      FUNCTION READW (xxx)

C

C     READS W ARRAY MAKING ANY NECESSARY CONVERSION OF UNITS.

C     VARIABLE LENGTH 'TABULAR' DATA IS READ BY SUBROUTINE 'READW1'

C     WHICH IS CALLED FOR NEGATIVE W-ARRAY INDICES.

C

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



C     COMMON DECK "CONST" INSERTED HERE 

      COMMON/PCONST/CREF,RGAS,GAMMA

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

C     COMMON DECK "WWR" INSERTED HERE

      character*80 id

      common /ident/ id

      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     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 "B2" INSERTED HERE

      INTEGER DUMX,DUNTBL,DUITBL,DUFRMTB,IDSDU(10)

      COMMON/B2/DUMX,DUNTBL(10),DUITBL(10),DUFRMTB(10),DUGP(10)

      EQUIVALENCE (DUGP,IDSDU)

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 "B4" INSERTED HERE

      INTEGER DCMX,DCNTBL,DCITBL,DCFRMTB,IDSDC(10)

      COMMON/B4/DCMX,DCNTBL(10),DCITBL(10),DCFRMTB(10),DCGP(10)

      EQUIVALENCE (DCGP,IDSDC)

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 "B6" INSERTED HERE

      INTEGER DTMX,DTNTBL,DTITBL,DTFRMTB,IDSDT(10)

      COMMON/B6/DTMX,DTNTBL(10),DTITBL(10),DTFRMTB(10),DTGP(10)

      EQUIVALENCE (DTGP,IDSDT)

C     COMMON DECK "B7" INSERTED HERE

      INTEGER MMX,MNTBL,MITBL,MFRMTBL,IDSM(10)

      DOUBLE PRECISION MGP

      COMMON/B7/MMX,MNTBL(10),MITBL(10),MFRMTBL(10),MGP(10) 

      EQUIVALENCE (MGP,IDSM)

C     COMMON DECK "B9" INSERTED HERE

      INTEGER GMX,GNTBL,GITBL,GFRMTBL,IDSG(10)

      COMMON/B9/GMX,GNTBL(10),GITBL(10),GFRMTBL(10),GGP(113)

      EQUIVALENCE (GGP,IDSG),(ANG,GGP(11))

C

C     COMMON DECK "B10" INSERTED HERE

      INTEGER DGMX,DGNTBL,DGITBL,DGFRMTB,IDSDG(10)

      COMMON/B10/DGMX,DGNTBL(10),DGITBL(10),DGFRMTB(10),DGGP(10)

      EQUIVALENCE (DGGP,IDSDG)

C

C     COMMON DECK "B8" INSERTED HERE

      INTEGER RMX,RNTBL,RITBL,RFRMTBL,IDSR(10)

      COMMON/B8/RMX,RNTBL(10),RITBL(10),RFRMTBL(10),RGP(10) 

      EQUIVALENCE (RGP,IDSR)

C

C     COMMON DECK "CB11" INSERTED HERE

      INTEGER SMX,SNTBL,SITBL,SFRMTBL,IDSS(10)

      COMMON/B11/SMX,SNTBL(10),SITBL(10),SFRMTBL(10),SGP(11)

      EQUIVALENCE (SGP,IDSS),(ANS,SGP(11))

C     COMMON DECK "CB12" INSERTED HERE

      INTEGER DSMX,DSNTBL,DSITBL,DSFRMTB,IDSDS(10)

      COMMON/B12/DSMX,DSNTBL(10),DSITBL(10),DSFRMTB(10),DSGP(11)

      EQUIVALENCE (DSGP,IDSDS),(ANDS,DSGP(11))

C     COMMON DECK "CB17" INSERTED HERE

      INTEGER VMX,VNTBL,VITBL,VFRMTBL,IDSV(10)

      COMMON/B17/VMX,VNTBL(10),VITBL(10),VFRMTBL(10),VGP(53)

      EQUIVALENCE (VGP,IDSV),(ANV,VGP(11))

C     COMMON DECK "CB18" INSERTED HERE

      INTEGER DVMX,DVNTBL,DVITBL,DVFRMTB,IDSDV(10)

      COMMON/B18/DVMX,DVNTBL(10),DVITBL(10),DVFRMTB(10),DVGP(11)

      EQUIVALENCE (DVGP,IDSDV),(ANDV,DVGP(11))

C     COMMON DECK "CB19" INSERTED HERE

      INTEGER PRMX,PRNTBL,PRITBL,PRFRMTB,IDSPR(10)

      COMMON/B19/PRMX,PRNTBL(10),PRITBL(10),PRFRMTB(10),PRGP(11)

      EQUIVALENCE (PRGP,IDSPR),(ANP,PRGP(11))

C     COMMON DECK "CB20" INSERTED HERE

      INTEGER DPMX,DPNTBL,DPITBL,DPFRMTB,IDSDP(10)

      COMMON/B20/DPMX,DPNTBL(10),DPITBL(10),DPFRMTB(10),DPGP(11)

      EQUIVALENCE (DPGP,IDSDP),(ANDP,DPGP(11))

C

      PARAMETER (MXCMTS=83)

C*****, BIGVAL=1.E37)

      common /crmach/rmach(5)

      equivalence (bigval,rmach(5))



      CHARACTER*80 LINEX

      CHARACTER*100 STMP1

      INTEGER WCOMTS(MXCMTS)

      CHARACTER*1 DEG,KM,NM,FEET,CYCLE,PER,MSKMS

C

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

      LOGICAL NWOK,AB,UCON

C

C     COMMON DECK "FLAG" INSERTED HERE

      LOGICAL NEWWR,NEWWP,NEWTRC,PENET

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

      COMMON/FLGP/NSET

C

      INTEGER XMX,XNTBL(10),XITBL(10),XFRMTBL(10)

      DOUBLE PRECISION XGP(11)

C

      DATA XMX/2/

      DATA XNTBL/1,11,12,7*0/

      DATA XITBL/1,9*0/

      DATA XFRMTBL/1,2,8*0/

C

      DATA WCOMTS/MXCMTS*1/

C

      AB=.FALSE.

      READW=0.d0

C

      IF(NDEVTMP.GT.0) REWIND NDEVTMP

C

      READ(NRYIND,1000,IOSTAT=IOS) ID

      IF (IOS.GT.0) THEN

         PRINT*,'READ ERROR:  STATUS = ',IOS

	 STOP 'Check status code in FORTRAN Reference Manual.'

      ENDIF

1000	   FORMAT (A)



C.....Handle End-of-file.



      IF (IOS.LT.0) then



	   READW=1.d0

	   IF(NFRMAT.LT.0) RETURN

C

	   PRINT 1040

1040	   FORMAT(' END OF INPUT DATA')

	   CALL ENDPLT

	   IF(PLT.NE.0.0) CALL DDEND

	   STOP

      endif



      IF(NDEVTMP.GT.0) WRITE(NDEVTMP,1000) ID

C

C

40    READ(NRYIND,'(A)',END=10001) STMP1

C

      READ(STMP1,1100) NW,WWW,LINEX

1100  FORMAT (BZ,I3,E14.7,A)

      IF(NDEVTMP.GT.0.AND.(NFRMAT.NE.-2.OR.NW.LT.0))

     1      WRITE(NDEVTMP,'(A)') STMP1

ccccc       PRINT*,'NW = ',NW



C When NW = 0, the end of a set is indicated.  AB = FALSE indicates that

C everything is ok.



10001 IF (NW.EQ.0) then

	   readw=0.d0

	   IF(.NOT.AB) RETURN

	   PRINT 1200

1200  FORMAT(' A DATA FORMATTING ERROR PREVENTS CONTINUED EXECUTION')

	   STOP

      endif



      IF(NW.GT.MAXW) then

	   PRINT 4000, NW

