C
c    program will plot macroseismic observations using GMT
c    can read web files and  seisan storage files,
c    web files are converted to seisan files
c   
c    input is a web file or a seisan macroseismic file
c
c    output is a gmt file macromacp.gmt with commands to plot the
c    macroseismic observations together with an input file iso.inp.
c    within the program, the gmt script is executed and the map ps
c    file macromap.eps displayed.
c
c    if input is from a web file made with macroquest, the plot is also 
c    made and an output file macromap.out is also generated in seisan 
c    macroformat. the program then needs an input file with postal codes.
c
c    The program can also take input from the prompt line:
c
c      -macroinput        file with macroseismic observations,
c                         abs path or in ISO
c      -placename         additional file with place names,
c                         abs path or in DAT, epimap format
c      -postfile          file with postal code, abs path
c
c      -lat               epicenter latitude
c
c      -lon               epicenter longitude
c    
c
c    If used with eev, the place name file must have name place_names.macro
c    
c
c    j. havskov, january 2005
c
c  changes
c
c  feb 15 2006 jh : add epicenter 
c  apr 5  2006 jh : add correct seisan output file name if web input
c  jun 20 2006 jh : change ps to eps
c  jan 26 2007 bm : change colors
c  mar 6  2007 jh : end criteria not err but '---' for macro fil
c  mar 23 2007 jh : make sure size of map ok if only one point
c  may 28 2008 jh : make map 0.1 deg larger in all directions
c  oct 31 2008 jh : change user/bin to bin
c
c
c
      implicit none
      include 'libsei.inc'

      character*120 text(100)		! general text
      character*80  txt                 ! general text
      character*80 txt_all(5000)        ! whole web file
      character*80 macroinput 		! input file with lat,lon and intensity
      character*80 post_file            ! file with postal codes
      real lat(5000),lon(5000) 		! latitutde and longitude
      real intensity(5000)		! intensity
      real max_lat,min_lat		! latitude limits
      real max_lon,min_lon		! longitude limits
      real epi_lat,epi_lon              ! epicenter
      integer n_observations		! number of intnesity points
      character*80 title		! plot title
      character*80 place_name_file	! place name file, seisan format
      character*80 p_name		! place name
      integer seiclen                   ! function to get length of string
      logical plot_gmt                  ! if true, plot 
      real x,y                          ! help variable
      character*3 format                ! format of input file
      integer narg                      ! number of arguments
      character*80 arg(40)              ! arguments
      integer npost                     ! number of postal codes
      character*10 post_code(10000)     ! postal codes
      character*10 ppost                ! one postal code
      character*30 psite(10000)         ! postal sites
      character*30 one_site             ! one postal site
      character*30 reported_site        ! reported site
      character*80 file_name            ! seisan type output file name
      real plat(10000),plon(10000)      ! lat-lon of postal sites
      integer year,month,day,hour,min,sec
      integer local_hour                ! local hour
      integer nweb                      ! number of lines in web file
      integer n_bad                      ! number of missign postal codes
      real ratio                        ! ratio between yand x on plot
      real xsize                        ! x size in cm
      

      integer i,k,kk,code,l,m,ll

      plot_gmt=.true.
      place_name_file=' '
      post_file=' '
      epi_lat=999.0
      epi_lon=999.0
      n_bad=0

c
c   get arguments
c
      call get_arguments(narg,arg)

      if(narg.lt.2) then
c
c   get file names
c
         write(6,*)' Input file name with macroseismic data'
         read(5,'(a)') macroinput
         write(6,*)' Place name file, return for none'
         read(5,'(a)') place_name_file
         write(6,*)' File with postal codes, return for none',
     *   ' or default if web file input'
         read(5,'(a)') post_file
      else
         do i=1,narg
            if(arg(i)(1:11).eq.'-macroinput') then
               macroinput=arg(i+1)
            endif
            if(arg(i)(1:10).eq.'-placename') then
               place_name_file=arg(i+1)
            endif
            if(arg(i)(1:10).eq.'-postfile') then
               post_file=arg(i+1)
            endif
            if(arg(i)(1:4).eq.'-lat') then
               read(arg(i+1),'(f8.3)') epi_lat
            endif
            if(arg(i)(1:4).eq.'-lon') then
               read(arg(i+1),'(f8.3)') epi_lon
            endif
          enddo
      endif
      if(epi_lat.lt.900) write(6,*)' Epicenter',epi_lat,epi_lon
