



      SUBROUTINE RAYPLT                                                 RAYPLT 2

c

      implicit real*8 (a-h,o-z)

c

C     MAIN PLOTTING PROGRAM; INITIALIZES, READS INPUT, PLOTS            RAYPLT 3

C     PROJECTIONS OF RAYS ON A VERTICAL OR HORIZONTAL PLANE.            RAYPLT 4

C        ABS(PLT)=1. PLOTS PROJECTION OF RAYPATH ON VERTICAL PLANE      RAYPLT 5

C                    RECTANGULAR EXPANSION BY FACTOR 'PFACTR'           RAYPLT 6

C                =2. PLOTS PROJECTION OF RAYPATH ON GROUND              RAYPLT 7

C                =3. VERICAL PROJECTION USING RADIAL EXPANSION BY FACTO RAYPLT 8

C                    'PFACTR'                                           RAYPLT 9

C     COMMON DECK "FILEC" INSERTED HERE                                 CFILEC 2

      COMMON /FILEC/NPLTDP                                              CFILEC 4

      COMMON /PLT/ XL,XR,YB,YT,PRESET                                   RAYPLT11

      COMMON/PLT/RMIN,RMAX,ALPHA,APLT                                   RAYPLT12

C                                                                       RAYPLT13

C     COMMON DECK "CONST" INSERTED HERE                                 CCONST 2

      COMMON/PCONST/CREF,RGAS,GAMMA                                     CCONST 4

      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10                         CCONST 5

C     COMMON DECK "FLAG" INSERTED HERE                                  CFLAG  2

      LOGICAL NEWWR,NEWWP,NEWTRC,PENET                                  CFLAG  4

      COMMON /FLG/ NTYP,NEWWR,NEWWP,NEWTRC,PENET,LINES,IHOP,HPUNCH      CFLAG  5

      COMMON/FLGP/NSET                                                  CFLAG  6

C     COMMON DECK "RKAM" INSERTED HERE                                  RKAMCOM2

      REAL*8 KR,KTH,KPH                                                 RKAMCOM4

      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)       RKAMCOM5

C     COMMON DECK "WW" INSERTED HERE                                    CWW    2

      PARAMETER (NWARSZ=1000)                                           CWW1   3

      real*8 id

      COMMON/WW/ID(10),MAXW,W(NWARSZ)                                   CWW1   4

      REAL*8 MAXSTP,MAXERR,INTYP,LLAT,LLON                              CWW2   2

      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),    CWW2   3

     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),      CWW2   4

     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),          CWW2   5

     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),         CWW2   6

     8 (RCVRH,W(20)),                                                   CWW2   7

     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))CWW2   8

     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),                      CWW2   9

     6 (HMIN,W(27)),(RGMAX,W(28)),                                      CWW2  10

     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),                     CWW2  11

     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),       CWW2  12

     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))        CWW2  13

     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),        CWW2  14

     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))              CWW2  15

     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))                   CWW2  16

      REAL*8 MMODEL,MFORM,MID                                           CWW3   2

C                                                                       CWW3   3

C     WIND        100-124                                               CWW3   4

      EQUIVALENCE (W(100),UMODEL),(W(101),UFORM),(W(102),UID)           CWW3   5

C                                                                       CWW3   6

C     DELTA WIND        125-149                                         CWW3   7

      EQUIVALENCE (W(125),DUMODEL),(W(126),DUFORM),(W(127),DUID)        CWW3   8

C                                                                       CWW3   9

C     SOUND SPEED 150-174                                               CWW3  10

      EQUIVALENCE (W(150),CMODEL),(W(151),CFORM),(W(152),CID)           CWW3  11

      EQUIVALENCE (W(153),REFC)                                         CWW3  12

C                                                                       CWW3  13

C     DELTA SOUND SPEED 175-199                                         CWW3  14

      EQUIVALENCE (W(175),DCMODEL),(W(176),DCFORM),(W(177),DCID)        CWW3  15

C                                                                       CWW3  16

C     TEMPERATURE    200-224                                            CWW3  17

      EQUIVALENCE (W(200),TMODEL),(W(201),TFORM),(W(202),TID)           CWW3  18

C                                                                       CWW3  19

C     DELTA TEMPERATURE    225-249                                      CWW3  20

      EQUIVALENCE (W(225),DTMODEL),(W(226),DTFORM),(W(227),DTID)        CWW3  21

C                                                                       CWW3  22

C     MOLECULAR   250-274                                               CWW3  23

      EQUIVALENCE (W(250),MMODEL),(W(251),MFORM),(W(252),MID)           CWW3  24

C                                                                       CWW3  25

C     RECEIVER HEIGHT   275-299                                         CWW3  26

      EQUIVALENCE (W(275),RMODEL),(W(276),RFORM),(W(277),RID)           CWW3  27

C                                                                       CWW3  28

C     TOPOGRAPHY   300-324                                              CWW3  29

      EQUIVALENCE (W(300),GMODEL),(W(301),GFORM),(W(302),GID)           CWW3  30

C                                                                       CWW3  31

C     DELTA TOPOGRAPHY   325-349                                        CWW3  32

      EQUIVALENCE (W(325),GUMODEL),(W(326),GUFORM),(W(327),GUID)        CWW3  33

C                                                                       CWW3  34

C     UPPER SURFACE TOPOGRAPHY   350-374                                CWW3  35

      EQUIVALENCE (W(350),SMODEL),(W(351),SFORM),(W(352),SID)           CWW3  36

C     PLOT ENHANCEMENTS CONTROL PARAMETERS                              CWW3  37

C                                                                       CWW3  38

      EQUIVALENCE (W(490),XFQMDL),(W(491),YFQMDL)                       CWW3  39

C     ABSORPTION        500-524                                         CWW3  40

      EQUIVALENCE (W(500),AMODEL),(W(501),AFORM),(W(502),AID)           CWW3  41

C                                                                       CWW3  42

C     DELTA ABSORPTION        525-549                                   CWW3  43

      EQUIVALENCE (W(525),DAMODEL),(W(526),DAFORM),(W(527),DAID)        CWW3  44

C                                                                       CWW3  45

C     PRESSURE        550-574                                           CWW3  46

      EQUIVALENCE (W(550),PMODEL),(W(551),PFORM),(W(552),PID)           CWW3  47

C                                                                       CWW3  48

C     DELTA PRESSURE        575-599                                     CWW3  49

      EQUIVALENCE (W(575),DPMODEL),(W(576),DPFORM),(W(577),DPID)        CWW3  50

C                                                                       CWW3  51

      REAL*8 LTIC                                                       RAYPLT18

      INTEGER IWDMP(411)                                                RAYPLT19

      EQUIVALENCE(IWDMP,ID)                                             RAYPLT20

C                                                                       RAYPLT21

      EXTERNAL PLOT,PLTLB,PLTLBN,PLTHLB                                 RAYPLT22

C                                                                       RAYPLT23

      DATA NWDSRK/4/                                                    RAYPLT24

C                                                                       RAYPLT25

      IF (.NOT.NEWWR) GO TO 8                                           RAYPLT26

      APLT=DABS(PLT)                                                    RAYPLT27

C                                                                       RAYPLT28

C          NEW W ARRAY -- REINITIALIZE                                  RAYPLT29

      NEWWR=.FALSE.                                                     RAYPLT30

      PRESET=1.                                                         RAYPLT31

C     IF NO ACTIVE PLOTTING,WE ARE STILL DUMPING DATA                   RAYPLT32

      IF(PLT.EQ.0) GO TO 5                                              RAYPLT33

C     INITIALIZE ANNOTATION MODEL                                       RAYPLT34

C  CONVERT COORDINATES OF VERTICAL PLANE FROM GEOGRAPHIC TO GEOMAGNETIC RAYPLT35

      SW=DSIN(PLAT)                                                     RAYPLT36

      CW=DSIN(PID2-PLAT)                                                RAYPLT37

      SLM=DSIN(LLAT)                                                    RAYPLT38

      CLM=DSIN(PID2-LLAT)                                               RAYPLT39

      SRM=DSIN(RLAT)                                                    RAYPLT40

      CRM=DSIN(PID2-RLAT)                                               RAYPLT41

      CDPHI=DSIN(PID2-(LLON-PLON))                                      RAYPLT42

      PHL=DATAN2(DSIN(LLON-PLON)*CLM,CDPHI*SW*CLM-CW*SLM)               RAYPLT43

      CTHL=CDPHI*CW*CLM+SW*SLM                                          RAYPLT44

      STHL=DSIN(DACOS(CTHL))                                            RAYPLT45

      CDPHI=DSIN(PID2-(RLON-PLON))                                      RAYPLT46

      PHR=DATAN2(DSIN(RLON-PLON)*CRM,CDPHI*SW*CRM-CW*SRM)               RAYPLT47

      CTHR=CDPHI*CW*CRM+SW*SRM                                          RAYPLT48

      STHR=DSIN(DACOS(CTHR))                                            RAYPLT49

      CLR=CTHL*CTHR+STHL*STHR*DSIN(PID2-(PHL-PHR))                      RAYPLT50

      ALPHA=.5*DACOS(CLR)                                               RAYPLT51

      SLR=DSQRT(1.-CLR**2)                                              RAYPLT52

C                                                                       RAYPLT53

      IF (APLT.EQ.2.) GO TO 3                                           RAYPLT54

C                                                                       RAYPLT55

C     VERTICAL PROJECTIONS ONLY                                         RAYPLT56

      T=HB                                                              RAYPLT57

      HB=DMIN1(T,HT)                                                    RAYPLT58

      HT=DMAX1(T,HT)                                                    RAYPLT59

      RMIN=EARTHR+HB                                                    RAYPLT60

      YT1=YT                                                            RAYPLT61

      RMAX=EARTHR+HT                                                    RAYPLT62

