1 : C CONVMA SOURCE CHAT 11/03/16 21:18:04 6902 2 : 3 : C======================================================================= 4 : C= C O N V M A = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul des flux nodaux equivalents a une condition de convection = 10 : C= forcee. Sousprogramme appele par CONVEC (convec.eso). = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= IPMODE (E) Pointeur sur le segment MMODEL = 15 : C= IPCHEL (E) Pointeur sur le segment MCHELM de CARACTERISTIQUES = 16 : C= IPCHPO (E) Pointeur sur le CHPOINT contenant la temperature = 17 : C= exterieure le long de la surface de convection = 18 : C= IPCONV (S) Pointeur sur le champ des flux equivalents = 19 : C= = 20 : C= Variables locales : = 21 : C= ------------------- = 22 : C= IPGEOM Pointeur sur un MAILLAGE elementaire du CHPOINT = 23 : C= IPOGEO Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF = 24 : C= = 25 : C= Denis ROBERT, le 28 avril 1988. = 26 : C======================================================================= 27 : 28 : SUBROUTINE CONVMA (IPMODE,IPCHEL,IPCHPO,IPCONV) 29 : 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8 (A-H,O-Z) 32 : 33 : -INC CCOPTIO 34 : -INC CCHAMP 35 : -INC SMCHAML 36 : -INC SMCHPOI 37 : -INC SMMODEL 38 : -INC SMELEME 39 : logical ltelq 40 : SEGMENT MPTVAL 41 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : SEGMENT NOTYPE 45 : CHARACTER*16 TYPE(NBTYPE) 46 : ENDSEGMENT 47 : PARAMETER (NINF=3) 48 : INTEGER INFOS(NINF) 49 : CHARACTER*(NCONCH) CONM 50 : CHARACTER*4 nomatt,nomcq 51 : CHARACTER*10 PEAU 52 : 53 : IPCONV=0 54 : 55 : C 1 - QUELQUES TRANSFORMATIONS SUR LES DONNEES 56 : C ============================================== 57 : C 1.1 - Changement de support du MCHAML de caracteristiques (noeuds -> 58 : C points de Gauss) puis transformation de ce MCHAML en CHPOINT 59 : C ===== 60 : * IPCHE1=0 61 : * IPCHCA=0 61 : * CALL CHASUP(IPMODE,IPCHEL,IPCHE1,iOK,1) 62 : * IF (iOK.NE.0) THEN 62 : * CALL ERREUR(iOK) 63 : ** RETURN 64 : * ENDIF 64 : * CALL CHAMPO(IPCHE1,1,IPCHCA,iOK) 64 : * CALL DTCHAM(IPCHE1) 65 : * IF (iOK.EQ.0) RETURN 66 : C ===== 67 : C 1.2 - Creation d'un objet MAILLAGE contenant une seule fois tous les 68 : C points du CHPOINT IPCHPO (fusion des maillages supports de tous 69 : C les MSOUPO) 70 : C ===== 71 : MCHPOI=IPCHPO 72 : SEGACT,MCHPOI 73 : MSOUPO=IPCHP(1) 74 : SEGACT,MSOUPO 75 : IPGEOM=IGEOC 76 : SEGDES,MSOUPO 77 : DO i=2,IPCHP(/1) 78 : MSOUPO=IPCHP(i) 79 : SEGACT,MSOUPO 80 : IGEO1=IGEOC 81 : SEGDES,MSOUPO 82 : ltelq=.false. 82 : CALL FUSE(IPGEOM,IGEO1,IRET,ltelq) 83 : IF (IERR.NE.0) GOTO 100 84 : IPGEOM=IRET 85 : ENDDO 86 : SEGDES,MCHPOI 87 : C ===== 88 : C 1.3 - Activation du MMODEL 89 : C ===== 90 : MMODEL=IPMODE 91 : SEGACT,MMODEL 92 : NSOUS=KMODEL(/1) 93 : 94 : C 2 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou) 95 : C ======================================================== 96 : IRRT=0 97 : DO iSou=1,NSOUS 98 : iOK=0 99 : C ===== 100 : C 2.1 - Activation du sous-modele (iSou) 101 : C ===== 102 : IMODEL=KMODEL(iSou) 103 : SEGACT,IMODEL 104 : PEAU=' ' 105 : IF (MATMOD(/1).NE.0) PEAU=MATMOD(1) 106 : * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION 107 : NEF=NEFMOD 108 : NLG=NUMGEO(NEF) 108 : CALL TSHAPE(NLG,'GAUSS',IPINTE) 109 : IF (IERR.NE.0) THEN 109 : CALL ERREUR(251) 110 : GOTO 50 111 : ENDIF 112 : IF (NEF.EQ.44.OR.NEF.EQ.27.OR.NEF.EQ.56.OR.NEF.EQ.49.OR. 113 : . NEF.EQ.41) THEN 114 : IF (PEAU.EQ.'INFERIEURE') THEN 115 : nomcq='QINF' 116 : ELSE 117 : nomcq='QSUP' 118 : ENDIF 119 : ELSE 120 : nomcq='Q ' 121 : ENDIF 122 : * ON RECUPERE LES MAILLAGES ELEMENTAIRES DU MODELE, QUI SONT 123 : * APPUYES STRICTEMENT SUR LE CHPOINT 124 : * ITGEOM=IMAMOD 124 : * CALL ECROBJ('MAILLAGE',IPGEOM) 124 : * CALL ECRCHA('STRI') 124 : * CALL ECRCHA('APPU') 124 : * CALL ECROBJ('MAILLAGE',ITGEOM) 124 : * CALL EXTREL(IRR,0,i) 125 : * ON N'A PAS TROUVE DE MAILLAGE COMMUN A CETTE PARTIE DE 126 : * L'ENVELOPPE ET DU CHPOINT 127 : * IF (IRR.NE.0) THEN 128 : * IRRT=IRRT+1 129 : * iOK=1 130 : * GOTO 50 131 : * ENDIF 131 : * CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET) 132 : * IF (IERR.NE.0) GOTO 50 133 : * ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES 134 : * IPT3=IPOGEO 135 : * SEGACT,IPT3 136 : * ipt3=imamod 137 : * NSOU3=IPT3.LISOUS(/1) 138 : * IF (NSOU3.EQ.0) THEN 139 : * NBN2=IPT3.NUM(/1) 140 : * ENDIF 141 : * BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE 142 : * DO IMAIL=1,MAX(1,NSOU3) 143 : * iOK=0 144 : * IF (NSOU3.NE.0) THEN 145 : * IPT2=IPT3.LISOUS(IMAIL) 146 : * SEGACT,IPT2 147 : * IPOGEO=IPT2 148 : * NBN2=IPT2.NUM(/1) 149 : * SEGDES,IPT2 150 : * ENDIF 151 : * ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT 152 : * DE SOURCE ET DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO 153 : 154 : 155 : IPMAIL=IMAMOD 156 : CONM=CONMOD 156 : CALL CHAME1(IPMAIL,0,IPCHPO,' ',ICHELS,1) 157 : MCHEL1=ICHELS 158 : IF (IERR.NE.0) GOTO 30 159 : SEGACT,MCHEL1 160 : MCHAM1=MCHEL1.ICHAML(1) 161 : SEGACT,MCHAM1 162 : * recherche de la bonne composante 163 : ivfr=1 164 : IF (MCHAM1.IELVAL(/1).NE.1) THEN 165 : nomatt='T ' 166 : IF (PEAU.EQ.'SUPERIEURE') nomatt='TSUP' 167 : IF (PEAU.EQ.'INFERIEURE') nomatt='TINF' 168 : ivfr=0 169 : DO i=1,mcham1.ielval(/1) 170 : IF (mcham1.NOMCHE(i).EQ.nomatt) ivfr=i 171 : ENDDO 172 : IF (ivfr.EQ.0) THEN 173 : MOTERR(1:4)=nomatt 174 : MOTERR(5:8)='TEMP' 174 : CALL ERREUR(77) 175 : GOTO 30 176 : ENDIF 177 : ENDIF 178 : IPTEMP=MCHAM1.IELVAL(ivfr) 179 : * RECUPERATION DU COEFFICIENT D'ECHANGE 180 : * ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT 181 : * DE CARACTERISTIQUES ET DU MAILLAGE ELEMENTAIRE IPOGEO 181 : CALL IDENT(IPMAIL,CONM,IPCHEL,0,INFOS,IOK) 182 : NBROBL=1 183 : NBRFAC=0 184 : SEGINI,NOMID 185 : LESOBL(1)='H ' 186 : NBTYPE=1 187 : SEGINI,NOTYPE 188 : TYPE(1)='REAL*8' 189 : MOMATR=NOMID 190 : MOTYPE=NOTYPE 190 : CALL KOMCHA(IPCHEL,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 191 : SEGSUP,NOTYPE 192 : IF (IERR.NE.0) GOTO 20 193 : MPTVAL=IVAMAT 194 : MELVAL=IVAL(1) 195 : IVEL1=VELCHE(/1) 196 : IVEL2=VELCHE(/2) 197 : IPCOEF=MELVAL 198 : segsup, mptval,nomid,notype 199 : 199 : * CALL CHAME1(IPOGEO,0,IPCHCA,' ',ICHELC,1) 200 : * MCHEL3=ICHELC 201 : * IF (IERR.NE.0) GOTO 20 202 : * SEGACT,MCHEL3 203 : * MCHAM3=MCHEL3.ICHAML(1) 204 : * SEGACT,MCHAM3 205 : * NCOELE=MCHAM3.NOMCHE(/2) 205 : * CALL PLACE(MCHAM3.NOMCHE,NCOELE,IPOSI,'H ') 206 : * IF (IPOSI.EQ.0) THEN 207 : * MOTERR(1:4)='H ' 208 : * MOTERR(5:8)='CARA' 208 : * CALL ERREUR(77) 209 : * GOTO 20 210 : * ENDIF 211 : * IPCOEF=MCHAM3.IELVAL(IPOSI) 212 : 213 : * PRODUIT DES SEGMENTS ELEMENTAIRES CONTENANT LA 214 : * TEMPERATURE EXTERIEURE ET LE COEFFICIENT D'ECHANGE 214 : CALL PRCHA1(IPTEMP,IPCOEF,IPSONO) 215 : * CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES 216 : L1=7 217 : N1=1 218 : N3=3 219 : SEGINI,MCHEL2 220 : MCHEL2.TITCHE='CHALEUR' 221 : MCHEL2.IMACHE(1)=IPMAIL 222 : MCHEL2.CONCHE(1)=' ' 223 : C* MCHEL2.IFOCHE=IFOMOD 224 : MCHEL2.IFOCHE=IFOUR 225 : MCHEL2.INFCHE(1,3)=NIFOUR 226 : IPCHE2=MCHEL2 227 : N2=1 228 : SEGINI,MCHAM2 229 : MCHAM2.NOMCHE(1)='CHALEUR' 230 : MCHAM2.TYPCHE(1)='REAL*8' 231 : MCHEL2.ICHAML(1)=MCHAM2 232 : 233 : * CALCUL DES FLUX NODAUX EQUIVALENTS 234 : IF (NLG.EQ.1) THEN 234 : CALL INTCN0(IPSONO,IPMAIL,IPINTE,IPCHEQ) 235 : ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN 235 : CALL INTCN1(IPSONO,IPMAIL,IPINTE,IPCHEQ) 236 : ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR. 237 : . NLG.EQ.10) THEN 237 : CALL INTCN2(IPSONO,IPMAIL,IPINTE,IPCHEQ) 238 : ENDIF 239 : IF (IERR.NE.0) GOTO 10 240 : MCHAM2.IELVAL(1)=IPCHEQ 241 : 242 : * ON TRANSFORME LE CHAMELEM EN CHPOINT 242 : CALL CHAMPO(IPCHE2,0,IPCH1,IDUM) 243 : melval=ipcheq 244 : segsup melval 245 : IF (IERR.NE.0) GOTO 10 246 : MCHPOI=IPCH1 247 : SEGACT,MCHPOI 248 : DO i=1,IPCHP(/1) 249 : MSOUPO=IPCHP(i) 250 : SEGACT,MSOUPO*MOD 251 : NOCOMP(1)=nomcq 252 : SEGDES,MSOUPO 253 : ENDDO 254 : SEGDES,MCHPOI 255 : * ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS 256 : IF (iSou.GT.1) THEN 257 : 257 : CALL ADCHPO(IPCH1,IPCONV,IRET,1.D0,1.D0) 257 : CALL DTCHPO(IPCH1) 257 : CALL DTCHPO(IPCONV) 258 : * write(6,*) ' isou iret',isou,iret 259 : IF (IRET.EQ.0) GOTO 10 260 : IPCONV=IRET 261 : ELSE 262 : IPCONV=IPCH1 263 : ENDIF 264 : iOK=1 265 : 10 SEGSUP,MCHAM2,MCHEL2 266 : 20 continue 267 : melval=ipsono 268 : segsup melval 268 : 30 call dtchel(mchel1) 269 : IF (iOK.EQ.0) GOTO 40 270 : meleme=imamod 271 : segdes meleme 272 : segdes imodel 273 : ENDDO 274 : iOK=1 275 : 40 CONTINUE 276 : * 40 SEGDES,IPT3 277 : 50 SEGDES,IMODEL 278 : IF (iOK.EQ.0) GOTO 100 279 : * ENDDO 280 : 281 : * LES SUPPORTS GEOMETRIQUES DU CHPOINT ET DE L'OBJET MODELE 282 : * SONT INCOMPATIBLES 283 : * IF (IRRT.EQ.NSOUS) THEN 284 : * MOTERR(1:8)='MODELE ' 285 : * MOTERR(9:16)='CHPOINT ' 285 : * CALL ERREUR(135) 286 : * ENDIF 287 : 100 CONTINUE 287 : * 100 CALL DTCHPO(IPCHCA) 288 : SEGDES,MMODEL 289 : 290 : RETURN 291 : END 292 : 293 : 294 : 295 : 296 : 297 : 298 : 299 : 300 :
© Cast3M 2003 - All rights reserved.
Disclaimer