C LINLI1 SOURCE GOUNAND 05/12/21 21:33:49 5281 SUBROUTINE LINLI1(NDDLPR,NDDLDU,NBPOGO, $ N2FVPR,N2FVDU, $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ, $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN, $ KDFRPR,KDFRDU, $ XPOPG, $ FVPR,FVDU,FCPR,FCDU, $ JDTJAC,LERF,JMTLIN, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : LINLI1 C DESCRIPTION : Calcul de la matrice. C C ! Commentaires non à jour ! C C LANGAGE : Fortran 77 (sauf E/S) C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : - C APPELE PAR : LINLIN C*********************************************************************** C ENTREES : * MYPG (type POGAU) : méthode d'intégration pour C le maillage élémentaire courant. C * FFGPR (type MCHEVA) : valeurs des fonctions C d'interpolation aux points de gauss sur C l'élément de référence pour la variable C primale. C Structure (cf.include SMCHAEL) : C (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1) C * DFFGPR (type MCHEVA) : valeurs des dérivées C premières des fonctions d'interpolation C primales aux points de gauss sur l'élément C réel. C Structure (cf.include SMCHAEL) : C (1, nb. ddl pri., 1, dim.esp.réel, C nb. poi. gauss, nb. élém.) C * FFGDU (type MCHEVA) : valeurs des fonctions C d'interpolation aux points de gauss sur C l'élément de référence pour la variable C duale. C Structure (cf.include SMCHAEL) : C (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1) C * DFFGDU (type MCHEVA) : valeurs des dérivées C premières des fonctions d'interpolation C duales aux points de gauss sur l'élément C réel. C Structure (cf.include SMCHAEL) : C (1, nb. ddl dua., 1, dim.esp.réel, C nb. poi. gauss, nb. élém.) C * CFGPR (type MCHEVA) : valeurs du coefficient C aux points de Gauss sur le maillage C élémentaire pour la variable primale. C Structure (cf.include SMCHAEL) : C (1, 1, 1, 1, C nb. poi. gauss, nb. éléments) C * CFGDU (type MCHEVA) : valeurs du coefficient C aux points de Gauss sur le maillage C élémentaire pour la variable duale. C Structure (cf.include SMCHAEL) : C (1, 1, 1, 1, C nb. poi. gauss, nb. éléments) C * KDERPR (type ENTIER) : dérivation sur la C variable primale. C * KDERDU(type ENTIER) : dérivation sur la C variable duale. C * JDTJAC (type MCHEVA) : valeurs du déterminant C de la matrice jacobienne aux points de Gauss C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, 1, 1, 1, nb. poi. gauss, nb. éléments) C * NBELEM (type entier) : nombre d'éléments du C maillage élémentaire courant. C ENTREES/SORTIES : * JMTLIN (type MCHEVA) : valeurs de la matrice C moindres carrés sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (nb. ddl dual, nb. ddl primal, C 1, 1, C 1, nb. éléments) C SORTIES : - C TRAVAIL : * NDDLDU (type entier) : nb. de ddl de la C variable duale par élément. C * NDDLPR (type entier) : nb. de ddl de la C variable primale par élément. C * IESREL (type entier) : dimension de l'espace C réel (i.e. géométrique). C * NBPOGO (type entier) : nombre de points C d'intégration. C * NLDFPR (type entier) : nombre d'éléments de C DFFGPR. C * NLDFDU (type entier) : nombre d'éléments de C DFFGDU. C * NLCPR (type entier) : nombre d'éléments de C CFGPR. C * NLCDU (type entier) : nombre d'éléments de C CFGDU. C * NLDTJ (type entier) : nombre d'éléments de C JDTJAC. C Les nombres d'éléments ci-dessus valent : C - soit NBELEM ; C - soit 1 si le champ par élément est constant sur le maillage C élémentaire courant. C * NLMLIN (type entier) : nombre d'éléments de C JMTLIN. C*********************************************************************** C VERSION : v3.1, 30/07/04, possiblité de travailler C dans l'espace de référence C VERSION : v1, 11/05/04, version initiale C HISTORIQUE : v1, 11/05/04, création 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 PPARAM -INC CCOPTIO INTEGER NDDLDU,NDDLPR,NBPOGO INTEGER N2FVPR,N2FVDU INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN INTEGER KDFRPR,KDFRDU REAL*8 XPOPG (NBPOGO) REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR) REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU) REAL*8 FCPR(NPFCPR,NLFCPR) REAL*8 FCDU(NPFCDU,NLFCDU) REAL*8 JDTJAC(NPDTJ,NLDTJ) REAL*8 JMTLIN(NDDLDU,NDDLPR,NLMLIN) * REAL*8 CONTRI,SPOGO,ISPOGO INTEGER LERF INTEGER IMPR,IRET INTEGER IDDLPR,IDDLDU,IPOGO,ILMLIN INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linli1' * Write(ioimp,*) 'linli1' * Write(ioimp,*) 'LERF=',LERF DO 1 ILMLIN=1,NLMLIN * * On suppose que le compilo pourra optimiser les IF * en les sortant de la boucle 1. (Très chiant a faire * a la main : 2^5 cas * * C'est pourquoi, on évite l'écriture * ILFVPR=MIN(ILMLIN,NLFVPR) plus courte mais sans * doute non optimisable * IF (NLFVPR.EQ.1) THEN ILFVPR=1 ELSE ILFVPR=ILMLIN ENDIF IF (NLFVDU.EQ.1) THEN ILFVDU=1 ELSE ILFVDU=ILMLIN ENDIF * IF (NLFCPR.EQ.1) THEN ILFCPR=1 ELSE ILFCPR=ILMLIN ENDIF IF (NLFCDU.EQ.1) THEN ILFCDU=1 ELSE ILFCDU=ILMLIN ENDIF * IF (NLDTJ.EQ.1) THEN ILDTJ=1 ELSE ILDTJ=ILMLIN ENDIF IF (LERF.EQ.2) THEN SPOGO=0.D0 DO IPOGO=1,NBPOGO SPOGO=SPOGO+XPOPG(IPOGO) ENDDO ISPOGO=1.D0/SPOGO * WRITE(IOIMP,*) 'ISPOGO=',ISPOGO ENDIF DO 12 IPOGO=1,NBPOGO IF (NPFVPR.EQ.1) THEN IPFVPR=1 ELSE IPFVPR=IPOGO ENDIF IF (NPFVDU.EQ.1) THEN IPFVDU=1 ELSE IPFVDU=IPOGO ENDIF * IF (NPFCPR.EQ.1) THEN IPFCPR=1 ELSE IPFCPR=IPOGO ENDIF IF (NPFCDU.EQ.1) THEN IPFCDU=1 ELSE IPFCDU=IPOGO ENDIF * IF (NPDTJ.EQ.1) THEN IPDTJ=1 ELSE IPDTJ=IPOGO ENDIF DO 12222 IDDLPR=1,NDDLPR DO 12224 IDDLDU=1,NDDLDU CONTRI= C $ XPOPG(IPOGO)* $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU) $ *FCDU(IPFCDU,ILFCDU) $ *FCPR(IPFCPR,ILFCPR) $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR) IF (LERF.EQ.0) THEN CONTRI=CONTRI*ABS(JDTJAC(IPDTJ,ILDTJ))*XPOPG(IPOGO) ELSEIF (LERF.EQ.1) THEN CONTRI=CONTRI*XPOPG(IPOGO) ELSEIF (LERF.EQ.2) THEN CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO ENDIF JMTLIN(IDDLDU,IDDLPR,ILMLIN)= $ JMTLIN(IDDLDU,IDDLPR,ILMLIN)+ $ CONTRI 12224 CONTINUE 12222 CONTINUE 12 CONTINUE 1 CONTINUE * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine linli1' RETURN * * End of subroutine LINLI1 * END