1 : C RAYE3 SOURCE CHAT 12/06/07 21:15:57 7389 2 : SUBROUTINE RAYE3(MATR, EMIS, RES) 3 : 4 : C ************************************************************ 5 : C **** SUBROUTINE DE CALCUL DE LA MATRICE DE RAYONNEMENT **** 6 : C **** **** 7 : C **** En entree : MATR matrice des facteurs de forme **** 8 : C **** EMIS valeur de l'emissivite en chaque **** 9 : C **** element de surface **** 10 : C **** En sortie : RES matrice de rayonnement **** 11 : C **** **** 12 : C **** Le resultat obtenu est RES: **** 13 : C **** RES = (I - F)*(I - (I - EMIS)*F)**(-1)*S*EMIS **** 14 : C **********************************************************T(J) 15 : 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8 (A-H,O-Z) 18 : 19 : -INC CCREEL 20 : -INC CCOPTIO 21 : 22 : C ********************************************************** 23 : C **** Declaration de la structure des facteurs **** 24 : C **** de forme **** 25 : C ********************************************************** 26 : 27 : SEGMENT IFACFO 28 : INTEGER LFACT(NBEL1) 29 : ENDSEGMENT 30 : SEGMENT LFAC 31 : REAL *8 FACT(NBEL2) 32 : ENDSEGMENT 33 : 34 : C **** Segment de travail pour l'inversion de matrice **** 35 : 36 : SEGMENT TRAVAI 37 : REAL *8 A(NEL,NEL), BT(NEL,NEL) 38 : INTEGER IS(NEL) 39 : ENDSEGMENT 40 : 41 : C ********************************************************** 42 : C **** Declaration des variables du probleme **** 43 : C ********************************************************** 44 : 45 : POINTEUR MATR.IFACFO, RES.IFACFO 46 : POINTEUR LMATR.LFAC, LRES.LFAC 47 : POINTEUR PSUR.LFAC, B.LFAC, EMIS.LFAC 48 : 49 : C ********************************************************** 50 : C **** Activation de la matrice des facteurs de forme **** 51 : C **** par l'intermediaire de son pointeur. Sa **** 52 : C **** dimension est Nbel. Le dernier pointeur pointe **** 53 : C **** sur les elements de surface **** 54 : C ********************************************************** 55 : 56 : IF (IIMPI.GE.4) THEN 57 : WRITE(6,*) 'DEBUT DE RAYE3.ESO' 58 : ENDIF 59 : 60 : SEGACT MATR 61 : Nel = MATR.LFACT(/1) 62 : 63 : IF (IIMPI.GE.4) THEN 64 : WRITE(6,*) 'Nel =',Nel 65 : WRITE(6,*) 'On doit trouver comme NBEL1 (NBEL + 1)' 66 : ENDIF 67 : 68 : Nel = Nel - 1 69 : 70 : SEGINI TRAVAI 71 : 72 : NBEL1 = Nel + 1 73 : NBEL2 = Nel 74 : PSUR = MATR.LFACT(NBEL1) 75 : 76 : SEGACT EMIS 77 : 78 : C ********************************************************** 79 : C **** Calcul de (I - (I - EMIS)*F) **** 80 : C **** (EMIS matrice diagonale des emissivites) **** 81 : C **** Au debut, on travaille avec une structure **** 82 : C **** matricielle A(Nel, Nel) car la routine INVER ne **** 83 : C **** fonctionne que pour cette structure. **** 84 : C ********************************************************** 85 : 86 : DO 10 I = 1, Nel 87 : LMATR = MATR.LFACT(I) 88 : 89 : SEGACT LMATR 90 : 91 : DO 20 J = 1, Nel 92 : A(I,J)=-(1.D0-(EMIS.FACT(I)))*(LMATR.FACT(J)) 93 : IF (I.EQ.J) A(I, I) = 1.D0 + A(I,J) 94 : 20 CONTINUE 95 : 96 : SEGDES LMATR 97 : 98 : 10 CONTINUE 99 : 100 : SEGDES EMIS 101 : 102 : C ********************************************************** 103 : C **** Calcul de (I - (I - EMIS)*F)**(-1) grace a une **** 104 : C **** subroutine de calcul (INVER1) **** 105 : C ********************************************************** 106 : 107 : ICRIT = 0 107 : CALL INVER1(TRAVAI, Nel, ICRIT, XPETIT) 108 : 109 : 110 : C ********************************************************** 111 : C **** Multiplication de RES par (I - F) **** 112 : C ********************************************************** 113 : 114 : SEGINI RES 115 : 116 : RES.LFACT(NBEL1) = MATR.LFACT(NBEL1) 117 : 118 : DO 50 I = 1, (NBEL1 - 1) 119 : SEGINI B 120 : 121 : C ********************************************************** 122 : C **** (I - F) est enregistre dans B **** 123 : C ********************************************************** 124 : 125 : LMATR = MATR.LFACT(I) 126 : SEGACT LMATR 127 : 128 : DO 60 J = 1, NBEL2 129 : B.FACT(J) = -LMATR.FACT(J) 130 : IF (I.EQ.J) B.FACT(J) = 1.D0 + B.FACT(J) 131 : 60 CONTINUE 132 : 133 : SEGINI LRES 134 : SEGACT PSUR 135 : SEGACT EMIS 136 : 137 : DO 70 J = 1, NBEL2 138 : 139 : C ********************************************************** 140 : C **** LRES(i,j) = somm[B(i,k)*TEMP(k,j)] **** 141 : C ********************************************************** 142 : 143 : DO 80 K = 1, NBEL2 144 : LRES.FACT(J) = LRES.FACT(J) + 145 : # B.FACT(K)*A(K,J) 146 : 147 : 80 CONTINUE 148 : 149 : C ********************************************************** 150 : C **** Multiplication par la surface et l'emissivite **** 151 : C **** LRES(i,j) = LRES(i,j)*S(i)*EMIS(j) **** 152 : C ********************************************************** 153 : 154 : 155 : 156 : LRES.FACT(J) = LRES.FACT(J)*PSUR.FACT(I)* 157 : # EMIS.FACT(J) 158 : 159 : 160 : C ********************************************************** 161 : C **** Fin des differentes boucles de calcul **** 162 : C ********************************************************** 163 : 164 : 70 CONTINUE 165 : RES.LFACT(I) = LRES 166 : SEGDES PSUR 167 : SEGDES EMIS 168 : SEGDES LMATR 169 : SEGDES B 170 : SEGDES LRES 171 : 172 : 50 CONTINUE 173 : 174 : SEGSUP TRAVAI, B 175 : SEGDES RES 176 : SEGDES MATR 177 : 178 : RETURN 179 : END 180 : 181 : 182 : 183 : 184 :
© Cast3M 2003 - All rights reserved.
Disclaimer