module hershey_symb
  !
  integer :: nc1,nc2
  !
  integer, parameter :: maxbuf=27000
  integer :: buffer(maxbuf)
  !
  integer, parameter :: maxind=3000
  integer :: index(maxind)
  !
end module hershey_symb
!
subroutine hershey2gag(file)
  use gchar_dependencies_interfaces
  use gchar_interfaces, except_this=>hershey2gag
  use gchar_variables
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Build of the GREG character set from the HERSHEY one
  !
  ! Organisation :
  !	2 Quality of characters
  !		1 FAST		2 DUPLEX
  !	3 Set of characters per quality
  !		1 ROMAN		2 GREEK		3 SCRIPT
  ! 	95 Characters per set
  !
  ! Addressing is based on the ASCII code of the character:
  ! INDEX = ICHAR(caractere) - ICHAR(' ') + 1 + 100*(NJEU-1) + 300*(NQUAL-1)
  !---------------------------------------------------------------------
  character(len=*) :: file          !
  ! Local
  character(len=*), parameter :: rname='HERSHEY'
  integer(kind=1) :: xy(400)
  integer :: n,j,k,l,nchar
  logical :: unused
  integer :: i(nkchar)
  character(len=4) :: sycode
  character(len=message_length) :: mess
  !
  ! Delete file if it already exists
  if (gag_inquire(file,lenc(file)).eq.0) call gag_delete(file)
  !
  ! Load the correspondance table
  call coresp(i)
  !
  ! Load HERSHEY font
  call bldfil
  !
  nchar = 0
  do j=1,nkchar
    call gsymxd(i(j),xy,n,unused)
    if (unused) then
      write(mess,*) j,i(j),' is not used'
      call gchar_message(seve%u,rname,mess)
      ladj(j) = 0
      radj(j) = 0
      pointe(j) = 0
      nstrok(j) = 0
    else
      ladj(j) = xy(4)
      radj(j) = xy(5)
      pointe(j) = nchar
      k = 0
      l = 6
      do while (xy(l+1).ne.-64)
        font(nchar+l-6) = xy(l)
        font(nchar+l-5) = xy(l+1)
        l = l+2
        k = k+1
      enddo
      nstrok(j) = k
      nchar = nchar + 2*k
    endif
  enddo
  !
  write (mess,*) nchar,' bytes used'
  call gchar_message(seve%d,rname,mess)
  !
  ! Write binary stuff
  call gdf_getcod(sycode)
  call chtoby(sycode,vstrsh1,4)
  call suwrit(file,vstrsh1,nkpage)
  !
end subroutine hershey2gag
!
subroutine gsymxd(number,xygrid,nstrok,unused)
  use gchar_interfaces, except_this=>gsymxd
  use hershey_symb
  !---------------------------------------------------------------------
  ! @ private
  ! GRPCKG (internal routine):
  !	Return the digitization coordinates of a character. Each
  !	character is built up on a grid with X and Y coordinates
  !	in the range (-49,49), with the origin (0,0) at the center
  !	of the character.  The coordinate system is right-handed,
  !	with X positive to the right, and Y positive upward.
  !	Characters are drawn with their tops upward, towards
  !	positive Y values.
  !
  ! Arguments:
  ! 	NUMBER 	I	symbol number in range (1..3000).	Input
  ! 	XYGRID 	L*1(*)	Height range, width range, and pairs	Output
  !			of (X,Y) coordinates returned.
  !			Height range = (XYGRID(1),XYGRID(3)).
  !			Width range = (XYGRID(4),XYGRID(5)).
  !			(X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...).
  !	NSTROK	I	Number of strokes			Output
  ! 	UNUSED	L	Set to .TRUE. if NUMBER is an unused 	Output
  !			symbol number. A character of normal
  !			height and zero width is returned.
  !			Set to .FALSE. if NUMBER is a valid
  !			symbol number.
  !
  !	The height range consists of 3 values: (minimum Y, baseline
  !	Y, maximum Y).  The first is reached by descenders on
  !	lower-case g, p, q, and y.  The second is the bottom of
  !	upper-case letters.  The third is the top of upper-case
  !	letters.  A coordinate pair (-64,0) requests a pen raise,
  !	and a pair (-64,-64) terminates the coordinate list.  It is
  !	assumed that movement to the first coordinate position will
  !	be done with the pen raised - no raise command is
  !	explicitly included to do this.
  !
  ! (7-Mar-1983)
  !---------------------------------------------------------------------
  integer :: number                 !
  integer(kind=1) :: xygrid(400)    !
  integer :: nstrok                 !
  logical :: unused                 !
  ! Local
  integer :: ix,iy,k,l,locbuf
  !
  ! Extract digitization.
  !
  if (number.lt.nc1 .or. number.gt.nc2) goto 3000
  l = number - nc1 + 1
  locbuf = index(l)
  if (locbuf .eq. 0) goto 3000
  xygrid(1) = buffer(locbuf)
  locbuf = locbuf + 1
  k = 2
  iy = -1
  !
