C CV2MCA SOURCE PV 22/04/25 21:15:02 11344 SUBROUTINE CV2MCA(CGEOME,TABVDC,TABMAT, $ MYFALS,LCHAM, $ MATLSA,CHPLSA, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CV2MCA C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) C représentant un ensemble de matrices élémentaires en C RIGIDITE ou chpoint... 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 : prlin2 C*********************************************************************** C ENTREES : C ENTREES/SORTIES : - C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 06/03/09, version initiale C HISTORIQUE : v1, 06/03/06, 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 PPARAM -INC CCOPTIO -INC SMLMOTS POINTEUR MYLMOT.MLMOTS POINTEUR NCVARP.MLMOTS POINTEUR NCVARD.MLMOTS -INC SMRIGID POINTEUR MATLSA.MRIGID POINTEUR MATTMP.MRIGID POINTEUR MATTM2.MRIGID -INC SMCHPOI * POINTEUR CHPLSA.MCHPOI * POINTEUR CHPTMP.MCHPOI * POINTEUR CHPTM2.MCHPOI INTEGER CHPLSA,CHPTMP,CHPTM2 -INC SMELEME POINTEUR CGEOME.MELEME * * Includes persos * -INC TNLIN *-INC SMCHAEL POINTEUR MYMCHA.MCHAEL *-INC SFALRF POINTEUR MYFALS.FALRFS *-INC SMTNLIN 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 cv2mca' * CALL CV2MAA(CGEOME,TABVDC,TABMAT, $ MYFALS, $ MATLSA, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CHPLSA=0 CHPTMP=0 SEGACT TABVDC SEGACT 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 (MVVPR.OR.MVVDU) THEN IF ((.NOT.MVVPR).AND.MVVDU) THEN MYDISC=MDISCP MYLMOT=NCVARP IF (LCHAM.EQ.1) THEN CALL CV2CML(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN MYDISC=MDISCD MYLMOT=NCVARD IF (LCHAM.EQ.1) THEN CALL CV2CML(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF 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 IF (LCHAM.EQ.1) THEN CALL CV2CML(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF SEGSUP,MYLMOT ENDIF ENDIF IF (CHPTMP.NE.0) THEN IF (CHPLSA.EQ.0) THEN CHPLSA=CHPTMP CHPTMP=0 ELSE IF (LCHAM.EQ.1) THEN CALL ADCHEL(CHPLSA,CHPTMP,CHPTM2,1) ELSE * In ADCHPO : SEGINI CHPTM2 CALL ADCHPO(CHPLSA,CHPTMP,CHPTM2,1.D0,1.D0) ENDIF IF (CHPTM2.EQ.0) THEN WRITE(IOIMP,*) $ 'Pas pu faire le ET des champs...' GOTO 9999 ENDIF IF (LCHAM.EQ.1) THEN CALL DTCHAM(CHPLSA) CALL DTCHAM(CHPTMP) ELSE * In DTCHPO : SEGSUP CHPLSA CALL DTCHPO(CHPLSA) * In DTCHPO : SEGSUP CHPTMP CALL DTCHPO(CHPTMP) ENDIF CHPLSA=CHPTM2 CHPTMP=0 ENDIF ENDIF ENDIF ENDDO ENDDO SEGDES TABMAT SEGDES TABVDC * WRITE(IOIMP,*) '>' IF (IMPR.GT.3) THEN IF (MATLSA.NE.0) THEN CALL ECROBJ('RIGIDITE',MATLSA) CALL PRLIST ENDIF IF (CHPLSA.NE.0) THEN IF (LCHAM.EQ.1) THEN CALL ECROBJ('MCHAML ',CHPLSA) ELSE CALL ECROBJ('CHPOINT ',CHPLSA) ENDIF 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 cv2mca' RETURN * * End of subroutine CV2MCA * END