C CALPN SOURCE GOUNAND 21/06/02 21:15:07 11022 SUBROUTINE CALPN(MYLRF, $ PN, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : CALPN C PROJET : Noyau linéaire NLIN C DESCRIPTION : Calcul de la matrice nodale [PN]. C Si {Un} sont les degrés de liberté nodaux C sur l'élément de référence et C {a} les coefficients dans la base polynômiale C alors {Un} = [PN] {a}. C Explicitement : C [PN] = ( P1(ksi1) ..... Pn(ksi1)) C ( ... ..... ... ) C ( P1(ksin) ..... Pn(ksin)) C n = nb. ddl sur l'élément (NDFN) C ksii = coords. du ieme noeud d'approximation C dans l'espace de référence (de dimension C NDIML) C Pi = ieme polynome d'interpolation sur C l'élément de référence. C 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 : VALPOL C APPELE PAR : KFNREF C*********************************************************************** C ENTREES : MYLRF C ENTREES/SORTIES : - C SORTIES : PN C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 16/09/99, version initiale C HISTORIQUE : v1, 16/09/99, création C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF 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 -INC TNLIN *-INC SELREF POINTEUR MYLRF.ELREF *-INC SPOLYNO POINTEUR MYBPOL.POLYNS POINTEUR MYPOLY.POLYNO -INC TMXMAT POINTEUR PN.MXMAT * INTEGER IMPR,IRET * INTEGER INDFN,JNDFN INTEGER NDIML,NDIML2,NDFN,NBMONO,NPOLY * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpn' * * Initialisations * SEGACT MYLRF NDIML=MYLRF.XCONOD(/1) NDFN =MYLRF.NPQUAF(/1) MYBPOL=MYLRF.MBPOLY SEGACT MYBPOL NPOLY=MYBPOL.LIPOLY(/1) IF (NPOLY.NE.NDFN) THEN WRITE(IOIMP,*) 'Element fini mal défini' GOTO 9999 ENDIF LDIM1=NDFN LDIM2=NDFN SEGINI PN * * On calcule la matrice [PN] colonne par colonne * DO 1 JNDFN=1,NDFN MYPOLY=MYBPOL.LIPOLY(JNDFN) SEGACT MYPOLY NDIML2=MYPOLY.EXPMON(/1) IF (NDIML2.NE.NDIML) THEN WRITE(IOIMP,*) 'Grosse erreur...(dimensions de segments)' GOTO 9999 ENDIF NBMONO=MYPOLY.EXPMON(/2) DO 12 INDFN=1,NDFN * Calcul du polynôme JNDFN (ou une de ses dérivées) au point de * l'élément de référence numéro INDFN CALL VALPOL(NDIML,NBMONO, $ MYLRF.XCONOD(1,INDFN), $ MYPOLY.COEMON,MYPOLY.EXPMON, $ MYLRF.ORDDER(1,JNDFN), $ PN.XMAT(INDFN,JNDFN), $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 12 CONTINUE SEGDES MYPOLY 1 CONTINUE IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'On a créé [PN] (',NDFN,'x',NDFN,') :' DO 3 INDFN=1,NDFN WRITE(IOIMP,4004) (PN.XMAT(INDFN,JNDFN),JNDFN=1,NDFN) 3 CONTINUE ENDIF SEGDES PN SEGDES MYBPOL SEGDES MYLRF * * Normal termination * IRET=0 RETURN * * Format handling * 4004 FORMAT (2X,6(1X,1PE13.5)) * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine calpn' RETURN * * End of subroutine CALPN * END