      SUBROUTINE TVCALC_CO2(IDAY,INITTV,ITVOPT,ITVOPTN2,IFLUXAL,ICCM,
     &ISLH,ISECANT,NITN,NITD,NITC,LVSEDTV,LTV,LMCM,LSHR,MTBL,MPOUT,
     &MTOUT,MSOUT,MSSPC,MWRKTV,MR,ML,MGG,MSTATES,MG3,NR,NL,NGG,NVTS,
     &IGS,IVTS,IVTSG3,NMXTV,IRAD,RE,ZA,ZR,PR,TR,Q,PN21OHVR,TVPATH,
     &VSTSCM,VSTSG3,ABDISO,ENGY,SZA,SSPC,TBL,POUT,TOUT,SOUT,WRKTV,
     &TVRMOD,TVRN2MOD,TVRG3,SLHRMOD,SLHKRMOD,SPHARRMOD,HRRMOD)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CALCTV CALCULATES ALL THE VIBRATIONAL TEMPERATURES MODELED,
C USING THE A PRIORI ATMOSPHERIC STATE.
C
C INPUT PARAMETERS:
C
C   IDAY      --- DAYTIME: TRUE OR FALSE.  
C   INITTV    --- INITIALIZE VIBRATIONAL TEMPERATURES: TRUE OR FALSE
C   ITVOPT    --- INITIALIZATION OPTION IF INITTV=TRUE: (1) TV=TK,
C                 (2) READ TV FROM UNIT LTV.
C   ITVOPTN2  --- N2(1) TV INITIALIZATION OPTION:
C                 (1) TVTN2=TT
C                 (2) TVTN2=TVT(10011)
C                 (3) SOLVE 626 N2(1)-001 SYSTEM WITHOUT COUPLING TO
C                     G1-STATES, ISO 4.3FB, AND 626 4.3FH.
C   IFLUXAL   --- ANGLULAR INTEGRATION OPTIONS:
C                 (1)  Diffusivity approximation r=1.66
C                 (2)  Diffusivity approximation r=1.81
C                 (3)  One-point zeroth-moment Gauss
C                 (4)  Two-point zeroth-moment Gauss
C                 (5)  Three-point zeroth-moment Gauss
C                 (6)  Four-point zeroth-moment Gauss
C                 (7)  Five-point zeroth-moment Gauss
C                 (8)  Six-point zeroth-moment Gauss
C                 (9)  Seven-point zeroth-moment Gauss
C                 (10) Eight-point zeroth-moment Gauss
C                 (11) One-point first-moment Gauss
C                 (12) Two-point first-moment Gauss
C                 (13) Three-point first-moment Gauss
C                 (14) Four-point first-moment Gauss
C                 (15) Five-point first-moment Gauss
C                 (16) Six-point first-moment Gauss
C                 (17) Seven-point first-moment Gauss
C                 (18) Eight-point first-moment Gauss
C   ICCM      --- CURTIS MATRIX CALCULATION OPTION: 
C                 (1) Calculated explicitly
C                 (2) Read from unit number LCM
C                 (3) No update (this option used in retrievals)
C   ISLH      --- DIRECT SOLAR HEATING RATE OPTION:
C                 (1) Calculated explicitly
C                 (2) Read from unit number LSHR
C                 (3) No update (this option used in retrievals)
C                 (4) Calculated with specified lower state populations.
C   ISECANT   --- SECANT APPROXIMATION (T OR F). NOTE: IF SZA => 90.0,
C                 SPHERICAL GEOMETRY RAY PATHS WILL BE COMPUTED
C   NITN      --- NUMBER OF ITERATIONS OVER SOLUTION OF COUPLED SYSTEM
C                 OF EQUATIONS IN CURTIS MATRIX FORMULATION FOR THE
C                 15-MICRON NIGHTTIME VIBRATIONAL STATES.
C   NITD      --- NUMBER OF ITERATIONS OVER SOLUTION OF COUPLED SYSTEM
C                 OF EQUATIONS IN CURTIS MATRIX FORMULATION FOR THE
C                 NEAR-IR STATES.
C   NITC      --- NUMBER OF ITERATIONS OVER COMBINED CO2 TV MODEL
C                 (DAY/NIGHT). THE FINAL SOLUTION FOR 15-UM STATES
C                 WILL INCLUDE DAYTIME ENHANCEMENT EFFECTS.
C   LVSEDTV   --- UNIT NUMBER OF VIBRATIONAL STATE PARAMETER DATABASE.
C   LTV       --- UNIT NUMBER OF INITIAL TV'S.
C   LMCM      --- UNIT NUMBER OF TABULATED CURTIS MATRIX DATA FILE.
C   LSHR      --- UNIT NUMBER OF TABULATED SOLAR ABSORPTION DATA FILE.
C   MTBL      --- MAXIMUM SIZE OF TBL DATA SUBSET.
C   MPOUT     --- MAXIMUM SIZE OF TBL DATA SUBSET.
C   MTOUT     --- MAXIMUM SIZE OF TOUT DATA SUBSET.
C   MSOUT     --- MAX SIZE OF SOUT SUBSET PER GAS. 
C   MSSPC     --- MAXIMUM SIZE OF SOLAR SPECTRUM ARRAY.
C   MWRKTV    --- MAXIMUM SIZE OF WRKTV WORK SPACE ARRAY.
C   MDET      --- MAXIMUM NUMBER OF DETECTORS.
C   NDET      --- NUMBER OF DETECTORS.
C   MR        --- MAXIMUM LEVELS IN INPUT ATMOSPHERE.
C   ML        --- MAXIMUM LEVELS IN MODEL ATMOSPHERE.
C   MGG       --- MAXIMUM GASES IN INPUT ATMOSPHERE.
C   MSTATES   --- MAXIMUM NUMBER of STATES.
C   MG3       --- NUMBER OF STATES IN G3-STATE MANIFOLD.
C   NR        --- NUMBER OF LEVELS IN INPUT ATMOSPHERE.
C   NL        --- NUMBER OF LEVELS IN MODEL ATMOSPHERE PLUS -RE LEVEL.
C   NGG       --- NUMBER OF GASES IN INPUT ATMOSPHERE.
C   NVTS      --- NUMBER OF VIBRATIONAL TRANSITIONS SIMULATED.
C   IGS       --- GASID'S OF INPUT ATMOSPHERE.
C   IVTS      --- PSUEDO GAS ID'S OF SIMULATED VIBRATIONAL TRANSITIONS.
C   NMXTV     --- NUMBER OF TERMS TO INCLUDE IN FQ IN TV MODEL.
C   IRAD      --- EGA TECHNIQUE: (1) PMA, (2) CGA, (3) AVG, AND 
C                 (4) CONT.
C   RE        --- EARTH'S RADIUS (KM).
C   ZA        --- MODEL ALTITUDE GRID (must include -RE for nadir).
C   ZR        --- INPUT ATMOSPHERE ALTITUDES (KM).
C   PR        --- INPUT ATMOSPHERE PRESSURES (MBAR).
C   TR        --- INPUT ATMOSPHERE TEMPERATURES (K).
C   Q         --- INPUT ATMOSPHERE MIXING RATIOS (VMR).
C   PN21OHVR  --- PRODUCTION RATE OF N2(1) FROM OH(v) VIBRATIONAL
C   TVPATH    --- DIRECTORY PATH TO INITIAL TV'S.
C   VSTSCM    --- UPPER/LOWER VIBRATIONAL STATE DESIGNATIONS IN TV 
C                 MODEL.
C   ABDISO    --- ISOTOPIC ABUNDANCE.
C   ENGY      --- UPPER/LOWER ENERGIES OF SIMULATED TRANSITIONS (CM-1).
C   SZA       --- SOLAR ZENITH ANGLE (DEGREES).
C   SSPC      --- SOLAR SPECTRUM (W/M^2/CM^-1).
C   TBL       --- EMISSIVITY TABLE DATA.
C   POUT      --- ATMOSPHERE PARAMETERS (output from mp_mass).
C   TOUT      --- INDIVIDUAL EMITTER RELATED PARAMETERS.
C   SOUT      --- TOTAL EMITTER RELATED PARAMETERS.
C   WRKTV     --- WORK ARRAY FOR STORING INTERMEDIATE REULTS.
C
C OUTPUT PARAMETERS:
C
C   IVTSG3    --- PSUEDO GAS ID'S OF OF 4.3UM TRANSITIONS FROM G3-STATES.
C   TVRMOD    --- COMPUTED CO2 VIBRATIONAL TEMPERATURES (K).
C   TVRN2MOD  --- COMPUTED VIBRATIONAL TEMPERATURES OF N2(1) (K).
C   TVRG3     --- UPDATED G3-STATES (COMPUTED VIBRATIONAL TEMPERATURES
C                 (K)).
C   SLHRMOD   --- COMPUTED DIRECT SOLAR HEATING RATE (ERGS SEC-1 CM-3).
c   SLHKRMOD  --- COMPUTED DIRECT SOLAR HEATING RATES (K/DAY). 
C   SPHARRMOD --- COMPUTED DIRECT SOLAR PHOTON ABSORPTION RATE
C                 (MOLEC-1 SEC-1).
C   HRRMOD    --- COMPUTED RADIATIVE HEATING RATES (K/DAY).
C
C SOFTWARE WRITTEN BY Christopher J. Mertens
C Modified by Benjamin T. Marshall December 2002
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C      (c) Copyright 1987-2000 by GATS, Inc.
C          11864 Canon Blvd., Suite 101, Newport News, Virginia, 23606
C          Phone: (757) 873-5920
C
C  All Rights Reserved. No part of this software or publication may be
C  reproduced, stored in a retrieval system, or transmitted, in any form
C  or by any means, electronic, mechanical, photocopying, recording, or
C  otherwise without the prior written permission of GATS, Inc.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      LOGICAL IDAY,ISECANT,INITTV,DEBUG,DEBUG2
      CHARACTER*(*) TVPATH,VSTSCM,VSTSG3
      DIMENSION IGS(MGG),IVTS(MSTATES),NMXTV(MSTATES)
      DIMENSION ZA(ML),ZR(MR),PR(MR),TR(MR),Q(MR,MGG),WRKTV(MWRKTV)
      DIMENSION ABDISO(MSTATES),ENGY(2,MSTATES),TBL(MTBL,1),POUT(MPOUT)
      DIMENSION TOUT(MTOUT),SOUT(MSOUT,MSTATES),TVRMOD(MR,MSTATES,2)
      DIMENSION IRAD(MSTATES),VSTSCM(2,MSTATES),VSTSG3(2,MG3),
     &SSPC(MSSPC)
      DIMENSION TVRN2MOD(MR),SLHRMOD(MR,MSTATES),SPHARRMOD(MR,MSTATES),
     &SLHKRMOD(MR,MSTATES)
      DIMENSION HRRMOD(MR,MSTATES),IVTSG3(MG3),PN21OHVR(MR),
     &TVRG3(MR,MG3,2)
      LOGICAL MP_ERROR
      CHARACTER*100 MP_MESSAGE
      COMMON/MP_STATUS/MP_ERROR,MP_MESSAGE
      DEBUG=.FALSE.
