SUBROUTINE OUT_LTE(LOUTPUT,LOUTPUT2,MGS,MCEL,ATMOS,ICALL,NTB,NST, &ITAB,ISL,IEL,NSR,NER,NG,NAME,IDG,IWR,QMIX,QG,IRAD,ICOR,ZA,ZT,PT, &TT,GR,EMR,RMR,ESR,RSR,IPOUT,POUT,ITBL,TBL,ISOUT,SOUT,ITOUT,TOUT, &NDX1,NDX2,IOPTT,IOPTB,ANOISE) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERSION 3-3_0 C C OUT_LTE OUTPUTS PATH AND MEGA VARIABLES IN AN EASY TO READ FORMAT. C C COPYRIGHT 1998 BY G & A TECHNICAL SOFTWARE INC. C 11864 Canon Blvd., Suite 101 C Newport News, VA 23606 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SAVE real*8 emr,esr,rsr,rmr,rrr,ros,ro PARAMETER(MCEL2=2000,P0=1013.25) CHARACTER*18 WEIGHT(5),NAME(MGS)*8,OVRLP(4)*20,ATMOS*8 CHARACTER*(*) OPTION(2)*28,OPTO(3)*18 DIMENSION IDG(MGS) DIMENSION ZA(MCEL),ZT(MCEL),PT(MCEL),TT(MCEL),GR(2,MCEL), &EMR(MCEL,MGS),RMR(MCEL,MGS),ESR(MCEL,MGS),RSR(MCEL,MGS), &QMIX(MCEL,MGS),QG(2,MCEL,MGS),IRAD(MGS),ICOR(MGS),GUS(MCEL2), &ITAB(MCEL) DIMENSION IPOUT(*),POUT(*),ISOUT(NST,MGS), &SOUT(NST,MGS),ITOUT(*),TOUT(*),ITBL(NTB,*),TBL(NTB,*) COMMON/MP_LOCTB/LNET,LNOT,LIBLK,LIETL,LIDET,LNBB,LNPS,LWNB,LWNE, &LSBT,LTINC,LEP,LEPLNK COMMON/KP_LOCPT/LISCP,LIELP,LNLP,LLEGA,LREFRAC,LSRL,LPI,LPMW,LTMW, &LUM,LUM1,LUM2,LUP,LUP1,LUP2,LTE,LTPE,LGANG,LHIT,LDN,LRFR, &LRREF,LSH,LSHI,LTHK,LRT,LRA2 COMMON/MP_LOCTT/LISCM,LIBLM,LIETM,LNLM,LIOPM,LIQM,LEM,LRM,LTM, &LPMI,LBM,LBBE COMMON/MP_LOCST/LISCS,LIDGS,LIBLS,LIETS,LIRSTS,LIOP2,LIPSM,LIQS, &LES,LRS,LBS,LBAVE,LESS,LBES,LTAU,LCGU,LCGP,LCGPI,LIOP1,LIPO,LUS, <S,LPS,LPSI,LUC,LTC,LPC,LPCI,LQES,LHOT,LRLE,LRUE DATA OPTION/'TOTAL INTEGRATED RADIANCES', & 'BAND AVERAGED RADIANCES'/ DATA OPTO/' (WATTS/M2 ST)',' (ERGS/SEC CM2 ST)', & ' (WATTS/CM2 ST)'/ DATA OVRLP/' MOLECULAR OVERLAP',' CONTINUUM OVERLAP', & ' ZERO OVERLAP',' '/ DATA WEIGHT/' MASS WEIGHTED PMA', & ' MASS WEIGHTED CGA', & ' MASS WEIGHTED AVE', & ' AIR WEIGHTED CNTA',' '/ GZ0=5.34E-9 SOLRDNC=2.74E13 XLOSCMDT=2.6872E19 IF(ICALL.NE.1) WRITE(LOUTPUT,*) ICH=ITOUT(LIETM)+ITOUT(LIBLM)*10 NRAY=NER-NSR+1 WRITE(LOUTPUT2,112) ATMOS,NRAY,ANOISE WRITE(LOUTPUT,100) ICALL,ICH,NG,NSR,NER,ISL,IEL,ATMOS C WRITE(LOUTPUT,200) OPTION(IOPTB),OPTO(IOPTT) C WRITE(LOUTPUT,202) DO 5 IG=1,NG IC=ICOR(IG) IF(IG.EQ.1.OR.IC.EQ.0) THEN IOV=4 ELSE IOV=IC ENDIF IF(IRAD(IG).GT.0) THEN IPW=IRAD(IG) ELSE IPW=5 ENDIF WRITE(LOUTPUT,101) NAME(IG),WEIGHT(IPW),OVRLP(IOV) 5 CONTINUE C WRITE(LOUTPUT,*) DO 10 J=NSR,NER I=IABS(NDX1) K=SIGN(1,NDX1) IJJ1=KP_INDX(I,J,K,1) I=IABS(NDX2) K=SIGN(1,NDX2) IJJ2=KP_INDX(I,J,K,1) IDF=ITAB(J) BAND=TBL(LEPLNK,IDF) EOS=0.0 ROS=0.0 WRITE(LOUTPUT,108) J,ZT(J),PT(J),TT(J),(GR(K,J),K=1,2) DO 20 IG=1,NG IC=ICOR(IG) GUT=0.0 IF(IC.NE.0) THEN III=0 DO 30 K=-1,1,2 IF(K.EQ.-1) THEN IST=ISL IET=J KD=1 ELSE IST=J IET=ISL KD=-1 ENDIF DO 30 I=IST,IET,KD III=III+1 IJ=KP_INDX(I,J,K,1) IF(IJ.GE.IJJ1.AND.IJ.LE.IJJ2) THEN IJ1=IJ-1 IE=KP_INDX(I,J,K,2) IE2=IE-1 Q2=SOUT(LQES+IE2,IG)/SOUT(LHOT+IE2,IG) U=POUT(LUM+IJ1) IF(I.EQ.1) THEN GUSS=Q2*U ELSE IE1=IE2+K Q1=SOUT(LQES+IE1,IG)/SOUT(LHOT+IE1,IG) QAV=(Q1+Q2)*.5 QDEL=-K*(Q2-Q1) U1=POUT(LUM1+IJ1) GUSS=QAV*U+QDEL*U1 ENDIF GUT=GUT+GUSS IF(IG.EQ.1) THEN GUS(III)=GUSS ENDIF ENDIF 30 CONTINUE ENDIF WRITE(LOUTPUT,102) NAME(IG),QMIX(J,IG),(QG(K,J,IG), & K=1,2),GUT,ISOUT(LIRSTS+J-1,IG) IF(IG.EQ.1) THEN EO=0.0 RO=0.0 ELSE EO=EMR(J,IG) RO=RMR(J,IG) ENDIF IF(IOPTT.EQ.1) THEN RRR=RSR(J,IG) ENDIF IF (IOPTT.EQ.2) THEN RO=RO*1000. RRR=RSR(J,IG)*1000. ENDIF IF (IOPTT.EQ.3) THEN RO=RO*0.0001 RRR=RSR(J,IG)*0.0001 ENDIF WRITE(LOUTPUT,105) EO,RO,ESR(J,IG),RRR EOS=EOS+EO ROS=ROS+RO 20 CONTINUE IF(IOPTT.EQ.1) THEN RRR=RMR(J,1) ENDIF IF (IOPTT.EQ.2) THEN RRR=RMR(J,1)*1000. ENDIF IF (IOPTT.EQ.3) THEN RRR=RMR(J,1)*0.0001 ENDIF WRITE(LOUTPUT2,115) ZA(J),RRR WRITE(LOUTPUT,103) ITBL(LIDET,IDF),TBL(LEPLNK,IDF),EOS,ROS, & EMR(J,1),RRR IF(IWR.EQ.1) THEN WRITE(LOUTPUT,104) III=0 DO 40 K=-1,1,2 IF(K.EQ.-1) THEN IST=ISL IET=J KD=1 ELSE IST=J IET=ISL KD=-1 ENDIF EMI=0.0 DO 40 I=IST,IET,KD II=K*I III=III+1 IJ=KP_INDX(I,J,K,1) IF(IJ.GE.IJJ1.AND.IJ.LE.IJJ2) THEN IJ1=IJ-1 PB=SOUT(LPS+IJ1,1)*P0 EMOLD=EMI EMI=TOUT(LEM+IJ1) c GZ=(EMI-EMOLD)*BAND*SOLRDNC/(GUS(III)*XLOSCMDT) c GZZ=GZ/GZ0 IF(IOPTT.EQ.1) THEN RMI=TOUT(LRM+IJ1) ENDIF IF(IPOTT.EQ.2) THEN RMI=TOUT(LRM+IJ1)*1000. ENDIF IF(IOPTT.EQ.3) THEN RMI=TOUT(LRM+IJ1)*0.0001 ENDIF IF(IWR.EQ.1) THEN WRITE(LOUTPUT,107) II,ZT(I),RMI,EMI,GUS(III), & SOUT(LTS+IJ1,1),PB ENDIF ENDIF 40 CONTINUE WRITE(LOUTPUT,*) ENDIF 10 CONTINUE 100 FORMAT(1X,'SET',I2,1X,' CHANNEL',I3,3X,'# GASES ',I2,3X, &'RAYS',I3,' -',I3,' LEVELS',I3,' -',I3,2X,A8) 101 FORMAT(1X,A8,3X,A18,A20) 102 FORMAT(2X,A8,' Q=',E10.4,' QG=',2F8.4,' TOTAL MASS PATH=',E10.4, &' >>',I3) c 103 FORMAT(1X,I4,'=',E11.5,' EO=',E11.5,' RO=',E11.5,' ET=',E11.5, c &' RT=',E11.5) 103 FORMAT(1X,I4,'=',E11.5,' EO=',E11.5,' RO=',E11.5,' ET=',E11.5, &' RT=',E11.5) 105 FORMAT(18X,'EO=',E11.5,' RO=',E11.5,' ES=',E11.5,' RS=',E11.5) 104 FORMAT(2X,'SHELL',4X,'ALT',9X,'RM',10X,'EM',10X,'USEG',8X,'TSEG', &8X,'PSEG') 107 FORMAT(1X,I4,1X,6E12.4) 108 FORMAT(1X,'RAY',I3,' ZT=',E10.4,' PT=',E10.4,' TT=',E10.4, &' GR=',2F8.4) 112 FORMAT(1X,A8,I8,E12.5) 115 FORMAT(1X,2E12.5) 200 FORMAT(1X,'BANDPAK ',A28,A18) 202 FORMAT(1X,'GASES SIMULATED: ') RETURN END