PROGRAM RangeFinder !A utility program for post-processing groups of f_[token].NKO output files !produced by multiple runs of NeoKinema (in the same orogen, !but not necessarily with identical fault sets). !It reads as many f_[token].nko files as the user specifies, and then !creates a tab-delimited .RangeFinder.TXT output file which reports the !range of input and output offset rates found among those files, and !also the number of times that a particular {fault#, offset-sense} !combination was encountered in the set of files. !By Peter Bird, UCLA, 2008.11.10-21. IMPLICIT NONE CHARACTER(1), PARAMETER :: tab = CHAR(9) ! special "HT" tab character in ASCII sequence INTEGER, PARAMETER :: highest_trace_number = 9999 CHARACTER*1 :: c1 CHARACTER*3 :: c3 CHARACTER*4 :: c4 CHARACTER*6 :: c6 CHARACTER*9 :: goal_c9_low, goal_c9_high, range_c9, sigma_c9_low, sigma_c9_high, result_c9_low, result_c9_high CHARACTER*19 :: goal_c19, sigma_c19, result_c19 CHARACTER*50 :: c50 CHARACTER*1, DIMENSION(7) :: sense_list ! S, P, T, D, N, L, R CHARACTER*50, DIMENSION(highest_trace_number, 7) :: trace_name, low_model, high_model CHARACTER*132 :: input_nko_filename = ' ', output_txt_filename = ' ' CHARACTER*256 :: nko_file_FORMAT = ' ', output_header = ' ' INTEGER :: file_count, i, ios, j, k INTEGER, DIMENSION(highest_trace_number, 7) :: encounters ! j = 1, 7:: S, P, T, D, N, L, R LOGICAL :: this_creeps REAL*8 :: range, this_goal, this_sigma, this_result REAL*8, DIMENSION(highest_trace_number, 7, 2) :: goal, sigma, result ! k = 1, 2:: low, high WRITE (*, "(' PROGRAM RangeFinder:')") WRITE (*, *) WRITE (*, "(' A utility program for post-processing groups of f_[token].NKO output files')") WRITE (*, "(' produced by multiple runs of NeoKinema (in the same orogen,')") WRITE (*, "(' but not necessarily with identical fault sets).')") WRITE (*, "(' It reads as many f_[token].nko files as the user specifies, and then')") WRITE (*, "(' creates a tab-delimited .RangeFinder.TXT output file which reports the')") WRITE (*, "(' range of input and output offset rates found among those files, and')") WRITE (*, "(' also the number of times that a particular {fault#, offset-sense}')") WRITE (*, "(' combination was encountered in the set of files.')") WRITE (*, "(' By Peter Bird, UCLA, 2008.11.10-21.')") WRITE (*, *) file_count = 0 encounters = 0 ! whole 2-D array sense_list = (/ 'S', 'P', 'T', 'D', 'N', 'L', 'R' /) !begin indefinate loop on input files 10 file_count = file_count + 1 IF (file_count <= 2) THEN WRITE (*, "(' Enter name of f_[token].NKO file in current folder: ')") ELSE WRITE (*, "(' Enter name of f_[token].NKO file, or END to finish: ')") END IF READ (*, "(A)") input_nko_filename IF ((TRIM(input_nko_filename) == "END").OR.(TRIM(input_nko_filename) == "End").OR.(TRIM(input_nko_filename) == "end")) THEN file_count = file_count - 1 GO TO 1000 END IF OPEN (UNIT = 1, FILE = TRIM(input_nko_filename), STATUS = "OLD", IOSTAT = ios) IF (ios /= 0) THEN file_count = file_count - 1 WRITE (*, "(' ERROR: File not found: ',A)") TRIM(input_nko_filename) WRITE (*, "(' Please make file available and type its name again.')") CALL Pause() END IF READ (1, "(A)") nko_file_FORMAT READ (1, *) ! to get past headers in file scanning: DO READ (1, nko_file_FORMAT, IOSTAT = ios) c6, c50, this_goal, this_sigma, this_creeps, this_result IF (ios /= 0) EXIT scanning ! typically at EOF c4 = c6(2:5) !READ (c4, *) i <-- this statement activates a mystery bug in the DIGITAL Visual Fortran Compiler; using work-around. i = 0 DO k = 0, 3 IF (c4((4-k):(4-k)) == '1') THEN i = i + 1 * 10**k ELSE IF (c4((4-k):(4-k)) == '2') THEN i = i + 2 * 10**k ELSE IF (c4((4-k):(4-k)) == '3') THEN i = i + 3 * 10**k ELSE IF (c4((4-k):(4-k)) == '4') THEN i = i + 4 * 10**k ELSE IF (c4((4-k):(4-k)) == '5') THEN i = i + 5 * 10**k ELSE IF (c4((4-k):(4-k)) == '6') THEN i = i + 6 * 10**k ELSE IF (c4((4-k):(4-k)) == '7') THEN i = i + 7 * 10**k ELSE IF (c4((4-k):(4-k)) == '8') THEN i = i + 8 * 10**k ELSE IF (c4((4-k):(4-k)) == '9') THEN i = i + 9 * 10**k END IF END DO c1 = c6(6:6) sensing: DO j = 1, 7 IF (c1 == sense_list(j)) EXIT sensing END DO sensing trace_name(i, j) = TRIM(c50) encounters(i, j) = encounters(i, j) + 1 IF (encounters(i, j) == 1) THEN ! first encounter goal(i, j, 1) = this_goal goal(i, j, 2) = this_goal sigma(i, j, 1) = this_sigma sigma(i, j, 2) = this_sigma result(i, j, 1) = this_result result(i, j, 2) = this_result low_model(i, j) = TRIM(input_nko_filename) high_model(i, j) = TRIM(input_nko_filename) ELSE ! greater than 1 goal(i, j, 1) = MIN(goal(i, j, 1), this_goal) goal(i, j, 2) = MAX(goal(i, j, 2), this_goal) sigma(i, j, 1) = MIN(sigma(i, j, 1), this_sigma) sigma(i, j, 2) = MAX(sigma(i, j, 2), this_sigma) IF (this_result < result(i, j, 1)) low_model(i, j) = TRIM(input_nko_filename) result(i, j, 1) = MIN(result(i, j, 1), this_result) IF (this_result > result(i, j, 2)) high_model(i, j) = TRIM(input_nko_filename) result(i, j, 2) = MAX(result(i, j, 2), this_result) END IF END DO scanning CLOSE (1) !end indefinate loop on input files: GO TO 10 1000 WRITE (*, *) !consolidate L & R entries for one fault as single R entry, using negative numbers: DO i = 1, highest_trace_number IF ((encounters(i, 6) > 0).AND.(encounters(i, 7) > 0)) THEN ! both L & R for this fault encounters(i, 7) = encounters(i, 7) + encounters(i, 6) ! combine as R encounters encounters(i, 6) = 0 ! suppress printing of any L line in report file result(i, 6, 1) = -result(i, 6, 1) ! convert L to R values result(i, 6, 2) = -result(i, 6, 2) IF (result(i, 6, 2) < result(i, 7, 1)) THEN ! check for new limits low_model(i, 7) = high_model(i, 6) result(i, 7, 1) = result(i, 6, 2) END IF IF (result(i, 6, 1) > result(i, 7, 2)) THEN high_model(i, 7) = low_model(i, 6) result(i, 7, 2) = result(i, 6, 1) END IF END IF END DO !look for faults/components omitted from any model, and enter rate of "0": DO i = 1, highest_trace_number DO j = 1, 7 IF ((encounters(i, j) > 0).AND.(encounters(i, j) < file_count)) THEN IF (0.0D0 < result(i, j, 1)) THEN low_model(i, j) = "(omitted)" result(i, j, 1) = 0.0D0 END IF IF (0.0D0 > result(i, j, 2)) THEN high_model(i, j) = "(omitted)" result(i, j, 2) = 0.0D0 END IF END IF END DO END DO !output section WRITE (*, "(' ',I3,' input files have been read.')") file_count WRITE (*, "(' Enter name for new report file, such as RangeFinder.TXT: ')") READ (*, "(A)") output_txt_filename OPEN (UNIT = 2, FILE = TRIM(output_txt_filename)) output_header = "F0000X" // tab // & & "Trace_name" // tab // & & "Encounters" // tab // & & "Targets" // tab // & & "Sigmas" // tab // & & "Results" // tab // & & "Range" WRITE (2, "(A)") TRIM(output_header) DO i = 1, highest_trace_number DO j = 1, 7 IF (encounters(i, j) > 0) THEN !trace number: WRITE(c4, "(I4)") i IF (c4(1:1) == ' ') c4(1:1) = '0' IF (c4(2:2) == ' ') c4(2:2) = '0' IF (c4(3:3) == ' ') c4(3:3) = '0' !sense of offset: c1 = sense_list(j) !number of encounters: WRITE (c3, "(I3)") encounters(i, j) c3 = ADJUSTL(c3) !goal range: goal_c9_low = ADJUSTL(DASCII9(goal(i, j, 1))) goal_c9_high = ADJUSTL(DASCII9(goal(i, j, 2))) IF (TRIM(goal_c9_low) == TRIM(goal_c9_high)) THEN goal_c19 = TRIM(goal_c9_low) ELSE goal_c19 = TRIM(goal_c9_low) // '~' // TRIM(goal_c9_high) END IF !sigma range: sigma_c9_low = ADJUSTL(DASCII9(sigma(i, j, 1))) sigma_c9_high = ADJUSTL(DASCII9(sigma(i, j, 2))) IF (TRIM(sigma_c9_low) == TRIM(sigma_c9_high)) THEN sigma_c19 = TRIM(sigma_c9_low) ELSE sigma_c19 = TRIM(sigma_c9_low) // '~' // TRIM(sigma_c9_high) END IF !result range: result_c9_low = ADJUSTL(DASCII9(result(i, j, 1))) result_c9_high = ADJUSTL(DASCII9(result(i, j, 2))) IF (TRIM(result_c9_low) == TRIM(result_c9_high)) THEN result_c19 = TRIM(result_c9_low) range = 0.0D0 range_c9 = '0' WRITE (2, 1010) c4, c1, tab, TRIM(trace_name(i, j)), tab, TRIM(c3), tab, TRIM(goal_c19), tab, TRIM(sigma_c19), tab, TRIM(result_c19), & & tab, TRIM(range_c9) 1010 FORMAT ('F',A4,A1,A1,A,A1,A,A1,A,A1,A,A1,A,A1,A) ELSE result_c19 = TRIM(result_c9_low) // '~' // TRIM(result_c9_high) range = result(i, j, 2) - result(i, j, 1) range_c9 = ADJUSTL(DASCII9(range)) WRITE (2, 1020) c4, c1, tab, TRIM(trace_name(i, j)), tab, TRIM(c3), tab, TRIM(goal_c19), tab, TRIM(sigma_c19), tab, TRIM(result_c19), & & tab, TRIM(range_c9), tab, TRIM(low_model(i, j)), tab, TRIM(high_model(i, j)) 1020 FORMAT ('F',A4,A1,A1,A,A1,A,A1,A,A1,A,A1,A,A1,A,A1,A,A1,A) END IF END IF END DO END DO CLOSE (2) WRITE (*, "(' Job completed.')") CALL Pause() STOP CONTAINS CHARACTER*9 FUNCTION DASCII9(x) ! Returns a right-justified 9-byte (or shorter) version of a ! floating-point number, in "human" format, with no more ! than 3 significant digits. IMPLICIT NONE REAL*8, INTENT(IN) :: x CHARACTER*9 :: temp9 CHARACTER*19 :: temp19 INTEGER :: j, k1, k9, zeros LOGICAL :: punt REAL*8 :: x_log DOUBLE PRECISION :: y IF (isNan(x)) THEN DASCII9="NaN " RETURN ELSE IF (x == 0.0D0) THEN DASCII9=" 0" RETURN ELSE IF (x > 0.0D0) THEN punt = (x >= 999999999.5D0).OR.(x < 0.0000100D0) ELSE ! x < 0.0 punt = (x <= -99999999.5D0).OR.(x > -0.000100D0) END IF IF (punt) THEN ! need exponential notation; use Fortran utility WRITE (temp9,'(1P,E9.2)') x !consider possible improvements, from left to right: IF (temp9(3:5) == '.00') THEN ! right-shift over it temp19(6:9) = temp9(6:9) temp19(4:5) = temp9(1:2) temp19(1:3) = ' ' temp9 = temp19(1:9) ELSE IF (temp9(5:5) == '0') THEN ! right-shift over it temp19(6:9) = temp9(6:9) temp19(2:5) = temp9(1:4) temp19(1:1) = ' ' temp9 = temp19(1:9) END IF IF (temp9(7:7) == '+') THEN ! right-shift over it temp19(8:9) = temp9(8:9) temp19(2:7) = temp9(1:6) temp19(1:1) = ' ' temp9 = temp19(1:9) END IF IF (temp9(8:8) == '0') THEN ! right-shift over it temp19(9:9) = temp9(9:9) temp19(2:8) = temp9(1:7) temp19(1:1) = ' ' temp9 = temp19(1:9) END IF DASCII9 = temp9 ELSE ! can represent without exponential notation x_log = DLOG10(ABS(x)) zeros = DInt_Below(x_log) - 2 y = (10.D0**zeros) * NINT(ABS(x) / (10.D0**zeros)) IF (x < 0.0D0) y = -y WRITE (temp19,"(F19.8)") y ! byte 11 is the '.' !Avoid results like "0.7400001" due to rounding error! IF (temp19(18:19) == '01') temp19(18:19) = '00' !Find first important byte from right; change 0 -> ' ' k9 = 10 ! (if no non-0 found to right of .) right_to_left: DO j = 19, 12, -1 IF (temp19(j:j) == '0') THEN temp19(j:j) = ' ' ELSE k9 = j EXIT right_to_left END IF END DO right_to_left !put leading (-)0 before . of fractions, if it fits IF (x > 0.0D0) THEN IF (temp19(10:11) == ' .') temp19(10:11) = '0.' ELSE ! x < 0.0 IF (k9 <= 17) THEN IF (temp19(9:11) == ' -.') temp19(9:11) = '-0.' END IF END IF k1 = k9 - 8 DASCII9 = temp19(k1:k9) END IF ! punt, or not END FUNCTION DASCII9 INTEGER FUNCTION DInt_Below (x) ! Returns integer equal to, or less than, x. ! (Note: INT() is different; always truncates toward zero.) IMPLICIT NONE REAL*8, INTENT(IN) :: x INTEGER :: i REAL*8 :: y i = INT(x) IF (x >= 0.0D0) THEN DInt_Below = i ELSE ! x < 0. y = 1.0D0*i IF (y <= x) THEN DInt_Below = i ELSE ! most commonly DInt_Below = i - 1 END IF END IF END FUNCTION DInt_Below SUBROUTINE Pause() IMPLICIT NONE WRITE (*,"(' Press [Enter]...'\)") READ (*,*) END SUBROUTINE Pause END PROGRAM RangeFinder