1 : C CHAME2 SOURCE PV 11/04/19 21:15:00 6936 2 : SUBROUTINE CHAME2(IPOGEO,IPCHPO,IPCHEL,IPCHAM,IPMINT,IPORE) 3 : ************************************************************************ 4 : * 5 : * c h a m e 2 6 : * ----------- 7 : * 8 : * fonction: 9 : * --------- 10 : * transformation d'un champ par point en champ par element 11 : * transfert des composantes du chpoint vers le chamelem, 12 : * relativement a un maillage elementaire du modele 13 : * 14 : * modules utilises: 15 : * ----------------- 16 : * 17 : IMPLICIT INTEGER(I-N) 18 : -INC CCOPTIO 19 : -INC SMELEME 20 : -INC SMCHAML 21 : -INC SMCHPOI 22 : -INC SMCOORD 23 : * 24 : * parametres: (e)=entree (s)=sortie (+ = contenu dans un commun) 25 : * ----------- 26 : * 27 : * ipogeo (e) pointeur sur un maillage elementaire 28 : * ipchpo (e) pointeur sur le champ par point (suppose actif)(retour actif) 29 : * +idim (e) voir ccoptio 30 : * ipchel (e) pointeur sur le champ par element (suppose actif) 31 : * ipcham (s) pointeur sur un segment "mchaml" 32 : * = 0 si echec 33 : * ipmint (e) = 0 si la mchaml doit etre laisse aux noeuds 34 : * = sinon pointeur sur un segment s'integration 35 : * correspondant au support desire 36 : * ipore (e) = 0 sauf pour milieu poreux (nbre de noeuds) 37 : * 38 : * 39 : * variables: 40 : * ---------- 41 : * 42 : * mtri = segment de travail 43 : * npaket = donne en regard du numero d'un noeud,le numero de la 44 : * zone du chpoint a laquelle il appartient 45 : * nposit = donne en regard du numero d'un noeud,le numero du poi1 46 : * dans la zone referencee ci-dessus 47 : * 48 : SEGMENT,MTRI 49 : INTEGER NPAKET(NX),NPOSIT(NX) 50 : ENDSEGMENT 51 : * 52 : * icntch = segment de travail (CoNTenu du CHpoint) 53 : * noeuds(i)=1 si le noeud i appartient au support du champ, sinon 0 54 : * 55 : SEGMENT,ICNTCH 56 : INTEGER NOEUDS(NX) 57 : ENDSEGMENT 58 : * 59 : * auteur, date de creation: 60 : * ------------------------- 61 : * 62 : * denis robert,le 22 juin 1988. 63 : * 64 : * langage: 65 : * -------- 66 : * 67 : * esope + fortran77 68 : * 69 : * Remarque : Le pointeur IPMINT doit etre ACTIF en ENTREE de CHAME2 70 : * ---------- et son etat ne doit pas etre modifie (meme en SORTIE). 71 : * 72 : ************************************************************************ 73 : IPCHAM=0 74 : * 75 : C* MCHELM=IPCHEL 76 : MCHPOI=IPCHPO 77 : NSOUPO=IPCHP(/1) 78 : NX=XCOOR(/1)/(IDIM+1) 79 : SEGINI,MTRI 80 : segini,ICNTCH 81 : * 82 : N2=10 83 : n2r=0 84 : SEGINI,MCHAML 85 : * 86 : IPT1=IPOGEO 87 : SEGACT,IPT1 88 : NBN1=IPT1.NUM(/1) 89 : NBELE1=IPT1.NUM(/2) 90 : * 91 : * boucle 1 sur les zones du chpoint 92 : * 93 : do 50 ISOUPO=1,NSOUPO 94 : MSOUPO=IPCHP(ISOUPO) 95 : MELEME=IGEOC 96 : SEGACT,MELEME 97 : NBELEM=NUM(/2) 98 : 99 : DO 60 IPOI=1,NBELEM 100 : IPONU=NUM(1,IPOI) 101 : NOEUDS(IPONU)=1 102 : 60 CONTINUE 103 : 50 continue 104 : * 105 : * boucle 2 sur les zones du chpoint 106 : * 107 : DO 100 ISOUPO=1,NSOUPO 108 : MSOUPO=IPCHP(ISOUPO) 109 : * segact,msoupo 110 : MPOVAL=IPOVAL 111 : SEGACT,MPOVAL 112 : MELEME=IGEOC 113 : * SEGACT,MELEME 114 : NBELEM=NUM(/2) 115 : DO 107 IO=1,NX 116 : NPAKET(IO)=0 117 : NPOSIT(IO)=0 118 : 107 CONTINUE 119 : * 120 : * boucle sur les poi1 contenus dans le msoupo considere 121 : * 122 : DO 110 IPOI=1,NBELEM 123 : IPONU=NUM(1,IPOI) 124 : NPAKET(IPONU)=ISOUPO 125 : NPOSIT(IPONU)=IPOI 126 : 110 CONTINUE 127 : * end do 128 : 129 : NCOMP=NOCOMP(/2) 130 : IMO=0 131 : * 132 : * boucle sur les composantes du msoupo considere 133 : * 134 : DO 120 ICOMP=1,NCOMP 135 : IF (N2R.GT.0) THEN 135 : CALL PLACE(NOMCHE,N2R,IMO,NOCOMP(ICOMP)) 136 : IF (IMO.EQ.0) THEN 137 : n2r=n2r+1 138 : IF (N2R.GT.N2) then 139 : N2=n2+100 140 : SEGADJ,MCHAML 141 : endif 142 : NOMCHE(N2r)=NOCOMP(ICOMP) 143 : TYPCHE(N2r)='REAL*8' 144 : * else 145 : *+* if (noharm(icomp).ne.nuhche(imo)) then 146 : * 147 : * c'est un nouvel harmonique 148 : * 149 : * n2=nomche(/2)+1 150 : * segadj,mchaml 151 : * nomche(n2)=nocomp(icomp) 152 : * typche(n2)='real*8' 153 : * endif 154 : ENDIF 155 : ELSE 156 : N2R=N2R+1 157 : IF (N2R.GT.N2) then 158 : N2=n2+100 159 : SEGADJ,MCHAML 160 : endif 161 : NOMCHE(N2R)=NOCOMP(ICOMP) 162 : TYPCHE(N2R)='REAL*8' 163 : ENDIF 164 : * 165 : IF (IMO.EQ.0) THEN 166 : N1PTEL=NBN1 167 : N1EL=NBELE1 168 : N2PTEL=0 169 : N2EL=0 170 : SEGINI,MELVAL 171 : IELVAL(N2R)=MELVAL 172 : ELSE 173 : MELVAL=IELVAL(IMO) 174 : SEGACT,MELVAL*MOD 175 : ENDIF 176 : * 177 : DO 210 INOE=1,NBN1 178 : DO 220 IEL=1,NBELE1 179 : IPONU=IPT1.NUM(INOE,IEL) 180 : ISOUP=NPAKET(IPONU) 181 : IF (ISOUP.NE.0) THEN 182 : * 183 : * le point considere est reference dans ce maillage 184 : * 185 : NPOPO=NPOSIT(IPONU) 186 : IF (NPOPO.NE.0) THEN 187 : VELCHE(INOE,IEL)=VPOCHA(NPOPO,ICOMP) 188 : ENDIF 189 : * else 190 : * if(noeuds(IPONU).eq.0) then 191 : * interr(1)=IPONU 191 : * call erreur(771) 192 : * endif 193 : ENDIF 194 : 220 CONTINUE 195 : * end do 196 : 210 CONTINUE 197 : * end do 198 : 120 CONTINUE 199 : * end do 200 : SEGDES,MELEME,MPOVAL 201 : 100 CONTINUE 202 : * end do 203 : * 204 : N2=n2R 205 : SEGADJ,MCHAML 206 : * 207 : * changement de support si besoin est 208 : * Le segment IPMINT est suppose ACTIF (E/S) 209 : * 210 : IF (IPMINT.NE.0) THEN 211 : DO 400 ICOMP=1,N2 212 : IPMELV=IELVAL(ICOMP) 212 : CALL CHAME3(IPMELV,IPMINT,IPRES,IPORE) 213 : IELVAL(ICOMP)=IPRES 214 : * 215 : MELVAL=IPRES 216 : SEGDES MELVAL 217 : * 218 : MELVAL=IPMELV 219 : SEGSUP MELVAL 220 : 400 CONTINUE 221 : ELSE 222 : DO 401 ICOMP=1,N2 223 : MELVAL=IELVAL(ICOMP) 224 : SEGDES MELVAL 225 : 401 CONTINUE 226 : ENDIF 227 : * 228 : IPCHAM=MCHAML 229 : SEGDES,MCHAML 230 : SEGSUP,MTRI 231 : segsup,ICNTCH 232 : * 233 : RETURN 234 : END 235 : 236 : 237 :
© Cast3M 2003 - All rights reserved.
Disclaimer