bhtobf.f90

!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
      MODULE bhtobf
 
      IMPLICIT NONE
 
      CONTAINS
 
!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bhalftobfull(bsupsijh, bsupuijh, bsupvijh,                    &
                              bsupsijf, bsupuijf, bsupvijf,                    &
                              pijh, pijf)
      USE stel_kinds
      USE v3_utilities, ONLY: assert_eq
      USE quantities, ONLY: ns, jacobf, jacobh
      USE timer_mod
      USE utilities, ONLY: to_full_mesh
      USE siesta_namelist, ONLY: l_vessel
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupsijh
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupuijh
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupvijh
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupsijf
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupuijf
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: bsupvijf
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: pijh
      REAL (dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(inout) :: pijf
 
!  local variables
      INTEGER                                                 :: nsmin
      INTEGER                                                 :: nsmax
 
!  Start of executable code
      nsmin = lbound(bsupsijh,3)
      nsmax = ubound(bsupsijh,3)
 
      CALL to_full_mesh(bsupsijh, bsupsijf)
      IF (nsmin .EQ. 1) THEN
         bsupsijf(:,:,1) = bsupsijh(:,:,1)
      END IF
      bsupsijf = bsupsijf/jacobf(:,:,nsmin:nsmax)
      bsupsijh = bsupsijh/jacobh(:,:,nsmin:nsmax)
 
      CALL to_full_mesh(bsupuijh, bsupuijf)
      IF (nsmin .EQ. 1) THEN
         bsupuijf(:,:,1) = bsupuijh(:,:,1)
      END IF
      bsupuijf = bsupuijf/jacobf(:,:,nsmin:nsmax)
      bsupuijh = bsupuijh/jacobh(:,:,nsmin:nsmax)
 
      CALL to_full_mesh(bsupvijh, bsupvijf)
      IF (nsmin .EQ. 1) THEN
         bsupvijf(:,:,1) = bsupvijh(:,:,1)
      END IF
      bsupvijf = bsupvijf/jacobf(:,:,nsmin:nsmax)
      bsupvijh = bsupvijh/jacobh(:,:,nsmin:nsmax)
 
      CALL assert_eq(SIZE(bsupsijh,3), SIZE(pijh,3), 'bhtobf pijh SIZE WRONG')
      CALL to_full_mesh(pijh, pijf)
      IF (nsmin .EQ. 1) THEN
         pijf(:,:,1) = pijh(:,:,1)
      END IF
      pijf = pijf/jacobf(:,:,nsmin:nsmax)
      pijh = pijh/jacobh(:,:,nsmin:nsmax)
 
      IF (nsmax .eq. ns .and. .not.l_vessel) THEN
         bsupsijf(:,:,ns) = 0
      END IF
 
      END SUBROUTINE
 
      END MODULE