FactoryClass.f90 Source File


Source Code

module FactoryClass
   use FEMDomainClass
   use SoybeanClass
   implicit none

   type :: Factory_

   contains
      ! creator
      procedure, public :: cube => cube_Factory
      procedure, public :: sphere => sphere_Factory

      procedure, public :: soybean => soybean_Factory
      !

      ! editor
      procedure, pass :: move_forall_femdomain_Factory
      procedure, pass :: move_foreach_femdomain_Factory
      procedure, pass :: move_foreach_soybean_Factory
      generic :: move => move_forall_femdomain_Factory, move_foreach_femdomain_Factory, &
         move_foreach_soybean_Factory

      procedure, pass :: rotate_forall_Factory
      procedure, pass :: rotate_foreach_Factory
      generic :: rotate => rotate_forall_Factory, rotate_foreach_Factory

      procedure, pass :: resize_forall_Factory
      procedure, pass :: resize_foreach_Factory
      generic :: resize => resize_forall_Factory, resize_foreach_Factory

   end type

   interface operator(//)
      module procedure :: appendFEMDomainVector
   end interface
contains

   function cube_Factory(this, division, n) result(cubes)
      class(Factory_), intent(in) :: this
      integer(int32), intent(in) :: division(1:3), n
      type(FEMDomain_) :: cubes(n)
      integer(int32) :: i

    !!!$OMP parallel do
      do i = 1, n
         call cubes(i)%create("Cube3D", &
                              x_num=division(1), &
                              y_num=division(2), &
                              z_num=division(3) &
                              )
      end do
    !!!$OMP end parallel do
   end function
! ##################################################

   function Sphere_Factory(this, division, n) result(Spheres)
      class(Factory_), intent(in) :: this
      integer(int32), intent(in) :: division(1:3), n
      type(FEMDomain_) :: Spheres(n)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, n
         call Spheres(i)%create("Sphere3D", &
                                x_num=division(1), &
                                y_num=division(2), &
                                z_num=division(3) &
                                )
      end do
    !!$OMP end parallel do
   end function
! ##################################################
   function Soybean_Factory(this, config, n) result(Soybeans)
      class(Factory_), intent(in) :: this
      character(*), intent(in) :: config
      integer(int32), intent(in) :: n
      type(Soybean_) :: Soybeans(n)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, n
         call Soybeans(i)%create(config=config)
      end do
    !!$OMP end parallel do

   end function
! ##################################################
   subroutine move_foreach_femdomain_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x(:), y(:), z(:)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%move( &
            x=x(i), &
            y=y(i), &
            z=z(i) &
            )
      end do
    !!$OMP end parallel do
   end subroutine

! ##################################################
   subroutine move_forall_femdomain_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x, y, z
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%move( &
            x=x, &
            y=y, &
            z=z &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################

! ##################################################
   subroutine move_foreach_Soybean_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(Soybean_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x(:), y(:), z(:)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%move( &
            x=x(i), &
            y=y(i), &
            z=z(i) &
            )
      end do
    !!$OMP end parallel do
   end subroutine

! ##################################################
   subroutine move_forall_Soybean_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(Soybean_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x, y, z
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%move( &
            x=x, &
            y=y, &
            z=z &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################

! ##################################################
   subroutine rotate_foreach_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x(:), y(:), z(:)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%rotate( &
            x=x(i), &
            y=y(i), &
            z=z(i) &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################
   subroutine rotate_forall_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x, y, z
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%rotate( &
            x=x, &
            y=y, &
            z=z &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################

! ##################################################
   subroutine resize_foreach_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), intent(in) :: x(:), y(:), z(:)
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%resize( &
            x=x(i), &
            y=y(i), &
            z=z(i) &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################
   subroutine resize_forall_Factory(this, objects, x, y, z)
      class(Factory_), intent(in) :: this
      type(FEMDomain_), intent(inout) :: objects(:)
      real(real64), optional, intent(in) :: x, y, z
      integer(int32) :: i

    !!$OMP parallel do
      do i = 1, size(objects)
         call objects(i)%resize( &
            x=x, &
            y=y, &
            z=z &
            )
      end do
    !!$OMP end parallel do
   end subroutine
! ##################################################

   function appendFEMDomainVector(dv1, dv2) result(ret)
      type(FEMDomain_), intent(in) :: dv1(:), dv2(:)
      type(FEMDomain_), allocatable :: ret(:)

      allocate (ret(size(dv1) + size(dv2)))
      ret(1:size(dv1)) = dv1(:)
      ret(size(dv1) + 1:) = dv2(:)

   end function

end module