C ============================================================================= C | | | C H A B _ L O S | APPARENT COLUMN EMISSION RATES | VERSION: 6.0 | C | DISTRIBUTION VERSION | JANUARY 2002 | C | | | C ============================================================================= C | C SUBROUTINES NEEDED: | C CORONA . . . ANALYTIC EXOSPHERE MODELS | C ZSUN_LOS. . . POINT-TO-SUN PROPAGATOR FOR LOS CALCULATIONS | C LOS_PARAM . . LINE-OF-SIGHT PROPAGATION PARAMETERS | C FAR_SIDE. . . LOCATION OF CELL PIERCE POINTS | C STEP_TAU. . . INCREMENTS OF OPTICAL DEPTHS (USING DLOCAL, NOT CELLS) | C DLOCAL . . . ROUTINE TO ESTIMATE LOCAL DENSITIES | C CROSS . . . ITERATION ROUTINE TO LOCATE SHADOW CROSSING | C (GROUND-BASED OBSERVATIONS) | C SMS_SPLINE. . LOGARITHMIC CUBIC SPLINE INTERPOLATION SET-UP ROUTINE | C FOR MULTIPLE SCATTERING SOURCE FUNCTIONS & ASSOCIATED | C NUMERICAL RECIPES SUBROUTINES | C GAUSS . . . GAUSS-LEGENDRE POINTS & WEIGHTS | C SPEED . . . SPEED POINTS & WEIGHTS | C | C ============================================================================= C C CODE TO CALCULATE FLUORESCENCE RADIATION INTENSITIES ALONG SPECIFIED LINES C OF SIGHT (LOSs) USING hab_rt.f SOURCE FUNCTIONS. C BASED ON ALGORITHM OF ANDERSON AND HORD [1977, EQN. (36) IN PARTICULAR]. C C VERSION FOR USE IN H-alpha OR H-beta AIRGLOW MODELING: C -- NONISOTHERMAL BALMER ALPHA AND BALMER BETA ONLY C -- ASSUMES OBSERVATIONS TAKEN FROM GROUND ON NIGHTSIDE C -- FLUORESCENCE FEATURES TREATED AS OPTICALLY THIN W/O ATTENUATION C -- OPTION FOR GENERATING ASSOCIATED LINE PROFILES C C ADDITIONAL UPDATES FOR THIS TEST VERSION: C -- ZSUN, ZONE & HAB_ ROUTINES REBUILT TO REMOVE REDUNDANT CODE C -- EXOSPHERIC TEMPERATURE PROFILE NO LONGER REPLACED BY CONSTANT C ----------------------------------------------------------------------------- C SECTIONS: C 1 PRELIMINARY SETUP C 2 BASIC PARAMETERS & INFORMATION C 3 FURTHER PREPARATION WORK C 4 LINE-OF-SIGHT PROPAGATION xxxMAIN LOOPxxx C 4a INITIALIZE LOS ARRAYS C 4b LOCATION AND LOOK DIRECTION IN SOLAR COORDINATES C 4c LINE-OF-SIGHT REFERENCE QUANTITIES C 4d SHADOW DISTANCE DETERMINATION C 4e SEARCH FOR FAR EDGE OF INITIAL BIN ALONG SPECIFIED LINE OF SIGHT C 4f SUBSEQUENT STEPS THROUGH BINS ALONG LINE OF SIGHT C 4g ACCUMULATED EMISSION CONTRIBUTIONS C 4h WRAP UP C 5 FINAL OUTPUT C ----------------------------------------------------------------------------- SUBROUTINE HAB_LOS(LINE_LABEL,MAXLOS,LPROF,WAVELN,FLUORB, & SPDPT,WSPD,ILOS,SZA,ZNTH,AZI,HSHAD,ACER,PRFL, & EXOBASE_T,DOPPLER_SPEED) C 11111111111111111111111111111111111111111111111111111111111111111111111111111 C 111 PRELIMINARY SETUP 111111111111111111111111111111111111111111111111111 C 11111111111111111111111111111111111111111111111111111111111111111111111111111 IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (IKNT = 25) ! MUST BE SAME AS IN SOURCE CODE PARAMETER (JKNT = 18) ! MUST BE SAME AS IN SOURCE CODE CCCCCCPARAMETER (LPROF = 8) ! OPTIONS: 4 8 16 ! NOW PASSED PARAMETER (SPEEDC = 2.9979D10) ! SPEED OF LIGHT PARAMETER (BOLTZ = 1.3806D-16) ! BOLTZMANN CONSTANT PARAMETER (AMASS = 1.6738D-24) ! ATOMIC MASS LOGICAL ILLUM, PASS_V, INSIDE CHARACTER*13 CHOOZ CHARACTER*15 HISTORY CHARACTER*13 ITORNIT DIMENSION SZA(MAXLOS), ZNTH(MAXLOS), AZI(MAXLOS) DIMENSION HSHAD(MAXLOS), ACER(3,MAXLOS), PRFL(3,0:LPROF,MAXLOS) DIMENSION BRAD(IKNT+1),RADN(IKNT) DIMENSION BCHI(JKNT+1),CHIN(JKNT) DIMENSION THERMO(5,61),HDNS(IKNT),O2DNS(IKNT),TEMP(IKNT) DIMENSION SOL(IKNT,JKNT),SRC(IKNT,JKNT),OSUN(3) DIMENSION SPDPT(LPROF),WSPD(LPROF) DIMENSION XSMS(IKNT+2),D0SMS(IKNT+2,JKNT),D2SMS(IKNT+2,JKNT), & YSMS(IKNT+2),D2YSMS(IKNT+2) DIMENSION PARAM_LOS(13) COMMON /EXOS/ GM,CONL,PLANETR,RBASE,RC,RUPR,RP,TEXO,DEXO,VELT, & RADPF,CENTER,ABSCSX,FTSAT,FDSAT,IGEO COMMON /NMBR/ PI,RTPI,PID2,OFFSET COMMON /GAUS08/WW08(08),XX08(08) COMMON /SPW04/ SWGT04(04),SPNT04(04) COMMON /SPW08/ SWGT08(08),SPNT08(08) COMMON /SPW16/ SWGT16(16),SPNT16(16) DATA GM / 3.9898D20/ ! G-CONSTANT * PLANET MASS DATA PLANETR / 6371.0D5 / ! MEAN PLANET RADIUS DATA OFFSET / 1.0D-6 / ! GENERIC OFFSET VALUE C GENERAL/MISC STUFF PID2 = ASIN(1.0D0) PI = 2.0D0 * PID2 RTPI = SQRT(PI) CONL = GM * AMASS / BOLTZ ANSCAT_A = 0.9219D0 ! single scattering coefficient ANSCAT_B = 0.2344D0 ! single scattering coefficient C SPEED POINT ARRAYS C (DOPPLER DISPLACEMENTS FOR NONISOTHERMAL CALCULATIONS) DO LP = 1,LPROF IF (LPROF.EQ.4) THEN SPDPT(LP) = SPNT04(LP) WSPD(LP) = SWGT04(LP) ELSE IF (LPROF.EQ.8) THEN SPDPT(LP) = SPNT08(LP) WSPD(LP) = SWGT08(LP) ELSE IF (LPROF.EQ.16) THEN SPDPT(LP) = SPNT16(LP) WSPD(LP) = SWGT16(LP) END IF END DO C 22222222222222222222222222222222222222222222222222222222222222222222222222222 C 222 BASIC PARAMETERS & INFORMATION 22222222222222222222222222222222222222 C 22222222222222222222222222222222222222222222222222222222222222222222222222222 C ----------------------------------------------------------------------------- C see hab_rt_H.f comment code for definitions C ----------------------------------------------------------------------------- C OPEN RT-CONTENT FILE IF (LINE_LABEL.EQ.2) THEN OPEN (03,FILE='H_alpha.source',STATUS='OLD') ELSE IF (LINE_LABEL.EQ.3) THEN OPEN (03,FILE='H_beta.source',STATUS='OLD') END IF C GET CASE INFO AND "FINE-GRID" ATMOSPHERE MODEL READ(03,10)CHOOZ,ITORNIT, & GLAT,GLONG,IDAY,IYEAR,UT,STL,AP,F107,F107A,HISTORY 10 FORMAT(1X,30X,A,2X,A/ & 1X,F6.2,2X,F7.2,2X,I3,2X,I2,2X,5(F6.2,2X),2X,A) READ(03,11)BASE,TOP,ITHERM,MOD_MSIS,SCALN,ADJT,D_EXO,FLUX,D_MAX 11 FORMAT(1X/1X,0P2F9.3,2I4,0P2F9.3,1P3E12.3) 12 FORMAT(1X,5(1PE10.4,1X)) DO IBIN = 1,ITHERM+1 READ(03,12)(THERMO(KBIN,IBIN),KBIN=1,5) END DO C EXOSPHERE & OPTICAL QUANTITIES READ(03,13)IGEO,TEXO,DEXO,TSAT,DSAT,RBASE,RC,RUPR,RP, & RADPF,VELT,CENTER,ABSCSX,BRANCH 13 FORMAT(1X/I3,4(1X,1PE10.4)/10(1X,1PE10.4)) C EFFECTIVE ZENITH COLUMN DENSITIES READ(03,14)TCOLM_H,TCOLM_O2,TCOLM_TOT,COLM_EXO 14 FORMAT(1X/1X,4(1PE10.4,2X)) C BOUNDARY GRID POINTS READ(03,15)BRAD 15 FORMAT(1X/(10(1X,1PE10.4))) READ(03,16)BCHI 16 FORMAT(1X/(10(1X,1PE10.4))) C NOMINAL CENTROID POINTS READ(03,17)RADN 17 FORMAT(1X/(10(1X,1PE10.4))) READ(03,18)CHIN 18 FORMAT(1X/(10(1X,1PE10.4))) C "RT-GRID" DENSITY & TEMPERATURE ARRAYS READ(03,21)HDNS 21 FORMAT(1X/(10(1X,1PE10.4))) READ(03,22)O2DNS 22 FORMAT(1X/(10(1X,1PE10.4))) READ(03,23)TEMP 23 FORMAT(1X/(10(1X,1PE10.4))) C SOLAR SOURCE ARRAY READ(03,31) 31 FORMAT(1X) 32 FORMAT(10(1X,1PE10.4)) DO IBIN = 1,IKNT READ(03,32)(SOL(IBIN,JBIN),JBIN=1,JKNT) END DO C TOTAL SOURCE ARRAY READ(03,33) 33 FORMAT(1X) 34 FORMAT(10(1X,1PE10.4)) DO IBIN = 1,IKNT READ(03,34)(SRC(IBIN,JBIN),JBIN=1,JKNT) END DO CLOSE(03) C 33333333333333333333333333333333333333333333333333333333333333333333333333333 C 333 FURTHER PREPARATION WORK 33333333333333333333333333333333333333333333 C 33333333333333333333333333333333333333333333333333333333333333333333333333333 C CONVERT THERMOSPHERIC DENSITIES TO DENSITY ALGORITHMS FOR USE IN C LINEAR-LOGARITHMIC INTERPOLATIONS DO IBIN = 1,ITHERM+1 THERMO(4,IBIN) = LOG(THERMO(4,IBIN)) THERMO(5,IBIN) = LOG(THERMO(5,IBIN)) END DO C SPECIFICATION OF SELECTED GEOCORONAL PARAMETER(S) IF (IGEO.EQ.1) THEN FTSAT = TSAT/TEXO FDSAT = DSAT/DEXO ELSE IF (IGEO.EQ.0) THEN FTSAT = TSAT * PLANETR FDSAT = 0.0D0 END IF C REPLACE BRANCHING RATIO USED IN SOURCE FUNCTION EVALUATIONS WITH C BRANCHING RATIO FOR FLUORESCENT SCATTERING BRANCH = FLUORB C SET UP INTERPOLATION ARRAYS FOR MULTIPLE SCATTERING SOURCE FUNCTIONS CALL SMS_SPLINE(IKNT,JKNT,BRAD,RADN,SOL,SRC,XSMS,D0SMS,D2SMS) C ZSUN SHADOW OFFSET (REDUNDANT ALTITUDE GRID VIOLATION PROTECTION) C SOLILLUMCHK . . . Solar Illumination Check C effective placement of terminator shadow height, C slightly offset from nominal placement to protect C against ZSUN grid violations. SOLILLUMCHK = BRAD(1) * (1.0D0 + OFFSET) C _____ AZIMUTH OF SOLAR DIRECTION FOR SINGLE SCATTERING COMPONENT SOLPHI = 0.001D0 C 44444444444444444444444444444444444444444444444444444444444444444444444444444 C 444 LINE-OF-SIGHT PROPAGATION 4444444444444444444444444444444444444444444 C 44444444444444444444444444444444444444444444444444444444444444444444444444444 DO 3333 LOOK = 1,ILOS C xxxxxxxxxxxxxxxxxxxxxxxx C x START OF MAIN LOOP x C xxxxxxxxxxxxxxxxxxxxxxxx C ----------------------------------------------------------------------------- C INITIALIZE LOS ARRAYS C ----------------------------------------------------------------------------- DO IL = 1,3 ACER(IL,LOOK) = 0.0D0 DO LP = 0,LPROF PRFL(IL,LP,LOOK) = 0.0D0 END DO END DO C ----------------------------------------------------------------------------- C LOCATION AND LOOK DIRECTION IN SOLAR COORDINATES C protections added, required by use of spherical trig relations C keep in mind that AZI is an ``interior'' angle C ----------------------------------------------------------------------------- C R1: RADIUS AT OBSERVATION LOCATION (FIXED ON PLANET SURFACE) R1 = PLANETR C X1: SOLAR ZENITH ANGLE AT OBSERVATION LOCATION X1 = SZA(LOOK) * PI / 180.0D0 IF (X1.LT.OFFSET*PI) THEN X1 = OFFSET * PI ELSE IF (X1.GT.(1.0D0 - OFFSET)*PI) THEN X1 = (1.0D0 - OFFSET)*PI END IF C THETA: LOCAL ZENITH ANGLE OF LOS +++ must be uplooking! +++ THETA = ZNTH(LOOK) * PI / 180.0D0 IF (THETA.LT.OFFSET*PI) THEN THETA = OFFSET * PI ELSE IF (THETA.GT.(1.0D0 - OFFSET)*PI) THEN THETA = (1.0D0 - OFFSET)*PI END IF C PHI: AZIMUTH OF LOS RELATIVE TO SOLAR DIRECTION PHI = AZI(LOOK) * PI / 180.0D0 IF (PHI.LT.0.0D0) PHI = -PHI IF (PHI.LT.OFFSET*PI) THEN PHI = OFFSET * PI ELSE IF ((PHI.LE.PID2).AND.(PHI.GE.(PID2-OFFSET*PI))) THEN PHI = PID2 - OFFSET*PI ELSE IF ((PHI.GT.PID2).AND.(PHI.LE.(PID2+OFFSET*PI))) THEN PHI = PID2 + OFFSET*PI ELSE IF (PHI.GT.(1.0D0 - OFFSET)*PI) THEN PHI = (1.0D0 - OFFSET)*PI END IF C ----------------------------------------------------------------------------- C LINE-OF-SIGHT REFERENCE QUANTITIES C ----------------------------------------------------------------------------- C _____ DETERMINE INITIAL BINS I1 = 0 !! starting at the ground !! DO JLOOP = 1,JKNT IF ((X1.GE.BCHI(JLOOP)).AND.(X1.LT.BCHI(JLOOP+1))) THEN J1 = JLOOP GO TO 3022 END IF END DO 3022 CONTINUE CALL LOS_PARAM(I1,J1,R1,X1,THETA,PHI,PARAM_LOS,PASS_V,IPHASE_V) C LOS PARAMETERS FROM PARAM_LOS CCCCC THETA = PARAM_LOS( 1) ! this already known CX1 = PARAM_LOS( 2) SX1 = PARAM_LOS( 3) CU1 = PARAM_LOS( 4) SU1 = PARAM_LOS( 5) CP1 = PARAM_LOS( 6) SP1 = PARAM_LOS( 7) RSMU = PARAM_LOS( 8) DSMU = PARAM_LOS( 9) XSKIM = PARAM_LOS(10) XTOT = PARAM_LOS(11) OSKIM = PARAM_LOS(12) OTOT = PARAM_LOS(13) C ANISOTROPIC SCATTERING FACTOR FOR LOS (NOTE THAT SCATTERING ANGLE IS XTOT) CSCAT = COS(XTOT) ANSCAT = ANSCAT_A + ANSCAT_B * (CSCAT**2) C ----------------------------------------------------------------------------- C SHADOW DISTANCE DETERMINATION C ----------------------------------------------------------------------------- DSHAD = 0.0D0 C VERIFY THAT OBSERVATION LOCATION IS IN SHADOW IF (X1.GT.PID2) THEN C _____ A-OK ELSE WRITE(06,909) 909 FORMAT(1X, 'EXECUTION ABORTING: ', & 'OBSERVATION POINT MUST BE ON NIGHTSIDE') GO TO 9009 END IF C VERIFY THAT LINE OF SIGHT IS UPWARD LOOKING IF (THETA.GT.PID2) THEN WRITE(06,908) 908 FORMAT(1X, 'EXECUTION ABORTING: ', & 'LINE OF SIGHT MUST BE UPWARD LOOKING') GO TO 9009 ELSE C _____ A-OK END IF C DETERMINE LOS RADIAL EXIT BOUNDARY C OEXIT . . . DISPLACEMENT ANGLE TO EXIT C XEXIT . . . SOLAR ANGLE AT EXIT IEXIT = IKNT+1 OEXIT = THETA - ASIN(RSMU/BRAD(IEXIT)) XEXIT = ACOS(CX1*COS(OEXIT)+SX1*SIN(OEXIT)*CP1) C DETERMINE DISTANCE TO SHADOW CROSSING IF (XEXIT.GE.BCHI(JKNT)) THEN ISHAD = 0 DSHAD = 0.0D0 RSHAD = 0.0D0 HSHAD(LOOK) = -1.0D0 ELSE ISHAD = 1 CALL CROSS(RBASE,RSMU,R1,THETA,CX1,SX1,CP1,OEXIT,DSHAD) RSHAD = SQRT(R1**2 + DSHAD**2 - 2.0D0*R1*DSHAD*COS(PI-THETA)) HSHAD(LOOK) = (RSHAD - PLANETR) / 1.0D5 END IF C ----------------------------------------------------------------------------- C SEARCH FOR FAR EDGE OF INITIAL BIN ALONG SPECIFIED LINE OF SIGHT C ----------------------------------------------------------------------------- ITRIP = 0 DELTA_A = 0.0D0 I_A = I1 J_A = J1 R_A = R1 X_A = X1 T_A = THETA CALL FAR_SIDE(IKNT, JKNT, BRAD, BCHI, PARAM_LOS, INSIDE, & I_A, J_A, T_A, R_A, X_A, PASS_V, IPHASE_V, & I_B, J_B, T_B, R_B, X_B, OMEGA) DELTA_B = SQRT(R_B**2 + R1**2 - 2.0D0*R_B*R1*COS(OMEGA)) IF ( INSIDE ) THEN C xxx xxx C C xxx xxx C C xxx SINCE OBSERVATION POINT IS ON THE GROUND, FIRST BIN IS BENEATH xxx C C xxx RADIATING REGION: NO EMISSION CONTRIBUTIONS (ITRIP = 0) xxx C C xxx xxx C C xxx END IF C ----------------------------------------------------------------------------- C SUBSEQUENT STEPS THROUGH BINS ALONG LINE OF SIGHT C ----------------------------------------------------------------------------- 1111 CONTINUE ITRIP = ITRIP + 1 DELTA_A = DELTA_B I_A = I_B J_A = J_B R_A = R_B X_A = X_B T_A = T_B CALL FAR_SIDE(IKNT, JKNT, BRAD, BCHI, PARAM_LOS, INSIDE, & I_A, J_A, T_A, R_A, X_A, PASS_V, IPHASE_V, & I_B, J_B, T_B, R_B, X_B, OMEGA) DELTA_B = SQRT(R_B**2 + R1**2 - 2.0D0*R_B*R1*COS(OMEGA)) C ----------------------------------------------------------------------------- C ACCUMULATED EMISSION CONTRIBUTIONS C ----------------------------------------------------------------------------- IF ( INSIDE ) THEN C SINGLY-SCATTERED COMPONENT SSOL = 0.0D0 C _____ MODIFICATION OF LIMITS DUE TO SHADOW IF ((ISHAD.EQ.0).OR.(DELTA_B.LE.DSHAD)) THEN ILLUM = .FALSE. ELSE DUPR = DELTA_B DLWR = MAX(DSHAD,DELTA_A) ILLUM = .TRUE. END IF C _____ INTEGRATING IF (ILLUM) THEN DO IDEL = 1,8 DL = ((DUPR - DLWR) * XX08(IDEL) + DUPR + DLWR) / 2.0D0 WDL = (DUPR - DLWR) * WW08(IDEL) / 2.0D0 RL = SQRT(R1**2 + DL**2 - 2.0D0*R1*DL*COS(PI-THETA)) OMEGL = THETA - ASIN(RSMU/RL) XL = ACOS(CX1*COS(OMEGL)+SX1*SIN(OMEGL)*CP1) CALL DLOCAL(ITHERM,THERMO,RL,XL,HLOC,O2LOC,TLOC) C _____ _____ LOCAL SOLAR SOURCE FUNCTIONS IF (((RL*SIN(XL)).LE.SOLILLUMCHK).AND.(XL.GE.PID2)) THEN SSOL = 0.0D0 ELSE CALL ZSUN_LOS(ITHERM,THERMO,IKNT,JKNT,BRAD,BCHI, & I_A,J_A,RL,XL,XL,SOLPHI, & LPROF,SPDPT,WSPD,OSUN) SSOL = BRANCH*CENTER*HLOC*EXP(-OSUN(2))*OSUN(3) END IF ACER(1,LOOK) = ACER(1,LOOK) + WDL*ANSCAT*SSOL FCTR = SQRT(TEXO/TLOC) DO LP = 0,LPROF XPNT = 0.0D0 IF (LP.GE.1) XPNT = (FCTR * SPDPT(LP))**2 PRFL(1,LP,LOOK) = PRFL(1,LP,LOOK) & + WDL*ANSCAT*SSOL*FCTR*EXP(-XPNT) END DO END DO END IF C MULTIPLY-SCATTERED COMPONENT C _____ INTEGRATING DUPR = DELTA_B DLWR = DELTA_A DO IDEL = 1,8 DL = ((DUPR - DLWR) * XX08(IDEL) + DUPR + DLWR) / 2.0D0 WDL = (DUPR - DLWR) * WW08(IDEL) / 2.0D0 RL = SQRT(R1**2 + DL**2 - 2.0D0*R1*DL*COS(PI-THETA)) OMEGL = THETA - ASIN(RSMU/RL) XL = ACOS(CX1*COS(OMEGL)+SX1*SIN(OMEGL)*CP1) CALL DLOCAL(ITHERM,THERMO,RL,XL,HLOC,O2LOC,TLOC) C _____ _____ LOCAL MULTIPLY-SCATTERED SOURCE FUNCTIONS (FROM INTERPOLATION) IF ((XL.GT.CHIN(1)).AND.(XL.LT.CHIN(JKNT))) THEN IF (XL.LE.CHIN(J_A)) THEN JBOX1 = J_A - 1 JBOX2 = J_A ELSE JBOX1 = J_A JBOX2 = J_A + 1 END IF DO ISPLN = 1,IKNT+2 YSMS(ISPLN) = D0SMS(ISPLN,JBOX1) D2YSMS(ISPLN) = D2SMS(ISPLN,JBOX1) END DO CALL SPLINT_LYAO(XSMS,YSMS,D2YSMS,IKNT+2,RL,SMS1) DO ISPLN = 1,IKNT+2 YSMS(ISPLN) = D0SMS(ISPLN,JBOX2) D2YSMS(ISPLN) = D2SMS(ISPLN,JBOX2) END DO CALL SPLINT_LYAO(XSMS,YSMS,D2YSMS,IKNT+2,RL,SMS2) RATIOX = (XL - CHIN(JBOX1))/(CHIN(JBOX2) - CHIN(JBOX1)) SMS = BRANCH*CENTER*HLOC*EXP(SMS1 + RATIOX*(SMS2-SMS1)) ELSE DO ISPLN = 1,IKNT+2 YSMS(ISPLN) = D0SMS(ISPLN,J_A) D2YSMS(ISPLN) = D2SMS(ISPLN,J_A) END DO CALL SPLINT_LYAO(XSMS,YSMS,D2YSMS,IKNT+2,RL,SMS) SMS = BRANCH*CENTER*HLOC*EXP(SMS) END IF ACER(2,LOOK) = ACER(2,LOOK) + WDL*SMS FCTR = SQRT(TEXO/TLOC) DO LP = 0,LPROF XPNT = 0.0D0 IF (LP.GE.1) XPNT = (FCTR * SPDPT(LP))**2 PRFL(2,LP,LOOK) = PRFL(2,LP,LOOK) & + WDL*SMS*FCTR*EXP(-XPNT) END DO END DO C TOTAL INTENSITY ACER(3,LOOK) = ACER(1,LOOK) + ACER(2,LOOK) DO LP = 0,LPROF PRFL(3,LP,LOOK) = PRFL(1,LP,LOOK) + PRFL(2,LP,LOOK) END DO IF ((I_B.LT.1).OR.(I_B.GT.IKNT)) GO TO 2222 ! exiting the volume END IF C ----------------------------------------------------------------------------- C WRAP UP C ----------------------------------------------------------------------------- GO TO 1111 2222 CONTINUE C xxxxxxxxxxxxxxxxxxxxxxxx C x END OF MAIN LOOP x C xxxxxxxxxxxxxxxxxxxxxxxx 3333 CONTINUE C 55555555555555555555555555555555555555555555555555555555555555555555555555555 C 555 FINAL OUTPUT 55555555555555555555555555555555555555555555555555555555 C 55555555555555555555555555555555555555555555555555555555555555555555555555555 C NORMALIZING LINE PROFILES TO LINE-CENTER FLUX DO LOOK = 1,ILOS DO LP = 0,LPROF PRFL(1,LP,LOOK) = PRFL(1,LP,LOOK) / PRFL(3,0,LOOK) PRFL(2,LP,LOOK) = PRFL(2,LP,LOOK) / PRFL(3,0,LOOK) PRFL(3,LP,LOOK) = PRFL(3,LP,LOOK) / PRFL(3,0,LOOK) END DO END DO EXOBASE_T = TEXO DOPPLER_SPEED = VELT C CONVERTING TO ABSOLUTE APPARENT COLUMN EMISSION RATES (RAYLEIGHS) C keep in mind that the line-center solar flux is in per-Angstrom units, C so that the wavelength doppler width must be in Angstroms. DPPLR = WAVELN * (VELT / SPEEDC) ABFCTR = RTPI * DPPLR / 1.0D6 ! unit line-center solar flux DO LOOK = 1,ILOS ACER(1,LOOK) = ABFCTR * ACER(1,LOOK) ACER(2,LOOK) = ABFCTR * ACER(2,LOOK) ACER(3,LOOK) = ABFCTR * ACER(3,LOOK) END DO C ----------------------------------------------------------------------------- 9009 CONTINUE RETURN END C =============================================================================