C DYNPLX SOURCE CHAT 09/10/09 21:17:39 6519 SUBROUTINE DYNPLX IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ************************************************************************ * * SOUS-PROGRAMME DE L'OPERATEUR "DYNE" * ALGORITHME EXPLICITE DE PLEXUS * ____________________________________ * * FONCTION: * --------- * LECTURE ET TESTS DE COMPATIBILITE DES OPERANDES * * DENIS ROBERT, LE 19 OCTOBRE 1988. * REVU ET CORRIGE DECEMBRE 89 MP ************************************************************************ * * MODULES UTILISES: * -INC CCOPTIO -INC SMRIGID -INC SMMATRI -INC SMVECTD -INC SMELEME * PARAMETER ( ZERO=0.D0 ) PARAMETER ( EPSI=1.D-30 ) * *--- TABLEAUX DE POINTEURS : * INTEGER IPRIG(4),IPCGT(2),IPCHM(2),IPPT(6) * *--- SEGMENTS DE TRAVAIL : * -1 T * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE * -1 * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL * MUCTRA CONTIENT LES RENSEIGNEMENTS POUR LES PRODUITS K * U * ICPR CONTIENT DES REFERENCES GEOMETRIQUES * SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) SEGMENT,MZZZ REAL*8 ZZZZ(LONZ) ENDSEGMENT SEGMENT,MBLO REAL*8 BLO(IDDL,NDDL) ENDSEGMENT POINTEUR MBLO2.MBLO SEGMENT,MUCTRA REAL*8 CC(NLIGMA) INTEGER MUCPO,MUCMIK,MUCDUA,MUIPOS(NLIGMA),MUCPR ENDSEGMENT * *--- INITIALISATIONS * DT=ZERO NINS=0 IRE1=0 IRE3=0 DO 1 I0=1,4 IPRIG(I0)=0 1 CONTINUE * END DO IPCGT(1)=0 IPCGT(2)=0 MCHT=0 IPCHM(1)=0 IPCHM(2)=0 DO 2 I1=1,6 IPPT(I1)=0 2 CONTINUE * END DO * *--------------------------------------------------* *--- LECTURE DES OPERANDES DE TYPE 'RIGIDITE' ---* *--------------------------------------------------* * CALL MESLIR(-161) CALL LIROBJ('RIGIDITE',IPRIG(1),1,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-160) CALL LIROBJ('RIGIDITE',IPRIG(2),1,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-159) CALL LIROBJ('RIGIDITE',IPRIG(3),0,IRET) IF (IERR.NE.0) RETURN * *--------------------------------------------------* *--- LECTURE DES OPERANDES DE TYPE 'CHARGEME' ---* *--------------------------------------------------* * CALL MESLIR(-158) CALL LIROBJ('CHARGEME',IPCGT(1),0,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-157) CALL LIROBJ('CHARGEME',IPCGT(2),0,IRET) IF (IERR.NE.0) RETURN * IF (IPCGT(1).EQ.0.AND.IPCGT(2).EQ.0) THEN * *--- ON NE TROUVE PAS D'OBJET DE TYPE CHARGEMENT ... * MOTERR(1:8)='CHARGEME' CALL ERREUR(37) RETURN ENDIF * *-----------------------------------------* *--- LECTURE DES OPERANDES TEMPORELS ---* *-----------------------------------------* * CALL MESLIR(-156) CALL LIRREE(DT,1,IRET) IF (IERR.NE.0) RETURN IF (DT.LE.EPSI) THEN * *--- NOMBRE INACCEPTABLE ... * CALL ERREUR(36) RETURN ENDIF * CALL MESLIR(-155) CALL LIRENT(NPAS,1,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-154) CALL LIRENT(NINS,0,IRE3) IF (IERR.NE.0) RETURN IF (IRE3.EQ.1) THEN IF (NINS.LT.1) THEN * *--- NOMBRE INACCEPTABLE ... * CALL ERREUR(36) RETURN ENDIF ELSE NINS=1 ENDIF * CALL MESLIR(-153) CALL LIRREE(TINI,0,IRE1) IF (IERR.NE.0) RETURN IF (IRE1.EQ.0) TINI=ZERO * *-----------------------------------------------------------* *--- LECTURE DE LA TABLE CONTENANT LES CHAMPS INITIAUX ---* *-----------------------------------------------------------* * CALL MESLIR(-152) CALL LIROBJ('TABLE',ITAB1,1,IRET) IF (IERR.NE.0) RETURN * *------------------------------------------------------------------* *--- VERIFICATION IDENTIFICATION ET PREPARATION DES OPERANDES ---* *------------------------------------------------------------------* * CALL DYNEVE(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4, & IPCGT,TINI,DT,NPAS,ITAB1,IPCHM,IPPT) IF (IERR.NE.0) RETURN * MBLO=IPPT(2) IDDL=BLO(/1) NDDL=BLO(/2) * *----------------------------------------* *--- MISE EN OEUVRE DE L'ALGORITHME ---* *----------------------------------------* * CALL DYNEPL(IPRIG,ICHT1,ICHT2,ICHT3,ICHT4, & IPCGT,IDDL,NDDL,DT,NPAS,NINS,IPCHM,IPPT,ITAB2) IF (IERR.NE.0) RETURN * *---------------------------------------* *--- DESACTIVATIONS / DESTRUCTIONS ---* *---------------------------------------* * MRIGID=IPRIG(2) NRIGEL=IRIGEL(/2) DO 100 IRI=1,NRIGEL MELEME=IRIGEL(1,IRI) SEGDES,MELEME DESCR=IRIGEL(3,IRI) SEGDES,DESCR xMATRI=IRIGEL(4,IRI) * NELRIG=re(/3) * DO 200 IEL=1,NELRIG * XMATRI=IMATTT(IEL) * SEGDES,XMATRI * 200 CONTINUE * END DO SEGDES,xMATRI 100 CONTINUE * END DO SEGDES,MRIGID * MVECTD=IPPT(1) SEGSUP,MVECTD MBLO=IPPT(2) SEGSUP,MBLO MBLO=IPPT(3) SEGSUP,MBLO * MUCTRA=IPPT(4) ICPR=MUCPR SEGSUP,ICPR SEGSUP,MUCTRA * MMATRI=IPPT(5) MINCPO=IINCPO MIMIK=IIMIK MIDUA=IIDUA MHARK=IHARK MELEME=IGEOMA SEGDES,MELEME,MHARK,MIDUA,MIMIK,MINCPO SEGDES,MMATRI IF (IPRIG(3).NE.0) THEN MRIGID=IPRIG(4) SEGSUP,MRIGID MZZZ=IPPT(6) SEGSUP,MZZZ ENDIF * *---------------------------------------* *--- ECRITURE DE LA TABLE RESULTAT ---* *---------------------------------------* * CALL ECROBJ('TABLE',ITAB2) * END