tensor_map_m.f90 Source File


This file depends on

sourcefile~~tensor_map_m.f90~~EfferentGraph sourcefile~tensor_map_m.f90 tensor_map_m.f90 sourcefile~double_precision_string_m.f90 double_precision_string_m.f90 sourcefile~tensor_map_m.f90->sourcefile~double_precision_string_m.f90 sourcefile~kind_parameters_m.f90 kind_parameters_m.f90 sourcefile~tensor_map_m.f90->sourcefile~kind_parameters_m.f90 sourcefile~tensor_m.f90 tensor_m.f90 sourcefile~tensor_map_m.f90->sourcefile~tensor_m.f90 sourcefile~tensor_m.f90->sourcefile~kind_parameters_m.f90

Files dependent on this one

sourcefile~~tensor_map_m.f90~~AfferentGraph sourcefile~tensor_map_m.f90 tensor_map_m.f90 sourcefile~fiats_m.f90 fiats_m.f90 sourcefile~fiats_m.f90->sourcefile~tensor_map_m.f90 sourcefile~neural_network_m.f90 neural_network_m.f90 sourcefile~fiats_m.f90->sourcefile~neural_network_m.f90 sourcefile~trainable_network_m.f90 trainable_network_m.f90 sourcefile~fiats_m.f90->sourcefile~trainable_network_m.f90 sourcefile~layer_m.f90 layer_m.f90 sourcefile~layer_m.f90->sourcefile~tensor_map_m.f90 sourcefile~layer_m.f90->sourcefile~neural_network_m.f90 sourcefile~neural_network_m.f90->sourcefile~tensor_map_m.f90 sourcefile~tensor_map_s.f90 tensor_map_s.F90 sourcefile~tensor_map_s.f90->sourcefile~tensor_map_m.f90 sourcefile~trainable_network_m.f90->sourcefile~tensor_map_m.f90 sourcefile~trainable_network_m.f90->sourcefile~neural_network_m.f90 sourcefile~concurrent-inferences.f90 concurrent-inferences.f90 sourcefile~concurrent-inferences.f90->sourcefile~fiats_m.f90 sourcefile~layer_s.f90 layer_s.F90 sourcefile~layer_s.f90->sourcefile~layer_m.f90 sourcefile~learn-addition.f90 learn-addition.F90 sourcefile~learn-addition.f90->sourcefile~fiats_m.f90 sourcefile~learn-exponentiation.f90 learn-exponentiation.F90 sourcefile~learn-exponentiation.f90->sourcefile~fiats_m.f90 sourcefile~learn-multiplication.f90 learn-multiplication.F90 sourcefile~learn-multiplication.f90->sourcefile~fiats_m.f90 sourcefile~learn-power-series.f90 learn-power-series.F90 sourcefile~learn-power-series.f90->sourcefile~fiats_m.f90 sourcefile~learn-saturated-mixing-ratio.f90 learn-saturated-mixing-ratio.F90 sourcefile~learn-saturated-mixing-ratio.f90->sourcefile~fiats_m.f90 sourcefile~saturated_mixing_ratio_m.f90 saturated_mixing_ratio_m.f90 sourcefile~learn-saturated-mixing-ratio.f90->sourcefile~saturated_mixing_ratio_m.f90 sourcefile~neural_network_s.f90 neural_network_s.F90 sourcefile~neural_network_s.f90->sourcefile~layer_m.f90 sourcefile~neural_network_s.f90->sourcefile~neural_network_m.f90 sourcefile~print-training-configuration.f90 print-training-configuration.F90 sourcefile~print-training-configuration.f90->sourcefile~fiats_m.f90 sourcefile~read-query-infer.f90 read-query-infer.f90 sourcefile~read-query-infer.f90->sourcefile~fiats_m.f90 sourcefile~saturated_mixing_ratio_m.f90->sourcefile~fiats_m.f90 sourcefile~train-and-write.f90 train-and-write.F90 sourcefile~train-and-write.f90->sourcefile~fiats_m.f90 sourcefile~trainable_network_s.f90 trainable_network_s.F90 sourcefile~trainable_network_s.f90->sourcefile~trainable_network_m.f90 sourcefile~unmapped_network_s.f90 unmapped_network_s.F90 sourcefile~unmapped_network_s.f90->sourcefile~neural_network_m.f90 sourcefile~workspace_s.f90 workspace_s.F90 sourcefile~workspace_s.f90->sourcefile~neural_network_m.f90 sourcefile~write-read-infer.f90 write-read-infer.F90 sourcefile~write-read-infer.f90->sourcefile~fiats_m.f90

Source Code

