C file PCPROF5.FOR
C ----------------------------------------------------------------------!-------
C Nothing left
C ----------------------------------------------------------------------!-------
C 24 Mar 2006 - Changed COMMON block /RAYDEV/
C 27 Feb 2006 - Moved READW1 and GTUNIT out
C 27 Feb 2006 - Moved ALCOSH and FTANH out.
C 3 May 2004 - added SUBROUTINE FTANH
C ----------------------------------------------------------------------!-------
      SUBROUTINE READW1_test (AB,NWOK,MSET,MX,NTBL,ITBL,FRMTBL,GP) ! 27 Feb 2006
C ----------------------------------------------------------------------!-------
C
C     HANDLES INPUT OF TABULAR DATA REQUIRED BY SOME MODELS.
C
      implicit double precision (a-h,o-z)

c     COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVGRP,NDEVBIN,NDEVTXT ! 24 Mar 2006
      COMMON/RAYDEV/NRYIND,NDEVTMP,NFRMAT,NDEVTXT,NDEVBIN         ! 24 Mar 2006
C     COMMON DECK "CUCON" INSERTED HERE
      COMMON/UCONV/CNVV(5,4)
      CHARACTER PCV*3,CNVC*2
      COMMON/UCONC/PCV(5),CNVC(5,4)
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
      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))
      LOGICAL NWOK,AB
C
      CHARACTER LINE*80,ALPHA*3,FBUF*3
      PARAMETER (NVAR=6,ALPHA='  A',NACDE=-1,NFIELD=13)
      INTEGER IPV(NVAR),NTBL(10),ITBL(10),FRMTBL(10)
      CHARACTER*8 PU(NVAR)
      DOUBLE PRECISION GP(*),V(NVAR),CONV(NVAR)
C
C     THE DATA STRUCTURE EXPECTED BY THIS PROGRAM FOR A DATA BLOCK IS 
C     SPECIFIED FOR A GIVEN MODEL BY THE THREE ARRAYS NTBL,ITBL,FRMTBL.
C     THE TYPE OF DATA EXPECTED FOR A GIVEN FORMAT GROUP IS TAKEN FROM
C     ARRAY FRMTBL. IT MUST HAVE AN ENTRY FOR A GIVEN TYPE OF FORMAT
C     WHICH IS EITHER ZERO, IF THAT FORMAT IS NOT ALLOWED OR AN ENTRY
C     WHOSE VALUE IS EQUAL TO THAT FORMAT TYPE. CURRENTLY ONLY TWO
C     FORMAT TYPES ARE ALLOWED, 1 FOR ALPHA AND 2 FOR NUMERIC.
C     TO ALLOW MORE FLEXIBLITY IN THE INPUT FILE THE NUMERIC FORMAT
C     TYPE IN TURN ALLOWS FOR 3 DIFFERENT DATA FORMATS, SEE BELOW.
C
C     OFFSETS INTO THE GENERAL ARRAY 'GP' FOR EACH FORMAT ARE GIVEN
C     IN THE ARRAY 'NTBL'. THE SPACING BETWEEN DATA VALUES IN EACH LINE
C     READ IS GIVEN IN ARRAY 'ITBL'. THIS SCHEME DOES NOT ALLOW FOR X,Y
C     ,Z CYCLES BUT RATHER SEPARATE ARRAYS OF X VALUES, THEN Y VALUES,
C     AND THEN Z VALUES(ETC. UP TO 'NVAR' VARIABLES).
C
      NWOK=.TRUE.
C
C     INITIALIZE ANY ALPHANUMERIC ARRAYS TO BLANKS
      IF(FRMTBL(1).EQ.1) CALL SET2(GP(NTBL(1)),1H ,NTBL(2)-NTBL(1))
C
C     BEGIN MULTI-FORMAT LOOP
C
5     READ(NRYIND,'(A,A)',END=200) FBUF,LINE
      IF(NDEVTMP.GT.0) WRITE(NDEVTMP,'(A,A)') FBUF,LINE
      IF(FBUF.EQ.ALPHA) THEN
         NFRM=NACDE
      ELSE
         READ(FBUF,10) NFRM
      ENDIF
10    FORMAT(BZ,I3,A)
      IF(NFRM .EQ. 0) RETURN
C
C     FORMAT #1 IS ASSIGNED TO ALPHANUMERIC INPUT AND LARGER NUMBERS
C     FOR NUMERIC INPUT.
C
C     CHECK NOW FOR NUMERICAL FORMATS.
C     THESE ARE PROVIDED FOR EASE OF INPUT OF TABULATED DATA
C     AND ARE PARTLY 'TRANSPARENT' TO THE MODEL INVOLVED. I.E.
C     THE USER HAS THE OPTION OF SPECIFING THE NUMBER OF DATA COLUMNS.
C     INPUT FORMAT NUMBER SPECIFIES THE NUMBER OF COLUMNS OF INPUT DATA
C     I.E. FOR VALUE 1 A SINGLE DATA COLUMN IS EXPECTED, FOR A VALUE
C     2 TWO DATA COLUMNS ARE EXPECTED, ETC.
C
C     DETERMINE FORMAT NUMBER
      IF(NFRM.EQ.NACDE) THEN
         IT=1
