insurf.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	insurf (nrt, msn, ir, irect, surf_nodes, itab, msv, id, titr, ntag, s_msv, sirect, type18)

Function/Subroutine Documentation

insurf()

subroutine insurf	(	integer	nrt,
		integer	msn,
		integer	ir,
		integer, dimension(4,sirect/4)	irect,
		integer, dimension(nrt,4)	surf_nodes,
		integer, dimension(numnod)	itab,
		integer, dimension(s_msv)	msv,
		integer	id,
		character(len=nchartitle)	titr,
		integer, dimension(2*numnod+1), intent(inout)	ntag,
		integer, intent(in)	s_msv,
		integer, intent(in)	sirect,
		logical, intent(inout)	type18 )

Definition at line 36 of file insurf.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      USE format_mod , ONLY : fmw_4i
C-----------------------------------------------
C     READING SURFACE AND SEGMENT NUMBERING
C           INPUT :   NRT
C           OUTPUT :  IRECT
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-----------------------------------------------
#include      "units_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NRT, IR,MSN
      INTEGER,INTENT(IN) :: S_MSV,SIRECT
      INTEGER IRECT(4,SIRECT/4), ITAB(NUMNOD), MSV(S_MSV),SURF_NODES(NRT,4)
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER, DIMENSION(2*NUMNOD+1), INTENT(INOUT) ::  NTAG
      LOGICAL, INTENT(INOUT) :: TYPE18
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N23, IT, J, NSGOLD,ITG,K,L,IR1,K4
      INTEGER OLDIRECT,OLDIRECT1
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C=======================================================================
      i=1                                                   
      l=1                                                   
      DO j=1,nrt                                            
          DO k=1,4                                          
            irect(k,j)=surf_nodes(j,k)
            l=l+1                                           
          ENDDO                                             
          l=l+2                                             
      ENDDO                                                 
C     SEGMENTS 3 NOEUDS MISE DE N4 = N3                     
      DO i=1,nrt                                            
        IF(irect(4,i)==0) irect(4,i)=irect(3,i)           
        IF(irect(1,i)==irect(4,i)) THEN
           oldirect=irect(4,i)
           irect(4,i)=irect(3,i)
           CALL ancmsg(msgid=106,msgtype=msgwarning,anmode=aninfo_blind_2,
     .                 i1=id,
     .                 c1=titr,
     .                 i2=irect(1,i),
     .                 i3=irect(2,i),
     .                 i4=irect(3,i),
     .                 i5=oldirect,
     .                 i6=irect(1,i),
     .                 i7=irect(2,i),
     .                 i8=irect(3,i),
     .                 i9=irect(4,i))
        ELSEIF(irect(2,i)==irect(3,i)) THEN               
           oldirect=irect(3,i)
           irect(3,i)=irect(4,i)                            
           CALL ancmsg(msgid=106,msgtype=msgwarning,anmode=aninfo_blind_2,
     .                 i1=id,
     .                 c1=titr,
     .                 i2=irect(1,i),
     .                 i3=irect(2,i),
     .                 i4=oldirect,
     .                 i5=irect(4,i),
     .                 i6=irect(1,i),
     .                 i7=irect(2,i),
     .                 i8=irect(3,i),
     .                 i9=irect(4,i))
        ELSEIF(irect(1,i)==irect(2,i)) THEN
           oldirect=irect(2,i)
           oldirect1=irect(3,i)
           irect(2,i)=irect(3,i)                            
           irect(3,i)=irect(4,i)
           CALL ancmsg(msgid=106,msgtype=msgwarning,anmode=aninfo_blind_2,
     .                 i1=id,
     .                 c1=titr,
     .                 i2=irect(1,i),
     .                 i3=oldirect,
     .                 i4=oldirect1,
     .                 i5=irect(4,i),
     .                 i6=irect(1,i),
     .                 i7=irect(2,i),
     .                 i8=irect(3,i),
     .                 i9=irect(4,i))
        ENDIF                                               
      ENDDO                                                 
C-------    
      IF(ir/=0 .AND. ir/=2)THEN
        DO j=1,nrt                 
          ir1=irect(1,j)           
          irect(1,j)=irect(2,j)    
          irect(2,j)=ir1           
          ir1=irect(3,j)           
          irect(3,j)=irect(4,j)    
          irect(4,j)=ir1           
        ENDDO                      
      ENDIF                        
      n23=4                        
C-------          
      IF(ipri>=1 .AND. .NOT.type18) THEN                                              
        WRITE(iout,'(/,A,/)')' SEGMENTS USED FOR SURFACE DEFINITION'  
        k=1                                                           
        k4=4                                                          
        IF(n2d/=0)k4=2                                              
        DO i=1,nrt                                                    
          WRITE(iout,fmt=fmw_4i)(itab(irect(k,i)),k=1,k4)             
        ENDDO                                                         
      ENDIF                                                          
      IF (nrt/=0) CALL count3(irect,msv,msn,nrt,ntag)                      
C------------------------------------------------------------
      RETURN