c
c   make file with color tables
c
      open(1,file='macro.cpt',status='unknown')
      write(1,'(a)')
     *'0       255     255     0       3     255       255     0'
      write(1,'(a)')
     *'3       255     200     100     4     255       200     100'
      write(1,'(a)')
     *'4       160     96      224     5     160        96     224'
      write(1,'(a)')
     *'5       0       255     0       6       0       255       0'
      write(1,'(a)')
     *'6       0       0       255     7       0         0     255'
      write(1,'(a)')
     *'7       255       0     0       8       255       0       0'
      write(1,'(a)')
     *'8       255     255     255     9       255     255     255'
      write(1,'(a)')
     *'B         0     224     255'
      write(1,'(a)')
     *'F       0       0       0'
      write(1,'(a)')
     *'N       128     128     128'
      close(1)
c
c
c   open file with macroseismic info

c
c   open file in ISO if fom eev (inputy from prompt)
c
      if(narg.ge.2) then
         call sei get file( open$,            ! Get file.
     &                          k,            ! Opened on this unit.
     &                      code,             ! Returned condition.
     &                      'ISO',            ! Alternative directory to search.
     &                      macroinput)       ! For this station file.
         if(code.ne.e_ok$) then
            write(6,*)' Macroseismic file missing'
            stop
         endif
      else
         k=10
         open(k,file=macroinput,status='old')
      endif


c
c   find format, new or web
c
      format=' '
c
c  try  if web format
c
      read(k,'(a)') txt
      if(txt(1:20).eq.'--------------------') then
          format='web'
          goto 6
      endif
c
c   try new format
c
      rewind k
      read(k,'(a)') txt
      if(txt(49:51).eq.'GMT') then
         format='new'
         goto 6
      endif

 6    continue
      rewind k
c
      if(format.eq.' ') then
         write(6,*)' Unknown format'
         stop
      else
         write(6,'(a,a)')' Format: ',format
      endif
c
c   if web format, input date etc
c
      if(format.eq.'web') then
      write(6,*)' enter GMT year,month,day,hour,min,sec'
      read(5,*) year,month,day,hour,min,sec
      write(6,*) 'enter local hour'
      read(5,*) local_hour
      write(6,*)' enter location, max 30 chars'
      read(5,'(a)') txt(1:40)
      write(6,*) txt(1:40)
      write(file_name,'(i4,a,i2,a,i2,a,2i2,a,i2,a)')
     *year,'-',month,'-',day,'-',
     *hour,min,'-',sec,'.MACRO'
      do i=1,21
        if(file_name(i:i).eq.' ') file_name(i:i)='0'
      enddo
      write(6,*) ' File name for SEISAN ', file_name
      open(9,file=file_name,status='unknown')
      write(9,
     *'(a,i4,1x,2i2,1x,2i2,1x,i2,a,i4,1x,2i2,1x,2i2,1x,i2,a)')
     * txt(1:30), year,month,day,hour,min,sec,' GMT ',
     * year,month,day,local_hour,min,sec,' Local time'
       write(9,*)'Comment'
      endif


c   open and read postal codes, if a web file, also try to use
c   default file if no name is given
c
      npost=0
      kk=0
c
c   first check if a default post file is to be used
c
      if(format.eq.'web'.and.post_file.eq.' ') then
        call sei get file( open$,            ! Get file.
     &                          kk,           ! Opened on this unit.
     &                      code,             ! Returned condition.
     &                      'DAT',            ! Alternative directory to search.
     &                      'postal_code.dat')! For this file.
         if(code.ne.e_ok$) then
            write(6,*)' File postal_code.dat is missing'
            stop
         endif
      endif
