44 lines
977 B
Fortran
44 lines
977 B
Fortran
!-------------------------------------------------------------------
|
|
!-
|
|
|
|
program chkpixels
|
|
|
|
use spitpgm ! main module
|
|
use trials ! experiments, ymmv.
|
|
|
|
implicit none
|
|
|
|
write(0, *) "------ CHKPIXELS ------"
|
|
call test_alpha(3)
|
|
|
|
STOP 'BECAUSE NO CPU AVAILABLE'
|
|
|
|
contains
|
|
!-------------------------------------------------------------------
|
|
!-
|
|
subroutine test_alpha(increment)
|
|
integer, intent(in) :: increment
|
|
|
|
integer, parameter :: SZ = 40
|
|
integer, dimension(SZ, SZ) :: greymap
|
|
integer :: ix, iy, value
|
|
|
|
value = 0
|
|
do iy=1, SZ
|
|
do ix=1, SZ
|
|
greymap(ix, iy) = value
|
|
value = value + increment
|
|
enddo
|
|
enddo
|
|
|
|
call spit_as_pgm_16 (greymap, 'a.pgm')
|
|
call spit_as_pgm_eq (greymap, 'b.pgm')
|
|
call spit_as_pgm_8 (greymap, 'c.pgm')
|
|
call new_spit_a (greymap, 'x.pgm')
|
|
|
|
end subroutine
|
|
|
|
end program
|
|
|
|
!-------------------------------------------------------------------
|