C     Copyright (c) Tijs Michels, 2001-2012
C     http://tijs.users.sourceforge.net

C     This 3D chart first appeared in print at page 131 of Tijs Michels,
C     Jos Pieper & Rien van Uden, Bewegingen rond de huwelijkssluiting,
C     Jaarboek voor liturgie-onderzoek 17 (2001), 107-134.
C     It later appeared at page 177 of my dissertation (ISBN 90-9018145-8).
C     The data charted here was collected in the course of my doctoral
C     research and remains copyrighted (c) Tijs Michels, 2004.
C     The code however is hereby placed in the public domain.

      PROGRAM OPLEIDNG
      CHARACTER ENV*3
      PARAMETER (NX=6,NY=5,NP=((NX-1)*(NY-1))+1)
      PARAMETER (GRE=.6201)
      DIMENSION PT(3,NP),XX(NX),YY(NY),PA(15)
      DATA XX /0.,1.,2.,3.,4.,5./
      DATA YY /0.,1.,2.,3.,4./
      DATA PA /2.03125,20,45,18.2,0,0,5,0,4,0,1.6667,1,NX,1,NY/
      DATA PT /0.,0.,0.,
     &  1.,1., .6842,
     &  2.,1., .5625,
     &  3.,1., .6667,
     &  4.,1., .8947,
     &  5.,1.,1.0833,
     &  1.,2., .6667,
     &  2.,2., .4375,
     &  3.,2., .7037,
     &  4.,2.,1.0000,
     &  5.,2.,1.1818,
     &  1.,3., .8947,
     &  2.,3., .6925,
     &  3.,3., .9167,
     &  4.,3., .9474,
     &  5.,3.,1.4167,
     &  1.,4.,1.1579,
     &  2.,4.,1.0000,
     &  3.,4.,1.4722,
     &  4.,4.,1.5000,
     &  5.,4.,1.6667/

      CALL GRSTRT(35,8)
      CALL GRSCLP(18.9,18.31,1)
      CALL GRSCLC(.25,.1,18.65,18.6)

C     Only the first two GRSCLC parameters matter to GRDRHS and GRDRLG;
C     they position the lower left corner

      CALL GSCR(1,9,GRE,GRE,GRE)

C     WKID = 1
C     ColorIndex 9 = LightGrey

      CALL GETENV ('GRSOFT_DEVICE', ENV)
      IF (ENV .NE. '61' .AND. ENV .NE. '62'
     &    .AND. ENV .NE. '102') ENV = 'NPS'
      IF (ENV .EQ. 'NPS') THEN

C     Software font
C     Hershey Standard

        CALL GRPREC(2)
        CALL GRFONT(-1)

      ELSE

C     Hardware font
C     Computer Modern Roman

        CALL GRPREC(0)
        CALL GRFONT(-1)

      END IF

C     GRFRBN sets line width 3 for the columns and line width 1 for
C     all other lines; GRSPTS and GSLWSC cannot do that

      CALL GRFRBN(10002,2001,2009,2001,2003,2001)
      CALL GRDRHS(PA,NP-1,PT,XX,YY)
      IF (PA(5) .GT. 0) STOP 'OPLEIDNG'

C     Line width 1 for the arrows

      CALL GRSPTS(16)
      IF (ENV .EQ. 'NPS') THEN
        CALL GRCHRC(.40,0.,16)
      ELSE
        CALL GRCHRC(.48,0.,16)
      END IF
      CALL GRDRLG(PA,'Opleidingsniveau',' ',
     &  'Ontroering',-1,.9,0.,2.4,0,0,0)

C     Font size X-axis at 50%

      IF (ENV .EQ. 'NPS') THEN
        CALL GRCHRC(.20,0.,16)
      ELSE
        CALL GRCHRC(.24,0.,16)
      END IF
      CALL GRSCAXP('Basisschool',' ',' ',' ',1.68,.11/5)
      CALL GRSCAXP('Universiteit',' ',' ',' ',1.68,(4.08/5))

C     Font size Y-axis at 67.5%

      IF (ENV .EQ. 'NPS') THEN
        CALL GRCHRC(.27,0.,16)
      ELSE
        CALL GRCHRC(.36,0.,16)
      END IF
      CALL GRSCAXP(' ','Gebeden',' ',' ',.6,.0)
      CALL GRSCAXP(' ','Symbolen',' ',' ',.6,(1.0136/4))
      CALL GRSCAXP(' ','Lezingen',' ',' ',.6,(2.148/4))
      CALL GRSCAXP(' ','Muziek',' ',' ',.6,(3.18/4))

C     Font size Z-axis at 90%
C     No new call to GRSPTS, so the tick markers get line width 1 as well

      CALL GRCHRC(.36,0.,16)
      CALL GRDRLG(PA,' ',' ',' ',1,0.,0.,3.4,0,0,1)
      CALL GREND
      END