1 : C LINLIN SOURCE GOUNAND 05/12/21 21:33:54 5281 2 : SUBROUTINE LINLIN(PGCOUR, 3 : $ FVPR,FVDU,FCPR,FCDU, 4 : $ KDERPR,KDERDU, 5 : $ JDTJAC,NBELEM,LERF,IESREF, 6 : $ JMTLIN, 7 : $ IMPR,IRET) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : IMPLICIT INTEGER (I-N) 10 : C*********************************************************************** 11 : C NOM : LINLIN 12 : C DESCRIPTION : Calcul de la matrice. 13 : C 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : LINLI1 (calcul de JMTLIN (fortran 77)) 20 : C APPELE PAR : NLIN 21 : C*********************************************************************** 22 : C ENTREES : * PGCOUR (type POGAU) : méthode d'intégration pour 23 : C le maillage élémentaire courant. 24 : C * FFGPR (type MCHEVA) : valeurs des fonctions 25 : C d'interpolation aux points de gauss sur 26 : C l'élément de référence pour la variable 27 : C primale. 28 : C Structure (cf.include SMCHAEL) : 29 : C (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1) 30 : C * DFFGPR (type MCHEVA) : valeurs des dérivées 31 : C premières des fonctions d'interpolation 32 : C primales aux points de gauss sur l'élément 33 : C réel. 34 : C Structure (cf.include SMCHAEL) : 35 : C (1, nb. ddl pri., 1, dim.esp.réel, 36 : C nb. poi. gauss, nb. élém.) 37 : C * FFGDU (type MCHEVA) : valeurs des fonctions 38 : C d'interpolation aux points de gauss sur 39 : C l'élément de référence pour la variable 40 : C duale. 41 : C Structure (cf.include SMCHAEL) : 42 : C (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1) 43 : C * DFFGDU (type MCHEVA) : valeurs des dérivées 44 : C premières des fonctions d'interpolation 45 : C duales aux points de gauss sur l'élément 46 : C réel. 47 : C Structure (cf.include SMCHAEL) : 48 : C (1, nb. ddl dua., 1, dim.esp.réel, 49 : C nb. poi. gauss, nb. élém.) 50 : C * CFGPR (type MCHEVA) : valeurs du coefficient 51 : C aux points de Gauss sur le maillage 52 : C élémentaire pour la variable primale. 53 : C Structure (cf.include SMCHAEL) : 54 : C (1, 1, 1, 1, 55 : C nb. poi. gauss, nb. éléments) 56 : C * CFGDU (type MCHEVA) : valeurs du coefficient 57 : C aux points de Gauss sur le maillage 58 : C élémentaire pour la variable duale. 59 : C Structure (cf.include SMCHAEL) : 60 : C (1, 1, 1, 1, 61 : C nb. poi. gauss, nb. éléments) 62 : C * KDERPR (type ENTIER) : dérivation sur la 63 : C variable primale. 64 : C * KDERDU(type ENTIER) : dérivation sur la 65 : C variable duale. 66 : C * JDTJAC (type MCHEVA) : valeurs du déterminant 67 : C de la matrice jacobienne aux points de Gauss 68 : C sur le maillage élémentaire. 69 : C Structure (cf.include SMCHAEL) : 70 : C (1, 1, 1, 1, nb. poi. gauss, nb. éléments) 71 : C * NBELEM (type entier) : nombre d'éléments du 72 : C maillage élémentaire courant. 73 : C ENTREES/SORTIES : * JMTLIN (type MCHEVA) : valeurs de la matrice 74 : C moindres carrés sur le maillage élémentaire. 75 : C Structure (cf.include SMCHAEL) : 76 : C (nb. ddl dual, nb. ddl primal, 77 : C 1, 1, 78 : C 1, nb. éléments) 79 : C SORTIES : - 80 : C TRAVAIL : * NDDLDU (type entier) : nb. de ddl de la 81 : C variable duale par élément. 82 : C * NDDLPR (type entier) : nb. de ddl de la 83 : C variable primale par élément. 84 : C * IESREL (type entier) : dimension de l'espace 85 : C réel (i.e. géométrique). 86 : C * NBPOGO (type entier) : nombre de points 87 : C d'intégration. 88 : C * NLDFPR (type entier) : nombre d'éléments de 89 : C DFFGPR. 90 : C * NLDFDU (type entier) : nombre d'éléments de 91 : C DFFGDU. 92 : C * NLCPR (type entier) : nombre d'éléments de 93 : C CFGPR. 94 : C * NLCDU (type entier) : nombre d'éléments de 95 : C CFGDU. 96 : C * NLDTJ (type entier) : nombre d'éléments de 97 : C JDTJAC. 98 : C Les nombres d'éléments ci-dessus valent : 99 : C - soit NBELEM ; 100 : C - soit 1 si le champ par élément est constant sur le maillage 101 : C élémentaire courant. 102 : C * NLMLIN (type entier) : nombre d'éléments de 103 : C JMTLIN. 104 : C*********************************************************************** 105 : C VERSION : v3.1, 30/07/04, possiblité de travailler 106 : C dans l'espace de référence 107 : C VERSION : v1, 11/05/04, version initiale 108 : C HISTORIQUE : v1, 11/05/04, création 109 : C HISTORIQUE : 110 : C HISTORIQUE : 111 : C*********************************************************************** 112 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 113 : C en cas de modification de ce sous-programme afin de faciliter 114 : C la maintenance ! 115 : C*********************************************************************** 116 : -INC CCOPTIO 117 : CBEGININCLUDE SPOGAU 118 : SEGMENT POGAU 119 : CHARACTER*(LNNPG) NOMPG 120 : CHARACTER*(LNTPG) TYPMPG 121 : CHARACTER*(LNFPG) FORLPG 122 : INTEGER NORDPG 123 : REAL*8 XCOPG(NDLPG,NBPG) 124 : REAL*8 XPOPG(NBPG) 125 : ENDSEGMENT 126 : SEGMENT POGAUS 127 : POINTEUR LISPG(0).POGAU 128 : ENDSEGMENT 129 : CENDINCLUDE SPOGAU 130 : POINTEUR PGCOUR.POGAU 131 : CBEGININCLUDE SMCHAEL 132 : SEGMENT MCHAEL 133 : POINTEUR IMACHE(N1).MELEME 134 : POINTEUR ICHEVA(N1).MCHEVA 135 : ENDSEGMENT 136 : SEGMENT MCHEVA 137 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 138 : ENDSEGMENT 139 : SEGMENT LCHEVA 140 : POINTEUR LISCHE(NBCHE).MCHEVA 141 : ENDSEGMENT 142 : CENDINCLUDE SMCHAEL 143 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 144 : POINTEUR FVPR.MCHEVA,FVDU.MCHEVA 145 : POINTEUR FCPR.MCHEVA,FCDU.MCHEVA 146 : POINTEUR JDTJAC.MCHEVA 147 : POINTEUR JMTLIN.MCHEVA 148 : * 149 : INTEGER KDERPR,KDERDU 150 : INTEGER NBELEM 151 : INTEGER LERF 152 : INTEGER IMPR,IRET 153 : * 154 : INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM 155 : INTEGER NLDTJ,NLMLIN 156 : INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO 157 : * 158 : * Executable statements 159 : * 160 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linlin' 161 : * 162 : IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN 163 : WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR 164 : GOTO 9999 165 : ENDIF 166 : * 167 : IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN 168 : WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU 169 : GOTO 9999 170 : ENDIF 171 : * 172 : IESREL=IDIM 173 : IF (LERF.NE.0) THEN 174 : IESDER=IESREF 175 : ELSE 176 : IESDER=IESREL 177 : ENDIF 178 : * 179 : SEGACT PGCOUR 180 : NBPOGO=PGCOUR.XPOPG(/1) 181 : * 182 : * SEGPRT,FVPR 183 : SEGACT FVPR 184 : NDLIG=FVPR.VELCHE(/1) 185 : NDCOL=FVPR.VELCHE(/2) 186 : N2DLIG=FVPR.VELCHE(/3) 187 : N2DCOL=FVPR.VELCHE(/4) 188 : NDNOEU=FVPR.VELCHE(/5) 189 : NDELM=FVPR.VELCHE(/6) 190 : IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR. 191 : $ ((N2DCOL.NE.1.AND.KDERPR.EQ.0) 192 : $ .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0)) 193 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 194 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 195 : WRITE(IOIMP,*) 'Erreur dims FVPR' 196 : GOTO 9999 197 : ENDIF 198 : NDDLPR=NDCOL 199 : N2FVPR=N2DCOL 200 : NPFVPR=NDNOEU 201 : NLFVPR=NDELM 202 : * 203 : * SEGPRT,FVDU 204 : SEGACT FVDU 205 : NDLIG=FVDU.VELCHE(/1) 206 : NDCOL=FVDU.VELCHE(/2) 207 : N2DLIG=FVDU.VELCHE(/3) 208 : N2DCOL=FVDU.VELCHE(/4) 209 : NDNOEU=FVDU.VELCHE(/5) 210 : NDELM=FVDU.VELCHE(/6) 211 : IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR. 212 : $ ((N2DCOL.NE.1.AND.KDERDU.EQ.0) 213 : $ .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0)) 214 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 215 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 216 : WRITE(IOIMP,*) 'Erreur dims FVDU' 217 : GOTO 9999 218 : ENDIF 219 : NDDLDU=NDCOL 220 : N2FVDU=N2DCOL 221 : NPFVDU=NDNOEU 222 : NLFVDU=NDELM 223 : * 224 : * SEGPRT,FCPR 225 : SEGACT FCPR 226 : NDLIG =FCPR.VELCHE(/1) 227 : NDCOL =FCPR.VELCHE(/2) 228 : N2DLIG=FCPR.VELCHE(/3) 229 : N2DCOL=FCPR.VELCHE(/4) 230 : NDNOEU=FCPR.VELCHE(/5) 231 : NDELM =FCPR.VELCHE(/6) 232 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR. 233 : $ N2DCOL.NE.1 234 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 235 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 236 : WRITE(IOIMP,*) 'Erreur dims FCPR' 237 : GOTO 9999 238 : ENDIF 239 : NPFCPR=NDNOEU 240 : NLFCPR=NDELM 241 : * 242 : * SEGPRT,FCDU 243 : SEGACT FCDU 244 : NDLIG =FCDU.VELCHE(/1) 245 : NDCOL =FCDU.VELCHE(/2) 246 : N2DLIG=FCDU.VELCHE(/3) 247 : N2DCOL=FCDU.VELCHE(/4) 248 : NDNOEU=FCDU.VELCHE(/5) 249 : NDELM =FCDU.VELCHE(/6) 250 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR. 251 : $ N2DCOL.NE.1 252 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 253 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 254 : WRITE(IOIMP,*) 'Erreur dims FCDU' 255 : GOTO 9999 256 : ENDIF 257 : NPFCDU=NDNOEU 258 : NLFCDU=NDELM 259 : * 260 : SEGACT JDTJAC 261 : NDLIG=JDTJAC.VELCHE(/1) 262 : NDCOL=JDTJAC.VELCHE(/2) 263 : N2DLIG=JDTJAC.VELCHE(/3) 264 : N2DCOL=JDTJAC.VELCHE(/4) 265 : NDNOEU=JDTJAC.VELCHE(/5) 266 : NDELM=JDTJAC.VELCHE(/6) 267 : IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1 268 : $ .OR.N2DCOL.NE.1 269 : $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO) 270 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 271 : WRITE(IOIMP,*) 'Erreur dims JDTJAC' 272 : GOTO 9999 273 : ENDIF 274 : NPDTJ=NDNOEU 275 : NLDTJ=NDELM 276 : * 277 : IF (JMTLIN.EQ.0) THEN 278 : NBLIG=NDDLDU 279 : NBCOL=NDDLPR 280 : N2LIG=1 281 : N2COL=1 282 : NBPOI=1 283 : NBELM=NBELEM 284 : * On pourrait aussi envisager de renvoyer une seule matrice pour le cas 285 : * où NLCFG=NLFPRG=NLFDUG=NLDTJ=1 286 : SEGINI JMTLIN 287 : NLMLIN=NBELM 288 : ELSE 289 : SEGACT JMTLIN*MOD 290 : NDLIG=JMTLIN.VELCHE(/1) 291 : NDCOL=JMTLIN.VELCHE(/2) 292 : N2DLIG=JMTLIN.VELCHE(/3) 293 : N2DCOL=JMTLIN.VELCHE(/4) 294 : NDNOEU=JMTLIN.VELCHE(/5) 295 : NDELM=JMTLIN.VELCHE(/6) 296 : IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1 297 : $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1 298 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN 299 : WRITE(IOIMP,*) 'Erreur dims JMTLIN' 300 : GOTO 9999 301 : ENDIF 302 : NLMLIN=NDELM 303 : ENDIF 304 : * 305 : KDFRPR=MAX(1,KDERPR) 306 : KDFRDU=MAX(1,KDERDU) 307 : * 308 : * On effectue le calcul de la matrice de moindres carrés 309 : * 309 : CALL LINLI1(NDDLPR,NDDLDU,NBPOGO, 310 : $ N2FVPR,N2FVDU, 311 : $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ, 312 : $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN, 313 : $ KDFRPR,KDFRDU, 314 : $ PGCOUR.XPOPG, 315 : $ FVPR.VELCHE,FVDU.VELCHE,FCPR.VELCHE,FCDU.VELCHE, 316 : $ JDTJAC.VELCHE,LERF,JMTLIN.VELCHE, 317 : $ IMPR,IRET) 318 : IF (IRET.NE.0) GOTO 9999 319 : * SEGDES JMTLIN 320 : SEGDES JMTLIN 321 : * IMPR=6 322 : IF (IMPR.GT.3) THEN 323 : WRITE(IOIMP,*) 'On a créé', 324 : $ ' JMTLIN(élément ,1 ,1 ,1 ,', 325 : $ ' ddl.pri , ddl.dua)' 325 : CALL PRCHVA(JMTLIN,IMPR,IRET) 326 : IF (IRET.NE.0) GOTO 9999 327 : ENDIF 328 : * IMPR=0 329 : SEGDES JDTJAC 330 : SEGDES FCDU 331 : SEGDES FCPR 332 : SEGDES FVDU 333 : SEGDES FVPR 334 : SEGDES PGCOUR 335 : * 336 : * Normal termination 337 : * 338 : IRET=0 339 : RETURN 340 : * 341 : * Format handling 342 : * 343 : * 344 : * Error handling 345 : * 346 : 9999 CONTINUE 347 : IRET=1 348 : WRITE(IOIMP,*) 'An error was detected in subroutine linlin' 349 : RETURN 350 : * 351 : * End of subroutine LINLIN 352 : * 353 : END 354 : 355 :
© Cast3M 2003 - All rights reserved.
Disclaimer