1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 1 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0001 C$Procedure GTARG 0002 C 0003 PROGRAM GTARG 0004 C 0005 C******************************************************************************* 0006 C 0007 C$ Purpose 0008 C 0009 C Ground track prediction and maneuver targeting for ground track 0010 C maintenence. 0011 C 0012 C Reference: B.E.Shapiro & R.S.Bhat,"GTARG-The TOPEX/POSEIDON 0013 C Ground Track Maintenance Maneuver Targeting Program," AIAA 0014 C Paper 93-1129, AIAA/AHS/ASEE Aerospace Design Conference, 0015 C Feb. 16-19, 1993, Irvine CA. See references of above reference 0016 C for further reference material. 0017 C 0018 C******************************************************************************* 0019 C 0020 C Copyright (C) 1993, California Institute of Technology. U.S. 0021 C Government Sponsorhip under NASA Contract NAS7-918 is 0022 C acknowledged. 0023 C 0024 C******************************************************************************* 0025 C 0026 C$ Log 0027 C 0028 C Date Name Description 0029 C ----------------------------------------------------------------------------- 0030 C 25-JUL-1990 Eric Cannell Creation of GTARG. 0031 C Targeting algorithm. 0032 C Mean element orbit propagation. 0033 C EZPLOT output. 0034 C Version 2.0 0035 C 7-MAY-1991 Bruce Shapiro Average Orbital Density. 0036 C User control of plot format. 0037 C 0038 C Version 3.0 0039 C 5-Aug-1991 Modify logic to prevent failure if initial 0040 C orbit is class 3 (DV too small) or 0041 C class 6 (DV is too large) in targeting 0042 C modes 0043 C Include Error Model, first guess logic, 0044 C user input of Gravity field. 0045 C Add second plot file for bias breakdown 0046 C 0047 C Version 3.1 0048 C 20-APR-1992 Apply maneuver as Delta-V to cartesian 0049 C rather than only a Delta-a 0050 C Allow yaw/pitch offset for maneuver. 0051 C Interpretive listing of input control 0052 C parameters instead of namelist dump. 0053 C 0054 C Version 4.0 0055 C 8-SEP-1992 User input of VMA table. 0056 C Interpretive listings of solar & geomagnetic 0057 C data and error sigmas. 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 2 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0058 C 0059 C Version 5.0 0060 C 16-FEB-1993 Table look-up for extra along-track forces. 0061 C Optional Constant-atmosphere density. 0062 C Optional Constant drag-area. 0063 C Remove dependence on JPL-library links 0064 C for COSMIC release. 0065 C Combine control (INPUT) namelist, gravity 0066 C field, astrodynamic constants, VMA 0067 C table, reference orbit grid all into 0068 C a single input namelist. 0069 C Tabular output of elements & ground track 0070 C for possible porting to spread sheet 0071 C for third party plotting. 0072 C User choice to print input data on output. 0073 C 0074 C Version 5.1 Table of dates in extra along-track forces 0075 C Feb. 16, 1993 rather than one point per date 0076 C 0077 C Version 5.2 Option of accumulating (a) daily drag errors 0078 C Feb. 26, 1993 and (b) daily boost errors either 0079 C (1) linearly or (2) in quadrature 0080 C Theory is that linear accumulation 0081 C treats each days error as completely 0082 C dependent of the previous days, while 0083 C accumulating in quadrature treats each 0084 C days error as a wholly independent event 0085 C from the previous days. 0086 C Table of daily boost errors 0087 C Daily boost in quadrature or linear accum. 0088 C Slope in solar flux, Kp 0089 C Bias in solar flux, Kp 0090 C 0091 C Version 5.3 Calculate Verification Site Overflight 0092 C 3-May-1993 Longitudinal Errors 0093 C 0094 C Version 6.0 Remove final known boo-boos for COSMIC 0095 C release 0096 C 0097 C$ Namelist_Input 0098 C 0099 C Namelist: $FLXKP (in FLUX_DATA file) 0100 C Name Type Dim Default Units Description 0101 C ----------------------------------------------------------------------------- 0102 C TEXT C*60 1 'no finger print' - finger print 0103 C NUMDAY I 1 0 - number of daily values in FLUX_DATA 0104 C DAYONE C*11 1 ' ' - epoch ('dd-mmm-yyyy') of the first 0105 C day in FLUX_DATA 0106 C FLX DP MXFLUX all 0D0 --> daily 10.7 solar flux values in 0107 C 10**-22 watts/m**2/cycle/sec 0108 C FLXBAR DP MXFLUX all 0D0 --> daily 81 day moving average of FLX 0109 C in 10**-22 watts/m**2/cycle/sec 0110 C KP DP MXFLUX all 0D0 - geomagnetic Kp planetary index 0111 C DFLX DP MXFLUX ALL 0.0 - ERROR IN FLUX 0112 C DFLXBAR DP MXFLUX ALL 0.0 - ERROR IN FBAR 0113 C DKP DP MXFLUX ALL 0.0 - ERROR IN KP 0114 C 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 3 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0115 C Namelist: $GTBIAS: defines ground track biases (for drag usually) 0116 C 0117 C Name Type Dim Units Description 0118 C ----------------------------------------------------------------------------- 0119 C GTBIAS_DRAG 0120 C DP NGTBIAS_DRAG 0 km contribution to ground track 0121 C bias due to drag computation 0122 C errors, including solar flux 0123 C errors; a table of ground 0124 C track biases, one per day. 0125 C NGTBIAS_DRAG 0126 C I 1 0 days number of days of bias data 0127 C in GTBIAS_DRAG 0128 C 0129 C Namelist: $INPUT (in IN_GTARG file) 0130 C Name Type Dim Default Units Description 0131 C ----------------------------------------------------------------------------- 0132 C ATARGONLY L 1 F km if true, will only 0133 C perform a first guess targeting 0134 C calculation 0135 C ATDEN DP 1 kg/km3 default constant density atmosphere 0136 C ATDEN_POLY DP 5 Chebyshev polynomial for density 0137 C used when ATMOS = 'POLYNOMIAL' 0138 C ATDEN_SEMI DP 2 Magnitude & Phase for Semiannual 0139 C variation used when ATMOS 0140 C = 'POLYNOMIAL' 0141 C ATDEN_ANN DP 2 Magnitude & Phase used for Annual 0142 C variation used when ATMOS 0143 C = 'POLYNOMIAL' 0144 C ATMOS c*10 1 - 'TOPEXJR' - user JRSMPL2 0145 C 'CONST' - use ATDEN 0146 C 'POLYNOMIAL' - use polynomial 0147 C in ATDEN_POLY 0148 C 'USER' - use user supplied function 0149 C BFILE C*25 1 'GTARG.BOOT' - GTARG bootstrap file name 0150 C BNDFUZ DP 1 .01D0 km if STRAT = 'LONG', BNDFUZ is the 0151 C fuzziness of BOUNDS(1). If the 0152 C west point of the ground track is 0153 C in the range BOUNDS(1) to BOUNDS(1) 0154 C + BNDFUZ, that is close enough. 0155 C Note that BNDFUZ is used only on 0156 C the east side of the west boundary. 0157 C Under no circumstances should the 0158 C spacecraft cross over the west 0159 C boundary. 0160 C BOOT L 1 F - if true, GTARG will write out the 0161 C final orbit and epoch to GTARG.BOOT 0162 C so the user can bootstrap into 0163 C the next run of GTARG. Basically, 0164 C GTARG.BOOT will contain values for 0165 C ORBIT and DATE. 0166 C BOUNDS DP 2 -1D0,+1D0 km the low and high boundaries (in 0167 C that order) of the valid ground 0168 C track band as measured from the 0169 C reference ground track. Usually, 0170 C BOUNDS will be something like 0171 C -/+ 1 km. But, BOUNDS could be 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 4 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0172 C (.5,1.5), i.e., fully right of 0173 C the reference ground track. 0174 C BOUNDS is used only when DAYS=>0 0175 C and STRAT not = 'RUNOUT'. See 0176 C Restriction #5. 0177 C CD DP 1 0D0 - if DRAG=T, constant of atmospheric 0178 C drag on s/c. i.e., about 2.3 0179 C DATE C*25 1 ' ' - epoch of ORBIT in TIMETRANS 0180 C format, 'dd-mmm-yyyy hh:mm:ss.ffff' 0181 C DAYS I 1 0 days if STRAT = 'RUNOUT', then ground 0182 C track is run out DAYS days, 0183 C regardless of whether or not the 0184 C ground track lies within or without 0185 C the valid band defined by BOUNDS. 0186 C DELTA_A_OD DP 1 0d0 meters Delta-A error due to O.D. 0187 C DRAG L 1 T - if true, drag will be turned on 0188 C DRAGAREA DP 1 m**2 constant drag area (DRAGMODEL='CONST') 0189 C DRAGMODEL c*10 1 'VMA' - TOPEX VMA Model 0190 C 'CONSTANT' - use DRAGAREA 0191 C DRAGBIASMODE c*4 'FLUX' - 'FLUX' or 'GT' - which set of 0192 C sigmas to used for the 0193 C drag contribution to 0194 C ground track bias 0195 C DSMADT DP (2) 0d0 m/day additional (d/dt)(SMA) to add 0196 C to vector after all other 0197 C models are included 0198 C DSMADT_DATA DP MXFLUX 0d0 m/day daily array of decay rates 0199 C not accounted for by any 0200 C other model 0201 C DSMADT_DATES c*25 MXFLUX ' ' - DATES for data in dsmadt_data. 0202 C values have format such as 0203 C 23-jul-1993 09:17:23.1234 0204 C will not be used unless 0205 C dsmadt_epoch = ' ' 0206 C DSMADT_EPOCH C*25 epoch of data in dsmadt_data; 0207 C The data in dsmadt_data is 0208 C assumed to have one point per 0209 C day starting with dsmadt_epoch. 0210 C Set this = ' ' to use dsmadt_dates 0211 C instead 0212 C DSMADT_DATA_SIGMA DP 1 Constant Sigma for dsmadt_data 0213 C if negative, will use array 0214 C of data in DSMADT_SIGMAS 0215 C DSMADT_SIGMAS DP MXFLUX Sigmas corresponding to dsmadt_datas 0216 C Will only be used if 0217 C DSMADT_DATA_SIGMA < 0.0 0218 C DSMASWITCH C*25 1 time to switch dsmadt from (1) 0219 C value to (2) value 0220 C DV DP 1 0D0 mm/sec maneuver magnitude 0221 C DVQUANTA DP 1 0d0 mm/sec delta v quantization factor 0222 C DVbracket i 3 0,0,1 counts when dvquanta > 0, range of 0223 C runout runs to make after 0224 C targeting run, measured 0225 C with respect to the targeted 0226 C deltav; e.g., 2,3,1 means from 0227 C 2 quanta below to 3 quanta 0228 C above, in increments of 1 quanta 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 5 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0229 C do a runout of the unbiased 0230 C ground track. 0231 C earth_rad DP 1 6378.140 kilomterst 0232 C ECHO_BIAS L 1 T - write bias data to output file 0233 C ECHO_FLUX L 1 T - write flux data to output file 0234 C ECHO_GRAV L 1 T - write gravity coefficients to 0235 C output file 0236 C ECHO_INPT L 1 F - echo the input namelist as is 0237 C ECHO_XING L 1 T - write equator crossing reference 0238 C to output file 0239 C ECHO_BOOST L 1 T - write out the table of da/dt if 0240 C one is supplied 0241 C ECHO_VMATAB L 1 T - if VMA model is used, print out 0242 C the VMA table which is supplied 0243 C EZHEAD L 1 T - if true, GTARG writes out the 0244 C $ZFRAME namelist into GTARG.Z 0245 C FBAR_BIAS DP 6 all 0.0 F10.7 bias polynominal 0246 C FBAR_SLOPE slope 0247 C FLUX_BIAS bias 0248 C FLUX_SLOPE slope 0249 C The above polynomials are 0250 C are applied (added) to the 0251 C FBAR & FLX arrays. SLOPE 0252 C accounts for SOLAR CYCLE 0253 C slopes, BIAS accounts for 0254 C prediction slopes. 0255 C (1) = constant 0256 C (2) = linear in time 0257 C (3) = t^2, (4) = t^3, (5) = t^4 0258 C T = 0 at DAYONE of flux file 0259 C GTBIASFILE c*25 1 'GTBIAS.DAT' - name of file containing GT 0260 C biases information 0261 C JEARTH DP (2:29) all 0d0 - Earth zonal coefficients 0262 C LSFLAG L 1 T - if true, luni-solar gravitational 0263 C effects are on in LSRGP Library 0264 C LTOP I 1 0 - maximum L index in Earth gravity 0265 C model 0266 C M I 1 4 - forces GTARG to examine every M-th 0267 C ascending node. For example, one 0268 C hopes that M=4 is not only faster, 0269 C but almost as acurate as M=1. 0270 C M must be >= 1 and <= 10. 0271 C MAKE_BIAS_FILE L 1 T create a new bias file. 0272 C the name of the file is in 0273 C NEWBIASFILE; File will be create 0274 C if MAKE_BIAS_FILE = TRUE and 0275 C drag_BIAS_MODE = 'FLUX'; else 0276 C if drag_bias_mode = 'GT' than 0277 C an input file given by GTBIASFILE 0278 C is read in so new biases are 0279 C never calculated 0280 C MASS DP 1 0D0 kg if DRAG=T, mass of spacecraft 0281 C NEWBIASFILE C*80 1 'NEWBIASES.OUT' - 0282 C mu_earth DP 1 398600.44807345D0 kg**3/sec**2 0283 C mu_moon DP 1 4902.7927809104D0 kg**3/sec**2 0284 C mu_sun DP 1 132712441933.00783456D0 kg**3/sec**2 0285 C NDSMADT_DATA I 1 0 - Number of days of data in DSMADT_DATA 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 6 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0286 C NSITES I Number of sites (<10) given 0287 C in SITE_LOC 0288 C ODAYS r*4 1 300 days Number of days on EZPLOT 0289 C ODEVICE c*12 1 '/IMPRESS' - EZPLOT output device 0290 C OFILE C*25 1 'OUTPUT.LIS' - output file name 0291 C ORBIT DP 6 6*0D0 km,deg classical orbital elements 0292 C (a,e,i,LAN,w,M) 0293 C ORBITS I 1 - - number of equator crossings in 0294 C array XINGS 0295 C PITCH DP 1 0.0 deg Pitch angle for manevuer direction 0296 C PLOT 0297 C PLOTDATE C*25 1 DATE WHICH CORRESPONDS to t=0 on 0298 C the ground track plots 0299 C PLOT_COMPONENTS 0300 C PLOTCYCLE 0301 C PLOTTITLE C*80 Title for Plot 0302 C QUAD_ERR_BOOST L 1 T/F add successive orbital errors 0303 C in quadrature/linearly for boost 0304 C contribution. 0305 C QUAD_ERR_DRAG L 1 T/F add successive orbital errors 0306 C in quadrature/linearly for drag 0307 C contribution. 0308 C sid_day DP 1 86164.09055 seconds 0309 C SIGMA_DV_FIXED 0310 C DP 1 0D0 mm/sec Fixed error in DV execution 0311 C SIGMA_DV_PROP 0312 C DP 1 0d0 - Proportional error in DV execution 0313 C as a proportion of the delta v 0314 C SIGMA_DSMA DP 2 0d0 m/day Error Sigmas in dsmadt(i) 0315 C SIGMA_SF_DVOD 0316 C DP 1 1.0 - Scale factor to use for computing 0317 C the biased ground track based 0318 C upon contribution due to orbit 0319 C determination and maneuver ex- 0320 C cution errors. 1.645 = normal 0321 C distribution 95 percentile 0322 C errors. 0323 C SIGMA_SF_BOOST 1.0 0324 C SIGMA_SF_DRAG 0325 C DP 1 1.0 - same as sigma_sf_DVOD but for drag 0326 C contribution 0327 C SITE_LOC 10 deg site_loc(1,I) = longitude 0328 C site_loc(2,I) = latitude 0329 C SITE_LOC_TYPE 1 'GEODETIC' 'GEODETIC' or 'GEOCENTRIC' 0330 C SITE_NAME 10 Names of site I 0331 C SITE_NODE 10 Ascending node # of orbit on 0332 C which overflight of sight I 0333 C takes place 0334 C SITE_STRAT 'PROP' 'PROP' or 'KEPLER' (KEPLER is 0335 C faster but less accurate) 0336 C SITE_SYM 10 PGPLOT graphics symbol for sites 0337 C SITES L 1 .false. Calculate site offset T/f 0338 C STRAT C*6 1 'RUNOUT' - see Purpose. 0339 C TARGET_STRAT C*8 1 'UNBIASED' - if STRAT is not 'RUNOUT' 0340 C 'UNBIASED', 'WESTGT', 'EASTGT' 0341 C selects which of the ground 0342 C tracks to do the targeting 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 7 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0343 C on 0344 C TERMINAL C*12 1 'VT100' type of terminal 0345 C TESTCASE C*80 1 Label to print on page 1 of 0346 C report file 0347 C TIMFUZ DP 1 1D0 days if STRAT = 'EAST' or 'WEST', if 0348 C GTARG finds a ground track that 0349 C crosses a boundary within TIMFUZ 0350 C of TIMTGT, then that ground track 0351 C adequately targeted. 0352 C TIMTGT DP 1 0D0 days if STRAT = 'EAST' or 'WEST', the 0353 C desired time to the east or west 0354 C boundaries, respectively 0355 C WATCH L 1 T if true, monitor calculations 0356 C WATCHINT L 1 F if true, then GTARG also records 0357 C the intermediate ground tracks 0358 C that are found prior to the 0359 C properly targeted one 0360 C XINGS DP MXING - deg equator crossings of reference 0361 C ground track. 0362 C YAW DP 1 0 deg Yaw angle for maneuver direction 0363 C ZFILE C*25 1 'ground_track.plot' - EZPLOT data file name 0364 C ZFILE2 C*25 1 'bias_breakdown.plot' 0365 C 0366 C 0367 C$ Namelist_Output 0368 C 0369 C Namelist: $ZFRAME: defines plot frame, not the curves and text inside it 0370 C Name Type Dim Units Description 0371 C ----------------------------------------------------------------------------- 0372 C DEVICE C*12 1 - PGPLOT plot device /IMPRESS 0373 C SUMMRY L 1 - false, no EZPLOT summary file is written 0374 C TITLE C*60 1 - title depends on STRAT 0375 C WINDO R 4 --> PGPLOT window boundaries in world coords, 0376 C (left-x,right-x,bottom-y,top-y). Depends on 0377 C BOUNDS and y-axis runs from 0 to 300 days. 0378 C XTITLE C*23 1 - title of x-axis, 'ground track offset, km' 0379 C YTITLE C*35 1 - title of y-axis, 'days from' // DATE 0380 C 0381 C 0382 C Namelist: $ZLINE: defines boundary curves 0383 C Name Type Dim Units Description 0384 C ----------------------------------------------------------------------------- 0385 C NPTS I 1 - number of (x,y) data points 0386 C STYLE I 1 - PGPLOT line style: 0387 C STYLE = 2 --> dashed 0388 C X RL 2 - x-data of boundary 0389 C Y RL 2 - y-data (0 to 1000 just to be safe) 0390 C 0391 C$ Restrictions 0392 C 0393 C 1] Inclination of the satellite orbit cannot be zero. 0394 C 0395 C 2] If DRAG=T, then both spacecraft mass (MASS) and spacecraft coefficient 0396 C of atmospheric drag must be > 0. 0397 C 0398 C 3] The maximum L index in the Earth gravity model (LTOP) must be in 0399 C the range of [2..29]. 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 8 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0400 C 0401 C 4] The number of daily values in the FLUX_DATA file (NUMDAY) must be in the 0402 C range of [1..MXFLUX]. 0403 C 0404 C 5] BOUNDS(1) + BNDFUZ < BOUNDS(2) 0405 C 0406 C 6] 1 <= M <= 10. 0407 C 0408 C$ Files 0409 C 0410 C File Name Unit Description 0411 C ----------------------------------------------------------------------------- 0412 C * * standard I/O 0413 C IN_GTARG 7 namelist_input_file with $INPUT 0414 C OFILE 8 text output file 0415 C FLUX_DATA 9 flux data file with $FLXKP 0416 C ZFILE 11 EZPLOT data file of ground track plot 0417 C BFILE 12 bootstrap file of final orbit and epoch 0418 C GTBIASFILE 14 File containing GT Biases due to FLUX 0419 C zfile2 16 EZPLOT data file with ground track bias plot 0420 C NEWBIASFILE 17 Output file containing calculated biases due 0421 C 0422 C$ Parameters 0423 C 0424 INTEGER MXFLUX 0425 PARAMETER ( MXFLUX = 1000 ) 0426 0427 INTEGER MXINGS 0428 PARAMETER ( MXINGS = 200 ) 0429 0430 INTEGER MX_BIAS_DAYS 0431 PARAMETER ( MX_BIAS_DAYS = 1000 ) 0432 0433 INTEGER MX_SITES 0434 parameter ( MX_SITES = 10 ) 0435 0436 INTEGER MX_OVERFLIGHTS 0437 parameter ( MX_OVERFLIGHTS = 100 ) 0438 double precision PI 0439 parameter ( PI = 3.14159265358979323846 ) 0440 C 0441 C$ Declarations_of_Input_and_Output_Arguments 0442 C 0443 C 0444 C Via $FLXKP. 0445 C 0446 CHARACTER*11 DAYONE 0447 DOUBLE PRECISION FLX ( MXFLUX ) 0448 DOUBLE PRECISION FLXBAR ( MXFLUX ) 0449 DOUBLE PRECISION KP ( MXFLUX ) 0450 DOUBLE PRECISION DFLX ( MXFLUX ) 0451 DOUBLE PRECISION DFLXBAR ( MXFLUX ) 0452 DOUBLE PRECISION DKP ( MXFLUX ) 0453 INTEGER NUMDAY 0454 CHARACTER*60 TEXT 0455 C 0456 C Via $INPUT. GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 9 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0457 C 0458 LOGICAL ATARGONLY 0459 DOUBLE PRECISION ATDEN, ATDEN_POLY(5), ATDEN_SEMI(2) 0460 double precision ATDEN_ANN(2) 0461 CHARACTER*10 ATMOS 0462 CHARACTER*80 BFILE 0463 DOUBLE PRECISION BNDFUZ 0464 LOGICAL BOOT 0465 character*12 boost_ERROR_MODEL, DRAG_ERROR_MODEL 0466 DOUBLE PRECISION BOUNDS ( 2 ) 0467 DOUBLE PRECISION CD 0468 CHARACTER*25 DATE, DSMASWITCH, DSMADT_EPOCH 0469 character*25 dsmadt_dates(MXFLUX) 0470 double precision xdsmadt_dates(MXFLUX) 0471 INTEGER DAYS 0472 DOUBLE PRECISION DELTA_A_OD 0473 LOGICAL DRAG 0474 character*10 dragmodel 0475 double precision dragarea 0476 character*4 dragbiasmode, terminal*12 0477 double precision dsmadt(2), tsmaswitch 0478 double precision dsmadt_data (MXFLUX) 0479 double precision dsmadt_data_sigma 0480 double precision DSMADT_SIGMAS(MXFLUX) 0481 integer ndsmadt_data 0482 DOUBLE PRECISION DV 0483 integer dvbracket ( 3 ) 0484 DOUBLE PRECISION DVQUANTA 0485 LOGICAL ECHO_bias, echo_flux, echo_grav 0486 LOGICAL echo_xing, echo_inpt, echo_boost 0487 LOGICAL sites 0488 LOGICAL EZHEAD, echo_VMATAB 0489 logical flux_slope_input, fbar_slope_input 0490 logical flux_bias_input, fbar_bias_input 0491 double precision FLUX_SLOPE(6), FBAR_SLOPE(6) 0492 double precision FLUX_BIAS(6), FBAR_BIAS(6) 0493 double precision jearth (2:29) 0494 LOGICAL LSFLAG 0495 INTEGER LTOP 0496 INTEGER M 0497 logical make_bias_file 0498 DOUBLE PRECISION MASS 0499 character*80 newbiasfile 0500 integer noverflights(MX_SITES) 0501 integer nsites 0502 REAL*4 ODAYS 0503 CHARACTER*12 ODEVICE 0504 CHARACTER*80 OFILE 0505 DOUBLE PRECISION ORBIT ( 6 ) 0506 INTEGER ORBITS 0507 double precision overflights(MX_SITES, MX_OVERFLIGHTS, 5) 0508 DOUBLE PRECISION PITCH 0509 character*25 plotdate 0510 logical plot, plotboost, plot_components 0511 logical plotcycle, plotsite 0512 character *80 PlotTitle, Testcase 0513 logical quad_err_boost, quad_err_drag GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 10 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0514 integer REV 0515 DOUBLE PRECISION SIGMA_DV_FIXED, SIGMA_DSMA(2) 0516 DOUBLE PRECISION SIGMA_DV_PROP, sigma_SF_Boost 0517 DOUBLE PRECISION SIGMA_Sf_DVOD, sigma_sf_drag 0518 double precision SITE_LOC(2,MX_SITES) 0519 character*10 SITE_LOC_TYPE 0520 integer SITE_NODE(MX_SITES) 0521 character*10 SITE_NAME(MX_SITES) 0522 integer SITE_SYM(MX_SITES) 0523 CHARACTER*6 STRAT, SITE_STRAT 0524 character*80 GTBIASFILE 0525 character*8 target_strat 0526 DOUBLE PRECISION TIMFUZ 0527 DOUBLE PRECISION TIMTGT 0528 double precision vmatab (3,-90:90) 0529 double precision careas(2), breakpts(2) 0530 LOGICAL WATCH, WATCHINT 0531 DOUBLE PRECISION XINGS ( MXINGS ) 0532 DOUBLE PRECISION YAW 0533 CHARACTER*80 ZFILE, zfile2 0534 0535 C 0536 c VIA $GTBIAS 0537 C 0538 INTEGER NGTBIAS_DRAG 0539 DOUBLE PRECISION GTBIAS_DRAG (MX_BIAS_DAYS) 0540 0541 C Via $ZFRAME. 0542 C 0543 CHARACTER*12 DEVICE 0544 LOGICAL SUMMRY 0545 CHARACTER*60 TITLE 0546 REAL WINDO ( 4 ) 0547 CHARACTER*50 XTITLE 0548 CHARACTER*35 YTITLE 0549 C 0550 C Via $ZLINE. 0551 C 0552 INTEGER NPTS, SYMBOL 0553 INTEGER STYLE 0554 REAL X ( MX_OVERFLIGHTS ), XTXT, YTXT 0555 REAL Y ( MX_OVERFLIGHTS) 0556 C 0557 C Global parameters 0558 C 0559 double precision earth_rad ! in kilomters 0560 double precision mu_earth ! km**3/sec 0561 double precision mu_moon ! km**3/sec 0562 double precision mu_sun ! km**3/sec 0563 double precision sid_day ! seconds 0564 C 0565 C - derived constants, in block physical_constants 0566 C 0567 double precision earth_freq ! radians / second 0568 double precision earth_rate ! meters / day 0569 double precision deg_to_km ! kilometers/deg 0570 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 11 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0571 0572 C 0573 C$ Declarations_of_Local_Variables 0574 C 0575 CHARACTER*25 DATEND, sitedate 0576 character * 9 aday 0577 character * 8 atime 0578 real*4 plotdelta, plotepoch 0579 LOGICAL ERROR 0580 DOUBLE PRECISION ORBEND ( 6 ) 0581 character*2 II 0582 real cputime, elapsedtime,clockstart,clockend 0583 integer ipage 0584 character*80 input_file_name, flux_file_name, 0585 * boot_file_name, 0586 * gtbias_file_name, 0587 * plot_file_name, output_file_name, 0588 * table_file_name, output_message, 0589 * plot_file2_name, NEWBIASFILE_NAME 0590 0591 C 0592 C$ External_Statements 0593 C 0594 logical checkdates 0595 external checkdates 0596 0597 DOUBLE PRECISION RNG360 0598 EXTERNAL RNG360 0599 0600 character*8 goto_string, YESNO*3, yesnostring*20 0601 external goto_String, YESNO, yesnostring 0602 0603 external setcpu 0604 real setcpu 0605 0606 external getcpu 0607 real getcpu 0608 0609 external ch2sec, ch2jd, sec2ch 0610 double precision ch2sec, ch2jd 0611 0612 character*24 sec2ch, ajd(10) 0613 double precision xjd0,xjd(10) 0614 0615 double precision SITE_GCLAT(MX_SITES), flat 0616 C 0617 C$ Namelists 0618 C 0619 NAMELIST / FLXKP / TEXT , NUMDAY , DAYONE , FLX , FLXBAR , 0620 & KP, DFLX, DFLXBAR, DKP 0621 NAMELIST / GTBIAS / NGTBIAS_DRAG, GTBIAS_DRAG 0622 NAMELIST / INPUT / 0623 & ATARGONLY, atden, ATDEN_ANN, ATDEN_POLY, 0624 & ATDEN_SEMI, atmos, BFILE, BNDFUZ, 0625 & BOOST_ERROR_MODEL, 0626 & BOOT, BOUNDS, breakpts, careas, CD, 0627 & DAYS, DATE, DELTA_A_OD, DRAG, dragarea, GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 12 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0628 & DRAG_ERROR_MODEL, 0629 & dragmodel, dsmadt, dsmadt_data, 0630 & dsmadt_data_sigma, dsmadt_dates, dsmadt_epoch, 0631 & dsmadt_sigmas, dsmaswitch, DV, 0632 & dvbracket, DVQUANTA, earth_rad, echo_bias, echo_boost, 0633 & echo_flux, echo_grav, echo_inpt, 0634 & echo_vmatab, echo_xing, 0635 & EZHEAD, FBAR_BIAS, FBAR_SLOPE, FLAT, 0636 & FLUX_BIAS, FLUX_SLOPE, 0637 & GTBIASFILE, JEARTH, LSFLAG , LTOP , 0638 & M, make_bias_file, MASS, mu_earth, 0639 & mu_moon, mu_sun, ndsmadt_data, newbiasfile, NSITES, 0640 & ODAYS, 0641 & ODEVICE, OFILE, ORBIT, orbits, pitch, 0642 & PLOT, plotboost, PLOT_COMPONENTS, PLOTCYCLE, 0643 & plotdate, plotsite, plotTitle, 0644 & rev, sid_day, sigma_dsma, 0645 & SIGMA_DV_FIXED, SIGMA_DV_PROP, 0646 & sigma_sf_drag, sigma_sf_boost, SIGMA_SF_DVOD, 0647 & SITE_LOC, SITE_LOC_TYPE, SITE_NODE, SITE_NAME, Sites, 0648 & SITE_STRAT, SITE_SYM, 0649 & STRAT, target_strat, terminal, TESTCASE, 0650 & TIMFUZ, TIMTGT, vmatab, WATCH, WATCHINT, 0651 & xings, yaw, ZFILE, zfile2 0652 0653 NAMELIST / ZFRAME / DEVICE , SUMMRY , TITLE , WINDO , XTITLE , 0654 & YTITLE 0655 NAMELIST / ZLINE / NPTS , STYLE , X , Y, SYMBOL, XTXT, 0656 & YTXT, TEXT 0657 0658 common /tt/ terminal 0659 common /boost/ ndsmadt_data, dsmadt_data, dsmadt_epoch, 0660 & dsmadt_data_sigma, plotboost, dsmadt_dates, 0661 & xdsmadt_dates, dsmadt_sigmas 0662 common /error_flags/ quad_err_boost, quad_err_drag 0663 common /dragblock/ dragmodel, dragarea, atmos, atden, 0664 & FLUX_SLOPE, FBAR_SLOPE, FLUX_BIAS, FBAR_BIAS, 0665 & ATDEN_POLY, ATDEN_ANN, ATDEN_SEMI 0666 common /vma/vmatab, careas, breakpts 0667 common / physical_constants / 0668 & earth_rad, earth_freq, earth_rate, mu_earth, 0669 & mu_moon, mu_sun, sid_day, deg_to_km, flat 0670 common /site_data/ NSITES, SITE_LOC, SITE_NODE, SITE_GCLAT, 0671 & SITE_NAME, SITE_STRAT, overflights, noverflights 0672 0673 C 0674 C$ Data_Statements 0675 C 0676 DATA ATARGONLY /.false. / 0677 data atmos /'TOPEXJR'/ 0678 data atden /1.0d-6/ 0679 DATA ATDEN_POLY / 0.102444406127929688D+04, 0680 & 0.414349639892578125D+03, 0681 & -.581061572488852007D+01, 0682 & 0.720650161644122988D+00, 0683 & 0.842769258090778408D-04 / 0684 data ATDEN_SEMI /-0.0791350355550989d+00, GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 13 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0685 & 5.4144904588160714d+00/ 0686 data ATDEN_ANN /0.0454889572120465d+00, 0687 & 6.1054952840340235d+00/ 0688 DATA BFILE / 'GTARG.BOOT' / 0689 DATA BOOST_ERROR_MODEL /'OPTIMISTIC'/ 0690 data breakpts /15.0, 75.0/ 0691 DATA BNDFUZ / .01D0 / 0692 DATA BOOT / .FALSE. / 0693 DATA BOUNDS / -1D0 , 1D0 / 0694 DATA CD / 0D0 / 0695 DATA DATE / ' ' / 0696 DATA DAYONE / ' ' / 0697 DATA DAYS / 0 / 0698 DATA DELTA_A_OD /0.0D0 / 0699 DATA DFLX / MXFLUX * 0D0 / 0700 DATA DFLXBAR / MXFLUX * 0D0 / 0701 DATA DKP / MXFLUX * 0D0 / 0702 DATA DRAG / .TRUE. / 0703 data dragarea /10.0/ 0704 data dragmodel /'VMA'/ 0705 DATA dragbiasmode / 'FLUX' / 0706 DATA DRAG_ERROR_MODEL /'PESSIMISTIC'/ 0707 DATA dsmadt / 2*0.0D0 / 0708 DATA dsmadt_DATA /MXFLUX * 0d0 / 0709 data dsmadt_dates /MXFLUX * ' '/ 0710 DATA dsmadt_DATA_SIGMA / 0d0 / 0711 data dsmadt_sigmas /mxflux * 0d0/ 0712 DATA sigma_dsma / 2*0.0D0 / 0713 data dsmaswitch /'Not Used'/ 0714 DATA DV / 0.0D0 / 0715 data DVBRACKET / 0, 0, 1 / 0716 DATA DVQUANTA/ 0.0D0 / 0717 data echo_bias /.true. / 0718 data echo_boost /.true. / 0719 data echo_flux /.true. / 0720 data echo_grav /.true. / 0721 data echo_xing /.true. / 0722 data echo_inpt /.false. / 0723 data echo_vmatab /.true. / 0724 DATA EZHEAD / .TRUE. / 0725 DATA FBAR_BIAS /6*0D0/ 0726 DATA FLAT /0.003352891869d0/ 0727 DATA FLUX_BIAS /6*0D0/ 0728 DATA FBAR_SLOPE /6*0D0/ 0729 DATA FLUX_SLOPE /6*0D0/ 0730 DATA FLX / MXFLUX * 0D0 / 0731 DATA FLXBAR / MXFLUX * 0D0 / 0732 DATA GTBIAS_DRAG / MX_BIAS_DAYS * 0D0 / 0733 DATA GTBIASFILE / 'GTBIAS.DAT' / 0734 data make_bias_File /.true. / 0735 data ipage / 1 / 0736 DATA KP / MXFLUX * 0D0 / 0737 DATA LSFLAG / .TRUE. / 0738 DATA LTOP / 0 / 0739 DATA M / 4 / 0740 DATA MASS / 0.0D0 / 0741 DATA newbiasfile /'newbiases.out'/ GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 14 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0742 DATA NDSMADT_DATA /0/ 0743 data NOVERFLIGHTS/MX_SITES*0/ 0744 DATA NUMDAY / 0 / 0745 DATA NGTBIAS_DRAG / 1 / 0746 DATA NSITES /2/ 0747 DATA ODAYS / -1 / 0748 DATA ODEVICE / '/IMPRESS' / 0749 DATA OFILE / 'OUTPUT.LIS' / 0750 DATA ORBIT / 6 * 0.0D0 / 0751 DATA PITCH /0.0d0/ 0752 data plot /.true./ 0753 data plotboost /.false./ 0754 data plotcycle /.true./ 0755 data plot_components /.true./ 0756 data plotsite /.false./ 0757 DATA PLOTDATE /'?'/ 0758 DATA PlotTitle /'?'/ 0759 DATA QUAD_ERR_BOOST /.false./ 0760 DATA QUAD_ERR_DRAG /.false./ 0761 DATA REV /0 / 0762 DATA SIGMA_DV_FIXED / 0d0 / 0763 DATA SIGMA_DV_PROP / 0d0 / 0764 DATA SIGMA_SF_DVOD / 1.0d0 / 0765 data sigma_sf_drag / 1.0d0 / 0766 data sigma_sf_boost /1.0d0 / 0767 data site_LOC /239.31919, 34.4691, 0768 & 12.32054,35.54649,16*0.0d0/ 0769 data site_LOC_TYPE /'GEODETIC'/ 0770 data site_name /'NASA','CNES',8*'?'/ 0771 data site_NODE /22, 111,8*0/ 0772 data sites /.false. / 0773 data site_STRAT /'PROP'/ 0774 data site_SYM/0,7,5,2,4,6,3,12,8,9/ 0775 DATA STRAT / 'RUNOUT' / 0776 DATA target_strat / 'UNBIASED' / 0777 DATA TEXT / 'no finger print' / 0778 DATA TERMINAL /'VT100'/ 0779 DATA TESTCASE /'?'/ 0780 DATA TIMFUZ / 1D0 / 0781 DATA TIMTGT / 0D0 / 0782 DATA WATCH / .FALSE. / 0783 DATA WATCHINT/ .FALSE. / 0784 data YAW /0.0d0/ 0785 DATA ZFILE / 'GROUND_TRACK.PLOT' / 0786 DATA ZFILE2 / 'BIAS_BREAKDOWN.PLOT' / 0787 data JEARTH / 0788 & 0.10826258D-02 , -0.25338975D-05 , -0.16238211D-05 , 0789 & -0.22963180D-06 , 0.54309576D-06 , -0.35775823D-06 , 0790 & -0.20980278D-06 , -0.12070701D-06 , -0.24441360D-06 , 0791 & 0.23257025D-06 , -0.19259423D-06 , -0.22280385D-06 , 0792 & 0.11011675D-06 , -0.15949534D-07 , 0.41544562D-07 , 0793 & -0.87909637D-07 , -0.70704603D-07 , -0.45577223D-08 , 0794 & -0.17217485D-06 , 0.11404873D-09 , 0.16061855D-07 , 0795 & 0.14036748D-06 , 0.19771236D-07 , -0.10809433D-07 , 0796 & -0.59183191D-07 , -0.81329176D-07 , 0.17087477D-06 , 0797 & 0.86549317D-07 / 0798 data earth_rad / 6378.140 / GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 15 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0799 data mu_earth / 398600.44807345D0 / 0800 data mu_moon / 4902.7927809104D0 / 0801 data mu_sun / 132712441933.00783456D0 / 0802 data sid_day / 86164.09055 / 0803 0804 C 0805 C$ Method 0806 C-& 0807 0808 CHARACTER*20 LINK_TIME, LNKTIM 0809 EXTERNAL LNKTIM 0810 0811 C1 Print fingerprint information. 0812 0813 cputime = setcpu () 0814 clockstart = secnds(0.0) 0815 0816 LINK_TIME = LNKTIM() 0817 0818 print *,' ' 0819 print *,' ' 0820 print *,' ' 0821 print *,'*************************************************', 0822 & '***************************' 0823 print *,'* GTARG Ground Track Targeting ', 0824 & 'Program Ver. 6.0 created '//link_time(1:18)//' *' 0825 print *,'*************************************************', 0826 & '***************************' 0827 print *,'* Copyright (C) 1993, California Institute of Tec', 0828 & 'hnology. *' 0829 print *,'* U.S. Government Sponsorship under NASA Contract', 0830 & ' NAS7-918 is acknowledged.*' 0831 print *,'*************************************************', 0832 & '***************************' 0833 0834 print *, ' ' 0835 print *, 'Reading input namelist data ... ' 0836 0837 C1 Use OPSFOR to open the input file. 0838 0839 CALL OPSFOR ( 7 , 'IN_GTARG' , ERROR ) 0840 0841 IF ( ERROR ) THEN 0842 WRITE(*,'(/1X,''GTARG: cannot open file IN_GTARG.'')') 0843 STOP 0844 END IF 0845 0846 C1 Read the input namelist $INPUT and then close it. 0847 0848 READ ( 7 , INPUT ) 0849 CLOSE ( 7 ) 0850 0851 print *, 'Initializing ...' 0852 0853 C1 Use OPSFN to open the output file. 0854 0855 CALL OPSFN ( 8 , OFILE , ERROR ) GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 16 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0856 0857 call vmsdate ( aday ) 0858 call time ( atime ) 0859 0860 write (8,11) LINK_TIME, aday, atime 0861 11 format( ' ', 0862 & 79('*'), 0863 & /, ' ', '*',77x,'*', 0864 & /, ' ', '*',t36,'G T A R G',t80'*', 0865 & /, ' ', '*',t15,'Ground Track Maintenance ', 0866 & 'Maneuver Targeting Program',t80,'*', 0867 & /, ' ', '*',77x,'*', 0868 & /, ' ', 79('*'), 0869 & /, ' ', '*',77x,'*', 0870 & /, ' ', '* Version: ',A18, ' (6.0)', 0871 & t51, 'Run time: ',A9,' ',A8,' *', 0872 & /, ' ', '*',77x,'*', 0873 & /, ' ', 79('*'), 0874 & /,' * Copyright (C) 1993, California Institute ', 0875 & 'of Technology.',t80,'*', 0876 & /,' * U.S. Government Sponsorship under NASA Contract ', 0877 & 'NAS7-918 is acknowledged.', t80, '*', 0878 & /,' ',79('*')) 0879 0880 IF ( ERROR ) THEN 0881 WRITE(*,'(/1X,''GTARG: cannot open file '',A,''.'')') OFILE 0882 STOP 0883 END IF 0884 0885 0886 IF (TESTCASE.EQ.'?') then 0887 IF (PLOTTITLE.EQ.'?') then 0888 TESTCASE = 'GTARG '//STRAT//' Test Case' 0889 else 0890 TESTCASE = PLOTTITLE 0891 end if 0892 end if 0893 i=80 0894 do while ((TESTCASE(i:i).EQ.' ').and.(i.GT.1)) 0895 i=i-1 0896 end do 0897 0898 write(8,1001) testcase(1:i) 0899 0900 1001 format(/,1x,<(74-i)/2>x,('*'),/ 0901 & 1x,<(74-i)/2>x,'* ',a,' *'/ 0902 & 1x,<(74-i)/2>x,('*') ) 0903 0904 0905 C1 Check that BOUNDS(1) + BNDFUZ < BOUNDS(2). 0906 0907 IF ( BOUNDS(1) + BNDFUZ .GE. BOUNDS(2) ) THEN 0908 0909 WRITE(*,301) 0910 WRITE(8,301) 0911 301 FORMAT(//,' GTARG: BOUNDS(1) + BNDFUZ < BOUNDS(2).') 0912 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 17 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0913 STOP 0914 0915 END IF 0916 0917 C1 Check that 1 <= M <= 10. 0918 0919 IF ( M .LT. 1 .OR. 10 .LT. M ) THEN 0920 WRITE(*,302) M 0921 WRITE(8,302) M 0922 302 FORMAT(//,' GTARG: M(',I,') must be in the range [1..10].') 0923 STOP 0924 END IF 0925 0926 C1 Check that the inclination of satellite orbit is not zero. 0927 0928 IF ( ORBIT( 3 ) .EQ. 0.0D0 ) THEN 0929 WRITE(*,303) 0930 WRITE(8,303) 0931 303 FORMAT(//,' GTARG: Inclination cannot be zero.') 0932 STOP 0933 END IF 0934 C 0935 C Default start of plot to start of run 0936 C 0937 0938 if (PLOTDATE(1:1).eq.'?') PLOTDATE = DATE 0939 0940 TITLE = PLOTTITLE 0941 0942 C 0943 C Command Line Input Files 0944 C 0945 inquire (FILE='IN_GTARG', NAME=input_file_name) 0946 inquire (FILE='FLUX_DATA', NAME=flux_file_name ) 0947 C 0948 C Input files with name specified in $INPUT 0949 C 0950 inquire (FILE=gtbiasfile, NAME=gtbias_file_name ) 0951 C 0952 C output files with name specified in $INPUT 0953 C 0954 0955 C1 Convert the STRAT input to uppercase. 0956 0957 CALL UPCASE( STRAT ) 0958 CALL UPCASE( TARGET_STRAT ) 0959 CALL UPCASE( BOOST_ERROR_MODEL ) 0960 CALL UPCASE( DRAG_ERROR_MODEL ) 0961 CALL UPCASE( DRAGMODEL ) 0962 CALL UPCASE( ATMOS ) 0963 0964 C 0965 C For boost errors, 0966 C 'PESSIMISTIC' model - add daily errors linearly 0967 C 'OPTIMISTIC' model - add in quadrature (default) 0968 C 0969 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 18 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 0970 IF (BOOST_ERROR_MODEL .EQ. 'PESSIMISTIC') THEN 0971 QUAD_ERR_BOOST = .FALSE. 0972 ELSE IF (BOOST_ERROR_MODEL .EQ. 'OPTIMISTIC') then 0973 quad_ERR_BOOST = .TRUE. 0974 ELSE 0975 write(8,*) '>>> Invalid BOOST_ERROR_MODEL = ', 0976 & BOOST_ERROR_MODEL,' input. Assumed OPTIMISTIC.' 0977 quad_ERR_BOOST = .TRUE. 0978 END IF 0979 C 0980 C Drag error model - either from a 'FILE' (old input DRAGBIASMODE='GT') 0981 C or based on solar flux sigmas (old input DRAGBIASMODE = 'FLUX') 0982 C If it is based on the solar flux sigmas, have a choice of 0983 C optimistic model - add daily errors in quadrature 0984 C pessimistic model - add daily errors linearly 0985 C default is "OPTIMSITIC" 0986 C 0987 IF (DRAG_ERROR_MODEL .eq. 'FILE') THEN 0988 DRAGBIASMODE = 'GT' 0989 ELSE 0990 DRAGBIASMODE = 'FLUX' 0991 IF (DRAG_ERROR_MODEL .EQ. 'PESSIMISTIC') THEN 0992 QUAD_ERR_DRAG = .FALSE. 0993 ELSE IF (DRAG_ERROR_MODEL .EQ. 'OPTIMISTIC') THEN 0994 QUAD_ERR_DRAG = .TRUE. 0995 ELSE 0996 write(8,*) '>>> Invalid DRAG_ERROR_MODEL = ', 0997 & DRAG_ERROR_MODEL,' input. Assumed OPTIMISTIC.' 0998 QUAD_ERR_DRAG = .TRUE. 0999 END IF 1000 END IF 1001 CALL UPCASE( DRAGBIASMODE ) 1002 1003 if ( ODAYS .LT. 0 ) ODAYS = days 1004 1005 C1 Map LAN, w, and M into [0..360]. 1006 1007 ORBIT( 4 ) = RNG360( ORBIT( 4 ) ) 1008 ORBIT( 5 ) = RNG360( ORBIT( 5 ) ) 1009 ORBIT( 6 ) = RNG360( ORBIT( 6 ) ) 1010 1011 C1 Echo initial orbit. 1012 1013 WRITE(8,306) date, ORBIT(1), orbit(4), 1014 & orbit(2), orbit(5), orbit(3), orbit(6) 1015 306 FORMAT( /35X,'Input Orbit',/ 1016 & ,35x,'-----------', 1017 & /,' ',t2,'Epoch:',A,t40, 1018 & /,' ',t6, 'a:', F20.12, ' km.', 1019 & t50, 'aop:',F20.8,' deg.', 1020 & /,' ',t6,'e:', F20.12, 1021 & t49:,'raan:',F20.8, ' deg.', 1022 & /,' ',t6,'i:', F16.8,' deg.', 1023 & t52,'M:',F20.8, ' deg.',/ ) 1024 C 1025 C Print the input parameters which will be used 1026 C GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 19 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1027 if ( ATARGONLY ) then 1028 if ( strat .eq. 'RUNOUT' ) strat = 'LONG' 1029 write(8,1174) strat 1030 1174 Format(' ',T21,'Constant-Flux First Guess Parameters',/, 1031 & ' ',T21,'------------------------------------',/, 1032 & ' ',t28,'Strategy:',T42,A10) 1033 else if ( strat .eq. 'RUNOUT') then 1034 write (8, 1180) 1035 1180 Format(' ',T25,'Untargeted Runout Parameters',/, 1036 & ' ',T25,'----------------------------') 1037 else if (strat .eq. 'LONG' ) then 1038 write (8, 1182) 1039 1182 Format(' ',T26,'Longitude Targeting Parameters',/, 1040 & ' ',T26,'------------------------------') 1041 else if (strat .eq. 'WEST' ) then 1042 write (8, 1185) 1043 1185 Format( 1044 & ' ',T17, 'Time Targeting to Western Boundary Parameters',/, 1045 & ' ',T17,'---------------------------------------------') 1046 else if (strat .eq. 'EAST' ) then 1047 write (8, 1188) 1048 1188 Format( 1049 & ' ',T17, 'Time Targeting to Eastern Boundary Parameters',/, 1050 & ' ',T17,'---------------------------------------------') 1051 else 1052 write (8, 1189) strat 1053 1189 format(' >>>> Unknown strategy = ',A,/ 1054 & ' ERROR termination') 1055 stop 1056 end if 1057 1058 if ( strat .ne. 'RUNOUT') then 1059 if ( target_strat .eq. 'WESTGT' ) then 1060 write (8, 1191) 1061 1191 Format(' ',T15, ' Targeting Strategy:', 1062 & T42, ' 95% West' ) 1063 else if (target_strat .eq. 'EASTGT') then 1064 1193 Format(' ',T15, ' Targeting Strategy:', 1065 & T42, ' 95% East' ) 1066 write (8, 1193) 1067 else if (target_strat .eq. 'UNBIASED' ) then 1068 write (8, 1195) 1069 1195 Format(' ',T15, ' Targeting Strategy:', 1070 & T42, ' Unbiased' ) 1071 else 1072 write (8,*) '>>>> Unknown target_strat = ', 1073 & target_strat 1074 STOP 1075 end if 1076 end if 1077 1078 write(8,1203) bounds 1079 1203 Format(' ',T15, ' Western Boundary:', 1080 & T42,F10.3,' kilometers',/, 1081 & ' ',T15, ' Eastern Boundary:', 1082 & T42,F10.3,' kilometers') 1083 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 20 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1084 if ( strat .ne. 'RUNOUT') then 1085 write(8,1204) bndfuz 1086 1204 Format(' ',T12, ' Ground track fuzziness:', 1087 & T42,F10.3,' kilometers') 1088 end if 1089 1090 if ( strat .eq. 'RUNOUT') then 1091 Write (8,121) days 1092 121 Format (' ',T15, ' Duration of run:',T42,I10,' days') 1093 end if 1094 1095 1096 if ( strat .eq. 'WEST' .or. 1097 & strat .eq. 'EAST' ) then 1098 Write (8,122) TIMTGT, TIMFUZ 1099 122 Format (' ',T15, ' Time Target:', 1100 & T42,F10.3,' days',/ 1101 & ' ',T15, ' Time Fuzziness:', 1102 & T42,F10.3,' days') 1103 end if 1104 1105 WRITE(8,1221) DV 1106 1221 FORMAT (' ', t15, ' Initial Delta V:', 1107 & t42,F10.5,' mm/sec.') 1108 1109 if ( dvquanta .gt. 0.0 ) then 1110 Write (8,1222) dvquanta 1111 1222 format(' ',T15, ' Delta V Quantization:', 1112 & T42,F10.3,' mm/sec.') 1113 if (dvbracket(2) .gt. dvbracket(1)) then 1114 write(8,1226) dvbracket 1115 1226 format(' ',T9, 'First post-targeting runout:', 1116 & T47,i5,' quanta wrt dv',/, 1117 & ' ',T9, ' Last post-targeting runout:', 1118 & T47,i5,' quanta',/, 1119 & ' ',T9, ' Interval between runouts:', 1120 & T47,i5,' quanta') 1121 else 1122 write(8,1227) 1123 1227 format(' ',T15,'Post-targeting runout:',T39, 1124 & 'Not Requested') 1125 end if 1126 else 1127 write (8,1228) 1128 1228 format(' ',T16,'Delta V Quantization:',T42,' Not Used') 1129 end if 1130 1131 1132 Write (8,123) sigma_dv_fixed, sigma_dv_prop, dragbiasmode, 1133 & delta_a_od, sigma_sf_dvod, sigma_sf_drag, Sigma_sf_boost 1134 123 Format(/' ', 1135 & T29,'Error Model Parameters', 1136 & /,' ',T29,'----------------------',/, 1137 & ' ', 15x, 'Fixed Delta-V Error:',T42,F10.5, 1138 & ' mm/sec (one-sigma)',/ 1139 & ' ', 15x, ' Proportional Error:',T42, F10.5, 1140 & ' dv/v (one-sigma)',/, GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 21 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1141 & ' ',T10, ' Drag bias mode:',T48,A4,/, 1142 & ' ',T10, 'Semimajor axis Uncertainty:',T42,F10.5, 1143 & ' meters',/, 1144 & ' ',T10, ' 95 % Scale Factor:',T42,F10.5, 1145 & ' sigma (DV & OD) ',/' ',T42,F10.5,' sigma (drag)', 1146 & /' ',T42, F10.5, ' sigma (boost)' 1147 & ) 1148 1149 IF ( DSMADT_DATA_SIGMA .GE. 0.0d0) then 1150 write (8,12345) DSMADT_DATA_SIGMA*100.0 1151 else 1152 write (8,12346) 1153 end if 1154 12345 format(' ',T10, ' Boost Error:',T42,F10.5, 1155 & ' cm/sec (one-sigma)') 1156 12346 format(' ',T10, ' Boost Error:',T42, 1157 & ' Table look-up.') 1158 write(8,1235) yesnostring(quad_err_boost, 1159 & 'Optimistic ', 'Pessimistic ') 1160 if (drag_error_model .ne. 'FILE') 1161 & write(8,12351) yesnostring(quad_err_drag, 1162 & 'Optimistic ', 'Pessimistic ') 1163 1164 1235 format(' ',T10,' Daily Boost Errors:', T45, A20) 1165 12351 format(' ',T10,' Daily Drag Errors:', T45, A20) 1166 1167 if (dsmaswitch.eq. 'Not Used') then 1168 dsmadt(1) = 0.0d0 1169 dsmadt(2) = 0.0d0 1170 TsmaSwitch = 0.0d0 1171 sigma_dsma(1) = 0.0d0 1172 sigma_dsma(2) = 0.0d0 1173 Dsmaswitch = '04-JUL-2076 00:00:00.0000' 1174 TsmaSwitch = CH2SEC ( DSMASWITCH, .TRUE., ERROR ) 1175 else 1176 TsmaSwitch = CH2SEC ( DSMASWITCH, .TRUE., ERROR ) 1177 end if 1178 1179 Write (8,124) ltop, m, yesno(drag), CD, yesno(lsflag), mass 1180 1181 if (ndsmadt_data.lt.1) then 1182 Write(8, 1243) dsmadt, sigma_dsma, dsmaswitch 1183 plotboost = .false. 1184 else 1185 write(8,1247) 1186 1247 format(' ',t5,' Boost - Extra (d/dt)(SMA):',T42, 1187 & ' Table look-up.') 1188 if (dsmadt_epoch.ne.' ') then 1189 write(8,12473) 1190 12473 format(' ',t42,' Contains one value per day.') 1191 else 1192 write(8,12475) 1193 12475 format(' ',t42,' Data time tagged & interpolated.') 1194 end if 1195 end if 1196 1197 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 22 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1198 1199 124 Format (/' ', 1200 & ' ',T29,'Propagation Parameters', 1201 & /,' ',T29,'----------------------', 1202 & /,' ',t5,' Geopotential Field Truncation:',T50,I2, 1203 & /,' ',t5,' Integration Step Size:',T42,I10, 1204 & ' orbits', 1205 & /,' ',t5,' Use Drag Force:',T42,a10, 1206 & /,' ',t5,' Drag Coefficient:',T42,F10.3, 1207 & /,' ',t5,' Use Lunar/Solar Perturbation:',T42,a10 1208 & /,' ',t5,' Satellite mass:', T42,f10.3, 1209 & ' kilograms') 1210 1211 1243 format(' ',t5,' Extra (d/dt)(SMA):',T42,2f10.6, 1212 & ' meters/day', 1213 & /,' ',t5,' Error Sigma in (d/dt)(SMA):',T42,2f10.6, 1214 & ' meters/day', 1215 & /,' ',t5,' (d/dt)(SMA) Switch point:',T42,A ) 1216 1217 write(8,12482) DRAGMODEL 1218 12482 format(' ',t5,' Drag Model:',T49,A10) 1219 1220 if ( DRAGMODEL .EQ. 'CONSTANT' ) write (8,12485) DRAGAREA 1221 12485 format(' ',t5,' Constant Area:',T42,F10.6, 1222 & ' m-2') 1223 1224 write(8, 12487) ATMOS 1225 12487 format(' ',t5,' Area Model:',T45,A10) 1226 1227 if (ATMOS .EQ. 'CONSTANT') write (8,12489) ATDEN 1228 12489 format(' ',t5,' Constant Density:',T42,F10.6, 1229 & 'kg/km-3') 1230 1231 ipage = 2 1232 CALL NEWPAGE(IPAGE,2) 1233 1234 if ( (.not. ATARGONLY) .and. 1235 & (strat .ne. 'RUNOUT') ) then 1236 Write (8,125) 1237 125 Format (' ',/, 1238 & ' ',T31,'First Guess Logic',/, 1239 & ' ',T31, '-----------------' ) 1240 1241 if ( dv .gt. 0 ) then 1242 write ( 8,126) dv 1243 126 Format ( ' ',T15,'Initial Delta V Guess:',T42,F10.3,/ 1244 & ' ',T30,'Method:',T42,' External'/) 1245 else 1246 write (8, 127) 1247 127 Format ( ' ',T30,'Method:',T42,' Internal'/) 1248 end if 1249 1250 end if 1251 1252 if (ATMOS .EQ. 'POLYNOMIAL') then 1253 write(8,3049) ATDEN_POLY(1), ATDEN_SEMI(1), 1254 & ATDEN_POLY(2), ATDEN_SEMI(2), GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 23 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1255 & ATDEN_POLY(3), 1256 & ATDEN_POLY(4), ATDEN_ANN(1), 1257 & ATDEN_POLY(5), ATDEN_ANN(2) 1258 3049 format(19x,'Input Parameters for Polynomial Density Model',/ 1259 & 19x,'---------------------------------------------',/ 1260 & ' ', T10, 'Polynomial',T25,E15.7, 1261 & ' S/A Magnitude',T55,E15.7/ 1262 & ' ', T25,E15.7, 1263 & ' Phase',T55,E15.7,' radians'/ 1264 & ' ', T25,E15.7/ 1265 & ' ', T25,E15.7, 1266 & ' Ann Magnitude',T55,E15.7,/ 1267 & ' ', T25,E15.7, 1268 & ' Phase',T55,E15.7,' radians'/) 1269 end if 1270 1271 write(8,3050) (flux_slope(i), fbar_slope(i), 1272 & flux_bias(i), fbar_bias(i), i=1,6) 1273 1274 3050 format(' ', T10,10x, 'F10.7',11x,'Fbar', 1275 & 10x, 'F10.7',11x,'Fbar' 1276 & /' ',T10,2(10x, 'Slope'), 2(11x, 'Bias'), 1277 & /' ',T10,4(1x,14('-')) 1278 & 6(/,T10,4E15.7)) 1279 1280 C1 Use OPSFN to open the EZPLOT data file. 1281 1282 if (plot) then 1283 CALL OPSFN ( 11 , ZFILE , ERROR ) 1284 IF ( ERROR ) THEN 1285 STOP '>>> ERROR: Unable to open PLOT File.' 1286 END IF 1287 end if 1288 1289 C1 Use OPSFOR to open the GT Biases file. 1290 1291 if (dragbiasmode .eq. 'GT' ) then 1292 CALL OPSFor ( 14 , GTBIASFILE , ERROR ) 1293 IF ( ERROR ) THEN 1294 write(8,*) '>>>>>>>>>>>>>>>>> WARNING >>>>>>>>>>>>>>>>>>' 1295 write(8,*) 'Unable to open GTBIAS file ',GTBIASFILE 1296 write(8,*) 'No ground track biases are assumed for drag.' 1297 write(8,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>' 1298 ELSE 1299 READ ( 14 , GTBIAS ) 1300 CLOSE ( 14 ) 1301 END IF 1302 end if 1303 1304 call init_parms 1305 1306 if ( dragbiasmode .eq. 'FLUX' ) then 1307 if (make_bias_file) then 1308 CALL OPSFN ( 17 , NEWBIASFILE , ERROR ) 1309 IF ( ERROR ) THEN 1310 print *, '>>> ERROR: Cannot open new bias file:' 1311 print *, NEWBIASFILE GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 24 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1312 STOP 1313 END IF 1314 end if 1315 end if 1316 1317 C1 Use OPSFN to open the EZPLOT data file. 1318 1319 if (plot .and. plot_components) then 1320 CALL OPSFN ( 16 , ZFILE2 , ERROR ) 1321 IF ( ERROR ) THEN 1322 STOP '>>> ERROR: Unable to open plot COMPONENTS file.' 1323 END IF 1324 end if 1325 1326 IF ( BOOT ) THEN 1327 CALL OPSFN ( 12 , BFILE , ERROR ) 1328 IF ( ERROR ) THEN 1329 WRITE(*,'(/1X,''GTARG: cannot open GTARG.BOOT.'')') 1330 STOP 1331 END IF 1332 end if 1333 1334 inquire (FILE=bfile, NAME=boot_file_name ) 1335 inquire (FILE=zfile, NAME=plot_file_name ) 1336 inquire (FILE=zfile2, NAME=plot_file2_name ) 1337 inquire (FILE=ofile, NAME=output_file_name ) 1338 inquire (FILE=newbiasfile, NAME=newbiasfile_NAME ) 1339 1340 write (8,1305) 1341 & yesno(echo_inpt), yesno(boot), 1342 & yesno(echo_grav), 1343 & yesno(echo_xing), yesno(watch), 1344 & yesno(echo_flux), yesno(watchint), 1345 & yesno(echo_bias), yesno(plot), yesno(echo_boost), 1346 & yesno(echo_vmatab), 1347 & yesno(make_bias_file .and. (dragbiasmode.eq.'FLUX')), 1348 & yesno(sites) 1349 1350 1305 format (/' ',t31,'Output Parameters',/ 1351 & ' ', t31,'------------------',/, 1352 & ' ',T10,' Print input namelist:', T35,a3, 1353 & ' ',T45,' Write Boot file:', T70,a3,/ 1354 & ' ',T10,' Print Constants:', T35,a3, 1355 & ' ',T45,' Print Reference Grid:', T70,a3,/, 1356 & ' ',T10,'Monitor Interactively:', T35,a3, 1357 & ' ',t45,' Write flux & Kp:', T70,a3,/, 1358 & ' ',T5,'Print Targeting Iterations:',T35,a3, 1359 & ' ',T45,' Print g.t. biases:', T70,a3/ 1360 & ' ',T4,'Plot Ground Track in EZPLOT:', T35,a3, 1361 & T45,' Print Input da/dt:', T70,a3,/ 1362 & ' ',T10,' Print VMA Table:', T35,a3, 1363 & T45,' Write Bias File:', T70, a3,/ 1364 & ' ',T10,' Site Overflight GT:', t35,a3 ) 1365 1366 if (plot) 1367 & write (8,13055) ODEVICE, plotdate, int(odays), 1368 & yesno(ezhead), yesno(plot_components), GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 25 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1369 & yesno(plotcycle), yesno(plotboost), 1370 & yesno(plotsite.and.sites) 1371 1372 13055 format (/' ',t28, 'EZPLOT Plotting Parameters',/ 1373 & ' ', t28,'--------------------------',/, 1374 & ' ',T10,' Plotting Device:',T33,A10,/ 1375 & ' ',T3,'Starting Date of Plot Axis:',T33, A24,/ 1376 & ' ',T10,' Plot Scale (days):',T33,I5, 1377 & ' ',T45,'Write EZPLOT header:',T70,a3,/ 1378 & ' ',T8,'Plot GT Error Sources:',T35,a3, 1379 & ' ',T45,'Plot Cycle Boundary:',T70,a3,/ 1380 & ' ',T10,' Plot Boost da/dt:',T35,a3, 1381 & t43,'Plot Site Overflights:',t70,a3 1382 & ) 1383 1384 write ( 8, 149 ) input_file_name, flux_file_name, 1385 & gtbias_file_name, output_file_name 1386 if (plot) write(8,1491) plot_file_name 1387 if (plot .and. plot_components) 1388 & write(8,1492) plot_file2_name 1389 if (boot) write(8,1493) boot_file_name 1390 if ( (dragbiasmode .eq. 'FLUX') .and. make_bias_file ) 1391 & write(8,1495) newbiasfile_name 1392 1393 149 format(/' ',T34,'Input Files', 1394 & /,' ',T34,'-----------', 1395 & /,' ','Control:',T20,A, 1396 & /,' ','Flux Data:',T20,A, 1397 & /,' ','Biases:',T20,A,/, 1398 & /,' ',T34,'Output Files', 1399 & /,' ',T34,'------------', 1400 & /,' ','Summary:',T20,A ) 1401 1491 format(' ','GT Plot:',T20,A) 1402 1492 format(' ','Bias Plot:',T20,A) 1403 1493 format(' ','Boot file:',T20,A) 1404 1495 format( ' ','New Biases:',T20,A ) 1405 1406 if (NDSMADT_DATA .GT. 0 ) then 1407 if (NDSMADT_DATA .GT. MXFLUX) NDSMADT_DATA = MXFLUX 1408 1409 if (dsmadt_epoch .eq. ' ') then 1410 if ( .not. checkdates ( dsmadt_dates, 1411 & ndsmadt_data,ierror, 1412 & xdsmadt_dates) ) then 1413 write(8, *) '>>> ERROR: dsmadt_dates out of order ', 1414 & 'at array element ', ierror,' ',dsmadt_dates(ierror) 1415 write(6, *) '>>> ERROR: dsmadt_dates out of order ', 1416 & 'at array element ', ierror,' ',dsmadt_dates(ierror) 1417 stop 'ERROR EXIT.' 1418 end if 1419 end if 1420 1421 if ( echo_boost .and. (dsmadt_epoch .eq. ' ') ) then 1422 C 1423 C use dsmadt_dates 1424 C 1425 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 26 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1426 do i=1,ndsmadt_data-99,100 1427 1428 CALL NEWPAGE(IPAGE,2) 1429 if (i.eq.1) write(8,14798) 1430 write (8,14799) 1431 1432 do j=0,49 1433 if (dsmadt_data_sigma .lt. 0.0) then 1434 write(8,14800) (dsmadt_dates(i+j+k*50)(1:17), 1435 & 100.0*dsmadt_data(i+j+k*50), 1436 & dsmadt_sigmas(i+j+k*50)*100.0, 1437 & k=0,1) 1438 else 1439 write(8,14800) (dsmadt_dates(i+j+k*50)(1:17), 1440 & 100.0*dsmadt_data(i+j+k*50), 1441 & dsmadt_data_sigma*100.0, 1442 & k=0,1) 1443 end if 1444 end do 1445 end do 1446 1447 imax = i-1 1448 1449 if ( mod(ndsmadt_data,100) .ne. 0 ) then 1450 CALL NEWPAGE(IPAGE,2) 1451 write (8,14799) 1452 end if 1453 1454 kk = mod(ndsmadt_data,100)/2 1455 if (mod(ndsmadt_data,2).eq.0) kk = kk-1 1456 1457 do j=0,kk 1458 if (2+imax+j+kk.le.ndsmadt_data) then 1459 if (dsmadt_data_sigma .lt. 0.0) then 1460 write(8,14800) ( 1461 & dsmadt_dates(1+imax+j+k*kk+k)(1:17), 1462 & 100.0*dsmadt_data(1+imax+j+k*kk+k), 1463 & dsmadt_sigmas(1+imax+j+k*kk+k)*100.0, 1464 & k=0,1) 1465 else 1466 write(8,14800) ( 1467 & dsmadt_dates(1+imax+j+k*kk+k)(1:17), 1468 & 100.0*dsmadt_data(1+imax+j+k*kk+k), 1469 & dsmadt_data_sigma*100.0, 1470 & k=0,1) 1471 end if 1472 else 1473 if (dsmadt_data_sigma .lt. 0.0) then 1474 write(8,14800) dsmadt_dates(1+imax+j)(1:17), 1475 & 100.0*dsmadt_data(1+imax+j), 1476 & dsmadt_sigmas(1+imax+j)*100.0 1477 else 1478 write(8,14800) dsmadt_dates(1+imax+j)(1:17), 1479 & 100.0*dsmadt_data(1+imax+j), 1480 & dsmadt_data_sigma*100.0 1481 end if 1482 end if GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 27 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1483 end do 1484 1485 c do i=1,ndsmadt_data,2 1486 c if (dsmadt_data_sigma .lt. 0.0) then 1487 c if (i.lt.ndsmadt_data) then 1488 c write(8,14800) (dsmadt_dates(j)(1:17), 1489 c & 100.0*dsmadt_data(j), 1490 c & dsmadt_sigmas(j)*100.0, 1491 c & j=i,i+1) 1492 c else 1493 c write(8,14800) dsmadt_dates(i)(1:17), 1494 c & 100.0*dsmadt_data(i) , 1495 c & dsmadt_sigmas(i)*100.0 1496 c end if 1497 c else 1498 c if (i.lt.ndsmadt_data) then 1499 c write(8,14800) (dsmadt_dates(j)(1:17), 1500 c & 100.0*dsmadt_data(j), 1501 c & dsmadt_data_sigma*100.0, 1502 c & j=i,i+1) 1503 c else 1504 c write(8,14800) dsmadt_dates(i)(1:17), 1505 c & 100.0*dsmadt_data(i) , 1506 c & dsmadt_data_sigma*100.0 1507 c end if 1508 c end if 1509 c if ( (mod(i+1,100).eq.0) .and. 1510 c & (i.lt.ndsmadt_data-1) ) then 1511 c write (8,3025) aday, atime, ipage 1512 c ipage = ipage + 1 1513 c write (8,14799) 1514 c end if 1515 c end do 1516 c 1517 14798 format(27x,'Extra Along Track Forces, cm/day') 1518 14799 format(1x,13x,'Date',t23,'da/dt',' Sigma', 1519 & t40,13x, 'Date',t61,'da/dt',' Sigma', 1520 & /,1x,17('-'),1x,8('-'),1x,7('-'), 1521 & t40,17('-'),1x,8('-'),1x,7('-')) 1522 14800 format(1x,a17, f9.2, f8.2, T40,a17,f9.2, f8.2) 1523 1524 else if (Echo_boost) then 1525 C *************** 1526 C use dsmadt_epoch 1527 C 1528 CALL NEWPAGE(IPAGE,2) 1529 if (dsmadt_data_sigma.lt.0) then 1530 write(8,14991) dsmadt_epoch 1531 else 1532 write(8,1499) dsmadt_epoch, dsmadt_data_sigma 1533 end if 1534 1499 format(18x,'Extra Along-Track Forces: da/dt, meters/day',/ 1535 & 18x,'-------------------------------------------'/, 1536 & 18x,'1st Date = ',A/, 1537 & 18x,'sigma = ', f9.4) 1538 14991 format(18x,'Extra Along-Track Forces: da/dt, meters/day',/ 1539 & 18x,'-------------------------------------------'/, GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 28 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1540 & 18x,'1st Date = ',A) 1541 xjd0=ch2jd(dsmadt_epoch,.true.,ERROR) 1542 do j = 1, (ndsmadt_data-1)/7 + 1 1543 imin = j*7-6 1544 imax = min(j*7, ndsmadt_data) 1545 if ( ( (dsmadt_data_sigma .lt. 0.0d0) .and. 1546 ^ (mod(j,12).eq.0) ) .or. 1547 & ( (dsmadt_data_sigma .ge. 0.0d0) .and. 1548 ^ ( mod(j,17).eq.0) ) ) then 1549 write (8,1496) ' ', (' ---------',i=imin,j*7) 1550 CALL NEWPAGE(IPAGE,2) 1551 write (8, 14995) 1552 14995 format 1553 & (18x,'Extra Along-Track Forces: da/dt, meters/day',/ 1554 & 18x,'-------------------------------------------') 1555 end if 1556 1557 do i=imin,imax 1558 xjd(i+1-imin)=xjd0 + dble(real(i)) - 1.0d0 1559 ajd(i+1-imin)=sec2ch((xjd(i+1-imin)-2451545.0d0) 1560 & *86400.0d0) 1561 end do 1562 write (8,1496) ' ', (' ---------',i=imin,j*7) 1563 write (8,14975) 'Date:', 1564 & (ajd(i+1-imin)(1:6)//'-'//ajd(i+1-imin)(10:11), 1565 & i=imin,imax) 1566 write (8,1498) 'Boost:',(dsmadt_data(i),i=imin, imax) 1567 if (dsmadt_data_sigma .lt. 0) 1568 & write(8,1498) 'Sigma:',(dsmadt_sigmas(i),i=imin,imax) 1569 end do 1570 write (8,1496) ' ', (' -------',i=imin,imax) 1571 1496 format ( 1x, a7, 7a10) 1572 1497 format ( 1x, a7, 7(1x,i9) ) 1573 14975 format (1x, a7,7(1x,a9)) 1574 1498 format ( 1x, a7, 7(1x,f9.4) ) 1575 end if 1576 end if 1577 1578 C1 If DRAG is true, then process the flux data file. 1579 1580 IF ( DRAG ) THEN 1581 1582 C2 Use OPSFOR to open the flux data file. 1583 1584 CALL OPSFOR ( 9 , 'FLUX_DATA' , ERROR ) 1585 1586 IF ( ERROR ) THEN 1587 print *, goto_string(7,1), 1588 & 'GTARG: cannot open file FLUX_DATA.' 1589 WRITE(8,'(/,1X,''GTARG: cannot open FLUX DATA FILE.'')') 1590 STOP 1591 END IF 1592 1593 C2 Read the namelist $FLXKP, close the FLUX_DATA file, and then 1594 C2 print status. 1595 1596 READ ( 9 , FLXKP ) GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 29 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1597 CLOSE( 9 ) 1598 1599 C2 If number of days is not in range of 1..MXFLUX, then error. 1600 1601 IF ( NUMDAY .LT. 1 .OR. MXFLUX .LT. NUMDAY ) THEN 1602 1603 WRITE(*,305) MXFLUX 1604 WRITE(8,305) MXFLUX 1605 305 FORMAT(//,1X,'GTARG: NUMDAY is not in range [1,',I4,'].') 1606 1607 STOP 1608 1609 END IF 1610 C 1611 C APPLY BIASES TO FLUX DATA, IF REQUIRED 1612 C 1613 fbar_bias_input = .false. 1614 flux_bias_input = .false. 1615 fbar_slope_input = .false. 1616 flux_slope_input = .false. 1617 1618 do i = 1,6 1619 fbar_bias_input = fbar_bias_input .or. 1620 & (fbar_bias(i).ne.0.0d0) 1621 flux_bias_input = flux_bias_input .or. 1622 & (flux_bias(i).ne.0.0d0) 1623 fbar_slope_input = fbar_slope_input .or. 1624 & (fbar_slope(i).ne.0.0d0) 1625 flux_slope_input = flux_slope_input .or. 1626 & (flux_slope(i).ne.0.0d0) 1627 end do 1628 1629 IF (FBAR_BIAS_INPUT .OR. FLUX_BIAS_INPUT .OR. 1630 & FBAR_SLOPE_INPUT .OR. FLUX_SLOPE_INPUT ) THEN 1631 do i = 2, NUMDAY 1632 if (fbar_bias_input) 1633 & flxbar(i) = flxbar(i) + 1634 & poly(dble(real(i-1)),fbar_bias,6) 1635 if (flux_bias_input) 1636 & flx(i) = flx(i) + 1637 & poly(dble(real(i-1)),flux_bias,6) 1638 if (fbar_slope_input) 1639 & flxbar(i) = flxbar(i) + 1640 & poly(dble(real(i-1)),fbar_slope,6) 1641 if (flux_slope_input) 1642 & flx(i) = flx(i) + 1643 & poly(dble(real(i-1)),flux_slope,6) 1644 end do 1645 END IF 1646 1647 1648 1649 C2> Use CRMINI to compute and save daily ratios of: 1650 C2 1651 C2 Cd * density 1652 C2 ------------ 1653 C2 mass GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 30 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1654 C2 1655 C2 where density is based upon the information in the FLUX_DATA file. 1656 C2 I am computing this ratio, rather than just density, in order to 1657 C2 avoid having to pass CD and MASS all over Hell. 1658 C2 1659 C2 The alternate entry point, CRMGET, returns ratios for a given day 1660 C2 when needed (i.e., in PROP). 1661 1662 CALL CRMINI( NUMDAY , DAYONE , FLX , FLXBAR , KP , CD , MASS, 1663 & DFLX, DFLXBAR, DKP ) 1664 1665 END IF 1666 1667 1668 C 1669 C initialize site data 1670 1671 call UPCASE(SITE_LOC_TYPE) 1672 call UPCASE(SITE_STRAT) 1673 1674 if (.not.((site_strat.eq.'PROP').or. 1675 & (site_strat.eq.'KEPLER'))) then 1676 write(8,*) '>>> INVALID SITE_STRAT = ',SITE_STRAT 1677 write(8,*) ' PROP assumed.' 1678 SITE_STRAT = 'PROP' 1679 end if 1680 1681 do i = 1, NSITES 1682 C 1683 C Make sure SITE_LOC(2,I) = geodetic latitude 1684 C and SITE_GCLAT(I) = geocentric latitude 1685 C 1686 if (site_loc_type .EQ. 'GEOCENTRIC') then 1687 C 1688 C input is in GEOCENTRIC COORDINATES, Convert to GEODETIC 1689 C 1690 SITE_GCLAT(I) = SITE_LOC(2,i) 1691 SITE_LOC(2,I) = tan(SITE_GCLAT(I)*PI/180.0)/ 1692 & ( 1.0d0 - FLAT )**2 1693 SITE_LOC(2,i) = (180.0/PI)*ATAN(SITE_LOC(2,I)) 1694 else 1695 C 1696 C input is in GEODETIC COORDINATES, Convert to GEOCENTRIC 1697 C 1698 SITE_GCLAT(I) = ( 1.0d0 - FLAT )**2 1699 & * tan ( SITE_LOC(2,I)*PI/180.0 ) 1700 SITE_GCLAT(I) = (180.0/PI) * ATAN ( SITE_GCLAT(I) ) 1701 if (Site_LOC_TYPE.NE.'GEODETIC') then 1702 write(8,*) '>>> WARNING: SITE_LOC_TYPE = ', 1703 & SITE_LOC_TYPE,' is invalid. ', 1704 & 'Input is assumed to be in GEODETIC ', 1705 & 'coordinates.' 1706 end if 1707 end if 1708 end do 1709 1710 if (.not.sites) NSITES = 0 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 31 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1711 C if (NSITES .GT. 0 ) then 1712 C write(8,1133) (SITE_NAME(i), 1713 C & site_loc(2,i),site_gclat(i), 1714 C & site_loc(1,i),site_node(i),i=1,nsites) 1715 C1133 format (//T16,'Site',9x,'GD Lat',9x, 'GC Lat', 6x, 1716 C & 'Longitude',1x,'Node', 1717 C & /,T10,10('-'),3(1x,14('-')),1x,4('-') , 1718 C & (/,T10, A10,3F15.7,I5) ) 1719 C end if 1720 1721 if (echo_grav) then 1722 1723 if (ndsmadt_data .gt. 0 ) then 1724 CALL NEWPAGE(IPAGE,2) 1725 end if 1726 1727 write(8,1135) 1728 1135 format(' ',/, 1729 & ' ', 31x,'Physical Constants',/, 1730 & ' ', 31x,'------------------') 1731 write (8,114) (i,jearth(i),i=2,9),(i,jearth(i),i=10,29) 1732 114 format(2(' ',2x,4(' J',i1,' =',e13.5),/), 1733 & 5(' ',2x,4(' J',i2,'=',e13.5),/)) 1734 1735 write (8,1143) earth_rad, earth_freq, earth_rate,mu_earth, 1736 & mu_moon, mu_sun, sid_day, deg_to_km, 1.0d0/flat 1737 1738 1143 format(' ',t15,' Earth radius:', 1739 & t42, F20.10,' kilometers', 1740 & /,' ',t15,' Earth rotation rate:',t42,F20.18, 1741 & ' rad/sec',t75,'(*)', 1742 & /,' ',t42,F20.10,' meters/day',t75,'(*)', 1743 & /,' ',t25,' GM, earth:',t42,F20.10,' km**3/sec**2', 1744 & /,' ',t25,' GM, moon:',t42,F20.10,' km**3/sec**2', 1745 & /,' ',t25,' GM, sun:',t37,F25.10,' km**3/sec**2', 1746 & /,' ',T5, ' Length of Sidereal Day:', 1747 & T42,F20.10,' seconds', 1748 & /,' ',T5, ' 1 Deg. of Equatorial Longitude:', 1749 & T42,F20.10, ' kilometers',t75,'(*)', 1750 & /,' ',T14,' Earth Flattening, 1/f:', 1751 & T42,F20.10, 1752 & //,27x,'[ (*) Derived parameters. ]' 1753 & ) 1754 end if 1755 1756 if (echo_xing) then 1757 1758 CALL NEWPAGE(IPAGE,2) 1759 1760 write (8, 110) orbits 1761 110 format(' ',20x,i3,' Reference Equator Crossing Longitudes', 1762 & /,' ',20x,'-----------------------------------------') 1763 write (8, 111) ( xings(i), i=1,orbits) 1764 111 format(' ', 5x, 7f10.4) 1765 end if 1766 1767 if ( echo_bias .and. GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 32 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1768 & drag .and. 1769 & (dragbiasmode .eq. 'GT') ) then 1770 1771 CALL NEWPAGE(IPAGE,2) 1772 1773 write (8, 112), ngtbias_drag 1774 write (8, 113) (gtbias_drag(i),i=1,ngtbias_drag) 1775 112 format (' ',18x, 1776 & i4,' Days Ground Track Biases for Drag (in km)',/, 1777 & ' ',18x,'----------------------------------------------') 1778 113 format (' ',5x,10f7.3) 1779 end if 1780 1781 if ( echo_flux .and. drag ) then 1782 CALL NEWPAGE(IPAGE,0) 1783 1784 WRITE(8,304) NUMDAY , DAYONE 1785 304 FORMAT(/' ',22X,'FLUX & Geomagnetic Data Summary',/, 1786 & ' ',22x,'-------------------------------', 1787 & /,22X,i5, ' days starting ',a11) 1788 1789 Write(8,30401) YesNo(Flux_Slope_Input), 1790 & YesNo(Fbar_Slope_Input), YesNo(Flux_bias_input), 1791 & YEsNo(Fbar_bias_Input) 1792 30401 format (/' ','Includes: ', 1793 & ' F10.7 Slope:',A3,' Fbar Slope:',A3, 1794 & ' F10.7 Bias:', A3, ' Fbar Bias:', A3/ ) 1795 1796 xjd0=ch2jd(dayone,.true.,ERROR) 1797 1798 do j = 1, (numday-1)/10 + 1 1799 1800 imin = j*10-9 1801 imax = min( j*10, NUMDAY) 1802 1803 if (mod(j,10).eq.0) then 1804 write(8,3039) ' ',(' ------',i=imin,j*10) 1805 CALL NEWPAGE(IPAGE,2) 1806 write (8,30405) 1807 30405 FORMAT(' ',22X,'FLUX & Geomagnetic Data Summary',/, 1808 & ' ',22x, '-------------------------------') 1809 end if 1810 1811 do i=imin,imax 1812 xjd(i+1-imin)=xjd0 + dble(real(i)) - 1.0d0 1813 ajd(i+1-imin)=sec2ch((xjd(i+1-imin)-2451545.0d0) 1814 & *86400.0d0) 1815 end do 1816 1817 write(8,3039) ' ',(' ------',i=imin,j*10) 1818 C write(8,3037) 'Day:',(i-1,i=imin,imax) 1819 write(8,30375)'Date:',(ajd(i+1-imin)(1:6),i=imin,imax) 1820 write(8,3038) 'F10.7:',(flx(i),i=imin,imax) 1821 write(8,3038) 'Fbar:',(flxbar(i),i=imin,imax) 1822 write(8,3038) 'Kp:',(kp(i), i=imin,imax) 1823 end do 1824 write(8,3039) ' ',(' ------',i=imin, imax) GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 33 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1825 1826 3037 format(1x,a7,10(1x,i6)) 1827 30375 format(1x,a7,10(1x,a6)) 1828 3038 format(1x,a7,10(1x,f6.2)) 1829 3039 format(1x,a7,10(1x,a6)) 1830 1831 3041 format(2x, 4(' Flux Fbar Kp ')) 1832 3045 format(2x, 4(f6.2,1x,f6.2,1x,f4.2,1x) ) 1833 1834 if (dragbiasmode .eq. 'FLUX' ) then 1835 CALL NEWPAGE(IPAGE,2) 1836 WRITE(8,3046) 1837 3046 FORMAT(' ',26X,'FLUX & Geomagetic Data Error Sigmas',/, 1838 & ' ',26x, '-----------------------------------') 1839 3047 format(2x, 4(' dFlux dFbar dKp ')) 1840 1841 do j = 1, (numday-1)/10 + 1 1842 1843 imin = j*10-9 1844 imax = min( j*10, NUMDAY) 1845 1846 if (mod(j,10).eq.0) then 1847 write(8,3039) ' ',(' ------',i=imin,j*10) 1848 CALL NEWPAGE(IPAGE,2) 1849 write (8,3046) 1850 end if 1851 1852 do i=imin,imax 1853 xjd(i+1-imin)=xjd0 + dble(real(i)) - 1.0d0 1854 ajd(i+1-imin)=sec2ch((xjd(i+1-imin)-2451545.0d0) 1855 & *86400.0d0) 1856 end do 1857 1858 write(8,3039) ' ',(' ------',i=imin,j*10) 1859 C write(8,3037) 'Day:',(i-1,i=imin,imax) 1860 write(8,30375)'Date:',(ajd(i+1-imin)(1:6),i=imin,imax) 1861 write(8,3038) 'dF10.7:',(dflx(i),i=imin,imax) 1862 write(8,3038) 'dFbar:',(dflxbar(i),i=imin,imax) 1863 write(8,3038) 'dKp:',(dkp(i), i=imin,imax) 1864 end do 1865 write(8,3039) ' ',(' ------',i=imin,imax) 1866 1867 end if 1868 1869 end if 1870 1871 C1 Echo $INPUT. 1872 1873 if ( echo_inpt ) then 1874 CALL NEWPAGE(IPAGE,2) 1875 1876 write (8,3053) 1877 3053 format(' ','Input Namelist',/,' ','--------------') 1878 WRITE(8,INPUT) 1879 end if 1880 1881 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 34 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1882 if (echo_vmatab) then 1883 CALL NEWPAGE(IPAGE,2) 1884 write(8,3054) 1885 3054 format(1x,t34,'VMA Table',/t34,'---------',/ 1886 * 1x,4(' Beta Drag SRP ')/, 1887 * 1x,4(' Prime Area Area ')/, 1888 * 1x,4(' ----- ----- ----- ')) 1889 do i=0,45 1890 write(8,3055)((vmatab(k,90-45*j-i),k=1,3),j=0,3) 1891 3055 format(1x,4(f6.1,2f6.2,1x) ) 1892 end do 1893 write(8,3056) breakpts, careas 1894 3056 format(//1x,'Note: SRP Area is not currently used by GTARG.', 1895 * //1x,'VMA Break Points: ', 2f6.2, 1896 * ' Constant Drag Areas:', 2f6.2 ) 1897 end if 1898 1899 C1 If required, write out the $ZFRAME namelist to the EZPLOT data file. 1900 C1 Note that the range of the y-axis is arbitrarily set to 300 days. 1901 C1 The user can edit GTARG.Z after GTARG has terminated. Also, draw 1902 C1 in the boundaries using dashed lines. 1903 1904 IF ( PLOT ) then 1905 IF ( EZHEAD ) THEN 1906 1907 DEVICE = ODEVICE 1908 SUMMRY = .FALSE. 1909 1910 IF ( TITLE .EQ. '?') then 1911 IF ( STRAT .EQ. 'RUNOUT' ) THEN 1912 TITLE = 'Ground Track Runout ' 1913 ELSE IF ( STRAT .EQ. 'LONG' ) THEN 1914 TITLE = 'Longitudinal Targeting ' 1915 & // 'to the West Boundary' 1916 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 1917 TITLE = 'Time Targeting ' 1918 & // 'to the East Boundary' 1919 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 1920 TITLE = 'Time Targeting ' 1921 & // 'to the West Boundary' 1922 ELSE 1923 WRITE(*,307) STRAT 1924 WRITE(8,307) STRAT 1925 307 FORMAT(/,1X,'GTARG: STRAT("',A6,'") is invalid.') 1926 STOP 1927 END IF 1928 END IF 1929 1930 plotdelta = ( CH2SEC ( date, .TRUE., ERROR ) - 1931 & CH2SEC ( plotdate, .TRUE., ERROR ) )/86400.0d0 1932 1933 1934 WINDO(1) = BOUNDS(1) - .1 1935 & - 0.18 * (BOUNDS(2)-BOUNDS(1)+0.2) 1936 WINDO(2) = BOUNDS(2) + .1 1937 WINDO(3) = 0.0 + plotdelta 1938 WINDO(4) = ODAYS + plotdelta GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 35 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1939 if (plotboost) then 1940 XTITLE = '\fr Ground Track, km, or Boost (da/dt) m/day' 1941 else 1942 XTITLE = '\frGround Track, km.' 1943 end if 1944 1945 YTITLE = '\frDays From ' // PLOTDATE(1:11) 1946 title = '\fr'//title 1947 1948 WRITE(11,ZFRAME) 1949 1950 call write_line(11, -1.0, -1.0, 0.0+plotdelta, 1951 & 1000.0+plotdelta, 4) 1952 call write_line(11, 0.0, 0.0, 0.0+plotdelta, 1953 & 1000.0+plotdelta, 4) 1954 call write_line(11, 1.0, 1.0, 0.0+plotdelta, 1955 & 1000.0+plotdelta, 4) 1956 call write_label(11, windo(1), 1957 & 1.015*(windo(4)-windo(3))+windo(3), 1958 & '\fr'//plot_file_name) 1959 call write_label(11, 1960 & 0.7353*(windo(2)-windo(1))+windo(1), 1961 & 1.015*(windo(4)-windo(3))+windo(3), 1962 & '\fr'//'Created '//aday//' '//atime) 1963 1964 if (plot_components) then 1965 title = '\frGround Track Biasing Components' 1966 write(16,zframe) 1967 call write_line(16, -1.0, -1.0, 0.0+plotdelta, 1968 & 1000.0+plotdelta, 2) 1969 call write_line(16, 0.0, 0.0, 0.0+plotdelta, 1970 & 1000.0+plotdelta, 2) 1971 call write_line(16, 1.0, 1.0, 0.0+plotdelta, 1972 & 1000.0+plotdelta, 2) 1973 call write_label(16, windo(1), 1974 & 1.015*(windo(4)-windo(3))+windo(3), 1975 & '\fr'//plot_file2_name) 1976 call write_label(16, 1977 & 0.7353*(windo(2)-windo(1))+windo(1), 1978 & 1.015*(windo(4)-windo(3))+windo(3), 1979 & '\fr'//'Created '//aday//' '//atime) 1980 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 1981 & 0.2*(windo(2)-windo(1)) + windo(1), 1982 & 0.95*(windo(4)-windo(3)) + windo(3), 1983 & 0.95*(windo(4)-windo(3)) + windo(3), 1) 1984 call write_label(16, 0.22*(windo(2)-windo(1))+windo(1), 1985 & 0.95*(windo(4)-windo(3)) + windo(3), 1986 & 'Unbiased Track') 1987 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 1988 & 0.2*(windo(2)-windo(1)) + windo(1), 1989 & 0.9*(windo(4)-windo(3)) + windo(3), 1990 & 0.9*(windo(4)-windo(3)) + windo(3), 2) 1991 call write_label(16, 0.22*(windo(2)-windo(1))+windo(1), 1992 & 0.9*(windo(4)-windo(3)) + windo(3), 1993 & 'OD Error Bias') 1994 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 1995 & 0.2*(windo(2)-windo(1)) + windo(1), GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 36 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 1996 & 0.85*(windo(4)-windo(3)) + windo(3), 1997 & 0.85*(windo(4)-windo(3)) + windo(3), 3) 1998 call write_label(16, 0.22*(windo(2)-windo(1))+windo(1), 1999 & 0.85*(windo(4)-windo(3)) + windo(3), 2000 & 'DV Error bias') 2001 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 2002 & 0.2*(windo(2)-windo(1)) + windo(1), 2003 & 0.80*(windo(4)-windo(3)) + windo(3), 2004 & 0.80*(windo(4)-windo(3)) + windo(3), 4) 2005 call write_label(16, 0.22*(windo(2)-windo(1))+windo(1), 2006 & 0.8*(windo(4)-windo(3)) + windo(3), 2007 & 'Density Prediction Bias') 2008 2009 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 2010 & 0.2*(windo(2)-windo(1)) + windo(1), 2011 & 0.75*(windo(4)-windo(3)) + windo(3), 2012 & 0.75*(windo(4)-windo(3)) + windo(3), 1) 2013 call write_label(16, 0.22*(windo(2)-windo(1))+windo(1), 2014 & 0.75*(windo(4)-windo(3)) + windo(3), 2015 & 'Boost Prediction Bias') 2016 2017 call write_line ( 16, 0.1*(windo(2)-windo(1))+windo(1), 2018 & 0.2*(windo(2)-windo(1)) + windo(1), 2019 & 0.7*(windo(4)-windo(3)) + windo(3), 2020 & 0.7*(windo(4)-windo(3)) + windo(3), 5) 2021 call write_label( 16, 0.22*(windo(2)-windo(1))+windo(1), 2022 & 0.7*(windo(4)-windo(3)) + windo(3), 'RSS Bias') 2023 2024 end if 2025 END IF 2026 END IF 2027 2028 C 2029 C************************************************************************** 2030 C 2031 C Now that all the input has been read and the output files 2032 C initialized, do the targeting, FINALLY. 2033 C 2034 C************************************************************************** 2035 C 2036 C 2037 C1 Runout or target the ground track. TGTGT also writes $ZLINE namelists 2038 C1 to the EZPLOT data file. 2039 2040 2041 CALL TGTGT ( TESTCASE, 2042 & STRAT , target_strat , DAYS , 2043 & ORBIT , DATE , REV, 2044 & DV , PITCH, YAW, DVQUANTA, 2045 & M , JEARTH , LTOP , LSFLAG , DRAG , 2046 * cd, dsmadt, tsmaswitch, sigma_dsma, 2047 & dragbiasmode, 2048 & BOUNDS , BNDFUZ , TIMTGT , TIMFUZ , 2049 & ORBITS , XINGS , 2050 & WATCH , WATCHINT , 2051 & SIGMA_DV_FIXED, SIGMA_DV_PROP, DELTA_A_OD, 2052 & SIGMA_SF_DVOD, sigma_sf_drag, sigma_sf_boost, GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 37 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 2053 & NGTBIAS_DRAG, GTBIAS_DRAG, DVBRACKET, 2054 & ATARGONLY, ipage, 2055 & ORBEND , DATEND, PLOTDATE, WINDO, boot, 2056 & plot, plot_components, plotcycle 2057 & ) 2058 2059 C 2060 C write overflight data to report file 2061 C 2062 if (sites) then 2063 CALL NEWPAGE(IPAGE, 2) 2064 WRITE(8, 11200) SITE_STRAT 2065 11200 FORMAT (31x, 'Site Overflights'/ 2066 & 31x, '----------------'/ 2067 & 31x, 'Method = ', A6,/) 2068 2069 write(8,11202) (SITE_NAME(i), 2070 & site_loc(2,i),site_gclat(i), 2071 & site_loc(1,i),site_node(i),i=1,nsites) 2072 11202 format (T16,'Site',9x,'GD Lat',9x, 'GC Lat', 6x, 2073 & 'Longitude',1x,'Node', 2074 & /,T10,10('-'),3(1x,14('-')),1x,4('-') , 2075 & (/,T10, A10,3F15.7,I5) ) 2076 do i=1,nsites 2077 j = 10 2078 do while((site_name(i)(j:j).eq.' ') .and. 2079 & (j.gt.1)) 2080 j = j-1 2081 end do 2082 write(8,11203) site_name(i) 2083 write(8,11204) 2084 do j=1,noverflights(i) 2085 sitedate = sec2ch(overflights(i,j,1)) 2086 if (site_strat.eq.'KEPLER') then 2087 overflights(i,j,4) = 2088 & site_loc(1,i) - overflights(i,j,2)/deg_to_km 2089 end if 2090 write(8,11206) sitedate(1:17), 2091 & nint(overflights(i,j,5)), 2092 & nint(overflights(i,j,5)).eq.site_node(i), 2093 & overflights(i,j,3), 2094 & overflights(i,j,4), overflights(i,j,2) 2095 end do 2096 end do 2097 11203 format(//1x,<(71-j)/2>x,'Site = ',a/ 2098 & 1x,<(71-j)/2>x,'-------',('-')) 2099 11204 format(/ 2100 & 1x, 14x,'Overflight',3x,'Rev #',24x,'Longitudinal',/ 2101 & 1x, 11x,'UTC Date/Time Used Latitude', 2102 & ' Longitude Offset, Km',/ 2103 & 1x, 7x, '----------------- ------- -----------', 2104 & ' ---------- ------------') 2105 11206 format(1x,7x, A17,1x, I5,1x,L1,F12.5,F11.5,F13.5) 2106 end if 2107 2108 C 2109 C write overflight data to plot GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 38 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 2110 C 2111 plotepoch = CH2SEC ( date, .TRUE., ERROR ) 2112 2113 if ( PLOTSITE) then 2114 do I=1,NSITES 2115 NPTS = NOVERFLIGHTS(I) 2116 STYLE = 0 2117 SYMBOL = SITE_SYM(I) 2118 do j=1,NOVERFLIGHTS(I) 2119 C write(8,*) SITE_NAME(I), (OVERFLIGHTS(I,J,k),k=1,2) 2120 X(J) = OVERFLIGHTS(I,J,2) 2121 Y(J) = ( OVERFLIGHTS(I,J,1) - PLOTEPOCH )/86400.0d0 2122 & + PLOTDELTA 2123 end do 2124 TEXT = CHAR(symbol)//' '//SITE_NAME(I) 2125 XTXT = WINDO(2)+(WINDO(2)-WINDO(1))*0.01 2126 YTXT = WINDO(3)+ i * ( (WINDO(4)-WINDO(3))*0.05 ) 2127 write(11,ZLINE) 2128 end do 2129 end if 2130 2131 C close files 2132 2133 if (plot) CLOSE( 11 ) 2134 if (boot) close(12) 2135 if (plot .and. plot_components) CLOSE( 16 ) 2136 2137 2138 if ( dragbiasmode .eq. 'FLUX') then 2139 if (make_bias_file) then 2140 write(17,gtbias) 2141 close(17) 2142 end if 2143 end if 2144 2145 cputime = getcpu() - cputime 2146 clockend = secnds(0.0) 2147 2148 elapsedtime = clockend - clockstart 2149 if (elapsedtime .lt. 0.0) elapsedtime = elapsedtime+86400.0 2150 2151 call vmsdate (aday) 2152 call time (atime) 2153 write (8, * ) ' ' 2154 write (8, * ) 'GTARG run completed ',aday,' ',atime 2155 write ( 8, 1500 ) 'Total CPU time = ', cputime, ' seconds.' 2156 write (8, 1500) 'Elapsed time = ', elapsedtime, ' seconds.' 2157 write (8, 1500)'CPU Utilization = ', 100.0* cputime/elapsedtime, 2158 * ' percent.' 2159 2160 2161 close ( 8 ) 2162 1500 FORMAT(1X,A,F12.1,A) 2163 1501 format(1x,75('*')) 2164 print *, goto_string(24,1), 'Run completed.',aday,' ',atime 2165 write (6,1501) 2166 write (6, 1500 ) 'Total CPU time = ', cputime, ' seconds.' GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 39 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 2167 write (6, 1500) 'Elapsed time = ', elapsedtime, ' seconds.' 2168 write (6, 1500)'CPU Utilization = ',100.0*cputime/elapsedtime, 2169 * ' percent.' 2170 write (6,1501) 2171 WRITE (6,*) 'Output File: ',output_file_name 2172 if (plot) write (6,*) 'EZPLOT Files: ',plot_file_name 2173 if (plot .and. plot_components) 2174 * write (6,*) ' ',plot_file2_name 2175 if (boot) 2176 *write (6,*) 'Boot File: ',boot_file_name 2177 if ( (dragbiasmode .eq. 'FLUX') .and. MAKE_BIAS_FILE) 2178 &write(6,*) 'New Biases: ', newbiasfile_name 2179 write (6,1501) 2180 stop 'Thank you for using GTARG!' 2181 2182 2183 C1 End of GTARG. 2184 2185 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 14358 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 10675 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 67856 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 BOOST 49041 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 ERROR_FLAGS 8 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 6 DRAGBLOCK 300 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 7 VMA 4376 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 8 PHYSICAL_CONSTANTS 72 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 9 SITE_DATA 40430 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 187128 ENTRY POINTS Address Type Name 0-00000000 GTARG VARIABLES Address Type Name Address Type Name 2-0000EB35 CHAR ADAY 2-0000EE64 L*4 ATARGONLY 6-0000001C R*8 ATDEN 2-0000EB3E CHAR ATIME 6-00000012 CHAR ATMOS 2-0000E75B CHAR BFILE 2-0000EDE0 R*8 BNDFUZ 2-0000E7AB CHAR BOOST_ERROR_MODEL 2-0000EE68 L*4 BOOT 2-0000EBE6 CHAR BOOT_FILE_NAME GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 40 01 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 2-0000EDE8 R*8 CD ** R*4 CLOCKEND 2-0000EF04 R*4 CLOCKSTART 2-0000EF00 R*4 CPUTIME 2-0000E7C3 CHAR DATE 2-0000EB03 CHAR DATEND 2-0000E714 CHAR DAYONE 2-0000EE6C I*4 DAYS 8-00000038 R*8 DEG_TO_KM 2-0000EDF0 R*8 DELTA_A_OD 2-0000EA66 CHAR DEVICE 2-0000EE70 L*4 DRAG 6-0000000A R*8 DRAGAREA 2-0000E7F5 CHAR DRAGBIASMODE 6-00000000 CHAR DRAGMODEL 2-0000E7B7 CHAR DRAG_ERROR_MODEL 4-00001F5D R*8 DSMADT_DATA_SIGMA 4-00001F44 CHAR DSMADT_EPOCH 2-0000E7DC CHAR DSMASWITCH 2-0000EE00 R*8 DV 2-0000EE08 R*8 DVQUANTA 8-00000008 R*8 EARTH_FREQ 8-00000000 R*8 EARTH_RAD 8-00000010 R*8 EARTH_RATE 2-0000EE74 L*4 ECHO_BIAS 2-0000EE88 L*4 ECHO_BOOST 2-0000EE78 L*4 ECHO_FLUX 2-0000EE7C L*4 ECHO_GRAV 2-0000EE84 L*4 ECHO_INPT 2-0000EE94 L*4 ECHO_VMATAB 2-0000EE80 L*4 ECHO_XING ** R*4 ELAPSEDTIME 2-0000EEFC L*4 ERROR 2-0000EE90 L*4 EZHEAD 2-0000EEA4 L*4 FBAR_BIAS_INPUT 2-0000EE9C L*4 FBAR_SLOPE_INPUT 8-00000040 R*8 FLAT 2-0000EEA0 L*4 FLUX_BIAS_INPUT 2-0000EB96 CHAR FLUX_FILE_NAME 2-0000EE98 L*4 FLUX_SLOPE_INPUT 2-0000E96E CHAR GTBIASFILE 2-0000EC36 CHAR GTBIAS_FILE_NAME 2-0000EF0C I*4 I 2-0000EF10 I*4 IERROR ** CHAR II 2-0000EF18 I*4 IMAX 2-0000EF1C I*4 IMIN 2-0000EB46 CHAR INPUT_FILE_NAME 2-0000EF08 I*4 IPAGE 2-0000EF14 I*4 J ** I*4 K ** I*4 KK 2-0000EDC6 CHAR LINK_TIME 2-0000EEA8 L*4 LSFLAG 2-0000EEAC I*4 LTOP 2-0000EEB0 I*4 M 2-0000EEB4 L*4 MAKE_BIAS_FILE 2-0000EE10 R*8 MASS 8-00000018 R*8 MU_EARTH 8-00000020 R*8 MU_MOON 8-00000028 R*8 MU_SUN 4-00000000 I*4 NDSMADT_DATA 2-0000E7F9 CHAR NEWBIASFILE 2-0000ED76 CHAR NEWBIASFILE_NAME 2-0000EEDC I*4 NGTBIAS_DRAG 2-0000EEE4 I*4 NPTS 9-00000000 I*4 NSITES 2-0000EE60 I*4 NUMDAY 2-0000EEB8 R*4 ODAYS 2-0000E849 CHAR ODEVICE 2-0000E855 CHAR OFILE 2-0000EEBC I*4 ORBITS 2-0000ECD6 CHAR OUTPUT_FILE_NAME ** CHAR OUTPUT_MESSAGE 2-0000EE18 R*8 PITCH 2-0000EEC0 L*4 PLOT 4-00001F65 L*4 PLOTBOOST 2-0000EEC8 L*4 PLOTCYCLE 2-0000E8A5 CHAR PLOTDATE 2-0000EEF8 R*4 PLOTDELTA ** R*4 PLOTEPOCH 2-0000EECC L*4 PLOTSITE 2-0000E8BE CHAR PLOTTITLE 2-0000EEC4 L*4 PLOT_COMPONENTS 2-0000ED26 CHAR PLOT_FILE2_NAME 2-0000EC86 CHAR PLOT_FILE_NAME 5-00000000 L*4 QUAD_ERR_BOOST 5-00000004 L*4 QUAD_ERR_DRAG 2-0000EED0 I*4 REV 8-00000030 R*8 SID_DAY 2-0000EE20 R*8 SIGMA_DV_FIXED 2-0000EE28 R*8 SIGMA_DV_PROP 2-0000EE30 R*8 SIGMA_SF_BOOST 2-0000EE40 R*8 SIGMA_SF_DRAG 2-0000EE38 R*8 SIGMA_SF_DVOD 2-0000EB1C CHAR SITEDATE 2-0000EE8C L*4 SITES 2-0000E95E CHAR SITE_LOC_TYPE 9-00000180 CHAR SITE_STRAT 2-0000E968 CHAR STRAT 2-0000EEEC I*4 STYLE 2-0000EEE0 L*4 SUMMRY 2-0000EEE8 I*4 SYMBOL ** CHAR TABLE_FILE_NAME 2-0000E9BE CHAR TARGET_STRAT 3-00000000 CHAR TERMINAL 2-0000E90E CHAR TESTCASE 2-0000E71F CHAR TEXT 2-0000EE48 R*8 TIMFUZ 2-0000EE50 R*8 TIMTGT 2-0000EA72 CHAR TITLE 2-0000EDF8 R*8 TSMASWITCH 2-0000EED4 L*4 WATCH 2-0000EED8 L*4 WATCHINT GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 41 01 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 ** R*8 XJD0 2-0000EAAE CHAR XTITLE 2-0000EEF0 R*4 XTXT 2-0000EE58 R*8 YAW 2-0000EAE0 CHAR YTITLE 2-0000EEF4 R*4 YTXT 2-0000E9C6 CHAR ZFILE 2-0000EA16 CHAR ZFILE2 ARRAYS Address Type Name Bytes Dimensions 2-0000E624 CHAR AJD 240 (10) 6-0000010C R*8 ATDEN_ANN 16 (2) 6-000000E4 R*8 ATDEN_POLY 40 (5) 6-0000011C R*8 ATDEN_SEMI 16 (2) 2-0000BB80 R*8 BOUNDS 16 (2) 7-00001108 R*8 BREAKPTS 16 (2) 7-000010F8 R*8 CAREAS 16 (2) 2-00005DC0 R*8 DFLX 8000 (1000) 2-00007D00 R*8 DFLXBAR 8000 (1000) 2-00009C40 R*8 DKP 8000 (1000) 2-0000BB90 R*8 DSMADT 16 (2) 4-00000004 R*8 DSMADT_DATA 8000 (1000) 4-00001F69 CHAR DSMADT_DATES 25000 (1000) 4-0000A051 R*8 DSMADT_SIGMAS 8000 (1000) 2-0000E2C0 I*4 DVBRACKET 12 (3) 6-000000B4 R*8 FBAR_BIAS 48 (6) 6-00000054 R*8 FBAR_SLOPE 48 (6) 6-00000084 R*8 FLUX_BIAS 48 (6) 6-00000024 R*8 FLUX_SLOPE 48 (6) 2-00000000 R*8 FLX 8000 (1000) 2-00001F40 R*8 FLXBAR 8000 (1000) 2-0000C300 R*8 GTBIAS_DRAG 8000 (1000) 2-0000BBA0 R*8 JEARTH 224 (2:29) 2-00003E80 R*8 KP 8000 (1000) 9-00009DC6 I*4 NOVERFLIGHTS 40 (10) 2-0000E240 R*8 ORBEND 48 (6) 2-0000BC80 R*8 ORBIT 48 (6) 9-00000186 R*8 OVERFLIGHTS 40000 (10, 100, 5) 2-0000BCB0 R*8 SIGMA_DSMA 16 (2) 9-000000CC R*8 SITE_GCLAT 80 (10) 9-00000004 R*8 SITE_LOC 160 (2, 10) 9-0000011C CHAR SITE_NAME 100 (10) 9-000000A4 I*4 SITE_NODE 40 (10) 2-0000E2CC I*4 SITE_SYM 40 (10) 7-00000000 R*8 VMATAB 4344 (3, -90:90) 2-0000E2F4 R*4 WINDO 16 (4) 2-0000E304 R*4 X 400 (100) 4-00008111 R*8 XDSMADT_DATES 8000 (1000) 2-0000BCC0 R*8 XINGS 1600 (200) 2-0000E270 R*8 XJD 80 (10) 2-0000E494 R*4 Y 400 (100) GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 42 01 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 NAMELISTS Address Name Address Name Address Name Address Name 2-0000EF54 FLXKP 2-0000EFA4 GTBIAS 2-0000EFBC INPUT 2-0000F2DC ZFRAME 2-0000F314 ZLINE LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-00000A28 11' 1-00002291 110' 1-000022F2 111' 1-000022FD 112' 1-00002367 113' 1-000020A3 114' 1-00001061 121' 1-0000108A 122' 1-0000122C 123' 1-000014E2 124' 1-000017A5 125' 1-000017DB 126' 1-0000181C 127' 1-00001D0B 149' 1-00000C18 301' 1-00000C44 302' 1-00000C75 303' 1-00002372 304' 1-0000203D 305' 1-00000C9D 306' 1-00002620 307' 1-00000BD8 1001' 1-0000206B 1135' 1-000020DB 1143' 1-00000D3E 1174' 1-00000DAB 1180' 1-00000DF3 1182' 1-00000E3F 1185' 1-00000EA9 1188' 1-00000F13 1189' 1-00000F4A 1191' 1-00000F76 1193' 1-00000FA2 1195' 1-00000FCE 1203' 1-0000102E 1204' 1-000010DE 1221' 1-0000110B 1222' 1-00001138 1226' 1-000011D2 1227' 1-00001201 1228' 1-0000140C 1235' 1-00001641 1243' 1-0000145A 1247' 1-000019D4 1305' 1-00001DA0 1491' 1-00001DB1 1492' 1-00001DC4 1493' 1-00001DD7 1495' 1-00001FEF 1496' ** 1497' 1-00002006 1498' 1-00001E9D 1499' 1-000027EC 1500' 1-000027F4 1501' ** 3037' 1-0000248D 3038' 1-0000249C 3039' ** 3041' ** 3045' 1-000024AA 3046' ** 3047' 1-0000183A 3049' 1-00001946 3050' 1-00002500 3053' 1-00002528 3054' 1-0000259D 3055' 1-000025AF 3056' 1-00002646 11200' 1-00002681 11202' 1-000026EA 11203' 1-00002721 11204' 1-000027D4 11206' 1-00001397 12345' 1-000013D4 12346' 1-00001433 12351' 1-00001495 12473' 1-000014B9 12475' 1-000016E4 12482' 1-00001710 12485' 1-00001743 12487' 1-0000176F 12489' 1-00001BC1 13055' 1-00001DEB 14798' 1-00001E10 14799' 1-00001E88 14800' 1-00001FF8 14975' 1-00001F1E 14991' 1-00001F8F 14995' 1-0000247F 30375' 1-000023D9 30401' 1-00002431 30405' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 CH2JD R*8 CH2SEC L*4 CHECKDATES CRMINI FOR$CLOSE FOR$INQUIRE R*4 FOR$SECNDS FOR$TIME_T_DS R*4 GETCPU CHAR GOTO_STRING INIT_PARMS CHAR LNKTIM R*8 MTH$DATAN R*8 MTH$DTAN NEWPAGE OPSFN OPSFOR R*4 POLY R*8 RNG360 CHAR SEC2CH R*4 SETCPU TGTGT UPCASE VMSDATE WRITE_LABEL WRITE_LINE CHAR YESNO CHAR YESNOSTRING COMMAND QUALIFIERS FOR/LIS GTARG.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.OBJ;2 GTARG 1-Jun-1993 15:37:16 VAX FORTRAN V5.6-119 Page 43 01 10-May-1993 15:48:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GTARG.FOR;1406 COMPILATION STATISTICS Run Time: 7.00 seconds Elapsed Time: 24.28 seconds Page Faults: 2478 Dynamic Memory: 1708 pages 1-Jun-1993 15:32:27 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:25:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.FOR;26 0001 subroutine car2kep ( car, kep, mu ) 0002 C 0003 C Converts Cartesian elements to Keplerian Elements 0004 C Algorithm Given by Bate, Mueller, and White, "Fundamentals of 0005 C Astrodynamics", Dover 0006 C 0007 C B. Shapiro 11/24/92 - created to remove dependence on TOPEX libraries 0008 C 0009 C******************************************************************************* 0010 C 0011 C Copyright (C) 1993, California Institute of Technology. U.S. 0012 C Government Sponsorhip under NASA Contract NAS7-918 is 0013 C acknowledged. 0014 C 0015 C******************************************************************************* 0016 C 0017 C parameter name type description & units 0018 C -------------- ---- ------------------------------------------- 0019 C input: car (6) r*8 x, y, z, vx, vy, vz, km and km/sec 0020 C mu r*8 earth gravity, km-3/sec-2 0021 C 0022 C output: kep (6) r*8 a (km), e, i,Node,Perigee, M (degrees) 0023 C 0024 C******************************************************************************* 0025 0026 double precision kep(6), car(6), mu 0027 0028 double precision eVec(3), r, v, rdotv, first, second, h(3), e, 0029 & N(3), Zhat(3), p, sma, INCL, RAAN, AOP, Ehat(3), Nhat(3), 0030 & Hhat(3), U, RHAT(3), THETA, EANOM, MANOM, SINTHETA, 0031 & COSTHETA, cosE, sinE, RhatDotNhat, NhatDotEhat 0032 data Zhat /0.0d0, 0.0d0, 1.0d0 / 0033 0034 double precision dot 0035 external dot 0036 0037 double precision pi 0038 parameter ( pi=3.14159 26535 89793 23846) 0039 0040 r = sqrt( dot ( car(1), car(1) ) ) 0041 v = sqrt( dot ( car(4), car(4) ) ) 0042 RdotV = dot ( car(1), car(4) ) 0043 0044 first = ( v*v - MU/r ) / MU 0045 second = -RdotV / MU 0046 0047 do i = 1, 3 0048 evec(i) = first * car(i) + second * car(i+3) 0049 end do 0050 0051 e = sqrt ( dot ( evec, evec ) ) 0052 0053 call UNIT ( EVEC , EHAT) 0054 0055 call cross ( car(1), car(4), h ) 0056 call UNIT ( H, HHAT) 0057 CAR2KEP 1-Jun-1993 15:32:27 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:25:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.FOR;26 0058 p = dot ( H, H ) / MU 0059 SMA = P/(1-e*e) 0060 0061 if (HHAT(3) .ge. 1.0) then 0062 INCL = 0.0d0 0063 else if (hhat(3) .le. -1.0) then 0064 INCL = 180.0d0 0065 else 0066 INCL = ACOS ( HHAT(3) ) * 180.0d0 / PI 0067 end if 0068 0069 call cross ( zhat, h, n) 0070 call UNIT ( N, NHAT) 0071 0072 if (NHAT(1) .ge. 1.0) then 0073 raan = 0.0d0 0074 else if (NHAT(2) .le. -1.0) then 0075 raan = 180.0d0 0076 else 0077 RAAN = ACOS ( NHAT(1) ) * 180.0d0 / PI 0078 end if 0079 0080 IF ( N(2) .LT. 0.0D0 ) then 0081 RAAN = 360.0d0 - RAAN 0082 end if 0083 0084 if (RAAN .LT. 0.0D0) RAAN = RAAN + 360.0D0 0085 0086 NhatDotEhat = DOT( NHAT, EHAT ) 0087 0088 if ( nhatdotehat .ge. 1.0d0 ) then 0089 aop = 0.0d0 0090 else if ( nhatdotehat .le. -1.0d0 ) then 0091 aop = 180.0d0 0092 else 0093 AOP = ACOS ( NhatDotEhat ) * 180.0d0 / PI 0094 end if 0095 0096 if (EVEC(3) .LT. 0.0D0 ) then 0097 AOP = 360.0D0 - AOP 0098 end if 0099 0100 IF (AOP .LT. 0.0D0) AOP = AOP + 360.0D0 0101 0102 CALL UNIT ( CAR(1), RHAT ) 0103 0104 C write(8,*) 'h=',h 0105 C write(8,*) 'n=',n 0106 C write(8,*) 'car=',car 0107 C write(8,*) 'rhat=',rhat 0108 C write(8,*) 'nhat=',nhat 0109 C write(8,*) 'dot(rhat,nhat)=',dot(rhat,nhat) 0110 0111 0112 RhatDotNhat = DOT(RHAT,NHAT) 0113 if (RhatDotNhat .ge. 1.0) then 0114 U = 0.0d0 CAR2KEP 1-Jun-1993 15:32:27 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 19:25:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.FOR;26 0115 else if (RhatDotNhat .le. -1.0) then 0116 U = 180.0D0 0117 else 0118 U = ACOS ( RhatDotNhat ) * 180.0d0 / PI 0119 end if 0120 0121 if (CAR(3) .LT. 0 ) then 0122 U = 360.0d0 - U 0123 end if 0124 THETA = U - AOP 0125 0126 sinTHETA = SIN ( THETA * PI/180.0d0 ) 0127 cosTHETA = COS ( THETA * PI/180.0d0 ) 0128 0129 cosE = (e + cosTHETA)/(1+e*cosTHETA) 0130 sinE = (sqrt(1-e*e)*sinTHETA)/(1+e*cosTHETA) 0131 EANOM = ATAN2 ( sinE, cosE ) 0132 MANOM = ( EANOM - e * sinE ) * 180.0d0 / PI 0133 0134 if (MANOM .LT. 0.0D0 ) MANOM = MANOM + 360.0D0 0135 0136 KEP(1) = SMA 0137 KEP(2) = e 0138 KEP(3) = INCL 0139 KEP(4) = RAAN 0140 KEP(5) = AOP 0141 KEP(6) = MANOM 0142 0143 return 0144 end CAR2KEP 1-Jun-1993 15:32:27 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 19:25:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.FOR;26 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 862 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 464 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 1326 ENTRY POINTS Address Type Name 0-00000000 CAR2KEP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-000000E0 R*8 AOP 2-000000E8 R*8 COSE ** R*8 COSTHETA 2-000000C0 R*8 E ** R*8 EANOM ** R*8 FIRST ** I*4 I 2-000000D0 R*8 INCL ** R*8 MANOM AP-0000000C@ R*8 MU ** R*8 NHATDOTEHAT ** R*8 P ** R*8 R 2-000000D8 R*8 RAAN ** R*8 RDOTV ** R*8 RHATDOTNHAT ** R*8 SECOND 2-000000F0 R*8 SINE ** R*8 SINTHETA 2-000000C8 R*8 SMA ** R*8 THETA ** R*8 U ** R*8 V ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 CAR 48 (6) 2-00000060 R*8 EHAT 24 (3) 2-00000000 R*8 EVEC 24 (3) 2-00000018 R*8 H 24 (3) 2-00000090 R*8 HHAT 24 (3) AP-00000008@ R*8 KEP 48 (6) 2-00000030 R*8 N 24 (3) 2-00000078 R*8 NHAT 24 (3) 2-000000A8 R*8 RHAT 24 (3) 2-00000048 R*8 ZHAT 24 (3) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name CROSS R*8 DOT R*8 MTH$DACOS R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DSIN R*8 MTH$DSQRT UNIT 1-Jun-1993 15:32:27 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 19:25:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.FOR;26 0001 0002 0003 C program test 0004 C double precision mu, car(6), kep(6) 0005 C data mu/398600.436/ 0006 C data car/ 5485.65525126522754817, 423.93438555786292454, 0007 C & -5408.29999696842162393, 3.81409491479695123, 0008 C & 4.39940058458674010, 4.21417533546375223 / 0009 C 0010 C call car2kep(car, kep, mu) 0011 C write(6,*) 'car=',car 0012 C write(6,*) 'kep=',kep 0013 C end 0014 C COMMAND QUALIFIERS FOR/LIS CAR2KEP.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CAR2KEP.OBJ;2 COMPILATION STATISTICS Run Time: 0.73 seconds Elapsed Time: 5.70 seconds Page Faults: 347 Dynamic Memory: 568 pages 1-Jun-1993 15:32:39 VAX FORTRAN V5.6-119 Page 1 15-Feb-1993 17:46:07 [SHAPIRO.COSMIC.SOURCE]CHECKDATES.FOR;4 0001 logical function checkdates ( dates, ndates, ierror, 0002 & xdates ) 0003 C 0004 C return value: True = all dates are in order, false, out of order 0005 C ierror = line where error occurred; random if all dates are in order 0006 C xdates = array of real*8 dates in ch2sec format, if everything is OK 0007 C 0008 integer ndates, ierror 0009 character*25 dates(ndates), sec2ch, tnew 0010 double precision ch2sec, t, tlast, xdates(ndates) 0011 external ch2sec, sec2ch 0012 logical error, result 0013 data result/.true./ 0014 0015 tlast = ch2sec ( dates(1), .true., error) 0016 tnew = sec2ch ( tlast ) 0017 dates (1) = tnew 0018 xdates(1) = tlast 0019 0020 do i=2, ndates 0021 t = ch2sec ( dates(i), .true., error) 0022 xdates(i) = t 0023 tnew = sec2ch ( t ) 0024 dates (i) = tnew 0025 if (t .lt. tlast) then 0026 result = .false. 0027 ierror = i 0028 goto 9999 0029 else 0030 tlast = t 0031 end if 0032 end do 0033 0034 9999 continue 0035 checkdates = result 0036 return 0037 end CHECKDATES 1-Jun-1993 15:32:39 VAX FORTRAN V5.6-119 Page 2 01 15-Feb-1993 17:46:07 [SHAPIRO.COSMIC.SOURCE]CHECKDATES.FOR;4 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 221 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 228 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 453 ENTRY POINTS Address Type Name 0-00000000 L*4 CHECKDATES VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000030 L*4 ERROR ** I*4 I AP-0000000C@ I*4 IERROR AP-00000008@ I*4 NDATES 2-00000034 L*4 RESULT 2-00000020 R*8 T 2-00000028 R*8 TLAST 2-00000000 CHAR TNEW ARRAYS Address Type Name Bytes Dimensions AP-00000004@ CHAR DATES ** (*) AP-00000010@ R*8 XDATES ** (*) LABELS Address Label 0-000000D8 9999 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 CH2SEC CHAR SEC2CH 1-Jun-1993 15:32:39 VAX FORTRAN V5.6-119 Page 3 15-Feb-1993 17:46:07 [SHAPIRO.COSMIC.SOURCE]CHECKDATES.FOR;4 0001 0002 0003 C program tester 0004 C logical checkdates 0005 C character*25 dates(11) 0006 C data dates / '16-APR-1992 23:30', 0007 C & '19-APR-1992 15:12', '13-MAY-1992 01:48', '18-JUN-1992 22:20', 0008 C & '27-JUL-1992 14:20', '29-AUG-1993 15:03', '2-SEP-1993 03:01', 0009 C & '6-OCT-1993 04:27', '11-NOV-1993 19:22', '12-DEC-1993 08:29', 0010 C & '13-MAY-1994 05:06'/ 0011 C data dates / '16-APR-1992 23:30', 0012 C & '19-APR-1992 15:12', '13-MAY-1992 01:48', '18-JUN-1992 22:20', 0013 C & '27-JUL-1992 14:20', '29-AUG-1993 15:03', '2-SEP-1993 03:01', 0014 C & '6-OCT-1993 04:27', '11-NOV-1992 19:22', '12-DEC-1993 08:29', 0015 C & '13-MAY-1994 05:06'/ 0016 C write(6,*) checkdates(dates, 11, ierror), ' ', ierror 0017 C stop 0018 C end COMMAND QUALIFIERS FOR/LIS CHECKDATES.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHECKDATES.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHECKDATES.OBJ;2 COMPILATION STATISTICS Run Time: 0.34 seconds Elapsed Time: 3.67 seconds Page Faults: 236 Dynamic Memory: 488 pages 1-Jun-1993 15:32:49 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:32:43 [SHAPIRO.COSMIC.SOURCE]CHECK_SUCCESS.FOR;4 0001 subroutine check_success ( STRAT , TARGET_STRAT, 0002 & CLASS , LIMITS, LIMITS_WEST, LIMITS_EAST , 0003 & BNDFUZ , TIMFUZ , TARGET , 0004 & SUCCES ) 0005 0006 C 0007 C******************************************************************************* 0008 C 0009 C Copyright (C) 1993, California Institute of Technology. U.S. 0010 C Government Sponsorhip under NASA Contract NAS7-918 is 0011 C acknowledged. 0012 C 0013 C******************************************************************************* 0014 C 0015 C This is a driver for chksuc. CHKSUC determines whether the correct 0016 C DV has been found which successfully targets the ground track as 0017 C desired. The purpose of this driver is to determine which ground 0018 C track to check; there are three choices: the nominal ground track, 0019 C and the edges of the 95% error envelope. 0020 C 0021 C Bruce Shapiro 9/6/91 0022 C 0023 C 0024 DOUBLE PRECISION BNDFUZ 0025 INTEGER CLASS 0026 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0027 DOUBLE PRECISION LIMITS_EAST ( 4 , 2 ) 0028 DOUBLE PRECISION LIMITS_WEST ( 4 , 2 ) 0029 CHARACTER*6 STRAT 0030 LOGICAL SUCCES 0031 DOUBLE PRECISION TARGET 0032 CHARACTER*8 TARGET_STRAT 0033 DOUBLE PRECISION TIMFUZ 0034 0035 if (target_strat .eq. 'UNBIASED') then 0036 CALL CHKSUC ( STRAT , 0037 & CLASS , LIMITS , 0038 & BNDFUZ , TIMFUZ , TARGET , 0039 & SUCCES ) 0040 else if ( target_strat .eq. 'WESTGT' ) then 0041 CALL CHKSUC ( STRAT , 0042 & CLASS , LIMITS_WEST , 0043 & BNDFUZ , TIMFUZ , TARGET , 0044 & SUCCES ) 0045 else if ( target_strat .eq. 'EASTGT' ) then 0046 CALL CHKSUC ( STRAT , 0047 & CLASS , LIMITS_EAST , 0048 & BNDFUZ , TIMFUZ , TARGET , 0049 & SUCCES ) 0050 end if 0051 0052 return 0053 end CHECK_SUCCESS 1-Jun-1993 15:32:49 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:32:43 [SHAPIRO.COSMIC.SOURCE]CHECK_SUCCESS.FOR;4 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 227 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 20 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 172 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 419 ENTRY POINTS Address Type Name 0-00000000 CHECK_SUCCESS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000001C@ R*8 BNDFUZ AP-0000000C@ I*4 CLASS AP-00000004@ CHAR STRAT AP-00000028@ L*4 SUCCES AP-00000024@ R*8 TARGET AP-00000008@ CHAR TARGET_STRAT AP-00000020@ R*8 TIMFUZ ARRAYS Address Type Name Bytes Dimensions AP-00000010@ R*8 LIMITS 64 (4, 2) AP-00000018@ R*8 LIMITS_EAST 64 (4, 2) AP-00000014@ R*8 LIMITS_WEST 64 (4, 2) FUNCTIONS AND SUBROUTINES REFERENCED Type Name CHKSUC COMMAND QUALIFIERS FOR/LIS CHECK_SUCCESS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHECK_SUCCESS.LIS;2 CHECK_SUCCESS 1-Jun-1993 15:32:49 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 19:32:43 [SHAPIRO.COSMIC.SOURCE]CHECK_SUCCESS.FOR;4 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHECK_SUCCESS.OBJ;2 COMPILATION STATISTICS Run Time: 0.26 seconds Elapsed Time: 4.59 seconds Page Faults: 219 Dynamic Memory: 472 pages 1-Jun-1993 15:32:58 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:34:09 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.FOR;4 0001 C$Procedure CHKDV 0002 C 0003 SUBROUTINE CHKDV ( STRAT , CLASS , DV , VALUE , TARGET , DVBND ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 30-JUL-1990 Eric Cannell creation of CHKDV 0019 C 0020 C$ Purpose 0021 C 0022 C CHKDV determines if the current dV and ground track can be used to 0023 C restrict the range of dV's that bound the target dV. 0024 C 0025 C The TARGET is the desired value of the criteria variable. What the criteria 0026 C variable represents depends on the strategy defined by STRAT: 0027 C 0028 C STRAT | criteria contents | units 0029 C -------|-----------------------------------------------|------ 0030 C 'LONG' | furthest west limit of ground tracks | km 0031 C 'EAST' | time for ground tracks to reach east boundary | days 0032 C 'WEST' | time for ground tracks to reach west boundary | days 0033 C 0034 C Depending on the type of ground track (CLASS), the dV (DV), and where 0035 C the ground track lies with respect to the desired ground track (VALUE, 0036 C TARGET), CHKDV may restrict the dV's that bound the desired targeted 0037 C dV. 0038 C 0039 C$ Input_Arguments 0040 C 0041 C Name Type Dim Units Description 0042 C ----------------------------------------------------------------------------- 0043 C STRAT C*6 1 - see Purpose 0044 C CLASS I 1 - type of last ground track 0045 C DV DP 1 mm/sec dV of last ground track 0046 C VALUE DP 1 --> current value of criteria variable. See 0047 C Purpose. 0048 C TARGET DP 1 --> see Purpose 0049 C DVBND DP 2 mm/sec smallest range of dV's known to bound 0050 C the target dV: 0051 C DVBND(1) = largest dV < target dV 0052 C DVBND(2) = smallest dV > target dV 0053 C 0054 C$ Output_Arguments 0055 C 0056 C Name Type Dim Units Description 0057 C ----------------------------------------------------------------------------- 1-Jun-1993 15:32:58 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:34:09 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.FOR;4 0058 C DVBND DP 2 mm/sec smallest range of dV's known to bound 0059 C the target dV: 0060 C DVBND(1) = largest dV < target dV 0061 C DVBND(2) = smallest dV > target dV 0062 C 0063 C$ References 0064 C 0065 C 1] See GTARG.FOR for a discussion regarding the classification of 0066 C ground tracks. 0067 C 0068 C$ Restrictions 0069 C 0070 C 1] CLASS should only have values in the range of 1..6. 0071 C 0072 C 3] CHKDV should not be called with STRAT = 'RUNOUT'. CHKDV is only for 0073 C targeting a ground track, not running one out. 0074 C 0075 C$ Declarations_of_Input_and_Output_Arguments 0076 C 0077 INTEGER CLASS 0078 DOUBLE PRECISION DV 0079 DOUBLE PRECISION DVBND ( 2 ) 0080 CHARACTER*6 STRAT 0081 DOUBLE PRECISION TARGET 0082 DOUBLE PRECISION VALUE 0083 C 0084 C$ Method 0085 C-& 0086 0087 C1 Action depends on the type of strategy... 0088 0089 IF ( STRAT .EQ. 'LONG' ) THEN 0090 0091 C2 If using the longitudinal targeting strategy... 0092 0093 IF ( CLASS .LE. 3 .AND. DV .GT. DVBND(1) ) THEN 0094 0095 C3 If CLASS is 1, 2, or 3 and dV is > low dV bound, then 0096 C3 increase low dV bound. 0097 0098 DVBND(1) = DV 0099 0100 ELSE IF ( CLASS .GE. 4 .AND. DV .LT. DVBND(2) ) THEN 0101 0102 C3 If CLASS is 4, 5, or 6 and dV is < high dV bound, then 0103 C3 decrease high dV bound. 0104 0105 DVBND(2) = DV 0106 0107 END IF 0108 0109 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 0110 0111 C2 If using the time targeting strategy to east boundary... 0112 0113 IF ( ( CLASS .EQ. 1 0114 & .OR. CLASS .EQ. 2 CHKDV 1-Jun-1993 15:32:58 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 19:34:09 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.FOR;4 0115 & ) 0116 & .AND. VALUE .LT. TARGET 0117 & .AND. DV .GT. DVBND(1) ) THEN 0118 0119 C3 If CLASS is 1 or 2, the current VALUE < the target value, and 0120 C3 the current dV > than the current low dV bound, then set the 0121 C3 low dV bound to the current dV. 0122 0123 DVBND(1) = DV 0124 0125 ELSE IF ( ( CLASS .EQ. 1 0126 & .OR. CLASS .EQ. 2 0127 & ) 0128 & .AND. VALUE .GT. TARGET 0129 & .AND. DV .LT. DVBND(2) ) THEN 0130 0131 C3 If CLASS is 1 or 2, the current VALUE < the target value, and 0132 C3 the current dV < than the current high dV bound, then set the 0133 C3 high dV bound to the current dV. 0134 0135 DVBND(2) = DV 0136 0137 ELSE IF ( ( CLASS .EQ. 3 0138 & ) 0139 & .AND. DV .GT. DVBND(1) ) THEN 0140 0141 C3 If CLASS is 3 and the current dV > than the current low dV bound, 0142 C3 then set the low dV bound to the current dV. 0143 0144 DVBND(1) = DV 0145 0146 ELSE IF ( ( CLASS .GE. 4 0147 & ) 0148 & .AND. DV .LT. DVBND(2) ) THEN 0149 0150 C3 If CLASS is >= 4 and the current dV < than the current high dV 0151 C3 bound, then set the high dV bound to the current dV. 0152 0153 DVBND(2) = DV 0154 0155 END IF 0156 0157 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 0158 0159 C2 If using the time targeting strategy to west boundary... 0160 0161 IF ( ( CLASS .LE. 3 0162 & ) 0163 & .AND. DV .GT. DVBND(1) ) THEN 0164 0165 C3 If CLASS is <= 3 and the current dV > than the current low dV 0166 C3 bound, then set the low dV bound to the current dV. 0167 0168 DVBND(1) = DV 0169 0170 ELSE IF ( ( CLASS .EQ. 4 0171 & .OR. CLASS .EQ. 5 CHKDV 1-Jun-1993 15:32:58 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 19:34:09 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.FOR;4 0172 & ) 0173 & .AND. VALUE .GT. TARGET 0174 & .AND. DV .GT. DVBND(1) ) THEN 0175 0176 C3 If CLASS is 4 or 5, the current VALUE > the target value, and 0177 C3 the current dV > than the current low dV bound, then set the 0178 C3 low dV bound to the current dV. 0179 0180 DVBND(1) = DV 0181 0182 ELSE IF ( ( CLASS .EQ. 4 0183 & .OR. CLASS .EQ. 5 0184 & ) 0185 & .AND. VALUE .LT. TARGET 0186 & .AND. DV .LT. DVBND(2) ) THEN 0187 0188 C3 If CLASS is 4 or 5, the current VALUE < the target value, and 0189 C3 the current dV < than the current high dV bound, then set the 0190 C3 high dV bound to the current dV. 0191 0192 DVBND(2) = DV 0193 0194 ELSE IF ( ( CLASS .EQ. 6 0195 & ) 0196 & .AND. DV .LT. DVBND(2) ) THEN 0197 0198 C3 If CLASS is 6 and the current dV < than the current high dV bound, 0199 C3 then set the high dV bound to the current dV. 0200 0201 DVBND(2) = DV 0202 0203 END IF 0204 0205 END IF 0206 0207 C1 End of CHKDV. 0208 0209 RETURN 0210 END CHKDV 1-Jun-1993 15:32:58 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 19:34:09 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.FOR;4 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 347 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 12 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 28 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 387 ENTRY POINTS Address Type Name 0-00000000 CHKDV VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 CLASS AP-0000000C@ R*8 DV AP-00000004@ CHAR STRAT AP-00000014@ R*8 TARGET AP-00000010@ R*8 VALUE ARRAYS Address Type Name Bytes Dimensions AP-00000018@ R*8 DVBND 16 (2) COMMAND QUALIFIERS FOR/LIS CHKDV.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKDV.OBJ;2 COMPILATION STATISTICS Run Time: 0.46 seconds Elapsed Time: 3.24 seconds Page Faults: 263 Dynamic Memory: 492 pages 1-Jun-1993 15:33:07 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:35:32 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.FOR;7 0001 C$Procedure CHKSUC 0002 C 0003 SUBROUTINE CHKSUC ( STRAT , 0004 & CLASS , LIMITS , 0005 & BNDFUZ , TIMFUZ , TARGET , 0006 & SUCCES ) 0007 C 0008 C 0009 C******************************************************************************* 0010 C 0011 C Copyright (C) 1993, California Institute of Technology. U.S. 0012 C Government Sponsorhip under NASA Contract NAS7-918 is 0013 C acknowledged. 0014 C 0015 C******************************************************************************* 0016 C 0017 C$ Log 0018 C 0019 C Date Name Description 0020 C ----------------------------------------------------------------------------- 0021 C 18-JUL-1990 Eric Cannell creation of CHKSUC 0022 C 0023 C$ Purpose 0024 C 0025 C CHKSUC determines if the ground track quantified by LIMITS successfully 0026 C meets the targeting criteria defined by the selected strategy. 0027 C 0028 C The success criteria for the different strategies are: 0029 C 0030 C STRAT = 'LONG' --> the furthest west point of the ground track must be 0031 C within BDNFUZ of the west boundary, but not beyond. 0032 C The ground track classification must be 1. 0033 C 0034 C STRAT = 'EAST' --> the time at the end of the ground track must be within 0035 C TIMFUZ of the target time on the east boundary. The 0036 C ground track classification must be 1 or 2. 0037 C 0038 C STRAT = 'WEST' --> the time at the end of the ground track must be within 0039 C TIMFUZ of the target time on the west boundary. The 0040 C ground track classification must be 4 or 5. 0041 C 0042 C$ Input_Arguments 0043 C 0044 C Name Type Dim Units Description 0045 C ----------------------------------------------------------------------------- 0046 C STRAT C*6 1 - name of targeting strategy. See Purpose. 0047 C CLASS I 1 - classification of ground track as per 0048 C discussion in Purpose Section GTARG. 0049 C LIMITS DP 4,2 days,km with regard to ascending nodes, the 0050 C time (in days) and ground track offset 0051 C (in km) of the first node, the furthest 0052 C west node, the furthest east node, and 0053 C the last node of the ground track. LIMITS 0054 C allows GTARG to classify the ground track. 0055 C time offset 0056 C |------|--------| 0057 C first node | days | km | 1-Jun-1993 15:33:07 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:35:32 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.FOR;7 0058 C furthest west node | days | km | 0059 C furthest east node | days | km | 0060 C final node | days | km | 0061 C |------|--------| 0062 C BNDFUZ DP 1 km when longitude targeting a ground track 0063 C to the west boundary, BNDFUZ is the 0064 C fuzziness of BOUNDS(1). In essence, if 0065 C ground is within BNDFUZ of BOUNDS(1), but 0066 C not beyond, then that is close enough. 0067 C TIMFUZ DP 1 days when time targeting a ground track 0068 C to the east or west boundary, TIMFUZ is 0069 C the fuzziness of TARGET. In essence, if 0070 C ground track is within TIMFUZ of the 0071 C target time, then that is close enough. 0072 C TARGET DP 1 --> boundary (in km) when STRAT='LONG' or 0073 C time (in days) when STRAT='EAST'/'WEST' 0074 C to which GTARG is trying to target the 0075 C ground track 0076 C 0077 C$ Output_Arguments 0078 C 0079 C Name Type Dim Units Description 0080 C ----------------------------------------------------------------------------- 0081 C SUCCES L 1 - true if ground track satisfies targeting 0082 C criteria 0083 C 0084 C$ Files 0085 C 0086 C File Name Unit Number Description 0087 C ----------------------------------------------------------------------------- 0088 C * * standardd I/O 0089 C OFILE 8 text output file 0090 C 0091 C$ Declarations_of_Input_and_Output_Arguments 0092 C 0093 DOUBLE PRECISION BNDFUZ 0094 INTEGER CLASS 0095 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0096 CHARACTER*6 STRAT 0097 LOGICAL SUCCES 0098 DOUBLE PRECISION TARGET 0099 DOUBLE PRECISION TIMFUZ 0100 C 0101 C$ Declarations_of_Local_Variables 0102 C 0103 DOUBLE PRECISION DT 0104 C 0105 C$ Method 0106 C-& 0107 0108 C1 Just assume success is false until proved otherwise. 0109 0110 SUCCES = .FALSE. 0111 0112 C1 Success is determined differently for different strategies. 0113 0114 IF ( STRAT .EQ. 'LONG' ) THEN CHKSUC 1-Jun-1993 15:33:07 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 19:35:32 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.FOR;7 0115 0116 C2 If employing the longitudinal targeting strategy to the west 0117 C2 boundary, check to see if the furthest west point of the ground 0118 C2 track is within BNDFUZ of the target boundary, but not beyond. 0119 0120 IF ( CLASS .EQ. 1 0121 & .AND. TARGET .LE. LIMITS(2,2) 0122 & .AND. LIMITS(2,2) .LE. ( TARGET + BNDFUZ ) 0123 & ) 0124 & SUCCES = .TRUE. 0125 0126 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 0127 0128 C2 If employing the time targeting to the east boundary, check to see 0129 C2 if the final point on the ground track arrives at the east boundary 0130 C2 at a time TIMFUZ within the TARGET time. 0131 0132 DT = DABS( TARGET - LIMITS(4,1) ) 0133 0134 IF ( ( CLASS .EQ. 1 0135 & .OR. CLASS .EQ. 2 0136 & ) 0137 & .AND. DT .LE. TIMFUZ 0138 & ) 0139 & SUCCES = .TRUE. 0140 0141 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 0142 0143 C2 If employing the time targeting to the west boundary, check to see 0144 C2 if the final point on the ground track arrives at the west boundary 0145 C2 at a time TIMFUZ within the TARGET time. 0146 0147 DT = DABS( TARGET - LIMITS(4,1) ) 0148 0149 IF ( ( CLASS .EQ. 4 0150 & .OR. CLASS .EQ. 5 0151 & ) 0152 & .AND. DT .LE. TIMFUZ 0153 & ) 0154 & SUCCES = .TRUE. 0155 0156 ELSE 0157 0158 C2 Otherwise, STRAT has an invlaid value. 0159 0160 WRITE(*,301) STRAT 0161 WRITE(8,301) STRAT 0162 301 FORMAT(/,1X,'GTARG: in SUCCES, STRAT("',A6,'") is invalid.') 0163 0164 STOP 0165 0166 END IF 0167 0168 C1 End of CHKSUC. 0169 0170 RETURN 0171 END CHKSUC 1-Jun-1993 15:33:07 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 19:35:32 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.FOR;7 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 254 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 61 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 28 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 343 ENTRY POINTS Address Type Name 0-00000000 CHKSUC VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000010@ R*8 BNDFUZ AP-00000008@ I*4 CLASS ** R*8 DT AP-00000004@ CHAR STRAT AP-0000001C@ L*4 SUCCES AP-00000018@ R*8 TARGET AP-00000014@ R*8 TIMFUZ ARRAYS Address Type Name Bytes Dimensions AP-0000000C@ R*8 LIMITS 64 (4, 2) LABELS Address Label 1-00000000 301' COMMAND QUALIFIERS FOR/LIS CHKSUC.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.OBJ;2 CHKSUC 1-Jun-1993 15:33:07 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 19:35:32 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CHKSUC.FOR;7 COMPILATION STATISTICS Run Time: 0.30 seconds Elapsed Time: 4.39 seconds Page Faults: 226 Dynamic Memory: 472 pages 1-Jun-1993 15:33:19 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:37:09 [SHAPIRO.COSMIC.SOURCE]CLEAR_SCREEN.FOR;3 0001 subroutine clear_screen 0002 common /tt/terminal 0003 character*12 terminal 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C This subroutine clears the screen 0014 C 0015 C******************************************************************************* 0016 C 0017 if (terminal .eq. 'VT100' ) then 0018 write (6,100) 27 0019 100 format(' ',a1,'[2J') 0020 end if 0021 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 54 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 20 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 3 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 86 ENTRY POINTS Address Type Name 0-00000000 CLEAR_SCREEN VARIABLES Address Type Name 3-00000000 CHAR TERMINAL LABELS Address Label 1-00000004 100' CLEAR_SCREEN 1-Jun-1993 15:33:19 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:37:09 [SHAPIRO.COSMIC.SOURCE]CLEAR_SCREEN.FOR;3 COMMAND QUALIFIERS FOR/LIS CLEAR_SCREEN.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CLEAR_SCREEN.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CLEAR_SCREEN.OBJ;2 COMPILATION STATISTICS Run Time: 0.28 seconds Elapsed Time: 3.25 seconds Page Faults: 251 Dynamic Memory: 456 pages 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 1 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0001 C$Procedure COMPGT 0002 C 0003 SUBROUTINE COMPGT ( ORBIN , DATIN , 0004 & M , 0005 & JEARTH, LTOP , LSFLAG , DRAG, 0006 & dsmadt, tsmaswitch, sigma_dsma, DRAGBIASMODE, 0007 & DAYS , BOUNDS , 0008 & ORBITS , XINGS , 0009 & WATCH, 0010 & DV_FIXED, DV_PROP, DA_OD, 0011 & SF_DVOD, SF_DRAG, SF_BOOST, 0012 & NDRAG_BIAS, DRAG_BIAS, DV, TARGET_STRAT, 0013 & BIAS_ODE, BIAS_DVE, BIAS_DRAGE, BIAS_BOOSTE, 0014 & BIAS_ODW, BIAS_DVW, BIAS_DRAGW, BIAS_BOOSTW, 0015 & ORBOUT , DATOUT , 0016 & LIMITS , LIMITS_WEST, LIMITS_EAST, 0017 & NPTS , TIMVEC , DGTVEC , 0018 & WESTVEC, EASTVEC, tmaneuver, betaprime, 0019 & norbits, GTLONG, NREV, bootdata, IPAGE 0020 & ) 0021 0022 C 0023 C 0024 C******************************************************************************* 0025 C 0026 C Copyright (C) 1993, California Institute of Technology. U.S. 0027 C Government Sponsorhip under NASA Contract NAS7-918 is 0028 C acknowledged. 0029 C 0030 C******************************************************************************* 0031 C 0032 C$ Log 0033 C 0034 C Date Name Description 0035 C ----------------------------------------------------------------------------- 0036 C 24-JUL-1990 Eric Cannell creation of COMPGT 0037 C 29-AUG-1991 Bruce Shapiro include targeting biases 0038 C 2-DEC-1992 Tabular output of ground track & elements. 0039 C 23-FEB-1993 Correct usage of hi/low drag errors in gt. 0040 C old way: take maximum of two ground 0041 C track diff, apply equally to 0042 C east and west 0043 C new way: apply hi drag error to east 0044 C lo drag error west 0045 C 0046 C$ Purpose 0047 C 0048 C COMPGT computes a ground track by determining the distance from a reference 0049 C ground track at ascending nodes. For computational expediency, the input 0050 C M allows COMPGT to examine every m-th ascending node (i.e., every 4th one). 0051 C 0052 C The computed ground track is either a particular number of days long 0053 C (DAYS>0) or terminates when it leaves the valid band. 0054 C 0055 C$ Input_Arguments 0056 C 0057 C Name Type Dim Units Description 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 2 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0058 C ----------------------------------------------------------------------------- 0059 C ORBIN DP 6 km,deg input orbit of (a,e,i,LAN,w,M) 0060 C DATIN C*25 1 --> input epoch of ORBIT in TIMETRANS format 0061 C 'dd-mmm-yyyy hh:mm:ss.fff 0062 C M I 1 - forces COMPGT to examine every M-th 0063 C ascending node. For example, one hopes 0064 C that M=4 is a lot faster computationally 0065 C and almost as accurate as M=1. 0066 C LTOP I 1 - the maximum L index to consider in LSRGP's 0067 C Earth gravity model (i.e., LTOP=17 means 0068 C model up to J17). 0069 C LSFLAG L 1 - if true, luni-solar effects are ON in the 0070 C LSRGP library 0071 C DRAG L 1 - if true, atmospheric drag effects are ON 0072 C in the PROP subroutine. Note that only 0073 C drag can affect semi-major axis. 0074 C dsmadt R*8 2 m/day extra (d/dt) on SMA 0075 C tsmaswitch R*8 A secon6s time to switch between dsmadt values 0076 C sigma_dsma r*8 2 sigmas in dsmadt 0077 C DRAGBIASMODE C*4 1 - 'FLUX' or 'GT' - use flux biases or 0078 C use table of GT biases to compute 0079 C the component of ground track error 0080 C which is due to sf/geomag data errors 0081 C DAYS I 1 days if DAYS>0, the ground track is run out 0082 C DAYS days, regardless of whether or not 0083 C the ground lies within or without the 0084 C valid band defined by BOUNDS. 0085 C if DAYS=<0, the ground track is run out 0086 C until it leaves the valid band as defined 0087 C by input BOUNDS. However, if a ground 0088 C track lies completely outside of the valid 0089 C band, COMPGT will terminate the track after 0090 C TOLONG days. 0091 C BOUNDS DP 2 km the low and high boundaries (in that order) 0092 C of the valid ground track band as measured 0093 C from the reference ground track. Usually, 0094 C BOUNDS will be something like -/+ 1 km. 0095 C But, BOUNDS could be (.5,1.5), i.e., fully 0096 C right of the reference ground track. 0097 C BOUNDS is used only when DAYS=<0. 0098 C ORBITS I 1 - number of equator crossings XINGS 0099 C XINGS DP ORBITS deg reference equator crossings from REF_EQXING 0100 C JEARTH DP (2:29) - earth field zonal coefficients J2, J3, ... 0101 C WATCH L 1 - watch the nodes as they are being calculated 0102 C DV_FIXED, DP 1 mm/sec Fixed error 0103 C DV_PROP, DP 1 - Proportional error, proportion of dv 0104 C DA_OD, DP 1 m od error in a 0105 C SF_DVOD, DP 1 - scale factor for gt bias (DV & OD biases) 0106 C SF_DRAG, DP 1 - scale factor for gt bias (drag biases) 0107 C SF_BOOST DP 1 - scale factor for gt bias (boost ) 0108 C NDRAG_BIAS, I 1 - number of drag bias points 0109 C DRAG_BIAS, DP NDRAG_BIAS km bias in gt due to drag 0110 C DV DP 1 mm/sec the actual delta-v (used for proportional 0111 C error 0112 C TARGET_STRAT c*8 1 'UNBIASED', 'WESTGT', 'EASTGT' 0113 C BIAS_OD r MXNODES biases for od 0114 C BIAS_DV for dv 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 3 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0115 C BIAS_FLUX for flux 0116 C IPAGE I PAGE NUMBER 0117 C 0118 C$ Output_Arguments 0119 C 0120 C Name Type Dim Units Description 0121 C ----------------------------------------------------------------------------- 0122 C ORBOUT DP 6 km,deg final orbit of (a,e,i,LAN,w,M) 0123 C DATOUT C*25 1 --> final epoch of ORBOUT in TIMETRANS format 0124 C 'dd-mmm-yyyy hh:mm:ss.fff 0125 C LIMITS DP 4,2 days,km with regard to ascending nodes, the 0126 C time (in days) and ground track offset 0127 C (in km) of the first node, the furthest 0128 C west node, the furthest east node, and 0129 C the last node of the ground track. LIMITS 0130 C allows GTARG to classify the ground track. 0131 C time offset 0132 C |------|--------| 0133 C first node | days | km | 0134 C furthest west node | days | km | 0135 C furthest east node | days | km | 0136 C final node | days | km | 0137 C |------|--------| 0138 C LIMITS_WEST DP 4,2 days,km same as LIMITS, but applies to 95 pctle 0139 C LIMITS_EAST DP 4,2 (or whatever maximum bias is used) 0140 C westernmost ground track. 0141 C NPTS I 1 - number of data points TIMVEC and DGTVEC 0142 C TIMVEC RL MXNODE days time in days of each nodes examined, used 0143 C in plotting 0144 C DGTVEC RL MXNODE km ground offset from reference track of 0145 C each node examined, used for plotting 0146 C WESTVEC RL MXNODE KM same as dgtvec, for WEST 95 pctl 0147 C EASTVEC RL MXNODE km same as dgtvec, for EAST 95 pctl 0148 C TMANEUVER DP 3 days time to subsequent maneuver (works 0149 C correctly for LONG targeting) 0150 C 1 = west, 2 = unbiased, 3 = east 0151 C BETAPrime DP 1 deg Beta Prime angle at DATIN 0152 C norbits i 3 - # of orbits until next maneuver 0153 C (1)=west; (2)=unbiasd; (3)=east 0154 C 0155 C$ Restrictions 0156 C 0157 C 1] Note that if DAYS=<0 and a ground track lies completely outside of the 0158 C valid band, then COMPGT will only run out that ground track for TOLONG 0159 C days. 0160 C 0161 C$ Library_Links 0162 C 0163 C Entry Point Name Location 0164 C ----------------------------------------------------------------------------- 0165 C CH2JD TIMETRANS 0166 C DCLOSE TPXUTIL 0167 C DVMOVE TPXUTIL 0168 C MNODES GTARG 0169 C SIDANG TPXORB 0170 C 0171 C$ Global/Common Stuff 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 4 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0172 C 0173 double precision RE ! in kilomters 0174 double precision earth_freq ! radians / second 0175 double precision WEARTH ! meters / day 0176 double precision mu_earth ! km**3/sec 0177 double precision mu_moon ! km**3/sec 0178 double precision mu_sun ! km**3/sec 0179 double precision sid_day ! seconds 0180 double precision DEG2KM ! kilometers/deg 0181 double precision flat 0182 0183 common / physical_constants / 0184 & RE, earth_freq, WEARTH, mu_earth, 0185 & mu_moon, mu_sun, sid_day, DEG2KM, flat 0186 0187 common / tt / terminal 0188 character*12 terminal 0189 0190 C$ Parameters 0191 C 0192 logical trace 0193 parameter ( trace = .false. ) 0194 logical trace_Site, trace_overflights 0195 parameter ( trace_site = .FALSE. ) 0196 parameter ( trace_overflights = .false. ) 0197 0198 INTEGER MXNODE 0199 PARAMETER ( MXNODE = 20000 ) 0200 0201 DOUBLE PRECISION TOLONG 0202 PARAMETER ( TOLONG = 15D0 ) 0203 0204 character*4 hi 0205 parameter (hi = 'HI') 0206 character*4 lo 0207 parameter (lo = 'LO') 0208 0209 DOUBLE PRECISION PI 0210 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0211 DOUBLE PRECISION TWOPI 0212 PARAMETER ( TWOPI = 2*PI ) 0213 0214 C DOUBLE PRECISION RE 0215 C PARAMETER ( RE = 6378.14D0 ) 0216 0217 C DOUBLE PRECISION DEG2KM 0218 C PARAMETER ( DEG2KM = PI * RE / 180D0 ) 0219 0220 C DOUBLE PRECISION WEARTH 0221 C PARAMETER ( WEARTH = 2*PI*RE*86400000.0/86164.0) 0222 0223 0224 C DOUBLE PRECISION MU 0225 C PARAMETER ( MU = 3.9860044807345D14 ) 0226 C 0227 C$ Declarations_of_Input_and_Output_Arguments 0228 C COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 5 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0229 DOUBLE PRECISION BETAP, betaprime 0230 DOUBLE PRECISION BOUNDS ( 2 ) 0231 CHARACTER*25 DATIN 0232 CHARACTER*25 DATOUT 0233 INTEGER DAYS 0234 DOUBLE PRECISION DGTVEC ( MXNODE ) 0235 character*4 dragbiasmode 0236 double precision dsmadt(2), tsmaswitch, sigma_dsma(2) 0237 DOUBLE PRECISION EASTVEC ( MXNODE ) 0238 DOUBLE PRECISION WESTVEC ( MXNODE ) 0239 REAL BIAS_ODE ( MXNODE ), BIAS_BOOSTE(MXNODE) 0240 REAL BIAS_DVE ( MXNODE ) 0241 REAL BIAS_DRAGE ( MXNODE ) 0242 REAL BIAS_ODW ( MXNODE ), BIAS_BOOSTW(MXNODE) 0243 REAL BIAS_DVW ( MXNODE ) 0244 REAL BIAS_DRAGW ( MXNODE ) 0245 LOGICAL DRAG 0246 INTEGER IPAGE 0247 double precision jearth ( 2:29 ) 0248 double precision gtlong (MXNODE) 0249 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0250 DOUBLE PRECISION LIMITS_WEST ( 4, 2 ) 0251 DOUBLE PRECISION LIMITS_EAST ( 4, 2 ) 0252 LOGICAL LSFLAG 0253 INTEGER LTOP 0254 INTEGER M 0255 integer norbits ( 3 ) 0256 INTEGER NPTS 0257 DOUBLE PRECISION ORBIN ( 6 ) 0258 INTEGER ORBITS 0259 DOUBLE PRECISION ORBOUT ( 6 ) 0260 integer nrev ( MXNODE ) 0261 DOUBLE PRECISION TIMVEC ( MXNODE ) 0262 DOUBLE PRECISION TMANEUVER ( 3 ) 0263 DOUBLE PRECISION XINGS ( ORBITS ) 0264 LOGICAL watch 0265 DOUBLE PRECISION DV_FIXED 0266 DOUBLE PRECISION DV_PROP 0267 DOUBLE PRECISION DA_OD 0268 DOUBLE PRECISION SF_DVOD, SF_DRAG, SF_BOOST 0269 INTEGER NDRAG_BIAS 0270 DOUBLE PRECISION DRAG_BIAS ( NDRAG_BIAS ) 0271 DOUBLE PRECISION DV 0272 character*8 target_strat 0273 logical fluxbias 0274 double precision bootdata(mxnode, 6) 0275 C 0276 C 0277 common /boost/ ndsmadt_data, dsmadt_data, dsmadt_epoch, 0278 & dsmadt_data_sigma, plot_boost, 0279 & DSMADT_DATES, XDSMADT_DATES, DSMADT_SIGMAS 0280 double precision dsmadt_data(1000) 0281 double precision dsmadt_data_sigma, dsmadt_epochjd 0282 DOUBLE PRECISION DSMADT_SIGMAS(1000), XDSMADT_DATES(1000) 0283 character*25 dsmadt_epoch, DSMADT_DATES(1000) 0284 integer ndsmadt_data 0285 logical plot_boost COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 6 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0286 0287 common /error_flags/ quad_err_boost, quad_err_drag 0288 logical quad_err_boost, quad_err_drag 0289 0290 double precision da_boost 0291 double precision xt1, xt2, y1, y2 0292 INTEGER FINDDATE 0293 EXTERNAL FINDDATE 0294 0295 integer mx_sites, mx_overflights 0296 parameter (mx_sites = 10) 0297 parameter (mx_overflights = 100) 0298 0299 common /site_data/ NSITES, SITE_LOC, SITE_NODE, SITE_GCLAT, 0300 & SITE_NAME, site_STRAT, overflights, noverflights 0301 integer nsites, site_node(mx_sites), noverflights(MX_SITES) 0302 double precision site_loc(2,mx_sites), site_gclat(Mx_sites) 0303 double precision overflights(mx_sites, mx_overflights, 5) 0304 C 0305 C overflights(site #, j, 1) = time 0306 C 2) = offset, km 0307 C 3) = geodetic latitude 0308 C 4) = longitude 0309 C 5) = node number 0310 C 0311 character*10 site_name(mx_sites), site_STRAT*6 0312 0313 C 0314 C$ Declarations_of_Local_Variables 0315 C 0316 0317 CHARACTER*25 DATLST, datlsthi, datlstlo 0318 CHARACTER*25 DATNOW, datnowhi, datnowlo 0319 DOUBLE PRECISION DGT, DGTWest, DGTEast, DGTHI, DGTLO 0320 double precision dgthi_used, dgtlo_used 0321 double precision DGTHI_LAST, DGTLO_LAST 0322 DOUBLE PRECISION DIFF, DIFFHI, DIFFLO 0323 DOUBLE PRECISION ECL, ECLHI, ECLLO 0324 LOGICAL ERROR, FIRSTTIME 0325 INTEGER IDX, itdays, itdayslast 0326 DOUBLE PRECISION JDLST, JDLSTHI, JDLSTLO 0327 DOUBLE PRECISION JDNOW, JDNOWHI, JDNOWLO 0328 DOUBLE PRECISION MU 0329 DOUBLE PRECISION ORBLST ( 6 ), ORBLSTHI (6), orblstlo(6) 0330 DOUBLE PRECISION ORBNOW ( 6 ), ORBNOWHI(6), orbnowLO(6) 0331 DOUBLE PRECISION ORBINHI( 6 ), ORBINLO (6) 0332 DOUBLE PRECISION CARSITE(6), orbsite(6) 0333 INTEGER REFIDX, REFIDXHI, REFIDXLO 0334 DOUBLE PRECISION TDAYS, TDAYSHI, TDAYSLO 0335 DOUBLE PRECISION TDAYSHI_LAST,TDAYSLO_LAST 0336 DOUBLE PRECISION TSTOP 0337 LOGICAL WASIN 0338 LOGICAL WASIN_EAST 0339 LOGICAL WASIN_WEST 0340 LOGICAL WASIN_UNBIASED 0341 DOUBLE PRECISION VEL 0342 DOUBLE PRECISION partial_dgtdv, partial_dgtda_boost COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 7 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0343 DOUBLE PRECISION partial_dgtda 0344 DOUBLE PRECISION DV_ERROR 0345 DOUBLE PRECISION GT_ERROR, PERIOD, GT_ERROR_EAST 0346 DOUBLE PRECISION GT_ERROR_WEST, PERIOD_DAYS 0347 DOUBLE PRECISION GTE_DV, GTE_OD, GTE_DRAG, GTE_BOOST 0348 DOUBLE PRECISION GTE_BOOST_ENV 0349 DOUBLE PRECISION GTE_BOOST_OLD 0350 LOGICAL GTE_BOOST_ARRAY 0351 DOUBLE PRECISION alpha_BOOST, alpha_BOOST_OLD 0352 double precision delta_boost, delta_boost_old 0353 DOUBLE PRECISION GAMMA_BOOST, GAMMA_BOOST_OLD 0354 double precision beta_boost, beta_star 0355 DOUBLE PRECISION GTE_DRAG_HI, GTE_DRAG_LO 0356 DOUBLE PRECISION old_GTE_DRAG_HI, old_GTE_DRAG_LO 0357 DOUBLE PRECISION delta_GTE_DRAG_HI, delta_GTE_DRAG_LO 0358 DOUBLE PRECISION optimistic_GTE_DRAG_HI 0359 DOUBLE PRECISION optimistic_GTE_DRAG_LO 0360 DOUBLE PRECISION GTE_DVOD, GTE_DRAG_EAST, GET_DRAG_WEST 0361 0362 double precision secnow, xtsite, xtsite1, xtsite2 0363 character*25 tsite, tsite1, tsite2 0364 double Precision sinDtheta, cosdtheta, dtheta, cosB 0365 double precision sinl,sini,GTES_A, GTES_B, GTES_D, GTES 0366 double Precision cosl, sitelong, sitelat,NuNode,NuSite 0367 double Precision EASite, MASite, SinEASite, CosEASite 0368 double Precision cosNuSite, SinNuSite,TOF, MEANMOTION 0369 double Precision EarthShift, NODESHIFT, DeltaNJ2, GTES_DD 0370 double Precision SatLongitude, SatGDLat, SatGCLat 0371 double precision ErrGDLat, SatLongitude1, SatLongitude2 0372 double Precision SatGDLat1, SatGDLat2, SatGCLat1, SatGCLat2 0373 double Precision TOF1, TOF2, ErrLimit 0374 logical ODD,ONEOK, CLOSE, NEW 0375 0376 C 0377 C$ External_Statements 0378 C 0379 DOUBLE PRECISION CH2JD, ch2sec 0380 character *25 sec2ch 0381 EXTERNAL CH2JD, ch2sec, sec2ch 0382 0383 INTEGER DCLOSE 0384 EXTERNAL DCLOSE 0385 0386 DOUBLE PRECISION RNG360 0387 EXTERNAL RNG360 0388 0389 DOUBLE PRECISION SIDANG 0390 EXTERNAL SIDANG 0391 0392 character*8 goto_string 0393 external goto_string 0394 0395 data firsttime /.true./ 0396 C 0397 C$ Method 0398 C-& 0399 C write(8,*) 'COMPGT:ORBIN=',orbin COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 8 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0400 0401 fluxbias = ( (dragbiasmode .eq. 'FLUX' ) .or. 0402 & (dragbiasmode .eq. 'flux' ) ) 0403 0404 C convert mu from km**3/sec to m**3/second 0405 0406 mu = 1.0e9 * mu_earth 0407 C write(8,*) 'COMPGT:MU=',MU 0408 C 0409 do k = 1, 3 0410 tmaneuver (k) = 0.0 0411 norbits(k) = 0 0412 end do 0413 0414 C 0415 0416 0417 C write(8,*) 'COMPGT:ORBIN=',orbin 0418 C write(8,*) 'COMPGT:MU=',MU 0419 vel = sqrt ( MU / (1000.0 * orbin(1)) ) * 1000.0 0420 C 0421 C period in seconds 0422 C 0423 period = SQRT ( orbin(1)**3 / MU_EARTH ) * 2 * PI 0424 PERIOD_DAYS = PERIOD/86400.0D0 0425 0426 0427 C 0428 C time independent part of partials (these are not the 0429 C complete partials, only the coefficients that are time 0430 C independent) 0431 C 0432 partial_dGTdv = -3 * WEARTH / vel 0433 partial_dGTda = 1.5 * WEARTH / (1000.0 * orbin(1)) 0434 partial_dGTda_boost = 0.5 * partial_dGTda 0435 C 0436 C sigma in boost in sma in meters/orbit 0437 C 0438 da_boost = dsmadt_data_sigma * period / 86400.0d0 0439 0440 C write(8,*) 'da_boost=',da_boost 0441 C write(8,*) 'partial_dgtda_boost=',partial_dgtda_boost 0442 0443 GTE_DRAG_HI = 0.0 0444 GTE_DRAG_LO = 0.0 0445 OPTIMISTIC_GTE_DRAG_HI = 0.0 0446 OPTIMISTIC_GTE_DRAG_LO = 0.0 0447 C 0448 C INITIALIZE BOOST ERROR MODEL 0449 C 0450 GTE_BOOST_ARRAY = ( DSMADT_DATA_SIGMA.LT.0D0 ) 0451 0452 ALPHA_BOOST = 0.0 0453 BETA_STAR = PERIOD_DAYS**2 * (4.0/3.0) * 0454 & ( DBLE(REAL(M*M)) - 0.375 * DBLE(REAL(M)) + 0.125 ) 0455 DELTA_BOOST = 0.0 0456 GAMMA_BOOST = 0.0 COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 9 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0457 ALPHA_BOOST_OLD = 0.0 0458 DELTA_BOOST_OLD = 0.0 0459 GAMMA_BOOST_OLD = 0.0 0460 GTE_BOOST = 0.0 0461 MMPRIME = M * (M-1) 0462 MPRIME = M * (M+2) 0463 C 0464 C compute total delta-v error 0465 C 0466 if ( dabs(dv) .gt. 1.0D-6) then 0467 dv_error = sqrt ( dv_fixed**2 + (dv_prop * dv)**2 ) 0468 else 0469 dv_error = 0.0d0 0470 end if 0471 C 0472 C print a header to the screen 0473 C 0474 if ( watch .and. TERMINAL.eq.'VT100' ) then 0475 write (6,102) goto_string (14,55),'Days' 0476 write (6,1101) goto_string (15,1),'West' 0477 write (6,1101) goto_string (16,1),' GT' 0478 write (6,1101) goto_string (17,1),'East' 0479 0480 write (6,102) goto_string (15,25),'a' 0481 write (6,102) goto_string (16,25),'e' 0482 write (6,102) goto_string (17,25),'i' 0483 write (6,102) goto_string (15,55),'RAAN' 0484 write (6,102) goto_string (16,55),'AOP' 0485 write (6,102) goto_string (17,55),'M' 0486 0487 1101 format(' ',A8,A4) 0488 102 format(' ',A8,A4) 0489 0490 end if 0491 0492 C1 Set data arrays to zero for TGTGT. 0493 0494 DO 101 IDX = 1 , MXNODE 0495 TIMVEC( IDX ) = 0.0D0 0496 DGTVEC( IDX ) = 0.0D0 0497 EASTVEC ( IDX ) = 0.0D0 0498 WESTVEC ( IDX ) = 0.0D0 0499 101 CONTINUE 0500 0501 C1 Determine the time to stop. Either TSTOP is DAYS when DAYS > 0 or 0502 C1 TOLONG in case ground is completely outside of valid band. Basically, 0503 C1 a ground track outside of the valid band is not of much use, so there 0504 C1 is no point in running it out for a long period of time. 0505 0506 IF ( DAYS .GT. 0 ) THEN 0507 0508 TSTOP = DAYS 0509 0510 ELSE 0511 0512 TSTOP = TOLONG 0513 COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 10 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0514 END IF 0515 0516 C1 Take the first step to the first M-th ascending node. 0517 0518 if (fluxbias ) then 0519 call dvmove ( 6, orbin, orbinhi ) 0520 call dvmove ( 6, orbin, orbinlo ) 0521 end if 0522 0523 CALL MNODES( ORBIN , DATIN , M , JEARTH, LTOP , 0524 & LSFLAG , DRAG , dsmadt, tsmaswitch, 0525 & sigma_dsma, 0526 & 'TRUE', ORBNOW , DATNOW , 0527 & betaprime ) 0528 0529 do i=1,6 0530 bootdata(1, i) = orbnow(i) 0531 end do 0532 0533 C write(8,*) 'COMPGT:betaprime=',betaprime 0534 0535 if ( fluxbias ) then 0536 CALL MNODES( ORBINHI, DATIN , M , JEARTH, LTOP , 0537 & LSFLAG , DRAG, dsmadt, tsmaswitch, sigma_dsma, 0538 & HI, ORBNOWHI , DATNOWHI, betap ) 0539 CALL MNODES( ORBINLO, DATIN , M , JEARTH, LTOP , 0540 & LSFLAG, DRAG, dsmadt, tsmaswitch, sigma_dsma, 0541 & LO, ORBNOWLO , DATNOWLO, betap ) 0542 end if 0543 0544 if ( trace ) then 0545 write (50,*) 'COMPGT *** True:', orbin, datin, orbnow, datnow 0546 write (50,*) 'COMPGT *** Hi :', orbinhi, datin, orbnowhi, 0547 * datnowhi 0548 write (50,*) 'COMPGT *** Lo :', orbinlo, datin, orbnowlo, 0549 * datnowlo 0550 end if 0551 0552 C1 Compute the equator crossing longitude of this node. Since LAN 0553 C1 equals right ascension at this point, longitude is LAN - sidereal 0554 C1 angle of Greenwich. 0555 0556 ECL = RNG360( ORBNOW(4) - SIDANG( DATNOW , 0D0 ) ) 0557 0558 if (fluxbias) then 0559 ECLHI = RNG360( ORBNOWHI(4) - SIDANG( DATNOWHI , 0D0 ) ) 0560 ECLLO = RNG360( ORBNOWLO(4) - SIDANG( DATNOWLO , 0D0 ) ) 0561 end if 0562 0563 0564 C1 Determine the index of the reference equator crossing longitude 0565 C1 that closest matches the crossing longitude of this first node. 0566 0567 REFIDX = DCLOSE( ECL , ORBITS , XINGS ) 0568 if (fluxbias) then 0569 REFIDXHI = DCLOSE( ECLHI , ORBITS , XINGS ) 0570 REFIDXLO = DCLOSE( ECLLO , ORBITS , XINGS ) COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 11 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0571 end if 0572 0573 C1 Compute the difference between the actual and reference equatorial 0574 C1 crossing longitude and then update the reference index. 0575 0576 DIFF = ECL - XINGS( REFIDX ) 0577 GTLONG(1) = ECL 0578 NREV(1) = REFIDX 0579 0580 if (fluxbias ) then 0581 DIFFHI = ECLHI - XINGS( REFIDXHI ) 0582 DIFFLO = ECLLO - XINGS( REFIDXLO ) 0583 end if 0584 0585 IF ( DIFF .GT. 180D0 ) THEN 0586 DIFF = DIFF - 360D0 0587 ELSE IF ( DIFF .LT.-180D0 ) THEN 0588 DIFF = DIFF + 360D0 0589 END IF 0590 0591 if (fluxbias) then 0592 IF ( DIFFHI .GT. 180D0 ) THEN 0593 DIFFHI = DIFFHI - 360D0 0594 ELSE IF ( DIFFHI .LT.-180D0 ) THEN 0595 DIFFHI = DIFFHI + 360D0 0596 END IF 0597 IF ( DIFFLO .GT. 180D0 ) THEN 0598 DIFFLO = DIFFLO - 360D0 0599 ELSE IF ( DIFFLO .LT.-180D0 ) THEN 0600 DIFFLO = DIFFLO + 360D0 0601 END IF 0602 end if 0603 0604 if (trace) then 0605 write (50,*) 'COMPGT ECL,HI,LO',ECL,ECLHI,ECLLO 0606 write (50,*) 'COMPGT IDX,HI,LO',REFIDX,REFIDXHI,REFIDXLO 0607 write (50,*) 'COMPGT DIF,HI,LO',DIFF,DIFFHI,DIFFLO 0608 end if 0609 0610 REFIDX = REFIDX + M 0611 IF ( REFIDX .GT. ORBITS ) REFIDX = REFIDX - ORBITS 0612 0613 if (fluxbias) then 0614 REFIDXHI = REFIDXHI + M 0615 IF ( REFIDXHI .GT. ORBITS ) REFIDXHI = REFIDXHI - ORBITS 0616 REFIDXLO = REFIDXLO + M 0617 IF ( REFIDXLO .GT. ORBITS ) REFIDXLO = REFIDXLO - ORBITS 0618 end if 0619 0620 C1 Convert the difference to kilometers. 0621 0622 DGT = DIFF * DEG2KM 0623 if (fluxbias) then 0624 DGTHI = DIFFHI * DEG2KM 0625 DGTLO = DIFFLO * DEG2KM 0626 end if 0627 COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 12 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0628 if (trace) then 0629 write(50,*) 'COMPGT DGT,HI,LO:',DGT,DGTHI,DGTLO 0630 end if 0631 0632 C1 Compute the time in days of this ascending node. 0633 0634 JDLST = CH2JD( DATIN , .TRUE. , ERROR ) 0635 JDNOW = CH2JD( DATNOW , .TRUE. , ERROR ) 0636 TDAYS = JDNOW - JDLST 0637 0638 if (fluxbias) then 0639 JDLSTHI = JDLST 0640 JDLSTLO = JDLST 0641 JDNOWHI = CH2JD( DATNOWHI , .TRUE. , ERROR ) 0642 JDNOWLO = CH2JD( DATNOWLO , .TRUE. , ERROR ) 0643 TDAYSHI = JDNOWHI - JDLSTHI 0644 TDAYSLO = JDNOWLO - JDLSTLO 0645 itdays = int(tdays) 0646 end if 0647 0648 C1 Store the time and offset of this first node. Also, this only node 0649 C1 is the furthest west and east. 0650 0651 LIMITS(1,1) = TDAYS 0652 LIMITS(1,2) = DGT 0653 0654 LIMITS(2,1) = TDAYS 0655 LIMITS(2,2) = DGT 0656 0657 LIMITS(3,1) = TDAYS 0658 LIMITS(3,2) = DGT 0659 0660 TIMVEC(1) = TDAYS 0661 DGTVEC(1) = DGT 0662 0663 0664 GTE_DV = 0.001 * SF_DVOD * partial_dGTdV * DV_ERROR * TDAYS 0665 GTE_OD = 0.001 * SF_DVOD * partial_dGTda * DA_OD * TDAYS 0666 0667 IF (GTE_BOOST_ARRAY) THEN 0668 C 0669 C INSERT CODE HERE TO OBTAIN DA_BOOST FROM THE APPROPRIATE 0670 C DATA ARRAY, DSMADT_SIGMAS(I) 0671 C DA_BOOST = DATA FROM ARRAY * PERIOD * M / 86400.0 0672 C 0673 C NEED ALSO TO INCORPORATE SCALE FACTOR INTO EQUATIONS 0674 0675 IF (DSMADT_EPOCH .EQ. ' ') then 0676 IDATE = finddate ( DATNOW, .FALSE., DSMADT_dates, 0677 & XDSMADT_DATES, nDSMADT_DATA ) 0678 IF (IDATE .LT. 1 .OR. IDATE .GE. NDSMADT_DATA) THEN 0679 WRITE(8,*) 'Time ', datnow,' is out of range of ', 0680 & ' Boost Sigma Array.' 0681 DA_BOOST = 0.0D0 0682 ELSE 0683 XT1 = XDSMADT_DATES(IDATE) 0684 XT2 = XDSMADT_DATES(IDATE+1) COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 13 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0685 Y1 = dsmadt_sigmas(IDATE) 0686 Y2 = dsmadt_sigmas(IDATE+1) 0687 da_boost = y1 + 0688 & (CH2SEC(DATNOW,.TRUE., ERROR) - XT1) 0689 & * ( (y2-y1)/(XT1-XT2) ) 0690 da_boost = da_boost * PERIOD_DAYS 0691 END IF 0692 ELSE 0693 dsmadt_epoochjd = ch2jd ( dsmadt_epoch, .true., ERROR) 0694 IDATE = jdnow - dsmadt_epochjd 0695 IF (IDATE .LT. 1 .OR. IDATE .GE. NDSMADT_DATA) THEN 0696 WRITE(8,*) 'Time ', datnow,' is out of range of ', 0697 & ' Boost Sigma Array.' 0698 DA_BOOST = 0.0D0 0699 ELSE 0700 da_boost = DSMADT_SIGMAS(IDATE) 0701 da_boost = da_boost * M * PERIOD_DAYS 0702 END IF 0703 END IF 0704 0705 GTE_BOOST_OLD = GTE_BOOST 0706 IF (QUAD_ERR_BOOST) THEN 0707 ALPHA_BOOST_OLD = ALPHA_BOOST 0708 GAMMA_BOOST_OLD = GAMMA_BOOST 0709 ALPHA_BOOST = ALPHA_BOOST_OLD + 0710 & m * (PERIOD_DAYS**2) * (DA_BOOST**2) 0711 GAMMA_BOOST = 2.0*m*ALPHA_BOOST_OLD + GAMMA_BOOST_OLD 0712 & + MMPRIME * (PERIOD_DAYS**2) * (DA_BOOST**2) 0713 BETA_BOOST = BETA_STAR * (DA_BOOST**2) 0714 GTE_BOOST = SQRT( GTE_BOOST_OLD**2 0715 & + ( PARTIAL_DGTDA**2 ) 0716 & * ( MPRIME * ALPHA_BOOST_OLD + 0717 & M * GAMMA_BOOST_OLD + BETA_BOOST ) ) 0718 C write(8,*) 'm=',m 0719 C write(8,*) 'ALPHA_BOOST_OLD=',ALPHA_BOOST_OLD 0720 C write(8,*) 'PERIOD_DAY =',PERIOD_DAYS 0721 C write(8,*) 'PERIOD_DAYS**2 =',PERIOD_DAYS**2 0722 C write(8,*) 'DA_BOOST =',DA_BOOST 0723 C write(8,*) 'DA_BOOST**2 = ',DA_BOOST**2 0724 C write(8,*) 'M*T^2*DA^2 =', 0725 C & m * (PERIOD_DAYS**2) * (DA_BOOST**2) 0726 C write(8,*) 'ALPHA_BOOST =',ALPHA_BOOST 0727 ELSE 0728 DELTA_BOOST_OLD = DELTA_BOOST 0729 DELTA_BOOST = DELTA_BOOST_OLD + 0730 & M * M * PERIOD_DAYS * 0731 & PARTIAL_DGTDA * DA_BOOST 0732 GTE_BOOST = GTE_BOOST_OLD + DELTA_BOOST_OLD + 0733 & PARTIAL_DGTDA * PERIOD_DAYS * DA_BOOST * 0734 & 0.5 * mmprime 0735 END IF 0736 ELSE 0737 if (quad_err_boost) then 0738 GTE_BOOST = partial_dgtda_boost * 0739 & da_boost * 0740 & sqrt (2.0d0/3.0d0) * 0741 & sqrt ( ( tdays * 86400.0 / period) * COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 14 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0742 & ( tdays - PERIOD/86400.0) * 0743 & ( 2*tdays - PERIOD/86400.0) ) 0744 else 0745 GTE_BOOST = partial_dgtda_boost * 0746 & da_boost * 0747 & tdays * (1 + tdays * 86400.0 / PERIOD ) 0748 end if 0749 END IF 0750 0751 GTE_BOOST_ENV = 0.001 * SF_BOOST * GTE_BOOST 0752 0753 GTE_DVOD = sqrt ( GTE_DV**2 + GTE_OD**2 ) 0754 0755 if (fluxbias) then 0756 gte_drag = 0 0757 if (itdays.gt.0) 0758 & drag_bias(ITDAYS) = gte_drag 0759 itdayslast = itdays 0760 C if (itdays .eq. 0 ) write(8,*) 'ITDAYS = 0!!!' 0761 else 0762 call interp_drag_bias (tdays, drag_bias, ndrag_bias, gte_drag ) 0763 end if 0764 0765 GT_ERROR = sqrt ( GTE_DVOD**2 + GTE_DRAG**2 + GTE_BOOST_ENV**2) 0766 0767 DGTWest = DGT - GT_ERROR 0768 DGTEast = DGT + GT_ERROR 0769 0770 EASTVEC( 1 ) = DGTEast 0771 WESTVEC( 1 ) = DGTWest 0772 0773 BIAS_ODE( 1 ) = SNGL ( DGT+abs(GTE_OD) ) 0774 BIAS_DVE( 1 ) = SNGL ( DGT+abs(GTE_DV) ) 0775 BIAS_DRAGE( 1 ) = SNGL ( DGT+abs(GTE_DRAG) ) 0776 BIAS_BOOSTE(1) = SNGL ( DGT+ABS(GTE_BOOST_ENV)) 0777 0778 BIAS_ODW( 1 ) = SNGL ( DGT-abs(GTE_OD) ) 0779 BIAS_DVW( 1 ) = SNGL ( DGT-abs(GTE_DV) ) 0780 BIAS_DRAGW( 1 ) = SNGL ( DGT-abs(GTE_DRAG) ) 0781 BIAS_BOOSTW(1) = SNGL ( DGT- ABS(GTE_BOOST_ENV)) 0782 0783 LIMITS_WEST(1,1) = TDAYS 0784 LIMITS_WEST(1,2) = DGT 0785 0786 LIMITS_WEST(2,1) = TDAYS 0787 LIMITS_WEST(2,2) = DGT 0788 0789 LIMITS_WEST(3,1) = TDAYS 0790 LIMITS_WEST(3,2) = DGT 0791 0792 LIMITS_EAST(1,1) = TDAYS 0793 LIMITS_EAST(1,2) = DGT 0794 0795 LIMITS_EAST(2,1) = TDAYS 0796 LIMITS_EAST(2,2) = DGT 0797 0798 LIMITS_EAST(3,1) = TDAYS COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 15 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0799 LIMITS_EAST(3,2) = DGT 0800 0801 C1 Determine if this first node was in or out of the valid band. 0802 0803 IF ( BOUNDS(1) .LT. DGT .AND. DGT .LT. BOUNDS(2) ) THEN 0804 WASIN = .TRUE. 0805 WASIN_EAST = .TRUE. 0806 WASIN_WEST = .TRUE. 0807 WASIN_UNBIASED = .TRUE. 0808 ELSE 0809 WASIN = .FALSE. 0810 WASIN_EAST = .FALSE. 0811 WASIN_WEST = .FALSE. 0812 WASIN_UNBIASED = .FALSE. 0813 END IF 0814 0815 0816 C1 Continue stepping from M-th ascending node to M-th ascending node 0817 C1 until stopping criteria is reached. 0818 0819 NPTS = 1 0820 0821 C1 Do... 0822 0823 901 CONTINUE 0824 0825 C2 Check that data arrays are not filled. 0826 0827 NPTS = NPTS + 1 0828 0829 IF ( NPTS .GT. MXNODE ) THEN 0830 0831 WRITE(*,301) 0832 WRITE(8,301) 0833 301 FORMAT(/,1X,'GTARG: COMPGT has filled its data arrays.') 0834 0835 STOP 0836 0837 END IF 0838 0839 C2 Save the last orbit and dates. 0840 0841 CALL DVMOVE( 6 , ORBNOW , ORBLST ) 0842 DATLST = DATNOW 0843 JDLST = JDNOW 0844 0845 if (fluxbias) then 0846 CALL DVMOVE( 6 , ORBNOWHI , ORBLSTHI ) 0847 DATLSTHI = DATNOWHI 0848 JDLSTHI = JDNOWHI 0849 CALL DVMOVE( 6 , ORBNOWLO , ORBLSTLO ) 0850 DATLSTLO = DATNOWLO 0851 JDLSTLO = JDNOWLO 0852 end if 0853 0854 C2 Go the the next M-th ascending node and compute the equator 0855 C2 crossing longitude. COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 16 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0856 0857 CALL MNODES( ORBLST , DATLST , M , JEARTH , 0858 & LTOP , LSFLAG , 0859 & DRAG , dsmadt, tsmaswitch, sigma_dsma, 0860 & 'TRUE', ORBNOW , DATNOW, betap ) 0861 0862 ECL = RNG360( ORBNOW(4) - SIDANG( DATNOW , 0D0 ) ) 0863 GTLONG( NPTS ) = ECL 0864 NREV( NPTS ) = REFIDX 0865 0866 0867 do i=1,6 0868 bootdata(NPTS, i) = orbnow(i) 0869 end do 0870 0871 if (fluxbias) then 0872 CALL MNODES( ORBLSTHI , DATLSTHI , M , JEARTH , 0873 & LTOP , LSFLAG , 0874 & DRAG , dsmadt, tsmaswitch, sigma_dsma, 0875 & HI, ORBNOWHI , DATNOWHI, betap ) 0876 ECLHI = RNG360( ORBNOWHI(4) - SIDANG( DATNOWHI , 0D0 ) ) 0877 CALL MNODES( ORBLSTLO , DATLSTLO , M , JEARTH , 0878 & LTOP , LSFLAG , 0879 & DRAG , dsmadt, tsmaswitch, sigma_dsma, 0880 & LO, ORBNOWLO , DATNOWLO, betap ) 0881 ECLLO = RNG360( ORBNOWLO(4) - SIDANG( DATNOWLO , 0D0 ) ) 0882 end if 0883 0884 if ( trace ) then 0885 write (50,*) 'COMPGT *** True:', orbin, datin, orbnow, datnow 0886 write (50,*) 'COMPGT *** Hi :', orbinhi, datin, orbnowhi, 0887 * datnowhi 0888 write (50,*) 'COMPGT *** Lo :', orbinlo, datin, orbnowlo, 0889 * datnowlo 0890 end if 0891 0892 C2 Compute the difference between the actual and reference equatorial 0893 C2 crossing longitude and then update the reference index. 0894 0895 DIFF = ECL - XINGS( REFIDX ) 0896 0897 IF ( DIFF .GT. 180D0 ) THEN 0898 DIFF = DIFF - 360D0 0899 ELSE IF ( DIFF .LT.-180D0 ) THEN 0900 DIFF = DIFF + 360D0 0901 END IF 0902 0903 C2 Compute the time in days between nodes and update total days. 0904 0905 JDNOW = CH2JD( DATNOW , .TRUE. , ERROR ) 0906 TDAYS = TDAYS+ ( JDNOW - JDLST ) 0907 0908 C 0909 C Examine the ground track offset at the pseudo-site location 0910 C THis is the equivalent site location corresponding to the 0911 C current node crossing 0912 C COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 17 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0913 sini = sin(orbnow(3)*pi/180.0d0) 0914 0915 IF ( trace_overflights .and. 0916 & firsttime.and.(NSITES .GT. 0 ) ) THEN 0917 firsttime = .false. 0918 CALL NEWPAGE(IPAGE, 2) 0919 WRITE(8, 1200) SITE_STRAT 0920 1200 FORMAT (31x, 'Site Overflights'/ 0921 & 31x, '----------------'/ 0922 & 31x, 'Method = ', A6,/) 0923 0924 write(8,1202) (SITE_NAME(i), 0925 & site_loc(2,i),site_gclat(i), 0926 & site_loc(1,i),site_node(i),i=1,nsites) 0927 1202 format (T16,'Site',9x,'GD Lat',9x, 'GC Lat', 6x, 0928 & 'Longitude',1x,'Node', 0929 & /,T10,10('-'),3(1x,14('-')),1x,4('-') , 0930 & (/,T10, A10,3F15.7,I5) ) 0931 write(8,1204) 0932 1204 format(// 0933 & 1x, 7x,'Overflight',13x,'Rev #',24x,'Longitudinal',/ 0934 & 1x, 4x,'UTC Date/Time Site Name Used Latitude', 0935 & ' Longitude Offset, Km',/ 0936 & 1x, '----------------- ---------- ------- ----------', 0937 & ' ---------- ------------') 0938 END IF 0939 0940 do i=1,NSITES 0941 C 0942 C warning: 0943 C !!!!!!! 0944 C in the next if, a site might be missed if the site 0945 C node # is within M/2 of ORBITS or smaller than M/2 0946 C or the same is true of REFIDX. Since the NOMINAL 0947 C T/P sites are always at least 5 from the ends 0948 C (22 & 111) this will never be a problem!!!! 0949 C 0950 0951 ODD = (2*(M/2).ne.M) 0952 OneOK = ((M.EQ.1).and.(REFIDX.EQ.SITE_NODE(I))) 0953 CLOSE = ((M.NE.1).and. 0954 & (iabs(refidx-site_node(i)).le.(M+1)/2)) 0955 NEW = ( REFIDX - (M+1)/2 .NE. SITE_NODE(I) ) 0956 0957 C if ( iabs(REFIDX - SITE_NODE(I) ) .LE. (M+1)/2 ) then 0958 0959 if ( OneOk .OR. 0960 & ( CLOSE .and. ODD ) .or. 0961 & ( CLOSE .and. NEW ) ) then 0962 0963 if (trace_site) write(8,*) '**********' 0964 SITELAT = SITE_GCLAT(i) 0965 if (SITE_STRAT.EQ.'KEPLER') SATGDLAT = SITELAT 0966 SITELONG = XINGS(REFIDX)-XINGS(SITE_NODE(i)) 0967 & + SITE_LOC(1,i) 0968 0969 SITELONG = DMOD ( SITELONG + 360.0D0, 360.0D0) COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 18 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 0970 0971 GTES_A = DMOD(SITELONG - XINGS(REFIDX)+360.0d0,360.0d0) 0972 sinl = sin (sitelat * PI/180.0d0) 0973 cosl = cos (sitelat * PI/180.0d0) 0974 SINDTHETA = sinl/sini 0975 dtheta = asin(sindtheta) 0976 if (GTES_A .GT. 90.0D0) dtheta=pi-dtheta 0977 0978 cosdtheta = cos(dtheta) 0979 cosB = cosdtheta/cosl 0980 GTES_B = acos(cosB) * 180.0/PI 0981 GTES_D = GTES_B + DIFF - GTES_A 0982 0983 call orb2u(orbnow,NuNode) 0984 NuNode=dmod(NuNode - orbnow(5)+360.0d0, 360.0d0) 0985 NuSite=dmod( NuNode + dtheta*180.0d0/PI 0986 & + 360.0d0, 360.0d0 ) 0987 cosNuSite = cos(NuSite*Pi/180.0d0) 0988 SinNuSite = sin(NuSite*Pi/180.0d0) 0989 cosEASite = (orbnow(2)+cosNuSite)/ 0990 & (1+orbnow(2)*cosNuSite) 0991 sinEASite = sqrt(1-orbnow(2)**2)*sinNuSite/ 0992 & (1+orbnow(2)*cosNuSite) 0993 0994 EASite = Atan2 ( SinEASite, CosEASite) 0995 EASITE = DMOD(EASITE+TWOPI, TWOPI) 0996 0997 MASIte = EASite - orbnow(2) * sinEASITE 0998 MASITE = DMOD(MASITE+TWOPI, TWOPI) 0999 C 1000 C anomalistic mean motion 1001 C 1002 call lsrgpb ('GET', 'LSRGP_N',MeanMotion ) 1003 TOF = DMOD( MASITE-orbnow(6)*PI/180.0d0 +TWOPI, 1004 & TWOPI ) / MeanMotion 1005 1006 EarthShift = Earth_freq*(180.0/PI)*TOF 1007 NODESHIFT = ( ( BOOTDATA(NPTS,4)-BOOTDATA(NPTS-1,4) ) 1008 & / (JDNOW-JDLST) ) * TOF/86400.0d0 1009 GTES_DD = GTES_D+(NODESHIFT-EARTHSHIFT) 1010 GTES = GTES_DD * cosl * DEG2KM 1011 1012 if (trace_site) then 1013 write(8,*) 'Time of Flight=',TOF 1014 end if 1015 C 1016 C determine time of site overflight for printout 1017 C 1018 secnow = CH2sec( DATNOW , .TRUE. , ERROR ) 1019 xtsite = secnow + tof + 1020 & (SITE_NODE(I)-REFIDX)*twopi/meanmotion 1021 tsite = sec2ch (xtsite) 1022 1023 if (site_strat .eq. 'PROP') then 1024 C 1025 C repeat calculation using prop 1026 C COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 19 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1027 TOF1 = 0.95 * TOF 1028 TOF2 = 1.05 * TOF 1029 xtsite1 = secnow + tof1 1030 xtsite2 = secnow + tof2 1031 tsite1 = sec2ch(xtsite1) 1032 tsite2 = sec2ch(xtsite2) 1033 C 1034 C prop 5% before the site 1035 C 1036 CALL PROP( ORBNOW , DATNOW , TOF1 , JEARTH, LTOP , 1037 & LSFLAG , DRAG , dsmadt, tsmaswitch, 1038 & sigma_dsma, 'TRUE', ORBSITE, BETAP ) 1039 C call kep2car ( ORBSITE, CARSITE, MU_EARTH ) 1040 C satGCLat1 = atan2 ( carsite(3), 1041 C & sqrt(carsite(1)**2 + carsite(2)**2) ) 1042 C satGDLat1 = atan (tan(satGCLat1)/ (1-flat)**2)*180.0d0/pi 1043 call ORB2LatLong (ORBSITE, TSITE1, MU_EARTH, FLAT, re, 1044 * 1.0d-5, satGDLAT1, satGCLAT1, satLONGITUDE1) 1045 1046 1047 C 1048 C prop to 5% beyond the site 1049 C 1050 CALL PROP( ORBNOW , DATNOW , TOF2 , JEARTH, LTOP , 1051 & LSFLAG , DRAG , dsmadt, tsmaswitch, 1052 & sigma_dsma, 'TRUE', ORBSITE, BETAP ) 1053 C call kep2car ( ORBSITE, CARSITE, MU_EARTH ) 1054 C satGCLat2 = atan2 ( carsite(3), 1055 C & sqrt(carsite(1)**2 + carsite(2)**2) ) 1056 C satGDLat2 = atan (tan(satGCLat2)/ (1-flat)**2)*180.0d0/pi 1057 call ORB2LatLong (ORBSITE, TSITE2, MU_EARTH, FLAT, re, 1058 * 1.0d-5, satGDLAT2, satGCLAT2, satLONGITUDE2) 1059 1060 ErrLimit = 1.0D-5 1061 ErrGDLat = 1.0 1062 Iterations = 0 1063 DO While ( (Dabs(ErrGDLat) .GT. ErrLimit) .and. 1064 & (Iterations .LT. 10 ) ) 1065 1066 iterations = iterations + 1 1067 1068 C 1069 C interpolate to find site 1070 C 1071 TOF = TOF1 + ( (TOF2-TOF1)/(satGDLAT2-satGDLat1)) * 1072 & (site_loc(2,i)-satGDLat1) 1073 xtsite1 = secnow + tof 1074 tsite1 = sec2ch(xtsite1) 1075 C 1076 C prop to interpolated location 1077 C 1078 CALL PROP( ORBNOW , DATNOW , TOF , JEARTH, LTOP , 1079 & LSFLAG , DRAG , dsmadt, tsmaswitch, 1080 & sigma_dsma, 'TRUE', ORBSITE, BETAP ) 1081 C call kep2car ( ORBSITE, CARSITE, MU_EARTH ) 1082 C satGCLat = atan2 ( carsite(3), 1083 C & sqrt(carsite(1)**2 + carsite(2)**2) ) COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 20 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1084 C satGDLat = atan ( tan(satGCLat)/ (1-flat)**2)*180/pi 1085 call ORB2LatLong (ORBSITE, TSITE1, MU_EARTH, FLAT, 1086 * re, 1.0d-5, satGDLAT, satGCLAT, satLONGITUDE) 1087 1088 ErrGDLat = SatGDLat - Site_loc(2,i) 1089 1090 if (trace_site) then 1091 write(8,*) 'Iteration ',Iterations 1092 write(8,*) 'Error = ', ErrGDLat 1093 write(8,*) 'GD Lat 1 = ', satGDLat1, TOF1 1094 write(8,*) 'GD Lat 2 = ', SatGDLat2, TOF2 1095 write(8,*) 'Sat GD Lat = ', SatGDLat, TOF 1096 write(8,*) '***' 1097 end if 1098 1099 if (Dabs(ErrGDLAT) .GT. ErrLimit) then 1100 if (SatGDLat2 .LT. SatGdLat1) then 1101 C 1102 C descending pass 1103 C 1104 if (SatGDLat .LT. Site_Loc(2,i)) then 1105 TOF2 = TOF 1106 SATGDLAT2 = SATGDLAT 1107 else 1108 TOF1 = TOF 1109 SATGDLAT1 = SATGDLAT 1110 end if 1111 else 1112 C 1113 C ascending pass 1114 C 1115 if (SatGDLAT .LT. Site_Loc(2,i)) then 1116 TOF1 = TOF 1117 SATGDLAT1 = SATGDLAT 1118 else 1119 TOF2 = TOF 1120 SATGDLAT2 = SATGDLAT 1121 end if 1122 end if 1123 end if 1124 End do 1125 1126 C 1127 C SatLongitude = (180.0/PI) * 1128 C & atan2 ( CARSITE(2), CARSITE(1) ) 1129 C & - sidang ( sec2ch(secnow+tof), 0.0d0 ) 1130 1131 SatLongitude = dmod ( SatLongitude + 720.0d0, 360.0d0) 1132 GTES = ( SatLongitude - SiteLong ) * cosl * DEG2KM 1133 end if 1134 1135 if (trace_site) then 1136 write(8,*) 'Sat GC Latitude = ', satGCLat 1137 write(8,*) 'Sat GD Latitude = ', satGDLat 1138 write(8,*) 'Site GD Latitude = ', site_loc(2,i) 1139 write(8,*) 'Error in Latitude = ',ErrGDLat 1140 write(8,*) 'Sat Longitude = ',SatLongitude COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 21 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1141 write(8,*) 'Sat Pseudo Longitude = ', SatLongitude 1142 & -( XINGS(REFIDX)-XINGS(SITE_NODE(i))) 1143 write(8,*) 'SiteLong = ',SiteLong 1144 write(8,*) 'Offset by Prop = ', GTES, ' km.' 1145 end if 1146 1147 if (trace_overflights) then 1148 write(8,1234) tsite(1:17), site_name(i), REFIDX, 1149 & REFIDX.EQ.SITE_NODE(I), satGDLat, 1150 & DMOD( satLongitude+360.0D0- 1151 & (XINGS(REFIDX)-XINGS(SITE_NODE(i))), 360.0d0), 1152 & gtes 1153 1234 format(1x, A17,1x, A10,I5,1x,L1,F12.5,F11.5,F13.5) 1154 end if 1155 1156 NOVERFLIGHTS(I) = NOVERFLIGHTS(I)+1 1157 overflights(I,NOVERFLIGHTS(I),1) = xtsite 1158 overflights(I,NOVERFLIGHTS(I),2) = GTES 1159 overflights(I,NOVERFLIGHTS(I),3) = satGDLAT 1160 overflights(I,NOVERFLIGHTS(I),4) = 1161 & DMOD( satLongitude+360.0D0- 1162 & (XINGS(REFIDX)-XINGS(SITE_NODE(i))), 360.0d0) 1163 overflights(I,NOVERFLIGHTS(I),5) = dble(real(REFIDX)) 1164 1165 end if 1166 1167 end do 1168 1169 1170 REFIDX = REFIDX + M 1171 IF ( REFIDX .GT. ORBITS ) REFIDX = REFIDX - ORBITS 1172 1173 if (fluxbias ) then 1174 DIFFHI = ECLHI - XINGS( REFIDXHI ) 1175 DIFFLO = ECLLO - XINGS( REFIDXLO ) 1176 1177 IF ( DIFFHI .GT. 180D0 ) THEN 1178 DIFFHI = DIFFHI - 360D0 1179 ELSE IF ( DIFFHI .LT.-180D0 ) THEN 1180 DIFFHI = DIFFHI + 360D0 1181 END IF 1182 IF ( DIFFLO .GT. 180D0 ) THEN 1183 DIFFLO = DIFFLO - 360D0 1184 ELSE IF ( DIFFLO .LT.-180D0 ) THEN 1185 DIFFLO = DIFFLO + 360D0 1186 END IF 1187 1188 REFIDXHI = REFIDXHI + M 1189 IF ( REFIDXHI .GT. ORBITS ) REFIDXHI = REFIDXHI - ORBITS 1190 REFIDXLO = REFIDXLO + M 1191 IF ( REFIDXLO .GT. ORBITS ) REFIDXLO = REFIDXLO - ORBITS 1192 1193 end if 1194 1195 if (trace) then 1196 write (50,*) 'COMPGT ECL,HI,LO',ECL,ECLHI,ECLLO 1197 write (50,*) 'COMPGT IDX,HI,LO',REFIDX,REFIDXHI,REFIDXLO COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 22 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1198 write (50,*) 'COMPGT DIF,HI,LO',DIFF,DIFFHI,DIFFLO 1199 end if 1200 1201 C2 Convert the difference to kilometers. 1202 1203 DGT = DIFF * DEG2KM 1204 if (fluxbias) then 1205 dgthi_last = dgthi 1206 dgtlo_last = dgtlo 1207 DGTHI = DIFFHI * DEG2KM 1208 DGTLO = DIFFLO * DEG2KM 1209 end if 1210 1211 if (trace) then 1212 write(50,*) 'COMPGT DGT,HI,LO:',DGT,DGTHI,DGTLO 1213 end if 1214 1215 1216 if (fluxbias) then 1217 JDNOWHI = CH2JD( DATNOWHI , .TRUE. , ERROR ) 1218 JDNOWLO = CH2JD( DATNOWLO , .TRUE. , ERROR ) 1219 TDAYSHI_LAST = TDAYSHI 1220 TDAYSLO_LAST = TDAYSLO 1221 TDAYSHI = TDAYSHI + JDNOWHI - JDLSTHI 1222 TDAYSLO = TDAYSLO + JDNOWLO - JDLSTLO 1223 C 1224 C if necessary, save a new point to flux/gt bias file 1225 C 1226 itdays = int(tdays) 1227 if ( itdays .gt. itdayslast) then 1228 call interp_line ( dble(itdays), tdayshi_last, tdayshi, 1229 & dgthi_last, dgthi, dgthi_used ) 1230 call interp_line ( dble(itdays), tdayslo_last, tdayslo, 1231 & dgtlo_last, dgtlo, dgtlo_used ) 1232 if (itdays.gt.0) 1233 & drag_bias(itdays) = max ( abs(dgthi_used)-dgt, 1234 & abs(dgtlo_used)-dgt ) 1235 itdayslast = itdays 1236 end if 1237 end if 1238 1239 C2 Store offset and time in data arrays. 1240 1241 TIMVEC( NPTS ) = TDAYS 1242 DGTVEC( NPTS ) = DGT 1243 1244 GTE_DV = 0.001 * SF_DVOD * partial_dGTdV * DV_ERROR * TDAYS 1245 GTE_OD = 0.001 * SF_DVOD * partial_dGTda * DA_OD * TDAYS 1246 1247 IF (GTE_BOOST_ARRAY) THEN 1248 C 1249 C INSERT CODE HERE TO OBTAIN DA_BOOST FROM THE APPROPRIATE 1250 C DATA ARRAY, DSMADT_SIGMAS(I) 1251 C 1252 C DA_BOOST = DATA FROM ARRAY * PERIOD * M / 86400.0 1253 C 1254 C NEED ALSO TO INCORPORATE SCALE FACTOR INTO EQUATIONS COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 23 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1255 1256 IF ( DSMADT_EPOCH .EQ. ' ') then 1257 IDATE = finddate ( DATNOW, .FALSE., DSMADT_dates, 1258 & XDSMADT_DATES, nDSMADT_DATA ) 1259 IF (IDATE .LT. 1 .OR. IDATE .GE. NDSMADT_DATA) THEN 1260 WRITE(8,*) 'Time ', datnow,' is out of range of ', 1261 & ' Boost Sigma Array.' 1262 DA_BOOST = 0.0D0 1263 ELSE 1264 XT1 = XDSMADT_DATES(IDATE) 1265 XT2 = XDSMADT_DATES(IDATE+1) 1266 Y1 = dsmadt_sigmas(IDATE) 1267 Y2 = dsmadt_sigmas(IDATE+1) 1268 da_boost = y1 + 1269 & (CH2SEC(DATNOW, .TRUE., ERROR) - XT1) 1270 & *( (y2-y1)/(XT1-XT2) ) 1271 da_boost = da_boost * PERIOD_DAYS 1272 END IF 1273 ELSE 1274 dsmadt_epoochjd = ch2jd ( dsmadt_epoch, .true., ERROR) 1275 IDATE = jdnow - dsmadt_epochjd 1276 IF (IDATE .LT. 1 .OR. IDATE .GE. NDSMADT_DATA) THEN 1277 WRITE(8,*) 'Time ', datnow,' is out of range of ', 1278 & ' Boost Sigma Array.' 1279 DA_BOOST = 0.0D0 1280 ELSE 1281 da_boost = DSMADT_SIGMAS(IDATE) 1282 da_boost = da_boost * M * PERIOD_DAYS 1283 END IF 1284 END IF 1285 1286 GTE_BOOST_OLD = GTE_BOOST 1287 IF (QUAD_ERR_BOOST) THEN 1288 ALPHA_BOOST_OLD = ALPHA_BOOST 1289 GAMMA_BOOST_OLD = GAMMA_BOOST 1290 ALPHA_BOOST = ALPHA_BOOST_OLD + 1291 & m * (PERIOD_DAYS**2) * (DA_BOOST**2) 1292 GAMMA_BOOST = 2.0*m*ALPHA_BOOST_OLD + GAMMA_BOOST_OLD 1293 & + MMPRIME * (PERIOD_DAYS**2) * (DA_BOOST**2) 1294 BETA_BOOST = BETA_STAR * (DA_BOOST**2) 1295 GTE_BOOST = SQRT( GTE_BOOST_OLD**2 1296 & + ( PARTIAL_DGTDA**2 ) 1297 & * ( MPRIME * ALPHA_BOOST_OLD + 1298 & M * GAMMA_BOOST_OLD + BETA_BOOST ) ) 1299 C write(8,*) DATNOW,' TDAYS=', TDAYS, 1300 C & ' I=',IDATE,' DA_BOOST=',DA_BOOST,' M=',M, 1301 C & ' M''=',MPRIME,' MM''=',MMPRIME, 1302 C & ' AL=',ALPHA_BOOST_OLD, ' GAM=',GAMMA_BOOST_OLD, 1303 C & ' BETA*=',BETA_STAR, 1304 C & ' BETA=',BETA_BOOST, ' GT=',GTE_BOOST 1305 ELSE 1306 DELTA_BOOST_OLD = DELTA_BOOST 1307 DELTA_BOOST = DELTA_BOOST_OLD + 1308 & M * M * PERIOD_DAYS * 1309 & PARTIAL_DGTDA * DA_BOOST 1310 GTE_BOOST = GTE_BOOST_OLD + DELTA_BOOST_OLD + 1311 & PARTIAL_DGTDA * PERIOD_DAYS * DA_BOOST * COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 24 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1312 & 0.5 * mmprime 1313 END IF 1314 1315 ELSE 1316 if (quad_err_boost) then 1317 GTE_BOOST = partial_dgtda_boost * 1318 & da_boost * 1319 & sqrt (2.0d0/3.0d0) * 1320 & sqrt ( ( tdays * 86400.0 / period) * 1321 & ( tdays - PERIOD/86400.0) * 1322 & ( 2*tdays - PERIOD/86400.0) ) 1323 C write(8,*) tdays,' ',GTE_BOOST 1324 else 1325 GTE_BOOST = partial_dgtda_boost * 1326 & da_boost * 1327 & tdays * (1 + tdays * 86400.0 / PERIOD ) 1328 end if 1329 END IF 1330 1331 GTE_BOOST_ENV = 0.001 * SF_BOOST * GTE_BOOST 1332 1333 GTE_DVOD = sqrt ( GTE_DV**2 + GTE_OD**2 ) 1334 1335 if (fluxbias) then 1336 1337 call interp_line ( tdays, tdayshi_last, tdayshi, 1338 & dgthi_last, dgthi, dgthi_used ) 1339 call interp_line ( tdays, tdayslo_last, tdayslo, 1340 & dgtlo_last, dgtlo, dgtlo_used ) 1341 1342 gte_drag = max (abs (dgthi_used - dgt), 1343 & abs (dgtlo_used - dgt) ) 1344 old_gte_drag_hi = gte_drag_hi 1345 old_gte_drag_lo = gte_drag_lo 1346 GTE_DRAG_HI = abs (dgthi_used - dgt) 1347 GTE_DRAG_LO = abs (dgtlo_used - dgt) 1348 else 1349 call interp_drag_bias (tdays, drag_bias, ndrag_bias, 1350 & gte_drag ) 1351 old_gte_drag_hi = gte_drag_hi 1352 old_gte_drag_lo = gte_drag_lo 1353 gte_drag_hi = gte_drag 1354 gte_drag_lo = gte_drag 1355 end if 1356 1357 delta_gte_drag_hi = gte_drag_hi - old_gte_drag_hi 1358 delta_gte_drag_lo = gte_drag_lo - old_gte_drag_lo 1359 optimistic_gte_drag_hi = sqrt ( 1360 & optimistic_gte_drag_hi**2 + delta_gte_drag_hi**2 ) 1361 optimistic_gte_drag_lo = sqrt ( 1362 & optimistic_gte_drag_lo**2 + delta_gte_drag_lo**2 ) 1363 1364 if ( quad_err_drag) then 1365 GTE_DRAG_EAST = sf_drag * OPTIMISTIC_GTE_DRAG_HI 1366 GTE_DRAG_WEST = sf_drag * OPTIMISTIC_GTE_DRAG_LO 1367 else 1368 GTE_DRAG_EAST = sf_drag * GTE_DRAG_HI COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 25 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1369 GTE_DRAG_WEST = sf_drag * GTE_DRAG_LO 1370 end if 1371 1372 GT_ERROR_EAST = sqrt ( GTE_DVOD**2 + 1373 & GTE_DRAG_EAST**2 + GTE_BOOST_ENV**2 ) 1374 GT_ERROR_WEST = sqrt ( GTE_DVOD**2 + 1375 & GTE_DRAG_WEST**2 + GTE_BOOST_ENV**2 ) 1376 1377 DGTWest = DGT - GT_ERROR_WEST 1378 DGTEast = DGT + GT_ERROR_EAST 1379 1380 EASTVEC( NPTS ) = DGTEast 1381 WESTVEC( NPTS ) = DGTWest 1382 1383 BIAS_ODE( NPTS ) = SNGL ( DGT+abs(GTE_OD) ) 1384 BIAS_DVE( NPTS ) = SNGL ( DGT+abs(GTE_DV) ) 1385 BIAS_DRAGE( NPTS ) = SNGL ( DGT+abs(GTE_DRAG_EAST) ) 1386 BIAS_boostE( NPTS ) = SNGL ( DGT+abs(GTE_boost_ENV) ) 1387 1388 BIAS_ODW( NPTS ) = SNGL ( DGT-abs(GTe_OD) ) 1389 BIAS_DVW( NPTS ) = SNGL ( DGT-abs(GTe_DV) ) 1390 BIAS_DRAGW( NPTS ) = SNGL ( DGT-abs(GTe_DRAG_WEST) ) 1391 BIAS_boostw( NPTS ) = SNGL ( DGT-abs(GTE_boost_ENV) ) 1392 1393 if ( watch .and. TERMINAL.eq.'VT100' ) then 1394 write (6,*) goto_string (14,1), datnow 1395 write (6,100) goto_string (14,63),tdays 1396 write (6,100) goto_string (15,6),dgtwest 1397 write (6,100) goto_string (16,6),dgt 1398 write (6,100) goto_string (17,6),dgteast 1399 1400 write (6,100) goto_string(15,33), orbnow (1) 1401 write (6,100)goto_string(16,33), orbnow (2) 1402 write (6,100) goto_string(17,33), orbnow (3) 1403 write (6,100) goto_string(15,63), orbnow (4) 1404 write (6,100) goto_string(16,63), orbnow (5) 1405 write (6,100) goto_string(17,63), orbnow (6) 1406 1407 100 format(' ',A8,f15.10) 1408 end if 1409 1410 C2 Is ground track within the valid band? 1411 C 1412 C This test will only pass if on the previous iteration, the 1413 C ground track was OUT of the valid band. Thus if we 1414 C have JUST ENTERED the valid band, then set the 1415 C appropriate flag to say "KEEP GOING" 1416 C 1417 IF ( .NOT. WASIN ) THEN 1418 if ( target_strat .eq. 'UNBIASED' ) then 1419 IF ( BOUNDS(1) .LT. DGT .AND. DGT .LT. BOUNDS(2) ) 1420 & WASIN = .TRUE. 1421 else if ( target_strat .eq. 'WESTGT' ) then 1422 IF ( BOUNDS(1) .LT. DGTwest .AND. 1423 & DGTwest .LT. BOUNDS(2) ) 1424 & WASIN = .TRUE. 1425 else if ( target_strat .eq. 'EASTGT' ) then COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 26 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1426 IF ( BOUNDS(1) .LT. DGTeast .AND. 1427 & DGTeast .LT. BOUNDS(2) ) 1428 & WASIN = .TRUE. 1429 endif 1430 1431 END IF 1432 C 1433 C has the unbiased of the 3 ground tracks returned? if so, save 1434 C the time for the report 1435 C 1436 IF ( .NOT. WASIN_UNBIASED ) THEN 1437 if ( BOUNDS(1) .LT. DGT .AND. DGT .LT. BOUNDS(2) ) 1438 & WASIN_UNBIASED = .TRUE. 1439 else if ( ( tmaneuver(2) .le. 0 ) .and. 1440 & ( dgt .lt. bounds(1) .or. 1441 & dgt .gt. bounds(2) ) ) then 1442 tmaneuver(2) = tdays 1443 norbits(2) = npts*M 1444 end if 1445 C 1446 C has the eastermost of the 3 ground tracks returned? if so, save 1447 C the time for the report 1448 C 1449 IF ( .NOT. WASIN_EAST ) THEN 1450 if ( BOUNDS(1) .LT. DGTeast .AND. 1451 & DGTeast .LT. BOUNDS(2) ) 1452 & WASIN_EAST = .TRUE. 1453 else if ( ( tmaneuver(3) .le. 0 ) .AND. 1454 & ( dgteast .lt. bounds(1) .or. 1455 & dgteast .gt. bounds(2) ) ) then 1456 tmaneuver(3) = tdays 1457 norbits(3) = npts*M 1458 end if 1459 C 1460 C has the westermost of the 3 ground tracks returned? if so, save 1461 C the time for the report 1462 C 1463 IF ( .NOT. WASIN_WEST ) THEN 1464 IF ( BOUNDS(1) .LT. DGTwest .AND. 1465 & DGTwest .LT. BOUNDS(2) ) 1466 & WASIN_weST = .TRUE. 1467 else if ( ( tmaneuver(1) .le. 0 ) .and. 1468 & ( DGTwest .lt. bounds(1) .or. 1469 & dgtwest .gt. bounds(2) ) )then 1470 tmaneuver(1) = tdays 1471 norbits(1) = npts*M 1472 end if 1473 1474 C2 Is ground track any further west? 1475 1476 IF ( DGT .LT. LIMITS(2,2) ) THEN 1477 LIMITS(2,1) = TDAYS 1478 LIMITS(2,2) = DGT 1479 END IF 1480 1481 if ( dgtwest .lt. limits_west(2,2)) then 1482 limits_west(2,1) = tdays COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 27 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1483 limits_west(2,2) = dgtwest 1484 end if 1485 1486 if ( dgteast .lt. limits_east(2,2)) then 1487 limits_east(2,1) = tdays 1488 limits_east(2,2) = dgteast 1489 end if 1490 1491 C2 Is ground track any further east? 1492 1493 IF ( DGT .GT. LIMITS(3,2) ) THEN 1494 LIMITS(3,1) = TDAYS 1495 LIMITS(3,2) = DGT 1496 END IF 1497 IF ( DGTwest .GT. LIMITS_west(3,2) ) THEN 1498 LIMITS_west(3,1) = TDAYS 1499 LIMITS_west(3,2) = DGTwest 1500 END IF 1501 IF ( DGTeast .GT. LIMITS_east(3,2) ) THEN 1502 LIMITS_east(3,1) = TDAYS 1503 LIMITS_east(3,2) = DGTeast 1504 END IF 1505 1506 C2 Check to see if stopping criteria was met. If COMPGT is simply 1507 C2 running out a ground track, then continue for specified number 1508 C2 of days. Otherwise, go until ground track leaves valid band. 1509 C2 However, if the track was never in the band, terminate after 1510 C2 TOLONG days. 1511 1512 C 1513 C first test : for a RUNOUT 1514 C 1515 IF ( DAYS .GT. 0 ) THEN 1516 1517 IF ( TDAYS .GT. TSTOP ) GO TO 902 1518 C 1519 C second test: never made it into the valid band, try again 1520 C with a bettern delta v 1521 C 1522 ELSE IF ( .NOT. WASIN ) THEN 1523 1524 IF ( TDAYS .GT. TSTOP ) GO TO 902 1525 C 1526 C otherwise, see if the ground track just crossed out of the 1527 C valid band; stop if all done 1528 C 1529 ELSE IF ( WASIN ) THEN 1530 1531 if ( target_strat .eq. 'UNBIASED' ) then 1532 IF ( DGT .LT. BOUNDS(1) .OR. 1533 & BOUNDS(2) .LT. DGT ) GO TO 902 1534 else if ( target_strat .eq. 'WESTGT' ) then 1535 IF ( DGTwest .LT. BOUNDS(1) .OR. 1536 & BOUNDS(2) .LT. DGTwest ) GO TO 902 1537 else if ( target_strat .eq. 'EASTGT' ) then 1538 IF ( DGTeast .LT. BOUNDS(1) .OR. 1539 & BOUNDS(2) .LT. DGTeast ) GO TO 902 COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 28 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 1540 endif 1541 1542 END IF 1543 1544 C2 If no stopping criteria was met, then take another step. 1545 1546 GO TO 901 1547 1548 C1 End of Do Loop. 1549 1550 902 CONTINUE 1551 1552 C1 Save the last node and orbit. 1553 1554 CALL DVMOVE( 6 , ORBNOW , ORBOUT ) 1555 1556 DATOUT = DATNOW 1557 1558 LIMITS(4,1) = TDAYS 1559 LIMITS(4,2) = DGT 1560 1561 LIMITS_WEST(4,1) = TDAYS 1562 LIMITS_WEST(4,2) = DGTwest 1563 1564 LIMITS_EAST(4,1) = TDAYS 1565 LIMITS_EAST(4,2) = DGTeast 1566 1567 C 1568 C if flux biasing mode, save the gt bias component due to flux 1569 C 1570 if (fluxbias) ndrag_bias = int(tdays) 1571 1572 C1 End of COMPGT. 1573 1574 RETURN 1575 END COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 29 01 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 9385 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 1032 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 4624 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 72 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 5 BOOST 49041 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 6 ERROR_FLAGS 8 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 7 SITE_DATA 40430 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 104604 ENTRY POINTS Address Type Name 0-00000000 COMPGT VARIABLES Address Type Name Address Type Name 2-000003D0 R*8 ALPHA_BOOST 2-000003D8 R*8 ALPHA_BOOST_OLD 2-000002A8 R*8 BETAP AP-000000B8@ R*8 BETAPRIME ** R*8 BETA_BOOST 2-00000400 R*8 BETA_STAR ** L*4 CLOSE ** R*8 COSB ** R*8 COSDTHETA 2-00000480 R*8 COSEASITE ** R*8 COSL ** R*8 COSNUSITE AP-00000008@ CHAR DATIN 2-000001E0 CHAR DATLST 2-000001F9 CHAR DATLSTHI 2-00000212 CHAR DATLSTLO 2-0000022B CHAR DATNOW 2-00000244 CHAR DATNOWHI 2-0000025D CHAR DATNOWLO AP-00000090@ CHAR DATOUT AP-00000030@ I*4 DAYS 2-000002B8 R*8 DA_BOOST AP-0000004C@ R*8 DA_OD 3-00000038 R*8 DEG2KM ** R*8 DELTANJ2 2-000003E0 R*8 DELTA_BOOST 2-000003E8 R*8 DELTA_BOOST_OLD ** R*8 DELTA_GTE_DRAG_HI ** R*8 DELTA_GTE_DRAG_LO 2-000002C0 R*8 DGT ** R*8 DGTEAST 2-000002C8 R*8 DGTHI 2-000002E8 R*8 DGTHI_LAST 2-000002D8 R*8 DGTHI_USED 2-000002D0 R*8 DGTLO 2-000002F0 R*8 DGTLO_LAST 2-000002E0 R*8 DGTLO_USED ** R*8 DGTWEST 2-000002F8 R*8 DIFF 2-00000300 R*8 DIFFHI 2-00000308 R*8 DIFFLO AP-0000001C@ L*4 DRAG AP-0000002C@ CHAR DRAGBIASMODE 5-00001F5D R*8 DSMADT_DATA_SIGMA 5-00001F44 CHAR DSMADT_EPOCH 2-000002B0 R*8 DSMADT_EPOCHJD ** R*4 DSMADT_EPOOCHJD 2-00000458 R*8 DTHETA AP-00000064@ R*8 DV 2-000003A8 R*8 DV_ERROR AP-00000044@ R*8 DV_FIXED AP-00000048@ R*8 DV_PROP ** R*8 EARTHSHIFT 3-00000008 R*8 EARTH_FREQ ** R*8 EASITE 2-00000310 R*8 ECL 2-00000318 R*8 ECLHI 2-00000320 R*8 ECLLO 2-000004B0 R*8 ERRGDLAT ** R*8 ERRLIMIT COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 30 01 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 2-000004F8 L*4 ERROR ** L*4 FIRSTTIME 3-00000040 R*8 FLAT ** L*4 FLUXBIAS 2-000003F0 R*8 GAMMA_BOOST 2-000003F8 R*8 GAMMA_BOOST_OLD ** R*8 GET_DRAG_WEST 2-00000468 R*8 GTES ** R*8 GTES_A ** R*8 GTES_B ** R*8 GTES_D ** R*8 GTES_DD 2-000003C8 R*8 GTE_BOOST 2-00000520 L*4 GTE_BOOST_ARRAY ** R*8 GTE_BOOST_ENV ** R*8 GTE_BOOST_OLD 2-000003C0 R*8 GTE_DRAG 2-00000438 R*8 GTE_DRAG_EAST 2-00000408 R*8 GTE_DRAG_HI 2-00000410 R*8 GTE_DRAG_LO 2-00000530 R*4 GTE_DRAG_WEST ** R*8 GTE_DV ** R*8 GTE_DVOD ** R*8 GTE_OD ** R*8 GT_ERROR ** R*8 GT_ERROR_EAST ** R*8 GT_ERROR_WEST ** I*4 I ** I*4 IDATE ** I*4 IDX AP-000000CC@ I*4 IPAGE 2-000004FC I*4 ITDAYS 2-00000500 I*4 ITDAYSLAST ** I*4 ITERATIONS 2-00000328 R*8 JDLST 2-00000330 R*8 JDLSTHI 2-00000338 R*8 JDLSTLO 2-00000340 R*8 JDNOW 2-00000348 R*8 JDNOWHI 2-00000350 R*8 JDNOWLO ** I*4 K AP-00000018@ L*4 LSFLAG AP-00000014@ I*4 LTOP AP-0000000C@ I*4 M ** R*8 MASITE 2-00000490 R*8 MEANMOTION 2-00000524 I*4 MMPRIME 2-00000528 I*4 MPRIME 2-00000358 R*8 MU 3-00000018 R*8 MU_EARTH 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN AP-0000005C@ I*4 NDRAG_BIAS 5-00000000 I*4 NDSMADT_DATA ** L*4 NEW ** R*8 NODESHIFT AP-000000A0@ I*4 NPTS 7-00000000 I*4 NSITES 2-00000470 R*8 NUNODE ** R*8 NUSITE ** L*4 ODD 2-00000418 R*8 OLD_GTE_DRAG_HI 2-00000420 R*8 OLD_GTE_DRAG_LO ** L*4 ONEOK 2-00000428 R*8 OPTIMISTIC_GTE_DRAG_HI 2-00000430 R*8 OPTIMISTIC_GTE_DRAG_LO AP-00000038@ I*4 ORBITS 2-000003A0 R*8 PARTIAL_DGTDA 2-00000398 R*8 PARTIAL_DGTDA_BOOST 2-00000390 R*8 PARTIAL_DGTDV 2-000003B0 R*8 PERIOD 2-000003B8 R*8 PERIOD_DAYS 5-00001F65 L*4 PLOT_BOOST 6-00000000 L*4 QUAD_ERR_BOOST 6-00000004 L*4 QUAD_ERR_DRAG 3-00000000 R*8 RE 2-00000504 I*4 REFIDX 2-00000508 I*4 REFIDXHI 2-0000050C I*4 REFIDXLO 2-000004A8 R*8 SATGCLAT 2-000004D8 R*8 SATGCLAT1 2-000004E0 R*8 SATGCLAT2 2-000004A0 R*8 SATGDLAT 2-000004C8 R*8 SATGDLAT1 2-000004D0 R*8 SATGDLAT2 2-00000498 R*8 SATLONGITUDE 2-000004B8 R*8 SATLONGITUDE1 2-000004C0 R*8 SATLONGITUDE2 ** R*8 SECNOW AP-00000058@ R*8 SF_BOOST AP-00000054@ R*8 SF_DRAG AP-00000050@ R*8 SF_DVOD 3-00000030 R*8 SID_DAY ** R*8 SINDTHETA 2-00000478 R*8 SINEASITE 2-00000460 R*8 SINI ** R*8 SINL ** R*8 SINNUSITE ** R*8 SITELAT ** R*8 SITELONG 7-00000180 CHAR SITE_STRAT AP-00000068@ CHAR TARGET_STRAT 2-00000360 R*8 TDAYS 2-00000368 R*8 TDAYSHI 2-00000378 R*8 TDAYSHI_LAST 2-00000370 R*8 TDAYSLO 2-00000380 R*8 TDAYSLO_LAST 4-00000000 CHAR TERMINAL 2-00000488 R*8 TOF 2-000004E8 R*8 TOF1 2-000004F0 R*8 TOF2 ** CHAR TSITE 2-00000276 CHAR TSITE1 2-0000028F CHAR TSITE2 COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 31 01 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 AP-00000024@ R*8 TSMASWITCH 2-00000388 R*8 TSTOP ** R*8 VEL 2-00000510 L*4 WASIN 2-00000514 L*4 WASIN_EAST 2-0000051C L*4 WASIN_UNBIASED 2-00000518 L*4 WASIN_WEST AP-00000040@ L*4 WATCH 3-00000010 R*8 WEARTH ** R*8 XT1 ** R*8 XT2 2-00000440 R*8 XTSITE 2-00000448 R*8 XTSITE1 2-00000450 R*8 XTSITE2 ** R*8 Y1 ** R*8 Y2 ARRAYS Address Type Name Bytes Dimensions AP-00000078@ R*4 BIAS_BOOSTE 80000 (20000) AP-00000088@ R*4 BIAS_BOOSTW 80000 (20000) AP-00000074@ R*4 BIAS_DRAGE 80000 (20000) AP-00000084@ R*4 BIAS_DRAGW 80000 (20000) AP-00000070@ R*4 BIAS_DVE 80000 (20000) AP-00000080@ R*4 BIAS_DVW 80000 (20000) AP-0000006C@ R*4 BIAS_ODE 80000 (20000) AP-0000007C@ R*4 BIAS_ODW 80000 (20000) AP-000000C8@ R*8 BOOTDATA 960000 (20000, 6) AP-00000034@ R*8 BOUNDS 16 (2) 2-00000180 R*8 CARSITE 48 (6) AP-000000A8@ R*8 DGTVEC 160000 (20000) AP-00000060@ R*8 DRAG_BIAS ** (*) AP-00000020@ R*8 DSMADT 16 (2) 5-00000004 R*8 DSMADT_DATA 8000 (1000) 5-00001F69 CHAR DSMADT_DATES 25000 (1000) 5-0000A051 R*8 DSMADT_SIGMAS 8000 (1000) AP-000000B0@ R*8 EASTVEC 160000 (20000) AP-000000C0@ R*8 GTLONG 160000 (20000) AP-00000010@ R*8 JEARTH 224 (2:29) AP-00000094@ R*8 LIMITS 64 (4, 2) AP-0000009C@ R*8 LIMITS_EAST 64 (4, 2) AP-00000098@ R*8 LIMITS_WEST 64 (4, 2) AP-000000BC@ I*4 NORBITS 12 (3) 7-00009DC6 I*4 NOVERFLIGHTS 40 (10) AP-000000C4@ I*4 NREV 80000 (20000) AP-00000004@ R*8 ORBIN 48 (6) 2-00000120 R*8 ORBINHI 48 (6) 2-00000150 R*8 ORBINLO 48 (6) 2-00000000 R*8 ORBLST 48 (6) 2-00000030 R*8 ORBLSTHI 48 (6) 2-00000060 R*8 ORBLSTLO 48 (6) 2-00000090 R*8 ORBNOW 48 (6) 2-000000C0 R*8 ORBNOWHI 48 (6) 2-000000F0 R*8 ORBNOWLO 48 (6) AP-0000008C@ R*8 ORBOUT 48 (6) 2-000001B0 R*8 ORBSITE 48 (6) 7-00000186 R*8 OVERFLIGHTS 40000 (10, 100, 5) AP-00000028@ R*8 SIGMA_DSMA 16 (2) 7-000000CC R*8 SITE_GCLAT 80 (10) 7-00000004 R*8 SITE_LOC 160 (2, 10) 7-0000011C CHAR SITE_NAME 100 (10) 7-000000A4 I*4 SITE_NODE 40 (10) COMPGT 1-Jun-1993 15:33:32 VAX FORTRAN V5.6-119 Page 32 01 20-May-1993 20:58:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.FOR;272 AP-000000A4@ R*8 TIMVEC 160000 (20000) AP-000000B4@ R*8 TMANEUVER 24 (3) AP-000000AC@ R*8 WESTVEC 160000 (20000) 5-00008111 R*8 XDSMADT_DATES 8000 (1000) AP-0000003C@ R*8 XINGS ** (*) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-000003D4 100' ** 101 1-0000021B 102' 1-00000223 301' 0-00000F44 901 0-00002448 902 1-00000213 1101' 1-00000252 1200' 1-0000028D 1202' 1-000002F6 1204' 1-000003BC 1234' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*8 CH2JD R*8 CH2SEC I*4 DCLOSE DVMOVE I*4 FINDDATE CHAR GOTO_STRING INTERP_DRAG_BIAS INTERP_LINE LSRGPB MNODES R*8 MTH$DACOS R*8 MTH$DASIN R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DMOD R*8 MTH$DSIN R*8 MTH$DSQRT NEWPAGE ORB2LATLONG ORB2U PROP R*8 RNG360 CHAR SEC2CH R*8 SIDANG COMMAND QUALIFIERS FOR/LIS COMPGT.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COMPGT.OBJ;2 COMPILATION STATISTICS Run Time: 5.25 seconds Elapsed Time: 27.07 seconds Page Faults: 1380 Dynamic Memory: 1352 pages 1-Jun-1993 15:34:07 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:40:27 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY44.FOR;3 0001 subroutine copy44(from,to,n) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C copies a real*4 array 0012 C 0013 real*4 from(N) 0014 real*4 to(N) 0015 do i=1,n 0016 to(i)=from(i) 0017 end do 0018 return 0019 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 88 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 172 ENTRY POINTS Address Type Name 0-00000000 COPY44 VARIABLES Address Type Name Address Type Name ** I*4 I AP-0000000C@ I*4 N ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*4 FROM ** (*) AP-00000008@ R*4 TO ** (*) COPY44 1-Jun-1993 15:34:07 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:40:27 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY44.FOR;3 COMMAND QUALIFIERS FOR/LIS COPY44.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY44.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY44.OBJ;2 COMPILATION STATISTICS Run Time: 0.21 seconds Elapsed Time: 2.97 seconds Page Faults: 194 Dynamic Memory: 456 pages 1-Jun-1993 15:34:12 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:45:33 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY48.FOR;4 0001 subroutine copy48(from,to,n) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 real*4 from(N) 0012 real*8 to(N) 0013 integer N 0014 do i=1,n 0015 to(i)=from(i) 0016 end do 0017 return 0018 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 88 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 172 ENTRY POINTS Address Type Name 0-00000000 COPY48 VARIABLES Address Type Name Address Type Name ** I*4 I AP-0000000C@ I*4 N ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*4 FROM ** (*) AP-00000008@ R*8 TO ** (*) COPY48 1-Jun-1993 15:34:12 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:45:33 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY48.FOR;4 COMMAND QUALIFIERS FOR/LIS COPY48.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY48.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY48.OBJ;2 COMPILATION STATISTICS Run Time: 0.19 seconds Elapsed Time: 2.07 seconds Page Faults: 201 Dynamic Memory: 456 pages 1-Jun-1993 15:34:18 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:46:17 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY84.FOR;3 0001 subroutine copy84(from,to,n) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 0012 real*8 from(N) 0013 real*4 to(N) 0014 do i=1,n 0015 to(i)=from(i) 0016 end do 0017 return 0018 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 88 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 172 ENTRY POINTS Address Type Name 0-00000000 COPY84 VARIABLES Address Type Name Address Type Name ** I*4 I AP-0000000C@ I*4 N ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 FROM ** (*) AP-00000008@ R*4 TO ** (*) COPY84 1-Jun-1993 15:34:18 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:46:17 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY84.FOR;3 COMMAND QUALIFIERS FOR/LIS COPY84.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY84.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY84.OBJ;2 COMPILATION STATISTICS Run Time: 0.22 seconds Elapsed Time: 2.43 seconds Page Faults: 213 Dynamic Memory: 456 pages 1-Jun-1993 15:34:25 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:46:54 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY88.FOR;4 0001 subroutine copy88(from,to,n) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 0012 real*8 from(N) 0013 real*8 to(N) 0014 do i=1,n 0015 to(i)=from(i) 0016 end do 0017 return 0018 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 88 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 172 ENTRY POINTS Address Type Name 0-00000000 COPY88 VARIABLES Address Type Name Address Type Name ** I*4 I AP-0000000C@ I*4 N ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 FROM ** (*) AP-00000008@ R*8 TO ** (*) COPY88 1-Jun-1993 15:34:25 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:46:54 NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY88.FOR;4 COMMAND QUALIFIERS FOR/LIS COPY88.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY88.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]COPY88.OBJ;2 COMPILATION STATISTICS Run Time: 0.33 seconds Elapsed Time: 4.98 seconds Page Faults: 192 Dynamic Memory: 456 pages 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0001 C$Procedure CRM 0002 C 0003 SUBROUTINE CRM 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 12-JUL-1990 Eric Cannell creation of CRM 0019 C 7-MAY-1991 Bruce Shapiro invoke MEAN orbital density 0020 C 28-OCT-1991 B.E.S include error bars on solar/geomag data 0021 C 0022 C$ Purpose 0023 C 0024 C CRM is the main subroutine point for entry points CRMINI and CRMGET. 0025 C The user should NEVER call CRM, only the entry points CRMINI and CRMGET. 0026 C 0027 C CRMINI computed and saved daily ratios of: 0028 C 0029 C Cd * density 0030 C ------------ 0031 C mass 0032 C 0033 C where density is based upon the information in the FLUX_DATA file. This 0034 C can be done right after the FLUX_DATA file is read. I am computing this 0035 C ratio, rather than just density, in order to avoid having to pass CD and 0036 C MASS all over Hell. Note that the daily ratios values are stored in a 0037 C SAVEd array. 0038 C 0039 C CRMGET determines the ratio value for a particular epoch. Note that 0040 C daily values are somewhat of a misnomer, since density is constantly 0041 C changing. Also, the input DATE will likely be at some arbitrary time 0042 C during a particular day. CRMGET ignores the hour of the day and returns 0043 C the ratio for that day, regardless of the time of day. 0044 C 0045 C$ Input_Arguments 0046 C 0047 C Entry Point: CRMINI 0048 C Name Type Dim Units Description 0049 C ----------------------------------------------------------------------------- 0050 C DAYS I 1 - number of daily values 0051 C DAYONE C*(*) 1 - epoch ('dd-mmm-yyyy') of the first day 0052 C FLX DP DAYS --> daily 10.7 solar flux values in 0053 C 10**-22 watts/m**2/cycle/sec 0054 C FLXBAR DP DAYS --> daily 81 day moving average of FLX 0055 C in 10**-22 watts/m**2/cycle/sec 0056 C KP DP DAYS - geomagnetic Kp planetary index 0057 C CD DP 1 - constant of atmospheric drag on spacecraft 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0058 C MASS DP 1 kg mass of spacecraft 0059 C DFLX DP DAYS - error bar on FLX 0060 C DFLXBAR DP DAYS - error bar on FLX 0061 C DKP DP DAYS - error bar on FLX 0062 C 0063 C 0064 C Entry Point: CRMGET 0065 C Name Type Dim Units Description 0066 C ----------------------------------------------------------------------------- 0067 C DATE C*(*) 1 - day of desired density, 'dd-mmm-yyyy' 0068 C 0069 C$ Output_Arguments 0070 C 0071 C Entry Point: CRMGET 0072 C Name Type Dim Units Description 0073 C ----------------------------------------------------------------------------- 0074 C CRMVAL DP 1 km**-3 Cd * density / MASS for DATE 0075 C CRMVALHI DP 1 km**-3 high value 0076 C CRMVALLO DP 1 km**-3 lo value 0077 C 0078 C$ Restrictions 0079 C 0080 C 1] If CRMGET is called with a DATE that is not within the time period 0081 C covered by the FLUX_DATA file, then an error message is printed and 0082 C GTARG is terminated. 0083 C 0084 C 2] Both CD and MASS must be > 0. 0085 C 0086 C$ References 0087 C 0088 C 1] Cannell, P.E., "JRSMPL- A Simple Fortran Function to Approximate 0089 C Atmospheric Density", JPL-IOM 314.9/90-481, 13 Jun 1990. 0090 C 0091 C$ Library_Links 0092 C 0093 C Entry Point Name Location 0094 C ----------------------------------------------------------------------------- 0095 C CAL2JD TIMETRANS 0096 C CH2JD TIMETRANS 0097 C jrsmpl2 jrsmpl2 0098 C 0099 C$ Files 0100 C 0101 C File Name Unit Number Description 0102 C ----------------------------------------------------------------------------- 0103 C * * standard I/O 0104 C OFILE 8 text output file 0105 C 0106 C$ Parameters 0107 C 0108 INTEGER MXFLUX 0109 PARAMETER ( MXFLUX = 1000 ) 0110 C 0111 C$ Declarations_of_Input_and_Output_Arguments 0112 C 0113 C Input for CRMINI. 0114 C CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0115 DOUBLE PRECISION CD 0116 INTEGER DAYS 0117 CHARACTER*(*) DAYONE 0118 DOUBLE PRECISION DFLX ( DAYS ) 0119 DOUBLE PRECISION DFLXBAR ( DAYS ) 0120 DOUBLE PRECISION DKP ( DAYS ) 0121 DOUBLE PRECISION FLX ( DAYS ) 0122 DOUBLE PRECISION FLXBAR ( DAYS ) 0123 DOUBLE PRECISION KP ( DAYS ) 0124 DOUBLE PRECISION MASS 0125 0126 C Input for CRMGET. 0127 0128 CHARACTER*(*) DATE 0129 DOUBLE PRECISION CRMVAL 0130 DOUBLE PRECISION CRMVALHI 0131 DOUBLE PRECISION CRMVALLO 0132 C 0133 C$ Declarations_of_Local_Variables 0134 C 0135 CHARACTER*11 DMY 0136 DOUBLE PRECISION LOFLUX, LOFBAR, LOKP 0137 DOUBLE PRECISION HIFLUX, HIFBAR, HIKP 0138 double precision DCRM_flux,DCRM_fbar,dCRM_kp 0139 LOGICAL ERROR 0140 INTEGER IDAY 0141 integer iday_now 0142 integer ihour_now 0143 integer iminute_now 0144 integer imonth_now 0145 integer isecond_now 0146 INTEGER iyear_now 0147 real*8 jd_jan0 0148 real*8 jd_now 0149 real*8 jd_one 0150 real*8 frac_now 0151 real*8 fractional_year 0152 C 0153 C$ Save_Statements 0154 C 0155 INTEGER OFFSET 0156 SAVE OFFSET 0157 0158 INTEGER MAXDAY 0159 SAVE MAXDAY 0160 0161 DOUBLE PRECISION CRMDAT ( MXFLUX ) 0162 SAVE CRMDAT 0163 0164 DOUBLE PRECISION CRMDATHI ( MXFLUX ) 0165 SAVE CRMDATHI 0166 0167 DOUBLE PRECISION CRMDATLO ( MXFLUX ) 0168 SAVE CRMDATLO 0169 C 0170 C$ External_Statements 0171 C CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0172 DOUBLE PRECISION CAL2JD 0173 EXTERNAL CAL2JD 0174 0175 DOUBLE PRECISION CH2JD 0176 EXTERNAL CH2JD 0177 0178 DOUBLE PRECISION JRSMPL2 0179 EXTERNAL JRSMPL2 0180 C 0181 C$ Method 0182 C-& 0183 0184 C******************************************************************************* 0185 C******************************************************************************* 0186 C*** *** 0187 C*** Main Entry Point CRM *** 0188 C*** *** 0189 C******************************************************************************* 0190 C******************************************************************************* 0191 0192 C1 The user must never call CRM, only the entry points CRMINI and CRMGET. 0193 0194 WRITE(*,301) 0195 WRITE(8,301) 0196 301 FORMAT(//,1X,'GTARG: Call CRMINI or CRMGET, but never call CRM.') 0197 0198 STOP 0199 0200 C******************************************************************************* 0201 C******************************************************************************* 0202 C*** *** 0203 C*** Entry Point CRMINI *** 0204 C*** *** 0205 C******************************************************************************* 0206 C******************************************************************************* 0207 0208 C1 Entry point CRMINI: 0209 0210 ENTRY CRMINI( DAYS , DAYONE , FLX , FLXBAR , KP , CD , MASS, 0211 & DFLX, DFLXBAR, DKP ) 0212 0213 C2 Check that CD is > 0. 0214 0215 IF ( CD .LE. 0D0 ) THEN 0216 WRITE(*,302) CD 0217 WRITE(8,302) CD 0218 302 FORMAT(//,1X,'GTARG: CD (',D24.18,') must be > 0.') 0219 STOP 0220 END IF 0221 0222 C2 Check that MASS is > 0. 0223 0224 IF ( MASS .LE. 0D0 ) THEN 0225 WRITE(*,303) MASS 0226 WRITE(8,303) MASS 0227 303 FORMAT(//,1X,'GTARG: MASS (',D24.18,') must be > 0.') 0228 STOP CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0229 END IF 0230 0231 C2===> 5/7/91 Mod B.E.S. 0232 0233 C 0234 C Determine julian day at the start of the calculation 0235 C 0236 DMY = DAYONE 0237 jd_one = CH2JD(DMY,.TRUE.,ERROR) 0238 0239 C2 Compute and save ratio of CD * rho / MASS. 0240 0241 DO 101 IDAY = 1 , DAYS 0242 0243 C 0244 C Determine the fraction of the current year 0245 C 0246 jd_now = jd_one + dfloat ( iday - 1 ) 0247 0248 call jd2cal ( jd_now, 0249 & iyear_now, imonth_now, iday_now, ihour_now, 0250 & iminute_now, isecond_now, frac_now ) 0251 0252 jd_jan0 = cal2jd (iyear_now, 1, 1, 0, 0, 0, 0.0) - 1.0 0253 0254 if ( mod (iyear_now, 4) .eq. 0 ) then 0255 fractional_year = (jd_now - jd_jan0)/366.0 0256 else 0257 fractional_year = (jd_now - jd_jan0)/365.0 0258 end if 0259 0260 CD write (8,99) iday, iyear_now, imonth_now, iday_now, 0261 CD & jd_now-jd_jan0, fractional_year 0262 99 format (1x, 4i10, 2g15.8) 0263 0264 CRMDAT( IDAY ) = CD 0265 & * JRSMPL2( FLX ( IDAY ) , 0266 & FLXBAR( IDAY ) , 0267 & KP ( IDAY ) , 0268 & fractional_year 0269 & ) 0270 & / MASS 0271 C 0272 C calculate the CRM errors due to the sigmas in each of 0273 C the components F, FBAR, KP 0274 C 0275 HIFLUX = FLX ( IDAY )+DFLX(IDAY) 0276 HIFBAR = FLXBAR( IDAY )+DFLXBAR(IDAY) 0277 HIKP = KP (IDAY) + DKP(IDAY) 0278 0279 DCRM_FLUX = CD * JRSMPL2( HIFLUX, FLXBAR(IDAY), KP(IDAY), 0280 & fractional_year) / MASS - CRMDAT(IDAY) 0281 DCRM_FBAR = CD * JRSMPL2( FLX(IDAY), HIFBAR, KP(IDAY) , 0282 & fractional_year) / MASS - CRMDAT(IDAY) 0283 DCRM_KP = CD * JRSMPL2( FLX(IDAY), FLXBAR(IDAY), HIKP, 0284 & fractional_year) / MASS - CRMDAT(IDAY) 0285 C CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 6 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0286 C RSS the three density variations to get the total 0287 C density sigma 0288 C 0289 CRMDATHI( IDAY ) = CRMDAT(IDAY) + 0290 & SQRT ( DCRM_FLUX**2 + DCRM_FBAR**2 + DCRM_KP**2 ) 0291 0292 C CRMDATHI( IDAY ) = CD 0293 C & * JRSMPL2( FLX ( IDAY )+DFLX(IDAY) , 0294 C & FLXBAR( IDAY )+DFLXBAR(IDAY) , 0295 C & KP ( IDAY )+DKP(IDAY) , 0296 C & fractional_year 0297 C & ) 0298 C & / MASS 0299 0300 C 0301 C calculate the CRM errors due to the sigmas in each of 0302 C the components F, FBAR, KP in the low density 0303 C direction 0304 C 0305 LOFLUX = DMIN1( DMAX1( FLX(IDAY)-DFLX(IDAY), 70.0d0), 0306 & FLX(IDAY) ) 0307 LOFBAR = DMIN1( DMAX1( FLXBAR(IDAY)-DFLXBAR(IDAY), 70.0d0 ), 0308 & FLXBAR(IDAY)) 0309 LOKP = DMIN1( DMAX1( KP(IDAY)-DKP(IDAY), 1.0d0 ), KP(IDAY)) 0310 0311 C CRMDATLO( IDAY ) = CD 0312 C & * JRSMPL2( LOFLUX, 0313 C & LOFBAR, LOKP, 0314 C & fractional_year 0315 C & ) 0316 C & / MASS 0317 0318 DCRM_FLUX = CD * JRSMPL2( LOFLUX, FLXBAR(IDAY), KP(IDAY), 0319 & fractional_year) / MASS - CRMDAT(IDAY) 0320 DCRM_FBAR = CD * JRSMPL2( FLX(IDAY), LOFBAR, KP(IDAY) , 0321 & fractional_year) / MASS - CRMDAT(IDAY) 0322 DCRM_KP = CD * JRSMPL2( FLX(IDAY), FLXBAR(IDAY), LOKP, 0323 & fractional_year) / MASS - CRMDAT(IDAY) 0324 C 0325 C RSS the three density variations to get the total 0326 C density sigma 0327 C 0328 CRMDATLO( IDAY ) = CRMDAT(IDAY) - 0329 & SQRT ( DCRM_FLUX**2 + DCRM_FBAR**2 + DCRM_KP**2 ) 0330 0331 101 CONTINUE 0332 0333 C2=====> end mod 5/7/91 0334 0335 C2 Determine and save the Julian date offset into the data array 0336 C2 so that for any other date: index = date - offset. 0337 0338 DMY = DAYONE 0339 OFFSET = IDNINT( CH2JD(DMY,.TRUE.,ERROR) - .5D0 ) 0340 0341 C2 Save the number of days in the date array. 0342 CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 7 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 0343 MAXDAY = DAYS 0344 0345 C2 Return from CRMINI. 0346 0347 RETURN 0348 0349 C******************************************************************************* 0350 C******************************************************************************* 0351 C*** *** 0352 C*** Entry Point CRMGET *** 0353 C*** *** 0354 C******************************************************************************* 0355 C******************************************************************************* 0356 0357 C1 Entry point CRMGET: 0358 0359 ENTRY CRMGET( DATE , CRMVAL, CRMVALHI, CRMVALLO ) 0360 0361 C2 Determine the index into the ratio array. 0362 0363 DMY = DATE 0364 IDAY = IDNINT( CH2JD(DMY,.TRUE.,ERROR) + .5D0 ) - OFFSET 0365 0366 C2 Check that DATE is within the time period covered by the data. 0367 0368 IF ( IDAY .LT. 1 .OR. MAXDAY .LT. IDAY ) THEN 0369 0370 WRITE(8,304) DMY , IDAY 0371 WRITE(*,304) DMY , IDAY 0372 304 FORMAT(//,1X,'GTARG: FLUX_DATA does not cover "',A11, 0373 & '" (index ',I5,').') 0374 0375 STOP 0376 0377 END IF 0378 0379 C2 Access ratio from saved data array. 0380 0381 CRMVAL = CRMDAT( IDAY ) 0382 CRMVALHI = CRMDATHI( IDAY ) 0383 CRMVALLO = CRMDATLO( IDAY ) 0384 0385 C2 Return from CRMGET. 0386 0387 RETURN 0388 0389 C1 End of CRM. 0390 0391 END CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 8 01 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1207 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 207 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 24656 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 26070 ENTRY POINTS Address Type Name Address Type Name Address Type Name 0-00000000 CRM 0-00000371 CRMGET 0-00000040 CRMINI VARIABLES Address Type Name Address Type Name AP-00000018@ R*8 CD AP-00000008@ R*8 CRMVAL AP-0000000C@ R*8 CRMVALHI AP-00000010@ R*8 CRMVALLO AP-00000004@ CHAR DATE AP-00000008@ CHAR DAYONE AP-00000004@ I*4 DAYS ** R*8 DCRM_FBAR ** R*8 DCRM_FLUX ** R*8 DCRM_KP 2-00005DC0 CHAR DMY 2-00005E20 L*4 ERROR 2-00005E18 R*8 FRACTIONAL_YEAR 2-00005E10 R*8 FRAC_NOW 2-00005DF0 R*8 HIFBAR 2-00005DE8 R*8 HIFLUX 2-00005DF8 R*8 HIKP ** I*4 IDAY 2-00005E24 I*4 IDAY_NOW 2-00005E28 I*4 IHOUR_NOW 2-00005E2C I*4 IMINUTE_NOW 2-00005E30 I*4 IMONTH_NOW 2-00005E34 I*4 ISECOND_NOW 2-00005E38 I*4 IYEAR_NOW ** R*8 JD_JAN0 2-00005E00 R*8 JD_NOW 2-00005E08 R*8 JD_ONE 2-00005DD8 R*8 LOFBAR 2-00005DD0 R*8 LOFLUX 2-00005DE0 R*8 LOKP AP-0000001C@ R*8 MASS 2-00005E40 I*4 MAXDAY 2-00005E3C I*4 OFFSET ARRAYS Address Type Name Bytes Dimensions 2-00000000 R*8 CRMDAT 8000 (1000) 2-00001F40 R*8 CRMDATHI 8000 (1000) 2-00003E80 R*8 CRMDATLO 8000 (1000) AP-00000020@ R*8 DFLX ** (*) AP-00000024@ R*8 DFLXBAR ** (*) AP-00000028@ R*8 DKP ** (*) AP-0000000C@ R*8 FLX ** (*) AP-00000010@ R*8 FLXBAR ** (*) AP-00000014@ R*8 KP ** (*) CRM 1-Jun-1993 15:34:39 VAX FORTRAN V5.6-119 Page 9 01 21-Jan-1993 19:47:59 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.FOR;20 LABELS Address Label Address Label Address Label Address Label Address Label Address Label ** 99' ** 101 1-00000010 301' 1-00000048 302' 1-0000006D 303' 1-00000094 304' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name R*8 CAL2JD R*8 CH2JD JD2CAL R*8 JRSMPL2 R*8 MTH$DSQRT COMMAND QUALIFIERS FOR/LIS CRM.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CRM.OBJ;2 COMPILATION STATISTICS Run Time: 0.83 seconds Elapsed Time: 6.24 seconds Page Faults: 346 Dynamic Memory: 584 pages 1-Jun-1993 15:34:49 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:49:19 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CROSS.FOR;2 0001 Subroutine cross(a,b,c) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C Computes Vector Cross Product 0012 C 0013 0014 double precision a(3), b(3), c(3) 0015 0016 c(1)=a(2)*b(3)-b(2)*a(3) 0017 c(2)=a(3)*b(1)-b(3)*a(1) 0018 c(3)=a(1)*b(2)-b(1)*a(2) 0019 0020 return 0021 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 106 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 60 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 166 ENTRY POINTS Address Type Name 0-00000000 CROSS ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 A 24 (3) AP-00000008@ R*8 B 24 (3) AP-0000000C@ R*8 C 24 (3) 1-Jun-1993 15:34:49 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:49:19 NAVDEV:[SHAPIRO.COSMIC.SOURCE]CROSS.FOR;2 0001 COMMAND QUALIFIERS FOR/LIS CROSS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CROSS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]CROSS.OBJ;2 COMPILATION STATISTICS Run Time: 0.28 seconds Elapsed Time: 2.66 seconds Page Faults: 209 Dynamic Memory: 456 pages 1-Jun-1993 15:34:55 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:50:12 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCLOSE.FOR;3 0001 C$Procedure DCLOSE 0002 C 0003 INTEGER FUNCTION DCLOSE ( DVAL , NELTS , DARRAY ) 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C 0014 C$ Log 0015 C 0016 C 26-FEB-1990 - Eric Cannell - creation 0017 C 0018 C$ Purpose 0019 C 0020 C DCLOSE returns the index of the element of DARRAY that is closest in 0021 C value to DVAL. 0022 C 0023 C$ Input_Arguments 0024 C 0025 C Name Type Dim Units Description 0026 C ----------------------------------------------------------------------------- 0027 C DVAL DP 1 - anchor value 0028 C NELTS I 1 - number of elements in DARRAY 0029 C DARRAY DP * - array of values against which DVAL 0030 C is compared 0031 C 0032 C$ Output_Arguments 0033 C 0034 C Name Type Dim Units Description 0035 C ----------------------------------------------------------------------------- 0036 C DCLOSE I 1 - index of the element of DARRAY that is 0037 C closest in value to DVAL 0038 C 0039 C$ Declarations_of_Input_and_Output_Arguments 0040 C 0041 DOUBLE PRECISION DARRAY ( * ) 0042 DOUBLE PRECISION DVAL 0043 INTEGER NELTS 0044 C 0045 C$ Declarations_of_Local_Variables 0046 C 0047 DOUBLE PRECISION DIFF1 0048 DOUBLE PRECISION DIFF2 0049 INTEGER I 0050 INTEGER IDIFF 0051 C 0052 C$ Method 0053 C-& 0054 0055 C1 Compute the difference for the first element. 0056 0057 IDIFF = 1 DCLOSE 1-Jun-1993 15:34:55 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:50:12 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCLOSE.FOR;3 0058 DIFF1 = DABS( DVAL - DARRAY(1) ) 0059 0060 C1 Check the remaining elements of DARRAY for one closer to DVAL. 0061 0062 DO 101 I = 2 , NELTS 0063 0064 DIFF2 = DABS( DVAL - DARRAY(I) ) 0065 0066 IF ( DIFF2 .LT. DIFF1 ) THEN 0067 IDIFF = I 0068 DIFF1 = DIFF2 0069 END IF 0070 0071 101 CONTINUE 0072 0073 C1 Return the index of the closted element. 0074 0075 DCLOSE = IDIFF 0076 0077 RETURN 0078 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 93 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 24 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 117 ENTRY POINTS Address Type Name 0-00000000 I*4 DCLOSE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 DIFF1 ** R*8 DIFF2 AP-00000004@ R*8 DVAL ** I*4 I ** I*4 IDIFF AP-00000008@ I*4 NELTS ARRAYS Address Type Name Bytes Dimensions AP-0000000C@ R*8 DARRAY ** (*) DCLOSE 1-Jun-1993 15:34:55 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 19:50:12 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCLOSE.FOR;3 LABELS Address Label ** 101 COMMAND QUALIFIERS FOR/LIS DCLOSE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCLOSE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCLOSE.OBJ;2 COMPILATION STATISTICS Run Time: 0.30 seconds Elapsed Time: 3.01 seconds Page Faults: 221 Dynamic Memory: 456 pages 1-Jun-1993 15:35:02 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:55:08 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCPVAL.FOR;3 0001 double precision function DCPVAL ( P, N, T ) 0002 C 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C emulates DCPVAL to remove GTARG's dependence on MATH-77 0013 C restriction: N < 10 0014 C (not tested for N>2 ,since GTARG only uses N=2) 0015 C will cause program to halt of p(2) = 0 0016 C reference: "MATH77 Release 3.0: A library of Mathematical 0017 C Subprograms for FORTRAN 77", JPL Applied 0018 C Mathematics Group, May 1989, JPL D-1341 0019 C 0020 C DCPVAL evaluates a polynomial which is represented by 0021 C coefficients relative to a Chebyshev basis. 0022 C 0023 C B. Shapiro 11/18/92 0024 C 0025 C Only enough of DCPVAL is emulated to evaluate the atmospheric 0026 C density polynomial. This is not a complete emulation of DCPVAL. 0027 C 0028 integer n 0029 double precision p(*) 0030 double precision t, u, z(10) 0031 0032 if (n.gt.10) n=10 0033 0034 if (p(2).eq.0.0d0) then 0035 write(8,*) 'Invalid value p(2) = 0.' 0036 stop ' Error Exit.' 0037 end if 0038 0039 u = ( t-p(1) ) / p(2) 0040 z(n) = p(n+3) 0041 z(n-1) = 2*u*z(n)+p(n+2) 0042 if (n.gt.2) then 0043 do i = n-2,1,-1 0044 z(i) = 2*u*z(i+1) - z(i+2) + p(i+3) 0045 end do 0046 end if 0047 0048 dcpval = u * z(1) - z(2) + p(3) 0049 0050 return 0051 end DCPVAL 1-Jun-1993 15:35:02 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 19:55:08 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCPVAL.FOR;3 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 180 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 35 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 124 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 339 ENTRY POINTS Address Type Name 0-00000000 R*8 DCPVAL VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I AP-00000008@ I*4 N AP-0000000C@ R*8 T ** R*8 U ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 P ** (*) 2-00000000 R*8 Z 80 (10) COMMAND QUALIFIERS FOR/LIS DCPVAL.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCPVAL.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DCPVAL.OBJ;2 COMPILATION STATISTICS Run Time: 0.35 seconds Elapsed Time: 5.79 seconds Page Faults: 235 Dynamic Memory: 488 pages 1-Jun-1993 15:35:12 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 19:56:58 [SHAPIRO.COSMIC.SOURCE]DISPLAY_LIMITS.FOR;6 0001 subroutine display_limits ( line, column, limits, 0002 & limits_west, limits_east, label ) 0003 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C writes the summary of the current targeting iteration to the screen. 0014 C B. E. S. 9/6/91 0015 C 0016 integer line, column, i 0017 0018 double precision limits (4, 2) 0019 double precision limits_west (4, 2) 0020 double precision limits_east (4, 2) 0021 0022 logical label 0023 0024 external goto_string 0025 character*8 goto_string 0026 0027 if ( label ) then 0028 write(6,100) goto_string(line+2,1),'1st Node', 0029 & goto_string(line+3,1),'Furthest West', 0030 & goto_string(line+4,1),'Furthest East', 0031 & goto_string(line+5,1),'Final Node' 0032 0033 write(6,200) goto_string(line,1),' ', 0034 & goto_string(line,15), '---- Unbiased ----', 0035 & goto_string(line,35), '---- 95% West ----', 0036 & goto_string(line,55), '---- 95% East ----' 0037 0038 write(6,300) goto_string(line+1,15),'Time', 0039 & goto_string(line+1,25),'GT', 0040 & goto_string(line+1,35),'Time', 0041 & goto_string(line+1,45),'GT', 0042 & goto_string(line+1,55),'Time', 0043 & goto_string(line+1,65),'GT' 0044 end if 0045 0046 DO i=1,4 0047 write(6,400) goto_string(line+1+i,15), Limits(i,1), 0048 & goto_string(line+1+i,25), Limits(i,2), 0049 & goto_string(line+1+i,35), Limits_west(i,1), 0050 & goto_string(line+1+i,45), Limits_west(i,2), 0051 & goto_string(line+1+i,55), Limits_east(i,1), 0052 & goto_string(line+1+i,65), Limits_east(i,2) 0053 end do 0054 100 format(' ',4(a8,a14)) 0055 200 format(' ',a8,a14, 3(a8,a20)) 0056 300 format(' ',6(a8,a10)) 0057 400 format(' ',12(a8,f10.5)) DISPLAY_LIMITS 1-Jun-1993 15:35:12 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 19:56:58 [SHAPIRO.COSMIC.SOURCE]DISPLAY_LIMITS.FOR;6 0058 0059 return 0060 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1334 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 190 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 812 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 2336 ENTRY POINTS Address Type Name 0-00000000 DISPLAY_LIMITS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 COLUMN ** I*4 I AP-00000018@ L*4 LABEL AP-00000004@ I*4 LINE ARRAYS Address Type Name Bytes Dimensions AP-0000000C@ R*8 LIMITS 64 (4, 2) AP-00000014@ R*8 LIMITS_EAST 64 (4, 2) AP-00000010@ R*8 LIMITS_WEST 64 (4, 2) LABELS Address Label Address Label Address Label Address Label 1-00000085 100' 1-00000092 200' 1-000000A3 300' 1-000000B0 400' FUNCTIONS AND SUBROUTINES REFERENCED Type Name CHAR GOTO_STRING DISPLAY_LIMITS 1-Jun-1993 15:35:12 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 19:56:58 [SHAPIRO.COSMIC.SOURCE]DISPLAY_LIMITS.FOR;6 COMMAND QUALIFIERS FOR/LIS DISPLAY_LIMITS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DISPLAY_LIMITS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DISPLAY_LIMITS.OBJ;2 COMPILATION STATISTICS Run Time: 0.49 seconds Elapsed Time: 3.35 seconds Page Faults: 242 Dynamic Memory: 504 pages 1-Jun-1993 15:35:19 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:49:40 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.FOR;15 0001 C$Procedure DOMNVR 0002 C 0003 SUBROUTINE DOMNVR ( OPRE , DV , PITCH , YAW , OPOST , DVVEC, 0004 * DVLCR ) 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C 0015 C$ Log 0016 C 0017 C 19-Oct-1989 - Eric Cannell - creation of DVDORB Program 0018 C 1-MAR-1990 - Eric Cannell - hacked DVDORB to get this routine 0019 C 12-MAR-1990 - Eric Cannell - changed algorithm to add dV to Cartesian 0020 C state 0021 C 9-APR-1992 - Bruce Shapiro - include DVLCR as return parameter 0022 C 0023 C$ Purpose 0024 C 0025 C DOMNVR determines the change in the classical orbital elements due 0026 C to a maneuver defined by a magnitude, pitch, and yaw. 0027 C 0028 C$ Input_Arguments 0029 C 0030 C Name Type Dim Units Description 0031 C ----------------------------------------------------------------------------- 0032 C OPRE DP 6 km,deg pre-maneuver orbit (a,e,i,LAN,w,M) 0033 C DV DP 1 m/sec maneuver magnitude 0034 C PITCH DP 1 deg maneuver pitch angle 0035 C YAW DP 1 deg maneuver yaw angle 0036 C 0037 C$ Output_Arguments 0038 C 0039 C Name Type Dim Units Description 0040 C ----------------------------------------------------------------------------- 0041 C OPOST DP 6 km,deg post-maneuver orbit (a,e,i,LAN,w,M) 0042 C DVVEC DP 3 m/sec inertial dV applied (dvx,dvy,dvz) 0043 C DVLCR DP 3 m/sec dv in long track,cross track, radial 0044 C 0045 C$ Parameters 0046 C 0047 DOUBLE PRECISION PI 0048 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0049 0050 DOUBLE PRECISION D2R 0051 PARAMETER ( D2R = PI / 180.0D0 ) 0052 C 0053 C$ Declarations_of_Input_and_Output_Arguments 0054 C 0055 DOUBLE PRECISION DV 0056 DOUBLE PRECISION DVVEC ( 3 ) 0057 double precision dvlcr ( 3 ) DOMNVR 1-Jun-1993 15:35:19 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:49:40 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.FOR;15 0058 INTEGER I 0059 DOUBLE PRECISION OPRE ( 6 ) 0060 DOUBLE PRECISION OPOST ( 6 ) 0061 DOUBLE PRECISION PITCH 0062 DOUBLE PRECISION YAW 0063 C 0064 C$ Declarations_of_Local_Variables 0065 C 0066 DOUBLE PRECISION DVC 0067 DOUBLE PRECISION DVL 0068 DOUBLE PRECISION DVR 0069 DOUBLE PRECISION GM 0070 DOUBLE PRECISION J2 0071 DOUBLE PRECISION P ( 3 ) 0072 DOUBLE PRECISION R ( 3 ) 0073 DOUBLE PRECISION RP 0074 DOUBLE PRECISION RR 0075 DOUBLE PRECISION STATE ( 6 ) 0076 DOUBLE PRECISION Y ( 3 ) 0077 C 0078 C$ External_Statements 0079 C 0080 DOUBLE PRECISION RNG360 0081 EXTERNAL RNG360 0082 0083 C - via namelist $constants, in block physical_constants 0084 C 0085 double precision earth_rad ! in kilomters 0086 double precision mu_earth ! km**3/sec 0087 double precision mu_moon ! km**3/sec 0088 double precision mu_sun ! km**3/sec 0089 double precision sid_day ! seconds 0090 C 0091 C - derived constants, in block physical_constants 0092 C 0093 double precision earth_freq ! radians / second 0094 double precision earth_rate ! meters / day 0095 double precision deg_to_km ! kilometers/deg 0096 0097 common / physical_constants / 0098 & earth_rad, earth_freq, earth_rate, mu_earth, 0099 & mu_moon, mu_sun, sid_day, deg_to_km 0100 0101 0102 0103 C 0104 C$ Method 0105 C-& 0106 0107 C1 Set up MASL*VECTOR for Earth as central body. 0108 0109 C CALL MVINFO( 'EARTH' , ' ' , GM , J2 , RP , RR ) 0110 0111 C1 Convert classical elements (a,e,i,LAN,w,M) to Cartesian state 0112 C1 (x,y,z,vx,vy,vz). 0113 0114 C CALL ORBIN ( OPRE , 11 ) DOMNVR 1-Jun-1993 15:35:19 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:49:40 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.FOR;15 0115 C CALL ORBOUT( STATE , 112 ) 0116 0117 GM = MU_EARTH 0118 CALL KEP2CAR ( OPRE, STATE, GM ) 0119 0120 C1 Compute the yaw axis. 0121 0122 C CALL VUNIT( Y , STATE , 3 ) 0123 C CALL VNEG ( Y , Y , 3 ) 0124 0125 DO I=1,3 0126 Y(I) = -STATE(I) 0127 END DO 0128 CALL UNIT (Y, Y) 0129 0130 C1 Compute the pitch axis. 0131 0132 C CALL UCROSS( P , Y , STATE(4) ) 0133 CALL CROSS (Y, STATE(4), P) 0134 CALL UNIT (P, P) 0135 0136 C1 Compute the roll axis. 0137 0138 C CALL UCROSS( R , P , Y ) 0139 CALL CROSS ( P, Y, R) 0140 CALL UNIT( R, R) 0141 0142 C1 Compute delta-V in L-C-R. 0143 0144 DVL = DV * DCOS( D2R * PITCH ) * DCOS( D2R * YAW ) / 1.0D3 0145 DVC = DV * DCOS( D2R * PITCH ) * DSIN( D2R * YAW ) / 1.0D3 0146 DVR = DV * DSIN( D2R * PITCH ) / 1.0D3 0147 0148 dvlcr(1) = dvl 0149 dvlcr(2) = dvc 0150 dvlcr(3) = dvr 0151 0152 C1 Scale the yaw, pitch, and roll axes with dV. 0153 0154 C CALL VSCALE( Y , Y , DVR , 3 ) 0155 C CALL VSCALE( P , P , DVC , 3 ) 0156 C CALL VSCALE( R , R , DVL , 3 ) 0157 0158 DO I=1,3 0159 Y(I) = Y(I) * DVR 0160 P(I) = P(I) * DVC 0161 R(I) = R(I) * DVL 0162 END DO 0163 0164 C1 Add the dV to the state velocity. 0165 0166 DO 101 I = 1 , 3 0167 DVVEC(I ) = Y(I) + P(I) + R(I) 0168 STATE(I+3) = STATE(I+3) + DVVEC(I) 0169 101 CONTINUE 0170 0171 C1 Convert the new state to classical elements. DOMNVR 1-Jun-1993 15:35:19 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:49:40 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.FOR;15 0172 0173 C CALL ORBIN ( STATE , 112 ) 0174 C CALL ORBOUT( OPOST , 11 ) 0175 0176 CALL CAR2KEP ( STATE, OPOST, GM ) 0177 0178 C1 Make sure that LAN, w, and M are in range of 0..360. 0179 0180 OPOST(4) = RNG360( OPOST(4) ) 0181 OPOST(5) = RNG360( OPOST(5) ) 0182 OPOST(6) = RNG360( OPOST(6) ) 0183 0184 C1 Convert dV vector to meter/sec. 0185 0186 C CALL VSCALE( DVVEC , DVVEC , 1D3 , 3 ) 0187 0188 DO I=1,3 0189 DVVEC(I) = 1000.0D0 * DVVEC(I) 0190 END DO 0191 0192 RETURN 0193 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 412 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 332 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 808 ENTRY POINTS Address Type Name 0-00000000 DOMNVR VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000038 R*8 DEG_TO_KM AP-00000008@ R*8 DV ** R*8 DVC ** R*8 DVL ** R*8 DVR 3-00000008 R*8 EARTH_FREQ 3-00000000 R*8 EARTH_RAD 3-00000010 R*8 EARTH_RATE 2-00000078 R*8 GM ** I*4 I ** R*8 J2 3-00000018 R*8 MU_EARTH 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN AP-0000000C@ R*8 PITCH ** R*8 RP ** R*8 RR 3-00000030 R*8 SID_DAY AP-00000010@ R*8 YAW DOMNVR 1-Jun-1993 15:35:19 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 20:49:40 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.FOR;15 ARRAYS Address Type Name Bytes Dimensions AP-0000001C@ R*8 DVLCR 24 (3) AP-00000018@ R*8 DVVEC 24 (3) AP-00000014@ R*8 OPOST 48 (6) AP-00000004@ R*8 OPRE 48 (6) 2-00000000 R*8 P 24 (3) 2-00000018 R*8 R 24 (3) 2-00000030 R*8 STATE 48 (6) 2-00000060 R*8 Y 24 (3) LABELS Address Label ** 101 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name CAR2KEP CROSS KEP2CAR R*8 MTH$DCOS R*8 MTH$DSIN R*8 RNG360 UNIT COMMAND QUALIFIERS FOR/LIS DOMNVR.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOMNVR.OBJ;2 COMPILATION STATISTICS Run Time: 0.45 seconds Elapsed Time: 3.21 seconds Page Faults: 266 Dynamic Memory: 504 pages 1-Jun-1993 15:35:26 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:50:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOT.FOR;3 0001 double precision function dot(x, y) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C computes vector dot product 0012 0013 0014 double precision x(3), y(3) 0015 0016 dot = x(1)*y(1) + x(2)*y(2) + x(3)*y(3) 0017 0018 return 0019 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 67 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 115 ENTRY POINTS Address Type Name 0-00000000 R*8 DOT ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 X 24 (3) AP-00000008@ R*8 Y 24 (3) DOT 1-Jun-1993 15:35:26 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 20:50:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOT.FOR;3 COMMAND QUALIFIERS FOR/LIS DOT.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOT.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DOT.OBJ;2 COMPILATION STATISTICS Run Time: 0.28 seconds Elapsed Time: 2.86 seconds Page Faults: 207 Dynamic Memory: 456 pages 1-Jun-1993 15:35:32 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:50:58 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.FOR;13 0001 C$Procedure DVEAST 0002 C 0003 SUBROUTINE DVEAST ( CLSOLD , CLSNOW , 0004 & DVOLD , DVNOW , 0005 & TMEOLD , TMENOW , TARGET 0006 & ) 0007 C 0008 C 0009 C******************************************************************************* 0010 C 0011 C Copyright (C) 1993, California Institute of Technology. U.S. 0012 C Government Sponsorhip under NASA Contract NAS7-918 is 0013 C acknowledged. 0014 C 0015 C******************************************************************************* 0016 C 0017 C$ Log 0018 C 0019 C Date Name Description 0020 C ----------------------------------------------------------------------------- 0021 C 23-JUL-1990 Eric Cannell creation of DVEAST 0022 C 0023 C$ Purpose 0024 C 0025 C DVEAST computes the dV for the next ground track runout for the 0026 C time targeting to the east boundary strategy. 0027 C 0028 C$ Input_Arguments 0029 C 0030 C Name Type Dim Units Description 0031 C ----------------------------------------------------------------------------- 0032 C CLSOLD I 1 - type of next to last ground track 0033 C CLSNOW I 1 - type of last ground track 0034 C DVOLD DP 1 mm/sec dV of next to last ground track 0035 C DVNOW DP 1 mm/sec dV of last ground track 0036 C TMEOLD DP 1 days time to east boundary for next to the 0037 C last ground track 0038 C TMENOW DP 1 days time to east boundary for last ground track 0039 C TARGET DP 1 days desired time to east boundary 0040 C 0041 C$ Output_Arguments 0042 C 0043 C Name Type Dim Units Description 0044 C ----------------------------------------------------------------------------- 0045 C DVOLD DP 1 mm/sec dV of last ground track (input DVNOW) 0046 C DVNOW DP 1 mm/sec dV of next ground track 0047 C 0048 C$ References 0049 C 0050 C 1] See GTARG.FOR for a discussion regarding the classification of 0051 C ground tracks. 0052 C 0053 C$ Restrictions 0054 C 0055 C 1] CLSOLD and CLSNOW can only have values in the range of 1..6 and 0056 C combinations defined in the Method Section. 0057 C 1-Jun-1993 15:35:32 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:50:58 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.FOR;13 0058 C 2] DVEAST assumes that a positive dV is along the velocity vector and 0059 C raises the semi-major axis. Conversely, a negative dV is opposite 0060 C the velocity vector and lowers semi-major axis. 0061 C 0062 C$ Files 0063 C 0064 C File Name Unit Number Description 0065 C ----------------------------------------------------------------------------- 0066 C * * standard I/O 0067 C OFILE 8 text output file 0068 C 0069 C$ Declarations_of_Input_and_Output_Arguments 0070 C 0071 INTEGER CLSNOW 0072 INTEGER CLSOLD 0073 DOUBLE PRECISION DVNOW 0074 DOUBLE PRECISION DVOLD 0075 DOUBLE PRECISION TARGET 0076 DOUBLE PRECISION TMENOW 0077 DOUBLE PRECISION TMEOLD 0078 C 0079 C$ Declarations_of_Local_Variables 0080 C 0081 DOUBLE PRECISION DVTEMP 0082 DOUBLE PRECISION M 0083 C 0084 C$ Method 0085 C 0086 C The method by which the new dV is computed depends on the previous 0087 C two ground track types: 0088 C 0089 C CLSOLD CLSNOW method of computation 0090 C -------------------------------------------------- 0091 C 1 or 2 1 or 2 or 3 linear extrapolation 0092 C 3 1 or 2 linear extrapolation 0093 C 3 3 120% of current dV 0094 C 1 or 2 or 3 4 or 5 or 6 average of last 2 dV's 0095 C 4 or 5 or 6 1 or 2 or 3 average of last 2 dV's 0096 C 4 4 80% of current dV 0097 C 5 4 or 5 80% of current dV 0098 C 6 4 or 5 or 6 80% of current dV 0099 C 0100 C 0101 C If luni-solar/drag interaction gets really wacky, DVEAST may have to 0102 C be modified to allow other transitions, i.e., 4 to 5. 0103 C 0104 C-& 0105 0106 IF ( ( CLSOLD .EQ. 1 0107 & .OR. CLSOLD .EQ. 2 0108 & ) 0109 & .AND. ( CLSNOW .EQ. 1 0110 & .OR. CLSNOW .EQ. 2 0111 & .OR. CLSNOW .EQ. 3 0112 & ) ) THEN 0113 0114 M = ( TMENOW - TMEOLD ) / ( DVNOW - DVOLD ) DVEAST 1-Jun-1993 15:35:32 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:50:58 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.FOR;13 0115 DVTEMP = ( TARGET - TMENOW + DVNOW * M ) 0116 & / M 0117 0118 DVOLD = DVNOW 0119 DVNOW = DVTEMP 0120 0121 ELSE IF ( ( CLSOLD .EQ. 3 0122 & ) 0123 & .AND. ( CLSNOW .EQ. 1 0124 & .OR. CLSNOW .EQ. 2 0125 & ) ) THEN 0126 0127 M = ( TMENOW - TMEOLD ) / ( DVNOW - DVOLD ) 0128 DVTEMP = ( TARGET - TMENOW + DVNOW * M ) 0129 & / M 0130 0131 DVOLD = DVNOW 0132 DVNOW = DVTEMP 0133 0134 ELSE IF ( ( CLSOLD .EQ. 3 0135 & ) 0136 & .AND. ( CLSNOW .EQ. 3 0137 & ) ) THEN 0138 0139 DVOLD = DVNOW 0140 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0141 0142 ELSE IF ( ( CLSOLD .EQ. 1 0143 & .OR. CLSOLD .EQ. 2 0144 & .OR. CLSOLD .EQ. 3 0145 & ) 0146 & .AND. ( CLSNOW .EQ. 4 0147 & .OR. CLSNOW .EQ. 5 0148 & .OR. CLSNOW .EQ. 6 0149 & ) ) THEN 0150 0151 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0152 DVOLD = DVNOW 0153 DVNOW = DVTEMP 0154 0155 ELSE IF ( ( CLSOLD .EQ. 4 0156 & .OR. CLSOLD .EQ. 5 0157 & .OR. CLSOLD .EQ. 6 0158 & ) 0159 & .AND. ( CLSNOW .EQ. 1 0160 & .OR. CLSNOW .EQ. 2 0161 & .OR. CLSNOW .EQ. 3 0162 & ) ) THEN 0163 0164 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0165 DVOLD = DVNOW 0166 DVNOW = DVTEMP 0167 0168 ELSE IF ( ( CLSOLD .EQ. 4 0169 & ) 0170 & .AND. ( CLSNOW .EQ. 4 0171 & ) ) THEN DVEAST 1-Jun-1993 15:35:32 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:50:58 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.FOR;13 0172 0173 DVOLD = DVNOW 0174 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0175 0176 ELSE IF ( ( CLSOLD .EQ. 5 0177 & ) 0178 & .AND. ( CLSNOW .EQ. 4 0179 & .OR. CLSNOW .EQ. 5 0180 & ) ) THEN 0181 0182 DVOLD = DVNOW 0183 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0184 0185 ELSE IF ( ( CLSOLD .EQ. 6 0186 & ) 0187 & .AND. ( CLSNOW .EQ. 4 0188 & .OR. CLSNOW .EQ. 5 0189 & .OR. CLSNOW .EQ. 6 0190 & ) ) THEN 0191 0192 DVOLD = DVNOW 0193 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0194 0195 ELSE 0196 0197 WRITE(*,301) CLSOLD , CLSNOW 0198 WRITE(8,301) CLSOLD , CLSNOW 0199 301 FORMAT(/,1X, 0200 & 'GTARG: CLSOLD, CLSNOW (',I,',',I,') in DVEAST are invalid.') 0201 0202 STOP 0203 0204 END IF 0205 0206 C1 End of DVEAST. 0207 0208 RETURN 0209 END DVEAST 1-Jun-1993 15:35:32 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 20:50:58 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.FOR;13 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 556 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 60 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD Total Space Allocated 616 ENTRY POINTS Address Type Name 0-00000000 DVEAST VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 CLSNOW AP-00000004@ I*4 CLSOLD AP-00000010@ R*8 DVNOW AP-0000000C@ R*8 DVOLD ** R*8 DVTEMP ** R*8 M AP-0000001C@ R*8 TARGET AP-00000018@ R*8 TMENOW AP-00000014@ R*8 TMEOLD LABELS Address Label 1-00000000 301' COMMAND QUALIFIERS FOR/LIS DVEAST.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVEAST.OBJ;2 COMPILATION STATISTICS Run Time: 0.44 seconds Elapsed Time: 3.83 seconds Page Faults: 309 Dynamic Memory: 492 pages 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 0001 C$Procedure DVLONG 0002 C 0003 SUBROUTINE DVLONG ( CLSOLD , CLSNOW , 0004 & DVOLD , DVNOW , 0005 & WSTOLD , WSTNOW , WSTBND 0006 & ) 0007 C 0008 C 0009 C******************************************************************************* 0010 C 0011 C Copyright (C) 1993, California Institute of Technology. U.S. 0012 C Government Sponsorhip under NASA Contract NAS7-918 is 0013 C acknowledged. 0014 C 0015 C******************************************************************************* 0016 C 0017 c 0018 C$ Log 0019 C 0020 C Date Name Description 0021 C ----------------------------------------------------------------------------- 0022 C 23-JUL-1990 Eric Cannell creation of DVLONG 0023 C 0024 C$ Purpose 0025 C 0026 C DVLONG computes the dV for the next ground track runout for the 0027 C longitudinal targeting strategy. 0028 C 0029 C$ Input_Arguments 0030 C 0031 C Name Type Dim Units Description 0032 C ----------------------------------------------------------------------------- 0033 C CLSOLD I 1 - type of next to last ground track 0034 C CLSNOW I 1 - type of last ground track 0035 C DVOLD DP 1 mm/sec dV of next to last ground track 0036 C DVNOW DP 1 mm/sec dV of last ground track 0037 C WSTOLD DP 1 km west offset of next to last ground track 0038 C WSTNOW DP 1 km west offset of last ground track 0039 C WSTBND DP 1 km offset of west boundary 0040 C 0041 C$ Output_Arguments 0042 C 0043 C Name Type Dim Units Description 0044 C ----------------------------------------------------------------------------- 0045 C DVOLD DP 1 mm/sec dV of last ground track (input DVNOW) 0046 C DVNOW DP 1 mm/sec dV of next ground track 0047 C 0048 C$ References 0049 C 0050 C 1] See GTARG.FOR for a discussion regarding the classification of 0051 C ground tracks. 0052 C 0053 C$ Restrictions 0054 C 0055 C 1] CLSOLD and CLSNOW can only have values in the range of 1..6 and 0056 C combinations defined in the Method Section. 0057 C 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 0058 C 2] DVLONG assumes that a positive dV is along the velocity vector and 0059 C raises the semi-major axis. Conversely, a negative dV is opposite 0060 C the velocity vector and lowers semi-major axis. 0061 C 0062 C$ Files 0063 C 0064 C File Name Unit Number Description 0065 C ----------------------------------------------------------------------------- 0066 C * * standard I/O 0067 C OFILE 8 text output file 0068 C 0069 C$ Declarations_of_Input_and_Output_Arguments 0070 C 0071 INTEGER CLSNOW 0072 INTEGER CLSOLD 0073 DOUBLE PRECISION DVNOW 0074 DOUBLE PRECISION DVOLD 0075 DOUBLE PRECISION WSTBND 0076 DOUBLE PRECISION WSTNOW 0077 DOUBLE PRECISION WSTOLD 0078 C 0079 C$ Declarations_of_Local_Variables 0080 C 0081 DOUBLE PRECISION DVTEMP 0082 DOUBLE PRECISION M 0083 C 0084 C$ Method 0085 C 0086 C The method by which the new dV is computed depends on the previous 0087 C two ground track types: 0088 C 0089 C CLSOLD CLSNOW method of computation 0090 C -------------------------------------------------- 0091 C 1 1 linear extrapolation 0092 C 2 1 or 2 120% of current dV 0093 C 3 1 or 2 or 3 120% of current dV 0094 C 1 or 2 or 3 4 or 5 or 6 average of last 2 dV's 0095 C 4 or 5 or 6 1 or 2 or 3 average of last 2 dV's 0096 C 4 4 80% of current dV 0097 C 5 4 or 5 80% of current dV 0098 C 6 4 or 5 or 6 80% of current dV 0099 C 0100 C 0101 C If luni-solar/drag interaction gets really wacky, DVLONG may have to 0102 C be modified to allow other transitions, i.e., 4 to 5. 0103 C 0104 C For the linear extrapolation when (CLSOLD,CLSNOW) is (1,1), target for 0105 C the west boundary + .5 meters (not -.5 meters!). Although the +.5 meters 0106 C targets the ground track alittle closer to the reference track, we now 0107 C avoid the numerical problem where the extrapolation places the ground track 0108 C a few centimeters beyond the west boundary, rather than a few centimeters 0109 C inside the west boundary. Also the half meter will usually be much less 0110 C than BNDFUZ, the fuzziness or success zone width (~10 meters) of the west 0111 C boundary longitudinal targeting. Pictorially (and not to scale), the area 0112 C around the west boundary appears as: 0113 C 0114 C DVLONG 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 0115 C if west point of a CLASS 1 0116 C ground track passes through 0117 C this band, the ground track 0118 C is considered to be close 0119 C enough to being perfectly 0120 C tangent to the west boundary 0121 C ------------------------------- 0122 C | | 0123 C | | 0124 C V V 0125 C 0126 C | . . 0127 C | . . 0128 C | . . 0129 C |--->| . . 0130 C | | . . 0131 C | | . . |===================> 0132 C west | | . . |reference track 0133 C boundary ---|--->| . . | and ===> 0134 C | | . . |east boundary 0135 C | | . . |===================> 0136 C | | . . 0137 C |--->| . . 0138 C | . . 0139 C | . . 0140 C | . . 0141 C 0142 C /|\ /|\ 0143 C | | 0144 C | | 0145 C +.5m BNDFUZ 0146 C 0147 C-& 0148 0149 IF ( ( CLSOLD .EQ. 1 0150 & ) 0151 & .AND. ( CLSNOW .EQ. 1 0152 & ) ) THEN 0153 0154 M = ( WSTNOW - WSTOLD ) / ( DVNOW - DVOLD ) 0155 DVTEMP = ( ( WSTBND + .0005 ) - WSTNOW + DVNOW * M ) 0156 & / M 0157 0158 DVOLD = DVNOW 0159 DVNOW = DVTEMP 0160 0161 ELSE IF ( ( CLSOLD .EQ. 2 0162 & ) 0163 & .AND. ( CLSNOW .EQ. 1 0164 & .OR. CLSNOW .EQ. 2 0165 & ) ) THEN 0166 0167 DVOLD = DVNOW 0168 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0169 0170 ELSE IF ( ( CLSOLD .EQ. 3 0171 & ) DVLONG 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 0172 & .AND. ( CLSNOW .EQ. 1 0173 & .OR. CLSNOW .EQ. 2 0174 & .OR. CLSNOW .EQ. 3 0175 & ) ) THEN 0176 0177 DVOLD = DVNOW 0178 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0179 0180 ELSE IF ( ( CLSOLD .EQ. 1 0181 & .OR. CLSOLD .EQ. 2 0182 & .OR. CLSOLD .EQ. 3 0183 & ) 0184 & .AND. ( CLSNOW .EQ. 4 0185 & .OR. CLSNOW .EQ. 5 0186 & .OR. CLSNOW .EQ. 6 0187 & ) ) THEN 0188 0189 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0190 DVOLD = DVNOW 0191 DVNOW = DVTEMP 0192 0193 ELSE IF ( ( CLSOLD .EQ. 4 0194 & .OR. CLSOLD .EQ. 5 0195 & .OR. CLSOLD .EQ. 6 0196 & ) 0197 & .AND. ( CLSNOW .EQ. 1 0198 & .OR. CLSNOW .EQ. 2 0199 & .OR. CLSNOW .EQ. 3 0200 & ) ) THEN 0201 0202 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0203 DVOLD = DVNOW 0204 DVNOW = DVTEMP 0205 0206 ELSE IF ( ( CLSOLD .EQ. 4 0207 & ) 0208 & .AND. ( CLSNOW .EQ. 4 0209 & ) ) THEN 0210 0211 DVOLD = DVNOW 0212 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0213 0214 ELSE IF ( ( CLSOLD .EQ. 5 0215 & ) 0216 & .AND. ( CLSNOW .EQ. 4 0217 & .OR. CLSNOW .EQ. 5 0218 & ) ) THEN 0219 0220 DVOLD = DVNOW 0221 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0222 0223 ELSE IF ( ( CLSOLD .EQ. 6 0224 & ) 0225 & .AND. ( CLSNOW .EQ. 4 0226 & .OR. CLSNOW .EQ. 5 0227 & .OR. CLSNOW .EQ. 6 0228 & ) ) THEN DVLONG 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 0229 0230 DVOLD = DVNOW 0231 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0232 0233 ELSE 0234 0235 WRITE(*,301) CLSOLD , CLSNOW 0236 WRITE(8,301) CLSOLD , CLSNOW 0237 301 FORMAT(/,1X, 0238 & 'GTARG: CLSOLD, CLSNOW (',I,',',I,') in DVLONG are invalid.') 0239 0240 STOP 0241 0242 END IF 0243 0244 C1 End of DVLONG. 0245 0246 RETURN 0247 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 548 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 60 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD Total Space Allocated 608 ENTRY POINTS Address Type Name 0-00000000 DVLONG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 CLSNOW AP-00000004@ I*4 CLSOLD AP-00000010@ R*8 DVNOW AP-0000000C@ R*8 DVOLD ** R*8 DVTEMP ** R*8 M AP-0000001C@ R*8 WSTBND AP-00000018@ R*8 WSTNOW AP-00000014@ R*8 WSTOLD LABELS Address Label 1-00000000 301' DVLONG 1-Jun-1993 15:35:39 VAX FORTRAN V5.6-119 Page 6 01 21-Jan-1993 20:51:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.FOR;7 COMMAND QUALIFIERS FOR/LIS DVLONG.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVLONG.OBJ;2 COMPILATION STATISTICS Run Time: 0.64 seconds Elapsed Time: 5.98 seconds Page Faults: 249 Dynamic Memory: 476 pages 1-Jun-1993 15:35:49 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:52:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVMOVE.FOR;3 0001 C$Procedure DVMOVE 0002 C 0003 SUBROUTINE DVMOVE ( ELTS , SOURCE , TARGET ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C DVMOVE copies the first ELTS elements of SOURCE into the first 0017 C ELTS elements of TARGET. 0018 C 0019 C$ Input_Arguments 0020 C 0021 C ELTS - number of elements to move 0022 C SOURCE - source vector 0023 C 0024 C$ Output_Arguments 0025 C 0026 C TARGET - target vector 0027 C 0028 C$ Log 0029 C 0030 C 18-Jul-1988 - Eric Cannell - creation 0031 C 0032 C$ Declarations_of_Input_and_Output_Arguments 0033 C 0034 INTEGER ELTS 0035 DOUBLE PRECISION SOURCE(*) 0036 DOUBLE PRECISION TARGET(*) 0037 C 0038 C$ Declarations_of_Local_Variables 0039 C 0040 INTEGER IELT 0041 C 0042 C$ Method 0043 C-& 0044 0045 C1 Copy ELTS elements from SOURCE to TARGET. 0046 0047 DO 101 IELT = 1 , ELTS 0048 0049 TARGET( IELT ) = SOURCE( IELT ) 0050 0051 101 CONTINUE 0052 0053 RETURN 0054 END DVMOVE 1-Jun-1993 15:35:49 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 20:52:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVMOVE.FOR;3 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 72 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 44 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 116 ENTRY POINTS Address Type Name 0-00000000 DVMOVE VARIABLES Address Type Name Address Type Name AP-00000004@ I*4 ELTS ** I*4 IELT ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 SOURCE ** (*) AP-0000000C@ R*8 TARGET ** (*) LABELS Address Label ** 101 COMMAND QUALIFIERS FOR/LIS DVMOVE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVMOVE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVMOVE.OBJ;2 DVMOVE 1-Jun-1993 15:35:49 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 20:52:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVMOVE.FOR;3 COMPILATION STATISTICS Run Time: 0.17 seconds Elapsed Time: 5.45 seconds Page Faults: 211 Dynamic Memory: 456 pages 1-Jun-1993 15:36:13 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:53:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.FOR;14 0001 C$Procedure DVWEST 0002 C 0003 SUBROUTINE DVWEST ( CLSOLD , CLSNOW , 0004 & DVOLD , DVNOW , 0005 & TMWOLD , TMWNOW , TARGET 0006 & ) 0007 C 0008 C 0009 C******************************************************************************* 0010 C 0011 C Copyright (C) 1993, California Institute of Technology. U.S. 0012 C Government Sponsorhip under NASA Contract NAS7-918 is 0013 C acknowledged. 0014 C 0015 C******************************************************************************* 0016 C 0017 C$ Log 0018 C 0019 C Date Name Description 0020 C ----------------------------------------------------------------------------- 0021 C 23-JUL-1990 Eric Cannell creation of DVWEST 0022 C 0023 C$ Purpose 0024 C 0025 C DVWEST computes the dV for the next ground track runout for the 0026 C time targeting to the west boundary strategy. 0027 C 0028 C$ Input_Arguments 0029 C 0030 C Name Type Dim Units Description 0031 C ----------------------------------------------------------------------------- 0032 C CLSOLD I 1 - type of next to last ground track 0033 C CLSNOW I 1 - type of last ground track 0034 C DVOLD DP 1 mm/sec dV of next to last ground track 0035 C DVNOW DP 1 mm/sec dV of last ground track 0036 C TMWOLD DP 1 days time to west boundary for next to the 0037 C last ground track 0038 C TMWNOW DP 1 days time to west boundary for last ground track 0039 C TARGET DP 1 days desired time to west boundary 0040 C 0041 C$ Output_Arguments 0042 C 0043 C Name Type Dim Units Description 0044 C ----------------------------------------------------------------------------- 0045 C DVOLD DP 1 mm/sec dV of last ground track (input DVNOW) 0046 C DVNOW DP 1 mm/sec dV of next ground track 0047 C 0048 C$ References 0049 C 0050 C 1] See GTARG.FOR for a discussion regarding the classification of 0051 C ground tracks. 0052 C 0053 C$ Restrictions 0054 C 0055 C 1] CLSOLD and CLSNOW can only have values in the range of 1..6 and 0056 C combinations defined in the Method Section. 0057 C 1-Jun-1993 15:36:13 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:53:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.FOR;14 0058 C 2] DVWEST assumes that a positive dV is along the velocity vector and 0059 C raises the semi-major axis. Conversely, a negative dV is opposite 0060 C the velocity vector and lowers semi-major axis. 0061 C 0062 C$ Files 0063 C 0064 C File Name Unit Number Description 0065 C ----------------------------------------------------------------------------- 0066 C * * standard I/O 0067 C OFILE 8 text output file 0068 C 0069 C$ Declarations_of_Input_and_Output_Arguments 0070 C 0071 INTEGER CLSNOW 0072 INTEGER CLSOLD 0073 DOUBLE PRECISION DVNOW 0074 DOUBLE PRECISION DVOLD 0075 DOUBLE PRECISION TARGET 0076 DOUBLE PRECISION TMWNOW 0077 DOUBLE PRECISION TMWOLD 0078 C 0079 C$ Declarations_of_Local_Variables 0080 C 0081 DOUBLE PRECISION DVTEMP 0082 DOUBLE PRECISION M 0083 C 0084 C$ Method 0085 C 0086 C The method by which the new dV is computed depends on the previous 0087 C two ground track types: 0088 C 0089 C CLSOLD CLSNOW method of computation 0090 C -------------------------------------------------- 0091 C 1 1 120% of current dV 0092 C 2 1 or 2 120% of current dV 0093 C 3 1 or 2 or 3 120% of current dV 0094 C 1 or 2 or 3 4 or 5 or 6 average of last 2 dV's 0095 C 4 or 5 or 6 1 or 2 or 3 average of last 2 dV's 0096 C 4 or 5 4 or 5 or 6 linear extrapolation 0097 C 6 4 or 5 linear extrapolation 0098 C 6 6 80% of current dV 0099 C 0100 C 0101 C If luni-solar/drag interaction gets really wacky, DVWEST may have to 0102 C be modified to allow other transitions, i.e., 1 to 2. 0103 C 0104 C-& 0105 0106 IF ( ( CLSOLD .EQ. 1 0107 & ) 0108 & .AND. ( CLSNOW .EQ. 1 0109 & ) ) THEN 0110 0111 DVOLD = DVNOW 0112 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0113 0114 ELSE IF ( ( CLSOLD .EQ. 2 DVWEST 1-Jun-1993 15:36:13 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:53:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.FOR;14 0115 & ) 0116 & .AND. ( CLSNOW .EQ. 1 0117 & .OR. CLSNOW .EQ. 2 0118 & ) ) THEN 0119 0120 DVOLD = DVNOW 0121 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0122 0123 ELSE IF ( ( CLSOLD .EQ. 3 0124 & ) 0125 & .AND. ( CLSNOW .EQ. 1 0126 & .OR. CLSNOW .EQ. 2 0127 & .OR. CLSNOW .EQ. 3 0128 & ) ) THEN 0129 0130 DVOLD = DVNOW 0131 DVNOW = DVNOW + DABS( .2D0 * DVNOW ) 0132 0133 ELSE IF ( ( CLSOLD .EQ. 1 0134 & .OR. CLSOLD .EQ. 2 0135 & .OR. CLSOLD .EQ. 3 0136 & ) 0137 & .AND. ( CLSNOW .EQ. 4 0138 & .OR. CLSNOW .EQ. 5 0139 & .OR. CLSNOW .EQ. 6 0140 & ) ) THEN 0141 0142 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0143 DVOLD = DVNOW 0144 DVNOW = DVTEMP 0145 0146 ELSE IF ( ( CLSOLD .EQ. 4 0147 & .OR. CLSOLD .EQ. 5 0148 & .OR. CLSOLD .EQ. 6 0149 & ) 0150 & .AND. ( CLSNOW .EQ. 1 0151 & .OR. CLSNOW .EQ. 2 0152 & .OR. CLSNOW .EQ. 3 0153 & ) ) THEN 0154 0155 DVTEMP = ( DVOLD + DVNOW ) / 2D0 0156 DVOLD = DVNOW 0157 DVNOW = DVTEMP 0158 0159 ELSE IF ( ( CLSOLD .EQ. 4 0160 & .OR. CLSOLD .EQ. 5 0161 & ) 0162 & .AND. ( CLSNOW .EQ. 4 0163 & .OR. CLSNOW .EQ. 5 0164 & .OR. CLSNOW .EQ. 6 0165 & ) ) THEN 0166 0167 M = ( TMWNOW - TMWOLD ) / ( DVNOW - DVOLD ) 0168 DVTEMP = ( TARGET - TMWNOW + DVNOW * M ) 0169 & / M 0170 0171 DVOLD = DVNOW DVWEST 1-Jun-1993 15:36:13 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:53:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.FOR;14 0172 DVNOW = DVTEMP 0173 0174 ELSE IF ( ( CLSOLD .EQ. 6 0175 & ) 0176 & .AND. ( CLSNOW .EQ. 4 0177 & .OR. CLSNOW .EQ. 5 0178 & ) ) THEN 0179 0180 M = ( TMWNOW - TMWOLD ) / ( DVNOW - DVOLD ) 0181 DVTEMP = ( TARGET - TMWNOW + DVNOW * M ) 0182 & / M 0183 0184 DVOLD = DVNOW 0185 DVNOW = DVTEMP 0186 0187 ELSE IF ( ( CLSOLD .EQ. 6 0188 & ) 0189 & .AND. ( CLSNOW .EQ. 6 0190 & ) ) THEN 0191 0192 DVOLD = DVNOW 0193 DVNOW = DVNOW - DABS( .2D0 * DVNOW ) 0194 0195 ELSE 0196 0197 WRITE(*,301) CLSOLD , CLSNOW 0198 WRITE(8,301) CLSOLD , CLSNOW 0199 301 FORMAT(/,1X, 0200 & 'GTARG: CLSOLD, CLSNOW (',I,',',I,') in DVWEST are invalid.') 0201 0202 STOP 0203 0204 END IF 0205 0206 C1 End of DVWEST. 0207 0208 RETURN 0209 END DVWEST 1-Jun-1993 15:36:13 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 20:53:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.FOR;14 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 556 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 60 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD Total Space Allocated 616 ENTRY POINTS Address Type Name 0-00000000 DVWEST VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000008@ I*4 CLSNOW AP-00000004@ I*4 CLSOLD AP-00000010@ R*8 DVNOW AP-0000000C@ R*8 DVOLD ** R*8 DVTEMP ** R*8 M AP-0000001C@ R*8 TARGET AP-00000018@ R*8 TMWNOW AP-00000014@ R*8 TMWOLD LABELS Address Label 1-00000000 301' COMMAND QUALIFIERS FOR/LIS DVWEST.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]DVWEST.OBJ;2 COMPILATION STATISTICS Run Time: 0.52 seconds Elapsed Time: 5.88 seconds Page Faults: 276 Dynamic Memory: 492 pages 1-Jun-1993 15:36:31 VAX FORTRAN V5.6-119 Page 1 15-Feb-1993 19:14:29 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.FOR;5 0001 integer function finddate ( indate, flag, dates, xdates, ndates ) 0002 C 0003 C searchs for a date in an array of dates. The format of the 0004 C dates in both the array and the date is for example, 0005 C 0006 C 23-DEC-1992 09:47:56.1234 0007 C 0008 C return value = index of latest date in array just prior to indate 0009 C retrun = -1 if indate preceds dates[1] 0010 C 0011 C assumptions: 0012 C 1) ndates > 1 0013 C 2) the array is time ordered. 0014 C 0015 C name type dimension description 0016 C ------- ---- ---------- --------------------------- 0017 C indate c*25 1 date to find in array dates 0018 C flag logical .true. use dates 0019 C .false. use xdates 0020 C dates c*25 ndates array of dates 0021 C xdates D.P. ndates same, in DP ch2sec output format 0022 C ndates i 1 size of array dates 0023 C 0024 integer idate 0025 data idate/-1/ 0026 integer ndates, i1, i2, imid 0027 character*25 dates(ndates), sec2ch 0028 double precision ch2sec, tin, tcheck, it1, it2, itmid 0029 double precision xdates(ndates) 0030 external ch2sec 0031 logical error, flag 0032 0033 tin = ch2sec ( indate, .true., error) 0034 0035 i1 = 1 0036 i2 = ndates 0037 0038 if (flag) then 0039 it1 = ch2sec ( dates(i1), .true., error) 0040 it2 = ch2sec ( dates(i2), .true., error) 0041 else 0042 it1 = xdates(i1) 0043 it2 = xdates(i2) 0044 end if 0045 0046 C 0047 C check for date out of range of array 0048 C 0049 0050 if (tin .lt. it1 ) then 0051 idate = -1 0052 goto 9999 0053 else if (tin .ge. it2 ) then 0054 idate = ndates 0055 goto 9999 0056 end if 0057 C FINDDATE 1-Jun-1993 15:36:31 VAX FORTRAN V5.6-119 Page 2 15-Feb-1993 19:14:29 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.FOR;5 0058 C at this point, know that 0059 C 0060 C dates(1) <= indate < dates(ndate) 0061 C 0062 C check for only 2 points 0063 C 0064 if ( ndates .eq. 2 ) then 0065 idate = 1 0066 goto 9999 0067 end if 0068 C 0069 C there are at least 3 points in the array. Narrow it down. 0070 C 0071 do while ( (i2-i1) .gt. 1) 0072 imid = (i2+i1)/2 0073 if (flag) then 0074 itmid = ch2sec ( dates(imid), .true., error) 0075 else 0076 itmid = xdates(imid) 0077 end if 0078 0079 if (tin .lt. itmid) then 0080 i2 = imid 0081 else 0082 i1 = imid 0083 end if 0084 end do 0085 idate = i1 0086 C 0087 C check for repeated time code 0088 C 0089 0090 8888 continue 0091 0092 i3 = idate+1 0093 if (i3 .gt. ndates) goto 9999 0094 0095 if (flag) then 0096 itmid = ch2sec ( dates(i3), .true., error) 0097 else 0098 itmid = xdates (i3) 0099 end if 0100 if (itmid .lt. tin) then 0101 idate = i3 0102 goto 8888 0103 end if 0104 0105 9999 continue 0106 finddate = idate 0107 return 0108 end FINDDATE 1-Jun-1993 15:36:31 VAX FORTRAN V5.6-119 Page 3 01 15-Feb-1993 19:14:29 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.FOR;5 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 308 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 200 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 512 ENTRY POINTS Address Type Name 0-00000000 I*4 FINDDATE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000004 L*4 ERROR AP-00000008@ L*4 FLAG ** I*4 I1 ** I*4 I2 ** I*4 I3 ** I*4 IDATE ** I*4 IMID AP-00000004@ I*4 INDATE ** R*8 IT1 ** R*8 IT2 ** R*8 ITMID AP-00000014@ I*4 NDATES ** CHAR SEC2CH ** R*8 TCHECK ** R*8 TIN ARRAYS Address Type Name Bytes Dimensions AP-0000000C@ CHAR DATES ** (*) AP-00000010@ R*8 XDATES ** (*) LABELS Address Label Address Label 0-000000FC 8888 0-00000130 9999 FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*8 CH2SEC 1-Jun-1993 15:36:31 VAX FORTRAN V5.6-119 Page 4 15-Feb-1993 19:14:29 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.FOR;5 0001 0002 0003 C program tester 0004 C integer finddate 0005 C character*25 dates(11), indate 0006 C data dates / '16-APR-1992 23:30', 0007 C & '19-APR-1992 15:12', '13-MAY-1992 01:48', '18-JUN-1992 22:20', 0008 C & '27-JUL-1992 14:20', '29-AUG-1993 15:03', '2-SEP-1993 03:01', 0009 C & '6-OCT-1993 04:27', '11-NOV-1993 19:22', '12-DEC-1993 08:29', 0010 C & '13-MAY-1994 05:06'/ 0011 C write(6,*) dates 0012 C 50 write(6,*) '***' 0013 C write(6,*) 'Enter date:' 0014 C read(6,100) indate 0015 C 100 format (A25) 0016 C idate = finddate(indate, dates, 11) 0017 C write(6,*) 'idate = ', idate, ' ',dates(idate) 0018 C if (.true.) goto 50 0019 C stop 0020 C end COMMAND QUALIFIERS FOR/LIS FINDDATE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FINDDATE.OBJ;2 COMPILATION STATISTICS Run Time: 0.42 seconds Elapsed Time: 4.20 seconds Page Faults: 265 Dynamic Memory: 520 pages 1-Jun-1993 15:36:24 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:55:08 [SHAPIRO.COSMIC.SOURCE]FIND_CLASS.FOR;3 0001 subroutine find_class ( target_strat, limits, 0002 & limits_west, limits_east, bounds, class ) 0003 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C 0014 C Determine appropriate call to fndcls depending upon 0015 C choice of ground track used 0016 C 0017 C UNBIASED - use limits 0018 C WESTGT - use limits_west 0019 C EASTGT - use limits_east 0020 C 0021 C B. Shapiro Sept. 6, 1991 0022 C 0023 C 0024 character*8 target_strat 0025 double precision limits(4,2) 0026 double precision limits_west(4,2) 0027 double precision limits_east(4,2) 0028 0029 if ( target_strat .eq. 'UNBIASED' ) then 0030 CALL FNDCLS ( LIMITS , BOUNDS , CLASS ) 0031 else if ( target_strat .eq. 'WESTGT' ) then 0032 CALL FNDCLS ( LIMITS_west , BOUNDS , CLASS ) 0033 else if ( target_strat .eq. 'EASTGT' ) then 0034 CALL FNDCLS ( LIMITS_east , BOUNDS , CLASS ) 0035 else 0036 call clear_screen 0037 print *, 'ERROR: Unknown target_strat = ', target_strat 0038 write (8,*) 'ERROR: Unknown target_strat = ', target_strat 0039 stop 0040 end if 0041 return 0042 end FIND_CLASS 1-Jun-1993 15:36:24 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 20:55:08 [SHAPIRO.COSMIC.SOURCE]FIND_CLASS.FOR;3 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 253 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 50 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 132 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 435 ENTRY POINTS Address Type Name 0-00000000 FIND_CLASS VARIABLES Address Type Name Address Type Name Address Type Name AP-00000014@ R*4 BOUNDS AP-00000018@ R*4 CLASS AP-00000004@ CHAR TARGET_STRAT ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 LIMITS 64 (4, 2) AP-00000010@ R*8 LIMITS_EAST 64 (4, 2) AP-0000000C@ R*8 LIMITS_WEST 64 (4, 2) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name CLEAR_SCREEN FNDCLS COMMAND QUALIFIERS FOR/LIS FIND_CLASS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FIND_CLASS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FIND_CLASS.OBJ;2 FIND_CLASS 1-Jun-1993 15:36:24 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 20:55:08 [SHAPIRO.COSMIC.SOURCE]FIND_CLASS.FOR;3 COMPILATION STATISTICS Run Time: 0.27 seconds Elapsed Time: 3.58 seconds Page Faults: 280 Dynamic Memory: 472 pages 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 1 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 0001 C$Procedure Firstguess 0002 C 0003 subroutine firstguess ( STRAT, ORBIT, DATE, TIMTGT, 0004 & BOUNDS, JEARTH, LTOP, LSFLAG, n_ref_orbits, 0005 & equator_xings, DELTAV ) 0006 C 0007 C 0008 C******************************************************************************* 0009 C 0010 C Copyright (C) 1993, California Institute of Technology. U.S. 0011 C Government Sponsorhip under NASA Contract NAS7-918 is 0012 C acknowledged. 0013 C 0014 C******************************************************************************* 0015 C 0016 C$ Log 0017 C 0018 C Date Name Description 0019 C ----------------------------------------------------------------------------- 0020 C 13 Aug 1991 Bruce Shapiro create firstguess 0021 C 0022 C$ Purpose 0023 C 0024 C Determines a first guess at the delta v required based upon a constant 0025 C density approximation and a given targeting method. 0026 C 0027 C$ Input_Arguments 0028 C 0029 C Name Type Dim Units Description 0030 C ----------------------------------------------------------------------------- 0031 C STRAT C*6 1 - see GTARG 0032 C ORBIT DP 6 km,deg input orbit of (a,e,i,LAN,w,M) 0033 C DATE C*25 1 --> input epoch of ORBIT in TIMETRANS format 0034 C 'dd-mmm-yyyy hh:mm:ss.fff 0035 C BOUNDS DP 2 km boundary of the valid ground track band 0036 C as measured 0037 C from the reference ground track. Usually, 0038 C BOUNDS will be something like -/+ 1 km. 0039 C But, BOUNDS could be (.5,1.5), i.e., fully 0040 C right of the reference ground track. 0041 C TIMTGT DP 1 days if STRAT='EAST' or STRAT='WEST', then 0042 C TIMTGT is the desired target time to the 0043 C east or west boundary. 0044 C JEARTH DP (2:29) Earth gravity coefficients 0045 C LTOP I 1 size of gravity field (up to 17) 0046 C LSFLAG L 1 True/false use lunar/solar perturbations 0047 C n_ref_orbits i 1 Number of crossings in equator_xings 0048 C equator_xings DP n_ref_orbist reference equator crossings in deg 0049 0050 C 0051 C$ Output_Arguments 0052 C 0053 C Name Type Dim Units Description 0054 C ----------------------------------------------------------------------------- 0055 C DELTAV DP 1 mm/sec guess at deltav 0056 C 0057 C$ Namelist_Output 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 2 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 0058 C 0059 C none 0060 C 0061 C$ Library_Links 0062 C 0063 C Entry Point Name Location 0064 C ----------------------------------------------------------------------------- 0065 C sidang TPXORB 0066 C MNODES gtarg 0067 C RNG360 0068 C ORBBP TPXORB 0069 C SUNORB TPXORB 0070 C B2DRAG TPXLIB 0071 C CRMGET GTARG 0072 C dclose TPXUTIL 0073 C 0074 C common area 0075 C 0076 double precision earth_rad ! in kilomters 0077 double precision earth_freq ! radians / second 0078 double precision earth_rate ! meters / day 0079 double precision mu_earth ! km**3/sec 0080 double precision mu_moon ! km**3/sec 0081 double precision mu_sun ! km**3/sec 0082 double precision sid_day ! seconds 0083 double precision deg2km ! kilometers/deg 0084 0085 common / physical_constants / 0086 & earth_rad, earth_freq, earth_rate, mu_earth, 0087 & mu_moon, mu_sun, sid_day, deg2km 0088 0089 0090 C$ Parameters 0091 C 0092 C MU = GM_EARTH in KM**3/SEC**2 0093 C 0094 C DOUBLE PRECISION MU 0095 C PARAMETER ( MU = 398600.44807345 ) 0096 C 0097 C DOUBLE PRECISION EARTH_RADIUS 0098 C PARAMETER ( EARTH_RADIUS = 6378.140 ) 0099 0100 C DOUBLE PRECISION PI 0101 C PARAMETER ( PI = 3.14159265358979323846 ) 0102 0103 C DOUBLE PRECISION SIDEREAL_DAY 0104 C PARAMETER ( SIDEREAL_DAY = 86164.09055 ) 0105 0106 DOUBLE PRECISION OMEGA_EARTH 0107 C parameter ( OMEGA_EARTH = 2.0 * PI * EARTH_RADIUS * 0108 C & 86400.0/ SIDEREAL_DAY ) 0109 0110 C DOUBLE PRECISION deg2km 0111 C parameter ( deg2km = PI * EARTH_RADIUS / 180.0 ) 0112 C 0113 C$ Declarations_of_Input_and_Output_Arguments 0114 C FIRSTGUESS 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 3 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 0115 0116 DOUBLE PRECISION ORBIT ( 6 ) 0117 DOUBLE PRECISION BOUNDS ( 2 ) 0118 double precision jearth ( 2:29 ) 0119 CHARACTER*25 DATE 0120 CHARACTER*6 STRAT 0121 DOUBLE PRECISION TIMTGT 0122 DOUBLE PRECISION DELTAV 0123 logical LSFLAG 0124 integer LTOP 0125 integer n_ref_orbits 0126 double precision equator_xings ( n_ref_orbits ) 0127 C 0128 C$ Declarations_of_Local_Variables 0129 C 0130 C Name Type Dim Units Description 0131 C ----------------------------------------------------------------------------- 0132 C CRM DP 1 1/km**3 rho*C_D/M 0133 C AREA DP 1 KM**2 area of drag 0134 C v DP 1 km/sec spacecraft velocity 0135 C sunstt DP 1 Sun vector 0136 C betaprime DP 1 beta abgke 0137 C alpha, beta DP 1 coefficients of g.t. equation 0138 C dl = dl + alpha * t + beta * t ** 2 0139 0140 double precision CRM, crmhi, crmlo 0141 double precision area 0142 double precision v 0143 double precision orbwrk ( 6 ) 0144 double precision sunstt ( 6 ) 0145 double precision betaprime, betap 0146 double precision orbnode ( 6) 0147 character * 25 timenode 0148 double precision ecl 0149 double precision delta_lambda 0150 double precision alpha, beta 0151 double precision west_bound, east_bound 0152 character * 4 hilo 0153 C 0154 C$ External_Statements 0155 C 0156 double precision sidang 0157 external sidang 0158 0159 double precision rng360 0160 external rng360 0161 0162 double precision VMAREA 0163 external VMAREA 0164 0165 double precision ORBBP 0166 external ORBBP 0167 0168 integer dclose 0169 external dclose 0170 0171 C FIRSTGUESS 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 4 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 0172 C$ Method 0173 C-& 0174 C convert from meters/day to kilomters/day 0175 C 0176 omega_earth = earth_rate/1000.0 0177 0178 write (8, 1000) 0179 1000 format (/, 0180 & ' ',25x,'Targeting First Guess Report',/, 0181 & ' ',25x,'----------------------------' 0182 & ) 0183 C write (6, *) '========== First Guess Calculation ==========' 0184 C write (6, *) 'Method: ', STRAT 0185 C write (6, *) 'Semi-major axis: ', ORBIT(1) 0186 C write (6, *) 'Date: ', DATE 0187 C write (6, *) 'Time target: ', TIMTGT 0188 C write (6, *) LSFLAG 0189 C write (6, *) n_ref_orbits, ' ', equator_xings(1) 0190 0191 0192 call dvmove ( 6, orbit, orbwrk ) 0193 0194 west_bound = bounds ( 1 ) 0195 east_bound = bounds ( 2 ) 0196 C 0197 C circular velocity approximation 0198 0199 v = sqrt ( mu_earth / orbwrk (1) ) 0200 C write (6, *) 'Spacecraft vel: ', v 0201 C 0202 C get drag parameters 0203 C 0204 call SUNORB ( DATE, SUNSTT ) 0205 betaprime = orbbp ( ORBWRK, SUNSTT ) 0206 area = VMAREA ( betaprime, 'DRAG' ) / (1000.0 ** 2) 0207 0208 call crmget ( date, CRM, crmhi, crmlo ) 0209 0210 C write (6,*) 'SUN:', sunstt 0211 C write (6,*) 'Beta prime: ', betaprime 0212 C write (6,*) 'Area: ', area 0213 C write (6,*) 'rho * CD / M: ', CRM 0214 C 0215 C calculate current ground track position: propagate to nearest 0216 C ascending node with drag turned on 0217 C 0218 hilo = 'TRUE' 0219 call MNODES ( orbwrk, date, 1, jearth, ltop, lsflag, .true., 0220 & 0.0d0, 0.0d0, 0.0d0, 0221 & 'TRUE', orbnode, timenode, betap ) 0222 0223 C 0224 C equator crossing longitude 0225 C 0226 ecl = rng360 ( orbnode ( 4 ) - sidang ( timenode, 0d0 ) ) 0227 0228 ref_index = DCLOSE ( ecl, n_ref_orbits, equator_xings ) FIRSTGUESS 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 5 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 0229 0230 delta_lambda = ecl - equator_xings ( ref_index ) 0231 0232 C write (6,*) 'ecl:', ecl 0233 C write (6,*) 'delta lambda:', delta_lambda 0234 0235 if ( delta_lambda .gt. 180d0 ) then 0236 delta_lambda = delta_lambda - 360d0 0237 else if ( delta_lambda .lt. -180d0 ) then 0238 delta_lambda = delta_lambda + 360.0d0 0239 end if 0240 0241 delta_lambda = delta_lambda * DEG2KM 0242 0243 write (8, 1050) delta_lambda, betaprime, CRM 0244 1050 format (' ',T15,' Initial Ground Track:', 0245 & T42,F10.5,' kilometers.',/, 0246 & ' ',T15, ' Constant beta prime:',T42, F10.5, 0247 & ' degrees.',/, 0248 & ' ',T15, 'Constant rho * CD / M:',T42, E14.9, 0249 & ' km**-3') 0250 0251 beta = 0.75d0 * omega_earth * crm * area * v * 86400.0d0 0252 0253 if ( strat .eq. 'LONG' ) then 0254 alpha = -2.0 * sqrt ( beta * 0255 & ( delta_lambda - west_bound ) ) 0256 else if ( strat .eq. 'EAST' ) then 0257 alpha = ( delta_lambda - east_bound ) / timtgt - 0258 & beta * timtgt 0259 else if ( strat .eq. 'WEST' ) then 0260 alpha = - 2.0 * beta * timtgt 0261 end if 0262 0263 C write (6,*) 'beta = ', beta 0264 C write (6,*) 'alpha = ', alpha 0265 0266 deltav = ( -alpha * v / (3 * omega_earth ) ) * 1d6 0267 0268 write (8,1090) deltav 0269 1090 format(' ',T15, ' First guess delta v:',T42,F10.3, 0270 & ' mm/sec.') 0271 RETURN 0272 END FIRSTGUESS 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 6 01 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 624 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 311 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 572 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1571 ENTRY POINTS Address Type Name 0-00000000 FIRSTGUESS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-000000F0 R*8 ALPHA ** R*8 AREA 2-000000F8 R*8 BETA 2-000000E0 R*8 BETAP 2-000000D8 R*8 BETAPRIME 2-000000B8 R*8 CRM 2-000000C0 R*8 CRMHI 2-000000C8 R*8 CRMLO AP-0000000C@ CHAR DATE 3-00000038 R*8 DEG2KM AP-0000002C@ R*8 DELTAV ** R*8 DELTA_LAMBDA 3-00000008 R*8 EARTH_FREQ 3-00000000 R*8 EARTH_RAD 3-00000010 R*8 EARTH_RATE 2-00000100 R*8 EAST_BOUND 2-000000E8 R*8 ECL ** CHAR HILO AP-00000020@ L*4 LSFLAG AP-0000001C@ I*4 LTOP 3-00000018 R*8 MU_EARTH 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN AP-00000024@ I*4 N_REF_ORBITS 2-000000B0 R*8 OMEGA_EARTH ** R*4 REF_INDEX 3-00000030 R*8 SID_DAY AP-00000004@ CHAR STRAT 2-00000090 CHAR TIMENODE AP-00000010@ R*8 TIMTGT 2-000000D0 R*8 V ** R*8 WEST_BOUND ARRAYS Address Type Name Bytes Dimensions AP-00000014@ R*8 BOUNDS 16 (2) AP-00000028@ R*8 EQUATOR_XINGS ** (*) AP-00000018@ R*8 JEARTH 224 (2:29) AP-00000008@ R*8 ORBIT 48 (6) 2-00000060 R*8 ORBNODE 48 (6) 2-00000000 R*8 ORBWRK 48 (6) 2-00000030 R*8 SUNSTT 48 (6) LABELS Address Label Address Label Address Label 1-0000001E 1000' 1-00000067 1050' 1-000000FA 1090' FIRSTGUESS 1-Jun-1993 15:36:40 VAX FORTRAN V5.6-119 Page 7 01 3-Feb-1993 19:23:01 [SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.FOR;24 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name CRMGET I*4 DCLOSE DVMOVE MNODES R*8 MTH$DSQRT R*8 ORBBP R*8 RNG360 R*8 SIDANG SUNORB R*8 VMAREA COMMAND QUALIFIERS FOR/LIS FIRSTGUESS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FIRSTGUESS.OBJ;2 COMPILATION STATISTICS Run Time: 0.62 seconds Elapsed Time: 4.79 seconds Page Faults: 273 Dynamic Memory: 504 pages 1-Jun-1993 15:36:50 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:54:07 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.FOR;7 0001 C$Procedure FNDCLS 0002 C 0003 SUBROUTINE FNDCLS ( LIMITS , BOUNDS , CLASS ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 18-JUL-1990 Eric Cannell creation of FNDCLS 0019 C 0020 C$ Purpose 0021 C 0022 C FNDCLS classifies a ground track according to the following sample 0023 C ground track charts: 0024 C 0025 C CLASS = 1 CLASS = 4 0026 C 0027 C | ....| |.. | 0028 C | .. | | ... | 0029 C | . | | .. | 0030 C | . | | . | 0031 C | .. | | .. | 0032 C | ..| | .. | 0033 C |------------. |--.---------| 0034 C 0035 C CLASS = 2 CLASS = 5 0036 C 0037 C | | | | 0038 C | | | | 0039 C | ...| |. | 0040 C | ..... | | ... | 0041 C | .. | | ... | 0042 C |.. | | ... | 0043 C |.-----------| |---------.--| 0044 C 0045 C CLASS = 3 CLASS = 6 0046 C 0047 C | | . | | 0048 C | | .. .. | | 0049 C | | .. . | | 0050 C | | .. . | | 0051 C | |.. .. | | 0052 C | |. ..| | 0053 C |------------. .|------------| 0054 C 0055 C FNDCLS uses the furthest west and east point of a ground track, as well 0056 C as the west and east boundary, in order to classify the ground track. 0057 C As it turns out, the times in LIMITS are not required in order to 1-Jun-1993 15:36:50 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:54:07 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.FOR;7 0058 C complete the classification. 0059 C 0060 C Note that the above ground track patterns do not have to begin within 0061 C the valid band. Except for CLASS 3 and 6, however, all other classes 0062 C do stop at the east or west boundary of the valid band. 0063 C 0064 C$ Input_Arguments 0065 C 0066 C Name Type Dim Units Description 0067 C ----------------------------------------------------------------------------- 0068 C LIMITS DP 4,2 days,km with regard to ascending nodes, the 0069 C time (in days) and ground track offset 0070 C (in km) of the first node, the furthest 0071 C west node, the furthest east node, and 0072 C the last node of the ground track. LIMITS 0073 C allows GTARG to classify the ground track. 0074 C time offset 0075 C |------|--------| 0076 C first node | days | km | 0077 C furthest west node | days | km | 0078 C furthest east node | days | km | 0079 C final node | days | km | 0080 C |------|--------| 0081 C BOUNDS DP 2 km the low and high boundaries (in that order) 0082 C of the valid ground track band as measured 0083 C from the reference ground track. Usually, 0084 C BOUNDS will be something like -/+ 1 km. 0085 C But, BOUNDS could be (.5,1.5), i.e., fully 0086 C right of the reference ground track. 0087 C 0088 C$ Output_Arguments 0089 C 0090 C Name Type Dim Units Description 0091 C ----------------------------------------------------------------------------- 0092 C CLASS I 1 - classification of ground track as per 0093 C discussion in Purpose Section. 0094 C 0095 C$ Files 0096 C 0097 C File Name Unit Number Description 0098 C ----------------------------------------------------------------------------- 0099 C * * standard I/O 0100 C OFILE 8 text output file 0101 C 0102 C$ Declarations_of_Input_and_Output_Arguments 0103 C 0104 DOUBLE PRECISION BOUNDS ( 2 ) 0105 INTEGER CLASS 0106 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0107 C 0108 C$ Declarations_of_Local_Variables 0109 C 0110 DOUBLE PRECISION END 0111 DOUBLE PRECISION ESTBND 0112 DOUBLE PRECISION FAREST 0113 DOUBLE PRECISION FARWST 0114 DOUBLE PRECISION START FNDCLS 1-Jun-1993 15:36:50 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:54:07 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.FOR;7 0115 DOUBLE PRECISION WSTBND 0116 C 0117 C$ Method 0118 C-& 0119 0120 C1 For clarity, transfer needed LIMITS and BOUNDS into local, simple 0121 C1 variables. 0122 0123 START = LIMITS(1,2) 0124 FARWST = LIMITS(2,2) 0125 FAREST = LIMITS(3,2) 0126 END = LIMITS(4,2) 0127 0128 WSTBND = BOUNDS(1) 0129 ESTBND = BOUNDS(2) 0130 0131 C1 Summary of classifcation rules (check in specified order!): 0132 C1 0133 C1 1] if furthest west >= east boundary --> CLASS = 3 0134 C1 0135 C1 2] if furthest east <= west boundary --> CLASS = 6 0136 C1 0137 C1 3] if furthest west < first node 0138 C1 AND furthest west < last node --> CLASS = 1 0139 C1 0140 C1 4] if furthest east > first node 0141 C1 AND furthest east > last node --> CLASS = 4 0142 C1 0143 C1 5] if furthest east = first node --> CLASS = 5 0144 C1 0145 C1 6] if furthest west = first node --> CLASS = 2 0146 0147 IF ( FARWST .GE. ESTBND ) THEN 0148 0149 CLASS = 3 0150 0151 ELSE IF ( FAREST .LE. WSTBND ) THEN 0152 0153 CLASS = 6 0154 0155 ELSE IF ( FARWST .LT. START .AND. FARWST .LT. END ) THEN 0156 0157 CLASS = 1 0158 0159 ELSE IF ( FAREST .GT. START .AND. FAREST .GT. END ) THEN 0160 0161 CLASS = 4 0162 0163 ELSE IF ( FAREST .EQ. START ) THEN 0164 0165 CLASS = 5 0166 0167 ELSE IF ( FARWST .EQ. START ) THEN 0168 0169 CLASS = 2 0170 0171 ELSE FNDCLS 1-Jun-1993 15:36:50 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:54:07 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.FOR;7 0172 0173 WRITE(*,301) BOUNDS , START , FARWST , FAREST , END 0174 WRITE(8,301) BOUNDS , START , FARWST , FAREST , END 0175 301 FORMAT(/,1X,'GTARG: FNDCLS failed to classify ground track:', 0176 & //,1X,' boundaries = ',2F20.10, 0177 & /,1X,' first node''s offset = ',F20.10, 0178 & /,1X,' far west node''s offset = ',F20.10, 0179 & /,1X,' far east node''s offset = ',F20.10, 0180 & /,1X,' final node''s offset = ',F20.10) 0181 0182 STOP 0183 0184 END IF 0185 0186 C1 End of FNDCLS. 0187 0188 RETURN 0189 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 296 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 255 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 599 ENTRY POINTS Address Type Name 0-00000000 FNDCLS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000000C@ I*4 CLASS 2-00000000 R*8 END ** R*8 ESTBND ** R*8 FAREST ** R*8 FARWST ** R*8 START ** R*8 WSTBND ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 BOUNDS 16 (2) AP-00000004@ R*8 LIMITS 64 (4, 2) FNDCLS 1-Jun-1993 15:36:50 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 20:54:07 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.FOR;7 LABELS Address Label 1-00000000 301' COMMAND QUALIFIERS FOR/LIS FNDCLS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDCLS.OBJ;2 COMPILATION STATISTICS Run Time: 0.34 seconds Elapsed Time: 3.46 seconds Page Faults: 226 Dynamic Memory: 472 pages 1-Jun-1993 15:36:58 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:57:01 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.FOR;12 0001 C$Procedure FNDDV 0002 C 0003 SUBROUTINE FNDDV ( STRAT , 0004 & CLSOLD , CLSNOW , 0005 & DVOLD , DVNOW , DVBND , 0006 & VALOLD , VALNOW , TARGET 0007 & ) 0008 C 0009 C 0010 C******************************************************************************* 0011 C 0012 C Copyright (C) 1993, California Institute of Technology. U.S. 0013 C Government Sponsorhip under NASA Contract NAS7-918 is 0014 C acknowledged. 0015 C 0016 C******************************************************************************* 0017 C 0018 C$ Log 0019 C 0020 C Date Name Description 0021 C ----------------------------------------------------------------------------- 0022 C 30-JUL-1990 Eric Cannell creation of FNDDV 0023 C 0024 C$ Purpose 0025 C 0026 C FNDDV determines the next dV to execute given the selected targeting 0027 C strategy, the old and current ground track classes, the old and current 0028 C dV's, the old and current success criteria variables, and the target 0029 C itself. 0030 C 0031 C The old criteria variable is the second to last value of the criteria 0032 C variable. The current criteria variable is the last value of the criteria 0033 C variable. The TARGET is the desired value of the criteria variable. What 0034 C the criteria variable represents depends on the strategy defined by STRAT: 0035 C 0036 C STRAT | criteria contents | units 0037 C -------|-----------------------------------------------|------ 0038 C 'LONG' | furthest west limit of ground tracks | km 0039 C 'EAST' | time for ground tracks to reach east boundary | days 0040 C 'WEST' | time for ground tracks to reach west boundary | days 0041 C 0042 C Note that VALOLD and VALNOW may or may not be used to compute the 0043 C next dV: it all depends on the strategy and CLSOLD and CLSNOW. 0044 C 0045 C FNDDV also ensures convergence by forcing the next dV to be within 0046 C the range defined by DVBND. If not, FNDDV replaces the dV with the 0047 C midpoint of the DVBND range. 0048 C 0049 C Finally, FNDDV is used for targeting a ground track. GTARG should not 0050 C be calling FNDDV when STRAT = 'RUNOUT'. 0051 C 0052 C$ Input_Arguments 0053 C 0054 C Name Type Dim Units Description 0055 C ----------------------------------------------------------------------------- 0056 C STRAT C*6 1 - see Purpose 0057 C CLSOLD I 1 - type of next to last ground track 1-Jun-1993 15:36:58 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:57:01 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.FOR;12 0058 C CLSNOW I 1 - type of last ground track 0059 C DVOLD DP 1 mm/sec dV of next to last ground track 0060 C DVNOW DP 1 mm/sec dV of last ground track 0061 C DVBND DP 2 mm/sec smallest range of dV's known to bound 0062 C the target dV: 0063 C DVBND(1) = largest dV < target dV 0064 C DVBND(2) = smallest dV > target dV 0065 C VALOLD DP 1 --> see Purpose 0066 C VALNOW DP 1 --> see Purpose 0067 C TARGET DP 1 --> see Purpose 0068 C 0069 C$ Output_Arguments 0070 C 0071 C Name Type Dim Units Description 0072 C ----------------------------------------------------------------------------- 0073 C DVOLD DP 1 mm/sec dV of last ground track (input DVNOW) 0074 C DVNOW DP 1 mm/sec dV of next ground track 0075 C 0076 C$ References 0077 C 0078 C 1] See GTARG.FOR for a discussion regarding the classification of 0079 C ground tracks. 0080 C 0081 C$ Restrictions 0082 C 0083 C 1] CLSOLD and CLSNOW can only have values in the range of 1..6 and 0084 C combinations defined in the Method Section of called routines. 0085 C 0086 C 2] FNDDV assumes that a positive dV is along the velocity vector and 0087 C raises the semi-major axis. Conversely, a negative dV is opposite 0088 C the velocity vector and lowers semi-major axis. 0089 C 0090 C 3] FNDDV cannot be called with STRAT = 'RUNOUT'. FNDDV is only for 0091 C targeting a ground track, not running one out. 0092 C 0093 C$ Library_Links 0094 C 0095 C Entry Point Name Location 0096 C ----------------------------------------------------------------------------- 0097 C DVEAST GTARG 0098 C DVLONG GTARG 0099 C DVWEST GTARG 0100 C 0101 C$ Files 0102 C 0103 C File Name Unit Number Description 0104 C ----------------------------------------------------------------------------- 0105 C * * standardd I/O 0106 C OFILE 8 text output file 0107 C 0108 C$ Declarations_of_Input_and_Output_Arguments 0109 C 0110 INTEGER CLSNOW 0111 INTEGER CLSOLD 0112 DOUBLE PRECISION DVBND ( 2 ) 0113 DOUBLE PRECISION DVNOW 0114 DOUBLE PRECISION DVOLD FNDDV 1-Jun-1993 15:36:58 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:57:01 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.FOR;12 0115 CHARACTER*6 STRAT 0116 DOUBLE PRECISION TARGET 0117 DOUBLE PRECISION VALNOW 0118 DOUBLE PRECISION VALOLD 0119 C 0120 C$ Method 0121 C-& 0122 0123 0124 C write(8,*) 'FNDDV(START): STRAT=', STRAT , 0125 C & ' CLSOLD=' , CLSOLD , 0126 C & ' CLSNOW=' , CLSNOW , 0127 C & ' DVOLD=' ,DVOLD , ' DVNOW=' , DVNOW , 0128 C & ' DVBND=' ,DVBND , ' VALOLD=' , VALOLD , 0129 C & ' VALNOW=' ,VALNOW , ' TARGET= ',TARGET 0130 0131 C1 Compute the new dV as per STRAT. 0132 0133 IF ( STRAT .EQ. 'LONG' ) THEN 0134 0135 CALL DVLONG ( CLSOLD , CLSNOW , 0136 & DVOLD , DVNOW , 0137 & VALOLD , VALNOW , TARGET 0138 & ) 0139 0140 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 0141 0142 CALL DVEAST ( CLSOLD , CLSNOW , 0143 & DVOLD , DVNOW , 0144 & VALOLD , VALNOW , TARGET 0145 & ) 0146 0147 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 0148 0149 CALL DVWEST ( CLSOLD , CLSNOW , 0150 & DVOLD , DVNOW , 0151 & VALOLD , VALNOW , TARGET 0152 & ) 0153 0154 ELSE 0155 0156 WRITE(*,301) STRAT 0157 WRITE(8,301) STRAT 0158 301 FORMAT(/,1X,'GTARG: in FNDDV, STRAT("',A6,'") is invalid.') 0159 0160 STOP 0161 0162 END IF 0163 0164 C1 Check that computed dV is within the know range of dV's bounding 0165 C1 target dV. If not, set next dV to midpoint of known range, i.e., 0166 C1 bisect the known dV bounds. 0167 0168 IF ( DVNOW .LE. DVBND(1) .OR. DVBND(2) .LE. DVNOW ) 0169 & DVNOW = ( DVBND(1) + DVBND(2) ) / 2D0 0170 0171 C1 End of FNDDV. FNDDV 1-Jun-1993 15:36:58 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 20:57:01 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.FOR;12 0172 C write(8,*) 'FNDDV(END): STRAT=', STRAT , 0173 C & ' CLSOLD=' , CLSOLD , 0174 C & ' CLSNOW=' , CLSNOW , 0175 C & ' DVOLD=' ,DVOLD , ' DVNOW=' , DVNOW , 0176 C & ' DVBND=' ,DVBND , ' VALOLD=' , VALOLD , 0177 C & ' VALNOW=' ,VALNOW , ' TARGET= ',TARGET 0178 0179 RETURN 0180 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 306 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 60 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 124 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 490 ENTRY POINTS Address Type Name 0-00000000 FNDDV VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000000C@ I*4 CLSNOW AP-00000008@ I*4 CLSOLD AP-00000014@ R*8 DVNOW AP-00000010@ R*8 DVOLD AP-00000004@ CHAR STRAT AP-00000024@ R*8 TARGET AP-00000020@ R*8 VALNOW AP-0000001C@ R*8 VALOLD ARRAYS Address Type Name Bytes Dimensions AP-00000018@ R*8 DVBND 16 (2) LABELS Address Label 1-00000000 301' FNDDV 1-Jun-1993 15:36:58 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 20:57:01 NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.FOR;12 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name DVEAST DVLONG DVWEST COMMAND QUALIFIERS FOR/LIS FNDDV.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]FNDDV.OBJ;2 COMPILATION STATISTICS Run Time: 0.34 seconds Elapsed Time: 2.86 seconds Page Faults: 253 Dynamic Memory: 472 pages 1-Jun-1993 15:37:05 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:58:25 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GETCPU.FOR;8 0001 C$Procedure GETCPU 0002 C 0003 REAL FUNCTION GETCPU 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C ** MACHINE DEPENDENT ** 0017 C 0018 C GETCPU returns the elapsed CPU time in seconds. 0019 C 0020 C$ Output_Arguments 0021 C 0022 C GETCPU - seconds of elapsed CPU time since last SETCPU call 0023 C 0024 C$ Log 0025 C 0026 C 01-Aug-1988 0027 C Eric Cannell - creation 0028 C 0029 C$ References 0030 C 0031 C 1- VAX/VMS System Routines - Run-time Library Routines, Volume 5B. 0032 C 0033 C$ Restrictions 0034 C 0035 C 1- SETCPU must be called prior to using GETCPU. 0036 C 0037 C For example: 0038 C 0039 C REAL GETCPU 0040 C EXTERNAL GETCPU 0041 C 0042 C REAL SETCPU 0043 C EXTERNAL SETCPU 0044 C 0045 C CPU0 = SETCPU() ! time since initialization 0046 C . 0047 C 0048 C . 0049 C CPU1 = GETCPU() 0050 C SINC01 = CPU1 - CPU0 ! time since CPU0 0051 C . 0052 C 0053 C . 0054 C CPU2 = GETCPU() 0055 C SINC12 = CPU2 - CPU1 ! time since CPU1 0056 C . 0057 C 1-Jun-1993 15:37:05 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 20:58:25 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GETCPU.FOR;8 0058 C . 0059 C CPU3 = GETCPU() 0060 C SINC03 = CPU3 - CPU0 ! time since CPU0 0061 C 0062 C 2- Of course, GETCPU itself takes a minor amount of CPU time after 0063 C the system calls... 0064 C 0065 C$ Declarations_of_Local_Variables 0066 C 0067 INTEGER CPU10M 0068 C 0069 C$ Method 0070 C-& 0071 0072 C1 Use system run-time routine LIB$STAT_TIMER to get elapsed CPU 0073 C1 time. 0074 0075 CALL LIB$STAT_TIMER( 2 , CPU10M , ) 0076 0077 C1 Convert ten's of milliseconds of system time to seconds. 0078 0079 GETCPU = FLOAT( CPU10M ) / 100.0 0080 0081 RETURN 0082 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 28 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 24 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 56 ENTRY POINTS Address Type Name 0-00000000 R*4 GETCPU VARIABLES Address Type Name 2-00000004 I*4 CPU10M GETCPU 1-Jun-1993 15:37:05 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 20:58:25 NAVDEV:[SHAPIRO.COSMIC.SOURCE]GETCPU.FOR;8 FUNCTIONS AND SUBROUTINES REFERENCED Type Name LIB$STAT_TIMER COMMAND QUALIFIERS FOR/LIS GETCPU.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GETCPU.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GETCPU.OBJ;2 COMPILATION STATISTICS Run Time: 0.24 seconds Elapsed Time: 2.59 seconds Page Faults: 235 Dynamic Memory: 456 pages 1-Jun-1993 15:37:11 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 20:59:47 [SHAPIRO.COSMIC.SOURCE]GOTO_STRING.FOR;3 0001 character*8 function goto_string ( line, column ) 0002 C 0003 C Move cursor to specified screen position 0004 C NOTE: This function is currently only implemented to work on a VT100 0005 C compatable terminal. 0006 C 0007 C******************************************************************************* 0008 C 0009 C Copyright (C) 1993, California Institute of Technology. U.S. 0010 C Government Sponsorhip under NASA Contract NAS7-918 is 0011 C acknowledged. 0012 C 0013 C******************************************************************************* 0014 C 0015 C 0016 integer line, column 0017 character*8 command, terminal*12 0018 common /tt/ terminal 0019 0020 command = ' ' 0021 0022 if (terminal .eq. 'VT100' ) then 0023 write (command,200) 27,line,column 0024 200 format(a1,'[',i2.2,';',i2.2,'H') 0025 end if 0026 0027 goto_string = command 0028 return 0029 end GOTO_STRING 1-Jun-1993 15:37:11 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 20:59:47 [SHAPIRO.COSMIC.SOURCE]GOTO_STRING.FOR;3 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 102 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 27 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 24 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 165 ENTRY POINTS Address Type Name 0-00000000 CHAR GOTO_STRING VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000000C@ I*4 COLUMN 2-00000000 CHAR COMMAND AP-00000008@ I*4 LINE 3-00000000 CHAR TERMINAL LABELS Address Label 1-00000004 200' 1-Jun-1993 15:37:11 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 20:59:47 [SHAPIRO.COSMIC.SOURCE]GOTO_STRING.FOR;3 0001 0002 C program tester 0003 C character*8 goto_string 0004 C write (6,*) goto_string(10,45),'Testing 1,2,3.' 0005 C end COMMAND QUALIFIERS FOR/LIS GOTO_STRING.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GOTO_STRING.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]GOTO_STRING.OBJ;2 COMPILATION STATISTICS Run Time: 0.22 seconds Elapsed Time: 1.51 seconds Page Faults: 189 Dynamic Memory: 456 pages 1-Jun-1993 15:37:48 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:00:35 [SHAPIRO.COSMIC.SOURCE]INIT_PARMS.FOR;6 0001 C$Procedure Init_parms 0002 0003 subroutine init_parms 0004 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C 0015 C$ Log 0016 C 0017 C Date Name Description 0018 C ----------------------------------------------------------------------------- 0019 C 30-Sep-1991 B. Shapiro creation 0020 C 0021 C$ Purpose 0022 C 0023 C Initializes the derived physical constants (e.g., earth rotation 0024 C rate). 0025 C 0026 C$ Input_Arguments 0027 C 0028 C Name Type Dim Units Description 0029 C ----------------------------------------------------------------------------- 0030 C none 0031 C 0032 C$ Output_Arguments 0033 C 0034 C Name Type Dim Units Description 0035 C ----------------------------------------------------------------------------- 0036 C none 0037 C 0038 C$ Namelist_Output 0039 C 0040 C Name Type Dim Units Description 0041 C ----------------------------------------------------------------------------- 0042 C none 0043 C 0044 C 0045 C$ Parameters 0046 C 0047 double precision pi 0048 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0049 C 0050 C$ Declarations_of_Global_Variables 0051 C 0052 C Name Type Dim Units Description 0053 C ----------------------------------------------------------------------------- 0054 C earth_rad d 1 km earth equatorial radius 0055 C earth_freq d 1 rad/sec earth rotation frequency 0056 C earth_rate d 1 meters/day earth rotation speed 0057 C mu_earth d 1 km**3/sec**2 Earth gravity constant INIT_PARMS 1-Jun-1993 15:37:48 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:00:35 [SHAPIRO.COSMIC.SOURCE]INIT_PARMS.FOR;6 0058 C mu_moon d 1 km**3/sec**2 Earth gravity constant 0059 C mu_sun d 1 km**3/sec**2 Earth gravity constant 0060 C sid_day d 1 seconds Length of sidereal day 0061 C deg_to_km d 1 km/degree 1 degree of longitude at equator 0062 C 0063 0064 double precision earth_rad ! in kilomters 0065 double precision earth_freq ! radians / second 0066 double precision earth_rate ! kilomters / day 0067 double precision mu_earth ! km**3/sec 0068 double precision mu_moon ! km**3/sec 0069 double precision mu_sun ! km**3/sec 0070 double precision sid_day ! seconds 0071 double precision deg_to_km ! kilometers/deg 0072 0073 common / physical_constants / 0074 & earth_rad, earth_freq, earth_rate, mu_earth, 0075 & mu_moon, mu_sun, sid_day, deg_to_km 0076 0077 C$ External_Statements 0078 C 0079 C none 0080 C 0081 C$ Method 0082 C 0083 deg_to_km = pi * earth_rad / 180.0d0 0084 0085 earth_rate = 2 * pi * earth_rad * 86400000.0 / sid_day 0086 0087 earth_freq = 2 * pi / sid_day 0088 0089 return 0090 end INIT_PARMS 1-Jun-1993 15:37:48 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:00:35 [SHAPIRO.COSMIC.SOURCE]INIT_PARMS.FOR;6 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 94 PIC CON REL LCL SHR EXE RD NOWRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 158 ENTRY POINTS Address Type Name 0-00000000 INIT_PARMS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-00000038 R*8 DEG_TO_KM 3-00000008 R*8 EARTH_FREQ 3-00000000 R*8 EARTH_RAD 3-00000010 R*8 EARTH_RATE 3-00000018 R*8 MU_EARTH 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN 3-00000030 R*8 SID_DAY 1-Jun-1993 15:37:48 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 21:00:35 [SHAPIRO.COSMIC.SOURCE]INIT_PARMS.FOR;6 0001 COMMAND QUALIFIERS FOR/LIS INIT_PARMS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INIT_PARMS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INIT_PARMS.OBJ;2 COMPILATION STATISTICS Run Time: 0.28 seconds Elapsed Time: 2.60 seconds Page Faults: 206 Dynamic Memory: 456 pages 1-Jun-1993 15:37:55 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:01:18 INTERP_DRAG_BIAS.FOR;9 0001 C$Procedure interp_drag_bias 0002 C 0003 subroutine interp_drag_bias ( x, ydata, n, y ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 30-AUG-1991 Bruce Shapiro Creation of interp_drag_bias 0019 C Built from interp 0020 C 0021 C$ Purpose 0022 C 0023 C Linear interpolation into an array 0024 C 0025 C$ Input_Arguments 0026 C 0027 C Name Type Dim Units Description 0028 C ----------------------------------------------------------------------------- 0029 C X DP - - x-value of desired point 0030 C Y DP - - return value y-value 0031 C Ydata DP - - y-data in world coordinates 0032 C N I 1 - number of data points 0033 C 0034 C$ Parameters 0035 C 0036 C 0037 C$ Declarations_of_Input_and_Output_Arguments 0038 C 0039 0040 INTEGER N 0041 DOUBLE PRECISION YDATA ( N ) 0042 DOUBLE PRECISION X 0043 DOUBLE PRECISION Y 0044 C 0045 C$ Declarations_of_Local_Variables 0046 C 0047 C Name Type Dim Units Description 0048 C ----------------------------------------------------------------------------- 0049 C 0050 C$ Namelists 0051 C 0052 C 0053 C$ Data_Statements 0054 C 0055 C 0056 C$ Method 0057 C-& INTERP_DRAG_BIAS 1-Jun-1993 15:37:55 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:01:18 INTERP_DRAG_BIAS.FOR;9 0058 0059 INTEGER I1 0060 DOUBLE PRECISION X1, X2, Y1, Y2 0061 0062 C assume the data is distributed one point per day to the last point 0063 C with the first point being for day 0 0064 0065 i1 = idint ( x ) + 1 0066 0067 C now do a linear interpolation 0068 0069 if ( i1 .lt. 1 ) then 0070 y1 = ydata ( 1 ) 0071 y2 = ydata ( 2 ) 0072 x1 = 0.0 0073 x2 = 1.0 0074 else if ( i1 .GE. n ) THEN 0075 y1 = ydata ( N - 1 ) 0076 y2 = ydata ( N ) 0077 x1 = dble ( N - 2 ) 0078 x2 = dble ( N - 1 ) 0079 else 0080 y1 = ydata ( I1) 0081 y2 = ydata ( I1 + 1) 0082 x1 = dble ( I1 - 1) 0083 x2 = dble ( I1 ) 0084 end if 0085 0086 if ( x2 .eq. x1 ) then 0087 y = y1 0088 else 0089 y = y1 + ( x - x1 ) * (y2-y1) / (x2-x1) 0090 end if 0091 0092 return 0093 end INTERP_DRAG_BIAS 1-Jun-1993 15:37:55 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:01:18 INTERP_DRAG_BIAS.FOR;9 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 159 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 40 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 199 ENTRY POINTS Address Type Name 0-00000000 INTERP_DRAG_BIAS VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I1 AP-0000000C@ I*4 N AP-00000004@ R*8 X ** R*8 X1 ** R*8 X2 AP-00000010@ R*8 Y ** R*8 Y1 ** R*8 Y2 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 YDATA ** (*) 1-Jun-1993 15:37:55 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 21:01:18 INTERP_DRAG_BIAS.FOR;9 0001 0002 C program tester 0003 C double precision x, y, xdata(12), ydata(12) 0004 C integer n 0005 C 0006 C data n / 10 / 0007 C data xdata /2, 3, 5, 7, 11, 0008 C & 13, 17, 19, 23, 29, 31, 37/ 0009 C data ydata /100, 200, 300, 400, 500, 0010 C & 600, 700, 800, 900, 1000, 1001, 1002 / 0011 C 0012 C write (6,*) xdata 0013 C write (6,*) '*****' 0014 C write (6,*) ydata 0015 C write (6,*) '*****' 0016 C 0017 C x = 8.4 0018 C call interp_drag_bias ( x, ydata, n, y ) 0019 C write (6,*) x,' ', y 0020 C end COMMAND QUALIFIERS FOR/LIS INTERP_DRAG_BIAS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INTERP_DRAG_BIAS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INTERP_DRAG_BIAS.OBJ;2 COMPILATION STATISTICS Run Time: 0.30 seconds Elapsed Time: 2.04 seconds Page Faults: 225 Dynamic Memory: 472 pages 1-Jun-1993 15:37:59 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:01:55 [SHAPIRO.COSMIC.SOURCE]INTERP_LINE.FOR;3 0001 C$Procedure interp_line 0002 C 0003 subroutine interp_line ( x, x1, x2, y1, y2, y ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 29-OCT-1991 Bruce Shapiro Creation of interp_line 0019 C 0020 C$ Purpose 0021 C 0022 C Linear interpolation (extrapolation) based upon a two-point line 0023 C Based on the line from (x1, y1) to (x2, y2) find value of y 0024 C corresponding to x 0025 C 0026 C$ Input_Arguments 0027 C 0028 C Name Type Dim Units Description 0029 C ----------------------------------------------------------------------------- 0030 C X DP - - x-value of desired point 0031 C x1, x2 DP 1 - x values defining line 0032 C y1, y2 DP 1 - y values definining line 0033 C N I 1 - number of data points 0034 C 0035 C$ OUTput_Arguments 0036 C 0037 C Name Type Dim Units Description 0038 C ----------------------------------------------------------------------------- 0039 C Y DP - - return value y-value 0040 C 0041 C 0042 C 0043 DOUBLE PRECISION X, Y, x1, x2, y1, y2, M, B 0044 C 0045 C 0046 C$ Method 0047 C-& 0048 m = 0.0 0049 0050 if ( x2 .ne. x1 ) m = (y2-y1)/(x2-x1) 0051 0052 b = y1 - m * x1 0053 0054 y = m * x + b 0055 0056 return 0057 INTERP_LINE 1-Jun-1993 15:37:59 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:01:55 [SHAPIRO.COSMIC.SOURCE]INTERP_LINE.FOR;3 0058 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 47 PIC CON REL LCL SHR EXE RD NOWRT QUAD Total Space Allocated 47 ENTRY POINTS Address Type Name 0-00000000 INTERP_LINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 B ** R*8 M AP-00000004@ R*8 X AP-00000008@ R*8 X1 AP-0000000C@ R*8 X2 AP-00000018@ R*8 Y AP-00000010@ R*8 Y1 AP-00000014@ R*8 Y2 COMMAND QUALIFIERS FOR/LIS INTERP_LINE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INTERP_LINE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]INTERP_LINE.OBJ;2 COMPILATION STATISTICS Run Time: 0.18 seconds Elapsed Time: 1.78 seconds Page Faults: 193 Dynamic Memory: 456 pages 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 1 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 0001 C$Procedure JRSMPL2 0002 C 0003 DOUBLE PRECISION FUNCTION JRSMPL2 ( FLX , FLXBAR , KP, YEAR ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C 12-JUN-1990 - Eric Cannell - creation of JRSMPL 0017 C 1-MAY-1991 - Bruce Shapiro - add average density, semiannual correction 0018 C 1-DEC-1992 - B.S. - invoke USER_DENSITY if ATMOS='USER' 0019 C 0020 C$ Purpose 0021 C 0022 C JRSMPL2 computes atmospheric density using a model based upon 10 raised 0023 C to a quadratic ploynomial. 0024 C 0025 C log rho = P(T) + a cos (2 * pi * t + phi1) + b cos (4 * pi * t + phi2 ) 0026 C 0027 C where 0028 C 0029 C T = T-infinity from the Jacchia Roberts model. It is 0030 C T-infinity that is a function of solar flux (FLX), the 81-day moving 0031 C average (FLXBAR), and the geomagnetic Kp index (KP). 0032 C 0033 C t = time of the year, 1/1 at 00:00 ==> 0.0, 12/31 at 24:00 ==> 1.0 0034 C 0035 C P(T) = quadratic polynomial expressed in terms of Chebyshev basis 0036 C (refer to MATH-77 library documentation for explanation of the 0037 C five coefficients required) 0038 C 0039 C$ Input_Arguments 0040 C 0041 C Name Type Dim Units Description 0042 C ----------------------------------------------------------------------------- 0043 C FLX DP 1 the usual the solar flux 0044 C FLXBAR DP 1 the usual the 81 day moving average of solar flux 0045 C ending on and including FLX. The GSFC's 0046 C Jacchia-Robert source code indicates that 0047 C the 81 day moving average should be 0048 C centered on FLX, but this seems 0049 C counter-intuitive. 0050 C KP DP 1 the usual the geomagnetic Kp index. The GSFC's 0051 C Jacchia-Robert source code uses the 3-hour 0052 C Kp value, but for simplicity an 0053 C interpolated Kp value will probably 0054 C suffice. 0055 C YEAR DP 1 years Time into CURRENT year in fraction of a 0056 C year 0057 C 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 2 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 0058 C$ Output_Arguments 0059 C 0060 C Name Type Dim Units Description 0061 C ----------------------------------------------------------------------------- 0062 C JRSMPL DP 1 kg/km**3 function return that is the atmospheric 0063 C density 0064 C 0065 C$ References 0066 C 0067 C 1] Marc A. Sengstacke, Fortran Subroutine JRDRIVE Version 3, 29 May 1990. 0068 C JRDRIV is an implementation of the Jacchia-Roberts Atmospheric 0069 C Density Model originally coded at GSFC. 0070 C 0071 C 2] Eric Cannel, JRSMPL-A Simple Fortran Function to Approximate 0072 C Atmospheric Density, JPL IOM No. 314.9/90-481, 13 June 1990. 0073 C 0074 C 3] Bruce Shapiro, Improved Approximation to Simplified Jacchia-Roberts 0075 C Density Model, JPL IOM No. TBD, May 1991. 0076 C 0077 C 4] JPL Applied Mathematics Group, MATH77, Release 3.0, A Library of 0078 C Mathematical Subprograms for FORTRAN-77, JPL D-1341, Rev. B, 0079 C May 1989. 0080 C 0081 C$ Restrictions 0082 C 0083 C 1] JRFIT assumes that the 4000+ daily samples over a 10 years period 0084 C cover an appropriate range of solar flux and Kp values. 0085 C 0086 C$ Library_Links 0087 C 0088 C MATH77 0089 C 0090 C$ Declarations_of_Input_and_Output_Arguments 0091 C 0092 DOUBLE PRECISION FLX ! Solar Flux, 1 day lag 0093 DOUBLE PRECISION FLXBAR ! 81-Day centered Mean of FLX 0094 DOUBLE PRECISION KP ! Kp index, 6.7 hour lag 0095 DOUBLE PRECISION YEAR ! Fraction of year 0096 0097 common /dragblock/ dragmodel, dragarea, atmos, atden, 0098 & FLUX_SLOPE, FBAR_SLOPE, FLUX_BIAS, FBAR_BIAS, 0099 & ATDEN_POLY, ATDEN_ANN, ATDEN_SEMI 0100 character*10 dragmodel, atmos 0101 double precision dragarea, atden 0102 double precision FLUX_SLOPE(6), FBAR_SLOPE(6) 0103 double precision FLUX_BIAS(6), FBAR_BIAS(6) 0104 double precision ATDEN_POLY(5), ATDEN_ANN(2) 0105 double precision ATDEN_SEMI(2) 0106 C 0107 C$ Declarations_of_Local_Variables 0108 C 0109 DOUBLE PRECISION DTINF ! Kp contribution to T-infinity 0110 DOUBLE PRECISION LOG_RHO ! Log base 10 of density fit 0111 DOUBLE PRECISION MAG_ANNUAL ! Magnitude of Annual correction 0112 DOUBLE PRECISION MAG_SEMIANNUAL 0113 INTEGER NDEG ! Order of polynomial fit 0114 DOUBLE PRECISION P ( 5 ) ! Coefficients of polynomial fit JRSMPL2 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 3 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 0115 DOUBLE PRECISION PHASE_ANNUAL ! Phase of Annual/Semiannual correction 0116 DOUBLE PRECISION PHASE_SEMIANNUAL 0117 DOUBLE PRECISION RHO ! Density , kg/m**3 0118 DOUBLE PRECISION TC ! F10.7 and FLXBAR contr. to T-infinity 0119 DOUBLE PRECISION TINF ! T-infinity, exospheric temperature 0120 DOUBLE PRECISION PI 0121 C 0122 C$ External_Statements 0123 C 0124 DOUBLE PRECISION DCPVAL ! Polynomial evaluation in MATH77 0125 EXTERNAL DCPVAL 0126 C 0127 C$ Data_Statements 0128 C 0129 DATA NDEG / 2 / 0130 DATA P / 0.102444406127929688D+04, 0131 & 0.414349639892578125D+03, 0132 & -.581061572488852007D+01, 0133 & 0.720650161644122988D+00, 0134 & 0.842769258090778408D-04 / 0135 data MAG_SEMIANNUAL /-0.0791350355550989d+00 / 0136 data phase_SEMIANNUAL/5.4144904588160714d+00/ 0137 data mag_annual /0.0454889572120465d+00/ 0138 data phase_annual /6.1054952840340235d+00/ 0139 0140 logical first 0141 data first/.true./ 0142 C 0143 Parameter (PI = 3.141592653589893238d0) 0144 C 0145 C$ Method 0146 C-& 0147 0148 0149 if (ATMOS .EQ. 'CONSTANT' ) then 0150 if (first) then 0151 write(8,*) 'Using Constant Density Atmosphere.' 0152 first = .false. 0153 end if 0154 JRSMPL2 = ATDEN 0155 return 0156 0157 else if ((ATMOS .NE. 'TOPEXJR').and. 0158 & (ATMOS .NE. 'POLYNOMIAL') ) then 0159 if (first) then 0160 write(8,*) 'Using User-Supplied Density Function.' 0161 first = .false. 0162 end if 0163 0164 JRSMPL2 = USER_DENSITY ( YEAR, FLX, FLXBAR, KP ) 0165 return 0166 end if 0167 0168 if (first) then 0169 write(8,*) 'Using Average Orbital Jacchia-Roberts Atmosphere' 0170 first = .false. 0171 end if JRSMPL2 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 4 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 0172 0173 C1 Compute delta-T-infinity. 0174 0175 DTINF = 28.0D0 * KP + 0.03D0 * DEXP( KP ) 0176 0177 C1 Compute Tc. 0178 0179 TC = 379.0D0 + 3.24 * FLXBAR + 1.3D0 * ( FLX - FLXBAR ) 0180 0181 C1 Compute T-infinity. 0182 0183 TINF = TC + DTINF 0184 0185 C1 Compute density via simple model, 10**a+bx+cx**2. DCPVAL 0186 C1 is a MATH77 routine that evaluates the quadratic exponent. (I used 0187 C1 MATH77's DPFIT to fit the quadratic to 4018 data points.) 0188 0189 0190 IF (ATMOS .EQ. 'TOPEXJR') then 0191 LOG_RHO = DCPVAL ( P, NDEG, TINF ) + 0192 & Mag_semiannual * dcos ( 4 * pi * year + phase_semiannual) + 0193 & Mag_annual * dcos ( 2 * pi * year + phase_annual ) 0194 else IF (ATMOS .EQ. 'POLYNOMIAL') then 0195 LOG_RHO = DCPVAL ( ATDEN_POLY, NDEG, TINF ) + 0196 & ATDEN_SEMI(1) * dcos ( 4 * pi * year + ATDEN_SEMI(2)) + 0197 & ATDEN_ANN(1) * dcos ( 2 * pi * year + ATDEN_ANN(2) ) 0198 else 0199 write(8,*) '>>> ERROR: INVALID ATMOS = ',ATMOS 0200 stop 'ERROR EXIT: Invalid ATMOS input' 0201 end if 0202 0203 0204 RHO = 10D0 ** log_rho 0205 0206 C1 Return the density. 0207 0208 JRSMPL2 = RHO 0209 0210 RETURN 0211 END JRSMPL2 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 5 01 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 540 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 202 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 204 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DRAGBLOCK 300 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1246 ENTRY POINTS Address Type Name 0-00000000 R*8 JRSMPL2 VARIABLES Address Type Name Address Type Name 3-0000001C R*8 ATDEN 3-00000012 CHAR ATMOS 3-0000000A R*8 DRAGAREA 3-00000000 CHAR DRAGMODEL ** R*8 DTINF 2-00000064 L*4 FIRST AP-00000004@ R*8 FLX AP-00000008@ R*8 FLXBAR AP-0000000C@ R*8 KP 2-00000030 R*8 LOG_RHO 2-00000038 R*8 MAG_ANNUAL 2-00000040 R*8 MAG_SEMIANNUAL 2-00000060 I*4 NDEG 2-00000048 R*8 PHASE_ANNUAL 2-00000050 R*8 PHASE_SEMIANNUAL ** R*8 RHO ** R*8 TC 2-00000058 R*8 TINF AP-00000010@ R*8 YEAR ARRAYS Address Type Name Bytes Dimensions 3-0000010C R*8 ATDEN_ANN 16 (2) 3-000000E4 R*8 ATDEN_POLY 40 (5) 3-0000011C R*8 ATDEN_SEMI 16 (2) 3-000000B4 R*8 FBAR_BIAS 48 (6) 3-00000054 R*8 FBAR_SLOPE 48 (6) 3-00000084 R*8 FLUX_BIAS 48 (6) 3-00000024 R*8 FLUX_SLOPE 48 (6) 2-00000000 R*8 P 40 (5) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 DCPVAL R*8 MTH$DCOS R*8 MTH$DEXP R*4 USER_DENSITY JRSMPL2 1-Jun-1993 15:38:04 VAX FORTRAN V5.6-119 Page 6 01 6-May-1993 16:07:49 NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.FOR;16 COMMAND QUALIFIERS FOR/LIS JRSMPL2.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]JRSMPL2.OBJ;2 COMPILATION STATISTICS Run Time: 0.46 seconds Elapsed Time: 2.48 seconds Page Faults: 278 Dynamic Memory: 512 pages 1-Jun-1993 15:38:09 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:04:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]KEP2CAR.FOR;8 0001 subroutine kep2car ( kep, car, mu ) 0002 double precision kep(6), car(6), mu 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C Input: Keplerian elements in km and degrees 0013 C Output: Cartesian elements in km and km/sec. 0014 C 0015 0016 double precision p(3), q(3), w(3), COSRAAN, SINRAAN, 0017 & COSAOP, SINAOP, COSINCL, SININCL, U, THETA, 0018 & COSTHETA, SINTHETA, R, VCIRC, SemiParm 0019 0020 double precision pi 0021 parameter ( pi=3.14159 26535 89793 23846) 0022 0023 cosRAAN = cos(kep(4)*PI/180.0) 0024 sinRAAN = sin(kep(4)*PI/180.0) 0025 cosAOP = cos(kep(5)*PI/180.0) 0026 sinAOP = sin(kep(5)*PI/180.0) 0027 cosINCL = cos(kep(3)*PI/180.0) 0028 sinINCL = sin(kep(3)*PI/180.0) 0029 0030 P(1) = cosRAAN * cosAOP - sinRAAN * sinAOP * cosINCL 0031 P(2) = sinRAAN * cosAOP + cosRAAN * sinAOP * cosINCL 0032 P(3) = sinAOP * sinINCL 0033 0034 Q(1) = -cosRAAN * sinAOP - sinRAAN * cosAOP * cosINCL 0035 Q(2) = -sinRAAN * sinAOP + cosRAAN * cosAOP * cosINCL 0036 Q(3) = cosAOP * sinINCL 0037 0038 W(1) = sinRAAN * sinINCL 0039 W(2) = -cosRAAN * sinINCL 0040 W(3) = cosINCL 0041 0042 CALL ORB2U (KEP, U) 0043 0044 THETA = U - KEP(5) 0045 cosTHETA = cos( THETA * PI/180.0 ) 0046 sinTHETA = sin( THETA * PI/180.0 ) 0047 0048 SemiParm = kep(1) * ( 1 - KEP(2)*kep(2) ) 0049 R = SemiParm / ( 1 + kep(2)*cosTHETA ) 0050 0051 VCIRC = SQRT ( MU / (SemiParm) ) 0052 0053 0054 do i=1,3 0055 car(i) = r * COSTHETA * P(i) + r * SINTHETA * Q(i) 0056 car(i+3) = Vcirc * ( -SINTHETA * P(i) + 0057 & ( kep(2) + cosTheta ) * Q(i) ) KEP2CAR 1-Jun-1993 15:38:09 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:04:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]KEP2CAR.FOR;8 0058 end do 0059 0060 return 0061 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 423 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 180 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 603 ENTRY POINTS Address Type Name 0-00000000 KEP2CAR VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000058 R*8 COSAOP ** R*8 COSINCL 2-00000048 R*8 COSRAAN 2-00000070 R*8 COSTHETA ** I*4 I AP-0000000C@ R*8 MU ** R*8 R ** R*8 SEMIPARM ** R*8 SINAOP 2-00000060 R*8 SININCL 2-00000050 R*8 SINRAAN 2-00000078 R*8 SINTHETA ** R*8 THETA 2-00000068 R*8 U ** R*8 VCIRC ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 CAR 48 (6) AP-00000004@ R*8 KEP 48 (6) 2-00000000 R*8 P 24 (3) 2-00000018 R*8 Q 24 (3) 2-00000030 R*8 W 24 (3) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 MTH$DCOS R*8 MTH$DSIN R*8 MTH$DSQRT ORB2U 1-Jun-1993 15:38:09 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:04:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]KEP2CAR.FOR;8 0001 0002 C program driver 0003 C double precision CAR(6), KEP(6), MU 0004 C data KEP / 7714.43446628842718837, 0.00010252944063611, 0005 C & 66.04284092566848763, 30.31672498043705000, 0006 C & 89.87211868114119540, 220.04188763963342623 / 0007 C MU = 398600.436000 0008 C 0009 C call kep2car ( KEP, CAR, MU ) 0010 C write(6,*) 'KEP = ', kep 0011 C write(6,*) 'CAR = ', car 0012 C end COMMAND QUALIFIERS FOR/LIS KEP2CAR.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]KEP2CAR.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]KEP2CAR.OBJ;2 COMPILATION STATISTICS Run Time: 0.40 seconds Elapsed Time: 2.87 seconds Page Faults: 256 Dynamic Memory: 504 pages 28-May-1993 19:16:46 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:12:05 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LINKTIME.FOR;1 0001 C 0002 C LINKTIME 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C This program is COMPILED, LINKED, and EXECUTED just prior to linking 0013 C another program. It creates the function subroutine LNKTIM. The 0014 C function LNKTIM then provides the link time when it is call by the main 0015 C program. 0016 C For example, 0017 C 0018 C (1) Edit the program test.for 0019 C program test 0020 C : 0021 C character*24 x, lnktim 0022 C external lnktim 0023 C : 0024 C : 0025 C x = lnktim() 0026 C print *, 'Test created at ',x 0027 C : 0028 C : 0029 C stop 0030 C end 0031 C 0032 C (2) Compile and link as follows: 0033 C 0034 C FOR TEST 0035 C FOR LINKTIME 0036 C LINK LINKTIME 0037 C RUN LINKTIME 0038 C LINK TEST, LNKTIM 0039 C 0040 C (3) when the program TEST is executed, the line 0041 C 0042 C Test created at 4-JUL-1776 12:00:00 0043 C 0044 C will be printed out. 0045 C 0046 C NOTE: THIS program, LINKTIME, is not actually linked with the 0047 C main program. It is an independent program which 0048 C is compiled and executed at linkage of the main program. 0049 C The subroutine LNKTIM which is created by LINKTIME 0050 C is what is really used!!. 0051 C 0052 C CREATION LOG: created by UNKNOWN AUTHOR 0053 C at an UNKNOWN TIME 0054 C in an UNKNOWN PLACE 0055 C 0056 0057 character*8 timebuf LINKTIME$MAIN 28-May-1993 19:16:46 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:12:05 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LINKTIME.FOR;1 0058 character*9 datebuf 0059 call DATE(datebuf) 0060 call TIME(timebuf) 0061 open(unit=10,name='lnktim.f',status='NEW') 0062 write(10,*) ' FUNCTION LNKTIM()' 0063 write(10,*) ' CHARACTER*(*) LNKTIM' 0064 write(10,100) datebuf, timebuf 0065 100 format(' LNKTIM = ''',A9,1x,a8,'''') 0066 write(10,*) ' END' 0067 close(10) 0068 write(6,*)'Link Time is ',datebuf,' ',timebuf 0069 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 219 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 114 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 132 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 465 ENTRY POINTS Address Type Name 0-00000000 LINKTIME$MAIN VARIABLES Address Type Name Address Type Name 2-00000008 CHAR DATEBUF 2-00000000 CHAR TIMEBUF LABELS Address Label 1-00000054 100' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name FOR$CLOSE FOR$DATE_T_DS FOR$OPEN FOR$TIME_T_DS LINKTIME$MAIN 28-May-1993 19:16:46 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:12:05 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LINKTIME.FOR;1 COMMAND QUALIFIERS FOR/LIS/NOOBJ LINKTIME /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LINKTIME.LIS;1 /NOOBJECT COMPILATION STATISTICS Run Time: 0.25 seconds Elapsed Time: 3.40 seconds Page Faults: 176 Dynamic Memory: 344 pages 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 0001 C$Procedure LSRGPB 0002 C 0003 SUBROUTINE LSRGPB ( IOFLAG , ITFLAG , ITVALU ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C 19-JUN-1990 - Eric Cannell - creation of LSRGPB 0017 C 0018 C$ Purpose 0019 C 0020 C LSRGPB is the bulletin board for the LSRGP library. Rather than using 0021 C common blocks to pass data out of the LSRGP library, LSRGP will simply post 0022 C a value on the LSRGP bulletin board. A calling program, such as EQXING, 0023 C can then read the board for the posted value. 0024 C 0025 C ADDING SLOTS TO THE BULLETIN BOARD: 0026 C 0027 C A programmer can add more slots to the bulletin board by creating 0028 C three additional variables and adding two ELSE IF clauses. 0029 C 0030 C The first variable is the xID parameter used to identify the slot, 0031 C the second is the SAVEd xVAL variable that holds the actual value, 0032 C and the third is the SAVEd xSET variable that makes sure that a 0033 C value has been "PUT" before it can be "GET"ed. Be sure to DATA set 0034 C the xSET variable. 0035 C 0036 C One of the ELSE IF clauses is for PUTting and the other for GETting. 0037 C 0038 C Currently, the only values that can be posted and read are: 0039 C 0040 C item | ITFLAG | description 0041 C -------|------------|---------------------------------------------- 0042 C N | "LSRGP_N" | the mean motion rads/sec 0043 C N | "LSRGP_NHI" | the mean motion rads/sec 0044 C N | "LSRGP_NLO" | the mean motion rads/sec 0045 C 0046 C$ Input_Arguments 0047 C 0048 C Name Type Dim Units Description 0049 C ----------------------------------------------------------------------------- 0050 C IOFLAG C*3 1 - either "PUT"s or "GET"s a value from 0051 C the bulletin board 0052 C ITFLAG C*(*) 1 - string which identifies value, see purpose 0053 C ITVALU DP 1 ? value to be posted 0054 C 0055 C$ Output_Arguments 0056 C 0057 C Name Type Dim Units Description 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 0058 C ----------------------------------------------------------------------------- 0059 C ITVALU DP 1 ? value to be gotten 0060 C 0061 C$ Restrictions 0062 C 0063 C 1] LSRGPB will only handle double precision values. 0064 C 0065 C$ Library_Links 0066 C 0067 C TPXUTIL 0068 C 0069 C$ Parameters 0070 C 0071 CHARACTER*3 GET 0072 PARAMETER ( GET = 'GET' ) 0073 0074 CHARACTER*3 PUT 0075 PARAMETER ( PUT = 'PUT' ) 0076 0077 CHARACTER*7 NID 0078 PARAMETER ( NID = 'LSRGP_N' ) 0079 0080 CHARACTER*7 NIDHI 0081 PARAMETER ( NIDHI = 'LSRGP_NHI' ) 0082 0083 CHARACTER*7 NIDLO 0084 PARAMETER ( NIDLO = 'LSRGP_NLO' ) 0085 0086 C 0087 C$ Declarations_of_Input_and_Output_Arguments 0088 C 0089 CHARACTER*3 IOFLAG 0090 CHARACTER*(*) ITFLAG 0091 DOUBLE PRECISION ITVALU 0092 C 0093 C$ Declarations_of_Local_Variables 0094 C 0095 CHARACTER*3 IOUP 0096 CHARACTER*50 ITUP 0097 C 0098 C$ Save_Statements 0099 C 0100 LOGICAL NSET 0101 SAVE NSET 0102 0103 LOGICAL NHISET 0104 SAVE NHISET 0105 0106 LOGICAL NLOSET 0107 SAVE NLOSET 0108 0109 DOUBLE PRECISION NVAL 0110 SAVE NVAL 0111 0112 DOUBLE PRECISION NHIVAL 0113 SAVE NHIVAL 0114 LSRGPB 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 0115 DOUBLE PRECISION NLOVAL 0116 SAVE NLOVAL 0117 C 0118 C$ Data_Statements 0119 C 0120 DATA NSET / .FALSE. / 0121 DATA NHISET / .FALSE. / 0122 DATA NLOSET / .FALSE. / 0123 C 0124 C$ Method 0125 C-& 0126 0127 C write(8,*) 'lsrgp:IOFLAG',IOFLAG 0128 C write(8,*) 'lsrgp:ITFLAG',ITFLAG 0129 0130 C1 Change input strings to upper case. 0131 0132 IOUP = IOFLAG 0133 ITUP = ITFLAG 0134 0135 CALL UPCASE( IOUP ) 0136 CALL UPCASE( ITUP ) 0137 0138 C1 Determine the action to be taken. 0139 0140 IF ( IOUP .EQ. GET ) THEN 0141 0142 C2 You want to get a value... 0143 0144 IF ( ITUP .EQ. NID ) THEN 0145 0146 IF ( NSET ) THEN 0147 ITVALU = NVAL 0148 ELSE 0149 WRITE(*,301) 0150 301 FORMAT(//,1X,'LSRGPB: No mean motion has been PUT yet.') 0151 STOP 0152 END IF 0153 ELSE IF ( ITUP .EQ. NIDHI ) THEN 0154 IF ( NHISET ) THEN 0155 ITVALU = NHIVAL 0156 ELSE 0157 WRITE(*,302) 0158 302 FORMAT(//,1X,'LSRGPB: No NHI has been PUT yet.') 0159 STOP 0160 END IF 0161 ELSE IF ( ITUP .EQ. NIDLO ) THEN 0162 IF ( NLOSET ) THEN 0163 ITVALU = NLOVAL 0164 ELSE 0165 WRITE(*,303) 0166 303 FORMAT(//,1X,'LSRGPB: No NLO has been PUT yet.') 0167 STOP 0168 END IF 0169 ELSE 0170 0171 C3 The item you want is not here. LSRGPB 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 0172 0173 WRITE(*,397) ITFLAG 0174 397 FORMAT(//,1X,'LSRGPB: ITFLAG(',A,') is not on the board.') 0175 0176 STOP 0177 0178 END IF 0179 0180 ELSE IF ( IOUP .EQ. PUT ) THEN 0181 0182 C2 You want to put a value... 0183 0184 IF ( ITUP .EQ. NID ) THEN 0185 0186 C3 You want to put the value of mean motion. 0187 0188 NVAL = ITVALU 0189 NSET = .TRUE. 0190 ELSE IF ( ITUP .EQ. NIDHI ) THEN 0191 NHIVAL = ITVALU 0192 NHISET = .TRUE. 0193 ELSE IF ( ITUP .EQ. NIDLO ) THEN 0194 NLOVAL = ITVALU 0195 NLOSET = .TRUE. 0196 0197 ELSE 0198 0199 C3 There is no place for your item. 0200 0201 WRITE(*,398) ITFLAG 0202 398 FORMAT(//,1X,'LSRGPB: There is no slot for ITFLAG(',A,').') 0203 0204 STOP 0205 0206 END IF 0207 0208 ELSE 0209 0210 C2 You do not know what you want to do! 0211 0212 WRITE(*,399) IOFLAG 0213 399 FORMAT(//,1X,'LSRGPB: IOFLAG(',A3,') is not "GET" or "PUT".') 0214 0215 STOP 0216 0217 END IF 0218 0219 RETURN 0220 END LSRGPB 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 452 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 290 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 140 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 882 ENTRY POINTS Address Type Name 0-00000000 LSRGPB VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR IOFLAG 2-00000000 CHAR IOUP AP-00000008@ CHAR ITFLAG 2-00000003 CHAR ITUP AP-0000000C@ R*8 ITVALU 2-00000054 L*4 NHISET 2-00000040 R*8 NHIVAL 2-00000058 L*4 NLOSET 2-00000048 R*8 NLOVAL 2-00000050 L*4 NSET 2-00000038 R*8 NVAL LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-00000000 301' 1-0000002F 302' 1-00000056 303' 1-0000007D 397' 1-000000AC 398' 1-000000DC 399' FUNCTIONS AND SUBROUTINES REFERENCED Type Name UPCASE COMMAND QUALIFIERS FOR/LIS LSRGPB.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.OBJ;2 LSRGPB 1-Jun-1993 15:38:33 VAX FORTRAN V5.6-119 Page 6 01 21-Jan-1993 21:28:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPB.FOR;7 COMPILATION STATISTICS Run Time: 0.44 seconds Elapsed Time: 2.53 seconds Page Faults: 269 Dynamic Memory: 520 pages 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0001 C$Procedure LSRGP 0002 C 0003 SUBROUTINE LSRGPJ ( ORB0 , DATE , TSTEP , J , LTOP , LSFLAG , 0004 & ORB1 ) 0005 C 0006 C 0007 C******************************************************************************* 0008 C 0009 C Copyright (C) 1993, California Institute of Technology. U.S. 0010 C Government Sponsorhip under NASA Contract NAS7-918 is 0011 C acknowledged. 0012 C 0013 C******************************************************************************* 0014 C 0015 C$ Log 0016 C 0017 C 19-JUN-1990 - Eric Cannell - creation of LSRGP. The Earth gravity 0018 C model is taken directly from the RGP 0019 C library. All I did was to add luni-solar 0020 C perturbations. 0021 C 11-JUL-1990 - Eric Cannell - added LSFLAG 0022 C 13-Sep-1991 - Bruce Shapiro - Make J a parameter & change name to LSRGPJ 0023 C 0024 C$ Purpose 0025 C 0026 C Please read the Restrictions Section is you intend to modify LSRGP. 0027 C 0028 C LSRGP (Luni-Solar Recurrence Gravity Perturbations) is an analytic tool 0029 C for propagating the orbital parameters of an Earth orbiting satellite 0030 C under the influence of both Earth gravity and lunar-solar perturbations. 0031 C LSRGP specifically deals with secular and long periodic perturbations. 0032 C 0033 C Although LSRGP can model the Earth gravity up to J29; luni-solar 0034 C gravitational attraction is modeled using a simplified version the 0035 C luni-solar gravitational potential. The luni-solar model uses the 0036 C following index ranges: 0037 C 0038 C L = 2 0039 C M = 0 , 1 , 2 0040 C H = 0 , 1 , 2 0041 C 0042 C Here, it is assumed that: 0043 C 0044 C If L = 2, then P = 1. 0045 C 0046 C J = -1 , 0 , 1 0047 C 0048 C Since Q = 2P - L, Q = 0. 0049 C 0050 C Note that both models use similar indices; however, the models are never 0051 C mixed together in the source code. LSRGP computes Earth gravity effects 0052 C first. Only after that does LSRGP compute luni-solar pertubations. 0053 C 0054 C LSRGP can be invoked with LSFLAG equal false in order to ignore luni-solar 0055 C effects. In such a case, LSRGP is equivalent to RGP. 0056 C 0057 C LSRGP uses non-singular orbital elements to avoid singularities near the 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0058 C critical inclination and other problems that are associated with near 0059 C circular orbits. 0060 C 0061 C LSRGP does not model atmospheric drag and solar radiation pressure; 0062 C however, these effects can be easily modelled with other routines. 0063 C 0064 C$ Input_Arguments 0065 C 0066 C Name Type Dim Units Description 0067 C ----------------------------------------------------------------------------- 0068 C ORB0 DP 6 km,deg the initial classical orbital elements. 0069 C The six elements are (a,e,i,LAN,w,M). 0070 C DATE C*(*) 1 --> epoch of ORB0. DATE is used to determine 0071 C the geometry of the Sun and Moon. DATE's 0072 C format is 'dd-mmm-yyyy hh:mm:ss.ffff'. 0073 C DATE can be abbreviated as per TIMETRANS. 0074 C TSTEP DP 1 sec length of time step to propagate orbit 0075 C ORB0 using gravity model up to LTOP 0076 C LTOP I 1 - the maximum L index to consider in 0077 C the Earth gravity model. For example, 0078 C LTOP = 15 would use up to J15. 0079 C LTOP must be in the range of 2..LMAX. 0080 C LSFLAG L 1 - if true, luni-solar effects are included. 0081 C if false, luni-solar effects are ignored. 0082 C J DP (2:29) - earth gravity field zonals J2, J3, ... 0083 C 0084 C$ Output_Arguments 0085 C 0086 C Name Type Dim Units Description 0087 C ----------------------------------------------------------------------------- 0088 C ORB0 DP 6 km,deg the final classical orbital elements. 0089 C The six elements are (a,e,i,LAN,w,M). 0090 C 0091 C$ References 0092 C 0093 C 1] Ram Bhat's handout titled "Analytical Tool for Propagating Orbital 0094 C Parameters". 0095 C 0096 C 2] Ram Bhat's handout titled "The MTARG Algorithm", which is a superset 0097 C of Reference 1 and the Luni-Solar Gravitational Attraction Algorithm. 0098 C 0099 C 3] R.H. Merson, "The Dynamic Model of PROP, A Computer Program for the 0100 C Refinement of Orbital Parameters of Earth Orbiters", Royal Aircraft 0101 C Establishment, Technical Report #66255. 0102 C 0103 C 4] W.M. Kaula, "Theory of Satellite Geodesy". 0104 C 0105 C$ Restrictions 0106 C 0107 C 1] LSRGP is only for orbits about the Earth. 0108 C 0109 C 2] LSRGP has been designed to be fast, not necessarily structured or 0110 C modular. There is a high degree of coupling between the equations and 0111 C simple variables. Keep this in mind when attempting to modifiy LSRGP. 0112 C 0113 C The Earth gravity model and the Luni-Solar perturbation model are 0114 C contained in separate areas of the source code. This implies that one 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0115 C can modify either model without having to worry about messing up the 0116 C other. 0117 C 0118 C Extending the Earth model is pretty much a matter of modifying the 0119 C Earth model parameter statements. You may run into an overflow problem 0120 C with large factorials. In that case, massage the order of computation 0121 C to avoid overflow. At some point, of course, the VAX's maximum double 0122 C precision value of about 1.7D+38 is going bite you. 0123 C 0124 C Extending the Luni-Solar model is also a matter of modifying the 0125 C Luni-Solar model parameter statements. However, you will have to 0126 C add the additional statements to compute the contents of new elements 0127 C in the now larger matricies (i.e., in GSC, DGDE, GMOON, GSUN, FSC, 0128 C DFDI, FMOON, and FSUN). Also, you may have to add a Do Loop for the 0129 C Q index if it ends up having a range of values. Finally, keep in 0130 C mind that I have optimized the loops to be as fast as possible by 0131 C moving nested loop invariate computations outward as far as possible. 0132 C 0133 C Please be careful!! 0134 C 0135 C 3] LSRGP is not valid for geo-stationery satellites. 0136 C 0137 C 4] The inclination of the satellite cannot be zero. 0138 C 0139 C 5] LSRGP does not currently include tesseral harmonics. 0140 C 0141 C 6] 2 <= LTOP <= LMAX for the Earth model. 0142 C 0143 C$ common area for physical constants 0144 C 0145 double precision RE ! in kilomters 0146 double precision earth_freq ! radians / second 0147 double precision earth_rate ! meters / day 0148 double precision GMRTH ! km**3/sec 0149 double precision GMMOON ! km**3/sec 0150 double precision GMSUN ! km**3/sec 0151 double precision sid_day ! seconds 0152 double precision deg_to_km ! kilometers/deg 0153 0154 common / physical_constants / 0155 & RE, earth_freq, earth_rate, GMRTH, 0156 & GMMOON, GMSUN, sid_day, deg_to_km 0157 0158 0159 0160 C$ Parameters 0161 C 0162 C These parameters are for the Earth Gravity Model. 0163 C 0164 INTEGER LMAX 0165 PARAMETER ( LMAX = 29 ) 0166 0167 INTEGER LBTM 0168 PARAMETER ( LBTM = 2 ) 0169 0170 INTEGER KBTM 0171 PARAMETER ( KBTM = 0 ) LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0172 0173 INTEGER KMAX 0174 PARAMETER ( KMAX = LMAX ) 0175 0176 INTEGER KBTM1 0177 PARAMETER ( KBTM1 = KBTM + 1 ) 0178 0179 INTEGER KNUM 0180 PARAMETER ( KNUM = KMAX - KBTM + 1 ) 0181 0182 INTEGER KNUM1 0183 PARAMETER ( KNUM1 = KNUM - 1 ) 0184 0185 INTEGER LKNUM 0186 PARAMETER ( LKNUM = ( LMAX - LBTM + 1 ) * KNUM ) 0187 0188 INTEGER LKNUM1 0189 PARAMETER ( LKNUM1 = LMAX * KNUM ) 0190 0191 C DOUBLE PRECISION GMRTH 0192 C PARAMETER ( GMRTH = 398600.44807345D0 ) 0193 0194 C DOUBLE PRECISION RE 0195 C PARAMETER ( RE = 6378.14D0 ) 0196 0197 C These parameters are for the Luni-Solar Gravity Model. 0198 0199 INTEGER HLO 0200 PARAMETER ( HLO = 0 ) 0201 0202 INTEGER HHI 0203 PARAMETER ( HHI = 2 ) 0204 0205 INTEGER JLO 0206 PARAMETER ( JLO = -1 ) 0207 0208 INTEGER JHI 0209 PARAMETER ( JHI = 1 ) 0210 0211 INTEGER LLO 0212 PARAMETER ( LLO = 2 ) 0213 0214 INTEGER LHI 0215 PARAMETER ( LHI = 2 ) 0216 0217 INTEGER MLO 0218 PARAMETER ( MLO = 0 ) 0219 0220 INTEGER MHI 0221 PARAMETER ( MHI = 2 ) 0222 0223 INTEGER PLO 0224 PARAMETER ( PLO = 1 ) 0225 0226 INTEGER PHI 0227 PARAMETER ( PHI = 1 ) 0228 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0229 INTEGER QLO 0230 PARAMETER ( QLO = 0 ) 0231 0232 INTEGER QHI 0233 PARAMETER ( QHI = 0 ) 0234 0235 C DOUBLE PRECISION GMMOON 0236 C PARAMETER ( GMMOON = 4902.7927809104D0 ) 0237 0238 C DOUBLE PRECISION GMSUN 0239 C PARAMETER ( GMSUN = 132712441933.00783456D0 ) 0240 0241 DOUBLE PRECISION NMOON 0242 PARAMETER ( NMOON = 2.649899946D-6 ) 0243 0244 DOUBLE PRECISION NSUN 0245 PARAMETER ( NSUN = 1.990968723D-7 ) 0246 0247 C These parameters are useful anywhere. 0248 0249 DOUBLE PRECISION PI 0250 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0251 0252 DOUBLE PRECISION PI2 0253 PARAMETER ( PI2 = PI / 2D0 ) 0254 0255 DOUBLE PRECISION D2R 0256 PARAMETER ( D2R = PI / 180.0D0 ) 0257 C 0258 C$ Declarations_of_Input_and_Output_Arguments 0259 C 0260 CHARACTER*(*) DATE 0261 LOGICAL LSFLAG 0262 INTEGER LTOP 0263 DOUBLE PRECISION ORB0 ( 6 ) 0264 DOUBLE PRECISION ORB1 ( 6 ) 0265 DOUBLE PRECISION TSTEP 0266 C 0267 C$ Declarations_of_Local_Variables 0268 C 0269 DOUBLE PRECISION A0 0270 DOUBLE PRECISION A1 0271 DOUBLE PRECISION A2 0272 DOUBLE PRECISION AKPCK 0273 DOUBLE PRECISION AKPSK 0274 DOUBLE PRECISION ALMOON (LLO:LHI) 0275 DOUBLE PRECISION ALSUN (LLO:LHI) 0276 DOUBLE PRECISION AM 0277 DOUBLE PRECISION AM2 0278 DOUBLE PRECISION AM3 0279 DOUBLE PRECISION AS 0280 DOUBLE PRECISION AS2 0281 DOUBLE PRECISION AS3 0282 DOUBLE PRECISION BB 0283 DOUBLE PRECISION BDC 0284 DOUBLE PRECISION CEC 0285 DOUBLE PRECISION CI LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 6 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0286 DOUBLE PRECISION CI2 0287 DOUBLE PRECISION CI4 0288 DOUBLE PRECISION CIM 0289 DOUBLE PRECISION CIQSI 0290 DOUBLE PRECISION CIS 0291 DOUBLE PRECISION COSINT (KMAX) 0292 DOUBLE PRECISION CW 0293 DOUBLE PRECISION CKW 0294 DOUBLE PRECISION CWT1 0295 DOUBLE PRECISION CY0M 0296 DOUBLE PRECISION CY0S 0297 DOUBLE PRECISION DE 0298 DOUBLE PRECISION DEBAR 0299 DOUBLE PRECISION DEMH 0300 DOUBLE PRECISION DEMJ 0301 DOUBLE PRECISION DEML 0302 DOUBLE PRECISION DEMM 0303 DOUBLE PRECISION DEMOON 0304 DOUBLE PRECISION DEMP 0305 DOUBLE PRECISION DESH 0306 DOUBLE PRECISION DESJ 0307 DOUBLE PRECISION DESL 0308 DOUBLE PRECISION DESM 0309 DOUBLE PRECISION DESP 0310 DOUBLE PRECISION DESUN 0311 DOUBLE PRECISION DFDI (LLO:LHI,MLO:MHI,PLO:PHI) 0312 DOUBLE PRECISION DGDE (LLO:LHI,PLO:PHI,QLO:QHI) 0313 DOUBLE PRECISION DI 0314 DOUBLE PRECISION DIFFOM 0315 DOUBLE PRECISION DIFFOS 0316 DOUBLE PRECISION DIMH 0317 DOUBLE PRECISION DIMJ 0318 DOUBLE PRECISION DIML 0319 DOUBLE PRECISION DIMM 0320 DOUBLE PRECISION DIMOON 0321 DOUBLE PRECISION DIMP 0322 DOUBLE PRECISION DISH 0323 DOUBLE PRECISION DISJ 0324 DOUBLE PRECISION DISL 0325 DOUBLE PRECISION DISM 0326 DOUBLE PRECISION DISP 0327 DOUBLE PRECISION DISUN 0328 DOUBLE PRECISION DL 0329 DOUBLE PRECISION DLBAR 0330 DOUBLE PRECISION DLDUM 0331 DOUBLE PRECISION DLM (LLO:LHI,MLO:MHI) 0332 DOUBLE PRECISION DLMH 0333 DOUBLE PRECISION DLMJ 0334 DOUBLE PRECISION DLML 0335 DOUBLE PRECISION DLMM 0336 DOUBLE PRECISION DLMOON 0337 DOUBLE PRECISION DLMP 0338 DOUBLE PRECISION DLP 0339 DOUBLE PRECISION DLSH 0340 DOUBLE PRECISION DLSJ 0341 DOUBLE PRECISION DLSL 0342 DOUBLE PRECISION DLSM LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 7 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0343 DOUBLE PRECISION DLSP 0344 DOUBLE PRECISION DLSUN 0345 DOUBLE PRECISION DO 0346 DOUBLE PRECISION DODUM 0347 DOUBLE PRECISION DOMH 0348 DOUBLE PRECISION DOMJ 0349 DOUBLE PRECISION DOML 0350 DOUBLE PRECISION DOMM 0351 DOUBLE PRECISION DOMOON 0352 DOUBLE PRECISION DOMP 0353 DOUBLE PRECISION DOSH 0354 DOUBLE PRECISION DOSJ 0355 DOUBLE PRECISION DOSL 0356 DOUBLE PRECISION DOSM 0357 DOUBLE PRECISION DOSP 0358 DOUBLE PRECISION DOSUN 0359 DOUBLE PRECISION DX 0360 DOUBLE PRECISION DXBAR 0361 DOUBLE PRECISION DXMH 0362 DOUBLE PRECISION DXMJ 0363 DOUBLE PRECISION DXML 0364 DOUBLE PRECISION DXMM 0365 DOUBLE PRECISION DXMOON 0366 DOUBLE PRECISION DXMP 0367 DOUBLE PRECISION DXP 0368 DOUBLE PRECISION DXSH 0369 DOUBLE PRECISION DXSJ 0370 DOUBLE PRECISION DXSL 0371 DOUBLE PRECISION DXSM 0372 DOUBLE PRECISION DXSP 0373 DOUBLE PRECISION DXSUN 0374 DOUBLE PRECISION E0 0375 DOUBLE PRECISION E2 0376 DOUBLE PRECISION EM 0377 DOUBLE PRECISION EM2 0378 DOUBLE PRECISION EM3 0379 DOUBLE PRECISION EM4 0380 DOUBLE PRECISION ES 0381 DOUBLE PRECISION ES2 0382 DOUBLE PRECISION ES3 0383 DOUBLE PRECISION ES4 0384 DOUBLE PRECISION ESI (KMAX) 0385 DOUBLE PRECISION ETA0 0386 DOUBLE PRECISION ETA1 0387 DOUBLE PRECISION F 0388 DOUBLE PRECISION F1 0389 DOUBLE PRECISION F1M 0390 DOUBLE PRECISION F1S 0391 DOUBLE PRECISION F2 0392 DOUBLE PRECISION F2M 0393 DOUBLE PRECISION F2S 0394 DOUBLE PRECISION FFY 0395 DOUBLE PRECISION FMOON (LLO:LHI,MLO:MHI,HLO:HHI) 0396 DOUBLE PRECISION FSC (LLO:LHI,MLO:MHI,PLO:PHI) 0397 DOUBLE PRECISION FSUN (LLO:LHI,MLO:MHI,HLO:HHI) 0398 DOUBLE PRECISION GMMNA2 0399 DOUBLE PRECISION GMMNQS LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 8 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0400 DOUBLE PRECISION GMNICM 0401 DOUBLE PRECISION GMOON (LLO:LHI,HLO:HHI,JLO:JHI) 0402 DOUBLE PRECISION GMSNA2 0403 DOUBLE PRECISION GMSNQS 0404 DOUBLE PRECISION GSC (LLO:LHI,PLO:PHI,QLO:QHI) 0405 DOUBLE PRECISION GSCDF 0406 DOUBLE PRECISION GSCFSC 0407 DOUBLE PRECISION GSNICS 0408 DOUBLE PRECISION GSUN (LLO:LHI,HLO:HHI,JLO:JHI) 0409 INTEGER H 0410 DOUBLE PRECISION I0 0411 DOUBLE PRECISION I1 0412 DOUBLE PRECISION ICM 0413 DOUBLE PRECISION ICS 0414 INTEGER IDX 0415 DOUBLE PRECISION ISM 0416 DOUBLE PRECISION ISS 0417 INTEGER IV 0418 INTEGER JJ 0419 DOUBLE PRECISION J2SQR 0420 DOUBLE PRECISION JGA 0421 DOUBLE PRECISION JGABA 0422 INTEGER K 0423 INTEGER KTOP 0424 DOUBLE PRECISION KWT 0425 INTEGER L 0426 DOUBLE PRECISION L0 0427 DOUBLE PRECISION L1 0428 DOUBLE PRECISION L2H 0429 DOUBLE PRECISION L2HJ 0430 DOUBLE PRECISION LDOT1 0431 DOUBLE PRECISION LKBYKK 0432 DOUBLE PRECISION LNRPL 0433 DOUBLE PRECISION LUNSTT ( 6 ) 0434 INTEGER M 0435 DOUBLE PRECISION M0 0436 DOUBLE PRECISION MDLM 0437 DOUBLE PRECISION MDP 0438 DOUBLE PRECISION MM 0439 DOUBLE PRECISION MS 0440 DOUBLE PRECISION N 0441 DOUBLE PRECISION N0 0442 DOUBLE PRECISION N1 0443 DOUBLE PRECISION NA2 0444 DOUBLE PRECISION NA2QSI 0445 DOUBLE PRECISION NJ 0446 DOUBLE PRECISION NJR 0447 DOUBLE PRECISION NRPL (LMAX) 0448 DOUBLE PRECISION NRPL4 0449 DOUBLE PRECISION O0 0450 DOUBLE PRECISION O1 0451 DOUBLE PRECISION ODOT1 0452 DOUBLE PRECISION ODOTJ 0453 INTEGER P 0454 DOUBLE PRECISION PP 0455 DOUBLE PRECISION Q 0456 DOUBLE PRECISION Q2 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 9 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0457 DOUBLE PRECISION QE 0458 DOUBLE PRECISION QSA 0459 DOUBLE PRECISION QSI 0460 DOUBLE PRECISION RPL1 0461 DOUBLE PRECISION SAS 0462 DOUBLE PRECISION SEC 0463 DOUBLE PRECISION SI 0464 DOUBLE PRECISION SI2 0465 DOUBLE PRECISION SICI 0466 DOUBLE PRECISION SIM 0467 DOUBLE PRECISION SIM2 0468 DOUBLE PRECISION SININT (KMAX) 0469 DOUBLE PRECISION SIS 0470 DOUBLE PRECISION SIS2 0471 DOUBLE PRECISION SUNSTT ( 6 ) 0472 DOUBLE PRECISION SW 0473 DOUBLE PRECISION SKW 0474 DOUBLE PRECISION SWT 0475 DOUBLE PRECISION SY0M 0476 DOUBLE PRECISION SY0S 0477 DOUBLE PRECISION W0 0478 DOUBLE PRECISION WDOT1 0479 DOUBLE PRECISION WDOTJ 0480 DOUBLE PRECISION WM 0481 DOUBLE PRECISION WS 0482 DOUBLE PRECISION WT 0483 DOUBLE PRECISION XI0 0484 DOUBLE PRECISION XI1 0485 DOUBLE PRECISION XM 0486 DOUBLE PRECISION XM2 0487 DOUBLE PRECISION XM4 0488 DOUBLE PRECISION XM6 0489 DOUBLE PRECISION XM8 0490 DOUBLE PRECISION XM10 0491 DOUBLE PRECISION XM12 0492 DOUBLE PRECISION XM14 0493 DOUBLE PRECISION XS 0494 DOUBLE PRECISION XS2 0495 DOUBLE PRECISION XS4 0496 DOUBLE PRECISION XS6 0497 DOUBLE PRECISION XS8 0498 DOUBLE PRECISION XS10 0499 DOUBLE PRECISION XS12 0500 DOUBLE PRECISION XS14 0501 DOUBLE PRECISION Y0M 0502 DOUBLE PRECISION Y0S 0503 C 0504 C$ Save_Statements 0505 C 0506 DOUBLE PRECISION A (LBTM:LMAX,KBTM:KMAX) 0507 SAVE A 0508 0509 DOUBLE PRECISION AK (LBTM:LMAX,KBTM:KMAX) 0510 SAVE AK 0511 0512 DOUBLE PRECISION AKP (LBTM:LMAX,KBTM:KMAX) 0513 SAVE AKP LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 10 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0514 0515 DOUBLE PRECISION ALPHA (1:LMAX,KBTM:KMAX) 0516 SAVE ALPHA 0517 0518 DOUBLE PRECISION B (LBTM:LMAX,KBTM:KMAX) 0519 SAVE B 0520 0521 DOUBLE PRECISION BETA (LBTM:LMAX,KBTM:KMAX) 0522 SAVE BETA 0523 0524 DOUBLE PRECISION BK (LBTM:LMAX,KBTM:KMAX) 0525 SAVE BK 0526 0527 DOUBLE PRECISION CK (LBTM:LMAX,KBTM:KMAX) 0528 SAVE CK 0529 0530 DOUBLE PRECISION DK (LBTM:LMAX,KBTM:KMAX) 0531 SAVE DK 0532 0533 DOUBLE PRECISION FACTRL (0:LMAX) 0534 SAVE FACTRL 0535 0536 LOGICAL FIRST 0537 SAVE FIRST 0538 0539 DOUBLE PRECISION GAMMA (LBTM:LMAX,KBTM:KMAX) 0540 SAVE GAMMA 0541 0542 DOUBLE PRECISION J (2:29) 0543 C SAVE J 0544 0545 DOUBLE PRECISION T (LBTM:LMAX,KBTM:KMAX) 0546 SAVE T 0547 0548 DOUBLE PRECISION U2KK (0:KMAX) 0549 SAVE U2KK 0550 0551 DOUBLE PRECISION UK (KBTM:KMAX) 0552 SAVE 0553 C 0554 C$ Data_Statements 0555 C 0556 DATA A / LKNUM * 0D0 / 0557 DATA AK / LKNUM * 0D0 / 0558 DATA AKP / LKNUM * 0D0 / 0559 DATA ALPHA / LKNUM1 * 0D0 / 0560 DATA B / LKNUM * 0D0 / 0561 DATA BETA / LKNUM * 0D0 / 0562 DATA BK / LKNUM * 0D0 / 0563 DATA CK / LKNUM * 0D0 / 0564 DATA COSINT / KMAX * 0D0 / 0565 DATA DK / LKNUM * 0D0 / 0566 DATA FIRST / .TRUE. / 0567 DATA GAMMA / LKNUM * 0D0 / 0568 C DATA J / 0.10826258D-02,-0.25338975D-05, 0569 C & -0.16238211D-05,-0.22963180D-06, 0570 C & 0.54309576D-06,-0.35775823D-06, LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 11 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0571 C & -0.20980278D-06,-0.12070701D-06, 0572 C & -0.24441360D-06, 0.23257025D-06, 0573 C & -0.19259423D-06,-0.22280385D-06, 0574 C & 0.11011675D-06,-0.15949534D-07, 0575 C & 0.41544562D-07,-0.87909637D-07, 0576 C & -0.70704603D-07,-0.45577223D-08, 0577 C & -0.17217485D-06, 0.11404873D-09, 0578 C & 0.16061855D-07, 0.14036748D-06, 0579 C & 0.19771236D-07,-0.10809433D-07, 0580 C & -0.59183191D-07,-0.81329176D-07, 0581 C & 0.17087477D-06, 0.86549317D-07 0582 C & / 0583 DATA SININT / KMAX * 0D0 / 0584 DATA T / LKNUM * 0D0 / 0585 DATA UK / 1D0 , KNUM1 * 2D0 / 0586 C 0587 C$ Method 0588 C-& 0589 0590 C1 Check if LTOP is in range of 2..LMAX. 0591 0592 IF ( ( LTOP .LT. 2 ) .OR. ( LTOP .GT. LMAX ) ) THEN 0593 0594 WRITE(*,301) LTOP , LMAX 0595 301 FORMAT(//,1X,'LSRGP: LTOP(',I,') not in range of 2..',I2,'.') 0596 0597 STOP 0598 0599 END IF 0600 0601 C1 Compute SAVED variables only once. 0602 0603 IF ( FIRST ) THEN 0604 0605 C2 Negate first time through flag. 0606 0607 FIRST = .FALSE. 0608 0609 C2 KTOP is LTOP. 0610 0611 KTOP = LTOP 0612 0613 C2 Compute factorial array and scaling array U2KK. U2KK is used to 0614 C2 compute GAMMA. 0615 0616 FACTRL(0) = 1D0 0617 U2KK (0) = -1D0 0618 0619 DO 100 IDX = 1 , LTOP 0620 FACTRL(IDX) = DFLOAT(IDX) * FACTRL(IDX-1) 0621 100 CONTINUE 0622 0623 DO 101 IDX = 1 , KTOP 0624 0625 U2KK (IDX) = -UK(IDX) 0626 & / 2D0 ** DFLOAT( 2 * IDX ) 0627 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 12 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0628 101 CONTINUE 0629 0630 C2 Compute identities ALPHA, BETA, and T. Also save the 0631 C2 lower subdiagonal of array B (the diagonal is DATA'ed to 1D0). 0632 0633 ALPHA(1,0) = 1D0 0634 0635 DO 102 L = LBTM , LTOP 0636 0637 B(L,L-1) = 1D0 0638 0639 DO 104 K = KBTM , L-1 0640 ALPHA(L,K) = DFLOAT( ( L + K + 1 ) * ( L - K ) ) 0641 & / 2D0 0642 & / DFLOAT( K + 1 ) 0643 BETA (L,K) = ALPHA(L-1,K) 0644 104 CONTINUE 0645 0646 DO 105 K = KBTM , L 0647 0648 IF ( MOD(L-K,2) .EQ. 0 ) THEN 0649 0650 IV = ( L - K ) / 2 0651 0652 C3 The following two statements re-arrange computations 0653 C3 in order to avoid overflow errors. Note that the DO 0654 C3 loop will NOT be executed if K=0 (standard Fortran-77). 0655 0656 LKBYKK = 1D0 / FACTRL(K) / FACTRL(K) 0657 0658 DO 1051 IDX = L+1 , L+K 0659 LKBYKK = LKBYKK * DFLOAT( IDX ) 0660 1051 CONTINUE 0661 0662 T(L,K) = DFLOAT( (-1)**IV ) 0663 & * FACTRL( L ) 0664 & * LKBYKK 0665 & / DFLOAT( 2**L ) 0666 & / FACTRL(IV) 0667 & / FACTRL(L-IV) 0668 0669 END IF 0670 0671 105 CONTINUE 0672 0673 102 CONTINUE 0674 0675 END IF 0676 0677 C1 Compute constants based upon classical keplerian elements. 0678 0679 A0 = ORB0(1) 0680 E0 = ORB0(2) 0681 I0 = ORB0(3) * D2R 0682 O0 = ORB0(4) * D2R 0683 W0 = ORB0(5) * D2R 0684 M0 = ORB0(6) * D2R LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 13 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0685 0686 A2 = A0 * A0 0687 E2 = E0 * E0 0688 0689 PP = A0 * ( 1D0 - E2 ) 0690 0691 N0 = DSQRT( GMRTH / A0**3 ) 0692 0693 Q = DSQRT( 1D0 - E2 ) 0694 Q2 = Q * Q 0695 0696 CI = DCOS( I0 ) 0697 CI2 = CI * CI 0698 CI4 = CI2 * CI2 0699 0700 SI = DSIN( I0 ) 0701 SI2 = SI * SI 0702 F = SI2 0703 0704 SICI = SI * CI 0705 0706 CW = DCOS( W0 ) 0707 SW = DSIN( W0 ) 0708 0709 RPL1 = RE / PP 0710 NRPL(1) = RPL1 0711 0712 C1 Update N0 with with J2 term. 0713 0714 N = N0 * ( 1.0D0 0715 & + 1.5D0 0716 & * J(2) 0717 & * Q 0718 & * RPL1 * RPL1 0719 & * ( 1D0 - 1.5D0 * SI2 ) 0720 & ) 0721 0722 DO 106 IDX = 2 , LTOP 0723 NRPL(IDX ) = NRPL(IDX-1) * RPL1 0724 NRPL(IDX-1) = NRPL(IDX-1) * N 0725 106 CONTINUE 0726 0727 NRPL(LTOP) = NRPL(LTOP) * N 0728 0729 NRPL4 = N * RPL1 * RPL1 * RPL1 * RPL1 0730 0731 ESI(1) = E0 * SI 0732 0733 DO 107 IDX = 2 , KTOP 0734 ESI(IDX) = ESI(IDX-1) * ESI(1) 0735 107 CONTINUE 0736 0737 J2SQR = J(2) * J(2) 0738 0739 NJR = (3D0/32D0) * J2SQR * NRPL4 0740 0741 C1 Compute non-singular orbital elements. LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 14 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0742 0743 XI0 = E0 * CW 0744 ETA0 = E0 * SW 0745 L0 = W0 + M0 0746 0747 C1 ********************************************************************* 0748 C1 ********************************************************************* 0749 C1 *** *** 0750 C1 *** Earth Gravity Model *** 0751 C1 *** *** 0752 C1 ********************************************************************* 0753 C1 ********************************************************************* 0754 0755 C1 Many factors are a function of the index L. Nest their computation 0756 C1 with a single L loop in order to avoid duplicating overhead for 0757 C1 for separate L do loops. 0758 0759 ODOTJ = 0D0 0760 WDOTJ = 0D0 0761 NJ = 0D0 0762 0763 DO 108 L = LBTM , LTOP 0764 0765 C2 Compute GAMMA(L,K). 0766 0767 LNRPL = FACTRL(L-1) * NRPL(L) 0768 0769 DO 109 K = KBTM , L-2 0770 GAMMA(L,K) = U2KK(K) * LNRPL * T(L,K) / FACTRL(L-K-1) 0771 109 CONTINUE 0772 0773 C2 Compute inclination and eccentricity functions, A(L,K) AND B(L,K). 0774 0775 A(L,L ) = 1D0 0776 A(L,L-1) = CI 0777 0778 DO 110 K = L-2 , KBTM , -1 0779 0780 A(L,K) = CI * A(L,K+1) - ALPHA(L,K+1) * SI2 * A(L,K+2) 0781 & / ( 2D0 * (K+1) ) 0782 0783 B(L,K) = B(L,K+1) + BETA(L,K+1) * E2 * B(L,K+2) 0784 & / ( 2D0 * (K+1) ) 0785 0786 110 CONTINUE 0787 0788 C2 Compute secular functions dLAN/dt, dw/dt, and N (ODOTJ, WDOTJ, and NJ). 0789 0790 JGABA = J(L) * GAMMA(L,0) * ALPHA(L,0) * B(L,0) * A(L,1) 0791 JGA = J(L) * GAMMA(L,0) * A(L,0) 0792 BB = B(L,1) * BETA(L,0) 0793 0794 ODOTJ = ODOTJ - JGABA 0795 WDOTJ = WDOTJ + JGABA * CI + JGA * ( L * B(L,0) + BB ) 0796 NJ = NJ + Q * JGA * ( ( L - 1 ) * B(L,0) - BB ) 0797 0798 108 CONTINUE LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 15 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0799 0800 C1 Now add to secular variations the J2**2 perturbations. 0801 0802 ODOT1 = ODOTJ 0803 & + NJR * CI 0804 & * ( 4D0 + 12D0 * Q - 9D0 * E2 0805 & - ( 40D0 + 36D0 * Q - 5D0 * E2 ) * CI2 0806 & ) 0807 0808 WDOT1 = WDOTJ 0809 & + -0.25D0 * NJR 0810 & * ( 10D0 - 24D0 * Q + 25D0 * E2 0811 & + ( 36D0 + 192D0 * Q - 126D0 * E2 ) * CI2 0812 & - ( 430D0 + 360D0 * Q - 45D0 * E2 ) * CI4 0813 & ) 0814 0815 N1 = NJ 0816 & + 0.25D0 * NJR * Q 0817 & * ( ( 10D0 + 16D0 * Q - 25D0 * E2 ) 0818 & - ( 60D0 + 96D0 * Q - 90D0 * E2 ) * CI2 0819 & + ( 130D0 + 144D0 * Q - 25D0 * E2 ) * CI4 0820 & ) 0821 0822 LDOT1 = N1 + WDOT1 0823 0824 C1 Compute the integrals for sine and cosine. 0825 0826 DO 111 K = 1 , KTOP 0827 0828 KWT = K * WDOT1 * TSTEP 0829 F1 = DSIN( KWT ) / KWT 0830 F2 = ( 1D0 - DCOS( KWT ) ) / KWT**2 0831 0832 CKW = DCOS( K * ( W0 - PI2 ) ) 0833 SKW = DSIN( K * ( W0 - PI2 ) ) 0834 0835 COSINT(K) = TSTEP * ( F1 * CKW - KWT * F2 * SKW ) 0836 SININT(K) = TSTEP * ( F1 * SKW + KWT * F2 * CKW ) 0837 0838 111 CONTINUE 0839 0840 C1 Once again, nest computations with a single L loop in order to avoid 0841 C1 duplicating overhead for for separate L do loops. 0842 0843 AKPCK = 0D0 0844 AKPSK = 0D0 0845 BDC = 0D0 0846 DODUM = 0D0 0847 DLDUM = 0D0 0848 0849 DO 112 L = LBTM + 1 , LTOP 0850 0851 C2 In fact, we can use a single K loop also! As it turns out, GAMMA(L,K) 0852 C2 is a factor of each coefficient and series inside this K loop. 0853 C2 Since GAMMA(L,K) = 0 when L - K is odd, only execute the body of the 0854 C2 K loop when L - K is even. Of course, one must set the skipped 0855 C2 elements to zero in a DATA statement. SAVEing them is probably LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 16 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0856 C2 a good idea also. 0857 0858 DO 113 K = KBTM1 , L-2 0859 0860 IF ( MOD( L - K , 2 ) .EQ. 0 ) THEN 0861 0862 C3 Compute long periodic coefficients. 0863 0864 AK (L,K) = J(L) * GAMMA(L,K) * ESI(K) * A(L,K) * B(L,K) 0865 AKP(L,K) = K * AK(L,K) / ESI(1) 0866 BK (L,K) = L * AK(L,K) 0867 CK (L,K) = AK(L,K) * A(L,K+1) * ALPHA(L,K) / A(L,K) 0868 DK (L,K) = AK(L,K) * B(L,K+1) * BETA (L,K) / B(L,K) 0869 0870 C3 Compute series for long periodics. 0871 0872 AKPCK = AKPCK + AKP(L,K) * COSINT(K) 0873 AKPSK = AKPSK + AKP(L,K) * SININT(K) 0874 0875 BDC = 0876 & BDC 0877 & + ( BK(L,K) + DK(L,K) + CK(L,K) * CI ) * COSINT(K) 0878 0879 DODUM = 0880 & DODUM 0881 & + ( E0 * CI * AKP(L,K) / SI - CK(L,K) ) * COSINT(K) 0882 0883 DLDUM = 0884 & DLDUM 0885 & + COSINT(K) 0886 & * ( ( 1D0 + Q ) * BK(L,K) 0887 & - E0 * CI2 * AKP(L,K) / SI 0888 & + CK(L,K) * CI 0889 & - AK(L,K) 0890 & ) 0891 0892 END IF 0893 0894 113 CONTINUE 0895 0896 112 CONTINUE 0897 0898 C1 Compute long periodic perturbations. 0899 0900 SEC = 2D0 + 5D0 * E2 0901 & - ( 32D0 + 112D0 * E2 ) * CI2 0902 & + ( 30D0 + 135D0 * E2 ) * CI4 0903 CEC = E0 * Q2 * ( 1D0 - 16D0 * CI2 + 15D0 * CI4 ) 0904 0905 FFY = 1D0 - (15D0/14D0) * F 0906 QSA = Q2 * SI * AKPSK 0907 SAS = ( SI2 - E2 * CI2 ) * AKPCK / SI 0908 0909 DX = CW * QSA 0910 & - SW * SAS 0911 & - ETA0 * BDC 0912 & + 0.5D0 * E0 * NJR * SW * SEC * COSINT(2) LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 17 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0913 & - NJR * CW * CEC * SININT(2) 0914 0915 DE = SW * QSA 0916 & + CW * SAS 0917 & + XI0 * BDC 0918 & - 0.5D0 * E0 * NJR * CW * SEC * COSINT(2) 0919 & - NJR * SW * CEC * SININT(2) 0920 0921 DI = - E0 * CI * AKPSK 0922 & - 14D0 * NJR * E2 * SI * CI * FFY * SININT(2) 0923 0924 DO = DODUM 0925 & - NJR * ( E2 * ( 16D0 - 30D0 * CI2 ) * CI ) * COSINT(2) 0926 0927 DL = DLDUM 0928 & - 0.5D0 * NJR * ( SEC 0929 & + ( 5D0 * E2 - 2D0 ) * CEC / Q / E0 0930 & ) * COSINT(2) 0931 0932 C1 Compute secular perturbations. 0933 0934 WT = WDOT1 * TSTEP 0935 CWT1 = DCOS( WT ) - 1D0 0936 SWT = DSIN( WT ) 0937 0938 DXBAR = XI0 * CWT1 - ETA0 * SWT 0939 DEBAR = ETA0 * CWT1 + XI0 * SWT 0940 DLBAR = ( N +LDOT1 ) * TSTEP 0941 0942 0943 C1 ********************************************************************* 0944 C1 ********************************************************************* 0945 C1 *** *** 0946 C1 *** Luni-Solar Gravity Model *** 0947 C1 *** *** 0948 C1 ********************************************************************* 0949 C1 ********************************************************************* 0950 0951 C1 If LSFLAG = .FALSE., then ignore luni-solar effects. 0952 0953 IF ( .NOT. LSFLAG ) THEN 0954 0955 DXMOON = 0D0 0956 DXSUN = 0D0 0957 DEMOON = 0D0 0958 DESUN = 0D0 0959 DIMOON = 0D0 0960 DISUN = 0D0 0961 DOMOON = 0D0 0962 DOSUN = 0D0 0963 DLMOON = 0D0 0964 DLSUN = 0D0 0965 0966 GO TO 901 0967 0968 END IF 0969 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 18 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 0970 C1 Determine the classical orbital elements for the Sun and Moon 0971 C1 at the given epoch. 0972 0973 CALL LUNORB( DATE , LUNSTT ) 0974 CALL SUNORB( DATE , SUNSTT ) 0975 0976 C1 Compute required functions of elements of Sun and Moon. 0977 0978 AM = LUNSTT(1) 0979 AM2 = AM * AM 0980 AM3 = AM2 * AM 0981 0982 AS = SUNSTT(1) 0983 AS2 = AS * AS 0984 AS3 = AS2 * AS 0985 0986 EM = LUNSTT(2) 0987 EM2 = EM * EM 0988 EM3 = EM2 * EM 0989 EM4 = EM3 * EM 0990 0991 ES = SUNSTT(2) 0992 ES2 = ES * ES 0993 ES3 = ES2 * ES 0994 ES4 = ES3 * ES 0995 0996 CIM = DCOS( LUNSTT(3) * D2R ) 0997 CIS = DCOS( SUNSTT(3) * D2R ) 0998 0999 SIM = DSIN( LUNSTT(3) * D2R ) 1000 SIM2 = SIM * SIM 1001 SIS = DSIN( SUNSTT(3) * D2R ) 1002 SIS2 = SIS * SIS 1003 1004 DIFFOM = O0 - LUNSTT(4) * D2R 1005 DIFFOS = O0 - SUNSTT(4) * D2R 1006 1007 WM = LUNSTT(5) * D2R 1008 WS = SUNSTT(5) * D2R 1009 1010 MM = LUNSTT(6) * D2R 1011 MS = SUNSTT(6) * D2R 1012 1013 C1 Compute the spacecraft's eccentricity function G(lpq). Only compute 1014 C1 G for the required range of indices. 1015 1016 GSC(2,1,0) = ( 1D0 - E2 ) ** -1.5D0 1017 1018 C1 Compute the spacecraft's eccentricity function dG(lpq)/de. Only 1019 C1 compute dG/de for the required range of indices. 1020 1021 DGDE(2,1,0) = 3D0 * E0 * ( 1D0 - E2 ) ** -2.5D0 1022 1023 C1 Compute the moon's eccentricity function G(lhj). Only compute 1024 C1 G for the required range of indices. 1025 1026 GMOON(2,0,-1) = -.5D0 * EM + EM ** 3D0 / 16D0 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 19 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1027 GMOON(2,0, 0) = 1D0 - 2.5D0 * EM2 + (13D0/16D0) * EM4 1028 GMOON(2,0, 1) = 3.5D0 * EM - (123D0/16D0) * EM3 1029 GMOON(2,1,-1) = 1.5D0 * EM + (27D0/16D0) * EM3 1030 GMOON(2,1, 0) = ( 1D0 - EM2 ) ** -1.5D0 1031 GMOON(2,1, 1) = GMOON(2,1,-1) 1032 GMOON(2,2,-1) = GMOON(2,0, 1) 1033 GMOON(2,2, 0) = GMOON(2,0, 0) 1034 GMOON(2,2, 1) = GMOON(2,0,-1) 1035 1036 C1 Compute the Sun's eccentricity function G(lhj). Only compute 1037 C1 G for the required range of indices. 1038 1039 GSUN(2,0,-1) = -.5D0 * ES + ES ** 3D0 / 16D0 1040 GSUN(2,0, 0) = 1D0 - 2.5D0 * ES2 + (13D0/16D0) * ES4 1041 GSUN(2,0, 1) = 3.5D0 * ES - (123D0/16D0) * ES3 1042 GSUN(2,1,-1) = 1.5D0 * ES + (27D0/16D0) * ES3 1043 GSUN(2,1, 0) = ( 1D0 - ES2 ) ** -1.5D0 1044 GSUN(2,1, 1) = GSUN(2,1,-1) 1045 GSUN(2,2,-1) = GSUN(2,0, 1) 1046 GSUN(2,2, 0) = GSUN(2,0, 0) 1047 GSUN(2,2, 1) = GSUN(2,0,-1) 1048 1049 C1 Compute the spacecraft's inclination function F(lmp). Only compute 1050 C1 F for the required range of indices. 1051 1052 FSC(2,0,1) = .75D0 * SI2 - .5D0 1053 FSC(2,1,1) = -1.50D0 * SICI 1054 FSC(2,2,1) = 1.50D0 * SI2 1055 1056 C1 Compute the spacecraft's inclination function dF(lmp)/di. Only 1057 C1 compute dF/di for the required range of indices. 1058 1059 DFDI(2,0,1) = 1.5D0 * SICI 1060 DFDI(2,1,1) = -1.5D0 * ( 2D0 * CI2 - 1.D0 ) 1061 DFDI(2,2,1) = 3.0D0 * SICI 1062 1063 C1 Compute the moon's inclination function F(lmh). Only compute 1064 C1 F for the required range of indices. 1065 1066 FMOON(2,0,0) = -.375D0 * SIM2 1067 FMOON(2,0,1) = .750D0 * SIM2 - .5D0 1068 FMOON(2,0,2) = -.375D0 * SIM2 1069 FMOON(2,1,0) = .750D0 * SIM * ( 1D0 + CIM ) 1070 FMOON(2,1,1) = -1.500D0 * SIM * CIM 1071 FMOON(2,1,2) = -.750D0 * SIM * ( 1D0 - CIM ) 1072 FMOON(2,2,0) = .750D0 * ( 1D0 + CIM ) ** 2D0 1073 FMOON(2,2,1) = 1.500D0 * SIM2 1074 FMOON(2,2,2) = .750D0 * ( 1D0 - CIM ) ** 2D0 1075 1076 C1 Compute the Sun's inclination function F(lmh). Only compute 1077 C1 F for the required range of indices. 1078 1079 FSUN(2,0,0) = -.375D0 * SIS2 1080 FSUN(2,0,1) = .750D0 * SIS2 - .5D0 1081 FSUN(2,0,2) = -.375D0 * SIS2 1082 FSUN(2,1,0) = .750D0 * SIS * ( 1D0 + CIS ) 1083 FSUN(2,1,1) = -1.500D0 * SIS * CIS LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 20 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1084 FSUN(2,1,2) = -.750D0 * SIS * ( 1D0 - CIS ) 1085 FSUN(2,2,0) = .750D0 * ( 1D0 + CIS ) ** 2D0 1086 FSUN(2,2,1) = 1.500D0 * SIS2 1087 FSUN(2,2,2) = .750D0 * ( 1D0 - CIS ) ** 2D0 1088 1089 C1 Besides the eccentricity and inclination functions, we might as well 1090 C1 compute other products outside of the nested index loops, even though 1091 C1 this may not save any execution time. 1092 1093 C2 Compute products from the spacecraft's orbital elements. 1094 1095 QE = Q / E0 1096 QSI = Q * SI 1097 CIQSI = CI / QSI 1098 NA2 = N * A2 1099 NA2QSI = NA2 * QSI 1100 1101 C2 Compute the power ratio for the expected range of the L index of the 1102 C2 spacecraft's semi-major axis to that of the sun and moon. 1103 1104 ALMOON(2) = A2 / AM3 1105 ALSUN (2) = A2 / AS3 1106 1107 C2 Compute the partial product D*(L-M)!/(L+M)!, where D=1 when M=0 and 1108 C2 D=2 when not M=0. 1109 1110 DLM(2,0) = 1D0 1111 DLM(2,1) = 1D0 / 3D0 1112 DLM(2,2) = 1D0 / 12D0 1113 1114 C1 Compute the change in the spacecraft's non-singular elements due 1115 C1 to both the Sun and Moon. For execution speed, the nested loops 1116 C1 over L, M, P, H, and J and intermingled for both bodies. 1117 C1 1118 C1 The non-singular elements computed are xi, eta, inclination, longitude 1119 C1 of the ascending node, and latitude (w + M). 1120 C1 1121 C1 Luni-solar effects do not change the semi-major axis of the spacecraft. 1122 C1 1123 C1 Note that loop ranges for indices M and H only go up to L, not 1124 C1 MHI or HHI. However, indices P and J range explicitly from their 1125 C1 low to high values. 1126 C1 1127 C1 If LSRGP is modified, then the you should make sure that the loop 1128 C1 range for each index reflects the new index range. 1129 1130 C2 Set L index accumulator values to zero for both Sun and Moon. 1131 1132 DEML = 0D0 1133 DIML = 0D0 1134 DLML = 0D0 1135 DOML = 0D0 1136 DXML = 0D0 1137 1138 DESL = 0D0 1139 DISL = 0D0 1140 DLSL = 0D0 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 21 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1141 DOSL = 0D0 1142 DXSL = 0D0 1143 1144 C2 Begin the L index loop. 1145 1146 DO 201 L = LLO , LHI 1147 1148 C3 Set M index accumulator values to zero for both Sun and Moon. 1149 1150 DEMM = 0D0 1151 DIMM = 0D0 1152 DLMM = 0D0 1153 DOMM = 0D0 1154 DXMM = 0D0 1155 1156 DESM = 0D0 1157 DISM = 0D0 1158 DLSM = 0D0 1159 DOSM = 0D0 1160 DXSM = 0D0 1161 1162 C3 Begin the M index loop. 1163 1164 DO 202 M = MLO , L 1165 1166 C4 Convert M from integer to double precision. 1167 1168 MDP = DFLOAT( M ) 1169 1170 C4 Set P index accumulator values to zero for both Sun and Moon. 1171 1172 DEMP = 0D0 1173 DIMP = 0D0 1174 DLMP = 0D0 1175 DOMP = 0D0 1176 DXMP = 0D0 1177 1178 DESP = 0D0 1179 DISP = 0D0 1180 DLSP = 0D0 1181 DOSP = 0D0 1182 DXSP = 0D0 1183 1184 C4 Begin the P index loop. 1185 1186 DO 203 P = PLO , PHI 1187 1188 C5 Set H index accumulator values to zero for both Sun and Moon. 1189 1190 DEMH = 0D0 1191 DIMH = 0D0 1192 DLMH = 0D0 1193 DOMH = 0D0 1194 DXMH = 0D0 1195 1196 DESH = 0D0 1197 DISH = 0D0 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 22 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1198 DLSH = 0D0 1199 DOSH = 0D0 1200 DXSH = 0D0 1201 1202 C5 Begin H index loop. 1203 1204 DO 204 H = HLO , L 1205 1206 C6 Compute L - 2H for later use in computing integrals. 1207 1208 L2H = DFLOAT( L - 2 * H ) 1209 1210 C6 Set J index accumulator values to zero for both Sun and Moon. 1211 1212 DEMJ = 0D0 1213 DIMJ = 0D0 1214 DLMJ = 0D0 1215 DOMJ = 0D0 1216 DXMJ = 0D0 1217 1218 DESJ = 0D0 1219 DISJ = 0D0 1220 DLSJ = 0D0 1221 DOSJ = 0D0 1222 DXSJ = 0D0 1223 1224 C6 Begin J index loop. (Using JJ, since J is for J2, J3, ...) 1225 1226 DO 205 JJ = JLO , JHI 1227 1228 C7 Compute the integrals of sin(y0) and cos(y0) for 1229 C7 both the Sun and the Moon. 1230 1231 L2HJ = L2H + DFLOAT( JJ ) 1232 1233 Y0M = MDP * DIFFOM - L2H * WM - L2HJ * MM 1234 Y0S = MDP * DIFFOS - L2H * WS - L2HJ * MS 1235 1236 CY0M = DCOS( Y0M ) 1237 SY0M = DSIN( Y0M ) 1238 1239 CY0S = DCOS( Y0S ) 1240 SY0S = DSIN( Y0S ) 1241 1242 XM = TSTEP * ( MDP * ODOT1 - L2HJ * NMOON ) 1243 XM2 = XM * XM 1244 XM4 = XM2 * XM2 1245 XM6 = XM4 * XM2 1246 XM8 = XM6 * XM2 1247 XM10 = XM8 * XM2 1248 XM12 = XM10 * XM2 1249 XM14 = XM12 * XM2 1250 1251 XS = TSTEP * ( MDP * ODOT1 - L2HJ * NSUN ) 1252 XS2 = XS * XS 1253 XS4 = XS2 * XS2 1254 XS6 = XS4 * XS2 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 23 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1255 XS8 = XS6 * XS2 1256 XS10 = XS8 * XS2 1257 XS12 = XS10 * XS2 1258 XS14 = XS12 * XS2 1259 1260 F1M = 1D0 1261 & - XM2 / 6D0 1262 & + XM4 / 120D0 1263 & - XM6 / 5040D0 1264 & + XM8 / 362880D0 1265 & - XM10 / 39916800D0 1266 & + XM12 / 6227020800D0 1267 & - XM14 / 1307674368000D0 1268 1269 F2M = .5D0 1270 & - XM2 / 24D0 1271 & + XM4 / 720D0 1272 & - XM6 / 40320D0 1273 & + XM8 / 3628800D0 1274 & - XM10 / 479001600D0 1275 & + XM12 / 87178291200D0 1276 & - XM14 / 20922789888000D0 1277 1278 F1S = 1D0 1279 & - XS2 / 6D0 1280 & + XS4 / 120D0 1281 & - XS6 / 5040D0 1282 & + XS8 / 362880D0 1283 & - XS10 / 39916800D0 1284 & + XS12 / 6227020800D0 1285 & - XS14 / 1307674368000D0 1286 1287 F2S = .5D0 1288 & - XS2 / 24D0 1289 & + XS4 / 720D0 1290 & - XS6 / 40320D0 1291 & + XS8 / 3628800D0 1292 & - XS10 / 479001600D0 1293 & + XS12 / 87178291200D0 1294 & - XS14 / 20922789888000D0 1295 1296 ICM = TSTEP * ( F1M * CY0M - XM * F2M * SY0M ) 1297 ISM = TSTEP * ( XM * F2M * CY0M + F1M * SY0M ) 1298 1299 ICS = TSTEP * ( F1S * CY0S - XS * F2S * SY0S ) 1300 ISS = TSTEP * ( XS * F2S * CY0S + F1S * SY0S ) 1301 1302 C7 Compute common terms for J index. 1303 1304 GMNICM = GMOON(L,H,JJ) * ICM 1305 GSNICS = GSUN (L,H,JJ) * ICS 1306 1307 C7 Update xi element wrt Moon for J index. 1308 1309 DXMJ = DXMJ + GMNICM 1310 1311 C7 Update xi element wrt Sun for J index. LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 24 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1312 1313 DXSJ = DXSJ + GSNICS 1314 1315 C7 Update eta element wrt Moon for J index. 1316 1317 DEMJ = DEMJ + GMNICM 1318 1319 C7 Update eta element wrt Sun for J index. 1320 1321 DESJ = DESJ + GSNICS 1322 1323 C7 Update inclination element wrt Moon for J index. 1324 1325 DIMJ = DIMJ + GMOON(L,H,JJ) * ISM 1326 1327 C7 Update inclination element wrt Sun for J index. 1328 1329 DISJ = DISJ + GSUN(L,H,JJ) * ISS 1330 1331 C7 Update LAN element wrt Moon for J index. 1332 1333 DOMJ = DOMJ + GMNICM 1334 1335 C7 Update LAN element wrt Sun for J index. 1336 1337 DOSJ = DOSJ + GSNICS 1338 1339 C7 Update argument of latitude element wrt Moon for J index. 1340 1341 DLMJ = DLMJ + GMNICM 1342 1343 C7 Update argument of latitude element wrt Sun for J index. 1344 1345 DLSJ = DLSJ + GSNICS 1346 1347 C6 End J index loop. 1348 1349 205 CONTINUE 1350 1351 C6 Update xi element wrt Moon for H index. 1352 1353 DXMH = DXMH + DXMJ * FMOON(L,M,H) 1354 1355 C6 Update xi element wrt Sun for H index. 1356 1357 DXSH = DXSH + DXSJ * FSUN(L,M,H) 1358 1359 C6 Update eta element wrt Moon for H index. 1360 1361 DEMH = DEMH + DEMJ * FMOON(L,M,H) 1362 1363 C6 Update eta element wrt Sun for H index. 1364 1365 DESH = DESH + DESJ * FSUN(L,M,H) 1366 1367 C6 Update inclination element wrt Moon for H index. 1368 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 25 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1369 DIMH = DIMH + DIMJ * FMOON(L,M,H) 1370 1371 C6 Update inclination element wrt Sun for H index. 1372 1373 DISH = DISH + DISJ * FSUN(L,M,H) 1374 1375 C6 Update LAN element wrt Moon for H index. 1376 1377 DOMH = DOMH + DOMJ * FMOON(L,M,H) 1378 1379 C6 Update LAN element wrt Sun for H index. 1380 1381 DOSH = DOSH + DOSJ * FSUN(L,M,H) 1382 1383 C6 Update argument of latitude element wrt Moon for H index. 1384 1385 DLMH = DLMH + DLMJ * FMOON(L,M,H) 1386 1387 C6 Update argument of latitude element wrt Sun for H index. 1388 1389 DLSH = DLSH + DLSJ * FSUN(L,M,H) 1390 1391 C5 End H index loop. 1392 1393 204 CONTINUE 1394 1395 C5 Compute common term for xi and eta. 1396 1397 DXP = ( CIQSI * DFDI(L,M,P) * GSC(L,P,0) 1398 & - QE * FSC(L,M,P) * DGDE(L,P,0) 1399 & ) 1400 1401 C5 Update xi element wrt Moon for P index. 1402 1403 DXMP = DXMP + DXMH * DXP 1404 1405 C5 Update xi element wrt SUN for P index. 1406 1407 DXSP = DXSP + DXSH * DXP 1408 1409 C5 Update eta element wrt Moon for P index. 1410 1411 DEMP = DEMP - DEMH * DXP 1412 1413 C5 Update eta element wrt SUN for P index. 1414 1415 DESP = DESP - DESH * DXP 1416 1417 C5 Compute common term for inclination and LAN. 1418 1419 GSCFSC = GSC(L,P,0) * FSC (L,M,P) 1420 GSCDF = GSC(L,P,0) * DFDI(L,M,P) 1421 1422 C5 Update inclination element wrt Moon for P index. 1423 1424 DIMP = DIMP + DIMH * GSCFSC 1425 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 26 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1426 C5 Update inclination element wrt SUN for P index. 1427 1428 DISP = DISP + DISH * GSCFSC 1429 1430 C5 Update LAN element wrt Moon for P index. 1431 1432 DOMP = DOMP + DOMH * GSCDF 1433 1434 C5 Update LAN element wrt SUN for P index. 1435 1436 DOSP = DOSP + DOSH * GSCDF 1437 1438 C5 Compute common term for argument of latitude. 1439 1440 DLP = GSC(L,P,0) 1441 & * ( CIQSI * DFDI(L,M,P) 1442 & + DFLOAT( 2 * L ) * FSC(L,M,P) 1443 & ) 1444 1445 C5 Update argument of latitude element wrt Moon for P index. 1446 1447 DLMP = DLMP + DLMH * DLP 1448 1449 C5 Update argument of latitude element wrt SUN for P index. 1450 1451 DLSP = DLSP + DLSH * DLP 1452 1453 C4 End the P index loop. 1454 1455 203 CONTINUE 1456 1457 C4 Update xi element wrt Moon for M index. 1458 1459 DXMM = DXMM + DXMP * DLM(L,M) 1460 1461 C4 Update xi element wrt Sun for M index. 1462 1463 DXSM = DXSM + DXSP * DLM(L,M) 1464 1465 C4 Update eta element wrt Moon for M index. 1466 1467 DEMM = DEMM + DEMP * DLM(L,M) 1468 1469 C4 Update eta element wrt Sun for M index. 1470 1471 DESM = DESM + DESP * DLM(L,M) 1472 1473 C4 Compute common term for inclination. 1474 1475 MDLM = MDP * DLM(L,M) 1476 1477 C4 Update inclination element wrt Moon for M index. 1478 1479 DIMM = DIMM + DIMP * MDLM 1480 1481 C4 Update inclination element wrt Sun for M index. 1482 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 27 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1483 DISM = DISM + DISP * MDLM 1484 1485 C4 Update LAN element wrt Moon for M index. 1486 1487 DOMM = DOMM + DOMP * DLM(L,M) 1488 1489 C4 Update LAN element wrt Sun for M index. 1490 1491 DOSM = DOSM + DOSP * DLM(L,M) 1492 1493 C4 Update argument of latitude element wrt Moon for M index. 1494 1495 DLMM = DLMM + DLMP * DLM(L,M) 1496 1497 C4 Update argument of latitude element wrt Sun for M index. 1498 1499 DLSM = DLSM + DLSP * DLM(L,M) 1500 1501 C3 End the M index loop. 1502 1503 202 CONTINUE 1504 1505 C3 Update xi element wrt Moon for L index. 1506 1507 DXML = DXML + DXMM * ALMOON(L) 1508 1509 C3 Update xi element wrt Sun for L index. 1510 1511 DXSL = DXSL + DXSM * ALSUN(L) 1512 1513 C3 Update eta element wrt Moon for L index. 1514 1515 DEML = DEML + DEMM * ALMOON(L) 1516 1517 C3 Update eta element wrt Sun for L index. 1518 1519 DESL = DESL + DESM * ALSUN(L) 1520 1521 C3 Update inclination element wrt Moon for L index. 1522 1523 DIML = DIML + DIMM * ALMOON(L) 1524 1525 C3 Update inclination element wrt Sun for L index. 1526 1527 DISL = DISL + DISM * ALSUN(L) 1528 1529 C3 Update LAN element wrt Moon for L index. 1530 1531 DOML = DOML + DOMM * ALMOON(L) 1532 1533 C3 Update LAN element wrt Sun for L index. 1534 1535 DOSL = DOSL + DOSM * ALSUN(L) 1536 1537 C3 Update argument of latitude element wrt Moon for L index. 1538 1539 DLML = DLML + DLMM * ALMOON(L) LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 28 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1540 1541 C3 Update argument of latitude element wrt Sun for L index. 1542 1543 DLSL = DLSL + DLSM * ALSUN(L) 1544 1545 C2 End the L index loop. 1546 1547 201 CONTINUE 1548 1549 C2 Compute common terms for Sun and Moon. 1550 1551 GMMNA2 = GMMOON / NA2 1552 GMSNA2 = GMSUN / NA2 1553 1554 GMMNQS = GMMOON / NA2QSI 1555 GMSNQS = GMSUN / NA2QSI 1556 1557 C2 Complete change to xi due to Moon. 1558 1559 DXMOON = DXML * ETA0 * GMMNA2 1560 1561 C2 Complete change to xi due to Sun. 1562 1563 DXSUN = DXSL * ETA0 * GMSNA2 1564 1565 C2 Complete change to eta due to Moon. 1566 1567 DEMOON = DEML * XI0 * GMMNA2 1568 1569 C2 Complete change to eta due to Sun. 1570 1571 DESUN = DESL * XI0 * GMSNA2 1572 1573 C2 Complete change to inclination due to Moon. 1574 1575 DIMOON = DIML * GMMNQS 1576 1577 C2 Complete change to inclination due to Sun. 1578 1579 DISUN = DISL * GMSNQS 1580 1581 C2 Complete change to LAN due to Moon. 1582 1583 DOMOON = DOML * GMMNQS 1584 1585 C2 Complete change to LAN due to Sun. 1586 1587 DOSUN = DOSL * GMSNQS 1588 1589 C2 Complete change to argument of latitude due to Moon. 1590 1591 DLMOON = - DLML * GMMNA2 1592 1593 C2 Complete change to argument of latitude due to Sun. 1594 1595 DLSUN = - DLSL * GMSNA2 1596 LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 29 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 1597 C1 ********************************************************************* 1598 C1 ********************************************************************* 1599 C1 *** *** 1600 C1 *** Add Effects of Both Earth and Luni-Solar Gravity *** 1601 C1 *** *** 1602 C1 ********************************************************************* 1603 C1 ********************************************************************* 1604 1605 C1 Target for GO TO if LSFLAG is false. 1606 1607 901 CONTINUE 1608 1609 C1 Propagate non-singular elements using both Earth and Luni-Solar 1610 C1 models (luni-solar effects may be zero if LSFLAG is false). 1611 1612 A1 = A0 1613 XI1 = XI0 + DX + DXBAR + DXMOON + DXSUN 1614 ETA1 = ETA0 + DE + DEBAR + DEMOON + DESUN 1615 I1 = I0 + DI + DIMOON + DISUN 1616 O1 = O0 + DO + ODOT1 * TSTEP + DOMOON + DOSUN 1617 L1 = L0 + DL + DLBAR + DLMOON + DLSUN 1618 1619 C1 Convert non-singular elements to Keplerian classical orbital elements. 1620 1621 ORB1(1) = A1 1622 1623 ORB1(2) = DSQRT( XI1**2 + ETA1**2 ) 1624 1625 ORB1(3) = I1 / D2R 1626 1627 ORB1(4) = DMOD( O1 / D2R , 360D0 ) 1628 IF ( ORB1(4) .LT. 0D0 ) ORB1(4) = ORB1(4) + 360D0 1629 1630 ORB1(5) = ATAN2( ETA1 , XI1 ) / D2R 1631 IF ( ORB1(5) .LT. 0D0 ) ORB1(5) = ORB1(5) + 360D0 1632 1633 ORB1(6) = DMOD( L1 / D2R - ORB1(5) , 360D0 ) 1634 IF ( ORB1(6) .LT. 0D0 ) ORB1(6) = ORB1(6) + 360D0 1635 1636 C1 Before we go, let me post mean motion on the LSRGP Bulletin Board. 1637 1638 CALL LSRGPB( 'PUT' , 'LSRGP_N' , N + N1 ) 1639 1640 C1 End of LSRGP. 1641 1642 RETURN 1643 END LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 30 01 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 6349 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 72 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 77552 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 84037 ENTRY POINTS Address Type Name 0-00000000 LSRGPJ VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00012A08 R*8 A0 ** R*8 A1 2-00012A10 R*8 A2 2-00012A18 R*8 AKPCK 2-00012A20 R*8 AKPSK ** R*8 AM ** R*8 AM2 ** R*8 AM3 ** R*8 AS ** R*8 AS2 ** R*8 AS3 ** R*8 BB 2-00012A28 R*8 BDC ** R*8 CEC 2-00012A30 R*8 CI 2-00012A38 R*8 CI2 2-00012A40 R*8 CI4 ** R*8 CIM 2-00012A48 R*8 CIQSI ** R*8 CIS ** R*8 CKW 2-00012A50 R*8 CW ** R*8 CWT1 ** R*8 CY0M ** R*8 CY0S AP-00000008@ CHAR DATE 2-00012A58 R*8 DE 2-00012A60 R*8 DEBAR 3-00000038 R*8 DEG_TO_KM 2-00012A68 R*8 DEMH 2-00012A70 R*8 DEMJ 2-00012A78 R*8 DEML 2-00012A80 R*8 DEMM 2-00012A88 R*8 DEMOON 2-00012A90 R*8 DEMP 2-00012A98 R*8 DESH 2-00012AA0 R*8 DESJ 2-00012AA8 R*8 DESL 2-00012AB0 R*8 DESM 2-00012AB8 R*8 DESP 2-00012AC0 R*8 DESUN 2-00012AC8 R*8 DI 2-00012AD0 R*8 DIFFOM 2-00012AD8 R*8 DIFFOS 2-00012AE0 R*8 DIMH 2-00012AE8 R*8 DIMJ 2-00012AF0 R*8 DIML 2-00012AF8 R*8 DIMM 2-00012B00 R*8 DIMOON 2-00012B08 R*8 DIMP 2-00012B10 R*8 DISH 2-00012B18 R*8 DISJ 2-00012B20 R*8 DISL 2-00012B28 R*8 DISM 2-00012B30 R*8 DISP 2-00012B38 R*8 DISUN 2-00012B40 R*8 DL 2-00012B48 R*8 DLBAR 2-00012B50 R*8 DLDUM 2-00012B58 R*8 DLMH 2-00012B60 R*8 DLMJ 2-00012B68 R*8 DLML 2-00012B70 R*8 DLMM 2-00012B78 R*8 DLMOON 2-00012B80 R*8 DLMP ** R*8 DLP 2-00012B88 R*8 DLSH 2-00012B90 R*8 DLSJ 2-00012B98 R*8 DLSL 2-00012BA0 R*8 DLSM 2-00012BA8 R*8 DLSP 2-00012BB0 R*8 DLSUN 2-00012BB8 R*8 DO 2-00012BC0 R*8 DODUM 2-00012BC8 R*8 DOMH 2-00012BD0 R*8 DOMJ 2-00012BD8 R*8 DOML 2-00012BE0 R*8 DOMM 2-00012BE8 R*8 DOMOON 2-00012BF0 R*8 DOMP 2-00012BF8 R*8 DOSH 2-00012C00 R*8 DOSJ 2-00012C08 R*8 DOSL 2-00012C10 R*8 DOSM 2-00012C18 R*8 DOSP 2-00012C20 R*8 DOSUN 2-00012C28 R*8 DX 2-00012C30 R*8 DXBAR 2-00012C38 R*8 DXMH 2-00012C40 R*8 DXMJ 2-00012C48 R*8 DXML 2-00012C50 R*8 DXMM 2-00012C58 R*8 DXMOON 2-00012C60 R*8 DXMP ** R*8 DXP 2-00012C68 R*8 DXSH 2-00012C70 R*8 DXSJ 2-00012C78 R*8 DXSL 2-00012C80 R*8 DXSM 2-00012C88 R*8 DXSP 2-00012C90 R*8 DXSUN 2-00012C98 R*8 E0 2-00012CA0 R*8 E2 3-00000008 R*8 EARTH_FREQ 3-00000010 R*8 EARTH_RATE ** R*8 EM ** R*8 EM2 ** R*8 EM3 ** R*8 EM4 ** R*8 ES ** R*8 ES2 ** R*8 ES3 ** R*8 ES4 2-00012CA8 R*8 ETA0 2-00012CB0 R*8 ETA1 2-00012CB8 R*8 F ** R*8 F1 ** R*8 F1M ** R*8 F1S ** R*8 F2 ** R*8 F2M ** R*8 F2S ** R*8 FFY 2-00012E2C L*4 FIRST ** R*8 GMMNA2 ** R*8 GMMNQS 3-00000020 R*8 GMMOON ** R*8 GMNICM 3-00000018 R*8 GMRTH ** R*8 GMSNA2 ** R*8 GMSNQS 3-00000028 R*8 GMSUN ** R*8 GSCDF ** R*8 GSCFSC ** R*8 GSNICS 2-00012E10 I*4 H LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 31 01 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 2-00012CC0 R*8 I0 ** R*8 I1 ** R*8 ICM ** R*8 ICS ** I*4 IDX ** R*8 ISM ** R*8 ISS ** I*4 IV ** R*8 J2SQR ** R*8 JGA ** R*8 JGABA 2-00012E14 I*4 JJ 2-00012E18 I*4 K 2-00012E1C I*4 KTOP ** R*8 KWT 2-00012E20 I*4 L 2-00012CC8 R*8 L0 2-00012CD0 R*8 L1 ** R*8 L2H 2-00012CD8 R*8 L2HJ 2-00012CE0 R*8 LDOT1 2-00012CE8 R*8 LKBYKK ** R*8 LNRPL AP-00000018@ L*4 LSFLAG AP-00000014@ I*4 LTOP 2-00012E24 I*4 M 2-00012CF0 R*8 M0 ** R*8 MDLM ** R*8 MDP 2-00012CF8 R*8 MM 2-00012D00 R*8 MS 2-00012D08 R*8 N ** R*8 N0 2-00012D10 R*8 N1 2-00012D18 R*8 NA2 2-00012D20 R*8 NA2QSI 2-00012D28 R*8 NJ 2-00012D30 R*8 NJR 2-00012D38 R*8 NRPL4 2-00012D40 R*8 O0 ** R*8 O1 2-00012D48 R*8 ODOT1 2-00012D50 R*8 ODOTJ 2-00012E28 I*4 P ** R*8 PP 2-00012D58 R*8 Q 2-00012D60 R*8 Q2 2-00012D68 R*8 QE ** R*8 QSA ** R*8 QSI 3-00000000 R*8 RE 2-00012D70 R*8 RPL1 ** R*8 SAS ** R*8 SEC 2-00012D78 R*8 SI 2-00012D80 R*8 SI2 2-00012D88 R*8 SICI 3-00000030 R*8 SID_DAY ** R*8 SIM ** R*8 SIM2 ** R*8 SIS ** R*8 SIS2 ** R*8 SKW 2-00012D90 R*8 SW ** R*8 SWT ** R*8 SY0M ** R*8 SY0S AP-0000000C@ R*8 TSTEP 2-00012D98 R*8 W0 2-00012DA0 R*8 WDOT1 2-00012DA8 R*8 WDOTJ 2-00012DB0 R*8 WM 2-00012DB8 R*8 WS ** R*8 WT 2-00012DC0 R*8 XI0 2-00012DC8 R*8 XI1 2-00012DD0 R*8 XM 2-00012DE0 R*8 XM10 2-00012DE8 R*8 XM12 ** R*8 XM14 ** R*8 XM2 ** R*8 XM4 ** R*8 XM6 2-00012DD8 R*8 XM8 2-00012DF0 R*8 XS ** R*8 XS10 ** R*8 XS12 ** R*8 XS14 ** R*8 XS2 2-00012DF8 R*8 XS4 2-00012E00 R*8 XS6 2-00012E08 R*8 XS8 ** R*8 Y0M ** R*8 Y0S ARRAYS Address Type Name Bytes Dimensions 2-00000588 R*8 A 6720 (2:29, 0:29) 2-00001FC8 R*8 AK 6720 (2:29, 0:29) 2-00003A08 R*8 AKP 6720 (2:29, 0:29) 2-00000000 R*8 ALMOON 8 (2:2) 2-00005448 R*8 ALPHA 6960 (29, 0:29) 2-00000008 R*8 ALSUN 8 (2:2) 2-00006F78 R*8 B 6720 (2:29, 0:29) 2-000089B8 R*8 BETA 6720 (2:29, 0:29) 2-0000A3F8 R*8 BK 6720 (2:29, 0:29) 2-0000BE38 R*8 CK 6720 (2:29, 0:29) 2-00000010 R*8 COSINT 232 (29) 2-000000F8 R*8 DFDI 24 (2:2, 0:2, 1) 2-00000110 R*8 DGDE 8 (2:2, 1, 0:0) 2-0000D878 R*8 DK 6720 (2:29, 0:29) 2-00000118 R*8 DLM 24 (2:2, 0:2) 2-00000130 R*8 ESI 232 (29) 2-0000F2B8 R*8 FACTRL 240 (0:29) 2-00000218 R*8 FMOON 72 (2:2, 0:2, 0:2) 2-00000260 R*8 FSC 24 (2:2, 0:2, 1) 2-00000278 R*8 FSUN 72 (2:2, 0:2, 0:2) 2-0000F3A8 R*8 GAMMA 6720 (2:29, 0:29) 2-000002C0 R*8 GMOON 72 (2:2, 0:2, -1:1) 2-00000308 R*8 GSC 8 (2:2, 1, 0:0) 2-00000310 R*8 GSUN 72 (2:2, 0:2, -1:1) AP-00000010@ R*8 J 224 (2:29) 2-00000358 R*8 LUNSTT 48 (6) 2-00000388 R*8 NRPL 232 (29) LSRGPJ 1-Jun-1993 15:38:15 VAX FORTRAN V5.6-119 Page 32 01 21-Jan-1993 21:29:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.FOR;6 AP-00000004@ R*8 ORB0 48 (6) AP-0000001C@ R*8 ORB1 48 (6) 2-00000470 R*8 SININT 232 (29) 2-00000558 R*8 SUNSTT 48 (6) 2-00010DE8 R*8 T 6720 (2:29, 0:29) 2-00012828 R*8 U2KK 240 (0:29) 2-00012918 R*8 UK 240 (0:29) LABELS Address Label Address Label Address Label Address Label Address Label Address Label ** 100 ** 101 ** 102 ** 104 ** 105 ** 106 ** 107 ** 108 ** 109 ** 110 ** 111 ** 112 ** 113 ** 201 ** 202 ** 203 ** 204 ** 205 1-00000018 301' 0-0000177E 901 ** 1051 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name LSRGPB LUNORB R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DMOD R*8 MTH$DSIN R*8 MTH$DSQRT SUNORB COMMAND QUALIFIERS FOR/LIS LSRGPJ.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LSRGPJ.OBJ;2 COMPILATION STATISTICS Run Time: 3.74 seconds Elapsed Time: 12.71 seconds Page Faults: 923 Dynamic Memory: 1032 pages 1-Jun-1993 15:38:38 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:30:31 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.FOR;5 0001 C$Procedure LUNORB 0002 C 0003 SUBROUTINE LUNORB ( DATE , MOON ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C LUNORB computes the mean orbital elements of the Moon in EME and equinox 0017 C of date coordinate system. 0018 C 0019 C$ Input_Arguments 0020 C 0021 C DATE - epoch at which to determine orbital elements of Sun 0022 C 0023 C$ Output_Arguments 0024 C 0025 C MOON - mean orbital elements of the Moon (a,e,i,LAN,w,M), km,deg 0026 C 0027 C$ Log 0028 C 0029 C 21-Mar-1989 - Eric Cannell - creation 0030 C 0031 C$ Library_Links 0032 C 0033 C TIMETRANS 0034 C 0035 C$ Parameters 0036 C 0037 CHARACTER*25 J1899 0038 PARAMETER ( J1899 = '31-DEC-1899 12:00:00.0000' ) 0039 0040 DOUBLE PRECISION PI 0041 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0042 0043 DOUBLE PRECISION D2R 0044 PARAMETER ( D2R = PI / 180.0D0 ) 0045 C 0046 C$ Declarations_of_Input_and_Output_Arguments 0047 C 0048 CHARACTER*(*) DATE 0049 DOUBLE PRECISION MOON ( 6 ) 0050 C 0051 C$ Declarations_of_Local_Variables 0052 C 0053 DOUBLE PRECISION ALPHA 0054 DOUBLE PRECISION APM 0055 DOUBLE PRECISION COSALF 0056 DOUBLE PRECISION COSB 0057 DOUBLE PRECISION COSOM LUNORB 1-Jun-1993 15:38:38 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:30:31 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.FOR;5 0058 DOUBLE PRECISION D 0059 DOUBLE PRECISION DF 0060 DOUBLE PRECISION EPM 0061 LOGICAL ERROR 0062 DOUBLE PRECISION IPM 0063 DOUBLE PRECISION JD1899 0064 DOUBLE PRECISION JDEPOC 0065 DOUBLE PRECISION MPM 0066 DOUBLE PRECISION OOE 0067 DOUBLE PRECISION OPM 0068 DOUBLE PRECISION SINB 0069 DOUBLE PRECISION SINOM 0070 DOUBLE PRECISION TE 0071 DOUBLE PRECISION WPM 0072 C 0073 C$ External_Statements 0074 C 0075 DOUBLE PRECISION CH2JD 0076 EXTERNAL CH2JD 0077 C 0078 C$ Method 0079 C-& 0080 0081 C1 Convert reference epoch and orbit epoch to Julian date. 0082 0083 JD1899 = CH2JD ( J1899 , .TRUE. , ERROR ) 0084 JDEPOC = CH2JD ( DATE , .TRUE. , ERROR ) 0085 0086 C1 Compute number of ephemeris days from reference epoch and fraction. 0087 0088 D = JDEPOC - JD1899 0089 DF = D / 10000.0D0 0090 0091 C1 Compute orbital elements of Moon (a, e, i, LAN , w, M) in Earth 0092 C1 mean ecliptic and equinox of date. 0093 0094 APM = 384 400.0D0 0095 EPM = 0.054900489D0 0096 IPM = 5.1453964D0 0097 OPM = 259.183275D0 - 0.0529539222*D + .0001557*DF**2 + 0098 & 5.D-8*DF**3 0099 WPM = 334.329556D0 + .1114040803D0*D - .0007739D0*DF**2 - 0100 & 2.6D-7*DF**3 - OPM 0101 MPM = 270.434164D0 + 13.1763965268*D - 8.5D-5*DF**2 + 0102 & 3.9D-8*DF**3 - OPM - WPM 0103 0104 OPM = DMOD( OPM , 360.0D0 ) 0105 WPM = DMOD( WPM , 360.0D0 ) 0106 MPM = DMOD( MPM , 360.0D0 ) 0107 0108 IF ( OPM .LT. 0.0D0 ) OPM = OPM + 360.0D0 0109 IF ( WPM .LT. 0.0D0 ) WPM = WPM + 360.0D0 0110 IF ( MPM .LT. 0.0D0 ) MPM = MPM + 360.0D0 0111 0112 C1 Compute the mean obliquity of the ecliptic. 0113 0114 TE = ( D + 1.0D0 ) / 36525.0D0 LUNORB 1-Jun-1993 15:38:38 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:30:31 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.FOR;5 0115 0116 OOE = 23.45229444D0 - .0130125D0 * TE - .16388889D-5*TE**2 + 0117 & .50277778D-6*TE**3 0118 0119 OOE = OOE * D2R 0120 0121 C1 Copy a, e, and M into return vector. 0122 0123 MOON( 1 ) = APM 0124 MOON( 2 ) = EPM 0125 MOON( 6 ) = MPM 0126 0127 C1 Convert inclination from ecliptic to equator. 0128 0129 COSALF = DSIN(IPM*D2R)*DSIN(OOE)*DCOS(OPM*D2R) 0130 & - DCOS(OOE)*DCOS(IPM*D2R) 0131 ALPHA = DACOS( COSALF ) 0132 0133 MOON( 3 ) = ( PI - ALPHA ) / D2R 0134 0135 C1 Convert LAN from ecliptic to equator. 0136 0137 SINOM = DSIN(OPM*D2R) * DSIN(IPM*D2R) / DSIN(ALPHA) 0138 COSOM = ( DCOS(IPM*D2R) + DCOS(ALPHA) * DCOS(OOE) ) 0139 & / DSIN(ALPHA) / DSIN(OOE) 0140 0141 IF ( SINOM .EQ. 0.0D0 .AND. COSOM .EQ. 0.0D0 ) THEN 0142 MOON( 4 ) = 0.0 0143 ELSE 0144 MOON( 4 ) = DATAN2( SINOM , COSOM ) / D2R 0145 IF ( MOON( 4 ) .LT. 0.0D0 ) MOON( 4 ) = MOON( 4 ) + 360.0D0 0146 END IF 0147 0148 C1 Convert w from ecliptic to equator. 0149 0150 SINB = DSIN(OPM*D2R) * DSIN(OOE) / DSIN(ALPHA) 0151 COSB = ( DCOS(OOE) + DCOS(ALPHA) * DCOS(IPM*D2R) ) 0152 & / DSIN(ALPHA) / DSIN(IPM*D2R) 0153 0154 IF ( SINB .EQ. 0.0D0 .AND. COSB .EQ. 0.0D0 ) THEN 0155 MOON( 5 ) = WPM 0156 ELSE 0157 MOON( 5 ) = WPM + DATAN2( SINB , COSB ) / D2R 0158 IF ( MOON( 5 ) .LT. 0.0D0 ) MOON( 5 ) = MOON( 5 ) + 360.0D0 0159 END IF 0160 0161 RETURN 0162 END LUNORB 1-Jun-1993 15:38:38 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:30:31 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.FOR;5 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 780 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 38 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 196 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 1014 ENTRY POINTS Address Type Name 0-00000000 LUNORB VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 ALPHA ** R*8 APM ** R*8 COSALF 2-00000000 R*8 COSB 2-00000008 R*8 COSOM 2-00000010 R*8 D AP-00000004@ CHAR DATE ** R*8 DF ** R*8 EPM 2-00000040 L*4 ERROR ** R*8 IPM ** R*8 JD1899 ** R*8 JDEPOC 2-00000018 R*8 MPM ** R*8 OOE 2-00000020 R*8 OPM 2-00000028 R*8 SINB 2-00000030 R*8 SINOM ** R*8 TE 2-00000038 R*8 WPM ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 MOON 48 (6) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 CH2JD R*8 MTH$DACOS R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DMOD R*8 MTH$DSIN COMMAND QUALIFIERS FOR/LIS LUNORB.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS LUNORB 1-Jun-1993 15:38:38 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 21:30:31 NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.FOR;5 /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]LUNORB.OBJ;2 COMPILATION STATISTICS Run Time: 0.54 seconds Elapsed Time: 3.06 seconds Page Faults: 286 Dynamic Memory: 520 pages 1-Jun-1993 15:38:44 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:31:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.FOR;2 0001 C$ Procedure MA2EA 0002 C 0003 DOUBLE PRECISION FUNCTION MA2EA ( ECC , MADEG ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C MA2EA converts mean anomaly to eccentric anomaly using Newton's 0017 C Method upon Kelper's Equation. 0018 C 0019 C$ Input_Arguments 0020 C 0021 C ECC - the eccentricity 0022 C MADEG - the mean anomaly in degrees 0023 C 0024 C$ Output_Arguments 0025 C 0026 C MA2EA - function return that is the eccentric anomaly in degrees 0027 C 0028 C$ Restrictions 0029 C 0030 C 1- MA2EA is not stable for eccentricity > .965. This routine 0031 C will return -999 for ECC > .965. 0032 C$ Log 0033 C 0034 C 17-Feb-1989 - Eric Cannell - creation 0035 C 0036 C$ Parameters 0037 C 0038 DOUBLE PRECISION EPS 0039 PARAMETER ( EPS = 1.0D-15 ) 0040 0041 DOUBLE PRECISION MAXECC 0042 PARAMETER ( MAXECC = .965 ) 0043 0044 DOUBLE PRECISION PI 0045 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0046 0047 DOUBLE PRECISION D2R 0048 PARAMETER ( D2R = PI / 180.0D0 ) 0049 C 0050 C$ Declarations_of_Input_and_Output_Arguments 0051 C 0052 DOUBLE PRECISION ECC 0053 DOUBLE PRECISION MADEG 0054 C 0055 C$ Declarations_of_Local_Variables 0056 C 0057 DOUBLE PRECISION EA MA2EA 1-Jun-1993 15:38:44 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:31:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.FOR;2 0058 DOUBLE PRECISION EANXT 0059 DOUBLE PRECISION ERATIO 0060 DOUBLE PRECISION MARAD 0061 C 0062 C$ Method 0063 C-& 0064 0065 C1 If mean anomaly is zero, then return zero. 0066 0067 IF ( MADEG .EQ. 0.0D0 ) THEN 0068 MA2EA = 0.0D0 0069 RETURN 0070 END IF 0071 0072 C1 Check that eccentricity is not greater than MAXECC. 0073 0074 IF ( ECC .GT. MAXECC ) THEN 0075 MA2EA = -999. 0076 RETURN 0077 END IF 0078 0079 C1 Convert mean anomaly to radians. 0080 0081 MARAD = MADEG * D2R 0082 0083 C1 Let the initial guess be the value of the mean anomaly. 0084 0085 EANXT = MARAD 0086 0087 C1 Use Newton's Equation to find the root of 0 = E - esin(E) - M. 0088 0089 901 CONTINUE 0090 0091 EA = EANXT 0092 0093 EANXT = EA - ( EA - ECC * DSIN( EA ) - MARAD ) 0094 & / ( 1.0D0 - ECC * DCOS( EA ) ) 0095 0096 ERATIO = DABS( EANXT - EA ) / EA 0097 0098 IF ( ERATIO .GT. EPS ) GO TO 901 0099 0100 C1 Return the eccentric anomaly in degrees. 0101 0102 MA2EA = EANXT / D2R 0103 0104 RETURN 0105 END MA2EA 1-Jun-1993 15:38:44 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:31:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 149 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 24 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 173 ENTRY POINTS Address Type Name 0-00000000 R*8 MA2EA VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000008 R*8 EA ** R*8 EANXT AP-00000004@ R*8 ECC ** R*8 ERATIO AP-00000008@ R*8 MADEG 2-00000010 R*8 MARAD LABELS Address Label 0-00000044 901 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 MTH$DCOS R*8 MTH$DSIN COMMAND QUALIFIERS FOR/LIS MA2EA.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.OBJ;2 MA2EA 1-Jun-1993 15:38:44 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:31:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MA2EA.FOR;2 COMPILATION STATISTICS Run Time: 0.25 seconds Elapsed Time: 2.25 seconds Page Faults: 208 Dynamic Memory: 456 pages 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0001 C$Procedure MNODES 0002 C 0003 SUBROUTINE MNODES ( ORBIN , DATIN , 0004 & M , jearth , 0005 & LTOP , LSFLAG , 0006 & DRAG , dsmadt, tsmaswitch, 0007 & sigma_dsma, HILO, 0008 & ORBOUT , DATOUT , BETAPrime ) 0009 C 0010 C 0011 C******************************************************************************* 0012 C 0013 C Copyright (C) 1993, California Institute of Technology. U.S. 0014 C Government Sponsorhip under NASA Contract NAS7-918 is 0015 C acknowledged. 0016 C 0017 C******************************************************************************* 0018 C 0019 C$ Log 0020 C 0021 C Date Name Description 0022 C ----------------------------------------------------------------------------- 0023 C 11-JUL-1990 Eric Cannell creation of MNODES 0024 C 13-SEp-1991 Bruce Shapiro add JEARTH as parameter 0025 C 0026 C$ Purpose 0027 C 0028 C MNODES determines the classical elements and epoch of the Mth ascending 0029 C node. 0030 C 0031 C$ Input_Arguments 0032 C 0033 C Name Type Dim Units Description 0034 C ----------------------------------------------------------------------------- 0035 C ORBIN DP 6 km,deg classical elements (a,e,i,LAN,w,M) 0036 C DATIN C*(*) 1 - epoch of ORBIN, TIMETRANS format 0037 C 'dd-mmm-yyyy hh:mm:ss.ffff' 0038 C M I 1 - index of desired ascending node. 0 < M. 0039 C JEARTH DP (2:29) - earth zonals 0040 C LTOP I 1 - LTOP passed to LSRGP 0041 C LSFLAG L 1 - if true, luni-solar effects are turned 0042 C on in LSRGP 0043 C DRAG L 1 - if true, atmoshperic drag is turned on 0044 C dsmadt r*8 m/day 0045 C tsmaswitch r*8 0046 C sigma_dsma 0047 C HILO c*4 1 - which drag to use, HI, LO, TRUE 0048 C 0049 C$ Output_Arguments 0050 C 0051 C Name Type Dim Units Description 0052 C ----------------------------------------------------------------------------- 0053 C ORBOUT DP 6 km,deg classical elements (a,e,i,LAN,w,M) at 0054 C the Mth ascending node 0055 C DATOUT C*(*) 1 - epoch of Mth ascending node, TIMETRANS 0056 C format 'dd-mmm-yyyy hh:mm:ss.ffff' 0057 C BETAPrime DP 1 deg beta prime angle at START OF RUN 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0058 C 0059 C$ Restrictions 0060 C 0061 C 1] MNODES is strictly for Earth orbiters only, since the LSRGP library 0062 C is used to propagate the orbit. 0063 C 0064 C 2] ORBIN must not have a inclination of zero. MNODES does NOT check 0065 C for i=0, since execution time is a valuable commodity. 0066 C 0067 C 3] Index of desired ascending node (M) must be greater than zero. MNODES 0068 C does NOT check for M>0, since execution time is a valuable commodity. 0069 C 0070 C 4] If the initial orbit is at an ascending node (u0=0), then that node 0071 C is the zeroth node, not the first node. 0072 C 0073 C 5] Often a programmer will use MNODES to iterate on an orbit, feeding 0074 C the orbit at the ascending node back into MNODES. Unfortunately, 0075 C the orbit returned for the ascending node MIGHT have an exceedingly 0076 C small -Z component. In such a case, simply feeding the orbit back to 0077 C MNODES would have caused either the same ascending node to be counted 0078 C twice OR crash LSRGP when the propagation time is on the order of 0079 C 10**-15 (the time needed to go from, say, Z=-10**-13 to Z=0). 0080 C 0081 C =====> Because GTARG runs out a ground track by propagating an orbit 0082 C M ascending nodes from the current ascending node (M>0), 0083 C I have arbitrarily decided that if the initial argument of 0084 C latitude (U0) is in the range of [359.999,360.000] then 0085 C MNODES will set U0 to zero. In which case, Restriction #4 0086 C is invoked. 0087 C 0088 C The only possible loss is that MNODES may skip the very first 0089 C ascending node of a ground track if the initial orbit provided 0090 C to GTARG happens to have an exceedingly small Z-component. Such 0091 C a loss does not affect the results of GTARG. 0092 C 0093 C$ Library_Links 0094 C 0095 C Entry Point Name Location 0096 C ----------------------------------------------------------------------------- 0097 C CH2SEC TIMETRANS 0098 C DVMOVE TPXUTIL 0099 C ORB2U TPXORB 0100 C PROP GTARG 0101 C SEC2CH TIMETRANS 0102 C 0103 C common area for physical constants 0104 C 0105 double precision earth_rad ! in kilomters 0106 double precision earth_freq ! radians / second 0107 double precision earth_rate ! kilomters / day 0108 double precision GMrth ! km**3/sec 0109 double precision mu_moon ! km**3/sec 0110 double precision mu_sun ! km**3/sec 0111 double precision sid_day ! seconds 0112 double precision deg_to_km ! kilometers/deg 0113 0114 common / physical_constants / MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0115 & earth_rad, earth_freq, earth_rate, GMrth, 0116 & mu_moon, mu_sun, sid_day, deg_to_km 0117 0118 0119 C$ Parameters 0120 C 0121 logical trace 0122 parameter (trace = .false.) 0123 DOUBLE PRECISION EPS 0124 PARAMETER ( EPS = 1.0D-5 ) 0125 0126 C DOUBLE PRECISION GMRTH 0127 C PARAMETER ( GMRTH = 398600.44807345D0 ) 0128 0129 INTEGER KMAX 0130 PARAMETER ( KMAX = 20 ) 0131 0132 DOUBLE PRECISION PI 0133 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0134 0135 DOUBLE PRECISION D2R 0136 PARAMETER ( D2R = PI / 180D0 ) 0137 0138 DOUBLE PRECISION TWOPI 0139 PARAMETER ( TWOPI = 2D0 * PI ) 0140 C 0141 C$ Declarations_of_Input_and_Output_Arguments 0142 C 0143 double precision betap, betaprime 0144 CHARACTER*(*) DATIN 0145 CHARACTER*(*) DATOUT 0146 CHARACTER*4 HILO 0147 double precision jearth ( 2:29 ) 0148 LOGICAL DRAG 0149 double precision dsmadt(2), tsmaswitch 0150 double precision sigma_dsma(2) 0151 LOGICAL LSFLAG 0152 INTEGER LTOP 0153 INTEGER M 0154 DOUBLE PRECISION ORBIN ( 6 ) 0155 DOUBLE PRECISION ORBOUT ( 6 ) 0156 C 0157 C$ Declarations_of_Local_Variables 0158 C 0159 CHARACTER*25 DATSHY 0160 LOGICAL ERROR 0161 DOUBLE PRECISION JSEC 0162 INTEGER KFLAG 0163 DOUBLE PRECISION O1 ( 6 ) 0164 DOUBLE PRECISION O2 ( 6 ) 0165 DOUBLE PRECISION ORBSHY ( 6 ) 0166 DOUBLE PRECISION P 0167 DOUBLE PRECISION SU1 0168 DOUBLE PRECISION SU2 0169 DOUBLE PRECISION T1 0170 DOUBLE PRECISION T2 0171 DOUBLE PRECISION T3 MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 4 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0172 DOUBLE PRECISION T4MORE 0173 DOUBLE PRECISION TSHY 0174 DOUBLE PRECISION U0 0175 DOUBLE PRECISION U1 0176 DOUBLE PRECISION U2 0177 DOUBLE PRECISION U2GO 0178 C 0179 C$ External_Statements 0180 C 0181 DOUBLE PRECISION CH2SEC 0182 EXTERNAL CH2SEC 0183 0184 CHARACTER*25 SEC2CH 0185 EXTERNAL SEC2CH 0186 C 0187 C$ Method 0188 C 0189 C In general- 0190 C 0191 C 1- Propagate orbit forward in one step to a point about 2 degrees 0192 C shy of the Mth ascending node. 0193 C 0194 C 2- Propagate about 4 degrees beyond that point to a second point 0195 C in the +z hemisphere. 0196 C 0197 C 3- Given two orbits that bound the Mth ascending node, use the 0198 C secant method to search for the orbit and epoch where the 0199 C sin(u) is zero. This is equivalent to finding the root 0200 C of: 0201 C 0202 C sin( u(t) ) = 0. 0203 C 0204 C Since the function sin(u(t)) is a well-behaved function of t, the 0205 C secant method will converge quickly to the desired root. 0206 C 0207 C 4- Note that sin(u(t)) is zero at both the ascending and descending 0208 C nodes. However, the initial step taken by MNODES will place the 0209 C orbit just shy of the ascending node. 0210 C 0211 C Specifically- 0212 C-& 0213 0214 0215 if (trace) then 0216 write (50,*) 'MNODES: Input', 0217 & ORBIN , DATIN , M , jearth , LTOP , LSFLAG , 0218 & DRAG , HILO, ORBOUT , DATOUT 0219 end if 0220 0221 0222 C1 Estimate the orbital period (in seconds) during this time to be 0223 C1 roughly a constant 2pi * sqrt( a**3 / gm ). 0224 0225 P = TWOPI * DSQRT( ORBIN(1)**3 / GMRTH ) 0226 0227 C1 Determine the initial U0. 0228 MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0229 CALL ORB2U( ORBIN , U0 ) 0230 0231 C1 Invoke Restriction #5, if necessary. 0232 0233 IF ( U0 .GT. 359.999 ) U0 = 0D0 0234 0235 C1 Compute the remaining U-to-go to the next ascending node. This is 0236 C1 the first ascending node. 0237 0238 U2GO = 360D0 - U0 0239 0240 C1 Propagate initial orbit up to about 2 degrees shy of Mth ascending 0241 C1 node. Note that this places the orbit in the -z hemisphere near an 0242 C1 ascending node, not a descending node. 0243 0244 TSHY = ( DFLOAT( M - 1 ) 0245 & + ( U2GO - 2D0 ) 0246 & / 360D0 0247 & ) 0248 & * P 0249 0250 C write(8,*) 'MNODES1 hilo = ',hilo 0251 0252 CALL PROP( ORBIN , DATIN , TSHY , JEARTH, LTOP , 0253 & LSFLAG , DRAG , dsmadt, tsmaswitch, 0254 & sigma_dsma, HILO, O1, BETAPRIME ) 0255 0256 C write(8,*)'MNODES BETAP=',betap 0257 0258 C1 Compute the epoch at this point. 0259 0260 JSEC = CH2SEC( DATIN , .TRUE. , ERROR ) + TSHY 0261 DATSHY = SEC2CH( JSEC ) 0262 0263 C1 Propagate orbit about 4 degrees more, placing orbit in +z hemisphere. 0264 0265 T4MORE = ( 4D0 / 360D0 ) * P 0266 0267 C write(8,*) 'MNODES2 hilo = ',hilo 0268 0269 CALL PROP( O1 , DATSHY , T4MORE , jearth , 0270 & LTOP , LSFLAG , DRAG , dsmadt, tsmaswitch, 0271 & sigma_dsma, HILO, O2, BETAP ) 0272 0273 C write(8,*)'MNODES BETAP=',betap 0274 0275 C1 Setup for secant search for ascending node. Let the -z orbit be 0276 C1 designated (O1,T1,SU1) and the +z orbit be designated (O2,T2,SU2), 0277 C1 where SUn = sin( Un ). The node is somewhere in between orbit O1 and 0278 C1 orbit O2. 0279 0280 T1 = 0D0 0281 T2 = T4MORE 0282 0283 CALL ORB2U( O1 , U1 ) 0284 CALL ORB2U( O2 , U2 ) 0285 MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 6 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0286 SU1 = DSIN( U1 * D2R ) 0287 SU2 = DSIN( U2 * D2R ) 0288 0289 C1 To avoid propagating an orbit backwards in time (although LSRGP should 0290 C1 be able to do it), save O1 and always propagate from there. 0291 0292 CALL DVMOVE( 6 , O1 , ORBSHY ) 0293 0294 C1 Iterate with the secant method until the delta time satisfies 0295 C1 the stopping criteria, until the change in sin( U ) is zero, or 0296 C1 until the maximum number of iterations has been reached. One hopes 0297 C1 that if delta(sin(U)) is zero, then U is zero. 0298 0299 KFLAG = 0 0300 0301 901 CONTINUE 0302 0303 C2 Increment the iteration counter. 0304 0305 KFLAG = KFLAG + 1 0306 0307 C2 Determine the next time iterate. 0308 0309 T3 = T1 - SU1 * ( T2 - T1 ) / ( SU2 - SU1 ) 0310 0311 C2 Transfer the current orbit's time and sin(U). Do not bother to 0312 C2 save the orbital elements, since MNODES always propagate from ORBSHY. 0313 0314 T1 = T2 0315 SU1 = SU2 0316 0317 C2 Generate the next orbit. 0318 0319 T2 = T3 0320 0321 C write(8,*) 'MNODES3 hilo = ',hilo 0322 CALL PROP( ORBSHY , DATSHY , T2 , jearth, 0323 & LTOP , LSFLAG , DRAG , dsmadt, tsmaswitch, 0324 & sigma_dsma, HILO, O2, BETAP ) 0325 0326 c write(8,*)'MNODES BETAP=',betap 0327 0328 CALL ORB2U( O2 , U2 ) 0329 SU2 = DSIN( U2 * D2R ) 0330 0331 C2 If a stopping criteria was reached, exit the secant method. 0332 0333 IF ( DABS( T2 - T1 ) .LE. EPS 0334 & .OR. SU1 .EQ. SU2 0335 & .OR. KFLAG .EQ. KMAX ) GOTO 902 0336 0337 C2 If not, begin another iteration. 0338 0339 GOTO 901 0340 0341 902 CONTINUE 0342 MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 7 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 0343 C1 Once a stopping criteria was reached, return the last iterate 0344 C1 as the final orbit. 0345 0346 CALL DVMOVE( 6 , O2 , ORBOUT ) 0347 0348 C1 Update the nodal epoch. 0349 0350 JSEC = CH2SEC( DATSHY , .TRUE. , ERROR ) + T2 0351 DATOUT = SEC2CH( JSEC ) 0352 0353 C1 End of MNODES. 0354 0355 if (trace) then 0356 write (50,*) 'MNODES: Otput', 0357 & ORBIN , DATIN , M , jearth , LTOP , LSFLAG , 0358 & DRAG , HILO, ORBOUT , DATOUT 0359 end if 0360 0361 0362 RETURN 0363 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 698 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 34 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 712 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 1508 ENTRY POINTS Address Type Name 0-00000000 MNODES VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-000000B0 R*8 BETAP AP-00000038@ R*8 BETAPRIME AP-00000008@ CHAR DATIN AP-00000034@ CHAR DATOUT 2-00000090 CHAR DATSHY 3-00000038 R*8 DEG_TO_KM AP-0000001C@ L*4 DRAG 3-00000008 R*8 EARTH_FREQ 3-00000000 R*8 EARTH_RAD 3-00000010 R*8 EARTH_RATE 2-00000100 L*4 ERROR 3-00000018 R*8 GMRTH AP-0000002C@ CHAR HILO 2-000000B8 R*8 JSEC ** I*4 KFLAG AP-00000018@ L*4 LSFLAG AP-00000014@ I*4 LTOP AP-0000000C@ I*4 M 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN ** R*8 P 3-00000030 R*8 SID_DAY 2-000000C0 R*8 SU1 2-000000C8 R*8 SU2 ** R*8 T1 2-000000D0 R*8 T2 ** R*8 T3 2-000000D8 R*8 T4MORE 2-000000E0 R*8 TSHY AP-00000024@ R*8 TSMASWITCH 2-000000E8 R*8 U0 2-000000F0 R*8 U1 2-000000F8 R*8 U2 ** R*8 U2GO MNODES 1-Jun-1993 15:38:51 VAX FORTRAN V5.6-119 Page 8 01 21-Jan-1993 21:31:53 NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.FOR;39 ARRAYS Address Type Name Bytes Dimensions AP-00000020@ R*8 DSMADT 16 (2) AP-00000010@ R*8 JEARTH 224 (2:29) 2-00000000 R*8 O1 48 (6) 2-00000030 R*8 O2 48 (6) AP-00000004@ R*8 ORBIN 48 (6) AP-00000030@ R*8 ORBOUT 48 (6) 2-00000060 R*8 ORBSHY 48 (6) AP-00000028@ R*8 SIGMA_DSMA 16 (2) LABELS Address Label Address Label 0-000001D8 901 0-0000027C 902 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 CH2SEC DVMOVE R*8 MTH$DSIN R*8 MTH$DSQRT ORB2U PROP CHAR SEC2CH COMMAND QUALIFIERS FOR/LIS MNODES.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]MNODES.OBJ;2 COMPILATION STATISTICS Run Time: 0.58 seconds Elapsed Time: 6.08 seconds Page Faults: 278 Dynamic Memory: 520 pages 1-Jun-1993 15:39:00 VAX FORTRAN V5.6-119 Page 1 29-Apr-1993 20:50:03 NAVDEV:[SHAPIRO.COSMIC.SOURCE]NEWPAGE.FOR;4 0001 subroutine newpage ( ipage, ISKIP ) 0002 integer ipage, ISKIP 0003 character adate*9, atime*8 0004 0005 call date ( adate ) 0006 call time ( atime ) 0007 write (8,3025) adate, atime, ipage 0008 0009 3025 format ('1',/,' ',77('*'),/, 0010 & ' * ', A9,1x,A8,T35, 'GTARG Report', 0011 & T69,'Page ',i3,' *',/, 0012 & ' ',77('*') ) 0013 0014 IPAGE = IPAGE+1 0015 0016 IF (ISKIP.GT.0) THEN 0017 DO I=1,ISKIP 0018 WRITE(8,*) ' ' 0019 END DO 0020 END IF 0021 0022 return 0023 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 127 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 72 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 60 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 259 ENTRY POINTS Address Type Name 0-00000000 NEWPAGE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000000 CHAR ADATE 2-00000009 CHAR ATIME ** I*4 I AP-00000004@ I*4 IPAGE AP-00000008@ I*4 ISKIP NEWPAGE 1-Jun-1993 15:39:00 VAX FORTRAN V5.6-119 Page 2 01 29-Apr-1993 20:50:03 NAVDEV:[SHAPIRO.COSMIC.SOURCE]NEWPAGE.FOR;4 LABELS Address Label 1-00000001 3025' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name FOR$DATE_T_DS FOR$TIME_T_DS COMMAND QUALIFIERS FOR/LIS NEWPAGE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]NEWPAGE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]NEWPAGE.OBJ;2 COMPILATION STATISTICS Run Time: 0.17 seconds Elapsed Time: 3.81 seconds Page Faults: 215 Dynamic Memory: 472 pages 1-Jun-1993 15:39:07 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:35:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFN.FOR;2 0001 C$Procedure OPSFN 0002 C 0003 SUBROUTINE OPSFN ( UNIT , FILE , ERROR ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C OPSFN opens a sequential, formatted, new file. 0017 C 0018 C For example, will open a file for program text output. 0019 C 0020 C$ Input_Arguments 0021 C 0022 C UNIT - FORTRAN unit number 0023 C FILE - file name 0024 C 0025 C$ Output_Arguments 0026 C 0027 C ERROR - set to .FALSE. if file was openned properly. Otherwise, 0028 C set to .TRUE. 0029 C 0030 C$ Log 0031 C 0032 C 22-Apr-1988 0033 C Eric Cannell - birth 0034 C 0035 C$ Files 0036 C 0037 C FILE - UNIT - file to open 0038 C 0039 C$ Declarations_of_Input_and_Output_Arguments 0040 C 0041 LOGICAL ERROR 0042 CHARACTER*(*) FILE 0043 INTEGER UNIT 0044 C 0045 C$ Method 0046 C-& 0047 0048 C1 Set status to false. 0049 0050 ERROR = .FALSE. 0051 0052 C1 Attempt to open file. 0053 0054 OPEN ( 0055 & UNIT = UNIT, 0056 & FILE = FILE, 0057 & ACCESS = 'SEQUENTIAL', OPSFN 1-Jun-1993 15:39:07 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:35:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFN.FOR;2 0058 & FORM = 'FORMATTED', 0059 & STATUS = 'NEW', 0060 & ERR = 998 0061 & ) 0062 0063 GOTO 999 0064 0065 C1 If there was a problem, then set status to .TRUE. 0066 0067 998 CONTINUE 0068 0069 ERROR = .TRUE. 0070 0071 C1 Return status. 0072 0073 999 CONTINUE 0074 0075 RETURN 0076 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 49 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 97 ENTRY POINTS Address Type Name 0-00000000 OPSFN VARIABLES Address Type Name Address Type Name Address Type Name AP-0000000C@ L*4 ERROR AP-00000008@ CHAR FILE AP-00000004@ I*4 UNIT LABELS Address Label Address Label 0-0000002C 998 0-00000030 999 OPSFN 1-Jun-1993 15:39:07 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:35:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFN.FOR;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name FOR$OPEN COMMAND QUALIFIERS FOR/LIS OPSFN.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFN.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFN.OBJ;2 COMPILATION STATISTICS Run Time: 0.25 seconds Elapsed Time: 2.07 seconds Page Faults: 230 Dynamic Memory: 456 pages 1-Jun-1993 15:39:14 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:35:48 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFOR.FOR;3 0001 C$Procedure OPSFOR 0002 C 0003 SUBROUTINE OPSFOR ( UNIT , FILE , ERROR ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C OPSFOR opens a sequential, formatted, old, readonly file. 0017 C 0018 C For example, when opening a file to read one or more namelist. 0019 C 0020 C$ Log 0021 C 0022 C 22-Apr-1988 0023 C Eric Cannell - birth 0024 C 0025 C$ Input_Arguments 0026 C 0027 C UNIT - FORTRAN unit number 0028 C FILE - file name 0029 C 0030 C$ Output_Arguments 0031 C 0032 C ERROR - set .FALSE. if file was opened successfully. Otherwise, 0033 C .TRUE. 0034 C 0035 C$ Files 0036 C 0037 C FILE - UNIT - sequential, formatted, old, readonly file 0038 C 0039 C$ Declarations_of_Input_and_Output_Arguments 0040 C 0041 LOGICAL ERROR 0042 CHARACTER*(*) FILE 0043 INTEGER UNIT 0044 C 0045 C$ Method 0046 C-& 0047 0048 C1 Set error flag to false. 0049 0050 ERROR = .FALSE. 0051 0052 C1 Attempt to open file. 0053 0054 OPEN ( 0055 & UNIT = UNIT, 0056 & FILE = FILE, 0057 & ACCESS = 'SEQUENTIAL', OPSFOR 1-Jun-1993 15:39:14 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:35:48 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFOR.FOR;3 0058 & FORM = 'FORMATTED', 0059 & STATUS = 'OLD', 0060 & READONLY, 0061 & ERR = 998 0062 & ) 0063 0064 GOTO 999 0065 0066 C1 Set error flag to true if there was a problem. 0067 0068 998 CONTINUE 0069 0070 ERROR = .TRUE. 0071 0072 C1 Return status. 0073 0074 999 CONTINUE 0075 0076 RETURN 0077 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 49 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 52 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 101 ENTRY POINTS Address Type Name 0-00000000 OPSFOR VARIABLES Address Type Name Address Type Name Address Type Name AP-0000000C@ L*4 ERROR AP-00000008@ CHAR FILE AP-00000004@ I*4 UNIT LABELS Address Label Address Label 0-0000002C 998 0-00000030 999 OPSFOR 1-Jun-1993 15:39:14 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:35:48 NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFOR.FOR;3 FUNCTIONS AND SUBROUTINES REFERENCED Type Name FOR$OPEN COMMAND QUALIFIERS FOR/LIS OPSFOR.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFOR.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]OPSFOR.OBJ;2 COMPILATION STATISTICS Run Time: 0.19 seconds Elapsed Time: 1.59 seconds Page Faults: 205 Dynamic Memory: 456 pages 1-Jun-1993 15:39:25 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:36:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.FOR;5 0001 C$Procedure ORB2U 0002 C 0003 SUBROUTINE ORB2U ( ORBIT , U ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C 10-JUL-1990 - Eric Cannell - creation of ORB2U 0017 C 0018 C$ Purpose 0019 C 0020 C ORB2U computes U, the argument of latitude of ORBIT. 0021 C 0022 C$ Input_Arguments 0023 C 0024 C Name Type Dim Units Description 0025 C ----------------------------------------------------------------------------- 0026 C ORBIT DP 6 km,deg classical orbital elements: 0027 C ORBIT(1) = semi-major axis 0028 C ORBIT(2) = eccentricity 0029 C ORBIT(3) = inclination 0030 C ORBIT(4) = longitude of the ascending node 0031 C ORBIT(5) = argument of periapsis 0032 C ORBIT(6) = mean anomaly 0033 C 0034 C$ Output_Arguments 0035 C 0036 C Name Type Dim Units Description 0037 C ----------------------------------------------------------------------------- 0038 C U DP 1 deg argument of latitude of ORBIT in 0039 C range of 0..360. 0040 C 0041 C$ Restrictions 0042 C 0043 C 1] Note that MA2EA cannot transform mean anomalies > .965. 0044 C 0045 C$ Library_Links 0046 C 0047 C TPXORB 0048 C 0049 C$ Parameters 0050 C 0051 DOUBLE PRECISION PI 0052 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0053 0054 DOUBLE PRECISION D2R 0055 PARAMETER ( D2R = PI / 180D0 ) 0056 0057 DOUBLE PRECISION TWOPI ORB2U 1-Jun-1993 15:39:25 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:36:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.FOR;5 0058 PARAMETER ( TWOPI = 2D0 * PI ) 0059 C 0060 C$ Declarations_of_Input_and_Output_Arguments 0061 C 0062 DOUBLE PRECISION ORBIT ( 6 ) 0063 DOUBLE PRECISION U 0064 C 0065 C$ Declarations_of_Local_Variables 0066 C 0067 DOUBLE PRECISION CE 0068 DOUBLE PRECISION CV 0069 DOUBLE PRECISION DENOM 0070 DOUBLE PRECISION E 0071 DOUBLE PRECISION EA 0072 DOUBLE PRECISION SE 0073 DOUBLE PRECISION SV 0074 DOUBLE PRECISION V 0075 C 0076 C$ External_Statements 0077 C 0078 DOUBLE PRECISION MA2EA 0079 EXTERNAL MA2EA 0080 0081 DOUBLE PRECISION RNG360 0082 EXTERNAL RNG360 0083 C 0084 C$ Method 0085 C-& 0086 0087 C1 Compute eccentric anomaly and its sine and cosine. 0088 0089 E = ORBIT(2) 0090 0091 EA = MA2EA( E , ORBIT(6) ) * D2R 0092 SE = DSIN( EA ) 0093 CE = DCOS( EA ) 0094 0095 C1 Compute the common denominator. 0096 0097 DENOM = 1D0 - E * CE 0098 0099 C1 Compute true anomaly. 0100 0101 SV = DSQRT( 1D0 - E**2 ) * SE / DENOM 0102 CV = ( CE - E ) / DENOM 0103 0104 V = DATAN2( SV , CV ) / D2R 0105 0106 C1 Compute U, which is sum of argument of periapsis and true anomaly. 0107 0108 U = RNG360( ORBIT(5) + V ) 0109 0110 RETURN 0111 END ORB2U 1-Jun-1993 15:39:25 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:36:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.FOR;5 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 165 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 249 ENTRY POINTS Address Type Name 0-00000000 ORB2U VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 CE 2-00000000 R*8 CV ** R*8 DENOM 2-00000008 R*8 E ** R*8 EA 2-00000010 R*8 SE 2-00000018 R*8 SV AP-00000008@ R*8 U ** R*8 V ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 ORBIT 48 (6) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 MA2EA R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DSIN R*8 MTH$DSQRT R*8 RNG360 COMMAND QUALIFIERS FOR/LIS ORB2U.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.OBJ;2 ORB2U 1-Jun-1993 15:39:25 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:36:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORB2U.FOR;5 COMPILATION STATISTICS Run Time: 0.32 seconds Elapsed Time: 2.11 seconds Page Faults: 271 Dynamic Memory: 472 pages 1-Jun-1993 15:39:18 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:36:57 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.FOR;14 0001 C$Procedure ORBBP 0002 C 0003 DOUBLE PRECISION FUNCTION ORBBP( ORBIT , SUNORB ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C ORBBP computes the beta-prime angle in degrees given the classical 0017 C elements for the satellite and Sun in a central body centered system. 0018 C For example, for Topex, the Earth is the central body. 0019 C 0020 C$ Input_Arguments 0021 C 0022 C ORBIT - central body centered classical elements of satellite 0023 C (a,e,i,LAN,w,M) km,deg 0024 C SUNORB - central body centered classical elements of the Sun 0025 C (a,e,i,LAN,w,M) km,deg 0026 C 0027 C$ Output_Arguments 0028 C 0029 C ORBBP - beta-prime in degrees 0030 C 0031 C$ Log 0032 C 0033 C 24-May-1989 - Eric Cannell - creation 0034 C 9-APR-1992 - Bruce Shapiro 0035 C Correct 2 errors (1) call to MA2EA must have MA in deg. 0036 C (2) correct calculation of true anomaly. 0037 C 0038 C$ Restrictions 0039 C 0040 C 1- The mean anomaly to eccentric anomaly will not converge for 0041 C eccentricities close to 1. See source code for MA2EA. 0042 C 0043 C$ Library_Links 0044 C 0045 C TPXORB 0046 C 0047 C$ Parameters 0048 C 0049 DOUBLE PRECISION PI 0050 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0051 0052 DOUBLE PRECISION D2R 0053 PARAMETER ( D2R = PI / 180.0D0 ) 0054 C 0055 C$ Declarations_of_Input_and_Output_Arguments 0056 C 0057 DOUBLE PRECISION ORBIT ( 6 ) ORBBP 1-Jun-1993 15:39:18 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:36:57 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.FOR;14 0058 DOUBLE PRECISION SUNORB ( 6 ) 0059 C 0060 C$ Declarations_of_Local_Variables 0061 C 0062 DOUBLE PRECISION AX 0063 DOUBLE PRECISION AY 0064 DOUBLE PRECISION AZ 0065 DOUBLE PRECISION B 0066 DOUBLE PRECISION COSB 0067 DOUBLE PRECISION COSV 0068 DOUBLE PRECISION ECANOM 0069 DOUBLE PRECISION ESUN 0070 DOUBLE PRECISION IORB 0071 DOUBLE PRECISION ISUN 0072 DOUBLE PRECISION MSUN 0073 DOUBLE PRECISION OORB 0074 DOUBLE PRECISION OSUN 0075 DOUBLE PRECISION SINV 0076 DOUBLE PRECISION USUN 0077 DOUBLE PRECISION VSUN 0078 DOUBLE PRECISION WSUN 0079 DOUBLE PRECISION WX 0080 DOUBLE PRECISION WY 0081 DOUBLE PRECISION WZ 0082 C 0083 C$ External_Statements 0084 C 0085 DOUBLE PRECISION MA2EA 0086 EXTERNAL MA2EA 0087 C 0088 C$ Method 0089 C-& 0090 0091 C1 Place input orbital elements into local storage. 0092 0093 IORB = D2R * ORBIT( 3 ) 0094 OORB = D2R * ORBIT( 4 ) 0095 0096 ESUN = SUNORB( 2 ) 0097 ISUN = D2R * SUNORB( 3 ) 0098 OSUN = D2R * SUNORB( 4 ) 0099 WSUN = D2R * SUNORB( 5 ) 0100 MSUN = D2R * SUNORB( 6 ) 0101 0102 C1 Compute orbit normal vector. 0103 0104 WX = DSIN( OORB ) * DSIN( IORB ) 0105 WY = - DCOS( OORB ) * DSIN( IORB ) 0106 WZ = DCOS( IORB ) 0107 0108 C1> Use MA2EA to convert mean anomaly to eccentric anomaly. 0109 C NOTE: MA2EA expects the Mean Anomaly IN DEGREES!!!! 0110 0111 ECANOM = D2R * MA2EA( ESUN , MSUN/D2R ) 0112 0113 C1 Compute true anomaly in radians. Ignore the possibility of 0114 C1 both arguments to atan2 being zero, since this will only ORBBP 1-Jun-1993 15:39:18 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:36:57 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.FOR;14 0115 C1 happen if eccentricity is one. See restriction #1. 0116 0117 cosV = ( DCOS( ECANOM ) - ESUN ) 0118 & / ( 1.0D0 - ESUN * DCOS( ECANOM ) ) 0119 0120 sinV = ( DSQRT( 1.0D0 - ESUN**2 ) * DSIN( ECANOM ) ) 0121 & / ( 1.0D0 - ESUN * DCOS( ECANOM ) ) 0122 0123 VSUN = DATAN2( SINV , COSV ) 0124 0125 C1 Sum argument of periapsis and true anomaly in radians. 0126 0127 USUN = WSUN + VSUN 0128 0129 C1 Compute unit position vector of sun. 0130 0131 AX = DCOS( USUN ) * DCOS( OSUN ) 0132 & - DCOS( ISUN ) * DSIN( USUN ) * DSIN( OSUN ) 0133 AY = DCOS( USUN ) * DSIN( OSUN ) 0134 & + DCOS( ISUN ) * DSIN( USUN ) * DCOS( OSUN ) 0135 AZ = DSIN( USUN ) * DSIN( ISUN ) 0136 0137 C write ( 6, *) 'M = ',MSUN/D2R 0138 C write ( 6, * ) 'E = ',ECANOM/D2R 0139 C write ( 6, * ) 'V = ',VSUN/D2R 0140 C write ( 6, * ) 'U = ', USUN/D2R 0141 C write ( 6, * ) 'SUN = ',Ax,' ',ay,' ',az 0142 C write ( 6, * ) 'S/C Normal = ',Wx,' ',wy,' ',wz 0143 C1 Compute beta angle via dot product of orbit normal and sun position. 0144 0145 COSB = WX * AX + WY * AY + WZ * AZ 0146 0147 B = DACOS( COSB ) / D2R 0148 0149 C1 Return beta-prime, the complement of beta angle. 0150 0151 ORBBP = 90 - B 0152 0153 RETURN 0154 END ORBBP 1-Jun-1993 15:39:18 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:36:57 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.FOR;14 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 402 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 160 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 562 ENTRY POINTS Address Type Name 0-00000000 R*8 ORBBP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 AX ** R*8 AY ** R*8 AZ ** R*8 B ** R*8 COSB 2-00000008 R*8 COSV ** R*8 ECANOM 2-00000010 R*8 ESUN 2-00000018 R*8 IORB 2-00000020 R*8 ISUN 2-00000028 R*8 MSUN ** R*8 OORB 2-00000030 R*8 OSUN 2-00000038 R*8 SINV ** R*8 USUN ** R*8 VSUN 2-00000040 R*8 WSUN 2-00000048 R*8 WX 2-00000050 R*8 WY 2-00000058 R*8 WZ ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 ORBIT 48 (6) AP-00000008@ R*8 SUNORB 48 (6) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 MA2EA R*8 MTH$DACOS R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DSIN R*8 MTH$DSQRT COMMAND QUALIFIERS FOR/LIS ORBBP.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS ORBBP 1-Jun-1993 15:39:18 VAX FORTRAN V5.6-119 Page 5 01 21-Jan-1993 21:36:57 NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.FOR;14 /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]ORBBP.OBJ;2 COMPILATION STATISTICS Run Time: 0.43 seconds Elapsed Time: 3.21 seconds Page Faults: 315 Dynamic Memory: 504 pages 1-Jun-1993 15:39:30 VAX FORTRAN V5.6-119 Page 1 26-Feb-1993 19:43:41 NAVDEV:[SHAPIRO.COSMIC.SOURCE]POLY.FOR;2 0001 double precision FUNCTION POLY(x, c, n ) 0002 C 0003 C evaluates y = c(1) + c(2)*x + c(3)*x^2 + ... + c(n)*x^n-1 0004 0005 C 0006 double precision x, c(n), y 0007 0008 y = c(n-1) + c(n) * x 0009 do i = 1, n-2 0010 j = n-1-i 0011 y = c(j) + y*x 0012 end do 0013 0014 poly = y 0015 return 0016 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 101 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 149 ENTRY POINTS Address Type Name 0-00000000 R*8 POLY VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I ** I*4 J AP-0000000C@ I*4 N AP-00000004@ R*8 X ** R*8 Y ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 C ** (*) POLY 1-Jun-1993 15:39:30 VAX FORTRAN V5.6-119 Page 2 01 26-Feb-1993 19:43:41 NAVDEV:[SHAPIRO.COSMIC.SOURCE]POLY.FOR;2 COMMAND QUALIFIERS FOR/LIS POLY.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]POLY.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]POLY.OBJ;2 COMPILATION STATISTICS Run Time: 0.26 seconds Elapsed Time: 2.15 seconds Page Faults: 205 Dynamic Memory: 456 pages 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 1 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0001 C$Procedure PROP 0002 C 0003 SUBROUTINE PROP ( ORBIN , DATIN , 0004 & DT , jearth , 0005 & LTOP , LSFLAG , DRAG , 0006 & dsmadt , tsmaswitch, 0007 & sigma_dsma, HILO, 0008 & ORBOUT , BETAP ) 0009 C 0010 C 0011 C******************************************************************************* 0012 C 0013 C Copyright (C) 1993, California Institute of Technology. U.S. 0014 C Government Sponsorhip under NASA Contract NAS7-918 is 0015 C acknowledged. 0016 C 0017 C******************************************************************************* 0018 C 0019 C$ Log 0020 C 0021 C Date Name Description 0022 C ----------------------------------------------------------------------------- 0023 C 11-JUL-1990 Eric Cannell creation of PROP 0024 C 13-Sep-1991 Bruce Shapiro jearth as a parameter 0025 C Dec-1992 additional along track force as table look-up 0026 C into array of da/dt values 0027 C 0028 C$ Purpose 0029 C 0030 C PROP propagates an orbit using the LSRGP Library and adjusts the 0031 C semi-major axis to reflect atmospheric drag. 0032 C 0033 C$ Input_Arguments 0034 C 0035 C Name Type Dim Units Description 0036 C ----------------------------------------------------------------------------- 0037 C ORBIN DP 6 km,deg classical elements (a,e,i,LAN,w,M) 0038 C DATIN C*(*) 1 - epoch of ORBIN, TIMETRANS format 0039 C 'dd-mmm-yyyy hh:mm:ss.ffff' 0040 C DT DP 1 sec length of propagation time 0041 C jearth dp (2:29) - earth gravity field zonal coefficients 0042 C LTOP I 1 - LTOP passed to LSRGP 0043 C LSFLAG L 1 - if true, luni-solar effects are turned 0044 C on in LSRGP 0045 C DRAG L 1 - if true, atmoshperic drag is turned on 0046 C dsmadt r*8 1 meters/day extra da/dt 0047 C HILO C*4 1 - 'HI' - use high density 0048 C 'LO' - use low density 0049 C 'TRUE' - use "true" density 0050 C 0051 C$ Output_Arguments 0052 C 0053 C Name Type Dim Units Description 0054 C ----------------------------------------------------------------------------- 0055 C ORBOUT DP 6 km,deg classical elements (a,e,i,LAN,w,M) after 0056 C time DT 0057 C 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 2 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0058 C$ Restrictions 0059 C 0060 C 1] PROP is strictly for Earth orbiters only, since the LSRGP library 0061 C is used to propagate the orbit. 0062 C 0063 C 2] ORBIN must not have a inclination of zero. PROP does NOT check 0064 C for i=0, since execution time is a valuable commodity. 0065 C 0066 C$ Library_Links 0067 C 0068 C Entry Point Name Location 0069 C ----------------------------------------------------------------------------- 0070 C B2DRG TPXLIB 0071 C CRMGET GTARG 0072 C LSRGP LSRGP 0073 C LSRGPB LSRGP 0074 C ORBBP TPXORB 0075 C SUNORB TPXORB 0076 C 0077 double precision earth_rad ! in kilomters 0078 double precision WE ! radians / second 0079 double precision earth_rate ! meters / day 0080 double precision GMrth ! km**3/sec 0081 double precision mu_moon ! km**3/sec 0082 double precision mu_sun ! km**3/sec 0083 double precision sid_day ! seconds 0084 double precision deg_to_km ! kilometers/deg 0085 0086 common / physical_constants / 0087 & earth_rad, WE, earth_rate, GMrth, 0088 & mu_moon, mu_sun, sid_day, deg_to_km 0089 0090 0091 C$ Parameters 0092 C 0093 C DOUBLE PRECISION GMRTH 0094 C PARAMETER ( GMRTH = 398600.44807345D0 ) 0095 0096 logical trace, dsmatrace 0097 parameter ( trace = .false. ) 0098 parameter (dsmatrace = .false. ) 0099 0100 DOUBLE PRECISION PI 0101 PARAMETER ( PI = 3. 14159 26535 89793 23846 D0 ) 0102 0103 DOUBLE PRECISION D2R 0104 PARAMETER ( D2R = PI / 180D0 ) 0105 0106 C DOUBLE PRECISION SPD 0107 C PARAMETER ( SPD = 86400D0 ) 0108 0109 C DOUBLE PRECISION WE 0110 C PARAMETER ( WE = D2R * 360.9856473458400D0 / SPD ) 0111 C 0112 C$ Declarations_of_Input_and_Output_Arguments 0113 C 0114 CHARACTER*(*) DATIN PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 3 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0115 LOGICAL DRAG 0116 DOUBLE PRECISION dsmadt(2), dsmaswitch, DT, tnow 0117 double precision sigma_dsma(2) 0118 CHARACTER * 4 HILO 0119 double precision jearth ( 2:29 ) 0120 LOGICAL LSFLAG 0121 INTEGER LTOP 0122 DOUBLE PRECISION ORBIN ( 6 ) 0123 DOUBLE PRECISION ORBOUT ( 6 ) 0124 0125 common /boost/ ndsmadt_data, dsmadt_data, dsmadt_epoch, 0126 & dsmadt_data_sigma, plot_boost, 0127 & dsmadt_dates, xdsmadt_dates 0128 logical plot_boost 0129 double precision dsmadt_data(1000), xdsmadt_dates(1000) 0130 double precision dsmadt_data_sigma 0131 character*25 dsmadt_epoch, dsmadt_dates(1000) 0132 integer ndsmadt_data 0133 0134 c 0135 C 0136 C$ Declarations_of_Local_Variables 0137 C 0138 DOUBLE PRECISION AREA 0139 DOUBLE PRECISION BETAP 0140 DOUBLE PRECISION CI 0141 DOUBLE PRECISION CRM, crmhi, crmlo 0142 DOUBLE PRECISION DADT, dadt1, dadt2, dadtnow, xt1,xt2 0143 logical error 0144 DOUBLE PRECISION N 0145 DOUBLE PRECISION SUNSTT ( 6 ) 0146 DOUBLE PRECISION V2 0147 double precision error_sign 0148 double precision tdsma 0149 C 0150 C$ External_Statements 0151 C 0152 DOUBLE PRECISION VMAREA 0153 EXTERNAL VMAREA 0154 0155 DOUBLE PRECISION CH2SEC 0156 EXTERNAL CH2SEC 0157 0158 integer finddate 0159 external finddate 0160 0161 DOUBLE PRECISION ORBBP 0162 EXTERNAL ORBBP 0163 0164 CHARACTER*25 SEC2CH 0165 EXTERNAL SEC2CH 0166 C 0167 C$ Method 0168 C-& 0169 0170 C1 Propagate the orbit using LSRGP. This does not include drag effects. 0171 PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 4 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0172 if (trace) then 0173 write(50,*) 'PROP (before LSRGP) ORBIN,DATIN,dt:',orbin,datin,dt 0174 end if 0175 0176 CALL LSRGPj( ORBIN , DATIN , DT , JEARTH, LTOP , LSFLAG , ORBOUT ) 0177 0178 if (trace) then 0179 write(50,*) 'PROP (after LSRGP) ORBOUT:',orbout 0180 end if 0181 0182 0183 C1 If desired, modify the semi-major axis to reflect the effects of 0184 C1 atmospheric drag. 0185 0186 IF ( DRAG ) THEN 0187 0188 C2 Compute square of satellite velocity. 0189 0190 V2 = GMRTH / ORBOUT( 1 ) 0191 0192 C2 Use ORBBP to determine the beta-prime angle of the Sun. 0193 0194 CALL SUNORB( DATIN , SUNSTT ) 0195 0196 BETAP = ORBBP( ORBIN , SUNSTT ) 0197 0198 C2 Use B2DRG to determine the projected area of the TOPEX satellite 0199 C2 due to atmospheric drag in km**2. 0200 0201 C AREA = B2DRG( BETAP ) * 1.0D-6 0202 AREA = VMAREA( BETAP, 'DRAG' ) * 1.0D-6 0203 0204 C2 Compute cosine of inclination of satellite. 0205 0206 CI = DCOS( D2R * ORBIN( 3 ) ) 0207 0208 C2 Get the mean motion off of the LSRGP Bulletin Board. 0209 0210 C 0211 C need to test at some point for invalid HILO value 0212 C also: may want to keep three separate bulletin boards ??? 0213 C for now, just use one and hope things don't get confused 0214 C 0215 if (hilo .eq. 'TRUE') then 0216 CALL LSRGPB( 'GET' , 'LSRGP_N' , N ) 0217 else if (hilo .eq. 'HI') then 0218 CALL LSRGPB( 'GET' , 'LSRGP_N' , N ) 0219 else if (hilo .eq. 'LO') then 0220 CALL LSRGPB( 'GET' , 'LSRGP_N' , N ) 0221 else 0222 write(6,*) 'PROP: Unknown HILO = '//hilo 0223 stop 'ERROR EXIT' 0224 end if 0225 0226 C2 Determine the product of Cd * density / mass which is computed 0227 C2 at the time the PFLUX file is read. 0228 PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 5 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0229 CALL CRMGET( DATIN , CRM, crmhi, crmlo ) 0230 0231 C 0232 C use the 'TRUE' CRM unless otherwise requested 0233 C 0234 if (hilo .eq. 'HI') then 0235 CRM = CRMHI 0236 else if (hilo .eq. 'LO') then 0237 CRM = CRMLO 0238 end if 0239 0240 if (trace) then 0241 write (50,*) 'PROP CRM:',crm 0242 end if 0243 0244 C2 Compute da/dt in km/sec. 0245 0246 DADT = - CRM 0247 & * AREA 0248 & * V2 0249 & * ( 1D0 - WE * CI / N ) ** 2D0 0250 & / N 0251 0252 C2 Adjust semi-major axis. 0253 0254 ORBOUT( 1 ) = ORBOUT( 1 ) + DADT * DT 0255 0256 END IF 0257 C 0258 C 0259 C add extra (d/dt)sma 0260 C 0261 error_sign = 0.0d0 0262 if (hilo .eq. 'HI') then 0263 error_sign = -1.0d0 0264 else if (hilo .eq. 'LO') then 0265 error_sign = 1.0d0 0266 end if 0267 0268 tnow = ch2sec ( datin , .true., error) 0269 C 0270 C ***** 0271 C apply the selected boost model 0272 C 0273 0274 if (ndsmadt_data .gt. 0 ) then 0275 if (dsmadt_epoch .eq. ' ') then 0276 C 0277 C use DSMADT_DATES and use the most recent value 0278 C supplied for da/dt 0279 C 0280 idate = finddate ( datin, .false., dsmadt_dates, 0281 & xdsmadt_dates, ndsmadt_data ) 0282 C 0283 C interpolate 0284 C 0285 if ( (idate .gt. 0) .and. PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 6 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0286 & (idate .le. ndsmadt_data) ) then 0287 0288 xt1 = xdsmadt_dates(idate) 0289 xt2 = xdsmadt_dates(idate+1) 0290 dadt1 = dsmadt_data(idate) 0291 dadt2 = dsmadt_data(idate+1) 0292 dadtnow = dadt1 + (tnow-xt1)*(dadt2-dadt1)/(xt2-xt1) 0293 0294 C write(8,*) datin, ' ',dsmadt_dates(idate), ' ', 0295 C & dsmadt_dates(idate+1), ' ', 0296 C & dadt1, ' ',dadt2, ' ',dadtnow 0297 0298 orbout(1) = orbout(1) + 0299 & dadtnow * 0.001d0 * (dt/86400.0d0) 0300 else 0301 write (8,*) 'Current Epoch = ', datin, 0302 & ' is out of range = ', idate, 0303 & ' of data, range = 1 to ', ndsmadt_data 0304 end if 0305 C***** 0306 else 0307 C 0308 C use DSMADT_EPOCH and assume data are 0309 C equally spaced at one point per orbit 0310 C 0311 tdsma = ch2sec ( dsmadt_epoch, .true., error) 0312 itnow = int ( (tnow - tdsma)/86400.0d0 ) + 1 0313 if ( (itnow .ge. 1) .or. (itnow.le.ndsmadt_data)) then 0314 if (dsmatrace) 0315 * write(8,400) datin, itnow,dsmadt_data(itnow), 0316 * dsmadt_data_sigma 0317 400 format(1x, a, 1x,i10, f10.4,1x, f10.4) 0318 0319 orbout(1) = orbout(1) + 0320 & dsmadt_data(itnow) * 0.001d0 * (dt/86400.0d0) 0321 else 0322 write(8,*) 'Warning: tnow = ',datin, 0323 * ' is out of the range of dsmadt_data, i=',itnow 0324 end if 0325 end if 0326 else 0327 C 0328 C if this model is used, error model may be incorrect; should 0329 C use array of dsmadt_data instead of a pair of points 0330 C 0331 if ( tnow .le. tsmaswitch ) then 0332 if ( ( dsmadt(1) .ne. 0.0d0) .or. 0333 & (sigma_dsma(1) .ne. 0.0d0) ) then 0334 orbout(1) = orbout(1) + 0335 & ( dsmadt(1) + error_sign * sigma_dsma(1) ) 0336 & * 0.001d0 * (dt/86400.0d0) 0337 if ( dsmatrace) write(8,*) datin, ' ',dsmadt(1) 0338 end if 0339 else if ( (dsmadt(2) .ne. 0.0d0) .or. 0340 & (sigma_dsma(2) .ne. 0.0d0 ) ) then 0341 orbout(1) = orbout(1) + 0342 & ( dsmadt(2) + error_sign * sigma_dsma(2) ) PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 7 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 0343 & * 0.001d0 * (dt/86400.0d0) 0344 if (dsmatrace) write(8,*) datin, ' ',dsmadt(2) 0345 end if 0346 end if 0347 0348 C1 End of PROP. 0349 0350 RETURN 0351 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1044 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 264 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 576 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 PHYSICAL_CONSTANTS 64 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 BOOST 41041 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 42989 ENTRY POINTS Address Type Name 0-00000000 PROP VARIABLES Address Type Name Address Type Name ** R*8 AREA AP-00000034@ R*8 BETAP ** R*8 CI 2-00000038 R*8 CRM 2-00000040 R*8 CRMHI 2-00000048 R*8 CRMLO ** R*8 DADT ** R*8 DADT1 ** R*8 DADT2 ** R*8 DADTNOW AP-00000008@ CHAR DATIN 3-00000038 R*8 DEG_TO_KM AP-0000001C@ L*4 DRAG 4-00001F5D R*8 DSMADT_DATA_SIGMA 4-00001F44 CHAR DSMADT_EPOCH ** R*8 DSMASWITCH AP-0000000C@ R*8 DT 3-00000000 R*8 EARTH_RAD 3-00000010 R*8 EARTH_RATE 2-00000070 L*4 ERROR 2-00000068 R*8 ERROR_SIGN 3-00000018 R*8 GMRTH AP-0000002C@ CHAR HILO ** I*4 IDATE ** I*4 ITNOW AP-00000018@ L*4 LSFLAG AP-00000014@ I*4 LTOP 3-00000020 R*8 MU_MOON 3-00000028 R*8 MU_SUN 2-00000058 R*8 N 4-00000000 I*4 NDSMADT_DATA 4-00001F65 L*4 PLOT_BOOST 3-00000030 R*8 SID_DAY ** R*8 TDSMA 2-00000030 R*8 TNOW AP-00000024@ R*4 TSMASWITCH 2-00000060 R*8 V2 3-00000008 R*8 WE ** R*8 XT1 2-00000050 R*8 XT2 PROP 1-Jun-1993 15:39:35 VAX FORTRAN V5.6-119 Page 8 01 15-Feb-1993 19:48:16 NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.FOR;51 ARRAYS Address Type Name Bytes Dimensions AP-00000020@ R*8 DSMADT 16 (2) 4-00000004 R*8 DSMADT_DATA 8000 (1000) 4-00001F69 CHAR DSMADT_DATES 25000 (1000) AP-00000010@ R*8 JEARTH 224 (2:29) AP-00000004@ R*8 ORBIN 48 (6) AP-00000030@ R*8 ORBOUT 48 (6) AP-00000028@ R*8 SIGMA_DSMA 16 (2) 2-00000000 R*8 SUNSTT 48 (6) 4-00008111 R*8 XDSMADT_DATES 8000 (1000) LABELS Address Label 1-000000DB 400' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name R*8 CH2SEC CRMGET I*4 FINDDATE LSRGPB LSRGPJ R*8 MTH$DCOS R*8 ORBBP SUNORB R*8 VMAREA COMMAND QUALIFIERS FOR/LIS PROP.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]PROP.OBJ;2 COMPILATION STATISTICS Run Time: 0.90 seconds Elapsed Time: 6.02 seconds Page Faults: 341 Dynamic Memory: 572 pages 1-Jun-1993 15:39:45 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:40:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]RNG360.FOR;3 0001 C$Procedure RNG360 0002 C 0003 DOUBLE PRECISION FUNCTION RNG360 ( DEGS ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C RNG360 takes a value in degrees and transforms it so that it lies 0017 C in the range of [0..360). 0018 C 0019 C$ Input_Arguments 0020 C 0021 C DEGS - a value in degrees that can be positive or negative, greater 0022 C than 360 or less than -360. 0023 C 0024 C$ Output_Arguments 0025 C 0026 C RNG360 - function return value that results when DEGS is restricted 0027 C to [0..360). 0028 C 0029 C$ Log 0030 C 0031 C 27-Mar-1989 - Eric Cannell - creation 0032 C 0033 C$ Declarations_of_Input_and_Output_Arguments 0034 C 0035 DOUBLE PRECISION DEGS 0036 C 0037 C$ Declarations_of_Local_Variables 0038 C 0039 DOUBLE PRECISION DEG360 0040 C 0041 C$ Method 0042 C-& 0043 0044 C1 Remove multiples of 360 degrees. 0045 0046 DEG360 = DMOD( DEGS , 360.0D0 ) 0047 0048 C1 Add 360 degrees if value is negative. 0049 0050 IF ( DEG360 .LT. 0.0D0 ) DEG360 = DEG360 + 360.0D0 0051 0052 C1 Function return. 0053 0054 RNG360 = DEG360 0055 0056 RETURN 0057 END RNG360 1-Jun-1993 15:39:45 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:40:10 NAVDEV:[SHAPIRO.COSMIC.SOURCE]RNG360.FOR;3 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 37 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 20 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 65 ENTRY POINTS Address Type Name 0-00000000 R*8 RNG360 VARIABLES Address Type Name Address Type Name ** R*8 DEG360 AP-00000004@ R*8 DEGS FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*8 MTH$DMOD COMMAND QUALIFIERS FOR/LIS RNG360.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]RNG360.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]RNG360.OBJ;2 COMPILATION STATISTICS Run Time: 0.24 seconds Elapsed Time: 2.49 seconds Page Faults: 256 Dynamic Memory: 456 pages 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 1 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 0001 C$Procedure screen_header 0002 C 0003 0004 subroutine screen_header ( testcase, 0005 & strat, target_strat, bounds, 0006 & bndfuz, timfuz, datin, orbin, dvquanta, lsflag, drag, 0007 & m, ltop, dvbracket, atargonly, days, biasmode, 0008 & sf_dvod, sf_drag, dvfixed, dvprop, delta_a, Cd, 0009 & dsmadt, sigma_dsma ) 0010 0011 C 0012 C******************************************************************************* 0013 C 0014 C Copyright (C) 1993, California Institute of Technology. U.S. 0015 C Government Sponsorhip under NASA Contract NAS7-918 is 0016 C acknowledged. 0017 C 0018 C******************************************************************************* 0019 C 0020 C 0021 C$ Log 0022 C 0023 C Date Name Description 0024 C ----------------------------------------------------------------------------- 0025 C 6-sep-1991 Bruce Shapiro Creation of screen_header 0026 C 0027 C$ Purpose 0028 C 0029 C Write a header block of information to the screen during GTARG 0030 C execution. Called by TGTGT. 0031 C 0032 C$ Input_Arguments 0033 C 0034 C Name Type Dim Units Description 0035 C ----------------------------------------------------------------------------- 0036 C 0037 C --- see declarations section, below 0038 C 0039 C$ Parameters 0040 C 0041 C 0042 C$ Declarations_of_Input_and_Output_Arguments 0043 C 0044 C 0045 character*12 terminal 0046 common /tt / terminal 0047 0048 logical atargonly 0049 character*80 testcase 0050 character*6 strat ! 'RUNOUT','LONG','EAST','WEST' 0051 character*8 target_strat ! 'UNBIASED','GTWEST','GTEAST' 0052 double precision bounds(2) ! -1km,+1km normally 0053 double precision bndfuz ! fuzzyness in km for LONG targeting 0054 double precision timfuz ! fuzzyness in days for time target 0055 character*25 datin ! date of epoch elements 0056 double precision orbin(6) ! initial orbital elements 0057 double precision dvquanta ! delta v quantization in mm/sec SCREEN_HEADER 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 2 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 0058 logical lsflag ! use lunar/solar true/false 0059 logical drag ! drag is on true/false 0060 integer m ! step size in orbits 0061 integer ltop ! size of G-field 0062 integer dvbracket(3) ! brackets on post-targeting runout 0063 integer days 0064 character*4 biasmode 0065 double precision sf_dvod, sf_drag 0066 double precision dvfixed, dvprop, delta_a, Cd 0067 double precision dsmadt(2), sigma_dsma(2) 0068 C 0069 common /boost/ ndsmadt_data 0070 integer ndsmadt_data 0071 0072 character*20 lnktim 0073 external lnktim 0074 0075 C$ Declarations_of_Local_Variables 0076 C 0077 C Name Type Dim Units Description 0078 C ----------------------------------------------------------------------------- 0079 C 0080 C NONE 0081 C 0082 C 0083 C EXTERNAL DEFINITIONS 0084 C 0085 external goto_string 0086 character*8 goto_string 0087 0088 C$ Namelists 0089 C 0090 C 0091 C$ Data_Statements 0092 C 0093 C 0094 C$ Method 0095 0096 C call clear_screen 0097 0098 0099 if (terminal .eq. 'VT100') then 0100 write(6,2000) goto_string(1,1),lnktim() 0101 else 0102 write(6,2001) lnktim() 0103 end if 0104 0105 2000 format(1x,a8,'GTARG Ground Track Targeting Program ', 0106 & /,1x, 0107 & 'Copyright (C) 1993, California Institute of Technology.', 0108 & /,1x, 0109 & 'U.S. Government Sponsorship under NASA Contract NAS7-918 is ', 0110 & 'acknowledged.', 0111 & /,1x,'GTARG Version 6.0 Created ',A20 ) 0112 2001 format(' GTARG Ground Track Targeting Program ', 0113 & /,1x, 0114 & 'Copyright (C) 1993, California Institute of Technology.', SCREEN_HEADER 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 3 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 0115 & /,1x, 0116 & 'U.S. Government Sponsorship under NASA Contract NAS7-918 is ', 0117 & 'acknowledged.'/, 0118 & /,1x,'GTARG Version 6.0 Created ', A20 ) 0119 0120 if (terminal .ne. 'VT100') return 0121 0122 if ( atargonly ) then 0123 write (6,89) goto_string(5,1), '1st Guess' 0124 else 0125 write (6,89) goto_string(5,1), strat 0126 end if 0127 0128 if ( (.not. atargonly) .and. ( strat .ne. 'RUNOUT') ) 0129 & write (6,91) goto_string(5,55), target_strat 0130 0131 write (6,95) goto_string(7,21), 'Iteration' 0132 write (6,96) goto_string(7,41),'dv' 0133 write (6,1075) goto_string (9,40), 'Band', 0134 & goto_string(9,45),Bounds(1), 0135 & goto_string(9,51),Bounds(2) 0136 write (6,107) goto_string (11,41), 'B Fuzz', 0137 & goto_string(11,48),Bndfuz 0138 write (6,107) goto_string (12,41), 'T Fuzz', goto_string(12,48), 0139 & Timfuz 0140 write (6,97) goto_string(6,1), datin 0141 if (testcase.ne.'?') 0142 & write(6,975) goto_string(6,27),Testcase(1:53) 0143 0144 write (6,101) goto_string(7,1),'a ', goto_string(7,10),orbin(1) 0145 write (6,105) goto_string(8,1),'e ', goto_string(8,10),orbin(2) 0146 write (6,101) goto_string(9,1),'i ', goto_string(9,10),orbin(3) 0147 write (6,101) goto_string(10,1),'Node ', 0148 & goto_string(10,10),orbin(4) 0149 write (6,101) goto_string(11,1),'Perigee ', 0150 & goto_string(11,10),orbin(5) 0151 write (6,101) goto_string(12,1),'M ', goto_string(12,10),orbin(6) 0152 write (6,1072) goto_String(8,41),'Quanta', 0153 & goto_string(8,48), dvquanta 0154 write (6,102) goto_string(8,21), 'Lunar/Solar', 0155 & goto_string(8,34), lsflag 0156 write (6,1025) goto_string(9,27), 'Drag', 0157 & goto_string(9,32), drag, 0158 & goto_string(9,34), Cd 0159 write (6,103) goto_string(10,21), 'Step Size', 0160 & goto_string(10,34), m 0161 write (6,103) goto_string(11,21), 'Grav Fld Size', 0162 & goto_string(11,34),ltop 0163 write (6,103) goto_string(12,21),'Runout Days', 0164 & goto_string(12,34), days 0165 write (6,104) goto_string(13,1) 0166 write (6,108) goto_string(10,41), 'Bracket', dvbracket 0167 write (6,109) goto_string(7,57), 'Bias mode', 0168 & goto_string(7,67),biasmode 0169 0170 if (ndsmadt_data .gt. 0) then 0171 write (6,1105) goto_string(8,57), 'd(sma)/dt', SCREEN_HEADER 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 4 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 0172 & goto_string(8,67), 'Input Array' 0173 else 0174 write (6,110) goto_string(8,57), 'd(sma)/dt', 0175 & goto_string(8,67), dsmadt(1), dsmadt(2) 0176 write (6,110) goto_string(9,57), 'Sigma da/dt', 0177 & goto_string(9,67), sigma_dsma(1), sigma_dsma(2) 0178 end if 0179 0180 write (6,110) goto_string(10,57), 'Scale Fact', 0181 & goto_string(10,67),sf_dvod,sf_drag 0182 write (6,110) goto_string(11,57), 'Sigma dv', 0183 & goto_string(11,67),dvfixed,dvprop 0184 write (6,111) goto_string(12,57), 'Sigma a', 0185 & goto_string(12,67),delta_a 0186 0187 89 format (1x,a8,26('-'),' GTARG ',a9,' Parameters ',26('-')) 0188 0189 91 format (1x,a8,' ',a8,' ') 0190 94 format (1x,a8,i4) 0191 95 format (1x,a8,a13) 0192 96 format (1x,a8,a2) 0193 97 format (1x,a8,a24) 0194 975 format (1x,a8,a53) 0195 101 format(' ',A8,A9,A8,F10.5) 0196 102 format(' ',A8,A13,A8,L4) 0197 1025 format(' ',A8,A4,A8,L1,A8,F4.1) 0198 103 format(' ',A8,a13,a8,i4) 0199 104 format(' ',A8,30('-'),1x,'Current Iteration',1x,30('-')) 0200 105 format(' ',A8,A9,A8,F10.6) 0201 107 format(' ',a8,a6,a8,f7.4) 0202 1072 format(' ',a8,a6,a8,f7.5) 0203 1075 format(' ',a8,a4,a8,f4.1,a8,f4.1) 0204 108 format(' ',a8,a7,1x,3i2) 0205 109 format(' ',a8,a10,a8,2x, a4) 0206 110 format(' ',a8,a10,a8,f6.3,1x,f6.3) 0207 1105 format(' ',a8,a10,a8,a13) 0208 111 format(' ',a8,a10,a8,f6.3) 0209 return 0210 end SCREEN_HEADER 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 5 01 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 3604 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 1029 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 2212 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 BOOST 4 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 6861 ENTRY POINTS Address Type Name 0-00000000 SCREEN_HEADER VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000003C@ L*4 ATARGONLY AP-00000044@ CHAR BIASMODE AP-00000014@ R*8 BNDFUZ AP-0000005C@ R*8 CD AP-0000001C@ CHAR DATIN AP-00000040@ I*4 DAYS AP-00000058@ R*8 DELTA_A AP-0000002C@ L*4 DRAG AP-00000050@ R*8 DVFIXED AP-00000054@ R*8 DVPROP AP-00000024@ R*8 DVQUANTA AP-00000028@ L*4 LSFLAG AP-00000034@ I*4 LTOP AP-00000030@ I*4 M 4-00000000 I*4 NDSMADT_DATA AP-0000004C@ R*8 SF_DRAG AP-00000048@ R*8 SF_DVOD AP-00000008@ CHAR STRAT AP-0000000C@ CHAR TARGET_STRAT 3-00000000 CHAR TERMINAL AP-00000004@ CHAR TESTCASE AP-00000018@ R*8 TIMFUZ ARRAYS Address Type Name Bytes Dimensions AP-00000010@ R*8 BOUNDS 16 (2) AP-00000060@ R*8 DSMADT 16 (2) AP-00000038@ I*4 DVBRACKET 12 (3) AP-00000020@ R*8 ORBIN 48 (6) AP-00000064@ R*8 SIGMA_DSMA 16 (2) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-000002C0 89' 1-000002EE 91' ** 94' 1-000002FB 95' 1-00000302 96' 1-00000309 97' 1-00000317 101' 1-00000324 102' 1-00000341 103' 1-0000034D 104' 1-0000037A 105' 1-00000387 107' 1-000003B3 108' 1-000003C1 109' 1-000003CF 110' 1-000003ED 111' 1-00000310 975' 1-00000330 1025' 1-00000394 1072' 1-000003A1 1075' 1-000003E1 1105' 1-00000110 2000' 1-000001E9 2001' SCREEN_HEADER 1-Jun-1993 15:39:52 VAX FORTRAN V5.6-119 Page 6 01 10-May-1993 16:19:28 [SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.FOR;44 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name CHAR GOTO_STRING CHAR LNKTIM COMMAND QUALIFIERS FOR/LIS SCREEN_HEADER.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SCREEN_HEADER.OBJ;2 COMPILATION STATISTICS Run Time: 0.97 seconds Elapsed Time: 4.43 seconds Page Faults: 381 Dynamic Memory: 616 pages 1-Jun-1993 15:40:00 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:41:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SETCPU.FOR;9 0001 C$Procedure SETCPU 0002 C 0003 REAL FUNCTION SETCPU 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Purpose 0015 C 0016 C ** MACHINE DEPENDENT ** 0017 C 0018 C SETCPU initializes the VMS system CPU counter and then returns the 0019 C elapsed CPU time since the initialization in seconds. 0020 C 0021 C Obviously, this value will be very small. 0022 C 0023 C$ Output_Arguments 0024 C 0025 C SETCPU - seconds of elapsed CPU since counter initialization. 0026 C Obviously, a small number. 0027 C 0028 C$ Log 0029 C 0030 C 01-Aug-1988 0031 C Eric Cannell - birth 0032 C 0033 C$ References 0034 C 0035 C 1- VAX/VMS System Routines - Run-time Library Routines, Volume 5B. 0036 C 0037 C$ Restrictions 0038 C 0039 C 1- SETCPU must be called prior to using GETCPU. 0040 C 0041 C For example: 0042 C 0043 C REAL GETCPU 0044 C EXTERNAL GETCPU 0045 C 0046 C REAL SETCPU 0047 C EXTERNAL SETCPU 0048 C 0049 C CPU0 = SETCPU() ! time since initialization 0050 C . 0051 C 0052 C . 0053 C CPU1 = GETCPU() 0054 C SINC01 = CPU1 - CPU0 ! time since CPU0 0055 C . 0056 C 0057 C . 1-Jun-1993 15:40:00 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:41:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SETCPU.FOR;9 0058 C CPU2 = GETCPU() 0059 C SINC12 = CPU2 - CPU1 ! time since CPU1 0060 C . 0061 C 0062 C . 0063 C CPU3 = GETCPU() 0064 C SINC03 = CPU3 - CPU0 ! time since CPU0 0065 C 0066 C 2- Of course, SETCPU itself takes a minor amount of CPU after the 0067 C system calls... 0068 C 0069 C$ Declarations_of_Local_Variables 0070 C 0071 INTEGER CPU10M 0072 C 0073 C$ Method 0074 C-& 0075 0076 C1 Use system run-time routine LIB$INIT_TIMER to initialize timer. 0077 0078 CALL LIB$INIT_TIMER() 0079 0080 C1 Use system run-time routine LIB$STAT_TIMER to get elapsed CPU 0081 C1 time. 0082 0083 CALL LIB$STAT_TIMER( 2 , CPU10M , ) 0084 0085 C1 Convert ten's of milliseconds of system time to seconds and 0086 C1 return. 0087 0088 SETCPU = FLOAT( CPU10M ) / 100.0 0089 0090 RETURN 0091 END SETCPU 1-Jun-1993 15:40:00 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:41:37 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SETCPU.FOR;9 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 36 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 32 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 72 ENTRY POINTS Address Type Name 0-00000000 R*4 SETCPU VARIABLES Address Type Name 2-00000004 I*4 CPU10M FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name LIB$INIT_TIMER LIB$STAT_TIMER COMMAND QUALIFIERS FOR/LIS SETCPU.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SETCPU.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SETCPU.OBJ;2 COMPILATION STATISTICS Run Time: 0.25 seconds Elapsed Time: 3.04 seconds Page Faults: 189 Dynamic Memory: 456 pages 1-Jun-1993 15:40:07 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:42:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SHIFT4.FOR;2 0001 subroutine shift4( X, SHIFT ,N) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C adds a constant SHFIT to first N elements of array X 0012 C 0013 real*4 X(N), SHIFT 0014 do i=1,N 0015 X(i) = X(I) + SHIFT 0016 end do 0017 return 0018 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 61 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 44 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 105 ENTRY POINTS Address Type Name 0-00000000 SHIFT4 VARIABLES Address Type Name Address Type Name Address Type Name ** I*4 I AP-0000000C@ I*4 N AP-00000008@ R*4 SHIFT ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*4 X ** (*) SHIFT4 1-Jun-1993 15:40:07 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:42:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SHIFT4.FOR;2 COMMAND QUALIFIERS FOR/LIS SHIFT4.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SHIFT4.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SHIFT4.OBJ;2 COMPILATION STATISTICS Run Time: 0.22 seconds Elapsed Time: 1.75 seconds Page Faults: 257 Dynamic Memory: 456 pages 1-Jun-1993 15:40:11 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:44:17 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SIDANG.FOR;4 0001 DOUBLE PRECISION FUNCTION SIDANG(DATE, LONG) 0002 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C Take from OSMEAN (Courtesy of Joe Guinn) 0013 C 0014 C...Inputs: 0015 C DATE = UT1 CHARACTER DATE (DD-MMM-YYYY HH:MM:SS.FFFF) 0016 C LONG = EAST LONGITUDE (DEGREES) 0017 CHARACTER*25 DATE 0018 DOUBLE PRECISION LONG 0019 0020 C...Output: 0021 C SIDANG = SIDEREAL ANGLE (DEGREES) 0022 0023 C...LOCAL VARIABLES: 0024 LOGICAL MSG,ERROR 0025 DOUBLE PRECISION CH2JD,JDUT1,TU,DP2000,UT1,GMST 0026 DOUBLE PRECISION JD2000,DPJC,ARC2DG 0027 0028 PARAMETER (JD2000 = 2451545D0) 0029 PARAMETER (DPJC = 36525D0) 0030 PARAMETER (ARC2DG = 15D0/3600D0) 0031 0032 C=============================================================================== 0033 0034 C...Convert input DATE to Julian date. 0035 JDUT1 = CH2JD(DATE,MSG,ERROR) 0036 0037 C...Compute Julian centuries of 36525 days of universal time. 0038 DP2000 = JDUT1-JD2000 0039 TU = DP2000/DPJC 0040 UT1 = MOD(DP2000+0.5D0,1D0)*86400D0 0041 0042 GMST = (24110.54841D0 + 8640184.812866D0*TU + 0.093104D0*TU*TU 0043 * - 6.2D-6*TU*TU*TU + UT1) * ARC2DG 0044 0045 GMST = MOD(GMST,360D0) 0046 IF(GMST.LT.0) GMST = 360D0 + GMST 0047 SIDANG = MOD(GMST+LONG,360D0) 0048 0049 RETURN 0050 END SIDANG 1-Jun-1993 15:40:11 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:44:17 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SIDANG.FOR;4 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 198 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 16 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 298 ENTRY POINTS Address Type Name 0-00000000 R*8 SIDANG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR DATE ** R*8 DP2000 2-00000014 L*4 ERROR 2-00000008 R*8 GMST ** R*8 JDUT1 AP-00000008@ R*8 LONG 2-00000010 L*4 MSG ** R*8 TU ** R*8 UT1 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 CH2JD R*8 MTH$DMOD COMMAND QUALIFIERS FOR/LIS SIDANG.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SIDANG.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SIDANG.OBJ;2 SIDANG 1-Jun-1993 15:40:11 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:44:17 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SIDANG.FOR;4 COMPILATION STATISTICS Run Time: 0.24 seconds Elapsed Time: 1.99 seconds Page Faults: 219 Dynamic Memory: 472 pages 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 1 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 0001 C$Procedure SUMMRY 0002 C 0003 SUBROUTINE SUMMRY ( STRAT , 0004 & ORBIN , DATIN , rev, 0005 & DV , dvlcr, PITCH, YAW, ORBWRK , 0006 & LIMITS , 0007 & ORBEND , DATEND , 0008 & tmaneuver, betap, norbits 0009 & ) 0010 C 0011 C******************************************************************************* 0012 C 0013 C Copyright (C) 1993, California Institute of Technology. U.S. 0014 C Government Sponsorhip under NASA Contract NAS7-918 is 0015 C acknowledged. 0016 C 0017 C******************************************************************************* 0018 C 0019 C 0020 C$ Log 0021 C 0022 C Date Name Description 0023 C ----------------------------------------------------------------------------- 0024 C 26-JUL-1990 Eric Cannell creation of SUMMRY 0025 C 23-SEP-1991 Bruce Shapiro change format slightly to fit in < 80 columns 0026 C 20-APR-1992 Bruce Shapiro output change in elements 0027 C 0028 C$ Purpose 0029 C 0030 C SUMMRY prints an executive's summary of the final targeted ground track 0031 C on the last page of the output file. 0032 C 0033 C I explain the input STRAT as follows: 0034 C 0035 C STRAT = 'RUNOUT' --> no targeting required. SUMMRY simply execute the 0036 C given dV and runout the ground track for 0037 C DAYS days 0038 C STRAT = 'LONG' --> longitudinal targeting to the west boundary. 0039 C SUMMRY figures out the dV that will place the 0040 C furthest westward point of the ground track 0041 C tangent to the west boundary. 0042 C STRAT = 'EAST' --> time targeting to the east boundary. SUMMRY 0043 C figures out the dV that will cause the ground 0044 C track to cross the east boundary in TIMTGT days. 0045 C STRAT = 'WEST' --> time targeting to the west boundary. SUMMRY 0046 C figures out the dV that will cause the ground 0047 C track to cross the west boundary in TIMTGT days. 0048 C 0049 C$ Input_Arguments 0050 C 0051 C Name Type Dim Units Description 0052 C ----------------------------------------------------------------------------- 0053 C STRAT C*6 1 - see Purpose 0054 C ORBIN DP 6 km,deg initial orbit of (a,e,i,LAN,w,M) 0055 C (at DATIN) 0056 C DATIN C*25 1 --> input epoch of ORBIT in TIMETRANS format 0057 C 'dd-mmm-yyyy hh:mm:ss.fff 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 2 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 0058 C REV i 1 input rev # 0059 C DV DP 1 mm/sec targeted dV 0060 C DVLCR DP 3 km/sec long-track,x-track,radial component of dv 0061 C ORBWRK DP 6 km,deg post-maneuver orbit of (a,e,i,LAN,w,M) 0062 C LIMITS DP 4,2 days,km with regard to ascending nodes, the 0063 C time (in days) and ground track offset 0064 C (in km) of the first node, the furthest 0065 C west node, the furthest east node, and 0066 C the last node of the ground track. LIMITS 0067 C allows GTARG to classify the ground track. 0068 C time offset 0069 C |------|--------| 0070 C first node | days | km | 0071 C furthest west node | days | km | 0072 C furthest east node | days | km | 0073 C final node | days | km | 0074 C |------|--------| 0075 C ORBEND DP 6 km,deg final orbit 0076 C DATEND C*25 1 - epoch of ORBEND 0077 C tmaneuver dp 3 days maneuver interval for long targeting 0078 C 1-west, 2-unbiased, 3-east 0079 C norbits i 3 orbits until next maneuver 0080 C 0081 C$ Declarations_of_Input_and_Output_Arguments 0082 C 0083 double precision betap 0084 CHARACTER*25 DATEND 0085 CHARACTER*25 DATIN 0086 DOUBLE PRECISION DV, dvlcr(3), pitch, yaw 0087 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0088 integer norbits ( 3 ) 0089 DOUBLE PRECISION ORBEND ( 6 ) 0090 DOUBLE PRECISION ORBIN ( 6 ) 0091 DOUBLE PRECISION ORBWRK ( 6 ) 0092 integer rev 0093 CHARACTER*6 STRAT 0094 double precision tmaneuver ( 3 ) 0095 C 0096 C$ Declarations_of_Local_Variables 0097 C 0098 INTEGER I 0099 character*36 monthnames,AMON*3 0100 data monthnames/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ 0101 integer burndoy, day, month, year, dnext(3) 0102 double precision jdnext(3), jdnow,ch2jd 0103 external ch2jd, sec2ch 0104 character*25 ajdnext(3), sec2ch 0105 logical error 0106 data ajdnext/3*' '/ 0107 0108 double precision cal2jd 0109 external cal2jd 0110 0111 C 0112 C$ Method 0113 C-& 0114 SUMMRY 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 3 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 0115 C1 Print GTARG Executive Summary. 0116 0117 WRITE(8,301) 0118 301 FORMAT( 0119 & /,1X,77('-'), 0120 & /,1X,'|', 24(' '),' GTARG Executive Summary ', 0121 & 24(' '),'|' 0122 & /,1X,'|',T78,'|') 0123 0124 C1 Print strategy. 0125 0126 IF ( STRAT .EQ. 'RUNOUT' ) THEN 0127 WRITE(8,302) 0128 302 FORMAT(1X,'| Strategy : ', 0129 & 'Non-Targeted Runout of Ground Track',T78,'|') 0130 ELSE IF ( STRAT .EQ. 'LONG' ) THEN 0131 WRITE(8,303) 0132 303 FORMAT(1X,'| Strategy : ', 0133 & 'Longitudinal Targeting to West Boundary',T78,'|') 0134 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 0135 WRITE(8,304) 0136 304 FORMAT(1X,'| Strategy : ', 0137 & 'Time Targeting to East Boundary',T78,'|') 0138 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 0139 WRITE(8,305) 0140 305 FORMAT(1X,'| Strategy : ', 0141 & 'Time Targeting to West Boundary',T78,'|') 0142 END IF 0143 0144 C1 Print maneuver epoch, magnitude, change to semi-major axis, 0145 C1 and final epoch. 0146 0147 0148 if (index(DATIN,'-').eq.2) datin=' '//datin 0149 read( datin,'(i2,1x,A3,1x,I4)') day,amon,year 0150 month=1+index(monthnames,amon)/3 0151 0152 C burndoy=dayoyr(year,month,day) 0153 0154 burndoy = NINT ( cal2jd (year, month, day, 0, 0, 0, 0.0d0 ) - 0155 & cal2jd (year, 1, 0, 0, 0, 0, 0.0d0 ) ) 0156 0157 WRITE(8,306) DATIN(1:11),burndoy,datin(13:25), 0158 & rev, DV , (1.0D6*DVLCR(i),i=1,3), 0159 & PITCH, YAW, betap, DATEND 0160 0161 306 FORMAT(1X,'|',T78,'|', 0162 & /,1X,'| Maneuver Epoch : ',A11,'/',I3.3,1x,a13,T78,'|', 0163 & /,1X,'|',T78,'|', 0164 & /,1X,'| Rev Number : ',I10,T78,'|', 0165 & /,1X,'|',T78,'|', 0166 & /,1X,'| Maneuver Delta-V',T78,'|', 0167 & /,1x,'| Total Magnitude : ',F10.5,' mm/sec',T78,'|', 0168 & /,1x,'| Along-track : ',F10.5,' mm/sec',T78,'|', 0169 & /,1x,'| Cross-track : ',F10.5,' mm/sec',T78,'|', 0170 & /,1x,'| Radial : ',F10.5,' mm/sec',T78,'|', 0171 & /,1X,'|',T78,'|', SUMMRY 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 4 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 0172 & /,1x,'| Maneuver Direction',T78,'|', 0173 & /,1X,'| Pitch Angle : ',F10.2,' degrees',T78,'|', 0174 & /,1X,'| Yaw Angle : ',F10.2,' degrees',T78,'|', 0175 & /,1X,'|',T78,'|', 0176 & /,1x,'| Maneuver Beta Prime : ',F10.2,' degrees',T78,'|', 0177 & /,1X,'|',T78,'|', 0178 & /,1X,'| Final Epoch : ',A25,T78,'|', 0179 & /,1X,'|',T78,'|') 0180 0181 C1 Print maneuver period or ground track length. 0182 0183 IF ( STRAT .EQ. 'RUNOUT' ) THEN 0184 WRITE(8,307) LIMITS(4,1) 0185 307 FORMAT(1X,'| Ground Track Length : ',F10.5,' days',T78,'|', 0186 & /,1X,'|',T78,'|') 0187 if (Tmaneuver(1).le.1.0d-05 .or. 0188 & Tmaneuver(2).le.1.0d-05 .or. 0189 & Tmaneuver(3).le.1.0d-05 ) then 0190 write(8,3075) 0191 3075 format(1x,'| Note: Runout is too short to find ', 0192 & 'all parameters for maneuver interval',t78,'|', 0193 & /,1X,'|',T78,'|') 0194 end if 0195 end if 0196 jdnow = ch2jd ( datin, .false., error ) 0197 if (error) write(8,*) '?? Error parsing DATIN.' 0198 do i=1,3 0199 jdnext(i) = jdnow + tmaneuver(i) 0200 C ajdnext(i) = jd2ch ( jdnext(i) ) 0201 ajdnext(i) = sec2ch ( 0202 & ( jdnext(i) - 2451545.0d0 ) * 86400.0 d0 ) 0203 read( ajdnext(i) ,'(i2,1x,A3,1x,I4)') day,amon,year 0204 month=1+index(monthnames,amon)/3 0205 C dnext(i) = dayoyr(year,month,day) 0206 dnext(i) = 0207 & NINT ( cal2jd (year, month, day, 0, 0, 0, 0.0d0 ) - 0208 & cal2jd (year, 1, 0, 0, 0, 0, 0.0d0 ) ) 0209 0210 end do 0211 0212 WRITE(8,308) ( tmaneuver ( i ), 0213 & ajdnext(i)(1:11),'/',dnext(i), 0214 & ajdnext(i)(13:17), 0215 & rev + norbits(i), i = 1,3 ) 0216 308 FORMAT(1X,'| Window for next maneuver',T78,'|',/ 0217 & 1x,'| West bias : ',f10.2,' days ', 0218 & A11,a1,i3.3,1x,a5,' rev ',i5, T78,'|',/ 0219 & 1x,'| Unbiased : ',f10.2,' days ', 0220 & A11,a1,i3.3,1x,a5,' rev ',i5, T78,'|',/ 0221 & 1x,'| East bias : ',f10.2,' days ', 0222 & A11,a1,i3.3,1x,a5,' rev ',i5, T78,'|') 0223 0224 C1 Print pre- and post-maneuver elements and the final orbit. 0225 0226 WRITE(8,309) ( ORBIN(I) , ORBWRK(I) , 0227 & ORBWRK(I) - ORBIN(I), ORBEND(I) , I = 1 , 6 ) 0228 309 FORMAT( SUMMRY 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 5 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 0229 & 1X,'|',T78,'|', 0230 & /,1X,'| | pre-burn |', 0231 & ' post-burn | change | final |', 0232 & /,1X,'| parameters | elements |', 0233 & ' elements | in elements | elements |', 0234 & /,1X,'| -----------------------------|--------------|', 0235 & '--------------|--------------|', 0236 & /,1X,'| a, km ',2(' |',F13.6),' |',F13.9,' |',F13.6,' |', 0237 & /,1X,'| e ',4(' |',F13.9),' |', 0238 & /,1X,'| i, degrees ',2(' |',F13.6),' |',F13.9,' |',F13.6,' |', 0239 & /,1X,'| asc node, deg',2(' |',F13.6),' |',F13.9,' |',F13.6,' |', 0240 & /,1X,'| w, deg ',2(' |',F13.6),' |',F13.9,' |',F13.6,' |', 0241 & /,1X,'| M, deg ',2(' |',F13.6),' |',F13.9,' |',F13.6,' |', 0242 & /,1X,77('-')) 0243 0244 C1 End of SUMMRY. 0245 0246 RETURN 0247 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1202 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 1951 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 620 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 3773 ENTRY POINTS Address Type Name 0-00000000 SUMMRY VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000093 CHAR AMON AP-00000038@ R*8 BETAP ** I*4 BURNDOY AP-00000030@ CHAR DATEND AP-0000000C@ CHAR DATIN 2-000000A0 I*4 DAY AP-00000014@ R*8 DV 2-000000AC L*4 ERROR ** I*4 I 2-00000098 R*8 JDNOW 2-000000A4 I*4 MONTH 2-0000006F CHAR MONTHNAMES AP-0000001C@ R*8 PITCH AP-00000010@ I*4 REV AP-00000004@ CHAR STRAT AP-00000020@ R*8 YAW 2-000000A8 I*4 YEAR SUMMRY 1-Jun-1993 15:40:16 VAX FORTRAN V5.6-119 Page 6 01 6-Apr-1993 18:59:14 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.FOR;47 ARRAYS Address Type Name Bytes Dimensions 2-00000024 CHAR AJDNEXT 75 (3) 2-00000018 I*4 DNEXT 12 (3) AP-00000018@ R*8 DVLCR 24 (3) 2-00000000 R*8 JDNEXT 24 (3) AP-00000028@ R*8 LIMITS 64 (4, 2) AP-0000003C@ I*4 NORBITS 12 (3) AP-0000002C@ R*8 ORBEND 48 (6) AP-00000008@ R*8 ORBIN 48 (6) AP-00000024@ R*8 ORBWRK 48 (6) AP-00000034@ R*8 TMANEUVER 24 (3) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-0000002E 301' 1-0000007B 302' 1-000000C2 303' 1-0000010D 304' 1-00000150 305' 1-0000019E 306' 1-000003E0 307' 1-00000476 308' 1-0000055D 309' 1-00000417 3075' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name R*8 CAL2JD R*8 CH2JD I*4 LIB$INDEX CHAR SEC2CH COMMAND QUALIFIERS FOR/LIS SUMMRY.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUMMRY.OBJ;2 COMPILATION STATISTICS Run Time: 0.76 seconds Elapsed Time: 2.88 seconds Page Faults: 324 Dynamic Memory: 556 pages 1-Jun-1993 15:40:22 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:45:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.FOR;5 0001 C$Procedure SUNORB 0002 C 0003 SUBROUTINE SUNORB ( DATE , SUN ) 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C 0014 C$ Purpose 0015 C 0016 C SUNORB computes the mean orbital elements of the Sun in EME and equinox 0017 C of date coordinate system. 0018 C 0019 C$ Input_Arguments 0020 C 0021 C DATE - epoch at which to determine orbital elements of Sun 0022 C 0023 C$ Output_Arguments 0024 C 0025 C SUN - mean orbital elements of the Sun (a,e,i,LAN,w,M), km,deg 0026 C 0027 C$ Log 0028 C 0029 C 21-Mar-1989 - Eric Cannell - creation 0030 C 0031 C$ Library_Links 0032 C 0033 C TIMETRANS 0034 C 0035 C$ Parameters 0036 C 0037 CHARACTER*25 J1899 0038 PARAMETER ( J1899 = '31-DEC-1899 12:00:00.0000' ) 0039 C 0040 C$ Declarations_of_Input_and_Output_Arguments 0041 C 0042 CHARACTER*(*) DATE 0043 DOUBLE PRECISION SUN ( 6 ) 0044 C 0045 C$ Declarations_of_Local_Variables 0046 C 0047 DOUBLE PRECISION D 0048 DOUBLE PRECISION DF 0049 LOGICAL ERROR 0050 DOUBLE PRECISION JD1899 0051 DOUBLE PRECISION JDEPOC 0052 C 0053 C$ External_Statements 0054 C 0055 DOUBLE PRECISION CH2JD 0056 EXTERNAL CH2JD 0057 C SUNORB 1-Jun-1993 15:40:22 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:45:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.FOR;5 0058 C$ Method 0059 C-& 0060 0061 C1 Convert reference epoch and orbit epoch to Julian date. 0062 0063 JD1899 = CH2JD ( J1899 , .TRUE. , ERROR ) 0064 JDEPOC = CH2JD ( DATE , .TRUE. , ERROR ) 0065 0066 C1 Compute number of ephemeris days from reference epoch and fraction. 0067 0068 D = JDEPOC - JD1899 0069 DF = D / 10000.0D0 0070 0071 C1 Compute orbital elements of Sun (a, e, i, LAN , w, M). 0072 0073 SUN( 1 ) = 149 600 000.0D0 0074 SUN( 2 ) = 0.01675104D0 - 0.000011444D0*DF - 9.4D-9*DF**2 0075 SUN( 3 ) = 23.452294D0 - 3.5626D-3*DF - 1.23D-7*DF**2 + 0076 & 1.03D-8*DF**3 0077 SUN( 4 ) = 0.0D0 0078 SUN( 5 ) = 281.220844D0 + 4.70684D-5*D + 3.39D-5*DF**2 + 0079 & 7.D-8*DF**3 0080 SUN( 6 ) = 358.475833D0 + .9856002670D0*D - 1.12D-5*DF**2 - 0081 & 7.D-8*DF**3 0082 0083 SUN( 6 ) = DMOD( SUN( 6 ) , 360.0D0 ) 0084 0085 RETURN 0086 END SUNORB 1-Jun-1993 15:40:22 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:45:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.FOR;5 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 340 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 38 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 84 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 462 ENTRY POINTS Address Type Name 0-00000000 SUNORB VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 D AP-00000004@ CHAR DATE ** R*8 DF 2-00000000 L*4 ERROR ** R*8 JD1899 ** R*8 JDEPOC ARRAYS Address Type Name Bytes Dimensions AP-00000008@ R*8 SUN 48 (6) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 CH2JD R*8 MTH$DMOD COMMAND QUALIFIERS FOR/LIS SUNORB.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.OBJ;2 SUNORB 1-Jun-1993 15:40:22 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:45:20 NAVDEV:[SHAPIRO.COSMIC.SOURCE]SUNORB.FOR;5 COMPILATION STATISTICS Run Time: 0.31 seconds Elapsed Time: 2.16 seconds Page Faults: 243 Dynamic Memory: 472 pages 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 1 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0001 C$Procedure TGTGT 0002 C 0003 SUBROUTINE TGTGT ( TESTCASE, 0004 & STRAT , TARGET_STRAT , DAYS , 0005 & ORBIN , DATIN, REV, 0006 & DVIN, PITCH, YAW, DVQUANTA, 0007 & M , JEARTH , 0008 & LTOP , LSFLAG , DRAG , cd, dsmadt, 0009 & tsmaswitch, sigma_dsma, dragbiasmode, 0010 & BOUNDS , BNDFUZ , 0011 & TIMTGT , TIMFUZ , 0012 & ORBITS , XINGS , 0013 & WATCH , watchint , 0014 & DV_FIXED, DV_PROP, DA_OD, SF_DVOD, sf_drag, 0015 & sf_boost, 0016 & NDRAG_BIAS, DRAG_BIAS, dvbracket, 0017 & ATARGONLY, Page , 0018 & ORBEND , DATEND , PLOTDATE, WINDO, boot, 0019 & plot, plot_components, plotcycle 0020 & ) 0021 C 0022 C 0023 C******************************************************************************* 0024 C 0025 C Copyright (C) 1993, California Institute of Technology. U.S. 0026 C Government Sponsorhip under NASA Contract NAS7-918 is 0027 C acknowledged. 0028 C 0029 C******************************************************************************* 0030 C 0031 C$ Log 0032 C 0033 C Date Name Description 0034 C ----------------------------------------------------------------------------- 0035 C 30-JUL-1990 Eric Cannell creation of TGTGT 0036 C 31-JUL-1991 Bruce Shapiro allow CLASS=3 or 6 in first guess, i.e., 0037 C too small or to large first dv. 0038 C Add call to FIRSTGUESS (atarg) 0039 C Add Delta-v quantization 0040 C Add ground track biasing (east & west) 0041 C Add post-targ runouts 0042 C Add spreadsheet-like output table 0043 C 20-APR-1992 B.E.S. Replace DODV with DOMNVR from OAMS 0044 C 0045 C$ Purpose 0046 C 0047 C TGTGT determines the dV that properly targets the ground track in 0048 C accordance to the criteria established by the selected targeting 0049 C strategy. 0050 C 0051 C$ Input_Arguments 0052 C 0053 C Name Type Dim Units Description 0054 C ----------------------------------------------------------------------------- 0055 C STRAT C*6 1 - see Purpose 0056 C TARGET_STRAT C*8 1 - for STRAT other than RUNOUT: 0057 C 'UNBIASED' - target on UNBIASED TRACK 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 2 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0058 C 'WESTGT' - target on 95% west track 0059 C 'EASTGT' - target on 95% east track 0060 C DAYS I 1 days if DAYS>0, the ground track is run out 0061 C DAYS days, regardless of whether or not 0062 C the ground lies within or without the 0063 C valid band defined by BOUNDS. if DAYS=<0, 0064 C the ground track is run out until it 0065 C leaves the valid band as defined by input 0066 C BOUNDS. However, if a ground track lies 0067 C completely outside of the valid band, 0068 C TGTGT will terminate the track after 0069 C TOLONG days. 0070 C ORBIN DP 6 km,deg input orbit of (a,e,i,LAN,w,M) 0071 C DATIN C*25 1 --> input epoch of ORBIT in TIMETRANS format 0072 C 'dd-mmm-yyyy hh:mm:ss.fff 0073 C REV rev # of maneuver 0074 C DVIN DP 1 mm/sec initial guess of dV 0075 C DVQUANTA DP 1 mm/sec quantization of dv 0076 C if <= 0 then do not quantize 0077 C M I 1 - forces TGTGT to examine every M-th 0078 C ascending node. For example, one hopes 0079 C that M=4 is a lot faster computationally 0080 C and almost as accurate as M=1. 0081 C LTOP I 1 - the maximum L index to consider in LSRGP's 0082 C Earth gravity model (i.e., LTOP=17 means 0083 C model up to J17). 0084 C LSFLAG L 1 - if true, luni-solar effects are ON in the 0085 C LSRGP library 0086 C DRAG L 1 - if true, atmospheric drag effects are ON 0087 C in the PROP subroutine. Note that only 0088 C drag can affect semi-major axis. 0089 C Cd dp 0090 C dsmadt dp 2 m/day extra d/dt of SMA to include 0091 C tsmaswitch dp time, seconds, to switch dsmadt 0092 C dragbiasmode c*4 1 - 'FLUX' = use the flux sigmas 0093 C 'GT' = use the gtbiase sigmas 0094 C to determine the drag bias 0095 C BOUNDS DP 2 km the low and high boundaries (in that order) 0096 C of the valid ground track band as measured 0097 C from the reference ground track. Usually, 0098 C BOUNDS will be something like -/+ 1 km. 0099 C But, BOUNDS could be (.5,1.5), i.e., fully 0100 C right of the reference ground track. 0101 C BOUNDS is used only when DAYS=<0. 0102 C BNDFUZ DP 1 km when longitude targeting a ground track 0103 C to the west boundary, BNDFUZ is the 0104 C fuzziness of BOUNDS(1). In essence, if 0105 C ground is within BNDFUZ of BOUNDS(1), 0106 C then that is close enough. 0107 C TIMTGT DP 1 days if STRAT='EAST' or STRAT='WEST', then 0108 C TIMTGT is the desired target time to the 0109 C east or west boundary. 0110 C TIMFUZ DP 1 days if a ground track crosses the selected 0111 C boundary within TIMFUZ days of the desired 0112 C TIMTGT days, then that is close enough and 0113 C the ground track is considered properly 0114 C targeted 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 3 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0115 C ORBITS I 1 - number of equator crossings XINGS 0116 C XINGS DP ORBITS deg reference equator crossings from REF_EQXING 0117 C JEARTH DP (2:29) - earth zonals 0118 C WATCH L 1 monitor calculations, true/false 0119 C WATCHINT L 1 - if true, then GTARG also records the 0120 C intermediate ground tracks that are found 0121 C prior before the properly targeted one 0122 C DV_FIXED, DP 1 mm/sec Fixed error 0123 C DV_PROP, DP 1 - Proportional error, proportion of dv 0124 C DA_OD, DP 1 m od error in a 0125 C SF_DVOD, DP 1 - scale factor for gt bias (dv & od comps) 0126 C sf_drag dp 1 - scale factor for gt bias (drag comp) 0127 C sf_boost dp 1 - scale factor for boost 0128 C NDRAG_BIAS, I 1 - number of drag bias points 0129 C DRAG_BIAS, DP NDRAG_BIAS km bias in gt due to drag 0130 C dvbracket i 3 counts to bracket target with subsequent 0131 C runouts 0132 C ATARGONLY L 1 - if true, just calculate the first guess 0133 C and do nothing else 0134 C Page i 1 - page number to start with 0135 C PLOT 0136 C PLOT_COMPONENTS 0137 C PLOTCYCLE 0138 C 0139 C$ Output_Arguments 0140 C 0141 C Name Type Dim Units Description 0142 C ----------------------------------------------------------------------------- 0143 C ORBEND DP 6 km,deg final orbit 0144 C DATEND C*25 1 - epoch of ORBEND 0145 C 0146 C$ Namelist_Output 0147 C 0148 C Namelist: $ZLINE: defines curves, not plot frame 0149 C Name Type Dim Units Description 0150 C ----------------------------------------------------------------------------- 0151 C NPTS I 1 - number of (x,y) data points 0152 C STYLE I 1 - PGPLOT line style: 0153 C STYLE = 1 --> solid 0154 C style = 2 --> dashed 0155 C STYLE = 4 --> dotted 0156 C style = 5 --> ...-...- 0157 C X RL MXNODE - x-data in world coordinates 0158 C Y RL MXNODE - y-data in world coordinates 0159 C 0160 C$ Parameters 0161 C 0162 INTEGER MXNODE 0163 PARAMETER ( MXNODE = 20000 ) 0164 C 0165 C$ Declarations_of_Input_and_Output_Arguments 0166 C 0167 Logical atargonly, boot 0168 DOUBLE PRECISION BNDFUZ 0169 DOUBLE PRECISION BOUNDS ( 2 ), tplotdate 0170 CHARACTER*25 DATEND, PLOTDATE 0171 REAL*4 WINDO(4) TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 4 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0172 CHARACTER*25 DATIN 0173 INTEGER DAYS 0174 LOGICAL DRAG 0175 character*4 dragbiasmode 0176 double precision cd, dsmadt(2), tsmaswitch 0177 DOUBLE PRECISION DVIN, sigma_dsma(2) 0178 integer dvbracket ( 3 ) 0179 DOUBLE PRECISION DVQUANTA 0180 double precision jearth ( 2:29 ) 0181 LOGICAL LSFLAG 0182 INTEGER LTOP 0183 INTEGER M 0184 DOUBLE PRECISION ORBEND ( 6 ) 0185 DOUBLE PRECISION ORBIN ( 6 ) 0186 INTEGER ORBITS 0187 double precision pitch, yaw 0188 integer rev 0189 CHARACTER*6 STRAT 0190 CHARACTER*8 TARGET_STRAT, TESTCASE*80 0191 DOUBLE PRECISION TIMFUZ 0192 DOUBLE PRECISION TIMTGT 0193 logical plot, plot_components, plotcycle 0194 LOGICAL WATCH, WATCHINT 0195 DOUBLE PRECISION XINGS ( ORBITS ) 0196 DOUBLE PRECISION DV_FIXED 0197 DOUBLE PRECISION DV_PROP 0198 DOUBLE PRECISION DA_OD 0199 DOUBLE PRECISION SF_DVOD, sf_drag, sf_boost 0200 INTEGER NDRAG_BIAS 0201 DOUBLE PRECISION DRAG_BIAS ( NDRAG_BIAS ) 0202 0203 DOUBLE PRECISION GT_TABLE ( 6, MXNODE ) 0204 DOUBLE PRECISION DV_LABELS ( 6 ) 0205 C 0206 C via COMMON block tt 0207 C 0208 character*12 terminal 0209 common /tt/ terminal 0210 0211 0212 common /boost/ ndsmadt_data, dsmadt_data, dsmadt_epoch, 0213 & dsmadt_data_sigma, plot_boost, dsmadt_dates 0214 double precision dsmadt_data(1000) 0215 double precision dsmadt_data_sigma 0216 character*25 dsmadt_epoch, dsmadt_dates(1000) 0217 integer ndsmadt_data 0218 logical plot_boost 0219 real plot_datax(1000), plot_datay(1000) 0220 0221 C 0222 C Via $ZLINE. 0223 C 0224 INTEGER NPTS 0225 INTEGER STYLE 0226 REAL X ( MXNODE ) 0227 REAL Y ( MXNODE ) 0228 C TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 5 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0229 C$ Declarations_of_Local_Variables 0230 C 0231 C Name Type Dim Units Description 0232 C ----------------------------------------------------------------------------- 0233 C DVBND DP 2 mm/sec smallest range of dV's known to bound 0234 C the target dV: 0235 C DVBND(1) = largest dV < target dV 0236 C DVBND(2) = smallest dV > target dV 0237 C LIMITS DP 4,2 days,km with regard to ascending nodes, the 0238 C time (in days) and ground track offset 0239 C (in km) of the first node, the furthest 0240 C west node, the furthest east node, and 0241 C the last node of the ground track. LIMITS 0242 C allows GTARG to classify the ground track. 0243 C time offset 0244 C |------|--------| 0245 C first node | days | km | 0246 C furthest west node | days | km | 0247 C furthest east node | days | km | 0248 C final node | days | km | 0249 C |------|--------| 0250 C LIMITS_WEST DP 4,2 days, km see LIMITS; same, but for 95 percentile 0251 C LIMITS_EAST DP 4,2 westernmost track; LIMITS is for the 0252 C targeted ground track (error-free case) 0253 C 0254 DOUBLE PRECISION A0 0255 DOUBLE PRECISION ABSDDV 0256 character adate*9, atime*8 0257 DOUBLE PRECISION BETAP 0258 DOUBLE PRECISION DVBND ( 2 ) 0259 DOUBLE PRECISION DVNOW 0260 DOUBLE PRECISION DVOLD, dvvec(3), dvlcr(3) 0261 character*23 dvlabel 0262 INTEGER CLASS 0263 INTEGER CLSNOW 0264 INTEGER CLSOLD 0265 INTEGER GTID 0266 DOUBLE PRECISION LIMITS ( 4 , 2 ) 0267 DOUBLE PRECISION LIMITS_EAST ( 4, 2 ) 0268 DOUBLE PRECISION LIMITS_WEST ( 4, 2 ) 0269 integer norbits ( 3 ) 0270 DOUBLE PRECISION ORBWRK ( 6 ), opre(6), opost(6) 0271 integer page 0272 LOGICAL SUCCES 0273 DOUBLE PRECISION TARGET 0274 double precision tmaneuver ( 3 ) 0275 DOUBLE PRECISION VALNOW 0276 DOUBLE PRECISION VALOLD 0277 REAL XW (MXNODE), XE (MXNODE) 0278 DOUBLE PRECISION DPXW (MXNODE), DPXE (MXNODE) 0279 DOUBLE PRECISION DPX (MXNODE), DPY (MXNODE) 0280 C double precision evsw (MXNODE, 2) 0281 integer REFIDX (MXNODE) 0282 double precision ECL ( MXNODE ), x1, x2, y1, y2 0283 real xtmp(2), ytmp(2) 0284 real bias_ode(mxnode), bias_dve(mxnode) 0285 real bias_fluxe(mxnode), bias_booste(mxnode) TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 6 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0286 real bias_odw(mxnode), bias_dvw(mxnode) 0287 real bias_fluxw(mxnode), bias_boostw(mxnode) 0288 real plotdelta, boostdelta 0289 0290 0291 double precision t0, ti, ch2sec, drate 0292 external ch2sec, sec2ch 0293 logical error 0294 character*25 dati, sec2ch, dnode 0295 0296 0297 DOUBLE PRECISION DVA 0298 DOUBLE PRECISION DVB 0299 C 0300 C the following local variables are required because the quantization 0301 C algorithm may cause an iteration to repeat a delta-v calculation 0302 C which which was performed 2-iterations earlier. This will only happen 0303 C on the final (converging) iteration, and will require the entire 0304 C recalculation of all results for that iteration. Save the results 0305 C and check - and maybe the final iteration can be avoided. 0306 C 0307 double precision saved_orbend ( 6 ) 0308 double precision saved_orbwrk ( 6 ) 0309 character * 25 saved_datend 0310 double precision saved_limits ( 4, 2 ) 0311 double precision saved_limits_east ( 4, 2 ) 0312 double precision saved_limits_west ( 4, 2 ) 0313 integer saved_npts, saved_norbits(3) 0314 double precision saved_y ( mxnode), saved_x (mxnode) 0315 double precision saved_xw ( mxnode), saved_xe (mxnode) 0316 double precision saved_tmaneuver ( 3 ) 0317 C, saved_evsw(mxnode, 2) 0318 double precision saved_dvold, saved_dvvec(3), saved_dvlcr(3) 0319 double precision saved_ecl ( mxnode ) 0320 double precision bootdata(mxnode, 6), saved_bootdata(6, mxnode) 0321 integer saved_class, saved_refidx ( mxnode ) 0322 0323 C 0324 C external declarations 0325 C 0326 CHARACTER*8 goto_string 0327 external goto_string 0328 0329 C 0330 C$ Namelists 0331 C 0332 NAMELIST / ZLINE / NPTS , STYLE , X , Y 0333 C 0334 C$ Data_Statements 0335 C 0336 DATA DVBND / -1D10 , +1D10 / 0337 C 0338 C$ Method 0339 C-& 0340 0341 plotdelta = ( CH2SEC ( datin, .TRUE., ERROR ) - 0342 & CH2SEC ( plotdate, .TRUE., ERROR ) )/86400.0d0 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 7 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0343 0344 call clear_screen 0345 call screen_header ( TESTCASE, 0346 & strat, target_strat, bounds, 0347 & bndfuz, timfuz, datin, orbin, dvquanta, lsflag, 0348 & drag, m, ltop, dvbracket, atargonly, days, dragbiasmode, 0349 & sf_dvod, sf_drag, dv_fixed, dv_prop, da_od, cd, 0350 & dsmadt, sigma_dsma ) 0351 0352 C Initialize --- 7/31/91 mod 0353 0354 CLASS = 0 0355 GTID = 0 0356 0357 C ----- end mod 7/31/91 0358 0359 C1 Set the target value, whether it will be the west boundary or 0360 C1 some time target. 0361 0362 IF ( STRAT .EQ. 'LONG' ) THEN 0363 TARGET = BOUNDS(1) 0364 ELSE IF ( STRAT .EQ. 'EAST' ) THEN 0365 TARGET = TIMTGT 0366 ELSE IF ( STRAT .EQ. 'WEST' ) THEN 0367 TARGET = TIMTGT 0368 END IF 0369 0370 C Iterate until first guess at Delta V is appropriate --- 7/31/91 0371 0372 if ( ( (DVIN .eq. 0) .AND. (STRAT .NE. 'RUNOUT') ) .or. 0373 & ATARGONLY ) THEN 0374 0375 call firstguess ( STRAT, ORBIN, DATIN, TIMTGT, 0376 & BOUNDS, JEARTH, LTOP, LSFLAG, ORBITS, 0377 & XINGS, DVIN, betap ) 0378 0379 C write(8,*) 'TGTGT(post firstguess) BETAP=',BETAP 0380 0381 if (terminal .eq. 'VT100') 0382 & write (6,110) goto_string(7,45), dvin 0383 110 format (' ',A8,F10.5) 0384 0385 END IF 0386 0387 if ( atargonly .and. TERMINAL .eq. 'VT100') then 0388 write(6,115) goto_string(14,1) 0389 115 format(' ',A8) 0390 C & , 'First guess delta-v is ',F10.3,' mm/second.') 0391 stop 'First guess delta-v is shown. GTARG complete.' 0392 end if 0393 0394 200 CONTINUE 0395 0396 GTID = GTID + 1 0397 if (terminal .eq. 'VT100') 0398 & write (6,110) goto_string(7,45), dvin 0399 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 8 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0400 if (terminal .eq. 'VT100') 0401 & write ( 6, 94 ) goto_String(7,34), gtid 0402 94 format (1x,a8,i4) 0403 0404 if ((strat .ne. 'RUNOUT') .and. (dvquanta .gt. 0) ) then 0405 dvin = dvin - dmod ( dvin, dvquanta ) 0406 if (terminal .eq. 'VT100') 0407 & write (6,110) goto_string(7,45), dvin 0408 end if 0409 0410 DVB = DVA 0411 DVA = DVIN 0412 0413 if ( ( strat .ne. 'RUNOUT' ) .and. 0414 & ( dvquanta .gt. 0 ) .and. 0415 & ( dabs (dvb - dva) .lt. dvquanta ) )then 0416 write (6, *) goto_string(5,24), 0417 & 'ERROR: DVQUANTA = ', dvquanta, ' to big.' 0418 goto 902 0419 end if 0420 0421 C write (6, *) 'DVIN, DVA, DVB= ', dvin, dva, dvb 0422 0423 C --- end mod 7/31/91 0424 0425 C1 Copy the input orbit into work areas. 0426 0427 A0 = ORBIN(1) 0428 0429 CALL DVMOVE ( 6 , ORBIN , ORBWRK ) 0430 0431 C1 If this is simply a runout of the given dV, then compute the 0432 C1 ground track for DAYS days. Otherwise, set DAYS to zero for COMPGT. 0433 0434 IF ( STRAT .NE. 'RUNOUT' ) DAYS = 0 0435 0436 C1 Execute the initial dV guess provided by user, run out the ground 0437 C1 track, and then classify the ground track. This first runout is 0438 C1 computed regardless of what the strategy is. 0439 0440 C write(8,*) 'ORBIN=(PRE DOMNVR)',ORBIN 0441 0442 call DVMOVE ( 6, ORBIN, OPRE) 0443 c CALL DODV ( A0 , DVIN , ORBWRK ) 0444 0445 c write(8,*) 'ORBIN=(POST DODV)',ORBIN 0446 0447 call DOMNVR ( OPRE, 0.001*DVIN, PITCH, YAW, opost, dvvec, dvlcr) 0448 C write ( 8, 900 ) (OPRE(KK), ORBWRK(KK), OPOST(KK),KK=1,6) 0449 900 format(1x,'Pre',T20,'DODV',T40,'DOMNVR',/ 0450 & 6(1x,3F20.10,/)) 0451 0452 c write(8,*) 'ORBIN=(POST DOMNVR)',ORBIN 0453 0454 CALL DVMOVE(6, OPOST, ORBWRK) 0455 0456 c write(8,*) 'ORBIN=(PRE COMPGT)',ORBIN TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 9 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0457 C write(8,*) 'TGTGT:OPOST=',OPOST 0458 C write(8,*) 'TGTGT:ORBWRK=',ORBWRK 0459 CALL COMPGT ( ORBWRK , DATIN , 0460 & M , JEARTH, 0461 & LTOP , LSFLAG , DRAG, 0462 & dsmadt, tsmaswitch, sigma_dsma, dragbiasmode, 0463 & DAYS , BOUNDS , 0464 & ORBITS , XINGS , WATCH, 0465 & DV_FIXED, DV_PROP, DA_OD, 0466 & SF_DVOD, sf_drag, sf_boost, 0467 & NDRAG_BIAS, DRAG_BIAS, DVIN, target_strat, 0468 & bias_ode, bias_dve, bias_fluxe, bias_booste, 0469 & bias_odw, bias_dvw, bias_fluxw, bias_boostw, 0470 & ORBEND , DATEND , 0471 & LIMITS , LIMITS_WEST, LIMITS_EAST, 0472 & NPTS , DPY, DPX , DPXW , DPXE, tmaneuver, betap, 0473 & norbits, ecl, refidx, bootdata, PAGE ) 0474 CALL COPY84(DPX,X,NPTS) 0475 CALL COPY84(DPY,Y,NPTS) 0476 call shift4(Y, PLOTDELTA, NPTS) 0477 CALL COPY84(DPXE,XE,NPTS) 0478 CALL COPY84(DPXW,XW,NPTS) 0479 0480 C write(8,*) 'TGTGT:after COMPGT BETAP=',betap 0481 0482 CLSOLD = CLASS 0483 0484 c write(8,*) 'ORBIN=(PRE FIND_CLASS)',ORBIN 0485 call find_class ( target_strat, limits, 0486 & limits_west, limits_east, bounds, class ) 0487 0488 C1 If the use simply wants to runout a ground track, then skip to end 0489 C1 of TGTGT and record the ground track. 0490 0491 IF ( STRAT .EQ. 'RUNOUT' ) then 0492 c write(8,*) 'ORBIN=(IF RUNOUT)',ORBIN 0493 dvnow = dvin 0494 GO TO 902 0495 end if 0496 0497 C1 Check if the initial dV guess was sufficiently good. The first ground 0498 C1 should not be a class 3 or 6. 0499 0500 0501 IF ( CLASS .EQ. 3 .OR. CLASS .EQ. 6 ) THEN 0502 WRITE(8,302) DVIN, CLASS 0503 302 FORMAT(/,1X,'GTARG: DVIN(',D24.12,') CLASS ',I2,' FAILURE.') 0504 IF ( CLASS .EQ. 3 ) THEN 0505 write (8,*) 'CLASS = 3: GT always East of East Bounds' 0506 ELSE if (class .eq. 6) then 0507 write (8,*) 'CLASS = 6: GT always West of West Bounds' 0508 end if 0509 END IF 0510 0511 C1 Check if the user got lucky and provided an initial dV guess that 0512 C1 solved the problem. 0513 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 10 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0514 call check_success ( STRAT , TARGET_STRAT, 0515 & CLASS , LIMITS, LIMITS_WEST, LIMITS_EAST , 0516 & BNDFUZ , TIMFUZ , TARGET , 0517 & SUCCES ) 0518 0519 C1 Record data regarding this ground track. 0520 0521 0522 call display_limits ( 18, 1, limits, 0523 & limits_west, limits_east, .true. ) 0524 0525 C2 Print record to OFILE. 0526 0527 IF ( WATCHINT ) THEN 0528 0529 IF ( MOD(GTID,3).EQ.1) THEN 0530 CALL NEWPAGE(PAGE,2) 0531 END IF 0532 0533 0534 WRITE(8,304) GTID , SUCCES , CLASS , DVIN 0535 0536 call write_limits ( 8, LIMITS, LIMITS_WEST, LIMITS_EAST) 0537 0538 C WRITE(8,305) ' Nominal Track ', LIMITS 0539 C WRITE(8,305) '95 Percentile West', LIMITS_WEST 0540 C WRITE(8,305) '95 Percentile East', LIMITS_EAST 0541 0542 C2 Write $ZLINE namelist to EZPLOT data file. 0543 0544 STYLE = 4 0545 0546 if (plot) WRITE(11,ZLINE) 0547 0548 END IF 0549 0550 304 FORMAT(1X, 77('-'), 0551 & /,1X,'|', 25x,' Ground Track Trial ID: ',I3,1X,22x,'|', 0552 & /,1X,'| Success? : ',L3,T78,'|', 0553 & /,1X,'| Classification : ',I3,T78,'|', 0554 & /,1X,'| Maneuver Magnitude : ',F12.6,' mm/sec',T78,'|', 0555 & /,1x,'|', t78,'|') 0556 0557 C1 If ground was successfully targeted, then we are done. 0558 0559 IF ( SUCCES ) then 0560 dvnow = dvin 0561 GO TO 902 0562 end if 0563 0564 C iterate if still class 3 or class 6 --- 7/31/91 0565 0566 IF ( (CLASS .EQ. 3) .AND. (CLSOLD .EQ. 6) .OR. 0567 & (CLASS .EQ. 6) .AND. (CLSOLD .EQ. 3 ) ) THEN 0568 C DVIN = (DVNOW + DVOLD)/2.0 0569 DVIN = (DVA + DVB)/2.0 0570 GO TO 200 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 11 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0571 ELSE IF (CLASS .EQ. 3) THEN 0572 C DVIN = 2.0 * DVNOW 0573 DVIN = 2.0 * DVA 0574 GO TO 200 0575 ELSE IF (CLASS .EQ. 6) THEN 0576 C DVIN = DVNOW/2.0 0577 DVIN = DVA / 2.0 0578 GO TO 200 0579 END IF 0580 C ---- end mod 7/31/91 0581 0582 C1 As the initial dV guess did not solve the problem, set up "OLD" 0583 C1 and "NOW" variables prior to entry into the iterative search loop. 0584 0585 0586 CLSNOW = CLASS 0587 DVOLD = DVIN 0588 saved_dvold = dvold 0589 do i=1,3 0590 saved_dvvec(i) = dvvec(i) 0591 saved_dvlcr(i) = dvlcr(i) 0592 end do 0593 0594 IF ( STRAT .EQ. 'LONG' ) THEN 0595 if ( target_strat .eq. 'UNBIASED' ) then 0596 VALNOW = LIMITS(2,2) 0597 else if ( target_strat .eq. 'WESTGT' ) then 0598 VALNOW = LIMITS_WEST(2,2) 0599 else if ( target_strat .eq. 'EASTGT' ) then 0600 VALNOW = LIMITS_EAST(2,2) 0601 end if 0602 ELSE 0603 if ( target_strat .eq. 'UNBIASED' ) then 0604 VALNOW = LIMITS(4,1) 0605 else if ( target_strat .eq. 'WESTGT' ) then 0606 VALNOW = LIMITS_WEST(4,1) 0607 else if ( target_strat .eq. 'EASTGT' ) then 0608 VALNOW = LIMITS_EAST(4,1) 0609 end if 0610 END IF 0611 0612 C1 Check if DVIN will restrict the range of possible dV's. Obviously, 0613 C1 it will. 0614 0615 CALL CHKDV ( STRAT , CLSNOW , DVIN , VALNOW , TARGET , DVBND ) 0616 0617 C1 Determine the second dV guess. Set this up as the "NOW" guess. Note 0618 C1 that within the loop TGTGT uses both "OLD" and "NOW" varaibles to 0619 C1 compute the new dV; however, for the second dV use an almost arbitrary 0620 C1 guess. 0621 0622 ABSDDV = DABS( .2D0 * DVIN ) 0623 0624 IF ( ( CLASS .EQ. 1 0625 & .OR. CLASS .EQ. 2 0626 & ) 0627 & .AND. ( STRAT .EQ. 'LONG' TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 12 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0628 & .OR. STRAT .EQ. 'WEST' 0629 & ) 0630 & ) THEN 0631 0632 DVNOW = DVIN + ABSDDV 0633 0634 ELSE IF ( ( CLASS .EQ. 4 0635 & .OR. CLASS .EQ. 5 0636 & ) 0637 & .AND. ( STRAT .EQ. 'LONG' 0638 & .OR. STRAT .EQ. 'EAST' 0639 & ) 0640 & ) THEN 0641 0642 DVNOW = DVIN - ABSDDV 0643 0644 ELSE IF ( ( CLASS .EQ. 1 0645 & .OR. CLASS .EQ. 2 0646 & ) 0647 & .AND. ( STRAT .EQ. 'EAST' 0648 & ) 0649 & ) THEN 0650 0651 IF ( VALNOW .LT. TARGET ) THEN 0652 DVNOW = DVIN + ABSDDV 0653 ELSE 0654 DVNOW = DVIN - ABSDDV 0655 END IF 0656 0657 ELSE IF ( ( CLASS .EQ. 4 0658 & .OR. CLASS .EQ. 5 0659 & ) 0660 & .AND. ( STRAT .EQ. 'WEST' 0661 & ) 0662 & ) THEN 0663 0664 IF ( VALNOW .LT. TARGET ) THEN 0665 DVNOW = DVIN - ABSDDV 0666 ELSE 0667 DVNOW = DVIN + ABSDDV 0668 END IF 0669 0670 END IF 0671 0672 C1 Continue guessing at dV until the dV is properly targeted. 0673 C1 0674 C1 Do Loop... 0675 0676 C write(8,*) 'TGTGT PRE 901: DVNOW=',DVNOW 0677 901 CONTINUE 0678 0679 if (terminal .eq. 'VT100') 0680 & write (6,110) goto_string(7,45), dvnow 0681 0682 if ( (dvquanta .gt. 0) ) then 0683 C write(8,*)'TGTGT 901: DVNOW=',DVNOW 0684 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 13 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0685 dvnow = dvnow - dmod ( dvnow, dvquanta ) 0686 if (terminal .eq. 'VT100') 0687 & write (6,110) goto_string(7,45), dvnow 0688 C 0689 C check for convergence (will occur if approaching the 0690 C result from one side) 0691 C 0692 if ( ( dabs (dvnow - dvold) .lt. 0.9999*dvquanta ) )then 0693 goto 902 0694 end if 0695 C 0696 C check for repeat of earlier guess (will occur if last 2 0697 C iterations have bounded the result within a single 0698 C quanta) 0699 C 0700 if ( dvnow .eq. saved_dvold ) then 0701 C 0702 C recover the results from 2 iterations back 0703 C 0704 do i=1,3 0705 dvvec(i) = saved_dvvec(i) 0706 dvlcr(i) = saved_dvlcr(i) 0707 end do 0708 class = saved_class 0709 do i = 1,6 0710 orbend (i) = saved_orbend (i) 0711 orbwrk (i) = saved_orbwrk (i) 0712 end do 0713 datend = saved_datend 0714 do i = 1, 4 0715 do ii = 1, 2 0716 limits (i,ii) = saved_limits (i, ii) 0717 limits_east (i,ii) = saved_limits_east (i, ii) 0718 limits_west (i, ii) = saved_limits_west (i, ii) 0719 end do 0720 end do 0721 npts = saved_npts 0722 0723 CALL COPY84(SAVED_Y,Y,NPTS) 0724 CALL COPY84(SAVED_X,X,NPTS) 0725 CALL COPY84(SAVED_XW,XW,NPTS) 0726 CALL COPY84(SAVED_XE,XE,NPTS) 0727 0728 CALL COPY88(SAVED_Y,DPY,NPTS) 0729 CALL COPY88(SAVED_X,DPX,NPTS) 0730 CALL COPY88(SAVED_XW,DPXW,NPTS) 0731 CALL COPY88(SAVED_XE,DPXE,NPTS) 0732 0733 do i = 1, npts 0734 C evsw(i,1) = saved_evsw(i,1) 0735 C evsw(i,2) = saved_evsw(i,2) 0736 ecl(i) = saved_ecl(i) 0737 refidx(i) = saved_refidx(i) 0738 do j=1,6 0739 bootdata(i,j) = saved_bootdata(i,j) 0740 end do 0741 end do TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 14 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0742 0743 do i = 1, 3 0744 tmaneuver(i) = saved_tmaneuver (i) 0745 norbits(i) = saved_norbits(i) 0746 end do 0747 0748 goto 902 0749 end if 0750 0751 end if 0752 0753 C2 Update the ground track iteration counter. 0754 0755 GTID = GTID + 1 0756 if (terminal .eq. 'VT100') 0757 & write ( 6, 94 ) goto_String(7,34), gtid 0758 0759 C 0760 C save the previous iteration results just in case they 0761 C are needed 0762 C 0763 do i=1,3 0764 saved_dvvec(i) = dvvec(i) 0765 saved_dvlcr(i) = dvlcr(i) 0766 end do 0767 saved_class = class 0768 do i = 1,6 0769 saved_orbend (i) = orbend ( i ) 0770 saved_orbwrk (i) = orbwrk ( i ) 0771 end do 0772 saved_datend = datend 0773 do i = 1, 4 0774 do ii = 1, 2 0775 saved_limits (i,ii) = limits (i, ii) 0776 saved_limits_east (i,ii) = limits_east (i, ii) 0777 saved_limits_west (i, ii) = limits_west (i, ii) 0778 end do 0779 end do 0780 saved_npts = npts 0781 0782 CALL COPY88(DPY,SAVED_Y,NPTS) 0783 CALL COPY88(DPX,SAVED_X,NPTS) 0784 CALL COPY88(DPXW,SAVED_XW,NPTS) 0785 CALL COPY88(DPXE,SAVED_XE,NPTS) 0786 0787 do i = 1, npts 0788 C saved_evsw(i,1) = evsw (i,1) 0789 C saved_evsw(i,2) = evsw (i,2) 0790 saved_ecl(i) = ecl(i) 0791 saved_refidx(i) = refidx(i) 0792 do j = 1, 6 0793 saved_bootdata(i,j) = bootdata(i,j) 0794 end do 0795 end do 0796 0797 do i = 1, 3 0798 saved_tmaneuver(i) = tmaneuver (i) TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 15 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0799 saved_norbits(i) = norbits(i) 0800 end do 0801 0802 0803 0804 C2 Execute the "NOW" dV, run out the ground track, and then classify 0805 C2 the ground track. 0806 0807 call DVMOVE ( 6, ORBIN, OPRE) 0808 c CALL DODV ( A0 , DVNOW , ORBWRK ) 0809 0810 C write(8,*) 'TGTGT:ORBWRK=',ORBWRK 0811 C write(8,*) 'TGTGT:OPRE=',OPRE 0812 C write(8,*) 'TGTGT(PREDMNVR):DVNOW=',DVNOW 0813 call DOMNVR ( OPRE,0.001*DVNOW, PITCH, YAW, 0814 & opost, dvvec, dvlcr) 0815 c write ( 8, 900 ) (OPRE(KK), ORBWRK(KK), OPOST(KK),KK=1,6) 0816 CALL DVMOVE(6, OPOST, ORBWRK) 0817 C write(8,*) 'TGTGT(POSTDMNVR):DVNOW=',DVNOW 0818 C write(8,*) 'TGTGT:OPRE=',OPRE 0819 C write(8,*) 'TGTGT:OPOST=',OPOST 0820 C write(8,*) 'TGTGT:ORBWRK=',ORBWRK 0821 CALL COMPGT ( ORBWRK , DATIN , 0822 & M , JEARTH , 0823 & LTOP , LSFLAG , DRAG, 0824 & dsmadt, tsmaswitch, sigma_dsma, dragbiasmode, 0825 & 0 , BOUNDS , 0826 & ORBITS , XINGS , WATCH , 0827 & DV_FIXED, DV_PROP, DA_OD, 0828 & SF_DVOD, sf_drag, sf_boost, 0829 & NDRAG_BIAS, DRAG_BIAS, DVNOW, target_strat, 0830 & bias_ode, bias_dve, bias_fluxe, bias_booste, 0831 & bias_odw, bias_dvw, bias_fluxw, bias_boostw, 0832 & ORBEND , DATEND , 0833 & LIMITS , LIMITS_WEST, LIMITS_EAST, 0834 & NPTS , DPY, DPX,DPXW,DPXE, tmaneuver, betap, 0835 & norbits, ecl, refidx, bootdata, PAGE ) 0836 CALL COPY84(DPX,X,NPTS) 0837 CALL COPY84(DPY,Y,NPTS) 0838 call shift4(Y, PLOTDELTA, NPTS) 0839 CALL COPY84(DPXE,XE,NPTS) 0840 CALL COPY84(DPXW,XW,NPTS) 0841 0842 C write(8,*)'TGTGT:POST iterative COMPGT: betap=',betap 0843 C2 Check if "NOW" dV properly targets the ground track. 0844 0845 call find_class ( target_strat, limits, 0846 & limits_west, limits_east, bounds, class ) 0847 call check_success ( STRAT , TARGET_STRAT, 0848 & CLASS , LIMITS, LIMITS_WEST, LIMITS_EAST , 0849 & BNDFUZ , TIMFUZ , TARGET , 0850 & SUCCES ) 0851 0852 C1 If ground track was targeted properly, the exit loop. 0853 0854 IF ( SUCCES ) GO TO 902 0855 TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 16 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0856 C2 If the user wants to record this ground track... 0857 0858 call display_limits ( 18, 1, limits, 0859 & limits_west, limits_east, .false. ) 0860 0861 IF ( WATCHINT ) THEN 0862 0863 C3 Start a new page if necessary. 0864 0865 IF ( ( MOD( GTID, 3 ) .EQ. 1 ) )then 0866 CALL NEWPAGE(PAGE,2) 0867 end if 0868 0869 C3 Print record to OFILE. 0870 0871 WRITE(8,304) GTID , SUCCES , CLASS , DVNOW 0872 call write_limits ( 8, LIMITS, LIMITS_WEST, LIMITS_EAST) 0873 C WRITE(8,305) ' Nominal Track ', LIMITS 0874 C WRITE(8,305) '95 Percentile West', LIMITS_WEST 0875 C WRITE(8,305) '95 Percentile East', LIMITS_EAST 0876 0877 C3 Write $ZLINE namelist to EZPLOT data file. 0878 0879 STYLE = 4 0880 0881 if (plot) WRITE(11,ZLINE) 0882 0883 END IF 0884 C 0885 C Check maximum iterations --- 7/31/91 addition 0886 C -- future mod: add namelist input for maximum value 0887 0888 IF (GTID .GE. 25) THEN 0889 call clear_screen 0890 STOP '>> ERROR EXIT: Algorithm does not converge.' 0891 END IF 0892 0893 C End check --- 7/31/91 0894 0895 C2 Otherwise, update the remaining "OLD" and "NEW" variables. Note that 0896 C2 the class and independent value (distance west or time to boundary) 0897 C2 variables are updated here, but the "NOW" dV variable was updated 0898 C2 in the previous loop: i.e., one must find and execute a new dV 0899 C2 before the class and independent value can be assessed. 0900 0901 CLSOLD = CLSNOW 0902 CLSNOW = CLASS 0903 0904 VALOLD = VALNOW 0905 0906 IF ( STRAT .EQ. 'LONG' ) THEN 0907 if ( target_strat .eq. 'UNBIASED' ) then 0908 VALNOW = LIMITS(2,2) 0909 else if ( target_strat .eq. 'WESTGT' ) then 0910 VALNOW = LIMITS_WEST(2,2) 0911 else if ( target_strat .eq. 'EASTGT' ) then 0912 VALNOW = LIMITS_EAST(2,2) TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 17 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0913 end if 0914 ELSE 0915 if ( target_strat .eq. 'UNBIASED' ) then 0916 VALNOW = LIMITS(4,1) 0917 else if ( target_strat .eq. 'WESTGT' ) then 0918 VALNOW = LIMITS_WEST(4,1) 0919 else if ( target_strat .eq. 'EASTGT' ) then 0920 VALNOW = LIMITS_EAST(4,1) 0921 end if 0922 END IF 0923 0924 C2 Check if dV will restrict range of possible dV's. 0925 0926 CALL CHKDV( STRAT , CLSNOW , DVNOW , VALNOW , TARGET , DVBND ) 0927 0928 C2 Compute the next dV. FNDDV takes care of transfering "NOW" dV to 0929 C2 "OLD" dV. 0930 0931 saved_dvold = dvold 0932 0933 C write(8,*) 'TGTGT PRE FINDV:DVNOW=',DVNOW,' DVOLD=',DVOLD 0934 CALL FNDDV ( STRAT , 0935 & CLSOLD , CLSNOW , 0936 & DVOLD , DVNOW , DVBND , 0937 & VALOLD , VALNOW , TARGET ) 0938 0939 C2 Return to top of loop and test this new dV. 0940 0941 C write(8,*) 'TGTGT POST FINDV:DVNOW=',DVNOW,' DVOLD=',DVOLD 0942 GO TO 901 0943 0944 C1 End of loop. 0945 0946 902 CONTINUE 0947 0948 C1 Print the targeted ground track vital statistics. 0949 0950 CALL NEWPAGE (PAGE,2) 0951 0952 call clear_screen 0953 0954 if (TERMINAL.eq.'VT100') print 1710, goto_string(1, 1) 0955 1710 format(1x,a8,28('-'),1x,'Ground Track Results',1x,29('-')) 0956 0957 if (TERMINAL .eq. 'VT100') 0958 & call display_limits ( 2, 1, limits, 0959 & limits_west, limits_east, .true. ) 0960 0961 WRITE(8,304) GTID , SUCCES , CLASS , DVNOW 0962 call write_limits ( 8, LIMITS, LIMITS_WEST, LIMITS_EAST) 0963 0964 C1 Use SUMMRY to print GTARG's Executive Summary following the 0965 C1 the targeted ground track's vitals on the last page. 0966 0967 c write(8,*) 'ORBIN=(PRE-SUMMRY)',ORBIN 0968 0969 CALL SUMMRY( STRAT , TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 18 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 0970 & ORBIN , DATIN , rev, 0971 & DVNOW , dvlcr, PITCH, YAW, ORBWRK , 0972 & LIMITS , 0973 & ORBEND , DATEND , tmaneuver, betap, norbits ) 0974 0975 t0 = ch2sec ( datin, .true., error ) 0976 C 0977 C print kepler state summary 0978 C 0979 do i = 1, npts 0980 if (mod(i-1,50) .eq. 0 ) then 0981 CALL NEWPAGE(PAGE,2) 0982 write (8,83824) 0983 end if 0984 ti = dpy(i) * 86400.0d0 + t0 0985 dati = sec2ch (ti) 0986 write (8,83825) dati(1:20),(bootdata(i,j),j=1,5) 0987 end do 0988 C 0989 C print ground track summary 0990 C 0991 0992 do i = 1, npts 0993 if (mod(i-1,50) .eq. 0 ) then 0994 CALL NEWPAGE(PAGE,2) 0995 write (8,837) 0996 end if 0997 0998 ti = dpy(i) * 86400.0d0 + t0 0999 dati = sec2ch (ti) 1000 1001 if ( i .gt. 1 .and. i .lt. npts ) then 1002 drate = 1000.0*(dpx(i+1) - dpx(i-1))/(dpy(i+1)-dpy(i-1)) 1003 write (8, 8382) rev+i*m, dati(1:20), 1004 * dpxw(i), dpx(i), dpxe(i), 1005 * refidx(i), ecl(i), 1006 * drate 1007 else 1008 write (8, 838) rev+i*m, dati(1:20), 1009 * dpxw(i), dpx(i), dpxe(i), 1010 * refidx(i), ecl(i) 1011 end if 1012 1013 837 format (1x, 2x, 'Orbit', 1x, 16x, 4x, 1014 * 1x, '-- Ground Track (km) --' 1015 * 8x, 8x, 2x, 'Drift', 1016 * /1x,' Number',1x,7x,'Date', 6x,'UTC', 1017 * 4x, 'West', 1x, 'Nominal' 1018 * 4x, 'East', 1019 * 1x,'Rev',3x,' long', 6x,'m/day', 1020 * /1x,7('-'),1x, 11('-'), 1x, 8('-'), 3(1x,7('-')), 1021 * 1x,'---',1x,7('-'),1x,10('-') 1022 * ) 1023 838 format (1x, I7, 1x, A20, 3f8.3, i4, f8.3) 1024 8382 format (1x, I7, 1x, A20, 3f8.3, i4, f8.3, f11.4) 1025 83824 format (1x,7x,'Date',6x,'UTC',15x,'a',10x, 1026 * 'e',8x,'i',5x,'RAAN',6x,'AOP', TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 19 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 1027 * /1x,11('-'),1x,8('-'),1x,15('-'),1x,10('-'), 1028 * 3(1x,8('-'))) 1029 83825 format (1x,A20,F16.8,f11.7, 3f9.3) 1030 1031 if (boot) write (12,8385) dati, (bootdata(i,j), j=1,6) 1032 8385 format(1x,'DATE = ''',A25,'''', 1033 * / 1x, 'ORBIT = ',3(F20.10,',',1x), 1034 * /1x,8x,3(F20.10,',',1x)) 1035 end do 1036 1037 C 1038 C write ground track biasing components 1039 C 1040 1041 do i = 1, npts 1042 if (mod(i-1,50) .eq. 0 ) then 1043 CALL NEWPAGE(PAGE,2) 1044 write (8,8390) 1045 end if 1046 1047 ti = dpy(i) * 86400.0d0 + t0 1048 dati = sec2ch (ti) 1049 1050 write (8, 8392) dati(1:20), 1051 * abs(bias_odw(i)-dpx(i)), abs(bias_dvw(i)-dpx(i)), 1052 * abs(bias_boostw(i)-dpx(i)), abs(bias_fluxw(i)-dpx(i)), 1053 * abs(dpxw(i)-dpx(i)), abs(bias_fluxe(i)-dpx(i)), 1054 * abs(dpxe(i)-dpx(i)) 1055 1056 end do 1057 8390 format (1x,44x,4x,'West',4x,'West',4x, 'East',4x,'East' 1058 * /1x,7x,'Date',6x,'UTC', 1059 * 6x, 'OD', 6x,'DV', 3x,'BOOST',4x,'Drag', 1060 * ' Total',4x,'Drag', ' Total', 1061 * /1x,11('-'),1x,8('-'), 7(1x,'-------')) 1062 8392 format (1x, A20, 7F8.4) 1063 1064 1065 1066 C1 Write $ZLINE namelist describing the targeting ground track to 1067 C1 EZPLOT data file. Note that the targeted ground track is a solid 1068 C1 line, where as the un-targeted tracks were dotted lines. 1069 1070 STYLE = 1 1071 1072 if (plot) then 1073 WRITE(11,ZLINE) 1074 if (plot_components) write(16,zline) 1075 1076 C EAST/WEST 95 Percentile Tracks 1077 1078 call write_curve ( 11, npts, xw, y, 2 ) 1079 call write_curve ( 11, npts, xe, y, 2) 1080 C 1081 C plot the boost/deboost (unmodeled forces) 1082 C 1083 if ( plot_boost ) then TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 20 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 1084 tplotdate = ch2sec (plotdate, .true., ERROR) 1085 if (dsmadt_epoch .ne. ' ') then 1086 boostdelta = 1087 & ( ch2sec ( dsmadt_epoch, .true., ERROR) - 1088 & tplotdate ) / 86400.0 1089 do i = 1, ndsmadt_data 1090 plot_datay(i) = i - 1 + boostdelta 1091 plot_datax(i) = dsmadt_data(i) 1092 end do 1093 else 1094 do i = 1, ndsmadt_data 1095 plot_datay(i) = 1096 & ( ch2sec ( dsmadt_dates(i), .true., ERROR) - 1097 & tplotdate ) / 86400.0 1098 plot_datax(i) = dsmadt_data(i) 1099 end do 1100 end if 1101 1102 call write_curve ( 11, ndsmadt_data, plot_datax, 1103 & plot_datay, 1 ) 1104 end if 1105 1106 C 1107 C label the cycle boundaries 1108 C 1109 if (plotcycle) then 1110 do i = 2, npts 1111 if (refidx(i) .lt. refidx (i-1)) then 1112 x1 = dble(real(refidx(i-1))) 1113 x2 = dble(real(refidx(i))) + dble(real(orbits)) 1114 y1 = dpy(i-1) 1115 y2 = dpy(i) 1116 y2 = y1 + ( 1.0d0 + dble(real(orbits)) 1117 & - real(refidx(i-1)) ) 1118 & * (y2-y1)/(x2-x1) 1119 ti = y2 * 86400.0d0 + t0 1120 dnode = sec2ch ( ti ) 1121 xtmp(1) = windo(1) 1122 xtmp(2) = windo(2) 1123 ytmp(1) = y2 + plotdelta 1124 ytmp(2) = y2 + plotdelta 1125 call write_labeled_curve ( 11, 2, xtmp, ytmp, 4, 1126 & WINDO(1) + (WINDO(2)-WINDO(1))*0.01, 1127 & Ytmp(1) + (windo(4)-windo(3))*0.0075, 1128 & '\fr'//dnode(1:17) ) 1129 end if 1130 end do 1131 end if 1132 call write_label ( 11, windo(1), 1133 & windo(3)-0.0522*(windo(4)-windo(3)), 1134 & '\frData Epoch: '//datin) 1135 1136 write(dvlabel, 8400) dvnow 1137 1138 8400 format('\gDV =',f10.5,' mm/sec') 1139 call write_label ( 11, windo(1)+0.8235*(windo(2)-windo(1)), 1140 & windo(3)-0.0522*(windo(4)-windo(3)), TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 21 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 1141 & '\fr'//dvlabel) 1142 1143 C Break down bias into components for plot 1144 1145 if (plot_components) then 1146 call write_curve ( 16, npts, xw, y, 5 ) 1147 call write_curve ( 16, npts, xe, y, 5) 1148 call write_curve ( 16, npts, bias_ode, y, 2 ) 1149 call write_curve ( 16, npts, bias_dve, y, 3 ) 1150 call write_curve ( 16, npts, bias_fluxe, y, 4 ) 1151 call write_curve ( 16, npts, bias_booste, y, 1) 1152 call write_curve ( 16, npts, bias_odw, y, 2 ) 1153 call write_curve ( 16, npts, bias_dvw, y, 3 ) 1154 call write_curve ( 16, npts, bias_fluxw, y, 4 ) 1155 call write_curve ( 16, npts, bias_boostw, y, 1) 1156 end if 1157 end if 1158 1159 if ( dvbracket(1) .ge. dvbracket(2) ) return 1160 C 1161 C Do post-targeting runouts 1162 C 1163 1164 if ( strat .ne. 'RUNOUT' ) then 1165 if ( target_strat .eq. 'UNBIASED' ) then 1166 days = int ( limits ( 4, 1) ) + 1 1167 else if ( target_strat .eq. 'WESTGT' ) then 1168 days = int ( limits_west ( 4, 1) ) + 1 1169 else if ( target_strat .eq. 'EASTGT' ) then 1170 days = int ( limits_east ( 4, 1) ) + 1 1171 endif 1172 end if 1173 1174 strat = 'RUNOUT' 1175 DVIN = DVNOW 1176 1177 jcolumn = 0 1178 1179 1180 do j = dvbracket(1), dvbracket(2), dvbracket(3) 1181 1182 if (terminal .eq. 'VT100') print 2001, goto_string(12,1), j 1183 2001 format(' ',a8,27('-'),' Post-Targeting Runout ', 1184 & i2,1x, 27('-')) 1185 if ( j .ne. 0 ) then 1186 jcolumn = jcolumn + 1 1187 dvnow = dvin + dble(j) * dvquanta 1188 1189 call DVMOVE ( 6, ORBIN, OPRE) 1190 c call dodv ( a0, dvnow, orbwrk ) 1191 call DOMNVR ( OPRE, 0.001*DVNOW, PITCH, YAW, 1192 & opost, dvvec, dvlcr) 1193 c write ( 8, 900 ) (OPRE(KK), ORBWRK(KK), OPOST(KK),KK=1,6) 1194 CALL DVMOVE(6, OPOST, ORBWRK) 1195 1196 C write(8,*) 'TGTGT:OPOST=',OPOST 1197 C write(8,*) 'TGTGT:ORBWRK=',ORBWRK TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 22 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 1198 CALL COMPGT ( ORBWRK , DATIN , 1199 & M , JEARTH , 1200 & LTOP , LSFLAG , DRAG, 1201 & dsmadt, tsmaswitch, sigma_dsma, dragbiasmode, 1202 & DAYS , BOUNDS , 1203 & ORBITS , XINGS , WATCH , 1204 & DV_FIXED, DV_PROP, DA_OD, 1205 & SF_DVOD, sf_drag, sf_boost, 1206 & NDRAG_BIAS, DRAG_BIAS, DVNOW, target_strat, 1207 & bias_ode, bias_dve, bias_fluxe, bias_booste, 1208 & bias_odw, bias_dvw, bias_fluxw, bias_boostw, 1209 & ORBEND , DATEND , 1210 & LIMITS , LIMITS_WEST, LIMITS_EAST, 1211 & NPTS ,DPY,DPX ,DPXW,DPXE, tmaneuver, betap, 1212 & norbits, ecl, refidx, bootdata, PAGE) 1213 CALL COPY84(DPX,X,NPTS) 1214 CALL COPY84(DPY,Y,NPTS) 1215 call shift4(Y, PLOTDELTA, NPTS) 1216 CALL COPY84(DPXE,XE,NPTS) 1217 CALL COPY84(DPXW,XW,NPTS) 1218 1219 call display_limits ( 18, 1, limits, 1220 & limits_west, limits_east, .true. ) 1221 1222 C write(8,*) '**** DV BRACKET = ', j,' ****' 1223 1224 CALL NEWPAGE(PAGE,2) 1225 1226 write(8,399) j, DVNOW 1227 399 format(' ', 1228 & /,1x,77('-'), 1229 & /,1x,'|',t78,'|', 1230 & /,1x,'|', 5x, 'Delta-V Bracketing Runout, Delta = ',i2, 1231 & ' counts, dv = ',f7.2,' mm/sec.',t78,'|', 1232 & /,1x,'|',t78,'|', 1233 & /,1x,77('-'), 1234 * /,1x,'|',t78,'|') 1235 1236 C WRITE(8,304) GTID , SUCCES , CLASS , DVNOW 1237 1238 call write_limits ( 8, LIMITS, LIMITS_WEST, LIMITS_EAST) 1239 1240 CALL SUMMRY( STRAT , ORBIN , DATIN , rev, 1241 & DVNOW , dvlcr, PITCH, YAW, 1242 & ORBWRK , LIMITS , ORBEND , DATEND , 1243 & tmaneuver, OPRE, betap, norbits ) 1244 1245 STYLE = 5 1246 if (plot) WRITE(11,ZLINE) 1247 1248 C 1249 C save the data in the table for output to the spreadsheet file 1250 C 1251 dv_labels ( jcolumn ) = dvnow 1252 do istep = 1, npts 1253 gt_table ( jcolumn, istep ) = x(istep) 1254 end do TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 23 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 1255 1256 end if 1257 1258 C 1259 C write bracketing data to the spread sheet file if time 1260 C 1261 1262 C if ( (jcolumn .eq. 6) .or. 1263 C & (j .gt. dvbracket(2)-dvbracket(3) ) ) then 1264 C write ( 13, * ) '***** dv braketing runout *****' 1265 C write ( 13, 989 ) ( dv_labels ( k ), k = 1, jcolumn ) 1266 C do istep = 1, npts 1267 C write ( 13, 990 ) y(istep), 1268 C & ( gt_table(k,istep), k=1,jcolumn ) 1269 C end do 1270 C 1271 C989 format (1x, ' Time', 7f11.3) 1272 C990 format ( 1x, 7f11.6) 1273 C jcolumn = 0 1274 C end if 1275 1276 end do 1277 1278 1279 C1 End of TGTGT. 1280 1281 RETURN 1282 END TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 24 01 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 6956 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 1456 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 5612688 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 TT 12 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 BOOST 33041 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 5654153 ENTRY POINTS Address Type Name 0-00000000 TGTGT VARIABLES Address Type Name Address Type Name ** R*8 A0 ** R*8 ABSDDV ** CHAR ADATE AP-0000009C@ L*4 ATARGONLY ** CHAR ATIME 2-00559610 R*8 BETAP AP-0000005C@ R*8 BNDFUZ ** R*4 BOOSTDELTA AP-000000B4@ L*4 BOOT AP-00000044@ R*8 CD 2-00559678 I*4 CLASS 2-0055967C I*4 CLSNOW 2-00559680 I*4 CLSOLD AP-000000A8@ CHAR DATEND 2-005595BF CHAR DATI AP-00000018@ CHAR DATIN AP-00000010@ I*4 DAYS AP-00000080@ R*8 DA_OD 2-005595D8 CHAR DNODE AP-00000040@ L*4 DRAG AP-00000054@ CHAR DRAGBIASMODE ** R*8 DRATE 4-00001F5D R*8 DSMADT_DATA_SIGMA 4-00001F44 CHAR DSMADT_EPOCH 2-00559658 R*8 DVA 2-00559660 R*8 DVB AP-00000020@ R*8 DVIN 2-005595A8 CHAR DVLABEL 2-00559618 R*8 DVNOW 2-00559620 R*8 DVOLD AP-0000002C@ R*8 DVQUANTA AP-00000078@ R*8 DV_FIXED AP-0000007C@ R*8 DV_PROP 2-0055968C L*4 ERROR ** I*4 GTID 2-00559698 I*4 I ** I*4 II ** I*4 ISTEP ** I*4 J ** I*4 JCOLUMN AP-0000003C@ L*4 LSFLAG AP-00000038@ I*4 LTOP AP-00000030@ I*4 M AP-00000090@ I*4 NDRAG_BIAS 4-00000000 I*4 NDSMADT_DATA 2-00559670 I*4 NPTS AP-00000068@ I*4 ORBITS AP-000000A0@ I*4 PAGE AP-00000024@ R*8 PITCH AP-000000B8@ L*4 PLOT AP-000000C0@ L*4 PLOTCYCLE AP-000000AC@ CHAR PLOTDATE 2-00559688 R*4 PLOTDELTA 4-00001F65 L*4 PLOT_BOOST AP-000000BC@ L*4 PLOT_COMPONENTS AP-0000001C@ I*4 REV 2-00559694 I*4 SAVED_CLASS 2-005595F1 CHAR SAVED_DATEND 2-00559668 R*8 SAVED_DVOLD 2-00559690 I*4 SAVED_NPTS AP-0000008C@ R*8 SF_BOOST AP-00000088@ R*8 SF_DRAG AP-00000084@ R*8 SF_DVOD AP-00000008@ CHAR STRAT 2-00559674 I*4 STYLE 2-00559684 L*4 SUCCES TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 25 01 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 2-00559648 R*8 T0 2-00559628 R*8 TARGET AP-0000000C@ CHAR TARGET_STRAT 3-00000000 CHAR TERMINAL AP-00000004@ CHAR TESTCASE 2-00559650 R*8 TI AP-00000064@ R*8 TIMFUZ AP-00000060@ R*8 TIMTGT ** R*8 TPLOTDATE AP-0000004C@ R*8 TSMASWITCH 2-00559630 R*8 VALNOW 2-00559638 R*8 VALOLD AP-00000070@ L*4 WATCH AP-00000074@ L*4 WATCHINT ** R*8 X1 ** R*8 X2 2-00559640 R*8 Y1 ** R*8 Y2 AP-00000028@ R*8 YAW ARRAYS Address Type Name Bytes Dimensions 2-004E429C R*4 BIAS_BOOSTE 80000 (20000) 2-0053249C R*4 BIAS_BOOSTW 80000 (20000) 2-004BD19C R*4 BIAS_DVE 80000 (20000) 2-0050B39C R*4 BIAS_DVW 80000 (20000) 2-004D0A1C R*4 BIAS_FLUXE 80000 (20000) 2-0051EC1C R*4 BIAS_FLUXW 80000 (20000) 2-004A991C R*4 BIAS_ODE 80000 (20000) 2-004F7B1C R*4 BIAS_ODW 80000 (20000) 2-00271340 R*8 BOOTDATA 960000 (20000, 6) AP-00000058@ R*8 BOUNDS 16 (2) 2-001389D8 R*8 DPX 160000 (20000) 2-001118D8 R*8 DPXE 160000 (20000) 2-000EA7D8 R*8 DPXW 160000 (20000) 2-0015FAD8 R*8 DPY 160000 (20000) AP-00000094@ R*8 DRAG_BIAS ** (*) AP-00000048@ R*8 DSMADT 16 (2) 4-00000004 R*8 DSMADT_DATA 8000 (1000) 4-00001F69 CHAR DSMADT_DATES 25000 (1000) 2-000EA630 R*8 DVBND 16 (2) AP-00000098@ I*4 DVBRACKET 12 (3) 2-000EA658 R*8 DVLCR 24 (3) 2-000EA640 R*8 DVVEC 24 (3) 2-000EA600 R*8 DV_LABELS 48 (6) 2-00186BD8 R*8 ECL 160000 (20000) 2-00000000 R*8 GT_TABLE 960000 (6, 20000) AP-00000034@ R*8 JEARTH 224 (2:29) 2-000EA670 R*8 LIMITS 64 (4, 2) 2-000EA6B0 R*8 LIMITS_EAST 64 (4, 2) 2-000EA6F0 R*8 LIMITS_WEST 64 (4, 2) 2-0046EF80 I*4 NORBITS 12 (3) 2-000EA790 R*8 OPOST 48 (6) 2-000EA760 R*8 OPRE 48 (6) AP-000000A4@ R*8 ORBEND 48 (6) AP-00000014@ R*8 ORBIN 48 (6) 2-000EA730 R*8 ORBWRK 48 (6) 2-00445F40 R*4 PLOT_DATAX 4000 (1000) 2-00446EE0 R*4 PLOT_DATAY 4000 (1000) 2-0049608C I*4 REFIDX 80000 (20000) 2-0035B940 R*8 SAVED_BOOTDATA 960000 (6, 20000) 2-0024A228 R*8 SAVED_DVLCR 24 (3) 2-0024A210 R*8 SAVED_DVVEC 24 (3) TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 26 01 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 2-0024A240 R*8 SAVED_ECL 160000 (20000) 2-001ADD38 R*8 SAVED_LIMITS 64 (4, 2) 2-001ADD78 R*8 SAVED_LIMITS_EAST 64 (4, 2) 2-001ADDB8 R*8 SAVED_LIMITS_WEST 64 (4, 2) 2-00545D1C I*4 SAVED_NORBITS 12 (3) 2-001ADCD8 R*8 SAVED_ORBEND 48 (6) 2-001ADD08 R*8 SAVED_ORBWRK 48 (6) 2-00545D28 I*4 SAVED_REFIDX 80000 (20000) 2-0024A1F8 R*8 SAVED_TMANEUVER 24 (3) 2-001D4EF8 R*8 SAVED_X 160000 (20000) 2-002230F8 R*8 SAVED_XE 160000 (20000) 2-001FBFF8 R*8 SAVED_XW 160000 (20000) 2-001ADDF8 R*8 SAVED_Y 160000 (20000) AP-00000050@ R*8 SIGMA_DSMA 16 (2) 2-000EA7C0 R*8 TMANEUVER 24 (3) AP-000000B0@ R*4 WINDO 16 (4) 2-00447E80 R*4 X 80000 (20000) 2-0048280C R*4 XE 80000 (20000) AP-0000006C@ R*8 XINGS ** (*) 2-004A990C R*4 XTMP 8 (2) 2-0046EF8C R*4 XW 80000 (20000) 2-0045B700 R*4 Y 80000 (20000) 2-004A9914 R*4 YTMP 8 (2) NAMELISTS Address Name 2-005596A8 ZLINE LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-00000132 94' 1-00000123 110' 1-0000012C 115' 0-000002F8 200 1-00000139 302' 1-00000165 304' 1-000004E7 399' 1-0000024F 837' 1-00000322 838' ** 900' 0-0000092C 901 0-00000FDC 902 1-00000220 1710' 1-000004B4 2001' 1-00000335 8382' 1-000003C2 8385' 1-00000400 8390' 1-00000495 8392' 1-0000049F 8400' 1-0000034B 83824' 1-000003B2 83825' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*8 CH2SEC CHECK_SUCCESS CHKDV CLEAR_SCREEN COMPGT COPY84 COPY88 DISPLAY_LIMITS DOMNVR DVMOVE FIND_CLASS FIRSTGUESS FNDDV CHAR GOTO_STRING R*8 MTH$DMOD NEWPAGE SCREEN_HEADER CHAR SEC2CH SHIFT4 SUMMRY WRITE_CURVE WRITE_LABEL WRITE_LABELED_CURVE WRITE_LIMITS TGTGT 1-Jun-1993 15:40:27 VAX FORTRAN V5.6-119 Page 27 01 10-May-1993 16:21:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.FOR;288 COMMAND QUALIFIERS FOR/LIS TGTGT.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]TGTGT.OBJ;2 COMPILATION STATISTICS Run Time: 3.77 seconds Elapsed Time: 12.90 seconds Page Faults: 1151 Dynamic Memory: 1176 pages 1-Jun-1993 15:40:44 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:47:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]UNIT.FOR;3 0001 SUBROUTINE UNIT(A, B) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C Creates a unit vector B colinear with input vector A 0012 C 0013 DOUBLE PRECISION A(3), B(3), TEMP 0014 TEMP = A(1)*A(1) + A(2)*A(2) + A(3)*A(3) 0015 TEMP = SQRT(TEMP) 0016 if (TEMP .eq. 0.0d0) then 0017 B(1) = 0.0d0 0018 B(2) = 0.0d0 0019 B(3) = 0.0d0 0020 else 0021 B(1) = A(1)/TEMP 0022 B(2) = A(2)/TEMP 0023 B(3) = A(3)/TEMP 0024 end if 0025 return 0026 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 107 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 40 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 147 ENTRY POINTS Address Type Name 0-00000000 UNIT VARIABLES Address Type Name ** R*8 TEMP UNIT 1-Jun-1993 15:40:44 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:47:18 NAVDEV:[SHAPIRO.COSMIC.SOURCE]UNIT.FOR;3 ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 A 24 (3) AP-00000008@ R*8 B 24 (3) FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*8 MTH$DSQRT COMMAND QUALIFIERS FOR/LIS UNIT.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]UNIT.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]UNIT.OBJ;2 COMPILATION STATISTICS Run Time: 0.27 seconds Elapsed Time: 2.04 seconds Page Faults: 200 Dynamic Memory: 456 pages 1-Jun-1993 15:40:50 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:47:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]UPCASE.FOR;3 0001 C$Procedure UPCASE 0002 C 0003 SUBROUTINE UPCASE ( STR ) 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C 0014 C$ Purpose 0015 C 0016 C UPCASE converts any lower case letters in a string to uppercase. 0017 C 0018 C$ Log 0019 C 0020 C 12-Aug-1987 0021 C Eric Cannell - birth 0022 C 0023 C 01-Sep-1987 0024 C Eric Cannell - SID 0025 C 0026 C$ Restrictions 0027 C 0028 C 1- Basically, STR can contain any ASCII character. 0029 C 0030 C$ Input_Arguments 0031 C 0032 C STR - string of arbitrary characters 0033 C 0034 C$ Output_Arguments 0035 C 0036 C STR - input string with lower case letter converted to uppercase 0037 C 0038 C$ Declarations_of_Input_and_Output_Arguments 0039 C 0040 CHARACTER*(*) STR 0041 C 0042 C$ Declarations_of_Local_Variables 0043 C 0044 INTEGER I 0045 INTEGER LSTR 0046 INTEGER OFFSET 0047 C 0048 C$ Data_Statements 0049 C 0050 DATA OFFSET / 32 / 0051 C 0052 C$ Method 0053 C-& 0054 0055 C1 Compute length of string. 0056 0057 LSTR = LEN(STR) UPCASE 1-Jun-1993 15:40:50 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:47:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]UPCASE.FOR;3 0058 0059 C1 Check each character in the string. 0060 0061 DO 10 I = 1 , LSTR 0062 0063 C2 If it is a lowercase letter, then convert it to uppercase. 0064 0065 IF ('a' .LE. STR(I:I) .AND. STR(I:I) .LE. 'z') THEN 0066 0067 STR(I:I) = CHAR ( ICHAR ( STR(I:I) ) - OFFSET ) 0068 0069 END IF 0070 0071 C2 Otherwise, skip that character and continue. 0072 0073 10 CONTINUE 0074 0075 RETURN 0076 0077 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 74 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 90 ENTRY POINTS Address Type Name 0-00000000 UPCASE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I ** I*4 LSTR 2-00000000 I*4 OFFSET AP-00000004@ CHAR STR LABELS Address Label ** 10 UPCASE 1-Jun-1993 15:40:50 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:47:46 NAVDEV:[SHAPIRO.COSMIC.SOURCE]UPCASE.FOR;3 COMMAND QUALIFIERS FOR/LIS UPCASE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]UPCASE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]UPCASE.OBJ;2 COMPILATION STATISTICS Run Time: 0.22 seconds Elapsed Time: 1.66 seconds Page Faults: 205 Dynamic Memory: 460 pages 1-Jun-1993 15:40:56 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:48:19 [SHAPIRO.COSMIC.SOURCE]USER_DENSITY.FOR;2 0001 DOUBLE PRECISION FUNCTION USER_DENSITY ( TIME, 0002 & FLUX, FLUXBAR, KP ) 0003 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C TEMPLATE FOR A USER-DEFINED DENSITY FUNCTION 0015 C 0016 C INPUT PARAMETERS 0017 C ---------------- 0018 C TIME DP FRACTION OF A YEAR (E.G., 0 = JAN 1, 1.0 = DEC 31) 0019 C FLUX DP SOLAR FLUX INPUT 0020 C FLUXBAR DP MEAN (81-DAY) SOLAR FLUX 0021 C KP DP GEOMAGNETIC INDEX 0022 C 0023 C RESULT 0024 C ------ 0025 C THE DOUBLE PRECISION ATMOSPHERIC DENSITY IN KILOGRAMS/KILOMETER**3 0026 C 0027 0028 DOUBLE PRECISION TIME, FLUX, FLUXBAR, KP, RHO 0029 0030 common /dragblock/ dragmodel, dragarea, atmos, atden 0031 character*10 dragmodel, atmos 0032 double precision dragarea, atden 0033 C 0034 C DEFAULT TO THE CONSTANT DENSITY VALUE 0035 C 0036 RHO = ATDEN 0037 C *** 0038 C INSERT CODE HERE TO CALCULATE DENSITY AS A FUNCTION OF INPUT 0039 C PARAMETERS; ASSIGN RESULT TO RHO 0040 C 0041 C *** 0042 USER_DENSITY = RHO 0043 RETURN 0044 END USER_DENSITY 1-Jun-1993 15:40:56 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:48:19 [SHAPIRO.COSMIC.SOURCE]USER_DENSITY.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 17 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 8 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 DRAGBLOCK 36 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 61 ENTRY POINTS Address Type Name 0-00000000 R*8 USER_DENSITY VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 3-0000001C R*8 ATDEN 3-00000012 CHAR ATMOS 3-0000000A R*8 DRAGAREA 3-00000000 CHAR DRAGMODEL AP-00000008@ R*8 FLUX AP-0000000C@ R*8 FLUXBAR AP-00000010@ R*8 KP ** R*8 RHO AP-00000004@ R*8 TIME COMMAND QUALIFIERS FOR/LIS USER_DENSITY.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]USER_DENSITY.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]USER_DENSITY.OBJ;2 COMPILATION STATISTICS Run Time: 0.16 seconds Elapsed Time: 1.63 seconds Page Faults: 173 Dynamic Memory: 440 pages 1-Jun-1993 15:41:00 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:49:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.FOR;13 0001 real*8 function vmarea ( betap, model ) 0002 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C Calculate the VMA Area of the Satellite 0013 C 0014 double precision betap,vmatab(3,-90:90), betalo,betahi,alo,ahi, 0015 * RESULT,x1,x2,xtemp, careas(2), breakpts(2) 0016 character model*4 0017 common /vma/vmatab, careas, breakpts 0018 0019 common /dragblock/ dragmodel, dragarea, atmos, atden 0020 character*10 dragmodel, atmos 0021 double precision dragarea, atden 0022 0023 logical first 0024 data first/.true./ 0025 0026 IF (DRAGMODEL .EQ. 'CONSTANT') THEN 0027 VMARAEA = DRAGAREA 0028 if (first) then 0029 write(8,*) 'Using Constant Satellite Area.' 0030 first = .false. 0031 end if 0032 RETURN 0033 ELSE IF (DRAGMODEL .NE. 'VMA') THEN 0034 WRITE(8,*) 'INVALID DRAGMODEL = ', DRAGMODEL 0035 STOP '>>>>> ERROR EXIT.' 0036 END IF 0037 if (first) then 0038 write(8,*) 'Using VMA Model for Satellite Area.' 0039 first = .false. 0040 end if 0041 0042 if (model.eq.'DRAG') then 0043 iarea = 2 0044 else if (model.eq.'SRP') then 0045 iarea = 3 0046 else 0047 write(8,*) 'Invalid VMA model = ',model 0048 write(8,*) 'Valid models = DRAG, SRP' 0049 stop '?? VMA Error Exit.' 0050 end if 0051 C 0052 C interpolate between two successive values. Find bounding values 0053 C in table. 0054 0055 if ( model .eq. 'DRAG') then 0056 if ( dabs(betap) .le. breakpts(1) ) then 0057 result = careas(1) VMAREA 1-Jun-1993 15:41:00 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:49:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.FOR;13 0058 goto 9999 0059 else if ( dabs(betap) .ge. breakpts(2) ) then 0060 result = careas(2) 0061 goto 9999 0062 end if 0063 end if 0064 0065 jlow = -100 0066 0067 do j=-90,89 0068 x1 = vmatab(1,j) 0069 x2 = vmatab(1,j+1) 0070 if (x2.lt.x1) then 0071 xtemp = x1 0072 x1 = x2 0073 x2 = xtemp 0074 end if 0075 0076 if ( (x1.le.betap).and.(betap.le.x2)) then 0077 jlow = j 0078 jhi = j+1 0079 end if 0080 0081 end do 0082 0083 if (jlow .lt. -90) then 0084 write(8,*) 'Invalid Betap = ',betap 0085 stop 'Invalid Betap in VMA model.' 0086 end if 0087 0088 C 0089 C determine beta primes and areas for interpolation into table 0090 C 0091 betalo = vmatab(1,jlow) 0092 betahi = vmatab(1,jhi) 0093 0094 alow = vmatab(iarea, jlow) 0095 ahi = vmatab(iarea, jhi) 0096 C 0097 C linearly interpolate for the area 0098 C 0099 RESULT = alow + (ahi-alow)*(betap-betalo)/(betahi-betalo) 0100 0101 C WRITE(8,*) 'BETAP:',BETAP 0102 C WRITE(8,*) 'BETA BOUNDS:', BETAHI,BETALO 0103 C WRITE(8,*) 'BOUNDING AREAS:',ALOW,AHI 0104 C WRITE(8,*) 'INTERPOLATED AREA:',RESULT 0105 C 0106 0107 9999 continue 0108 0109 C write (8,*) betap,' ', result 0110 0111 VMAREA = RESULT 0112 return 0113 end VMAREA 1-Jun-1993 15:41:00 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:49:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.FOR;13 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 540 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 225 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 116 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD 3 VMA 4376 PIC OVR REL GBL SHR NOEXE RD WRT QUAD 4 DRAGBLOCK 36 PIC OVR REL GBL SHR NOEXE RD WRT QUAD Total Space Allocated 5293 ENTRY POINTS Address Type Name 0-00000000 R*8 VMAREA VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 AHI ** R*8 ALO ** R*4 ALOW 4-0000001C R*8 ATDEN 4-00000012 CHAR ATMOS ** R*8 BETAHI ** R*8 BETALO AP-00000004@ R*8 BETAP 4-0000000A R*8 DRAGAREA 4-00000000 CHAR DRAGMODEL 2-00000010 L*4 FIRST 2-00000014 I*4 IAREA ** I*4 J 2-00000018 I*4 JHI ** I*4 JLOW AP-00000008@ CHAR MODEL 2-00000008 R*8 RESULT ** R*4 VMARAEA ** R*8 X1 ** R*8 X2 ** R*8 XTEMP ARRAYS Address Type Name Bytes Dimensions 3-00001108 R*8 BREAKPTS 16 (2) 3-000010F8 R*8 CAREAS 16 (2) 3-00000000 R*8 VMATAB 4344 (3, -90:90) LABELS Address Label 0-000001D0 9999 VMAREA 1-Jun-1993 15:41:00 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 21:49:24 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.FOR;13 COMMAND QUALIFIERS FOR/LIS VMAREA.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMAREA.OBJ;2 COMPILATION STATISTICS Run Time: 0.52 seconds Elapsed Time: 2.64 seconds Page Faults: 271 Dynamic Memory: 536 pages 1-Jun-1993 15:41:07 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:50:02 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMSDATE.FOR;7 0001 subroutine vmsdate ( thedate ) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 character * 9 thedate 0012 call date ( thedate ) 0013 return 0014 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 26 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 42 ENTRY POINTS Address Type Name 0-00000000 VMSDATE VARIABLES Address Type Name AP-00000004@ CHAR THEDATE FUNCTIONS AND SUBROUTINES REFERENCED Type Name FOR$DATE_T_DS VMSDATE 1-Jun-1993 15:41:07 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:50:02 NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMSDATE.FOR;7 COMMAND QUALIFIERS FOR/LIS VMSDATE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMSDATE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]VMSDATE.OBJ;2 COMPILATION STATISTICS Run Time: 0.13 seconds Elapsed Time: 2.83 seconds Page Faults: 239 Dynamic Memory: 460 pages 1-Jun-1993 15:41:13 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:50:35 [SHAPIRO.COSMIC.SOURCE]WRITE_CURVE.FOR;5 0001 C$Procedure write_curve 0002 C 0003 SUBROUTINE write_curve ( unit, n, xin, yin, stylei ) 0004 C 0005 C******************************************************************************* 0006 C 0007 C Copyright (C) 1993, California Institute of Technology. U.S. 0008 C Government Sponsorhip under NASA Contract NAS7-918 is 0009 C acknowledged. 0010 C 0011 C******************************************************************************* 0012 C 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 10-11-91 B. Shapiro creation 0019 C 0020 C$ Purpose 0021 C writes a curve to an EZPLOT output file 0022 0023 C Input Parameters 0024 C Name Type Dim Units Description 0025 C ----------------------------------------------------------------------------- 0026 C UNIT I 1 - Fortran unit of plot file 0027 C n I n 0028 C xin r4 n - x coordinates of line 0029 C yin r4 n - y coordinates of line 0030 C stylei i 1 - ezplot line style 0031 C 0032 C Namelist: $ZLINE: defines boundary curves 0033 C Name Type Dim Units Description 0034 C ----------------------------------------------------------------------------- 0035 C npts i 1 - number of points 0036 C x r4 n - x coordinates of line 0037 C y r4 n - y coordinates of line 0038 C style i 1 - ezplot line style 0039 C 0040 C 0041 C$ Restrictions 0042 C 0043 C assumes unit is open for the plot file 0044 C 0045 0046 double precision mxnode 0047 parameter (mxnode = 20000) 0048 0049 integer npts, style, unit, stylei, n 0050 real xin(n), yin(n) 0051 real x(mxnode), y(mxnode) 0052 0053 NAMELIST / ZLINE / npts, style, x, y 0054 0055 npts = n 0056 style = stylei 0057 WRITE_CURVE 1-Jun-1993 15:41:13 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:50:35 [SHAPIRO.COSMIC.SOURCE]WRITE_CURVE.FOR;5 0058 do i = 1, npts 0059 x(i) = xin(i) 0060 y(i) = yin(i) 0061 end do 0062 do i = npts+1, mxnode 0063 x(i) = 0.0 0064 y(i) = 0.0 0065 end do 0066 0067 WRITE(unit,ZLINE) 0068 0069 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 254 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 21 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 160208 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 160483 ENTRY POINTS Address Type Name 0-00000000 WRITE_CURVE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I AP-00000008@ I*4 N 2-00027100 I*4 NPTS 2-00027104 I*4 STYLE AP-00000014@ I*4 STYLEI AP-00000004@ I*4 UNIT ARRAYS Address Type Name Bytes Dimensions 2-00000000 R*4 X 80000 (20000) AP-0000000C@ R*4 XIN ** (*) 2-00013880 R*4 Y 80000 (20000) AP-00000010@ R*4 YIN ** (*) WRITE_CURVE 1-Jun-1993 15:41:13 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:50:35 [SHAPIRO.COSMIC.SOURCE]WRITE_CURVE.FOR;5 NAMELISTS Address Name 2-00027108 ZLINE COMMAND QUALIFIERS FOR/LIS WRITE_CURVE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_CURVE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_CURVE.OBJ;2 COMPILATION STATISTICS Run Time: 0.29 seconds Elapsed Time: 2.36 seconds Page Faults: 226 Dynamic Memory: 472 pages 1-Jun-1993 15:41:19 VAX FORTRAN V5.6-119 Page 1 26-Feb-1993 16:47:03 [SHAPIRO.COSMIC.SOURCE]WRITE_LABEL.FOR;10 0001 C$Procedure Write_label 0002 C 0003 SUBROUTINE WRITE_LABEL ( unit, xtxti, ytxti, texti ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C Oct 11, 1991 B. Shapiro 0019 C 0020 C$ Purpose 0021 C writes a label at a specified position on a plot to 0022 C an EZPLOT output file 0023 C 0024 C Input Parameters 0025 C Name Type Dim Units Description 0026 C ----------------------------------------------------------------------------- 0027 C UNIT I 1 - Fortran unit of plot file 0028 C XTXTi I 1 - Location of text string, x coordinate 0029 C YTXTi I 1 - Location of text string, y coordinate 0030 C TEXTi c*100 1 - character string to be written 0031 C 0032 C 0033 C Namelist: $ZLINE: defines boundary curves 0034 C Name Type Dim Units Description 0035 C ----------------------------------------------------------------------------- 0036 C XTXT I 1 - Location of text string, x coordinate 0037 C YTXT I 1 - Location of text string, y coordinate 0038 C TEXT c*100 1 - character string to be written 0039 C 0040 C 0041 C$ Restrictions 0042 C 0043 C assumes unit is open for the plot file 0044 C 0045 real xtxt, ytxt 0046 character*100 text 0047 integer unit 0048 real xtxti, ytxti 0049 character*(*) texti 0050 0051 NAMELIST / ZLINE / xtxt, ytxt, text 0052 0053 xtxt = xtxti 0054 ytxt = ytxti 0055 text = texti 0056 WRITE(unit,ZLINE) 0057 WRITE_LABEL 1-Jun-1993 15:41:19 VAX FORTRAN V5.6-119 Page 2 26-Feb-1993 16:47:03 [SHAPIRO.COSMIC.SOURCE]WRITE_LABEL.FOR;10 0058 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 62 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 21 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 172 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 255 ENTRY POINTS Address Type Name 0-00000000 WRITE_LABEL VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000000 CHAR TEXT AP-00000010@ CHAR TEXTI AP-00000004@ I*4 UNIT 2-00000064 R*4 XTXT AP-00000008@ R*4 XTXTI 2-00000068 R*4 YTXT AP-0000000C@ R*4 YTXTI NAMELISTS Address Name 2-0000006C ZLINE COMMAND QUALIFIERS FOR/LIS WRITE_LABEL.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LABEL.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LABEL.OBJ;2 WRITE_LABEL 1-Jun-1993 15:41:19 VAX FORTRAN V5.6-119 Page 3 01 26-Feb-1993 16:47:03 [SHAPIRO.COSMIC.SOURCE]WRITE_LABEL.FOR;10 COMPILATION STATISTICS Run Time: 0.29 seconds Elapsed Time: 1.78 seconds Page Faults: 201 Dynamic Memory: 456 pages 1-Jun-1993 15:41:23 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:53:04 WRITE_LABELED_CURVE.FOR;1 0001 subroutine write_labeled_curve ( unit, npts, xdata, ydata, 0002 & linetype, xtext, ytext, dnode) 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C writes a curve to an ezplot file and labels it 0013 C the parameters are the same as in write_curve and write_label 0014 C 0015 integer unit, npts, linetype 0016 character*(*) dnode 0017 real xdata(npts), ydata(npts) 0018 real xtxt, ytxt, xtext 0019 character*25 text 0020 namelist /zline/xtxt, ytxt, text 0021 0022 xtxt = xtext 0023 ytxt = ytext 0024 text = dnode 0025 write( unit, zline) 0026 0027 call write_curve(unit, npts, xdata, ydata, linetype) 0028 0029 return 0030 end WRITE_LABELED_CURVE 1-Jun-1993 15:41:23 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:53:04 WRITE_LABELED_CURVE.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 139 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 21 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 204 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 364 ENTRY POINTS Address Type Name 0-00000000 WRITE_LABELED_CURVE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000020@ CHAR DNODE AP-00000014@ I*4 LINETYPE AP-00000008@ I*4 NPTS 2-00000000 CHAR TEXT AP-00000004@ I*4 UNIT AP-00000018@ R*4 XTEXT 2-0000001C R*4 XTXT AP-0000001C@ R*4 YTEXT 2-00000020 R*4 YTXT ARRAYS Address Type Name Bytes Dimensions AP-0000000C@ R*4 XDATA ** (*) AP-00000010@ R*4 YDATA ** (*) NAMELISTS Address Name 2-00000024 ZLINE FUNCTIONS AND SUBROUTINES REFERENCED Type Name WRITE_CURVE WRITE_LABELED_CURVE 1-Jun-1993 15:41:23 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:53:04 WRITE_LABELED_CURVE.FOR;1 COMMAND QUALIFIERS FOR/LIS WRITE_LABELED_CURVE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LABELED_CURVE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LABELED_CURVE.OBJ;2 COMPILATION STATISTICS Run Time: 0.18 seconds Elapsed Time: 1.78 seconds Page Faults: 227 Dynamic Memory: 472 pages 1-Jun-1993 15:41:28 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:54:34 [SHAPIRO.COSMIC.SOURCE]WRITE_LIMITS.FOR;20 0001 subroutine write_limits ( unit, limits, limits_west, 0002 & limits_east ) 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C writes the results of a targeting iteration to the output file 0013 C B. Shapiro 23-sep-1991 0014 C 0015 integer i 0016 integer unit 0017 double precision limits ( 4, 2 ) 0018 double precision limits_west ( 4, 2 ) 0019 double precision limits_east ( 4, 2 ) 0020 character * 13 labels ( 4 ) 0021 0022 data labels / '1st Node', 'Furthest West', 0023 & 'Furthest East', 'Final Node' / 0024 0025 0026 write(unit,200) 0027 write(unit,300) 0028 DO i=1,4 0029 write(unit,500) labels(i), 0030 & (limits(i,j),j=1,2), 0031 & (limits_west(i,j),j=1,2), 0032 & (limits_east(i,j),j=1,2) 0033 end do 0034 write(unit,600) 0035 0036 200 format(' | ', 14x, '| --- Unbiased --- | ', 0037 & ' --- 95% West --- | ', 0038 & ' --- 95% East --- |') 0039 300 format(' | ',14x,'|',3(5x,'Time',7x,'GT |')) 0040 500 format(' | ',a13,' |' 3(2f9.5, ' |') ) 0041 600 format(' |',t78,'|', / ,' ',77('-')) 0042 0043 return 0044 end WRITE_LIMITS 1-Jun-1993 15:41:28 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:54:34 [SHAPIRO.COSMIC.SOURCE]WRITE_LIMITS.FOR;20 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 265 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 155 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 120 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 540 ENTRY POINTS Address Type Name 0-00000000 WRITE_LIMITS VARIABLES Address Type Name Address Type Name Address Type Name ** I*4 I ** I*4 J AP-00000004@ I*4 UNIT ARRAYS Address Type Name Bytes Dimensions 2-00000000 CHAR LABELS 52 (4) AP-00000008@ R*8 LIMITS 64 (4, 2) AP-00000010@ R*8 LIMITS_EAST 64 (4, 2) AP-0000000C@ R*8 LIMITS_WEST 64 (4, 2) LABELS Address Label Address Label Address Label Address Label 1-00000000 200' 1-0000004B 300' 1-0000006B 500' 1-00000085 600' 1-Jun-1993 15:41:28 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 21:54:34 [SHAPIRO.COSMIC.SOURCE]WRITE_LIMITS.FOR;20 0001 0002 C double precision limits ( 4, 2 ) 0003 C double precision limits_west ( 4, 2 ) 0004 C double precision limits_east ( 4, 2 ) 0005 C data limits /1,2,3,4,5,6,7,8/ 0006 C data limits_west/11,12,13,14,15,16,17,18/ 0007 C data limits_east/101,102,103,104,105,106,107,108/ 0008 C call write_limits ( 6, limits, limits_west, 0009 C & limits_east ) 0010 C stop 0011 C end COMMAND QUALIFIERS FOR/LIS WRITE_LIMITS.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LIMITS.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LIMITS.OBJ;2 COMPILATION STATISTICS Run Time: 0.34 seconds Elapsed Time: 1.81 seconds Page Faults: 225 Dynamic Memory: 472 pages 1-Jun-1993 15:41:33 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:55:33 [SHAPIRO.COSMIC.SOURCE]WRITE_LINE.FOR;5 0001 C$Procedure write_line 0002 C 0003 SUBROUTINE write_line ( unit,x1, x2, y1, y2, stylei ) 0004 C 0005 C 0006 C******************************************************************************* 0007 C 0008 C Copyright (C) 1993, California Institute of Technology. U.S. 0009 C Government Sponsorhip under NASA Contract NAS7-918 is 0010 C acknowledged. 0011 C 0012 C******************************************************************************* 0013 C 0014 C$ Log 0015 C 0016 C Date Name Description 0017 C ----------------------------------------------------------------------------- 0018 C 10-11-91 B. Shapiro creation 0019 C 0020 C$ Purpose 0021 C writes a 2-point line to an EZPLOT output file. The two points 0022 C specify the endpoints of the straight line plotted. 0023 C 0024 C Input Parameters 0025 C Name Type Dim Units Description 0026 C ----------------------------------------------------------------------------- 0027 C UNIT I 1 - Fortran unit of plot file 0028 C x1, x2 dp n - x coordinates of line 0029 C y1, y2 dp n - y coordinates of line 0030 C stylei i 1 - ezplot line style 0031 C 0032 C Namelist: $ZLINE: defines boundary curves 0033 C Name Type Dim Units Description 0034 C ----------------------------------------------------------------------------- 0035 C npts i 1 - number of points 0036 C x dp n - x coordinates of line 0037 C y dp n - y coordinates of line 0038 C style i 1 - ezplot line style 0039 C 0040 C 0041 C$ Restrictions 0042 C 0043 C assumes unit is open for the plot file 0044 C 0045 0046 integer npts, style, unit, stylei 0047 double precision x1,x2, y1,y2 0048 double precision x(2), y(2) 0049 0050 0051 NAMELIST / ZLINE / npts, style, x, y 0052 0053 npts = 2 0054 style = stylei 0055 0056 x(1) = x1 0057 x(2) = x2 WRITE_LINE 1-Jun-1993 15:41:33 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 21:55:33 [SHAPIRO.COSMIC.SOURCE]WRITE_LINE.FOR;5 0058 Y(1) = y1 0059 Y(2) = y2 0060 0061 WRITE(unit,ZLINE) 0062 0063 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 58 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 21 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 160 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 239 ENTRY POINTS Address Type Name 0-00000000 WRITE_LINE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000020 I*4 NPTS 2-00000024 I*4 STYLE AP-00000018@ I*4 STYLEI AP-00000004@ I*4 UNIT AP-00000008@ R*8 X1 AP-0000000C@ R*8 X2 AP-00000010@ R*8 Y1 AP-00000014@ R*8 Y2 ARRAYS Address Type Name Bytes Dimensions 2-00000000 R*8 X 16 (2) 2-00000010 R*8 Y 16 (2) NAMELISTS Address Name 2-00000028 ZLINE WRITE_LINE 1-Jun-1993 15:41:33 VAX FORTRAN V5.6-119 Page 3 01 21-Jan-1993 21:55:33 [SHAPIRO.COSMIC.SOURCE]WRITE_LINE.FOR;5 COMMAND QUALIFIERS FOR/LIS WRITE_LINE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LINE.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]WRITE_LINE.OBJ;2 COMPILATION STATISTICS Run Time: 0.29 seconds Elapsed Time: 2.25 seconds Page Faults: 215 Dynamic Memory: 456 pages 1-Jun-1993 15:41:38 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 21:57:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNO.FOR;2 0001 character*3 function YesNo ( var ) 0002 C 0003 C******************************************************************************* 0004 C 0005 C Copyright (C) 1993, California Institute of Technology. U.S. 0006 C Government Sponsorhip under NASA Contract NAS7-918 is 0007 C acknowledged. 0008 C 0009 C******************************************************************************* 0010 C 0011 C input var = T output = 'YES' 0012 C var = .false. = ' NO' 0013 C 0014 C Used to "pretty-print" interpretive output of logical parameters. 0015 0016 logical var 0017 if (var) then 0018 YesNo = 'Yes' 0019 else 0020 YesNo = ' No' 0021 end if 0022 return 0023 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 42 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 6 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 8 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 56 ENTRY POINTS Address Type Name 0-00000000 CHAR YESNO VARIABLES Address Type Name AP-00000008@ L*4 VAR YESNO 1-Jun-1993 15:41:38 VAX FORTRAN V5.6-119 Page 2 01 21-Jan-1993 21:57:11 NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNO.FOR;2 COMMAND QUALIFIERS FOR/LIS YESNO.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNO.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNO.OBJ;2 COMPILATION STATISTICS Run Time: 0.17 seconds Elapsed Time: 1.97 seconds Page Faults: 198 Dynamic Memory: 456 pages 1-Jun-1993 15:41:43 VAX FORTRAN V5.6-119 Page 1 24-Feb-1993 21:45:03 [SHAPIRO.COSMIC.SOURCE]YESNOSTRING.FOR;3 0001 character*20 function YesNoString ( var, 0002 & TrueString, FalseString ) 0003 C 0004 C******************************************************************************* 0005 C 0006 C Copyright (C) 1993, California Institute of Technology. U.S. 0007 C Government Sponsorhip under NASA Contract NAS7-918 is 0008 C acknowledged. 0009 C 0010 C******************************************************************************* 0011 C 0012 C input var = T output = TrueSTring 0013 C var = .false. = FalseString 0014 C 0015 C Used to "pretty-print" interpretive output of logical parameters. 0016 0017 character*20 TrueString, FalseString, result 0018 logical var 0019 if (var) then 0020 Result = TrueString 0021 else 0022 Result = FalseString 0023 end if 0024 YesNoString = Result 0025 return 0026 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 61 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 44 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 105 ENTRY POINTS Address Type Name 0-00000000 CHAR YESNOSTRING VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000010@ CHAR FALSESTRING 2-00000000 CHAR RESULT AP-0000000C@ CHAR TRUESTRING AP-00000008@ L*4 VAR YESNOSTRING 1-Jun-1993 15:41:43 VAX FORTRAN V5.6-119 Page 2 01 24-Feb-1993 21:45:03 [SHAPIRO.COSMIC.SOURCE]YESNOSTRING.FOR;3 COMMAND QUALIFIERS FOR/LIS YESNOSTRING.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNOSTRING.LIS;2 /OBJECT=NAVDEV:[SHAPIRO.COSMIC.SOURCE]YESNOSTRING.OBJ;2 COMPILATION STATISTICS Run Time: 0.24 seconds Elapsed Time: 1.72 seconds Page Faults: 213 Dynamic Memory: 456 pages 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 1 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C******************************************************************************* 0002 C 0003 C Copyright (C) 1993, California Institute of Technology. U.S. 0004 C Government Sponsorhip under NASA Contract NAS7-918 is 0005 C acknowledged. 0006 C 0007 C******************************************************************************* 0008 C Procedure CAL2CH 0009 C 0010 CHARACTER*(*) FUNCTION CAL2CH( YEAR, MONTH, DAY, 0011 * HOUR, MINUTE, SECOND, FRAC ) 0012 C 0013 C 0014 C Purpose 0015 C 0016 C This subroutine (CALendar date 2 CHaracter string) takes the various 0017 C components of an input calendar date and returns as its functional va 0018 C the equivalent time in the character*25 format 'DD-MMM-YYYY HH:MM:SS. 0019 C 0020 C If the user wishes to display only some initial segment of the calend 0021 C date, he may do so with his declaration of CAL2CH. For example, if he 0022 C wants to display 'DD-MMM-YYYY HH:MM:SS' then he may declare the funct 0023 C CAL2CH to be character*20. 0024 C 0025 C 0026 C Input_Arguments 0027 C 0028 C YEAR is the year. 0029 C MONTH is the month number. 0030 C DAY is the day. 0031 C HOUR is the hour. 0032 C MINUTE is the minute. 0033 C SECOND is the second. 0034 C FRAC is the fractional seconds. 0035 C 0036 C 0037 C Declarations_of_External_Functions 0038 C 0039 CHARACTER*5 INT2CH 0040 C 0041 C 0042 C Declarations_of_Input_and_Output_Arguments 0043 C 0044 INTEGER YEAR 0045 INTEGER MONTH 0046 INTEGER DAY 0047 INTEGER HOUR 0048 INTEGER MINUTE 0049 INTEGER SECOND 0050 DOUBLE PRECISION FRAC 0051 C 0052 C 0053 C Declarations_of_Local_Variables 0054 C 0055 CHARACTER*3 MONTHS(12) 0056 C 0057 CHARACTER*3 STR CAL2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 2 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 CHARACTER*31 NEWTIM 0059 DOUBLE PRECISION TEMP 0060 INTEGER NDIGIT 0061 INTEGER IDIGIT 0062 C 0063 C 0064 SAVE MONTHS 0065 C 0066 C Data_Statements 0067 C 0068 DATA MONTHS( 1) /'JAN'/ 0069 DATA MONTHS( 2) /'FEB'/ 0070 DATA MONTHS( 3) /'MAR'/ 0071 DATA MONTHS( 4) /'APR'/ 0072 DATA MONTHS( 5) /'MAY'/ 0073 DATA MONTHS( 6) /'JUN'/ 0074 DATA MONTHS( 7) /'JUL'/ 0075 DATA MONTHS( 8) /'AUG'/ 0076 DATA MONTHS( 9) /'SEP'/ 0077 DATA MONTHS(10) /'OCT'/ 0078 DATA MONTHS(11) /'NOV'/ 0079 DATA MONTHS(12) /'DEC'/ 0080 C 0081 C 0082 C Method 0083 C-& 0084 C*********************************************************************** 0085 C 0086 C1 Check to see if the input calendar date is out of bounds. 0087 IF( YEAR .LT. 0 )THEN 0088 CAL2CH = 'DISTANT-PAST' 0089 RETURN 0090 ELSEIF( YEAR .GT. 9999 )THEN 0091 CAL2CH = 'DISTANT-FUTURE' 0092 RETURN 0093 END IF 0094 C 0095 C------------------------------ 0096 C 0097 C1 Convert the time from integers to characters. 0098 C 0099 C2 Fractional seconds 0100 NDIGIT = MIN( LEN(CAL2CH), LEN(NEWTIM) ) - 21 0101 TEMP = FRAC 0102 DO 20005 I = 1,NDIGIT 0103 TEMP = 10.0D0 * MOD( TEMP, 1.0D0 ) 0104 IDIGIT = INT( TEMP ) 0105 NEWTIM(21+I:21+I) = INT2CH( IDIGIT ) 0106 20005 CONTINUE 0107 NEWTIM(21:21) = '.' 0108 C 0109 C2 Second 0110 NEWTIM(18:20) = INT2CH( SECOND + 100 ) 0111 NEWTIM(18:18) = ':' 0112 C 0113 C2 Minute 0114 NEWTIM(15:17) = INT2CH( MINUTE + 100 ) CAL2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 3 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0115 NEWTIM(15:15) = ':' 0116 C 0117 C2 Hour 0118 NEWTIM(12:14) = INT2CH( HOUR + 100 ) 0119 NEWTIM(12:12) = ' ' 0120 C 0121 C2 Year 0122 NEWTIM(8:11) = INT2CH( YEAR ) 0123 NEWTIM(7:7) = '-' 0124 C 0125 C2 Month 0126 NEWTIM(4:6) = MONTHS( MONTH ) 0127 NEWTIM(3:3) = '-' 0128 C 0129 C2 Day 0130 STR = INT2CH( DAY + 100 ) 0131 IF ( STR(2:2) .EQ. '0' ) STR(2:2) = ' ' 0132 NEWTIM(1:2) = STR(2:3) 0133 C 0134 C 0135 C1 Return the converted time string. 0136 CAL2CH = NEWTIM 0137 C 0138 RETURN 0139 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 394 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 34 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 228 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 656 ENTRY POINTS Address Type Name 0-00000000 CHAR CAL2CH VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000010@ I*4 DAY AP-00000020@ R*8 FRAC AP-00000014@ I*4 HOUR ** I*4 I 2-00000050 I*4 IDIGIT AP-00000018@ I*4 MINUTE AP-0000000C@ I*4 MONTH ** I*4 NDIGIT 2-00000027 CHAR NEWTIM AP-0000001C@ I*4 SECOND 2-00000024 CHAR STR 2-00000048 R*8 TEMP AP-00000008@ I*4 YEAR CAL2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 4 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 ARRAYS Address Type Name Bytes Dimensions 2-00000000 CHAR MONTHS 36 (12) LABELS Address Label ** 20005 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name CHAR INT2CH R*8 MTH$DMOD 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 5 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CAL2JD 0002 C 0003 DOUBLE PRECISION FUNCTION CAL2JD 0004 * ( YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC ) 0005 C 0006 C 0007 C Purpose 0008 C 0009 C This double precision function (CALendar date to Julian Date) takes t 0010 C components of a calendar date and time 0011 C 0012 C Year / Month / Day , Hour : Minute : Second.Frac 0013 C 0014 C and returns the corresponding Julian date. 0015 C 0016 C The values for MONTH, DAY, HOUR, MINUTE, SECOND, and FRACtional secon 0017 C not have to lie within the usual range, i.e., MONTH=13 and DAY=212 ar 0018 C legitimate. 0019 C 0020 C 0021 C Input_Arguments 0022 C 0023 C YEAR is the year. 0024 C MONTH is the month number. 0025 C DAY is the day. 0026 C HOUR is the hour. 0027 C MINUTE is the minute. 0028 C SECOND is the second. 0029 C FRAC is the fractional seconds. 0030 C 0031 C 0032 C Output_Arguments 0033 C 0034 C Declarations_of_External_Functions 0035 C 0036 INTEGER DATE2J 0037 C 0038 C 0039 C Declarations_of_Input_and_Output_Arguments 0040 C 0041 INTEGER YEAR 0042 INTEGER MONTH 0043 INTEGER DAY 0044 INTEGER HOUR 0045 INTEGER MINUTE 0046 INTEGER SECOND 0047 DOUBLE PRECISION FRAC 0048 C 0049 C 0050 C Declarations_of_Local_Variables 0051 C 0052 C Method 0053 C-& 0054 C*********************************************************************** 0055 C 0056 C1 Call DATE2J to convert the date (year, month, day) to the integer 0057 C1 Julian date at noon of that day. CAL2JD 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 6 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 CAL2JD = DATE2J( YEAR, MONTH, DAY ) - 0.5D0 + 0059 * (3600.D0*HOUR + 60.D0*MINUTE + SECOND + FRAC) / 86400.D0 0060 C 0061 RETURN 0062 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 92 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 24 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 116 ENTRY POINTS Address Type Name 0-00000000 R*8 CAL2JD VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000000C@ I*4 DAY AP-0000001C@ R*8 FRAC AP-00000010@ I*4 HOUR AP-00000014@ I*4 MINUTE AP-00000008@ I*4 MONTH AP-00000018@ I*4 SECOND AP-00000004@ I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 DATE2J 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 7 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CALSEC 0002 C 0003 DOUBLE PRECISION FUNCTION CALSEC 0004 * ( YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC ) 0005 C 0006 C 0007 C Purpose 0008 C 0009 C This double precision function (CALendar date to SEConds) takes the 0010 C components of a calendar date and time 0011 C 0012 C Year / Month / Day , Hour : Minute : Second.Frac 0013 C 0014 C and returns the corresponding seconds past the reference date (JDREF) 0015 C this library. 0016 C 0017 C 0018 C Input_Arguments 0019 C 0020 C YEAR is the year. 0021 C MONTH is the month number. 0022 C DAY is the day. 0023 C HOUR is the hour. 0024 C MINUTE is the minute. 0025 C SECOND is the second. 0026 C FRAC is the fractional seconds. 0027 C 0028 C 0029 C Output_Arguments 0030 C 0031 C Declarations_of_External_Functions 0032 C 0033 INTEGER DATE2J 0034 DOUBLE PRECISION JD2SEC 0035 C 0036 C 0037 C Declarations_of_Input_and_Output_Arguments 0038 C 0039 INTEGER YEAR 0040 INTEGER MONTH 0041 INTEGER DAY 0042 INTEGER HOUR 0043 INTEGER MINUTE 0044 INTEGER SECOND 0045 DOUBLE PRECISION FRAC 0046 C 0047 C 0048 C Declarations_of_Local_Variables 0049 C 0050 DOUBLE PRECISION JD 0051 C 0052 C 0053 C Method 0054 C-& 0055 C*********************************************************************** 0056 C 0057 C1 Call DATE2J to compute the double precision Julian date at the start CALSEC 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 8 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C1 the current day. 0059 JD = DATE2J( YEAR, MONTH, DAY ) - 0.5D0 0060 C 0061 C1 Call JD2SEC to compute the seconds past the reference date at the st 0062 C1 of the current day and then add in the seconds in the remaining frac 0063 C1 day. 0064 CALSEC = JD2SEC( JD ) 0065 * + HOUR * 3600.0D0 0066 * + MINUTE * 60.0D0 0067 * + SECOND 0068 * + FRAC 0069 C 0070 RETURN 0071 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 87 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 40 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 127 ENTRY POINTS Address Type Name 0-00000000 R*8 CALSEC VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-0000000C@ I*4 DAY AP-0000001C@ R*8 FRAC AP-00000010@ I*4 HOUR 2-00000008 R*8 JD AP-00000014@ I*4 MINUTE AP-00000008@ I*4 MONTH AP-00000018@ I*4 SECOND AP-00000004@ I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 DATE2J R*8 JD2SEC 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 9 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CASCHG 0002 C 0003 SUBROUTINE CASCHG( INSTR, OUTSTR ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This subroutine (CASe CHanGe) will take an input character string and 0009 C all occurances of lowercase letters with the corresponding uppercase 0010 C 0011 C 0012 C Input_Arguments 0013 C 0014 C INSTR is the input character string. 0015 C 0016 C 0017 C Output_Arguments 0018 C 0019 C OUTSTR is the output character string. This string may the same as 0020 C input string. 0021 C 0022 C 0023 C Declarations_of_External_Functions 0024 C 0025 C Declarations_of_Input_and_Output_Arguments 0026 C 0027 CHARACTER*(*) INSTR 0028 CHARACTER*(*) OUTSTR 0029 C 0030 C 0031 C Declarations_of_Local_Variables 0032 C 0033 CHARACTER*26 LOWER 0034 CHARACTER*26 UPPER 0035 C 0036 C 0037 C Data_Statements 0038 C 0039 DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/ 0040 DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ 0041 C 0042 C 0043 C Method 0044 C-& 0045 C*********************************************************************** 0046 C 0047 OUTSTR = INSTR 0048 C 0049 DO 20002 I = 1,MIN( LEN(INSTR), LEN(OUTSTR) ) 0050 N = INDEX( LOWER, OUTSTR(I:I) ) 0051 IF ( N .GT. 0 ) OUTSTR(I:I) = UPPER(N:N) 0052 20002 CONTINUE 0053 C 0054 RETURN 0055 END CASCHG 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 10 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 104 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 96 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 200 ENTRY POINTS Address Type Name 0-00000000 CASCHG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 I AP-00000004@ CHAR INSTR 2-00000000 CHAR LOWER ** I*4 N AP-00000008@ CHAR OUTSTR 2-0000001A CHAR UPPER LABELS Address Label ** 20002 FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 LIB$INDEX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 11 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CH2CAL 0002 C 0003 SUBROUTINE CH2CAL( STRING, MSG, 0004 * YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC, 0005 * ERROR ) 0006 C 0007 C 0008 C Purpose 0009 C 0010 C This subroutine (CHaracter string 2 CALendar date) will parse an inpu 0011 C character string containing the date and time in the format 0012 C 'DD-MMM-YYYY HH:MM:SS.FFFF' and return the seven components of this d 0013 C and time converted to numbers. 0014 C 0015 C The user may input only an initial segment of the date/time string, b 0016 C the input string must include at least the day, month, and year. 0017 C 0018 C 0019 C Input_Arguments 0020 C 0021 C STRING is the input date and time in the format 0022 C 'DD-MMM-YYYY HH:MM:SS.FFFF'. The fractional seconds, seconds 0023 C minutes, and/or hours may be omitted if their intended value 0024 C zero. 0025 C MSG controls the response to an input error. 0026 C If MSG=true and the input STRING contains a string which can 0027 C be parsed, then an error message is written to the standa 0028 C system output file and the program is terminated with a 0029 C walkback. 0030 C If MSG=false and the input STRING contains a string which ca 0031 C be parsed, no message is written but ERROR=true is return 0032 C 0033 C 0034 C 0035 C 0036 C Output_Arguments 0037 C 0038 C YEAR is the year. 0039 C MONTH is the month number. 0040 C DAY is the day. 0041 C HOUR is the hour. 0042 C MINUTE is the minute. 0043 C SECOND is the second. 0044 C FRAC is the fractional seconds. 0045 C ERROR = true if the input string cannot be parsed; otherwise, 0046 C ERROR=false is returned. 0047 C 0048 C 0049 C Declarations_of_External_Functions 0050 C 0051 INTEGER CH2INT 0052 DOUBLE PRECISION CH2DP 0053 C 0054 C 0055 C Declarations_of_Input_and_Output_Arguments 0056 C 0057 CHARACTER*(*) STRING CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 12 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 LOGICAL MSG 0059 INTEGER YEAR 0060 INTEGER MONTH 0061 INTEGER DAY 0062 INTEGER HOUR 0063 INTEGER MINUTE 0064 INTEGER SECOND 0065 DOUBLE PRECISION FRAC 0066 LOGICAL ERROR 0067 C 0068 C 0069 C Declarations_of_Local_Variables 0070 C 0071 CHARACTER*80 BUFFER 0072 C 0073 INTEGER S 0074 INTEGER E 0075 INTEGER NDIGIT 0076 C 0077 INTEGER INT 0078 C 0079 LOGICAL FIND 0080 C 0081 INTEGER IERROR 0082 CHARACTER*40 ERRMSG(5) 0083 C 0084 CHARACTER*3 MONTHS(12) 0085 C 0086 C 0087 SAVE MONTHS 0088 SAVE ERRMSG 0089 C 0090 C Data_Statements 0091 C 0092 DATA MONTHS( 1) /'JAN'/ 0093 DATA MONTHS( 2) /'FEB'/ 0094 DATA MONTHS( 3) /'MAR'/ 0095 DATA MONTHS( 4) /'APR'/ 0096 DATA MONTHS( 5) /'MAY'/ 0097 DATA MONTHS( 6) /'JUN'/ 0098 DATA MONTHS( 7) /'JUL'/ 0099 DATA MONTHS( 8) /'AUG'/ 0100 DATA MONTHS( 9) /'SEP'/ 0101 DATA MONTHS(10) /'OCT'/ 0102 DATA MONTHS(11) /'NOV'/ 0103 DATA MONTHS(12) /'DEC'/ 0104 C 0105 DATA ERRMSG(1) /'Name of month not found'/ 0106 DATA ERRMSG(2) /'Year not found'/ 0107 DATA ERRMSG(3) /'Too many digits in fractional seconds'/ 0108 DATA ERRMSG(4) /'No decimal before fractional seconds'/ 0109 DATA ERRMSG(5) /'Too many digits in integer'/ 0110 C 0111 C 0112 C Method 0113 C-& 0114 C*********************************************************************** CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 13 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0115 C1 Main Routine 0116 C*********************************************************************** 0117 C 0118 ERROR = .FALSE. 0119 C 0120 CALL CASCHG( STRING, BUFFER ) 0121 C 0122 GO TO 30001 0123 C 0124 20002 GO TO 30002 0125 C 0126 20003 GO TO 30003 0127 C 0128 20004 GO TO 30004 0129 C 0130 20005 GO TO 30005 0131 C 0132 20006 GO TO 30006 0133 C 0134 20007 GO TO 30007 0135 C 0136 20008 RETURN 0137 C 0138 C*********************************************************************** 0139 C1 Procedures 0140 C*********************************************************************** 0141 C 0142 C PROCEDURE (GET DAY NUMBER) 0143 C 0144 30001 S = 1 0145 ASSIGN 20009 TO NPR008 0146 GO TO 30008 0147 20009 DAY = INT 0148 C 0149 GO TO 20002 0150 C 0151 C*********************************************************************** 0152 C 0153 C PROCEDURE (GET MONTH NUMBER) 0154 C 0155 30002 S = E + 1 0156 C 0157 DO 20011 I = 1,12 0158 N = INDEX( BUFFER(S:), MONTHS(I) ) 0159 IF( N .GT. 0 )THEN 0160 MONTH = I 0161 E = S + N 0162 GO TO 20010 0163 END IF 0164 20011 CONTINUE 0165 IERROR = 1 0166 ASSIGN 20016 TO NPR009 0167 GO TO 30009 0168 C 0169 20016 CONTINUE 0170 20010 GO TO 20003 0171 C CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 14 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0172 C*********************************************************************** 0173 C 0174 C PROCEDURE (GET YEAR) 0175 C 0176 30003 S = E + 1 0177 ASSIGN 20017 TO NPR008 0178 GO TO 30008 0179 20017 YEAR = INT 0180 IF (.NOT.( YEAR .LE. 0 )) GO TO 20019 0181 IERROR = 2 0182 ASSIGN 20020 TO NPR009 0183 GO TO 30009 0184 C 0185 20020 CONTINUE 0186 20019 GO TO 20004 0187 C 0188 C*********************************************************************** 0189 C 0190 C PROCEDURE (GET HOURS) 0191 C 0192 30004 S = E + 1 0193 ASSIGN 20021 TO NPR008 0194 GO TO 30008 0195 20021 HOUR = INT 0196 C 0197 GO TO 20005 0198 C 0199 C*********************************************************************** 0200 C 0201 C PROCEDURE (GET MINUTES) 0202 C 0203 30005 S = E + 1 0204 ASSIGN 20022 TO NPR008 0205 GO TO 30008 0206 20022 MINUTE = INT 0207 C 0208 GO TO 20006 0209 C 0210 C*********************************************************************** 0211 C 0212 C PROCEDURE (GET INTEGRAL SECONDS) 0213 C 0214 30006 S = E + 1 0215 ASSIGN 20023 TO NPR008 0216 GO TO 30008 0217 20023 SECOND = INT 0218 C 0219 GO TO 20007 0220 C 0221 C*********************************************************************** 0222 C 0223 C PROCEDURE (GET FRACTIONAL SECONDS) 0224 C 0225 30007 S = E + 1 0226 C 0227 ASSIGN 20024 TO NPR010 0228 GO TO 30010 CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 15 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0229 C 0230 20024 NDIGIT = E - S + 1 0231 IF (.NOT.( .NOT. FIND )) GO TO 20026 0232 FRAC = 0.0 0233 GO TO 20025 0234 20026 IF (.NOT.( NDIGIT .GT. 10 )) GO TO 20027 0235 IERROR = 3 0236 ASSIGN 20028 TO NPR009 0237 GO TO 30009 0238 20028 GO TO 20025 0239 20027 IF (.NOT.( BUFFER(S-1:S-1) .NE. '.' )) GO TO 20029 0240 IERROR = 4 0241 ASSIGN 20030 TO NPR009 0242 GO TO 30009 0243 20030 GO TO 20025 0244 20029 FRAC = CH2DP( BUFFER(S-1:E) ) 0245 C 0246 20025 GO TO 20008 0247 C 0248 C*********************************************************************** 0249 C 0250 C PROCEDURE (GET NEXT INTEGER INT) 0251 C 0252 30008 ASSIGN 20031 TO NPR010 0253 GO TO 30010 0254 C 0255 20031 NDIGIT = E - S + 1 0256 IF (.NOT.( .NOT. FIND )) GO TO 20033 0257 INT = 0 0258 GO TO 20032 0259 20033 IF (.NOT.( NDIGIT .GT. 10 )) GO TO 20034 0260 IERROR = 5 0261 ASSIGN 20035 TO NPR009 0262 GO TO 30009 0263 20035 GO TO 20032 0264 20034 INT = CH2INT( BUFFER(S:E) ) 0265 C 0266 20032 GO TO NPR008,(20009,20017,20021,20022,20023) 0267 C 0268 C*********************************************************************** 0269 C 0270 C PROCEDURE (FIND START S AND END E OF NEXT DIGIT STRING) 0271 C 0272 30010 N = S 0273 DO 20037 S = N,LEN(STRING) 0274 IF ( INDEX( '1234567890', BUFFER(S:S) ) .GT. 0 ) GO TO 20036 0275 20037 CONTINUE 0276 E = S 0277 FIND = .FALSE. 0278 GO TO 31010 0279 C 0280 20036 DO 20040 E = S+1,LEN(STRING) 0281 IF ( INDEX( '1234567890', BUFFER(E:E) ) .LE. 0 ) GO TO 20041 0282 20040 CONTINUE 0283 20041 E = E - 1 0284 FIND = .TRUE. 0285 C CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 16 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0286 31010 GO TO NPR010,(20024,20031) 0287 C 0288 C*********************************************************************** 0289 C 0290 C PROCEDURE (PROCESS INPUT ERROR) 0291 C 0292 30009 IF(MSG)THEN 0293 WRITE(*,110) STRING, ERRMSG( IERROR ) 0294 110 FORMAT(' ','Error - ''',A,'''', 0295 * /' ',' is not a legitimate date/time string', 0296 * /' ',' ',A) 0297 C CALL HALT 0298 ELSE 0299 ERROR = .TRUE. 0300 RETURN 0301 END IF 0302 C 0303 GO TO NPR009,(20016,20020,20028,20030,20035) 0304 C 0305 C*********************************************************************** 0306 C 0307 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 628 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 97 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 488 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 1213 ENTRY POINTS Address Type Name 0-00000000 CH2CAL VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-000000EC CHAR BUFFER AP-00000014@ I*4 DAY ** I*4 E AP-00000028@ L*4 ERROR ** L*4 FIND AP-00000024@ R*8 FRAC AP-00000018@ I*4 HOUR ** I*4 I ** I*4 IERROR 2-0000013C I*4 INT AP-0000001C@ I*4 MINUTE AP-00000010@ I*4 MONTH AP-00000008@ L*4 MSG ** I*4 N ** I*4 NDIGIT 2-00000140 I*4 NPR008 ** I*4 NPR009 2-00000144 I*4 NPR010 ** I*4 S AP-00000020@ I*4 SECOND AP-00000004@ CHAR STRING AP-0000000C@ I*4 YEAR CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 17 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 ARRAYS Address Type Name Bytes Dimensions 2-00000000 CHAR ERRMSG 200 (5) 2-000000C8 CHAR MONTHS 36 (12) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-0000000B 110' ** 20002 ** 20003 ** 20004 ** 20005 ** 20006 ** 20007 ** 20008 0-000001C4 20009 0-00000204 20010 ** 20011 0-000001C0 20016 0-0000019C 20017 0-000001B0 20019 0-00000198 20020 0-00000184 20021 0-00000170 20022 0-0000015C 20023 0-00000100 20024 0-00000156 20025 0-00000110 20026 0-00000124 20027 0-000000FC 20028 0-0000013C 20029 0-000000F8 20030 0-000000AC 20031 0-000000ED 20032 0-000000BC 20033 0-000000D0 20034 0-000000A8 20035 0-00000060 20036 ** 20037 ** 20040 0-0000008C 20041 ** 30001 ** 30002 ** 30003 ** 30004 ** 30005 ** 30006 ** 30007 0-00000030 30008 0-00000222 30009 0-00000038 30010 0-0000009D 31010 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name CASCHG R*8 CH2DP I*4 CH2INT I*4 LIB$INDEX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 18 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CH2DP 0002 C 0003 DOUBLE PRECISION FUNCTION CH2DP( STRING ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This double precision function (CHaracter 2 Double Precision) takes t 0009 C character string STRING and returns the double precision equivalent. 0010 C string STRING must contain a legitimate number, either floating point 0011 C integer. Any blanks in the input STRING are ignored. 0012 C 0013 C 0014 C Input_Arguments 0015 C 0016 C STRING is a character string. 0017 C 0018 C 0019 C Declarations_of_External_Functions 0020 C 0021 C Declarations_of_Input_and_Output_Arguments 0022 C 0023 CHARACTER*(*) STRING 0024 C 0025 C 0026 C Declarations_of_Local_Variables 0027 C 0028 DOUBLE PRECISION DP 0029 INTEGER ISTAT 0030 C 0031 C 0032 C Data_Statements 0033 C 0034 C Method 0035 C-& 0036 C*********************************************************************** 0037 C1 Main Routine 0038 C*********************************************************************** 0039 C 0040 CALL CH2DPX( STRING, .TRUE., DP, ISTAT ) 0041 C 0042 CH2DP = DP 0043 C 0044 RETURN 0045 END CH2DP 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 19 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 33 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 4 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 48 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 85 ENTRY POINTS Address Type Name 0-00000000 R*8 CH2DP VARIABLES Address Type Name Address Type Name Address Type Name 2-00000008 R*8 DP 2-00000010 I*4 ISTAT AP-00000004@ CHAR STRING FUNCTIONS AND SUBROUTINES REFERENCED Type Name CH2DPX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 20 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Use MAXEXP = INT( LOG10( D1MACH(2) ) ) 0002 C to check if input numbers are out of range??? 0003 C 0004 C 0005 C Procedure CH2DPX 0006 C 0007 SUBROUTINE CH2DPX( CH, MSG, DP, ISTAT ) 0008 C 0009 C 0010 C Purpose 0011 C 0012 C This subroutine (CHaracter 2 Double Precision X) takes the input char 0013 C string CH and returns the double precision numeric equivalent DP. The 0014 C CH must contain a legitimate number, either floating point or integer 0015 C Leading and trailing blanks are ignored but any other character in CH 0016 C is not a digit or an exponent delimiter ('D' or 'E') will cause a fat 0017 C error. In particular, embedded blanks are not allowed. 0018 C 0019 C 0020 C Input_Arguments 0021 C 0022 C CH is the character string to be converted to a double precision 0023 C MSG is a logical flag which controls the response to an error con 0024 C If MSG=.TRUE. and an error is encountered, then an error mess 0025 C written to the standard system output file and the program 0026 C terminated with a walkback. 0027 C If MSG=.FALSE. and an error is encountered, then no error mes 0028 C written but ISTAT<0 is returned. 0029 C 0030 C 0031 C Output_Arguments 0032 C 0033 C DP is the double precision equivalent of the number in the chara 0034 C string CH. 0035 C ISTAT is the error status flag: 0036 C ISTAT=0 if the request was successful. The other output 0037 C arguments are defined. 0038 C ISTAT>0 if the request was successful but some warning co 0039 C prevails that the user may wish to be aware of. T 0040 C other output arguments are defined. 0041 C ISTAT<0 if the request was unsuccessful. The other output 0042 C arguments are undefined and should not be used. 0043 C 0044 C 0045 C Declarations_of_External_Functions 0046 C 0047 DOUBLE PRECISION D1MACH 0048 C 0049 C 0050 C Declarations_of_Input_and_Output_Arguments 0051 C 0052 DOUBLE PRECISION DP 0053 LOGICAL MSG 0054 CHARACTER*(*) CH 0055 INTEGER ISTAT 0056 C 0057 C CH2DPX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 21 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C Declarations_of_Local_Variables 0059 C 0060 PARAMETER ( MAXLEN = 30 ) 0061 C 0062 INTEGER N1 0063 INTEGER N2 0064 INTEGER LENGTH 0065 C 0066 CHARACTER*(MAXLEN) CTEMP1 0067 CHARACTER*(MAXLEN) CTEMP2 0068 C 0069 INTEGER MSGNUM 0070 C 0071 C 0072 SAVE 0073 C 0074 C 0075 C Data_Statements 0076 C 0077 C Method 0078 C-& 0079 C*********************************************************************** 0080 C1 Main Routine 0081 C*********************************************************************** 0082 C 0083 C2 Trim leading and trailing blanks. 0084 DO 20002 N1 = 1,LEN(CH) 0085 IF ( CH(N1:N1) .NE. ' ' ) GO TO 20003 0086 20002 CONTINUE 0087 20003 DO 20005 N2 = LEN(CH),1,-1 0088 IF ( CH(N2:N2) .NE. ' ' ) GO TO 20006 0089 20005 CONTINUE 0090 C 0091 C2 Verify that the trimmed string is not empty. 0092 20006 IF (.NOT.( N1 .GT. N2 )) GO TO 20009 0093 MSGNUM = 1 0094 ASSIGN 20010 TO NPR001 0095 GO TO 30001 0096 C 0097 20010 CONTINUE 0098 20009 LENGTH = N2 - N1 + 1 0099 IF (.NOT.( LENGTH .GT. MAXLEN )) GO TO 20012 0100 MSGNUM = 2 0101 ASSIGN 20013 TO NPR001 0102 GO TO 30001 0103 C 0104 C2 If the input number is an integer, add a decimal point. 0105 20013 CONTINUE 0106 20012 CTEMP1 = CH( N1:N2 ) 0107 IF( INDEX( CTEMP1, '.' ) .EQ. 0 )THEN 0108 CTEMP1 = CTEMP1(:LENGTH) // '.' 0109 LENGTH = LENGTH + 1 0110 END IF 0111 C 0112 C2 Convert the input string to a double precision using a FORTRAN inter 0113 C2 file. 0114 CTEMP2 = ' ' CH2DPX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 22 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0115 CTEMP2( MAXLEN-LENGTH+1: ) = CTEMP1 0116 READ ( UNIT=CTEMP2, FMT='(D30.22)', IOSTAT=IOS ) DP 0117 IF (.NOT.( IOS .GT. 0 )) GO TO 20017 0118 MSGNUM = 3 0119 ASSIGN 20018 TO NPR001 0120 GO TO 30001 0121 C 0122 20018 CONTINUE 0123 20017 RETURN 0124 C 0125 C*********************************************************************** 0126 C1 Procedures 0127 C*********************************************************************** 0128 C 0129 C PROCEDURE (WRITE ERROR MESSAGE NUMBER MSGNUM) 0130 C 0131 30001 IF ( .NOT. MSG) RETURN 0132 C 0133 WRITE(*,*) 'ERROR - Unable to convert string to ', 0134 * 'double precision number' 0135 WRITE(*,*) ' Input string = ', CH 0136 GO TO (20021,20022,20023), MSGNUM 0137 GO TO 20020 0138 20021 WRITE(*,*) ' String is empty' 0139 GO TO 20020 0140 20022 WRITE(*,*) ' String is too long' 0141 GO TO 20020 0142 20023 READ ( UNIT=CTEMP2, FMT='(D30.22)' ) DP 0143 C 0144 C20020 CALL HALT 0145 20020 CONTINUE 0146 C 0147 GO TO NPR001,(20010,20013,20018) 0148 C 0149 C*********************************************************************** 0150 C 0151 END CH2DPX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 23 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 489 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 137 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 160 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 786 ENTRY POINTS Address Type Name 0-00000000 CH2DPX VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR CH 2-00000000 CHAR CTEMP1 2-0000001E CHAR CTEMP2 ** R*8 D1MACH AP-0000000C@ R*8 DP ** I*4 IOS AP-00000010@ I*4 ISTAT 2-00000044 I*4 LENGTH AP-00000008@ L*4 MSG ** I*4 MSGNUM 2-0000003C I*4 N1 2-00000040 I*4 N2 ** I*4 NPR001 LABELS Address Label Address Label Address Label Address Label Address Label Address Label ** 20002 0-00000037 20003 ** 20005 0-00000050 20006 0-00000064 20009 0-000001E0 20010 0-00000080 20012 0-000001DC 20013 0-000001E4 20017 0-000001D7 20018 0-000001CD 20020 0-0000016C 20021 0-0000018C 20022 0-000001AC 20023 0-0000010A 30001 FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 LIB$INDEX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 24 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CH2INT 0002 C 0003 INTEGER FUNCTION CH2INT( STRING ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This integer function takes the input character string STRING and ret 0009 C integer equivalent. The string STRING must contain a legitimate integ 0010 C Any blanks in the input STRING are ignored. 0011 C 0012 C 0013 C Input_Arguments 0014 C 0015 C STRING is a character string. 0016 C 0017 C 0018 C Declarations_of_Input_and_Output_Arguments 0019 C 0020 CHARACTER*(*) STRING 0021 C 0022 C 0023 C Declarations_of_Local_Variables 0024 C 0025 INTEGER ICHR 0026 INTEGER LENGTH 0027 C 0028 CHARACTER*1 CHR 0029 C 0030 INTEGER INT 0031 C 0032 LOGICAL MINUS 0033 C 0034 C 0035 C Data_Statements 0036 C 0037 C Method 0038 C-& 0039 C*********************************************************************** 0040 C1 Main Routine 0041 C*********************************************************************** 0042 C 0043 GO TO 30001 0044 C 0045 20002 ASSIGN 20003 TO NPR002 0046 GO TO 30002 0047 20003 IF (.NOT.( CHR .EQ. '+' )) GO TO 20005 0048 ASSIGN 20006 TO NPR002 0049 GO TO 30002 0050 20006 GO TO 20004 0051 20005 IF (.NOT.( CHR .EQ. '-' )) GO TO 20007 0052 MINUS = .TRUE. 0053 ASSIGN 20008 TO NPR002 0054 GO TO 30002 0055 20008 CONTINUE 0056 20007 CONTINUE 0057 C CH2INT 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 25 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 20004 IF (.NOT.( CHR .EQ. ' ' )) GO TO 20009 0059 ASSIGN 20009 TO NPR003 0060 GO TO 30003 0061 C 0062 20009 CONTINUE 0063 20010 IF (.NOT.( CHR .NE. ' ' )) GO TO 20011 0064 N = INDEX( '0123456789', CHR ) - 1 0065 IF (.NOT.( N .LT. 0 )) GO TO 20012 0066 ASSIGN 20012 TO NPR003 0067 GO TO 30003 0068 20012 INT = 10*INT + N 0069 ASSIGN 20013 TO NPR002 0070 GO TO 30002 0071 20013 GO TO 20010 0072 C 0073 20011 IF(MINUS)THEN 0074 CH2INT = -INT 0075 ELSE 0076 CH2INT = INT 0077 END IF 0078 C 0079 RETURN 0080 C 0081 C*********************************************************************** 0082 C1 Procedures 0083 C*********************************************************************** 0084 C 0085 C PROCEDURE (INITIALIZE) 0086 C 0087 30001 LENGTH = LEN( STRING ) 0088 ICHR = 0 0089 MINUS = .FALSE. 0090 INT = 0 0091 C 0092 GO TO 20002 0093 C 0094 C*********************************************************************** 0095 C 0096 C PROCEDURE (GET CHR: THE NEXT NONBLANK CHARACTER IN STRING) 0097 C 0098 30002 CONTINUE 0099 20016 ICHR = ICHR + 1 0100 IF( ICHR .GT. LENGTH )THEN 0101 CHR = ' ' 0102 GO TO 20017 0103 ELSE 0104 CHR = STRING(ICHR:ICHR) 0105 IF ( CHR .NE. ' ' ) GO TO 20017 0106 END IF 0107 GO TO 20016 0108 C 0109 20017 GO TO NPR002,(20003,20006,20008,20013) 0110 C 0111 C*********************************************************************** 0112 C 0113 C PROCEDURE (WRITE ERROR MESSAGE) 0114 C CH2INT 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 26 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0115 30003 WRITE(*,*) 'ERROR - Unable to convert string to integer: ', 0116 * 'String = ''', STRING, '''' 0117 C CALL HALT 0118 C 0119 GO TO NPR003,(20009,20012) 0120 C 0121 C*********************************************************************** 0122 C 0123 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 293 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 67 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 76 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 436 ENTRY POINTS Address Type Name 0-00000000 I*4 CH2INT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000000 CHAR CHR ** I*4 ICHR ** I*4 INT ** I*4 LENGTH 2-00000008 L*4 MINUS 2-0000000C I*4 N ** I*4 NPR002 ** I*4 NPR003 AP-00000004@ CHAR STRING LABELS Address Label Address Label Address Label Address Label Address Label Address Label ** 20002 0-00000064 20003 0-00000088 20004 0-00000074 20005 0-00000060 20006 0-00000088 20007 0-0000005C 20008 0-00000098 20009 0-00000098 20010 0-0000010C 20011 0-000000F8 20012 0-0000005A 20013 0-0000002C 20016 0-00000050 20017 ** 30001 0-0000002C 30002 0-000000B3 30003 FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 LIB$INDEX 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 27 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CH2JD 0002 C 0003 DOUBLE PRECISION FUNCTION CH2JD( STRING, MSG, ERROR ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This double precision function (CHaracter string 2 Julian Date) will 0009 C an input character string containing the date and time in the format 0010 C 'DD-MMM-YYYY HH:MM:SS.FFFF' and return as its functional value the 0011 C corresponding Julian date. 0012 C 0013 C The user may input only an initial segment of the date/time string, b 0014 C the input string must include at least the day, month, and year. 0015 C 0016 C 0017 C Input_Arguments 0018 C 0019 C STRING is the input data and time in the format 0020 C 'DD-MMM-YYYY HH:MM:SS.FFFF'. The fractional seconds, seconds 0021 C minutes, and/or hours may be omitted if their intended value 0022 C zero. 0023 C MSG controls the response to an input error. 0024 C If MSG=true and the input STRING contains a string which can 0025 C be parsed, then an error message is written to the standa 0026 C system output file and the program is terminated with a 0027 C walkback. 0028 C If MSG=false and the input STRING contains a string which ca 0029 C be parsed, no message is written but ERROR=true is return 0030 C 0031 C 0032 C Output_Arguments 0033 C 0034 C ERROR = true if and only if MSG=false and the input string cannot 0035 C parsed; otherwise ERROR=false is returned. 0036 C 0037 C 0038 C Declarations_of_External_Functions 0039 C 0040 DOUBLE PRECISION CAL2JD 0041 C 0042 C 0043 C Declarations_of_Input_and_Output_Arguments 0044 C 0045 CHARACTER*(*) STRING 0046 LOGICAL MSG 0047 LOGICAL ERROR 0048 C 0049 C 0050 C Declarations_of_Local_Variables 0051 C 0052 INTEGER YEAR 0053 INTEGER MONTH 0054 INTEGER DAY 0055 INTEGER HOUR 0056 INTEGER MINUTE 0057 INTEGER SECOND CH2JD 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 28 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 DOUBLE PRECISION FRAC 0059 C 0060 C 0061 C Method 0062 C-& 0063 C*********************************************************************** 0064 C 0065 C1 Call CH2CAL to convert the character string to a calendar date. 0066 CALL CH2CAL( STRING, MSG, 0067 * YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC, 0068 * ERROR ) 0069 IF (ERROR) RETURN 0070 C 0071 C1 Call CAL2JD to convert the calendar date to the Julian date. 0072 CH2JD = CAL2JD( YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC ) 0073 C 0074 RETURN 0075 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 57 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 124 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 181 ENTRY POINTS Address Type Name 0-00000000 R*8 CH2JD VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000018 I*4 DAY AP-0000000C@ L*4 ERROR 2-00000008 R*8 FRAC 2-0000001C I*4 HOUR 2-00000020 I*4 MINUTE 2-00000014 I*4 MONTH AP-00000008@ L*4 MSG 2-00000024 I*4 SECOND AP-00000004@ CHAR STRING 2-00000010 I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 CAL2JD CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 29 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure CH2SEC 0002 C 0003 DOUBLE PRECISION FUNCTION CH2SEC( STRING, MSG, ERROR ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This double precision function (CHaracter string 2 SEConds) will pars 0009 C an input character string containing the date and time in the format 0010 C 'DD-MMM-YYYY HH:MM:SS.FFFF' and return as its functional value the 0011 C corresponding seconds past the reference date (JDREF) for this librar 0012 C 0013 C The user may input only an initial segment of the date/time string, b 0014 C the input string must include at least the day, month, and year. 0015 C 0016 C 0017 C Input_Arguments 0018 C 0019 C STRING is the input data and time in the format 0020 C 'DD-MMM-YYYY HH:MM:SS.FFFF'. The fractional seconds, seconds 0021 C minutes, and/or hours may be omitted if their intended value 0022 C zero. 0023 C MSG controls the response to an input error. 0024 C If MSG=true and the input STRING contains a string which can 0025 C be parsed, then an error message is written to the standa 0026 C system output file and the program is terminated with a 0027 C walkback. 0028 C If MSG=false and the input STRING contains a string which ca 0029 C be parsed, no message is written but ERROR=true is return 0030 C 0031 C 0032 C Output_Arguments 0033 C 0034 C ERROR = true if and only if MSG=false and the input string cannot 0035 C parsed; otherwise ERROR=false is returned. 0036 C 0037 C 0038 C Declarations_of_External_Functions 0039 C 0040 DOUBLE PRECISION CALSEC 0041 C 0042 C 0043 C Declarations_of_Input_and_Output_Arguments 0044 C 0045 CHARACTER*(*) STRING 0046 LOGICAL MSG 0047 LOGICAL ERROR 0048 C 0049 C 0050 C Declarations_of_Local_Variables 0051 C 0052 INTEGER YEAR 0053 INTEGER MONTH 0054 INTEGER DAY 0055 INTEGER HOUR 0056 INTEGER MINUTE 0057 INTEGER SECOND CH2SEC 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 30 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 DOUBLE PRECISION FRAC 0059 C 0060 C 0061 C Method 0062 C-& 0063 C*********************************************************************** 0064 C 0065 C1 Call CH2CAL to convert the input string to the components of the c 0066 C1 date and time. 0067 CALL CH2CAL( STRING, MSG, 0068 * YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC, 0069 * ERROR ) 0070 C 0071 C1 Call CALSEC to convert the components of the calendar date to seco 0072 C1 past the reference date. 0073 IF ( .NOT. ERROR ) 0074 * CH2SEC = CALSEC( YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC ) 0075 C 0076 RETURN 0077 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 60 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 124 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 184 ENTRY POINTS Address Type Name 0-00000000 R*8 CH2SEC VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000018 I*4 DAY AP-0000000C@ L*4 ERROR 2-00000008 R*8 FRAC 2-0000001C I*4 HOUR 2-00000020 I*4 MINUTE 2-00000014 I*4 MONTH AP-00000008@ L*4 MSG 2-00000024 I*4 SECOND AP-00000004@ CHAR STRING 2-00000010 I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name R*8 CALSEC CH2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 31 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure DATE2J 0002 C 0003 INTEGER FUNCTION DATE2J( YEAR, MONTH, DAY ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This integer function (calendar DATE 2 Julian date) takes the input 0009 C Gregorian calendar date and returns as its functional value the 0010 C corresponding integer Julian date. Since the Julian date is an intege 0011 C this correspondence is exact for noon of the output calendar date. 0012 C 0013 C The algorithm for this conversion is taken from the following article 0014 C Tantzen,R.T., "Communications of the ACM", Volume 6, Number 8, August 0015 C Algorithm 199, page 444. 0016 C 0017 C 0018 C Input_Arguments 0019 C 0020 C YEAR is the year number. 0021 C MONTH is the month number. 0022 C DAY is the day number. 0023 C 0024 C 0025 C Output_Arguments 0026 C 0027 C Declarations_of_External_Functions 0028 C 0029 C Declarations_of_Input_and_Output_Arguments 0030 C 0031 INTEGER YEAR 0032 INTEGER MONTH 0033 INTEGER DAY 0034 C 0035 C 0036 C Declarations_of_Local_Variables 0037 C 0038 INTEGER Y 0039 INTEGER M 0040 INTEGER D 0041 C 0042 INTEGER C 0043 INTEGER YA 0044 C 0045 C 0046 C Method 0047 C-& 0048 C*********************************************************************** 0049 C 0050 Y = YEAR 0051 M = MONTH 0052 D = DAY 0053 C 0054 IF( M .GT. 2 )THEN 0055 M = M - 3 0056 ELSE 0057 M = M + 9 DATE2J 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 32 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 Y = Y - 1 0059 END IF 0060 C 0061 C = Y/100 0062 YA = Y - 100*C 0063 DATE2J = (146097*C)/4 + (1461*YA)/4 + (153*M+2)/5 + D + 1721119 0064 C 0065 RETURN 0066 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 111 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 4 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 115 ENTRY POINTS Address Type Name 0-00000000 I*4 DATE2J VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 C ** I*4 D AP-0000000C@ I*4 DAY ** I*4 M AP-00000008@ I*4 MONTH ** I*4 Y ** I*4 YA AP-00000004@ I*4 YEAR 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 33 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure INT2CH 0002 C 0003 CHARACTER*(*) FUNCTION INT2CH( INT ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This character*(*) function (INTeger 2 CHaracter) takes the input int 0009 C INT and returns the equivalent character string representation left 0010 C justified and padded with blanks on the the right. For example, if IN 0011 C is declared as CHARACTER*5 in the calling routine then INT2CH(23) wil 0012 C return the five character string '23 '. 0013 C 0014 C 0015 C Input_Arguments 0016 C 0017 C INT is an integer. 0018 C 0019 C 0020 C Declarations_of_Input_and_Output_Arguments 0021 C 0022 INTEGER INT 0023 C 0024 C 0025 C Declarations_of_Local_Variables 0026 C 0027 PARAMETER ( MAXLEN = 15 ) 0028 C 0029 LOGICAL MINUS 0030 INTEGER ITEMP 0031 CHARACTER*(MAXLEN) STRING 0032 C 0033 CHARACTER*1 DIGIT(0:9) 0034 C 0035 C 0036 C Data_Statements 0037 C 0038 DATA DIGIT(0) / '0' / 0039 DATA DIGIT(1) / '1' / 0040 DATA DIGIT(2) / '2' / 0041 DATA DIGIT(3) / '3' / 0042 DATA DIGIT(4) / '4' / 0043 DATA DIGIT(5) / '5' / 0044 DATA DIGIT(6) / '6' / 0045 DATA DIGIT(7) / '7' / 0046 DATA DIGIT(8) / '8' / 0047 DATA DIGIT(9) / '9' / 0048 C 0049 C 0050 C Method 0051 C-& 0052 C*********************************************************************** 0053 C 0054 IF( INT .LT. 0 )THEN 0055 MINUS = .TRUE. 0056 ELSE 0057 MINUS = .FALSE. INT2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 34 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 END IF 0059 C 0060 ITEMP = ABS( INT ) 0061 ICHR = MAXLEN + 1 0062 STRING = ' ' 0063 C 0064 GO TO 20006 0065 20004 IF ( ITEMP .EQ. 0 ) GO TO 20005 0066 20006 JTEMP = ITEMP/10 0067 N = ITEMP - 10*JTEMP 0068 ICHR = ICHR - 1 0069 STRING(ICHR:ICHR) = DIGIT(N) 0070 ITEMP = JTEMP 0071 GO TO 20004 0072 C 0073 20005 IF(MINUS)THEN 0074 ICHR = ICHR - 1 0075 STRING(ICHR:ICHR) = '-' 0076 END IF 0077 C 0078 INT2CH = STRING( ICHR:MAXLEN ) 0079 C 0080 RETURN 0081 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 119 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 36 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 155 ENTRY POINTS Address Type Name 0-00000000 CHAR INT2CH VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 ICHR AP-00000008@ I*4 INT ** I*4 ITEMP ** I*4 JTEMP ** L*4 MINUS ** I*4 N 2-0000000A CHAR STRING INT2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 35 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 ARRAYS Address Type Name Bytes Dimensions 2-00000000 CHAR DIGIT 10 (0:9) LABELS Address Label Address Label Address Label ** 20004 0-00000058 20005 0-00000038 20006 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 36 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure J2DATE 0002 C 0003 SUBROUTINE J2DATE( JD, YEAR, MONTH, DAY ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This subroutine (Julian date 2 calendar DATE) converts the input inte 0009 C Julian date to the corresponding Gregorian calendar date. Since the J 0010 C date is an integer, this correspondence is exact for noon of the cale 0011 C date. 0012 C 0013 C The algorithm for this conversion is taken from the following article 0014 C Tantzen,R.T., "Communications of the ACM", Volume 6, Number 8, August 0015 C Algorithm 199, page 444. 0016 C 0017 C 0018 C Input_Arguments 0019 C 0020 C JD is the integer Julian date. 0021 C 0022 C 0023 C Output_Arguments 0024 C 0025 C YEAR is the year number. 0026 C MONTH is the month number. 0027 C DAY is the day number. 0028 C 0029 C 0030 C Output_Arguments 0031 C 0032 C Declarations_of_External_Functions 0033 C 0034 C Declarations_of_Input_and_Output_Arguments 0035 C 0036 INTEGER JD 0037 INTEGER YEAR 0038 INTEGER MONTH 0039 INTEGER DAY 0040 C 0041 C 0042 C Declarations_of_Local_Variables 0043 C 0044 INTEGER J 0045 INTEGER Y 0046 INTEGER M 0047 INTEGER D 0048 C 0049 C 0050 C Method 0051 C-& 0052 C*********************************************************************** 0053 C 0054 J = JD 0055 C 0056 C 0057 J = J - 1721119 J2DATE 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 37 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 Y = (4*J-1)/146097 0059 J = 4*J - 1 - 146097*Y 0060 D = J/4 0061 J = (4*D+3)/1461 0062 D = 4*D + 3 -1461*J 0063 D = (D+4)/4 0064 M = (5*D-3)/153 0065 D = 5*D - 3 - 153*M 0066 D = (D+5)/5 0067 Y = 100*Y + J 0068 IF( M .LT. 10 )THEN 0069 M = M + 3 0070 ELSE 0071 M = M - 9 0072 Y = Y + 1 0073 END IF 0074 C 0075 C 0076 YEAR = Y 0077 MONTH = M 0078 DAY = D 0079 C 0080 RETURN 0081 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 138 PIC CON REL LCL SHR EXE RD NOWRT QUAD Total Space Allocated 138 ENTRY POINTS Address Type Name 0-00000000 J2DATE VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 D AP-00000010@ I*4 DAY ** I*4 J AP-00000004@ I*4 JD ** I*4 M AP-0000000C@ I*4 MONTH ** I*4 Y AP-00000008@ I*4 YEAR 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 38 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure JD2CAL 0002 C 0003 SUBROUTINE JD2CAL( JD, YEAR, MONTH, DAY, 0004 * HOUR, MINUTE, SECOND, FRAC ) 0005 C 0006 C 0007 C Purpose 0008 C 0009 C This subroutine (Julian Date 2 CALendar date) takes an input Julian d 0010 C and returns the various components of the corresponding calendar date 0011 C The components of the calendar date are all returned as numbers to al 0012 C for use in computation. For instance, the month is returned as the 0013 C integer month number rather than as a character string. 0014 C 0015 C 0016 C Input_Arguments 0017 C 0018 C JD is the Julian date. 0019 C 0020 C 0021 C Output_Arguments 0022 C 0023 C YEAR is the year. 0024 C MONTH is the month number. 0025 C DAY is the day. 0026 C HOUR is the hour. 0027 C MINUTE is the minute. 0028 C SECOND is the second. 0029 C FRAC is the fractional seconds. 0030 C 0031 C 0032 C Declarations_of_Input_and_Output_Arguments 0033 C 0034 DOUBLE PRECISION JD 0035 INTEGER YEAR 0036 INTEGER MONTH 0037 INTEGER DAY 0038 INTEGER HOUR 0039 INTEGER MINUTE 0040 INTEGER SECOND 0041 DOUBLE PRECISION FRAC 0042 C 0043 C 0044 C Declarations_of_Local_Variables 0045 C 0046 DOUBLE PRECISION SECDAY 0047 PARAMETER ( SECDAY = 86400.0D0 ) 0048 C 0049 DOUBLE PRECISION JDPLUS 0050 INTEGER JDINT 0051 DOUBLE PRECISION DSEC 0052 INTEGER ISEC 0053 C 0054 C 0055 C Method 0056 C-& 0057 C*********************************************************************** JD2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 39 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C 0059 C1 Compute JDINT, the integer Julian date at noon of the current day 0060 C1 compute DSEC, the number of seconds elapsed since the start of the 0061 C1 current day. 0062 JDPLUS = JD + 0.5D0 0063 JDINT = INT( JDPLUS ) 0064 DSEC = SECDAY * MOD( JDPLUS, 1.0D0 ) 0065 IF( DSEC .GE. SECDAY )THEN 0066 JDINT = JDINT + 1 0067 DSEC = DSEC - SECDAY 0068 END IF 0069 ISEC = INT( DSEC ) 0070 C 0071 C1 Call J2DATE with JDINT to compute the year, month, and day of the 0072 C1 calendar date. 0073 CALL J2DATE( JDINT, YEAR, MONTH, DAY ) 0074 C 0075 C1 Compute HOUR. 0076 HOUR = ISEC/3600 0077 ISEC = ISEC - 3600*HOUR 0078 C 0079 C1 Compute MINUTE. 0080 MINUTE = ISEC/60 0081 ISEC = ISEC - 60*MINUTE 0082 C 0083 C1 Compute SECOND. 0084 SECOND = ISEC 0085 C 0086 C1 Compute FRAC. 0087 FRAC = MOD( DSEC, 1.0D0 ) 0088 C 0089 RETURN 0090 END JD2CAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 40 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 152 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 64 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 224 ENTRY POINTS Address Type Name 0-00000000 JD2CAL VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000010@ I*4 DAY 2-00000008 R*8 DSEC AP-00000020@ R*8 FRAC AP-00000014@ I*4 HOUR ** I*4 ISEC AP-00000004@ R*8 JD 2-00000010 I*4 JDINT 2-00000000 R*8 JDPLUS AP-00000018@ I*4 MINUTE AP-0000000C@ I*4 MONTH AP-0000001C@ I*4 SECOND AP-00000008@ I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name J2DATE R*8 MTH$DMOD 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 41 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure JD2SEC 0002 C 0003 DOUBLE PRECISION FUNCTION JD2SEC( JD ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This subroutine (Julian Date 2 SEConds) takes an input Julian date an 0009 C returns the corresponding time in seconds past the reference date (JD 0010 C for this library as its functional value. 0011 C 0012 C 0013 C Input_Arguments 0014 C 0015 C JD is the Julian date to convert. 0016 C 0017 C 0018 C Declarations_of_External_Functions 0019 C 0020 DOUBLE PRECISION JDREF 0021 C 0022 C 0023 C Declarations_of_Input_and_Output_Arguments 0024 C 0025 DOUBLE PRECISION JD 0026 C 0027 C 0028 C Declarations_of_Local_Variables 0029 C 0030 DOUBLE PRECISION SECDAY 0031 PARAMETER ( SECDAY = 86400.0D0 ) 0032 C 0033 C 0034 C Method 0035 C-& 0036 C*********************************************************************** 0037 C 0038 C1 Subtract the Julian reference date from the input Julian date and 0039 C1 multiply by the number of seconds in a day (86400). 0040 JD2SEC = ( JD - JDREF() ) * SECDAY 0041 C 0042 RETURN 0043 END JD2SEC 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 42 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 33 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 49 ENTRY POINTS Address Type Name 0-00000000 R*8 JD2SEC VARIABLES Address Type Name AP-00000004@ R*8 JD FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*8 JDREF 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 43 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure JDREF 0002 C 0003 DOUBLE PRECISION FUNCTION JDREF( ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This double precision function (Julian Date REFerence) will return th 0009 C the current Julian reference epoch for this library. Any time convers 0010 C routine in this library which outputs double precision seconds will o 0011 C seconds past this reference epoch. Note that this function must be ca 0012 C with an empty argument list: JDREF(). 0013 C 0014 C> Subroutine JDSET may be called to change this reference epoch from th 0015 C default value of 2451545.0 which is J2000.0 (January 1, 2000, 12 hour 0016 C 0017 C The alternate entry point, JDNEW, is reserved for use by other routin 0018 C this library and should never be called by the user. 0019 C 0020 C 0021 C Input_Arguments 0022 C 0023 C Output_Arguments 0024 C 0025 C Declarations_of_External_Functions 0026 C 0027 C Declarations_of_Input_and_Output_Arguments 0028 C 0029 C Declarations_of_Local_Variables 0030 C 0031 C Declare the alternate entry point: 0032 DOUBLE PRECISION JDNEW 0033 C 0034 DOUBLE PRECISION REFDAT 0035 C 0036 DOUBLE PRECISION JDSAVE 0037 C 0038 C 0039 SAVE 0040 C 0041 C Data_Statements 0042 C 0043 DATA JDSAVE /2451545.0D0/ 0044 C 0045 C 0046 C Method 0047 C*********************************************************************** 0048 C 0049 C1 Entry point JDREF. 0050 C 0051 JDREF = JDSAVE 0052 C 0053 RETURN 0054 C 0055 C*********************************************************************** 0056 C 0057 C1 Entry point JDNEW. JDREF 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 44 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C1 This entry point will change the Julian reference epoch to the val 0059 C the input argument REFDAT. 0060 C 0061 ENTRY JDNEW( REFDAT ) 0062 C 0063 JDSAVE = REFDAT 0064 JDNEW = JDSAVE 0065 C 0066 RETURN 0067 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 31 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 47 ENTRY POINTS Address Type Name Address Type Name 0-0000000D R*8 JDNEW 0-00000000 R*8 JDREF VARIABLES Address Type Name Address Type Name 2-00000008 R*8 JDSAVE AP-00000004@ R*8 REFDAT 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 45 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure SEC2CH 0002 C 0003 CHARACTER*(*) FUNCTION SEC2CH( SEC ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This subroutine (SEConds 2 CHaracter string) takes the input seconds 0009 C the Julian reference date (JDREF) for this library and returns as its 0010 C functional value the equivalent time in the character*25 format 0011 C 'DD-MMM-YYYY HH:MM:SS.FFFF'. 0012 C 0013 C If the user wishes to display only some initial segment of the calend 0014 C date, he may do so with his declaration of SEC2CH. For example, if he 0015 C wants to display 'DD-MMM-YYYY HH:MM:SS' then he may declare the funct 0016 C SEC2CH to be character*20. 0017 C 0018 C Note that this function will round rather than truncate to the neares 0019 C fractional second. The output accuracy is computed using the length o 0020 C declared in the calling routine. For example, if the calling routine 0021 C SEC2CH to be character*24, then this routine will round to the neares 0022 C millisecond. If the calling routine declares SEC2CH to be character*2 0023 C this routine will round to the nearest second. 0024 C 0025 C 0026 C Input_Arguments 0027 C 0028 C SEC is the time in seconds past the reference date for this library. 0029 C 0030 C 0031 C Declarations_of_External_Functions 0032 C 0033 CHARACTER*31 CAL2CH 0034 C 0035 C 0036 C Declarations_of_Input_and_Output_Arguments 0037 C 0038 DOUBLE PRECISION SEC 0039 C 0040 C 0041 C Declarations_of_Local_Variables 0042 C 0043 INTEGER YEAR 0044 INTEGER MONTH 0045 INTEGER DAY 0046 INTEGER HOUR 0047 INTEGER MINUTE 0048 INTEGER SECOND 0049 DOUBLE PRECISION FRAC 0050 C 0051 INTEGER NDIGIT 0052 DOUBLE PRECISION EPS 0053 DOUBLE PRECISION SECTMP 0054 C 0055 C NDIGIT is the number of fractional digits to be output. 0056 C EPS is the fraction needed to be added to SEC to round to NDIGIT digi 0057 C SECTMP is the 'rounded' number of seconds. SEC2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 46 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C 0059 C 0060 C Method 0061 C-& 0062 C*********************************************************************** 0063 C 0064 C1 Check to see if the date is out of bounds. 0065 IF( SEC .LT. -1.0D12 )THEN 0066 SEC2CH = 'DISTANT-PAST' 0067 RETURN 0068 ELSEIF( SEC .GT. 1.0D12 )THEN 0069 SEC2CH = 'DISTANT-FUTURE' 0070 RETURN 0071 END IF 0072 C 0073 C1 Round the number of seconds based on the output character string l 0074 NDIGIT = MIN( MAX( LEN(SEC2CH)-21, 0 ), 20 ) 0075 EPS = 0.5D0 / ( 10.D0**NDIGIT ) 0076 SECTMP = SEC + EPS 0077 C 0078 C1 Call SECCAL to convert seconds to calendar date. 0079 CALL SECCAL( SECTMP, YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC) 0080 C 0081 C1 Call CAL2CH to convert calendar date to a character string. 0082 SEC2CH = CAL2CH( YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, FRAC ) 0083 C 0084 RETURN 0085 END SEC2CH 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 47 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 159 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 26 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 128 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 313 ENTRY POINTS Address Type Name 0-00000000 CHAR SEC2CH VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000018 I*4 DAY ** R*8 EPS 2-00000000 R*8 FRAC 2-0000001C I*4 HOUR 2-00000020 I*4 MINUTE 2-00000014 I*4 MONTH ** I*4 NDIGIT AP-00000008@ R*8 SEC 2-00000024 I*4 SECOND 2-00000008 R*8 SECTMP 2-00000010 I*4 YEAR FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name CHAR CAL2CH SECCAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 48 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure SEC2JD 0002 C 0003 DOUBLE PRECISION FUNCTION SEC2JD( SEC ) 0004 C 0005 C 0006 C Purpose 0007 C 0008 C This double precision function subroutine (SEConds 2 Julian Date) tak 0009 C input time in seconds past the Julian reference date (JDREF) for this 0010 C and returns the corresponding Julian date as its functional value. 0011 C 0012 C 0013 C Input_Arguments 0014 C 0015 C SEC is the seconds past the reference date for this library. 0016 C 0017 C 0018 C Declarations_of_External_Functions 0019 C 0020 DOUBLE PRECISION JDREF 0021 C 0022 C 0023 C Declarations_of_Input_and_Output_Arguments 0024 C 0025 DOUBLE PRECISION SEC 0026 C 0027 C 0028 C Declarations_of_Local_Variables 0029 C 0030 DOUBLE PRECISION SECDAY 0031 PARAMETER ( SECDAY = 86400.0D0 ) 0032 C 0033 C 0034 C Method 0035 C-& 0036 C*********************************************************************** 0037 C 0038 C1 Divide the input seconds past the Julian reference date by the num 0039 C1 of seconds in a day and add the Julian reference date. 0040 SEC2JD = SEC/SECDAY + JDREF() 0041 C 0042 RETURN 0043 END SEC2JD 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 49 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 33 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 16 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 49 ENTRY POINTS Address Type Name 0-00000000 R*8 SEC2JD VARIABLES Address Type Name AP-00000004@ R*8 SEC FUNCTIONS AND SUBROUTINES REFERENCED Type Name R*8 JDREF 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 50 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0001 C Procedure SECCAL 0002 C 0003 SUBROUTINE SECCAL( SEC, YEAR, MONTH, DAY, 0004 * HOUR, MINUTE, SECOND, FRAC ) 0005 C 0006 C 0007 C Purpose 0008 C 0009 C This subroutine (SEConds to CALendar date) takes an input seconds pas 0010 C the Julian reference date (JDREF) for this library and returns the va 0011 C components of the corresponding calendar date. The components of the 0012 C calendar date are all returned as numbers to allow for use in computa 0013 C For instance, the month is returned as the integer month number rathe 0014 C as a character string. 0015 C 0016 C 0017 C Input_Arguments 0018 C 0019 C SEC is the seconds past the reference date for this library. 0020 C 0021 C 0022 C Output_Arguments 0023 C 0024 C YEAR is the year. 0025 C MONTH is the month number. 0026 C DAY is the day. 0027 C HOUR is the hour. 0028 C MINUTE is the minute. 0029 C SECOND is the second. 0030 C FRAC is the fractional seconds. 0031 C 0032 C 0033 C Declarations_of_External_Functions 0034 C 0035 DOUBLE PRECISION SEC2JD 0036 C 0037 C 0038 C Declarations_of_Input_and_Output_Arguments 0039 C 0040 DOUBLE PRECISION SEC 0041 INTEGER YEAR 0042 INTEGER MONTH 0043 INTEGER DAY 0044 INTEGER HOUR 0045 INTEGER MINUTE 0046 INTEGER SECOND 0047 DOUBLE PRECISION FRAC 0048 C 0049 C 0050 C Declarations_of_Local_Variables 0051 C 0052 DOUBLE PRECISION JD 0053 DOUBLE PRECISION TEMP 0054 C 0055 C 0056 C Method 0057 C-& SECCAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 51 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 0058 C*********************************************************************** 0059 C 0060 C1 Extract the fraction seconds (FRAC) from SEC. Note that care must 0061 C1 taken if SEC<0 since FRAC must be a non-negative number < 1. The o 0062 C1 fraction seconds of the calendar representation is simply the frac 0063 C1 part of the input seconds and can be computed immediately. The rem 0064 C1 integral seconds is converted to the rest of the calendar date. Th 0065 C1 done to avoid round off error that could be introduced by the 0066 C1 intermediate conversion to Julian date. 0067 FRAC = MOD( SEC, 1.0D0 ) 0068 IF ( FRAC .LT. 0.0D0 ) FRAC = 1.0D0 + FRAC 0069 C 0070 C1 Call SEC2JD to convert the integral seconds to the Julian date. 0071 JD = SEC2JD( SEC - FRAC + 0.5D0 ) 0072 C 0073 C1 Call JD2CAL to convert the Julian date to calandar date. 0074 CALL JD2CAL( JD, YEAR, MONTH, DAY, 0075 * HOUR, MINUTE, SECOND, TEMP ) 0076 C 0077 RETURN 0078 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 99 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 72 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 179 ENTRY POINTS Address Type Name 0-00000000 SECCAL VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000010@ I*4 DAY AP-00000020@ R*8 FRAC AP-00000014@ I*4 HOUR 2-00000000 R*8 JD AP-00000018@ I*4 MINUTE AP-0000000C@ I*4 MONTH AP-00000004@ R*8 SEC AP-0000001C@ I*4 SECOND 2-00000008 R*8 TEMP AP-00000008@ I*4 YEAR SECCAL 1-Jun-1993 15:42:29 VAX FORTRAN V5.6-119 Page 52 01 21-Jan-1993 22:17:50 NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.FOR;2 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name JD2CAL R*8 MTH$DMOD R*8 SEC2JD COMMAND QUALIFIERS FOR/LIS/NOOBJ TIMCVT /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC.SOURCE]TIMCVT.LIS;2 /NOOBJECT COMPILATION STATISTICS Run Time: 2.80 seconds Elapsed Time: 6.33 seconds Page Faults: 322 Dynamic Memory: 456 pages 2-Jun-1993 17:29:30 VAX FORTRAN V5.6-119 Page 1 18-May-1993 21:08:30 NAVDEV:[SHAPIRO.COSMIC]ORB2LATLONG.FOR;5 0001 Subroutine ORB2LatLong (ORB, DATE, MU, FLAT, re, 0002 * TOLERANCE, GDLAT, GCLAT, LONGITUDE) 0003 C 0004 C 0005 C Computes ground track latitude & longitude from a state 0006 C vector using Escobal transformation (3), 0007 C "Methods of Orbit Determination", Page 398-399 0008 C 0009 C INPUT: 0010 C ORB = GTARG STATE VECTOR in standard GTARG format 0011 C a,e,i,raan,aop,M (deg & km) 0012 C data = epoch of orb in timetrans format 0013 C MU = earth GM 0014 C FLAT = earth flattening 0015 C RE = earth equatorial radius in km 0016 C TOLERANCE = tolerance in degrees of final answer 0017 C OUTPUT: 0018 C GDLAT = geodetic latitude in degrees 0019 C GCLAT = geocentric latitude in degrees 0020 C longitude = longitude in degrees 0021 0022 double precision orb(6), mu, xyz(6), rag, sidang, 0023 * r, alpha, lat, longitude, phi, delta, flat, rc, 0024 * H, phiprime, deltaprime, newphiprime, error, 0025 * tolerance, gclat, gdlat, re 0026 0027 external sidang 0028 character*25 date 0029 double precision pi 0030 parameter (pi = 3.14159 26535 89793 23846 ) 0031 integer maxsteps, istep 0032 data maxsteps /25/ 0033 C 0034 C convert to cartesian state vector 0035 C 0036 call kep2car ( orb, xyz, mu) 0037 r = sqrt( xyz(1)**2 + xyz(2)**2 + xyz(3)**2 ) 0038 C 0039 C determine longitude 0040 C 0041 alpha = atan2 ( xyz(2), xyz(1) ) * ( 180.0d0 / PI ) 0042 rag = sidang ( date, 0.0d0 ) 0043 longitude = alpha - rag 0044 0045 C write(8,*) 'LONGITUDE = ',longitude 0046 C 0047 C iterate for latitude 0048 C 0049 delta = atan2 ( xyz(3), sqrt( xyz(2)**2 + xyz(1)**2 ) ) 0050 newphiprime = delta 0051 ERROR = 10.0d0 0052 istep = 0 0053 do while( ( error .gt. tolerance ) .and. 0054 & ( istep .lt. maxsteps ) ) 0055 istep = istep + 1 0056 phiprime = newphiprime 0057 rc = ( 1.0 - (2*flat-flat*flat) ) / ORB2LATLONG 2-Jun-1993 17:29:30 VAX FORTRAN V5.6-119 Page 2 18-May-1993 21:08:30 NAVDEV:[SHAPIRO.COSMIC]ORB2LATLONG.FOR;5 0058 & (1.0 - (2*flat-flat*flat)*cos(phiprime)**2 ) 0059 rc = re * sqrt(rc) 0060 0061 phi = atan ( tan(phiprime) / ((1-flat)**2) ) 0062 h = sqrt ( r*r - rc*rc*( sin(phi-phiprime)**2 ) ) - 0063 & rc * cos(phi-phiprime) 0064 deltaprime = asin ( (h/r)*sin(phi-phiprime) ) 0065 0066 newphiprime = delta - deltaprime 0067 error = dabs ( newphiprime - phiprime ) * (180.0d0/PI) 0068 0069 C write(8,*) 'GD = ', newphiprime*180.0d0/pi 0070 end do 0071 phiprime = newphiprime 0072 gclat = phiprime*180.0d0/PI 0073 gdlat = phi*180.0d0/PI 0074 return 0075 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 419 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 8 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 180 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 607 ENTRY POINTS Address Type Name 0-00000000 ORB2LATLONG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** R*8 ALPHA AP-00000008@ CHAR DATE 2-00000040 R*8 DELTA ** R*8 DELTAPRIME 2-00000058 R*8 ERROR AP-00000010@ R*8 FLAT AP-00000020@ R*8 GCLAT AP-0000001C@ R*8 GDLAT ** R*8 H ** I*4 ISTEP ** R*8 LAT AP-00000024@ R*8 LONGITUDE 2-00000060 I*4 MAXSTEPS AP-0000000C@ R*8 MU ** R*8 NEWPHIPRIME 2-00000038 R*8 PHI 2-00000050 R*8 PHIPRIME 2-00000030 R*8 R ** R*8 RAG 2-00000048 R*8 RC AP-00000014@ R*8 RE AP-00000018@ R*8 TOLERANCE ORB2LATLONG 2-Jun-1993 17:29:30 VAX FORTRAN V5.6-119 Page 3 01 18-May-1993 21:08:30 NAVDEV:[SHAPIRO.COSMIC]ORB2LATLONG.FOR;5 ARRAYS Address Type Name Bytes Dimensions AP-00000004@ R*8 ORB 48 (6) 2-00000000 R*8 XYZ 48 (6) FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name KEP2CAR R*8 MTH$DASIN R*8 MTH$DATAN R*8 MTH$DATAN2 R*8 MTH$DCOS R*8 MTH$DSIN R*8 MTH$DSQRT R*8 MTH$DTAN R*8 SIDANG COMMAND QUALIFIERS FOR/LIS ORB2LATLONG /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=NAVDEV:[SHAPIRO.COSMIC]ORB2LATLONG.LIS;1 /OBJECT=NAVDEV:[SHAPIRO.COSMIC]ORB2LATLONG.OBJ;1 COMPILATION STATISTICS Run Time: 0.40 seconds Elapsed Time: 2.08 seconds Page Faults: 262 Dynamic Memory: 504 pages