mod_states.F90 2.56 KB
module mod_states
   use mod_dimensions

   type states
      real, dimension(kdim) :: N,P,H
   end type states

   type local_states
      real N,P,H
   end type local_states

   type lstates
      logical N,P,H
   end type lstates

   interface operator(+)
      module procedure add_states
   end interface

   interface operator(-)
      module procedure subtract_states
   end interface

   interface operator(*)
      module procedure states_real_mult,&
                       real_states_mult,&
                       states_states_mult
   end interface

   interface  assignment(=)
      module procedure assign_states,&
                       assign_local_states
   end interface

   contains
      function add_states(X,Y)
         type(states) add_states
         type(states), intent(in) :: X
         type(states), intent(in) :: Y
         add_states%N = X%N + Y%N
         add_states%P = X%P + Y%P
         add_states%H = X%H + Y%H
      end function add_states

      function subtract_states(X,Y)
         type(states) subtract_states
         type(states), intent(in) :: X
         type(states), intent(in) :: Y
         subtract_states%N = X%N - Y%N
         subtract_states%P = X%P - Y%P
         subtract_states%H = X%H - Y%H
      end function subtract_states

      function states_real_mult(X,Y)
         type(states) states_real_mult
         type(states), intent(in) :: X
         real, intent(in) :: Y
         states_real_mult%N = Y*X%N
         states_real_mult%P = Y*X%P
         states_real_mult%H = Y*X%H
      end function states_real_mult

      function real_states_mult(Y,X)
         type(states) real_states_mult
         type(states), intent(in) :: X
         real, intent(in) :: Y
         real_states_mult%N = Y*X%N
         real_states_mult%P = Y*X%P
         real_states_mult%H = Y*X%H
      end function real_states_mult

      function states_states_mult(X,Y)
         type(states) states_states_mult
         type(states), intent(in) :: X
         type(states), intent(in) :: Y
         states_states_mult%N = X%N * Y%N
         states_states_mult%P = X%P * Y%P
         states_states_mult%H = X%H * Y%H
      end function states_states_mult
      
      subroutine assign_states(X,r)
         type(states), intent(out) :: X
         real, intent(in) :: r
         X%N = r
         X%P = r
         X%H = r
      end subroutine assign_states

      subroutine assign_local_states(X,r)
         type(local_states), intent(out) :: X
         real, intent(in) :: r
         X%N = r
         X%P = r
         X%H = r
      end subroutine assign_local_states

end module mod_states