C CV2MCA SOURCE CB215821 20/11/25 13:23:36 10792 $ MYFALS, $ 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 -INC SMELEME POINTEUR CGEOME.MELEME * * 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 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 cv2mca' * $ MYFALS, $ MATLSA, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CHPLSA=0 CHPTMP=0 SEGACT TABVDC SEGACT TABMAT 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) IF (MYMCHA.NE.0) THEN IF (MVVPR.OR.MVVDU) THEN IF ((.NOT.MVVPR).AND.MVVDU) THEN MYDISC=MDISCP MYLMOT=NCVARP $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN MYDISC=MDISCD MYLMOT=NCVARD $ 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' * In CV2CP9 : SEGINI CHPTMP $ MYFALS, $ CHPTMP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP,MYLMOT ENDIF ENDIF IF (CHPTMP.NE.0) THEN IF (CHPLSA.EQ.0) THEN CHPLSA=CHPTMP CHPTMP=0 ELSE * In ADCHPO : SEGINI CHPTM2 IF (CHPTM2.EQ.0) THEN WRITE(IOIMP,*) $ 'Pas pu faire le ET des chpoints...' GOTO 9999 ENDIF * In DTCHPO : SEGSUP CHPLSA * In DTCHPO : SEGSUP CHPTMP 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 PRLIST ENDIF IF (CHPLSA.NE.0) THEN 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
© Cast3M 2003 - Tous droits réservés.
Mentions légales