      SUBROUTINE PRFPLT(PLTMODE,FINIT,FUNX,FUNY,TLTS,NPTS,MAP,WORK

     1    ,FGEN,XPLT,YPLT,MARK)

C

C     'PRFPLT' IS A MULTI-FUNCTION GRAPHICAL SUPPORT ROUTINE TO AID IN

C     THE PRODUCTION OF ANNOTATED MULTI-TRACE X-Y PLOTS.

C     TO MORE EASILY CONTROL OPTIONS THE ARRAY 'PLTMODE' CONTAINS

C     A SET OF LOGICAL FLAGS WHICH WILL BE 'EXECUTED' IN THIS

C     PASS THROUGH 'PRFPLT'. THE FOLLOWING LIST OF FLAGS ARE

C     CURRENTLY IMPLEMENTED.

C

C      NFILL

C           CAUSES WORK ARRAY TO BE FILLED WITH VALUES OBTAINED BY CALL

C           TO EXTERNAL FUNCTIONS:

C             'FINIT' INITIALIZE FUNCTION.  FINIT HAS THE VALUE OF

C                     AN ENTRY POINT IN 'PRFSUP',E.G. ISPEDV.

C             'FUNX'  COMPUTE X-VALUES as for FINIT.

C             'FUNY'  COMPUTE Y-VALUES as for FINIT.

C      INISCX

C           CAUSES X SCALING ARRAY 'XPLT' TO BE INITIALIZED TO +-INFINI

C      INISCY

C           CAUSES Y SCALING ARRAY 'YPLT' TO BE INITIALIZED TO +-INFINI

C      NSCALE

C           CAUSES EXTREME X-Y VALUES TO BE DETERMINED SO THAT NO POINT

C           WILL BE OUT OF RANGE. MANUALLY SPECIFIED VALUES WILL NOT BE

C           OVERWRITTEN PROVIDED THEY ARE SUFFICIENT TO

C           INCLUDE ALL DATA VALUES.

C      INSFRAM

C           INSERT A FRAME IN THE GRAPHICS OUTPUT

C      NORMPLT

C           NORMAL PLOT. THIS WILL INCLUDE AUTOSCALING IF THE INCREMENT

C           VALUE USED FOR AXIS ANNOTATION IS GIVEN AS ZERO. IF EXTREME

C           VALUES ARE GIVEN BUT INCREMENT IS ZERO, AUTOSCALING WILL BE

C           USED TO DETERMINE THE INCREMENT AND SUBTICK INTERVAL

C           BUT WILL NOT DETERMINE EXTREME VALUES.

C      ENDFRAM

C           CAUSES A FINAL END FRAME TO BE OUTPUT TO GRAPHICS FILE.

C      ENDPLOT

C           COMPLETES OUTPUT TO GRAPHICS FILE, TERMINATING PLOTS.

C      NXSNEG, NYSNEG

C           FOR SUBROUTINE SUPNEG.  DETERMINES HOW MANY AXIS VALUES

C           ARE NEGATIVE.  ONLY FOR DISSPLA PACKAGE.

C

      implicit double precision (a-h,o-z)



      character*80 id

      common /ident/ id

      CHARACTER*(*) TLTS(4)

      INTEGER MAP(2)

      DOUBLE PRECISION WORK(NPTS,2),FGEN(5),XPLT(3),YPLT(3)

C

      LOGICAL PLTMODE(12), NOTSET

C

      LOGICAL PSTART,FSTART

C

      INTEGER NFILL, INISCX, INISCY, NSCALE, INPLT, INSFRAM, NORMPLT,

     &        ENDFRAM, ENDPLOT, NFULL, NXSNEG, NYSNEG



      PARAMETER (NFILL=1,INISCX=2,INISCY=3,NSCALE=4,INPLT=5,INSFRAM=6,

     &           NORMPLT=7,ENDFRAM=8,ENDPLOT=9,NFULL=10,NXSNEG=11,

     &           NYSNEG=12)



      DATA PSTART,FSTART/2*.TRUE./

      DATA BIG/1.E38/