C                                                                       RAYPLT63

      IF(APLT.NE.4.) GO TO 100                                          RAYPLT64

C                                                                       RAYPLT65

C     SCALE FOR CARTESIAN PROJECTION(=4)                                RAYPLT66

      XR=ALPHA                                                          RAYPLT67

      XR1=XR                                                            RAYPLT68

      XL=-XR                                                            RAYPLT69

      XL1=XL                                                            RAYPLT70

      YB=RMIN                                                           RAYPLT71

      YT=RMAX                                                           RAYPLT72

      GO TO 5                                                           RAYPLT73

C                                                                       RAYPLT74

C     PROJECTIONS 1 AND 3                                               RAYPLT75

100   XR1=RMIN*DSIN(ALPHA)                                              RAYPLT76

      XL1=-XR1                                                          RAYPLT77

      YB=RMIN*DSIN(PID2-ALPHA)                                          RAYPLT78

      IF(APLT.EQ.3.) RMAX=RMIN+(RMAX-RMIN)*PFACTR                       RAYPLT79

      XR=DMAX1(RMAX*DSIN(ALPHA),(RMAX-YB)/2.)                           RAYPLT80

      XL=-XR                                                            RAYPLT81

      YT1=RMAX*(YB/RMIN)                                                RAYPLT82

      YT=2.0*XR                                                         RAYPLT83

      IF(APLT.EQ.1) YT=YT/PFACTR                                        RAYPLT84

      YT=YT+YB                                                          RAYPLT85

      GO TO 5                                                           RAYPLT86

C                                                                       RAYPLT87

C     HORIZONTAL PROJECTION(=2)                                         RAYPLT88

3     ALPH1=DATAN2(STHR*DSIN(PHR-PHL),(CTHR-CTHL*CLR)/STHL)             RAYPLT89

      XL=0.0                                                            RAYPLT90

      XL1=0.0                                                           RAYPLT91

      XR=EARTHR*2.0*ALPHA                                               RAYPLT92

      XR1=XR                                                            RAYPLT93

C USE 90% OF X-RANGE FOR Y-RANGE                                        RAYPLT94

      RMAX=0.5*(0.90*XR)/PFACTR                                         RAYPLT95

      YT=RMAX                                                           RAYPLT96

      RMIN=-RMAX                                                        RAYPLT97

      YB=RMIN                                                           RAYPLT98

C                                                                       RAYPLT99

5     IF(NPLTDP.LE.0) GO TO 8                                           RAYPL100

      WRITE(NPLTDP) 1,NWDSRK,1,411                                      RAYPL101

      WRITE(NPLTDP) (IWDMP(I),I=1,411)                                  RAYPL102

C                                                                       RAYPL103

8     NEW=0                                                             RAYPL104

      IF (NEWTRC) NEW=1                                                 RAYPL105

      NEWTRC=.FALSE.                                                    RAYPL106

C                                                                       RAYPL107

      IF(NPLTDP.LE.0) GO TO 88                                          RAYPL108

      IF(NEW.NE.1) GO TO 84                                             RAYPL109

      WRITE(NPLTDP) 1,NWDSRK,17,25                                      RAYPL110

      WRITE(NPLTDP) (IWDMP(I),I=17,25)                                  RAYPL111

C                                                                       RAYPL112

84    WRITE(NPLTDP) 3-NEW,R,TH,PH                                       RAYPL113

C                                                                       RAYPL114

88    IF(PLT.EQ.0) RETURN                                               RAYPL115

C                                                                       RAYPL116

      STH=DSIN(TH)                                                      RAYPL117

      CTH=DSIN(PID2-TH)                                                 RAYPL118

      CR=CTHR*CTH+STHR*STH*DSIN(PID2-(PHR-PH))                          RAYPL119

      CL=CTHL*CTH+STHL*STH*DSIN(PID2-(PHL-PH))                          RAYPL120

      CEA=DATAN2(CR-CL*CLR,CL*SLR)                                      RAYPL121

C                                                                       RAYPL122

      IF(APLT.NE.4.) GO TO 150                                          RAYPL123

      CALL PLOT(CEA-ALPHA,R,NEW)                                        RAYPL124

      RETURN                                                            RAYPL125

C                                                                       RAYPL126

150   IF(APLT.EQ.2.) GO TO 10                                           RAYPL127

      RX=R                                                              RAYPL128

      IF(APLT.EQ.3.) RX=RMIN+(R-RMIN)*PFACTR                            RAYPL129

      CALL PLOT(CEA-ALPHA,RX,NEW)                                       RAYPL130

      RETURN                                                            RAYPL131

C                                                                       RAYPL132

10    SL=DSQRT(DMAX1(0.,1.-CL**2))                                      RAYPL133

      TMP1=STH*DSIN(PH-PHL)                                             RAYPL134

      TMP2=(CTH-CTHL*CL)/STHL                                           RAYPL135

      ALPH2=0.                                                          RAYPL136

      IF (TMP1.NE.0..OR.TMP2.NE.0.) ALPH2=DATAN2(TMP1,TMP2)             RAYPL137

      CALL PLOT (EARTHR*CEA,EARTHR*DASIN(SL*DSIN(ALPH1-ALPH2)),NEW)     RAYPL138

      RETURN                                                            RAYPL139

C                                                                       RAYPL140

C          DRAW AXES AND CALL FOR LABELING AND TERMINATION OF THIS PLOT RAYPL141

      ENTRY ENDPLT                                                      RAYPL142

C                                                                       RAYPL143

C     IF NEWWR IS STILL TRUE, NO PLOTS WHERE PRODUCED                   RAYPL144

      IF(NEWWR) RETURN                                                  RAYPL145

      NEWWR=.TRUE.                                                      RAYPL146

C                                                                       RAYPL147

C     SIGNAL END OF PLOT                                                RAYPL148

      IF(NPLTDP.GT.0) WRITE(NPLTDP) 4,(NWDSRK,I=2,NWDSRK)               RAYPL149

C                                                                       RAYPL150

      IF(PLT.EQ.0) RETURN                                               RAYPL151

C                                                                       RAYPL152

      TICKX=0.01*(YT-YB)                                                RAYPL153

      DTIC=TIC*EARTHR                                                   RAYPL154

      CALL SETXY(APLT,-ALPHA,RMIN,ALPHA,RMAX)                           RAYPL155

C                                                                       RAYPL156

      IF(APLT.EQ.4.) GO TO 200                                          RAYPL157

      IF(APLT.EQ.2.) GO TO 25                                           RAYPL158

C                                                                       RAYPL159

C     CURVLINEAR PROJECTIONS(=1,3)                                      RAYPL160

      CALL ARCTIC(-ALPHA,ALPHA,RMIN,TICKX,PLTHLB)                       RAYPL161

      CALL ARCTIC(-ALPHA,ALPHA,RMAX,-TICKX,PLTHLB)                      RAYPL162

      GO TO 300                                                         RAYPL163

C                                                                       RAYPL164

C     CARTESIAN PROJECTION PUT IN BOTTOM BOUNDARY                       RAYPL165

200   CALL TIKLINE(-ALPHA,RMIN,ALPHA,RMIN,TIC,-TICKX,PLTHLB)            RAYPL166

C     PUT IN TOP BOUNDARY                                               RAYPL167

      CALL TIKLINE(-ALPHA,RMAX,ALPHA,RMAX,TIC,TICKX,PLTHLB)             RAYPL168

C                                                                       RAYPL169

300   TIKL=.02*ALPHA                                                    RAYPL170

      LTIC=TICV                                                         RAYPL171

      IF(APLT.EQ.3.) LTIC=TICV*PFACTR                                   RAYPL172

C     PUT IN LEFT BOUNDARY                                              RAYPL173

      CALL TIKLINE(-ALPHA,RMIN,-ALPHA,RMAX,LTIC,TIKL,PLTLB)             RAYPL174

C     PUT IN RIGHT BOUNDARY                                             RAYPL175

      CALL TIKLINE(ALPHA,RMIN,ALPHA,RMAX,LTIC,-TIKL,PLTLBN)             RAYPL176

C                                                                       RAYPL177

      GO TO 50                                                          RAYPL178

C   DRAW TICKS, BOX FOR HORIZONTAL PLOT                                 RAYPL179

25    CALL DRAWTKS(DTIC,TICV,XL,XR,YB,YT,PLOT)                          RAYPL180

C                                                                       RAYPL181

50    IF(APLT.EQ.2.0) THEN                                              RAYPL182

        CALL PLTANOT(ID,OW/PIT2,XFQMDL,YFQMDL,XL,YB,XR,YT,DEGS,         RAYPL183

     2     LLAT,LLON,RLAT,RLON,HB,HT,APLT,DTIC,DTIC/PFACTR,PLOT)        RAYPL184

      ELSE                                                              RAYPL185

        CALL PLTANOT(ID,OW/PIT2,XFQMDL,YFQMDL,-ALPHA,RMIN,ALPHA,RMAX,   RAYPL186

     2     DEGS,LLAT,LLON,RLAT,RLON,HB,HT,APLT,DTIC,TICV,PLOT)          RAYPL187

      ENDIF                                                             RAYPL188

C                                                                       RAYPL189

      CALL LABPLT                                                       RAYPL190

      CALL PLTEND                                                       RAYPL191

      RETURN                                                            RAYPL192

      END                                                               RAYPL193











      SUBROUTINE PLOT (X,Y,NEW)                                         PLOT   2

c

      implicit real*8 (a-h,o-z)

c