! Copyright (c), The Regents of the University of California
! Terms of use are as specified in LICENSE.txt
module tensor_map_m
  use tensor_m, only : tensor_t
  use julienne_m, only : string_t
  use kind_parameters_m, only : default_real, double_precision
  use double_precision_string_m, only : double_precision_string_t
  implicit none
  
  private
  public :: tensor_map_t

  type tensor_map_t(k)
    integer, kind :: k = default_real 
    character(len=:),      allocatable, private :: layer_
    real(k), dimension(:), allocatable, private :: intercept_, slope_
  contains
    generic :: map_to_training_range    => default_real_map_to_training_range  , double_precision_map_to_training_range
    procedure, private, non_overridable :: default_real_map_to_training_range  , double_precision_map_to_training_range
    generic :: map_from_training_range  => default_real_map_from_training_range, double_precision_map_from_training_range
    procedure, private, non_overridable :: default_real_map_from_training_range, double_precision_map_from_training_range
    generic :: minima                   => default_real_minima                 , double_precision_minima
    procedure, private, non_overridable :: default_real_minima                 , double_precision_minima
    generic :: maxima                   => default_real_maxima                 , double_precision_maxima
    procedure, private, non_overridable :: default_real_maxima                 , double_precision_maxima
    generic :: to_json                  => default_real_to_json                , double_precision_to_json
    procedure, private                  :: default_real_to_json                , double_precision_to_json
    generic :: operator(==)             => default_real_equals                 , double_precision_equals
    procedure, private                  :: default_real_equals                 , double_precision_equals
  end type


  interface tensor_map_t

    pure module function construct_default_real(layer, minima, maxima) result(tensor_map)
      implicit none
      character(len=*), intent(in) :: layer
      real, dimension(:), intent(in) :: minima, maxima
      type(tensor_map_t) tensor_map
    end function

    pure module function construct_double_precision(layer, minima, maxima) result(tensor_map)
      implicit none
      character(len=*), intent(in) :: layer
      double precision, dimension(:), intent(in) :: minima, maxima
      type(tensor_map_t(double_precision)) tensor_map
    end function

    module function from_json(lines) result(tensor_map)
      implicit none
      type(string_t), intent(in) :: lines(:)
      type(tensor_map_t) tensor_map
    end function

    module function double_precision_from_json(lines) result(tensor_map)
      implicit none
      type(double_precision_string_t), intent(in) :: lines(:)
      type(tensor_map_t(double_precision)) tensor_map
    end function

  end interface

  interface

    pure module function default_real_minima(self) result(minima)
      implicit none
      class(tensor_map_t), intent(in) :: self
      real, allocatable :: minima(:)
    end function

    pure module function double_precision_minima(self) result(minima)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: self
      double precision, allocatable :: minima(:)
    end function

    pure module function default_real_maxima(self) result(maxima)
      implicit none
      class(tensor_map_t), intent(in) :: self
      real, allocatable :: maxima(:)
    end function

    pure module function double_precision_maxima(self) result(maxima)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: self
      double precision, allocatable :: maxima(:)
    end function

    elemental module function default_real_map_to_training_range(self, tensor) result(normalized_tensor)
      implicit none
      class(tensor_map_t), intent(in) :: self
      type(tensor_t), intent(in) :: tensor
      type(tensor_t) normalized_tensor
    end function

    elemental module function double_precision_map_to_training_range(self, tensor) result(normalized_tensor)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: self
      type(tensor_t(double_precision)), intent(in) :: tensor
      type(tensor_t(double_precision)) normalized_tensor
    end function

    elemental module function default_real_map_from_training_range(self, tensor) result(unnormalized_tensor)
      implicit none
      class(tensor_map_t), intent(in) :: self
      type(tensor_t), intent(in) :: tensor
      type(tensor_t) unnormalized_tensor
    end function

    elemental module function double_precision_map_from_training_range(self, tensor) result(unnormalized_tensor)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: self
      type(tensor_t(double_precision)), intent(in) :: tensor
      type(tensor_t(double_precision)) unnormalized_tensor
    end function

    pure module function default_real_to_json(self) result(lines)
      implicit none
      class(tensor_map_t), intent(in) :: self
      type(string_t), allocatable :: lines(:)
    end function

    pure module function double_precision_to_json(self) result(lines)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: self
      type(string_t), allocatable :: lines(:)
    end function

    elemental module function default_real_equals(lhs, rhs) result(lhs_equals_rhs)
      implicit none
      class(tensor_map_t), intent(in) :: lhs, rhs
      logical lhs_equals_rhs
    end function

    elemental module function double_precision_equals(lhs, rhs) result(lhs_equals_rhs)
      implicit none
      class(tensor_map_t(double_precision)), intent(in) :: lhs, rhs
      logical lhs_equals_rhs
    end function

  end interface

end module tensor_map_m