https://github.com/cran/Hmisc
Tip revision: abaf1cec1ebc1a1938dffcc10c0e4249b8a18603 authored by Frank E Harrell Jr on 16 October 2003, 00:00:00 UTC
version 2.0-4
version 2.0-4
Tip revision: abaf1ce
largrec.f
SUBROUTINE largrec(x, y, n, xlim, ylim, width, height,
& numbins, itype, rx, ry)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 x(*),y(*),xlim(2),ylim(2),rx(2),ry(2)
INTEGER*4 numbins,itype
C
xd = xlim(2)-xlim(1)
yd = ylim(2)-ylim(1)
xinc = xd/DFLOAT(numbins)
yinc = yd/DFLOAT(numbins)
x1 = 1d30
x2 = 1d30
y1 = 1d30
y2 = 1d30
IF(width .GE. xd .OR. height .GE. yd) THEN
rx(1) = 1d30
rx(2) = 1d30
ry(1) = 1d30
ry(2) = 1d30
RETURN
ENDIF
C
w = 0d0
h = 0d0
area = 0d0
C
DO xl=xlim(1),xlim(2)-width,xinc
DO yl=ylim(1),ylim(2)-height,yinc
DO xr=xl+width,xlim(2),xinc
DO yu=yl+height,ylim(2),yinc
DO i=1,n
IF(x(i) .GE. xl .AND. x(i) .LE. xr .AND.
& y(i) .GE. yl .AND. y(i) .LE. yu) GO TO 1
ENDDO
ar = (yu-yl)*(xr-xl)
if((itype.EQ.1 .AND. ar .GT. area) .OR.
& (itype.EQ.2 .AND. yu-yl .GE. h .AND.
& xr-xl .GE. w)) THEN
area = ar
w = xr - xl
h = yu - yl
x1 = xl
x2 = xr
y1 = yl
y2 = yu
ENDIF
ENDDO
ENDDO
1 CONTINUE
ENDDO
ENDDO
rx(1)=x1
rx(2)=x2
ry(1)=y1
ry(2)=y2
RETURN
END