afterpl.exe_49000066403252300000050000000770751026531420200135660ustar00ksimmons000054600020030DX0205(Q6q hv8AFTERPL01@Q6q05-02 ;#N 6 ?B!d FORRTL_001! LIBRTL_001! MTHRTL_001 E &@ffCASSIGN ERROR WANT PLOT ON SCREEN (0) OR IN FILE (1)?WANT TO USE TEK4662? (Y=1,N=0)WHICH PEN:1=BLACK,2=RED...% SUPPLY DISK FILE NAME, AS D12307.DAT FILE ASSIGN ERROR, #  ACCUM TUBE CNTS= ON TAPE  19 |JUM 1 |HCO W |jum 37@DzFE`BEE@DEAFBE &@ffADHDEE@EE@ ENG CNTS TOTL CNTS WHICH TIME 04=SCE,13=ERT+ SUPPLY GMT START DAY,HR FOR THIS PLOT(2I3) END DAYS,HRS (2I3) WANT E602? (NO=0,YES=1) SUPPLY DATA MODE TYPE(I2) DELTA TIME IN SECONDS=I ALL ENG (NO E602)D H 0M SCE TIME (Hours) -->D H 0M SCED H 0M ERT TIME (Hours) -->D H 0M ERT ALL PTS, MODE =TICKS EVERY 2 HRS VOYAGER : FIL:6,  4,0,E  A:7,6,E  O.F.  H.V. &@ffC0.000*****;ESYS$OUTPUTTEKPLOT.DATTEKPLOT: Image t erminated on ^Y  (? @B?d? d;(??  (,Tr@?@A??`;? @ @`;?????`,`;????? $`;??`;??`;?????   A  @CC@DE4F@C@C@C@C@C@C#> #> tJ$ Bd LI II0I484<@DCEIIDIIII IILP48TX@@C`6IIDC7IIDC8IIDG :IIDDIHIIID IIH`48dh@@II\ID IIH`48dh@@  Il@@DtK|KKDHp@tHI IILP48TX@@  Ix@@@KL LD II0I484<@D  II@@DhLpLxLDH|@tHIH|@tHIH@tHIHX@tHIH@tHIH@tHIH@tHIH@tHIABPMp ` @ MtMx |MMMMNN N N NN NNMM$NNNMMMMMM N NN NN NMMN(NNMMMMMMNNC=PQ,1K[ЬЬ  $R"K[ЬЬ  $RSTU1> V޻$WR&ݧ2~W"?(="B"P<PQRQSX2XX2QYIHf2QXQSY2YYIfH=PQR&ݧ2~!?(!!PS=TUgI,[ PQ@R12QSP"C2CTTP%C2TP$C2TP#C2PC0CTTpP C0T`PC0RCœ/CTPCœ/RC\.CTPC\.=PQmPQ 2S0TUV<2VWM X@G\.XIX MX@Gœ/XIXQG0TPQG2SQ=UVPQO[^k2 1xﺇ n o ?= N S 8 ч9 ? ?  ??lQ?ԫPMPPD,PQMQQ@QPEaFPPF,%qV,W?%62P@ T1T ST  ߫0ˀƆ4 {Lti˸L42 ~K2~@2~52~*? L}482~2~2~2~D m42~?ɫ n44 Y4uP D4tUl 04T5ˈ 44ˤl 1W<ѫPP2P@ͪTMTTD,TDaFT@︪QMQQDaFQ@QTM@索QD7Q@QTM@Q@QTM@PFzEPAPT 2PNQGQ@ UCL?UVFVU 1@ PX12XYI IILЫ ZMXSGQSRDPR@ZRIZMZZMIJSD0S@ZSVZIﶣTTGFSWCWZWTSW DJZGWZSSS EUSW@WQSPSQSЫSQRЫRQRЫRRI RISIL=XCh > ˄ˀ22 ˘E 'PQP2QUEE =PQi 'PQP2QUEE =PQ= PQP2QUEE =PQ  Q Ы Q Ы Ы |PI|$ <{ X*Y2XP@^$QX QXX Q_ @b$SS<6PPR(PQP$PPSSWˀCPSPQPR1BRPFWP@PJPSBD %AWR~P"~PRP"~{P  AWRPPR P"ˌ P"˜C PPGPCPJPPPTTURXSYZY1wXP"~ PkXkP"ˬkVP PPV@PTUPPC>U˼ )XXP"~PC*Vk  U @WXYZ\$yTUXSoRP"~XPkRkP"ˬP PPk@PTUPPU&  U @WRSXS1=A74C7/'A2C2 ˏX XPPXPQPPPRPQPPPUUXˀ\CPUPQPR1BRPFXP@PJPU BC$Smv$AXR~P"~ PRP"~P  AXRPPR P"(P"8~C PPGP DPJPPPSSTRYUZVZ1YP"~PkYkP"H$kWP PPW@PSTPPG =TXQ )YYP"~ PC9Wkl Tˈ @XYZVX$1STYUx:RP"~PkRkP"HhP PPk@PSTPP T˜ T˰ @XRUY-8< n#APEPA4-@D n"AzqPEPBC$-HL nAVMPEPO@h[^}PQPмVмW V W g ЫWЫ VмPPRQS<Uխ1c< UQ UUPPPQQ,@04ЫYPY1 PPD@ PPD@ː PP@Q PP@ːZESQXERZT PPCTX@DRQDSZ PPAZQ@ː PP@V@ PP@W@ːYP`ZTTYW TTDO TYT:TYTZTk ZZJT ZZJːXPaZNTDTESTY@YVDRT@TWUH [ЬЬ$޼,޼0޼ 4( Ѽ޼,޼0޼ 4(XѼ*Ѽ ޼<޼@޼ D8&Ѽ޼<޼@޼ D8I@[ˏVVW SW PPPQ,#y Q@1XSW WP)JPXX!XFzEWKFtJ$WMQVnO(k+Wk   PPPW, W@ PPPV,x V@S PPPV,- V@ PPPV,n V@޼8޼< @޼D޼H PPPVV,@04SH[k H[ЬЬ$(Y< P@H[}PQPk s|޼ ; H[ ޼޼k= ޼޼|@@V$)(*QԦмQ PFмQԦмQ  PCFм ммм м )ЦP PЦP P*Ц P P Ц P P C!C %S! CPG!P!S CPG%P%|H@4[}PQЬЬ$0Ь8DP PP2@P P P@WQQQ P P@XQQ PмQRռ1DS޻0T޻U P P@WVNVBe P P@XVNVBdQBe8BDBeQBd8BDBdDBeDBd P P@YBcBcPQRO@|[ЬЬ$0%YZP@P@0V޻PРY޻0QСZРСV1CYUCZXEUUPEXXQ@QP PWˏXPFWP SUSXSUSX@IAPFSXSU@IAP2SUSXCPAPSUSX CPIAP @IAPo PXQUJWRSRINSQCQWPQP,7EUQPAPYDXQAQZSQNQQEUQPAPYDXQAQZk4R0SV !ЫYЫZVSCVSC0V1H8[Ь Ь ,WkkkRkSм TUռ 1޻,V޻WEg4Ef80:PtEg@EfD1 PLOT_CLEANUPp PLOT_CLEANUP;'PLOT_DRAW_AXISPLOT_DRAW_AXISù] a8PLOT_DRAW_CHARACTERSЉPLOT_DRAW_CHARACTERS:3PLOT_DRAW_DATAPLOT_DRAW_DATA"'PLOT_DRAW_NUMBERSLPLOT_DRAW_NUMBERS6*2 PLOT_ERASE PLOT_ERASE PLOT_ERROR_HANDLERPLOT_ERROR_HANDLER 4PLOT_FLUSH_OUTPUTȍPLOT_FLUSH_OUTPUT   PLOT_INITIALIZEԍPLOT_INITIALIZE9>PLOT_POSITION_CURSORPLOT_POSITION_CURSOR2 PLOT_SCALEH PLOT_SCALE@HALPHA_GET_CHAR_VECTORSHALPHA_GET_CHAR_V ECTORS'V&INTERPLOT_GENERATE_DOTTED_LINES&\INTERPLOT_GENERATE_DOTTED_LINES\= INTERPLOT_GENERATE_POINTS INTERPLOT_GENERATE_POINTS,7%INTERPLOT_GENERATE_SOLID_LINES%ԒINTERPLOT_GENERATE_SOLID_LINEST= mINTERPLOT_INITIALIZEDINTERPLOT_INITIALIZE!LINTERPLOT_UPDATE_PCINTERPLOT_UPDATE_PC*h IO_CLEANUP IO_CLEANUPep IO_INITIALIZEh IO_INITIALIZE/+PLOTBUF_FLUSH_BUFFERTPLOTBUF_FLUSH_BUFFER#PLOTBUF_INITIALIZExPLOTBUF_INITIALIZE /"PLOTBUF_SEND_DATA_TO_BUFFER"PLOTBUF_SEND_DATA_TO_BUFFER) "PLOT_CONVERT_DATA_TO_SCREEN"pPLOT_CONVERT_DATA_TO_SCREEN01$PLOT_DRAW_CENTERED_CHARACTERS$hPLOT_DRAW_CENTERED_CHARACTERS%-"INTERPLOT_4014_OPTIMIZATION"$INTERPLOT_4014_OPTIMIZATION K INTERPLOT_CONV ERT_TO_4014 INTERPLOT_CONVERT_TO_4014'  IO_INTERRUPTd IO_INTERRUPT0IO_OUTPUT_DATA8IO_OUTPUT_DATAez ZVZ1YP"~PkYkP"H$kWP PPW@PSTPPG =TXQ )YYP"~ PC9Wkl Tˈ @XYZVX$1STYUx:RP"~PkRkP"HhP PPk@PSTPP T˜ T˰ @XRUY-8< n#APEPA4-@D n"AzqPEPBC$-HL nAVMPEPO@bmultie.com_6000066403252300000050000000037721032256174200135000ustar00ksimmons00005460002003$ VERIFY_SAVE = 'F$VERIFY("NO")' $! Ali Bahrami October 24, 1984 VMS 3.7 $! MULTIE prompts the user for parameters to the voyager MULTIE program $! and generates a batch file which is submitted to produce MULTIE plots. $ $ on error then goto CLEANUP $ on control_y then goto CLEANUP $ OPEN/WRITE MULTIE_SLAVE SYS$LOGIN:MULTIESLV.COM $ $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT " MULTIE Batch File Submission Procedure : $ WRITE SYS$OUTPUT " " $ $ write MULTIE_SLAVE "MULTIE" ! Symbol defined by user $ inquire/nopunc TEMP "SUPPLY DISK FILE NAME, AS D12307.DAT>" $ write MULTIE_SLAVE "''TEMP'" $ write MULTIE_SLAVE "1" ! Want plot in file? $ write MULTIE_SLAVE "0" ! Want to use 4662? $ NEXT: $ write sys$output "" $ write sys$output - "NOTE: Enter all zeros in time specification, as in 235009030" $ inquire/nopunc TEMP "SUPPLY START DAYS,IHRS,MIN(3I3)>" $ write MULTIE_SLAVE "''TEMP'" $ inquire/nopunc TEMP "SUPPLY END DAYS,IHRS,MIN>" $ write MULTIE_SLAVE "''TEMP'" $ inquire/nopunc TEMP "WHICH TIME: SCE(=4) OR ERT (=13)>" $ write MULTIE_SLAVE "''TEMP'" $ inquire/nopunc TEMP "SUPPLY MODE # (I2)>" $ write MULTIE_SLAVE "''TEMP'" $ write MULTIE_SLAVE "0" ! Use standard Y axis $ write MULTIE_SLAVE "5" ! Points $ inquire/nopunc TEMP "MORE? (STOP=3,RESTART=0,CONT=1)>" $ write MULTIE_SLAVE "''TEMP'" $ if "''TEMP'" .eqs. "3" then goto RUN_JOB $ goto NEXT $ $ RUN_JOB: $ CLOSE MULTIE_SLAVE $ purge MULTIESLV.COM $ ON ERROR THEN CONTINUE $ write SYS$OUTPUT " " $ write SYS$OUTPUT "SYS$BATCH status:" $ show queue/all sys$batch $ write SYS$OUTPUT " " $ inquire/nopunc TEMP "Run locally or in batch? (0=local, 1=batch)>" $ if "''TEMP'" .eqs. "1" then goto SUBMIT_JOB $ @MULTIESLV $ goto JOB_CONT $ SUBMIT_JOB: submit/notify MULTIESLV $ JOB_CONT: $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT "MULTIE Batch File Submission Procedure - Normal Exit" $ GOTO DONE $ $ $ CLEANUP: $ CLOSE MULTIE_SLAVE $ DEL MULTIESLV.COM; $ $ DONE: IF VERIFY_SAVE THEN SET VERIFY bobprt.pro_6000066403252300000050000000014211032256162400133350ustar00ksimmons00005460002003 PRO BOBPRT,DUMMY ;JAN 3,86 ; PRINTS BOB WEST'S TITAN PARAMETERS FROM MERGE RECS ; A=ASSOC(1,FLTARR(650)) OUT=' ' READ,' SUPPLY OUTPUT FILE NAME',OUT OPENW,3,OUT PRINTF,3,' TITAN PRINT CASE',OUT PRINTF,3,' ALL VECTORS ARE EM ECLIPTIC 1950' read,' SUPPLY STARTING RECORD NUMBER',IBEG READ,' SUPPLY LAST RECORD TO INCLUDE',IEND FOR IREC=IBEG-1,IEND-1 DO BEGIN D=A(IREC) PRINT,D(2),D(3),D(4),D(5) PRINTF,3,' MERGE REC(ftn#), SCE TIME',IREC+1,D(2),D(3),D(4),D(5) printf,3,' FOOTPRINT DECLARED ID (TIT=76,SAT=6)',D(408) PRINTF,3,' RANGE S/C TO SATURN AND TITAN',D(336),D(343) PRINTF,3,' CART.STATE OF S/C, SAT CENT',D(330),D(331),D(332) PRINTF,3,' CART.STATE OF S/C, TIT CENT',D(337),D(338),D(339) PRINTF,3,' ' END CLOSE,3 RETURN & END c03_example.fot000066403252300000050000000315211046443432200137150ustar00ksimmons00005460002003file:/ansa2/simmons/c03_example.fot This is an example of the values in the footprint file /ansa4/gllsoft/k_pryor/pryor/c03a_upb_ftkr2b11.foot,/vax_float This file was created with GGGS and moved to unix on Oct 10, 2002. There is no .log file so GGGS params were not recorded. --------------------------------------- Analysis: Comparing this file with a run of the Lasica/Pape GGS s/w (on Aug 3, 2006) Wayne and I determined several things: * Since GGS doesn not use a Rotor kernel (it used the Z-AXIS.DAT comanded axis lock star position) the values may be slightly off from the true s/c position. * Using the GGS "BOS" (bundle-of-lines-of-sight) utility, we compared the values in the previously generated FOOTPRINT file with those of the current run. The values are very close; some third decimal place differences occur in some values. * There is a major diference in the polarization values calculated with the GGS BOS vs the GGGS value. I would tend to believe the GGGS value since we did not have a chance to verify all GGS values before the project ended. kes - Aug 3, '06 see /ansa4/simmons/info/hdr_formats/footprint_header.doc_10 for GGGS footprint array description and values. -------------------------------------------------------------------- use DBLARR(180) Start with record 0 1996.0000 310.00000 8.0000000 11.000000 48.000000 42.000000 1996.0000 310.00000 7.0000000 25.000000 29.000000 621.00000 1.0000000 3684232.0 59.000000 0.0000000 0.0000000 12800.000 181547.00 2.6000000 0.0000000 0.0000000 599.00000 1369164.2 244.68872 -23.363814 -0.25419597 152.75821 -1.1144001 107.14764 2.9492291e+08 -6.5262839e+08 -2.8716305e+08 11.918421 5.2637548 1.9667721 1.0933347e+08 91935246. 39858827. -20.610067 20.061338 8.6970554 2.9548969e+08 -6.5148315e+08 -2.8661525e+08 0.50553111 1.8277441 0.11619170 7.7159961e+08 7.7064438e+08 1.4830584e+08 114.39760 21.833939 2.0000000 -1.0000000 [ 245.24231 Boresight -20.956421 56.813012 156.32340 72.235584 FOV values 45.505672 63.046075 0.45327385 0.30510393 here 1333452.2 131.50584 176.09404 0.0000000 ] -1.0000000 245.13704 -21.137656 49.381909 153.73870 66.774752 45.569840 55.690304 0.56366585 0.39434691 1325740.4 129.00625 0.0000000 0.0000000 -1.0000000 245.24375 -20.750270 67.570383 156.24103 78.388927 45.541616 73.143250 0.28997988 0.20126724 1345235.5 133.22516 0.0000000 0.0000000 -1.0000000 245.34734 -20.775122 67.040083 161.28125 79.481832 45.441967 72.854285 0.29480285 0.18254731 1344885.7 133.59301 0.0000000 0.0000000 -1.0000000 245.24088 -21.162572 49.103096 156.67125 68.035869 45.470226 55.508979 0.56627709 0.37402609 1325565.7 129.81783 0.0000000 0.0000000 -1.0000000 245.05664 -21.428152 40.294134 152.95540 61.002272 45.592466 46.370499 0.68999233 0.48477495 1317203.8 125.23762 0.0000000 0.0000000 0.0000000 245.32342 -20.459688 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3195.6618 0.0000000 0.0000000 0.0000000 0.0000000 245.42682 -20.484491 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3056.4833 0.0000000 0.0000000 0.0000000 -1.0000000 245.16067 -21.453116 40.067369 155.42464 62.350914 45.492891 46.198909 0.69215692 0.46405509 1317064.3 126.44560 0.0000000 0.0000000 Record 2 1996.0000 310.00000 8.0000000 11.000000 52.000000 43.000000 1996.0000 310.00000 7.0000000 25.000000 33.000000 621.00000 1.0000000 3684232.0 65.000000 0.0000000 0.0000000 12800.000 181547.00 2.6000000 0.0000000 0.0000000 599.00000 1369131.3 244.69034 -23.364060 -0.25420493 152.79701 -1.1143999 107.18794 2.9492296e+08 -6.5262837e+08 -2.8716305e+08 11.918421 5.2637554 1.9667724 1.0933338e+08 91935327. 39858861. -20.610085 20.061323 8.6970489 2.9548969e+08 -6.5148314e+08 -2.8661525e+08 0.50542393 1.8275290 0.11608875 7.7159961e+08 7.7064437e+08 1.4830584e+08 114.39760 21.833939 2.0000000 -1.0000000 245.24781 -20.956421 56.847217 156.49319 72.306189 45.500635 63.083890 0.45268545 0.30393017 1333461.1 131.53856 176.07652 0.0000000 -1.0000000 245.14247 -21.137628 49.409682 153.88175 66.840005 45.564862 55.719605 0.56324336 0.39330008 1325736.6 129.04687 0.0000000 0.0000000 -1.0000000 245.24930 -20.750271 67.625454 156.47840 78.472215 45.536515 73.198422 0.28905818 0.19984313 1345270.3 133.24885 0.0000000 0.0000000 -1.0000000 245.35289 -20.775150 67.092657 161.52680 79.567536 45.436867 72.913845 0.29380937 0.18107643 1344925.8 133.61744 0.0000000 0.0000000 -1.0000000 245.24631 -21.162572 49.129847 156.81548 68.102208 45.465250 55.541435 0.56581011 0.37295205 1325565.1 129.85934 0.0000000 0.0000000 -1.0000000 245.06199 -21.428102 40.316792 153.07882 61.064335 45.587581 46.394717 0.68968632 0.48382725 1317191.1 125.29260 0.0000000 0.0000000 0.0000000 245.32907 -20.459710 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3215.2182 0.0000000 0.0000000 0.0000000 0.0000000 245.43246 -20.484541 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3077.9661 0.0000000 0.0000000 0.0000000 -1.0000000 245.16601 -21.453094 40.089203 155.54861 62.413644 45.488007 46.226196 0.69181311 0.46308500 1317054.3 126.50131 0.0000000 0.0000000 Record 10 1996.0000 310.00000 8.0000000 12.000000 31.000000 379.00000 1996.0000 310.00000 7.0000000 26.000000 12.000000 954.00000 1.0000000 3684233.0 33.000000 0.0000000 0.0000000 12800.000 181547.00 2.6000000 0.0000000 0.0000000 599.00000 1368807.3 244.70621 -23.366476 -0.25429300 153.17856 -1.1143983 107.58423 2.9492343e+08 -6.5262816e+08 -2.8716297e+08 11.918417 5.2637618 1.9667752 1.0933257e+08 91936116. 39859204. -20.610261 20.061176 8.6969853 2.9548971e+08 -6.5148307e+08 -2.8661524e+08 0.50437005 1.8254125 0.11507609 7.7159959e+08 7.7064431e+08 1.4830582e+08 114.39760 21.833940 2.0000000 -1.0000000 245.25330 -20.961914 56.620490 156.53739 72.037377 45.494631 62.854283 0.45625509 0.30839651 1332883.6 131.44370 176.07567 0.0000000 -1.0000000 245.14798 -21.143131 49.231458 153.99972 66.601739 45.558857 55.538510 0.56585220 0.39712005 1325232.7 128.92747 0.0000000 0.0000000 -1.0000000 245.25478 -20.755764 67.262403 156.34726 78.123924 45.530517 72.854348 0.29480181 0.20579560 1344524.2 133.17791 0.0000000 0.0000000 -1.0000000 245.35836 -20.780634 66.736932 161.32598 79.212655 45.430870 72.558225 0.29973647 0.18716437 1344166.4 133.54796 0.0000000 0.0000000 -1.0000000 245.25182 -21.168065 48.952499 156.92233 67.859946 45.459246 55.350426 0.56855574 0.37687190 1325051.4 129.74015 0.0000000 0.0000000 -1.0000000 245.06752 -21.433612 40.175564 153.24239 60.845280 45.581578 46.246328 0.69155936 0.48716966 1316742.7 125.12986 0.0000000 0.0000000 0.0000000 245.33451 -20.465196 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3084.8610 0.0000000 0.0000000 0.0000000 0.0000000 245.43791 -20.490017 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 2941.4479 0.0000000 0.0000000 0.0000000 -1.0000000 245.17155 -21.458595 39.948422 155.70641 62.191766 45.482005 46.068002 0.69380413 0.46651377 1316597.6 126.33960 0.0000000 0.0000000 Last record (is 124) 1996.0000 310.00000 8.0000000 20.000000 45.000000 419.00000 1996.0000 310.00000 7.0000000 34.000000 26.000000 954.00000 1.0000000 3684241.0 46.000000 0.0000000 0.0000000 12800.000 181547.00 2.6000000 0.0000000 0.0000000 599.00000 1364737.5 244.90625 -23.396786 -0.25540122 157.96996 -1.1143772 112.56125 2.9492932e+08 -6.5262556e+08 -2.8716200e+08 11.918376 5.2638418 1.9668099 1.0932239e+08 91946026. 39863500. -20.612472 20.059335 8.6961860 2.9548996e+08 -6.5148218e+08 -2.8661519e+08 0.49114266 1.7987253 0.10230865 7.7159927e+08 7.7064363e+08 1.4830561e+08 114.39764 21.833957 2.0000000 -1.0000000 245.34119 -20.956421 57.054934 157.56039 70.784831 45.415254 63.224565 0.45049482 0.32911666 1329214.9 131.05523 176.06973 0.0000000 -1.0000000 245.23590 -21.137647 49.603270 155.64839 65.293687 45.479501 55.950296 0.55991190 0.41796719 1321569.4 128.36082 0.0000000 0.0000000 -1.0000000 245.34265 -20.750271 67.925946 155.62579 77.110092 45.451104 73.458807 0.28470462 0.22307844 1341189.7 133.05930 0.0000000 0.0000000 -1.0000000 245.44623 -20.775131 67.346588 160.82555 78.041875 45.351472 72.934990 0.29345659 0.20719677 1340547.3 133.34688 0.0000000 0.0000000 -1.0000000 245.33973 -21.162572 49.312016 158.60296 66.473069 45.379898 55.625560 0.56459886 0.39918009 1321245.2 129.07651 0.0000000 0.0000000 -1.0000000 245.15547 -21.428135 40.499252 155.39251 59.408482 45.502261 46.654967 0.68639016 0.50891400 1313016.6 124.16624 0.0000000 0.0000000 0.0000000 245.42235 -20.459695 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3317.5080 0.0000000 0.0000000 0.0000000 0.0000000 245.52575 -20.484508 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 3096.8007 0.0000000 0.0000000 0.0000000 -1.0000000 245.25949 -21.453109 40.264697 157.87204 60.693354 45.402695 46.347364 0.69028453 0.48948362 1312754.7 125.26067 0.0000000 0.0000000 c03_test.view000066403252300000050000000016731047732703500134360ustar00ksimmons00005460002003Galileo Geometry and Graphics Software version 2.7 Data computed on Tue Sep 5 11:00:46 2006 SP Kernel(s) used: /vixen2/ggs/Kernels/Spk/spk_s970103a.bsp C-Kernel(s) loaded: /vixen2/ggs/Kernels/Plt/ckc03_990526_final.plt RCK-Kernel(s) loaded: /vixen2/ggs/Kernels/Rtr/ckc03_990526_final.rtr Evaluation time : UTC : 1996-310 // 08:11:48.002 SCLK : 1/03684278:40:5:6 ET : -99546430. Event Title: Target body is : JUPITER Longitude format - LONGITUDE WEST Body radius values used: JUPITER = 71492.0 Km Spacecraft distance to body center: 18.831 Rj Body center Ra : 245.830 Deg Body center Dec : -23.533 Deg Sub-S/C Latitude (Planetodetic) : -0.298 Deg Sub-S/C Longitude (Planetodetic) : 179.692 Deg Sub-solar Latitude (Planetodetic): -1.274 Deg Sub-solar Longitude (Planetodetic): 135.140 Deg cal.pro_8000066403252300000050000000011341026755505200126150ustar00ksimmons00005460002003 PRO CAL,IR,IRO,IE ; IR IS VYS HEADER REC TO START, IRO IS OUTPUT REC ; IE IS REC TO END July 13, 83 KES ; Updated Aug 14,87 KES print,'Assumes fileunits are: Input=1 and Output=3' read,' Is that correct (y=1)',ok if ok eq 0 then return new=assoc(3,fltarr(100)) LOOP: VYS,1,IR,D,FDS,B,BS,NS ; Use .RUN VY for pre-84:256 PLOT,D ; and .RUN VYS up to 85:092 PRINT,IR,IRO,FDS(0),FDS(1) ; and VYU after that ; IF IRO EQ IE THEN RETURN ; Note:VYU has Satrn stat.tbl READ,' WANT? (YES=1)',IW IF IW EQ 1 THEN BEGIN STARCAL,OUT,D,B,BS,NS,FDS NEW(IRO)=OUT IRO=IRO+1 END GOTO,LOOP RETURN END curvefit.pro_1000066403252300000050000000070651026755506500137130ustar00ksimmons00005460002003FUNCTION CURVEFIT,X,Y,W,A,SIGMAA ;+ ; NAME: ; CURVEFIT ; PURPOSE: ; Non-linear least squares fit to a function of an ; arbitrary number of parameters. ; Function may be any non-linear function where ; the partial derivatives are known or can be approximated. ; CATEGORY: ; E2 - Curve and Surface Fitting ; CALLING SEQUENCE: ; YFIT = CURVEFIT(X,Y,W,A,SIGMAA) ; INPUTS: ; X = Row vector of independent variables. ; Y = Row vector of dependent variable, same length as x. ; W = Row vector of weights, same length as x and y. ; For no weighting ; w(i) = 1., instrumental weighting w(i) = ; 1./y(i), etc. ; A = Vector of nterms length containing the initial estimate ; for each parameter. ; ; OUTPUTS: ; A = Vector of parameters containing fit. ; Function result = YFIT = Vector of calculated ; values. ; OPTIONAL OUTPUT PARAMETERS: ; Sigmaa = Vector of standard deviations for parameters ; A. ; ; COMMON BLOCKS: ; NONE. ; SIDE EFFECTS: ; The function to be fit must be defined and called FUNCT. ; For an example see FUNCT in the IDL User's Libaray. ; Call to FUNCT is: ; FUNCT,X,A,F,PDER ; where: ; X = Vector of NPOINT independent variables, input. ; A = Vector of NTERMS function parameters, input. ; F = Vector of NPOINT values of function, y(i) = funct(x(i)), output. ; PDER = Array, (NPOINT, NTERMS), of partial derivatives of funct. ; PDER(I,J) = DErivative of function at ith point with ; respect to jth parameter. Optional output parameter. ; PDER should not be calculated if parameter is not ; supplied in call (Unless you want to waste some time). ; RESTRICTIONS: ; NONE. ; PROCEDURE: ; Copied from "CURFIT", least squares fit to a non-linear ; function, pages 237-239, Bevington, Data Reduction and Error ; Analysis for the Physical Sciences. ; ; "This method is the Gradient-expansion algorithm which ; compines the best features of the gradient search with ; the method of linearizing the fitting function." ; ; Iterations are perform until the chi square changes by ; only 0.1% or until 20 iterations have been performed. ; ; The initial guess of the parameter values should be ; as close to the actual values as possible or the solution ; may not converge. ; ; MODIFICATION HISTORY: ; Written, DMS, RSI, September, 1982. ;- ON_ERROR,2 ;RETURN TO CALLER IF ERROR A = FLOAT(A) ;MAKE PARAMS FLOATING NTERMS = N_ELEMENTS(A) ;# OF PARAMS. NFREE = (N_ELEMENTS(Y)> DISKTEST cc Dec 8, 1989 cc INTEGER jdat(256) INTEGER IOSB !input file status LOGICAL*1 indat(32767) LOGICAL*1 NAMDSK(25) !Input file EQUIVALENCE (jdat,indat) INTEGER*4 SYS$QIOW,LIB$STOP,SYS$ASSIGN,IN_STATUS INCLUDE '($IODEF)' !MUST INCLUDE SYS.SERV. QIO CODES INCLUDE '($MTDEF)' ! AND TAPE I/O F(X)S INCLUDE '($SSDEF)' ! AND SYS.SERV. ERROR CODES c NF=1 !keep # files read WRITE(5,5) 5 FORMAT(' SUPPLY Input file name (25A)') READ(5,15) NAMDSK 15 FORMAT(25A1) c OPEN(UNIT=1,NAME=NAMDSK,BLOCKSIZE=32767,ERR=600,FORM='UNFORMATTED', OPEN(UNIT=1,NAME=NAMDSK,BLOCKSIZE=32767,ERR=600, + RECORDTYPE='STREAM_LF',IOSTAT=IOSB,STATUS='OLD') c cc Use a default output file: FOR002.dat 10 WRITE(5,25) 25 FORMAT(' Output on File:FOR002.DAT') IUNIT=2 WRITE(IUNIT,15) NAMDSK WRITE(5,35) 35 FORMAT(' WANT SUMMARY(=0), OR FULL DUMP(=1)') READ(5,45) IFLAG !summary vs full flag 45 FORMAT(I1) !summary gives all recs Cc IF(IFLAG .EQ. 0) GO TO 50 !go around for summary Cc WRITE(5,455) Cc455 FORMAT(' WANT ALL RECS(=0), ENG ONLY(=1),DATA ONLY(=2)') Cc READ(5,45) IWHIC !which rec types WRITE(5,465) 465 FORMAT(' WANT 16-BIT WORDS(=0) OR BYTES(=1)') READ(5,45) LBYTE !bytes or words WRITE(5,475) 475 FORMAT(' WANT OCTAL(=0) OR HEX(=1)') READ(5,45) IFMT !format of output Cc50 WRITE(5,55) Cc55 FORMAT(' SUPPLY # FILES(I1)') Cc READ(5,45) NOF !number of files IF(IFLAG .EQ. 1) WRITE(5,65) 65 FORMAT(' SUPPLY # RECORDS TO DUMP(I3)') NR=0 !desired # records IF(IFLAG .EQ. 1) READ(5,75) NR 75 FORMAT(I3) cc IR=0 !COUNT NO. OF INPUT RECS 20 continue read(1) indat ir=ir+1 WRITE(5,305) IR 305 FORMAT(' PROCESSING INPUT RECORD',I5) 30 INU=32767 cc DO 40 JJ=1,INU,2 cc IHOLD=IARR(JJ+1) cc IARR(JJ+1)=IARR(JJ) cc40 IARR(JJ)=IHOLD IF(IR .GT. NR) GO TO 500 WRITE(IUNIT,125)INU,IR IF(IFLAG .EQ. 1) GO TO 60 GO TO 20 60 IF (IWHIC .EQ. 0) GO TO 70 IF (IWHIC .EQ. 1 .AND. INU .EQ. 1930) GO TO 70 IF (IWHIC .EQ. 2 .AND. INU .EQ. 1270) GO TO 70 GO TO 20 70 IF(LBYTE .EQ. 1) GO TO 76 !goto 76 for bytes,stay for words IF (IFMT .EQ. 0) WRITE(IUNIT,105) (jdat(I),I=1,INU/2) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,1055) (jdat(I),I=1,INU/2) !hex GO TO 20 76 IF (IFMT .EQ. 0) WRITE(IUNIT,205) (indat(I),I=1,INU) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,2055) (indat(I),I=1,INU) !hex GO TO 20 500 continue write(iunit,135) ir write(5,135) ir stop 600 write(iunit,145) IOSB 105 FORMAT(1X,(10O8)) 1055 FORMAT(10(4X,Z6)) 205 FORMAT(1X,(20O5)) 2055 FORMAT(20(3X,Z2)) 125 FORMAT('0',I5,' WORDS IN REC.'I5,' FILE',I5) 135 FORMAT(' finished; # RECS =',I7) 145 FORMAT(' OPEN ERROR; STATUS =',5I7) END early.com_59000066403252300000050000000003221032256161300132240ustar00ksimmons00005460002003$ SET VERIFY $ RUN [SIMMONS]AFTERPL [VOYAGER]P20278.V2;1 04 272 01 273 00 000 10 $ RUN [SIMMONS]ALLENG [VOYAGER]P20278.V2;1 0 272 01 00 273 00 00 4 10 -1.,265.,5.,0. 3 607 0 606 0 605 0 604 0 603 0 601 0 600 3 earlyaft.com_7000066403252300000050000000001231032256161300136270ustar00ksimmons00005460002003$ SET VERIFY $ RUN [SIMMONS]AFTERPL [VOYAGER]P20272.V2;1 04 275 06 275 22 000 05 0 earlyeng.com_23000066403252300000050000000002161032256161300137070ustar00ksimmons00005460002003$ SET VERIFY $ RUN [SIMMONS]ALLENG [VOYAGER]P20270.V2;1 0 278 23 30 280 00 00 4 05 -1.,265.,5.,0. 3 607 0 606 0 605 0 604 0 603 0 601 0 600 3 errorfix.com_3000066403252300000050000000006071032256161300136630ustar00ksimmons00005460002003$ VERIFY_SAVE='F$VERIFY("NO") $! This file redirects the error stream to a file named ERRORS.OUT $! and runs the image specified by P1. Before exiting, the error $! stream is reset to the default (The terminal if interactive). $ $! Revert to process-permanent sys$input $ deassign sys$input $ $ assign ERRORS.OUT sys$error $ run 'P1' $ deassign sys$error $ $ IF VERIFY_SAVE THEN SET VERIFY finone_tape.pro_2000066403252300000050000000015361032252534200143340ustar00ksimmons00005460002003; this is a program to get finone.dat off a ; pps-11? tape(KESAVE), an IDL taprd was the only way to get ; a usable format, EXHCANGE COPY and FTCOPY didn't work ; the FTCOPY cmds in this program are used to read past ; apparent end-of-tape markers that 'skipf' would not read ; past. The output of this program, fin, was then saved as ; using the following commands: ; openw,1,'finone.dat',1024*4 ; a=assoc(1,fltarr(1024) ; for i=0,133 do a(i) = fin(*,i) ; ^^ ; there were 133 arrays read from the tape ; before the end of the file tape=fltarr(1024) fin = fltarr(1024,200) spawn,'delete del.dat;*' rewind,1 skipf,1,69 for ind = 0,2 do spawn,'ftcopy pisces$mub0:finone.dat del.dat' skipf,1,330 spawn,'ftcopy pisces$mub0:finone.dat del.dat' for I = 0,200 do begin taprd,tape,1 print, !err fin(*,i) = tape endfor stop end finone_tape.pro_3000066403252300000050000000015441032252534200143340ustar00ksimmons00005460002003; this is a program to get finone.dat off a ; pps-11? tape(KESAVE), an IDL taprd was the only way to get ; a usable format, EXHCANGE COPY and FTCOPY didn't work ; the FTCOPY cmds in this program are used to read past ; apparent end-of-tape markers that 'skipf' would not read ; past. The output of this program, fin, was then saved as ; using the following commands: ; openw,1,'finone.dat',1024*4 ; a=assoc(1,fltarr(1024) ; for i=0,133 do a(i) = fin(*,i) ; ^^ ; there were 133 arrays read from the tape ; before the end of the file tape=fltarr(1024) fin = fltarr(1024,200) spawn,'delete del.dat;*' rewind,1 skipf,1,69 for ind = 0,2 do spawn,'ftcopy pisces$mub0:finone.dat del.dat' skipf,1,330 spawn,'ftcopy pisces$mub0:finone.dat del.dat' ;for I = 0,200 do begin ; taprd,tape,1 ; print, !err ; fin(*,i) = tape ;endfor stop end fitfov.com_11000066403252300000050000000003431026755522200134030ustar00ksimmons00005460002003$ INQUIRE FILE "ENTER WHICH FOV298.BOB FILE TO USE" $ COPY 'FILE' FOV298.TST $ FOR FITFOV $ LINK FITFOV,[WEST.VOY]CURFIT,FDERIV,[WEST.DOUBLING]OLDFCHISQ,OLDMATINV $ PURGE FITFOV.FOR,.EXE,.COM $ DELETE FITFOV.OBJ;* $ RUN FITFOV fitrun.com_2000066403252300000050000000001321026755522300133320ustar00ksimmons00005460002003$ INQUIRE FILE "ENTER WHICH FOV298.BOB FILE TO USE" $ COPY 'FILE' FOV298.TST $ RUN FITFOV foot.cmd_1000066403252300000050000000001041026755522500127570ustar00ksimmons00005460002003FOOT=FOOT,SEDRHDR,SEDRASC,FPCON.OJB,BLKSET.OJB,[SYSLIB]F4POTS/LB // foot.com_4000066403252300000050000000001571026755522600130060ustar00ksimmons00005460002003$ set verify $ fort/noi4 foot $ fort/noi4 foothdr $ fort/noi4 footasc $ link foot,foothdr,footasc,ibmtovax.ojb foot.exe_13000066403252300000050000000150001027674470400130630ustar00ksimmons000054600020030DX0205(`Th FOOT01``T04-00    ?@!d FORRTL_001!  LIBRTL_001ERR100END OF JOBOUTERR ENTER TAPE UNIT "MT4:" ) SUPPLY OUTPUT FILE NAME" OUTPUT UNIT (I2):5=TI,6=LP,0=NONE QIO ERROR AT 300; IOSB= END OF INPUT TAPE  RECORDS WRITTEN OUTPUT FILE OPEN ERROR:  PROJECT  FILE TYPE: S/C IS VOYAGER 2 S/C IS VOYAGER 1 S/C IS SIMULATION UNIT: SEDR TAPE ID:   q P X | ~ x  v   !P @(<    ABCDEFGHI?.<(+ &JKLMNOP R!$*); -/STUVWXYZ ,%_>?0123456789:#@'="|H|[\R S@9  ?STS2TP@=ST~^@(^SP1?hqhPTP ߫|jR2T˘ːP [<?"1̏R˄P2PQA~UAuAp3UAg=(PPS2PQAf=SPPQ2QU2PVME;FEP=Q2~rkY^\1/L2\~"P2P~ )z2~ H[kj2RRS2SP@=S@PPSS,1H?, 6 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9, 7 1H:,1H#,1H@,1H',1H=,1H"/ L=K DO 100 J=1,N IBCDIC=IARR(L+J-1) I=IBCDIC .AND. "77 IASCI=TABLE(I+1) ICH(J)=IASCI 100 CONTINUE RETURN END foot_ck_hdr.for_5000066403252300000050000000023671026531455300143300ustar00ksimmons00005460002003 SUBROUTINE SEDRHD(NAV,IUN) C APR 2,84 Cc Updated Feb 7,92 COMMON NARR(800) LOGICAL*1 IARR(1600),ICH(16),I1,I2,I3,I4,I5,I6,I7 EQUIVALENCE (NARR,IARR) C C THIS ROUTINE FOR DECODEING YOYAGER (MJS) 9-TRACK C TAPE HEADER (=VOLUMN HEADER) AND CHECKING FOR RIGHT TAPE C IUN IS OUTPUT UNIT DEVICE C NAV RETURNS NAVIGATION DATA BLOCK F/T CODE:L=1,C=2,J=3,S=4,X=5 C U=6,N=7 DATA I1/1HL/,I2/1HC/,I3/1HJ/,I4/1HS/,I5/1HX/,I6/1HU/,I7/1HN/ CALL ASCI(1,8,ICH) c WRITE(IUN,5) (ICH(JJ),JJ=1,8) 5 FORMAT(' PROJECT '4A1,' FILE TYPE:'4A1) IDSC=IARR(12) .AND. 7 IF(IDSC .GE. 4) GO TO 120 IDSC=IDSC+1 c IF(IDSC .EQ. 2) WRITE(IUN,15) c IF(IDSC .EQ. 1) WRITE(IUN,115) 115 FORMAT(' S/C IS VOYAGER 2') 15 FORMAT(' S/C IS VOYAGER 1') GO TO 130 120 IDSC=IDSC-3 c WRITE(IUN,25) IDSC 25 FORMAT(' S/C IS SIMULATION UNIT:'I2) 130 CONTINUE CALL ASCI(13,8,ICH) WRITE(5,35) (ICH(JJ),JJ=1,8) WRITE(IUN,35) (ICH(JJ),JJ=1,8) 35 FORMAT(' SEDR TAPE ID:'10A1) c CALL ASCI(53,8,ICH) c NAV=0 c IF(ICH(1) .EQ. I1) NAV=1 c IF(ICH(1) .EQ. I2) NAV=2 c IF(ICH(1) .EQ. I3) NAV=3 c IF(ICH(1) .EQ. I4) NAV=4 c IF(ICH(1) .EQ. I5) NAV=5 c IF(ICH(1) .EQ. I6) NAV=6 c IF(ICH(1) .EQ. I7) NAV=7 c WRITE(IUN,45) ICH(1),NAV c45 FORMAT(' NAVIGATION F/T IS:'A8,' NAV. F/T CODE=',I2) END fovpic.pro_3000066403252300000050000000030371032252534300133330ustar00ksimmons00005460002003 PRO FOVPIC,CONPIX,CLOLIN,DATA,NPTS,PIC,WS,KEY,INIT ;NOV 6, 1980 ; ; CREATES A 128,128 ARRAY OF FOV INTENSITY VS CONE,CLOCK POSN ; OR FOR LINE,PIXEL (WHEN KEY=1) ;IF IN=1 THEN INITIATE ARRAY ; DATA SHOULD BE SCALED BEFORE ENTERING ROUTINE ; WS =1 FOR SMALL SCALE, GT.1 FOR A LARGER (SQUARE) SCALE ; ;CHECKED FEB,84 IF INIT EQ 1 THEN PIC=BYTARR(128,128) ; COLOR OUT EDGES AND PLACE TICKS IN THEM !ORDER=1 ;TVIMAGES: TOP DOWN TEMP=BYTARR(115)+100 FOR I=0,6 DO INSERT,PIC,TEMP,0,I ;TOP FOR I=0,6 DO INSERT,PIC,TEMP,0,I+108 ;BOT TEMP=BYTARR(1,108)+100 FOR I=0,6 DO INSERT,PIC,TEMP,I,0 ;LEFT FOR I=0,6 DO INSERT,PIC,TEMP,I+108,0 ;RIGHT FOR I=0,5 DO FOR J=0,4 DO BEGIN ;TOP + BOT TICKS PIC(107-J*25,I)=20 & PIC(107-J*25,109+I)=20 & END FOR I=0,5 DO FOR J=0,3 DO BEGIN ;MINI-TICKS FOR K=0,4 DO BEGIN PIC(107-J*25-K*5-I,I)=20 PIC(107-J*25-K*5-I,109+I)=20 & END &END FOR I=0,5 DO FOR J=0,4 DO BEGIN ;LEFT +RIGHT TICKS PIC(I,107-25*J)=20 & PIC(109+I,107-25*J)=20 & END FOR I=0,4 DO FOR J=0,3 DO BEGIN ;MINI-LEFT FOR K=0,4 DO BEGIN PIC(I,107-25*J-K*5-I)=20 PIC(109+I,107-25*J-K*5-I)=20 & END &END ; NOW FILL IN DATA (EITHER CO-CLOCK OR LIN-PIXEL ) IF KEY EQ 1 THEN GOTO,LIPIX CLSF=73. & COSF=159.5 ; USE 73.0 FOR 1/16, 73.2 FOR 1/4 (CLOCK) ; USE 159.5 FOR 1/16, 160.6 FOR 1/4 (CONE) GOTO,WORK LIPIX: CLSF=400. & COSF=400. WORK: DUM=0 FOR I=0,NPTS-1 DO BEGIN III=(CLOLIN(I)-CLSF)*25.*WS II=((57-III)>7)<107 IF KEY EQ 1 THEN II=((57+III)>7)<107 JJ=((57+(CONPIX(I)-COSF)*25.*WS)>7)<107 PIC(JJ,II)=DATA(I) END RETURN END fovpic.pro_53000066403252300000050000000027521032252534300134230ustar00ksimmons00005460002003 PRO FOVPIC,CONPIX,CLOLIN,DATA,NPTS,PIC,WS,KEY,INIT ;NOV 6, 1980 ; ; CREATES A 128,128 ARRAY OF FOV INTENSITY VS CONE,CLOCK POSN ; OR FOR LINE,PIXEL (WHEN KEY=1) ;IF IN=1 THEN INITIATE ARRAY ; DATA SHOULD BE SCALED BEFORE ENTERING ROUTINE ; WS =1 FOR SMALL SCALE, GT.1 FOR A LARGER (SQUARE) SCALE ; IF INIT EQ 1 THEN PIC=BYTARR(128,128) ; COLOR OUT EDGES AND PLACE TICKS IN THEM TEMP=BYTARR(115)+100 FOR I=0,6 DO INSERT,PIC,TEMP,0,I ;TOP FOR I=0,6 DO INSERT,PIC,TEMP,0,I+108 ;BOT TEMP=BYTARR(1,108)+100 FOR I=0,6 DO INSERT,PIC,TEMP,I,0 ;LEFT FOR I=0,6 DO INSERT,PIC,TEMP,I+108,0 ;RIGHT FOR I=0,5 DO FOR J=0,4 DO BEGIN ;TOP + BOT TICKS PIC(107-J*25,I)=20 & PIC(107-J*25,109+I)=20 & END FOR I=0,5 DO FOR J=0,3 DO BEGIN ;MINI-TICKS FOR K=0,4 DO BEGIN PIC(107-J*25-K*5-I,I)=20 PIC(107-J*25-K*5-I,109+I)=20 & END &END FOR I=0,5 DO FOR J=0,4 DO BEGIN ;LEFT +RIGHT TICKS PIC(I,107-25*J)=20 & PIC(109+I,107-25*J)=20 & END FOR I=0,4 DO FOR J=0,3 DO BEGIN ;MINI-LEFT FOR K=0,4 DO BEGIN PIC(I,107-25*J-K*5-I)=20 PIC(109+I,107-25*J-K*5-I)=20 & END &END ; NOW FILL IN DATA (EITHER CO-CLOCK OR LIN-PIXEL ) IF KEY EQ 1 THEN GOTO,LIPIX CLSF=73. & COSF=159.5 ; USE 73.0 FOR 1/16, 73.2 FOR 1/4 (CLOCK) ; USE 159.5 FOR 1/16, 160.6 FOR 1/4 (CONE) GOTO,WORK LIPIX: CLSF=400. & COSF=400. WORK: DUM=0 FOR I=0,NPTS-1 DO BEGIN III=(CLOLIN(I)-CLSF)*25.*WS II=((57-III)>7)<107 IF KEY EQ 1 THEN II=((57+III)>7)<107 JJ=((57+(CONPIX(I)-COSF)*25.*WS)>7)<107 PIC(JJ,II)=DATA(I) END RETURN END fovpic.pro_54000066403252300000050000000030541032252534300134200ustar00ksimmons00005460002003 PRO FOVPIC,CONPIX,CLOLIN,DATA,NPTS,PIC,WS,KEY,INIT ;NOV 6, 1980 ; ; CREATES A 128,128 ARRAY OF FOV INTENSITY VS CONE,CLOCK POSN ; OR FOR LINE,PIXEL (WHEN KEY=1) ;IF IN=1 THEN INITIATE ARRAY ; DATA SHOULD BE SCALED BEFORE ENTERING ROUTINE ; WS =1 FOR SMALL SCALE, GT.1 FOR A LARGER (SQUARE) SCALE ; ;CHECKED FEB,84 IF INIT EQ 1 THEN PIC=intARR(128,128) ;*****change ; COLOR OUT EDGES AND PLACE TICKS IN THEM !ORDER=1 ;TVIMAGES: TOP DOWN TEMP=BYTARR(115)+100 FOR I=0,6 DO INSERT,PIC,TEMP,0,I ;TOP FOR I=0,6 DO INSERT,PIC,TEMP,0,I+108 ;BOT TEMP=BYTARR(1,108)+100 FOR I=0,6 DO INSERT,PIC,TEMP,I,0 ;LEFT FOR I=0,6 DO INSERT,PIC,TEMP,I+108,0 ;RIGHT FOR I=0,5 DO FOR J=0,4 DO BEGIN ;TOP + BOT TICKS PIC(107-J*25,I)=20 & PIC(107-J*25,109+I)=20 & END FOR I=0,5 DO FOR J=0,3 DO BEGIN ;MINI-TICKS FOR K=0,4 DO BEGIN PIC(107-J*25-K*5-I,I)=20 PIC(107-J*25-K*5-I,109+I)=20 & END &END FOR I=0,5 DO FOR J=0,4 DO BEGIN ;LEFT +RIGHT TICKS PIC(I,107-25*J)=20 & PIC(109+I,107-25*J)=20 & END FOR I=0,4 DO FOR J=0,3 DO BEGIN ;MINI-LEFT FOR K=0,4 DO BEGIN PIC(I,107-25*J-K*5-I)=20 PIC(109+I,107-25*J-K*5-I)=20 & END &END ; NOW FILL IN DATA (EITHER CO-CLOCK OR LIN-PIXEL ) IF KEY EQ 1 THEN GOTO,LIPIX CLSF=73. & COSF=159.5 ; USE 73.0 FOR 1/16, 73.2 FOR 1/4 (CLOCK) ; USE 159.5 FOR 1/16, 160.6 FOR 1/4 (CONE) GOTO,WORK LIPIX: CLSF=400. & COSF=400. WORK: DUM=0 FOR I=0,NPTS-1 DO BEGIN III=(CLOLIN(I)-CLSF)*25.*WS II=((57-III)>7)<107 IF KEY EQ 1 THEN II=((57+III)>7)<107 JJ=((57+(CONPIX(I)-COSF)*25.*WS)>7)<107 PIC(JJ,II)=DATA(I) END RETURN END fpcon.mac_1000066403252300000050000000050071026755523200131170ustar00ksimmons00005460002003 .TITLE FPCON - IBM TO PDP-11 FLOATING POINT CONVERSION .IDENT /V1.0/ .PSECT ; FPCON: FORTRAN CALLABLE SUBROUTINE FOR CONVERTING ; IBM 360 FLOATING POINT TO PDP-11 FLOATING POINT. ; ; FORTRAN CALLING SEQUENCE: ; ; CALL FPCON (FPIN,FPOUT,NUM) ; ; FPIN - INPUT ARRAY CONTAINING 32 BIT IBM 360 FORMAT ; FLOATING POINT NUMBERS. ; ; FPOUT - OUTPUT ARRAY WHICH WILL CONTAIN 32 BIT PDP-11 ; FORMAT FLOATING POINT NUMBERS. FPOUT MAY BE ; THE SAME ARRAY AS FPIN. ; ; NUM - NUMBER OF 32 BIT WORDS TO BE CONVERTED. FPCON:: TST (R5)+ ; SKIP ARGUMENT COUNT MOV (R5)+,R0 ; ADDRESS OF FPIN ARRAY MOV (R5)+,R1 ; ADDRESS OF FPOUT ARRAY MOV @(R5)+,NWORDS ; # OF WDS TO BE CONVERTED ; 1$: DEC NWORDS ; DECREMENT WD COUNT BLT 10$ ; BRANCH IF ALL WDS CONVERTED MOV (R0)+,R2 ; GET 1ST 16 BITS OF IBM WD MOV (R0)+,R3 ; GET LOW 16 BITS OF IBM WD BNE 2$ ; BRANCH IF LOW 16 BITS NOT ZERO TST R2 ; IF THEY ARE, CHECK 1ST 16 BITS BNE 2$ CLR (R1)+ ; IF IBM WORD IS ZERO... CLR (R1)+ ; SET PDP-11 WORD TO ZERO... BR 1$ ; AND GO FOR NEXT WD 2$: MOV R2,R5 ; TRANSFER 1ST 16 BITS TO R5 SXT R4 ; EXTEND SIGN THROUGHOUT R4 SWAB R5 ; PUT EXPONENT INTO LOW BYTE BIC #177600,R5 ; MASK OFF EXPONENT SUB #64.,R5 ; SUBTRACT HEX BIAS ASL R5 ; MULTIPLY BY 2... ASL R5 ; AND 2 AGAIN ADD #128.,R5 ; ADD BINARY BIAS BGT 4$ CLR (R1)+ ; EXPONENT UNDERFLOW... CLR (R1)+ ; SET PDP-11 WD TO ZERO... BR 1$ ; AND GO FOR NEXT NUMBER 4$: CMP R5,#256. ; TEST FOR EXPONENT OVERFLOW BLT 5$ ; EXPONENT WITHIN PDP-11 RANGE MOV #-1,R2 ; IF EXPONENT OVERFLOW... MOV #-1,R3 ; SET PDP-11 WD TO MAXIMUM... MOV #377,R5 ; AND CONTINUE PROCESSING... BR 7$ ; AT STATEMENT 7$ 5$: ASHC #8.,R2 ; GET THE FRACTION PART OF WD MOV #24.,NSHIFT ; MAXIMUM BIT SHIFT COUNT 6$: ASHC #1,R2 ; SHIFT LEFT ONE MORE BIT BCS 7$ ; WAS A ONE BIT SHIFTED OFF? DEC R5 ; IF NOT, DECREMENT EXPONENT DEC NSHIFT ; DECREMENT SHIFT COUNT BGT 6$ ; IF MORE BITS REMAIN, CHECK 'EM CLR (R1)+ ; IF FRACTION IS ZERO... CLR (R1)+ ; SET PDP-11 WD TO ZERO... BR 1$ ; AND GO FOR NEXT WD 7$: ASHC #-9.,R2 ; ALIGN THE FRACTION PART OF WD BIC #177600,R2 ; CLEAR TOP 9 BITS OF TOP WD SWAB R5 ; PUT EXPONENT INTO TOP BYTE ASHC #-1,R4 ; ALIGN SIGN AND EXPONENT IN R5 BIS R5,R2 ; COMBINE EXPONENT AND FRACTION MOV R2,(R1)+ ; STORE 1ST 16 BITS OF PDP-11 WD MOV R3,(R1)+ ; STORE LOW 16 BITS OF PDP-11 WD BR 1$ ; GO PROCESS NEXT WD ; 10$: RETURN ; RETURN TO CALLING ROUTINE NWORDS: .WORD 0 NSHIFT: .WORD 0 .END get_vgr_ha.pro_2000066403252300000050000000010001032256262600141420ustar00ksimmons00005460002003; pro get_vgr_Ha ;Dec 19,89 KES ; retrieves Voyager Nav data into assoc arrays for analysis with SME ; H-a data nd=365 ;number of days in 1982 openr,3,'diskg:[voyager]vgr2_barth_ha.dat' a=assoc(3,fltarr(nd)) ;one value per day of yr state_x=a(0) ;Cart. state of s/c, sun state_y=a(1) ; centered, EM Ecliptic state_z=a(2) ; and Equinox of 1950 ra_sun=a(3) ;RA/DEC of s/c, Sun centered,Sun dec_sun=a(4) ; true equinox and Equat.of date date=a(5) ;decimal days of 1982 end how_to_make_foot_lbl.doc000066403252300000050000000076501064251456200157570ustar00ksimmons00005460002003; /ansa2/simmons/ how_to_make_foot_lbl.doc July 3, 07 @ansa/data =>idl IDL Version 5.4 (sunos sparc). (c) 2000, Research Systems, Inc. Installation number: 100-550. Licensed for use by: University of Colorado IDL> .run /ansa4/gll_archive/new_pds_label.pro_unix % Compiled module: PAD. % Compiled module: GET_CURRENT_DATE. % Compiled module: GET_CREATE_TIME. % Compiled module: PHASE_MENU. % Compiled module: TARGET_MENU. % Compiled module: GET_FPNT. % Compiled module: LIST_FILES. % Compiled module: UVS_FOOT. % Compiled module: SAT_GEOM. % Compiled module: SAT_PHASE. % Compiled module: JUP_RTS_LON1132. % Compiled module: JUP_PB_INT600. % Compiled module: PREJUP_EUV_MRO. % Compiled module: PREJUP_PB_INT600. % Compiled module: JUP_LOOK. % Compiled module: UVS_LOOK. % Compiled module: PDS_LABEL. IDL> pds_label ****************************************** **** PDS Label Writer **** ****************************************** Please choose an instrument -- (1) UVS (2) EUV --> 1 Please choose a datafile type (For GEOM & status files, choose RDR) -- (1) RDR (2) EDR --> 1 Please choose the label template you wish to use Want to process a UVS LOOK file (y=y)? n ( 0) /ansa4/gll_archive/uvs/rdr_templates/browse_geom.lbl_51 ( 1) /ansa4/gll_archive/uvs/rdr_templates/jup_orbit_status.lbl_1 ( 2) /ansa4/gll_archive/uvs/rdr_templates/pb_orbit_status.lbl_1 ( 3) /ansa4/gll_archive/uvs/rdr_templates/rts_orbit_status.lbl_3 ( 4) /ansa4/gll_archive/uvs/rdr_templates/sat_phase_geom.lbl_50 ( 5) /ansa4/gll_archive/uvs/rdr_templates/sat_phase_geom.lbl_51 ( 6) /ansa4/gll_archive/uvs/rdr_templates/uvs_footprint.lbl ( 7) /ansa4/gll_archive/uvs/rdr_templates/uvs_torus_look.lbl_12 ( 8) /ansa4/gll_archive/uvs/rdr_templates/uvs_torus_look.lbl_14 ( 9) /ansa4/gll_archive/uvs/rdr_templates/uvs_torus_look.lbl_15 Enter your selection --> 6 % Compiled module: RSTRPOS. % Compiled module: REVERSE. template choosen is: uvs_footprint.lbl NOTE: The .FOOT files should be in the uvs_p2 directory QUIT AND GO TO THAT DIRECTORY IF YOU ARE NOT THERE NOW Give the data files label file? i24b_urt_grating.lbl_1 (NOTE:this is the data file's label file name) How many records in .foot file? 180 14DESCRIPTION = " i, prod id= 0 CCSD3ZF0000100000001NJPL3IF0PDSX00000001 i, prod id= 1 i, prod id= 2 /* FILE: I24B_URT_GRATING.LBL */ i, prod id= 3 /* VERSION 1.4: 28-OCT-2005 MOSSER */ i, prod id= 4 i, prod id= 5 PDS_VERSION_ID = PDS3 i, prod id= 6 RECORD_TYPE = FIXED_LENGTH i, prod id= 7 RECORD_BYTES = 4528 /*=1132*4 */ i, prod id= 8 FILE_RECORDS = 1 descrip line? ^SPECTRUM = "I24B_URT_GRATING.DAT" log doc lines 0 log doc lines 1 During the generation of the footprint data file a log file is log doc lines 2 generated that documents the input information, such as the SPICE log doc lines 3 kernel data sources for the generated data. This information is below. log doc lines 4 log doc lines 5 Finished processing i24b_urt_grating.lbl_1 Make another label? (y/n)n IDL> exit @ansa/data => ibmtovax.mar_14000066403252300000050000000032751033671341400137460ustar00ksimmons00005460002003 .TITLE IBMTOVAX - IBM TO VAX FP CONVERSION .IDENT /A1.0/ ; LAST UPDATE: 08-JUN-82 .PSECT FP_IBMTOVAX:: .WORD ^M ; Register mask MOVL 4(AP),R0 ; Get address of input array MOVL 8(AP),R1 ; Get address of output array MOVL @12(AP),R2 ; GET NUMBER OF VALUES TO CONVERT ; ;10$: cmpl (R0),#-1 ; Is this reserved operand? ; bneq 11$ ; MOVL (R0)+,(R1)+ ; CLRL (R1)+ ;TRY JUST CLEARING WORD...KES ; BRW 4$ ;11$: cmpb 3(R0),#^X7F ; bneq 12$ ; MOVL #^X7FFFFFFF,(R1)+ ; CLRL (R1)+ ;DITTO...KES ; TSTL (R0)+ ; BRW 4$ ; 12$: extzv #0,#7,(R0)+,-(SP); (SP) <-- exponent subl #64,(SP); sub. hex exp bias (excess 64) ashl #2,(SP),(SP); times 4 --> binary exp addl #128,(SP); add bin exp bias (excess 128) bgeq 1$; ok if no underflow clrl (SP); else use zero ; 1$: cmpl (SP),#255; check for overflow blss 2$; branch if not overflow tstl (SP)+; else pop stack and addl #3,R0; bump ptr over next 3 bytes and bisl #-1,(R1)+; set result to all ones brb 4$; and go wrapup ; 2$: ashl #7,(SP),(SP); position exp as in f.p. format mulf2 #2.0,(SP); adjust for hidden bit ; clrb temp+3 movb (R0)+,temp+2; temp <-- fraction part movb (R0)+,temp+1; re-ordered to DEC movb (R0)+,temp; convention bitb #128,-4(R0); test original sign bit beql 3$; branch if zero (positive) mnegl temp,temp; fract <-- neg fract ; 3$: cvtlf temp,-(SP); (SP) <-- float fract (as integer) mulf2 tm24,(SP); shift binary point for fraction mulf3 (SP)+,(SP)+,(R1)+; result <-- exp * fraction ; 4$: DECL R2 BLEQ 41$ BRW 12$ 41$: ret; and return ; tm24: .float 5.9604645E-8; 2**(-24) ; temp: .quad 0; Temporary storage for reordering bytes .end merg_n_p.com_4000066403252300000050000000002301026531543200136040ustar00ksimmons00005460002003$ set verify $ fort/cross_reference/list/nod_lines merg_nep_pred $ fort/list [.vgr]unpack $ link merg_nep_pred,unpack,[.vgr]ibmtovax.ojb $ set noverify merg_nep_pred.for_3000066403252300000050000000303771026531543100146510ustar00ksimmons00005460002003C PROGRAM MERGE ***MERG_NEP_PRED.FOR Cc DEC 14, 81 Cc Updated for Uranus (esp. FOOT=140 array) Jul,86 Cc Updated for Uranus, new param from FOOT Sept 8,88 Cc Correct assignment error in FOTFIL Sept 13,88 C# Updated for Neptune params, FOOT changes Sept 9,89 C# All changes indicated with "C#" C$$ This version for running from Predict tapes; it zeroes C$$ any need for NAV tapes and fills in zero values C$$ for what would normally be in the SP tapes Sept 11,89 C$$ C A FORTRAN MERGE ROUTINE FOR VOYAGER SATURN DATA SETS C C MERGES EDR ASSOCIATED FILES WITH SEDR NAV. FILES AND C SEDR FOOTPRINT FILES. C REFORMAT,SEDRJOB, AND FOOT RUNS MUST BE USED TO CREATE C THE DATA SETS BEFORE THE MERGE PROCESS C C OUTPUT IS AN ASSOC. FILE CONTAINING EDR (WITH ENG),NAV, C AND FOOT VALUES IN CONSECUTIVE ASSOC ARRAYS. C COMMON/OUTARR/ANS(650) INTEGER*2 IHDR,IDAT,IENG C# COMMON IHDR(256),IDAT(256),IENG(256),RNAV(50),PV(30),FOOT(140) COMMON IHDR(256),IDAT(256),IENG(256),RNAV(50),PV(30),FOOT(160) dimension fnew(50) CHARACTER*25 NAMDAT,NAMNAV,NAMFOT,NAMOUT CHARACTER RUNDAY*9,RUNTIM*8 DATA LENNAV/80/,LENFOT/50/,FDSF1/0./,FDSF2/0./,KF/50/ DATA FDS1/0./FDS2/0./,INAV/0/,IFOT/0/ C WRITE(5,5) READ(5,15) NAMDAT READ(5,15) NAMNAV READ(5,15) NAMFOT READ(5,15) NAMOUT OPEN(UNIT=1,ACCESS='DIRECT',NAME=NAMDAT, + ASSOCIATEVARIABLE=IREC,IOSTAT=INERR, + ERR=7000,STATUS='OLD',READONLY) C CALL ASSIGN(2,NAMNAV,0) C CALL ASSIGN(3,NAMFOT,0) C OPEN(UNIT=4,NAME=NAMOUT,ACCESS='DIRECT',BLOCKSIZE=2600, + ASSOCIATEVARIABLE=NREC,MAXREC=10000,IOSTAT=NERR,RECL=650, + ERR=9000,STATUS='NEW') C 5 FORMAT(' SUPPLY FILE NAMES (ONE PER LINE):DATA,NAV,FOOT,OUTPUT') 15 FORMAT(A25) WRITE(5,25) 25 FORMAT(' SUPPLY SCE START DOY,HR,MIN (3F10.7)') READ(5,35) BDAY,BHR,BMIN 35 FORMAT(3F10.7) WRITE(5,45) 45 FORMAT(' END DOY,HR,MIN (3F10.7)') READ(5,35) EDAY,EHR,EMIN START=BDAY+(BHR/24.)+(BMIN/1440.) ENDTIM=EDAY+(EHR/24.)+(EMIN/1440.) WRITE(7,55) BDAY,BHR,BMIN,EDAY,EHR,EMIN,NAMDAT,NAMNAV,NAMFOT 55 FORMAT(4X,' DATA/GEOMETRY MERGE LOG FOR SATURN DATA',/, + ' TIME OF MERGE (IN SCE) IS:',3F6.1,' TO ',3F6.1,' .', + /,' THE MERGE INCORPORATES THE FOLLOWING FILES:',/,(1X,A25)) CALL DATE(RUNDAY) CALL TIME(RUNTIM) WRITE(7,65) NAMOUT,RUNDAY,RUNTIM 65 FORMAT(' THE OUTPUT FILE IS:',A25,' CREATED:',A9,1X,A8,//) C IREC=1 !INITIALIZE DIRECT ACCESS RECORD COUNTERS NREC=1 C READ THE 1ST DATA RECORD; SKIP ENGINEERING RECORDS FOR NOW C POSITION THE RECORD COUNTER FOR 1ST REC. AFTER START TIME GIVEN 100 CONTINUE FLAST1=FDS1 FLAST2=FDS2 READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IHDR D WRITE(7,105) IHDR(2),IHDR(28),IREC,IHDR(4),IHDR(5),IHDR(6) 105 FORMAT(' MODE,LEN,IREC',3I7,10X,3I5) IF(IHDR(28) .GT. 80) THEN !CHECK IF AN ENG. REC. IQAN=IHDR(28)/256 IF(IQAN*256 .LT. IHDR(28)) IQAN=IQAN+1 Ccc IF(IHDR(28) .EQ. 600) IQAN=10 IF(IHDR(28) .EQ. 600) IQAN=9 DO 120 JJ=1,IQAN READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IENG D WRITE(7,115) IHDR(28),IREC,IQAN 115 FORMAT(' LEN,IREC,IQAN',3I7) 120 CONTINUE GO TO 100 !READ THE NEXT HEADER END IF READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IDAT !READ DATA, CHECK TIME CURRENT=IHDR(4)+(IHDR(5)/24.)+(IHDR(6)/1440.)+(IHDR(7)/86000.) IF(CURRENT .LT. START) GO TO 100 200 CONTINUE !DATA PROPERLY POSITIONED IF(CURRENT .GT. ENDTIM) GO TO 7100 CALL UNPACK(IHDR,IDAT,CURRENT,IFLAG) IF(IFLAG .EQ. 1) GO TO 200 FDS1=ANS(9) FDS2=ANS(10) FDS3=ANS(11) IF(FDS3 .NE. 1.) THEN IF(FDS2 .EQ. 0. .AND. FLAST2 .EQ. 59.) GO TO 220 WRITE(7,205) IREC,NREC,FDS1,FDS2,FDS3 IF(FLAST2 .EQ. FDS2 .AND. FLAST1 .EQ. FDS1) GO TO 500 END IF 220 IF(FDS2 .NE. FLAST2+1.) WRITE(7,215) IREC,NREC,FLAST1,FLAST2, + FDS1,FDS2,FDS3 205 FORMAT(' LATE START (DATA GAP):I/O RECS',2I7, + ' THIS FDS TIME:',F9.1,2F5.1) 215 FORMAT(' GAP OR FDS ROLL OVER(I/0):',2I5, + ' LAST:',F8.1,F5.1,' THIS:',F8.1,2F5.1) D WRITE(7,225) FDS1,FDS2,FDS3 225 FORMAT(4X,' LOOKING FOR',F9.1,2F5.1) GO TO 270 250 Continue !C$$ do 2555 ijnav=1,50 !C$$ if( ijnav .le. 30) pv(ijnav)=-1. !C$$ 2555 rnav(ijnav)=-1. !C$$ go to 276 !C$$ 260 dum=0. !C$$ READ(UNIT=2, IOSTAT=NAVERR, END=8050, ERR=8040) RNAV,PV INAV=INAV+1 !CHECK NAV POSITION IF(PV(7) .LT. 0.) PV(7)=PV(7)+65536. FDSN1=PV(7) FDSN2=PV(8) D WRITE(7,235) INAV,RNAV(2),RNAV(3),RNAV(4),RNAV(5),RNAV(6), D + PV(2),PV(3),PV(4),PV(5),PV(6),PV(7),PV(8) 235 FORMAT(' NAV:',I5,5F5.1,' PV',5F5.1,F8.1,F5.1) 255 FORMAT(4X,' NAVREC',I4,' NAV FDS:',F9.1,F5.1) 270 IF(FDSN1 .GT. FDS1 ) GO TO 8080 IF(FDSN1 .LT. FDS1) GO TO 250 IF(FDSN2 .LT. FDS2) GO TO 250 C ONE NAV.SEDR COMES WITH EACH EDR (ONE MAJOR FRAME EACH) D WRITE(7,255) INAV,FDSN1,FDSN2 276 DO 280 II=1,LENNAV !C$$ ANS(300+II)=RNAV(II) 280 CONTINUE 300 CONTINUE !POSITION FOOT FILE(AT LINE=001) C HAVE TO MAKE AN INITIAL ASSUMPTION THAT THOSE FILES C CONTAINING 12 SECOND FOOTPRINT TIMING ACTUALLY START AT C LINE=001 IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 IF(FDSF2 .EQ. FDS2) GO TO 314 GO TO 8180 310 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT C# CALL FOTFIL(FOOT,140,FNEW) !TO URANUS F/T CALL FOTFIL(FOOT,160,FNEW) !C# TO Neptune F/T IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=65536.+FOOT(7) IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT 325 FORMAT(' FOOTPRINT TIME DROPOUT',3F5.1,F9.1,F5.1,' REC:',I5) FDSF1=FOOT(7) FDSF2=FOOT(8) IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 WRITE(7,315) IFOT,FDSF1,FDSF2 315 FORMAT(4X,'IFOT,FDS',I5,F9.1,F5.1) Cc Add call to new Uranus/Neptune FOOT conversion routine 314 DO 320 II=1,LENFOT Cc320 ANS(400+II)=FOOT(II) 320 ANS(400+II)=FNEW(II) ANS(381)=FOOT(32) !C# Body center Ra (S/C Centered) ANS(382)=FOOT(33) !C# Body center Dec (S/C Centered) ANS(383)=FOOT(61) !C# Optic Axis Ra (S/C Centered) ANS(384)=FOOT(62) !C# Optic Axis Dec (S/C Centered) F2LAST=FDSF2 F1LAST=FDSF1 JJ=KF jkf=0 !C# Count (Ra/Dec) array offset 350 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT C# CALL FOTFIL(FOOT,140,FNEW) !To Uranus f/t CALL FOTFIL(FOOT,160,FNEW) !C# To Neptune f/t IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=FOOT(7)+65536. IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT FDSF1=FOOT(7) FDSF2=FOOT(8) 355 FORMAT(4X,' INNER FOOT',I5,F9.1,F5.1) IF(FDSF2 .GT. F2LAST) GO TO 500 IF(FDSF2 .EQ. 0. .AND. F2LAST .EQ. 59.) GO TO 500 !DEC 14,81 D WRITE(7,355) IFOT,FDSF1,FDSF2 IF(400+JJ+LENFOT .GT. 650) GO TO 390 DO 380 II=1,LENFOT Cc380 ANS(400+JJ+II)=FOOT(II) 380 ANS(400+JJ+II)=FNEW(II) JJ=JJ+KF jkf=jkf+4 !C# Count offset ANS(381+jkf)=FOOT(32) !C# Body center Ra (S/C Centered) ANS(382+jkf)=FOOT(33) !C# Body center Dec (S/C Centered) ANS(383+jkf)=FOOT(61) !C# Optic Axis Ra (S/C Centered) ANS(384+jkf)=FOOT(62) !C# Optic Axis Dec (S/C Centered) GO TO 350 390 WRITE(5,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 395 FORMAT(' FOOTPRINT OVERFLOWING ANS ARRAY:',F9.1,F5.1, + F9.1,F5.1,' JJ=',I4,I7) WRITE(7,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 500 CONTINUE !WRITE THEN OUTPUT TO DISK IF(NREC .GT. 10000) THEN WRITE(5,515) WRITE(7,515) GO TO 7100 END IF WRITE(4,REC=NREC) ANS L=400+KF WRITE(7,505) NREC-1,ANS(4),ANS(5),ANS(6),ANS(7),ANS(9),ANS(10), + ANS(11), + ANS(302),ANS(303),ANS(304),ANS(305),ANS(352),ANS(353),ANS(354), + ANS(355),ANS(357),ANS(358),ANS(402),ANS(403),ANS(404),ANS(405), + ANS(407),ANS(408),ANS(L+2),ANS(L+3),ANS(L+4),ANS(L+5), + ANS(L+7),ANS(L+8) 505 FORMAT(I5,F5.0,3F3.0,F7.0,F3.0,F4.0,2('+',F5.0,3F3.0),F7.0,F3.0, + 2('+',F5.0,3F3.0,F7.0,F3.0)) 515 FORMAT(' OUTPUT MAXREC LIMIT; CLOSE OUT JOB') GO TO 100 7000 CONTINUE !ERROR ON OPENING DATA FILE WRITE(5,7005) INERR 7005 FORMAT(' ERROR OPENING DATA FILE:',I5) STOP 7000 7100 WRITE(5,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 7105 FORMAT(' END TIME REACHED',/,I10,' INPUT RECORDS READ',/, + I10,' OUTPUT RECORDS WRITTEN',/, + ' THE FINAL EDR TIME IS:',4I5,F9.1,2F5.1) WRITE(7,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 CLOSE(UNIT=4) CLOSE(UNIT=1) CLOSE(UNIT=2) CLOSE(UNIT=3) STOP 7200 CONTINUE WRITE(5,7205) INERR WRITE(7,7205) INERR 7205 FORMAT(' DATA FILE ERROR:',I5,' ASSUME END OF DATA FILE') GO TO 7100 8000 CONTINUE !ERROR ON NAVIGATION FILE WRITE(5,8005) NAVERR,RNAV(2),PV(2) 8005 FORMAT(' ERROR OPENING NAV FILE:',I5,2F10.1) STOP 8000 8040 WRITE(5,8045) NAVERR 8045 FORMAT(' NAV. READ STATUS ERROR:',I5) GO TO 250 8050 WRITE(5,8055) INAV,FDSN1,FDSN2,FDS1,FDS2,NAVERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 250 WRITE(7,8055) INAV,FDSN1,FDSN2,FDS1,FDS2 8055 FORMAT(' NAV FILE EOF AT REC',I5,' FDS=',F9.1,F5.1, + ' WHILE LOOKING FOR ',F9.1,F5.1,' MUST STOP',I5) 8065 FORMAT(' FILE READ ERROR; WANT TO TRY TO CONTINUE?(YES=1)') 8075 FORMAT(I1) CLOSE(UNIT=4) STOP 8055 8080 WRITE(5,8085) FDS1,FDS2,FDS3,FDSN1,FDSN2,IREC,INAV,IFOT C DATA IS GOOD BUT THERE IS A NAV FILE GAP; ZERO NAV FROM C LAST VALUES, GO DOWN TO FOOT AND CHECK VALUES THERE 8085 FORMAT(' NAV IS AHEAD OF DATA; TIMES:',F9.1,2F5.1,F9.1,F5.1, + ',IR,NR,NF=',3I5) DO 8082 II=300,399 8082 ANS(II)=0. GO TO 300 8100 WRITE(5,8105) IFOTERR 8105 FORMAT(' ERROR OPENING FOOT FILE:',I5) STOP 8100 8140 WRITE(5,8145) IFOTERR 8145 FORMAT(' FOOT READ STATUS ERROR:',I5) GO TO 310 8150 WRITE(5,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2,IFOTERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 300 WRITE(7,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2 8155 FORMAT(' FOOT FILE EOF AT REC',I5,' (FDS=',F9.1,F5.1, + ') WHILE LOOKING FOR',F9.1,F5.1,' MUST STOP') CLOSE(UNIT=4) STOP 8150 8180 WRITE(5,8185) FDS1,FDS2,FDS3,FDSF1,FDSF2,IREC,INAV,IFOT 8185 FORMAT(' FOOT IS AHEAD OF DATA; TIMES ', + F9.1,2F5.1,F9.1,F5.1,' IR,NR,NF=',3I5) C FOOTPRINT FILE IS AHEAD SO ZERO OLD FOOT VALUES AND WRITE OUT C WHAT YOU HAVE SO FAR (AT LEAST DATA); CYCLE OTHER AREAS TIL C FIND GOOD FOOTPRINT DO 8182 II=400,650 8182 ANS(II)=0. GO TO 500 9000 WRITE(5,9005) NERR 9005 FORMAT(' ERROR OPENING OUTPUT FILE:',I5) STOP 9000 10000 CONTINUE C ***************************************** C# See the file WRITEUP_N.TXT for a description of record contents END C SUBROUTINE FOTFIL(FOOT,LENFOT,FNEW) !JUL 18,86 C This subroutine to convert Uranus/Nept format Footprint C records into the Saturn parameter format list C Note: Because of the Uranus FOOT IBMTOVAX call, the C params are offset 2 array locs from JPL loc C# Changes for Neptune are shown with "C#" DIMENSION FOOT(LENFOT),FNEW(50) C S.ARRAY POSN = U.ARRAY POSN & ID DO 100 I=1,8 100 FNEW(I)=FOOT(I) !SCE YR,DOY,HR,MIN,SEC,MSEC Cc FNEW(9)=FOOT(2) !PICTURE BODY ID **not avail FNEW(9)=FOOT(12-2) !PICTUNE BODY FLATTENING C# FNEW(10)=FOOT(68-2) !MOTION BIT FNEW(11)=FOOT(43-2) !PIC. BOD SUB-SOLAR PLANETODETIC LAT FNEW(12)=FOOT(44-2) ! & LON FNEW(13)=FOOT(45-2) ! " " " S/C " LAT FNEW(14)=FOOT(46-2) ! & LON FNEW(15)=FOOT(62-2) !CELESTIAL CONE OF PPS OPTIC AXIS FNEW(16)=FOOT(69-2) !INST OPTIC AXIS-S/C-PICT BODY CENTER ANGLE FNEW(17)=FOOT(71-2) !SLANT RANGE FNEW(18)=FOOT(72-2) !PLANETODETIC LAT OF PICT BODY INTERCEPT FNEW(19)=FOOT(73-2) ! " " LON " FNEW(20)=FOOT(74-2) !SOLAR INCIDENCE ANGLE FNEW(21)=FOOT(75-2) !EMISSION ANGLE (BOTH INCL. PLANET OBLATENESS) FNEW(22)=FOOT(77-2) !AZ IN PLANE...P5-P6 TO P5-SUN FNEW(23)=FOOT(78-2) !AZ IN PLANE...P5-P6 TO P5-S/C FNEW(24)=FOOT(83-2) !ALT OF OPTIC AXIS FNEW(25)=FOOT(76-2) !PICT BOD INTERCEPT PHASE ANGLE FNEW(26)=FOOT(82-2) ! " " " LOCAL HOUR ANGLE FNEW(27)=FOOT(40-2) !RANGE S/C TO CENTRAL BOD Cc FNEW(28)=FOOT(14-2) !TIME TO PERIAPSIS Sept 8,88 FNEW(28)=FOOT(36-2) !RANGE S/C TO SUN Sept 8,88 DO 110 I=1,3 110 FNEW(29+I-1)=FOOT(15+I-1-2) !CARTESIAN POSN OF S/C, CENTRAL BODY CENT Cc DO 120 I=1,8 ! error... DO 120 I=1,9 ! corrected Sept 13,88 120 FNEW(32+I-1)=FOOT(49+I-1-2) !TRANSFORMATION MATRIX DO 130 I=1,3 130 FNEW(41+I-1)=FOOT(24+I-1-2) !CART.UNIT VECT OF SUN, S/C CENT DO 140 I=1,3 140 FNEW(44+I-1)=FOOT(27+I-1-2) !CART. UNIT VECT OF EARTH, S/C CENT FNEW(47)=FOOT(36-2) !RANGE CENTRAL BOD TO SUN FNEW(48)=FOOT(85-2) !RANGE, CENT. BOD CENT TO RING PLANE INTERC FNEW(49)=FOOT(86-2) !LON. RING PLANE INTERC PT PROJ. ON CENT.BOD C# FNEW(50)=FOOT(139) !PPS OPTIC AXIS "CHI" FNEW(50)=FOOT(159) !PPS OPTIC AXIS "CHI" RETURN END E OUTPUT FILE IS:',A25,' CREATED:',A9,1X,A8,//) C IREC=1 !INITIALIZE DIRECT ACCESS RECORD COUNTERS NREC=1 C READ THE 1ST DATA RECORD; SKIP ENGINEERING RECORDS FOR NOW C POSITION THE RECORD COUNTER FOR 1ST REC. AFTER START TIME GIVEN 100 CONTINUE FLAST1=merge.com_5000066403252300000050000000002061026531542000131160ustar00ksimmons00005460002003$ set verify $ fort/cross_reference/list/nod_lines merge_uran $ fort/list unpack $ link merge_uran,unpack,ibmtovax.ojb $ set noverify merge_nept.com_3000066403252300000050000000002221026531542100141410ustar00ksimmons00005460002003$ set verify $ fort/cross_reference/list/nod_lines merge_nept $ fort/list [.vgr]unpack $ link merge_nept,unpack,[.vgr]ibmtovax.ojb $ set noverify merge_nept.for_3000066403252300000050000000302201026531542400141550ustar00ksimmons00005460002003C PROGRAM MERGE Cc DEC 14, 81 Cc Updated for Uranus (esp. FOOT=140 array) Jul,86 Cc Updated for Uranus, new param from FOOT Sept 8,88 Cc Correct assignment error in FOTFIL Sept 13,88 C# Updated for Neptune params, FOOT changes Sept 9,89 C# All changes indicated with "C#" C A FORTRAN MERGE ROUTINE FOR VOYAGER SATURN DATA SETS C C MERGES EDR ASSOCIATED FILES WITH SEDR NAV. FILES AND C SEDR FOOTPRINT FILES. C REFORMAT,SEDRJOB, AND FOOT RUNS MUST BE USED TO CREATE C THE DATA SETS BEFORE THE MERGE PROCESS C C OUTPUT IS AN ASSOC. FILE CONTAINING EDR (WITH ENG),NAV, C AND FOOT VALUES IN CONSECUTIVE ASSOC ARRAYS. C COMMON/OUTARR/ANS(650) INTEGER*2 IHDR,IDAT,IENG C# COMMON IHDR(256),IDAT(256),IENG(256),RNAV(50),PV(30),FOOT(140) COMMON IHDR(256),IDAT(256),IENG(256),RNAV(50),PV(30),FOOT(160) dimension fnew(50) CHARACTER*25 NAMDAT,NAMNAV,NAMFOT,NAMOUT CHARACTER RUNDAY*9,RUNTIM*8 DATA LENNAV/80/,LENFOT/50/,FDSF1/0./,FDSF2/0./,KF/50/ DATA FDS1/0./FDS2/0./,INAV/0/,IFOT/0/ C WRITE(5,5) READ(5,15) NAMDAT READ(5,15) NAMNAV READ(5,15) NAMFOT READ(5,15) NAMOUT OPEN(UNIT=1,ACCESS='DIRECT',NAME=NAMDAT, + ASSOCIATEVARIABLE=IREC,IOSTAT=INERR, + ERR=7000,STATUS='OLD',READONLY) C CALL ASSIGN(2,NAMNAV,0) C CALL ASSIGN(3,NAMFOT,0) WRITE(5,11555) 11555 FORMAT(' Supply FOOTPRINT type:',/, + ' 3=C_smithed final, 4=non-smithed final,',/, + ' 5=early final, 6=predict') READ(5,8075) Ifot_typ C OPEN(UNIT=4,NAME=NAMOUT,ACCESS='DIRECT',BLOCKSIZE=2600, + ASSOCIATEVARIABLE=NREC,MAXREC=10000,IOSTAT=NERR,RECL=650, + ERR=9000,STATUS='NEW') C 5 FORMAT(' SUPPLY FILE NAMES (ONE PER LINE):DATA,NAV,FOOT,OUTPUT') 15 FORMAT(A25) WRITE(5,25) 25 FORMAT(' SUPPLY SCE START DOY,HR,MIN (3F10.7)') READ(5,35) BDAY,BHR,BMIN 35 FORMAT(3F10.7) WRITE(5,45) 45 FORMAT(' END DOY,HR,MIN (3F10.7)') READ(5,35) EDAY,EHR,EMIN START=BDAY+(BHR/24.)+(BMIN/1440.) ENDTIM=EDAY+(EHR/24.)+(EMIN/1440.) WRITE(7,55) BDAY,BHR,BMIN,EDAY,EHR,EMIN,NAMDAT,NAMNAV,NAMFOT 55 FORMAT(4X,' DATA/GEOMETRY MERGE LOG FOR SATURN DATA',/, + ' TIME OF MERGE (IN SCE) IS:',3F6.1,' TO ',3F6.1,' .', + /,' THE MERGE INCORPORATES THE FOLLOWING FILES:',/,(1X,A25)) CALL DATE(RUNDAY) CALL TIME(RUNTIM) WRITE(7,65) NAMOUT,RUNDAY,RUNTIM 65 FORMAT(' THE OUTPUT FILE IS:',A25,' CREATED:',A9,1X,A8,//) C IREC=1 !INITIALIZE DIRECT ACCESS RECORD COUNTERS NREC=1 C READ THE 1ST DATA RECORD; SKIP ENGINEERING RECORDS FOR NOW C POSITION THE RECORD COUNTER FOR 1ST REC. AFTER START TIME GIVEN 100 CONTINUE FLAST1=FDS1 FLAST2=FDS2 READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IHDR D WRITE(7,105) IHDR(2),IHDR(28),IREC,IHDR(4),IHDR(5),IHDR(6) 105 FORMAT(' MODE,LEN,IREC',3I7,10X,3I5) IF(IHDR(28) .GT. 80) THEN !CHECK IF AN ENG. REC. IQAN=IHDR(28)/256 IF(IQAN*256 .LT. IHDR(28)) IQAN=IQAN+1 Ccc IF(IHDR(28) .EQ. 600) IQAN=10 IF(IHDR(28) .EQ. 600) IQAN=9 DO 120 JJ=1,IQAN READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IENG D WRITE(7,115) IHDR(28),IREC,IQAN 115 FORMAT(' LEN,IREC,IQAN',3I7) 120 CONTINUE GO TO 100 !READ THE NEXT HEADER END IF READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IDAT !READ DATA, CHECK TIME CURRENT=IHDR(4)+(IHDR(5)/24.)+(IHDR(6)/1440.)+(IHDR(7)/86000.) IF(CURRENT .LT. START) GO TO 100 200 CONTINUE !DATA PROPERLY POSITIONED IF(CURRENT .GT. ENDTIM) GO TO 7100 CALL UNPACK(IHDR,IDAT,CURRENT,IFLAG) IF(IFLAG .EQ. 1) GO TO 200 FDS1=ANS(9) FDS2=ANS(10) FDS3=ANS(11) IF(FDS3 .NE. 1.) THEN IF(FDS2 .EQ. 0. .AND. FLAST2 .EQ. 59.) GO TO 220 WRITE(7,205) IREC,NREC,FDS1,FDS2,FDS3 IF(FLAST2 .EQ. FDS2 .AND. FLAST1 .EQ. FDS1) GO TO 500 END IF 220 IF(FDS2 .NE. FLAST2+1.) WRITE(7,215) IREC,NREC,FLAST1,FLAST2, + FDS1,FDS2,FDS3 205 FORMAT(' LATE START (DATA GAP):I/O RECS',2I7, + ' THIS FDS TIME:',F9.1,2F5.1) 215 FORMAT(' GAP OR FDS ROLL OVER(I/0):',2I5, + ' LAST:',F8.1,F5.1,' THIS:',F8.1,2F5.1) D WRITE(7,225) FDS1,FDS2,FDS3 225 FORMAT(4X,' LOOKING FOR',F9.1,2F5.1) GO TO 270 250 READ(UNIT=2, IOSTAT=NAVERR, END=8050, ERR=8040) RNAV,PV INAV=INAV+1 !CHECK NAV POSITION IF(PV(7) .LT. 0.) PV(7)=PV(7)+65536. FDSN1=PV(7) FDSN2=PV(8) D WRITE(7,235) INAV,RNAV(2),RNAV(3),RNAV(4),RNAV(5),RNAV(6), D + PV(2),PV(3),PV(4),PV(5),PV(6),PV(7),PV(8) 235 FORMAT(' NAV:',I5,5F5.1,' PV',5F5.1,F8.1,F5.1) 255 FORMAT(4X,' NAVREC',I4,' NAV FDS:',F9.1,F5.1) 270 IF(FDSN1 .GT. FDS1 ) GO TO 8080 IF(FDSN1 .LT. FDS1) GO TO 250 IF(FDSN2 .LT. FDS2) GO TO 250 C ONE NAV.SEDR COMES WITH EACH EDR (ONE MAJOR FRAME EACH) D WRITE(7,255) INAV,FDSN1,FDSN2 DO 280 II=1,LENNAV ANS(300+II)=RNAV(II) 280 CONTINUE 300 CONTINUE !POSITION FOOT FILE(AT LINE=001) C HAVE TO MAKE AN INITIAL ASSUMPTION THAT THOSE FILES C CONTAINING 12 SECOND FOOTPRINT TIMING ACTUALLY START AT C LINE=001 IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 IF(FDSF2 .EQ. FDS2) GO TO 314 GO TO 8180 310 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT C# CALL FOTFIL(FOOT,140,FNEW) !TO URANUS F/T CALL FOTFIL(FOOT,160,FNEW) !C# TO Neptune F/T IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=65536.+FOOT(7) IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT 325 FORMAT(' FOOTPRINT TIME DROPOUT',3F5.1,F9.1,F5.1,' REC:',I5) FDSF1=FOOT(7) FDSF2=FOOT(8) IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 WRITE(7,315) IFOT,FDSF1,FDSF2 315 FORMAT(4X,'IFOT,FDS',I5,F9.1,F5.1) Cc Add call to new Uranus/Neptune FOOT conversion routine ANS(400)=IFOT_TYP !Code for Footprint source type 314 DO 320 II=1,LENFOT Cc320 ANS(400+II)=FOOT(II) 320 ANS(400+II)=FNEW(II) ANS(381)=FOOT(32) !C# Body center Ra (S/C Centered) ANS(382)=FOOT(33) !C# Body center Dec (S/C Centered) ANS(383)=FOOT(61) !C# Optic Axis Ra (S/C Centered) ANS(384)=FOOT(62) !C# Optic Axis Dec (S/C Centered) F2LAST=FDSF2 F1LAST=FDSF1 JJ=KF jkf=0 !C# Count (Ra/Dec) array offset 350 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT C# CALL FOTFIL(FOOT,140,FNEW) !To Uranus f/t CALL FOTFIL(FOOT,160,FNEW) !C# To Neptune f/t IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=FOOT(7)+65536. IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT FDSF1=FOOT(7) FDSF2=FOOT(8) 355 FORMAT(4X,' INNER FOOT',I5,F9.1,F5.1) IF(FDSF2 .GT. F2LAST) GO TO 500 IF(FDSF2 .EQ. 0. .AND. F2LAST .EQ. 59.) GO TO 500 !DEC 14,81 D WRITE(7,355) IFOT,FDSF1,FDSF2 IF(400+JJ+LENFOT .GT. 650) GO TO 390 DO 380 II=1,LENFOT Cc380 ANS(400+JJ+II)=FOOT(II) 380 ANS(400+JJ+II)=FNEW(II) JJ=JJ+KF jkf=jkf+4 !C# Count offset ANS(381+jkf)=FOOT(32) !C# Body center Ra (S/C Centered) ANS(382+jkf)=FOOT(33) !C# Body center Dec (S/C Centered) ANS(383+jkf)=FOOT(61) !C# Optic Axis Ra (S/C Centered) ANS(384+jkf)=FOOT(62) !C# Optic Axis Dec (S/C Centered) GO TO 350 390 WRITE(5,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 395 FORMAT(' FOOTPRINT OVERFLOWING ANS ARRAY:',F9.1,F5.1, + F9.1,F5.1,' JJ=',I4,I7) WRITE(7,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 500 CONTINUE !WRITE THEN OUTPUT TO DISK IF(NREC .GT. 10000) THEN WRITE(5,515) WRITE(7,515) GO TO 7100 END IF WRITE(4,REC=NREC) ANS L=400+KF WRITE(7,505) NREC-1,ANS(4),ANS(5),ANS(6),ANS(7),ANS(9),ANS(10), + ANS(11), + ANS(302),ANS(303),ANS(304),ANS(305),ANS(352),ANS(353),ANS(354), + ANS(355),ANS(357),ANS(358),ANS(402),ANS(403),ANS(404),ANS(405), + ANS(407),ANS(408),ANS(L+2),ANS(L+3),ANS(L+4),ANS(L+5), + ANS(L+7),ANS(L+8) 505 FORMAT(I5,F5.0,3F3.0,F7.0,F3.0,F4.0,2('+',F5.0,3F3.0),F7.0,F3.0, + 2('+',F5.0,3F3.0,F7.0,F3.0)) 515 FORMAT(' OUTPUT MAXREC LIMIT; CLOSE OUT JOB') GO TO 100 7000 CONTINUE !ERROR ON OPENING DATA FILE WRITE(5,7005) INERR 7005 FORMAT(' ERROR OPENING DATA FILE:',I5) STOP 7000 7100 WRITE(5,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 7105 FORMAT(' END TIME REACHED',/,I10,' INPUT RECORDS READ',/, + I10,' OUTPUT RECORDS WRITTEN',/, + ' THE FINAL EDR TIME IS:',4I5,F9.1,2F5.1) WRITE(7,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 CLOSE(UNIT=4) CLOSE(UNIT=1) CLOSE(UNIT=2) CLOSE(UNIT=3) STOP 7200 CONTINUE WRITE(5,7205) INERR WRITE(7,7205) INERR 7205 FORMAT(' DATA FILE ERROR:',I5,' ASSUME END OF DATA FILE') GO TO 7100 8000 CONTINUE !ERROR ON NAVIGATION FILE WRITE(5,8005) NAVERR,RNAV(2),PV(2) 8005 FORMAT(' ERROR OPENING NAV FILE:',I5,2F10.1) STOP 8000 8040 WRITE(5,8045) NAVERR 8045 FORMAT(' NAV. READ STATUS ERROR:',I5) GO TO 250 8050 WRITE(5,8055) INAV,FDSN1,FDSN2,FDS1,FDS2,NAVERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 250 WRITE(7,8055) INAV,FDSN1,FDSN2,FDS1,FDS2 8055 FORMAT(' NAV FILE EOF AT REC',I5,' FDS=',F9.1,F5.1, + ' WHILE LOOKING FOR ',F9.1,F5.1,' MUST STOP',I5) 8065 FORMAT(' FILE READ ERROR; WANT TO TRY TO CONTINUE?(YES=1)') 8075 FORMAT(I1) CLOSE(UNIT=4) STOP 8055 8080 WRITE(5,8085) FDS1,FDS2,FDS3,FDSN1,FDSN2,IREC,INAV,IFOT C DATA IS GOOD BUT THERE IS A NAV FILE GAP; ZERO NAV FROM C LAST VALUES, GO DOWN TO FOOT AND CHECK VALUES THERE 8085 FORMAT(' NAV IS AHEAD OF DATA; TIMES:',F9.1,2F5.1,F9.1,F5.1, + ',IR,NR,NF=',3I5) DO 8082 II=300,399 8082 ANS(II)=0. GO TO 300 8100 WRITE(5,8105) IFOTERR 8105 FORMAT(' ERROR OPENING FOOT FILE:',I5) STOP 8100 8140 WRITE(5,8145) IFOTERR 8145 FORMAT(' FOOT READ STATUS ERROR:',I5) GO TO 310 8150 WRITE(5,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2,IFOTERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 300 WRITE(7,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2 8155 FORMAT(' FOOT FILE EOF AT REC',I5,' (FDS=',F9.1,F5.1, + ') WHILE LOOKING FOR',F9.1,F5.1,' MUST STOP') CLOSE(UNIT=4) STOP 8150 8180 WRITE(5,8185) FDS1,FDS2,FDS3,FDSF1,FDSF2,IREC,INAV,IFOT 8185 FORMAT(' FOOT IS AHEAD OF DATA; TIMES ', + F9.1,2F5.1,F9.1,F5.1,' IR,NR,NF=',3I5) C FOOTPRINT FILE IS AHEAD SO ZERO OLD FOOT VALUES AND WRITE OUT C WHAT YOU HAVE SO FAR (AT LEAST DATA); CYCLE OTHER AREAS TIL C FIND GOOD FOOTPRINT DO 8182 II=400,650 8182 ANS(II)=0. GO TO 500 9000 WRITE(5,9005) NERR 9005 FORMAT(' ERROR OPENING OUTPUT FILE:',I5) STOP 9000 10000 CONTINUE C ***************************************** C# See the file WRITEUP_N.TXT for a description of record contents END C SUBROUTINE FOTFIL(FOOT,LENFOT,FNEW) !JUL 18,86 C This subroutine to convert Uranus/Nept format Footprint C records into the Saturn parameter format list C Note: Because of the Uranus FOOT IBMTOVAX call, the C params are offset 2 array locs from JPL loc C# Changes for Neptune are shown with "C#" DIMENSION FOOT(LENFOT),FNEW(50) C S.ARRAY POSN = U.ARRAY POSN & ID DO 100 I=1,8 100 FNEW(I)=FOOT(I) !SCE YR,DOY,HR,MIN,SEC,MSEC Cc FNEW(9)=FOOT(2) !PICTURE BODY ID **not avail FNEW(9)=FOOT(12-2) !PICTUNE BODY FLATTENING C# FNEW(10)=FOOT(68-2) !MOTION BIT FNEW(11)=FOOT(43-2) !PIC. BOD SUB-SOLAR PLANETODETIC LAT FNEW(12)=FOOT(44-2) ! & LON FNEW(13)=FOOT(45-2) ! " " " S/C " LAT FNEW(14)=FOOT(46-2) ! & LON FNEW(15)=FOOT(62-2) !CELESTIAL CONE OF PPS OPTIC AXIS FNEW(16)=FOOT(69-2) !INST OPTIC AXIS-S/C-PICT BODY CENTER ANGLE FNEW(17)=FOOT(71-2) !SLANT RANGE FNEW(18)=FOOT(72-2) !PLANETODETIC LAT OF PICT BODY INTERCEPT FNEW(19)=FOOT(73-2) ! " " LON " FNEW(20)=FOOT(74-2) !SOLAR INCIDENCE ANGLE FNEW(21)=FOOT(75-2) !EMISSION ANGLE (BOTH INCL. PLANET OBLATENESS) FNEW(22)=FOOT(77-2) !AZ IN PLANE...P5-P6 TO P5-SUN FNEW(23)=FOOT(78-2) !AZ IN PLANE...P5-P6 TO P5-S/C FNEW(24)=FOOT(83-2) !ALT OF OPTIC AXIS FNEW(25)=FOOT(76-2) !PICT BOD INTERCEPT PHASE ANGLE FNEW(26)=FOOT(82-2) ! " " " LOCAL HOUR ANGLE FNEW(27)=FOOT(40-2) !RANGE S/C TO CENTRAL BOD Cc FNEW(28)=FOOT(14-2) !TIME TO PERIAPSIS Sept 8,88 FNEW(28)=FOOT(36-2) !RANGE S/C TO SUN Sept 8,88 DO 110 I=1,3 110 FNEW(29+I-1)=FOOT(15+I-1-2) !CARTESIAN POSN OF S/C, CENTRAL BODY CENT Cc DO 120 I=1,8 ! error... DO 120 I=1,9 ! corrected Sept 13,88 120 FNEW(32+I-1)=FOOT(49+I-1-2) !TRANSFORMATION MATRIX DO 130 I=1,3 130 FNEW(41+I-1)=FOOT(24+I-1-2) !CART.UNIT VECT OF SUN, S/C CENT DO 140 I=1,3 140 FNEW(44+I-1)=FOOT(27+I-1-2) !CART. UNIT VECT OF EARTH, S/C CENT FNEW(47)=FOOT(36-2) !RANGE CENTRAL BOD TO SUN FNEW(48)=FOOT(85-2) !RANGE, CENT. BOD CENT TO RING PLANE INTERC FNEW(49)=FOOT(86-2) !LON. RING PLANE INTERC PT PROJ. ON CENT.BOD C# FNEW(50)=FOOT(139) !PPS OPTIC AXIS "CHI" FNEW(50)=FOOT(159) !PPS OPTIC AXIS "CHI" RETURN END merge_uran.for_8000066403252300000050000000424151026531542600141740ustar00ksimmons00005460002003C PROGRAM MERGE DEC 14, 81 Cc Updated for Uranus (esp. FOOT=140 array) Jul,86 Cc Updated for Uranus, new param from FOOT Sept 8,88 Cc Correct assignment error in FOTFIL Sept 13,88 C A FORTRAN MERGE ROUTINE FOR VOYAGER SATURN DATA SETS C C MERGES EDR ASSOCIATED FILES WITH SEDR NAV. FILES AND C SEDR FOOTPRINT FILES. C REFORMAT,SEDRJOB, AND FOOT RUNS MUST BE USED TO CREATE C THE DATA SETS BEFORE THE MERGE PROCESS C C OUTPUT IS AN ASSOC. FILE CONTAINING EDR (WITH ENG),NAV, C AND FOOT VALUES IN CONSECUTIVE ASSOC ARRAYS. C COMMON/OUTARR/ANS(650) INTEGER*2 IHDR,IDAT,IENG COMMON IHDR(256),IDAT(256),IENG(256),RNAV(50),PV(30),FOOT(140) dimension fnew(50) CHARACTER*25 NAMDAT,NAMNAV,NAMFOT,NAMOUT CHARACTER RUNDAY*9,RUNTIM*8 DATA LENNAV/80/,LENFOT/50/,FDSF1/0./,FDSF2/0./,KF/50/ DATA FDS1/0./FDS2/0./,INAV/0/,IFOT/0/ C WRITE(5,5) READ(5,15) NAMDAT READ(5,15) NAMNAV READ(5,15) NAMFOT READ(5,15) NAMOUT OPEN(UNIT=1,ACCESS='DIRECT',NAME=NAMDAT, + ASSOCIATEVARIABLE=IREC,IOSTAT=INERR, + ERR=7000,STATUS='OLD',READONLY) C CALL ASSIGN(2,NAMNAV,0) C CALL ASSIGN(3,NAMFOT,0) C OPEN(UNIT=4,NAME=NAMOUT,ACCESS='DIRECT',BLOCKSIZE=2600, + ASSOCIATEVARIABLE=NREC,MAXREC=10000,IOSTAT=NERR,RECL=650, + ERR=9000,STATUS='NEW') C 5 FORMAT(' SUPPLY FILE NAMES (ONE PER LINE):DATA,NAV,FOOT,OUTPUT') 15 FORMAT(A25) WRITE(5,25) 25 FORMAT(' SUPPLY SCE START DOY,HR,MIN (3F10.7)') READ(5,35) BDAY,BHR,BMIN 35 FORMAT(3F10.7) WRITE(5,45) 45 FORMAT(' END DOY,HR,MIN (3F10.7)') READ(5,35) EDAY,EHR,EMIN START=BDAY+(BHR/24.)+(BMIN/1440.) ENDTIM=EDAY+(EHR/24.)+(EMIN/1440.) WRITE(7,55) BDAY,BHR,BMIN,EDAY,EHR,EMIN,NAMDAT,NAMNAV,NAMFOT 55 FORMAT(4X,' DATA/GEOMETRY MERGE LOG FOR SATURN DATA',/, + ' TIME OF MERGE (IN SCE) IS:',3F6.1,' TO ',3F6.1,' .', + /,' THE MERGE INCORPORATES THE FOLLOWING FILES:',/,(1X,A25)) CALL DATE(RUNDAY) CALL TIME(RUNTIM) WRITE(7,65) NAMOUT,RUNDAY,RUNTIM 65 FORMAT(' THE OUTPUT FILE IS:',A25,' CREATED:',A9,1X,A8,//) C IREC=1 !INITIALIZE DIRECT ACCESS RECORD COUNTERS NREC=1 C READ THE 1ST DATA RECORD; SKIP ENGINEERING RECORDS FOR NOW C POSITION THE RECORD COUNTER FOR 1ST REC. AFTER START TIME GIVEN 100 CONTINUE FLAST1=FDS1 FLAST2=FDS2 READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IHDR D WRITE(7,105) IHDR(2),IHDR(28),IREC,IHDR(4),IHDR(5),IHDR(6) 105 FORMAT(' MODE,LEN,IREC',3I7,10X,3I5) IF(IHDR(28) .GT. 80) THEN !CHECK IF AN ENG. REC. IQAN=IHDR(28)/256 IF(IQAN*256 .LT. IHDR(28)) IQAN=IQAN+1 Ccc IF(IHDR(28) .EQ. 600) IQAN=10 IF(IHDR(28) .EQ. 600) IQAN=9 DO 120 JJ=1,IQAN READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IENG D WRITE(7,115) IHDR(28),IREC,IQAN 115 FORMAT(' LEN,IREC,IQAN',3I7) 120 CONTINUE GO TO 100 !READ THE NEXT HEADER END IF READ(1,REC=IREC,IOSTAT=INERR,ERR=7200) IDAT !READ DATA, CHECK TIME CURRENT=IHDR(4)+(IHDR(5)/24.)+(IHDR(6)/1440.)+(IHDR(7)/86000.) IF(CURRENT .LT. START) GO TO 100 200 CONTINUE !DATA PROPERLY POSITIONED IF(CURRENT .GT. ENDTIM) GO TO 7100 CALL UNPACK(IHDR,IDAT,CURRENT,IFLAG) IF(IFLAG .EQ. 1) GO TO 200 FDS1=ANS(9) FDS2=ANS(10) FDS3=ANS(11) IF(FDS3 .NE. 1.) THEN IF(FDS2 .EQ. 0. .AND. FLAST2 .EQ. 59.) GO TO 220 WRITE(7,205) IREC,NREC,FDS1,FDS2,FDS3 IF(FLAST2 .EQ. FDS2 .AND. FLAST1 .EQ. FDS1) GO TO 500 END IF 220 IF(FDS2 .NE. FLAST2+1.) WRITE(7,215) IREC,NREC,FLAST1,FLAST2, + FDS1,FDS2,FDS3 205 FORMAT(' LATE START (DATA GAP):I/O RECS',2I7, + ' THIS FDS TIME:',F9.1,2F5.1) 215 FORMAT(' GAP OR FDS ROLL OVER(I/0):',2I5, + ' LAST:',F8.1,F5.1,' THIS:',F8.1,2F5.1) D WRITE(7,225) FDS1,FDS2,FDS3 225 FORMAT(4X,' LOOKING FOR',F9.1,2F5.1) GO TO 270 250 READ(UNIT=2, IOSTAT=NAVERR, END=8050, ERR=8040) RNAV,PV INAV=INAV+1 !CHECK NAV POSITION IF(PV(7) .LT. 0.) PV(7)=PV(7)+65536. FDSN1=PV(7) FDSN2=PV(8) D WRITE(7,235) INAV,RNAV(2),RNAV(3),RNAV(4),RNAV(5),RNAV(6), D + PV(2),PV(3),PV(4),PV(5),PV(6),PV(7),PV(8) 235 FORMAT(' NAV:',I5,5F5.1,' PV',5F5.1,F8.1,F5.1) 255 FORMAT(4X,' NAVREC',I4,' NAV FDS:',F9.1,F5.1) 270 IF(FDSN1 .GT. FDS1 ) GO TO 8080 IF(FDSN1 .LT. FDS1) GO TO 250 IF(FDSN2 .LT. FDS2) GO TO 250 C ONE NAV.SEDR COMES WITH EACH EDR (ONE MAJOR FRAME EACH) D WRITE(7,255) INAV,FDSN1,FDSN2 DO 280 II=1,LENNAV ANS(300+II)=RNAV(II) 280 CONTINUE 300 CONTINUE !POSITION FOOT FILE(AT LINE=001) C HAVE TO MAKE AN INITIAL ASSUMPTION THAT THOSE FILES C CONTAINING 12 SECOND FOOTPRINT TIMING ACTUALLY START AT C LINE=001 IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 IF(FDSF2 .EQ. FDS2) GO TO 314 GO TO 8180 310 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT CALL FOTFIL(FOOT,140,FNEW) !TO URANUS F/T IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=65536.+FOOT(7) IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT 325 FORMAT(' FOOTPRINT TIME DROPOUT',3F5.1,F9.1,F5.1,' REC:',I5) FDSF1=FOOT(7) FDSF2=FOOT(8) IF(FDSF1 .LT. FDS1) GO TO 310 IF(FDSF1 .GT. FDS1 ) GO TO 8180 IF(FDSF2 .LT. FDS2) GO TO 310 WRITE(7,315) IFOT,FDSF1,FDSF2 315 FORMAT(4X,'IFOT,FDS',I5,F9.1,F5.1) Cc Add call to new Uranus foot conversion routine 314 DO 320 II=1,LENFOT Cc320 ANS(400+II)=FOOT(II) 320 ANS(400+II)=FNEW(II) F2LAST=FDSF2 F1LAST=FDSF1 JJ=KF 350 READ(UNIT=3,IOSTAT=IFOTERR,END=8150,ERR=8140) FOOT CALL FOTFIL(FOOT,140,FNEW) !To Uranus f/t IFOT=IFOT+1 IF(FOOT(7) .LT. 0.) FOOT(7)=FOOT(7)+65536. IF(FOOT(7) .EQ. 0.) WRITE(7,325) FOOT(2),FOOT(3),FOOT(4), + FOOT(7),FOOT(8),IFOT FDSF1=FOOT(7) FDSF2=FOOT(8) 355 FORMAT(4X,' INNER FOOT',I5,F9.1,F5.1) IF(FDSF2 .GT. F2LAST) GO TO 500 IF(FDSF2 .EQ. 0. .AND. F2LAST .EQ. 59.) GO TO 500 !DEC 14,81 D WRITE(7,355) IFOT,FDSF1,FDSF2 IF(400+JJ+LENFOT .GT. 650) GO TO 390 DO 380 II=1,LENFOT Cc380 ANS(400+JJ+II)=FOOT(II) 380 ANS(400+JJ+II)=FNEW(II) JJ=JJ+KF GO TO 350 390 WRITE(5,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 395 FORMAT(' FOOTPRINT OVERFLOWING ANS ARRAY:',F9.1,F5.1, + F9.1,F5.1,' JJ=',I4,I7) WRITE(7,395) F1LAST,F2LAST,FDS1,FDS2,JJ,IFOT 500 CONTINUE !WRITE THEN OUTPUT TO DISK IF(NREC .GT. 10000) THEN WRITE(5,515) WRITE(7,515) GO TO 7100 END IF WRITE(4,REC=NREC) ANS L=400+KF WRITE(7,505) NREC-1,ANS(4),ANS(5),ANS(6),ANS(7),ANS(9),ANS(10), + ANS(11), + ANS(302),ANS(303),ANS(304),ANS(305),ANS(352),ANS(353),ANS(354), + ANS(355),ANS(357),ANS(358),ANS(402),ANS(403),ANS(404),ANS(405), + ANS(407),ANS(408),ANS(L+2),ANS(L+3),ANS(L+4),ANS(L+5), + ANS(L+7),ANS(L+8) 505 FORMAT(I5,F5.0,3F3.0,F7.0,F3.0,F4.0,2('+',F5.0,3F3.0),F7.0,F3.0, + 2('+',F5.0,3F3.0,F7.0,F3.0)) 515 FORMAT(' OUTPUT MAXREC LIMIT; CLOSE OUT JOB') GO TO 100 7000 CONTINUE !ERROR ON OPENING DATA FILE WRITE(5,7005) INERR 7005 FORMAT(' ERROR OPENING DATA FILE:',I5) STOP 7000 7100 WRITE(5,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 7105 FORMAT(' END TIME REACHED',/,I10,' INPUT RECORDS READ',/, + I10,' OUTPUT RECORDS WRITTEN',/, + ' THE FINAL EDR TIME IS:',4I5,F9.1,2F5.1) WRITE(7,7105) IREC-1,NREC-1,IHDR(4),IHDR(5),IHDR(5), + IHDR(6),FDS1,FDS2,FDS3 CLOSE(UNIT=4) CLOSE(UNIT=1) CLOSE(UNIT=2) CLOSE(UNIT=3) STOP 7200 CONTINUE WRITE(5,7205) INERR WRITE(7,7205) INERR 7205 FORMAT(' DATA FILE ERROR:',I5,' ASSUME END OF DATA FILE') GO TO 7100 8000 CONTINUE !ERROR ON NAVIGATION FILE WRITE(5,8005) NAVERR,RNAV(2),PV(2) 8005 FORMAT(' ERROR OPENING NAV FILE:',I5,2F10.1) STOP 8000 8040 WRITE(5,8045) NAVERR 8045 FORMAT(' NAV. READ STATUS ERROR:',I5) GO TO 250 8050 WRITE(5,8055) INAV,FDSN1,FDSN2,FDS1,FDS2,NAVERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 250 WRITE(7,8055) INAV,FDSN1,FDSN2,FDS1,FDS2 8055 FORMAT(' NAV FILE EOF AT REC',I5,' FDS=',F9.1,F5.1, + ' WHILE LOOKING FOR ',F9.1,F5.1,' MUST STOP',I5) 8065 FORMAT(' FILE READ ERROR; WANT TO TRY TO CONTINUE?(YES=1)') 8075 FORMAT(I1) CLOSE(UNIT=4) STOP 8055 8080 WRITE(5,8085) FDS1,FDS2,FDS3,FDSN1,FDSN2,IREC,INAV,IFOT C DATA IS GOOD BUT THERE IS A NAV FILE GAP; ZERO NAV FROM C LAST VALUES, GO DOWN TO FOOT AND CHECK VALUES THERE 8085 FORMAT(' NAV IS AHEAD OF DATA; TIMES:',F9.1,2F5.1,F9.1,F5.1, + ',IR,NR,NF=',3I5) DO 8082 II=300,399 8082 ANS(II)=0. GO TO 300 8100 WRITE(5,8105) IFOTERR 8105 FORMAT(' ERROR OPENING FOOT FILE:',I5) STOP 8100 8140 WRITE(5,8145) IFOTERR 8145 FORMAT(' FOOT READ STATUS ERROR:',I5) GO TO 310 8150 WRITE(5,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2,IFOTERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 300 WRITE(7,8155) IFOT,FDSF1,FDSF2,FDS1,FDS2 8155 FORMAT(' FOOT FILE EOF AT REC',I5,' (FDS=',F9.1,F5.1, + ') WHILE LOOKING FOR',F9.1,F5.1,' MUST STOP') CLOSE(UNIT=4) STOP 8150 8180 WRITE(5,8185) FDS1,FDS2,FDS3,FDSF1,FDSF2,IREC,INAV,IFOT 8185 FORMAT(' FOOT IS AHEAD OF DATA; TIMES ', + F9.1,2F5.1,F9.1,F5.1,' IR,NR,NF=',3I5) C FOOTPRINT FILE IS AHEAD SO ZERO OLD FOOT VALUES AND WRITE OUT C WHAT YOU HAVE SO FAR (AT LEAST DATA); CYCLE OTHER AREAS TIL C FIND GOOD FOOTPRINT DO 8182 II=400,650 8182 ANS(II)=0. GO TO 500 9000 WRITE(5,9005) NERR 9005 FORMAT(' ERROR OPENING OUTPUT FILE:',I5) STOP 9000 10000 CONTINUE C ***************************************** C THE CONTENTS OF THE ANS ARRAY ARE AS FOLLOWS C ANS(1-80) HEADER DATA VALUES C ANS(81-160) DATA STATUS WORDS C 161-240 80 F.P. DATA VALUES C 301-350 50 F.P. NAV VALUES C 351-380 30 F.P. PV VALUES C 401-450 50 F.P. FOOT VALUES FROM FIRST FOOT REC/MJF C 451-500 50 F.P. FOOT VALUES FROM SECOND FOOT REC/MJF C 500-550 50 " " " " THIRD " " C 551-600 50 " " " " FOUTH " " C ****************************************** C THE HEADER WORD LOCATIONS CONTAIN C IHDR(1)=NREC C IHDR(2)=MODE C SPACECRAFT EVENT TIMES IN GMT C IHDR(3)=IYR C IHDR(4)=IDAY C IHDR(5)=IHR C IHDR(6)=IMIN C IHDR(7)=ISEC C IHDR(8)=MSEC C IHDR(9)=MOD16 C IHDR(10)=MOD60 C IHDR(11)=LINESC C SPACE CRAFT IDENTIFICATION C IHDR(12)=IDSC C EARTH RECEIPT TIMES IN GMT C S APENDAGE FOR START OF FIRST MINOR FRAME C E APENDAGE FOR START OF LAST MINOR FRAME C IHDR(13)=IDAYS C IHDR(14)=IHRS C IHDR(15)=IMINS C IHDR(16)=ISECS C IHDR(17)=MSECS C IHDR(18)=IDAYE C IHDR(19)=IHRE C IHDR(20)=IMINE C IHDR(21)=ISECE C IHDR(22)=MSECE C IHDR(23)=MFSEG C IDS=SCE TIME FLAG, IGOLAY=GOLAY CORR. FLAG, NGOLAY=CORR.COUNT C IRAT=DOWNLINK TM RATE, ITEMP=FDSC TIME CORR. FLAG C CMD'S ARE SUB-HEADER PPS COMMAND WORDS C IHDR(24)=IDS C IHDR(25)=IGOLAY C IHDR(26)=NGOLAY C IHDR(27)=IRAT C IHDR(28)=NO. OF POINTS C IHDR(29)=NO. OF ENG. VALUES C IHDR(30)=NO. OF ENG. WORDS RETURNED C IHDR(31)=SOURCE TAPE NO. C IHDR(32)=ITEMP C IHDR(33)=ICMD1 C IHDR(34)=ICMD2 C IHDR(35)=ICMD3 C IHDR(36)=ICMD4 C IHDR(37)=ICMD5 C COUNT # DQSW ERROR FRAMES C IHDR(38)=IDQ C NOW STORE BYTES CONTAINING NON-REFORMATTED INFO C DO 1020 INA=1,101****NOTE, 81-101 ARE OVERWRITTEN IN MERGE C NA=NARR(K+16+INA) C IHDR(49+INA)=NA C1020 CONTINUE C HAVE NOW USED 151 LOCATIONS WITH #39-49 AVAILABLE AS SPARES C C THE DATA LOCATIONS CONTAIN 80 F.P. VALUES FROM THE 80 C MINOR FRAMES IN THE GS-3 RECORD (THERE ARE NO OFFSETS, C CALIBS, OR ETC) C C ANS(297)=TIME OF DAY IN DECIMAL DAYS C ANS(298)=DATA MODE TIMING (=DELTA TIME FOR EACH PPS DATA VALUE) C GIVEN IN SECONDS C THE POINTING VECTOR ARRAY (PV(30)) CONTAINS: C 1-SCE GMT YEAR R,YEARS AD C 2-SCE GMT DAY R,DAY OF YEAR C 3-SCE GMT HOUR R,HOUR OF DAY C 4-SCE GMT MINUTE R,MIN OF HOUR C 5-SCE GMT SECONDS R,SEC OF MIN C 6-SCE GMT MILLISECS R,MSEC OF SEC C 7-FDSC MOD16 COUNT R,BINARY COUNTS C 8-FCSC MOD60 COUNT R,BINARY COUNTS C PLCY 9-PITCH LIMIT CYCLE R,DEGS C YLCY 10-YAW LIMIT CYCLE R,DEGS C RLCY 11-ROLL LIMIT CYCLE R,DEGS C 12-14:CARTESIAN UNIT VECTOR OF S/C X-AXIS,S/C-CENTERED C EARTH MEAN ECLIPTIC 3R,DIM C 15-17:SAME Y-AXIS 3R, DIMENTIONLESS C 18-20:SAME Z-AXIS 3R, " C 21-CELESTIAL CLOCK OF HIGH GAIN R,DEG C 22-CONE OF HIGH GAIN R,DEG C CLOCK 23-CLOCK OF PPS OPTIC AXIS, R C CONE 24-CONE OF PPS OPTIC AXIS, R C 25-27:CARTESTIAN UNIT VECTOR OF PPS OPTIC AXIS, S/C C CENTERED 3R, DIM C AZPP 28-AZIMUTH OF NOMINAL PLATFORM R,DEGS C ELPP 29-ELEVATION R,DEGS C TWPP 30-TWIST R,DEGS C C THE CONTENTS OF THE NAVIGATION VECTOR (NAV(50)): C 1-6:SAME TIMES AS ABOVE C 7-12:CARTESIAN STATE OF S/C, SUN CENTERED,EARTH C MEAN EC. 6R, KM AND KM/SEC C 13-18:SAME FOR EARTH 6R, " " C IF CRUISE FORMAT THEN GET: C 19-24:SAME FOR JUPITER 3R, " " C 25-30:SAME FOR SATURN C 31: ANGLE SUN-S/C-EARTH C 32: CELESTIAL CLOCK OF EARTH C IF JUPITER FORMAT THEN GET: C 25-30:CART. STATE OF S/C, EARTH CENTERED, (EMEC50) C 31-36:CARTESIAN STATE OF S/C, CENTRAL BODY CENTERED, EMEC C 37:RANGE,CENTRAL BODY TO S/C 1R, KM C 38-40:CARTESIAN STATE OF S/C,IO CENTERED, EMEC C 41-43: " " " , EUROPA CENTERED, EMEC C 44-46: " " " , GANYMEDE CENTERED, EMEC C 47-49: " " " , CALLISTO CENTERED, EMEC C IF SATURN FORMAT THEN GET: C 19-24:CART. STATE OF SATURN, SUN CENT.,EMEC50 C 25-30:CART. STATE OF S/C, EARTH CENTERED C 31-36: " " " ,SATURN CENTERED, EMEC50 C 37: RANGE, SATURN TO S/C C 38-43:CARTESIAN STATE OF S/C,TITAN CENTERED,EMEC50 C 44:TITAN TO S/C RANGE, KM C 45: TITAN SCATTERING PLANE ANGLE FROM "M" VECTOR C 46: CWH CHECK (SHOULD BE 0.) C 47: SATURN SCATERING PLANE ANGLE C 48: #47 CHECK VALUE C 49: SATURN PHASE ANGLE C 50: TITAN PHASE ANGLE C C GENERAL FOTPRINT NOTES: C THE HEADER RECORD SUPPLIES ELEVATION,CROSS-ELEV AND ROTATION C OF THE PPS OPTIC AXIS FROM ISSNA OPTIC AXIS C ALL INTERCEPT POINTS ARE CALCULATED ON AN ELLIPTICAL PLANET C THE FOOTPRINT DATA CONTAINS THE FOLLOWING PARAMS PER RECORD C C THE OUTPUT SCAN PLATFORM FOOTPRINT DATA ARRAY CONTAINS C 1-6:(3-8)SCE GMT TIME 6I,YR,D,H,M,S,MSEC C 7-8:(9-10)FDSC MOD16 AND MOD60 2I,CNTS C 9:(2)PICTURE BODY ID I C 3=EARTH, 5=JUPITER, 6=SATURN C 13=MOON, 15=IO, 25=EUR, 35=GANY, 45=CAL, 55=ALM C 16=JANUS, 26=MIMAS, 36=ENCEL, 46=TETHY, 56=DIONE C 10:(68)MOTION BIT (1=IN MOTION) C 11-12:(43-4)PICT. BODY SUB-SOLAR PLANETODETIC LAT&LON 2R,DEG C 13-14:(45-6)" " " " " -S/C " " " " "" " C 15:(62)CELESTIAL CONE ANGLE OF PPS AXIS (PHASE=180.-CONE) R,DEG C 16:(69)INST OPTIC AXIS-S/C-PICT BODY CENTER ANGLE R,DEG C 17:(71)SLANT RANGE (S/C-PICT BODY INTERCEPT/TANG PT) R,KM C 18-19:(72-3)SYSTEM I PLANETODETIC LAT&LON 2R,DEG C 20:(74) SOLAR INCIDENCE ANGLE R,DEG C 21:(75) EMISSION ANGLE R,DEG C ABOVE TWO INCLUDE PLANET OBLATENESS C 22:(77)AZ IN PLANE TANG. TO SURFACE AT SLANT RANGE C FROM P5-P6 VECT. TO P5-SUN (CLOCKWISE) R,DEG C 23:(78)AZ IN PLANE ...FROM P5-P6 TO P5-S/C R,DEG C 24:(83)POINT OF CLOSEST APPR. ALT OF OPTIC AXIS C (+ FOR TANGENCY, - FOR INTERCEPT) R,KM C.JUP...25:(107)ANGLE JUP SYSII PRIME MERID MINUS SYSI R,DEG C.JUP...26:(108)ANGLE JUP SYSIII PRIME MERID-SYSI PRIME R,DEG C.SAT...25:(76)PICTURE BODY INTERCEPT PHASE ANGLE R,DEG C.SAT...26:(82)PICTURE BODY INTERCEPT LOCAR HOUR ANGLE R,DEG C 27:(40) RANGE S/C TO CENTRAL BODY R,KM C 28:(14) TIME TO(-)/FROM(+) CENTRAL BODY PERIAPSIS R,SEC C.URN 28:(36) Range: S/C to Sun R,KM C 29-31:(15-17) CARTESIAN POSN AND VEL OF S/C,CENTRAL C BODY CENTERED,EMEQ50 R,KM,KM/S C 32-40:(49-57) TRANSFORMATION MATRIX-INST TO EARTH(EMEQ) R,DIM C 41-43:(24-6) CART.UNIT VECT OF SUN DIRECTION, S/C CENTERED, C EMEQ50 R,DIM C 44-46:(27-9) CART. " " OF EARTH, S/C CENTERED, EMEQ50 " C 47:(36) RANGE OF CENTRAL BODY TO SUN R,KM C 48:(85) RANGE SAT.CENTER TO SAT.RINGS INTERCEPT POINT KM C 49:(88) SAT.RINGS INTERCEPT PT. S/C EMISSION ANGLE C 50:(95) SAT.RINGS INTERCEPT PT. LOCAL HR ANGLE END C SUBROUTINE FOTFIL(FOOT,LENFOT,FNEW) !JUL 18,86 C This subroutine to convert Uranus format Footprint C records into the Saturn parameter format list C Note: Because of the Uranus FOOT IBMTOVAX call, the C params are offset 2 array locs from JPL loc DIMENSION FOOT(LENFOT),FNEW(50) C S.ARRAY POSN = U.ARRAY POSN & ID DO 100 I=1,8 100 FNEW(I)=FOOT(I) !SCE YR,DOY,HR,MIN,SEC,MSEC Cc FNEW(9)=FOOT(2) !PICTURE BODY ID **not avail FNEW(10)=FOOT(68-2) !MOTION BIT FNEW(11)=FOOT(43-2) !PIC. BOD SUB-SOLAR PLANETODETIC LAT FNEW(12)=FOOT(44-2) ! & LON FNEW(13)=FOOT(45-2) ! " " " S/C " LAT FNEW(14)=FOOT(46-2) ! & LON FNEW(15)=FOOT(62-2) !CELESTIAL CONE OF PPS OPTIC AXIS FNEW(16)=FOOT(69-2) !INST OPTIC AXIS-S/C-PICT BODY CENTER ANGLE FNEW(17)=FOOT(71-2) !SLANT RANGE FNEW(18)=FOOT(72-2) !PLANETODETIC LAT OF PICT BODY INTERCEPT FNEW(19)=FOOT(73-2) ! " " LON " FNEW(20)=FOOT(74-2) !SOLAR INCIDENCE ANGLE FNEW(21)=FOOT(75-2) !EMISSION ANGLE (BOTH INCL. PLANET OBLATENESS) FNEW(22)=FOOT(77-2) !AZ IN PLANE...P5-P6 TO P5-SUN FNEW(23)=FOOT(78-2) !AZ IN PLANE...P5-P6 TO P5-S/C FNEW(24)=FOOT(83-2) !ALT OF OPTIC AXIS FNEW(25)=FOOT(76-2) !PICT BOD INTERCEPT PHASE ANGLE FNEW(26)=FOOT(82-2) ! " " " LOCAL HOUR ANGLE FNEW(27)=FOOT(40-2) !RANGE S/C TO CENTRAL BOD Cc FNEW(28)=FOOT(14-2) !TIME TO PERIAPSIS Sept 8,88 FNEW(28)=FOOT(36-2) !RANGE S/C TO SUN Sept 8,88 DO 110 I=1,3 110 FNEW(29+I-1)=FOOT(15+I-1-2) !CARTESIAN POSN OF S/C, CENTRAL BODY CENT Cc DO 120 I=1,8 ! error... DO 120 I=1,9 ! corrected Sept 13,88 120 FNEW(32+I-1)=FOOT(49+I-1-2) !TRANSFORMATION MATRIX DO 130 I=1,3 130 FNEW(41+I-1)=FOOT(24+I-1-2) !CART.UNIT VECT OF SUN, S/C CENT DO 140 I=1,3 140 FNEW(44+I-1)=FOOT(27+I-1-2) !CART. UNIT VECT OF EARTH, S/C CENT FNEW(47)=FOOT(36-2) !RANGE CENTRAL BOD TO SUN FNEW(48)=FOOT(85-2) !RANGE, CENT. BOD CENT TO RING PLANE INTERC FNEW(49)=FOOT(86-2) !LON. RING PLANE INTERC PT PROJ. ON CENT.BOD FNEW(50)=FOOT(139) !PPS OPTIC AXIS "CHI" RETURN END ORMAT(' NAV. READ STATUS ERROR:',I5) GO TO 250 8050 WRITE(5,8055) INAV,FDSN1,FDSN2,FDS1,FDS2,NAVERR WRITE(5,8065) READ(5,8075) ICF IF(ICF .EQ. 1) GO TO 250 WRITE(7,8055) INAV,FDSN1,FDSN2,FDS1,FDS2 8055 FORMAT(' NAV FILE EOF AT REC',I5,' Fmessage.txt_4000066403252300000050000000000001032256164300134770ustar00ksimmons00005460002003multieslv.com_12000066403252300000050000000000671032256174200141320ustar00ksimmons00005460002003MULTIE P21206.V2;1 1 0 297016050 298000030 04 10 0 5 3 nav.exe_32000066403252300000050000000320321026531562500126770ustar00ksimmons000054600020030DX0205(Jh2NAV01@l05-02   $%  ?B!d FORRTL_001! LIBRTL_001! MTHRTL_001 ERR100NAV BADDISK WRITE ERROREND OF JOB)" OUTPUT UNIT (I2):5=TI,6=LP,7=NONE" WANT TO SKIP ANY RECORDS? (YES=1) ( DATA SUPPLIED AFTER SKIP TO DOY,HR,MIN: ) SUPPLY START DAY OF YEAR,HR,MIN (3F10.7) SUPPLY END DAY,HR,MIN NAV CODE: IS THIS A PREDICT TAPE? (Y=1)( WANT OBJECT BODY PHASE ANGLE CALC (Y=1) QIO ERROR AT 300; IOSB= SEDR NAVIGATION DATA: SEDR POINTING VECTOR DATA: NAV VALUE BAD ENTER TAPE UNIT "MT4:"  END OF INP UT TAPE,   RECORDS WRITTEN SUPPLY OUTPUT FILE NAME  DISK WRITE ERROR # 2 SUPPLY LOCK STAR:1=CANOP,2=VEGA,3=MIAP,4=PROCYON, 5=REGULUS,6=DENEBOLA,7=ALIOTH,8=ALKAID, 9=ACKANER,10=FOMALHAUT11=SPICA,12=ROLL+110 5 PROJECT  FILE TYPE: S/C IS VOYAGER 2 S/C IS VOYAGER 1 S/C IS SIMULATION UNIT: SEDR TAPE ID:  NAVIGATION F/T IS: NAV. F/T CODE= &. ONAV ARRAY INDEX HAS EXCEEDED SIZE=50, VALUE=   PV CONTINUE FLAG ERROR, VALUE= 3 PV ARRAY INDEX ABOUT TO EXCEED SIZE OF 30,RETURNED LOCK STAR ERROR ON VALUE=  p1 x 0 d'  v'l'''z'''' !d'@'''''~''|''''@'L'X''' %LCJSXUN(((00x0 1 $1H 101 81`<1xH1T1 `1x01H 81`<1L T1()4)@)L)P)()4)@)L)P)81P1 T1X1 \1`1d101` 81()4)@)L)P)  ABCDEFGHI?.<(+ &JKLMNOP R!$*); -/STUVWXYZ ,%_>?0123456789:#@'=" X,d,4,L,d,L,         ,,   --                                       IA            4/(/../4///@/@/L// //@///`//X////\////..\/../ I[Ы\RSfSLd230?T2TP@=Tlt?Q`?_l@i2~:K|PTPːCUS2T˸˰P# ?T1S1?1 {k^߫T߫JOL982߫ ߫ ߫ kݫݫݫ ݫݫG,P@kPGEQAQPG,P@ PGEQAQP\ ˘Q ˤBg2~8IF3/,?1?17#2~2~1P2PQ A=2PP2PQAeVAAe3VA=PQ ?9.2~5V2VP@>=VVVVVV1PVQQPQW2WWGeXGGe3XG= PVkVQ$?92~W2WP@RO=WMQ 1Q \1QKP2PWGGGPGRGVG=P $V Ы(Ы0&߫D߫45#m2~2~{R 1R~V V1V131Q2R~#4@= H[k,2RRS2SP@=SlPPSS &kİЫĴФxФ|Ā> 84kĸЫļPpPR\dRPS2W N E ,PP2PSC\CCCCtC=P> okĸЫ ļ2h x ˈ ˘ ˨ ˸  2|H$[PR 1 QSPTQTU2UU2RVMEmFR=QG,Q@QGE VAVQQ2TTDTT2PVFG2RP@k RF72RP@ RF.$2RP@( RFe42RVF80 RT 3 2T~  RT  @<%޼P޼ T޼X޼\޼`H$H[ЬP?URANUSYLOCKSTAR>LOCKSTAR6Y SC @SC m CROSS @CROSS j DOT @DOTC VNORM @AVNORM` CS ACS  ROTX \BROTXC ROTZ BROTZC SCAT BSCAT<3IBMTOVAXH . BLANK . x01H 81`<1L T1()4)@)L)P)()4)@)L)P)81P1 T1X1 \1`1d101` 81()4)@)L)P)  ABCDEFGHI?.<(+ &JKLMNOP R!$*); -/STUVWXYZ ,%_>?0123456789:#@'nelson_long.pro_7000066403252300000050000000022131026755541300143720ustar00ksimmons00005460002003; Nelson sub-s/c Lat & Long values read from Footprint for ; a specified FDS time filnam=' ' read,'supply desired footprint file name',filnam close,1 openr,1,filnam openw,3,'Bob_geom.dat' printf,3,' ' printf,3,' ' printf,3,' Data from the Footprint file ',filnam link=' ' a=assoc(1,fltarr(160)) t=a(0) & i=0 Beg: read,' Supply a Link ID',link printf,3,' ' printf,3,' for ',link read,'supply FDS time in Mod2^16 and Mod60 (as 11060 59)',fds1,fds2 loop: if (t(6) eq fds1) and (t(7) eq fds2) then begin print,'at fds= ',t(6),t(7) printf,3,'at fds= ',t(6),t(7) print,' sub-s/c planetodetic lat and long=',t(42),t(43) printf,3,' sub-s/c planetodetic lat and long=',t(42),t(43) print,' Range (body), phase, and PPS scat angle=', t(38),t(73),t(159) printf,3,' Range (body), phase, and PPS scat angle=', t(38),t(73),t(159) print,' Range (Nept), Ra, Dec (Optic Axis)', t(37), t(60),t(61) printf,3,' Range (Nept), Ra, Dec (Optic Axis)', t(37), t(60),t(61) read,'Want another in this file (y=1)',iw if iw eq 1 then goto,beg else goto,finis endif i=i+1 & t=a(i) & goto,loop finis: close,3 stop end new_ring_comp.pro_4000066403252300000050000000027111032256262600146770ustar00ksimmons00005460002003 pro rc,bright ;Uranus ring composite picture temp=intarr(510) iry=0 close,1,2,3,4,5,6 openr,1,'eps_in_sag.img;1' eps=assoc(1,intarr(510)) openr,2,'delt_in_sag.img;1' delts=assoc(2,intarr(510)) openr,6,'Ndelt_in_per.img;1 deltp=assoc(6,intarr(510)) openr,3,'Nbeta_in_per.img;1' bet=assoc(3,intarr(510)) openr,4,'Ngam_in_per.img;1' gam=assoc(4,intarr(510)) openr,5,'Nalpha_in_per.img;1' alp=assoc(5,intarr(510)) ; tvinit for i=10,150 do begin temp=intarr(510) e=eps(i) & e(0)=0 & e(509)=0 & insert,temp,e,0 if i lt 60 then begin d=delts(I) & d(0)=0 & e(509)=0 dd=extract(d,200,150) insert,temp,dd,350 & end if i gt 80 then d=deltp(i) else goto,space delta: d(0)=0 & e(509)=0 & dd=extract(d,230,150) insert,temp,dd,350 space: dum=0 tvimag,temp,0,i+300 t2=intarr(510) g=gam(i) & g(0)=0 & g(509)=0 & gg=extract(g,200,100) insert,t2,gg,0 b=bet(i) & b(0)=0 & b(509)=0 & bb=extract(b,200,100) insert,t2,bb,150 a=alp(i) & a(0)=0 & a(509)=0 & aa=extract(a,200,150) insert,t2,aa,300 tvimag,t2,0,i+50 end !color=bright pps=' VOYAGER 2 PPS RING IMAGES' tvout,50,475,pps,1 lab1='EPSILON DELTA' tvout,50,275,lab1,1 lab2='GAMMA BETA ALPHA' tvout,25,25,lab2,1 print,'eps = epsilon' print,'delts (top)=delta Sgr' print,'deltp (bot)=delta Per' print,'gam = gamma' print,'bet = beta' print,'alp = alpha' ; read,'finished? (y=1)',iry if iry eq 0 then stop close,1,2,3,4,5,6 return & end nortkey.com_1000066403252300000050000000020071032256174200135130ustar00ksimmons00005460002003$ VERIFY_SAVE='F$VERIFY("NO") $! Ali Bahrami October 28, 1985 $! MODIFIED NOV 5,85 BY K.SIMMONS $! Laboratory for Atmospheric and Space Physics $! University of Colorado, Boulder $ $! NORTKEY programs the Tektronix 4025 F9 - F keys to $! send all the REMOTE commands needed to start a REMOTE session. $! Hitting the keys in order then starts up REMOTE for the $! VOYAGER Uranus encounter dataline transmission. $! P1 contains the name of the file to be recieved. If P1 is $! empty, NORTKEY prompts the user for the name of the file to be $! recieved. $! $! We have to use more than one key because there is a limit on the number $! of characters a key can remember. $ $ if "''P1'" .eqs. "" then Inquire P1 "Name of recieve file" $ write sys$output "|LEA S9 /MC REMOTE/13/SET NOTRANSLATION/13" $ write sys$output "|LEA S10 /SET RECORDSIZE/47/PRINT_TRANSPARENT=400/13" $ write sys$output "|LEA S11 /SET END_OF_FILE=EOT/13" $ write sys$output "|LEA S12 /SET ON/13/SEND ID/13/REC ''P1'/47/DEF/13" $ IF VERIFY_SAVE THEN SET VERIFY phase.for_6000066403252300000050000000011171026755543100131440ustar00ksimmons00005460002003 FUNCTION PHASE(IBODY,ISUNSC) C USE FLAG FOR TITAN CASE(DUE TO DIF.VECTORS AVAIL.) AUG 6, 81 COMMON/COMNAV/ONAV(50) C A SUBROUTINE TO DO THE PHASE ANGLE CALC. C C INPUT PARAMS ARE BOD(3):THE SUN-BODY STATE VECTOR X,Y,Z C SUN(3):THE SUN-S/C VECTOR X,Y,Z DIMENSION SUN(3),BOD(3),SUNIT(3),BUNIT(3),U(3),UUNIT(3) DO 100 I=1,3 SUN(I)=ONAV(ISUNSC+I-1) BOD(I)=ONAV(IBODY+I-1) U(I)=SUN(I)-BOD(I) 100 CONTINUE CALL VNORM(U,UUNIT) CALL VNORM(BOD,BUNIT) UUNIT(1)=-UUNIT(1) UUNIT(2)=-UUNIT(2) UUNIT(3)=-UUNIT(3) TEMP=DOT(UUNIT,BUNIT) TEMP=ACOS(TEMP)*57.2957795 PHASE=TEMP RETURN END plotit.com_5000066403252300000050000000004421026531574200133430ustar00ksimmons00005460002003$ set verify $ plotit [voyager]GLLPLOT.DAT;4 $ ! |RDO 5 ! |HCO S $ plotit [voyager]gllplot.dat;5 $ ! |RDO 5 ! |HCO S $ STOP*** $ plotit [voyager]gllplot.dat;3 $ ! |HCO S $ plotit [voyager]gllplot.dat;4 $ ! |HCO S $ plotit [voyager]gllplot.dat;5 $ ! |HCO S $ ! finished $ set noverify plotit.pro_9000066403252300000050000000007201026755543400133760ustar00ksimmons00005460002003 pro sho,begrec,nrec !ymax=14000. lin=bytarr(7680) a=assoc(1,bytarr(7680)) for i=begrec,nrec,50 do begin plot,lin t=a(i) print,'start=',t(0),fix(t,1),t(3),(fix(t,16))*256.+t(18),t(19),t(20),t(21) PRINT,'rec=',i for j=0,49 do begin const=(j+1)*260. k=j+i if k ge nrec then goto,finis r=a(k) if (k+1) mod 10 eq 0 then begin r(7677)=100. & r(7678)=100. & r(7679)=100. end oplot,r+13300.-const end finis: print,' |hco w' end return end plotit_byt_laser.pro_15000066403252300000050000000014051026531574600155160ustar00ksimmons00005460002003 pro sho,begrec,nrec set_plot,4 !lo=0 &!hi=0 &!flip=0 !ymax=14000. lin=bytarr(7680) a=assoc(1,bytarr(7680)) b=assoc(1,intarr(3840)) for i=begrec,nrec,50 do begin plot,lin t=a(i) & tt=b(i) ; print,'start=',t(0),fix(t,1),t(3),fix(t,16)+t(18),t(19),t(20),t(21) yr=string(tt(0)) & doy=string(tt(1)) & hr=string(tt(2)) rmin=string(tt(3)) & sec=string(tt(4)) & rrec=string(i) this_info=rrec+yr+doy+hr+rmin+sec xyouts,0.,15000.,this_info PRINT,'rec=',i for j=0,49 do begin const=(j+1)*260. k=j+i if k ge nrec then goto,finis r=a(k) if (k+1) mod 10 eq 0 then begin r(7677)=100. & r(7678)=100. & r(7679)=100. end r=(r < 200) & oplot,r+13300.-const end finis: print,'next page' end qmclose print,'finished, use $qmsb qmsplot.lis' return end plotit_int_laser.pro_24000066403252300000050000000015201026531574700155110ustar00ksimmons00005460002003 pro sho,begrec,nrec ;Nov 4,92, update 2/27/96 set_plot,'ps' device,/landscape !ymax=14000. lin=intarr(600) yr=strarr(5,1) & doy=yr & hr=yr & rmin=yr & sec=yr & rrec=yr a=assoc(1,intarr(600)) for i=begrec,nrec,50 do begin plot,lin t=a(i) ; print,'start=',t(0),fix(t,1),t(3),fix(t,16)+t(18),t(19),t(20),t(21) print,t(0),t(1),t(2),t(3),t(4) yr=string(t(0)) & doy=string(t(1)) & hr=string(t(2)) rmin=string(t(3)) & sec=string(t(4)) & rrec=string(i) this_info=rrec+yr+doy+hr+rmin+sec xyouts,0.,15000.,this_info PRINT,'rec=',i loop: for j=0,49 do begin const=(j+1)*260. k=j+i if k ge nrec then goto,finis r=a(k) if (k+1) mod 10 eq 0 then begin r(599)=100. & r(598)=100. & r(597)=100. end oplot,r+13300.-const end finis: dummy=0 print,'next page' end device,/close print,'finished, use $lwb idl.ps' return end plotit_nif_laser.pro_17000066403252300000050000000017621026531575000154770ustar00ksimmons00005460002003 pro sho_nif,begrec,nrec fil=' ' read,1,' supply filename ',fil close,1 & openr,1,fil read,'want laser(4) or screen(0)',idev if idev eq 4 then set_plot,'ps' ; !lo=0 &!hi=0 &!flip=0 !ymax=14000. lin=bytarr(7680) & r=lin t=bytarr(104) for i=begrec,nrec do begin plot,lin readu,1,t sclk=t(0)*256.*256.+t(1)*256.+t(2) mf=t(3) ; print,'start=',t(0),fix(t,1),t(3),fix(t,16)+t(18),t(19),t(20),t(21) yr=string(t(6)) & doy=string(t(7)*8.+t(9)) & hr=string(t(10)) rmin=string(t(11)) & sec=string(t(12)) & rrec=string(i) this_info=rrec+yr+doy+hr+rmin+sec ; xyouts,0.,15000.,this_info xyouts,0.,16000.,fil PRINT,'rec=',i for j=0,49 do begin const=(j+1)*260. a=bytarr(7680) for mm=0,90 do begin ;collect one spectra a(36+mm*84)=t(20:103) readu,1,t end if (j+1) mod 10 eq 0 then begin a(7677)=100. & a(7678)=100. & a(7679)=100. end oplot,a+13300.-const end finis: print,'next page' end if idev eq 4 then psclose print,'finished, use $lwb psplot.lis' return end proccs.com_4000066403252300000050000000002261032256161300133120ustar00ksimmons00005460002003$ SET VERIFY $ RUN [SIMMONS]VOYOCC [VOYAGER]P20828.V2T 238 01 20 00. 238 01 30 00. 27 -5.,100.,5. 0 1 238 01 40 00. 238 01 50 00. 27 -5.,100.,5., 0 3 proccs.pro_5000066403252300000050000000015571026531575700133610ustar00ksimmons00005460002003 pro proccs,ibeg,iend,m ;forms PROCCS f/t rec May 26,89KES ; ; Output is file whose arrays are Fltarr(603) and in PROCCS f/t: ; first 600 pts are data followed by three FDS times ; ; IBEG is the first rec to read from Input : Assume Open on unit 1 ; IEND is last rec to use (Recall rec should be the IDL Hdr rec #) ; NEW is Associatevariable to Output file : Assume Open on unit 3 ; M return the number of output records written ; Assume VYU has been ".RUN" ; new=assoc(3,fltarr(603)) ;est output file connect ir=ibeg & m=0 ;init output counter loop: vyu,1,ir,dat,fds,ba,bs,ns ;read a rec (skips eng,etc) print,ir,m,fds hold=fltarr(603) ; form new array insert,hold,dat,0 ;put in data pts insert,hold,fds,600 ;put in times new(m)=hold ;place into file m=m+1 ;increment output count if ir gt iend then return else goto,loop end ; all done proccs.txt_3000066403252300000050000000022731032256164300133610ustar00ksimmons00005460002003 THIS FILE SPECIFIES THE CONTENTS OF THE SATURN PROCCS LINK DATA SETS. THE FINAL EDR IS WRITTEN ON THE FILES P20745.V2 (VERSIONS 1 THRU 5 CONTAIN THE ENTIRE SET). AN IDL ASSOCIATED FILE OF THE DATA SET IS PROCCS.DAT;1 (CREATION DATE: JAN 7, 82) THE "P" FILE USES ROUTINE '[SIMMONS]VYS.PRO' AND CONTAINS ALL THE HEADER,DATA, AND ENGINEERING INFORMATION AVAILABLE. THE IDL FILE CONATINS ONLY THE RAW DATA WITH A THREE WORD FDS TIME TAG. (THE IDL FILE IS READ WITH AN "ASSOC(J,FLTARR(603))" WHERE THE FLOATING ARRAY CONTAINS 600 DATA POINTS FOLLOWED BY THE 3 WORD TIME TAG.) THE FOLLOWING TABLE INDICATES THE CONTENTS BY TIME OF THE "P" FILES AND THERE RESPECTIVE LOCATION IN THE IDL FILE. FDS SCE START START END END P FILE # IDL START 43999:00:001 237/22/06/23. 44001:26:401 238/00/03/35. ;1 N.A. 44000:52:001 237/23/35/59. IDL START=0 44001:26:601 238/00/03/47. 274 44002:04:001 238/00/33/35. ;2 573 44002:04:201 238/00/33/47. 574 44002:41:401 238/01/03/35. ;3 873 44002:41:601 238/01/03/47. 874 44003:19:001 238/01/33/35. ;4 1173 44003:19:201 238/01/33/47. 1194 44010:15:01 238/07/06/23. ;5 N.A. 44003:45:601 238/01/54/59. IDL STOP=1387   ring_demo.pro_1000066403252300000050000000036031032256262700140130ustar00ksimmons00005460002003; This file sets up demos for the URANUS and SATURN images. ; It defines the following commands: Nov 6,86 ; ; Saturn: ; SATURN (Fullrings) ; FCOR ; FRING ; Uranus: ; URANUS (Composite) ; RESET ; EPS,EPS ; PART,EPS ; PART,DELTS ; PART,DELTP ; PART,GAM ; PART,BET ; PART,ALP ; ; The Saturn commands can be called at any point from anywhere. ; ; The Uranus commands require the following constraints: ; - COMP must be the first of the Uranus commands called. When ; it asks if you are done, the answer is always NO (0). ; This is the Uranus composite image. ; - The command RESET will set you up so that a following COMP ; call will work, so you can easily re-display the composite ; image. ; - Once COMP has been called, and until RESET has been called ; (i.e. Between those two), the remaining commands can be called. ; They display the separate parts of the composite image. The ; PART command takes as an argument the assoc variable of the ; desired image. The EPS,EPS command displays the Epsilon ring ; in it's widened version. ; TVINIT END ; PRO SATURN,dummy tveras loadct,103 openr,10,'SCIENCE.PIC' a=assoc(10,intarr(512)) for I=0,509 do begin T=A(I) & T(509) = 150 & tvimag,T,0,510-I & end tvimag,A(0),0,0 close,10 return & end ; ; pro FCOR,dummy tveras loadct,103 openr,11,'FCOR.DAT' b=assoc(11,intarr(510)) for I=0,509 do begin T=B(I) & tvimag,T,0,510-I & end close,11 end ; ; pro FRING,dummy tveras loadct,103 openr,12,'FRING.DAT' C=assoc(12,intarr(510)) for I=0,509 do begin T=C(I) & tvimag,T,0,510-I & end close,12 end ; ; ; URANUS ; ; pro URANUS,dummy tveras loadct,101 rc,250 end ; ; pro RESET,dummy close,1,2,3,4,5,6 retall end ; ; pro EPS,eps tveras loadct,101 eps = assoc(1,bytarr(510)) for i=0,509 do begin temp=eps(I) & temp(509)=temp(0) &tvimag,temp,0,I & end eps = assoc(1,intarr(510)) end ; ; pro part,img tveras loadct,101 for i=0,509 do tvimag,img(I),0,I end ; ; @new_ring_comp rtfmt.exe_76000066403252300000050000000720001027674504400132620ustar00ksimmons000054600020030DX0205(/ogxhP7RTFMT01`/o04-00  ("< 6 ?@!d FORRTL_001!  LIBRTL_001y! MTHRTL_001 ASSIGN ERROROUTERREDROUT.LISTAPE ASSIGN ERROREOF not found on disk; Assume EOFREC LEN ERROR" Program Version: November, 1988  DISK INPUT(=1), OR MT:(=0)? REALTIME FILE NAME (FOR FILE:  THEN ENG FLAG FILE ASSIGN ERROR UNIT 1, # MT# THEN ENG FLAG, THEN VALUES) SOURCE TAPE # (MAX=32767) OUTPUT FILE,P20073.V2$ OUTPUT FILE OPEN ERROR UNIT 2,NERR=& OUTPUT FILE OPEN ERROR UNIT 4, NERR4=( Decom choices: 0=decoms from data file,4 1= default ONLY, 2= to supply IFORM  TAPE ASSIGN ERROR UNIT 1 / RESTART?, IF YES(=1) THEN ENTER # START AT(I5). STOP EARLY? (YES=1, THEN GIVE END REC # (I5)) HEADER ERROR # ON REC.LEN=. REC. PASSED OVER1+ VOYAGER PROJECT EDR TAPE REFORMAT PROGRAM EDR #  TAPE #:  FILE #: 1 OUTPUT DISK NAME IS: TODAYS DATE: AUG 30, 77 JOB RUN ON 2 INPUT OUTPUT ERT(GMT)ST < SCE(GMT) S T GOLAY EN ERR  CMD: REC # LEN TYPE WDS BLKS REC DAY HR MN SC.MSC YR DY;HR MN SC.MSC MOD16 MOD60 LINE G F F COUNT RT CNT (O5) RESTARTED AT REC: RTSUB ERROR= COMPLETED FILE ANOTHER INPUT FILE? (Y=0) P.E.+  BAD REC LEN, =NEXT+  ZERO HDR & CANNOT DEFINE MODE TYPE FROM TABLE + GS-3  C+  OCC+  DEC  DECOM RETURNS NO VALUES  DEFAULT DECOM (GS-3)( SUPPLY IFORM (4=GS-3, 3=MN MODES, 2=CR)+  ENG+ CR-2+ CR-1+ CR-5+  CR-6+ CR-3+ CR-4+1 NEW OUTPUT FILE BEGINS HERE CONTINUATION FILE # ERROR CONDITION,GO TO NEXT READ END OF JOB  FORTRAN FORMAT RECORDS WRITTEN ONTO  TAP IS NOT AN MJS; 1ST CHAR.= REC ID IS NOT PPS, IS:+ . . *OC SIZE LIMITOC DATA LIMITOC LIMIT PART1OC LIMIT PART2 CHECK EXPONENT0 PROBLEM W/DECOM RECORD, SELECT:(2=CR,3=MN,4=GS)3 DECOM FINDS MORE VALUES THAN HAS ROOM FOR WHILE ON+ NO ENG.MINOR FRAME SYNC WORD FOUND; RETURN+ ENG.TIMING OFFSET ERROR:DMOD GT 1MF (DMOD=  NO EOF FOUND ON FILE; ASSUME EOF READ ERROR ON INPUT EOF ON INPUT LENGTH ERROR, ITEMP= DISK ERROR IHDRDISK ERROR ISTATDISK ERROR IDATADISK ERROR IDAT2(LSB)DISK ERROR ENG IHDR WRITE ERROR ISTAT WRITE ERROR IDATA WRITE ERROR IDAT2 WRITE ERROR (LSB) ENG WRITE ERROR IHOLD DISK ERROR @ (@ <@  @ F@ (@t<Z@  @d<f@ " XAj@l@`@x<N@?n@@J@- !h< (@\@^@z@|@p<!> _@@@@@@P@@`@x<N@?n@  @`@x<N@?n@@@x<n@@.@x@L@ XAj@l@      XYZ[\]^_d,X Lx@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]l4` ( T  H t<h0c     \$P|}~D  MMMP$P MMMP$| MMM  $P MMM  H \   (?0123456789:#@'="  G !  `.`< I$  (`<II3  `<IIC  !`<IIS  `0`<IIh  `:`< I  xJ O[\RSQd(M(DJ(?(-(`1\K('''?'''H'.$~'2~''ˀ'Ȱ6 'n'k'@I'N'EK'?'.'Dӱ%'?&VWV2WP?@&=VW&Ϋ&&Ｒ&?&&$VƜ"d&&i|&?F&WkQ&R&W2WP@ˈ&d0/#4&2~%&˼#&%.~%2~%%˼%%%%?p%%K(PPXX:~r%X=%R%X@<l%DU%9%"%%?$% $?$$ٰ$$ｰ$?$$ $?g$$Z2TLh0j0>P9Z$?h0$$?j0 $$$Y ˀKz$Z2ZP@#=Z#ﰰ#ZW2ZP@#=WZ####?]# k#l#tm#W2WP@#=W8#W9#"#!5#2~""W^2TLYh0j0@P"?h0"2Y~"?j0""YZY1ːR1yI$j"˨?"D"&pA"2~""˰!U"?0!!:!2\~!!!2\~!!節!?z!!1 \ﺫ!2\~K!h!Re!?/!=!>!H !0~,!2~ !ˀ!1dRf1( Y1K Y1 12TLPTh0 j01j0PPf Y1Ts﹬ 2Y~N ?h0G ?j0< U T0îM 6 ﭮ7 1 Y1FBj0RR ˸ RPTP2TQAfXAAf3XA=PTj0RT?2Y~2R~yRTRfTRTRTR TRTT6ڭW2R~6ԭ7 Z~^^1­2Y~?x"?z"?|"2T~T2XH61H6mH61P2~L?H6D]PR PPZWJ3ZR1 15)Z 1Z~ PƖ"1}ݬWZ1bʫ?0ghĬiRIO?2I%W1yJ WPPW1Xo1:ZW@2WƘ"ƚ"Ɩ"1QZXX1wq11]d2~%BC,1Z PƖ"1«ﲫs Ɩ"tIEhXPƖ"Ɩ"1Ɩ"SSPPƖ"SSS?Ɩ"2S~d0WW7/ɪW`Uɪ4SPXP2XQAƞAA=PX1P2PXH^"H^.=PƜ"P2PXH^$=P2PPd0PPPP 1 hթpxֵ-Τ~2~v˼2XH˴˰`],^H2UU.+3,HU 2~Wˈd0-2~s˼d0PP1PPPZZKJ3Zr('ZR1ZR11gw115hd0kz{O[ P2PRBPPTT+T ʧA2T~ BPPTT`STLTE﫧2T~2T~ B9PPPP2TD'TB"QQB2UUUеQBVVVVQVQQQVQBީQQQ2QAMA︩XMYD,YBYXIX֧VTQTG~QTGPGTE9VPIPPMPPDGPCPVPSQ2QQITAŜSQ2QQIPASV=RS:SVR2VQAS=RVSR Ox[^kRSPPT UVﳣW 1S  ߫+2TP@QQ@gXX@XQ2SYQXIǞ@QQQQ@PPPQITSYS  ߫ 2TP@Q?Q@XX@QX2SZXQJǞ@QQ@XXXQXXQJǠ@QQ@XXXQ@XXQJǢ@QQ@PPPPPQJǤTSS! ߫ Y12TP@Z?Z@QQ@ZQ2SXQZHǞ@QQ@ZZZQZZQHǠ@gQQ@ZZZQ@ZZQHǢ@QQ@gPPPPPQHǤTSS  ߫v= YSYYPVPPYT=UVSVVǖ"V  1lSPPZE9PYQYGPGYIYYMYYDGYBYPQZGPGZQPGPGPIZHǞIPHXXTP2PPM@ǞZU#QZaESAEZYDRYCRQDQ@YQZQE>QZE9QYIYYMYYDGYBYQQZGPGZIZ@ǞIQ@=;XS~ =RkOt[^Ь Ïz Ь$R PQ>S2PT(T2QUTUE(EP=Q= P!PQ>$U2QVFzFe=PQVW12WXH$YR1 J ?(  ] ? 2P PQXQ2ZS2QZZPZZXZJx2UJxEx2TYDh=QV1XSX1>TSPP2SQAYh2Q2PP@ːAx2QYAhDm 2Y~ M~ 2Y~z =XS~=VWR1\V1>WS2VY2SX XPYP@8Ix3@8M!XYXIxHIxHIxH=SMIxSFCSISSdSXXIxPPXSS.XSS2XSS7XSXSX(XY2XHx1KHPHQQ޼ >(AtP$",R2~VsRؗmVRV1RdPdPd?QP2QWG縉G=PQQP2QWGXGG3XG=PQP!PQQ2QWPQX2XXH˗G=Q QQWW W W`f 12W~]zW1q/%<P P P P d PPRRPdPP RVPWP 2WQA˘XA˗A˘3XA˗=PWVRRPdP PddSSPPPPWP2UQ2WXH˖AU=PWVR1US2UVPSPUP2PP@˖Fd=SUR H[͖R–"PP–"k- 2~߫1–"P1 f.ԕ2~߫8@++ﰕ2~Mj߫X|`+T2~2߫xD1PPQ2QSCC^.CžC.CCž/=PQˠX>ˀZ.2~|˘K[ЬЬ  $R"Ka[ЬЬ  $RSTU1>V޻$WR&ݧ2~?(P<PQRQSX2XX2QYIHf2QXQSY2YYIfH=PQR&ݧ2~?(PS=TUg@@(@H0 8h ((v @FORRTLLIBRTLMTHRTL FMTRT$MAINP FMTRT$MAIN¹ ¹ - # #  Qù  B   # . EDRHDR aEDRHDR # GSDATA (fGSDATAF  OCDATA $hOCDATAq  DECOM kDECOMwE d $ y$ ENGDAT nENGDAT|& 7 ASCI qASCI^ RTSUB rRTSUB{ VYOUT $uVYOUTY  1 BLKRDW vBLKRDWsat_crunch.for_1000066403252300000050000000325621032256276600142010ustar00ksimmons00005460002003C PROGRAM CRUNCH FEB 2, 82 C A PROGRAM TO EXTRACT VOYAGER DATA FROM THE MERGE FILE SET C AND PLACE GROUPS OF FILT/ANA DATA FROM A MAJOR FRAME INTO AN C ARRAY OF INCREASING TIME FOR A SINGLE SCAN PLATFORM POINTING C C "I"46 (ETC) ARE INDICES FOR THE F4/6 (ETC) ARRAYS C T46 (ETC) CONTAINS THE TIME OF THE DATUM C C THIS ROUTINES WRITES AN UPDATED VERSION OF THE FILE C CONTAINING THE ORIGIONAL DATA AND THE ANSWERS C CALCULATED HERE. C C ACCUMULATE ARRAYS FOR CURVE FITTING HOLD 6 MAJOR FRAMES AT MOST C C THE COMMON DATA MATRIX IS STRUCTURED SO THAT (I,J): C I IS SAMPLE FROM 1 TO 156 (26 PER MJF*6 MAX MJF'S) C J IS F/A PAIR: F46,F66,F67,F47 C ## PTS PER ^ 26 10 26 10 C THE TIME ARRAY IS ORDERED THE SAME WAY C C THE OUTPUT ARRAY IS THE SAME AS THE MERGE FILE INPUT FILE C WITH ANSWERS INPUT INTO UNUSED PORTIONS OF THE ORIG. ARRAY C SEE AREA AT END OF PROGRAM FOR WHAT'S WHERE(OR "WRITEUP.TXT") C C A SECOND OUTPUT FILE ALLOWS PLOT PARAMS TO PASS TO A C TEMPORARY FILE FOR LATER IDL PLOTTING OF DATA/FIT CURVES. C C************************************************************* COMMON DATA(156,4),TIMES(156,4),I46,I66,I67,I47 DIMENSION RAW(650),ACOEF(10),SIGMAY(156),TEMPD(156),TEMPT(156) DIMENSION IFA(4),COEF(10,4),CHI(4),CALIB(2) DIMENSION ANS(4) REAL K16(2),K26(2),K17(2),K27(2) CHARACTER*25 NAMIN CHARACTER*4 IDS(4) CHARACTER RUNDAY*9,RUNTIM*8 C C STATEMENT FUNCTION FOLLOWS C C CALC. FUNCTION VALUE FROM CURVE FIT COEFF'S VALUE(TT,A,B,C,D,E)=A+(B*TT)+(C*TT*TT)+(D*TT*TT*TT)+(E*TT*TT*TT*TT) C C NTERMS AND MODE ARE FIXED FOR OUTPUT ARRAY CONSIDERATIONS DATA DTIM/.6/,MODE/-1/,J/161/,KREC/1/,IPLT/1/ DATA IDS/'F4A6','F6A6','F6A7','F4A7'/ C PLACE K1 AND K2 ANALYZER CONST. INTO ARRAYS BY F4 THEN F6 ORDER DATA K16/.336,.790/,K26/.0158,.1111/ DATA K17/.350,.768/,K27/.0128,.1029/ C PLACE INTENSITY CALIB. INTO ARRAYS BY F4,F6 DATA CALIB/5.13E-5,3.16E-5/ !F4,F6 C C INITIALIZE CALL DATE(RUNDAY) !RECORD RUN TIMING CALL TIME(RUNTIM) DTR=3.141592654/180. !DEG TO RAD CALCON4=K17(1)*K16(1)-K27(1)*K26(1) !CONSTANTS FOR (.1174) CALCON6=K17(2)*K16(2)-K27(2)*K26(2) ! INTENSITY CALC. (.5953) I46=1 !INDICIES/COUNTERS FOR F/A GROUPS I66=1 I67=1 I47=1 WRITE(5,5) 5 FORMAT(' SUPPLY MERGE FILE NAME (A25)') READ(5,15) NAMIN 15 FORMAT(A25) C OPEN(UNIT=1,ACCESS='DIRECT',NAME=NAMIN,ASSOCIATEVARIABLE=IREC, + IOSTAT=INERR,ERR=7000,STATUS='OLD',READONLY) !INPUT C OPEN(UNIT=7,ACCESS='DIRECT',NAME='MERG.DAT',ASSOCIATEVARIABLE + =KREC,IOSTAT=KERR,ERR=7000,STATUS='NEW',RECL=650) !OUT. DATA C OPEN(UNIT=3,ACCESS='DIRECT',NAME='CRUNCH.PLT',IOSTAT=IPERR, + ASSOCIATEVARIABLE=IPLT,ERR=7000,STATUS='NEW',RECL=156) !OUT.PLT C WRITE(5,25) 25 FORMAT(' OUTPUT LOG :FOR004.DAT, ANSWERS ' + 'ON UPDATED VERSION OF MERGE FILE', + /,' AND PLOT VECTORS ON "CRUNCH.PLT" FILE',/) !OUT.LOG C WRITE(5,35) C35 FORMAT(' SUPPLY START TIME FLAG (REC#=0,FDS=1,SCE=2)', C + /,' ARRAYS HOLD 20 MAJOR FRAMES MAX') C READ(5,45) ITYP ITYP=0 45 FORMAT(I1) WRITE(4,115) RUNDAY,RUNTIM,NAMIN WRITE(5,115) RUNDAY,RUNTIM WRITE(4,165) K16,K26,K17,K27 WRITE(5,135) READ(5,*) MYR,MMO,MDAY,MHR,MMI C WRITE(5,125) C READ(5,45) ICFLAG ICASE=0 C C BEGIN LOOPING FOR EACH POINTING CASE C 1000 CONTINUE C THE ABILITY TO LOCATE DATA BY TIME IS NOT IMPLEMENTED YET IF(ITYP .EQ. 0) THEN WRITE(5,55) 55 FORMAT(' SUPPLY RECORD BEGIN,END (#,#), MAX DELTA=6') READ(5,*) JREC,NREC IREC=JREC C65 FORMAT(I4,1X,I4) WRITE(5,155) JREC,NREC WRITE(5,65) 65 FORMAT(' SUPPLY # TERMS FOR THE POLY FIT') READ(5,*) NTERMS END IF IF(ITYP .EQ. 1) THEN WRITE(5,75) 75 FORMAT(' GIVE START,END FDS (00000.,00.,00000.,00.)') READ(5,85) BFDS1,BFDS2,EFDS1,EFDS2 85 FORMAT(4F8.1) END IF IF(ITYPE .EQ. 2) THEN WRITE(5,95) 95 FORMAT(' SUPPLY SCE START (D,H,M,S)') READ(5,*) BDAY,BHR,BMIN,BSEC WRITE(5,105) 105 FORMAT(' SUPPLY SCE END TIME (D,H,M,S)') READ(5,*) EDAY,EHR,EMIN,ESEC END IF 115 FORMAT(' JOB RUN:',A9,1X,A8,' FROM MERGE FILE:',A25) 125 FORMAT(' WANT TO COPY ALL RECS(=1) OR ONLY USED RECS(=0)?') 135 FORMAT(' SUPPLY RUN TIME INFO: MYR,MMO,MDAY,MHR,MMI') 155 FORMAT(2I5) 165 FORMAT(/,' THE K1A6 (F4,F6) VALUES ARE:',2F8.5,/, + ' THE K2A6 (F4,F6) VALUES ARE:',2F7.5,/, + ' THE K1A7 (F4,F6) VALUES ARE:',2F7.5,/, + ' THE K2A7 (F4,F6) VALUES ARE:',2F7.5,/, + ' THE MAJOR FRAME SEQUENCE IS: F4A6,F6A6,F6A7,F4A7',/) WRITE(4,185) CALIB 185 FORMAT(' I/F CALIB. FACTORS ARE:',E10.3,' (F4), AND',E10.3,' (F6)') ICASE=ICASE+1 !COUNT THE NUMBER OF CASES/RUN WRITE(5,195) 195 FORMAT(' SUPPLY F4A6 START POINT OFFSET') READ(5,*) JF4A6 WRITE(4,205) JF4A6 205 FORMAT(' F4A6 DATA IS OFFSET BY ',I5) WRITE(5,215) 215 FORMAT(' POINTING AT SATURN (=1), OR TITAN(=2)?') READ(5,*) ISTFLAG START=0. !THIS IS THE STARTING TIME IRUSED=0 !WILL COUNT NUMBER OF RECS ACTUALLY READ C C BEGIN LOOPING WITHIN POINTING CASE C IF(ITYP .EQ. 0) THEN IF(ICASE .GT. 1) WRITE(4,1105) 1105 FORMAT(1H1) WRITE(4,1125) ICASE,JREC,NREC 1125 FORMAT(/,' CASE:',I3,' START AND STOP RECORDS ARE:',2I5) END IF C FOR NOW ASSUME START IS RECORD # 1100 IF(IREC .GE. NREC) GO TO 1200 !REMEMBER, IREC IS AT IF(NREC-IREC+1 .GT. 20) GO TO 1200 !NEXT REC ..TO READ.. READ(1,REC=IREC) RAW IRUSED=IRUSED+1 WRITE(4,1135) IREC,RAW(3),RAW(4),RAW(5),RAW(6),RAW(7),RAW(8), + RAW(9),RAW(10),RAW(11) C WRITE(4,1145) I46,I66,I67,I47 C1145 FORMAT(' START WITH INDEXES:F46,F66,F67,F47',4I5) 1135 FORMAT(I5,6F5.0,F7.0,2F3.0) C DO 1110 I=J+JF4A6,J+21 !THE F4/A6 GROUP IF(RAW(I) .LE. 0.) GO TO 1110 !DO NOT INCLUDE ZERO VALUES DATA(I46,1)=RAW(I) TIMES(I46,1)=START+DTIM*(I-J) I46=I46+1 1110 CONTINUE DO 1120 I=J+24,J+33 !THE F6/A6 GROUP IF(RAW(I) .LE. 0.) GO TO 1120 DATA(I66,2)=RAW(I) TIMES(I66,2)=START+DTIM*(I-J) I66=I66+1 1120 CONTINUE DO 1130 I=J+36,J+61 !THE F6/A7 GROUP IF(RAW(I) .LE. 0.) GO TO 1130 DATA(I67,3)=RAW(I) TIMES(I67,3)=START+DTIM*(I-J) I67=I67+1 1130 CONTINUE DO 1140 I=J+64,J+73 !THE F4/A7 GROUP IF(RAW(I) .LE. 0.) GO TO 1140 DATA(I47,4)=RAW(I) TIMES(I47,4)=START+DTIM*(I-J) I47=I47+1 1140 CONTINUE DO 1150 I=J+76,J+79 !MORE F4/A6 IF(RAW(I) .LE. 0.) GO TO 1150 DATA(I46,1)=RAW(I) TIMES(I46,1)=START+DTIM*(I-J) I46=I46+1 1150 CONTINUE START=START+48. !INCREMENT START SECS. BY 1 MAJ.FRAME GO TO 1100 C 1200 CONTINUE IFA(1)=I46-1 !ADJUST THE COUNTERS IFA(2)=I66-1 IFA(3)=I67-1 IFA(4)=I47-1 WRITE(4,1235) IFA !RECORD ## POINTS WRITE(5,1235) IFA 1235 FORMAT(' NO.PTS IN EACH ARRAY:',4I5) C C 2000 CONTINUE C C NOW LOOP ON EACH DATA SET TO DETERMINE FIT C DO 2500 II=1,4 !LOOP FOR F/A PAIRS DO 2010 JJ=1,156 !INITIALIZE ALL ARRAYS TEMPD(JJ)=DATA(JJ,II) !STORE DATA IN TEMP ARRAYS 2010 TEMPT(JJ)=TIMES(JJ,II) !" DO 2210 I=1,156 2210 SIGMAY(I)=1. !USE 1. FOR MODE CASE WHERE "/" BY SIGMAY DO 2220 I=1,10 2220 ACOEF(I)=0. ITEMS=IFA(II) C WRITE(4,5555) ITEMS,NTERMS,MODE,TEMPT,TEMPD,SIGMAY,ACOEF,CHISQR 5555 FORMAT('ITEMS,NTERMS,MODE:',3I5,/,' TEMPT...:',(5E12.2)) C CALL POLFIT(TEMPT,TEMPD,SIGMAY,ITEMS,NTERMS,MODE,ACOEF,CHISQR) IPFLAG=0 !PRINT FLAG FOR LARGE VALUES DO 2230 MM=1,5 !CHECK FOR FORMAT OVERFLOW VALUES 2230 IF(ABS(ACOEF(MM)) .GT. 1.E+7) IPFLAG=1 IF(ABS(CHISQR) .GT. 1.E+3) IPFLAG=1 IF(IPFLAG .EQ. 0) WRITE(4,2205) IDS(II),ITEMS,ACOEF(1),ACOEF(2), + ACOEF(3),ACOEF(4),ACOEF(5),CHISQR IF(IPFLAG .GT. 0) WRITE(4,2215) IDS(II),ITEMS,ACOEF(1),ACOEF(2), + ACOEF(3),ACOEF(4),ACOEF(5),CHISQR 2205 FORMAT(' THE CASE IS:',A4,' USING',I5,' POINTS',/, + ' THE COEFS ARE:',5F12.5,' CHISQR =',F7.3) 2215 FORMAT(' THE CASE IS:',A4,' USING',I5,' POINTS',/, + ' THE COEFS ARE:',5E12.5,' CHISQR =',E12.5) C DO 2300 JJ=1,5 !STORE THE ANSWERS 2300 COEF(JJ,II)=ACOEF(JJ) CHI(II)=CHISQR WRITE(3,REC=IPLT) TEMPD !STORE PLOT Y-AXIS VALUES WRITE(3,REC=IPLT) TEMPT !AND X-AXIS TIME VALUES C C NOW, USING COEFS, DETERMINE FITTED CURVE FOR PLOT FILE C DO 2410 JJ=1,156 DT=JJ*2. !USE A TWO SEC. DELTA TEMPT(JJ)=DT TEMPD(JJ)=VALUE(DT,ACOEF(1),ACOEF(2),ACOEF(3),ACOEF(4),ACOEF(5)) 2410 CONTINUE WRITE(3,REC=IPLT) TEMPT !PLOT FULL X,Y AXIS VALUES WRITE(3,REC=IPLT) TEMPD 2500 CONTINUE C C 3000 CONTINUE C GO BACK THRU DATA RECORDS AND: C 1) DETERMINE FITTED VALUE FOR GEOM TIME (FDS LINE=601) C FOR EACH MAJOR FRAME USED IN FIT (=4 F/A VAULES) C 2) DETERMINE POLARIZATION FOR THAT FRAME C FOR EACH FILTER (=2 VALUES) C 3) WRITE THE ANSWERS INTO A FILE C SUPPLY ID INFO. C IRON=0 !WHICH INPUT REC NOW ON (DETERMINES THE C !FORMAT FOR THE OUTPUT DATA RECORDS IREC=JREC !RESTORE BEGINNING REC # C WAIT TO TEST END # TIL DONE PROCESSING START=0.+.75*48. !1ST REC. GEOM TIME FOR FDS LINE 601 C C WANT TO TRY DIFFERENT TIMING TO TEST LOCATION OF POL. CALC IN MJF 3100 CONTINUE !LOOP TO HERE FOR NEXT POINTING DO 3200 II=1,4 !CALC. FIT VALUE FOR EACH F/A AA=COEF(1,II) BB=COEF(2,II) CC=COEF(3,II) DD=COEF(4,II) EE=COEF(5,II) DT=14.*.6 !FOR F4 POL TRANS ADD 14 M.F. OFFSET IF(II .EQ. 2 .OR. II .EQ. 3) DT=-26.*.6 ANS(II)=VALUE(START+DT,AA,BB,CC,DD,EE) WRITE(4,3105) II,START+DT,ANS(II) WRITE(5,3105) II,START+DT,ANS(II) 3105 FORMAT(' F/A #',I3,' AT START TIME',F10.3,' GIVES VALUE',F12.5) 3200 CONTINUE C C BRING IN THE RAW ARRAY AGAIN; WILL NOW NEED THE GEOM VALUE READ(1,REC=IREC) RAW IRON=IRON+1 !INCREMENT WHICH REC WE'RE ON SCAT=RAW(347) !SATURN SCAT. ANGLE FROM NAV. GEOM IF(ISTFLAG .EQ. 2) SCAT=RAW(345) !TITAN SCAT. ANGLE IF(SCAT .EQ. 0.) THEN !SCATTERING ANGLE ERROR WRITE(5,3205) ICASE,IREC,RAW(9),RAW(10) WRITE(4,3205) ICASE,IREC,RAW(9),RAW(10) 3205 FORMAT(' FOOT ERROR, SCAT.=0.; CASE,IREC,FDS=',2I4,F7.0,F5.0) END IF SECCHI=0. CHIR=SCAT*DTR !CONVERT TO RADIANS IF(SCAT .NE. 0.) SECCHI=1./COS(2.*CHIR) !FIND SECANT 2*CHI WRITE(4,3215) SCAT,SECCHI WRITE(5,3215) SCAT,SECCHI 3215 FORMAT(30X,'SCAT.ANG. OF SATURN AND SECANT OF SCAT.ANG.=',2F8.3) C C NOW CALC. THE POLARIZATION FOR EACH FILTER C C REMEMBER THE ANS ARRAY ORDER IS F46,F66,F67,F47 C II=1 !DO FILTER 4 THEN FILTER 6 TOP=ANS(4)*(K16(II)+K26(II))-ANS(1)*(K17(II)+K27(II)) BOT=ANS(1)*(K17(II)-K27(II))+ANS(4)*(K16(II)-K26(II)) POLF4=SECCHI*TOP/BOT F4INTEN=CALIB(1)*BOT/CALCON4 SIGNUM=((K16(II)+K26(II))**2)*ANS(4)*CHI(4)/(IFA(4)-1.)+ + ((K17(II)+K27(II))**2)*ANS(1)*CHI(1)/(IFA(1)-1.) SIGDEN=((K17(II)-K27(II))**2)*ANS(1)*CHI(1)/(IFA(1)-1.) + + ((K16(II)-K26(II))**2)*ANS(4)*CHI(4)/(IFA(4)-1.) SIGPOL4=(SIGNUM/(TOP*TOP))+(SIGDEN/(BOT*BOT)) TEMP=SIGPOL4*(POLF4*POLF4) SIGPOL4=0. IF(TEMP .GT. 0.) SIGPOL4=SQRT(TEMP) II=2 TOP=ANS(3)*(K16(II)+K26(II))-ANS(2)*(K17(II)+K27(II)) BOT=ANS(2)*(K17(II)-K27(II))+ANS(3)*(K16(II)-K26(II)) POLF6=SECCHI*TOP/BOT F6INTEN=CALIB(2)*BOT/CALCON6 SIGNUM=((K16(II)+K26(II))**2)*ANS(3)*CHI(3)/(IFA(3)-1.) + + ((K17(II)+K27(II))**2)*ANS(2)*CHI(2)/(IFA(2)-1.) SIGDEN=((K17(II)-K27(II))**2)*ANS(2)*CHI(2)/(IFA(2)-1.) + + ((K16(II)-K26(II))**2)*ANS(3)*CHI(3)/(IFA(3)-1.) SIGPOL6=(SIGNUM/(TOP*TOP))+(SIGDEN/(BOT*BOT)) TEMP=SIGPOL6*(POLF6*POLF6) SIGPOL6=0. IF(TEMP .GT. 0.) SIGPOL6=SQRT(TEMP) 3400 CONTINUE WRITE(5,3425) F4INTEN,F6INTEN,POLF4,POLF6 WRITE(4,3405) F4INTEN,F6INTEN,POLF4,POLF6 3405 FORMAT(80X,'INTENSITIES:',F8.3,' (=F4),',F8.3,' (=F6)',/,79X, + 'POLARIZATIONS:',F8.3,' (=F4),',F8.3,' (=F6)') 3425 FORMAT(' INTENSITIES:',2F8.3,' (F4,F6)',/, + ' POLARIZATIONS:',2F8.3,' (F4,F6)') WRITE(4,3415) SIGPOL4,SIGPOL6 3415 FORMAT(70X,'UNCERTAINTIES IN POLAR.:',F7.3, + ' (=F4),',F8.3,' (=F6)',/) WRITE(5,3435) SIGPOL4,SIGPOL6 3435 FORMAT(' UNCERTAINTIES IN POLAR:',2F8.3,' (F4,F6)') C STORE THE ANSWERS DO 3410 II=1,50 3410 RAW(600+II)=0. !ZERO ANSWER PORTION OF ARRAY RAW(601)=MYR !RUN YEAR RAW(602)=MMO*100+MDAY !RUN MONTH*100+DAY RAW(603)=MHR*100+MMI !RUN HOUR*100+MINUTES RAW(604)=SECCHI !SECANT 2*PHASE VALUE USED DO 3420 II=1,2 !RECORD K1 AND K2 VALUES RAW(604+II)=K16(II) !F4 THEN F6 VALUE RAW(606+II)=K26(II) RAW(608+II)=K17(II) 3420 RAW(610+II)=K27(II) !THIS USES RAW(605-612) RAW(613)=START !POINTING DELTA TIME RAW(614)=14.*.6 !OFFSET FOR F4 A6A7 TRANSITION RAW(615)=-26.*.6 ! " F6 " " RAW(616)=CALIB(1) !STORE I/F CAL FACTOR FOR F4 RAW(617)=CALIB(2) ! " " F6 DO 3430 II=1,4 !STORE DN DETERMINED ANSWERS 3430 RAW(617+II)=ANS(II) !ONE F/A VALUE-RAW(616-9) RAW(622)=F4INTEN !INTENSITY FOR F4 RAW(623)=F6INTEN !INTENSITY FOR F6 RAW(624)=POLF4 !POLARIZ. FOR F4 RAW(625)=POLF6 !POLARIZ. FOR F6 RAW(626)=SIGPOL4 !UNCERTAINTY IN POLAR. F4 RAW(627)=SIGPOL6 ! " " F6 C THAT LEAVES 628-650 STILL AVAILABLE DO 3450 II=1,4 ! FILL IN COEF'S AND SIGMA RAW(39+II)=COEF(1,II) ! FOR EACH F/A SET RAW(43+II)=COEF(2,II) !USE UN-USED HEADER WORDS AREA RAW(47+II)=COEF(3,II) RAW(51+II)=COEF(4,II) RAW(55+II)=COEF(5,II) RAW(59+II)=CHI(II) !ERROR OF FIT IN @F/A SET RAW(63+II)=IFA(II) !# TERMS USED IN @F/A SET 3450 CONTINUE RAW(68)=IRUSED !#MJF'S USED IN THE SET RAW(69)=IRON !WHICH OF SET WE'RE ON NOW (1-N) C THAT LEAVES 70-80 STILL AVAILABLE WRITE(7,REC=KREC) RAW !WRITE OUTPUT ARRAY IF(IREC .GE. NREC) GO TO 6000 !TEST FOR DONE WITH THIS CASE START=START+48. !INCREMENT DELTA TIME ONE MJF GO TO 3100 C 6000 CONTINUE C CHECK IF WANT MORE CASES WRITE(5,6005) 6005 FORMAT(' THIS CASE IS FINISHED; DO YOU WANT TO QUIT(Y=1)?') READ(5,45) IQUIT IF(IQUIT .EQ. 1) THEN WRITE(5,6015) ICASE 6015 FORMAT(' JOB FINISHED AFTER:',I3,' CASES') WRITE(4,6015) ICASE STOP END IF DO 6100 II=1,156*4 TIMES(II,1)=0. 6100 DATA(II,1)=0. GO TO 1000 7000 WRITE(5,7005) INERR 7005 FORMAT(' FILE OPEN ERROR #',I5) STOP 7200 WRITE(5,7205) INERR 7205 FORMAT(' FILE READ ERROR #',I5) STOP END 1125) ICASE,JREC,NREC 1125 FORMAT(/,' CASE:',I3,' START AND STOP RECORDS ARE:',2I5) END IF C FOR NOW ASSUME START IS RECORD # 1100 IF(IREC sat_ns_merg.pro_1000066403252300000050000000063611032252534300143470ustar00ksimmons00005460002003; A procedure to re-merge Saturn merge data file M236.V2 with new ; C_smithed geometry from FP2144_SAT_CS.FOT. Assumes files open ; already with 1=M236 and 2=FOT while ASSOC is assigned as 1=A,2=B. ; Sept 11, 1990 ; edited Sept 12,90 to include input file info and make Non-smithed version < ; edited Sept 17,90 to correct record # =mbeg for start of N/S Map ;<< ; MBEG & MEND are M236 beg/end recs; FBEG & FEND are for .FOT C=2.^16. ;adjust .FOT FDS value CLOSE,1 & OPENR,1,'DISKG:[MERGES]M236.V2' ;< A=ASSOC(1,FLTARR(650)) ;< MBEG=21 & MEND=789 ;< PRINT,'M236 file Beg, End=',A(8,MBEG),A(9,MBEG),A(8,MEND),A(9,MEND) ;< read,'Want C_Smithed (=0) or Non-Smithed (=1)',choose ;<< CLOSE,2 if choose eq 0 then OPENR,2,'diskg:[GEOM]FP2144_SAT_CS.FOT' ;<< if choose eq 1 then OPENR,2,'diskg:[GEOM]FP2140_SAT_NONCS.FOT';<< B=ASSOC(2,FLTARR(160)) ;< FBEG=0 & FEND=3076 ;< PRINT,'FOT file Beg,End=',B(6,FBEG)+C,B(7,FBEG),B(6,FEND)+C,B(7,FEND) ;< ;the new merge file CLOSE,3 if choose eq 0 then OPENW,3,'M236_NEW_CS.V2',650*4 ;<< if choose eq 1 then OPENW,3,'M236_NON_CS.V2',650*4 ;<< NEW_NS=ASSOC(3,FLTARR(650)) M=0 ;count output recs ;<< FOR m=0,mbeg-1 DO new_ns(m)=fltarr(650) ;zero fill early recs J=FBEG ;first Foot rec (=:001) LOOP: FOR I=MBEG,MEND DO BEGIN OLD=A(I) ;orig merge array if I eq 654 then j=j-4 ;repeat rec time RETRY: FOOT=B(J) ;get next .FOT set print,'old,fot=',i,j,old(8),foot(6)+c,old(9),foot(7) IF(OLD(8) EQ FOOT(6)+C) AND (OLD(9) EQ FOOT(7)) THEN BEGIN ;timematch NEW=FLTARR(650) ;ZERO FILL NEW(0)=OLD(0:399) ;orig data, PV,NAV ;; NEW(600)=OLD(600:649) ;orig analysis params ;;EMPTY FOR JJ=0,3 DO BEGIN ;accum @12s Foot set FOOT=B(J+JJ) TEMP=FLTARR(50) ;temp holding TEMP(0)=FOOT(0:7) ;times Y,D,H,M,S,MSEC,FDS1,FDS2 TEMP(8)=OLD(400+49+(JJ*50));was ID; now=orig Chi TEMP(9)=FOOT(65) ;motion TEMP(10)=FOOT(40:43) ;sub-solar lat,lon; sub-s/c lat,lon TEMP(14)=FOOT(59) ;optic axis cone TEMP(15)=FOOT(66) ;clock TEMP(16)=FOOT(68) ;slant range TEMP(17)=FOOT(69:72) ;optic axis lat,lon,incid,emiss TEMP(21)=FOOT(75:76) ;az in plane tang to surf... TEMP(23)=FOOT(80) ;pt of Closest approach TEMP(24)=FOOT(73) ;pict.bod interc.phase TEMP(25)=FOOT(79) ;pict.bod interc.local hr ang TEMP(26)=FOOT(37) ;rang, s/c to central bod TEMP(27)=FOOT(11:14) ;time to/from peri,cart pos s/c-c.bod TEMP(31)=FOOT(46:54) ;transform matrix TEMP(40)=FOOT(21:23) ;cart.vec earth, s/c cent TEMP(46)=FOOT(33) ;rang, cent.bod to sun TEMP(47)=FOOT(82) ;rang, cent.bod cent to ring interc TEMP(48)=FOOT(85) ;ring interc pt emission ang TEMP(49)=FOOT(92) ;ring interc pt local hr ang NEW(400+(JJ*50))=TEMP ;new FOOT values for :001+(200*JJ) END ;12s*4 loop NEW_NS(M)=NEW & M=M+1 ;write it out J=J+4 ;pt to next .FOT rec IF J GE FEND THEN GOTO,FINIS GOTO,NEXT ;ready for next orig rec END ;matched time loop J=J+1 ;if no time match, inc .FOT to skip data gap GOTO,RETRY ;try time match again NEXT: DUM=0 END ;main loop on merge recs FINIS: PRINT,'FINISHED, RECORDS OUTPUT=',M-1 ;all done STOP END saturn_pds.pro_1000066403252300000050000000033421032252534300142240ustar00ksimmons00005460002003;Sept 22, 1990--KES ; Three files of data are ready for re-formatting for PDS ; The first is the Orig merge data file: m236 ; The second is the c_smithed new footprint merged data ; The third is the new s/w non-smithed footprint ; Wayne modeled the data for each geom set. PDS wants all ; three as separate tables. ; close,1 read,'choose orig(=0), CS (=1) or new-non (=2)',choose if choose eq 0 then openr,1,'diskg:[merges]m236_orig.wayne' if choose eq 1 then openr,1,'diskg:[merges]m236_new_cs.wayne' if choose eq 2 then openr,1,'diskg:[merges]m236_non_cs.wayne' a=assoc(1,fltarr(650)) f1beg=43952. & f2beg=36 f1end=43965. & f2end=29 fbeg=f1beg+(f2beg/60.) & fend=f1end+(f2end/60.) close,3 if choose eq 0 then openw,3,'sat_orig_ns.pds' if choose eq 1 then openw,3,'sat_new_cs_ns.pds' if choose eq 2 then openw,3,'sat_non_cs_ns.pds' f1=fltarr(5000) & f2=f1 & lat=f1 & lon=f1 ;estab arrays phas=f1 & mu=f1 & muo=f1 & sclat=f1 & sclon=f1 & rang=f1 f4=fltarr(5000) & f6=f4 & p4=f4 & p6=f6 s4=f4 & s6=f4 cc=3.1415926/180. ;convert deg to rad for Cosine m=0 loop: for i=0,4999 do begin t=a(i) tim=t(8)+(t(9)/60.) if (tim ge fbeg) and (tim le fend) then begin f1(m)=t(8) & f2(m)=t(9) & lat(m)=t(517) & lon(m)=t(518) rang(m)=t(516) & sclat(m)=t(512) & sclon(m)=t(513) mu(m)=cos(t(520)*cc) & muo(m)=cos(t(519)*cc) phas(m)=(180.-t(514)) f4(m)=t(621) & f6(m)=t(622) & p4(m)=t(623) & p6(m)=t(624) s4(m)=t(625) & s6(m)=t(626) & m=m+1 end end print,'completed at m=',m-1 for i=0,m-1 do begin ;write it out to table printf,3,'$(f7.0,f3.0,5f9.1,e15.7,8f7.4)',f1(i),f2(i),lat(i),$ lon(i),sclat(i),sclon(i),phas(i),rang(i),mu(i),muo(i),$ f4(i),p4(i),s4(i),f6(i),p6(i),s6(i) end close,3,1 stop & end sedr.com_11000066403252300000050000000001261026755544100130450ustar00ksimmons00005460002003LINK/EXE=Nav SEDR,SEDRHDR,SEDRNAV,SEDRPV,SEDRASC,PHASE,URNTEST, - [.vgr]IBMTOVAX.OJB sedr.for_45000066403252300000050000000221401026755544200130650ustar00ksimmons00005460002003C PROGRAM SEDR C UPDATED FOR URAN.ENC(APR-2-84) C UPDATED FOR ".FOR" APR-25-84 c non-reversed byte errors corrected Oct 23,85 cc Uranus Enc. program error detected/fixed Nov 26,85 Cc Neptune update June 7,1989>July 19,89 Cc Update for Lock star: SPICA for Nep June 20,90 C C A ROUTINE FOR READING VOYAGER SEDR TAPES C THE OUTPUT ARRAY CONTAINS THE FOLLOWING VALUES C C THE OUTPUT VALUES ARE FOUND IN COMMON ARRAYS FOR EACH TYPE C OF DATA: POINTING VECTOR, NAVIGATION VECTOR, S/C GEOMS C C THE POINTING VECTOR ARRAY (PV(30)) CONTAINS: C 1-SCE GMT YEAR R,YEARS AD C 2-SCE GMT DAY R,DAY OF YEAR C 3-SCE GMT HOUR R,HOUR OF DAY C 4-SCE GMT MINUTE R,MIN OF HOUR C 5-SCE GMT SECONDS R,SEC OF MIN C 6-SCE GMT MILLISECS R,MSEC OF SEC C 7-FDSC MOD16 COUNT R,BINARY COUNTS C 8-FCSC MOD60 COUNT R,BINARY COUNTS C 9-PITCH LIMIT CYCLE R,DEGS C 10-YAW LIMIT CYCLE R,DEGS C 11-ROLL LIMIT CYCLE R,DEGS C 12-14:CARTESIAN UNIT VECTOR OF S/C X-AXIS,S/C-CENTERED C EARTH MEAN ECLIPTIC 3R,DIM C 15-17:SAME Y-AXIS 3R, DIMENTIONLESS C 18-20:SAME Z-AXIS 3R, " C 21-CELESTIAL CLOCK OF HIGH GAIN R,DEG C 22-CONE OF HIGH GAIN R,DEG C 23-CLOCK OF PPS OPTIC AXIS, R C 24-CONE OF PPS OPTIC AXIS, R C 25-27:CARTESTIAN UNIT VECTOR OF PPS OPTIC AXIS, S/C C CENTERED 3R, DIM C 28-AZIMUTH OF NOMINAL PLATFORM R,DEGS C 29-ELEVATION " R,DEGS C 30-TELEM USE CODE (1=TEL,0=PREDICT) C C THE CONTENTS OF THE NAVIGATION VECTOR (NAV(50)): C 1-6:SAME TIMES AS ABOVE C 7-12:CARTESIAN STATE OF S/C, SUN CENTERED,EARTH C MEAN EC. 6R, KM AND KM/SEC C 13-18:SAME FOR EARTH 6R, " " C IF CRUISE FORMAT THEN GET: C 19-24:SAME FOR JUPITER 3R, " " C 25-30:SAME FOR SATURN C 31: ANGLE SUN-S/C-EARTH C 32: CELESTIAL CLOCK OF EARTH C IF JUPITER FORMAT THEN GET: C 25-30:CART. STATE OF S/C, EARTH CENTERED, (EMEC50) C 31-36:CARTESIAN STATE OF S/C, CENTRAL BODY CENTERED, EMEC C 37:RANGE,CENTRAL BODY TO S/C 1R, KM C 38-40:CARTESIAN STATE OF S/C,IO CENTERED, EMEC C 41-43: " " " , EUROPA CENTERED, EMEC C 44-46: " " " , GANYMEDE CENTERED, EMEC C 47-49: " " " , CALLISTO CENTERED, EMEC C IF SATURN FORMAT THEN GET: C 19-24:CART. STATE OF SATURN, SUN CENT.,EMEC50 C 25-30:CART. STATE OF S/C, EARTH CENTERED C 31-36: " " " ,SATURN CENTERED, EMEC50 C 37: RANGE, SATURN TO S/C C 38-43:CARTESIAN STATE OF S/C,TITAN CENTERED,EMEC50 C 44:TITAN TO S/C RANGE, KM C 45: TITAN SCATTERING PLANE ANGLE FROM "M" VECTOR C 46: CWH CHECK (SHOULD BE 0.) C 47: SATURN SCATERING PLANE ANGLE C 48: #47 CHECK VALUE C 49: SATURN PHASE ANGLE C 50: TITAN PHASE ANGLE C C IF XCRUISE (SATURN-URANUS CRUISE) FORMAT THEN GET: C 19-24:CART.STATE OF URANUS, SUN CENTERED, (EMEC50) C 25-30:CART.STATE OF S/C, EARTH CENTERED, (EMEC50) C 31-36:CART.STATE OF S/C, CENTRAL BODY CENT.-URANUS,(EMEC50) C 37-42:CART.STATE OF NEPTUNE, SUN CENTERED, (EMEC50) C 43: URANUS CELESTIAL CONE C 44: URANUS CELESTIAL CLOCK C 45: NEPTUNE CELESTIAL CONE C 46: NEPTUNE CELESTIAL CLOCK C 47: RANGE URANUS TO S/C C 48: RANGE NEPTUNE TO S/C C C IF URANUS ENCOUNTER FORMAT THEN GET: C 19-37: SAME AS ABOVE C 45: BODY SCATTERING PLANE ANGLE C 46: BODY CWH CHECK VALUE (OK=0) C 47: URANUS SCATTERING PLANE ANGLE C 48: CWH CHECK VALUE (OK=0) C 49: URANUS PHASE C IF Neptune ENCOUNTER FORMAT THEN GET: C 19-37: SAME AS ABOVE C 45: BODY SCATTERING PLANE ANGLE C 46: BODY CWH CHECK VALUE (OK=0) C 47: Neptune SCATTERING PLANE ANGLE C 48: CWH CHECK VALUE (OK=0) C 49: Neptune PHASE C COMMON NARR(4000) COMMON/COMPNT/PV(30) COMMON/COMNAV/ONAV(50) DIMENSION ARR(2000) DIMENSION TEMPE(3),TEMPS(3),TEMPB(3) LOGICAL*1 NAMDSK(10) LOGICAL*1 IARR(8000) INTEGER*2 CHAN,IOSB(4),LEN CHARACTER*4 NAMTAP INTEGER*4 SYS$QIOW,LIB$STOP,SYS$ASSIGN,IN_STATUS INCLUDE '($IODEF)' !MUST INCLUDE SYS.SERV. QIO CODES INCLUDE '($MTDEF)' ! AND TAPE I/O F(X)S INCLUDE '($SSDEF)' ! AND SYS.SERV. ERROR CODES EQUIVALENCE (NARR,ARR),(NARR,IARR) C DATA ICON/0/,LOC/0/,IROUT/0/ IR=0 CONST=180./3.141592654 WRITE(5,65) READ(5,5) NAMTAP 5 FORMAT(A) WRITE(5,95) READ(5,105) MM,(NAMDSK(JJ),JJ=1,MM) CALL ASSIGN(2,NAMDSK,MM) WRITE(5,145) READ(5,585) ISTAR WRITE(5,575) 575 FORMAT(' OUTPUT UNIT (I2):5=TI,6=LP,7=NONE') READ(5,585) IUN 585 FORMAT(I2) WRITE (5,585) IUN 100 CONTINUE C CALL ASSIGN(1,MT,N) C CALL QIO(IOSTC,1,1,,IOSB,IPARMS) C CALL GETADR(IPARMS,NARR) C CALL WAITFR(1) C IF(IOSB(1) .GT. 0) GO TO 300 IN_STATUS=SYS$ASSIGN(NAMTAP,CHAN,,) IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 300 STOP 'ERR100' 200 CONTINUE WRITE(5,205) READ(5,215) ISR IF(ISR .EQ. 0) GO TO 250 WRITE(5,245) READ(5,225) SDAY,SHR,SMIN WRITE(5,255) READ(5,225) EDAY,EHR,EMIN WRITE(5,235) SDAY,SHR,SMIN,EDAY,EHR,EMIN STARTT=0. STARTT=SDAY+(SHR/24.)+(SMIN/1440.) ENDT=EDAY+(EHR/24.)+(EMIN/1440.) 205 FORMAT(' WANT TO SKIP ANY RECORDS? (YES=1)') 215 FORMAT(I1) 225 FORMAT(3F10.7) 235 FORMAT(' DATA SUPPLIED AFTER SKIP TO DOY,HR,MIN:',3F10.1) 245 FORMAT(' SUPPLY START DAY OF YEAR,HR,MIN (3F10.7)') 255 FORMAT(' SUPPLY END DAY,HR,MIN') 250 CONTINUE C C NAV CODES: L=1,C=2,J=3,S=4,X=5,U=6 C IF(IUN .LT. 7) CALL SEDRHD(NAV,IUN) IF(IUN .EQ. 7) CALL SEDRHD(NAV,5) WRITE(5,135) NAV 135 FORMAT(' NAV CODE:',I5) C A PREDICT TAPE WILL NOT HAVE A POINTING VECTOR BLOCK WRITE(5,155) 155 FORMAT(' IS THIS A PREDICT TAPE? (Y=1)') READ(5,215) IPD ISCB=0 IF(IPD .EQ. 0) WRITE(5,275) 275 FORMAT(' WANT OBJECT BODY PHASE ANGLE CALC (Y=1)') IF(IPD .EQ. 0) READ(5,215) ISCB 300 CONTINUE IR=IR+1 C CALL QIO(IORVB,1,1,,IOSB,IPARMS) C CALL WAITFR(1) C IF(IOSB(1) .GT. 0) GO TO 320 IN_STATUS=SYS$QIOW( ,%VAL(CHAN),%VAL(IO$_READLBLK),IOSB, + ,,IARR,%VAL(8000),,,,) D WRITE(5,305) IR,IOSB 305 FORMAT(' PROCESSING INPUT RECORD',I5,' STATUS=',4I5) IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 320 WRITE(5,315) IOSB 315 FORMAT(' QIO ERROR AT 300; IOSB=',4I8) C DOES NOT PROCESS RECORDS WITH PARITY ERRORS GO TO 300 320 CONTINUE IF((IOSB(1) .NE. 1) .AND. (IOSB(2) .EQ. 0)) GO TO 7000 !EOF IF(IR .EQ. 1) GO TO 200 C ONLY NEED TO REVERSE BYTES WHEN DECODING DATA LEN=IOSB(2) C DO 340 JJ=1,LEN,2 !.FOR IBMTOVAX ASSUMES NO BYTES REVERSED C ITEMP=IARR(JJ+1) C IARR(JJ+1)=IARR(JJ) C340 IARR(JJ)=ITEMP IF(NAV .GT. 0) GO TO 350 IF(IUN .LT. 7) WRITE (IUN,45)NAV STOP 'NAV BAD' 350 CONTINUE IF(ICON .GT. 0) GO TO 370 DO 360 JJ=1,50 360 ONAV(JJ)=0. ICON=0 DO 366 JJ=1,24,2 !REVERSE BYTES FOR NAV TIME ITEMP=IARR(JJ+1) IARR(JJ+1)=IARR(JJ) 366 IARR(JJ)=ITEMP CALL SEDRNA(NAV,II,ISTAR,STARTT,TIME) !Get NAV values D WRITE(5,365) II 365 FORMAT(' NAV SUBR.,II=',I5) IF(TIME.GT.STARTT.AND.IUN.LT.7)WRITE(IUN,25) (ONAV(JJ),JJ=1,II) 370 LOC=127 cc if ICON=1 then reading a continuation pointing logical rec and cc the NAV logical does not appear in this rec...so check ICON last IF(NAV .EQ. 3) LOC=253 IF(NAV .EQ. 6) LOC=253 !J AND U HAVE LONG NAV BLOCKS IF(NAV .EQ. 7) LOC=253 !Nep too IF(ICON .EQ. 1) LOC=1 !start back at the beginning 400 CONTINUE D WRITE(5,405) ICON,LOC 405 FORMAT(' ICON,LOC=',2I5) IF(IPD .EQ. 1) GO TO 598 !No PV recs on Predict DO 390 JJ=1,32,2 !REVERSE PV TIME BYTES ITMP=(LOC-1)*4+JJ ITEMP=IARR(ITMP+1) IARR(ITMP+1)=IARR(ITMP) 390 IARR(ITMP)=ITEMP CALL SEDRPV(LOC,IJ,ICON,STARTT,TIMEP) !get PV values D WRITE(5,415) ICON,LOC 415 FORMAT(' P.V.SUB ICON,LOC=',2I5) C Test desired time limits: diagnostic only IF(TIMEP.GT.STARTT .AND.IUN.LT.7) WRITE(IUN,35) (PV(JJ),JJ=1,IJ) C READ(5,75) (PV(JJ),JJ=1,6) 75 FORMAT(6F7.1) C WRITE(IUN,35) (PV(JJ),JJ=1,IJ) GO TO 580 500 CONTINUE IF(IUN .LT. 7) WRITE(IUN,125) IERR STOP 'DISK WRITE ERROR' 580 CONTINUE IF(ISR .EQ. 0) GO TO 582 IF(TIME .LT. STARTT ) GO TO 600 !test for desired times IF(TIME .GT. ENDT) GO TO 7000 582 IF(NAV .EQ. 1) GO TO 598 !Cruise f/ts have no IF(NAV .EQ. 5) GO TO 598 !central body,no scat.plane C CALCULATE THE SCATTERING PLANE FOR OBSERVED BODY 584 DO 590 ITEMP=1,3 TEMPE(ITEMP)=ONAV(ITEMP+25-1) TEMPS(ITEMP)=ONAV(ITEMP+7-1) TEMPB(ITEMP)=-1.*PV(ITEMP+25-1) 590 CONTINUE IF(ISCB .EQ. 1) CALL SCAT(ISTAR,TEMPE,TEMPS,TEMPB,SCATA,CWH) ONAV(45)=SCATA ONAV(46)=CHW C ********************************* WRITE F/T 598 WRITE(2,ERR=500) ONAV,PV C ******************************************* IROUT=IROUT+1 600 CONTINUE IF(ICON .EQ. 0) GO TO 300 !No more Pointing in phy.rec LOC=LOC+126 !More, @logical=126 words IF((NAV .EQ. 6) .AND. (LOC .LE. 253)) GO TO 400 !Urn Case IF(LOC .GT. 252) GO TO 300 !More, read another phy.rec GO TO 400 7000 CONTINUE WRITE(5,85) IROUT STOP 'END OF JOB' C5 FORMAT(Q,4A1) 15 FORMAT(' ERROR CODE',I5,' ENCOUNTERED AT REC',I5, + ' OF LENGTH',I5) 25 FORMAT(' SEDR NAVIGATION DATA:',/,(5E15.7)) 35 FORMAT(' SEDR POINTING VECTOR DATA:',/,(5E15.7)) 45 FORMAT(' NAV VALUE BAD',I2) 55 FORMAT(' GEOM VALUES FROM SEDRX:',/,(5E20.7)) 65 FORMAT(' ENTER TAPE UNIT "MT4:" ') 85 FORMAT(' END OF INPUT TAPE, ',I10,' RECORDS WRITTEN') 95 FORMAT(' SUPPLY OUTPUT FILE NAME') 105 FORMAT(Q,10A1) 115 FORMAT(' FILE ASSIGN ERROR ') 125 FORMAT(' DISK WRITE ERROR #',I10) 145 FORMAT(' SUPPLY LOCK STAR:1=CANOP,2=VEGA,3=MIAP,4=PROCYON,', + ' 5=REGULUS,',/,17X,'6=DENEBOLA,7=ALIOTH,8=ALKAID,' + ' 9=ACKANER,10=FOMALHAUT',/,17X,'11=SPICA,12=ROLL+110') Cc + ' 9=ACKANER,10=FOMALHAUT',/,17X,'11=ROLL-60,12=ROLL+110') END C IF SATURN FORMAT THEN GET: C 19-24:CART. STATE OF SATURN, SUN CENT.,EMEC50 C 25-30:CART. STATE OF S/C, EARTH CENTERED C 31-36: " " " ,SATURN CENTERED, EMEC50 C 37: RANGE, SATURN TO S/C C 38-43:CARTESIAN STATE OF S/C,TITAN CENTERED,EMEC50 C 44:TITAN TO S/C RANGE, KM C 45: TITAN SCATTERING PLANE ANGLE FROM "M" VECTOR C 46: CWH CHECK (SHOULD BE 0.) C 47: SATURN SCATERING PLANE ANGLE C 48: #47 sedrasc.for_1000066403252300000050000000013071026755544300134670ustar00ksimmons00005460002003 SUBROUTINE ASCI(K,N,ICH) COMMON NARR(4000) LOGICAL*1 IARR(8000) C C K IS THE BYTE LOCATION TO BEGIN WITH C N IS THE NUMBER OF CHARACTERS C ICH IS ARRAY TO STORE DECODED CHARS. C EQUIVALENCE (NARR,IARR) LOGICAL*1 IASCI,IBCDIC,TABLE(64),ICH(N) DATA TABLE/1H ,1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI, 1 1H?,1H.,1H<,1H(,1H+,1H , 2 1H&,1HJ,1HK,1HL,1HM,1HN,1HO,1HP,1H ,1HR, 3 1H!,1H$,1H*,1H),1H;,1H , 4 1H-,1H/,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ, 5 1H ,1H,,1H%,1H_,1H>,1H?, 6 1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9, 7 1H:,1H#,1H@,1H',1H=,1H"/ L=K DO 100 J=1,N IBCDIC=IARR(L+J-1) I=IBCDIC .AND. "77 IASCI=TABLE(I+1) ICH(J)=IASCI 100 CONTINUE RETURN END sedrhdr.for_2000066403252300000050000000023131026755544400134760ustar00ksimmons00005460002003 SUBROUTINE SEDRHD(NAV,IUN) C APR 2,84 Cc Updated Jun 7,89 COMMON NARR(4000) LOGICAL*1 IARR(8000),ICH(16),I1,I2,I3,I4,I5,I6,I7 EQUIVALENCE (NARR,IARR) C C THIS ROUTINE FOR DECODEING YOYAGER (MJS) 9-TRACK C TAPE HEADER (=VOLUMN HEADER) AND CHECKING FOR RIGHT TAPE C IUN IS OUTPUT UNIT DEVICE C NAV RETURNS NAVIGATION DATA BLOCK F/T CODE:L=1,C=2,J=3,S=4,X=5 C U=6,N=7 DATA I1/1HL/,I2/1HC/,I3/1HJ/,I4/1HS/,I5/1HX/,I6/1HU/,I7/1HN/ CALL ASCI(1,8,ICH) WRITE(IUN,5) (ICH(JJ),JJ=1,8) 5 FORMAT(' PROJECT '4A1,' FILE TYPE:'4A1) IDSC=IARR(12) .AND. 7 IF(IDSC .GE. 4) GO TO 120 IDSC=IDSC+1 IF(IDSC .EQ. 2) WRITE(IUN,15) IF(IDSC .EQ. 1) WRITE(IUN,115) 115 FORMAT(' S/C IS VOYAGER 2') 15 FORMAT(' S/C IS VOYAGER 1') GO TO 130 120 IDSC=IDSC-3 WRITE(IUN,25) IDSC 25 FORMAT(' S/C IS SIMULATION UNIT:'I2) 130 CONTINUE CALL ASCI(13,8,ICH) WRITE(IUN,35) (ICH(JJ),JJ=1,8) 35 FORMAT(' SEDR TAPE ID:'10A1) CALL ASCI(53,8,ICH) NAV=0 IF(ICH(1) .EQ. I1) NAV=1 IF(ICH(1) .EQ. I2) NAV=2 IF(ICH(1) .EQ. I3) NAV=3 IF(ICH(1) .EQ. I4) NAV=4 IF(ICH(1) .EQ. I5) NAV=5 IF(ICH(1) .EQ. I6) NAV=6 IF(ICH(1) .EQ. I7) NAV=7 WRITE(IUN,45) ICH(1),NAV 45 FORMAT(' NAVIGATION F/T IS:'A8,' NAV. F/T CODE=',I2) END sedrnav.for_18000066403252300000050000000116771026755544500136120ustar00ksimmons00005460002003 SUBROUTINE SEDRNA(NTYPE,II,ISTAR,STARTT,CURREN) C ;APR 3,84 c added more comments Oct 24,85 COMMON IARR(4000) COMMON/COMNAV/ONAV(50) DIMENSION ARR(2000),TEMPE(3),TEMPS(3),TEMPB(3) EQUIVALENCE (IARR,ARR) C THIS ROUTINE FOR DECODING NAVIGATION DATA BLOCKS C FROM VOYAGER (MJS) 9-TRACK TAPES C NTYPE GIVES FORMAT TYPE (AS:L=1,C=2,J=3,S=4,X=5,U=6) C II IS NO. OF VALUES RETURNED IN COMMON ONAV ARRAY C I=1 C DO SIX WORDS OF TIME DO 100 KA=2,12,2 ONAV(I)=IARR(KA) I=I+1 100 CONTINUE C CHECK START TIME, IF BEFORE THEN RETURN CURREN=ONAV(2)+(ONAV(3)/24.)+(ONAV(4)/1400.) IF(CURREN .LT. STARTT) RETURN C NOW SIX VALUES FOR CARTESIAN STATE OF S/C, SUN CENTERED,EMEC50 CALL FP_IBMTOVAX(ARR(13),ONAV(7),6) I=I+6 IF(NTYPE .GT. 2) GO TO 500 !gt 1st cruise; =J or more CCRUISE FORMAT C NOW THREE, SIX WORD VECTORS OF CARTESIAN STATES (EMEC50) C OF: EARTH, JUPITER AND SATURN, ALL SUN CENTERED CALL FP_IBMTOVAX(ARR(31),ONAV(13),18) I=I+18 CALL FP_IBMTOVAX(ARR(57),ONAV(31),1) CALL FP_IBMTOVAX(ARR(65),ONAV(32),1) I=I+2 II=I-1 IF(I .GT. 50) WRITE(5,15) II RETURN 500 CONTINUE CJUPITER FORMAT !J = ntype=2 C NOW 1, SIX WORD VECTOR OF CARTESIAN STATE OF S/C, CENTRAL BODY C CENTERED, (E.M.EC 50) CALL FP_IBMTOVAX(ARR(19),ONAV(31),6) c CNOTE (3-28-84) THE NTYPE GT 3 APPAR. DID NOT WORK. IT SHOULD HAVE BEEN C GT 2 BUT THAT DID NOT WORK EITHER??? WILL LEAVE IT ALONE NOW C IF(NTYPE .GT. 3) GO TO 600 c IF(NTYPE .GT. 1) GO TO 600 !May 6,85 "c" out IF(NTYPE .GT. 3) GO TO 600 !5/6/85 this should be ok c !gt J; =S or more c C NOW TWO, SIX WORD VECTORS OF CARTESIAN STATES (EMEC 50) C OF: EARTH AND JUPITER, BOTH SUN CENTERED CALL FP_IBMTOVAX(ARR(49),ONAV(13),12) C STATE OF S/C, EARTH CENTERED, EMEC50 (3-28-84) FOR COMPLETENESS CALL FP_IBMTOVAX(ARR(7),ONAV(25),6) C NOW THE RANGE OF JUPITER TO S/C (KM) CALL FP_IBMTOVAX(ARR(176),ONAV(37),1) C NOW FOUR, 3 WORD VECTORS OF THE CARTESIAN STATE OF THE S/C, C CENTERED AT THE FOLLOWING SATELLITES: IO,EUR,GANY,CALL.; ALL EMEC CALL FP_IBMTOVAX(ARR(25),ONAV(38),3) CALL FP_IBMTOVAX(ARR(31),ONAV(41),3) CALL FP_IBMTOVAX(ARR(37),ONAV(44),3) CALL FP_IBMTOVAX(ARR(43),ONAV(47),3) II=I+19+12-1 RETURN 600 CONTINUE CSATURN FORMAT !S = ntype=3 C NOW TWO, SIX WORD VECTOR OF CARTESIAN STATES (EMEC50) C OF: EARTH SUN CENTERED ,AND SATURN, SUN CENTERED CALL FP_IBMTOVAX(ARR(31),ONAV(13),12) I=I+12 C SKIP ALREADY FILLED JUP POSN. C ONE SIX WORD VECTOR OF CART. STATE OF S/C, EARTH CENTERED,(EMEC50) CALL FP_IBMTOVAX(ARR(7),ONAV(25),6) c IF(NTYPE .EQ. 5) GO TO 800 !xcruise=5 IF(NTYPE .EQ. 6) GO TO 900 !uranus=6 C RANGE, SATURN TO S/C CALL FP_IBMTOVAX(ARR(83),ONAV(37),1) C 1-6 WORD VECTOR OF CART. STATE OF S/C, TITAN CENT.,(EMEC50) CALL FP_IBMTOVAX(ARR(25),ONAV(38),6) C AND RANGE TITAN TO S/C CALL FP_IBMTOVAX(ARR(84),ONAV(44),1) C...MOVE SCATTERING CALC. TO MAIN PROGRAM, TO USE P.VECT. DATA C...MAINTAIN THIS SUB. AS WAS AND OVERWRITE "BODY" SCATTERING ANGLE C TEMPE=EARTH, TEMPS=SUN, TEMPB=BODY C CALCULATE THE SCATTERING PLANE ANGLE FROM CHARLIE'S SUBR. C PRAMETERS ARE: 1ST=WHICH STAR:1=CAN,2=VEGA,3=MIAPL,4=PERC. C 2ND=INDEX FOR CART.STATE S/C, EARTH CENT C 3RD= " " " " ,SUN CENTERED C 4TH= " " " " , BODY CENTERED C 5TH=SCAT. ANGLE, 6TH=CWH CHECK VALUE DO 700 ITEMP=1,3 TEMPE(ITEMP)=ONAV(25+ITEMP-1) TEMPS(ITEMP)=ONAV(7+ITEMP-1) TEMPB(ITEMP)=ONAV(38+ITEMP-1) 700 CONTINUE C CALL SCAT(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) CALL URANUS(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) ONAV(45)=SA ONAV(46)=CH C NOW FOR SATURN SCATTERING ANGLE TEMPB(1)=ONAV(31) TEMPB(2)=ONAV(32) TEMPB(3)=ONAV(33) C CALL SCAT(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) CALL URANUS(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) ONAV(47)=SA ONAV(48)=CH C CALC. SATURN AND TITAN PHASE ANGLES PHAS=PHASE(31,7) PHAT=PHASE(38,7) ONAV(49)=PHAS ONAV(50)=PHAT II=I+26-1 II=50 RETURN 800 CONTINUE CXCRUISE FORMAT !X = ntype=5 C FOR THE SATURN-URANUS CRUISE C C NOW VECTOR FOR NEPTUNE CART.STATES,SUN CENT.,EMEC50 CALL FP_IBMTOVAX(ARR(43),ONAV(37),6) C URAN. CELES. CONE, THEN CLOCK CALL FP_IBMTOVAX(ARR(60),ONAV(43),1) CALL FP_IBMTOVAX(ARR(66),ONAV(44),1) C NEPT. CELEST. CONE, THEN CLOSK CALL FP_IBMTOVAX(ARR(63),ONAV(45),1) CALL FP_IBMTOVAX(ARR(67),ONAV(46),1) C URAN-TO-S/C RANGE, THEN NEPT-TO-S/C RANGE CALL FP_IBMTOVAX(ARR(52),ONAV(47),1) CALL FP_IBMTOVAX(ARR(53),ONAV(48),1) II=50 RETURN 900 CONTINUE C.URANUS FORMAT !U = ntype=6 C FOR THE URANUS ENCOUNTER C CART.STATE OF EARTH, SUN CENTERED, EMEC50; THEN UR, SUN CENT. CALL FP_IBMTOVAX(ARR(49),ONAV(13),12) C STATE OF S/C, EARTH CENTERED, EMEC50 CALL FP_IBMTOVAX(ARR(7),ONAV(25),6) C URANUS-S/C RANGE CALL FP_IBMTOVAX(ARR(153),ONAV(37),1) PHAU=PHASE(31,7) ONAV(49)=PHAU C CALC URANUS SCATTERING PLANE ANGLE DO 910 ITEMP=1,3 TEMPE(ITEMP)=ONAV(25+ITEMP-1) TEMPS(ITEMP)=ONAV(7+ITEMP-1) 910 TEMPB(ITEMP)=ONAV(31+ITEMP-1) C CALL SCAT(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) CALL URANUS(ISTAR,TEMPE,TEMPS,TEMPB,SA,CH) ONAV(47)=SA ONAV(48)=CH II=50 RETURN 15 FORMAT(' ONAV ARRAY INDEX HAS EXCEEDED SIZE=50, VALUE=',I5) END YPE .GT. 3) GO TO 600 !5/6/85 this should be ok c !gt J; =S sedro.com_7000066403252300000050000000001771026755544600131640ustar00ksimmons00005460002003$fort/NOI4 SEDR $fort/NOI4 SEDRHDR $fort/NOI4 SEDRNAV $fort/NOI4 SEDRPV $fort/NOI4 SEDRASC $fort/NOI4 PHASE $fort/NOI4 URNTEST sedrpv.for_15000066403252300000050000000034721026755544600134430ustar00ksimmons00005460002003 SUBROUTINE SEDRPV(KK,II,ICON,STARTT,CURREN) C FDSC CORRECTED SEPT 15, 1980 C EDITED NOV 16, 1981 C RE-COMMENTED 3-28-84 c non-reversed byte corr'tion Oct 23,85 COMMON IARR(4000) COMMON/COMPNT/PV(30) DIMENSION ARR(2000) EQUIVALENCE(IARR,ARR) C THIS ROUTINE FOR DECODING POINTING VECTOR DATA BLOCKS C FROM VOYAGER(MJS) SEDR 9-TRACK TAPES C KK=LOC. OF 1ST WORD OF ARRAY TO DECODE C RETURNS FULL P.V. DATA(INCLUDING CONT. BLOCKS) C IN COMMON WORDS PV (II IS NO. OF VALUES) C EACH P.V. BLOCK RETURNS 30 VALUES C (MAX. # BLOCKS/PHY.REC. SHOULD BE 2) C C CONTENTS OF PV C PV(1-6)=SCE GMT YEAR,DAY,HR,MIN,SEC,MSEC C PV(7-8)=32-BIT FDSC MOD16 AND MOD60 C PV(9-11)=LIMIT CYCLE PITCH,YAW,ROLL (DEGREES) C PV(12-20)=CARTESIAN UNIT VECTOR S/C X,Y,Z DIRECTIONS C PV(21-22)=CELESTIAL CLOCK AND CONE OF HIGH GAIN ANT.BORE.(DEG) C PV(23-24)=CELESTIAL CLOCK AND CONE OF PPS OPTIC AXIS (DEG) C PV(25-27)=CARTESIAN UNIT VECTOR OF PPS-S/C CENTERED C PV(28-29)="NOMINAL PLATFORM" AZIM,ELEV (DEG) ="COMMANDED" C PV(30)=TELEMETRY USE CODE (1=ACTUAL TELE,0=PREDICT) C K=KK I=1 ICON=0 100 CONTINUE IF(I .GE. 30) GO TO 200 DO 110 KA=2,16,2 PV(I)=IARR(K*2+KA-2) I=I+1 110 CONTINUE CURREN=PV(2)+(PV(3)/24.)+(PV(4)/1440.) IF(CURREN .LT. STARTT) RETURN C CHECK CONTINUATION FLAG c IFLAG=IARR(K*2+200).AND. 1 !when bytes reversed IFLAG=(IARR(K*2+200) .AND. "400) !non-reversed IFLAG=IFLAG/256 !non-reversed CALL FP_IBMTOVAX(ARR(K+8),PV(I),12) !i=9,20 I=I+12 CALL FP_IBMTOVAX(ARR(K+75),PV(I),2) !i=21,22 I=I+2 CALL FP_IBMTOVAX(ARR(K+80),PV(I),5) !i=23,27 I=I+5 CALL FP_IBMTOVAX(ARR(K+101),PV(I),3) !i=28-30 I=I+3 IF(IFLAG .GT. 1) WRITE(5,5) IFLAG II=I-1 IF(IFLAG .EQ. 1) ICON=1 RETURN 200 CONTINUE WRITE(5,15) RETURN 5 FORMAT(' PV CONTINUE FLAG ERROR, VALUE=',I10) 15 FORMAT(' PV ARRAY INDEX ABOUT TO EXCEED SIZE OF 30,RETURNED') END setdef.com_68000066403252300000050000000033711032256174200133740ustar00ksimmons00005460002003$ VERIFY_SAVE='F$VERIFY("NO") $ $! ALI BAHRAMI 6-27-83 $! setdef sets the user's default to the location specified by P1. If P1 is $! null, setdef shows the current default. The user is free to drop the [] $! brackets. If P2 is non-null, a full directory is generated. $ $ OLD_DEF = F$LOGICAL("SYS$DISK")+F$DIRECTORY() $ $ IF "''P1'" .EQS. "" THEN GOTO SHOW_DEF ! Null spec $! The above also keeps the logical test below from bombing out $ IF F$LENGTH(P1) .NES. F$LOCATE(":",P1) THEN GOTO TRY_IT ! Direct spec $ IF F$LENGTH(P1) .NES. F$LOCATE("[",P1) THEN GOTO TRY_IT ! Direct spec $ TEMP = F$LOGICAL("''P1'") ! Logical won't work on null string $ IF "''TEMP'" .NES. "" THEN GOTO TRY_IT ! Logical $ ADD_BRACKETS: P1="[" + "''P1'" + "]" ! Add brackets $ $ TRY_IT: $ SET MESSAGE/NOTEXT/NOFAC/NOID/NOSEV ! Shuts off error message text $ ON WARNING THEN GOTO BAD_DIR ! Handles bad directory specifications $ SET DEF 'P1' $ ON ERROR THEN GOTO NO_DIR ! Handles non-existant directories $ IF "''P2'" .EQS. "" THEN GOTO ABREV_DIR $ WRITE SYS$OUTPUT " " $ DIR $ WRITE SYS$OUTPUT " " $ GOTO FINISH $ $ ABREV_DIR: $ NEW_DEF = F$LOGICAL("SYS$DISK")+F$DIRECTORY() $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT "Directory ''NEW_DEF'" $ DIRECTORY/TOTAL/NOHEAD/SIZE=ALL $ GOTO FINISH $ $ SHOW_DEF: $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT "Directory ''OLD_DEF'" $ WRITE SYS$OUTPUT " " $ GOTO FINISH $ $ BAD_DIR: $ WRITE SYS$OUTPUT "Invalid directory spec, Default remains: ",OLD_DEF $ GOTO FINISH $ $ NO_DIR: $ WRITE SYS$OUTPUT "Directory not found, Default returned to: ",OLD_DEF $ SET DEF 'OLD_DEF' $ $ FINISH: $ WRITE SYS$OUTPUT " " $ SET MESSAGE/TEXT/FAC/ID/SEV $ IF VERIFY_SAVE THEN SET VERIFY star_load.pro_5000066403252300000050000000006261026755545600140400ustar00ksimmons00005460002003; PRO LOAD,F4A6,F6A6,F6A7,F4A7,IBEG,IEND ;Loads LUT values from Calfile ; ;July 19, 1989 KES READ,'SUPPLY IBEG,IEND',IBEG,IEND NPTS=IEND-IBEG+1 F4A6=FLTARR(NPTS) & F6A6=F4A6 & F6A7=F4A6 & F4A7=F4A6 ; ;Assume input=unit 1 A=ASSOC(1,FLTARR(100)) ;stnd Star_cal.dat f/t FOR I=IBEG,IEND DO BEGIN T=A(I) F4A6(I)=T(80) & F6A6(I)=T(81) F6A7(I)=T(82) & F4A7(I)=T(83) END ; RETURN END starcal.pro_2000066403252300000050000000007601026755545400135130ustar00ksimmons00005460002003 PRO STARCAL,OUT,DATA,BEST,BESSIG,NUMBES,FDS ;JUN 21, 83 ; Edited July 19,89 KES ; A ROUTINE TO ASSEMBLE A OUTPUT ARRAY TO FACILITATE STARCAL ; PROCESSING. OUT=FLTARR(100) INSERT,OUT,EXTRACT(DATA,0,80),0 ;PUT EACH PT IN INSERT,OUT,BEST,80 ;BEST AVGS INSERT,OUT,BESSIG,85 ;THE BEST AVG. SIGMAS INSERT,OUT,NUMBES,90 ;THE NUMB.VALS IN EA.BEST ; INSERT,OUT,EXTRACT(FDS,0,2),95 ;PUT IN FDS OF FRAME START INSERT,OUT,EXTRACT(FDS,0,3),95 ;7/19 Don't recall why I had 2 RETURN & END stat.for_4000066403252300000050000000014051026755545700130250ustar00ksimmons00005460002003 SUBROUTINE STAT(LEN,IFLG) COMMON NARR(1280),IHDR(80),IST(6,80) C C A PROGRAM TO MASK OUT STATUS VALUES C IST(1,I)=FILTER C 2 =ANALYZER C 3 =OVERFLOW FLAG C 4 =J MODE FLAG C 5 = SOLAR SENSOR C 6 =HIGH VOLTAGE ON/OFF FLAG C LEN=LENGTH OF DATA CONTENTS C IFLG=FLAG FOR ALL ZERO VALUES C IFLG=0 C.FTN ISUM=0 ...HAD TO CHANGE TO F.P. FOR NEW .FOR VERSION??? SUM=0. DO 100 I=1,LEN SUM=SUM+NARR(I) 100 CONTINUE IF(SUM .NE. 0.) GO TO 200 IFLG=1 RETURN 200 CONTINUE DO 300 I=1,LEN ITEMP=NARR(I) IFL=ITEMP .AND. "1600 IST(1,I)=IFL/128 IAN=ITEMP .AND. "160 IST(2,I)=IAN/16 IOF=ITEMP .AND. "10 IST(3,I)=IOF/8 JMODE=ITEMP .AND. 4 IST(4,I)=JMODE/4 ISOLS=ITEMP .AND. 2 IST(5,I)=ISOLS/2 IST(6,I)=ITEMP .AND. 1 300 CONTINUE RETURN END store.pro_5000066403252300000050000000005111026755546000132100ustar00ksimmons00005460002003PRO STORE,XT,YT,XV,YAR,K,IDENT,ID ;AUG 18,83 AVG=0. & C=0. FOR I=!LO,!HI DO BEGIN TEMP=YAR(I) & IF TEMP LE 0. THEN GOTO,AROU AVG=AVG+TEMP & C=C+1. AROU: DUM=0 END IF C GT 0. THEN AVG=AVG/C ;EDITED 10/4/84 ;IF YAR(!LO) LT !YMIN THEN RETURN IF AVG LT !YMIN THEN RETURN XT(K)=XV & YT(K)=AVG & K=K+1 IDENT(K-1)=ID RETURN & END store_barth_ha.pro_8000066403252300000050000000026521032256262700150460ustar00ksimmons00005460002003; pro stor,nav,m ;Dec 19,89 KES ; stores Voyager Nav data into assoc arrays for analysis with SME ; H-a data (for use by Dr. Barth) ; NAV contains the 120 point (H-a special case) SEDR nav array ; M = index pointing to next place to store values nav=fltarr(120) & p=fltarr(30) m=0 nd=365 ;number of days in 1982 fil=' ' cart_state_x=fltarr(nd) ;Cart. state of s/c, sun cart_state_y=fltarr(nd) ; centered, EM Ecliptic cart_state_z=fltarr(nd) ; and Equinox of 1950 ra_sun=fltarr(nd) ;RA/DEC of s/c, Sun centered,Sun dec_sun=fltarr(nd) ; true equinox and Equat.of date date=fltarr(nd) ;decimal days of 1982 ; Store values into arrays start: read,' Input file name',fil openr,1,fil+'/unf' forrd,1,nav,p ;read navig. record for i=1,nd do begin ;main loop for each day loop: if nav(1) eq i then begin cart_state_x(m)=nav(12) cart_state_y(m)=nav(13) cart_state_z(m)=nav(14) ra_sun(m)=nav(98) dec_sun(m)=nav(99) day=nav(1) & hr=nav(2) & rmin=nav(3) & sec=nav(4) temp=(rmin+(sec/60.))/60. temp2=(hr+temp)/24. date(m)=day+temp2 m=m+1 ENDIF ELSE BEGIN forrd,1,nav,p goto,loop endelse end ; Update file records openw,3,'vgr2_barth_ha.dat',365*4 a=assoc(3,fltarr(365)) ;one value per day of yr a(0)=cart_state_x a(1)=cart_state_y a(2)=cart_state_z a(3)=ra_sun a(4)=dec_sun a(5)=date close,3 print,'file VGR2_BARTH_HA.DAT, recs=',m end taptest.com_1000066403252300000050000000000371026755546400135210ustar00ksimmons00005460002003fort/noi4 taptest link taptest taptest.for_12000066403252300000050000000060261026755546600136210ustar00ksimmons00005460002003cc Program Taptest cc Updated for Vax/VMS Fortran July 15,87, Corrected Oct 9, 1987 cc INTEGER IPARMS(6),ARR(16000),JOSB(2) LOGICAL*1 IARR(32000) CHARACTER*4 MT !TapeMount INTEGER*2 CHAN,IOSB(4) !Input channel&status EQUIVALENCE (ARR,IARR) c INTEGER*4 SYS$QIOW,LIB$STOP,SYS$ASSIGN,IN_STATUS INCLUDE '($IODEF)' !MUST INCLUDE SYS.SERV. QIO CODES INCLUDE '($MTDEF)' ! AND TAPE I/O F(X)S INCLUDE '($SSDEF)' ! AND SYS.SERV. ERROR CODES c NF=1 !keep # files read WRITE(5,5) 5 FORMAT(' SUPPLY MT1:') READ(5,15) MT 15 FORMAT(A) IN_STATUS=SYS$ASSIGN(MT,CHAN,,) !assign tape to channel# IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 10 STOP 'ERR100' c 10 WRITE(5,25) 25 FORMAT(' Output on File:FOR002.DAT') cc Use a default output file: FOR002.dat WRITE(5,35) 35 FORMAT(' WANT SUMMARY(=0), OR FULL DUMP(=1)') READ(5,45) IFLAG !summary vs full flag 45 FORMAT(I1) !summary gives all recs IF(IFLAG .EQ. 0) GO TO 50 !go around for summary WRITE(5,455) 455 FORMAT(' WANT ALL RECS(=0), ENG ONLY(=1),DATA ONLY(=2)') READ(5,45) IWHIC !which rec types WRITE(5,465) 465 FORMAT(' WANT 16-BIT WORDS(=0) OR BYTES(=1)') READ(5,45) LBYTE !bytes or words WRITE(5,475) 475 FORMAT(' WANT OCTAL(=0) OR HEX(=1)') READ(5,45) IFMT !format of output 50 WRITE(5,55) 55 FORMAT(' SUPPLY # FILES(I1)') READ(5,45) NOF !number of files IF(IFLAG .EQ. 1) WRITE(5,65) 65 FORMAT(' SUPPLY # RECORDS TO DUMP(I3)') NR=0 !desired # records IF(IFLAG .EQ. 1) READ(5,75) NR 75 FORMAT(I3) WRITE(5,85) NR 85 FORMAT(' PRINT',I4,' RECORDS FOR EACH FILE') IUNIT=2 cc IR=1 !COUNT NO. OF INPUT RECS 20 continue IN_STATUS=SYS$QIOW( ,%VAL(CHAN),%VAL(IO$_READLBLK),IOSB, + ,,IARR,%VAL(32000),,,,) D WRITE(5,305) IR,IOSB 305 FORMAT(' PROCESSING INPUT RECORD',I5,' STATUS=',4I5) IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 310 WRITE(5,315) IOSB 315 FORMAT(' QIO ERROR AT 300; IOSB=',4I8) 310 CONTINUE C DOES NOT PROCESS RECORDS WITH PARITY ERRORS IF ((IOSB(1) .NE. 1) .AND. (IOSB(2) .EQ. 0)) go to 312 go to 30 312 NF=NF+1 !eof IF(NF .EQ. NOF+1) go to 500 IR=1 go to 20 30 INU=IOSB(2) DO 40 JJ=1,INU,2 IHOLD=IARR(JJ+1) IARR(JJ+1)=IARR(JJ) 40 IARR(JJ)=IHOLD INU=IOSB(2) INU=IOSB(2)/2 IF(IR .GT. NR) GO TO 80 WRITE(IUNIT,125)INU,IR,NF IF(IFLAG .EQ. 1) GO TO 60 GO TO 80 60 IF (IWHIC .EQ. 0) GO TO 70 IF (IWHIC .EQ. 1 .AND. INU .EQ. 1930) GO TO 70 IF (IWHIC .EQ. 2 .AND. INU .EQ. 1270) GO TO 70 GO TO 80 70 IF(LBYTE .EQ. 1) GO TO 76 !goto 76 for bytes,stay for words IF (IFMT .EQ. 0) WRITE(IUNIT,105) (ARR(I),I=1,INU) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,1055) (ARR(I),I=1,INU) !hex GO TO 80 76 IF (IFMT .EQ. 0) WRITE(IUNIT,205) (IARR(I),I=1,INU*2) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,2055) (IARR(I),I=1,INU*2) !hex 80 IF(NF .EQ. NOF+1) STOP IR=IR+1 GO TO 20 500 continue write(iunit,135) nf,ir,iosb(1),iosb(2) write(5,135) nf,ir,iosb(1),iosb(2) stop 105 FORMAT(1X,(10O8)) 1055 FORMAT(10(1X,Z6)) 205 FORMAT(1X,(20O4)) 2055 FORMAT(20(1X,Z2)) 125 FORMAT('0',I5,' WORDS IN REC.'I5,' FILE',I5) 135 FORMAT(' TAPE ERROR DECTECTED; FILE,REC,ERR=',4I7) END taptest.for_14000066403252300000050000000061761026531611100136050ustar00ksimmons00005460002003cc Program Taptest cc Updated for Vax/VMS Fortran July 15,87, Corrected Oct 9, 1987 cc INTEGER IPARMS(6),ARR(16000),JOSB(2) LOGICAL*1 IARR(32000) CHARACTER*4 MT !TapeMount INTEGER*2 CHAN,IOSB(4) !Input channel&status EQUIVALENCE (ARR,IARR) c INTEGER*4 SYS$QIOW,LIB$STOP,SYS$ASSIGN,IN_STATUS INCLUDE '($IODEF)' !MUST INCLUDE SYS.SERV. QIO CODES INCLUDE '($MTDEF)' ! AND TAPE I/O F(X)S INCLUDE '($SSDEF)' ! AND SYS.SERV. ERROR CODES c NF=1 !keep # files read WRITE(5,5) 5 FORMAT(' SUPPLY MT1:') READ(5,15) MT 15 FORMAT(A) IN_STATUS=SYS$ASSIGN(MT,CHAN,,) !assign tape to channel# IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 10 STOP 'ERR100' c 10 WRITE(5,25) 25 FORMAT(' Output on File:FOR002.DAT') cc Use a default output file: FOR002.dat WRITE(5,35) 35 FORMAT(' WANT SUMMARY(=0), OR FULL DUMP(=1)') READ(5,45) IFLAG !summary vs full flag 45 FORMAT(I1) !summary gives all recs IF(IFLAG .EQ. 0) GO TO 50 !go around for summary WRITE(5,455) 455 FORMAT(' WANT ALL RECS(=0), ENG ONLY(=1),DATA ONLY(=2)') READ(5,45) IWHIC !which rec types WRITE(5,465) 465 FORMAT(' WANT 16-BIT WORDS(=0) OR BYTES(=1)') READ(5,45) LBYTE !bytes or words WRITE(5,475) 475 FORMAT(' WANT OCTAL(=0) OR HEX(=1)') READ(5,45) IFMT !format of output 50 WRITE(5,55) 55 FORMAT(' SUPPLY # FILES(I1)') READ(5,45) NOF !number of files IF(IFLAG .EQ. 1) WRITE(5,65) 65 FORMAT(' SUPPLY # RECORDS TO DUMP(I3)') NR=0 !desired # records IF(IFLAG .EQ. 1) READ(5,75) NR 75 FORMAT(I3) WRITE(5,85) NR 85 FORMAT(' PRINT',I4,' RECORDS FOR EACH FILE') IUNIT=2 cc IR=1 !COUNT NO. OF INPUT RECS 20 continue IN_STATUS=SYS$QIOW( ,%VAL(CHAN),%VAL(IO$_READLBLK),IOSB, + ,,IARR,%VAL(32000),,,,) D WRITE(5,305) IR,IOSB 305 FORMAT(' PROCESSING INPUT RECORD',I5,' STATUS=',4I5) IF(IN_STATUS .EQ. SS$_NORMAL) GO TO 310 WRITE(5,315) IOSB WRITE(iunit,315) IOSB 315 FORMAT(' QIO ERROR AT 300; IOSB=',4I8) 310 CONTINUE C DOES NOT PROCESS RECORDS WITH PARITY ERRORS IF ((IOSB(1) .NE. 1) .AND. (IOSB(2) .EQ. 0)) go to 312 go to 30 312 write(5,313) ir,nf write(iunit,313) ir,nf 313 format(i5,' records in file',i5) NF=NF+1 !eof IF(NF .EQ. NOF+1) go to 500 IR=1 go to 20 30 INU=IOSB(2) DO 40 JJ=1,INU,2 IHOLD=IARR(JJ+1) IARR(JJ+1)=IARR(JJ) 40 IARR(JJ)=IHOLD INU=IOSB(2) INU=IOSB(2)/2 IF(IR .GT. NR) GO TO 80 WRITE(IUNIT,125)INU,IR,NF IF(IFLAG .EQ. 1) GO TO 60 GO TO 80 60 IF (IWHIC .EQ. 0) GO TO 70 IF (IWHIC .EQ. 1 .AND. INU .EQ. 1930) GO TO 70 IF (IWHIC .EQ. 2 .AND. INU .EQ. 1270) GO TO 70 GO TO 80 70 IF(LBYTE .EQ. 1) GO TO 76 !goto 76 for bytes,stay for words IF (IFMT .EQ. 0) WRITE(IUNIT,105) (ARR(I),I=1,INU) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,1055) (ARR(I),I=1,INU) !hex GO TO 80 76 IF (IFMT .EQ. 0) WRITE(IUNIT,205) (IARR(I),I=1,INU*2) !octal IF (IFMT .EQ. 1) WRITE(IUNIT,2055) (IARR(I),I=1,INU*2) !hex 80 IF(NF .EQ. NOF+1) STOP IR=IR+1 GO TO 20 500 continue write(iunit,135) nf,ir,iosb(1),iosb(2) write(5,135) nf,ir,iosb(1),iosb(2) stop 105 FORMAT(1X,(10O8)) 1055 FORMAT(10(1X,Z6)) 205 FORMAT(1X,(20O4)) 2055 FORMAT(20(1X,Z2)) 125 FORMAT('0',I5,' WORDS IN REC.'I5,' FILE',I5) 135 FORMAT(' TAPE ERROR DECTECTED; FILE,REC,ERR=',4I7) END urntest.for_31000066403252300000050000000107731026531617000136270ustar00ksimmons00005460002003 SUBROUTINE URANUS(ISTAR,EARTH,SUN,URAN,PSI,CWH) !APR25 C APR 25,84 CONVERT TO A SUBR. AND INSERT IN SEDR IN PLACE OF SCAT. C PROGRAM URANUS TEST APR 24,84 KES C TO TEST THE SCATTERING PLANE ANGLE (PSI) VS A RANGE OF (RA,DEC) C Cc Updated lock star list for SPICA for Nept June 20,'90 DIMENSION STARUV(3),EARTH(3),SUN(3),URAN(3) C C START BY CALC. OF STAR UNIT VECTOR CALL LOCKSTAR(ISTAR,STARUV) CALL SCAT(STARUV,EARTH,SUN,URAN,PSI,CWH) RETURN END SUBROUTINE LOCKSTAR (ISTAR,STARUV) DIMENSION P(3),STARUV(3) DIMENSION RA(20),DEC(20) CONST=3.141592654/180. CON2=360./24. OBLIQ=23.44*CONST !ANGLE OF OBLIQUITY=TILT C C ALL RA,DEC PAIRS ARE 1950 UNLESS OTHERWISE STATED RA(1)=6.+(23.5/60.) !CANOPUS=1 DEC(1)=-52.-(41./60.) RA(2)=18.+35.2/60. !VEGA=2 DEC(2)=38.+44./60. RA(3)=9.+13./60. !MIAP=3 DEC(3)=-69.-38./60. !NOT 1950 RA(4)=7.+36.7/60. !PROCYON=4 DEC(4)=5.+21./60. RA(5)=10.+5.7/60. !REGULUS=5 DEC(5)=12.+14./60. RA(6)=11.+48./60. !DENOBELA=6 DEC(6)=14.+41./60. !NOT 1950 RA(7)=12.+53.2/60. !ALIOTH=7 DEC(7)=56.+4./60. !NO 1950 RA(8)=13.+46.8/60. !ALKAID=8 DEC(8)=49.+25./60. !NOT 1950 cc RA(9)=20.+39.7/60. cc!DENEB=9 cc DEC(9)=45.+6./60. cc RA(9)=1.+35.85/60. !Ackanar=9 DEC(9)=-57-29.41/60. RA(10)=22.+54.9/60. !FOMALHAUT DEC(10)=-29.-(53./60.) RA(11)=200.65 !SPICA for Neptune DEC(11)=-10.9 Cc RA(11)=150. !ROLL = -60. Cc DEC(11)=-12.9 RA(12)=358. !ROLL = +110. DEC(12)=14.4 C IF(ISTAR .LT. 14) GO TO 200 WRITE(5,5) ISTAR !ERROR CONDITION 5 FORMAT(' LOCK STAR ERROR ON VALUE=',I5) RETURN 200 CONTINUE RDEC=(90.-DEC(ISTAR))*CONST RRA=RA(ISTAR)*CON2*CONST P(1)=1. P(2)=RRA !PHI=RA P(3)=RDEC !THETA=90-DEC CALL SC(P,STARUV) !SPHER TO CART.UNIT.VECT. CALL ROTX(OBLIQ,STARUV) !ROTATE AROUND X=E=ANG.OBLIQ. RETURN END C SUBROUTINE SC(P,X) !SPHERE TO CART. (CWH) DIMENSION P(3),X(3) !P COMES IN, X OUT A=SIN(P(3)) X(1)=P(1)*A*COS(P(2)) X(2)=P(1)*A*SIN(P(2)) X(3)=P(1)*COS(P(3)) RETURN END C SUBROUTINE CROSS(X,Y,Z) !CROSS PRODUCT (KES) DIMENSION X(3),Y(3),Z(3) Z(1)=X(2)*Y(3)-X(3)*Y(2) Z(2)=X(3)*Y(1)-X(1)*Y(3) Z(3)=X(1)*Y(2)-X(2)*Y(1) RETURN END C FUNCTION DOT(X,Y) DIMENSION X(3),Y(3) DOT=X(1)*Y(1)+X(2)*Y(2)+X(3)*Y(3) RETURN END C SUBROUTINE VNORM(RIN,ROUT) !VECTOR NORMALIZATION DIMENSION RIN(3),ROUT(3) A=RIN(1)*RIN(1) B=RIN(2)*RIN(2) C=RIN(3)*RIN(3) ST=SQRT(A+B+C) SS=ST IF(SS .NE. 0.) SS=1./SS ROUT(1)=RIN(1)*SS ROUT(2)=RIN(2)*SS ROUT(3)=RIN(3)*SS RETURN END C SUBROUTINE CS(X,P) DIMENSION X(3),P(3) PI=3.141592654 P(1)=SQRT(X(1)**2+X(2)**2+X(3)**2) Y=SQRT(X(1)**2+X(2)**2) IF (X(3)) 4,2,4 2 CONTINUE P(3)=PI/2. GO TO 10 4 CONTINUE TMP=X(3) IF(TMP .NE. 0.) TMP=1./TMP P(3)=ATAN(Y*TMP) IF(X(3) .GT. 0.) GO TO 10 P(3)=P(3)+PI 10 CONTINUE TMP=X(1) IF(TMP .NE. 0.) TMP=1./TMP P(2)=ATAN(X(2)*TMP) IF(X(1) .GT. 0.) GO TO 20 P(2)=P(2)+PI 20 CONTINUE RETURN END SUBROUTINE ROTX(T,X) DIMENSION X(3) A=COS(T) B=SIN(T) C=X(2)*A+X(3)*B X(3)=-X(2)*B+X(3)*A X(2)=C RETURN END C SUBROUTINE ROTZ(P,X) DIMENSION X(3) A=COS(P) B=SIN(P) C=X(1)*A+X(2)*B X(2)=-X(1)*B+X(2)*A X(1)=C RETURN END C SUBROUTINE SCAT(STAR,EARTH,SUN,BODY,SA,CWH) C APR 24, 84 C EDITED FOR URANUS TEST PROGRAM C VOYAGER ROUTINE TO CALC. SCATTERING PLANE FROM STATE VECTORS C SA=SCATTERING ANGLE, IN DEGREES, UP FROM 'M' VECTOR C CWH=CHECK, SHOULD BE ZERO C C EARTH,SUN,BODY ARE VECTORS FOR: C EARTH IS CART. STATE OF S/C, EARTH CENTERED, EMEC50 C SUN IS CART. STATE OF S/C, SUN CENTERED, EMEC50 C BODY IS CART. STATE OF S/C, URANUS CENTERED, EMEC50 C C DIMENSION C(3),SP(3),X(3),T(3),V789(3),V1345(3),V2567(3) DIMENSION E(3),EA(3),STAR(3),EARTH(3),SUN(3),BODY(3) DATA PI/3.141592654/ DO 100 I=1,3 C(I)=STAR(I) V789(I)=-1.*EARTH(I) V1345(I)=-1.*SUN(I) V2567(I)=-1.*BODY(I) 100 CONTINUE PI2=PI/2. CALL CROSS(V2567,V1345,SP) CALL VNORM(SP,X) CALL VNORM(V2567,T) CALL VNORM(V789,E) CALL CS(E,EA) DO 120 I=1,3 SP(I)=X(I) 120 X(I)=C(I) CALL ROTZ(EA(2)-PI2,X) CALL ROTX(-EA(3),X) CALL CS(X,E) X(1)=E(1) X(2)=E(2) X(3)=E(3) P2=X(2) X(1)=SP(1) X(2)=SP(2) X(3)=SP(3) DO 200 N=1,2 CALL ROTZ(EA(2)-PI2,X) CALL ROTX(-1.*EA(3),X) CALL ROTZ(P2,X) CALL ROTX(PI,X) CALL ROTZ(55.*PI/180.,X) CALL ROTX(173.*PI/180.,X) CALL ROTZ(PI2,X) C SP IS IN AZ/EL SYSTEM IF(N .EQ. 2) GO TO 200 DO 140 I=1,3 SP(I)=X(I) X(I)=T(I) 140 CONTINUE 200 CONTINUE T(1)=X(1) T(2)=X(2) T(3)=X(3) CALL CS(T,X) CALL ROTZ(X(2)-PI2,SP) CALL ROTX(-X(3),SP) CALL ROTZ(PI2,SP) SP(2)=-SP(2) CALL CS(SP,X) SA=X(2)*180./PI - 45. CWH=X(3) RETURN END vgr_finone.pro_1000066403252300000050000000007211032252534400141750ustar00ksimmons00005460002003opern,1,'finone openr,1,'finone a=assoc(1,fltarr(1024)) t=a(0) print,t(0:10) ; 8.0000 9.0000 9.6000 5.4000 7.8000 7.4000 ; 8.0000 6.4000 7.6000 8.6000 5.6000 .run fovpic fov=fltarr(128,128) .run for i=0,17 do begin fovpic,a(96+i*2),a(95+i*2),a(i)*a(i)*254./9.e6,1024,fov,.005,1,0 end & end tvimag,fov tv,fov imag,fov $ plot,extract(fov,0,56,128,1) for i=0,3 do oplot,extract(fov,0,56+i,128,1) erase vgr_uvs_inst_structure.pro000075503252300000050000000101640647441565300165120ustar00ksimmons00005460002003; ------------------------------------------------ ; UVS RDR Version 1.0 structure definition for IDL ; October 1, 1996 ; ------------------------------------------------ spec = { uvs,$ ; FDS Count and Time fds:0.0,$ ; FDS count spno:0,$ ; Spectrum Number scid:0,$ ; Space Craft ID data_mode:0,$ ; Data mode scet_yr:0,$ ; Space Craft Event Time (YEAR) scet_day:0,$ ; Space Craft Event Time (DAY) scet_hr:0,$ ; Space Craft Event Time (HOUR) scet_min:0,$ ; Space Craft Event Time (MIN) scet_sec:0,$ ; Space Craft Event Time (SEC) scet_ms:0,$ ; Space Craft Event Time (MS) ; History fpn:0,$ ; FPN spectrum number cal:0,$ ; CAL spectrum number scat:0,$ ; SCAT matrix number ; counting mode and HV level counting_mode:0,$ ; Counting mode hv:0,$ ; High Voltage Level ; integration time and scale factor dt:0.0,$ ; Integration time scale:0.0,$ ; Scale Factor ; UVS original pointing ag_az:0.0,$ ; Air-Glow Azimuth ag_el:0.0,$ ; Air-Glow Elevation ag_ra:0.0,$ ; Air-Glow Right-Ascension ag_dec:0.0,$ ; Air-Glow Declination occ_ra:0.0,$ ; Occultation Right-Ascension occ_dec:0.0,$ ; Occultation Declination dl:FLTARR(5),$ ; Delta L [5 values] dw:FLTARR(5),$ ; Delta W [5 values] rot:FLTARR(4),$ ; Rotation matrix [A,B,C,D] sun_ra:0.0,$ ; Sun Right-Ascension sun_dec:0.0,$ ; Sun Declination pba:0.0,$ ; Pitch Bias Angle yba:0.0,$ ; Yaw Bias Angle ; footprint pb_id:0,$ ; Picture Body ID cb_id:0,$ ; Central Body ID sc_cb:FLTARR(3),$ ; S/C, Central Body Centered, EME50 pb_sc:FLTARR(3),$ ; Picture Body, S/C Centered, EME50 sun_sc:FLTARR(3),$ ; Sun (unit vector), S/C Centered, EME50 sc_cb_range:0.0,$ ; S/C - Central Body Range sc_pb_range:0.0,$ ; S/C - Picture Body Range sc_sun_range:0.0,$ ; S/C - Sun Range pb_subsl_lat:0.0,$ ; Picture Body Subsolar Latitude pb_subsl_lon:0.0,$ ; Picture Body Subsolar Longitude pb_subsc_lat:0.0,$ ; Picture Body Sub-S/C Latitude pb_subsc_lon:0.0,$ ; Picture Body Sub-S/C Longitude cb_subsc_lon:0.0,$ ; Central Body Sub-S/C Longitude sc_phase_ang:0.0,$ ; S/C Phase Angle pb_semi_diam:0.0,$ ; Picture Body Angular Semi-diameter scan_az:0.0,$ ; Azimuth of Scan Platform scan_el:0.0,$ ; Elevation of Scan Platform scan_twist:0.0,$ ; Twist Angle of Scan Platform p5_lat:0.0,$ ; P5 Planetodetic Latitude p5_lon:0.0,$ ; P5 Longitude p5_incidence:0.0,$ ; P5 Solar Incidence Angle p5_emission:0.0,$ ; P5 S/C Emission Angle p5_phase:0.0,$ ; P5 S/C Phase Angle p5_pca_altitude:0.0,$ ; P5 PCA Altitude p5_pca_hour_angle:0.0,$ ; P5 PCA Hour Angle p5_slant_range:0.0,$ ; P5 Slant Range p2_lat:0.0,$ ; P2 Planetodetic Latitude p2_lon:0.0,$ ; P2 Longitude p2_incidence:0.0,$ ; P2 Solar Incidence Angle p2_emission:0.0,$ ; P2 S/C Emission Angle p2_phase:0.0,$ ; P2 S/C Phase Angle p2_pca_altitude:0.0,$ ; P2 PCA Altitude p2_pca_hour_angle:0.0,$ ; P2 PCA Hour Angle p2_slant_range:0.0,$ ; P2 Slant Range p8_lat:0.0,$ ; P8 Planetodetic Latitude p8_lon:0.0,$ ; P8 Longitude p8_incidence:0.0,$ ; P8 Solar Incidence Angle p8_emission:0.0,$ ; P8 S/C Emission Angle p8_phase:0.0,$ ; P8 S/C Phase Angle p8_pca_altitude:0.0,$ ; P8 PCA Altitude p8_pca_hour_angle:0.0,$ ; P8 PCA Hour Angle p8_slant_range:0.0,$ ; P8 Slant Range p5_X:0.0,$ ; P5 X Position in System p5_Y:0.0,$ ; P5 Y Position in System p5_XM:0.0,$ ; P5 X Position in System p5_YM:0.0,$ ; P5 Y Position in System slit_tilt:0.0,$ ; Slit Tilt wrt System ; status words pointing_bad:0,$ ; original pointing flagged bad OR uncorrectable glitch azel_corrected:0,$ ; AZ/EL pointing glitch was corrected footprint_bad:0,$ ; footprint quantities could not be calculated spectrum_bad:0,$ ; spectra data quality is bad ; Julian date jd:0.0d0,$ ; Julian Date ; UVS data vector with 6 shift channels to either side lshift:FLTARR(6),$ ; 6 Shift channels (shortward) data:FLTARR(126),$ ; 126 Data channels rshift:FLTARR(6) } ; 6 Shift channels (longward) STOP ;;kes END ;;kes vgrppsmg.pro_13000066403252300000050000000101171032255250200137650ustar00ksimmons00005460002003; file: GLLUVS2:[VGR.PDS_ARCHIVE.SOFTWARE]VGRPPSMG.PRO ; ; Oct 18, 2001 - kes ; ; Voyager Photopolarimeter Subsystem (PPS) URANUS Merged data file IDL data ; structure from the file: ;ORION::DISKG:[MERGES]WRITEUP_U.TXT ; June 21,1996 - JEREMY GEBBEN ; Updated February 27, 1997 - WENDY SWEET ; Updated terms - July 23, 1997 - Simmons ; ; The MERGED file data represents the total Reduced Data Record (RDR) ;from the Voyager 2 PPS Uranus encounter data set. The Raw PPS data has ;been calibrated and corrected, as per the publication and calibration ;documentation, and then merged with the spacecraft and optical path ;geometry to form this file. The data in this file was used for all PPS ;science publications. ; ;NOTE: The PPS Raw data file format is different from the MERGE format. ;------------------------------------------------------------------------ RT = {UVS_RT,$ ; Header: ; Earth Receipt Time ERT_YR:0L,$ ; Year (last 2 digits eg. 96) ERT_DOY:0L,$ ; day of year ERT_HR:0L,$ ; hours ERT_MIN:0L,$ ; minutes ERT_SEC:0L,$ ; seconds ERT_MSEC:0L,$ ; milliSEConds ; Spacecraft Event time (SCET) for start of integration: SCE_YR:0L,$ ; Year (last 2 digits eg. 96) SCE_DOY:0L,$ ; day of year SCE_HR:0L,$ ; hours SCE_MIN:0L,$ ; minutes SCE_SEC:0L,$ ; seconds SCE_MSEC:0L,$ ; milliSEConds ; Spacecraft Clock (SCLK) time for start of integration: RIM:0L,$ ; start RIM (all realtime data starts on mf 0) ; Spacecraft Event time (SCET) for end of integration: SCETE_YR:0L,$ ; Year (last 2 digits eg. 96) SCETE_DOY:0L,$ ; day of year SCETE_HR:0L,$ ; hours SCETE_MIN:0L,$ ; minutes SCETE_SEC:0L,$ ; seconds SCETE_MSEC:0L,$ ; milliSEConds ; SCLK time for end of integration: RIME:0L,$ ; end RIM (all realtime data ends on mf 0) PACKETS:0l,$ ;# of packets that went into this array(max = 8) ; Data PresenSCE Indicators DPI:lonarr(8),$ ; dpi flags,1 for each packet ; Each is a 4 byte field: ; Top byte: ; 00 = no data missing ; FF = entire packet missing ; 01 = data missing at end of packet ; 02 = data missing in middle of packet ; 03 = data missing at end of packet ; Lower 3 bytes are only used if top byte is ; 01,02, or 03. In these cases, the tHRee lower ; bytes are used to report the position of the gap: ; SECond byte: # of data words(2 bytes) ; at start(0 if gap is at start) ; third byte : # of data words missing ; bottom byte: # of data words at end of packet ; (0 if gap is at end) PAC_SEQ:0L,$ ; packet sequence # of the first packet in this set SPARE:lonarr(2),$ ; spare (set to -1) SW:0L,$ ; software version number ; (of IPF_RT_PROC.PRO - both UVS and EUV) CMD_SUM:0L,$ ; commanded summation period (in RIMS) CMD_STEP1:0L,$ ; commanded number of steps in the MINiscan for ; the first spectrum CMD_STEP2:0L,$ ; commanded number of steps in the MINiscan for ; the SECond spectrum CMD_STEP_START:0L,$ ; commanded initial grating position CMD_STEP_DELTA:0L,$ ; commanded number of grating steps to move ; to the SECond spectrum SPARE2:lonarr(2),$ ; spare (set to -1) ; Data: END_SPEC:lonarr(84),$ ; end of spectra from last RIM ; for RT, 6 integrations/RIM plus one zero FID1:lonarr(18),$ ; eng. fiducial of first spectra of RIM SPEC1:lonarr(528),$ ; data (7 integrations/RIM) FID2:lonarr(18),$ ; second spectra engineering fiducial SPEC2:lonarr(444) $ ; 1st part of second spectra data ; (7 integrations/RIM) } ; all done ; END vgrppsmg.pro_14000066403252300000050000000102301032255250200137620ustar00ksimmons00005460002003; file: GLLUVS2:[VGR.PDS_ARCHIVE.SOFTWARE]VGRPPSMG.PRO ; ; Oct 18, 2001 - kes ; ; Voyager Photopolarimeter Subsystem (PPS) URANUS Merged data file IDL data ; structure from the file: ;ORION::DISKG:[MERGES]WRITEUP_U.TXT ; June 21,1996 - JEREMY GEBBEN ; Updated February 27, 1997 - WENDY SWEET ; Updated terms - July 23, 1997 - Simmons ; ; The MERGED file data represents the total Reduced Data Record (RDR) ;from the Voyager 2 PPS Uranus encounter data set. The Raw PPS data has ;been calibrated and corrected, as per the publication and calibration ;documentation, and then merged with the spacecraft and optical path ;geometry to form this file. The data in this file was used for all PPS ;science publications. ; ;NOTE: The PPS Raw data file format is different from the MERGE format. ; #### Nov, 2002 - kes: the following comes from GLL and is NOT PPS f/t ;------------------------------------------------------------------------ RT = {UVS_RT,$ ; Header: ; Earth Receipt Time ERT_YR:0L,$ ; Year (last 2 digits eg. 96) ERT_DOY:0L,$ ; day of year ERT_HR:0L,$ ; hours ERT_MIN:0L,$ ; minutes ERT_SEC:0L,$ ; seconds ERT_MSEC:0L,$ ; milliSEConds ; Spacecraft Event time (SCET) for start of integration: SCE_YR:0L,$ ; Year (last 2 digits eg. 96) SCE_DOY:0L,$ ; day of year SCE_HR:0L,$ ; hours SCE_MIN:0L,$ ; minutes SCE_SEC:0L,$ ; seconds SCE_MSEC:0L,$ ; milliSEConds ; Spacecraft Clock (SCLK) time for start of integration: RIM:0L,$ ; start RIM (all realtime data starts on mf 0) ; Spacecraft Event time (SCET) for end of integration: SCETE_YR:0L,$ ; Year (last 2 digits eg. 96) SCETE_DOY:0L,$ ; day of year SCETE_HR:0L,$ ; hours SCETE_MIN:0L,$ ; minutes SCETE_SEC:0L,$ ; seconds SCETE_MSEC:0L,$ ; milliSEConds ; SCLK time for end of integration: RIME:0L,$ ; end RIM (all realtime data ends on mf 0) PACKETS:0l,$ ;# of packets that went into this array(max = 8) ; Data PresenSCE Indicators DPI:lonarr(8),$ ; dpi flags,1 for each packet ; Each is a 4 byte field: ; Top byte: ; 00 = no data missing ; FF = entire packet missing ; 01 = data missing at end of packet ; 02 = data missing in middle of packet ; 03 = data missing at end of packet ; Lower 3 bytes are only used if top byte is ; 01,02, or 03. In these cases, the tHRee lower ; bytes are used to report the position of the gap: ; SECond byte: # of data words(2 bytes) ; at start(0 if gap is at start) ; third byte : # of data words missing ; bottom byte: # of data words at end of packet ; (0 if gap is at end) PAC_SEQ:0L,$ ; packet sequence # of the first packet in this set SPARE:lonarr(2),$ ; spare (set to -1) SW:0L,$ ; software version number ; (of IPF_RT_PROC.PRO - both UVS and EUV) CMD_SUM:0L,$ ; commanded summation period (in RIMS) CMD_STEP1:0L,$ ; commanded number of steps in the MINiscan for ; the first spectrum CMD_STEP2:0L,$ ; commanded number of steps in the MINiscan for ; the SECond spectrum CMD_STEP_START:0L,$ ; commanded initial grating position CMD_STEP_DELTA:0L,$ ; commanded number of grating steps to move ; to the SECond spectrum SPARE2:lonarr(2),$ ; spare (set to -1) ; Data: END_SPEC:lonarr(84),$ ; end of spectra from last RIM ; for RT, 6 integrations/RIM plus one zero FID1:lonarr(18),$ ; eng. fiducial of first spectra of RIM SPEC1:lonarr(528),$ ; data (7 integrations/RIM) FID2:lonarr(18),$ ; second spectra engineering fiducial SPEC2:lonarr(444) $ ; 1st part of second spectra data ; (7 integrations/RIM) } ; all done ; END vgruvs.pro_1000066403252300000050000000101641026532443000133760ustar00ksimmons00005460002003; ------------------------------------------------ ; UVS RDR Version 1.0 structure definition for IDL ; October 1, 1996 ; ------------------------------------------------ spec = { uvs,$ ; FDS Count and Time fds:0.0,$ ; FDS count spno:0,$ ; Spectrum Number scid:0,$ ; Space Craft ID data_mode:0,$ ; Data mode scet_yr:0,$ ; Space Craft Event Time (YEAR) scet_day:0,$ ; Space Craft Event Time (DAY) scet_hr:0,$ ; Space Craft Event Time (HOUR) scet_min:0,$ ; Space Craft Event Time (MIN) scet_sec:0,$ ; Space Craft Event Time (SEC) scet_ms:0,$ ; Space Craft Event Time (MS) ; History fpn:0,$ ; FPN spectrum number cal:0,$ ; CAL spectrum number scat:0,$ ; SCAT matrix number ; counting mode and HV level counting_mode:0,$ ; Counting mode hv:0,$ ; High Voltage Level ; integration time and scale factor dt:0.0,$ ; Integration time scale:0.0,$ ; Scale Factor ; UVS original pointing ag_az:0.0,$ ; Air-Glow Azimuth ag_el:0.0,$ ; Air-Glow Elevation ag_ra:0.0,$ ; Air-Glow Right-Ascension ag_dec:0.0,$ ; Air-Glow Declination occ_ra:0.0,$ ; Occultation Right-Ascension occ_dec:0.0,$ ; Occultation Declination dl:FLTARR(5),$ ; Delta L [5 values] dw:FLTARR(5),$ ; Delta W [5 values] rot:FLTARR(4),$ ; Rotation matrix [A,B,C,D] sun_ra:0.0,$ ; Sun Right-Ascension sun_dec:0.0,$ ; Sun Declination pba:0.0,$ ; Pitch Bias Angle yba:0.0,$ ; Yaw Bias Angle ; footprint pb_id:0,$ ; Picture Body ID cb_id:0,$ ; Central Body ID sc_cb:FLTARR(3),$ ; S/C, Central Body Centered, EME50 pb_sc:FLTARR(3),$ ; Picture Body, S/C Centered, EME50 sun_sc:FLTARR(3),$ ; Sun (unit vector), S/C Centered, EME50 sc_cb_range:0.0,$ ; S/C - Central Body Range sc_pb_range:0.0,$ ; S/C - Picture Body Range sc_sun_range:0.0,$ ; S/C - Sun Range pb_subsl_lat:0.0,$ ; Picture Body Subsolar Latitude pb_subsl_lon:0.0,$ ; Picture Body Subsolar Longitude pb_subsc_lat:0.0,$ ; Picture Body Sub-S/C Latitude pb_subsc_lon:0.0,$ ; Picture Body Sub-S/C Longitude cb_subsc_lon:0.0,$ ; Central Body Sub-S/C Longitude sc_phase_ang:0.0,$ ; S/C Phase Angle pb_semi_diam:0.0,$ ; Picture Body Angular Semi-diameter scan_az:0.0,$ ; Azimuth of Scan Platform scan_el:0.0,$ ; Elevation of Scan Platform scan_twist:0.0,$ ; Twist Angle of Scan Platform p5_lat:0.0,$ ; P5 Planetodetic Latitude p5_lon:0.0,$ ; P5 Longitude p5_incidence:0.0,$ ; P5 Solar Incidence Angle p5_emission:0.0,$ ; P5 S/C Emission Angle p5_phase:0.0,$ ; P5 S/C Phase Angle p5_pca_altitude:0.0,$ ; P5 PCA Altitude p5_pca_hour_angle:0.0,$ ; P5 PCA Hour Angle p5_slant_range:0.0,$ ; P5 Slant Range p2_lat:0.0,$ ; P2 Planetodetic Latitude p2_lon:0.0,$ ; P2 Longitude p2_incidence:0.0,$ ; P2 Solar Incidence Angle p2_emission:0.0,$ ; P2 S/C Emission Angle p2_phase:0.0,$ ; P2 S/C Phase Angle p2_pca_altitude:0.0,$ ; P2 PCA Altitude p2_pca_hour_angle:0.0,$ ; P2 PCA Hour Angle p2_slant_range:0.0,$ ; P2 Slant Range p8_lat:0.0,$ ; P8 Planetodetic Latitude p8_lon:0.0,$ ; P8 Longitude p8_incidence:0.0,$ ; P8 Solar Incidence Angle p8_emission:0.0,$ ; P8 S/C Emission Angle p8_phase:0.0,$ ; P8 S/C Phase Angle p8_pca_altitude:0.0,$ ; P8 PCA Altitude p8_pca_hour_angle:0.0,$ ; P8 PCA Hour Angle p8_slant_range:0.0,$ ; P8 Slant Range p5_X:0.0,$ ; P5 X Position in System p5_Y:0.0,$ ; P5 Y Position in System p5_XM:0.0,$ ; P5 X Position in System p5_YM:0.0,$ ; P5 Y Position in System slit_tilt:0.0,$ ; Slit Tilt wrt System ; status words pointing_bad:0,$ ; original pointing flagged bad OR uncorrectable glitch azel_corrected:0,$ ; AZ/EL pointing glitch was corrected footprint_bad:0,$ ; footprint quantities could not be calculated spectrum_bad:0,$ ; spectra data quality is bad ; Julian date jd:0.0d0,$ ; Julian Date ; UVS data vector with 6 shift channels to either side lshift:FLTARR(6),$ ; 6 Shift channels (shortward) data:FLTARR(126),$ ; 126 Data channels rshift:FLTARR(6) } ; 6 Shift channels (longward) STOP ;;kes END ;;kes voyage.for_35000066403252300000050000000367421033671271100134250ustar00ksimmons00005460002003C PROGRAM VOYAGER.FOR Oct 25,84 * UPDATED TO USE NEW TEKPLOT GRAPHICS PACKAGE 8-84 * REVISED FOR USE WITH COLOR PLOTTER 8-12-84 C UPDATED TO WRITE XX,YY DATA TO A FILE c Update for Eng.use of SCE or ERT Oct 25,85 C Updated for TEKPLOT 4014 version w/QMS or C Postscript laser printer options May 25,88 Cc Edited for a new VOYPLTT Feb 5,'90 C A PROGRAM TO USE VOYAGER REFORMATED DATA FILES/TAPES C TO INSPECT AND ANALYZE DATA COMMON NARR(1280),IHDR(80),IST(6,80),IENG(1280) COMMON/HOLD/XXX,YYY INTEGER*4 ITYP INTEGER*4 INREC,IVBN,LASTE !Aug 31,88 LOGICAL*1 NAMDSK(25) DIMENSION DDT(27),IVBN(2),IDAT1(80),IDAT2(80),ITRAN(80) integer*2 CHOICE ! Used to choose screen or file character*100 OUTPUT_STRING ! Used to output formatted text logical*1 SCREEN_OUTPUT ! Indicates plot destination logical*1 Y_LOG !SELECT Y-AXIS LINEAR/LOG logical*1 STANDARD ! Used to allow plotter cmds. EQUIVALENCE (IVBN(2),INREC) DATA IVBN/0,1/,IK/1/,IRY/0/,XLIM/3000./,YLIM/524288./ DATA YT/10./,XT/500./,YMIN/1./,XMIN/0./,RATE/7.2E+3/ DATA DDT/.6,6.,12.,18.,36.,.6,.6,.6,.6,.6,.6,.6,.6,.6,.6,.6,.6, + .6,.6,.6,.6,.6,.6,.6,.6,.6,.0075/,ISTART/0/ type*,'Select output device: (0 = screen, 1 = file)' read(*,105) CHOICE 105 format(I1) SCREEN_OUTPUT = .true. if (CHOICE .eq. 1) SCREEN_OUTPUT = .false. FILE_SPEC = ' ' STANDARD = .true. IF(SCREEN_OUTPUT .EQ. .FALSE.) THEN type*,'Plot intended for Tek4662?: (1 = Yes, 0 = No)' read(*,105) CHOICE if (CHOICE .eq. 1) then STANDARD = .false. TYPE*,'WHICH PEN:1=BLACK,2=RED...' READ(*,105) CHOICE endif endif call PLOT_INITIALIZE(SCREEN_OUTPUT,' ',STANDARD,1) IF(STANDARD .EQ. .FALSE.) CALL NONSTAND_SELECT_4662_PEN(CHOICE) ITIS=0 PPTD=0. PPNZ=0. ACCUM=0. WRITE(*,115) 115 FORMAT(' SUPPLY DISK FILE NAME, AS D12307.DAT') READ(*,125) MM,NAMDSK 125 FORMAT(Q,25A1) OPEN(1,ASSOCIATEVARIABLE=INREC,BLOCKSIZE=512,RECL=128, + NAME=NAMDSK,ACCESS='DIRECT',STATUS='OLD',READONLY, + IOSTAT=IER) IF(IER .ne. 0) then WRITE(*,135) IER 135 FORMAT(' FILE ASSIGN ERROR, #',I5) STOP 'ASSIGN ERROR' endif IR=0 IEOF=0 200 CONTINUE DO IJ=1,80 DO JJ=1,6 IST(IJ,JJ)=0 ENDDO ENDDO C.FTN IF(MOD(IR,ISTART) .EQ. 0) GO TO 590 IF(IR .EQ. ISTART) GO TO 590 210 CONTINUE IR=IR+1 C ZERO ARRAY BEFORE READING AGAIN DO 212 IJK=1,1280 IENG(IJK)=0 212 NARR(IJK)=0 C READ LOOP: READ THE RECORD HEADER INFO THEN GROUPS OF DATA C HEADER TELLS HOW MUCH TO EXPECT CALL BLKRDW(1,NARR,IVBN,1,IER) IF(IER .EQ. 0) GO TO 300 ! Success IF(IER .EQ. 36) GO TO 220 ! eof WRITE(*,205) IR,IER ! Report error 205 FORMAT(' READ ERROR, IR=',I5,' #',2I5) GO TO 200 220 CONTINUE IEOF=IEOF+1 215 FORMAT(' EOF AFTER REC',I5) IF(IEOF .EQ. 1)GO TO 590 IF(IEOF .LT. 2) GO TO 200 WRITE(*,225) IEOF WRITE(*,225) IEOF 225 FORMAT(' DOUBLE EOF',I5) STOP 'END OF JOB' 300 CONTINUE C FIGURE HOW MUCH DATA TO READ NEXT C IF THERE ARE .LE. 80 VALUES THEN EXPECT IDATA,IDAT2,ISTAT LEN=NARR(28) MODE=NARR(2) DO 304 II=1,80 IHDR(II)=NARR(II) 304 CONTINUE 315 FORMAT(' R,M,Y,D,H,M,S,,MS,FDS',/,6I10,/,2I10,F7.1,2I10) C WRITE(*,305) IR,LEN,(IHDR(JJ),JJ=1,80) 310 CONTINUE 305 FORMAT(' RECORD #',I5,' HEADER VALUES:',I5,/,(10I10)) IQAN=LEN/256 IF(IQAN*256 .LT. LEN) IQAN=IQAN+1 IF(LEN .NE. 80) GO TO 400 314 CONTINUE LOOP=0 320 CONTINUE C READ ONCE FOR STATUS, HIGH BITS AND LOW BITS CALL BLKRDW(1,NARR,IVBN,IQAN,IER) LASTE=IVBN(2)-IQAN IF(IER .EQ. 0) GO TO 330 WRITE(*,205) IR,IER GO TO 200 330 CONTINUE 335 FORMAT(' DATA=',/,(10I10)) CALL STAT(LEN,IFLG) IF(ITRN .EQ. 1) CALL TRAN(LEN,ITRAN) RMOD16=IHDR(9) IF(IHDR(9) .LT. 0) RMOD16=(32768.+IHDR(9))+32768. IF(IFLG .EQ. 1) GO TO 360 340 CONTINUE 360 CONTINUE DO 362 II=1,LEN IDAT1(II)=NARR(II+80) IDAT2(II)=NARR(II+160) 362 CONTINUE C WRITE(*,305) IR,LEN,(IHDR(JJ),JJ=1,37) IF(IDOE .EQ. 0) GO TO 200 397 CONTINUE IF(IROS .EQ. 0) GO TO 3000 DD=(IHDR(ITI)-IDAYS)*24.*3600. DH=(IHDR(ITI+1)-IHRS)*3600. DMI=(IHDR(ITI+2)-MINS)*60. TIM=DD+DH+DMI+IHDR(ITI+3)+(IHDR(ITI+4)/1000.) XX=TIM IF(XX .LT. TIMST) GO TO 200 Cc IF(XX .GT. TIMSP) GO TO 200 TOP=0. BOT=0. IBN=0 ITN=0 LENH=LEN/2 DO 398 II=1,LEN C IF(IST(2,II) .NE. 0) GO TO 398 IF(IST(1,II) .EQ. IFC ) GOTO 370 IF(IST(1,II) .EQ. IAC) GO TO 380 GO TO 398 370 CONTINUE VAL=(IDAT1(II)*32.)+(IDAT2(II) .AND. 31) TOP=TOP+VAL ITN=ITN+1 GO TO 398 380 CONTINUE VAL=(IDAT1(II)*32.)+(IDAT2(II) .AND. 31) BOT=BOT+VAL IBN=IBN+1 398 CONTINUE IF(ITN .EQ. 0) GO TO 200 TOP=TOP/ITN IF(IBN .EQ. 0) GO TO 200 BOT=BOT/IBN XX=TIM IF(TOP .EQ. 0.) GO TO 200 YY=BOT/TOP IF(YY .LT. YMIN) YY=YMIN IF(YY .GT. YLIM) YY=YLIM DDDD CALL PDRAW(XX,YY,1,ITYP) PPTD = PPTD + 1. IF (YY .LT. YLIM .AND. YY .GT. YMIN) PPNZ = PPNZ + 1 IF(YY .LT. YLIM .AND. YY .GT. YMIN) ACCUM=ACCUM+YY CALL PLOT_DRAW_DATA(XX,YY,1,ITYP,.true.) GO TO 200 400 CONTINUE IF(LEN .EQ. 600) GO TO 6000 IF(LEN .LT. 80) GO TO 314 C THE ENGINEERING DATA CASE CALL BLKRDW(1,IENG,IVBN,IQAN,IER) IF(IER .EQ. 0) GO TO 420 WRITE(*,205) IR,IER GO TO 200 420 CONTINUE IF(IDOE .EQ. 1) GO TO 200 C WRITE(*,375) IR,IRK 375 FORMAT(' ENG SEC.,IR,IRK=',2I5) IE=1 424 CONTINUE NUM=IENG(IE) LN=IENG(IE+2) C WRITE(*,345) NUME,IE,NUM,LN DD=(IHDR(ITI)-IDAYS)*24.*3600. DH=(IHDR(ITI+1)-IHRS)*3600. DMI=(IHDR(ITI+2)-MINS)*60. TIM=DD+DH+DMI+IHDR(ITI+3)+(IHDR(ITI+4)/1000.) C TIM IS IN SECONDS FROM PLOT START 345 FORMAT(' ENG SEC.,NUM,LNE,IE,NUM=',4I5) 430 CONTINUE IF(NUM .EQ. NUME) GO TO 440 IE=IE+(LN*2)+3 IF(IE .GE. LEN) GO TO 200 GO TO 424 440 CONTINUE DO 450 II=1,LN C.FTN IRK=IRK+1 !APPEARS TO BE NON-USED REMNANT JK=II*2 YY=IENG(IE+2+JK) XX=IENG(IE+1+JK)/10. C XX IS GIVEN IN TENTHS OF SECONDS FROM FRAME START TIMS=XX+IHDR(6)*60.+IHDR(7)+(IHDR(8)/1000.) MINEN=TIMS/60. SECEN=TIMS-(MINEN*60.) IF(IPNT .EQ. 1) WRITE(3,365) NUME,YY,(IHDR(IJK),IJK=3,8), + XX,MINEN,SECEN 365 FORMAT(' E',I3,' DN=',F6.1,' TIME:',6I5,F10.5,I5,F9.3) XX=TIM+XX IF(XX .LT. TIMST) GO TO 450 C IF(XX .GT. TIMSP) GO TO 580 ! For multi eng blks/rec Cc IF(XX .GT. TIMSP) GO TO 590 ! Standard case IF(YY .LT. 0.) YY=0. IF(YY .GT. 256.) YY=256. IF(XX .GT. XLIM) XX=XLIM DDDD CALL PDRAW(XX,YY,1,ITYP) IF(IPNT .EQ. 2) CALL STORIT (XX,YY,ITIS) CALL PLOT_DRAW_DATA(XX,YY,1,ITYP,.true.) DDDD450 IF(ITYP .EQ.1) ITYP=-1 450 IF ((ITYP .NE. 1).and.(ITYP .ne. 5)) ITYP=5 IE=IE+(LN*2)+3 IF(IE .GE. LEN) GOTO 200 GO TO 424 500 CONTINUE C OTHER FORMATS PRINT 505,IR,LEN 505 FORMAT(' LENGTH INDICATES STRANGE FORMAT,REC:',I5,'LEN',I5) GOTO 200 580 CONTINUE C SEARCH REST OF ENG.BLOCK FOR MORE DATA FOR THIS E VALUE IE=IE+(LN*2)+3 IF(IE .GE. LEN) GO TO 590 GO TO 424 590 CONTINUE IF(IR .LE. 1) GO TO 602 600 CONTINUE C PLOT THE COLLECTED DATA C IF(IRK .EQ. 0) GO TO 602 IF(ITI .EQ. 4) WRITE(OUTPUT_STRING,805) IHDR(3) IF(ITI .EQ. 13) WRITE(OUTPUT_STRING,815) IHDR(3) call PLOT_DRAW_CHARACTERS(0.,75.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:49)) IF(IDOE .EQ. 1 .AND. PPNZ .GT. 0.) AVG=ACCUM/PPNZ IF(IDOE .EQ. 1) THEN WRITE(OUTPUT_STRING,6605) PPTD,PPNZ,ACCUM,AVG 6605 FORMAT(' TOT.PTS=',F10.1,' N.Z.PTS=',F10.1,' ACCUM=',E15.7, + ' AVG=',E15.7) call PLOT_DRAW_CHARACTERS(0.,0.,.false.,.65,0., 1 OUTPUT_STRING(1:80)) ENDIF PPTD=0. PPNZ=0. ACCUM=0. C DUMP ACCUMULATED XX,YY ARRAY IF STORING IT IF(IPNT .EQ. 2) CALL STORIT(0.,0.,9000) CALL NONSTAND_SELECT_4662_PEN(0) ! Return pen call PLOT_CLEANUP ! Close off last plot WRITE(*,6015) 6015 FORMAT(' MORE? (RESTART=0,CONT=1,SAME PERIOD=2,STOP=3)') READ(*,645) IRY C 0=RESTART, 1=CONTINUE,2=SAME PERIOD-ENG REDO,3=STOP IF(IRY .GT. 2) STOP 'IRY STOP' ** Init the next plot call PLOT_INITIALIZE(SCREEN_OUTPUT,' ',STANDARD) CALL NONSTAND_SELECT_4662_PEN(1) ! Black pen IVBN(2)=LASTE - 1 ! Minus 1 for header IF(IRY .EQ. 0) IVBN(2)=1 IF(IRY .EQ. 2) IVBN(2)=1 IEOF=0 602 CONTINUE WRITE(*,705) 705 FORMAT(' WANT DATA (=1) OR ENG (=0) PLOTS?') READ(*,645) IDOE IF(IRY .EQ. 2) GO TO 2050 WRITE(*,605) 5995 FORMAT(' ENTER YMIN,YLIM,YTICKS,5F5.,AXIS TYPE(0=LIN)') WRITE(*,2005) 2005 FORMAT(' SUPPLY START DAYS,IHRS,MIN(3I3)') READ(*,2015) IDAYS,IHRS,MINS 2015 FORMAT(3I3) XMIN=0. WRITE(*,2025) 2025 FORMAT(' SUPPLY END DAYS,IHRS,MIN') READ(*,2015) IDAYE,IHRE,MINE WRITE(*,4075) 4075 FORMAT(' WHICH TIME: SCE(=4) OR ERT(=13)') READ(*,2045) ITI XT=((IDAYE-IDAYS)*24.)+(IHRE-IHRS) LIM=XT XLIM=(LIM)*3600.+(MINE-MINS)*60. TIMST=0. TIMSP=(XT*3600.)+(MINE-MINS)*60. XT=600. IF(LIM .EQ. 0) XT=600. IF(LIM .EQ. 0 .AND. (MINE-MINS) .LE. 30.) XT=60. WRITE(*,2035) 2035 FORMAT(' SUPPLY MODE # (I2)') READ(*,2045) IDDT DDTI=DDT(IDDT) MODE=IDDT 2045 FORMAT(I2) WRITE(*,5995) READ(*,595) YMIN,YLIM,YT,IYTYP X_LOG = .FALSE. Y_LOG = .FALSE. if (IYTYP .eq. 1) Y_LOG = .true. 2050 WRITE(*,715) READ(*,645) ITYP WRITE(*,2065) 2065 FORMAT(' WANT PRINT (YES=1, OR XX,YY INTO FILE=2)?') READ(*,645) IPNT IF(IPNT .EQ. 1) WRITE(3,6455) NAMDSK 6455 FORMAT(1H1,' FROM DATA FILE',25A1) IF(IDOE .EQ. 0) GO TO 700 IF(IPNT .GT. 0) WRITE(*,6465) 6465 FORMAT(' FOR PRINT OUTPUT, "ASSIGN file=FOR003, X,Y FILE=003"') WRITE(*,2055) 2055 FORMAT(' WANT:ALL PTS(=0), SPECIFY F#/A# (=1), OR STATUS(=2)?') READ(*,645) IALL WRITE(*,1625) 1625 FORMAT(' WANT: TRANSITION VALUES INCLUDED (=0) OR NOT (=1)?') READ(*,645) ITRN IF(IALL .EQ. 0) GO TO 2100 IF(IALL .EQ. 2) GO TO 2090 WRITE(*,1615) 1615 FORMAT(' WANT RATIOS (=1) OR SIMPLE DATA (=0)') READ(*,645) IROS if (IROS .eq. 1) then WRITE(*,1635) 1635 FORMAT(' SUPPLY DESIRED FILTER PAIR, AS "4 6"') else WRITE(*,615) 615 FORMAT(' SUPPLY DESIRED FILTER NO AND ANAL NO, AS "4 5"') endif READ(*,625)IFC,IAC WRITE(*,635) IFC,IAC 635 FORMAT(' LOOKING FOR FILTER',I3,' AND',I3) C WRITE(*,665) 665 FORMAT(' WANT FORWARDS (1), BACKWARDS (2) OR BOTH (0)') C READ(*,645) NDIR 715 FORMAT(' WANT POINTS (5) OR LINES (1)?') 645 FORMAT(I1) 625 FORMAT(I1,I2) 605 FORMAT(' LIMITS;Y:1-524288 LOG;') 595 FORMAT(3F10.1,I1) GO TO 2100 2090 WRITE(*,2095) 2095 FORMAT(' STATUS KEY:1=F,2=A,3=OF,4=J,5=SS,6=HV') READ(*,645) ISK 2100 IRK=0 CALL PLOT_ERASE ACCUM=0. CALL PLOT_SCALE(XMIN,XLIM,YMIN,YLIM,100.*4.,1000.*4.,100.*4., 1 775.*4.,X_LOG,Y_LOG) IF(IROS .EQ. 1) CALL PLOT_DRAW_AXIS(XT,YT,.false.,.true., 1 .true.,' ',' TIME', 2 'FILTER RATIO (AVG/REC)',.true.) IF(IROS .EQ. 0) CALL PLOT_DRAW_AXIS(XT,YT,.false.,.true., 1 .true.,' ',' TIME', 2 'ALL COUNTS',.true.) WRITE(OUTPUT_STRING,695) IDAYS,IHRS,MINS,NAMDSK,IDAYE,IHRE,MINE CALL PLOT_DRAW_CHARACTERS(1.,50.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:92)) 805 FORMAT(15X,' 19',I2,25X,'SCE') 815 FORMAT(15X,' 19',I2,25X,'ERT') IF(ITRN .EQ. 1) THEN WRITE(OUTPUT_STRING,1685) CALL PLOT_DRAW_CHARACTERS(0.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:47)) ENDIF IF(IALL .EQ. 0) THEN WRITE(OUTPUT_STRING,685) CALL PLOT_DRAW_CHARACTERS(0.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:22)) ENDIF 1685 FORMAT(35X,' NO TRANSITS') IF(IALL .EQ. 0) GO TO 210 IF(IALL .EQ. 2) GO TO 2200 IF (IROS .EQ. 0) then WRITE(OUTPUT_STRING,655) IFC,IAC 655 FORMAT(' FILTER',I4,' ANALYZER',I4) CALL PLOT_DRAW_CHARACTERS(0.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:24)) endif IF (IROS .EQ. 1) then WRITE(OUTPUT_STRING,1655) IFC,IAC 1655 FORMAT(' RATIO OF FILTER ',I2,' OVER ',I2) CALL PLOT_DRAW_CHARACTERS(0.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:27)) endif C IF(NDIR .EQ. 1) WRITE(OUTPUT_STRING,675) C675 FORMAT(' FORWARDS ') C IF(NDIR .EQ. 2) WRITE(OUTPUT_STRING,785) C785 FORMAT(' BACKWARDS ') C IF(NDIR .EQ. 0) WRITE(OUTPUT_STRING,685) C WRITE(OUTPUT_STRING,685) 685 FORMAT(' ALL FILTERS/ANALYZERS') C CALL PLOT_DRAW_CHARACTERS(450.*4.,0.,.false.,.65,0., C 1 OUTPUT_STRING(1:22)) 725 FORMAT(25A1) 695 FORMAT(I4,'D',I3,'H',I3,'M',' FROM ',25A1, + ' ',I3,'D',I3,'H',I3,'M') GO TO 210 2200 CONTINUE WRITE(OUTPUT_STRING,2205) ISK 2205 FORMAT(' STATUS KEY(1=F,2=A,3=OF,4=J,5=SS,6=HV):',I3) CALL PLOT_DRAW_CHARACTERS(0.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:43)) GO TO 210 608 CONTINUE 700 CONTINUE IRK=0 WRITE(*,735) 735 FORMAT(' WHICH ENG NUMB? (I3)') READ(*,745) NUME 745 FORMAT(I3) 755 FORMAT(' ENGINEERING NUMB',I4) CALL PLOT_ERASE CALL PLOT_SCALE(XMIN,XLIM,YMIN,YLIM,100.*4.,1000.*4.,100.*4. 1 ,775.*4.,X_LOG,Y_LOG) CALL PLOT_DRAW_AXIS(XT,YT,.false.,.true.,.true.,' ', 1 ' TIME','COUNTS',.true.) WRITE(OUTPUT_STRING,695) IDAYS,IHRS,MINS,NAMDSK,IDAYE,IHRE,MINE CALL PLOT_DRAW_CHARACTERS(1.,50.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:86)) WRITE(OUTPUT_STRING,755) NUME CALL PLOT_DRAW_CHARACTERS(1.,25.*4.,.false.,.65,0., 1 OUTPUT_STRING(1:21)) GO TO 210 3000 CONTINUE DDTI=DDT(MODE) C THE SIMPLE DATA PLOT CASE DD=(IHDR(ITI)-IDAYS)*24.*3600. DH=(IHDR(ITI+1)-IHRS)*3600. DMI=(IHDR(ITI+2)-MINS)*60. TIM=DD+DH+DMI+IHDR(ITI+3)+(IHDR(ITI+4)/1000.) LENH=40 DO 3100 II=1,LEN IF(IALL .EQ. 0) GO TO 3050 IF(IALL .EQ. 2) GO TO 3050 IF(IST(1,II) .NE. IFC) GO TO 3100 IF(IST(2,II) .NE. IAC) GO TO 3100 C IF(NDIR .EQ. 1 .AND. II .GT. LENH) GO TO 3100 C IF(NDIR .EQ. 2 .AND. II .LE. LENH) GO TO 3100 3050 CONTINUE IF(ITRN .EQ. 1 .AND. ITRAN(II) .EQ. 1) GO TO 3100 C.FTN IRK=IRK+1 !APPEARS TO BE NON-USED REMNANT RI=II XX=TIM+(RI*DDTI) IF(XX .LT. TIMST) GO TO 3100 Cc IF(XX .GT. TIMSP) GO TO 590 IF(II .EQ. 1 .AND. IPNT .EQ.1) WRITE(3,315)(IHDR(JJ),JJ=1,8),RMOD16 + ,IHDR(10),IHDR(11) IND=IST(1,II) C XX=WAVEL(IND+1) YY=(IDAT1(II)*32.)+(IDAT2(II) .AND. 31) DDTINT=DDTI-.2 IF(IST(3,II) .GT. 0) YY=(524288.*DDTINT)/(DDTINT-(YY/RATE)) IF(YY .LT. YLIM .AND. YY .GT. YMIN) ACCUM=ACCUM+YY IF(IPNT .EQ. 0) GO TO 3060 TIMSCI=RI*DDTI+(IHDR(6)*60.)+IHDR(7)+(IHDR(8)/1000.) MINSCI=TIMSCI/60. SECSCI=TIMSCI-(MINSCI*60.) WRITE(3,3005) II,(IST(JJ,II),JJ=1,6),YY, + (IHDR(IJK),IJK=3,8),MINSCI,SECSCI 3005 FORMAT(' I;STAT:F,A,OF,J,SS,HVON;CNTS;TIME',7I5,E15.7, + I3,I4,3I3,I5,' = ',I3,F9.3) 3060 IF(XX .GT. XLIM) XX=XLIM IF(YY .LT. YMIN) YY=YMIN IF(YY .GT. YLIM) YY=YLIM IF(IALL .EQ. 2) YY=IST(ISK,II) DDDD CALL PDRAW(XX,YY,1,ITYP) YY_TEMP = YY ! TEKPLOT destroys value IF(IPNT .EQ. 2) CALL STORIT (XX,YY,ITIS) CALL PLOT_DRAW_DATA(XX,YY,1,ITYP,.true.) PPTD=PPTD+1 IF(YY_TEMP .LE. 0) GO TO 3100 IF(YY_TEMP .LT. YLIM .AND. YY_TEMP .GT. YMIN) PPNZ=PPNZ+1 3100 CONTINUE C.FTN IF(ITYP .EQ. 1) ITYP=-1 IF((ITYP .ne. 1).and.(ITYP .ne. 5)) ITYP=5 GO TO 200 6000 CONTINUE C THE OCC DATA CASE C JUST SKIP RECORDS NOW C THERE ARE 9 BLOCKS BESIDES THE HEADER IN THE OCC CASE IRO=0 6004 CONTINUE CALL BLKRDW(1,NARR,IVBN,IQAN,IERR) IF(IERR .EQ. 0) GO TO 6010 WRITE(*,6005) IR,IERR 6005 FORMAT(' READ ERROR, REC,ERR#',2I5) 6010 IRO=IRO+1 IF(IRO .EQ. 3) GO TO 200 GO TO 6004 END C SUBROUTINE STORIT (X,Y,ITIS) integer*2 II,ITIS COMMON/HOLD/XXX(1000),YYY(1000) C STORES XX,YY PLOT VALUES INTO AN ARRAY FOR FILE WRITE IF(ITIS .EQ. 9000) GO TO 1000 XXX(ITIS)=X YYY(ITIS)=Y ITIS=ITIS+1 IF(ITIS .GE. 1000) GO TO 950 RETURN 900 CONTINUE WRITE(*,5) ITIS 5 FORMAT(' XX,YY FILE WRITE ERROR AT ITIS=',I5) RETURN 950 CONTINUE WRITE(3,ERR=900) XXX,YYY DO 960 II=1,1000 XXX(II)=0. 960 YYY(II)=0. ITIS=1 RETURN 1000 CONTINUE C END OF PLOT, DUMP REMAINING ARRAYS WRITE(3,ERR=900) XXX,YYY RETURN END NUE IF(NUM .EQ. NUME) GO TO 4vplotout.com_24000066403252300000050000000014361032256174200140060ustar00ksimmons00005460002003$ VERIFY_SAVE='f$verify("NO") $ $! Ali Bahrami October 24, 1984 VMS 3.7 $! VPLOTOUT produces a plot of every TEKPLOT.DAT file in the current $! directory. The plot files are left unharmed for later use. $ $ on error then goto CLEANUP $ on control_y then goto CLEANUP $ $ write sys$output - "|MON K |WOR 33 H |GRA 1,35 |SHR |JUM 1 |LEA 172 $|ERA G$13" $ $ TOP: $ file_spec := "''f$search("tekplot.dat;*")'" $ if file_spec .eqs. "" then goto cleanup $ run [bahrami.tekplot]plotout $ write sys$output "|JUM 1 1" $ write sys$output "|HCO" $ wait 00:00:12 ! Because H-copy unit needs time $ write sys$output "|ERA G$13" $ rename tekplot.dat; tekhold.dat; $ goto TOP $ $ CLEANUP: $ rename tekhold.dat;* tekplot.dat;* $ write sys$output "|MON 34 H K |LEA 172 172" $ $ if VERIFY_SAVE then set verify vplotout.com_25000066403252300000050000000014361032256174200140070ustar00ksimmons00005460002003$ VERIFY_SAVE='f$verify("NO") $ $! Ali Bahrami October 24, 1984 VMS 3.7 $! VPLOTOUT produces a plot of every TEKPLOT.DAT file in the current $! directory. The plot files are left unharmed for later use. $ $ on error then goto CLEANUP $ on control_y then goto CLEANUP $ $ write sys$output - "|MON K |WOR 33 H |GRA 1,35 |SHR |JUM 1 |LEA 172 $|ERA G$13" $ $ TOP: $ file_spec := "''f$search("tekplot.dat;*")'" $ if file_spec .eqs. "" then goto cleanup $ run [voyager.library]plotout $ write sys$output "|JUM 1 1" $ write sys$output "|HCO" $ wait 00:00:12 ! Because H-copy unit needs time $ write sys$output "|ERA G$13" $ rename tekplot.dat; tekhold.dat; $ goto TOP $ $ CLEANUP: $ rename tekhold.dat;* tekplot.dat;* $ write sys$output "|MON 34 H K |LEA 172 172" $ $ if VERIFY_SAVE then set verify vybackup.com_2000066403252300000050000000013641032256174200136520ustar00ksimmons00005460002003$ VERIFY_SAVE='F$VERIFY("NO") ! ! BACKUP.COM DOES THE NECESSARY TAPE DRIVE ! COMMANDS TO BACK UP A VY TAPE LOADED ON ! MT1: ONTO AN UNINITIALIZED TAPE LOADED ON ! MT0:. PARAMETER P1 MUST BE SUPPLIED ON THE ! COMMAND LINE AND IS THE NAME OF THE TAPE ! TO BE BACKED UP. ! $ MOU MT1: 'P1' $ INI MT0: 'P1'/DENSITY=1600 $ MOU MT0: 'P1' $ LABEL:='P1' $ WRITE SYS$OUTPUT "" $ WRITE SYS$OUTPUT "" $ WRITE SYS$OUTPUT "...BACKING UP ",LABEL,"......" $ COPY MT1:*.*;* MT0:*.*;* $ DISMOUNT MT1: $ WRITE SYS$OUTPUT "|ERA|WOR 34|WOR H" $ WRITE SYS$OUTPUT "|ILI 3" $ WRITE SYS$OUTPUT LABEL," (B)" $ WRITE SYS$OUTPUT "|ILI 2" $ DIR/SIZE/DATE MT0: $ DISMOUNT MT0: $ WRITE SYS$OUTPUT "" $ SHOW TIME $ WRITE SYS$OUTPUT "|UP 100|LEFT 80|HCO" $ IF VERIFY_SAVE THEN SET VERIFY vydir.com_14000066403252300000050000000012571032256174300132500ustar00ksimmons00005460002003$ VERIFY_SAVE='F$VERIFY("NO") ! ! VYDIR IS USED TO MAKE ENTRIES FOR VOYAGER TAPE LOGS AFTER NEW ! ENTRIES HAVE BEEN MADE ON A VY TAPE. PARAMETER P1 IS THE NAME OF ! THE TAPE. ! $ SET NOON $ LABEL:='P1' $ INQUIRE DRVSYM "ENTER NAME OF ALLOCATED DRIVE" $ DISMOUNT 'DRVSYM'/NOUNLO $ ALL 'DRVSYM' DRIVE $ MOU DRIVE 'P1' $ WRITE SYS$OUTPUT "" $ WRITE SYS$OUTPUT "" $ WRITE SYS$OUTPUT "...TAKING DIRECTORY OF ",LABEL,"......" $ WRITE SYS$OUTPUT "|ERA|WOR 34|WOR H" $ WRITE SYS$OUTPUT "|ILI 3" $ WRITE SYS$OUTPUT LABEL $ WRITE SYS$OUTPUT "|ILI 2" $ DIR/SIZE/DATE DRIVE $ DISMOUNT DRIVE $ WRITE SYS$OUTPUT "" $ SHOW TIME $ WRITE SYS$OUTPUT "|UP 100|LEFT 80|HCO" $ IF VERIFY_SAVE THEN SET VERIFY vymou2.com_1000066403252300000050000000001361026755572600132770ustar00ksimmons00005460002003$ MOU/FOREIGN/BLOCKSIZE=8000/DENSITY=1600 'p1' $ MOU/FOREIGN/BLOCKSIZE=8000/DENSITY=1600 'p2' vymtc.cmd_6000066403252300000050000000000671026755572700131760ustar00ksimmons00005460002003VYMTC/CP=MTC / ASG=TI:3 TASK=VYMTC PAR=GEN:0:100000 // vyu.pro_7000066403252300000050000000116011026755573100127040ustar00ksimmons00005460002003 PRO VYU,LUN,IREC,DATA,FDSC,BA,BS,NS ;MAR 14, 86 ; READ VOYAGER REFORMATTED SCIENCE FILES, RECORD BY RECORD ; ASSUMING SATURN SEQUENCING FORMAT: F4A6,F6A6,F6A7,F4A7,F4A6 ; BA=OUTPUT OF 5 AVERAGES OF BEST DATA POINTS PER GROUP ; BS =STAT. FOR BEST POINTS PER GROUP ; NS IS THEN # POINTS USED IN BA AND BS ; DATA=ORIGIONAL 80*3 ARRAY OF STATUS,LOW,HIGH(PACKED) ; IREC=START REC (**NOTE:SHOULD BE THE HEADER REC#) ; CHANGES THE VALUE TO MAIN PROGRAM ; ASSUME FILE IS ALREADY OPENED ; OPENR,LUN,'[201,211]RT9012.V1;1',256*1*2 ; UPDATED IN JUNE, 83 FOR XIDL (INSERT OFFSETS>SHIFTS) ; UPDATED IN JULY, 83 TO CHECK D.STATUS FOR TIMING, ; ELIMINATES 'AVG' GROUP VALUES AND LEAVES 'BEST', ; SKIPS ENG. BY ITSELF W/O USER CHECKING. ; UPDATED OCT,84 FOR THE NEW URANUS ANA.TABLE TIMING ; ([F4A7,]F4A6,F6A6,F6A7,F4A7) ; 1ST F4A7 IS DISREGARDED SINCE ONLY 2 PTS ; Corrected Mar 14,86 for error in Sigma Calc. ; (zeores prev. incl.) ; IDAT=ASSOC(LUN,INTARR(256)) DATA=FLTARR(256)-1. FDSC=FLTARR(3) LEN=0 STEP1: IHDR=IDAT(IREC) FDSC(0)=IHDR(8) IF FDSC(0) LE 0. THEN FDSC(0)=FDSC(0)+65536. FDSC(1)=IHDR(9) FDSC(2)=IHDR(10) IF IHDR(255) NE -1 THEN BEGIN IREC=IREC+1 IF IREC GT 12000 THEN RETURN ELSE GOTO,STEP1 END COMPAR: LEN=IHDR(27) IF LEN EQ 80 THEN GOTO,GS3 IF LEN EQ 16 THEN GOTO,GS3 IF LEN EQ 600 THEN GOTO,OC1 LENE=(LEN/256)>0 RLEN=LEN/256. IF RLEN GT LEN/256 THEN LENE=(LEN/256)+1 IREC=IREC+LENE+1 GOTO,STEP1 GS3: IDATA=IDAT(IREC+1) IREC=IREC+2 GENSCI,IDATA,DATA,BA,BS,NS RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; PRO GENSCI,IDATA,DATA,BA,BS,NB ; DOES THE GS-3 FORMATING & EXTRACTION OF F/A GROUPS ID1=INTARR(80) ID2=INTARR(80) BA=FLTARR(4) & BS=BA & NB=BA ID3=ID2 INSERT,ID1,EXTRACT(IDATA,80,80),0 ;TOPS INSERT,ID2,EXTRACT(IDATA,160,80),0 ;BOTS ID3=ISHFT(ID2,-5) ;SHIFT TO REMOV LOWER BITS ID3=ID3*32. ID2=ID2-ID3 DATA=ID1*32.+ID2 ; USING ID3, EXTRACT DIGITAL STATUS AND GO OF AND CHECK IT INSERT,ID3,EXTRACT(IDATA,0,80),0 STATUS,ID3,NFLAG,ISS,ICS ; NFLAG=1 IF TIMING IS NON-STANDARD; ISS=SATURN STANDARD TIMING ; ARRAY AND ICS IS CURRENT STATUS TIMING ARRAY(ISS(0)=46 FOR ; F=4/A=6) ; ASSEMBLE 4 BEST POINTS FROM THE 80 D2=EXTRACT(DATA, 4,18) ;THEREFORE ONLY HAVE 4 SETS D3=EXTRACT(DATA,24,18) D4=EXTRACT(DATA,44,18) D5=EXTRACT(DATA,64,16) NZD2=WHERE(D2 GT 0) & N2=!ERR NZD3=WHERE(D3 GT 0) & N3=!ERR NZD4=WHERE(D4 GT 0) & N4=!ERR NZD5=WHERE(D5 GT 0) & N5=!ERR ; ; NONZERO,D2,18,N2 ; NONZERO,D3,18,N3 ; NONZERO,D4,18,N4 ; NONZERO,D5,16,N5 ; BA(0)=TOTAL(D2)/N2 ; BA(1)=TOTAL(D3)/N3 ; BA(2)=TOTAL(D4)/N4 ; BA(3)=TOTAL(D5)/N5 BA(0)=TOTAL(D2(NZD2))/N2 BA(1)=TOTAL(D3(NZD3))/N3 BA(2)=TOTAL(D4(NZD4))/N4 BA(3)=TOTAL(D5(NZD5))/N5 NB(0)=N2 & NB(1)=N3 & NB(2)=N4 & NB(3)=N5 ; TEMP=(D2(NZD2)-BA(0)) & TEMP=TEMP*TEMP & BS(0)=TOTAL(TEMP)/N2 TEMP=(D3(NZD3)-BA(1)) & TEMP=TEMP*TEMP & BS(1)=TOTAL(TEMP)/N3 TEMP=(D4(NZD4)-BA(2)) & TEMP=TEMP*TEMP & BS(2)=TOTAL(TEMP)/N4 TEMP=(D5(NZD5)-BA(3)) & TEMP=TEMP*TEMP & BS(3)=TOTAL(TEMP)/N5 BS=SQRT(BS)/2. RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; ; DO OCC CASE IN A SUBROUTINE PRO VYOCC,IDAT,DATA,IREC DATA=FLTARR(600) & IOC=1 ID3=INTARR(256) & TEMP=FLTARR(256) LOOP: IDATA=IDAT(IREC+3+IOC) ;SKIP STAT, READ TOPS IDAT2=IDAT(IREC+6+IOC) ;READ BOTS ; ID3=ISHFT(IDAT2,-5) DEC 03 ; ID3=ID3*32 DEC 03 ; IDAT2=IDAT2-ID3 DEC 03 ; TEMP=IDATA*32.+IDAT2 DEC 03 TEMP=IDAT2 ;DEC 03,81 INSERT,DATA,TEMP,(IOC-1)*256 IOC=IOC+1 & IF IOC LT 4 THEN GOTO,LOOP IREC=IREC+10 RETURN END ; ; PRO NONZERO,AIN,NPTS,NZ ;AUG 18, 81 ; DETERMINES # NON-ZERO POINTS IN THE INPUT ARRAY(AIN) ; AIN IS NPTS LONG M=FLTARR(NPTS)+1 M=M*(AIN<1) NZ=TOTAL(M) RETURN & END ; ; PRO VY,IUNIT,IREC,DATA,FDS ;JUN 20,83 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO VYS,IUNIT,IREC,DATA,FDS,B,BS,NS ;OCT 1, 84 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO STATUS,IST,NONSTD,IS1,IS2 ;AUG 16,83 ; DECONVOLVES THE DIGITAL STATUS WORD ; CONPARES F/A TIMING TO THE SATURN STANDARD ; WARNS IF: 1) NON-STANDARD TIMING ; 2) J-MODE CHANGES DURING FRAME ; 3) OVERFLOW FLAG IS SET DURING FRAME ; IST=FIX(IST) IFL=INTARR(80) IAN=IFL & IS1=IFL & IS2=IFL IFL=(IST AND "1600) ;FILTER IFL=IFL/128 IAN=(IST AND "160) ;ANA IAN=IAN/16 IS1=(IST AND "4) ;J-MODE IS1=IS1/4 IS2=(IST AND "10) ;O.FLOW IS2=IS2/8 IF TOTAL(IS2) GT 0 THEN PRINT,'D.S. WARNING! OVERFLOW FLAG' J=TOTAL(IS1) IF (J GT 0) AND (J LT 80) THEN PRINT,'D.S. WARNING! J-MODE CHANGE' ; FILL SATURN STANDARD ARRAY (USE IS1 ARRAY) FOR I=0,21 DO IS1(I)=46 FOR I=22,33 DO IS1(I)=66 FOR I=34,61 DO IS1(I)=67 FOR I=62,73 DO IS1(I)=47 FOR I=74,79 DO IS1(I)=46 ; FORM CURRENT CONFIG. ARRAY (USE IS2) IS2=IFL*10+IAN NONSTD=0 IF TOTAL(IS2) NE TOTAL(IS1) THEN BEGIN IF (TOTAL(IS2)/80) EQ IS2(0) THEN GOTO,AROU NONSTD=1 PRINT,' D.S. WARNING! NON-STANDARD TIMING' END RETURN AROU: PRINT,'FIXED F/A=',IS2(0) RETURN & END vyu_idl5.pro_5000066403252300000050000000126701026532443400136160ustar00ksimmons00005460002003 PRO VYU,LUN,IREC,DATA,FDSC,BA,BS,NS ;MAR 14, 86 ;; ;; Updated for IDL V5.x - Jun 4,98 -kes ;; These changes are tagged with ";;" ;; ; READ VOYAGER REFORMATTED SCIENCE FILES, RECORD BY RECORD ; ASSUMING SATURN SEQUENCING FORMAT: F4A6,F6A6,F6A7,F4A7,F4A6 ; BA=OUTPUT OF 5 AVERAGES OF BEST DATA POINTS PER GROUP ; BS =STAT. FOR BEST POINTS PER GROUP ; NS IS THEN # POINTS USED IN BA AND BS ; DATA=ORIGIONAL 80*3 ARRAY OF STATUS,LOW,HIGH(PACKED) ; IREC=START REC (**NOTE:SHOULD BE THE HEADER REC#) ; CHANGES THE VALUE TO MAIN PROGRAM ; ASSUME FILE IS ALREADY OPENED ; OPENR,LUN,'[201,211]RT9012.V1;1',256*1*2 ; UPDATED IN JUNE, 83 FOR XIDL (INSERT OFFSETS>SHIFTS) ; UPDATED IN JULY, 83 TO CHECK D.STATUS FOR TIMING, ; ELIMINATES 'AVG' GROUP VALUES AND LEAVES 'BEST', ; SKIPS ENG. BY ITSELF W/O USER CHECKING. ; UPDATED OCT,84 FOR THE NEW URANUS ANA.TABLE TIMING ; ([F4A7,]F4A6,F6A6,F6A7,F4A7) ; 1ST F4A7 IS DISREGARDED SINCE ONLY 2 PTS ; Corrected Mar 14,86 for error in Sigma Calc. ; (zeores prev. incl.) ; IDAT=ASSOC(LUN,INTARR(256)) DATA=FLTARR(256)-1. FDSC=FLTARR(3) LEN=0 STEP1: IHDR=IDAT(IREC) FDSC(0)=IHDR(8) IF FDSC(0) LE 0. THEN FDSC(0)=FDSC(0)+65536. FDSC(1)=IHDR(9) FDSC(2)=IHDR(10) IF IHDR(255) NE -1 THEN BEGIN IREC=IREC+1 IF IREC GT 12000 THEN RETURN ELSE GOTO,STEP1 END COMPAR: LEN=IHDR(27) IF LEN EQ 80 THEN GOTO,GS3 IF LEN EQ 16 THEN GOTO,GS3 IF LEN EQ 600 THEN GOTO,OC1 LENE=(LEN/256)>0 RLEN=LEN/256. IF RLEN GT LEN/256 THEN LENE=(LEN/256)+1 IREC=IREC+LENE+1 GOTO,STEP1 GS3: IDATA=IDAT(IREC+1) IREC=IREC+2 GENSCI,IDATA,DATA,BA,BS,NS RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; PRO GENSCI,IDATA,DATA,BA,BS,NB ; DOES THE GS-3 FORMATING & EXTRACTION OF F/A GROUPS ID1=INTARR(80) ID2=INTARR(80) BA=FLTARR(4) & BS=BA & NB=BA ID3=ID2 ;; INSERT,ID1,EXTRACT(IDATA,80,80),0 ;TOPS ;; INSERT,ID2,EXTRACT(IDATA,160,80),0 ;BOTS ID1=IDATA(80:159) ;; ID2=IDATA(160:239) ;; ID3=ISHFT(ID2,-5) ;SHIFT TO REMOV LOWER BITS ID3=ID3*32. ID2=ID2-ID3 DATA=ID1*32.+ID2 ; USING ID3, EXTRACT DIGITAL STATUS AND GO OF AND CHECK IT ;; INSERT,ID3,EXTRACT(IDATA,0,80),0 ID3=IDATA(0:79) ;; STATUS,ID3,NFLAG,ISS,ICS ; NFLAG=1 IF TIMING IS NON-STANDARD; ISS=SATURN STANDARD TIMING ; ARRAY AND ICS IS CURRENT STATUS TIMING ARRAY(ISS(0)=46 FOR ; F=4/A=6) ; ASSEMBLE 4 BEST POINTS FROM THE 80 ;; D2=EXTRACT(DATA, 4,18) ;THEREFORE ONLY HAVE 4 SETS ;; D3=EXTRACT(DATA,24,18) ;; D4=EXTRACT(DATA,44,18) ;; D5=EXTRACT(DATA,64,16) D2=DATA(4:4+18-1) D3=DATA(24:24+18-1) D4=DATA(44:44+18-1) D5=DATA(64:64+16-1) NZD2=WHERE(D2 GT 0) & N2=!ERR NZD3=WHERE(D3 GT 0) & N3=!ERR NZD4=WHERE(D4 GT 0) & N4=!ERR NZD5=WHERE(D5 GT 0) & N5=!ERR ; ; NONZERO,D2,18,N2 ; NONZERO,D3,18,N3 ; NONZERO,D4,18,N4 ; NONZERO,D5,16,N5 ; BA(0)=TOTAL(D2)/N2 ; BA(1)=TOTAL(D3)/N3 ; BA(2)=TOTAL(D4)/N4 ; BA(3)=TOTAL(D5)/N5 if n2 le 0 then begin ;; ba(0)=0 endif else begin BA(0)=TOTAL(D2(NZD2))/N2 TEMP=(D2(NZD2)-BA(0)) TEMP=TEMP*TEMP BS(0)=TOTAL(TEMP)/N2 endelse if n3 le 0 then begin ;; ba(1)=0 endif else begin BA(1)=TOTAL(D3(NZD3))/N3 TEMP=(D3(NZD3)-BA(1)) & TEMP=TEMP*TEMP BS(1)=TOTAL(TEMP)/N3 endelse if n4 le 0 then begin ;; ba(2)=0 endif else begin BA(2)=TOTAL(D4(NZD4))/N4 TEMP=(D4(NZD4)-BA(2)) & TEMP=TEMP*TEMP BS(2)=TOTAL(TEMP)/N4 endelse if n5 le 0 then begin ;; ba(3)=0 endif else begin BA(3)=TOTAL(D5(NZD5))/N5 TEMP=(D5(NZD5)-BA(3)) & TEMP=TEMP*TEMP BS(3)=TOTAL(TEMP)/N5 endelse NB(0)=N2 & NB(1)=N3 & NB(2)=N4 & NB(3)=N5 ; BS=SQRT(BS)/2. RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; ; DO OCC CASE IN A SUBROUTINE PRO VYOCC,IDAT,DATA,IREC DATA=FLTARR(600) & IOC=1 ID3=INTARR(256) & TEMP=FLTARR(256) LOOP: IDATA=IDAT(IREC+3+IOC) ;SKIP STAT, READ TOPS IDAT2=IDAT(IREC+6+IOC) ;READ BOTS ; ID3=ISHFT(IDAT2,-5) DEC 03 ; ID3=ID3*32 DEC 03 ; IDAT2=IDAT2-ID3 DEC 03 ; TEMP=IDATA*32.+IDAT2 DEC 03 TEMP=IDAT2 ;DEC 03,81 INSERT,DATA,TEMP,(IOC-1)*256 IOC=IOC+1 & IF IOC LT 4 THEN GOTO,LOOP IREC=IREC+10 RETURN END ; ; PRO NONZERO,AIN,NPTS,NZ ;AUG 18, 81 ; DETERMINES # NON-ZERO POINTS IN THE INPUT ARRAY(AIN) ; AIN IS NPTS LONG M=FLTARR(NPTS)+1 M=M*(AIN<1) NZ=TOTAL(M) RETURN & END ; ; PRO VY,IUNIT,IREC,DATA,FDS ;JUN 20,83 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO VYS,IUNIT,IREC,DATA,FDS,B,BS,NS ;OCT 1, 84 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO STATUS,IST,NONSTD,IS1,IS2 ;AUG 16,83 ; DECONVOLVES THE DIGITAL STATUS WORD ; CONPARES F/A TIMING TO THE SATURN STANDARD ; WARNS IF: 1) NON-STANDARD TIMING ; 2) J-MODE CHANGES DURING FRAME ; 3) OVERFLOW FLAG IS SET DURING FRAME ; IST=FIX(IST) IFL=INTARR(80) IAN=IFL & IS1=IFL & IS2=IFL IFL=(IST AND "1600) ;FILTER IFL=IFL/128 IAN=(IST AND "160) ;ANA IAN=IAN/16 IS1=(IST AND "4) ;J-MODE IS1=IS1/4 IS2=(IST AND "10) ;O.FLOW IS2=IS2/8 IF TOTAL(IS2) GT 0 THEN PRINT,'D.S. WARNING! OVERFLOW FLAG' J=TOTAL(IS1) IF (J GT 0) AND (J LT 80) THEN PRINT,'D.S. WARNING! J-MODE CHANGE' ; FILL SATURN STANDARD ARRAY (USE IS1 ARRAY) FOR I=0,21 DO IS1(I)=46 FOR I=22,33 DO IS1(I)=66 FOR I=34,61 DO IS1(I)=67 FOR I=62,73 DO IS1(I)=47 FOR I=74,79 DO IS1(I)=46 ; FORM CURRENT CONFIG. ARRAY (USE IS2) IS2=IFL*10+IAN NONSTD=0 IF TOTAL(IS2) NE TOTAL(IS1) THEN BEGIN IF (TOTAL(IS2)/80) EQ IS2(0) THEN GOTO,AROU NONSTD=1 PRINT,' D.S. WARNING! NON-STANDARD TIMING' END RETURN AROU: PRINT,'FIXED F/A=',IS2(0) RETURN & END vyuu.pro_1000066403252300000050000000125151026755573200130710ustar00ksimmons00005460002003 PRO VYU,LUN,IREC,DATA,FDSC,BA,BS,NS ;MAR 14, 86 ; READ VOYAGER REFORMATTED SCIENCE FILES, RECORD BY RECORD ; ASSUMING SATURN SEQUENCING FORMAT: F4A6,F6A6,F6A7,F4A7,F4A6 ; BA=OUTPUT OF 5 AVERAGES OF BEST DATA POINTS PER GROUP ; BS =STAT. FOR BEST POINTS PER GROUP ; NS IS THEN # POINTS USED IN BA AND BS ; DATA=ORIGIONAL 80*3 ARRAY OF STATUS,LOW,HIGH(PACKED) ; IREC=START REC (**NOTE:SHOULD BE THE HEADER REC#) ; CHANGES THE VALUE TO MAIN PROGRAM ; ASSUME FILE IS ALREADY OPENED ; OPENR,LUN,'[201,211]RT9012.V1;1',256*1*2 ; UPDATED IN JUNE, 83 FOR XIDL (INSERT OFFSETS>SHIFTS) ; UPDATED IN JULY, 83 TO CHECK D.STATUS FOR TIMING, ; ELIMINATES 'AVG' GROUP VALUES AND LEAVES 'BEST', ; SKIPS ENG. BY ITSELF W/O USER CHECKING. ; UPDATED OCT,84 FOR THE NEW URANUS ANA.TABLE TIMING ; ([F4A7,]F4A6,F6A6,F6A7,F4A7) ; 1ST F4A7 IS DISREGARDED SINCE ONLY 2 PTS ; Corrected Mar 14,86 for error in Sigma Calc. ; (zeores prev. incl.) ; IDAT=ASSOC(LUN,INTARR(256)) DATA=FLTARR(256)-1. FDSC=FLTARR(3) LEN=0 STEP1: IHDR=IDAT(IREC) FDSC(0)=IHDR(8) IF FDSC(0) LE 0. THEN FDSC(0)=FDSC(0)+65536. FDSC(1)=IHDR(9) FDSC(2)=IHDR(10) IF IHDR(255) NE -1 THEN BEGIN IREC=IREC+1 IF IREC GT 12000 THEN RETURN ELSE GOTO,STEP1 END COMPAR: LEN=IHDR(27) IF LEN EQ 80 THEN GOTO,GS3 IF LEN EQ 16 THEN GOTO,GS3 IF LEN EQ 600 THEN GOTO,OC1 LENE=(LEN/256)>0 RLEN=LEN/256. IF RLEN GT LEN/256 THEN LENE=(LEN/256)+1 IREC=IREC+LENE+1 GOTO,STEP1 GS3: IDATA=IDAT(IREC+1) IREC=IREC+2 GENSCI,IDATA,DATA,BA,BS,NS RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; PRO GENSCI,IDATA,DATA,BA,BS,NB ; DOES THE GS-3 FORMATING & EXTRACTION OF F/A GROUPS ID1=INTARR(80) ID2=INTARR(80) BA=FLTARR(4) & BS=BA & NB=BA ID3=ID2 INSERT,ID1,EXTRACT(IDATA,80,80),0 ;TOPS INSERT,ID2,EXTRACT(IDATA,160,80),0 ;BOTS ID3=ISHFT(ID2,-5) ;SHIFT TO REMOV LOWER BITS ID3=ID3*32. ID2=ID2-ID3 DATA=ID1*32.+ID2 ; DATEDIT,DATA ;Check to see if data needs editing ; USING ID3, EXTRACT DIGITAL STATUS AND GO OF AND CHECK IT INSERT,ID3,EXTRACT(IDATA,0,80),0 STATUS,ID3,NFLAG,ISS,ICS ; NFLAG=1 IF TIMING IS NON-STANDARD; ISS=SATURN STANDARD TIMING ; ARRAY AND ICS IS CURRENT STATUS TIMING ARRAY(ISS(0)=46 FOR ; F=4/A=6) ; ASSEMBLE 4 BEST POINTS FROM THE 80 D2=EXTRACT(DATA, 4,18) ;THEREFORE ONLY HAVE 4 SETS D3=EXTRACT(DATA,24,18) D4=EXTRACT(DATA,44,18) D5=EXTRACT(DATA,64,16) NZD2=WHERE(D2 GT 0) & N2=!ERR NZD3=WHERE(D3 GT 0) & N3=!ERR NZD4=WHERE(D4 GT 0) & N4=!ERR NZD5=WHERE(D5 GT 0) & N5=!ERR ; ; NONZERO,D2,18,N2 ; NONZERO,D3,18,N3 ; NONZERO,D4,18,N4 ; NONZERO,D5,16,N5 ; BA(0)=TOTAL(D2)/N2 ; BA(1)=TOTAL(D3)/N3 ; BA(2)=TOTAL(D4)/N4 ; BA(3)=TOTAL(D5)/N5 BA(0)=TOTAL(D2(NZD2))/N2 BA(1)=TOTAL(D3(NZD3))/N3 BA(2)=TOTAL(D4(NZD4))/N4 BA(3)=TOTAL(D5(NZD5))/N5 NB(0)=N2 & NB(1)=N3 & NB(2)=N4 & NB(3)=N5 ; TEMP=(D2(NZD2)-BA(0)) & TEMP=TEMP*TEMP & BS(0)=TOTAL(TEMP)/N2 TEMP=(D3(NZD3)-BA(1)) & TEMP=TEMP*TEMP & BS(1)=TOTAL(TEMP)/N3 TEMP=(D4(NZD4)-BA(2)) & TEMP=TEMP*TEMP & BS(2)=TOTAL(TEMP)/N4 TEMP=(D5(NZD5)-BA(3)) & TEMP=TEMP*TEMP & BS(3)=TOTAL(TEMP)/N5 BS=SQRT(BS)/2. RETURN OC1: DUM=0 VYOCC,IDAT,DATA,IREC RETURN END ; ; ; DO OCC CASE IN A SUBROUTINE PRO VYOCC,IDAT,DATA,IREC DATA=FLTARR(600) & IOC=1 ID3=INTARR(256) & TEMP=FLTARR(256) LOOP: IDATA=IDAT(IREC+3+IOC) ;SKIP STAT, READ TOPS IDAT2=IDAT(IREC+6+IOC) ;READ BOTS ; ID3=ISHFT(IDAT2,-5) DEC 03 ; ID3=ID3*32 DEC 03 ; IDAT2=IDAT2-ID3 DEC 03 ; TEMP=IDATA*32.+IDAT2 DEC 03 TEMP=IDAT2 ;DEC 03,81 INSERT,DATA,TEMP,(IOC-1)*256 IOC=IOC+1 & IF IOC LT 4 THEN GOTO,LOOP IREC=IREC+10 RETURN END ; ; PRO NONZERO,AIN,NPTS,NZ ;AUG 18, 81 ; DETERMINES # NON-ZERO POINTS IN THE INPUT ARRAY(AIN) ; AIN IS NPTS LONG M=FLTARR(NPTS)+1 M=M*(AIN<1) NZ=TOTAL(M) RETURN & END ; ; PRO VY,IUNIT,IREC,DATA,FDS ;JUN 20,83 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO VYS,IUNIT,IREC,DATA,FDS,B,BS,NS ;OCT 1, 84 VYU,IUNIT,IREC,DATA,FDS,B,BS,NS RETURN & END ; ; PRO STATUS,IST,NONSTD,IS1,IS2 ;AUG 16,83 ; DECONVOLVES THE DIGITAL STATUS WORD ; CONPARES F/A TIMING TO THE SATURN STANDARD ; WARNS IF: 1) NON-STANDARD TIMING ; 2) J-MODE CHANGES DURING FRAME ; 3) OVERFLOW FLAG IS SET DURING FRAME ; IST=FIX(IST) IFL=INTARR(80) IAN=IFL & IS1=IFL & IS2=IFL IFL=(IST AND "1600) ;FILTER IFL=IFL/128 IAN=(IST AND "160) ;ANA IAN=IAN/16 IS1=(IST AND "4) ;J-MODE IS1=IS1/4 IS2=(IST AND "10) ;O.FLOW IS2=IS2/8 IF TOTAL(IS2) GT 0 THEN PRINT,'D.S. WARNING! OVERFLOW FLAG' J=TOTAL(IS1) IF (J GT 0) AND (J LT 80) THEN PRINT,'D.S. WARNING! J-MODE CHANGE' ; FILL SATURN STANDARD ARRAY (USE IS1 ARRAY) FOR I=0,21 DO IS1(I)=46 FOR I=22,33 DO IS1(I)=66 FOR I=34,61 DO IS1(I)=67 FOR I=62,73 DO IS1(I)=47 FOR I=74,79 DO IS1(I)=46 ; FORM CURRENT CONFIG. ARRAY (USE IS2) IS2=IFL*10+IAN NONSTD=0 IF TOTAL(IS2) NE TOTAL(IS1) THEN BEGIN IF (TOTAL(IS2)/80) EQ IS2(0) THEN GOTO,AROU NONSTD=1 PRINT,' D.S. WARNING! NON-STANDARD TIMING' END RETURN AROU: PRINT,'FIXED F/A=',IS2(0) RETURN & END ; PRO DATEDIT,DATA ; EDIT THE DATA POINTS PLOT,DATA READ,'WANT TO EDIT (Y=1)',YESEDIT IF YESEDIT EQ 0 THEN RETURN READ, 'WHATS A MAX COUNT RATE?',CNTTOP J=0 NEXTE: FOR I=J,79 DO IF DATA(I) GT CNTTOP THEN BEGIN !C=I & PLOT,DATA READ, 'WANT TO MAKE=0 (Y=1)',SMALL IF SMALL EQ 1 THEN DATA(I)=0. ; J=I ENDIF ; GOTO,NEXTE PLOT,DATA READ,'OK (N=1)',OK IF OK EQ 1 THEN STOP RETURN END IONAL 80*3 ARRAY OF STATUS,LOW,HIGH(PACKED) ; IREC=START REC (**NOTE:SHOULD BE THE HEADER REC#) ; CHANGES THE VALUE TO MAIN PROGRAM ; ASSUME FILE IS ALREADY OPENED ;