C

C

C*****CHECK TO SEE IF ANY OF THE ELEMENTS OF "PLTMODE" ARE SET TO TRUE.

C

      NOTSET = .TRUE.

      DO 10 I=1,12

         IF (PLTMODE(I)) NOTSET = .FALSE.

10    CONTINUE

      IF (NOTSET) PLTMODE(NFULL) = .TRUE.

C

C.....Calculate the values and fill WORK array with the values to be plotted.

C     NOTE:  This is where the models are called i.e. FUNX and FUNY which

C            calculate the speeds.

C

      IF (PLTMODE(NFILL)) THEN

	 IF(NPTS.LT.2) STOP 'ERROR: Less than 2 data points.'

         CALL FINIT(FGEN(5),TLTS(1),TLTS(2),TLTS(4))

         DD=(FGEN(2)-FGEN(1))/(NPTS-1)

         DO 100 I=0,NPTS-1

            F=FGEN(1)+DD*I

	    WORK(I+1,1)=dINT(FUNX(F)*FGEN(3)*1.E5+.5)*1.E-5

            WORK(I+1,2)=FUNY(F)*FGEN(4)

100         continue

      ENDIF

C

      IF (PLTMODE(INISCX)) THEN

         XPLT(1)=BIG

         XPLT(2)=-BIG

         XPLT(3)=0.0

      ENDIF

C

      IF (PLTMODE(INISCY)) THEN

         YPLT(1)=BIG

         YPLT(2)=-BIG

         YPLT(3)=0.0

      ENDIF

C

      XPN=XPLT(1)

      XPX=XPLT(2)

      YPN=YPLT(1)

      YPX=YPLT(2)

      IF (PLTMODE(NSCALE) .and. PLTMODE(iniscx)) THEN

         CALL VMNMX(WORK(1,MAP(1)),NPTS,XPLT(1),XPLT(2))

      endif

      if (PLTMODE(nscale) .and. PLTMODE(iniscy)) then

         CALL VMNMX(WORK(1,MAP(2)),NPTS,YPLT(1),YPLT(2))

      endif

C

C

ccccc	  IF (.NOT. PLTMODE(INSFRAM)) THEN

ccccc	     IF(XPN.GT.XPLT(1) .OR. XPX.LT.XPLT(2))

ccccc	1		 STOP 'ERROR:  Value in X array out of range'

ccccc	     IF(YPN.GT.YPLT(1) .OR. YPX.LT.YPLT(2))

ccccc	1		 STOP 'ERROR:  Value in Y array out of range'

ccccc	  ENDIF

C



      IF(PSTART) THEN

         CALL PLTINI

         PSTART=.FALSE.

      ENDIF

C

      IF (PLTMODE(INSFRAM)) THEN

         IF(.NOT.FSTART) CALL ENDPL(0)

C

C*****THE 100 IS NOT THE LENGTH OF THE CHAR STRING.  IT INDICATES THAT

C*****THE STRING IS TERMINATED BY A '$'.  JAH.

C

	 CALL TITLXY(TLTS(1),100,TLTS(2),100,TLTS(3),100,XAXIS,YAXIS)

         FSTART=.FALSE.

      ENDIF

C

      IF (PLTMODE(NORMPLT)) THEN

         IF(XPLT(3).LE.0.0) THEN

            CALL PSCALE(XPLT(1),XPLT(2),XPLT(3),NXTKS,XAXIS)



            IF(XPX.GT.XPN) THEN

                XPLT(1)=XPN

                XPLT(2)=XPX

            ENDIF

            CALL XTICKS(NXTKS)

         ENDIF

         IF(YPLT(3).LE.0.0) THEN

            CALL PSCALE(YPLT(1),YPLT(2),YPLT(3),NYTKS,YAXIS)

            IF(YPX.GT.YPN) THEN

                YPLT(1)=YPN

                YPLT(2)=YPX

            ENDIF

            CALL YTICKS(NYTKS)

         ENDIF

