1 : C LINLI1 SOURCE GOUNAND 05/12/21 21:33:49 5281 2 : SUBROUTINE LINLI1(NDDLPR,NDDLDU,NBPOGO, 3 : $ N2FVPR,N2FVDU, 4 : $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ, 5 : $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN, 6 : $ KDFRPR,KDFRDU, 7 : $ XPOPG, 8 : $ FVPR,FVDU,FCPR,FCDU, 9 : $ JDTJAC,LERF,JMTLIN, 10 : $ IMPR,IRET) 11 : IMPLICIT REAL*8 (A-H,O-Z) 12 : IMPLICIT INTEGER (I-N) 13 : C*********************************************************************** 14 : C NOM : LINLI1 15 : C DESCRIPTION : Calcul de la matrice. 16 : C 17 : C ! Commentaires non à jour ! 18 : C 19 : C LANGAGE : Fortran 77 (sauf E/S) 20 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 21 : C mél : gounand@semt2.smts.cea.fr 22 : C*********************************************************************** 23 : C APPELES : - 24 : C APPELE PAR : LINLIN 25 : C*********************************************************************** 26 : C ENTREES : * MYPG (type POGAU) : méthode d'intégration pour 27 : C le maillage élémentaire courant. 28 : C * FFGPR (type MCHEVA) : valeurs des fonctions 29 : C d'interpolation aux points de gauss sur 30 : C l'élément de référence pour la variable 31 : C primale. 32 : C Structure (cf.include SMCHAEL) : 33 : C (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1) 34 : C * DFFGPR (type MCHEVA) : valeurs des dérivées 35 : C premières des fonctions d'interpolation 36 : C primales aux points de gauss sur l'élément 37 : C réel. 38 : C Structure (cf.include SMCHAEL) : 39 : C (1, nb. ddl pri., 1, dim.esp.réel, 40 : C nb. poi. gauss, nb. élém.) 41 : C * FFGDU (type MCHEVA) : valeurs des fonctions 42 : C d'interpolation aux points de gauss sur 43 : C l'élément de référence pour la variable 44 : C duale. 45 : C Structure (cf.include SMCHAEL) : 46 : C (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1) 47 : C * DFFGDU (type MCHEVA) : valeurs des dérivées 48 : C premières des fonctions d'interpolation 49 : C duales aux points de gauss sur l'élément 50 : C réel. 51 : C Structure (cf.include SMCHAEL) : 52 : C (1, nb. ddl dua., 1, dim.esp.réel, 53 : C nb. poi. gauss, nb. élém.) 54 : C * CFGPR (type MCHEVA) : valeurs du coefficient 55 : C aux points de Gauss sur le maillage 56 : C élémentaire pour la variable primale. 57 : C Structure (cf.include SMCHAEL) : 58 : C (1, 1, 1, 1, 59 : C nb. poi. gauss, nb. éléments) 60 : C * CFGDU (type MCHEVA) : valeurs du coefficient 61 : C aux points de Gauss sur le maillage 62 : C élémentaire pour la variable duale. 63 : C Structure (cf.include SMCHAEL) : 64 : C (1, 1, 1, 1, 65 : C nb. poi. gauss, nb. éléments) 66 : C * KDERPR (type ENTIER) : dérivation sur la 67 : C variable primale. 68 : C * KDERDU(type ENTIER) : dérivation sur la 69 : C variable duale. 70 : C * JDTJAC (type MCHEVA) : valeurs du déterminant 71 : C de la matrice jacobienne aux points de Gauss 72 : C sur le maillage élémentaire. 73 : C Structure (cf.include SMCHAEL) : 74 : C (1, 1, 1, 1, nb. poi. gauss, nb. éléments) 75 : C * NBELEM (type entier) : nombre d'éléments du 76 : C maillage élémentaire courant. 77 : C ENTREES/SORTIES : * JMTLIN (type MCHEVA) : valeurs de la matrice 78 : C moindres carrés sur le maillage élémentaire. 79 : C Structure (cf.include SMCHAEL) : 80 : C (nb. ddl dual, nb. ddl primal, 81 : C 1, 1, 82 : C 1, nb. éléments) 83 : C SORTIES : - 84 : C TRAVAIL : * NDDLDU (type entier) : nb. de ddl de la 85 : C variable duale par élément. 86 : C * NDDLPR (type entier) : nb. de ddl de la 87 : C variable primale par élément. 88 : C * IESREL (type entier) : dimension de l'espace 89 : C réel (i.e. géométrique). 90 : C * NBPOGO (type entier) : nombre de points 91 : C d'intégration. 92 : C * NLDFPR (type entier) : nombre d'éléments de 93 : C DFFGPR. 94 : C * NLDFDU (type entier) : nombre d'éléments de 95 : C DFFGDU. 96 : C * NLCPR (type entier) : nombre d'éléments de 97 : C CFGPR. 98 : C * NLCDU (type entier) : nombre d'éléments de 99 : C CFGDU. 100 : C * NLDTJ (type entier) : nombre d'éléments de 101 : C JDTJAC. 102 : C Les nombres d'éléments ci-dessus valent : 103 : C - soit NBELEM ; 104 : C - soit 1 si le champ par élément est constant sur le maillage 105 : C élémentaire courant. 106 : C * NLMLIN (type entier) : nombre d'éléments de 107 : C JMTLIN. 108 : C*********************************************************************** 109 : C VERSION : v3.1, 30/07/04, possiblité de travailler 110 : C dans l'espace de référence 111 : C VERSION : v1, 11/05/04, version initiale 112 : C HISTORIQUE : v1, 11/05/04, création 113 : C HISTORIQUE : 114 : C HISTORIQUE : 115 : C*********************************************************************** 116 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 117 : C en cas de modification de ce sous-programme afin de faciliter 118 : C la maintenance ! 119 : C*********************************************************************** 120 : -INC CCOPTIO 121 : INTEGER NDDLDU,NDDLPR,NBPOGO 122 : INTEGER N2FVPR,N2FVDU 123 : INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ 124 : INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN 125 : INTEGER KDFRPR,KDFRDU 126 : REAL*8 XPOPG (NBPOGO) 127 : REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR) 128 : REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU) 129 : REAL*8 FCPR(NPFCPR,NLFCPR) 130 : REAL*8 FCDU(NPFCDU,NLFCDU) 131 : REAL*8 JDTJAC(NPDTJ,NLDTJ) 132 : REAL*8 JMTLIN(NDDLDU,NDDLPR,NLMLIN) 133 : * 134 : REAL*8 CONTRI,SPOGO,ISPOGO 135 : INTEGER LERF 136 : INTEGER IMPR,IRET 137 : INTEGER IDDLPR,IDDLDU,IPOGO,ILMLIN 138 : INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ 139 : INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ 140 : * 141 : * Executable statements 142 : * 143 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linli1' 144 : * Write(ioimp,*) 'linli1' 145 : * Write(ioimp,*) 'LERF=',LERF 146 : DO 1 ILMLIN=1,NLMLIN 147 : * 148 : * On suppose que le compilo pourra optimiser les IF 149 : * en les sortant de la boucle 1. (Très chiant a faire 150 : * a la main : 2^5 cas 151 : * 152 : * C'est pourquoi, on évite l'écriture 153 : * ILFVPR=MIN(ILMLIN,NLFVPR) plus courte mais sans 154 : * doute non optimisable 155 : * 156 : IF (NLFVPR.EQ.1) THEN 157 : ILFVPR=1 158 : ELSE 159 : ILFVPR=ILMLIN 160 : ENDIF 161 : IF (NLFVDU.EQ.1) THEN 162 : ILFVDU=1 163 : ELSE 164 : ILFVDU=ILMLIN 165 : ENDIF 166 : * 167 : IF (NLFCPR.EQ.1) THEN 168 : ILFCPR=1 169 : ELSE 170 : ILFCPR=ILMLIN 171 : ENDIF 172 : IF (NLFCDU.EQ.1) THEN 173 : ILFCDU=1 174 : ELSE 175 : ILFCDU=ILMLIN 176 : ENDIF 177 : * 178 : IF (NLDTJ.EQ.1) THEN 179 : ILDTJ=1 180 : ELSE 181 : ILDTJ=ILMLIN 182 : ENDIF 183 : IF (LERF.EQ.2) THEN 184 : SPOGO=0.D0 185 : DO IPOGO=1,NBPOGO 186 : SPOGO=SPOGO+XPOPG(IPOGO) 187 : ENDDO 188 : ISPOGO=1.D0/SPOGO 189 : * WRITE(IOIMP,*) 'ISPOGO=',ISPOGO 190 : ENDIF 191 : DO 12 IPOGO=1,NBPOGO 192 : IF (NPFVPR.EQ.1) THEN 193 : IPFVPR=1 194 : ELSE 195 : IPFVPR=IPOGO 196 : ENDIF 197 : IF (NPFVDU.EQ.1) THEN 198 : IPFVDU=1 199 : ELSE 200 : IPFVDU=IPOGO 201 : ENDIF 202 : * 203 : IF (NPFCPR.EQ.1) THEN 204 : IPFCPR=1 205 : ELSE 206 : IPFCPR=IPOGO 207 : ENDIF 208 : IF (NPFCDU.EQ.1) THEN 209 : IPFCDU=1 210 : ELSE 211 : IPFCDU=IPOGO 212 : ENDIF 213 : * 214 : IF (NPDTJ.EQ.1) THEN 215 : IPDTJ=1 216 : ELSE 217 : IPDTJ=IPOGO 218 : ENDIF 219 : DO 12222 IDDLPR=1,NDDLPR 220 : DO 12224 IDDLDU=1,NDDLDU 221 : CONTRI= 222 : C $ XPOPG(IPOGO)* 223 : $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU) 224 : $ *FCDU(IPFCDU,ILFCDU) 225 : $ *FCPR(IPFCPR,ILFCPR) 226 : $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR) 227 : IF (LERF.EQ.0) THEN 228 : CONTRI=CONTRI*ABS(JDTJAC(IPDTJ,ILDTJ))*XPOPG(IPOGO) 229 : ELSEIF (LERF.EQ.1) THEN 230 : CONTRI=CONTRI*XPOPG(IPOGO) 231 : ELSEIF (LERF.EQ.2) THEN 232 : CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO 233 : ENDIF 234 : JMTLIN(IDDLDU,IDDLPR,ILMLIN)= 235 : $ JMTLIN(IDDLDU,IDDLPR,ILMLIN)+ 236 : $ CONTRI 237 : 12224 CONTINUE 238 : 12222 CONTINUE 239 : 12 CONTINUE 240 : 1 CONTINUE 241 : * 242 : * Normal termination 243 : * 244 : IRET=0 245 : RETURN 246 : * 247 : * Format handling 248 : * 249 : * 250 : * Error handling 251 : * 252 : 9999 CONTINUE 253 : IRET=1 254 : WRITE(IOIMP,*) 'An error was detected in subroutine linli1' 255 : RETURN 256 : * 257 : * End of subroutine LINLI1 258 : * 259 : END 260 : 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer