c@a c@versb C----------------------------------------------------------------------- C CVERS Code_Saturne version 1.3 C ------------------------ C C This file is part of the Code_Saturne Kernel, element of the C Code_Saturne CFD tool. C C Copyright (C) 1998-2007 EDF S.A., France C C contact: saturne-support@edf.fr C C The Code_Saturne Kernel is free software; you can redistribute it C and/or modify it under the terms of the GNU General Public License C as published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C The Code_Saturne Kernel is distributed in the hope that it will be C useful, but WITHOUT ANY WARRANTY; without even the implied warranty C of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public License C along with the Code_Saturne Kernel; if not, write to the C Free Software Foundation, Inc., C 51 Franklin St, Fifth Floor, C Boston, MA 02110-1301 USA C C----------------------------------------------------------------------- c@verse SUBROUTINE USRAY3 C ***************** C -------------------------------------------------------------- & ( IDBIA0 , IDBRA0 , & NDIM , NCELET , NCEL , NFAC , NFABOR , NFML , NPRFML , & NNOD , LNDFAC , LNDFBR , NCELBR , & NVAR , NSCAL , IPHAS , IAPPEL , & NIDEVE , NRDEVE , NITUSE , NRTUSE , & IFACEL , IFABOR , IFMFBR , IFMCEL , IPRFML , ITYPFB , & IPNFAC , NODFAC , IPNFBR , NODFBR , IZFRDP , & IDEVEL , ITUSER , IA , & XYZCEN , SURFAC , SURFBO , CDGFAC , CDGFBO , XYZNOD , VOLUME , & DT , RTP , RTPA , PROPCE , PROPFA , PROPFB , & CK , W1 , W2 , W3 , W4 , W5 , W6 , & RDEVEL , RTUSER , & RA ) C -------------------------------------------------------------- C*********************************************************************** C FONCTION : C ---------- c@foncb CFONC CFONC SOUS-PROGRAMME DU MODULE DE RAYONNEMENT : CFONC ----------------------------------------- CFONC CFONC CFONC Coefficient d'absorption CFONC ------------------------- CFONC CFONC Il est indispensable de renseigner la valeur du coefficient CFONC d'absorption du fluide CK. CFONC CFONC Pour un milieu transparent, le coefficient doit etre CFONC fixe a 0.D0. CFONC CFONC DANS LE CAS DU MODELE P-1 ON VERIFIE QUE LA LONGUEUR OPTIQUE CFONC DU MILIEU EST AU MINIMUM DE L'ORDRE DE L'UNITE CFONC CFONC ATTENTION : CFONC ========= CFONC Pour les physiques particulieres (Combustion, charbon...) CFONC CFONC il est INTERDIT de fournir le COEFFICIENT D'ABSORPTION ici. CFONC ======== CFONC CFONC Voir le sous-programme PPCABS CFONC CFONC c@fonce C----------------------------------------------------------------------- c@argub CARGU ARGUMENTS CARGU .______________.____._____.______________________________________. CARGU ! NOM !TYPE!MODE ! ROLE ! CARGU !______________!____!_____!______________________________________! CARGU ! IDBIA0 ! E ! -> ! NUMERO DE LA 1ERE CASE LIBRE DANS IA ! CARGU ! IDBRA0 ! E ! -> ! NUMERO DE LA 1ERE CASE LIBRE DANS RA ! CARGU ! NDIM ! E ! -> ! DIMENSION DE L'ESPACE ! CARGU ! NCELET ! E ! -> ! NOMBRE D'ELEMENTS HALO COMPRIS ! CARGU ! NCEL ! E ! -> ! NOMBRE D'ELEMENTS ACTIFS ! CARGU ! NFAC ! E ! -> ! NOMBRE DE FACES INTERNES ! CARGU ! NFABOR ! E ! -> ! NOMBRE DE FACES DE BORD ! CARGU ! NFML ! E ! -> ! NOMBRE DE FAMILLES D ENTITES ! CARGU ! NPRFML ! E ! -> ! NOMBRE DE PROPRIETESE DES FAMILLES ! CARGU ! NNOD ! E ! -> ! NOMBRE DE SOMMETS ! CARGU ! LNDFAC ! E ! -> ! LONGUEUR DU TABLEAU NODFAC (OPTIONNEL! CARGU ! LNDFBR ! E ! -> ! LONGUEUR DU TABLEAU NODFBR (OPTIONNEL! CARGU ! NCELBR ! E ! -> ! NOMBRE D'ELEMENTS AYANT AU MOINS UNE ! CARGU ! ! ! ! FACE DE BORD ! CARGU ! NVAR ! E ! -> ! NOMBRE TOTAL DE VARIABLES ! CARGU ! NSCAL ! E ! -> ! NOMBRE TOTAL DE SCALAIRES ! CARGU ! IPHAS ! E ! -> ! NUMERO DE LA PHASE COURANTE ! CARGU ! NIDEVE NRDEVE! E ! -> ! LONGUEUR DE IDEVEL RDEVEL ! CARGU ! NITUSE NRTUSE! E ! -> ! LONGUEUR DE ITUSER RTUSER ! CARGU ! IFACEL ! TE ! -> ! ELEMENTS VOISINS D'UNE FACE INTERNE ! CARGU ! (2, NFAC) ! ! ! ! CARGU ! IFABOR ! TE ! -> ! ELEMENT VOISIN D'UNE FACE DE BORD ! CARGU ! (NFABOR) ! ! ! ! CARGU ! IFMFBR ! TE ! -> ! NUMERO DE FAMILLE D'UNE FACE DE BORD ! CARGU ! (NFABOR) ! ! ! ! CARGU ! IFMCEL ! TE ! -> ! NUMERO DE FAMILLE D'UNE CELLULE ! CARGU ! (NCELET) ! ! ! ! CARGU ! IPRFML ! TE ! -> ! PROPRIETES D'UNE FAMILLE ! CARGU ! NFML ,NPRFML! ! ! ! CARGU ! ITYPFB(NFABOR! TE ! -> ! TYPE DES FACES DE BORD ! CARGU ! NPHAS )! ! ! ! CARGU ! IPNFAC ! TE ! -> ! POSITION DU PREMIER NOEUD DE CHAQUE ! CARGU ! (LNDFAC) ! ! ! FACE INTERNE DANS NODFAC (OPTIONNEL)! CARGU ! NODFAC ! TE ! -> ! CONNECTIVITE FACES INTERNES/NOEUDS ! CARGU ! (NFAC+1) ! ! ! (OPTIONNEL) ! CARGU ! IPNFBR ! TE ! -> ! POSITION DU PREMIER NOEUD DE CHAQUE ! CARGU ! (LNDFBR) ! ! ! FACE DE BORD DANS NODFBR (OPTIONNEL)! CARGU ! NODFBR ! TE ! -> ! CONNECTIVITE FACES DE BORD/NOEUDS ! CARGU ! (NFABOR+1) ! ! ! (OPTIONNEL) ! CARGU ! IZFRDP(NFABOR! TE ! -> ! NUMERO DE ZONE POUR LES FACES DE BORD! CARGU ! IDEVEL(NIDEVE! TE ! <-> ! TAB ENTIER COMPLEMENTAIRE DEVELOPEMT ! CARGU ! ITUSER(NITUSE! TE ! <-> ! TAB ENTIER COMPLEMENTAIRE UTILISATEUR! CARGU ! IA(*) ! TR ! - ! MACRO TABLEAU ENTIER ! CARGU ! XYZCEN ! TR ! -> ! POINT ASSOCIES AUX VOLUMES DE CONTROL! CARGU ! (NDIM,NCELET ! ! ! ! CARGU ! SURFAC ! TR ! -> ! VECTEUR SURFACE DES FACES INTERNES ! CARGU ! (NDIM,NFAC) ! ! ! ! CARGU ! SURFBO ! TR ! -> ! VECTEUR SURFACE DES FACES DE BORD ! CARGU ! (NDIM,NFABOR)! ! ! ! CARGU ! CDGFAC ! TR ! -> ! CENTRE DE GRAVITE DES FACES INTERNES ! CARGU ! (NDIM,NFAC) ! ! ! ! CARGU ! CDGFBO ! TR ! -> ! CENTRE DE GRAVITE DES FACES DE BORD ! CARGU ! (NDIM,NFABOR)! ! ! ! CARGU ! XYZNOD ! TR ! -> ! COORDONNES DES NOEUDS (OPTIONNEL) ! CARGU ! (NDIM,NNOD) ! ! ! ! CARGU ! VOLUME ! TR ! -> ! VOLUME D'UN DES NCELET ELEMENTS ! CARGU ! (NCELET ! ! ! ! CARGU ! DT(NCELET) ! TR ! -> ! PAS DE TEMPS ! CARGU ! RTP, RTPA ! TR ! -> ! VARIABLES DE CALCUL AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES (INSTANT COURANT OU PREC)! CARGU ! PROPCE ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NCELET,*) ! ! ! CELLULES ! CARGU ! PROPFA ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NFAC,*) ! ! ! FACES INTERNES ! CARGU ! PROPFB ! TR ! -> ! PROPRIETES PHYSIQUES AU CENTRE DES ! CARGU ! (NFABOR,*) ! ! ! FACES DE BORD ! CARGU ! CK (NCELET) ! TR ! <- ! COEFFICIENT D'ABSORPTION DU MILIEU ! CARGU ! ! ! ! (NUL SI TRANSPARENT) ! CARGU ! RDEVEL(NRDEVE! TR ! <-> ! TAB REEL COMPLEMENTAIRE DEVELOPEMT ! CARGU ! W1...6(NCELET! TR ! - ! TABLEAU DE TRAVAIL ! CARGU ! RTUSER(NRTUSE! TR ! <-> ! TAB REEL COMPLEMENTAIRE UTILISATEUR ! CARGU ! RA(*) ! TR ! - ! MACRO TABLEAU REEL ! CARGU !______________!____!_____!______________________________________! c@argue C c@commb CCOMM COMMONS CCOMM .______________.____._____.______________________________________. CCOMM ! NOM !TYPE!MODE ! ROLE ! CCOMM !______________!____!_____!______________________________________! CCOMM !______________!____!_____!______________________________________! c@comme C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : -> DONNEE, <- RESULTAT, <-> DONNEE MODIFIEE, C - TABLEAU DE TRAVAIL C----------------------------------------------------------------------- C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C INCLUDE "paramx.h" INCLUDE "numvar.h" INCLUDE "entsor.h" INCLUDE "optcal.h" INCLUDE "cstphy.h" INCLUDE "cstnum.h" INCLUDE "pointe.h" INCLUDE "parall.h" INCLUDE "period.h" INCLUDE "radiat.h" INCLUDE "ppppar.h" INCLUDE "ppthch.h" INCLUDE "coincl.h" INCLUDE "cpincl.h" INCLUDE "ppincl.h" INCLUDE "ihmpre.h" C C*********************************************************************** C C ARGUMENTS C INTEGER IDBIA0 , IDBRA0 INTEGER NDIM , NCELET , NCEL , NFAC , NFABOR INTEGER NFML , NPRFML INTEGER NNOD , LNDFAC , LNDFBR , NCELBR INTEGER NVAR , NSCAL , IPHAS , IAPPEL INTEGER NIDEVE , NRDEVE , NITUSE , NRTUSE C INTEGER IFACEL(2,NFAC) , IFABOR(NFABOR) INTEGER IFMFBR(NFABOR) , IFMCEL(NCELET) INTEGER IPRFML(NFML,NPRFML) , ITYPFB(NFABOR) INTEGER IPNFAC(NFAC+1), NODFAC(LNDFAC) INTEGER IPNFBR(NFABOR+1), NODFBR(LNDFBR),IZFRDP(NFABOR) INTEGER IDEVEL(NIDEVE), ITUSER(NITUSE), IA(*) C DOUBLE PRECISION XYZCEN(NDIM,NCELET) DOUBLE PRECISION SURFAC(NDIM,NFAC), SURFBO(NDIM,NFABOR) DOUBLE PRECISION CDGFAC(NDIM,NFAC), CDGFBO(NDIM,NFABOR) DOUBLE PRECISION XYZNOD(NDIM,NNOD), VOLUME(NCELET) DOUBLE PRECISION DT(NCELET), RTP(NCELET,*), RTPA(NCELET,*) DOUBLE PRECISION PROPCE(NCELET,*) DOUBLE PRECISION PROPFA(NFAC,*), PROPFB(NFABOR,*) C DOUBLE PRECISION W1(NCELET), W2(NCELET), W3(NCELET) DOUBLE PRECISION W4(NCELET), W5(NCELET), W6(NCELET) C DOUBLE PRECISION CK(NCELET) C DOUBLE PRECISION RDEVEL(NRDEVE), RTUSER(NRTUSE), RA(*) C C C VARIABLES LOCALES C INTEGER IDEBIA , IDEBRA , IEL, IFAC, IOK, IFAM, ICOUL DOUBLE PRECISION VV, SF, XLC, XIT, XKMIN, DISTBF, PP C C*********************************************************************** C C TEST_A_ENLEVER_POUR_UTILISER_LE_SOUS_PROGRAMME_DEBUT C======================================================================= C C======================================================================= C 0. CE TEST PERMET A L'UTILISATEUR D'ETRE CERTAIN QUE C'EST C SA VERSION DU SOUS PROGRAMME QUI EST UTILISEE C ET NON CELLE DE LA BIBLIOTHEQUE C======================================================================= C IF (IIHMPR.EQ.1) THEN RETURN ELSE WRITE(NFECRA,9000) CALL CSEXIT (1) ENDIF C 9000 FORMAT( &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/, &'@ @@ ATTENTION : ARRET RAYONNEMENT ',/, &'@ ********* ',/, &'@ LE SOUS-PROGRAMME UTILISATEUR usray3 DOIT ETRE COMPLETE',/, &'@ ',/, &'@ Le calcul ne sera pas execute. ',/, &'@ ',/, &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/) C C======================================================================= C TEST_A_ENLEVER_POUR_UTILISER_LE_SOUS_PROGRAMME_FIN C C C======================================================================= C 0 - GESTION MEMOIRE C======================================================================= C IDEBIA = IDBIA0 IDEBRA = IDBRA0 C C Indicateur d'arret (pour savoir si des faces ont ete oubliees) IOK = 0 C C======================================================================= C COEFFICIENT D'ABSORPTION DU MILIEU (m-1) C C DANS LE CAS DES PHYSIQUES "CLASSIQUES" C CK DOIT ETRE COMPLETE (IL EST NUL PAR DEFAUT) C C C DANS LE CAS DES PHYSIQUES PARTICULIERES (COMBUSTION/CHARBON/ELEC) C C CK NE DOIT PAS ETRE FOURNI C =========== C (il est determine automatiquement, eventuellement a partir C du fichier parametrique) C======================================================================= C C C C IF(NSCAPP.LE.0) THEN DO IEL = 1, NCEL CK(IEL) = 0.D0 ENDDO ENDIF C C--> MODELE P1 : Controle standard des valeurs du coefficient C d'absorption. Ce coefficient doit assurer une C longueur optique au minimum de l'ordre de l'unite. C IF (IRAYON(IPHAS).EQ.2 .AND. NSCAPP.LE.0) THEN SF = 0.D0 VV = 0.D0 C C Calcul de la longueur caractéristique du domaine de calcul C DO IFAC = 1,NFABOR SF = SF + SQRT( & SURFBO(1,IFAC)**2 + & SURFBO(2,IFAC)**2 + & SURFBO(3,IFAC)**2 ) ENDDO IF (IRANGP.GE.0) THEN CALL PARSOM(SF) C =========== ENDIF C DO IEL = 1,NCEL VV = VV + VOLUME(IEL) ENDDO IF (IRANGP.GE.0) THEN CALL PARSOM(VV) C =========== ENDIF C XLC = 3.6D0 * VV / SF C C Clipping pour la variable CK C XKMIN = 1.D0 / XLC C IOK = 0 C DO IEL = 1,NCEL IF (CK(IEL).LT.XKMIN) THEN IOK = IOK + 1 ENDIF ENDDO C C Arret en fin de pas de temps si epaisseur optique trop grande C (ISTPP1 = 1 permet d'arreter proprement a la fin du pas de temps C courant). PP = XNP1MX/100.0D0 IF (DBLE(IOK).GT.PP*DBLE(NCEL)) THEN WRITE(NFECRA,3000) XKMIN, DBLE(IOK)/DBLE(NCEL)*100.D0, & XNP1MX ISTPP1 = 1 C CALL CSEXIT (1) C =========== ENDIF ENDIF C C ------- C FORMATS C ------- C 3000 FORMAT( &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/, &'@ @@ ATTENTION : RAYONNEMENT APPROXIMATION P-1 (USRAY3) ',/, &'@ ********* ',/, &'@ ',/, &'@ LA LONGUEUR OPTIQUE DU MILIEU SEMI-TRANSPARENT ',/, &'@ DOIT AU MOINS ETRE DE L''ORDRE DE L''UNITE POUR ETRE ',/, &'@ DANS LE DOMAINE D''APPLICATION DE L''APPROXIMATION P-1',/, &'@ CELA NE SEMBLE PAS ETRE LE CAS ICI. ',/, &'@ ',/, &'@ LE COEFFICIENT D''ABSORPTION MINIMUM POUR ASSURER CETTE ',/, &'@ LONGUEUR OPTIQUE EST XKMIN = ',E10.4 ,/, &'@ CETTE VALEUR N''EST PAS ATTEINTE POUR ', E10.4,'% ',/, &'@ DES CELLULES DU MAILLAGE. ',/, &'@ LE POURCENTAGE DE CELLULES DU MAILLAGE POUR LESQUELLES ',/, &'@ ON ADMET QUE CETTE CONDITION SOIT VIOLEE EST IMPOSE ',/, &'@ PAR DEFAUT OU DANS USINI1 A XNP1MX = ', E10.4,'% ',/, &'@ ',/, &'@ Le calcul est interrompu. ',/, &'@ ',/, &'@ Verifier les valeurs du coefficient d''absorption CK ',/, &'@ dans PPCABS, USRAY3 ou Fichier thermochimie. ',/, &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/) C C END