1C
2C
3C
4      SUBROUTINE PWRIT( X , Y , CH , NCH , ISIZ , IOR , ICENT )
5C
6C  Additional options besides NCAR's choices:
7C
8C    NCH < 0    ==> use absolute coordinates rather than user coords.
9C                   [this is because the use of integer absolute   ]
10C                   [coordinates is not implemented in this package]
11C
12C    ABS(NCH) = 999 ==> find length of string by looking for a 0 byte.
13C
14C    ICENT = -2 ==> (X,Y) is lower left corner of string to plot.
15C
16      CHARACTER*1 CH(*)
17C.......................................................................
18      PARAMETER ( DG2RAD = .017453292 )
19C
20      INCLUDE 'plotpak.inc'
21C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
22C  Calculate character width in terms of 1/1000 of the x-width.
23C
24      ISIZE = ISIZ
25      IF( ISIZE .LE. 0 )THEN
26         ISIZE = 8
27      ELSEIF( ISIZE .EQ. 1 )THEN
28         ISIZE = 12
29      ELSEIF( ISIZE .EQ. 2 )THEN
30         ISIZE = 16
31      ELSEIF( ISIZE .EQ. 3 )THEN
32         ISIZE = 24
33      ENDIF
34C
35      WIDTH = ISIZE * 0.001 * ( XPGMAX - XPGMIN )
36C
37C  Rotation/scaling factors for digitization.  Include factor of 1/6
38C  to allow for digitization scale in ZZCHAR.
39C
40      OR = DG2RAD * IOR
41      DX = WIDTH * COS(OR)
42      DY = WIDTH * SIN(OR)
43      CT = 0.1666667 * DX
44      ST = 0.1666667 * DY
45C
46C  Starting location for first character.
47C
48      XX = X
49      YY = Y
50      IF( NCH .GT. 0 )CALL ZZPHYS( XX , YY )
51C
52C  Get no. of characters in string.  Special option 999 must be checked.
53C
54      NCHAR = ABS( NCH )
55      IF( NCHAR .EQ. 999 )THEN
56         DO 10 I=1,NCHAR
57            IF( CH(I) .EQ. CHAR(0) )GOTO 20
5810       CONTINUE
5920       NCHAR = I-1
60      ENDIF
61C
62C  If centering option is not lower-left corner, must calculate
63C  location of lower left corner.
64C
65      IF( ICENT .NE. -2 )THEN
66C  Move from center of character down to bottom (aspect ratio = 7/6)
67         XX = XX + 0.5833333 * DY
68         YY = YY - 0.5833333 * DX
69         IF( ICENT .EQ. 0 )THEN
70            XX = XX - 0.5*NCHAR*DX
71            YY = YY - 0.5*NCHAR*DY
72         ELSEIF( ICENT .EQ. +1 )THEN
73            XX = XX - NCHAR*DX
74            YY = YY - NCHAR*DY
75         ENDIF
76      ENDIF
77C.......................................................................
78      DO 100 I=1,NCHAR
79         CALL ZZCHAR( CH(I) , XX , YY , CT , ST )
80         XX = XX + DX
81         YY = YY + DY
82100   CONTINUE
83C.......................................................................
84      XPHOLD = XX
85      YPHOLD = YY
86      RETURN
87      END
88