1*-----------------------------------------------------------------------
2*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
3*-----------------------------------------------------------------------
4      SUBROUTINE UETONB(Z,MX,NX,NY)
5
6      REAL      Z(MX,*)
7
8      INTEGER   NP(2),NI(2)
9      REAL      XC(4),YC(4),ZC(4),AX(10),AY(10),TLM(2)
10      LOGICAL   LMISS
11
12      COMMON    /UEBLK1/ TL1,TL2,IPT,NT,LASCND
13      PARAMETER (MAXNT=100)
14      LOGICAL   LASCND
15      INTEGER   IPT(MAXNT)
16      REAL      TL1(MAXNT),TL2(MAXNT)
17
18      EXTERNAL  RUWGX,RUWGY
19
20
21*     / GET INTERNAL PARAMETERS /
22
23      CALL GLLGET('LMISS   ',LMISS )
24      CALL GLRGET('RMISS   ',RMISS )
25      CALL SGIGET('ITR     ',ITR)
26
27*     / SET GRID ATTRIBUTE IF IT HAS NOT BEEN SET YET /
28
29      CALL UWDFLT(NX,NY)
30
31*     / CHECK Z VALUES AND TONE LEVEL /
32
33      CALL UEZCHK(Z,MX,NX,NY,'UETONB',ISTAT)
34      IF (ISTAT.NE.0) RETURN
35
36*     / SET TONE MODE (IRMODE) /
37
38      CALL UWQGXB(UXMIN,UXMAX,NXZ)
39      CALL UWQGYB(UYMIN,UYMAX,NYZ)
40
41      IF (ITR.LT.4) THEN
42        CALL STFTRF(UXMIN,UYMIN,VXMIN,VYMIN)
43        CALL STFTRF(UXMAX,UYMAX,VXMAX,VYMAX)
44        DX=VXMAX-VXMIN
45        DY=VYMAX-VYMIN
46      ELSE
47        DX=UXMAX-UXMIN
48        DY=UYMAX-UYMIN
49      END IF
50
51      IRMODE=0
52      IF (DX.LT.0) IRMODE=MOD(IRMODE+1,2)
53      IF (DY.LT.0) IRMODE=MOD(IRMODE+1,2)
54
55      CALL SGISET('IRMODE', IRMODE)
56
57*     / INITIALIZE /
58
59      CALL UEAINT
60
61*     / LOOP FOR EACH TONE PATTERN /
62
63      DO 30 IT=1,NT
64
65        CALL SZTNOP(IPT(IT))
66
67*       / LOOP FOR EACH SECTION /
68
69        DO 20 I=1,NX-1
70
71          I0=I-1
72          I1=I+1
73
74          IF (I.EQ.1) THEN
75            XC(1)=RUWGX(I)
76          ELSE
77            XC(1)=(RUWGX(I0)+RUWGX(I))/2.0
78          END IF
79          IF (I.EQ.NX-1) THEN
80            XC(2)=RUWGX(I1)
81          ELSE
82            XC(2)=(RUWGX(I)+RUWGX(I1))/2.0
83          END IF
84          XC(3)=XC(2)
85          XC(4)=XC(1)
86
87          DO 10 J=1,NY-1
88
89            J0=J-1
90            J1=J+1
91
92            IF (Z(I,J).LT.TL1(IT)) GO TO 10
93            IF (Z(I,J).GT.TL2(IT)) GO TO 10
94
95            ZC(1)=Z(I,J)
96            ZC(2)=Z(I,J)
97            ZC(3)=Z(I,J)
98            ZC(4)=Z(I,J)
99
100            IF (LMISS .AND. NINDXR(ZC,4,1,RMISS).NE.0) GO TO 10
101
102            IF (J.EQ.1) THEN
103              YC(1)=RUWGY(J)
104            ELSE
105              YC(1)=(RUWGY(J0)+RUWGY(J))/2.0
106            END IF
107            YC(2)=YC(1)
108            IF (J.EQ.NY-1) THEN
109              YC(3)=RUWGY(J1)
110            ELSE
111              YC(3)=(RUWGY(J)+RUWGY(J1))/2.0
112            END IF
113            YC(4)=YC(3)
114
115            TLM(1)=TL1(IT)
116            TLM(2)=TL2(IT)
117            CALL UEAREA(XC,YC,ZC,TLM,AX,AY,NP,NI,NG)
118
119            DO 40 N=1,NG
120              CALL SZTNZU(NP(N),AX(NI(N)),AY(NI(N)))
121   40       CONTINUE
122
123   10     CONTINUE
124   20   CONTINUE
125
126        CALL SZTNCL
127
128   30 CONTINUE
129
130      END
131