Télécharger raye3.eso

Retour à la liste

raye3
C RAYE3     SOURCE    CHAT      12/06/07    21:15:57     7389
        SUBROUTINE RAYE3(MATR, EMIS, RES)
 
C ************************************************************
C ****  SUBROUTINE DE CALCUL DE LA MATRICE DE RAYONNEMENT ****
C ****                                                    ****
C ****  En entree : MATR matrice des facteurs de forme    ****
C ****              EMIS valeur de l'emissivite en chaque ****
C ****                   element de surface               ****
C ****  En sortie : RES matrice de rayonnement            ****
C ****                                                    ****
C ****  Le resultat obtenu est RES:                     ****
C ****  RES = (I - F)*(I - (I - EMIS)*F)**(-1)*S*EMIS   ****
C **********************************************************T(J)
 
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
 
-INC CCREEL
 
-INC PPARAM
-INC CCOPTIO
 
C **********************************************************
C ****  Declaration de la structure des facteurs        ****
C ****  de forme                                        ****
C **********************************************************
 
        SEGMENT IFACFO
           INTEGER LFACT(NBEL1)
        ENDSEGMENT
        SEGMENT LFAC
           REAL *8 FACT(NBEL2)
        ENDSEGMENT
 
C ****  Segment de travail pour l'inversion de matrice  ****
 
        SEGMENT TRAVAI
           REAL *8 A(NEL,NEL), BT(NEL,NEL)
           INTEGER IS(NEL)
        ENDSEGMENT
 
C **********************************************************
C ****  Declaration des variables du probleme           ****
C **********************************************************
 
        POINTEUR MATR.IFACFO, RES.IFACFO
        POINTEUR LMATR.LFAC, LRES.LFAC
        POINTEUR PSUR.LFAC, B.LFAC, EMIS.LFAC
 
C **********************************************************
C ****  Activation de la matrice des facteurs de forme  ****
C ****  par l'intermediaire de son pointeur. Sa         ****
C ****  dimension est Nbel. Le dernier pointeur pointe  ****
C ****  sur les elements de surface                     ****
C **********************************************************
 
        IF (IIMPI.GE.4) THEN
                WRITE(6,*) 'DEBUT DE RAYE3.ESO'
        ENDIF
 
        SEGACT MATR
        Nel = MATR.LFACT(/1)
 
        IF (IIMPI.GE.4) THEN
                WRITE(6,*) 'Nel =',Nel
                WRITE(6,*) 'On doit trouver comme NBEL1 (NBEL + 1)'
        ENDIF
 
        Nel = Nel - 1
 
        SEGINI TRAVAI
 
        NBEL1 = Nel + 1
        NBEL2 = Nel
        PSUR = MATR.LFACT(NBEL1)
 
        SEGACT EMIS
 
C **********************************************************
C ****  Calcul de (I - (I - EMIS)*F)                    ****
C ****  (EMIS matrice diagonale des emissivites)        ****
C ****  Au debut, on travaille avec une structure       ****
C ****  matricielle A(Nel, Nel) car la routine INVER ne ****
C ****  fonctionne que pour cette structure.            ****
C **********************************************************
 
        DO 10 I = 1, Nel
                LMATR = MATR.LFACT(I)
 
                SEGACT LMATR
 
                DO 20 J = 1, Nel
                        A(I,J)=-(1.D0-(EMIS.FACT(I)))*(LMATR.FACT(J))
                        IF (I.EQ.J) A(I, I) = 1.D0 + A(I,J)
 20             CONTINUE
 
                SEGDES LMATR
 
 10     CONTINUE
 
        SEGDES EMIS
 
C **********************************************************
C ****  Calcul de (I - (I - EMIS)*F)**(-1) grace a une  ****
C ****  subroutine de calcul (INVER1)                   ****
C **********************************************************
 
        ICRIT = 0
        CALL INVER1(TRAVAI, Nel, ICRIT, XPETIT)
 
 
C **********************************************************
C ****  Multiplication de RES par (I - F)               ****
C **********************************************************
 
        SEGINI RES
 
        RES.LFACT(NBEL1) = MATR.LFACT(NBEL1)
 
        DO 50 I = 1, (NBEL1 - 1)
                SEGINI B
 
C **********************************************************
C ****  (I - F) est enregistre dans B                   ****
C **********************************************************
 
                LMATR = MATR.LFACT(I)
                SEGACT LMATR
 
                DO 60 J = 1, NBEL2
                        B.FACT(J) = -LMATR.FACT(J)
                        IF (I.EQ.J) B.FACT(J) = 1.D0 + B.FACT(J)
 60             CONTINUE
 
                SEGINI LRES
                SEGACT PSUR
                SEGACT EMIS
 
                DO 70 J = 1, NBEL2
 
C **********************************************************
C ****  LRES(i,j) = somm[B(i,k)*TEMP(k,j)]              ****
C **********************************************************
 
                        DO 80 K = 1, NBEL2
                                LRES.FACT(J) = LRES.FACT(J) +
     #                          B.FACT(K)*A(K,J)
 
 80                     CONTINUE
 
C **********************************************************
C ****  Multiplication par la surface et l'emissivite   ****
C ****  LRES(i,j) = LRES(i,j)*S(i)*EMIS(j)              ****
C **********************************************************
 
 
 
                        LRES.FACT(J) = LRES.FACT(J)*PSUR.FACT(I)*
     #                                                EMIS.FACT(J)
 
 
C **********************************************************
C ****   Fin des differentes boucles de calcul          ****
C **********************************************************
 
 70             CONTINUE
                RES.LFACT(I) = LRES
                SEGDES PSUR
                SEGDES EMIS
                SEGDES LMATR
                SEGDES B
                SEGDES LRES
 
 50     CONTINUE
 
        SEGSUP TRAVAI, B
        SEGDES RES
        SEGDES MATR
 
        RETURN
        END
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales