PROGRAM p_rst_Summary ! A utility program in the Restore4 family. ! Reads a p.rst file OUTPUT from Restore4 (e.g., pUSM_NI_006.0Ma.rst), ! adds up the model achievements (during time-steps so far completed) ! towards meeting latitude-anomaly and vertical-axis-rotation goals, ! and writes these as 6 new columns, to the right of the p.rst INPUT table. ! The resulting p_rst_Summary file (e.g., pUSM_NI_006.0Ma_rst_Summary.txt) ! can be opened with Excel or other spreadsheet for plotting. ! By Peter Bird, UCLA, May 2020 !- - - - - - - - - - - - - - - - - - - IMPLICIT NONE CHARACTER(1) :: tab CHARACTER(5) :: c5 CHARACTER(6) :: c6 CHARACTER(7) :: c7 CHARACTER(8) :: c8 CHARACTER(80) :: output_filename, p_rst_filename, p_memo CHARACTER(134) :: p_rst_format ! to read paleomagnetic data CHARACTER(134) :: p_rst_titles ! to write paleomagnetic data CHARACTER(134) :: line INTEGER :: p_rst_count ! number of paleomagnetic data (# of sites; 2 goals/site) INTEGER :: delta_t_denominator, i, ios, j, high_time, length REAL*8 :: delta_t_Ma ! inferred timestep REAL*8 :: highest_t_Ma ! greatest geologic age reached so far, in Ma REAL*8 :: delta_t_numerator, fraction, t1, t2, t3, t4 REAL*8, DIMENSION(10) :: vector REAL*8, DIMENSION(0:2) :: p_ccw_err ! 3 norms of rotation error (each normalized by sigma before combining): !(0:2 = L0,L1,L2 norm). REAL*8, DIMENSION(:), ALLOCATABLE :: p_ccw_degrees ! counterclockwise rotation of paleomagnetic site, from past ! to present, in degrees (not radians, as inside Restore4) ! (1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_ccw_goal_degreesPerMa ! target counterclockwise rotation rate of a paleomagnetic site, ! going from past to present, in degrees/m.y. !(1:num_timesteps = timestep index; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_ccw_rate_degreesPerMa ! model counterclockwise rotation rate of a paleomagnetic site, ! going from past to present, in degrees/m.y. !(1:num_timesteps = timestep index; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_ccw_rate_sigma_degreesPerMa ! uncertainty in counterclockwise rotation rate, degrees/m.y. !(1:p_rst_count = paleomagentic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_ccw_sigma_degrees ! standard deviation of counterclockwise rotation of paleomagnetic ! site, from past to present, in degrees ! (1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_pole_lonLat ! Paleo-North-pole at time of magnetization of paleomagnetic site, ! in reference frame used for velocity boundary conditions, ! in degrees of East longitude and North latitude !(1:2 = E, N; 1:p_rst_count = paleomagnetic site index) CHARACTER(50), DIMENSION(:), ALLOCATABLE :: p_ref ! bibliographic reference for each paleomagnetic site ! (1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:), ALLOCATABLE :: p_site_now_lonLat ! current location of paleomagnetic site (integrated); ! in degrees of East longitude and North latitude ! (1:2 = E, N; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:), ALLOCATABLE :: p_site_0_lonLat ! integrated paleo-location of paleomagnetic site; ! in degrees of East longitude and North latitude: ! (1:2 = E, N; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_south_degrees ! distance that paleomagnetic site has drifted South, in degrees ! (1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_south_err ! 3 norms of paleolatitude error (each normalized by sigma before combining): !(0:2 = L0,L1,L2 norm; 0:max_iter = pre-solution:iteration index). REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_south_goal_degreesPerMa ! target velocities toward paleo-South of a paleomagnetic site, in degrees/m.y. !(1:num_timesteps = timestep index; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:,:),ALLOCATABLE :: p_south_rate_degreesPerMa ! model velocities toward paleo-South of a paleomagnetic site, in degrees/m.y. !(1:num_timesteps = timestep index; 1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_south_sigma_degrees ! standard deviation of distance that paleomagnetic site has ! drifted South, in degrees ! (1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_south_rate_sigma_degreesPerMa ! uncertainty in Southward drift rate, degrees/m.y. !(1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_t_max_Ma ! mean age of magnetization, in Ma !(1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_t_min_Ma ! this is the age, in Ma, at which paleomagnetic sites were sampled; ! so all values are 0.; provided as a necessary actual parameter. !(1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_t1_Ma ! maximum age of magnetization (averaged with p_t2 to give ! p_t_max), in Ma !(1:p_rst_count = paleomagnetic site index) REAL*8, DIMENSION(:), ALLOCATABLE :: p_t2_Ma ! minimum age of magnetization (averaged with p_t1 to give ! p_t_max), in Ma !(1:p_rst_count = paleomagnetic site index LOGICAL, DIMENSION(:), ALLOCATABLE :: summary_complete REAL*8, DIMENSION(:), ALLOCATABLE :: summary_south_goal_degrees REAL*8, DIMENSION(:), ALLOCATABLE :: summary_south_sigma_degrees REAL*8, DIMENSION(:), ALLOCATABLE :: summary_south_model_degrees REAL*8, DIMENSION(:), ALLOCATABLE :: summary_ccw_goal_degrees REAL*8, DIMENSION(:), ALLOCATABLE :: summary_ccw_sigma_degrees REAL*8, DIMENSION(:), ALLOCATABLE :: summary_ccw_model_degrees !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (*, "(' PROGRAM p_rst_Summary:')") WRITE (*, "(' A utility program in the Restore4 family.')") WRITE (*, "(' Reads a p.rst file OUTPUT from Restore4 (e.g., pUSM_NI_006.0Ma.rst),')") WRITE (*, "(' adds up the model achievements (during time-steps so far completed)')") WRITE (*, "(' towards meeting latitude-anomaly and vertical-axis-rotation goals,')") WRITE (*, "(' and writes these as 6 new columns, to the right of the p.rst INPUT table.')") WRITE (*, "(' The resulting p_rst_Summary file (e.g., pUSM_NI_006.0Ma_rst_Summary.txt)')") WRITE (*, "(' can be opened with Excel or other spreadsheet for plotting.')") WRITE (*, "(' By Peter Bird, UCLA, May 2020')") CALL Pause() 10 WRITE (*, *) WRITE (*, "(' Enter filename of p.rst file OUTPUT from Restore: ')") READ (*, "(A)") p_rst_filename OPEN (UNIT = 1, FILE = TRIM(p_rst_filename), STATUS = "OLD", IOSTAT = ios) IF (ios /= 0) THEN WRITE (*, "(' ERROR: File ', A, ' not found (in current folder). Try again...')") TRIM(p_rst_filename) CALL Pause() GO TO 10 END IF !First time through, just count number of sites (p_rst_count) and greatest timestep achieved (top_time): highest_t_Ma = 0.0D0 ! just initializing before search delta_t_Ma = 0.0D0 p_rst_count = 0 delta_t_numerator = 0.0D0 delta_t_denominator = 0 READ (1, "(A)") p_rst_format READ (1, "(A)") p_rst_titles scanning: DO READ (1, "(A)", IOSTAT = ios) line IF (ios /= 0) EXIT scanning IF (line(1:1) == '+') THEN ! present location ELSE IF (line(1:1) == '*') THEN ! progress toward latitude-anomaly in one timestep line(1:1) = ' ' READ (line, *) t1, t2 delta_t_numerator = delta_t_numerator + (t2 - t1) delta_t_denominator = delta_t_denominator + 1 highest_t_Ma = MAX(highest_t_Ma, t2) ELSE IF (line(1:1) == '&') THEN ! progress toward vertical-axis-rotation in one timestep line(1:1) = ' ' READ (line, *) t1, t2 delta_t_numerator = delta_t_numerator + (t2 - t1) delta_t_denominator = delta_t_denominator + 1 highest_t_Ma = MAX(highest_t_Ma, t2) ELSE ! header line with original INPUT line of the INPUT p_rst file READ (line, p_rst_format, IOSTAT = ios) p_memo, (vector(j), j = 1, 10) IF (ios /= 0) EXIT scanning ! perhaps input file has empty lines at end? p_rst_count = p_rst_count + 1 END IF END DO scanning CLOSE (1) ! p_rst input file (which was OUTPUT from Restore) !Infer timestep IF (delta_t_denominator > 0) THEN delta_t_Ma = delta_t_numerator / delta_t_denominator ELSE WRITE (*, *) WRITE (*, "(' ERROR: This is a p.rst INPUT file, not a p.rst OUTPUT file.')") CALL Pause() STOP END IF !Infer high_time (INTEGER): high_time = NINT(highest_t_Ma / delta_t_Ma) WRITE (*, *) WRITE (*, "(' This file describes ', I5, ' paleomagnetic sites within the current F-E grid area.')") p_rst_count WRITE (*, "(' This file contains results of ', I5, ' timesteps, extending back to ', F8.3, ' Ma.')") high_time, highest_t_Ma CALL Pause() !DIMENSION all needed arrays: ALLOCATE ( p_ccw_degrees(p_rst_count) ) ALLOCATE ( p_ccw_goal_degreesPerMa(high_time, p_rst_count) ) ALLOCATE ( p_ccw_rate_degreesPerMa(high_time, p_rst_count) ) ALLOCATE ( p_ccw_rate_sigma_degreesPerMa(p_rst_count) ) ALLOCATE ( p_ccw_sigma_degrees(p_rst_count) ) ALLOCATE ( p_pole_lonLat(2, p_rst_count) ) ALLOCATE ( p_ref(p_rst_count) ) ALLOCATE ( p_site_now_lonLat(2, p_rst_count) ) ALLOCATE ( p_site_0_lonLat(2, p_rst_count) ) ALLOCATE ( p_south_degrees(p_rst_count) ) ALLOCATE ( p_south_goal_degreesPerMa(high_time, p_rst_count) ) ALLOCATE ( p_south_rate_degreesPerMa(high_time, p_rst_count) ) ALLOCATE ( p_south_sigma_degrees(p_rst_count) ) ALLOCATE ( p_south_rate_sigma_degreesPerMa(p_rst_count) ) ALLOCATE ( p_t_max_Ma(p_rst_count) ) ALLOCATE ( p_t_min_Ma(p_rst_count) ) ALLOCATE ( p_t1_Ma(p_rst_count) ) ALLOCATE ( p_t2_Ma(p_rst_count) ) !Initialize all arrays (to simplify debugging): p_ccw_degrees = 0.0D0 ! whole array p_ccw_goal_degreesPerMa = 0.0D0 p_ccw_rate_degreesPerMa = 0.0D0 p_ccw_rate_sigma_degreesPerMa = 0.0D0 p_ccw_sigma_degrees = 0.0D0 p_pole_lonLat = 0.0D0 p_ref = ' ' p_site_now_lonLat = 0.0D0 p_site_0_lonLat = 0.0D0 p_south_degrees = 0.0D0 p_south_goal_degreesPerMa = 0.0D0 p_south_rate_degreesPerMa = 0.0D0 p_south_sigma_degrees = 0.0D0 p_south_rate_sigma_degreesPerMa = 0.0D0 p_t_max_Ma = 0.0D0 p_t_min_Ma = 0.0D0 p_t1_Ma = 0.0D0 p_t2_Ma = 0.0D0 !Re-read the input p.rst file, and memorize contents: OPEN (UNIT = 1, FILE = TRIM(p_rst_filename), STATUS = "OLD", IOSTAT = ios) READ (1, "(A)") p_rst_format READ (1, "(A)") p_rst_titles i = 0 ! index of site, 1:p_rst_count. Incremented whenever a header-line is read. memorizing: DO READ (1, "(A)", IOSTAT = ios) line IF (ios /= 0) EXIT memorizing IF (line(1:1) == '+') THEN ! present location line(1:1) = ' ' READ (line, *) t1, t2 p_site_0_lonLat(1, i) = t1 p_site_0_lonLat(2, i) = t2 ELSE IF (line(1:1) == '*') THEN ! progress toward latitude-anomaly in one timestep line(1:1) = ' ' READ (line, *) t1, t2, t3, t4 j = NINT(t2 / delta_t_Ma) p_south_rate_degreesPerMa(j, i) = t3 p_south_goal_degreesPerMa(j, i) = t4 ELSE IF (line(1:1) == '&') THEN ! progress toward vertical-axis-rotation in one timestep line(1:1) = ' ' READ (line, *) t1, t2, t3, t4 j = NINT(t2 / delta_t_Ma) p_ccw_rate_degreesPerMa(j, i) = t3 p_ccw_goal_degreesPerMa(j, i) = t4 ELSE ! header line with original INPUT line of the INPUT p_rst file READ (line, p_rst_format, IOSTAT = ios) p_memo, (vector(j), j = 1, 10) IF (ios /= 0) EXIT memorizing ! perhaps input file has empty lines at end? i = i + 1 p_ref(i) = TRIM(p_memo) p_site_now_lonLat(1, i) = vector(1) p_site_now_lonLat(2, i) = vector(2) p_south_degrees(i) = vector(3) p_south_sigma_degrees(i) = vector(4) p_ccw_degrees(i) = vector(5) p_ccw_sigma_degrees(i) = vector(6) p_t1_Ma(i) = vector(7) p_t2_Ma(i) = vector(8) p_pole_lonLat(1, i) = vector(9) p_pole_lonLat(2, i) = vector(10) END IF END DO memorizing CLOSE (1) ! p_rst input file (which was OUTPUT from Restore); now DONE with this. !Create extra arrays to describe Summary results. Note that some of these are incomplete/prorated. !Therefore we have to have logically distinct, differently-named arrays, even though the values !may be the same for those sites where the simulation is complete. ALLOCATE ( summary_complete(p_rst_count) ) ALLOCATE ( summary_south_goal_degrees(p_rst_count) ) ALLOCATE ( summary_south_sigma_degrees(p_rst_count) ) ALLOCATE ( summary_south_model_degrees(p_rst_count) ) ALLOCATE ( summary_ccw_goal_degrees(p_rst_count) ) ALLOCATE ( summary_ccw_sigma_degrees(p_rst_count) ) ALLOCATE ( summary_ccw_model_degrees(p_rst_count) ) !Fill in values of all output arrays: DO i = 1, p_rst_count p_t_min_Ma(i) = 0.0D0 ! (redundant, and also never used) p_t_max_Ma(i) = (p_t1_Ma(i) + p_t2_Ma(i)) / 2.0D0 ! mean age of magnetization, as in Restore summary_south_goal_degrees(i) = 0.0D0 ! just initializing, before sum over timesteps... summary_south_model_degrees(i) = 0.0D0 ! just initializing, before sum over timesteps... summary_ccw_goal_degrees(i) = 0.0D0 ! just initializing, before sum over timesteps... summary_ccw_model_degrees(i) = 0.0D0 ! just initializing, before sum over timesteps... DO j = 1, high_time summary_south_goal_degrees(i) = summary_south_goal_degrees(i) + delta_t_Ma * p_south_goal_degreesPerMa(j, i) summary_south_model_degrees(i) = summary_south_model_degrees(i) + delta_t_Ma * p_south_rate_degreesPerMa(j, i) summary_ccw_goal_degrees(i) = summary_ccw_goal_degrees(i) + delta_t_Ma * p_ccw_goal_degreesPerMa(j, i) summary_ccw_model_degrees(i) = summary_ccw_model_degrees(i) + delta_t_Ma * p_ccw_rate_degreesPerMa(j, i) END DO summary_complete(i) = (highest_t_Ma >= p_t_max_Ma(i)) ! (Otherwise, goals and sigmas will be prorated.) IF (summary_complete(i)) THEN ! use original sigmas: summary_south_sigma_degrees(i) = p_south_sigma_degrees(i) summary_ccw_sigma_degrees(i) = p_ccw_sigma_degrees(i) ELSE ! use pro-rated sigmas: fraction = highest_t_Ma / p_t_max_Ma(i) summary_south_sigma_degrees(i) = fraction * p_south_sigma_degrees(i) summary_ccw_sigma_degrees(i) = fraction * p_ccw_sigma_degrees(i) END IF END DO !OUTPUT all results, using tabs for ease in opening in Excel, and grouping COMPLETE vs. INCOMPLETE sites: output_filename = TRIM(p_rst_filename) length = LEN_TRIM(p_rst_filename) output_filename((length-3):(length-3)) = '_' ! changing the '.' of ".rst" to the '_' of "_rst" output_filename = TRIM(output_filename) // "_Summary.txt" OPEN (UNIT = 2, FILE = TRIM(output_filename)) ! unconditional OPEN; overwrites any existing file !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - WRITE (2, "('COMPLETE:')") tab = CHAR(9) ! from ASCII table line = "Reference" // tab // "Long." // tab // "Latt." // tab // "LatAn" // tab // "Sigma" // tab // "CCWRo" // tab // "Sigma" // tab // & & "MxAg" // tab // "MxAg" // tab // "PlLon" // tab // "PlLt" // tab // tab // & & "S_goal" // tab // "S_sigma" // tab // "S_model" // tab // & & "CCW_goal" // tab // "CCW_sigma" // tab // "CCW_model" WRITE (2, "(A)") TRIM(line) DO i = 1, p_rst_count IF (summary_complete(i)) THEN line = TRIM(p_ref(i)) WRITE (c8, "(F8.2)") p_site_now_lonLat(1, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c8)) WRITE (c7, "(F7.2)") p_site_now_lonLat(2, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c7)) WRITE (c6, "(F6.1)") p_south_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_south_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_ccw_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_ccw_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c5, "(F5.0)") p_t1_Ma(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_t2_Ma(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_pole_lonLat(1, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_pole_lonLat(2, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) line = TRIM(line) // tab !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (c6, "(F6.1)") summary_south_goal_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_south_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_south_model_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (c6, "(F6.1)") summary_ccw_goal_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_ccw_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_ccw_model_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (2, "(A)") TRIM(line) END IF END DO !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - WRITE (2, "('INCOMPLETE:')") line = "Reference" // tab // "Long." // tab // "Latt." // tab // "LatAn" // tab // "Sigma" // tab // "CCWRo" // tab // "Sigma" // tab // & & "MxAg" // tab // "MxAg" // tab // "PlLon" // tab // "PlLt" // tab // tab // & & "S_goal" // tab // "S_sigma" // tab // "S_model" // tab // & & "CCW_goal" // tab // "CCW_sigma" // tab // "CCW_model" WRITE (2, "(A)") TRIM(line) DO i = 1, p_rst_count IF (.NOT.summary_complete(i)) THEN line = TRIM(p_ref(i)) WRITE (c8, "(F8.2)") p_site_now_lonLat(1, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c8)) WRITE (c7, "(F7.2)") p_site_now_lonLat(2, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c7)) WRITE (c6, "(F6.1)") p_south_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_south_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_ccw_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") p_ccw_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c5, "(F5.0)") p_t1_Ma(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_t2_Ma(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_pole_lonLat(1, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) WRITE (c5, "(F5.0)") p_pole_lonLat(2, i) line = TRIM(line) // tab // TRIM(ADJUSTL(c5)) line = TRIM(line) // tab !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (c6, "(F6.1)") summary_south_goal_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_south_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_south_model_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (c6, "(F6.1)") summary_ccw_goal_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_ccw_sigma_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) WRITE (c6, "(F6.1)") summary_ccw_model_degrees(i) line = TRIM(line) // tab // TRIM(ADJUSTL(c6)) !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE (2, "(A)") TRIM(line) END IF END DO !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - CLOSE (2) WRITE (*, *) WRITE (*, "(' Job completed.')") CALL Pause() CONTAINS SUBROUTINE Pause() IMPLICIT NONE WRITE (*,"(' Press [Enter]...'\)") READ (*,*) END SUBROUTINE Pause END PROGRAM p_rst_Summary