C KFNREF SOURCE GOUNAND 21/06/02 21:17:07 11022 SUBROUTINE KFNREF(MYLRF,MYPG, $ FNPG,DFNPG, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : KFNREF C PROJET : Noyau linéaire NLIN C DESCRIPTION : Calcul des fonctions de forme et de leurs C dérivées aux points de Gauss sur l'élément C de référence. C Le but avoué de ce sous-programme est d'effectuer C toutes les opérations de pré-traitement sur un élément C de référence donné. 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 : CALPN, IVMAT, NI C APPELE PAR : KALPBG C*********************************************************************** C ENTREES : MYLRF, MYPG C ENTREES/SORTIES : - C SORTIES : FNPG, DFNPG C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 26/07/99, version initiale C HISTORIQUE : v1, 26/07/99, création C HISTORIQUE : v1.1 16/09/99, remaniement pour que la base polynômiale C puisse contenir des polynômes au lieu de C monômes exclusivement... C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF C HISTORIQUE : v2.1 02/10/03 ajout d'astuces 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 CCREEL -INC TNLIN *-INC SELREF POINTEUR MYLRF.ELREF *-INC SPOGAU POINTEUR MYPG.POGAU *-INC SMCHAEL POINTEUR FNPG.MCHEVA POINTEUR DFNPG.MCHEVA -INC SMLENTI INTEGER JG POINTEUR IVTMP.MLENTI -INC TMXMAT POINTEUR PN.MXMAT POINTEUR PNM1.MXMAT * INTEGER IMPR,IRET * LOGICAL LLAHE,LCAST LOGICAL LCSTE,LLINE,LEGAL INTEGER NDFN REAL*8 DETPN * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans kfnref' SEGACT MYLRF * LCAST=(MYLRF.NOMLRF.EQ.'H1D1PY5'.OR.MYLRF.NOMLRF.EQ.'H1D2PY13' $ .OR.MYLRF.NOMLRF.EQ.'H1D2PR15'.OR.MYLRF.NOMLRF.EQ.'H1D2CU20') * NDIML=MYLRF.ORDDER(/1) NBDDL=MYLRF.ORDDER(/2) LLAHE=(MYLRF.TYPEL.EQ.'LAGRANGE'.OR.MYLRF.TYPEL.EQ.'HERMITE') * On fait un cas particulier aux éléments de Lagrange * à un ddl : dans ce cas-la, la fonction de forme * est constante et sa dérivée est nulle LCSTE=(MYLRF.TYPEL.EQ.'LAGRANGE'.AND.NBDDL.EQ.1) * On fait un cas particulier aux éléments de Lagrange * linéaire (simplex) : dans ce cas-la, les dérivées des fonctions de * forme sont constantes LLINE=(MYLRF.TYPEL.EQ.'LAGRANGE'.AND.NBDDL.EQ.(NDIML+1)) SEGDES MYLRF * * On repique les éléments dans SHAPE * IF (LCAST) THEN CALL SH2FNR(MYLRF,MYPG, $ FNPG,DFNPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Astuce foireuse * ELSEIF (LCSTE) THEN NBLIG=1 NBCOL=1 N2LIG=1 N2COL=1 NBPOI=1 NBELM=1 SEGINI FNPG FNPG.WELCHE(1,1,1,1,1,1)=1.D0 SEGDES FNPG NBLIG=1 NBCOL=1 N2LIG=1 N2COL=NDIML NBPOI=1 NBELM=1 SEGINI DFNPG DO IDIML=1,NDIML DFNPG.WELCHE(1,1,1,IDIML,1,1)=0.D0 ENDDO SEGDES DFNPG * Cas des éléments de Lagrange et Hermite ELSEIF (LLAHE) THEN * * Construisons la Matrice [PN] à l'aide de la base polynômiale : * et des coordonnées de noeuds d'approximation ** CALL CALPN(MYLRF, $ PN, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Inversons la Matrice [PN] * SEGACT PN SEGINI,PNM1=PN NDFN=PN.XMAT(/1) JG=NDFN SEGINI IVTMP IIMPR=1 CALL IVMAT(NDFN,PN.XMAT, $ IVTMP.LECT, $ PNM1.XMAT,DETPN, $ IIMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP IVTMP SEGSUP PN * * On peut maintenant calculer les valeurs des fonctions de forme * et leurs dérivées premières (par rapport aux coordonnées de l'espace * de référence) aux points de Gauss sur l'élément de référence * CALL NI(MYLRF,MYPG,PNM1, $ FNPG,DFNPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP PNM1 ELSE WRITE(IOIMP,*) 'Le type d''élément ',MYLRF.TYPEL WRITE(IOIMP,*) 'n''est pas reconnu.' GOTO 9999 ENDIF * * Astuce foireuse (mais on fait quand même des * vérifications) * IF (LLINE) THEN SEGACT DFNPG*MOD NBPOGO=DFNPG.WELCHE(/5) DO IDIML=1,NDIML DO IDDL=1,NBDDL VALDF=DFNPG.WELCHE(1,IDDL,1,IDIML,1,1) DO IPOGO=2,NBPOGO VALDF2=DFNPG.WELCHE(1,IDDL,1,IDIML,IPOGO,1) LEGAL=(ABS(VALDF2-VALDF).LE.100.D0*XZPREC) IF (.NOT.LEGAL) THEN WRITE(IOIMP,*) 'Houston, on a un probleme' * SEGPRT,DFNPG GOTO 9999 ENDIF ENDDO ENDDO ENDDO NBLIG=1 NBCOL=NBDDL N2LIG=1 N2COL=NDIML NBPOI=1 NBELM=1 SEGADJ,DFNPG SEGDES DFNPG ENDIF * * Normal termination * IRET=0 RETURN * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine kfnref' RETURN * * End of subroutine KFNREF * END