      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,
     &LTS,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
