Sources Esope | Cast3M

rayen
C RAYEN     SOURCE    CB215821  25/05/21    21:15:02     12273          
      SUBROUTINE RAYEN(modl,mchel1,mchel2,mchel3,errj,mchel4)
 
C **********************************************************
C ****          OPERATEUR RAYE                          ****
C ****                                                  ****
C ****  SYNTAXE : CH2 = RAYE MODL1 CHAM1 CHAM2          ****
C ****           ou                                     ****
C ****            CH2 = RAYE MODL1 CHAM1 CHAM2 CHAM3    ****
C ****                                        (PREC)    ****
C ****                                   'TABS' VAL     ****
C ****          MODL1 : type MMODEL                     ****
C ****          MCHEL1 : type MCHELM                    ****
C ****          MCHEL2 : type MCHELM                    ****
C ****          MCHEL3   : type MCHELM                  ****
C ****          PREC     : flottant                     ****
C ****          VAL      : flottant (T milieu absorbant)****
C ****                                                  ****
C  Rayonnement en milieu transparent dans une cavité    ****
C  2 possibilités:                                      ****
C   1- calcul de la matrice de rayonnement              ****
C        Phi = R. T**4                                  ****
C   2- calcul de la temperature Trad                    ****
C        Phi = emis.sigma.(T**4-Trad**4)                ****
C **********************************************************
 
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
 
C **********************************************************
C ****  Entree des includes                             ****
C **********************************************************
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMMODEL
 
C **********************************************************
C ****  Declaration des variables du probleme           ****
C **********************************************************
 
        POINTEUR MODL.MMODEL
        POINTEUR CHAME.MCHELM, CHAMF.MCHELM, CHAMT.MCHELM
        CHARACTER*8 TYPE
        CHARACTER*4 MOTCLE
 
C       POINTEUR IMCHFA.MCHAML
C **********************************************************
C ****  Lecture des entrees                             ****
C **********************************************************
 
        KABS=0
        KMATR=1
        IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYT.ESO'
        if(mchel3.ne.0) then
C          segact mchel2
          kabs=0
          kmatr=0
          do io=1,mchel2.imache(/1)
            mchaml=mchel2.ichaml(io)
C            segact mchaml
            do ia=1,nomche(/2)
              if( nomche(ia).eq.'TABS' ) then
                kabs=1
                melval=ielval(ia)
C                segact melval
                Tabs= velche(1,1)
                go to 1
             endif
           enddo
    1      continue
         enddo
       endif
*      write(6,*) ' kmatr kabs ' , kmatr , kabs
*      write(6,*) ' errj , tabs ' , errj , tabs
        IF(KMATR.EQ.1) THEN
 
C Calcul de la matrice de rayonnement
 
 
C **********************************************************
C ****  Verification sur l'egalite des supports des     ****
C ****  differents champs.                              ****
C **********************************************************
        CALL RAYN1(MODL, MCHEL1)
        IF (IERR .NE. 0) RETURN
        CALL RAYN1(MODL, MCHEL2)
        IF (IERR .NE. 0) RETURN
 
C **********************************************************
C ****  Reconnaissance des deux CHAMELEM                ****
C ****          MCHEL1 contient les facteurs de forme    ****
C ****          MCHEL2 contient les emissivites          ****
C **********************************************************
 
C        SEGACT MCHEL1, MCHEL2
 
       IF ((MCHEL1.TITCHE).NE.'MATRICE DE RAYONNEMENT') THEN
                 CHAME = MCHEL1
                 CHAMF = MCHEL2
        ELSE
                 CHAME = MCHEL2
                 CHAMF = MCHEL1
        ENDIF
 
        CALL RAYE0(MODL, INFOEL)
        IF (IERR .NE. 0) RETURN
 
C **********************************************************
C ****  Conversion des MCHELM en matrices               ****
C **********************************************************
        CALL RAYE1(MCHEL1, INFOEL, IFACFO)
        CALL RAYE2(MCHEL2, MODL, INFOEL, IEMIS)
        IF (IERR .NE. 0) RETURN
 