10 continue
  ix = buffer(locbuf)/128
  iy = buffer(locbuf) - 128*ix - 64
  xygrid(k) = ix - 64
  xygrid(k+1) = iy
  k = k + 2
  locbuf = locbuf + 1
  if (iy.ne.-64) goto 10
  !
  unused = .false.
  nstrok = (k-6)/2
  return
  !
  !		Unimplemented character.
  !
3000 xygrid(1) = -16
  xygrid(2) =  -9
  xygrid(3) = +12
  xygrid(4) =   0
  xygrid(5) =   0
  xygrid(6) = -64
  xygrid(7) = -64
  nstrok = 0
  unused = .true.
  return
end subroutine gsymxd
!
subroutine bldfil
  use gchar_interfaces, except_this=>bldfil
  use hershey_symb
  !---------------------------------------------------------------------
  ! @ private
  !  (build HERSHEY font file)
  !  This program converts the character digitizations on the
  !  distribution HERSHEY font file to a series of records on a
  !  fortran unformatted (binary) file in which coordinate pairs
  !  have been packed into single integers to reduce the space
  !  requirements.  The font file contains the character
  !  digitizations in record groups, as follows:
  !
  !  first: NC,LENGTH,(XYGRID(I),I=1,5)
  !  remaining: (XYGRID(I),I=6,LENGTH)
  !
  !  the format for each record is (7(2X,2I4)).  NC is the
  !  HERSHEY character number, which at present consists of one of
  !  1611 integers in the range (1..NCLAST), with NCLAST = 4000.
  !  these character numbers must never be altered, since
  !  the entire set of routines which handle the hershey fonts
  !  use them. The first five entries in XYGRID(*) are the
  !  character extents:
  !
  !  XYGRID(1) = minimum Y value.
  !  XYGRID(2) = baseline Y value.
  !  XYGRID(3) = maximum Y value.
  !  XYGRID(4) = minimum X value.
  !  XYGRID(5) = maximum X value.
  !
  !  the minimum and maximum values do not necessarily
  !  correspond to the actual (X,Y) coordinates in the remainder
  !  of XYGRID(*), but specify the box in which characters are
  !  drawn.  The center of each character grid is at (0,0), and
  !  actual coordinates lie in the range (-49..+49).  a
  !  coordinate pair (-64,0) is a request to raise the pen
  !  before moving to the next point, and a pair (-64,-64)
  !  signals end-of-data for the current character.
  !
  !  By biasing each coordinate by +64, the coordinate range
  !  becomes (0..113), which can be represented by 7 bits.  Thus
  !  an (x,y) pair can be packed into 14 data bits.  The
  !  distribution version of <PLOT79> packs only one pair per
  !  integer word, so that the system can be installed without
  !  change on any machine with 16 or more bits/integer.  Later
  !  on, it may be desirable to increase the number of
  !  coordinate pairs stored in a single word.  On machines
  !  which permit this, it may be most convenient to define the
  !  data arrays as integer*2 or integer*3, rather than to
  !  revise the packing algorithm.
  !
  !  The entire set of fonts contains at present 105,557
  !  individual coordinate values, to which space for pointers
  !  to individual characters must be added.  If the coordinates
  !  are packed as (X,Y) pairs in 16-bit integers, then about
  !  57,000 16-bit integers are required for the coordinates and
  !  pointers. Since this is an excessive amount of storage on
  !  many machines, the character data is subdivided into
  !  smaller sections and stored as fortran unformatted (binary)
  !  records. Each such record contains the data list
  !
  !  NC1,NC2,NC3,INDEX,BUFFER
  !
  !  the data items in the record are
  !
  !  NC1......... starting character number in buffer.
  !  NC2......... last character number in buffer.
  !  NC3......... starting character number in next buffer, if there
  !               would be one.
  !  INDEX(*).... index array, locating the start of data
  !               for character K (assumed in range NC1..NC2) at
  !               BUFFER(INDEX(K+1-NC1)).
  !  BUFFER(*)... array for packed coordinates.
  !
  !  The actual size of BUFFER(*) and INDEX(*) may be adjusted
  !  to an installation's requirements, and the code in
  !  subroutine SYMXD must be appropriately modified to reflect
  !  any change in the size of these arrays.
  !
  !  This version of BLDFIL omits the indexical, triplex, and
  !  gothic fonts (Hershey numbers 1000-1999, 3000-3999). A
  !  buffer size of 27000 words and an index size of 3000 are
  !  adequate.
  !
  ! (09-aug-80)
  !---------------------------------------------------------------------
  integer :: i,           l
  integer :: length,      locbuf
  integer :: nc,          nclast
  integer :: need,        numbuf
  integer :: nused,       prtfil
  integer :: xygrid(400)
  integer :: input
  !
  prtfil = 6
  input = 1
  open (unit=input,status='OLD',file='hershey-font.dat')
  !-----------------------------------------------------------------------
  nclast = 3000                ! Last character considered in this version
  !
  !---- Procedure (initialize)
  numbuf = 0
  nc = 0
  nc1 = 0
  locbuf = 1
  rewind input
  !
