************************************************************************ * Demonstrates some 'format' statements suitable for generating * many columns of full-precision real*8 and/or integer values. ************************************************************************ program demoformat implicit none integer iargc, i4arg, roll real*8 drand48, r8arg integer ncol, nrow, opt integer maxncol parameter ( maxncol = 128 ) real*8 rnum(maxncol) integer inum(maxncol) integer icol, irow if( iargc() .lt. 2 ) go to 900 ncol = i4arg(1,-1) nrow = i4arg(2,-1) opt = i4arg(3,0) if( ncol .lt. 1 .or. ncol .gt. maxncol .or. & nrow .lt. 1 .or. & opt .lt. 0 .or. opt .gt. 2 ) go to 900 write(0,*) 'demoformat: Will dump ', nrow, ' rows of ', ncol, & ' columns' call srand48(0) if( opt .eq. 0 ) then write(0,*) 'demoformat: Dumping real*8 values' do irow = 1 , nrow do icol = 1 , ncol rnum(icol) = -1.0d0 + 2.0d0 * drand48() end do *----------------------------------------------------------------------- * Output row using a 'generic' format stmt good for up to c 128 real*8s per line *----------------------------------------------------------------------- write(*,100) (rnum(icol) , icol = 1 , ncol) 100 format(1P,128E25.16,0P) end do else if( opt .eq. 1 ) then write(0,*) 'demoformat: Dumping integer values' do irow = 1 , nrow do icol = 1 , ncol inum(icol) = 2.0d0**31 * (-1.0d0 + 2.0d0 * drand48()) end do *----------------------------------------------------------------------- * Output row using a 'generic' format stmt good for up to * 128 integers per line *----------------------------------------------------------------------- write(*,200) (inum(icol) , icol = 1 , ncol) 200 format(128I12) end do else if( opt .eq. 2 ) then write(0,*) 'demoformat: Dumping real*8/integer values' do irow = 1 , nrow do icol = 1 , ncol rnum(icol) = -1.0d0 + 2.0d0 * drand48() inum(icol) = 2.0d0**31 * (-1.0d0 + 2.0d0 * drand48()) end do *----------------------------------------------------------------------- * Output row using a 'generic' format stmt good for up to * 128 real*8/integer alternating pairs per line *----------------------------------------------------------------------- write(*,300) (rnum(icol), inum(icol) , icol = 1 , ncol) 300 format(1P,128(E25.16,I12),0P) end do else write(0,*) 'demoformat: Unexpected value of opt = ', opt go to 900 end if stop 900 continue write(0,*) 'usage: demoformat []' write(0,*) write(0,*) ' -> Number of columns of numbers '// & 'printed (maximum 128)' write(0,*) ' -> Number of rows of numbers printed' write(0,*) write(0,*) ' = 0 -> '// & 'Generate/print random real*8 values (default)' write(0,*) ' = 1 -> '// & 'Generate/print random integer values' write(0,*) ' = 2 -> '// & 'Generate/print random real*8/integer values (interleaved)' stop end ************************************************************************ * Returns uniformly distributed random integer chosen * from 1 to n. ************************************************************************ integer function roll(n) implicit none real*8 drand48 integer n roll = min(n,1 + int(n * drand48())) return end