PROGRAM 12

PROGRAM 12 PROGRAM ADJUST C.....THIS PROGRAM ADJUSTS THE INITIAL DATA SO THAT IT WILL FORM A CLOSED C.....POLYGON. C.....F012 ANTHONY F. ORTIZ **104** C.....DECLARE A 2-DIMENSIONAL REAL ARRAY THAT HOLDS LENGTH, ANGLE IN C.....DEGREES, ANGLE IN MINUTES, AZIMUTH, DEPARTURE, LATITUDE, X, AND C.....Y COORDINATES AND A 2-DIMENSIONAL CHARACTER ARRAY THAT HOLDS THE C.....BEARINGS. ALSO DECLARE A REAL VARIABLES FOR THE ERRORS OF CLOSURES. INTEGER COUNT REAL ARRAY1 (5, 8), DCLOSE, LCLOSE CHARACTER*1 ARRAY2 (5, 2) COUNT = 1 C.....CALL THE BELOW SUBPROGRAMS FROM THE MAIN PROGRAM. CALL OPEN_FILES () CALL INPUT_VALUES (ARRAY1, ARRAY2) CALL CALCULATE_DEPTLATI (ARRAY1, ARRAY2) CALL CALCULATE_CLOSURE (ARRAY1, DCLOSE, LCLOSE) CALL CALCULATE_COORDINATES (ARRAY1) CALL PRINT_RESULTS (ARRAY1, DCLOSE, LCLOSE, COUNT) CALL MAKE_CORRECTIONS (ARRAY1, DCLOSE, LCLOSE) CALL CALCULATE_CLOSURE (ARRAY1, DCLOSE, LCLOSE) CALL CALCULATE_COORDINATES (ARRAY1) CALL PRINT_RESULTS (ARRAY1, DCLOSE, LCLOSE, COUNT) STOP END SUBROUTINE OPEN_FILES () C.....THIS SUBROUTINE OPENS THE DATA FILE 'F012P104.DAT' AND THE OUT FILE C.....'F012P104.OUT'. OPEN (1, FILE = 'F012P104.DAT') OPEN (2, FILE = 'F012P104.OUT') RETURN END SUBROUTINE INPUT_VALUES (ARRAY1, ARRAY2) C.....THIS SUBROUTINE STORES THE DATA VALUES IN A 2 2-DIMENSIONAL ARRAY C.....(THE INTEGER VALUES IN ONE AND THE CHARACTER VALUES IN ANOTHER). REAL ARRAY1 (5, 8) CHARACTER*1 ARRAY2 (5, 2) DO 10 J = 1, 5 READ (1, 100) (ARRAY1 (J, K), K = 1, 3) 100 FORMAT (3F8.2) 10 CONTINUE REWIND 1 DO 20 J = 1, 5 READ (1, 200) (ARRAY2 (J, K), K = 1, 2) 200 FORMAT (24X, 2A8) 20 CONTINUE RETURN END SUBROUTINE CALCULATE_DEPTLATI (ARRAY1, ARRAY2) C.....THIS PROGRAM CALCULATES THE AZIMUTH, DEPARTURE, AND LATITUDE PARTS OF THE C.....2-DIMENSIONAL REAL ARRAY. REAL ARRAY1 (5, 8), PI CHARACTER*1 ARRAY2 (5, 2) PI = 3.141593 DO 10 J = 1, 5 ARRAY1 (J, 4) = ARRAY1 (J, 2) + ARRAY1 (J, 3) / 60.0 IF (ARRAY2 (J, 1).EQ.'N'.AND.ARRAY2 (J, 2).EQ.'E') THEN ARRAY1 (J, 4) = ARRAY1 (J, 4) ELSE IF (ARRAY2 (J, 1).EQ.'S'.AND.ARRAY2 (J, 2).EQ.'E') THEN ARRAY1 (J, 4) = 180 - ARRAY1 (J, 4) ELSE IF (ARRAY2 (J, 1).EQ.'S'.AND.ARRAY2 (J, 2).EQ.'W') THEN ARRAY1 (J, 4) = 180.0 + ARRAY1 (J, 4) ELSE ARRAY1 (J, 4) = 360.0 - ARRAY1 (J, 4) ENDIF ENDIF ENDIF ARRAY1 (J, 5) = ARRAY1 (J, 1) * SIN (ARRAY1 (J, 4) * PI / 180.0) ARRAY1 (J, 6) = ARRAY1 (J, 1) * COS (ARRAY1 (J, 4) * PI / 180.0) 10 CONTINUE RETURN END SUBROUTINE CALCULATE_CLOSURE (ARRAY1, DCLOSE, LCLOSE) C.....THIS SUBROUTINE CALCULATES THE ERROR OF CLOSURES FOR LATIUDE AND C.....DEPARTURE. REAL ARRAY1 (5, 8), DCLOSE, LCLOSE DCLOSE = 0 LCLOSE = 0 DO 10 J = 1, 5 DCLOSE = DCLOSE + ARRAY1 (J, 5) LCLOSE = LCLOSE + ARRAY1 (J, 6) 10 CONTINUE RETURN END SUBROUTINE CALCULATE_COORDINATES (ARRAY1) C.....THIS SUBROUTINE CALCULATES THE X AND Y COORINATES AND STORES THEM IN C.....THE 2-DIMENSIONAL REAL ARRAY. REAL ARRAY1 (5, 8) ARRAY1 (1, 7) = 10000.0 ARRAY1 (1, 8) = 50000.0 DO 10 J = 2, 5 ARRAY1 (J, 7) = ARRAY1 (J - 1, 7) + ARRAY1 (J - 1, 5) ARRAY1 (J, 8) = ARRAY1 (J - 1, 8) + ARRAY1 (J - 1, 6) 10 CONTINUE RETURN END SUBROUTINE PRINT_RESULTS (ARRAY1, DCLOSE, LCLOSE, COUNT) C.....THIS PROGRAM PRINTS THE INITIAL AND THE ENDING VALUES OF THE ARRAY. INTEGER COUNT REAL ARRAY1 (5, 8), DCLOSE, LCLOSE IF (COUNT.NE.0) THEN WRITE (2, 100) 'F012 ANTHONY F. ORTIZ **P104**' WRITE (2, 100) ' BEFORE CORRECTIONS' ELSE WRITE (2, 100) ' AFTER CORRECTIONS' 100 FORMAT (20X, A, /) ENDIF COUNT = 0 WRITE (2, 200) 'POINT', 'LENGTH', 'AZIMUTH', 'DEPARTURE', $'LATITUDE', 'X', 'Y' 200 FORMAT (1X, A, 4X, A, 6X, A, 4X, A, 3X, A, 6X, A, 11X, A, /) DO 10 J = 1, 5 WRITE (2, 300) J, ARRAY1 (J, 1), ARRAY1 (J, 4), ARRAY1 (J, 5), $ ARRAY1 (J, 6), ARRAY1 (J, 7), ARRAY1 (J, 8) 300 FORMAT (1X, I3, 6F12.2) 10 CONTINUE WRITE (2, 400) 'CLOSURE (DEPARTURE) = ', DCLOSE WRITE (2, 400) 'CLOSURE (LATITUDE) = ', LCLOSE 400 FORMAT (/, 1X, A, F8.2) RETURN END SUBROUTINE MAKE_CORRECTIONS (ARRAY1, DCLOSE, LCLOSE) C.....THIS PROGRAM MAKES THE CORRECTIONS TO THE INITIAL DATA VALUES. REAL ARRAY1 (5, 8), DCLOSE, LCLOSE, TOTAL, PI TOTAL = 0 PI = 3.141593 DO 10 J = 1, 5 TOTAL = TOTAL + ARRAY1 (J, 1) 10 CONTINUE DO 20 J = 1, 5 ARRAY1 (J, 5) = ARRAY1 (J, 5) - (DCLOSE * ARRAY1 (J, 1) / TOTAL) ARRAY1 (J, 6) = ARRAY1 (J, 6) - (LCLOSE * ARRAY1 (J, 1) / TOTAL) ARRAY1 (J, 4) = ASIN (ARRAY1 (J, 5) / ARRAY1 (J, 1)) * 180.0 $ / PI 20 CONTINUE RETURN END C....OUTFILE: F012P104.DAT 285.10 26.00 10.00 N E 610.45 75.00 25.00 S E 720.48 15.00 30.00 S W 203.00 15.00 30.00 N W 647.02 53.00 6.00 N W C.....OUTFILE: F012P104.OUT F012 ANTHONY F. ORTIZ **P104** BEFORE CORRECTIONS POINT LENGTH AZIMUTH DEPARTURE LATITUDE X Y 1 285.10 26.17 125.72 255.88 10000.00 50000.00 2 610.45 104.58 590.78 -153.70 10125.72 50255.88 3 720.48 195.50 -192.54 -694.28 10716.51 50102.18 4 203.00 344.50 -54.25 195.62 10523.97 49407.90 5 647.02 306.90 -517.41 388.48 10469.72 49603.52 CLOSURE (DEPARTURE) = -47.69 CLOSURE (LATITUDE) = -8.00 AFTER CORRECTIONS POINT LENGTH AZIMUTH DEPARTURE LATITUDE X Y 1 285.10 27.41 131.24 256.81 10000.00 50000.00 2 610.45 80.80 602.59 -151.72 10131.24 50256.80 3 720.48 -14.35 -178.61 -691.94 10733.83 50105.08 4 203.00 -14.35 -50.32 196.28 10555.22 49413.14 5 647.02 -51.29 -504.90 390.58 10504.90 49609.41 CLOSURE (DEPARTURE) = .00 CLOSURE (LATITUDE) = .00 BACK TO COMP150 PAGE.