i12tid3.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/.
!||====================================================================
!||    i12tid3                ../starter/source/interfaces/inter3d1/i12tid3.F
!||--- called by ------------------------------------------------------
!||    inint3                 ../starter/source/interfaces/inter3d1/inint3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.f
!||    inist3                 ../starter/source/interfaces/inter3d1/inist3.F
!||--- uses       -----------------------------------------------------
!||    format_mod             ../starter/share/modules1/format_mod.F90
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i12tid3(
     1                   X   , IRECT, CRST, MSR , NSV,
     2                   ILOC, IRTL , NSN , ITAB, ALP, 
     3                   ID  , TITR
     .                   )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      USE message_mod
      USE format_mod , ONLY : fmw_7i_2f
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C     TIED/SLIDING INTERFACE TYPE 12
C     (FLUID/FLUID)
C     COMPUTATION OF S,T (secnd node coordinates)
C     check if secnd is facing a main segment
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN)    :: NSN,ID
      INTEGER,INTENT(IN)    :: IRECT(4,*) , MSR(*), NSV(*), ILOC(*), IRTL(*),ITAB(*)
      my_real,INTENT(IN)    :: X(3,NUMNOD), ALP
      my_real,INTENT(INOUT) :: CRST(2,*)
      CHARACTER(LEN=NCHARTITLE),INTENT(INOUT) :: TITR
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "scr03_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: II, I, J, K, L, JJ, NN, IER
      my_real :: N1, N2, N3, SS, TT
      my_real :: XX1(4),XX2(4),XX3(4),XS1,YS1,ZS1,XC,YC,ZC
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      DO ii=1,nsn
        !secnd node data
        i   = nsv(ii)  !itab(i) is user node_id
        j   = iloc(ii)
        k   = msr(j)
        l   = irtl(ii) !main segment
        xs1 = x(1,i)
        ys1 = x(2,i)
        zs1 = x(3,i)
        !main segment data
        DO jj=1,4
          nn      = msr(irect(jj,l)) !itab( MSR(IRECT(JJ,L)) ) are main segment nodes
          xx1(jj) = x(1,nn)
          xx2(jj) = x(2,nn)
          xx3(jj) = x(3,nn)
              END DO
        
        CALL inist3(n1,n2,n3,ss,tt,ier,alp,xx1,xx2,xx3,xs1,ys1,zs1,xc,yc,zc)
        IF(ipri>=1)WRITE(iout,fmt=fmw_7i_2f) itab(i),itab(k),l,(itab(msr(irect(jj,l))),jj=1,4),ss,tt
        IF(ier==-1)THEN                          
          CALL ancmsg(msgid=1247,                  
     .                 msgtype=msgerror,           
     .                 anmode=anstop,              
     .                 i1=itab(i),i2=itab(k),i3=l, 
     .                 i4=itab(msr(irect(1,l))),   
     .                 i5=itab(msr(irect(2,l))),   
     .                 i6=itab(msr(irect(3,l))),   
     .                 i7=itab(msr(irect(4,l))),   
     .                 prmod=msg_cumu)             
        ELSE IF(ier==1)THEN                      
          CALL ancmsg(msgid=1248,                  
     .                 msgtype=msgwarning,         
     .                 anmode=aninfo_blind,        
     .                 i1=itab(i),i2=l,            
     .                 i3=itab(msr(irect(1,l))),   
     .                 i4=itab(msr(irect(2,l))),   
     .                 i5=itab(msr(irect(3,l))),   
     .                 i6=itab(msr(irect(4,l))),   
     .                 r1=ss,r2=tt,                
     .                 prmod=msg_cumu)             
        ENDIF                                      
        crst(1,ii) = ss
        crst(2,ii) = tt
      END DO !II=1,NSN
      CALL ancmsg(msgid=1247,
     .          msgtype=msgerror,
     .          anmode=anstop,
     .          i1=id,
     .          c1=titr,
     .          prmod=msg_print)
      CALL ancmsg(msgid=1248,
     .          msgtype=msgwarning,
     .          anmode=aninfo_blind,
     .          i1=id,
     .          c1=titr,
     .          prmod=msg_print) 
 
      RETURN
      END