Commit 53406f4e authored by agebhard's avatar agebhard
Browse files

Imported sources

parents
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