1 : C CNEQMG SOURCE CHAT 11/03/16 21:17:04 6902 2 : SUBROUTINE CNEQMG(IPMAIL,IPMINT,IVAPVE,IVAPNO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C N E Q M G 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * CALCUL DU PRODUIT DU POTENTIEL VECTEUR INDUCTEUR 13 : * AVEC LES FONCTIONS DE FORME ROT3 POUR LA 14 : * FORMULATION MAGNETODYNAMIQUE 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : -INC SMCOORD 22 : -INC SMINTE 23 : -INC CCHAMP 24 : -INC SMMODEL 25 : -INC SMELEME 26 : -INC SMCHAML 27 : * 28 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 29 : * ----------- 30 : * 31 : * IPMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE (ACTIF E/S) 32 : * IPMINT (E) POINTEUR SUR UN SEGMENT MINTE (ACTIF E/S) 33 : * IVAPVE (E) POINTEUR SUR UN SEGMENT MPTVAL POUR LE POTENTIEL VECTEUR 34 : * IVAPNO (S) POINTEUR SUR UN SEGMENT MPTVAL POUR LE RESULTAT 35 : * +XCOOR (E) VOIR SMCOORD 36 : * +IDIM (E) VOIR CCOPTIO 37 : * +IFOMOD (E) VOIR CCOPTIO 38 : * +XZERO (E) VOIR CCREEL 39 : * 40 : * VARIABLES: 41 : * ---------- 42 : * 43 : * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE 44 : * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP) 45 : * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE 46 : * NBPGAU NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI 47 : * NDIM NOMBRE DE LIGNES DE LA MATRICE GRADIENT 48 : * XE(3,NBNN) COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL 49 : * SHP(6,NBNN) TABLEAU DE TRAVAIL 50 : * VALMAT(NMATR) TABLEAU DE TRAVAIL 51 : * 52 : SEGMENT,MMAT1 53 : REAL*8 VALMAT(NMATR) 54 : REAL*8 XE(3,NBNN),XE1(3,NBNN) 55 : REAL*8 SHP(6,NBNN) 56 : REAL*8 COSD1(3),COSD2(3),GRD3(3,3) 57 : ENDSEGMENT 58 : * 59 : SEGMENT NOTYPE 60 : CHARACTER*16 TYPE(NBTYPE) 61 : ENDSEGMENT 62 : * 63 : SEGMENT MPTVAL 64 : INTEGER IPOS(NS) ,NSOF(NS) 65 : INTEGER IVAL(NCOSOU) 66 : CHARACTER*16 TYVAL(NCOSOU) 67 : ENDSEGMENT 68 : * 69 : CHARACTER*8 CNM 70 : CHARACTER*(NCONCH) CONM 71 : * 72 : * AUTEUR, DATE DE CREATION: 73 : * ------------------------- 74 : * 75 : * YANN STEPHAN , AOUT 1997 (COPIE DE ROT3R) 76 : * 77 : * LANGAGE: 78 : * -------- 79 : * 80 : * ESOPE + FORTRAN77 81 : * 82 : ************************************************************************ 83 : * 84 : * RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE 85 : * ELEMENTAIRE 86 : * 87 : MELEME=IPMAIL 88 : C* SEGACT,MELEME <- Actif en E/S 89 : NBNN=NUM(/1) 90 : NBELEM=NUM(/2) 91 : * 92 : * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT 93 : * FINI LIE A NOTRE MAILLAGE 94 : * 95 : MINTE=IPMINT 96 : C* SEGACT,MINTE <- Actif en E/S 97 : NBPGAU=POIGAU(/1) 98 : * 99 : * CHANGEMENT DE SUPPORT DU MPTVAL IVAPVE 100 : * 101 : MPTVAL=IVAPVE 102 : NCOMP=IVAL(/1) 103 : * 104 : * on suppose pas de formulation poreux ici 105 : IPPORE=0 106 : * 106 : CALL VALCHE(IVAPVE,NCOMP,IPMINT,IPPORE) 107 : * 108 : NDIM=IDIM-1 109 : NFIN=NDIM+1 110 : NMATR=NCOMP 111 : SEGINI,MMAT1 112 : * 113 : * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL 114 : * 115 : DO 10 IEL=1,NBELEM 116 : * 117 : * MISE A ZERO DU TABLEAU XE1 118 : * 118 : CALL ZERO (XE1,3,NBNN) 119 : * 120 : * ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL, 121 : * DANS LE REPERE GLOBAL 122 : * 122 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 123 : * 124 : * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L' 125 : * ELEMENT COQUE 126 : * 126 : CALL COQLOC(NBNN,XE,COSD1,COSD2,XE1) 127 : * 128 : IFOIS=0 129 : IFOI2=0 130 : DO 20 IGAU=1,NBPGAU 131 : * 132 : * CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET 133 : * DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS 134 : * 135 : DO 90 NP=1,NBNN 136 : DO 90 I=1,NFIN 137 : SHP(I,NP)=SHPTOT(I,NP,IGAU) 138 : 90 CONTINUE 139 : * 140 : * DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE 141 : * ET LE JACOBIEN 141 : CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC) 142 : * 143 : IF(DJAC.LT.XZERO)IFOIS=IFOIS+1 144 : IF(ABS(DJAC).LT.XPETIT)IFOI2=IFOI2 +1 145 : * 146 : DO 100 NP=1,NBNN 147 : * ON FAIT TOURNER LE GRADIENT DE -PI/2 DANS LE REPERE LOCAL 148 : * POUR ETRE PARALLELE AU COTE OPPOSE AU SOMMET 149 : XG=SHP(2,NP) 150 : SHP(2,NP)=SHP(3,NP) 151 : C* YG=SHP(3,NP) 152 : C* SHP(2,NP)=YG 153 : SHP(3,NP)=-XG 154 : * RETOUR AU REPERE 3D 155 : r_z1 = SHP(2,NP) 156 : r_z2 = SHP(3,NP) 157 : DO 60 I=1,NFIN 158 : GRD3(I,NP)= r_z1*COSD1(I) + r_z2*COSD2(I) 159 : 60 CONTINUE 160 : 100 CONTINUE 161 : * 162 : * ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE 163 : * POINT DE GAUSS CONSIDERE 164 : * 165 : DJAC=ABS(DJAC)*POIGAU(IGAU) 166 : * 167 : * ON CHERCHE LES VALEURS DES COMPOSANTES 168 : * DU POTENTIEL VECTEUR 169 : * 170 : MPTVAL=IVAPVE 171 : DO 30 IM=1,NCOMP 172 : IF(IVAL(IM).NE.0)THEN 173 : MELVAL=IVAL(IM) 174 : IBMN=MIN(IEL,VELCHE(/2)) 175 : IGMN=MIN(IGAU,VELCHE(/1)) 176 : VALMAT(IM)=VELCHE(IGMN,IBMN) 177 : ELSE 178 : VALMAT(IM)=0. 179 : ENDIF 180 : 30 CONTINUE 181 : * 182 : * ON EFFECTUE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*VALMAT 183 : * POUR LE POINT DE GAUSS CONSIDERE (RESULTAT SCALAIRE) 184 : * 185 : MPTVAL=IVAPNO 186 : MELVAL=IVAL(1) 187 : DO 40 IP=1,NBNN 188 : r_z = 0. 189 : DO 41 IM=1,NCOMP 190 : r_z = r_z + GRD3(IM,IP)*VALMAT(IM) 191 : 41 CONTINUE 192 : VELCHE(IP,IEL)=VELCHE(IP,IEL) + DJAC*r_z 193 : 40 CONTINUE 194 : * 195 : 20 CONTINUE 196 : * 197 : * LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT 198 : IF(IFOIS.NE.0.AND.IFOIS.NE.NBPGAU)THEN 199 : INTERR(1)=IEL 199 : CALL ERREUR(195) 200 : GO TO 999 201 : * 202 : * CAS OU LE JACOBIEN EST TRES PETIT 203 : ELSEIF(IFOI2.EQ.NBPGAU)THEN 204 : INTERR(1)=IEL 204 : CALL ERREUR (259) 205 : GO TO 999 206 : ENDIF 207 : * 208 : 10 CONTINUE 209 : * 210 : * DESACTIVATION DES SEGMENTS 211 : * 212 : 999 CONTINUE 213 : SEGSUP,MMAT1 214 : SEGDES,MELEME 215 : C* SEGDES,MINTE <- Actif en E/S 216 : * 217 : RETURN 218 : END 219 : 220 : 221 :
© Cast3M 2003 - All rights reserved.
Disclaimer