C CMCT1 SOURCE PV090527 26/04/30 21:15:17 12529 SUBROUTINE CMCT1(ICHP,IRIG,IRIG2) *_______________________________________________________________________ c c opérateur cmct c c entrée c ICHP : champ par point qui stocke la masse inversée c IRIG : rigidité contenant les blocages c c sortie c IRIG2 : rigidité contenant la matrice condensée c *_______________________________________________________________________ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC PPARAM -INC CCOPTIO -INC SMRIGID -INC SMELEME -INC SMCOORD -INC SMCHPOI * stockage des noms de tous les composantes primales. SEGMENT LSINCP CHARACTER*(LOCOMP) LISINP(NLIGP) ENDSEGMENT * correspondance entre les noms de composantes locale LISINC * et les nom de composantes dans LSINCP SEGMENT CORES1 INTEGER IPCOR2(NRIGEL) ENDSEGMENT SEGMENT CORES2 INTEGER COR2(NLIGRP) ENDSEGMENT * tableau pour dire en chaque point si la composante du tableau LISINP * est implquée SEGMENT MTOPTS * nombre d'occurence de la compoosante INTEGER ITOPTS(NBPTS,NLIGP) * valeur de l'inverse la masse en ce point REAL*8 XTOPTS(NBPTS,NLIGP+1) ENDSEGMENT * * tableau pour pointer vers MCOEF à partir du nombre d'inconnues * SEGMENT LSINCO INTEGER LESINC(NINC,2) REAL*8 XMAS(NINC) ENDSEGMENT * * tableau des coefficient de la matrice C * ordonné dans l'ordre des inconnues SEGMENT MCOEF * numero du noeud support du multiplicateur ligne 1 * est il en marié avec un autre multiplicateur ligne 2 INTEGER ICOEF(2,NCOEF) * valeur des coefficients REAL*8 XCOEF(NCOEF) ENDSEGMENT * *_______________________________________________________________________ * * la première etape consiste à établir la liste de tous les noms * d'inconnue primale dans la rigidité * cette liste est stockée dans LSINCP * la correspondance locale -> globale dans CORES1 * * la rigidité est déjà active (cmct) MRIGID = IRIG NRIGEL = IRIGEL(/2) SEGINI CORES1 * NLIGP1 est la taille effective de LSINCP * on évite ainsi de faire trop de segadj NLIGP1 = 0 NLIGP = 0 NCOEF = 0 DO 50 I=1,NRIGEL DESCR = IRIGEL(3,I) SEGACT DESCR*NOMOD NLIGRP = LISINC(/2) NLIGP = NLIGP + NLIGRP MELEME = IRIGEL(1,I) NCOEF = NCOEF + (NUM(/2) * NLIGRP) * les coeffficients sur les multiplicateurs * ne nous interessent pas IF (ITYPEL .EQ. 22) NCOEF=NCOEF-NUM(/2) 50 CONTINUE * SEGINI LSINCP DO 300 I=1,NRIGEL DESCR = IRIGEL(3,I) NLIGRP = LISINC(/2) MELEME = IRIGEL(1,I) IMULT=1 IF (ITYPEL .EQ.22) IMULT = 2 SEGINI CORES2 DO 200 J=IMULT,NLIGRP DO 100 K=1,NLIGP IF (LISINC(J) .EQ. LISINP(K)) THEN COR2(J) = K GOTO 200 ENDIF 100 CONTINUE NLIGP1 = NLIGP1 + 1 LISINP(NLIGP1) = LISINC(J) COR2(J) = NLIGP1 200 CONTINUE IPCOR2(I) = CORES2 300 CONTINUE * * ajustement de la taille de LSINCP * on purrait suprimer cette ligne NLIGP = NLIGP1 SEGADJ LSINCP * * *_______________________________________________________________________ * on remplit maintenant le tableau itopts en bouclant sur les sous zones de * la rigidité * SEGINI MTOPTS * DO 600 I=1,NRIGEL * les maillages sont actifs depuis cmct MELEME = IRIGEL(1,I) imult=1 IF (ITYPEL .EQ.22) IMULT = 2 DESCR = IRIGEL(3,I) CORES2 = IPCOR2(I) DO 500 K=1,NUM(/2) DO 400 J=IMULT,NOELEP(/1) ITOPTS(NUM(NOELEP(J),K),COR2(J)) = & ITOPTS(NUM(NOELEP(J),K),COR2(J)) + 1 400 CONTINUE 500 CONTINUE 600 CONTINUE * * on remplit maintenant la masse inversée * MCHPOI = ICHP SEGACT MCHPOI*NOMOD * boucle sur les sous zones du champ par point DO 1100 I=1,IPCHP(/1) MSOUPO = IPCHP(I) SEGACT MSOUPO MELEME = IGEOC SEGACT MELEME MPOVAL = IPOVAL SEGACT MPOVAL * boucle sur les composantes de la sous zone DO 1000 J=1,NOCOMP(/2) * recuperation du numéro de la composante dans LISINP DO 700 K=1,NLIGP IF (NOCOMP(J) .EQ. LISINP(K)) THEN IDK = K GOTO 800 ENDIF 700 CONTINUE IDK = NLIGP + 1 * 800 CONTINUE * boucle sur les points de la sous zone DO 900 K=1,NUM(/2) XTOPTS(NUM(1,K),IDK) = VPOCHA(K,J) 900 CONTINUE * 1000 CONTINUE SEGDES MPOVAL,MELEME,MSOUPO 1100 CONTINUE * SEGDES MCHPOI * *_______________________________________________________________________ * * calcul du nombre d'inconnues et creation de LESINC * correspondance entre les inconnues et MCOEF * * NINC = 0 DO 1300 I=1,NLIGP DO 1200 J=1,NBPTS NINC = NINC + SIGN(1,(ITOPTS(J,I)-1)) 1200 CONTINUE 1300 CONTINUE NINC = ((NLIGP * NBPTS) + NINC )/ 2 ** * on remplit LSINCO SEGINI LSINCO IND1 = 1 IDUM = 1 DO 1600 I=1,NRIGEL MELEME = IRIGEL(1,I) imult=1 IF (ITYPEL .EQ.22) IMULT = 2 DESCR = IRIGEL(3,I) CORES2 = IPCOR2(I) DO 1500 K=1,NUM(/2) DO 1400 J=IMULT,NOELEP(/1) IF ( ITOPTS(NUM(NOELEP(J),K),COR2(J)) .GT. 0 ) THEN LESINC(IND1,1) = IDUM IDUM = IDUM + ITOPTS(NUM(NOELEP(J),K),COR2(J)) * ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC ITOPTS(NUM(NOELEP(J),K),COR2(J)) = -1 * IND1 XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2(J)) IND1 = IND1 + 1 ENDIF 1400 CONTINUE 1500 CONTINUE 1600 CONTINUE *===== * if ( (IND1-1) .NE. NINC ) then * write(*,*) 'erreur dans boucle lsinco' * endif *====== * * *_______________________________________________________________________ * remplissage de MCOEF * SEGINI MCOEF DO 1900 I=1,NRIGEL MELEME = IRIGEL(1,I) imult=1 IF (ITYPEL .EQ.22) IMULT = 2 DESCR = IRIGEL(3,I) CORES2 = IPCOR2(I) xMATRI = IRIGEL(4,I) SEGACT xMATRI DO 1800 K=1,NUM(/2) * XMATRI = IMATTT(K) * SEGACT XMATRI DO 1700 J=IMULT,NOELEP(/1) NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2(J)) IDMCOE = LESINC(NNINC,1)+LESINC(NNINC,2) LESINC(NNINC,2) = LESINC(NNINC,2) + 1 ICOEF(1,IDMCOE)=NUM(1,K) XCOEF(IDMCOE)=RE(1,J,k)*COERIG(I) 1700 CONTINUE * SEGDES XMATRI 1800 CONTINUE * on referme la boutique SEGDES xMATRI,MELEME,DESCR SEGSUP CORES2 1900 CONTINUE SEGSUP CORES1,LSINCP,MTOPTS * *===== * do 2001 i=1,ninc * write(*,2003) i,lesinc(i,1),lesinc(i,2),xmas(i) * 2001 continue * 2003 format(I3,1X,I3,1X,I3,2X,E12.5) * * do 2005 i=1,ncoef * write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i) * 2005 continue *===== *_______________________________________________________________________ * * il ne reste plus qu' a creer les matrices élémentaires * CALL CMCT2(MCOEF,LSINCO,IRIG2) IF (IERR .NE.0 ) RETURN SEGSUP LSINCO,MCOEF RI2 = IRIG2 SEGACT,RI2*MOD RI2.MTYMAT = MRIGID.MTYMAT RI2.IFORIG = MRIGID.IFORIG SEGDES,RI2 * *_______________________________________________________________________ RETURN END