4000	   FORMAT(I3,' IS AN INVALID VALUE FOR THE W-ARRAY.')

	   STOP

      endif

C

      IF (NW.LE.MAXW .AND. NW.GT.0) GO TO 50

C     TABULAR INPUT DATA

      NWOK=.FALSE.

C 'OPEN' THE TEMP FILE

1150  FORMAT(I3,T18,A)

      NWP=-NW

      IF(NFRMAT.EQ.-2) THEN

C     USE DUMMY ARRAYS TO ABSORB TABULAR DATA

         CALL READW1(AB,NWOK,NW,XMX,XNTBL,XITBL,XFRMTBL,XGP)

      ELSEIF(NWP.EQ.1) THEN

         CALL READW1(AB,NWOK,NW,UMX,UNTBL,UITBL,UFRMTBL,UGP)

      ELSEIF(NWP.EQ.2) THEN

         CALL READW1(AB,NWOK,NW,DUMX,DUNTBL,DUITBL,DUFRMTB,DUGP)

      ELSEIF(NWP.EQ.3) THEN

         CALL READW1(AB,NWOK,NW,CMX,CNTBL,CITBL,CFRMTBL,CGP)

      ELSEIF(NWP.EQ.4) THEN

         CALL READW1(AB,NWOK,NW,DCMX,DCNTBL,DCITBL,DCFRMTB,DCGP)

      ELSEIF(NWP.EQ.5) THEN

            CALL READW1(AB,NWOK,NW,TMX,TNTBL,TITBL,TFRMTBL,TGP)

      ELSEIF(NWP.EQ.6) THEN

         CALL READW1(AB,NWOK,NW,DTMX,DTNTBL,DTITBL,DTFRMTB,DTGP)

      ELSEIF(NWP.EQ.7) THEN

         CALL READW1(AB,NWOK,NW,MMX,MNTBL,MITBL,MFRMTBL,MGP)

      ELSEIF(NWP.EQ.8) THEN

         CALL READW1(AB,NWOK,NW,RMX,RNTBL,RITBL,RFRMTBL,RGP)

      ELSEIF(NWP.EQ.9) THEN

         CALL READW1(AB,NWOK,NW,GMX,GNTBL,GITBL,GFRMTBL,GGP)

      ELSEIF(NWP.EQ.10) THEN

         CALL READW1(AB,NWOK,NW,DGMX,DGNTBL,DGITBL,DGFRMTB,DGGP)

      ELSEIF(NWP.EQ.11) THEN

         CALL READW1(AB,NWOK,NW,SMX,SNTBL,SITBL,SFRMTBL,SGP)

      ELSEIF(NWP.EQ.12) THEN

         CALL READW1(AB,NWOK,NW,DSMX,DSNTBL,DSITBL,DSFRMTB,DSGP)

      ELSEIF(NWP.EQ.17) THEN

         CALL READW1(AB,NWOK,NW,VMX,VNTBL,VITBL,VFRMTBL,VGP)

      ELSEIF(NWP.EQ.18) THEN

         CALL READW1(AB,NWOK,NW,DVMX,DVNTBL,DVITBL,DVFRMTB,DVGP)

      ELSEIF(NWP.EQ.19) THEN

         CALL READW1(AB,NWOK,NW,PRMX,PRNTBL,PRITBL,PRFRMTB,PRGP)

      ELSEIF(NWP.EQ.20) THEN

         CALL READW1(AB,NWOK,NW,DPMX,DPNTBL,DPITBL,DPFRMTB,DPGP)

      ELSE

         CALL SREAD1(AB,NWOK,NW)

      ENDIF



      IF (NWOK) then

	   go to 40

      else

	   PRINT 4000, NW

      endif

C

C

50    READ(LINEX,777) DEG,KM,NM,FEET,CYCLE,PER,MSKMS

777   FORMAT(7A)

ccccc	    PRINT*,'WWW = ',WWW



      W(NW)=WWW

