vmec_context.f

Go to the documentation of this file.

!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
      MODULE vmec_context
      USE stel_kinds
      USE data_parameters
      USE xstuff
      USE vmec_input, Only: raxis_cc, raxis_cs, zaxis_cc, zaxis_cs
      USE v3f_vmec_comm
      USE profiler
      USE mpi_inc
 
      IMPLICIT NONE
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) vmec_context_class class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE vmec_context_class
         REAL (rprec), DIMENSION(:), POINTER :: xc => null()
 
         REAL (rprec), DIMENSION(:), POINTER :: raxis_cc => null()
         REAL (rprec), DIMENSION(:), POINTER :: raxis_cs => null()
         REAL (rprec), DIMENSION(:), POINTER :: zaxis_cc => null()
         REAL (rprec), DIMENSION(:), POINTER :: zaxis_cs => null()
 
!  threed1 file variables.
         REAL (rprec)                        :: vvc_smaleli
         REAL (rprec)                        :: vvc_kappa_p
      END TYPE
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION vmec_context_construct()
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), POINTER :: vmec_context_construct
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(vmec_context_construct)
 
      ALLOCATE(vmec_context_construct%xc(SIZE(xc)))
      ALLOCATE(vmec_context_construct%raxis_cc(SIZE(raxis_cc)))
      ALLOCATE(vmec_context_construct%raxis_cs(SIZE(raxis_cs)))
      ALLOCATE(vmec_context_construct%zaxis_cc(SIZE(zaxis_cc)))
      ALLOCATE(vmec_context_construct%zaxis_cs(SIZE(zaxis_cs)))
 
      CALL vmec_context_get_context(vmec_context_construct)
 
      CALL profiler_set_stop_time('vmec_context_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE vmec_context_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), POINTER :: this
 
!  Start of executable code
      IF (ASSOCIATED(this%xc)) THEN
         DEALLOCATE(this%xc)
         this%xc => null()
      END IF
 
      IF (ASSOCIATED(this%raxis_cc)) THEN
         DEALLOCATE(this%raxis_cc)
         this%raxis_cc => null()
      END IF
 
      IF (ASSOCIATED(this%raxis_cs)) THEN
         DEALLOCATE(this%raxis_cs)
         this%raxis_cs => null()
      END IF
 
      IF (ASSOCIATED(this%zaxis_cc)) THEN
         DEALLOCATE(this%zaxis_cc)
         this%zaxis_cc => null()
      END IF
 
      IF (ASSOCIATED(this%zaxis_cs)) THEN
         DEALLOCATE(this%zaxis_cs)
         this%zaxis_cs => null()
      END IF
 
      DEALLOCATE(this)
 
      END SUBROUTINE
 
!*******************************************************************************
!  SETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE vmec_context_set_context(this)
      USE v3_utilities
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      CALL assert_eq(SIZE(this%xc), SIZE(xc), "xc size change. " //            &
     &               "Cannot set context.")
      xc = this%xc
 
      raxis_cc = this%raxis_cc
      raxis_cs = this%raxis_cs
      zaxis_cc = this%zaxis_cc
      zaxis_cs = this%zaxis_cs
 
      vvc_smaleli = this%vvc_smaleli
      vvc_kappa_p = this%vvc_kappa_p
 
      CALL profiler_set_stop_time('vmec_context_set_context',                  &
     &                            start_time)
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE vmec_context_get_context(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), INTENT(inout) :: this
 
!  local variables
      REAL (rprec)                             :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      IF(SIZE(this%xc) .ne. SIZE(xc)) THEN
         DEALLOCATE(this%xc)
         ALLOCATE(this%xc(SIZE(xc)))
      END IF
      this%xc = xc
 
      this%raxis_cc = raxis_cc
      this%raxis_cs = raxis_cs
      this%zaxis_cc = zaxis_cc
      this%zaxis_cs = zaxis_cs
 
      this%vvc_smaleli = vvc_smaleli
      this%vvc_kappa_p = vvc_kappa_p
 
      CALL profiler_set_stop_time('vmec_context_get_context',                  &
     &                            start_time)
 
      END SUBROUTINE
 
!*******************************************************************************
!  MPI SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE vmec_context_sync_state(this, recon_comm)
      USE v3_utilities
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), INTENT(inout) :: this
      INTEGER, INTENT(in)                      :: recon_comm
 
#if defined(MPI_OPT)
!  local variables
      INTEGER                                  :: error
      INTEGER                                  :: temp_size
      INTEGER                                  :: mpi_rank
 
!  Start of executable code
      CALL mpi_comm_rank(recon_comm, mpi_rank, error)
 