C     PLOTS ONE VECTOR FROM CURRENT PLOT POSITION TO POINT(X,Y)         PLOT   3

C     TAKING BORDER CROSSINGS INTO ACCOUNT.                             PLOT   4

      COMMON /PLT/ XMIN0,XMAX0,YMIN0,YMAX0,RESET                        PLOT   5

      COMMON/PLT/RMIN,RMAX,ALPHA,APLT                                   PLOT   6

      COMMON /DD/ INT,IOR,IT,IS,IC,ICC,IX,IY                            PLOT   7

C DEFINE NOMINAL PLOTTING AREA(ZERO SUFFIXES) AND AN                    PLOT   8

C OUTER CLIPPING BOUNDARY BEYOND WHICH NO VECTORS EXTEND.               PLOT   9

      DATA XOLD,YOLD/0.0,0.0/                                           PLOT  10

C 90% FOR Y RANGE                                                       PLOT  11

C                                                                       PLOT  12

C          COMPUTE SCALE FACTORS                                        PLOT  13

    1 IF (RESET.EQ.0.) GO TO 5                                          PLOT  14

      RESET=0.                                                          PLOT  15

      IF(APLT.EQ.2.) THEN                                               PLOT  16

         MRNGE=723                                                      PLOT  17

         MINX0=165                                                      PLOT  18

         MINY0=140                                                      PLOT  19

      ELSE                                                              PLOT  20

         MRNGE=813                                                      PLOT  21

         MINX0=165                                                      PLOT  22

         MINY0=140                                                      PLOT  23

      ENDIF                                                             PLOT  24

      IF(APLT.EQ.4.) MINY0=0                                            PLOT  25

C                                                                       PLOT  26

      MAXX0=MINX0+MRNGE                                                 PLOT  27

      MAXY0=MINY0+MRNGE                                                 PLOT  28

C                                                                       PLOT  29

      XSCALE=(MAXX0-MINX0)/(XMAX0-XMIN0)                                PLOT  30

      YSCALE=(MAXY0-MINY0)/(YMAX0-YMIN0)                                PLOT  31

      XMIN=XMIN0                                                        PLOT  32

      YMIN=YMIN0                                                        PLOT  33

      XMAX=XMAX0                                                        PLOT  34

      YMAX=YMAX0                                                        PLOT  35

      IF(APLT.EQ.2.) GO TO 5                                            PLOT  36

C                                                                       PLOT  37

      XMIN=-ALPHA                                                       PLOT  38

      XMAX=ALPHA                                                        PLOT  39

      YMIN=RMIN                                                         PLOT  40

      YMAX=RMAX                                                         PLOT  41

      IF(APLT.NE.4) GO TO 5                                             PLOT  42

      YSCALE=.85*YSCALE                                                 PLOT  43

      MINY0=MINY0+60                                                    PLOT  44

C                                                                       PLOT  45

C          START A NEW LINE                                             PLOT  46

C          HORIZONTAL DISPLACEMENT                                      PLOT  47

5     XS=X-XOLD                                                         PLOT  48

      YS=Y-YOLD                                                         PLOT  49

      S=1.0                                                             PLOT  50

      IF(NEW.EQ.0) GO TO 10                                             PLOT  51

      IF(X.GE.XMIN.AND.X.LE.XMAX.AND.Y.GE.YMIN.AND.Y.LE.YMAX) GO TO 48  PLOT  52

      GO TO 50                                                          PLOT  53

C                                                                       PLOT  54

10    IF (XS) 11,12,16                                                  PLOT  55

C          NEGATIVE                                                     PLOT  56

   11 X1=XMAX                                                           PLOT  57

      X2=XMIN                                                           PLOT  58

      GO TO 20                                                          PLOT  59

C          ZERO                                                         PLOT  60

   12 IF (YS) 13,50,14                                                  PLOT  61

   13 S1=(YMAX-YOLD)/YS                                                 PLOT  62

      S2=(YMIN-YOLD)/YS                                                 PLOT  63

      GO TO 40                                                          PLOT  64

   14 S1=(YMIN-YOLD)/YS                                                 PLOT  65

      S2=(YMAX-YOLD)/YS                                                 PLOT  66

      GO TO 40                                                          PLOT  67

C          POSITIVE                                                     PLOT  68

   16 X1=XMIN                                                           PLOT  69

      X2=XMAX                                                           PLOT  70

C                                                                       PLOT  71

C          VERTICAL DISPLACEMENT                                        PLOT  72

   20 IF (YS) 21,22,26                                                  PLOT  73

C          NEGATIVE                                                     PLOT  74

   21 Y1=YMAX                                                           PLOT  75

      Y2=YMIN                                                           PLOT  76

      GO TO 30                                                          PLOT  77

C          ZERO                                                         PLOT  78

   22 S1=(X1-XOLD)/XS                                                   PLOT  79

      S2=(X2-XOLD)/XS                                                   PLOT  80

      GO TO 40                                                          PLOT  81

C          POSITIVE                                                     PLOT  82

   26 Y1=YMIN                                                           PLOT  83

      Y2=YMAX                                                           PLOT  84

C                                                                       PLOT  85

   30 S1=DMAX1((X1-XOLD)/XS,(Y1-YOLD)/YS)                               PLOT  86

      S2=DMIN1((X2-XOLD)/XS,(Y2-YOLD)/YS)                               PLOT  87

C                                                                       PLOT  88

C          PLOT LINE -- CHECKING FOR BORDER CROSSINGS                   PLOT  89

40    IF (S2.LT.0..OR.S1.GT.1.) GO TO 50                                PLOT  90

      IF (S1.LT.0.) GO TO 42                                            PLOT  91

C          PREVIOUS POINT OFF GRAPH                                     PLOT  92

      XP=XOLD+XS*S1                                                     PLOT  93

      YP=YOLD+YS*S1                                                     PLOT  94

      IF(APLT.EQ.2.0.OR.APLT.EQ.4.0) GO TO 41                           PLOT  95

      T=XP                                                              PLOT  96

      XP=YP*DSIN(T)                                                     PLOT  97

      YP=YP*DCOS(T)                                                     PLOT  98

C                                                                       PLOT  99

41    IX=MINX0+(XP-XMIN0)*XSCALE+0.5                                    PLOT 100

      IY=MINY0+(YP-YMIN0)*YSCALE+0.5                                    PLOT 101

      CALL DDBP                                                         PLOT 102

      GO TO 48                                                          PLOT 103

C                                                                       PLOT 104

42    IF (S2.GT.1.) GO TO 48                                            PLOT 105

C          CURRENT POINT OFF GRAPH                                      PLOT 106

      S=S2                                                              PLOT 107

C          CURRENT POINT ON GRAPH                                       PLOT 108

48    XP=XOLD+XS*S                                                      PLOT 109

      YP=YOLD+YS*S                                                      PLOT 110

      IF(APLT.EQ.2.0.OR.APLT.EQ.4.0) GO TO 49                           PLOT 111

      T=XP                                                              PLOT 112

      XP=YP*DSIN(T)                                                     PLOT 113

      YP=YP*DCOS(T)                                                     PLOT 114

49    IX=MINX0+(XP-XMIN0)*XSCALE+0.5                                    PLOT 115

      IY=MINY0+(YP-YMIN0)*YSCALE+0.5                                    PLOT 116

      IF(NEW.EQ.0) CALL DDVC                                            PLOT 117

      IF(NEW.NE.0) CALL DDBP                                            PLOT 118

C                                                                       PLOT 119

C          EXIT ROUTINE                                                 PLOT 120

   50 XOLD=X                                                            PLOT 121

      YOLD=Y                                                            PLOT 122

      RETURN                                                            PLOT 123

C                                                                       PLOT 124

C          TERMINATE THE CURRENT PLOT                                   PLOT 125

      entry pltend

c     ENTRY PLTEND(X,Y,NEW)                                             PLOT 126

      CALL DDFR                                                         PLOT 127

C                                                                       PLOT 128

      RETURN                                                            PLOT 129

         END                                                            PLOT 130











      SUBROUTINE LABPLT                                                 LABPLT 2

c

      implicit real*8 (a-h,o-z)

c

C          LABEL THE CURRENT PLOT                                       LABPLT 3

      CHARACTER*80 LABEL,CHID                                           LABPLT 4

      CHARACTER*4 ANGRANG,ANOTE                                         LABPLT 5

C     COMMON DECK "SS" INSERTED HERE                                    CSS    2

      real*8 modsurf

c     REAL MODSURF                                                      CSS    4

      COMMON/SS/ MODSURF(4)                                             CSS    5

      COMMON/SS/U,PUR,PURR,PURTH,PURPH                                  CSS    6

      COMMON/SS/PUTH,PUPH,PUTHTH,PUPHPH,PUTHPH,USELECT,UTIME            CSS    7

C     COMMON DECK "GG" INSERTED HERE                                    CGG    2

      real*8 modg

c     REAL MODG                                                         CGG    4

      COMMON/GG/MODG(4)                                                 CGG    5

      COMMON/GG/G,PGR,PGRR,PGRTH,PGRPH                                  CGG    6

      COMMON/GG/PGTH,PGPH,PGTHTH,PGPHPH,PGTHPH,GSELECT,GTIME            CGG    7

C     COMMON DECK "RR" INSERTED HERE                                    CRR    2

      real*8 modrec

c     REAL MODREC                                                       CRR    4

      COMMON/RR/ MODREC(4)                                              CRR    5

      COMMON/RR/F,PFR,PFRR,PFRTH,PFRPH                                  CRR    6

      COMMON/RR/PFTH,PFPH,PFTHTH,PFPHPH,PFTHPH,FSELECT,FTIME            CRR    7

C     COMMON DECK "UU" INSERTED HERE                                    CUU    2

      real*8 modu

c     REAL MODU                                                         CUU    4

      COMMON/UU/MODU(4)                                                 CUU    5

     1  ,V  ,PVT  ,PVR  ,PVTH  ,PVPH                                    CUU    6

     2  ,VR ,PVRT ,PVRR ,PVRTH ,PVRPH                                   CUU    7

     3  ,VTH,PVTHT,PVTHR,PVTHTH,PVTHPH                                  CUU    8

     4  ,VPH,PVPHT,PVPHR,PVPHTH,PVPHPH                                  CUU    9

C     COMMON DECK "CC" INSERTED HERE                                    CCC    2

      real*8 modc

c     REAL MODC                                                         CCC    4

      COMMON/CC/MODC(4),CS,PCST,PCSR,PCSTH,PCSPH                        CCC    5

C     COMMON DECK "TT" INSERTED HERE                                    CTT    2

      real*8 modt

c     REAL MODT                                                         CTT    4

      COMMON/TT/MODT(4), T,PTT,PTR,PTTH,PTPH                            CTT    5

C     COMMON DECK "MM" INSERTED HERE                                    CMM    2

      real*8 modm

c     REAL M                                                            CMM    4

      COMMON/MM/MODM(4),M,PMT,PMR,PMTH,PMPH                             CMM    5

C     COMMON DECK "HDR" INSERTED HERE                                   CHDR   2

      CHARACTER*10 INITID*80,DAT,TOD                                    CHDR   4

      COMMON/HDR/SEC                                                    CHDR   5

      COMMON/HDRC/INITID,DAT,TOD                                        CHDR   6

C     COMMON DECK "RINPLEX" INSERTED HERE                               CRINPLE2

      REAL*8 KAY2,KAY2I                                                 CRINPLE4

      COMPLEX*16 PNP,POLAR,LPOLAR                                       CRINPLE5

      LOGICAL SPACE                                                     CRINPLE6

      CHARACTER DISPM*6                                                 CRINPLE7

      COMMON/RINPL/DISPM                                                CRINPLE8

      real*8 modrin

c     COMMON /RIN/ MODRIN(8),RAYNAME(2,3),TYPE(3),SPACE                 CRINPLE9

      COMMON/RIN/OMEGMIN,OMEGMAX,KAY2,KAY2I                             CRINPL10

      COMMON/RIN/PNP(10),POLAR,LPOLAR,SGN                               CRINPL11

      COMMON /DD/ INT,IOR,IT,IS,IC,ICC,IX,IY                            LABPLT15

C     COMMON DECK "CONST" INSERTED HERE                                 CCONST 2

      COMMON/PCONST/CREF,RGAS,GAMMA                                     CCONST 4

      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10                         CCONST 5

C     COMMON DECK "FLAG" INSERTED HERE                                  CFLAG  2

      LOGICAL NEWWR,NEWWP,NEWTRC,PENET                                  CFLAG  4

      COMMON /FLG/ NTYP,NEWWR,NEWWP,NEWTRC,PENET,LINES,IHOP,HPUNCH      CFLAG  5

      COMMON/FLGP/NSET                                                  CFLAG  6

C     COMMON DECK "WW" INSERTED HERE                                    CWW    2

      PARAMETER (NWARSZ=1000)                                           CWW1   3

      real*8 id

      COMMON/WW/ID(10),MAXW,W(NWARSZ)                                   CWW1   4

      REAL*8 MAXSTP,MAXERR,INTYP,LLAT,LLON                              CWW2   2

      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),    CWW2   3

     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),      CWW2   4

     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),          CWW2   5

     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),         CWW2   6

     8 (RCVRH,W(20)),                                                   CWW2   7

     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))CWW2   8

     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),                      CWW2   9

     6 (HMIN,W(27)),(RGMAX,W(28)),                                      CWW2  10

     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),                     CWW2  11

     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),       CWW2  12

     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))        CWW2  13

     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),        CWW2  14

     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))              CWW2  15

     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))                   CWW2  16

      REAL*8 MMODEL,MFORM,MID                                           CWW3   2

C                                                                       CWW3   3

C     WIND        100-124                                               CWW3   4

      EQUIVALENCE (W(100),UMODEL),(W(101),UFORM),(W(102),UID)           CWW3   5

C                                                                       CWW3   6

C     DELTA WIND        125-149                                         CWW3   7

      EQUIVALENCE (W(125),DUMODEL),(W(126),DUFORM),(W(127),DUID)        CWW3   8

C                                                                       CWW3   9

C     SOUND SPEED 150-174                                               CWW3  10

      EQUIVALENCE (W(150),CMODEL),(W(151),CFORM),(W(152),CID)           CWW3  11

      EQUIVALENCE (W(153),REFC)                                         CWW3  12

C                                                                       CWW3  13

C     DELTA SOUND SPEED 175-199                                         CWW3  14

      EQUIVALENCE (W(175),DCMODEL),(W(176),DCFORM),(W(177),DCID)        CWW3  15

C                                                                       CWW3  16

C     TEMPERATURE    200-224                                            CWW3  17

      EQUIVALENCE (W(200),TMODEL),(W(201),TFORM),(W(202),TID)           CWW3  18

C                                                                       CWW3  19

C     DELTA TEMPERATURE    225-249                                      CWW3  20

      EQUIVALENCE (W(225),DTMODEL),(W(226),DTFORM),(W(227),DTID)        CWW3  21

C                                                                       CWW3  22

C     MOLECULAR   250-274                                               CWW3  23

      EQUIVALENCE (W(250),MMODEL),(W(251),MFORM),(W(252),MID)           CWW3  24

C                                                                       CWW3  25

C     RECEIVER HEIGHT   275-299                                         CWW3  26

      EQUIVALENCE (W(275),RMODEL),(W(276),RFORM),(W(277),RID)           CWW3  27

C                                                                       CWW3  28

C     TOPOGRAPHY   300-324                                              CWW3  29

      EQUIVALENCE (W(300),GMODEL),(W(301),GFORM),(W(302),GID)           CWW3  30

C                                                                       CWW3  31

C     DELTA TOPOGRAPHY   325-349                                        CWW3  32

      EQUIVALENCE (W(325),GUMODEL),(W(326),GUFORM),(W(327),GUID)        CWW3  33

C                                                                       CWW3  34

C     UPPER SURFACE TOPOGRAPHY   350-374                                CWW3  35

      EQUIVALENCE (W(350),SMODEL),(W(351),SFORM),(W(352),SID)           CWW3  36

C     PLOT ENHANCEMENTS CONTROL PARAMETERS                              CWW3  37

C                                                                       CWW3  38

      EQUIVALENCE (W(490),XFQMDL),(W(491),YFQMDL)                       CWW3  39

C     ABSORPTION        500-524                                         CWW3  40

      EQUIVALENCE (W(500),AMODEL),(W(501),AFORM),(W(502),AID)           CWW3  41

C                                                                       CWW3  42

C     DELTA ABSORPTION        525-549                                   CWW3  43

      EQUIVALENCE (W(525),DAMODEL),(W(526),DAFORM),(W(527),DAID)        CWW3  44

C                                                                       CWW3  45

C     PRESSURE        550-574                                           CWW3  46

      EQUIVALENCE (W(550),PMODEL),(W(551),PFORM),(W(552),PID)           CWW3  47

C                                                                       CWW3  48

C     DELTA PRESSURE        575-599                                     CWW3  49

      EQUIVALENCE (W(575),DPMODEL),(W(576),DPFORM),(W(577),DPID)        CWW3  50

C                                                                       CWW3  51

C                                                                       LABPLT19

C     COMMON DECK "AA" INSERTED HERE                                    CAA    2

      real*8 moda

c     REAL MODA                                                         CAA    4

      REAL*8 MU,MUPT,MUPR,MUPTH,MUPPH                                   CAA    5

      REAL*8 KAP,KAPPT,KAPPR,KAPPTH,KAPPPH                              CAA    6

      COMMON/AA/MODA(4),MU,MUPT,MUPR,MUPTH,MUPPH                        CAA    7

      COMMON/AA/KAP,KAPPT,KAPPR,KAPPTH,KAPPPH                           CAA    8

C     COMMON DECK "PP" INSERTED HERE                                    CPP    2

      real*8 modp

c     REAL MODP                                                         CPP    4

      COMMON/PP/MODP(4),P,PPT,PPR,PPTH,PPPH                             CPP    5

C                                                                       LABPLT22

      WRITE(LABEL,900) ID                                               LABPLT23

900   FORMAT(10A8)                                                      LABPLT24

      CHID=LABEL                                                        LABPLT25

      LABEL=CHID(5:)                                                    LABPLT26

      IOR=0                                                             LABPLT27

      IT=0                                                              LABPLT28

      IS=2                                                              LABPLT29

      IX=0                                                              LABPLT30

      IY=1023                                                           LABPLT31

      CALL DDTEXT (8,LABEL)                                             LABPLT32

      IX=1090                                                           LABPLT33

      IY=0                                                              LABPLT34

      CALL DDTEXT (2,DAT)                                               LABPLT35

      IY=1023                                                           LABPLT36

      F=OW/PIT2                                                         LABPLT37

      NANGLE=10                                                         LABPLT38

      ANGRANG='EL ='                                                    LABPLT39

      ANOTE='AZ ='                                                      LABPLT40

      ANEL=0.                                                           LABPLT41

      IF(ELSTEP.NE.0.0) ANEL=(ELEND-ELBEG)/ELSTEP+1.5                   LABPLT42

      IF(ANEL.GT.1.0.OR.PLT.LT.0.0) GO TO 100                           LABPLT43

         ANGRANG='AZ ='                                                 LABPLT44

         ANOTE='EL ='                                                   LABPLT45

         NANGLE=14                                                      LABPLT46

100   WRITE(LABEL,1300)  CHID(1:3),F,ANOTE,W(NANGLE)*DEGS               LABPLT47

1300  FORMAT ('MODEL = ',A,'  ,FREQ =',F9.3,' HZ, ',A,F7.3,' DEG')      LABPLT48

      IX=0                                                              LABPLT49

      IY=IY-32                                                          LABPLT50

      CALL DDTEXT (7,LABEL)                                             LABPLT51

C                                                                       LABPLT52

C INDEX OF OPPOSITE ANGLE                                               LABPLT53

      NANGLE=(10+14-NANGLE)+1                                           LABPLT54

      NANGLE2=NANGLE+2                                                  LABPLT55

      WRITE(LABEL,1400) ANGRANG,(W(I)*DEGS,I=NANGLE,NANGLE2)            LABPLT56

1400  FORMAT(A,F7.2,' DEG TO',F7.2,' DEG, STEP =',F7.2,' DEG')          LABPLT57

      IY=IY-32                                                          LABPLT58

      CALL DDTEXT (7,LABEL)                                             LABPLT59

C                                                                       LABPLT60

      WRITE(LABEL,1500) XMTRH,TLAT*DEGS,TLON*DEGS                       LABPLT61

1500  FORMAT('XMTR HT =',F6.2,' KM ,LAT =',F6.2,' DEG, LONG ='          LABPLT62

     1   ,F6.2,' DEG')                                                  LABPLT63

      IY=IY-32                                                          LABPLT64

      CALL DDTEXT (7,LABEL)                                             LABPLT65

C                                                                       LABPLT66

      IY=IY-32                                                          LABPLT67

      WRITE(LABEL,'(10A8)') MODRIN                                      LABPLT68

      CALL DDTEXT(8,LABEL)                                              LABPLT69

C                                                                       LABPLT70

      IX=1050                                                           LABPLT71

      CALL DDTEXT(1,'MODELS')                                           LABPLT72

      IY=IY-15                                                          LABPLT73

C     LOOP FOR 8 MODELS AND PERTURBATIONS                               LABPLT74

      DO 1700 K=1,16                                                    LABPLT75

      I=(K-1)/2+1                                                       LABPLT76

C     GENERATE ALTERNATING 1,2;3,4 SERIES FOR MODEL AND PERTURBATION    LABPLT77

      J1=2*(K+1-I*2)+1                                                  LABPLT78

      J2=J1+1                                                           LABPLT79

      IF(I.EQ.1) WRITE(LABEL,1600) (MODU(J),J=J1,J2)                    LABPLT80

      IF(I.EQ.2) WRITE(LABEL,1600) (MODC(J),J=J1,J2)                    LABPLT81

      IF(I.EQ.3) WRITE(LABEL,1600) (MODT(J),J=J1,J2)                    LABPLT82

      IF(I.EQ.4 .AND. J1.EQ.1)                                          LABPLT83

     1 WRITE(LABEL,1600) (MODM(J),J=J1,J2)                              LABPLT84

C                                                                       LABPLT85

      IF(I.EQ.5) WRITE(LABEL,1600) (MODG(J),J=J1,J2)                    LABPLT86

      IF(I.EQ.6) WRITE(LABEL,1600) (MODA(J),J=J1,J2)                    LABPLT87

      IF(I.EQ.7) WRITE(LABEL,1600) (MODP(J),J=J1,J2)                    LABPLT88

C NO FURTHER OUTPUT FOR MODELS WITHOUT PERTURBATIONS                    LABPLT89

      IF(J1.GT.1) GO TO 1610                                            LABPLT90

      IF(I.EQ.8) WRITE(LABEL,1600) (MODREC(J),J=J1,J2)                  LABPLT91

1600  FORMAT(2(2(A8,2X,F5.1,1X),2X))                                    LABPLT92

C                                                                       LABPLT93

1610  IF(LABEL(1:1).EQ.' ') GO TO 1700                                  LABPLT94

      IY=IY-32                                                          LABPLT95

      CALL DDTEXT(2,LABEL)                                              LABPLT96

1700  LABEL(1:1)=' '                                                    LABPLT97

C                                                                       LABPLT98

         END                                                            LABPLT99











      SUBROUTINE PLTHLB(X,Y,NC)                                         PLTHLB 2

c

      implicit real*8 (a-h,o-z)

c

C     HORIZONTAL TICK ANNOTATION ROUTINE FOR RAYPLOT.                   PLTHLB 3

C                                                                       PLTHLB 4

C                                                                       PLTHLB 5

      EXTERNAL PLOT                                                     PLTHLB 6

C                                                                       PLTHLB 7

      CALL PLTANH(X,Y,NC,PLOT)                                          PLTHLB 8

      END                                                               PLTHLB 9











      SUBROUTINE PLTANH(X,Y,NC,PLOT)                                    PLTANH 2

c

      implicit real*8 (a-h,o-z)

c

C                                                                       PLTANH 3

C     TIC LABELING ROUTINE FOR HORIZONTAL PLOT PROJECTIONS              PLTANH 4

C                                                                       PLTANH 5

      CHARACTER ANNOT*10                                                PLTANH 6

      COMMON/DD/IN,IOR,IT,IS,IC,ICC,IX,IY                               PLTANH 7

C     COMMON DECK "WWR" INSERTED HERE                                   CWWR   2

      PARAMETER (NWARSZ=1000)                                           CWW1   3

      real*8 id

      COMMON/WW/ID(10),MAXW,W(NWARSZ)                                   CWW1   4

      REAL*8 MAXSTP,MAXERR,INTYP,LLAT,LLON                              CWW2   2

      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),    CWW2   3

     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),      CWW2   4

     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),          CWW2   5

     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),         CWW2   6

     8 (RCVRH,W(20)),                                                   CWW2   7

     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))CWW2   8

     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),                      CWW2   9

     6 (HMIN,W(27)),(RGMAX,W(28)),                                      CWW2  10

     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),                     CWW2  11

     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),       CWW2  12

     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))        CWW2  13

     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),        CWW2  14

     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))              CWW2  15

     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))                   CWW2  16

C     COMMON DECK "CONST" INSERTED HERE                                 CCONST 2

      COMMON/PCONST/CREF,RGAS,GAMMA                                     CCONST 4

      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10                         CCONST 5

      COMMON/LABCLT/PROJCT,THMIN,THMAX,RMIN,RMAX                        PLTANH10

C                                                                       PLTANH11

      COMMON/RAYCON/MCONP                                               PLTANH12

C                                                                       PLTANH13

      DATA LNC/-100/                                                    PLTANH14

C                                                                       PLTANH15

      IF(NC.LE.0 .OR. NC.GT.2) GO TO 100                                PLTANH16

C                                                                       PLTANH17

C     NORMALIZE LETTER SIZE FACTOR TO .15 INCHES                        PLTANH18

      HLETF=HITLET/.15                                                  PLTANH19

C                                                                       PLTANH20

      IF(LNC.NE.NC) LICM=-100                                           PLTANH21

      LNC=NC                                                            PLTANH22

C                                                                       PLTANH23

      CALL PLOT(X,Y,1)                                                  PLTANH24

      IX=IX-80*HLETF                                                    PLTANH25

      ICM=IX                                                            PLTANH26

      IF(NC.GT.1) THEN                                                  PLTANH27

         ICM=IY                                                         PLTANH28

         IX=IX-40                                                       PLTANH29

      ENDIF                                                             PLTANH30

C                                                                       PLTANH31

C     INSURE THAT OVERLAPS OF ANNOTATIONS DO NOT OCCUR                  PLTANH32

      IF(IABS(ICM-LICM).LT.INT(80*HLETF)) GO TO 100                     PLTANH33

C                                                                       PLTANH34

      IF(PROJCT.EQ.2.0) GO TO 25                                        PLTANH35

      IF(HB.GE.0.0.AND.Y.GT.(RMIN+RMAX)/2) GO TO 100                    PLTANH36

      IF(HB.LT.0.0.AND.Y.LT.(RMIN+RMAX)/2) GO TO 100                    PLTANH37

C                                                                       PLTANH38

25    F=DEGS                                                            PLTANH39

      TMP=(THMAX-THMIN)*DEGS                                            PLTANH40

      IF(TMP.LT.10.) F =EARTHR                                          PLTANH41

      FT=F                                                              PLTANH42

      IF(PROJCT.EQ.2.0 .AND. MCONP.EQ.0) F=F/EARTHR                     PLTANH43

      V=X-THMIN                                                         PLTANH44

      IF(NC.GT.1) V=Y-(RMIN+RMAX)/2.                                    PLTANH45

      IF(DABS(DMOD(TIC*FT+.0001,1.)).GT..001) GO TO 60                  PLTANH46

C                                                                       PLTANH47

      xv = 0.5

      WRITE(ANNOT,50) INT(V*F+DSIGN(xv,V))                              PLTANH48

50    FORMAT(I5)                                                        PLTANH49

      GO TO 90                                                          PLTANH50

C                                                                       PLTANH51

60    WRITE(ANNOT,80) V*F                                               PLTANH52

80    FORMAT(F8.2)                                                      PLTANH53

C                                                                       PLTANH54

90    LICM=ICM                                                          PLTANH55

C     ALLOW 8 RASTERS FOR THE LETTER HEIGHT                             PLTANH56

      H=HB                                                              PLTANH57

      IF(PROJCT.EQ.2.0) H=0.                                            PLTANH58

      XXH = 52.

      IF(NC.EQ.1) IY=IY-8*HLETF-DSIGN(XXH,H)                            PLTANH59

      IOR=0                                                             PLTANH60

95    FORMAT(3G13.6,2I5,1X,A10)                                         PLTANH61

99    FORMAT(2G13.6,5I5,1X,A10)                                         PLTANH62

      CALL DDTEXT(1,ANNOT)                                              PLTANH63

C                                                                       PLTANH64

100   CALL PLOT(X,Y,MIN0(1,NC))                                         PLTANH65

      END                                                               PLTANH66











      SUBROUTINE SETXY(PROJ,XMIN,YMIN,XMAX,YMAX)                        SETXY  2

c

      implicit real*8 (a-h,o-z)

c

C     PLOT INITIALIZATION; SETS PROJECTION PARAMETERS                   SETXY  3

C                                                                       SETXY  4

      COMMON/LABCLT/PROJCT,THMIN,THMAX,RMIN,RMAX                        SETXY  5

C                                                                       SETXY  6

C                                                                       SETXY  7

C   INITIAL ANNOTATION MODEL                                            SETXY  8

      CALL SETANN                                                       SETXY  9

C                                                                       SETXY 10

      PROJCT=PROJ                                                       SETXY 11

      THMIN=XMIN                                                        SETXY 12

      RMIN=YMIN                                                         SETXY 13

      THMAX=XMAX                                                        SETXY 14

      RMAX=YMAX                                                         SETXY 15

      END                                                               SETXY 16











      SUBROUTINE TIKLINE(XL1,YB,XL,YT1,TICV,TIKSZ,PLOT)                 TIKLINE2

c

      implicit real*8 (a-h,o-z)

c

C     DRAWS STRAIGHT LINE WITH TICKS AT INTERVALS                       TIKLINE3

C                                                                       TIKLINE4

C                                                                       TIKLINE5

      XDF=XL-XL1                                                        TIKLINE6

      YDF=YT1-YB                                                        TIKLINE7

      DST=DSQRT(XDF*XDF+YDF*YDF)                                        TIKLINE8

      TICE=DST                                                          TIKLINE9

      T=0.0                                                             TIKLIN10

      IF(TICV.EQ.0.0) GO TO 50                                          TIKLIN11

      TICE=TICV                                                         TIKLIN12

      T=TIKSZ/TICV                                                      TIKLIN13

C                                                                       TIKLIN14

50    TICVX=TICE*XDF/DST                                                TIKLIN15

      TICVY=TICE*YDF/DST                                                TIKLIN16

      TX=TICVY*T                                                        TIKLIN17

      TY=-TICVX*T                                                       TIKLIN18

      NTIC=1+DST/TICE                                                   TIKLIN19

      CALL PLOT(XL1,YB,-1)                                              TIKLIN20

      DO 100 I=0,NTIC-1                                                 TIKLIN21

        X=XL1+I*TICVX                                                   TIKLIN22

        Y=YB+I*TICVY                                                    TIKLIN23

        CALL PLOT(X,Y,0)                                                TIKLIN24

        CALL PLOT(X+TX,Y+TY,0)                                          TIKLIN25

100   CALL PLOT(X,Y,1)                                                  TIKLIN26

      CALL PLOT(XL,YT1,0)                                               TIKLIN27

      CALL PLOT(XL,YT1,1)                                               TIKLIN28

      END                                                               TIKLIN29











      SUBROUTINE PLTANOT(ID,FREQ,XMF,YMF,XL,YB,XR,YT                    PLTANOT2

     1    ,DEGS,LLAT,LLON,RLAT,RLON,ALTLOW,ALTHI,PLT,DTICH,DTICV,PLOT)  PLTANOT3

c

      implicit real*8 (a-h,o-z)

c

C     PUTS STANDARD ANNOTATIONS ON PLOTS                                PLTANOT4

C                                                                       PLTANOT5

      real*8 id 

      COMMON/LABCLT/PROJCT,THMIN,THMAX,RMIN,RMAX                        PLTANOT6

      REAL*8 LLAT,LLON                                                  PLTANOT7

      CHARACTER LABEL*80                                                PLTANOT8

      COMMON /DD/ INT,IOR,IT,IS,IC,ICC,IX,IY                            PLTANOT9

C     COMMON DECK "ANNOT" INSERTED HERE                                 ANNOT  2

      CHARACTER*10 ANOTES,HNOTES                                        ANNOT  4

      COMMON/ANNCTL/LENA(4),LENHA(3)                                    ANNOT  5

      COMMON/ANNCTC/ANOTES(2,4),HNOTES(4,3)                             ANNOT  6

      CHARACTER*8 IDTOO

C                                                                       PLTANO11

      IF(PLT.EQ.2. .OR. XMF.LE.0.0 .OR. YMF.LE.0.0) GO TO 45            PLTANO12

      CALL PLOT(XL+XMF*(XR-XL),YB+YMF*(YT-YB),1)                        PLTANO13

      IF(FREQ.LE.0.0) GO TO 30                                          PLTANO14

C                                                                       PLTANO15

      WRITE(LABEL,25) FREQ                                              PLTANO16

25    FORMAT('FREQ =',F9.3)                                             PLTANO17

      CALL DDTEXT(2,LABEL)                                              PLTANO18

      IY=IY+40                                                          PLTANO19

C                                                                       PLTANO20

      IDTOO = ID

30    WRITE(LABEL,35) IDTOO                                             PLTANO21

35    FORMAT('MODEL = ',A3)                                             PLTANO22

      CALL DDTEXT(2,LABEL)                                              PLTANO23

C                                                                       PLTANO24

45    NSPY=97                                                           PLTANO25

      IOR=0                                                             PLTANO26

C                                                                       PLTANO27

C FIRST THE LOW ALTITUDE-LATITUDE ANNOTATION                            PLTANO28

50    CALL PLOT(XL,YB,1)                                                PLTANO29

      IX=IX-155                                                         PLTANO30

      IY=IY-NSPY                                                        PLTANO31

      WRITE(LABEL,1840) DEGS*LLON                                       PLTANO32

      CALL DDTEXT(2,LABEL)                                              PLTANO33

      WRITE(LABEL,1850) DEGS*LLAT                                       PLTANO34

      IY=IY-32                                                          PLTANO35

      CALL DDTEXT(2,LABEL)                                              PLTANO36

C                                                                       PLTANO37

C NEXT THE RIGHT LATITUDE ANNOTATION                                    PLTANO38

      CALL PLOT(XR,YB,1)                                                PLTANO39

      IX=IX-130                                                         PLTANO40

      IY=IY-NSPY                                                        PLTANO41

      WRITE(LABEL,1840) DEGS*RLON                                       PLTANO42

      CALL DDTEXT(2,LABEL)                                              PLTANO43

      WRITE(LABEL,1850) DEGS*RLAT                                       PLTANO44

      IY=IY-32                                                          PLTANO45

      CALL DDTEXT(2,LABEL)                                              PLTANO46

C                                                                       PLTANO47

      XMID=(XL+XR)/2.0                                                  PLTANO48

      IF(PLT.EQ.2.0) GO TO 55                                           PLTANO49

C                                                                       PLTANO50

C PUT THE HORIZONTAL TIC LABEL                                          PLTANO51

      Y=YT                                                              PLTANO52

      IF(ALTLOW.GE.0.0) Y=YB                                            PLTANO53

      CALL PLOT(XMID,Y,1)                                               PLTANO54

C                                                                       PLTANO55

      IF(ALTLOW.LT.0.0) IY=IY+80                                        PLTANO56

      IF(ALTLOW.GE.0.0) IY=IY-95                                        PLTANO57

      GO TO 60                                                          PLTANO58

C                                                                       PLTANO59

55    CALL PLOT(XMID,YB,1)                                              PLTANO60

      IY=IY-95                                                          PLTANO61

C                                                                       PLTANO62

60    IX=IX-235                                                         PLTANO63

      NOTEA=1                                                           PLTANO64

      TMP=(THMAX-THMIN)*DEGS                                            PLTANO65

      IF(TMP.GT.10.) NOTEA=2                                            PLTANO66

C                                                                       PLTANO67

      CALL DDTEXT (LENHA(NOTEA),HNOTES(1,NOTEA))                        PLTANO68

C                                                                       PLTANO69

C PUT THE VERTICAL TIC LABEL                                            PLTANO70

      CALL PLOT(XL,(YB+YT)/2.0,1)                                       PLTANO71

      IOR=1                                                             PLTANO72

      IF(PLT.NE.2.) GO TO 100                                           PLTANO73

C                                                                       PLTANO74

C   HORIZONTAL PLOT  PUT Y-AXIS ANNOTATION                              PLTANO75

C                                                                       PLTANO76

      IX=IX-125                                                         PLTANO77

      IY=200                                                            PLTANO78

      CALL DDTEXT (LENHA(3),HNOTES(1,3))                                PLTANO79

      GO TO 200                                                         PLTANO80

C                                                                       PLTANO81

100   IX=IX-125                                                         PLTANO82

      IY=IY-75                                                          PLTANO83

      NOTEA=1                                                           PLTANO84

      IF(ALTLOW.GE.0.0) NOTEA=3                                         PLTANO85

      IF(DABS(ALTHI-ALTLOW).GE.1.) NOTEA=NOTEA+1                        PLTANO86

      CALL DDTEXT (LENA(NOTEA),ANOTES(1,NOTEA))                         PLTANO87

C                                                                       PLTANO88

200   IOR=0                                                             PLTANO89

1840  FORMAT(F7.2,' DEG E.')                                            PLTANO90

1850  FORMAT(F7.2,' DEG N.')                                            PLTANO91

C                                                                       PLTANO92

      END                                                               PLTANO93











      SUBROUTINE DRAWTKS(DTICH,DTICV,XLPR,XR,YBPR,YT,PLOT)              DRAWTKS2

c

      implicit real*8 (a-h,o-z)

c

C                                                                       DRAWTKS3

C     HORIZONTAL PLOT PROJECTION SUPPORT ROUTINE.                       DRAWTKS4

C     DRAW BOUNDARY TO PLOT AREA, TICS AND TIC LABELS.                  DRAWTKS5

C                                                                       DRAWTKS6

      EXTERNAL PLOT                                                     DRAWTKS7

C                                                                       DRAWTKS8

      XL=XLPR                                                           DRAWTKS9

      YB=YBPR                                                           DRAWTK10

      YMID=.5*(YB+YT)                                                   DRAWTK11

      TICX=.01*(YT-YB)                                                  DRAWTK12

      TICY=.01*(XR-XL)                                                  DRAWTK13

      YBP=YB                                                            DRAWTK14

      IF(DTICV.GT.0.) YBP=YMID-DINT((YMID-YB)/DTICV)*DTICV              DRAWTK15

C                                                                       DRAWTK16

      NTICX=(XR-XL)/DTICH                                               DRAWTK17

      NTICY=1                                                           DRAWTK18

      IF(DTICV.GT.0.) NTICY=(YT-YBP+DTICV)/DTICV                        DRAWTK19

C&     PRINT *,"DRAWTKS ",XLPR,XR,YBPR,YBP,YT,DTICH,DTICV,NTICX,NTICY   DRAWTK20

      IOF=0                                                             DRAWTK21

C                                                                       DRAWTK22

C     TWO PASSES BOTTOM AND LEFT THEN TOP AND RIGHT                     DRAWTK23

      DO 100 J=1,2                                                      DRAWTK24

      CALL PLOT(XL,YBPR,1)                                              DRAWTK25

      DO 30 I=1,NTICY                                                   DRAWTK26

      Y=YBP+(I-1)*DTICV                                                 DRAWTK27

      CALL PLOT(XL,Y,0)                                                 DRAWTK28

      CALL PLOT(XL+TICY,Y,0)                                            DRAWTK29

30    CALL PLTANH(XL,Y,IOF+2,PLOT)                                      DRAWTK30

      CALL PLOT(XL,YT,0)                                                DRAWTK31

C                                                                       DRAWTK32

      CALL PLOT(XLPR,YB,1)                                              DRAWTK33

C                                                                       DRAWTK34

      DO 40 I=1,NTICX                                                   DRAWTK35

      X=XLPR+I*DTICH                                                    DRAWTK36

      CALL PLOT(X,YB,0)                                                 DRAWTK37

      CALL PLOT(X,YB+TICX,0)                                            DRAWTK38

      CALL PLTANH(X,YB,IOF+1,PLOT)                                      DRAWTK39

40    CALL PLOT(X,YB,1)                                                 DRAWTK40

      CALL PLOT(XR,YB,0)                                                DRAWTK41

      YB=YT                                                             DRAWTK42

      XL=XR                                                             DRAWTK43

      TICX=-TICX                                                        DRAWTK44

      TICY=-TICY                                                        DRAWTK45

100   IOF=10                                                            DRAWTK46

C                                                                       DRAWTK47

      CALL PLOT(XLPR,YMID,1)                                            DRAWTK48

      CALL PLOT(XR,YMID,0)                                              DRAWTK49

      END                                                               DRAWTK50











      SUBROUTINE PLTLB(X,PY,NCP)                                        PLTLB  2

c

      implicit real*8 (a-h,o-z)

c

C     PUT VERTICAL TIC ANNOTATIONS ON RAY PLOT                          PLTLB  3

C     THIS IS A SPECIAL PURPOSE SUBSTITUTE FOR THE 'PLOT' ROUTINE       PLTLB  4

C     IT COMPUTES THE NEAREST ROUNDED TIC POSITIONS FOR VERTICAL LINES. PLTLB  5

C     WHEN THE NC PARAMETER IS > 0 AN ANNOTATION IS GENERATED           PLTLB  6

C     AT THE TIC POSITION. THE ADDITIONAL NC VALUE < 0 ALLOWS FOR       PLTLB  7

C     SIMPLE PEN UP MOTION TO THE X,Y POSITION.                         PLTLB  8

C                                                                       PLTLB  9

      CHARACTER ANNOT*10                                                PLTLB 10

C                                                                       PLTLB 11

C     COMMON DECK "WWR" INSERTED HERE                                   CWWR   2

      PARAMETER (NWARSZ=1000)                                           CWW1   3

      real*8 id

      COMMON/WW/ID(10),MAXW,W(NWARSZ)                                   CWW1   4

      REAL*8 MAXSTP,MAXERR,INTYP,LLAT,LLON                              CWW2   2

      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),    CWW2   3

     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),      CWW2   4

     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),          CWW2   5

     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),         CWW2   6

     8 (RCVRH,W(20)),                                                   CWW2   7

     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))CWW2   8

     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),                      CWW2   9

     6 (HMIN,W(27)),(RGMAX,W(28)),                                      CWW2  10

     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),                     CWW2  11

     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),       CWW2  12

     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))        CWW2  13

     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),        CWW2  14

     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))              CWW2  15

     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))                   CWW2  16

      COMMON /DD/ IINT,IOR,IT,IS,IC,ICC,IX,IY                           PLTLB 13

      COMMON/LABCLT/PROJCT,THMIN,THMAX,RMIN,RMAX                        PLTLB 14

C                                                                       PLTLB 15

      DATA LIY/-100/                                                    PLTLB 16

C                                                                       PLTLB 17

      NC=NCP                                                            PLTLB 18

      GO TO 10                                                          PLTLB 19

C                                                                       PLTLB 20

      ENTRY PLTLBN(X,PY,NCP)                                            PLTLB 21

      NC=0                                                              PLTLB 22

C                                                                       PLTLB 23

10    Y=PY                                                              PLTLB 24

C                                                                       PLTLB 25

      IF(NCP.LT.0) GO TO 200                                            PLTLB 26

      F=1.                                                              PLTLB 27

      IF(DMAX1(DABS(RMAX-EARTHR),DABS(RMIN-EARTHR)).LT.1.) F=1000.      PLTLB 28

      Y=INT((Y-EARTHR)*F)/F+EARTHR                                      PLTLB 29

      IF(NC.EQ.0) GO TO 100                                             PLTLB 30

C                                                                       PLTLB 31

      V=Y                                                               PLTLB 32

      IF(PROJCT.EQ.3.) V=RMIN+(Y-RMIN)/PFACTR                           PLTLB 33

      IF(DABS(DINT(TICV*F)-TICV*F).GT..001) GO TO 60                    PLTLB 34

C                                                                       PLTLB 35

      WRITE(ANNOT,50) INT(DABS(V-EARTHR)*F)                             PLTLB 36

50    FORMAT(I3)                                                        PLTLB 37

      GO TO 90                                                          PLTLB 38

C                                                                       PLTLB 39

60    WRITE(ANNOT,80) DABS(V-EARTHR)*F                                  PLTLB 40

80    FORMAT(F6.2)                                                      PLTLB 41

C                                                                       PLTLB 42

90    CALL PLOT(X,PY,1)                                                 PLTLB 43

      CALL PLOT(X,Y,1)                                                  PLTLB 44

C     INSURE THAT OVERLAPS OF ANNOTATIONS DO NOT OCCUR                  PLTLB 45

      IF(IABS(IY-LIY).LT.80) GO TO 100                                  PLTLB 46

      LIY=IY                                                            PLTLB 47

      IX=IX-100                                                         PLTLB 48

      IOR=0                                                             PLTLB 49

      CALL DDTEXT(1,ANNOT)                                              PLTLB 50

C                                                                       PLTLB 51

100   CALL PLOT(X,Y,NC)                                                 PLTLB 52

      RETURN                                                            PLTLB 53

C                                                                       PLTLB 54

200   CALL PLOT(X,Y,1)                                                  PLTLB 55

      RETURN                                                            PLTLB 56

      END                                                               PLTLB 57











      SUBROUTINE ARCTIC(THMIN,THMAX,HEIGHT,TICY,PLOT)                   ARCTIC 2

c

      implicit real*8 (a-h,o-z)

c

C     DRAW RANGE AXIS IN RAY TRACE PLOT. INCLUDES ANY CURVILINEAR       ARCTIC 3

C     PROJECTIONS PROVIDED IN DDGRAPH.                                  ARCTIC 4

C     COMMON DECK "WWR" INSERTED HERE                                   CWWR   2

      PARAMETER (NWARSZ=1000)                                           CWW1   3

      real*8 id

      COMMON/WW/ID(10),MAXW,W(NWARSZ)                                   CWW1   4

      REAL*8 MAXSTP,MAXERR,INTYP,LLAT,LLON                              CWW2   2

      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),    CWW2   3

     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),      CWW2   4

     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),          CWW2   5

     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),         CWW2   6

     8 (RCVRH,W(20)),                                                   CWW2   7

     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))CWW2   8

     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),                      CWW2   9

     6 (HMIN,W(27)),(RGMAX,W(28)),                                      CWW2  10

     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),                     CWW2  11

     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),       CWW2  12

     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))        CWW2  13

     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),        CWW2  14

     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))              CWW2  15

     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))                   CWW2  16

      COMMON /DDSCALE/ XMIN,XMAX,YMIN,YMAX,MINX,MAXX,MINY,MAXY,SCX,SCY, ARCTIC 6

     1 NSCX,NXCY,MSCX,MSCY,ISCX,ISCY                                    ARCTIC 7