c
c   specific name is given
c
c
      if(post_file.ne.' ') then
         kk=1
         open(kk,file=post_file,status='old')
      endif
c
c   now read if a file there
c
      if(kk.gt.0) then
         i=1
 1       continue
         read(kk,'(a10,2f10.3,2x,a30)',end=2)
     *   post_code(i),plat(i),plon(i),psite(i)
         i=i+1
         goto 1
 2       continue
         npost=i-1
         write(6,*) ' Number of postal codes', npost
         close(kk)
      endif
c
c   read observations file
c
      if(format.eq.'old') then
         read(k,'(a)') text(1)
         do i=1,10000
            n_observations=i-1
            read(k,'(28x,2f7.2,8x,f3.1)',end=10) 
     *      lat(i),lon(i),intensity(i)
         enddo
 10      continue
      endif
     
c
      if(format.eq.'new') then
         read(k,'(a)')title(1:48) 
         read(k,'(a)') txt
         do i=1, 10000
           n_observations=i-1
           read(k,'(a)',end=5) txt
           if(txt(1:5).eq.'-----') goto 5     ! new section with original data
           read(txt,'(2f10.3,f6.1)') 
     *     lat(i),lon(i),intensity(i)
           if(lat(i).eq.0.0.or.lon(i).eq.0.0) then
              n_observations=n_observations-1
              goto 5
           endif
         enddo
 5       continue
      endif
c
      if(format.eq.'web') then
         i=1
         ll=1
c        open(2,file='macromap.out',status='unknown')
         open(7,file='macromap_bad.out',status='unknown')
         read(k,'(a)') txt
         txt_all(ll)=txt
         ll=ll+1
         read(k,'(a)') txt
         txt_all(ll)=txt
         ll=ll+1
         read(k,'(a)') txt
         txt_all(ll)=txt
         ll=ll+1
 7       continue
         read(k,'(a)',end=8) txt  
         txt_all(ll)=txt
         ll=ll+1
         if(txt(1:10).eq.'----------') then ! new observation
           i=i+1
         endif
         if(txt(1:10).eq.'intensitet') then
            if(txt(19:20).eq.'II') intensity(i)=2
            if(txt(19:21).eq.'III') intensity(i)=3
            if(txt(19:20).eq.'IV') intensity(i)=4
            if(txt(19:20).eq.'V ') intensity(i)=5
            if(txt(19:20).eq.'VI') intensity(i)=6
            if(txt(19:21).eq.'VII') intensity(i)=7
            if(txt(19:22).eq.'VIII') intensity(i)=8
            if(txt(19:20).eq.'IX') intensity(i)=9
            if(txt(19:20).eq.'X ') intensity(i)=10
            goto 7
         endif
c
c   read site
c
         if(txt(1:11).eq.'postal site') then
            reported_site=txt(19:48)
            goto 7
         endif
c
c        if(txt(1:11).eq.'postal code') then
         if(txt(1:6).eq.'postnr') then
           ppost=txt(19:28)
c          write(6,*) ppost
c
c   find lat long corresponding to postal code
c
           if(npost.eq.0) then
             write(6,*)' No post code file'
             stop
           else
             one_site='code unknown'
             lat(i)=999
             lon(i)=999
             do l=1,npost
c              write(17,*) l, ppost(1:4),' ',post_code(l)(1:4)
c              if(ppost).eq.post_code(l)) then
               if(ppost(1:4).eq.post_code(l)(1:4)) then
                  lat(i)=plat(l)
                  lon(i)=plon(l)
                  one_site=psite(l)
               endif
             enddo
c            write(17,*)
             if(lat(i).lt.900) then
                write(9,'(2f10.3,2x,f3.1,1x,a3,1x,a10,2x,2a)')
     *          lat(i),lon(i),intensity(i),'EMS',
     *          ppost,one_site(1:20),
     *          reported_site(1:17)
             else
                write(7,'(2f10.3,2x,f3.1,1x,a3,1x,a10,2x,2a)')
     *          lat(i),lon(i),intensity(i),'EMS',
     *          ppost,one_site(1:20),
     *          reported_site(1:17)
                i=i-1
                n_bad=n_bad+1
             endif
           endif
         endif
         goto 7
 8       continue
         nweb=ll-1
         n_observations=i
c
c   write original web observation
c
         do i=1,nweb
           write(9,'(a)') txt_all(i)
         enddo
         close(9)
      endif
      if(narg.ge.2) call sei close (close$,k,code)


  
c
c  open file with place names, read and write
c
      if(place_name_file.ne.' ') then
c
c
c   open file in DAT
c
         call sei get file( open$,            ! Get file.
     &                          m,            ! Opened on this unit.
     &                      code,             ! Returned condition.
     &                      'DAT',            ! Alternative directory to search.
     &                      place_name_file)  ! For this station file.
         if(code.ne.e_ok$) then
            write(6,*)' Place name file missing'
         endif

        open(4,file='place_name.gmt',status='unknown')
        k=0
 11     continue
        read(m,'(a)',end=12) txt
        k=k+1
        i=index(txt,'  ')
        p_name=txt(1:i)       ! save name
        txt(1:80-i+1)=txt(i:80) ! strip off name
        call sei get values( 2, txt, code )        ! Parse text.
        y=array$(1)                         
        x=array$(2)
        write(4,'(2f8.3,a,a)') 
     *  x,y,' 12 0 1 CM ',p_name(1:seiclen(p_name))
        goto 11
 12     continue
        write(6,*)' Number of place names', k
        call sei close (close$,m,code)
        close(4)
      endif
c
c   write out for gmt script
c
      open(3,file='iso.inp',status='unknown')
      k=1
      do i=1,n_observations
         if(lat(i).ne.999.0.or.lon(i).ne.999.0) then
            lat(k)=lat(i)
            lon(k)=lon(i)
            k=k+1
            write(3,*) lon(i),lat(i),intensity(i)
         endif
      enddo
      close(3)

c
c   find limits
c
      max_lat=-100.0
      min_lat=100.0
      max_lon=-400.0
      min_lon=400.0
      do i=1,n_observations
        if(lat(i).gt.max_lat) max_lat=lat(i)
        if(lat(i).lt.min_lat) min_lat=lat(i)
        if(lon(i).gt.max_lon) max_lon=lon(i)
        if(lon(i).lt.min_lon) min_lon=lon(i)
      enddo
c
c   if epicenter is given, make sure it is on map
c
      if(epi_lat.lt.900.0) then
        if(epi_lat.gt.max_lat) max_lat=epi_lat
        if(epi_lat.lt.min_lat) min_lat=epi_lat
        if(epi_lon.gt.max_lon) max_lon=epi_lon
        if(epi_lon.lt.min_lon) min_lon=epi_lon
      endif
c
c  make sure min and max is not the same
c
      if(max_lat-min_lat.lt.0.1) max_lat=max_lat+0.1
      if(max_lon-min_lon.lt.0.1) max_lon=max_lon+0.1


c
c    check that it fits and make it a bit bigger than observations
c
c     i=2*max_lat
c     max_lat=i
c     if(i.gt.0) max_lat=max_lat+1.0
c     max_lat=max_lat/2.0
      max_lat=max_lat+(max_lat-min_lat)*0.2
      max_lat=max_lat+0.1
      

c     i=2*min_lat
c     if(i.lt.0) i=i-1.0
c     min_lat=i
c     min_lat=min_lat/2.0
      min_lat=min_lat-(max_lat-min_lat)*0.2
      min_lat=min_lat-0.1

