xref: /phasta/svLS/BC.f (revision 712d3df0b59ebebaaeaea358162c8d2c043c6e08)

!     This software is Copyright (c) 2012-2015 The Regents of the
!     University of California. All Rights Reserved.
!
!     Permission to copy and modify this software and its documentation
!     for educational, research and non-profit purposes, without fee,
!     and without a written agreement is hereby granted, provided that
!     the above copyright notice, this paragraph and the following three
!     paragraphs appear in all copies.
!
!     Permission to make commercial use of this software may be obtained
!     by contacting:
!
!     Technology Transfer Office
!     9500 Gilman Drive, Mail Code 0910
!     University of California
!     La Jolla, CA 92093-0910
!     (858) 534-5815
!     invent@ucsd.edu
!
!     This software program and documentation are copyrighted by The
!     Regents of the University of California. The software program and
!     documentation are supplied "as is", without any accompanying
!     services from The Regents. The Regents does not warrant that the
!     operation of the program will be uninterrupted or error-free. The
!     end-user understands that the program was developed for research
!     purposes and is advised not to rely exclusively on the program for
!     any reason.
!
!     IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
!     PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
!     DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS
!     SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
!     CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!     THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY
!     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
!     OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
!     SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE
!     UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE
!     MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

      SUBROUTINE svLS_BC_CREATE (lhs, faIn, nNo, dof, BC_type, gNodes,
     2   Val)

      INCLUDE "svLS_STD.h"

      TYPE(svLS_lhsType), INTENT(INOUT) :: lhs
      INTEGER, INTENT(IN) :: faIn, nNo, dof
      INTEGER, INTENT(IN) :: BC_type
      INTEGER, INTENT(IN) :: gNodes(nNo)
      REAL*8, INTENT(IN), OPTIONAL :: Val(dof,nNo)

      INTEGER a, Ac, i
      REAL*8, ALLOCATABLE :: v(:,:)

      IF (faIn .GT. lhs%nFaces) THEN
         PRINT *, "faIn is exceeding lhs structure maximum number of",
     2      "face:", lhs%nFaces, ">", faIn
         STOP
      END IF
      IF (faIn .LT. 0) THEN
         PRINT *, "faIn is should be greater than zero"
         STOP
      END IF

      IF (lhs%face(faIn)%foC) THEN
         PRINT *, "BC(", faIn,") is not free"
         PRINT *, "You may use svLS_BC_FREE to free this structure"
      END IF

      lhs%face(faIn)%nNo  = nNo
      lhs%face(faIn)%dof  = dof
      lhs%face(faIn)%bGrp = BC_type

      ALLOCATE(lhs%face(faIn)%glob(nNo), lhs%face(faIn)%val(dof,nNo),
     2   lhs%face(faIn)%valM(dof,nNo))

      DO a=1, nNo
         Ac = lhs%map(gNodes(a))
         lhs%face(faIn)%glob(a) = Ac
      END DO

      IF (PRESENT(Val)) THEN
         DO a=1, nNo
            lhs%face(faIn)%val(:,a) = Val(:,a)
         END DO
      ELSE
         lhs%face(faIn)%val = 0D0
      END IF

      IF (lhs%commu%nTasks .GT. 1) THEN
         a = 0
         IF (lhs%face(faIn)%nNo .NE. 0) a = 1
         CALL MPI_ALLREDUCE(a, Ac, 1, mpint,
     2        MPI_SUM, lhs%commu%comm, i)
         IF (Ac .GT. 1) THEN
            lhs%face(faIn)%sharedFlag = .TRUE.
            IF (.NOT.ALLOCATED(v)) ALLOCATE(v(dof,lhs%nNo))
            v = 0D0
            DO a=1, nNo
               Ac = lhs%face(faIn)%glob(a)
               v(:,Ac) = lhs%face(faIn)%val(:,a)
            END DO
            CALL COMMUV(dof, lhs%nNo, lhs%commu, lhs%cS, v)

            DO a=1, nNo
               Ac = lhs%face(faIn)%glob(a)
               lhs%face(faIn)%val(:,a) = v(:,Ac)
            END DO
         END IF
      END IF

      RETURN
      END SUBROUTINE svLS_BC_CREATE

!====================================================================

      SUBROUTINE svLS_BC_FREE (lhs, faIn)

      INCLUDE "svLS_STD.h"

      TYPE(svLS_lhsType), INTENT(INOUT) :: lhs
      INTEGER, INTENT(IN) :: faIn

      IF (.NOT.lhs%face(faIn)%foC) THEN
         PRINT *, 'Cannot free face:', faIn
         PRINT *, 'It is not created yet'
         STOP
      END IF
      lhs%face(faIn)%foC        = .FALSE.
      lhs%face(faIn)%nNo        = 0
      lhs%face(faIn)%bGrp       = BC_TYPE_Dir
      lhs%face(faIn)%res        = 0D0
      lhs%face(faIn)%sharedFlag = .FALSE.

      DEALLOCATE(lhs%face(faIn)%glob, lhs%face(faIn)%val,
     2   lhs%face(faIn)%valM)

      RETURN
      END SUBROUTINE svLS_BC_FREE