C

C.....Output the subheading before writing the data for the curve.

C     Subheading is ID in COMMON IDENT.  See READW for more.  It

C     contains additional user-supplied information about the particular plot.



         call ddtext(8,id)



         IF (PLTMODE(INSFRAM)) THEN

            NMBXS=1.5+(XPLT(2)-XPLT(1))/XPLT(3)

            NMBYS=1.5+(YPLT(2)-YPLT(1))/YPLT(3)

            NMBS=0

            IF (PLTMODE(NYSNEG)) THEN

               IDEL=NMBXS

               NMBS=NMBYS

            ENDIF

            IF (PLTMODE(NXSNEG)) THEN

               IDEL=0

               NMBS=NMBS+NMBXS

            ENDIF

            IF(NMBS.GT.0) CALL SUPNEG(IDEL,NMBS)

            CALL GRAFB(XPLT(1),XPLT(3),XPLT(2),YPLT(1),YPLT(3),YPLT(2))

         ENDIF

         MRK=0

         IF(MARK.LT.0) MRK=-1

C     DISSPLA CONVENTION IS TO AUTO-STEP THE MARKER SYMBOL.

C

         CALL CURVE(WORK(1,MAP(1)),WORK(1,MAP(2)),NPTS,MRK)

      ENDIF

C

      IF (PLTMODE(ENDFRAM) .AND. .NOT.FSTART) THEN

         CALL ENDPL(0)

         FSTART=.TRUE.

      ENDIF

C

      IF (PLTMODE(ENDPLOT) .AND. .NOT.PSTART) THEN

         CALL DONEPL

         PSTART=.TRUE.

      ENDIF

      END

C----------------------------------------------------------------------------

      INTEGER FUNCTION PRFSUP()

      implicit double precision (a-h,o-z)



C     COMMON DECK "UU" INSERTED HERE

      DOUBLE PRECISION MODU

      COMMON/UU/MODU(4)

     1  ,V  ,PVT  ,PVR  ,PVTH  ,PVPH

     2  ,VR ,PVRT ,PVRR ,PVRTH ,PVRPH

     3  ,VTH,PVTHT,PVTHR,PVTHTH,PVTHPH

     4  ,VPH,PVPHT,PVPHR,PVPHTH,PVPHPH

C     COMMON DECK "B1" INSERTED HERE

      INTEGER UMX,UNTBL,UITBL,UFRMTBL,IDSU(10)

      COMMON/B1/UMX,UNTBL(10),UITBL(10),UFRMTBL(10),UGP(10)

      EQUIVALENCE (UGP,IDSU)

C     COMMON DECK "CC" INSERTED HERE

      DOUBLE PRECISION MODC

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

C     COMMON DECK "B3" INSERTED HERE

      INTEGER CMX,CNTBL,CITBL,CFRMTBL,IDSC(10)

      COMMON/B3/CMX,CNTBL(10),CITBL(10),CFRMTBL(10),CGP(512)

      EQUIVALENCE (CGP,IDSC),(ANC,CGP(11))

C     COMMON DECK "TT" INSERTED HERE

      DOUBLE PRECISION MODT

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

C     COMMON DECK "B5" INSERTED HERE

      INTEGER TMX,TNTBL,TITBL,TFRMTBL,IDST(10)

      COMMON/B5/TMX,TNTBL(10),TITBL(10),TFRMTBL(10),TGP(262)

      EQUIVALENCE (TGP,IDST),(ANT,TGP(11))

C     COMMON DECK "CONST" INSERTED HERE

      COMMON/PCONST/CREF,RGAS,GAMMA

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

