SUBROUTINE OUT_NLTE(LOUTPUT,LOUTPUT2,LTV,MGS,MCEL,NTB,NST,SZA, &ATMOS,ICALL,ISL,IEL,NSR,NER,NG,NAME,IDG,IWR,QMIX,QG,ITAB,IRAD, &ICOR,ZA,ZT,PT,TT,GR,EMR,RMR,ESR,RSR,IPOUT,POUT,ITBL,TBL,ISOUT, &SOUT,ITOUT,TOUT,NDX1,NDX2,IOPTT,IOPTB,ANOISE,TVT,RLT,RUT,VIBTRAN, &VIBSTS,RE,ATMPATH) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERSION 3-3_0 C C OUT_NLTE 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,rmr,rsr,rrr,ros,ro PARAMETER(MCEL2=20000,P0=1013.25,NCHAR=40) CHARACTER*18 WEIGHT(5),OVRLP(4)*20 CHARACTER OPTION(2)*28,OPTO(3)*18 CHARACTER*(*) ATMPATH,ATMOS,NAME(NG),VIBTRAN(MGS),VIBSTS(2,MGS) CHARACTER*40 VIBT,VIBTEST,TVPATH*100 CHARACTER*200 TVFILE,BLANCK*1,NULL*1 DIMENSION IDG(MGS) DIMENSION TVT(MCEL,MGS,2) DIMENSION ZA(MCEL),ZT(MCEL),PT(MCEL),TT(MCEL),GR(2,MCEL), &EMR(MCEL,NG),RMR(MCEL,NG),ESR(MCEL,NG),RSR(MCEL,NG), &QMIX(MCEL,NG),QG(2,MCEL,NG),RLT(MCEL,MGS),RUT(MCEL,MGS),IRAD(NG), &ICOR(NG),GUS(MCEL2),ITAB(MCEL) DIMENSION IPOUT(*),POUT(*),ISOUT(NST,NG), &SOUT(NST,NG),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',' '/ DATA BLANCK/' '/ DATA NULL/'\0'/ C .............................................................. C TVPATH='./' TVPATH=ATMPATH CTM CREATE TVPATH/SZA.DAT and write SZA to it NCHART=LEN(TVPATH) DO IC=1,NCHART ICC1=IC IF((TVPATH(IC:IC).NE.BLANCK).AND. &(TVPATH(IC:IC).NE.NULL)) GO TO 5 ENDDO 5 DO IC=ICC1,NCHART IF((TVPATH(IC:IC).EQ.BLANCK).OR. &(TVPATH(IC:IC).EQ.NULL)) GO TO 10 ICC2=IC ENDDO 10 TVFILE=TVPATH(ICC1:ICC2)//'SZA.DAT' OPEN(LTV,FILE=TVFILE,status='unknown') WRITE(LTV,*) SZA CLOSE(LTV) CTM IF(ICALL.NE.1) WRITE(LOUTPUT,*) ICH=ITOUT(LIBLM) NRAY=NER-NSR+1 WRITE(LOUTPUT2,112) ATMOS,ICH,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 IG=1,NG IF(IDG(IG).GT.10000) THEN IGAS=IDG(IG)/10000 ELSE IGAS=IDG(IG) ENDIF 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),IGAS,VIBTRAN(IG),WEIGHT(IPW), & OVRLP(IOV) C DO IS=1,2 C CALL TVWRITE(LTV,MCEL,NER,IGAS,ATMPATH,VIBSTS(IS,IG),ZT, C & TVT(1,IG,IS)) C ENDDO ENDDO C WRITE(LOUTPUT,*) DO 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 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 IF(IDG(IG).GT.10000) THEN IGAS=IDG(IG)/10000 ELSE IGAS=IDG(IG) ENDIF VIBTEST=VIBTRAN(IG) IF(VIBTEST(1:6).EQ.'RESDL_') THEN VIBT=VIBTEST(7:NCHAR) ELSE VIBT=VIBTEST(1:NCHAR) ENDIF WRITE(LOUTPUT,102) IGAS,VIBT,QMIX(J,IG), & (TVT(J,IG,K),K=1,2),RUT(J,IG),RLT(J,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 ENDDO 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,EMR(J,1) 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 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 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) IF(IOPTT.EQ.1) THEN RMI=TOUT(LRM+IJ1) ENDIF IF(IOPTT.EQ.1) 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 ENDDO ENDDO WRITE(LOUTPUT,*) ENDIF ENDDO 100 FORMAT(1X,'SET',I2,1X,' CHANNEL',I3,3X,'# GASES ',I2,3X, &'RAYS',I3,' -',I3,' LEVELS',I3,' -',I3,2X,A8) 101 FORMAT(1X,A8,I4,3x,A20,3X,A18,A20) 102 FORMAT(1X,I4,1x,A12,' Q=',E10.4,' TV=',2F8.2,' RUT=',E10.4, &' RLT=',E10.4) 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) 110 FORMAT(18X,' TVUP=',E10.4,' TVLO=',E10.4, &' TOTAL MASS PATH=',E10.4) 112 FORMAT(1X,A8,2I4,E12.5) 115 FORMAT(1X,3E12.5) 200 FORMAT(1X,'BANDPAK ',A28,A18) 202 FORMAT(1X,'GASES AND VIBRATIONAL TRANSITIONS SIMULATED: ') RETURN END