C DATA SET MAJORITY AT LEVEL TMP AS OF 05/04/81 C ************ 00001 C **MAJORITY** 00002 C ************ 00003 C VERSION JULY 75 (IFAG) 00004 C MAJORITY VOTE NNSS SATELLITE DOPPLER RECEIVER RAW DATA 00005 C IDENTIFY RECEIVER MAKE ('RCVR') 00006 C PROCESS PASS BY PASS AS FOLLOWS 00007 C READ RAW DATA FOR ONE PASS INTO CHARACTER STRING 'ISTR' ('STRING') 00008 C EDIT 'ISTR' INTO CHARACTER ARRAY 'IARR' ('ARRAY') 00009 C MAJORITY VOTE 'IARR' INTO NUMERICAL ARRAYS 'IFIX', 'IVAR' ('MESAGE')00010 C EDIT 4.6 SEC DOPS FROM 'IARR' TO NUMERICAL ARRAY 'IDOP' ('DOPED') 00011 C INPUT FROM CARDS 00012 CARD ONE CONTAINS THE INPUT CHARACTER SET (18A1) 00013 CHAR(1) - CHAR(10) = NUMERALS 00014 CHAR(11) = '=' INJECTION SIGNAL (= FOR MAR AND MVX, QMARK FOR ITT) 00015 CHAR(12) = 'C' CARRIAGE RETURN 00016 CHAR(13) = 'L' LINE FEED 00017 CHAR(14) = 'B' BLANK PAPER TAPE 00018 CHAR(15) = ' ' SPACE 00019 CHAR(16) = '*' END OF PASS SIGNAL (* FOR MAR, / FOR MVX ' ' FOR ITT) 00020 CHAR(17) = '.' NOISE CHARACTER ( ANY OTHER RAW DATA CHARACTER) 00021 CHAR(18) = 'X' NOVOTE VALUE OF 'NUM' IN SUBROUTINE 'IVOTE' 00022 CARD TWO CONTAINS UP TO 80 CHARACTERS DESCRIBING RUN (80A1) 00023 CARD THREE CONTAINS IRCVR,NDS,ILIST (A4,2I4) 00024 C IRCVR = ' MAR' OR ' ITT' OR ' MVX' TO IDENTIFY RECEIVER MAKE 00025 C NDS = NUMBER OF DATA SETS OF NNSS RAW DATA TO BE PROCESSED 00026 C (IN JCL STATEMENTS '//GO.FTXXFYYY DD ...' ALL DATA SETS HAVE 00027 C SAME REFERENCE NUMBER XX = 'IDEV', BUT HAVE INCREMENTED SEQUENCE 00028 C NUMBERS YYY) 00029 C ILIST = LEVEL OF OUTPUT LISTING 00030 C 0 - ONE LINE SUMMARY OF EACH PASS ONLY 00031 C 1 - SUMMARY PLUS ERROR MESSAGES 00032 C 2 - COMPLETE MAJORITY VOTE OUTPUT LISTING 00033 C 3 - COMPLETE INPUT AND OUTPUT LISTING 00034 C FOR EACH INPUT DATA SET THERE ARE TWO CARDS - 00035 CARD FOUR CONTAINS UP TO 80 CHARACTERS DESCRIBING INPUT DATA SET 00036 CARD FIVE CONTAINS 'KPASS(10)' (10I4) 00037 C KPASS = ARRAY IDENTIFYING UP TO 10 SELECTED PASSES TO BE PROCESSED 00038 C IF KPASS(1) = 0 ALL PASSES ARE PROCESSED 00039 C INPUT OF NNSS RECEIVER DATA 00040 C THIS PROGRAM ASSUMES THIS DATA TO BE STORED IN DATA SET 'IDEV', 00041 C FORMATTED INTO 80 CHARACTER RECORDS, THE CHARACTERS BEING 00042 C CODED IN EBCDIC CODE 00043 C OUTPUT 00044 C WRITTEN UNFORMATTED ONTO DATA SET 'IOUT' FOR EACH ACCEPTED PASS - 00045 C IRCVR = INTEGER IDENTIFYING RECEIVER MAKE (1,2 OR 3) 00046 C NROW2 = NUMBER OF ROWS PER TWO-MINUTE MESSAGE (25 OR 26) 00047 C NDPMSG = NUMBER OF MESSAGES CONTAINING DOPPLER DATA (UP TO 10) 00048 C NVAR = NUMBER OF VARIABLE PARAMETER SETS MAJORITY VOTED (UP TO 17) 00049 C LOCK = INDEX OF VARIABLE PARAMETER SET REFERRING TO LOCK ON TIME 00050 C IFIX(14) = MAJORITY VOTED FIXED PARAMETERS 00051 C IVAR(NVAR) = MAJORITY VOTED VARIABLE PARAMETERS 00052 C IDOP(NROW2,NDPMSG,2) = HIGH AND LOW CHANNEL 4.6 SEC EDITED DOPPLERS 00053 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00054 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00055 INTEGER CODE,CHAR 00056 COMMON /CSTR/ NSTR,ISTR(8000) 00057 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00058 DIMENSION KPASS(10),NAME(20) 00059 C INITIALIZE RUN 00060 C DATA SET REFERENCE NUMBERS 00061 ICR = 5 00062 IPR = 6 00063 IDEV = 1 00064 IOUT = 2 00065 C INPUT CHARACTER STRING LENGTH 00068 NSTR = 8001 00069 C INPUT CHARACTER SET 00070 READ(ICR,1000) CHAR 00071 WRITE(IPR,1005) CHAR 00072 WRITE(IPR,1001) 00073 CALL RCVR 00074 IDS = 0 00075 C INITIALIZE DATA SET 00076 10 IDS = IDS + 1 00077 IEDS = 0 00078 NPASS = 0 00079 IKEPT = 0 00080 IPAGE = 0 00081 C DETERMINE PROGRAM MODE FOR CURRENT DATA SET 00082 READ(ICR,1002) NAME,KPASS 00083 WRITE(IPR,1003) NAME 00084 WRITE(IPR,1004) 00085 IF(KPASS(1) .EQ. 0) GO TO 60 00086 C PROGRAM MODE = PROCESS UP TO 10 SELECTED PASSES 00087 KLIST = ILIST 00088 DO 30 I = 1,10 00089 IF(KPASS(I) .EQ. 0) GO TO 40 00090 ILIST = 0 00091 J1 = NPASS + 1 00092 NPASS = KPASS(I) 00093 DO 20 J = J1,NPASS 00094 IF(J .EQ. NPASS) ILIST = 3 00095 IF(IEDS .NE. 0) GO TO 50 00096 CALL STRING 00097 IF(NSTR .LT. 1000) GO TO 50 00098 20 CONTINUE 00099 CALL ARRAY 00100 IF(NULL .NE. 0) GO TO 25 00101 CALL MESAGE 00102 CALL DOPED 00103 25 CALL LIST 00104 30 CALL STORE 00105 40 ILIST = 0 00106 IF(IEDS .NE. 0) GO TO 50 00107 CALL STRING 00108 IF(NSTR .LT. 1000) GO TO 50 00109 GO TO 40 00110 50 ILIST = KLIST 00111 GO TO 80 00112 C PROGRAM MODE = PROCESS ALL PASSES IN DATA SET 00113 60 NPASS = NPASS + 1 00114 IF(IEDS .NE. 0) GO TO 80 00115 CALL STRING 00116 IF(NSTR .LT. 1000) GO TO 80 00117 CALL ARRAY 00118 IF(NULL .NE. 0) GO TO 70 00119 CALL MESAGE 00120 CALL DOPED 00121 70 IF(ILIST .GE. 2) CALL LIST 00122 CALL STORE 00123 GO TO 60 00124 80 IF(IDS .LT. NDS) GO TO 10 00125 END FILE IOUT 00126 REWIND IOUT 00127 WRITE(IPR,1001) 00128 RETURN 00129 C FORMAT STATEMENTS 00130 1000 FORMAT(18A1) 00131 1001 FORMAT(1H1,10(/),25X,23HPROGRAM MAJORITY OUTPUT ) 00132 1002 FORMAT(20A4/10I4) 00133 1003 FORMAT(1H1,50X,20A4//) 00134 1004 FORMAT(10H PASS KEPT,8X,15HCOL ROW MSG SAT,20X,9HINJECTION,3X, 00135 * 6HLOCKON,5X,29HNON ZERO DOPPLERS PER MESSAGE ) 00136 1005 FORMAT(5X,20HINPUT CHARACTER SET , 20(A1,1X)) 00137 END 00138 C 00139 SUBROUTINE RCVR 00140 C IDENTIFY RECEIVER 00141 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00142 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00143 INTEGER CODE,CHAR 00144 DIMENSION TITLE(20) 00145 DATA MAR7,MAR8,MAR9,ITT,MVX/4HMAR7,4HMAR8,4HMAR9,4H ITT,4H MVX/ 00146 DATA IBLANK/4H / 00147 IF(ILIST .GE. 1) WRITE(IPR,1000) 00148 READ(ICR,1001) TITLE,IRCVR,NDS,ILIST 00149 C SET UP DEFAULTS 00150 IF(IRCVR .EQ. IBLANK) IRCVR = MAR9 00151 IF(NDS .EQ. 0) NDS = 1 00152 C SELECT RECEIVER 00153 IF(IRCVR .EQ. MAR7) GO TO 10 00154 IF(IRCVR .EQ. MAR8) GO TO 40 00155 IF(IRCVR .EQ. MAR9) GO TO 50 00156 IF(IRCVR .EQ. ITT) GO TO 20 00157 IF(IRCVR .EQ. MVX) GO TO 30 00158 WRITE(IPR,1002) 00159 STOP 00160 C MARCONI CMA-722 RECEIVER (WITH NO FRACTIONAL COUNTS = 7 DIGIT DOPS) 00161 10 WRITE(IPR,1003) IRCVR,NDS,TITLE 00162 IRCVR = 1 00163 NROW2 = 25 00164 MCHARS = 650 00165 I2000 = 0 00166 RETURN 00167 C ITT 5001 RECEIVER (UNB CONFIGURATION) 00168 20 WRITE(IPR,1003) IRCVR,NDS,TITLE 00169 IRCVR = 2 00170 NROW2 = 26 00171 MCHARS = 589 00172 I2000 = 2000 00173 RETURN 00174 C MVX 702 RECEIVER 00175 30 WRITE(IPR,1003) IRCVR,NDS,TITLE 00176 IRCVR = 3 00177 NROW2 = 25 00178 MCHARS = 600 00179 I2000 = 0 00180 RETURN 00181 C MARCONI 722B RECEIVER WITH ONE FRACTIONAL DIGIT COUNT = 8 DIGIT DOPS 00182 40 WRITE(IPR,1003) IRCVR,NDS,TITLE 00183 IRCVR = 4 00184 NROW2 = 25 00185 MCHARS = 700 00186 I2000 = 0 00187 RETURN 00188 C MARCONI 722B RECEIVER WITH TWO FRACTIONAL DIGIT COUNTS = 9 DIGIT DOPS 00189 50 WRITE(IPR,1003) IRCVR,NDS,TITLE 00190 IRCVR = 5 00191 NROW2 = 25 00192 MCHARS = 750 00193 I2000 = 0 00194 RETURN 00195 C FORMAT STATEMENTS 00196 1000 FORMAT(1X,30HSUBROUTINE RCVR ENTERED ) 00197 1001 FORMAT(20A4/A4,2I4) 00198 1002 FORMAT(34H1 CANNOT IDENTIFY MAKE OF RECEIVER ) 00199 1003 FORMAT( 26X,11HRECEIVER ,A4/25X,19HNUMBER OF DATA SETS ,I5/ 00200 * 25X,20A4) 00201 END 00202 C 00203 SUBROUTINE STRING 00204 C READ RAW DATA FOR ONE PASS INTO CHARACTER STRING 'ISTR' 00205 C INPUT 00206 C 80 CHARACTER RECORDS FROM DATA SET 'IDEV' 00207 C OUTPUT 00208 C ISTR(NSTR) WHERE LENGTH 'NSTR' IS FOUND BY DETECTING BEGINNING AND 00209 C ENDING OF PASS 00210 C ELEMENTS 'NSTR+1' TO 'KSTR' OF 'ISTR' REMAIN FOR NEXT CALL 00211 C BEGINNING OF PASS SIGNALLED BY FIRST NUMERAL 00212 C END OF PASS SIGNALLED BY CHAR(16) OR TEN CONSECUTIVE NON-NUMERICS 00213 C OR SEVEN CONSECUTIVE '9' (BEGINNING OF NEXT PASS) 00214 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00215 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00216 INTEGER CODE,CHAR 00217 COMMON /CSTR/ NSTR,ISTR(8000) 00218 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00219 EQUIVALENCE(CHAR(10),NINE),(CHAR(15),IBLANK),(CHAR(16),IAST) 00220 DATA KSTR/8000/ 00221 DATA ITOP/0/ 00222 IF(ILIST .GE. 1) WRITE(IPR,1000) 00223 C BOTTOM ARRAY AND REFILL IT 00224 10 IF(IEDS .NE. 0) RETURN 00225 15 CONTINUE 00226 IBOT = NSTR + 1 00227 CALL SHIFT(IBOT,ITOP) 00228 NSTR = 0 00229 IEOP = 0 00230 C FIND BEGINNING OF PASS (FIRST NUMERAL) 00231 DO 20 I = 1,ITOP 00232 DO 20 J = 1,10 00233 IF(ISTR(I) .EQ. CHAR(J)) GO TO 30 00234 20 CONTINUE 00235 C NO BEGINNING OF PASS FOUND - REJECT WHOLE ARRAY 00236 IF(ILIST .GE. 3) WRITE(IPR,1006) ITOP 00237 IF(ILIST .GE. 3) WRITE(IPR,1005) (ISTR(I),I=1,ITOP) 00238 ITOP = 0 00239 GO TO 10 00240 C BEGINNING OF PASS FOUND 00241 30 IBOP = I 00242 IF(IBOP .EQ. 1) GO TO 35 00243 C PRINT REJECTED CHARACTERS 00244 NREJ = IBOP - 1 00245 IF(ILIST .GE. 3) WRITE(IPR,1006) NREJ 00246 IF(ILIST .GE. 3) WRITE(IPR,1005) (ISTR(I),I=1,NREJ) 00247 CALL SHIFT(IBOP,ITOP) 00248 C FIND END OF PASS - FIRST 20 CHARACTERS ARE NINES 00249 35 CONTINUE 00250 I9 = 0 00251 IS = 0 00252 DO 90 I = 21,ITOP 00253 IF(ISTR(I) .EQ. IAST) GO TO 100 00254 IF(ISTR(I) .EQ. NINE) GO TO 60 00255 DO 40 J = 12,17 00256 IF(ISTR(I) .EQ. CHAR(J)) GO TO 70 00257 40 CONTINUE 00258 GO TO 80 00259 C END OF PASS SIGNALLED BY 7 NINES 00260 60 IS = 0 00261 I9 = I9 + 1 00262 IF(I9 .GE. 7) GO TO 100 00263 GO TO 90 00264 C END OF PASS SIGNALLED BY 10 NON-NUMERICS 00265 70 I9 = 0 00266 IS = IS + 1 00267 IF(IS .GE. 10) GO TO 100 00268 GO TO 90 00269 80 I9 = 0 00270 IS = 0 00271 90 CONTINUE 00272 C NO END OF PASS FOUND - REJECT WHOLE ARRAY 00273 IF(ILIST .GE. 3) WRITE(IPR,1006) ITOP 00274 IF(ILIST .GE. 3) WRITE(IPR,1005) (ISTR(I),I=1,ITOP) 00275 ITOP = 0 00276 GO TO 15 00277 C END OF PASS FOUND (ASTERISK, OR 7 NINES, OR 10 NON-NUMERICS) 00278 100 IEOP = I - I9 - IS 00279 NSTR = IEOP 00280 IF(ILIST .GE. 3) WRITE(IPR,1003) NSTR 00281 IF(ILIST .GE. 3) WRITE(IPR,1005) (ISTR(I),I=1,NSTR) 00282 C REJECT PASS IF LESS THAN 1000 CHARACTERS LONG 00283 IF(NSTR .GT. 1000) RETURN 00284 IF(ILIST .GE. 1) WRITE(IPR,1006) NSTR 00285 GO TO 10 00286 C FORMAT STATEMENTS 00287 1000 FORMAT(1X,30HSUBROUTINE STRING ENTERED ) 00288 1003 FORMAT(5X,10HFOUND ,I5,20H CHARACTER PASS ) 00289 1005 FORMAT(10X,100A1) 00290 1006 FORMAT(5X,10HREJECT ,I5,11H CHARACTERS ) 00291 END 00292 SUBROUTINE SHIFT(IBOT,ITOP) 00293 C SHIFT ARRAY TO BOTTOM AND REFILL TO TOP 00294 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00295 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00296 INTEGER CODE,CHAR 00297 COMMON /CSTR/ NSTR,ISTR(8000) 00298 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00299 EQUIVALENCE(CHAR(15),IBLANK) 00300 DATA KSTR/8000/ 00301 IF(ILIST .GE. 1) WRITE(IPR,1000) 00302 C SHIFT ARRAY DOWN 00303 IF(IBOT .GT. KSTR) ITOP = 0 00304 IF(ITOP .EQ. 0) GO TO 20 00305 J = 0 00306 DO 10 I = IBOT,ITOP 00307 J = J + 1 00308 10 ISTR(J) = ISTR(I) 00309 ITOP = J 00310 IF(ILIST .GE. 3) WRITE(IPR,1003) ITOP 00311 C CLEAR TOP OF ARRAY 00312 20 IN1 = ITOP + 1 00313 DO 30 I = IN1,KSTR 00314 30 ISTR(I) = IBLANK 00315 C REFILL TOP OF ARRAY 00316 IF(IEDS .NE. 0) RETURN 00317 IN2 = ITOP + 80 * ((KSTR - ITOP) / 80) 00318 IF(IN1 .GE. IN2) RETURN 00319 CALL RAWIN(IN1,IN2) 00320 C REVISE IN2 IF EOD 00321 IF(IEDS .EQ. 0) GO TO 50 00322 DO 40 I = IN1,IN2 00323 J = IN1 + IN2 - I 00324 IF(ISTR(J) .NE. IBLANK) GO TO 45 00325 40 CONTINUE 00326 45 IN2 = J 00327 50 ITOP = IN2 00328 IF(ILIST .GE. 3) WRITE(IPR,1004) IN1,IN2 00329 RETURN 00330 C FORMAT STATEMENTS 00331 1000 FORMAT(1X,30HSUBROUTINE SHIFT ENTERED ) 00332 1003 FORMAT(5X,10HBOTTOMED ,I5) 00333 1004 FORMAT(5X,10HREAD ,2I5) 00334 END 00335 C 00336 SUBROUTINE RAWIN(IN1,IN2) 00337 C** MACHINE DEPENDENT SUBROUTINE** 00338 C FILL ARRAY ISTR FROM ELEMENT IN1 TO IN2 BY READING 80 CHARACTER 00339 C RECORDS OF RAW DATA FROM DATASET IDEV 00340 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00341 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00342 COMMON /CSTR/ NSTR,ISTR(8000) 00343 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00344 INTEGER CODE,CHAR 00345 IF(ILIST .GE. 1) WRITE(IPR,1000) 00346 READ(IDEV,1001,END=10,ERR=10) (ISTR(I),I=IN1,IN2) 00347 RETURN 00348 10 IEDS = 1 00349 IF(ILIST .GE. 3) WRITE(IPR,1002) 00350 RETURN 00351 1000 FORMAT(1X,30HSUBROUTINE RAWIN ENTERED ) 00352 1001 FORMAT(80A1) 00353 1002 FORMAT(5X,25HEND OF DATA ENCOUNTERED ) 00354 END 00355 C 00356 SUBROUTINE ARRAY 00357 C EDIT CHARACTER STRING 'ISTR(NSTR)' INTO CHARACTER ARRAY 'IARR' 00358 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00359 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00360 INTEGER CODE,CHAR 00361 COMMON /CSTR/ NSTR,ISTR(8000) 00362 COMMON /CARR/ NMESS,IARR(29,26,10) 00363 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00364 IF(ILIST .GE. 1) WRITE(IPR,1000) 00365 JCHAR = 0 00366 C MESSAGE LOOP 00367 DO 200 NMSG = 1,10 00368 NCHARS = 0 00369 C ROW LOOP 00370 DO 170 NROW = 1,NROW2 00371 NCOL = 0 00372 C READ ONE ROW 00373 10 NCOL = NCOL + 1 00374 IF(NCOL .LE. 29) IARR(NCOL,NROW,NMSG) = CHAR(15) 00375 C MVX RECEIVER - STORE SPACES IN COLUMNS 10,20 00376 IF(IRCVR .EQ. 3 .AND. (NCOL.EQ.10.OR.NCOL.EQ.20)) GO TO 10 00377 C MAR7,ITT,MVX RCVRS - STORE ZERO IN COLUMNS 8,9,18,19 00378 IF(IRCVR .LT. 4 .AND.(NCOL.EQ.8.OR.NCOL.EQ.9.OR.NCOL.EQ.18 00379 * .OR.NCOL.EQ.19)) GO TO 15 00380 C MAR8 RCVR - STORE ZERO IN COLUMNS 9,19 00381 IF(IRCVR .EQ. 4 .AND.(NCOL.EQ.9.OR.NCOL.EQ.19)) GO TO 15 00382 C ITT RCVR - STORE ZERO IN COLUMNS 11,12,13 00383 IF(IRCVR .EQ. 2 .AND.(NCOL.EQ.11.OR.NCOL.EQ.12.OR.NCOL.EQ.13))00384 * GO TO 15 00385 GO TO 20 00386 15 IARR(NCOL,NROW,NMSG) = CHAR(1) 00387 GO TO 10 00388 C FETCH CHARACTER FROM STRING 'ISTR' 00389 20 JCHAR = JCHAR + 1 00390 IF(JCHAR .GT. NSTR) GO TO 210 00391 ICHAR = ISTR(JCHAR) 00392 NCHARS = NCHARS + 1 00393 C IDENTIFY 'ICHAR' 00394 DO 30 ID = 1,17 00395 IF(ICHAR .EQ. CHAR(ID)) GO TO 40 00396 30 CONTINUE 00397 GO TO 60 00398 40 IF(ID .LE. 10) GO TO 70 00399 ID = ID - 10 00400 GO TO (70,100,100,60,50,210,70),ID 00401 C ITT,MAR7,MAR8,MAR9 RCVRS - ACCEPT SPACES IN COLUMNS 10,20 00402 50 IF(IRCVR .NE. 3 .AND.(NCOL.EQ.10.OR.NCOL.EQ.20)) GO TO 10 00403 C BLANK OR UNACCEPTABLE SPACES ARE SEQUENCE ERROR 00404 60 IF(ILIST .GE. 1) WRITE(IPR,1001) NCOL,NROW,NMSG 00405 C ACCEPT NUMERALS, INJECTION SIGNALS, NOISE 00406 70 IF(NCOL .GT. 29) GO TO 80 00407 IARR(NCOL,NROW,NMSG) = ICHAR 00408 GO TO 10 00409 C ROW TOO LONG - SKIP TO NEXT CARRIAGE RETURN 00410 80 NCOL = 30 00411 IF(ILIST .GE. 1) WRITE(IPR,1002) NCOL,NROW,NMSG 00412 90 JCHAR = JCHAR + 1 00413 IF(JCHAR .GT. NSTR) GO TO 210 00414 IF(ISTR(JCHAR) .EQ. CHAR(12)) GO TO 100 00415 GO TO 90 00416 C END OF ROW (FOUND CARRIAGE RETURN OR LINE FEED). CRLF IS CORRECT 00417 100 JCHAR = JCHAR + 1 00418 IF(JCHAR .GT. NSTR) GO TO 210 00419 IF(ISTR(JCHAR-1).EQ.CHAR(12).AND.ISTR(JCHAR).EQ.CHAR(13)) 00420 * GO TO 110 00421 JCHAR = JCHAR - 1 00422 IF(ILIST .GE. 1) WRITE(IPR,1003) NROW,NMSG 00423 110 CONTINUE 00424 C MAR RCVR - '*' AFTER END OF ROW MEANS END OF PASS 00425 IF(IRCVR .EQ. 1 .AND.ISTR(JCHAR+1).EQ.CHAR(16)) GO TO 210 00426 C ITT RCVR - CR AT COLUMN 21 MEANS END OF MESSAGE - FILL IN SPACES 00427 IF(IRCVR .NE. 2 .OR. NCOL .NE. 21) GO TO 130 00428 II = NCOL + 1 00429 DO 120 I = II,29 00430 120 IARR(I,NROW,NMSG) = CHAR(15) 00431 GO TO 180 00432 C CR BEFORE COLUMN 30 MEANS ROW TOO SHORT - FILL IN SPACES 00433 130 IF(NCOL .GT. 29) GO TO 150 00434 IF(ILIST .GE. 1) WRITE(IPR,1004) NCOL,NROW,NMSG 00435 IF(NCOL .GE. 29) GO TO 150 00436 II = NCOL + 1 00437 DO 140 I = II,29 00438 140 IARR(I,NROW,NMSG) = CHAR(15) 00439 150 CONTINUE 00440 C IF ROW IS MORE THAN 5 CHARACTERS TOO SHORT ASSUME END OF MESSAGE 00441 IF(NCOL + 5 .LT. 29) GO TO 180 00442 C MAR RCVR - 2 PAIR OF CRLF MEANS END OF MESSAGE 00443 IF(IRCVR.NE.1 .AND. IRCVR.NE.4 .AND. IRCVR.NE.5) GO TO 160 00444 IF(JCHAR + 3 .GT. NSTR) GO TO 210 00445 IF(ISTR(JCHAR-1).NE.CHAR(12).OR.ISTR(JCHAR).NE.CHAR(13).OR. 00446 * ISTR(JCHAR+1).NE.CHAR(12).OR.ISTR(JCHAR+2).NE.CHAR(13)) 00447 * GO TO 160 00448 JCHAR = JCHAR + 2 00449 C MAR RCVR - '*' AFTER END OF MESSAGE MEANS END OF PASS 00450 IF(ISTR(JCHAR+1) .EQ. CHAR(16)) GO TO 210 00451 GO TO 180 00452 C MVX RCVR - 3 PAIRS OF CRLF MEANS END OF MESSAGE 00453 160 IF(IRCVR .NE. 3) GO TO 170 00454 IF(JCHAR+4 .GT. NSTR) GO TO 210 00455 IF(ISTR(JCHAR-1).NE.CHAR(12).OR.ISTR(JCHAR).NE.CHAR(13).OR. 00456 * ISTR(JCHAR+1).NE.CHAR(12).OR.ISTR(JCHAR+2).NE.CHAR(13).OR. 00457 * ISTR(JCHAR+3).NE.CHAR(12).OR.ISTR(JCHAR+4).NE.CHAR(13)) 00458 * GO TO 170 00459 JCHAR = JCHAR + 4 00460 GO TO 180 00461 170 CONTINUE 00462 C END OF MESSAGE - CORRECT LENGTH IS 'NROW2' ROWS AND 'MCHARS' CHARACTER00463 NROW = NROW2 00464 180 IF(NROW .EQ. NROW2 .AND. NCHARS .EQ. MCHARS) GO TO 200 00465 IF(ILIST .GE. 1) WRITE(IPR,1005) NCHARS,NMSG 00466 IF(NROW .GE. NROW2) GO TO 200 00467 C FILL IN SPACES 00468 JJ = NROW + 1 00469 DO 190 J = JJ,NROW2 00470 DO 190 I = 1,29 00471 190 IARR(I,J,NMSG) = CHAR(15) 00472 200 CONTINUE 00473 C END OF PASS 00474 NMSG = 10 00475 IF(ILIST .GE. 1) WRITE(IPR,1006) 00476 210 NMESS = NMSG 00477 IF(NROW .EQ. 1 .OR. NCHARS .LT. 25) NMESS = NMESS - 1 00478 C FILL IN SPACES 00479 IF(NMSG.NE.NMESS.OR.(NROW.EQ.NROW2.AND.NCOL.GT.29)) GO TO 250 00480 IF(NCOL .GE. 29) GO TO 230 00481 II = NCOL + 1 00482 DO 220 I = II,29 00483 220 IARR(I,NROW,NMSG) = CHAR(15) 00484 230 IF(NROW .GE. NROW2) GO TO 250 00485 JJ = NROW + 1 00486 DO 240 J = JJ,NROW2 00487 DO 240 I = 1,29 00488 240 IARR(I,J,NMSG) = CHAR(15) 00489 250 CONTINUE 00490 NULL = 0 00491 IF(NMESS .LT. 2) NULL = 1 00492 RETURN 00493 C FORMAT STATEMENTS 00494 1000 FORMAT(1X,30HSUBROUTINE ARRAY ENTERED ) 00495 1001 FORMAT(10X,9HSEQUENCE ,I3,2I4) 00496 1002 FORMAT(10X,9HLONG ROW ,I3,2I4) 00497 1003 FORMAT(10X,9HCRLF SEQ ,3X,2I4) 00498 1004 FORMAT(10X,9HSHORT ROW,I3,2I4) 00499 1005 FORMAT(10X,7HNCHARS=,I4,5X,I4) 00500 1006 FORMAT(10X,17HMORE THAN 10 MSGS ) 00501 END 00502 C 00503 SUBROUTINE MESAGE 00504 C DETERMINE DATA SPANS TO BE MAJORITY VOTED (FROM INJECTION SIGNALS) 00505 C COMPUTE ARRAY 'NOISE' FOR ALL DATA SPANS (DIFFERENCES FROM MJV DIGITS)00506 C MAJORITY VOTE 'IARR' INTO 'IFIX' AND 'IVAR' FOR LONGEST DATA SPAN 00507 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00508 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00509 INTEGER CODE,CHAR 00510 COMMON /CARR/ NMESS,IARR(29,26,10) 00511 COMMON /VOTE/ NVAR,LOCK,IVAR(26),IFIX(26),MFAIL(26),NFAIL(26), 00512 * NOISE(27,10),KNOISE 00513 DIMENSION INJ(10),INJB(10),INJE(10),INJN(10) 00514 IF(ILIST .GE. 1) WRITE(IPR,1000) 00515 C INITIALIZE ARRAY 'NOISE' 00516 KNOISE = 50 00517 DO 10 NMSG = 1,10 00518 NOISE(27,NMSG) = 234 00519 DO 10 NROW = 1,NROW2 00520 10 NOISE(NROW,NMSG) = 9 00521 C SIGNAL INJECTIONS IN ARRAY 'INJ' 00522 INJ(NMESS) = NMESS 00523 NINJ = 1 00524 II = NMESS - 1 00525 DO 30 I = 1,II 00526 INJ(I) = 0 00527 DO 20 NROW = 23,25 00528 DO 20 NCOL = 21,29 00529 IF(IARR(NCOL,NROW,I) .NE. CHAR(11)) GO TO 30 00530 20 CONTINUE 00531 INJ(I) = I 00532 NINJ = NINJ + 1 00533 30 CONTINUE 00534 IF(ILIST .GE. 1 .AND. NINJ .GT. 1) WRITE(IPR,1001) (INJ(I),I=1,II)00535 C DETERMINE DATA SPANS BETWEEN INJECTIONS.'INJB' AND 'INJE' CONTAIN 00536 C BEGINNING AND ENDING MESSAGES AND 'INJN' LENGTH FOR EACH DATA SPAN 00537 J1 = 1 00538 DO 60 I = 1,NINJ 00539 INJB(I) = J1 00540 DO 40 J = J1,NMESS 00541 IF(INJ(J) .NE. 0) GO TO 50 00542 40 CONTINUE 00543 J = NMESS 00544 50 INJE(I) = J 00545 INJN(I) = INJE(I) - INJB(I) + 1 00546 J1 = J + 1 00547 60 CONTINUE 00548 C IDENTIFY LONGEST DATA SPAN (MAX INJN) 00549 MAX = 0 00550 IMAX = 0 00551 DO 70 I = 1,NINJ 00552 IF(INJN(I) .LE. MAX) GO TO 70 00553 MAX = INJN(I) 00554 IMAX = I 00555 70 CONTINUE 00556 C MAJORITY VOTE EACH DATA SPAN TO EVALUATE 'NOISE'. DO LONGEST LAST. 00557 DO 80 I = 1,NINJ 00558 IF(I .EQ. IMAX) GO TO 80 00559 CALL MAJVOT(INJB(I),INJE(I)) 00560 80 CONTINUE 00561 CALL MAJVOT(INJB(IMAX),INJE(IMAX)) 00562 RETURN 00563 C FORMAT STATEMENTS 00564 1000 FORMAT(1X,30HSUBROUTINE MESAGE ENTERED ) 00565 1001 FORMAT(10X,6HINJECT,10I2) 00566 END 00567 C 00568 SUBROUTINE MAJVOT(KMIN,KMAX) 00569 C MAJORITY VOTE ORBIT PARAMETERS IN 'IARR' INTO NUMERICAL 'IFIX','IVAR' 00570 C FIXED PARAMETERS MJV FROM CHARACTER 'IARR' ROW 9 - 25 00571 C COL 21 - 29 00572 C MSG KMIN - KMAX 00573 C INTO NUMERICAL 'IFIX' ELEMENTS 9 - 25 00574 C EPHEMERALS ARE MJV FROM CHARACTER 'IARR' ROW 1 OF MSG KMIN 00575 C TO ROW 8 OF MSG KMAX 00576 C COL 21 - 29 00577 C INTO NUMERICAL 'IVAR' ELEMENTS 1 TO 8+KMAX-KMIN 00578 C OUTPUT 00579 C LOCK = INDEX OF ELEMENT OF IVAR REFERRING TO LOCK ON 00580 C NVAR = NUMBER OF EPHEMERAL PARAMETERS MJV 00581 C IFIX(NROW2) AND IVAR(NROW2) AS ABOVE 00582 C NFAIL(NROW2) = NUMBER OF MJV FAILURES FOR EACH ELEMENT OF 'IFIX' 00583 C MFAIL(NROW2) = NUMBER OF MJV FAILURES FOR EACH ELEMENT OF 'IVAR' 00584 C NOISE(NROW2,NMESS) = NUMBER OF DISAGREEMENTS WITH MJV VALUES 00585 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00586 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00587 INTEGER CODE,CHAR 00588 COMMON /CARR/ NMESS,IARR(29,26,10) 00589 COMMON /VOTE/ NVAR,LOCK,IVAR(26),IFIX(26),MFAIL(26),NFAIL(26), 00590 * NOISE(27,10),KNOISE 00591 DIMENSION KARRAY(12) 00592 IF(ILIST .GE. 1) WRITE(IPR,1000) 00593 C INITIALIZE ARRAYS 'IFIX','IVAR','NFAIL','MFAIL','NOISE' 00594 DO 10 NROW = 1,NROW2 00595 IFIX(NROW) = 0 00596 IVAR(NROW) = 0 00597 NFAIL(NROW) = 0 00598 10 MFAIL(NROW) = 0 00599 DO 15 NMSG = KMIN,KMAX 00600 DO 15 NROW = 9,NROW2 00601 15 NOISE(NROW,NMSG) = 0 00602 LOCK = 5 - KMIN 00603 C MAJORITY VOTE FIXED PARAMETERS 00604 C EXAMINE EACH CHARACTER BETWEEN ROWS 9 AND 25 OF MESSAGES 00605 C FILL ARRAY 'KARRAY' WITH THE EQUIVALENT CHARACTER FROM EACH MSG 00606 DO 30 NROW = 9,25 00607 DO 30 NCOL = 21,29 00608 NK = 0 00609 DO 20 NMSG = KMIN,KMAX 00610 NK = NK + 1 00611 20 KARRAY(NK) = IARR(NCOL,NROW,NMSG) 00612 C CONVERT SEQUENCE OF MJV CHARACTERS IN ONE ROW INTO AN INTEGER 00613 IFIX(NROW) = IFIX(NROW) * 10 + IVOTE(NK,KARRAY,NOVOTE,NUM) 00614 NFAIL(NROW) = NFAIL(NROW) + NOVOTE 00615 NFAIL(NROW2) = NFAIL(NROW2) + NOVOTE 00616 C COUNT NOISE CHARACTERS 00617 NK = 0 00618 DO 30 NMSG = KMIN,KMAX 00619 NK = NK + 1 00620 IF(KARRAY(NK).NE.NUM) NOISE(NROW,NMSG) = NOISE(NROW,NMSG) +100621 30 CONTINUE 00622 C EXEMPT INJECTION SIGNALS FROM BEING COUNTED AS NOISE 00623 DO 40 NROW = 23,25 00624 DO 40 NCOL = 21,29 00625 IF(IARR(NCOL,NROW,KMAX) .NE. CHAR(11)) GO TO 60 00626 40 CONTINUE 00627 DO 50 NROW = 23,25 00628 50 NOISE(NROW,KMAX) = 0 00629 60 CONTINUE 00630 C SUM NOISE PER MESSAGE FOR FIXED PARAMETERS 00631 DO 65 NMSG = KMIN,KMAX 00632 NOISE(27,NMSG) = 0 00633 DO 65 NROW = 9,22 00634 65 NOISE(27,NMSG) = NOISE(27,NMSG) + NOISE(NROW,NMSG) 00635 C MAJORITY VOTE EPHEMERAL PARAMETERS 00636 C REDUCE KMAX IF LAST MESSAGES NOISY 00637 KMAXV = KMAX 00638 66 IF(NOISE(27,KMAXV) .LT. KNOISE) GO TO 67 00639 KMAXV = KMAXV - 1 00640 GO TO 66 00641 67 CONTINUE 00642 DO 68 NMSG = KMIN,KMAX 00643 DO 68 NROW = 1,8 00644 68 NOISE(NROW,NMSG) = 0 00645 NVAR = 8 + KMAXV - KMIN 00646 C EXAMINE EACH CHARACTER BETWEEN ROW 1,MSG KMIN AND ROW 8,MSG KMAX 00647 C FILL ARRAY 'KARRAY' WITH EQUIVALENT CHARACTERS FROM EACH MESSAGE 00648 DO 80 NROW = 1,NVAR 00649 DO 80 NCOL = 21,29 00650 NK = 0 00651 DO 70 NMSG = KMIN,KMAXV 00652 NLINE = NROW - NMSG + KMIN 00653 IF(NLINE .GT. 8 .OR. NLINE .LT. 1) GO TO 70 00654 NK = NK + 1 00655 KARRAY(NK) = IARR(NCOL,NLINE,NMSG) 00656 70 CONTINUE 00657 C CONVERT SEQUENCE OF MJV CHARACTERS IN ONE ROW INTO AN INTEGER 00658 IVAR(NROW) = IVAR(NROW) * 10 + IVOTE(NK,KARRAY,NOVOTE,NUM) 00659 MFAIL(NROW) = MFAIL(NROW) + NOVOTE 00660 MFAIL(NROW2) = MFAIL(NROW2) + NOVOTE 00661 C COUNT NOISE CHARACTERS 00662 NK = 0 00663 DO 80 NMSG = KMIN,KMAX 00664 NLINE = NROW - NMSG + KMIN 00665 IF(NLINE .GT. 8 .OR. NLINE .LT. 1) GO TO 80 00666 NK = NK + 1 00667 IF(IARR(NCOL,NLINE,NMSG).NE.NUM) NOISE(NLINE,NMSG) = 00668 * NOISE(NLINE,NMSG) + 1 00669 80 CONTINUE 00670 C SUM TOTAL NOISE PER MESSAGE 00671 DO 85 NMSG = KMIN,KMAX 00672 NOISE(27,NMSG) = 0 00673 DO 85 NROW = 1,NROW2 00674 85 NOISE(27,NMSG) = NOISE(27,NMSG) + NOISE(NROW,NMSG) 00675 RETURN 00676 1000 FORMAT(1X,30HSUBROUTINE MAJVOT ENTERED ) 00677 END 00678 C 00679 FUNCTION IVOTE(NIN,KIN,NOVOTE,NUM) 00680 C MAJORITY VOTE ONE MESSAGE DIGIT PER CALL 00681 C INPUT 00682 C KIN(NIN) = ARRAY TO BE MAJORITY VOTED 00683 C OUTPUT 00684 C NUM = MJV CHARACTER 00685 C IVOTE = NUMERICAL VALUE OF MJV CHARACTER ( ZERO IF NON-NUMERIC) 00686 C NOVOTE = 0 FOR SUCCESSFUL MJV 00687 C 1 IF MJV TIE, OR MORE NON-NUMERICS THAN ANY ONE NUMERAL 00688 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00689 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00690 INTEGER CODE,CHAR 00691 DIMENSION KVALUE(11),KIN(12) 00692 C CLEAR ARRAY 'KVALUE' 00693 DO 10 K = 1,11 00694 10 KVALUE(K) = 0 00695 C SORT CONTENTS OF ARRAY 'KIN' BY VALUE INTO ARRAY 'KVALUE' 00696 C KVALUE(11) CONTAINS NUMBER OF NONNUMERICS ENCOUNTERED 00697 DO 30 K = 1,NIN 00698 DO 20 I = 1,10 00699 IF(KIN(K) .EQ. CHAR(I)) GO TO 30 00700 20 CONTINUE 00701 I = 11 00702 30 KVALUE(I) = KVALUE(I) + 1 00703 C IDENTIFY ELEMENT OF KVALUE CONTAINING LARGEST NUMBER 00704 MAX = 0 00705 DO 40 K = 1,11 00706 IF(KVALUE(K) .LE. MAX) GO TO 40 00707 MAX = KVALUE(K) 00708 NVAL = K 00709 40 CONTINUE 00710 C NOVOTE IF NVAL = 11 ( MORE NON-NUMERICS THAN ANY NUMERAL) 00711 IF(NVAL .EQ. 11) GO TO 70 00712 C NOVOTE IF MORE THAN ONE ELEMENT OF 'KVALUE' CONTAINS 'MAX' 00713 IF(NVAL .EQ. 10) GO TO 60 00714 NVALP1 = NVAL + 1 00715 DO 50 K = NVALP1,10 00716 IF(KVALUE(K) .EQ. MAX) GO TO 70 00717 50 CONTINUE 00718 C SUCCESSFUL VOTE RETURN 00719 60 IVOTE = NVAL - 1 00720 NUM = CHAR(NVAL) 00721 NOVOTE = 0 00722 RETURN 00723 C UNSUCCESSFUL VOTE RETURN 00724 70 IVOTE = 0 00725 NUM = CHAR(18) 00726 NOVOTE = 1 00727 RETURN 00728 END 00729 C 00730 SUBROUTINE DOPED 00731 C EDIT DOPPLER DATA FROM CHARACTER 'IARR' INTO NUMERICAL 'IDOP' 00732 C REJECT DOPPLERS IF NON-NUMERIC CHARACTERS IN EITHER CHANNEL (IERR=2,3)00733 C LOSS OF LOCK ON EITHER CHANNEL (IERR=4,5) 00734 C MJV NOISE ON THAT MESSAGE ROW (IERR=8) 00735 C OUTPUT 00736 C NDPMSG = NUMBER OF TWO-MINUTE MESSAGES CONTAINING NON-ZERO DOPPLERS 00737 C NDOP(11) = ARRAY CONTAINING NUMBER OF NON-ZERO DOPPLERS PER MESSAGE 00738 C IDOP(NROW2,NDPMSG,2) = ARRAY CONTAINING ACCEPTED DOPPLERS 00739 C IERR(NROW2,NDPMSG) = ARRAY CONTAINING CAUSES FOR REJECTION 00740 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00741 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00742 COMMON /CARR/ NMESS,IARR(29,26,10) 00743 INTEGER CODE,CHAR 00744 COMMON /VOTE/ NVAR,LOCK,IVAR(26),IFIX(26),MFAIL(26),NFAIL(26), 00745 * NOISE(27,10),KNOISE 00746 COMMON/DOP/NDPMSG,IDOP(26,10,2),IERR(26,10),NDOP(11) 00747 IF(ILIST .GE. 1) WRITE(IPR,1000) 00748 C INITIALIZE ARRAYS 'IDOP', 'IERR', AND 'NDOP' 00749 DO 10 NMSG = 1,10 00750 NDOP(NMSG) = 0 00751 DO 10 NROW = 1,NROW2 00752 IERR(NROW,NMSG) = 1 00753 DO 10 K = 1,2 00754 10 IDOP(NROW,NMSG,K) = 0 00755 NDOP(11) = 0 00756 DO 70 NMSG = 1,NMESS 00757 DO 70 NROW = 1,NROW2 00758 C CONVERT 400 MHZ CHANNEL FROM CHARACTER TO INTEGER 00759 C CHECK FOR NON-NUMERIC CHARACTERS (IERR = 2) 00760 C CHECK FOR 400 MHZ LOSS OF LOCK (IERR = 4) 00761 DO 30 NCOL = 1,9 00762 DO 20 K = 1,10 00763 IF(IARR(NCOL,NROW,NMSG) .EQ. CHAR(K)) GO TO 30 00764 20 CONTINUE 00765 IERR(NROW,NMSG) = 2 00766 IDOP(NROW,NMSG,1) = 0 00767 IDOP(NROW,NMSG,2) = 0 00768 GO TO 70 00769 30 IDOP(NROW,NMSG,1) = IDOP(NROW,NMSG,1) * 10 + K - 1 00770 IF(IDOP(NROW,NMSG,1) .EQ. 0) IERR(NROW,NMSG) = 4 00771 C CONVERT REFRACTION CHANNEL FROM CHARACTER TO INTEGER 00772 C CHECK FOR NON-NUMERIC CHARACTERS (IERR = 2) 00773 C CHECK FOR 400 MHZ LOSS OF LOCK (IERR = 4) 00774 C CHECK FOR REFRACTION CHANNEL LOSS OF LOCK (IERR = 5) 00775 DO 60 NCOL = 11,19 00776 DO 40 K = 1,10 00777 IF(IARR(NCOL,NROW,NMSG) .EQ. CHAR(K)) GO TO 60 00778 40 CONTINUE 00779 C ITT RECEIVER - INJECTION SIGNALS IN REFRACTION CHANNEL MEAN HI UNLOCK 00780 IF(IRCVR.NE.2.OR.IARR(NCOL,NROW,NMSG).NE.CHAR(11)) GO TO 50 00781 IERR(NROW,NMSG) = 4 00782 IDOP(NROW,NMSG,2) = 0 00783 GO TO 70 00784 50 IERR(NROW,NMSG) = 2 00785 IDOP(NROW,NMSG,1) = 0 00786 IDOP(NROW,NMSG,2) = 0 00787 GO TO 70 00788 60 IDOP(NROW,NMSG,2) = IDOP(NROW,NMSG,2) * 10 + K - 1 00789 IF(IDOP(NROW,NMSG,2) .EQ. 0) IERR(NROW,NMSG) = 5 00790 70 CONTINUE 00791 C DETERMINE HOW MANY TWO MINUTE MESSAGES CONTAIN NON-ZERO DOPPLERS 00792 DO 80 K = 1,NMESS 00793 NMSG = NMESS - K + 1 00794 DO 80 J = 1,NROW2 00795 NROW = NROW2 - J + 1 00796 IF(IDOP(NROW,NMSG,1) .NE. 0) GO TO 90 00797 80 CONTINUE 00798 NDPMSG = 0 00799 RETURN 00800 90 NDPMSG = NMESS - K + 1 00801 C CONVERT FROM TWO-MINUTE TO 4.6-SECOND INTEGRATED DOPPLERS 00802 C CONVERT TWO MINUTE VALUES FIRST 00803 DO 110 NMSG = 2,NDPMSG 00804 IDOP1 = 0 00805 IDOP2 = 0 00806 IF(IERR(1,NMSG) .NE. 1 .OR. IERR(NROW2,NMSG-1) .EQ. 2) GO TO 10000807 IDOP1 = IDOP(1,NMSG,1) - IDOP(NROW2,NMSG-1,1) 00808 IDOP2 = IDOP(1,NMSG,2) - IDOP(NROW2,NMSG-1,2) + I2000 00809 IF(IRCVR.EQ.2.AND.IDOP(NROW2,NMSG-1,2).LE.0) 00810 * IDOP2 = IDOP(1,NMSG,2) 00811 100 IDOP(1,NMSG,2) = IDOP2 00812 110 IDOP(1,NMSG,1) = IDOP1 00813 C CONVERT OTHER THAN TWO MINUTES VALUES 00814 NROWX = NROW2 - 2 00815 DO 140 NMSG = 1,NDPMSG 00816 DO 130 I = 1,NROWX 00817 NROW = NROW2 - I + 1 00818 IDOP1 = 0 00819 IDOP2 = 0 00820 IF(IERR(NROW,NMSG).NE.1.OR.IERR(NROW-1,NMSG).EQ.2) GO TO 120 00821 IDOP1 = IDOP(NROW,NMSG,1) - IDOP(NROW-1,NMSG,1) 00822 IDOP2 = IDOP(NROW,NMSG,2) - IDOP(NROW-1,NMSG,2) + I2000 00823 IF(IRCVR.EQ.2.AND.IDOP(NROW-1,NMSG,2).EQ.0) 00824 * IDOP2 = IDOP(NROW,NMSG,2) 00825 120 IDOP(NROW,NMSG,1) = IDOP1 00826 130 IDOP(NROW,NMSG,2) = IDOP2 00827 IF(IERR(2,NMSG) .EQ. 1) GO TO 140 00828 IDOP(2,NMSG,1) = 0 00829 IDOP(2,NMSG,2) = 0 00830 140 CONTINUE 00831 C ZERO DOPPLERS IF NOISE .NE. 0 00832 DO 150 NMSG = 1,NDPMSG 00833 DO 150 NROW = 1,NROW2 00834 IF(NOISE(NROW,NMSG) .EQ. 0) GO TO 150 00835 IDOP(NROW,NMSG,1) = 0 00836 IDOP(NROW,NMSG,2) = 0 00837 IERR(NROW,NMSG) = 3 00838 150 CONTINUE 00839 C COUNT NON-ZERO DOPPLERS PER TWO-MINUTE MESSAGE INTO ARRAY 'NDOP' 00840 DO 170 NMSG = 1,NDPMSG 00841 DO 170 NROW = 1,NROW2 00842 IF(IERR(NROW,NMSG) .NE. 1) GO TO 170 00843 NDOP(NMSG) = NDOP(NMSG) + 1 00844 NDOP(11) = NDOP(11) + 1 00845 170 CONTINUE 00846 RETURN 00847 1000 FORMAT(1X,30HSUBROUTINE DOPED ENTERED ) 00848 END 00849 C 00850 SUBROUTINE LIST 00851 C PRINT RAW AND MJV DATA 00852 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00853 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00854 COMMON /CARR/ NMESS,IARR(29,26,10) 00855 INTEGER CODE,CHAR 00856 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00857 COMMON /VOTE/ NVAR,LOCK,IVAR(26),IFIX(26),MFAIL(26),NFAIL(26), 00858 * NOISE(27,10),KNOISE 00859 COMMON/DOP/NDPMSG,IDOP(26,10,2),IERR(26,10),NDOP(11) 00860 DOUBLE PRECISION ERR(5) 00861 DATA ERR(1)/8H /,ERR(2)/8HNOISYDOP/,ERR(3)/8HNOISYMSG/, 00862 * ERR(4)/8HLOST HI /,ERR(5)/8HLOST LO / 00863 IF(ILIST .GE. 1) WRITE(IPR,1000) 00864 WRITE(IPR,1001) IDS,NPASS 00865 IF(NMESS .LT. 2) GO TO 100 00866 WRITE(IPR,1002) 00867 K = 1 00868 WRITE(IPR,1004) K,((IARR(I,J,K),I=1,29),NOISE(J,K), 00869 * (IDOP(J,K,L),L=1,2),ERR(IERR(J,K)),IVAR(J),MFAIL(J),J=1,NROW2) 00870 K = 2 00871 WRITE(IPR,1005) IVAR(LOCK) 00872 WRITE(IPR,1004) K,((IARR(I,J,K),I=1,29),NOISE(J,K), 00873 * (IDOP(J,K,L),L=1,2),ERR(IERR(J,K)),IFIX(J),NFAIL(J),J=1,NROW2) 00874 IF(NMESS .LT. 3) RETURN 00875 DO 10 K = 3,NMESS 00876 10 WRITE(IPR,1006) K,((IARR(I,J,K),I=1,29),NOISE(J,K), 00877 * (IDOP(J,K,L),L=1,2),ERR(IERR(J,K)),J=1,NROW2) 00878 RETURN 00879 100 K = 1 00880 WRITE(IPR,1007) K,((IARR(I,J,K),I=1,29),J=1,NROW2) 00881 RETURN 00882 C FORMAT STATEMENTS 00883 1000 FORMAT(1X,30HSUBROUTINE LIST ENTERED ) 00884 1001 FORMAT(1H1,80X,8HDATA SET,I4,11H INPUT PASS,I4) 00885 1002 FORMAT(10H MESSAGE,10X,8HRAW DATA,9X,5HNOISE,5X, 00886 * 15HEDITED DOPPLERS,16X,14HVAR MJV FAIL) 00887 1004 FORMAT(/5X,I2,4X,20A1,1X,9A1,I4,5X,2I10,1X,A8,5X,I9,I7/ 00888 * 7(11X,20A1,1X,9A1,I4,5X,2I10,1X,A8,5X,I9,I7/), 00889 * 18(11X,29A1, I5,5X,2I10,1X,A8,5X,I9,I7/)) 00890 1005 FORMAT(65X,11HVAR(LOCK)= ,I9/78X,14HFIX MJV FAIL) 00891 1006 FORMAT(/5X,I2,4X,20A1,1X,9A1,I4,5X,2I10,1X,A8/ 00892 * 7(11X,20A1,1X,9A1,I4,5X,2I10,1X,A8/), 00893 * 18(11X,29A1, I5,5X,2I10,1X,A8/)) 00894 1007 FORMAT(/5X,I2,4X,20A1,1X,9A1/ 00895 * 7(11X,20A1,1X,9A1/), 00896 * 18(11X,29A1/)) 00897 END 00898 C 00899 SUBROUTINE STORE 00900 C STORE MJV DATA UNFORMATTED IN DATA SET 'IOUT' 00901 C PRINT ONE LINE SUMMARY OF PASS 00902 COMMON /DSRN/ ICR,IPR,IDEV,IOUT 00903 COMMON /CONST/IRCVR,NDS,ILIST,NROW2,MCHARS,I2000,CODE(16),CHAR(18)00904 COMMON /CARR/ NMESS,IARR(29,26,10) 00905 INTEGER CODE,CHAR 00906 COMMON /POINT/ IEDS,IDS,NPASS,IKEPT,IPAGE,NULL 00907 COMMON /VOTE/ NVAR,LOCK,IVAR(26),IFIX(26),MFAIL(26),NFAIL(26), 00908 * NOISE(27,10),KNOISE 00909 COMMON/DOP/NDPMSG,IDOP(26,10,2),IERR(26,10),NDOP(11) 00910 IF(ILIST .GE. 1) WRITE(IPR,1000) 00911 I1D8 = 100000000 00912 I1D7 = 10000000 00913 C NEW PAGE EVERY 50 LINES 00914 IPAGE = IPAGE + 1 00915 IF(IPAGE .LE. 50) GO TO 5 00916 IPAGE = 0 00917 WRITE(IPR,1001) 00918 5 CONTINUE 00919 C REJECT PASS IF FIXED PARAMETER MJV FAILURES 00920 IF(NFAIL(NROW2) .EQ. 0) GO TO 7 00921 WRITE(IPR,1003) NPASS,NDOP 00922 RETURN 00923 C REJECT PASS IF FIXED PARAMETERS .LT. 800000000 00924 7 IF(IFIX(9) .LE. 0) GO TO 9 00925 DO 8 I = 10,21 00926 IF(IFIX(I) .LT. 8*I1D8) GO TO 9 00927 8 CONTINUE 00928 GO TO 10 00929 9 WRITE(IPR,1004) NPASS,NDOP 00930 RETURN 00931 C ZERO VARIABLES WITH MJV ERRORS 00932 10 IF(MFAIL(NROW2) .EQ. 0) GO TO 12 00933 DO 11 I = 1,NVAR 00934 IF(MFAIL(I) .NE. 0) IVAR(I) = 0 00935 11 CONTINUE 00936 12 CONTINUE 00937 C REDUCE NDPMSG IF LAST MESSAGES ARE NOISY OR HAVE NO NONZERO DOPPLERS 00938 KNOISE = KNOISE * 2 00939 13 IF(NOISE(27,NDPMSG).LT. KNOISE .AND. NDOP(NDPMSG).GT.0) GO TO 14 00940 NDOP(11) = NDOP(11) - NDOP(NDPMSG) 00941 NDOP(NDPMSG) = 0 00942 NDPMSG = NDPMSG - 1 00943 GO TO 13 00944 14 CONTINUE 00945 C REJECT PASS IF LESS THAN THREE MESSAGES CONTAIN DOPPLERS 00946 IF(NDPMSG .GE. 3) GO TO 6 00947 WRITE(IPR,1002) NPASS,NDOP 00948 RETURN 00949 C SHIFT DOPPLER ARRAY DOWN SO THAT LOCKON DOPPLER IS IN FIRST ELEMENT 00950 6 CONTINUE 00951 J2 = NROW2 - 1 00952 DO 19 L = 1,2 00953 DO 19 K = 1,NDPMSG 00954 DO 18 J = 1,J2 00955 18 IDOP(J,K,L) = IDOP(J+1,K,L) 00956 IF(K .LT. NDPMSG) IDOP(NROW2,K,L) = IDOP(1,K+1,L) 00957 IF(K .EQ. NDPMSG) IDOP(NROW2,K,L) = 0 00958 19 CONTINUE 00959 C STORE MJV DATA 00960 WRITE(IOUT,1009) IRCVR,NROW2,NDPMSG,NVAR,LOCK,(IFIX(I),I=9,22), 00961 $ (IVAR(I),I=1,NVAR) 00962 WRITE(IOUT,1010) (((IDOP(J,K,L),L=1,2),J=1,NROW2),K=1,NDPMSG) 00963 C PRINT STORED DATA 00964 IF(ILIST .LT. 2) GO TO 17 00965 WRITE(IPR,1006) IRCVR,NROW2,NDPMSG,NVAR,LOCK, 00966 * (IFIX(I),I=9,22),(IVAR(I),I=1,NVAR) 00967 WRITE(IPR,1007) 00968 K1 = 1 00969 K2 = 5 00970 IF(NDPMSG .LT. 5) K2 = NDPMSG 00971 DO 15 J = 1,NROW2 00972 WRITE(IPR,1008) ((IDOP(J,K,L),L=1,2),K=K1,K2) 00973 15 CONTINUE 00974 IF(NDPMSG .LE. 5) GO TO 17 00975 WRITE(IPR,1007) 00976 K1 = K2 + 1 00977 K2 = NDPMSG 00978 DO 16 J = 1,NROW2 00979 WRITE(IPR,1008) ((IDOP(J,K,L),L=1,2),K=K1,K2) 00980 16 CONTINUE 00981 17 CONTINUE 00982 C PRINT SUMMARY OF ACCEPTED PASS 00983 IKEPT = IKEPT + 1 00984 LOCKT = 0 00985 IF(LOCK .GE. 1) LOCKT = IVAR(LOCK) / I1D7 00986 ISAT = MOD(IFIX(19),10000) / 100 00987 INJT = MOD(IFIX(20),I1D8) / 50000 00988 INJDAY=MOD(IFIX(20),10000) / 10 00989 INJHR = INJT / 60 00990 INJMIN = MOD(INJT,60) 00991 WRITE(IPR,1005) NPASS,IKEPT,ISAT,INJDAY,INJHR,INJMIN,LOCKT,NDOP 00992 RETURN 00993 C FORMAT STATEMENTS 00994 1000 FORMAT(1X,30HSUBROUTINE STORE ENTERED ) 00995 1001 FORMAT(10H1PASS KEPT,8X,15HCOL ROW MSG SAT,20X,9HINJECTION,3X, 00996 * 6HLOCKON,5X,29HNON ZERO DOPPLERS PER MESSAGE ) 00997 1002 FORMAT(I5,5X,17HREJECT - LT 3 MSG ,49X,10I3,I4) 00998 1003 FORMAT(I5,5X,21HREJECT - FIX MJV FAIL ,45X,10I3,I4) 00999 1004 FORMAT(I5,5X,24HREJECT - ZERO FIX PARAMS ,42X,10I3,I4) 01000 1005 FORMAT(I5,I4,21X,I3,19X,I4,2I3,7X,I3,4X,10I3,I4) 01001 1006 FORMAT(10X,11HOUTPUT DATA/10X,5HIRCVR,I5,5X,5HNROW2,I5,5X,6HNDPMSG01002 * ,I5,5X,4HNVAR,I5,5X,4HLOCK,I5/10X,5HIFIX ,7I10/15X,7I10/10X, 01003 * 5HIVAR ,9I10/15X,8I10) 01004 1007 FORMAT(/) 01005 1008 FORMAT(5X,5(2I10)) 01006 1009 FORMAT(5I3,5(/7I10)) 01007 1010 FORMAT(8I10) 01008 END 01009