c       print*,'Maxcount 3'
      IF(DEBUG) THEN
        WRITE(99,*) '************ BEFORE TVIB CALL *******************'
        WRITE(99,*) '*** IDAY=',IDAY
        WRITE(99,*) '*** INITTV=',INITTV
        WRITE(99,*) '*** ITVOPT=',ITVOPT
        WRITE(99,*) '*** ITVOPTN2=',ITVOPTN2
        WRITE(99,*) '*** IFLUXAL=',IFLUXAL
        WRITE(99,*) '*** ICCM=',ICCM
        WRITE(99,*) '*** ISLH=',ISLH
        WRITE(99,*) '*** ISECANT=',ISECANT
        WRITE(99,*) '*** NITN=',NITN
        WRITE(99,*) '*** NITD=',NITD
        WRITE(99,*) '*** NITC=',NITC
        WRITE(99,*) '*** LVSEDTV=',LVSEDTV
        WRITE(99,*) '*** LTV=',LTV
        WRITE(99,*) '*** LMCM=',LMCM
        WRITE(99,*) '*** LSHR=',LSHR
        WRITE(99,*) '*** MTBL=',MTBL
        WRITE(99,*) '*** MPOUT=',MPOUT
        WRITE(99,*) '*** MTOUT=',MTOUT
        WRITE(99,*) '*** MSOUT=',MSOUT
        WRITE(99,*) '*** MSSPC=',MSSPC
        WRITE(99,*) '*** MWRKTV=',MWRKTV
        WRITE(99,*) '*** MR=',MR
        WRITE(99,*) '*** ML=',ML
        WRITE(99,*) '*** MGG=',MGG
        WRITE(99,*) '*** MSTATES=',MSTATES
        WRITE(99,*) '*** MG3=',MG3
        WRITE(99,*) '*** NR=',NR
        WRITE(99,*) '*** NL=',NL
        WRITE(99,*) '*** NCELL=',NCELL
        WRITE(99,*) '*** NGG=',NGG
        WRITE(99,*) '*** NVTS=',NVTS
        WRITE(99,*) '*** IGS=',IGS
        WRITE(99,*) '*** IVTS=',IVTS
        WRITE(99,*) '*** IVTSG3=',IVTSG3
        WRITE(99,*) '*** NMXTV=',NMXTV
        WRITE(99,*) '*** IRAD=',IRAD
        WRITE(99,*) '*** RE=',RE
        WRITE(99,*) '*** ZA=',ZA
        WRITE(99,*) '*** ZR=',ZR
        WRITE(99,*) '*** PR=',PR
        WRITE(99,*) '*** TR=',TR
        WRITE(99,*) '*** Q=',Q
        WRITE(99,*) '*** PN21OHVR=',PN21OHVR
        WRITE(99,*) '*** TVPATH=',TVPATH
        WRITE(99,*) '*** VSTSCM=',VSTSCM
        WRITE(99,*) '*** ABDISO=',ABDISO
        WRITE(99,*) '*** ENGY=',ENGY
        WRITE(99,*) '*** SZA=',SZA
        WRITE(99,*) '*** SSPC=',SSPC
