C MKCOOR SOURCE GOUNAND 21/06/02 21:17:12 11022 SUBROUTINE MKCOOR(CGEOME,MDISCR, $ MYFALS, $ ICOOR, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : MKCOOR C PROJET : Noyau linéaire NLIN C DESCRIPTION : On crée le champ par éléments contenant les coordonnées C des points servant pour la transformation géométrique C (ddl de la transformation géométrique)... 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 NOMINC (nommage des inconnues) C MKCOO1 (remplissage du sous-champ par élément C (fortran 77)) C PRCAEL (impression du champ créé) C APPELE PAR : PRNLI2 C*********************************************************************** C ENTREES : * CGEOME (type MELEME) : maillage de QUAFs C partitionné. C * MDISCR (type CH*(*)) : 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 : * ICOOR (type MCHAEL) : champ par éléments de C coordonnées de points (degrés de liberté de la C transformation géométrique). C TRAVAIL : * SOUGEO (type MELEME) : maillage élémentaire. C * JCOOR (type MCHEVA) : valeurs du champ ICOOR C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, dim. esp. réel, 1, nb. élément) C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 01/09/99, version initiale C HISTORIQUE : v1, 01/09/99, 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 CCGEOME -INC SMCOORD -INC SMELEME POINTEUR CGEOME.MELEME POINTEUR SOUGEO.MELEME * Segments à moi -INC TNLIN *-INC SMCHAEL INTEGER N1 POINTEUR ICOOR.MCHAEL INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM POINTEUR JCOOR.MCHEVA *-INC SFALRF POINTEUR MYFALS.FALRFS *-INC SELREF POINTEUR MYLRF.ELREF * CHARACTER*(*) MDISCR INTEGER IMPR,IRET * INTEGER ISOUS INTEGER NSOUS,NNOEU,NELEM,NDDL,NXCO INTEGER ITQUAF * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoor' SEGACT CGEOME NSOUS=CGEOME.LISOUS(/1) N1=NSOUS SEGINI ICOOR NXCO=nbpts*(idim+1) * Par sous-domaine... DO 1 ISOUS=1,NSOUS SOUGEO=CGEOME.LISOUS(ISOUS) SEGACT SOUGEO * On cherche l'élément fini correspondant au QUAF ITQUAF=SOUGEO.ITYPEL CALL KEEF(ITQUAF,MDISCR, $ MYFALS, $ MYLRF, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGACT MYLRF NDDL=MYLRF.NPQUAF(/1) NNOEU=SOUGEO.NUM(/1) NELEM=SOUGEO.NUM(/2) NBLIG=1 NBCOL=NDDL N2LIG=1 N2COL=IDIM NBPOI=1 NBELM=NELEM SEGINI JCOOR segact mcoord CALL MKCOO1(NNOEU,NELEM,NXCO,NDDL,IDIM, $ SOUGEO.NUM,MCOORD.XCOOR,MYLRF.NPQUAF, $ JCOOR.WELCHE, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES JCOOR ICOOR.ICHEVA(ISOUS)=JCOOR SEGDES MYLRF SEGDES SOUGEO ICOOR.JMACHE(ISOUS)=SOUGEO 1 CONTINUE SEGDES ICOOR SEGDES CGEOME IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'On a créé', $ ' ICOOR(élément ,1, coor.esp ,1, ddl ,1)=',ICOOR CALL PRCAEL(ICOOR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine mkcoor' RETURN * * End of subroutine MKCOOR * END