cv2ma9
C CV2MA9 SOURCE FANDEUR 22/01/19 21:15:04 11256 $ IMTLS9, $ MYFALS, $ MATLS9, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CV2MA9 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 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 NCVARP.MLMOTS POINTEUR NCVARD.MLMOTS -INC SMELEME POINTEUR MYMEL.MELEME POINTEUR RIGMEL.MELEME INTEGER NBNN,NBELEM,NBSOUS,NBREF -INC SMLENTI POINTEUR LPOQUF.MLENTI POINTEUR KPOQUF.MLENTI INTEGER JG -INC SMRIGID POINTEUR MATLS9.MRIGID POINTEUR MYDSCR.DESCR POINTEUR MYIMAT.IMATRI POINTEUR MYXMAT.XMATRI INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD * * Includes persos * -INC TNLIN *-INC SMCHAEL POINTEUR IMTLS9.MCHAEL POINTEUR JMTLS9.MCHEVA INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM *-INC SFALRF POINTEUR MYFALS.FALRFS *-INC SELREF POINTEUR LRFPRI.ELREF POINTEUR LRFDUA.ELREF * CHARACTER*4 MDISCP,MDISCD INTEGER IMPR,IRET * INTEGER IBNN,IBELEM INTEGER ITQUAF,NDDLPR,NDDLDU INTEGER IDDLPR,IDDLDU INTEGER NSOUS,NPOQUF INTEGER ISOUS INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2ma9' NRIGEL=0 c* NRIGE=8 SEGINI,MATLS9 MATLS9.MTYMAT='LEASTSQU' MATLS9.IFORIG=IFOUR * On prend le mode de calcul courant (on pourrait s'appuyer sur celui du champ ?) NRIGE=MATLS9.IRIGEL(/1) * * Remplissage de MRIGID * SEGACT NCVARP SEGACT NCVARD SEGACT IMTLS9 NSOUS=IMTLS9.JMACHE(/1) C SEGPRT,NCVARP C SEGPRT,NCVARD C SEGPRT,IMTLS9 DO ISOUS=1,NSOUS JMTLS9=IMTLS9.ICHEVA(ISOUS) IF (JMTLS9.NE.0) THEN C SEGPRT,NCVARP C SEGPRT,NCVARD C SEGPRT,JMTLS9 MYMEL =IMTLS9.JMACHE(ISOUS) SEGACT MYMEL ITQUAF=MYMEL.ITYPEL $ LRFPRI,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT LRFPRI NDDLPR=LRFPRI.NPQUAF(/1) $ LRFDUA,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT LRFDUA NDDLDU=LRFDUA.NPQUAF(/1) * * remplissage du segment DISCR * * Construction de la liste des points du QUAF sur lesquels il y a des * ddl JG=0 SEGINI LPOQUF DO IDDLPR=1,NDDLPR LPOQUF.LECT(**)=LRFPRI.NPQUAF(IDDLPR) ENDDO DO IDDLDU=1,NDDLDU LPOQUF.LECT(**)=LRFDUA.NPQUAF(IDDLDU) ENDDO * Suppression des doublons $ LPOQUF.LECT,NPOQUF, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 JG=NPOQUF SEGADJ,LPOQUF * Segment de repérage dans cette liste JG=MYMEL.NUM(/1) SEGINI,KPOQUF NLIGRP=NDDLPR NLIGRD=NDDLDU SEGINI MYDSCR DO ILIGRP=1,NLIGRP ICMPP=LRFPRI.NUMCMP(ILIGRP) MYDSCR.NOELEP(ILIGRP)= $ KPOQUF.LECT(LRFPRI.NPQUAF(ILIGRP)) ENDDO DO ILIGRD=1,NLIGRD ICMPD=LRFDUA.NUMCMP(ILIGRD) MYDSCR.NOELED(ILIGRD)= $ KPOQUF.LECT(LRFDUA.NPQUAF(ILIGRD)) ENDDO SEGDES MYDSCR SEGDES LRFDUA SEGDES LRFPRI SEGSUP KPOQUF * * remplissage du maillage pour la rigidité * NBNN=NPOQUF NBELEM=MYMEL.NUM(/2) NBSOUS=0 NBREF=0 SEGINI,RIGMEL * Type 32 POLY RIGMEL.ITYPEL=32 DO IBELEM=1,NBELEM DO IBNN=1,NBNN RIGMEL.NUM(IBNN,IBELEM)= $ MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM) ENDDO ENDDO SEGDES RIGMEL SEGSUP LPOQUF SEGDES MYMEL * * remplissage des matrices élémentaires * SEGACT JMTLS9 NBLIG=JMTLS9.WELCHE(/1) NBCOL=JMTLS9.WELCHE(/2) N2LIG=JMTLS9.WELCHE(/3) N2COL=JMTLS9.WELCHE(/4) NBPOI=JMTLS9.WELCHE(/5) NBELM=JMTLS9.WELCHE(/6) IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1 $ .OR.N2COL.NE.1.OR.NBPOI.NE.1) THEN WRITE(IOIMP,*) 'Erreur dims JMTLS9' GOTO 9999 ENDIF NELRIG=NBELM nligrp=nddlpr nligrd=nddldu SEGINI MYxMAT DO IELRIG=1,NELRIG * NLIGRP=NDDLPR * NLIGRD=NDDLDU * SEGINI MYXMAT DO ILIGRP=1,NLIGRP DO ILIGRD=1,NLIGRD MYXMAT.RE(ILIGRD,ILIGRP,ielrig)= $ JMTLS9.WELCHE(ILIGRD,ILIGRP,1,1,1,IELRIG) ENDDO ENDDO * SEGDES MYXMAT * MYIMAT.IMATTT(IELRIG)=MYXMAT ENDDO SEGDES JMTLS9 * * remplissage du chapeau * NRIGE=MATLS9.IRIGEL(/1) NRIGEL=MATLS9.IRIGEL(/2)+1 SEGADJ,MATLS9 MATLS9.COERIG(NRIGEL)=1.D0 MATLS9.IRIGEL(1,NRIGEL)=RIGMEL MATLS9.IRIGEL(2,NRIGEL)=0 MATLS9.IRIGEL(3,NRIGEL)=MYDSCR MATLS9.IRIGEL(4,NRIGEL)=MYxMAT MATLS9.IRIGEL(5,NRIGEL)=0 MATLS9.IRIGEL(6,NRIGEL)=0 * * la matrice ne possède pas de symétries (a priori...) * MATLS9.IRIGEL(7,NRIGEL)=2 MATLS9.IRIGEL(8,NRIGEL)=0 myxmat.symre = 2 SEGDES MYxMAT ENDIF ENDDO SEGDES IMTLS9 SEGDES NCVARD SEGDES NCVARP SEGDES MATLS9 IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9 CALL PRLIST ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine cv2ma9' RETURN * * End of subroutine CV2MA9 * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales