SUBROUTINE SETUPTVMODELS_CO2(LCON,LVSED,LTV,LMCM,LSHR,LSSPC, &SSPCFILE,MSSPC,ML,MGB,MSTATES,MG3,MWRKTVMDS,MWRKTV,MTBLTV,MPOUT, &MTOUT,MSOUT,NETTV,NGAS,IDG,NLMX,DBGIN,RLT,RUT,CONTROLTV,CMFILE, &SHFILE,FILENETV,NAME,NAMETV,VIBTRANTV,VSTSCM,WRKTVMDS, & rse_mean, rse ) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SETUPTVMODELS READS INPUT DATA AND INITIALIZES PARAMETERS REQUIRED C TO MODEL NON-LTE VIBRATIONAL TEMPERATURES. C C INPUT PARAMETERS: C C LCON --- UNIT NUMBER OF TV MODEL CONTROL FILE. C LVSED --- UNIT NUMBER OF VIBRATIONAL STATE PARAMETER DATABASE. C (FORWARD RADIANCE MODEL). C LVSEDTV --- UNIT NUMBER OF VIBRATIONAL STATE PARAMETER DATABASE. C (TV MODEL). C LTV --- UNIT NUMBER OF INITIAL TV'S. C LMCM --- UNIT NUMBER OF TABULATED CURTIS MATRIX FILE. C LSHR --- UNIT NUMBER OF TABULATED SOLAR HEATING RATE. C LSSPC --- UNIT NUMBER OF SOLAR SPECTRUM DATA. C MSSPC --- MAXIMUM SIZE OF SOLAR SPECTRUM ARRAY. C ML --- MAXIMUM LEVELS IN MODEL ATMOSPHERE. C MGB --- MAXIMUM GASES/ISOTOPES/TRANSITIONS IN FORWARD MODEL. C MSTATES --- MAXIMUM GASES/ISOTOPES/TRANSITIONS IN TVIB MODEL. C MG3 --- NUMBER OF TRANSITIONS IN G3 MANIFOLD. C MWRKTVMDS --- MAXIMUM SIZE OF WRKTVMDS WORK ARRAY. C MWRKTV --- MAXIMUM SIZE OF WRKTV WORK ARRAY (IN WRKTVMDS). C MTBLTV --- MAXIMUM SIZE OF TBL DATA SUBSET. C MPOUT --- MAXIMUM SIZE OF POUT DATA SUBSET. C MTOUT --- MAXIMUM SIZE OF TOUT. C MSOUT --- MAX SIZE OF SOUT PER GAS (or vibrational transition). C NETTV --- NUMBER OF SINGLE BAND EMISSIVITY TABLES PER CHANNEL. C NGAS --- NUMBER OF GASES IN INPUT ATMOSPHERE. C IDG --- GASID'S OF INPUT ATMOSPHERE. C NLMX --- NUMBER OF TERMS TO INCLUDE IN FQ / TRANSITION. C (FORWARD RADIANCE MODEL). C DBGIN --- WARNING MESSAGES ON OR OFF (TRUE=ON AND FALSE=OFF). C CONTROLTV --- CONTROL FILE. C CMFILE --- TABULATED CURTIS MATRIX DATA FILE. C SHFILE --- TABULATED SOLAR HEATING RATE DATA FILE. C FILENETV --- SINGLE BAND EMISSIVITY TABLE FILE NAMES C NAME --- GAS NAMES IN INPUT ATMOSPHERE. C NAMETV --- GAS NAMES FOR SIMULATED GASES/ISOTOPES/TRANSITIONS. C VIBTRANTV --- ARRAY OF SIMULATED NON-LTE VIBTRATIONAL TRANSITIONS. C VSTSCM --- UPPER/LOWER VIBRATIONAL STATE DESIGNATIONS C (kp_setnlte). C WRKTVMDS --- WORK ARRAY CONTAINING MOST OF THE PARAMETERS AND C ARRAYS IN THE TV MODELS. c rse_mean --- The mean earth sun distance (km) c rse --- THe earth sun distance for the current date of the event. (km) C C OUTPUT PARAMETERS: C C RLT --- LOWER STATE NLTE/LTE POPULATION RATIOS. C INITIALIZED TO 1 (LTE). C RUT --- UPPER STATE NLTE/LTE POPULATION RATIOS. C INITIALIZED TO 1 (LTE). C C SOFTWARE WRITTEN BY Christopher J. Mertens C MODIFIED 2002, 2003, 2004 to integrate with SOPS. B.T. Marshall. 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 DBGIN CHARACTER*(*) CONTROLTV,CMFILE,SHFILE,FILENETV,SSPCFILE,VIBTRANTV CHARACTER*8 NAME,NAMETV,VSTSCM DIMENSION FILENETV(MSTATES),VIBTRANTV(MSTATES),NAME(NGAS), &IDG(NGAS) DIMENSION NAMETV(MSTATES),VSTSCM(2,MSTATES),WRKTVMDS(MWRKTVMDS) DIMENSION NLMX(MGB,*),RLT(ML,MSTATES),RUT(ML,MSTATES) COMMON/LWRKTVMDST/LIDAY,LINITTV,LLVSED,LLVSEDTV,LLTV,LLMCM,LLSHR, &LIFLUXAL,LICCM,LISLH,LISECANT,LNITN,LNITD,LNITC,LITVOPT,LITVOPTN2, &LMG3,LMSSPC,LMTBLTV,LMWRKTV,LNLTV,LNVTS,LIVTS,LIVTSN,LIVTSG3, &LITVID,LITVIDVMR,LNLMX,LNLMXVMR,LNMXTV,LIRADTV,LZATV,LABDISO, &LABDISOG3,LENGY,LENGYG3,LSZA,LCSSPC,LWRKTV,LTVTBL,LTVPOUT,LTVTOUT, <VSOUT,LPN21RMOD,LPN21TMOD,LTVRMOD,LTVTMOD,LTVRN2MOD,LTVTN2MOD, <VRG3,LTVTG3,LSLHRMOD,LSLHTMOD,LSLHKRMOD,LSLHKTMOD,LSPHARRMOD, &LSPHARTMOD,LHRRMOD,LHRTMOD,LFQQ,LFQQT,LFQQVMR,LFQQTVMR NWRKTVMDS=24+ML+3*ML+MGB*2+MSTATES*(9+10*ML+10*ML)+MWRKTV+MPOUT+ & MSSPC+MTOUT+MTBLTV+MSOUT*MSTATES+MG3*(4+2*ML+2*ML) IF(MWRKTVMDS.LT.NWRKTVMDS) THEN WRITE(*,*) 'INCREASE WRKTVMDS TO AT LEAST',NWRKTVMDS STOP 'ERROR IN SETUPTVMODELS' ENDIF OPEN(LSSPC,FILE=SSPCFILE,STATUS='UNKNOWN') CALL LOCTVMDST(ML,ML,MGB,MSTATES,MG3,MSSPC,MWRKTV,MTBLTV,MPOUT, &MTOUT,MSOUT) CALL KP_GETINT(MG3,1,WRKTVMDS(LMG3)) CALL KP_GETINT(LVSED,1,WRKTVMDS(LLVSED)) CALL KP_GETINT(LVSED,1,WRKTVMDS(LLVSEDTV)) CALL KP_GETINT(LTV,1,WRKTVMDS(LLTV)) CALL KP_GETINT(LMCM,1,WRKTVMDS(LLMCM)) CALL KP_GETINT(LSHR,1,WRKTVMDS(LLSHR)) CALL KP_GETINT(MSSPC,1,WRKTVMDS(LMSSPC)) CALL KP_GETINT(MTBLTV,1,WRKTVMDS(LMTBLTV)) CALL KP_GETINT(MWRKTV,1,WRKTVMDS(LMWRKTV)) CALL KP_GETINT(NLMX(1,1),MGB,WRKTVMDS(LNLMX)) CALL KP_GETINT(NLMX(1,2),MGB,WRKTVMDS(LNLMXVMR)) DO I=1,ML IOFF=I-1 CALL KP_GETREAL(0.0,1,WRKTVMDS(LPN21RMOD+IOFF)) ENDDO CALL READCONTV_CO2(LCON,LMCM,LSHR,MSTATES,WRKTVMDS(LNVTS), & WRKTVMDS(LIVTS),WRKTVMDS(LIVTSN),NETTV,WRKTVMDS(LNMXTV),ML, & WRKTVMDS(LIRADTV),CMFILE,SHFILE,CONTROLTV,VIBTRANTV,VSTSCM, & WRKTVMDS(LITVOPT),WRKTVMDS(LITVOPTN2),WRKTVMDS(LIFLUXAL), & WRKTVMDS(LICCM),WRKTVMDS(LISLH),FILENETV) CALL READSOLSPEC(LSSPC,MSSPC,WRKTVMDS(LNVTS),WRKTVMDS(LCSSPC)) c solar distance correction SFAC=(RSE_MEAN/RSE)**2.0 do i = 4, msspc WRKTVMDS(LCSSPC+i-1) = WRKTVMDS(LCSSPC+i-1) * sfac enddo C end solar distance correction CALL FILLENGY(WRKTVMDS(LLVSEDTV),WRKTVMDS(LNVTS),WRKTVMDS(LIVTS), & WRKTVMDS(LABDISO),WRKTVMDS(LENGY),VSTSCM) WRITE(*,900) CALL MP_INITA(ML,MSTATES,MPOUT,MTOUT,MSOUT,WRKTVMDS(LTVPOUT), & WRKTVMDS(LTVTOUT),WRKTVMDS(LTVSOUT),DBGIN,RLT,RUT) ************************************************************************ * WRITE(*,*)' ****** NGAS = ',NGAS * DO I = 1,NGAS * WRITE(*,*)NAME(I) * ENDDO * DO I = 1, MSTATES * WRITE(*,*)VIBTRANTV(I) * ENDDO ************************************************************************ CALL SETTVGASNAME(NGAS,WRKTVMDS(LNVTS),NAME,NAMETV, & WRKTVMDS(LIVTS),IDG,WRKTVMDS(LIRADTV),VIBTRANTV) CLOSE(LSSPC) RETURN 900 FORMAT(/,1X,'INITIALIZE BANDPAK MULTIPARAMETER ARRAYS FOR ', & 'VIBRATIONAL TEMPERATURE MODELING',/) END