C RAYE SOURCE CHAT 12/06/07 21:15:58 7389 SUBROUTINE RAYE 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 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 ********************************************************** IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYT.ESO' TYPE = 'MMODEL ' CALL LIROBJ(TYPE, IREP, 1, IRET) IF (IRET.EQ.1) MODL = IREP IF (IRET.EQ.0) THEN MOTERR(1:8)=TYPE CALL ERREUR(37) RETURN ENDIF * on ne prend que les modeles concernés call selmod(modl,ipmod,'RAYONNEMENT') modl=ipmod TYPE = 'MCHAML ' CALL LIROBJ(TYPE, IREP, 1, IRET) IF (IRET.EQ.1) MCHEL11 = IREP write(6,*) ' mchel1 ' , mchel11 IF (IRET.EQ.0) THEN MOTERR(1:8)=TYPE CALL ERREUR(37) RETURN ENDIF call reduaf(mchel11,ipmod,mchel1,1,iretr,kerre) if( iretr.ne.1) then write(6,*) ' aie aie 1 ', kerre call erreur ( kerre) return endif TYPE = 'MCHAML ' CALL LIROBJ(TYPE, IREP, 1, IRET) IF (IRET.EQ.1) MCHEL22 = IREP write(6,*) ' mchel2 ' , mchel2 IF (IRET.EQ.0) THEN MOTERR(1:8)=TYPE CALL ERREUR(37) RETURN ENDIF call reduaf(mchel22,ipmod,mchel2,1,iretr,kerre) if( iretr.ne.1) then call erreur(kerre) return endif TYPE = 'MCHAML ' CALL LIROBJ(TYPE, IREP, 0, IRET) IF (IRET.EQ.1) THEN MCHEL33 = IREP call reduaf(mchel33,ipmod,mchel3,1,iretr,kerre) if( iretr.ne.1) then call erreur(kerre) return endif KMATR = 0 CALL LIRREE(XVAL,0,IRET) IF(IRET.EQ.1) THEN ERRJ = XVAL ELSE ERRJ = 1D-10 ENDIF C Lecture de la temperature du milieu absorbant CALL LIRCHA(MOTCLE,0,LCHAR) IF (MOTCLE.EQ.'TABS') THEN KABS=1 CALL LIRREE(XVAL,0,IRET) IF (IRET.EQ.1) THEN TABS=XVAL ELSE CALL ERREUR(37) RETURN ENDIF ELSE KABS=0 ENDIF ELSE KABS=0 KMATR = 1 C MOTERR(1:8)=TYPE C CALL ERREUR(37) C RETURN ENDIF write(6,*) ' kmatr kabs ' , kmatr,kabs 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 ********************************************************** write(6,*) ' premier appel a rayn1 avec mchel1' CALL RAYN1(MODL, MCHEL1) write(6,* ) ' deuxiee appel a rayn1 avec mchelm2' CALL RAYN1(MODL, MCHEL2) write(6,* ) ' sortie de rayn1' C ********************************************************** C **** Reconnaissance des deux CHAMELEM **** C **** MCHEL1 contient les facteurs de forme **** C **** MCHEL2 contient les emissivites **** C ********************************************************** SEGACT MCHEL1, MCHEL2 IF ((MCHEL1.TITCHE).NE.'FACTEURS DE FORME ') THEN CHAME = MCHEL1 CHAMF = MCHEL2 ELSE CHAME = MCHEL2 CHAMF = MCHEL1 ENDIF SEGDES, MCHEL1, MCHEL2 write(6,*) ' mchel1 mchel2 ', mchel1,mchel2 CALL RAYE0(MODL, INFOEL) C ********************************************************** C **** Conversion des MCHELM en matrices **** C ********************************************************** * call zpchel(mchel1,1) CALL RAYE1(MCHEL1, INFOEL, IFACFO) * call zpchel(mchel2,1) CALL RAYE2(MCHEL2, MODL, INFOEL, IEMIS) 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 ********************************************************** CALL ECROBJ('MCHAML ', 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) CALL RAYN1(MODL, MCHEL2) CALL RAYN1(MODL, MCHEL3) 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 ********************************************************** SEGACT MCHEL1, MCHEL2, MCHEL3 IF ((MCHEL1.TITCHE).EQ.'FACTEURS DE FORME ') 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.'FACTEURS DE FORME ') THEN CHAMF = MCHEL2 CHAMT = MCHEL3 ELSE CHAMF = MCHEL3 CHAMT = MCHEL2 ENDIF ELSE CHAMT = MCHEL1 IF((MCHEL2.TITCHE).EQ.'FACTEURS DE FORME ') 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 ********************************************************** CALL ECROBJ('MCHAML ', MCHEL4) ENDIF IF (IIMPI.GE.4) WRITE(6,*) 'FIN RAYT OK' END