C                                                                       ARCTIC 8

      NTIC=2                                                            ARCTIC 9

      IF(TIC.NE.0.) NTIC=1+(THMAX-THMIN)/TIC                            ARCTIC10

      NLINE=MAX0(2,100/NTIC)                                            ARCTIC11

C                                                                       ARCTIC12

      TICN=TIC/(NLINE-2)                                                ARCTIC13

      DO 10 I=1,NTIC                                                    ARCTIC14

      X=THMIN+(I-1)*TIC                                                 ARCTIC15

      CALL PLOT(X,HEIGHT+TICY,1)                                        ARCTIC16

      DO 10 J=2,NLINE                                                   ARCTIC17

      XJ=X+(J-2)*TICN                                                   ARCTIC18

      IF(XJ.GT.THMAX) GO TO 15                                          ARCTIC19

10    CALL PLOT(XJ,HEIGHT,0)                                            ARCTIC20

C                                                                       ARCTIC21

15    CALL PLOT(THMAX,HEIGHT,0)                                         ARCTIC22

      CALL PLOT(THMAX,HEIGHT+TICY,1)                                    ARCTIC23

      RETURN                                                            ARCTIC24

      END                                                               ARCTIC25











      BLOCK DATA PLOTBL                                                 PLOTBL 2

c

      implicit real*8 (a-h,o-z)

c

C     BLOCK DATA INITIALIZING PLOT ROUTINE COUNTERS AND                 PLOTBL 3

C     EXTREME VALUES VARIABLES.                                         PLOTBL 4

      COMMON/KNKN/KNBP,KNVC,KNDT                                        PLOTBL 5

      COMMON/DDLIM/MXIX,MXIY,MNIX,MNIY                                  PLOTBL 6

      DATA MXIX,MXIY,MNIX,MNIY/2*-1000,2*1000/                          PLOTBL 7

      DATA KNBP,KNVC,KNDT/3*0/                                          PLOTBL 8

      END                                                               PLOTBL 9











      SUBROUTINE DDINIT(N,TEXT)                                         DDINIT 2

c

      implicit real*8 (a-h,o-z)

c

C     INITIALIZES PLOTTING PROCESS(DDPLOT)                              DDINIT 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDINIT 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      CHARACTER TEXT*(*)                                                DDINIT 6

C                                                                       DDINIT 7

      DATA IDD/0/                                                       DDINIT 8

10    FORMAT(5A10)                                                      DDINIT 9

      IF(IDD.EQ.0) REWIND NDEVGRP                                       DDINIT10

      IDD=1                                                             DDINIT11

      WRITE(NDEVGRP) 0,0,0                                              DDINIT12

      WRITE(NDEVGRP) M,LEN(TEXT),TEXT                                   DDINIT13

      END                                                               DDINIT14











      SUBROUTINE DDBP                                                   DDBP   2

c

      implicit real*8 (a-h,o-z)

c

C     SETS A VECTOR ORIGIN(DDPLOT)                                      DDBP   3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDBP   4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      COMMON/DD/IN,IOR,IT,IS,IC,ICC,IX,IY                               DDBP   6

      COMMON/KNKN/KNBP,KNVC,KNDT                                        DDBP   7

      COMMON/DDLIM/MXIX,MXIY,MNIX,MNIY                                  DDBP   8

      MNIX=MIN0(MNIX,IX)                                                DDBP   9

      MXIX=MAX0(MXIX,IX)                                                DDBP  10

      MNIY=MIN0(MNIY,IY)                                                DDBP  11

      MXIY=MAX0(MXIY,IY)                                                DDBP  12

      IF(IX.LT.0.OR.IX.GT.1023.OR.IY.LT.0.OR.IY.GT.1023                 DDBP  13

     1  ) PRINT 10,'DDBP ',KNBP,IX,IY                                   DDBP  14

10    FORMAT(A10,3I5)                                                   DDBP  15

      KNBP=KNBP+1                                                       DDBP  16

      WRITE(NDEVGRP) 1,IX,IY                                            DDBP  17

      END                                                               DDBP  18











      SUBROUTINE DDVC                                                   DDVC   2

c

      implicit real*8 (a-h,o-z)

c

C     PLOTS A VECTOR(DDPLOT)                                            DDVC   3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDVC   4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      COMMON/DD/IN,IOR,IT,IS,IC,ICC,IX,IY                               DDVC   6

      COMMON/KNKN/KNBP,KNVC,KNDT                                        DDVC   7

      COMMON/DDLIM/MXIX,MXIY,MNIX,MNIY                                  DDVC   8

      MNIX=MIN0(MNIX,IX)                                                DDVC   9

      MXIX=MAX0(MXIX,IX)                                                DDVC  10

      MNIY=MIN0(MNIY,IY)                                                DDVC  11

      MXIY=MAX0(MXIY,IY)                                                DDVC  12

      IF(IX.LT.0.OR.IX.GT.1023.OR.IY.LT.0.OR.IY.GT.1023                 DDVC  13

     1  ) PRINT 10,'DDVC ',KNVC,IX,IY                                   DDVC  14

10    FORMAT(A10,3I5)                                                   DDVC  15

      KNVC=KNVC+1                                                       DDVC  16

      WRITE(NDEVGRP) 2,IX,IY                                            DDVC  17

      END                                                               DDVC  18











      SUBROUTINE DDTEXT(N,TEXT)                                         DDTEXT 2

c

      implicit real*8 (a-h,o-z)

c

C     WRITES A CHARACTER ARRAY PACKED A10(DDPLOT)                       DDTEXT 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDTEXT 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      CHARACTER TEXT*(*)                                                DDTEXT 6

      COMMON/DD/IN,IOR,IT,IS,IC,ICC,IX,IY                               DDTEXT 7

      COMMON/KNKN/KNBP,KNVC,KNDT                                        DDTEXT 8

100   FORMAT(A10,2I5,I2,1X,8A10)                                        DDTEXT 9

      KNDT=KNDT+1                                                       DDTEXT10

      WRITE(NDEVGRP) 3,IX,IY                                            DDTEXT11

      WRITE(NDEVGRP) IOR,N,N*10,(TEXT(I:I),I=1,N*10)                    DDTEXT12

      END                                                               DDTEXT13











      SUBROUTINE DDTAB                                                  DDTAB  2

C     INITIALIZES TABULAR PLOTTING(DDPLOT)                              DDTAB  3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDTAB  4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      END                                                               DDTAB  6











      SUBROUTINE DDFR                                                   DDFR   2

C     ADVANCE ONE PLOTTING FRAME(DDPLOT)                                DDFR   3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDFR   4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

10    FORMAT(A10)                                                       DDFR   6

      WRITE(NDEVGRP) -2,0,0                                             DDFR   7

      END                                                               DDFR   8











      SUBROUTINE DDEND                                                  DDEND  2

C     EMPTIES PLOT BUFFER AND RELEASES PLOTTING COMMAND FILE(DDPLOT)    DDEND  3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DDEND  4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      COMMON/KNKN/KNBP,KNVC,KNDT                                        DDEND  6

      COMMON/DDLIM/MXIX,MXIY,MNIX,MNIY                                  DDEND  7

10    FORMAT(3A10,5I5)                                                  DDEND  8

      WRITE(NDEVGRP) -1,0,0                                             DDEND  9

      END                                                               DDEND 10











      SUBROUTINE DASH                                                   DASH   2

C     ACTIVATE DASHED LINE CONNECTIONS(DISSPLA)                         DASH   3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           DASH   4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      WRITE(NDEVGRP) 37,0,0                                             DASH   6

      END                                                               DASH   7











      SUBROUTINE RESET(S)                                               RESET  2

C     RESETS AN OPTION TO ITS DEFAULT VALUE(DISSPLA)                    RESET  3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           RESET  4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      CHARACTER S*10                                                    RESET  6

      WRITE(NDEVGRP) 38,0,0                                             RESET  7

      WRITE(NDEVGRP) S                                                  RESET  8

      END                                                               RESET  9











      SUBROUTINE HEIGHT(H)                                              HEIGHT 2

C     SETS REFERENCE CHARACTER HEIGHT IN INCHES(DISSPLA)                HEIGHT 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           HEIGHT 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      WRITE(NDEVGRP) 13,H,0                                             HEIGHT 6

      END                                                               HEIGHT 7











      SUBROUTINE MX1ALF(T1,T2)                                          MX1ALF 2

C     SPECIFY USE OF ALTERNATE CHARACTER SET NUMBER 1(DISSPLA)          MX1ALF 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           MX1ALF 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      WRITE(NDEVGRP) 11,T1,T2                                           MX1ALF 6

      END                                                               MX1ALF 7











      SUBROUTINE MX2ALF(T1,T2)                                          MX2ALF 2

C     SPECIFY USE OF ALTERNATE CHARACTER SET NUMBER 2(DISSPLA)          MX2ALF 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           MX2ALF 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      WRITE(NDEVGRP) 12,T1,T2                                           MX2ALF 6

      END                                                               MX2ALF 7











      SUBROUTINE SCMPLX                                                 SCMPLX 2

C     SPECIFY USE OF SIMPLEX CHARACTER SET(DISSPLA)                     SCMPLX 3

C     WRITE PARAMETERS TO GRAPHICS CALLS FILE                           SCMPLX 4

C     COMMON DECK "RAYDEV" INSERTED HERE                                CRAYDEV2

C     DEVICE ASSIGNED TO RAYTRC INPUT FILE                              CRAYDEV4

      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN               CRAYDEV5

      WRITE(NDEVGRP) 10,0,0                                             SCMPLX 6

      end

