PROGRAM rg
DIM r(32,32)
LIBRARY "csgraphics"
CALL initial(r(,),L,b,#1,#2,#3,#4)
CALL configuration(r(,),L,b,#1,#2,#3,#4)
END

SUB initial(r(,),L,b,#1,#2,#3,#4)
    RANDOMIZE
    LET L = 32
    ! program must be modified for b <> 2
    LET b = 2
    ! assign random number to each site
    FOR y = 1 to L
        FOR x = 1 to L
            LET r(x,y) = rnd
        NEXT x
    NEXT y
    OPEN #1: screen 0,0.5,0.5,1
    CALL lattice(L)               ! draw original lattice in window #1
    OPEN #2: screen 0.5,1,0.5,1
    CALL lattice(L/b)
    OPEN #3: screen 0,0.5,0,0.5
    CALL lattice(L/(b*b))
    OPEN #4: screen 0.5,1,0,0.5
    CALL lattice(L/(b*b*b))
END SUB

SUB lattice(Ln)
    CALL compute_aspect_ratio(Ln,xwin,ywin)
    SET WINDOW -0.07*xwin,1.07*xwin,-0.07*ywin,1.07*ywin
    BOX LINES 0,Ln,0,Ln
    SET CURSOR 1,1
    PRINT "L ="; Ln
    FOR y = 1 to Ln
        FOR x = 1 to Ln
            PLOT POINTS: x - 0.5,y - 0.5
        NEXT x
    NEXT y
END SUB

SUB configuration(r(,),L,b,#1,#2,#3,#4)
    DIM s(32,32),s1(16,16),s2(8,8),s3(4,4)
    DO while p <=1
       WINDOW #1
       SET COLOR "black"
       SET CURSOR 1,14
       PRINT "     "              ! erase previous value of p
       SET CURSOR 1,10
       INPUT prompt "p = ": p
       SET COLOR "red"
       FOR y = 1 to L
           FOR x = 1 to L
               IF r(x,y) <= p then
                  BOX AREA x - 1, x, y - 1,y
                  LET s(x,y) = 1
               END IF
           NEXT x
       NEXT y
       CALL block(#2,L/b,s(,),s1(,))
       CALL block(#3,L/(b*b),s1(,),s2(,))
       CALL block(#4,L/(b*b*b),s2(,),s3(,))
    LOOP
END SUB

SUB block(#9,Ln,w(,),wr(,))
    WINDOW #9
    SET COLOR "red"
    FOR y = 1 to Ln
        LET yc = 2*y - 1
        FOR x = 1 to Ln
            LET xc = 2*x - 1
            ! cell spans vertically -> renormalized site occupied
            IF w(xc,yc)*w(xc,yc+1)=1 or w(xc+1,yc)*w(xc+1,yc+1)=1 then
               LET wr(x,y) = 1
               BOX AREA x - 1, x, y - 1,y
            END IF
        NEXT x
    NEXT y
END SUB