create_2lsom Subroutine

public subroutine create_2lsom(kohonen_map, training_parameters)

Constructor of a two_level self_organized_map class

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

type(kohonen_layer_parameters), dimension(:) :: training_parameters

A kohonen_layer_parameters structure


Calls

proc~~create_2lsom~~CallsGraph proc~create_2lsom two_level_self_organizing_map%create_2lsom none~create_distance factory_distance%create_distance proc~create_2lsom->none~create_distance none~create~3 rkiss05_generator%create proc~create_2lsom->none~create~3 proc~calculate_distance_matrix~2 two_level_self_organizing_map%calculate_distance_matrix proc~create_2lsom->proc~calculate_distance_matrix~2 proc~create_random_sample~2 two_level_self_organizing_map%create_random_sample proc~create_2lsom->proc~create_random_sample~2 proc~position2index~2 position2index proc~create_2lsom->proc~position2index~2 error_stop error_stop none~create_distance->error_stop none~generate rkiss05_generator%generate proc~create_random_sample~2->none~generate

Called by

proc~~create_2lsom~~CalledByGraph proc~create_2lsom two_level_self_organizing_map%create_2lsom proc~train_two_level_som train_two_level_som proc~train_two_level_som->proc~create_2lsom

Variables

Type Visibility Attributes Name Initial
integer, public :: ierr
integer, public :: nx
integer, public :: ny
integer, public :: nz
integer, public :: ix
integer, public :: iy
integer, public :: iz
integer, public :: nvar1
integer, public :: nvar2
integer, public :: number_clusters
integer, public :: ivar1
integer, public :: ivar2
integer, public :: current_index
real(kind=wp), public, allocatable :: input(:,:)
integer, public :: seed

Source Code

   subroutine create_2lsom(kohonen_map,training_parameters)
   !========================================================================================
!!   Constructor of a two_level self_organized_map class 
      class(two_level_self_organizing_map) :: kohonen_map
!! A `two_level_self_organizing_map` object
      type(kohonen_layer_parameters),dimension(:) :: training_parameters
!! A `kohonen_layer_parameters` structure
      integer :: ierr,nx,ny,nz,ix,iy,iz,nvar1,nvar2,number_clusters,ivar1,ivar2,current_index
      real(kind=wp),allocatable :: input(:,:)
      integer :: seed
   !
      kohonen_map%parameters=training_parameters(1:2);
      nx=training_parameters(1)%number_nodes_nx;
      ny=training_parameters(1)%number_nodes_ny;
      nz=training_parameters(1)%number_nodes_nz;
      nvar1=training_parameters(1)%number_variables1;
      nvar2=training_parameters(1)%number_variables2;
      number_clusters=training_parameters(2)%number_nodes_nx*&
                     training_parameters(2)%number_nodes_ny*&
                     training_parameters(2)%number_nodes_nz;
      kohonen_map%number_clusters=number_clusters;
      kohonen_map%number_variables=nvar1*nvar2;
      kohonen_map%number_variables1=nvar1;
      kohonen_map%number_variables2=nvar2;
      kohonen_map%number_nodes=nx*ny*nz;
      allocate(kohonen_map%grid(nx,ny,nz),stat=ierr);
      allocate(kohonen_map%coordinates(nx*ny*nz,3),stat=ierr);
      kohonen_map%coordinates=0;
      allocate(input(nvar1,nvar2),stat=ierr);
      input=0.0_wp;
      allocate(kohonen_map%number_patterns(nx,ny,nz),stat=ierr);
      allocate(kohonen_map%cells_index(training_parameters(1)%number_patterns,3),stat=ierr);
      kohonen_map%number_patterns=0;
      kohonen_map%cells_index=0;
      allocate(kohonen_map%u_matrix(2*nx-1,2*ny-1,2*nz-1),stat=ierr);
      kohonen_map%u_matrix=0.0_wp;
      allocate(kohonen_map%distance(nx*ny*nz,nx*ny*nz),stat=ierr);
   !  cluster layer arrays   
      allocate(kohonen_map%cluster_layer(number_clusters),stat=ierr);
      allocate(kohonen_map%cluster_cells_index(nx*ny*nz,4),stat=ierr);
      kohonen_map%cluster_cells_index=0;
      allocate(kohonen_map%cluster_number_patterns(number_clusters),stat=ierr);
      kohonen_map%cluster_number_patterns=0;
      allocate(kohonen_map%grid_cluster(nx,ny,nz),stat=ierr);
      kohonen_map%grid_cluster=0;
      allocate(kohonen_map%cluster_samples(training_parameters(1)%number_patterns),stat=ierr);
      allocate(kohonen_map%number_cluster_samples(number_clusters),stat=ierr);
      !Lack of initialization was causing problems during execution
      kohonen_map%number_cluster_samples=0;
      allocate(kohonen_map%index_cluster_samples(number_clusters,&
               training_parameters(1)%number_patterns),stat=ierr);
      kohonen_map%index_cluster_samples=0         
   !
      call kohonen_map%factory%create_distance(training_parameters(1)%distance_type,&
         kohonen_map%distance_function);
   !
      kohonen_map%seed1=training_parameters(1)%random_seed_(1)+100;
      call kohonen_map%rnumber_grator(1)%create(kohonen_map%seed1);
      !call sgrnd(seed)
      write(*,*) 'TWO LEVEL SOM: Initializing grid...',seed
      do iz=1,nz
         do iy=1,ny
            do ix=1,nx
               call kohonen_map%create_random_sample(input);
               !call grnd_array(input);
   !            write(*,*) ix,iy,input(1:2,1)
               call kohonen_map%grid(ix,iy,iz)%create(input); 
               !call kohonen_map%grid(ix,iy)%print();
               current_index=position2index(ix,iy,iz,nx,ny);
               kohonen_map%coordinates(current_index,1)=dble(ix);
               kohonen_map%coordinates(current_index,2)=dble(iy);
               kohonen_map%coordinates(current_index,3)=dble(iz);
   !            write(*,*) ix+(iy-1)*nx+(iz-1)*nx*ny
               if(trim(training_parameters(1)%node_type) .eq. 'hexagonal') then
   !              write(*,*) 'hexagonal'
                  kohonen_map%coordinates(current_index,1)=kohonen_map%coordinates(current_index,1)+&
                                          .5_wp*(mod(kohonen_map%coordinates(current_index,2),2.0_wp));
                  kohonen_map%coordinates(current_index,2)=(dsqrt(3.0_wp)/2._wp)*kohonen_map%coordinates(current_index,2);
               endif
            enddo!iz
         enddo !iy
      enddo !ix
   !
   !
   !
      allocate(kohonen_map%cells_distances(nx*ny*nz,nx*ny*nz),stat=ierr);
      call kohonen_map%calculate_distance_matrix(kohonen_map%coordinates,&
         kohonen_map%cells_distances,training_parameters(1)%node_type,&
         training_parameters(1)%toroidal_grid);
   !
   !
   !
      kohonen_map%seed2=training_parameters(2)%random_seed_(1);
      !call sgrnd(seed);
      call kohonen_map%rnumber_grator(2)%create(kohonen_map%seed2);
   !
      do ix=1,number_clusters
         !call grnd_array(input);
         call kohonen_map%create_random_sample(input);
         call kohonen_map%cluster_layer(ix)%create(input);
      enddo
   !   
      deallocate(input);
   !
      write(*,*) 'TWO LEVEL SOM: Initializing grid...OK'
   !   
   end subroutine create_2lsom