calculate_u_matrix Subroutine

public subroutine calculate_u_matrix(kohonen_map)

Subroutine to calculate the u_matrix

Type Bound

self_organizing_map

Arguments

Type IntentOptional Attributes Name
class(self_organizing_map) :: kohonen_map

A self_organizing_map object

Calls

proc~~calculate_u_matrix~~CallsGraph proc~calculate_u_matrix self_organizing_map%calculate_u_matrix none~distance~8 kohonen_prototype%distance proc~calculate_u_matrix->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~~CalledByGraph proc~calculate_u_matrix self_organizing_map%calculate_u_matrix proc~train_som_data self_organizing_map%train_som_data proc~train_som_data->proc~calculate_u_matrix proc~external_train_map self_organizing_map%external_train_map proc~external_train_map->proc~train_som_data proc~train_som train_som proc~train_som->proc~train_som_data

Variables

Type Visibility Attributes Name Initial
character(len=NUMCHAR), 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

Source Code

    subroutine calculate_u_matrix(kohonen_map)
!========================================================================================
!! Subroutine to calculate  the u_matrix
        class(self_organizing_map) :: kohonen_map
!! A `self_organizing_map` object
        character(len=NUMCHAR) :: type_
        integer :: nx,ny,nz,nt,ierr,ix,iy,iz,cx,cy,cz,nxu,nyu,nzu
        real(kind=wp) :: dist,u_temp
!
        type_=trim(kohonen_map%parameters%node_type);
        nx=kohonen_map%parameters%number_nodes_nx;
        ny=kohonen_map%parameters%number_nodes_ny;
        nz=kohonen_map%parameters%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')
                !call kohonen_map%calculate_u_matrix_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.0d0;
                             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')
                !call kohonen_map%calculate_u_matrix_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.0d0;
                        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
!
        if(kohonen_map%parameters%train_option < 3) then
            do iz=1,size(kohonen_map%u_matrix,3);
                write(kohonen_map%parameters%iumat,'(A,I4)') 'Layer ',iz 
                do ix=1,size(kohonen_map%u_matrix,1);
                    write(kohonen_map%parameters%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