10 continue
  !---- Procedure (retrieve next character digitization)
  read (input,1000) nc,length,(xygrid(i),i=1,5)
  read (input,1000) (xygrid(i),i=6,length)
  !
  if (nc.gt.nclast) goto 20
  !
  !---- Skip these ones
  if ((nc.gt.999.and.nc.lt.2000).or.(nc.gt.2999)) goto 10
  !
  need = (length + 1)/2
  !---- If no space left, flush current buffer
  if ( (locbuf+need-1).gt.maxbuf .or. (nc-nc1+1.gt.maxind) ) then
    numbuf = numbuf + 1
    nused = locbuf - 1
    write (prtfil,2000) numbuf,nc1,nc2,nc,nused
    nc1 = 0
  endif
  !---- Initialize new buffer if needed
  if (nc1.eq.0) then
    do i=1,maxind
      index(i) = 0
    enddo
    nc1 = nc
    nc2 = nc
    locbuf = 1
  endif
  !
  ! Add character to current buffer
  l = nc - nc1 + 1
  index(l) = locbuf
  nc2 = nc
  buffer(locbuf) = xygrid(1)
  locbuf = locbuf + 1
  do i=2,length,2
    buffer(locbuf) = 128*(xygrid(i)+64) + xygrid(i+1) + 64
    locbuf = locbuf + 1
  enddo
  !
  ! Loop for next character
  if (nc.lt.nclast) goto 10
  !
  ! Flush last buffer
20 continue
  close (unit=input)
  numbuf = numbuf + 1
  nused = locbuf - 1
  write (prtfil,2000) numbuf,nc1,nc2,nc,nused
  !
1000 format (7(2x,2i4))
2000 format (1x,'RECORD =',i4,5x,'CHARACTER RANGE =',3i5,5x,  &
       'BUFFER WORDS USED =',i5)
end subroutine bldfil
!
subroutine suwrit (filename,array,n)
  use gchar_dependencies_interfaces
  use gchar_interfaces
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ no-interface (because 'vstrsh1' is used as 1st word of a common block)
  ! SUWRIT
  !       Writes the GREG character set to file.
  !
  ! Arguments :
  !       FILENAME        C*(*)     Name of output file          Input
  !       ARRAY           I(128,N)  Character set                Input
  !       N               I                                      Input
  !---------------------------------------------------------------------
  character(len=*) :: filename      !
  integer :: n                      !
  integer :: array(128,n)           !
  ! Local
  integer :: i,ier
  !
  open(unit=1,status='NEW',file=filename,form='UNFORMATTED',access='DIRECT',  &
       recl=128*facunf,iostat=ier)
  if (ier.ne.0) then
    call gchar_message(seve%e,'HERSHEY','An error occured while creating '//  &
    'file '//filename)
    call sysexi(ier)
  endif
  !
  do i=1,n
    call wwrite(1,array(1,i),i)
  enddo
  close(unit=1)
end subroutine suwrit
!
subroutine wwrite(iunit,array,block)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer :: iunit                  !
  integer :: array(128)             !
  integer :: block                  !
  write (unit=iunit,rec=block) array
end subroutine wwrite
!
subroutine coresp(i)
  use gchar_interfaces, except_this=>coresp
  use gchar_variables
  !---------------------------------------------------------------------
  ! @ private
  ! CHAR
  !	Create the correspondance table between Hershey and Greg fonts
  !---------------------------------------------------------------------
  integer :: i(nkchar)              !
  ! Local
  integer :: j
  !
  ! Load SIMPLEX quality font
  !
  ! Roman alphabet
  !	Number	  Hershey number	! Caractere	ASCII
  !
  i(  1) = 699
  !			 Space 	32
  i(  2) = 714
  !			 !		33
  i(  3) = 619
  !			 "		34 Unused
  i(  4) = 2275
  !			 #		35
  i(  5) = 719
  !			 $		36
  i(  6) = 2271
  !			 %		37
  i(  7) = 734
  !			 &		38
  i(  8) = 716
  !			 '		39
  i(  9) = 721
  !			 (		40
  i( 10) = 722
  !			 )		41
  i( 11) = 728
  !			 *		42
  i( 12) = 725
  !			 +		43
  i( 13) = 711
  !			 ,		44
  i( 14) = 724
  !			 -		45
  i( 15) = 710
  !			 .		46
  i( 16) = 720
  !			 /		47
  !
  do j=0,9
    i( 17+j) = 700+j
    !			 0-9 numerals	48-57
  enddo
  !
  i( 27) = 712
  !			 :		58
  i( 28) = 713
  !			 ;		59
  i( 29) = 2241
  !			 <		60
  i( 30) = 726
  !			 =		61
  i( 31) = 2242
  !			 >		62
  i( 32) = 715
  !			 ?		63
  i( 33) = 2273
  !			 @		64
  !
  do j=1,26
    i( 33+j) = 500+j
    !			 A-Z 		65-90
  enddo
  !
  i( 60) = 2223
  !			 [		91
  i( 61) = 2199
  !			 \		92
  i( 62) = 2224
  !			 ]		93
  i( 63) = 2218
  !			 ^ = Degree	94
  i( 64) = 2199
  !			 *95
  !			 _		95
  i( 65) =  717
  !			 ` = "		96
  !
  do j=1,26
    i( 65+j) = 600+j
    !			 a-z		97-122
  enddo
  !
  i( 92) = 2225
  !			 {		123
  i( 93) = 723
  !			 |		124
  i( 94) = 2226
  !			 }		125
  i( 95) = 2246
  !			 ~		126
  !
  do j=96,100
    i( j) = 2199
    !			 Space		unused
  enddo
  !
  ! Greek font
  !
  i(101) = 699
  !			 Space 	32
  i(102) = 2301
  !
  !			 Aries	33
  i(103) = 699
  !			 " Taurus	34 Unused used `
  i(104) = 2303
  !			 # Gemini	35
  i(105) = 2304
  !			 $ Cancer	36
  i(106) = 2305
  !			 % Leo		37
  i(107) = 2306
  !			 & Virgo	38
  i(108) = 2307
  !			 ' Libra	39
  i(109) = 2308
  !			 ( Scorpius	40
  i(110) = 2309
  !			 ) Sagittarius	41
  i(111) = 2310
  !			 * Capricornus	42
  i(112) = 2311
  !			 + Aquarius	43
  i(113) = 2312
  !			 , Pisces	44
  i(114) = 2199
  !			*
  !			 - Conjunction	45
  i(115) =  254
  !			 . Quadrature	46
  i(116) = 2199
  !			*
  !			 / Opposition	47
  !
  i(117) = 2281
  !			 0 Sun
  i(118) = 2282
  !			 1 Mercure
  i(119) = 2283
  !			 2 Venus
  i(120) = 2284
  !			 3 Terre
  i(121) = 2285
  !			 4 Mars
  i(122) = 2286
  !			 5 Jupiter
  i(123) = 2287
  !			 6 Saturne
  i(124) = 2288
  !			 7 Uranus
  i(125) = 2289
  !			 8 Neptune
  i(126) = 2290
  !			 9 Pluton
  i(127) = 2291
  !			 : Lune	58
  i(128) = 2292
  !			 ; Comete	59
  i(129) = 2293
  !			 < Etoile	60
  i(130) = 2294
  !			 = Neud ascendant	61
  i(131) = 2295
  !			 > Neud descendant	62
  i(132) = 2199
  !			*90
  !			 ? h barre		63
  i(133) = 2199
  !			*
  !			 @ lambda barre	64
  !
  i(134) =  527
  !			 A Alpha
  i(135) =  528
  !			 B Beta
  i(136) =  548
  !			 C Chi
  i(137) =  530
  !			 D Delta
  i(138) =  531
  !			 E Epsilon
  i(139) =  547
  !			 F Phi
  i(140) =  529
  !			 G Gamma
  i(141) =  533
  !			 H Eta
  i(142) =  535
  !			 I Iota
  i(143) =  583
  !			 J   Nabla
  i(144) =  536
  !			 K Kappa
  i(145) =  537
  !			 L Lambda
  i(146) =  538
  !			 M Mu
  i(147) =  539
  !			 N Nu
  i(148) =  541
  !			 O Omicron
  i(149) =  542
  !			 P Pi
  i(150) =  534
  !			 Q Theta
  i(151) =  543
  !			 R Rho
  i(152) =  544
  !			 S Sigma
  i(153) =  545
  !			 T Tau
  i(154) =  546
  !			 U Upsilon
  i(155) = 2199
  !			*86
  !			 V   Angstrom
  i(156) =  550
  !			 W Omega
  i(157) =  540
  !			 X Xi
  i(158) =  549
  !			 Y Psi
  i(159) =  532
  !			 Z Zeta
  !
  i(160) = 2277
  !			 [ Cross
  i(161) = 2199
  !			 "\"
  i(162) = 2278
  !			 ] Double Cross
  i(163) = 2276
  !			 ^ Paragraph
  i(164) =  276
  !			 _ ...
  i(165) = 2302
  !			 ` Taurus
  !
  i(166) =  627
  !			 A Alpha
  i(167) =  628
  !			 B Beta
  i(168) =  648
  !			 C Chi
  i(169) =  630
  !			 D Delta
  i(170) =  631
  !			 E Epsilon
  i(171) =  686
  !			 F Phi		variante
  i(172) =  629
  !			 G Gamma
  i(173) =  633
  !			 H Eta
  i(174) =  635
  !			 I Iota
  i(175) =  683
  !			 J   d ronde
  i(176) =  636
  !			 K Kappa
  i(177) =  637
  !			 L Lambda
  i(178) =  638
  !			 M Mu
  i(179) =  639
  !			 N Nu
  i(180) =  641
  !			 O Omicron
  i(181) =  642
  !			 P Pi
  i(182) =  685
  !			 Q Theta	variante
  i(183) =  643
  !			 R Rho
  i(184) =  644
  !			 S Sigma
  i(185) =  645
  !			 T Tau
  i(186) =  646
  !			 U Upsilon
  i(187) = 2270
  !			 V   Infini
  i(188) =  650
  !			 W Omega
  i(189) =  640
  !			 X Xi
  i(190) =  649
  !			 Y Psi
  i(191) =  632
  !			 Z Zeta
  !
  i(192) = 2407
  !			 { Grand format
  i(193) = 2412
  !			 | Integrale
  i(194) = 2408
  !			 } Grand format
  i(195) = 2411
  !			 ~ Racine
  !
  do j=196,200
    i(j) =  699
    !			 Space		unused
  enddo
  !
  ! Script font
  !
  i(201) =  699
  !			   Space 	32
  i(202) = 2279
  !
  !			 Il existe	33
  i(203) = 2199
  !			 " 		34 Unused
  i(204) = 2256
  !			 # Inclusion	35
  i(205) = 2257
  !			 $ Union	36
  i(206) = 2258
  !			 % Contient	37
  i(207) = 2259
  !			 & Intersection
  i(208) = 2260
  !			 ' Appartient	39
  i(209) = 2268
  !			 ( Integrale	40
  i(210) = 2269
  !			 ) Integrale circulaire
  i(211) = 2235
  !			 * x		42
  i(212) = 2233
  !			 + Plus moins	43
  i(213) = 2237
  !			 , ./. droit	44
  i(214) = 2234
  !			 - Moins plus	45
  i(215) = 2236
  !			 . .		46
  i(216) = 2267
  !			 / Racine	47
  !
  do j=0,9
    i(217+j) = 700+j
    !			 0-9 numerals	48-57
  enddo
  !
  i(227) = 2199
  !			*
  !			 : Quelque soit
  i(228) =  738
  !			 ; Orthogonal	59
  i(229) = 2243
  !			 < ou egal	60
  i(230) = 2240
  !			 = Equivalent	61
  i(231) = 2244
  !			 > ou egal	62
  i(232) = 2239
  !			 ? Different	63
  i(233) = 2245
  !			 @ Proportionnel
  !
  do j=1,26
    i(233+j) =  550+j
    !			 A-Z 		65-90
  enddo
  !
  i(260) = 248
  !			 [ A peu pres egal
  i(261) = 2199
  !			 "\"
  i(262) = 250
  !			 ] A peu pres egal
  i(263) = 252
  !			 ^ Equilibre chimique
  i(264) = 278
  !			 _ Fleches horizontales
  i(265) = 279
  !			 ` Fleches verticales
  !
  do j=1,26
    i(265+j) =  650+j
    !			 a-z		97-122
  enddo
  !
  i(292) = 2262
  !			 { Fleche en haut
  i(293) = 2261
  !			 | Fleche a droite
  i(294) = 2264
  !			 } Fleche en bas
  i(295) = 2263
  !			 ~ Fleche a gauche
  !
  do j=296,300
    i(j) = 699
    !			 Space		unused
  enddo
  !
  ! Load DUPLEX quality font
  !
  ! Roman alphabet
  !	Number	  Hershey number
  !			 Caractere	ASCII
  i(301) = 2199
  !			 Space 	32
  i(302) = 2214
  !
  !					33
  i(303) = 2199
  !			 "		34 Unused
  i(304) = 2275
  !			 #		35
  i(305) = 2274
  !			 $		36
  i(306) = 2271
  !			 %		37
  i(307) = 2272
  !			 &		38
  i(308) = 2216
  !			 '		39
  i(309) = 2221
  !			 (		40
  i(310) = 2222
  !			 )		41
  i(311) = 2219
  !			 *		42
  i(312) = 2232
  !			 +		43
  i(313) = 2211
  !			 ,		44
  i(314) = 2231
  !			 -		45
  i(315) = 2210
  !			 .		46
  i(316) = 2220
  !			 /		47
  !
  do j=0,9
    i(317+j) = 2200+j
    !			 0-9 numerals	48-57
  enddo
  !
  i(327) = 2212
  !			 :		58
  i(328) = 2213
  !			 ;		59
  i(329) = 2241
  !			 <		60
  i(330) = 2238
  !			 =		61
  i(331) = 2242
  !			 >		62
  i(332) = 2215
  !			 ?		63
  i(333) = 2273
  !			 @		64
  !
  do j=1,26
    i(333+j) = 2000+j
    !			 A-Z 		65-90
  enddo
  !
  i(360) = 2223
  !			 [		91
  i(361) = 2199
  !			 \		92
  i(362) = 2224
  !			 ]		93
  i(363) = 2218
  !			 ^ = Degree	94
  i(364) = 2199
  !			 *95
  !			 _		95
  i(365) = 2217
  !			 ` = "		96
  !
  do j=1,26
    i(365+j) = 2100+j
    !			 a-z		97-122
  enddo
  !
  i(392) = 2225
  !			 {		123
  i(393) = 2229
  !			 |		124
  i(394) = 2226
  !			 }		125
  i(395) = 2246
  !			 ~		126
  !
  do j=396,400
    i( j) = 2199
    !			 Space		unused
  enddo
  !
  ! Greek font
  !
  i(401) = 2199
  !			 Space 	32
  i(402) = 2301
  !
  !			 Aries	33
  i(403) = 2199
  !			 " Taurus	34 Unused use `
  i(404) = 2303
  !			 # Gemini	35
  i(405) = 2304
  !			 $ Cancer	36
  i(406) = 2305
  !			 % Leo		37
  i(407) = 2306
  !			 & Virgo	38
  i(408) = 2307
  !			 ' Libra	39
  i(409) = 2308
  !			 ( Scorpius	40
  i(410) = 2309
  !			 ) Sagittarius	41
  i(411) = 2310
  !			 * Capricornus	42
  i(412) = 2311
  !			 + Aquarius	43
  i(413) = 2312
  !			 , Pisces	44
  i(414) = 2199
  !			*
  !			 - Conjunction	45
  i(415) = 254
  !			 . Quadrature	46
  i(416) = 2199
  !			*
  !			 / Opposition	47
  !
  i(417) = 2281
  !			 0 Sun
  i(418) = 2282
  !			 1 Mercure
  i(419) = 2283
  !			 2 Venus
  i(420) = 2284
  !			 3 Terre
  i(421) = 2285
  !			 4 Mars
  i(422) = 2286
  !			 5 Jupiter
  i(423) = 2287
  !			 6 Saturne
  i(424) = 2288
  !			 7 Uranus
  i(425) = 2289
  !			 8 Neptune
  i(426) = 2290
  !			 9 Pluton
  i(427) = 2291
  !			 : Lune	58
  i(428) = 2292
  !			 ; Comete	59
  i(429) = 2293
  !			 < Etoile	60
  i(430) = 2294
  !			 = Neud ascendant	61
  i(431) = 2295
  !			 > Neud descendant	62
  i(432) = 2199
  !			*90
  !			 ? h barre		63
  i(433) = 2199
  !			*
  !			 @ lambda barre	64
  !
  i(434) = 2027
  !			 A Alpha
  i(435) = 2028
  !			 B Beta
  i(436) = 2048
  !			 C Chi
  i(437) = 2030
  !			 D Delta
  i(438) = 2031
  !			 E Epsilon
  i(439) = 2047
  !			 F Phi
  i(440) = 2029
  !			 G Gamma
  i(441) = 2033
  !			 H Eta
  i(442) = 2035
  !			 I Iota
  i(443) = 2266
  !			 J   Nabla
  i(444) = 2036
  !			 K Kappa
  i(445) = 2037
  !			 L Lambda
  i(446) = 2038
  !			 M Mu
  i(447) = 2039
  !			 N Nu
  i(448) = 2041
  !			 O Omicron
  i(449) = 2042
  !			 P Pi
  i(450) = 2034
  !			 Q Theta
  i(451) = 2043
  !			 R Rho
  i(452) = 2044
  !			 S Sigma
  i(453) = 2045
  !			 T Tau
  i(454) = 2046
  !			 U Upsilon
  i(455) = 2199
  !			*86
  !			 V   Angstrom
  i(456) = 2050
  !			 W Omega
  i(457) = 2040
  !			 X Xi
  i(458) = 2049
  !			 Y Psi
  i(459) = 2032
  !			 Z Zeta
  !
  i(460) = 2277
  !			 [ Cross
  i(461) = 2199
  !			 "\"
  i(462) = 2278
  !			 ] Double Cross
  i(463) = 2276
  !			 ^ Paragraph
  i(464) = 276
  !			 _ ...
  i(465) = 2302
  !			 ` Taurus
  !
  i(466) = 2127
  !			 A Alpha
  i(467) = 2128
  !			 B Beta
  i(468) = 2148
  !			 C Chi
  i(469) = 2130
  !			 D Delta
  i(470) = 2131
  !			 E Epsilon
  i(471) = 2186
  !			 F Phi		variante
  i(472) = 2129
  !			 G Gamma
  i(473) = 2133
  !			 H Eta
  i(474) = 2135
  !			 I Iota
  i(475) = 2265
  !			 J   d ronde
  i(476) = 2136
  !			 K Kappa
  i(477) = 2137
  !			 L Lambda
  i(478) = 2138
  !			 M Mu
  i(479) = 2139
  !			 N Nu
  i(480) = 2141
  !			 O Omicron
  i(481) = 2142
  !			 P Pi
  i(482) = 2185
  !			 Q Theta	variante
  i(483) = 2143
  !			 R Rho
  i(484) = 2144
  !			 S Sigma
  i(485) = 2145
  !			 T Tau
  i(486) = 2146
  !			 U Upsilon
  i(487) = 2270
  !			 V   Infini
  i(488) = 2150
  !			 W Omega
  i(489) = 2140
  !			 X Xi
  i(490) = 2149
  !			 Y Psi
  i(491) = 2132
  !			 Z Zeta
  !
  i(492) = 2407
  !			 { Grand format
  i(493) = 2412
  !			 | Integrale
  i(494) = 2408
  !			 } Grand format
  i(495) = 2411
  !			 ~ Racine
  !
  do j=496,500
    i(j) = 2199
    !			 Space		unused
  enddo
  !
  ! Script font
  !
  i(501) = 2199
  !			   Space 	32
  i(502) = 2279
  !
  !			 Il existe	33
  i(503) = 2199
  !			 " 		34 Unused
  i(504) = 2256
  !			 # Inclusion	35
  i(505) = 2257
  !			 $ Union	36
  i(506) = 2258
  !			 % Contient	37
  i(507) = 2259
  !			 & Intersection
  i(508) = 2260
  !			 ' Appartient	39
  i(509) = 2268
  !			 ( Integrale	40
  i(510) = 2269
  !			 ) Integrale circulaire
  i(511) = 2235
  !			 * x		42
  i(512) = 2233
  !			 + Plus moins	43
  i(513) = 2237
  !			 , ./. droit	44
  i(514) = 2234
  !			 - Moins plus	45
  i(515) = 2236
  !			 . .		46
  i(516) = 2267
  !			 / Racine	47
  !
  do j=0,9
    i(517+j) = 2200+j
    !			 0-9 numerals	48-57
  enddo
  !
  i(527) = 2199
  !			*
  !			 : Quelque soit
  i(528) =  738
  !			 ; Orthogonal	59
  i(529) = 2243
  !			 < ou egal	60
  i(530) = 2240
  !			 = Equivalent	61
  i(531) = 2244
  !			 > ou egal	62
  i(532) = 2239
  !			 ? Different	63
  i(533) = 2245
  !			 @ Proportionnel
  !
  do j=1,26
    i(533+j) = 2550+j
    !			 A-Z 		65-90
  enddo
  !
  i(560) = 248
  !			 [ A peu pres egal
  i(561) = 2199
  !			 "\"
  i(562) = 250
  !			 ] A peu pres egal
  i(563) = 252
  !			 ^ Equilibre chimique
  i(564) = 278
  !			 _ Fleches horizontales
  i(565) = 279
  !			 ` Fleches verticales
  !
  do j=1,26
    i(565+j) = 2650+j
    !			 a-z		97-122
  enddo
  !
  i(592) = 2262
  !			 { Fleche en haut
  i(593) = 2261
  !			 | Fleche a droite
  i(594) = 2264
  !			 } Fleche en bas
  i(595) = 2263
  !			 ~ Fleche a gauche
  !
  do j=596,nkchar
    i(j) = 2199
    !			 Space		unused
  enddo
end subroutine coresp
