PROGRAM Projector ! ! Reads .DIG files in either (x,y) or (lon,lat) ! format, creates .AI graphics file with map, ! and (optionally) converts (x,y) to (lon,lat), ! or converts (lon,lat) to (x,y) in a choice of ! 10 different map projections. ! ! by Peter Bird ! Department of Earth and Space Sciences ! University of California ! Los Angeles, CA 90095-1567 ! pbird@ess.ucla.edu ! (310) 825-1126 ! August, 1997 ! Converted to REAL*8 variables and subprograms October 2018. ! !(c) Copyright 1997 and 2018 by Peter Bird and the Regents ! of the University of California. ! USE DAdobe_Illustrator ! provided by Peter Bird as file DAdobe_Illustrator.f90 USE DMap_Projections ! provided by Peter Bird as file DMap_Projections.f90 USE DMap_Tools ! provided by Peter Bird as file DMap_Tools.f90 IMPLICIT NONE CHARACTER(24) :: c24, c24al CHARACTER*80 :: input_file_name, line, output_file_name, suggestion INTEGER :: dot_place, i, ios, kilometers, minutes LOGICAL :: convert, do_another, in_ok, includes_TF, infile_is_lonlat, & & more_ai, more_dig, more_map, polygons, success, title_it REAL*8 :: lat, lon, x_meters, x_user, y_meters, y_user REAL*8, DIMENSION(3) :: uvec !GPBgo WRITE (*,"(//' ----------------------------------------------------------------------'& &/' PROJECTOR'& &/' A utility program to plot and convert .DIG files (simple maps,'& &/' composed of 1-, 2-, or n-point lines and curves). Capabilities:'& &/' * Reads .DIG file(s) with points in either (x,y) or (lon,lat) format.'& &/' * Creates an Adobe Illustrator (.AI) map file from the .DIG file(s).'& &/' Data in (lon,lat) format can be displayed in a choice of 10'& &/' map projections, and is decorated with labelled parallels and'& &/' meridians.'& &/' Data in (x,y) format can be displayed either with (x,y) axes, or'& &/' with computed parallels and meridians which should match the'& &/' source map the data was digitised from.'& &/' * Optionally, converts (x,y) data to (lon,lat) format by requesting'& &/' information about the map projection of the source map.'& &/' * Optionally, converts (lon,lat) data to (x,y) data in a choice of'& &/' 10 map projections.'& &/' by Peter Bird, UCLA, 1997 & 2018'& &/' ----------------------------------------------------------------------')") CALL DPrompt_for_Logical('Do you want more information about .DIG files?',.FALSE.,more_dig) IF (more_dig) THEN WRITE (*,& &"(//' ----------------------------------------------------------------------'& &/' About .DIG Files'& &/' The box below contains the first 12 lines of a typical .DIG file.'& &/' ----------------------------- Notice:'& &/' |F0469N | <- a title line (optional)'& &/' | -1.05875E+02,+3.87835E+01 | <- 1st (lon,lat) pair in segment'& &/' | -1.05849E+02,+3.87731E+01 |'& &/' | -1.05826E+02,+3.87534E+01 |'& &/' | -1.05801E+02,+3.87355E+01 | <-(segment can have any number of'& &/' | -1.05777E+02,+3.87195E+01 | points)'& &/' | -1.05769E+02,+3.87104E+01 |<- last (lon,lat) pair in segment'& &/' |*** END OF SEGMENT *** |<- standard end record (required)'& &/' |F0453N |<- title of next segment (optional)'& &/' | -1.05023E+02,+3.76613E+01 |'& &/' | -1.05040E+02,+3.76794E+01 |'& &/' | -1.05050E+02,+3.76995E+01 | et cetera, et cetera......'& &/' -----------------------------'& &/' ----------------------------------------------------------------------')") END IF ! more_dig IF (more_dig) CALL DPrompt_for_Logical('Do you want more information about .DIG files?',.FALSE.,more_dig) IF (more_dig) THEN WRITE (*,& &"(//' ----------------------------------------------------------------------'& &/' About .DIG Files'& &/' Titles of segments: Optional. Use 0, 1, 2, ...? lines to label your'& &/' segments. (This allows for personal codes in which symbols, text'& &/' or other information about the location might be embedded in the '& &/' title lines.) Title lines are simply passed unchanged to converted'& &/' .DIG files. They do not appear in the .ai map files.'& &/' Number formats: Column 1 blank. Column 2 holds sign. Columns 3-13'& &/' hold the first real number, preferably in scientific notation.'& &/' Column 14 is a comma. Column 15 is a sign. Columns 16-26 hold'& &/' the second real number. To write such data from a FORTRAN program,'& &/' use FORMAT(1X, SP, ES12.5, ',', ES12.5).'& &/' (lon,lat) data has longitude before latitude in each pair. Units are'& &/' degrees (e.g., 24 degrees 17 minutes 5 seconds -> 24.2847 degrees).'& &/' East longitude is +, West is -. North latitude is +, South is -.'& &/' (x,y) data can be in units of meters, kilometers, centimeters, miles,'& &/' or feet. However, it MUST give the actual sizes of features on'& &/' the planet, NOT their reduced sizes on some map! Any origin and'& &/' any orientation of the (x,y) system is permissible, as long as'& &/' the +y axis is 90 degrees counterclockwise from the +x axis.'& &/' ----------------------------------------------------------------------')") END IF ! more_dig CALL DPrompt_for_Logical('Do you want more information about .AI files?',.FALSE.,more_ai) IF (more_ai) THEN WRITE (*,& &"(//' ----------------------------------------------------------------------'& &/' About .AI Files'& &/' The .AI files created by this program can be read by:'& &/' * Adobe Illustrator 7 for Windows NT, Windows 95, or Macintosh'& &/' * Adobe Illustrator 4 for Windows 3.1'& &/' * any later version of Adobe Illustrator.'& &//' In Adobe Illustrator you can view, edit, annotate, and print the maps.'& &//' A model .AI file is needed to provide the boiler-plate PostScript'& &/' header that all .ai files carry. Therefore, file AI4Frame.ai'& &/' must be in a location accessible by this program. You will have'& &/' a chance to specify the path if it is not in your current directory.'& &//' All .AI files are transmitted (e.g., by FTP over the Internet) as'& &/' ASCII, not as binary. This is because different computer systems'& &/' have different ways of marking the end of a line.'& &/' ----------------------------------------------------------------------')") END IF ! more_ai CALL DPrompt_for_Logical('Do you want more information about map projections?',.FALSE.,more_map) IF (more_map) THEN WRITE (*,& &"(//' ----------------------------------------------------------------------'& &/' About Map Projections'& &//' John Parr Snyder (1983) Map projections used by the U.S. Geological'& &/' Survey, U.S. Geological Survey Bulletin, volume 1532.'& &//' G. B. Newton (1985) Computer programs for common map projections,'& &/' U.S. Geological Survey Publication, B-1642, 33 pages.'& &//' ----------------------------------------------------------------------')") WRITE (*,"(' Press any key to continue...'\)") READ (*,"(A)") line END IF ! more_map WRITE (*,"(/' -----------------------------------------------------------------------'& &/' ABOUT MULTIPLE INPUT FILES'& &/' You may process more than one .dig file in each run of Projector.'& &/' (One reason is that closed polygons and unclosed lines should not'& &/' typically be mixed in one file.)'& &/' The only restriction is that all must be in the same coordinate'& &/' system: all (lon, lat), or all in the same (x, y) system.'& &/' If you choose to convert to new coordinates, each file is processed'& &/' separately with the same transformation.'& &/' In the map (.AI graphic), each file becomes a group, and the last'& &/' file goes on top. Thus, if you want to plot shaded polygons,'& &/' you should enter them first.'& &/' -----------------------------------------------------------------------')") 100 WRITE (*, "(//' Enter [path\]filename of your (first?) .DIG file: ')") READ (*, "(A)") input_file_name input_file_name = ADJUSTL(input_file_name) OPEN (UNIT = 1, FILE = TRIM(input_file_name), STATUS = 'OLD', IOSTAT = ios, PAD = 'YES') IF (ios /= 0) THEN WRITE (*,"(' ERROR: File not found (in this directory). Try again:')") GOTO 100 END IF ! file not found WRITE (*,"(/' Here are some initial lines from your .dig file:')") WRITE (*,"(' -------------------------------------------------')") DO i = 1, 12 READ (1, "(A)", IOSTAT = ios) line IF (ios /= 0) EXIT WRITE (*,"(' ',A)") TRIM(line) END DO WRITE (*,"(' -------------------------------------------------')") CLOSE(1) WRITE (*, "(' Please take note of the units of your data!'/)") CALL DPrompt_for_Logical('Is this file composed ENTIRELY of closed polygons?', .FALSE., polygons) CALL DPrompt_for_Logical('Are these data in (lon,lat) coordinates?', .TRUE., infile_is_lonlat) CALL DPrompter (xy_mode = .TRUE., lonlat_mode = .TRUE.) !- - - - - - PLOT ONE .DIG ON MAP - - - - - - - - - - - - - - - - - - - WRITE (*,"(/' -----------------------------------------------')") WRITE (*,"(' Creating a map of your input .DIG file....')") WRITE (*,"(' -----------------------------------------------')") !contents of .DIG file: 200 CALL DSet_Line_Style (1.5D0, .FALSE.) CALL DSet_Stroke_Color ('foreground') CALL DSet_Fill_or_Pattern (.FALSE., 'gray______') IF (infile_is_lonlat) THEN ! plot on level 7 CALL DPlot_Dig (7, input_file_name, polygons, 1, in_ok) ELSE ! plot on level 3 CALL DPlot_Dig (3, input_file_name, polygons, 1, in_ok) END IF !- - - - - - - - CONVERSION? - - - - - - - - - - - - - - WRITE (*, "(' ')") IF (infile_is_lonlat) THEN CALL DPrompt_for_Logical('Do you wnat to create a .DIG file in (x,y) format?', .FALSE., convert) IF (convert) THEN OPEN (UNIT = 1, FILE = TRIM(input_file_name), STATUS = 'OLD', IOSTAT = ios, PAD = 'YES') dot_place = INDEX(input_file_name,'.dig',.TRUE.) IF (dot_place <= 0) dot_place = INDEX(input_file_name, '.DIG', .TRUE.) IF (dot_place > 0) THEN ! input_file_name includes .dig or .DIG suggestion = input_file_name(1:dot_place-1) // '_xy.dig' ELSE ! input_file_name does not include .dig or .DIG suggestion = TRIM(ADJUSTL(input_file_name)) // '_xy.dig' END IF 400 CALL DPrompt_for_String('What filename shall it have?', TRIM(suggestion), output_file_name) OPEN (UNIT = 2, FILE = TRIM(output_file_name), STATUS = 'NEW', IOSTAT = ios) IF (ios /= 0) THEN CLOSE (UNIT = 2, IOSTAT = ios) WRITE (*,"(' ERROR: File already exists. Try again:')") suggestion = output_file_name GOTO 400 END IF ! file already exists getting_lonlat: DO READ (1, "(A)", IOSTAT = ios) line IF (ios == -1) EXIT getting_lonlat ! end of input file !Test for 'T', 't', 'F', 'f' in the line; !when one of these begins a word, list-directed input !processing treats it as .TRUE. or .FALSE. and converts !this value to 1.0 or 0.0, causing mis-alignment of !data and/or ficticious data points. For example, !the title line "TX" was read as .TRUE., converted to REAL !1.0, and assigned to the longitude, and then the !first number of the next line was read for the latitude! !Another time, the title line " 129 Tonga-1" was !interpreted as (+129.00E, +1.00N), causing an unwanted !great-circle arc to that point! includes_TF = ((SCAN(line,'T') > 0).AND.(SCAN(line,'T') < 25)).OR. & & ((SCAN(line,'t') > 0).AND.(SCAN(line,'t') < 25)).OR. & & ((SCAN(line,'F') > 0).AND.(SCAN(line,'F') < 25)).OR. & & ((SCAN(line,'f') > 0).AND.(SCAN(line,'f') < 25)) IF (includes_TF) THEN ! this is always a title line WRITE (2, "(A)") TRIM(line) ELSE ! may still be a title line (without T,F) or an ***end READ (line, *, IOSTAT = ios) lon, lat IF (ios == 0) THEN ! line had 2 numbers CALL DLonLat_2_Uvec (lon, lat, uvec) CALL DProject (uvec = uvec, x = x_meters, y = y_meters) ! NO guide parameter x_user = x_meters / mt_meters_per_user y_user = y_meters / mt_meters_per_user WRITE (2, "(1X, SP, ES12.5, ',', ES12.5)") x_user, y_user ELSE ! line was a title or ***end WRITE (2,"(A)") TRIM(line) END IF END IF END DO getting_lonlat CLOSE(1) CLOSE(2) WRITE (*,"(/' Job completed.'/)") END IF ! convert ELSE ! infile is (x,y) IF (mp_projection_number > 0) THEN CALL DPrompt_for_Logical('Do you want to create a .DIG file in (lon,lat) format?', .TRUE., convert) IF (convert) THEN OPEN (UNIT = 1, FILE = TRIM(input_file_name), STATUS = 'OLD', IOSTAT = ios, PAD = 'YES') dot_place = INDEX(input_file_name, '.dig', .TRUE.) IF (dot_place <= 0) dot_place = INDEX(input_file_name, '.DIG', .TRUE.) IF (dot_place > 0) THEN ! input_file_name includes .dig or .DIG suggestion = input_file_name(1:dot_place-1) // '_lonlat.dig' ELSE ! input_file_name does not include .dig or .DIG suggestion = TRIM(ADJUSTL(input_file_name)) // '_lonlat.dig' END IF 500 CALL DPrompt_for_String('What filename shall it have?', TRIM(suggestion), output_file_name) OPEN (UNIT = 2, FILE = TRIM(output_file_name), STATUS = 'NEW', IOSTAT = ios) IF (ios /= 0) THEN CLOSE (UNIT = 2, IOSTAT = ios) WRITE (*,"(' ERROR: File already exists. Try again:')") suggestion = output_file_name GOTO 500 END IF ! file already exists getting_xy: DO READ (1, "(A)", IOSTAT = ios) line IF (ios == -1) EXIT getting_xy ! end of input file !Test for 'T', 't', 'F', 'f' in the line; !when one of these begins a word, list-directed input !processing treats it as .TRUE. or .FALSE. and converts !this value to 1.0 or 0.0, causing mis-alignment of !data and/or ficticious data points. For example, !the title line "TX" was read as .TRUE., converted to REAL !1.0, and assigned to the longitude, and then the !first number of the next line was read for the latitude! !Another time, the title line " 129 Tonga-1" was !interpreted as (+129.00E, +1.00N), causing an unwanted !great-circle arc to that point! includes_TF = ((SCAN(line,'T') > 0).AND.(SCAN(line,'T') < 25)).OR. & & ((SCAN(line,'t') > 0).AND.(SCAN(line,'t') < 25)).OR. & & ((SCAN(line,'F') > 0).AND.(SCAN(line,'F') < 25)).OR. & & ((SCAN(line,'f') > 0).AND.(SCAN(line,'f') < 25)) IF (includes_TF) THEN ! this is always a title line WRITE (2,"(A)") TRIM(line) ELSE ! may still be a title line (without T,F) or an ***end READ (line, *, IOSTAT = ios) x_user, y_user IF (ios == 0) THEN ! line had 2 numbers x_meters = x_user * mt_meters_per_user y_meters = y_user * mt_meters_per_user CALL DReject (x_meters, y_meters, success, uvec) IF (success) THEN CALL DUvec_2_LonLat (uvec, lon, lat) !WRITE (2, "(1X, SP, ES12.5, ',', ES12.5)") lon, lat WRITE (c24, "(SP, F10.5, ',', F9.5)") lon, lat !N.B. Longitude field may contain 0, 1, or 2 leading blanks. c24al = ADJUSTL(c24) ! necessary so that first byte will always be '+' or '-' WRITE (2, "(1X, A)") TRIM(c24al) END IF ELSE ! line was a title or ***end WRITE (2,"(A)") TRIM(line) END IF END IF END DO getting_xy CLOSE(1) CLOSE(2) WRITE (*,"(/' Job completed.'/)") END IF ! convert END IF ! projection was defined END IF ! infile_is_lonlat or not ! - - - - - POSSIBLE LOOP FOR MORE THAN ONE .dig FILE - - - - - - - - - WRITE (*,"(' ')") CALL DPrompt_for_Logical('Do you want to process another .DIG file with the SAME projection and coordinate system?', .FALSE., do_another) IF (do_another) THEN 600 WRITE (*, "(//' Enter [path\]filename of your next .dig file: ')") READ (*, "(A)") input_file_name input_file_name = ADJUSTL(input_file_name) OPEN (UNIT = 1, FILE = TRIM(input_file_name), STATUS = 'OLD', IOSTAT = ios, PAD = 'YES') IF (ios /= 0) THEN WRITE (*,"(' ERROR: File not found (in this directory). Try again:')") GOTO 600 END IF ! file not found CLOSE(1) CALL DPrompt_for_Logical('Is this file composed ENTIRELY of closed polygons?', .FALSE., polygons) GO TO 200 END IF ! - - - - - FINISH THE MAP - - - - - - - - - - - - - - - - - - - - - - - ! reference lines CALL DSet_Line_Style (0.6D0, .TRUE., 2.0D0, 5.0D0) CALL DSet_Stroke_Color ('foreground') WRITE (*,"(' ')") IF (mp_projection_number == 0) THEN ! (x,y) axes desired CALL DPrompt_for_Integer('How many kilometers apart should fiducial lines& & of constant x and constant y be plotted?', 100, kilometers) CALL DWire_Mesh (kilometers) ELSE ! parallels and meridians desired CALL DPrompt_for_Integer('How many minutes apart should parallels& & and meridians be plotted?', 600, minutes) CALL DGraticule (minutes) END IF !numbered margin: IF (mp_projection_number == 0) THEN ! (x,y) axes desired CALL DKilometer_Frame (kilometers) ELSE ! parallels and meridians desired CALL DLonLat_Frame (minutes) END IF ! titles IF (ai_toptitles_reserved) THEN WRITE (*, *) CALL DPrompt_for_Logical('Do you want titles in your .AI plot?', .TRUE., title_it) IF (title_it) THEN WRITE (*,"(' You will provide one title line, and the second will automatically')") WRITE (*,"(' record the chosen map projection (if any).')") WRITE (*,"(' Enter your title line below:')") READ (*, "(A)") line IF (mp_projection_number > 0) THEN CALL DTop_Titles (top_line = TRIM(line), & & bottom_line = TRIM(mp_projection)//' Projection') ELSE CALL DTop_Titles (top_line = TRIM(line), & & bottom_line = ' ') END IF END IF END IF CALL DEnd_Page END PROGRAM Projector