1*-----------------------------------------------------------------------
2*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
3*-----------------------------------------------------------------------
4      SUBROUTINE UETONC (Z,MX,NX,NY)
5
6      REAL      Z(MX,*)
7
8      PARAMETER (MAXPXL=4000)
9
10      INTEGER   IMAGE(MAXPXL)
11      LOGICAL   LMISS,LIMC
12
13      COMMON    /UEBLK1/ TL1,TL2,IPT,NT,LASCND
14      PARAMETER (MAXNT=100)
15      LOGICAL   LASCND
16      INTEGER   IPT(MAXNT)
17      REAL      TL1(MAXNT),TL2(MAXNT)
18
19      EXTERNAL  IUETON, IUWGX, IUWGY
20
21      CALL SGIGET('IBGCLI',IBGCLI)
22
23*     / CHECK IMAGE CAPABILITY /
24
25      CALL SWQIMC(LIMC)
26      IF (.NOT.LIMC) THEN
27        CALL MSGDMP('E','UETONC','NO IMAGE CAPABILITY.')
28      END IF
29
30*     / GET INTERNAL PARAMETERS /
31
32      CALL GLRGET('RUNDEF  ',RUNDEF)
33      CALL GLIGET('IUNDEF  ',IUNDEF)
34      CALL GLLGET('LMISS   ',LMISS )
35      CALL GLRGET('RMISS   ',RMISS )
36
37*     / SET GRID ATTRIBUTE IF IT HAS NOT BEEN SET YET /
38
39      CALL UWDFLT(NX, NY)
40
41*     / CHECK Z VALUES AND TONE LEVEL /
42
43      CALL UEZCHK(Z,MX,NX,NY,'UETONC',ISTAT)
44      IF (ISTAT.NE.0) RETURN
45
46*     / INITIALIZE /
47
48      CALL SGQVPT(VXMIN, VXMAX, VYMIN, VYMAX)
49
50      CALL STFPR2(VXMIN, VYMIN, RX, RY)
51      CALL STFWTR(RX, RY, WX1, WY1)
52      CALL SWFINT(WX1, WY1, IX1, IY1)
53
54      CALL STFPR2(VXMAX, VYMIN, RX, RY)
55      CALL STFWTR(RX, RY, WX2, WY2)
56      CALL SWFINT(WX2, WY2, IX2, IY2)
57
58      CALL STFPR2(VXMAX, VYMAX, RX, RY)
59      CALL STFWTR(RX, RY, WX3, WY3)
60      CALL SWFINT(WX3, WY3, IX3, IY3)
61
62      CALL STFPR2(VXMIN, VYMAX, RX, RY)
63      CALL STFWTR(RX, RY, WX4, WY4)
64      CALL SWFINT(WX4, WY4, IX4, IY4)
65
66      IXMIN  = MIN(IX1, IX2, IX3, IX4)
67      IYMIN  = MIN(IY1, IY2, IY3, IY4)
68      IXMAX  = MAX(IX1, IX2, IX3, IX4)
69      IYMAX  = MAX(IY1, IY2, IY3, IY4)
70      IWIDTH = IXMAX-IXMIN+1
71      IHIGHT = IYMAX-IYMIN+1
72
73      CALL SWIOPN(IXMIN, IYMIN, IWIDTH, IHIGHT,
74     +            WX1, WY1, WX2, WY2, WX3, WY3, WX4, WY4)
75
76*     / LOOP FOR EACH PIXEL /
77
78      DO 30 J=1, IHIGHT
79
80        DO 20 I=1, IWIDTH
81
82          CALL SWIINT(I+IXMIN-1, J+IYMIN-1, WX, WY)
83          CALL STIWTR(WX, WY, RX, RY)
84          CALL STIPR2(RX, RY, VX, VY)
85          IF (VX .LT. VXMIN .OR. VX .GT. VXMAX .OR.
86     +        VY .LT. VYMIN .OR. VY .GT. VYMAX) THEN
87            UX = RUNDEF
88          ELSE
89            CALL STITRF(VX, VY, UX, UY)
90          END IF
91
92          IF (UX.EQ.RUNDEF) THEN
93            IMAGE(I) = 0
94          ELSE
95            IX = IUWGX(UX)
96            IY = IUWGY(UY)
97            IF (IX.EQ.IUNDEF .OR. IY.EQ.IUNDEF) THEN
98              IMAGE(I) = 0
99            ELSE
100              ZZ = Z(IX, IY)
101              IF (LMISS .AND. ZZ.EQ.RMISS) THEN
102                IMAGE(I) = 0
103              ELSE
104                IF (TL1(1) .LE. ZZ .AND. ZZ .LE. TL2(NT)) THEN
105                  IMAGE(I) = IUETON(ZZ)/1000
106                  IF(IMAGE(I) .EQ. IBGCLI) THEN
107                    IMAGE(I)=0
108                  ENDIF
109                ELSE
110                  IMAGE(I) = 0
111                END IF
112              END IF
113            END IF
114          END IF
115
116   20   CONTINUE
117
118        CALL SWIDAT(IMAGE, IWIDTH)
119
120   30 CONTINUE
121
122      CALL SWICLS
123
124      END
125