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 LAGRUS C ***************** C ------------------------------------------------------------- & ( IDBIA0 , IDBRA0 , & NCELET , NCEL , & NBPMAX , NVP , NVP1 , NVEP , NIVEP , & ITEPA , INDEP , & IA , & ETTP , ETTPA , TEPA , CROULE , & RA ) C ------------------------------------------------------------- C*********************************************************************** C FONCTION : C ---------- c@foncb CFONC CFONC SOUS-PROGRAMME DU MODULE LAGRANGIEN : CFONC ----------------------------------- CFONC CFONC Roulette russe et clonage applique aux particules CFONC suivant un critere d'importance (CROULE) CFONC c@fonce C----------------------------------------------------------------------- C ARGUMENTS c@argub 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 ! NCELET ! E ! -> ! NOMBRE D'ELEMENTS HALO COMPRIS ! CARGU ! NCEL ! E ! -> ! NOMBRE D'ELEMENTS ACTIFS ! CARGU ! NBPMAX ! E ! -> ! NOMBRE MAX DE PARTICULIES AUTORISE ! CARGU ! NVP ! E ! -> ! NOMBRE DE VARIABLES PARTICULAIRES ! CARGU ! NVP1 ! E ! -> ! NVP SANS POSITION, VFLUIDE, VPART ! CARGU ! NVEP ! E ! -> ! NOMBRE INFO PARTICULAIRES (REELS) ! CARGU ! NIVEP ! E ! -> ! NOMBRE INFO PARTICULAIRES (ENTIERS) ! CARGU ! NTERSL ! E ! -> ! NBR TERMES SOURCES DE COUPLAGE RETOUR! CARGU ! NVLSTA ! E ! -> ! NOMBRE DE VAR STATISTIQUES LAGRANGIEN! CARGU ! ITEPA ! TE ! -> ! INFO PARTICULAIRES (ENTIERS) ! CARGU ! (NBPMAX,NIVEP! ! ! (CELLULE DE LA PARTICULE,...) ! CARGU ! INDEP(NBPMAX)! TE ! <-> ! NUMERO DE SA CELLULE DE DEPART ! CARGU ! IA(*) ! TR ! - ! MACRO TABLEAU ENTIER ! CARGU ! ETTP ! TR ! <-> ! TABLEAUX DES VARIABLES LIEES ! CARGU ! (NBPMAX,NVP)! ! ! AUX PARTICULES ETAPE COURANTE ! CARGU ! ETTPA ! TR ! -> ! TABLEAUX DES VARIABLES LIEES ! CARGU ! (NBPMAX,NVP)! ! ! AUX PARTICULES ETAPE PRECEDENTE ! CARGU ! TEPA ! TR ! <-> ! INFO PARTICULAIRES (REELS) ! CARGU ! (NBPMAX,NVEP)! ! ! (POIDS STATISTIQUES,...) ! CARGU ! CROULE(NCELET! TR ! -> ! CRITERE D'IMPORTANCE ! 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 "cstnum.h" INCLUDE "optcal.h" INCLUDE "entsor.h" INCLUDE "lagpar.h" INCLUDE "lagran.h" C C*********************************************************************** C C ARGUMENTS C INTEGER IDBIA0 , IDBRA0 INTEGER NCELET , NCEL INTEGER NBPMAX , NVP , NVP1 , NVEP , NIVEP INTEGER ITEPA(NBPMAX,NIVEP) , INDEP(NBPMAX) INTEGER IA(*) C DOUBLE PRECISION ETTP(NBPMAX,NVP) , ETTPA(NBPMAX,NVP) DOUBLE PRECISION TEPA(NBPMAX,NVEP) DOUBLE PRECISION CROULE(NCELET) DOUBLE PRECISION RA(*) C C VARIABLES LOCALES C INTEGER IEL , IELD , NCLO , NPARS INTEGER NPT , N , N1 , IVA , NC DOUBLE PRECISION AUX(1) , COEFF , PNEW , DNPARS C C*********************************************************************** C C======================================================================= C 0. Initialisation C======================================================================= C C NPCLON : NOMBRE DE NOUVELLES PARTICULES PAR CLONNAGE C C NPKILL : NOMBRE DE PARTICULES VICTIMES DE LA ROULETTE RUSSE C C NPCSUP : NOMBRE DE PARTICULES QUI ON SUBIT LE CLONNAGE C NPCLON = 0 NPCSUP = 0 NPKILL = 0 C DNPCLO = 0.D0 DNPCSU = 0.D0 DNPKIL = 0.D0 C C======================================================================= C 1. Clonage / Fusion (ou "Roulette Russe") C======================================================================= C C C Boucle sur les particules C DO NPT = 1,NBPART C IF (ITEPA(NPT,JISOR).NE.INDEP(NPT)) THEN C IEL = ITEPA(NPT,JISOR) IELD = INDEP(NPT) C C Rapport des fonction d'importance entre la cellule de depart C et celle d'arrivee C COEFF = CROULE(IEL) / CROULE(IELD) C IF (COEFF.LT.1.D0) THEN C C--------------- C ROULETTE RUSSE C--------------- C N1 = 1 CALL ZUFALL(N1,AUX(1)) C IF (AUX(1).LT.COEFF) THEN C C La particule survit avec une probabilite COEFF C TEPA(NPT,JRPOI) = TEPA(NPT,JRPOI)/COEFF C ELSE C C La particule est supprimee avec une probabilite (1-COEFF) C ITEPA(NPT,JISOR) = 0 NPKILL = NPKILL + 1 DNPKIL = DNPKIL + TEPA(NPT,JRPOI) ENDIF C ELSE IF (COEFF.GT.1.D0) THEN C C-------- C CLONAGE C-------- C N = INT(COEFF) N1 = 1 CALL ZUFALL(N1,AUX(1)) C IF (AUX(1).LT.(COEFF-DBLE(N))) THEN C C Clonage en N+1 particules C NCLO = N + 1 C ELSE C C Clonage en N particules C NCLO = N C ENDIF C IF ((NBPART+NPCLON+NCLO+1).GT.NBPMAX) THEN WRITE(NFECRA,5000) NBPART, NPCLON+NCLO+1, NBPMAX GOTO 1000 ENDIF C NPCSUP = NPCSUP + 1 DNPCSU = DNPCSU + TEPA(NPT,JRPOI) PNEW = TEPA(NPT,JRPOI) / DBLE(NCLO) C DO NC = 1,NCLO C NPCLON = NPCLON + 1 DNPCLO = DNPCLO + PNEW C DO IVA = 1,NVP ETTP(NBPART+NPCLON,IVA) = ETTP(NPT,IVA) ENDDO C DO IVA = 1,NVP ETTPA(NBPART+NPCLON,IVA) = ETTPA(NPT,IVA) ENDDO C DO IVA = 1,NVEP TEPA(NBPART+NPCLON,IVA) = TEPA(NPT,IVA) ENDDO C TEPA(NBPART+NPCLON,JRPOI) = PNEW C DO IVA = 1,NIVEP ITEPA(NBPART+NPCLON,IVA) = ITEPA(NPT,IVA) ENDDO C ENDDO C C Modif de la particule elle meme C ITEPA(NPT,JISOR) = 0 C ENDIF ENDIF ENDDO C 1000 CONTINUE C C Actualisation du nouveau nombre de particules C NBPART = NBPART + NPCLON DNBPAR = DNBPAR + DNPCLO C C======================================================================= C 2. On elimine les particules qui ont perdu à la Roulette Russe C et celles qui ont subit le clonage. C======================================================================= C CALL LAGELI C =========== & ( NBPMAX , NVP , NVP1 , NVEP , NIVEP , & NPARS , & ITEPA , IA , & DNPARS , & ETTP , ETTPA , TEPA , RA ) C IF ( NPARS.NE.(NPKILL+NPCSUP) ) THEN WRITE(NFECRA,9000) CALL CSEXIT(1) C =========== ENDIF C C------- C FORMAT C------- C 5000 FORMAT( &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/, &'@ @@ ATTENTION : MODULE LAGRANGIEN ',/, &'@ ********* ',/, &'@ CLONAGE / FUSION DES PARTICULES ',/, &'@ ',/, &'@ Le nombre de nouvelles particules clonees conduit a un ',/, &'@ nombre total de particules superieur au maximum prevu : ',/, &'@ Nombre de particules courant : NBPART = ',I10 ,/, &'@ Nombre de particules clonnees : NPCLON = ',I10 ,/, &'@ Nombre maximal de particules : NBPMAX = ',I10 ,/, &'@ ',/, &'@ On ne clone plus de particules por cette iteration. ',/, &'@ ',/, &'@ Verifier NBPMAX dans USLAG1. ',/, &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/) C 9000 FORMAT( &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/, &'@ @@ ATTENTION : MODULE LAGRANGIEN ',/, &'@ ********* ',/, &'@ CLONAGE / FUSION DES PARTICULES ',/, &'@ ',/, &'@ La somme des particules detruites a la Roulette Russe ',/, &'@ avec celles qui ont subit le clonage ',/, &'@ est different de celui des particules eliminees. ',/, &'@ ',/, &'@ Le calcul ne sera pas execute. ',/, &'@ ',/, &'@ Verifier LAGRUS et LAGELI. ',/, &'@ ',/, &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/, &'@ ',/) C C---- C FIN C---- C END