Esope source files

   1 : C DUAL01    SOURCE    GOUNAND   11/06/14    21:15:14     7005           
   2 :       SUBROUTINE dual01(mrigid,ri1)
   3 : C a appeler dual  ulterieurement
   4 : c====================================================================
   5 : c     
   6 : c     entrees
   7 : c           mrigid  rigidité   [C]  de dependance  rela depend
   8 : c     sorties
   9 : C           ri1   [C] Transpose non symétrique
  10 : C     La différence par rapport à dual00, c'est que la matrice à
  11 : C     transposer n'est pas nécessairement symétrique.
  12 : c     
  13 : c====================================================================
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8(A-H,O-Z)
  16 :       CHARACTER*4 CMOT
  17 : *     
  18 : -INC SMRIGID
  19 : -INC SMELEME
  20 : -INC CCHAMP
  21 :       character*4 NOMM,NODUA 
  22 :       
  23 :       segment snomip
  24 :       character*4 nomip(0)
  25 :       endsegment
  26 :       segment snomda
  27 :       character*4 nomda(0)
  28 :       endsegment
  29 :       
  30 :       segment snomm
  31 :       character*4 nompi(nomip(/2)),nompa(nomda(/2))                    
  32 :       endsegment 
  33 : 
  34 :       SEGACT MRIGID      
  35 :       
  36 : C on en profite  pour recenser les inconnues en question (primales)
  37 : C  a voir
  38 :       segini snomip,snomda
  39 :       segact mrigid
  40 :       
  41 :       DO 1501 I=1,IRIGEL(/2)
  42 : *         MELEME=IRIGEL(1,I)
  43 : *         SEGACT MELEME
  44 :          DESCR=IRIGEL(3,I)
  45 :          SEGACT DESCR
  46 : C   attention ces matrices ne sont pas carrees  il faut 2 boucles
  47 : C          pour identifier les inconnues
  48 :          
  49 :          DO 1402 J=1,LISINC(/2)
  50 :             IF(nomip(/2).EQ.0) THEN
  51 :                nomip(**)=LISINC(J)
  52 :             ELSE
  53 :                DO 1406 K=1,nomip(/2)
  54 :                   IF(LISINC(J).EQ.nomip(K)) GO TO 1405
  55 :  1406          CONTINUE
  56 :                nomip(**)=LISINC(J)
  57 :  1405          CONTINUE
  58 :             ENDIF
  59 :  1402    CONTINUE
  60 : C     
  61 :          DO 1502 J=1,LISDUA(/2)
  62 :             IF(nomda(/2).EQ.0) THEN
  63 :                nomda(**)=LISDUA(J)
  64 :             ELSE
  65 :                DO 1506 K=1,nomda(/2)
  66 :                   IF(LISDUA(J).EQ.nomda(K)) GO TO 1505
  67 :  1506          CONTINUE
  68 :                nomda(**)=LISDUA(J)
  69 :  1505          CONTINUE
  70 :             ENDIF
  71 :  1502    CONTINUE 
  72 :          
  73 :  1501 CONTINUE 
  74 :       
  75 : C      tableau des correspondances
  76 : 
  77 :       segini snomm 
  78 :       
  79 :       do 325 il=1,nomip(/2)
  80 :          NOMM =nomip(IL)
  81 :          do 326 in = 1,lnomdd
  82 :             if (NOMM.EQ.NOMDD(in)) then 
  83 :                NOMPI(il) =NOMDU(in)
  84 :                goto 327
  85 :             endif   
  86 :  326     continue
  87 :          NOMPI(il)=NOMM
  88 :  327     continue
  89 :  325  continue
  90 :       
  91 :       do 425 il=1,nomda(/2)
  92 :          NOMM =nomda(IL)
  93 :          do 426 in = 1,lnomdd
  94 :             if (NOMM.EQ.NOMDU(in)) then 
  95 :                NOMPA(il) =NOMDD(in)
  96 :                goto 427
  97 :             endif   
  98 :  426     continue
  99 :          NOMPA(il)=NOMM
 100 :  427     continue
 101 :  425  continue
 102 : 
 103 :       
 104 : *      write(6,*) 'primales',(nomip(j),j=1,nomip(/2)),'sortie ' ,
 105 : *     &     ( nompi(j),j=1,nompi(/2))
 106 : *      
 107 : *      
 108 : *      write(6,*) 'duales  ',(nomda(j),j=1,nomda(/2)),'sortie ' ,
 109 : *     &     ( nompa(j),j=1,nompa(/2))
 110 : 
 111 : C on stoke le ddel en question en position ad-hoc
 112 : 
 113 :       nrigel=coerig(/1)
 114 :       segini , ri1
 115 : *      segini , ri1=mrigid 
 116 :       
 117 :       do 1700 ima=1,IRIGEL(/2)
 118 :          ri1.mtymat=mtymat
 119 :          ri1.coerig(ima)=coerig(ima)
 120 :          do 1750 iri =1,irigel(/1)
 121 :             if(iri.eq.3.or.iri.eq.4) goto 1750
 122 :             ri1.irigel(iri,ima)= IRIGEL(iri,ima)
 123 :  1750    continue
 124 :          
 125 :          descr = irigel(3,ima)
 126 :          
 127 :          nligrp = lisdua(/2)
 128 :          nligrd = lisinc(/2)               
 129 :          segini des1
 130 :          ri1.irigel(3,ima) = des1
 131 : C     
 132 :          do 1634 ik=1,lisinc(/2)
 133 :             nomm = lisinc(ik)
 134 :             do 1635 ij=1,nomip(/2)
 135 :                if(NOMM.eq.NOMIP(ij)) des1.lisdua(ik) = nompi(ij)
 136 :  1635       continue
 137 :             des1.noeled(ik)=noelep(ik)
 138 :  1634    continue
 139 : 
 140 :          do 1644 ik=1,lisdua(/2)
 141 :             nomm = lisdua(ik)
 142 :             do 1645 ij=1,nomda(/2)
 143 :                if(NOMM.eq.NOMDA(ij)) des1.lisinc(ik) = nompa(ij)
 144 :  1645       continue
 145 :             des1.noelep(ik)=noeled(ik)
 146 :  1644    continue
 147 :          segdes des1,descr
 148 : 
 149 :          if (irigel(7,ima).ne.0.or.nligrp.ne.nligrd) then
 150 :             XMATRI = IRIGEL(4,ima)
 151 :             segact XMATRI
 152 :             NELRIG=XMATRI.RE(/3)
 153 :             SEGINI xmatr1
 154 :             do i=1,nelrig
 155 :                do j=1,nligrp
 156 :                   do k=1,nligrd
 157 :                      xmatr1.re(k,j,i)=re(j,k,i)
 158 :                   enddo
 159 :                enddo
 160 :             enddo
 161 :             segdes xmatr1,xmatri
 162 :             ri1.irigel(4,ima)=xmatr1
 163 :          else 
 164 :             ri1.irigel(4,ima)=irigel(4,ima)
 165 :          endif
 166 :  1700 continue
 167 : 
 168 :       segdes ri1,mrigid 
 169 :       
 170 :       segsup ,snomm,snomip,snomda
 171 :       
 172 :       RETURN
 173 :       END
 174 : 
 175 :  
 176 :  
 177 :  
 178 :  
 179 :  
 180 :  
 181 :  
 182 :  
 183 :  
 184 :  
 185 :  
 186 :  
 187 :  
 188 :  
 189 :