Subroutine LABELP
c
c ***********************************************************************
c *                                                                     *
c *        Subroutine LABELP - To label the plot with user-specified    *
c *        labels selected using PLTPRG.                                *
c *                                                                     *
c *       Programmed by Steven C. Fisher, DTNSRDC Code 1522             *
c *                                                                     *
c ***********************************************************************
c
      Dimension Xmin(2),Ymin(2),Xmax(2),Ymax(2),Xinc(2),Yinc(2)
      Integer Xnumbr,Ynumbr,Axchst,Axtypx,Axtypy,Axcolr,Ticdir
      Byte Xaxis(2,80),Yaxis(2,80)
c
      Byte Titl(80),Char
c
      Integer Atxclr,Spchar,Xtop
c
      Common/Ptype/Idev,Xtop,Spchar,Chscal
      Common/Labls/Nlab,Lachst,Lacolr,Nleg,Lechst,Lecolr,Legtit,Labcrd,
     $ Iprtot,Irot
      Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr,
     $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz,
     $ Ticdir,Atxclr
c
c         Set the labels coordinate system
c
      If (Nlab .EQ. 0) Return
c
      If (Labcrd .EQ. 0) Then
c
c         Set up local coordinate system
c
         Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen)
c
      Else
c
c         Set up global coordinate system
c
         Call Plcord(0.0,1.0,0.0,1.0,Xlen,Ylen)
c
      End If
c
c         Set the viewport clipping off, and then loop for the labels
c
      Call Stclof
      Call Sttxco(Lacolr)   ! Set the labels colors
c
c         Set the character set
c
      If (Lachst .GT. 0) Then
         Call Stsoft
         Call Stcstn(Lachst)
         If(Spchar .GT. 1) Call Stcspa(1,0,0)
      Else
         Call Sthard
      End If
c
      Call Sttpol(0)    ! Do not outline the protected text
c
      Do 30 I=1,Nlab
         Read(12,*)  Nchar,Xlabel,Ylabel,Sizlab,Just,Iprot,Irot
c
         If (Sizlab .EQ. 1.0) Sizlab = 1.7
         If (Sizlab .EQ. 2.0) Sizlab = 2.3
c
         Read(12,125) (Titl(J),J=1,Nchar)
125      Format(<Nchar>A1)
         If (Sizlab .EQ. 0.0) Go To 30
         Call Strn(Titl,Nchar,Lachst)
c
c            Move to the correct location
c
         Call Movawc(Xlabel,Ylabel)
c
c            Set the text size
c
         Call Stccsz(Sizlab*0.03*Chscal,Sizlab*0.042*Chscal)
         Call Gtccsz(Xsiz,Ysiz)
         If (Labcrd .EQ. 0) Then
            Ysiz = Ysiz * (Ymax(1)-Ymin(1))/Ylen
         Else
            Ysiz = Ysiz / Ylen
         End If
c
c            Set the text justification
c
         Call Stjust(Just)
c
c            Now write the label
c
c            See if the label is above or below the plot - if it is,
c            turn off the text protection. Also, if there is no
c            curves or grid, turn off the text protection
c
         If ((Labcrd .EQ. 0 .AND. Ylabel .GT. Ymax(1)) .OR. (Labcrd
     $       .NE. 0 .AND. Ylabel .GT. 1.0)) Iprot = 1
         If ((Labcrd .EQ. 0 .AND. Ylabel+Ysiz .LT. Ymin(1)) .OR.
     $       (Labcrd .NE. 0 .AND. Ylabel+Ysiz .LT. 0.0)) Iprot = 1
         If (Iprtot .EQ. 1) Iprot = 1
         If (Idev .LE. 0) Iprot = 1
c
         If (Irot .NE. 0) Call Stcrot(1.0*Irot)    ! rotate text Irot degrees
         If (Iprot .EQ. 0) Call Sttxpr  ! Initialize the text protection
         Call Grtxcp(Nchar,Titl)
         If (Iprot .EQ. 0) Call Sttxpf  ! Finish the text protection
         If (Irot .NE. 0) Call Stcrot(0.0)    ! rotate back to zero
c
c            Loop back for the next string
c
30    Continue
      Return
      End
      Subroutine Chaset
c
c ***********************************************************************
c *                                                                     *
c *        Subroutine CHASET - to set up the various character sets     *
c *                                                                     *
c *       Programmed by Steven C. Fisher, DTNSRDC Code 1522             *
c *                                                                     *
c ***********************************************************************
c
      Call Stcset('SIMPLEX_ROMAN',1)
      Call Stcset('DUPLEX_ROMAN',2)
      Call Stcset('COMPLEX_ROMAN',3)
      Call Stcset('TRIPLEX_ROMAN',4)
      Call Stcset('COMPLEX_ITALIC',5)
      Call Stcset('TRIPLEX_ITALIC',6)
      Call Stcset('COMPLEX_SCRIPT',7)
      Call Stcset('GOTHIC_ENGLISH',8)
      Call Stcset('GREEK_MATH_1',9)
      Return
      End