C CV2MC9 SOURCE CHAT 09/10/09 21:16:52 6519 SUBROUTINE CV2MC9(TABVDC,TABMAT, $ MYFALS, $ MATLS9,CHPLS9, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CV2MC9 C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) C représentant un ensemble de matrices élémentaires en C RIGIDITE... C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : KEEF (recherche de l'élément fini) C APPELES (E/S) : ECROBJ, PRLIST (écriture entier, objet, C impression) C APPELE PAR : PRLS92 C*********************************************************************** C ENTREES : C ENTREES/SORTIES : - C SORTIES : C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire. C * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9 C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (nb. ddl dual, nb. ddl primal, C nb. comp. duales, nb. comp. primales, C 1, nb. éléments) C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 26/09/03, version initiale C HISTORIQUE : v1, 26/09/03, création C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC SMLMOTS POINTEUR MYLMOT.MLMOTS POINTEUR NCVARP.MLMOTS POINTEUR NCVARD.MLMOTS -INC SMRIGID POINTEUR MATLS9.MRIGID POINTEUR MATTMP.MRIGID POINTEUR MATTM2.MRIGID -INC SMCHPOI POINTEUR CHPLS9.MCHPOI POINTEUR CHPTMP.MCHPOI POINTEUR CHPTM2.MCHPOI * * Includes persos * CBEGININCLUDE SMCHAEL SEGMENT MCHAEL POINTEUR IMACHE(N1).MELEME POINTEUR ICHEVA(N1).MCHEVA ENDSEGMENT SEGMENT MCHEVA REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) ENDSEGMENT SEGMENT LCHEVA POINTEUR LISCHE(NBCHE).MCHEVA ENDSEGMENT CENDINCLUDE SMCHAEL POINTEUR MYMCHA.MCHAEL CBEGININCLUDE SFALRF SEGMENT FALRF CHARACTER*(LNNFA) NOMFA INTEGER NUQUAF(NBLRF) POINTEUR ELEMF(NBLRF).ELREF ENDSEGMENT SEGMENT FALRFS POINTEUR LISFA(0).FALRF ENDSEGMENT CENDINCLUDE SFALRF POINTEUR MYFALS.FALRFS CBEGININCLUDE SMPOUET SEGMENT TABGEO CHARACTER*4 DISGEO POINTEUR IGEO.MCHAEL ENDSEGMENT SEGMENT TABVDC INTEGER VVARPR(NUMVPR) INTEGER VVARDU(NUMVDU) INTEGER VDATPR(NUMDPR) INTEGER VDATDU(NUMDDU) INTEGER VCOFPR(NUMCPR) INTEGER VCOFDU(NUMCDU) INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) POINTEUR VLCOF(JLCOF).MLENTI POINTEUR VCOMP(JGCOF).COMP POINTEUR VLDAT(JGCOF).MLENTI INTEGER DJSVD(JGVD) POINTEUR NOMVD(JGVD).MLMOTS POINTEUR MVD(JGVD).MCHPOI REAL*8 XVD(JGVD) CHARACTER*4 DISVD(KGVD) ENDSEGMENT SEGMENT TATRAV POINTEUR VVCOF(JLCOF).MCHEVA POINTEUR VCOF(JGCOF).MCHEVA POINTEUR IVD(JGVD).MCHAEL POINTEUR VD(JGVD).MCHEVA POINTEUR DVD(JGVD).MCHEVA POINTEUR FFVD(KGVD).MCHEVA POINTEUR DFFVD(KGVD).MCHEVA LOGICAL LVCOF(JGCOF) LOGICAL LVD(JGVD) LOGICAL LDVD(JGVD) LOGICAL LFFVD(KGVD) LOGICAL LDFFVD(KGVD) ENDSEGMENT SEGMENT TABMAT POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL ENDSEGMENT CENDINCLUDE SMPOUET INTEGER NUMVPR,NUMVDU * CHARACTER*4 MDISCP,MDISCD,MYDISC INTEGER IMPR,IRET * LOGICAL MVVPR,MVVDU * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mc9' * WRITE(IOIMP,*) '<' MATLS9=0 CHPLS9=0 MATTMP=0 CHPTMP=0 SEGACT TABVDC SEGACT TABMAT * SEGPRT,TABMAT NUMVPR=TABMAT.VMAT(/2) NUMVDU=TABMAT.VMAT(/1) DO IVARPR=1,NUMVPR DO IVARDU=1,NUMVDU IJVARP=TABVDC.VVARPR(IVARPR) IJVARD=TABVDC.VVARDU(IVARDU) MVVPR=(TABVDC.MVD(IJVARP).NE.0) MVVDU=(TABVDC.MVD(IJVARD).NE.0) IKVARP=TABVDC.DJSVD(IJVARP) MDISCP=TABVDC.DISVD(IKVARP) NCVARP=TABVDC.NOMVD(IJVARP) IKVARD=TABVDC.DJSVD(IJVARD) MDISCD=TABVDC.DISVD(IKVARD) NCVARD=TABVDC.NOMVD(IJVARD) MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) IF (MYMCHA.NE.0) THEN IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN * In cv2ma9 : SEGINI MATTMP CALL CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD, $ MYMCHA, $ MYFALS, $ MATTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN MYDISC=MDISCP MYLMOT=NCVARP CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN MYDISC=MDISCD MYLMOT=NCVARD CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (MVVPR.AND.MVVDU) THEN MYDISC='CSTE' JGN=4 JGM=1 SEGINI,MYLMOT * MYLMOT.MOTS(1)='RES2' MYLMOT.MOTS(1)='SCAL' * In CV2CP9 : SEGINI CHPTMP CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP,MYLMOT ENDIF IF (CHPTMP.NE.0) THEN IF (CHPLS9.EQ.0) THEN CHPLS9=CHPTMP CHPTMP=0 ELSE * In ADCHPO : SEGINI CHPTM2 CALL ADCHPO(CHPLS9,CHPTMP,CHPTM2,1.D0,1.D0) IF (CHPTM2.EQ.0) THEN WRITE(IOIMP,*) $ 'Pas pu faire le ET des chpoints...' GOTO 9999 ENDIF * In DTCHPO : SEGSUP CHPLS9 CALL DTCHPO(CHPLS9) * In DTCHPO : SEGSUP CHPTMP CALL DTCHPO(CHPTMP) CHPLS9=CHPTM2 CHPTMP=0 ENDIF ENDIF IF (MATTMP.NE.0) THEN IF (MATLS9.EQ.0) THEN MATLS9=MATTMP MATTMP=0 ELSE * In FUSRIG : SEGINI MATTM2 CALL FUSRIG(MATLS9,MATTMP,MATTM2) IF (MATTM2.EQ.0) THEN WRITE(IOIMP,*) $ 'Pas pu faire le ET des chpoints...' GOTO 9999 ENDIF SEGSUP MATLS9 SEGSUP MATTMP MATLS9=MATTM2 MATTMP=0 ENDIF ENDIF ENDIF ENDDO ENDDO SEGDES TABMAT SEGDES TABVDC * WRITE(IOIMP,*) '>' IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9 IF (MATLS9.NE.0) THEN CALL ECROBJ('RIGIDITE',MATLS9) CALL PRLIST ENDIF WRITE(IOIMP,*) 'On a créé CHPLS9=',CHPLS9 IF (CHPLS9.NE.0) THEN CALL ECROBJ('CHPOINT ',CHPLS9) CALL PRLIST ENDIF ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine cv2mc9' RETURN * * End of subroutine CV2MC9 * END