mreploc.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/.
!||====================================================================
!||    mreploc         ../engine/source/materials/mat_share/mreploc.F
!||--- called by ------------------------------------------------------
!||    m25law          ../engine/source/materials/mat/mat025/m25law.F
!||    mmain           ../engine/source/materials/mat_share/mmain.F90
!||    mulaw           ../engine/source/materials/mat_share/mulaw.F90
!||    mulaw8          ../engine/source/materials/mat_share/mulaw8.F90
!||    usermat_solid   ../engine/source/materials/mat_share/usermat_solid.F
!||====================================================================
      SUBROUTINE mreploc(
     1   ANG,     R11,     R12,     R13,
     2   R21,     R22,     R23,     R31,
     3   R32,     R33,     RX,      RY,
     4   RZ,      SX,      SY,      SZ,
     5   TX,      TY,      TZ,      NEL,
     6   JSPH)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: JSPH
      my_real  ANG(MVSIZ,6),
     .R11(MVSIZ),R12(MVSIZ),R13(MVSIZ),R21(MVSIZ),R22(MVSIZ),R23(MVSIZ),
     .R31(MVSIZ),R32(MVSIZ),R33(MVSIZ),
     .   RX(MVSIZ)    ,RY(MVSIZ)    ,RZ(MVSIZ)    ,
     .   sx(mvsiz)    ,sy(mvsiz)    ,sz(mvsiz)    ,
     .   tx(mvsiz)    ,ty(mvsiz)    ,tz(mvsiz)  
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J
      my_real 
     .   S11, S12, S13, S21, 
     .   S22, S23, S31,
     .   S32, S33, RR,  RRD
C
 
      IF(jsph==0)THEN
        IF(n2d==0)THEN
          DO 100 i=1,nel
             rr=max(sqrt(rx(i)**2+ry(i)**2+rz(i)**2),em20)
             rx(i)=rx(i)/rr
             ry(i)=ry(i)/rr
             rz(i)=rz(i)/rr
 100      CONTINUE
C
          DO 105 i=1,nel
            tx(i)=ry(i)*sz(i)-rz(i)*sy(i)
            ty(i)=rz(i)*sx(i)-rx(i)*sz(i)
            tz(i)=rx(i)*sy(i)-ry(i)*sx(i)
            rr=max(sqrt(tx(i)**2+ty(i)**2+tz(i)**2),em20)
            tx(i)=tx(i)/rr
            ty(i)=ty(i)/rr
            tz(i)=tz(i)/rr
 105      CONTINUE
C
          DO 110 i=1,nel
             sx(i)=ty(i)*rz(i)-tz(i)*ry(i)
             sy(i)=tz(i)*rx(i)-tx(i)*rz(i)
             sz(i)=tx(i)*ry(i)-ty(i)*rx(i)
             rr=max(sqrt(sx(i)**2+sy(i)**2+sz(i)**2),em20)
             sx(i)=sx(i)/rr
             sy(i)=sy(i)/rr
             sz(i)=sz(i)/rr
 110      CONTINUE
        ELSE
C---------------------------------------------
C     EN 2D LES CONTRAINTES SONT :
C     1=YY 2=ZZ 3=TT 4=YZ 5=0 6=0
C     EN CONTRADICTION AVEC X=T
C     ATTENTION DANGER!
C---------------------------------------------
          DO 120 i=1,nel
              rr= max(sqrt(sy(i)**2+sz(i)**2),em20)
              rx(i)= sy(i)/rr
              ry(i)= sz(i)/rr
              rz(i)= zero
              sx(i)=-ry(i)
              sy(i)= rx(i)
              sz(i)= zero
              tx(i)= zero
              ty(i)= zero
              tz(i)= one     
 120      CONTINUE
        ENDIF
C
        DO i=1,nel
          s11=ang(i,1)
          s21=ang(i,2)
          s31=ang(i,3)
          s12=ang(i,4)
          s22=ang(i,5)
          s32=ang(i,6)
          s13=s21*s32-s31*s22
          s23=s31*s12-s11*s32
          s33=s11*s22-s21*s12
C
          r11(i) = s11*rx(i)+s21*sx(i)+s31*tx(i)
          r21(i) = s11*ry(i)+s21*sy(i)+s31*ty(i)
          r31(i) = s11*rz(i)+s21*sz(i)+s31*tz(i)
C           
          r12(i) = s12*rx(i)+s22*sx(i)+s32*tx(i)
          r22(i) = s12*ry(i)+s22*sy(i)+s32*ty(i)
          r32(i) = s12*rz(i)+s22*sz(i)+s32*tz(i)
C
          r13(i) = s13*rx(i)+s23*sx(i)+s33*tx(i)
          r23(i) = s13*ry(i)+s23*sy(i)+s33*ty(i)
          r33(i) = s13*rz(i)+s23*sz(i)+s33*tz(i)
        ENDDO
C
      ELSE
C
       DO i=1,nel
         r11(i)=ang(i,1)
         r21(i)=ang(i,2)
         r31(i)=ang(i,3)
         r12(i)=ang(i,4)
         r22(i)=ang(i,5)
         r32(i)=ang(i,6)
         r13(i)=r21(i)*r32(i)-r31(i)*r22(i)
         r23(i)=r31(i)*r12(i)-r11(i)*r32(i)
         r33(i)=r11(i)*r22(i)-r21(i)*r12(i)
       END DO
C
      END IF
C
      RETURN
      END