Commit 338da289 authored by Gebhardt, Albrecht's avatar Gebhardt, Albrecht
Browse files

fix the latest fortan warnings

parent 2f29a003
......@@ -4,7 +4,7 @@ C ALGORITHM 697 , COLLECTED ALGORITHMS FROM ACM.
C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C VOL. 17, NO. 3, SEPTEMBER, 1991, PP. 367.
C
SUBROUTINE UVIP3P(NP,ND,XD,YD,NI,XI, YI, ERR)
SUBROUTINE UVIP3P(NP,ND,XD,YD,NI,XI, YI, IERR)
IMPLICIT INTEGER (I-N), DOUBLE PRECISION (A-H,O-Z)
C
C Univariate Interpolation (Improved Akima Method)
......@@ -49,7 +49,7 @@ C
C The output argument is
C YI = array of dimension NI, where the ordinates of the
C desired points are to be stored.
C ERR = ERROR CODE (added by ThPe)
C IERR = ERROR CODE (added by ThPe)
C
C If an integer value smaller than 3 is given to the NP argument,
C this subroutine assumes NP = 3.
......@@ -390,10 +390,10 @@ C (Cubic interpolation and linear extrapolation)
C End of Special Case 3
RETURN
C Error exit
90 ERR=1
90 IERR=1
RETURN
91 ERR=2
91 IERR=2
RETURN
92 ERR=3
92 IERR=3
RETURN
END
......@@ -340,7 +340,20 @@ C WRITE (*,FMT=9050)
C WRITE (*,FMT=9060) NXD,NYD,NXI,NYI
RETURN
END
* converted from statement functions:
DOUBLE PRECISION FUNCTION Z2F(XX1,XX2,ZZ0,ZZ1)
IMPLICIT DOUBLE PRECISION (X-Z)
Z2F=(ZZ1-ZZ0)*XX2/XX1 + ZZ0
RETURN
END
DOUBLE PRECISION FUNCTION Z3F(XX1,XX2,XX3,ZZ0,ZZ1,ZZ2)
IMPLICIT DOUBLE PRECISION (X-Z)
Z3F=((ZZ2-ZZ0)* (XX3-XX1)/XX2-
+ (ZZ1-ZZ0)* (XX3-XX2)/XX1)*
+ (XX3/ (XX2-XX1)) + ZZ0
RETURN
END
SUBROUTINE RGPD3P(NXD,NYD,XD,YD,ZD, PDD)
*
......@@ -414,11 +427,11 @@ C WRITE (*,FMT=9060) NXD,NYD,NXI,NYI
DATA ((IDLT(JXY,JPEXY),JPEXY=1,4),JXY=1,3)/-3,-2,-1,1,
+ -2,-1,1,2,-1,1,2,3/
* ..
* Statement Function definitions
Z2F(XX1,XX2,ZZ0,ZZ1) = (ZZ1-ZZ0)*XX2/XX1 + ZZ0
Z3F(XX1,XX2,XX3,ZZ0,ZZ1,ZZ2) = ((ZZ2-ZZ0)* (XX3-XX1)/XX2-
+ (ZZ1-ZZ0)* (XX3-XX2)/XX1)*
+ (XX3/ (XX2-XX1)) + ZZ0
* Statement Function definitions -> converted above
* Z2F(XX1,XX2,ZZ0,ZZ1) = (ZZ1-ZZ0)*XX2/XX1 + ZZ0
* Z3F(XX1,XX2,XX3,ZZ0,ZZ1,ZZ2) = ((ZZ2-ZZ0)* (XX3-XX1)/XX2-
* + (ZZ1-ZZ0)* (XX3-XX2)/XX1)*
* + (XX3/ (XX2-XX1)) + ZZ0
* ..
* initialize some variables to silence compiler warnings
Z00=0.0D0
......@@ -1275,3 +1288,5 @@ C WRITE (*,FMT=9060) NXD,NYD,NXI,NYI
RETURN
END
......@@ -695,6 +695,19 @@ c WRITE (*,FMT=9010)
END
* converted from Statement Function definitions ..
DOUBLE PRECISION FUNCTION DSQF(U1,V1,U2,V2,U3,V3)
IMPLICIT DOUBLE PRECISION (U-V)
DSQF=((U2-U1)/U3)**2 + ((V2-V1)/V3)**2
RETURN
END
DOUBLE PRECISION FUNCTION VPDT(U1,V1,U2,V2,U3,V3,U4,V4)
IMPLICIT DOUBLE PRECISION (U-V)
VPDT=((V3-V1)/V4)* ((U2-U1)/U4) -
+ ((U3-U1)/U4)* ((V2-V1)/V4)
RETURN
END
SUBROUTINE SDTRTT(NDP,XD,YD,NT,IPT,NL,IPL,ITL,HBRMN,NRRTT,IER)
*
* Removal of thin triangles along the border line of triangulation
......@@ -772,9 +785,9 @@ c WRITE (*,FMT=9010)
DOUBLE PRECISION DSQF,VPDT
* ..
* .. Statement Function definitions ..
DSQF(U1,V1,U2,V2,U3,V3) = ((U2-U1)/U3)**2 + ((V2-V1)/V3)**2
VPDT(U1,V1,U2,V2,U3,V3,U4,V4) = ((V3-V1)/V4)* ((U2-U1)/U4) -
+ ((U3-U1)/U4)* ((V2-V1)/V4)
* DSQF(U1,V1,U2,V2,U3,V3) = ((U2-U1)/U3)**2 + ((V2-V1)/V3)**2
* VPDT(U1,V1,U2,V2,U3,V3,U4,V4) = ((V3-V1)/V4)* ((U2-U1)/U4) -
* + ((U3-U1)/U4)* ((V2-V1)/V4)
* ..
* initialization:
IER=0
......@@ -1797,6 +1810,18 @@ c WRITE (*,FMT=9010)
RETURN
END
* converted from Statement Function definitions ..
DOUBLE PRECISION FUNCTION SPDT(U1,V1,U2,V2,U3,V3)
IMPLICIT DOUBLE PRECISION (U-V)
SPDT=(U1-U3)* (U2-U3) + (V1-V3)* (V2-V3)
RETURN
END
* renamed to VPDT3 as from above already a VPDT exists:
DOUBLE PRECISION FUNCTION VPDT3(U1,V1,U2,V2,U3,V3)
IMPLICIT DOUBLE PRECISION (U-V)
VPDT3=(U1-U3)* (V2-V3) - (V1-V3)* (U2-U3)
RETURN
END
SUBROUTINE SDLCTN(NDP,XD,YD,NT,IPT,NL,IPL,NIP,XI,YI,KTLI,ITLI)
*
......@@ -1871,11 +1896,11 @@ c WRITE (*,FMT=9010)
INTRINSIC MOD
* ..
* .. Statement Functions ..
DOUBLE PRECISION SPDT,VPDT
DOUBLE PRECISION SPDT,VPDT3
* ..
* .. Statement Function definitions ..
SPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (U2-U3) + (V1-V3)* (V2-V3)
VPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (V2-V3) - (V1-V3)* (U2-U3)
* SPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (U2-U3) + (V1-V3)* (V2-V3)
* VPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (V2-V3) - (V1-V3)* (U2-U3)
* ..
* Outermost DO-loop with respect to the points to be located
DO 40 IIP = 1,NIP
......@@ -1900,9 +1925,9 @@ c WRITE (*,FMT=9010)
Y2 = YD(IP2)
X3 = XD(IP3)
Y3 = YD(IP3)
IF ((VPDT(X1,Y1,X2,Y2,X0,Y0).GE.0.0D0) .AND.
+ (VPDT(X2,Y2,X3,Y3,X0,Y0).GE.0.0D0) .AND.
+ (VPDT(X3,Y3,X1,Y1,X0,Y0).GE.0.0D0)) THEN
IF ((VPDT3(X1,Y1,X2,Y2,X0,Y0).GE.0.0D0) .AND.
+ (VPDT3(X2,Y2,X3,Y3,X0,Y0).GE.0.0D0) .AND.
+ (VPDT3(X3,Y3,X1,Y1,X0,Y0).GE.0.0D0)) THEN
KTLI(IIP) = 1
ITLI(IIP) = ITII
GO TO 40
......@@ -1919,9 +1944,9 @@ c WRITE (*,FMT=9010)
Y2 = YD(IP2)
X3 = XD(IP3)
Y3 = YD(IP3)
IF ((VPDT(X1,Y1,X2,Y2,X0,Y0).GE.0.0D0) .AND.
+ (VPDT(X2,Y2,X3,Y3,X0,Y0).GE.0.0D0) .AND.
+ (VPDT(X3,Y3,X1,Y1,X0,Y0).GE.0.0D0)) THEN
IF ((VPDT3(X1,Y1,X2,Y2,X0,Y0).GE.0.0D0) .AND.
+ (VPDT3(X2,Y2,X3,Y3,X0,Y0).GE.0.0D0) .AND.
+ (VPDT3(X3,Y3,X1,Y1,X0,Y0).GE.0.0D0)) THEN
KTLI(IIP) = 1
ITLI(IIP) = ITII
GO TO 40
......@@ -1940,8 +1965,8 @@ c WRITE (*,FMT=9010)
Y2 = YD(IP2)
X3 = XD(IP3)
Y3 = YD(IP3)
IF (VPDT(X1,Y1,X3,Y3,X0,Y0).LE.0.0D0) THEN
IF (VPDT(X1,Y1,X3,Y3,X2,Y2).LE.0.0D0) THEN
IF (VPDT3(X1,Y1,X3,Y3,X0,Y0).LE.0.0D0) THEN
IF (VPDT3(X1,Y1,X3,Y3,X2,Y2).LE.0.0D0) THEN
IF ((SPDT(X1,Y1,X0,Y0,X2,Y2).LE.0.0D0) .AND.
+ (SPDT(X3,Y3,X0,Y0,X2,Y2).LE.0.0D0)) THEN
KTLI(IIP) = 3
......@@ -1949,7 +1974,7 @@ c WRITE (*,FMT=9010)
GO TO 40
END IF
END IF
IF (VPDT(X1,Y1,X3,Y3,X2,Y2).GE.0.0D0) THEN
IF (VPDT3(X1,Y1,X3,Y3,X2,Y2).GE.0.0D0) THEN
IF ((SPDT(X1,Y1,X0,Y0,X2,Y2).GE.0.0D0) .AND.
+ (SPDT(X3,Y3,X0,Y0,X2,Y2).GE.0.0D0)) THEN
KTLI(IIP) = 4
......@@ -1967,7 +1992,7 @@ c WRITE (*,FMT=9010)
Y2 = YD(IP2)
X3 = XD(IP3)
Y3 = YD(IP3)
IF (VPDT(X2,Y2,X3,Y3,X0,Y0).LE.0.0D0) THEN
IF (VPDT3(X2,Y2,X3,Y3,X0,Y0).LE.0.0D0) THEN
IF ((SPDT(X3,Y3,X0,Y0,X2,Y2).GE.0.0D0) .AND.
+ (SPDT(X2,Y2,X0,Y0,X3,Y3).GE.0.0D0)) THEN
KTLI(IIP) = 2
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment