calculate_u_matrix Subroutine

public subroutine calculate_u_matrix(kohonen_map)

Subroutine to calculate the u_matrix

Type Bound

two_level_self_organizing_map

Arguments

Type IntentOptional Attributes Name
class(two_level_self_organizing_map) :: kohonen_map

A two_level_self_organizing_map object


Calls

proc~~calculate_u_matrix~2~~CallsGraph proc~calculate_u_matrix~2 two_level_self_organizing_map%calculate_u_matrix none~distance~8 kohonen_prototype%distance proc~calculate_u_matrix~2->none~distance~8 calculate calculate none~distance~8->calculate none~get_prototype kohonen_prototype%get_prototype none~distance~8->none~get_prototype

Called by

proc~~calculate_u_matrix~2~~CalledByGraph proc~calculate_u_matrix~2 two_level_self_organizing_map%calculate_u_matrix proc~train_grid_layer two_level_self_organizing_map%train_grid_layer proc~train_grid_layer->proc~calculate_u_matrix~2 proc~train_2lsom two_level_self_organizing_map%train_2lsom proc~train_2lsom->proc~train_grid_layer proc~train_two_level_som train_two_level_som proc~train_two_level_som->proc~train_2lsom

Variables

Type Visibility Attributes Name Initial
character(len=50), public :: type_
integer, public :: nx
integer, public :: ny
integer, public :: nz
integer, public :: nt
integer, public :: ierr
integer, public :: ix
integer, public :: iy
integer, public :: iz
integer, public :: cx
integer, public :: cy
integer, public :: cz
integer, public :: nxu
integer, public :: nyu
integer, public :: nzu
real(kind=wp), public :: dist
real(kind=wp), public :: u_temp
logical, public :: testop

Source Code

   subroutine calculate_u_matrix(kohonen_map)
   !========================================================================================
!!    Subroutine to calculate  the u_matrix
   class(two_level_self_organizing_map) :: kohonen_map
