1 : C RAYE SOURCE CHAT 12/06/07 21:15:58 7389 2 : SUBROUTINE RAYE 3 : 4 : C ********************************************************** 5 : C **** OPERATEUR RAYE **** 6 : C **** **** 7 : C **** SYNTAXE : CH2 = RAYE MODL1 CHAM1 CHAM2 **** 8 : C **** ou **** 9 : C **** CH2 = RAYE MODL1 CHAM1 CHAM2 CHAM3 **** 10 : C **** (PREC) **** 11 : C **** 'TABS' VAL **** 12 : C **** MODL1 : type MMODEL **** 13 : C **** MCHEL1 : type MCHELM **** 14 : C **** MCHEL2 : type MCHELM **** 15 : C **** MCHEL3 : type MCHELM **** 16 : C **** PREC : flottant **** 17 : C **** VAL : flottant (T milieu absorbant)**** 18 : C **** **** 19 : C Rayonnement en milieu transparent dans une cavité **** 20 : C 2 possibilités: **** 21 : C 1- calcul de la matrice de rayonnement **** 22 : C Phi = R. T**4 **** 23 : C 2- calcul de la temperature Trad **** 24 : C Phi = emis.sigma.(T**4-Trad**4) **** 25 : C ********************************************************** 26 : 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : 30 : C ********************************************************** 31 : C **** Entree des includes **** 32 : C ********************************************************** 33 : 34 : -INC CCOPTIO 35 : -INC SMCHAML 36 : -INC SMMODEL 37 : 38 : C ********************************************************** 39 : C **** Declaration des variables du probleme **** 40 : C ********************************************************** 41 : 42 : POINTEUR MODL.MMODEL 43 : POINTEUR CHAME.MCHELM, CHAMF.MCHELM, CHAMT.MCHELM 44 : CHARACTER*8 TYPE 45 : CHARACTER*4 MOTCLE 46 : 47 : C POINTEUR IMCHFA.MCHAML 48 : C ********************************************************** 49 : C **** Lecture des entrees **** 50 : C ********************************************************** 51 : 52 : IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYT.ESO' 53 : TYPE = 'MMODEL ' 53 : CALL LIROBJ(TYPE, IREP, 1, IRET) 54 : IF (IRET.EQ.1) MODL = IREP 55 : IF (IRET.EQ.0) THEN 56 : MOTERR(1:8)=TYPE 56 : CALL ERREUR(37) 57 : RETURN 58 : ENDIF 59 : * on ne prend que les modeles concernés 59 : call selmod(modl,ipmod,'RAYONNEMENT') 60 : modl=ipmod 61 : TYPE = 'MCHAML ' 61 : CALL LIROBJ(TYPE, IREP, 1, IRET) 62 : IF (IRET.EQ.1) MCHEL11 = IREP 63 : write(6,*) ' mchel1 ' , mchel11 64 : IF (IRET.EQ.0) THEN 65 : MOTERR(1:8)=TYPE 65 : CALL ERREUR(37) 66 : RETURN 67 : ENDIF 67 : call reduaf(mchel11,ipmod,mchel1,1,iretr,kerre) 68 : if( iretr.ne.1) then 69 : write(6,*) ' aie aie 1 ', kerre 69 : call erreur ( kerre) 70 : return 71 : endif 72 : 73 : 74 : TYPE = 'MCHAML ' 74 : CALL LIROBJ(TYPE, IREP, 1, IRET) 75 : IF (IRET.EQ.1) MCHEL22 = IREP 76 : write(6,*) ' mchel2 ' , mchel2 77 : IF (IRET.EQ.0) THEN 78 : MOTERR(1:8)=TYPE 78 : CALL ERREUR(37) 79 : RETURN 80 : ENDIF 80 : call reduaf(mchel22,ipmod,mchel2,1,iretr,kerre) 81 : if( iretr.ne.1) then 81 : call erreur(kerre) 82 : return 83 : endif 84 : TYPE = 'MCHAML ' 84 : CALL LIROBJ(TYPE, IREP, 0, IRET) 85 : IF (IRET.EQ.1) THEN 86 : MCHEL33 = IREP 86 : call reduaf(mchel33,ipmod,mchel3,1,iretr,kerre) 87 : if( iretr.ne.1) then 87 : call erreur(kerre) 88 : return 89 : endif 90 : KMATR = 0 90 : CALL LIRREE(XVAL,0,IRET) 91 : IF(IRET.EQ.1) THEN 92 : ERRJ = XVAL 93 : ELSE 94 : ERRJ = 1D-10 95 : ENDIF 96 : 97 : C Lecture de la temperature du milieu absorbant 97 : CALL LIRCHA(MOTCLE,0,LCHAR) 98 : IF (MOTCLE.EQ.'TABS') THEN 99 : KABS=1 99 : CALL LIRREE(XVAL,0,IRET) 100 : IF (IRET.EQ.1) THEN 101 : TABS=XVAL 102 : ELSE 102 : CALL ERREUR(37) 103 : RETURN 104 : ENDIF 105 : ELSE 106 : KABS=0 107 : ENDIF 108 : 109 : 110 : ELSE 111 : KABS=0 112 : KMATR = 1 113 : C MOTERR(1:8)=TYPE 113 : C CALL ERREUR(37) 114 : C RETURN 115 : ENDIF 116 : write(6,*) ' kmatr kabs ' , kmatr,kabs 117 : 118 : IF(KMATR.EQ.1) THEN 119 : 120 : C Calcul de la matrice de rayonnement 121 : 122 : 123 : C ********************************************************** 124 : C **** Verification sur l'egalite des supports des **** 125 : C **** differents champs. **** 126 : C ********************************************************** 127 : write(6,*) ' premier appel a rayn1 avec mchel1' 127 : CALL RAYN1(MODL, MCHEL1) 128 : write(6,* ) ' deuxiee appel a rayn1 avec mchelm2' 128 : CALL RAYN1(MODL, MCHEL2) 129 : write(6,* ) ' sortie de rayn1' 130 : 131 : C ********************************************************** 132 : C **** Reconnaissance des deux CHAMELEM **** 133 : C **** MCHEL1 contient les facteurs de forme **** 134 : C **** MCHEL2 contient les emissivites **** 135 : C ********************************************************** 136 : 137 : SEGACT MCHEL1, MCHEL2 138 : 139 : IF ((MCHEL1.TITCHE).NE.'FACTEURS DE FORME ') THEN 140 : CHAME = MCHEL1 141 : CHAMF = MCHEL2 142 : ELSE 143 : CHAME = MCHEL2 144 : CHAMF = MCHEL1 145 : ENDIF 146 : 147 : SEGDES, MCHEL1, MCHEL2 148 : write(6,*) ' mchel1 mchel2 ', mchel1,mchel2 148 : CALL RAYE0(MODL, INFOEL) 149 : 150 : C ********************************************************** 151 : C **** Conversion des MCHELM en matrices **** 152 : C ********************************************************** 152 : * call zpchel(mchel1,1) 152 : CALL RAYE1(MCHEL1, INFOEL, IFACFO) 152 : * call zpchel(mchel2,1) 152 : CALL RAYE2(MCHEL2, MODL, INFOEL, IEMIS) 153 : 154 : C ********************************************************** 155 : C **** Calcul de la matrice de rayonnement associe **** 156 : C ********************************************************** 157 : 157 : CALL RAYE3(IFACFO, IEMIS, IRES) 158 : 159 : IF (IIMPI.GE.3) THEN 159 : CALL PRFACF(IRES) 160 : ENDIF 161 : 162 : C ********************************************************** 163 : C **** Conversion du resultat en un MCHELM **** 164 : C ********************************************************** 165 : 166 : LTITR = 0 166 : CALL FFMCHA(MODL, INFOEL, IRES, MCHEL3, LTITR) 167 : 168 : C ********************************************************** 169 : C **** Ecriture des resultats **** 170 : C ********************************************************** 171 : 171 : CALL ECROBJ('MCHAML ', MCHEL3) 172 : 173 : ELSE 174 : 175 : C Calcul de la temperature Trad 176 : 177 : C ********************************************************** 178 : C **** Verification sur l'egalite des supports des **** 179 : C **** differents champs. **** 180 : C ********************************************************** 181 : 181 : CALL RAYN1(MODL, MCHEL1) 181 : CALL RAYN1(MODL, MCHEL2) 181 : CALL RAYN1(MODL, MCHEL3) 182 : 183 : C ********************************************************** 184 : C **** Reconnaissance des deux CHAMELEM **** 185 : C **** MCHEL1 contient les facteurs de forme **** 186 : C **** MCHEL2 contient les emissivites par element)**** 187 : C **** MCHEL3 contient les temperatures par element*** 188 : C ********************************************************** 189 : 190 : 191 : SEGACT MCHEL1, MCHEL2, MCHEL3 192 : IF ((MCHEL1.TITCHE).EQ.'FACTEURS DE FORME ') THEN 193 : CHAMF = MCHEL1 194 : IF((MCHEL2.TITCHE).EQ.'CARACTERISTIQUES') THEN 195 : CHAME = MCHEL2 196 : CHAMT = MCHEL3 197 : ELSE 198 : CHAME = MCHEL3 199 : CHAMT = MCHEL2 200 : ENDIF 201 : ELSEIF((MCHEL1.TITCHE).EQ.'CARACTERISTIQUES') THEN 202 : CHAME = MCHEL1 203 : IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN 204 : CHAMF = MCHEL2 205 : CHAMT = MCHEL3 206 : ELSE 207 : CHAMF = MCHEL3 208 : CHAMT = MCHEL2 209 : ENDIF 210 : ELSE 211 : CHAMT = MCHEL1 212 : IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN 213 : CHAMF = MCHEL2 214 : CHAME = MCHEL3 215 : ELSE 216 : CHAMF = MCHEL3 217 : CHAME = MCHEL2 218 : ENDIF 219 : 220 : ENDIF 221 : 221 : CALL RAYE0(MODL, INFOEL) 222 : 223 : C ********************************************************** 224 : C **** Conversion des MCHELM en matrices **** 225 : C ********************************************************** 226 : 226 : CALL RAYE1(CHAMF, INFOEL, IFACFO) 227 : 227 : CALL RAYE2(CHAME , MODL, INFOEL, IEMIS) 228 : 228 : CALL RAYE2(CHAMT , MODL, INFOEL, ITEMP) 229 : 230 : C ********************************************************** 231 : C **** Calcul du tableau TRAD **** 232 : C ********************************************************** 233 : 233 : CALL RAYT1(IFACFO, IEMIS, ITEMP, ERRJ , IRES, KABS, TABS) 234 : 235 : 236 : C ********************************************************** 237 : C **** Conversion du resultat en un MCHELM **** 238 : C ********************************************************** 239 : 240 : C WRITE(6,*) ' infoel',INFOEL 241 : C on ne traite pas les coques 242 : INFOEL = 0 242 : CALL RAYT2(MODL, INFOEL, CHAMT , IRES, MCHEL4) 243 : 244 : C ********************************************************** 245 : C **** Ecriture des resultats **** 246 : C ********************************************************** 247 : 247 : CALL ECROBJ('MCHAML ', MCHEL4) 248 : 249 : ENDIF 250 : 251 : IF (IIMPI.GE.4) WRITE(6,*) 'FIN RAYT OK' 252 : 253 : END 254 : 255 : 256 : 257 : 258 : 259 : 260 : 261 : 262 : 263 : 264 :
© Cast3M 2003 - All rights reserved.
Disclaimer