C **********************************************************
C ****  Calcul de la matrice de rayonnement associe     ****
C **********************************************************
 
        CALL RAYE3(IFACFO, IEMIS, IRES)
 
        IF (IIMPI.GE.3) THEN
                CALL PRFACF(IRES)
        ENDIF
 
C **********************************************************
C ****  Conversion du resultat en un MCHELM             ****
C **********************************************************
 
        LTITR = 0
        CALL FFMCHA(MODL, INFOEL, IRES, MCHEL3, LTITR)
 
C **********************************************************
C ****  Ecriture des resultats                          ****
C **********************************************************
        mchel4=mchel3
 
        ELSE
 
C Calcul de la temperature Trad
 
C **********************************************************
C ****  Verification sur l'egalite des supports des     ****
C ****  differents champs.                              ****
C **********************************************************
 
        CALL RAYN1(MODL, MCHEL1)
        IF (IERR .NE. 0) RETURN
        CALL RAYN1(MODL, MCHEL2)
        IF (IERR .NE. 0) RETURN
        CALL RAYN1(MODL, MCHEL3)
        IF (IERR .NE. 0) RETURN
 
C **********************************************************
C ****  Reconnaissance des deux CHAMELEM                ****
C ****          MCHEL1 contient les facteurs de forme    ****
C ****          MCHEL2 contient les emissivites par element)****
C ****          MCHEL3 contient les temperatures par element***
C **********************************************************
 
 
C        SEGACT MCHEL1, MCHEL2, MCHEL3
       IF ((MCHEL1.TITCHE).EQ.'MATRICE DE RAYONNEMENT') THEN
               CHAMF = MCHEL1
           IF((MCHEL2.TITCHE).EQ.'CARACTERISTIQUES') THEN
               CHAME = MCHEL2
               CHAMT = MCHEL3
           ELSE
               CHAME = MCHEL3
               CHAMT = MCHEL2
           ENDIF
        ELSEIF((MCHEL1.TITCHE).EQ.'CARACTERISTIQUES') THEN
               CHAME = MCHEL1
           IF((MCHEL2.TITCHE).EQ.'MATRICE DE RAYONNEMENT') THEN
               CHAMF = MCHEL2
               CHAMT = MCHEL3
           ELSE
               CHAMF = MCHEL3
               CHAMT = MCHEL2
           ENDIF
        ELSE
               CHAMT = MCHEL1
           IF((MCHEL2.TITCHE).EQ.'MATRICE DE RAYONNEMENT') THEN
               CHAMF = MCHEL2
               CHAME = MCHEL3
           ELSE
               CHAMF = MCHEL3
               CHAME = MCHEL2
           ENDIF
 
        ENDIF
 
        CALL RAYE0(MODL, INFOEL)
 
C **********************************************************
C ****  Conversion des MCHELM en matrices               ****
C **********************************************************
 
        CALL RAYE1(CHAMF, INFOEL, IFACFO)
 
        CALL RAYE2(CHAME , MODL, INFOEL, IEMIS)
 
        CALL RAYE2(CHAMT , MODL, INFOEL, ITEMP)
 
C **********************************************************
C ****  Calcul du tableau TRAD                          ****
C **********************************************************
 
        CALL RAYT1(IFACFO, IEMIS, ITEMP, ERRJ , IRES, KABS, TABS)
 
 
C **********************************************************
C ****  Conversion du resultat en un MCHELM             ****
C **********************************************************
 
C       WRITE(6,*) ' infoel',INFOEL
C on ne traite pas les coques
        INFOEL = 0
        CALL RAYT2(MODL, INFOEL, CHAMT , IRES, MCHEL4)
 
C **********************************************************
C ****  Ecriture des resultats                          ****
C **********************************************************
 
        ENDIF
 
        IF (IIMPI.GE.4) WRITE(6,*) 'FIN RAYT OK'
 
        END