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