!! A `two_level_self_organizing_map` object 
   character(len=50) :: type_
   integer :: nx,ny,nz,nt,ierr,ix,iy,iz,cx,cy,cz,nxu,nyu,nzu
   real(kind=wp) :: dist,u_temp
   logical :: testop
   !
   type_=kohonen_map%parameters(1)%node_type;
   nx=kohonen_map%parameters(1)%number_nodes_nx;
   ny=kohonen_map%parameters(1)%number_nodes_ny;
   nz=kohonen_map%parameters(1)%number_nodes_nz;
   !
   nxu=size(kohonen_map%u_matrix,1);
   nyu=size(kohonen_map%u_matrix,2);
   nzu=size(kohonen_map%u_matrix,3);
   
   !
   select case(trim(type_))
   ! 
      case('rectangular')
   !   
      do iz=1,size(kohonen_map%grid,3);
         do iy=1,size(kohonen_map%grid,2);
            do ix=1,size(kohonen_map%grid,1);
               ! horizontal
               if(ix<nx) then
                  cx=ix+1;cy=iy;cz=iz;               
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix,2*iy-1,2*iz-1)=dist;
               endif
               !vertical
               if(iy<ny) then
                  cx=ix;cy=iy+1;cz=iz;               
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix-1,2*iy,2*iz-1)=dist;              
               endif
               !
               if(iz<nz) then
                  cx=ix;cy=iy;cz=iz+1;               
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix-1,2*iy-1,2*iz-1)=dist;         
               endif
               ! Diagonal
               if(ix < nx .and. iy < ny) then
                  cx=ix+1;cy=iy+1;cz=iz;
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  cx=ix+1;cy=iy+1;cz=iz;
                  dist=dist+kohonen_map%grid(ix,cy,iz)%distance(kohonen_map%grid(cx,iy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix,2*iy,2*iz-1)=dist;         
               endif
            enddo
         enddo
      enddo
   !
      do iz=1,size(kohonen_map%u_matrix,3),2
         do iy=1,size(kohonen_map%u_matrix,2),2
            do ix=1,size(kohonen_map%u_matrix,1),2
                  u_temp=0.0_wp;
                  if(ix>1 .and. ix<size(kohonen_map%u_matrix,1) .and. & 
                     iy>1 .and. iy<size(kohonen_map%u_matrix,2)) then
                     u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix+1,iy,iz)+&
                              kohonen_map%u_matrix(ix,iy-1,iz)+kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=4;
                  elseif(iy==1 .and. ix>1 .and. ix<size(kohonen_map%u_matrix,1)) then
                     u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix+1,iy,iz)+&
                              kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=3;
                  elseif(iy==size(kohonen_map%u_matrix,2) .and. ix>1 .and.&
                        ix<size(kohonen_map%u_matrix,1)) then
                     u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix+1,iy,iz)+&
                              kohonen_map%u_matrix(ix,iy-1,iz);
                     nt=3;
                  elseif(ix==1 .and. iy>1 .and. iy<size(kohonen_map%u_matrix,2)) then
                     u_temp = kohonen_map%u_matrix(ix+1,iy,iz)+&
                              kohonen_map%u_matrix(ix,iy-1,iz)+kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=3;
                  elseif(ix==size(kohonen_map%u_matrix,1) .and. iy>1 .and. iy<size(kohonen_map%u_matrix,2)) then
                     u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+&
                              kohonen_map%u_matrix(ix,iy-1,iz)+kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=3;
                  elseif(ix==1 .and. iy==1) then
                     u_temp = kohonen_map%u_matrix(ix+1,iy,iz)+kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=2;
                  elseif( ix==size(kohonen_map%u_matrix,1) .and. iy==1) then
                     u_temp=kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix,iy+1,iz);
                     nt=2;
                  elseif(ix==1 .and. iy==size(kohonen_map%u_matrix,2)) then
                     u_temp=kohonen_map%u_matrix(ix+1,iy,iz)+kohonen_map%u_matrix(ix,iy-1,iz);
                     nt=2;
                  elseif( ix==size(kohonen_map%u_matrix,1) .and. iy==size(kohonen_map%u_matrix,2)) then
                     u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix,iy-1,iz);
                     nt=2;
                  else
                     u_temp = 0.0_wp;
                  endif
                  kohonen_map%u_matrix(ix,iy,iz)=u_temp/dble(nt);
            enddo
         enddo
      enddo   
   !
      case('hexagonal')
   !   
      do iz=1,size(kohonen_map%grid,3);
         do iy=1,size(kohonen_map%grid,2);
            do ix=1,size(kohonen_map%grid,1);
               if(ix < nx) then !horizontal
                  cx=ix+1;cy=iy;cz=iz;               
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix,2*iy-1,2*iz-1)=dist;
               endif
               !
               if(iy < ny) then !diagonals
                  cx=ix;cy=iy+1;cz=iz;               
                  dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                  kohonen_map%u_matrix(2*ix-1,2*iy,2*iz-1)=dist;
                  if(mod(iy,2)==0 .and. ix < nx) then
                     cx=ix+1;cy=iy+1;cz=iz;
                     dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                     kohonen_map%u_matrix(2*ix,2*iy,2*iz-1)=dist;               
                  elseif(mod(iy,2)==1 .and. ix>1) then
                     cx=ix-1;cy=iy+1;cz=iz;
                     dist=kohonen_map%grid(ix,iy,iz)%distance(kohonen_map%grid(cx,cy,cz),&
                                    kohonen_map%distance_function);
                     kohonen_map%u_matrix(2*ix-2,2*iy,2*iz-1)=dist;
                  endif
               endif
            enddo
         enddo
      enddo
   !
   do iz=1,nzu,2;
      do iy=1,nyu,2;
         do ix=1,nxu,2;
            u_temp=0.0_wp;
            if(ix>1 .and. iy>1 .and. ix<nxu .and. iy<nyu ) then !middle part of the map
               u_temp = kohonen_map%u_matrix(ix-1,iy,iz) + kohonen_map%u_matrix(ix+1,iy,iz);
               if (mod(iy-1,4)==0) then
                  u_temp = u_temp +  kohonen_map%u_matrix(ix-1,iy-1,iz) + kohonen_map%u_matrix(ix,iy-1,iz) + &
                           kohonen_map%u_matrix(ix-1,iy+1,iz)+ kohonen_map%u_matrix(ix,iy+1,iz);                
               else 
                  u_temp = u_temp+ kohonen_map%u_matrix(ix,iy-1,iz)+ kohonen_map%u_matrix(ix+1,iy-1,iz) +&
                           kohonen_map%u_matrix(ix,iy+1,iz) +  kohonen_map%u_matrix(ix+1,iy+1,iz); 
               endif
               nt=6;
            elseif(iy==1 .and. ix>1 .and. ix<nxu ) then ! upper edge
               u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+kohonen_map%u_matrix(ix+1,iy,iz)+&
                        kohonen_map%u_matrix(ix-1,iy+1,iz) + kohonen_map%u_matrix(ix,iy+1,iz);
               nt=4;
            elseif(iy==nyu .and. ix>1 .and. ix<nxu) then ! lower edge
               u_temp = kohonen_map%u_matrix(ix-1,iy,iz)+ kohonen_map%u_matrix(ix+1,iy,iz);
               if (mod(iy-1,4)==0) then
                  u_temp = u_temp + kohonen_map%u_matrix(ix-1,iy-1,iz) + kohonen_map%u_matrix(ix,iy-1,iz);
               else 
                  u_temp = u_temp + kohonen_map%u_matrix(ix,iy-1,iz) + kohonen_map%u_matrix(ix+1,iy-1,iz); 
               endif
               nt=4;
            elseif( ix==1 .and. iy>1 .and. iy<nyu) then ! left edge
               u_temp = kohonen_map%u_matrix(ix+1,iy,iz);
               if(mod(iy-1,4)==0) then
                  u_temp = u_temp + kohonen_map%u_matrix(ix,iy-1,iz)+ kohonen_map%u_matrix(ix,iy+1,iz);
                  nt=3;
               else 
                  u_temp = u_temp + kohonen_map%u_matrix(ix,iy-1,iz) + kohonen_map%u_matrix(ix+1,iy-1,iz) +&
                           kohonen_map%u_matrix(ix,iy+1,iz) + kohonen_map%u_matrix(ix+1,iy+1,iz); 
                  nt=5;
               endif             
            elseif(ix==nxu .and. iy>1 .and. iy<nyu) then ! right edge
               u_temp = kohonen_map%u_matrix(ix-1,iy,iz);
               if (mod(iy-1,4)==0) then
                  u_temp= u_temp + kohonen_map%u_matrix(ix,iy-1,iz) + kohonen_map%u_matrix(ix-1,iy-1,iz) +&
                           kohonen_map%u_matrix(ix,iy+1,iz) + kohonen_map%u_matrix(ix-1,iy+1,iz);
                  nt=5;        
               else 
                  u_temp = u_temp + kohonen_map%u_matrix(ix,iy-1,iz) + kohonen_map%u_matrix(ix,iy+1,iz);
                  nt=3;
               endif
            elseif(ix==1 .and. iy==1) then ! top left corner
               u_temp = kohonen_map%u_matrix(ix+1,iy,iz) + kohonen_map%u_matrix(ix,iy+1,iz);
               nt=2;
            elseif(ix==nxu .and. iy==1) then ! top right corner
               u_temp = kohonen_map%u_matrix(ix-1,iy,iz) +  kohonen_map%u_matrix(ix-1,iy+1,iz) +&
                        kohonen_map%u_matrix(ix,iy+1,iz);
               nt=3;
            elseif(ix==1 .and. iy==nyu) then ! bottom left corner
               if (mod(iy-1,4)==0) then
                  u_temp = kohonen_map%u_matrix(ix+1,iy,iz) + kohonen_map%u_matrix(ix,iy-1,iz);
                  nt=2;
               else 
                  u_temp = kohonen_map%u_matrix(ix+1,iy,iz) + kohonen_map%u_matrix(ix,iy-1,iz) +&
                           kohonen_map%u_matrix(ix+1,iy-1,iz); 
                  nt=3;
               endif;
            elseif(ix==nxu .and. iy==nyu) then ! bottom right corner
               if (mod(iy-1,4)==0) then
                  u_temp = kohonen_map%u_matrix(ix-1,iy,iz) + kohonen_map%u_matrix(ix,iy-1,iz) +&
                           kohonen_map%u_matrix(ix-1,iy-1,iz);
                  nt=3;
               else 
                  u_temp = kohonen_map%u_matrix(ix-1,iy,iz) + kohonen_map%u_matrix(ix,iy-1,iz);
                  nt=2;
               endif           
            endif
            kohonen_map%u_matrix(ix,iy,iz)=u_temp/dble(nt);
         enddo
      enddo
   enddo
   ! 
   end select
   !
   inquire(unit=kohonen_map%parameters(1)%iumat,opened=testop);
   if(testop) then
      do iz=1,size(kohonen_map%u_matrix,3);
         write(kohonen_map%parameters(1)%iumat,'(A,I4)') 'Layer ',iz 
         do ix=1,size(kohonen_map%u_matrix,1);
            write(kohonen_map%parameters(1)%iumat,'(100f10.5)') (kohonen_map%u_matrix(ix,iy,iz),&
                  iy=1,size(kohonen_map%u_matrix,2));
         enddo
      enddo
   endif
   
   !
   end subroutine calculate_u_matrix