PROGRAM iterate_map * iterate logistic map IMPLICIT NONE REAL*8 r, x INTEGER IR_ CHARACTER*80 flag LOGICAL Ltmp1_ CALL GWopen(IR_, 0) CALL set_up_windows Ltmp1_ = .TRUE. DO WHILE(Ltmp1_) CALL initial(x,r,flag) CALL map(x,r,flag) Ltmp1_ = flag .NE. 'stop' END DO CALL GWquit(IR_) END C SUBROUTINE initial(x0,r,flag) IMPLICIT NONE REAL*8 x0, r INTEGER IR_ CHARACTER*80 flag, Stmp1_ CALL GWinput(IR_, 'growth parameter (0 < r <= 1) = ', Stmp1_) IF(IR_ .NE. 0) THEN READ(Stmp1_,*) r x0 = 0.3D0 CALL GWclear(IR_, -1) CALL GWrect(IR_, 0.0, 0.0, 1000.0, 1.0) WRITE(Stmp1_,*) 'r =', r CALL GWputtxt(IR_, 10.0, 0.95, Stmp1_) flag = '' ELSE flag = 'stop' ENDIF END C SUBROUTINE set_up_windows IMPLICIT NONE REAL*8 margin, nmax INTEGER IR_ nmax = 1000 margin = 0.01D0*nmax CALL GWindow(IR_, REAL(-margin), -0.01, REAL(nmax+margin), 1.01) END C SUBROUTINE map(x,r,flag) IMPLICIT NONE REAL*8 x, r INTEGER IR_, iterations CHARACTER*80 flag LOGICAL Ltmp1_, TBkeyinput iterations = 0 Ltmp1_ = .TRUE. DO WHILE(Ltmp1_) x = 4*r*x*(1 - x) ! iterate map iterations = iterations + 1 ! number of iterations WRITE(*, '(1X,F8.6,$)') x * period doubling implies convenient to start new line * every 2^n iterations, where n = 2 or 3. IF(mod(iterations,8) .EQ. 0) WRITE(*,*) ! new line CALL GWsetpxl(IR_, REAL(mod(iterations,1000)), REAL(x), 13) IF(TBkeyinput()) CALL change(flag) Ltmp1_ = flag .NE. 'stop' .AND. flag .NE. 'change' END DO WRITE(*,*) WRITE(*,*) 'number of iterations = ', iterations END C SUBROUTINE change(flag) IMPLICIT NONE INTEGER k CHARACTER*80 flag CALL TBgetkey(k) IF((k .EQ. ICHAR('c')) .OR. (k .EQ. ICHAR('C'))) THEN flag = 'change' ELSE IF((k .EQ. ICHAR('s')) .OR. (k .EQ. ICHAR('S'))) THEN flag = 'stop' END IF END