C     COMMON DECK "GG" INSERTED HERE

      DOUBLE PRECISION MODG

      COMMON/GG/MODG(4)

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

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

C     COMMON DECK "RKAM" INSERTED HERE

      DOUBLE PRECISION KR,KTH,KPH

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

C     COMMON DECK "WWR" INSERTED HERE

      PARAMETER (NWARSZ=1000) 

      COMMON/WW/ dum(10), MAXW,W(NWARSZ)

      DOUBLE PRECISION MAXSTP,MAXERR,INTYP,LLAT,LLON

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

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

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

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

     8   (RUNSUP,W(18)),(RCVRH,W(20)),

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

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

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

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

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

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

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

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

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

C

C     COMMON DECK "CPROCFL" INSERTED HERE

      INTEGER PMX,PNTBL,PITBL,PFRMTBL,IDSP(10)

C     PARAMETER DECK "PGROUPS"

      PARAMETER (NCHPG1=11,NWPV=250,NSPGP=NCHPG1+2*NWPV+1)

      PARAMETER (MNGRP=9,MXGRP=69,MXLIST=MXGRP-MNGRP+2)

      COMMON/PROCFL/LIST(MXLIST)

      COMMON/PROCFL/PMX,PNTBL(10),PITBL(10),PFRMTBL(10),PGP(NSPGP)

      EQUIVALENCE (PGP,IDSP)

C

      CHARACTER ITOC*7

      CHARACTER*40 TLTP,TLTY,TLTL

      INTEGER STRIM

C

      CALL ITOPOG

      R=EARTHR

      TH=PID2-LLAT

      PH=LLON

      PRFSUP=0

      RETURN

C

      ENTRY ISPEDV(X,TLTP,TLTY,TLTL)

      CALL ISPEED

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODC

      CALL ANNFIL('S#OUND !S#PEED ('//TLTY(:STRIM(TLTY))//'/SEC!)'

     1         ,TLTY)

C*****CHANGED 10a8 TO 10a4.

      WRITE(TLTL,'(10A4)') (CGP(I),I=1,10)

      ISPEDV=1

      RETURN

C

      ENTRY SPEEDV

      CALL SPEED

      SPEEDV=SQRT(CS)

      RETURN

C

      ENTRY IWINDV(X,TLTP,TLTY,TLTL)

      CALL IWINDR

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODU

      CALL ANNFIL('C#URRENT !S#PEED ('//TLTY(:STRIM(TLTY))//'/SEC!)'

     1       ,TLTY)

C*****CHANGED 10A8 TO 10A4

      WRITE(TLTL,'(10A4)') (UGP(I),I=1,10)

      IWINDV=1

      RETURN



      ENTRY IEASTV(X,TLTP,TLTY,TLTL)

      CALL IWINDR

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODU

C*****CHANGED 10A8 TO 10A4

      call ANNFIL('E#ASTWARD !C#URRENT !C#OMP.('

     &		  //TLTY(:STRIM(TLTY))//'/SEC!)'

     &		   ,TLTY)

      WRITE(TLTL,'(10A4)') (UGP(I),I=1,10)

      IEASTV=1

      RETURN



      ENTRY ISOUTV(X,TLTP,TLTY,TLTL)

      CALL IWINDR

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODU

C*****CHANGED 10A8 TO 10A4

      call ANNFIL ('S#OUTHWARD !C#URRENT !C#OMP.('

     &		   //TLTY(:STRIM(TLTY))//'/SEC!)'

     &		   ,TLTY)

      WRITE(TLTL,'(10A4)') (UGP(I),I=1,10)

      ISOUTV = 1

      RETURN



      ENTRY IVERTV(X,TLTP,TLTY,TLTL)

      CALL IWINDR

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODU

C*****CHANGED 10A8 TO 10A4

      call ANNFIL('V#ERTICAL !C#URRENT !C#OMP.('

     &		  //TLTY(:STRIM(TLTY))//'/SEC!)'

     &		   ,TLTY)

      WRITE(TLTL,'(10A4)') (UGP(I),I=1,10)

      IVERTV = 1

      RETURN



