! Sand pile: 2 dim ! treshold condition ! ! simple rule; 4 neighbors ! ! Peter Stefan Hammerstein !------------------------------------------------------------------- ! program 2d4 implicit none include 'pict_subs.h' integer, parameter:: Nx = 40 integer, parameter:: Ny = 40 integer, dimension(Nx, Ny):: pile, add integer threshold integer nr_random_edge, nr_random_rest integer, dimension(1):: rand_edge, rand_x, rand_y integer,parameter:: rnx = 4 integer,parameter:: rny = 4 integer nxp, nyp integer display real neutral, more real, dimension(Nx, Ny):: image integer step, step_end, height, next integer i, j, k logical rule, log1, log2 character decide cmf$ layout pile(:news,:news) cmf$ layout add(:news,:news) cmf$ layout image(:news, :news) write(*,*)' D I S P L A Y A N D F I L E V E R S I O N ' 8 write(*,*)'? WISH TO READ SINGLE PILE-ARRAYS TO FILE ? :' read(*,*) decide log1 = .false. if (decide.eq.'y') log1 = .true. write(*,*)'? WISH TO READ PILE-EVOLUTION TO FILE ? :' read(*,*) decide log2 = .false. if (decide.eq.'y') then open(unit=20,file='evolut.dat', status='unknown') log2 =.true. end if nxp = rnx * Nx nyp = rny * Ny call FSR_select_display_menu(depth,nxp,nyp) call FSR_set_display_color_map("density") display = FSR_allocate_image_buffer(depth,nxp, nyp,.TRUE.) call cmf_randomize(1) ! initialize random number generator pile = 0 step = 0 rule = .false. write(*,*)'---------------------------------------------------' write(*,*)'SYSTEM: sand leaves at one edge; forcing and noise' write(*,*)'---------------------------------------------------' write(*,*)'? RULE: INCLUDING CORNERS (8 NEIGHBOURS) ? (y):' read(*,*) decide if (decide.eq.'y') rule = .true. write(*,*)'? HOW MANY FILLS PER ITERATION ON EDGE ?' read(*,*) nr_random_edge write(*,*)'? HOW MANY FILLS PER ITERATION ON REST ?' read(*,*) nr_random_rest write(*,*)'! ENTER THRESHOLD ( >4 ) !' read(*,*) threshold write(*,*) '? INITIAL PILE: ALL AT Y=1 OR TABLE ATTRACTOR ?' read(*,*) decide c write(*,*)'Y O U W I L L W A T C H A V A L A N C H E S :' c write(*,*)'! ENTER COLOUR FOR BACKGROUND (BLUE = 0.0) !' c read(*,*) neutral c write(*,*)'! ENTER COLOUR FOR ADDED SAND (RED = 1.0) !' c read(*,*) more neutral = 0.5 more = 1.0 C____SET INITIAL PILE:________________________________________________ c__STABLE ATTRACTOR:________________________________ if (decide.eq.'s'.or.decide.eq.'S') then forall(j=1:Ny) pile(:,j) = (Ny - j + 1) * threshold end if C__WALL AT ROW Y = 1_________________________________ if (decide.eq.'w'.or.decide.eq.'W') then write(*,*) '! ENTER HEIGHT OF WALL !:' read(*,*) height forall(i=1:Nx) pile(i,1) = height end if write(*,*)'? how many steps till first questionary ?' read(*,*) next c_____DISPLAY INITIAL PILE AND WRITE TO FILE IF REQUIRED:_______ forall(i=1:Nx, j=1:Ny) image(i,j) = pile(i,j) / real(Nx*threshold) call display_rescaled_image(Nx,Ny,nxp,nyp,image,display) write(*,*)'? PILE TO FILE ''pile.dat'' ? ' read(*,*) decide if (decide.eq.'y') then open(unit=10,file='pile.dat',status='unknown') do i = 1, Nx do j = 1, Ny write(10,*) i, j, pile(i,j) end do end do close(10) end if c_______M A I N P A R T____________________________________ write(*,*)'START' read(*,*) do while(step.le.step+1) step = step + 1 if (log2) then do i = 1, Nx do j = 1, Ny write(20,*) step, i, j, pile(i,j) end do end do end if image = neutral ! set whole display array to neutral colour c______IN ROW Y = 1 (nr_random_edge) RANDOM X-PLACES ARE INCREASED WITH 1 : c___SHOULD CORRESPOND TO "FORCING"_________________________________________ do i=1,nr_random_edge call cmf_random(rand_edge,Nx) ! rand_edge = one random number ! in the range 0..( Nx- 1 ) pile(rand_edge + 1, 1) = pile(rand_edge + 1,1) + 1 image(rand_edge + 1, 1) = 0.05 end do C______IN REST OF ARRAY (nr_random_rest) RANDOM PLACES ARE INCREASED WITH 1: c___SHOULD CORRESPOND TO "NOISE"____________________________________________ do i=1,nr_random_rest call cmf_random(rand_x,Nx) call cmf_random(rand_y,Ny-1) pile(rand_x+1,rand_y+2) = pile(rand_x+1,rand_y+2) + 1 image(rand_x + 1, rand_y + 2) = 0.05 end do c____RULE:______________________________________________ c___________NOTE: LOWER IS UPPER IN DISPLAY AND VV !!!_________________ add = 0 c__left: where (pile - eoshift(pile,1,-1,pile(1,:)).gt.threshold) & add = add - 1 where (eoshift(pile,1,+1) - pile.gt.threshold) add = add + 1 image = more end where c__right: where (pile - eoshift(pile,1,+1,pile(Nx,:)).gt.threshold) & add = add - 1 where (eoshift(pile,1,-1) - pile.gt.threshold) add = add + 1 image = more end where c__lower: where (pile - eoshift(pile,2,-1,pile(:,1)).gt.threshold) & add = add - 1 where (eoshift(pile,2,+1) - pile.gt.threshold) add = add + 1 image = more end where c__upper !!! SAND CAN LEAVE HERE !!!: where (pile - eoshift(pile,2,+1).gt.threshold) add = add - 1 where (eoshift(pile,2,-1) - pile.gt.threshold) add = add + 1 image = more end where c_____INCLUDING CORNERS AS REQUIRED:_________________________ if (rule) then c__left lower: where (pile-eoshift(eoshift(pile,1,-1,pile(1,:)),2,-1,pile(:,1)) & .gt.threshold) add = add - 1 where (eoshift(eoshift(pile,1,+1),2,+1) - pile.gt.threshold) add = add + 1 image = more end where c__right lower: where (pile-eoshift(eoshift(pile,1,+1,pile(Nx,:)),2,-1,pile(:,1)) & .gt.threshold) add = add - 1 where (eoshift(eoshift(pile,1,-1),2,+1) - pile.gt.threshold) add = add + 1 image = more end where c__left upper !!! SAND CAN LEAVE HERE !!!: where (pile - eoshift(eoshift(pile,1,-1,pile(1,:)),2,+1) & .gt.threshold) add = add - 1 where (eoshift(eoshift(pile,1,+1),2,-1) - pile.gt.threshold) add = add + 1 image = more end where c__right upper !!! SAND CAN LEAVE HERE !!!: where (pile - eoshift(eoshift(pile,1,+1,pile(Nx,:)),2,+1) & .gt.threshold) add = add - 1 where (eoshift(eoshift(pile,1,-1),2,-1) - pile.gt.threshold) add = add + 1 image = more end where end if pile = pile + add C_____DISPLAY AVALANCHES:___________________ c forall(i=1:Nx, j=1:Ny) image(i,j) = pile(i,j)/real(Nx*threshold) call display_rescaled_image(Nx,Ny,nxp,nyp,image,display) c____RUN TIME CONTROL AND WRITE PILE TO FILE:_________________________ if (mod(step,10).eq.0) write(*,*) step if (mod(step + next, next).eq.0) then if(log1) then write(*,*)'? THIS PILE TO FILE ''pile.dat'' ? :' read(*,*) decide if (decide.eq.'y') then open(unit=10,file='pile.dat',status='unknown') do i = 1, Nx do j = 1, Ny write(10,*) i, j, pile(i,j) end do end do close(10) end if write(*,*)' O . K . ...done !' end if end if if (mod(step, next).eq.0) then write(*,*)'? ANOTHER NUMBER OF ILLS / ITERATION ? ' write(*,*)'NOTHER GAME ?' write(*,*)'EAVE ?' WRITE(*,*)'CONTINUE ? (any other letter) :' read(*,*) decide if (decide.eq.'a') close(10) if (decide.eq.'a') goto 8 if (decide.eq.'l') goto 80 if (decide.eq.'f') then write(*,*) 'HOW MANY FOR EDGE ?' read(*,*) nr_random_edge write(*,*) 'HOW MANY FOR REST ?' read(*,*) nr_random_rest end if write(*,*)'? NEXT QUESTIONARY AFTER HOW MANY STEPS ?' read(*,*) next end if end do 80 close(10) stop end !________________________________________________________________________