C     ALPHANUMERIC FORMATS MUST BE FIRST IN LIST
C     SINCE NO OFFSET SPECIFIER IS ALLOWED IN A FULL ALPHA LINE
         IF(FRMTBL(1).EQ.1) GO TO 100
      ELSE
         READ(LINE,'(I1)') IT
         IT=MAX0(IT,2)
         IF(IT.LE.MX) GO TO 100
      ENDIF
C
15    AB=.TRUE.
      PRINT 20, MSET,NFRM,MX
20    FORMAT(' FOR W-VALUE',I5,' NUMBER OF COLUMNS',I5,
     &       ' EXCEEDS LIMIT OF', I5)
      PRINT*,'FOR PROFILE POINT PLOTS:  '
      PRINT*,'     NEGATIVE W-VALUES MUST BE < -40 and >= -62.'
C     ERROR IN INPUT DATA, STOP HERE
      STOP
C
C     THE 'NTBL' TABLE PROVIDES A LIST OF OFFSETS TO VARIABLE GROUPS IN
C     MODEL ARRAYS, 'ITBL' GIVES ELEMENT SEPARATION TO ALLOW FOR 2-
C     DIMENSIONAL ARRAYS AND 'FRMTBL' SPECIFIES THE INPUT FORMAT.
C
100   N1=NTBL(IT)
      N3=ITBL(IT)
      N2=NTBL(IT+1)-N3
C
      IF(NFRM.NE.NACDE) GO TO 110
C
      READ(LINE,1010)((GP(I+J-1),I=N1,N2,N3),J=1,N3)
1010  FORMAT(10A8)
      GO TO 5
C
110   IF(NFRM.LT.1 .OR. NFRM.GT.NVAR) GO TO 200
C     HANDLE NUMERIC FORMATS
C
C     N1 IS STARTING ELEMENT WHICH WILL BE AFTER THE DATA COUNT
C     VALUE(NEED NELS*N3+1 TOTAL ELEMENTS)
      N1=N1+1
      N=0
C
C     # ELEMENTS IS EQUAL TO FORMAT NUMBER
      NELS=NFRM
C     READ UNITS CONVERSION SPECIFICATION LINE
      READ(LINE,1018) (PU(I),I=1,3)
      IF(PU(2).NE.' ') READ(LINE,2024) DELIM
      IF(PU(2).EQ.' ') READ(LINE,1020) DELIM,(PU(I),I=1,NELS)
C
C  ALLOW FOR BLANK CONVERSION LINE PRODUCED BY EIGENRAY ROUTINE
      IF(DELIM.EQ.0) READ(LINE,2024) DELIM
C
C     READ NEXT LINE AND EXTRACT UNIT CONVERSION SPECS IF PRESENT
C     IN FLOATING FORMAT
      READ(NRYIND,'(A)') LINE
      CALL GTUNIT(LINE,PU,NFIELD,NELS, NCARY)
C     CARRY COUNT IS ZERO IF LINE CONTAINED UNITS SPECIFIERS
      IF(NCARY.EQ.0.AND.NDEVTMP.GT.0) WRITE(NDEVTMP,'(A)') LINE
C
1018  FORMAT(10(A,5X))
ccccc1020  FORMAT(BZ,3X,G10.3,8X,10A)
1020  FORMAT(BZ,G10.3,8X,10A)
2024  FORMAT(T43,G10.3)
1025  FORMAT(BZ,10G13.6)
C
C     LOOK UP CONVERSION CONSTANTS
      DO 2030 I=1,NELS
2030  CALL UCON(IPV(I),PU(I),CONV(I))
C
C     DELIMITOR TESTING REQUIRES THE INNER LOOP BE EXECUTED
C     AT LEAST ONCE
      NX=MAX0(1,N3)
      N2=MAX0(N2,N1)
C     BEGIN SINGLE DATA FORMAT LOOP
      DO 150 J=0,10000
         IF(NELS.GT.1) THEN
            IF(NCARY.EQ.0) READ(NRYIND,'(A)') LINE
            NCARY=0
            IF(NDEVTMP.GT.0) WRITE(NDEVTMP,'(A)') LINE
            READ(LINE,1025) (V(I),I=1,NELS)
         ENDIF
         K=0
         DO 145 I=N1+J,N2+J,NX
               K=K+1
               IF(NELS.EQ.1) THEN
                  IF(NCARY.EQ.0) READ(NRYIND,'(A)',END=10000) LINE
                  NCARY=0
                  IF(NDEVTMP.GT.0) WRITE(NDEVTMP,'(A)') LINE
C     FOR SINGLE COLUMN CASE READ NOW
                  READ(LINE,1020) V(K)
               ENDIF
               IF(V(K) .EQ. DELIM) GO TO 160
