Sources Esope | Cast3M

dual00
C DUAL00    SOURCE    BP208322  16/11/18    21:16:33     9177           
 
      SUBROUTINE dual00(mrigid,ri1)
C a appeler dual  ulterieurement
c====================================================================
c
c     entrees
c           mrigid  rigidité   [C]  de dependance  rela depend
c     sorties
C           ri1   [C] Transpose
c
c====================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
-INC SMRIGID
 
      character*4 NOMM
 
      segment snomip
        character*4 nomip(lnomip), nompi(lnomip)
      endsegment
      segment snomda
        character*4 nomda(lnomda), nompa(lnomda)
      endsegment
 
C on en profite  pour recenser les inconnues en question (primales)
      lnomip = 200
      lnomda = 200
      segini,snomip,snomda
      inomip = 0
      inomda = 0
 
      segact mrigid
      nrigel = IRIGEL(/2)
 
      DO 1501 I=1, NRIGEL
          DESCR=IRIGEL(3,I)
          SEGACT DESCR
C   attention ces matrices ne sont pas carrees  il faut 2 boucles
C          pour identifier les inconnues
          DO 1402 J=1,LISINC(/2)
            NOMM = LISINC(J)
            DO 1406 K=1,inomip
              IF (NOMM.EQ.nomip(K)) GO TO 1405
 1406       CONTINUE
            IF (inomip.EQ.lnomip) THEN
              lnomip = lnomip + 200
              segadj,snomip
            ENDIF
            inomip = inomip + 1
            nomip(inomip)=NOMM
 1405       CONTINUE
 1402     CONTINUE
C
          DO 1502 J=1,LISDUA(/2)
            NOMM = LISDUA(J)
            DO 1506 K=1,inomda
              IF (NOMM.EQ.nomda(K)) GO TO 1505
 1506       CONTINUE
            IF (inomda.EQ.lnomda) THEN
              lnomda = lnomda + 200
              segadj,snomda
            ENDIF
            inomda = inomda + 1
            nomda(inomda)=NOMM
 1505       CONTINUE
 1502     CONTINUE
 
 1501 CONTINUE
 
C      tableau des correspondances
 
          do 325 il=1,inomip
          NOMM =nomip(IL)
          do 326 in = 1,lnomdd
          if (NOMM.EQ.NOMDD(in)) then
          NOMPI(il) =NOMDU(in)
          goto 327
          endif
326       continue
C          nompi(il) = '    '
          nompi(il) = NOMM
327       continue
325       continue
 
          do 425 il=1,inomda
          NOMM =nomda(IL)
          do 426 in = 1,lnomdd
          if (NOMM.EQ.NOMDD(in)) then
          NOMPA(il) =NOMDU(in)
          goto 427
          endif
426       continue
C          nompa(il) = '    '
          nompa(il) = NOMM
427       continue
425       continue
 
C       write(ioimp,*) 'primales',(nomip(j),j=1,inomip),'sortie ' ,
C     &   ( nompi(j),j=1,inomip)
C       write(ioimp,*) 'duales  ',(nomda(j),j=1,inomda),'sortie ' ,
C     &   ( nompa(j),j=1,inomda)
 
C on stoke le ddel en question en position ad-hoc
 
       segini , ri1=mrigid
 
       do 1700 ima=1,NRIGEL
 
       descr = irigel(3,ima)
 
       nligrp = lisdua(/2)
       nligrd = lisinc(/2)
       segini,des1
       ri1.irigel(3,ima) = des1
C
        do 1634 ik=1,nligrd
        nomm = lisinc(ik)
        do 1635 ij=1,inomip
        if(NOMM.eq.NOMIP(ij)) des1.lisdua(ik) = nompi(ij)
1635    continue
        des1.noeled(ik)=noelep(ik)
1634    continue
 
        do 1644 ik=1,nligrp
        nomm = lisdua(ik)
        do 1645 ij=1,inomda
        if(NOMM.eq.NOMDA(ij)) des1.lisinc(ik) = nompa(ij)
1645    continue
        des1.noelep(ik)=noeled(ik)
1644    continue
 
        segdes,descr,des1
 
1700   continue
 
      segdes ri1,mrigid
 
      segsup,snomip,snomda
 
      RETURN
      END