WNMF/createV.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
SUBROUTINE createV(A,U,V, row, rank, col)
  ! Calcolo la matrice V
  INTEGER row, col, rank
  INTEGER (kind = 4), DIMENSION(row,col) :: A
  REAL, DIMENSION(row,rank) :: U
  REAL, DIMENSION(rank,col) :: V
  INTEGER i, j

  REAL, DIMENSION(rank,col) :: Va
  REAL, DIMENSION(rank,rank) :: Uk, invUk
  REAL, DIMENSION(rank) :: y
  REAL maxV

  ! Salvo la sottomatrice U_k
  DO i = 1, rank
     DO j = 1, rank
        Uk(i,j) = U(i,j)
     END DO
  END DO

  CALL FINDinv(Uk,invUk, rank, error)
  ! invUk = inv(Uk)
  ! CALL inv(Uk,invUk)
  ! WRITE(*,*) 'inversa di Uk calcolata'

  ! ! Controllo NonNegatività di invUk
  ! DO i = 1, rank
  !    DO j = 1, rank
  !       IF ( invUk(i,j) <= 0 ) THEN
  !          STOP 'trovato elemento <= 0 in invUk'
  !       ENDIF
  !    END DO
  ! END DO

  DO j=1,col
     ! Calcolo y
     DO i=1,rank
        y(i) = A(i,j)
     ENDDO
     ! WRITE(*,*) 'MATMUL...'
     ! WRITE(*,*) SHAPE(V(:,j)), SHAPE(invUk), SHAPE(y)
     V(:,j)= MATMUL(invUk, y)
  END DO

  ! Controllo NonNegatività di V
  maxV = 0
  k = 0
  DO i = 1, rank
     DO j = 1, col
        IF ( V(i,j) < 0 ) THEN
           ! STOP 'trovato elemento < 0 in V'
           ! write(*,*) 'trovato elemento < 0 in V, lo metto a 0'
           V(i,j) = 0
        ELSE
           IF ( maxV < V(i,j) ) then
              maxV = V(i,j)
           ENDIF
           k = k+1
        ENDIF
     END DO
  END DO

  write(*,'(A,I5,A,I5)', advance='no') ' in V ',k,' elementi > 0 su ',rank*col
  write(*,'(A,F6.2)', advance='no') ' - max in V: ', maxV

END SUBROUTINE createV