1 : C RAYE2 SOURCE CHAT 12/06/07 21:15:56 7389 2 : SUBROUTINE RAYE2(CHAMP, MODL, INFOEL, EMIS) 3 : 4 : C ********************************************************** 5 : C **** SUBROUTINE D'INTERFACAGE CHAMELEM -->EMISSIVITE **** 6 : C **** **** 7 : C **** En entree : CHAMP champ par element **** 8 : C **** MODL modele sur lequel s'appuie le **** 9 : C **** probleme **** 10 : C **** INFOEL pointeur contenant des **** 11 : C **** informations relatives au maillage **** 12 : C **** **** 13 : C **** En sortie : EMIS matrice des composantes **** 14 : C **** des emissivites **** 15 : C **** **** 16 : C ********************************************************** 17 : 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT REAL*8 (A-H,O-Z) 20 : 21 : C ********************************************************** 22 : C **** Structure des elements utilises **** 23 : C ********************************************************** 24 : 25 : -INC SMCHAML 26 : -INC SMELEME 27 : -INC SMMODEL 28 : -INC CCOPTIO 29 : 30 : SEGMENT MATR 31 : REAL*8 VAL(NTOT) 32 : ENDSEGMENT 33 : 34 : SEGMENT ADRES 35 : INTEGER V(NBS, 3) 36 : ENDSEGMENT 37 : 38 : C **** ADRES contient les informations suivantes **** 39 : C **** V(j,1) : Numero du type d'element dans **** 40 : C **** MODL **** 41 : C **** V(j,2) : Numero correspondant au meme **** 42 : C **** element que le precedent mais **** 43 : C **** dans le CHAMELEM **** 44 : C **** V(j,3) : Nombre de surfaces dans cet **** 45 : C **** ensemble **** 46 : 47 : SEGMENT INFOEL 48 : LOGICAL KCOQ(N1), KQUAD(N1) 49 : ENDSEGMENT 50 : 51 : POINTEUR EMIS.MATR 52 : POINTEUR CHAMP.MCHELM 53 : POINTEUR PCHAMP.MCHAML 54 : POINTEUR DCHAM.MELVAL, DCHAM1.MELVAL, DCHAM2.MELVAL 55 : POINTEUR MAILL.MELEME, SMAILL.MELEME 56 : POINTEUR MODL.MMODEL 57 : POINTEUR ID0.IMODEL 58 : CHARACTER*8 MOT 59 : 60 : C ********************************************************** 61 : C **** Declaration des variables utilisees **** 62 : C ********************************************************** 63 : 64 : IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE2.ESO' 65 : 66 : SEGACT CHAMP 67 : NBS = CHAMP.IMACHE(/1) 68 : SEGINI ADRES 69 : NTOT = 0 70 : SEGACT MODL 71 : 72 : NBS2 = MODL.KMODEL(/1) 73 : 74 : SEGACT INFOEL 75 : 76 : DO 10 J = 1, NBS2 77 : ID0 = MODL.KMODEL(J) 78 : 79 : SEGACT ID0 80 : ID2 = ID0.IMAMOD 81 : SEGDES ID0 82 : DO 20 I = 1, NBS 83 : 84 : ADRES.V(J,1) = J 85 : MAILL = CHAMP.IMACHE(I) 86 : ID1 = MAILL 87 : 88 : IF (ID1.EQ.ID2) THEN 89 : ADRES.V(J, 2) = I 90 : SEGACT MAILL 91 : NBSOUS = MAILL.LISOUS(/1) 92 : 93 : IF (NBSOUS.EQ.0) THEN 94 : NEL = MAILL.NUM(/2) 95 : ELSE 96 : DO 30 L = 1, NBSOUS 97 : SMAILL = MAILL.LISOUS(L) 98 : SEGACT SMAILL 99 : NEL = NEL + SMAILL.NUM(/2) 100 : SEGDES SMAILL 101 : 30 CONTINUE 102 : ENDIF 103 : 104 : ADRES.V(J,3) = NEL 105 : 106 : IF (KCOQ(I)) NEL = NEL + NEL 107 : 108 : SEGDES MAILL 109 : ENDIF 110 : 20 CONTINUE 111 : NTOT = NTOT + NEL 112 : 113 : 10 CONTINUE 114 : 115 : C **** NTOT designe la dimension du vecteur EMIS **** 116 : 117 : SEGDES INFOEL 118 : 119 : IF (IIMPI.GE.4) THEN 120 : WRITE(6,*) 'Dimension du vecteur d''emissivite =',NTOT 121 : ENDIF 122 : 123 : SEGINI EMIS 124 : N = 1 125 : 126 : DO 40 K = 1, NBS 127 : I = ADRES.V(K,2) 128 : 129 : PCHAMP = CHAMP.ICHAML(I) 130 : 131 : SEGACT PCHAMP 132 : NBST = PCHAMP.IELVAL(/1) 133 : nbs2=nbsT 134 : 135 : * 136 : *on cherche les positions des EMIS ou EINF et ESUP position ie1 ie2 137 : * 138 : lemis=0 139 : leinf=0 140 : lesup=0 141 : do iva=1,nbst 142 : if( PCHAMP.NOMCHE(iva).eq.'EMIS') lemis=iva 143 : if( PCHAMP.NOMCHE(iva).eq.'EINF') leinf=iva 144 : if( PCHAMP.NOMCHE(iva).eq.'ESUP') lesup=iva 145 : enddo 146 : nbs2=1 147 : if(lemis.eq.0) then 148 : if( (leinf.eq.0.or.lesup.eq.0).and.nbst.ne.1) then 149 : moterr(1:4)='EMIS' 149 : call erreur( 77) 150 : return 151 : endif 152 : if(nbst.ne.1) nbs2=2 153 : endif 154 : if (nbs2.eq.1.and. nbst.eq.1) lemis =1 155 : IF (IIMPI.GE.4.AND.NBS2.GT.2) THEN 156 : WRITE(6,*) 'Dimensions incompatibles' 157 : ENDIF 158 : 159 : IF (NBS2.EQ.2) THEN 160 : C **** Il y a des elements COQ **** 161 : DCHAM1 = PCHAMP.IELVAL(lesup) 162 : DCHAM2 = PCHAMP.IELVAL(leinf) 163 : SEGACT DCHAM1, DCHAM2 164 : 165 : N1PTEL = DCHAM1.VELCHE(/1) 166 : N1EL = DCHAM1.VELCHE(/2) 167 : 168 : IF (N1EL.EQ.1) THEN 169 : * write(6,*) 'k,, ADRES.V(K,3 dcham1', k , ADRES.V(K,3),dcham1 170 : DO 70 M = 1, ADRES.V(K,3) 171 : EMIS.VAL(N) = DCHAM1.VELCHE(1,1) 172 : IF (IIMPI.GE.4) THEN 173 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 174 : ENDIF 175 : N = N + 1 176 : 177 : EMIS.VAL(N) = DCHAM2.VELCHE(1,1) 178 : IF (IIMPI.GE.4) THEN 179 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 180 : ENDIF 181 : N = N + 1 182 : 70 CONTINUE 183 : ENDIF 184 : 185 : IF (N1EL.NE.1) THEN 186 : DO 75 M = 1, ADRES.V(K,3) 187 : EMIS.VAL(N) = DCHAM1.VELCHE(1,M) 188 : IF (IIMPI.GE.4) THEN 189 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 190 : ENDIF 191 : N = N + 1 192 : 193 : EMIS.VAL(N) = DCHAM2.VELCHE(1,M) 194 : IF (IIMPI.GE.4) THEN 195 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 196 : ENDIF 197 : N = N + 1 198 : 75 CONTINUE 199 : 200 : ENDIF 201 : 202 : SEGDES DCHAM1, DCHAM2 203 : 204 : 205 : ENDIF 206 : 207 : IF (NBS2.EQ.1) THEN 208 : C **** Il n'y a pas d'elements COQ **** 209 : 210 : MOT = PCHAMP.NOMCHE(1) 211 : IF (IIMPI.GE.4) WRITE(6,*) 'MOT =',MOT 212 : 213 : DCHAM = PCHAMP.IELVAL(1) 214 : SEGACT DCHAM 215 : 216 : N1PTEL = DCHAM.VELCHE(/1) 217 : N1EL = DCHAM.VELCHE(/2) 218 : 219 : IF (N1EL.EQ.1) THEN 220 : DO 90 M = 1, ADRES.V(K,3) 221 : EMIS.VAL(N) = DCHAM.VELCHE(1,1) 222 : IF (IIMPI.GE.4) THEN 223 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 224 : ENDIF 225 : N = N + 1 226 : 90 CONTINUE 227 : ENDIF 228 : 229 : IF (N1EL.NE.1) THEN 230 : DO 95 M = 1, ADRES.V(K,3) 231 : EMIS.VAL(N) = DCHAM.VELCHE(1,M) 232 : IF (IIMPI.GE.4) THEN 233 : WRITE(6,*) 'EMIS =',EMIS.VAL(N) 234 : ENDIF 235 : N = N + 1 236 : 95 CONTINUE 237 : 238 : ENDIF 239 : SEGDES DCHAM 240 : ENDIF 241 : 242 : SEGDES PCHAMP 243 : 40 CONTINUE 244 : 245 : IF (IIMPI.GE.4) THEN 246 : WRITE(6,*) 'Nombre de surfaces traitees', N - 1 247 : ENDIF 248 : 249 : SEGDES MODL, EMIS, CHAMP 250 : SEGDES ADRES 251 : 252 : RETURN 253 : END 254 : 255 : 256 : 257 : 258 : 259 : 260 : 261 :
© Cast3M 2003 - All rights reserved.
Disclaimer