C INFALS SOURCE GOUNAND 21/06/02 21:16:34 11022 SUBROUTINE INFALS(MYFALS,MYLRFS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INFALS C PROJET : Noyau linéaire NLIN C DESCRIPTION : Initialise le segment contenant les informations sur C l'ensemble des familles d'éléments de référence 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 : INIFAL, FILFAL, PRFAL (initialisations, impression) C APPELE PAR : PRNLI2 C*********************************************************************** C ENTREES : * MYLRFS (type ELREFS) : segment de description C des éléments de références. C ENTREES/SORTIES : - C SORTIES : * MYFALS (type FALRFS) : segment de description C des familles d'éléments de références. C TRAVAIL : * FACOUR (type FALRFS) : famille courante. C * NBDFA (type ENTIER) : nombre total de familles C d'éléments C * INBDFA (type ENTIER) : indice de boucle sur les C familles d'éléments C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 17/08/99, version initiale C HISTORIQUE : v1, 17/08/99, création C HISTORIQUE : 26/07/02, ajout du triangle cubique 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 TNLIN *-INC SELREF POINTEUR MYLRFS.ELREFS *-INC SFALRF POINTEUR MYFALS.FALRFS POINTEUR FACOUR.FALRF * INTEGER IMPR,IRET * INTEGER NBDFA,INBDFA * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infals' SEGINI MYFALS * * Famille de nom : CSTE * Elément de Lagrange, fonctions L2, approximation nodale, * degré de l'approximation : 0 * 7 éléments : segment, triangle, carré, tétraèdre, pyramide, * prisme, cube * * In INIFAL : SEGINI FACOUR CALL INIFAL('CSTE', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D0TR1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D0QU1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D0TE1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PY19','L2D0PY1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D0PR1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D0CU1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : LINM (linéaire par morceaux) * Elément de Lagrange, fonctions L2, approximation nodale, * degré de l'approximation : 1 * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube * * In INIFAL : SEGINI FACOUR CALL INIFAL('LINM', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D1SE2',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D1TR3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D1QU3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D1TE4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D1PR4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D1CU4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : LINE * Elément de Lagrange, fonctions H1, approximation nodale, * degré de l'approximation : 1 * * * In INIFAL : SEGINI FACOUR CALL INIFAL('LINE', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D1QU4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D1PY5',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D1PR6',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D1CU8',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : LINC * Elément de Lagrange, type Crouzeix-Raviart, approximation nodale, * degré de l'approximation : 1 * * * In INIFAL : SEGINI FACOUR CALL INIFAL('LINC', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','CRD1TR3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','CRD1QU4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','CRD1TE4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * La pyramide doit être facile à faire, les fonctions de forme * sont les mêmes que celles de la famille H1. * Mais cet élément marche-t-il ? Jamais vu dans la littérature * * CALL FILFAL(FACOUR,MYLRFS,'PY19','CRD1PY5',IMPR,IRET) * IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','CRD1PR5',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','CRD1CU6',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : LINB * Elément de Lagrange simpliciaux + bulle, * fonctions H1, approximation nodale, * degré de l'approximation : 1 * * In INIFAL : SEGINI FACOUR CALL INIFAL('LINB', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR4',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE5',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : QUAI * Elément de Lagrange incomplets, fonctions H1, approximation nodale, * degré de l'approximation : 2 * * In INIFAL : SEGINI FACOUR CALL INIFAL('QUAI', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU8',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D2PY13',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR15',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU20',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : QUAD * Elément de Lagrange, fonctions H1, approximation nodale, * degré de l'approximation : 2 * * In INIFAL : SEGINI FACOUR CALL INIFAL('QUAD', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR18',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : QUAF (Quadratique pour les fluides) * Elément de Lagrange + bulles éventuelles, fonctions H1, approximation * nodale, degré de l'approximation : 2 * * In INIFAL : SEGINI FACOUR CALL INIFAL('QUAF', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR7',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE15',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR21',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : CUBI * Elément de Lagrange, fonctions H1, approximation nodale, * degré de l'approximation : 3 * * In INIFAL : SEGINI FACOUR CALL INIFAL('CUBI', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D3TR10',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Famille de nom : BULL * Elément de Lagrange simpliciaux bulle, * fonctions H10, approximation nodale, * degré de l'approximation : 0 * * In INIFAL : SEGINI FACOUR CALL INIFAL('BULL', $ FACOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FILFAL(FACOUR,MYLRFS,'TRI7','H10D0TR1',IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES FACOUR MYFALS.LISFA(**)=FACOUR * * Impression finale * NBDFA=MYFALS.LISFA(/1) IF (IMPR.GT.1) THEN DO 3 INBDFA=1,NBDFA WRITE(IOIMP,*) 'Famille d''éléments de référence ',INBDFA FACOUR=MYFALS.LISFA(INBDFA) CALL PRFAL(FACOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 3 CONTINUE ENDIF SEGDES MYFALS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine infals' RETURN * * End of subroutine INFALS * END