surfmas.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    surfmas                ../starter/source/tools/admas/surfmas.F
!||--- called by ------------------------------------------------------
!||    hm_read_admas          ../starter/source/tools/admas/hm_read_admas.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE surfmas(MS,IBUFN,ITY,AMASU,X,ID,ADDMAS,ADMID,TITR)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE message_mod
        USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBUFN(*),ITY,ID,ADMID
      my_real ms(*),amasu,x(3,*),addmas
      CHARACTER(LEN=NCHARTITLE)::TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .   x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
     .   x21,y21,z21,x31,y31,z31,x42,y42,z42,
     .   x32,y32,z32,e3x,e3y,e3z,smass,sum,area,
     .   a2,b2,c2,aa,bb,cc,ang1,ang2,ang3
C=======================================================================
      IF(ity /= 7)THEN
C----------------------------------------------
C     MASSES ELEMENTS /4
C----------------------------------------------
        x1=x(1,ibufn(1))
        y1=x(2,ibufn(1))
        z1=x(3,ibufn(1))
        x2=x(1,ibufn(2))
        y2=x(2,ibufn(2))
        z2=x(3,ibufn(2))
        x3=x(1,ibufn(3))
        y3=x(2,ibufn(3))
        z3=x(3,ibufn(3))
        x4=x(1,ibufn(4))
        y4=x(2,ibufn(4))
        z4=x(3,ibufn(4))
C
        x21=x2-x1
        y21=y2-y1
        z21=z2-z1
        x31=x3-x1
        y31=y3-y1
        z31=z3-z1
        x42=x4-x2
        y42=y4-y2
        z42=z4-z2
C
        e3x=y31*z42-z31*y42
        e3y=z31*x42-x31*z42
        e3z=x31*y42-y31*x42
        sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
        area=half*sum
C
C        EMS = RHO * THK * AREA
C
        smass = amasu * area  ! THK is already included in the input AMASU ( = MASS/AREA = RHO * THK)
C nodal mass
        ms(ibufn(1))=ms(ibufn(1)) + smass * fourth
        ms(ibufn(2))=ms(ibufn(2)) + smass * fourth
        ms(ibufn(3))=ms(ibufn(3)) + smass * fourth
        ms(ibufn(4))=ms(ibufn(4)) + smass * fourth
C
        addmas = addmas + smass
C
      ELSE IF(ity == 7)THEN
C----------------------------------------------
C     MASSES ELEMENTS * ANGLE
C----------------------------------------------
        x1=x(1,ibufn(1))
        y1=x(2,ibufn(1))
        z1=x(3,ibufn(1))
        x2=x(1,ibufn(2))
        y2=x(2,ibufn(2))
        z2=x(3,ibufn(2))
        x3=x(1,ibufn(3))
        y3=x(2,ibufn(3))
        z3=x(3,ibufn(3))
C
        x21=x2-x1
        y21=y2-y1
        z21=z2-z1
        x31=x3-x1
        y31=y3-y1
        z31=z3-z1
        x32=x3-x2
        y32=y3-y2
        z32=z3-z2
C
        a2 = x21**2 + y21**2 + z21**2
        b2 = x32**2 + y32**2 + z32**2
        c2 = x31**2 + y31**2 + z31**2
        aa = sqrt(a2)
        bb = sqrt(b2)
        cc = sqrt(c2)
C
        ang1 = acos((a2 + c2 - b2)/(two * aa * cc)) / pi
        ang2 = acos((a2 + b2 - c2)/(two * aa * bb)) / pi
        ang3 = acos((b2 + c2 - a2)/(two * bb * cc)) / pi
C
        IF ( ( (a2 + c2 - b2)/(2. * aa * cc) <= -one ) .OR.
     .       ( (a2 + c2 - b2)/(2. * aa * cc) >=  one ) .OR.
     .       ( (a2 + b2 - c2)/(2. * aa * bb) <= -one ) .OR.
     .       ( (a2 + b2 - c2)/(2. * aa * bb) >=  one ) .OR.
     .       ( (b2 + c2 - a2)/(2. * bb * cc) <= -one ) .OR.
     .       ( (b2 + c2 - a2)/(2. * bb * cc) >=  one ) ) THEN      
          CALL ancmsg(msgid=880,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=admid,
     .                c1=titr,i2=id)
        ENDIF
C
        e3x=y21*z31-z21*y31
        e3y=z21*x31-x21*z31
        e3z=x21*y31-y21*x31
        sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
        area=half*sum
C
        smass = amasu * area
C
        ms(ibufn(1))=ms(ibufn(1)) + smass * ang1
        ms(ibufn(2))=ms(ibufn(2)) + smass * ang2
        ms(ibufn(3))=ms(ibufn(3)) + smass * ang3
C
C        ADDMAS = ADDMAS + SMASS * (ANG1 + ANG2 + ANG3)
C    ANG1 + ANG2 + ANG3 = 1.
        addmas = addmas + smass
      END IF
C=======================================================================
      RETURN
      END