C CV2CP9 SOURCE GOUNAND 21/06/02 21:15:35 11022 SUBROUTINE CV2CP9(MYDISC,MYLMOT,MYMCHA, $ MYFALS, $ MYCHPO, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : CV2CP9 C DESCRIPTION : Transforme un MCHAEL en MCHPOI 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 : C APPELE PAR : PRLS92 C*********************************************************************** C ENTREES : * CGEOME (type MELEME) : maillage de QUAFs C partitionné. C * MYDISC (type CH*(4)) : nom d'espace de C discrétisation (cf. NOMFA dans l'include C SFALRF) C * MYFALS (type FALRFS) : segment de description C des familles d'éléments de références. C SORTIES : * MYMCHA (type MCHAEL) : champ par éléments de C la grandeur tensorielle (degrés de liberté de C la grandeur). C ENTREES/SORTIES : - C TRAVAIL : C (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément) C C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 07/10/02, version initiale C HISTORIQUE : v1, 07/10/02, 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 SMCOORD -INC SMCHPOI POINTEUR MYCHPO.MCHPOI -INC TMTRAV POINTEUR MYMTRA.MTRAV INTEGER NNIN,NNNOE -INC SMELEME POINTEUR SOUMAI.MELEME POINTEUR MELTOT.MELEME POINTEUR SMLTOT.MELEME POINTEUR ML1TOT.MELEME INTEGER NBNN,NBELEM,NBSOUS,NBREF -INC SMLMOTS POINTEUR MYLMOT.MLMOTS -INC SMLENTI POINTEUR KRIGEO.MLENTI INTEGER JG * * Includes persos * -INC TNLIN *-INC SMCHAEL POINTEUR MYMCHA.MCHAEL POINTEUR MZMCHA.MCHEVA *-INC SFALRF POINTEUR MYFALS.FALRFS *-INC SELREF POINTEUR MYLRF.ELREF * * Includes persos * * Liste de MELEME INTEGER NBMEL SEGMENT MELS POINTEUR LISMEL(NBMEL).MELEME ENDSEGMENT POINTEUR GPMELS.MELS * CHARACTER*(4) MYDISC INTEGER IMPR,IRET * INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM INTEGER IDELM INTEGER IBEL,IDDL,ISOUS,ITQUAF INTEGER NBEL,NDDL,NSOUS INTEGER NNGLO,NNLOC,NNQUA INTEGER ININ,INNOE INTEGER NTOGPO * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cp9' * * Création de MELTOT maillage des points sur lesquels reposent les ddl * (il y a des doublons) * SEGACT MYMCHA * SEGPRT,MYMCHA NSOUS=MYMCHA.JMACHE(/1) * NBNN=0 NBELEM=0 NBSOUS=NSOUS NBREF=0 SEGINI,MELTOT DO 1 ISOUS=1,NSOUS SOUMAI=MYMCHA.JMACHE(ISOUS) SEGACT SOUMAI * On cherche l'élément fini correspondant au QUAF ITQUAF=SOUMAI.ITYPEL CALL KEEF(ITQUAF,MYDISC, $ MYFALS, $ MYLRF, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT MYLRF NDDL=MYLRF.NPQUAF(/1) NBEL=SOUMAI.NUM(/2) * NBNN=NDDL NBELEM=NBEL NBSOUS=0 NBREF=0 SEGINI,SMLTOT DO IBEL=1,NBEL DO IDDL=1,NDDL NNQUA=MYLRF.NPQUAF(IDDL) NNGLO=SOUMAI.NUM(NNQUA,IBEL) SMLTOT.NUM(IDDL,IBEL)=NNGLO ENDDO ENDDO SEGDES,SMLTOT MELTOT.LISOUS(ISOUS)=SMLTOT SEGDES,MYLRF SEGDES,SOUMAI 1 CONTINUE SEGDES,MELTOT SEGDES,MYMCHA * * On construit ML1TOT, ensemble des points de MELTOT * NBMEL=1 SEGINI,GPMELS GPMELS.LISMEL(1)=MELTOT CALL MLUNIQ(GPMELS,ML1TOT, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP,GPMELS * * Destruction de MELTOT * SEGACT,MELTOT*MOD DO 3 ISOUS=1,NSOUS SMLTOT=MELTOT.LISOUS(ISOUS) * SEGACT,SMLTOT SEGSUP,SMLTOT 3 CONTINUE SEGSUP,MELTOT * * Initialisation de MYMTRA * SEGACT MYLMOT NNIN=MYLMOT.MOTS(/2) SEGACT ML1TOT NNNOE=ML1TOT.NUM(/2) SEGINI,MYMTRA * Remplissage de MYMTRA.INCO et MYMTRA.IGEO DO ININ=1,NNIN MYMTRA.INCO(ININ)=MYLMOT.MOTS(ININ) ENDDO DO INNOE=1,NNNOE MYMTRA.IGEO(INNOE)=ML1TOT.NUM(1,INNOE) ENDDO SEGSUP,ML1TOT SEGDES,MYLMOT * Création du segment de repérage dans MYMTRA.IGEO NTOGPO=nbpts JG=NTOGPO SEGINI,KRIGEO CALL RSETEE(MYMTRA.IGEO,NNNOE, $ KRIGEO.LECT,NTOGPO, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Remplissage de MYMTRA.BB et MYMTRA.IBIN SEGACT,MYMCHA DO 5 ISOUS=1,NSOUS SOUMAI=MYMCHA.JMACHE(ISOUS) SEGACT,SOUMAI MZMCHA=MYMCHA.ICHEVA(ISOUS) IF (MZMCHA.NE.0) THEN SEGACT,MZMCHA * On cherche l'élément fini correspondant au QUAF ITQUAF=SOUMAI.ITYPEL CALL KEEF(ITQUAF,MYDISC, $ MYFALS, $ MYLRF, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT MYLRF NDDL=MYLRF.NPQUAF(/1) NBEL=SOUMAI.NUM(/2) * Petits tests NDLIG=MZMCHA.WELCHE(/1) NDCOL=MZMCHA.WELCHE(/2) N2DLIG=MZMCHA.WELCHE(/3) N2DCOL=MZMCHA.WELCHE(/4) NDNOEU=MZMCHA.WELCHE(/5) NDELM=MZMCHA.WELCHE(/6) IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL) $ .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1)) $ .OR.N2DLIG.NE.1 $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1 $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBEL)) THEN WRITE(IOIMP,*) 'Erreur dims MZMCHA' GOTO 9999 ENDIF DO IBEL=1,NBEL IF (NDELM.EQ.1) THEN IDELM=1 ELSE IDELM=IBEL ENDIF DO IDDL=1,NDDL IF (NDLIG.EQ.1) THEN ILIG=1 ICOL=IDDL ELSE ILIG=IDDL ICOL=1 ENDIF NNQUA=MYLRF.NPQUAF(IDDL) NNGLO=SOUMAI.NUM(NNQUA,IBEL) NNLOC=KRIGEO.LECT(NNGLO) IF (NNLOC.EQ.0) THEN WRITE(IOIMP,*) 'Erreur de programmation 1' GOTO 9999 ENDIF ININ=MYLRF.NUMCMP(IDDL) MYMTRA.IBIN(ININ,NNLOC)=1 MYMTRA.BB(ININ,NNLOC)=MYMTRA.BB(ININ,NNLOC) $ +MZMCHA.WELCHE(ILIG,ICOL,1,1,1,IDELM) ENDDO ENDDO SEGDES,MYLRF SEGDES,MZMCHA ENDIF SEGDES,SOUMAI 5 CONTINUE SEGDES,MYMCHA SEGSUP,KRIGEO * * Transformation l'objet MTRAV en chpoint * CALL CRECHP(MYMTRA,MYCHPO) SEGSUP MYMTRA SEGACT MYCHPO*MOD MYCHPO.JATTRI(1)=2 SEGDES MYCHPO * IMPR=6 IF (IMPR.GT.3) THEN CALL ECROBJ('CHPOINT ',MYCHPO) CALL PRLIST ENDIF * IMPR=0 * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine cv2cp9' RETURN * * End of subroutine CV2CP9 * END