i12tid3.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i12tid3 (x, irect, crst, msr, nsv, iloc, irtl, nsn, itab, alp, id, titr)

Function/Subroutine Documentation

i12tid3()

subroutine i12tid3	(	dimension(3,numnod), intent(in)	x,
		integer, dimension(4,*), intent(in)	irect,
		dimension(2,*), intent(inout)	crst,
		integer, dimension(*), intent(in)	msr,
		integer, dimension(*), intent(in)	nsv,
		integer, dimension(*), intent(in)	iloc,
		integer, dimension(*), intent(in)	irtl,
		integer, intent(in)	nsn,
		integer, dimension(*), intent(in)	itab,
		intent(in)	alp,
		integer, intent(in)	id,
		character(len=nchartitle), intent(inout)	titr )

Definition at line 34 of file i12tid3.F.

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