1 : C DFNFR1 SOURCE GOUNAND 06/01/18 21:15:21 5293 2 : SUBROUTINE DFNFR1(NDDL,IESREF,IESREL,NPFF,NDPOGO,NBELEM, 3 : $ NPJMI, 4 : $ DFFPG,JMIJAC, 5 : $ JDFFPG, 6 : $ IMPR,IRET) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : DFNFR1 11 : C DESCRIPTION : 12 : C 13 : C 14 : C 15 : C LANGAGE : Fortran 77 (sauf E/S) 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 : - 20 : C APPELE PAR : DFNFR 21 : C*********************************************************************** 22 : C ENTREES : * NDDL (type entier) : nombre de ddl (par 23 : C élément) de la transformation géométrique. 24 : C * IESREF (type entier) : dimension de l'espace de 25 : C référence. 26 : C * IESREL (type entier) : dimension de l'espace 27 : C réel (i.e. géométrique). 28 : C * NDPOGO (type entier) : nombre de points 29 : C d'intégration. 30 : C * NBELEM (type entier) : nombre d'éléments du 31 : C maillage élémentaire courant. 32 : C * DFFPG (type réel) : valeurs des dérivées 33 : C premières des fonctions d'interpolation aux 34 : C points de gauss sur l'élément de référence. 35 : C * JMIJAC (type réel) : valeurs de l'inverse de 36 : C la matrice jacobienne aux points de Gauss sur 37 : C le maillage élémentaire. 38 : C ENTREES/SORTIES : * JDFFPG (type réel) : valeurs des dérivées 39 : C premières des fonctions d'interpolation 40 : C aux points de gauss sur l'élément réel. 41 : C SORTIES : - 42 : C*********************************************************************** 43 : C VERSION : v2, 25/09/03, refonte complète (modif SMPOUET) 44 : C VERSION : v1, 19/05/00, version initiale 45 : C HISTORIQUE : v1, 19/05/00, création 46 : C HISTORIQUE : 47 : C HISTORIQUE : 48 : C*********************************************************************** 49 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 50 : C en cas de modification de ce sous-programme afin de faciliter 51 : C la maintenance ! 52 : C*********************************************************************** 53 : -INC CCOPTIO 54 : INTEGER NDDL,IESREF,IESREL,NDPOGO,NBELEM 55 : REAL*8 DFFPG (NDDL,IESREF,NPFF) 56 : REAL*8 JMIJAC(IESREF,IESREL,NPJMI,NBELEM) 57 : REAL*8 JDFFPG(NDDL,IESREL,NDPOGO,NBELEM) 58 : * 59 : INTEGER IMPR,IRET 60 : * 61 : INTEGER IDDL,ISREF,ISREL,IPOGO,IELEM 62 : REAL*8 INVJAC 63 : * 64 : * Executable statements 65 : * 66 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans dfnfr1' 67 : DO 1 IELEM=1,NBELEM 68 : DO 12 IPOGO=1,NDPOGO 69 : IF (NPFF.EQ.1) THEN 70 : IPFF=1 71 : ELSE 72 : IPFF=IPOGO 73 : ENDIF 74 : IF (NPJMI.EQ.1) THEN 75 : IPJMI=1 76 : ELSE 77 : IPJMI=IPOGO 78 : ENDIF 79 : DO 122 ISREL=1,IESREL 80 : DO 1222 ISREF=1,IESREF 81 : INVJAC=JMIJAC(ISREF,ISREL,IPJMI,IELEM) 82 : DO 12222 IDDL=1,NDDL 83 : * JDFFPG(IDDL,ISREL,IPOGO,IELEM)= 84 : * $ JDFFPG(IDDL,ISREL,IPOGO,IELEM)+ 85 : * $ (DFFPG(IDDL,ISREF,IPOGO) 86 : * $ *JMIJAC(ISREF,ISREL,IPOGO,IELEM) 87 : JDFFPG(IDDL,ISREL,IPOGO,IELEM)= 88 : $ JDFFPG(IDDL,ISREL,IPOGO,IELEM)+ 89 : $ (DFFPG(IDDL,ISREF,IPFF) 90 : $ *INVJAC) 91 : 12222 CONTINUE 92 : 1222 CONTINUE 93 : 122 CONTINUE 94 : 12 CONTINUE 95 : 1 CONTINUE 96 : 97 : * 98 : * Normal termination 99 : * 100 : IRET=0 101 : RETURN 102 : * 103 : * Format handling 104 : * 105 : * 106 : * Error handling 107 : * 108 : 9999 CONTINUE 109 : IRET=1 110 : WRITE(IOIMP,*) 'An error was detected in subroutine dfnfr1' 111 : RETURN 112 : * 113 : * End of subroutine DFNFR1 114 : * 115 : END 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer