C CV2MCB SOURCE GOUNAND 09/09/03 21:15:12 6481 SUBROUTINE CV2MCB(TABVDC,TABMAT, $ MYFALS, $ MATLSB,CHPLSB, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CV2MCB C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) C représentant un ensemble de matrices élémentaires en C MATRIK... 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 : PRLSB2 C*********************************************************************** C ENTREES : C ENTREES/SORTIES : - C SORTIES : C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire. C * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB 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, 22/07/09, version initiale C HISTORIQUE : v1, 22/07/09, 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 SMMATRIK POINTEUR MATLSB.MATRIK POINTEUR MATTMP.MATRIK POINTEUR MATTM2.MATRIK -INC SMCHPOI POINTEUR CHPLSB.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 cv2mcb' * WRITE(IOIMP,*) '<' MATLSB=0 CHPLSB=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 CV2MAB(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 (CHPLSB.EQ.0) THEN CHPLSB=CHPTMP CHPTMP=0 ELSE * In ADCHPO : SEGINI CHPTM2 CALL ADCHPO(CHPLSB,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 CHPLSB CALL DTCHPO(CHPLSB) * In DTCHPO : SEGSUP CHPTMP CALL DTCHPO(CHPTMP) CHPLSB=CHPTM2 CHPTMP=0 ENDIF ENDIF IF (MATTMP.NE.0) THEN IF (MATLSB.EQ.0) THEN MATLSB=MATTMP MATTMP=0 ELSE * In FUSMTK : SEGINI MATTM2 CALL FUSMTK(MATLSB,MATTMP,MATTM2) IF (MATTM2.EQ.0) THEN WRITE(IOIMP,*) $ 'Pas pu faire le ET des matriks...' GOTO 9999 ENDIF SEGSUP MATLSB SEGSUP MATTMP MATLSB=MATTM2 MATTMP=0 ENDIF ENDIF ENDIF ENDDO ENDDO SEGDES TABMAT SEGDES TABVDC * WRITE(IOIMP,*) '>' IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'On a créé MATLSB=',MATLSB IF (MATLSB.NE.0) THEN CALL ECROBJ('MATRIK',MATLSB) CALL PRLIST ENDIF WRITE(IOIMP,*) 'On a créé CHPLSB=',CHPLSB IF (CHPLSB.NE.0) THEN CALL ECROBJ('CHPOINT ',CHPLSB) 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 cv2mcb' RETURN * * End of subroutine CV2MCB * END