      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
