SUBROUTINE READFASATM2(LPR,ATMOS,RE,XLAT,MR,NR,NGG,NAM,IGS, &ZR,PR,TR,TGR,Q,QGR,IHYDRO,ATMOSDIR,PPMV,READZPT,ztie ) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERSION 1.0 C C READDATA READS IN THE APPARENT TANGENT DATA AND ALL INPUT ATMOSPHERIC C DATA. C C COPYRIGHT 1988 BY G & A TECHNICAL SOFTWARE INC. C P.O. BOX 1885 C GRAFTON, VA 23692 c led c modified so re and xlat are input into this routine c hydro is only called if you want to use the PT profile and c you now input the ztie altitude C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C INCLUDE 'common.units' c save external kp_intprof, hydro, openfile, closefile LOGICAL IHYDRO,PPMV,READZPT PARAMETER(NFILE=14,MTMP=701) 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) c c note that these files all have monotonically increasing altitudes c 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'/ c DATA ZTIE/30.0/ c print*, atmosdir, len(atmosdir) c stop c ATMOSDIR=ATMFILE NGG=NFILE-2 icc=1 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_dum,RE_dum call CLOSEfile(LPR) c 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) DO I=1,NR DO IS=1,2 TGR(IS,I)=0.0 ENDDO ENDDO IF(IHYDRO) CALL HYDRO(NR,1,NR,IPTIE,RE,XLAT,ZR,PR,TR) ENDIF !read zpt DO I=1,NR DO IS=1,2 DO IG=1,NGG QGR(IS,I,IG)=0.0 ENDDO ENDDO ENDDO 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 write(101,*) readzpt c DO I=1,NR c WRITE(101,*) ZR(I),PR(I),TR(I),(q(i,iig),iig=7,7) c ENDDO c stop RETURN c 100 FORMAT(6(1X,E12.5)) c 104 FORMAT(1X,A8,2F8.2,2I3,4(A8,I4)) END