c
c   ratio on map
c
      ratio=(max_lat-min_lat)/((max_lon-min_lon)*cos(max_lat/57.0))
c
c   horizontal size. if both y and x size the same, map will be 12 cm wide
c
      xsize=34.0/ratio
      if(xsize.gt.12.0) xsize=12.0

c     i=2*max_lon
c     max_lon=i
c     if(i.gt.0) max_lon=max_lon+1.0
c     max_lon=max_lon/2.0
      max_lon=max_lon+(max_lon-min_lon)*0.2
      max_lon=max_lon+0.1


c     i=2*min_lon
c     if(i.lt.0) i=i-1.0
c     min_lon=i/2.0
      min_lon=min_lon-(max_lon-min_lon)*0.2
      min_lon=min_lon-0.1
c
      write(6,*)' Number of observations with postal code', 
     *           n_observations
      write(6,*)' Number of observations without postal code', 
     *           n_bad
      write(6,*)' Lat-lon range ',
     *            min_lat,max_lat,min_lon,max_lon

c
c   open file with gmt output script
c
      open(2,file='macromap.gmt',status='unknown')

      k=1
      text(k)='#!/bin/csh'  	    		! start of file
      k=k+1
      text(k)='gmtset UNIX_TIME FALSE'
      k=k+1
      text(k)='gmtset WANT_EURO_FONT TRUE'
      k=k+1
      text(k)='gmtset HEADER_FONT_SIZE 14'
      k=k+1
      write(text(k),'(a,4(f6.1,a))')'set REGION=',	! region limits
     *          min_lon,'/',max_lon,'/',min_lat,'/',max_lat,' '
      do i=12,36
        if(text(k)(i:i).eq.' ') text(k)(i:i)='0'        ! no blanks allowed
      enddo
      k=k+1
c
c   calculate horizontal scale in cm/deg
c
      x=xsize/(max_lon-min_lon)
      write(text(k),'(a,f5.2)')'set PROJ=m',x		! scale     
      if(text(k)(11:11).eq.' ') text(k)(11:11)='0'
      if(text(k)(12:12).eq.' ') text(k)(12:12)='0'
      k=k+1
      write(text(k),'(a,a,a)')'set TITLE="',title(1:48),'"' ! title
      k=k+1
      text(k)='set OUTFILE=macromap.eps'	! ps output file
      k=k+1
      text(k)='set INFILE=iso.inp'
      k=k+1
      write(text(k),'(a,f6.1)') 'set LEGLON=',max_lon+0.1  ! legion corner
      do i=12,15
        if(text(k)(i:i).eq.' ') text(k)(i:i)='0'           ! no blanks allowed
      enddo

      k=k+1
      write(text(k),'(a,f6.1)')'set LEGLAT=',max_lat       ! legion corner
      do i=12,15
        if(text(k)(i:i).eq.' ') text(k)(i:i)='0'           ! no blanks allowed
      enddo
      k=k+1
c
c   epicenter
c
      if(epi_lat.lt.900) then
         write(text(k),'(a,f9.3)')'set EVLON=',epi_lon
         do i=11,19
           if(text(k)(i:i).eq.' ') text(k)(i:i)='0'        ! no blanks allowed
         enddo
         k=k+1
         write(text(k),'(a,f9.3)')'set EVLAT=',epi_lat
         do i=11,19
           if(text(k)(i:i).eq.' ') text(k)(i:i)='0'        ! no blanks allowed
         enddo
         k=k+1
       endif
c
c  place names
c
      if(place_name_file.ne.' ') then
         text(k)='set PLACEFILE=place_name.gmt'
         k=k+1
      endif
c     text(k)='makecpt -Crainbow -I -T0/8/1  >! macro.cpt'
c
c   fixed commands
c

