insurf_dx.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_dx (nrt, msn, ir, irect, noint, surf_nodes, itab, msv, id, titr, ntag, s_msv, sirect, x, stiff_stat)

Function/Subroutine Documentation

insurf_dx()

subroutine insurf_dx	(	integer	nrt,
		integer	msn,
		integer	ir,
		integer, dimension(4,sirect/4)	irect,
		integer, intent(in)	noint,
		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,
		dimension(3,numnod), intent(inout)	x,
		dimension(3), intent(inout)	stiff_stat )

Definition at line 31 of file insurf_dx.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     LECTURE DES SURFACES ET DECOMPTE DES SEGMENTS
C           ENTREE : 
C                    NRT NOMBRE DE RENSEIGNEMENTS A LIRE
C           SORTIE : 
C                    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
      my_real, INTENT(INOUT) :: x(3,numnod)
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER, DIMENSION(2*NUMNOD+1), INTENT(INOUT) ::  NTAG
      my_real, INTENT(INOUT) :: stiff_stat(3)
      INTEGER,INTENT(IN) :: NOINT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,K4
      my_real :: surf, s2n(3), d1(3), d2(3), surf_max, surf_min, surf_mean, stval,vel
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
      surf_min = ep20
      surf_max = zero
      surf_mean = zero
      DO i=1,nrt                                                     
        IF(irect(3,i)==irect(4,i)) THEN
          d1(1)=x(1,irect(1,i))-x(1,irect(3,i))
          d1(2)=x(2,irect(1,i))-x(2,irect(3,i))
          d1(3)=x(3,irect(1,i))-x(3,irect(3,i))                    
          d2(1)=x(1,irect(2,i))-x(1,irect(1,i))
          d2(2)=x(2,irect(2,i))-x(2,irect(1,i))
          d2(3)=x(3,irect(2,i))-x(3,irect(1,i))
          s2n(1) =   d1(2)*d2(3)-d1(3)*d2(2)
          s2n(2) = - d1(1)*d2(3)+d1(3)*d2(1)
          s2n(3) =   d1(1)*d2(2)-d1(2)*d2(1)
          surf = s2n(1)*s2n(1) + s2n(2)*s2n(2) + s2n(3)*s2n(3)
          surf = sqrt(fourth*surf)        
        ELSE
          d1(1)=x(1,irect(1,i))-x(1,irect(3,i))
          d1(2)=x(2,irect(1,i))-x(2,irect(3,i))
          d1(3)=x(3,irect(1,i))-x(3,irect(3,i))                    
          d2(1)=x(1,irect(2,i))-x(1,irect(4,i))
          d2(2)=x(2,irect(2,i))-x(2,irect(4,i))
          d2(3)=x(3,irect(2,i))-x(3,irect(4,i))
          s2n(1) =   d1(2)*d2(3)-d1(3)*d2(2)
          s2n(2) = - d1(1)*d2(3)+d1(3)*d2(1)
          s2n(3) =   d1(1)*d2(2)-d1(2)*d2(1)
          surf = s2n(1)*s2n(1) + s2n(2)*s2n(2) + s2n(3)*s2n(3)
          surf = sqrt(fourth*surf)
        ENDIF 
        
        surf_max = max(surf_max,surf)
        surf_min = min(surf_min,surf)
        surf_mean = surf_mean + surf/real(nrt)
                                                      
      ENDDO   
 
      stval = stiff_stat(1)*stiff_stat(2)*surf_mean/stiff_stat(3)
      
      stiff_stat(1) = -stval
      
      
      WRITE(iout,1000)noint
      WRITE(iout,3021)stval, stiff_stat(2),  surf_mean, surf_min, surf_max
      IF(ipri>=1) 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 
                                                    
C------------------------------------------------------------
      RETURN
1000  FORMAT(/1x,'  INTERFACE NUMBER :',i10,1x,a)      
3021  FORMAT(
     .    '    COMPUTED STIFFNESS VALUE. . . . . . . . . . ',1pg20.13,/,
     .    '                      . . .USING DENSITY. . . . ',1pg20.13,/,     
     .    '                      . . .USING MEAN AREA. . . ',1pg20.13,/,          
     .    '                      . . . . . . . . .MIN. . . ',1pg20.13,/,        
     .    '                      . . . . . . . . .MAX  . . ',1pg20.13)