Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Gebhardt, Albrecht
akima
Commits
53406f4e
Commit
53406f4e
authored
Feb 28, 1998
by
agebhard
Browse files
Imported sources
parents
Changes
36
Hide whitespace changes
Inline
Side-by-side
526
0 → 100644
View file @
53406f4e
C PROGRAM TTIDBS(OUTPUT,TAPE6=OUTPUT) ID000070
C THIS PROGRAM IS A TEST PROGRAM FOR THE IDBVIP/IDSFFT SUBPRO- ID000080
C GRAM PACKAGE. ALL ELEMENTS OF RESULTING DZI1 AND DZI2 ARRAYS ID000090
C ARE EXPECTED TO BE ZERO. ID000100
C THE LUN CONSTANT IN THE LAST DATA INITIALIZATION STATEMENT IS ID000110
C THE LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, ID000120
C THEREFORE, SYSTEM DEPENDENT. ID000130
C DECLARATION STATEMENTS ID000140
DIMENSION XD(30),YD(30),ZD(30), ID000150
1 XI(6),YI(5),ZI(6,5), ID000160
2 ZI1(6,5),ZI2(6,5),DZI1(6,5),DZI2(6,5), ID000170
3 IWK(1030),WK(240) ID000180
DATA NCP/4/ ID000190
DATA NDP/30/ ID000200
DATA XD(1), XD(2), XD(3), XD(4), XD(5), XD(6), ID000210
1 XD(7), XD(8), XD(9), XD(10),XD(11),XD(12), ID000220
2 XD(13),XD(14),XD(15),XD(16),XD(17),XD(18), ID000230
3 XD(19),XD(20),XD(21),XD(22),XD(23),XD(24), ID000240
4 XD(25),XD(26),XD(27),XD(28),XD(29),XD(30)/ ID000250
5 11.16, 24.20, 19.85, 10.35, 19.72, 0.00, ID000260
6 20.87, 19.99, 10.28, 4.51, 0.00, 16.70, ID000270
7 6.08, 25.00, 14.90, 0.00, 9.66, 5.22, ID000280
8 11.77, 15.10, 25.00, 25.00, 14.59, 15.20, ID000290
9 5.23, 2.14, 0.51, 25.00, 21.67, 3.31/ ID000300
DATA YD(1), YD(2), YD(3), YD(4), YD(5), YD(6), ID000310
1 YD(7), YD(8), YD(9), YD(10),YD(11),YD(12), ID000320
2 YD(13),YD(14),YD(15),YD(16),YD(17),YD(18), ID000330
3 YD(19),YD(20),YD(21),YD(22),YD(23),YD(24), ID000340
4 YD(25),YD(26),YD(27),YD(28),YD(29),YD(30)/ ID000350
5 1.24, 16.23, 10.72, 4.11, 1.39, 20.00, ID000360
6 20.00, 4.62, 15.16, 20.00, 4.48, 19.65, ID000370
7 4.58, 11.87, 3.12, 0.00, 20.00, 14.66, ID000380
8 10.47, 17.19, 3.87, 0.00, 8.71, 0.00, ID000390
9 10.72, 15.03, 8.37, 20.00, 14.36, 0.13/ ID000400
DATA ZD(1), ZD(2), ZD(3), ZD(4), ZD(5), ZD(6), ID000410
1 ZD(7), ZD(8), ZD(9), ZD(10),ZD(11),ZD(12), ID000420
2 ZD(13),ZD(14),ZD(15),ZD(16),ZD(17),ZD(18), ID000430
3 ZD(19),ZD(20),ZD(21),ZD(22),ZD(23),ZD(24), ID000440
4 ZD(25),ZD(26),ZD(27),ZD(28),ZD(29),ZD(30)/ ID000450
5 22.15, 2.83, 7.97, 22.33, 16.83, 34.60, ID000460
6 5.74, 14.72, 21.59, 15.61, 61.77, 6.31, ID000470
7 35.74, 4.40, 21.70, 58.20, 4.73, 40.36, ID000480
8 13.62, 12.57, 8.74, 12.00, 14.81, 21.60, ID000490
9 26.50, 53.10, 49.43, 0.60, 5.52, 44.08/ ID000500
DATA NXI/6/, NYI/5/ ID000510
DATA XI(1), XI(2), XI(3), XI(4), XI(5), XI(6)/ ID000520
1 0.00, 5.00, 10.00, 15.00, 20.00, 25.00/ ID000530
DATA YI(1), YI(2), YI(3), YI(4), YI(5)/ ID000540
1 0.00, 5.00, 10.00, 15.00, 20.00/ ID000550
DATA ZI(1,1),ZI(2,1),ZI(3,1),ZI(4,1),ZI(5,1),ZI(6,1), ID000560
1 ZI(1,2),ZI(2,2),ZI(3,2),ZI(4,2),ZI(5,2),ZI(6,2), ID000570
2 ZI(1,3),ZI(2,3),ZI(3,3),ZI(4,3),ZI(5,3),ZI(6,3), ID000580
3 ZI(1,4),ZI(2,4),ZI(3,4),ZI(4,4),ZI(5,4),ZI(6,4), ID000590
4 ZI(1,5),ZI(2,5),ZI(3,5),ZI(4,5),ZI(5,5),ZI(6,5)/ ID000600
5 58.20, 39.55, 26.90, 21.71, 17.68, 12.00, ID000610
6 61.58, 39.39, 22.04, 21.29, 14.36, 8.04, ID000620
7 59.18, 27.39, 16.78, 13.25, 8.59, 5.36, ID000630
8 52.82, 40.27, 22.76, 16.61, 7.40, 2.88, ID000640
9 34.60, 14.05, 4.12, 3.17, 6.31, 0.60/ ID000650
DATA LUN/6/ ID000660
C CALCULATION ID000670
10 MD=1 ID000680
DO 12 IYI=1,NYI ID000690
DO 11 IXI=1,NXI ID000700
IF(IXI.NE.1.OR.IYI.NE.1) MD=2 ID000710
CALL IDBVIP(MD,NCP,NDP,XD,YD,ZD,1,XI(IXI),YI(IYI), ID000720
1 ZI1(IXI,IYI),IWK,WK) ID000730
11 CONTINUE ID000740
12 CONTINUE ID000750
15 CALL IDSFFT(1,NCP,NDP,XD,YD,ZD,NXI,NYI,XI,YI,ZI2,IWK,WK) ID000760
DO 17 IYI=1,NYI ID000770
DO 16 IXI=1,NXI ID000780
DZI1(IXI,IYI)=ABS(ZI1(IXI,IYI)-ZI(IXI,IYI)) ID000790
DZI2(IXI,IYI)=ABS(ZI2(IXI,IYI)-ZI(IXI,IYI)) ID000800
16 CONTINUE ID000810
17 CONTINUE ID000820
C PRINTING OF INPUT DATA ID000830
20 WRITE (LUN,2020) NDP ID000840
DO 23 IDP=1,NDP ID000850
IF(MOD(IDP,5).EQ.1) WRITE (LUN,2021) ID000860
WRITE (LUN,2022) IDP,XD(IDP),YD(IDP),ZD(IDP) ID000870
23 CONTINUE ID000880
C PRINTING OF OUTPUT RESULTS ID000890
30 WRITE (LUN,2030) ID000900
WRITE (LUN,2031) YI ID000910
DO 33 IXI=1,NXI ID000920
WRITE (LUN,2032) XI(IXI),(ZI1(IXI,IYI),IYI=1,NYI) ID000930
33 CONTINUE ID000940
40 WRITE (LUN,2040) ID000950
WRITE (LUN,2031) YI ID000960
DO 43 IXI=1,NXI ID000970
WRITE (LUN,2032) XI(IXI),(DZI1(IXI,IYI),IYI=1,NYI) ID000980
43 CONTINUE ID000990
50 WRITE (LUN,2050) ID001000
WRITE (LUN,2031) YI ID001010
DO 53 IXI=1,NXI ID001020
WRITE (LUN,2032) XI(IXI),(ZI2(IXI,IYI),IYI=1,NYI) ID001030
53 CONTINUE ID001040
60 WRITE (LUN,2060) ID001050
WRITE (LUN,2031) YI ID001060
DO 63 IXI=1,NXI ID001070
WRITE (LUN,2032) XI(IXI),(DZI2(IXI,IYI),IYI=1,NYI) ID001080
63 CONTINUE ID001090
STOP ID001100
C FORMAT STATEMENTS ID001110
2020 FORMAT(1H1,6HTTIDBS/////3X,10HINPUT DATA,8X,5HNDP =,I3/// ID001120
1 30H I XD YD ZD /) ID001130
2021 FORMAT(1X) ID001140
2022 FORMAT(5X,I2,2X,3F7.2) ID001150
2030 FORMAT(1H1,6HTTIDBS/////3X,17HIDBVIP SUBROUTINE/// ID001160
1 26X,10HZI1(XI,YI)) ID001170
2031 FORMAT(7X,2HXI,4X,3HYI=/12X,5F7.2/) ID001180
2032 FORMAT(1X/1X,F9.2,2X,5F7.2) ID001190
2040 FORMAT(1X/////3X,10HDIFFERENCE/// ID001200
1 25X,11HDZI1(XI,YI)) ID001210
2050 FORMAT(1H1,6HTTIDBS/////3X,17HIDSFFT SUBROUTINE/// ID001220
1 26X,10HZI2(XI,YI)) ID001230
2060 FORMAT(1X/////3X,10HDIFFERENCE/// ID001240
1 25X,11HDZI2(XI,YI)) ID001250
END ID001260
SUBROUTINE IDBVIP(MD,NCP,NDP,XD,YD,ZD,NIP,XI,YI,ZI, ID001340
1 IWK,WK)
C THIS SUBROUTINE PERFORMS BIVARIATE INTERPOLATION WHEN THE PRO-
C JECTIONS OF THE DATA POINTS IN THE X-Y PLANE ARE IRREGULARLY
C DISTRIBUTED IN THE PLANE.
C THE INPUT PARAMETERS ARE
C MD = MODE OF COMPUTATION (MUST BE 1, 2, OR 3),
C = 1 FOR NEW NCP AND/OR NEW XD-YD,
C = 2 FOR OLD NCP, OLD XD-YD, NEW XI-YI,
C = 3 FOR OLD NCP, OLD XD-YD, OLD XI-YI,
C NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI-
C MATING PARTIAL DERIVATIVES AT EACH DATA POINT
C (MUST BE 2 OR GREATER, BUT SMALLER THAN NDP),
C NDP = NUMBER OF DATA POINTS (MUST BE 4 OR GREATER),
C XD = ARRAY OF DIMENSION NDP CONTAINING THE X
C COORDINATES OF THE DATA POINTS,
C YD = ARRAY OF DIMENSION NDP CONTAINING THE Y
C COORDINATES OF THE DATA POINTS,
C ZD = ARRAY OF DIMENSION NDP CONTAINING THE Z
C COORDINATES OF THE DATA POINTS,
C NIP = NUMBER OF OUTPUT POINTS AT WHICH INTERPOLATION
C IS TO BE PERFORMED (MUST BE 1 OR GREATER),
C XI = ARRAY OF DIMENSION NIP CONTAINING THE X
C COORDINATES OF THE OUTPUT POINTS,
C YI = ARRAY OF DIMENSION NIP CONTAINING THE Y
C COORDINATES OF THE OUTPUT POINTS.
C THE OUTPUT PARAMETER IS
C ZI = ARRAY OF DIMENSION NIP WHERE INTERPOLATED Z
C VALUES ARE TO BE STORED.
C THE OTHER PARAMETERS ARE
C IWK = INTEGER ARRAY OF DIMENSION
C MAX0(31,27+NCP)*NDP+NIP
C USED INTERNALLY AS A WORK AREA,
C WK = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
C WORK AREA.
C THE VERY FIRST CALL TO THIS SUBROUTINE AND THE CALL WITH A NEW
C NCP VALUE, A NEW NDP VALUE, AND/OR NEW CONTENTS OF THE XD AND
C YD ARRAYS MUST BE MADE WITH MD=1. THE CALL WITH MD=2 MUST BE
C PRECEDED BY ANOTHER CALL WITH THE SAME NCP AND NDP VALUES AND
C WITH THE SAME CONTENTS OF THE XD AND YD ARRAYS. THE CALL WITH
C MD=3 MUST BE PRECEDED BY ANOTHER CALL WITH THE SAME NCP, NDP,
C AND NIP VALUES AND WITH THE SAME CONTENTS OF THE XD, YD, XI,
C AND YI ARRAYS. BETWEEN THE CALL WITH MD=2 OR MD=3 AND ITS
C PRECEDING CALL, THE IWK AND WK ARRAYS MUST NOT BE DISTURBED.
C USE OF A VALUE BETWEEN 3 AND 5 (INCLUSIVE) FOR NCP IS RECOM-
C MENDED UNLESS THERE ARE EVIDENCES THAT DICTATE OTHERWISE.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C THIS SUBROUTINE CALLS THE IDCLDP, IDLCTN, IDPDRV, IDPTIP, AND
C IDTANG SUBROUTINES.
C DECLARATION STATEMENTS
DIMENSION XD(100),YD(100),ZD(100),XI(1000),YI(1000),
1 ZI(1000),IWK(4100),WK(800)
COMMON/IDLC/NIT
COMMON/IDPI/ITPV
DATA LUN/6/
C SETTING OF SOME INPUT PARAMETERS TO LOCAL VARIABLES.
C (FOR MD=1,2,3)
10 MD0=MD
NCP0=NCP
NDP0=NDP
NIP0=NIP
C ERROR CHECK. (FOR MD=1,2,3)
20 IF(MD0.LT.1.OR.MD0.GT.3) GO TO 90
IF(NCP0.LT.2.OR.NCP0.GE.NDP0) GO TO 90
IF(NDP0.LT.4) GO TO 90
IF(NIP0.LT.1) GO TO 90
IF(MD0.GE.2) GO TO 21
IWK(1)=NCP0
IWK(2)=NDP0
GO TO 22
21 NCPPV=IWK(1)
NDPPV=IWK(2)
IF(NCP0.NE.NCPPV) GO TO 90
IF(NDP0.NE.NDPPV) GO TO 90
22 IF(MD0.GE.3) GO TO 23
IWK(3)=NIP
GO TO 30
23 NIPPV=IWK(3)
IF(NIP0.NE.NIPPV) GO TO 90
C ALLOCATION OF STORAGE AREAS IN THE IWK ARRAY. (FOR MD=1,2,3)
30 JWIPT=16
JWIWL=6*NDP0+1
JWIWK=JWIWL
JWIPL=24*NDP0+1
JWIWP=30*NDP0+1
JWIPC=27*NDP0+1
JWIT0=MAX0(31,27+NCP0)*NDP0
C TRIANGULATES THE X-Y PLANE. (FOR MD=1)
40 IF(MD0.GT.1) GO TO 50
CALL IDTANG(NDP0,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),
1 IWK(JWIWL),IWK(JWIWP),WK)
IWK(5)=NT
IWK(6)=NL
IF(NT.EQ.0) RETURN
C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT. (FOR MD=1)
50 IF(MD0.GT.1) GO TO 60
CALL IDCLDP(NDP0,XD,YD,NCP0,IWK(JWIPC))
IF(IWK(JWIPC).EQ.0) RETURN
C LOCATES ALL POINTS AT WHICH INTERPOLATION IS TO BE PERFORMED.
C (FOR MD=1,2)
60 IF(MD0.EQ.3) GO TO 70
NIT=0
JWIT=JWIT0
DO 61 IIP=1,NIP0
JWIT=JWIT+1
CALL IDLCTN(NDP0,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),
1 XI(IIP),YI(IIP),IWK(JWIT),IWK(JWIWK),WK)
61 CONTINUE
C ESTIMATES PARTIAL DERIVATIVES AT ALL DATA POINTS.
C (FOR MD=1,2,3)
70 CALL IDPDRV(NDP0,XD,YD,ZD,NCP0,IWK(JWIPC),WK)
C INTERPOLATES THE ZI VALUES. (FOR MD=1,2,3)
80 ITPV=0
JWIT=JWIT0
DO 81 IIP=1,NIP0
JWIT=JWIT+1
CALL IDPTIP(XD,YD,ZD,NT,IWK(JWIPT),NL,IWK(JWIPL),WK,
1 IWK(JWIT),XI(IIP),YI(IIP),ZI(IIP))
81 CONTINUE
RETURN
C ERROR EXIT
90 WRITE (LUN,2090) MD0,NCP0,NDP0,NIP0
RETURN
C FORMAT STATEMENT FOR ERROR MESSAGE
2090 FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S)./
1 7H MD =,I4,10X,5HNCP =,I6,10X,5HNDP =,I6,
2 10X,5HNIP =,I6/
3 35H ERROR DETECTED IN ROUTINE IDBVIP/)
END
SUBROUTINE IDCLDP(NDP,XD,YD,NCP,IPC) ID002720
C THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST
C TO EACH OF THE DATA POINT.
C THE INPUT PARAMETERS ARE
C NDP = NUMBER OF DATA POINTS,
C XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C COORDINATES OF THE DATA POINTS,
C NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA
C POINTS.
C THE OUTPUT PARAMETER IS
C IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE
C POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
C EACH OF THE NDP DATA POINTS ARE TO BE STORED.
C THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST
C NOT EXCEED 25.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C DECLARATION STATEMENTS
DIMENSION XD(100),YD(100),IPC(400)
DIMENSION DSQ0(25),IPC0(25)
DATA NCPMX/25/, LUN/6/
C STATEMENT FUNCTION
DSQF(U1,V1,U2,V2)=(U2-U1)**2+(V2-V1)**2
C PRELIMINARY PROCESSING
10 NDP0=NDP
NCP0=NCP
IF(NDP0.LT.2) GO TO 90
IF(NCP0.LT.1.OR.NCP0.GT.NCPMX.OR.NCP0.GE.NDP0) GO TO 90
C CALCULATION
20 DO 59 IP1=1,NDP0
C - SELECTS NCP POINTS.
X1=XD(IP1)
Y1=YD(IP1)
J1=0
DSQMX=0.0
DO 22 IP2=1,NDP0
IF(IP2.EQ.IP1) GO TO 22
DSQI=DSQF(X1,Y1,XD(IP2),YD(IP2))
J1=J1+1
DSQ0(J1)=DSQI
IPC0(J1)=IP2
IF(DSQI.LE.DSQMX) GO TO 21
DSQMX=DSQI
JMX=J1
21 IF(J1.GE.NCP0) GO TO 23
22 CONTINUE
23 IP2MN=IP2+1
IF(IP2MN.GT.NDP0) GO TO 30
DO 25 IP2=IP2MN,NDP0
IF(IP2.EQ.IP1) GO TO 25
DSQI=DSQF(X1,Y1,XD(IP2),YD(IP2))
IF(DSQI.GE.DSQMX) GO TO 25
DSQ0(JMX)=DSQI
IPC0(JMX)=IP2
DSQMX=0.0
DO 24 J1=1,NCP0
IF(DSQ0(J1).LE.DSQMX) GO TO 24
DSQMX=DSQ0(J1)
JMX=J1
24 CONTINUE
25 CONTINUE
C - CHECKS IF ALL THE NCP+1 POINTS ARE COLLINEAR.
30 IP2=IPC0(1)
DX12=XD(IP2)-X1
DY12=YD(IP2)-Y1
DO 31 J3=2,NCP0
IP3=IPC0(J3)
DX13=XD(IP3)-X1
DY13=YD(IP3)-Y1
IF((DY13*DX12-DX13*DY12).NE.0.0) GO TO 50
31 CONTINUE
C - SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT.
40 NCLPT=0
DO 43 IP3=1,NDP0
IF(IP3.EQ.IP1) GO TO 43
DO 41 J4=1,NCP0
IF(IP3.EQ.IPC0(J4)) GO TO 43
41 CONTINUE
DX13=XD(IP3)-X1
DY13=YD(IP3)-Y1
IF((DY13*DX12-DX13*DY12).EQ.0.0) GO TO 43
DSQI=DSQF(X1,Y1,XD(IP3),YD(IP3))
IF(NCLPT.EQ.0) GO TO 42
IF(DSQI.GE.DSQMN) GO TO 43
42 NCLPT=1
DSQMN=DSQI
IP3MN=IP3
43 CONTINUE
IF(NCLPT.EQ.0) GO TO 91
DSQMX=DSQMN
IPC0(JMX)=IP3MN
C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY.
50 J1=(IP1-1)*NCP0
DO 51 J2=1,NCP0
J1=J1+1
IPC(J1)=IPC0(J2)
51 CONTINUE
59 CONTINUE
RETURN
C ERROR EXIT
90 WRITE (LUN,2090)
GO TO 92
91 WRITE (LUN,2091)
92 WRITE (LUN,2092) NDP0,NCP0
IPC(1)=0
RETURN
C FORMAT STATEMENTS FOR ERROR MESSAGES
2090 FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S).)
2091 FORMAT(1X/33H *** ALL COLLINEAR DATA POINTS.)
2092 FORMAT(8H NDP =,I5,5X,5HNCP =,I5/
1 35H ERROR DETECTED IN ROUTINE IDCLDP/)
END
SUBROUTINE IDGRID(XD, YD, NT, IPT, NL, IPL, NXI, NYI, XI, YI, IDG 10
* NGP, IGP)
C THIS SUBROUTINE ORGANIZES GRID POINTS FOR SURFACE FITTING BY
C SORTING THEM IN ASCENDING ORDER OF TRIANGLE NUMBERS AND OF THE
C BORDER LINE SEGMENT NUMBER.
C THE INPUT PARAMETERS ARE
C XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C COORDINATES OF THE DATA POINTS, WHERE NDP IS THE
C NUMBER OF THE DATA POINTS,
C NT = NUMBER OF TRIANGLES,
C IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C NL = NUMBER OF BORDER LINE SEGMENTS,
C IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C POINT NUMBERS OF THE END POINTS OF THE BORDER
C LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C NUMBERS,
C NXI = NUMBER OF GRID POINTS IN THE X COORDINATE,
C NYI = NUMBER OF GRID POINTS IN THE Y COORDINATE,
C XI,YI = ARRAYS OF DIMENSION NXI AND NYI CONTAINING
C THE X AND Y COORDINATES OF THE GRID POINTS,
C RESPECTIVELY.
C THE OUTPUT PARAMETERS ARE
C NGP = INTEGER ARRAY OF DIMENSION 2*(NT+2*NL) WHERE THE
C NUMBER OF GRID POINTS THAT BELONG TO EACH OF THE
C TRIANGLES OR OF THE BORDER LINE SEGMENTS ARE TO
C BE STORED,
C IGP = INTEGER ARRAY OF DIMENSION NXI*NYI WHERE THE
C GRID POINT NUMBERS ARE TO BE STORED IN ASCENDING
C ORDER OF THE TRIANGLE NUMBER AND THE BORDER LINE
C SEGMENT NUMBER.
C DECLARATION STATEMENTS
DIMENSION XD(100), YD(100), IPT(585), IPL(300), XI(101),
* YI(101), NGP(800), IGP(10201)
C STATEMENT FUNCTIONS
SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3)
SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2)
C PRELIMINARY PROCESSING
NT0 = NT
NL0 = NL
NXI0 = NXI
NYI0 = NYI
NXINYI = NXI0*NYI0
XIMN = AMIN1(XI(1),XI(NXI0))
XIMX = AMAX1(XI(1),XI(NXI0))
YIMN = AMIN1(YI(1),YI(NYI0))
YIMX = AMAX1(YI(1),YI(NYI0))
C DETERMINES GRID POINTS INSIDE THE DATA AREA.
JNGP0 = 0
JNGP1 = 2*(NT0+2*NL0) + 1
JIGP0 = 0
JIGP1 = NXINYI + 1
DO 160 IT0=1,NT0
NGP0 = 0
NGP1 = 0
IT0T3 = IT0*3
IP1 = IPT(IT0T3-2)
IP2 = IPT(IT0T3-1)
IP3 = IPT(IT0T3)
X1 = XD(IP1)
Y1 = YD(IP1)
X2 = XD(IP2)
Y2 = YD(IP2)
X3 = XD(IP3)
Y3 = YD(IP3)
XMN = AMIN1(X1,X2,X3)
XMX = AMAX1(X1,X2,X3)
YMN = AMIN1(Y1,Y2,Y3)
YMX = AMAX1(Y1,Y2,Y3)
INSD = 0
DO 20 IXI=1,NXI0
IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 10
IF (INSD.EQ.0) GO TO 20
IXIMX = IXI - 1
GO TO 30
10 IF (INSD.EQ.1) GO TO 20
INSD = 1
IXIMN = IXI
20 CONTINUE
IF (INSD.EQ.0) GO TO 150
IXIMX = NXI0
30 DO 140 IYI=1,NYI0
YII = YI(IYI)
IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 140
DO 130 IXI=IXIMN,IXIMX
XII = XI(IXI)
L = 0
IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 130, 40, 50
40 L = 1
50 IF (SIDE(X2,Y2,X3,Y3,XII,YII)) 130, 60, 70
60 L = 1
70 IF (SIDE(X3,Y3,X1,Y1,XII,YII)) 130, 80, 90
80 L = 1
90 IZI = NXI0*(IYI-1) + IXI
IF (L.EQ.1) GO TO 100
NGP0 = NGP0 + 1
JIGP0 = JIGP0 + 1
IGP(JIGP0) = IZI
GO TO 130
100 IF (JIGP1.GT.NXINYI) GO TO 120
DO 110 JIGP1I=JIGP1,NXINYI
IF (IZI.EQ.IGP(JIGP1I)) GO TO 130
110 CONTINUE
120 NGP1 = NGP1 + 1
JIGP1 = JIGP1 - 1
IGP(JIGP1) = IZI
130 CONTINUE
140 CONTINUE
150 JNGP0 = JNGP0 + 1
NGP(JNGP0) = NGP0
JNGP1 = JNGP1 - 1
NGP(JNGP1) = NGP1
160 CONTINUE
C DETERMINES GRID POINTS OUTSIDE THE DATA AREA.
C - IN SEMI-INFINITE RECTANGULAR AREA.
DO 450 IL0=1,NL0
NGP0 = 0
NGP1 = 0
IL0T3 = IL0*3
IP1 = IPL(IL0T3-2)
IP2 = IPL(IL0T3-1)
X1 = XD(IP1)
Y1 = YD(IP1)
X2 = XD(IP2)
Y2 = YD(IP2)
XMN = XIMN
XMX = XIMX
YMN = YIMN
YMX = YIMX
IF (Y2.GE.Y1) XMN = AMIN1(X1,X2)
IF (Y2.LE.Y1) XMX = AMAX1(X1,X2)
IF (X2.LE.X1) YMN = AMIN1(Y1,Y2)
IF (X2.GE.X1) YMX = AMAX1(Y1,Y2)
INSD = 0
DO 180 IXI=1,NXI0
IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 170
IF (INSD.EQ.0) GO TO 180
IXIMX = IXI - 1
GO TO 190
170 IF (INSD.EQ.1) GO TO 180
INSD = 1
IXIMN = IXI
180 CONTINUE
IF (INSD.EQ.0) GO TO 310
IXIMX = NXI0
190 DO 300 IYI=1,NYI0
YII = YI(IYI)
IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 300
DO 290 IXI=IXIMN,IXIMX
XII = XI(IXI)
L = 0
IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 210, 200, 290
200 L = 1
210 IF (SPDT(X2,Y2,X1,Y1,XII,YII)) 290, 220, 230
220 L = 1
230 IF (SPDT(X1,Y1,X2,Y2,XII,YII)) 290, 240, 250
240 L = 1
250 IZI = NXI0*(IYI-1) + IXI
IF (L.EQ.1) GO TO 260
NGP0 = NGP0 + 1
JIGP0 = JIGP0 + 1
IGP(JIGP0) = IZI
GO TO 290
260 IF (JIGP1.GT.NXINYI) GO TO 280
DO 270 JIGP1I=JIGP1,NXINYI
IF (IZI.EQ.IGP(JIGP1I)) GO TO 290
270 CONTINUE
280 NGP1 = NGP1 + 1
JIGP1 = JIGP1 - 1
IGP(JIGP1) = IZI
290 CONTINUE
300 CONTINUE
310 JNGP0 = JNGP0 + 1
NGP(JNGP0) = NGP0
JNGP1 = JNGP1 - 1
NGP(JNGP1) = NGP1
C - IN SEMI-INFINITE TRIANGULAR AREA.
NGP0 = 0
NGP1 = 0
ILP1 = MOD(IL0,NL0) + 1
ILP1T3 = ILP1*3
IP3 = IPL(ILP1T3-1)
X3 = XD(IP3)
Y3 = YD(IP3)
XMN = XIMN
XMX = XIMX
YMN = YIMN
YMX = YIMX
IF (Y3.GE.Y2 .AND. Y2.GE.Y1) XMN = X2
IF (Y3.LE.Y2 .AND. Y2.LE.Y1) XMX = X2
IF (X3.LE.X2 .AND. X2.LE.X1) YMN = Y2
IF (X3.GE.X2 .AND. X2.GE.X1) YMX = Y2
INSD = 0
DO 330 IXI=1,NXI0
IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 320
IF (INSD.EQ.0) GO TO 330
IXIMX = IXI - 1
GO TO 340
320 IF (INSD.EQ.1) GO TO 330
INSD = 1
IXIMN = IXI
330 CONTINUE
IF (INSD.EQ.0) GO TO 440
IXIMX = NXI0
340 DO 430 IYI=1,NYI0
YII = YI(IYI)
IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 430
DO 420 IXI=IXIMN,IXIMX
XII = XI(IXI)
L = 0
IF (SPDT(X1,Y1,X2,Y2,XII,YII)) 360, 350, 420
350 L = 1
360 IF (SPDT(X3,Y3,X2,Y2,XII,YII)) 380, 370, 420
370 L = 1
380 IZI = NXI0*(IYI-1) + IXI
IF (L.EQ.1) GO TO 390
NGP0 = NGP0 + 1
JIGP0 = JIGP0 + 1
IGP(JIGP0) = IZI
GO TO 420
390 IF (JIGP1.GT.NXINYI) GO TO 410
DO 400 JIGP1I=JIGP1,NXINYI
IF (IZI.EQ.IGP(JIGP1I)) GO TO 420
400 CONTINUE
410 NGP1 = NGP1 + 1
JIGP1 = JIGP1 - 1
IGP(JIGP1) = IZI
420 CONTINUE
430 CONTINUE
440 JNGP0 = JNGP0 + 1
NGP(JNGP0) = NGP0
JNGP1 = JNGP1 - 1
NGP(JNGP1) = NGP1
450 CONTINUE
RETURN
END
SUBROUTINE IDLCTN(NDP, XD, YD, NT, IPT, NL, IPL, XII, YII, ITI, IDL 10
* IWK, WK)
C THIS SUBROUTINE LOCATES A POINT, I.E., DETERMINES TO WHAT TRI-
C ANGLE A GIVEN POINT (XII,YII) BELONGS. WHEN THE GIVEN POINT
C DOES NOT LIE INSIDE THE DATA AREA, THIS SUBROUTINE DETERMINES
C THE BORDER LINE SEGMENT WHEN THE POINT LIES IN AN OUTSIDE
C RECTANGULAR AREA, AND TWO BORDER LINE SEGMENTS WHEN THE POINT
C LIES IN AN OUTSIDE TRIANGULAR AREA.
C THE INPUT PARAMETERS ARE
C NDP = NUMBER OF DATA POINTS,
C XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C COORDINATES OF THE DATA POINTS,
C NT = NUMBER OF TRIANGLES,
C IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C NL = NUMBER OF BORDER LINE SEGMENTS,
C IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C POINT NUMBERS OF THE END POINTS OF THE BORDER
C LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C NUMBERS,
C XII,YII = X AND Y COORDINATES OF THE POINT TO BE
C LOCATED.
C THE OUTPUT PARAMETER IS
C ITI = TRIANGLE NUMBER, WHEN THE POINT IS INSIDE THE
C DATA AREA, OR
C TWO BORDER LINE SEGMENT NUMBERS, IL1 AND IL2,
C CODED TO IL1*(NT+NL)+IL2, WHEN THE POINT IS
C OUTSIDE THE DATA AREA.
C THE OTHER PARAMETERS ARE
C IWK = INTEGER ARRAY OF DIMENSION 18*NDP USED INTER-
C NALLY AS A WORK AREA,
C WK = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
C WORK AREA.
C DECLARATION STATEMENTS
DIMENSION XD(100), YD(100), IPT(585), IPL(300), IWK(1800),
* WK(800)
DIMENSION NTSC(9), IDSC(9)
COMMON /IDLC/ NIT
C STATEMENT FUNCTIONS
SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3)
SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2)
C PRELIMINARY PROCESSING
NDP0 = NDP
NT0 = NT
NL0 = NL
NTL = NT0 + NL0
X0 = XII
Y0 = YII
C PROCESSING FOR A NEW SET OF DATA POINTS
IF (NIT.NE.0) GO TO 80
NIT = 1
C - DIVIDES THE X-Y PLANE INTO NINE RECTANGULAR SECTIONS.
XMN = XD(1)
XMX = XMN
YMN = YD(1)
YMX = YMN
DO 10 IDP=2,NDP0
XI = XD(IDP)
YI = YD(IDP)
XMN = AMIN1(XI,XMN)
XMX = AMAX1(XI,XMX)
YMN = AMIN1(YI,YMN)
YMX = AMAX1(YI,YMX)
10 CONTINUE
XS1 = (XMN+XMN+XMX)/3.0
XS2 = (XMN+XMX+XMX)/3.0
YS1 = (YMN+YMN+YMX)/3.0
