#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.6.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `#!/bin/sh' line above, then type `sh FILE'.
#
lock_dir=_sh18081
# Made on 2012-10-10 12:32 UTC by <toyoda@toyoda-eizi.net>.
# Source directory was `/var/www/html/2012/1004faxmap/faxmap'.
#
# Existing files will *not* be overwritten, unless `-c' is specified.
# This format requires very little intelligence at unshar time.
# "if test", "echo", "mkdir", and "sed" may be needed.
#
# This shar contains:
# length mode       name
# ------ ---------- ------------------------------------------
#   5128 -rw-rw-r-- faxmap.f
#    499 -rw-rw-r-- faxmap1.in
#    702 -rw-rw-r-- faxmap2.in
#    626 -rw-rw-r-- Makefile
#
echo=echo
shar_tty= shar_n= shar_c='
'
if test ! -d ${lock_dir}
then : ; else ${echo} 'lock directory '${lock_dir}' exists'
  exit 1
fi
if mkdir ${lock_dir}
then : ; else ${echo} 'failed to create lock directory'
  exit 1
fi
# ============= faxmap.f ==============
if test -f 'faxmap.f' && test "$first_param" != -c; then
  ${echo} 'x -SKIPPING faxmap.f (file already exists)'
else
${echo} 'x - extracting faxmap.f (text)'
  sed 's/^X//' << 'SHAR_EOF' > 'faxmap.f' &&
