Download sfricr.eso

Back to the list

   1 : C SFRICR    SOURCE    CHAT      06/03/29    21:33:23     5360           
   2 :       SUBROUTINE SFRICR(IFR,NBIFR,IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >                   NOETRI,NBE,iarr)
   4 : C     ****************************************************************
   5 : C     OBJET : FRONTIERE (INTER MATERIAUX) CREEE DANS UN MAILLAGE  
   6 : C        AJOUT D'UN SOMMET, D'UNE ARETE OU D'UNE FACETTE A LA FRONTIERE
   7 : C        INTER-MATERIAUX.
   8 : C     EN ENTREE:
   9 : C      IFR    :  TABLEAU DES NOEUDS DE L'ELEMENT FRONTIERE
  10 : C      NBIFR  :  NOMBRE DE NOEUDS DE L'ELEMENT FRONTIERE
  11 : C      IDE    :  (1..3) DIMENSION DES ELEMENTS 
  12 : C      ITRNOE:  LES NOEUDS DES ELEMENTS
  13 : C      NBNMAX :  (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS 
  14 : C      ITRTRI:  LES VOISINS DES ELEMENTS
  15 : C      NBCMAX :  (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS 
  16 : C      NOETRI :  TABLEAU DES ELEMENTS INCIDENT AUX NOEUDS
  17 : C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
  18 : C     EN SORTIE: 
  19 : C      ITRTRI:  MIS A JOUR
  20 : C      iarr   :  CODE D'ERREUR 0 => OK, -1 => L'ELEMENT FRONTIERE
  21 : C                N'EXISTE PAS DANS LE MAILLAGE
  22 : C     CONDITION D'APPLICATION :      
  23 : C     ****************************************************************
  24 :       IMPLICIT INTEGER(I-N)
  25 :       INTEGER   IFR(*),NBIFR,iarr
  26 :       INTEGER   IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NOETRI(*),NBE 
  27 : C
  28 :       INTEGER   IT1, IT2, I1, I2 
  29 : C  
  30 :       iarr = 0 
  30 :       CALL SFRIDE(IFR,NBIFR,IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  31 :      >             NOETRI,NBE,IT1,IT2,I1,I2 )
  32 :       IF(( IT1 .EQ. 0 ) .AND. ( IT2 .EQ. 0 ))THEN
  33 : C       L'ARETE N'EXISTE PAS
  34 :         iarr = -1
  35 :         GOTO 999
  36 :       ENDIF
  37 :       IF(( IT1 .GT. 0 ) .AND. ( IT2 .GT. 0 ))THEN
  38 :         IF(ITRTRI((IT1-1)*NBCMAX+I1).GT.0)
  39 :      >  ITRTRI((IT1-1)*NBCMAX+I1) = -ITRTRI((IT1-1)*NBCMAX+I1)
  40 :         IF(ITRTRI((IT2-1)*NBCMAX+I2).GT.0)
  41 :      >  ITRTRI((IT2-1)*NBCMAX+I2) = -ITRTRI((IT2-1)*NBCMAX+I2)
  42 :       ENDIF
  43 :   999 END
  44 :  
  45 :  
  46 :  

© Cast3M 2003 - All rights reserved.
Disclaimer