From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/gio/ncarutil/conlib/conlcm.f | 65 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) create mode 100644 sys/gio/ncarutil/conlib/conlcm.f (limited to 'sys/gio/ncarutil/conlib/conlcm.f') diff --git a/sys/gio/ncarutil/conlib/conlcm.f b/sys/gio/ncarutil/conlib/conlcm.f new file mode 100644 index 00000000..80791d49 --- /dev/null +++ b/sys/gio/ncarutil/conlib/conlcm.f @@ -0,0 +1,65 @@ + FUNCTION CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,LOC) +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C +C COMPUTE A Z VALUE FOR A GIVEN X,Y VALUE +C NOTE THAT X,Y MUST BE INSIDE THE CONVEX HULL OF THE INPUT DATA +C INORDER FOR THIS FUNCTION TO WORK. +C +C INPUT +C X-X COORDINATE OF REQUESTED POINT +C Y-Y COORDINATE OF REQUESTED POINT +C WK-LIST OF COEFICENTS FOR LINEAR INTERPOLATION FUNCTIONS +C LOCATED BY A = WK((TRI-1)*3+1) +C B = WK((TRI-2)*3+1) +C C = WK((TRI-3)*3+1) +C +C OUTPUT +C LOC-TRIANGLE NUMBER OF REQUESTED POINT +C Z VALUE AS FUNCTION RESULT +C + DIMENSION WK(1),IWK(1),XD(1),YD(1),ZD(1) +C + COMMON /CONR10/ NT ,NL ,NTNL ,JWIPT , + 1 JWIWL ,JWIWP ,JWIPL ,IPR , + 2 ITPV +C + SAVE +C +C LOCATE THE TRIANGLE +C + CALL CONLOC(NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),X,Y,LOC, + 1 IWK(JWIWL),WK) +C +C IF OUTSIDE CONVEX HULL THEN DON'T COMPUTE A VALUE +C + IF (LOC.GT.NT) RETURN +C +C GET THE VECTOR 1 VALUES FOR THE TRIANGLE +C + IVEC = (LOC-1)*3 + JWIPT + IV = IWK(IVEC) + X1 = X - XD(IV) + Y1 = Y - YD(IV) + Z1 = ZD(IV) +C +C COMPUT THE Z VALUE +C + IPOINT = (LOC-1)*3 + IPR +C + Z = (WK(IPOINT)*X1+WK(IPOINT+1)*Y1)/WK(IPOINT+2) + Z1 +C + CONLCM = Z +C + RETURN + END -- cgit