C

C Wind (or current) magnitude.



      ENTRY WNMAGV

      CALL WINDR

      WNMAGV=SQRT(VR*VR+VTH*VTH+VPH*VPH)

      RETURN



C Wind (or current) vertical component.



      ENTRY WNVRTV

      CALL WINDR

      WNVRTV=VR

      RETURN



C Wind (or current) southward component.



      ENTRY WNSTHV

      CALL WINDR

      WNSTHV=VTH

      RETURN



C Wind (or current) eastward component.



      ENTRY WNESTV

      CALL WINDR

      WNESTV=VPH

      RETURN

C

      ENTRY COLAT

      COLAT=PID2-TH

      RETURN

C

      ENTRY REARTH(X)

      R=X

      CALL TOPOG

      REARTH=R-EARTHR

      RETURN

C

      ENTRY ITEMPV(X,TLTP,TLTY,TLTL)

      CALL ITEMP

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODT

      CALL ANNFIL('T#EMPERATURE (DEGS !K)',TLTY)

C*****CHANGED 10A8 TO 10A4

      WRITE(TLTL,'(10A4)') (TGP(I),I=1,10)

      ITEMPV=1

      RETURN

C

      ENTRY TOPV(X)

      TH=X

      CALL TOPOG

      TOPV=-G/PGR

      RETURN

C

      ENTRY TEMPV(X)

      R=X

      CALL TEMP

      TEMPV=T

      RETURN

C

      ENTRY IPTPLT(X,TLTP,TLTY,TLTL)

      NP=X-(MNGRP-2)

C

C     INITIALIZE OFFSETS FOR X AND Y ARRAYS

C     NOTE:  If error message gives number of points = -7, that means that

C            X must be 0.0.



      IF(NP.LT.2 .OR. NP.GT.LIST(1)) then

     	   PRINT*,'ERROR: Invalid number of points in tabular data: ',np

           STOP

      endif

C

      TLTP='DATA POINT MODEL'//ITOC(NP+(MNGRP-2))

C

      NLN=LIST(NP)



      IF(NLN.LE.0) STOP 'ERROR: Invalid LIST (see PRFSUP routine).'

C

C*****NOTE:  THE LOOP FOR PGP IS 1 TO 10 SINCE NCHPG1=11 AND NLN=1

      WRITE(TLTL,'(10A4)') (PGP(I),I=NLN,NLN+(NCHPG1-2))

C

C     GET SET POINTER AND STEP OVER IDENTIFIER STRING

      NLN=NLN+(NCHPG1-1)

C

C     GET NUMBER OF AVAILABLE POINTS

      NPTS=PGP(NLN)

      N2=NPTS/2

      IPTPLT=N2

C     X VALUES ARE NEXT

      NLX=NLN+1

C     THEN Y VALUES

      NLY=NLX+N2

C     SET LAST AVAILABLE LIMIT

      NMX=NLY+N2

      RETURN

C

      ENTRY PTPLTX(X)

      N=NLX+X

      IF(N.LT.NLX .OR. N.GE.NLY)

     &	 STOP 'ERROR: Invalid index into X array'

      PTPLTX=PGP(N)

      RETURN

C

      ENTRY PTPLTY(X)

      N=NLY+X

      IF(N.LT.NLY .OR. N.GT.NMX)

     &	 STOP 'ERROR: Invalid index into Y array'

      PTPLTY=PGP(N)

      RETURN

C

      ENTRY ITOPV (X,TLTP,TLTY,TLTL)

      WRITE(TLTP,'(2(A8,F7.2,1X))') MODG

      tlty = '                         '

      CALL ANNFIL('R#ANGE !(K#M!)',TLTY)

      ITOPV=1

      RETURN

C

      END



