C INELSE SOURCE GOUNAND 05/12/21 21:31:21 5281 SUBROUTINE INELSE(MYLRFS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INELSE C PROJET : Noyau linéaire NLIN C DESCRIPTION : Remplit le segment des éléments de référence C avec les éléments de référence de dimension 1 C (segments). C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : INILRF, INILAG, GBAPCO C APPELE PAR : INLRFS C*********************************************************************** C ENTREES : - C ENTREES/SORTIES : MYLRFS C SORTIES : - C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 23/03/00, version initiale C HISTORIQUE : v1, 23/03/00, création C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF 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 CCOPTIO CBEGININCLUDE SELREF SEGMENT ELREF CHARACTER*(LNNOM) NOMLRF CHARACTER*(LNFORM) FORME CHARACTER*(LNTYPL) TYPEL CHARACTER*(LNESP) ESPACE INTEGER DEGRE REAL*8 XCONOD(NDIMEL,NBNOD) INTEGER NPQUAF(NBDDL) INTEGER NUMCMP(NBDDL) INTEGER QUENOD(NBDDL) INTEGER ORDDER(NDIMEL,NBDDL) POINTEUR MBPOLY.POLYNS ENDSEGMENT SEGMENT ELREFS POINTEUR LISEL(0).ELREF ENDSEGMENT CENDINCLUDE SELREF POINTEUR MYLRFS.ELREFS POINTEUR ELCOUR.ELREF CBEGININCLUDE SPOLYNO SEGMENT POLYNO REAL*8 COEMON(NBMON) INTEGER EXPMON(NDIML,NBMON) ENDSEGMENT SEGMENT POLYNS POINTEUR LIPOLY(NBPOLY).POLYNO ENDSEGMENT CENDINCLUDE SPOLYNO POINTEUR MYBPOL.POLYNS * INTEGER IMPR,IRET * Elément de nom : L2D0SE1 REAL*8 ZERO PARAMETER (ZERO=0.D0) * Elément de nom : L2D1SE2 REAL*8 UNS2 PARAMETER (UNS2=0.5D0) * Elément de nom : H1D1SE2 REAL*8 UN PARAMETER (UN=1.D0) * INTEGER INDDL * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelse' * * Elément de nom : L2D0SE1 * Sur un segment : élément de Lagrange, fonction L2, approximation * nodale, espace de référence de dimension 1, 1 noeud, 1 degré de * liberté, degré de l'approximation : 0 * * In INILRF : SEGINI ELCOUR CALL INILRF('L2D0SE1','SEGMENT','LAGRANGE','L2', $ 1,1,1,0, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.XCONOD(1,1)=ZERO ELCOUR.NPQUAF(1)=2 ELCOUR.NUMCMP(1)=1 * Initialise la correspondance ddl-noeud+ord.der CALL INILAG(ELCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Génère une base polynômiale complète (dimension 1, degré 0) CALL GBAPCO(1,0,MYBPOL,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.MBPOLY=MYBPOL SEGDES ELCOUR MYLRFS.LISEL(**)=ELCOUR * * Elément de nom : L2D1SE2 * Sur un segment : élément de Lagrange, fonction L2, approximation * nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de * liberté, degré de l'approximation : 1 * * In INILRF : SEGINI ELCOUR CALL INILRF('L2D1SE2','SEGMENT','LAGRANGE','L2', $ 1,2,2,1, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.XCONOD(1,1)=-UNS2 ELCOUR.XCONOD(1,2)= UNS2 ELCOUR.NPQUAF(1)=2 ELCOUR.NUMCMP(1)=1 ELCOUR.NPQUAF(2)=2 ELCOUR.NUMCMP(2)=2 * Initialise la correspondance ddl-noeud+ord.der CALL INILAG(ELCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Génère une base polynômiale complète (dimension 1, degré 1) CALL GBAPCO(1,1,MYBPOL,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.MBPOLY=MYBPOL SEGDES ELCOUR MYLRFS.LISEL(**)=ELCOUR * * Elément de nom : H1D1SE2 * Sur un segment : élément de Lagrange, fonction H1, approximation * nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de * liberté, degré de l'approximation : 1 * * In INILRF : SEGINI ELCOUR CALL INILRF('H1D1SE2','SEGMENT','LAGRANGE','H1', $ 1,2,2,1, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.XCONOD(1,1)=-UN ELCOUR.XCONOD(1,2)=UN ELCOUR.NPQUAF(1)=1 ELCOUR.NUMCMP(1)=1 ELCOUR.NPQUAF(2)=3 ELCOUR.NUMCMP(2)=1 * Initialise la correspondance ddl-noeud+ord.der CALL INILAG(ELCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Génère une base polynômiale complète (dimension 1, degré 1) CALL GBAPCO(1,1,MYBPOL,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.MBPOLY=MYBPOL SEGDES ELCOUR MYLRFS.LISEL(**)=ELCOUR * * Elément de nom : H1D2SE3 * Sur un segment : élément de Lagrange, fonction H1, approximation * nodale, espace de référence de dimension 1, 3 noeuds, 3 degrés de * liberté, degré de l'approximation : 2 * * In INILRF : SEGINI ELCOUR CALL INILRF('H1D2SE3','SEGMENT','LAGRANGE','H1', $ 1,3,3,2, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.XCONOD(1,1)=-UN ELCOUR.XCONOD(1,2)=ZERO ELCOUR.XCONOD(1,3)=UN * Les d.d.l. sont aux noeuds 1,2,3 DO 205 INDDL=1,3 ELCOUR.NPQUAF(INDDL)=INDDL ELCOUR.NUMCMP(INDDL)=1 205 CONTINUE * Initialise la correspondance ddl-noeud+ord.der CALL INILAG(ELCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Génère une base polynômiale complète (dimension 1, degré 2) CALL GBAPCO(1,2,MYBPOL,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELCOUR.MBPOLY=MYBPOL SEGDES ELCOUR MYLRFS.LISEL(**)=ELCOUR * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine inelse' RETURN * * End of subroutine INELSE * END