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