1! This software is Copyright (c) 2012-2015 The Regents of the 2! University of California. All Rights Reserved. 3! 4! Permission to copy and modify this software and its documentation 5! for educational, research and non-profit purposes, without fee, 6! and without a written agreement is hereby granted, provided that 7! the above copyright notice, this paragraph and the following three 8! paragraphs appear in all copies. 9! 10! Permission to make commercial use of this software may be obtained 11! by contacting: 12! 13! Technology Transfer Office 14! 9500 Gilman Drive, Mail Code 0910 15! University of California 16! La Jolla, CA 92093-0910 17! (858) 534-5815 18! invent@ucsd.edu 19! 20! This software program and documentation are copyrighted by The 21! Regents of the University of California. The software program and 22! documentation are supplied "as is", without any accompanying 23! services from The Regents. The Regents does not warrant that the 24! operation of the program will be uninterrupted or error-free. The 25! end-user understands that the program was developed for research 26! purposes and is advised not to rely exclusively on the program for 27! any reason. 28! 29! IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY 30! PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL 31! DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS 32! SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF 33! CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 34! THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY 35! WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 36! OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 37! SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE 38! UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE 39! MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 40 41 SUBROUTINE svLS_BC_CREATE (lhs, faIn, nNo, dof, BC_type, gNodes, 42 2 Val) 43 44 INCLUDE "svLS_STD.h" 45 46 TYPE(svLS_lhsType), INTENT(INOUT) :: lhs 47 INTEGER, INTENT(IN) :: faIn, nNo, dof 48 INTEGER, INTENT(IN) :: BC_type 49 INTEGER, INTENT(IN) :: gNodes(nNo) 50 REAL*8, INTENT(IN), OPTIONAL :: Val(dof,nNo) 51 52 INTEGER a, Ac, i 53 REAL*8, ALLOCATABLE :: v(:,:) 54 55 IF (faIn .GT. lhs%nFaces) THEN 56 PRINT *, "faIn is exceeding lhs structure maximum number of", 57 2 "face:", lhs%nFaces, ">", faIn 58 STOP 59 END IF 60 IF (faIn .LT. 0) THEN 61 PRINT *, "faIn is should be greater than zero" 62 STOP 63 END IF 64 65 IF (lhs%face(faIn)%foC) THEN 66 PRINT *, "BC(", faIn,") is not free" 67 PRINT *, "You may use svLS_BC_FREE to free this structure" 68 END IF 69 70 lhs%face(faIn)%nNo = nNo 71 lhs%face(faIn)%dof = dof 72 lhs%face(faIn)%bGrp = BC_type 73 74 ALLOCATE(lhs%face(faIn)%glob(nNo), lhs%face(faIn)%val(dof,nNo), 75 2 lhs%face(faIn)%valM(dof,nNo)) 76 77 DO a=1, nNo 78 Ac = lhs%map(gNodes(a)) 79 lhs%face(faIn)%glob(a) = Ac 80 END DO 81 82 IF (PRESENT(Val)) THEN 83 DO a=1, nNo 84 lhs%face(faIn)%val(:,a) = Val(:,a) 85 END DO 86 ELSE 87 lhs%face(faIn)%val = 0D0 88 END IF 89 90 IF (lhs%commu%nTasks .GT. 1) THEN 91 a = 0 92 IF (lhs%face(faIn)%nNo .NE. 0) a = 1 93 CALL MPI_ALLREDUCE(a, Ac, 1, mpint, 94 2 MPI_SUM, lhs%commu%comm, i) 95 IF (Ac .GT. 1) THEN 96 lhs%face(faIn)%sharedFlag = .TRUE. 97 IF (.NOT.ALLOCATED(v)) ALLOCATE(v(dof,lhs%nNo)) 98 v = 0D0 99 DO a=1, nNo 100 Ac = lhs%face(faIn)%glob(a) 101 v(:,Ac) = lhs%face(faIn)%val(:,a) 102 END DO 103 CALL COMMUV(dof, lhs%nNo, lhs%commu, lhs%cS, v) 104 105 DO a=1, nNo 106 Ac = lhs%face(faIn)%glob(a) 107 lhs%face(faIn)%val(:,a) = v(:,Ac) 108 END DO 109 END IF 110 END IF 111 112 RETURN 113 END SUBROUTINE svLS_BC_CREATE 114 115!==================================================================== 116 117 SUBROUTINE svLS_BC_FREE (lhs, faIn) 118 119 INCLUDE "svLS_STD.h" 120 121 TYPE(svLS_lhsType), INTENT(INOUT) :: lhs 122 INTEGER, INTENT(IN) :: faIn 123 124 IF (.NOT.lhs%face(faIn)%foC) THEN 125 PRINT *, 'Cannot free face:', faIn 126 PRINT *, 'It is not created yet' 127 STOP 128 END IF 129 lhs%face(faIn)%foC = .FALSE. 130 lhs%face(faIn)%nNo = 0 131 lhs%face(faIn)%bGrp = BC_TYPE_Dir 132 lhs%face(faIn)%res = 0D0 133 lhs%face(faIn)%sharedFlag = .FALSE. 134 135 DEALLOCATE(lhs%face(faIn)%glob, lhs%face(faIn)%val, 136 2 lhs%face(faIn)%valM) 137 138 RETURN 139 END SUBROUTINE svLS_BC_FREE 140 141