C

C     CHECK FOR A 'TERRAIN RELATIVE' HEIGHT SPECIFICATION.

C     IF SO ADD FLAG VALUE 10**40 TO BE TESTED FOR LATER IN 'RAYTRC'

C

C*****Don't set the flags for Profile data (NW = 90).



      if (nw .ne. 90) then

	   IF(MSKMS.EQ.'T' .AND. WWW.EQ.0.0) W(NW)=1.E-38

	   IF(WWW.EQ.0.0) GO TO 40

	   IF(MSKMS.EQ.'T') WWW=WWW*1.E37

      endif



C     CHECK FOR KEYWORD UNITS SPECIFICATION, IF SO PERFORM CONVERSION

C

      IF(.NOT.UCON(KU,LINEX(:10),CONV)) then

	   IF (DEG.EQ.'1') WWW=WWW*RAD

	   IF (KM.EQ.'1') WWW=WWW/EARTHR

	   IF (NM.EQ.'1') WWW=WWW*1.852

	   IF (FEET.EQ.'1') WWW=WWW*3.048006096E-4

	   IF(CYCLE.EQ.'1') WWW=WWW*PIT2

	   IF(PER.EQ.'1') WWW=PIT2/WWW

	   IF(MSKMS.EQ.'1') WWW=WWW*1.E-3

	   W(NW)=WWW

	   go to 40

      endif



      IF(CONV.GE.0.0) THEN

         W(NW)=WWW*CONV

      ELSEIF(W(NW).NE.0.0) THEN

         W(NW)=-CONV/W(NW)

      ENDIF

      GO TO 40

C

C

      ENTRY SETW

C     THIS ENTRY IS CALLED ONCE BEFORE THE FIRST RUN SET IS READ

C

C INITIALIZE SOME MATHEMATICAL CONSTANTS

      PI=4.0*ATAN(1.0)

      PIT2=2.*PI

      PID2=PI/2.

      DEGS=180./PI

      RAD=PI/180.

      ALN10=ALOG(10.)

CC********* INITIALIZE SOME VARIABLES IN THE W ARRAY

      MAXW=NWARSZ

      CALL CLEAR(W,MAXW)

      PLON=0.

      PLAT=PID2

      EARTHR=6370.

      INTYP=3.

      MAXERR=1.E-4

      ERATIO=50.

      STEP1=1.

      STPMAX=100.

      STPMIN=1.E-8

      FACTR=0.5

      HITLET=.15

      MAXSTP=1000.0

      HOP=1.

      HMAX=500.0

      EXTINC=999.999

      PAGLN=66.0

C

      CALL SETUCON

C

      RETURN

C

      ENTRY SETOVR

C     THIS ENTRY IS CALLED AFTER EACH RUN SET IS READ

C

C     PERFORM OVERRIDE ASSIGNMENTS TO W-ELEMENTS

      CALL OVERRD(MAXSTP,0.0,1000.0d0,WCOMTS(23),2,1)

      CALL OVERRD(ERATIO,0.0,50.0d0,WCOMTS(43),2,1)

      CALL OVERRD(FACTR,0.0,0.5d0,WCOMTS(47),2,1)

      CALL OVERRD(SKIP,0.0,BIGVAL,WCOMTS(71),2,1)

      CALL OVERRD(HITLET,0.0,.15d0,WCOMTS(75),2,1)

      IF(PAGLN.LT.30.0) PAGLN=0.0

      CALL OVERRD(PAGLN,0.0,66.0d0,WCOMTS(77),2,1)

      CALL OVERRD(PFACTR,0.0,1.0d0,WCOMTS(82),2,1)

      RETURN

C

      END

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

      SUBROUTINE ENDPLT



C.....This is a stub routine that exists solely to satisfy the call

C     in READW.  It was desired that READW not be changed in any sig-

C     nificant way since it is also used by other programs e.g. HARPO.



      RETURN

      END

