1 : C RAYEN SOURCE CHAT 12/06/07 21:15:58 7389 2 : SUBROUTINE RAYEN(modl,mchel1,mchel2,mchel3,errj,mchel4) 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 : KABS=0 53 : KMATR=1 54 : IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYT.ESO' 55 : if(mchel3.ne.0) then 56 : segact mchel2 57 : kabs=0 58 : kmatr=0 59 : do io=1,mchel2.imache(/1) 60 : mchaml=mchel2.ichaml(io) 61 : segact mchaml 62 : do ia=1,nomche(/2) 63 : if( nomche(ia).eq.'TABS' ) then 64 : kabs=1 65 : melval=ielval(ia) 66 : segact melval 67 : Tabs= velche(1,1) 68 : segdes melval 69 : go to 1 70 : endif 71 : enddo 72 : 1 continue 73 : segdes mchaml 74 : enddo 75 : segdes mchel2 76 : endif 77 : * write(6,*) ' kmatr kabs ' , kmatr , kabs 78 : * write(6,*) ' errj , tabs ' , errj , tabs 79 : IF(KMATR.EQ.1) THEN 80 : 81 : C Calcul de la matrice de rayonnement 82 : 83 : 84 : C ********************************************************** 85 : C **** Verification sur l'egalite des supports des **** 86 : C **** differents champs. **** 87 : C ********************************************************** 87 : CALL RAYN1(MODL, MCHEL1) 87 : CALL RAYN1(MODL, MCHEL2) 88 : 89 : C ********************************************************** 90 : C **** Reconnaissance des deux CHAMELEM **** 91 : C **** MCHEL1 contient les facteurs de forme **** 92 : C **** MCHEL2 contient les emissivites **** 93 : C ********************************************************** 94 : 95 : SEGACT MCHEL1, MCHEL2 96 : 97 : IF ((MCHEL1.TITCHE).NE.'FACTEURS DE FORME ') THEN 98 : CHAME = MCHEL1 99 : CHAMF = MCHEL2 100 : ELSE 101 : CHAME = MCHEL2 102 : CHAMF = MCHEL1 103 : ENDIF 104 : 105 : SEGDES, MCHEL1, MCHEL2 105 : CALL RAYE0(MODL, INFOEL) 106 : 107 : C ********************************************************** 108 : C **** Conversion des MCHELM en matrices **** 109 : C ********************************************************** 109 : * call zpchel(mchel1,1) 109 : CALL RAYE1(MCHEL1, INFOEL, IFACFO) 109 : * call zpchel(mchel2,1) 109 : CALL RAYE2(MCHEL2, MODL, INFOEL, IEMIS) 110 : 111 : C ********************************************************** 112 : C **** Calcul de la matrice de rayonnement associe **** 113 : C ********************************************************** 114 : 114 : CALL RAYE3(IFACFO, IEMIS, IRES) 115 : 116 : IF (IIMPI.GE.3) THEN 116 : CALL PRFACF(IRES) 117 : ENDIF 118 : 119 : C ********************************************************** 120 : C **** Conversion du resultat en un MCHELM **** 121 : C ********************************************************** 122 : 123 : LTITR = 0 123 : CALL FFMCHA(MODL, INFOEL, IRES, MCHEL3, LTITR) 124 : 125 : C ********************************************************** 126 : C **** Ecriture des resultats **** 127 : C ********************************************************** 128 : mchel4=mchel3 128 : * CALL ECROBJ('MCHAML ', MCHEL3) 129 : 130 : ELSE 131 : 132 : C Calcul de la temperature Trad 133 : 134 : C ********************************************************** 135 : C **** Verification sur l'egalite des supports des **** 136 : C **** differents champs. **** 137 : C ********************************************************** 138 : 138 : CALL RAYN1(MODL, MCHEL1) 138 : CALL RAYN1(MODL, MCHEL2) 138 : CALL RAYN1(MODL, MCHEL3) 139 : 140 : C ********************************************************** 141 : C **** Reconnaissance des deux CHAMELEM **** 142 : C **** MCHEL1 contient les facteurs de forme **** 143 : C **** MCHEL2 contient les emissivites par element)**** 144 : C **** MCHEL3 contient les temperatures par element*** 145 : C ********************************************************** 146 : 147 : 148 : SEGACT MCHEL1, MCHEL2, MCHEL3 149 : IF ((MCHEL1.TITCHE).EQ.'FACTEURS DE FORME ') THEN 150 : CHAMF = MCHEL1 151 : IF((MCHEL2.TITCHE).EQ.'CARACTERISTIQUES') THEN 152 : CHAME = MCHEL2 153 : CHAMT = MCHEL3 154 : ELSE 155 : CHAME = MCHEL3 156 : CHAMT = MCHEL2 157 : ENDIF 158 : ELSEIF((MCHEL1.TITCHE).EQ.'CARACTERISTIQUES') THEN 159 : CHAME = MCHEL1 160 : IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN 161 : CHAMF = MCHEL2 162 : CHAMT = MCHEL3 163 : ELSE 164 : CHAMF = MCHEL3 165 : CHAMT = MCHEL2 166 : ENDIF 167 : ELSE 168 : CHAMT = MCHEL1 169 : IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') THEN 170 : CHAMF = MCHEL2 171 : CHAME = MCHEL3 172 : ELSE 173 : CHAMF = MCHEL3 174 : CHAME = MCHEL2 175 : ENDIF 176 : 177 : ENDIF 178 : 178 : CALL RAYE0(MODL, INFOEL) 179 : 180 : C ********************************************************** 181 : C **** Conversion des MCHELM en matrices **** 182 : C ********************************************************** 183 : 183 : CALL RAYE1(CHAMF, INFOEL, IFACFO) 184 : 184 : CALL RAYE2(CHAME , MODL, INFOEL, IEMIS) 185 : 185 : CALL RAYE2(CHAMT , MODL, INFOEL, ITEMP) 186 : 187 : C ********************************************************** 188 : C **** Calcul du tableau TRAD **** 189 : C ********************************************************** 190 : 190 : CALL RAYT1(IFACFO, IEMIS, ITEMP, ERRJ , IRES, KABS, TABS) 191 : 192 : 193 : C ********************************************************** 194 : C **** Conversion du resultat en un MCHELM **** 195 : C ********************************************************** 196 : 197 : C WRITE(6,*) ' infoel',INFOEL 198 : C on ne traite pas les coques 199 : INFOEL = 0 199 : CALL RAYT2(MODL, INFOEL, CHAMT , IRES, MCHEL4) 200 : 201 : C ********************************************************** 202 : C **** Ecriture des resultats **** 203 : C ********************************************************** 204 : 204 : * CALL ECROBJ('MCHAML ', MCHEL4) 205 : 206 : ENDIF 207 : 208 : IF (IIMPI.GE.4) WRITE(6,*) 'FIN RAYT OK' 209 : 210 : END 211 : 212 : 213 : 214 : 215 : 216 : 217 : 218 : 219 : 220 : 221 :
© Cast3M 2003 - All rights reserved.
Disclaimer