WNMF/read.f90 at master · gimmy/WNMF · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
MODULE Readmodule
IMPLICIT NONE
CONTAINS
  SUBROUTINE read ( file_name, g, nrow, ncol, maxg )
    ! Legge un file pgm (ascii) in input
    ! - per test su singolo file
    IMPLICIT NONE

    CHARACTER ( len = 80 ) :: file_name
    INTEGER ( kind = 4 ) file_unit
    INTEGER ( kind = 4 ), allocatable, dimension ( :, : ) :: g
    INTEGER ( kind = 4 ) ierror
    INTEGER ( kind = 4 ) ios
    INTEGER :: maxg

    INTEGER nrow, ncol

    WRITE ( *, '(a)' ) ' '
    WRITE ( *, '(a)' ) '  PGMA_READ reads an ASCII PGM file.'

    CALL get_unit ( file_unit )

    OPEN ( unit = file_unit, file = file_name, status = 'old', iostat = ios )

    IF ( ios /= 0 ) THEN
       WRITE ( *, '(a)' ) ' '
       WRITE ( *, '(a)' ) 'TEST02 - Fatal error!'
       WRITE ( *, '(a)' ) '  Could not open the file.'
       return
    END IF

    CALL pgma_read_header ( file_unit, nrow, ncol, maxg )

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  PGMA_READ_HEADER read the header.'
    write ( *, '(a)' ) ' '
    write ( *, '(a,i8)' ) '  Number of rows of data =    ', nrow
    write ( *, '(a,i8)' ) '  Number of columns of data = ', ncol
    WRITE ( *, '(a,i8)' ) '  Maximum G value =           ', maxg

    ALLOCATE ( g(nrow,ncol) )

    CALL pgma_read_data ( file_unit, nrow, ncol, g )


    RETURN

  END SUBROUTINE read
END MODULE Readmodule

PROGRAM test
  USE Readmodule

  IMPLICIT NONE

  INTEGER row, col, max
  INTEGER :: rank = 15
  INTEGER i, j
  INTEGER, ALLOCATABLE, DIMENSION (:,:) :: A

  REAL(KIND(0.d0)), ALLOCATABLE, DIMENSION(:,:) :: localW, UV
  INTEGER, parameter :: sigma = 30, maxiter = 80
  REAL (KIND(0.d0)) d, maxUV

  CHARACTER ( len = 80 ) filename
  ! INTEGER (kind = 4) ierror

  filename = 'img.pgm'          ! Must be ASCII image

  CALL read ( filename, A, row, col, max )

  filename = 'A.pgm'
  CALL simpleprint(A,row,col, filename)

  ! Avanti tutta !

  WRITE ( *, '(a)' ) ' '

  ! Creo la matrice dei pesi
  WRITE ( *, '(a)', advance='no' ) '  Creo matrice dei pesi..'
  ALLOCATE ( localW(row,col) )
  DO i = 1, row
     DO j = 1, col
        d = (i-56.5)**2  + (j-46.5)**2    ! distanza^2 dal centro
        localW(i,j) = exp(-d/(sigma**2))
     END DO
  END DO

  ALLOCATE ( UV(row,col) )

  WRITE ( *, '(a)', advance='no' ) '  Factor... '
  CALL factor (A, localW, row,col,rank,UV,maxUV,maxiter)
  WRITE ( *, '(a)' ) ' '
  WRITE ( *, '(a)' ) '  Fattorizzazione fatta.'

  filename = 'UV.pgm'
  CALL simpleprint (UV,row,col,filename)

  ! Fattorizzazione senza pesi
  WRITE(*,*) 'Fattorizzazione non pesata'
  ! Creo la matrice dei pesi
  WRITE ( *, '(a)', advance='no' ) '  Creo matrice dei pesi..'
  DO i = 1, row
     DO j = 1, col
        localW(i,j) = 1
     END DO
  END DO

  WRITE ( *, '(a)', advance='no' ) '  Factor... '
  CALL factor (A, localW, row,col,rank,UV,maxUV,maxiter)
  WRITE ( *, '(a)' ) ' '
  WRITE ( *, '(a)' ) '  Fattorizzazione fatta.'

  filename = 'UV_noW.pgm'
  CALL simpleprint (UV,row,col,filename)

  DEALLOCATE ( A )
  DEALLOCATE ( UV )
  DEALLOCATE ( localW )

END PROGRAM test