Esope source files

   1 : C AJOUEL    SOURCE    FANDEUR   13/01/29    21:15:01     7683           
   2 : C         
   3 :       SUBROUTINE AJOUEL(NODE,NBNODE,ityp1,IMELE,IEL)
   4 : C--------------------------------------------------------------
   5 : C
   6 : C FONCTION :
   7 : C     Verifie l'existence d'un element (defini par ses noeuds)
   8 : C     en tenant compte de l'eventuelle permutation des noeuds
   9 : C     et Ajoute cet element au maillage si non existence
  10 : C
  11 : C NODE  : ENTREE  : Tableau des noeudsde dimension NBNODE
  12 : C ityp1 : ENTREE  : ITYPEL (type d'element)
  13 : C IMELE : E/S   :  Pointeur vers MELEME (actif et modifiable en E/S)
  14 : C IEL : ENTREE  :  Numero de l element qu'on propose de créer
  15 : C IEL : SORTIE  :  Numero de l element effectivement créé ou retrouvé 
  16 : C
  17 : C APPELE PAR : INTGEO
  18 : C
  19 : C CREATION : BP 2012/09/11
  20 : C
  21 : C--------------------------------------------------------------
  22 :       IMPLICIT INTEGER(I-N)
  23 :       IMPLICIT REAL*8(A-H,O-Z)
  24 :       INTEGER NODE(NBNODE)
  25 :       INTEGER IVU(NBNODE)
  26 : C
  27 : -INC CCOPTIO
  28 : -INC SMELEME
  29 : 
  30 : c       write(ioimp,fmt="('ajouel(',I5,I5,I3,I3,I7,I3)")
  31 : c      &NODE(1),NODE(2),NBNODE,ityp1,IMELE,IEL
  32 :       
  33 : C--------------------------------------------------------------
  34 : C     PRELIMINAIRES et initialisation
  35 :       do iii=1,NBNODE
  36 :         IVU(iii)=0
  37 :       enddo
  38 : c     on commence par le 1er noeud a cherche
  39 :       inode=1
  40 :       nono = NODE(inode)
  41 :      
  42 : C--------------------------------------------------------------
  43 : C     ON RECHERCHE LE POINT (idem ELIM)
  44 :       
  45 : c     maillage a verifier (actif et modifiable en entrée)
  46 :       IPT1   = IMELE
  47 : c     segact,IPT1
  48 : 
  49 :       NBSOUS = IPT1.LISOUS(/1)
  50 : c     dans le cas d un meleme complexe,
  51 : c==== il faut boucler sur les differents type d elements ==== 
  52 :       DO 100 ISOUS=1,max(1,NBSOUS)
  53 :       
  54 :         if (NBSOUS.ne.0)  then 
  55 :           MELEME=IPT1.LISOUS(isous)
  56 : c           segact,meleme
  57 :         else
  58 :           MELEME=IPT1
  59 :         endif
  60 :         
  61 :         if(ITYPEL.ne.ityp1) goto 100
  62 :         NBNN = NUM(/1)
  63 :         NBEL = NUM(/2)
  64 : C ici MELEME est un maillage simple (NSOUS = 0)
  65 :         NBSOUS = LISOUS(/1)
  66 :         NBREF  = LISREF(/1)
  67 : c         write(ioimp,*) 'ajouel: on a trouvé le bon itypel=',ityp1
  68 : c      &  ,' associe au maillage de dim=',NBNN,NBEL
  69 :         
  70 :         if(NBNN.ne.NBNODE) then
  71 : c         goto 100
  72 : c         write(ioimp,*)'ajouel: ITYPEL et nombre de noeuds incompatibles'
  72 :           call erreur(21)
  73 :         endif
  74 : c       on a le bon nombre de noeuds : 
  75 : c       on cherche si l element fourni existe deja  
  76 :         
  77 : c         write(ioimp,*)'ajouel: on cherche le ',inode,'ieme noeud=',nono
  78 : 
  79 :         
  80 : c       boucle sur les element du maillage
  81 :         DO 71 J=1,NBEL
  82 : 
  83 : c         on remet a zero si IVU a bougé 
  84 :           if(inode.gt.1) then
  85 :             do iii=1,(inode-1)
  86 :               IVU(iii)=0
  87 :             enddo
  88 : c           on commence par le 1er noeud
  89 :             inode=1
  90 :             nono = NODE(inode)
  91 :           endif
  92 :           
  93 : c         boucle sur les noeuds 
  94 :  72       I=0
  95 :  73       I=I+1
  96 :             ii=NUM(I,J)
  97 : c             write(ioimp,*) 'on teste ',ii,' =element NUM(',I,J,')'
  98 :             IF(ii.eq.0) GOTO 71
  99 : c           on a trouvé nono !   
 100 :             IF(ii.eq.nono) THEN
 101 : c               write(ioimp,*) 'on a trouvé ',ii,' element NUM(',I,J,')'
 102 :               IVU(inode)=I
 103 :               if(inode.eq.NBNODE) goto 700
 104 : c             si on n a pas fini on continue dans cet element
 105 :               inode = inode +1
 106 :               nono = NODE(inode)
 107 :               goto 72
 108 :             ENDIF
 109 : c           si on a fini de boucler sur les noeuds => element suivant
 110 :             if(I.eq.NBNN) goto 71
 111 :             goto 73
 112 : 
 113 :  71     CONTINUE
 114 : 
 115 :  
 116 : C--------------------------------------------------------------
 117 : c       si élément non trouvé on le crée à la IEL ieme place
 118 :         if(NBEL.lt.IEL) then
 119 :           NBELEM=IEL
 120 : C ici MELEME est un maillage simple (NSOUS = 0)
 121 :           NBSOUS = LISOUS(/1)
 122 :           NBREF  = LISREF(/1)
 123 :           segadj,MELEME
 124 :         endif
 125 :         if(NUM(1,IEL).ne.0) then
 126 :           write(ioimp,*) 'ajouel : on écrase un élément existant !'
 127 :         endif
 128 :         do inode=1,NBNODE
 129 :           NUM(inode,IEL)=NODE(inode)
 130 :         enddo
 131 :         
 132 :         RETURN
 133 :       
 134 : C--------------------------------------------------------------
 135 : c       on a trouvé l element deja existant
 136 :  700    CONTINUE
 137 :         IEL = J
 138 : c         write(ioimp,*) 'on a trouvé l element deja existant ',IEL
 139 :       
 140 : 
 141 :  100  CONTINUE
 142 : c==== fin de boucle sur les differents type d elements ==== 
 143 : 
 144 :       RETURN
 145 : 
 146 :       END
 147 : 
 148 :