1 : C INELSE SOURCE GOUNAND 05/12/21 21:31:21 5281 2 : SUBROUTINE INELSE(MYLRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INELSE 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Remplit le segment des éléments de référence 9 : C avec les éléments de référence de dimension 1 10 : C (segments). 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES : INILRF, INILAG, GBAPCO 16 : C APPELE PAR : INLRFS 17 : C*********************************************************************** 18 : C ENTREES : - 19 : C ENTREES/SORTIES : MYLRFS 20 : C SORTIES : - 21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 22 : C*********************************************************************** 23 : C VERSION : v1, 23/03/00, version initiale 24 : C HISTORIQUE : v1, 23/03/00, création 25 : C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF 26 : C HISTORIQUE : 27 : C HISTORIQUE : 28 : C*********************************************************************** 29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 30 : C en cas de modification de ce sous-programme afin de faciliter 31 : C la maintenance ! 32 : C*********************************************************************** 33 : -INC CCOPTIO 34 : CBEGININCLUDE SELREF 35 : SEGMENT ELREF 36 : CHARACTER*(LNNOM) NOMLRF 37 : CHARACTER*(LNFORM) FORME 38 : CHARACTER*(LNTYPL) TYPEL 39 : CHARACTER*(LNESP) ESPACE 40 : INTEGER DEGRE 41 : REAL*8 XCONOD(NDIMEL,NBNOD) 42 : INTEGER NPQUAF(NBDDL) 43 : INTEGER NUMCMP(NBDDL) 44 : INTEGER QUENOD(NBDDL) 45 : INTEGER ORDDER(NDIMEL,NBDDL) 46 : POINTEUR MBPOLY.POLYNS 47 : ENDSEGMENT 48 : SEGMENT ELREFS 49 : POINTEUR LISEL(0).ELREF 50 : ENDSEGMENT 51 : CENDINCLUDE SELREF 52 : POINTEUR MYLRFS.ELREFS 53 : POINTEUR ELCOUR.ELREF 54 : CBEGININCLUDE SPOLYNO 55 : SEGMENT POLYNO 56 : REAL*8 COEMON(NBMON) 57 : INTEGER EXPMON(NDIML,NBMON) 58 : ENDSEGMENT 59 : SEGMENT POLYNS 60 : POINTEUR LIPOLY(NBPOLY).POLYNO 61 : ENDSEGMENT 62 : CENDINCLUDE SPOLYNO 63 : POINTEUR MYBPOL.POLYNS 64 : * 65 : INTEGER IMPR,IRET 66 : * Elément de nom : L2D0SE1 67 : REAL*8 ZERO 68 : PARAMETER (ZERO=0.D0) 69 : * Elément de nom : L2D1SE2 70 : REAL*8 UNS2 71 : PARAMETER (UNS2=0.5D0) 72 : * Elément de nom : H1D1SE2 73 : REAL*8 UN 74 : PARAMETER (UN=1.D0) 75 : * 76 : INTEGER INDDL 77 : * 78 : * Executable statements 79 : * 80 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelse' 81 : * 82 : * Elément de nom : L2D0SE1 83 : * Sur un segment : élément de Lagrange, fonction L2, approximation 84 : * nodale, espace de référence de dimension 1, 1 noeud, 1 degré de 85 : * liberté, degré de l'approximation : 0 86 : * 87 : * In INILRF : SEGINI ELCOUR 87 : CALL INILRF('L2D0SE1','SEGMENT','LAGRANGE','L2', 88 : $ 1,1,1,0, 89 : $ ELCOUR, 90 : $ IMPR,IRET) 91 : IF (IRET.NE.0) GOTO 9999 92 : ELCOUR.XCONOD(1,1)=ZERO 93 : ELCOUR.NPQUAF(1)=2 94 : ELCOUR.NUMCMP(1)=1 95 : * Initialise la correspondance ddl-noeud+ord.der 95 : CALL INILAG(ELCOUR,IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 97 : * Génère une base polynômiale complète (dimension 1, degré 0) 97 : CALL GBAPCO(1,0,MYBPOL,IMPR,IRET) 98 : IF (IRET.NE.0) GOTO 9999 99 : ELCOUR.MBPOLY=MYBPOL 100 : SEGDES ELCOUR 101 : MYLRFS.LISEL(**)=ELCOUR 102 : * 103 : * Elément de nom : L2D1SE2 104 : * Sur un segment : élément de Lagrange, fonction L2, approximation 105 : * nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de 106 : * liberté, degré de l'approximation : 1 107 : * 108 : * In INILRF : SEGINI ELCOUR 108 : CALL INILRF('L2D1SE2','SEGMENT','LAGRANGE','L2', 109 : $ 1,2,2,1, 110 : $ ELCOUR, 111 : $ IMPR,IRET) 112 : IF (IRET.NE.0) GOTO 9999 113 : ELCOUR.XCONOD(1,1)=-UNS2 114 : ELCOUR.XCONOD(1,2)= UNS2 115 : ELCOUR.NPQUAF(1)=2 116 : ELCOUR.NUMCMP(1)=1 117 : ELCOUR.NPQUAF(2)=2 118 : ELCOUR.NUMCMP(2)=2 119 : * Initialise la correspondance ddl-noeud+ord.der 119 : CALL INILAG(ELCOUR,IMPR,IRET) 120 : IF (IRET.NE.0) GOTO 9999 121 : * Génère une base polynômiale complète (dimension 1, degré 1) 121 : CALL GBAPCO(1,1,MYBPOL,IMPR,IRET) 122 : IF (IRET.NE.0) GOTO 9999 123 : ELCOUR.MBPOLY=MYBPOL 124 : SEGDES ELCOUR 125 : MYLRFS.LISEL(**)=ELCOUR 126 : * 127 : * Elément de nom : H1D1SE2 128 : * Sur un segment : élément de Lagrange, fonction H1, approximation 129 : * nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de 130 : * liberté, degré de l'approximation : 1 131 : * 132 : * In INILRF : SEGINI ELCOUR 132 : CALL INILRF('H1D1SE2','SEGMENT','LAGRANGE','H1', 133 : $ 1,2,2,1, 134 : $ ELCOUR, 135 : $ IMPR,IRET) 136 : IF (IRET.NE.0) GOTO 9999 137 : ELCOUR.XCONOD(1,1)=-UN 138 : ELCOUR.XCONOD(1,2)=UN 139 : ELCOUR.NPQUAF(1)=1 140 : ELCOUR.NUMCMP(1)=1 141 : ELCOUR.NPQUAF(2)=3 142 : ELCOUR.NUMCMP(2)=1 143 : * Initialise la correspondance ddl-noeud+ord.der 143 : CALL INILAG(ELCOUR,IMPR,IRET) 144 : IF (IRET.NE.0) GOTO 9999 145 : * Génère une base polynômiale complète (dimension 1, degré 1) 145 : CALL GBAPCO(1,1,MYBPOL,IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : ELCOUR.MBPOLY=MYBPOL 148 : SEGDES ELCOUR 149 : MYLRFS.LISEL(**)=ELCOUR 150 : * 151 : * Elément de nom : H1D2SE3 152 : * Sur un segment : élément de Lagrange, fonction H1, approximation 153 : * nodale, espace de référence de dimension 1, 3 noeuds, 3 degrés de 154 : * liberté, degré de l'approximation : 2 155 : * 156 : * In INILRF : SEGINI ELCOUR 156 : CALL INILRF('H1D2SE3','SEGMENT','LAGRANGE','H1', 157 : $ 1,3,3,2, 158 : $ ELCOUR, 159 : $ IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : ELCOUR.XCONOD(1,1)=-UN 162 : ELCOUR.XCONOD(1,2)=ZERO 163 : ELCOUR.XCONOD(1,3)=UN 164 : * Les d.d.l. sont aux noeuds 1,2,3 165 : DO 205 INDDL=1,3 166 : ELCOUR.NPQUAF(INDDL)=INDDL 167 : ELCOUR.NUMCMP(INDDL)=1 168 : 205 CONTINUE 169 : * Initialise la correspondance ddl-noeud+ord.der 169 : CALL INILAG(ELCOUR,IMPR,IRET) 170 : IF (IRET.NE.0) GOTO 9999 171 : * Génère une base polynômiale complète (dimension 1, degré 2) 171 : CALL GBAPCO(1,2,MYBPOL,IMPR,IRET) 172 : IF (IRET.NE.0) GOTO 9999 173 : ELCOUR.MBPOLY=MYBPOL 174 : SEGDES ELCOUR 175 : MYLRFS.LISEL(**)=ELCOUR 176 : * 177 : * Normal termination 178 : * 179 : IRET=0 180 : RETURN 181 : * 182 : * Format handling 183 : * 184 : * 185 : * Error handling 186 : * 187 : 9999 CONTINUE 188 : IRET=1 189 : WRITE(IOIMP,*) 'An error was detected in subroutine inelse' 190 : RETURN 191 : * 192 : * End of subroutine INELSE 193 : * 194 : END 195 : 196 : 197 :
© Cast3M 2003 - All rights reserved.
Disclaimer