Esope source files

   1 : C DUAL00    SOURCE    GOUNAND   12/07/23    21:15:00     7440           
   2 :            
   3 :       SUBROUTINE dual00(mrigid,ri1)
   4 : C a appeler dual  ulterieurement  
   5 : c====================================================================
   6 : c      
   7 : c     entrees
   8 : c           mrigid  rigidité   [C]  de dependance  rela depend  
   9 : c     sorties 
  10 : C           ri1   [C] Transpose  
  11 : c      
  12 : c====================================================================        
  13 :       IMPLICIT INTEGER(I-N)
  14 :       IMPLICIT REAL*8(A-H,O-Z)
  15 : 
  16 : -INC CCOPTIO
  17 : -INC CCGEOME
  18 : -INC CCHAMP
  19 : -INC SMRIGID
  20 : 
  21 :       character*4 NOMM
  22 :     
  23 :       segment snomip
  24 :         character*4 nomip(lnomip), nompi(lnomip)
  25 :       endsegment
  26 :       segment snomda
  27 :         character*4 nomda(lnomda), nompa(lnomda)
  28 :       endsegment
  29 :        
  30 : C on en profite  pour recenser les inconnues en question (primales)
  31 :       lnomip = 200
  32 :       lnomda = 200
  33 :       segini,snomip,snomda
  34 :       inomip = 0
  35 :       inomda = 0
  36 : 
  37 :       segact mrigid
  38 :       nrigel = IRIGEL(/2)
  39 : 
  40 :       DO 1501 I=1, NRIGEL
  41 :           DESCR=IRIGEL(3,I)
  42 :           SEGACT DESCR
  43 : C   attention ces matrices ne sont pas carrees  il faut 2 boucles
  44 : C          pour identifier les inconnues 
  45 :           DO 1402 J=1,LISINC(/2)
  46 :             NOMM = LISINC(J)
  47 :             DO 1406 K=1,inomip
  48 :               IF (NOMM.EQ.nomip(K)) GO TO 1405
  49 :  1406       CONTINUE
  50 :             IF (inomip.EQ.lnomip) THEN
  51 :               lnomip = lnomip + 200
  52 :               segadj,snomip
  53 :             ENDIF
  54 :             inomip = inomip + 1
  55 :             nomip(inomip)=NOMM
  56 :  1405       CONTINUE
  57 :  1402     CONTINUE
  58 : C
  59 :           DO 1502 J=1,LISDUA(/2)
  60 :             NOMM = LISDUA(J)
  61 :             DO 1506 K=1,inomda
  62 :               IF (NOMM.EQ.nomda(K)) GO TO 1505
  63 :  1506       CONTINUE
  64 :             IF (inomda.EQ.lnomda) THEN
  65 :               lnomda = lnomda + 200
  66 :               segadj,snomda
  67 :             ENDIF
  68 :             inomda = inomda + 1
  69 :             nomda(inomda)=NOMM
  70 :  1505       CONTINUE
  71 :  1502     CONTINUE 
  72 : 
  73 :  1501 CONTINUE 
  74 : 
  75 : C      tableau des correspondances
  76 : 
  77 :           do 325 il=1,inomip
  78 :           NOMM =nomip(IL)
  79 :           do 326 in = 1,lnomdd
  80 :           if (NOMM.EQ.NOMDD(in)) then 
  81 :           NOMPI(il) =NOMDU(in)
  82 :           goto 327
  83 :           endif   
  84 : 326       continue
  85 : C          nompi(il) = '    '
  86 :           nompi(il) = NOMM
  87 : 327       continue
  88 : 325       continue
  89 :  
  90 :           do 425 il=1,inomda
  91 :           NOMM =nomda(IL)
  92 :           do 426 in = 1,lnomdd
  93 :           if (NOMM.EQ.NOMDD(in)) then 
  94 :           NOMPA(il) =NOMDU(in)
  95 :           goto 427
  96 :           endif   
  97 : 426       continue
  98 : C          nompa(il) = '    '
  99 :           nompa(il) = NOMM
 100 : 427       continue
 101 : 425       continue
 102 : 
 103 : C       write(ioimp,*) 'primales',(nomip(j),j=1,inomip),'sortie ' ,
 104 : C     &   ( nompi(j),j=1,inomip)
 105 : C       write(ioimp,*) 'duales  ',(nomda(j),j=1,inomda),'sortie ' ,
 106 : C     &   ( nompa(j),j=1,inomda)
 107 : 
 108 : C on stoke le ddel en question en position ad-hoc 
 109 : 
 110 :        segini , ri1=mrigid 
 111 :     
 112 :        do 1700 ima=1,NRIGEL
 113 :    
 114 :        descr = irigel(3,ima)
 115 :        
 116 :        nligrp = lisdua(/2)
 117 :        nligrd = lisinc(/2)               
 118 :        segini,des1
 119 :        ri1.irigel(3,ima) = des1
 120 : C        
 121 :         do 1634 ik=1,nligrd
 122 :         nomm = lisinc(ik)
 123 :         do 1635 ij=1,inomip
 124 :         if(NOMM.eq.NOMIP(ij)) des1.lisdua(ik) = nompi(ij)
 125 : 1635    continue
 126 :         des1.noeled(ik)=noelep(ik)
 127 : 1634    continue
 128 : 
 129 :         do 1644 ik=1,nligrp
 130 :         nomm = lisdua(ik)
 131 :         do 1645 ij=1,inomda
 132 :         if(NOMM.eq.NOMDA(ij)) des1.lisinc(ik) = nompa(ij)
 133 : 1645    continue
 134 :         des1.noelep(ik)=noeled(ik)
 135 : 1644    continue
 136 : 
 137 :         segdes,descr,des1
 138 : 
 139 : 1700   continue
 140 : 
 141 :       segdes ri1,mrigid 
 142 : 
 143 :       segsup,snomip,snomda
 144 : 
 145 :       RETURN
 146 :       END
 147 : 
 148 :  
 149 :