C        WRITE(99,*) '*** TBL=',TBL
C        WRITE(99,*) '*** POUT=',POUT
C        WRITE(99,*) '*** TOUT=',TOUT
C        WRITE(99,*) '*** SOUT=',SOUT
C        WRITE(99,*) '*** WRKTV=',WRKTV
C        WRITE(99,*) '*** TVRMOD=',TVRMOD
C        WRITE(99,*) '*** TVRN2MOD=',TVRN2MOD
C        WRITE(99,*) '*** TVRG3=',TVRG3
C        WRITE(99,*) '*** SLHRMOD=',SLHRMOD
C        WRITE(99,*) '*** SLHKRMOD=',SLHKRMOD
C        WRITE(99,*) '*** SPHARRMOD=',SPHARRMOD
C        WRITE(99,*) '*** HRRMOD=',HRRMOD
      ENDIF
    
      CALL CO2TVMODEL(IDAY,INITTV,ITVOPT,ITVOPTN2,IFLUXAL,ICCM,ISLH,
     & ISECANT,NITN,NITD,NITC,LVSEDTV,LTV,LMCM,LSHR,MTBL,MPOUT,MTOUT,
     & MSOUT,MSSPC,MWRKTV,MR,ML,MGG,MSTATES,MG3,NR,NL,NCELL,NGG,NVTS,
     & IGS,IVTS,IVTSG3,NMXTV,IRAD,RE,ZA,ZR,PR,TR,Q,PN21OHVR,TVPATH,
     & VSTSCM,VSTSG3,ABDISO,ENGY,SZA,SSPC,TBL,POUT,TOUT,SOUT,WRKTV,
     & TVRMOD,TVRN2MOD,TVRG3,SLHRMOD,SLHKRMOD,SPHARRMOD,HRRMOD)
      IF(MP_ERROR) RETURN
     
      DEBUG2=.FALSE.
      IF(DEBUG2) THEN
        WRITE(99,*) '************* AFTER TVIB CALL *******************'
        WRITE(99,*) '*** IDAY=',IDAY
        WRITE(99,*) '*** INITTV=',INITTV
        WRITE(99,*) '*** ITVOPT=',ITVOPT
        WRITE(99,*) '*** ITVOPTN2=',ITVOPTN2
        WRITE(99,*) '*** IFLUXAL=',IFLUXAL
        WRITE(99,*) '*** ICCM=',ICCM
        WRITE(99,*) '*** ISLH=',ISLH
        WRITE(99,*) '*** ISECANT=',ISECANT
        WRITE(99,*) '*** NITN=',NITN
        WRITE(99,*) '*** NITD=',NITD
        WRITE(99,*) '*** NITC=',NITC
        WRITE(99,*) '*** LVSEDTV=',LVSEDTV
        WRITE(99,*) '*** LTV=',LTV
        WRITE(99,*) '*** LMCM=',LMCM
        WRITE(99,*) '*** LSHR=',LSHR
        WRITE(99,*) '*** MTBL=',MTBL
        WRITE(99,*) '*** MPOUT=',MPOUT
        WRITE(99,*) '*** MTOUT=',MTOUT
        WRITE(99,*) '*** MSOUT=',MSOUT
        WRITE(99,*) '*** MSSPC=',MSSPC
        WRITE(99,*) '*** MWRKTV=',MWRKTV
        WRITE(99,*) '*** MR=',MR
        WRITE(99,*) '*** ML=',ML
        WRITE(99,*) '*** MGG=',MGG
        WRITE(99,*) '*** MSTATES=',MSTATES
        WRITE(99,*) '*** MG3=',MG3
        WRITE(99,*) '*** NR=',NR
        WRITE(99,*) '*** NL=',NL
        WRITE(99,*) '*** NCELL=',NCELL
        WRITE(99,*) '*** NGG=',NGG
        WRITE(99,*) '*** NVTS=',NVTS
        WRITE(99,*) '*** IGS=',IGS
        WRITE(99,*) '*** IVTS=',IVTS
        WRITE(99,*) '*** IVTSG3=',IVTSG3
        WRITE(99,*) '*** NMXTV=',NMXTV
        WRITE(99,*) '*** IRAD=',IRAD
        WRITE(99,*) '*** RE=',RE
        WRITE(99,*) '*** ZA=',ZA
        WRITE(99,*) '*** ZR=',ZR
        WRITE(99,*) '*** PR=',PR
        WRITE(99,*) '*** TR=',TR
        WRITE(99,*) '*** Q=',Q
        WRITE(99,*) '*** PN21OHVR=',PN21OHVR
        WRITE(99,*) '*** TVPATH=',TVPATH
        WRITE(99,*) '*** VSTSCM=',VSTSCM
        WRITE(99,*) '*** ABDISO=',ABDISO
        WRITE(99,*) '*** ENGY=',ENGY
        WRITE(99,*) '*** SZA=',SZA
C        WRITE(99,*) '*** SSPC=',SSPC
C        WRITE(99,*) '*** TBL=',TBL
C        WRITE(99,*) '*** POUT=',POUT
C        WRITE(99,*) '*** TOUT=',TOUT
C        WRITE(99,*) '*** SOUT=',SOUT
C        WRITE(99,*) '*** WRKTV=',WRKTV
        WRITE(99,*) '*** TVRMOD=',TVRMOD
        WRITE(99,*) '*** TVRN2MOD=',TVRN2MOD
        WRITE(99,*) '*** TVRG3=',TVRG3
C        WRITE(99,*) '*** SLHRMOD=',SLHRMOD
C        WRITE(99,*) '*** SLHKRMOD=',SLHKRMOD
C        WRITE(99,*) '*** SPHARRMOD=',SPHARRMOD
C        WRITE(99,*) '*** HRRMOD=',HRRMOD
      ENDIF
      RETURN
      END