c     k=k+1
      text(k)='psbasemap -R$REGION -J$PROJ -B1.0f10m:'//
     *         '."$TITLE":WSne -K >! $OUTFILE'
      k=k+1
      text(k)='pscoast -R$REGION -J$PROJ -B1.0f10m:.'//
     *         '"$TITLE":WSne -Di -G255/224/192 -S128/192/224 -W2 '//
     *          '-O -K >> $OUTFILE'
      k=k+1
      if(place_name_file.ne.' ') then
         text(k)='psxy $PLACEFILE -R$REGION -J$PROJ -O'//
     *   ' -Ss0.3 -G0 -K >> $OUTFILE'
         k=k+1
         text(k)='pstext $PLACEFILE -R$REGION -J$PROJ'//
     *   ' -D0/0.4 -O -K >> $OUTFILE'
         k=k+1
      endif
c
c   epicenter
c
      if(epi_lat.lt.900) then
         text(k)='psxy -R$REGION -J$PROJ -B1.0f10m:."$TITLE":WSne'//
     *   ' -O -K -Sa0.8c -G255/255/0 -W1 << EOF >> $OUTFILE'
         k=k+1
         text(k)='$EVLON $EVLAT'
         k=k+1
         text(k)='EOF'
         k=k+1
      endif
c
      text(k)='psxy $INFILE -R$REGION -J$PROJ -B1.0f10m:.'//
     *         '"$TITLE":WSne'//
     *         ' -Cmacro.cpt -O -Sc0.3c -W -G0/0/0 -K >> $OUTFILE'
      k=k+1
      if(epi_lat.lt.900) then
         text(k)='pslegend -R$REGION -J$PROJ -D$LEGLON/$LEGLAT/'//
     *           '2.8/5.2/TL -O -F -G255/255/255 << EOF >> $OUTFILE'
         k=k+1
      else
         text(k)='pslegend -R$REGION -J$PROJ'//
     *           ' -D$LEGLON/$LEGLAT/2.3/4.7/TL'//
     *           ' -O -F -G255/255/255 << EOF >> $OUTFILE'
         k=k+1
      endif
      text(k)='C 0/0/0'
      k=k+1
      text(k)='H 10 1 Intensity'
      k=k+1
      text(k)='D 0.1 1'
      k=k+1
      text(k)='N 1'
      k=k+1
      text(k)='S 0.2 c 0.3c 255/255/0 1p 0.6c I = 0-II '
      k=k+1
      text(k)='S 0.2 c 0.3c 255/200/100 1p 0.6c I = III'
      k=k+1
      text(k)='S 0.2 c 0.3c 160/96/225 1p 0.6c I = IV'
      k=k+1
      text(k)='S 0.2 c 0.3c 0/255/0 1p 0.6c I = V'
      k=k+1
      text(k)='S 0.2 c 0.3c 0/0/255 1p 0.6c I = VI'
      k=k+1
      text(k)='S 0.2 c 0.3c 255/0/0 1p 0.6c I = VII'
      k=k+1
      text(k)='S 0.2 c 0.3c 255/255/255 1p 0.6c I = VIII'
      k=k+1
      if(epi_lat.lt.900.0)then 
         text(k)='S 0.2 a 0.5c 255/255/0 1p 0.6c epicenter'
         k=k+1
      endif
      text(k)='EOF'
c
c   write gmt script
c

      do i=1,k 
         write(2,'(a)') text(i)(1:seiclen(text(i)))
      enddo
      close(2)
c
c   plot gmt script if that option
c
      if(plot_gmt) then
        call systemc('chmod +x macromap.gmt',21)   ! make it executable
        call systemc
     *  ('macromap.gmt',12)    ! run gmt
        call systemc('gv macromap.eps',15)         ! plot
        call systemc(
     *   'gs -sDEVICE=jpeg -sOutputFile=macromap.jpeg macromap.eps',
     *    56)

      endif

      if(format.eq.'web') then
         write(6,*)
     *   ' Output file with identified sites is macromap.out'
         write(6,*)
     *   ' Output file with un-identified sites is macromap_bad.out'
      endif
      stop
      end