C
C           APPLY ANY SCALING CONVERSIONS
               IF(CONV(K).GE.0.0) THEN
                  V(K)=V(K)*CONV(K)
               ELSEIF(V(K).NE.0.0) THEN
                  V(K)=-CONV(K)/V(K)
      ENDIF
               IF(J.LT.N3) GP(I)=V(K)
145            N=N+1
150   CONTINUE
C
10000 IF(V(1).NE.DELIM) THEN
           PRINT*,' Tabular data delimiter does not match ',
     &            'for set: ',mset
           STOP
      ENDIF
C
C     SAVE NUMBER OF VALUES AND ELEMENTS(AS FRACTIONAL PART)
160   IF(N1.GT.1) GP(N1-1)=N+NELS/10.
C
C     CONTINUE MULTI-FORMAT LOOP

      GO TO 5
C
200   PRINT*,' Bad format in tabular data for set: ',mset
C
C ----------------------------------------------------------------------!-------
      END SUBROUTINE READW1_test 
C ----------------------------------------------------------------------!-------
C ----------------------------------------------------------------------!-------
      SUBROUTINE GTUNIT_test (LINE,PU,NFIELD,NVAR, LN) ! 27 Feb 2006
C ----------------------------------------------------------------------!-------
C     GTUNIT IS USED TO EXTRACT UNIT CONVERSION SPECIFIERS FROM TABULAR
C     DATA INPUT.
C     CONVERSION SPECIFICATIONS ARE TAKEN FROM 'LINE' INPUT STRING.
C     A FLOATING FORMAT FALLING WITHIN SUCCESSIVE FIELDS OF
C     LENGTH 'NFIELD' IS PROVIDED FOR.
C     OUTPUT IS TO UNIT SPECIFIER ARRAY 'PU' FOR A MAXIMUM OF 'NVAR'
C     FIELDS. FOR A SUCCESS/FAIL RETURN VALUE, 'LN' GIVES THE NUMBER
C     OF NON-BLANK CHARACTERS USEFUL FOR UNIT DECODING, ZERO IMPLIES
C     NO USEFUL UNIT INFORMATION WAS FOUND.
C
      PARAMETER (MAXLN=130)
      CHARACTER*(*) LINE,PU(NVAR),TMP*(MAXLN),TMP1*(MAXLN)
      INTEGER STRIM 
C
      LN=STRIM(LINE)
      IF(LN.LT.1) THEN
         DO 5 I=1,NVAR
5           PU(I)=' '
         RETURN
      ENDIF
C
      TMP=' '
      CALL SFILTR(LINE,TMP,' 0123456789+-.E')
      IF(STRIM(TMP).LT.1) RETURN
C     SIGNIFY WE CONSUMED THIS LINE
      LN=0
C
      TMP1=LINE
C     PLACE INTER-SPECIFIER DELIMITORS
      DO 10 I=NFIELD,NFIELD*NVAR,NFIELD
         IF(TMP1(I:I).NE.' ') THEN
            IF(TMP1(I+1:I+1).NE.' ') THEN
C     IF NO ROOM FOR A BLANK, ITS AN ERROR
               PRINT*,'Format error in units specifier of tabular data.'
               STOP
            ELSE
               TMP1(I+1:I+1)='#'
            ENDIF
         ELSE
            TMP1(I:I)='#'
         ENDIF
10    CONTINUE
C
C     NOW SQUEEZE OUT THE BLANKS
      CALL SFILTR(TMP1,TMP,' ')
C     HOPEFULLY SOMETHING LEFT
C
      NL=STRIM(TMP) 
      ILIN=1
      DO 20 I=1,NVAR
C     CHECK FOR EMPTY CONVERSIONS
         IF(TMP(ILIN:ILIN).EQ.'#') THEN 
            ILIN=ILIN+1
            PU(I)=' '
            GO TO 20
         ENDIF
C     GET NEXT UNIT TYPE
         PU(I)(1:2)=TMP(ILIN:ILIN+1)
C     GET NEXT PHYSICAL UNIT(BLANKS HAVE BEEN REMOVED)
C     SHORT PHRASE IF A BLANK WAS REMOVED
         IF(TMP(ILIN+3:ILIN+3).NE.'#') THEN
            IF(TMP(ILIN+4:ILIN+4).NE.'#') THEN
C     IF INCORRECT GROUPING OF LETTERS, ITS AN ERROR
               PRINT*,'Format error in units specifier of tabular data.'
               STOP
            ELSE
C     ADD TWO LETTER UNIT
               PU(I)(3:5)=' '//TMP(ILIN+2:ILIN+3) 
               ILIN=ILIN+5
            ENDIF
         ELSE
C     ADD ONE LETTER UNIT
            PU(I)(3:5)='  '//TMP(ILIN+2:ILIN+2)
            ILIN=ILIN+4
         ENDIF
20    CONTINUE
C
C     SHOULD HAVE USED UP ALL THE TEXT BY NOW
      IF(ILIN.LE.NL) then
           PRINT*,'Format error in units specifier of tabular data.'
           STOP
      endif
C ----------------------------------------------------------------------!-------
      END SUBROUTINE GTUNIT_test ! 27 Feb 2006
C ----------------------------------------------------------------------!-------
