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