Esope source files

   1 : C DEPEN3    SOURCE    CHAT      09/10/09    21:17:04     6519           
   2 :            
   3 :       SUBROUTINE depen3 (iri2,iri1)  
   4 : c====================================================================
   5 : c   transformation d une matrice de relations en matrice de dependance
   6 : C  
   7 : c     entrees:
   8 : c           mrigid  rigidité   [C]  de dependance  cree par  rela   
   9 : c     sorties: 
  10 : C           ri1   matrice de dependence 
  11 : C 
  12 : C      on conserve dans irigel(8,irig) le pointeur sur la matrice accro
  13 : C    d origine  
  14 : C      
  15 : c====================================================================        
  16 :       IMPLICIT INTEGER(I-N)
  17 :       IMPLICIT REAL*8(A-H,O-Z)
  18 : -INC SMRIGID
  19 : -INC SMELEME
  20 : -INC SMCOORD
  21 : -INC CCOPTIO
  22 : -INC CCGEOME
  23 : -INC CCHAMP
  24 : -INC SMLMOTS 
  25 : C
  26 :       mrigid=iri2 
  27 : *      write(6,*) ' entree dans depen3'
  27 : *      call prrigi(mrigid)        
  28 :       SEGACT MRIGID
  29 : C              
  30 :        segini , ri1=mrigid
  31 :        iri1= ri1         
  32 :        ri1.imgeo1=0
  33 :        ri1.imgeo2=0
  34 :        nrige = 8
  35 :        nrigel=irigel(/2)
  36 :        if( nrige.ne.ri1.irigel(/1)) segadj ri1
  37 :        idec=1 
  38 :        irigg=0
  39 :        do 100 irig = 1,irigel(/2)       
  40 : C   rectification des supports geometriques et matrices      
  41 :        meleme = irigel(1,irig)
  42 :        xmatri = irigel(4,irig)
  43 :        segact ,meleme ,xmatri
  44 :        nbnn = num(/1)-idec
  45 :        if (nbnn.eq.0) then
  46 :           segdes meleme,xmatri
  47 :           goto 100
  48 :        endif
  49 :        irigg=irigg+1
  50 :        nbelem=num(/2)
  51 :        nelrig = nbelem           
  52 :        nbsous=0
  53 :        nbref=0
  54 :        segini ,ipt1       
  55 :        segini,xmatr1=xmatri
  56 :        ri1.irigel(1,irigg)=ipt1
  57 :        ri1.irigel(4,irigg)=xmatr1
  58 :        ri1.coerig(irigg)=1.d0
  59 : C   on stocke ds irigel de 8 le meleme avec supports de LX       
  60 :        ri1.irigel(8,irigg)=meleme
  61 :        ipt1.itypel=28
  62 :        descr = irigel(3,irig)  
  63 :        segact descr        
  64 :        nligrp=lisinc(/2)-idec-1
  65 :        nligrd=2-idec       
  66 :        segini des1 
  67 :            nelrig=nbelem
  68 :            segadj xmatr1
  69 :        ri1.irigel(3,irigg) = des1
  70 :        do 110  iel=1,nbelem
  71 : *       xmatri=imattt(iel)
  72 : *       segact xmatri 
  73 :        do 111  ip=1,nbnn
  74 :        ipt1.num(ip,iel)=num(ip+idec,iel)          
  75 : 111    continue      
  76 : *       segini xmatr1
  77 : *       imatr1.imattt(iel) = xmatr1
  78 :        aa= re(1,2,iel)        
  79 :        do 121 ic = 1,nligrp 
  80 :        xmatr1.re(1,ic,iel)=(-re(1,ic+idec+1,iel)/aa)
  81 : 121    continue 
  82 : 120    continue 
  83 : *       segdes xmatri,xmatr1 
  84 : 110    continue  
  85 :        do 130 il=1,nligrp
  86 :        des1.lisinc(il)= lisinc(il+idec+1)
  87 :        des1.noelep(il)= noelep(il+idec+1)-1
  88 : 130    continue 
  89 :        des1.lisdua(1)= lisinc(2)
  90 :        des1.noeled(1)= noelep(2)-1
  91 : C      write(6,*) ' depen3 irigel(8,irig) ' ,ri1.irigel(8,irig)
  92 :        segdes ipt1,meleme,xmatr1,descr,des1,xmatri
  93 : 100    continue       
  94 :        nrigel=irigg
  95 :        nrige=ri1.irigel(/1)
  96 :        segadj ri1
  97 :       segdes ri1,mrigid   
  97 : *      call prrigi(ri1)    
  98 :       RETURN
  99 :       END
 100 : 
 101 :  
 102 :  
 103 :  
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 : 
 110 :  
 111 :  
 112 :  
 113 :  
 114 :  
 115 :  
 116 :  
 117 :  
 118 :