!  If the size of the xc array changed size we cannot sync.
      temp_size = SIZE(xc)
      CALL mpi_bcast(temp_size, 1, mpi_integer, 0, recon_comm, error)
 
      IF (mpi_rank .gt. 0) THEN
         CALL assert_eq(temp_size, SIZE(xc),                                   &
     &                  'Cannot sync xc arrays. Arrays changed size.')
      END IF
      CALL mpi_bcast(xc, temp_size, mpi_real8, 0, recon_comm, error)
 
      CALL mpi_bcast(raxis_cc, SIZE(raxis_cc), mpi_real8, 0, recon_comm,       &
     &               error)
      CALL mpi_bcast(raxis_cs, SIZE(raxis_cs), mpi_real8, 0, recon_comm,       &
     &               error)
      CALL mpi_bcast(zaxis_cc, SIZE(zaxis_cc), mpi_real8, 0, recon_comm,       &
     &               error)
      CALL mpi_bcast(zaxis_cs, SIZE(zaxis_cs), mpi_real8, 0, recon_comm,       &
     &               error)
 
      CALL mpi_bcast(vvc_smaleli, 1, mpi_real8, 0, recon_comm, error)
      CALL mpi_bcast(vvc_kappa_p, 1, mpi_real8, 0, recon_comm, error)
 
#endif
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE vmec_context_sync_child(this, index, recon_comm)
      USE v3_utilities
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (vmec_context_class), INTENT(inout) :: this
      INTEGER, INTENT(in)                      :: index
      INTEGER, INTENT(in)                      :: recon_comm
 
#if defined(MPI_OPT)
!  local variables
      INTEGER                                  :: error
      INTEGER                                  :: temp_size
      INTEGER                                  :: mpi_rank
 
!  Start of executable code
      CALL mpi_comm_rank(recon_comm, mpi_rank, error)
 
!  If the size of the xc array changed size we cannot sync.
      temp_size = SIZE(xc)
      IF (mpi_rank .eq. index) THEN
         CALL mpi_ssend(temp_size, 1, mpi_integer, 0, mpi_rank,                &
     &                  recon_comm, error)
 
         CALL mpi_ssend(xc, temp_size, mpi_real8, 0, mpi_rank,                 &
     &                  recon_comm, error)
 
         CALL mpi_ssend(raxis_cc, SIZE(raxis_cc), mpi_real8, 0,                &
     &                  mpi_rank, recon_comm, error)
         CALL mpi_ssend(raxis_cs, SIZE(raxis_cs), mpi_real8, 0,                &
     &                  mpi_rank, recon_comm, error)
         CALL mpi_ssend(zaxis_cc, SIZE(zaxis_cc), mpi_real8, 0,                &
     &                  mpi_rank, recon_comm, error)
         CALL mpi_ssend(zaxis_cs, SIZE(zaxis_cs), mpi_real8, 0,                &
     &                  mpi_rank, recon_comm, error)
 
         CALL mpi_ssend(vvc_smaleli, 1, mpi_real8, 0, mpi_rank,                &
     &                  recon_comm, error)
         CALL mpi_ssend(vvc_kappa_p, 1, mpi_real8, 0, mpi_rank,                &
     &                  recon_comm, error)
 
      ELSE IF (mpi_rank .eq. 0) THEN
         CALL mpi_recv(temp_size, 1, mpi_integer, index, index,                &
     &                 recon_comm, mpi_status_ignore, error)
         CALL assert_eq(temp_size, SIZE(xc),                                   &
     &                  'Cannot sync xc arrays. Arrays changed size.')
 
         CALL mpi_recv(xc, temp_size, mpi_real8, index, index,                 &
     &                 recon_comm, mpi_status_ignore, error)
 
         CALL mpi_recv(raxis_cc, SIZE(raxis_cc), mpi_real8, index,             &
     &                 index, recon_comm, mpi_status_ignore, error)
         CALL mpi_recv(raxis_cs, SIZE(raxis_cs), mpi_real8, index,             &
     &                 index, recon_comm, mpi_status_ignore, error)
         CALL mpi_recv(zaxis_cc, SIZE(zaxis_cc), mpi_real8, index,             &
     &                 index, recon_comm, mpi_status_ignore, error)
         CALL mpi_recv(zaxis_cs, SIZE(zaxis_cs), mpi_real8, index,             &
     &                 index, recon_comm, mpi_status_ignore, error)
 
         CALL mpi_recv(vvc_smaleli, 1, mpi_real8, index, index,                &
     &                 recon_comm, mpi_status_ignore, error)
         CALL mpi_recv(vvc_kappa_p, 1, mpi_real8, index, index,                &
     &                 recon_comm, mpi_status_ignore, error)
 
      END IF
 
#endif
      END SUBROUTINE
 
      END MODULE