i7err3.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/.
!||====================================================================
!||    i7err3                 ../starter/source/interfaces/inter3d1/i7err3.F
!||--- called by ------------------------------------------------------
!||    i20ini3                ../starter/source/interfaces/inter3d1/i20ini3.F
!||    inint3                 ../starter/source/interfaces/inter3d1/inint3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.f
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i7err3(
     1         X       ,NRTM    ,IRECT   ,NOINT   ,ITAB,ID,TITR,
     2         IX1      ,IX2    ,IX3    ,IX4    ,X1     ,
     3         X2       ,X3     ,X4     ,Y1     ,Y2     ,
     4         Y3       ,Y4     ,Z1     ,Z2     ,Z3     ,
     5         Z4       ,N1     ,N2     ,N3     ,X0     ,
     6         Y0       ,Z0     ,XN1    ,YN1    ,ZN1    ,
     7         XN2      ,YN2    ,ZN2    ,XN3    ,YN3    ,
     8         ZN3      ,XN4    ,YN4    ,ZN4      )
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   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-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NRTM, IRECT(4,*), NOINT, ITAB(*)
      my_real
     .        X(3,*)
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER, DIMENSION(MVSIZ), INTENT(OUT) :: IX1,IX2,IX3,IX4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn1,yn1,zn1
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn2,yn2,zn2
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn3,yn3,zn3
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn4,yn4,zn4
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, IDEB
C     REAL
      my_real :: an
      my_real, DIMENSION(MVSIZ) :: xx1,yy1,zz1
      my_real, DIMENSION(MVSIZ) :: xx2,yy2,zz2
      my_real, DIMENSION(MVSIZ) :: xx3,yy3,zz3
      my_real, DIMENSION(MVSIZ) :: xx4,yy4,zz4
C-----------------------------------------------
C
      ideb=0
      DO WHILE(ideb<nrtm)
C
       DO i=1,min(mvsiz,nrtm-ideb)
        j=ideb+i
        ix1(i)=irect(1,j)
        ix2(i)=irect(2,j)
        ix3(i)=irect(3,j)
        ix4(i)=irect(4,j)
        x1(i) =x(1,ix1(i))
        y1(i) =x(2,ix1(i))
        z1(i) =x(3,ix1(i))
        x2(i) =x(1,ix2(i))
        y2(i) =x(2,ix2(i))
        z2(i) =x(3,ix2(i))
        x3(i) =x(1,ix3(i))
        y3(i) =x(2,ix3(i))
        z3(i) =x(3,ix3(i))
        x4(i) =x(1,ix4(i))
        y4(i) =x(2,ix4(i))
        z4(i) =x(3,ix4(i))
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
        y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
        z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
C
        xx1(i) = x1(i)-x0(i)
        xx2(i) = x2(i)-x0(i)
        xx3(i) = x3(i)-x0(i)
        xx4(i) = x4(i)-x0(i)
        yy1(i) = y1(i)-y0(i)
        yy2(i) = y2(i)-y0(i)
        yy3(i) = y3(i)-y0(i)
        yy4(i) = y4(i)-y0(i)
        zz1(i) = z1(i)-z0(i)
        zz2(i) = z2(i)-z0(i)
        zz3(i) = z3(i)-z0(i)
        zz4(i) = z4(i)-z0(i)
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
        yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
        zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
        n1(i)=xn1(i)
        n2(i)=yn1(i)
        n3(i)=zn1(i)
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
        yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
        zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
        n1(i)=n1(i)+xn2(i)
        n2(i)=n2(i)+yn2(i)
        n3(i)=n3(i)+zn2(i)
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        IF(ix3(i)/=ix4(i)) THEN
         xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
         yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
         zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
         n1(i)=n1(i)+xn3(i)
         n2(i)=n2(i)+yn3(i)
         n3(i)=n3(i)+zn3(i)
        ELSE
         xn3(i)=zero
         yn3(i)=zero
         zn3(i)=zero
        ENDIF
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
        yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
        zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
        n1(i)=n1(i)+xn4(i)
        n2(i)=n2(i)+yn4(i)
        n3(i)=n3(i)+zn4(i)
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
        n1(i)=n1(i)/an
        n2(i)=n2(i)/an
        n3(i)=n3(i)/an
       ENDDO
C
       DO i=1,min(mvsiz,nrtm-ideb)
        x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
        z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
C
        IF(z0(i)==zero.AND.x0(i)==zero)THEN
          CALL ancmsg(msgid=558,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=id,
     .                c1=titr,
     .                i2=itab(ix1(i)),
     .                i3=itab(ix2(i)),
     .                i4=itab(ix3(i)),
     .                i5=itab(ix4(i)))
        ENDIF
       ENDDO
C
       ideb=ideb+min(mvsiz,nrtm-ideb)
      ENDDO
C
      RETURN
      END