FTN SORTM C ADJUSTMENT OF MODELS SEPTEMBER 1980 G.H.S. 6001 C 6002 C ********* SORT MODELS ********* MAIN ROUTINE ********* 6003 C 6004 C ************************************************************** 6005 C * SET DIMENSIONS AND 7 CONSTANTS AS FOLLOWS, OR LARGER * 6006 C * MMO IS NUMBER OF MODELS * 6007 C * MENH IS NUMBER OF CONTROL AND CHECK POINTS, PLUS ONE * 6008 C * MXYZ IS MAXIMUM NUMBER OF POINTS IN ONE MODEL * 6009 C * MID IS TOTAL NUMBER OF MODEL POINTS * 6010 C * MIM IS MAXIMUM NUMBER OF MODEL POINTS PER TERRAIN POINT * 6011 C * OR POINTS ON ONE LAKE, WHICHEVER IS GREATER * 6012 C * MTY IS MAXIMUM NUMBER OF POINTS IN ARRAY LTIE (.LE. MXYZ)* 6013 C * MW IS BANDWIDTH * 6014 C * LORI(8,MMO),LMO(2,MMO),LENH(4,MENH), * 6015 C * LXYZ(4,MXYZ),ID(MID),LTIE(4,MIM,MTY) * 6016 C ************************************************************** 6017 C 6018 COMMON N,NIM,NW,MTOT,NP, INTGR(11) 6019 EQUIVALENCE (ID(1),LENH(1,1)) 6020 C *************************************************************** 6021 C DIMENSIONS FOR CRYSLER BLOCK SORTING OF MODELS 6022 C **************************** 6023 DIMENSION LORI(8,30),LMO(2,30),LENH(4,75), 6024 1 LXYZ(4,30),ID( 600),LTIE(4, 6,10) 6025 DATA MMO,MENH,MXYZ,MID,MIM,MTY,MW / 30,75,30,600,6,10,5 / 6026 C *************************************************************** 6027 C 6028 C READ JOB SPECIFICATION CARD, READ MODEL NUMBERS IN SEQUENCE 6029 C WITH APPROXIMATE VALUES OF ALL ORIENTATION PARAMETERS 6030 NP = 0 6031 100 CALL SORT1 (LORI,LMO,MMO, LXYZ,MXYZ, ID,MID) 6032 IF (NP) 200, 200, 300 6033 C 6034 C READ AND REDUCE THE MODEL COORDINATES, THEN RETURN 6035 C TO SORT1 TO SORT THE MODELS IN THE REQUIRED SEQUENCE 6036 200 MTOT = MID 6037 CALL SORT2 (LXYZ,MXYZ, LMO,N) 6038 GO TO 100 6039 C 6040 C SORT THE REDUCED COORDINATES 6041 300 NW = MW 6042 CALL SORT3 (LMO,N, ID,NP, LXYZ,MXYZ, LTIE,MIM,MTY) 6043 C 6044 C READ GROUND CONTROL AND COMPUTE APPROXIMATE COORDINATES 6045 CALL SORT4 (LENH,MENH, LORI,N, LTIE,NIM,MTY) 6046 STOP 77 6047 END 6048 FTN MSORT1 SUBROUTINE SORT1 (LORI,LMO,MMO, LXYZ,MXYZ, ID,MID) 6201 C 6202 C READ JOB AND MODEL SPECIFICATIONS 6203 C READ MODEL NUMBERS IN DESIRED ORDER, WITH INITIAL VALUES 6204 C OF ORIENTATION PARAMETERS 6205 C 6206 COMMON N,KODE,NOT(2),NP,LIST, JD31,JD32,JD33,IPR,JW11,JW12,JW13, 6207 1 LSC(2),LAKE,LFAC,MISS 6208 DIMENSION A(19), LORI(8,MMO),LMO(2,MMO), LXYZ(4,MXYZ),ID(MID) 6209 C 6210 1 FORMAT (19A4, I4, / 40X, 4I10) 6211 3 FORMAT (8I10) 6212 11 FORMAT (3H1 19A4 //) 6213 13 FORMAT (28H0 INITIAL MODEL PARAMETERS / 6214 1 T7,'SEQ.#' T19,'MOD' / (1H 9I10)) 6215 22 FORMAT (25H0 NO INITIAL PARAMETERS) 6216 23 FORMAT (38H0 SPACE NEEDED FOR THE PARAMETERS OF I4, ' MODELS') 6217 24 FORMAT (38H0 INVALID CODE FOR LAKE LEVEL POINTS) 6218 33 FORMAT (1H0 I8, ' MODELS' / I9, ' MODEL POINTS') 6219 42 FORMAT ( 9H0 MODEL I8, ' HAS NO MODEL COORDINATES') 6220 C 6221 IF (NP) 100, 100, 270 6222 C 6223 C DEFINE INPUT DEVICES JW, STORAGE DEVICES JD, AND PRINTER IPR 6224 100 JW11 = 11 6225 JW12 = 12 6226 JW13 = 13 6227 JD31 = 31 6228 JD32 = 32 6229 JD33 = 33 6230 IPR = 3 6231 C 6232 C READ JOB DESCRIPTION CARD, CODES, ETC. 6233 READ (JW11,1) A, LIST, KODE, LSC, LAKE 6234 DO 101 J = 1,2 6235 101 IF (LSC(J) .EQ. 0) LSC(J) = 100000 6236 WRITE (IPR,11) A 6237 LFAC = 10000 6238 IF (LAKE * LFAC .GE. 1000000) GO TO 154 6239 C 6240 C READ IN PROPER SEQUENCE ALL MODEL NUMBERS 6241 C WITH INITIAL VALUES OF ALL MODEL PARAMETERS 6242 DO 115 N = 1,9999 6243 IF (N .GT. MMO) GO TO 114 6244 READ (JW11,3, END=116) (LORI(J,N), J = 1,8) 6245 IF (LORI(1,N) .EQ. 0) GO TO 116 6246 LMO(1,N) = LORI(1,N) 6247 LMO(2,N) = 0 6248 GO TO 115 6249 114 READ (JW11,3, END=116) JJ 6250 IF (JJ .EQ. 0) GO TO 116 6251 115 CONTINUE 6252 116 N = N - 1 6253 IF (N .EQ. 0) GO TO 152 6254 IF (N .GT. MMO) GO TO 153 6255 WRITE (IPR,13) (J2, (LORI(J1,J2), J1=1,8), J2=1,N) 6256 RETURN 6257 C 6258 C ERROR MESSAGES 6259 152 WRITE (IPR,22) 6260 GO TO 159 6261 153 WRITE (IPR,23) N 6262 GO TO 159 6263 154 WRITE (IPR,24) 6264 159 STOP 01 6265 C 6266 C UPON RETURN FROM SORT2, SORT MODELS IN SEQUENCE FOR ADJUSTMENT 6267 270 NP = 0 6268 J = 1 6269 DO 279 J1 = 1,N 6270 J2 = LMO(2,J1) 6271 IF (J2 .NE. 0) GO TO 272 6272 WRITE (IPR,42) LMO(1,J1) 6273 MISS = MISS + 1 6274 GO TO 279 6275 272 IF (J2 - J) 273, 275, 274 6276 273 BACKSPACE JD33 6277 J = J - 1 6278 GO TO 272 6279 274 READ (JD33) 6280 J = J + 1 6281 GO TO 272 6282 275 READ (JD33) L1,KPC, ((LXYZ(L2,L3), L2 = 1,4), L3 = 1,L1) 6283 J = J + 1 6284 WRITE (JD32) J1, L1,KPC, ((LXYZ(L2,L3), L2 = 1,4), L3 = 1,L1) 6285 C STORE POINT NUMBERS IN ARRAY ID 6286 DO 278 J2 = 1,L1 6287 NP = NP + 1 6288 278 ID(NP) = LXYZ(1,J2) 6289 LMO(2,J1) = NP 6290 279 CONTINUE 6291 C 6292 IF (MISS .GT. 0) STOP 03 6293 WRITE (IPR,33) N, NP 6294 END FILE JD32 6295 REWIND JD32 6296 REWIND JD33 6297 RETURN 6298 END 6299 FTN MSORT2 SUBROUTINE SORT2 (LXYZ,MXYZ, LMO,N) 6401 C 6402 C READ MODEL COORDINATES, COMPUTE REDUCED MODEL COORD. 6403 C CONSTRUCT ONE RECORD WITH REDUCED COORDINATES FOR EACH MODEL 6404 C 6405 COMMON INT(3),MID,NP,NOT(3),JD33,IPR,JW11,JW12,JW13,LSC(2), 6406 1 LAKE,LFAC,MISS 6407 DOUBLE PRECISION SC(2),W(3),ROUND 6408 DIMENSION L(4,2),LXYZ(4,MXYZ),LMO(2,N),MEAN(3) 6409 EQUIVALENCE (INT(2),KODE),(W(1),ROUND) 6410 C 6411 8 FORMAT (I4, I6, 7I10) 6412 31 FORMAT (1H0 T27,'CODES' T39,'SCALE FACTORS') 6413 32 FORMAT (1H 3I10, 2F10.5) 6414 40 FORMAT (24H0 NO MODEL COORDINATES) 6415 41 FORMAT ( 9H0 MODEL I5, ' HAS NO PARAMETERS') 6416 43 FORMAT (16H0 INVALID CODE I3, ' FOR ROTATION OF AXES') 6417 44 FORMAT (30H0 NOT ENOUGH POINTS IN MODEL I5) 6418 45 FORMAT (28H0 TOO MANY POINTS IN MODEL I5) 6419 46 FORMAT (29H0 TOO MANY POINTS IN BLOCK: I5) 6420 47 FORMAT ( 1H0 I8, ' MODELS READ, BUT ONLY' I4, ' EXPECTED') 6421 48 FORMAT (16H POINT NUMBER I8, ' IS DUPLICATE IN MODEL' I5) 6422 49 FORMAT (16H0 MODEL NUMBER I8, ' IS DUPLICATE') 6423 C 6424 C FOR EACH MODEL, READ FIRST THE PROJECTION CENTRES, 6425 C THEN THE MEASURED POINTS 6426 WRITE (IPR,31) 6427 MISS = 0 6428 NMO = 1 6429 MOD = 0 6430 205 READ (JW12,8,END=240) MODL, ((L(J1,J2), J1=1,4), J2=1,2) 6431 IF (MODL .EQ. MOD) GO TO 230 6432 IF (MOD .NE. 0) GO TO 250 6433 C 6434 C PROCESS CARD OF FIRST PROJECTION CENTRE 6435 210 MOD = MODL 6436 DO 211 J = 1,4 6437 211 LXYZ(J,1) = L(J,1) 6438 KPC = 0 6439 L1 = 1 6440 DO 214 JSEQ = 1,N 6441 IF (LMO(1,JSEQ) .NE. MODL) GO TO 214 6442 IF (LMO(2,JSEQ) .NE. 0) GO TO 213 6443 LMO(2,JSEQ) = NMO 6444 GO TO 220 6445 213 WRITE (IPR,49) MODL 6446 GO TO 216 6447 214 CONTINUE 6448 WRITE (IPR,41) MODL 6449 216 MISS = MISS + 1 6450 C PREPARE FOR CHANGE TO U,V COORDINATES 6451 220 IF (L(1,2) .NE. 0) KODE = L(1,2) 6452 L2 = 2 6453 L3 = 3 6454 JU = KODE / 10 6455 JV = KODE - 10 * JU 6456 IF (JU.GT.4 .OR. JV.GT.4) GO TO 293 6457 JU = JU + 1 6458 JV = JV + 1 6459 GO TO (221, 222, 221, 222, 221), JU 6460 221 GO TO (225, 293, 225, 293, 225), JV 6461 222 GO TO (293, 223, 293, 223, 293), JV 6462 223 L2 = 3 6463 L3 = 2 6464 C PUT SCALE FACTORS IN ARRAY SC 6465 225 DO 226 J = 1,2 6466 IF (L(J+1,2) .NE. 0) LSC(J) = L(J+1,2) 6467 226 SC(J) = LSC(J) * 1D-5 6468 IF (JU.EQ.3 .OR. JU.EQ.4) SC(1) = -SC(1) 6469 IF (JV.EQ.2 .OR. JV.EQ.3) SC(2) = -SC(2) 6470 GO TO 205 6471 C 6472 C SQUEEZE POINTS INTO ARRAY LXYZ, OMITTING DUPLICATES. 6473 230 J1 = KPC + 1 6474 DO 239 J2 = 1,2 6475 IF (L(1,J2) .EQ. 0) GO TO 239 6476 IF (L1 .EQ. KPC) GO TO 235 6477 IF (LAKE .LE. 0) GO TO 232 6478 IF (L(1,J2) / LFAC .EQ. LAKE) GO TO 235 6479 232 DO 234 J = J1,L1 6480 IF (L(1,J2) .NE. LXYZ(1,J)) GO TO 234 6481 WRITE (IPR,48) L(1,J2), MOD 6482 IF (KPC .EQ. 0) MISS = MISS + 1 6483 GO TO 239 6484 234 CONTINUE 6485 235 IF (L1 .EQ. MXYZ) GO TO 295 6486 L1 = L1 + 1 6487 DO 238 J = 1,4 6488 238 LXYZ(J,L1) = L(J,J2) 6489 239 CONTINUE 6490 IF (KPC .EQ. 0) KPC = L1 6491 GO TO 205 6492 C 6493 240 IF (MOD .EQ. 0) GO TO 290 6494 MODL = -1 6495 C 6496 C PROCESS THE POINTS IN ONE MODEL 6497 C SHIFT ORIGIN, SCALE, AND, IF REQUIRED, INTERCHANGE COORDINATES 6498 250 IF (KPC.EQ.0 .OR. L1.EQ.KPC) GO TO 294 6499 DO 251 J = 1,3 6500 251 MEAN(J) = 0 6501 J1 = L1 - KPC 6502 DO 255 J2 = 1,L1 6503 IF (J2 .GT. KPC) GO TO 253 6504 DO 252 J = 1,2 6505 252 MEAN(J) = MEAN(J) + LXYZ(J+1,J2) / KPC 6506 GO TO 255 6507 253 MEAN(3) = MEAN(3) + LXYZ(4,J2) / J1 6508 255 CONTINUE 6509 DO 258 J1 = 1,L1 6510 W(L2) = (LXYZ(2,J1) - MEAN(1)) * SC(1) 6511 W(L3) = (LXYZ(3,J1) - MEAN(2)) * SC(2) 6512 LXYZ(4,J1) = LXYZ(4,J1) - MEAN(3) 6513 DO 257 J = 2,3 6514 ROUND = .5D0 6515 IF (W(J) .LT. 0.) ROUND = -ROUND 6516 257 LXYZ(J,J1) = W(J) + ROUND 6517 258 CONTINUE 6518 C 6519 C STORE THE DATA PERTAINING TO ONE MODEL IN ONE RECORD 6520 WRITE (JD33) L1,KPC, ((LXYZ(J1,J2), J1=1,4), J2=1,L1) 6521 WRITE (IPR,32) JSEQ, MOD, KODE, (SC(J),J=1,2) 6522 NP = NP + L1 6523 IF (MODL .LE. 0) GO TO 260 6524 NMO = NMO + 1 6525 GO TO 210 6526 C 6527 260 END FILE JD33 6528 REWIND JD33 6529 IF (NP .GT. MID) GO TO 296 6530 IF (NMO .GT. N) GO TO 297 6531 C NEXT, SORT THE MODELS IN THE SPECIFIED SEQUENCE 6532 RETURN 6533 C 6534 C ERROR MESSAGES 6535 290 WRITE (IPR,40) 6536 GO TO 299 6537 293 WRITE (IPR,43) KODE 6538 GO TO 299 6539 294 WRITE (IPR,44) MOD 6540 GO TO 299 6541 295 WRITE (IPR,45) MODL 6542 GO TO 299 6543 296 WRITE (IPR,46) NP 6544 GO TO 299 6545 297 WRITE (IPR,47) NMO, N 6546 299 STOP 02 6547 END 6548 FTN MSORT3 SUBROUTINE SORT3 (LMO,N, ID,NP, LXYZ,MXYZ, LTIE,MIM,MTY) 6601 C 6602 C FOR EACH TERRAIN POINT, CODE INFORMATION ON EACH MODEL POINT 6603 C AND PLACE IN ARRAY LTIE. THEN, INSERT REDUCED MODEL COORDINATES 6604 C 6605 COMMON INT(5),LIST, JD31,JD32,JD33,IPR, NOT(5),LAKE,LFAC, LLAC 6606 DIMENSION LMO(2,N), ID(NP), LXYZ(4,MXYZ), LTIE(4,MIM,MTY) 6607 EQUIVALENCE (INT(2),NIM),(INT(3),NW),(INT(4),MTOT) 6608 51 FORMAT (28H0 MODELS WITH MODEL POINTS) 6609 52 FORMAT (2H # I4,I9, (1H T21, 12I8)) 6610 53 FORMAT (22H0 A MAXIMUM OF NIM = I3, ' MODEL POINTS PER TERRAIN 6611 1 POINT' / 27H REQUIRED BANDWIDTH NW = I3) 6612 61 FORMAT ( 9H POINT I8, ', FIRST IN MODEL #' I4, 6613 1 ', OCCURS MORE THAN MIM =' I3, ' TIMES') 6614 62 FORMAT ( 9H POINT I8, ', FIRST IN MODEL #' I4, 6615 1 ', NEEDS BANDWIDTH MW =' I3) 6616 C 6617 MW = INT(3) 6618 LFAC2 = 100 6619 LAKE0 = LAKE * LFAC / LFAC2 6620 LLAC = 0 6621 DO 301 J = 2,4 6622 301 INT(J) = 0 6623 KK = 0 6624 JSUM = 0 6625 L2 = 0 6626 C 6627 C FOR EACH MODEL, 6628 DO 379 K = 1,N 6629 L1 = L2 + 1 6630 L2 = LMO(2,K) 6631 L44 = K + 2 * MW - 1 6632 IF (L44 .GT. N) L44 = N 6633 MT = 0 6634 MPC = 0 6635 C 6636 C ASSIGN SPACE IN ARRAY LTIE TO SETS OF POINTS THAT OCCUR FIRST IN 6637 C THAT MODEL: STORE FIRST POINT IDENTIFICATION AND SEQ. NUMBER 6638 DO 378 L = L1,L2 6639 IF (ID(L) .LE. 0) GO TO 339 6640 IF (MT .GT. 0) GO TO 305 6641 KMAX = K 6642 MZ = 1 6643 305 M1 = 1 6644 MT = MT + 1 6645 LTIE(1,1,MT) = ID(L) 6646 LTIE(2,1,MT) = L - (L1-1) 6647 IF (LAKE .LE. 0) GO TO 306 6648 IF (ID(L) / LFAC .EQ. LAKE) GO TO 307 6649 306 L3 = L2 + 1 6650 L4 = LMO(2,L44) 6651 LAKE1 = 0 6652 GO TO 309 6653 C LAKE1 IS NAME OF A LAKE 6654 307 LAKE1 = ID(L) / LFAC2 6655 LLAC = 1 6656 L3 = L + 1 6657 L4 = NP 6658 IF (LAKE1 .EQ. LAKE0) L4 = L2 6659 309 IF (L4 .LE. L3) GO TO 330 6660 C 6661 C SEARCH FOR POINT NUMBER IN FOLLOWING MODELS, 6662 C RECORD EACH OCCURRENCE BY MODEL SEQ.# AND POINT SEQ.# 6663 DO 323 J = L3,L4 6664 IF (LAKE1) 311, 311, 312 6665 311 IF (ID(J) - ID(L)) 323, 313, 323 6666 312 IF (ID(J) / LFAC2 .NE. LAKE1) GO TO 323 6667 J1 = K 6668 GO TO 314 6669 313 J1 = K + 1 6670 314 DO 315 J2 = J1,N 6671 IF (LMO(2,J2) .GE. J) GO TO 316 6672 315 CONTINUE 6673 316 J1 = J2 - K + 1 6674 IF (J1 .LE. MW) GO TO 317 6675 WRITE (IPR,62) ID(L), K, J1 6676 IF (LAKE1 .GT. 0) GO TO 323 6677 317 IF (J2 .GT. KMAX) KMAX = J2 6678 IF (M1 .LT. MIM) GO TO 318 6679 WRITE (IPR,61) ID(L), K, MIM 6680 JSUM = JSUM + 1 6681 GO TO 322 6682 318 M1 = M1 + 1 6683 LTIE(1,M1,MT) = J2 6684 IF (J2 .GT. 1) GO TO 321 6685 LTIE(2,M1,MT) = J 6686 GO TO 322 6687 321 LTIE(2,M1,MT) = J - LMO(2,J2-1) 6688 322 ID(J) = -ID(J) 6689 323 CONTINUE 6690 C 6691 C COMPLETE THE PROCESSING OF A TERRAIN POINT 6692 330 ID(L) = -ID(L) 6693 IF (M1 .GT. MZ) MZ = M1 6694 C MARK UNUSED PART OF RECORD WITH A NUMBER GREATER THAN N 6695 IF (M1 .LT. MIM) LTIE(1,M1+1,MT) = 7777 6696 IF (MT .EQ. MTY) GO TO 340 6697 339 IF (L.LT.L2 .OR. MT.EQ.0) GO TO 378 6698 C 6699 C A SET OF TERRAIN POINTS HAS BEEN ASSIGNED TO ARRAY LTIE. NOW, 6700 C INSERT REDUCED COORDINATES OF ALL TERRAIN POINTS IN ARRAY LTIE 6701 C FIRST, UPDATE COUNTERS IN ARRAY INT 6702 C K AND KMAX ARE SEQUENCE NUMBERS OF FIRST AND LAST MODEL, 6703 C MT IS NUMBER OF TERRAIN POINTS COLLECTED IN LTIE 6704 340 IF (KMAX-K .GE. NW) NW = KMAX - K + 1 6705 IF (MZ .GT. NIM) NIM = MZ 6706 J11 = 1 6707 DO 355 J3 = K,KMAX 6708 IF (J3 .GT. K) J11 = 2 6709 IF (KK .EQ. J3) GO TO 350 6710 C READ NEEDED RECORD OF MODEL J3 INTO ARRAY LXYZ 6711 341 IF (KK+1 - J3) 342, 344, 343 6712 342 READ (JD32) 6713 KK = KK + 1 6714 GO TO 341 6715 343 BACKSPACE JD32 6716 KK = KK - 1 6717 GO TO 341 6718 344 READ (JD32) KK,JJ,KPC, ((LXYZ(J,JJ1), J =1,4), JJ1=1,JJ) 6719 350 DO 354 J2 = 1,MT 6720 DO 353 J1 = J11,MZ 6721 IF (J1 .EQ. 1) GO TO 351 6722 IF (LTIE(1,J1,J2) - J3) 353, 351, 354 6723 351 J = LTIE(2,J1,J2) 6724 DO 352 JJ = 2,4 6725 352 LTIE(JJ,J1,J2) = LXYZ(JJ,J) 6726 IF (J1.EQ.1 .AND. J.LE.KPC) MPC = MPC + 1 6727 353 CONTINUE 6728 354 CONTINUE 6729 355 CONTINUE 6730 C 6731 C STORE ZEROS IN UNUSED LOCATIONS OF ARRAY LTIE 6732 DO 377 J2 = 1,MT 6733 DO 372 J1 = 2,MZ 6734 IF (LTIE(1,J1,J2) .NE. 7777) GO TO 372 6735 DO 371 J3 = J1,MZ 6736 DO 371 JJ = 1,4 6737 371 LTIE(JJ,J3,J2) = 0 6738 GO TO 377 6739 372 CONTINUE 6740 377 CONTINUE 6741 WRITE (JD33) K,MZ,MT,MPC, (((LTIE(J1,J2,J3),J1=1,4),J2=1,MZ), 6742 1 J3=1,MT) 6743 MTOT = MTOT + MT 6744 MT = 0 6745 MPC = 0 6746 378 CONTINUE 6747 379 CONTINUE 6748 C 6749 C OPTIONALLY, LIST ALL POINTS IN EACH MODEL 6750 IF (LIST.LE.0 .AND. JSUM.EQ.0) GO TO 390 6751 DO 381 J = 1,NP 6752 381 ID(J) = -ID(J) 6753 WRITE (IPR,51) 6754 J2 = 0 6755 DO 382 K = 1,N 6756 J1 = J2 + 1 6757 J2 = LMO(2,K) 6758 WRITE (IPR,52) K, LMO(1,K), (ID(J), J=J1,J2) 6759 382 CONTINUE 6760 IF (JSUM .GT. 0) STOP 04 6761 C 6762 390 WRITE (IPR,53) NIM, NW 6763 END FILE JD33 6764 REWIND JD33 6765 REWIND JD32 6766 RETURN 6767 END 6768 FTN MSORT4 SUBROUTINE SORT4 (LENH,MENH, LORI,N, LTIE,NIM,MTY) 6801 C 6802 C COMPLETE AND STORE ONE RECORD FOR EACH TERRAIN POINT 6803 C 6804 COMMON NOT1(2),NW,NOT2(2),LIST, JD31,JD32,JD33,IPR,NOT3(2),JW13, 6805 1 NOT4(2),LAKE,LFAC, LLAC 6806 DIMENSION LENH(4,MENH),LORI(8,N),LTIE(4,NIM,MTY),LTER(4),LG(6) 6807 DIMENSION LTRA(3), ROT(3,3), ABCD(4) 6808 EQUIVALENCE (AR,ABCD(1)),(BR,ABCD(2)),(CR,ABCD(3)),(DR,ABCD(4)) 6809 3 FORMAT (8I10) 6810 71 FORMAT (1H0 T8,'POINTS INITIAL TERRAIN COORDINATES' 6811 1 / 5H TYPE T52,'SEQ# COUNT') 6812 72 FORMAT (1H I5, I7, 2X, 4I10, I6) 6813 73 FORMAT (1H0 I8,' PLANIMETRIC CONTROL POINTS' / 1H I8,' HEIGHT CONT 6814 1ROL POINTS' / 1H I8,' AUXILIARY CONTROL POINTS' / 1H I8, 6815 2' PROJECTION CENTRES'/ 1H I8,' TIE POINTS'/ 1H I8,' LAKE LEVELS'/) 6816 81 FORMAT (21H0 NO GROUND CONTROL) 6817 82 FORMAT (37H0 GROUND CONTROL OVERFLOWS AT POINT I7) 6818 83 FORMAT ( 9H POINT I7, T17,' IS ALONE ON ITS LAKE') 6819 C 6820 C READ GROUND COORDINATES, CHECK ON OVERFLOW 6821 LL1 = 0 6822 J = 0 6823 401 J = J + 1 6824 IF (J .GT. MENH) GO TO 492 6825 402 READ (JW13,3, END=405) (LENH(J1,J), J1 = 1,4) 6826 IF (LENH(1,J) .GT. 0) GO TO 401 6827 IF (LL1 .NE. 0) GO TO 405 6828 LL1 = J - 1 6829 GO TO 402 6830 C 6831 405 LL2 = J - 1 6832 IF (LL1 .EQ. 0) LL1 = LL2 6833 IF (LL1 .EQ. 0) GO TO 491 6834 IF (LL2 .GT. LL1) LLAC = LLAC + 2 6835 C LLAC = 1,3: LAKE POINTS; = 2,3: AUXILIARY CONTROL POINTS OCCUR 6836 C 6837 ITER = 0 6838 WRITE (JD31) ITER, N,NIM,NW, LLAC, LORI 6839 IF (LIST .GT. 0) WRITE (IPR,71) 6840 DO 406 J = 1,6 6841 406 LG(J) = 0 6842 C 6843 C READ AND PROCESS ONE RECORD 6844 KK = 0 6845 410 READ (JD33,END=480) K,MZ,MT,MPC, (((LTIE(J,M1,M2),J=1,4),M1=1,MZ), 6846 1 M2=1,MT) 6847 IF (K .EQ. KK) GO TO 430 6848 C 6849 C COMPUTE AND STORE THE ORIENTATION MATRIX OF MODEL # K 6850 KK = K 6851 DO 426 J1 = 1,4 6852 426 ABCD(J1) = LORI(J1+4,K) * 1E-7 6853 ROT(2,3) = 2E0*(BR*CR - AR*DR) 6854 ROT(3,1) = 2E0*(CR*AR - BR*DR) 6855 ROT(1,2) = 2E0*(AR*BR - CR*DR) 6856 ROT(3,2) = 2E0*(BR*CR + AR*DR) 6857 ROT(1,3) = 2E0*(CR*AR + BR*DR) 6858 ROT(2,1) = 2E0*(AR*BR + CR*DR) 6859 DO 427 J1 = 1,4 6860 427 ABCD(J1) = ABCD(J1)**2 6861 ROT(1,1) = DR + AR - BR - CR 6862 ROT(2,2) = DR - AR + BR - CR 6863 ROT(3,3) = DR - AR - BR + CR 6864 C 6865 C PROCESS THE TERRAIN POINTS IN THE RECORD, ONE AT A TIME 6866 430 DO 479 M2 = 1,MT 6867 ILK = 0 6868 LTER(1) = LTIE(1,1,M2) 6869 LTIE(1,1,M2) = K 6870 DO 431 M1 = 1,MZ 6871 IF (LTIE(1,M1,M2) .EQ. 0) GO TO 432 6872 431 CONTINUE 6873 M1 = MZ + 1 6874 432 M1 = M1 - 1 6875 IF (M2 .GT. MPC) GO TO 433 6876 ILK = 9 6877 LG(4) = LG(4) + 1 6878 GO TO 442 6879 433 IF (LAKE .LE. 0) GO TO 440 6880 IF (LTER(1) / LFAC .NE. LAKE) GO TO 440 6881 IF (M1 - 1) 435, 435, 434 6882 434 ILK = 10 6883 LG(6) = LG(6) + 1 6884 GO TO 442 6885 435 WRITE (IPR,83) LTER(1) 6886 GO TO 442 6887 C 6888 C IDENTIFY ALL CONTROL POINTS 6889 440 DO 441 L = 1,LL2 6890 IF (LTER(1) .EQ. LENH(1,L)) GO TO 445 6891 441 CONTINUE 6892 442 L = 0 6893 DO 443 J1 = 2,4 6894 443 LTER(J1) = 0 6895 GO TO 450 6896 C INSERT GIVEN TERRAIN COORDINATES 6897 445 DO 446 J1 = 2,4 6898 446 LTER(J1) = LENH(J1,L) 6899 IF (LTER(3).NE.0 .AND. LTER(4).NE.0) GO TO 460 6900 C 6901 C COMPUTE APPROXIMATE COORDINATES FROM MODEL K 6902 450 DO 452 J = 1,3 6903 452 LTRA(J) = ROT(J,1)*LTIE(2,1,M2) + ROT(J,2)*LTIE(3,1,M2) + 6904 1 ROT(J,3)*LTIE(4,1,M2) 6905 C TAG GROUND CONTROL AND INSERT APPROXIMATE COORDINATES 6906 IF (LTER(3) .EQ. 0) GO TO 461 6907 460 ILK = 2 6908 IF (L .LE. LL1) LG(1) = LG(1) + 1 6909 GO TO 462 6910 461 LTER(2) = LORI(2,K) + LTRA(1) 6911 LTER(3) = LORI(3,K) + LTRA(2) 6912 462 IF (LTER(4) .EQ. 0) GO TO 463 6913 ILK = ILK + 1 6914 IF (L .LE. LL1) LG(2) = LG(2) + 1 6915 GO TO 466 6916 463 LTER(4) = LORI(4,K) + LTRA(3) 6917 466 IF (L .LE. LL1) GO TO 467 6918 ILK = ILK + 3 6919 LG(3) = LG(3) + 1 6920 467 IF (ILK.GT.0 .OR. M1.EQ.1) GO TO 468 6921 ILK = 8 6922 LG(5) = LG(5) + 1 6923 468 IF (LIST .GT. 0) WRITE (IPR,72) ILK, LTER, K, M1 6924 C 6925 C WRITE ONE RECORD FOR EACH TERRAIN POINT (INCLUDING PROJ CENTRES) 6926 WRITE (JD31) LTER, ILK, M1, ((LTIE(J,J1,M2),J=1,4),J1=1,M1) 6927 479 CONTINUE 6928 GO TO 410 6929 C 6930 480 END FILE JD31 6931 REWIND JD31 6932 REWIND JD33 6933 WRITE (IPR,73) LG 6934 RETURN 6935 C 6936 C ERROR MESSAGES 6937 491 WRITE (IPR,81) 6938 GO TO 499 6939 492 WRITE (IPR,82) LENH(1,MENH) 6940 499 STOP 05 6941 END 6942