SUBROUTINE READFASATM2(LPR,ATMOS,RE,XLAT,MR,NR,NGG,NAM,IGS,
     &ZR,PR,TR,TGR,Q,QGR,IHYDRO,ATMOSDIR,PPMV,READZPT)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C VERSION 1.0
C
C READDATA READS IN THE APPARENT TANGENT DATA AND ALL INPUT ATMOSPHERIC
C  DATA. THIS VERSION ALLOWS SELECTION OF AEROSOL MODEL BY USE OF THE
C  PARAMETER IAER. IAER=1 IS FOR LOW AEROSOL, IAER=2 FOR MODERATE, AND
C  IAER=3 FOR HIGH.
C
C  COPYRIGHT 1988 BY G & A TECHNICAL SOFTWARE INC.
C                    P.O. BOX 1885
C                    GRAFTON, VA 23692
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C      INCLUDE 'common.units'
c     save
      external kp_intprof_noxtrp, hydro, openfile, closefile
      LOGICAL IHYDRO,PPMV,READZPT
      PARAMETER(NFILE=14,MTMP=501)
      CHARACTER*(*) ATMOSDIR,NAM(*),ATMOS
      character NAME(NFILE)*8,FILEN(NFILE)*12,
     &ATMFILE*80,BLANK*1
      DIMENSION ZR(MR),PR(MR),TR(MR),TGR(2,MR),IGS(*),
     &Q(MR,*),QGR(2,MR,*)
       dimension ZTMP(MTMP),
     &PTMP(MTMP),QTMP(MTMP),ZTMP2(MTMP),QTMP2(MTMP),IGAS(NFILE)
      DATA FILEN/ 'H2O.ALT', 'CO2.ALT','O3.ALT', 'RAYLEIGH.ALT',
     & 'NO.ALT', 'CH4.ALT', 'AEROSOL.ALT',
     & 'O2.ALT', 'N2.ALT', 'O.ALT', 'O1D.ALT','N2O.ALT',
     &  'TEMP.ALT', 'PRESS.ALT'/
      DATA NAME/ 'H2O', 'CO2','O3', 'RAYLEIGH', 'NO', 'CH4',
     &  'AEROSOL', 
     & 'O2',   'N2',  'O(3P)', 'O(1D)','N2O',  'TEMP', 'PRESS'/
      DATA IGAS/100,200,300, 7700, 800, 600, 9000,700,2200,3400,
     &  6100, 400, 0,0/
      DATA BLANK/' '/
c      DATA TERM/'/0'/
      DATA ZTIE/30.0/

c        print*, atmosdir, len(atmosdir)
c         stop
c      ATMOSDIR=ATMFILE
      NGG=NFILE-2
      icc=1
      IAER=0
      DO IC=1,len(atmosdir)
C        IF(ATMFILE(IC:IC).EQ.BLANK.OR.ATMFILE(IC:IC).EQ.TERM) GO TO 5
        IF(ATMosdir(IC:IC).EQ.BLANK) GO TO 5
        ICC=IC
      ENDDO
c      ATMOS=ATMFILE(1:ICC)
  5   ATMFILE=ATMOSDIR(1:ICC)//'/LATITUDE.DAT'
      write(*,*) atmfile, len(atmfile)
      call OPENfile(1,LPR,ATMFILE)
      READ(LPR,*) XLAT,RE
      call CLOSEfile(LPR)
      WRITE(*,*) 'LATITUDE= ',XLAT
      IF(READZPT) THEN
        ATMFILE=ATMOSDIR(1:ICC)//'/'//FILEN(NFILE)
c        write(*,'(a64)') ATMFILE
        call OPENfile(1,LPR,ATMFILE)
        READ(LPR,*)
        I=0
  10    I=I+1
        READ(LPR,*,END=15) ZTMP(I),PTMP(I)
        GO TO 10
  15    call closefile(lpr)
        NR=I-1
        DO I=1,NR
          II=NR-I+1
          IF(ZTMP(I).LT.ZTIE) IPTIE=II
          ZR(II)=ZTMP(I)
          PR(II)=PTMP(I)
        ENDDO
        ATMFILE=ATMOSDIR(1:ICC)//'/'//FILEN(NFILE-1)
c        write(*,'(a64)') ATMFILE
        call OPENfile(1,LPR,ATMFILE)
        READ(LPR,*)
        I=0
  20    I=I+1
        READ(LPR,*,END=25) ZTMP(I),QTMP(I)
        GO TO 20
  25    call closefile(lpr)
        NTMP=I-1
        DO I=1,NTMP
          II=NTMP-I+1
          ZTMP2(II)=ZTMP(I)
          QTMP2(II)=QTMP(I)
        ENDDO
        CALL KP_INTPROF_noxtrp(NR,NTMP,1,NR,ZTMP2,ZR,QTMP2,TR)
      ENDIF

      DO I=1,NR
        DO IS=1,2
          TGR(IS,I)=0.0
          DO IG=1,NGG
            QGR(IS,I,IG)=0.0
          ENDDO
        ENDDO
      ENDDO
C HYDRO no longer updates RE, so must call RADGRAV to get RE
C      WRITE(*,*) IPTIE,ZR(IPTIE)
C      CALL RADGRAV( ZR,XLAT,G,REARTH)
      IF(IHYDRO) CALL HYDRO(NR,1,NR,IPTIE,RE,XLAT,ZR,PR,TR)
c      DO I=1,NR
c        Q(I,NGG)=0.0
c      ENDDO
c      IGS(NGG)=IGAS(NGG)
c      NAM(NGG)=NAME(NGG)

      DO 55 IG=1,NGG
        IIG=IG
        IGS(IIG)=IGAS(IG)
        NAM(IIG)=NAME(IG)
        ATMFILE=ATMOSDIR(1:ICC)//'/'//FILEN(IG)
c        write(*,'(a64)') ATMFILE
        call OPENfile(1,LPR,ATMFILE)
        READ(LPR,*)
        I=0
  30    I=I+1
        READ(LPR,*,END=35) ZTMP(I),QTMP(I)
        GO TO 30
  35    call closefile(lpr)

      IF(PPMV .and. igas(ig) < 9000 ) THEN
         FACTOR=1.0e-6
      ELSE
         FACTOR=1.0
      ENDIF


        NTMP=I-1
        DO I=1,NTMP
          II=NTMP-I+1
          ZTMP2(II)=ZTMP(I)
          QTMP2(II)=QTMP(I)*FACTOR
        ENDDO
C        write(*,'(//,a8)') NAME(IG)
C        write(*,'(5e15.5)') (qtmp2(ilev),ilev=1,ntmp)
        CALL KP_INTPROF_noxtrp(NR,NTMP,1,NR,ZTMP2,ZR,QTMP2,Q(1,IIG))
C        write(*,'(5e15.5)') (q(ilev,iig),ilev=1,nr)
 55   CONTINUE
c      DO I=1,NR
c        WRITE(101,*) ZR(I),PR(I),TR(I),(q(i,iig),iig=1,3)
c      ENDDO
c      stop
      RETURN
c  100 FORMAT(6(1X,E12.5))
c  104 FORMAT(1X,A8,2F8.2,2I3,4(A8,I4))
      END