X* ex: set sw=2 ts=72:
X      PROGRAM MAP
X      IMPLICIT NONE
X
X      REAL, PARAMETER:: DY = 2.0
X      CHARACTER(4), PARAMETER:: LONS(4) = (/'0', '90E', '180', '90W'/)
X      REAL:: CLON = 140.0
X      REAL:: SIMFAC = 0.18
X      REAL:: VXOFF = 0.0
X      REAL:: VYOFF = 0.0
X      CHARACTER(32):: FNAME = 'faxmap'
X      INTEGER:: IWS = 1, WINSIZ = 900, THICK = 3
X      INTEGER, PARAMETER:: NFAX = 8
X      REAL:: X(4, NFAX) = -999.0
X      REAL:: Y(4, NFAX) = -999.0
X      INTEGER:: IDX(NFAX) = 1
X      CHARACTER(4):: TITLE(NFAX) = ''
X      CHARACTER(4):: OPTS(NFAX) = ''
X      INTEGER:: IOS, IX, ILON, IROT, IM, IP, ITYPE
X      NAMELIST /C/ IWS, WINSIZ, FNAME, TITLE, X, Y, IDX, CLON, OPTS,
X     $ SIMFAC, VXOFF, VYOFF, THICK
X      REAL:: RX(5), RY(5)
X      REAL, PARAMETER:: DR = 0.01
X
X      WRITE(*, NML=C)
X      CALL SGPWSN
X      READ(*, NML=C, IOSTAT=IOS)
X      WRITE(*, NML=C)
X
X      IF (IWS == 1 .or. IWS == 2) THEN
X        CALL SWISTX('IWIDTH',  WINSIZ)
X        CALL SWISTX('IHEIGHT', WINSIZ)
X        CALL SWCSTX('FNAME', fname)
X        CALL SWCSTX('TITLE', TRIM(fname) // ' - FAX MAP by Eizi TOYODA')
X      ENDIF
X
X      CALL SGOPN( -ABS(IWS) )
X
X      CALL SGRSET( 'STLAT1', 45.0 )
X      CALL SGRSET( 'STLAT2', 30.0 )
X
X      CALL UMLSET( 'LGRIDMN', .FALSE. )
X      CALL UMISET( 'INDEXMJ', 1 )
X      CALL UMISET( 'ITYPEMJ', 2 )
X
X      CALL SGFRM
X
X      CALL SGSSIM( SIMFAC, VXOFF, VYOFF )
X      CALL SGSMPL( REAL(CLON), 90.0, 0.0 )
X      CALL SGSVPT( 0.0, 1.0, 0.0, 1.0 )
X      CALL SGSTXY( -180.0, 180.0, -90.0, 90.0 )
X      CALL SGSTRN( 31 )
X      CALL SGSTRF
X
X      CALL SGLSET( 'LCLIP', .TRUE. )
X      CALL SLPWWR( 1 )
X      CALL SLPVPR( 1 )
X
X      DO, IX = 1, 4
X        ILON = 90 * (IX - 1)
X        IROT = ILON + CLON + 90
X        CALL SGTXZU( REAL(ILON), -DY, LONS(IX), 0.012, IROT, 0, 1)
X        CALL SGTXZU( REAL(ILON),  DY, 'EQ', 0.012, IROT, 0, 1)
X        CALL SGTXZU( REAL(ILON), 30.0 + DY, '30N', 0.012, IROT, 0, 1)
X        CALL SGTXZU( REAL(ILON), 60.0 + DY, '60N', 0.012, IROT, 0, 1)
X      ENDDO
X
X      DO, IM = 1, NFAX
X        IF (TITLE(IM) == '') CYCLE
X        IF (INDEX(OPTS(IM), 'H') > 0) THEN
X          ITYPE = 2
X        ELSE IF (INDEX(OPTS(IM), 'D') > 0) THEN
X          ITYPE = 3
X        ELSE
X          ITYPE = 1
X        ENDIF
X        IF (INDEX(OPTS(IM), 'L') > 0) THEN
X          CALL DRBOXU(X(1:4, IM), Y(1:4, IM), ITYPE, THICK)
X          CALL SGTXZU(X(IDX(IM), IM) + DY, Y(IDX(IM), IM) + DY,
X     $                TITLE(IM), 0.02, 0, -1, THICK)
X        ELSE
X          DO, IP = 1, 4
X            CALL PROJECT(X(IP, IM), Y(IP, IM), RX(IP), RY(IP))
X          ENDDO
X          RX(5) = RX(1)
X          RY(5) = RY(1)
X          CALL SGPLZR(5, RX, RY, ITYPE, THICK)
X          CALL SGTXZR(RX(IDX(IM)) + DR, RY(IDX(IM)) - DR, TITLE(IM),
X     $                0.02, 0, -1, THICK)
X        ENDIF
X      ENDDO
X
X      CALL UMPMAP( 'coast_world' )
X      CALL UMPGLB
X
X      CALL SGCLS
X
X      CONTAINS
X
X        SUBROUTINE PROJECT(UX, UY, RX, RY)
X          REAL, INTENT(IN):: UX, UY
X          REAL, INTENT(OUT):: RX, RY
X          REAL:: VX, VY
X          CALL STFTRF(UX, UY, VX, VY)
X          CALL STFPR2(VX, VY, RX, RY)
X        END SUBROUTINE
X
X        INTEGER FUNCTION NDIVS(LON1, LON2)
X          REAL, INTENT(IN):: LON1, LON2
X          NDIVS = CEILING(ABS(LON1 - LON2))
X        END FUNCTION
X
X        REAL FUNCTION ANBUN(A, B, N, I)
X          REAL, INTENT(IN):: A, B
X          INTEGER, INTENT(IN):: N, I
X          ANBUN = A + (B - A) * REAL(I) / REAL(N)
X        END FUNCTION
X
X        SUBROUTINE DRBOXU(UX, UY, ITYPE, INDX)
X          REAL, INTENT(IN):: UX(4)
X          REAL, INTENT(IN):: UY(4)
X          INTEGER, INTENT(IN):: ITYPE
X          INTEGER, INTENT(IN):: INDX
X          REAL, ALLOCATABLE:: RX(:)
X          REAL, ALLOCATABLE:: RY(:)
X          INTEGER:: IPATH, IPREV, INEXT, NP, I, INOW, MDIVS
X          REAL:: UX1, UY1
X          NP = 1
X          DO, IPATH = 1, 4
X            IPREV = MOD(IPATH - 1, 4) + 1  !! [1, 2, 3, 4]
X            INEXT = MOD(IPATH, 4) + 1      !! [2, 3, 4, 1]
X            IF (UX(IPREV) == UX(INEXT)) THEN
X              NP = NP + 1
X            ELSE
X              NP = NP + NDIVS(UX(IPREV), UX(INEXT))
X            ENDIF
X          ENDDO
X          ALLOCATE(RX(NP), RY(NP))
X          I = 1
X          CALL PROJECT(UX(1), UY(1), RX(I), RY(I))
X          DO, IPATH = 1, 4
X            IPREV = MOD(IPATH - 1, 4) + 1
X            INEXT = MOD(IPATH, 4) + 1
X            IF (UX(IPREV) == UX(INEXT)) THEN
X              I = I + 1
X              IF (I > NP) STOP "OVERFLOW 1"
X              CALL PROJECT(UX(INEXT), UY(INEXT), RX(I), RY(I))
X            ELSE
X              INOW = I
X              MDIVS = NDIVS(UX(IPREV), UX(INEXT))
X              DO, I = INOW + 1, INOW + MDIVS
X                IF (I > NP) STOP "OVERFLOW 2"
X                UX1 = ANBUN(UX(IPREV), UX(INEXT), MDIVS, I - INOW)
X                UY1 = ANBUN(UY(IPREV), UY(INEXT), MDIVS, I - INOW)
X                CALL PROJECT(UX1, UY1, RX(I), RY(I))
X              ENDDO
X              I = INOW + MDIVS
X            ENDIF
X          ENDDO
X          CALL SGPLZR(I, RX, RY, ITYPE, INDX)
X          DEALLOCATE(RX)
X          DEALLOCATE(RY)
X        END SUBROUTINE
X
X      END
SHAR_EOF
:
if test $? -ne 0
then ${echo} 'restore of faxmap.f failed'
fi
fi
# ============= faxmap1.in ==============
if test -f 'faxmap1.in' && test "$first_param" != -c; then
  ${echo} 'x -SKIPPING faxmap1.in (file already exists)'
else
${echo} 'x - extracting faxmap1.in (text)'
  sed 's/^X//' << 'SHAR_EOF' > 'faxmap1.in' &&
X#!/bin/sh
X./faxmap <<EOF
X&C
X IWS=2
X FNAME='faxmap1'
X SIMFAC = 0.4
X VXOFF = 0.05
X VYOFF = 0.4
X THICK = 7
X TITLE(1) = 'A''', IDX(1) = 3
X X(:, 1) =   85.7379, 110.6508, 157.2087, 177.4324
X Y(:, 1) =   38.3043, 12.5207, 17.5853, 50.7744
X TITLE(2) = 'C', IDX(2) = 3, OPTS(2) = 'H'
X X(:, 2) =   63.5200, 106.3566, 159.8052, 206.0428
X Y(:, 2) =   26.3793, -4.8562, 2.1475, 50.6943
X TITLE(8) = 'C"', IDX(8) = 3, OPTS(8) = 'D'
X X(:, 8) =   67.0, 112.4, 166.7, 212.4
X Y(:, 8) =   37.5, -1.0, -0.5, 39.0
X/
XEOF
SHAR_EOF
:
if test $? -ne 0
then ${echo} 'restore of faxmap1.in failed'
fi
fi
# ============= faxmap2.in ==============
if test -f 'faxmap2.in' && test "$first_param" != -c; then
  ${echo} 'x -SKIPPING faxmap2.in (file already exists)'
else
${echo} 'x - extracting faxmap2.in (text)'
  sed 's/^X//' << 'SHAR_EOF' > 'faxmap2.in' &&
X&C
X IWS=2
X FNAME='faxmap2'
X SIMFAC = 0.19
X VYOFF = 0.1
X THICK = 7
X TITLE(3) = 'D', IDX(3) = 3
X X(:, 3) =   64.7916, 132.2762, 234.9165, 328.2525
X Y(:, 3) =   -3.2988, -1.3412, 14.6670, 11.3931
X TITLE(4) = 'O', IDX(4) = 4, OPTS(4) = 'H'
X X(:, 4) =   10.0000, 62.9409, 143.4044, 190.0000
X Y(:, 4) =   36.2358, 9.8592, 4.5259, 25.1770
X TITLE(5) = 'Q', IDX(5) = 3, OPTS(5) = 'D'
X X(:, 5) =   44.4258, 107.1215, 174.5007, 237.6680
X Y(:, 5) =   28.3229, -3.5517, -3.3003, 29.0315
X TITLE(6) = 'W', IDX(6) = 3, OPTS(6) = 'L'
X X(:, 6) =   80.0, 80.0, 200.0, 200.0
X Y(:, 6) =   60.0, -20.0, -20.0, 60.0
X TITLE(7) = 'D''', IDX(7) = 3
X X(:, 7) =   5.0, 97.0, 183.0, 275.0
X Y(:, 7) =   -13.5, -15.5, -15.5, -13.5
X/
SHAR_EOF
:
if test $? -ne 0
then ${echo} 'restore of faxmap2.in failed'
fi
fi
# ============= Makefile ==============
if test -f 'Makefile' && test "$first_param" != -c; then
  ${echo} 'x -SKIPPING Makefile (file already exists)'
else
${echo} 'x - extracting Makefile (text)'
  sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
XDCLFRT=dclfrt
X
XPSS =	faxmap1.ps faxmap2.ps
XEPSS = $(PSS:.ps=.eps)
XPNGS = $(PSS:.ps=.png)
XBMPS = $(PSS:.ps=.bmp)
XINS = $(PSS:.ps=.in)
X
Xall: ps
Xps: $(PSS)
Xeps: $(EPSS)
Xpng: $(PNGS)
Xbmp: $(BMPS)
X
X.SUFFIXES:
X.SUFFIXES: .in .ps .png .eps .bmp
X
X$(PSS): faxmap
X
X.in.ps:
X	./faxmap < $<
X
X.ps.eps:
X	sed \
X	's/^%%BoundingBox: 31 43 563 795/%%BoundingBox: 31 152 563 685/' \
X	$< > $@
X
X.eps.png:
X	convert $< $@
X
X.eps.bmp:
X	convert -density 200x200 $< $@
X
Xfaxmap: faxmap.f
X	$(DCLFRT) -g -o faxmap faxmap.f `gtk-config --libs`
X
Xclean:
X	rm -f *~ *.bak *.o faxmap *.ps *.eps *.png *.shar
X
Xshar:
X	shar -V Makefile faxmap.f $(INS) > faxmap.shar
SHAR_EOF
:
if test $? -ne 0
then ${echo} 'restore of Makefile failed'
fi
fi
if rm -fr ${lock_dir}
then ${echo} 'x - removed lock directory `'${lock_dir}\''.'
else ${echo} 'x - failed to remove lock directory `'${lock_dir}\''.'
  exit 1
fi
exit 0