diff options
Diffstat (limited to 'sys/gio/ncarutil/conlib/concom.f')
| -rw-r--r-- | sys/gio/ncarutil/conlib/concom.f | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/conlib/concom.f b/sys/gio/ncarutil/conlib/concom.f new file mode 100644 index 00000000..8a5041df --- /dev/null +++ b/sys/gio/ncarutil/conlib/concom.f @@ -0,0 +1,78 @@ + FUNCTION CONCOM (XQ,YQ,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 INTERPOLATE A GIVEN X,Y PAIR AND RETURN ITS LOCATION +C +C +C + COMMON /CONRA1/ CL(30) ,NCL ,OLDZ ,PV(210) , + 1 FINC ,HI ,FLO + COMMON /CONRA2/ REPEAT ,EXTRAP ,PER ,MESS , + 1 ISCALE ,LOOK ,PLDVLS ,GRD , + 2 CINC ,CHILO ,CON ,LABON , + 3 PMIMX ,SCALE ,FRADV ,EXTRI , + 4 BPSIZ ,LISTOP + COMMON /CONRA3/ IREC + COMMON /CONRA4/ NCP ,NCPSZ + COMMON /CONRA5/ NIT ,ITIPV + COMMON /CONRA6/ XST ,YST ,XED ,YED , + 1 STPSZ ,IGRAD ,IG ,XRG , + 2 YRG ,BORD ,PXST ,PYST , + 3 PXED ,PYED ,ITICK + COMMON /CONRA7/ TITLE ,ICNT ,ITLSIZ + COMMON /CONRA8/ IHIGH ,INMAJ ,INLAB ,INDAT , + 1 LEN ,IFMT ,LEND , + 2 IFMTD ,ISIZEP ,INMIN + COMMON /CONRA9/ ICOORD(500), NP ,MXXY ,TR , + 1 BR ,TL ,BL ,CONV , + 2 XN ,YN ,ITLL ,IBLL , + 3 ITRL ,IBRL ,XC ,YC , + 4 ITLOC(210) ,JX ,JY ,ILOC , + 5 ISHFCT ,XO ,YO ,IOC ,NC + COMMON /CONR10/ NT ,NL ,NTNL ,JWIPT , + 1 JWIWL ,JWIWP ,JWIPL ,IPR , + 2 ITPV + COMMON /CONR11/ NREP ,NCRT ,ISIZEL , + 1 MINGAP ,ISIZEM , + 2 TENS + COMMON /CONR12/ IXMAX ,IYMAX ,XMAX ,YMAX + LOGICAL REPEAT ,EXTRAP ,PER ,MESS , + 1 LOOK ,PLDVLS ,GRD ,LABON , + 2 PMIMX ,FRADV ,EXTRI ,CINC , + 3 TITLE ,LISTOP ,CHILO ,CON + COMMON /CONR15/ ISTRNG + CHARACTER*64 ISTRNG + COMMON /CONR16/ FORM + CHARACTER*10 FORM + COMMON /CONR17/ NDASH, IDASH, EDASH + CHARACTER*10 NDASH, IDASH, EDASH +C +C + DIMENSION XD(1) ,YD(1) ,ZD(1) ,WK(1) , + 1 IWK(1) +C + SAVE +C +C LOCATE PROPER TRIANGLE +C + CALL CONLOC (NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),XQ,YQ,LOC, + 1 IWK(JWIWL),WK) +C +C INTERPOLATE THE LOCATION +C + CALL CONCAL (XD,YD,ZD,NT,IWK(JWIPT),NL,IWK(JWIPL),WK(IPR),LOC,XQ, + 1 YQ,TEMP,ITPV) + CONCOM = TEMP + RETURN + END |