Esope source files

   1 : C TRJQUA    SOURCE    CHAT      05/01/13    03:50:47     5004           
   2 :       SUBROUTINE TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,J,IEL,INOELO,TLI)
   3 : C                                                                               
   4 : C**********************************************************************         
   5 : C                                                                               
   6 : C   OBJET  : CE SOUS-PROGRAMME CALCULE L'APPARTENANCE DE POINTS A UN            
   7 : C   -----    ELEMENT QUADRILATERE D'UN MAILLAGE M1.                             
   8 : C       issu de TRIOEF utilise dans le calcul des trajectoires
   9 : C                                                                               
  10 : C   ARGUMENTS:                                                                  
  11 : C   ---------                                                                   
  12 : C                                                                               
  13 : C   ENTREE  :  IZNOEU = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES           
  14 : C                       ET LES NUMEROS DES NOEUDS DE L ELEMENT                  
  15 : C              IZTRAV = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES           
  16 : C                       DES POINTS DONT ON CHERCHE L'APPARTENANCE               
  17 : C              IZAPAR = POINTEUR DU SEGMENT QUI CONTIENDRA LES                  
  18 : C                       APPARTENANCES                                           
  19 : C              NPAPAR = NOMBRE DE POINTS APPARTENANT A UN ELEMENT               
  20 : C              IEL    = NUMERO GLOBAL DE L'ELEMENT DANS LE MAILLAGE             
  21 : C              J      = NUMERO DU POINT TRAITE                                  
  22 : C                                                                               
  23 : C              INOELO = NUMERO LOCAL SI LE POINT CHERCHE EST UN NOEUD
  24 : C                       DU TRIANGLE CONSIDERE
  25 : C              TLI    COORDONNEES BARYCENTRIQUES DU POINT CONSIDERE
  26 : C                                                                               
  27 : C***********************************************************************        
  28 : C                                                                               
  29 :       IMPLICIT INTEGER(I-N)
  30 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  31 :       DIMENSION X(2),TLI(*)
  32 : C                                                                               
  33 :       SEGMENT IZAPAR 
  34 :            INTEGER IAPAR(4,NPT2)
  35 :       ENDSEGMENT
  36 : C                                                                               
  37 :       SEGMENT IZTRAV
  38 :            REAL*8  COOR(NDIM,NPART)
  39 :       ENDSEGMENT
  40 :       SEGMENT  IZNOEU 
  41 :             REAL*8 XELE(IDIM,NOEL)  
  42 :             INTEGER NOEGLO(NOEL)
  43 :       ENDSEGMENT
  44 :       DIMENSION XELTRI(2,6),IDET3(3,2),                                         
  45 :      *          IDET67(6,2),NUARET(3,2),NOEAR1(9),NOEAR2(9)
  46 : C                                                                               
  47 : C                                                                               
  48 : C                                                                               
  49 :       DATA IDET3/2,3,1, 4,1,3/                                                  
  50 :       DATA IDET67/3,4,5,9,1,2, 7,8,1,9,5,6/                                     
  51 :       DATA NUARET/2,0,1, 4,0,3/
  52 :       DATA NOEAR1/4,1,2,3,0,0,0,0,0/
  53 :       DATA NOEAR2/4,1,1,2,2,3,3,4,0/
  54 : C                                                                               
  55 :       IDIM=XELE(/1)
  56 :       NOEL=XELE(/2)
  57 :       IF(NOEL.GT.4)GO TO 50                                                     
  58 : C                                                                               
  59 : C---  CAS QUA4                                                                  
  60 : C                                                                               
  61 : C                                                                               
  62 : C***  DECOUPAGE DU QUA4 EN 2 TRI3 ET RECHERCHE DE L'APPARTENANCE DES            
  63 : C***  POINTS A CHACUN DES TRI3.                                                 
  64 : C                                                                               
  65 :       DO 40 I=1,2                                                               
  66 :       ITRI=I                                                                    
  67 : C                                                                               
  68 : C                                                                               
  69 :       DO 20 K=1,3                                                               
  70 :       IN=IDET3(K,ITRI)                                                          
  71 :       DO 10 L=1,2                                                               
  72 :       XELTRI(L,K)=XELE(L,IN)
  73 :   10  CONTINUE                                                                  
  74 :   20  CONTINUE                                                                  
  75 : C                                                                               
  76 : C                                                                               
  77 : C                                                                               
  78 : C     WRITE(6,*)'CALQUA IAPAR ',J,IAPAR(1,J)
  79 :       IF(IAPAR(1,J).NE.0) GO TO 9999                                            
  80 :       X(1)=COOR(1,J)                                                            
  81 :       X(2)=COOR(2,J)                                                            
  81 :       CALL APAT3(X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
  82 : C     WRITE(6,*)'CALQUA APAT3',IELEM,IARTRI,INOTRI
  83 : C     WRITE(6,*)' IELEM ',IELEM                                                 
  84 :       IF(IELEM.EQ.0) GO TO 40                                                   
  85 : C                                                                               
  86 : C---  LE POINT APPARTIENT A L'ELEMENT                                           
  87 : C                                                                               
  88 :       NPAPAR=NPAPAR+1                                                           
  89 :       IAPAR(1,J)=IEL                                                            
  90 : C                                                                               
  91 : C---  APPARTENANCE A UNE ARETE DU QUA4                                          
  92 : C                                                                               
  93 :       IF(IARTRI.EQ.0) GO TO 9999                                                
  94 :       IAPAR(3,J)=NUARET(IARTRI,ITRI)                                            
  95 : C                                                                               
  96 : C---  APPARTENANCE A UN NOEUD DU QUA4                                           
  97 : C                                                                               
  98 :       IF(INOTRI.EQ.0) GO TO 9999                                                
  99 :       INOELO=IDET3(INOTRI,ITRI)                                                 
 100 :       IAPAR(3,J)=NOEAR1(INOELO)                                                 
 101 :       IAPAR(4,J)=NOEGLO(INOELO)                                                 
 102 :       GO TO 9999                                                                
 103 :    40 CONTINUE                                                                  
 104 :       GO TO 9999                                                                
 105 : C                                                                               
 106 : C---  CAS QUA8-QUA9                                                             
 107 : C                                                                               
 108 :    50 CONTINUE                                                                  
 109 :       IF(NOEL.NE.8) GO TO 60                                                    
 110 : C                                                                               
 111 : C***  CALCUL DES COORDONNEES DU POINT MILIEU DE L'ELEMENT POUR GENERER          
 112 : C***  UN QUA9                                                                   
 113 : C                                                                               
 114 :       XELE(1,9)=0.5D0*(XELE(1,1)+XELE(1,3))
 115 :       XELE(2,9)=0.5D0*(XELE(2,3)+XELE(2,5))
 116 :    60 CONTINUE                                                                  
 117 : C                                                                               
 118 : C***  DECOUPAGE DU QUA9 EN 2 TRI6 ET RECHERCHE DE L'APPARTENANCE DES            
 119 : C***  POINTS A CHACUN DES TRI6.                                                 
 120 : C                                                                               
 121 :       DO 80 I=1,2                                                               
 122 :       ITRI=I                                                                    
 123 : C                                                                               
 124 : C                                                                               
 125 :       DO 120 K=1,6                                                              
 126 :       IN=IDET67(K,ITRI)                                                         
 127 :       DO 110 L=1,2                                                              
 128 :       XELTRI(L,K)=XELE(L,IN)
 129 :  110  CONTINUE                                                                  
 130 :  120  CONTINUE                                                                  
 131 : C                                                                               
 132 : C                                                                               
 133 : C                                                                               
 134 :       IF(IAPAR(1,J).NE.0) GO TO 9999                                            
 135 :       X(1)=COOR(1,J)                                                            
 136 :       X(2)=COOR(2,J)                                                            
 136 :       CALL APAT67(6,X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
 137 :       IF(IELEM.EQ.0) GO TO 80                                                   
 138 : C                                                                               
 139 : C---  LE POINT APPARTIENT A L'ELEMENT                                           
 140 : C                                                                               
 141 :       NPAPAR=NPAPAR+1                                                           
 142 :       IAPAR(1,J)=IEL                                                            
 143 : C                                                                               
 144 : C---  APPARTENANCE A UNE ARETE DU QUA9                                          
 145 : C                                                                               
 146 :       IF(IARTRI.EQ.0) GO TO 9999                                                
 147 :       IAPAR(3,J)=NUARET(IARTRI,ITRI)                                            
 148 : C                                                                               
 149 : C---  APPARTENANCE A UN NOEUD DU QUA8 OU QUA9                                   
 150 : C                                                                               
 151 :       IF(INOTRI.EQ.0) GO TO 9999                                                
 152 :       INOELO=IDET67(INOTRI,ITRI)                                                
 153 :       IF(INOELO.EQ.9.AND.NOEL.EQ.8) GO TO 9999                                  
 154 :       IAPAR(3,J)=NOEAR2(INOELO)                                                 
 155 :       IAPAR(4,J)=NOEGLO(INOELO)                                                 
 156 :       GO TO 9999                                                                
 157 :    80 CONTINUE                                                                  
 158 : C                                                                               
 159 : C                                                                               
 160 :  9999 CONTINUE
 161 :       RETURN
 162 :       END                                                                       
 163 :