syrthes-3.4.3-dfsg1/0000755000175000017500000000000011524070646012711 5ustar pinipinisyrthes-3.4.3-dfsg1/example/0000777000175000017500000000000011511305604014337 5ustar pinipinisyrthes-3.4.3-dfsg1/example/cylinder/0000777000175000017500000000000011524070640016153 5ustar pinipinisyrthes-3.4.3-dfsg1/example/cylinder/syrthes.env0000666000175000017500000000210711524070640020366 0ustar pinipini* ************************************************************************ * EMPLACEMENT ET NOM DES FICHIERS DU MODULE SYRTHES * ************************************************************************ * * EMPLACEMENT DES FICHIERS POUR SYRTHES AMONT : ./ SUITE : ./ AVAL : ./ * * NOM DES FICHIERS AMONT POUR SYRTHES DONNEES DU CALCUL : syrthes.data GEOMETRIE SOLIDE : MESH/cylinder.syr DONNEES POUR LE RAYONNEMENT : syrthes.ray MAILLAGE RAYONNEMENT : MESH/cylinder_rad.syr * * NOM DES FICHIERS SUITE POUR SYRTHES SUITE SOLIDE RESU : resus1 FACTEURS DE FORME RAYONNEMENT : fdf STOCKAGE DES CORRESPONDANTS RAYONNEMENT : corresp.ray * * NOM DES FICHIERS AVAL POUR SYRTHES RESU SYRTHES 1 : RESU/geom.syr RESU SYRTHES 2 : RESU/resus1 CHRONO SYRTHES 2 : RESU/resusc1 HISTORIQUE SOLIDE RESULTAT : RESU/histos1 MAILLAGE DE RAYONNEMENT : RESU/raygeo.syr RESULTATS DE RAYONNEMENT : RESU/ray.res1 CHRONO DE RAYONNEMENT : RESU/ray.chro1 HISTORIQUE RAYONNEMENT : RESU/ray.histo1 * syrthes-3.4.3-dfsg1/example/cylinder/Makefile0000666000175000017500000001231711524070640017617 0ustar pinipini#----------------------------------------------------------------------- # # SYRTHES version 3.4 # ------------------- # # This file is part of the SYRTHES Kernel, element of the # thermal code SYRTHES. # # Copyright (C) 1988-2008 EDF S.A., France # # contact: syrthes-support@edf.fr # # # The SYRTHES Kernel is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # The SYRTHES Kernel is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # # You should have received a copy of the GNU General Public License # along with the Code_Saturne Kernel; if not, write to the # Free Software Foundation, Inc., # 51 Franklin St, Fifth Floor, # Boston, MA 02110-1301 USA # #----------------------------------------------------------------------- # # Makefile for Syrthes ###################### include $(SYRTHES_HOME)/bin/Makefile.in # Environment Macros # ================== SHELL = /bin/sh VERSION = "3.4.2" # Project configuration macros # ============================ # Test if variable SYRTHES_HOME is set ifndef SYRTHES_HOME $(error SYRTHES_HOME is not defined, run 'syrthes.profile' to set a correct value) endif ifeq ($(SYRTHES_HOME),) $(error SYRTHES_HOME is a empty string, run 'syrthes.profile' to set a correct value) endif # Base project directories DIR_SYRTHES = $(SYRTHES_HOME) BIN_SYRTHES = $(DIR_SYRTHES)/bin INC_SYRTHES = $(DIR_SYRTHES)/include SRC_SYRTHES = $(DIR_SYRTHES)/src UTIL_SYRTHES = $(SRC_SYRTHES)/util ARCH_SYRTHES = $(DIR_SYRTHES)/lib/$(NOM_ARCH) EXEC_SYRTHES = $(DIR_SYRTHES)/bin/$(NOM_ARCH) # Names of the base library and Syrthes executable file NOM_PREFIX = "syrthes" NOM_LIB_MAIN = "libmain"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_LIB_SAT = "libsat"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_LIB_SYRTHES = "lib"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_EXE = "syrthes" NOM_UTIL1 = "syrthes2ensight" # Presentation macros #-------------------- BO = `tput bold` SO = `tput smso` NO = `tput rmso; tput sgr0` # Target definitions #=================== exe: @for ffile in *.F ; do \ if [ -f $${ffile} ] ; then \ echo "$${ffile} " ;\ $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $${ffile} ;\ fi ;\ done @for cfile in *.c ; do \ if [ -f $${cfile} ] ; then \ echo "$${cfile} " ;\ $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $${cfile} ;\ fi ;\ done ar xv $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a syrthes.o $(LD) $(LDLFLAGS) -o $(NOM_EXE) *.o \ $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a \ $(ARCH_SYRTHES)/$(NOM_LIB_SYRTHES).a -lm @rm *.o @echo "*** Executable '$(NOM_EXE)' created " lib: $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/s/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/s/*.c @ar rv $(NOM_LIB_SYRTHES).a *.o @rm -f *.o $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/ss/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/ss/*.c @ar rv $(NOM_LIB_MAIN).a *.o @rm -f *.o $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/sc/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/sc/*.c @ar rv $(NOM_LIB_SAT).a *.o @rm -f *.o @if [ ! -d "$(ARCH_SYRTHES)" ] ;\ then mkdir "$(ARCH_SYRTHES)" ;\ fi ;\ @mv *.a $(ARCH_SYRTHES) # @echo "*** Libraries created in directory $(ARCH_SYRTHES)" install: lib util @echo "*** installation successfull" util: $(CC) $(CFLAGS) -o $(NOM_UTIL1) $(UTIL_SYRTHES)/$(NOM_UTIL1).c @if [ ! -d "$(EXEC_SYRTHES)" ] ; then \ mkdir "$(EXEC_SYRTHES)" ;\ fi ;\ @mv $(NOM_UTIL1) $(EXEC_SYRTHES) # @echo "***Executable '$(NOM_UTIL1)' created in directory $(EXEC_SYRTHES)" clean: @rm -f *.o distclean: clean @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_SYRTHES).a @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_SAT).a @rm -f $(NOM_EXE) @rm -f $(EXEC_SYRTHES)/$(NOM_UTIL1) help info: @echo @echo "*** Syrthes $(VERSION) compilation/link" @echo "*** System: $(NOM_ARCH)" @echo @echo @echo "Usage : $(BO)make$(NO) $(SO)$(NO) (in a user directory)" @echo " for Syrthes link" @echo @echo " with :" @echo " $(SO)$(NO) : $(BO)exe$(NO) : 'syrthes' executable (default)" @echo " $(BO)install$(NO) : libraries creation and utilitaries" @echo " $(BO)lib$(NO) : libraries creation" @echo " $(BO)util$(NO) : utilitaries" @echo " $(BO)clean$(NO) : deletes object files" @echo " $(BO)distclean$(NO) : deletes object files, libraries, and utilitaries" @echo " $(BO)help$(NO) : this message" @echo " $(BO)info$(NO) : same" @echo @echo " and the additional user options:" @echo " $(SO)$(NO) : C compiler options" @echo " $(SO)$(NO) : Fortran compiler options" @echo " $(SO)$(NO): linker options" @echo syrthes-3.4.3-dfsg1/example/cylinder/syrthes.ray0000666000175000017500000000476011524070640020400 0ustar pinipini/********************************************************************* / Fichier de donnees pour SYRTHES 3.0 RAYONNEMENT /********************************************************************* / - Les lignes qui commencent par '/' sont des commentaires / - Dans une meme ligne, les blancs sont des separateurs, / leur nombre est quelconque / - L'ordre d'enumeration des conditions n'a aucune importance / - Les chaines sont donnees entre cotes / /********************************************************************* / Definitions / ----------- 'PERIODICITE DE ROTATION POUR LE RAYONNEMENT=' 'NON' 'NOMBRE DE PLANS DE SYMETRIE POUR LE RAYONNEMENT=' 1 / 'NOMBRE DE BANDES SPECTRALES POUR LE RAYONNEMENT=' 1 / / Sorties / ------- 'NIVEAU DES IMPRESSIONS POUR LE RAYONNEMENT=' 3 'PAS DES SORTIES CHRONO RAYONNEMENT=' -1 'HISTORIQUES RAYONNEMENT=' 'NON' / / Gestion des correspondants et facteurs de forme /------------------------------------------------ 'NOMBRE DE REDECOUPAGES POUR CALCUL DES FACTEURS DE FORME=' 0 'DOMAINE DE RAYONNEMENT CONFINE OUVERT SUR L EXTERIEUR=' 'NON' 'STOCKAGE DES FACTEURS DE FORME SUR FICHIER=' 'NON' 'LECTURE DES FACTEURS DE FORME SUR FICHIER=' 'NON' / 'STOCKAGE DES CORRESPONDANTS POUR RAYONNEMENT=' 'NON' 'LECTURE DES CORRESPONDANTS POUR RAYONNEMENT=' 'NON' / /********************************************************************* / / References sur le solide / ------------------------ 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT CONFINE' 2 3 / / References sur le maillage de rayonnement / ----------------------------------------- 'RAYONNEMENT : REFERENCES FACES COUPLEES AU SOLIDE' 2 3 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE COUPLEES AU FLUIDE' 0 'RAYONNEMENT : REFERENCES FACES TEMPERATURE IMPOSEE' 0 'RAYONNEMENT : REFERENCES FACES FLUX IMPOSE' 0 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE' 0 / /********************************************************************* / ----------------------------------------- / Entree des conditions pour le rayonnement / ----------------------------------------- / 'RAYT' 'VOLUME CONNEXE' Px Py Pz 'RAYT' 'VOLUME CONNEXE' 0.7 0. 0.0 / 'RAYT' 'SYM2D' 1. 0. 0. 0. / / bande lbd1 lbd2 'RAYT' 'BANDES SPECTRALES' 1 1.e-10 10. / / bande emissi ref 'RAYT' 'EMISSIVITE PAR BANDE' 1 0.5 2 'RAYT' 'EMISSIVITE PAR BANDE' 1 0.8 3 / /********************************************************************* syrthes-3.4.3-dfsg1/example/cylinder/syrthes.data0000666000175000017500000000561611524070640020517 0ustar pinipini/********************************************************************* / Fichier de donnees pour le couplage thermique /********************************************************************* / - Les lignes qui commencent par '/' sont des commentaires / - Dans une meme ligne, les blancs sont des separateurs, / leur nombre est quelconque / - L'ordre d'enumeration des conditions n'a aucune importance / - Les chaines sont donnees entre cotes / /********************************************************************* / Definitions /------------- / 'DIMENSION DU PROBLEME=' 2 'AXE D AXISYMETRIE (AUCUN,OX,OY)=' 'AUCUN' 'SUITE DE CALCUL=' 'NON' / 'ISOTROPIE DU MATERIAU=' 1 'NOMBRE DE DIRECTIONS PERIODIQUES=' 0 / 'CONDITIONS LIMITES PAR NOEUD OU PAR FACE=' 'FACE' 'DEFINITION DES PROPRIETES PHYSIQUES PAR=' 'ELEMENT' 'DEFINITION DES FLUX VOLUMIQUES PAR=' 'ELEMENT' / / Rayonnement /------------ 'PRISE EN COMPTE DU RAYONNEMENT CONFINE=' 'OUI' / / Pas de temps /--------------- 'PAS DE TEMPS SOLIDE=' 1800. 'NOMBRE DE PAS DE TEMPS SOLIDES=' 100 / / / Sorties /-------- 'NIVEAU DES IMPRESSIONS POUR LE SOLIDE=' 3 'PAS DES SORTIES CHRONO SOLIDE=' 20 'PAS DES SORTIES LISTING SOLIDE=' -1 / 'HISTORIQUES CONDUCTION=' 'OUI' / / / Choix numeriques /----------------- 'NOMBRE ITERATIONS SOLVEUR SOLIDE=' 100 'FREQUENCE DU CALCUL SOLIDE=' 1 'PRECISION POUR LE SOLVEUR SOLIDE=' 1.E-7 / / /*************************************************************** / 'REFERENCES NOEUDS OU FACES SOLIDES COUPLE(E)S' 0 'REFERENCES NOEUDS SOLIDES AVEC DIRICHLET' 1 4 'REFERENCES NOEUDS OU FACES SOLIDES AVEC FLUX' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC COEFFICIENT D ECHANGE' 2 3 'REFERENCES NOEUDS OU ELEMENTS SOLIDES AVEC FLUX VOLUMIQUES' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RESISTANCE DE CONTACT' 0 'REFERENCES NOEUDS SOLIDES PERIODIQUES' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT INFINI' 0 / / ------------------------------- / Entree des conditions initiales / ------------------------------- / mot-cle valeur liste des references 'CINI' 0. -1 / / / ----------------------------------------------------- / Entree des conditions aux limites constantes par bloc / ----------------------------------------------------- / mot-cle type valeur liste des references / 'CLIM' 'DIRICHLET' 0. 4 'CLIM' 'DIRICHLET' 1000. 1 / / --------------------------------------------------- / Entree des conditions physiques constantes par bloc / --------------------------------------------------- / mot-cle type valeur liste des references 'CPHY' 'RHO' 7700. -1 'CPHY' 'CP' 460. -1 'CPHY' 'K ISOTROPE' 25. -1 / / / ----------- / Historiques / ----------- 'HIST' 'FREQ' 100. 'HIST' 'NOEUDS' 120 121 122 123 124 125 126 421 422 423 424 425 426 427 / syrthes-3.4.3-dfsg1/example/cylinder/RESU/0000777000175000017500000000000011524070640016731 5ustar pinipinisyrthes-3.4.3-dfsg1/example/cylinder/RESU/histos10000666000175000017500000030470011524070640020252 0ustar pinipini 0.180000000E+04 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.180000000E+04 121 0.250000000E+00 0.000000000E+00 0.585081553E+03 0.180000000E+04 122 0.300000000E+00 0.000000000E+00 0.352967856E+03 0.180000000E+04 123 0.350000000E+00 0.000000000E+00 0.221644882E+03 0.180000000E+04 124 0.400000000E+00 0.149011600E-07 0.149105153E+03 0.180000000E+04 125 0.450000000E+00 0.149011600E-07 0.113078501E+03 0.180000000E+04 126 0.500000000E+00 0.000000000E+00 0.102168706E+03 0.180000000E+04 421 0.100000000E+01 0.000000000E+00 -.621609348E-08 0.180000000E+04 422 0.105000000E+01 0.608173600E-07 -.361449824E-08 0.180000000E+04 423 0.110000000E+01 0.187131300E-07 -.214659564E-08 0.180000000E+04 424 0.115000000E+01 0.748522200E-07 -.125955527E-08 0.180000000E+04 425 0.120000000E+01 0.187130200E-07 -.694869584E-09 0.180000000E+04 426 0.125000000E+01 -.467825600E-07 -.305946113E-09 0.180000000E+04 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.360000000E+04 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.360000000E+04 121 0.250000000E+00 0.000000000E+00 0.726679124E+03 0.360000000E+04 122 0.300000000E+00 0.000000000E+00 0.528178609E+03 0.360000000E+04 123 0.350000000E+00 0.000000000E+00 0.391774224E+03 0.360000000E+04 124 0.400000000E+00 0.149011600E-07 0.304747779E+03 0.360000000E+04 125 0.450000000E+00 0.149011600E-07 0.256827842E+03 0.360000000E+04 126 0.500000000E+00 0.000000000E+00 0.240799198E+03 0.360000000E+04 421 0.100000000E+01 0.000000000E+00 0.784627373E+00 0.360000000E+04 422 0.105000000E+01 0.608173600E-07 0.488491690E+00 0.360000000E+04 423 0.110000000E+01 0.187131300E-07 0.301390339E+00 0.360000000E+04 424 0.115000000E+01 0.748522200E-07 0.181318047E+00 0.360000000E+04 425 0.120000000E+01 0.187130200E-07 0.101708766E+00 0.360000000E+04 426 0.125000000E+01 -.467825600E-07 0.452165067E-01 0.360000000E+04 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.540000000E+04 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.540000000E+04 121 0.250000000E+00 0.000000000E+00 0.789555756E+03 0.540000000E+04 122 0.300000000E+00 0.000000000E+00 0.629028256E+03 0.540000000E+04 123 0.350000000E+00 0.000000000E+00 0.511447467E+03 0.540000000E+04 124 0.400000000E+00 0.149011600E-07 0.431459240E+03 0.540000000E+04 125 0.450000000E+00 0.149011600E-07 0.384307294E+03 0.540000000E+04 126 0.500000000E+00 0.000000000E+00 0.365827074E+03 0.540000000E+04 421 0.100000000E+01 0.000000000E+00 0.386134887E+01 0.540000000E+04 422 0.105000000E+01 0.608173600E-07 0.250522929E+01 0.540000000E+04 423 0.110000000E+01 0.187131300E-07 0.160430844E+01 0.540000000E+04 424 0.115000000E+01 0.748522200E-07 0.996537765E+00 0.540000000E+04 425 0.120000000E+01 0.187130200E-07 0.573159080E+00 0.540000000E+04 426 0.125000000E+01 -.467825600E-07 0.258939375E+00 0.540000000E+04 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.720000000E+04 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.720000000E+04 121 0.250000000E+00 0.000000000E+00 0.829212326E+03 0.720000000E+04 122 0.300000000E+00 0.000000000E+00 0.696986687E+03 0.720000000E+04 123 0.350000000E+00 0.000000000E+00 0.597452136E+03 0.720000000E+04 124 0.400000000E+00 0.149011600E-07 0.526949105E+03 0.720000000E+04 125 0.450000000E+00 0.149011600E-07 0.482375063E+03 0.720000000E+04 126 0.500000000E+00 0.000000000E+00 0.460693299E+03 0.720000000E+04 421 0.100000000E+01 0.000000000E+00 0.105477378E+02 0.720000000E+04 422 0.105000000E+01 0.608173600E-07 0.709507018E+01 0.720000000E+04 423 0.110000000E+01 0.187131300E-07 0.469329570E+01 0.720000000E+04 424 0.115000000E+01 0.748522200E-07 0.299696346E+01 0.720000000E+04 425 0.120000000E+01 0.187130200E-07 0.176096633E+01 0.720000000E+04 426 0.125000000E+01 -.467825600E-07 0.806476729E+00 0.720000000E+04 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.900000000E+04 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.900000000E+04 121 0.250000000E+00 0.000000000E+00 0.856719119E+03 0.900000000E+04 122 0.300000000E+00 0.000000000E+00 0.744772935E+03 0.900000000E+04 123 0.350000000E+00 0.000000000E+00 0.658748605E+03 0.900000000E+04 124 0.400000000E+00 0.149011600E-07 0.595429885E+03 0.900000000E+04 125 0.450000000E+00 0.149011600E-07 0.552199303E+03 0.900000000E+04 126 0.500000000E+00 0.000000000E+00 0.526462160E+03 0.900000000E+04 421 0.100000000E+01 0.000000000E+00 0.204758820E+02 0.900000000E+04 422 0.105000000E+01 0.608173600E-07 0.142678440E+02 0.900000000E+04 423 0.110000000E+01 0.187131300E-07 0.973655345E+01 0.900000000E+04 424 0.115000000E+01 0.748522200E-07 0.638187658E+01 0.900000000E+04 425 0.120000000E+01 0.187130200E-07 0.382531926E+01 0.900000000E+04 426 0.125000000E+01 -.467825600E-07 0.177401012E+01 0.900000000E+04 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.108000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.108000000E+05 121 0.250000000E+00 0.000000000E+00 0.875885476E+03 0.108000000E+05 122 0.300000000E+00 0.000000000E+00 0.778083601E+03 0.108000000E+05 123 0.350000000E+00 0.000000000E+00 0.701401309E+03 0.108000000E+05 124 0.400000000E+00 0.149011600E-07 0.642763689E+03 0.108000000E+05 125 0.450000000E+00 0.149011600E-07 0.599758170E+03 0.108000000E+05 126 0.500000000E+00 0.000000000E+00 0.570089444E+03 0.108000000E+05 421 0.100000000E+01 0.000000000E+00 0.320519752E+02 0.108000000E+05 422 0.105000000E+01 0.608173600E-07 0.230601287E+02 0.108000000E+05 423 0.110000000E+01 0.187131300E-07 0.161844332E+02 0.108000000E+05 424 0.115000000E+01 0.748522200E-07 0.108586376E+02 0.108000000E+05 425 0.120000000E+01 0.187130200E-07 0.662457783E+01 0.108000000E+05 426 0.125000000E+01 -.467825600E-07 0.310626235E+01 0.108000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.126000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.126000000E+05 121 0.250000000E+00 0.000000000E+00 0.889017270E+03 0.126000000E+05 122 0.300000000E+00 0.000000000E+00 0.800848302E+03 0.126000000E+05 123 0.350000000E+00 0.000000000E+00 0.730403483E+03 0.126000000E+05 124 0.400000000E+00 0.149011600E-07 0.674672491E+03 0.126000000E+05 125 0.450000000E+00 0.149011600E-07 0.631386445E+03 0.126000000E+05 126 0.500000000E+00 0.000000000E+00 0.598514378E+03 0.126000000E+05 421 0.100000000E+01 0.000000000E+00 0.436912659E+02 0.126000000E+05 422 0.105000000E+01 0.608173600E-07 0.322946440E+02 0.126000000E+05 423 0.110000000E+01 0.187131300E-07 0.232087801E+02 0.126000000E+05 424 0.115000000E+01 0.748522200E-07 0.158801392E+02 0.126000000E+05 425 0.120000000E+01 0.187130200E-07 0.983226089E+01 0.126000000E+05 426 0.125000000E+01 -.467825600E-07 0.465294535E+01 0.126000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.144000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.144000000E+05 121 0.250000000E+00 0.000000000E+00 0.897859354E+03 0.144000000E+05 122 0.300000000E+00 0.000000000E+00 0.816136395E+03 0.144000000E+05 123 0.350000000E+00 0.000000000E+00 0.749790170E+03 0.144000000E+05 124 0.400000000E+00 0.149011600E-07 0.695852127E+03 0.144000000E+05 125 0.450000000E+00 0.149011600E-07 0.652170743E+03 0.144000000E+05 126 0.500000000E+00 0.000000000E+00 0.616937079E+03 0.144000000E+05 421 0.100000000E+01 0.000000000E+00 0.543791994E+02 0.144000000E+05 422 0.105000000E+01 0.608173600E-07 0.410807913E+02 0.144000000E+05 423 0.110000000E+01 0.187131300E-07 0.300935539E+02 0.144000000E+05 424 0.115000000E+01 0.748522200E-07 0.209196270E+02 0.144000000E+05 425 0.120000000E+01 0.187130200E-07 0.131073949E+02 0.144000000E+05 426 0.125000000E+01 -.467825600E-07 0.624880378E+01 0.144000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.162000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.162000000E+05 121 0.250000000E+00 0.000000000E+00 0.903736381E+03 0.162000000E+05 122 0.300000000E+00 0.000000000E+00 0.826277824E+03 0.162000000E+05 123 0.350000000E+00 0.000000000E+00 0.762607278E+03 0.162000000E+05 124 0.400000000E+00 0.149011600E-07 0.709786937E+03 0.162000000E+05 125 0.450000000E+00 0.149011600E-07 0.665757299E+03 0.162000000E+05 126 0.500000000E+00 0.000000000E+00 0.628879932E+03 0.162000000E+05 421 0.100000000E+01 0.000000000E+00 0.636469576E+02 0.162000000E+05 422 0.105000000E+01 0.608173600E-07 0.489152739E+02 0.162000000E+05 423 0.110000000E+01 0.187131300E-07 0.363773728E+02 0.162000000E+05 424 0.115000000E+01 0.748522200E-07 0.256050985E+02 0.162000000E+05 425 0.120000000E+01 0.187130200E-07 0.161936577E+02 0.162000000E+05 426 0.125000000E+01 -.467825600E-07 0.776495279E+01 0.162000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.180000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.180000000E+05 121 0.250000000E+00 0.000000000E+00 0.907610556E+03 0.180000000E+05 122 0.300000000E+00 0.000000000E+00 0.832954668E+03 0.180000000E+05 123 0.350000000E+00 0.000000000E+00 0.771028056E+03 0.180000000E+05 124 0.400000000E+00 0.149011600E-07 0.718915598E+03 0.180000000E+05 125 0.450000000E+00 0.149011600E-07 0.674625590E+03 0.180000000E+05 126 0.500000000E+00 0.000000000E+00 0.636642248E+03 0.180000000E+05 421 0.100000000E+01 0.000000000E+00 0.713846885E+02 0.180000000E+05 422 0.105000000E+01 0.608173600E-07 0.555999863E+02 0.180000000E+05 423 0.110000000E+01 0.187131300E-07 0.418365331E+02 0.180000000E+05 424 0.115000000E+01 0.748522200E-07 0.297340766E+02 0.180000000E+05 425 0.120000000E+01 0.187130200E-07 0.189415684E+02 0.180000000E+05 426 0.125000000E+01 -.467825600E-07 0.912334500E+01 0.180000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.198000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.198000000E+05 121 0.250000000E+00 0.000000000E+00 0.910153186E+03 0.198000000E+05 122 0.300000000E+00 0.000000000E+00 0.837333723E+03 0.198000000E+05 123 0.350000000E+00 0.000000000E+00 0.776544930E+03 0.198000000E+05 124 0.400000000E+00 0.149011600E-07 0.724887960E+03 0.198000000E+05 125 0.450000000E+00 0.149011600E-07 0.680418787E+03 0.198000000E+05 126 0.500000000E+00 0.000000000E+00 0.641706229E+03 0.198000000E+05 421 0.100000000E+01 0.000000000E+00 0.776781122E+02 0.198000000E+05 422 0.105000000E+01 0.608173600E-07 0.611295182E+02 0.198000000E+05 423 0.110000000E+01 0.187131300E-07 0.464155587E+02 0.198000000E+05 424 0.115000000E+01 0.748522200E-07 0.332354476E+02 0.198000000E+05 425 0.120000000E+01 0.187130200E-07 0.212902449E+02 0.198000000E+05 426 0.125000000E+01 -.467825600E-07 0.102899257E+02 0.198000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.216000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.216000000E+05 121 0.250000000E+00 0.000000000E+00 0.911819347E+03 0.216000000E+05 122 0.300000000E+00 0.000000000E+00 0.840202608E+03 0.216000000E+05 123 0.350000000E+00 0.000000000E+00 0.780158093E+03 0.216000000E+05 124 0.400000000E+00 0.149011600E-07 0.728798355E+03 0.216000000E+05 125 0.450000000E+00 0.149011600E-07 0.684211882E+03 0.216000000E+05 126 0.500000000E+00 0.000000000E+00 0.645024358E+03 0.216000000E+05 421 0.100000000E+01 0.000000000E+00 0.827013821E+02 0.216000000E+05 422 0.105000000E+01 0.608173600E-07 0.656016569E+02 0.216000000E+05 423 0.110000000E+01 0.187131300E-07 0.501590794E+02 0.216000000E+05 424 0.115000000E+01 0.748522200E-07 0.361221470E+02 0.216000000E+05 425 0.120000000E+01 0.187130200E-07 0.232383515E+02 0.216000000E+05 426 0.125000000E+01 -.467825600E-07 0.112610758E+02 0.216000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.234000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.234000000E+05 121 0.250000000E+00 0.000000000E+00 0.912911782E+03 0.234000000E+05 122 0.300000000E+00 0.000000000E+00 0.842083798E+03 0.234000000E+05 123 0.350000000E+00 0.000000000E+00 0.782527888E+03 0.234000000E+05 124 0.400000000E+00 0.149011600E-07 0.731364459E+03 0.234000000E+05 125 0.450000000E+00 0.149011600E-07 0.686703753E+03 0.234000000E+05 126 0.500000000E+00 0.000000000E+00 0.647209090E+03 0.234000000E+05 421 0.100000000E+01 0.000000000E+00 0.866551634E+02 0.234000000E+05 422 0.105000000E+01 0.608173600E-07 0.691583658E+02 0.234000000E+05 423 0.110000000E+01 0.187131300E-07 0.531614560E+02 0.234000000E+05 424 0.115000000E+01 0.748522200E-07 0.384525005E+02 0.234000000E+05 425 0.120000000E+01 0.187130200E-07 0.248183643E+02 0.234000000E+05 426 0.125000000E+01 -.467825600E-07 0.120509397E+02 0.234000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.252000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.252000000E+05 121 0.250000000E+00 0.000000000E+00 0.913629560E+03 0.252000000E+05 122 0.300000000E+00 0.000000000E+00 0.843320239E+03 0.252000000E+05 123 0.350000000E+00 0.000000000E+00 0.784086479E+03 0.252000000E+05 124 0.400000000E+00 0.149011600E-07 0.733054053E+03 0.252000000E+05 125 0.450000000E+00 0.149011600E-07 0.688347596E+03 0.252000000E+05 126 0.500000000E+00 0.000000000E+00 0.648655111E+03 0.252000000E+05 421 0.100000000E+01 0.000000000E+00 0.897341394E+02 0.252000000E+05 422 0.105000000E+01 0.608173600E-07 0.719510256E+02 0.252000000E+05 423 0.110000000E+01 0.187131300E-07 0.555345173E+02 0.252000000E+05 424 0.115000000E+01 0.748522200E-07 0.403038303E+02 0.252000000E+05 425 0.120000000E+01 0.187130200E-07 0.260781661E+02 0.252000000E+05 426 0.125000000E+01 -.467825600E-07 0.126821010E+02 0.252000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.270000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.270000000E+05 121 0.250000000E+00 0.000000000E+00 0.914102717E+03 0.270000000E+05 122 0.300000000E+00 0.000000000E+00 0.844135713E+03 0.270000000E+05 123 0.350000000E+00 0.000000000E+00 0.785115399E+03 0.270000000E+05 124 0.400000000E+00 0.149011600E-07 0.734171194E+03 0.270000000E+05 125 0.450000000E+00 0.149011600E-07 0.689437202E+03 0.270000000E+05 126 0.500000000E+00 0.000000000E+00 0.649617543E+03 0.270000000E+05 421 0.100000000E+01 0.000000000E+00 0.921120320E+02 0.270000000E+05 422 0.105000000E+01 0.608173600E-07 0.741220525E+02 0.270000000E+05 423 0.110000000E+01 0.187131300E-07 0.573890669E+02 0.270000000E+05 424 0.115000000E+01 0.748522200E-07 0.417564938E+02 0.270000000E+05 425 0.120000000E+01 0.187130200E-07 0.270695139E+02 0.270000000E+05 426 0.125000000E+01 -.467825600E-07 0.131796166E+02 0.270000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.288000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.288000000E+05 121 0.250000000E+00 0.000000000E+00 0.914415917E+03 0.288000000E+05 122 0.300000000E+00 0.000000000E+00 0.844675856E+03 0.288000000E+05 123 0.350000000E+00 0.000000000E+00 0.785797723E+03 0.288000000E+05 124 0.400000000E+00 0.149011600E-07 0.734913418E+03 0.288000000E+05 125 0.450000000E+00 0.149011600E-07 0.690163262E+03 0.288000000E+05 126 0.500000000E+00 0.000000000E+00 0.650261877E+03 0.288000000E+05 421 0.100000000E+01 0.000000000E+00 0.939364384E+02 0.288000000E+05 422 0.105000000E+01 0.608173600E-07 0.757966183E+02 0.288000000E+05 423 0.110000000E+01 0.187131300E-07 0.588255608E+02 0.288000000E+05 424 0.115000000E+01 0.748522200E-07 0.428853187E+02 0.288000000E+05 425 0.120000000E+01 0.187130200E-07 0.278416155E+02 0.288000000E+05 426 0.125000000E+01 -.467825600E-07 0.135676271E+02 0.288000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.306000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.306000000E+05 121 0.250000000E+00 0.000000000E+00 0.914624240E+03 0.306000000E+05 122 0.300000000E+00 0.000000000E+00 0.845035398E+03 0.306000000E+05 123 0.350000000E+00 0.000000000E+00 0.786252520E+03 0.306000000E+05 124 0.400000000E+00 0.149011600E-07 0.735409198E+03 0.306000000E+05 125 0.450000000E+00 0.149011600E-07 0.690649830E+03 0.306000000E+05 126 0.500000000E+00 0.000000000E+00 0.650695891E+03 0.306000000E+05 421 0.100000000E+01 0.000000000E+00 0.953288226E+02 0.306000000E+05 422 0.105000000E+01 0.608173600E-07 0.770801738E+02 0.306000000E+05 423 0.110000000E+01 0.187131300E-07 0.599303840E+02 0.306000000E+05 424 0.115000000E+01 0.748522200E-07 0.437557573E+02 0.306000000E+05 425 0.120000000E+01 0.187130200E-07 0.284380695E+02 0.306000000E+05 426 0.125000000E+01 -.467825600E-07 0.138676931E+02 0.306000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.324000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.324000000E+05 121 0.250000000E+00 0.000000000E+00 0.914763551E+03 0.324000000E+05 122 0.300000000E+00 0.000000000E+00 0.845276031E+03 0.324000000E+05 123 0.350000000E+00 0.000000000E+00 0.786557356E+03 0.324000000E+05 124 0.400000000E+00 0.149011600E-07 0.735742272E+03 0.324000000E+05 125 0.450000000E+00 0.149011600E-07 0.690977865E+03 0.324000000E+05 126 0.500000000E+00 0.000000000E+00 0.650990081E+03 0.324000000E+05 421 0.100000000E+01 0.000000000E+00 0.963869503E+02 0.324000000E+05 422 0.105000000E+01 0.608173600E-07 0.780590488E+02 0.324000000E+05 423 0.110000000E+01 0.187131300E-07 0.607752868E+02 0.324000000E+05 424 0.115000000E+01 0.748522200E-07 0.444228128E+02 0.324000000E+05 425 0.120000000E+01 0.187130200E-07 0.288958317E+02 0.324000000E+05 426 0.125000000E+01 -.467825600E-07 0.140981869E+02 0.324000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.342000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.342000000E+05 121 0.250000000E+00 0.000000000E+00 0.914857251E+03 0.342000000E+05 122 0.300000000E+00 0.000000000E+00 0.845438024E+03 0.342000000E+05 123 0.350000000E+00 0.000000000E+00 0.786762892E+03 0.342000000E+05 124 0.400000000E+00 0.149011600E-07 0.735967400E+03 0.342000000E+05 125 0.450000000E+00 0.149011600E-07 0.691200401E+03 0.342000000E+05 126 0.500000000E+00 0.000000000E+00 0.651190775E+03 0.342000000E+05 421 0.100000000E+01 0.000000000E+00 0.971882539E+02 0.342000000E+05 422 0.105000000E+01 0.608173600E-07 0.788024924E+02 0.342000000E+05 423 0.110000000E+01 0.187131300E-07 0.614184357E+02 0.342000000E+05 424 0.115000000E+01 0.748522200E-07 0.449314513E+02 0.342000000E+05 425 0.120000000E+01 0.187130200E-07 0.292452999E+02 0.342000000E+05 426 0.125000000E+01 -.467825600E-07 0.142742774E+02 0.342000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.360000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.360000000E+05 121 0.250000000E+00 0.000000000E+00 0.914920658E+03 0.360000000E+05 122 0.300000000E+00 0.000000000E+00 0.845547745E+03 0.360000000E+05 123 0.350000000E+00 0.000000000E+00 0.786902335E+03 0.360000000E+05 124 0.400000000E+00 0.149011600E-07 0.736120521E+03 0.360000000E+05 125 0.450000000E+00 0.149011600E-07 0.691352332E+03 0.360000000E+05 126 0.500000000E+00 0.000000000E+00 0.651328574E+03 0.360000000E+05 421 0.100000000E+01 0.000000000E+00 0.977933219E+02 0.360000000E+05 422 0.105000000E+01 0.608173600E-07 0.793652206E+02 0.360000000E+05 423 0.110000000E+01 0.187131300E-07 0.619061581E+02 0.360000000E+05 424 0.115000000E+01 0.748522200E-07 0.453177120E+02 0.360000000E+05 425 0.120000000E+01 0.187130200E-07 0.295109474E+02 0.360000000E+05 426 0.125000000E+01 -.467825600E-07 0.144082100E+02 0.360000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.378000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.378000000E+05 121 0.250000000E+00 0.000000000E+00 0.914963836E+03 0.378000000E+05 122 0.300000000E+00 0.000000000E+00 0.845622532E+03 0.378000000E+05 123 0.350000000E+00 0.000000000E+00 0.786997540E+03 0.378000000E+05 124 0.400000000E+00 0.149011600E-07 0.736225336E+03 0.378000000E+05 125 0.450000000E+00 0.149011600E-07 0.691456728E+03 0.378000000E+05 126 0.500000000E+00 0.000000000E+00 0.651423796E+03 0.378000000E+05 421 0.100000000E+01 0.000000000E+00 0.982491215E+02 0.378000000E+05 422 0.105000000E+01 0.608173600E-07 0.797899728E+02 0.378000000E+05 423 0.110000000E+01 0.187131300E-07 0.622748647E+02 0.378000000E+05 424 0.115000000E+01 0.748522200E-07 0.456100549E+02 0.378000000E+05 425 0.120000000E+01 0.187130200E-07 0.297121665E+02 0.378000000E+05 426 0.125000000E+01 -.467825600E-07 0.145097081E+02 0.378000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.396000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.396000000E+05 121 0.250000000E+00 0.000000000E+00 0.914993427E+03 0.396000000E+05 122 0.300000000E+00 0.000000000E+00 0.845673835E+03 0.396000000E+05 123 0.350000000E+00 0.000000000E+00 0.787062959E+03 0.396000000E+05 124 0.400000000E+00 0.149011600E-07 0.736297544E+03 0.396000000E+05 125 0.450000000E+00 0.149011600E-07 0.691528921E+03 0.396000000E+05 126 0.500000000E+00 0.000000000E+00 0.651490014E+03 0.396000000E+05 421 0.100000000E+01 0.000000000E+00 0.985917950E+02 0.396000000E+05 422 0.105000000E+01 0.608173600E-07 0.801098367E+02 0.396000000E+05 423 0.110000000E+01 0.187131300E-07 0.625528802E+02 0.396000000E+05 424 0.115000000E+01 0.748522200E-07 0.458307022E+02 0.396000000E+05 425 0.120000000E+01 0.187130200E-07 0.298641397E+02 0.396000000E+05 426 0.125000000E+01 -.467825600E-07 0.145863962E+02 0.396000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.414000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.414000000E+05 121 0.250000000E+00 0.000000000E+00 0.915013837E+03 0.414000000E+05 122 0.300000000E+00 0.000000000E+00 0.845709254E+03 0.414000000E+05 123 0.350000000E+00 0.000000000E+00 0.787108200E+03 0.414000000E+05 124 0.400000000E+00 0.149011600E-07 0.736347608E+03 0.414000000E+05 125 0.450000000E+00 0.149011600E-07 0.691579160E+03 0.414000000E+05 126 0.500000000E+00 0.000000000E+00 0.651536346E+03 0.414000000E+05 421 0.100000000E+01 0.000000000E+00 0.988489917E+02 0.414000000E+05 422 0.105000000E+01 0.608173600E-07 0.803502485E+02 0.414000000E+05 423 0.110000000E+01 0.187131300E-07 0.627620627E+02 0.414000000E+05 424 0.115000000E+01 0.748522200E-07 0.459968535E+02 0.414000000E+05 425 0.120000000E+01 0.187130200E-07 0.299786421E+02 0.414000000E+05 426 0.125000000E+01 -.467825600E-07 0.146441950E+02 0.414000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.432000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.432000000E+05 121 0.250000000E+00 0.000000000E+00 0.915028004E+03 0.432000000E+05 122 0.300000000E+00 0.000000000E+00 0.845733863E+03 0.432000000E+05 123 0.350000000E+00 0.000000000E+00 0.787139684E+03 0.432000000E+05 124 0.400000000E+00 0.149011600E-07 0.736382535E+03 0.432000000E+05 125 0.450000000E+00 0.149011600E-07 0.691614336E+03 0.432000000E+05 126 0.500000000E+00 0.000000000E+00 0.651568956E+03 0.432000000E+05 421 0.100000000E+01 0.000000000E+00 0.990417643E+02 0.432000000E+05 422 0.105000000E+01 0.608173600E-07 0.805306515E+02 0.432000000E+05 423 0.110000000E+01 0.187131300E-07 0.629191728E+02 0.432000000E+05 424 0.115000000E+01 0.748522200E-07 0.461217279E+02 0.432000000E+05 425 0.120000000E+01 0.187130200E-07 0.300647389E+02 0.432000000E+05 426 0.125000000E+01 -.467825600E-07 0.146876671E+02 0.432000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.450000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.450000000E+05 121 0.250000000E+00 0.000000000E+00 0.915037898E+03 0.450000000E+05 122 0.300000000E+00 0.000000000E+00 0.845751065E+03 0.450000000E+05 123 0.350000000E+00 0.000000000E+00 0.787161728E+03 0.450000000E+05 124 0.400000000E+00 0.149011600E-07 0.736407048E+03 0.450000000E+05 125 0.450000000E+00 0.149011600E-07 0.691639110E+03 0.450000000E+05 126 0.500000000E+00 0.000000000E+00 0.651592036E+03 0.450000000E+05 421 0.100000000E+01 0.000000000E+00 0.991860810E+02 0.450000000E+05 422 0.105000000E+01 0.608173600E-07 0.806658409E+02 0.450000000E+05 423 0.110000000E+01 0.187131300E-07 0.630369960E+02 0.450000000E+05 424 0.115000000E+01 0.748522200E-07 0.462154291E+02 0.450000000E+05 425 0.120000000E+01 0.187130200E-07 0.301293680E+02 0.450000000E+05 426 0.125000000E+01 -.467825600E-07 0.147203072E+02 0.450000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.468000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.468000000E+05 121 0.250000000E+00 0.000000000E+00 0.915044851E+03 0.468000000E+05 122 0.300000000E+00 0.000000000E+00 0.845763163E+03 0.468000000E+05 123 0.350000000E+00 0.000000000E+00 0.787177253E+03 0.468000000E+05 124 0.400000000E+00 0.149011600E-07 0.736424352E+03 0.468000000E+05 125 0.450000000E+00 0.149011600E-07 0.691656654E+03 0.468000000E+05 126 0.500000000E+00 0.000000000E+00 0.651608458E+03 0.468000000E+05 421 0.100000000E+01 0.000000000E+00 0.992940153E+02 0.468000000E+05 422 0.105000000E+01 0.608173600E-07 0.807670328E+02 0.468000000E+05 423 0.110000000E+01 0.187131300E-07 0.631252451E+02 0.468000000E+05 424 0.115000000E+01 0.748522200E-07 0.462856441E+02 0.468000000E+05 425 0.120000000E+01 0.187130200E-07 0.301778138E+02 0.468000000E+05 426 0.125000000E+01 -.467825600E-07 0.147447789E+02 0.468000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.486000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.486000000E+05 121 0.250000000E+00 0.000000000E+00 0.915049763E+03 0.486000000E+05 122 0.300000000E+00 0.000000000E+00 0.845771718E+03 0.486000000E+05 123 0.350000000E+00 0.000000000E+00 0.787188249E+03 0.486000000E+05 124 0.400000000E+00 0.149011600E-07 0.736436634E+03 0.486000000E+05 125 0.450000000E+00 0.149011600E-07 0.691669145E+03 0.486000000E+05 126 0.500000000E+00 0.000000000E+00 0.651620199E+03 0.486000000E+05 421 0.100000000E+01 0.000000000E+00 0.993746718E+02 0.486000000E+05 422 0.105000000E+01 0.608173600E-07 0.808427041E+02 0.486000000E+05 423 0.110000000E+01 0.187131300E-07 0.631912732E+02 0.486000000E+05 424 0.115000000E+01 0.748522200E-07 0.463382000E+02 0.486000000E+05 425 0.120000000E+01 0.187130200E-07 0.302140855E+02 0.486000000E+05 426 0.125000000E+01 -.467825600E-07 0.147631040E+02 0.486000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.504000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.504000000E+05 121 0.250000000E+00 0.000000000E+00 0.915053253E+03 0.504000000E+05 122 0.300000000E+00 0.000000000E+00 0.845777801E+03 0.504000000E+05 123 0.350000000E+00 0.000000000E+00 0.787196077E+03 0.504000000E+05 124 0.400000000E+00 0.149011600E-07 0.736445395E+03 0.504000000E+05 125 0.450000000E+00 0.149011600E-07 0.691678081E+03 0.504000000E+05 126 0.500000000E+00 0.000000000E+00 0.651628633E+03 0.504000000E+05 421 0.100000000E+01 0.000000000E+00 0.994349020E+02 0.504000000E+05 422 0.105000000E+01 0.608173600E-07 0.808992450E+02 0.504000000E+05 423 0.110000000E+01 0.187131300E-07 0.632406312E+02 0.504000000E+05 424 0.115000000E+01 0.748522200E-07 0.463775004E+02 0.504000000E+05 425 0.120000000E+01 0.187130200E-07 0.302412152E+02 0.504000000E+05 426 0.125000000E+01 -.467825600E-07 0.147768123E+02 0.504000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.522000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.522000000E+05 121 0.250000000E+00 0.000000000E+00 0.915055745E+03 0.522000000E+05 122 0.300000000E+00 0.000000000E+00 0.845782147E+03 0.522000000E+05 123 0.350000000E+00 0.000000000E+00 0.787201678E+03 0.522000000E+05 124 0.400000000E+00 0.149011600E-07 0.736451675E+03 0.522000000E+05 125 0.450000000E+00 0.149011600E-07 0.691684502E+03 0.522000000E+05 126 0.500000000E+00 0.000000000E+00 0.651634715E+03 0.522000000E+05 421 0.100000000E+01 0.000000000E+00 0.994798518E+02 0.522000000E+05 422 0.105000000E+01 0.608173600E-07 0.809414629E+02 0.522000000E+05 423 0.110000000E+01 0.187131300E-07 0.632774998E+02 0.522000000E+05 424 0.115000000E+01 0.748522200E-07 0.464068648E+02 0.522000000E+05 425 0.120000000E+01 0.187130200E-07 0.302614899E+02 0.522000000E+05 426 0.125000000E+01 -.467825600E-07 0.147870581E+02 0.522000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.540000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.540000000E+05 121 0.250000000E+00 0.000000000E+00 0.915057533E+03 0.540000000E+05 122 0.300000000E+00 0.000000000E+00 0.845785267E+03 0.540000000E+05 123 0.350000000E+00 0.000000000E+00 0.787205702E+03 0.540000000E+05 124 0.400000000E+00 0.149011600E-07 0.736456195E+03 0.540000000E+05 125 0.450000000E+00 0.149011600E-07 0.691689135E+03 0.540000000E+05 126 0.500000000E+00 0.000000000E+00 0.651639118E+03 0.540000000E+05 421 0.100000000E+01 0.000000000E+00 0.995133810E+02 0.540000000E+05 422 0.105000000E+01 0.608173600E-07 0.809729677E+02 0.540000000E+05 423 0.110000000E+01 0.187131300E-07 0.633050218E+02 0.540000000E+05 424 0.115000000E+01 0.748522200E-07 0.464287902E+02 0.540000000E+05 425 0.120000000E+01 0.187130200E-07 0.302766309E+02 0.540000000E+05 426 0.125000000E+01 -.467825600E-07 0.147947103E+02 0.540000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.558000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.558000000E+05 121 0.250000000E+00 0.000000000E+00 0.915058821E+03 0.558000000E+05 122 0.300000000E+00 0.000000000E+00 0.845787516E+03 0.558000000E+05 123 0.350000000E+00 0.000000000E+00 0.787208606E+03 0.558000000E+05 124 0.400000000E+00 0.149011600E-07 0.736459462E+03 0.558000000E+05 125 0.450000000E+00 0.149011600E-07 0.691692491E+03 0.558000000E+05 126 0.500000000E+00 0.000000000E+00 0.651642316E+03 0.558000000E+05 421 0.100000000E+01 0.000000000E+00 0.995383805E+02 0.558000000E+05 422 0.105000000E+01 0.608173600E-07 0.809964663E+02 0.558000000E+05 423 0.110000000E+01 0.187131300E-07 0.633255554E+02 0.558000000E+05 424 0.115000000E+01 0.748522200E-07 0.464451516E+02 0.558000000E+05 425 0.120000000E+01 0.187130200E-07 0.302879311E+02 0.558000000E+05 426 0.125000000E+01 -.467825600E-07 0.148004219E+02 0.558000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.576000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.576000000E+05 121 0.250000000E+00 0.000000000E+00 0.915059752E+03 0.576000000E+05 122 0.300000000E+00 0.000000000E+00 0.845789143E+03 0.576000000E+05 123 0.350000000E+00 0.000000000E+00 0.787210709E+03 0.576000000E+05 124 0.400000000E+00 0.149011600E-07 0.736461831E+03 0.576000000E+05 125 0.450000000E+00 0.149011600E-07 0.691694929E+03 0.576000000E+05 126 0.500000000E+00 0.000000000E+00 0.651644646E+03 0.576000000E+05 421 0.100000000E+01 0.000000000E+00 0.995570134E+02 0.576000000E+05 422 0.105000000E+01 0.608173600E-07 0.810139859E+02 0.576000000E+05 423 0.110000000E+01 0.187131300E-07 0.633408680E+02 0.576000000E+05 424 0.115000000E+01 0.748522200E-07 0.464573551E+02 0.576000000E+05 425 0.120000000E+01 0.187130200E-07 0.302963606E+02 0.576000000E+05 426 0.125000000E+01 -.467825600E-07 0.148046827E+02 0.576000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.594000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.594000000E+05 121 0.250000000E+00 0.000000000E+00 0.915060428E+03 0.594000000E+05 122 0.300000000E+00 0.000000000E+00 0.845790324E+03 0.594000000E+05 123 0.350000000E+00 0.000000000E+00 0.787212237E+03 0.594000000E+05 124 0.400000000E+00 0.149011600E-07 0.736463554E+03 0.594000000E+05 125 0.450000000E+00 0.149011600E-07 0.691696706E+03 0.594000000E+05 126 0.500000000E+00 0.000000000E+00 0.651646348E+03 0.594000000E+05 421 0.100000000E+01 0.000000000E+00 0.995708968E+02 0.594000000E+05 422 0.105000000E+01 0.608173600E-07 0.810270432E+02 0.594000000E+05 423 0.110000000E+01 0.187131300E-07 0.633522826E+02 0.594000000E+05 424 0.115000000E+01 0.748522200E-07 0.464664534E+02 0.594000000E+05 425 0.120000000E+01 0.187130200E-07 0.303026459E+02 0.594000000E+05 426 0.125000000E+01 -.467825600E-07 0.148078600E+02 0.594000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.612000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.612000000E+05 121 0.250000000E+00 0.000000000E+00 0.915060920E+03 0.612000000E+05 122 0.300000000E+00 0.000000000E+00 0.845791185E+03 0.612000000E+05 123 0.350000000E+00 0.000000000E+00 0.787213351E+03 0.612000000E+05 124 0.400000000E+00 0.149011600E-07 0.736464812E+03 0.612000000E+05 125 0.450000000E+00 0.149011600E-07 0.691698004E+03 0.612000000E+05 126 0.500000000E+00 0.000000000E+00 0.651647595E+03 0.612000000E+05 421 0.100000000E+01 0.000000000E+00 0.995812385E+02 0.612000000E+05 422 0.105000000E+01 0.608173600E-07 0.810367717E+02 0.612000000E+05 423 0.110000000E+01 0.187131300E-07 0.633607888E+02 0.612000000E+05 424 0.115000000E+01 0.748522200E-07 0.464732343E+02 0.612000000E+05 425 0.120000000E+01 0.187130200E-07 0.303073307E+02 0.612000000E+05 426 0.125000000E+01 -.467825600E-07 0.148102283E+02 0.612000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.630000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.630000000E+05 121 0.250000000E+00 0.000000000E+00 0.915061279E+03 0.630000000E+05 122 0.300000000E+00 0.000000000E+00 0.845791813E+03 0.630000000E+05 123 0.350000000E+00 0.000000000E+00 0.787214165E+03 0.630000000E+05 124 0.400000000E+00 0.149011600E-07 0.736465732E+03 0.630000000E+05 125 0.450000000E+00 0.149011600E-07 0.691698955E+03 0.630000000E+05 126 0.500000000E+00 0.000000000E+00 0.651648509E+03 0.630000000E+05 421 0.100000000E+01 0.000000000E+00 0.995889404E+02 0.630000000E+05 422 0.105000000E+01 0.608173600E-07 0.810440183E+02 0.630000000E+05 423 0.110000000E+01 0.187131300E-07 0.633671258E+02 0.630000000E+05 424 0.115000000E+01 0.748522200E-07 0.464782864E+02 0.630000000E+05 425 0.120000000E+01 0.187130200E-07 0.303108214E+02 0.630000000E+05 426 0.125000000E+01 -.467825600E-07 0.148119930E+02 0.630000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.648000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.648000000E+05 121 0.250000000E+00 0.000000000E+00 0.915061541E+03 0.648000000E+05 122 0.300000000E+00 0.000000000E+00 0.845792273E+03 0.648000000E+05 123 0.350000000E+00 0.000000000E+00 0.787214761E+03 0.648000000E+05 124 0.400000000E+00 0.149011600E-07 0.736466406E+03 0.648000000E+05 125 0.450000000E+00 0.149011600E-07 0.691699653E+03 0.648000000E+05 126 0.500000000E+00 0.000000000E+00 0.651649182E+03 0.648000000E+05 421 0.100000000E+01 0.000000000E+00 0.995946751E+02 0.648000000E+05 422 0.105000000E+01 0.608173600E-07 0.810494149E+02 0.648000000E+05 423 0.110000000E+01 0.187131300E-07 0.633718456E+02 0.648000000E+05 424 0.115000000E+01 0.748522200E-07 0.464820497E+02 0.648000000E+05 425 0.120000000E+01 0.187130200E-07 0.303134217E+02 0.648000000E+05 426 0.125000000E+01 -.467825600E-07 0.148133076E+02 0.648000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.666000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.666000000E+05 121 0.250000000E+00 0.000000000E+00 0.915061734E+03 0.666000000E+05 122 0.300000000E+00 0.000000000E+00 0.845792610E+03 0.666000000E+05 123 0.350000000E+00 0.000000000E+00 0.787215199E+03 0.666000000E+05 124 0.400000000E+00 0.149011600E-07 0.736466901E+03 0.666000000E+05 125 0.450000000E+00 0.149011600E-07 0.691700167E+03 0.666000000E+05 126 0.500000000E+00 0.000000000E+00 0.651649677E+03 0.666000000E+05 421 0.100000000E+01 0.000000000E+00 0.995989445E+02 0.666000000E+05 422 0.105000000E+01 0.608173600E-07 0.810534331E+02 0.666000000E+05 423 0.110000000E+01 0.187131300E-07 0.633753602E+02 0.666000000E+05 424 0.115000000E+01 0.748522200E-07 0.464848522E+02 0.666000000E+05 425 0.120000000E+01 0.187130200E-07 0.303153583E+02 0.666000000E+05 426 0.125000000E+01 -.467825600E-07 0.148142867E+02 0.666000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.684000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.684000000E+05 121 0.250000000E+00 0.000000000E+00 0.915061876E+03 0.684000000E+05 122 0.300000000E+00 0.000000000E+00 0.845792858E+03 0.684000000E+05 123 0.350000000E+00 0.000000000E+00 0.787215520E+03 0.684000000E+05 124 0.400000000E+00 0.149011600E-07 0.736467266E+03 0.684000000E+05 125 0.450000000E+00 0.149011600E-07 0.691700544E+03 0.684000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650042E+03 0.684000000E+05 421 0.100000000E+01 0.000000000E+00 0.996021225E+02 0.684000000E+05 422 0.105000000E+01 0.608173600E-07 0.810564244E+02 0.684000000E+05 423 0.110000000E+01 0.187131300E-07 0.633779768E+02 0.684000000E+05 424 0.115000000E+01 0.748522200E-07 0.464869388E+02 0.684000000E+05 425 0.120000000E+01 0.187130200E-07 0.303168002E+02 0.684000000E+05 426 0.125000000E+01 -.467825600E-07 0.148150158E+02 0.684000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.702000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.702000000E+05 121 0.250000000E+00 0.000000000E+00 0.915061980E+03 0.702000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793041E+03 0.702000000E+05 123 0.350000000E+00 0.000000000E+00 0.787215757E+03 0.702000000E+05 124 0.400000000E+00 0.149011600E-07 0.736467534E+03 0.702000000E+05 125 0.450000000E+00 0.149011600E-07 0.691700823E+03 0.702000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650311E+03 0.702000000E+05 421 0.100000000E+01 0.000000000E+00 0.996044877E+02 0.702000000E+05 422 0.105000000E+01 0.608173600E-07 0.810586511E+02 0.702000000E+05 423 0.110000000E+01 0.187131300E-07 0.633799247E+02 0.702000000E+05 424 0.115000000E+01 0.748522200E-07 0.464884922E+02 0.702000000E+05 425 0.120000000E+01 0.187130200E-07 0.303178738E+02 0.702000000E+05 426 0.125000000E+01 -.467825600E-07 0.148155586E+02 0.702000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.720000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.720000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062057E+03 0.720000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793175E+03 0.720000000E+05 123 0.350000000E+00 0.000000000E+00 0.787215932E+03 0.720000000E+05 124 0.400000000E+00 0.149011600E-07 0.736467732E+03 0.720000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701029E+03 0.720000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650510E+03 0.720000000E+05 421 0.100000000E+01 0.000000000E+00 0.996062480E+02 0.720000000E+05 422 0.105000000E+01 0.608173600E-07 0.810603083E+02 0.720000000E+05 423 0.110000000E+01 0.187131300E-07 0.633813746E+02 0.720000000E+05 424 0.115000000E+01 0.748522200E-07 0.464896485E+02 0.720000000E+05 425 0.120000000E+01 0.187130200E-07 0.303186729E+02 0.720000000E+05 426 0.125000000E+01 -.467825600E-07 0.148159626E+02 0.720000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.738000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.738000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062113E+03 0.738000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793275E+03 0.738000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216061E+03 0.738000000E+05 124 0.400000000E+00 0.149011600E-07 0.736467879E+03 0.738000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701181E+03 0.738000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650658E+03 0.738000000E+05 421 0.100000000E+01 0.000000000E+00 0.996075579E+02 0.738000000E+05 422 0.105000000E+01 0.608173600E-07 0.810615415E+02 0.738000000E+05 423 0.110000000E+01 0.187131300E-07 0.633824536E+02 0.738000000E+05 424 0.115000000E+01 0.748522200E-07 0.464905091E+02 0.738000000E+05 425 0.120000000E+01 0.187130200E-07 0.303192676E+02 0.738000000E+05 426 0.125000000E+01 -.467825600E-07 0.148162634E+02 0.738000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.756000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.756000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062155E+03 0.756000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793348E+03 0.756000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216156E+03 0.756000000E+05 124 0.400000000E+00 0.149011600E-07 0.736467987E+03 0.756000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701294E+03 0.756000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650767E+03 0.756000000E+05 421 0.100000000E+01 0.000000000E+00 0.996085325E+02 0.756000000E+05 422 0.105000000E+01 0.608173600E-07 0.810624592E+02 0.756000000E+05 423 0.110000000E+01 0.187131300E-07 0.633832566E+02 0.756000000E+05 424 0.115000000E+01 0.748522200E-07 0.464911496E+02 0.756000000E+05 425 0.120000000E+01 0.187130200E-07 0.303197102E+02 0.756000000E+05 426 0.125000000E+01 -.467825600E-07 0.148164872E+02 0.756000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.774000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.774000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062186E+03 0.774000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793402E+03 0.774000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216227E+03 0.774000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468067E+03 0.774000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701377E+03 0.774000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650847E+03 0.774000000E+05 421 0.100000000E+01 0.000000000E+00 0.996092577E+02 0.774000000E+05 422 0.105000000E+01 0.608173600E-07 0.810631421E+02 0.774000000E+05 423 0.110000000E+01 0.187131300E-07 0.633838541E+02 0.774000000E+05 424 0.115000000E+01 0.748522200E-07 0.464916261E+02 0.774000000E+05 425 0.120000000E+01 0.187130200E-07 0.303200396E+02 0.774000000E+05 426 0.125000000E+01 -.467825600E-07 0.148166537E+02 0.774000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.792000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.792000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062209E+03 0.792000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793442E+03 0.792000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216279E+03 0.792000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468126E+03 0.792000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701439E+03 0.792000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650907E+03 0.792000000E+05 421 0.100000000E+01 0.000000000E+00 0.996097972E+02 0.792000000E+05 422 0.105000000E+01 0.608173600E-07 0.810636502E+02 0.792000000E+05 423 0.110000000E+01 0.187131300E-07 0.633842986E+02 0.792000000E+05 424 0.115000000E+01 0.748522200E-07 0.464919807E+02 0.792000000E+05 425 0.120000000E+01 0.187130200E-07 0.303202847E+02 0.792000000E+05 426 0.125000000E+01 -.467825600E-07 0.148167777E+02 0.792000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.810000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.810000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062226E+03 0.810000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793472E+03 0.810000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216318E+03 0.810000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468170E+03 0.810000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701484E+03 0.810000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650952E+03 0.810000000E+05 421 0.100000000E+01 0.000000000E+00 0.996101986E+02 0.810000000E+05 422 0.105000000E+01 0.608173600E-07 0.810640282E+02 0.810000000E+05 423 0.110000000E+01 0.187131300E-07 0.633846294E+02 0.810000000E+05 424 0.115000000E+01 0.748522200E-07 0.464922446E+02 0.810000000E+05 425 0.120000000E+01 0.187130200E-07 0.303204671E+02 0.810000000E+05 426 0.125000000E+01 -.467825600E-07 0.148168699E+02 0.810000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.828000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.828000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062239E+03 0.828000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793494E+03 0.828000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216346E+03 0.828000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468203E+03 0.828000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701518E+03 0.828000000E+05 126 0.500000000E+00 0.000000000E+00 0.651650985E+03 0.828000000E+05 421 0.100000000E+01 0.000000000E+00 0.996104972E+02 0.828000000E+05 422 0.105000000E+01 0.608173600E-07 0.810643094E+02 0.828000000E+05 423 0.110000000E+01 0.187131300E-07 0.633848755E+02 0.828000000E+05 424 0.115000000E+01 0.748522200E-07 0.464924409E+02 0.828000000E+05 425 0.120000000E+01 0.187130200E-07 0.303206027E+02 0.828000000E+05 426 0.125000000E+01 -.467825600E-07 0.148169385E+02 0.828000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.846000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.846000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062248E+03 0.846000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793511E+03 0.846000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216367E+03 0.846000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468227E+03 0.846000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701543E+03 0.846000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651009E+03 0.846000000E+05 421 0.100000000E+01 0.000000000E+00 0.996107194E+02 0.846000000E+05 422 0.105000000E+01 0.608173600E-07 0.810645186E+02 0.846000000E+05 423 0.110000000E+01 0.187131300E-07 0.633850586E+02 0.846000000E+05 424 0.115000000E+01 0.748522200E-07 0.464925869E+02 0.846000000E+05 425 0.120000000E+01 0.187130200E-07 0.303207037E+02 0.846000000E+05 426 0.125000000E+01 -.467825600E-07 0.148169895E+02 0.846000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.864000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.864000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062255E+03 0.864000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793523E+03 0.864000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216383E+03 0.864000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468245E+03 0.864000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701562E+03 0.864000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651027E+03 0.864000000E+05 421 0.100000000E+01 0.000000000E+00 0.996108846E+02 0.864000000E+05 422 0.105000000E+01 0.608173600E-07 0.810646742E+02 0.864000000E+05 423 0.110000000E+01 0.187131300E-07 0.633851947E+02 0.864000000E+05 424 0.115000000E+01 0.748522200E-07 0.464926955E+02 0.864000000E+05 425 0.120000000E+01 0.187130200E-07 0.303207788E+02 0.864000000E+05 426 0.125000000E+01 -.467825600E-07 0.148170275E+02 0.864000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.882000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.882000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062260E+03 0.882000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793532E+03 0.882000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216395E+03 0.882000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468258E+03 0.882000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701576E+03 0.882000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651041E+03 0.882000000E+05 421 0.100000000E+01 0.000000000E+00 0.996110075E+02 0.882000000E+05 422 0.105000000E+01 0.608173600E-07 0.810647900E+02 0.882000000E+05 423 0.110000000E+01 0.187131300E-07 0.633852961E+02 0.882000000E+05 424 0.115000000E+01 0.748522200E-07 0.464927763E+02 0.882000000E+05 425 0.120000000E+01 0.187130200E-07 0.303208346E+02 0.882000000E+05 426 0.125000000E+01 -.467825600E-07 0.148170557E+02 0.882000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.900000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.900000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062264E+03 0.900000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793538E+03 0.900000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216404E+03 0.900000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468268E+03 0.900000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701586E+03 0.900000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651051E+03 0.900000000E+05 421 0.100000000E+01 0.000000000E+00 0.996110990E+02 0.900000000E+05 422 0.105000000E+01 0.608173600E-07 0.810648761E+02 0.900000000E+05 423 0.110000000E+01 0.187131300E-07 0.633853714E+02 0.900000000E+05 424 0.115000000E+01 0.748522200E-07 0.464928365E+02 0.900000000E+05 425 0.120000000E+01 0.187130200E-07 0.303208762E+02 0.900000000E+05 426 0.125000000E+01 -.467825600E-07 0.148170767E+02 0.900000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.918000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.918000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062267E+03 0.918000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793543E+03 0.918000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216410E+03 0.918000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468275E+03 0.918000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701594E+03 0.918000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651058E+03 0.918000000E+05 421 0.100000000E+01 0.000000000E+00 0.996111670E+02 0.918000000E+05 422 0.105000000E+01 0.608173600E-07 0.810649401E+02 0.918000000E+05 423 0.110000000E+01 0.187131300E-07 0.633854275E+02 0.918000000E+05 424 0.115000000E+01 0.748522200E-07 0.464928812E+02 0.918000000E+05 425 0.120000000E+01 0.187130200E-07 0.303209071E+02 0.918000000E+05 426 0.125000000E+01 -.467825600E-07 0.148170924E+02 0.918000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.936000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.936000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062269E+03 0.936000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793547E+03 0.936000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216415E+03 0.936000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468281E+03 0.936000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701599E+03 0.936000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651064E+03 0.936000000E+05 421 0.100000000E+01 0.000000000E+00 0.996112176E+02 0.936000000E+05 422 0.105000000E+01 0.608173600E-07 0.810649878E+02 0.936000000E+05 423 0.110000000E+01 0.187131300E-07 0.633854692E+02 0.936000000E+05 424 0.115000000E+01 0.748522200E-07 0.464929144E+02 0.936000000E+05 425 0.120000000E+01 0.187130200E-07 0.303209301E+02 0.936000000E+05 426 0.125000000E+01 -.467825600E-07 0.148171040E+02 0.936000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.954000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.954000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062270E+03 0.954000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793550E+03 0.954000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216418E+03 0.954000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468285E+03 0.954000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701604E+03 0.954000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651068E+03 0.954000000E+05 421 0.100000000E+01 0.000000000E+00 0.996112552E+02 0.954000000E+05 422 0.105000000E+01 0.608173600E-07 0.810650232E+02 0.954000000E+05 423 0.110000000E+01 0.187131300E-07 0.633855002E+02 0.954000000E+05 424 0.115000000E+01 0.748522200E-07 0.464929392E+02 0.954000000E+05 425 0.120000000E+01 0.187130200E-07 0.303209472E+02 0.954000000E+05 426 0.125000000E+01 -.467825600E-07 0.148171126E+02 0.954000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.972000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.972000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062272E+03 0.972000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793552E+03 0.972000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216421E+03 0.972000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468288E+03 0.972000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701607E+03 0.972000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651071E+03 0.972000000E+05 421 0.100000000E+01 0.000000000E+00 0.996112832E+02 0.972000000E+05 422 0.105000000E+01 0.608173600E-07 0.810650496E+02 0.972000000E+05 423 0.110000000E+01 0.187131300E-07 0.633855233E+02 0.972000000E+05 424 0.115000000E+01 0.748522200E-07 0.464929576E+02 0.972000000E+05 425 0.120000000E+01 0.187130200E-07 0.303209599E+02 0.972000000E+05 426 0.125000000E+01 -.467825600E-07 0.148171191E+02 0.972000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.990000000E+05 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.990000000E+05 121 0.250000000E+00 0.000000000E+00 0.915062273E+03 0.990000000E+05 122 0.300000000E+00 0.000000000E+00 0.845793553E+03 0.990000000E+05 123 0.350000000E+00 0.000000000E+00 0.787216423E+03 0.990000000E+05 124 0.400000000E+00 0.149011600E-07 0.736468290E+03 0.990000000E+05 125 0.450000000E+00 0.149011600E-07 0.691701609E+03 0.990000000E+05 126 0.500000000E+00 0.000000000E+00 0.651651073E+03 0.990000000E+05 421 0.100000000E+01 0.000000000E+00 0.996113040E+02 0.990000000E+05 422 0.105000000E+01 0.608173600E-07 0.810650692E+02 0.990000000E+05 423 0.110000000E+01 0.187131300E-07 0.633855404E+02 0.990000000E+05 424 0.115000000E+01 0.748522200E-07 0.464929713E+02 0.990000000E+05 425 0.120000000E+01 0.187130200E-07 0.303209694E+02 0.990000000E+05 426 0.125000000E+01 -.467825600E-07 0.148171239E+02 0.990000000E+05 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.100800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.100800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062273E+03 0.100800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793554E+03 0.100800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216425E+03 0.100800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468292E+03 0.100800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701611E+03 0.100800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651075E+03 0.100800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113195E+02 0.100800000E+06 422 0.105000000E+01 0.608173600E-07 0.810650838E+02 0.100800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855532E+02 0.100800000E+06 424 0.115000000E+01 0.748522200E-07 0.464929815E+02 0.100800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209764E+02 0.100800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171274E+02 0.100800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.102600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.102600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062274E+03 0.102600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793555E+03 0.102600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216426E+03 0.102600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468293E+03 0.102600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701612E+03 0.102600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651076E+03 0.102600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113310E+02 0.102600000E+06 422 0.105000000E+01 0.608173600E-07 0.810650946E+02 0.102600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855627E+02 0.102600000E+06 424 0.115000000E+01 0.748522200E-07 0.464929890E+02 0.102600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209816E+02 0.102600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171301E+02 0.102600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.104400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.104400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062274E+03 0.104400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793556E+03 0.104400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216426E+03 0.104400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468294E+03 0.104400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701613E+03 0.104400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651077E+03 0.104400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113396E+02 0.104400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651027E+02 0.104400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855697E+02 0.104400000E+06 424 0.115000000E+01 0.748522200E-07 0.464929947E+02 0.104400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209855E+02 0.104400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171320E+02 0.104400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.106200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.106200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062274E+03 0.106200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793556E+03 0.106200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216427E+03 0.106200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468294E+03 0.106200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701614E+03 0.106200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651077E+03 0.106200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113459E+02 0.106200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651087E+02 0.106200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855750E+02 0.106200000E+06 424 0.115000000E+01 0.748522200E-07 0.464929989E+02 0.106200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209884E+02 0.106200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171335E+02 0.106200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.108000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.108000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062274E+03 0.108000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.108000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216427E+03 0.108000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468295E+03 0.108000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701614E+03 0.108000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651078E+03 0.108000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113507E+02 0.108000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651132E+02 0.108000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855789E+02 0.108000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930020E+02 0.108000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209906E+02 0.108000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171346E+02 0.108000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.109800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.109800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.109800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.109800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.109800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468295E+03 0.109800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701615E+03 0.109800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651078E+03 0.109800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113542E+02 0.109800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651165E+02 0.109800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855818E+02 0.109800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930043E+02 0.109800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209922E+02 0.109800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171354E+02 0.109800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.111600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.111600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.111600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.111600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.111600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468295E+03 0.111600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701615E+03 0.111600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.111600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113568E+02 0.111600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651189E+02 0.111600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855840E+02 0.111600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930060E+02 0.111600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209934E+02 0.111600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171360E+02 0.111600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.113400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.113400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.113400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.113400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.113400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.113400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701615E+03 0.113400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.113400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113588E+02 0.113400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651208E+02 0.113400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855856E+02 0.113400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930073E+02 0.113400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209943E+02 0.113400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171365E+02 0.113400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.115200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.115200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.115200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.115200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.115200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.115200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701615E+03 0.115200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.115200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113602E+02 0.115200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651221E+02 0.115200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855868E+02 0.115200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930083E+02 0.115200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209949E+02 0.115200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171368E+02 0.115200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.117000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.117000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.117000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.117000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.117000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.117000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701615E+03 0.117000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.117000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113613E+02 0.117000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651232E+02 0.117000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855877E+02 0.117000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930090E+02 0.117000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209954E+02 0.117000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171370E+02 0.117000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.118800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.118800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.118800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.118800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.118800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.118800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.118800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.118800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113621E+02 0.118800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651239E+02 0.118800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855883E+02 0.118800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930095E+02 0.118800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209958E+02 0.118800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171372E+02 0.118800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.120600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.120600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.120600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.120600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216428E+03 0.120600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.120600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.120600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.120600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113627E+02 0.120600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651245E+02 0.120600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855888E+02 0.120600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930099E+02 0.120600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209960E+02 0.120600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171373E+02 0.120600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.122400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.122400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.122400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.122400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.122400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.122400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.122400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.122400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113631E+02 0.122400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651249E+02 0.122400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855892E+02 0.122400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930102E+02 0.122400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209962E+02 0.122400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171374E+02 0.122400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.124200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.124200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.124200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.124200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.124200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.124200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.124200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.124200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113635E+02 0.124200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651252E+02 0.124200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855894E+02 0.124200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930104E+02 0.124200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209964E+02 0.124200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171375E+02 0.124200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.126000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.126000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.126000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793557E+03 0.126000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.126000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.126000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.126000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.126000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113637E+02 0.126000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651254E+02 0.126000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855896E+02 0.126000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930105E+02 0.126000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209965E+02 0.126000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171376E+02 0.126000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.127800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.127800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.127800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.127800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.127800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.127800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.127800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.127800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113639E+02 0.127800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651256E+02 0.127800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855898E+02 0.127800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930107E+02 0.127800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209966E+02 0.127800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171376E+02 0.127800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.129600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.129600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.129600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.129600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.129600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.129600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.129600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.129600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113640E+02 0.129600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651257E+02 0.129600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855899E+02 0.129600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930108E+02 0.129600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209966E+02 0.129600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171376E+02 0.129600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.131400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.131400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.131400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.131400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.131400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.131400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.131400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.131400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113641E+02 0.131400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651258E+02 0.131400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.131400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930108E+02 0.131400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.131400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.131400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.133200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.133200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.133200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.133200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.133200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.133200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.133200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.133200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.133200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.133200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.133200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.133200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.133200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.133200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.135000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.135000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.135000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.135000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.135000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.135000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.135000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.135000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.135000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.135000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.135000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.135000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.135000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.135000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.136800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.136800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.136800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.136800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.136800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.136800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.136800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.136800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.136800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.136800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.136800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.136800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.136800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.136800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.138600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.138600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.138600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.138600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.138600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.138600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.138600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.138600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.138600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.138600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.138600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.138600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.138600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.138600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.140400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.140400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.140400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.140400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.140400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.140400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.140400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.140400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.140400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.140400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.140400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.140400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.140400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.140400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.142200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.142200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.142200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.142200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.142200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.142200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.142200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.142200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.142200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.142200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.142200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.142200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.142200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.142200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.144000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.144000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.144000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.144000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.144000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.144000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.144000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.144000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.144000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.144000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.144000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.144000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.144000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.144000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.145800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.145800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.145800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.145800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.145800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.145800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.145800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.145800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.145800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.145800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.145800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.145800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.145800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.145800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.147600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.147600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.147600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.147600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.147600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.147600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.147600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.147600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.147600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.147600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.147600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.147600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.147600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.147600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.149400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.149400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.149400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.149400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.149400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.149400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.149400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.149400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.149400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.149400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.149400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.149400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.149400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.149400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.151200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.151200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.151200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.151200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.151200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.151200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.151200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.151200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.151200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.151200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.151200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.151200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.151200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.151200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.153000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.153000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.153000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.153000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.153000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.153000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.153000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.153000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.153000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.153000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.153000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.153000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.153000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.153000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.154800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.154800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.154800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.154800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.154800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.154800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.154800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.154800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.154800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.154800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.154800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.154800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.154800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.154800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.156600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.156600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.156600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.156600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.156600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.156600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.156600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.156600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.156600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.156600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.156600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.156600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.156600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.156600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.158400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.158400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.158400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.158400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.158400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.158400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.158400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.158400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.158400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.158400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.158400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.158400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.158400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.158400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.160200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.160200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.160200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.160200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.160200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.160200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.160200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.160200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.160200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.160200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.160200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.160200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.160200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.160200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.162000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.162000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.162000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.162000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.162000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.162000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.162000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.162000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.162000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.162000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.162000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.162000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.162000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.162000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.163800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.163800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.163800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.163800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.163800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.163800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.163800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.163800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.163800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.163800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.163800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.163800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.163800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.163800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.165600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.165600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.165600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.165600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.165600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.165600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.165600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.165600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.165600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.165600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.165600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.165600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.165600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.165600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.167400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.167400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.167400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.167400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.167400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.167400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.167400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.167400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.167400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.167400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.167400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.167400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.167400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.167400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.169200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.169200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.169200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.169200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.169200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.169200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.169200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.169200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.169200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.169200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.169200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.169200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.169200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.169200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.171000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.171000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.171000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.171000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.171000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.171000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.171000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.171000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.171000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.171000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.171000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.171000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.171000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.171000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.172800000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.172800000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.172800000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.172800000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.172800000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.172800000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.172800000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.172800000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.172800000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.172800000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.172800000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.172800000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.172800000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.172800000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.174600000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.174600000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.174600000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.174600000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.174600000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.174600000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.174600000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.174600000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.174600000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.174600000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.174600000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.174600000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.174600000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.174600000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.176400000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.176400000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.176400000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.176400000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.176400000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.176400000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.176400000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.176400000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.176400000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.176400000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.176400000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.176400000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.176400000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.176400000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.178200000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.178200000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.178200000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.178200000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.178200000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.178200000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.178200000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.178200000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.178200000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.178200000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.178200000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.178200000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.178200000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.178200000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 0.180000000E+06 120 0.200000000E+00 0.000000000E+00 0.100000000E+04 0.180000000E+06 121 0.250000000E+00 0.000000000E+00 0.915062275E+03 0.180000000E+06 122 0.300000000E+00 0.000000000E+00 0.845793558E+03 0.180000000E+06 123 0.350000000E+00 0.000000000E+00 0.787216429E+03 0.180000000E+06 124 0.400000000E+00 0.149011600E-07 0.736468296E+03 0.180000000E+06 125 0.450000000E+00 0.149011600E-07 0.691701616E+03 0.180000000E+06 126 0.500000000E+00 0.000000000E+00 0.651651079E+03 0.180000000E+06 421 0.100000000E+01 0.000000000E+00 0.996113642E+02 0.180000000E+06 422 0.105000000E+01 0.608173600E-07 0.810651259E+02 0.180000000E+06 423 0.110000000E+01 0.187131300E-07 0.633855900E+02 0.180000000E+06 424 0.115000000E+01 0.748522200E-07 0.464930109E+02 0.180000000E+06 425 0.120000000E+01 0.187130200E-07 0.303209967E+02 0.180000000E+06 426 0.125000000E+01 -.467825600E-07 0.148171377E+02 0.180000000E+06 427 0.130000000E+01 0.000000000E+00 0.000000000E+00 syrthes-3.4.3-dfsg1/example/cylinder/RESU/resus10000666000175000017500000007176611524070640020117 0ustar pinipini************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 100 0.1800000000000E+06 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+030.6917027E+03 0.6516524E+030.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+03 0.6917026E+030.6516524E+030.1000000E+040.9150624E+030.8457939E+030.7872170E+03 0.7364689E+030.6917024E+030.6516521E+030.1000000E+040.9150624E+030.8457939E+03 0.7872169E+030.7364687E+030.6917022E+030.6516516E+030.1000000E+040.9150621E+03 0.8457938E+030.7872166E+030.7364685E+030.6917017E+030.6516510E+030.1000000E+04 0.9150623E+030.8457937E+030.7872165E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457936E+030.7872164E+030.7364680E+030.6917010E+03 0.6516500E+030.1000000E+040.9150622E+030.8457936E+030.7872163E+030.7364678E+03 0.6917007E+030.6516494E+030.1000000E+040.9150621E+030.8457935E+030.7872161E+03 0.7364677E+030.6917005E+030.6516492E+030.1000000E+040.9150622E+030.8457934E+03 0.7872161E+030.7364676E+030.6917004E+030.6516490E+030.1000000E+040.9150621E+03 0.8457934E+030.7872161E+030.7364676E+030.6917004E+030.6516491E+030.1000000E+04 0.9150620E+030.8457934E+030.7872161E+030.7364677E+030.6917005E+030.6516493E+03 0.1000000E+040.9150621E+030.8457935E+030.7872161E+030.7364678E+030.6917007E+03 0.6516497E+030.1000000E+040.9150621E+030.8457935E+030.7872162E+030.7364679E+03 0.6917010E+030.6516501E+030.1000000E+040.9150622E+030.8457935E+030.7872163E+03 0.7364680E+030.6917012E+030.6516504E+030.1000000E+040.9150621E+030.8457935E+03 0.7872164E+030.7364682E+030.6917014E+030.6516508E+030.1000000E+040.9150622E+03 0.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+030.1000000E+04 0.9150623E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+03 0.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+03 0.6516510E+030.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364682E+03 0.6917014E+030.6516508E+030.1000000E+040.9150621E+030.8457935E+030.7872163E+03 0.7364681E+030.6917012E+030.6516505E+030.1000000E+040.9150620E+030.8457935E+03 0.7872161E+030.7364679E+030.6917010E+030.6516500E+030.1000000E+040.9150622E+03 0.8457935E+030.7872161E+030.7364678E+030.6917008E+030.6516497E+030.1000000E+04 0.9150622E+030.8457934E+030.7872161E+030.7364676E+030.6917005E+030.6516494E+03 0.1000000E+040.9150621E+030.8457934E+030.7872161E+030.7364676E+030.6917004E+03 0.6516491E+030.1000000E+040.9150621E+030.8457934E+030.7872160E+030.7364676E+03 0.6917004E+030.6516490E+030.1000000E+040.9150622E+030.8457934E+030.7872162E+03 0.7364677E+030.6917005E+030.6516491E+030.1000000E+040.9150621E+030.8457935E+03 0.7872162E+030.7364678E+030.6917007E+030.6516495E+030.1000000E+040.9150622E+03 0.8457936E+030.7872163E+030.7364680E+030.6917010E+030.6516499E+030.1000000E+04 0.9150623E+030.8457937E+030.7872164E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457938E+030.7872167E+030.7364685E+030.6917017E+03 0.6516510E+030.1000000E+040.9150624E+030.8457939E+030.7872168E+030.7364687E+03 0.6917021E+030.6516515E+030.1000000E+040.9150623E+030.8457939E+030.7872169E+03 0.7364689E+030.6917024E+030.6516520E+030.1000000E+040.9150624E+030.8457940E+03 0.7872170E+030.7364691E+030.6917026E+030.6516524E+030.1000000E+040.9150625E+03 0.8457939E+030.7872170E+030.7364691E+030.6917027E+030.6516524E+030.9964557E+02 0.8108990E+020.6340348E+020.4650543E+020.3032881E+020.1482090E+020.0000000E+00 0.9964096E+020.8108691E+020.6340140E+020.4650412E+020.3032800E+020.1482048E+02 0.0000000E+000.9962879E+020.8107868E+020.6339575E+020.4650023E+020.3032549E+02 0.1481944E+020.0000000E+000.9961325E+020.8106713E+020.6338748E+020.4649473E+02 0.3032189E+020.1481753E+020.0000000E+000.9959518E+020.8105377E+020.6337770E+02 0.4648768E+020.3031769E+020.1481548E+020.0000000E+000.9957703E+020.8103982E+02 0.6336717E+020.4648027E+020.3031294E+020.1481309E+020.0000000E+000.9955944E+02 0.8102596E+020.6335672E+020.4647296E+020.3030827E+020.1481077E+020.0000000E+00 0.9954278E+020.8101295E+020.6334687E+020.4646583E+020.3030367E+020.1480865E+02 0.0000000E+000.9952776E+020.8100110E+020.6333776E+020.4645916E+020.3029954E+02 0.1480678E+020.0000000E+000.9951483E+020.8099079E+020.6332987E+020.4645359E+02 0.3029587E+020.1480490E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644891E+020.3029283E+020.1480343E+020.0000000E+000.9949564E+020.8097573E+02 0.6331846E+020.4644539E+020.3029054E+020.1480235E+020.0000000E+000.9949037E+02 0.8097165E+020.6331537E+020.4644320E+020.3028916E+020.1480166E+020.0000000E+00 0.9948817E+020.8097012E+020.6331433E+020.4644254E+020.3028874E+020.1480149E+02 0.0000000E+000.9948947E+020.8097146E+020.6331549E+020.4644342E+020.3028935E+02 0.1480174E+020.0000000E+000.9949497E+020.8097603E+020.6331905E+020.4644600E+02 0.3029100E+020.1480261E+020.0000000E+000.9950502E+020.8098394E+020.6332501E+02 0.4645025E+020.3029380E+020.1480386E+020.0000000E+000.9951971E+020.8099494E+02 0.6333315E+020.4645593E+020.3029740E+020.1480574E+020.0000000E+000.9953760E+02 0.8100801E+020.6334265E+020.4646261E+020.3030160E+020.1480756E+020.0000000E+00 0.9955574E+020.8102149E+020.6335252E+020.4646951E+020.3030584E+020.1480956E+02 0.0000000E+000.9957202E+020.8103405E+020.6336191E+020.4647608E+020.3031000E+02 0.1481161E+020.0000000E+000.9958601E+020.8104503E+020.6337020E+020.4648185E+02 0.3031376E+020.1481352E+020.0000000E+000.9959735E+020.8105374E+020.6337679E+02 0.4648683E+020.3031677E+020.1481503E+020.0000000E+000.9960480E+020.8106003E+02 0.6338165E+020.4649016E+020.3031906E+020.1481628E+020.0000000E+000.9960977E+02 0.8106385E+020.6338457E+020.4649233E+020.3032052E+020.1481692E+020.0000000E+00 0.9961136E+020.8106513E+020.6338559E+020.4649301E+020.3032100E+020.1481714E+02 0.0000000E+000.9960976E+020.8106385E+020.6338457E+020.4649235E+020.3032055E+02 0.1481690E+020.0000000E+000.9960480E+020.8106000E+020.6338165E+020.4649015E+02 0.3031904E+020.1481631E+020.0000000E+000.9959733E+020.8105370E+020.6337681E+02 0.4648685E+020.3031672E+020.1481501E+020.0000000E+000.9958599E+020.8104497E+02 0.6337017E+020.4648186E+020.3031380E+020.1481355E+020.0000000E+000.9957206E+02 0.8103412E+020.6336189E+020.4647603E+020.3031002E+020.1481163E+020.0000000E+00 0.9955579E+020.8102151E+020.6335251E+020.4646953E+020.3030591E+020.1480959E+02 0.0000000E+000.9953762E+020.8100802E+020.6334268E+020.4646261E+020.3030147E+02 0.1480751E+020.0000000E+000.9951966E+020.8099494E+020.6333314E+020.4645582E+02 0.3029736E+020.1480575E+020.0000000E+000.9950500E+020.8098391E+020.6332502E+02 0.4645025E+020.3029380E+020.1480390E+020.0000000E+000.9949497E+020.8097601E+02 0.6331905E+020.4644599E+020.3029104E+020.1480258E+020.0000000E+000.9948942E+02 0.8097146E+020.6331548E+020.4644342E+020.3028934E+020.1480177E+020.0000000E+00 0.9948818E+020.8097013E+020.6331430E+020.4644253E+020.3028873E+020.1480146E+02 0.0000000E+000.9949034E+020.8097166E+020.6331538E+020.4644324E+020.3028916E+02 0.1480168E+020.0000000E+000.9949570E+020.8097578E+020.6331845E+020.4644539E+02 0.3029056E+020.1480230E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644890E+020.3029279E+020.1480346E+020.0000000E+000.9951486E+020.8099078E+02 0.6332988E+020.4645356E+020.3029587E+020.1480486E+020.0000000E+000.9952776E+02 0.8100107E+020.6333778E+020.4645926E+020.3029955E+020.1480679E+020.0000000E+00 0.9954277E+020.8101291E+020.6334680E+020.4646581E+020.3030378E+020.1480865E+02 0.0000000E+000.9955940E+020.8102594E+020.6335672E+020.4647295E+020.3030821E+02 0.1481076E+020.0000000E+000.9957700E+020.8103974E+020.6336717E+020.4648032E+02 0.3031292E+020.1481308E+020.0000000E+000.9959525E+020.8105383E+020.6337772E+02 0.4648765E+020.3031765E+020.1481545E+020.0000000E+000.9961322E+020.8106717E+02 0.6338747E+020.4649472E+020.3032192E+020.1481756E+020.0000000E+000.9962877E+02 0.8107870E+020.6339575E+020.4650023E+020.3032552E+020.1481941E+020.0000000E+00 0.9964097E+020.8108689E+020.6340139E+020.4650410E+020.3032796E+020.1482051E+02 0.0000000E+000.9964557E+020.8108991E+020.6340345E+020.4650541E+020.3032882E+02 0.1482090E+020.0000000E+000.9554770E+030.9550919E+030.1000000E+040.9550920E+03 0.9154679E+030.8788551E+030.8792583E+030.8461998E+030.8788551E+030.8153799E+03 0.8157839E+030.7876227E+030.8153799E+030.7609979E+030.7614023E+030.7368747E+03 0.7609979E+030.7134280E+030.7138327E+030.6921083E+030.7134280E+030.6711521E+03 0.6715578E+030.6520642E+030.6711521E+030.9554770E+030.1000000E+040.9154678E+03 0.9550919E+030.8792583E+030.8461997E+030.8788550E+030.8157838E+030.7876227E+03 0.8153798E+030.7614022E+030.7368746E+030.7609978E+030.7138326E+030.6921082E+03 0.7134278E+030.6715577E+030.6520640E+030.6711518E+030.9554771E+030.1000000E+04 0.9154678E+030.9550919E+030.8792582E+030.8461997E+030.8788551E+030.8157838E+03 0.7876226E+030.8153798E+030.7614021E+030.7368744E+030.7609976E+030.7138324E+03 0.6921080E+030.7134276E+030.6715574E+030.6520637E+030.6711514E+030.9554771E+03 0.1000000E+040.9154677E+030.9550918E+030.8792582E+030.8461996E+030.8788549E+03 0.8157837E+030.7876224E+030.8153796E+030.7614019E+030.7368742E+030.7609975E+03 0.7138321E+030.6921076E+030.7134273E+030.6715569E+030.6520631E+030.6711510E+03 0.9554769E+030.1000000E+040.9154676E+030.9550919E+030.8792582E+030.8461995E+03 0.8788550E+030.8157836E+030.7876222E+030.8153795E+030.7614018E+030.7368739E+03 0.7609972E+030.7138318E+030.6921071E+030.7134270E+030.6715564E+030.6520624E+03 0.6711505E+030.9554770E+030.1000000E+040.9154677E+030.9550919E+030.8792582E+03 0.8461995E+030.8788550E+030.8157835E+030.7876221E+030.8153794E+030.7614015E+03 0.7368737E+030.7609970E+030.7138315E+030.6921068E+030.7134266E+030.6715560E+03 0.6520620E+030.6711500E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792582E+030.8461994E+030.8788550E+030.8157833E+030.7876220E+030.8153792E+03 0.7614014E+030.7368735E+030.7609969E+030.7138312E+030.6921065E+030.7134264E+03 0.6715556E+030.6520615E+030.6711496E+030.9554769E+030.1000000E+040.9154676E+03 0.9550917E+030.8792581E+030.8461993E+030.8788548E+030.8157832E+030.7876219E+03 0.8153792E+030.7614012E+030.7368733E+030.7609968E+030.7138310E+030.6921062E+03 0.7134262E+030.6715553E+030.6520611E+030.6711494E+030.9554768E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157832E+03 0.7876217E+030.8153792E+030.7614012E+030.7368732E+030.7609967E+030.7138309E+03 0.6921061E+030.7134262E+030.6715551E+030.6520608E+030.6711492E+030.9554769E+03 0.1000000E+040.9154676E+030.9550917E+030.8792579E+030.8461992E+030.8788548E+03 0.8157832E+030.7876217E+030.8153792E+030.7614011E+030.7368732E+030.7609967E+03 0.7138308E+030.6921060E+030.7134262E+030.6715550E+030.6520608E+030.6711493E+03 0.9554768E+030.1000000E+040.9154675E+030.9550916E+030.8792580E+030.8461992E+03 0.8788547E+030.8157832E+030.7876217E+030.8153791E+030.7614011E+030.7368732E+03 0.7609968E+030.7138309E+030.6921061E+030.7134262E+030.6715551E+030.6520609E+03 0.6711495E+030.9554766E+030.1000000E+040.9154675E+030.9550915E+030.8792580E+03 0.8461993E+030.8788548E+030.8157831E+030.7876218E+030.8153792E+030.7614013E+03 0.7368733E+030.7609968E+030.7138310E+030.6921062E+030.7134264E+030.6715553E+03 0.6520613E+030.6711498E+030.9554768E+030.1000000E+040.9154676E+030.9550916E+03 0.8792580E+030.8461993E+030.8788547E+030.8157832E+030.7876218E+030.8153792E+03 0.7614013E+030.7368734E+030.7609969E+030.7138312E+030.6921064E+030.7134266E+03 0.6715557E+030.6520616E+030.6711501E+030.9554768E+030.1000000E+040.9154676E+03 0.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+030.7876219E+03 0.8153794E+030.7614014E+030.7368735E+030.7609970E+030.7138314E+030.6921067E+03 0.7134268E+030.6715560E+030.6520621E+030.6711504E+030.9554769E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876220E+030.8153793E+030.7614014E+030.7368737E+030.7609971E+030.7138316E+03 0.6921070E+030.7134269E+030.6715562E+030.6520624E+030.6711507E+030.9554768E+03 0.1000000E+040.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788548E+03 0.8157834E+030.7876221E+030.8153794E+030.7614015E+030.7368738E+030.7609971E+03 0.7138317E+030.6921071E+030.7134271E+030.6715565E+030.6520627E+030.6711509E+03 0.9554769E+030.1000000E+040.9154677E+030.9550918E+030.8792581E+030.8461994E+03 0.8788548E+030.8157833E+030.7876221E+030.8153794E+030.7614016E+030.7368739E+03 0.7609972E+030.7138317E+030.6921072E+030.7134271E+030.6715567E+030.6520629E+03 0.6711509E+030.9554770E+030.1000000E+040.9154677E+030.9550918E+030.8792580E+03 0.8461994E+030.8788548E+030.8157834E+030.7876221E+030.8153794E+030.7614015E+03 0.7368739E+030.7609972E+030.7138318E+030.6921072E+030.7134271E+030.6715566E+03 0.6520629E+030.6711509E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792580E+030.8461995E+030.8788548E+030.8157834E+030.7876220E+030.8153794E+03 0.7614015E+030.7368739E+030.7609971E+030.7138317E+030.6921071E+030.7134270E+03 0.6715565E+030.6520627E+030.6711507E+030.9554769E+030.1000000E+040.9154676E+03 0.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157833E+030.7876220E+03 0.8153794E+030.7614014E+030.7368737E+030.7609970E+030.7138315E+030.6921069E+03 0.7134268E+030.6715563E+030.6520624E+030.6711504E+030.9554770E+030.1000000E+04 0.9154675E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876218E+030.8153792E+030.7614013E+030.7368736E+030.7609968E+030.7138313E+03 0.6921067E+030.7134266E+030.6715560E+030.6520621E+030.6711501E+030.9554768E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876218E+030.8153792E+030.7614012E+030.7368734E+030.7609967E+03 0.7138312E+030.6921065E+030.7134264E+030.6715556E+030.6520616E+030.6711498E+03 0.9554769E+030.1000000E+040.9154675E+030.9550919E+030.8792581E+030.8461992E+03 0.8788548E+030.8157831E+030.7876218E+030.8153791E+030.7614011E+030.7368733E+03 0.7609966E+030.7138311E+030.6921062E+030.7134262E+030.6715553E+030.6520613E+03 0.6711495E+030.9554768E+030.1000000E+040.9154675E+030.9550917E+030.8792580E+03 0.8461993E+030.8788547E+030.8157831E+030.7876218E+030.8153791E+030.7614010E+03 0.7368732E+030.7609966E+030.7138309E+030.6921061E+030.7134262E+030.6715552E+03 0.6520610E+030.6711493E+030.9554769E+030.1000000E+040.9154675E+030.9550917E+03 0.8792580E+030.8461992E+030.8788547E+030.8157832E+030.7876217E+030.8153791E+03 0.7614010E+030.7368732E+030.7609966E+030.7138309E+030.6921060E+030.7134262E+03 0.6715550E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+040.9154675E+03 0.9550917E+030.8792580E+030.8461992E+030.8788547E+030.8157831E+030.7876217E+03 0.8153792E+030.7614010E+030.7368732E+030.7609967E+030.7138309E+030.6921061E+03 0.7134263E+030.6715551E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+04 0.9154676E+030.9550916E+030.8792579E+030.8461993E+030.8788548E+030.8157833E+03 0.7876219E+030.8153793E+030.7614011E+030.7368733E+030.7609968E+030.7138310E+03 0.6921062E+030.7134264E+030.6715552E+030.6520611E+030.6711497E+030.9554766E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876219E+030.8153794E+030.7614013E+030.7368734E+030.7609970E+03 0.7138312E+030.6921064E+030.7134266E+030.6715555E+030.6520614E+030.6711500E+03 0.9554767E+030.1000000E+040.9154676E+030.9550918E+030.8792582E+030.8461995E+03 0.8788550E+030.8157834E+030.7876220E+030.8153795E+030.7614016E+030.7368737E+03 0.7609972E+030.7138315E+030.6921068E+030.7134269E+030.6715559E+030.6520620E+03 0.6711504E+030.9554769E+030.1000000E+040.9154678E+030.9550917E+030.8792582E+03 0.8461995E+030.8788549E+030.8157836E+030.7876222E+030.8153796E+030.7614017E+03 0.7368739E+030.7609974E+030.7138318E+030.6921071E+030.7134273E+030.6715564E+03 0.6520624E+030.6711510E+030.9554769E+030.1000000E+040.9154678E+030.9550918E+03 0.8792583E+030.8461996E+030.8788551E+030.8157837E+030.7876224E+030.8153798E+03 0.7614018E+030.7368742E+030.7609975E+030.7138321E+030.6921076E+030.7134275E+03 0.6715569E+030.6520631E+030.6711514E+030.9554770E+030.1000000E+040.9154678E+03 0.9550918E+030.8792582E+030.8461997E+030.8788550E+030.8157837E+030.7876225E+03 0.8153798E+030.7614020E+030.7368744E+030.7609977E+030.7138324E+030.6921079E+03 0.7134278E+030.6715573E+030.6520636E+030.6711518E+030.9554769E+030.1000000E+04 0.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788550E+030.8157838E+03 0.7876226E+030.8153799E+030.7614021E+030.7368746E+030.7609978E+030.7138325E+03 0.6921081E+030.7134280E+030.6715576E+030.6520640E+030.6711521E+030.9554770E+03 0.1000000E+040.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788551E+03 0.8157838E+030.7876227E+030.8153799E+030.7614023E+030.7368747E+030.7609978E+03 0.7138327E+030.6921083E+030.7134280E+030.6715578E+030.6711521E+030.6520642E+03 0.9043840E+020.9024959E+020.9982624E+020.9025324E+020.8127637E+020.7214348E+02 0.7233030E+020.6359044E+020.7214098E+020.5486040E+020.5504742E+020.4669251E+02 0.5485869E+020.3833073E+020.3851758E+020.3051462E+020.3832972E+020.2249338E+02 0.2267557E+020.1499064E+020.2249275E+020.7314284E+010.7444518E+010.0000000E+00 0.7314062E+010.9043150E+020.9981746E+020.8127056E+020.9023955E+020.7232558E+02 0.6358650E+020.7213423E+020.5504421E+020.4668985E+020.5485397E+020.3851545E+02 0.3051288E+020.3832653E+020.2267428E+020.1498990E+020.2249106E+020.7444111E+01 0.0000000E+000.7313532E+010.9041948E+020.9980314E+020.8126039E+020.9022622E+02 0.7231699E+020.6357929E+020.7212435E+020.5503823E+020.4668502E+020.5484717E+02 0.3851151E+020.3050977E+020.3832206E+020.2267208E+020.1498835E+020.2248829E+02 0.7443328E+010.0000000E+000.7312600E+010.9040473E+020.9978616E+020.8124775E+02 0.9021061E+020.7230630E+020.6357015E+020.7211289E+020.5503062E+020.4667863E+02 0.5483882E+020.3850625E+020.3050576E+020.3831645E+020.2266914E+020.1498634E+02 0.2248521E+020.7442361E+010.0000000E+000.7311622E+010.9038883E+020.9976782E+02 0.8123390E+020.9019466E+020.7229438E+020.6355990E+020.7210071E+020.5502191E+02 0.4667128E+020.5482989E+020.3850048E+020.3050120E+020.3831044E+020.2266572E+02 0.1498406E+020.2248167E+020.7441242E+010.0000000E+000.7310432E+010.9037291E+02 0.9974982E+020.8121989E+020.9017899E+020.7228203E+020.6354932E+020.7208864E+02 0.5501292E+020.4666388E+020.5482104E+020.3849440E+020.3049642E+020.3830448E+02 0.2266212E+020.1498168E+020.2247817E+020.7440089E+010.0000000E+000.7309263E+01 0.9035755E+020.9973264E+020.8120635E+020.9016422E+020.7227021E+020.6353899E+02 0.7207724E+020.5500421E+020.4665663E+020.5481263E+020.3848852E+020.3049177E+02 0.3829860E+020.2265862E+020.1497939E+020.2247482E+020.7438896E+010.0000000E+00 0.7308275E+010.9034339E+020.9971666E+020.8119382E+020.9015084E+020.7225921E+02 0.6352947E+020.7206681E+020.5499589E+020.4664958E+020.5480474E+020.3848275E+02 0.3048745E+020.3829326E+020.2265550E+020.1497740E+020.2247185E+020.7437974E+01 0.0000000E+000.7307321E+010.9033083E+020.9970262E+020.8118270E+020.9013924E+02 0.7224938E+020.6352095E+020.7205773E+020.5498855E+020.4664344E+020.5479804E+02 0.3847776E+020.3048334E+020.3828865E+020.2265269E+020.1497544E+020.2246911E+02 0.7437009E+010.0000000E+000.7306399E+010.9032012E+020.9969071E+020.8117320E+02 0.9012961E+020.7224099E+020.6351366E+020.7205022E+020.5498236E+020.4663826E+02 0.5479246E+020.3847348E+020.3048001E+020.3828479E+020.2265009E+020.1497381E+02 0.2246688E+020.7436173E+010.0000000E+000.7305630E+010.9031151E+020.9968105E+02 0.8116565E+020.9012221E+020.7223432E+020.6350791E+020.7204454E+020.5497743E+02 0.4663413E+020.5478829E+020.3847005E+020.3047730E+020.3828192E+020.2264806E+02 0.1497248E+020.2246518E+020.7435502E+010.0000000E+000.7305147E+010.9030539E+02 0.9967415E+020.8116027E+020.9011754E+020.7222966E+020.6350389E+020.7204100E+02 0.5497396E+020.4663125E+020.5478565E+020.3846770E+020.3047547E+020.3828014E+02 0.2264669E+020.1497158E+020.2246415E+020.7435065E+010.0000000E+000.7304798E+01 0.9030207E+020.9967039E+020.8115745E+020.9011571E+020.7222719E+020.6350179E+02 0.7203972E+020.5497219E+020.4662980E+020.5478482E+020.3846652E+020.3047456E+02 0.3827960E+020.2264600E+020.1497116E+020.2246385E+020.7434862E+010.0000000E+00 0.7304705E+010.9030173E+020.9966986E+020.8115729E+020.9011706E+020.7222713E+02 0.6350182E+020.7204100E+020.5497224E+020.4662987E+020.5478585E+020.3846656E+02 0.3047463E+020.3828035E+020.2264606E+020.1497118E+020.2246428E+020.7434840E+01 0.0000000E+000.7304820E+010.9030484E+020.9967321E+020.8116022E+020.9012212E+02 0.7222973E+020.6350417E+020.7204504E+020.5497427E+020.4663163E+020.5478892E+02 0.3846801E+020.3047578E+020.3828246E+020.2264688E+020.1497178E+020.2246552E+02 0.7435168E+010.0000000E+000.7305189E+010.9031181E+020.9968096E+020.8116648E+02 0.9013108E+020.7223521E+020.6350898E+020.7205196E+020.5497834E+020.4663507E+02 0.5479400E+020.3847083E+020.3047809E+020.3828595E+020.2264865E+020.1497294E+02 0.2246749E+020.7435671E+010.0000000E+000.7305908E+010.9032270E+020.9969340E+02 0.8117604E+020.9014382E+020.7224345E+020.6351610E+020.7206144E+020.5498441E+02 0.4664011E+020.5480083E+020.3847498E+020.3048130E+020.3829062E+020.2265088E+02 0.1497443E+020.2247025E+020.7436538E+010.0000000E+000.7306792E+010.9033696E+02 0.9971007E+020.8118830E+020.9015907E+020.7225396E+020.6352508E+020.7207262E+02 0.5499190E+020.4664630E+020.5480891E+020.3847997E+020.3048524E+020.3829599E+02 0.2265392E+020.1497635E+020.2247327E+020.7437384E+010.0000000E+000.7307721E+01 0.9035275E+020.9972848E+020.8120183E+020.9017473E+020.7226550E+020.6353485E+02 0.7208421E+020.5500021E+020.4665326E+020.5481721E+020.3848554E+020.3048945E+02 0.3830152E+020.2265685E+020.1497819E+020.2247635E+020.7438330E+010.0000000E+00 0.7308690E+010.9036791E+020.9974583E+020.8121497E+020.9018909E+020.7227690E+02 0.6354466E+020.7209510E+020.5500843E+020.4666012E+020.5482510E+020.3849113E+02 0.3049383E+020.3830681E+020.2266011E+020.1498036E+020.2247941E+020.7439418E+01 0.0000000E+000.7309702E+010.9038145E+020.9976110E+020.8122695E+020.9020151E+02 0.7228738E+020.6355371E+020.7210470E+020.5501613E+020.4666640E+020.5483208E+02 0.3849621E+020.3049787E+020.3831158E+020.2266309E+020.1498238E+020.2248226E+02 0.7440445E+010.0000000E+000.7310594E+010.9039277E+020.9977381E+020.8123673E+02 0.9021151E+020.7229593E+020.6356111E+020.7211232E+020.5502239E+020.4667179E+02 0.5483784E+020.3850063E+020.3050119E+020.3831557E+020.2266558E+020.1498408E+02 0.2248447E+020.7441213E+010.0000000E+000.7311398E+010.9040124E+020.9978328E+02 0.8124439E+020.9021834E+020.7230272E+020.6356688E+020.7211790E+020.5502750E+02 0.4667602E+020.5484198E+020.3850405E+020.3050399E+020.3831829E+020.2266771E+02 0.1498551E+020.2248630E+020.7442012E+010.0000000E+000.7311986E+010.9040685E+02 0.9978938E+020.8124936E+020.9022281E+020.7230710E+020.6357078E+020.7212121E+02 0.5503077E+020.4667874E+020.5484450E+020.3850632E+020.3050580E+020.3832016E+02 0.2266911E+020.1498646E+020.2248730E+020.7442461E+010.0000000E+000.7312280E+01 0.9040985E+020.9979277E+020.8125194E+020.9022415E+020.7230943E+020.6357279E+02 0.7212240E+020.5503253E+020.4668021E+020.5484534E+020.3850759E+020.3050680E+02 0.3832071E+020.2266984E+020.1498691E+020.2248766E+020.7442645E+010.0000000E+00 0.7312407E+010.9040995E+020.9979281E+020.8125198E+020.9022276E+020.7230947E+02 0.6357277E+020.7212122E+020.5503254E+020.4668020E+020.5484451E+020.3850761E+02 0.3050684E+020.3832019E+020.2266985E+020.1498689E+020.2248728E+020.7442658E+01 0.0000000E+000.7312304E+010.9040706E+020.9978948E+020.8124940E+020.9021831E+02 0.7230725E+020.6357082E+020.7211790E+020.5503090E+020.4667877E+020.5484195E+02 0.3850642E+020.3050581E+020.3831832E+020.2266906E+020.1498648E+020.2248629E+02 0.7442413E+010.0000000E+000.7311994E+010.9040140E+020.9978321E+020.8124433E+02 0.9021149E+020.7230270E+020.6356686E+020.7211228E+020.5502748E+020.4667599E+02 0.5483790E+020.3850408E+020.3050391E+020.3831555E+020.2266771E+020.1498548E+02 0.2248445E+020.7441923E+010.0000000E+000.7311363E+010.9039289E+020.9977384E+02 0.8123675E+020.9020148E+020.7229619E+020.6356110E+020.7210465E+020.5502263E+02 0.4667177E+020.5483213E+020.3850054E+020.3050122E+020.3831159E+020.2266574E+02 0.1498410E+020.2248229E+020.7441259E+010.0000000E+000.7310669E+010.9038174E+02 0.9976107E+020.8122688E+020.9018914E+020.7228760E+020.6355362E+020.7209512E+02 0.5501623E+020.4666632E+020.5482507E+020.3849629E+020.3049783E+020.3830684E+02 0.2266317E+020.1498237E+020.2247947E+020.7440390E+010.0000000E+000.7309703E+01 0.9036832E+020.9974588E+020.8121505E+020.9017476E+020.7227719E+020.6354471E+02 0.7208420E+020.5500868E+020.4666012E+020.5481718E+020.3849118E+020.3049382E+02 0.3830155E+020.2266015E+020.1498037E+020.2247640E+020.7439432E+010.0000000E+00 0.7308692E+010.9035312E+020.9972852E+020.8120184E+020.9015909E+020.7226579E+02 0.6353490E+020.7207263E+020.5500047E+020.4665333E+020.5480892E+020.3848573E+02 0.3048951E+020.3829588E+020.2265692E+020.1497829E+020.2247317E+020.7438422E+01 0.0000000E+000.7307656E+010.9033731E+020.9971003E+020.8118830E+020.9014377E+02 0.7225424E+020.6352505E+020.7206146E+020.5499207E+020.4664629E+020.5480080E+02 0.3847999E+020.3048524E+020.3829051E+020.2265383E+020.1497629E+020.2247025E+02 0.7437512E+010.0000000E+000.7306815E+010.9032300E+020.9969340E+020.8117602E+02 0.9013105E+020.7224370E+020.6351611E+020.7205195E+020.5498448E+020.4664004E+02 0.5479399E+020.3847500E+020.3048119E+020.3828598E+020.2265111E+020.1497442E+02 0.2246758E+020.7436494E+010.0000000E+000.7305909E+010.9031200E+020.9968093E+02 0.8116643E+020.9012211E+020.7223534E+020.6350895E+020.7204504E+020.5497846E+02 0.4663506E+020.5478892E+020.3847091E+020.3047803E+020.3828246E+020.2264862E+02 0.1497286E+020.2246557E+020.7435705E+010.0000000E+000.7305212E+010.9030497E+02 0.9967320E+020.8116020E+020.9011704E+020.7222981E+020.6350416E+020.7204099E+02 0.5497432E+020.4663162E+020.5478584E+020.3846805E+020.3047578E+020.3828034E+02 0.2264692E+020.1497174E+020.2246429E+020.7435135E+010.0000000E+000.7304860E+01 0.9030177E+020.9966981E+020.8115730E+020.9011573E+020.7222713E+020.6350180E+02 0.7203971E+020.5497225E+020.4662989E+020.5478480E+020.3846661E+020.3047464E+02 0.3827959E+020.2264607E+020.1497118E+020.2246383E+020.7434871E+010.0000000E+00 0.7304694E+010.9030203E+020.9967040E+020.8115746E+020.9011753E+020.7222716E+02 0.6350177E+020.7204100E+020.5497218E+020.4662982E+020.5478568E+020.3846651E+02 0.3047456E+020.3828015E+020.2264599E+020.1497116E+020.2246415E+020.7434860E+01 0.0000000E+000.7304799E+010.9030532E+020.9967417E+020.8116031E+020.9012226E+02 0.7222960E+020.6350389E+020.7204457E+020.5497392E+020.4663127E+020.5478826E+02 0.3846765E+020.3047548E+020.3828191E+020.2264666E+020.1497157E+020.2246515E+02 0.7435031E+010.0000000E+000.7305096E+010.9031137E+020.9968107E+020.8116565E+02 0.9012961E+020.7223424E+020.6350791E+020.7205023E+020.5497733E+020.4663414E+02 0.5479245E+020.3846999E+020.3047733E+020.3828477E+020.2264799E+020.1497252E+02 0.2246683E+020.7435529E+010.0000000E+000.7305608E+010.9031990E+020.9969072E+02 0.8117320E+020.9013926E+020.7224083E+020.6351367E+020.7205773E+020.5498224E+02 0.4663827E+020.5479804E+020.3847336E+020.3048008E+020.3828862E+020.2265008E+02 0.1497389E+020.2246901E+020.7436141E+010.0000000E+000.7306398E+010.9033051E+02 0.9970262E+020.8118267E+020.9015082E+020.7224915E+020.6352095E+020.7206680E+02 0.5498847E+020.4664351E+020.5480479E+020.3847774E+020.3048343E+020.3829335E+02 0.2265246E+020.1497547E+020.2247184E+020.7437053E+010.0000000E+000.7307308E+01 0.9034303E+020.9971668E+020.8119380E+020.9016419E+020.7225892E+020.6352946E+02 0.7207718E+020.5499570E+020.4664956E+020.5481260E+020.3848269E+020.3048741E+02 0.3829869E+020.2265554E+020.1497742E+020.2247490E+020.7437918E+010.0000000E+00 0.7308257E+010.9035721E+020.9973260E+020.8120633E+020.9017896E+020.7226986E+02 0.6353894E+020.7208863E+020.5500391E+020.4665652E+020.5482107E+020.3848833E+02 0.3049170E+020.3830445E+020.2265855E+020.1497933E+020.2247815E+020.7438897E+01 0.0000000E+000.7309283E+010.9037246E+020.9974977E+020.8121980E+020.9019461E+02 0.7228169E+020.6354925E+020.7210068E+020.5501265E+020.4666388E+020.5482990E+02 0.3849431E+020.3049643E+020.3831043E+020.2266209E+020.1498167E+020.2248162E+02 0.7440071E+010.0000000E+000.7310424E+010.9038848E+020.9976786E+020.8123397E+02 0.9021068E+020.7229408E+020.6355996E+020.7211293E+020.5502176E+020.4667134E+02 0.5483877E+020.3850036E+020.3050123E+020.3831644E+020.2266564E+020.1498409E+02 0.2248517E+020.7441297E+010.0000000E+000.7311546E+010.9040444E+020.9978611E+02 0.8124772E+020.9022623E+020.7230597E+020.6357015E+020.7212438E+020.5503034E+02 0.4667862E+020.5484714E+020.3850628E+020.3050572E+020.3832207E+020.2266897E+02 0.1498633E+020.2248830E+020.7442335E+010.0000000E+000.7312646E+010.9041916E+02 0.9980319E+020.8126046E+020.9023958E+020.7231691E+020.6357933E+020.7213420E+02 0.5503822E+020.4668507E+020.5485401E+020.3851144E+020.3050985E+020.3832651E+02 0.2267204E+020.1498838E+020.2249106E+020.7443427E+010.0000000E+000.7313518E+01 0.9043115E+020.9981733E+020.8127051E+020.9024962E+020.7232533E+020.6358644E+02 0.7214097E+020.5504404E+020.4668982E+020.5485867E+020.3851531E+020.3051287E+02 0.3832969E+020.2267431E+020.1498989E+020.2249277E+020.7444162E+010.0000000E+00 0.7314072E+010.9043840E+020.9982624E+020.8127634E+020.9025324E+020.7233024E+02 0.6359045E+020.7214351E+020.5504736E+020.4669250E+020.5486030E+020.3851754E+02 0.3051457E+020.3833075E+020.2267554E+020.1499062E+020.2249341E+020.7444513E+01 0.7314283E+010.0000000E+00 syrthes-3.4.3-dfsg1/example/cylinder/RESU/ray.res10000666000175000017500000000541111524070640020321 0ustar pinipini************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 1 84 86 2 C3C* NPDT TEMPS DT C4C* 100 0.1800000000000E+06 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ T_RAYT 1----------- 0.9964327E+020.9963487E+020.9962102E+020.9960421E+020.9958610E+020.9956824E+02 0.9955111E+020.9953527E+020.9952129E+020.9950943E+020.9949983E+020.9949300E+02 0.9948927E+020.9948882E+020.9949222E+020.9950000E+020.9951237E+020.9952865E+02 0.9954667E+020.9956388E+020.9957902E+020.9959168E+020.9960107E+020.9960728E+02 0.9961057E+020.9961056E+020.9960728E+020.9960106E+020.9959166E+020.9957902E+02 0.9956392E+020.9954670E+020.9952864E+020.9951233E+020.9949998E+020.9949219E+02 0.9948880E+020.9948926E+020.9949302E+020.9949986E+020.9950944E+020.9952131E+02 0.9953526E+020.9955109E+020.9956820E+020.9958613E+020.9960423E+020.9962100E+02 0.9963487E+020.9964327E+020.6516524E+030.6516522E+030.6516518E+030.6516513E+03 0.6516507E+030.6516502E+030.6516497E+030.6516493E+030.6516491E+030.6516490E+03 0.6516492E+030.6516495E+030.6516499E+030.6516502E+030.6516506E+030.6516509E+03 0.6516511E+030.6516511E+030.6516509E+030.6516506E+030.6516502E+030.6516498E+03 0.6516495E+030.6516492E+030.6516491E+030.6516491E+030.6516493E+030.6516497E+03 0.6516502E+030.6516507E+030.6516513E+030.6516518E+030.6516522E+030.6516524E+03 FLUX_RAY_B01 1----------- -.9511981E+04-.9509230E+04-.9506818E+04-.9504330E+04-.9501679E+04-.9499649E+04 -.9497749E+04-.9495703E+04-.9494290E+04-.9493126E+04-.9491771E+04-.9490970E+04 -.9490617E+04-.9490165E+04-.9490249E+04-.9491054E+04-.9492335E+04-.9495238E+04 -.9498496E+04-.9500731E+04-.9502324E+04-.9504103E+04-.9505041E+04-.9505348E+04 -.9506043E+04-.9506043E+04-.9505348E+04-.9505042E+04-.9504103E+04-.9502323E+04 -.9500731E+04-.9498496E+04-.9495238E+04-.9492335E+04-.9491054E+04-.9490249E+04 -.9490165E+04-.9490617E+04-.9490970E+04-.9491770E+04-.9493126E+04-.9494290E+04 -.9495703E+04-.9497749E+04-.9499649E+04-.9501679E+04-.9504329E+04-.9506817E+04 -.9509229E+04-.9511981E+040.1900080E+050.1900085E+050.1900093E+050.1900103E+05 0.1900114E+050.1900125E+050.1900135E+050.1900141E+050.1900144E+050.1900143E+05 0.1900139E+050.1900132E+050.1900123E+050.1900113E+050.1900105E+050.1900099E+05 0.1900095E+050.1900095E+050.1900098E+050.1900105E+050.1900113E+050.1900123E+05 0.1900132E+050.1900140E+050.1900143E+050.1900144E+050.1900141E+050.1900134E+05 0.1900125E+050.1900114E+050.1900102E+050.1900092E+050.1900085E+050.1900080E+05 syrthes-3.4.3-dfsg1/example/cylinder/RESU/geom.syr0000666000175000017500000070627611524070640020441 0ustar pinipiniC************************************************C C FICHIER GEOMETRIQUE SYRTHES 3.4 C C************************************************C C DIMENSION = 2 DIMENSION DES ELTS = 2 C NOMBRE DE NOEUDS = 2210 C NOMBRE D'ELEMENTS = 1008 C NOMBRE DE NOEUDS PAR ELEMENT = 6 C************************************************C C C$ RUBRIQUE = NOEUDS C 1 1 0.0000000E+00 -0.2000000E+00 0.0000000E+00 2 0 0.0000000E+00 -0.2500000E+00 0.0000000E+00 3 0 0.0000000E+00 -0.3000000E+00 0.0000000E+00 4 0 0.0000000E+00 -0.3500000E+00 0.0000000E+00 5 0 0.0000000E+00 -0.4000000E+00 0.0000000E+00 6 0 0.0000000E+00 -0.4500000E+00 0.0000000E+00 7 0 0.0000000E+00 -0.5000000E+00 0.0000000E+00 8 1 0.1845367E-01 -0.1991468E+00 0.0000000E+00 9 0 0.2306709E-01 -0.2489335E+00 0.0000000E+00 10 0 0.2768051E-01 -0.2987203E+00 0.0000000E+00 11 0 0.3229392E-01 -0.3485070E+00 0.0000000E+00 12 0 0.3690734E-01 -0.3982937E+00 0.0000000E+00 13 0 0.4152076E-01 -0.4480804E+00 0.0000000E+00 14 2 0.4613418E-01 -0.4978671E+00 0.0000000E+00 15 1 0.3674990E-01 -0.1965946E+00 0.0000000E+00 16 0 0.4593738E-01 -0.2457433E+00 0.0000000E+00 17 0 0.5512486E-01 -0.2948920E+00 0.0000000E+00 18 0 0.6431233E-01 -0.3440406E+00 0.0000000E+00 19 0 0.7349981E-01 -0.3931893E+00 0.0000000E+00 20 0 0.8268728E-01 -0.4423379E+00 0.0000000E+00 21 2 0.9187476E-01 -0.4914865E+00 0.0000000E+00 22 1 0.5473260E-01 -0.1923651E+00 0.0000000E+00 23 0 0.6841575E-01 -0.2404564E+00 0.0000000E+00 24 0 0.8209889E-01 -0.2885477E+00 0.0000000E+00 25 0 0.9578203E-01 -0.3366390E+00 0.0000000E+00 26 0 0.1094652E+00 -0.3847303E+00 0.0000000E+00 27 0 0.1231483E+00 -0.4328215E+00 0.0000000E+00 28 2 0.1368315E+00 -0.4809128E+00 0.0000000E+00 29 1 0.7224833E-01 -0.1864945E+00 0.0000000E+00 30 0 0.9031042E-01 -0.2331181E+00 0.0000000E+00 31 0 0.1083725E+00 -0.2797417E+00 0.0000000E+00 32 0 0.1264346E+00 -0.3263653E+00 0.0000000E+00 33 0 0.1444967E+00 -0.3729889E+00 0.0000000E+00 34 0 0.1625587E+00 -0.4196125E+00 0.0000000E+00 35 2 0.1806208E+00 -0.4662361E+00 0.0000000E+00 36 1 0.8914768E-01 -0.1790327E+00 0.0000000E+00 37 0 0.1114346E+00 -0.2237908E+00 0.0000000E+00 38 0 0.1337215E+00 -0.2685490E+00 0.0000000E+00 39 0 0.1560084E+00 -0.3133071E+00 0.0000000E+00 40 0 0.1782954E+00 -0.3580653E+00 0.0000000E+00 41 0 0.2005823E+00 -0.4028235E+00 0.0000000E+00 42 2 0.2228692E+00 -0.4475816E+00 0.0000000E+00 43 1 0.1052864E+00 -0.1700434E+00 0.0000000E+00 44 0 0.1316080E+00 -0.2125543E+00 0.0000000E+00 45 0 0.1579296E+00 -0.2550651E+00 0.0000000E+00 46 0 0.1842512E+00 -0.2975760E+00 0.0000000E+00 47 0 0.2105729E+00 -0.3400868E+00 0.0000000E+00 48 0 0.2368945E+00 -0.3825977E+00 0.0000000E+00 49 2 0.2632161E+00 -0.4251086E+00 0.0000000E+00 50 1 0.1205269E+00 -0.1596034E+00 0.0000000E+00 51 0 0.1506587E+00 -0.1995043E+00 0.0000000E+00 52 0 0.1807904E+00 -0.2394052E+00 0.0000000E+00 53 0 0.2109221E+00 -0.2793060E+00 0.0000000E+00 54 0 0.2410539E+00 -0.3192069E+00 0.0000000E+00 55 0 0.2711856E+00 -0.3591077E+00 0.0000000E+00 56 2 0.3013173E+00 -0.3990086E+00 0.0000000E+00 57 1 0.1347391E+00 -0.1478018E+00 0.0000000E+00 58 0 0.1684239E+00 -0.1847522E+00 0.0000000E+00 59 0 0.2021087E+00 -0.2217027E+00 0.0000000E+00 60 0 0.2357935E+00 -0.2586531E+00 0.0000000E+00 61 0 0.2694782E+00 -0.2956036E+00 0.0000000E+00 62 0 0.3031630E+00 -0.3325540E+00 0.0000000E+00 63 2 0.3368478E+00 -0.3695045E+00 0.0000000E+00 64 1 0.1478018E+00 -0.1347391E+00 0.0000000E+00 65 0 0.1847522E+00 -0.1684239E+00 0.0000000E+00 66 0 0.2217027E+00 -0.2021087E+00 0.0000000E+00 67 0 0.2586531E+00 -0.2357935E+00 0.0000000E+00 68 0 0.2956036E+00 -0.2694783E+00 0.0000000E+00 69 0 0.3325540E+00 -0.3031630E+00 0.0000000E+00 70 2 0.3695045E+00 -0.3368478E+00 0.0000000E+00 71 1 0.1596034E+00 -0.1205269E+00 0.0000000E+00 72 0 0.1995043E+00 -0.1506587E+00 0.0000000E+00 73 0 0.2394052E+00 -0.1807904E+00 0.0000000E+00 74 0 0.2793060E+00 -0.2109221E+00 0.0000000E+00 75 0 0.3192069E+00 -0.2410538E+00 0.0000000E+00 76 0 0.3591078E+00 -0.2711855E+00 0.0000000E+00 77 2 0.3990086E+00 -0.3013173E+00 0.0000000E+00 78 1 0.1700434E+00 -0.1052864E+00 0.0000000E+00 79 0 0.2125543E+00 -0.1316081E+00 0.0000000E+00 80 0 0.2550651E+00 -0.1579297E+00 0.0000000E+00 81 0 0.2975760E+00 -0.1842512E+00 0.0000000E+00 82 0 0.3400868E+00 -0.2105729E+00 0.0000000E+00 83 0 0.3825977E+00 -0.2368945E+00 0.0000000E+00 84 2 0.4251086E+00 -0.2632161E+00 0.0000000E+00 85 1 0.1790327E+00 -0.8914766E-01 0.0000000E+00 86 0 0.2237908E+00 -0.1114346E+00 0.0000000E+00 87 0 0.2685490E+00 -0.1337215E+00 0.0000000E+00 88 0 0.3133072E+00 -0.1560084E+00 0.0000000E+00 89 0 0.3580653E+00 -0.1782953E+00 0.0000000E+00 90 0 0.4028235E+00 -0.2005822E+00 0.0000000E+00 91 2 0.4475816E+00 -0.2228692E+00 0.0000000E+00 92 1 0.1864945E+00 -0.7224832E-01 0.0000000E+00 93 0 0.2331181E+00 -0.9031039E-01 0.0000000E+00 94 0 0.2797417E+00 -0.1083725E+00 0.0000000E+00 95 0 0.3263653E+00 -0.1264345E+00 0.0000000E+00 96 0 0.3729889E+00 -0.1444966E+00 0.0000000E+00 97 0 0.4196125E+00 -0.1625587E+00 0.0000000E+00 98 2 0.4662361E+00 -0.1806208E+00 0.0000000E+00 99 1 0.1923651E+00 -0.5473260E-01 0.0000000E+00 100 0 0.2404564E+00 -0.6841575E-01 0.0000000E+00 101 0 0.2885477E+00 -0.8209890E-01 0.0000000E+00 102 0 0.3366390E+00 -0.9578204E-01 0.0000000E+00 103 0 0.3847303E+00 -0.1094652E+00 0.0000000E+00 104 0 0.4328215E+00 -0.1231483E+00 0.0000000E+00 105 2 0.4809128E+00 -0.1368315E+00 0.0000000E+00 106 1 0.1965946E+00 -0.3674989E-01 0.0000000E+00 107 0 0.2457433E+00 -0.4593736E-01 0.0000000E+00 108 0 0.2948920E+00 -0.5512484E-01 0.0000000E+00 109 0 0.3440406E+00 -0.6431231E-01 0.0000000E+00 110 0 0.3931893E+00 -0.7349977E-01 0.0000000E+00 111 0 0.4423379E+00 -0.8268724E-01 0.0000000E+00 112 2 0.4914865E+00 -0.9187473E-01 0.0000000E+00 113 1 0.1991468E+00 -0.1845367E-01 0.0000000E+00 114 0 0.2489335E+00 -0.2306710E-01 0.0000000E+00 115 0 0.2987203E+00 -0.2768053E-01 0.0000000E+00 116 0 0.3485070E+00 -0.3229395E-01 0.0000000E+00 117 0 0.3982937E+00 -0.3690733E-01 0.0000000E+00 118 0 0.4480804E+00 -0.4152075E-01 0.0000000E+00 119 2 0.4978671E+00 -0.4613419E-01 0.0000000E+00 120 1 0.2000000E+00 0.0000000E+00 0.0000000E+00 121 0 0.2500000E+00 0.0000000E+00 0.0000000E+00 122 0 0.3000000E+00 0.0000000E+00 0.0000000E+00 123 0 0.3500000E+00 0.0000000E+00 0.0000000E+00 124 0 0.4000000E+00 0.1490116E-07 0.0000000E+00 125 0 0.4500000E+00 0.1490116E-07 0.0000000E+00 126 0 0.5000000E+00 0.0000000E+00 0.0000000E+00 127 1 0.1991468E+00 0.1845367E-01 0.0000000E+00 128 0 0.2489335E+00 0.2306709E-01 0.0000000E+00 129 0 0.2987202E+00 0.2768051E-01 0.0000000E+00 130 0 0.3485070E+00 0.3229393E-01 0.0000000E+00 131 0 0.3982936E+00 0.3690736E-01 0.0000000E+00 132 0 0.4480804E+00 0.4152077E-01 0.0000000E+00 133 2 0.4978671E+00 0.4613418E-01 0.0000000E+00 134 1 0.1965946E+00 0.3674990E-01 0.0000000E+00 135 0 0.2457433E+00 0.4593738E-01 0.0000000E+00 136 0 0.2948919E+00 0.5512486E-01 0.0000000E+00 137 0 0.3440406E+00 0.6431233E-01 0.0000000E+00 138 0 0.3931892E+00 0.7349982E-01 0.0000000E+00 139 0 0.4423379E+00 0.8268729E-01 0.0000000E+00 140 2 0.4914865E+00 0.9187476E-01 0.0000000E+00 141 1 0.1923651E+00 0.5473260E-01 0.0000000E+00 142 0 0.2404564E+00 0.6841575E-01 0.0000000E+00 143 0 0.2885477E+00 0.8209890E-01 0.0000000E+00 144 0 0.3366390E+00 0.9578204E-01 0.0000000E+00 145 0 0.3847302E+00 0.1094652E+00 0.0000000E+00 146 0 0.4328215E+00 0.1231484E+00 0.0000000E+00 147 2 0.4809128E+00 0.1368315E+00 0.0000000E+00 148 1 0.1864945E+00 0.7224833E-01 0.0000000E+00 149 0 0.2331181E+00 0.9031042E-01 0.0000000E+00 150 0 0.2797417E+00 0.1083725E+00 0.0000000E+00 151 0 0.3263653E+00 0.1264346E+00 0.0000000E+00 152 0 0.3729889E+00 0.1444967E+00 0.0000000E+00 153 0 0.4196125E+00 0.1625587E+00 0.0000000E+00 154 2 0.4662361E+00 0.1806208E+00 0.0000000E+00 155 1 0.1790327E+00 0.8914768E-01 0.0000000E+00 156 0 0.2237908E+00 0.1114346E+00 0.0000000E+00 157 0 0.2685490E+00 0.1337215E+00 0.0000000E+00 158 0 0.3133072E+00 0.1560084E+00 0.0000000E+00 159 0 0.3580653E+00 0.1782954E+00 0.0000000E+00 160 0 0.4028234E+00 0.2005823E+00 0.0000000E+00 161 2 0.4475816E+00 0.2228692E+00 0.0000000E+00 162 1 0.1700434E+00 0.1052864E+00 0.0000000E+00 163 0 0.2125543E+00 0.1316080E+00 0.0000000E+00 164 0 0.2550651E+00 0.1579297E+00 0.0000000E+00 165 0 0.2975760E+00 0.1842512E+00 0.0000000E+00 166 0 0.3400868E+00 0.2105729E+00 0.0000000E+00 167 0 0.3825977E+00 0.2368945E+00 0.0000000E+00 168 2 0.4251086E+00 0.2632161E+00 0.0000000E+00 169 1 0.1596034E+00 0.1205269E+00 0.0000000E+00 170 0 0.1995043E+00 0.1506587E+00 0.0000000E+00 171 0 0.2394051E+00 0.1807904E+00 0.0000000E+00 172 0 0.2793060E+00 0.2109222E+00 0.0000000E+00 173 0 0.3192069E+00 0.2410539E+00 0.0000000E+00 174 0 0.3591077E+00 0.2711856E+00 0.0000000E+00 175 2 0.3990086E+00 0.3013173E+00 0.0000000E+00 176 1 0.1478018E+00 0.1347391E+00 0.0000000E+00 177 0 0.1847522E+00 0.1684239E+00 0.0000000E+00 178 0 0.2217027E+00 0.2021087E+00 0.0000000E+00 179 0 0.2586531E+00 0.2357935E+00 0.0000000E+00 180 0 0.2956035E+00 0.2694783E+00 0.0000000E+00 181 0 0.3325540E+00 0.3031630E+00 0.0000000E+00 182 2 0.3695045E+00 0.3368478E+00 0.0000000E+00 183 1 0.1347391E+00 0.1478018E+00 0.0000000E+00 184 0 0.1684239E+00 0.1847522E+00 0.0000000E+00 185 0 0.2021087E+00 0.2217027E+00 0.0000000E+00 186 0 0.2357935E+00 0.2586531E+00 0.0000000E+00 187 0 0.2694782E+00 0.2956036E+00 0.0000000E+00 188 0 0.3031630E+00 0.3325540E+00 0.0000000E+00 189 2 0.3368478E+00 0.3695045E+00 0.0000000E+00 190 1 0.1205269E+00 0.1596034E+00 0.0000000E+00 191 0 0.1506587E+00 0.1995043E+00 0.0000000E+00 192 0 0.1807904E+00 0.2394052E+00 0.0000000E+00 193 0 0.2109221E+00 0.2793060E+00 0.0000000E+00 194 0 0.2410538E+00 0.3192069E+00 0.0000000E+00 195 0 0.2711855E+00 0.3591078E+00 0.0000000E+00 196 2 0.3013173E+00 0.3990086E+00 0.0000000E+00 197 1 0.1052864E+00 0.1700434E+00 0.0000000E+00 198 0 0.1316081E+00 0.2125543E+00 0.0000000E+00 199 0 0.1579297E+00 0.2550651E+00 0.0000000E+00 200 0 0.1842513E+00 0.2975760E+00 0.0000000E+00 201 0 0.2105729E+00 0.3400868E+00 0.0000000E+00 202 0 0.2368945E+00 0.3825977E+00 0.0000000E+00 203 2 0.2632161E+00 0.4251086E+00 0.0000000E+00 204 1 0.8914766E-01 0.1790327E+00 0.0000000E+00 205 0 0.1114346E+00 0.2237908E+00 0.0000000E+00 206 0 0.1337215E+00 0.2685490E+00 0.0000000E+00 207 0 0.1560084E+00 0.3133072E+00 0.0000000E+00 208 0 0.1782953E+00 0.3580653E+00 0.0000000E+00 209 0 0.2005823E+00 0.4028235E+00 0.0000000E+00 210 2 0.2228692E+00 0.4475816E+00 0.0000000E+00 211 1 0.7224832E-01 0.1864945E+00 0.0000000E+00 212 0 0.9031039E-01 0.2331181E+00 0.0000000E+00 213 0 0.1083725E+00 0.2797417E+00 0.0000000E+00 214 0 0.1264345E+00 0.3263653E+00 0.0000000E+00 215 0 0.1444966E+00 0.3729889E+00 0.0000000E+00 216 0 0.1625587E+00 0.4196125E+00 0.0000000E+00 217 2 0.1806208E+00 0.4662361E+00 0.0000000E+00 218 1 0.5473260E-01 0.1923651E+00 0.0000000E+00 219 0 0.6841576E-01 0.2404564E+00 0.0000000E+00 220 0 0.8209892E-01 0.2885477E+00 0.0000000E+00 221 0 0.9578209E-01 0.3366390E+00 0.0000000E+00 222 0 0.1094652E+00 0.3847303E+00 0.0000000E+00 223 0 0.1231483E+00 0.4328215E+00 0.0000000E+00 224 2 0.1368315E+00 0.4809128E+00 0.0000000E+00 225 1 0.3674989E-01 0.1965946E+00 0.0000000E+00 226 0 0.4593736E-01 0.2457433E+00 0.0000000E+00 227 0 0.5512484E-01 0.2948920E+00 0.0000000E+00 228 0 0.6431231E-01 0.3440406E+00 0.0000000E+00 229 0 0.7349978E-01 0.3931893E+00 0.0000000E+00 230 0 0.8268725E-01 0.4423379E+00 0.0000000E+00 231 2 0.9187473E-01 0.4914865E+00 0.0000000E+00 232 1 0.1845367E-01 0.1991468E+00 0.0000000E+00 233 0 0.2306709E-01 0.2489335E+00 0.0000000E+00 234 0 0.2768051E-01 0.2987203E+00 0.0000000E+00 235 0 0.3229393E-01 0.3485070E+00 0.0000000E+00 236 0 0.3690735E-01 0.3982937E+00 0.0000000E+00 237 0 0.4152076E-01 0.4480804E+00 0.0000000E+00 238 2 0.4613419E-01 0.4978671E+00 0.0000000E+00 239 1 0.0000000E+00 0.2000000E+00 0.0000000E+00 240 0 0.0000000E+00 0.2500000E+00 0.0000000E+00 241 0 0.0000000E+00 0.3000000E+00 0.0000000E+00 242 0 0.0000000E+00 0.3500000E+00 0.0000000E+00 243 0 0.0000000E+00 0.4000000E+00 0.0000000E+00 244 0 0.0000000E+00 0.4500000E+00 0.0000000E+00 245 0 0.0000000E+00 0.5000000E+00 0.0000000E+00 246 0 0.0000000E+00 -0.1000000E+01 0.0000000E+00 247 0 0.0000000E+00 -0.1050000E+01 0.0000000E+00 248 0 0.0000000E+00 -0.1100000E+01 0.0000000E+00 249 0 0.0000000E+00 -0.1150000E+01 0.0000000E+00 250 0 0.0000000E+00 -0.1200000E+01 0.0000000E+00 251 0 0.0000000E+00 -0.1250000E+01 0.0000000E+00 252 4 0.0000000E+00 -0.1300000E+01 0.0000000E+00 253 3 0.6279052E-01 -0.9980267E+00 0.0000000E+00 254 0 0.6593004E-01 -0.1047928E+01 0.0000000E+00 255 0 0.6906958E-01 -0.1097829E+01 0.0000000E+00 256 0 0.7220910E-01 -0.1147731E+01 0.0000000E+00 257 0 0.7534863E-01 -0.1197632E+01 0.0000000E+00 258 0 0.7848816E-01 -0.1247533E+01 0.0000000E+00 259 4 0.8162767E-01 -0.1297435E+01 0.0000000E+00 260 3 0.1253332E+00 -0.9921147E+00 0.0000000E+00 261 0 0.1315999E+00 -0.1041720E+01 0.0000000E+00 262 0 0.1378666E+00 -0.1091326E+01 0.0000000E+00 263 0 0.1441332E+00 -0.1140932E+01 0.0000000E+00 264 0 0.1503999E+00 -0.1190538E+01 0.0000000E+00 265 0 0.1566665E+00 -0.1240143E+01 0.0000000E+00 266 4 0.1629332E+00 -0.1289749E+01 0.0000000E+00 267 3 0.1873813E+00 -0.9822872E+00 0.0000000E+00 268 0 0.1967504E+00 -0.1031402E+01 0.0000000E+00 269 0 0.2061195E+00 -0.1080516E+01 0.0000000E+00 270 0 0.2154885E+00 -0.1129630E+01 0.0000000E+00 271 0 0.2248576E+00 -0.1178745E+01 0.0000000E+00 272 0 0.2342267E+00 -0.1227859E+01 0.0000000E+00 273 4 0.2435957E+00 -0.1276973E+01 0.0000000E+00 274 3 0.2486899E+00 -0.9685832E+00 0.0000000E+00 275 0 0.2611244E+00 -0.1017012E+01 0.0000000E+00 276 0 0.2735589E+00 -0.1065441E+01 0.0000000E+00 277 0 0.2859934E+00 -0.1113871E+01 0.0000000E+00 278 0 0.2984279E+00 -0.1162300E+01 0.0000000E+00 279 0 0.3108624E+00 -0.1210729E+01 0.0000000E+00 280 4 0.3232968E+00 -0.1259158E+01 0.0000000E+00 281 3 0.3090170E+00 -0.9510565E+00 0.0000000E+00 282 0 0.3244678E+00 -0.9986093E+00 0.0000000E+00 283 0 0.3399187E+00 -0.1046162E+01 0.0000000E+00 284 0 0.3553696E+00 -0.1093715E+01 0.0000000E+00 285 0 0.3708204E+00 -0.1141268E+01 0.0000000E+00 286 0 0.3862713E+00 -0.1188821E+01 0.0000000E+00 287 4 0.4017221E+00 -0.1236373E+01 0.0000000E+00 288 3 0.3681245E+00 -0.9297765E+00 0.0000000E+00 289 0 0.3865308E+00 -0.9762653E+00 0.0000000E+00 290 0 0.4049371E+00 -0.1022754E+01 0.0000000E+00 291 0 0.4233432E+00 -0.1069243E+01 0.0000000E+00 292 0 0.4417494E+00 -0.1115732E+01 0.0000000E+00 293 0 0.4601557E+00 -0.1162221E+01 0.0000000E+00 294 4 0.4785619E+00 -0.1208709E+01 0.0000000E+00 295 3 0.4257793E+00 -0.9048271E+00 0.0000000E+00 296 0 0.4470682E+00 -0.9500684E+00 0.0000000E+00 297 0 0.4683572E+00 -0.9953098E+00 0.0000000E+00 298 0 0.4896462E+00 -0.1040551E+01 0.0000000E+00 299 0 0.5109351E+00 -0.1085792E+01 0.0000000E+00 300 0 0.5322241E+00 -0.1131034E+01 0.0000000E+00 301 4 0.5535131E+00 -0.1176275E+01 0.0000000E+00 302 3 0.4817537E+00 -0.8763067E+00 0.0000000E+00 303 0 0.5058414E+00 -0.9201219E+00 0.0000000E+00 304 0 0.5299291E+00 -0.9639373E+00 0.0000000E+00 305 0 0.5540168E+00 -0.1007753E+01 0.0000000E+00 306 0 0.5781044E+00 -0.1051568E+01 0.0000000E+00 307 0 0.6021921E+00 -0.1095383E+01 0.0000000E+00 308 4 0.6262798E+00 -0.1139199E+01 0.0000000E+00 309 3 0.5358268E+00 -0.8443279E+00 0.0000000E+00 310 0 0.5626181E+00 -0.8865442E+00 0.0000000E+00 311 0 0.5894095E+00 -0.9287607E+00 0.0000000E+00 312 0 0.6162008E+00 -0.9709771E+00 0.0000000E+00 313 0 0.6429922E+00 -0.1013193E+01 0.0000000E+00 314 0 0.6697835E+00 -0.1055410E+01 0.0000000E+00 315 4 0.6965748E+00 -0.1097626E+01 0.0000000E+00 316 3 0.5877852E+00 -0.8090170E+00 0.0000000E+00 317 0 0.6171745E+00 -0.8494678E+00 0.0000000E+00 318 0 0.6465638E+00 -0.8899187E+00 0.0000000E+00 319 0 0.6759530E+00 -0.9303695E+00 0.0000000E+00 320 0 0.7053423E+00 -0.9708203E+00 0.0000000E+00 321 0 0.7347316E+00 -0.1011271E+01 0.0000000E+00 322 4 0.7641208E+00 -0.1051722E+01 0.0000000E+00 323 3 0.6374241E+00 -0.7705132E+00 0.0000000E+00 324 0 0.6692953E+00 -0.8090388E+00 0.0000000E+00 325 0 0.7011665E+00 -0.8475645E+00 0.0000000E+00 326 0 0.7330377E+00 -0.8860902E+00 0.0000000E+00 327 0 0.7649088E+00 -0.9246158E+00 0.0000000E+00 328 0 0.7967800E+00 -0.9631415E+00 0.0000000E+00 329 4 0.8286512E+00 -0.1001667E+01 0.0000000E+00 330 3 0.6845471E+00 -0.7289686E+00 0.0000000E+00 331 0 0.7187745E+00 -0.7654170E+00 0.0000000E+00 332 0 0.7530019E+00 -0.8018655E+00 0.0000000E+00 333 0 0.7872292E+00 -0.8383139E+00 0.0000000E+00 334 0 0.8214565E+00 -0.8747623E+00 0.0000000E+00 335 0 0.8556839E+00 -0.9112108E+00 0.0000000E+00 336 4 0.8899112E+00 -0.9476592E+00 0.0000000E+00 337 3 0.7289687E+00 -0.6845471E+00 0.0000000E+00 338 0 0.7654171E+00 -0.7187744E+00 0.0000000E+00 339 0 0.8018656E+00 -0.7530017E+00 0.0000000E+00 340 0 0.8383139E+00 -0.7872291E+00 0.0000000E+00 341 0 0.8747624E+00 -0.8214564E+00 0.0000000E+00 342 0 0.9112108E+00 -0.8556838E+00 0.0000000E+00 343 4 0.9476592E+00 -0.8899112E+00 0.0000000E+00 344 3 0.7705132E+00 -0.6374240E+00 0.0000000E+00 345 0 0.8090389E+00 -0.6692951E+00 0.0000000E+00 346 0 0.8475646E+00 -0.7011664E+00 0.0000000E+00 347 0 0.8860902E+00 -0.7330376E+00 0.0000000E+00 348 0 0.9246158E+00 -0.7649087E+00 0.0000000E+00 349 0 0.9631416E+00 -0.7967799E+00 0.0000000E+00 350 4 0.1001667E+01 -0.8286511E+00 0.0000000E+00 351 3 0.8090170E+00 -0.5877852E+00 0.0000000E+00 352 0 0.8494678E+00 -0.6171744E+00 0.0000000E+00 353 0 0.8899187E+00 -0.6465637E+00 0.0000000E+00 354 0 0.9303696E+00 -0.6759529E+00 0.0000000E+00 355 0 0.9708203E+00 -0.7053422E+00 0.0000000E+00 356 0 0.1011271E+01 -0.7347315E+00 0.0000000E+00 357 4 0.1051722E+01 -0.7641208E+00 0.0000000E+00 358 3 0.8443279E+00 -0.5358267E+00 0.0000000E+00 359 0 0.8865443E+00 -0.5626180E+00 0.0000000E+00 360 0 0.9287608E+00 -0.5894095E+00 0.0000000E+00 361 0 0.9709771E+00 -0.6162007E+00 0.0000000E+00 362 0 0.1013193E+01 -0.6429920E+00 0.0000000E+00 363 0 0.1055410E+01 -0.6697834E+00 0.0000000E+00 364 4 0.1097626E+01 -0.6965747E+00 0.0000000E+00 365 3 0.8763067E+00 -0.4817536E+00 0.0000000E+00 366 0 0.9201220E+00 -0.5058413E+00 0.0000000E+00 367 0 0.9639374E+00 -0.5299289E+00 0.0000000E+00 368 0 0.1007753E+01 -0.5540166E+00 0.0000000E+00 369 0 0.1051568E+01 -0.5781043E+00 0.0000000E+00 370 0 0.1095383E+01 -0.6021920E+00 0.0000000E+00 371 4 0.1139199E+01 -0.6262797E+00 0.0000000E+00 372 3 0.9048271E+00 -0.4257793E+00 0.0000000E+00 373 0 0.9500684E+00 -0.4470682E+00 0.0000000E+00 374 0 0.9953098E+00 -0.4683572E+00 0.0000000E+00 375 0 0.1040551E+01 -0.4896462E+00 0.0000000E+00 376 0 0.1085792E+01 -0.5109351E+00 0.0000000E+00 377 0 0.1131034E+01 -0.5322241E+00 0.0000000E+00 378 4 0.1176275E+01 -0.5535131E+00 0.0000000E+00 379 3 0.9297765E+00 -0.3681245E+00 0.0000000E+00 380 0 0.9762653E+00 -0.3865308E+00 0.0000000E+00 381 0 0.1022754E+01 -0.4049370E+00 0.0000000E+00 382 0 0.1069243E+01 -0.4233432E+00 0.0000000E+00 383 0 0.1115732E+01 -0.4417493E+00 0.0000000E+00 384 0 0.1162221E+01 -0.4601556E+00 0.0000000E+00 385 4 0.1208709E+01 -0.4785619E+00 0.0000000E+00 386 3 0.9510565E+00 -0.3090170E+00 0.0000000E+00 387 0 0.9986093E+00 -0.3244678E+00 0.0000000E+00 388 0 0.1046162E+01 -0.3399186E+00 0.0000000E+00 389 0 0.1093715E+01 -0.3553694E+00 0.0000000E+00 390 0 0.1141268E+01 -0.3708203E+00 0.0000000E+00 391 0 0.1188821E+01 -0.3862712E+00 0.0000000E+00 392 4 0.1236373E+01 -0.4017220E+00 0.0000000E+00 393 3 0.9685832E+00 -0.2486898E+00 0.0000000E+00 394 0 0.1017012E+01 -0.2611243E+00 0.0000000E+00 395 0 0.1065441E+01 -0.2735588E+00 0.0000000E+00 396 0 0.1113871E+01 -0.2859932E+00 0.0000000E+00 397 0 0.1162300E+01 -0.2984278E+00 0.0000000E+00 398 0 0.1210729E+01 -0.3108623E+00 0.0000000E+00 399 4 0.1259158E+01 -0.3232968E+00 0.0000000E+00 400 3 0.9822873E+00 -0.1873812E+00 0.0000000E+00 401 0 0.1031402E+01 -0.1967502E+00 0.0000000E+00 402 0 0.1080516E+01 -0.2061193E+00 0.0000000E+00 403 0 0.1129630E+01 -0.2154883E+00 0.0000000E+00 404 0 0.1178745E+01 -0.2248574E+00 0.0000000E+00 405 0 0.1227859E+01 -0.2342266E+00 0.0000000E+00 406 4 0.1276973E+01 -0.2435956E+00 0.0000000E+00 407 3 0.9921147E+00 -0.1253332E+00 0.0000000E+00 408 0 0.1041720E+01 -0.1315998E+00 0.0000000E+00 409 0 0.1091326E+01 -0.1378666E+00 0.0000000E+00 410 0 0.1140932E+01 -0.1441332E+00 0.0000000E+00 411 0 0.1190538E+01 -0.1503998E+00 0.0000000E+00 412 0 0.1240143E+01 -0.1566666E+00 0.0000000E+00 413 4 0.1289749E+01 -0.1629332E+00 0.0000000E+00 414 3 0.9980267E+00 -0.6279050E-01 0.0000000E+00 415 0 0.1047928E+01 -0.6592996E-01 0.0000000E+00 416 0 0.1097829E+01 -0.6906953E-01 0.0000000E+00 417 0 0.1147731E+01 -0.7220900E-01 0.0000000E+00 418 0 0.1197632E+01 -0.7534858E-01 0.0000000E+00 419 0 0.1247533E+01 -0.7848818E-01 0.0000000E+00 420 4 0.1297435E+01 -0.8162765E-01 0.0000000E+00 421 0 0.1000000E+01 0.0000000E+00 0.0000000E+00 422 0 0.1050000E+01 0.6081736E-07 0.0000000E+00 423 0 0.1100000E+01 0.1871313E-07 0.0000000E+00 424 0 0.1150000E+01 0.7485222E-07 0.0000000E+00 425 0 0.1200000E+01 0.1871302E-07 0.0000000E+00 426 0 0.1250000E+01 -0.4678256E-07 0.0000000E+00 427 4 0.1300000E+01 0.0000000E+00 0.0000000E+00 428 3 0.9980267E+00 0.6279052E-01 0.0000000E+00 429 0 0.1047928E+01 0.6593012E-01 0.0000000E+00 430 0 0.1097829E+01 0.6906953E-01 0.0000000E+00 431 0 0.1147731E+01 0.7220913E-01 0.0000000E+00 432 0 0.1197632E+01 0.7534872E-01 0.0000000E+00 433 0 0.1247533E+01 0.7848809E-01 0.0000000E+00 434 4 0.1297435E+01 0.8162767E-01 0.0000000E+00 435 3 0.9921147E+00 0.1253332E+00 0.0000000E+00 436 0 0.1041720E+01 0.1315999E+00 0.0000000E+00 437 0 0.1091326E+01 0.1378666E+00 0.0000000E+00 438 0 0.1140932E+01 0.1441331E+00 0.0000000E+00 439 0 0.1190538E+01 0.1503998E+00 0.0000000E+00 440 0 0.1240143E+01 0.1566665E+00 0.0000000E+00 441 4 0.1289749E+01 0.1629332E+00 0.0000000E+00 442 3 0.9822872E+00 0.1873813E+00 0.0000000E+00 443 0 0.1031402E+01 0.1967504E+00 0.0000000E+00 444 0 0.1080516E+01 0.2061194E+00 0.0000000E+00 445 0 0.1129630E+01 0.2154885E+00 0.0000000E+00 446 0 0.1178745E+01 0.2248577E+00 0.0000000E+00 447 0 0.1227859E+01 0.2342266E+00 0.0000000E+00 448 4 0.1276973E+01 0.2435957E+00 0.0000000E+00 449 3 0.9685832E+00 0.2486899E+00 0.0000000E+00 450 0 0.1017012E+01 0.2611244E+00 0.0000000E+00 451 0 0.1065441E+01 0.2735590E+00 0.0000000E+00 452 0 0.1113871E+01 0.2859935E+00 0.0000000E+00 453 0 0.1162300E+01 0.2984278E+00 0.0000000E+00 454 0 0.1210729E+01 0.3108623E+00 0.0000000E+00 455 4 0.1259158E+01 0.3232968E+00 0.0000000E+00 456 3 0.9510565E+00 0.3090170E+00 0.0000000E+00 457 0 0.9986093E+00 0.3244678E+00 0.0000000E+00 458 0 0.1046162E+01 0.3399187E+00 0.0000000E+00 459 0 0.1093715E+01 0.3553696E+00 0.0000000E+00 460 0 0.1141268E+01 0.3708204E+00 0.0000000E+00 461 0 0.1188821E+01 0.3862713E+00 0.0000000E+00 462 4 0.1236373E+01 0.4017221E+00 0.0000000E+00 463 3 0.9297765E+00 0.3681245E+00 0.0000000E+00 464 0 0.9762653E+00 0.3865308E+00 0.0000000E+00 465 0 0.1022754E+01 0.4049370E+00 0.0000000E+00 466 0 0.1069243E+01 0.4233432E+00 0.0000000E+00 467 0 0.1115732E+01 0.4417494E+00 0.0000000E+00 468 0 0.1162221E+01 0.4601557E+00 0.0000000E+00 469 4 0.1208709E+01 0.4785619E+00 0.0000000E+00 470 3 0.9048271E+00 0.4257793E+00 0.0000000E+00 471 0 0.9500684E+00 0.4470683E+00 0.0000000E+00 472 0 0.9953098E+00 0.4683573E+00 0.0000000E+00 473 0 0.1040551E+01 0.4896461E+00 0.0000000E+00 474 0 0.1085792E+01 0.5109351E+00 0.0000000E+00 475 0 0.1131034E+01 0.5322241E+00 0.0000000E+00 476 4 0.1176275E+01 0.5535131E+00 0.0000000E+00 477 3 0.8763067E+00 0.4817537E+00 0.0000000E+00 478 0 0.9201219E+00 0.5058414E+00 0.0000000E+00 479 0 0.9639373E+00 0.5299290E+00 0.0000000E+00 480 0 0.1007753E+01 0.5540168E+00 0.0000000E+00 481 0 0.1051568E+01 0.5781045E+00 0.0000000E+00 482 0 0.1095383E+01 0.6021920E+00 0.0000000E+00 483 4 0.1139199E+01 0.6262798E+00 0.0000000E+00 484 3 0.8443279E+00 0.5358268E+00 0.0000000E+00 485 0 0.8865443E+00 0.5626181E+00 0.0000000E+00 486 0 0.9287607E+00 0.5894095E+00 0.0000000E+00 487 0 0.9709771E+00 0.6162008E+00 0.0000000E+00 488 0 0.1013193E+01 0.6429921E+00 0.0000000E+00 489 0 0.1055410E+01 0.6697835E+00 0.0000000E+00 490 4 0.1097626E+01 0.6965748E+00 0.0000000E+00 491 3 0.8090170E+00 0.5877852E+00 0.0000000E+00 492 0 0.8494678E+00 0.6171744E+00 0.0000000E+00 493 0 0.8899187E+00 0.6465637E+00 0.0000000E+00 494 0 0.9303695E+00 0.6759531E+00 0.0000000E+00 495 0 0.9708203E+00 0.7053423E+00 0.0000000E+00 496 0 0.1011271E+01 0.7347316E+00 0.0000000E+00 497 4 0.1051722E+01 0.7641208E+00 0.0000000E+00 498 3 0.7705132E+00 0.6374241E+00 0.0000000E+00 499 0 0.8090389E+00 0.6692952E+00 0.0000000E+00 500 0 0.8475646E+00 0.7011665E+00 0.0000000E+00 501 0 0.8860902E+00 0.7330376E+00 0.0000000E+00 502 0 0.9246158E+00 0.7649088E+00 0.0000000E+00 503 0 0.9631415E+00 0.7967800E+00 0.0000000E+00 504 4 0.1001667E+01 0.8286512E+00 0.0000000E+00 505 3 0.7289686E+00 0.6845471E+00 0.0000000E+00 506 0 0.7654170E+00 0.7187744E+00 0.0000000E+00 507 0 0.8018656E+00 0.7530018E+00 0.0000000E+00 508 0 0.8383138E+00 0.7872292E+00 0.0000000E+00 509 0 0.8747622E+00 0.8214566E+00 0.0000000E+00 510 0 0.9112108E+00 0.8556839E+00 0.0000000E+00 511 4 0.9476592E+00 0.8899112E+00 0.0000000E+00 512 3 0.6845471E+00 0.7289687E+00 0.0000000E+00 513 0 0.7187744E+00 0.7654170E+00 0.0000000E+00 514 0 0.7530019E+00 0.8018655E+00 0.0000000E+00 515 0 0.7872292E+00 0.8383138E+00 0.0000000E+00 516 0 0.8214564E+00 0.8747624E+00 0.0000000E+00 517 0 0.8556839E+00 0.9112108E+00 0.0000000E+00 518 4 0.8899112E+00 0.9476592E+00 0.0000000E+00 519 3 0.6374240E+00 0.7705132E+00 0.0000000E+00 520 0 0.6692952E+00 0.8090388E+00 0.0000000E+00 521 0 0.7011664E+00 0.8475646E+00 0.0000000E+00 522 0 0.7330376E+00 0.8860902E+00 0.0000000E+00 523 0 0.7649088E+00 0.9246157E+00 0.0000000E+00 524 0 0.7967799E+00 0.9631416E+00 0.0000000E+00 525 4 0.8286511E+00 0.1001667E+01 0.0000000E+00 526 3 0.5877852E+00 0.8090170E+00 0.0000000E+00 527 0 0.6171745E+00 0.8494678E+00 0.0000000E+00 528 0 0.6465638E+00 0.8899187E+00 0.0000000E+00 529 0 0.6759529E+00 0.9303696E+00 0.0000000E+00 530 0 0.7053422E+00 0.9708204E+00 0.0000000E+00 531 0 0.7347315E+00 0.1011271E+01 0.0000000E+00 532 4 0.7641208E+00 0.1051722E+01 0.0000000E+00 533 3 0.5358267E+00 0.8443279E+00 0.0000000E+00 534 0 0.5626181E+00 0.8865443E+00 0.0000000E+00 535 0 0.5894095E+00 0.9287607E+00 0.0000000E+00 536 0 0.6162008E+00 0.9709771E+00 0.0000000E+00 537 0 0.6429920E+00 0.1013193E+01 0.0000000E+00 538 0 0.6697834E+00 0.1055410E+01 0.0000000E+00 539 4 0.6965747E+00 0.1097626E+01 0.0000000E+00 540 3 0.4817536E+00 0.8763067E+00 0.0000000E+00 541 0 0.5058413E+00 0.9201220E+00 0.0000000E+00 542 0 0.5299290E+00 0.9639374E+00 0.0000000E+00 543 0 0.5540166E+00 0.1007753E+01 0.0000000E+00 544 0 0.5781043E+00 0.1051568E+01 0.0000000E+00 545 0 0.6021920E+00 0.1095383E+01 0.0000000E+00 546 4 0.6262797E+00 0.1139199E+01 0.0000000E+00 547 3 0.4257793E+00 0.9048271E+00 0.0000000E+00 548 0 0.4470683E+00 0.9500684E+00 0.0000000E+00 549 0 0.4683573E+00 0.9953098E+00 0.0000000E+00 550 0 0.4896463E+00 0.1040551E+01 0.0000000E+00 551 0 0.5109351E+00 0.1085792E+01 0.0000000E+00 552 0 0.5322241E+00 0.1131034E+01 0.0000000E+00 553 4 0.5535131E+00 0.1176275E+01 0.0000000E+00 554 3 0.3681245E+00 0.9297765E+00 0.0000000E+00 555 0 0.3865308E+00 0.9762653E+00 0.0000000E+00 556 0 0.4049371E+00 0.1022754E+01 0.0000000E+00 557 0 0.4233431E+00 0.1069243E+01 0.0000000E+00 558 0 0.4417494E+00 0.1115732E+01 0.0000000E+00 559 0 0.4601556E+00 0.1162221E+01 0.0000000E+00 560 4 0.4785619E+00 0.1208709E+01 0.0000000E+00 561 3 0.3090170E+00 0.9510565E+00 0.0000000E+00 562 0 0.3244678E+00 0.9986093E+00 0.0000000E+00 563 0 0.3399187E+00 0.1046162E+01 0.0000000E+00 564 0 0.3553695E+00 0.1093715E+01 0.0000000E+00 565 0 0.3708203E+00 0.1141268E+01 0.0000000E+00 566 0 0.3862712E+00 0.1188821E+01 0.0000000E+00 567 4 0.4017220E+00 0.1236373E+01 0.0000000E+00 568 3 0.2486898E+00 0.9685832E+00 0.0000000E+00 569 0 0.2611243E+00 0.1017012E+01 0.0000000E+00 570 0 0.2735588E+00 0.1065441E+01 0.0000000E+00 571 0 0.2859933E+00 0.1113871E+01 0.0000000E+00 572 0 0.2984278E+00 0.1162300E+01 0.0000000E+00 573 0 0.3108623E+00 0.1210729E+01 0.0000000E+00 574 4 0.3232968E+00 0.1259158E+01 0.0000000E+00 575 3 0.1873812E+00 0.9822873E+00 0.0000000E+00 576 0 0.1967502E+00 0.1031402E+01 0.0000000E+00 577 0 0.2061193E+00 0.1080516E+01 0.0000000E+00 578 0 0.2154883E+00 0.1129630E+01 0.0000000E+00 579 0 0.2248575E+00 0.1178745E+01 0.0000000E+00 580 0 0.2342266E+00 0.1227859E+01 0.0000000E+00 581 4 0.2435956E+00 0.1276973E+01 0.0000000E+00 582 3 0.1253332E+00 0.9921147E+00 0.0000000E+00 583 0 0.1315999E+00 0.1041720E+01 0.0000000E+00 584 0 0.1378666E+00 0.1091326E+01 0.0000000E+00 585 0 0.1441332E+00 0.1140932E+01 0.0000000E+00 586 0 0.1503999E+00 0.1190538E+01 0.0000000E+00 587 0 0.1566665E+00 0.1240143E+01 0.0000000E+00 588 4 0.1629332E+00 0.1289749E+01 0.0000000E+00 589 3 0.6279050E-01 0.9980267E+00 0.0000000E+00 590 0 0.6593002E-01 0.1047928E+01 0.0000000E+00 591 0 0.6906955E-01 0.1097829E+01 0.0000000E+00 592 0 0.7220908E-01 0.1147731E+01 0.0000000E+00 593 0 0.7534860E-01 0.1197632E+01 0.0000000E+00 594 0 0.7848813E-01 0.1247533E+01 0.0000000E+00 595 4 0.8162765E-01 0.1297435E+01 0.0000000E+00 596 0 0.0000000E+00 0.1000000E+01 0.0000000E+00 597 0 0.0000000E+00 0.1050000E+01 0.0000000E+00 598 0 0.0000000E+00 0.1100000E+01 0.0000000E+00 599 0 0.0000000E+00 0.1150000E+01 0.0000000E+00 600 0 0.0000000E+00 0.1200000E+01 0.0000000E+00 601 0 0.0000000E+00 0.1250000E+01 0.0000000E+00 602 4 0.0000000E+00 0.1300000E+01 0.0000000E+00 603 0 0.1153354E-01 -0.2244668E+00 0.0000000E+00 604 0 0.2076038E-01 -0.2240402E+00 0.0000000E+00 605 1 0.9226836E-02 -0.1995734E+00 0.0000000E+00 606 0 0.0000000E+00 -0.2250000E+00 0.0000000E+00 607 0 0.1153354E-01 -0.2494668E+00 0.0000000E+00 608 0 0.0000000E+00 -0.2750000E+00 0.0000000E+00 609 0 0.1153354E-01 -0.2744668E+00 0.0000000E+00 610 0 0.1384025E-01 -0.2993601E+00 0.0000000E+00 611 0 0.2537380E-01 -0.2738269E+00 0.0000000E+00 612 0 0.0000000E+00 -0.3250000E+00 0.0000000E+00 613 0 0.1384025E-01 -0.3243601E+00 0.0000000E+00 614 0 0.1614696E-01 -0.3492535E+00 0.0000000E+00 615 0 0.2998721E-01 -0.3236136E+00 0.0000000E+00 616 0 0.0000000E+00 -0.3750000E+00 0.0000000E+00 617 0 0.1614696E-01 -0.3742535E+00 0.0000000E+00 618 0 0.1845367E-01 -0.3991468E+00 0.0000000E+00 619 0 0.3460063E-01 -0.3734003E+00 0.0000000E+00 620 0 0.0000000E+00 -0.4250000E+00 0.0000000E+00 621 0 0.1845367E-01 -0.4241468E+00 0.0000000E+00 622 0 0.2076038E-01 -0.4490402E+00 0.0000000E+00 623 0 0.3921405E-01 -0.4231870E+00 0.0000000E+00 624 0 0.0000000E+00 -0.4750000E+00 0.0000000E+00 625 0 0.2076038E-01 -0.4740402E+00 0.0000000E+00 626 2 0.2306709E-01 -0.4989335E+00 0.0000000E+00 627 0 0.4382747E-01 -0.4729737E+00 0.0000000E+00 628 0 0.2990850E-01 -0.2227641E+00 0.0000000E+00 629 1 0.2760179E-01 -0.1978707E+00 0.0000000E+00 630 0 0.3450223E-01 -0.2473384E+00 0.0000000E+00 631 0 0.4134364E-01 -0.2211690E+00 0.0000000E+00 632 0 0.3680894E-01 -0.2722318E+00 0.0000000E+00 633 0 0.4140268E-01 -0.2968061E+00 0.0000000E+00 634 0 0.5053112E-01 -0.2703176E+00 0.0000000E+00 635 0 0.4370939E-01 -0.3216995E+00 0.0000000E+00 636 0 0.4830313E-01 -0.3462738E+00 0.0000000E+00 637 0 0.5971860E-01 -0.3194663E+00 0.0000000E+00 638 0 0.5060983E-01 -0.3711671E+00 0.0000000E+00 639 0 0.5520357E-01 -0.3957415E+00 0.0000000E+00 640 0 0.6890607E-01 -0.3686149E+00 0.0000000E+00 641 0 0.5751028E-01 -0.4206348E+00 0.0000000E+00 642 0 0.6210402E-01 -0.4452091E+00 0.0000000E+00 643 0 0.7809354E-01 -0.4177636E+00 0.0000000E+00 644 0 0.6441073E-01 -0.4701025E+00 0.0000000E+00 645 2 0.6900447E-01 -0.4946768E+00 0.0000000E+00 646 0 0.8728102E-01 -0.4669122E+00 0.0000000E+00 647 0 0.5033499E-01 -0.2190542E+00 0.0000000E+00 648 1 0.4574125E-01 -0.1944799E+00 0.0000000E+00 649 0 0.5717656E-01 -0.2430998E+00 0.0000000E+00 650 0 0.6157417E-01 -0.2164108E+00 0.0000000E+00 651 0 0.6177030E-01 -0.2676742E+00 0.0000000E+00 652 0 0.6861188E-01 -0.2917198E+00 0.0000000E+00 653 0 0.7525732E-01 -0.2645020E+00 0.0000000E+00 654 0 0.7320561E-01 -0.3162941E+00 0.0000000E+00 655 0 0.8004718E-01 -0.3403398E+00 0.0000000E+00 656 0 0.8894046E-01 -0.3125933E+00 0.0000000E+00 657 0 0.8464092E-01 -0.3649141E+00 0.0000000E+00 658 0 0.9148250E-01 -0.3889598E+00 0.0000000E+00 659 0 0.1026236E+00 -0.3606846E+00 0.0000000E+00 660 0 0.9607624E-01 -0.4135341E+00 0.0000000E+00 661 0 0.1029178E+00 -0.4375797E+00 0.0000000E+00 662 0 0.1163068E+00 -0.4087759E+00 0.0000000E+00 663 0 0.1075115E+00 -0.4621540E+00 0.0000000E+00 664 2 0.1143531E+00 -0.4861997E+00 0.0000000E+00 665 0 0.1299899E+00 -0.4568672E+00 0.0000000E+00 666 0 0.7033204E-01 -0.2134754E+00 0.0000000E+00 667 1 0.6349047E-01 -0.1894298E+00 0.0000000E+00 668 0 0.7936308E-01 -0.2367872E+00 0.0000000E+00 669 0 0.8127937E-01 -0.2098063E+00 0.0000000E+00 670 0 0.8620466E-01 -0.2608329E+00 0.0000000E+00 671 0 0.9523570E-01 -0.2841447E+00 0.0000000E+00 672 0 0.9934146E-01 -0.2564299E+00 0.0000000E+00 673 0 0.1020773E+00 -0.3081903E+00 0.0000000E+00 674 0 0.1111083E+00 -0.3315021E+00 0.0000000E+00 675 0 0.1174036E+00 -0.3030535E+00 0.0000000E+00 676 0 0.1179499E+00 -0.3555478E+00 0.0000000E+00 677 0 0.1269809E+00 -0.3788596E+00 0.0000000E+00 678 0 0.1354656E+00 -0.3496771E+00 0.0000000E+00 679 0 0.1338225E+00 -0.4029052E+00 0.0000000E+00 680 0 0.1428535E+00 -0.4262170E+00 0.0000000E+00 681 0 0.1535277E+00 -0.3963007E+00 0.0000000E+00 682 0 0.1496951E+00 -0.4502627E+00 0.0000000E+00 683 2 0.1587262E+00 -0.4735745E+00 0.0000000E+00 684 0 0.1715898E+00 -0.4429243E+00 0.0000000E+00 685 0 0.8972905E-01 -0.2060754E+00 0.0000000E+00 686 1 0.8069801E-01 -0.1827636E+00 0.0000000E+00 687 0 0.1008725E+00 -0.2284544E+00 0.0000000E+00 688 0 0.1002911E+00 -0.2014117E+00 0.0000000E+00 689 0 0.1099036E+00 -0.2517662E+00 0.0000000E+00 690 0 0.1210470E+00 -0.2741453E+00 0.0000000E+00 691 0 0.1225781E+00 -0.2461699E+00 0.0000000E+00 692 0 0.1300781E+00 -0.2974571E+00 0.0000000E+00 693 0 0.1412215E+00 -0.3198362E+00 0.0000000E+00 694 0 0.1448650E+00 -0.2909281E+00 0.0000000E+00 695 0 0.1502526E+00 -0.3431480E+00 0.0000000E+00 696 0 0.1613960E+00 -0.3655271E+00 0.0000000E+00 697 0 0.1671519E+00 -0.3356862E+00 0.0000000E+00 698 0 0.1704271E+00 -0.3888389E+00 0.0000000E+00 699 0 0.1815705E+00 -0.4112180E+00 0.0000000E+00 700 0 0.1894388E+00 -0.3804444E+00 0.0000000E+00 701 0 0.1906016E+00 -0.4345298E+00 0.0000000E+00 702 2 0.2017450E+00 -0.4569089E+00 0.0000000E+00 703 0 0.2117257E+00 -0.4252026E+00 0.0000000E+00 704 0 0.1083605E+00 -0.1969171E+00 0.0000000E+00 705 1 0.9721706E-01 -0.1745380E+00 0.0000000E+00 706 0 0.1215213E+00 -0.2181726E+00 0.0000000E+00 707 0 0.1184472E+00 -0.1912988E+00 0.0000000E+00 708 0 0.1326648E+00 -0.2405516E+00 0.0000000E+00 709 0 0.1458256E+00 -0.2618071E+00 0.0000000E+00 710 0 0.1447688E+00 -0.2338097E+00 0.0000000E+00 711 0 0.1569690E+00 -0.2841861E+00 0.0000000E+00 712 0 0.1701298E+00 -0.3054416E+00 0.0000000E+00 713 0 0.1710904E+00 -0.2763206E+00 0.0000000E+00 714 0 0.1812733E+00 -0.3278206E+00 0.0000000E+00 715 0 0.1944341E+00 -0.3490761E+00 0.0000000E+00 716 0 0.1974121E+00 -0.3188314E+00 0.0000000E+00 717 0 0.2055776E+00 -0.3714552E+00 0.0000000E+00 718 0 0.2187384E+00 -0.3927106E+00 0.0000000E+00 719 0 0.2237337E+00 -0.3613423E+00 0.0000000E+00 720 0 0.2298818E+00 -0.4150897E+00 0.0000000E+00 721 2 0.2430426E+00 -0.4363451E+00 0.0000000E+00 722 0 0.2500553E+00 -0.4038531E+00 0.0000000E+00 723 0 0.1260675E+00 -0.1860789E+00 0.0000000E+00 724 1 0.1129067E+00 -0.1648234E+00 0.0000000E+00 725 0 0.1411334E+00 -0.2060293E+00 0.0000000E+00 726 0 0.1355928E+00 -0.1795539E+00 0.0000000E+00 727 0 0.1542942E+00 -0.2272847E+00 0.0000000E+00 728 0 0.1693600E+00 -0.2472352E+00 0.0000000E+00 729 0 0.1657245E+00 -0.2194547E+00 0.0000000E+00 730 0 0.1825208E+00 -0.2684906E+00 0.0000000E+00 731 0 0.1975867E+00 -0.2884410E+00 0.0000000E+00 732 0 0.1958563E+00 -0.2593556E+00 0.0000000E+00 733 0 0.2107475E+00 -0.3096964E+00 0.0000000E+00 734 0 0.2258134E+00 -0.3296469E+00 0.0000000E+00 735 0 0.2259880E+00 -0.2992565E+00 0.0000000E+00 736 0 0.2389742E+00 -0.3509023E+00 0.0000000E+00 737 0 0.2540400E+00 -0.3708527E+00 0.0000000E+00 738 0 0.2561197E+00 -0.3391573E+00 0.0000000E+00 739 0 0.2672008E+00 -0.3921081E+00 0.0000000E+00 740 2 0.2822667E+00 -0.4120586E+00 0.0000000E+00 741 0 0.2862515E+00 -0.3790582E+00 0.0000000E+00 742 0 0.1426989E+00 -0.1736530E+00 0.0000000E+00 743 1 0.1276330E+00 -0.1537026E+00 0.0000000E+00 744 0 0.1595413E+00 -0.1921283E+00 0.0000000E+00 745 0 0.1515815E+00 -0.1662770E+00 0.0000000E+00 746 0 0.1746072E+00 -0.2120787E+00 0.0000000E+00 747 0 0.1914496E+00 -0.2305539E+00 0.0000000E+00 748 0 0.1852663E+00 -0.2032275E+00 0.0000000E+00 749 0 0.2065154E+00 -0.2505044E+00 0.0000000E+00 750 0 0.2233578E+00 -0.2689796E+00 0.0000000E+00 751 0 0.2189511E+00 -0.2401779E+00 0.0000000E+00 752 0 0.2384237E+00 -0.2889300E+00 0.0000000E+00 753 0 0.2552660E+00 -0.3074052E+00 0.0000000E+00 754 0 0.2526358E+00 -0.2771284E+00 0.0000000E+00 755 0 0.2703319E+00 -0.3273557E+00 0.0000000E+00 756 0 0.2871743E+00 -0.3458309E+00 0.0000000E+00 757 0 0.2863206E+00 -0.3140788E+00 0.0000000E+00 758 0 0.3022402E+00 -0.3657813E+00 0.0000000E+00 759 2 0.3190826E+00 -0.3842565E+00 0.0000000E+00 760 0 0.3200054E+00 -0.3510292E+00 0.0000000E+00 761 0 0.1581128E+00 -0.1597457E+00 0.0000000E+00 762 1 0.1412705E+00 -0.1412705E+00 0.0000000E+00 763 0 0.1765881E+00 -0.1765881E+00 0.0000000E+00 764 0 0.1662770E+00 -0.1515815E+00 0.0000000E+00 765 0 0.1934305E+00 -0.1950633E+00 0.0000000E+00 766 0 0.2119057E+00 -0.2119057E+00 0.0000000E+00 767 0 0.2032275E+00 -0.1852663E+00 0.0000000E+00 768 0 0.2287481E+00 -0.2303809E+00 0.0000000E+00 769 0 0.2472233E+00 -0.2472233E+00 0.0000000E+00 770 0 0.2401779E+00 -0.2189511E+00 0.0000000E+00 771 0 0.2640657E+00 -0.2656985E+00 0.0000000E+00 772 0 0.2825409E+00 -0.2825409E+00 0.0000000E+00 773 0 0.2771284E+00 -0.2526359E+00 0.0000000E+00 774 0 0.2993833E+00 -0.3010161E+00 0.0000000E+00 775 0 0.3178585E+00 -0.3178585E+00 0.0000000E+00 776 0 0.3140788E+00 -0.2863206E+00 0.0000000E+00 777 0 0.3347009E+00 -0.3363337E+00 0.0000000E+00 778 2 0.3531761E+00 -0.3531761E+00 0.0000000E+00 779 0 0.3510293E+00 -0.3200054E+00 0.0000000E+00 780 0 0.1721778E+00 -0.1444754E+00 0.0000000E+00 781 1 0.1537026E+00 -0.1276330E+00 0.0000000E+00 782 0 0.1921283E+00 -0.1595413E+00 0.0000000E+00 783 0 0.1795539E+00 -0.1355928E+00 0.0000000E+00 784 0 0.2106035E+00 -0.1763837E+00 0.0000000E+00 785 0 0.2305539E+00 -0.1914495E+00 0.0000000E+00 786 0 0.2194547E+00 -0.1657245E+00 0.0000000E+00 787 0 0.2490292E+00 -0.2082919E+00 0.0000000E+00 788 0 0.2689796E+00 -0.2233578E+00 0.0000000E+00 789 0 0.2593556E+00 -0.1958563E+00 0.0000000E+00 790 0 0.2874548E+00 -0.2402002E+00 0.0000000E+00 791 0 0.3074052E+00 -0.2552660E+00 0.0000000E+00 792 0 0.2992565E+00 -0.2259880E+00 0.0000000E+00 793 0 0.3258805E+00 -0.2721084E+00 0.0000000E+00 794 0 0.3458309E+00 -0.2871743E+00 0.0000000E+00 795 0 0.3391573E+00 -0.2561197E+00 0.0000000E+00 796 0 0.3643061E+00 -0.3040167E+00 0.0000000E+00 797 2 0.3842566E+00 -0.3190826E+00 0.0000000E+00 798 0 0.3790582E+00 -0.2862514E+00 0.0000000E+00 799 0 0.1847739E+00 -0.1279725E+00 0.0000000E+00 800 1 0.1648234E+00 -0.1129067E+00 0.0000000E+00 801 0 0.2060293E+00 -0.1411334E+00 0.0000000E+00 802 0 0.1912989E+00 -0.1184472E+00 0.0000000E+00 803 0 0.2259797E+00 -0.1561992E+00 0.0000000E+00 804 0 0.2472352E+00 -0.1693600E+00 0.0000000E+00 805 0 0.2338097E+00 -0.1447689E+00 0.0000000E+00 806 0 0.2671856E+00 -0.1844259E+00 0.0000000E+00 807 0 0.2884410E+00 -0.1975867E+00 0.0000000E+00 808 0 0.2763206E+00 -0.1710905E+00 0.0000000E+00 809 0 0.3083915E+00 -0.2126525E+00 0.0000000E+00 810 0 0.3296469E+00 -0.2258134E+00 0.0000000E+00 811 0 0.3188314E+00 -0.1974121E+00 0.0000000E+00 812 0 0.3495973E+00 -0.2408792E+00 0.0000000E+00 813 0 0.3708527E+00 -0.2540400E+00 0.0000000E+00 814 0 0.3613423E+00 -0.2237337E+00 0.0000000E+00 815 0 0.3908032E+00 -0.2691059E+00 0.0000000E+00 816 2 0.4120586E+00 -0.2822667E+00 0.0000000E+00 817 0 0.4038531E+00 -0.2500553E+00 0.0000000E+00 818 0 0.1957935E+00 -0.1103779E+00 0.0000000E+00 819 1 0.1745380E+00 -0.9721705E-01 0.0000000E+00 820 0 0.2181726E+00 -0.1215213E+00 0.0000000E+00 821 0 0.2014118E+00 -0.1002911E+00 0.0000000E+00 822 0 0.2394280E+00 -0.1346821E+00 0.0000000E+00 823 0 0.2618071E+00 -0.1458256E+00 0.0000000E+00 824 0 0.2461699E+00 -0.1225780E+00 0.0000000E+00 825 0 0.2830625E+00 -0.1589864E+00 0.0000000E+00 826 0 0.3054416E+00 -0.1701298E+00 0.0000000E+00 827 0 0.2909281E+00 -0.1448649E+00 0.0000000E+00 828 0 0.3266970E+00 -0.1832906E+00 0.0000000E+00 829 0 0.3490761E+00 -0.1944341E+00 0.0000000E+00 830 0 0.3356863E+00 -0.1671519E+00 0.0000000E+00 831 0 0.3703315E+00 -0.2075949E+00 0.0000000E+00 832 0 0.3927106E+00 -0.2187384E+00 0.0000000E+00 833 0 0.3804444E+00 -0.1894388E+00 0.0000000E+00 834 0 0.4139660E+00 -0.2318992E+00 0.0000000E+00 835 2 0.4363451E+00 -0.2430426E+00 0.0000000E+00 836 0 0.4252026E+00 -0.2117257E+00 0.0000000E+00 837 0 0.2051426E+00 -0.9184144E-01 0.0000000E+00 838 1 0.1827636E+00 -0.8069799E-01 0.0000000E+00 839 0 0.2284545E+00 -0.1008725E+00 0.0000000E+00 840 0 0.2098063E+00 -0.8127935E-01 0.0000000E+00 841 0 0.2508335E+00 -0.1120159E+00 0.0000000E+00 842 0 0.2741453E+00 -0.1210470E+00 0.0000000E+00 843 0 0.2564299E+00 -0.9934143E-01 0.0000000E+00 844 0 0.2965244E+00 -0.1321904E+00 0.0000000E+00 845 0 0.3198362E+00 -0.1412215E+00 0.0000000E+00 846 0 0.3030535E+00 -0.1174035E+00 0.0000000E+00 847 0 0.3422153E+00 -0.1523649E+00 0.0000000E+00 848 0 0.3655271E+00 -0.1613960E+00 0.0000000E+00 849 0 0.3496771E+00 -0.1354656E+00 0.0000000E+00 850 0 0.3879062E+00 -0.1725394E+00 0.0000000E+00 851 0 0.4112180E+00 -0.1815705E+00 0.0000000E+00 852 0 0.3963007E+00 -0.1535277E+00 0.0000000E+00 853 0 0.4335971E+00 -0.1927139E+00 0.0000000E+00 854 2 0.4569089E+00 -0.2017450E+00 0.0000000E+00 855 0 0.4429243E+00 -0.1715898E+00 0.0000000E+00 856 0 0.2127416E+00 -0.7252149E-01 0.0000000E+00 857 1 0.1894298E+00 -0.6349046E-01 0.0000000E+00 858 0 0.2367872E+00 -0.7936307E-01 0.0000000E+00 859 0 0.2164108E+00 -0.6157417E-01 0.0000000E+00 860 0 0.2600990E+00 -0.8839411E-01 0.0000000E+00 861 0 0.2841447E+00 -0.9523569E-01 0.0000000E+00 862 0 0.2645021E+00 -0.7525732E-01 0.0000000E+00 863 0 0.3074565E+00 -0.1042667E+00 0.0000000E+00 864 0 0.3315021E+00 -0.1111083E+00 0.0000000E+00 865 0 0.3125933E+00 -0.8894047E-01 0.0000000E+00 866 0 0.3548139E+00 -0.1201393E+00 0.0000000E+00 867 0 0.3788596E+00 -0.1269809E+00 0.0000000E+00 868 0 0.3606846E+00 -0.1026236E+00 0.0000000E+00 869 0 0.4021714E+00 -0.1360119E+00 0.0000000E+00 870 0 0.4262170E+00 -0.1428535E+00 0.0000000E+00 871 0 0.4087759E+00 -0.1163068E+00 0.0000000E+00 872 0 0.4495288E+00 -0.1518846E+00 0.0000000E+00 873 2 0.4735745E+00 -0.1587261E+00 0.0000000E+00 874 0 0.4568672E+00 -0.1299899E+00 0.0000000E+00 875 0 0.2185255E+00 -0.5258282E-01 0.0000000E+00 876 1 0.1944799E+00 -0.4574125E-01 0.0000000E+00 877 0 0.2430998E+00 -0.5717655E-01 0.0000000E+00 878 0 0.2211690E+00 -0.4134363E-01 0.0000000E+00 879 0 0.2671455E+00 -0.6401813E-01 0.0000000E+00 880 0 0.2917198E+00 -0.6861187E-01 0.0000000E+00 881 0 0.2703176E+00 -0.5053110E-01 0.0000000E+00 882 0 0.3157655E+00 -0.7545344E-01 0.0000000E+00 883 0 0.3403398E+00 -0.8004718E-01 0.0000000E+00 884 0 0.3194663E+00 -0.5971857E-01 0.0000000E+00 885 0 0.3643854E+00 -0.8688875E-01 0.0000000E+00 886 0 0.3889598E+00 -0.9148248E-01 0.0000000E+00 887 0 0.3686149E+00 -0.6890604E-01 0.0000000E+00 888 0 0.4130054E+00 -0.9832405E-01 0.0000000E+00 889 0 0.4375797E+00 -0.1029178E+00 0.0000000E+00 890 0 0.4177636E+00 -0.7809350E-01 0.0000000E+00 891 0 0.4616254E+00 -0.1097594E+00 0.0000000E+00 892 2 0.4861997E+00 -0.1143531E+00 0.0000000E+00 893 0 0.4669122E+00 -0.8728098E-01 0.0000000E+00 894 0 0.2224451E+00 -0.3219552E-01 0.0000000E+00 895 1 0.1978707E+00 -0.2760178E-01 0.0000000E+00 896 0 0.2473384E+00 -0.3450223E-01 0.0000000E+00 897 0 0.2240402E+00 -0.2076039E-01 0.0000000E+00 898 0 0.2719127E+00 -0.3909597E-01 0.0000000E+00 899 0 0.2968061E+00 -0.4140268E-01 0.0000000E+00 900 0 0.2738269E+00 -0.2537381E-01 0.0000000E+00 901 0 0.3213804E+00 -0.4599642E-01 0.0000000E+00 902 0 0.3462738E+00 -0.4830313E-01 0.0000000E+00 903 0 0.3236136E+00 -0.2998724E-01 0.0000000E+00 904 0 0.3708481E+00 -0.5289686E-01 0.0000000E+00 905 0 0.3957415E+00 -0.5520355E-01 0.0000000E+00 906 0 0.3734003E+00 -0.3460064E-01 0.0000000E+00 907 0 0.4203158E+00 -0.5979728E-01 0.0000000E+00 908 0 0.4452091E+00 -0.6210399E-01 0.0000000E+00 909 0 0.4231870E+00 -0.3921404E-01 0.0000000E+00 910 0 0.4697835E+00 -0.6669774E-01 0.0000000E+00 911 2 0.4946768E+00 -0.6900446E-01 0.0000000E+00 912 0 0.4729737E+00 -0.4382747E-01 0.0000000E+00 913 0 0.2244668E+00 -0.1153355E-01 0.0000000E+00 914 1 0.1995734E+00 -0.9226837E-02 0.0000000E+00 915 0 0.2494668E+00 -0.1153355E-01 0.0000000E+00 916 0 0.2250000E+00 0.0000000E+00 0.0000000E+00 917 0 0.2743601E+00 -0.1384026E-01 0.0000000E+00 918 0 0.2993601E+00 -0.1384026E-01 0.0000000E+00 919 0 0.2750000E+00 0.0000000E+00 0.0000000E+00 920 0 0.3242535E+00 -0.1614698E-01 0.0000000E+00 921 0 0.3492535E+00 -0.1614698E-01 0.0000000E+00 922 0 0.3250000E+00 0.0000000E+00 0.0000000E+00 923 0 0.3741468E+00 -0.1845367E-01 0.0000000E+00 924 0 0.3991468E+00 -0.1845366E-01 0.0000000E+00 925 0 0.3750000E+00 0.7450580E-08 0.0000000E+00 926 0 0.4240402E+00 -0.2076037E-01 0.0000000E+00 927 0 0.4490402E+00 -0.2076037E-01 0.0000000E+00 928 0 0.4250000E+00 0.1490116E-07 0.0000000E+00 929 0 0.4739335E+00 -0.2306709E-01 0.0000000E+00 930 2 0.4989335E+00 -0.2306709E-01 0.0000000E+00 931 0 0.4750000E+00 0.7450580E-08 0.0000000E+00 932 0 0.2245734E+00 0.9226836E-02 0.0000000E+00 933 1 0.1995734E+00 0.9226836E-02 0.0000000E+00 934 0 0.2494668E+00 0.1153355E-01 0.0000000E+00 935 0 0.2240402E+00 0.2076038E-01 0.0000000E+00 936 0 0.2744668E+00 0.1153355E-01 0.0000000E+00 937 0 0.2993601E+00 0.1384025E-01 0.0000000E+00 938 0 0.2738269E+00 0.2537380E-01 0.0000000E+00 939 0 0.3243601E+00 0.1384025E-01 0.0000000E+00 940 0 0.3492535E+00 0.1614696E-01 0.0000000E+00 941 0 0.3236136E+00 0.2998722E-01 0.0000000E+00 942 0 0.3742535E+00 0.1614697E-01 0.0000000E+00 943 0 0.3991468E+00 0.1845369E-01 0.0000000E+00 944 0 0.3734003E+00 0.3460064E-01 0.0000000E+00 945 0 0.4241468E+00 0.1845369E-01 0.0000000E+00 946 0 0.4490402E+00 0.2076039E-01 0.0000000E+00 947 0 0.4231870E+00 0.3921407E-01 0.0000000E+00 948 0 0.4740402E+00 0.2076039E-01 0.0000000E+00 949 2 0.4989335E+00 0.2306709E-01 0.0000000E+00 950 0 0.4729737E+00 0.4382748E-01 0.0000000E+00 951 0 0.2227641E+00 0.2990850E-01 0.0000000E+00 952 1 0.1978707E+00 0.2760179E-01 0.0000000E+00 953 0 0.2473384E+00 0.3450223E-01 0.0000000E+00 954 0 0.2211690E+00 0.4134364E-01 0.0000000E+00 955 0 0.2722318E+00 0.3680894E-01 0.0000000E+00 956 0 0.2968061E+00 0.4140268E-01 0.0000000E+00 957 0 0.2703176E+00 0.5053112E-01 0.0000000E+00 958 0 0.3216994E+00 0.4370939E-01 0.0000000E+00 959 0 0.3462738E+00 0.4830313E-01 0.0000000E+00 960 0 0.3194662E+00 0.5971859E-01 0.0000000E+00 961 0 0.3711671E+00 0.5060985E-01 0.0000000E+00 962 0 0.3957414E+00 0.5520359E-01 0.0000000E+00 963 0 0.3686149E+00 0.6890608E-01 0.0000000E+00 964 0 0.4206348E+00 0.5751030E-01 0.0000000E+00 965 0 0.4452091E+00 0.6210403E-01 0.0000000E+00 966 0 0.4177635E+00 0.7809355E-01 0.0000000E+00 967 0 0.4701025E+00 0.6441073E-01 0.0000000E+00 968 2 0.4946768E+00 0.6900447E-01 0.0000000E+00 969 0 0.4669122E+00 0.8728102E-01 0.0000000E+00 970 0 0.2190542E+00 0.5033499E-01 0.0000000E+00 971 1 0.1944799E+00 0.4574125E-01 0.0000000E+00 972 0 0.2430998E+00 0.5717656E-01 0.0000000E+00 973 0 0.2164108E+00 0.6157417E-01 0.0000000E+00 974 0 0.2676742E+00 0.6177030E-01 0.0000000E+00 975 0 0.2917198E+00 0.6861188E-01 0.0000000E+00 976 0 0.2645021E+00 0.7525732E-01 0.0000000E+00 977 0 0.3162941E+00 0.7320562E-01 0.0000000E+00 978 0 0.3403398E+00 0.8004719E-01 0.0000000E+00 979 0 0.3125933E+00 0.8894047E-01 0.0000000E+00 980 0 0.3649141E+00 0.8464093E-01 0.0000000E+00 981 0 0.3889597E+00 0.9148251E-01 0.0000000E+00 982 0 0.3606846E+00 0.1026236E+00 0.0000000E+00 983 0 0.4135341E+00 0.9607625E-01 0.0000000E+00 984 0 0.4375797E+00 0.1029178E+00 0.0000000E+00 985 0 0.4087759E+00 0.1163068E+00 0.0000000E+00 986 0 0.4621540E+00 0.1075116E+00 0.0000000E+00 987 2 0.4861997E+00 0.1143531E+00 0.0000000E+00 988 0 0.4568672E+00 0.1299899E+00 0.0000000E+00 989 0 0.2134754E+00 0.7033204E-01 0.0000000E+00 990 1 0.1894298E+00 0.6349047E-01 0.0000000E+00 991 0 0.2367872E+00 0.7936308E-01 0.0000000E+00 992 0 0.2098063E+00 0.8127937E-01 0.0000000E+00 993 0 0.2608329E+00 0.8620466E-01 0.0000000E+00 994 0 0.2841447E+00 0.9523570E-01 0.0000000E+00 995 0 0.2564299E+00 0.9934146E-01 0.0000000E+00 996 0 0.3081903E+00 0.1020773E+00 0.0000000E+00 997 0 0.3315021E+00 0.1111083E+00 0.0000000E+00 998 0 0.3030535E+00 0.1174035E+00 0.0000000E+00 999 0 0.3555478E+00 0.1179499E+00 0.0000000E+00 1000 0 0.3788596E+00 0.1269809E+00 0.0000000E+00 1001 0 0.3496771E+00 0.1354656E+00 0.0000000E+00 1002 0 0.4029052E+00 0.1338225E+00 0.0000000E+00 1003 0 0.4262170E+00 0.1428536E+00 0.0000000E+00 1004 0 0.3963007E+00 0.1535277E+00 0.0000000E+00 1005 0 0.4502627E+00 0.1496951E+00 0.0000000E+00 1006 2 0.4735745E+00 0.1587262E+00 0.0000000E+00 1007 0 0.4429243E+00 0.1715898E+00 0.0000000E+00 1008 0 0.2060754E+00 0.8972905E-01 0.0000000E+00 1009 1 0.1827636E+00 0.8069801E-01 0.0000000E+00 1010 0 0.2284544E+00 0.1008725E+00 0.0000000E+00 1011 0 0.2014117E+00 0.1002911E+00 0.0000000E+00 1012 0 0.2517662E+00 0.1099035E+00 0.0000000E+00 1013 0 0.2741453E+00 0.1210470E+00 0.0000000E+00 1014 0 0.2461699E+00 0.1225780E+00 0.0000000E+00 1015 0 0.2974571E+00 0.1300780E+00 0.0000000E+00 1016 0 0.3198362E+00 0.1412215E+00 0.0000000E+00 1017 0 0.2909281E+00 0.1448649E+00 0.0000000E+00 1018 0 0.3431480E+00 0.1502525E+00 0.0000000E+00 1019 0 0.3655271E+00 0.1613960E+00 0.0000000E+00 1020 0 0.3356862E+00 0.1671519E+00 0.0000000E+00 1021 0 0.3888389E+00 0.1704271E+00 0.0000000E+00 1022 0 0.4112180E+00 0.1815705E+00 0.0000000E+00 1023 0 0.3804444E+00 0.1894388E+00 0.0000000E+00 1024 0 0.4345298E+00 0.1906016E+00 0.0000000E+00 1025 2 0.4569089E+00 0.2017450E+00 0.0000000E+00 1026 0 0.4252025E+00 0.2117257E+00 0.0000000E+00 1027 0 0.1969171E+00 0.1083605E+00 0.0000000E+00 1028 1 0.1745380E+00 0.9721706E-01 0.0000000E+00 1029 0 0.2181726E+00 0.1215213E+00 0.0000000E+00 1030 0 0.1912988E+00 0.1184472E+00 0.0000000E+00 1031 0 0.2405516E+00 0.1326648E+00 0.0000000E+00 1032 0 0.2618071E+00 0.1458256E+00 0.0000000E+00 1033 0 0.2338097E+00 0.1447688E+00 0.0000000E+00 1034 0 0.2841862E+00 0.1569690E+00 0.0000000E+00 1035 0 0.3054416E+00 0.1701298E+00 0.0000000E+00 1036 0 0.2763206E+00 0.1710905E+00 0.0000000E+00 1037 0 0.3278206E+00 0.1812733E+00 0.0000000E+00 1038 0 0.3490761E+00 0.1944341E+00 0.0000000E+00 1039 0 0.3188314E+00 0.1974121E+00 0.0000000E+00 1040 0 0.3714551E+00 0.2055776E+00 0.0000000E+00 1041 0 0.3927106E+00 0.2187384E+00 0.0000000E+00 1042 0 0.3613423E+00 0.2237337E+00 0.0000000E+00 1043 0 0.4150897E+00 0.2298818E+00 0.0000000E+00 1044 2 0.4363451E+00 0.2430426E+00 0.0000000E+00 1045 0 0.4038531E+00 0.2500553E+00 0.0000000E+00 1046 0 0.1860789E+00 0.1260675E+00 0.0000000E+00 1047 1 0.1648234E+00 0.1129067E+00 0.0000000E+00 1048 0 0.2060293E+00 0.1411334E+00 0.0000000E+00 1049 0 0.1795539E+00 0.1355928E+00 0.0000000E+00 1050 0 0.2272847E+00 0.1542942E+00 0.0000000E+00 1051 0 0.2472351E+00 0.1693600E+00 0.0000000E+00 1052 0 0.2194547E+00 0.1657246E+00 0.0000000E+00 1053 0 0.2684906E+00 0.1825208E+00 0.0000000E+00 1054 0 0.2884410E+00 0.1975867E+00 0.0000000E+00 1055 0 0.2593556E+00 0.1958563E+00 0.0000000E+00 1056 0 0.3096964E+00 0.2107475E+00 0.0000000E+00 1057 0 0.3296469E+00 0.2258134E+00 0.0000000E+00 1058 0 0.2992564E+00 0.2259880E+00 0.0000000E+00 1059 0 0.3509023E+00 0.2389742E+00 0.0000000E+00 1060 0 0.3708527E+00 0.2540400E+00 0.0000000E+00 1061 0 0.3391573E+00 0.2561197E+00 0.0000000E+00 1062 0 0.3921081E+00 0.2672008E+00 0.0000000E+00 1063 2 0.4120586E+00 0.2822667E+00 0.0000000E+00 1064 0 0.3790582E+00 0.2862515E+00 0.0000000E+00 1065 0 0.1736530E+00 0.1426989E+00 0.0000000E+00 1066 1 0.1537026E+00 0.1276330E+00 0.0000000E+00 1067 0 0.1921283E+00 0.1595413E+00 0.0000000E+00 1068 0 0.1662770E+00 0.1515815E+00 0.0000000E+00 1069 0 0.2120787E+00 0.1746072E+00 0.0000000E+00 1070 0 0.2305539E+00 0.1914496E+00 0.0000000E+00 1071 0 0.2032275E+00 0.1852663E+00 0.0000000E+00 1072 0 0.2505043E+00 0.2065154E+00 0.0000000E+00 1073 0 0.2689795E+00 0.2233578E+00 0.0000000E+00 1074 0 0.2401779E+00 0.2189511E+00 0.0000000E+00 1075 0 0.2889300E+00 0.2384237E+00 0.0000000E+00 1076 0 0.3074052E+00 0.2552661E+00 0.0000000E+00 1077 0 0.2771283E+00 0.2526359E+00 0.0000000E+00 1078 0 0.3273556E+00 0.2703319E+00 0.0000000E+00 1079 0 0.3458309E+00 0.2871743E+00 0.0000000E+00 1080 0 0.3140788E+00 0.2863206E+00 0.0000000E+00 1081 0 0.3657813E+00 0.3022402E+00 0.0000000E+00 1082 2 0.3842565E+00 0.3190826E+00 0.0000000E+00 1083 0 0.3510292E+00 0.3200054E+00 0.0000000E+00 1084 0 0.1597457E+00 0.1581128E+00 0.0000000E+00 1085 1 0.1412705E+00 0.1412705E+00 0.0000000E+00 1086 0 0.1765881E+00 0.1765881E+00 0.0000000E+00 1087 0 0.1515815E+00 0.1662770E+00 0.0000000E+00 1088 0 0.1950633E+00 0.1934305E+00 0.0000000E+00 1089 0 0.2119057E+00 0.2119057E+00 0.0000000E+00 1090 0 0.1852663E+00 0.2032275E+00 0.0000000E+00 1091 0 0.2303809E+00 0.2287481E+00 0.0000000E+00 1092 0 0.2472233E+00 0.2472233E+00 0.0000000E+00 1093 0 0.2189511E+00 0.2401779E+00 0.0000000E+00 1094 0 0.2656985E+00 0.2640657E+00 0.0000000E+00 1095 0 0.2825409E+00 0.2825409E+00 0.0000000E+00 1096 0 0.2526358E+00 0.2771284E+00 0.0000000E+00 1097 0 0.3010161E+00 0.2993833E+00 0.0000000E+00 1098 0 0.3178585E+00 0.3178585E+00 0.0000000E+00 1099 0 0.2863206E+00 0.3140788E+00 0.0000000E+00 1100 0 0.3363337E+00 0.3347009E+00 0.0000000E+00 1101 2 0.3531761E+00 0.3531761E+00 0.0000000E+00 1102 0 0.3200054E+00 0.3510293E+00 0.0000000E+00 1103 0 0.1444754E+00 0.1721778E+00 0.0000000E+00 1104 1 0.1276330E+00 0.1537026E+00 0.0000000E+00 1105 0 0.1595413E+00 0.1921283E+00 0.0000000E+00 1106 0 0.1355928E+00 0.1795539E+00 0.0000000E+00 1107 0 0.1763837E+00 0.2106035E+00 0.0000000E+00 1108 0 0.1914496E+00 0.2305539E+00 0.0000000E+00 1109 0 0.1657245E+00 0.2194547E+00 0.0000000E+00 1110 0 0.2082919E+00 0.2490291E+00 0.0000000E+00 1111 0 0.2233578E+00 0.2689796E+00 0.0000000E+00 1112 0 0.1958563E+00 0.2593556E+00 0.0000000E+00 1113 0 0.2402002E+00 0.2874548E+00 0.0000000E+00 1114 0 0.2552660E+00 0.3074053E+00 0.0000000E+00 1115 0 0.2259880E+00 0.2992565E+00 0.0000000E+00 1116 0 0.2721084E+00 0.3258805E+00 0.0000000E+00 1117 0 0.2871743E+00 0.3458309E+00 0.0000000E+00 1118 0 0.2561197E+00 0.3391573E+00 0.0000000E+00 1119 0 0.3040167E+00 0.3643061E+00 0.0000000E+00 1120 2 0.3190826E+00 0.3842566E+00 0.0000000E+00 1121 0 0.2862514E+00 0.3790582E+00 0.0000000E+00 1122 0 0.1279726E+00 0.1847739E+00 0.0000000E+00 1123 1 0.1129067E+00 0.1648234E+00 0.0000000E+00 1124 0 0.1411334E+00 0.2060293E+00 0.0000000E+00 1125 0 0.1184472E+00 0.1912988E+00 0.0000000E+00 1126 0 0.1561992E+00 0.2259797E+00 0.0000000E+00 1127 0 0.1693600E+00 0.2472351E+00 0.0000000E+00 1128 0 0.1447689E+00 0.2338097E+00 0.0000000E+00 1129 0 0.1844259E+00 0.2671856E+00 0.0000000E+00 1130 0 0.1975867E+00 0.2884410E+00 0.0000000E+00 1131 0 0.1710905E+00 0.2763206E+00 0.0000000E+00 1132 0 0.2126525E+00 0.3083915E+00 0.0000000E+00 1133 0 0.2258134E+00 0.3296469E+00 0.0000000E+00 1134 0 0.1974121E+00 0.3188314E+00 0.0000000E+00 1135 0 0.2408792E+00 0.3495973E+00 0.0000000E+00 1136 0 0.2540400E+00 0.3708527E+00 0.0000000E+00 1137 0 0.2237337E+00 0.3613423E+00 0.0000000E+00 1138 0 0.2691059E+00 0.3908032E+00 0.0000000E+00 1139 2 0.2822667E+00 0.4120586E+00 0.0000000E+00 1140 0 0.2500553E+00 0.4038531E+00 0.0000000E+00 1141 0 0.1103779E+00 0.1957935E+00 0.0000000E+00 1142 1 0.9721705E-01 0.1745380E+00 0.0000000E+00 1143 0 0.1215213E+00 0.2181726E+00 0.0000000E+00 1144 0 0.1002911E+00 0.2014117E+00 0.0000000E+00 1145 0 0.1346821E+00 0.2394280E+00 0.0000000E+00 1146 0 0.1458256E+00 0.2618071E+00 0.0000000E+00 1147 0 0.1225780E+00 0.2461699E+00 0.0000000E+00 1148 0 0.1589864E+00 0.2830625E+00 0.0000000E+00 1149 0 0.1701298E+00 0.3054416E+00 0.0000000E+00 1150 0 0.1448650E+00 0.2909281E+00 0.0000000E+00 1151 0 0.1832906E+00 0.3266970E+00 0.0000000E+00 1152 0 0.1944341E+00 0.3490761E+00 0.0000000E+00 1153 0 0.1671519E+00 0.3356863E+00 0.0000000E+00 1154 0 0.2075949E+00 0.3703315E+00 0.0000000E+00 1155 0 0.2187384E+00 0.3927106E+00 0.0000000E+00 1156 0 0.1894388E+00 0.3804444E+00 0.0000000E+00 1157 0 0.2318992E+00 0.4139660E+00 0.0000000E+00 1158 2 0.2430426E+00 0.4363451E+00 0.0000000E+00 1159 0 0.2117257E+00 0.4252026E+00 0.0000000E+00 1160 0 0.9184145E-01 0.2051426E+00 0.0000000E+00 1161 1 0.8069799E-01 0.1827636E+00 0.0000000E+00 1162 0 0.1008725E+00 0.2284544E+00 0.0000000E+00 1163 0 0.8127936E-01 0.2098063E+00 0.0000000E+00 1164 0 0.1120159E+00 0.2508335E+00 0.0000000E+00 1165 0 0.1210470E+00 0.2741453E+00 0.0000000E+00 1166 0 0.9934144E-01 0.2564299E+00 0.0000000E+00 1167 0 0.1321904E+00 0.2965244E+00 0.0000000E+00 1168 0 0.1412215E+00 0.3198362E+00 0.0000000E+00 1169 0 0.1174035E+00 0.3030535E+00 0.0000000E+00 1170 0 0.1523649E+00 0.3422153E+00 0.0000000E+00 1171 0 0.1613960E+00 0.3655271E+00 0.0000000E+00 1172 0 0.1354656E+00 0.3496771E+00 0.0000000E+00 1173 0 0.1725394E+00 0.3879062E+00 0.0000000E+00 1174 0 0.1815705E+00 0.4112180E+00 0.0000000E+00 1175 0 0.1535277E+00 0.3963007E+00 0.0000000E+00 1176 0 0.1927139E+00 0.4335971E+00 0.0000000E+00 1177 2 0.2017450E+00 0.4569089E+00 0.0000000E+00 1178 0 0.1715898E+00 0.4429243E+00 0.0000000E+00 1179 0 0.7252150E-01 0.2127416E+00 0.0000000E+00 1180 1 0.6349046E-01 0.1894298E+00 0.0000000E+00 1181 0 0.7936308E-01 0.2367872E+00 0.0000000E+00 1182 0 0.6157418E-01 0.2164108E+00 0.0000000E+00 1183 0 0.8839412E-01 0.2600990E+00 0.0000000E+00 1184 0 0.9523570E-01 0.2841447E+00 0.0000000E+00 1185 0 0.7525734E-01 0.2645020E+00 0.0000000E+00 1186 0 0.1042667E+00 0.3074565E+00 0.0000000E+00 1187 0 0.1111083E+00 0.3315021E+00 0.0000000E+00 1188 0 0.8894050E-01 0.3125933E+00 0.0000000E+00 1189 0 0.1201394E+00 0.3548139E+00 0.0000000E+00 1190 0 0.1269809E+00 0.3788596E+00 0.0000000E+00 1191 0 0.1026236E+00 0.3606846E+00 0.0000000E+00 1192 0 0.1360120E+00 0.4021714E+00 0.0000000E+00 1193 0 0.1428535E+00 0.4262170E+00 0.0000000E+00 1194 0 0.1163068E+00 0.4087759E+00 0.0000000E+00 1195 0 0.1518846E+00 0.4495288E+00 0.0000000E+00 1196 2 0.1587261E+00 0.4735745E+00 0.0000000E+00 1197 0 0.1299899E+00 0.4568672E+00 0.0000000E+00 1198 0 0.5258283E-01 0.2185255E+00 0.0000000E+00 1199 1 0.4574125E-01 0.1944799E+00 0.0000000E+00 1200 0 0.5717656E-01 0.2430998E+00 0.0000000E+00 1201 0 0.4134363E-01 0.2211690E+00 0.0000000E+00 1202 0 0.6401814E-01 0.2671455E+00 0.0000000E+00 1203 0 0.6861188E-01 0.2917198E+00 0.0000000E+00 1204 0 0.5053110E-01 0.2703176E+00 0.0000000E+00 1205 0 0.7545346E-01 0.3157655E+00 0.0000000E+00 1206 0 0.8004720E-01 0.3403398E+00 0.0000000E+00 1207 0 0.5971857E-01 0.3194663E+00 0.0000000E+00 1208 0 0.8688875E-01 0.3643854E+00 0.0000000E+00 1209 0 0.9148248E-01 0.3889598E+00 0.0000000E+00 1210 0 0.6890604E-01 0.3686149E+00 0.0000000E+00 1211 0 0.9832405E-01 0.4130054E+00 0.0000000E+00 1212 0 0.1029178E+00 0.4375797E+00 0.0000000E+00 1213 0 0.7809351E-01 0.4177636E+00 0.0000000E+00 1214 0 0.1097594E+00 0.4616254E+00 0.0000000E+00 1215 2 0.1143531E+00 0.4861997E+00 0.0000000E+00 1216 0 0.8728099E-01 0.4669122E+00 0.0000000E+00 1217 0 0.3219552E-01 0.2224451E+00 0.0000000E+00 1218 1 0.2760178E-01 0.1978707E+00 0.0000000E+00 1219 0 0.3450223E-01 0.2473384E+00 0.0000000E+00 1220 0 0.2076038E-01 0.2240402E+00 0.0000000E+00 1221 0 0.3909597E-01 0.2719127E+00 0.0000000E+00 1222 0 0.4140267E-01 0.2968061E+00 0.0000000E+00 1223 0 0.2537380E-01 0.2738269E+00 0.0000000E+00 1224 0 0.4599641E-01 0.3213804E+00 0.0000000E+00 1225 0 0.4830312E-01 0.3462738E+00 0.0000000E+00 1226 0 0.2998722E-01 0.3236136E+00 0.0000000E+00 1227 0 0.5289685E-01 0.3708481E+00 0.0000000E+00 1228 0 0.5520356E-01 0.3957415E+00 0.0000000E+00 1229 0 0.3460064E-01 0.3734003E+00 0.0000000E+00 1230 0 0.5979730E-01 0.4203158E+00 0.0000000E+00 1231 0 0.6210401E-01 0.4452091E+00 0.0000000E+00 1232 0 0.3921406E-01 0.4231870E+00 0.0000000E+00 1233 0 0.6669774E-01 0.4697835E+00 0.0000000E+00 1234 2 0.6900446E-01 0.4946768E+00 0.0000000E+00 1235 0 0.4382747E-01 0.4729737E+00 0.0000000E+00 1236 0 0.1153355E-01 0.2244668E+00 0.0000000E+00 1237 1 0.9226837E-02 0.1995734E+00 0.0000000E+00 1238 0 0.1153355E-01 0.2494668E+00 0.0000000E+00 1239 0 0.0000000E+00 0.2250000E+00 0.0000000E+00 1240 0 0.1384026E-01 0.2743601E+00 0.0000000E+00 1241 0 0.1384026E-01 0.2993601E+00 0.0000000E+00 1242 0 0.0000000E+00 0.2750000E+00 0.0000000E+00 1243 0 0.1614696E-01 0.3242535E+00 0.0000000E+00 1244 0 0.1614696E-01 0.3492535E+00 0.0000000E+00 1245 0 0.0000000E+00 0.3250000E+00 0.0000000E+00 1246 0 0.1845367E-01 0.3741468E+00 0.0000000E+00 1247 0 0.1845367E-01 0.3991468E+00 0.0000000E+00 1248 0 0.0000000E+00 0.3750000E+00 0.0000000E+00 1249 0 0.2076038E-01 0.4240402E+00 0.0000000E+00 1250 0 0.2076038E-01 0.4490402E+00 0.0000000E+00 1251 0 0.0000000E+00 0.4250000E+00 0.0000000E+00 1252 0 0.2076038E-01 0.4740402E+00 0.0000000E+00 1253 0 0.0000000E+00 0.4750000E+00 0.0000000E+00 1254 2 0.2306709E-01 0.4989335E+00 0.0000000E+00 1255 0 0.3296502E-01 -0.1023964E+01 0.0000000E+00 1256 0 0.6436028E-01 -0.1022977E+01 0.0000000E+00 1257 3 0.3139526E-01 -0.9990134E+00 0.0000000E+00 1258 0 0.0000000E+00 -0.1025000E+01 0.0000000E+00 1259 0 0.3296502E-01 -0.1048964E+01 0.0000000E+00 1260 0 0.0000000E+00 -0.1075000E+01 0.0000000E+00 1261 0 0.3296502E-01 -0.1073964E+01 0.0000000E+00 1262 0 0.3453479E-01 -0.1098915E+01 0.0000000E+00 1263 0 0.6749981E-01 -0.1072879E+01 0.0000000E+00 1264 0 0.0000000E+00 -0.1125000E+01 0.0000000E+00 1265 0 0.3453479E-01 -0.1123915E+01 0.0000000E+00 1266 0 0.3610455E-01 -0.1148865E+01 0.0000000E+00 1267 0 0.7063934E-01 -0.1122780E+01 0.0000000E+00 1268 0 0.0000000E+00 -0.1175000E+01 0.0000000E+00 1269 0 0.3610455E-01 -0.1173865E+01 0.0000000E+00 1270 0 0.3767432E-01 -0.1198816E+01 0.0000000E+00 1271 0 0.7377887E-01 -0.1172681E+01 0.0000000E+00 1272 0 0.0000000E+00 -0.1225000E+01 0.0000000E+00 1273 0 0.3767432E-01 -0.1223816E+01 0.0000000E+00 1274 0 0.3924408E-01 -0.1248767E+01 0.0000000E+00 1275 0 0.7691839E-01 -0.1222583E+01 0.0000000E+00 1276 0 0.0000000E+00 -0.1275000E+01 0.0000000E+00 1277 0 0.3924408E-01 -0.1273767E+01 0.0000000E+00 1278 4 0.4081384E-01 -0.1298717E+01 0.0000000E+00 1279 0 0.8005792E-01 -0.1272484E+01 0.0000000E+00 1280 0 0.9563164E-01 -0.1020021E+01 0.0000000E+00 1281 3 0.9406188E-01 -0.9950707E+00 0.0000000E+00 1282 0 0.9876496E-01 -0.1044824E+01 0.0000000E+00 1283 0 0.1284666E+00 -0.1016918E+01 0.0000000E+00 1284 0 0.1003347E+00 -0.1069775E+01 0.0000000E+00 1285 0 0.1034681E+00 -0.1094578E+01 0.0000000E+00 1286 0 0.1347332E+00 -0.1066523E+01 0.0000000E+00 1287 0 0.1050378E+00 -0.1119528E+01 0.0000000E+00 1288 0 0.1081712E+00 -0.1144331E+01 0.0000000E+00 1289 0 0.1409999E+00 -0.1116129E+01 0.0000000E+00 1290 0 0.1097409E+00 -0.1169282E+01 0.0000000E+00 1291 0 0.1128743E+00 -0.1194085E+01 0.0000000E+00 1292 0 0.1472666E+00 -0.1165735E+01 0.0000000E+00 1293 0 0.1144440E+00 -0.1219036E+01 0.0000000E+00 1294 0 0.1175774E+00 -0.1243838E+01 0.0000000E+00 1295 0 0.1535332E+00 -0.1215340E+01 0.0000000E+00 1296 0 0.1191471E+00 -0.1268789E+01 0.0000000E+00 1297 4 0.1222804E+00 -0.1293592E+01 0.0000000E+00 1298 0 0.1597999E+00 -0.1264946E+01 0.0000000E+00 1299 0 0.1594906E+00 -0.1012004E+01 0.0000000E+00 1300 3 0.1563573E+00 -0.9872010E+00 0.0000000E+00 1301 0 0.1641751E+00 -0.1036561E+01 0.0000000E+00 1302 0 0.1920658E+00 -0.1006844E+01 0.0000000E+00 1303 0 0.1673085E+00 -0.1061364E+01 0.0000000E+00 1304 0 0.1719930E+00 -0.1085921E+01 0.0000000E+00 1305 0 0.2014349E+00 -0.1055959E+01 0.0000000E+00 1306 0 0.1751264E+00 -0.1110724E+01 0.0000000E+00 1307 0 0.1798109E+00 -0.1135281E+01 0.0000000E+00 1308 0 0.2108040E+00 -0.1105073E+01 0.0000000E+00 1309 0 0.1829442E+00 -0.1160084E+01 0.0000000E+00 1310 0 0.1876287E+00 -0.1184641E+01 0.0000000E+00 1311 0 0.2201731E+00 -0.1154187E+01 0.0000000E+00 1312 0 0.1907621E+00 -0.1209444E+01 0.0000000E+00 1313 0 0.1954466E+00 -0.1234001E+01 0.0000000E+00 1314 0 0.2295421E+00 -0.1203302E+01 0.0000000E+00 1315 0 0.1985799E+00 -0.1258804E+01 0.0000000E+00 1316 4 0.2032645E+00 -0.1283361E+01 0.0000000E+00 1317 0 0.2389112E+00 -0.1252416E+01 0.0000000E+00 1318 0 0.2227201E+00 -0.9999923E+00 0.0000000E+00 1319 3 0.2180356E+00 -0.9754352E+00 0.0000000E+00 1320 0 0.2289374E+00 -0.1024207E+01 0.0000000E+00 1321 0 0.2549072E+00 -0.9927977E+00 0.0000000E+00 1322 0 0.2336219E+00 -0.1048764E+01 0.0000000E+00 1323 0 0.2398392E+00 -0.1072979E+01 0.0000000E+00 1324 0 0.2673417E+00 -0.1041227E+01 0.0000000E+00 1325 0 0.2445237E+00 -0.1097536E+01 0.0000000E+00 1326 0 0.2507410E+00 -0.1121750E+01 0.0000000E+00 1327 0 0.2797762E+00 -0.1089656E+01 0.0000000E+00 1328 0 0.2554255E+00 -0.1146308E+01 0.0000000E+00 1329 0 0.2616427E+00 -0.1170522E+01 0.0000000E+00 1330 0 0.2922106E+00 -0.1138085E+01 0.0000000E+00 1331 0 0.2663273E+00 -0.1195079E+01 0.0000000E+00 1332 0 0.2725445E+00 -0.1219294E+01 0.0000000E+00 1333 0 0.3046451E+00 -0.1186514E+01 0.0000000E+00 1334 0 0.2772290E+00 -0.1243851E+01 0.0000000E+00 1335 4 0.2834463E+00 -0.1268066E+01 0.0000000E+00 1336 0 0.3170796E+00 -0.1234943E+01 0.0000000E+00 1337 0 0.2850707E+00 -0.9840344E+00 0.0000000E+00 1338 3 0.2788535E+00 -0.9598199E+00 0.0000000E+00 1339 0 0.2927961E+00 -0.1007811E+01 0.0000000E+00 1340 0 0.3167424E+00 -0.9748329E+00 0.0000000E+00 1341 0 0.2990134E+00 -0.1032025E+01 0.0000000E+00 1342 0 0.3067388E+00 -0.1055802E+01 0.0000000E+00 1343 0 0.3321933E+00 -0.1022386E+01 0.0000000E+00 1344 0 0.3129561E+00 -0.1080016E+01 0.0000000E+00 1345 0 0.3206815E+00 -0.1103793E+01 0.0000000E+00 1346 0 0.3476441E+00 -0.1069939E+01 0.0000000E+00 1347 0 0.3268987E+00 -0.1128007E+01 0.0000000E+00 1348 0 0.3346241E+00 -0.1151784E+01 0.0000000E+00 1349 0 0.3630950E+00 -0.1117491E+01 0.0000000E+00 1350 0 0.3408414E+00 -0.1175998E+01 0.0000000E+00 1351 0 0.3485668E+00 -0.1199775E+01 0.0000000E+00 1352 0 0.3785458E+00 -0.1165044E+01 0.0000000E+00 1353 0 0.3547841E+00 -0.1223989E+01 0.0000000E+00 1354 4 0.3625095E+00 -0.1247766E+01 0.0000000E+00 1355 0 0.3939967E+00 -0.1212597E+01 0.0000000E+00 1356 0 0.3462962E+00 -0.9641929E+00 0.0000000E+00 1357 3 0.3385708E+00 -0.9404165E+00 0.0000000E+00 1358 0 0.3554993E+00 -0.9874373E+00 0.0000000E+00 1359 0 0.3773277E+00 -0.9530209E+00 0.0000000E+00 1360 0 0.3632247E+00 -0.1011214E+01 0.0000000E+00 1361 0 0.3724279E+00 -0.1034458E+01 0.0000000E+00 1362 0 0.3957339E+00 -0.9995097E+00 0.0000000E+00 1363 0 0.3801533E+00 -0.1058235E+01 0.0000000E+00 1364 0 0.3893564E+00 -0.1081479E+01 0.0000000E+00 1365 0 0.4141401E+00 -0.1045999E+01 0.0000000E+00 1366 0 0.3970818E+00 -0.1105255E+01 0.0000000E+00 1367 0 0.4062849E+00 -0.1128500E+01 0.0000000E+00 1368 0 0.4325463E+00 -0.1092487E+01 0.0000000E+00 1369 0 0.4140103E+00 -0.1152276E+01 0.0000000E+00 1370 0 0.4232135E+00 -0.1175521E+01 0.0000000E+00 1371 0 0.4509526E+00 -0.1138976E+01 0.0000000E+00 1372 0 0.4309389E+00 -0.1199297E+01 0.0000000E+00 1373 4 0.4401420E+00 -0.1222541E+01 0.0000000E+00 1374 0 0.4693588E+00 -0.1185465E+01 0.0000000E+00 1375 0 0.4061550E+00 -0.9405462E+00 0.0000000E+00 1376 3 0.3969519E+00 -0.9173018E+00 0.0000000E+00 1377 0 0.4167995E+00 -0.9631668E+00 0.0000000E+00 1378 0 0.4364238E+00 -0.9274477E+00 0.0000000E+00 1379 0 0.4260027E+00 -0.9864112E+00 0.0000000E+00 1380 0 0.4366471E+00 -0.1009032E+01 0.0000000E+00 1381 0 0.4577127E+00 -0.9726891E+00 0.0000000E+00 1382 0 0.4458502E+00 -0.1032276E+01 0.0000000E+00 1383 0 0.4564947E+00 -0.1054897E+01 0.0000000E+00 1384 0 0.4790017E+00 -0.1017930E+01 0.0000000E+00 1385 0 0.4656978E+00 -0.1078141E+01 0.0000000E+00 1386 0 0.4763423E+00 -0.1100762E+01 0.0000000E+00 1387 0 0.5002906E+00 -0.1063172E+01 0.0000000E+00 1388 0 0.4855454E+00 -0.1124007E+01 0.0000000E+00 1389 0 0.4961899E+00 -0.1146627E+01 0.0000000E+00 1390 0 0.5215796E+00 -0.1108413E+01 0.0000000E+00 1391 0 0.5053930E+00 -0.1169872E+01 0.0000000E+00 1392 4 0.5160375E+00 -0.1192492E+01 0.0000000E+00 1393 0 0.5428686E+00 -0.1153654E+01 0.0000000E+00 1394 0 0.4644110E+00 -0.9131875E+00 0.0000000E+00 1395 3 0.4537665E+00 -0.8905669E+00 0.0000000E+00 1396 0 0.4764548E+00 -0.9350951E+00 0.0000000E+00 1397 0 0.4937975E+00 -0.8982143E+00 0.0000000E+00 1398 0 0.4870993E+00 -0.9577158E+00 0.0000000E+00 1399 0 0.4991432E+00 -0.9796236E+00 0.0000000E+00 1400 0 0.5178852E+00 -0.9420296E+00 0.0000000E+00 1401 0 0.5097876E+00 -0.1002244E+01 0.0000000E+00 1402 0 0.5218315E+00 -0.1024152E+01 0.0000000E+00 1403 0 0.5419730E+00 -0.9858450E+00 0.0000000E+00 1404 0 0.5324760E+00 -0.1046773E+01 0.0000000E+00 1405 0 0.5445198E+00 -0.1068680E+01 0.0000000E+00 1406 0 0.5660606E+00 -0.1029660E+01 0.0000000E+00 1407 0 0.5551642E+00 -0.1091301E+01 0.0000000E+00 1408 0 0.5672081E+00 -0.1113209E+01 0.0000000E+00 1409 0 0.5901482E+00 -0.1073476E+01 0.0000000E+00 1410 0 0.5778526E+00 -0.1135829E+01 0.0000000E+00 1411 4 0.5898964E+00 -0.1157737E+01 0.0000000E+00 1412 0 0.6142359E+00 -0.1117291E+01 0.0000000E+00 1413 0 0.5208341E+00 -0.8822249E+00 0.0000000E+00 1414 3 0.5087903E+00 -0.8603173E+00 0.0000000E+00 1415 0 0.5342298E+00 -0.9033331E+00 0.0000000E+00 1416 0 0.5492225E+00 -0.8654361E+00 0.0000000E+00 1417 0 0.5462736E+00 -0.9252408E+00 0.0000000E+00 1418 0 0.5596693E+00 -0.9463490E+00 0.0000000E+00 1419 0 0.5760138E+00 -0.9076525E+00 0.0000000E+00 1420 0 0.5717131E+00 -0.9682567E+00 0.0000000E+00 1421 0 0.5851088E+00 -0.9893649E+00 0.0000000E+00 1422 0 0.6028051E+00 -0.9498689E+00 0.0000000E+00 1423 0 0.5971526E+00 -0.1011272E+01 0.0000000E+00 1424 0 0.6105483E+00 -0.1032381E+01 0.0000000E+00 1425 0 0.6295965E+00 -0.9920852E+00 0.0000000E+00 1426 0 0.6225922E+00 -0.1054288E+01 0.0000000E+00 1427 0 0.6359878E+00 -0.1075397E+01 0.0000000E+00 1428 0 0.6563878E+00 -0.1034302E+01 0.0000000E+00 1429 0 0.6480316E+00 -0.1097304E+01 0.0000000E+00 1430 4 0.6614273E+00 -0.1118412E+01 0.0000000E+00 1431 0 0.6831791E+00 -0.1076518E+01 0.0000000E+00 1432 0 0.5752017E+00 -0.8477806E+00 0.0000000E+00 1433 3 0.5618060E+00 -0.8266725E+00 0.0000000E+00 1434 0 0.5898963E+00 -0.8680060E+00 0.0000000E+00 1435 0 0.6024799E+00 -0.8292424E+00 0.0000000E+00 1436 0 0.6032920E+00 -0.8891142E+00 0.0000000E+00 1437 0 0.6179866E+00 -0.9093397E+00 0.0000000E+00 1438 0 0.6318692E+00 -0.8696932E+00 0.0000000E+00 1439 0 0.6313823E+00 -0.9304479E+00 0.0000000E+00 1440 0 0.6460769E+00 -0.9506733E+00 0.0000000E+00 1441 0 0.6612584E+00 -0.9101441E+00 0.0000000E+00 1442 0 0.6594726E+00 -0.9717814E+00 0.0000000E+00 1443 0 0.6741672E+00 -0.9920068E+00 0.0000000E+00 1444 0 0.6906477E+00 -0.9505949E+00 0.0000000E+00 1445 0 0.6875629E+00 -0.1013115E+01 0.0000000E+00 1446 0 0.7022575E+00 -0.1033341E+01 0.0000000E+00 1447 0 0.7200369E+00 -0.9910458E+00 0.0000000E+00 1448 0 0.7156532E+00 -0.1054449E+01 0.0000000E+00 1449 4 0.7303478E+00 -0.1074674E+01 0.0000000E+00 1450 0 0.7494262E+00 -0.1031497E+01 0.0000000E+00 1451 0 0.6272993E+00 -0.8099905E+00 0.0000000E+00 1452 3 0.6126046E+00 -0.7897651E+00 0.0000000E+00 1453 0 0.6432349E+00 -0.8292533E+00 0.0000000E+00 1454 0 0.6533597E+00 -0.7897760E+00 0.0000000E+00 1455 0 0.6579295E+00 -0.8494788E+00 0.0000000E+00 1456 0 0.6738652E+00 -0.8687416E+00 0.0000000E+00 1457 0 0.6852309E+00 -0.8283017E+00 0.0000000E+00 1458 0 0.6885598E+00 -0.8889670E+00 0.0000000E+00 1459 0 0.7044953E+00 -0.9082298E+00 0.0000000E+00 1460 0 0.7171021E+00 -0.8668273E+00 0.0000000E+00 1461 0 0.7191900E+00 -0.9284552E+00 0.0000000E+00 1462 0 0.7351255E+00 -0.9477181E+00 0.0000000E+00 1463 0 0.7489732E+00 -0.9053530E+00 0.0000000E+00 1464 0 0.7498202E+00 -0.9679435E+00 0.0000000E+00 1465 0 0.7657558E+00 -0.9872064E+00 0.0000000E+00 1466 0 0.7808444E+00 -0.9438787E+00 0.0000000E+00 1467 0 0.7804504E+00 -0.1007432E+01 0.0000000E+00 1468 4 0.7963860E+00 -0.1026695E+01 0.0000000E+00 1469 0 0.8127156E+00 -0.9824043E+00 0.0000000E+00 1470 0 0.6769212E+00 -0.7690037E+00 0.0000000E+00 1471 3 0.6609856E+00 -0.7497409E+00 0.0000000E+00 1472 0 0.6940349E+00 -0.7872279E+00 0.0000000E+00 1473 0 0.7016608E+00 -0.7471928E+00 0.0000000E+00 1474 0 0.7099705E+00 -0.8064907E+00 0.0000000E+00 1475 0 0.7270842E+00 -0.8247150E+00 0.0000000E+00 1476 0 0.7358882E+00 -0.7836412E+00 0.0000000E+00 1477 0 0.7430198E+00 -0.8439778E+00 0.0000000E+00 1478 0 0.7601334E+00 -0.8622020E+00 0.0000000E+00 1479 0 0.7701156E+00 -0.8200897E+00 0.0000000E+00 1480 0 0.7760690E+00 -0.8814649E+00 0.0000000E+00 1481 0 0.7931826E+00 -0.8996890E+00 0.0000000E+00 1482 0 0.8043428E+00 -0.8565381E+00 0.0000000E+00 1483 0 0.8091183E+00 -0.9189519E+00 0.0000000E+00 1484 0 0.8262320E+00 -0.9371762E+00 0.0000000E+00 1485 0 0.8385702E+00 -0.8929866E+00 0.0000000E+00 1486 0 0.8421676E+00 -0.9564390E+00 0.0000000E+00 1487 4 0.8592812E+00 -0.9746632E+00 0.0000000E+00 1488 0 0.8727976E+00 -0.9294350E+00 0.0000000E+00 1489 0 0.7238716E+00 -0.7249820E+00 0.0000000E+00 1490 3 0.7067579E+00 -0.7067578E+00 0.0000000E+00 1491 0 0.7420958E+00 -0.7420957E+00 0.0000000E+00 1492 0 0.7471929E+00 -0.7016607E+00 0.0000000E+00 1493 0 0.7592095E+00 -0.7603199E+00 0.0000000E+00 1494 0 0.7774338E+00 -0.7774336E+00 0.0000000E+00 1495 0 0.7836413E+00 -0.7358881E+00 0.0000000E+00 1496 0 0.7945474E+00 -0.7956578E+00 0.0000000E+00 1497 0 0.8127716E+00 -0.8127715E+00 0.0000000E+00 1498 0 0.8200898E+00 -0.7701154E+00 0.0000000E+00 1499 0 0.8298852E+00 -0.8309957E+00 0.0000000E+00 1500 0 0.8481094E+00 -0.8481094E+00 0.0000000E+00 1501 0 0.8565381E+00 -0.8043427E+00 0.0000000E+00 1502 0 0.8652231E+00 -0.8663336E+00 0.0000000E+00 1503 0 0.8834473E+00 -0.8834473E+00 0.0000000E+00 1504 0 0.8929866E+00 -0.8385701E+00 0.0000000E+00 1505 0 0.9005610E+00 -0.9016715E+00 0.0000000E+00 1506 4 0.9187852E+00 -0.9187852E+00 0.0000000E+00 1507 0 0.9294350E+00 -0.8727975E+00 0.0000000E+00 1508 0 0.7679652E+00 -0.6780992E+00 0.0000000E+00 1509 3 0.7497410E+00 -0.6609855E+00 0.0000000E+00 1510 0 0.7872280E+00 -0.6940348E+00 0.0000000E+00 1511 0 0.7897761E+00 -0.6533596E+00 0.0000000E+00 1512 0 0.8054522E+00 -0.7111484E+00 0.0000000E+00 1513 0 0.8247151E+00 -0.7270841E+00 0.0000000E+00 1514 0 0.8283017E+00 -0.6852308E+00 0.0000000E+00 1515 0 0.8429393E+00 -0.7441977E+00 0.0000000E+00 1516 0 0.8622020E+00 -0.7601333E+00 0.0000000E+00 1517 0 0.8668274E+00 -0.7171020E+00 0.0000000E+00 1518 0 0.8804263E+00 -0.7772470E+00 0.0000000E+00 1519 0 0.8996891E+00 -0.7931826E+00 0.0000000E+00 1520 0 0.9053530E+00 -0.7489731E+00 0.0000000E+00 1521 0 0.9179133E+00 -0.8102962E+00 0.0000000E+00 1522 0 0.9371762E+00 -0.8262319E+00 0.0000000E+00 1523 0 0.9438787E+00 -0.7808443E+00 0.0000000E+00 1524 0 0.9554004E+00 -0.8433456E+00 0.0000000E+00 1525 4 0.9746632E+00 -0.8592812E+00 0.0000000E+00 1526 0 0.9824044E+00 -0.8127155E+00 0.0000000E+00 1527 0 0.8090279E+00 -0.6285402E+00 0.0000000E+00 1528 3 0.7897651E+00 -0.6126046E+00 0.0000000E+00 1529 0 0.8292533E+00 -0.6432348E+00 0.0000000E+00 1530 0 0.8292424E+00 -0.6024798E+00 0.0000000E+00 1531 0 0.8485162E+00 -0.6591704E+00 0.0000000E+00 1532 0 0.8687417E+00 -0.6738651E+00 0.0000000E+00 1533 0 0.8696933E+00 -0.6318691E+00 0.0000000E+00 1534 0 0.8880045E+00 -0.6898006E+00 0.0000000E+00 1535 0 0.9082299E+00 -0.7044953E+00 0.0000000E+00 1536 0 0.9101442E+00 -0.6612583E+00 0.0000000E+00 1537 0 0.9274927E+00 -0.7204308E+00 0.0000000E+00 1538 0 0.9477181E+00 -0.7351255E+00 0.0000000E+00 1539 0 0.9505949E+00 -0.6906476E+00 0.0000000E+00 1540 0 0.9669809E+00 -0.7510611E+00 0.0000000E+00 1541 0 0.9872064E+00 -0.7657557E+00 0.0000000E+00 1542 0 0.9910458E+00 -0.7200369E+00 0.0000000E+00 1543 0 0.1006469E+01 -0.7816913E+00 0.0000000E+00 1544 4 0.1026695E+01 -0.7963859E+00 0.0000000E+00 1545 0 0.1031497E+01 -0.7494261E+00 0.0000000E+00 1546 0 0.8468979E+00 -0.5765006E+00 0.0000000E+00 1547 3 0.8266725E+00 -0.5618060E+00 0.0000000E+00 1548 0 0.8680061E+00 -0.5898962E+00 0.0000000E+00 1549 0 0.8654361E+00 -0.5492224E+00 0.0000000E+00 1550 0 0.8882315E+00 -0.6045909E+00 0.0000000E+00 1551 0 0.9093398E+00 -0.6179866E+00 0.0000000E+00 1552 0 0.9076525E+00 -0.5760137E+00 0.0000000E+00 1553 0 0.9295652E+00 -0.6326812E+00 0.0000000E+00 1554 0 0.9506733E+00 -0.6460768E+00 0.0000000E+00 1555 0 0.9498689E+00 -0.6028051E+00 0.0000000E+00 1556 0 0.9708987E+00 -0.6607715E+00 0.0000000E+00 1557 0 0.9920069E+00 -0.6741671E+00 0.0000000E+00 1558 0 0.9920853E+00 -0.6295964E+00 0.0000000E+00 1559 0 0.1012232E+01 -0.6888617E+00 0.0000000E+00 1560 0 0.1033341E+01 -0.7022575E+00 0.0000000E+00 1561 0 0.1034302E+01 -0.6563877E+00 0.0000000E+00 1562 0 0.1053566E+01 -0.7169521E+00 0.0000000E+00 1563 4 0.1074674E+01 -0.7303478E+00 0.0000000E+00 1564 0 0.1076518E+01 -0.6831791E+00 0.0000000E+00 1565 0 0.8814255E+00 -0.5221858E+00 0.0000000E+00 1566 3 0.8603173E+00 -0.5087902E+00 0.0000000E+00 1567 0 0.9033331E+00 -0.5342296E+00 0.0000000E+00 1568 0 0.8982143E+00 -0.4937974E+00 0.0000000E+00 1569 0 0.9244414E+00 -0.5476254E+00 0.0000000E+00 1570 0 0.9463491E+00 -0.5596692E+00 0.0000000E+00 1571 0 0.9420297E+00 -0.5178851E+00 0.0000000E+00 1572 0 0.9674572E+00 -0.5730648E+00 0.0000000E+00 1573 0 0.9893649E+00 -0.5851087E+00 0.0000000E+00 1574 0 0.9858450E+00 -0.5419728E+00 0.0000000E+00 1575 0 0.1010473E+01 -0.5985043E+00 0.0000000E+00 1576 0 0.1032381E+01 -0.6105481E+00 0.0000000E+00 1577 0 0.1029660E+01 -0.5660604E+00 0.0000000E+00 1578 0 0.1053489E+01 -0.6239438E+00 0.0000000E+00 1579 0 0.1075397E+01 -0.6359877E+00 0.0000000E+00 1580 0 0.1073476E+01 -0.5901481E+00 0.0000000E+00 1581 0 0.1096505E+01 -0.6493834E+00 0.0000000E+00 1582 4 0.1118412E+01 -0.6614272E+00 0.0000000E+00 1583 0 0.1117291E+01 -0.6142358E+00 0.0000000E+00 1584 0 0.9124745E+00 -0.4658103E+00 0.0000000E+00 1585 3 0.8905669E+00 -0.4537665E+00 0.0000000E+00 1586 0 0.9350952E+00 -0.4764547E+00 0.0000000E+00 1587 0 0.9274477E+00 -0.4364238E+00 0.0000000E+00 1588 0 0.9570029E+00 -0.4884986E+00 0.0000000E+00 1589 0 0.9796236E+00 -0.4991431E+00 0.0000000E+00 1590 0 0.9726891E+00 -0.4577127E+00 0.0000000E+00 1591 0 0.1001531E+01 -0.5111869E+00 0.0000000E+00 1592 0 0.1024152E+01 -0.5218314E+00 0.0000000E+00 1593 0 0.1017930E+01 -0.4790017E+00 0.0000000E+00 1594 0 0.1046060E+01 -0.5338752E+00 0.0000000E+00 1595 0 0.1068680E+01 -0.5445197E+00 0.0000000E+00 1596 0 0.1063172E+01 -0.5002906E+00 0.0000000E+00 1597 0 0.1090588E+01 -0.5565635E+00 0.0000000E+00 1598 0 0.1113209E+01 -0.5672080E+00 0.0000000E+00 1599 0 0.1108413E+01 -0.5215796E+00 0.0000000E+00 1600 0 0.1135116E+01 -0.5792519E+00 0.0000000E+00 1601 4 0.1157737E+01 -0.5898964E+00 0.0000000E+00 1602 0 0.1153654E+01 -0.5428686E+00 0.0000000E+00 1603 0 0.9399224E+00 -0.4075964E+00 0.0000000E+00 1604 3 0.9173018E+00 -0.3969519E+00 0.0000000E+00 1605 0 0.9631668E+00 -0.4167995E+00 0.0000000E+00 1606 0 0.9530209E+00 -0.3773277E+00 0.0000000E+00 1607 0 0.9857875E+00 -0.4274440E+00 0.0000000E+00 1608 0 0.1009032E+01 -0.4366471E+00 0.0000000E+00 1609 0 0.9995097E+00 -0.3957339E+00 0.0000000E+00 1610 0 0.1031653E+01 -0.4472916E+00 0.0000000E+00 1611 0 0.1054897E+01 -0.4564947E+00 0.0000000E+00 1612 0 0.1045999E+01 -0.4141401E+00 0.0000000E+00 1613 0 0.1077518E+01 -0.4671392E+00 0.0000000E+00 1614 0 0.1100762E+01 -0.4763422E+00 0.0000000E+00 1615 0 0.1092487E+01 -0.4325463E+00 0.0000000E+00 1616 0 0.1123383E+01 -0.4869867E+00 0.0000000E+00 1617 0 0.1146627E+01 -0.4961898E+00 0.0000000E+00 1618 0 0.1138976E+01 -0.4509525E+00 0.0000000E+00 1619 0 0.1169248E+01 -0.5068343E+00 0.0000000E+00 1620 4 0.1192492E+01 -0.5160375E+00 0.0000000E+00 1621 0 0.1185465E+01 -0.4693588E+00 0.0000000E+00 1622 0 0.9636609E+00 -0.3477739E+00 0.0000000E+00 1623 3 0.9404165E+00 -0.3385708E+00 0.0000000E+00 1624 0 0.9874373E+00 -0.3554993E+00 0.0000000E+00 1625 0 0.9748329E+00 -0.3167424E+00 0.0000000E+00 1626 0 0.1010682E+01 -0.3647024E+00 0.0000000E+00 1627 0 0.1034458E+01 -0.3724278E+00 0.0000000E+00 1628 0 0.1022386E+01 -0.3321932E+00 0.0000000E+00 1629 0 0.1057703E+01 -0.3816309E+00 0.0000000E+00 1630 0 0.1081479E+01 -0.3893563E+00 0.0000000E+00 1631 0 0.1069939E+01 -0.3476440E+00 0.0000000E+00 1632 0 0.1104723E+01 -0.3985594E+00 0.0000000E+00 1633 0 0.1128500E+01 -0.4062848E+00 0.0000000E+00 1634 0 0.1117491E+01 -0.3630949E+00 0.0000000E+00 1635 0 0.1151744E+01 -0.4154880E+00 0.0000000E+00 1636 0 0.1175521E+01 -0.4232134E+00 0.0000000E+00 1637 0 0.1165044E+01 -0.3785457E+00 0.0000000E+00 1638 0 0.1198765E+01 -0.4324165E+00 0.0000000E+00 1639 4 0.1222541E+01 -0.4401420E+00 0.0000000E+00 1640 0 0.1212597E+01 -0.3939966E+00 0.0000000E+00 1641 0 0.9835962E+00 -0.2865788E+00 0.0000000E+00 1642 3 0.9598199E+00 -0.2788534E+00 0.0000000E+00 1643 0 0.1007811E+01 -0.2927960E+00 0.0000000E+00 1644 0 0.9927978E+00 -0.2549070E+00 0.0000000E+00 1645 0 0.1031587E+01 -0.3005214E+00 0.0000000E+00 1646 0 0.1055802E+01 -0.3067387E+00 0.0000000E+00 1647 0 0.1041227E+01 -0.2673415E+00 0.0000000E+00 1648 0 0.1079578E+01 -0.3144641E+00 0.0000000E+00 1649 0 0.1103793E+01 -0.3206813E+00 0.0000000E+00 1650 0 0.1089656E+01 -0.2797760E+00 0.0000000E+00 1651 0 0.1127569E+01 -0.3284068E+00 0.0000000E+00 1652 0 0.1151784E+01 -0.3346240E+00 0.0000000E+00 1653 0 0.1138085E+01 -0.2922105E+00 0.0000000E+00 1654 0 0.1175560E+01 -0.3423495E+00 0.0000000E+00 1655 0 0.1199775E+01 -0.3485668E+00 0.0000000E+00 1656 0 0.1186514E+01 -0.3046450E+00 0.0000000E+00 1657 0 0.1223551E+01 -0.3562922E+00 0.0000000E+00 1658 4 0.1247766E+01 -0.3625094E+00 0.0000000E+00 1659 0 0.1234944E+01 -0.3170795E+00 0.0000000E+00 1660 0 0.9996498E+00 -0.2242527E+00 0.0000000E+00 1661 3 0.9754352E+00 -0.2180355E+00 0.0000000E+00 1662 0 0.1024207E+01 -0.2289372E+00 0.0000000E+00 1663 0 0.1006844E+01 -0.1920657E+00 0.0000000E+00 1664 0 0.1048422E+01 -0.2351545E+00 0.0000000E+00 1665 0 0.1072979E+01 -0.2398391E+00 0.0000000E+00 1666 0 0.1055959E+01 -0.2014348E+00 0.0000000E+00 1667 0 0.1097193E+01 -0.2460563E+00 0.0000000E+00 1668 0 0.1121750E+01 -0.2507408E+00 0.0000000E+00 1669 0 0.1105073E+01 -0.2108038E+00 0.0000000E+00 1670 0 0.1145965E+01 -0.2569580E+00 0.0000000E+00 1671 0 0.1170522E+01 -0.2616426E+00 0.0000000E+00 1672 0 0.1154187E+01 -0.2201729E+00 0.0000000E+00 1673 0 0.1194737E+01 -0.2678599E+00 0.0000000E+00 1674 0 0.1219294E+01 -0.2725445E+00 0.0000000E+00 1675 0 0.1203302E+01 -0.2295420E+00 0.0000000E+00 1676 0 0.1243509E+01 -0.2787617E+00 0.0000000E+00 1677 4 0.1268066E+01 -0.2834462E+00 0.0000000E+00 1678 0 0.1252416E+01 -0.2389111E+00 0.0000000E+00 1679 0 0.1011758E+01 -0.1610417E+00 0.0000000E+00 1680 3 0.9872010E+00 -0.1563572E+00 0.0000000E+00 1681 0 0.1036561E+01 -0.1641750E+00 0.0000000E+00 1682 0 0.1016918E+01 -0.1284665E+00 0.0000000E+00 1683 0 0.1061118E+01 -0.1688596E+00 0.0000000E+00 1684 0 0.1085921E+01 -0.1719930E+00 0.0000000E+00 1685 0 0.1066523E+01 -0.1347332E+00 0.0000000E+00 1686 0 0.1110478E+01 -0.1766775E+00 0.0000000E+00 1687 0 0.1135281E+01 -0.1798108E+00 0.0000000E+00 1688 0 0.1116129E+01 -0.1409999E+00 0.0000000E+00 1689 0 0.1159838E+01 -0.1844953E+00 0.0000000E+00 1690 0 0.1184641E+01 -0.1876286E+00 0.0000000E+00 1691 0 0.1165735E+01 -0.1472665E+00 0.0000000E+00 1692 0 0.1209198E+01 -0.1923132E+00 0.0000000E+00 1693 0 0.1234001E+01 -0.1954466E+00 0.0000000E+00 1694 0 0.1215340E+01 -0.1535332E+00 0.0000000E+00 1695 0 0.1258558E+01 -0.2001311E+00 0.0000000E+00 1696 4 0.1283361E+01 -0.2032644E+00 0.0000000E+00 1697 0 0.1264946E+01 -0.1597999E+00 0.0000000E+00 1698 0 0.1019874E+01 -0.9719517E-01 0.0000000E+00 1699 3 0.9950707E+00 -0.9406187E-01 0.0000000E+00 1700 0 0.1044824E+01 -0.9876490E-01 0.0000000E+00 1701 0 0.1022977E+01 -0.6436023E-01 0.0000000E+00 1702 0 0.1069627E+01 -0.1018983E+00 0.0000000E+00 1703 0 0.1094578E+01 -0.1034681E+00 0.0000000E+00 1704 0 0.1072879E+01 -0.6749975E-01 0.0000000E+00 1705 0 0.1119381E+01 -0.1066014E+00 0.0000000E+00 1706 0 0.1144331E+01 -0.1081711E+00 0.0000000E+00 1707 0 0.1122780E+01 -0.7063927E-01 0.0000000E+00 1708 0 0.1169134E+01 -0.1113044E+00 0.0000000E+00 1709 0 0.1194085E+01 -0.1128742E+00 0.0000000E+00 1710 0 0.1172681E+01 -0.7377879E-01 0.0000000E+00 1711 0 0.1218888E+01 -0.1160076E+00 0.0000000E+00 1712 0 0.1243838E+01 -0.1175774E+00 0.0000000E+00 1713 0 0.1222583E+01 -0.7691838E-01 0.0000000E+00 1714 0 0.1268641E+01 -0.1207107E+00 0.0000000E+00 1715 4 0.1293592E+01 -0.1222804E+00 0.0000000E+00 1716 0 0.1272484E+01 -0.8005792E-01 0.0000000E+00 1717 0 0.1023964E+01 -0.3296498E-01 0.0000000E+00 1718 3 0.9990134E+00 -0.3139525E-01 0.0000000E+00 1719 0 0.1048964E+01 -0.3296495E-01 0.0000000E+00 1720 0 0.1025000E+01 0.3040868E-07 0.0000000E+00 1721 0 0.1073915E+01 -0.3453474E-01 0.0000000E+00 1722 0 0.1098915E+01 -0.3453476E-01 0.0000000E+00 1723 0 0.1075000E+01 0.3976525E-07 0.0000000E+00 1724 0 0.1123865E+01 -0.3610449E-01 0.0000000E+00 1725 0 0.1148865E+01 -0.3610446E-01 0.0000000E+00 1726 0 0.1125000E+01 0.4678267E-07 0.0000000E+00 1727 0 0.1173816E+01 -0.3767425E-01 0.0000000E+00 1728 0 0.1198816E+01 -0.3767428E-01 0.0000000E+00 1729 0 0.1175000E+01 0.4678262E-07 0.0000000E+00 1730 0 0.1223767E+01 -0.3924408E-01 0.0000000E+00 1731 0 0.1248767E+01 -0.3924411E-01 0.0000000E+00 1732 0 0.1225000E+01 -0.1403477E-07 0.0000000E+00 1733 0 0.1273717E+01 -0.4081385E-01 0.0000000E+00 1734 4 0.1298717E+01 -0.4081383E-01 0.0000000E+00 1735 0 0.1275000E+01 -0.2339128E-07 0.0000000E+00 1736 0 0.1024013E+01 0.3139529E-01 0.0000000E+00 1737 3 0.9990134E+00 0.3139526E-01 0.0000000E+00 1738 0 0.1048964E+01 0.3296509E-01 0.0000000E+00 1739 0 0.1022977E+01 0.6436032E-01 0.0000000E+00 1740 0 0.1073964E+01 0.3296507E-01 0.0000000E+00 1741 0 0.1098915E+01 0.3453478E-01 0.0000000E+00 1742 0 0.1072879E+01 0.6749983E-01 0.0000000E+00 1743 0 0.1123915E+01 0.3453480E-01 0.0000000E+00 1744 0 0.1148865E+01 0.3610460E-01 0.0000000E+00 1745 0 0.1122780E+01 0.7063933E-01 0.0000000E+00 1746 0 0.1173865E+01 0.3610457E-01 0.0000000E+00 1747 0 0.1198816E+01 0.3767437E-01 0.0000000E+00 1748 0 0.1172681E+01 0.7377892E-01 0.0000000E+00 1749 0 0.1223816E+01 0.3767434E-01 0.0000000E+00 1750 0 0.1248767E+01 0.3924402E-01 0.0000000E+00 1751 0 0.1222583E+01 0.7691840E-01 0.0000000E+00 1752 0 0.1273767E+01 0.3924404E-01 0.0000000E+00 1753 4 0.1298717E+01 0.4081384E-01 0.0000000E+00 1754 0 0.1272484E+01 0.8005788E-01 0.0000000E+00 1755 0 0.1020021E+01 0.9563168E-01 0.0000000E+00 1756 3 0.9950707E+00 0.9406188E-01 0.0000000E+00 1757 0 0.1044824E+01 0.9876503E-01 0.0000000E+00 1758 0 0.1016918E+01 0.1284666E+00 0.0000000E+00 1759 0 0.1069775E+01 0.1003347E+00 0.0000000E+00 1760 0 0.1094578E+01 0.1034681E+00 0.0000000E+00 1761 0 0.1066523E+01 0.1347333E+00 0.0000000E+00 1762 0 0.1119528E+01 0.1050379E+00 0.0000000E+00 1763 0 0.1144331E+01 0.1081711E+00 0.0000000E+00 1764 0 0.1116129E+01 0.1409999E+00 0.0000000E+00 1765 0 0.1169282E+01 0.1097409E+00 0.0000000E+00 1766 0 0.1194085E+01 0.1128743E+00 0.0000000E+00 1767 0 0.1165735E+01 0.1472665E+00 0.0000000E+00 1768 0 0.1219036E+01 0.1144439E+00 0.0000000E+00 1769 0 0.1243838E+01 0.1175773E+00 0.0000000E+00 1770 0 0.1215340E+01 0.1535332E+00 0.0000000E+00 1771 0 0.1268789E+01 0.1191471E+00 0.0000000E+00 1772 4 0.1293592E+01 0.1222804E+00 0.0000000E+00 1773 0 0.1264946E+01 0.1597999E+00 0.0000000E+00 1774 0 0.1012004E+01 0.1594906E+00 0.0000000E+00 1775 3 0.9872010E+00 0.1563573E+00 0.0000000E+00 1776 0 0.1036561E+01 0.1641752E+00 0.0000000E+00 1777 0 0.1006844E+01 0.1920659E+00 0.0000000E+00 1778 0 0.1061364E+01 0.1673085E+00 0.0000000E+00 1779 0 0.1085921E+01 0.1719930E+00 0.0000000E+00 1780 0 0.1055959E+01 0.2014349E+00 0.0000000E+00 1781 0 0.1110724E+01 0.1751263E+00 0.0000000E+00 1782 0 0.1135281E+01 0.1798108E+00 0.0000000E+00 1783 0 0.1105073E+01 0.2108040E+00 0.0000000E+00 1784 0 0.1160084E+01 0.1829442E+00 0.0000000E+00 1785 0 0.1184641E+01 0.1876287E+00 0.0000000E+00 1786 0 0.1154187E+01 0.2201731E+00 0.0000000E+00 1787 0 0.1209444E+01 0.1907621E+00 0.0000000E+00 1788 0 0.1234001E+01 0.1954466E+00 0.0000000E+00 1789 0 0.1203302E+01 0.2295421E+00 0.0000000E+00 1790 0 0.1258804E+01 0.1985799E+00 0.0000000E+00 1791 4 0.1283361E+01 0.2032645E+00 0.0000000E+00 1792 0 0.1252416E+01 0.2389111E+00 0.0000000E+00 1793 0 0.9999923E+00 0.2227202E+00 0.0000000E+00 1794 3 0.9754352E+00 0.2180356E+00 0.0000000E+00 1795 0 0.1024207E+01 0.2289374E+00 0.0000000E+00 1796 0 0.9927977E+00 0.2549072E+00 0.0000000E+00 1797 0 0.1048764E+01 0.2336219E+00 0.0000000E+00 1798 0 0.1072979E+01 0.2398392E+00 0.0000000E+00 1799 0 0.1041227E+01 0.2673417E+00 0.0000000E+00 1800 0 0.1097536E+01 0.2445238E+00 0.0000000E+00 1801 0 0.1121750E+01 0.2507410E+00 0.0000000E+00 1802 0 0.1089656E+01 0.2797762E+00 0.0000000E+00 1803 0 0.1146308E+01 0.2554256E+00 0.0000000E+00 1804 0 0.1170522E+01 0.2616427E+00 0.0000000E+00 1805 0 0.1138085E+01 0.2922106E+00 0.0000000E+00 1806 0 0.1195079E+01 0.2663272E+00 0.0000000E+00 1807 0 0.1219294E+01 0.2725445E+00 0.0000000E+00 1808 0 0.1186514E+01 0.3046451E+00 0.0000000E+00 1809 0 0.1243851E+01 0.2772290E+00 0.0000000E+00 1810 4 0.1268066E+01 0.2834463E+00 0.0000000E+00 1811 0 0.1234943E+01 0.3170796E+00 0.0000000E+00 1812 0 0.9840344E+00 0.2850707E+00 0.0000000E+00 1813 3 0.9598199E+00 0.2788535E+00 0.0000000E+00 1814 0 0.1007811E+01 0.2927961E+00 0.0000000E+00 1815 0 0.9748329E+00 0.3167424E+00 0.0000000E+00 1816 0 0.1032025E+01 0.2990134E+00 0.0000000E+00 1817 0 0.1055802E+01 0.3067388E+00 0.0000000E+00 1818 0 0.1022386E+01 0.3321933E+00 0.0000000E+00 1819 0 0.1080016E+01 0.3129561E+00 0.0000000E+00 1820 0 0.1103793E+01 0.3206815E+00 0.0000000E+00 1821 0 0.1069939E+01 0.3476441E+00 0.0000000E+00 1822 0 0.1128007E+01 0.3268987E+00 0.0000000E+00 1823 0 0.1151784E+01 0.3346241E+00 0.0000000E+00 1824 0 0.1117491E+01 0.3630950E+00 0.0000000E+00 1825 0 0.1175998E+01 0.3408414E+00 0.0000000E+00 1826 0 0.1199775E+01 0.3485668E+00 0.0000000E+00 1827 0 0.1165044E+01 0.3785458E+00 0.0000000E+00 1828 0 0.1223989E+01 0.3547841E+00 0.0000000E+00 1829 4 0.1247766E+01 0.3625095E+00 0.0000000E+00 1830 0 0.1212597E+01 0.3939967E+00 0.0000000E+00 1831 0 0.9641929E+00 0.3462962E+00 0.0000000E+00 1832 3 0.9404165E+00 0.3385708E+00 0.0000000E+00 1833 0 0.9874373E+00 0.3554993E+00 0.0000000E+00 1834 0 0.9530209E+00 0.3773277E+00 0.0000000E+00 1835 0 0.1011214E+01 0.3632247E+00 0.0000000E+00 1836 0 0.1034458E+01 0.3724279E+00 0.0000000E+00 1837 0 0.9995097E+00 0.3957339E+00 0.0000000E+00 1838 0 0.1058235E+01 0.3801533E+00 0.0000000E+00 1839 0 0.1081479E+01 0.3893564E+00 0.0000000E+00 1840 0 0.1045999E+01 0.4141401E+00 0.0000000E+00 1841 0 0.1105255E+01 0.3970818E+00 0.0000000E+00 1842 0 0.1128500E+01 0.4062849E+00 0.0000000E+00 1843 0 0.1092487E+01 0.4325463E+00 0.0000000E+00 1844 0 0.1152276E+01 0.4140103E+00 0.0000000E+00 1845 0 0.1175521E+01 0.4232135E+00 0.0000000E+00 1846 0 0.1138976E+01 0.4509526E+00 0.0000000E+00 1847 0 0.1199297E+01 0.4309389E+00 0.0000000E+00 1848 4 0.1222541E+01 0.4401420E+00 0.0000000E+00 1849 0 0.1185465E+01 0.4693588E+00 0.0000000E+00 1850 0 0.9405462E+00 0.4061550E+00 0.0000000E+00 1851 3 0.9173018E+00 0.3969519E+00 0.0000000E+00 1852 0 0.9631668E+00 0.4167995E+00 0.0000000E+00 1853 0 0.9274477E+00 0.4364238E+00 0.0000000E+00 1854 0 0.9864113E+00 0.4260026E+00 0.0000000E+00 1855 0 0.1009032E+01 0.4366471E+00 0.0000000E+00 1856 0 0.9726891E+00 0.4577128E+00 0.0000000E+00 1857 0 0.1032276E+01 0.4458503E+00 0.0000000E+00 1858 0 0.1054897E+01 0.4564947E+00 0.0000000E+00 1859 0 0.1017930E+01 0.4790017E+00 0.0000000E+00 1860 0 0.1078141E+01 0.4656978E+00 0.0000000E+00 1861 0 0.1100762E+01 0.4763422E+00 0.0000000E+00 1862 0 0.1063172E+01 0.5002906E+00 0.0000000E+00 1863 0 0.1124007E+01 0.4855454E+00 0.0000000E+00 1864 0 0.1146627E+01 0.4961899E+00 0.0000000E+00 1865 0 0.1108413E+01 0.5215796E+00 0.0000000E+00 1866 0 0.1169872E+01 0.5053930E+00 0.0000000E+00 1867 4 0.1192492E+01 0.5160375E+00 0.0000000E+00 1868 0 0.1153655E+01 0.5428686E+00 0.0000000E+00 1869 0 0.9131875E+00 0.4644110E+00 0.0000000E+00 1870 3 0.8905669E+00 0.4537665E+00 0.0000000E+00 1871 0 0.9350951E+00 0.4764549E+00 0.0000000E+00 1872 0 0.8982143E+00 0.4937976E+00 0.0000000E+00 1873 0 0.9577158E+00 0.4870994E+00 0.0000000E+00 1874 0 0.9796236E+00 0.4991432E+00 0.0000000E+00 1875 0 0.9420296E+00 0.5178852E+00 0.0000000E+00 1876 0 0.1002244E+01 0.5097876E+00 0.0000000E+00 1877 0 0.1024152E+01 0.5218314E+00 0.0000000E+00 1878 0 0.9858450E+00 0.5419729E+00 0.0000000E+00 1879 0 0.1046773E+01 0.5324759E+00 0.0000000E+00 1880 0 0.1068680E+01 0.5445198E+00 0.0000000E+00 1881 0 0.1029660E+01 0.5660606E+00 0.0000000E+00 1882 0 0.1091301E+01 0.5551643E+00 0.0000000E+00 1883 0 0.1113209E+01 0.5672081E+00 0.0000000E+00 1884 0 0.1073476E+01 0.5901483E+00 0.0000000E+00 1885 0 0.1135829E+01 0.5778525E+00 0.0000000E+00 1886 4 0.1157737E+01 0.5898964E+00 0.0000000E+00 1887 0 0.1117291E+01 0.6142359E+00 0.0000000E+00 1888 0 0.8822249E+00 0.5208341E+00 0.0000000E+00 1889 3 0.8603173E+00 0.5087903E+00 0.0000000E+00 1890 0 0.9033331E+00 0.5342298E+00 0.0000000E+00 1891 0 0.8654361E+00 0.5492225E+00 0.0000000E+00 1892 0 0.9252408E+00 0.5462736E+00 0.0000000E+00 1893 0 0.9463490E+00 0.5596693E+00 0.0000000E+00 1894 0 0.9076525E+00 0.5760138E+00 0.0000000E+00 1895 0 0.9682567E+00 0.5717131E+00 0.0000000E+00 1896 0 0.9893649E+00 0.5851088E+00 0.0000000E+00 1897 0 0.9498689E+00 0.6028051E+00 0.0000000E+00 1898 0 0.1011272E+01 0.5971527E+00 0.0000000E+00 1899 0 0.1032381E+01 0.6105483E+00 0.0000000E+00 1900 0 0.9920852E+00 0.6295965E+00 0.0000000E+00 1901 0 0.1054288E+01 0.6225921E+00 0.0000000E+00 1902 0 0.1075397E+01 0.6359878E+00 0.0000000E+00 1903 0 0.1034302E+01 0.6563878E+00 0.0000000E+00 1904 0 0.1097304E+01 0.6480316E+00 0.0000000E+00 1905 4 0.1118412E+01 0.6614273E+00 0.0000000E+00 1906 0 0.1076518E+01 0.6831791E+00 0.0000000E+00 1907 0 0.8477806E+00 0.5752017E+00 0.0000000E+00 1908 3 0.8266725E+00 0.5618060E+00 0.0000000E+00 1909 0 0.8680061E+00 0.5898963E+00 0.0000000E+00 1910 0 0.8292424E+00 0.6024798E+00 0.0000000E+00 1911 0 0.8891143E+00 0.6032920E+00 0.0000000E+00 1912 0 0.9093397E+00 0.6179866E+00 0.0000000E+00 1913 0 0.8696933E+00 0.6318691E+00 0.0000000E+00 1914 0 0.9304479E+00 0.6313823E+00 0.0000000E+00 1915 0 0.9506733E+00 0.6460769E+00 0.0000000E+00 1916 0 0.9101441E+00 0.6612584E+00 0.0000000E+00 1917 0 0.9717814E+00 0.6594726E+00 0.0000000E+00 1918 0 0.9920068E+00 0.6741672E+00 0.0000000E+00 1919 0 0.9505949E+00 0.6906477E+00 0.0000000E+00 1920 0 0.1013115E+01 0.6875629E+00 0.0000000E+00 1921 0 0.1033341E+01 0.7022575E+00 0.0000000E+00 1922 0 0.9910458E+00 0.7200370E+00 0.0000000E+00 1923 0 0.1054449E+01 0.7156532E+00 0.0000000E+00 1924 4 0.1074674E+01 0.7303478E+00 0.0000000E+00 1925 0 0.1031497E+01 0.7494262E+00 0.0000000E+00 1926 0 0.8099905E+00 0.6272992E+00 0.0000000E+00 1927 3 0.7897651E+00 0.6126046E+00 0.0000000E+00 1928 0 0.8292533E+00 0.6432348E+00 0.0000000E+00 1929 0 0.7897761E+00 0.6533596E+00 0.0000000E+00 1930 0 0.8494788E+00 0.6579295E+00 0.0000000E+00 1931 0 0.8687417E+00 0.6738651E+00 0.0000000E+00 1932 0 0.8283017E+00 0.6852308E+00 0.0000000E+00 1933 0 0.8889670E+00 0.6885598E+00 0.0000000E+00 1934 0 0.9082298E+00 0.7044953E+00 0.0000000E+00 1935 0 0.8668274E+00 0.7171020E+00 0.0000000E+00 1936 0 0.9284552E+00 0.7191899E+00 0.0000000E+00 1937 0 0.9477181E+00 0.7351255E+00 0.0000000E+00 1938 0 0.9053530E+00 0.7489732E+00 0.0000000E+00 1939 0 0.9679435E+00 0.7498202E+00 0.0000000E+00 1940 0 0.9872064E+00 0.7657558E+00 0.0000000E+00 1941 0 0.9438787E+00 0.7808444E+00 0.0000000E+00 1942 0 0.1007432E+01 0.7804504E+00 0.0000000E+00 1943 4 0.1026695E+01 0.7963860E+00 0.0000000E+00 1944 0 0.9824043E+00 0.8127156E+00 0.0000000E+00 1945 0 0.7690037E+00 0.6769212E+00 0.0000000E+00 1946 3 0.7497409E+00 0.6609856E+00 0.0000000E+00 1947 0 0.7872280E+00 0.6940348E+00 0.0000000E+00 1948 0 0.7471928E+00 0.7016608E+00 0.0000000E+00 1949 0 0.8064908E+00 0.7099704E+00 0.0000000E+00 1950 0 0.8247151E+00 0.7270841E+00 0.0000000E+00 1951 0 0.7836413E+00 0.7358881E+00 0.0000000E+00 1952 0 0.8439779E+00 0.7430197E+00 0.0000000E+00 1953 0 0.8622020E+00 0.7601334E+00 0.0000000E+00 1954 0 0.8200897E+00 0.7701155E+00 0.0000000E+00 1955 0 0.8814648E+00 0.7760690E+00 0.0000000E+00 1956 0 0.8996890E+00 0.7931827E+00 0.0000000E+00 1957 0 0.8565380E+00 0.8043429E+00 0.0000000E+00 1958 0 0.9189519E+00 0.8091183E+00 0.0000000E+00 1959 0 0.9371761E+00 0.8262320E+00 0.0000000E+00 1960 0 0.8929865E+00 0.8385702E+00 0.0000000E+00 1961 0 0.9564390E+00 0.8421676E+00 0.0000000E+00 1962 4 0.9746632E+00 0.8592812E+00 0.0000000E+00 1963 0 0.9294350E+00 0.8727976E+00 0.0000000E+00 1964 0 0.7249821E+00 0.7238716E+00 0.0000000E+00 1965 3 0.7067578E+00 0.7067579E+00 0.0000000E+00 1966 0 0.7420957E+00 0.7420957E+00 0.0000000E+00 1967 0 0.7016608E+00 0.7471929E+00 0.0000000E+00 1968 0 0.7603200E+00 0.7592094E+00 0.0000000E+00 1969 0 0.7774337E+00 0.7774336E+00 0.0000000E+00 1970 0 0.7358882E+00 0.7836412E+00 0.0000000E+00 1971 0 0.7956578E+00 0.7945473E+00 0.0000000E+00 1972 0 0.8127715E+00 0.8127715E+00 0.0000000E+00 1973 0 0.7701155E+00 0.8200896E+00 0.0000000E+00 1974 0 0.8309957E+00 0.8298852E+00 0.0000000E+00 1975 0 0.8481093E+00 0.8481095E+00 0.0000000E+00 1976 0 0.8043428E+00 0.8565381E+00 0.0000000E+00 1977 0 0.8663336E+00 0.8652231E+00 0.0000000E+00 1978 0 0.8834473E+00 0.8834474E+00 0.0000000E+00 1979 0 0.8385701E+00 0.8929866E+00 0.0000000E+00 1980 0 0.9016715E+00 0.9005610E+00 0.0000000E+00 1981 4 0.9187852E+00 0.9187852E+00 0.0000000E+00 1982 0 0.8727975E+00 0.9294350E+00 0.0000000E+00 1983 0 0.6780992E+00 0.7679651E+00 0.0000000E+00 1984 3 0.6609855E+00 0.7497410E+00 0.0000000E+00 1985 0 0.6940348E+00 0.7872279E+00 0.0000000E+00 1986 0 0.6533596E+00 0.7897760E+00 0.0000000E+00 1987 0 0.7111485E+00 0.8054521E+00 0.0000000E+00 1988 0 0.7270841E+00 0.8247150E+00 0.0000000E+00 1989 0 0.6852308E+00 0.8283017E+00 0.0000000E+00 1990 0 0.7441978E+00 0.8429392E+00 0.0000000E+00 1991 0 0.7601334E+00 0.8622020E+00 0.0000000E+00 1992 0 0.7171020E+00 0.8668274E+00 0.0000000E+00 1993 0 0.7772470E+00 0.8804263E+00 0.0000000E+00 1994 0 0.7931826E+00 0.8996890E+00 0.0000000E+00 1995 0 0.7489732E+00 0.9053530E+00 0.0000000E+00 1996 0 0.8102963E+00 0.9179133E+00 0.0000000E+00 1997 0 0.8262319E+00 0.9371762E+00 0.0000000E+00 1998 0 0.7808444E+00 0.9438787E+00 0.0000000E+00 1999 0 0.8433456E+00 0.9554004E+00 0.0000000E+00 2000 4 0.8592812E+00 0.9746632E+00 0.0000000E+00 2001 0 0.8127155E+00 0.9824044E+00 0.0000000E+00 2002 0 0.6285402E+00 0.8090279E+00 0.0000000E+00 2003 3 0.6126046E+00 0.7897651E+00 0.0000000E+00 2004 0 0.6432348E+00 0.8292533E+00 0.0000000E+00 2005 0 0.6024799E+00 0.8292424E+00 0.0000000E+00 2006 0 0.6591704E+00 0.8485162E+00 0.0000000E+00 2007 0 0.6738651E+00 0.8687417E+00 0.0000000E+00 2008 0 0.6318692E+00 0.8696932E+00 0.0000000E+00 2009 0 0.6898007E+00 0.8880044E+00 0.0000000E+00 2010 0 0.7044953E+00 0.9082299E+00 0.0000000E+00 2011 0 0.6612584E+00 0.9101442E+00 0.0000000E+00 2012 0 0.7204309E+00 0.9274927E+00 0.0000000E+00 2013 0 0.7351255E+00 0.9477181E+00 0.0000000E+00 2014 0 0.6906475E+00 0.9505950E+00 0.0000000E+00 2015 0 0.7510611E+00 0.9669810E+00 0.0000000E+00 2016 0 0.7657557E+00 0.9872064E+00 0.0000000E+00 2017 0 0.7200368E+00 0.9910458E+00 0.0000000E+00 2018 0 0.7816913E+00 0.1006469E+01 0.0000000E+00 2019 4 0.7963859E+00 0.1026695E+01 0.0000000E+00 2020 0 0.7494261E+00 0.1031497E+01 0.0000000E+00 2021 0 0.5765006E+00 0.8468979E+00 0.0000000E+00 2022 3 0.5618060E+00 0.8266725E+00 0.0000000E+00 2023 0 0.5898963E+00 0.8680061E+00 0.0000000E+00 2024 0 0.5492224E+00 0.8654361E+00 0.0000000E+00 2025 0 0.6045910E+00 0.8882315E+00 0.0000000E+00 2026 0 0.6179866E+00 0.9093397E+00 0.0000000E+00 2027 0 0.5760138E+00 0.9076525E+00 0.0000000E+00 2028 0 0.6326812E+00 0.9295652E+00 0.0000000E+00 2029 0 0.6460769E+00 0.9506733E+00 0.0000000E+00 2030 0 0.6028051E+00 0.9498689E+00 0.0000000E+00 2031 0 0.6607715E+00 0.9708987E+00 0.0000000E+00 2032 0 0.6741671E+00 0.9920069E+00 0.0000000E+00 2033 0 0.6295964E+00 0.9920853E+00 0.0000000E+00 2034 0 0.6888618E+00 0.1012232E+01 0.0000000E+00 2035 0 0.7022575E+00 0.1033341E+01 0.0000000E+00 2036 0 0.6563877E+00 0.1034302E+01 0.0000000E+00 2037 0 0.7169521E+00 0.1053566E+01 0.0000000E+00 2038 4 0.7303478E+00 0.1074674E+01 0.0000000E+00 2039 0 0.6831791E+00 0.1076518E+01 0.0000000E+00 2040 0 0.5221858E+00 0.8814255E+00 0.0000000E+00 2041 3 0.5087902E+00 0.8603173E+00 0.0000000E+00 2042 0 0.5342297E+00 0.9033332E+00 0.0000000E+00 2043 0 0.4937974E+00 0.8982144E+00 0.0000000E+00 2044 0 0.5476254E+00 0.9244414E+00 0.0000000E+00 2045 0 0.5596692E+00 0.9463491E+00 0.0000000E+00 2046 0 0.5178851E+00 0.9420297E+00 0.0000000E+00 2047 0 0.5730649E+00 0.9674572E+00 0.0000000E+00 2048 0 0.5851087E+00 0.9893649E+00 0.0000000E+00 2049 0 0.5419728E+00 0.9858450E+00 0.0000000E+00 2050 0 0.5985043E+00 0.1010473E+01 0.0000000E+00 2051 0 0.6105481E+00 0.1032381E+01 0.0000000E+00 2052 0 0.5660605E+00 0.1029660E+01 0.0000000E+00 2053 0 0.6239438E+00 0.1053489E+01 0.0000000E+00 2054 0 0.6359877E+00 0.1075397E+01 0.0000000E+00 2055 0 0.5901481E+00 0.1073476E+01 0.0000000E+00 2056 0 0.6493834E+00 0.1096505E+01 0.0000000E+00 2057 4 0.6614272E+00 0.1118412E+01 0.0000000E+00 2058 0 0.6142358E+00 0.1117291E+01 0.0000000E+00 2059 0 0.4658103E+00 0.9124745E+00 0.0000000E+00 2060 3 0.4537665E+00 0.8905669E+00 0.0000000E+00 2061 0 0.4764548E+00 0.9350952E+00 0.0000000E+00 2062 0 0.4364238E+00 0.9274477E+00 0.0000000E+00 2063 0 0.4884986E+00 0.9570029E+00 0.0000000E+00 2064 0 0.4991432E+00 0.9796236E+00 0.0000000E+00 2065 0 0.4577128E+00 0.9726891E+00 0.0000000E+00 2066 0 0.5111870E+00 0.1001531E+01 0.0000000E+00 2067 0 0.5218315E+00 0.1024152E+01 0.0000000E+00 2068 0 0.4790018E+00 0.1017930E+01 0.0000000E+00 2069 0 0.5338753E+00 0.1046060E+01 0.0000000E+00 2070 0 0.5445197E+00 0.1068680E+01 0.0000000E+00 2071 0 0.5002907E+00 0.1063172E+01 0.0000000E+00 2072 0 0.5565635E+00 0.1090588E+01 0.0000000E+00 2073 0 0.5672080E+00 0.1113209E+01 0.0000000E+00 2074 0 0.5215796E+00 0.1108413E+01 0.0000000E+00 2075 0 0.5792519E+00 0.1135116E+01 0.0000000E+00 2076 4 0.5898964E+00 0.1157737E+01 0.0000000E+00 2077 0 0.5428686E+00 0.1153654E+01 0.0000000E+00 2078 0 0.4075964E+00 0.9399224E+00 0.0000000E+00 2079 3 0.3969519E+00 0.9173018E+00 0.0000000E+00 2080 0 0.4167995E+00 0.9631668E+00 0.0000000E+00 2081 0 0.3773277E+00 0.9530209E+00 0.0000000E+00 2082 0 0.4274441E+00 0.9857875E+00 0.0000000E+00 2083 0 0.4366472E+00 0.1009032E+01 0.0000000E+00 2084 0 0.3957339E+00 0.9995097E+00 0.0000000E+00 2085 0 0.4472917E+00 0.1031653E+01 0.0000000E+00 2086 0 0.4564947E+00 0.1054897E+01 0.0000000E+00 2087 0 0.4141401E+00 0.1045999E+01 0.0000000E+00 2088 0 0.4671391E+00 0.1077518E+01 0.0000000E+00 2089 0 0.4763422E+00 0.1100762E+01 0.0000000E+00 2090 0 0.4325462E+00 0.1092487E+01 0.0000000E+00 2091 0 0.4869867E+00 0.1123383E+01 0.0000000E+00 2092 0 0.4961898E+00 0.1146627E+01 0.0000000E+00 2093 0 0.4509525E+00 0.1138976E+01 0.0000000E+00 2094 0 0.5068343E+00 0.1169248E+01 0.0000000E+00 2095 4 0.5160375E+00 0.1192492E+01 0.0000000E+00 2096 0 0.4693588E+00 0.1185465E+01 0.0000000E+00 2097 0 0.3477739E+00 0.9636609E+00 0.0000000E+00 2098 3 0.3385708E+00 0.9404165E+00 0.0000000E+00 2099 0 0.3554993E+00 0.9874373E+00 0.0000000E+00 2100 0 0.3167424E+00 0.9748329E+00 0.0000000E+00 2101 0 0.3647024E+00 0.1010682E+01 0.0000000E+00 2102 0 0.3724279E+00 0.1034458E+01 0.0000000E+00 2103 0 0.3321932E+00 0.1022386E+01 0.0000000E+00 2104 0 0.3816309E+00 0.1057703E+01 0.0000000E+00 2105 0 0.3893563E+00 0.1081479E+01 0.0000000E+00 2106 0 0.3476441E+00 0.1069939E+01 0.0000000E+00 2107 0 0.3985594E+00 0.1104723E+01 0.0000000E+00 2108 0 0.4062849E+00 0.1128500E+01 0.0000000E+00 2109 0 0.3630949E+00 0.1117491E+01 0.0000000E+00 2110 0 0.4154880E+00 0.1151744E+01 0.0000000E+00 2111 0 0.4232134E+00 0.1175521E+01 0.0000000E+00 2112 0 0.3785458E+00 0.1165044E+01 0.0000000E+00 2113 0 0.4324165E+00 0.1198765E+01 0.0000000E+00 2114 4 0.4401420E+00 0.1222541E+01 0.0000000E+00 2115 0 0.3939966E+00 0.1212597E+01 0.0000000E+00 2116 0 0.2865788E+00 0.9835962E+00 0.0000000E+00 2117 3 0.2788534E+00 0.9598199E+00 0.0000000E+00 2118 0 0.2927961E+00 0.1007811E+01 0.0000000E+00 2119 0 0.2549071E+00 0.9927977E+00 0.0000000E+00 2120 0 0.3005215E+00 0.1031587E+01 0.0000000E+00 2121 0 0.3067387E+00 0.1055802E+01 0.0000000E+00 2122 0 0.2673416E+00 0.1041227E+01 0.0000000E+00 2123 0 0.3144642E+00 0.1079578E+01 0.0000000E+00 2124 0 0.3206814E+00 0.1103793E+01 0.0000000E+00 2125 0 0.2797761E+00 0.1089656E+01 0.0000000E+00 2126 0 0.3284068E+00 0.1127569E+01 0.0000000E+00 2127 0 0.3346241E+00 0.1151784E+01 0.0000000E+00 2128 0 0.2922105E+00 0.1138085E+01 0.0000000E+00 2129 0 0.3423495E+00 0.1175560E+01 0.0000000E+00 2130 0 0.3485667E+00 0.1199775E+01 0.0000000E+00 2131 0 0.3046450E+00 0.1186514E+01 0.0000000E+00 2132 0 0.3562922E+00 0.1223551E+01 0.0000000E+00 2133 4 0.3625094E+00 0.1247766E+01 0.0000000E+00 2134 0 0.3170795E+00 0.1234944E+01 0.0000000E+00 2135 0 0.2242528E+00 0.9996498E+00 0.0000000E+00 2136 3 0.2180355E+00 0.9754352E+00 0.0000000E+00 2137 0 0.2289373E+00 0.1024207E+01 0.0000000E+00 2138 0 0.1920657E+00 0.1006844E+01 0.0000000E+00 2139 0 0.2351545E+00 0.1048422E+01 0.0000000E+00 2140 0 0.2398390E+00 0.1072979E+01 0.0000000E+00 2141 0 0.2014348E+00 0.1055959E+01 0.0000000E+00 2142 0 0.2460563E+00 0.1097193E+01 0.0000000E+00 2143 0 0.2507408E+00 0.1121750E+01 0.0000000E+00 2144 0 0.2108038E+00 0.1105073E+01 0.0000000E+00 2145 0 0.2569580E+00 0.1145965E+01 0.0000000E+00 2146 0 0.2616426E+00 0.1170522E+01 0.0000000E+00 2147 0 0.2201729E+00 0.1154187E+01 0.0000000E+00 2148 0 0.2678599E+00 0.1194737E+01 0.0000000E+00 2149 0 0.2725444E+00 0.1219294E+01 0.0000000E+00 2150 0 0.2295420E+00 0.1203302E+01 0.0000000E+00 2151 0 0.2787617E+00 0.1243509E+01 0.0000000E+00 2152 4 0.2834462E+00 0.1268066E+01 0.0000000E+00 2153 0 0.2389111E+00 0.1252416E+01 0.0000000E+00 2154 0 0.1610417E+00 0.1011758E+01 0.0000000E+00 2155 3 0.1563572E+00 0.9872010E+00 0.0000000E+00 2156 0 0.1641751E+00 0.1036561E+01 0.0000000E+00 2157 0 0.1284666E+00 0.1016918E+01 0.0000000E+00 2158 0 0.1688596E+00 0.1061118E+01 0.0000000E+00 2159 0 0.1719929E+00 0.1085921E+01 0.0000000E+00 2160 0 0.1347332E+00 0.1066523E+01 0.0000000E+00 2161 0 0.1766774E+00 0.1110478E+01 0.0000000E+00 2162 0 0.1798107E+00 0.1135281E+01 0.0000000E+00 2163 0 0.1409999E+00 0.1116129E+01 0.0000000E+00 2164 0 0.1844954E+00 0.1159838E+01 0.0000000E+00 2165 0 0.1876287E+00 0.1184641E+01 0.0000000E+00 2166 0 0.1472665E+00 0.1165735E+01 0.0000000E+00 2167 0 0.1923132E+00 0.1209198E+01 0.0000000E+00 2168 0 0.1954466E+00 0.1234001E+01 0.0000000E+00 2169 0 0.1535332E+00 0.1215340E+01 0.0000000E+00 2170 0 0.2001311E+00 0.1258558E+01 0.0000000E+00 2171 4 0.2032644E+00 0.1283361E+01 0.0000000E+00 2172 0 0.1597999E+00 0.1264946E+01 0.0000000E+00 2173 0 0.9719519E-01 0.1019874E+01 0.0000000E+00 2174 3 0.9406187E-01 0.9950707E+00 0.0000000E+00 2175 0 0.9876496E-01 0.1044824E+01 0.0000000E+00 2176 0 0.6436026E-01 0.1022977E+01 0.0000000E+00 2177 0 0.1018983E+00 0.1069627E+01 0.0000000E+00 2178 0 0.1034681E+00 0.1094578E+01 0.0000000E+00 2179 0 0.6749979E-01 0.1072879E+01 0.0000000E+00 2180 0 0.1066014E+00 0.1119381E+01 0.0000000E+00 2181 0 0.1081711E+00 0.1144331E+01 0.0000000E+00 2182 0 0.7063931E-01 0.1122780E+01 0.0000000E+00 2183 0 0.1113045E+00 0.1169134E+01 0.0000000E+00 2184 0 0.1128742E+00 0.1194085E+01 0.0000000E+00 2185 0 0.7377884E-01 0.1172681E+01 0.0000000E+00 2186 0 0.1160076E+00 0.1218888E+01 0.0000000E+00 2187 0 0.1175773E+00 0.1243838E+01 0.0000000E+00 2188 0 0.7691836E-01 0.1222583E+01 0.0000000E+00 2189 0 0.1207107E+00 0.1268641E+01 0.0000000E+00 2190 4 0.1222804E+00 0.1293592E+01 0.0000000E+00 2191 0 0.8005789E-01 0.1272484E+01 0.0000000E+00 2192 0 0.3296501E-01 0.1023964E+01 0.0000000E+00 2193 3 0.3139525E-01 0.9990134E+00 0.0000000E+00 2194 0 0.3296501E-01 0.1048964E+01 0.0000000E+00 2195 0 0.0000000E+00 0.1025000E+01 0.0000000E+00 2196 0 0.3453477E-01 0.1073915E+01 0.0000000E+00 2197 0 0.3453477E-01 0.1098915E+01 0.0000000E+00 2198 0 0.0000000E+00 0.1075000E+01 0.0000000E+00 2199 0 0.3610454E-01 0.1123865E+01 0.0000000E+00 2200 0 0.3610454E-01 0.1148865E+01 0.0000000E+00 2201 0 0.0000000E+00 0.1125000E+01 0.0000000E+00 2202 0 0.3767430E-01 0.1173816E+01 0.0000000E+00 2203 0 0.3767430E-01 0.1198816E+01 0.0000000E+00 2204 0 0.0000000E+00 0.1175000E+01 0.0000000E+00 2205 0 0.3924406E-01 0.1223767E+01 0.0000000E+00 2206 0 0.3924406E-01 0.1248767E+01 0.0000000E+00 2207 0 0.0000000E+00 0.1225000E+01 0.0000000E+00 2208 0 0.3924406E-01 0.1273767E+01 0.0000000E+00 2209 0 0.0000000E+00 0.1275000E+01 0.0000000E+00 2210 4 0.4081383E-01 0.1298717E+01 0.0000000E+00 C C$ RUBRIQUE = ELEMENTS C 1 1 1 9 8 603 604 605 2 1 1 2 9 606 607 603 3 1 2 3 9 608 609 607 4 1 9 3 10 609 610 611 5 1 3 4 10 612 613 610 6 1 10 4 11 613 614 615 7 1 4 5 11 616 617 614 8 1 11 5 12 617 618 619 9 1 5 6 12 620 621 618 10 1 12 6 13 621 622 623 11 1 6 7 13 624 625 622 12 1 13 7 14 625 626 627 13 1 8 9 15 604 628 629 14 1 15 9 16 628 630 631 15 1 9 10 16 611 632 630 16 1 16 10 17 632 633 634 17 1 10 11 17 615 635 633 18 1 17 11 18 635 636 637 19 1 11 12 18 619 638 636 20 1 18 12 19 638 639 640 21 1 12 13 19 623 641 639 22 1 19 13 20 641 642 643 23 1 13 14 20 627 644 642 24 1 20 14 21 644 645 646 25 1 15 16 22 631 647 648 26 1 22 16 23 647 649 650 27 1 16 17 23 634 651 649 28 1 23 17 24 651 652 653 29 1 17 18 24 637 654 652 30 1 24 18 25 654 655 656 31 1 18 19 25 640 657 655 32 1 25 19 26 657 658 659 33 1 19 20 26 643 660 658 34 1 26 20 27 660 661 662 35 1 20 21 27 646 663 661 36 1 27 21 28 663 664 665 37 1 22 23 29 650 666 667 38 1 29 23 30 666 668 669 39 1 23 24 30 653 670 668 40 1 30 24 31 670 671 672 41 1 24 25 31 656 673 671 42 1 31 25 32 673 674 675 43 1 25 26 32 659 676 674 44 1 32 26 33 676 677 678 45 1 26 27 33 662 679 677 46 1 33 27 34 679 680 681 47 1 27 28 34 665 682 680 48 1 34 28 35 682 683 684 49 1 29 30 36 669 685 686 50 1 36 30 37 685 687 688 51 1 30 31 37 672 689 687 52 1 37 31 38 689 690 691 53 1 31 32 38 675 692 690 54 1 38 32 39 692 693 694 55 1 32 33 39 678 695 693 56 1 39 33 40 695 696 697 57 1 33 34 40 681 698 696 58 1 40 34 41 698 699 700 59 1 34 35 41 684 701 699 60 1 41 35 42 701 702 703 61 1 36 37 43 688 704 705 62 1 43 37 44 704 706 707 63 1 37 38 44 691 708 706 64 1 44 38 45 708 709 710 65 1 38 39 45 694 711 709 66 1 45 39 46 711 712 713 67 1 39 40 46 697 714 712 68 1 46 40 47 714 715 716 69 1 40 41 47 700 717 715 70 1 47 41 48 717 718 719 71 1 41 42 48 703 720 718 72 1 48 42 49 720 721 722 73 1 43 44 50 707 723 724 74 1 50 44 51 723 725 726 75 1 44 45 51 710 727 725 76 1 51 45 52 727 728 729 77 1 45 46 52 713 730 728 78 1 52 46 53 730 731 732 79 1 46 47 53 716 733 731 80 1 53 47 54 733 734 735 81 1 47 48 54 719 736 734 82 1 54 48 55 736 737 738 83 1 48 49 55 722 739 737 84 1 55 49 56 739 740 741 85 1 50 51 57 726 742 743 86 1 57 51 58 742 744 745 87 1 51 52 58 729 746 744 88 1 58 52 59 746 747 748 89 1 52 53 59 732 749 747 90 1 59 53 60 749 750 751 91 1 53 54 60 735 752 750 92 1 60 54 61 752 753 754 93 1 54 55 61 738 755 753 94 1 61 55 62 755 756 757 95 1 55 56 62 741 758 756 96 1 62 56 63 758 759 760 97 1 57 58 64 745 761 762 98 1 64 58 65 761 763 764 99 1 58 59 65 748 765 763 100 1 65 59 66 765 766 767 101 1 59 60 66 751 768 766 102 1 66 60 67 768 769 770 103 1 60 61 67 754 771 769 104 1 67 61 68 771 772 773 105 1 61 62 68 757 774 772 106 1 68 62 69 774 775 776 107 1 62 63 69 760 777 775 108 1 69 63 70 777 778 779 109 1 64 65 71 764 780 781 110 1 71 65 72 780 782 783 111 1 65 66 72 767 784 782 112 1 72 66 73 784 785 786 113 1 66 67 73 770 787 785 114 1 73 67 74 787 788 789 115 1 67 68 74 773 790 788 116 1 74 68 75 790 791 792 117 1 68 69 75 776 793 791 118 1 75 69 76 793 794 795 119 1 69 70 76 779 796 794 120 1 76 70 77 796 797 798 121 1 71 72 78 783 799 800 122 1 78 72 79 799 801 802 123 1 72 73 79 786 803 801 124 1 79 73 80 803 804 805 125 1 73 74 80 789 806 804 126 1 80 74 81 806 807 808 127 1 74 75 81 792 809 807 128 1 81 75 82 809 810 811 129 1 75 76 82 795 812 810 130 1 82 76 83 812 813 814 131 1 76 77 83 798 815 813 132 1 83 77 84 815 816 817 133 1 78 79 85 802 818 819 134 1 85 79 86 818 820 821 135 1 79 80 86 805 822 820 136 1 86 80 87 822 823 824 137 1 80 81 87 808 825 823 138 1 87 81 88 825 826 827 139 1 81 82 88 811 828 826 140 1 88 82 89 828 829 830 141 1 82 83 89 814 831 829 142 1 89 83 90 831 832 833 143 1 83 84 90 817 834 832 144 1 90 84 91 834 835 836 145 1 85 86 92 821 837 838 146 1 92 86 93 837 839 840 147 1 86 87 93 824 841 839 148 1 93 87 94 841 842 843 149 1 87 88 94 827 844 842 150 1 94 88 95 844 845 846 151 1 88 89 95 830 847 845 152 1 95 89 96 847 848 849 153 1 89 90 96 833 850 848 154 1 96 90 97 850 851 852 155 1 90 91 97 836 853 851 156 1 97 91 98 853 854 855 157 1 92 93 99 840 856 857 158 1 99 93 100 856 858 859 159 1 93 94 100 843 860 858 160 1 100 94 101 860 861 862 161 1 94 95 101 846 863 861 162 1 101 95 102 863 864 865 163 1 95 96 102 849 866 864 164 1 102 96 103 866 867 868 165 1 96 97 103 852 869 867 166 1 103 97 104 869 870 871 167 1 97 98 104 855 872 870 168 1 104 98 105 872 873 874 169 1 99 100 106 859 875 876 170 1 106 100 107 875 877 878 171 1 100 101 107 862 879 877 172 1 107 101 108 879 880 881 173 1 101 102 108 865 882 880 174 1 108 102 109 882 883 884 175 1 102 103 109 868 885 883 176 1 109 103 110 885 886 887 177 1 103 104 110 871 888 886 178 1 110 104 111 888 889 890 179 1 104 105 111 874 891 889 180 1 111 105 112 891 892 893 181 1 106 107 113 878 894 895 182 1 113 107 114 894 896 897 183 1 107 108 114 881 898 896 184 1 114 108 115 898 899 900 185 1 108 109 115 884 901 899 186 1 115 109 116 901 902 903 187 1 109 110 116 887 904 902 188 1 116 110 117 904 905 906 189 1 110 111 117 890 907 905 190 1 117 111 118 907 908 909 191 1 111 112 118 893 910 908 192 1 118 112 119 910 911 912 193 1 113 114 120 897 913 914 194 1 120 114 121 913 915 916 195 1 114 115 121 900 917 915 196 1 121 115 122 917 918 919 197 1 115 116 122 903 920 918 198 1 122 116 123 920 921 922 199 1 116 117 123 906 923 921 200 1 123 117 124 923 924 925 201 1 117 118 124 909 926 924 202 1 124 118 125 926 927 928 203 1 118 119 125 912 929 927 204 1 125 119 126 929 930 931 205 1 120 121 127 916 932 933 206 1 127 121 128 932 934 935 207 1 121 122 128 919 936 934 208 1 128 122 129 936 937 938 209 1 122 123 129 922 939 937 210 1 129 123 130 939 940 941 211 1 123 124 130 925 942 940 212 1 130 124 131 942 943 944 213 1 124 125 131 928 945 943 214 1 131 125 132 945 946 947 215 1 125 126 132 931 948 946 216 1 132 126 133 948 949 950 217 1 127 128 134 935 951 952 218 1 134 128 135 951 953 954 219 1 128 129 135 938 955 953 220 1 135 129 136 955 956 957 221 1 129 130 136 941 958 956 222 1 136 130 137 958 959 960 223 1 130 131 137 944 961 959 224 1 137 131 138 961 962 963 225 1 131 132 138 947 964 962 226 1 138 132 139 964 965 966 227 1 132 133 139 950 967 965 228 1 139 133 140 967 968 969 229 1 134 135 141 954 970 971 230 1 141 135 142 970 972 973 231 1 135 136 142 957 974 972 232 1 142 136 143 974 975 976 233 1 136 137 143 960 977 975 234 1 143 137 144 977 978 979 235 1 137 138 144 963 980 978 236 1 144 138 145 980 981 982 237 1 138 139 145 966 983 981 238 1 145 139 146 983 984 985 239 1 139 140 146 969 986 984 240 1 146 140 147 986 987 988 241 1 141 142 148 973 989 990 242 1 148 142 149 989 991 992 243 1 142 143 149 976 993 991 244 1 149 143 150 993 994 995 245 1 143 144 150 979 996 994 246 1 150 144 151 996 997 998 247 1 144 145 151 982 999 997 248 1 151 145 152 999 1000 1001 249 1 145 146 152 985 1002 1000 250 1 152 146 153 1002 1003 1004 251 1 146 147 153 988 1005 1003 252 1 153 147 154 1005 1006 1007 253 1 148 149 155 992 1008 1009 254 1 155 149 156 1008 1010 1011 255 1 149 150 156 995 1012 1010 256 1 156 150 157 1012 1013 1014 257 1 150 151 157 998 1015 1013 258 1 157 151 158 1015 1016 1017 259 1 151 152 158 1001 1018 1016 260 1 158 152 159 1018 1019 1020 261 1 152 153 159 1004 1021 1019 262 1 159 153 160 1021 1022 1023 263 1 153 154 160 1007 1024 1022 264 1 160 154 161 1024 1025 1026 265 1 155 156 162 1011 1027 1028 266 1 162 156 163 1027 1029 1030 267 1 156 157 163 1014 1031 1029 268 1 163 157 164 1031 1032 1033 269 1 157 158 164 1017 1034 1032 270 1 164 158 165 1034 1035 1036 271 1 158 159 165 1020 1037 1035 272 1 165 159 166 1037 1038 1039 273 1 159 160 166 1023 1040 1038 274 1 166 160 167 1040 1041 1042 275 1 160 161 167 1026 1043 1041 276 1 167 161 168 1043 1044 1045 277 1 162 163 169 1030 1046 1047 278 1 169 163 170 1046 1048 1049 279 1 163 164 170 1033 1050 1048 280 1 170 164 171 1050 1051 1052 281 1 164 165 171 1036 1053 1051 282 1 171 165 172 1053 1054 1055 283 1 165 166 172 1039 1056 1054 284 1 172 166 173 1056 1057 1058 285 1 166 167 173 1042 1059 1057 286 1 173 167 174 1059 1060 1061 287 1 167 168 174 1045 1062 1060 288 1 174 168 175 1062 1063 1064 289 1 169 170 176 1049 1065 1066 290 1 176 170 177 1065 1067 1068 291 1 170 171 177 1052 1069 1067 292 1 177 171 178 1069 1070 1071 293 1 171 172 178 1055 1072 1070 294 1 178 172 179 1072 1073 1074 295 1 172 173 179 1058 1075 1073 296 1 179 173 180 1075 1076 1077 297 1 173 174 180 1061 1078 1076 298 1 180 174 181 1078 1079 1080 299 1 174 175 181 1064 1081 1079 300 1 181 175 182 1081 1082 1083 301 1 176 177 183 1068 1084 1085 302 1 183 177 184 1084 1086 1087 303 1 177 178 184 1071 1088 1086 304 1 184 178 185 1088 1089 1090 305 1 178 179 185 1074 1091 1089 306 1 185 179 186 1091 1092 1093 307 1 179 180 186 1077 1094 1092 308 1 186 180 187 1094 1095 1096 309 1 180 181 187 1080 1097 1095 310 1 187 181 188 1097 1098 1099 311 1 181 182 188 1083 1100 1098 312 1 188 182 189 1100 1101 1102 313 1 183 184 190 1087 1103 1104 314 1 190 184 191 1103 1105 1106 315 1 184 185 191 1090 1107 1105 316 1 191 185 192 1107 1108 1109 317 1 185 186 192 1093 1110 1108 318 1 192 186 193 1110 1111 1112 319 1 186 187 193 1096 1113 1111 320 1 193 187 194 1113 1114 1115 321 1 187 188 194 1099 1116 1114 322 1 194 188 195 1116 1117 1118 323 1 188 189 195 1102 1119 1117 324 1 195 189 196 1119 1120 1121 325 1 190 191 197 1106 1122 1123 326 1 197 191 198 1122 1124 1125 327 1 191 192 198 1109 1126 1124 328 1 198 192 199 1126 1127 1128 329 1 192 193 199 1112 1129 1127 330 1 199 193 200 1129 1130 1131 331 1 193 194 200 1115 1132 1130 332 1 200 194 201 1132 1133 1134 333 1 194 195 201 1118 1135 1133 334 1 201 195 202 1135 1136 1137 335 1 195 196 202 1121 1138 1136 336 1 202 196 203 1138 1139 1140 337 1 197 198 204 1125 1141 1142 338 1 204 198 205 1141 1143 1144 339 1 198 199 205 1128 1145 1143 340 1 205 199 206 1145 1146 1147 341 1 199 200 206 1131 1148 1146 342 1 206 200 207 1148 1149 1150 343 1 200 201 207 1134 1151 1149 344 1 207 201 208 1151 1152 1153 345 1 201 202 208 1137 1154 1152 346 1 208 202 209 1154 1155 1156 347 1 202 203 209 1140 1157 1155 348 1 209 203 210 1157 1158 1159 349 1 204 205 211 1144 1160 1161 350 1 211 205 212 1160 1162 1163 351 1 205 206 212 1147 1164 1162 352 1 212 206 213 1164 1165 1166 353 1 206 207 213 1150 1167 1165 354 1 213 207 214 1167 1168 1169 355 1 207 208 214 1153 1170 1168 356 1 214 208 215 1170 1171 1172 357 1 208 209 215 1156 1173 1171 358 1 215 209 216 1173 1174 1175 359 1 209 210 216 1159 1176 1174 360 1 216 210 217 1176 1177 1178 361 1 211 212 218 1163 1179 1180 362 1 218 212 219 1179 1181 1182 363 1 212 213 219 1166 1183 1181 364 1 219 213 220 1183 1184 1185 365 1 213 214 220 1169 1186 1184 366 1 220 214 221 1186 1187 1188 367 1 214 215 221 1172 1189 1187 368 1 221 215 222 1189 1190 1191 369 1 215 216 222 1175 1192 1190 370 1 222 216 223 1192 1193 1194 371 1 216 217 223 1178 1195 1193 372 1 223 217 224 1195 1196 1197 373 1 218 219 225 1182 1198 1199 374 1 225 219 226 1198 1200 1201 375 1 219 220 226 1185 1202 1200 376 1 226 220 227 1202 1203 1204 377 1 220 221 227 1188 1205 1203 378 1 227 221 228 1205 1206 1207 379 1 221 222 228 1191 1208 1206 380 1 228 222 229 1208 1209 1210 381 1 222 223 229 1194 1211 1209 382 1 229 223 230 1211 1212 1213 383 1 223 224 230 1197 1214 1212 384 1 230 224 231 1214 1215 1216 385 1 225 226 232 1201 1217 1218 386 1 232 226 233 1217 1219 1220 387 1 226 227 233 1204 1221 1219 388 1 233 227 234 1221 1222 1223 389 1 227 228 234 1207 1224 1222 390 1 234 228 235 1224 1225 1226 391 1 228 229 235 1210 1227 1225 392 1 235 229 236 1227 1228 1229 393 1 229 230 236 1213 1230 1228 394 1 236 230 237 1230 1231 1232 395 1 230 231 237 1216 1233 1231 396 1 237 231 238 1233 1234 1235 397 1 232 233 239 1220 1236 1237 398 1 239 233 240 1236 1238 1239 399 1 233 234 240 1223 1240 1238 400 1 240 234 241 1240 1241 1242 401 1 234 235 241 1226 1243 1241 402 1 241 235 242 1243 1244 1245 403 1 235 236 242 1229 1246 1244 404 1 242 236 243 1246 1247 1248 405 1 236 237 243 1232 1249 1247 406 1 243 237 244 1249 1250 1251 407 1 237 245 244 1252 1253 1250 408 1 237 238 245 1235 1254 1252 409 2 246 254 253 1255 1256 1257 410 2 246 247 254 1258 1259 1255 411 2 247 248 254 1260 1261 1259 412 2 254 248 255 1261 1262 1263 413 2 248 249 255 1264 1265 1262 414 2 255 249 256 1265 1266 1267 415 2 249 250 256 1268 1269 1266 416 2 256 250 257 1269 1270 1271 417 2 250 251 257 1272 1273 1270 418 2 257 251 258 1273 1274 1275 419 2 251 252 258 1276 1277 1274 420 2 258 252 259 1277 1278 1279 421 2 253 254 260 1256 1280 1281 422 2 260 254 261 1280 1282 1283 423 2 254 255 261 1263 1284 1282 424 2 261 255 262 1284 1285 1286 425 2 255 256 262 1267 1287 1285 426 2 262 256 263 1287 1288 1289 427 2 256 257 263 1271 1290 1288 428 2 263 257 264 1290 1291 1292 429 2 257 258 264 1275 1293 1291 430 2 264 258 265 1293 1294 1295 431 2 258 259 265 1279 1296 1294 432 2 265 259 266 1296 1297 1298 433 2 260 261 267 1283 1299 1300 434 2 267 261 268 1299 1301 1302 435 2 261 262 268 1286 1303 1301 436 2 268 262 269 1303 1304 1305 437 2 262 263 269 1289 1306 1304 438 2 269 263 270 1306 1307 1308 439 2 263 264 270 1292 1309 1307 440 2 270 264 271 1309 1310 1311 441 2 264 265 271 1295 1312 1310 442 2 271 265 272 1312 1313 1314 443 2 265 266 272 1298 1315 1313 444 2 272 266 273 1315 1316 1317 445 2 267 268 274 1302 1318 1319 446 2 274 268 275 1318 1320 1321 447 2 268 269 275 1305 1322 1320 448 2 275 269 276 1322 1323 1324 449 2 269 270 276 1308 1325 1323 450 2 276 270 277 1325 1326 1327 451 2 270 271 277 1311 1328 1326 452 2 277 271 278 1328 1329 1330 453 2 271 272 278 1314 1331 1329 454 2 278 272 279 1331 1332 1333 455 2 272 273 279 1317 1334 1332 456 2 279 273 280 1334 1335 1336 457 2 274 275 281 1321 1337 1338 458 2 281 275 282 1337 1339 1340 459 2 275 276 282 1324 1341 1339 460 2 282 276 283 1341 1342 1343 461 2 276 277 283 1327 1344 1342 462 2 283 277 284 1344 1345 1346 463 2 277 278 284 1330 1347 1345 464 2 284 278 285 1347 1348 1349 465 2 278 279 285 1333 1350 1348 466 2 285 279 286 1350 1351 1352 467 2 279 280 286 1336 1353 1351 468 2 286 280 287 1353 1354 1355 469 2 281 282 288 1340 1356 1357 470 2 288 282 289 1356 1358 1359 471 2 282 283 289 1343 1360 1358 472 2 289 283 290 1360 1361 1362 473 2 283 284 290 1346 1363 1361 474 2 290 284 291 1363 1364 1365 475 2 284 285 291 1349 1366 1364 476 2 291 285 292 1366 1367 1368 477 2 285 286 292 1352 1369 1367 478 2 292 286 293 1369 1370 1371 479 2 286 287 293 1355 1372 1370 480 2 293 287 294 1372 1373 1374 481 2 288 289 295 1359 1375 1376 482 2 295 289 296 1375 1377 1378 483 2 289 290 296 1362 1379 1377 484 2 296 290 297 1379 1380 1381 485 2 290 291 297 1365 1382 1380 486 2 297 291 298 1382 1383 1384 487 2 291 292 298 1368 1385 1383 488 2 298 292 299 1385 1386 1387 489 2 292 293 299 1371 1388 1386 490 2 299 293 300 1388 1389 1390 491 2 293 294 300 1374 1391 1389 492 2 300 294 301 1391 1392 1393 493 2 295 296 302 1378 1394 1395 494 2 302 296 303 1394 1396 1397 495 2 296 297 303 1381 1398 1396 496 2 303 297 304 1398 1399 1400 497 2 297 298 304 1384 1401 1399 498 2 304 298 305 1401 1402 1403 499 2 298 299 305 1387 1404 1402 500 2 305 299 306 1404 1405 1406 501 2 299 300 306 1390 1407 1405 502 2 306 300 307 1407 1408 1409 503 2 300 301 307 1393 1410 1408 504 2 307 301 308 1410 1411 1412 505 2 302 303 309 1397 1413 1414 506 2 309 303 310 1413 1415 1416 507 2 303 304 310 1400 1417 1415 508 2 310 304 311 1417 1418 1419 509 2 304 305 311 1403 1420 1418 510 2 311 305 312 1420 1421 1422 511 2 305 306 312 1406 1423 1421 512 2 312 306 313 1423 1424 1425 513 2 306 307 313 1409 1426 1424 514 2 313 307 314 1426 1427 1428 515 2 307 308 314 1412 1429 1427 516 2 314 308 315 1429 1430 1431 517 2 309 310 316 1416 1432 1433 518 2 316 310 317 1432 1434 1435 519 2 310 311 317 1419 1436 1434 520 2 317 311 318 1436 1437 1438 521 2 311 312 318 1422 1439 1437 522 2 318 312 319 1439 1440 1441 523 2 312 313 319 1425 1442 1440 524 2 319 313 320 1442 1443 1444 525 2 313 314 320 1428 1445 1443 526 2 320 314 321 1445 1446 1447 527 2 314 315 321 1431 1448 1446 528 2 321 315 322 1448 1449 1450 529 2 316 317 323 1435 1451 1452 530 2 323 317 324 1451 1453 1454 531 2 317 318 324 1438 1455 1453 532 2 324 318 325 1455 1456 1457 533 2 318 319 325 1441 1458 1456 534 2 325 319 326 1458 1459 1460 535 2 319 320 326 1444 1461 1459 536 2 326 320 327 1461 1462 1463 537 2 320 321 327 1447 1464 1462 538 2 327 321 328 1464 1465 1466 539 2 321 322 328 1450 1467 1465 540 2 328 322 329 1467 1468 1469 541 2 323 324 330 1454 1470 1471 542 2 330 324 331 1470 1472 1473 543 2 324 325 331 1457 1474 1472 544 2 331 325 332 1474 1475 1476 545 2 325 326 332 1460 1477 1475 546 2 332 326 333 1477 1478 1479 547 2 326 327 333 1463 1480 1478 548 2 333 327 334 1480 1481 1482 549 2 327 328 334 1466 1483 1481 550 2 334 328 335 1483 1484 1485 551 2 328 329 335 1469 1486 1484 552 2 335 329 336 1486 1487 1488 553 2 330 331 337 1473 1489 1490 554 2 337 331 338 1489 1491 1492 555 2 331 332 338 1476 1493 1491 556 2 338 332 339 1493 1494 1495 557 2 332 333 339 1479 1496 1494 558 2 339 333 340 1496 1497 1498 559 2 333 334 340 1482 1499 1497 560 2 340 334 341 1499 1500 1501 561 2 334 335 341 1485 1502 1500 562 2 341 335 342 1502 1503 1504 563 2 335 336 342 1488 1505 1503 564 2 342 336 343 1505 1506 1507 565 2 337 338 344 1492 1508 1509 566 2 344 338 345 1508 1510 1511 567 2 338 339 345 1495 1512 1510 568 2 345 339 346 1512 1513 1514 569 2 339 340 346 1498 1515 1513 570 2 346 340 347 1515 1516 1517 571 2 340 341 347 1501 1518 1516 572 2 347 341 348 1518 1519 1520 573 2 341 342 348 1504 1521 1519 574 2 348 342 349 1521 1522 1523 575 2 342 343 349 1507 1524 1522 576 2 349 343 350 1524 1525 1526 577 2 344 345 351 1511 1527 1528 578 2 351 345 352 1527 1529 1530 579 2 345 346 352 1514 1531 1529 580 2 352 346 353 1531 1532 1533 581 2 346 347 353 1517 1534 1532 582 2 353 347 354 1534 1535 1536 583 2 347 348 354 1520 1537 1535 584 2 354 348 355 1537 1538 1539 585 2 348 349 355 1523 1540 1538 586 2 355 349 356 1540 1541 1542 587 2 349 350 356 1526 1543 1541 588 2 356 350 357 1543 1544 1545 589 2 351 352 358 1530 1546 1547 590 2 358 352 359 1546 1548 1549 591 2 352 353 359 1533 1550 1548 592 2 359 353 360 1550 1551 1552 593 2 353 354 360 1536 1553 1551 594 2 360 354 361 1553 1554 1555 595 2 354 355 361 1539 1556 1554 596 2 361 355 362 1556 1557 1558 597 2 355 356 362 1542 1559 1557 598 2 362 356 363 1559 1560 1561 599 2 356 357 363 1545 1562 1560 600 2 363 357 364 1562 1563 1564 601 2 358 359 365 1549 1565 1566 602 2 365 359 366 1565 1567 1568 603 2 359 360 366 1552 1569 1567 604 2 366 360 367 1569 1570 1571 605 2 360 361 367 1555 1572 1570 606 2 367 361 368 1572 1573 1574 607 2 361 362 368 1558 1575 1573 608 2 368 362 369 1575 1576 1577 609 2 362 363 369 1561 1578 1576 610 2 369 363 370 1578 1579 1580 611 2 363 364 370 1564 1581 1579 612 2 370 364 371 1581 1582 1583 613 2 365 366 372 1568 1584 1585 614 2 372 366 373 1584 1586 1587 615 2 366 367 373 1571 1588 1586 616 2 373 367 374 1588 1589 1590 617 2 367 368 374 1574 1591 1589 618 2 374 368 375 1591 1592 1593 619 2 368 369 375 1577 1594 1592 620 2 375 369 376 1594 1595 1596 621 2 369 370 376 1580 1597 1595 622 2 376 370 377 1597 1598 1599 623 2 370 371 377 1583 1600 1598 624 2 377 371 378 1600 1601 1602 625 2 372 373 379 1587 1603 1604 626 2 379 373 380 1603 1605 1606 627 2 373 374 380 1590 1607 1605 628 2 380 374 381 1607 1608 1609 629 2 374 375 381 1593 1610 1608 630 2 381 375 382 1610 1611 1612 631 2 375 376 382 1596 1613 1611 632 2 382 376 383 1613 1614 1615 633 2 376 377 383 1599 1616 1614 634 2 383 377 384 1616 1617 1618 635 2 377 378 384 1602 1619 1617 636 2 384 378 385 1619 1620 1621 637 2 379 380 386 1606 1622 1623 638 2 386 380 387 1622 1624 1625 639 2 380 381 387 1609 1626 1624 640 2 387 381 388 1626 1627 1628 641 2 381 382 388 1612 1629 1627 642 2 388 382 389 1629 1630 1631 643 2 382 383 389 1615 1632 1630 644 2 389 383 390 1632 1633 1634 645 2 383 384 390 1618 1635 1633 646 2 390 384 391 1635 1636 1637 647 2 384 385 391 1621 1638 1636 648 2 391 385 392 1638 1639 1640 649 2 386 387 393 1625 1641 1642 650 2 393 387 394 1641 1643 1644 651 2 387 388 394 1628 1645 1643 652 2 394 388 395 1645 1646 1647 653 2 388 389 395 1631 1648 1646 654 2 395 389 396 1648 1649 1650 655 2 389 390 396 1634 1651 1649 656 2 396 390 397 1651 1652 1653 657 2 390 391 397 1637 1654 1652 658 2 397 391 398 1654 1655 1656 659 2 391 392 398 1640 1657 1655 660 2 398 392 399 1657 1658 1659 661 2 393 394 400 1644 1660 1661 662 2 400 394 401 1660 1662 1663 663 2 394 395 401 1647 1664 1662 664 2 401 395 402 1664 1665 1666 665 2 395 396 402 1650 1667 1665 666 2 402 396 403 1667 1668 1669 667 2 396 397 403 1653 1670 1668 668 2 403 397 404 1670 1671 1672 669 2 397 398 404 1656 1673 1671 670 2 404 398 405 1673 1674 1675 671 2 398 399 405 1659 1676 1674 672 2 405 399 406 1676 1677 1678 673 2 400 401 407 1663 1679 1680 674 2 407 401 408 1679 1681 1682 675 2 401 402 408 1666 1683 1681 676 2 408 402 409 1683 1684 1685 677 2 402 403 409 1669 1686 1684 678 2 409 403 410 1686 1687 1688 679 2 403 404 410 1672 1689 1687 680 2 410 404 411 1689 1690 1691 681 2 404 405 411 1675 1692 1690 682 2 411 405 412 1692 1693 1694 683 2 405 406 412 1678 1695 1693 684 2 412 406 413 1695 1696 1697 685 2 407 408 414 1682 1698 1699 686 2 414 408 415 1698 1700 1701 687 2 408 409 415 1685 1702 1700 688 2 415 409 416 1702 1703 1704 689 2 409 410 416 1688 1705 1703 690 2 416 410 417 1705 1706 1707 691 2 410 411 417 1691 1708 1706 692 2 417 411 418 1708 1709 1710 693 2 411 412 418 1694 1711 1709 694 2 418 412 419 1711 1712 1713 695 2 412 413 419 1697 1714 1712 696 2 419 413 420 1714 1715 1716 697 2 414 415 421 1701 1717 1718 698 2 421 415 422 1717 1719 1720 699 2 415 416 422 1704 1721 1719 700 2 422 416 423 1721 1722 1723 701 2 416 417 423 1707 1724 1722 702 2 423 417 424 1724 1725 1726 703 2 417 418 424 1710 1727 1725 704 2 424 418 425 1727 1728 1729 705 2 418 419 425 1713 1730 1728 706 2 425 419 426 1730 1731 1732 707 2 419 420 426 1716 1733 1731 708 2 426 420 427 1733 1734 1735 709 2 421 422 428 1720 1736 1737 710 2 428 422 429 1736 1738 1739 711 2 422 423 429 1723 1740 1738 712 2 429 423 430 1740 1741 1742 713 2 423 424 430 1726 1743 1741 714 2 430 424 431 1743 1744 1745 715 2 424 425 431 1729 1746 1744 716 2 431 425 432 1746 1747 1748 717 2 425 426 432 1732 1749 1747 718 2 432 426 433 1749 1750 1751 719 2 426 427 433 1735 1752 1750 720 2 433 427 434 1752 1753 1754 721 2 428 429 435 1739 1755 1756 722 2 435 429 436 1755 1757 1758 723 2 429 430 436 1742 1759 1757 724 2 436 430 437 1759 1760 1761 725 2 430 431 437 1745 1762 1760 726 2 437 431 438 1762 1763 1764 727 2 431 432 438 1748 1765 1763 728 2 438 432 439 1765 1766 1767 729 2 432 433 439 1751 1768 1766 730 2 439 433 440 1768 1769 1770 731 2 433 434 440 1754 1771 1769 732 2 440 434 441 1771 1772 1773 733 2 435 436 442 1758 1774 1775 734 2 442 436 443 1774 1776 1777 735 2 436 437 443 1761 1778 1776 736 2 443 437 444 1778 1779 1780 737 2 437 438 444 1764 1781 1779 738 2 444 438 445 1781 1782 1783 739 2 438 439 445 1767 1784 1782 740 2 445 439 446 1784 1785 1786 741 2 439 440 446 1770 1787 1785 742 2 446 440 447 1787 1788 1789 743 2 440 441 447 1773 1790 1788 744 2 447 441 448 1790 1791 1792 745 2 442 443 449 1777 1793 1794 746 2 449 443 450 1793 1795 1796 747 2 443 444 450 1780 1797 1795 748 2 450 444 451 1797 1798 1799 749 2 444 445 451 1783 1800 1798 750 2 451 445 452 1800 1801 1802 751 2 445 446 452 1786 1803 1801 752 2 452 446 453 1803 1804 1805 753 2 446 447 453 1789 1806 1804 754 2 453 447 454 1806 1807 1808 755 2 447 448 454 1792 1809 1807 756 2 454 448 455 1809 1810 1811 757 2 449 450 456 1796 1812 1813 758 2 456 450 457 1812 1814 1815 759 2 450 451 457 1799 1816 1814 760 2 457 451 458 1816 1817 1818 761 2 451 452 458 1802 1819 1817 762 2 458 452 459 1819 1820 1821 763 2 452 453 459 1805 1822 1820 764 2 459 453 460 1822 1823 1824 765 2 453 454 460 1808 1825 1823 766 2 460 454 461 1825 1826 1827 767 2 454 455 461 1811 1828 1826 768 2 461 455 462 1828 1829 1830 769 2 456 457 463 1815 1831 1832 770 2 463 457 464 1831 1833 1834 771 2 457 458 464 1818 1835 1833 772 2 464 458 465 1835 1836 1837 773 2 458 459 465 1821 1838 1836 774 2 465 459 466 1838 1839 1840 775 2 459 460 466 1824 1841 1839 776 2 466 460 467 1841 1842 1843 777 2 460 461 467 1827 1844 1842 778 2 467 461 468 1844 1845 1846 779 2 461 462 468 1830 1847 1845 780 2 468 462 469 1847 1848 1849 781 2 463 464 470 1834 1850 1851 782 2 470 464 471 1850 1852 1853 783 2 464 465 471 1837 1854 1852 784 2 471 465 472 1854 1855 1856 785 2 465 466 472 1840 1857 1855 786 2 472 466 473 1857 1858 1859 787 2 466 467 473 1843 1860 1858 788 2 473 467 474 1860 1861 1862 789 2 467 468 474 1846 1863 1861 790 2 474 468 475 1863 1864 1865 791 2 468 469 475 1849 1866 1864 792 2 475 469 476 1866 1867 1868 793 2 470 471 477 1853 1869 1870 794 2 477 471 478 1869 1871 1872 795 2 471 472 478 1856 1873 1871 796 2 478 472 479 1873 1874 1875 797 2 472 473 479 1859 1876 1874 798 2 479 473 480 1876 1877 1878 799 2 473 474 480 1862 1879 1877 800 2 480 474 481 1879 1880 1881 801 2 474 475 481 1865 1882 1880 802 2 481 475 482 1882 1883 1884 803 2 475 476 482 1868 1885 1883 804 2 482 476 483 1885 1886 1887 805 2 477 478 484 1872 1888 1889 806 2 484 478 485 1888 1890 1891 807 2 478 479 485 1875 1892 1890 808 2 485 479 486 1892 1893 1894 809 2 479 480 486 1878 1895 1893 810 2 486 480 487 1895 1896 1897 811 2 480 481 487 1881 1898 1896 812 2 487 481 488 1898 1899 1900 813 2 481 482 488 1884 1901 1899 814 2 488 482 489 1901 1902 1903 815 2 482 483 489 1887 1904 1902 816 2 489 483 490 1904 1905 1906 817 2 484 485 491 1891 1907 1908 818 2 491 485 492 1907 1909 1910 819 2 485 486 492 1894 1911 1909 820 2 492 486 493 1911 1912 1913 821 2 486 487 493 1897 1914 1912 822 2 493 487 494 1914 1915 1916 823 2 487 488 494 1900 1917 1915 824 2 494 488 495 1917 1918 1919 825 2 488 489 495 1903 1920 1918 826 2 495 489 496 1920 1921 1922 827 2 489 490 496 1906 1923 1921 828 2 496 490 497 1923 1924 1925 829 2 491 492 498 1910 1926 1927 830 2 498 492 499 1926 1928 1929 831 2 492 493 499 1913 1930 1928 832 2 499 493 500 1930 1931 1932 833 2 493 494 500 1916 1933 1931 834 2 500 494 501 1933 1934 1935 835 2 494 495 501 1919 1936 1934 836 2 501 495 502 1936 1937 1938 837 2 495 496 502 1922 1939 1937 838 2 502 496 503 1939 1940 1941 839 2 496 497 503 1925 1942 1940 840 2 503 497 504 1942 1943 1944 841 2 498 499 505 1929 1945 1946 842 2 505 499 506 1945 1947 1948 843 2 499 500 506 1932 1949 1947 844 2 506 500 507 1949 1950 1951 845 2 500 501 507 1935 1952 1950 846 2 507 501 508 1952 1953 1954 847 2 501 502 508 1938 1955 1953 848 2 508 502 509 1955 1956 1957 849 2 502 503 509 1941 1958 1956 850 2 509 503 510 1958 1959 1960 851 2 503 504 510 1944 1961 1959 852 2 510 504 511 1961 1962 1963 853 2 505 506 512 1948 1964 1965 854 2 512 506 513 1964 1966 1967 855 2 506 507 513 1951 1968 1966 856 2 513 507 514 1968 1969 1970 857 2 507 508 514 1954 1971 1969 858 2 514 508 515 1971 1972 1973 859 2 508 509 515 1957 1974 1972 860 2 515 509 516 1974 1975 1976 861 2 509 510 516 1960 1977 1975 862 2 516 510 517 1977 1978 1979 863 2 510 511 517 1963 1980 1978 864 2 517 511 518 1980 1981 1982 865 2 512 513 519 1967 1983 1984 866 2 519 513 520 1983 1985 1986 867 2 513 514 520 1970 1987 1985 868 2 520 514 521 1987 1988 1989 869 2 514 515 521 1973 1990 1988 870 2 521 515 522 1990 1991 1992 871 2 515 516 522 1976 1993 1991 872 2 522 516 523 1993 1994 1995 873 2 516 517 523 1979 1996 1994 874 2 523 517 524 1996 1997 1998 875 2 517 518 524 1982 1999 1997 876 2 524 518 525 1999 2000 2001 877 2 519 520 526 1986 2002 2003 878 2 526 520 527 2002 2004 2005 879 2 520 521 527 1989 2006 2004 880 2 527 521 528 2006 2007 2008 881 2 521 522 528 1992 2009 2007 882 2 528 522 529 2009 2010 2011 883 2 522 523 529 1995 2012 2010 884 2 529 523 530 2012 2013 2014 885 2 523 524 530 1998 2015 2013 886 2 530 524 531 2015 2016 2017 887 2 524 525 531 2001 2018 2016 888 2 531 525 532 2018 2019 2020 889 2 526 527 533 2005 2021 2022 890 2 533 527 534 2021 2023 2024 891 2 527 528 534 2008 2025 2023 892 2 534 528 535 2025 2026 2027 893 2 528 529 535 2011 2028 2026 894 2 535 529 536 2028 2029 2030 895 2 529 530 536 2014 2031 2029 896 2 536 530 537 2031 2032 2033 897 2 530 531 537 2017 2034 2032 898 2 537 531 538 2034 2035 2036 899 2 531 532 538 2020 2037 2035 900 2 538 532 539 2037 2038 2039 901 2 533 534 540 2024 2040 2041 902 2 540 534 541 2040 2042 2043 903 2 534 535 541 2027 2044 2042 904 2 541 535 542 2044 2045 2046 905 2 535 536 542 2030 2047 2045 906 2 542 536 543 2047 2048 2049 907 2 536 537 543 2033 2050 2048 908 2 543 537 544 2050 2051 2052 909 2 537 538 544 2036 2053 2051 910 2 544 538 545 2053 2054 2055 911 2 538 539 545 2039 2056 2054 912 2 545 539 546 2056 2057 2058 913 2 540 541 547 2043 2059 2060 914 2 547 541 548 2059 2061 2062 915 2 541 542 548 2046 2063 2061 916 2 548 542 549 2063 2064 2065 917 2 542 543 549 2049 2066 2064 918 2 549 543 550 2066 2067 2068 919 2 543 544 550 2052 2069 2067 920 2 550 544 551 2069 2070 2071 921 2 544 545 551 2055 2072 2070 922 2 551 545 552 2072 2073 2074 923 2 545 546 552 2058 2075 2073 924 2 552 546 553 2075 2076 2077 925 2 547 548 554 2062 2078 2079 926 2 554 548 555 2078 2080 2081 927 2 548 549 555 2065 2082 2080 928 2 555 549 556 2082 2083 2084 929 2 549 550 556 2068 2085 2083 930 2 556 550 557 2085 2086 2087 931 2 550 551 557 2071 2088 2086 932 2 557 551 558 2088 2089 2090 933 2 551 552 558 2074 2091 2089 934 2 558 552 559 2091 2092 2093 935 2 552 553 559 2077 2094 2092 936 2 559 553 560 2094 2095 2096 937 2 554 555 561 2081 2097 2098 938 2 561 555 562 2097 2099 2100 939 2 555 556 562 2084 2101 2099 940 2 562 556 563 2101 2102 2103 941 2 556 557 563 2087 2104 2102 942 2 563 557 564 2104 2105 2106 943 2 557 558 564 2090 2107 2105 944 2 564 558 565 2107 2108 2109 945 2 558 559 565 2093 2110 2108 946 2 565 559 566 2110 2111 2112 947 2 559 560 566 2096 2113 2111 948 2 566 560 567 2113 2114 2115 949 2 561 562 568 2100 2116 2117 950 2 568 562 569 2116 2118 2119 951 2 562 563 569 2103 2120 2118 952 2 569 563 570 2120 2121 2122 953 2 563 564 570 2106 2123 2121 954 2 570 564 571 2123 2124 2125 955 2 564 565 571 2109 2126 2124 956 2 571 565 572 2126 2127 2128 957 2 565 566 572 2112 2129 2127 958 2 572 566 573 2129 2130 2131 959 2 566 567 573 2115 2132 2130 960 2 573 567 574 2132 2133 2134 961 2 568 569 575 2119 2135 2136 962 2 575 569 576 2135 2137 2138 963 2 569 570 576 2122 2139 2137 964 2 576 570 577 2139 2140 2141 965 2 570 571 577 2125 2142 2140 966 2 577 571 578 2142 2143 2144 967 2 571 572 578 2128 2145 2143 968 2 578 572 579 2145 2146 2147 969 2 572 573 579 2131 2148 2146 970 2 579 573 580 2148 2149 2150 971 2 573 574 580 2134 2151 2149 972 2 580 574 581 2151 2152 2153 973 2 575 576 582 2138 2154 2155 974 2 582 576 583 2154 2156 2157 975 2 576 577 583 2141 2158 2156 976 2 583 577 584 2158 2159 2160 977 2 577 578 584 2144 2161 2159 978 2 584 578 585 2161 2162 2163 979 2 578 579 585 2147 2164 2162 980 2 585 579 586 2164 2165 2166 981 2 579 580 586 2150 2167 2165 982 2 586 580 587 2167 2168 2169 983 2 580 581 587 2153 2170 2168 984 2 587 581 588 2170 2171 2172 985 2 582 583 589 2157 2173 2174 986 2 589 583 590 2173 2175 2176 987 2 583 584 590 2160 2177 2175 988 2 590 584 591 2177 2178 2179 989 2 584 585 591 2163 2180 2178 990 2 591 585 592 2180 2181 2182 991 2 585 586 592 2166 2183 2181 992 2 592 586 593 2183 2184 2185 993 2 586 587 593 2169 2186 2184 994 2 593 587 594 2186 2187 2188 995 2 587 588 594 2172 2189 2187 996 2 594 588 595 2189 2190 2191 997 2 589 590 596 2176 2192 2193 998 2 596 590 597 2192 2194 2195 999 2 590 591 597 2179 2196 2194 1000 2 597 591 598 2196 2197 2198 1001 2 591 592 598 2182 2199 2197 1002 2 598 592 599 2199 2200 2201 1003 2 592 593 599 2185 2202 2200 1004 2 599 593 600 2202 2203 2204 1005 2 593 594 600 2188 2205 2203 1006 2 600 594 601 2205 2206 2207 1007 2 594 602 601 2208 2209 2206 1008 2 594 595 602 2191 2210 2208 C C$ RUBRIQUE = REFERENCES DES FACES C 1 0 0 1 2 0 0 0 3 0 0 0 4 0 0 0 5 0 0 0 6 0 0 0 7 0 0 0 8 0 0 0 9 0 0 0 10 0 0 0 11 0 0 0 12 0 2 0 13 0 0 1 14 0 0 0 15 0 0 0 16 0 0 0 17 0 0 0 18 0 0 0 19 0 0 0 20 0 0 0 21 0 0 0 22 0 0 0 23 0 0 0 24 0 2 0 25 0 0 1 26 0 0 0 27 0 0 0 28 0 0 0 29 0 0 0 30 0 0 0 31 0 0 0 32 0 0 0 33 0 0 0 34 0 0 0 35 0 0 0 36 0 2 0 37 0 0 1 38 0 0 0 39 0 0 0 40 0 0 0 41 0 0 0 42 0 0 0 43 0 0 0 44 0 0 0 45 0 0 0 46 0 0 0 47 0 0 0 48 0 2 0 49 0 0 1 50 0 0 0 51 0 0 0 52 0 0 0 53 0 0 0 54 0 0 0 55 0 0 0 56 0 0 0 57 0 0 0 58 0 0 0 59 0 0 0 60 0 2 0 61 0 0 1 62 0 0 0 63 0 0 0 64 0 0 0 65 0 0 0 66 0 0 0 67 0 0 0 68 0 0 0 69 0 0 0 70 0 0 0 71 0 0 0 72 0 2 0 73 0 0 1 74 0 0 0 75 0 0 0 76 0 0 0 77 0 0 0 78 0 0 0 79 0 0 0 80 0 0 0 81 0 0 0 82 0 0 0 83 0 0 0 84 0 2 0 85 0 0 1 86 0 0 0 87 0 0 0 88 0 0 0 89 0 0 0 90 0 0 0 91 0 0 0 92 0 0 0 93 0 0 0 94 0 0 0 95 0 0 0 96 0 2 0 97 0 0 1 98 0 0 0 99 0 0 0 100 0 0 0 101 0 0 0 102 0 0 0 103 0 0 0 104 0 0 0 105 0 0 0 106 0 0 0 107 0 0 0 108 0 2 0 109 0 0 1 110 0 0 0 111 0 0 0 112 0 0 0 113 0 0 0 114 0 0 0 115 0 0 0 116 0 0 0 117 0 0 0 118 0 0 0 119 0 0 0 120 0 2 0 121 0 0 1 122 0 0 0 123 0 0 0 124 0 0 0 125 0 0 0 126 0 0 0 127 0 0 0 128 0 0 0 129 0 0 0 130 0 0 0 131 0 0 0 132 0 2 0 133 0 0 1 134 0 0 0 135 0 0 0 136 0 0 0 137 0 0 0 138 0 0 0 139 0 0 0 140 0 0 0 141 0 0 0 142 0 0 0 143 0 0 0 144 0 2 0 145 0 0 1 146 0 0 0 147 0 0 0 148 0 0 0 149 0 0 0 150 0 0 0 151 0 0 0 152 0 0 0 153 0 0 0 154 0 0 0 155 0 0 0 156 0 2 0 157 0 0 1 158 0 0 0 159 0 0 0 160 0 0 0 161 0 0 0 162 0 0 0 163 0 0 0 164 0 0 0 165 0 0 0 166 0 0 0 167 0 0 0 168 0 2 0 169 0 0 1 170 0 0 0 171 0 0 0 172 0 0 0 173 0 0 0 174 0 0 0 175 0 0 0 176 0 0 0 177 0 0 0 178 0 0 0 179 0 0 0 180 0 2 0 181 0 0 1 182 0 0 0 183 0 0 0 184 0 0 0 185 0 0 0 186 0 0 0 187 0 0 0 188 0 0 0 189 0 0 0 190 0 0 0 191 0 0 0 192 0 2 0 193 0 0 1 194 0 0 0 195 0 0 0 196 0 0 0 197 0 0 0 198 0 0 0 199 0 0 0 200 0 0 0 201 0 0 0 202 0 0 0 203 0 0 0 204 0 2 0 205 0 0 1 206 0 0 0 207 0 0 0 208 0 0 0 209 0 0 0 210 0 0 0 211 0 0 0 212 0 0 0 213 0 0 0 214 0 0 0 215 0 0 0 216 0 2 0 217 0 0 1 218 0 0 0 219 0 0 0 220 0 0 0 221 0 0 0 222 0 0 0 223 0 0 0 224 0 0 0 225 0 0 0 226 0 0 0 227 0 0 0 228 0 2 0 229 0 0 1 230 0 0 0 231 0 0 0 232 0 0 0 233 0 0 0 234 0 0 0 235 0 0 0 236 0 0 0 237 0 0 0 238 0 0 0 239 0 0 0 240 0 2 0 241 0 0 1 242 0 0 0 243 0 0 0 244 0 0 0 245 0 0 0 246 0 0 0 247 0 0 0 248 0 0 0 249 0 0 0 250 0 0 0 251 0 0 0 252 0 2 0 253 0 0 1 254 0 0 0 255 0 0 0 256 0 0 0 257 0 0 0 258 0 0 0 259 0 0 0 260 0 0 0 261 0 0 0 262 0 0 0 263 0 0 0 264 0 2 0 265 0 0 1 266 0 0 0 267 0 0 0 268 0 0 0 269 0 0 0 270 0 0 0 271 0 0 0 272 0 0 0 273 0 0 0 274 0 0 0 275 0 0 0 276 0 2 0 277 0 0 1 278 0 0 0 279 0 0 0 280 0 0 0 281 0 0 0 282 0 0 0 283 0 0 0 284 0 0 0 285 0 0 0 286 0 0 0 287 0 0 0 288 0 2 0 289 0 0 1 290 0 0 0 291 0 0 0 292 0 0 0 293 0 0 0 294 0 0 0 295 0 0 0 296 0 0 0 297 0 0 0 298 0 0 0 299 0 0 0 300 0 2 0 301 0 0 1 302 0 0 0 303 0 0 0 304 0 0 0 305 0 0 0 306 0 0 0 307 0 0 0 308 0 0 0 309 0 0 0 310 0 0 0 311 0 0 0 312 0 2 0 313 0 0 1 314 0 0 0 315 0 0 0 316 0 0 0 317 0 0 0 318 0 0 0 319 0 0 0 320 0 0 0 321 0 0 0 322 0 0 0 323 0 0 0 324 0 2 0 325 0 0 1 326 0 0 0 327 0 0 0 328 0 0 0 329 0 0 0 330 0 0 0 331 0 0 0 332 0 0 0 333 0 0 0 334 0 0 0 335 0 0 0 336 0 2 0 337 0 0 1 338 0 0 0 339 0 0 0 340 0 0 0 341 0 0 0 342 0 0 0 343 0 0 0 344 0 0 0 345 0 0 0 346 0 0 0 347 0 0 0 348 0 2 0 349 0 0 1 350 0 0 0 351 0 0 0 352 0 0 0 353 0 0 0 354 0 0 0 355 0 0 0 356 0 0 0 357 0 0 0 358 0 0 0 359 0 0 0 360 0 2 0 361 0 0 1 362 0 0 0 363 0 0 0 364 0 0 0 365 0 0 0 366 0 0 0 367 0 0 0 368 0 0 0 369 0 0 0 370 0 0 0 371 0 0 0 372 0 2 0 373 0 0 1 374 0 0 0 375 0 0 0 376 0 0 0 377 0 0 0 378 0 0 0 379 0 0 0 380 0 0 0 381 0 0 0 382 0 0 0 383 0 0 0 384 0 2 0 385 0 0 1 386 0 0 0 387 0 0 0 388 0 0 0 389 0 0 0 390 0 0 0 391 0 0 0 392 0 0 0 393 0 0 0 394 0 0 0 395 0 0 0 396 0 2 0 397 0 0 1 398 0 0 0 399 0 0 0 400 0 0 0 401 0 0 0 402 0 0 0 403 0 0 0 404 0 0 0 405 0 0 0 406 0 0 0 407 0 0 0 408 0 2 0 409 0 0 3 410 0 0 0 411 0 0 0 412 0 0 0 413 0 0 0 414 0 0 0 415 0 0 0 416 0 0 0 417 0 0 0 418 0 0 0 419 0 0 0 420 0 4 0 421 0 0 3 422 0 0 0 423 0 0 0 424 0 0 0 425 0 0 0 426 0 0 0 427 0 0 0 428 0 0 0 429 0 0 0 430 0 0 0 431 0 0 0 432 0 4 0 433 0 0 3 434 0 0 0 435 0 0 0 436 0 0 0 437 0 0 0 438 0 0 0 439 0 0 0 440 0 0 0 441 0 0 0 442 0 0 0 443 0 0 0 444 0 4 0 445 0 0 3 446 0 0 0 447 0 0 0 448 0 0 0 449 0 0 0 450 0 0 0 451 0 0 0 452 0 0 0 453 0 0 0 454 0 0 0 455 0 0 0 456 0 4 0 457 0 0 3 458 0 0 0 459 0 0 0 460 0 0 0 461 0 0 0 462 0 0 0 463 0 0 0 464 0 0 0 465 0 0 0 466 0 0 0 467 0 0 0 468 0 4 0 469 0 0 3 470 0 0 0 471 0 0 0 472 0 0 0 473 0 0 0 474 0 0 0 475 0 0 0 476 0 0 0 477 0 0 0 478 0 0 0 479 0 0 0 480 0 4 0 481 0 0 3 482 0 0 0 483 0 0 0 484 0 0 0 485 0 0 0 486 0 0 0 487 0 0 0 488 0 0 0 489 0 0 0 490 0 0 0 491 0 0 0 492 0 4 0 493 0 0 3 494 0 0 0 495 0 0 0 496 0 0 0 497 0 0 0 498 0 0 0 499 0 0 0 500 0 0 0 501 0 0 0 502 0 0 0 503 0 0 0 504 0 4 0 505 0 0 3 506 0 0 0 507 0 0 0 508 0 0 0 509 0 0 0 510 0 0 0 511 0 0 0 512 0 0 0 513 0 0 0 514 0 0 0 515 0 0 0 516 0 4 0 517 0 0 3 518 0 0 0 519 0 0 0 520 0 0 0 521 0 0 0 522 0 0 0 523 0 0 0 524 0 0 0 525 0 0 0 526 0 0 0 527 0 0 0 528 0 4 0 529 0 0 3 530 0 0 0 531 0 0 0 532 0 0 0 533 0 0 0 534 0 0 0 535 0 0 0 536 0 0 0 537 0 0 0 538 0 0 0 539 0 0 0 540 0 4 0 541 0 0 3 542 0 0 0 543 0 0 0 544 0 0 0 545 0 0 0 546 0 0 0 547 0 0 0 548 0 0 0 549 0 0 0 550 0 0 0 551 0 0 0 552 0 4 0 553 0 0 3 554 0 0 0 555 0 0 0 556 0 0 0 557 0 0 0 558 0 0 0 559 0 0 0 560 0 0 0 561 0 0 0 562 0 0 0 563 0 0 0 564 0 4 0 565 0 0 3 566 0 0 0 567 0 0 0 568 0 0 0 569 0 0 0 570 0 0 0 571 0 0 0 572 0 0 0 573 0 0 0 574 0 0 0 575 0 0 0 576 0 4 0 577 0 0 3 578 0 0 0 579 0 0 0 580 0 0 0 581 0 0 0 582 0 0 0 583 0 0 0 584 0 0 0 585 0 0 0 586 0 0 0 587 0 0 0 588 0 4 0 589 0 0 3 590 0 0 0 591 0 0 0 592 0 0 0 593 0 0 0 594 0 0 0 595 0 0 0 596 0 0 0 597 0 0 0 598 0 0 0 599 0 0 0 600 0 4 0 601 0 0 3 602 0 0 0 603 0 0 0 604 0 0 0 605 0 0 0 606 0 0 0 607 0 0 0 608 0 0 0 609 0 0 0 610 0 0 0 611 0 0 0 612 0 4 0 613 0 0 3 614 0 0 0 615 0 0 0 616 0 0 0 617 0 0 0 618 0 0 0 619 0 0 0 620 0 0 0 621 0 0 0 622 0 0 0 623 0 0 0 624 0 4 0 625 0 0 3 626 0 0 0 627 0 0 0 628 0 0 0 629 0 0 0 630 0 0 0 631 0 0 0 632 0 0 0 633 0 0 0 634 0 0 0 635 0 0 0 636 0 4 0 637 0 0 3 638 0 0 0 639 0 0 0 640 0 0 0 641 0 0 0 642 0 0 0 643 0 0 0 644 0 0 0 645 0 0 0 646 0 0 0 647 0 0 0 648 0 4 0 649 0 0 3 650 0 0 0 651 0 0 0 652 0 0 0 653 0 0 0 654 0 0 0 655 0 0 0 656 0 0 0 657 0 0 0 658 0 0 0 659 0 0 0 660 0 4 0 661 0 0 3 662 0 0 0 663 0 0 0 664 0 0 0 665 0 0 0 666 0 0 0 667 0 0 0 668 0 0 0 669 0 0 0 670 0 0 0 671 0 0 0 672 0 4 0 673 0 0 3 674 0 0 0 675 0 0 0 676 0 0 0 677 0 0 0 678 0 0 0 679 0 0 0 680 0 0 0 681 0 0 0 682 0 0 0 683 0 0 0 684 0 4 0 685 0 0 3 686 0 0 0 687 0 0 0 688 0 0 0 689 0 0 0 690 0 0 0 691 0 0 0 692 0 0 0 693 0 0 0 694 0 0 0 695 0 0 0 696 0 4 0 697 0 0 3 698 0 0 0 699 0 0 0 700 0 0 0 701 0 0 0 702 0 0 0 703 0 0 0 704 0 0 0 705 0 0 0 706 0 0 0 707 0 0 0 708 0 4 0 709 0 0 3 710 0 0 0 711 0 0 0 712 0 0 0 713 0 0 0 714 0 0 0 715 0 0 0 716 0 0 0 717 0 0 0 718 0 0 0 719 0 0 0 720 0 4 0 721 0 0 3 722 0 0 0 723 0 0 0 724 0 0 0 725 0 0 0 726 0 0 0 727 0 0 0 728 0 0 0 729 0 0 0 730 0 0 0 731 0 0 0 732 0 4 0 733 0 0 3 734 0 0 0 735 0 0 0 736 0 0 0 737 0 0 0 738 0 0 0 739 0 0 0 740 0 0 0 741 0 0 0 742 0 0 0 743 0 0 0 744 0 4 0 745 0 0 3 746 0 0 0 747 0 0 0 748 0 0 0 749 0 0 0 750 0 0 0 751 0 0 0 752 0 0 0 753 0 0 0 754 0 0 0 755 0 0 0 756 0 4 0 757 0 0 3 758 0 0 0 759 0 0 0 760 0 0 0 761 0 0 0 762 0 0 0 763 0 0 0 764 0 0 0 765 0 0 0 766 0 0 0 767 0 0 0 768 0 4 0 769 0 0 3 770 0 0 0 771 0 0 0 772 0 0 0 773 0 0 0 774 0 0 0 775 0 0 0 776 0 0 0 777 0 0 0 778 0 0 0 779 0 0 0 780 0 4 0 781 0 0 3 782 0 0 0 783 0 0 0 784 0 0 0 785 0 0 0 786 0 0 0 787 0 0 0 788 0 0 0 789 0 0 0 790 0 0 0 791 0 0 0 792 0 4 0 793 0 0 3 794 0 0 0 795 0 0 0 796 0 0 0 797 0 0 0 798 0 0 0 799 0 0 0 800 0 0 0 801 0 0 0 802 0 0 0 803 0 0 0 804 0 4 0 805 0 0 3 806 0 0 0 807 0 0 0 808 0 0 0 809 0 0 0 810 0 0 0 811 0 0 0 812 0 0 0 813 0 0 0 814 0 0 0 815 0 0 0 816 0 4 0 817 0 0 3 818 0 0 0 819 0 0 0 820 0 0 0 821 0 0 0 822 0 0 0 823 0 0 0 824 0 0 0 825 0 0 0 826 0 0 0 827 0 0 0 828 0 4 0 829 0 0 3 830 0 0 0 831 0 0 0 832 0 0 0 833 0 0 0 834 0 0 0 835 0 0 0 836 0 0 0 837 0 0 0 838 0 0 0 839 0 0 0 840 0 4 0 841 0 0 3 842 0 0 0 843 0 0 0 844 0 0 0 845 0 0 0 846 0 0 0 847 0 0 0 848 0 0 0 849 0 0 0 850 0 0 0 851 0 0 0 852 0 4 0 853 0 0 3 854 0 0 0 855 0 0 0 856 0 0 0 857 0 0 0 858 0 0 0 859 0 0 0 860 0 0 0 861 0 0 0 862 0 0 0 863 0 0 0 864 0 4 0 865 0 0 3 866 0 0 0 867 0 0 0 868 0 0 0 869 0 0 0 870 0 0 0 871 0 0 0 872 0 0 0 873 0 0 0 874 0 0 0 875 0 0 0 876 0 4 0 877 0 0 3 878 0 0 0 879 0 0 0 880 0 0 0 881 0 0 0 882 0 0 0 883 0 0 0 884 0 0 0 885 0 0 0 886 0 0 0 887 0 0 0 888 0 4 0 889 0 0 3 890 0 0 0 891 0 0 0 892 0 0 0 893 0 0 0 894 0 0 0 895 0 0 0 896 0 0 0 897 0 0 0 898 0 0 0 899 0 0 0 900 0 4 0 901 0 0 3 902 0 0 0 903 0 0 0 904 0 0 0 905 0 0 0 906 0 0 0 907 0 0 0 908 0 0 0 909 0 0 0 910 0 0 0 911 0 0 0 912 0 4 0 913 0 0 3 914 0 0 0 915 0 0 0 916 0 0 0 917 0 0 0 918 0 0 0 919 0 0 0 920 0 0 0 921 0 0 0 922 0 0 0 923 0 0 0 924 0 4 0 925 0 0 3 926 0 0 0 927 0 0 0 928 0 0 0 929 0 0 0 930 0 0 0 931 0 0 0 932 0 0 0 933 0 0 0 934 0 0 0 935 0 0 0 936 0 4 0 937 0 0 3 938 0 0 0 939 0 0 0 940 0 0 0 941 0 0 0 942 0 0 0 943 0 0 0 944 0 0 0 945 0 0 0 946 0 0 0 947 0 0 0 948 0 4 0 949 0 0 3 950 0 0 0 951 0 0 0 952 0 0 0 953 0 0 0 954 0 0 0 955 0 0 0 956 0 0 0 957 0 0 0 958 0 0 0 959 0 0 0 960 0 4 0 961 0 0 3 962 0 0 0 963 0 0 0 964 0 0 0 965 0 0 0 966 0 0 0 967 0 0 0 968 0 0 0 969 0 0 0 970 0 0 0 971 0 0 0 972 0 4 0 973 0 0 3 974 0 0 0 975 0 0 0 976 0 0 0 977 0 0 0 978 0 0 0 979 0 0 0 980 0 0 0 981 0 0 0 982 0 0 0 983 0 0 0 984 0 4 0 985 0 0 3 986 0 0 0 987 0 0 0 988 0 0 0 989 0 0 0 990 0 0 0 991 0 0 0 992 0 0 0 993 0 0 0 994 0 0 0 995 0 0 0 996 0 4 0 997 0 0 3 998 0 0 0 999 0 0 0 1000 0 0 0 1001 0 0 0 1002 0 0 0 1003 0 0 0 1004 0 0 0 1005 0 0 0 1006 0 0 0 1007 0 0 0 1008 0 4 0 syrthes-3.4.3-dfsg1/example/cylinder/RESU/raygeo.syr0000666000175000017500000002021311524070640020754 0ustar pinipiniC************************************************C C FICHIER GEOMETRIQUE SYRTHES - Rayonnement - C C************************************************C C DIMENSION = 2 DIMENSION DES ELTS = 1 C NOMBRE DE NOEUDS = 86 C NOMBRE D'ELEMENTS = 84 C NOMBRE DE NOEUDS PAR ELEMENT = 2 C************************************************C C C$ RUBRIQUE = NOEUDS C 1 0 0.0000000E+00 -0.1000000E+01 0.0000000E+00 2 0 0.6279052E-01 -0.9980267E+00 0.0000000E+00 3 0 0.1253332E+00 -0.9921147E+00 0.0000000E+00 4 0 0.1873813E+00 -0.9822872E+00 0.0000000E+00 5 0 0.2486899E+00 -0.9685832E+00 0.0000000E+00 6 0 0.3090170E+00 -0.9510565E+00 0.0000000E+00 7 0 0.3681245E+00 -0.9297765E+00 0.0000000E+00 8 0 0.4257793E+00 -0.9048271E+00 0.0000000E+00 9 0 0.4817537E+00 -0.8763067E+00 0.0000000E+00 10 0 0.5358268E+00 -0.8443279E+00 0.0000000E+00 11 0 0.5877852E+00 -0.8090170E+00 0.0000000E+00 12 0 0.6374241E+00 -0.7705132E+00 0.0000000E+00 13 0 0.6845471E+00 -0.7289686E+00 0.0000000E+00 14 0 0.7289687E+00 -0.6845471E+00 0.0000000E+00 15 0 0.7705132E+00 -0.6374240E+00 0.0000000E+00 16 0 0.8090170E+00 -0.5877852E+00 0.0000000E+00 17 0 0.8443279E+00 -0.5358267E+00 0.0000000E+00 18 0 0.8763067E+00 -0.4817536E+00 0.0000000E+00 19 0 0.9048271E+00 -0.4257793E+00 0.0000000E+00 20 0 0.9297765E+00 -0.3681245E+00 0.0000000E+00 21 0 0.9510565E+00 -0.3090170E+00 0.0000000E+00 22 0 0.9685832E+00 -0.2486898E+00 0.0000000E+00 23 0 0.9822873E+00 -0.1873812E+00 0.0000000E+00 24 0 0.9921147E+00 -0.1253332E+00 0.0000000E+00 25 0 0.9980267E+00 -0.6279050E-01 0.0000000E+00 26 0 0.1000000E+01 0.0000000E+00 0.0000000E+00 27 0 0.9980267E+00 0.6279052E-01 0.0000000E+00 28 0 0.9921147E+00 0.1253332E+00 0.0000000E+00 29 0 0.9822872E+00 0.1873813E+00 0.0000000E+00 30 0 0.9685832E+00 0.2486899E+00 0.0000000E+00 31 0 0.9510565E+00 0.3090170E+00 0.0000000E+00 32 0 0.9297765E+00 0.3681245E+00 0.0000000E+00 33 0 0.9048271E+00 0.4257793E+00 0.0000000E+00 34 0 0.8763067E+00 0.4817537E+00 0.0000000E+00 35 0 0.8443279E+00 0.5358268E+00 0.0000000E+00 36 0 0.8090170E+00 0.5877852E+00 0.0000000E+00 37 0 0.7705132E+00 0.6374241E+00 0.0000000E+00 38 0 0.7289686E+00 0.6845471E+00 0.0000000E+00 39 0 0.6845471E+00 0.7289687E+00 0.0000000E+00 40 0 0.6374240E+00 0.7705132E+00 0.0000000E+00 41 0 0.5877852E+00 0.8090170E+00 0.0000000E+00 42 0 0.5358267E+00 0.8443279E+00 0.0000000E+00 43 0 0.4817536E+00 0.8763067E+00 0.0000000E+00 44 0 0.4257793E+00 0.9048271E+00 0.0000000E+00 45 0 0.3681245E+00 0.9297765E+00 0.0000000E+00 46 0 0.3090170E+00 0.9510565E+00 0.0000000E+00 47 0 0.2486898E+00 0.9685832E+00 0.0000000E+00 48 0 0.1873812E+00 0.9822873E+00 0.0000000E+00 49 0 0.1253332E+00 0.9921147E+00 0.0000000E+00 50 0 0.6279050E-01 0.9980267E+00 0.0000000E+00 51 0 0.0000000E+00 0.1000000E+01 0.0000000E+00 52 0 0.0000000E+00 -0.5000000E+00 0.0000000E+00 53 0 0.4613418E-01 -0.4978671E+00 0.0000000E+00 54 0 0.9187476E-01 -0.4914865E+00 0.0000000E+00 55 0 0.1368315E+00 -0.4809128E+00 0.0000000E+00 56 0 0.1806208E+00 -0.4662361E+00 0.0000000E+00 57 0 0.2228692E+00 -0.4475816E+00 0.0000000E+00 58 0 0.2632161E+00 -0.4251086E+00 0.0000000E+00 59 0 0.3013173E+00 -0.3990086E+00 0.0000000E+00 60 0 0.3368478E+00 -0.3695045E+00 0.0000000E+00 61 0 0.3695045E+00 -0.3368478E+00 0.0000000E+00 62 0 0.3990086E+00 -0.3013173E+00 0.0000000E+00 63 0 0.4251086E+00 -0.2632161E+00 0.0000000E+00 64 0 0.4475816E+00 -0.2228692E+00 0.0000000E+00 65 0 0.4662361E+00 -0.1806208E+00 0.0000000E+00 66 0 0.4809128E+00 -0.1368315E+00 0.0000000E+00 67 0 0.4914865E+00 -0.9187473E-01 0.0000000E+00 68 0 0.4978671E+00 -0.4613419E-01 0.0000000E+00 69 0 0.5000000E+00 0.0000000E+00 0.0000000E+00 70 0 0.4978671E+00 0.4613418E-01 0.0000000E+00 71 0 0.4914865E+00 0.9187476E-01 0.0000000E+00 72 0 0.4809128E+00 0.1368315E+00 0.0000000E+00 73 0 0.4662361E+00 0.1806208E+00 0.0000000E+00 74 0 0.4475816E+00 0.2228692E+00 0.0000000E+00 75 0 0.4251086E+00 0.2632161E+00 0.0000000E+00 76 0 0.3990086E+00 0.3013173E+00 0.0000000E+00 77 0 0.3695045E+00 0.3368478E+00 0.0000000E+00 78 0 0.3368478E+00 0.3695045E+00 0.0000000E+00 79 0 0.3013173E+00 0.3990086E+00 0.0000000E+00 80 0 0.2632161E+00 0.4251086E+00 0.0000000E+00 81 0 0.2228692E+00 0.4475816E+00 0.0000000E+00 82 0 0.1806208E+00 0.4662361E+00 0.0000000E+00 83 0 0.1368315E+00 0.4809128E+00 0.0000000E+00 84 0 0.9187473E-01 0.4914865E+00 0.0000000E+00 85 0 0.4613419E-01 0.4978671E+00 0.0000000E+00 86 0 0.0000000E+00 0.5000000E+00 0.0000000E+00 C C$ RUBRIQUE = ELEMENTS C 1 3 1 2 2 3 2 3 3 3 3 4 4 3 4 5 5 3 5 6 6 3 6 7 7 3 7 8 8 3 8 9 9 3 9 10 10 3 10 11 11 3 11 12 12 3 12 13 13 3 13 14 14 3 14 15 15 3 15 16 16 3 16 17 17 3 17 18 18 3 18 19 19 3 19 20 20 3 20 21 21 3 21 22 22 3 22 23 23 3 23 24 24 3 24 25 25 3 25 26 26 3 26 27 27 3 27 28 28 3 28 29 29 3 29 30 30 3 30 31 31 3 31 32 32 3 32 33 33 3 33 34 34 3 34 35 35 3 35 36 36 3 36 37 37 3 37 38 38 3 38 39 39 3 39 40 40 3 40 41 41 3 41 42 42 3 42 43 43 3 43 44 44 3 44 45 45 3 45 46 46 3 46 47 47 3 47 48 48 3 48 49 49 3 49 50 50 3 50 51 51 2 52 53 52 2 53 54 53 2 54 55 54 2 55 56 55 2 56 57 56 2 57 58 57 2 58 59 58 2 59 60 59 2 60 61 60 2 61 62 61 2 62 63 62 2 63 64 63 2 64 65 64 2 65 66 65 2 66 67 66 2 67 68 67 2 68 69 68 2 69 70 69 2 70 71 70 2 71 72 71 2 72 73 72 2 73 74 73 2 74 75 74 2 75 76 75 2 76 77 76 2 77 78 77 2 78 79 78 2 79 80 79 2 80 81 80 2 81 82 81 2 82 83 82 2 83 84 83 2 84 85 84 2 85 86 syrthes-3.4.3-dfsg1/example/cylinder/RESU/resusc10000666000175000017500000044171611524070640020256 0ustar pinipini************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 20 0.3600000000000E+05 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9149211E+030.8455484E+030.7869032E+030.7361216E+030.6913535E+03 0.6513293E+030.1000000E+040.9149209E+030.8455483E+030.7869031E+030.7361215E+03 0.6913534E+030.6513298E+030.1000000E+040.9149209E+030.8455482E+030.7869030E+03 0.7361213E+030.6913532E+030.6513296E+030.1000000E+040.9149208E+030.8455482E+03 0.7869029E+030.7361211E+030.6913530E+030.6513292E+030.1000000E+040.9149206E+03 0.8455480E+030.7869027E+030.7361209E+030.6913526E+030.6513286E+030.1000000E+04 0.9149207E+030.8455479E+030.7869025E+030.7361206E+030.6913521E+030.6513280E+03 0.1000000E+040.9149207E+030.8455479E+030.7869024E+030.7361203E+030.6913518E+03 0.6513276E+030.1000000E+040.9149206E+030.8455478E+030.7869022E+030.7361201E+03 0.6913515E+030.6513270E+030.1000000E+040.9149205E+030.8455477E+030.7869021E+03 0.7361200E+030.6913513E+030.6513267E+030.1000000E+040.9149206E+030.8455476E+03 0.7869020E+030.7361199E+030.6913512E+030.6513265E+030.1000000E+040.9149205E+03 0.8455477E+030.7869020E+030.7361199E+030.6913512E+030.6513267E+030.1000000E+04 0.9149204E+030.8455476E+030.7869020E+030.7361200E+030.6913513E+030.6513269E+03 0.1000000E+040.9149205E+030.8455477E+030.7869021E+030.7361201E+030.6913514E+03 0.6513272E+030.1000000E+040.9149205E+030.8455477E+030.7869021E+030.7361202E+03 0.6913517E+030.6513276E+030.1000000E+040.9149206E+030.8455477E+030.7869022E+03 0.7361203E+030.6913520E+030.6513279E+030.1000000E+040.9149205E+030.8455477E+03 0.7869023E+030.7361204E+030.6913522E+030.6513283E+030.1000000E+040.9149206E+03 0.8455478E+030.7869023E+030.7361205E+030.6913523E+030.6513286E+030.1000000E+04 0.9149207E+030.8455477E+030.7869023E+030.7361205E+030.6913523E+030.6513286E+03 0.1000000E+040.9149206E+030.8455478E+030.7869023E+030.7361206E+030.6913523E+03 0.6513285E+030.1000000E+040.9149205E+030.8455478E+030.7869023E+030.7361205E+03 0.6913521E+030.6513283E+030.1000000E+040.9149205E+030.8455477E+030.7869022E+03 0.7361203E+030.6913519E+030.6513279E+030.1000000E+040.9149204E+030.8455476E+03 0.7869020E+030.7361201E+030.6913517E+030.6513275E+030.1000000E+040.9149206E+03 0.8455476E+030.7869020E+030.7361200E+030.6913514E+030.6513271E+030.1000000E+04 0.9149205E+030.8455476E+030.7869020E+030.7361198E+030.6913511E+030.6513268E+03 0.1000000E+040.9149204E+030.8455476E+030.7869019E+030.7361198E+030.6913511E+03 0.6513265E+030.1000000E+040.9149204E+030.8455476E+030.7869019E+030.7361198E+03 0.6913510E+030.6513265E+030.1000000E+040.9149205E+030.8455475E+030.7869020E+03 0.7361198E+030.6913511E+030.6513265E+030.1000000E+040.9149204E+030.8455477E+03 0.7869020E+030.7361200E+030.6913513E+030.6513269E+030.1000000E+040.9149205E+03 0.8455477E+030.7869021E+030.7361201E+030.6913516E+030.6513273E+030.1000000E+04 0.9149207E+030.8455478E+030.7869022E+030.7361204E+030.6913519E+030.6513278E+03 0.1000000E+040.9149206E+030.8455478E+030.7869024E+030.7361206E+030.6913523E+03 0.6513284E+030.1000000E+040.9149207E+030.8455479E+030.7869026E+030.7361208E+03 0.6913527E+030.6513289E+030.1000000E+040.9149206E+030.8455479E+030.7869027E+03 0.7361210E+030.6913530E+030.6513295E+030.1000000E+040.9149207E+030.8455480E+03 0.7869027E+030.7361211E+030.6913530E+030.6513304E+030.1000000E+040.9149207E+03 0.8455479E+030.7869026E+030.7361211E+030.6913540E+030.6513295E+030.9783162E+02 0.7940021E+020.6193028E+020.4533453E+020.2952165E+020.1441339E+020.0000000E+00 0.9783305E+020.7939171E+020.6192678E+020.4533260E+020.2952048E+020.1441281E+02 0.0000000E+000.9781608E+020.7938352E+020.6192031E+020.4532805E+020.2951757E+02 0.1441157E+020.0000000E+000.9779912E+020.7937094E+020.6191126E+020.4532196E+02 0.2951358E+020.1440948E+020.0000000E+000.9778018E+020.7935677E+020.6190082E+02 0.4531441E+020.2950904E+020.1440726E+020.0000000E+000.9776140E+020.7934222E+02 0.6188977E+020.4530659E+020.2950401E+020.1440473E+020.0000000E+000.9774336E+02 0.7932792E+020.6187893E+020.4529897E+020.2949913E+020.1440230E+020.0000000E+00 0.9772637E+020.7931459E+020.6186879E+020.4529161E+020.2949436E+020.1440010E+02 0.0000000E+000.9771112E+020.7930251E+020.6185948E+020.4528477E+020.2949012E+02 0.1439817E+020.0000000E+000.9769803E+020.7929203E+020.6185144E+020.4527908E+02 0.2948637E+020.1439625E+020.0000000E+000.9768710E+020.7928338E+020.6184481E+02 0.4527432E+020.2948327E+020.1439475E+020.0000000E+000.9767864E+020.7927678E+02 0.6183985E+020.4527074E+020.2948094E+020.1439365E+020.0000000E+000.9767329E+02 0.7927263E+020.6183670E+020.4526850E+020.2947952E+020.1439294E+020.0000000E+00 0.9767103E+020.7927104E+020.6183560E+020.4526779E+020.2947907E+020.1439275E+02 0.0000000E+000.9767226E+020.7927231E+020.6183671E+020.4526863E+020.2947965E+02 0.1439299E+020.0000000E+000.9767769E+020.7927681E+020.6184021E+020.4527116E+02 0.2948127E+020.1439384E+020.0000000E+000.9768765E+020.7928464E+020.6184610E+02 0.4527535E+020.2948403E+020.1439508E+020.0000000E+000.9770224E+020.7929555E+02 0.6185416E+020.4528097E+020.2948759E+020.1439693E+020.0000000E+000.9772002E+02 0.7930853E+020.6186358E+020.4528759E+020.2949174E+020.1439874E+020.0000000E+00 0.9773806E+020.7932191E+020.6187336E+020.4529443E+020.2949594E+020.1440072E+02 0.0000000E+000.9775423E+020.7933438E+020.6188268E+020.4530094E+020.2950006E+02 0.1440274E+020.0000000E+000.9776814E+020.7934528E+020.6189090E+020.4530666E+02 0.2950379E+020.1440463E+020.0000000E+000.9777940E+020.7935393E+020.6189743E+02 0.4531159E+020.2950677E+020.1440612E+020.0000000E+000.9778680E+020.7936016E+02 0.6190226E+020.4531489E+020.2950904E+020.1440736E+020.0000000E+000.9779174E+02 0.7936395E+020.6190515E+020.4531704E+020.2951047E+020.1440800E+020.0000000E+00 0.9779332E+020.7936522E+020.6190616E+020.4531771E+020.2951095E+020.1440821E+02 0.0000000E+000.9779173E+020.7936396E+020.6190515E+020.4531706E+020.2951050E+02 0.1440797E+020.0000000E+000.9778679E+020.7936013E+020.6190225E+020.4531488E+02 0.2950901E+020.1440739E+020.0000000E+000.9777938E+020.7935388E+020.6189745E+02 0.4531160E+020.2950671E+020.1440611E+020.0000000E+000.9776809E+020.7934521E+02 0.6189086E+020.4530666E+020.2950382E+020.1440466E+020.0000000E+000.9775424E+02 0.7933443E+020.6188265E+020.4530088E+020.2950008E+020.1440275E+020.0000000E+00 0.9773806E+020.7932188E+020.6187332E+020.4529442E+020.2949600E+020.1440074E+02 0.0000000E+000.9771996E+020.7930847E+020.6186356E+020.4528755E+020.2949159E+02 0.1439867E+020.0000000E+000.9770208E+020.7929546E+020.6185408E+020.4528081E+02 0.2948751E+020.1439692E+020.0000000E+000.9768747E+020.7928448E+020.6184599E+02 0.4527527E+020.2948396E+020.1439509E+020.0000000E+000.9767746E+020.7927659E+02 0.6184004E+020.4527103E+020.2948122E+020.1439377E+020.0000000E+000.9767191E+02 0.7927204E+020.6183646E+020.4526845E+020.2947951E+020.1439296E+020.0000000E+00 0.9767062E+020.7927066E+020.6183525E+020.4526753E+020.2947889E+020.1439264E+02 0.0000000E+000.9767269E+020.7927211E+020.6183625E+020.4526817E+020.2947928E+02 0.1439284E+020.0000000E+000.9767791E+020.7927610E+020.6183920E+020.4527023E+02 0.2948060E+020.1439343E+020.0000000E+000.9768603E+020.7928238E+020.6184393E+02 0.4527361E+020.2948275E+020.1439454E+020.0000000E+000.9769661E+020.7929065E+02 0.6185024E+020.4527810E+020.2948570E+020.1439588E+020.0000000E+000.9770916E+02 0.7930061E+020.6185785E+020.4528356E+020.2948922E+020.1439772E+020.0000000E+00 0.9772374E+020.7931204E+020.6186651E+020.4528981E+020.2949324E+020.1439948E+02 0.0000000E+000.9773983E+020.7932455E+020.6187597E+020.4529659E+020.2949743E+02 0.1440146E+020.0000000E+000.9775676E+020.7933771E+020.6188585E+020.4530351E+02 0.2950183E+020.1440363E+020.0000000E+000.9777418E+020.7935101E+020.6189570E+02 0.4531029E+020.2950617E+020.1440580E+020.0000000E+000.9779112E+020.7936337E+02 0.6190462E+020.4531671E+020.2951000E+020.1440768E+020.0000000E+000.9780536E+02 0.7937370E+020.6191193E+020.4532149E+020.2951310E+020.1440925E+020.0000000E+00 0.9781563E+020.7938038E+020.6191653E+020.4532467E+020.2951508E+020.1440966E+02 0.0000000E+000.9781505E+020.7938184E+020.6191782E+020.4532557E+020.2951600E+02 0.1441171E+020.0000000E+000.9554020E+030.9550163E+030.1000000E+040.9550163E+03 0.9153271E+030.8786571E+030.8790608E+030.8459547E+030.8786570E+030.8150957E+03 0.8155002E+030.7873092E+030.8150957E+030.7606630E+030.7610676E+030.7365272E+03 0.7606629E+030.7130758E+030.7134805E+030.6917589E+030.7130757E+030.6708128E+03 0.6712183E+030.6517411E+030.6708129E+030.9554020E+030.1000000E+040.9153269E+03 0.9550162E+030.8790607E+030.8459546E+030.8786569E+030.8155000E+030.7873091E+03 0.8150956E+030.7610675E+030.7365271E+030.7606628E+030.7134804E+030.6917588E+03 0.7130755E+030.6712183E+030.6517412E+030.6708128E+030.9554020E+030.1000000E+04 0.9153269E+030.9550162E+030.8790607E+030.8459546E+030.8786569E+030.8155001E+03 0.7873090E+030.8150956E+030.7610673E+030.7365269E+030.7606626E+030.7134801E+03 0.6917586E+030.7130753E+030.6712181E+030.6517409E+030.6708124E+030.9554020E+03 0.1000000E+040.9153268E+030.9550161E+030.8790606E+030.8459545E+030.8786568E+03 0.8154999E+030.7873088E+030.8150953E+030.7610672E+030.7365267E+030.7606624E+03 0.7134799E+030.6917583E+030.7130751E+030.6712176E+030.6517404E+030.6708120E+03 0.9554018E+030.1000000E+040.9153267E+030.9550162E+030.8790607E+030.8459544E+03 0.8786568E+030.8154997E+030.7873086E+030.8150952E+030.7610670E+030.7365264E+03 0.7606622E+030.7134796E+030.6917578E+030.7130747E+030.6712172E+030.6517397E+03 0.6708114E+030.9554019E+030.1000000E+040.9153268E+030.9550162E+030.8790606E+03 0.8459543E+030.8786568E+030.8154997E+030.7873085E+030.8150951E+030.7610667E+03 0.7365262E+030.7606620E+030.7134792E+030.6917575E+030.7130744E+030.6712167E+03 0.6517393E+030.6708110E+030.9554018E+030.1000000E+040.9153267E+030.9550161E+03 0.8790606E+030.8459542E+030.8786568E+030.8154995E+030.7873084E+030.8150949E+03 0.7610666E+030.7365259E+030.7606618E+030.7134790E+030.6917571E+030.7130742E+03 0.6712163E+030.6517387E+030.6708106E+030.9554019E+030.1000000E+040.9153266E+03 0.9550160E+030.8790605E+030.8459541E+030.8786566E+030.8154993E+030.7873082E+03 0.8150949E+030.7610665E+030.7365257E+030.7606617E+030.7134787E+030.6917569E+03 0.7130740E+030.6712160E+030.6517383E+030.6708104E+030.9554017E+030.1000000E+04 0.9153266E+030.9550160E+030.8790604E+030.8459541E+030.8786565E+030.8154993E+03 0.7873081E+030.8150949E+030.7610664E+030.7365256E+030.7606616E+030.7134786E+03 0.6917567E+030.7130739E+030.6712158E+030.6517381E+030.6708102E+030.9554018E+03 0.1000000E+040.9153267E+030.9550160E+030.8790603E+030.8459540E+030.8786565E+03 0.8154994E+030.7873081E+030.8150949E+030.7610663E+030.7365256E+030.7606616E+03 0.7134786E+030.6917567E+030.7130739E+030.6712157E+030.6517381E+030.6708103E+03 0.9554017E+030.1000000E+040.9153266E+030.9550159E+030.8790603E+030.8459540E+03 0.8786564E+030.8154993E+030.7873081E+030.8150948E+030.7610663E+030.7365256E+03 0.7606617E+030.7134786E+030.6917567E+030.7130739E+030.6712158E+030.6517382E+03 0.6708105E+030.9554015E+030.1000000E+040.9153266E+030.9550158E+030.8790603E+03 0.8459540E+030.8786565E+030.8154993E+030.7873081E+030.8150948E+030.7610664E+03 0.7365257E+030.7606617E+030.7134787E+030.6917569E+030.7130741E+030.6712160E+03 0.6517385E+030.6708107E+030.9554017E+030.1000000E+040.9153266E+030.9550159E+03 0.8790604E+030.8459541E+030.8786564E+030.8154993E+030.7873081E+030.8150949E+03 0.7610664E+030.7365258E+030.7606618E+030.7134789E+030.6917571E+030.7130743E+03 0.6712163E+030.6517388E+030.6708110E+030.9554017E+030.1000000E+040.9153266E+03 0.9550160E+030.8790604E+030.8459541E+030.8786564E+030.8154994E+030.7873082E+03 0.8150950E+030.7610665E+030.7365259E+030.7606619E+030.7134791E+030.6917573E+03 0.7130745E+030.6712166E+030.6517393E+030.6708113E+030.9554018E+030.1000000E+04 0.9153266E+030.9550160E+030.8790603E+030.8459541E+030.8786565E+030.8154994E+03 0.7873083E+030.8150949E+030.7610666E+030.7365261E+030.7606619E+030.7134792E+03 0.6917576E+030.7130746E+030.6712169E+030.6517396E+030.6708116E+030.9554018E+03 0.1000000E+040.9153266E+030.9550161E+030.8790604E+030.8459541E+030.8786565E+03 0.8154995E+030.7873084E+030.8150950E+030.7610666E+030.7365262E+030.7606620E+03 0.7134794E+030.6917577E+030.7130747E+030.6712171E+030.6517399E+030.6708118E+03 0.9554018E+030.1000000E+040.9153267E+030.9550161E+030.8790604E+030.8459541E+03 0.8786566E+030.8154994E+030.7873084E+030.8150950E+030.7610667E+030.7365263E+03 0.7606620E+030.7134794E+030.6917578E+030.7130747E+030.6712173E+030.6517400E+03 0.6708118E+030.9554019E+030.1000000E+040.9153267E+030.9550161E+030.8790604E+03 0.8459541E+030.8786566E+030.8154995E+030.7873083E+030.8150950E+030.7610667E+03 0.7365263E+030.7606620E+030.7134794E+030.6917578E+030.7130747E+030.6712172E+03 0.6517400E+030.6708117E+030.9554018E+030.1000000E+040.9153266E+030.9550160E+03 0.8790603E+030.8459542E+030.8786565E+030.8154995E+030.7873083E+030.8150950E+03 0.7610667E+030.7365262E+030.7606619E+030.7134793E+030.6917577E+030.7130746E+03 0.6712171E+030.6517399E+030.6708116E+030.9554019E+030.1000000E+040.9153266E+03 0.9550161E+030.8790603E+030.8459541E+030.8786564E+030.8154994E+030.7873083E+03 0.8150950E+030.7610666E+030.7365261E+030.7606618E+030.7134792E+030.6917575E+03 0.7130744E+030.6712169E+030.6517395E+030.6708113E+030.9554019E+030.1000000E+04 0.9153265E+030.9550160E+030.8790603E+030.8459540E+030.8786564E+030.8154994E+03 0.7873081E+030.8150948E+030.7610664E+030.7365259E+030.7606617E+030.7134790E+03 0.6917573E+030.7130742E+030.6712166E+030.6517392E+030.6708110E+030.9554017E+03 0.1000000E+040.9153266E+030.9550161E+030.8790604E+030.8459540E+030.8786565E+03 0.8154993E+030.7873080E+030.8150948E+030.7610663E+030.7365258E+030.7606616E+03 0.7134788E+030.6917570E+030.7130741E+030.6712162E+030.6517387E+030.6708106E+03 0.9554018E+030.1000000E+040.9153266E+030.9550161E+030.8790604E+030.8459539E+03 0.8786565E+030.8154991E+030.7873080E+030.8150947E+030.7610662E+030.7365256E+03 0.7606615E+030.7134787E+030.6917568E+030.7130738E+030.6712159E+030.6517385E+03 0.6708103E+030.9554017E+030.1000000E+040.9153265E+030.9550160E+030.8790603E+03 0.8459540E+030.8786564E+030.8154992E+030.7873080E+030.8150947E+030.7610661E+03 0.7365255E+030.7606615E+030.7134785E+030.6917566E+030.7130738E+030.6712157E+03 0.6517381E+030.6708101E+030.9554018E+030.1000000E+040.9153265E+030.9550160E+03 0.8790603E+030.8459539E+030.8786564E+030.8154992E+030.7873080E+030.8150947E+03 0.7610661E+030.7365255E+030.7606614E+030.7134785E+030.6917565E+030.7130738E+03 0.6712156E+030.6517379E+030.6708101E+030.9554017E+030.1000000E+040.9153265E+03 0.9550159E+030.8790603E+030.8459539E+030.8786564E+030.8154992E+030.7873080E+03 0.8150948E+030.7610661E+030.7365255E+030.7606615E+030.7134785E+030.6917566E+03 0.7130738E+030.6712156E+030.6517379E+030.6708101E+030.9554017E+030.1000000E+04 0.9153266E+030.9550159E+030.8790602E+030.8459540E+030.8786565E+030.8154993E+03 0.7873081E+030.8150948E+030.7610662E+030.7365256E+030.7606616E+030.7134786E+03 0.6917567E+030.7130740E+030.6712157E+030.6517382E+030.6708104E+030.9554016E+03 0.1000000E+040.9153265E+030.9550160E+030.8790603E+030.8459540E+030.8786565E+03 0.8154993E+030.7873081E+030.8150949E+030.7610664E+030.7365257E+030.7606618E+03 0.7134788E+030.6917569E+030.7130742E+030.6712161E+030.6517385E+030.6708108E+03 0.9554016E+030.1000000E+040.9153266E+030.9550160E+030.8790604E+030.8459541E+03 0.8786566E+030.8154994E+030.7873082E+030.8150950E+030.7610666E+030.7365260E+03 0.7606619E+030.7134790E+030.6917572E+030.7130745E+030.6712164E+030.6517391E+03 0.6708112E+030.9554018E+030.1000000E+040.9153267E+030.9550160E+030.8790605E+03 0.8459542E+030.8786566E+030.8154996E+030.7873084E+030.8150951E+030.7610667E+03 0.7365262E+030.7606621E+030.7134793E+030.6917576E+030.7130748E+030.6712169E+03 0.6517394E+030.6708117E+030.9554018E+030.1000000E+040.9153267E+030.9550160E+03 0.8790605E+030.8459543E+030.8786567E+030.8154996E+030.7873085E+030.8150953E+03 0.7610668E+030.7365265E+030.7606622E+030.7134796E+030.6917580E+030.7130751E+03 0.6712174E+030.6517402E+030.6708121E+030.9554019E+030.1000000E+040.9153267E+03 0.9550160E+030.8790605E+030.8459543E+030.8786566E+030.8154996E+030.7873087E+03 0.8150952E+030.7610670E+030.7365266E+030.7606624E+030.7134799E+030.6917584E+03 0.7130753E+030.6712178E+030.6517407E+030.6708126E+030.9554018E+030.1000000E+04 0.9153267E+030.9550161E+030.8790605E+030.8459543E+030.8786566E+030.8154997E+03 0.7873087E+030.8150953E+030.7610671E+030.7365268E+030.7606625E+030.7134801E+03 0.6917585E+030.7130755E+030.6712182E+030.6517412E+030.6708130E+030.9554018E+03 0.1000000E+040.9153268E+030.9550161E+030.8790605E+030.8459543E+030.8786566E+03 0.8154997E+030.7873087E+030.8150953E+030.7610672E+030.7365269E+030.7606625E+03 0.7134803E+030.6917589E+030.7130757E+030.6712185E+030.6708131E+030.6517414E+03 0.8867150E+020.8848395E+020.9801441E+020.8848765E+020.7958169E+020.7054966E+02 0.7073293E+020.6211371E+020.7054463E+020.5352907E+020.5371241E+020.4551751E+02 0.5352653E+020.3733552E+020.3751800E+020.2970278E+020.3733409E+020.2188319E+02 0.2206060E+020.1457851E+020.2188234E+020.7111538E+010.7238183E+010.0000000E+00 0.7111246E+010.8866353E+020.9800522E+020.7957404E+020.8847191E+020.7072663E+02 0.6210857E+020.7053720E+020.5370830E+020.4551416E+020.5352105E+020.3751535E+02 0.2970064E+020.3733037E+020.2205903E+020.1457759E+020.2188034E+020.7237686E+01 0.0000000E+000.7110619E+010.8864989E+020.9798868E+020.7956290E+020.8845732E+02 0.7071719E+020.6210058E+020.7052644E+020.5370160E+020.4550872E+020.5351357E+02 0.3751090E+020.2969712E+020.3732541E+020.2205653E+020.1457584E+020.2187729E+02 0.7236804E+010.0000000E+000.7109595E+010.8863410E+020.9797063E+020.7954933E+02 0.8844085E+020.7070567E+020.6209071E+020.7051425E+020.5369334E+020.4550177E+02 0.5350463E+020.3750518E+020.2969274E+020.3731938E+020.2205331E+020.1457365E+02 0.2187395E+020.7235745E+010.0000000E+000.7108531E+010.8861748E+020.9795155E+02 0.7953478E+020.8842428E+020.7069310E+020.6207986E+020.7050150E+020.5368411E+02 0.4549396E+020.5349523E+020.3749902E+020.2968787E+020.3731303E+020.2204966E+02 0.1457122E+020.2187020E+020.7234549E+010.0000000E+000.7107274E+010.8860102E+02 0.9793302E+020.7952025E+020.8840816E+020.7068026E+020.6206882E+020.7048901E+02 0.5367470E+020.4548620E+020.5348603E+020.3749262E+020.2968284E+020.3730680E+02 0.2204587E+020.1456871E+020.2186655E+020.7233333E+010.0000000E+000.7106053E+01 0.8858527E+020.9791545E+020.7950634E+020.8839306E+020.7066807E+020.6205816E+02 0.7047731E+020.5366568E+020.4547867E+020.5347736E+020.3748652E+020.2967800E+02 0.3730073E+020.2204222E+020.1456633E+020.2186308E+020.7232095E+010.0000000E+00 0.7105022E+010.8857083E+020.9789920E+020.7949353E+020.8837945E+020.7065681E+02 0.6204840E+020.7046665E+020.5365715E+020.4547143E+020.5346928E+020.3748058E+02 0.2967354E+020.3729525E+020.2203900E+020.1456426E+020.2186001E+020.7231134E+01 0.0000000E+000.7104038E+010.8855807E+020.9788497E+020.7948222E+020.8836768E+02 0.7064680E+020.6203970E+020.7045741E+020.5364965E+020.4546515E+020.5346245E+02 0.3747546E+020.2966934E+020.3729053E+020.2203612E+020.1456226E+020.2185721E+02 0.7230144E+010.0000000E+000.7103097E+010.8854723E+020.9787292E+020.7947259E+02 0.8835793E+020.7063828E+020.6203230E+020.7044980E+020.5364334E+020.4545987E+02 0.5345678E+020.3747110E+020.2966594E+020.3728660E+020.2203346E+020.1456058E+02 0.2185494E+020.7229290E+010.0000000E+000.7102314E+010.8853851E+020.9786316E+02 0.7946494E+020.8835044E+020.7063152E+020.6202645E+020.7044403E+020.5363834E+02 0.4545568E+020.5345253E+020.3746762E+020.2966318E+020.3728367E+020.2203139E+02 0.1455923E+020.2185320E+020.7228607E+010.0000000E+000.7101819E+010.8853232E+02 0.9785619E+020.7945948E+020.8834571E+020.7062678E+020.6202236E+020.7044042E+02 0.5363480E+020.4545274E+020.5344984E+020.3746522E+020.2966131E+020.3728185E+02 0.2203000E+020.1455831E+020.2185215E+020.7228161E+010.0000000E+000.7101461E+01 0.8852894E+020.9785236E+020.7945660E+020.8834381E+020.7062425E+020.6202020E+02 0.7043909E+020.5363298E+020.4545124E+020.5344895E+020.3746399E+020.2966037E+02 0.3728128E+020.2202928E+020.1455788E+020.2185183E+020.7227948E+010.0000000E+00 0.7101361E+010.8852853E+020.9785176E+020.7945638E+020.8834510E+020.7062413E+02 0.6202018E+020.7044031E+020.5363298E+020.4545127E+020.5344994E+020.3746400E+02 0.2966041E+020.3728199E+020.2202932E+020.1455788E+020.2185223E+020.7227920E+01 0.0000000E+000.7101469E+010.8853157E+020.9785505E+020.7945924E+020.8835008E+02 0.7062667E+020.6202248E+020.7044429E+020.5363496E+020.4545298E+020.5345295E+02 0.3746541E+020.2966153E+020.3728406E+020.2203012E+020.1455846E+020.2185344E+02 0.7228238E+010.0000000E+000.7101831E+010.8853846E+020.9786271E+020.7946542E+02 0.8835896E+020.7063207E+020.6202722E+020.7045112E+020.5363896E+020.4545637E+02 0.5345796E+020.3746819E+020.2966380E+020.3728750E+020.2203186E+020.1455960E+02 0.2185539E+020.7228734E+010.0000000E+000.7102538E+010.8854926E+020.9787505E+02 0.7947489E+020.8837160E+020.7064023E+020.6203426E+020.7046052E+020.5364497E+02 0.4546135E+020.5346473E+020.3747228E+020.2966696E+020.3729212E+020.2203406E+02 0.1456108E+020.2185811E+020.7229588E+010.0000000E+000.7103411E+010.8856342E+02 0.9789162E+020.7948706E+020.8838675E+020.7065065E+020.6204317E+020.7047161E+02 0.5365239E+020.4546748E+020.5347273E+020.3747722E+020.2967086E+020.3729743E+02 0.2203706E+020.1456298E+020.2186110E+020.7230426E+010.0000000E+000.7104330E+01 0.8857911E+020.9790992E+020.7950049E+020.8840231E+020.7066211E+020.6205285E+02 0.7048312E+020.5366062E+020.4547437E+020.5348096E+020.3748274E+020.2967503E+02 0.3730291E+020.2203997E+020.1456480E+020.2186416E+020.7231363E+010.0000000E+00 0.7105291E+010.8859417E+020.9792717E+020.7951354E+020.8841657E+020.7067342E+02 0.6206259E+020.7049392E+020.5366878E+020.4548117E+020.5348879E+020.3748827E+02 0.2967937E+020.3730816E+020.2204320E+020.1456695E+020.2186718E+020.7232439E+01 0.0000000E+000.7106292E+010.8860762E+020.9794234E+020.7952543E+020.8842891E+02 0.7068382E+020.6207155E+020.7050344E+020.5367641E+020.4548740E+020.5349570E+02 0.3749331E+020.2968337E+020.3731288E+020.2204614E+020.1456895E+020.2187000E+02 0.7233455E+010.0000000E+000.7107175E+010.8861886E+020.9795497E+020.7953515E+02 0.8843884E+020.7069230E+020.6207890E+020.7051100E+020.5368261E+020.4549273E+02 0.5350142E+020.3749768E+020.2968666E+020.3731683E+020.2204861E+020.1457063E+02 0.2187220E+020.7234215E+010.0000000E+000.7107969E+010.8862727E+020.9796438E+02 0.7954274E+020.8844562E+020.7069904E+020.6208462E+020.7051654E+020.5368768E+02 0.4549693E+020.5350551E+020.3750108E+020.2968943E+020.3731953E+020.2205072E+02 0.1457204E+020.2187400E+020.7235004E+010.0000000E+000.7108550E+010.8863284E+02 0.9797044E+020.7954768E+020.8845005E+020.7070338E+020.6208848E+020.7051982E+02 0.5369092E+020.4549962E+020.5350801E+020.3750332E+020.2969123E+020.3732138E+02 0.2205210E+020.1457298E+020.2187499E+020.7235448E+010.0000000E+000.7108842E+01 0.8863582E+020.9797380E+020.7955023E+020.8845139E+020.7070569E+020.6209047E+02 0.7052100E+020.5369266E+020.4550107E+020.5350885E+020.3750458E+020.2969221E+02 0.3732192E+020.2205282E+020.1457342E+020.2187534E+020.7235630E+010.0000000E+00 0.7108967E+010.8863591E+020.9797384E+020.7955028E+020.8845000E+020.7070573E+02 0.6209045E+020.7051983E+020.5369267E+020.4550106E+020.5350802E+020.3750460E+02 0.2969226E+020.3732140E+020.2205283E+020.1457340E+020.2187497E+020.7235643E+01 0.0000000E+000.7108865E+010.8863304E+020.9797053E+020.7954771E+020.8844558E+02 0.7070352E+020.6208852E+020.7051654E+020.5369104E+020.4549965E+020.5350548E+02 0.3750342E+020.2969124E+020.3731955E+020.2205205E+020.1457300E+020.2187399E+02 0.7235401E+010.0000000E+000.7108557E+010.8862742E+020.9796430E+020.7954268E+02 0.8843881E+020.7069901E+020.6208459E+020.7051096E+020.5368766E+020.4549689E+02 0.5350147E+020.3750110E+020.2968935E+020.3731681E+020.2205072E+020.1457201E+02 0.2187217E+020.7234917E+010.0000000E+000.7107935E+010.8861897E+020.9795499E+02 0.7953515E+020.8842886E+020.7069255E+020.6207888E+020.7050339E+020.5368284E+02 0.4549271E+020.5349574E+020.3749759E+020.2968669E+020.3731289E+020.2204877E+02 0.1457065E+020.2187003E+020.7234260E+010.0000000E+000.7107247E+010.8860788E+02 0.9794229E+020.7952534E+020.8841660E+020.7068402E+020.6207146E+020.7049392E+02 0.5367650E+020.4548731E+020.5348874E+020.3749338E+020.2968333E+020.3730817E+02 0.2204622E+020.1456893E+020.2186723E+020.7233399E+010.0000000E+000.7106291E+01 0.8859454E+020.9792718E+020.7951359E+020.8840229E+020.7067368E+020.6206261E+02 0.7048307E+020.5366900E+020.4548115E+020.5348090E+020.3748831E+020.2967935E+02 0.3730293E+020.2204322E+020.1456695E+020.2186419E+020.7232450E+010.0000000E+00 0.7105289E+010.8857942E+020.9790990E+020.7950046E+020.8838670E+020.7066235E+02 0.6205286E+020.7047157E+020.5366085E+020.4547442E+020.5347270E+020.3748290E+02 0.2967508E+020.3729730E+020.2204002E+020.1456488E+020.2186098E+020.7231448E+01 0.0000000E+000.7104262E+010.8856369E+020.9789149E+020.7948698E+020.8837145E+02 0.7065086E+020.6204307E+020.7046046E+020.5365250E+020.4546742E+020.5346463E+02 0.3747720E+020.2967084E+020.3729197E+020.2203696E+020.1456290E+020.2185809E+02 0.7230543E+010.0000000E+000.7103424E+010.8854943E+020.9787492E+020.7947477E+02 0.8835878E+020.7064038E+020.6203418E+020.7045099E+020.5364496E+020.4546121E+02 0.5345786E+020.3747224E+020.2966682E+020.3728745E+020.2203425E+020.1456104E+02 0.2185543E+020.7229534E+010.0000000E+000.7102525E+010.8853847E+020.9786249E+02 0.7946521E+020.8834986E+020.7063205E+020.6202705E+020.7044410E+020.5363896E+02 0.4545625E+020.5345280E+020.3746818E+020.2966367E+020.3728395E+020.2203177E+02 0.1455949E+020.2185343E+020.7228749E+010.0000000E+000.7101832E+010.8853145E+02 0.9785477E+020.7945899E+020.8834479E+020.7062653E+020.6202227E+020.7044004E+02 0.5363483E+020.4545282E+020.5344972E+020.3746533E+020.2966142E+020.3728183E+02 0.2203008E+020.1455837E+020.2185215E+020.7228181E+010.0000000E+000.7101477E+01 0.8852822E+020.9785135E+020.7945606E+020.8834342E+020.7062382E+020.6201989E+02 0.7043872E+020.5363275E+020.4545108E+020.5344864E+020.3746387E+020.2966027E+02 0.3728105E+020.2202922E+020.1455781E+020.2185167E+020.7227914E+010.0000000E+00 0.7101307E+010.8852841E+020.9785188E+020.7945615E+020.8834514E+020.7062379E+02 0.6201980E+020.7043993E+020.5363262E+020.4545095E+020.5344946E+020.3746373E+02 0.2966016E+020.3728156E+020.2202912E+020.1455777E+020.2185197E+020.7227895E+01 0.0000000E+000.7101401E+010.8853160E+020.9785554E+020.7945890E+020.8834973E+02 0.7062613E+020.6202182E+020.7044338E+020.5363428E+020.4545233E+020.5345193E+02 0.3746481E+020.2966103E+020.3728324E+020.2202974E+020.1455815E+020.2185292E+02 0.7228053E+010.0000000E+000.7101683E+010.8853748E+020.9786226E+020.7946408E+02 0.8835689E+020.7063062E+020.6202570E+020.7044885E+020.5363755E+020.4545508E+02 0.5345597E+020.3746705E+020.2966280E+020.3728599E+020.2203102E+020.1455906E+02 0.2185452E+020.7228530E+010.0000000E+000.7102172E+010.8854579E+020.9787168E+02 0.7947141E+020.8836627E+020.7063700E+020.6203127E+020.7045611E+020.5364229E+02 0.4545906E+020.5346136E+020.3747028E+020.2966544E+020.3728969E+020.2203302E+02 0.1456038E+020.2185661E+020.7229115E+010.0000000E+000.7102929E+010.8855610E+02 0.9788329E+020.7948059E+020.8837749E+020.7064505E+020.6203829E+020.7046487E+02 0.5364829E+020.4546409E+020.5346784E+020.3747449E+020.2966865E+020.3729421E+02 0.2203529E+020.1456189E+020.2185931E+020.7229988E+010.0000000E+000.7103798E+01 0.8856824E+020.9789695E+020.7949135E+020.8839044E+020.7065446E+020.6204647E+02 0.7047485E+020.5365523E+020.4546989E+020.5347532E+020.3747922E+020.2967244E+02 0.3729930E+020.2203823E+020.1456375E+020.2186222E+020.7230809E+010.0000000E+00 0.7104697E+010.8858194E+020.9791239E+020.7950341E+020.8840467E+020.7066496E+02 0.6205555E+020.7048581E+020.5366306E+020.4547651E+020.5348337E+020.3748457E+02 0.2967651E+020.3730476E+020.2204108E+020.1456554E+020.2186529E+020.7231733E+01 0.0000000E+000.7105661E+010.8859660E+020.9792896E+020.7951630E+020.8841966E+02 0.7067624E+020.6206534E+020.7049726E+020.5367134E+020.4548346E+020.5349169E+02 0.3749021E+020.2968096E+020.3731035E+020.2204440E+020.1456774E+020.2186852E+02 0.7232834E+010.0000000E+000.7106723E+010.8861188E+020.9794630E+020.7952976E+02 0.8843491E+020.7068796E+020.6207543E+020.7050875E+020.5367988E+020.4549043E+02 0.5349993E+020.3749584E+020.2968541E+020.3731590E+020.2204769E+020.1456998E+02 0.2187178E+020.7233970E+010.0000000E+000.7107751E+010.8862693E+020.9796363E+02 0.7954263E+020.8844944E+020.7069902E+020.6208485E+020.7051930E+020.5368777E+02 0.4549710E+020.5350756E+020.3750125E+020.2968948E+020.3732097E+020.2205071E+02 0.1457201E+020.2187457E+020.7234904E+010.0000000E+000.7108735E+010.8864051E+02 0.9797956E+020.7955429E+020.8846151E+020.7070896E+020.6209312E+020.7052802E+02 0.5369485E+020.4550285E+020.5351358E+020.3750582E+020.2969314E+020.3732480E+02 0.2205341E+020.1457381E+020.2187693E+020.7235866E+010.0000000E+000.7109462E+01 0.8865103E+020.9799215E+020.7956299E+020.8846978E+020.7071619E+020.6209921E+02 0.7053353E+020.5369979E+020.4550686E+020.5351740E+020.3750907E+020.2969564E+02 0.3732744E+020.2205524E+020.1457495E+020.2187818E+020.7236413E+010.0000000E+00 0.7109756E+010.8865609E+020.9799831E+020.7956716E+020.8847089E+020.7071985E+02 0.6210224E+020.7053510E+020.5370237E+020.4550899E+020.5351851E+020.3751092E+02 0.2969716E+020.3732832E+020.2205648E+020.1457587E+020.2187943E+020.7236889E+01 0.7110585E+010.0000000E+00 ************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 40 0.7200000000000E+05 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9150623E+030.8457936E+030.7872166E+030.7364686E+030.6917021E+03 0.6516519E+030.1000000E+040.9150622E+030.8457936E+030.7872165E+030.7364686E+03 0.6917021E+030.6516518E+030.1000000E+040.9150622E+030.8457935E+030.7872165E+03 0.7364684E+030.6917018E+030.6516515E+030.1000000E+040.9150621E+030.8457935E+03 0.7872164E+030.7364682E+030.6917016E+030.6516510E+030.1000000E+040.9150619E+03 0.8457934E+030.7872161E+030.7364680E+030.6917011E+030.6516505E+030.1000000E+04 0.9150621E+030.8457933E+030.7872160E+030.7364677E+030.6917007E+030.6516498E+03 0.1000000E+040.9150621E+030.8457933E+030.7872159E+030.7364674E+030.6917004E+03 0.6516494E+030.1000000E+040.9150620E+030.8457932E+030.7872158E+030.7364672E+03 0.6917001E+030.6516489E+030.1000000E+040.9150619E+030.8457931E+030.7872156E+03 0.7364671E+030.6916999E+030.6516486E+030.1000000E+040.9150620E+030.8457930E+03 0.7872156E+030.7364670E+030.6916998E+030.6516484E+030.1000000E+040.9150619E+03 0.8457931E+030.7872156E+030.7364670E+030.6916998E+030.6516485E+030.1000000E+04 0.9150618E+030.8457930E+030.7872156E+030.7364671E+030.6916999E+030.6516488E+03 0.1000000E+040.9150619E+030.8457931E+030.7872156E+030.7364672E+030.6917001E+03 0.6516491E+030.1000000E+040.9150619E+030.8457931E+030.7872157E+030.7364674E+03 0.6917004E+030.6516495E+030.1000000E+040.9150620E+030.8457931E+030.7872158E+03 0.7364675E+030.6917006E+030.6516499E+030.1000000E+040.9150619E+030.8457931E+03 0.7872159E+030.7364676E+030.6917008E+030.6516502E+030.1000000E+040.9150620E+03 0.8457932E+030.7872159E+030.7364677E+030.6917010E+030.6516505E+030.1000000E+04 0.9150621E+030.8457932E+030.7872159E+030.7364677E+030.6917010E+030.6516505E+03 0.1000000E+040.9150620E+030.8457932E+030.7872159E+030.7364678E+030.6917010E+03 0.6516505E+030.1000000E+040.9150619E+030.8457933E+030.7872159E+030.7364677E+03 0.6917008E+030.6516503E+030.1000000E+040.9150619E+030.8457932E+030.7872158E+03 0.7364675E+030.6917006E+030.6516499E+030.1000000E+040.9150618E+030.8457931E+03 0.7872156E+030.7364674E+030.6917004E+030.6516495E+030.1000000E+040.9150620E+03 0.8457931E+030.7872156E+030.7364672E+030.6917002E+030.6516491E+030.1000000E+04 0.9150619E+030.8457930E+030.7872156E+030.7364671E+030.6916999E+030.6516488E+03 0.1000000E+040.9150619E+030.8457931E+030.7872156E+030.7364670E+030.6916998E+03 0.6516485E+030.1000000E+040.9150619E+030.8457930E+030.7872155E+030.7364671E+03 0.6916998E+030.6516485E+030.1000000E+040.9150620E+030.8457930E+030.7872157E+03 0.7364671E+030.6916999E+030.6516485E+030.1000000E+040.9150619E+030.8457932E+03 0.7872157E+030.7364673E+030.6917001E+030.6516489E+030.1000000E+040.9150619E+03 0.8457932E+030.7872158E+030.7364675E+030.6917004E+030.6516493E+030.1000000E+04 0.9150621E+030.8457933E+030.7872160E+030.7364677E+030.6917007E+030.6516499E+03 0.1000000E+040.9150621E+030.8457934E+030.7872162E+030.7364680E+030.6917011E+03 0.6516504E+030.1000000E+040.9150622E+030.8457935E+030.7872163E+030.7364682E+03 0.6917015E+030.6516510E+030.1000000E+040.9150621E+030.8457935E+030.7872164E+03 0.7364683E+030.6917018E+030.6516515E+030.1000000E+040.9150622E+030.8457936E+03 0.7872165E+030.7364685E+030.6917020E+030.6516518E+030.1000000E+040.9150622E+03 0.8457935E+030.7872165E+030.7364685E+030.6917021E+030.6516518E+030.9964048E+02 0.8108513E+020.6339929E+020.4650209E+020.3032651E+020.1481973E+020.0000000E+00 0.9963589E+020.8108212E+020.6339721E+020.4650078E+020.3032569E+020.1481931E+02 0.0000000E+000.9962370E+020.8107389E+020.6339156E+020.4649688E+020.3032318E+02 0.1481827E+020.0000000E+000.9960815E+020.8106233E+020.6338328E+020.4649139E+02 0.3031957E+020.1481636E+020.0000000E+000.9959008E+020.8104897E+020.6337350E+02 0.4648433E+020.3031538E+020.1481431E+020.0000000E+000.9957193E+020.8103501E+02 0.6336297E+020.4647692E+020.3031063E+020.1481192E+020.0000000E+000.9955434E+02 0.8102116E+020.6335252E+020.4646961E+020.3030596E+020.1480960E+020.0000000E+00 0.9953767E+020.8100815E+020.6334266E+020.4646248E+020.3030135E+020.1480748E+02 0.0000000E+000.9952265E+020.8099629E+020.6333355E+020.4645581E+020.3029722E+02 0.1480561E+020.0000000E+000.9950972E+020.8098598E+020.6332567E+020.4645023E+02 0.3029355E+020.1480373E+020.0000000E+000.9949892E+020.8097744E+020.6331913E+02 0.4644555E+020.3029051E+020.1480226E+020.0000000E+000.9949053E+020.8097092E+02 0.6331425E+020.4644204E+020.3028822E+020.1480118E+020.0000000E+000.9948526E+02 0.8096684E+020.6331116E+020.4643985E+020.3028684E+020.1480049E+020.0000000E+00 0.9948306E+020.8096531E+020.6331012E+020.4643918E+020.3028641E+020.1480032E+02 0.0000000E+000.9948436E+020.8096664E+020.6331128E+020.4644006E+020.3028703E+02 0.1480056E+020.0000000E+000.9948986E+020.8097121E+020.6331484E+020.4644264E+02 0.3028868E+020.1480143E+020.0000000E+000.9949991E+020.8097913E+020.6332080E+02 0.4644689E+020.3029148E+020.1480269E+020.0000000E+000.9951460E+020.8099013E+02 0.6332893E+020.4645257E+020.3029508E+020.1480457E+020.0000000E+000.9953248E+02 0.8100319E+020.6333844E+020.4645924E+020.3029928E+020.1480639E+020.0000000E+00 0.9955063E+020.8101668E+020.6334830E+020.4646615E+020.3030351E+020.1480839E+02 0.0000000E+000.9956691E+020.8102923E+020.6335770E+020.4647272E+020.3030768E+02 0.1481044E+020.0000000E+000.9958090E+020.8104022E+020.6336599E+020.4647849E+02 0.3031144E+020.1481234E+020.0000000E+000.9959223E+020.8104893E+020.6337257E+02 0.4648347E+020.3031445E+020.1481385E+020.0000000E+000.9959968E+020.8105521E+02 0.6337744E+020.4648680E+020.3031674E+020.1481511E+020.0000000E+000.9960466E+02 0.8105903E+020.6338035E+020.4648897E+020.3031819E+020.1481575E+020.0000000E+00 0.9960625E+020.8106031E+020.6338137E+020.4648965E+020.3031867E+020.1481596E+02 0.0000000E+000.9960465E+020.8105904E+020.6338035E+020.4648899E+020.3031822E+02 0.1481572E+020.0000000E+000.9959968E+020.8105518E+020.6337743E+020.4648679E+02 0.3031671E+020.1481513E+020.0000000E+000.9959222E+020.8104888E+020.6337259E+02 0.4648348E+020.3031439E+020.1481383E+020.0000000E+000.9958087E+020.8104015E+02 0.6336596E+020.4647850E+020.3031148E+020.1481238E+020.0000000E+000.9956694E+02 0.8102930E+020.6335768E+020.4647267E+020.3030770E+020.1481045E+020.0000000E+00 0.9955067E+020.8101669E+020.6334829E+020.4646617E+020.3030359E+020.1480842E+02 0.0000000E+000.9953250E+020.8100320E+020.6333846E+020.4645925E+020.3029914E+02 0.1480633E+020.0000000E+000.9951454E+020.8099012E+020.6332893E+020.4645245E+02 0.3029504E+020.1480458E+020.0000000E+000.9949988E+020.8097909E+020.6332080E+02 0.4644689E+020.3029147E+020.1480273E+020.0000000E+000.9948985E+020.8097119E+02 0.6331483E+020.4644263E+020.3028871E+020.1480140E+020.0000000E+000.9948430E+02 0.8096664E+020.6331126E+020.4644006E+020.3028701E+020.1480059E+020.0000000E+00 0.9948306E+020.8096531E+020.6331008E+020.4643917E+020.3028641E+020.1480028E+02 0.0000000E+000.9948521E+020.8096684E+020.6331116E+020.4643987E+020.3028683E+02 0.1480050E+020.0000000E+000.9949058E+020.8097096E+020.6331423E+020.4644202E+02 0.3028823E+020.1480112E+020.0000000E+000.9949890E+020.8097743E+020.6331912E+02 0.4644553E+020.3029047E+020.1480229E+020.0000000E+000.9950974E+020.8098595E+02 0.6332566E+020.4645020E+020.3029354E+020.1480368E+020.0000000E+000.9952263E+02 0.8099624E+020.6333356E+020.4645589E+020.3029722E+020.1480561E+020.0000000E+00 0.9953764E+020.8100808E+020.6334257E+020.4646244E+020.3030145E+020.1480747E+02 0.0000000E+000.9955427E+020.8102111E+020.6335249E+020.4646958E+020.3030588E+02 0.1480958E+020.0000000E+000.9957187E+020.8103491E+020.6336294E+020.4647695E+02 0.3031059E+020.1481190E+020.0000000E+000.9959012E+020.8104900E+020.6337348E+02 0.4648427E+020.3031531E+020.1481427E+020.0000000E+000.9960808E+020.8106233E+02 0.6338323E+020.4649135E+020.3031959E+020.1481638E+020.0000000E+000.9962363E+02 0.8107386E+020.6339152E+020.4649685E+020.3032319E+020.1481822E+020.0000000E+00 0.9963582E+020.8108204E+020.6339715E+020.4650071E+020.3032562E+020.1481933E+02 0.0000000E+000.9964041E+020.8108505E+020.6339921E+020.4650203E+020.3032648E+02 0.1481972E+020.0000000E+000.9554769E+030.9550918E+030.1000000E+040.9550918E+03 0.9154677E+030.8788548E+030.8792580E+030.8461994E+030.8788548E+030.8153794E+03 0.8157834E+030.7876222E+030.8153794E+030.7609973E+030.7614017E+030.7368741E+03 0.7609973E+030.7134274E+030.7138321E+030.6921077E+030.7134274E+030.6711516E+03 0.6715573E+030.6520636E+030.6711515E+030.9554769E+030.1000000E+040.9154676E+03 0.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157833E+030.7876222E+03 0.8153793E+030.7614017E+030.7368741E+030.7609972E+030.7138320E+030.6921076E+03 0.7134272E+030.6715571E+030.6520635E+030.6711512E+030.9554769E+030.1000000E+04 0.9154676E+030.9550918E+030.8792579E+030.8461993E+030.8788548E+030.8157834E+03 0.7876221E+030.8153794E+030.7614016E+030.7368738E+030.7609971E+030.7138318E+03 0.6921074E+030.7134270E+030.6715568E+030.6520631E+030.6711509E+030.9554769E+03 0.1000000E+040.9154674E+030.9550917E+030.8792579E+030.8461993E+030.8788546E+03 0.8157832E+030.7876219E+030.8153792E+030.7614014E+030.7368736E+030.7609969E+03 0.7138315E+030.6921070E+030.7134267E+030.6715563E+030.6520626E+030.6711504E+03 0.9554768E+030.1000000E+040.9154674E+030.9550918E+030.8792579E+030.8461992E+03 0.8788547E+030.8157831E+030.7876217E+030.8153790E+030.7614012E+030.7368734E+03 0.7609967E+030.7138312E+030.6921065E+030.7134264E+030.6715559E+030.6520619E+03 0.6711499E+030.9554768E+030.1000000E+040.9154675E+030.9550918E+030.8792579E+03 0.8461991E+030.8788547E+030.8157830E+030.7876216E+030.8153790E+030.7614010E+03 0.7368732E+030.7609965E+030.7138309E+030.6921062E+030.7134260E+030.6715554E+03 0.6520615E+030.6711495E+030.9554768E+030.1000000E+040.9154674E+030.9550917E+03 0.8792579E+030.8461990E+030.8788547E+030.8157829E+030.7876215E+030.8153788E+03 0.7614008E+030.7368729E+030.7609963E+030.7138306E+030.6921059E+030.7134258E+03 0.6715550E+030.6520609E+030.6711491E+030.9554768E+030.1000000E+040.9154673E+03 0.9550916E+030.8792578E+030.8461990E+030.8788545E+030.8157827E+030.7876214E+03 0.8153788E+030.7614007E+030.7368727E+030.7609963E+030.7138304E+030.6921056E+03 0.7134257E+030.6715547E+030.6520605E+030.6711489E+030.9554767E+030.1000000E+04 0.9154674E+030.9550916E+030.8792577E+030.8461989E+030.8788544E+030.8157827E+03 0.7876212E+030.8153788E+030.7614007E+030.7368726E+030.7609961E+030.7138303E+03 0.6921055E+030.7134256E+030.6715545E+030.6520603E+030.6711487E+030.9554767E+03 0.1000000E+040.9154674E+030.9550916E+030.8792576E+030.8461988E+030.8788544E+03 0.8157828E+030.7876212E+030.8153788E+030.7614005E+030.7368726E+030.7609961E+03 0.7138303E+030.6921054E+030.7134256E+030.6715544E+030.6520603E+030.6711488E+03 0.9554767E+030.1000000E+040.9154673E+030.9550915E+030.8792577E+030.8461988E+03 0.8788544E+030.8157828E+030.7876212E+030.8153787E+030.7614006E+030.7368726E+03 0.7609962E+030.7138303E+030.6921055E+030.7134256E+030.6715545E+030.6520604E+03 0.6711489E+030.9554765E+030.1000000E+040.9154673E+030.9550914E+030.8792577E+03 0.8461989E+030.8788544E+030.8157827E+030.7876213E+030.8153787E+030.7614007E+03 0.7368728E+030.7609963E+030.7138304E+030.6921056E+030.7134258E+030.6715548E+03 0.6520608E+030.6711492E+030.9554767E+030.1000000E+040.9154674E+030.9550915E+03 0.8792577E+030.8461989E+030.8788544E+030.8157827E+030.7876213E+030.8153788E+03 0.7614007E+030.7368728E+030.7609964E+030.7138306E+030.6921059E+030.7134260E+03 0.6715551E+030.6520610E+030.6711495E+030.9554767E+030.1000000E+040.9154674E+03 0.9550916E+030.8792577E+030.8461990E+030.8788544E+030.8157828E+030.7876214E+03 0.8153789E+030.7614008E+030.7368730E+030.7609965E+030.7138308E+030.6921061E+03 0.7134262E+030.6715554E+030.6520615E+030.6711498E+030.9554768E+030.1000000E+04 0.9154674E+030.9550916E+030.8792576E+030.8461989E+030.8788544E+030.8157828E+03 0.7876215E+030.8153789E+030.7614009E+030.7368731E+030.7609965E+030.7138310E+03 0.6921064E+030.7134263E+030.6715557E+030.6520619E+030.6711501E+030.9554767E+03 0.1000000E+040.9154674E+030.9550917E+030.8792577E+030.8461990E+030.8788545E+03 0.8157829E+030.7876216E+030.8153789E+030.7614010E+030.7368732E+030.7609966E+03 0.7138311E+030.6921065E+030.7134265E+030.6715559E+030.6520621E+030.6711503E+03 0.9554768E+030.1000000E+040.9154674E+030.9550917E+030.8792578E+030.8461990E+03 0.8788545E+030.8157829E+030.7876216E+030.8153789E+030.7614010E+030.7368733E+03 0.7609966E+030.7138312E+030.6921067E+030.7134265E+030.6715561E+030.6520623E+03 0.6711503E+030.9554768E+030.1000000E+040.9154674E+030.9550917E+030.8792577E+03 0.8461990E+030.8788545E+030.8157829E+030.7876216E+030.8153789E+030.7614010E+03 0.7368733E+030.7609966E+030.7138312E+030.6921066E+030.7134265E+030.6715560E+03 0.6520623E+030.6711503E+030.9554768E+030.1000000E+040.9154674E+030.9550916E+03 0.8792577E+030.8461991E+030.8788545E+030.8157829E+030.7876215E+030.8153790E+03 0.7614010E+030.7368733E+030.7609966E+030.7138311E+030.6921065E+030.7134264E+03 0.6715559E+030.6520622E+030.6711501E+030.9554768E+030.1000000E+040.9154673E+03 0.9550917E+030.8792577E+030.8461990E+030.8788544E+030.8157829E+030.7876215E+03 0.8153789E+030.7614009E+030.7368732E+030.7609965E+030.7138309E+030.6921063E+03 0.7134262E+030.6715557E+030.6520618E+030.6711498E+030.9554769E+030.1000000E+04 0.9154673E+030.9550916E+030.8792577E+030.8461989E+030.8788544E+030.8157829E+03 0.7876213E+030.8153788E+030.7614008E+030.7368730E+030.7609963E+030.7138308E+03 0.6921061E+030.7134260E+030.6715554E+030.6520615E+030.6711495E+030.9554767E+03 0.1000000E+040.9154673E+030.9550917E+030.8792578E+030.8461989E+030.8788545E+03 0.8157828E+030.7876213E+030.8153787E+030.7614007E+030.7368729E+030.7609962E+03 0.7138306E+030.6921059E+030.7134259E+030.6715551E+030.6520610E+030.6711492E+03 0.9554768E+030.1000000E+040.9154673E+030.9550917E+030.8792578E+030.8461988E+03 0.8788545E+030.8157826E+030.7876213E+030.8153786E+030.7614006E+030.7368727E+03 0.7609961E+030.7138305E+030.6921057E+030.7134256E+030.6715548E+030.6520608E+03 0.6711489E+030.9554767E+030.1000000E+040.9154673E+030.9550916E+030.8792577E+03 0.8461989E+030.8788544E+030.8157827E+030.7876213E+030.8153787E+030.7614005E+03 0.7368726E+030.7609961E+030.7138303E+030.6921055E+030.7134256E+030.6715546E+03 0.6520604E+030.6711487E+030.9554768E+030.1000000E+040.9154673E+030.9550916E+03 0.8792576E+030.8461989E+030.8788544E+030.8157827E+030.7876212E+030.8153787E+03 0.7614005E+030.7368726E+030.7609961E+030.7138303E+030.6921054E+030.7134256E+03 0.6715545E+030.6520603E+030.6711487E+030.9554766E+030.1000000E+040.9154673E+03 0.9550915E+030.8792577E+030.8461989E+030.8788544E+030.8157827E+030.7876213E+03 0.8153788E+030.7614005E+030.7368727E+030.7609962E+030.7138303E+030.6921055E+03 0.7134257E+030.6715545E+030.6520603E+030.6711488E+030.9554767E+030.1000000E+04 0.9154674E+030.9550915E+030.8792576E+030.8461989E+030.8788545E+030.8157828E+03 0.7876214E+030.8153788E+030.7614006E+030.7368728E+030.7609963E+030.7138304E+03 0.6921056E+030.7134259E+030.6715546E+030.6520605E+030.6711491E+030.9554765E+03 0.1000000E+040.9154673E+030.9550917E+030.8792577E+030.8461990E+030.8788545E+03 0.8157829E+030.7876214E+030.8153789E+030.7614008E+030.7368729E+030.7609965E+03 0.7138306E+030.6921059E+030.7134260E+030.6715550E+030.6520608E+030.6711495E+03 0.9554766E+030.1000000E+040.9154674E+030.9550917E+030.8792578E+030.8461991E+03 0.8788547E+030.8157830E+030.7876215E+030.8153790E+030.7614010E+030.7368732E+03 0.7609966E+030.7138309E+030.6921062E+030.7134264E+030.6715554E+030.6520615E+03 0.6711499E+030.9554768E+030.1000000E+040.9154675E+030.9550916E+030.8792579E+03 0.8461991E+030.8788546E+030.8157831E+030.7876217E+030.8153792E+030.7614012E+03 0.7368734E+030.7609968E+030.7138312E+030.6921065E+030.7134267E+030.6715558E+03 0.6520619E+030.6711504E+030.9554768E+030.1000000E+040.9154676E+030.9550917E+03 0.8792580E+030.8461993E+030.8788548E+030.8157832E+030.7876219E+030.8153793E+03 0.7614013E+030.7368737E+030.7609970E+030.7138315E+030.6921070E+030.7134270E+03 0.6715564E+030.6520626E+030.6711508E+030.9554769E+030.1000000E+040.9154675E+03 0.9550917E+030.8792579E+030.8461993E+030.8788547E+030.8157833E+030.7876221E+03 0.8153793E+030.7614015E+030.7368738E+030.7609972E+030.7138318E+030.6921073E+03 0.7134272E+030.6715567E+030.6520630E+030.6711512E+030.9554768E+030.1000000E+04 0.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157834E+03 0.7876221E+030.8153794E+030.7614016E+030.7368740E+030.7609973E+030.7138320E+03 0.6921075E+030.7134274E+030.6715571E+030.6520634E+030.6711515E+030.9554768E+03 0.1000000E+040.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788547E+03 0.8157834E+030.7876222E+030.8153794E+030.7614017E+030.7368741E+030.7609973E+03 0.7138321E+030.6921077E+030.7134274E+030.6715572E+030.6711515E+030.6520636E+03 0.9043342E+020.9024461E+020.9982115E+020.9024827E+020.8127158E+020.7213896E+02 0.7232577E+020.6358624E+020.7213645E+020.5485661E+020.5504362E+020.4668915E+02 0.5485490E+020.3832788E+020.3851472E+020.3051230E+020.3832687E+020.2249163E+02 0.2267380E+020.1498946E+020.2249100E+020.7313702E+010.7443927E+010.0000000E+00 0.7313480E+010.9042651E+020.9981237E+020.8126577E+020.9023457E+020.7232105E+02 0.6358230E+020.7212970E+020.5504041E+020.4668649E+020.5485017E+020.3851259E+02 0.3051055E+020.3832368E+020.2267252E+020.1498872E+020.2248931E+020.7443519E+01 0.0000000E+000.7312950E+010.9041449E+020.9979804E+020.8125559E+020.9022123E+02 0.7231246E+020.6357509E+020.7211981E+020.5503442E+020.4668167E+020.5484337E+02 0.3850865E+020.3050745E+020.3831921E+020.2267032E+020.1498716E+020.2248654E+02 0.7442735E+010.0000000E+000.7312018E+010.9039974E+020.9978106E+020.8124295E+02 0.9020562E+020.7230176E+020.6356595E+020.7210836E+020.5502681E+020.4667528E+02 0.5483502E+020.3850339E+020.3050343E+020.3831360E+020.2266738E+020.1498516E+02 0.2248346E+020.7441768E+010.0000000E+000.7311039E+010.9038384E+020.9976271E+02 0.8122910E+020.9018967E+020.7228984E+020.6355569E+020.7209617E+020.5501810E+02 0.4666792E+020.5482608E+020.3849762E+020.3049888E+020.3830759E+020.2266396E+02 0.1498288E+020.2247991E+020.7440649E+010.0000000E+000.7309849E+010.9036791E+02 0.9974472E+020.8121508E+020.9017400E+020.7227749E+020.6354510E+020.7208410E+02 0.5500910E+020.4666052E+020.5481723E+020.3849153E+020.3049409E+020.3830162E+02 0.2266035E+020.1498050E+020.2247642E+020.7439495E+010.0000000E+000.7308680E+01 0.9035255E+020.9972753E+020.8120154E+020.9015922E+020.7226566E+020.6353478E+02 0.7207270E+020.5500039E+020.4665326E+020.5480882E+020.3848566E+020.3048944E+02 0.3829575E+020.2265685E+020.1497821E+020.2247307E+020.7438303E+010.0000000E+00 0.7307691E+010.9033839E+020.9971155E+020.8118901E+020.9014585E+020.7225466E+02 0.6352526E+020.7206227E+020.5499207E+020.4664621E+020.5480093E+020.3847988E+02 0.3048512E+020.3829041E+020.2265373E+020.1497622E+020.2247010E+020.7437380E+01 0.0000000E+000.7306738E+010.9032583E+020.9969751E+020.8117789E+020.9013424E+02 0.7224483E+020.6351673E+020.7205318E+020.5498473E+020.4664007E+020.5479423E+02 0.3847489E+020.3048101E+020.3828579E+020.2265093E+020.1497426E+020.2246735E+02 0.7436415E+010.0000000E+000.7305816E+010.9031512E+020.9968560E+020.8116839E+02 0.9012461E+020.7223644E+020.6350945E+020.7204568E+020.5497854E+020.4663489E+02 0.5478865E+020.3847061E+020.3047768E+020.3828194E+020.2264832E+020.1497262E+02 0.2246513E+020.7435579E+010.0000000E+000.7305046E+010.9030650E+020.9967594E+02 0.8116084E+020.9011721E+020.7222977E+020.6350369E+020.7203999E+020.5497361E+02 0.4663077E+020.5478447E+020.3846718E+020.3047497E+020.3827906E+020.2264629E+02 0.1497129E+020.2246343E+020.7434907E+010.0000000E+000.7304563E+010.9030039E+02 0.9966904E+020.8115546E+020.9011254E+020.7222511E+020.6349967E+020.7203645E+02 0.5497014E+020.4662788E+020.5478184E+020.3846483E+020.3047314E+020.3827728E+02 0.2264492E+020.1497039E+020.2246240E+020.7434471E+010.0000000E+000.7304214E+01 0.9029707E+020.9966528E+020.8115263E+020.9011071E+020.7222264E+020.6349757E+02 0.7203518E+020.5496836E+020.4662643E+020.5478100E+020.3846365E+020.3047222E+02 0.3827674E+020.2264423E+020.1496998E+020.2246210E+020.7434267E+010.0000000E+00 0.7304121E+010.9029673E+020.9966475E+020.8115247E+020.9011206E+020.7222258E+02 0.6349760E+020.7203645E+020.5496842E+020.4662650E+020.5478204E+020.3846369E+02 0.3047230E+020.3827749E+020.2264429E+020.1496999E+020.2246253E+020.7434246E+01 0.0000000E+000.7304235E+010.9029983E+020.9966810E+020.8115541E+020.9011711E+02 0.7222518E+020.6349995E+020.7204050E+020.5497045E+020.4662826E+020.5478510E+02 0.3846514E+020.3047345E+020.3827960E+020.2264511E+020.1497059E+020.2246376E+02 0.7434573E+010.0000000E+000.7304605E+010.9030680E+020.9967585E+020.8116166E+02 0.9012608E+020.7223065E+020.6350476E+020.7204741E+020.5497451E+020.4663170E+02 0.5479018E+020.3846796E+020.3047576E+020.3828309E+020.2264688E+020.1497175E+02 0.2246574E+020.7435077E+010.0000000E+000.7305323E+010.9031769E+020.9968828E+02 0.8117122E+020.9013881E+020.7223889E+020.6351188E+020.7205689E+020.5498059E+02 0.4663674E+020.5479702E+020.3847211E+020.3047896E+020.3828776E+020.2264911E+02 0.1497324E+020.2246849E+020.7435943E+010.0000000E+000.7306208E+010.9033195E+02 0.9970495E+020.8118348E+020.9015407E+020.7224940E+020.6352086E+020.7206807E+02 0.5498807E+020.4664292E+020.5480509E+020.3847710E+020.3048290E+020.3829313E+02 0.2265215E+020.1497516E+020.2247151E+020.7436789E+010.0000000E+000.7307136E+01 0.9034774E+020.9972336E+020.8119701E+020.9016973E+020.7226095E+020.6353063E+02 0.7207966E+020.5499638E+020.4664989E+020.5481339E+020.3848267E+020.3048711E+02 0.3829866E+020.2265508E+020.1497700E+020.2247459E+020.7437735E+010.0000000E+00 0.7308105E+010.9036290E+020.9974072E+020.8121015E+020.9018408E+020.7227234E+02 0.6354044E+020.7209055E+020.5500461E+020.4665675E+020.5482128E+020.3848825E+02 0.3049149E+020.3830395E+020.2265834E+020.1497918E+020.2247765E+020.7438823E+01 0.0000000E+000.7309117E+010.9037644E+020.9975598E+020.8122213E+020.9019651E+02 0.7228283E+020.6354948E+020.7210015E+020.5501230E+020.4666303E+020.5482826E+02 0.3849334E+020.3049553E+020.3830872E+020.2266132E+020.1498120E+020.2248050E+02 0.7439851E+010.0000000E+000.7310010E+010.9038776E+020.9976869E+020.8123191E+02 0.9020651E+020.7229137E+020.6355689E+020.7210776E+020.5501856E+020.4666841E+02 0.5483403E+020.3849775E+020.3049885E+020.3831271E+020.2266381E+020.1498289E+02 0.2248272E+020.7440618E+010.0000000E+000.7310813E+010.9039623E+020.9977816E+02 0.8123956E+020.9021333E+020.7229816E+020.6356266E+020.7211335E+020.5502367E+02 0.4667265E+020.5483816E+020.3850118E+020.3050165E+020.3831543E+020.2266594E+02 0.1498433E+020.2248454E+020.7441417E+010.0000000E+000.7311401E+010.9040184E+02 0.9978426E+020.8124454E+020.9021780E+020.7230254E+020.6356656E+020.7211666E+02 0.5502695E+020.4667536E+020.5484068E+020.3850345E+020.3050346E+020.3831730E+02 0.2266734E+020.1498527E+020.2248555E+020.7441866E+010.0000000E+000.7311696E+01 0.9040484E+020.9978765E+020.8124712E+020.9021915E+020.7230488E+020.6356856E+02 0.7211785E+020.5502871E+020.4667683E+020.5484152E+020.3850471E+020.3050446E+02 0.3831784E+020.2266807E+020.1498572E+020.2248590E+020.7442050E+010.0000000E+00 0.7311822E+010.9040494E+020.9978769E+020.8124716E+020.9021775E+020.7230491E+02 0.6356854E+020.7211667E+020.5502872E+020.4667682E+020.5484069E+020.3850474E+02 0.3050451E+020.3831732E+020.2266808E+020.1498570E+020.2248552E+020.7442063E+01 0.0000000E+000.7311720E+010.9040205E+020.9978436E+020.8124457E+020.9021330E+02 0.7230269E+020.6356659E+020.7211335E+020.5502707E+020.4667539E+020.5483813E+02 0.3850354E+020.3050348E+020.3831545E+020.2266729E+020.1498529E+020.2248453E+02 0.7441818E+010.0000000E+000.7311409E+010.9039639E+020.9977809E+020.8123951E+02 0.9020648E+020.7229815E+020.6356264E+020.7210773E+020.5502366E+020.4667261E+02 0.5483409E+020.3850121E+020.3050157E+020.3831269E+020.2266594E+020.1498430E+02 0.2248269E+020.7441328E+010.0000000E+000.7310778E+010.9038788E+020.9976872E+02 0.8123192E+020.9019647E+020.7229164E+020.6355687E+020.7210010E+020.5501880E+02 0.4666840E+020.5482831E+020.3849766E+020.3049888E+020.3830873E+020.2266397E+02 0.1498291E+020.2248053E+020.7440663E+010.0000000E+000.7310084E+010.9037673E+02 0.9975595E+020.8122205E+020.9018414E+020.7228304E+020.6354940E+020.7209057E+02 0.5501240E+020.4666295E+020.5482125E+020.3849342E+020.3049549E+020.3830397E+02 0.2266140E+020.1498118E+020.2247771E+020.7439794E+010.0000000E+000.7309118E+01 0.9036331E+020.9974076E+020.8121023E+020.9016975E+020.7227263E+020.6354049E+02 0.7207965E+020.5500485E+020.4665675E+020.5481336E+020.3848831E+020.3049148E+02 0.3829869E+020.2265837E+020.1497918E+020.2247464E+020.7438837E+010.0000000E+00 0.7308107E+010.9034811E+020.9972340E+020.8119702E+020.9015408E+020.7226123E+02 0.6353067E+020.7206808E+020.5499665E+020.4664996E+020.5480510E+020.3848286E+02 0.3048718E+020.3829302E+020.2265514E+020.1497710E+020.2247141E+020.7437827E+01 0.0000000E+000.7307071E+010.9033230E+020.9970491E+020.8118347E+020.9013876E+02 0.7224968E+020.6352083E+020.7205691E+020.5498824E+020.4664291E+020.5479698E+02 0.3847711E+020.3048290E+020.3828765E+020.2265206E+020.1497510E+020.2246849E+02 0.7436917E+010.0000000E+000.7306230E+010.9031799E+020.9968827E+020.8117120E+02 0.9012604E+020.7223914E+020.6351189E+020.7204740E+020.5498065E+020.4663666E+02 0.5479017E+020.3847212E+020.3047885E+020.3828311E+020.2264934E+020.1497323E+02 0.2246582E+020.7435899E+010.0000000E+000.7305324E+010.9030698E+020.9967581E+02 0.8116161E+020.9011710E+020.7223078E+020.6350473E+020.7204049E+020.5497463E+02 0.4663168E+020.5478510E+020.3846804E+020.3047569E+020.3827960E+020.2264684E+02 0.1497167E+020.2246381E+020.7435110E+010.0000000E+000.7304627E+010.9029996E+02 0.9966808E+020.8115538E+020.9011203E+020.7222525E+020.6349994E+020.7203643E+02 0.5497050E+020.4662824E+020.5478203E+020.3846518E+020.3047344E+020.3827747E+02 0.2264515E+020.1497055E+020.2246253E+020.7434540E+010.0000000E+000.7304274E+01 0.9029675E+020.9966468E+020.8115247E+020.9011072E+020.7222256E+020.6349758E+02 0.7203516E+020.5496843E+020.4662652E+020.5478098E+020.3846373E+020.3047230E+02 0.3827673E+020.2264430E+020.1496999E+020.2246207E+020.7434276E+010.0000000E+00 0.7304108E+010.9029701E+020.9966528E+020.8115263E+020.9011252E+020.7222260E+02 0.6349755E+020.7203644E+020.5496835E+020.4662644E+020.5478186E+020.3846363E+02 0.3047222E+020.3827728E+020.2264422E+020.1496997E+020.2246239E+020.7434265E+01 0.0000000E+000.7304213E+010.9030030E+020.9966905E+020.8115549E+020.9011725E+02 0.7222504E+020.6349966E+020.7204002E+020.5497009E+020.4662789E+020.5478444E+02 0.3846478E+020.3047314E+020.3827905E+020.2264488E+020.1497038E+020.2246339E+02 0.7434435E+010.0000000E+000.7304511E+010.9030635E+020.9967595E+020.8116082E+02 0.9012460E+020.7222968E+020.6350368E+020.7204567E+020.5497350E+020.4663076E+02 0.5478863E+020.3846712E+020.3047499E+020.3828191E+020.2264622E+020.1497133E+02 0.2246507E+020.7434933E+010.0000000E+000.7305022E+010.9031489E+020.9968559E+02 0.8116837E+020.9013424E+020.7223626E+020.6350944E+020.7205317E+020.5497841E+02 0.4663489E+020.5479422E+020.3847048E+020.3047774E+020.3828576E+020.2264831E+02 0.1497270E+020.2246725E+020.7435545E+010.0000000E+000.7305812E+010.9032549E+02 0.9969750E+020.8117784E+020.9014580E+020.7224459E+020.6351672E+020.7206224E+02 0.5498464E+020.4664013E+020.5480096E+020.3847486E+020.3048109E+020.3829048E+02 0.2265068E+020.1497428E+020.2247007E+020.7436457E+010.0000000E+000.7306722E+01 0.9033801E+020.9971155E+020.8118897E+020.9015918E+020.7225435E+020.6352523E+02 0.7207261E+020.5499187E+020.4664618E+020.5480878E+020.3847981E+020.3048507E+02 0.3829582E+020.2265376E+020.1497623E+020.2247314E+020.7437321E+010.0000000E+00 0.7307671E+010.9035219E+020.9972747E+020.8120150E+020.9017394E+020.7226529E+02 0.6353471E+020.7208406E+020.5500007E+020.4665314E+020.5481724E+020.3848545E+02 0.3048935E+020.3830158E+020.2265678E+020.1497814E+020.2247639E+020.7438301E+01 0.0000000E+000.7308697E+010.9036744E+020.9974464E+020.8121496E+020.9018959E+02 0.7227711E+020.6354501E+020.7209612E+020.5500882E+020.4666050E+020.5482607E+02 0.3849143E+020.3049409E+020.3830756E+020.2266031E+020.1498048E+020.2247986E+02 0.7439474E+010.0000000E+000.7309837E+010.9038345E+020.9976273E+020.8122913E+02 0.9020566E+020.7228951E+020.6355573E+020.7210836E+020.5501792E+020.4666796E+02 0.5483494E+020.3849748E+020.3049888E+020.3831357E+020.2266386E+020.1498289E+02 0.2248340E+020.7440700E+010.0000000E+000.7310959E+010.9039941E+020.9978097E+02 0.8124288E+020.9022120E+020.7230139E+020.6356591E+020.7211981E+020.5502650E+02 0.4667523E+020.5484330E+020.3850340E+020.3050337E+020.3831919E+020.2266719E+02 0.1498514E+020.2248653E+020.7441737E+010.0000000E+000.7312058E+010.9041412E+02 0.9979805E+020.8125561E+020.9023454E+020.7231233E+020.6357508E+020.7212963E+02 0.5503437E+020.4668168E+020.5485017E+020.3850856E+020.3050751E+020.3832363E+02 0.2267026E+020.1498719E+020.2248929E+020.7442829E+010.0000000E+000.7312930E+01 0.9042611E+020.9981218E+020.8126566E+020.9024458E+020.7232075E+020.6358220E+02 0.7213639E+020.5504019E+020.4668642E+020.5485483E+020.3851242E+020.3051052E+02 0.3832681E+020.2267253E+020.1498869E+020.2249100E+020.7443564E+010.0000000E+00 0.7313483E+010.9043335E+020.9982108E+020.8127149E+020.9024820E+020.7232565E+02 0.6358620E+020.7213893E+020.5504351E+020.4668911E+020.5485646E+020.3851464E+02 0.3051222E+020.3832787E+020.2267376E+020.1498942E+020.2249164E+020.7443915E+01 0.7313696E+010.0000000E+00 ************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 60 0.1080000000000E+06 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+030.6917027E+03 0.6516524E+030.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+03 0.6917026E+030.6516524E+030.1000000E+040.9150624E+030.8457939E+030.7872170E+03 0.7364689E+030.6917024E+030.6516521E+030.1000000E+040.9150624E+030.8457939E+03 0.7872169E+030.7364687E+030.6917021E+030.6516516E+030.1000000E+040.9150621E+03 0.8457938E+030.7872166E+030.7364685E+030.6917017E+030.6516510E+030.1000000E+04 0.9150623E+030.8457937E+030.7872165E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457936E+030.7872164E+030.7364680E+030.6917010E+03 0.6516500E+030.1000000E+040.9150622E+030.8457936E+030.7872163E+030.7364678E+03 0.6917007E+030.6516494E+030.1000000E+040.9150621E+030.8457935E+030.7872161E+03 0.7364677E+030.6917005E+030.6516492E+030.1000000E+040.9150622E+030.8457934E+03 0.7872161E+030.7364676E+030.6917004E+030.6516490E+030.1000000E+040.9150621E+03 0.8457934E+030.7872161E+030.7364676E+030.6917004E+030.6516491E+030.1000000E+04 0.9150620E+030.8457934E+030.7872161E+030.7364677E+030.6917005E+030.6516493E+03 0.1000000E+040.9150621E+030.8457935E+030.7872161E+030.7364678E+030.6917007E+03 0.6516497E+030.1000000E+040.9150621E+030.8457935E+030.7872162E+030.7364679E+03 0.6917010E+030.6516500E+030.1000000E+040.9150622E+030.8457935E+030.7872163E+03 0.7364680E+030.6917012E+030.6516504E+030.1000000E+040.9150621E+030.8457935E+03 0.7872164E+030.7364682E+030.6917014E+030.6516508E+030.1000000E+040.9150622E+03 0.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+030.1000000E+04 0.9150623E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+03 0.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+03 0.6516510E+030.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364682E+03 0.6917014E+030.6516508E+030.1000000E+040.9150621E+030.8457935E+030.7872163E+03 0.7364681E+030.6917012E+030.6516505E+030.1000000E+040.9150620E+030.8457935E+03 0.7872161E+030.7364679E+030.6917010E+030.6516500E+030.1000000E+040.9150622E+03 0.8457935E+030.7872161E+030.7364678E+030.6917008E+030.6516496E+030.1000000E+04 0.9150622E+030.8457934E+030.7872161E+030.7364676E+030.6917005E+030.6516494E+03 0.1000000E+040.9150621E+030.8457934E+030.7872161E+030.7364676E+030.6917004E+03 0.6516491E+030.1000000E+040.9150621E+030.8457934E+030.7872160E+030.7364676E+03 0.6917004E+030.6516490E+030.1000000E+040.9150622E+030.8457934E+030.7872162E+03 0.7364677E+030.6917005E+030.6516491E+030.1000000E+040.9150621E+030.8457935E+03 0.7872162E+030.7364678E+030.6917007E+030.6516494E+030.1000000E+040.9150622E+03 0.8457936E+030.7872163E+030.7364680E+030.6917010E+030.6516499E+030.1000000E+04 0.9150623E+030.8457937E+030.7872164E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457938E+030.7872167E+030.7364685E+030.6917017E+03 0.6516510E+030.1000000E+040.9150624E+030.8457939E+030.7872168E+030.7364687E+03 0.6917021E+030.6516515E+030.1000000E+040.9150623E+030.8457939E+030.7872169E+03 0.7364689E+030.6917024E+030.6516520E+030.1000000E+040.9150624E+030.8457939E+03 0.7872170E+030.7364691E+030.6917026E+030.6516524E+030.1000000E+040.9150625E+03 0.8457939E+030.7872170E+030.7364691E+030.6917027E+030.6516524E+030.9964556E+02 0.8108989E+020.6340347E+020.4650543E+020.3032881E+020.1482089E+020.0000000E+00 0.9964095E+020.8108690E+020.6340139E+020.4650412E+020.3032799E+020.1482048E+02 0.0000000E+000.9962878E+020.8107867E+020.6339574E+020.4650022E+020.3032548E+02 0.1481943E+020.0000000E+000.9961323E+020.8106711E+020.6338746E+020.4649472E+02 0.3032188E+020.1481752E+020.0000000E+000.9959517E+020.8105376E+020.6337769E+02 0.4648767E+020.3031768E+020.1481548E+020.0000000E+000.9957701E+020.8103980E+02 0.6336716E+020.4648026E+020.3031294E+020.1481309E+020.0000000E+000.9955943E+02 0.8102595E+020.6335671E+020.4647295E+020.3030827E+020.1481077E+020.0000000E+00 0.9954276E+020.8101294E+020.6334686E+020.4646582E+020.3030366E+020.1480865E+02 0.0000000E+000.9952774E+020.8100109E+020.6333775E+020.4645915E+020.3029953E+02 0.1480678E+020.0000000E+000.9951482E+020.8099077E+020.6332986E+020.4645358E+02 0.3029587E+020.1480490E+020.0000000E+000.9950401E+020.8098223E+020.6332333E+02 0.4644890E+020.3029282E+020.1480343E+020.0000000E+000.9949563E+020.8097572E+02 0.6331845E+020.4644539E+020.3029054E+020.1480235E+020.0000000E+000.9949035E+02 0.8097164E+020.6331536E+020.4644320E+020.3028916E+020.1480166E+020.0000000E+00 0.9948816E+020.8097011E+020.6331432E+020.4644253E+020.3028873E+020.1480149E+02 0.0000000E+000.9948945E+020.8097145E+020.6331548E+020.4644341E+020.3028935E+02 0.1480173E+020.0000000E+000.9949496E+020.8097601E+020.6331904E+020.4644599E+02 0.3029100E+020.1480260E+020.0000000E+000.9950501E+020.8098393E+020.6332500E+02 0.4645024E+020.3029379E+020.1480386E+020.0000000E+000.9951970E+020.8099493E+02 0.6333314E+020.4645592E+020.3029740E+020.1480574E+020.0000000E+000.9953758E+02 0.8100800E+020.6334264E+020.4646260E+020.3030160E+020.1480756E+020.0000000E+00 0.9955573E+020.8102148E+020.6335250E+020.4646950E+020.3030583E+020.1480956E+02 0.0000000E+000.9957201E+020.8103403E+020.6336190E+020.4647607E+020.3030999E+02 0.1481161E+020.0000000E+000.9958600E+020.8104502E+020.6337019E+020.4648184E+02 0.3031375E+020.1481351E+020.0000000E+000.9959733E+020.8105373E+020.6337677E+02 0.4648682E+020.3031677E+020.1481502E+020.0000000E+000.9960478E+020.8106001E+02 0.6338164E+020.4649015E+020.3031906E+020.1481628E+020.0000000E+000.9960976E+02 0.8106383E+020.6338456E+020.4649232E+020.3032051E+020.1481692E+020.0000000E+00 0.9961135E+020.8106511E+020.6338558E+020.4649300E+020.3032099E+020.1481713E+02 0.0000000E+000.9960975E+020.8106384E+020.6338456E+020.4649235E+020.3032054E+02 0.1481690E+020.0000000E+000.9960478E+020.8105999E+020.6338164E+020.4649015E+02 0.3031903E+020.1481630E+020.0000000E+000.9959732E+020.8105369E+020.6337680E+02 0.4648684E+020.3031671E+020.1481501E+020.0000000E+000.9958597E+020.8104496E+02 0.6337016E+020.4648186E+020.3031379E+020.1481355E+020.0000000E+000.9957204E+02 0.8103411E+020.6336188E+020.4647602E+020.3031002E+020.1481162E+020.0000000E+00 0.9955578E+020.8102149E+020.6335250E+020.4646952E+020.3030591E+020.1480959E+02 0.0000000E+000.9953760E+020.8100801E+020.6334267E+020.4646260E+020.3030146E+02 0.1480751E+020.0000000E+000.9951964E+020.8099493E+020.6333313E+020.4645581E+02 0.3029736E+020.1480575E+020.0000000E+000.9950498E+020.8098390E+020.6332501E+02 0.4645025E+020.3029379E+020.1480390E+020.0000000E+000.9949495E+020.8097599E+02 0.6331904E+020.4644598E+020.3029103E+020.1480257E+020.0000000E+000.9948941E+02 0.8097144E+020.6331547E+020.4644341E+020.3028933E+020.1480176E+020.0000000E+00 0.9948817E+020.8097012E+020.6331429E+020.4644252E+020.3028873E+020.1480145E+02 0.0000000E+000.9949032E+020.8097165E+020.6331537E+020.4644323E+020.3028915E+02 0.1480168E+020.0000000E+000.9949569E+020.8097577E+020.6331843E+020.4644538E+02 0.3029055E+020.1480230E+020.0000000E+000.9950401E+020.8098224E+020.6332333E+02 0.4644889E+020.3029279E+020.1480346E+020.0000000E+000.9951485E+020.8099076E+02 0.6332987E+020.4645356E+020.3029587E+020.1480486E+020.0000000E+000.9952774E+02 0.8100105E+020.6333777E+020.4645925E+020.3029954E+020.1480678E+020.0000000E+00 0.9954276E+020.8101290E+020.6334679E+020.4646580E+020.3030377E+020.1480864E+02 0.0000000E+000.9955939E+020.8102593E+020.6335671E+020.4647294E+020.3030820E+02 0.1481075E+020.0000000E+000.9957699E+020.8103973E+020.6336716E+020.4648031E+02 0.3031292E+020.1481307E+020.0000000E+000.9959524E+020.8105382E+020.6337770E+02 0.4648764E+020.3031764E+020.1481544E+020.0000000E+000.9961320E+020.8106715E+02 0.6338746E+020.4649472E+020.3032191E+020.1481755E+020.0000000E+000.9962876E+02 0.8107869E+020.6339574E+020.4650022E+020.3032552E+020.1481940E+020.0000000E+00 0.9964096E+020.8108688E+020.6340138E+020.4650409E+020.3032795E+020.1482051E+02 0.0000000E+000.9964556E+020.8108989E+020.6340344E+020.4650540E+020.3032881E+02 0.1482089E+020.0000000E+000.9554770E+030.9550919E+030.1000000E+040.9550920E+03 0.9154679E+030.8788551E+030.8792583E+030.8461998E+030.8788551E+030.8153799E+03 0.8157839E+030.7876227E+030.8153799E+030.7609979E+030.7614023E+030.7368747E+03 0.7609979E+030.7134280E+030.7138327E+030.6921083E+030.7134280E+030.6711521E+03 0.6715578E+030.6520642E+030.6711521E+030.9554770E+030.1000000E+040.9154678E+03 0.9550919E+030.8792583E+030.8461997E+030.8788550E+030.8157838E+030.7876227E+03 0.8153798E+030.7614022E+030.7368746E+030.7609978E+030.7138326E+030.6921082E+03 0.7134278E+030.6715577E+030.6520640E+030.6711518E+030.9554771E+030.1000000E+04 0.9154678E+030.9550919E+030.8792582E+030.8461997E+030.8788551E+030.8157838E+03 0.7876226E+030.8153798E+030.7614021E+030.7368744E+030.7609976E+030.7138324E+03 0.6921080E+030.7134276E+030.6715574E+030.6520637E+030.6711514E+030.9554771E+03 0.1000000E+040.9154677E+030.9550918E+030.8792582E+030.8461996E+030.8788549E+03 0.8157837E+030.7876224E+030.8153796E+030.7614019E+030.7368742E+030.7609975E+03 0.7138321E+030.6921076E+030.7134273E+030.6715569E+030.6520631E+030.6711510E+03 0.9554769E+030.1000000E+040.9154676E+030.9550919E+030.8792582E+030.8461995E+03 0.8788550E+030.8157836E+030.7876222E+030.8153795E+030.7614018E+030.7368739E+03 0.7609972E+030.7138318E+030.6921071E+030.7134270E+030.6715564E+030.6520624E+03 0.6711505E+030.9554770E+030.1000000E+040.9154677E+030.9550919E+030.8792582E+03 0.8461995E+030.8788550E+030.8157835E+030.7876221E+030.8153794E+030.7614015E+03 0.7368737E+030.7609970E+030.7138315E+030.6921068E+030.7134266E+030.6715560E+03 0.6520620E+030.6711500E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792582E+030.8461994E+030.8788550E+030.8157833E+030.7876220E+030.8153792E+03 0.7614014E+030.7368735E+030.7609969E+030.7138312E+030.6921065E+030.7134264E+03 0.6715556E+030.6520615E+030.6711496E+030.9554769E+030.1000000E+040.9154676E+03 0.9550917E+030.8792581E+030.8461993E+030.8788548E+030.8157832E+030.7876219E+03 0.8153792E+030.7614012E+030.7368733E+030.7609968E+030.7138310E+030.6921062E+03 0.7134262E+030.6715553E+030.6520611E+030.6711494E+030.9554768E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157832E+03 0.7876217E+030.8153792E+030.7614012E+030.7368732E+030.7609967E+030.7138309E+03 0.6921061E+030.7134262E+030.6715551E+030.6520608E+030.6711492E+030.9554769E+03 0.1000000E+040.9154676E+030.9550917E+030.8792579E+030.8461992E+030.8788547E+03 0.8157832E+030.7876217E+030.8153792E+030.7614011E+030.7368732E+030.7609967E+03 0.7138308E+030.6921060E+030.7134262E+030.6715550E+030.6520608E+030.6711493E+03 0.9554768E+030.1000000E+040.9154675E+030.9550916E+030.8792580E+030.8461992E+03 0.8788547E+030.8157832E+030.7876217E+030.8153791E+030.7614011E+030.7368732E+03 0.7609968E+030.7138309E+030.6921061E+030.7134262E+030.6715551E+030.6520609E+03 0.6711495E+030.9554766E+030.1000000E+040.9154675E+030.9550915E+030.8792580E+03 0.8461993E+030.8788548E+030.8157831E+030.7876218E+030.8153792E+030.7614013E+03 0.7368733E+030.7609968E+030.7138310E+030.6921062E+030.7134264E+030.6715553E+03 0.6520613E+030.6711498E+030.9554768E+030.1000000E+040.9154676E+030.9550916E+03 0.8792580E+030.8461993E+030.8788547E+030.8157832E+030.7876218E+030.8153792E+03 0.7614013E+030.7368734E+030.7609969E+030.7138312E+030.6921064E+030.7134266E+03 0.6715557E+030.6520616E+030.6711501E+030.9554768E+030.1000000E+040.9154676E+03 0.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+030.7876219E+03 0.8153794E+030.7614014E+030.7368735E+030.7609970E+030.7138314E+030.6921067E+03 0.7134268E+030.6715560E+030.6520621E+030.6711504E+030.9554769E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876220E+030.8153793E+030.7614014E+030.7368737E+030.7609971E+030.7138316E+03 0.6921070E+030.7134269E+030.6715562E+030.6520624E+030.6711507E+030.9554768E+03 0.1000000E+040.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788548E+03 0.8157834E+030.7876221E+030.8153794E+030.7614015E+030.7368738E+030.7609971E+03 0.7138317E+030.6921071E+030.7134271E+030.6715565E+030.6520627E+030.6711509E+03 0.9554769E+030.1000000E+040.9154677E+030.9550918E+030.8792581E+030.8461994E+03 0.8788548E+030.8157833E+030.7876221E+030.8153794E+030.7614016E+030.7368739E+03 0.7609972E+030.7138317E+030.6921072E+030.7134271E+030.6715567E+030.6520629E+03 0.6711509E+030.9554770E+030.1000000E+040.9154677E+030.9550918E+030.8792580E+03 0.8461994E+030.8788548E+030.8157834E+030.7876221E+030.8153794E+030.7614015E+03 0.7368739E+030.7609972E+030.7138318E+030.6921072E+030.7134271E+030.6715566E+03 0.6520629E+030.6711509E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792580E+030.8461995E+030.8788548E+030.8157834E+030.7876220E+030.8153794E+03 0.7614015E+030.7368739E+030.7609971E+030.7138317E+030.6921071E+030.7134270E+03 0.6715565E+030.6520627E+030.6711507E+030.9554769E+030.1000000E+040.9154676E+03 0.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157833E+030.7876220E+03 0.8153794E+030.7614014E+030.7368737E+030.7609970E+030.7138315E+030.6921069E+03 0.7134268E+030.6715563E+030.6520624E+030.6711504E+030.9554770E+030.1000000E+04 0.9154675E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876218E+030.8153792E+030.7614013E+030.7368736E+030.7609968E+030.7138313E+03 0.6921067E+030.7134266E+030.6715560E+030.6520621E+030.6711501E+030.9554768E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876218E+030.8153792E+030.7614012E+030.7368734E+030.7609967E+03 0.7138312E+030.6921065E+030.7134264E+030.6715556E+030.6520616E+030.6711498E+03 0.9554769E+030.1000000E+040.9154675E+030.9550919E+030.8792581E+030.8461992E+03 0.8788548E+030.8157831E+030.7876218E+030.8153791E+030.7614011E+030.7368733E+03 0.7609966E+030.7138311E+030.6921062E+030.7134262E+030.6715553E+030.6520613E+03 0.6711495E+030.9554768E+030.1000000E+040.9154675E+030.9550917E+030.8792580E+03 0.8461993E+030.8788547E+030.8157831E+030.7876218E+030.8153791E+030.7614010E+03 0.7368732E+030.7609966E+030.7138309E+030.6921061E+030.7134262E+030.6715552E+03 0.6520610E+030.6711493E+030.9554769E+030.1000000E+040.9154675E+030.9550917E+03 0.8792580E+030.8461992E+030.8788547E+030.8157832E+030.7876217E+030.8153791E+03 0.7614010E+030.7368732E+030.7609966E+030.7138309E+030.6921060E+030.7134262E+03 0.6715550E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+040.9154675E+03 0.9550917E+030.8792580E+030.8461992E+030.8788547E+030.8157831E+030.7876217E+03 0.8153792E+030.7614010E+030.7368732E+030.7609967E+030.7138309E+030.6921061E+03 0.7134263E+030.6715551E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+04 0.9154676E+030.9550916E+030.8792579E+030.8461993E+030.8788548E+030.8157833E+03 0.7876219E+030.8153793E+030.7614011E+030.7368733E+030.7609968E+030.7138310E+03 0.6921062E+030.7134264E+030.6715552E+030.6520611E+030.6711497E+030.9554766E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876219E+030.8153794E+030.7614013E+030.7368734E+030.7609970E+03 0.7138312E+030.6921064E+030.7134266E+030.6715555E+030.6520614E+030.6711500E+03 0.9554767E+030.1000000E+040.9154676E+030.9550918E+030.8792581E+030.8461995E+03 0.8788550E+030.8157834E+030.7876220E+030.8153795E+030.7614016E+030.7368737E+03 0.7609972E+030.7138315E+030.6921068E+030.7134269E+030.6715559E+030.6520620E+03 0.6711504E+030.9554769E+030.1000000E+040.9154678E+030.9550917E+030.8792582E+03 0.8461995E+030.8788549E+030.8157836E+030.7876222E+030.8153796E+030.7614017E+03 0.7368739E+030.7609974E+030.7138318E+030.6921071E+030.7134273E+030.6715564E+03 0.6520624E+030.6711510E+030.9554769E+030.1000000E+040.9154678E+030.9550918E+03 0.8792583E+030.8461996E+030.8788551E+030.8157837E+030.7876224E+030.8153798E+03 0.7614018E+030.7368742E+030.7609975E+030.7138321E+030.6921076E+030.7134275E+03 0.6715569E+030.6520631E+030.6711514E+030.9554770E+030.1000000E+040.9154678E+03 0.9550918E+030.8792582E+030.8461997E+030.8788550E+030.8157837E+030.7876225E+03 0.8153798E+030.7614020E+030.7368744E+030.7609977E+030.7138324E+030.6921079E+03 0.7134278E+030.6715573E+030.6520636E+030.6711518E+030.9554769E+030.1000000E+04 0.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788550E+030.8157838E+03 0.7876226E+030.8153799E+030.7614021E+030.7368746E+030.7609978E+030.7138325E+03 0.6921081E+030.7134280E+030.6715576E+030.6520640E+030.6711521E+030.9554770E+03 0.1000000E+040.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788551E+03 0.8157838E+030.7876227E+030.8153799E+030.7614023E+030.7368747E+030.7609978E+03 0.7138327E+030.6921083E+030.7134280E+030.6715578E+030.6711521E+030.6520642E+03 0.9043838E+020.9024957E+020.9982622E+020.9025323E+020.8127636E+020.7214347E+02 0.7233029E+020.6359043E+020.7214097E+020.5486039E+020.5504741E+020.4669250E+02 0.5485868E+020.3833072E+020.3851757E+020.3051461E+020.3832971E+020.2249337E+02 0.2267556E+020.1499063E+020.2249275E+020.7314282E+010.7444517E+010.0000000E+00 0.7314060E+010.9043148E+020.9981744E+020.8127055E+020.9023954E+020.7232557E+02 0.6358648E+020.7213421E+020.5504420E+020.4668984E+020.5485396E+020.3851544E+02 0.3051287E+020.3832652E+020.2267428E+020.1498989E+020.2249105E+020.7444110E+01 0.0000000E+000.7313530E+010.9041947E+020.9980312E+020.8126038E+020.9022621E+02 0.7231698E+020.6357928E+020.7212433E+020.5503822E+020.4668501E+020.5484716E+02 0.3851150E+020.3050977E+020.3832205E+020.2267208E+020.1498834E+020.2248828E+02 0.7443326E+010.0000000E+000.7312599E+010.9040472E+020.9978615E+020.8124774E+02 0.9021060E+020.7230629E+020.6357014E+020.7211288E+020.5503061E+020.4667863E+02 0.5483881E+020.3850625E+020.3050575E+020.3831644E+020.2266914E+020.1498634E+02 0.2248520E+020.7442359E+010.0000000E+000.7311620E+010.9038882E+020.9976780E+02 0.8123389E+020.9019465E+020.7229437E+020.6355989E+020.7210070E+020.5502190E+02 0.4667127E+020.5482988E+020.3850047E+020.3050120E+020.3831043E+020.2266572E+02 0.1498406E+020.2248166E+020.7441241E+010.0000000E+000.7310430E+010.9037290E+02 0.9974981E+020.8121988E+020.9017898E+020.7228202E+020.6354930E+020.7208863E+02 0.5501291E+020.4666387E+020.5482103E+020.3849439E+020.3049641E+020.3830447E+02 0.2266211E+020.1498168E+020.2247817E+020.7440087E+010.0000000E+000.7309262E+01 0.9035754E+020.9973262E+020.8120634E+020.9016421E+020.7227020E+020.6353898E+02 0.7207723E+020.5500420E+020.4665662E+020.5481262E+020.3848852E+020.3049177E+02 0.3829859E+020.2265861E+020.1497939E+020.2247482E+020.7438894E+010.0000000E+00 0.7308273E+010.9034337E+020.9971664E+020.8119381E+020.9015083E+020.7225919E+02 0.6352946E+020.7206680E+020.5499588E+020.4664957E+020.5480473E+020.3848274E+02 0.3048744E+020.3829326E+020.2265549E+020.1497740E+020.2247185E+020.7437973E+01 0.0000000E+000.7307320E+010.9033081E+020.9970261E+020.8118269E+020.9013923E+02 0.7224937E+020.6352094E+020.7205772E+020.5498854E+020.4664343E+020.5479803E+02 0.3847775E+020.3048333E+020.3828864E+020.2265269E+020.1497544E+020.2246911E+02 0.7437008E+010.0000000E+000.7306398E+010.9032011E+020.9969069E+020.8117319E+02 0.9012959E+020.7224098E+020.6351365E+020.7205021E+020.5498235E+020.4663825E+02 0.5479245E+020.3847347E+020.3048001E+020.3828479E+020.2265008E+020.1497380E+02 0.2246688E+020.7436171E+010.0000000E+000.7305629E+010.9031149E+020.9968104E+02 0.8116564E+020.9012219E+020.7223431E+020.6350790E+020.7204453E+020.5497742E+02 0.4663413E+020.5478828E+020.3847005E+020.3047730E+020.3828191E+020.2264805E+02 0.1497247E+020.2246518E+020.7435500E+010.0000000E+000.7305146E+010.9030538E+02 0.9967414E+020.8116026E+020.9011753E+020.7222965E+020.6350388E+020.7204098E+02 0.5497395E+020.4663124E+020.5478564E+020.3846769E+020.3047547E+020.3828013E+02 0.2264669E+020.1497157E+020.2246415E+020.7435064E+010.0000000E+000.7304796E+01 0.9030206E+020.9967038E+020.8115744E+020.9011570E+020.7222718E+020.6350177E+02 0.7203971E+020.5497218E+020.4662979E+020.5478480E+020.3846651E+020.3047455E+02 0.3827959E+020.2264599E+020.1497116E+020.2246385E+020.7434860E+010.0000000E+00 0.7304703E+010.9030172E+020.9966985E+020.8115728E+020.9011705E+020.7222712E+02 0.6350181E+020.7204098E+020.5497223E+020.4662987E+020.5478584E+020.3846655E+02 0.3047463E+020.3828034E+020.2264605E+020.1497118E+020.2246428E+020.7434839E+01 0.0000000E+000.7304818E+010.9030482E+020.9967320E+020.8116021E+020.9012210E+02 0.7222972E+020.6350416E+020.7204503E+020.5497426E+020.4663162E+020.5478891E+02 0.3846801E+020.3047578E+020.3828245E+020.2264688E+020.1497178E+020.2246551E+02 0.7435166E+010.0000000E+000.7305188E+010.9031180E+020.9968095E+020.8116646E+02 0.9013107E+020.7223520E+020.6350897E+020.7205195E+020.5497833E+020.4663506E+02 0.5479398E+020.3847083E+020.3047809E+020.3828595E+020.2264865E+020.1497293E+02 0.2246749E+020.7435670E+010.0000000E+000.7305906E+010.9032269E+020.9969338E+02 0.8117602E+020.9014380E+020.7224343E+020.6351609E+020.7206143E+020.5498440E+02 0.4664010E+020.5480082E+020.3847497E+020.3048129E+020.3829061E+020.2265087E+02 0.1497443E+020.2247024E+020.7436537E+010.0000000E+000.7306791E+010.9033695E+02 0.9971005E+020.8118829E+020.9015906E+020.7225394E+020.6352507E+020.7207260E+02 0.5499189E+020.4664629E+020.5480890E+020.3847996E+020.3048523E+020.3829598E+02 0.2265391E+020.1497635E+020.2247326E+020.7437383E+010.0000000E+000.7307719E+01 0.9035274E+020.9972846E+020.8120182E+020.9017472E+020.7226549E+020.6353484E+02 0.7208420E+020.5500020E+020.4665325E+020.5481720E+020.3848553E+020.3048944E+02 0.3830151E+020.2265685E+020.1497819E+020.2247635E+020.7438328E+010.0000000E+00 0.7308688E+010.9036790E+020.9974582E+020.8121496E+020.9018907E+020.7227688E+02 0.6354465E+020.7209509E+020.5500842E+020.4666011E+020.5482509E+020.3849112E+02 0.3049382E+020.3830680E+020.2266011E+020.1498036E+020.2247941E+020.7439416E+01 0.0000000E+000.7309701E+010.9038144E+020.9976108E+020.8122694E+020.9020150E+02 0.7228737E+020.6355369E+020.7210469E+020.5501612E+020.4666639E+020.5483207E+02 0.3849620E+020.3049786E+020.3831158E+020.2266308E+020.1498238E+020.2248225E+02 0.7440444E+010.0000000E+000.7310593E+010.9039276E+020.9977380E+020.8123672E+02 0.9021150E+020.7229592E+020.6356110E+020.7211230E+020.5502238E+020.4667178E+02 0.5483783E+020.3850062E+020.3050118E+020.3831557E+020.2266558E+020.1498408E+02 0.2248447E+020.7441211E+010.0000000E+000.7311396E+010.9040123E+020.9978326E+02 0.8124437E+020.9021833E+020.7230271E+020.6356687E+020.7211789E+020.5502749E+02 0.4667601E+020.5484197E+020.3850405E+020.3050398E+020.3831829E+020.2266771E+02 0.1498551E+020.2248629E+020.7442010E+010.0000000E+000.7311984E+010.9040684E+02 0.9978937E+020.8124935E+020.9022279E+020.7230709E+020.6357077E+020.7212120E+02 0.5503076E+020.4667873E+020.5484449E+020.3850631E+020.3050580E+020.3832016E+02 0.2266910E+020.1498646E+020.2248730E+020.7442459E+010.0000000E+000.7312279E+01 0.9040984E+020.9979275E+020.8125193E+020.9022414E+020.7230942E+020.6357277E+02 0.7212239E+020.5503252E+020.4668020E+020.5484533E+020.3850758E+020.3050679E+02 0.3832070E+020.2266984E+020.1498690E+020.2248765E+020.7442643E+010.0000000E+00 0.7312406E+010.9040993E+020.9979279E+020.8125197E+020.9022274E+020.7230946E+02 0.6357275E+020.7212120E+020.5503253E+020.4668019E+020.5484450E+020.3850760E+02 0.3050684E+020.3832018E+020.2266984E+020.1498688E+020.2248727E+020.7442656E+01 0.0000000E+000.7312303E+010.9040705E+020.9978946E+020.8124938E+020.9021829E+02 0.7230724E+020.6357081E+020.7211789E+020.5503089E+020.4667876E+020.5484194E+02 0.3850641E+020.3050581E+020.3831831E+020.2266905E+020.1498648E+020.2248629E+02 0.7442411E+010.0000000E+000.7311992E+010.9040139E+020.9978319E+020.8124432E+02 0.9021147E+020.7230269E+020.6356685E+020.7211227E+020.5502747E+020.4667598E+02 0.5483789E+020.3850407E+020.3050390E+020.3831554E+020.2266771E+020.1498548E+02 0.2248444E+020.7441921E+010.0000000E+000.7311362E+010.9039288E+020.9977382E+02 0.8123673E+020.9020146E+020.7229618E+020.6356109E+020.7210464E+020.5502262E+02 0.4667176E+020.5483212E+020.3850053E+020.3050121E+020.3831159E+020.2266574E+02 0.1498410E+020.2248228E+020.7441257E+010.0000000E+000.7310667E+010.9038173E+02 0.9976106E+020.8122687E+020.9018913E+020.7228759E+020.6355361E+020.7209511E+02 0.5501622E+020.4666631E+020.5482506E+020.3849628E+020.3049783E+020.3830683E+02 0.2266317E+020.1498236E+020.2247946E+020.7440388E+010.0000000E+000.7309702E+01 0.9036831E+020.9974587E+020.8121504E+020.9017475E+020.7227718E+020.6354470E+02 0.7208419E+020.5500867E+020.4666011E+020.5481717E+020.3849117E+020.3049381E+02 0.3830155E+020.2266014E+020.1498037E+020.2247640E+020.7439430E+010.0000000E+00 0.7308690E+010.9035311E+020.9972851E+020.8120183E+020.9015908E+020.7226578E+02 0.6353488E+020.7207262E+020.5500046E+020.4665332E+020.5480891E+020.3848572E+02 0.3048951E+020.3829587E+020.2265691E+020.1497828E+020.2247316E+020.7438420E+01 0.0000000E+000.7307655E+010.9033730E+020.9971002E+020.8118829E+020.9014376E+02 0.7225423E+020.6352504E+020.7206145E+020.5499206E+020.4664628E+020.5480079E+02 0.3847998E+020.3048524E+020.3829051E+020.2265383E+020.1497629E+020.2247025E+02 0.7437511E+010.0000000E+000.7306813E+010.9032299E+020.9969338E+020.8117601E+02 0.9013104E+020.7224369E+020.6351610E+020.7205194E+020.5498447E+020.4664003E+02 0.5479398E+020.3847499E+020.3048119E+020.3828597E+020.2265111E+020.1497442E+02 0.2246757E+020.7436493E+010.0000000E+000.7305908E+010.9031198E+020.9968091E+02 0.8116642E+020.9012210E+020.7223533E+020.6350894E+020.7204503E+020.5497845E+02 0.4663505E+020.5478891E+020.3847090E+020.3047802E+020.3828245E+020.2264861E+02 0.1497286E+020.2246556E+020.7435703E+010.0000000E+000.7305211E+010.9030496E+02 0.9967318E+020.8116019E+020.9011703E+020.7222980E+020.6350415E+020.7204097E+02 0.5497431E+020.4663161E+020.5478583E+020.3846805E+020.3047577E+020.3828033E+02 0.2264692E+020.1497173E+020.2246429E+020.7435134E+010.0000000E+000.7304858E+01 0.9030175E+020.9966979E+020.8115729E+020.9011571E+020.7222711E+020.6350179E+02 0.7203970E+020.5497224E+020.4662989E+020.5478479E+020.3846660E+020.3047463E+02 0.3827958E+020.2264606E+020.1497118E+020.2246383E+020.7434870E+010.0000000E+00 0.7304692E+010.9030201E+020.9967039E+020.8115745E+020.9011751E+020.7222715E+02 0.6350176E+020.7204099E+020.5497217E+020.4662981E+020.5478567E+020.3846650E+02 0.3047455E+020.3828014E+020.2264599E+020.1497116E+020.2246415E+020.7434859E+01 0.0000000E+000.7304797E+010.9030531E+020.9967416E+020.8116030E+020.9012225E+02 0.7222959E+020.6350388E+020.7204456E+020.5497391E+020.4663126E+020.5478825E+02 0.3846765E+020.3047547E+020.3828191E+020.2264665E+020.1497156E+020.2246515E+02 0.7435030E+010.0000000E+000.7305094E+010.9031136E+020.9968106E+020.8116564E+02 0.9012960E+020.7223423E+020.6350789E+020.7205022E+020.5497732E+020.4663413E+02 0.5479244E+020.3846999E+020.3047732E+020.3828476E+020.2264799E+020.1497251E+02 0.2246682E+020.7435527E+010.0000000E+000.7305606E+010.9031989E+020.9969070E+02 0.8117319E+020.9013924E+020.7224082E+020.6351366E+020.7205772E+020.5498223E+02 0.4663826E+020.5479803E+020.3847335E+020.3048007E+020.3828862E+020.2265008E+02 0.1497389E+020.2246900E+020.7436140E+010.0000000E+000.7306396E+010.9033050E+02 0.9970261E+020.8118266E+020.9015080E+020.7224914E+020.6352094E+020.7206679E+02 0.5498846E+020.4664350E+020.5480478E+020.3847773E+020.3048343E+020.3829334E+02 0.2265245E+020.1497547E+020.2247183E+020.7437051E+010.0000000E+000.7307307E+01 0.9034302E+020.9971666E+020.8119379E+020.9016418E+020.7225890E+020.6352945E+02 0.7207716E+020.5499569E+020.4664955E+020.5481259E+020.3848269E+020.3048740E+02 0.3829868E+020.2265553E+020.1497742E+020.2247489E+020.7437916E+010.0000000E+00 0.7308256E+010.9035720E+020.9973259E+020.8120632E+020.9017895E+020.7226984E+02 0.6353893E+020.7208862E+020.5500390E+020.4665651E+020.5482106E+020.3848832E+02 0.3049169E+020.3830444E+020.2265855E+020.1497933E+020.2247815E+020.7438896E+01 0.0000000E+000.7309282E+010.9037245E+020.9974976E+020.8121979E+020.9019460E+02 0.7228167E+020.6354924E+020.7210067E+020.5501264E+020.4666387E+020.5482989E+02 0.3849430E+020.3049643E+020.3831042E+020.2266208E+020.1498167E+020.2248162E+02 0.7440070E+010.0000000E+000.7310423E+010.9038847E+020.9976785E+020.8123396E+02 0.9021067E+020.7229407E+020.6355995E+020.7211292E+020.5502175E+020.4667133E+02 0.5483876E+020.3850036E+020.3050122E+020.3831644E+020.2266563E+020.1498408E+02 0.2248516E+020.7441295E+010.0000000E+000.7311545E+010.9040443E+020.9978609E+02 0.8124771E+020.9022621E+020.7230595E+020.6357014E+020.7212437E+020.5503033E+02 0.4667861E+020.5484713E+020.3850627E+020.3050571E+020.3832206E+020.2266896E+02 0.1498633E+020.2248829E+020.7442333E+010.0000000E+000.7312644E+010.9041914E+02 0.9980318E+020.8126045E+020.9023956E+020.7231689E+020.6357932E+020.7213419E+02 0.5503821E+020.4668506E+020.5485400E+020.3851144E+020.3050985E+020.3832650E+02 0.2267204E+020.1498838E+020.2249105E+020.7443425E+010.0000000E+000.7313517E+01 0.9043114E+020.9981732E+020.8127050E+020.9024961E+020.7232532E+020.6358643E+02 0.7214095E+020.5504403E+020.4668981E+020.5485866E+020.3851530E+020.3051286E+02 0.3832968E+020.2267431E+020.1498989E+020.2249276E+020.7444161E+010.0000000E+00 0.7314070E+010.9043838E+020.9982623E+020.8127633E+020.9025323E+020.7233023E+02 0.6359044E+020.7214350E+020.5504735E+020.4669249E+020.5486029E+020.3851753E+02 0.3051456E+020.3833074E+020.2267553E+020.1499062E+020.2249340E+020.7444511E+01 0.7314281E+010.0000000E+00 ************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 80 0.1440000000000E+06 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+030.6917027E+03 0.6516524E+030.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+03 0.6917026E+030.6516524E+030.1000000E+040.9150624E+030.8457939E+030.7872170E+03 0.7364689E+030.6917024E+030.6516521E+030.1000000E+040.9150624E+030.8457939E+03 0.7872169E+030.7364687E+030.6917022E+030.6516516E+030.1000000E+040.9150621E+03 0.8457938E+030.7872166E+030.7364685E+030.6917017E+030.6516510E+030.1000000E+04 0.9150623E+030.8457937E+030.7872165E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457936E+030.7872164E+030.7364680E+030.6917010E+03 0.6516500E+030.1000000E+040.9150622E+030.8457936E+030.7872163E+030.7364678E+03 0.6917007E+030.6516494E+030.1000000E+040.9150621E+030.8457935E+030.7872161E+03 0.7364677E+030.6917005E+030.6516492E+030.1000000E+040.9150622E+030.8457934E+03 0.7872161E+030.7364676E+030.6917004E+030.6516490E+030.1000000E+040.9150621E+03 0.8457934E+030.7872161E+030.7364676E+030.6917004E+030.6516491E+030.1000000E+04 0.9150620E+030.8457934E+030.7872161E+030.7364677E+030.6917005E+030.6516493E+03 0.1000000E+040.9150621E+030.8457935E+030.7872161E+030.7364678E+030.6917007E+03 0.6516497E+030.1000000E+040.9150621E+030.8457935E+030.7872162E+030.7364679E+03 0.6917010E+030.6516501E+030.1000000E+040.9150622E+030.8457935E+030.7872163E+03 0.7364680E+030.6917012E+030.6516504E+030.1000000E+040.9150621E+030.8457935E+03 0.7872164E+030.7364682E+030.6917014E+030.6516508E+030.1000000E+040.9150622E+03 0.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+030.1000000E+04 0.9150623E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+03 0.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+03 0.6516510E+030.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364682E+03 0.6917014E+030.6516508E+030.1000000E+040.9150621E+030.8457935E+030.7872163E+03 0.7364681E+030.6917012E+030.6516505E+030.1000000E+040.9150620E+030.8457935E+03 0.7872161E+030.7364679E+030.6917010E+030.6516500E+030.1000000E+040.9150622E+03 0.8457935E+030.7872161E+030.7364678E+030.6917008E+030.6516497E+030.1000000E+04 0.9150622E+030.8457934E+030.7872161E+030.7364676E+030.6917005E+030.6516494E+03 0.1000000E+040.9150621E+030.8457934E+030.7872161E+030.7364676E+030.6917004E+03 0.6516491E+030.1000000E+040.9150621E+030.8457934E+030.7872160E+030.7364676E+03 0.6917004E+030.6516490E+030.1000000E+040.9150622E+030.8457934E+030.7872162E+03 0.7364677E+030.6917005E+030.6516491E+030.1000000E+040.9150621E+030.8457935E+03 0.7872162E+030.7364678E+030.6917007E+030.6516495E+030.1000000E+040.9150622E+03 0.8457936E+030.7872163E+030.7364680E+030.6917010E+030.6516499E+030.1000000E+04 0.9150623E+030.8457937E+030.7872164E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457938E+030.7872167E+030.7364685E+030.6917017E+03 0.6516510E+030.1000000E+040.9150624E+030.8457939E+030.7872168E+030.7364687E+03 0.6917021E+030.6516515E+030.1000000E+040.9150623E+030.8457939E+030.7872169E+03 0.7364689E+030.6917024E+030.6516520E+030.1000000E+040.9150624E+030.8457940E+03 0.7872170E+030.7364691E+030.6917026E+030.6516524E+030.1000000E+040.9150625E+03 0.8457939E+030.7872170E+030.7364691E+030.6917027E+030.6516524E+030.9964557E+02 0.8108990E+020.6340348E+020.4650543E+020.3032881E+020.1482090E+020.0000000E+00 0.9964096E+020.8108691E+020.6340140E+020.4650412E+020.3032800E+020.1482048E+02 0.0000000E+000.9962879E+020.8107868E+020.6339575E+020.4650023E+020.3032549E+02 0.1481944E+020.0000000E+000.9961325E+020.8106713E+020.6338748E+020.4649473E+02 0.3032189E+020.1481753E+020.0000000E+000.9959518E+020.8105377E+020.6337770E+02 0.4648768E+020.3031769E+020.1481548E+020.0000000E+000.9957703E+020.8103982E+02 0.6336717E+020.4648027E+020.3031294E+020.1481309E+020.0000000E+000.9955944E+02 0.8102596E+020.6335672E+020.4647296E+020.3030827E+020.1481077E+020.0000000E+00 0.9954278E+020.8101295E+020.6334687E+020.4646583E+020.3030367E+020.1480865E+02 0.0000000E+000.9952776E+020.8100110E+020.6333776E+020.4645916E+020.3029954E+02 0.1480678E+020.0000000E+000.9951483E+020.8099079E+020.6332987E+020.4645359E+02 0.3029587E+020.1480490E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644891E+020.3029283E+020.1480343E+020.0000000E+000.9949564E+020.8097573E+02 0.6331846E+020.4644539E+020.3029054E+020.1480235E+020.0000000E+000.9949037E+02 0.8097165E+020.6331537E+020.4644320E+020.3028916E+020.1480166E+020.0000000E+00 0.9948817E+020.8097012E+020.6331433E+020.4644254E+020.3028874E+020.1480149E+02 0.0000000E+000.9948947E+020.8097146E+020.6331549E+020.4644342E+020.3028935E+02 0.1480174E+020.0000000E+000.9949497E+020.8097603E+020.6331905E+020.4644600E+02 0.3029100E+020.1480261E+020.0000000E+000.9950502E+020.8098394E+020.6332501E+02 0.4645025E+020.3029380E+020.1480386E+020.0000000E+000.9951971E+020.8099494E+02 0.6333315E+020.4645593E+020.3029740E+020.1480574E+020.0000000E+000.9953760E+02 0.8100801E+020.6334265E+020.4646261E+020.3030160E+020.1480756E+020.0000000E+00 0.9955574E+020.8102149E+020.6335252E+020.4646951E+020.3030584E+020.1480956E+02 0.0000000E+000.9957202E+020.8103405E+020.6336191E+020.4647608E+020.3031000E+02 0.1481161E+020.0000000E+000.9958601E+020.8104503E+020.6337020E+020.4648185E+02 0.3031376E+020.1481352E+020.0000000E+000.9959735E+020.8105374E+020.6337679E+02 0.4648683E+020.3031677E+020.1481503E+020.0000000E+000.9960480E+020.8106003E+02 0.6338165E+020.4649016E+020.3031906E+020.1481628E+020.0000000E+000.9960977E+02 0.8106385E+020.6338457E+020.4649233E+020.3032052E+020.1481692E+020.0000000E+00 0.9961136E+020.8106513E+020.6338559E+020.4649301E+020.3032100E+020.1481714E+02 0.0000000E+000.9960976E+020.8106385E+020.6338457E+020.4649235E+020.3032055E+02 0.1481690E+020.0000000E+000.9960480E+020.8106000E+020.6338165E+020.4649015E+02 0.3031904E+020.1481631E+020.0000000E+000.9959733E+020.8105370E+020.6337681E+02 0.4648685E+020.3031672E+020.1481501E+020.0000000E+000.9958599E+020.8104497E+02 0.6337017E+020.4648186E+020.3031380E+020.1481355E+020.0000000E+000.9957206E+02 0.8103412E+020.6336189E+020.4647603E+020.3031002E+020.1481163E+020.0000000E+00 0.9955579E+020.8102151E+020.6335251E+020.4646953E+020.3030591E+020.1480959E+02 0.0000000E+000.9953762E+020.8100802E+020.6334268E+020.4646261E+020.3030147E+02 0.1480751E+020.0000000E+000.9951966E+020.8099494E+020.6333314E+020.4645582E+02 0.3029736E+020.1480575E+020.0000000E+000.9950500E+020.8098391E+020.6332502E+02 0.4645025E+020.3029380E+020.1480390E+020.0000000E+000.9949497E+020.8097601E+02 0.6331905E+020.4644599E+020.3029104E+020.1480258E+020.0000000E+000.9948942E+02 0.8097146E+020.6331548E+020.4644342E+020.3028934E+020.1480177E+020.0000000E+00 0.9948818E+020.8097013E+020.6331430E+020.4644253E+020.3028873E+020.1480146E+02 0.0000000E+000.9949034E+020.8097166E+020.6331538E+020.4644324E+020.3028916E+02 0.1480168E+020.0000000E+000.9949570E+020.8097578E+020.6331845E+020.4644539E+02 0.3029056E+020.1480230E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644890E+020.3029279E+020.1480346E+020.0000000E+000.9951486E+020.8099078E+02 0.6332988E+020.4645356E+020.3029587E+020.1480486E+020.0000000E+000.9952776E+02 0.8100107E+020.6333778E+020.4645926E+020.3029955E+020.1480679E+020.0000000E+00 0.9954277E+020.8101291E+020.6334680E+020.4646581E+020.3030378E+020.1480865E+02 0.0000000E+000.9955940E+020.8102594E+020.6335672E+020.4647295E+020.3030821E+02 0.1481076E+020.0000000E+000.9957700E+020.8103974E+020.6336717E+020.4648032E+02 0.3031292E+020.1481308E+020.0000000E+000.9959525E+020.8105383E+020.6337772E+02 0.4648765E+020.3031765E+020.1481545E+020.0000000E+000.9961322E+020.8106717E+02 0.6338747E+020.4649472E+020.3032192E+020.1481756E+020.0000000E+000.9962877E+02 0.8107870E+020.6339575E+020.4650023E+020.3032552E+020.1481941E+020.0000000E+00 0.9964097E+020.8108689E+020.6340139E+020.4650410E+020.3032796E+020.1482051E+02 0.0000000E+000.9964557E+020.8108991E+020.6340345E+020.4650541E+020.3032882E+02 0.1482090E+020.0000000E+000.9554770E+030.9550919E+030.1000000E+040.9550920E+03 0.9154679E+030.8788551E+030.8792583E+030.8461998E+030.8788551E+030.8153799E+03 0.8157839E+030.7876227E+030.8153799E+030.7609979E+030.7614023E+030.7368747E+03 0.7609979E+030.7134280E+030.7138327E+030.6921083E+030.7134280E+030.6711521E+03 0.6715578E+030.6520642E+030.6711521E+030.9554770E+030.1000000E+040.9154678E+03 0.9550919E+030.8792583E+030.8461997E+030.8788550E+030.8157838E+030.7876227E+03 0.8153798E+030.7614022E+030.7368746E+030.7609978E+030.7138326E+030.6921082E+03 0.7134278E+030.6715577E+030.6520640E+030.6711518E+030.9554771E+030.1000000E+04 0.9154678E+030.9550919E+030.8792582E+030.8461997E+030.8788551E+030.8157838E+03 0.7876226E+030.8153798E+030.7614021E+030.7368744E+030.7609976E+030.7138324E+03 0.6921080E+030.7134276E+030.6715574E+030.6520637E+030.6711514E+030.9554771E+03 0.1000000E+040.9154677E+030.9550918E+030.8792582E+030.8461996E+030.8788549E+03 0.8157837E+030.7876224E+030.8153796E+030.7614019E+030.7368742E+030.7609975E+03 0.7138321E+030.6921076E+030.7134273E+030.6715569E+030.6520631E+030.6711510E+03 0.9554769E+030.1000000E+040.9154676E+030.9550919E+030.8792582E+030.8461995E+03 0.8788550E+030.8157836E+030.7876222E+030.8153795E+030.7614018E+030.7368739E+03 0.7609972E+030.7138318E+030.6921071E+030.7134270E+030.6715564E+030.6520624E+03 0.6711505E+030.9554770E+030.1000000E+040.9154677E+030.9550919E+030.8792582E+03 0.8461995E+030.8788550E+030.8157835E+030.7876221E+030.8153794E+030.7614015E+03 0.7368737E+030.7609970E+030.7138315E+030.6921068E+030.7134266E+030.6715560E+03 0.6520620E+030.6711500E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792582E+030.8461994E+030.8788550E+030.8157833E+030.7876220E+030.8153792E+03 0.7614014E+030.7368735E+030.7609969E+030.7138312E+030.6921065E+030.7134264E+03 0.6715556E+030.6520615E+030.6711496E+030.9554769E+030.1000000E+040.9154676E+03 0.9550917E+030.8792581E+030.8461993E+030.8788548E+030.8157832E+030.7876219E+03 0.8153792E+030.7614012E+030.7368733E+030.7609968E+030.7138310E+030.6921062E+03 0.7134262E+030.6715553E+030.6520611E+030.6711494E+030.9554768E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157832E+03 0.7876217E+030.8153792E+030.7614012E+030.7368732E+030.7609967E+030.7138309E+03 0.6921061E+030.7134262E+030.6715551E+030.6520608E+030.6711492E+030.9554769E+03 0.1000000E+040.9154676E+030.9550917E+030.8792579E+030.8461992E+030.8788548E+03 0.8157832E+030.7876217E+030.8153792E+030.7614011E+030.7368732E+030.7609967E+03 0.7138308E+030.6921060E+030.7134262E+030.6715550E+030.6520608E+030.6711493E+03 0.9554768E+030.1000000E+040.9154675E+030.9550916E+030.8792580E+030.8461992E+03 0.8788547E+030.8157832E+030.7876217E+030.8153791E+030.7614011E+030.7368732E+03 0.7609968E+030.7138309E+030.6921061E+030.7134262E+030.6715551E+030.6520609E+03 0.6711495E+030.9554766E+030.1000000E+040.9154675E+030.9550915E+030.8792580E+03 0.8461993E+030.8788548E+030.8157831E+030.7876218E+030.8153792E+030.7614013E+03 0.7368733E+030.7609968E+030.7138310E+030.6921062E+030.7134264E+030.6715553E+03 0.6520613E+030.6711498E+030.9554768E+030.1000000E+040.9154676E+030.9550916E+03 0.8792580E+030.8461993E+030.8788547E+030.8157832E+030.7876218E+030.8153792E+03 0.7614013E+030.7368734E+030.7609969E+030.7138312E+030.6921064E+030.7134266E+03 0.6715557E+030.6520616E+030.6711501E+030.9554768E+030.1000000E+040.9154676E+03 0.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+030.7876219E+03 0.8153794E+030.7614014E+030.7368735E+030.7609970E+030.7138314E+030.6921067E+03 0.7134268E+030.6715560E+030.6520621E+030.6711504E+030.9554769E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876220E+030.8153793E+030.7614014E+030.7368737E+030.7609971E+030.7138316E+03 0.6921070E+030.7134269E+030.6715562E+030.6520624E+030.6711507E+030.9554768E+03 0.1000000E+040.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788548E+03 0.8157834E+030.7876221E+030.8153794E+030.7614015E+030.7368738E+030.7609971E+03 0.7138317E+030.6921071E+030.7134271E+030.6715565E+030.6520627E+030.6711509E+03 0.9554769E+030.1000000E+040.9154677E+030.9550918E+030.8792581E+030.8461994E+03 0.8788548E+030.8157833E+030.7876221E+030.8153794E+030.7614016E+030.7368739E+03 0.7609972E+030.7138317E+030.6921072E+030.7134271E+030.6715567E+030.6520629E+03 0.6711509E+030.9554770E+030.1000000E+040.9154677E+030.9550918E+030.8792580E+03 0.8461994E+030.8788548E+030.8157834E+030.7876221E+030.8153794E+030.7614015E+03 0.7368739E+030.7609972E+030.7138318E+030.6921072E+030.7134271E+030.6715566E+03 0.6520629E+030.6711509E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792580E+030.8461995E+030.8788548E+030.8157834E+030.7876220E+030.8153794E+03 0.7614015E+030.7368739E+030.7609971E+030.7138317E+030.6921071E+030.7134270E+03 0.6715565E+030.6520627E+030.6711507E+030.9554769E+030.1000000E+040.9154676E+03 0.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157833E+030.7876220E+03 0.8153794E+030.7614014E+030.7368737E+030.7609970E+030.7138315E+030.6921069E+03 0.7134268E+030.6715563E+030.6520624E+030.6711504E+030.9554770E+030.1000000E+04 0.9154675E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876218E+030.8153792E+030.7614013E+030.7368736E+030.7609968E+030.7138313E+03 0.6921067E+030.7134266E+030.6715560E+030.6520621E+030.6711501E+030.9554768E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876218E+030.8153792E+030.7614012E+030.7368734E+030.7609967E+03 0.7138312E+030.6921065E+030.7134264E+030.6715556E+030.6520616E+030.6711498E+03 0.9554769E+030.1000000E+040.9154675E+030.9550919E+030.8792581E+030.8461992E+03 0.8788548E+030.8157831E+030.7876218E+030.8153791E+030.7614011E+030.7368733E+03 0.7609966E+030.7138311E+030.6921062E+030.7134262E+030.6715553E+030.6520613E+03 0.6711495E+030.9554768E+030.1000000E+040.9154675E+030.9550917E+030.8792580E+03 0.8461993E+030.8788547E+030.8157831E+030.7876218E+030.8153791E+030.7614010E+03 0.7368732E+030.7609966E+030.7138309E+030.6921061E+030.7134262E+030.6715552E+03 0.6520610E+030.6711493E+030.9554769E+030.1000000E+040.9154675E+030.9550917E+03 0.8792580E+030.8461992E+030.8788547E+030.8157832E+030.7876217E+030.8153791E+03 0.7614010E+030.7368732E+030.7609966E+030.7138309E+030.6921060E+030.7134262E+03 0.6715550E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+040.9154675E+03 0.9550917E+030.8792580E+030.8461992E+030.8788547E+030.8157831E+030.7876217E+03 0.8153792E+030.7614010E+030.7368732E+030.7609967E+030.7138309E+030.6921061E+03 0.7134263E+030.6715551E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+04 0.9154676E+030.9550916E+030.8792579E+030.8461993E+030.8788548E+030.8157833E+03 0.7876219E+030.8153793E+030.7614011E+030.7368733E+030.7609968E+030.7138310E+03 0.6921062E+030.7134264E+030.6715552E+030.6520611E+030.6711497E+030.9554766E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876219E+030.8153794E+030.7614013E+030.7368734E+030.7609970E+03 0.7138312E+030.6921064E+030.7134266E+030.6715555E+030.6520614E+030.6711500E+03 0.9554767E+030.1000000E+040.9154676E+030.9550918E+030.8792582E+030.8461995E+03 0.8788550E+030.8157834E+030.7876220E+030.8153795E+030.7614016E+030.7368737E+03 0.7609972E+030.7138315E+030.6921068E+030.7134269E+030.6715559E+030.6520620E+03 0.6711504E+030.9554769E+030.1000000E+040.9154678E+030.9550917E+030.8792582E+03 0.8461995E+030.8788549E+030.8157836E+030.7876222E+030.8153796E+030.7614017E+03 0.7368739E+030.7609974E+030.7138318E+030.6921071E+030.7134273E+030.6715564E+03 0.6520624E+030.6711510E+030.9554769E+030.1000000E+040.9154678E+030.9550918E+03 0.8792583E+030.8461996E+030.8788551E+030.8157837E+030.7876224E+030.8153798E+03 0.7614018E+030.7368742E+030.7609975E+030.7138321E+030.6921076E+030.7134275E+03 0.6715569E+030.6520631E+030.6711514E+030.9554770E+030.1000000E+040.9154678E+03 0.9550918E+030.8792582E+030.8461997E+030.8788550E+030.8157837E+030.7876225E+03 0.8153798E+030.7614020E+030.7368744E+030.7609977E+030.7138324E+030.6921079E+03 0.7134278E+030.6715573E+030.6520636E+030.6711518E+030.9554769E+030.1000000E+04 0.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788550E+030.8157838E+03 0.7876226E+030.8153799E+030.7614021E+030.7368746E+030.7609978E+030.7138325E+03 0.6921081E+030.7134280E+030.6715576E+030.6520640E+030.6711521E+030.9554770E+03 0.1000000E+040.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788551E+03 0.8157838E+030.7876227E+030.8153799E+030.7614023E+030.7368747E+030.7609978E+03 0.7138327E+030.6921083E+030.7134280E+030.6715578E+030.6711521E+030.6520642E+03 0.9043840E+020.9024959E+020.9982624E+020.9025324E+020.8127637E+020.7214348E+02 0.7233030E+020.6359044E+020.7214098E+020.5486040E+020.5504742E+020.4669251E+02 0.5485869E+020.3833073E+020.3851758E+020.3051462E+020.3832972E+020.2249338E+02 0.2267557E+020.1499064E+020.2249275E+020.7314284E+010.7444518E+010.0000000E+00 0.7314062E+010.9043150E+020.9981746E+020.8127056E+020.9023955E+020.7232558E+02 0.6358650E+020.7213423E+020.5504421E+020.4668985E+020.5485397E+020.3851545E+02 0.3051288E+020.3832653E+020.2267428E+020.1498990E+020.2249106E+020.7444111E+01 0.0000000E+000.7313532E+010.9041948E+020.9980314E+020.8126039E+020.9022622E+02 0.7231699E+020.6357929E+020.7212435E+020.5503823E+020.4668502E+020.5484717E+02 0.3851151E+020.3050977E+020.3832206E+020.2267208E+020.1498835E+020.2248829E+02 0.7443328E+010.0000000E+000.7312600E+010.9040473E+020.9978616E+020.8124775E+02 0.9021061E+020.7230630E+020.6357015E+020.7211289E+020.5503062E+020.4667863E+02 0.5483882E+020.3850625E+020.3050576E+020.3831645E+020.2266914E+020.1498634E+02 0.2248521E+020.7442361E+010.0000000E+000.7311622E+010.9038883E+020.9976782E+02 0.8123390E+020.9019466E+020.7229438E+020.6355990E+020.7210071E+020.5502191E+02 0.4667128E+020.5482989E+020.3850048E+020.3050120E+020.3831044E+020.2266572E+02 0.1498406E+020.2248167E+020.7441242E+010.0000000E+000.7310432E+010.9037291E+02 0.9974982E+020.8121989E+020.9017899E+020.7228203E+020.6354932E+020.7208864E+02 0.5501292E+020.4666388E+020.5482104E+020.3849440E+020.3049642E+020.3830448E+02 0.2266212E+020.1498168E+020.2247817E+020.7440089E+010.0000000E+000.7309263E+01 0.9035755E+020.9973264E+020.8120635E+020.9016422E+020.7227021E+020.6353899E+02 0.7207724E+020.5500421E+020.4665663E+020.5481263E+020.3848852E+020.3049177E+02 0.3829860E+020.2265862E+020.1497939E+020.2247482E+020.7438896E+010.0000000E+00 0.7308275E+010.9034339E+020.9971666E+020.8119382E+020.9015084E+020.7225921E+02 0.6352947E+020.7206681E+020.5499589E+020.4664958E+020.5480474E+020.3848275E+02 0.3048745E+020.3829326E+020.2265550E+020.1497740E+020.2247185E+020.7437974E+01 0.0000000E+000.7307321E+010.9033083E+020.9970262E+020.8118270E+020.9013924E+02 0.7224938E+020.6352095E+020.7205773E+020.5498855E+020.4664344E+020.5479804E+02 0.3847776E+020.3048334E+020.3828865E+020.2265269E+020.1497544E+020.2246911E+02 0.7437009E+010.0000000E+000.7306399E+010.9032012E+020.9969071E+020.8117320E+02 0.9012961E+020.7224099E+020.6351366E+020.7205022E+020.5498236E+020.4663826E+02 0.5479246E+020.3847348E+020.3048001E+020.3828479E+020.2265009E+020.1497381E+02 0.2246688E+020.7436173E+010.0000000E+000.7305630E+010.9031151E+020.9968105E+02 0.8116565E+020.9012221E+020.7223432E+020.6350791E+020.7204454E+020.5497743E+02 0.4663413E+020.5478829E+020.3847005E+020.3047730E+020.3828192E+020.2264806E+02 0.1497248E+020.2246518E+020.7435502E+010.0000000E+000.7305147E+010.9030539E+02 0.9967415E+020.8116027E+020.9011754E+020.7222966E+020.6350389E+020.7204100E+02 0.5497396E+020.4663125E+020.5478565E+020.3846770E+020.3047547E+020.3828014E+02 0.2264669E+020.1497158E+020.2246415E+020.7435065E+010.0000000E+000.7304798E+01 0.9030207E+020.9967039E+020.8115745E+020.9011571E+020.7222719E+020.6350179E+02 0.7203972E+020.5497219E+020.4662980E+020.5478482E+020.3846652E+020.3047456E+02 0.3827960E+020.2264600E+020.1497116E+020.2246385E+020.7434862E+010.0000000E+00 0.7304705E+010.9030173E+020.9966986E+020.8115729E+020.9011706E+020.7222713E+02 0.6350182E+020.7204100E+020.5497224E+020.4662987E+020.5478585E+020.3846656E+02 0.3047463E+020.3828035E+020.2264606E+020.1497118E+020.2246428E+020.7434840E+01 0.0000000E+000.7304820E+010.9030484E+020.9967321E+020.8116022E+020.9012212E+02 0.7222973E+020.6350417E+020.7204504E+020.5497427E+020.4663163E+020.5478892E+02 0.3846801E+020.3047578E+020.3828246E+020.2264688E+020.1497178E+020.2246552E+02 0.7435168E+010.0000000E+000.7305189E+010.9031181E+020.9968096E+020.8116648E+02 0.9013108E+020.7223521E+020.6350898E+020.7205196E+020.5497834E+020.4663507E+02 0.5479400E+020.3847083E+020.3047809E+020.3828595E+020.2264865E+020.1497294E+02 0.2246749E+020.7435671E+010.0000000E+000.7305908E+010.9032270E+020.9969340E+02 0.8117604E+020.9014382E+020.7224345E+020.6351610E+020.7206144E+020.5498441E+02 0.4664011E+020.5480083E+020.3847498E+020.3048130E+020.3829062E+020.2265088E+02 0.1497443E+020.2247025E+020.7436538E+010.0000000E+000.7306792E+010.9033696E+02 0.9971007E+020.8118830E+020.9015907E+020.7225396E+020.6352508E+020.7207262E+02 0.5499190E+020.4664630E+020.5480891E+020.3847997E+020.3048524E+020.3829599E+02 0.2265392E+020.1497635E+020.2247327E+020.7437384E+010.0000000E+000.7307721E+01 0.9035275E+020.9972848E+020.8120183E+020.9017473E+020.7226550E+020.6353485E+02 0.7208421E+020.5500021E+020.4665326E+020.5481721E+020.3848554E+020.3048945E+02 0.3830152E+020.2265685E+020.1497819E+020.2247635E+020.7438330E+010.0000000E+00 0.7308690E+010.9036791E+020.9974583E+020.8121497E+020.9018909E+020.7227690E+02 0.6354466E+020.7209510E+020.5500843E+020.4666012E+020.5482510E+020.3849113E+02 0.3049383E+020.3830681E+020.2266011E+020.1498036E+020.2247941E+020.7439418E+01 0.0000000E+000.7309702E+010.9038145E+020.9976110E+020.8122695E+020.9020151E+02 0.7228738E+020.6355371E+020.7210470E+020.5501613E+020.4666640E+020.5483208E+02 0.3849621E+020.3049787E+020.3831158E+020.2266309E+020.1498238E+020.2248226E+02 0.7440445E+010.0000000E+000.7310594E+010.9039277E+020.9977381E+020.8123673E+02 0.9021151E+020.7229593E+020.6356111E+020.7211232E+020.5502239E+020.4667179E+02 0.5483784E+020.3850063E+020.3050119E+020.3831557E+020.2266558E+020.1498408E+02 0.2248447E+020.7441213E+010.0000000E+000.7311398E+010.9040124E+020.9978328E+02 0.8124439E+020.9021834E+020.7230272E+020.6356688E+020.7211790E+020.5502750E+02 0.4667602E+020.5484198E+020.3850405E+020.3050399E+020.3831829E+020.2266771E+02 0.1498551E+020.2248630E+020.7442012E+010.0000000E+000.7311986E+010.9040685E+02 0.9978938E+020.8124936E+020.9022281E+020.7230710E+020.6357078E+020.7212121E+02 0.5503077E+020.4667874E+020.5484450E+020.3850632E+020.3050580E+020.3832016E+02 0.2266911E+020.1498646E+020.2248730E+020.7442461E+010.0000000E+000.7312280E+01 0.9040985E+020.9979277E+020.8125194E+020.9022415E+020.7230943E+020.6357279E+02 0.7212240E+020.5503253E+020.4668021E+020.5484534E+020.3850759E+020.3050680E+02 0.3832071E+020.2266984E+020.1498691E+020.2248766E+020.7442645E+010.0000000E+00 0.7312407E+010.9040995E+020.9979281E+020.8125198E+020.9022276E+020.7230947E+02 0.6357277E+020.7212122E+020.5503254E+020.4668020E+020.5484451E+020.3850761E+02 0.3050684E+020.3832019E+020.2266985E+020.1498689E+020.2248728E+020.7442658E+01 0.0000000E+000.7312304E+010.9040706E+020.9978948E+020.8124940E+020.9021831E+02 0.7230725E+020.6357082E+020.7211790E+020.5503090E+020.4667877E+020.5484195E+02 0.3850642E+020.3050581E+020.3831832E+020.2266906E+020.1498648E+020.2248629E+02 0.7442413E+010.0000000E+000.7311994E+010.9040140E+020.9978321E+020.8124433E+02 0.9021149E+020.7230270E+020.6356686E+020.7211228E+020.5502748E+020.4667599E+02 0.5483790E+020.3850408E+020.3050391E+020.3831555E+020.2266771E+020.1498548E+02 0.2248445E+020.7441923E+010.0000000E+000.7311363E+010.9039289E+020.9977384E+02 0.8123675E+020.9020148E+020.7229619E+020.6356110E+020.7210465E+020.5502263E+02 0.4667177E+020.5483213E+020.3850054E+020.3050122E+020.3831159E+020.2266574E+02 0.1498410E+020.2248229E+020.7441259E+010.0000000E+000.7310669E+010.9038174E+02 0.9976107E+020.8122688E+020.9018914E+020.7228760E+020.6355362E+020.7209512E+02 0.5501623E+020.4666632E+020.5482507E+020.3849629E+020.3049783E+020.3830684E+02 0.2266317E+020.1498237E+020.2247947E+020.7440390E+010.0000000E+000.7309703E+01 0.9036832E+020.9974588E+020.8121505E+020.9017476E+020.7227719E+020.6354471E+02 0.7208420E+020.5500868E+020.4666012E+020.5481718E+020.3849118E+020.3049382E+02 0.3830155E+020.2266015E+020.1498037E+020.2247640E+020.7439432E+010.0000000E+00 0.7308692E+010.9035312E+020.9972852E+020.8120184E+020.9015909E+020.7226579E+02 0.6353490E+020.7207263E+020.5500047E+020.4665333E+020.5480892E+020.3848573E+02 0.3048951E+020.3829588E+020.2265692E+020.1497829E+020.2247317E+020.7438422E+01 0.0000000E+000.7307656E+010.9033731E+020.9971003E+020.8118830E+020.9014377E+02 0.7225424E+020.6352505E+020.7206146E+020.5499207E+020.4664629E+020.5480080E+02 0.3847999E+020.3048524E+020.3829051E+020.2265383E+020.1497629E+020.2247025E+02 0.7437512E+010.0000000E+000.7306815E+010.9032300E+020.9969340E+020.8117602E+02 0.9013105E+020.7224370E+020.6351611E+020.7205195E+020.5498448E+020.4664004E+02 0.5479399E+020.3847500E+020.3048119E+020.3828598E+020.2265111E+020.1497442E+02 0.2246758E+020.7436494E+010.0000000E+000.7305909E+010.9031200E+020.9968093E+02 0.8116643E+020.9012211E+020.7223534E+020.6350895E+020.7204504E+020.5497846E+02 0.4663506E+020.5478892E+020.3847091E+020.3047803E+020.3828246E+020.2264862E+02 0.1497286E+020.2246557E+020.7435705E+010.0000000E+000.7305212E+010.9030497E+02 0.9967320E+020.8116020E+020.9011704E+020.7222981E+020.6350416E+020.7204099E+02 0.5497432E+020.4663162E+020.5478584E+020.3846805E+020.3047578E+020.3828034E+02 0.2264692E+020.1497174E+020.2246429E+020.7435135E+010.0000000E+000.7304860E+01 0.9030177E+020.9966981E+020.8115730E+020.9011573E+020.7222713E+020.6350180E+02 0.7203971E+020.5497225E+020.4662989E+020.5478480E+020.3846661E+020.3047464E+02 0.3827959E+020.2264607E+020.1497118E+020.2246383E+020.7434871E+010.0000000E+00 0.7304694E+010.9030203E+020.9967040E+020.8115746E+020.9011753E+020.7222716E+02 0.6350177E+020.7204100E+020.5497218E+020.4662982E+020.5478568E+020.3846651E+02 0.3047456E+020.3828015E+020.2264599E+020.1497116E+020.2246415E+020.7434860E+01 0.0000000E+000.7304799E+010.9030532E+020.9967417E+020.8116031E+020.9012226E+02 0.7222960E+020.6350389E+020.7204457E+020.5497392E+020.4663127E+020.5478826E+02 0.3846765E+020.3047548E+020.3828191E+020.2264666E+020.1497157E+020.2246515E+02 0.7435031E+010.0000000E+000.7305096E+010.9031137E+020.9968107E+020.8116565E+02 0.9012961E+020.7223424E+020.6350791E+020.7205023E+020.5497733E+020.4663414E+02 0.5479245E+020.3846999E+020.3047733E+020.3828477E+020.2264799E+020.1497252E+02 0.2246683E+020.7435529E+010.0000000E+000.7305608E+010.9031990E+020.9969072E+02 0.8117320E+020.9013926E+020.7224083E+020.6351367E+020.7205773E+020.5498224E+02 0.4663827E+020.5479804E+020.3847336E+020.3048008E+020.3828862E+020.2265008E+02 0.1497389E+020.2246901E+020.7436141E+010.0000000E+000.7306398E+010.9033051E+02 0.9970262E+020.8118267E+020.9015082E+020.7224915E+020.6352095E+020.7206680E+02 0.5498847E+020.4664351E+020.5480479E+020.3847774E+020.3048343E+020.3829335E+02 0.2265246E+020.1497547E+020.2247184E+020.7437053E+010.0000000E+000.7307308E+01 0.9034303E+020.9971668E+020.8119380E+020.9016419E+020.7225892E+020.6352946E+02 0.7207718E+020.5499570E+020.4664956E+020.5481260E+020.3848269E+020.3048741E+02 0.3829869E+020.2265554E+020.1497742E+020.2247490E+020.7437918E+010.0000000E+00 0.7308257E+010.9035721E+020.9973260E+020.8120633E+020.9017896E+020.7226986E+02 0.6353894E+020.7208863E+020.5500391E+020.4665652E+020.5482107E+020.3848833E+02 0.3049170E+020.3830445E+020.2265855E+020.1497933E+020.2247815E+020.7438897E+01 0.0000000E+000.7309283E+010.9037246E+020.9974977E+020.8121980E+020.9019461E+02 0.7228169E+020.6354925E+020.7210068E+020.5501265E+020.4666388E+020.5482990E+02 0.3849431E+020.3049643E+020.3831043E+020.2266209E+020.1498167E+020.2248162E+02 0.7440071E+010.0000000E+000.7310424E+010.9038848E+020.9976786E+020.8123397E+02 0.9021068E+020.7229408E+020.6355996E+020.7211293E+020.5502176E+020.4667134E+02 0.5483877E+020.3850036E+020.3050123E+020.3831644E+020.2266564E+020.1498409E+02 0.2248517E+020.7441297E+010.0000000E+000.7311546E+010.9040444E+020.9978611E+02 0.8124772E+020.9022623E+020.7230597E+020.6357015E+020.7212438E+020.5503034E+02 0.4667862E+020.5484714E+020.3850628E+020.3050572E+020.3832207E+020.2266897E+02 0.1498633E+020.2248830E+020.7442335E+010.0000000E+000.7312646E+010.9041916E+02 0.9980319E+020.8126046E+020.9023958E+020.7231691E+020.6357933E+020.7213420E+02 0.5503822E+020.4668507E+020.5485401E+020.3851144E+020.3050985E+020.3832651E+02 0.2267204E+020.1498838E+020.2249106E+020.7443427E+010.0000000E+000.7313518E+01 0.9043115E+020.9981733E+020.8127051E+020.9024962E+020.7232533E+020.6358644E+02 0.7214097E+020.5504404E+020.4668982E+020.5485867E+020.3851531E+020.3051287E+02 0.3832969E+020.2267431E+020.1498989E+020.2249277E+020.7444162E+010.0000000E+00 0.7314072E+010.9043840E+020.9982624E+020.8127634E+020.9025324E+020.7233024E+02 0.6359045E+020.7214351E+020.5504736E+020.4669250E+020.5486030E+020.3851754E+02 0.3051457E+020.3833075E+020.2267554E+020.1499062E+020.2249341E+020.7444513E+01 0.7314283E+010.0000000E+00 ************************************************************************ THERMIQUE SOLIDE SYRTHES ************************************************************************ C1C* NDIM NDIELE NELEM NPOIN NBSCAL C2C* 2 2 1008 2210 1 C3C* NPDT TEMPS DT C4C* 100 0.1800000000000E+06 0.1800000000000E+04 C5C* VERSION DATE C6C* 3.4.1 TODAY ************************************************************************ TEMP_SOLIDE 3----------- 0.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+030.6917027E+03 0.6516524E+030.1000000E+040.9150625E+030.8457940E+030.7872170E+030.7364691E+03 0.6917026E+030.6516524E+030.1000000E+040.9150624E+030.8457939E+030.7872170E+03 0.7364689E+030.6917024E+030.6516521E+030.1000000E+040.9150624E+030.8457939E+03 0.7872169E+030.7364687E+030.6917022E+030.6516516E+030.1000000E+040.9150621E+03 0.8457938E+030.7872166E+030.7364685E+030.6917017E+030.6516510E+030.1000000E+04 0.9150623E+030.8457937E+030.7872165E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457936E+030.7872164E+030.7364680E+030.6917010E+03 0.6516500E+030.1000000E+040.9150622E+030.8457936E+030.7872163E+030.7364678E+03 0.6917007E+030.6516494E+030.1000000E+040.9150621E+030.8457935E+030.7872161E+03 0.7364677E+030.6917005E+030.6516492E+030.1000000E+040.9150622E+030.8457934E+03 0.7872161E+030.7364676E+030.6917004E+030.6516490E+030.1000000E+040.9150621E+03 0.8457934E+030.7872161E+030.7364676E+030.6917004E+030.6516491E+030.1000000E+04 0.9150620E+030.8457934E+030.7872161E+030.7364677E+030.6917005E+030.6516493E+03 0.1000000E+040.9150621E+030.8457935E+030.7872161E+030.7364678E+030.6917007E+03 0.6516497E+030.1000000E+040.9150621E+030.8457935E+030.7872162E+030.7364679E+03 0.6917010E+030.6516501E+030.1000000E+040.9150622E+030.8457935E+030.7872163E+03 0.7364680E+030.6917012E+030.6516504E+030.1000000E+040.9150621E+030.8457935E+03 0.7872164E+030.7364682E+030.6917014E+030.6516508E+030.1000000E+040.9150622E+03 0.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+030.1000000E+04 0.9150623E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+030.6516511E+03 0.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364683E+030.6917016E+03 0.6516510E+030.1000000E+040.9150622E+030.8457936E+030.7872164E+030.7364682E+03 0.6917014E+030.6516508E+030.1000000E+040.9150621E+030.8457935E+030.7872163E+03 0.7364681E+030.6917012E+030.6516505E+030.1000000E+040.9150620E+030.8457935E+03 0.7872161E+030.7364679E+030.6917010E+030.6516500E+030.1000000E+040.9150622E+03 0.8457935E+030.7872161E+030.7364678E+030.6917008E+030.6516497E+030.1000000E+04 0.9150622E+030.8457934E+030.7872161E+030.7364676E+030.6917005E+030.6516494E+03 0.1000000E+040.9150621E+030.8457934E+030.7872161E+030.7364676E+030.6917004E+03 0.6516491E+030.1000000E+040.9150621E+030.8457934E+030.7872160E+030.7364676E+03 0.6917004E+030.6516490E+030.1000000E+040.9150622E+030.8457934E+030.7872162E+03 0.7364677E+030.6917005E+030.6516491E+030.1000000E+040.9150621E+030.8457935E+03 0.7872162E+030.7364678E+030.6917007E+030.6516495E+030.1000000E+040.9150622E+03 0.8457936E+030.7872163E+030.7364680E+030.6917010E+030.6516499E+030.1000000E+04 0.9150623E+030.8457937E+030.7872164E+030.7364683E+030.6917013E+030.6516504E+03 0.1000000E+040.9150623E+030.8457938E+030.7872167E+030.7364685E+030.6917017E+03 0.6516510E+030.1000000E+040.9150624E+030.8457939E+030.7872168E+030.7364687E+03 0.6917021E+030.6516515E+030.1000000E+040.9150623E+030.8457939E+030.7872169E+03 0.7364689E+030.6917024E+030.6516520E+030.1000000E+040.9150624E+030.8457940E+03 0.7872170E+030.7364691E+030.6917026E+030.6516524E+030.1000000E+040.9150625E+03 0.8457939E+030.7872170E+030.7364691E+030.6917027E+030.6516524E+030.9964557E+02 0.8108990E+020.6340348E+020.4650543E+020.3032881E+020.1482090E+020.0000000E+00 0.9964096E+020.8108691E+020.6340140E+020.4650412E+020.3032800E+020.1482048E+02 0.0000000E+000.9962879E+020.8107868E+020.6339575E+020.4650023E+020.3032549E+02 0.1481944E+020.0000000E+000.9961325E+020.8106713E+020.6338748E+020.4649473E+02 0.3032189E+020.1481753E+020.0000000E+000.9959518E+020.8105377E+020.6337770E+02 0.4648768E+020.3031769E+020.1481548E+020.0000000E+000.9957703E+020.8103982E+02 0.6336717E+020.4648027E+020.3031294E+020.1481309E+020.0000000E+000.9955944E+02 0.8102596E+020.6335672E+020.4647296E+020.3030827E+020.1481077E+020.0000000E+00 0.9954278E+020.8101295E+020.6334687E+020.4646583E+020.3030367E+020.1480865E+02 0.0000000E+000.9952776E+020.8100110E+020.6333776E+020.4645916E+020.3029954E+02 0.1480678E+020.0000000E+000.9951483E+020.8099079E+020.6332987E+020.4645359E+02 0.3029587E+020.1480490E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644891E+020.3029283E+020.1480343E+020.0000000E+000.9949564E+020.8097573E+02 0.6331846E+020.4644539E+020.3029054E+020.1480235E+020.0000000E+000.9949037E+02 0.8097165E+020.6331537E+020.4644320E+020.3028916E+020.1480166E+020.0000000E+00 0.9948817E+020.8097012E+020.6331433E+020.4644254E+020.3028874E+020.1480149E+02 0.0000000E+000.9948947E+020.8097146E+020.6331549E+020.4644342E+020.3028935E+02 0.1480174E+020.0000000E+000.9949497E+020.8097603E+020.6331905E+020.4644600E+02 0.3029100E+020.1480261E+020.0000000E+000.9950502E+020.8098394E+020.6332501E+02 0.4645025E+020.3029380E+020.1480386E+020.0000000E+000.9951971E+020.8099494E+02 0.6333315E+020.4645593E+020.3029740E+020.1480574E+020.0000000E+000.9953760E+02 0.8100801E+020.6334265E+020.4646261E+020.3030160E+020.1480756E+020.0000000E+00 0.9955574E+020.8102149E+020.6335252E+020.4646951E+020.3030584E+020.1480956E+02 0.0000000E+000.9957202E+020.8103405E+020.6336191E+020.4647608E+020.3031000E+02 0.1481161E+020.0000000E+000.9958601E+020.8104503E+020.6337020E+020.4648185E+02 0.3031376E+020.1481352E+020.0000000E+000.9959735E+020.8105374E+020.6337679E+02 0.4648683E+020.3031677E+020.1481503E+020.0000000E+000.9960480E+020.8106003E+02 0.6338165E+020.4649016E+020.3031906E+020.1481628E+020.0000000E+000.9960977E+02 0.8106385E+020.6338457E+020.4649233E+020.3032052E+020.1481692E+020.0000000E+00 0.9961136E+020.8106513E+020.6338559E+020.4649301E+020.3032100E+020.1481714E+02 0.0000000E+000.9960976E+020.8106385E+020.6338457E+020.4649235E+020.3032055E+02 0.1481690E+020.0000000E+000.9960480E+020.8106000E+020.6338165E+020.4649015E+02 0.3031904E+020.1481631E+020.0000000E+000.9959733E+020.8105370E+020.6337681E+02 0.4648685E+020.3031672E+020.1481501E+020.0000000E+000.9958599E+020.8104497E+02 0.6337017E+020.4648186E+020.3031380E+020.1481355E+020.0000000E+000.9957206E+02 0.8103412E+020.6336189E+020.4647603E+020.3031002E+020.1481163E+020.0000000E+00 0.9955579E+020.8102151E+020.6335251E+020.4646953E+020.3030591E+020.1480959E+02 0.0000000E+000.9953762E+020.8100802E+020.6334268E+020.4646261E+020.3030147E+02 0.1480751E+020.0000000E+000.9951966E+020.8099494E+020.6333314E+020.4645582E+02 0.3029736E+020.1480575E+020.0000000E+000.9950500E+020.8098391E+020.6332502E+02 0.4645025E+020.3029380E+020.1480390E+020.0000000E+000.9949497E+020.8097601E+02 0.6331905E+020.4644599E+020.3029104E+020.1480258E+020.0000000E+000.9948942E+02 0.8097146E+020.6331548E+020.4644342E+020.3028934E+020.1480177E+020.0000000E+00 0.9948818E+020.8097013E+020.6331430E+020.4644253E+020.3028873E+020.1480146E+02 0.0000000E+000.9949034E+020.8097166E+020.6331538E+020.4644324E+020.3028916E+02 0.1480168E+020.0000000E+000.9949570E+020.8097578E+020.6331845E+020.4644539E+02 0.3029056E+020.1480230E+020.0000000E+000.9950402E+020.8098225E+020.6332334E+02 0.4644890E+020.3029279E+020.1480346E+020.0000000E+000.9951486E+020.8099078E+02 0.6332988E+020.4645356E+020.3029587E+020.1480486E+020.0000000E+000.9952776E+02 0.8100107E+020.6333778E+020.4645926E+020.3029955E+020.1480679E+020.0000000E+00 0.9954277E+020.8101291E+020.6334680E+020.4646581E+020.3030378E+020.1480865E+02 0.0000000E+000.9955940E+020.8102594E+020.6335672E+020.4647295E+020.3030821E+02 0.1481076E+020.0000000E+000.9957700E+020.8103974E+020.6336717E+020.4648032E+02 0.3031292E+020.1481308E+020.0000000E+000.9959525E+020.8105383E+020.6337772E+02 0.4648765E+020.3031765E+020.1481545E+020.0000000E+000.9961322E+020.8106717E+02 0.6338747E+020.4649472E+020.3032192E+020.1481756E+020.0000000E+000.9962877E+02 0.8107870E+020.6339575E+020.4650023E+020.3032552E+020.1481941E+020.0000000E+00 0.9964097E+020.8108689E+020.6340139E+020.4650410E+020.3032796E+020.1482051E+02 0.0000000E+000.9964557E+020.8108991E+020.6340345E+020.4650541E+020.3032882E+02 0.1482090E+020.0000000E+000.9554770E+030.9550919E+030.1000000E+040.9550920E+03 0.9154679E+030.8788551E+030.8792583E+030.8461998E+030.8788551E+030.8153799E+03 0.8157839E+030.7876227E+030.8153799E+030.7609979E+030.7614023E+030.7368747E+03 0.7609979E+030.7134280E+030.7138327E+030.6921083E+030.7134280E+030.6711521E+03 0.6715578E+030.6520642E+030.6711521E+030.9554770E+030.1000000E+040.9154678E+03 0.9550919E+030.8792583E+030.8461997E+030.8788550E+030.8157838E+030.7876227E+03 0.8153798E+030.7614022E+030.7368746E+030.7609978E+030.7138326E+030.6921082E+03 0.7134278E+030.6715577E+030.6520640E+030.6711518E+030.9554771E+030.1000000E+04 0.9154678E+030.9550919E+030.8792582E+030.8461997E+030.8788551E+030.8157838E+03 0.7876226E+030.8153798E+030.7614021E+030.7368744E+030.7609976E+030.7138324E+03 0.6921080E+030.7134276E+030.6715574E+030.6520637E+030.6711514E+030.9554771E+03 0.1000000E+040.9154677E+030.9550918E+030.8792582E+030.8461996E+030.8788549E+03 0.8157837E+030.7876224E+030.8153796E+030.7614019E+030.7368742E+030.7609975E+03 0.7138321E+030.6921076E+030.7134273E+030.6715569E+030.6520631E+030.6711510E+03 0.9554769E+030.1000000E+040.9154676E+030.9550919E+030.8792582E+030.8461995E+03 0.8788550E+030.8157836E+030.7876222E+030.8153795E+030.7614018E+030.7368739E+03 0.7609972E+030.7138318E+030.6921071E+030.7134270E+030.6715564E+030.6520624E+03 0.6711505E+030.9554770E+030.1000000E+040.9154677E+030.9550919E+030.8792582E+03 0.8461995E+030.8788550E+030.8157835E+030.7876221E+030.8153794E+030.7614015E+03 0.7368737E+030.7609970E+030.7138315E+030.6921068E+030.7134266E+030.6715560E+03 0.6520620E+030.6711500E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792582E+030.8461994E+030.8788550E+030.8157833E+030.7876220E+030.8153792E+03 0.7614014E+030.7368735E+030.7609969E+030.7138312E+030.6921065E+030.7134264E+03 0.6715556E+030.6520615E+030.6711496E+030.9554769E+030.1000000E+040.9154676E+03 0.9550917E+030.8792581E+030.8461993E+030.8788548E+030.8157832E+030.7876219E+03 0.8153792E+030.7614012E+030.7368733E+030.7609968E+030.7138310E+030.6921062E+03 0.7134262E+030.6715553E+030.6520611E+030.6711494E+030.9554768E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157832E+03 0.7876217E+030.8153792E+030.7614012E+030.7368732E+030.7609967E+030.7138309E+03 0.6921061E+030.7134262E+030.6715551E+030.6520608E+030.6711492E+030.9554769E+03 0.1000000E+040.9154676E+030.9550917E+030.8792579E+030.8461992E+030.8788548E+03 0.8157832E+030.7876217E+030.8153792E+030.7614011E+030.7368732E+030.7609967E+03 0.7138308E+030.6921060E+030.7134262E+030.6715550E+030.6520608E+030.6711493E+03 0.9554768E+030.1000000E+040.9154675E+030.9550916E+030.8792580E+030.8461992E+03 0.8788547E+030.8157832E+030.7876217E+030.8153791E+030.7614011E+030.7368732E+03 0.7609968E+030.7138309E+030.6921061E+030.7134262E+030.6715551E+030.6520609E+03 0.6711495E+030.9554766E+030.1000000E+040.9154675E+030.9550915E+030.8792580E+03 0.8461993E+030.8788548E+030.8157831E+030.7876218E+030.8153792E+030.7614013E+03 0.7368733E+030.7609968E+030.7138310E+030.6921062E+030.7134264E+030.6715553E+03 0.6520613E+030.6711498E+030.9554768E+030.1000000E+040.9154676E+030.9550916E+03 0.8792580E+030.8461993E+030.8788547E+030.8157832E+030.7876218E+030.8153792E+03 0.7614013E+030.7368734E+030.7609969E+030.7138312E+030.6921064E+030.7134266E+03 0.6715557E+030.6520616E+030.6711501E+030.9554768E+030.1000000E+040.9154676E+03 0.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+030.7876219E+03 0.8153794E+030.7614014E+030.7368735E+030.7609970E+030.7138314E+030.6921067E+03 0.7134268E+030.6715560E+030.6520621E+030.6711504E+030.9554769E+030.1000000E+04 0.9154676E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876220E+030.8153793E+030.7614014E+030.7368737E+030.7609971E+030.7138316E+03 0.6921070E+030.7134269E+030.6715562E+030.6520624E+030.6711507E+030.9554768E+03 0.1000000E+040.9154676E+030.9550918E+030.8792580E+030.8461994E+030.8788548E+03 0.8157834E+030.7876221E+030.8153794E+030.7614015E+030.7368738E+030.7609971E+03 0.7138317E+030.6921071E+030.7134271E+030.6715565E+030.6520627E+030.6711509E+03 0.9554769E+030.1000000E+040.9154677E+030.9550918E+030.8792581E+030.8461994E+03 0.8788548E+030.8157833E+030.7876221E+030.8153794E+030.7614016E+030.7368739E+03 0.7609972E+030.7138317E+030.6921072E+030.7134271E+030.6715567E+030.6520629E+03 0.6711509E+030.9554770E+030.1000000E+040.9154677E+030.9550918E+030.8792580E+03 0.8461994E+030.8788548E+030.8157834E+030.7876221E+030.8153794E+030.7614015E+03 0.7368739E+030.7609972E+030.7138318E+030.6921072E+030.7134271E+030.6715566E+03 0.6520629E+030.6711509E+030.9554769E+030.1000000E+040.9154676E+030.9550918E+03 0.8792580E+030.8461995E+030.8788548E+030.8157834E+030.7876220E+030.8153794E+03 0.7614015E+030.7368739E+030.7609971E+030.7138317E+030.6921071E+030.7134270E+03 0.6715565E+030.6520627E+030.6711507E+030.9554769E+030.1000000E+040.9154676E+03 0.9550918E+030.8792580E+030.8461994E+030.8788547E+030.8157833E+030.7876220E+03 0.8153794E+030.7614014E+030.7368737E+030.7609970E+030.7138315E+030.6921069E+03 0.7134268E+030.6715563E+030.6520624E+030.6711504E+030.9554770E+030.1000000E+04 0.9154675E+030.9550917E+030.8792580E+030.8461993E+030.8788547E+030.8157833E+03 0.7876218E+030.8153792E+030.7614013E+030.7368736E+030.7609968E+030.7138313E+03 0.6921067E+030.7134266E+030.6715560E+030.6520621E+030.6711501E+030.9554768E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876218E+030.8153792E+030.7614012E+030.7368734E+030.7609967E+03 0.7138312E+030.6921065E+030.7134264E+030.6715556E+030.6520616E+030.6711498E+03 0.9554769E+030.1000000E+040.9154675E+030.9550919E+030.8792581E+030.8461992E+03 0.8788548E+030.8157831E+030.7876218E+030.8153791E+030.7614011E+030.7368733E+03 0.7609966E+030.7138311E+030.6921062E+030.7134262E+030.6715553E+030.6520613E+03 0.6711495E+030.9554768E+030.1000000E+040.9154675E+030.9550917E+030.8792580E+03 0.8461993E+030.8788547E+030.8157831E+030.7876218E+030.8153791E+030.7614010E+03 0.7368732E+030.7609966E+030.7138309E+030.6921061E+030.7134262E+030.6715552E+03 0.6520610E+030.6711493E+030.9554769E+030.1000000E+040.9154675E+030.9550917E+03 0.8792580E+030.8461992E+030.8788547E+030.8157832E+030.7876217E+030.8153791E+03 0.7614010E+030.7368732E+030.7609966E+030.7138309E+030.6921060E+030.7134262E+03 0.6715550E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+040.9154675E+03 0.9550917E+030.8792580E+030.8461992E+030.8788547E+030.8157831E+030.7876217E+03 0.8153792E+030.7614010E+030.7368732E+030.7609967E+030.7138309E+030.6921061E+03 0.7134263E+030.6715551E+030.6520608E+030.6711493E+030.9554768E+030.1000000E+04 0.9154676E+030.9550916E+030.8792579E+030.8461993E+030.8788548E+030.8157833E+03 0.7876219E+030.8153793E+030.7614011E+030.7368733E+030.7609968E+030.7138310E+03 0.6921062E+030.7134264E+030.6715552E+030.6520611E+030.6711497E+030.9554766E+03 0.1000000E+040.9154675E+030.9550918E+030.8792581E+030.8461993E+030.8788548E+03 0.8157833E+030.7876219E+030.8153794E+030.7614013E+030.7368734E+030.7609970E+03 0.7138312E+030.6921064E+030.7134266E+030.6715555E+030.6520614E+030.6711500E+03 0.9554767E+030.1000000E+040.9154676E+030.9550918E+030.8792582E+030.8461995E+03 0.8788550E+030.8157834E+030.7876220E+030.8153795E+030.7614016E+030.7368737E+03 0.7609972E+030.7138315E+030.6921068E+030.7134269E+030.6715559E+030.6520620E+03 0.6711504E+030.9554769E+030.1000000E+040.9154678E+030.9550917E+030.8792582E+03 0.8461995E+030.8788549E+030.8157836E+030.7876222E+030.8153796E+030.7614017E+03 0.7368739E+030.7609974E+030.7138318E+030.6921071E+030.7134273E+030.6715564E+03 0.6520624E+030.6711510E+030.9554769E+030.1000000E+040.9154678E+030.9550918E+03 0.8792583E+030.8461996E+030.8788551E+030.8157837E+030.7876224E+030.8153798E+03 0.7614018E+030.7368742E+030.7609975E+030.7138321E+030.6921076E+030.7134275E+03 0.6715569E+030.6520631E+030.6711514E+030.9554770E+030.1000000E+040.9154678E+03 0.9550918E+030.8792582E+030.8461997E+030.8788550E+030.8157837E+030.7876225E+03 0.8153798E+030.7614020E+030.7368744E+030.7609977E+030.7138324E+030.6921079E+03 0.7134278E+030.6715573E+030.6520636E+030.6711518E+030.9554769E+030.1000000E+04 0.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788550E+030.8157838E+03 0.7876226E+030.8153799E+030.7614021E+030.7368746E+030.7609978E+030.7138325E+03 0.6921081E+030.7134280E+030.6715576E+030.6520640E+030.6711521E+030.9554770E+03 0.1000000E+040.9154678E+030.9550919E+030.8792583E+030.8461998E+030.8788551E+03 0.8157838E+030.7876227E+030.8153799E+030.7614023E+030.7368747E+030.7609978E+03 0.7138327E+030.6921083E+030.7134280E+030.6715578E+030.6711521E+030.6520642E+03 0.9043840E+020.9024959E+020.9982624E+020.9025324E+020.8127637E+020.7214348E+02 0.7233030E+020.6359044E+020.7214098E+020.5486040E+020.5504742E+020.4669251E+02 0.5485869E+020.3833073E+020.3851758E+020.3051462E+020.3832972E+020.2249338E+02 0.2267557E+020.1499064E+020.2249275E+020.7314284E+010.7444518E+010.0000000E+00 0.7314062E+010.9043150E+020.9981746E+020.8127056E+020.9023955E+020.7232558E+02 0.6358650E+020.7213423E+020.5504421E+020.4668985E+020.5485397E+020.3851545E+02 0.3051288E+020.3832653E+020.2267428E+020.1498990E+020.2249106E+020.7444111E+01 0.0000000E+000.7313532E+010.9041948E+020.9980314E+020.8126039E+020.9022622E+02 0.7231699E+020.6357929E+020.7212435E+020.5503823E+020.4668502E+020.5484717E+02 0.3851151E+020.3050977E+020.3832206E+020.2267208E+020.1498835E+020.2248829E+02 0.7443328E+010.0000000E+000.7312600E+010.9040473E+020.9978616E+020.8124775E+02 0.9021061E+020.7230630E+020.6357015E+020.7211289E+020.5503062E+020.4667863E+02 0.5483882E+020.3850625E+020.3050576E+020.3831645E+020.2266914E+020.1498634E+02 0.2248521E+020.7442361E+010.0000000E+000.7311622E+010.9038883E+020.9976782E+02 0.8123390E+020.9019466E+020.7229438E+020.6355990E+020.7210071E+020.5502191E+02 0.4667128E+020.5482989E+020.3850048E+020.3050120E+020.3831044E+020.2266572E+02 0.1498406E+020.2248167E+020.7441242E+010.0000000E+000.7310432E+010.9037291E+02 0.9974982E+020.8121989E+020.9017899E+020.7228203E+020.6354932E+020.7208864E+02 0.5501292E+020.4666388E+020.5482104E+020.3849440E+020.3049642E+020.3830448E+02 0.2266212E+020.1498168E+020.2247817E+020.7440089E+010.0000000E+000.7309263E+01 0.9035755E+020.9973264E+020.8120635E+020.9016422E+020.7227021E+020.6353899E+02 0.7207724E+020.5500421E+020.4665663E+020.5481263E+020.3848852E+020.3049177E+02 0.3829860E+020.2265862E+020.1497939E+020.2247482E+020.7438896E+010.0000000E+00 0.7308275E+010.9034339E+020.9971666E+020.8119382E+020.9015084E+020.7225921E+02 0.6352947E+020.7206681E+020.5499589E+020.4664958E+020.5480474E+020.3848275E+02 0.3048745E+020.3829326E+020.2265550E+020.1497740E+020.2247185E+020.7437974E+01 0.0000000E+000.7307321E+010.9033083E+020.9970262E+020.8118270E+020.9013924E+02 0.7224938E+020.6352095E+020.7205773E+020.5498855E+020.4664344E+020.5479804E+02 0.3847776E+020.3048334E+020.3828865E+020.2265269E+020.1497544E+020.2246911E+02 0.7437009E+010.0000000E+000.7306399E+010.9032012E+020.9969071E+020.8117320E+02 0.9012961E+020.7224099E+020.6351366E+020.7205022E+020.5498236E+020.4663826E+02 0.5479246E+020.3847348E+020.3048001E+020.3828479E+020.2265009E+020.1497381E+02 0.2246688E+020.7436173E+010.0000000E+000.7305630E+010.9031151E+020.9968105E+02 0.8116565E+020.9012221E+020.7223432E+020.6350791E+020.7204454E+020.5497743E+02 0.4663413E+020.5478829E+020.3847005E+020.3047730E+020.3828192E+020.2264806E+02 0.1497248E+020.2246518E+020.7435502E+010.0000000E+000.7305147E+010.9030539E+02 0.9967415E+020.8116027E+020.9011754E+020.7222966E+020.6350389E+020.7204100E+02 0.5497396E+020.4663125E+020.5478565E+020.3846770E+020.3047547E+020.3828014E+02 0.2264669E+020.1497158E+020.2246415E+020.7435065E+010.0000000E+000.7304798E+01 0.9030207E+020.9967039E+020.8115745E+020.9011571E+020.7222719E+020.6350179E+02 0.7203972E+020.5497219E+020.4662980E+020.5478482E+020.3846652E+020.3047456E+02 0.3827960E+020.2264600E+020.1497116E+020.2246385E+020.7434862E+010.0000000E+00 0.7304705E+010.9030173E+020.9966986E+020.8115729E+020.9011706E+020.7222713E+02 0.6350182E+020.7204100E+020.5497224E+020.4662987E+020.5478585E+020.3846656E+02 0.3047463E+020.3828035E+020.2264606E+020.1497118E+020.2246428E+020.7434840E+01 0.0000000E+000.7304820E+010.9030484E+020.9967321E+020.8116022E+020.9012212E+02 0.7222973E+020.6350417E+020.7204504E+020.5497427E+020.4663163E+020.5478892E+02 0.3846801E+020.3047578E+020.3828246E+020.2264688E+020.1497178E+020.2246552E+02 0.7435168E+010.0000000E+000.7305189E+010.9031181E+020.9968096E+020.8116648E+02 0.9013108E+020.7223521E+020.6350898E+020.7205196E+020.5497834E+020.4663507E+02 0.5479400E+020.3847083E+020.3047809E+020.3828595E+020.2264865E+020.1497294E+02 0.2246749E+020.7435671E+010.0000000E+000.7305908E+010.9032270E+020.9969340E+02 0.8117604E+020.9014382E+020.7224345E+020.6351610E+020.7206144E+020.5498441E+02 0.4664011E+020.5480083E+020.3847498E+020.3048130E+020.3829062E+020.2265088E+02 0.1497443E+020.2247025E+020.7436538E+010.0000000E+000.7306792E+010.9033696E+02 0.9971007E+020.8118830E+020.9015907E+020.7225396E+020.6352508E+020.7207262E+02 0.5499190E+020.4664630E+020.5480891E+020.3847997E+020.3048524E+020.3829599E+02 0.2265392E+020.1497635E+020.2247327E+020.7437384E+010.0000000E+000.7307721E+01 0.9035275E+020.9972848E+020.8120183E+020.9017473E+020.7226550E+020.6353485E+02 0.7208421E+020.5500021E+020.4665326E+020.5481721E+020.3848554E+020.3048945E+02 0.3830152E+020.2265685E+020.1497819E+020.2247635E+020.7438330E+010.0000000E+00 0.7308690E+010.9036791E+020.9974583E+020.8121497E+020.9018909E+020.7227690E+02 0.6354466E+020.7209510E+020.5500843E+020.4666012E+020.5482510E+020.3849113E+02 0.3049383E+020.3830681E+020.2266011E+020.1498036E+020.2247941E+020.7439418E+01 0.0000000E+000.7309702E+010.9038145E+020.9976110E+020.8122695E+020.9020151E+02 0.7228738E+020.6355371E+020.7210470E+020.5501613E+020.4666640E+020.5483208E+02 0.3849621E+020.3049787E+020.3831158E+020.2266309E+020.1498238E+020.2248226E+02 0.7440445E+010.0000000E+000.7310594E+010.9039277E+020.9977381E+020.8123673E+02 0.9021151E+020.7229593E+020.6356111E+020.7211232E+020.5502239E+020.4667179E+02 0.5483784E+020.3850063E+020.3050119E+020.3831557E+020.2266558E+020.1498408E+02 0.2248447E+020.7441213E+010.0000000E+000.7311398E+010.9040124E+020.9978328E+02 0.8124439E+020.9021834E+020.7230272E+020.6356688E+020.7211790E+020.5502750E+02 0.4667602E+020.5484198E+020.3850405E+020.3050399E+020.3831829E+020.2266771E+02 0.1498551E+020.2248630E+020.7442012E+010.0000000E+000.7311986E+010.9040685E+02 0.9978938E+020.8124936E+020.9022281E+020.7230710E+020.6357078E+020.7212121E+02 0.5503077E+020.4667874E+020.5484450E+020.3850632E+020.3050580E+020.3832016E+02 0.2266911E+020.1498646E+020.2248730E+020.7442461E+010.0000000E+000.7312280E+01 0.9040985E+020.9979277E+020.8125194E+020.9022415E+020.7230943E+020.6357279E+02 0.7212240E+020.5503253E+020.4668021E+020.5484534E+020.3850759E+020.3050680E+02 0.3832071E+020.2266984E+020.1498691E+020.2248766E+020.7442645E+010.0000000E+00 0.7312407E+010.9040995E+020.9979281E+020.8125198E+020.9022276E+020.7230947E+02 0.6357277E+020.7212122E+020.5503254E+020.4668020E+020.5484451E+020.3850761E+02 0.3050684E+020.3832019E+020.2266985E+020.1498689E+020.2248728E+020.7442658E+01 0.0000000E+000.7312304E+010.9040706E+020.9978948E+020.8124940E+020.9021831E+02 0.7230725E+020.6357082E+020.7211790E+020.5503090E+020.4667877E+020.5484195E+02 0.3850642E+020.3050581E+020.3831832E+020.2266906E+020.1498648E+020.2248629E+02 0.7442413E+010.0000000E+000.7311994E+010.9040140E+020.9978321E+020.8124433E+02 0.9021149E+020.7230270E+020.6356686E+020.7211228E+020.5502748E+020.4667599E+02 0.5483790E+020.3850408E+020.3050391E+020.3831555E+020.2266771E+020.1498548E+02 0.2248445E+020.7441923E+010.0000000E+000.7311363E+010.9039289E+020.9977384E+02 0.8123675E+020.9020148E+020.7229619E+020.6356110E+020.7210465E+020.5502263E+02 0.4667177E+020.5483213E+020.3850054E+020.3050122E+020.3831159E+020.2266574E+02 0.1498410E+020.2248229E+020.7441259E+010.0000000E+000.7310669E+010.9038174E+02 0.9976107E+020.8122688E+020.9018914E+020.7228760E+020.6355362E+020.7209512E+02 0.5501623E+020.4666632E+020.5482507E+020.3849629E+020.3049783E+020.3830684E+02 0.2266317E+020.1498237E+020.2247947E+020.7440390E+010.0000000E+000.7309703E+01 0.9036832E+020.9974588E+020.8121505E+020.9017476E+020.7227719E+020.6354471E+02 0.7208420E+020.5500868E+020.4666012E+020.5481718E+020.3849118E+020.3049382E+02 0.3830155E+020.2266015E+020.1498037E+020.2247640E+020.7439432E+010.0000000E+00 0.7308692E+010.9035312E+020.9972852E+020.8120184E+020.9015909E+020.7226579E+02 0.6353490E+020.7207263E+020.5500047E+020.4665333E+020.5480892E+020.3848573E+02 0.3048951E+020.3829588E+020.2265692E+020.1497829E+020.2247317E+020.7438422E+01 0.0000000E+000.7307656E+010.9033731E+020.9971003E+020.8118830E+020.9014377E+02 0.7225424E+020.6352505E+020.7206146E+020.5499207E+020.4664629E+020.5480080E+02 0.3847999E+020.3048524E+020.3829051E+020.2265383E+020.1497629E+020.2247025E+02 0.7437512E+010.0000000E+000.7306815E+010.9032300E+020.9969340E+020.8117602E+02 0.9013105E+020.7224370E+020.6351611E+020.7205195E+020.5498448E+020.4664004E+02 0.5479399E+020.3847500E+020.3048119E+020.3828598E+020.2265111E+020.1497442E+02 0.2246758E+020.7436494E+010.0000000E+000.7305909E+010.9031200E+020.9968093E+02 0.8116643E+020.9012211E+020.7223534E+020.6350895E+020.7204504E+020.5497846E+02 0.4663506E+020.5478892E+020.3847091E+020.3047803E+020.3828246E+020.2264862E+02 0.1497286E+020.2246557E+020.7435705E+010.0000000E+000.7305212E+010.9030497E+02 0.9967320E+020.8116020E+020.9011704E+020.7222981E+020.6350416E+020.7204099E+02 0.5497432E+020.4663162E+020.5478584E+020.3846805E+020.3047578E+020.3828034E+02 0.2264692E+020.1497174E+020.2246429E+020.7435135E+010.0000000E+000.7304860E+01 0.9030177E+020.9966981E+020.8115730E+020.9011573E+020.7222713E+020.6350180E+02 0.7203971E+020.5497225E+020.4662989E+020.5478480E+020.3846661E+020.3047464E+02 0.3827959E+020.2264607E+020.1497118E+020.2246383E+020.7434871E+010.0000000E+00 0.7304694E+010.9030203E+020.9967040E+020.8115746E+020.9011753E+020.7222716E+02 0.6350177E+020.7204100E+020.5497218E+020.4662982E+020.5478568E+020.3846651E+02 0.3047456E+020.3828015E+020.2264599E+020.1497116E+020.2246415E+020.7434860E+01 0.0000000E+000.7304799E+010.9030532E+020.9967417E+020.8116031E+020.9012226E+02 0.7222960E+020.6350389E+020.7204457E+020.5497392E+020.4663127E+020.5478826E+02 0.3846765E+020.3047548E+020.3828191E+020.2264666E+020.1497157E+020.2246515E+02 0.7435031E+010.0000000E+000.7305096E+010.9031137E+020.9968107E+020.8116565E+02 0.9012961E+020.7223424E+020.6350791E+020.7205023E+020.5497733E+020.4663414E+02 0.5479245E+020.3846999E+020.3047733E+020.3828477E+020.2264799E+020.1497252E+02 0.2246683E+020.7435529E+010.0000000E+000.7305608E+010.9031990E+020.9969072E+02 0.8117320E+020.9013926E+020.7224083E+020.6351367E+020.7205773E+020.5498224E+02 0.4663827E+020.5479804E+020.3847336E+020.3048008E+020.3828862E+020.2265008E+02 0.1497389E+020.2246901E+020.7436141E+010.0000000E+000.7306398E+010.9033051E+02 0.9970262E+020.8118267E+020.9015082E+020.7224915E+020.6352095E+020.7206680E+02 0.5498847E+020.4664351E+020.5480479E+020.3847774E+020.3048343E+020.3829335E+02 0.2265246E+020.1497547E+020.2247184E+020.7437053E+010.0000000E+000.7307308E+01 0.9034303E+020.9971668E+020.8119380E+020.9016419E+020.7225892E+020.6352946E+02 0.7207718E+020.5499570E+020.4664956E+020.5481260E+020.3848269E+020.3048741E+02 0.3829869E+020.2265554E+020.1497742E+020.2247490E+020.7437918E+010.0000000E+00 0.7308257E+010.9035721E+020.9973260E+020.8120633E+020.9017896E+020.7226986E+02 0.6353894E+020.7208863E+020.5500391E+020.4665652E+020.5482107E+020.3848833E+02 0.3049170E+020.3830445E+020.2265855E+020.1497933E+020.2247815E+020.7438897E+01 0.0000000E+000.7309283E+010.9037246E+020.9974977E+020.8121980E+020.9019461E+02 0.7228169E+020.6354925E+020.7210068E+020.5501265E+020.4666388E+020.5482990E+02 0.3849431E+020.3049643E+020.3831043E+020.2266209E+020.1498167E+020.2248162E+02 0.7440071E+010.0000000E+000.7310424E+010.9038848E+020.9976786E+020.8123397E+02 0.9021068E+020.7229408E+020.6355996E+020.7211293E+020.5502176E+020.4667134E+02 0.5483877E+020.3850036E+020.3050123E+020.3831644E+020.2266564E+020.1498409E+02 0.2248517E+020.7441297E+010.0000000E+000.7311546E+010.9040444E+020.9978611E+02 0.8124772E+020.9022623E+020.7230597E+020.6357015E+020.7212438E+020.5503034E+02 0.4667862E+020.5484714E+020.3850628E+020.3050572E+020.3832207E+020.2266897E+02 0.1498633E+020.2248830E+020.7442335E+010.0000000E+000.7312646E+010.9041916E+02 0.9980319E+020.8126046E+020.9023958E+020.7231691E+020.6357933E+020.7213420E+02 0.5503822E+020.4668507E+020.5485401E+020.3851144E+020.3050985E+020.3832651E+02 0.2267204E+020.1498838E+020.2249106E+020.7443427E+010.0000000E+000.7313518E+01 0.9043115E+020.9981733E+020.8127051E+020.9024962E+020.7232533E+020.6358644E+02 0.7214097E+020.5504404E+020.4668982E+020.5485867E+020.3851531E+020.3051287E+02 0.3832969E+020.2267431E+020.1498989E+020.2249277E+020.7444162E+010.0000000E+00 0.7314072E+010.9043840E+020.9982624E+020.8127634E+020.9025324E+020.7233024E+02 0.6359045E+020.7214351E+020.5504736E+020.4669250E+020.5486030E+020.3851754E+02 0.3051457E+020.3833075E+020.2267554E+020.1499062E+020.2249341E+020.7444513E+01 0.7314283E+010.0000000E+00 syrthes-3.4.3-dfsg1/example/cylinder/usr/0000777000175000017500000000000011524070640016764 5ustar pinipinisyrthes-3.4.3-dfsg1/example/cylinder/usr/cphyso.F0000666000175000017500000004176511524070640020415 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CPHYSO C ***************** C C --------------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,PHYSOL,NPOUE,NPPEL,NBPHYS,VOLUME) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DES CARACTERISTIQUES PHYSIQUES DU SOLIDE * C RHO(x,y,z,t,T), CP(x,y,z,t,T), K(x,y,z,t,T) * C + invariant de Gauss et epaisseur pour le modele coque * C * C Dans la version 3.0 de SYRTHES, il est possible de definir * C les caracteristiques soit par noeud soit par element soit * C par noeud pour un element. Parmi les trois choix suivant, * C un seul doit etre retenu et en coherence avec l'option prise * C dans le fichier des mots-cles. * C Pour plus de clarte, on engage meme les utilisateurs a * C supprimer les lignes non utiles dans leur cas. * C * C Attention : toute variable utilisee doit etre declaree * C ========= * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! PHYSOL ! TR ! R ! CARACTERISTIQUES PHYSIQUES DU SOLIDE ! C ! NPOUE ! E ! D ! NOMBRE DE NOEUDS OU D'ELTS ! C ! NPPEL ! E ! D ! NOMBRE DE NOEUD PAR ELEMENTS ! C ! VOLUME ! E ! D ! VOLUME DE CHAQUE ELEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /TEMPS / ! ! D ! ! C ! /OPTCT / ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "syrthu.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBPHYS,NPOUE,NPPEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS),VOLUME(NELEMS) C C.. Variables internes INTEGER I,J,K,N,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2,TT C C*********************************************************************** C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C -------------------------------------------------- C 2- INTERVENTION UTILISATEUR POUR LE MODELE GENERAL C -------------------------------------------------- C Les conditions physiques peuvent etre fonction C de l'espace (COORDS(...,1),COORDS(...,2),COORDS(...,3)), C du temps (TEMPS) et de la temperature TMPS(...) C On donne : C Si la conductivite est isotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k C Si la conductivite est orthotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x | 3 | C - PHYSOL(.,.,4) : conductivite k suivant y | 4 | C - PHYSOL(.,.,5) : conductivite k suivant z | 5 | C Si la conductivite est anisotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x C - PHYSOL(.,.,4) : conductivite k suivant y | 3 6 7 | C - PHYSOL(.,.,5) : conductivite k suivant z | 4 8 | C - PHYSOL(.,.,6) : conductivite k suivant xy | 5 | C - PHYSOL(.,.,7) : conductivite k suivant xz C - PHYSOL(.,.,8) : conductivite k suivant yz C C Temps reel courant sur le solide CUTI T = TEMPSS C C ===================================================== C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== CUTI IF(NDPROP .NE. 1) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque point solide CUTI DO N=1,NPOINS C C References du point courant CUTI NUMREF = NREFS(N) C C Coordonnees du point courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Temperature du noeud CUTI TT = TMPS(N) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C ===================================================== C FIN POUR LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 2) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero des noeuds de l'element ( 6 en 2D, 10 en 3D) CUTI point 1 a 6 CUTI N1 = NODES(N,1) CUTI N2 = NODES(N,2) CUTI N3 = NODES(N,3) CUTI N4 = NODES(N,4) CUTI N5 = NODES(N,5) CUTI N6 = NODES(N,6) C CUTI IF (NDIM .EQ. 3) THEN CUTI N7 = NODES(N,7) CUTI N8 = NODES(N,8) CUTI N9 = NODES(N,9) CUTI N10= NODES(N,10) CUTI ENDIF C C Coordonnees des points de l'element courant C Pour le noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Pour le noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc C C Temperature des noeuds de l'element CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C C ======================================================= C FIN DES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= C C C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 3) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque noeud de l'element CUTI DO J=1,NDMATS C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero global du noeud CUTI N1 = NODES(N,J) C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT = TMPS(N1) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,J,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI PHYSOL(N,J,6) = CUTI PHYSOL(N,J,7) = CUTI PHYSOL(N,J,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO CUTI ENDDO C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= C C C C*********************************************************************** C 1000 FORMAT(' CPHYSO : ATTENTION LE CHOIX EST CONTRADICTOIRE AVEC',/, & 'CELUI RETENU DANS LES MOTS-CLES') C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/usr/limfso.F0000666000175000017500000003741711524070640020400 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMFSO C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NELEUS,NDMASS,NODEUS,NREFAL, * NBFFLU,NFFLUS,VFFLUS,NBDIRS,NDIRS,VDIRS,NBFECH,NFECHS,VFECHS, * NBFRAI,NFRAIS,VFRAIS,NELERC,NFRESC,VFRESC) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C (Sous-programme utilisateur) * C * C ATTENTION : * C =========== * C A l'aide de ce sous programme, il est possible d'imposer * C les conditions limites sur les faces, ce qui permet un * C "meilleur" traitement des conditions limites discontinues.* C Le cas typique ou ce traitement peut avoir un interet est * C par exemple celui du coin affecte par des conditions aux * C limites de type differentes sur chaque face, auquel cas, * C le point de coin peut etre considere comme singulier. * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFFLUS ! TE ! D ! No local de la face affecte par des flux ! C ! VFFLUS ! TR ! R ! Valeur du flux aux points de la facette ! C ! NBFFLU ! E ! R ! Nombre de facettes de type flux ! C ! NFECHS ! TE ! D ! No local de la facette avec c.l. d'echange ! C ! VFECHS ! TR ! R ! Valeur aux noeud de la face de type echange ! C ! ! ! ! VFECHS(.,..,1) = temperature exterieure ! C ! ! ! ! VFECHS(.,..,2) = coefficient d'echange ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAIS ! TE ! D ! No des facettes avec rayonnement infi ! C ! VFRAIS ! TR ! R ! Valeurs aux noeuds des faces de type ! C ! ! ! ! rayonnement infi. ! C ! ! ! ! VFRAIS(.,..,1) = temp exterieure equival ! C ! ! ! ! VFRAIS(.,..,2) = coef d'echange equival ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf ! C ! NFRESC ! TE ! D ! No des facettes avec resistance de contact ! C ! VFRESC ! TR ! R ! Valeurs des resistances aux noeuds de la face! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS,NDMASS INTEGER NBFFLU,NBDIRS,NBFECH,NELERC,NBFRAI,NELEUS INTEGER NODEUS(NELEUS,NDMASS) INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS),NREFAL(NELEUS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFFLUS(NBFFLU),NDIRS(NBDIRS),NFECHS(NBFECH) INTEGER NFRESC(NELERC),NFRAIS(NBFRAI) DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VDIRS(NBDIRS) DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) C C.. Variables internes INTEGER N,J,NUMFA,NUMREF,NNGLOB DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFFLU C C Numero global de la facette de bord CUTI NUMFA = NFFLUS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D C CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NNGLOB) C C Si la face porte la reference 3, le flux sur les neuds de C la face vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFFLUS(N,J) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N,J) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Exemple ... C CUTI DO N=1,NBDIRS C C On rappelle que les conditions de Dirichlet affecte des noeuds C et non pas des faces. C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C C Si le noeud porte la reference 3, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFECH C C Numero global de la facette de bord CUTI NUMFA = NFECHS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 et le coefficient d'echange de 10, C sinon, la temperature exterieure est de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VFECHS(N,J,1) = 20.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ELSE CUTI VFECHS(N,J,1) = 40.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Exemple ... C CUTI DO N=1,NELERC C C Numero global de la facette de bord CUTI NUMFA = NFRESC(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C C Si le noeud porte la reference 4 on a une resistance C de contact de 100. sinon de 1. (mauvaise transmission) C C CUTI IF (NUMREF.EQ.4) THEN CUTI VFRESC(N,J,2) = 100.0D0 CUTI ELSE CUTI VFRESC(N,J,2) = 1.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFRAI C C Numero global de la facette de bord CUTI NUMFA = NFRAIS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 C et l'emissivite de 0.8, C sinon, la temperature exterieure est de 10 C et epsilon 0.9 C CUTI IF (NUMREF.EQ.6) THEN CUTI VFRAIS(N,J,1) = 20.0D0 CUTI VFRAIS(N,J,2) = 0.8D0 CUTI ELSE CUTI VFRAIS(N,J,1) = 10.0D0 CUTI VFRAIS(N,J,2) = 0.9D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C CC C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFFLU.GT.0 .OR. NBDIRS.GT.0 .OR. NBFECH.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF C C Impression des flux IF (NBFFLU.GT.0) THEN WRITE(NFECRA,5010) DO 5051 N=1,NBFFLU DO 5052 J=1,NDMASS WRITE(NFECRA,5050) NFFLUS(N),VFFLUS(N,J) 5052 CONTINUE 5051 CONTINUE ENDIF C C Impression des Dirichlets IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF C C Impression des conditions d'echange IF (NBFECH.GT.0) THEN WRITE(NFECRA,5030) DO 5061 N=1,NBFECH DO 5062 J=1,NDMASS WRITE(NFECRA,5060) & NFECHS(N),VFECHS(N,J,1),VFECHS(N,J,2) 5062 CONTINUE 5061 CONTINUE ENDIF C C Impression des conditions de rayonnement infini IF (NBFRAI.GT.0) THEN WRITE(NFECRA,5040) DO 5071 N=1,NBFRAI DO 5072 J=1,NDMASS WRITE(NFECRA,5060) & NFRAIS(N),J,VFRAIS(N,J,1),VFRAIS(N,J,2) 5072 CONTINUE 5071 CONTINUE ENDIF C C Impression des conditions de resistance de contact IF (NELERC.GT.0) THEN WRITE(NFECRA,5045) DO 5081 N=1,NELERC DO 5082 J=1,NDMASS WRITE(NFECRA,5060) & NFRESC(N),J,VFRESC(N,J,2) 5082 CONTINUE 5081 CONTINUE ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMFSO : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMFSO : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux', & ' (face, noeud, flux)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange', & ' (face, noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement inifni', & ' (face, noeud, Tnoir, sigma)') 5045 FORMAT(/,' - Condition de type resistance', & ' (face, noeud, resistance)') 5050 FORMAT('(',I6,'-',I2,'-',G10.3,')') 5060 FORMAT(I6,'--',I2,'--',G10.3,'--',G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/usr/initmp.F0000666000175000017500000001366111524070640020402 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INITMP C ***************** C C -------------------------------------------------- * (NDIM,NPOINS,NELEMS,NDMATS,NODES, * COORDS,NREFS,NREFE,TMPSA,TMPS) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DE LA TEMPERATURE DANS LE SOLIDE * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C ! TMPS ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL,RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION TMPSA(NPOINS),TMPS(NPOINS) C C.. Variables internes DOUBLE PRECISION XX,YY,ZZ INTEGER N,I,NUMREF C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C =================================================== C C Methode 1 : boucle sur les noeuds C --------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque point solide C DO N=1,NPOINS C C Coordonnees du noeud courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Numero de reference du noeud CUTI NUMREF = NREFS(N) C C Si le noeud courant porte la reference 4 CUTI IF (NUMREF.EQ.4 ) THEN CUTI TMPS(N) = 20.D0 CUTI ELSE CUTI TMPS(N) = 10.D0 CUTI ENDIF C CUTI ENDDO C C Methode 2 : boucle sur les elements C ----------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque element solide C DO N=1,NELEMS C C C Numero de materiau de l'element CUTI NUMREF=NREFE(N) C C Si l'elements porte la reference 4, on met 20 degres sur tous C les noeuds de l'element sinon on met 10 degres CUTI IF (NUMREF.EQ.4 ) THEN CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 20.D0 CUTI ENDDO CUTI ELSE CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 10.D0 CUTI ENDDO CUTI ENDIF C CUTI ENDDO C C FIN D'INTERVENTION UTILISATEUR C ------------------------------ C*********************************************************************** C DO N=1,NPOINS TMPSA(N)=TMPS(N) ENDDO C C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/usr/inrefa.F0000666000175000017500000001603111524070640020340 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=INREFA,SSI=0 SUBROUTINE INREFA C ***************** C C ----------------------------------- * (NDIM,NDIELE,NELEMS,NDMATS,NBFACE, * NODES,NREFAC,NPOINS,NREFS) C ----------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES REFERENCES DES FACES DANS LE CAS * C OU LE MAILLEUR UTILISE NE LES FOURNIT PAS * C Elles sont necessaires lorsque l'on veut imposer les * C conditions aux limites sur les faces. * C * C Sous programme utilisateur * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEMES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS(2=triangles,3=tetraed)! C ! NREFAC ! TE ! R ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS PAR ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE) INTEGER NPOINS,NREFS(NPOINS) C C.. Variables internes INTEGER I,J INTEGER N1,N2,N3,N4,N5,N6,NR1,NR2,NR3,NR4,NR5,NR6 C C NARE(noeud,arete), NFAC(noeud,face) INTEGER NARE(3,3),NFAC(6,4) C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,2,3,5,6,7, 1,2,4,5,9,8, 1,3,4,7,10,8, 2,3,4,6,10,9/ C C 1- INITIALISATIONS C ------------------ C C C 2- CAS D'UN MAILLAGE EN TRIANGLES C ================================= C IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C C Numeros des 3 noeuds de l'arete : 1----3----2 CUTI N1 = NODES(I,NARE(1,J)) CUTI N2 = NODES(I,NARE(2,J)) CUTI N3 = NODES(I,NARE(3,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C C C 3- CAS D'UN MAILLAGE EN TETRAEDRES C ================================== C ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C 3 C / \ C Numeros des 6 noeuds de la face : 6 5 C / \ C 1-----4-----2 CUTI N1 = NODES(I,NFAC(1,J)) CUTI N2 = NODES(I,NFAC(2,J)) CUTI N3 = NODES(I,NFAC(3,J)) CUTI N4 = NODES(I,NFAC(4,J)) CUTI N5 = NODES(I,NFAC(5,J)) CUTI N6 = NODES(I,NFAC(6,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) CUTI NR4 = NREFS(N4) CUTI NR5 = NREFS(N5) CUTI NR6 = NREFS(N6) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C ELSE C C 5- CAS D'ERREUR C =============== WRITE(NFECRA,5000) STOP C ENDIF C C-------- C FORMATS C-------- 5000 FORMAT(//,' %% ERREUR INREFA : ON N''EST DANS AUCUNE DES ', & 'CONFIGURATIONS PREVUES') C END syrthes-3.4.3-dfsg1/example/cylinder/usr/limray.F0000666000175000017500000003755611524070640020410 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LIMRAY,SSI=0 SUBROUTINE LIMRAY C ***************** C C ------------------------------------------------------------ * (NDIM,NELRAY,NPOINR, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA, * NODRAY,NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF, * COORAY,EMISSI,TEMRAY,FIRAY,PHFRAF,PHFRAE,VFIRAY) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES DE RAYONNEMENT * C TRANSPARENT CONFINE SUR LE MAILLAGE DE RAYONNEMENT * C * C Attention : Toutes les grandeurs entrees par l'utilisateur le sont * C au niveau des faces * C * C (Sous-programme utilisateur) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NELRAY ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUD DU MAILLAGE DE RAYONNEMENT ! C ! SPECTL ! TR ! R ! BORNES DE CHAQUE BANDE SPECTRALE ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNT ! C ! COORAY ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE DE RAYONNT! C ! NODRAY ! TE ! D ! CONNECTIVITE DU MAILLAGE DE RAYONNEMENT ! C ! EMISSI ! TE ! D ! EMISSIVITE DE FACETTE POUR CHAQUE BANDE ! C ! TEMRAY ! TR ! D ! TEMPERATURE DE LA FACE DE RAYONNT A L'ETAPE N! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "rayonn.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NELRAY,NPOINR INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA INTEGER NGFFIR(NFFIRA),NGFTIR(NFTIRA) INTEGER NGFPER(NFPERA),NGFPEF(NFCFRA) INTEGER NRFRAY(NELRAY),NODRAY(NELRAY,NDIM) DOUBLE PRECISION COORAY(NPOINR,NDIM),TEMRAY(NELRAY) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION PHFRAF(NFCFRA,4),PHFRAE(NFPERA,4) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) C C C.. Variables internes INTEGER N,NUMNO,NUMREF,I,NGFAC DOUBLE PRECISION T,XX1,YY1,ZZ1 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Temps courant sur le solide CUTI T = TEMPSS C C ================================================================ C 1- INITIALISATION DES BANDES SPECTRALES C ================================================================ C Definition des bandes spectrales si besoin est C Le nombre de bandes spectrales,NBANDE est defini dans le fichier C de mots-cles Syrthes.ray C Exemple : si le nombre de bandes (NBANDE) vaut 2, avec en metres C Premiere bande lambda_1 = 0 , lambda_2 = 5.e-6 (m) C Deuxieme bande lambda_1 = 5.e-6 , lambda_2 = 1. CUTI SPECTL(1,1) = 0 CUTI SPECTL(1,2) = 5.e-6 CUTI SPECTL(2,1) = 5.e-6 CUTI SPECTL(2,2) = 1. C C ================================================================ C 2- INITIALISATION DE l'EMISSIVITE POUR LE RAYONNEMENT C ================================================================ C C Exemple ... C CUTI DO N=1,NELRAY C C References de la face CUTI NUMREF = NRFRAY(N) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(N,1),1) CUTI YY1 = COORAY(NODRAY(N,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(N,1),3) C ... C C Temperature de la face de rayonnement CUTI TTFAC = TEMRAY(N) C C Exemple C Si la face porte la reference 3, l'emissivite vaut C 0.7 pour la premiere bande C 0.95 pour la deuxieme bande C sinon, elle vaut 0.5 (elle peut eventuellement dependre de la C temperature de la face calculee precedement (TTFAC) C CUTI IF (NUMREF.EQ.3) THEN CUTI EMISSI(N,1,1) = 0.7 CUTI EMISSI(N,1,2) = 0.95 CUTI ELSE CUTI EMISSI(N,1,1) = 0.5 CUTI EMISSI(N,1,2) = 0.5 CUTI ENDIF C CUTI ENDDO C C ================================================================ C 3- INITIALISATION DES TEMPERATURES DE FACES IMPOSEE C ================================================================ C CUTI DO N=1,NFTIRA C C Numero global de la face CUTI NGFAC = NGFTIR(N) C Reference de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Attention : La temperature de la face de rayonnement est en degre C C La references 5 designe une entree T = 30 degre C C La references 6 designe une sortie T = 50 degre C C CUTI IF ( NUMREF .EQ. 5 ) THEN CUTI TEMRAY(NGFAC) = 30. CUTI ELSEIF ( NUMREF .EQ. 6 ) THEN CUTI TEMRAY(NGFAC) = 50. CUTI ENDIF C CUTI ENDDO C C ================================================================ C 4- INITIALISATION DES FACES A FLUX IMPOSE PAR BANDE C ================================================================ C CUTI DO N=1,NFFIRA C C Numero global de la face CUTI NGFAC = NGFFIR(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C On a une seule bande spectrale --> NUMBAN = 1 C Si la reference de la face vaut 7 on a une paroi adiabatique C Si la reference de la face vaut 3 on a un flux de 500 W/m2 C CUTI NUMBAN = 1 C CUTI IF ( NUMREF .EQ. 7 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 0. CUTI ELSEIF ( NUMREF .EQ. 3 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 500. CUTI ENDIF C CUTI ENDDO C C C ================================================================ C 5- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C COUPLEE AU FLUIDE (attention sans solide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAF(..,1) est la conductivite du materiau C PHFRAF(..,2) est l'epaisseur du materiau C PHFRAF(..,3) est la temperature exterieure C PHFRAF(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFCFRA C C Numero global de la face CUTI NGFAC = NGFPEF(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 5 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : -10. degres C C H ext : 200 C CUTI IF (NUMREF.EQ.5) THEN CUTI PHFRAF(N,1) = 10. CUTI PHFRAF(N,2) = 0.01 CUTI PHFRAF(N,3) = -10. CUTI PHFRAF(N,4) = 200. CUTI ENDIF C C CUTI ENDDO C C ================================================================ C 6- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C DES FACES DE RAYONNEMENT ISOLEES C (ni couple au solide ni au fluide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAE(..,1) est la conductivite du materiau C PHFRAE(..,2) est l'epaisseur du materiau C PHFRAE(..,3) est la temperature exterieure C PHFRAE(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFPERA C C Numero global de la face CUTI NGFAC = NGFPER(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 12 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : 100. degres C C H ext : 10 C CUTI IF (NUMREF.EQ.12) THEN CUTI PHFRAE(N,1) = 10. CUTI PHFRAE(N,2) = 0.01 CUTI PHFRAE(N,3) = 100. CUTI PHFRAE(N,4) = 10. CUTI ENDIF C C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 7- IMPRESSION DE CONTROLE C ========================= C (il suffit de mettre LVERIF = .TRUE. en debut de programme) C IF (LVERIF) THEN C WRITE(NFECRA,7000) C IF (NBANDE .GT. 1) THEN WRITE(NFECRA,7100) NBANDE DO 7110 N=1,NBANDE WRITE(NFECRA,7120) SPECTL(N,1),SPECTL(N,2) 7110 CONTINUE ENDIF C DO 7200 N=1,NBANDE WRITE(NFECRA,7210) N WRITE(NFECRA,7220) WRITE(NFECRA,7230) ( I,EMISSI(I,1,N),I=1,NELRAY ) 7200 CONTINUE C C WRITE(NFECRA,7300) NFTIRA WRITE(NFECRA,7310) WRITE(NFECRA,7320) ( NGFTIR(I),TEMRAY(NGFTIR(I)),I=1,NFTIRA ) C C WRITE(NFECRA,7410) NFFIRA DO 7400 N=1,NBANDE WRITE(NFECRA,7415) N WRITE(NFECRA,7420) WRITE(NFECRA,7430) (NGFFIR(I),FIRAY(NGFFIR(I),N),I=1,NFFIRA) 7400 CONTINUE C C WRITE(NFECRA,7500) NFCFRA WRITE(NFECRA,7510) DO 7530 N=1,NFCFRA NGFAC = NGFPEF(N) WRITE(NFECRA,7520) N,PHFRAF(NGFAC,1),PHFRAF(NGFAC,2), & PHFRAF(NGFAC,3),PHFRAF(NGFAC,4) 7530 CONTINUE C C WRITE(NFECRA,7600) NFPERA WRITE(NFECRA,7610) DO 7630 N=1,NFPERA NGFAC = NGFPER(N) WRITE(NFECRA,7620) N,PHFRAE(NGFAC,1),PHFRAE(NGFAC,2), & PHFRAE(NGFAC,3),PHFRAE(NGFAC,4) 7630 CONTINUE C ENDIF C C-------- C FORMATS C-------- C 7000 FORMAT(/,' *** LIMRAY : IMPRESSION DES CONDITIONS AUX LIMITES', & ' DE TYPE RAYONNEMENT TRANSPARENT CONFINE') 7100 FORMAT(/,' Nombre de bandes spectrales definies',I2) 7120 FORMAT(/,' Bande spectrale :',I2,' Lamda_1 = ',E13.5, & ' Lamda_2 = ',E13.5) 7210 FORMAT(/,' Valeur des emissivites pour la bande : ',I2) 7220 FORMAT(/,' Numero de la facette - valeur de l''emissivite ') 7230 FORMAT('(',I6,' - ',G10.3,')') 7300 FORMAT(/,' Nombre de facette avec temperature imposee : ',I5) 7310 FORMAT(/,' Numero de la facette - valeur de la', & ' temperature imposee') 7320 FORMAT('(',I6,' - ',G10.3,')') 7410 FORMAT(/,' Nombre de facette avec Flux impose : ',I5) 7415 FORMAT(/,' Valeur des flux imposes pour la bande : ',I2) 7420 FORMAT(/,' Numero de la facette - valeur du flux impose') 7430 FORMAT('(',I6,' - ',G10.3,')') 7500 FORMAT(/,' Nombre de facette paroi equivalente couple au', & ' fluide : ',I5) 7510 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7520 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) 7600 FORMAT(/,' Nombre de facette paroi equivalente isolee : ',I5) 7610 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7620 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/usr/cfluvs.F0000666000175000017500000002436111524070640020403 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CFLUVS C ***************** C C ---------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,NBFLVS,NPFEL,NFLUVS,VFLUVS) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DE FLUX VOLUMIQUES SUR LE SOLIDE * C (EN FONCTION DE L'ESPACE DU TEMPS ET DE LA TEMPERATURE) * C CAS DU MODELE GENERAL * C * C Dans la version 3.0, le flux volumiques peuvent etre * C definis sur les noeuds, les elements ou * C par noeud d'un element * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TE ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS AVEC FLUX VOL ! C ! NFLUVS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOL ! C ! VFLUVS ! TR ! R ! VALEUR DU FLUX VOLUMIQUE EN CES NOEUDS ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /TEMPS/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBFLVS,NPFEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NFLUVS(NBFLVS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) C C.. Variables internes INTEGER I,J,K,N,NUMREF,NUMNO,NUMEL DOUBLE PRECISION XX,YY,ZZ,TT1,TT2,T C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C --------------------------------------------------- C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ------------------------------------------------------------------ C Le flux volumique est stocke dans VFLUVS C Il peut etre fonction de l'espace (COORDS(...,1),COORDS(...,2), C COORDS(...,3)), du temps TEMPS, et de la temperature TMPS(...) C Dans le cas du modele coque, on dispose des temperatures C interne (TMPSA) et externe (TMPS) de la coque C ------------------------------------------------------------------ C C C Temps reel courant sur le solide CUTI T = TEMPSS C C C ============================================================ C TRAITEMENT PAR NOEUD C ============================================================ C Pour chaque point portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global du noeud CUTI NUMNO = NFLUVS(N) C C Reference du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud courant porte la reference 4 le flux vaut 1000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 C C Sinon il vaut 10000 W/M3 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 C CUTI ENDIF C CUTI ENDDO C ============================================================ C FIN DU TRAITEMENT PAR NOEUD C ============================================================ C C C C C ============================================================ C TRAITEMENT PAR ELEMENT (FLUX VOLUMIQUE CONSTANT PAR ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C C Numero des noeuds de l'element CUTI N1 = NODES(NUMEL,1) CUTI N2 = NODES(NUMEL,2) CUTI N3 = NODES(NUMEL,3) CUTI N4 = NODES(NUMEL,4) CUTI N5 = NODES(NUMEL,5) CUTI N6 = NODES(NUMEL,6) CUTI IF (NDIM.EQ.3) THEN CUTI N7 = NODES(NUMEL,7) CUTI N8 = NODES(NUMEL,8) CUTI N9 = NODES(NUMEL,9) CUTI N10= NODES(NUMEL,10) CUTI ENDIF C C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Coordonnees XXi YYi ZZi des noeuds de l'element C (6 en 2d, 10 en 3D) C Noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc... C C Temperatures TTi aux noeuds de l'element (6 en 2d 10 en 3d) C TT1 = Temperature au noeud courant n1 CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc... C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 CUTI ENDIF C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR ELEMENT (FLUX CONSTANT PAR ELEMENT) C ============================================================ C C C C C C C ============================================================ C TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Pour chaque noeud de l'element courant CUTI DO J=1,NPFEL C C Numero du noeud courant CUTI N1 = NODES(NUMEL,J) C C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT1 = TMPS(N1) C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 sur chacun des noeuds de l'element C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,J) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,J) = 10000.D0 CUTI ENDIF CUTI ENDDO C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/usr/limsol.F0000666000175000017500000003117211524070640020376 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMSOL C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS,NBECHS,NECHS,VECHS, * NBRAIS,NRAYIS,VRAYIS,NBRESS,NRESCS,VRESCS) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C POUR LE CALCUL COUPLE FLUIDE-SOLIDE * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFLUSS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DE FLUX ! C ! VFLUSS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE FLUX ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C ! NECHS ! TE ! D ! NUMERO DES NOEUDS AVEC C.L. COEFF ECHANGE ! C ! VECHS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE COEFF ECHANGE! C ! ! ! ! VECHS(...,1) = temperature exterieure ! C ! ! ! ! VECHS(...,2) = coefficient d'echange ! C ! NRAYIS ! TE ! D ! NUMERO DES NOEUDS AVEC RAYONNEMENT infi ! C ! VRAYIS ! TR ! R ! VALEUR DES PARAMETRES POUR LE RAYONNEMENTinfi! C ! NRESCS ! TE ! D ! NUMERO DES NOEUDS AVEC RESISTANCE DE CONTACT ! C ! VRESCS ! TR ! R ! VALEUR DE LA RESISTANCE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NBFLUS,NBDIRS,NBECHS,NBRESS,NBRAIS INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFLUSS(NBFLUS),NDIRS(NBDIRS),NECHS(NBECHS) INTEGER NRESCS(NBRESS,2),NRAYIS(NBRAIS) DOUBLE PRECISION VFLUSS(NBFLUS),VDIRS(NBDIRS),VECHS(NBECHS,2) DOUBLE PRECISION VRESCS(NBRESS,2),VRAYIS(NBRAIS,2) C C.. Variables internes INTEGER N,NUMNO,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFLUS C C Numero global du noeud CUTI NUMNO = NFLUSS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 3, le flux vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFLUSS(N) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBDIRS C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 5, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBECHS C C Numero global du noeud CUTI NUMNO = NECHS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure est C de 20 et le coefficient d'echange de 10, sinon, la temperature C exterieure et de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VECHS(N,1) = 20.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ELSE CUTI VECHS(N,1) = 40.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRESS C C Numero global du noeud CUTI NUMNO = NRESCS(N,1) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 4 C CUTI IF (NUMREF.EQ.4) THEN CUTI VRESCS(N,2) = 0.5D0 CUTI ELSE CUTI VRESCS(N,2) = 0.7D0 CUTI ENDIF C CUTI ENDDO C C ==================================================== C 6- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RAYONNEMENT INFINI C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRAIS C C Numero global du noeud CUTI NUMNO = NRAYIS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure C utilisee pour le rayonnement est de 100 degree C C L'emissivite est de 0.8 C de 20 degree et epsilon=0.9 autrement C CUTI IF (NUMREF.EQ.6) THEN CUTI VRAYIS(N,1) = 100.0D0 CUTI VRAYIS(N,2) = 0.8D0 CUTI ELSE CUTI VRAYIS(N,1) = 20.D0 CUTI VRAYIS(N,2) = 0.9 CUTI ENDIF C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFLUS.GT.0 .OR. NBDIRS.GT.0 .OR. NBECHS.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF IF (NBFLUS.GT.0) THEN WRITE(NFECRA,5010) WRITE(NFECRA,5050) (NFLUSS(N),VFLUSS(N),N=1,NBFLUS) ENDIF IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF IF (NBECHS.GT.0) THEN WRITE(NFECRA,5030) WRITE(NFECRA,5060) & (NECHS(N),VECHS(N,1),VECHS(N,2),N=1,NBECHS) ENDIF IF (NBRAIS.GT.0) THEN WRITE(NFECRA,5040) WRITE(NFECRA,5060) & (NRAYIS(N),VRAYIS(N,1),VRAYIS(N,2),N=1,NBRAIS) ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMSOL : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMSOL : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux (noeud, valeur)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange (noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement infini', & ' (noeud, T, sigma)') 5050 FORMAT('(',I6,'-',G10.3,')') 5060 FORMAT('(',I6,'-',G10.3,',',G10.3,')') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/example/cylinder/MESH/0000777000175000017500000000000011524070640016707 5ustar pinipinisyrthes-3.4.3-dfsg1/example/cylinder/MESH/cylinder.syr0000666000175000017500000070627611524070640021301 0ustar pinipiniC************************************************C C FICHIER GEOMETRIQUE SYRTHES 3.4 C C************************************************C C DIMENSION = 2 DIMENSION DES ELTS = 2 C NOMBRE DE NOEUDS = 2210 C NOMBRE D'ELEMENTS = 1008 C NOMBRE DE NOEUDS PAR ELEMENT = 6 C************************************************C C C$ RUBRIQUE = NOEUDS C 1 1 0.0000000E+00 -0.2000000E+00 0.0000000E+00 2 0 0.0000000E+00 -0.2500000E+00 0.0000000E+00 3 0 0.0000000E+00 -0.3000000E+00 0.0000000E+00 4 0 0.0000000E+00 -0.3500000E+00 0.0000000E+00 5 0 0.0000000E+00 -0.4000000E+00 0.0000000E+00 6 0 0.0000000E+00 -0.4500000E+00 0.0000000E+00 7 0 0.0000000E+00 -0.5000000E+00 0.0000000E+00 8 1 0.1845367E-01 -0.1991468E+00 0.0000000E+00 9 0 0.2306709E-01 -0.2489335E+00 0.0000000E+00 10 0 0.2768051E-01 -0.2987203E+00 0.0000000E+00 11 0 0.3229392E-01 -0.3485070E+00 0.0000000E+00 12 0 0.3690734E-01 -0.3982937E+00 0.0000000E+00 13 0 0.4152076E-01 -0.4480804E+00 0.0000000E+00 14 2 0.4613418E-01 -0.4978671E+00 0.0000000E+00 15 1 0.3674990E-01 -0.1965946E+00 0.0000000E+00 16 0 0.4593738E-01 -0.2457433E+00 0.0000000E+00 17 0 0.5512486E-01 -0.2948920E+00 0.0000000E+00 18 0 0.6431233E-01 -0.3440406E+00 0.0000000E+00 19 0 0.7349981E-01 -0.3931893E+00 0.0000000E+00 20 0 0.8268728E-01 -0.4423379E+00 0.0000000E+00 21 2 0.9187476E-01 -0.4914865E+00 0.0000000E+00 22 1 0.5473260E-01 -0.1923651E+00 0.0000000E+00 23 0 0.6841575E-01 -0.2404564E+00 0.0000000E+00 24 0 0.8209889E-01 -0.2885477E+00 0.0000000E+00 25 0 0.9578203E-01 -0.3366390E+00 0.0000000E+00 26 0 0.1094652E+00 -0.3847303E+00 0.0000000E+00 27 0 0.1231483E+00 -0.4328215E+00 0.0000000E+00 28 2 0.1368315E+00 -0.4809128E+00 0.0000000E+00 29 1 0.7224833E-01 -0.1864945E+00 0.0000000E+00 30 0 0.9031042E-01 -0.2331181E+00 0.0000000E+00 31 0 0.1083725E+00 -0.2797417E+00 0.0000000E+00 32 0 0.1264346E+00 -0.3263653E+00 0.0000000E+00 33 0 0.1444967E+00 -0.3729889E+00 0.0000000E+00 34 0 0.1625587E+00 -0.4196125E+00 0.0000000E+00 35 2 0.1806208E+00 -0.4662361E+00 0.0000000E+00 36 1 0.8914768E-01 -0.1790327E+00 0.0000000E+00 37 0 0.1114346E+00 -0.2237908E+00 0.0000000E+00 38 0 0.1337215E+00 -0.2685490E+00 0.0000000E+00 39 0 0.1560084E+00 -0.3133071E+00 0.0000000E+00 40 0 0.1782954E+00 -0.3580653E+00 0.0000000E+00 41 0 0.2005823E+00 -0.4028235E+00 0.0000000E+00 42 2 0.2228692E+00 -0.4475816E+00 0.0000000E+00 43 1 0.1052864E+00 -0.1700434E+00 0.0000000E+00 44 0 0.1316080E+00 -0.2125543E+00 0.0000000E+00 45 0 0.1579296E+00 -0.2550651E+00 0.0000000E+00 46 0 0.1842512E+00 -0.2975760E+00 0.0000000E+00 47 0 0.2105729E+00 -0.3400868E+00 0.0000000E+00 48 0 0.2368945E+00 -0.3825977E+00 0.0000000E+00 49 2 0.2632161E+00 -0.4251086E+00 0.0000000E+00 50 1 0.1205269E+00 -0.1596034E+00 0.0000000E+00 51 0 0.1506587E+00 -0.1995043E+00 0.0000000E+00 52 0 0.1807904E+00 -0.2394052E+00 0.0000000E+00 53 0 0.2109221E+00 -0.2793060E+00 0.0000000E+00 54 0 0.2410539E+00 -0.3192069E+00 0.0000000E+00 55 0 0.2711856E+00 -0.3591077E+00 0.0000000E+00 56 2 0.3013173E+00 -0.3990086E+00 0.0000000E+00 57 1 0.1347391E+00 -0.1478018E+00 0.0000000E+00 58 0 0.1684239E+00 -0.1847522E+00 0.0000000E+00 59 0 0.2021087E+00 -0.2217027E+00 0.0000000E+00 60 0 0.2357935E+00 -0.2586531E+00 0.0000000E+00 61 0 0.2694782E+00 -0.2956036E+00 0.0000000E+00 62 0 0.3031630E+00 -0.3325540E+00 0.0000000E+00 63 2 0.3368478E+00 -0.3695045E+00 0.0000000E+00 64 1 0.1478018E+00 -0.1347391E+00 0.0000000E+00 65 0 0.1847522E+00 -0.1684239E+00 0.0000000E+00 66 0 0.2217027E+00 -0.2021087E+00 0.0000000E+00 67 0 0.2586531E+00 -0.2357935E+00 0.0000000E+00 68 0 0.2956036E+00 -0.2694783E+00 0.0000000E+00 69 0 0.3325540E+00 -0.3031630E+00 0.0000000E+00 70 2 0.3695045E+00 -0.3368478E+00 0.0000000E+00 71 1 0.1596034E+00 -0.1205269E+00 0.0000000E+00 72 0 0.1995043E+00 -0.1506587E+00 0.0000000E+00 73 0 0.2394052E+00 -0.1807904E+00 0.0000000E+00 74 0 0.2793060E+00 -0.2109221E+00 0.0000000E+00 75 0 0.3192069E+00 -0.2410538E+00 0.0000000E+00 76 0 0.3591078E+00 -0.2711855E+00 0.0000000E+00 77 2 0.3990086E+00 -0.3013173E+00 0.0000000E+00 78 1 0.1700434E+00 -0.1052864E+00 0.0000000E+00 79 0 0.2125543E+00 -0.1316081E+00 0.0000000E+00 80 0 0.2550651E+00 -0.1579297E+00 0.0000000E+00 81 0 0.2975760E+00 -0.1842512E+00 0.0000000E+00 82 0 0.3400868E+00 -0.2105729E+00 0.0000000E+00 83 0 0.3825977E+00 -0.2368945E+00 0.0000000E+00 84 2 0.4251086E+00 -0.2632161E+00 0.0000000E+00 85 1 0.1790327E+00 -0.8914766E-01 0.0000000E+00 86 0 0.2237908E+00 -0.1114346E+00 0.0000000E+00 87 0 0.2685490E+00 -0.1337215E+00 0.0000000E+00 88 0 0.3133072E+00 -0.1560084E+00 0.0000000E+00 89 0 0.3580653E+00 -0.1782953E+00 0.0000000E+00 90 0 0.4028235E+00 -0.2005822E+00 0.0000000E+00 91 2 0.4475816E+00 -0.2228692E+00 0.0000000E+00 92 1 0.1864945E+00 -0.7224832E-01 0.0000000E+00 93 0 0.2331181E+00 -0.9031039E-01 0.0000000E+00 94 0 0.2797417E+00 -0.1083725E+00 0.0000000E+00 95 0 0.3263653E+00 -0.1264345E+00 0.0000000E+00 96 0 0.3729889E+00 -0.1444966E+00 0.0000000E+00 97 0 0.4196125E+00 -0.1625587E+00 0.0000000E+00 98 2 0.4662361E+00 -0.1806208E+00 0.0000000E+00 99 1 0.1923651E+00 -0.5473260E-01 0.0000000E+00 100 0 0.2404564E+00 -0.6841575E-01 0.0000000E+00 101 0 0.2885477E+00 -0.8209890E-01 0.0000000E+00 102 0 0.3366390E+00 -0.9578204E-01 0.0000000E+00 103 0 0.3847303E+00 -0.1094652E+00 0.0000000E+00 104 0 0.4328215E+00 -0.1231483E+00 0.0000000E+00 105 2 0.4809128E+00 -0.1368315E+00 0.0000000E+00 106 1 0.1965946E+00 -0.3674989E-01 0.0000000E+00 107 0 0.2457433E+00 -0.4593736E-01 0.0000000E+00 108 0 0.2948920E+00 -0.5512484E-01 0.0000000E+00 109 0 0.3440406E+00 -0.6431231E-01 0.0000000E+00 110 0 0.3931893E+00 -0.7349977E-01 0.0000000E+00 111 0 0.4423379E+00 -0.8268724E-01 0.0000000E+00 112 2 0.4914865E+00 -0.9187473E-01 0.0000000E+00 113 1 0.1991468E+00 -0.1845367E-01 0.0000000E+00 114 0 0.2489335E+00 -0.2306710E-01 0.0000000E+00 115 0 0.2987203E+00 -0.2768053E-01 0.0000000E+00 116 0 0.3485070E+00 -0.3229395E-01 0.0000000E+00 117 0 0.3982937E+00 -0.3690733E-01 0.0000000E+00 118 0 0.4480804E+00 -0.4152075E-01 0.0000000E+00 119 2 0.4978671E+00 -0.4613419E-01 0.0000000E+00 120 1 0.2000000E+00 0.0000000E+00 0.0000000E+00 121 0 0.2500000E+00 0.0000000E+00 0.0000000E+00 122 0 0.3000000E+00 0.0000000E+00 0.0000000E+00 123 0 0.3500000E+00 0.0000000E+00 0.0000000E+00 124 0 0.4000000E+00 0.1490116E-07 0.0000000E+00 125 0 0.4500000E+00 0.1490116E-07 0.0000000E+00 126 0 0.5000000E+00 0.0000000E+00 0.0000000E+00 127 1 0.1991468E+00 0.1845367E-01 0.0000000E+00 128 0 0.2489335E+00 0.2306709E-01 0.0000000E+00 129 0 0.2987202E+00 0.2768051E-01 0.0000000E+00 130 0 0.3485070E+00 0.3229393E-01 0.0000000E+00 131 0 0.3982936E+00 0.3690736E-01 0.0000000E+00 132 0 0.4480804E+00 0.4152077E-01 0.0000000E+00 133 2 0.4978671E+00 0.4613418E-01 0.0000000E+00 134 1 0.1965946E+00 0.3674990E-01 0.0000000E+00 135 0 0.2457433E+00 0.4593738E-01 0.0000000E+00 136 0 0.2948919E+00 0.5512486E-01 0.0000000E+00 137 0 0.3440406E+00 0.6431233E-01 0.0000000E+00 138 0 0.3931892E+00 0.7349982E-01 0.0000000E+00 139 0 0.4423379E+00 0.8268729E-01 0.0000000E+00 140 2 0.4914865E+00 0.9187476E-01 0.0000000E+00 141 1 0.1923651E+00 0.5473260E-01 0.0000000E+00 142 0 0.2404564E+00 0.6841575E-01 0.0000000E+00 143 0 0.2885477E+00 0.8209890E-01 0.0000000E+00 144 0 0.3366390E+00 0.9578204E-01 0.0000000E+00 145 0 0.3847302E+00 0.1094652E+00 0.0000000E+00 146 0 0.4328215E+00 0.1231484E+00 0.0000000E+00 147 2 0.4809128E+00 0.1368315E+00 0.0000000E+00 148 1 0.1864945E+00 0.7224833E-01 0.0000000E+00 149 0 0.2331181E+00 0.9031042E-01 0.0000000E+00 150 0 0.2797417E+00 0.1083725E+00 0.0000000E+00 151 0 0.3263653E+00 0.1264346E+00 0.0000000E+00 152 0 0.3729889E+00 0.1444967E+00 0.0000000E+00 153 0 0.4196125E+00 0.1625587E+00 0.0000000E+00 154 2 0.4662361E+00 0.1806208E+00 0.0000000E+00 155 1 0.1790327E+00 0.8914768E-01 0.0000000E+00 156 0 0.2237908E+00 0.1114346E+00 0.0000000E+00 157 0 0.2685490E+00 0.1337215E+00 0.0000000E+00 158 0 0.3133072E+00 0.1560084E+00 0.0000000E+00 159 0 0.3580653E+00 0.1782954E+00 0.0000000E+00 160 0 0.4028234E+00 0.2005823E+00 0.0000000E+00 161 2 0.4475816E+00 0.2228692E+00 0.0000000E+00 162 1 0.1700434E+00 0.1052864E+00 0.0000000E+00 163 0 0.2125543E+00 0.1316080E+00 0.0000000E+00 164 0 0.2550651E+00 0.1579297E+00 0.0000000E+00 165 0 0.2975760E+00 0.1842512E+00 0.0000000E+00 166 0 0.3400868E+00 0.2105729E+00 0.0000000E+00 167 0 0.3825977E+00 0.2368945E+00 0.0000000E+00 168 2 0.4251086E+00 0.2632161E+00 0.0000000E+00 169 1 0.1596034E+00 0.1205269E+00 0.0000000E+00 170 0 0.1995043E+00 0.1506587E+00 0.0000000E+00 171 0 0.2394051E+00 0.1807904E+00 0.0000000E+00 172 0 0.2793060E+00 0.2109222E+00 0.0000000E+00 173 0 0.3192069E+00 0.2410539E+00 0.0000000E+00 174 0 0.3591077E+00 0.2711856E+00 0.0000000E+00 175 2 0.3990086E+00 0.3013173E+00 0.0000000E+00 176 1 0.1478018E+00 0.1347391E+00 0.0000000E+00 177 0 0.1847522E+00 0.1684239E+00 0.0000000E+00 178 0 0.2217027E+00 0.2021087E+00 0.0000000E+00 179 0 0.2586531E+00 0.2357935E+00 0.0000000E+00 180 0 0.2956035E+00 0.2694783E+00 0.0000000E+00 181 0 0.3325540E+00 0.3031630E+00 0.0000000E+00 182 2 0.3695045E+00 0.3368478E+00 0.0000000E+00 183 1 0.1347391E+00 0.1478018E+00 0.0000000E+00 184 0 0.1684239E+00 0.1847522E+00 0.0000000E+00 185 0 0.2021087E+00 0.2217027E+00 0.0000000E+00 186 0 0.2357935E+00 0.2586531E+00 0.0000000E+00 187 0 0.2694782E+00 0.2956036E+00 0.0000000E+00 188 0 0.3031630E+00 0.3325540E+00 0.0000000E+00 189 2 0.3368478E+00 0.3695045E+00 0.0000000E+00 190 1 0.1205269E+00 0.1596034E+00 0.0000000E+00 191 0 0.1506587E+00 0.1995043E+00 0.0000000E+00 192 0 0.1807904E+00 0.2394052E+00 0.0000000E+00 193 0 0.2109221E+00 0.2793060E+00 0.0000000E+00 194 0 0.2410538E+00 0.3192069E+00 0.0000000E+00 195 0 0.2711855E+00 0.3591078E+00 0.0000000E+00 196 2 0.3013173E+00 0.3990086E+00 0.0000000E+00 197 1 0.1052864E+00 0.1700434E+00 0.0000000E+00 198 0 0.1316081E+00 0.2125543E+00 0.0000000E+00 199 0 0.1579297E+00 0.2550651E+00 0.0000000E+00 200 0 0.1842513E+00 0.2975760E+00 0.0000000E+00 201 0 0.2105729E+00 0.3400868E+00 0.0000000E+00 202 0 0.2368945E+00 0.3825977E+00 0.0000000E+00 203 2 0.2632161E+00 0.4251086E+00 0.0000000E+00 204 1 0.8914766E-01 0.1790327E+00 0.0000000E+00 205 0 0.1114346E+00 0.2237908E+00 0.0000000E+00 206 0 0.1337215E+00 0.2685490E+00 0.0000000E+00 207 0 0.1560084E+00 0.3133072E+00 0.0000000E+00 208 0 0.1782953E+00 0.3580653E+00 0.0000000E+00 209 0 0.2005823E+00 0.4028235E+00 0.0000000E+00 210 2 0.2228692E+00 0.4475816E+00 0.0000000E+00 211 1 0.7224832E-01 0.1864945E+00 0.0000000E+00 212 0 0.9031039E-01 0.2331181E+00 0.0000000E+00 213 0 0.1083725E+00 0.2797417E+00 0.0000000E+00 214 0 0.1264345E+00 0.3263653E+00 0.0000000E+00 215 0 0.1444966E+00 0.3729889E+00 0.0000000E+00 216 0 0.1625587E+00 0.4196125E+00 0.0000000E+00 217 2 0.1806208E+00 0.4662361E+00 0.0000000E+00 218 1 0.5473260E-01 0.1923651E+00 0.0000000E+00 219 0 0.6841576E-01 0.2404564E+00 0.0000000E+00 220 0 0.8209892E-01 0.2885477E+00 0.0000000E+00 221 0 0.9578209E-01 0.3366390E+00 0.0000000E+00 222 0 0.1094652E+00 0.3847303E+00 0.0000000E+00 223 0 0.1231483E+00 0.4328215E+00 0.0000000E+00 224 2 0.1368315E+00 0.4809128E+00 0.0000000E+00 225 1 0.3674989E-01 0.1965946E+00 0.0000000E+00 226 0 0.4593736E-01 0.2457433E+00 0.0000000E+00 227 0 0.5512484E-01 0.2948920E+00 0.0000000E+00 228 0 0.6431231E-01 0.3440406E+00 0.0000000E+00 229 0 0.7349978E-01 0.3931893E+00 0.0000000E+00 230 0 0.8268725E-01 0.4423379E+00 0.0000000E+00 231 2 0.9187473E-01 0.4914865E+00 0.0000000E+00 232 1 0.1845367E-01 0.1991468E+00 0.0000000E+00 233 0 0.2306709E-01 0.2489335E+00 0.0000000E+00 234 0 0.2768051E-01 0.2987203E+00 0.0000000E+00 235 0 0.3229393E-01 0.3485070E+00 0.0000000E+00 236 0 0.3690735E-01 0.3982937E+00 0.0000000E+00 237 0 0.4152076E-01 0.4480804E+00 0.0000000E+00 238 2 0.4613419E-01 0.4978671E+00 0.0000000E+00 239 1 0.0000000E+00 0.2000000E+00 0.0000000E+00 240 0 0.0000000E+00 0.2500000E+00 0.0000000E+00 241 0 0.0000000E+00 0.3000000E+00 0.0000000E+00 242 0 0.0000000E+00 0.3500000E+00 0.0000000E+00 243 0 0.0000000E+00 0.4000000E+00 0.0000000E+00 244 0 0.0000000E+00 0.4500000E+00 0.0000000E+00 245 0 0.0000000E+00 0.5000000E+00 0.0000000E+00 246 0 0.0000000E+00 -0.1000000E+01 0.0000000E+00 247 0 0.0000000E+00 -0.1050000E+01 0.0000000E+00 248 0 0.0000000E+00 -0.1100000E+01 0.0000000E+00 249 0 0.0000000E+00 -0.1150000E+01 0.0000000E+00 250 0 0.0000000E+00 -0.1200000E+01 0.0000000E+00 251 0 0.0000000E+00 -0.1250000E+01 0.0000000E+00 252 4 0.0000000E+00 -0.1300000E+01 0.0000000E+00 253 3 0.6279052E-01 -0.9980267E+00 0.0000000E+00 254 0 0.6593004E-01 -0.1047928E+01 0.0000000E+00 255 0 0.6906958E-01 -0.1097829E+01 0.0000000E+00 256 0 0.7220910E-01 -0.1147731E+01 0.0000000E+00 257 0 0.7534863E-01 -0.1197632E+01 0.0000000E+00 258 0 0.7848816E-01 -0.1247533E+01 0.0000000E+00 259 4 0.8162767E-01 -0.1297435E+01 0.0000000E+00 260 3 0.1253332E+00 -0.9921147E+00 0.0000000E+00 261 0 0.1315999E+00 -0.1041720E+01 0.0000000E+00 262 0 0.1378666E+00 -0.1091326E+01 0.0000000E+00 263 0 0.1441332E+00 -0.1140932E+01 0.0000000E+00 264 0 0.1503999E+00 -0.1190538E+01 0.0000000E+00 265 0 0.1566665E+00 -0.1240143E+01 0.0000000E+00 266 4 0.1629332E+00 -0.1289749E+01 0.0000000E+00 267 3 0.1873813E+00 -0.9822872E+00 0.0000000E+00 268 0 0.1967504E+00 -0.1031402E+01 0.0000000E+00 269 0 0.2061195E+00 -0.1080516E+01 0.0000000E+00 270 0 0.2154885E+00 -0.1129630E+01 0.0000000E+00 271 0 0.2248576E+00 -0.1178745E+01 0.0000000E+00 272 0 0.2342267E+00 -0.1227859E+01 0.0000000E+00 273 4 0.2435957E+00 -0.1276973E+01 0.0000000E+00 274 3 0.2486899E+00 -0.9685832E+00 0.0000000E+00 275 0 0.2611244E+00 -0.1017012E+01 0.0000000E+00 276 0 0.2735589E+00 -0.1065441E+01 0.0000000E+00 277 0 0.2859934E+00 -0.1113871E+01 0.0000000E+00 278 0 0.2984279E+00 -0.1162300E+01 0.0000000E+00 279 0 0.3108624E+00 -0.1210729E+01 0.0000000E+00 280 4 0.3232968E+00 -0.1259158E+01 0.0000000E+00 281 3 0.3090170E+00 -0.9510565E+00 0.0000000E+00 282 0 0.3244678E+00 -0.9986093E+00 0.0000000E+00 283 0 0.3399187E+00 -0.1046162E+01 0.0000000E+00 284 0 0.3553696E+00 -0.1093715E+01 0.0000000E+00 285 0 0.3708204E+00 -0.1141268E+01 0.0000000E+00 286 0 0.3862713E+00 -0.1188821E+01 0.0000000E+00 287 4 0.4017221E+00 -0.1236373E+01 0.0000000E+00 288 3 0.3681245E+00 -0.9297765E+00 0.0000000E+00 289 0 0.3865308E+00 -0.9762653E+00 0.0000000E+00 290 0 0.4049371E+00 -0.1022754E+01 0.0000000E+00 291 0 0.4233432E+00 -0.1069243E+01 0.0000000E+00 292 0 0.4417494E+00 -0.1115732E+01 0.0000000E+00 293 0 0.4601557E+00 -0.1162221E+01 0.0000000E+00 294 4 0.4785619E+00 -0.1208709E+01 0.0000000E+00 295 3 0.4257793E+00 -0.9048271E+00 0.0000000E+00 296 0 0.4470682E+00 -0.9500684E+00 0.0000000E+00 297 0 0.4683572E+00 -0.9953098E+00 0.0000000E+00 298 0 0.4896462E+00 -0.1040551E+01 0.0000000E+00 299 0 0.5109351E+00 -0.1085792E+01 0.0000000E+00 300 0 0.5322241E+00 -0.1131034E+01 0.0000000E+00 301 4 0.5535131E+00 -0.1176275E+01 0.0000000E+00 302 3 0.4817537E+00 -0.8763067E+00 0.0000000E+00 303 0 0.5058414E+00 -0.9201219E+00 0.0000000E+00 304 0 0.5299291E+00 -0.9639373E+00 0.0000000E+00 305 0 0.5540168E+00 -0.1007753E+01 0.0000000E+00 306 0 0.5781044E+00 -0.1051568E+01 0.0000000E+00 307 0 0.6021921E+00 -0.1095383E+01 0.0000000E+00 308 4 0.6262798E+00 -0.1139199E+01 0.0000000E+00 309 3 0.5358268E+00 -0.8443279E+00 0.0000000E+00 310 0 0.5626181E+00 -0.8865442E+00 0.0000000E+00 311 0 0.5894095E+00 -0.9287607E+00 0.0000000E+00 312 0 0.6162008E+00 -0.9709771E+00 0.0000000E+00 313 0 0.6429922E+00 -0.1013193E+01 0.0000000E+00 314 0 0.6697835E+00 -0.1055410E+01 0.0000000E+00 315 4 0.6965748E+00 -0.1097626E+01 0.0000000E+00 316 3 0.5877852E+00 -0.8090170E+00 0.0000000E+00 317 0 0.6171745E+00 -0.8494678E+00 0.0000000E+00 318 0 0.6465638E+00 -0.8899187E+00 0.0000000E+00 319 0 0.6759530E+00 -0.9303695E+00 0.0000000E+00 320 0 0.7053423E+00 -0.9708203E+00 0.0000000E+00 321 0 0.7347316E+00 -0.1011271E+01 0.0000000E+00 322 4 0.7641208E+00 -0.1051722E+01 0.0000000E+00 323 3 0.6374241E+00 -0.7705132E+00 0.0000000E+00 324 0 0.6692953E+00 -0.8090388E+00 0.0000000E+00 325 0 0.7011665E+00 -0.8475645E+00 0.0000000E+00 326 0 0.7330377E+00 -0.8860902E+00 0.0000000E+00 327 0 0.7649088E+00 -0.9246158E+00 0.0000000E+00 328 0 0.7967800E+00 -0.9631415E+00 0.0000000E+00 329 4 0.8286512E+00 -0.1001667E+01 0.0000000E+00 330 3 0.6845471E+00 -0.7289686E+00 0.0000000E+00 331 0 0.7187745E+00 -0.7654170E+00 0.0000000E+00 332 0 0.7530019E+00 -0.8018655E+00 0.0000000E+00 333 0 0.7872292E+00 -0.8383139E+00 0.0000000E+00 334 0 0.8214565E+00 -0.8747623E+00 0.0000000E+00 335 0 0.8556839E+00 -0.9112108E+00 0.0000000E+00 336 4 0.8899112E+00 -0.9476592E+00 0.0000000E+00 337 3 0.7289687E+00 -0.6845471E+00 0.0000000E+00 338 0 0.7654171E+00 -0.7187744E+00 0.0000000E+00 339 0 0.8018656E+00 -0.7530017E+00 0.0000000E+00 340 0 0.8383139E+00 -0.7872291E+00 0.0000000E+00 341 0 0.8747624E+00 -0.8214564E+00 0.0000000E+00 342 0 0.9112108E+00 -0.8556838E+00 0.0000000E+00 343 4 0.9476592E+00 -0.8899112E+00 0.0000000E+00 344 3 0.7705132E+00 -0.6374240E+00 0.0000000E+00 345 0 0.8090389E+00 -0.6692951E+00 0.0000000E+00 346 0 0.8475646E+00 -0.7011664E+00 0.0000000E+00 347 0 0.8860902E+00 -0.7330376E+00 0.0000000E+00 348 0 0.9246158E+00 -0.7649087E+00 0.0000000E+00 349 0 0.9631416E+00 -0.7967799E+00 0.0000000E+00 350 4 0.1001667E+01 -0.8286511E+00 0.0000000E+00 351 3 0.8090170E+00 -0.5877852E+00 0.0000000E+00 352 0 0.8494678E+00 -0.6171744E+00 0.0000000E+00 353 0 0.8899187E+00 -0.6465637E+00 0.0000000E+00 354 0 0.9303696E+00 -0.6759529E+00 0.0000000E+00 355 0 0.9708203E+00 -0.7053422E+00 0.0000000E+00 356 0 0.1011271E+01 -0.7347315E+00 0.0000000E+00 357 4 0.1051722E+01 -0.7641208E+00 0.0000000E+00 358 3 0.8443279E+00 -0.5358267E+00 0.0000000E+00 359 0 0.8865443E+00 -0.5626180E+00 0.0000000E+00 360 0 0.9287608E+00 -0.5894095E+00 0.0000000E+00 361 0 0.9709771E+00 -0.6162007E+00 0.0000000E+00 362 0 0.1013193E+01 -0.6429920E+00 0.0000000E+00 363 0 0.1055410E+01 -0.6697834E+00 0.0000000E+00 364 4 0.1097626E+01 -0.6965747E+00 0.0000000E+00 365 3 0.8763067E+00 -0.4817536E+00 0.0000000E+00 366 0 0.9201220E+00 -0.5058413E+00 0.0000000E+00 367 0 0.9639374E+00 -0.5299289E+00 0.0000000E+00 368 0 0.1007753E+01 -0.5540166E+00 0.0000000E+00 369 0 0.1051568E+01 -0.5781043E+00 0.0000000E+00 370 0 0.1095383E+01 -0.6021920E+00 0.0000000E+00 371 4 0.1139199E+01 -0.6262797E+00 0.0000000E+00 372 3 0.9048271E+00 -0.4257793E+00 0.0000000E+00 373 0 0.9500684E+00 -0.4470682E+00 0.0000000E+00 374 0 0.9953098E+00 -0.4683572E+00 0.0000000E+00 375 0 0.1040551E+01 -0.4896462E+00 0.0000000E+00 376 0 0.1085792E+01 -0.5109351E+00 0.0000000E+00 377 0 0.1131034E+01 -0.5322241E+00 0.0000000E+00 378 4 0.1176275E+01 -0.5535131E+00 0.0000000E+00 379 3 0.9297765E+00 -0.3681245E+00 0.0000000E+00 380 0 0.9762653E+00 -0.3865308E+00 0.0000000E+00 381 0 0.1022754E+01 -0.4049370E+00 0.0000000E+00 382 0 0.1069243E+01 -0.4233432E+00 0.0000000E+00 383 0 0.1115732E+01 -0.4417493E+00 0.0000000E+00 384 0 0.1162221E+01 -0.4601556E+00 0.0000000E+00 385 4 0.1208709E+01 -0.4785619E+00 0.0000000E+00 386 3 0.9510565E+00 -0.3090170E+00 0.0000000E+00 387 0 0.9986093E+00 -0.3244678E+00 0.0000000E+00 388 0 0.1046162E+01 -0.3399186E+00 0.0000000E+00 389 0 0.1093715E+01 -0.3553694E+00 0.0000000E+00 390 0 0.1141268E+01 -0.3708203E+00 0.0000000E+00 391 0 0.1188821E+01 -0.3862712E+00 0.0000000E+00 392 4 0.1236373E+01 -0.4017220E+00 0.0000000E+00 393 3 0.9685832E+00 -0.2486898E+00 0.0000000E+00 394 0 0.1017012E+01 -0.2611243E+00 0.0000000E+00 395 0 0.1065441E+01 -0.2735588E+00 0.0000000E+00 396 0 0.1113871E+01 -0.2859932E+00 0.0000000E+00 397 0 0.1162300E+01 -0.2984278E+00 0.0000000E+00 398 0 0.1210729E+01 -0.3108623E+00 0.0000000E+00 399 4 0.1259158E+01 -0.3232968E+00 0.0000000E+00 400 3 0.9822873E+00 -0.1873812E+00 0.0000000E+00 401 0 0.1031402E+01 -0.1967502E+00 0.0000000E+00 402 0 0.1080516E+01 -0.2061193E+00 0.0000000E+00 403 0 0.1129630E+01 -0.2154883E+00 0.0000000E+00 404 0 0.1178745E+01 -0.2248574E+00 0.0000000E+00 405 0 0.1227859E+01 -0.2342266E+00 0.0000000E+00 406 4 0.1276973E+01 -0.2435956E+00 0.0000000E+00 407 3 0.9921147E+00 -0.1253332E+00 0.0000000E+00 408 0 0.1041720E+01 -0.1315998E+00 0.0000000E+00 409 0 0.1091326E+01 -0.1378666E+00 0.0000000E+00 410 0 0.1140932E+01 -0.1441332E+00 0.0000000E+00 411 0 0.1190538E+01 -0.1503998E+00 0.0000000E+00 412 0 0.1240143E+01 -0.1566666E+00 0.0000000E+00 413 4 0.1289749E+01 -0.1629332E+00 0.0000000E+00 414 3 0.9980267E+00 -0.6279050E-01 0.0000000E+00 415 0 0.1047928E+01 -0.6592996E-01 0.0000000E+00 416 0 0.1097829E+01 -0.6906953E-01 0.0000000E+00 417 0 0.1147731E+01 -0.7220900E-01 0.0000000E+00 418 0 0.1197632E+01 -0.7534858E-01 0.0000000E+00 419 0 0.1247533E+01 -0.7848818E-01 0.0000000E+00 420 4 0.1297435E+01 -0.8162765E-01 0.0000000E+00 421 0 0.1000000E+01 0.0000000E+00 0.0000000E+00 422 0 0.1050000E+01 0.6081736E-07 0.0000000E+00 423 0 0.1100000E+01 0.1871313E-07 0.0000000E+00 424 0 0.1150000E+01 0.7485222E-07 0.0000000E+00 425 0 0.1200000E+01 0.1871302E-07 0.0000000E+00 426 0 0.1250000E+01 -0.4678256E-07 0.0000000E+00 427 4 0.1300000E+01 0.0000000E+00 0.0000000E+00 428 3 0.9980267E+00 0.6279052E-01 0.0000000E+00 429 0 0.1047928E+01 0.6593012E-01 0.0000000E+00 430 0 0.1097829E+01 0.6906953E-01 0.0000000E+00 431 0 0.1147731E+01 0.7220913E-01 0.0000000E+00 432 0 0.1197632E+01 0.7534872E-01 0.0000000E+00 433 0 0.1247533E+01 0.7848809E-01 0.0000000E+00 434 4 0.1297435E+01 0.8162767E-01 0.0000000E+00 435 3 0.9921147E+00 0.1253332E+00 0.0000000E+00 436 0 0.1041720E+01 0.1315999E+00 0.0000000E+00 437 0 0.1091326E+01 0.1378666E+00 0.0000000E+00 438 0 0.1140932E+01 0.1441331E+00 0.0000000E+00 439 0 0.1190538E+01 0.1503998E+00 0.0000000E+00 440 0 0.1240143E+01 0.1566665E+00 0.0000000E+00 441 4 0.1289749E+01 0.1629332E+00 0.0000000E+00 442 3 0.9822872E+00 0.1873813E+00 0.0000000E+00 443 0 0.1031402E+01 0.1967504E+00 0.0000000E+00 444 0 0.1080516E+01 0.2061194E+00 0.0000000E+00 445 0 0.1129630E+01 0.2154885E+00 0.0000000E+00 446 0 0.1178745E+01 0.2248577E+00 0.0000000E+00 447 0 0.1227859E+01 0.2342266E+00 0.0000000E+00 448 4 0.1276973E+01 0.2435957E+00 0.0000000E+00 449 3 0.9685832E+00 0.2486899E+00 0.0000000E+00 450 0 0.1017012E+01 0.2611244E+00 0.0000000E+00 451 0 0.1065441E+01 0.2735590E+00 0.0000000E+00 452 0 0.1113871E+01 0.2859935E+00 0.0000000E+00 453 0 0.1162300E+01 0.2984278E+00 0.0000000E+00 454 0 0.1210729E+01 0.3108623E+00 0.0000000E+00 455 4 0.1259158E+01 0.3232968E+00 0.0000000E+00 456 3 0.9510565E+00 0.3090170E+00 0.0000000E+00 457 0 0.9986093E+00 0.3244678E+00 0.0000000E+00 458 0 0.1046162E+01 0.3399187E+00 0.0000000E+00 459 0 0.1093715E+01 0.3553696E+00 0.0000000E+00 460 0 0.1141268E+01 0.3708204E+00 0.0000000E+00 461 0 0.1188821E+01 0.3862713E+00 0.0000000E+00 462 4 0.1236373E+01 0.4017221E+00 0.0000000E+00 463 3 0.9297765E+00 0.3681245E+00 0.0000000E+00 464 0 0.9762653E+00 0.3865308E+00 0.0000000E+00 465 0 0.1022754E+01 0.4049370E+00 0.0000000E+00 466 0 0.1069243E+01 0.4233432E+00 0.0000000E+00 467 0 0.1115732E+01 0.4417494E+00 0.0000000E+00 468 0 0.1162221E+01 0.4601557E+00 0.0000000E+00 469 4 0.1208709E+01 0.4785619E+00 0.0000000E+00 470 3 0.9048271E+00 0.4257793E+00 0.0000000E+00 471 0 0.9500684E+00 0.4470683E+00 0.0000000E+00 472 0 0.9953098E+00 0.4683573E+00 0.0000000E+00 473 0 0.1040551E+01 0.4896461E+00 0.0000000E+00 474 0 0.1085792E+01 0.5109351E+00 0.0000000E+00 475 0 0.1131034E+01 0.5322241E+00 0.0000000E+00 476 4 0.1176275E+01 0.5535131E+00 0.0000000E+00 477 3 0.8763067E+00 0.4817537E+00 0.0000000E+00 478 0 0.9201219E+00 0.5058414E+00 0.0000000E+00 479 0 0.9639373E+00 0.5299290E+00 0.0000000E+00 480 0 0.1007753E+01 0.5540168E+00 0.0000000E+00 481 0 0.1051568E+01 0.5781045E+00 0.0000000E+00 482 0 0.1095383E+01 0.6021920E+00 0.0000000E+00 483 4 0.1139199E+01 0.6262798E+00 0.0000000E+00 484 3 0.8443279E+00 0.5358268E+00 0.0000000E+00 485 0 0.8865443E+00 0.5626181E+00 0.0000000E+00 486 0 0.9287607E+00 0.5894095E+00 0.0000000E+00 487 0 0.9709771E+00 0.6162008E+00 0.0000000E+00 488 0 0.1013193E+01 0.6429921E+00 0.0000000E+00 489 0 0.1055410E+01 0.6697835E+00 0.0000000E+00 490 4 0.1097626E+01 0.6965748E+00 0.0000000E+00 491 3 0.8090170E+00 0.5877852E+00 0.0000000E+00 492 0 0.8494678E+00 0.6171744E+00 0.0000000E+00 493 0 0.8899187E+00 0.6465637E+00 0.0000000E+00 494 0 0.9303695E+00 0.6759531E+00 0.0000000E+00 495 0 0.9708203E+00 0.7053423E+00 0.0000000E+00 496 0 0.1011271E+01 0.7347316E+00 0.0000000E+00 497 4 0.1051722E+01 0.7641208E+00 0.0000000E+00 498 3 0.7705132E+00 0.6374241E+00 0.0000000E+00 499 0 0.8090389E+00 0.6692952E+00 0.0000000E+00 500 0 0.8475646E+00 0.7011665E+00 0.0000000E+00 501 0 0.8860902E+00 0.7330376E+00 0.0000000E+00 502 0 0.9246158E+00 0.7649088E+00 0.0000000E+00 503 0 0.9631415E+00 0.7967800E+00 0.0000000E+00 504 4 0.1001667E+01 0.8286512E+00 0.0000000E+00 505 3 0.7289686E+00 0.6845471E+00 0.0000000E+00 506 0 0.7654170E+00 0.7187744E+00 0.0000000E+00 507 0 0.8018656E+00 0.7530018E+00 0.0000000E+00 508 0 0.8383138E+00 0.7872292E+00 0.0000000E+00 509 0 0.8747622E+00 0.8214566E+00 0.0000000E+00 510 0 0.9112108E+00 0.8556839E+00 0.0000000E+00 511 4 0.9476592E+00 0.8899112E+00 0.0000000E+00 512 3 0.6845471E+00 0.7289687E+00 0.0000000E+00 513 0 0.7187744E+00 0.7654170E+00 0.0000000E+00 514 0 0.7530019E+00 0.8018655E+00 0.0000000E+00 515 0 0.7872292E+00 0.8383138E+00 0.0000000E+00 516 0 0.8214564E+00 0.8747624E+00 0.0000000E+00 517 0 0.8556839E+00 0.9112108E+00 0.0000000E+00 518 4 0.8899112E+00 0.9476592E+00 0.0000000E+00 519 3 0.6374240E+00 0.7705132E+00 0.0000000E+00 520 0 0.6692952E+00 0.8090388E+00 0.0000000E+00 521 0 0.7011664E+00 0.8475646E+00 0.0000000E+00 522 0 0.7330376E+00 0.8860902E+00 0.0000000E+00 523 0 0.7649088E+00 0.9246157E+00 0.0000000E+00 524 0 0.7967799E+00 0.9631416E+00 0.0000000E+00 525 4 0.8286511E+00 0.1001667E+01 0.0000000E+00 526 3 0.5877852E+00 0.8090170E+00 0.0000000E+00 527 0 0.6171745E+00 0.8494678E+00 0.0000000E+00 528 0 0.6465638E+00 0.8899187E+00 0.0000000E+00 529 0 0.6759529E+00 0.9303696E+00 0.0000000E+00 530 0 0.7053422E+00 0.9708204E+00 0.0000000E+00 531 0 0.7347315E+00 0.1011271E+01 0.0000000E+00 532 4 0.7641208E+00 0.1051722E+01 0.0000000E+00 533 3 0.5358267E+00 0.8443279E+00 0.0000000E+00 534 0 0.5626181E+00 0.8865443E+00 0.0000000E+00 535 0 0.5894095E+00 0.9287607E+00 0.0000000E+00 536 0 0.6162008E+00 0.9709771E+00 0.0000000E+00 537 0 0.6429920E+00 0.1013193E+01 0.0000000E+00 538 0 0.6697834E+00 0.1055410E+01 0.0000000E+00 539 4 0.6965747E+00 0.1097626E+01 0.0000000E+00 540 3 0.4817536E+00 0.8763067E+00 0.0000000E+00 541 0 0.5058413E+00 0.9201220E+00 0.0000000E+00 542 0 0.5299290E+00 0.9639374E+00 0.0000000E+00 543 0 0.5540166E+00 0.1007753E+01 0.0000000E+00 544 0 0.5781043E+00 0.1051568E+01 0.0000000E+00 545 0 0.6021920E+00 0.1095383E+01 0.0000000E+00 546 4 0.6262797E+00 0.1139199E+01 0.0000000E+00 547 3 0.4257793E+00 0.9048271E+00 0.0000000E+00 548 0 0.4470683E+00 0.9500684E+00 0.0000000E+00 549 0 0.4683573E+00 0.9953098E+00 0.0000000E+00 550 0 0.4896463E+00 0.1040551E+01 0.0000000E+00 551 0 0.5109351E+00 0.1085792E+01 0.0000000E+00 552 0 0.5322241E+00 0.1131034E+01 0.0000000E+00 553 4 0.5535131E+00 0.1176275E+01 0.0000000E+00 554 3 0.3681245E+00 0.9297765E+00 0.0000000E+00 555 0 0.3865308E+00 0.9762653E+00 0.0000000E+00 556 0 0.4049371E+00 0.1022754E+01 0.0000000E+00 557 0 0.4233431E+00 0.1069243E+01 0.0000000E+00 558 0 0.4417494E+00 0.1115732E+01 0.0000000E+00 559 0 0.4601556E+00 0.1162221E+01 0.0000000E+00 560 4 0.4785619E+00 0.1208709E+01 0.0000000E+00 561 3 0.3090170E+00 0.9510565E+00 0.0000000E+00 562 0 0.3244678E+00 0.9986093E+00 0.0000000E+00 563 0 0.3399187E+00 0.1046162E+01 0.0000000E+00 564 0 0.3553695E+00 0.1093715E+01 0.0000000E+00 565 0 0.3708203E+00 0.1141268E+01 0.0000000E+00 566 0 0.3862712E+00 0.1188821E+01 0.0000000E+00 567 4 0.4017220E+00 0.1236373E+01 0.0000000E+00 568 3 0.2486898E+00 0.9685832E+00 0.0000000E+00 569 0 0.2611243E+00 0.1017012E+01 0.0000000E+00 570 0 0.2735588E+00 0.1065441E+01 0.0000000E+00 571 0 0.2859933E+00 0.1113871E+01 0.0000000E+00 572 0 0.2984278E+00 0.1162300E+01 0.0000000E+00 573 0 0.3108623E+00 0.1210729E+01 0.0000000E+00 574 4 0.3232968E+00 0.1259158E+01 0.0000000E+00 575 3 0.1873812E+00 0.9822873E+00 0.0000000E+00 576 0 0.1967502E+00 0.1031402E+01 0.0000000E+00 577 0 0.2061193E+00 0.1080516E+01 0.0000000E+00 578 0 0.2154883E+00 0.1129630E+01 0.0000000E+00 579 0 0.2248575E+00 0.1178745E+01 0.0000000E+00 580 0 0.2342266E+00 0.1227859E+01 0.0000000E+00 581 4 0.2435956E+00 0.1276973E+01 0.0000000E+00 582 3 0.1253332E+00 0.9921147E+00 0.0000000E+00 583 0 0.1315999E+00 0.1041720E+01 0.0000000E+00 584 0 0.1378666E+00 0.1091326E+01 0.0000000E+00 585 0 0.1441332E+00 0.1140932E+01 0.0000000E+00 586 0 0.1503999E+00 0.1190538E+01 0.0000000E+00 587 0 0.1566665E+00 0.1240143E+01 0.0000000E+00 588 4 0.1629332E+00 0.1289749E+01 0.0000000E+00 589 3 0.6279050E-01 0.9980267E+00 0.0000000E+00 590 0 0.6593002E-01 0.1047928E+01 0.0000000E+00 591 0 0.6906955E-01 0.1097829E+01 0.0000000E+00 592 0 0.7220908E-01 0.1147731E+01 0.0000000E+00 593 0 0.7534860E-01 0.1197632E+01 0.0000000E+00 594 0 0.7848813E-01 0.1247533E+01 0.0000000E+00 595 4 0.8162765E-01 0.1297435E+01 0.0000000E+00 596 0 0.0000000E+00 0.1000000E+01 0.0000000E+00 597 0 0.0000000E+00 0.1050000E+01 0.0000000E+00 598 0 0.0000000E+00 0.1100000E+01 0.0000000E+00 599 0 0.0000000E+00 0.1150000E+01 0.0000000E+00 600 0 0.0000000E+00 0.1200000E+01 0.0000000E+00 601 0 0.0000000E+00 0.1250000E+01 0.0000000E+00 602 4 0.0000000E+00 0.1300000E+01 0.0000000E+00 603 0 0.1153354E-01 -0.2244668E+00 0.0000000E+00 604 0 0.2076038E-01 -0.2240402E+00 0.0000000E+00 605 1 0.9226836E-02 -0.1995734E+00 0.0000000E+00 606 0 0.0000000E+00 -0.2250000E+00 0.0000000E+00 607 0 0.1153354E-01 -0.2494668E+00 0.0000000E+00 608 0 0.0000000E+00 -0.2750000E+00 0.0000000E+00 609 0 0.1153354E-01 -0.2744668E+00 0.0000000E+00 610 0 0.1384025E-01 -0.2993601E+00 0.0000000E+00 611 0 0.2537380E-01 -0.2738269E+00 0.0000000E+00 612 0 0.0000000E+00 -0.3250000E+00 0.0000000E+00 613 0 0.1384025E-01 -0.3243601E+00 0.0000000E+00 614 0 0.1614696E-01 -0.3492535E+00 0.0000000E+00 615 0 0.2998721E-01 -0.3236136E+00 0.0000000E+00 616 0 0.0000000E+00 -0.3750000E+00 0.0000000E+00 617 0 0.1614696E-01 -0.3742535E+00 0.0000000E+00 618 0 0.1845367E-01 -0.3991468E+00 0.0000000E+00 619 0 0.3460063E-01 -0.3734003E+00 0.0000000E+00 620 0 0.0000000E+00 -0.4250000E+00 0.0000000E+00 621 0 0.1845367E-01 -0.4241468E+00 0.0000000E+00 622 0 0.2076038E-01 -0.4490402E+00 0.0000000E+00 623 0 0.3921405E-01 -0.4231870E+00 0.0000000E+00 624 0 0.0000000E+00 -0.4750000E+00 0.0000000E+00 625 0 0.2076038E-01 -0.4740402E+00 0.0000000E+00 626 2 0.2306709E-01 -0.4989335E+00 0.0000000E+00 627 0 0.4382747E-01 -0.4729737E+00 0.0000000E+00 628 0 0.2990850E-01 -0.2227641E+00 0.0000000E+00 629 1 0.2760179E-01 -0.1978707E+00 0.0000000E+00 630 0 0.3450223E-01 -0.2473384E+00 0.0000000E+00 631 0 0.4134364E-01 -0.2211690E+00 0.0000000E+00 632 0 0.3680894E-01 -0.2722318E+00 0.0000000E+00 633 0 0.4140268E-01 -0.2968061E+00 0.0000000E+00 634 0 0.5053112E-01 -0.2703176E+00 0.0000000E+00 635 0 0.4370939E-01 -0.3216995E+00 0.0000000E+00 636 0 0.4830313E-01 -0.3462738E+00 0.0000000E+00 637 0 0.5971860E-01 -0.3194663E+00 0.0000000E+00 638 0 0.5060983E-01 -0.3711671E+00 0.0000000E+00 639 0 0.5520357E-01 -0.3957415E+00 0.0000000E+00 640 0 0.6890607E-01 -0.3686149E+00 0.0000000E+00 641 0 0.5751028E-01 -0.4206348E+00 0.0000000E+00 642 0 0.6210402E-01 -0.4452091E+00 0.0000000E+00 643 0 0.7809354E-01 -0.4177636E+00 0.0000000E+00 644 0 0.6441073E-01 -0.4701025E+00 0.0000000E+00 645 2 0.6900447E-01 -0.4946768E+00 0.0000000E+00 646 0 0.8728102E-01 -0.4669122E+00 0.0000000E+00 647 0 0.5033499E-01 -0.2190542E+00 0.0000000E+00 648 1 0.4574125E-01 -0.1944799E+00 0.0000000E+00 649 0 0.5717656E-01 -0.2430998E+00 0.0000000E+00 650 0 0.6157417E-01 -0.2164108E+00 0.0000000E+00 651 0 0.6177030E-01 -0.2676742E+00 0.0000000E+00 652 0 0.6861188E-01 -0.2917198E+00 0.0000000E+00 653 0 0.7525732E-01 -0.2645020E+00 0.0000000E+00 654 0 0.7320561E-01 -0.3162941E+00 0.0000000E+00 655 0 0.8004718E-01 -0.3403398E+00 0.0000000E+00 656 0 0.8894046E-01 -0.3125933E+00 0.0000000E+00 657 0 0.8464092E-01 -0.3649141E+00 0.0000000E+00 658 0 0.9148250E-01 -0.3889598E+00 0.0000000E+00 659 0 0.1026236E+00 -0.3606846E+00 0.0000000E+00 660 0 0.9607624E-01 -0.4135341E+00 0.0000000E+00 661 0 0.1029178E+00 -0.4375797E+00 0.0000000E+00 662 0 0.1163068E+00 -0.4087759E+00 0.0000000E+00 663 0 0.1075115E+00 -0.4621540E+00 0.0000000E+00 664 2 0.1143531E+00 -0.4861997E+00 0.0000000E+00 665 0 0.1299899E+00 -0.4568672E+00 0.0000000E+00 666 0 0.7033204E-01 -0.2134754E+00 0.0000000E+00 667 1 0.6349047E-01 -0.1894298E+00 0.0000000E+00 668 0 0.7936308E-01 -0.2367872E+00 0.0000000E+00 669 0 0.8127937E-01 -0.2098063E+00 0.0000000E+00 670 0 0.8620466E-01 -0.2608329E+00 0.0000000E+00 671 0 0.9523570E-01 -0.2841447E+00 0.0000000E+00 672 0 0.9934146E-01 -0.2564299E+00 0.0000000E+00 673 0 0.1020773E+00 -0.3081903E+00 0.0000000E+00 674 0 0.1111083E+00 -0.3315021E+00 0.0000000E+00 675 0 0.1174036E+00 -0.3030535E+00 0.0000000E+00 676 0 0.1179499E+00 -0.3555478E+00 0.0000000E+00 677 0 0.1269809E+00 -0.3788596E+00 0.0000000E+00 678 0 0.1354656E+00 -0.3496771E+00 0.0000000E+00 679 0 0.1338225E+00 -0.4029052E+00 0.0000000E+00 680 0 0.1428535E+00 -0.4262170E+00 0.0000000E+00 681 0 0.1535277E+00 -0.3963007E+00 0.0000000E+00 682 0 0.1496951E+00 -0.4502627E+00 0.0000000E+00 683 2 0.1587262E+00 -0.4735745E+00 0.0000000E+00 684 0 0.1715898E+00 -0.4429243E+00 0.0000000E+00 685 0 0.8972905E-01 -0.2060754E+00 0.0000000E+00 686 1 0.8069801E-01 -0.1827636E+00 0.0000000E+00 687 0 0.1008725E+00 -0.2284544E+00 0.0000000E+00 688 0 0.1002911E+00 -0.2014117E+00 0.0000000E+00 689 0 0.1099036E+00 -0.2517662E+00 0.0000000E+00 690 0 0.1210470E+00 -0.2741453E+00 0.0000000E+00 691 0 0.1225781E+00 -0.2461699E+00 0.0000000E+00 692 0 0.1300781E+00 -0.2974571E+00 0.0000000E+00 693 0 0.1412215E+00 -0.3198362E+00 0.0000000E+00 694 0 0.1448650E+00 -0.2909281E+00 0.0000000E+00 695 0 0.1502526E+00 -0.3431480E+00 0.0000000E+00 696 0 0.1613960E+00 -0.3655271E+00 0.0000000E+00 697 0 0.1671519E+00 -0.3356862E+00 0.0000000E+00 698 0 0.1704271E+00 -0.3888389E+00 0.0000000E+00 699 0 0.1815705E+00 -0.4112180E+00 0.0000000E+00 700 0 0.1894388E+00 -0.3804444E+00 0.0000000E+00 701 0 0.1906016E+00 -0.4345298E+00 0.0000000E+00 702 2 0.2017450E+00 -0.4569089E+00 0.0000000E+00 703 0 0.2117257E+00 -0.4252026E+00 0.0000000E+00 704 0 0.1083605E+00 -0.1969171E+00 0.0000000E+00 705 1 0.9721706E-01 -0.1745380E+00 0.0000000E+00 706 0 0.1215213E+00 -0.2181726E+00 0.0000000E+00 707 0 0.1184472E+00 -0.1912988E+00 0.0000000E+00 708 0 0.1326648E+00 -0.2405516E+00 0.0000000E+00 709 0 0.1458256E+00 -0.2618071E+00 0.0000000E+00 710 0 0.1447688E+00 -0.2338097E+00 0.0000000E+00 711 0 0.1569690E+00 -0.2841861E+00 0.0000000E+00 712 0 0.1701298E+00 -0.3054416E+00 0.0000000E+00 713 0 0.1710904E+00 -0.2763206E+00 0.0000000E+00 714 0 0.1812733E+00 -0.3278206E+00 0.0000000E+00 715 0 0.1944341E+00 -0.3490761E+00 0.0000000E+00 716 0 0.1974121E+00 -0.3188314E+00 0.0000000E+00 717 0 0.2055776E+00 -0.3714552E+00 0.0000000E+00 718 0 0.2187384E+00 -0.3927106E+00 0.0000000E+00 719 0 0.2237337E+00 -0.3613423E+00 0.0000000E+00 720 0 0.2298818E+00 -0.4150897E+00 0.0000000E+00 721 2 0.2430426E+00 -0.4363451E+00 0.0000000E+00 722 0 0.2500553E+00 -0.4038531E+00 0.0000000E+00 723 0 0.1260675E+00 -0.1860789E+00 0.0000000E+00 724 1 0.1129067E+00 -0.1648234E+00 0.0000000E+00 725 0 0.1411334E+00 -0.2060293E+00 0.0000000E+00 726 0 0.1355928E+00 -0.1795539E+00 0.0000000E+00 727 0 0.1542942E+00 -0.2272847E+00 0.0000000E+00 728 0 0.1693600E+00 -0.2472352E+00 0.0000000E+00 729 0 0.1657245E+00 -0.2194547E+00 0.0000000E+00 730 0 0.1825208E+00 -0.2684906E+00 0.0000000E+00 731 0 0.1975867E+00 -0.2884410E+00 0.0000000E+00 732 0 0.1958563E+00 -0.2593556E+00 0.0000000E+00 733 0 0.2107475E+00 -0.3096964E+00 0.0000000E+00 734 0 0.2258134E+00 -0.3296469E+00 0.0000000E+00 735 0 0.2259880E+00 -0.2992565E+00 0.0000000E+00 736 0 0.2389742E+00 -0.3509023E+00 0.0000000E+00 737 0 0.2540400E+00 -0.3708527E+00 0.0000000E+00 738 0 0.2561197E+00 -0.3391573E+00 0.0000000E+00 739 0 0.2672008E+00 -0.3921081E+00 0.0000000E+00 740 2 0.2822667E+00 -0.4120586E+00 0.0000000E+00 741 0 0.2862515E+00 -0.3790582E+00 0.0000000E+00 742 0 0.1426989E+00 -0.1736530E+00 0.0000000E+00 743 1 0.1276330E+00 -0.1537026E+00 0.0000000E+00 744 0 0.1595413E+00 -0.1921283E+00 0.0000000E+00 745 0 0.1515815E+00 -0.1662770E+00 0.0000000E+00 746 0 0.1746072E+00 -0.2120787E+00 0.0000000E+00 747 0 0.1914496E+00 -0.2305539E+00 0.0000000E+00 748 0 0.1852663E+00 -0.2032275E+00 0.0000000E+00 749 0 0.2065154E+00 -0.2505044E+00 0.0000000E+00 750 0 0.2233578E+00 -0.2689796E+00 0.0000000E+00 751 0 0.2189511E+00 -0.2401779E+00 0.0000000E+00 752 0 0.2384237E+00 -0.2889300E+00 0.0000000E+00 753 0 0.2552660E+00 -0.3074052E+00 0.0000000E+00 754 0 0.2526358E+00 -0.2771284E+00 0.0000000E+00 755 0 0.2703319E+00 -0.3273557E+00 0.0000000E+00 756 0 0.2871743E+00 -0.3458309E+00 0.0000000E+00 757 0 0.2863206E+00 -0.3140788E+00 0.0000000E+00 758 0 0.3022402E+00 -0.3657813E+00 0.0000000E+00 759 2 0.3190826E+00 -0.3842565E+00 0.0000000E+00 760 0 0.3200054E+00 -0.3510292E+00 0.0000000E+00 761 0 0.1581128E+00 -0.1597457E+00 0.0000000E+00 762 1 0.1412705E+00 -0.1412705E+00 0.0000000E+00 763 0 0.1765881E+00 -0.1765881E+00 0.0000000E+00 764 0 0.1662770E+00 -0.1515815E+00 0.0000000E+00 765 0 0.1934305E+00 -0.1950633E+00 0.0000000E+00 766 0 0.2119057E+00 -0.2119057E+00 0.0000000E+00 767 0 0.2032275E+00 -0.1852663E+00 0.0000000E+00 768 0 0.2287481E+00 -0.2303809E+00 0.0000000E+00 769 0 0.2472233E+00 -0.2472233E+00 0.0000000E+00 770 0 0.2401779E+00 -0.2189511E+00 0.0000000E+00 771 0 0.2640657E+00 -0.2656985E+00 0.0000000E+00 772 0 0.2825409E+00 -0.2825409E+00 0.0000000E+00 773 0 0.2771284E+00 -0.2526359E+00 0.0000000E+00 774 0 0.2993833E+00 -0.3010161E+00 0.0000000E+00 775 0 0.3178585E+00 -0.3178585E+00 0.0000000E+00 776 0 0.3140788E+00 -0.2863206E+00 0.0000000E+00 777 0 0.3347009E+00 -0.3363337E+00 0.0000000E+00 778 2 0.3531761E+00 -0.3531761E+00 0.0000000E+00 779 0 0.3510293E+00 -0.3200054E+00 0.0000000E+00 780 0 0.1721778E+00 -0.1444754E+00 0.0000000E+00 781 1 0.1537026E+00 -0.1276330E+00 0.0000000E+00 782 0 0.1921283E+00 -0.1595413E+00 0.0000000E+00 783 0 0.1795539E+00 -0.1355928E+00 0.0000000E+00 784 0 0.2106035E+00 -0.1763837E+00 0.0000000E+00 785 0 0.2305539E+00 -0.1914495E+00 0.0000000E+00 786 0 0.2194547E+00 -0.1657245E+00 0.0000000E+00 787 0 0.2490292E+00 -0.2082919E+00 0.0000000E+00 788 0 0.2689796E+00 -0.2233578E+00 0.0000000E+00 789 0 0.2593556E+00 -0.1958563E+00 0.0000000E+00 790 0 0.2874548E+00 -0.2402002E+00 0.0000000E+00 791 0 0.3074052E+00 -0.2552660E+00 0.0000000E+00 792 0 0.2992565E+00 -0.2259880E+00 0.0000000E+00 793 0 0.3258805E+00 -0.2721084E+00 0.0000000E+00 794 0 0.3458309E+00 -0.2871743E+00 0.0000000E+00 795 0 0.3391573E+00 -0.2561197E+00 0.0000000E+00 796 0 0.3643061E+00 -0.3040167E+00 0.0000000E+00 797 2 0.3842566E+00 -0.3190826E+00 0.0000000E+00 798 0 0.3790582E+00 -0.2862514E+00 0.0000000E+00 799 0 0.1847739E+00 -0.1279725E+00 0.0000000E+00 800 1 0.1648234E+00 -0.1129067E+00 0.0000000E+00 801 0 0.2060293E+00 -0.1411334E+00 0.0000000E+00 802 0 0.1912989E+00 -0.1184472E+00 0.0000000E+00 803 0 0.2259797E+00 -0.1561992E+00 0.0000000E+00 804 0 0.2472352E+00 -0.1693600E+00 0.0000000E+00 805 0 0.2338097E+00 -0.1447689E+00 0.0000000E+00 806 0 0.2671856E+00 -0.1844259E+00 0.0000000E+00 807 0 0.2884410E+00 -0.1975867E+00 0.0000000E+00 808 0 0.2763206E+00 -0.1710905E+00 0.0000000E+00 809 0 0.3083915E+00 -0.2126525E+00 0.0000000E+00 810 0 0.3296469E+00 -0.2258134E+00 0.0000000E+00 811 0 0.3188314E+00 -0.1974121E+00 0.0000000E+00 812 0 0.3495973E+00 -0.2408792E+00 0.0000000E+00 813 0 0.3708527E+00 -0.2540400E+00 0.0000000E+00 814 0 0.3613423E+00 -0.2237337E+00 0.0000000E+00 815 0 0.3908032E+00 -0.2691059E+00 0.0000000E+00 816 2 0.4120586E+00 -0.2822667E+00 0.0000000E+00 817 0 0.4038531E+00 -0.2500553E+00 0.0000000E+00 818 0 0.1957935E+00 -0.1103779E+00 0.0000000E+00 819 1 0.1745380E+00 -0.9721705E-01 0.0000000E+00 820 0 0.2181726E+00 -0.1215213E+00 0.0000000E+00 821 0 0.2014118E+00 -0.1002911E+00 0.0000000E+00 822 0 0.2394280E+00 -0.1346821E+00 0.0000000E+00 823 0 0.2618071E+00 -0.1458256E+00 0.0000000E+00 824 0 0.2461699E+00 -0.1225780E+00 0.0000000E+00 825 0 0.2830625E+00 -0.1589864E+00 0.0000000E+00 826 0 0.3054416E+00 -0.1701298E+00 0.0000000E+00 827 0 0.2909281E+00 -0.1448649E+00 0.0000000E+00 828 0 0.3266970E+00 -0.1832906E+00 0.0000000E+00 829 0 0.3490761E+00 -0.1944341E+00 0.0000000E+00 830 0 0.3356863E+00 -0.1671519E+00 0.0000000E+00 831 0 0.3703315E+00 -0.2075949E+00 0.0000000E+00 832 0 0.3927106E+00 -0.2187384E+00 0.0000000E+00 833 0 0.3804444E+00 -0.1894388E+00 0.0000000E+00 834 0 0.4139660E+00 -0.2318992E+00 0.0000000E+00 835 2 0.4363451E+00 -0.2430426E+00 0.0000000E+00 836 0 0.4252026E+00 -0.2117257E+00 0.0000000E+00 837 0 0.2051426E+00 -0.9184144E-01 0.0000000E+00 838 1 0.1827636E+00 -0.8069799E-01 0.0000000E+00 839 0 0.2284545E+00 -0.1008725E+00 0.0000000E+00 840 0 0.2098063E+00 -0.8127935E-01 0.0000000E+00 841 0 0.2508335E+00 -0.1120159E+00 0.0000000E+00 842 0 0.2741453E+00 -0.1210470E+00 0.0000000E+00 843 0 0.2564299E+00 -0.9934143E-01 0.0000000E+00 844 0 0.2965244E+00 -0.1321904E+00 0.0000000E+00 845 0 0.3198362E+00 -0.1412215E+00 0.0000000E+00 846 0 0.3030535E+00 -0.1174035E+00 0.0000000E+00 847 0 0.3422153E+00 -0.1523649E+00 0.0000000E+00 848 0 0.3655271E+00 -0.1613960E+00 0.0000000E+00 849 0 0.3496771E+00 -0.1354656E+00 0.0000000E+00 850 0 0.3879062E+00 -0.1725394E+00 0.0000000E+00 851 0 0.4112180E+00 -0.1815705E+00 0.0000000E+00 852 0 0.3963007E+00 -0.1535277E+00 0.0000000E+00 853 0 0.4335971E+00 -0.1927139E+00 0.0000000E+00 854 2 0.4569089E+00 -0.2017450E+00 0.0000000E+00 855 0 0.4429243E+00 -0.1715898E+00 0.0000000E+00 856 0 0.2127416E+00 -0.7252149E-01 0.0000000E+00 857 1 0.1894298E+00 -0.6349046E-01 0.0000000E+00 858 0 0.2367872E+00 -0.7936307E-01 0.0000000E+00 859 0 0.2164108E+00 -0.6157417E-01 0.0000000E+00 860 0 0.2600990E+00 -0.8839411E-01 0.0000000E+00 861 0 0.2841447E+00 -0.9523569E-01 0.0000000E+00 862 0 0.2645021E+00 -0.7525732E-01 0.0000000E+00 863 0 0.3074565E+00 -0.1042667E+00 0.0000000E+00 864 0 0.3315021E+00 -0.1111083E+00 0.0000000E+00 865 0 0.3125933E+00 -0.8894047E-01 0.0000000E+00 866 0 0.3548139E+00 -0.1201393E+00 0.0000000E+00 867 0 0.3788596E+00 -0.1269809E+00 0.0000000E+00 868 0 0.3606846E+00 -0.1026236E+00 0.0000000E+00 869 0 0.4021714E+00 -0.1360119E+00 0.0000000E+00 870 0 0.4262170E+00 -0.1428535E+00 0.0000000E+00 871 0 0.4087759E+00 -0.1163068E+00 0.0000000E+00 872 0 0.4495288E+00 -0.1518846E+00 0.0000000E+00 873 2 0.4735745E+00 -0.1587261E+00 0.0000000E+00 874 0 0.4568672E+00 -0.1299899E+00 0.0000000E+00 875 0 0.2185255E+00 -0.5258282E-01 0.0000000E+00 876 1 0.1944799E+00 -0.4574125E-01 0.0000000E+00 877 0 0.2430998E+00 -0.5717655E-01 0.0000000E+00 878 0 0.2211690E+00 -0.4134363E-01 0.0000000E+00 879 0 0.2671455E+00 -0.6401813E-01 0.0000000E+00 880 0 0.2917198E+00 -0.6861187E-01 0.0000000E+00 881 0 0.2703176E+00 -0.5053110E-01 0.0000000E+00 882 0 0.3157655E+00 -0.7545344E-01 0.0000000E+00 883 0 0.3403398E+00 -0.8004718E-01 0.0000000E+00 884 0 0.3194663E+00 -0.5971857E-01 0.0000000E+00 885 0 0.3643854E+00 -0.8688875E-01 0.0000000E+00 886 0 0.3889598E+00 -0.9148248E-01 0.0000000E+00 887 0 0.3686149E+00 -0.6890604E-01 0.0000000E+00 888 0 0.4130054E+00 -0.9832405E-01 0.0000000E+00 889 0 0.4375797E+00 -0.1029178E+00 0.0000000E+00 890 0 0.4177636E+00 -0.7809350E-01 0.0000000E+00 891 0 0.4616254E+00 -0.1097594E+00 0.0000000E+00 892 2 0.4861997E+00 -0.1143531E+00 0.0000000E+00 893 0 0.4669122E+00 -0.8728098E-01 0.0000000E+00 894 0 0.2224451E+00 -0.3219552E-01 0.0000000E+00 895 1 0.1978707E+00 -0.2760178E-01 0.0000000E+00 896 0 0.2473384E+00 -0.3450223E-01 0.0000000E+00 897 0 0.2240402E+00 -0.2076039E-01 0.0000000E+00 898 0 0.2719127E+00 -0.3909597E-01 0.0000000E+00 899 0 0.2968061E+00 -0.4140268E-01 0.0000000E+00 900 0 0.2738269E+00 -0.2537381E-01 0.0000000E+00 901 0 0.3213804E+00 -0.4599642E-01 0.0000000E+00 902 0 0.3462738E+00 -0.4830313E-01 0.0000000E+00 903 0 0.3236136E+00 -0.2998724E-01 0.0000000E+00 904 0 0.3708481E+00 -0.5289686E-01 0.0000000E+00 905 0 0.3957415E+00 -0.5520355E-01 0.0000000E+00 906 0 0.3734003E+00 -0.3460064E-01 0.0000000E+00 907 0 0.4203158E+00 -0.5979728E-01 0.0000000E+00 908 0 0.4452091E+00 -0.6210399E-01 0.0000000E+00 909 0 0.4231870E+00 -0.3921404E-01 0.0000000E+00 910 0 0.4697835E+00 -0.6669774E-01 0.0000000E+00 911 2 0.4946768E+00 -0.6900446E-01 0.0000000E+00 912 0 0.4729737E+00 -0.4382747E-01 0.0000000E+00 913 0 0.2244668E+00 -0.1153355E-01 0.0000000E+00 914 1 0.1995734E+00 -0.9226837E-02 0.0000000E+00 915 0 0.2494668E+00 -0.1153355E-01 0.0000000E+00 916 0 0.2250000E+00 0.0000000E+00 0.0000000E+00 917 0 0.2743601E+00 -0.1384026E-01 0.0000000E+00 918 0 0.2993601E+00 -0.1384026E-01 0.0000000E+00 919 0 0.2750000E+00 0.0000000E+00 0.0000000E+00 920 0 0.3242535E+00 -0.1614698E-01 0.0000000E+00 921 0 0.3492535E+00 -0.1614698E-01 0.0000000E+00 922 0 0.3250000E+00 0.0000000E+00 0.0000000E+00 923 0 0.3741468E+00 -0.1845367E-01 0.0000000E+00 924 0 0.3991468E+00 -0.1845366E-01 0.0000000E+00 925 0 0.3750000E+00 0.7450580E-08 0.0000000E+00 926 0 0.4240402E+00 -0.2076037E-01 0.0000000E+00 927 0 0.4490402E+00 -0.2076037E-01 0.0000000E+00 928 0 0.4250000E+00 0.1490116E-07 0.0000000E+00 929 0 0.4739335E+00 -0.2306709E-01 0.0000000E+00 930 2 0.4989335E+00 -0.2306709E-01 0.0000000E+00 931 0 0.4750000E+00 0.7450580E-08 0.0000000E+00 932 0 0.2245734E+00 0.9226836E-02 0.0000000E+00 933 1 0.1995734E+00 0.9226836E-02 0.0000000E+00 934 0 0.2494668E+00 0.1153355E-01 0.0000000E+00 935 0 0.2240402E+00 0.2076038E-01 0.0000000E+00 936 0 0.2744668E+00 0.1153355E-01 0.0000000E+00 937 0 0.2993601E+00 0.1384025E-01 0.0000000E+00 938 0 0.2738269E+00 0.2537380E-01 0.0000000E+00 939 0 0.3243601E+00 0.1384025E-01 0.0000000E+00 940 0 0.3492535E+00 0.1614696E-01 0.0000000E+00 941 0 0.3236136E+00 0.2998722E-01 0.0000000E+00 942 0 0.3742535E+00 0.1614697E-01 0.0000000E+00 943 0 0.3991468E+00 0.1845369E-01 0.0000000E+00 944 0 0.3734003E+00 0.3460064E-01 0.0000000E+00 945 0 0.4241468E+00 0.1845369E-01 0.0000000E+00 946 0 0.4490402E+00 0.2076039E-01 0.0000000E+00 947 0 0.4231870E+00 0.3921407E-01 0.0000000E+00 948 0 0.4740402E+00 0.2076039E-01 0.0000000E+00 949 2 0.4989335E+00 0.2306709E-01 0.0000000E+00 950 0 0.4729737E+00 0.4382748E-01 0.0000000E+00 951 0 0.2227641E+00 0.2990850E-01 0.0000000E+00 952 1 0.1978707E+00 0.2760179E-01 0.0000000E+00 953 0 0.2473384E+00 0.3450223E-01 0.0000000E+00 954 0 0.2211690E+00 0.4134364E-01 0.0000000E+00 955 0 0.2722318E+00 0.3680894E-01 0.0000000E+00 956 0 0.2968061E+00 0.4140268E-01 0.0000000E+00 957 0 0.2703176E+00 0.5053112E-01 0.0000000E+00 958 0 0.3216994E+00 0.4370939E-01 0.0000000E+00 959 0 0.3462738E+00 0.4830313E-01 0.0000000E+00 960 0 0.3194662E+00 0.5971859E-01 0.0000000E+00 961 0 0.3711671E+00 0.5060985E-01 0.0000000E+00 962 0 0.3957414E+00 0.5520359E-01 0.0000000E+00 963 0 0.3686149E+00 0.6890608E-01 0.0000000E+00 964 0 0.4206348E+00 0.5751030E-01 0.0000000E+00 965 0 0.4452091E+00 0.6210403E-01 0.0000000E+00 966 0 0.4177635E+00 0.7809355E-01 0.0000000E+00 967 0 0.4701025E+00 0.6441073E-01 0.0000000E+00 968 2 0.4946768E+00 0.6900447E-01 0.0000000E+00 969 0 0.4669122E+00 0.8728102E-01 0.0000000E+00 970 0 0.2190542E+00 0.5033499E-01 0.0000000E+00 971 1 0.1944799E+00 0.4574125E-01 0.0000000E+00 972 0 0.2430998E+00 0.5717656E-01 0.0000000E+00 973 0 0.2164108E+00 0.6157417E-01 0.0000000E+00 974 0 0.2676742E+00 0.6177030E-01 0.0000000E+00 975 0 0.2917198E+00 0.6861188E-01 0.0000000E+00 976 0 0.2645021E+00 0.7525732E-01 0.0000000E+00 977 0 0.3162941E+00 0.7320562E-01 0.0000000E+00 978 0 0.3403398E+00 0.8004719E-01 0.0000000E+00 979 0 0.3125933E+00 0.8894047E-01 0.0000000E+00 980 0 0.3649141E+00 0.8464093E-01 0.0000000E+00 981 0 0.3889597E+00 0.9148251E-01 0.0000000E+00 982 0 0.3606846E+00 0.1026236E+00 0.0000000E+00 983 0 0.4135341E+00 0.9607625E-01 0.0000000E+00 984 0 0.4375797E+00 0.1029178E+00 0.0000000E+00 985 0 0.4087759E+00 0.1163068E+00 0.0000000E+00 986 0 0.4621540E+00 0.1075116E+00 0.0000000E+00 987 2 0.4861997E+00 0.1143531E+00 0.0000000E+00 988 0 0.4568672E+00 0.1299899E+00 0.0000000E+00 989 0 0.2134754E+00 0.7033204E-01 0.0000000E+00 990 1 0.1894298E+00 0.6349047E-01 0.0000000E+00 991 0 0.2367872E+00 0.7936308E-01 0.0000000E+00 992 0 0.2098063E+00 0.8127937E-01 0.0000000E+00 993 0 0.2608329E+00 0.8620466E-01 0.0000000E+00 994 0 0.2841447E+00 0.9523570E-01 0.0000000E+00 995 0 0.2564299E+00 0.9934146E-01 0.0000000E+00 996 0 0.3081903E+00 0.1020773E+00 0.0000000E+00 997 0 0.3315021E+00 0.1111083E+00 0.0000000E+00 998 0 0.3030535E+00 0.1174035E+00 0.0000000E+00 999 0 0.3555478E+00 0.1179499E+00 0.0000000E+00 1000 0 0.3788596E+00 0.1269809E+00 0.0000000E+00 1001 0 0.3496771E+00 0.1354656E+00 0.0000000E+00 1002 0 0.4029052E+00 0.1338225E+00 0.0000000E+00 1003 0 0.4262170E+00 0.1428536E+00 0.0000000E+00 1004 0 0.3963007E+00 0.1535277E+00 0.0000000E+00 1005 0 0.4502627E+00 0.1496951E+00 0.0000000E+00 1006 2 0.4735745E+00 0.1587262E+00 0.0000000E+00 1007 0 0.4429243E+00 0.1715898E+00 0.0000000E+00 1008 0 0.2060754E+00 0.8972905E-01 0.0000000E+00 1009 1 0.1827636E+00 0.8069801E-01 0.0000000E+00 1010 0 0.2284544E+00 0.1008725E+00 0.0000000E+00 1011 0 0.2014117E+00 0.1002911E+00 0.0000000E+00 1012 0 0.2517662E+00 0.1099035E+00 0.0000000E+00 1013 0 0.2741453E+00 0.1210470E+00 0.0000000E+00 1014 0 0.2461699E+00 0.1225780E+00 0.0000000E+00 1015 0 0.2974571E+00 0.1300780E+00 0.0000000E+00 1016 0 0.3198362E+00 0.1412215E+00 0.0000000E+00 1017 0 0.2909281E+00 0.1448649E+00 0.0000000E+00 1018 0 0.3431480E+00 0.1502525E+00 0.0000000E+00 1019 0 0.3655271E+00 0.1613960E+00 0.0000000E+00 1020 0 0.3356862E+00 0.1671519E+00 0.0000000E+00 1021 0 0.3888389E+00 0.1704271E+00 0.0000000E+00 1022 0 0.4112180E+00 0.1815705E+00 0.0000000E+00 1023 0 0.3804444E+00 0.1894388E+00 0.0000000E+00 1024 0 0.4345298E+00 0.1906016E+00 0.0000000E+00 1025 2 0.4569089E+00 0.2017450E+00 0.0000000E+00 1026 0 0.4252025E+00 0.2117257E+00 0.0000000E+00 1027 0 0.1969171E+00 0.1083605E+00 0.0000000E+00 1028 1 0.1745380E+00 0.9721706E-01 0.0000000E+00 1029 0 0.2181726E+00 0.1215213E+00 0.0000000E+00 1030 0 0.1912988E+00 0.1184472E+00 0.0000000E+00 1031 0 0.2405516E+00 0.1326648E+00 0.0000000E+00 1032 0 0.2618071E+00 0.1458256E+00 0.0000000E+00 1033 0 0.2338097E+00 0.1447688E+00 0.0000000E+00 1034 0 0.2841862E+00 0.1569690E+00 0.0000000E+00 1035 0 0.3054416E+00 0.1701298E+00 0.0000000E+00 1036 0 0.2763206E+00 0.1710905E+00 0.0000000E+00 1037 0 0.3278206E+00 0.1812733E+00 0.0000000E+00 1038 0 0.3490761E+00 0.1944341E+00 0.0000000E+00 1039 0 0.3188314E+00 0.1974121E+00 0.0000000E+00 1040 0 0.3714551E+00 0.2055776E+00 0.0000000E+00 1041 0 0.3927106E+00 0.2187384E+00 0.0000000E+00 1042 0 0.3613423E+00 0.2237337E+00 0.0000000E+00 1043 0 0.4150897E+00 0.2298818E+00 0.0000000E+00 1044 2 0.4363451E+00 0.2430426E+00 0.0000000E+00 1045 0 0.4038531E+00 0.2500553E+00 0.0000000E+00 1046 0 0.1860789E+00 0.1260675E+00 0.0000000E+00 1047 1 0.1648234E+00 0.1129067E+00 0.0000000E+00 1048 0 0.2060293E+00 0.1411334E+00 0.0000000E+00 1049 0 0.1795539E+00 0.1355928E+00 0.0000000E+00 1050 0 0.2272847E+00 0.1542942E+00 0.0000000E+00 1051 0 0.2472351E+00 0.1693600E+00 0.0000000E+00 1052 0 0.2194547E+00 0.1657246E+00 0.0000000E+00 1053 0 0.2684906E+00 0.1825208E+00 0.0000000E+00 1054 0 0.2884410E+00 0.1975867E+00 0.0000000E+00 1055 0 0.2593556E+00 0.1958563E+00 0.0000000E+00 1056 0 0.3096964E+00 0.2107475E+00 0.0000000E+00 1057 0 0.3296469E+00 0.2258134E+00 0.0000000E+00 1058 0 0.2992564E+00 0.2259880E+00 0.0000000E+00 1059 0 0.3509023E+00 0.2389742E+00 0.0000000E+00 1060 0 0.3708527E+00 0.2540400E+00 0.0000000E+00 1061 0 0.3391573E+00 0.2561197E+00 0.0000000E+00 1062 0 0.3921081E+00 0.2672008E+00 0.0000000E+00 1063 2 0.4120586E+00 0.2822667E+00 0.0000000E+00 1064 0 0.3790582E+00 0.2862515E+00 0.0000000E+00 1065 0 0.1736530E+00 0.1426989E+00 0.0000000E+00 1066 1 0.1537026E+00 0.1276330E+00 0.0000000E+00 1067 0 0.1921283E+00 0.1595413E+00 0.0000000E+00 1068 0 0.1662770E+00 0.1515815E+00 0.0000000E+00 1069 0 0.2120787E+00 0.1746072E+00 0.0000000E+00 1070 0 0.2305539E+00 0.1914496E+00 0.0000000E+00 1071 0 0.2032275E+00 0.1852663E+00 0.0000000E+00 1072 0 0.2505043E+00 0.2065154E+00 0.0000000E+00 1073 0 0.2689795E+00 0.2233578E+00 0.0000000E+00 1074 0 0.2401779E+00 0.2189511E+00 0.0000000E+00 1075 0 0.2889300E+00 0.2384237E+00 0.0000000E+00 1076 0 0.3074052E+00 0.2552661E+00 0.0000000E+00 1077 0 0.2771283E+00 0.2526359E+00 0.0000000E+00 1078 0 0.3273556E+00 0.2703319E+00 0.0000000E+00 1079 0 0.3458309E+00 0.2871743E+00 0.0000000E+00 1080 0 0.3140788E+00 0.2863206E+00 0.0000000E+00 1081 0 0.3657813E+00 0.3022402E+00 0.0000000E+00 1082 2 0.3842565E+00 0.3190826E+00 0.0000000E+00 1083 0 0.3510292E+00 0.3200054E+00 0.0000000E+00 1084 0 0.1597457E+00 0.1581128E+00 0.0000000E+00 1085 1 0.1412705E+00 0.1412705E+00 0.0000000E+00 1086 0 0.1765881E+00 0.1765881E+00 0.0000000E+00 1087 0 0.1515815E+00 0.1662770E+00 0.0000000E+00 1088 0 0.1950633E+00 0.1934305E+00 0.0000000E+00 1089 0 0.2119057E+00 0.2119057E+00 0.0000000E+00 1090 0 0.1852663E+00 0.2032275E+00 0.0000000E+00 1091 0 0.2303809E+00 0.2287481E+00 0.0000000E+00 1092 0 0.2472233E+00 0.2472233E+00 0.0000000E+00 1093 0 0.2189511E+00 0.2401779E+00 0.0000000E+00 1094 0 0.2656985E+00 0.2640657E+00 0.0000000E+00 1095 0 0.2825409E+00 0.2825409E+00 0.0000000E+00 1096 0 0.2526358E+00 0.2771284E+00 0.0000000E+00 1097 0 0.3010161E+00 0.2993833E+00 0.0000000E+00 1098 0 0.3178585E+00 0.3178585E+00 0.0000000E+00 1099 0 0.2863206E+00 0.3140788E+00 0.0000000E+00 1100 0 0.3363337E+00 0.3347009E+00 0.0000000E+00 1101 2 0.3531761E+00 0.3531761E+00 0.0000000E+00 1102 0 0.3200054E+00 0.3510293E+00 0.0000000E+00 1103 0 0.1444754E+00 0.1721778E+00 0.0000000E+00 1104 1 0.1276330E+00 0.1537026E+00 0.0000000E+00 1105 0 0.1595413E+00 0.1921283E+00 0.0000000E+00 1106 0 0.1355928E+00 0.1795539E+00 0.0000000E+00 1107 0 0.1763837E+00 0.2106035E+00 0.0000000E+00 1108 0 0.1914496E+00 0.2305539E+00 0.0000000E+00 1109 0 0.1657245E+00 0.2194547E+00 0.0000000E+00 1110 0 0.2082919E+00 0.2490291E+00 0.0000000E+00 1111 0 0.2233578E+00 0.2689796E+00 0.0000000E+00 1112 0 0.1958563E+00 0.2593556E+00 0.0000000E+00 1113 0 0.2402002E+00 0.2874548E+00 0.0000000E+00 1114 0 0.2552660E+00 0.3074053E+00 0.0000000E+00 1115 0 0.2259880E+00 0.2992565E+00 0.0000000E+00 1116 0 0.2721084E+00 0.3258805E+00 0.0000000E+00 1117 0 0.2871743E+00 0.3458309E+00 0.0000000E+00 1118 0 0.2561197E+00 0.3391573E+00 0.0000000E+00 1119 0 0.3040167E+00 0.3643061E+00 0.0000000E+00 1120 2 0.3190826E+00 0.3842566E+00 0.0000000E+00 1121 0 0.2862514E+00 0.3790582E+00 0.0000000E+00 1122 0 0.1279726E+00 0.1847739E+00 0.0000000E+00 1123 1 0.1129067E+00 0.1648234E+00 0.0000000E+00 1124 0 0.1411334E+00 0.2060293E+00 0.0000000E+00 1125 0 0.1184472E+00 0.1912988E+00 0.0000000E+00 1126 0 0.1561992E+00 0.2259797E+00 0.0000000E+00 1127 0 0.1693600E+00 0.2472351E+00 0.0000000E+00 1128 0 0.1447689E+00 0.2338097E+00 0.0000000E+00 1129 0 0.1844259E+00 0.2671856E+00 0.0000000E+00 1130 0 0.1975867E+00 0.2884410E+00 0.0000000E+00 1131 0 0.1710905E+00 0.2763206E+00 0.0000000E+00 1132 0 0.2126525E+00 0.3083915E+00 0.0000000E+00 1133 0 0.2258134E+00 0.3296469E+00 0.0000000E+00 1134 0 0.1974121E+00 0.3188314E+00 0.0000000E+00 1135 0 0.2408792E+00 0.3495973E+00 0.0000000E+00 1136 0 0.2540400E+00 0.3708527E+00 0.0000000E+00 1137 0 0.2237337E+00 0.3613423E+00 0.0000000E+00 1138 0 0.2691059E+00 0.3908032E+00 0.0000000E+00 1139 2 0.2822667E+00 0.4120586E+00 0.0000000E+00 1140 0 0.2500553E+00 0.4038531E+00 0.0000000E+00 1141 0 0.1103779E+00 0.1957935E+00 0.0000000E+00 1142 1 0.9721705E-01 0.1745380E+00 0.0000000E+00 1143 0 0.1215213E+00 0.2181726E+00 0.0000000E+00 1144 0 0.1002911E+00 0.2014117E+00 0.0000000E+00 1145 0 0.1346821E+00 0.2394280E+00 0.0000000E+00 1146 0 0.1458256E+00 0.2618071E+00 0.0000000E+00 1147 0 0.1225780E+00 0.2461699E+00 0.0000000E+00 1148 0 0.1589864E+00 0.2830625E+00 0.0000000E+00 1149 0 0.1701298E+00 0.3054416E+00 0.0000000E+00 1150 0 0.1448650E+00 0.2909281E+00 0.0000000E+00 1151 0 0.1832906E+00 0.3266970E+00 0.0000000E+00 1152 0 0.1944341E+00 0.3490761E+00 0.0000000E+00 1153 0 0.1671519E+00 0.3356863E+00 0.0000000E+00 1154 0 0.2075949E+00 0.3703315E+00 0.0000000E+00 1155 0 0.2187384E+00 0.3927106E+00 0.0000000E+00 1156 0 0.1894388E+00 0.3804444E+00 0.0000000E+00 1157 0 0.2318992E+00 0.4139660E+00 0.0000000E+00 1158 2 0.2430426E+00 0.4363451E+00 0.0000000E+00 1159 0 0.2117257E+00 0.4252026E+00 0.0000000E+00 1160 0 0.9184145E-01 0.2051426E+00 0.0000000E+00 1161 1 0.8069799E-01 0.1827636E+00 0.0000000E+00 1162 0 0.1008725E+00 0.2284544E+00 0.0000000E+00 1163 0 0.8127936E-01 0.2098063E+00 0.0000000E+00 1164 0 0.1120159E+00 0.2508335E+00 0.0000000E+00 1165 0 0.1210470E+00 0.2741453E+00 0.0000000E+00 1166 0 0.9934144E-01 0.2564299E+00 0.0000000E+00 1167 0 0.1321904E+00 0.2965244E+00 0.0000000E+00 1168 0 0.1412215E+00 0.3198362E+00 0.0000000E+00 1169 0 0.1174035E+00 0.3030535E+00 0.0000000E+00 1170 0 0.1523649E+00 0.3422153E+00 0.0000000E+00 1171 0 0.1613960E+00 0.3655271E+00 0.0000000E+00 1172 0 0.1354656E+00 0.3496771E+00 0.0000000E+00 1173 0 0.1725394E+00 0.3879062E+00 0.0000000E+00 1174 0 0.1815705E+00 0.4112180E+00 0.0000000E+00 1175 0 0.1535277E+00 0.3963007E+00 0.0000000E+00 1176 0 0.1927139E+00 0.4335971E+00 0.0000000E+00 1177 2 0.2017450E+00 0.4569089E+00 0.0000000E+00 1178 0 0.1715898E+00 0.4429243E+00 0.0000000E+00 1179 0 0.7252150E-01 0.2127416E+00 0.0000000E+00 1180 1 0.6349046E-01 0.1894298E+00 0.0000000E+00 1181 0 0.7936308E-01 0.2367872E+00 0.0000000E+00 1182 0 0.6157418E-01 0.2164108E+00 0.0000000E+00 1183 0 0.8839412E-01 0.2600990E+00 0.0000000E+00 1184 0 0.9523570E-01 0.2841447E+00 0.0000000E+00 1185 0 0.7525734E-01 0.2645020E+00 0.0000000E+00 1186 0 0.1042667E+00 0.3074565E+00 0.0000000E+00 1187 0 0.1111083E+00 0.3315021E+00 0.0000000E+00 1188 0 0.8894050E-01 0.3125933E+00 0.0000000E+00 1189 0 0.1201394E+00 0.3548139E+00 0.0000000E+00 1190 0 0.1269809E+00 0.3788596E+00 0.0000000E+00 1191 0 0.1026236E+00 0.3606846E+00 0.0000000E+00 1192 0 0.1360120E+00 0.4021714E+00 0.0000000E+00 1193 0 0.1428535E+00 0.4262170E+00 0.0000000E+00 1194 0 0.1163068E+00 0.4087759E+00 0.0000000E+00 1195 0 0.1518846E+00 0.4495288E+00 0.0000000E+00 1196 2 0.1587261E+00 0.4735745E+00 0.0000000E+00 1197 0 0.1299899E+00 0.4568672E+00 0.0000000E+00 1198 0 0.5258283E-01 0.2185255E+00 0.0000000E+00 1199 1 0.4574125E-01 0.1944799E+00 0.0000000E+00 1200 0 0.5717656E-01 0.2430998E+00 0.0000000E+00 1201 0 0.4134363E-01 0.2211690E+00 0.0000000E+00 1202 0 0.6401814E-01 0.2671455E+00 0.0000000E+00 1203 0 0.6861188E-01 0.2917198E+00 0.0000000E+00 1204 0 0.5053110E-01 0.2703176E+00 0.0000000E+00 1205 0 0.7545346E-01 0.3157655E+00 0.0000000E+00 1206 0 0.8004720E-01 0.3403398E+00 0.0000000E+00 1207 0 0.5971857E-01 0.3194663E+00 0.0000000E+00 1208 0 0.8688875E-01 0.3643854E+00 0.0000000E+00 1209 0 0.9148248E-01 0.3889598E+00 0.0000000E+00 1210 0 0.6890604E-01 0.3686149E+00 0.0000000E+00 1211 0 0.9832405E-01 0.4130054E+00 0.0000000E+00 1212 0 0.1029178E+00 0.4375797E+00 0.0000000E+00 1213 0 0.7809351E-01 0.4177636E+00 0.0000000E+00 1214 0 0.1097594E+00 0.4616254E+00 0.0000000E+00 1215 2 0.1143531E+00 0.4861997E+00 0.0000000E+00 1216 0 0.8728099E-01 0.4669122E+00 0.0000000E+00 1217 0 0.3219552E-01 0.2224451E+00 0.0000000E+00 1218 1 0.2760178E-01 0.1978707E+00 0.0000000E+00 1219 0 0.3450223E-01 0.2473384E+00 0.0000000E+00 1220 0 0.2076038E-01 0.2240402E+00 0.0000000E+00 1221 0 0.3909597E-01 0.2719127E+00 0.0000000E+00 1222 0 0.4140267E-01 0.2968061E+00 0.0000000E+00 1223 0 0.2537380E-01 0.2738269E+00 0.0000000E+00 1224 0 0.4599641E-01 0.3213804E+00 0.0000000E+00 1225 0 0.4830312E-01 0.3462738E+00 0.0000000E+00 1226 0 0.2998722E-01 0.3236136E+00 0.0000000E+00 1227 0 0.5289685E-01 0.3708481E+00 0.0000000E+00 1228 0 0.5520356E-01 0.3957415E+00 0.0000000E+00 1229 0 0.3460064E-01 0.3734003E+00 0.0000000E+00 1230 0 0.5979730E-01 0.4203158E+00 0.0000000E+00 1231 0 0.6210401E-01 0.4452091E+00 0.0000000E+00 1232 0 0.3921406E-01 0.4231870E+00 0.0000000E+00 1233 0 0.6669774E-01 0.4697835E+00 0.0000000E+00 1234 2 0.6900446E-01 0.4946768E+00 0.0000000E+00 1235 0 0.4382747E-01 0.4729737E+00 0.0000000E+00 1236 0 0.1153355E-01 0.2244668E+00 0.0000000E+00 1237 1 0.9226837E-02 0.1995734E+00 0.0000000E+00 1238 0 0.1153355E-01 0.2494668E+00 0.0000000E+00 1239 0 0.0000000E+00 0.2250000E+00 0.0000000E+00 1240 0 0.1384026E-01 0.2743601E+00 0.0000000E+00 1241 0 0.1384026E-01 0.2993601E+00 0.0000000E+00 1242 0 0.0000000E+00 0.2750000E+00 0.0000000E+00 1243 0 0.1614696E-01 0.3242535E+00 0.0000000E+00 1244 0 0.1614696E-01 0.3492535E+00 0.0000000E+00 1245 0 0.0000000E+00 0.3250000E+00 0.0000000E+00 1246 0 0.1845367E-01 0.3741468E+00 0.0000000E+00 1247 0 0.1845367E-01 0.3991468E+00 0.0000000E+00 1248 0 0.0000000E+00 0.3750000E+00 0.0000000E+00 1249 0 0.2076038E-01 0.4240402E+00 0.0000000E+00 1250 0 0.2076038E-01 0.4490402E+00 0.0000000E+00 1251 0 0.0000000E+00 0.4250000E+00 0.0000000E+00 1252 0 0.2076038E-01 0.4740402E+00 0.0000000E+00 1253 0 0.0000000E+00 0.4750000E+00 0.0000000E+00 1254 2 0.2306709E-01 0.4989335E+00 0.0000000E+00 1255 0 0.3296502E-01 -0.1023964E+01 0.0000000E+00 1256 0 0.6436028E-01 -0.1022977E+01 0.0000000E+00 1257 3 0.3139526E-01 -0.9990134E+00 0.0000000E+00 1258 0 0.0000000E+00 -0.1025000E+01 0.0000000E+00 1259 0 0.3296502E-01 -0.1048964E+01 0.0000000E+00 1260 0 0.0000000E+00 -0.1075000E+01 0.0000000E+00 1261 0 0.3296502E-01 -0.1073964E+01 0.0000000E+00 1262 0 0.3453479E-01 -0.1098915E+01 0.0000000E+00 1263 0 0.6749981E-01 -0.1072879E+01 0.0000000E+00 1264 0 0.0000000E+00 -0.1125000E+01 0.0000000E+00 1265 0 0.3453479E-01 -0.1123915E+01 0.0000000E+00 1266 0 0.3610455E-01 -0.1148865E+01 0.0000000E+00 1267 0 0.7063934E-01 -0.1122780E+01 0.0000000E+00 1268 0 0.0000000E+00 -0.1175000E+01 0.0000000E+00 1269 0 0.3610455E-01 -0.1173865E+01 0.0000000E+00 1270 0 0.3767432E-01 -0.1198816E+01 0.0000000E+00 1271 0 0.7377887E-01 -0.1172681E+01 0.0000000E+00 1272 0 0.0000000E+00 -0.1225000E+01 0.0000000E+00 1273 0 0.3767432E-01 -0.1223816E+01 0.0000000E+00 1274 0 0.3924408E-01 -0.1248767E+01 0.0000000E+00 1275 0 0.7691839E-01 -0.1222583E+01 0.0000000E+00 1276 0 0.0000000E+00 -0.1275000E+01 0.0000000E+00 1277 0 0.3924408E-01 -0.1273767E+01 0.0000000E+00 1278 4 0.4081384E-01 -0.1298717E+01 0.0000000E+00 1279 0 0.8005792E-01 -0.1272484E+01 0.0000000E+00 1280 0 0.9563164E-01 -0.1020021E+01 0.0000000E+00 1281 3 0.9406188E-01 -0.9950707E+00 0.0000000E+00 1282 0 0.9876496E-01 -0.1044824E+01 0.0000000E+00 1283 0 0.1284666E+00 -0.1016918E+01 0.0000000E+00 1284 0 0.1003347E+00 -0.1069775E+01 0.0000000E+00 1285 0 0.1034681E+00 -0.1094578E+01 0.0000000E+00 1286 0 0.1347332E+00 -0.1066523E+01 0.0000000E+00 1287 0 0.1050378E+00 -0.1119528E+01 0.0000000E+00 1288 0 0.1081712E+00 -0.1144331E+01 0.0000000E+00 1289 0 0.1409999E+00 -0.1116129E+01 0.0000000E+00 1290 0 0.1097409E+00 -0.1169282E+01 0.0000000E+00 1291 0 0.1128743E+00 -0.1194085E+01 0.0000000E+00 1292 0 0.1472666E+00 -0.1165735E+01 0.0000000E+00 1293 0 0.1144440E+00 -0.1219036E+01 0.0000000E+00 1294 0 0.1175774E+00 -0.1243838E+01 0.0000000E+00 1295 0 0.1535332E+00 -0.1215340E+01 0.0000000E+00 1296 0 0.1191471E+00 -0.1268789E+01 0.0000000E+00 1297 4 0.1222804E+00 -0.1293592E+01 0.0000000E+00 1298 0 0.1597999E+00 -0.1264946E+01 0.0000000E+00 1299 0 0.1594906E+00 -0.1012004E+01 0.0000000E+00 1300 3 0.1563573E+00 -0.9872010E+00 0.0000000E+00 1301 0 0.1641751E+00 -0.1036561E+01 0.0000000E+00 1302 0 0.1920658E+00 -0.1006844E+01 0.0000000E+00 1303 0 0.1673085E+00 -0.1061364E+01 0.0000000E+00 1304 0 0.1719930E+00 -0.1085921E+01 0.0000000E+00 1305 0 0.2014349E+00 -0.1055959E+01 0.0000000E+00 1306 0 0.1751264E+00 -0.1110724E+01 0.0000000E+00 1307 0 0.1798109E+00 -0.1135281E+01 0.0000000E+00 1308 0 0.2108040E+00 -0.1105073E+01 0.0000000E+00 1309 0 0.1829442E+00 -0.1160084E+01 0.0000000E+00 1310 0 0.1876287E+00 -0.1184641E+01 0.0000000E+00 1311 0 0.2201731E+00 -0.1154187E+01 0.0000000E+00 1312 0 0.1907621E+00 -0.1209444E+01 0.0000000E+00 1313 0 0.1954466E+00 -0.1234001E+01 0.0000000E+00 1314 0 0.2295421E+00 -0.1203302E+01 0.0000000E+00 1315 0 0.1985799E+00 -0.1258804E+01 0.0000000E+00 1316 4 0.2032645E+00 -0.1283361E+01 0.0000000E+00 1317 0 0.2389112E+00 -0.1252416E+01 0.0000000E+00 1318 0 0.2227201E+00 -0.9999923E+00 0.0000000E+00 1319 3 0.2180356E+00 -0.9754352E+00 0.0000000E+00 1320 0 0.2289374E+00 -0.1024207E+01 0.0000000E+00 1321 0 0.2549072E+00 -0.9927977E+00 0.0000000E+00 1322 0 0.2336219E+00 -0.1048764E+01 0.0000000E+00 1323 0 0.2398392E+00 -0.1072979E+01 0.0000000E+00 1324 0 0.2673417E+00 -0.1041227E+01 0.0000000E+00 1325 0 0.2445237E+00 -0.1097536E+01 0.0000000E+00 1326 0 0.2507410E+00 -0.1121750E+01 0.0000000E+00 1327 0 0.2797762E+00 -0.1089656E+01 0.0000000E+00 1328 0 0.2554255E+00 -0.1146308E+01 0.0000000E+00 1329 0 0.2616427E+00 -0.1170522E+01 0.0000000E+00 1330 0 0.2922106E+00 -0.1138085E+01 0.0000000E+00 1331 0 0.2663273E+00 -0.1195079E+01 0.0000000E+00 1332 0 0.2725445E+00 -0.1219294E+01 0.0000000E+00 1333 0 0.3046451E+00 -0.1186514E+01 0.0000000E+00 1334 0 0.2772290E+00 -0.1243851E+01 0.0000000E+00 1335 4 0.2834463E+00 -0.1268066E+01 0.0000000E+00 1336 0 0.3170796E+00 -0.1234943E+01 0.0000000E+00 1337 0 0.2850707E+00 -0.9840344E+00 0.0000000E+00 1338 3 0.2788535E+00 -0.9598199E+00 0.0000000E+00 1339 0 0.2927961E+00 -0.1007811E+01 0.0000000E+00 1340 0 0.3167424E+00 -0.9748329E+00 0.0000000E+00 1341 0 0.2990134E+00 -0.1032025E+01 0.0000000E+00 1342 0 0.3067388E+00 -0.1055802E+01 0.0000000E+00 1343 0 0.3321933E+00 -0.1022386E+01 0.0000000E+00 1344 0 0.3129561E+00 -0.1080016E+01 0.0000000E+00 1345 0 0.3206815E+00 -0.1103793E+01 0.0000000E+00 1346 0 0.3476441E+00 -0.1069939E+01 0.0000000E+00 1347 0 0.3268987E+00 -0.1128007E+01 0.0000000E+00 1348 0 0.3346241E+00 -0.1151784E+01 0.0000000E+00 1349 0 0.3630950E+00 -0.1117491E+01 0.0000000E+00 1350 0 0.3408414E+00 -0.1175998E+01 0.0000000E+00 1351 0 0.3485668E+00 -0.1199775E+01 0.0000000E+00 1352 0 0.3785458E+00 -0.1165044E+01 0.0000000E+00 1353 0 0.3547841E+00 -0.1223989E+01 0.0000000E+00 1354 4 0.3625095E+00 -0.1247766E+01 0.0000000E+00 1355 0 0.3939967E+00 -0.1212597E+01 0.0000000E+00 1356 0 0.3462962E+00 -0.9641929E+00 0.0000000E+00 1357 3 0.3385708E+00 -0.9404165E+00 0.0000000E+00 1358 0 0.3554993E+00 -0.9874373E+00 0.0000000E+00 1359 0 0.3773277E+00 -0.9530209E+00 0.0000000E+00 1360 0 0.3632247E+00 -0.1011214E+01 0.0000000E+00 1361 0 0.3724279E+00 -0.1034458E+01 0.0000000E+00 1362 0 0.3957339E+00 -0.9995097E+00 0.0000000E+00 1363 0 0.3801533E+00 -0.1058235E+01 0.0000000E+00 1364 0 0.3893564E+00 -0.1081479E+01 0.0000000E+00 1365 0 0.4141401E+00 -0.1045999E+01 0.0000000E+00 1366 0 0.3970818E+00 -0.1105255E+01 0.0000000E+00 1367 0 0.4062849E+00 -0.1128500E+01 0.0000000E+00 1368 0 0.4325463E+00 -0.1092487E+01 0.0000000E+00 1369 0 0.4140103E+00 -0.1152276E+01 0.0000000E+00 1370 0 0.4232135E+00 -0.1175521E+01 0.0000000E+00 1371 0 0.4509526E+00 -0.1138976E+01 0.0000000E+00 1372 0 0.4309389E+00 -0.1199297E+01 0.0000000E+00 1373 4 0.4401420E+00 -0.1222541E+01 0.0000000E+00 1374 0 0.4693588E+00 -0.1185465E+01 0.0000000E+00 1375 0 0.4061550E+00 -0.9405462E+00 0.0000000E+00 1376 3 0.3969519E+00 -0.9173018E+00 0.0000000E+00 1377 0 0.4167995E+00 -0.9631668E+00 0.0000000E+00 1378 0 0.4364238E+00 -0.9274477E+00 0.0000000E+00 1379 0 0.4260027E+00 -0.9864112E+00 0.0000000E+00 1380 0 0.4366471E+00 -0.1009032E+01 0.0000000E+00 1381 0 0.4577127E+00 -0.9726891E+00 0.0000000E+00 1382 0 0.4458502E+00 -0.1032276E+01 0.0000000E+00 1383 0 0.4564947E+00 -0.1054897E+01 0.0000000E+00 1384 0 0.4790017E+00 -0.1017930E+01 0.0000000E+00 1385 0 0.4656978E+00 -0.1078141E+01 0.0000000E+00 1386 0 0.4763423E+00 -0.1100762E+01 0.0000000E+00 1387 0 0.5002906E+00 -0.1063172E+01 0.0000000E+00 1388 0 0.4855454E+00 -0.1124007E+01 0.0000000E+00 1389 0 0.4961899E+00 -0.1146627E+01 0.0000000E+00 1390 0 0.5215796E+00 -0.1108413E+01 0.0000000E+00 1391 0 0.5053930E+00 -0.1169872E+01 0.0000000E+00 1392 4 0.5160375E+00 -0.1192492E+01 0.0000000E+00 1393 0 0.5428686E+00 -0.1153654E+01 0.0000000E+00 1394 0 0.4644110E+00 -0.9131875E+00 0.0000000E+00 1395 3 0.4537665E+00 -0.8905669E+00 0.0000000E+00 1396 0 0.4764548E+00 -0.9350951E+00 0.0000000E+00 1397 0 0.4937975E+00 -0.8982143E+00 0.0000000E+00 1398 0 0.4870993E+00 -0.9577158E+00 0.0000000E+00 1399 0 0.4991432E+00 -0.9796236E+00 0.0000000E+00 1400 0 0.5178852E+00 -0.9420296E+00 0.0000000E+00 1401 0 0.5097876E+00 -0.1002244E+01 0.0000000E+00 1402 0 0.5218315E+00 -0.1024152E+01 0.0000000E+00 1403 0 0.5419730E+00 -0.9858450E+00 0.0000000E+00 1404 0 0.5324760E+00 -0.1046773E+01 0.0000000E+00 1405 0 0.5445198E+00 -0.1068680E+01 0.0000000E+00 1406 0 0.5660606E+00 -0.1029660E+01 0.0000000E+00 1407 0 0.5551642E+00 -0.1091301E+01 0.0000000E+00 1408 0 0.5672081E+00 -0.1113209E+01 0.0000000E+00 1409 0 0.5901482E+00 -0.1073476E+01 0.0000000E+00 1410 0 0.5778526E+00 -0.1135829E+01 0.0000000E+00 1411 4 0.5898964E+00 -0.1157737E+01 0.0000000E+00 1412 0 0.6142359E+00 -0.1117291E+01 0.0000000E+00 1413 0 0.5208341E+00 -0.8822249E+00 0.0000000E+00 1414 3 0.5087903E+00 -0.8603173E+00 0.0000000E+00 1415 0 0.5342298E+00 -0.9033331E+00 0.0000000E+00 1416 0 0.5492225E+00 -0.8654361E+00 0.0000000E+00 1417 0 0.5462736E+00 -0.9252408E+00 0.0000000E+00 1418 0 0.5596693E+00 -0.9463490E+00 0.0000000E+00 1419 0 0.5760138E+00 -0.9076525E+00 0.0000000E+00 1420 0 0.5717131E+00 -0.9682567E+00 0.0000000E+00 1421 0 0.5851088E+00 -0.9893649E+00 0.0000000E+00 1422 0 0.6028051E+00 -0.9498689E+00 0.0000000E+00 1423 0 0.5971526E+00 -0.1011272E+01 0.0000000E+00 1424 0 0.6105483E+00 -0.1032381E+01 0.0000000E+00 1425 0 0.6295965E+00 -0.9920852E+00 0.0000000E+00 1426 0 0.6225922E+00 -0.1054288E+01 0.0000000E+00 1427 0 0.6359878E+00 -0.1075397E+01 0.0000000E+00 1428 0 0.6563878E+00 -0.1034302E+01 0.0000000E+00 1429 0 0.6480316E+00 -0.1097304E+01 0.0000000E+00 1430 4 0.6614273E+00 -0.1118412E+01 0.0000000E+00 1431 0 0.6831791E+00 -0.1076518E+01 0.0000000E+00 1432 0 0.5752017E+00 -0.8477806E+00 0.0000000E+00 1433 3 0.5618060E+00 -0.8266725E+00 0.0000000E+00 1434 0 0.5898963E+00 -0.8680060E+00 0.0000000E+00 1435 0 0.6024799E+00 -0.8292424E+00 0.0000000E+00 1436 0 0.6032920E+00 -0.8891142E+00 0.0000000E+00 1437 0 0.6179866E+00 -0.9093397E+00 0.0000000E+00 1438 0 0.6318692E+00 -0.8696932E+00 0.0000000E+00 1439 0 0.6313823E+00 -0.9304479E+00 0.0000000E+00 1440 0 0.6460769E+00 -0.9506733E+00 0.0000000E+00 1441 0 0.6612584E+00 -0.9101441E+00 0.0000000E+00 1442 0 0.6594726E+00 -0.9717814E+00 0.0000000E+00 1443 0 0.6741672E+00 -0.9920068E+00 0.0000000E+00 1444 0 0.6906477E+00 -0.9505949E+00 0.0000000E+00 1445 0 0.6875629E+00 -0.1013115E+01 0.0000000E+00 1446 0 0.7022575E+00 -0.1033341E+01 0.0000000E+00 1447 0 0.7200369E+00 -0.9910458E+00 0.0000000E+00 1448 0 0.7156532E+00 -0.1054449E+01 0.0000000E+00 1449 4 0.7303478E+00 -0.1074674E+01 0.0000000E+00 1450 0 0.7494262E+00 -0.1031497E+01 0.0000000E+00 1451 0 0.6272993E+00 -0.8099905E+00 0.0000000E+00 1452 3 0.6126046E+00 -0.7897651E+00 0.0000000E+00 1453 0 0.6432349E+00 -0.8292533E+00 0.0000000E+00 1454 0 0.6533597E+00 -0.7897760E+00 0.0000000E+00 1455 0 0.6579295E+00 -0.8494788E+00 0.0000000E+00 1456 0 0.6738652E+00 -0.8687416E+00 0.0000000E+00 1457 0 0.6852309E+00 -0.8283017E+00 0.0000000E+00 1458 0 0.6885598E+00 -0.8889670E+00 0.0000000E+00 1459 0 0.7044953E+00 -0.9082298E+00 0.0000000E+00 1460 0 0.7171021E+00 -0.8668273E+00 0.0000000E+00 1461 0 0.7191900E+00 -0.9284552E+00 0.0000000E+00 1462 0 0.7351255E+00 -0.9477181E+00 0.0000000E+00 1463 0 0.7489732E+00 -0.9053530E+00 0.0000000E+00 1464 0 0.7498202E+00 -0.9679435E+00 0.0000000E+00 1465 0 0.7657558E+00 -0.9872064E+00 0.0000000E+00 1466 0 0.7808444E+00 -0.9438787E+00 0.0000000E+00 1467 0 0.7804504E+00 -0.1007432E+01 0.0000000E+00 1468 4 0.7963860E+00 -0.1026695E+01 0.0000000E+00 1469 0 0.8127156E+00 -0.9824043E+00 0.0000000E+00 1470 0 0.6769212E+00 -0.7690037E+00 0.0000000E+00 1471 3 0.6609856E+00 -0.7497409E+00 0.0000000E+00 1472 0 0.6940349E+00 -0.7872279E+00 0.0000000E+00 1473 0 0.7016608E+00 -0.7471928E+00 0.0000000E+00 1474 0 0.7099705E+00 -0.8064907E+00 0.0000000E+00 1475 0 0.7270842E+00 -0.8247150E+00 0.0000000E+00 1476 0 0.7358882E+00 -0.7836412E+00 0.0000000E+00 1477 0 0.7430198E+00 -0.8439778E+00 0.0000000E+00 1478 0 0.7601334E+00 -0.8622020E+00 0.0000000E+00 1479 0 0.7701156E+00 -0.8200897E+00 0.0000000E+00 1480 0 0.7760690E+00 -0.8814649E+00 0.0000000E+00 1481 0 0.7931826E+00 -0.8996890E+00 0.0000000E+00 1482 0 0.8043428E+00 -0.8565381E+00 0.0000000E+00 1483 0 0.8091183E+00 -0.9189519E+00 0.0000000E+00 1484 0 0.8262320E+00 -0.9371762E+00 0.0000000E+00 1485 0 0.8385702E+00 -0.8929866E+00 0.0000000E+00 1486 0 0.8421676E+00 -0.9564390E+00 0.0000000E+00 1487 4 0.8592812E+00 -0.9746632E+00 0.0000000E+00 1488 0 0.8727976E+00 -0.9294350E+00 0.0000000E+00 1489 0 0.7238716E+00 -0.7249820E+00 0.0000000E+00 1490 3 0.7067579E+00 -0.7067578E+00 0.0000000E+00 1491 0 0.7420958E+00 -0.7420957E+00 0.0000000E+00 1492 0 0.7471929E+00 -0.7016607E+00 0.0000000E+00 1493 0 0.7592095E+00 -0.7603199E+00 0.0000000E+00 1494 0 0.7774338E+00 -0.7774336E+00 0.0000000E+00 1495 0 0.7836413E+00 -0.7358881E+00 0.0000000E+00 1496 0 0.7945474E+00 -0.7956578E+00 0.0000000E+00 1497 0 0.8127716E+00 -0.8127715E+00 0.0000000E+00 1498 0 0.8200898E+00 -0.7701154E+00 0.0000000E+00 1499 0 0.8298852E+00 -0.8309957E+00 0.0000000E+00 1500 0 0.8481094E+00 -0.8481094E+00 0.0000000E+00 1501 0 0.8565381E+00 -0.8043427E+00 0.0000000E+00 1502 0 0.8652231E+00 -0.8663336E+00 0.0000000E+00 1503 0 0.8834473E+00 -0.8834473E+00 0.0000000E+00 1504 0 0.8929866E+00 -0.8385701E+00 0.0000000E+00 1505 0 0.9005610E+00 -0.9016715E+00 0.0000000E+00 1506 4 0.9187852E+00 -0.9187852E+00 0.0000000E+00 1507 0 0.9294350E+00 -0.8727975E+00 0.0000000E+00 1508 0 0.7679652E+00 -0.6780992E+00 0.0000000E+00 1509 3 0.7497410E+00 -0.6609855E+00 0.0000000E+00 1510 0 0.7872280E+00 -0.6940348E+00 0.0000000E+00 1511 0 0.7897761E+00 -0.6533596E+00 0.0000000E+00 1512 0 0.8054522E+00 -0.7111484E+00 0.0000000E+00 1513 0 0.8247151E+00 -0.7270841E+00 0.0000000E+00 1514 0 0.8283017E+00 -0.6852308E+00 0.0000000E+00 1515 0 0.8429393E+00 -0.7441977E+00 0.0000000E+00 1516 0 0.8622020E+00 -0.7601333E+00 0.0000000E+00 1517 0 0.8668274E+00 -0.7171020E+00 0.0000000E+00 1518 0 0.8804263E+00 -0.7772470E+00 0.0000000E+00 1519 0 0.8996891E+00 -0.7931826E+00 0.0000000E+00 1520 0 0.9053530E+00 -0.7489731E+00 0.0000000E+00 1521 0 0.9179133E+00 -0.8102962E+00 0.0000000E+00 1522 0 0.9371762E+00 -0.8262319E+00 0.0000000E+00 1523 0 0.9438787E+00 -0.7808443E+00 0.0000000E+00 1524 0 0.9554004E+00 -0.8433456E+00 0.0000000E+00 1525 4 0.9746632E+00 -0.8592812E+00 0.0000000E+00 1526 0 0.9824044E+00 -0.8127155E+00 0.0000000E+00 1527 0 0.8090279E+00 -0.6285402E+00 0.0000000E+00 1528 3 0.7897651E+00 -0.6126046E+00 0.0000000E+00 1529 0 0.8292533E+00 -0.6432348E+00 0.0000000E+00 1530 0 0.8292424E+00 -0.6024798E+00 0.0000000E+00 1531 0 0.8485162E+00 -0.6591704E+00 0.0000000E+00 1532 0 0.8687417E+00 -0.6738651E+00 0.0000000E+00 1533 0 0.8696933E+00 -0.6318691E+00 0.0000000E+00 1534 0 0.8880045E+00 -0.6898006E+00 0.0000000E+00 1535 0 0.9082299E+00 -0.7044953E+00 0.0000000E+00 1536 0 0.9101442E+00 -0.6612583E+00 0.0000000E+00 1537 0 0.9274927E+00 -0.7204308E+00 0.0000000E+00 1538 0 0.9477181E+00 -0.7351255E+00 0.0000000E+00 1539 0 0.9505949E+00 -0.6906476E+00 0.0000000E+00 1540 0 0.9669809E+00 -0.7510611E+00 0.0000000E+00 1541 0 0.9872064E+00 -0.7657557E+00 0.0000000E+00 1542 0 0.9910458E+00 -0.7200369E+00 0.0000000E+00 1543 0 0.1006469E+01 -0.7816913E+00 0.0000000E+00 1544 4 0.1026695E+01 -0.7963859E+00 0.0000000E+00 1545 0 0.1031497E+01 -0.7494261E+00 0.0000000E+00 1546 0 0.8468979E+00 -0.5765006E+00 0.0000000E+00 1547 3 0.8266725E+00 -0.5618060E+00 0.0000000E+00 1548 0 0.8680061E+00 -0.5898962E+00 0.0000000E+00 1549 0 0.8654361E+00 -0.5492224E+00 0.0000000E+00 1550 0 0.8882315E+00 -0.6045909E+00 0.0000000E+00 1551 0 0.9093398E+00 -0.6179866E+00 0.0000000E+00 1552 0 0.9076525E+00 -0.5760137E+00 0.0000000E+00 1553 0 0.9295652E+00 -0.6326812E+00 0.0000000E+00 1554 0 0.9506733E+00 -0.6460768E+00 0.0000000E+00 1555 0 0.9498689E+00 -0.6028051E+00 0.0000000E+00 1556 0 0.9708987E+00 -0.6607715E+00 0.0000000E+00 1557 0 0.9920069E+00 -0.6741671E+00 0.0000000E+00 1558 0 0.9920853E+00 -0.6295964E+00 0.0000000E+00 1559 0 0.1012232E+01 -0.6888617E+00 0.0000000E+00 1560 0 0.1033341E+01 -0.7022575E+00 0.0000000E+00 1561 0 0.1034302E+01 -0.6563877E+00 0.0000000E+00 1562 0 0.1053566E+01 -0.7169521E+00 0.0000000E+00 1563 4 0.1074674E+01 -0.7303478E+00 0.0000000E+00 1564 0 0.1076518E+01 -0.6831791E+00 0.0000000E+00 1565 0 0.8814255E+00 -0.5221858E+00 0.0000000E+00 1566 3 0.8603173E+00 -0.5087902E+00 0.0000000E+00 1567 0 0.9033331E+00 -0.5342296E+00 0.0000000E+00 1568 0 0.8982143E+00 -0.4937974E+00 0.0000000E+00 1569 0 0.9244414E+00 -0.5476254E+00 0.0000000E+00 1570 0 0.9463491E+00 -0.5596692E+00 0.0000000E+00 1571 0 0.9420297E+00 -0.5178851E+00 0.0000000E+00 1572 0 0.9674572E+00 -0.5730648E+00 0.0000000E+00 1573 0 0.9893649E+00 -0.5851087E+00 0.0000000E+00 1574 0 0.9858450E+00 -0.5419728E+00 0.0000000E+00 1575 0 0.1010473E+01 -0.5985043E+00 0.0000000E+00 1576 0 0.1032381E+01 -0.6105481E+00 0.0000000E+00 1577 0 0.1029660E+01 -0.5660604E+00 0.0000000E+00 1578 0 0.1053489E+01 -0.6239438E+00 0.0000000E+00 1579 0 0.1075397E+01 -0.6359877E+00 0.0000000E+00 1580 0 0.1073476E+01 -0.5901481E+00 0.0000000E+00 1581 0 0.1096505E+01 -0.6493834E+00 0.0000000E+00 1582 4 0.1118412E+01 -0.6614272E+00 0.0000000E+00 1583 0 0.1117291E+01 -0.6142358E+00 0.0000000E+00 1584 0 0.9124745E+00 -0.4658103E+00 0.0000000E+00 1585 3 0.8905669E+00 -0.4537665E+00 0.0000000E+00 1586 0 0.9350952E+00 -0.4764547E+00 0.0000000E+00 1587 0 0.9274477E+00 -0.4364238E+00 0.0000000E+00 1588 0 0.9570029E+00 -0.4884986E+00 0.0000000E+00 1589 0 0.9796236E+00 -0.4991431E+00 0.0000000E+00 1590 0 0.9726891E+00 -0.4577127E+00 0.0000000E+00 1591 0 0.1001531E+01 -0.5111869E+00 0.0000000E+00 1592 0 0.1024152E+01 -0.5218314E+00 0.0000000E+00 1593 0 0.1017930E+01 -0.4790017E+00 0.0000000E+00 1594 0 0.1046060E+01 -0.5338752E+00 0.0000000E+00 1595 0 0.1068680E+01 -0.5445197E+00 0.0000000E+00 1596 0 0.1063172E+01 -0.5002906E+00 0.0000000E+00 1597 0 0.1090588E+01 -0.5565635E+00 0.0000000E+00 1598 0 0.1113209E+01 -0.5672080E+00 0.0000000E+00 1599 0 0.1108413E+01 -0.5215796E+00 0.0000000E+00 1600 0 0.1135116E+01 -0.5792519E+00 0.0000000E+00 1601 4 0.1157737E+01 -0.5898964E+00 0.0000000E+00 1602 0 0.1153654E+01 -0.5428686E+00 0.0000000E+00 1603 0 0.9399224E+00 -0.4075964E+00 0.0000000E+00 1604 3 0.9173018E+00 -0.3969519E+00 0.0000000E+00 1605 0 0.9631668E+00 -0.4167995E+00 0.0000000E+00 1606 0 0.9530209E+00 -0.3773277E+00 0.0000000E+00 1607 0 0.9857875E+00 -0.4274440E+00 0.0000000E+00 1608 0 0.1009032E+01 -0.4366471E+00 0.0000000E+00 1609 0 0.9995097E+00 -0.3957339E+00 0.0000000E+00 1610 0 0.1031653E+01 -0.4472916E+00 0.0000000E+00 1611 0 0.1054897E+01 -0.4564947E+00 0.0000000E+00 1612 0 0.1045999E+01 -0.4141401E+00 0.0000000E+00 1613 0 0.1077518E+01 -0.4671392E+00 0.0000000E+00 1614 0 0.1100762E+01 -0.4763422E+00 0.0000000E+00 1615 0 0.1092487E+01 -0.4325463E+00 0.0000000E+00 1616 0 0.1123383E+01 -0.4869867E+00 0.0000000E+00 1617 0 0.1146627E+01 -0.4961898E+00 0.0000000E+00 1618 0 0.1138976E+01 -0.4509525E+00 0.0000000E+00 1619 0 0.1169248E+01 -0.5068343E+00 0.0000000E+00 1620 4 0.1192492E+01 -0.5160375E+00 0.0000000E+00 1621 0 0.1185465E+01 -0.4693588E+00 0.0000000E+00 1622 0 0.9636609E+00 -0.3477739E+00 0.0000000E+00 1623 3 0.9404165E+00 -0.3385708E+00 0.0000000E+00 1624 0 0.9874373E+00 -0.3554993E+00 0.0000000E+00 1625 0 0.9748329E+00 -0.3167424E+00 0.0000000E+00 1626 0 0.1010682E+01 -0.3647024E+00 0.0000000E+00 1627 0 0.1034458E+01 -0.3724278E+00 0.0000000E+00 1628 0 0.1022386E+01 -0.3321932E+00 0.0000000E+00 1629 0 0.1057703E+01 -0.3816309E+00 0.0000000E+00 1630 0 0.1081479E+01 -0.3893563E+00 0.0000000E+00 1631 0 0.1069939E+01 -0.3476440E+00 0.0000000E+00 1632 0 0.1104723E+01 -0.3985594E+00 0.0000000E+00 1633 0 0.1128500E+01 -0.4062848E+00 0.0000000E+00 1634 0 0.1117491E+01 -0.3630949E+00 0.0000000E+00 1635 0 0.1151744E+01 -0.4154880E+00 0.0000000E+00 1636 0 0.1175521E+01 -0.4232134E+00 0.0000000E+00 1637 0 0.1165044E+01 -0.3785457E+00 0.0000000E+00 1638 0 0.1198765E+01 -0.4324165E+00 0.0000000E+00 1639 4 0.1222541E+01 -0.4401420E+00 0.0000000E+00 1640 0 0.1212597E+01 -0.3939966E+00 0.0000000E+00 1641 0 0.9835962E+00 -0.2865788E+00 0.0000000E+00 1642 3 0.9598199E+00 -0.2788534E+00 0.0000000E+00 1643 0 0.1007811E+01 -0.2927960E+00 0.0000000E+00 1644 0 0.9927978E+00 -0.2549070E+00 0.0000000E+00 1645 0 0.1031587E+01 -0.3005214E+00 0.0000000E+00 1646 0 0.1055802E+01 -0.3067387E+00 0.0000000E+00 1647 0 0.1041227E+01 -0.2673415E+00 0.0000000E+00 1648 0 0.1079578E+01 -0.3144641E+00 0.0000000E+00 1649 0 0.1103793E+01 -0.3206813E+00 0.0000000E+00 1650 0 0.1089656E+01 -0.2797760E+00 0.0000000E+00 1651 0 0.1127569E+01 -0.3284068E+00 0.0000000E+00 1652 0 0.1151784E+01 -0.3346240E+00 0.0000000E+00 1653 0 0.1138085E+01 -0.2922105E+00 0.0000000E+00 1654 0 0.1175560E+01 -0.3423495E+00 0.0000000E+00 1655 0 0.1199775E+01 -0.3485668E+00 0.0000000E+00 1656 0 0.1186514E+01 -0.3046450E+00 0.0000000E+00 1657 0 0.1223551E+01 -0.3562922E+00 0.0000000E+00 1658 4 0.1247766E+01 -0.3625094E+00 0.0000000E+00 1659 0 0.1234944E+01 -0.3170795E+00 0.0000000E+00 1660 0 0.9996498E+00 -0.2242527E+00 0.0000000E+00 1661 3 0.9754352E+00 -0.2180355E+00 0.0000000E+00 1662 0 0.1024207E+01 -0.2289372E+00 0.0000000E+00 1663 0 0.1006844E+01 -0.1920657E+00 0.0000000E+00 1664 0 0.1048422E+01 -0.2351545E+00 0.0000000E+00 1665 0 0.1072979E+01 -0.2398391E+00 0.0000000E+00 1666 0 0.1055959E+01 -0.2014348E+00 0.0000000E+00 1667 0 0.1097193E+01 -0.2460563E+00 0.0000000E+00 1668 0 0.1121750E+01 -0.2507408E+00 0.0000000E+00 1669 0 0.1105073E+01 -0.2108038E+00 0.0000000E+00 1670 0 0.1145965E+01 -0.2569580E+00 0.0000000E+00 1671 0 0.1170522E+01 -0.2616426E+00 0.0000000E+00 1672 0 0.1154187E+01 -0.2201729E+00 0.0000000E+00 1673 0 0.1194737E+01 -0.2678599E+00 0.0000000E+00 1674 0 0.1219294E+01 -0.2725445E+00 0.0000000E+00 1675 0 0.1203302E+01 -0.2295420E+00 0.0000000E+00 1676 0 0.1243509E+01 -0.2787617E+00 0.0000000E+00 1677 4 0.1268066E+01 -0.2834462E+00 0.0000000E+00 1678 0 0.1252416E+01 -0.2389111E+00 0.0000000E+00 1679 0 0.1011758E+01 -0.1610417E+00 0.0000000E+00 1680 3 0.9872010E+00 -0.1563572E+00 0.0000000E+00 1681 0 0.1036561E+01 -0.1641750E+00 0.0000000E+00 1682 0 0.1016918E+01 -0.1284665E+00 0.0000000E+00 1683 0 0.1061118E+01 -0.1688596E+00 0.0000000E+00 1684 0 0.1085921E+01 -0.1719930E+00 0.0000000E+00 1685 0 0.1066523E+01 -0.1347332E+00 0.0000000E+00 1686 0 0.1110478E+01 -0.1766775E+00 0.0000000E+00 1687 0 0.1135281E+01 -0.1798108E+00 0.0000000E+00 1688 0 0.1116129E+01 -0.1409999E+00 0.0000000E+00 1689 0 0.1159838E+01 -0.1844953E+00 0.0000000E+00 1690 0 0.1184641E+01 -0.1876286E+00 0.0000000E+00 1691 0 0.1165735E+01 -0.1472665E+00 0.0000000E+00 1692 0 0.1209198E+01 -0.1923132E+00 0.0000000E+00 1693 0 0.1234001E+01 -0.1954466E+00 0.0000000E+00 1694 0 0.1215340E+01 -0.1535332E+00 0.0000000E+00 1695 0 0.1258558E+01 -0.2001311E+00 0.0000000E+00 1696 4 0.1283361E+01 -0.2032644E+00 0.0000000E+00 1697 0 0.1264946E+01 -0.1597999E+00 0.0000000E+00 1698 0 0.1019874E+01 -0.9719517E-01 0.0000000E+00 1699 3 0.9950707E+00 -0.9406187E-01 0.0000000E+00 1700 0 0.1044824E+01 -0.9876490E-01 0.0000000E+00 1701 0 0.1022977E+01 -0.6436023E-01 0.0000000E+00 1702 0 0.1069627E+01 -0.1018983E+00 0.0000000E+00 1703 0 0.1094578E+01 -0.1034681E+00 0.0000000E+00 1704 0 0.1072879E+01 -0.6749975E-01 0.0000000E+00 1705 0 0.1119381E+01 -0.1066014E+00 0.0000000E+00 1706 0 0.1144331E+01 -0.1081711E+00 0.0000000E+00 1707 0 0.1122780E+01 -0.7063927E-01 0.0000000E+00 1708 0 0.1169134E+01 -0.1113044E+00 0.0000000E+00 1709 0 0.1194085E+01 -0.1128742E+00 0.0000000E+00 1710 0 0.1172681E+01 -0.7377879E-01 0.0000000E+00 1711 0 0.1218888E+01 -0.1160076E+00 0.0000000E+00 1712 0 0.1243838E+01 -0.1175774E+00 0.0000000E+00 1713 0 0.1222583E+01 -0.7691838E-01 0.0000000E+00 1714 0 0.1268641E+01 -0.1207107E+00 0.0000000E+00 1715 4 0.1293592E+01 -0.1222804E+00 0.0000000E+00 1716 0 0.1272484E+01 -0.8005792E-01 0.0000000E+00 1717 0 0.1023964E+01 -0.3296498E-01 0.0000000E+00 1718 3 0.9990134E+00 -0.3139525E-01 0.0000000E+00 1719 0 0.1048964E+01 -0.3296495E-01 0.0000000E+00 1720 0 0.1025000E+01 0.3040868E-07 0.0000000E+00 1721 0 0.1073915E+01 -0.3453474E-01 0.0000000E+00 1722 0 0.1098915E+01 -0.3453476E-01 0.0000000E+00 1723 0 0.1075000E+01 0.3976525E-07 0.0000000E+00 1724 0 0.1123865E+01 -0.3610449E-01 0.0000000E+00 1725 0 0.1148865E+01 -0.3610446E-01 0.0000000E+00 1726 0 0.1125000E+01 0.4678267E-07 0.0000000E+00 1727 0 0.1173816E+01 -0.3767425E-01 0.0000000E+00 1728 0 0.1198816E+01 -0.3767428E-01 0.0000000E+00 1729 0 0.1175000E+01 0.4678262E-07 0.0000000E+00 1730 0 0.1223767E+01 -0.3924408E-01 0.0000000E+00 1731 0 0.1248767E+01 -0.3924411E-01 0.0000000E+00 1732 0 0.1225000E+01 -0.1403477E-07 0.0000000E+00 1733 0 0.1273717E+01 -0.4081385E-01 0.0000000E+00 1734 4 0.1298717E+01 -0.4081383E-01 0.0000000E+00 1735 0 0.1275000E+01 -0.2339128E-07 0.0000000E+00 1736 0 0.1024013E+01 0.3139529E-01 0.0000000E+00 1737 3 0.9990134E+00 0.3139526E-01 0.0000000E+00 1738 0 0.1048964E+01 0.3296509E-01 0.0000000E+00 1739 0 0.1022977E+01 0.6436032E-01 0.0000000E+00 1740 0 0.1073964E+01 0.3296507E-01 0.0000000E+00 1741 0 0.1098915E+01 0.3453478E-01 0.0000000E+00 1742 0 0.1072879E+01 0.6749983E-01 0.0000000E+00 1743 0 0.1123915E+01 0.3453480E-01 0.0000000E+00 1744 0 0.1148865E+01 0.3610460E-01 0.0000000E+00 1745 0 0.1122780E+01 0.7063933E-01 0.0000000E+00 1746 0 0.1173865E+01 0.3610457E-01 0.0000000E+00 1747 0 0.1198816E+01 0.3767437E-01 0.0000000E+00 1748 0 0.1172681E+01 0.7377892E-01 0.0000000E+00 1749 0 0.1223816E+01 0.3767434E-01 0.0000000E+00 1750 0 0.1248767E+01 0.3924402E-01 0.0000000E+00 1751 0 0.1222583E+01 0.7691840E-01 0.0000000E+00 1752 0 0.1273767E+01 0.3924404E-01 0.0000000E+00 1753 4 0.1298717E+01 0.4081384E-01 0.0000000E+00 1754 0 0.1272484E+01 0.8005788E-01 0.0000000E+00 1755 0 0.1020021E+01 0.9563168E-01 0.0000000E+00 1756 3 0.9950707E+00 0.9406188E-01 0.0000000E+00 1757 0 0.1044824E+01 0.9876503E-01 0.0000000E+00 1758 0 0.1016918E+01 0.1284666E+00 0.0000000E+00 1759 0 0.1069775E+01 0.1003347E+00 0.0000000E+00 1760 0 0.1094578E+01 0.1034681E+00 0.0000000E+00 1761 0 0.1066523E+01 0.1347333E+00 0.0000000E+00 1762 0 0.1119528E+01 0.1050379E+00 0.0000000E+00 1763 0 0.1144331E+01 0.1081711E+00 0.0000000E+00 1764 0 0.1116129E+01 0.1409999E+00 0.0000000E+00 1765 0 0.1169282E+01 0.1097409E+00 0.0000000E+00 1766 0 0.1194085E+01 0.1128743E+00 0.0000000E+00 1767 0 0.1165735E+01 0.1472665E+00 0.0000000E+00 1768 0 0.1219036E+01 0.1144439E+00 0.0000000E+00 1769 0 0.1243838E+01 0.1175773E+00 0.0000000E+00 1770 0 0.1215340E+01 0.1535332E+00 0.0000000E+00 1771 0 0.1268789E+01 0.1191471E+00 0.0000000E+00 1772 4 0.1293592E+01 0.1222804E+00 0.0000000E+00 1773 0 0.1264946E+01 0.1597999E+00 0.0000000E+00 1774 0 0.1012004E+01 0.1594906E+00 0.0000000E+00 1775 3 0.9872010E+00 0.1563573E+00 0.0000000E+00 1776 0 0.1036561E+01 0.1641752E+00 0.0000000E+00 1777 0 0.1006844E+01 0.1920659E+00 0.0000000E+00 1778 0 0.1061364E+01 0.1673085E+00 0.0000000E+00 1779 0 0.1085921E+01 0.1719930E+00 0.0000000E+00 1780 0 0.1055959E+01 0.2014349E+00 0.0000000E+00 1781 0 0.1110724E+01 0.1751263E+00 0.0000000E+00 1782 0 0.1135281E+01 0.1798108E+00 0.0000000E+00 1783 0 0.1105073E+01 0.2108040E+00 0.0000000E+00 1784 0 0.1160084E+01 0.1829442E+00 0.0000000E+00 1785 0 0.1184641E+01 0.1876287E+00 0.0000000E+00 1786 0 0.1154187E+01 0.2201731E+00 0.0000000E+00 1787 0 0.1209444E+01 0.1907621E+00 0.0000000E+00 1788 0 0.1234001E+01 0.1954466E+00 0.0000000E+00 1789 0 0.1203302E+01 0.2295421E+00 0.0000000E+00 1790 0 0.1258804E+01 0.1985799E+00 0.0000000E+00 1791 4 0.1283361E+01 0.2032645E+00 0.0000000E+00 1792 0 0.1252416E+01 0.2389111E+00 0.0000000E+00 1793 0 0.9999923E+00 0.2227202E+00 0.0000000E+00 1794 3 0.9754352E+00 0.2180356E+00 0.0000000E+00 1795 0 0.1024207E+01 0.2289374E+00 0.0000000E+00 1796 0 0.9927977E+00 0.2549072E+00 0.0000000E+00 1797 0 0.1048764E+01 0.2336219E+00 0.0000000E+00 1798 0 0.1072979E+01 0.2398392E+00 0.0000000E+00 1799 0 0.1041227E+01 0.2673417E+00 0.0000000E+00 1800 0 0.1097536E+01 0.2445238E+00 0.0000000E+00 1801 0 0.1121750E+01 0.2507410E+00 0.0000000E+00 1802 0 0.1089656E+01 0.2797762E+00 0.0000000E+00 1803 0 0.1146308E+01 0.2554256E+00 0.0000000E+00 1804 0 0.1170522E+01 0.2616427E+00 0.0000000E+00 1805 0 0.1138085E+01 0.2922106E+00 0.0000000E+00 1806 0 0.1195079E+01 0.2663272E+00 0.0000000E+00 1807 0 0.1219294E+01 0.2725445E+00 0.0000000E+00 1808 0 0.1186514E+01 0.3046451E+00 0.0000000E+00 1809 0 0.1243851E+01 0.2772290E+00 0.0000000E+00 1810 4 0.1268066E+01 0.2834463E+00 0.0000000E+00 1811 0 0.1234943E+01 0.3170796E+00 0.0000000E+00 1812 0 0.9840344E+00 0.2850707E+00 0.0000000E+00 1813 3 0.9598199E+00 0.2788535E+00 0.0000000E+00 1814 0 0.1007811E+01 0.2927961E+00 0.0000000E+00 1815 0 0.9748329E+00 0.3167424E+00 0.0000000E+00 1816 0 0.1032025E+01 0.2990134E+00 0.0000000E+00 1817 0 0.1055802E+01 0.3067388E+00 0.0000000E+00 1818 0 0.1022386E+01 0.3321933E+00 0.0000000E+00 1819 0 0.1080016E+01 0.3129561E+00 0.0000000E+00 1820 0 0.1103793E+01 0.3206815E+00 0.0000000E+00 1821 0 0.1069939E+01 0.3476441E+00 0.0000000E+00 1822 0 0.1128007E+01 0.3268987E+00 0.0000000E+00 1823 0 0.1151784E+01 0.3346241E+00 0.0000000E+00 1824 0 0.1117491E+01 0.3630950E+00 0.0000000E+00 1825 0 0.1175998E+01 0.3408414E+00 0.0000000E+00 1826 0 0.1199775E+01 0.3485668E+00 0.0000000E+00 1827 0 0.1165044E+01 0.3785458E+00 0.0000000E+00 1828 0 0.1223989E+01 0.3547841E+00 0.0000000E+00 1829 4 0.1247766E+01 0.3625095E+00 0.0000000E+00 1830 0 0.1212597E+01 0.3939967E+00 0.0000000E+00 1831 0 0.9641929E+00 0.3462962E+00 0.0000000E+00 1832 3 0.9404165E+00 0.3385708E+00 0.0000000E+00 1833 0 0.9874373E+00 0.3554993E+00 0.0000000E+00 1834 0 0.9530209E+00 0.3773277E+00 0.0000000E+00 1835 0 0.1011214E+01 0.3632247E+00 0.0000000E+00 1836 0 0.1034458E+01 0.3724279E+00 0.0000000E+00 1837 0 0.9995097E+00 0.3957339E+00 0.0000000E+00 1838 0 0.1058235E+01 0.3801533E+00 0.0000000E+00 1839 0 0.1081479E+01 0.3893564E+00 0.0000000E+00 1840 0 0.1045999E+01 0.4141401E+00 0.0000000E+00 1841 0 0.1105255E+01 0.3970818E+00 0.0000000E+00 1842 0 0.1128500E+01 0.4062849E+00 0.0000000E+00 1843 0 0.1092487E+01 0.4325463E+00 0.0000000E+00 1844 0 0.1152276E+01 0.4140103E+00 0.0000000E+00 1845 0 0.1175521E+01 0.4232135E+00 0.0000000E+00 1846 0 0.1138976E+01 0.4509526E+00 0.0000000E+00 1847 0 0.1199297E+01 0.4309389E+00 0.0000000E+00 1848 4 0.1222541E+01 0.4401420E+00 0.0000000E+00 1849 0 0.1185465E+01 0.4693588E+00 0.0000000E+00 1850 0 0.9405462E+00 0.4061550E+00 0.0000000E+00 1851 3 0.9173018E+00 0.3969519E+00 0.0000000E+00 1852 0 0.9631668E+00 0.4167995E+00 0.0000000E+00 1853 0 0.9274477E+00 0.4364238E+00 0.0000000E+00 1854 0 0.9864113E+00 0.4260026E+00 0.0000000E+00 1855 0 0.1009032E+01 0.4366471E+00 0.0000000E+00 1856 0 0.9726891E+00 0.4577128E+00 0.0000000E+00 1857 0 0.1032276E+01 0.4458503E+00 0.0000000E+00 1858 0 0.1054897E+01 0.4564947E+00 0.0000000E+00 1859 0 0.1017930E+01 0.4790017E+00 0.0000000E+00 1860 0 0.1078141E+01 0.4656978E+00 0.0000000E+00 1861 0 0.1100762E+01 0.4763422E+00 0.0000000E+00 1862 0 0.1063172E+01 0.5002906E+00 0.0000000E+00 1863 0 0.1124007E+01 0.4855454E+00 0.0000000E+00 1864 0 0.1146627E+01 0.4961899E+00 0.0000000E+00 1865 0 0.1108413E+01 0.5215796E+00 0.0000000E+00 1866 0 0.1169872E+01 0.5053930E+00 0.0000000E+00 1867 4 0.1192492E+01 0.5160375E+00 0.0000000E+00 1868 0 0.1153655E+01 0.5428686E+00 0.0000000E+00 1869 0 0.9131875E+00 0.4644110E+00 0.0000000E+00 1870 3 0.8905669E+00 0.4537665E+00 0.0000000E+00 1871 0 0.9350951E+00 0.4764549E+00 0.0000000E+00 1872 0 0.8982143E+00 0.4937976E+00 0.0000000E+00 1873 0 0.9577158E+00 0.4870994E+00 0.0000000E+00 1874 0 0.9796236E+00 0.4991432E+00 0.0000000E+00 1875 0 0.9420296E+00 0.5178852E+00 0.0000000E+00 1876 0 0.1002244E+01 0.5097876E+00 0.0000000E+00 1877 0 0.1024152E+01 0.5218314E+00 0.0000000E+00 1878 0 0.9858450E+00 0.5419729E+00 0.0000000E+00 1879 0 0.1046773E+01 0.5324759E+00 0.0000000E+00 1880 0 0.1068680E+01 0.5445198E+00 0.0000000E+00 1881 0 0.1029660E+01 0.5660606E+00 0.0000000E+00 1882 0 0.1091301E+01 0.5551643E+00 0.0000000E+00 1883 0 0.1113209E+01 0.5672081E+00 0.0000000E+00 1884 0 0.1073476E+01 0.5901483E+00 0.0000000E+00 1885 0 0.1135829E+01 0.5778525E+00 0.0000000E+00 1886 4 0.1157737E+01 0.5898964E+00 0.0000000E+00 1887 0 0.1117291E+01 0.6142359E+00 0.0000000E+00 1888 0 0.8822249E+00 0.5208341E+00 0.0000000E+00 1889 3 0.8603173E+00 0.5087903E+00 0.0000000E+00 1890 0 0.9033331E+00 0.5342298E+00 0.0000000E+00 1891 0 0.8654361E+00 0.5492225E+00 0.0000000E+00 1892 0 0.9252408E+00 0.5462736E+00 0.0000000E+00 1893 0 0.9463490E+00 0.5596693E+00 0.0000000E+00 1894 0 0.9076525E+00 0.5760138E+00 0.0000000E+00 1895 0 0.9682567E+00 0.5717131E+00 0.0000000E+00 1896 0 0.9893649E+00 0.5851088E+00 0.0000000E+00 1897 0 0.9498689E+00 0.6028051E+00 0.0000000E+00 1898 0 0.1011272E+01 0.5971527E+00 0.0000000E+00 1899 0 0.1032381E+01 0.6105483E+00 0.0000000E+00 1900 0 0.9920852E+00 0.6295965E+00 0.0000000E+00 1901 0 0.1054288E+01 0.6225921E+00 0.0000000E+00 1902 0 0.1075397E+01 0.6359878E+00 0.0000000E+00 1903 0 0.1034302E+01 0.6563878E+00 0.0000000E+00 1904 0 0.1097304E+01 0.6480316E+00 0.0000000E+00 1905 4 0.1118412E+01 0.6614273E+00 0.0000000E+00 1906 0 0.1076518E+01 0.6831791E+00 0.0000000E+00 1907 0 0.8477806E+00 0.5752017E+00 0.0000000E+00 1908 3 0.8266725E+00 0.5618060E+00 0.0000000E+00 1909 0 0.8680061E+00 0.5898963E+00 0.0000000E+00 1910 0 0.8292424E+00 0.6024798E+00 0.0000000E+00 1911 0 0.8891143E+00 0.6032920E+00 0.0000000E+00 1912 0 0.9093397E+00 0.6179866E+00 0.0000000E+00 1913 0 0.8696933E+00 0.6318691E+00 0.0000000E+00 1914 0 0.9304479E+00 0.6313823E+00 0.0000000E+00 1915 0 0.9506733E+00 0.6460769E+00 0.0000000E+00 1916 0 0.9101441E+00 0.6612584E+00 0.0000000E+00 1917 0 0.9717814E+00 0.6594726E+00 0.0000000E+00 1918 0 0.9920068E+00 0.6741672E+00 0.0000000E+00 1919 0 0.9505949E+00 0.6906477E+00 0.0000000E+00 1920 0 0.1013115E+01 0.6875629E+00 0.0000000E+00 1921 0 0.1033341E+01 0.7022575E+00 0.0000000E+00 1922 0 0.9910458E+00 0.7200370E+00 0.0000000E+00 1923 0 0.1054449E+01 0.7156532E+00 0.0000000E+00 1924 4 0.1074674E+01 0.7303478E+00 0.0000000E+00 1925 0 0.1031497E+01 0.7494262E+00 0.0000000E+00 1926 0 0.8099905E+00 0.6272992E+00 0.0000000E+00 1927 3 0.7897651E+00 0.6126046E+00 0.0000000E+00 1928 0 0.8292533E+00 0.6432348E+00 0.0000000E+00 1929 0 0.7897761E+00 0.6533596E+00 0.0000000E+00 1930 0 0.8494788E+00 0.6579295E+00 0.0000000E+00 1931 0 0.8687417E+00 0.6738651E+00 0.0000000E+00 1932 0 0.8283017E+00 0.6852308E+00 0.0000000E+00 1933 0 0.8889670E+00 0.6885598E+00 0.0000000E+00 1934 0 0.9082298E+00 0.7044953E+00 0.0000000E+00 1935 0 0.8668274E+00 0.7171020E+00 0.0000000E+00 1936 0 0.9284552E+00 0.7191899E+00 0.0000000E+00 1937 0 0.9477181E+00 0.7351255E+00 0.0000000E+00 1938 0 0.9053530E+00 0.7489732E+00 0.0000000E+00 1939 0 0.9679435E+00 0.7498202E+00 0.0000000E+00 1940 0 0.9872064E+00 0.7657558E+00 0.0000000E+00 1941 0 0.9438787E+00 0.7808444E+00 0.0000000E+00 1942 0 0.1007432E+01 0.7804504E+00 0.0000000E+00 1943 4 0.1026695E+01 0.7963860E+00 0.0000000E+00 1944 0 0.9824043E+00 0.8127156E+00 0.0000000E+00 1945 0 0.7690037E+00 0.6769212E+00 0.0000000E+00 1946 3 0.7497409E+00 0.6609856E+00 0.0000000E+00 1947 0 0.7872280E+00 0.6940348E+00 0.0000000E+00 1948 0 0.7471928E+00 0.7016608E+00 0.0000000E+00 1949 0 0.8064908E+00 0.7099704E+00 0.0000000E+00 1950 0 0.8247151E+00 0.7270841E+00 0.0000000E+00 1951 0 0.7836413E+00 0.7358881E+00 0.0000000E+00 1952 0 0.8439779E+00 0.7430197E+00 0.0000000E+00 1953 0 0.8622020E+00 0.7601334E+00 0.0000000E+00 1954 0 0.8200897E+00 0.7701155E+00 0.0000000E+00 1955 0 0.8814648E+00 0.7760690E+00 0.0000000E+00 1956 0 0.8996890E+00 0.7931827E+00 0.0000000E+00 1957 0 0.8565380E+00 0.8043429E+00 0.0000000E+00 1958 0 0.9189519E+00 0.8091183E+00 0.0000000E+00 1959 0 0.9371761E+00 0.8262320E+00 0.0000000E+00 1960 0 0.8929865E+00 0.8385702E+00 0.0000000E+00 1961 0 0.9564390E+00 0.8421676E+00 0.0000000E+00 1962 4 0.9746632E+00 0.8592812E+00 0.0000000E+00 1963 0 0.9294350E+00 0.8727976E+00 0.0000000E+00 1964 0 0.7249821E+00 0.7238716E+00 0.0000000E+00 1965 3 0.7067578E+00 0.7067579E+00 0.0000000E+00 1966 0 0.7420957E+00 0.7420957E+00 0.0000000E+00 1967 0 0.7016608E+00 0.7471929E+00 0.0000000E+00 1968 0 0.7603200E+00 0.7592094E+00 0.0000000E+00 1969 0 0.7774337E+00 0.7774336E+00 0.0000000E+00 1970 0 0.7358882E+00 0.7836412E+00 0.0000000E+00 1971 0 0.7956578E+00 0.7945473E+00 0.0000000E+00 1972 0 0.8127715E+00 0.8127715E+00 0.0000000E+00 1973 0 0.7701155E+00 0.8200896E+00 0.0000000E+00 1974 0 0.8309957E+00 0.8298852E+00 0.0000000E+00 1975 0 0.8481093E+00 0.8481095E+00 0.0000000E+00 1976 0 0.8043428E+00 0.8565381E+00 0.0000000E+00 1977 0 0.8663336E+00 0.8652231E+00 0.0000000E+00 1978 0 0.8834473E+00 0.8834474E+00 0.0000000E+00 1979 0 0.8385701E+00 0.8929866E+00 0.0000000E+00 1980 0 0.9016715E+00 0.9005610E+00 0.0000000E+00 1981 4 0.9187852E+00 0.9187852E+00 0.0000000E+00 1982 0 0.8727975E+00 0.9294350E+00 0.0000000E+00 1983 0 0.6780992E+00 0.7679651E+00 0.0000000E+00 1984 3 0.6609855E+00 0.7497410E+00 0.0000000E+00 1985 0 0.6940348E+00 0.7872279E+00 0.0000000E+00 1986 0 0.6533596E+00 0.7897760E+00 0.0000000E+00 1987 0 0.7111485E+00 0.8054521E+00 0.0000000E+00 1988 0 0.7270841E+00 0.8247150E+00 0.0000000E+00 1989 0 0.6852308E+00 0.8283017E+00 0.0000000E+00 1990 0 0.7441978E+00 0.8429392E+00 0.0000000E+00 1991 0 0.7601334E+00 0.8622020E+00 0.0000000E+00 1992 0 0.7171020E+00 0.8668274E+00 0.0000000E+00 1993 0 0.7772470E+00 0.8804263E+00 0.0000000E+00 1994 0 0.7931826E+00 0.8996890E+00 0.0000000E+00 1995 0 0.7489732E+00 0.9053530E+00 0.0000000E+00 1996 0 0.8102963E+00 0.9179133E+00 0.0000000E+00 1997 0 0.8262319E+00 0.9371762E+00 0.0000000E+00 1998 0 0.7808444E+00 0.9438787E+00 0.0000000E+00 1999 0 0.8433456E+00 0.9554004E+00 0.0000000E+00 2000 4 0.8592812E+00 0.9746632E+00 0.0000000E+00 2001 0 0.8127155E+00 0.9824044E+00 0.0000000E+00 2002 0 0.6285402E+00 0.8090279E+00 0.0000000E+00 2003 3 0.6126046E+00 0.7897651E+00 0.0000000E+00 2004 0 0.6432348E+00 0.8292533E+00 0.0000000E+00 2005 0 0.6024799E+00 0.8292424E+00 0.0000000E+00 2006 0 0.6591704E+00 0.8485162E+00 0.0000000E+00 2007 0 0.6738651E+00 0.8687417E+00 0.0000000E+00 2008 0 0.6318692E+00 0.8696932E+00 0.0000000E+00 2009 0 0.6898007E+00 0.8880044E+00 0.0000000E+00 2010 0 0.7044953E+00 0.9082299E+00 0.0000000E+00 2011 0 0.6612584E+00 0.9101442E+00 0.0000000E+00 2012 0 0.7204309E+00 0.9274927E+00 0.0000000E+00 2013 0 0.7351255E+00 0.9477181E+00 0.0000000E+00 2014 0 0.6906475E+00 0.9505950E+00 0.0000000E+00 2015 0 0.7510611E+00 0.9669810E+00 0.0000000E+00 2016 0 0.7657557E+00 0.9872064E+00 0.0000000E+00 2017 0 0.7200368E+00 0.9910458E+00 0.0000000E+00 2018 0 0.7816913E+00 0.1006469E+01 0.0000000E+00 2019 4 0.7963859E+00 0.1026695E+01 0.0000000E+00 2020 0 0.7494261E+00 0.1031497E+01 0.0000000E+00 2021 0 0.5765006E+00 0.8468979E+00 0.0000000E+00 2022 3 0.5618060E+00 0.8266725E+00 0.0000000E+00 2023 0 0.5898963E+00 0.8680061E+00 0.0000000E+00 2024 0 0.5492224E+00 0.8654361E+00 0.0000000E+00 2025 0 0.6045910E+00 0.8882315E+00 0.0000000E+00 2026 0 0.6179866E+00 0.9093397E+00 0.0000000E+00 2027 0 0.5760138E+00 0.9076525E+00 0.0000000E+00 2028 0 0.6326812E+00 0.9295652E+00 0.0000000E+00 2029 0 0.6460769E+00 0.9506733E+00 0.0000000E+00 2030 0 0.6028051E+00 0.9498689E+00 0.0000000E+00 2031 0 0.6607715E+00 0.9708987E+00 0.0000000E+00 2032 0 0.6741671E+00 0.9920069E+00 0.0000000E+00 2033 0 0.6295964E+00 0.9920853E+00 0.0000000E+00 2034 0 0.6888618E+00 0.1012232E+01 0.0000000E+00 2035 0 0.7022575E+00 0.1033341E+01 0.0000000E+00 2036 0 0.6563877E+00 0.1034302E+01 0.0000000E+00 2037 0 0.7169521E+00 0.1053566E+01 0.0000000E+00 2038 4 0.7303478E+00 0.1074674E+01 0.0000000E+00 2039 0 0.6831791E+00 0.1076518E+01 0.0000000E+00 2040 0 0.5221858E+00 0.8814255E+00 0.0000000E+00 2041 3 0.5087902E+00 0.8603173E+00 0.0000000E+00 2042 0 0.5342297E+00 0.9033332E+00 0.0000000E+00 2043 0 0.4937974E+00 0.8982144E+00 0.0000000E+00 2044 0 0.5476254E+00 0.9244414E+00 0.0000000E+00 2045 0 0.5596692E+00 0.9463491E+00 0.0000000E+00 2046 0 0.5178851E+00 0.9420297E+00 0.0000000E+00 2047 0 0.5730649E+00 0.9674572E+00 0.0000000E+00 2048 0 0.5851087E+00 0.9893649E+00 0.0000000E+00 2049 0 0.5419728E+00 0.9858450E+00 0.0000000E+00 2050 0 0.5985043E+00 0.1010473E+01 0.0000000E+00 2051 0 0.6105481E+00 0.1032381E+01 0.0000000E+00 2052 0 0.5660605E+00 0.1029660E+01 0.0000000E+00 2053 0 0.6239438E+00 0.1053489E+01 0.0000000E+00 2054 0 0.6359877E+00 0.1075397E+01 0.0000000E+00 2055 0 0.5901481E+00 0.1073476E+01 0.0000000E+00 2056 0 0.6493834E+00 0.1096505E+01 0.0000000E+00 2057 4 0.6614272E+00 0.1118412E+01 0.0000000E+00 2058 0 0.6142358E+00 0.1117291E+01 0.0000000E+00 2059 0 0.4658103E+00 0.9124745E+00 0.0000000E+00 2060 3 0.4537665E+00 0.8905669E+00 0.0000000E+00 2061 0 0.4764548E+00 0.9350952E+00 0.0000000E+00 2062 0 0.4364238E+00 0.9274477E+00 0.0000000E+00 2063 0 0.4884986E+00 0.9570029E+00 0.0000000E+00 2064 0 0.4991432E+00 0.9796236E+00 0.0000000E+00 2065 0 0.4577128E+00 0.9726891E+00 0.0000000E+00 2066 0 0.5111870E+00 0.1001531E+01 0.0000000E+00 2067 0 0.5218315E+00 0.1024152E+01 0.0000000E+00 2068 0 0.4790018E+00 0.1017930E+01 0.0000000E+00 2069 0 0.5338753E+00 0.1046060E+01 0.0000000E+00 2070 0 0.5445197E+00 0.1068680E+01 0.0000000E+00 2071 0 0.5002907E+00 0.1063172E+01 0.0000000E+00 2072 0 0.5565635E+00 0.1090588E+01 0.0000000E+00 2073 0 0.5672080E+00 0.1113209E+01 0.0000000E+00 2074 0 0.5215796E+00 0.1108413E+01 0.0000000E+00 2075 0 0.5792519E+00 0.1135116E+01 0.0000000E+00 2076 4 0.5898964E+00 0.1157737E+01 0.0000000E+00 2077 0 0.5428686E+00 0.1153654E+01 0.0000000E+00 2078 0 0.4075964E+00 0.9399224E+00 0.0000000E+00 2079 3 0.3969519E+00 0.9173018E+00 0.0000000E+00 2080 0 0.4167995E+00 0.9631668E+00 0.0000000E+00 2081 0 0.3773277E+00 0.9530209E+00 0.0000000E+00 2082 0 0.4274441E+00 0.9857875E+00 0.0000000E+00 2083 0 0.4366472E+00 0.1009032E+01 0.0000000E+00 2084 0 0.3957339E+00 0.9995097E+00 0.0000000E+00 2085 0 0.4472917E+00 0.1031653E+01 0.0000000E+00 2086 0 0.4564947E+00 0.1054897E+01 0.0000000E+00 2087 0 0.4141401E+00 0.1045999E+01 0.0000000E+00 2088 0 0.4671391E+00 0.1077518E+01 0.0000000E+00 2089 0 0.4763422E+00 0.1100762E+01 0.0000000E+00 2090 0 0.4325462E+00 0.1092487E+01 0.0000000E+00 2091 0 0.4869867E+00 0.1123383E+01 0.0000000E+00 2092 0 0.4961898E+00 0.1146627E+01 0.0000000E+00 2093 0 0.4509525E+00 0.1138976E+01 0.0000000E+00 2094 0 0.5068343E+00 0.1169248E+01 0.0000000E+00 2095 4 0.5160375E+00 0.1192492E+01 0.0000000E+00 2096 0 0.4693588E+00 0.1185465E+01 0.0000000E+00 2097 0 0.3477739E+00 0.9636609E+00 0.0000000E+00 2098 3 0.3385708E+00 0.9404165E+00 0.0000000E+00 2099 0 0.3554993E+00 0.9874373E+00 0.0000000E+00 2100 0 0.3167424E+00 0.9748329E+00 0.0000000E+00 2101 0 0.3647024E+00 0.1010682E+01 0.0000000E+00 2102 0 0.3724279E+00 0.1034458E+01 0.0000000E+00 2103 0 0.3321932E+00 0.1022386E+01 0.0000000E+00 2104 0 0.3816309E+00 0.1057703E+01 0.0000000E+00 2105 0 0.3893563E+00 0.1081479E+01 0.0000000E+00 2106 0 0.3476441E+00 0.1069939E+01 0.0000000E+00 2107 0 0.3985594E+00 0.1104723E+01 0.0000000E+00 2108 0 0.4062849E+00 0.1128500E+01 0.0000000E+00 2109 0 0.3630949E+00 0.1117491E+01 0.0000000E+00 2110 0 0.4154880E+00 0.1151744E+01 0.0000000E+00 2111 0 0.4232134E+00 0.1175521E+01 0.0000000E+00 2112 0 0.3785458E+00 0.1165044E+01 0.0000000E+00 2113 0 0.4324165E+00 0.1198765E+01 0.0000000E+00 2114 4 0.4401420E+00 0.1222541E+01 0.0000000E+00 2115 0 0.3939966E+00 0.1212597E+01 0.0000000E+00 2116 0 0.2865788E+00 0.9835962E+00 0.0000000E+00 2117 3 0.2788534E+00 0.9598199E+00 0.0000000E+00 2118 0 0.2927961E+00 0.1007811E+01 0.0000000E+00 2119 0 0.2549071E+00 0.9927977E+00 0.0000000E+00 2120 0 0.3005215E+00 0.1031587E+01 0.0000000E+00 2121 0 0.3067387E+00 0.1055802E+01 0.0000000E+00 2122 0 0.2673416E+00 0.1041227E+01 0.0000000E+00 2123 0 0.3144642E+00 0.1079578E+01 0.0000000E+00 2124 0 0.3206814E+00 0.1103793E+01 0.0000000E+00 2125 0 0.2797761E+00 0.1089656E+01 0.0000000E+00 2126 0 0.3284068E+00 0.1127569E+01 0.0000000E+00 2127 0 0.3346241E+00 0.1151784E+01 0.0000000E+00 2128 0 0.2922105E+00 0.1138085E+01 0.0000000E+00 2129 0 0.3423495E+00 0.1175560E+01 0.0000000E+00 2130 0 0.3485667E+00 0.1199775E+01 0.0000000E+00 2131 0 0.3046450E+00 0.1186514E+01 0.0000000E+00 2132 0 0.3562922E+00 0.1223551E+01 0.0000000E+00 2133 4 0.3625094E+00 0.1247766E+01 0.0000000E+00 2134 0 0.3170795E+00 0.1234944E+01 0.0000000E+00 2135 0 0.2242528E+00 0.9996498E+00 0.0000000E+00 2136 3 0.2180355E+00 0.9754352E+00 0.0000000E+00 2137 0 0.2289373E+00 0.1024207E+01 0.0000000E+00 2138 0 0.1920657E+00 0.1006844E+01 0.0000000E+00 2139 0 0.2351545E+00 0.1048422E+01 0.0000000E+00 2140 0 0.2398390E+00 0.1072979E+01 0.0000000E+00 2141 0 0.2014348E+00 0.1055959E+01 0.0000000E+00 2142 0 0.2460563E+00 0.1097193E+01 0.0000000E+00 2143 0 0.2507408E+00 0.1121750E+01 0.0000000E+00 2144 0 0.2108038E+00 0.1105073E+01 0.0000000E+00 2145 0 0.2569580E+00 0.1145965E+01 0.0000000E+00 2146 0 0.2616426E+00 0.1170522E+01 0.0000000E+00 2147 0 0.2201729E+00 0.1154187E+01 0.0000000E+00 2148 0 0.2678599E+00 0.1194737E+01 0.0000000E+00 2149 0 0.2725444E+00 0.1219294E+01 0.0000000E+00 2150 0 0.2295420E+00 0.1203302E+01 0.0000000E+00 2151 0 0.2787617E+00 0.1243509E+01 0.0000000E+00 2152 4 0.2834462E+00 0.1268066E+01 0.0000000E+00 2153 0 0.2389111E+00 0.1252416E+01 0.0000000E+00 2154 0 0.1610417E+00 0.1011758E+01 0.0000000E+00 2155 3 0.1563572E+00 0.9872010E+00 0.0000000E+00 2156 0 0.1641751E+00 0.1036561E+01 0.0000000E+00 2157 0 0.1284666E+00 0.1016918E+01 0.0000000E+00 2158 0 0.1688596E+00 0.1061118E+01 0.0000000E+00 2159 0 0.1719929E+00 0.1085921E+01 0.0000000E+00 2160 0 0.1347332E+00 0.1066523E+01 0.0000000E+00 2161 0 0.1766774E+00 0.1110478E+01 0.0000000E+00 2162 0 0.1798107E+00 0.1135281E+01 0.0000000E+00 2163 0 0.1409999E+00 0.1116129E+01 0.0000000E+00 2164 0 0.1844954E+00 0.1159838E+01 0.0000000E+00 2165 0 0.1876287E+00 0.1184641E+01 0.0000000E+00 2166 0 0.1472665E+00 0.1165735E+01 0.0000000E+00 2167 0 0.1923132E+00 0.1209198E+01 0.0000000E+00 2168 0 0.1954466E+00 0.1234001E+01 0.0000000E+00 2169 0 0.1535332E+00 0.1215340E+01 0.0000000E+00 2170 0 0.2001311E+00 0.1258558E+01 0.0000000E+00 2171 4 0.2032644E+00 0.1283361E+01 0.0000000E+00 2172 0 0.1597999E+00 0.1264946E+01 0.0000000E+00 2173 0 0.9719519E-01 0.1019874E+01 0.0000000E+00 2174 3 0.9406187E-01 0.9950707E+00 0.0000000E+00 2175 0 0.9876496E-01 0.1044824E+01 0.0000000E+00 2176 0 0.6436026E-01 0.1022977E+01 0.0000000E+00 2177 0 0.1018983E+00 0.1069627E+01 0.0000000E+00 2178 0 0.1034681E+00 0.1094578E+01 0.0000000E+00 2179 0 0.6749979E-01 0.1072879E+01 0.0000000E+00 2180 0 0.1066014E+00 0.1119381E+01 0.0000000E+00 2181 0 0.1081711E+00 0.1144331E+01 0.0000000E+00 2182 0 0.7063931E-01 0.1122780E+01 0.0000000E+00 2183 0 0.1113045E+00 0.1169134E+01 0.0000000E+00 2184 0 0.1128742E+00 0.1194085E+01 0.0000000E+00 2185 0 0.7377884E-01 0.1172681E+01 0.0000000E+00 2186 0 0.1160076E+00 0.1218888E+01 0.0000000E+00 2187 0 0.1175773E+00 0.1243838E+01 0.0000000E+00 2188 0 0.7691836E-01 0.1222583E+01 0.0000000E+00 2189 0 0.1207107E+00 0.1268641E+01 0.0000000E+00 2190 4 0.1222804E+00 0.1293592E+01 0.0000000E+00 2191 0 0.8005789E-01 0.1272484E+01 0.0000000E+00 2192 0 0.3296501E-01 0.1023964E+01 0.0000000E+00 2193 3 0.3139525E-01 0.9990134E+00 0.0000000E+00 2194 0 0.3296501E-01 0.1048964E+01 0.0000000E+00 2195 0 0.0000000E+00 0.1025000E+01 0.0000000E+00 2196 0 0.3453477E-01 0.1073915E+01 0.0000000E+00 2197 0 0.3453477E-01 0.1098915E+01 0.0000000E+00 2198 0 0.0000000E+00 0.1075000E+01 0.0000000E+00 2199 0 0.3610454E-01 0.1123865E+01 0.0000000E+00 2200 0 0.3610454E-01 0.1148865E+01 0.0000000E+00 2201 0 0.0000000E+00 0.1125000E+01 0.0000000E+00 2202 0 0.3767430E-01 0.1173816E+01 0.0000000E+00 2203 0 0.3767430E-01 0.1198816E+01 0.0000000E+00 2204 0 0.0000000E+00 0.1175000E+01 0.0000000E+00 2205 0 0.3924406E-01 0.1223767E+01 0.0000000E+00 2206 0 0.3924406E-01 0.1248767E+01 0.0000000E+00 2207 0 0.0000000E+00 0.1225000E+01 0.0000000E+00 2208 0 0.3924406E-01 0.1273767E+01 0.0000000E+00 2209 0 0.0000000E+00 0.1275000E+01 0.0000000E+00 2210 4 0.4081383E-01 0.1298717E+01 0.0000000E+00 C C$ RUBRIQUE = ELEMENTS C 1 1 1 9 8 603 604 605 2 1 1 2 9 606 607 603 3 1 2 3 9 608 609 607 4 1 9 3 10 609 610 611 5 1 3 4 10 612 613 610 6 1 10 4 11 613 614 615 7 1 4 5 11 616 617 614 8 1 11 5 12 617 618 619 9 1 5 6 12 620 621 618 10 1 12 6 13 621 622 623 11 1 6 7 13 624 625 622 12 1 13 7 14 625 626 627 13 1 8 9 15 604 628 629 14 1 15 9 16 628 630 631 15 1 9 10 16 611 632 630 16 1 16 10 17 632 633 634 17 1 10 11 17 615 635 633 18 1 17 11 18 635 636 637 19 1 11 12 18 619 638 636 20 1 18 12 19 638 639 640 21 1 12 13 19 623 641 639 22 1 19 13 20 641 642 643 23 1 13 14 20 627 644 642 24 1 20 14 21 644 645 646 25 1 15 16 22 631 647 648 26 1 22 16 23 647 649 650 27 1 16 17 23 634 651 649 28 1 23 17 24 651 652 653 29 1 17 18 24 637 654 652 30 1 24 18 25 654 655 656 31 1 18 19 25 640 657 655 32 1 25 19 26 657 658 659 33 1 19 20 26 643 660 658 34 1 26 20 27 660 661 662 35 1 20 21 27 646 663 661 36 1 27 21 28 663 664 665 37 1 22 23 29 650 666 667 38 1 29 23 30 666 668 669 39 1 23 24 30 653 670 668 40 1 30 24 31 670 671 672 41 1 24 25 31 656 673 671 42 1 31 25 32 673 674 675 43 1 25 26 32 659 676 674 44 1 32 26 33 676 677 678 45 1 26 27 33 662 679 677 46 1 33 27 34 679 680 681 47 1 27 28 34 665 682 680 48 1 34 28 35 682 683 684 49 1 29 30 36 669 685 686 50 1 36 30 37 685 687 688 51 1 30 31 37 672 689 687 52 1 37 31 38 689 690 691 53 1 31 32 38 675 692 690 54 1 38 32 39 692 693 694 55 1 32 33 39 678 695 693 56 1 39 33 40 695 696 697 57 1 33 34 40 681 698 696 58 1 40 34 41 698 699 700 59 1 34 35 41 684 701 699 60 1 41 35 42 701 702 703 61 1 36 37 43 688 704 705 62 1 43 37 44 704 706 707 63 1 37 38 44 691 708 706 64 1 44 38 45 708 709 710 65 1 38 39 45 694 711 709 66 1 45 39 46 711 712 713 67 1 39 40 46 697 714 712 68 1 46 40 47 714 715 716 69 1 40 41 47 700 717 715 70 1 47 41 48 717 718 719 71 1 41 42 48 703 720 718 72 1 48 42 49 720 721 722 73 1 43 44 50 707 723 724 74 1 50 44 51 723 725 726 75 1 44 45 51 710 727 725 76 1 51 45 52 727 728 729 77 1 45 46 52 713 730 728 78 1 52 46 53 730 731 732 79 1 46 47 53 716 733 731 80 1 53 47 54 733 734 735 81 1 47 48 54 719 736 734 82 1 54 48 55 736 737 738 83 1 48 49 55 722 739 737 84 1 55 49 56 739 740 741 85 1 50 51 57 726 742 743 86 1 57 51 58 742 744 745 87 1 51 52 58 729 746 744 88 1 58 52 59 746 747 748 89 1 52 53 59 732 749 747 90 1 59 53 60 749 750 751 91 1 53 54 60 735 752 750 92 1 60 54 61 752 753 754 93 1 54 55 61 738 755 753 94 1 61 55 62 755 756 757 95 1 55 56 62 741 758 756 96 1 62 56 63 758 759 760 97 1 57 58 64 745 761 762 98 1 64 58 65 761 763 764 99 1 58 59 65 748 765 763 100 1 65 59 66 765 766 767 101 1 59 60 66 751 768 766 102 1 66 60 67 768 769 770 103 1 60 61 67 754 771 769 104 1 67 61 68 771 772 773 105 1 61 62 68 757 774 772 106 1 68 62 69 774 775 776 107 1 62 63 69 760 777 775 108 1 69 63 70 777 778 779 109 1 64 65 71 764 780 781 110 1 71 65 72 780 782 783 111 1 65 66 72 767 784 782 112 1 72 66 73 784 785 786 113 1 66 67 73 770 787 785 114 1 73 67 74 787 788 789 115 1 67 68 74 773 790 788 116 1 74 68 75 790 791 792 117 1 68 69 75 776 793 791 118 1 75 69 76 793 794 795 119 1 69 70 76 779 796 794 120 1 76 70 77 796 797 798 121 1 71 72 78 783 799 800 122 1 78 72 79 799 801 802 123 1 72 73 79 786 803 801 124 1 79 73 80 803 804 805 125 1 73 74 80 789 806 804 126 1 80 74 81 806 807 808 127 1 74 75 81 792 809 807 128 1 81 75 82 809 810 811 129 1 75 76 82 795 812 810 130 1 82 76 83 812 813 814 131 1 76 77 83 798 815 813 132 1 83 77 84 815 816 817 133 1 78 79 85 802 818 819 134 1 85 79 86 818 820 821 135 1 79 80 86 805 822 820 136 1 86 80 87 822 823 824 137 1 80 81 87 808 825 823 138 1 87 81 88 825 826 827 139 1 81 82 88 811 828 826 140 1 88 82 89 828 829 830 141 1 82 83 89 814 831 829 142 1 89 83 90 831 832 833 143 1 83 84 90 817 834 832 144 1 90 84 91 834 835 836 145 1 85 86 92 821 837 838 146 1 92 86 93 837 839 840 147 1 86 87 93 824 841 839 148 1 93 87 94 841 842 843 149 1 87 88 94 827 844 842 150 1 94 88 95 844 845 846 151 1 88 89 95 830 847 845 152 1 95 89 96 847 848 849 153 1 89 90 96 833 850 848 154 1 96 90 97 850 851 852 155 1 90 91 97 836 853 851 156 1 97 91 98 853 854 855 157 1 92 93 99 840 856 857 158 1 99 93 100 856 858 859 159 1 93 94 100 843 860 858 160 1 100 94 101 860 861 862 161 1 94 95 101 846 863 861 162 1 101 95 102 863 864 865 163 1 95 96 102 849 866 864 164 1 102 96 103 866 867 868 165 1 96 97 103 852 869 867 166 1 103 97 104 869 870 871 167 1 97 98 104 855 872 870 168 1 104 98 105 872 873 874 169 1 99 100 106 859 875 876 170 1 106 100 107 875 877 878 171 1 100 101 107 862 879 877 172 1 107 101 108 879 880 881 173 1 101 102 108 865 882 880 174 1 108 102 109 882 883 884 175 1 102 103 109 868 885 883 176 1 109 103 110 885 886 887 177 1 103 104 110 871 888 886 178 1 110 104 111 888 889 890 179 1 104 105 111 874 891 889 180 1 111 105 112 891 892 893 181 1 106 107 113 878 894 895 182 1 113 107 114 894 896 897 183 1 107 108 114 881 898 896 184 1 114 108 115 898 899 900 185 1 108 109 115 884 901 899 186 1 115 109 116 901 902 903 187 1 109 110 116 887 904 902 188 1 116 110 117 904 905 906 189 1 110 111 117 890 907 905 190 1 117 111 118 907 908 909 191 1 111 112 118 893 910 908 192 1 118 112 119 910 911 912 193 1 113 114 120 897 913 914 194 1 120 114 121 913 915 916 195 1 114 115 121 900 917 915 196 1 121 115 122 917 918 919 197 1 115 116 122 903 920 918 198 1 122 116 123 920 921 922 199 1 116 117 123 906 923 921 200 1 123 117 124 923 924 925 201 1 117 118 124 909 926 924 202 1 124 118 125 926 927 928 203 1 118 119 125 912 929 927 204 1 125 119 126 929 930 931 205 1 120 121 127 916 932 933 206 1 127 121 128 932 934 935 207 1 121 122 128 919 936 934 208 1 128 122 129 936 937 938 209 1 122 123 129 922 939 937 210 1 129 123 130 939 940 941 211 1 123 124 130 925 942 940 212 1 130 124 131 942 943 944 213 1 124 125 131 928 945 943 214 1 131 125 132 945 946 947 215 1 125 126 132 931 948 946 216 1 132 126 133 948 949 950 217 1 127 128 134 935 951 952 218 1 134 128 135 951 953 954 219 1 128 129 135 938 955 953 220 1 135 129 136 955 956 957 221 1 129 130 136 941 958 956 222 1 136 130 137 958 959 960 223 1 130 131 137 944 961 959 224 1 137 131 138 961 962 963 225 1 131 132 138 947 964 962 226 1 138 132 139 964 965 966 227 1 132 133 139 950 967 965 228 1 139 133 140 967 968 969 229 1 134 135 141 954 970 971 230 1 141 135 142 970 972 973 231 1 135 136 142 957 974 972 232 1 142 136 143 974 975 976 233 1 136 137 143 960 977 975 234 1 143 137 144 977 978 979 235 1 137 138 144 963 980 978 236 1 144 138 145 980 981 982 237 1 138 139 145 966 983 981 238 1 145 139 146 983 984 985 239 1 139 140 146 969 986 984 240 1 146 140 147 986 987 988 241 1 141 142 148 973 989 990 242 1 148 142 149 989 991 992 243 1 142 143 149 976 993 991 244 1 149 143 150 993 994 995 245 1 143 144 150 979 996 994 246 1 150 144 151 996 997 998 247 1 144 145 151 982 999 997 248 1 151 145 152 999 1000 1001 249 1 145 146 152 985 1002 1000 250 1 152 146 153 1002 1003 1004 251 1 146 147 153 988 1005 1003 252 1 153 147 154 1005 1006 1007 253 1 148 149 155 992 1008 1009 254 1 155 149 156 1008 1010 1011 255 1 149 150 156 995 1012 1010 256 1 156 150 157 1012 1013 1014 257 1 150 151 157 998 1015 1013 258 1 157 151 158 1015 1016 1017 259 1 151 152 158 1001 1018 1016 260 1 158 152 159 1018 1019 1020 261 1 152 153 159 1004 1021 1019 262 1 159 153 160 1021 1022 1023 263 1 153 154 160 1007 1024 1022 264 1 160 154 161 1024 1025 1026 265 1 155 156 162 1011 1027 1028 266 1 162 156 163 1027 1029 1030 267 1 156 157 163 1014 1031 1029 268 1 163 157 164 1031 1032 1033 269 1 157 158 164 1017 1034 1032 270 1 164 158 165 1034 1035 1036 271 1 158 159 165 1020 1037 1035 272 1 165 159 166 1037 1038 1039 273 1 159 160 166 1023 1040 1038 274 1 166 160 167 1040 1041 1042 275 1 160 161 167 1026 1043 1041 276 1 167 161 168 1043 1044 1045 277 1 162 163 169 1030 1046 1047 278 1 169 163 170 1046 1048 1049 279 1 163 164 170 1033 1050 1048 280 1 170 164 171 1050 1051 1052 281 1 164 165 171 1036 1053 1051 282 1 171 165 172 1053 1054 1055 283 1 165 166 172 1039 1056 1054 284 1 172 166 173 1056 1057 1058 285 1 166 167 173 1042 1059 1057 286 1 173 167 174 1059 1060 1061 287 1 167 168 174 1045 1062 1060 288 1 174 168 175 1062 1063 1064 289 1 169 170 176 1049 1065 1066 290 1 176 170 177 1065 1067 1068 291 1 170 171 177 1052 1069 1067 292 1 177 171 178 1069 1070 1071 293 1 171 172 178 1055 1072 1070 294 1 178 172 179 1072 1073 1074 295 1 172 173 179 1058 1075 1073 296 1 179 173 180 1075 1076 1077 297 1 173 174 180 1061 1078 1076 298 1 180 174 181 1078 1079 1080 299 1 174 175 181 1064 1081 1079 300 1 181 175 182 1081 1082 1083 301 1 176 177 183 1068 1084 1085 302 1 183 177 184 1084 1086 1087 303 1 177 178 184 1071 1088 1086 304 1 184 178 185 1088 1089 1090 305 1 178 179 185 1074 1091 1089 306 1 185 179 186 1091 1092 1093 307 1 179 180 186 1077 1094 1092 308 1 186 180 187 1094 1095 1096 309 1 180 181 187 1080 1097 1095 310 1 187 181 188 1097 1098 1099 311 1 181 182 188 1083 1100 1098 312 1 188 182 189 1100 1101 1102 313 1 183 184 190 1087 1103 1104 314 1 190 184 191 1103 1105 1106 315 1 184 185 191 1090 1107 1105 316 1 191 185 192 1107 1108 1109 317 1 185 186 192 1093 1110 1108 318 1 192 186 193 1110 1111 1112 319 1 186 187 193 1096 1113 1111 320 1 193 187 194 1113 1114 1115 321 1 187 188 194 1099 1116 1114 322 1 194 188 195 1116 1117 1118 323 1 188 189 195 1102 1119 1117 324 1 195 189 196 1119 1120 1121 325 1 190 191 197 1106 1122 1123 326 1 197 191 198 1122 1124 1125 327 1 191 192 198 1109 1126 1124 328 1 198 192 199 1126 1127 1128 329 1 192 193 199 1112 1129 1127 330 1 199 193 200 1129 1130 1131 331 1 193 194 200 1115 1132 1130 332 1 200 194 201 1132 1133 1134 333 1 194 195 201 1118 1135 1133 334 1 201 195 202 1135 1136 1137 335 1 195 196 202 1121 1138 1136 336 1 202 196 203 1138 1139 1140 337 1 197 198 204 1125 1141 1142 338 1 204 198 205 1141 1143 1144 339 1 198 199 205 1128 1145 1143 340 1 205 199 206 1145 1146 1147 341 1 199 200 206 1131 1148 1146 342 1 206 200 207 1148 1149 1150 343 1 200 201 207 1134 1151 1149 344 1 207 201 208 1151 1152 1153 345 1 201 202 208 1137 1154 1152 346 1 208 202 209 1154 1155 1156 347 1 202 203 209 1140 1157 1155 348 1 209 203 210 1157 1158 1159 349 1 204 205 211 1144 1160 1161 350 1 211 205 212 1160 1162 1163 351 1 205 206 212 1147 1164 1162 352 1 212 206 213 1164 1165 1166 353 1 206 207 213 1150 1167 1165 354 1 213 207 214 1167 1168 1169 355 1 207 208 214 1153 1170 1168 356 1 214 208 215 1170 1171 1172 357 1 208 209 215 1156 1173 1171 358 1 215 209 216 1173 1174 1175 359 1 209 210 216 1159 1176 1174 360 1 216 210 217 1176 1177 1178 361 1 211 212 218 1163 1179 1180 362 1 218 212 219 1179 1181 1182 363 1 212 213 219 1166 1183 1181 364 1 219 213 220 1183 1184 1185 365 1 213 214 220 1169 1186 1184 366 1 220 214 221 1186 1187 1188 367 1 214 215 221 1172 1189 1187 368 1 221 215 222 1189 1190 1191 369 1 215 216 222 1175 1192 1190 370 1 222 216 223 1192 1193 1194 371 1 216 217 223 1178 1195 1193 372 1 223 217 224 1195 1196 1197 373 1 218 219 225 1182 1198 1199 374 1 225 219 226 1198 1200 1201 375 1 219 220 226 1185 1202 1200 376 1 226 220 227 1202 1203 1204 377 1 220 221 227 1188 1205 1203 378 1 227 221 228 1205 1206 1207 379 1 221 222 228 1191 1208 1206 380 1 228 222 229 1208 1209 1210 381 1 222 223 229 1194 1211 1209 382 1 229 223 230 1211 1212 1213 383 1 223 224 230 1197 1214 1212 384 1 230 224 231 1214 1215 1216 385 1 225 226 232 1201 1217 1218 386 1 232 226 233 1217 1219 1220 387 1 226 227 233 1204 1221 1219 388 1 233 227 234 1221 1222 1223 389 1 227 228 234 1207 1224 1222 390 1 234 228 235 1224 1225 1226 391 1 228 229 235 1210 1227 1225 392 1 235 229 236 1227 1228 1229 393 1 229 230 236 1213 1230 1228 394 1 236 230 237 1230 1231 1232 395 1 230 231 237 1216 1233 1231 396 1 237 231 238 1233 1234 1235 397 1 232 233 239 1220 1236 1237 398 1 239 233 240 1236 1238 1239 399 1 233 234 240 1223 1240 1238 400 1 240 234 241 1240 1241 1242 401 1 234 235 241 1226 1243 1241 402 1 241 235 242 1243 1244 1245 403 1 235 236 242 1229 1246 1244 404 1 242 236 243 1246 1247 1248 405 1 236 237 243 1232 1249 1247 406 1 243 237 244 1249 1250 1251 407 1 237 245 244 1252 1253 1250 408 1 237 238 245 1235 1254 1252 409 2 246 254 253 1255 1256 1257 410 2 246 247 254 1258 1259 1255 411 2 247 248 254 1260 1261 1259 412 2 254 248 255 1261 1262 1263 413 2 248 249 255 1264 1265 1262 414 2 255 249 256 1265 1266 1267 415 2 249 250 256 1268 1269 1266 416 2 256 250 257 1269 1270 1271 417 2 250 251 257 1272 1273 1270 418 2 257 251 258 1273 1274 1275 419 2 251 252 258 1276 1277 1274 420 2 258 252 259 1277 1278 1279 421 2 253 254 260 1256 1280 1281 422 2 260 254 261 1280 1282 1283 423 2 254 255 261 1263 1284 1282 424 2 261 255 262 1284 1285 1286 425 2 255 256 262 1267 1287 1285 426 2 262 256 263 1287 1288 1289 427 2 256 257 263 1271 1290 1288 428 2 263 257 264 1290 1291 1292 429 2 257 258 264 1275 1293 1291 430 2 264 258 265 1293 1294 1295 431 2 258 259 265 1279 1296 1294 432 2 265 259 266 1296 1297 1298 433 2 260 261 267 1283 1299 1300 434 2 267 261 268 1299 1301 1302 435 2 261 262 268 1286 1303 1301 436 2 268 262 269 1303 1304 1305 437 2 262 263 269 1289 1306 1304 438 2 269 263 270 1306 1307 1308 439 2 263 264 270 1292 1309 1307 440 2 270 264 271 1309 1310 1311 441 2 264 265 271 1295 1312 1310 442 2 271 265 272 1312 1313 1314 443 2 265 266 272 1298 1315 1313 444 2 272 266 273 1315 1316 1317 445 2 267 268 274 1302 1318 1319 446 2 274 268 275 1318 1320 1321 447 2 268 269 275 1305 1322 1320 448 2 275 269 276 1322 1323 1324 449 2 269 270 276 1308 1325 1323 450 2 276 270 277 1325 1326 1327 451 2 270 271 277 1311 1328 1326 452 2 277 271 278 1328 1329 1330 453 2 271 272 278 1314 1331 1329 454 2 278 272 279 1331 1332 1333 455 2 272 273 279 1317 1334 1332 456 2 279 273 280 1334 1335 1336 457 2 274 275 281 1321 1337 1338 458 2 281 275 282 1337 1339 1340 459 2 275 276 282 1324 1341 1339 460 2 282 276 283 1341 1342 1343 461 2 276 277 283 1327 1344 1342 462 2 283 277 284 1344 1345 1346 463 2 277 278 284 1330 1347 1345 464 2 284 278 285 1347 1348 1349 465 2 278 279 285 1333 1350 1348 466 2 285 279 286 1350 1351 1352 467 2 279 280 286 1336 1353 1351 468 2 286 280 287 1353 1354 1355 469 2 281 282 288 1340 1356 1357 470 2 288 282 289 1356 1358 1359 471 2 282 283 289 1343 1360 1358 472 2 289 283 290 1360 1361 1362 473 2 283 284 290 1346 1363 1361 474 2 290 284 291 1363 1364 1365 475 2 284 285 291 1349 1366 1364 476 2 291 285 292 1366 1367 1368 477 2 285 286 292 1352 1369 1367 478 2 292 286 293 1369 1370 1371 479 2 286 287 293 1355 1372 1370 480 2 293 287 294 1372 1373 1374 481 2 288 289 295 1359 1375 1376 482 2 295 289 296 1375 1377 1378 483 2 289 290 296 1362 1379 1377 484 2 296 290 297 1379 1380 1381 485 2 290 291 297 1365 1382 1380 486 2 297 291 298 1382 1383 1384 487 2 291 292 298 1368 1385 1383 488 2 298 292 299 1385 1386 1387 489 2 292 293 299 1371 1388 1386 490 2 299 293 300 1388 1389 1390 491 2 293 294 300 1374 1391 1389 492 2 300 294 301 1391 1392 1393 493 2 295 296 302 1378 1394 1395 494 2 302 296 303 1394 1396 1397 495 2 296 297 303 1381 1398 1396 496 2 303 297 304 1398 1399 1400 497 2 297 298 304 1384 1401 1399 498 2 304 298 305 1401 1402 1403 499 2 298 299 305 1387 1404 1402 500 2 305 299 306 1404 1405 1406 501 2 299 300 306 1390 1407 1405 502 2 306 300 307 1407 1408 1409 503 2 300 301 307 1393 1410 1408 504 2 307 301 308 1410 1411 1412 505 2 302 303 309 1397 1413 1414 506 2 309 303 310 1413 1415 1416 507 2 303 304 310 1400 1417 1415 508 2 310 304 311 1417 1418 1419 509 2 304 305 311 1403 1420 1418 510 2 311 305 312 1420 1421 1422 511 2 305 306 312 1406 1423 1421 512 2 312 306 313 1423 1424 1425 513 2 306 307 313 1409 1426 1424 514 2 313 307 314 1426 1427 1428 515 2 307 308 314 1412 1429 1427 516 2 314 308 315 1429 1430 1431 517 2 309 310 316 1416 1432 1433 518 2 316 310 317 1432 1434 1435 519 2 310 311 317 1419 1436 1434 520 2 317 311 318 1436 1437 1438 521 2 311 312 318 1422 1439 1437 522 2 318 312 319 1439 1440 1441 523 2 312 313 319 1425 1442 1440 524 2 319 313 320 1442 1443 1444 525 2 313 314 320 1428 1445 1443 526 2 320 314 321 1445 1446 1447 527 2 314 315 321 1431 1448 1446 528 2 321 315 322 1448 1449 1450 529 2 316 317 323 1435 1451 1452 530 2 323 317 324 1451 1453 1454 531 2 317 318 324 1438 1455 1453 532 2 324 318 325 1455 1456 1457 533 2 318 319 325 1441 1458 1456 534 2 325 319 326 1458 1459 1460 535 2 319 320 326 1444 1461 1459 536 2 326 320 327 1461 1462 1463 537 2 320 321 327 1447 1464 1462 538 2 327 321 328 1464 1465 1466 539 2 321 322 328 1450 1467 1465 540 2 328 322 329 1467 1468 1469 541 2 323 324 330 1454 1470 1471 542 2 330 324 331 1470 1472 1473 543 2 324 325 331 1457 1474 1472 544 2 331 325 332 1474 1475 1476 545 2 325 326 332 1460 1477 1475 546 2 332 326 333 1477 1478 1479 547 2 326 327 333 1463 1480 1478 548 2 333 327 334 1480 1481 1482 549 2 327 328 334 1466 1483 1481 550 2 334 328 335 1483 1484 1485 551 2 328 329 335 1469 1486 1484 552 2 335 329 336 1486 1487 1488 553 2 330 331 337 1473 1489 1490 554 2 337 331 338 1489 1491 1492 555 2 331 332 338 1476 1493 1491 556 2 338 332 339 1493 1494 1495 557 2 332 333 339 1479 1496 1494 558 2 339 333 340 1496 1497 1498 559 2 333 334 340 1482 1499 1497 560 2 340 334 341 1499 1500 1501 561 2 334 335 341 1485 1502 1500 562 2 341 335 342 1502 1503 1504 563 2 335 336 342 1488 1505 1503 564 2 342 336 343 1505 1506 1507 565 2 337 338 344 1492 1508 1509 566 2 344 338 345 1508 1510 1511 567 2 338 339 345 1495 1512 1510 568 2 345 339 346 1512 1513 1514 569 2 339 340 346 1498 1515 1513 570 2 346 340 347 1515 1516 1517 571 2 340 341 347 1501 1518 1516 572 2 347 341 348 1518 1519 1520 573 2 341 342 348 1504 1521 1519 574 2 348 342 349 1521 1522 1523 575 2 342 343 349 1507 1524 1522 576 2 349 343 350 1524 1525 1526 577 2 344 345 351 1511 1527 1528 578 2 351 345 352 1527 1529 1530 579 2 345 346 352 1514 1531 1529 580 2 352 346 353 1531 1532 1533 581 2 346 347 353 1517 1534 1532 582 2 353 347 354 1534 1535 1536 583 2 347 348 354 1520 1537 1535 584 2 354 348 355 1537 1538 1539 585 2 348 349 355 1523 1540 1538 586 2 355 349 356 1540 1541 1542 587 2 349 350 356 1526 1543 1541 588 2 356 350 357 1543 1544 1545 589 2 351 352 358 1530 1546 1547 590 2 358 352 359 1546 1548 1549 591 2 352 353 359 1533 1550 1548 592 2 359 353 360 1550 1551 1552 593 2 353 354 360 1536 1553 1551 594 2 360 354 361 1553 1554 1555 595 2 354 355 361 1539 1556 1554 596 2 361 355 362 1556 1557 1558 597 2 355 356 362 1542 1559 1557 598 2 362 356 363 1559 1560 1561 599 2 356 357 363 1545 1562 1560 600 2 363 357 364 1562 1563 1564 601 2 358 359 365 1549 1565 1566 602 2 365 359 366 1565 1567 1568 603 2 359 360 366 1552 1569 1567 604 2 366 360 367 1569 1570 1571 605 2 360 361 367 1555 1572 1570 606 2 367 361 368 1572 1573 1574 607 2 361 362 368 1558 1575 1573 608 2 368 362 369 1575 1576 1577 609 2 362 363 369 1561 1578 1576 610 2 369 363 370 1578 1579 1580 611 2 363 364 370 1564 1581 1579 612 2 370 364 371 1581 1582 1583 613 2 365 366 372 1568 1584 1585 614 2 372 366 373 1584 1586 1587 615 2 366 367 373 1571 1588 1586 616 2 373 367 374 1588 1589 1590 617 2 367 368 374 1574 1591 1589 618 2 374 368 375 1591 1592 1593 619 2 368 369 375 1577 1594 1592 620 2 375 369 376 1594 1595 1596 621 2 369 370 376 1580 1597 1595 622 2 376 370 377 1597 1598 1599 623 2 370 371 377 1583 1600 1598 624 2 377 371 378 1600 1601 1602 625 2 372 373 379 1587 1603 1604 626 2 379 373 380 1603 1605 1606 627 2 373 374 380 1590 1607 1605 628 2 380 374 381 1607 1608 1609 629 2 374 375 381 1593 1610 1608 630 2 381 375 382 1610 1611 1612 631 2 375 376 382 1596 1613 1611 632 2 382 376 383 1613 1614 1615 633 2 376 377 383 1599 1616 1614 634 2 383 377 384 1616 1617 1618 635 2 377 378 384 1602 1619 1617 636 2 384 378 385 1619 1620 1621 637 2 379 380 386 1606 1622 1623 638 2 386 380 387 1622 1624 1625 639 2 380 381 387 1609 1626 1624 640 2 387 381 388 1626 1627 1628 641 2 381 382 388 1612 1629 1627 642 2 388 382 389 1629 1630 1631 643 2 382 383 389 1615 1632 1630 644 2 389 383 390 1632 1633 1634 645 2 383 384 390 1618 1635 1633 646 2 390 384 391 1635 1636 1637 647 2 384 385 391 1621 1638 1636 648 2 391 385 392 1638 1639 1640 649 2 386 387 393 1625 1641 1642 650 2 393 387 394 1641 1643 1644 651 2 387 388 394 1628 1645 1643 652 2 394 388 395 1645 1646 1647 653 2 388 389 395 1631 1648 1646 654 2 395 389 396 1648 1649 1650 655 2 389 390 396 1634 1651 1649 656 2 396 390 397 1651 1652 1653 657 2 390 391 397 1637 1654 1652 658 2 397 391 398 1654 1655 1656 659 2 391 392 398 1640 1657 1655 660 2 398 392 399 1657 1658 1659 661 2 393 394 400 1644 1660 1661 662 2 400 394 401 1660 1662 1663 663 2 394 395 401 1647 1664 1662 664 2 401 395 402 1664 1665 1666 665 2 395 396 402 1650 1667 1665 666 2 402 396 403 1667 1668 1669 667 2 396 397 403 1653 1670 1668 668 2 403 397 404 1670 1671 1672 669 2 397 398 404 1656 1673 1671 670 2 404 398 405 1673 1674 1675 671 2 398 399 405 1659 1676 1674 672 2 405 399 406 1676 1677 1678 673 2 400 401 407 1663 1679 1680 674 2 407 401 408 1679 1681 1682 675 2 401 402 408 1666 1683 1681 676 2 408 402 409 1683 1684 1685 677 2 402 403 409 1669 1686 1684 678 2 409 403 410 1686 1687 1688 679 2 403 404 410 1672 1689 1687 680 2 410 404 411 1689 1690 1691 681 2 404 405 411 1675 1692 1690 682 2 411 405 412 1692 1693 1694 683 2 405 406 412 1678 1695 1693 684 2 412 406 413 1695 1696 1697 685 2 407 408 414 1682 1698 1699 686 2 414 408 415 1698 1700 1701 687 2 408 409 415 1685 1702 1700 688 2 415 409 416 1702 1703 1704 689 2 409 410 416 1688 1705 1703 690 2 416 410 417 1705 1706 1707 691 2 410 411 417 1691 1708 1706 692 2 417 411 418 1708 1709 1710 693 2 411 412 418 1694 1711 1709 694 2 418 412 419 1711 1712 1713 695 2 412 413 419 1697 1714 1712 696 2 419 413 420 1714 1715 1716 697 2 414 415 421 1701 1717 1718 698 2 421 415 422 1717 1719 1720 699 2 415 416 422 1704 1721 1719 700 2 422 416 423 1721 1722 1723 701 2 416 417 423 1707 1724 1722 702 2 423 417 424 1724 1725 1726 703 2 417 418 424 1710 1727 1725 704 2 424 418 425 1727 1728 1729 705 2 418 419 425 1713 1730 1728 706 2 425 419 426 1730 1731 1732 707 2 419 420 426 1716 1733 1731 708 2 426 420 427 1733 1734 1735 709 2 421 422 428 1720 1736 1737 710 2 428 422 429 1736 1738 1739 711 2 422 423 429 1723 1740 1738 712 2 429 423 430 1740 1741 1742 713 2 423 424 430 1726 1743 1741 714 2 430 424 431 1743 1744 1745 715 2 424 425 431 1729 1746 1744 716 2 431 425 432 1746 1747 1748 717 2 425 426 432 1732 1749 1747 718 2 432 426 433 1749 1750 1751 719 2 426 427 433 1735 1752 1750 720 2 433 427 434 1752 1753 1754 721 2 428 429 435 1739 1755 1756 722 2 435 429 436 1755 1757 1758 723 2 429 430 436 1742 1759 1757 724 2 436 430 437 1759 1760 1761 725 2 430 431 437 1745 1762 1760 726 2 437 431 438 1762 1763 1764 727 2 431 432 438 1748 1765 1763 728 2 438 432 439 1765 1766 1767 729 2 432 433 439 1751 1768 1766 730 2 439 433 440 1768 1769 1770 731 2 433 434 440 1754 1771 1769 732 2 440 434 441 1771 1772 1773 733 2 435 436 442 1758 1774 1775 734 2 442 436 443 1774 1776 1777 735 2 436 437 443 1761 1778 1776 736 2 443 437 444 1778 1779 1780 737 2 437 438 444 1764 1781 1779 738 2 444 438 445 1781 1782 1783 739 2 438 439 445 1767 1784 1782 740 2 445 439 446 1784 1785 1786 741 2 439 440 446 1770 1787 1785 742 2 446 440 447 1787 1788 1789 743 2 440 441 447 1773 1790 1788 744 2 447 441 448 1790 1791 1792 745 2 442 443 449 1777 1793 1794 746 2 449 443 450 1793 1795 1796 747 2 443 444 450 1780 1797 1795 748 2 450 444 451 1797 1798 1799 749 2 444 445 451 1783 1800 1798 750 2 451 445 452 1800 1801 1802 751 2 445 446 452 1786 1803 1801 752 2 452 446 453 1803 1804 1805 753 2 446 447 453 1789 1806 1804 754 2 453 447 454 1806 1807 1808 755 2 447 448 454 1792 1809 1807 756 2 454 448 455 1809 1810 1811 757 2 449 450 456 1796 1812 1813 758 2 456 450 457 1812 1814 1815 759 2 450 451 457 1799 1816 1814 760 2 457 451 458 1816 1817 1818 761 2 451 452 458 1802 1819 1817 762 2 458 452 459 1819 1820 1821 763 2 452 453 459 1805 1822 1820 764 2 459 453 460 1822 1823 1824 765 2 453 454 460 1808 1825 1823 766 2 460 454 461 1825 1826 1827 767 2 454 455 461 1811 1828 1826 768 2 461 455 462 1828 1829 1830 769 2 456 457 463 1815 1831 1832 770 2 463 457 464 1831 1833 1834 771 2 457 458 464 1818 1835 1833 772 2 464 458 465 1835 1836 1837 773 2 458 459 465 1821 1838 1836 774 2 465 459 466 1838 1839 1840 775 2 459 460 466 1824 1841 1839 776 2 466 460 467 1841 1842 1843 777 2 460 461 467 1827 1844 1842 778 2 467 461 468 1844 1845 1846 779 2 461 462 468 1830 1847 1845 780 2 468 462 469 1847 1848 1849 781 2 463 464 470 1834 1850 1851 782 2 470 464 471 1850 1852 1853 783 2 464 465 471 1837 1854 1852 784 2 471 465 472 1854 1855 1856 785 2 465 466 472 1840 1857 1855 786 2 472 466 473 1857 1858 1859 787 2 466 467 473 1843 1860 1858 788 2 473 467 474 1860 1861 1862 789 2 467 468 474 1846 1863 1861 790 2 474 468 475 1863 1864 1865 791 2 468 469 475 1849 1866 1864 792 2 475 469 476 1866 1867 1868 793 2 470 471 477 1853 1869 1870 794 2 477 471 478 1869 1871 1872 795 2 471 472 478 1856 1873 1871 796 2 478 472 479 1873 1874 1875 797 2 472 473 479 1859 1876 1874 798 2 479 473 480 1876 1877 1878 799 2 473 474 480 1862 1879 1877 800 2 480 474 481 1879 1880 1881 801 2 474 475 481 1865 1882 1880 802 2 481 475 482 1882 1883 1884 803 2 475 476 482 1868 1885 1883 804 2 482 476 483 1885 1886 1887 805 2 477 478 484 1872 1888 1889 806 2 484 478 485 1888 1890 1891 807 2 478 479 485 1875 1892 1890 808 2 485 479 486 1892 1893 1894 809 2 479 480 486 1878 1895 1893 810 2 486 480 487 1895 1896 1897 811 2 480 481 487 1881 1898 1896 812 2 487 481 488 1898 1899 1900 813 2 481 482 488 1884 1901 1899 814 2 488 482 489 1901 1902 1903 815 2 482 483 489 1887 1904 1902 816 2 489 483 490 1904 1905 1906 817 2 484 485 491 1891 1907 1908 818 2 491 485 492 1907 1909 1910 819 2 485 486 492 1894 1911 1909 820 2 492 486 493 1911 1912 1913 821 2 486 487 493 1897 1914 1912 822 2 493 487 494 1914 1915 1916 823 2 487 488 494 1900 1917 1915 824 2 494 488 495 1917 1918 1919 825 2 488 489 495 1903 1920 1918 826 2 495 489 496 1920 1921 1922 827 2 489 490 496 1906 1923 1921 828 2 496 490 497 1923 1924 1925 829 2 491 492 498 1910 1926 1927 830 2 498 492 499 1926 1928 1929 831 2 492 493 499 1913 1930 1928 832 2 499 493 500 1930 1931 1932 833 2 493 494 500 1916 1933 1931 834 2 500 494 501 1933 1934 1935 835 2 494 495 501 1919 1936 1934 836 2 501 495 502 1936 1937 1938 837 2 495 496 502 1922 1939 1937 838 2 502 496 503 1939 1940 1941 839 2 496 497 503 1925 1942 1940 840 2 503 497 504 1942 1943 1944 841 2 498 499 505 1929 1945 1946 842 2 505 499 506 1945 1947 1948 843 2 499 500 506 1932 1949 1947 844 2 506 500 507 1949 1950 1951 845 2 500 501 507 1935 1952 1950 846 2 507 501 508 1952 1953 1954 847 2 501 502 508 1938 1955 1953 848 2 508 502 509 1955 1956 1957 849 2 502 503 509 1941 1958 1956 850 2 509 503 510 1958 1959 1960 851 2 503 504 510 1944 1961 1959 852 2 510 504 511 1961 1962 1963 853 2 505 506 512 1948 1964 1965 854 2 512 506 513 1964 1966 1967 855 2 506 507 513 1951 1968 1966 856 2 513 507 514 1968 1969 1970 857 2 507 508 514 1954 1971 1969 858 2 514 508 515 1971 1972 1973 859 2 508 509 515 1957 1974 1972 860 2 515 509 516 1974 1975 1976 861 2 509 510 516 1960 1977 1975 862 2 516 510 517 1977 1978 1979 863 2 510 511 517 1963 1980 1978 864 2 517 511 518 1980 1981 1982 865 2 512 513 519 1967 1983 1984 866 2 519 513 520 1983 1985 1986 867 2 513 514 520 1970 1987 1985 868 2 520 514 521 1987 1988 1989 869 2 514 515 521 1973 1990 1988 870 2 521 515 522 1990 1991 1992 871 2 515 516 522 1976 1993 1991 872 2 522 516 523 1993 1994 1995 873 2 516 517 523 1979 1996 1994 874 2 523 517 524 1996 1997 1998 875 2 517 518 524 1982 1999 1997 876 2 524 518 525 1999 2000 2001 877 2 519 520 526 1986 2002 2003 878 2 526 520 527 2002 2004 2005 879 2 520 521 527 1989 2006 2004 880 2 527 521 528 2006 2007 2008 881 2 521 522 528 1992 2009 2007 882 2 528 522 529 2009 2010 2011 883 2 522 523 529 1995 2012 2010 884 2 529 523 530 2012 2013 2014 885 2 523 524 530 1998 2015 2013 886 2 530 524 531 2015 2016 2017 887 2 524 525 531 2001 2018 2016 888 2 531 525 532 2018 2019 2020 889 2 526 527 533 2005 2021 2022 890 2 533 527 534 2021 2023 2024 891 2 527 528 534 2008 2025 2023 892 2 534 528 535 2025 2026 2027 893 2 528 529 535 2011 2028 2026 894 2 535 529 536 2028 2029 2030 895 2 529 530 536 2014 2031 2029 896 2 536 530 537 2031 2032 2033 897 2 530 531 537 2017 2034 2032 898 2 537 531 538 2034 2035 2036 899 2 531 532 538 2020 2037 2035 900 2 538 532 539 2037 2038 2039 901 2 533 534 540 2024 2040 2041 902 2 540 534 541 2040 2042 2043 903 2 534 535 541 2027 2044 2042 904 2 541 535 542 2044 2045 2046 905 2 535 536 542 2030 2047 2045 906 2 542 536 543 2047 2048 2049 907 2 536 537 543 2033 2050 2048 908 2 543 537 544 2050 2051 2052 909 2 537 538 544 2036 2053 2051 910 2 544 538 545 2053 2054 2055 911 2 538 539 545 2039 2056 2054 912 2 545 539 546 2056 2057 2058 913 2 540 541 547 2043 2059 2060 914 2 547 541 548 2059 2061 2062 915 2 541 542 548 2046 2063 2061 916 2 548 542 549 2063 2064 2065 917 2 542 543 549 2049 2066 2064 918 2 549 543 550 2066 2067 2068 919 2 543 544 550 2052 2069 2067 920 2 550 544 551 2069 2070 2071 921 2 544 545 551 2055 2072 2070 922 2 551 545 552 2072 2073 2074 923 2 545 546 552 2058 2075 2073 924 2 552 546 553 2075 2076 2077 925 2 547 548 554 2062 2078 2079 926 2 554 548 555 2078 2080 2081 927 2 548 549 555 2065 2082 2080 928 2 555 549 556 2082 2083 2084 929 2 549 550 556 2068 2085 2083 930 2 556 550 557 2085 2086 2087 931 2 550 551 557 2071 2088 2086 932 2 557 551 558 2088 2089 2090 933 2 551 552 558 2074 2091 2089 934 2 558 552 559 2091 2092 2093 935 2 552 553 559 2077 2094 2092 936 2 559 553 560 2094 2095 2096 937 2 554 555 561 2081 2097 2098 938 2 561 555 562 2097 2099 2100 939 2 555 556 562 2084 2101 2099 940 2 562 556 563 2101 2102 2103 941 2 556 557 563 2087 2104 2102 942 2 563 557 564 2104 2105 2106 943 2 557 558 564 2090 2107 2105 944 2 564 558 565 2107 2108 2109 945 2 558 559 565 2093 2110 2108 946 2 565 559 566 2110 2111 2112 947 2 559 560 566 2096 2113 2111 948 2 566 560 567 2113 2114 2115 949 2 561 562 568 2100 2116 2117 950 2 568 562 569 2116 2118 2119 951 2 562 563 569 2103 2120 2118 952 2 569 563 570 2120 2121 2122 953 2 563 564 570 2106 2123 2121 954 2 570 564 571 2123 2124 2125 955 2 564 565 571 2109 2126 2124 956 2 571 565 572 2126 2127 2128 957 2 565 566 572 2112 2129 2127 958 2 572 566 573 2129 2130 2131 959 2 566 567 573 2115 2132 2130 960 2 573 567 574 2132 2133 2134 961 2 568 569 575 2119 2135 2136 962 2 575 569 576 2135 2137 2138 963 2 569 570 576 2122 2139 2137 964 2 576 570 577 2139 2140 2141 965 2 570 571 577 2125 2142 2140 966 2 577 571 578 2142 2143 2144 967 2 571 572 578 2128 2145 2143 968 2 578 572 579 2145 2146 2147 969 2 572 573 579 2131 2148 2146 970 2 579 573 580 2148 2149 2150 971 2 573 574 580 2134 2151 2149 972 2 580 574 581 2151 2152 2153 973 2 575 576 582 2138 2154 2155 974 2 582 576 583 2154 2156 2157 975 2 576 577 583 2141 2158 2156 976 2 583 577 584 2158 2159 2160 977 2 577 578 584 2144 2161 2159 978 2 584 578 585 2161 2162 2163 979 2 578 579 585 2147 2164 2162 980 2 585 579 586 2164 2165 2166 981 2 579 580 586 2150 2167 2165 982 2 586 580 587 2167 2168 2169 983 2 580 581 587 2153 2170 2168 984 2 587 581 588 2170 2171 2172 985 2 582 583 589 2157 2173 2174 986 2 589 583 590 2173 2175 2176 987 2 583 584 590 2160 2177 2175 988 2 590 584 591 2177 2178 2179 989 2 584 585 591 2163 2180 2178 990 2 591 585 592 2180 2181 2182 991 2 585 586 592 2166 2183 2181 992 2 592 586 593 2183 2184 2185 993 2 586 587 593 2169 2186 2184 994 2 593 587 594 2186 2187 2188 995 2 587 588 594 2172 2189 2187 996 2 594 588 595 2189 2190 2191 997 2 589 590 596 2176 2192 2193 998 2 596 590 597 2192 2194 2195 999 2 590 591 597 2179 2196 2194 1000 2 597 591 598 2196 2197 2198 1001 2 591 592 598 2182 2199 2197 1002 2 598 592 599 2199 2200 2201 1003 2 592 593 599 2185 2202 2200 1004 2 599 593 600 2202 2203 2204 1005 2 593 594 600 2188 2205 2203 1006 2 600 594 601 2205 2206 2207 1007 2 594 602 601 2208 2209 2206 1008 2 594 595 602 2191 2210 2208 C C$ RUBRIQUE = REFERENCES DES FACES C 1 0 0 1 2 0 0 0 3 0 0 0 4 0 0 0 5 0 0 0 6 0 0 0 7 0 0 0 8 0 0 0 9 0 0 0 10 0 0 0 11 0 0 0 12 0 2 0 13 0 0 1 14 0 0 0 15 0 0 0 16 0 0 0 17 0 0 0 18 0 0 0 19 0 0 0 20 0 0 0 21 0 0 0 22 0 0 0 23 0 0 0 24 0 2 0 25 0 0 1 26 0 0 0 27 0 0 0 28 0 0 0 29 0 0 0 30 0 0 0 31 0 0 0 32 0 0 0 33 0 0 0 34 0 0 0 35 0 0 0 36 0 2 0 37 0 0 1 38 0 0 0 39 0 0 0 40 0 0 0 41 0 0 0 42 0 0 0 43 0 0 0 44 0 0 0 45 0 0 0 46 0 0 0 47 0 0 0 48 0 2 0 49 0 0 1 50 0 0 0 51 0 0 0 52 0 0 0 53 0 0 0 54 0 0 0 55 0 0 0 56 0 0 0 57 0 0 0 58 0 0 0 59 0 0 0 60 0 2 0 61 0 0 1 62 0 0 0 63 0 0 0 64 0 0 0 65 0 0 0 66 0 0 0 67 0 0 0 68 0 0 0 69 0 0 0 70 0 0 0 71 0 0 0 72 0 2 0 73 0 0 1 74 0 0 0 75 0 0 0 76 0 0 0 77 0 0 0 78 0 0 0 79 0 0 0 80 0 0 0 81 0 0 0 82 0 0 0 83 0 0 0 84 0 2 0 85 0 0 1 86 0 0 0 87 0 0 0 88 0 0 0 89 0 0 0 90 0 0 0 91 0 0 0 92 0 0 0 93 0 0 0 94 0 0 0 95 0 0 0 96 0 2 0 97 0 0 1 98 0 0 0 99 0 0 0 100 0 0 0 101 0 0 0 102 0 0 0 103 0 0 0 104 0 0 0 105 0 0 0 106 0 0 0 107 0 0 0 108 0 2 0 109 0 0 1 110 0 0 0 111 0 0 0 112 0 0 0 113 0 0 0 114 0 0 0 115 0 0 0 116 0 0 0 117 0 0 0 118 0 0 0 119 0 0 0 120 0 2 0 121 0 0 1 122 0 0 0 123 0 0 0 124 0 0 0 125 0 0 0 126 0 0 0 127 0 0 0 128 0 0 0 129 0 0 0 130 0 0 0 131 0 0 0 132 0 2 0 133 0 0 1 134 0 0 0 135 0 0 0 136 0 0 0 137 0 0 0 138 0 0 0 139 0 0 0 140 0 0 0 141 0 0 0 142 0 0 0 143 0 0 0 144 0 2 0 145 0 0 1 146 0 0 0 147 0 0 0 148 0 0 0 149 0 0 0 150 0 0 0 151 0 0 0 152 0 0 0 153 0 0 0 154 0 0 0 155 0 0 0 156 0 2 0 157 0 0 1 158 0 0 0 159 0 0 0 160 0 0 0 161 0 0 0 162 0 0 0 163 0 0 0 164 0 0 0 165 0 0 0 166 0 0 0 167 0 0 0 168 0 2 0 169 0 0 1 170 0 0 0 171 0 0 0 172 0 0 0 173 0 0 0 174 0 0 0 175 0 0 0 176 0 0 0 177 0 0 0 178 0 0 0 179 0 0 0 180 0 2 0 181 0 0 1 182 0 0 0 183 0 0 0 184 0 0 0 185 0 0 0 186 0 0 0 187 0 0 0 188 0 0 0 189 0 0 0 190 0 0 0 191 0 0 0 192 0 2 0 193 0 0 1 194 0 0 0 195 0 0 0 196 0 0 0 197 0 0 0 198 0 0 0 199 0 0 0 200 0 0 0 201 0 0 0 202 0 0 0 203 0 0 0 204 0 2 0 205 0 0 1 206 0 0 0 207 0 0 0 208 0 0 0 209 0 0 0 210 0 0 0 211 0 0 0 212 0 0 0 213 0 0 0 214 0 0 0 215 0 0 0 216 0 2 0 217 0 0 1 218 0 0 0 219 0 0 0 220 0 0 0 221 0 0 0 222 0 0 0 223 0 0 0 224 0 0 0 225 0 0 0 226 0 0 0 227 0 0 0 228 0 2 0 229 0 0 1 230 0 0 0 231 0 0 0 232 0 0 0 233 0 0 0 234 0 0 0 235 0 0 0 236 0 0 0 237 0 0 0 238 0 0 0 239 0 0 0 240 0 2 0 241 0 0 1 242 0 0 0 243 0 0 0 244 0 0 0 245 0 0 0 246 0 0 0 247 0 0 0 248 0 0 0 249 0 0 0 250 0 0 0 251 0 0 0 252 0 2 0 253 0 0 1 254 0 0 0 255 0 0 0 256 0 0 0 257 0 0 0 258 0 0 0 259 0 0 0 260 0 0 0 261 0 0 0 262 0 0 0 263 0 0 0 264 0 2 0 265 0 0 1 266 0 0 0 267 0 0 0 268 0 0 0 269 0 0 0 270 0 0 0 271 0 0 0 272 0 0 0 273 0 0 0 274 0 0 0 275 0 0 0 276 0 2 0 277 0 0 1 278 0 0 0 279 0 0 0 280 0 0 0 281 0 0 0 282 0 0 0 283 0 0 0 284 0 0 0 285 0 0 0 286 0 0 0 287 0 0 0 288 0 2 0 289 0 0 1 290 0 0 0 291 0 0 0 292 0 0 0 293 0 0 0 294 0 0 0 295 0 0 0 296 0 0 0 297 0 0 0 298 0 0 0 299 0 0 0 300 0 2 0 301 0 0 1 302 0 0 0 303 0 0 0 304 0 0 0 305 0 0 0 306 0 0 0 307 0 0 0 308 0 0 0 309 0 0 0 310 0 0 0 311 0 0 0 312 0 2 0 313 0 0 1 314 0 0 0 315 0 0 0 316 0 0 0 317 0 0 0 318 0 0 0 319 0 0 0 320 0 0 0 321 0 0 0 322 0 0 0 323 0 0 0 324 0 2 0 325 0 0 1 326 0 0 0 327 0 0 0 328 0 0 0 329 0 0 0 330 0 0 0 331 0 0 0 332 0 0 0 333 0 0 0 334 0 0 0 335 0 0 0 336 0 2 0 337 0 0 1 338 0 0 0 339 0 0 0 340 0 0 0 341 0 0 0 342 0 0 0 343 0 0 0 344 0 0 0 345 0 0 0 346 0 0 0 347 0 0 0 348 0 2 0 349 0 0 1 350 0 0 0 351 0 0 0 352 0 0 0 353 0 0 0 354 0 0 0 355 0 0 0 356 0 0 0 357 0 0 0 358 0 0 0 359 0 0 0 360 0 2 0 361 0 0 1 362 0 0 0 363 0 0 0 364 0 0 0 365 0 0 0 366 0 0 0 367 0 0 0 368 0 0 0 369 0 0 0 370 0 0 0 371 0 0 0 372 0 2 0 373 0 0 1 374 0 0 0 375 0 0 0 376 0 0 0 377 0 0 0 378 0 0 0 379 0 0 0 380 0 0 0 381 0 0 0 382 0 0 0 383 0 0 0 384 0 2 0 385 0 0 1 386 0 0 0 387 0 0 0 388 0 0 0 389 0 0 0 390 0 0 0 391 0 0 0 392 0 0 0 393 0 0 0 394 0 0 0 395 0 0 0 396 0 2 0 397 0 0 1 398 0 0 0 399 0 0 0 400 0 0 0 401 0 0 0 402 0 0 0 403 0 0 0 404 0 0 0 405 0 0 0 406 0 0 0 407 0 0 0 408 0 2 0 409 0 0 3 410 0 0 0 411 0 0 0 412 0 0 0 413 0 0 0 414 0 0 0 415 0 0 0 416 0 0 0 417 0 0 0 418 0 0 0 419 0 0 0 420 0 4 0 421 0 0 3 422 0 0 0 423 0 0 0 424 0 0 0 425 0 0 0 426 0 0 0 427 0 0 0 428 0 0 0 429 0 0 0 430 0 0 0 431 0 0 0 432 0 4 0 433 0 0 3 434 0 0 0 435 0 0 0 436 0 0 0 437 0 0 0 438 0 0 0 439 0 0 0 440 0 0 0 441 0 0 0 442 0 0 0 443 0 0 0 444 0 4 0 445 0 0 3 446 0 0 0 447 0 0 0 448 0 0 0 449 0 0 0 450 0 0 0 451 0 0 0 452 0 0 0 453 0 0 0 454 0 0 0 455 0 0 0 456 0 4 0 457 0 0 3 458 0 0 0 459 0 0 0 460 0 0 0 461 0 0 0 462 0 0 0 463 0 0 0 464 0 0 0 465 0 0 0 466 0 0 0 467 0 0 0 468 0 4 0 469 0 0 3 470 0 0 0 471 0 0 0 472 0 0 0 473 0 0 0 474 0 0 0 475 0 0 0 476 0 0 0 477 0 0 0 478 0 0 0 479 0 0 0 480 0 4 0 481 0 0 3 482 0 0 0 483 0 0 0 484 0 0 0 485 0 0 0 486 0 0 0 487 0 0 0 488 0 0 0 489 0 0 0 490 0 0 0 491 0 0 0 492 0 4 0 493 0 0 3 494 0 0 0 495 0 0 0 496 0 0 0 497 0 0 0 498 0 0 0 499 0 0 0 500 0 0 0 501 0 0 0 502 0 0 0 503 0 0 0 504 0 4 0 505 0 0 3 506 0 0 0 507 0 0 0 508 0 0 0 509 0 0 0 510 0 0 0 511 0 0 0 512 0 0 0 513 0 0 0 514 0 0 0 515 0 0 0 516 0 4 0 517 0 0 3 518 0 0 0 519 0 0 0 520 0 0 0 521 0 0 0 522 0 0 0 523 0 0 0 524 0 0 0 525 0 0 0 526 0 0 0 527 0 0 0 528 0 4 0 529 0 0 3 530 0 0 0 531 0 0 0 532 0 0 0 533 0 0 0 534 0 0 0 535 0 0 0 536 0 0 0 537 0 0 0 538 0 0 0 539 0 0 0 540 0 4 0 541 0 0 3 542 0 0 0 543 0 0 0 544 0 0 0 545 0 0 0 546 0 0 0 547 0 0 0 548 0 0 0 549 0 0 0 550 0 0 0 551 0 0 0 552 0 4 0 553 0 0 3 554 0 0 0 555 0 0 0 556 0 0 0 557 0 0 0 558 0 0 0 559 0 0 0 560 0 0 0 561 0 0 0 562 0 0 0 563 0 0 0 564 0 4 0 565 0 0 3 566 0 0 0 567 0 0 0 568 0 0 0 569 0 0 0 570 0 0 0 571 0 0 0 572 0 0 0 573 0 0 0 574 0 0 0 575 0 0 0 576 0 4 0 577 0 0 3 578 0 0 0 579 0 0 0 580 0 0 0 581 0 0 0 582 0 0 0 583 0 0 0 584 0 0 0 585 0 0 0 586 0 0 0 587 0 0 0 588 0 4 0 589 0 0 3 590 0 0 0 591 0 0 0 592 0 0 0 593 0 0 0 594 0 0 0 595 0 0 0 596 0 0 0 597 0 0 0 598 0 0 0 599 0 0 0 600 0 4 0 601 0 0 3 602 0 0 0 603 0 0 0 604 0 0 0 605 0 0 0 606 0 0 0 607 0 0 0 608 0 0 0 609 0 0 0 610 0 0 0 611 0 0 0 612 0 4 0 613 0 0 3 614 0 0 0 615 0 0 0 616 0 0 0 617 0 0 0 618 0 0 0 619 0 0 0 620 0 0 0 621 0 0 0 622 0 0 0 623 0 0 0 624 0 4 0 625 0 0 3 626 0 0 0 627 0 0 0 628 0 0 0 629 0 0 0 630 0 0 0 631 0 0 0 632 0 0 0 633 0 0 0 634 0 0 0 635 0 0 0 636 0 4 0 637 0 0 3 638 0 0 0 639 0 0 0 640 0 0 0 641 0 0 0 642 0 0 0 643 0 0 0 644 0 0 0 645 0 0 0 646 0 0 0 647 0 0 0 648 0 4 0 649 0 0 3 650 0 0 0 651 0 0 0 652 0 0 0 653 0 0 0 654 0 0 0 655 0 0 0 656 0 0 0 657 0 0 0 658 0 0 0 659 0 0 0 660 0 4 0 661 0 0 3 662 0 0 0 663 0 0 0 664 0 0 0 665 0 0 0 666 0 0 0 667 0 0 0 668 0 0 0 669 0 0 0 670 0 0 0 671 0 0 0 672 0 4 0 673 0 0 3 674 0 0 0 675 0 0 0 676 0 0 0 677 0 0 0 678 0 0 0 679 0 0 0 680 0 0 0 681 0 0 0 682 0 0 0 683 0 0 0 684 0 4 0 685 0 0 3 686 0 0 0 687 0 0 0 688 0 0 0 689 0 0 0 690 0 0 0 691 0 0 0 692 0 0 0 693 0 0 0 694 0 0 0 695 0 0 0 696 0 4 0 697 0 0 3 698 0 0 0 699 0 0 0 700 0 0 0 701 0 0 0 702 0 0 0 703 0 0 0 704 0 0 0 705 0 0 0 706 0 0 0 707 0 0 0 708 0 4 0 709 0 0 3 710 0 0 0 711 0 0 0 712 0 0 0 713 0 0 0 714 0 0 0 715 0 0 0 716 0 0 0 717 0 0 0 718 0 0 0 719 0 0 0 720 0 4 0 721 0 0 3 722 0 0 0 723 0 0 0 724 0 0 0 725 0 0 0 726 0 0 0 727 0 0 0 728 0 0 0 729 0 0 0 730 0 0 0 731 0 0 0 732 0 4 0 733 0 0 3 734 0 0 0 735 0 0 0 736 0 0 0 737 0 0 0 738 0 0 0 739 0 0 0 740 0 0 0 741 0 0 0 742 0 0 0 743 0 0 0 744 0 4 0 745 0 0 3 746 0 0 0 747 0 0 0 748 0 0 0 749 0 0 0 750 0 0 0 751 0 0 0 752 0 0 0 753 0 0 0 754 0 0 0 755 0 0 0 756 0 4 0 757 0 0 3 758 0 0 0 759 0 0 0 760 0 0 0 761 0 0 0 762 0 0 0 763 0 0 0 764 0 0 0 765 0 0 0 766 0 0 0 767 0 0 0 768 0 4 0 769 0 0 3 770 0 0 0 771 0 0 0 772 0 0 0 773 0 0 0 774 0 0 0 775 0 0 0 776 0 0 0 777 0 0 0 778 0 0 0 779 0 0 0 780 0 4 0 781 0 0 3 782 0 0 0 783 0 0 0 784 0 0 0 785 0 0 0 786 0 0 0 787 0 0 0 788 0 0 0 789 0 0 0 790 0 0 0 791 0 0 0 792 0 4 0 793 0 0 3 794 0 0 0 795 0 0 0 796 0 0 0 797 0 0 0 798 0 0 0 799 0 0 0 800 0 0 0 801 0 0 0 802 0 0 0 803 0 0 0 804 0 4 0 805 0 0 3 806 0 0 0 807 0 0 0 808 0 0 0 809 0 0 0 810 0 0 0 811 0 0 0 812 0 0 0 813 0 0 0 814 0 0 0 815 0 0 0 816 0 4 0 817 0 0 3 818 0 0 0 819 0 0 0 820 0 0 0 821 0 0 0 822 0 0 0 823 0 0 0 824 0 0 0 825 0 0 0 826 0 0 0 827 0 0 0 828 0 4 0 829 0 0 3 830 0 0 0 831 0 0 0 832 0 0 0 833 0 0 0 834 0 0 0 835 0 0 0 836 0 0 0 837 0 0 0 838 0 0 0 839 0 0 0 840 0 4 0 841 0 0 3 842 0 0 0 843 0 0 0 844 0 0 0 845 0 0 0 846 0 0 0 847 0 0 0 848 0 0 0 849 0 0 0 850 0 0 0 851 0 0 0 852 0 4 0 853 0 0 3 854 0 0 0 855 0 0 0 856 0 0 0 857 0 0 0 858 0 0 0 859 0 0 0 860 0 0 0 861 0 0 0 862 0 0 0 863 0 0 0 864 0 4 0 865 0 0 3 866 0 0 0 867 0 0 0 868 0 0 0 869 0 0 0 870 0 0 0 871 0 0 0 872 0 0 0 873 0 0 0 874 0 0 0 875 0 0 0 876 0 4 0 877 0 0 3 878 0 0 0 879 0 0 0 880 0 0 0 881 0 0 0 882 0 0 0 883 0 0 0 884 0 0 0 885 0 0 0 886 0 0 0 887 0 0 0 888 0 4 0 889 0 0 3 890 0 0 0 891 0 0 0 892 0 0 0 893 0 0 0 894 0 0 0 895 0 0 0 896 0 0 0 897 0 0 0 898 0 0 0 899 0 0 0 900 0 4 0 901 0 0 3 902 0 0 0 903 0 0 0 904 0 0 0 905 0 0 0 906 0 0 0 907 0 0 0 908 0 0 0 909 0 0 0 910 0 0 0 911 0 0 0 912 0 4 0 913 0 0 3 914 0 0 0 915 0 0 0 916 0 0 0 917 0 0 0 918 0 0 0 919 0 0 0 920 0 0 0 921 0 0 0 922 0 0 0 923 0 0 0 924 0 4 0 925 0 0 3 926 0 0 0 927 0 0 0 928 0 0 0 929 0 0 0 930 0 0 0 931 0 0 0 932 0 0 0 933 0 0 0 934 0 0 0 935 0 0 0 936 0 4 0 937 0 0 3 938 0 0 0 939 0 0 0 940 0 0 0 941 0 0 0 942 0 0 0 943 0 0 0 944 0 0 0 945 0 0 0 946 0 0 0 947 0 0 0 948 0 4 0 949 0 0 3 950 0 0 0 951 0 0 0 952 0 0 0 953 0 0 0 954 0 0 0 955 0 0 0 956 0 0 0 957 0 0 0 958 0 0 0 959 0 0 0 960 0 4 0 961 0 0 3 962 0 0 0 963 0 0 0 964 0 0 0 965 0 0 0 966 0 0 0 967 0 0 0 968 0 0 0 969 0 0 0 970 0 0 0 971 0 0 0 972 0 4 0 973 0 0 3 974 0 0 0 975 0 0 0 976 0 0 0 977 0 0 0 978 0 0 0 979 0 0 0 980 0 0 0 981 0 0 0 982 0 0 0 983 0 0 0 984 0 4 0 985 0 0 3 986 0 0 0 987 0 0 0 988 0 0 0 989 0 0 0 990 0 0 0 991 0 0 0 992 0 0 0 993 0 0 0 994 0 0 0 995 0 0 0 996 0 4 0 997 0 0 3 998 0 0 0 999 0 0 0 1000 0 0 0 1001 0 0 0 1002 0 0 0 1003 0 0 0 1004 0 0 0 1005 0 0 0 1006 0 0 0 1007 0 0 0 1008 0 4 0 syrthes-3.4.3-dfsg1/example/cylinder/MESH/cylinder_rad.syr0000666000175000017500000002021311524070640022103 0ustar pinipiniC************************************************C C FICHIER GEOMETRIQUE SYRTHES - Rayonnement - C C************************************************C C DIMENSION = 2 DIMENSION DES ELTS = 1 C NOMBRE DE NOEUDS = 86 C NOMBRE D'ELEMENTS = 84 C NOMBRE DE NOEUDS PAR ELEMENT = 2 C************************************************C C C$ RUBRIQUE = NOEUDS C 1 0 0.0000000E+00 -0.1000000E+01 0.0000000E+00 2 0 0.6279052E-01 -0.9980267E+00 0.0000000E+00 3 0 0.1253332E+00 -0.9921147E+00 0.0000000E+00 4 0 0.1873813E+00 -0.9822872E+00 0.0000000E+00 5 0 0.2486899E+00 -0.9685832E+00 0.0000000E+00 6 0 0.3090170E+00 -0.9510565E+00 0.0000000E+00 7 0 0.3681245E+00 -0.9297765E+00 0.0000000E+00 8 0 0.4257793E+00 -0.9048271E+00 0.0000000E+00 9 0 0.4817537E+00 -0.8763067E+00 0.0000000E+00 10 0 0.5358268E+00 -0.8443279E+00 0.0000000E+00 11 0 0.5877852E+00 -0.8090170E+00 0.0000000E+00 12 0 0.6374241E+00 -0.7705132E+00 0.0000000E+00 13 0 0.6845471E+00 -0.7289686E+00 0.0000000E+00 14 0 0.7289687E+00 -0.6845471E+00 0.0000000E+00 15 0 0.7705132E+00 -0.6374240E+00 0.0000000E+00 16 0 0.8090170E+00 -0.5877852E+00 0.0000000E+00 17 0 0.8443279E+00 -0.5358267E+00 0.0000000E+00 18 0 0.8763067E+00 -0.4817536E+00 0.0000000E+00 19 0 0.9048271E+00 -0.4257793E+00 0.0000000E+00 20 0 0.9297765E+00 -0.3681245E+00 0.0000000E+00 21 0 0.9510565E+00 -0.3090170E+00 0.0000000E+00 22 0 0.9685832E+00 -0.2486898E+00 0.0000000E+00 23 0 0.9822873E+00 -0.1873812E+00 0.0000000E+00 24 0 0.9921147E+00 -0.1253332E+00 0.0000000E+00 25 0 0.9980267E+00 -0.6279050E-01 0.0000000E+00 26 0 0.1000000E+01 0.0000000E+00 0.0000000E+00 27 0 0.9980267E+00 0.6279052E-01 0.0000000E+00 28 0 0.9921147E+00 0.1253332E+00 0.0000000E+00 29 0 0.9822872E+00 0.1873813E+00 0.0000000E+00 30 0 0.9685832E+00 0.2486899E+00 0.0000000E+00 31 0 0.9510565E+00 0.3090170E+00 0.0000000E+00 32 0 0.9297765E+00 0.3681245E+00 0.0000000E+00 33 0 0.9048271E+00 0.4257793E+00 0.0000000E+00 34 0 0.8763067E+00 0.4817537E+00 0.0000000E+00 35 0 0.8443279E+00 0.5358268E+00 0.0000000E+00 36 0 0.8090170E+00 0.5877852E+00 0.0000000E+00 37 0 0.7705132E+00 0.6374241E+00 0.0000000E+00 38 0 0.7289686E+00 0.6845471E+00 0.0000000E+00 39 0 0.6845471E+00 0.7289687E+00 0.0000000E+00 40 0 0.6374240E+00 0.7705132E+00 0.0000000E+00 41 0 0.5877852E+00 0.8090170E+00 0.0000000E+00 42 0 0.5358267E+00 0.8443279E+00 0.0000000E+00 43 0 0.4817536E+00 0.8763067E+00 0.0000000E+00 44 0 0.4257793E+00 0.9048271E+00 0.0000000E+00 45 0 0.3681245E+00 0.9297765E+00 0.0000000E+00 46 0 0.3090170E+00 0.9510565E+00 0.0000000E+00 47 0 0.2486898E+00 0.9685832E+00 0.0000000E+00 48 0 0.1873812E+00 0.9822873E+00 0.0000000E+00 49 0 0.1253332E+00 0.9921147E+00 0.0000000E+00 50 0 0.6279050E-01 0.9980267E+00 0.0000000E+00 51 0 0.0000000E+00 0.1000000E+01 0.0000000E+00 52 0 0.0000000E+00 -0.5000000E+00 0.0000000E+00 53 0 0.4613418E-01 -0.4978671E+00 0.0000000E+00 54 0 0.9187476E-01 -0.4914865E+00 0.0000000E+00 55 0 0.1368315E+00 -0.4809128E+00 0.0000000E+00 56 0 0.1806208E+00 -0.4662361E+00 0.0000000E+00 57 0 0.2228692E+00 -0.4475816E+00 0.0000000E+00 58 0 0.2632161E+00 -0.4251086E+00 0.0000000E+00 59 0 0.3013173E+00 -0.3990086E+00 0.0000000E+00 60 0 0.3368478E+00 -0.3695045E+00 0.0000000E+00 61 0 0.3695045E+00 -0.3368478E+00 0.0000000E+00 62 0 0.3990086E+00 -0.3013173E+00 0.0000000E+00 63 0 0.4251086E+00 -0.2632161E+00 0.0000000E+00 64 0 0.4475816E+00 -0.2228692E+00 0.0000000E+00 65 0 0.4662361E+00 -0.1806208E+00 0.0000000E+00 66 0 0.4809128E+00 -0.1368315E+00 0.0000000E+00 67 0 0.4914865E+00 -0.9187473E-01 0.0000000E+00 68 0 0.4978671E+00 -0.4613419E-01 0.0000000E+00 69 0 0.5000000E+00 0.0000000E+00 0.0000000E+00 70 0 0.4978671E+00 0.4613418E-01 0.0000000E+00 71 0 0.4914865E+00 0.9187476E-01 0.0000000E+00 72 0 0.4809128E+00 0.1368315E+00 0.0000000E+00 73 0 0.4662361E+00 0.1806208E+00 0.0000000E+00 74 0 0.4475816E+00 0.2228692E+00 0.0000000E+00 75 0 0.4251086E+00 0.2632161E+00 0.0000000E+00 76 0 0.3990086E+00 0.3013173E+00 0.0000000E+00 77 0 0.3695045E+00 0.3368478E+00 0.0000000E+00 78 0 0.3368478E+00 0.3695045E+00 0.0000000E+00 79 0 0.3013173E+00 0.3990086E+00 0.0000000E+00 80 0 0.2632161E+00 0.4251086E+00 0.0000000E+00 81 0 0.2228692E+00 0.4475816E+00 0.0000000E+00 82 0 0.1806208E+00 0.4662361E+00 0.0000000E+00 83 0 0.1368315E+00 0.4809128E+00 0.0000000E+00 84 0 0.9187473E-01 0.4914865E+00 0.0000000E+00 85 0 0.4613419E-01 0.4978671E+00 0.0000000E+00 86 0 0.0000000E+00 0.5000000E+00 0.0000000E+00 C C$ RUBRIQUE = ELEMENTS C 1 3 1 2 2 3 2 3 3 3 3 4 4 3 4 5 5 3 5 6 6 3 6 7 7 3 7 8 8 3 8 9 9 3 9 10 10 3 10 11 11 3 11 12 12 3 12 13 13 3 13 14 14 3 14 15 15 3 15 16 16 3 16 17 17 3 17 18 18 3 18 19 19 3 19 20 20 3 20 21 21 3 21 22 22 3 22 23 23 3 23 24 24 3 24 25 25 3 25 26 26 3 26 27 27 3 27 28 28 3 28 29 29 3 29 30 30 3 30 31 31 3 31 32 32 3 32 33 33 3 33 34 34 3 34 35 35 3 35 36 36 3 36 37 37 3 37 38 38 3 38 39 39 3 39 40 40 3 40 41 41 3 41 42 42 3 42 43 43 3 43 44 44 3 44 45 45 3 45 46 46 3 46 47 47 3 47 48 48 3 48 49 49 3 49 50 50 3 50 51 51 2 52 53 52 2 53 54 53 2 54 55 54 2 55 56 55 2 56 57 56 2 57 58 57 2 58 59 58 2 59 60 59 2 60 61 60 2 61 62 61 2 62 63 62 2 63 64 63 2 64 65 64 2 65 66 65 2 66 67 66 2 67 68 67 2 68 69 68 2 69 70 69 2 70 71 70 2 71 72 71 2 72 73 72 2 73 74 73 2 74 75 74 2 75 76 75 2 76 77 76 2 77 78 77 2 78 79 78 2 79 80 79 2 80 81 80 2 81 82 81 2 82 83 82 2 83 84 83 2 84 85 84 2 85 86 syrthes-3.4.3-dfsg1/COPYING0000666000175000017500000004310311524070640013743 0ustar pinipini GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. syrthes-3.4.3-dfsg1/src/0000777000175000017500000000000011511305530013471 5ustar pinipinisyrthes-3.4.3-dfsg1/src/util/0000777000175000017500000000000011524070641014454 5ustar pinipinisyrthes-3.4.3-dfsg1/src/util/convert2syrthes/0000777000175000017500000000000011524070641017640 5ustar pinipinisyrthes-3.4.3-dfsg1/src/util/convert2syrthes/Makefile0000666000175000017500000000104611524070640021300 0ustar pinipiniCFLAGS=-O SOURCES=ecriture_syr.c lecture_neu.c lecture_msh.c lecture_med.c convert2syrthes.c INCMED=-I/home/saturne/opt/med-2.3.4/arch/Linux_x86_64/include INCLUDE=-I. LIBMED=-L/home/saturne/opt/med-2.3.4/arch/Linux_x86_64/lib -L/home/saturne/opt/hdf5-1.6.7/arch/Linux_x86_64/lib -lmedC -L. MED=no ifeq ($(MED),yes) CFLAGS += -DMED LIBS += $(LIBMED) INCLUDE += $(INCMED) MESS="Compilation with MED" else MESS="Compilation without MED" endif exe : @echo $(MESS) cc -o convert2syrthes $(CFLAGS) $(INCLUDE) $(LIBS) $(SOURCES) syrthes-3.4.3-dfsg1/src/util/convert2syrthes/lecture_neu.c0000666000175000017500000013002011524070640022311 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2009 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /* Conversions de maillages */ #include #include #include #include "convert2syrthes.h" /* longueur maximale d'une ligne du maillage a lire */ #define LONGUEUR_LIGNE 1001 int ouvrir_neu(struct typ_maillage *maillage, /* INOUT structure de maillage */ char *nomfich) { /* IN nom de fichier maillage a lire */ /* ouverture du fichier de maillage .neu en lecture */ (*maillage).fichier_ext = fopen(nomfich,"r"); /* descripteur de fichier d'entree */ if ( (*maillage).fichier_ext == NULL ) { printf("ERROR : unable to open file (%s)\n",nomfich); return 1; } printf("Gambit Neutral data file opened : %s\n",nomfich); return 0; } /*-------------------------------------------------------------------------------------------*/ int fermer_neu(struct typ_maillage *maillage) { /* fermeture du fichier .neu */ if ( (*maillage).fichier_ext == NULL ) { printf("ERROR : unable to close the file .neu\n"); return 1; } printf("Gambit Neutral file closed\n"); fclose((*maillage).fichier_ext); return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_entete_neu(struct typ_maillage *maillage) { /* lecture de maillage Gambit neutral */ /* entete */ int numnp; /* taille dans le maillage : nombre de sommets */ int nelem; /* taille dans le maillage : nombre d'element*/ int ngrps; /* taille dans le maillage : nombre de groupes*/ int nbsets; /* taille dans le maillage */ int ndfcd; /* taille dans le maillage : dimension 2 ou 3*/ int ndfvl; /* taille dans le maillage : dimension 2 ou 3*/ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char* nomdom; /* nom de domaine */ int longueur_mot; printf(" Reading the head of the file ...\n"); /* initialisations */ numnp = 0; nelem = 0; ngrps = 0; nbsets = 0; ndfcd = 0; ndfvl = 0; /* nom du domaine */ while ((*maillage).numligne < 3) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; } longueur_mot = strlen(chaine); nomdom = (char *) malloc(sizeof(char) * longueur_mot); sscanf(chaine, "%s", nomdom); printf("Domain name : %s \n",nomdom); free(nomdom); /* tailles */ while ((*maillage).numligne < 7) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; } if (sscanf(chaine, "%i %i %i %i %i %i", &numnp, &nelem, &ngrps, &nbsets, &ndfcd, &ndfvl) != 6) { printf("ERROR while reading line %i of the mesh file\n",(*maillage).numligne); return 1; } printf("NUMNP : %i\n",numnp); printf("NELEM : %i\n",nelem); printf("NGRPS : %i\n",ngrps); printf("NBSETS : %i\n",nbsets); printf("NDFCD : %i\n",ndfcd); printf("NDFVL : %i\n",ndfvl); ((*maillage).dimension) = ndfvl; ((*maillage).nbnoeuds) = numnp; ((*maillage).nbelem) = nelem; ((*maillage).nbzones) = ngrps; ((*maillage).nbcl) = nbsets; return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_coord_neu(struct typ_maillage *maillage) { /* lecture de maillage Gambit neutral */ /* coordonnees */ /* ATTENTION : le numero du noeud est considere comme croissant d'un a un en partant de 1 */ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char mot1[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot2[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot3[LONGUEUR_LIGNE]; /* mot dans la ligne */ int i; /* indice de boucle */ int entier1; int numnoeud_moinsun; printf(" Reading coordinates...\n"); strcpy(mot1,"\0"); strcpy(mot2,"\0"); /* recherche du debut de chapitre */ while (strcmp(mot1,"NODAL") != 0 && strcmp(mot2,"COORDINATES") != 0) { if (fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext) == NULL) { printf("ERROR : coordinates not found in the file\n"); return 1; } (*maillage).numligne++; sscanf(chaine, "%s %s %s", mot1, mot2, mot3); } switch ((*maillage).dimension) { case 2 : /* allocations et verifications */ ((*maillage).xcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).xcoord == NULL) { printf("ERROR : allocation error, x coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).ycoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).ycoord == NULL) { printf("ERROR : allocation error, y coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } numnoeud_moinsun = 0; for (numnoeud_moinsun = 0; numnoeud_moinsun < (*maillage).nbnoeuds ; numnoeud_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %lf %lf", &entier1, &((*maillage).xcoord[numnoeud_moinsun]), &((*maillage).ycoord[numnoeud_moinsun])); } break; case 3 : /* allocations et verifications */ ((*maillage).xcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).xcoord == NULL) { printf("ERROR : allocation error, x coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).ycoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).ycoord == NULL) { printf("ERROR : allocation error, y coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).zcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).zcoord == NULL) { printf("ERROR : allocation error, z coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } for (numnoeud_moinsun = 0; numnoeud_moinsun < (*maillage).nbnoeuds ; numnoeud_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %lf %lf %lf", &entier1, &((*maillage).xcoord[numnoeud_moinsun]), &((*maillage).ycoord[numnoeud_moinsun]), &((*maillage).zcoord[numnoeud_moinsun])); } break; default : /* probleme sur dimension */ printf("ERROR : invalid dimension : %i\n",(*maillage).dimension); return -1; } if (entier1 != (*maillage).nbnoeuds) { printf("ERROR : the number of the last node is not equal to the node number : %i != %i\n",entier1,(*maillage).nbnoeuds); return -1; } return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_noeuds_colores_neu(struct typ_maillage *maillage) { /* lecture des noeuds colores : rien a lire*/ /* allocation et initialisation du tableau des couleurs des noeuds */ int i; /* indice de boucle */ /* allocation */ ((*maillage).coul_noeud) = (int *) malloc (sizeof(int) * ((*maillage).nbnoeuds)); if ((*maillage).coul_noeud == NULL) { printf("ERROR : allocation error for the node color table, needed size : %i \n", sizeof(int) * ((*maillage).nbnoeuds)); return 1; } /* initialisation a zero */ for (i=0;i<(*maillage).nbnoeuds;i++) (*maillage).coul_noeud[i] = 0; return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_elem_neu(struct typ_maillage *maillage) { /* lecture des connectivite */ /* ATTENTION : le numero de l'element est considere croissant un a un commencant par 1 */ /* Un seul type d'elements est attendu puisque seul le premier element est verifie */ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char mot1[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot2[LONGUEUR_LIGNE]; /* mot dans la ligne */ int i; /* indice de boucle */ int debut_cpt; int numelem; /* numero de l'element */ int typeelem; /* type de l'element : segment, triangle ou tetraedre */ int nbnodes; /* nombre de noeuds par element */ int entier1, entier2, entier3; int numelem_moinsun; printf(" Reading elements...\n"); strcpy(mot1,"\0"); /* recherche du debut de chapitre */ while (strcmp(mot1,"ELEMENTS/CELLS") != 0) { if (fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext) == NULL) { printf("ERROR : nodes not found in the file\n"); return 1; } (*maillage).numligne++; sscanf(chaine, "%s %s", mot1, mot2); } /* allocation et verification */ (*maillage).liste_elem = (int **) malloc (sizeof(int *) * ((*maillage).nbelem)); if ((*maillage).liste_elem == NULL) { printf("ERROR : allocation error for the connectivity, needed size : %i \n", sizeof(int *) * ((*maillage).nbelem)); return 1; } fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* determination du type d'elements et du nombre de noeuds par element */ if (sscanf(chaine, "%i %i %i", &numelem, &typeelem, &nbnodes) != 3) { printf("ERROR : while reading line %i of the mesh file\n",(*maillage).numligne); return 1; } switch (typeelem) { case 6 : /* tetraedre => dimension des elements = 3*/ (*maillage).dim_elem = 3; (*maillage).nbnoeuds_par_elem = nbnodes; switch (nbnodes) { case 4 : /* tetraedre P1 */ /* allocation du tableau de connectivite */ for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element*/ sscanf(chaine, "%i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][1]), &((*maillage).liste_elem[0][2]), &((*maillage).liste_elem[0][3])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des tetraedres P1*/ sscanf(chaine, "%i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][1]), &((*maillage).liste_elem[numelem_moinsun][2]), &((*maillage).liste_elem[numelem_moinsun][3])); } break; case 10 :/* tetraedre P2 : la connectivite est sur 2 lignes pour un element */ /* renumerotation pour format Syrthes */ /* allocation du tableau de connectivite */ /* si format 4.0 demande, arret, P1 attendu */ if ((*maillage).version_syr==4) { printf("ERROR : element P2 line %i : not allowed with SYRTHES 4.0, Stop.\n",(*maillage).numligne); return 1; } for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element sur 2 lignes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][4]), &((*maillage).liste_elem[0][1]), &((*maillage).liste_elem[0][6]), &((*maillage).liste_elem[0][5]), &((*maillage).liste_elem[0][2]), &((*maillage).liste_elem[0][7])); fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %i %i", &((*maillage).liste_elem[0][8]), &((*maillage).liste_elem[0][9]), &((*maillage).liste_elem[0][3])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des tetraedres P2 sur 2 lignes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][4]), &((*maillage).liste_elem[numelem_moinsun][1]), &((*maillage).liste_elem[numelem_moinsun][6]), &((*maillage).liste_elem[numelem_moinsun][5]), &((*maillage).liste_elem[numelem_moinsun][2]), &((*maillage).liste_elem[numelem_moinsun][7])); fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %i %i", &((*maillage).liste_elem[numelem_moinsun][8]), &((*maillage).liste_elem[numelem_moinsun][9]), &((*maillage).liste_elem[numelem_moinsun][3])); } break; default : printf("ERROR : number of nodes per tetrahedron not allowed (%i)\n", nbnodes); return 1; } break; case 3 : /* triangle => dimension des elements = 2*/ (*maillage).dim_elem = 2; (*maillage).nbnoeuds_par_elem = nbnodes; if (nbnodes != 6 && nbnodes != 3) { printf("ERROR : wrong element type\n"); return 1; } switch (nbnodes) { case 3 : /* triangle P1 */ /* allocation du tableau de connectivite */ for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element*/ sscanf(chaine, "%i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][1]), &((*maillage).liste_elem[0][2])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des triangles P1*/ sscanf(chaine, "%i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][1]), &((*maillage).liste_elem[numelem_moinsun][2])); } break; case 6 : /* triangle P2 */ /* renumerotation pour format Syrthes */ /* allocation du tableau de connectivite */ /* si format 4.0 demande, arret, P1 attendu */ if ((*maillage).version_syr==4) { printf("ERROR : element P2 line %i : not allowed with SYRTHES 4.0, Stop.\n",(*maillage).numligne); return 1; } for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][3]), &((*maillage).liste_elem[0][1]), &((*maillage).liste_elem[0][4]), &((*maillage).liste_elem[0][2]), &((*maillage).liste_elem[0][5])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des triangles P2 */ sscanf(chaine, "%i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][3]), &((*maillage).liste_elem[numelem_moinsun][1]), &((*maillage).liste_elem[numelem_moinsun][4]), &((*maillage).liste_elem[numelem_moinsun][2]), &((*maillage).liste_elem[numelem_moinsun][5])); } break; default : printf("ERROR : number of nodes per triangle not allowed(%i)\n", nbnodes); return 1; } break; case 1 : /* segment => dimension des elements = 1*/ (*maillage).dim_elem = 1; (*maillage).nbnoeuds_par_elem = nbnodes; switch (nbnodes) { case 2 : /* segment P1 */ /* allocation du tableau de connectivite */ for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element*/ sscanf(chaine, "%i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][1])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des triangles P1 */ sscanf(chaine, "%i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][1])); } break; case 3 : /* segment P2 */ /* renumerotation pour format Syrthes */ /* allocation du tableau de connectivite */ /* si format 4.0 demande, arret, P1 attendu */ if ((*maillage).version_syr==4) { printf("ERROR : element P2 line %i : not allowed with SYRTHES 4.0, Stop.\n",(*maillage).numligne); return 1; } for (i=0; i<(*maillage).nbelem; i++) (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * nbnodes); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elem[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the connectivity (verification of the last allocation)\n"); return 1; } /* lecture du premier element*/ sscanf(chaine, "%i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[0][0]), &((*maillage).liste_elem[0][2]), &((*maillage).liste_elem[0][1])); for (numelem_moinsun=1; numelem_moinsun<(*maillage).nbelem; numelem_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* lecture des segments P2 */ sscanf(chaine, "%i %i %i %i %i %i", &entier1, &entier2, &entier3, &((*maillage).liste_elem[numelem_moinsun][0]), &((*maillage).liste_elem[numelem_moinsun][2]), &((*maillage).liste_elem[numelem_moinsun][1])); } break; default : printf("ERROR : number of nodes per bar not allowed (%i)\n", nbnodes); return 1; } break; default : printf("ERROR : element type not allowed\n"); return 1; } return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_zones_neu(struct typ_maillage *maillage) { /* lecture des zones (groupes) */ /* les numeros d'elements a lire sont disposes avec 10 elements maximum par ligne dans le fichier Gambit Neutral */ /* les "material" et "flags" sont ignores */ /* chaque groupe rencontre sera incremente de un a un a partir de un */ /* ce qui correspondra a la couleur des elements */ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char mot1[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot2[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot3[LONGUEUR_LIGNE]; /* mot dans la ligne */ char mot4[LONGUEUR_LIGNE]; /* mot dans la ligne */ int i,j,k; /* indices de boucle */ int nbelem_du_groupe; /* nombre d'element du groupe */ int entier1, entier3, entier4; int elem[10] ; /* liste de 10 elements servant a la lecture des groupes d'elements */ printf(" Reading groups...\n"); /* allocation du tableau des couleurs d'elements et verification */ (*maillage).coul_elem = (int *) malloc (sizeof(int) * ((*maillage).nbelem)); if ((*maillage).liste_elem == NULL) { printf("ERROR : allocation error for the elements color table, needed size : %i \n", sizeof(int) * ((*maillage).nbelem)); return 1; } /* initialisation a 0 des couleurs d'elements */ for (i=0;i<(*maillage).nbelem;i++) (*maillage).coul_elem[i] = 0; /* boucle sur le nombre de groupes */ for (i=0;i<(*maillage).nbzones;i++) { strcpy(mot1,"\0"); strcpy(mot2,"\0"); /* recherche d'un chapitre correspondant a un groupe */ while (strcmp(mot1,"ELEMENT") != 0 && strcmp(mot2,"GROUP") != 0) { if (fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext) == NULL) { printf("ERROR : elements not found in the file\n"); return 1; } (*maillage).numligne++; sscanf(chaine, "%s %s %s", mot1, mot2, mot3); } fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* recuperation des caracteristiques du groupe */ if (sscanf(chaine, "%s %i %s %i %s %i %s %i", mot1, &entier1, mot2, &nbelem_du_groupe, mot3, &entier3, mot4, &entier4) != 8) { printf("ERROR : while reading line %i of the mesh file\n",(*maillage).numligne); return 1; } fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%s", mot1); /* correspondance nom <=> couleur des elements */ printf("Group %s : color %i\n", mot1, i+1); fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* flags ignores */ /* lectures des numeros des elements pas groupe */ /* 10 par ligne sauf eventuellement la derniere */ for(j=0;j 0) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; if (sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i", &elem[0], &elem[1], &elem[2], &elem[3], &elem[4], &elem[5], &elem[6], &elem[7], &elem[8], &elem[9]) != nbelem_du_groupe%10) { printf("ERROR : while reading line %i of the mesh file\n",(*maillage).numligne); return 1; } /* prise en compte des couleurs de la derniere ligne d'elements */ for (k=0;k 0) && (((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) ) { printf(" Reading boundary conditions...\n"); switch ((*maillage).nbnoeuds_par_elem) { case 10 : case 4 : /* elements tetraedres, 4 faces */ nbfaces_par_elem = 4; break; case 6 : case 3 : /* elements triangles, 3 aretes */ nbfaces_par_elem = 3; break; default : printf("ERROR : number of nodes per element not equal to %i\n", (*maillage).nbnoeuds_par_elem); return 1; } /* allocation du tableau du nombre d'elements par condition limite */ nbelem_de_la_cl = (int *) malloc (sizeof(int) * ((*maillage).nbcl)); if (nbelem_de_la_cl == NULL) { printf("ERROR : allocation error for nbelem_de_la_cl, needed size : %i \n", sizeof(int) * ((*maillage).nbcl)); return 1; } for (i=0;i<(*maillage).nbcl;i++) nbelem_de_la_cl[i] = 0; if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ /* allocation de elembord*/ /* allocation du tableau des listes des elements de bord : une partie ne sert pas si parmi les conditions il y a des conditions noeuds */ elembord = (int ***) malloc (sizeof(int **) * ((*maillage).nbcl)); if (elembord == NULL) { printf("ERROR : allocation error for the boundary elements, needed size : %i \n", sizeof(int **) * ((*maillage).nbcl)); return 1; } } else { /* version Syrthes 3.4 */ /* liberation du tableau de connectivites */ for (i=0;i<(*maillage).nbelem;i++) free((*maillage).liste_elem[i]); free((*maillage).liste_elem); /* allocation de liste_reffaces*/ (*maillage).liste_reffaces = (int **) malloc (sizeof(int *) * ((*maillage).nbelem)); if ((*maillage).liste_reffaces == NULL) { printf("ERROR : allocation error for the face references, needed size : %i \n", sizeof(int *) * ((*maillage).nbelem)); return 1; } for (i=0;i<(*maillage).nbelem;i++) (*maillage).liste_reffaces[i] = (int *) malloc (sizeof(int) * nbfaces_par_elem); /* verification de la derniere allocation */ if ((*maillage).liste_reffaces[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the face references (last verification)\n"); return 1; } /* initialisation des references aux faces */ for (i=0;i<(*maillage).nbelem;i++) { for (j=0;j couleur des elements de bord */ printf("Boundary condition %s : color %i\n", mot1, cpt_coul_elembord); if (nbfaces_par_elem == 4) { /* tetraedres */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ elembord[cpt_coul_elembord - 1]=malloc(sizeof(int *) * (nbelem_de_la_cl[cpt_coul_elembord - 1])); for(j=0;j couleur des noeuds */ printf("Group of marked nodes %s : color %i\n", mot1, cpt_coul_noeud); for(j=0;j 0) { /* pour version Syrthes 4.0, mise en place dans la structure des elements de bord */ (*maillage).nbelem_de_bord = numelembord; (*maillage).liste_elembord = (int **) malloc (sizeof(int *) * numelembord); if ((*maillage).liste_elembord == NULL) { printf("ERROR : allocation error for the boundary elements list, needed size : %i \n", sizeof(int *) * numelembord); return 1; } (*maillage).coul_elembord = (int *) malloc (sizeof(int) * numelembord); if ((*maillage).coul_elembord == NULL) { printf("ERROR : allocation error for the boundary elements color, needed size : %i \n", sizeof(int) * numelembord); return 1; } numelembord = 0; for (i=0;i change initial mesh file format to SYRTHES 3.4 mesh format Additional options : -o mesh2.syr : to change the name of the output file -dim 2 or -dim 3 : needed for GMSH file format, ignored in the other cases Note : For MED format, convert2syrthes creates an additionnal ASCII file (..._desc) where one finds the links between group names (used in Salome) and familly (or references) numbers used in SYRTHES Examples : convert2syrthes -m square.med --> square.syr square.syr_desc convert2syrthes -m square.neu --> square.syr convert2syrthes -m square.msh -dim 2 --> square.syr convert2syrthes -m square.med -o square2.syr --> square2.syr square2.syr_desc syrthes-3.4.3-dfsg1/src/util/convert2syrthes/convert2syrthes.h0000666000175000017500000000471611524070640023204 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2009 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /* TYPE POUR CONVERSION DE MAILLAGE SYRTHES */ struct typ_maillage { FILE *fichier_ext; /* descripteur de fichier d'entree */ FILE *fichier_syr; /* descripteur de fichier de syrthes */ FILE *fichier_desc; /* descripteur de fichier de correspondance noms familles MED - references Syrthes */ int version_syr; /* version du fichier syrthes a ecrire */ int dimension; /* dimension de l'espace (1), 2 ou 3 */ int dim_elem; /* dimension des elements 1, 2 ou 3 */ int nbnoeuds; /* nombre de noeuds */ int nbelem; /* nombre d'elements */ int nbnoeuds_par_elem; /* nombre de noeuds par element */ int nbelem_de_bord; /* nombre d'elements de bord pour version Syrthes 4.0 */ int nbzones; /* nombre de zones */ int nbcl; /* nombre de conditions limites */ double *xcoord; /* coordonnee x */ double *ycoord; /* coordonnee y */ double *zcoord; /* coordonnee z */ int *coul_noeud; /* couleur du noeud */ int *coul_elem; /* couleur de l'element */ int **liste_elem; /* connectivite nodale */ int **liste_reffaces; /* stockage des references aux faces pour Syrthes 3.4 */ int *coul_elembord; /* stockage elements de bord pour Syrthes 4.0 */ int **liste_elembord; /* connectivite nodale */ int numligne; /* numero de ligne du fichier en lecture (compteur) */ }; syrthes-3.4.3-dfsg1/src/util/convert2syrthes/ecriture_syr.c0000666000175000017500000004112411524070640022524 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2009 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /* Conversions de maillages */ /* routines d'ecrire au format Syrthes */ #include #include #include #include "convert2syrthes.h" /* longueur maximale d'une ligne du maillage a lire */ #define LONGUEUR_LIGNE 1001 int ouvrir_syr(struct typ_maillage *maillage, /* INOUT structure de maillage */ char *nomfich) { /* IN nom de fichier maillage a ecrire */ /* ouverture du fichier de maillage .syr en ecriture */ (*maillage).fichier_syr = fopen(nomfich,"w"); /* descripteur de fichier d'entree */ if ( (*maillage).fichier_syr == NULL ) { printf("ERROR : unable to open the file %s\n",nomfich); return 1; } printf("SYRTHES file opened : %s\n",nomfich); return 0; } /*-------------------------------------------------------------------------------------------*/ int reouvrir_syr(struct typ_maillage *maillage, /* INOUT structure de maillage */ char *nomfich) { /* IN nom de fichier maillage a reecrire */ /* ouverture du fichier de maillage .syr en lecture/ecriture */ (*maillage).fichier_syr = fopen(nomfich,"r+"); /* descripteur de fichier d'entree */ if ( (*maillage).fichier_syr == NULL ) { printf("ERROR : unable to open again the file %s \n",nomfich); return 1; } printf("SYRTHES file opened again : %s\n",nomfich); return 0; } /*-------------------------------------------------------------------------------------------*/ int fermer_syr(struct typ_maillage *maillage) { /* fermeture du fichier .syr */ if ( (*maillage).fichier_syr == NULL ) { printf("ERROR : unable to close SYRTHES file\n"); return 1; } printf("SYRTHES file closed\n"); fclose((*maillage).fichier_syr); return 0; } /*-------------------------------------------------------------------------------------------*/ int ecrire_entete_syr(struct typ_maillage *maillage) { /* ecriture de l'entete format Syrthes */ printf(" Writing the head of the file..\n"); if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ fprintf((*maillage).fichier_syr,"C*V4.0*******************************************C\n"); fprintf((*maillage).fichier_syr,"C FICHIER GEOMETRIQUE SYRTHES C\n"); fprintf((*maillage).fichier_syr,"C************************************************C\n"); fprintf((*maillage).fichier_syr,"C DIMENSION =%2i\n",(*maillage).dimension); fprintf((*maillage).fichier_syr,"C DIMENSION DES ELTS =%2i\n",(*maillage).dim_elem); fprintf((*maillage).fichier_syr,"C NOMBRE DE NOEUDS = %10i\n",(*maillage).nbnoeuds); fprintf((*maillage).fichier_syr,"C NOMBRE D'ELEMENTS = %10i\n",(*maillage).nbelem); fprintf((*maillage).fichier_syr,"C NOMBRE D'ELEMENTS DE BORD = %10i\n",(*maillage).nbelem_de_bord); fprintf((*maillage).fichier_syr,"C NOMBRE DE NOEUDS PAR ELEMENT = %3i\n",(*maillage).nbnoeuds_par_elem); fprintf((*maillage).fichier_syr,"C************************************************C\n"); } else { /* version Syrthes 3.4 */ fprintf((*maillage).fichier_syr,"C************************************************C\n"); fprintf((*maillage).fichier_syr,"C FICHIER GEOMETRIQUE SYRTHES 3.4 C\n"); fprintf((*maillage).fichier_syr,"C************************************************C\n"); fprintf((*maillage).fichier_syr,"C DIMENSION = %1i DIMENSION DES ELTS = %1i\n",(*maillage).dimension, (*maillage).dim_elem); fprintf((*maillage).fichier_syr,"C NOMBRE DE NOEUDS = %10i\n",(*maillage).nbnoeuds); fprintf((*maillage).fichier_syr,"C NOMBRE D'ELEMENTS =%10i\n",(*maillage).nbelem); fprintf((*maillage).fichier_syr,"C NOMBRE DE NOEUDS PAR ELEMENT = %3i\n",(*maillage).nbnoeuds_par_elem); fprintf((*maillage).fichier_syr,"C************************************************C\n"); } return 0; } /*-------------------------------------------------------------------------------------------*/ int ecrire_coord_syr(struct typ_maillage *maillage) { /* ecriture des coordonnees des noeuds format Syrthes */ /* prerequis : (*maillage).coul_noeud, (*maillage).xcoord, (*maillage).ycoord (et (*maillage).zcoord) existent */ int i; /*indice de boucle */ printf(" Writing coordinates...\n"); fprintf((*maillage).fichier_syr,"C\n"); fprintf((*maillage).fichier_syr,"C$ RUBRIQUE = NOEUDS\n"); fprintf((*maillage).fichier_syr,"C\n"); if ((*maillage).dimension == 2) { /* 3e coordonnee nulle */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbnoeuds;i++) fprintf((*maillage).fichier_syr,"%10i%4i %14.7E %14.7E %14.7E \n", i+1, (*maillage).coul_noeud[i], (*maillage).xcoord[i], (*maillage).ycoord[i], 0.0); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbnoeuds;i++) fprintf((*maillage).fichier_syr,"%10i%3i %14.7E %14.7E %14.7E \n", i+1, (*maillage).coul_noeud[i], (*maillage).xcoord[i], (*maillage).ycoord[i], 0.0); } /* liberation de la memoire */ free((*maillage).xcoord); free((*maillage).ycoord); } else { /* 3D */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbnoeuds;i++) fprintf((*maillage).fichier_syr,"%10i%4i %14.7E %14.7E %14.7E \n", i+1, (*maillage).coul_noeud[i], (*maillage).xcoord[i], (*maillage).ycoord[i], (*maillage).zcoord[i]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbnoeuds;i++) fprintf((*maillage).fichier_syr,"%10i%3i %14.7E %14.7E %14.7E \n", i+1, (*maillage).coul_noeud[i], (*maillage).xcoord[i], (*maillage).ycoord[i], (*maillage).zcoord[i]); } /* liberation de la memoire */ free((*maillage).xcoord); free((*maillage).ycoord); free((*maillage).zcoord); } return 0; } /*-------------------------------------------------------------------------------------------*/ int ecrire_elem_syr(struct typ_maillage *maillage) { /* ecriture des elements format Syrthes */ /* prerequis : (*maillage).coul_elem, (*maillage).liste_elem existent */ int i; /* indice de boucle */ printf(" Writing elements...\n"); fprintf((*maillage).fichier_syr,"C\n"); fprintf((*maillage).fichier_syr,"C$ RUBRIQUE = ELEMENTS\n"); fprintf((*maillage).fichier_syr,"C\n"); switch ((*maillage).nbnoeuds_par_elem) { case 10 : /* 10 noeuds a ecrire */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i%10i%10i%10i%10i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3], (*maillage).liste_elem[i][4], (*maillage).liste_elem[i][5], (*maillage).liste_elem[i][6], (*maillage).liste_elem[i][7], (*maillage).liste_elem[i][8], (*maillage).liste_elem[i][9]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%3i%10i%10i%10i%10i%10i%10i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3], (*maillage).liste_elem[i][4], (*maillage).liste_elem[i][5], (*maillage).liste_elem[i][6], (*maillage).liste_elem[i][7], (*maillage).liste_elem[i][8], (*maillage).liste_elem[i][9]); } break; case 6 : /* 6 noeuds a ecrire */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3], (*maillage).liste_elem[i][4], (*maillage).liste_elem[i][5]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%3i%10i%10i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3], (*maillage).liste_elem[i][4], (*maillage).liste_elem[i][5]); } break; case 4 : /* 4 noeuds a ecrire */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%3i%10i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2], (*maillage).liste_elem[i][3]); } break; case 3 : /* 3 noeuds a ecrire */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%3i%10i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1], (*maillage).liste_elem[i][2]); } break; case 2 : /* 2 noeuds a ecrire */ if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1]); } else { /* version Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i%3i%10i%10i\n", i+1, (*maillage).coul_elem[i], (*maillage).liste_elem[i][0], (*maillage).liste_elem[i][1]); } break; default : printf("ERROR : wrong number of nodes per elements (%i)\n",(*maillage).nbnoeuds_par_elem); return 1; } /* liberation des couleurs des elements */ free((*maillage).coul_elem); return 0; } /*-------------------------------------------------------------------------------------------*/ int ecrire_elem_de_bord_syr(struct typ_maillage *maillage) { /* ecriture des elements de bord pour Syrthes 4.0 */ /* prerequis : (*maillage).liste_elembord (*maillage).coul_elembord (*maillage).nbelem_de_bord existent */ int i; /* indice de boucle */ int nbnoeuds_elembord = 0; /* nombre de noeuds par element de bord */ printf(" Writing boundary elements...\n"); fprintf((*maillage).fichier_syr,"C\n"); fprintf((*maillage).fichier_syr,"C$ RUBRIQUE = ELEMENTS DE BORD\n"); fprintf((*maillage).fichier_syr,"C\n"); switch ((*maillage).nbnoeuds_par_elem) { case 10 : /* 3 noeuds sommets (triangles)*/ case 4 : /* 3 noeuds sommets (triangles)*/ nbnoeuds_elembord = 3; break; case 6 : /* 2 noeuds sommets (aretes) */ case 3 : /* 2 noeuds sommets (aretes) */ nbnoeuds_elembord = 2; break; default : printf("ERROR : wrong number of nodes per elements (%i)\n",(*maillage).nbnoeuds_par_elem); return 1; } if (nbnoeuds_elembord == 3) { for (i=0;i<(*maillage).nbelem_de_bord;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i%10i\n", i+1, (*maillage).coul_elembord[i], (*maillage).liste_elembord[i][0], (*maillage).liste_elembord[i][1], (*maillage).liste_elembord[i][2]); } else { for (i=0;i<(*maillage).nbelem_de_bord;i++) fprintf((*maillage).fichier_syr,"%10i%4i%10i%10i\n", i+1, (*maillage).coul_elembord[i], (*maillage).liste_elembord[i][0], (*maillage).liste_elembord[i][1]); } /* liberation de la memoire pour liste_elembord*/ for (i=0;i<(*maillage).nbelem_de_bord;i++) free((*maillage).liste_elembord[i]); free ((*maillage).liste_elembord); /* liberation de la memoire pour coul_elembord*/ free ((*maillage).coul_elembord); return 0; } /*-------------------------------------------------------------------------------------------*/ int ecrire_reffaces_syr(struct typ_maillage *maillage) { /* ecriture des references aux faces format Syrthes 3.4 */ /* prerequis : (*maillage).liste_reffaces existe */ int i; /* indice de boucle */ int nbfaces_par_elem = 0; /* nombre de faces par element */ printf(" Writing faces references...\n"); fprintf((*maillage).fichier_syr,"C\n"); fprintf((*maillage).fichier_syr,"C$ RUBRIQUE = REFERENCES DES FACES\n"); fprintf((*maillage).fichier_syr,"C\n"); switch ((*maillage).nbnoeuds_par_elem) { case 10 : /* 4 faces pour un tetraedre */ case 4 : /* 4 faces pour un tetraedre */ nbfaces_par_elem = 4; break; case 6 : /* 3 aretes pour un triangle */ case 3 : /* 3 aretes pour un triangle */ nbfaces_par_elem = 3; break; default : printf("ERROR : wrong number of nodes per elements (%i)\n",(*maillage).nbnoeuds_par_elem); return 1; } if (nbfaces_par_elem == 4) { for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i %5i%5i%5i%5i\n", i+1, (*maillage).liste_reffaces[i][0], (*maillage).liste_reffaces[i][1], (*maillage).liste_reffaces[i][2], (*maillage).liste_reffaces[i][3]); } else { for (i=0;i<(*maillage).nbelem;i++) fprintf((*maillage).fichier_syr,"%10i %5i%5i%5i\n", i+1, (*maillage).liste_reffaces[i][0], (*maillage).liste_reffaces[i][1], (*maillage).liste_reffaces[i][2]); } /* liberation de la memoire */ for (i=0;i<(*maillage).nbelem;i++) free((*maillage).liste_reffaces[i]); free ((*maillage).liste_reffaces); return 0; } syrthes-3.4.3-dfsg1/src/util/convert2syrthes/lecture_msh.c0000666000175000017500000007026411524070640022326 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2009 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /* Conversions de maillages */ #include #include #include #include "convert2syrthes.h" /* longueur maximale d'une ligne du maillage a lire */ #define LONGUEUR_LIGNE 1001 int ouvrir_msh(struct typ_maillage *maillage, /* INOUT structure de maillage */ char *nomfich) { /* IN nom de fichier maillage a lire */ /* ouverture du fichier de maillage .msh en lecture */ (*maillage).fichier_ext = fopen(nomfich,"r"); /* descripteur de fichier d'entree */ if ( (*maillage).fichier_ext == NULL ) { printf("ERROR : unable to open the file %s\n",nomfich); return 1; } printf("GMSH file opened : %s\n",nomfich); return 0; } int fermer_msh(struct typ_maillage *maillage) { /* fermeture du fichier .msh */ if ( (*maillage).fichier_ext == NULL ) { printf("ERROR : unable to close the file .msh \n"); return 1; } printf("GMSH file closed\n"); fclose((*maillage).fichier_ext); return 0; } int lire_entete_msh(struct typ_maillage *maillage) { /* rien a lire */ printf(" Dimension : %i\n", (*maillage).dimension); if ((*maillage).dimension != 2 && (*maillage).dimension != 3) { printf("ERROR : non valid dimension\n"); return 1; } return 0; } int lire_coord_msh(struct typ_maillage *maillage) { /* lecture de maillage GMSH */ /* coordonnees */ /* ATTENTION : le numero du noeud est considere comme croissant d'un a un en partant de 1 */ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char mot1[LONGUEUR_LIGNE]; /* mot dans la ligne */ int i; /* indice de boucle */ int entier1; int numnoeud_moinsun; /* numero du noeud - 1 */ printf(" Reading coordinates...\n"); strcpy(mot1,"\0"); /* recherche du debut de chapitre */ /* selon version, $Nodes ou $NOD */ while (strcmp(mot1,"$Nodes") != 0 && strcmp(mot1,"$NOD") != 0) { if (fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext) == NULL) { printf("ERROR : coordinates not found\n"); return 1; } (*maillage).numligne++; sscanf(chaine, "%s", mot1); } /* nombre de noeuds */ fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i", &((*maillage).nbnoeuds)); switch ((*maillage).dimension) { case 2 : /* allocations et verifications */ ((*maillage).xcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).xcoord == NULL) { printf("ERROR : allocation error for the x coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).ycoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).ycoord == NULL) { printf("ERROR : allocation error for the y coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } numnoeud_moinsun = 0; for (numnoeud_moinsun = 0; numnoeud_moinsun < (*maillage).nbnoeuds ; numnoeud_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %lf %lf", &entier1, &((*maillage).xcoord[numnoeud_moinsun]), &((*maillage).ycoord[numnoeud_moinsun])); } break; case 3 : /* allocations et verifications */ ((*maillage).xcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).xcoord == NULL) { printf("ERROR : allocation error for the x coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).ycoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).ycoord == NULL) { printf("ERROR : allocation error for the y coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } ((*maillage).zcoord) = (double *) malloc (sizeof(double) * ((*maillage).nbnoeuds)); if ((*maillage).zcoord == NULL) { printf("ERROR : allocation error for the z coordinate, needed size : %i \n", sizeof(double) * ((*maillage).nbnoeuds)); return 1; } for (numnoeud_moinsun = 0; numnoeud_moinsun < (*maillage).nbnoeuds ; numnoeud_moinsun++) { fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; sscanf(chaine, "%i %lf %lf %lf", &entier1, &((*maillage).xcoord[numnoeud_moinsun]), &((*maillage).ycoord[numnoeud_moinsun]), &((*maillage).zcoord[numnoeud_moinsun])); } break; default : /* probleme sur dimension */ printf("ERROR : dimension is : %i\n",(*maillage).dimension); return -1; } if (entier1 != (*maillage).nbnoeuds) { printf("ERROR : number of the last node isn't equal to the number of nodes : %i != %i\n",entier1,(*maillage).nbnoeuds); return -1; } return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_noeuds_colores_msh(struct typ_maillage *maillage) { /* lecture des noeuds colores : rien a lire*/ /* allocation et initialisation du tableau des couleurs des noeuds */ int i; /* indice de boucle */ /* allocation */ ((*maillage).coul_noeud) = (int *) malloc (sizeof(int) * ((*maillage).nbnoeuds)); if ((*maillage).coul_noeud == NULL) { printf("ERROR : allocation error for nodes color, needed size : %i \n", sizeof(int) * ((*maillage).nbnoeuds)); return 1; } /* initialisation a zero */ for (i=0;i<(*maillage).nbnoeuds;i++) (*maillage).coul_noeud[i] = 0; return 0; } /*-------------------------------------------------------------------------------------------*/ int lire_elem_msh(struct typ_maillage *maillage) { /* lecture des elements dans le fichier GMSH */ /* noeuds colores, elements et elements de bord */ char chaine[LONGUEUR_LIGNE]; /* une ligne du fichier */ char mot1[LONGUEUR_LIGNE]; /* mot dans la ligne */ int entier1, entier2, entier3, entier4, entier5, entier6; int typeelem; /* type d'elements a lire */ int nbelemtotal; /* nombre d'elements total a lire */ int nbnoeuds_par_elembord = 0; /* nombre de noeuds par element de bord */ int numnoeud; /* numero de noeud colore */ int cpt_noeudcolore; /* compteur des noeuds colores */ int couleur; /* couleur lue */ int tetraedreP2; /* presence de tetraedres P2 */ int tetraedreP1; /* presence de tetraedres P1 */ int triangleP2; /* presence de triangles P2 */ int triangleP1; /* presence de triangles P1 */ int segmentP2; /* presence de segments P2 */ int segmentP1; /* presence de segments P1 */ int i,j; /* indices de boucle */ int* coul_elem_tetraedre; /* tableau local des couleurs d'elements tetraedres */ int* coul_elem_triangle; /* tableau local des couleurs d'elements triangles */ int* coul_elem_segment; /* tableau local des couleurs d'elements triangles */ int **elem_tetraedre; /* liste des elements tetraedres */ int **elem_triangle; /* liste des elements triangles */ int **elem_segment; /* liste des elements segments */ printf(" Reading elements ...\n"); strcpy(mot1,"\0"); /* recherche du debut de chapitre */ /* selon version, $Elements ou $ELM */ while (strcmp(mot1,"$Elements") != 0 && strcmp(mot1,"$ELM") != 0) { if (fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext) == NULL) { printf("ERROR : elements not found\n"); return 1; } (*maillage).numligne++; sscanf(chaine, "%s", mot1); } fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* determination du nombre total d'elements */ sscanf(chaine, "%i", &nbelemtotal); /* initialisations */ cpt_noeudcolore = 0; tetraedreP2 = 0; tetraedreP1 = 0; triangleP2 = 0; triangleP1 = 0; segmentP2 = 0; segmentP1 = 0; /* allocation et verification */ elem_tetraedre = (int **) malloc (sizeof(int *) * nbelemtotal); elem_triangle = (int **) malloc (sizeof(int *) * nbelemtotal); elem_segment = (int **) malloc (sizeof(int *) * nbelemtotal); coul_elem_tetraedre = (int *) malloc (sizeof(int ) * nbelemtotal); coul_elem_triangle = (int *) malloc (sizeof(int ) * nbelemtotal); coul_elem_segment = (int *) malloc (sizeof(int ) * nbelemtotal); if (elem_tetraedre == NULL || elem_triangle == NULL || elem_segment == NULL) { printf("ERROR : allocation error (lecture_msh), needed size for each elem_ : %i \n", sizeof(int *) * (nbelemtotal)); return 1; } /* les allocations plus basses de ces tableaux seront faites en fonction des elements trouves (elements de bord ou non) */ if (coul_elem_tetraedre == NULL || coul_elem_triangle == NULL || coul_elem_segment == NULL) { printf("ERROR : allocation error for the elements color, needed size : %i \n", sizeof(int) * (nbelemtotal)); return 1; } /* initialisations des couleurs */ for (i=0;i dimension des elements = 3 */ /* ATTENTION : noeud 9 et 10 a intervertir!! */ elem_tetraedre[tetraedreP2] = (int *) malloc (sizeof(int ) * 10); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_tetraedre[tetraedreP2][0]), &(elem_tetraedre[tetraedreP2][1]), &(elem_tetraedre[tetraedreP2][2]), &(elem_tetraedre[tetraedreP2][3]), &(elem_tetraedre[tetraedreP2][4]), &(elem_tetraedre[tetraedreP2][5]), &(elem_tetraedre[tetraedreP2][6]), &(elem_tetraedre[tetraedreP2][7]), &(elem_tetraedre[tetraedreP2][9]), &(elem_tetraedre[tetraedreP2][8])); coul_elem_tetraedre[tetraedreP2] = couleur; tetraedreP2++; break; case 4 : /* tetraedre a 4 noeuds => dimension des elements = 3 */ elem_tetraedre[tetraedreP1] = (int *) malloc (sizeof(int ) * 4); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_tetraedre[tetraedreP1][0]), &(elem_tetraedre[tetraedreP1][1]), &(elem_tetraedre[tetraedreP1][2]), &(elem_tetraedre[tetraedreP1][3])); coul_elem_tetraedre[tetraedreP1] = couleur; tetraedreP1++; break; case 9 : /* triangle a 6 noeuds => */ elem_triangle[triangleP2] = (int *) malloc (sizeof(int ) * 6); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_triangle[triangleP2][0]), &(elem_triangle[triangleP2][1]), &(elem_triangle[triangleP2][2]), &(elem_triangle[triangleP2][3]), &(elem_triangle[triangleP2][4]), &(elem_triangle[triangleP2][5])); coul_elem_triangle[triangleP2] = couleur; triangleP2++; break; case 2 : /* triangle a 3 noeuds */ elem_triangle[triangleP1] = (int *) malloc (sizeof(int ) * 3); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_triangle[triangleP1][0]), &(elem_triangle[triangleP1][1]), &(elem_triangle[triangleP1][2])); coul_elem_triangle[triangleP1] = couleur; triangleP1++; break; case 8 : /* segment 3 noeuds */ elem_segment[segmentP2] = (int *) malloc (sizeof(int ) * 3); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_segment[segmentP2][0]), &(elem_segment[segmentP2][1]), &(elem_segment[segmentP2][2])); coul_elem_segment[segmentP2] = couleur; segmentP2++; break; case 1 : /* segment 2 noeuds */ elem_segment[segmentP1] = (int *) malloc (sizeof(int ) * 2); /* lecture de l'element, meme numerotation que Syrthes*/ sscanf(chaine, "%i %i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &(elem_segment[segmentP1][0]), &(elem_segment[segmentP1][1])); coul_elem_segment[segmentP1] = couleur; segmentP1++; break; case 15 : /* noeud colore */ /* lecture du numero du noeud et de la couleur*/ sscanf(chaine, "%i %i %i %i %i %i %i", &entier1, &entier2, &entier3, &couleur, &entier5, &entier6, &numnoeud); (*maillage).coul_noeud[numnoeud-1] = couleur; cpt_noeudcolore++; break; default : printf("ERROR : unknown element type line %i\n",(*maillage).numligne); return 1; } fgets(chaine, LONGUEUR_LIGNE , (*maillage).fichier_ext); (*maillage).numligne++; /* determination du type d'elements*/ sscanf(chaine, "%i %i", &entier1, &typeelem); } /* Fin de la boucle sur les elements a lire */ if (segmentP1+segmentP2+triangleP1+triangleP2+tetraedreP1+tetraedreP2+cpt_noeudcolore != nbelemtotal) { printf("ERROR : wrong total number of elements\n"); return 1; } if ( (segmentP2>0 || triangleP2>0 || tetraedreP2>0) && ((*maillage).version_syr == 4) ) { printf("ERROR : element P2 found - This is not allowed with SYRTHES 4.0, Stop.\n"); return 1; } if ( (tetraedreP2>0 || tetraedreP1>0)&& ((*maillage).dimension != 3) ) { printf("ERROR : tetrahedron element found in dimension %i, stop.\n", (*maillage).dimension); return 1; } if ( tetraedreP2>0 ) { /* dimension de elements vaut 3 et le nombre de noeuds par element vaut 10*/ (*maillage).dim_elem = 3; (*maillage).nbnoeuds_par_elem = 10; (*maillage).nbelem = tetraedreP2; (*maillage).nbelem_de_bord = triangleP2; nbnoeuds_par_elembord = 6; } else if ( tetraedreP1>0 ) { /* dimension de elements vaut 3 et le nombre de noeuds par element vaut 4*/ (*maillage).dim_elem = 3; (*maillage).nbnoeuds_par_elem = 4; (*maillage).nbelem = tetraedreP1; (*maillage).nbelem_de_bord = triangleP1; nbnoeuds_par_elembord = 3; } else if ( triangleP2>0 ) { /* dimension de elements vaut 2 et le nombre de noeuds par element vaut 6*/ (*maillage).dim_elem = 2; (*maillage).nbnoeuds_par_elem = 6; (*maillage).nbelem = triangleP2; (*maillage).nbelem_de_bord = segmentP2; nbnoeuds_par_elembord = 3; } else if ( triangleP1>0 ) { /* dimension de elements vaut 2 et le nombre de noeuds par element vaut 3*/ (*maillage).dim_elem = 2; (*maillage).nbnoeuds_par_elem = 3; (*maillage).nbelem = triangleP1; (*maillage).nbelem_de_bord = segmentP1; nbnoeuds_par_elembord = 2; } else if ( segmentP2>0 ) { /* dimension de elements vaut 1 et le nombre de noeuds par element vaut 3*/ (*maillage).dim_elem = 1; (*maillage).nbnoeuds_par_elem = 3; (*maillage).nbelem = segmentP2; (*maillage).nbelem_de_bord = 0; nbnoeuds_par_elembord = 0; if ((*maillage).dimension != 2) { printf("\nWARNING : elements dimension is 1 while space dimension is %i !!\n\n", (*maillage).dimension); } } else if ( segmentP1>0 ) { /* dimension de elements vaut 1 et le nombre de noeuds par element vaut 2*/ (*maillage).dim_elem = 1; (*maillage).nbnoeuds_par_elem = 2; (*maillage).nbelem = segmentP1; (*maillage).nbelem_de_bord = 0; nbnoeuds_par_elembord = 0; if ((*maillage).dimension != 2) { printf("\nWARNING : elements dimension is 1 while space dimension is %i !!\n\n", (*maillage).dimension); } } if (tetraedreP2>0 || tetraedreP1>0) { (*maillage).liste_elem = (int **) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).liste_elembord = (int **) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); (*maillage).coul_elem = (int *) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).coul_elembord = (int *) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); if ((*maillage).liste_elem == NULL || (*maillage).coul_elem == NULL ) { printf("ERROR : allocation error (lecture_msh) for the structure\n"); return 1; } /* stockage des elements dans la structure */ for(i=0;i<(*maillage).nbelem;i++) { (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * ((*maillage).nbnoeuds_par_elem)); for(j=0;j<(*maillage).nbnoeuds_par_elem;j++) (*maillage).liste_elem[i][j] = elem_tetraedre[i][j]; free(elem_tetraedre[i]); (*maillage).coul_elem[i] = coul_elem_tetraedre[i]; }/* stockage des elements de bord dans la structure */ for(i=0;i<(*maillage).nbelem_de_bord;i++) { (*maillage).liste_elembord[i] = (int *) malloc (sizeof(int ) * nbnoeuds_par_elembord); for(j=0;j0 || triangleP1>0) { (*maillage).liste_elem = (int **) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).liste_elembord = (int **) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); (*maillage).coul_elem = (int *) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).coul_elembord = (int *) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); if ((*maillage).liste_elem == NULL || (*maillage).coul_elem == NULL) { printf("ERROR : allocation error (lecture_msh) for the structure\n"); return 1; } /* stockage des elements dans la structure */ for(i=0;i<(*maillage).nbelem;i++) { (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * ((*maillage).nbnoeuds_par_elem)); for(j=0;j<(*maillage).nbnoeuds_par_elem;j++) (*maillage).liste_elem[i][j] = elem_triangle[i][j]; free(elem_triangle[i]); (*maillage).coul_elem[i] = coul_elem_triangle[i]; }/* stockage des elements de bord dans la structure */ for(i=0;i<(*maillage).nbelem_de_bord;i++) { (*maillage).liste_elembord[i] = (int *) malloc (sizeof(int ) * nbnoeuds_par_elembord); for(j=0;j0 || segmentP1>0) { (*maillage).liste_elem = (int **) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).liste_elembord = (int **) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); (*maillage).coul_elem = (int *) malloc (sizeof(int *) * (*maillage).nbelem); (*maillage).coul_elembord = (int *) malloc (sizeof(int *) * (*maillage).nbelem_de_bord); if ((*maillage).liste_elem == NULL || (*maillage).coul_elem == NULL ) { printf("ERROR : allocation error (lecture_msh) for the structure\n"); return 1; } /* stockage des elements dans la structure */ for(i=0;i<(*maillage).nbelem;i++) { (*maillage).liste_elem[i] = (int *) malloc (sizeof(int ) * ((*maillage).nbnoeuds_par_elem)); for(j=0;j<(*maillage).nbnoeuds_par_elem;j++) (*maillage).liste_elem[i][j] = elem_segment[i][j]; free(elem_segment[i]); (*maillage).coul_elem[i] = coul_elem_segment[i]; } } else { printf("ERROR : no element found line %i\n",(*maillage).numligne); return 1; } /* liberation de la memoire */ free(elem_tetraedre); free(elem_triangle); free(elem_segment); free(coul_elem_tetraedre); free(coul_elem_triangle); free(coul_elem_segment); return 0; } int lire_zones_msh(struct typ_maillage *maillage) { /* rien a lire ni a faire */ return 0; } int lire_cl_msh(struct typ_maillage *maillage) { /* rien a lire */ /* Pour Syrthes 4.0 : rien a faire */ /* Pour Syrthes 3.4 : references des faces a faire */ /* a partir de liste_elembord et liste_elem */ int i,j; /* indices de boucles */ int nbfaces_par_elem; /* nomnre de faces par element */ if ((*maillage).nbelem_de_bord > 0) { if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if ((*maillage).version_syr == 3) { /* calcul des references des faces */ if (calcul_reffaces(maillage) != 0) { printf("ERROR while face references calculation\n"); return 1; } /* liberation de la memoire cas Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem_de_bord;i++) free((*maillage).liste_elembord[i]); free((*maillage).liste_elembord); free((*maillage).coul_elembord); } } else { /* liberation de la memoire cas Rayonnment */ for (i=0;i<(*maillage).nbelem_de_bord;i++) free((*maillage).liste_elembord[i]); free((*maillage).liste_elembord); free((*maillage).coul_elembord); (*maillage).nbelem_de_bord = 0; } } else { /* cas reffaces lorsque le nombre de d'elements de bord est nul */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { printf("\nWARNING : 0 boundary elements !!\n\n"); if ((*maillage).version_syr == 3) { /* nombre de faces par element et nombre de noeuds sommets par element */ if ((*maillage).dim_elem == 3) nbfaces_par_elem = 4; else nbfaces_par_elem = 3; /* allocation du tableau des references des faces */ (*maillage).liste_reffaces = (int **) malloc (sizeof(int *) * ((*maillage).nbelem)); if ((*maillage).liste_reffaces == NULL) { printf("ERROR : allocation error for the face references, needed size : %i \n", sizeof(int *) * ((*maillage).nbelem)); return 1; } for (i=0;i<(*maillage).nbelem;i++) (*maillage).liste_reffaces[i] = (int *) malloc (sizeof(int) * nbfaces_par_elem); /* verification de la derniere allocation */ if ((*maillage).liste_reffaces[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for the face references (last allocation)\n"); return 1; } /* initialisation des references aux faces */ for (i=0;i<(*maillage).nbelem;i++) { for (j=0;j #include #include #include "convert2syrthes.h" /* include MED */ #include #define MESGERR #include int ouvrir_med(struct typ_maillage *maillage, /* INOUT structure de maillage */ char *nomfich, /* IN nom de fichier maillage a lire */ char *nomsyr) { /* IN nom de fichier syrthes */ /* ouverture du fichier en lecture seule */ /* et verification de la conformite */ med_idt fid; med_int majeur, mineur, release; int erreur = 0; char *nomficfam = 0; fid = MEDouvrir(nomfich,MED_LECTURE); (*maillage).fichier_ext = (FILE *) fid; if ( fid < 0) { printf("ERROR : unable to open MED file\n"); return 1; } /* * Quelle version de la bibliotheque MED est utilisee ? */ printf("\n"); MEDversionDonner(&majeur, &mineur, &release); fprintf(stdout,"- MED version used to read the file : %d.%d.%d \n",majeur,mineur,release); /* * Le fichier à lire est-il au bon format de fichier HDF ? */ if (! MEDformatConforme(nomfich)) fprintf(stdout,"- HDF format of the MED file in accordance with HDF format now used \n"); else { fprintf(stdout,"ERROR : HDF format of the MED file not in accordance with HDF format now used\n"); erreur = 1; } /* * Le fichier a lire a-t-il été créé avec une version de la bibliothèque MED conforme avec celle utilise ? * (Numéros majeur et mineur identiques). */ if (! MEDversionConforme(nomfich)) fprintf(stdout,"- MED version of the file in accordance with MED version now used\n"); else { fprintf(stdout,"ERROR : MED version of the file not in accordance with MED version used now \n"); erreur = 1; } /* * Une fois le fichier ouvert on peut avoir acces au numero de version complet */ if (MEDversionLire(fid, &majeur, &mineur, &release) < 0) { MESSAGE("ERROR while reading the library version "); return -1; } fprintf(stdout,"- This file has been created with MED %d.%d.%d \n",majeur,mineur,release); if (erreur != 0) { fprintf(stdout,"ERROR : check $LD_LIBRARY_PATH?\n"); return 1; } printf("\n"); printf("Name of the MED file : %s\n",nomfich); if (!erreur) { /* * Ecriture de la table de correspondances nom familles MED, numeros syrthes */ nomficfam = (char*) malloc((strlen(nomsyr) +10)*sizeof(char)); sprintf(nomficfam, "%s%s",nomsyr,"_desc"); (*maillage).fichier_desc = fopen(nomficfam,"w"); if ( (*maillage).fichier_desc == NULL ) { printf("ERROR : unable to open file %s for writing\n",nomficfam); return 1; } printf("Name of the MED-SYRTHES correspondance file : %s\n",nomficfam); } return 0; } int fermer_med(struct typ_maillage *maillage) { /* fermeture du fichier .med */ if (MEDfermer((int) (*maillage).fichier_ext) < 0) { printf("ERROR : unable to close the file .med\n"); return 1; } printf("MED file closed\n"); fclose((*maillage).fichier_desc); printf("MED-SYRTHES correspondance file closed\n"); return 0; } int lire_entete_med(struct typ_maillage *maillage) { /* lecture des informations sur le maillage */ med_idt fid = (int) (*maillage).fichier_ext; /* la dimension du maillage */ med_int mdim; /* nom du maillage de longueur maxi MED_TAILLE_NOM */ char maa[MED_TAILLE_NOM+1]; char desc[MED_TAILLE_DESC+1]; med_maillage type; int tetraedreP2; /* presence de tetraedres P2 */ int tetraedreP1; /* presence de tetraedres P1 */ int triangleP2; /* presence de triangles P2 */ int triangleP1; /* presence de triangles P1 */ int segmentP2; /* presence de segments P2 */ int segmentP1; /* presence de segments P1 */ /* informations sur les familles */ med_int nbfam, nufam, natt, ngro, *attide, *attval; med_int i; char *attdes, *gro; char nomfam[MED_TAILLE_NOM+1]; char *nommed = 0; med_err ret =0; printf(" Reading mesh information...\n"); /* Lecture des infos concernant le premier maillage : les autres maillages sont ignores */ if (MEDmaaInfo(fid,1,maa,&mdim,&type,desc) < 0) { MESSAGE("ERROR while reading mesh information : ");SSCRUTE(maa); return 1; } printf("Mesh name : %s - dimension : %d \n",maa,mdim); (*maillage).dimension = mdim; if (type != MED_NON_STRUCTURE) { printf("ERROR : mesh must be unstructured\n"); return 1; } /* Combien de noeuds a lire ? */ (*maillage).nbnoeuds = MEDnEntMaa(fid,maa,MED_COOR,MED_NOEUD,0,0); if ((*maillage).nbnoeuds <= 0) { printf("ERROR : wrong number of nodes : %i\n",(*maillage).nbnoeuds); return 1; } printf("Number of nodes : %d \n",(*maillage).nbnoeuds); /* Combien d'elements a lire ? */ tetraedreP2 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE,MED_TETRA10,0); tetraedreP1 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE, MED_TETRA4,0); triangleP2 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE, MED_TRIA6,0); triangleP1 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE, MED_TRIA3,0); segmentP2 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE,MED_SEG3,0); segmentP1 = MEDnEntMaa(fid,maa,MED_CONN,MED_MAILLE,MED_SEG2,0); if ( (segmentP2>0 || triangleP2>0 || tetraedreP2>0) && ((*maillage).version_syr == 4) ) { printf("ERROR : element P2 found - This is not allowed with SYRTHES 4.0, Stop.\n"); return 1; } if ( (tetraedreP2>0 || tetraedreP1>0) && ((*maillage).dimension != 3) ) { printf("ERROR : tetrahedra found in dimension : %i, Stop.\n", (*maillage).dimension); return 1; } if ( tetraedreP2>0 ) { /* dimension de elements vaut 3 et le nombre de noeuds par element vaut 10*/ (*maillage).dim_elem = 3; (*maillage).nbnoeuds_par_elem = 10; (*maillage).nbelem = tetraedreP2; (*maillage).nbelem_de_bord = triangleP2; printf("Number of tetrahedra P2 : %i\n",tetraedreP2); printf("Number of triangles P2 : %i\n",triangleP2); } else if ( tetraedreP1>0 ) { /* dimension de elements vaut 3 et le nombre de noeuds par element vaut 4*/ (*maillage).dim_elem = 3; (*maillage).nbnoeuds_par_elem = 4; (*maillage).nbelem = tetraedreP1; (*maillage).nbelem_de_bord = triangleP1; printf("Number of tetrahedra P1 : %i\n",tetraedreP1); printf("Number of triangles P1 : %i\n",triangleP1); } else if ( triangleP2>0 ) { /* dimension de elements vaut 2 et le nombre de noeuds par element vaut 6*/ (*maillage).dim_elem = 2; (*maillage).nbnoeuds_par_elem = 6; (*maillage).nbelem = triangleP2; (*maillage).nbelem_de_bord = segmentP2; printf("Number of triangles P2 : %i\n",triangleP2); printf("Number of bars P2 : %i\n",segmentP2); } else if ( triangleP1>0 ) { /* dimension de elements vaut 2 et le nombre de noeuds par element vaut 3*/ (*maillage).dim_elem = 2; (*maillage).nbnoeuds_par_elem = 3; (*maillage).nbelem = triangleP1; (*maillage).nbelem_de_bord = segmentP1; printf("Number of triangles P1 : %i\n",triangleP1); printf("Number of bars P1 : %i\n",segmentP1); } else if ( segmentP2>0 ) { /* dimension de elements vaut 1 et le nombre de noeuds par element vaut 3*/ (*maillage).dim_elem = 1; (*maillage).nbnoeuds_par_elem = 3; (*maillage).nbelem = segmentP2; (*maillage).nbelem_de_bord = 0; printf("Number of bars P2 : %i\n",segmentP2); } else if ( segmentP1>0 ) { /* dimension de elements vaut 1 et le nombre de noeuds par element vaut 2*/ (*maillage).dim_elem = 1; (*maillage).nbnoeuds_par_elem = 2; (*maillage).nbelem = segmentP1; (*maillage).nbelem_de_bord = 0; printf("Number de segments P1 : %i\n",segmentP1); } else { printf("ERROR : no element to read !\n"); return 1; } nbfam = MEDnFam(fid,maa); printf("Number of MED families : %d\n", nbfam); for (i=0; i 0) { if (((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if (MEDmaaInfo(fid,1,maa,&mdim,&type,desc) < 0) { MESSAGE("ERROR while reading mesh information : ");SSCRUTE(maa); return 1; } printf(" Reading boundary elements...\n"); switch ((*maillage).nbnoeuds_par_elem) { case 10 : /* 6 noeuds (triangles)*/ nbnoeuds_elembord = 6; break; case 4 : /* 3 noeuds sommets (triangles)*/ nbnoeuds_elembord = 3; break; case 6 : /* 3 noeuds (aretes) */ nbnoeuds_elembord = 3; break; case 3 : /* 2 noeuds (aretes) */ nbnoeuds_elembord = 2; break; default : printf("ERROR : wrong number of nodes per element (%i)\n",(*maillage).nbnoeuds_par_elem); return 1; } liste = (med_int*) malloc(sizeof(med_int)*(nbnoeuds_elembord)*((*maillage).nbelem_de_bord)); if (liste == NULL){ printf("ERROR : allocation error for the boundary connectivity\n"); return 1; } /* couleurs : allocation et initialisation */ (*maillage).coul_elembord = (int *) malloc (sizeof(int) * (*maillage).nbelem_de_bord); if ((*maillage).coul_elembord == NULL) { printf("ERROR : allocation error for the boundary connectivity, needed size : %i \n", sizeof(int) * (*maillage).nbelem_de_bord); return 1; } for (i=0;i<(*maillage).nbelem_de_bord;i++) (*maillage).coul_elembord[i] = 0; /* selon le type d'elements a lire */ switch ((*maillage).nbnoeuds_par_elem) { case 10 : /* tetraedres P2 -> triangles P2 */ /* Lecture de la connectivite */ if (MEDconnLire(fid,maa,mdim,liste,MED_FULL_INTERLACE,NULL,0,MED_MAILLE,MED_TRIA6,MED_NOD) < 0) { MESSAGE("ERROR while reading connectivity, is it nodal connectivity ??"); return 1; } /* Lecture des numeros des familles*/ if (MEDfamLire(fid,maa,(*maillage).coul_elembord,(*maillage).nbelem_de_bord,MED_MAILLE,MED_TRIA6) < 0) { MESSAGE("ERROR while reading family numbers for the boundary elements"); return 1; } break; case 4 : /* tetraedres P1 -> triangles P1 */ /* Lecture de la connectivite */ if (MEDconnLire(fid,maa,mdim,liste,MED_FULL_INTERLACE,NULL,0,MED_MAILLE,MED_TRIA3,MED_NOD) < 0) { MESSAGE("ERROR while reading connectivity, is it nodal connectivity ??"); return 1; } /* Lecture des numeros des familles*/ if (MEDfamLire(fid,maa,(*maillage).coul_elembord,(*maillage).nbelem_de_bord,MED_MAILLE,MED_TRIA3) < 0) { MESSAGE("ERROR while reading family numbers for the boundary elements"); return 1; } break; case 6 : /* triangles P2 -> segments P2 */ /* Lecture de la connectivite */ if (MEDconnLire(fid,maa,mdim,liste,MED_FULL_INTERLACE,NULL,0,MED_MAILLE,MED_SEG3,MED_NOD) < 0) { MESSAGE("ERROR while reading connectivity, is it nodal connectivity ??"); return 1; } /* Lecture des numeros des familles*/ if (MEDfamLire(fid,maa,(*maillage).coul_elembord,(*maillage).nbelem_de_bord,MED_MAILLE,MED_SEG3) < 0) { MESSAGE("ERROR while reading family numbers for the boundary elements"); return 1; } break; case 3 : /* triangles P1 -> segments P1 */ /* Lecture de la connectivite */ if (MEDconnLire(fid,maa,mdim,liste,MED_FULL_INTERLACE,NULL,0,MED_MAILLE,MED_SEG2,MED_NOD) < 0) { MESSAGE("ERROR while reading connectivity, is it nodal connectivity ??"); return 1; } /* Lecture des numeros des familles*/ if (MEDfamLire(fid,maa,(*maillage).coul_elembord,(*maillage).nbelem_de_bord,MED_MAILLE,MED_SEG2) < 0) { MESSAGE("ERROR while reading family numbers for the boundary elements"); return 1; } break; default : printf("ERROR : wrong number of nodes per element %i\n",(*maillage).nbnoeuds_par_elem); return 1; } /* convention MED, le numéro des familles d'elements est negatif */ for (i=0;i<(*maillage).nbelem_de_bord;i++) (*maillage).coul_elembord[i] = abs((*maillage).coul_elembord[i]); /* mise dans la structure */ /* allocation et verification */ (*maillage).liste_elembord = (int **) malloc (sizeof(int *) * ((*maillage).nbelem_de_bord)); if ((*maillage).liste_elembord == NULL) { printf("ERROR : allocation error for the boundary connectivity, needed size : %i \n", sizeof(int *) * ((*maillage).nbelem_de_bord)); return 1; } /* allocation du tableau de connectivite */ for (i=0; i<(*maillage).nbelem_de_bord; i++) (*maillage).liste_elembord[i] = (int *) malloc (sizeof(int ) * (nbnoeuds_elembord)); /* verification de la derniere allocation seulement */ if ((*maillage).liste_elembord[(*maillage).nbelem_de_bord-1] == NULL) { printf("ERROR : allocation error for the boundary connectivity (verification of the last allocation)\n"); return 1; } /* stockage selon le mode choisi MED_FULL_INTERLACE*/ for (i=0;i<(*maillage).nbelem_de_bord;i++) { for (j=0;j #include #include #include "convert2syrthes.h" extern char *basename (__const char *__filename) __THROW __nonnull ((1)); static int cmpentier(const void *p1, const void *p2){ /* fonction servant pour l'utilisation de qsort...*/ return (* (int const *) p1 - * (int const *) p2); } int calcul_reffaces(struct typ_maillage *maillage) { /* Pour Syrthes 3.4 : calcul des references des faces */ /* a partir de liste_elembord et liste_elem */ /* - classer dans un tableau local par ordre croissant les 4 premiers noeuds si dim_elem=3, les 3 premiers si dim_elem=2 */ /* - Pour chaque element de bord, chercher l'element auquel il appartient et en deduire le numero de face */ int i,j,k; /* indices de boucles */ int nbfaces_par_elem; /* nombre de faces par element : 4 si dim_elem=3, 3 si dim_elem=2 */ int **elem_noeudstries; /* tableau des elements ou pour chacun les references aux noeuds sont tires par ordre croissant */ int nbnoeuds_sommets; /* nombre de noeuds sommets par element */ int min, posmin, max, posmax, posmilieu; /* pour calculer min max */ int ktrouve; /* element trouve */ int numnoeud_nonpris; /* noeud de l'element ne faisant pas partie de l'element de bord qui appartient a cet element */ int numero; printf(" Face references calculation...\n"); /* nombre de faces par element et nombre de noeuds sommets par element */ if ((*maillage).dim_elem == 3) nbfaces_par_elem = 4; else nbfaces_par_elem = 3; /* nombre de noeuds sommets par element */ nbnoeuds_sommets = nbfaces_par_elem; /* allocation du tableau des references des faces */ (*maillage).liste_reffaces = (int **) malloc (sizeof(int *) * ((*maillage).nbelem)); if ((*maillage).liste_reffaces == NULL) { printf("ERROR : allocation error for face references, needed size : %i \n", sizeof(int *) * ((*maillage).nbelem)); return 1; } for (i=0;i<(*maillage).nbelem;i++) (*maillage).liste_reffaces[i] = (int *) malloc (sizeof(int) * nbfaces_par_elem); /* verification de la derniere allocation */ if ((*maillage).liste_reffaces[(*maillage).nbelem-1] == NULL) { printf("ERROR : allocation error for face references (last allocation)\n"); return 1; } /* initialisation des references aux faces */ for (i=0;i<(*maillage).nbelem;i++) { for (j=0;j max) { max = (*maillage).liste_elembord[i][j] ; posmax=j; } if ((*maillage).liste_elembord[i][j] < min) { min = (*maillage).liste_elembord[i][j] ; posmin=j; } } switch (posmin+posmax) { case 1 : posmilieu = 2; break; case 2 : posmilieu = 1; break; case 3 : posmilieu = 0; break; default : printf("ERROR : for posmilieu = %i during face references calculation\n",posmilieu); return 1; } ktrouve = -1; /* posmin est la position du plus petit noeud dans la liste liste_elembord[i][] */ /* posmax est la position du plus grand noeud dans la liste liste_elembord[i][] */ /* posmilieu est la position du troisieme noeud dans la liste liste_elembord[i][] */ for (k=0;k<(*maillage).nbelem;k++) { if (elem_noeudstries[k][0] == (*maillage).liste_elembord[i][posmin]) { /* cet element contient le plus petit noeud de l'element de bord i */ if (elem_noeudstries[k][1] == (*maillage).liste_elembord[i][posmilieu]) { if (elem_noeudstries[k][2] == (*maillage).liste_elembord[i][posmax]) { /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1 N2 N3 N4nonpris */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][3]; exit; } else if (elem_noeudstries[k][3] == (*maillage).liste_elembord[i][posmax]) { /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1 N2 N3nonpris N4 */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][2]; exit; } } else if (( elem_noeudstries[k][2] == (*maillage).liste_elembord[i][posmilieu]) && ( elem_noeudstries[k][3] == (*maillage).liste_elembord[i][posmax])) { /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1 N2nonpris N3 N4 */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][1]; exit; } } else if ((elem_noeudstries[k][1] == (*maillage).liste_elembord[i][posmin]) && (elem_noeudstries[k][2] == (*maillage).liste_elembord[i][posmilieu]) && (elem_noeudstries[k][3] == (*maillage).liste_elembord[i][posmax])){ /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1nonpris N2 N3 N4 */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][0]; exit; } } /* deduction de la face selon format Syrthes : affectation de la couleur de l'element de bord*/ for (j=0;j face 4 */ /* numero 2 -> face 3 */ /* numero 3 -> face 2 */ /* numero 4 -> face 1 */ (*maillage).liste_reffaces[ktrouve][nbnoeuds_sommets-numero] = (*maillage).coul_elembord[i]; } } else if (nbnoeuds_sommets == 3) {/* cas triangles : posmilieu n'existe pas*/ for (i=0;i<(*maillage).nbelem_de_bord;i++) { /* soit 2 soit 3 noeuds, classement par min */ if ((*maillage).liste_elembord[i][0] > (*maillage).liste_elembord[i][1]) { posmax = 0; posmin = 1; } else { posmax = 1; posmin = 0; } ktrouve = -1; /* posmin est la position du plus petit noeud dans la liste liste_elembord[i][] */ /* posmax est la position du plus grand noeud dans la liste liste_elembord[i][] */ for (k=0;k<(*maillage).nbelem;k++) { if (elem_noeudstries[k][0] == (*maillage).liste_elembord[i][posmin]) { /* cet element contient le plus petit noeud de l'element de bord i */ if (elem_noeudstries[k][1] == (*maillage).liste_elembord[i][posmax]) { /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1 N2 N3nonpris */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][2]; exit; } else if (elem_noeudstries[k][2] == (*maillage).liste_elembord[i][posmax]) { /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1 N2nonpris N3 */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][1]; exit; } } else if ((elem_noeudstries[k][1] == (*maillage).liste_elembord[i][posmin]) && (elem_noeudstries[k][2] == (*maillage).liste_elembord[i][posmax])){ /* on a trouve l'element qui correspond a l'element de bord : noeuds tries N1nonpris N2 N3 */ ktrouve = k; numnoeud_nonpris = elem_noeudstries[k][0]; exit; } } /* deduction de l'arete selon format Syrthes : affectation de la couleur de l'element de bord*/ for (j=0;j arete 2 */ /* numero 2 -> arete 3 */ /* numero 3 -> arete 1 */ (*maillage).liste_reffaces[ktrouve][numero%3] = (*maillage).coul_elembord[i]; } } /* liberation de la memoire cas Syrthes 3.4 */ for (i=0;i<(*maillage).nbelem;i++) free(elem_noeudstries[i]); free(elem_noeudstries); return 0; } int conversion_neu(struct typ_maillage *maillage, char* nomfich) { /* lecture format Gambit Neutral, conversion au format Syrthes, ecriture au format Syrthes */ if (ouvrir_neu(maillage, nomfich) != 0) return 1; if (lire_entete_neu(maillage) != 0) return 1; if (ecrire_entete_syr(maillage) != 0) return 1; if (lire_coord_neu(maillage) != 0) return 1; if (lire_noeuds_colores_neu(maillage) != 0) return 1; if (ecrire_coord_syr(maillage) != 0) return 1; if (lire_elem_neu(maillage) != 0) return 1; if (lire_zones_neu(maillage) != 0) return 1; if (ecrire_elem_syr(maillage) != 0) return 1; if (lire_cl_neu(maillage) != 0) return 1; if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_elem_de_bord_syr(maillage) != 0) return 1; } } else { /* version Syrthes 3.4 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_reffaces_syr(maillage) != 0) return 1; } } if (fermer_neu(maillage) != 0) return 1; return 0; } int conversion_msh(struct typ_maillage *maillage, char* nomfich) { /* lecture format GMSH, conversion au format Syrthes, ecriture au format Syrthes */ if (ouvrir_msh(maillage, nomfich) != 0) return 1; if (lire_entete_msh(maillage) != 0) return 1; if (ecrire_entete_syr(maillage) != 0) return 1; if (lire_coord_msh(maillage) != 0) return 1; if (lire_noeuds_colores_msh(maillage) != 0) return 1; if (ecrire_coord_syr(maillage) != 0) return 1; if (lire_elem_msh(maillage) != 0) return 1; if (lire_zones_msh(maillage) != 0) return 1; if (ecrire_elem_syr(maillage) != 0) return 1; if (lire_cl_msh(maillage) != 0) return 1; if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_elem_de_bord_syr(maillage) != 0) return 1; } } else { /* version Syrthes 3.4 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_reffaces_syr(maillage) != 0) return 1; } } if (fermer_msh(maillage) != 0) return 1; return 0; } #ifdef MED int conversion_med(struct typ_maillage *maillage, char* nomfich, char* nomsyr) { /* lecture format MED, conversion au format Syrthes, ecriture au format Syrthes */ if (ouvrir_med(maillage, nomfich, nomsyr) != 0) return 1; if (lire_entete_med(maillage) != 0) return 1; if (ecrire_entete_syr(maillage) != 0) return 1; if (lire_coord_med(maillage) != 0) return 1; if (lire_noeuds_colores_med(maillage) != 0) return 1; if (ecrire_coord_syr(maillage) != 0) return 1; if (lire_elem_med(maillage) != 0) return 1; if (lire_zones_med(maillage) != 0) return 1; if (ecrire_elem_syr(maillage) != 0) return 1; if (lire_cl_med(maillage) != 0) return 1; if ((*maillage).version_syr == 4) { /* version Syrthes 4.0 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_elem_de_bord_syr(maillage) != 0) return 1; } } else { /* version Syrthes 3.4 */ if ( ((*maillage).dimension == 3 && (*maillage).dim_elem == 3) || ((*maillage).dimension == 2 && (*maillage).dim_elem == 2) ) { if(ecrire_reffaces_syr(maillage) != 0) return 1; } } if (fermer_med(maillage) != 0) return 1; return 0; } #endif int main(int iargc, char **iargv) { struct typ_maillage maillage; /* structure de maillage */ int extension; /* extension : 1 neu, 2 msh, 3 med */ int m; /* position de l'option -m */ int v; /* position de l'option -v */ int o; /* position de l'option -o */ int ref; /* position de l'option -ref */ int dim; /* position de l'option -dim dimension si GMSH */ int longueur; /* longueur de chaine de caracteres */ char *nom_syr; /* base du nom de fichier d'entree */ char *buffer; printf("\n***************************************************************\n"); printf(" convert2syrthes : convert mesh file to SYRTHES mesh format \n"); printf("**************************************************************\n\n"); if (iargc < 3 || iargc > 9) { printf(" convert2syrthes [-v 4] [-dim dimension] -m mesh1.ext [-o mesh2.syr] \n"); printf(" with .ext = \n"); printf(" .neu (GAMBIT format)\n"); printf(" .msh (GMSH format)\n"); printf(" .med (MED format)\n"); printf(" --> changes initial mesh file format to SYRTHES 3.4 mesh format\n"); printf("\n Additional options :\n"); printf(" -o mesh2.syr : to change the name of the file\n"); printf(" -dim 2 or -dim 3 : needed for GMSH file format, ignored in the other cases\n"); printf(" -v 4 : result will be a SYRTHES 4 mesh file format\n"); printf("\n Note :\n"); printf(" For med format, convert2syrthes creates an additionnal ASCII file (..._desc)\n"); printf(" where you will find the correspondances between group names (used in Salome)\n"); printf(" and familly (or references) numbers used in SYRTHES\n"); printf("\n Examples :\n"); printf(" convert2syrthes -m square.med --> square.syr square.syr_desc\n"); printf(" convert2syrthes -m square.neu --> square.syr\n"); printf(" convert2syrthes -m square.msh -dim 2 --> square.syr\n"); printf(" convert2syrthes -m square.med -o square2.syr --> square2.syr square2.syr_desc\n"); /* printf(" - pour ext=neu ou msh, si '-ref' est absent, les couleurs des noeuds sont ignorees\n"); */ /* printf(" si '-ref' est present, les couleurs des noeuds sont prises en compte\n"); */ return 1; } /* initialisations des entiers */ extension = 0; maillage.dimension = 0; /* dimension de l'espace 2 ou 3 */ maillage.dim_elem = 0; /* dimension des elements 1, 2 ou 3 */ maillage.nbnoeuds = 0; /* nombre de noeuds */ maillage.nbelem = 0; /* nombre d'elements */ maillage.nbnoeuds_par_elem = 0; /* nombre de noeuds par element */ maillage.nbelem_de_bord = 0; /* nombre d'elements de bord pour version Syrthes 4.0 */ maillage.numligne = 0; /* numero de ligne lue dans le maillage de lecture */ maillage.nbzones = 0; /* nombre de zones */ maillage.nbcl = 0; /* nombre de conditions limites */ maillage.fichier_ext = NULL; maillage.fichier_syr = NULL; maillage.fichier_desc = NULL; /* gestion de l'extension */ m=1; while (strcmp(iargv[m],"-m")!=0 && m 3) { if ( (iargv[m+1][longueur-4]=='.') && (iargv[m+1][longueur-3]=='n') && (iargv[m+1][longueur-2]=='e') && (iargv[m+1][longueur-1]=='u')) extension = 1; /* Gambit neutral */ else if ( (iargv[m+1][longueur-4]=='.') && (iargv[m+1][longueur-3]=='m') && (iargv[m+1][longueur-2]=='s') && (iargv[m+1][longueur-1]=='h')) extension = 2; /* GMSH */ else if ( (iargv[m+1][longueur-4]=='.') && (iargv[m+1][longueur-3]=='m') && (iargv[m+1][longueur-2]=='e') && (iargv[m+1][longueur-1]=='d')) extension = 3; /* MED */ } /* version Syrthes a ecrire */ maillage.version_syr = 3; /* 3.4 par defaut */ v=1; while (strcmp(iargv[v],"-v")!=0 && v #include #include #include "med.h" #define max(a,b) (a>b ? a:b) #define min(a,b) (a option -P1 => suppress P2 (quadratic) nodes\n"); printf(" --> option -decoupP1 => split quadratic elements in linear elements\n"); printf(" --> without option => write quadratic elements (default)\n\n"); exit(0); } else if (strcmp (s, "-P1") == 0) { na=2; maillP1=1; maillP1decoup=0; } else if (strcmp (s, "-decoupP1") == 0) { na=2; maillP1=0; maillP1decoup=1; } } /* ouverture des fichiers */ if(argc < 3) { printf ("usage : syrthes2med [-P1 | -decoupP1] syrthes_geom mesh.med \n"); printf (" syrthes2med [-P1 | -decoupP1] syrthes_geom syrthes_resu resu1.med \n"); exit(1) ; } if (argc==na+3) isResu=1; else isResu=0; if ((fsyrg=fopen(argv[na],"r")) == NULL) { printf("Unable to open file %s\n",argv[na]); exit(1) ; } if (isResu) if ((fsyrr=fopen(argv[na+1],"r")) == NULL) { printf("Unable to open file %s\n",argv[na+1]); exit(1) ; } if ((fmed=MEDouvrir(argv[na+1+isResu],MED_CREATION)) < 0) { printf("Unable to open file %s\n",argv[na+1+isResu]); exit(1) ; } printf("\n\n"); printf("===============================================================\n"); printf(" SYRTHES2MED \n"); printf(" SYRTHES --> MED INTERFACE \n"); printf("===============================================================\n"); printf("\n\nTransform SYRTHES results files to MED format\n"); /* on suppose ici que l'on a recupere l'option pour savoir si */ /* on veut un maillage P1 ou P2 */ /* maillP1=1 ==> on obtient un maillage P1 en supprimant les noeuds P2 */ /* mailldecoup=1 ==> on obtient un maillage P1 en decoupant les elements */ /* pour le moment, on force l'option */ if (maillP1==1) printf("\n--> Transfer results on a P1 mesh (linear elements) (suppress quadratic nodes)\n"); else if (maillP1decoup==1) printf("\n--> Transfer results on a P1 mesh (linear elements) (split quadratic elements in linear elements)\n"); printf("\n\nRead Syrthes geometry...\n"); entete(&ndim,&npoin,&nelem,&nbno); coord=(double*)malloc(ndim*npoin * sizeof(double)); node=(int*)malloc(nbno*nelem * sizeof(int)); nrefn=(int*)malloc(npoin * sizeof(int)); nrefe=(int*)malloc(nelem * sizeof(int)); geom_syr(ndim,npoin,nelem,nbno,node,coord,nrefn,nrefe,&npoi1); if (maillP1) { if (nbno==10) nbnoP1=4; if (nbno==6) nbnoP1=3; coordP1=(double*)malloc(ndim*npoi1 * sizeof(double)); nodeP1=(int*)malloc(nbnoP1*nelem * sizeof(int)); nrefnP1=(int*)malloc(npoi1 * sizeof(int)); quelP2=(int*)malloc(npoi1 * sizeof(int)); creeP1(npoin,nbno,nelem,coord,nrefn,node,nrefe, npoi1,nbnoP1,coordP1,nrefnP1,nodeP1, quelP2); } if (maillP1decoup) { if (ndim==2) {mult=4;nbnoP1=3;} if (ndim==3) {mult=8;nbnoP1=4;} nelemP1=nelem*mult; nodeP1=(int*)malloc(nbno*nelemP1 * sizeof(int)); nrefeP1=(int*)malloc(nelemP1 * sizeof(int)); printf("\n P1 mesh generation by splitting elements :\n"); printf(" Dimension %d\n",ndim); printf(" Number of nodes %d\n",npoin); printf(" Number of elements %d\n",nelemP1); printf(" Number of nodes per element %d\n",nbnoP1); creeP1decoup(nbno,nelem,node,nrefe, nbnoP1,nelemP1,nodeP1,nrefeP1); } printf("\nWriting MED geometry... "); if (maillP1) ecrit_geom_med(ndim,npoi1,nelem,nbnoP1,nodeP1,coordP1,nrefnP1,nrefe,npoi1); else if (maillP1decoup) ecrit_geom_med(ndim,npoin,nelemP1,nbnoP1,nodeP1,coord,nrefn,nrefeP1,npoi1); else ecrit_geom_med(ndim,npoin,nelem,nbno,node,coord,nrefn,nrefe,npoi1); printf("ok\n\n"); if(isResu) { printf("Results conversion...\n"); var=(double*)malloc(npoin * sizeof(double)); nbenr=0; while (fgets(ch,90,fsyrr)) { if ( !strncmp(ch,"*",1) ) { nbenr++; if (nbenr==1) acreer=1; else acreer=0; entete_resu_syr(&nt,&temps,&nbscal); if (nbscal!=1){nbscal=1;} for (i=0;i End of Syrthes nodes coordinates read\n"); /* connectivite maillage SYRTHES */ fgets(ch,90,fsyrg); //printf(" --- lu --- %s", ch); fgets(ch,90,fsyrg); //printf(" --- lu --- %s", ch); fgets(ch,90,fsyrg); //printf(" --- lu --- %s", ch); fgets(ch,90,fsyrg); //printf(" --- lu --- %s", ch); /* attention, on modifie la lecture pour avoir un tableau du type node(nbno,nelem) --> ceci n'est plus fait avec MED 2.1. on conserve, comme dans Syrthes, un tableau node(nelem,nbno) */ if (nbno==6) /* --- triangles 6 : NON TESTE */ for (i=0;i pour etre totalement adherent a la norme on modifie la numerotation med2.1 : 1 2 3 4 5 6 (au sens syrthes - normale vers le haut) | v 1 3 2 6 5 4 (au sens med - normale vers le bas) Attention implicitement on se retrouve en convention med 2.1 */ fscanf(fsyrg,"%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+i), (node+i+nelem*2),(node+i+nelem), (node+i+nelem*5),(node+i+nelem*4),(node+i+nelem*3)); } else /* --- tetras 10 */ for (i=0;i pour etre totalement adherent a la norme on modifie la numerotation med2.1 : 1 2 3 4 5 6 7 8 9 10 (au sens syrthes - normale interieure) | v 1 3 2 4 7 6 5 8 10 9 (au sens med - normale exterieure) Attention implicitement on se retrouve en convention med 2.1 */ fscanf(fsyrg,"%d%d%d%d%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+i), (node+i+nelem*2),(node+i+nelem), (node+i+nelem*3),(node+i+nelem*6),(node+i+nelem*5), (node+i+nelem*4),(node+i+nelem*7),(node+i+nelem*9), (node+i+nelem*8)); /* printf("%10d -- %3d -- %10d %10d %10d %10d %10d %10d %10d %10d %10d %10d\n",i,nrefe[i], */ /* node[i], node[i+nelem*2],node[i+nelem], node[i+nelem*3], */ /* node[i+nelem*6],node[i+nelem*5],node[i+nelem*4],node[i+nelem*7], */ /* node[i+nelem*9],node[i+nelem*8]); */ } printf(" --> End of Syrthes connectivity read\n"); /* compte des noeuds P1 */ np1=(int*)malloc(npoin*sizeof(int)); for (i=0;i Number of P1 nodes = %d\n",*npoi1); } /*|======================================================================| | SYRTHES 3.4 COPYRIGHT EDF 2009 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | entete_resu_syr | | read head of SYRTHES results file | |======================================================================| */ void entete_resu_syr(int *nt,double *temps,int *nbscal) { int i,n1,n2,n3,n4,n5; char ch[90],ch4[4]; char chlong[200]; double dt; /* on passe l'entete (-1 ligne deja lue avant)*/ for (i=0;i<3;i++) { fgets(chlong,200,fsyrr); //printf(" --- lu --- %s", chlong); } fscanf(fsyrr,"%s%d%d%d%d%d%d",ch4,&n1,&n2,&n3,&n4,&n5); printf("ndim=%d, ndiele=%d, nelem=%d, npoin=%d, nscal=%d\n",n1,n2,n3,n4,n5); fgets(chlong,200,fsyrr); //printf(" --- lu --- %s", chlong); fscanf(fsyrr,"%s%d%lf%lf",ch4,nt,temps,&dt); printf("timestep %d, time = %f, delta t = %f\n",*nt, *temps, dt); fgets(ch,90,fsyrr); for (i=0;i<3;i++) { fgets(ch,90,fsyrr); //printf(" --- lu --- %s", ch); } printf(" Reading timestep %d (%f seconds)\n",*nt,*temps); } /*|======================================================================| | SYRTHES 3.4 COPYRIGHT EDF 2009 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | resu_syr | | read SYRTHES results file | |======================================================================| */ void resu_syr(int npoin,double *var,char *nom_champ) { int nbl,i,j; char chlong[200]; /* on lit le nom de la variable */ fscanf(fsyrr,"%s",nom_champ); for (i=0;i<2;i++) { fgets(chlong,200,fsyrr); //printf(" --- lu --- %s", chlong); } nbl=npoin/6; for (i=0;i0) { quelP1[i]=nn; quelP2[nn]=i; /* quelP2 fournit des numeros de 0 a n-1 */ nn++; } } /* on bascule le tableau des noeuds */ for (i=0;i0) { coordP1[nn]=coord[i]; coordP1[nn+npoi1]=coord[i+npoin]; if (nbnoP1>3) coordP1[nn+npoi1*2]=coord[i+npoin*2]; nrefnP1[nn]=nrefn[i]; nn++; } } free(trav); free(quelP1); } /*|======================================================================| | SYRTHES 3.4 COPYRIGHT EDF 2009 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | creeP1 | | create the P1 mesh | |======================================================================| */ void creeP1decoup(int nbno,int nelem,int *node,int *nrefe, int nbnoP1,int nelemP1,int *nodeP1,int *nrefeP1) { int i,j,nn,np; if (nbno==6) { nn=0; for (i=0;i #include #include #define max(a,b) (a>b ? a:b) FILE *fsyrg,*fsyrr,*fgeom,*fcase,*fvar; void entete(int*,int*,int*,int*,int*,int*,int*); void geom_syr(int,int,int,int,int,int**,double**,int*,int*,int**,int*,int,int**,int*); void resu_syr_entete(int,int*,double*); void resu_syr_nomvar(char*,int*); void resu_syr_var(int,double*); void geom_ens(int,int,int,int,int,int, int**,int*,int**,double **, int,int,int, int,int**,int*,int); void ecrit_var_ensight(FILE *,int,int,int,int,int,int,double,char*,double *); void combien_scalaires(FILE *,int *,int *,int *,int *); /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | syrthes2ensight | | Transformation d'un resultat Syrthes au format Ensight | |======================================================================| */ main (argc,argv) int argc; char *argv[]; { int version; int i,lbase,n,quegeo=0,queresu=0,decoup=0; int ndim,ndiele,nelem,nbno,nbface,npoin,nt,noface,nelembord,indip1=1; int *discr,nbscal,npdt; int **node,**nodebord; int *nrefn,*nrefe,**nrefac,*nrefebord; double *temps,**coord,*var; char nomfichcase[200],nomfichgeom[200],nomfichvar[200]; char ch[90],*nomvar[90],nombase[90],nomnum[5]; int c; while ((c = getopt(argc, argv, "hgqrd")) != EOF) switch (c) { case '?': exit(0); break; case 'g': quegeo=1; break; case 'r': queresu=1; break; case 'q': indip1=0; break; case 'd': decoup=1; break; case 'h': printf("\n syrthes2ensight : utilitaire de transformation du resultat Syrthes au format Ensight\n"); printf(" Auteur : I. Rupp \n"); printf(" Usage : \n"); printf(" syrthes2ensight [-h] [-g] [-q] [-r]\n"); printf(" --> -h : mode d'emploi\n"); printf(" --> -g : geometrie seulement\n"); printf(" --> -d : decoupage des elements P2 en elements P1\n"); printf(" --> -q : conservation des elements quadratique (sinon passage en P1)\n"); printf(" --> -r : fichier resultat seulement\n"); printf(" syrthes2ensight -h : informations\n"); printf(" syrthes2ensight syr.geom syr.res fich_ensight\n"); printf(" syrthes2ensight -g syr.geom fich_ensight\n"); exit(0); break; } if (argc<4) { printf("syrthes2ensight [-h] [-g] [-d] [-q] [-r] [syr.geom] et/ou [syr.res] fich_ensight\n"); exit(0); } printf("\n\n"); printf("===============================================================\n"); printf(" SYRTHES2ENSIGHT \n"); printf("===============================================================\n"); printf(" I. Rupp\n\n"); if (quegeo) printf(" Traitement de la geometrie uniquement\n"); /* -------------------------------------------------------------------- */ /* ouverture des fichiers */ /* -------------------------------------------------------------------- */ if (quegeo) { if ((fsyrg=fopen(argv[argc-2],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[argc-2]); exit(1) ; } } else if (queresu) { if ((fsyrr=fopen(argv[argc-2],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[argc-2]); exit(1) ; } } else { if ((fsyrg=fopen(argv[argc-3],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[argc-3]); exit(1) ; } if ((fsyrr=fopen(argv[argc-2],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[argc-2]); exit(1) ; } } /* contitution des noms des fichiers geom et case */ lbase=strlen(argv[argc-1]); strcpy(nombase,argv[argc-1]); strcpy(nomfichcase,argv[argc-1]); strncat(nomfichcase,".ensight.case",13); strcpy(nomfichgeom,argv[argc-1]); strncat(nomfichgeom,".ensight.geom",13); if (!queresu) printf("--> nom du fichier geom : %s\n",nomfichgeom); printf("--> nom du fichier case : %s\n",nomfichcase); if (!queresu) if ((fgeom=fopen(nomfichgeom,"w")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",nomfichgeom); exit(1) ; } if ((fcase=fopen(nomfichcase,"w")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",nomfichcase); exit(1) ; } /* -------------------------------------------------------------------- */ /* traitement de la geometrie */ /* -------------------------------------------------------------------- */ if (!queresu) { /* lecture de la geometrie Syrthes */ entete(&ndim,&ndiele,&npoin,&nelem,&nbno,&nelembord,&version); coord=(double**)malloc(ndim * sizeof(double*)); for (n=0;n nombre de variables par pas de temps = %d\n\n",*nbscal); } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | resu_syr | | lecture des resultats Syrthes | |======================================================================| */ void resu_syr_entete(int version,int *nt,double *temps) { int i; char ch[90],chrien[20],chlong[200]; /* on passe l'entete (-1 ligne deja lue avant pour voir s'il reste un pas de temps a lire) */ if (version==40) { fgets(ch,120,fsyrr); fgets(ch,120,fsyrr); fgets(ch,120,fsyrr); fgets(ch,120,fsyrr); fscanf(fsyrr,"%s%s%s%d%s%s%s%lf\n",chrien,chrien,chrien,nt,chrien,chrien,chrien,temps); fgets(ch,90,fsyrr); fgets(ch,90,fsyrr); } else { /* on passe l'entete (-1 ligne deja lue avant)*/ for (i=0;i<5;i++) fgets(chlong,200,fsyrr); fscanf(fsyrr,"%s%d%lf",ch,nt,temps);fgets(ch,90,fsyrr); for (i=0;i<3;i++) fgets(ch,90,fsyrr); } printf(" Traitement du pas de temps %d (%f secondes)\n",*nt,*temps); } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | resu_syr | | lecture des resultats Syrthes | |======================================================================| */ void resu_syr_var(int npoin,double *var) { int nbl,i,j; nbl=npoin/6; for (i=0;i lecture de la variable %s (localisation %d)\n",nomvar,*discr); } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | geom_ens | | eciture de la geometrie au format Ensight | |======================================================================| */ void geom_ens(int ndim,int ndiele,int npoin,int nelem,int nbno,int nbface, int **node,int *nrefe,int **nrefac,double **coord, int noface,int indip1,int decoup, int nelembord,int **nodebord,int *nrefebord,int version) { int i,j,n,nelemd,nbsselt,numpart; int nare[2][3], nfac[3][4]; int *iref; nare[0][0]=0; nare[1][0]=1; nare[0][1]=1; nare[1][1]=2; nare[0][2]=2; nare[1][2]=0; nfac[0][0]=0; nfac[1][0]=1; nfac[2][0]=2; nfac[0][1]=0; nfac[1][1]=1; nfac[2][1]=3; nfac[0][2]=0; nfac[1][2]=2; nfac[2][2]=3; nfac[0][3]=1; nfac[1][3]=2; nfac[2][3]=3; /* ecriture des coorodonnees */ fprintf(fgeom,"CALCUL SYRTHES\n"); fprintf(fgeom,"conduction/rayonnement thermique\n"); fprintf(fgeom,"node id given\n"); fprintf(fgeom,"element id given\n"); printf("\n Ecriture des %d noeuds au format Ensight\n",npoin); fprintf(fgeom,"coordinates \n%8d\n",npoin); if (ndim==2) for (n=0;n0) iref[nrefe[n]]++; /* prise en compte du decoupage eventuel */ if (ndiele==1) nbsselt=2; else if (ndiele==2) nbsselt=4; else if (ndiele==3) nbsselt=8; if (!decoup) nbsselt=1; for (n=0;n<100;n++) iref[n]*=nbsselt; for (n=0;n<100;n++) if (iref[n]>0) if (!decoup) printf(" Nombre d'elements de sous-domaine %2d = %8d\n",n,iref[n]); else printf(" Nombre d'elements (decoupes) de sous-domaine %2d = %8d\n",n,iref[n]); for (i=0;i<100;i++) if (iref[i]>0) { if (ndiele==1) { numpart++; fprintf(fgeom,"part %8d\n Sous-domaine %3d\nbar2\n%8d\n",numpart,i,iref[i]); for (n=0;n0) iref[nrefac[j][n]]++; for (i=0;i<100;i++) if (iref[i]>0) { printf(" Nombre de faces de reference %2d = %8d\n",i,iref[i]); if (ndiele==2) { numpart++; fprintf(fgeom,"part %8d\n Reference %3d\nbar2\n%8d\n",numpart,i,iref[i]); for (n=0;n0) iref[nrefebord[n]]++; for (n=0;n<100;n++) if (iref[n]>0) if (!decoup) printf(" Nombre d'elements de bord de reference %2d = %8d\n",n,iref[n]); for (i=0;i<100;i++) if (iref[i]>0) { if (ndiele==2) /* alors elements de bord sont des poutres */ { numpart++; fprintf(fgeom,"part %8d\n Reference %3d\nbar2\n%8d\n",numpart,i,iref[i]); for (n=0;n #include #include #include "med.h" #define max(a,b) (a>b ? a:b) #define min(a,b) (a option -P1 => suppression des noeuds P2 \n"); printf(" --> option -decoupP1 => decoupage du maillage en elements P1 (defaut)\n\n"); exit(0); } else if (strcmp (s, "-P1") == 0) { maillP1=1; maillP1decoup=0; } else if (strcmp (s, "-decoupP1") == 0) { maillP1=0; maillP1decoup=1; } } /* ouverture des fichiers */ if(argc < 4) { printf ("usage : syrthes2med [-P1] [-decoupP1] syrthes_geom syrthes_resu resu1.med \n"); exit(1) ; } if (argc==4) na=1; else na=2; if ((fsyrg=fopen(argv[na],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[1]); exit(1) ; } if ((fsyrr=fopen(argv[na+1],"r")) == NULL) { printf("Impossible d'ouvrir le fichier %s\n",argv[2]); exit(1) ; } if ((fmed=MEDouvrir(argv[na+2],MED_CREATION)) < 0) { printf("Impossible d'ouvrir le fichier %s\n",argv[3]); exit(1) ; } printf("\n\n"); printf("===============================================================\n"); printf(" SYRTHES2MED \n"); printf(" INTERFACE SYRTHES --> MED \n"); printf("===============================================================\n"); printf(" I. Rupp\n\n"); printf("\n\nTransformation des resultats issus de Syrthes au format MED\n"); /* on suppose ici que l'on a recupere l'option pour savoir si */ /* on veut un maillage P1 ou P2 */ /* maillP1=1 ==> on obtient un maillage P1 en supprimant les noeuds P2 */ /* mailldecoup=1 ==> on obtient un maillage P1 en decoupant les elements */ /* pour le moment, on force l'option */ if (maillP1==1) printf("\n--> Transfert des resultats sur un maillage P1 (elimination des noeuds P2)\n"); else if (maillP1decoup==1) printf("\n--> Transfert des resultats sur un maillage P1 par redecoupage des elements P2\n"); printf("\n\nLecture de la geometrie Syrthes...\n"); entete(&ndim,&npoin,&nelem,&nbno); coord=(double*)malloc(ndim*npoin * sizeof(double)); node=(int*)malloc(nbno*nelem * sizeof(int)); nrefn=(int*)malloc(npoin * sizeof(int)); nrefe=(int*)malloc(nelem * sizeof(int)); geom_syr(ndim,npoin,nelem,nbno,node,coord,nrefn,nrefe,&npoi1); if (maillP1) { if (nbno==10) nbnoP1=4; if (nbno==6) nbnoP1=3; coordP1=(double*)malloc(ndim*npoi1 * sizeof(double)); nodeP1=(int*)malloc(nbnoP1*nelem * sizeof(int)); nrefnP1=(int*)malloc(npoi1 * sizeof(int)); quelP2=(int*)malloc(npoi1 * sizeof(int)); creeP1(npoin,nbno,nelem,coord,nrefn,node,nrefe, npoi1,nbnoP1,coordP1,nrefnP1,nodeP1, quelP2); } if (maillP1decoup) { if (ndim==2) {mult=4;nbnoP1=3;} if (ndim==3) {mult=8;nbnoP1=4;} nelemP1=nelem*mult; nodeP1=(int*)malloc(nbno*nelemP1 * sizeof(int)); nrefeP1=(int*)malloc(nelemP1 * sizeof(int)); printf("\n Generation d'un maillage P1 par redecoupage :\n"); printf(" Dimension %d\n",ndim); printf(" Nombre de noeuds %d\n",npoin); printf(" Nombre d'elements %d\n",nelemP1); printf(" Nombre de noeuds par element %d\n",nbnoP1); creeP1decoup(nbno,nelem,node,nrefe, nbnoP1,nelemP1,nodeP1,nrefeP1); } printf("\nEcriture geometrie MED... "); if (maillP1) ecrit_geom_med(ndim,npoi1,nelem,nbnoP1,nodeP1,coordP1,nrefnP1,nrefe,npoi1); else if (maillP1decoup) ecrit_geom_med(ndim,npoin,nelemP1,nbnoP1,nodeP1,coord,nrefn,nrefeP1,npoi1); else ecrit_geom_med(ndim,npoin,nelem,nbno,node,coord,nrefn,nrefe,npoi1); printf("ok\n\n"); printf("Traitement des champs resultats...\n"); var=(double*)malloc(npoin * sizeof(double)); nbenr=0; while (fgets(ch,90,fsyrr)) { if ( !strncmp(ch,"*",1) ) { nbenr++; if (nbenr==1) acreer=1; else acreer=0; entete_resu_syr(&nt,&temps,&nbscal); if (nbscal!=1){nbscal=1;} for (i=0;i Fin de la lecture des coordonnees des noeuds Syrthes\n"); /* connectivite maillage SYRTHES */ fgets(ch,90,fsyrg); fgets(ch,90,fsyrg); fgets(ch,90,fsyrg); fgets(ch,90,fsyrg); /* attention, on modifie la lecture pour avoir un tableau du type node(nbno,nelem) --> ceci n'est plus fait avec MED 2.1. on conserve, comme dans Syrthes, un tableau node(nelem,nbno) */ if (nbno==6) for (i=0;i pour etre totalement adherent a la norme on modifie la numerotation med2.1 : 1 2 3 4 5 6 (au sens syrthes - normale vers le haut) | v 1 3 2 6 5 4 (au sens med - normale vers le bas) Attention implicitement on se retrouve en convention med 2.1 */ /* fscanf(fsyrg,"%7d%3d%7d%7d%7d%7d%7d%7d",&n,(nrefe+i), */ /* (node+i),(node+i+nelem*2),(node+i+nelem), */ /* (node+i+nelem*5),(node+i+nelem*4),(node+i+nelem*3)); */ /* on,lit une chaine dans le cas ou le maillage depasse 1e6 noeuds */ /* les nombres se retrouvent colles */ fgets(ch,90,fsyrg); strncpy(ch02,ch+7,3); nrefe[i]=atoi(ch02); strncpy(ch1,ch+10,7);ch1[7]='\0';node[i]=atoi(ch1); strncpy(ch2,ch+17,7);ch2[7]='\0';node[i+nelem*2]=atoi(ch2); strncpy(ch3,ch+24,7);ch3[7]='\0';node[i+nelem]=atoi(ch3); strncpy(ch4,ch+31,7);ch4[7]='\0';node[i+nelem*5]=atoi(ch4); strncpy(ch5,ch+31,7);ch5[7]='\0';node[i+nelem*4]=atoi(ch4); strncpy(ch6,ch+38,7);ch6[7]='\0';node[i+nelem*3]=atoi(ch5); /* ancienne numerotation med 2.1 fscanf(fsyrg,"%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+i),(node+i+nelem),(node+i+nelem*2), (node+i+nelem*3),(node+i+nelem*4),(node+i+nelem*5)); */ /* ancienne version pour MED 2.0 { j=i*6; fscanf(fsyrg,"%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+j),(node+j+1),(node+j+2),(node+j+3),(node+j+4),(node+j+5)); } */ } else for (i=0;i pour etre totalement adherent a la norme on modifie la numerotation med2.1 : 1 2 3 4 5 6 7 8 9 10 (au sens syrthes - normale interieure) | v 1 3 2 4 7 6 5 8 10 9 (au sens med - normale exterieure) Attention implicitement on se retrouve en convention med 2.1 */ { /* fscanf(fsyrg,"%7ld%3ld%7ld%7ld%7ld%7ld%7ld%7ld%7ld%7ld%7ld%7ld",&n,(nrefe+i), */ /* (node+i),(node+i+nelem*2),(node+i+nelem), */ /* (node+i+nelem*3),(node+i+nelem*6),(node+i+nelem*5), */ /* (node+i+nelem*4),(node+i+nelem*7),(node+i+nelem*9), */ /* (node+i+nelem*8)); */ /* on,lit une chaine dans le cas ou le maillage depasse 1e6 noeuds */ /* les nombres se retrouvent colles */ fgets(ch,90,fsyrg); strncpy(ch02,ch+7,3); nrefe[i]=atoi(ch02); strncpy(ch1,ch+10,7);ch1[7]='\0';node[i]=atoi(ch1); strncpy(ch2,ch+17,7);ch2[7]='\0';node[i+nelem*2]=atoi(ch2); strncpy(ch3,ch+24,7);ch3[7]='\0';node[i+nelem]=atoi(ch3); strncpy(ch4,ch+31,7);ch4[7]='\0';node[i+nelem*3]=atoi(ch4); strncpy(ch5,ch+38,7);ch5[7]='\0';node[i+nelem*6]=atoi(ch5); strncpy(ch6,ch+45,7);ch6[7]='\0';node[i+nelem*5]=atoi(ch6); strncpy(ch7,ch+52,7);ch7[7]='\0';node[i+nelem*4]=atoi(ch7); strncpy(ch8,ch+59,7);ch8[7]='\0';node[i+nelem*7]=atoi(ch8); strncpy(ch9,ch+66,7);ch9[7]='\0';node[i+nelem*9]=atoi(ch9); strncpy(ch10,ch+73,7);ch10[7]='\0';node[i+nelem*8]=atoi(ch10); /* printf("%10d -- %3d -- %10d=%10d=%10d=%10d=%10d=%10d=%10d=%10d%10d%10d\n",i,nrefe[i], */ /* node[i],node[i+nelem*2],node[i+nelem],node[i+nelem*3], */ /* node[i+nelem*6],node[i+nelem*5],node[i+nelem*4],node[i+nelem*7], */ /* node[i+nelem*9],node[i+nelem*8]); */ } /* ancienne numerotation pour MED2.1 fscanf(fsyrg,"%d%d%d%d%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+i),(node+i+nelem),(node+i+nelem*2), (node+i+nelem*3),(node+i+nelem*4),(node+i+nelem*5), (node+i+nelem*6),(node+i+nelem*7),(node+i+nelem*8), (node+i+nelem*9)); */ /* ancienne version pour MED 2.0 { j=i*10; fscanf(fsyrg,"%d%d%d%d%d%d%d%d%d%d%d%d",&n,(nrefe+i), (node+j),(node+j+1),(node+j+2),(node+j+3),(node+j+4),(node+j+5), (node+j+6),(node+j+7),(node+j+8),(node+j+9)); } */ printf(" --> Fin de la lecture de la connectivite Syrthes\n"); /* compte des noeuds P1 */ /* np1=(int*)malloc(npoin*sizeof(int)); */ /* for (i=0;i Pour information, nombre de noeuds P1 = %d\n",*npoi1); */ } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | entete_resu_syr | | lecture des resultats Syrthes | |======================================================================| */ void entete_resu_syr(int *nt,double *temps,int *nbscal) { int i,n1,n2,n3,n4,n5; char ch[90]; char chlong[200]; /* on passe l'entete (-1 ligne deja lue avant)*/ for (i=0;i<3;i++) fgets(chlong,200,fsyrr); fscanf(fsyrr,"%s%d%d%d%d%d%d",ch,&n1,&n2,&n3,&n4,&n5,nbscal); fgets(chlong,200,fsyrr);fgets(chlong,200,fsyrr); fscanf(fsyrr,"%s%d%lf",ch,nt,temps);fgets(ch,90,fsyrr); for (i=0;i<3;i++) fgets(ch,90,fsyrr); printf(" Lecture du pas de temps %d (%f secondes)\n",*nt,*temps); } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | resu_syr | | lecture des resultats Syrthes | |======================================================================| */ void resu_syr(int npoin,double *var,char *nom_champ) { int nbl,i,j; char chlong[200]; /* on lit le nom de la variable */ fscanf(fsyrr,"%s",nom_champ); for (i=0;i<2;i++) fgets(chlong,200,fsyrr); nbl=npoin/6; for (i=0;i0) { quelP1[i]=nn; quelP2[nn]=i; /* quelP2 fournit des numeros de 0 a n-1 */ nn++; } } /* on bascule le tableau des noeuds */ for (i=0;i0) { coordP1[nn]=coord[i]; coordP1[nn+npoi1]=coord[i+npoin]; if (nbnoP1>3) coordP1[nn+npoi1*2]=coord[i+npoin*2]; nrefnP1[nn]=nrefn[i]; nn++; } } free(trav); free(quelP1); } /*|======================================================================| | SYRTHES - Utilitaires JUIL 95 | |======================================================================| | AUTEURS : I. RUPP | |======================================================================| | creeP1 | | extraction du maillage P1 | |======================================================================| */ void creeP1decoup(int nbno,int nelem,int *node,int *nrefe, int nbnoP1,int nelemP1,int *nodeP1,int *nrefeP1) { int i,j,nn,np; if (nbno==6) { nn=0; for (i=0;i X = MY * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! OP ! A ! D ! DEFINITION DU TYPE D'OPERATION ! C ! NODES ! TE ! D ! NUMERO DES NOEUDS ( LOCALE --> GLOBALE ) ! C ! X ! TR ! R ! VECTEUR RESULTAT ! C ! DMAT ! TR ! D ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! D ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! Y ! TR ! D ! VECTEUR A MUTIPLIER PAR LA MATRICE M ! C ! C ! R ! D ! CONSTANTE ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL (NELEMS*NDMATS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : GRCONJ, C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NCOEMA,NELEPR,NBPRIO,NBCOPR,NDIELE CHARACTER*8 OP DOUBLE PRECISION DMAT(NPOINS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION X(NPOINS),Y(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS) INTEGER NODEPR(NELEPR,NDMATS+1),NPRIOS(NBPRIO,1+NBCOPR) C C..Variables locales DOUBLE PRECISION C DOUBLE PRECISION Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10 DOUBLE PRECISION XM14,XM16,XM24,XM25,XM35,XM36,XM45,XM46,XM56 DOUBLE PRECISION XM15,XM17,XM18,XM26,XM29,XM37,XM310 DOUBLE PRECISION XM48,XM49,XM410,XM57,XM58,XM59 DOUBLE PRECISION XM67,XM68,XM69,XM610,XM78,XM710 DOUBLE PRECISION XM89,XM810,XM910 C C pour le traitement periodique INTEGER I,J,K,NELG,NGC,NELLOG,NLC,NL C C*********************************************************************** C C 1- CAS BIDIMENSIONNEL (triangle) C ================================ IF ( NDIELE .EQ. 2 ) THEN C C 1.1 CAS X = M Y C ------------- C IF ( OP(1:8).EQ.'X=MY ') THEN C C DO 110 I=1,NPOINS X(I) = DMAT(I)*Y(I) 110 CONTINUE C C DO 120 I=1,NELEMS C Y1 = Y(NODES(I,1)) Y2 = Y(NODES(I,2)) Y3 = Y(NODES(I,3)) Y4 = Y(NODES(I,4)) Y5 = Y(NODES(I,5)) Y6 = Y(NODES(I,6)) C XM14 = XMAT(I,1) XM16 = XMAT(I,2) XM24 = XMAT(I,3) XM25 = XMAT(I,4) XM35 = XMAT(I,5) XM36 = XMAT(I,6) XM45 = XMAT(I,7) XM46 = XMAT(I,8) XM56 = XMAT(I,9) C WCT(I,1) = XM14 * Y4 + XM16 * Y6 WCT(I,2) = XM24 * Y4 + XM25 * Y5 WCT(I,3) = XM35 * Y5 + XM36 * Y6 WCT(I,4) = XM14 * Y1 + XM24 * Y2 + XM45 * Y5 + XM46 * Y6 WCT(I,5) = XM25 * Y2 + XM35 * Y3 + XM45 * Y4 + XM56 * Y6 WCT(I,6) = XM16 * Y1 + XM36 * Y3 + XM46 * Y4 + XM56 * Y5 C 120 CONTINUE C C Assemblage du resultat dans le tableau X CALL ASSEMB ( X,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C C C Fin du cas X = MY ENDIF C C 2. CAS TRIDIMENSIONNEL (tetraedre) C ================================== ELSE C C C 2.1 CAS X = M Y C ------------- C IF ( OP(1:8).EQ.'X=MY ') THEN C C DO 210 I=1,NPOINS X(I) = DMAT(I)*Y(I) 210 CONTINUE C C DO 220 I=1,NELEMS C Y1 = Y(NODES(I,1)) Y2 = Y(NODES(I,2)) Y3 = Y(NODES(I,3)) Y4 = Y(NODES(I,4)) Y5 = Y(NODES(I,5)) Y6 = Y(NODES(I,6)) Y7 = Y(NODES(I,7)) Y8 = Y(NODES(I,8)) Y9 = Y(NODES(I,9)) Y10 = Y(NODES(I,10)) C XM15 = XMAT(I,1) XM17 = XMAT(I,2) XM18 = XMAT(I,3) XM25 = XMAT(I,4) XM26 = XMAT(I,5) XM29 = XMAT(I,6) XM36 = XMAT(I,7) XM37 = XMAT(I,8) XM310 = XMAT(I,9) XM48 = XMAT(I,10) XM49 = XMAT(I,11) XM410 = XMAT(I,12) XM56 = XMAT(I,13) XM57 = XMAT(I,14) XM58 = XMAT(I,15) XM59 = XMAT(I,16) XM67 = XMAT(I,17) XM68 = XMAT(I,18) XM69 = XMAT(I,19) XM610 = XMAT(I,20) XM78 = XMAT(I,21) XM710 = XMAT(I,22) XM89 = XMAT(I,23) XM810 = XMAT(I,24) XM910 = XMAT(I,25) C WCT(I,1) = XM15 * Y5 + XM17 * Y7 + XM18 * Y8 WCT(I,2) = XM25 * Y5 + XM26 * Y6 + XM29 * Y9 WCT(I,3) = XM36 * Y6 + XM37 * Y7 + XM310 * Y10 WCT(I,4) = XM48 * Y8 + XM49 * Y9 + XM410 * Y10 WCT(I,5) = XM15 * Y1 + XM25 * Y2 + XM56 * Y6 + XM57 * Y7 & +XM58 * Y8 + XM59 * Y9 WCT(I,6) = XM26 * Y2 + XM36 * Y3 + XM56 * Y5 + XM67 * Y7 & +XM68 * Y8 + XM69 * Y9 + XM610 * Y10 WCT(I,7) = XM17 * Y1 + XM37 * Y3 + XM57 * Y5 + XM67 * Y6 & +XM78 * Y8 + XM710 * Y10 WCT(I,8) = XM18 * Y1 + XM48 * Y4 + XM58 * Y5 + XM68 * Y6 & +XM78 * Y7 + XM89 * Y9 + XM810 * Y10 WCT(I,9) = XM29 * Y2 + XM49 * Y4 + XM59 * Y5 + XM69 * Y6 & +XM89 * Y8 + XM910 * Y10 WCT(I,10) = XM310 * Y3 + XM410 * Y4 + XM610 * Y6 & +XM710 * Y7 + XM810 * Y8 + XM910 * Y9 220 CONTINUE C C Assemblage du resultat dans le tableau X CALL ASSEMB ( X,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C C C Fin du cas 3D X = MY ENDIF C C Fin du cas 3D ENDIF C C 3.- TRAITEMENT DES NOEUDS PERIODIQUES C ===================================== C IF (NBPRIO .GT. 0) THEN C NELLOG = NDMATS + 1 C DO 300 K=1,NBCOPR DO 310 J=1,NDMATS DO 320 I=1,NELEPR NELG = NODEPR(I,NELLOG) NL = NODEPR(I,J) IF (NL .GT. 0) THEN NLC = NPRIOS(NL,K+1) IF (NLC .GT. 0) THEN NGC = NPRIOS(NLC,1) X(NGC) = X(NGC) + WCT(NELG,J) ENDIF ENDIF 320 CONTINUE 310 CONTINUE 300 CONTINUE C ENDIF C C END syrthes-3.4.3-dfsg1/src/s/chform.F0000666000175000017500000001505111524070641015330 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CHFORM,SSI=0 C SUBROUTINE CHFORM C ***************** C * (CTYP,CH,LCH,NB,FORMA) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C C********************************************************************** C C..Variables externes CHARACTER*1 CTYP CHARACTER CH*(*),FORMA*(*) INTEGER NB,LCH C C..Variables internes INTEGER IDEB,IFIN,NBB,LC,I1,N,ILF,ILONF,NBCHI,I INTEGER NBCHI1,NBCHI2 CHARACTER FF*80,CLC*3,CLC1*3,CLC2*3 C CHARACTER CNBRE*80,CF*1 INTEGER IPOINT,IFDECI,LDECI LOGICAL FORMAE C C********************************************************************** C C 0- INITIALISATIONS C ================== FORMA = '(' ILONF = 1 I1 = 1 C C 1- CAS DU DECRYPTAGE D'ENTIERS C ============================== C IF (CTYP.EQ.'I') THEN C C DO 100 N=1,NB C CALL POSNBR (CH(I1:),IDEB,IFIN,NBB,LC) FF = ' ' NBCHI = 3 - INT ( LOG10 (DBLE(LC)) ) WRITE ( CLC,'(I3)' ) LC IF (NBB.EQ.0) THEN WRITE(FF(1:),1000) CLC(NBCHI:3) ILF = 3-NBCHI+1 + 1 ELSE WRITE(FF(1:),1001) NBB,CLC(NBCHI:3) ILF = 3-NBCHI+1 + 1 + 4 ENDIF C IF (N.EQ.1) THEN FORMA = FORMA(1:ILONF)//FF(1:ILF) ILONF = ILONF+ILF ELSE FORMA = FORMA(1:ILONF)//','//FF(1:ILF) ILONF = ILONF+ILF + 1 ENDIF C I1 = I1 + IFIN C 100 CONTINUE C FORMA = FORMA(1:ILONF)//')' C C C C 2- CAS DU DECRYPTAGE DE REELS C ============================= ELSEIF (CTYP.EQ.'R') THEN C DO 200 N=1,NB C CALL POSNBR (CH(I1:),IDEB,IFIN,NBB,LC) CNBRE(1:LC) = CH(I1+IDEB-1:I1+IFIN-1) C FORMAE = .FALSE. IPOINT = LC IFDECI = LC C DO 210 I=1,LC IF (CNBRE(I:I).EQ.'.') THEN IPOINT = I ELSE IF (CNBRE(I:I).EQ.'E') THEN FORMAE = .TRUE. IFDECI = I-1 ENDIF 210 CONTINUE C IF (FORMAE) THEN CF = 'E' ELSE CF = 'F' ENDIF C NBCHI1 = 3 - INT ( LOG10 (DBLE(LC)) ) WRITE ( CLC1,'(I3)' ) LC C LDECI = IFDECI - IPOINT NBCHI2 = 3 IF (LDECI.GT.0) NBCHI2 = 3 - INT ( LOG10 (DBLE(LDECI)) ) WRITE ( CLC2,'(I3)' ) LDECI C IF (NBB.EQ.0) THEN WRITE(FF(1:),2000) CF,CLC1(NBCHI1:3),CLC2(NBCHI2:3) ILF = 3-NBCHI1+1 + 3-NBCHI2+1 +2 ELSE WRITE(FF(1:),2001) NBB,CF,CLC1(NBCHI1:3),CLC2(NBCHI2:3) ILF = 3-NBCHI1+1 +3-NBCHI2+1 +2 + 4 ENDIF C IF (N.EQ.1) THEN FORMA = FORMA(1:ILONF)//FF(1:ILF) ILONF = ILONF+ILF ELSE FORMA = FORMA(1:ILONF)//','//FF(1:ILF) ILONF = ILONF+ILF + 1 ENDIF C I1 = I1 + IFIN C 200 CONTINUE C FORMA = FORMA(1:ILONF)//')' C ENDIF C--------- C FORMATS C--------- 1000 FORMAT ('I',A) 1001 FORMAT (I2,'X,I',A) 2000 FORMAT (A1,A,'.',A) 2001 FORMAT (I2,'X,',A1,A,'.',A) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/cphyso.F0000666000175000017500000004176511524070641015372 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CPHYSO C ***************** C C --------------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,PHYSOL,NPOUE,NPPEL,NBPHYS,VOLUME) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DES CARACTERISTIQUES PHYSIQUES DU SOLIDE * C RHO(x,y,z,t,T), CP(x,y,z,t,T), K(x,y,z,t,T) * C + invariant de Gauss et epaisseur pour le modele coque * C * C Dans la version 3.0 de SYRTHES, il est possible de definir * C les caracteristiques soit par noeud soit par element soit * C par noeud pour un element. Parmi les trois choix suivant, * C un seul doit etre retenu et en coherence avec l'option prise * C dans le fichier des mots-cles. * C Pour plus de clarte, on engage meme les utilisateurs a * C supprimer les lignes non utiles dans leur cas. * C * C Attention : toute variable utilisee doit etre declaree * C ========= * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! PHYSOL ! TR ! R ! CARACTERISTIQUES PHYSIQUES DU SOLIDE ! C ! NPOUE ! E ! D ! NOMBRE DE NOEUDS OU D'ELTS ! C ! NPPEL ! E ! D ! NOMBRE DE NOEUD PAR ELEMENTS ! C ! VOLUME ! E ! D ! VOLUME DE CHAQUE ELEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /TEMPS / ! ! D ! ! C ! /OPTCT / ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "syrthu.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBPHYS,NPOUE,NPPEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS),VOLUME(NELEMS) C C.. Variables internes INTEGER I,J,K,N,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2,TT C C*********************************************************************** C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C -------------------------------------------------- C 2- INTERVENTION UTILISATEUR POUR LE MODELE GENERAL C -------------------------------------------------- C Les conditions physiques peuvent etre fonction C de l'espace (COORDS(...,1),COORDS(...,2),COORDS(...,3)), C du temps (TEMPS) et de la temperature TMPS(...) C On donne : C Si la conductivite est isotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k C Si la conductivite est orthotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x | 3 | C - PHYSOL(.,.,4) : conductivite k suivant y | 4 | C - PHYSOL(.,.,5) : conductivite k suivant z | 5 | C Si la conductivite est anisotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x C - PHYSOL(.,.,4) : conductivite k suivant y | 3 6 7 | C - PHYSOL(.,.,5) : conductivite k suivant z | 4 8 | C - PHYSOL(.,.,6) : conductivite k suivant xy | 5 | C - PHYSOL(.,.,7) : conductivite k suivant xz C - PHYSOL(.,.,8) : conductivite k suivant yz C C Temps reel courant sur le solide CUTI T = TEMPSS C C ===================================================== C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== CUTI IF(NDPROP .NE. 1) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque point solide CUTI DO N=1,NPOINS C C References du point courant CUTI NUMREF = NREFS(N) C C Coordonnees du point courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Temperature du noeud CUTI TT = TMPS(N) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C ===================================================== C FIN POUR LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 2) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero des noeuds de l'element ( 6 en 2D, 10 en 3D) CUTI point 1 a 6 CUTI N1 = NODES(N,1) CUTI N2 = NODES(N,2) CUTI N3 = NODES(N,3) CUTI N4 = NODES(N,4) CUTI N5 = NODES(N,5) CUTI N6 = NODES(N,6) C CUTI IF (NDIM .EQ. 3) THEN CUTI N7 = NODES(N,7) CUTI N8 = NODES(N,8) CUTI N9 = NODES(N,9) CUTI N10= NODES(N,10) CUTI ENDIF C C Coordonnees des points de l'element courant C Pour le noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Pour le noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc C C Temperature des noeuds de l'element CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C C ======================================================= C FIN DES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= C C C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 3) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque noeud de l'element CUTI DO J=1,NDMATS C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero global du noeud CUTI N1 = NODES(N,J) C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT = TMPS(N1) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,J,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI PHYSOL(N,J,6) = CUTI PHYSOL(N,J,7) = CUTI PHYSOL(N,J,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO CUTI ENDDO C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= C C C C*********************************************************************** C 1000 FORMAT(' CPHYSO : ATTENTION LE CHOIX EST CONTRADICTOIRE AVEC',/, & 'CELUI RETENU DANS LES MOTS-CLES') C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/iniso1.F0000666000175000017500000002512211524070641015254 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- C ***************** SUBROUTINE INISO1 C ***************** C C ------------------------------------------------------------- *(NDIM,NPOINS,NELEMS,NFBIDA,NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL, NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS,NBCOPR, * NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NPPEL,NPOUE,NBICOR, * NBFFLU,NBFECH,NBFRAI,NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C INITIALISATIONS POUR LA PRISE EN COMPTE DU COUPLAGE C THERMIQUE FLUIDE/SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MOTCLE ! E ! D ! TYPE DE COUPLAGE CHOISI ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NPOINS ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NELEUS ! E ! R ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELEPR ! E ! R ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NBCOUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NELERA ! E ! R ! NBRE D'ELTS DU MAIL SURF SOLIDE AVEC RAYONNT ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBFLVS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C ! NBRESS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBRAIS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT INF! C ! NBFRAI ! E ! R ! NOMBRE DE FACES SOLIDES AVEC RAYONNEMENT INF ! C ! NBPRIO ! E ! R ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! R ! NOMBRE DE NOEUDS SOLIDES EN MOUVEMENT ! C ! NBCOPR ! E ! R ! NBRE DE CORRESPONDANTS POUR LES NOEUDS PERIOD! C ! NDIELE ! E ! R ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NDMATS ! E ! R ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NDMASS ! E ! R ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NBFACE ! E ! R ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NCOEMA ! E ! R ! NOMBRE DE COEF EXTRA DIAG DES MATRICES ELEM ! C ! NBPHYS ! E ! R ! NOMBRE DE VARIABLES PHYSIQUES SUR LE SOLIDE ! C ! NBICOR ! E ! R ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NPOINR ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! R ! NOMBRE D'ELEMENTS DU MAILLAGE RAYONNEMENT ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! R ! ! C ! /OPTCT/ ! ! R ! ! C ! /FICHCT/ ! ! R ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : IFICCT,INOMCT,OPENCT,LECMCL,EVADIM C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "fichct.h" #include "syrth.h" #include "bilan.h" C C ********************************************************************** C C C.. Variables externes INTEGER NDIM,NDIELE,NBCOPR,NBFRAI,NBFACE INTEGER NPOINS,NELEMS,NELEPR,NELESS,NELEUS,NELERC,NELERA INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL INTEGER NBRESS,NBRAYS,NBPRIO INTEGER NBMOBS,NBRAIS INTEGER NDMATS,NDMASS,NCOEMA,NBPHYS,NPPEL,NPOUE,NBICOR INTEGER NBFFLU,NBFECH INTEGER NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE C C.. Variables internes INTEGER NFBIDA C C*********************************************************************** C -1- INITIALISATIONS C =================== CALL TOUTA0 (NPOINS,NELEMS,NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS,NBCOPR, * NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NBICOR, * NBFFLU,NBFECH,NBFRAI,NPOINR, * NELRAY,NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C C 1- NUMEROS LOGIQUES DES FICHIERS C ================================ CALL IFICCT C C C 2- NOMS DES FICHIERS C ==================== CALL INOMCT C C 3- OUVERTURES DES FICHIERS OBLIGATOIRES POUR LE COUPLAGE THERMIQUE C ================================================================== CALL OPENCT('OBLIG') C 4- VERIFICATION OTHOGRAPHIQUE DU FICHIER DE DONNEES C =================================================== CALL DICOCT C C 5- LECTURE DES MOTS-CLES DU COUPLAGE THERMIQUE C ============================================== CALL LECMCL(NDIM) C IF (LRAY) THEN CALL OPENCT('RAYOB') CALL DICORA CALL LECMCR ENDIF C C 6- OUVERTURE DES FICHIERS OPTIONNELS C ==================================== CALL OPENCT('AUTRE') IF (LRAY) CALL OPENCT('RAYTT') C C C 7- EVALUATION DES DIMENSIONS DES TABLEAUX C ========================================= C CALL EVADIM * (NDIM,NPOINS,NELEMS,NFBIDA, * NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL, NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS, * NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NPPEL,NPOUE, * NBICOR,NBCOPR,NBFFLU,NBFECH,NBFRAI, * NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C IF (NBMOBS.GT.0) THEN LSROTA = .TRUE. ELSE LSROTA = .FALSE. ENDIF C C 8- OUVERTURE DES FICHIERS DE RESULTATS C ====================================== IF (.NOT. LSROTA .AND. .NOT.LSDEPL) THEN CALL OPENCT ('RGEOM') CALL OPENCT ('RESUL') IF (NCHROS.GE.1) CALL OPENCT ('RCHRO') IF (NFMST.GT.0) CALL OPENCT ('FMSTS') ENDIF C C 9- DONNEES ISSUES DU FLUIDE C =========================== C C 9.1 Prise en compte des calculs axisymetriques C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (IAXISY.GT.0) THEN WRITE(NFECRA,9100) ENDIF C C 9.2 Bilan de flux vol C ~~~~~~~~~~~~~~~~~~~~~ IF (NBILAV.GT.0 .AND. NDFLUV.EQ.1) THEN WRITE (NFECRA,9310) STOP ENDIF C C C 10- MAILLAGE EN TRANSLATION C =========================== C IF (LSDEPL) THEN C NPOINS = NPOINS * 2 NELEMS = NELEMS * 2 NELEUS = NELEUS * 2 NELEPR = NELEPR * 2 C NBCOUS = NBCOUS * 2 NELESS = NELESS * 2 NBFLUS = NBFLUS * 2 NBFFLU = NBFFLU * 2 NBDIRS = NBDIRS * 2 NBECHS = NBECHS * 2 NBFECH = NBFECH * 2 NBFLVS = NBFLVS * 2 NBRESS = NBRESS * 2 NELERC = NELERC * 2 NBRAYS = NBRAYS * 2 NELERA = NELERA * 2 NBPRIO = NBPRIO * 2 NBMOBS = NBMOBS * 2 C ENDIF C C C-------- C FORMATS C-------- C 9100 FORMAT(/,' *** INISO1 : LE CALCUL SOLIDE EST FAIT', & ' EN AXISYMETRIQUE') 9310 FORMAT(/,' %% ERREUR INISO1 : Les bilans de flux volumiques ', & 'ne peuvent etre faits',/, & 20X,'que si les flux volumiques sont imposes par "element"',/, & 20X,'ou par "noeud par element"',/ ) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/lecrer.F0000666000175000017500000003600411524070641015327 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECRER C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER syrthes.ray * C Lecture de la correspondance entre references * C et type de CL * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! M ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" C C********************************************************************** C C INTEGER I,N,I1,I2,II1,II2,NB,LCH C INTEGER ITAB(NRFMAX) CHARACTER*200 CHAINE,FORMA C C********************************************************************** C C 0- INITIALISATIONS C ================== C DO 1 I=1,NRFMAX IREFRA(I) = 0 IRERCS(I) = 0 IRERCF(I) = 0 IRERTI(I) = 0 IRERFI(I) = 0 IRERPE(I) = 0 1 CONTINUE C DO 2 I=1,NRFMAX ITAB(I) = 0 2 CONTINUE C C C C 1- LECTURE DES REFERENCES DES CATEGORIES DE NOEUDS C ================================================== C REWIND(NFCLRA) C 10 CONTINUE C CHAINE = ' ' READ(NFCLRA,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) GOTO 10 C C C 1.2- NOEUDS SOLIDES AVEC RAYONNEMENT CONFINE C -------------------------------------------- IF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT CONFINE') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 120 N=1,NB IREFRA(ITAB(N)) = 1 120 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 121 N=1,NRFMAX IREFRA(N) = 1 121 CONTINUE ENDIF C C C 1.3- REFERENCES NOEUDS FLUIDES PAROI EQUIVALENTE C -------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS FLUIDES PAROI EQUIVALENTE') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 130 N=1,NB IREFRF(ITAB(N)) = 1 130 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 131 N=1,NRFMAX IREFRF(N) = 1 131 CONTINUE ENDIF C C C 1.4- RAYONNNEMENT : FACES COUPLEES AU SOLIDE C -------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES COUPLEES AU SOLIDE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 140 N=1,NB IRERCS(ITAB(N)) = 1 140 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 141 N=1,NRFMAX IRERCS(N) = 1 141 CONTINUE ENDIF C C 1.5- RAYONNNEMENT : NOEUDS OU FACES COUPLE(ES) AU FLUIDE C -------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE '// & 'COUPLEES AU FLUIDE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 150 N=1,NB IRERCF(ITAB(N)) = 1 150 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 151 N=1,NRFMAX IRERCF(N) = 1 151 CONTINUE ENDIF C C C 1.6- RAYONNNEMENT : FACES A TEMPERATURE IMPOSEE C ----------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES TEMPERATURE IMPOSEE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 160 N=1,NB IRERTI(ITAB(N)) = 1 160 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 161 N=1,NRFMAX IRERTI(N) = 1 161 CONTINUE ENDIF C C C 1.7- RAYONNNEMENT : FACES A FLUX IMPOSE C --------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES FLUX IMPOSE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 170 N=1,NB IRERFI(ITAB(N)) = 1 170 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 171 N=1,NRFMAX IRERFI(N) = 1 171 CONTINUE ENDIF C C C 1.8- RAYONNNEMENT : FACES A PAROI EQUIVALENTE C --------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 180 N=1,NB IRERPE(ITAB(N)) = 1 180 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 181 N=1,NRFMAX IRERPE(N) = 1 181 CONTINUE ENDIF C C ENDIF C GOTO 10 C 999 CONTINUE C C 8- IMPRESSION POUR VERIFICATIONS C ================================ C IF (NBLBLR.GE.2) THEN C C NB = 0 DO 810 N=1,NRFMAX IF (IREFRF(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 810 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8010) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 820 N=1,NRFMAX IF (IREFRA(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 820 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8020) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 830 N=1,NRFMAX IF (IRERCS(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 830 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8030) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 840 N=1,NRFMAX IF (IRERCF(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 840 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8040) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 850 N=1,NRFMAX IF (IRERTI(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 850 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8050) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 860 N=1,NRFMAX IF (IRERFI(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 860 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8060) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 870 N=1,NRFMAX IF (IRERPE(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 870 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8070) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 880 N=1,NRFMAX IF (IRESTE(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 880 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8080) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 881 N=1,NRFMAX IF (IRESTF(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 881 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8081) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 882 N=1,NRFMAX IF (IRESTS(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 882 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8082) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 883 N=1,NRFMAX IF (IRESTB(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 883 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8083) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 884 N=1,NRFMAX IF (IRESTC(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 884 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,8084) WRITE(NFECRA,8000) (ITAB(N),N=1,NB) ENDIF C ENDIF C C GOTO 300 C C 3. GESTION DES ERREURS DE LECTURE C ================================= C 9999 WRITE(NFECRA,3000) CHAINE STOP C 300 CONTINUE C C-------- C FORMATS C-------- 1000 FORMAT(A200) C 8000 FORMAT(3X,32I3,/) 8010 FORMAT(/,' *** LECRER : REFERENCES DES NOEUDS DU FLUIDE ', & 'NON COUPLES MAIS SOUMIS AU RAYONNEMENT') 8020 FORMAT(/,' *** LECRER : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC RAYONNEMENT CONFINE') 8030 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES COUPLEES ', & 'AU SOLIDE') 8040 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES COUPLEES ', & 'AU FLUIDE (Traitement equivalent)') 8050 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES ', & 'DE TYPE TEMPERATURE IMPOSEE') 8060 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES ', & 'DE TYPE FLUX IMPOSE') 8070 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES ', & 'DE TYPE PAROI EQUIVALENTE ISOLEE') 8080 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES MSTS AVEC COEFF D''E' & ,'CHANGE (OU ISOLEES)') 8081 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES MSTS', & 'COUPLEES AU FLUIDE') 8082 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES MSTS', & 'COUPLEES AU SOLIDE') 8083 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES ', & 'EPAISSEUR DU MSTS') 8084 FORMAT(/,' *** LECRER : MAILLAGE RAYONNEMENT ',/, & ' REFERENCES DES FACES COUPLEES SOLIDE ', & 'CONTACT AVEC MSTS') 3000 FORMAT(/,' %% ERREUR LECRER : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des references',/, * 20X,'Ligne concernee : ',A) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/grcon3.F0000666000175000017500000003514411524070641015252 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE GRCON3 C ***************** C C ---------------------------------------------------- *( X,DMAT,XMAT,B,DIAG,NODES,RES,GD,DD,Z,WCT, * NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, * NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- SOLVEUR D'UN SYSTEME A X = B * C * C Ce sous-programme determine la solution de: * C * C A X = B * C * C A est une matrice symetrique. * C On utilise une methode mixte de gradient conjuge simple et * C de residu conjuge multicouche (en test) * C avec * C preconditionnement par la diagonale. * C * C Soit X la variable d'iteration: * C * C Etape d'initialisation: * C ----------------------- * C * C RES0 = A X0 - B * C * C GD0 = DIAG * RES0 * C * C DD0 = GD0 * C * C Iterations N : * C -------------- * C * C GD = DIAG * RES * C N N * C * C RES . GD * C N N * C DD = GD * ------------- * DD * C N N RES . GD N-1 * C N-1 N-1 * C * C Z = A * DD * C N N * C * C RES . DD * C N N * C RO = - ------------ * C N DD . Z * C N N * C * C X = X + RO * DD * C N+1 N N N * C * C RES = RES + RO * Z * C N+1 N N N * C * C Test de convergence: * C -------------------- * C || RES || < EPSI * C N+1 * C On choisi de faire une precision relative qui s'appuit sur * C la norme du vecteur initial * C epsi = epsgcs * || X0 || * C c'est a dire que si la solution conduit a un grand vecteur X * C le residu || X - X || sera compare a un nombre plus grand. * C N+1 N * C epsgcs est fourni par l'utilisateur (0.001 A 0.000001) * C * C On embraye ensuite sur un multi-couche * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! X ! TR ! M ! VECTEUR RESULTAT ! C ! DMAT ! TR ! D ! DIAGONALE DE LA MATRICE DU SYSTEME ! C ! MAT ! TR ! D ! TERMES EXTRA DIAGOMAUX DE LA MATRICE ! C ! B ! TR ! D ! SECOND MEMBRE DE L'EQUATION ! C ! DIAG ! TR ! D ! DIAGONALE DE PRECONDITIONNEMENT ! C ! RES ! TR ! M ! RESIDU ! C ! GD ! TR ! M ! GRADIENT DE DESCENTE ! C ! DD ! TR ! M ! DIRECTION DE DESCENTE ! C ! Z ! TR ! M ! VECTEUR CONTENANT 'M' MULTIPLIEE PAR DD ! C ! WCT ! TR ! M ! TABLEAU DE TRAVAIL ( NELEMS*NDMATS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : IINFO,OV,OMV,PROSCA C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NELEPR,NBPRIO,NBCOPR,NCOEMA,NDIELE C INTEGER NODES(NELEMS,NDMATS) INTEGER NODEPR(NELEPR,NDMATS+1),NPRIOS(NBPRIO,1+NBCOPR) C DOUBLE PRECISION X(NPOINS),B(NPOINS),DD(NPOINS),GD(NPOINS) DOUBLE PRECISION RES(NPOINS),Z(NPOINS) DOUBLE PRECISION DIAG(NPOINS),DMAT(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS) C DOUBLE PRECISION XM1(50000),RESM1(50000) C..Variables locales INTEGER N,I DOUBLE PRECISION C,X0,RESNOR,SL,RGRG,RO,PRSCA1,PRSCA2 DOUBLE PRECISION ALP,EPSIS,ZERO DOUBLE PRECISION AA,BB,CC,D,EE,ALFA,AALFA,TAU,ALFAM1,ALFTAU DOUBLE PRECISION AUX1,AUX2,AUX,DENOM LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATION C ================= C LVERIF = .TRUE. ZERO = 0.D0 C N = 0 C CALL PROSCA ( NPOINS,X,X,PRSCA1 ) X0 = SQRT ( PRSCA1 ) C IF ( X0 .LT. 1.D-20 ) X0 = 1.D-4 EPSIS = 1.D-4 * X0 C C CALL OV ( 'X=C ',RES,RES,RES,ZERO,NPOINS ) CALL OMV ( 'X=MY ',RES,DMAT,XMAT,X,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR) CALL OV ( 'X=X-Y ',RES,B,RES,ZERO,NPOINS ) C C CALL PROSCA ( NPOINS,RES,RES,PRSCA1 ) RESNOR = SQRT ( PRSCA1 ) C IF ( RESNOR.LE.EPSIS .AND. RESNOR.LE.EPSGCS*SQRT(DBLE(NPOINS))) & THEN C C IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1000) WRITE(NFECRA,1010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) ELSEIF (NBLBLA.GT.0) THEN WRITE(NFECRA,2010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) ENDIF RETURN C ENDIF C C 2. PROCESSUS POUR DETERMINER LA DEUXIEME ITERATION C ===================== IF (NBLBLA.GE.2) WRITE(NFECRA,1000) C 1 CONTINUE N = N+1 C CALL OV ( 'X=YZ ',GD ,RES,DIAG,ZERO,NPOINS ) C C CALL PROSCA ( NPOINS,RES,GD,SL ) C IF ( N . EQ . 1 ) THEN CALL OV ( 'X=Y ',DD,GD,RES,ZERO,NPOINS ) ELSE ALP = SL / RGRG CALL OV ( 'X=Y+CZ ',DD,GD,DD,ALP,NPOINS ) ENDIF C RGRG = SL C C Calcul de Z C ----------- C CALL OV ( 'X=C ',Z,RES,RES,ZERO,NPOINS ) CALL OMV ( 'X=MY ',Z,DMAT,XMAT,DD,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C CALL PROSCA ( NPOINS,RES,DD,PRSCA1 ) CALL PROSCA ( NPOINS,DD,Z,PRSCA2 ) RO = - PRSCA1 / PRSCA2 C IF(N.EQ.2) THEN DO 100 I=1,NPOINS X(I) = X(I) + RO*DD(I) RES(I) = RES(I) + RO*Z(I) XM1(I) = X(I) RESM1(I) = RES(I) 100 CONTINUE ELSE DO 110 I=1,NPOINS X(I) = X(I) + RO*DD(I) RES(I) = RES(I) + RO*Z(I) 110 CONTINUE ENDIF C CALL PROSCA ( NPOINS,RES,RES,PRSCA1 ) RESNOR = SQRT ( PRSCA1 ) C IF (NBLBLA.GE.2 ) & WRITE(NFECRA,1010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) IF ( N.LE.1 ) GOTO 1 C c IF (NBLBLA.GT.0) c & WRITE (NFECRA,2010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) C C C 3. PROCESSUS ITERATIF MULTICOUCHE C ================================= IF (NBLBLA.GE.2) WRITE(NFECRA,1000) CALL OV ( 'X=C ',RESM1,RESM1,RESM1,ZERO,NPOINS ) CALL OMV ( 'X=MY ',RESM1,DMAT,XMAT,XM1,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR) CALL OV ( 'X=X-Y ',RESM1,B,RESM1,ZERO,NPOINS ) CALL OV ( 'X=C ',RES,RES,RES,ZERO,NPOINS ) CALL OMV ( 'X=MY ',RES,DMAT,XMAT,X,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR) CALL OV ( 'X=X-Y ',RES,B,RES,ZERO,NPOINS ) 3 CONTINUE N = N + 1 CALL OV ( 'X=YZ ',GD ,RES,DIAG,ZERO,NPOINS ) CALL OV ( 'X=C ',Z,Z,Z,ZERO,NPOINS ) CALL OMV ( 'X=MY ',Z,DMAT,XMAT,GD,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) AA = 0. BB = 0. CC = 0. D = 0. EE = 0. DO 30 I=1,NPOINS AA = AA + GD(I)*RES(I) BB = BB + GD(I)*RESM1(I) AUX = X(I)-XM1(I) CC = CC +RES(I)*AUX D = D +RESM1(I)*AUX EE = EE +Z(I)*GD(I) 30 CONTINUE c DO 31 I=1,NPOINS c AA = AA + Z(I)*RES(I) c BB = BB + Z(I)*RESM1(I) c AUX = RES(I)-RESM1(I) c CC = CC +RES(I)*AUX c D = D +RESM1(I)*AUX c EE = EE +Z(I)*Z(I) c 31 CONTINUE C DENOM = (CC-D )*EE-(AA-BB)*(AA-BB) IF(ABS(DENOM) .LT. 1E-20) THEN ALFA = 1. ELSE ALFA = ((AA-BB)*BB-D *EE)/DENOM ENDIF C AALFA = ABS(ALFA) IF (AALFA .LE. 1E-20 .OR. ABS(AALFA-1.) .LE. 1.E-20) THEN ALFA = 1. TAU = AA/EE ELSE TAU = AA/EE + (1.-ALFA)/ALFA * BB/EE ENDIF C ALFAM1 = 1.-ALFA ALFTAU = -ALFA*TAU DO 300 I=1,NPOINS AUX1 = RES(I) AUX2 = X(I) RES(I) = ALFA*AUX1+ALFAM1*RESM1(I)+ALFTAU*Z(I) RESM1(I) = AUX1 X(I) = ALFA*AUX2+ALFAM1*XM1(I)+ALFTAU*GD(I) XM1(I) = AUX2 300 CONTINUE C CALL PROSCA ( NPOINS,RES,RES,PRSCA1 ) RESNOR = SQRT ( PRSCA1 ) C IF (NBLBLA.GE.2 ) & WRITE(NFECRA,1010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) IF ( .NOT. ( (RESNOR.LE.EPSIS .AND. & RESNOR.LE.EPSGCS*SQRT(DBLE(NPOINS))) & .OR. N.GE.NITMXS ) ) & GOTO 3 C IF (NBLBLA.GT.0) & WRITE (NFECRA,2010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NPOINS)) C C-------- C FORMATS C-------- C 1000 FORMAT (/,' *** GRCON3: RESOLUTION PAR GRADIENT CONJUGUE' & ,/,10X,' ITERATIONS PRECISION RELATIVE', & ' PRECISION ABSOLUE') 1010 FORMAT (13X,I4,11X,E12.5,6X,E12.5) 2010 FORMAT (' GRCON3',I4,' ITERATIONS PRECISION RELATIVE = ',E12.5, & ' PRECISION ABSOLUE = ', E12.5 ) C END syrthes-3.4.3-dfsg1/src/s/verifa.F0000666000175000017500000001261711524070641015333 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=VERIFA,SSI=0 SUBROUTINE VERIFA C ***************** C C ------------------------------ * (NDIELE,NELEMS,NBFACE,NREFAC) C ------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C VERIFICATION QUE LE TABLEAU DES REFERENCES DE FACES * C A BIEN ETE REMPLI * C Les references sur les faces sont necessaires lorsque * C l'on veut imposer les conditions aux limites sur * C les faces * C * C Sous programme utilisateur * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEMES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS(2=triangles,3=tetraed)! C ! NREFAC ! TE ! R ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS PAR ELEMENTS ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIELE,NELEMS,NBFACE,NREFAC(NELEMS,NBFACE) C C.. Variables internes INTEGER I LOGICAL LOK C C*********************************************************************** C C C 1- TEST C ======= C LOK = .FALSE. C DO 200 I=1,NELEMS*NBFACE IF (NREFAC(I,1) .NE. 0) LOK = .TRUE. 200 CONTINUE C C C 2- IMPRESSION C ============= C IF (.NOT. LOK) WRITE(NFECRA,2000) C C C-------- C FORMATS C-------- 2000 FORMAT(/,' $$ ATTENTION VERIFA : VOUS AVEZ DEMANDE ', & 'L''IMPOSISTION DES CONDITIONS AUX LIMITES PAR FACE',/, & ' ET TOUTES LES REFERENCES SUR ', & 'LES FACES SONT NULLES !!!',/) C END syrthes-3.4.3-dfsg1/src/s/rrayrc.F0000666000175000017500000002244611524070641015362 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE RRAYRC C ***************** C C ---------------------------------------------------- *( FDFRAY,SUFRAY,NELRAY,EMISSI,RADIOS,EPROPR,NUMBS, * X,B,XM1,GD,RES,Z,DI,RESM1) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- SOLVEUR D'UN SYSTEME A X = B * C * C Ce sous-programme determine la solution de: * C * C A X = B * C * C A est une matrice symetrique. * C On utilise la methode du gradient conjuge, et le * C preconditionnement par la diagonale. * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! X ! TR ! M ! VECTEUR RESULTAT ! C ! B ! TR ! D ! SECOND MEMBRE DE L'EQUATION ! C ! DI ! TR ! M ! Diagonale de la matrice ! C ! RES ! TR ! M ! RESIDU ! C ! GD ! TR ! M ! GRADIENT DE DESCENTE ! C ! Z ! TR ! M ! VECTEUR CONTENANT 'M' MULTIPLIEE PAR DD ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : OV,PROSCA C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NELRAY,NUMBS C DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION SUFRAY(NELRAY),EMISSI(NELRAY,2,NBANDE) DOUBLE PRECISION RADIOS(NELRAY,NBANDE),EPROPR(NELRAY,NBANDE) DOUBLE PRECISION X(NELRAY),B(NELRAY),GD(NELRAY) DOUBLE PRECISION RES(NELRAY),Z(NELRAY),DI(NELRAY) C DOUBLE PRECISION XM1(NELRAY),RESM1(NELRAY) C C..Variables locales DOUBLE PRECISION AA,BB,CC,D,EE,ALFA,AALFA,TAU,ALFAM1,ALFTAU DOUBLE PRECISION AUX1,AUX2,AUX,DENOM INTEGER N,I,J,NITSMO DOUBLE PRECISION X0,RESNOR,PRSCA1 DOUBLE PRECISION EPSIS,ZERO,EPSSMO C C*********************************************************************** C C 1- INITIALISATION C ================= C ZERO = 0.D0 NITSMO = 100 EPSSMO = 1.E-12 NFECRA = 6 N = 0 C C 1- INITIALISATION DES VECTEURS AUXILIAIRES C ========================================== DO 10 I=1,NELRAY B(I) = EPROPR(I,NUMBS) DI(I) = SUFRAY(I)-EMISSI(I,2,NUMBS) & *FDFRAY((I-1)*NELRAY-(I-3)*I/2) X(I) = EPROPR(I,NUMBS) XM1(I) = EPROPR(I,NUMBS) 10 CONTINUE C C Norme du second membre C ---------------------- CALL PROSCA ( NELRAY,X,X,PRSCA1 ) X0 = SQRT ( PRSCA1 ) C IF ( X0 .LT. 1.D-20 ) X0 = 1.D-6 EPSIS = 1.D-4 * X0 C DO 100 I=1,NELRAY RES(I) = 0. DO 110 J=1,I-1 RES(I) = RES(I) - FDFRAY((J-1)*NELRAY-(J-1)*J/2+I) & * EMISSI(I,2,NUMBS) & * X(J) 110 CONTINUE DO 120 J=I+1,NELRAY RES(I) = RES(I) - FDFRAY((I-1)*NELRAY-(I-1)*I/2+J) & * EMISSI(I,2,NUMBS) & * X(J) 120 CONTINUE RES(I) = RES(I) + DI(I)*X(I) - B(I) 100 CONTINUE C CALL PROSCA ( NELRAY,RES,RES,PRSCA1 ) RESNOR = SQRT ( PRSCA1 ) C IF ( RESNOR.LE.EPSIS .AND. RESNOR.LE.EPSGCS*SQRT(DBLE(NELRAY))) & THEN C C Affichage de la precision relative et absolue et sortie C ------------------------------------------------------- IF (NBLBLR.GE.2) THEN WRITE(NFECRA,1000) WRITE(NFECRA,1010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NELRAY)) ELSEIF (NBLBLR.GT.0) THEN WRITE(NFECRA,2010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NELRAY)) ENDIF RETURN C ENDIF C C 2. PROCESSUS ITERATIF C ===================== IF (NBLBLR.GE.2) WRITE(NFECRA,1000) DO 198 I=1,NELRAY RESM1(I) = RES(I) 198 CONTINUE C 1 N = N + 1 C DO 199 I=1,NELRAY GD(I) = RES(I)/DI(I) 199 CONTINUE C DO 200 I=1,NELRAY Z(I) = 0. DO 210 J=1,I-1 Z(I) = Z(I) - FDFRAY((J-1)*NELRAY-(J-1)*J/2+I) & * EMISSI(I,2,NUMBS) & * GD(J) 210 CONTINUE DO 220 J=I+1,NELRAY Z(I) = Z(I) - FDFRAY((I-1)*NELRAY-(I-1)*I/2+J) & * EMISSI(I,2,NUMBS) & * GD(J) 220 CONTINUE Z(I) = Z(I) + DI(I)*GD(I) 200 CONTINUE C AA = 0. BB = 0. CC = 0. D = 0. EE = 0. DO 31 I=1,NELRAY AA = AA + Z(I)*RES(I) BB = BB + Z(I)*RESM1(I) AUX = RES(I)-RESM1(I) CC = CC +RES(I)*AUX D = D +RESM1(I)*AUX EE = EE +Z(I)*Z(I) 31 CONTINUE C DENOM = (CC-D )*EE-(AA-BB)*(AA-BB) IF(ABS(DENOM) .LT. 1E-20) THEN ALFA = 1. ELSE ALFA = ((AA-BB)*BB-D *EE)/DENOM ENDIF C AALFA = ABS(ALFA) IF (AALFA .LE. 1E-20 .OR. ABS(AALFA-1.) .LE. 1.E-20) THEN ALFA = 1. TAU = AA/EE ELSE TAU = AA/EE + (1.-ALFA)/ALFA * BB/EE ENDIF C ALFAM1 = 1.-ALFA ALFTAU = -ALFA*TAU DO 300 I=1,NELRAY AUX1 = RES(I) AUX2 = X(I) RES(I) = ALFA*AUX1+ALFAM1*RESM1(I)+ALFTAU*Z(I) RESM1(I) = AUX1 X(I) = ALFA*AUX2+ALFAM1*XM1(I)+ALFTAU*GD(I) XM1(I) = AUX2 300 CONTINUE C C CALL PROSCA ( NELRAY,RES,RES,PRSCA1 ) RESNOR = SQRT ( PRSCA1 ) C IF (NBLBLR.GE.2 .AND. MOD(N,10).EQ.0) & WRITE(NFECRA,1010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NELRAY)) IF ( .NOT. ( (RESNOR.LE.EPSIS .AND. & RESNOR.LE.EPSGCS*SQRT(DBLE(NELRAY))) & .OR. N.GE.NITSMO ) ) & GOTO 1 C IF (NBLBLR.GT.0) & WRITE (NFECRA,2010) N,RESNOR/X0,RESNOR/SQRT(DBLE(NELRAY)) C C C 4. REMISE A JOUR DU VECTEUR C =========================== DO 400 I=1,NELRAY RADIOS(I,NUMBS) = X(I) 400 CONTINUE C C-------- C FORMATS C-------- C 1000 FORMAT (/,' *** RRAYRC: RESOLUTION DU RAYONNEMENT' & ,/,10X,' ITERATIONS PRECISION RELATIVE', & ' PRECISION ABSOLUE') 1010 FORMAT (13X,I4,11X,E12.5,6X,E12.5) 2010 FORMAT (' RRAYRC',I4,' ITERATIONS PRECISION RELATIVE = ',E12.5, & ' PRECISION ABSOLUE = ', E12.5 ) C END syrthes-3.4.3-dfsg1/src/s/smfflu.F0000666000175000017500000004234311524070641015352 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMFFLU,SSI=0 C SUBROUTINE SMFFLU C ***************** C C --------------------------------------------------- *( NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * TMPSA,B,NODEUS,COORDS,SURFUS, * NPOINS,NELEMS,NDIM,NELEUS,NDMASS, * TRAVF,TRAVP,WCT ) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C PRISE EN COMPTE DES FLUX DE BORD * C * C Les flux au bord du solide sont de plusieurs types: * C Flux dus au couplage thermique fluide -solide * C Flux imposes par l'utilisateur * C Flux ayant pour origine un coefficient d'echange * C Flux ayant pour origine une resitance de contact * C Flux ayant pour origine un rayonnement * C * C Le flux est impose sur les noeuds definis par l'utilisateur * C Attention: * C Les termes de flux sont traites par facette * C c'est a dire qu'on considere des facettes de * C type Couplee * C Echange * C Flux * C Resistance * C Rayonnement * C * C Deux options sont envisageables : * C une option implicite (qui ameliore le traitement en temps) * C une option explicite (qui ameliore le traitement en espace) * C * C En 2D: * C ------ / * C B = B + / q . Phj dS * C / * C q est discretise en iso-P2 * C dS element de longueur * C Phj fonction de base iso-P2 * C * C En 3D: * C ------ / * C B = B + / q . Phj dS * C / * C q est discretises en iso-P2 * C dS element de surface * C Phj fonction de base iso-P2 * C * C Rq : Lorsque le flux n'est pas defini, cela revient a dire * C implicitement que ce flux est nul. * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NELERA ! E ! D ! Nombre de facette de type rayonnement ! C ! NFRAIS ! TE ! D ! No de facette rayonnt inf --> face glob ! C ! VFRAIS ! TR ! D ! Valeur du rayo inf aux points de la face ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! B ! TR ! R ! SECOND MEMBRE ! C ! NODEUS ! TE ! D ! NOEUDS DE BORD( LOCALE 2D --> GLOBALE 3D)! C ! SURFUS ! TR ! D ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE ! C ! TRAV ! TR ! R ! TABLEAU DE TRAVAIL ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL. ATTENTION On utilise! C ! ! ! ! uniquement les premieres cases ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" #include "syrth.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIM,NELEUS,NDMASS INTEGER NBFFLU,NBFECH,NELERC,NELERA,NBFRAI,NELESS INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI),NFCOUS(NELESS) INTEGER NODEUS(NELEUS,NDMASS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) DOUBLE PRECISION B(NPOINS),TRAVP(NPOINS),TRAVF(NELEUS,NDMASS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMASS) DOUBLE PRECISION SURFUS(NELEUS) C C..Variables internes DOUBLE PRECISION R1,R2 DOUBLE PRECISION F1,F2,F3,F4,F5,F6 INTEGER I,J,INODE,NF,NCA DOUBLE PRECISION S48,SV48,S12,SV12 DOUBLE PRECISION ZERO DOUBLE PRECISION HRAYI,HRAYT C C*********************************************************************** C C 1- INITIALISATIONS C ================== IF (NELESS * .EQ.0 .AND. .NOT. LSYRTH) * NELESS = NELEUS C ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEUS*NDMASS ) C S48 = 1.D0 / 48.D0 S12 = 1.D0 / 12.D0 C C 2- CALCUL DES CONDITIONS SUR LES FACES DE BORD CONCERNEES C ========================================================= C C C 2.1 Prise en compte explicite C ----------------------------- IF ( LCLEXP ) THEN C DO 2111 J=1,NDMASS DO 2110 I=1,NELESS INODE = NODEUS(NFCOUS(I),J) NF = NFCOUS(I) TRAVF(NF,J) = TRAVF(NF,J) + & VFCOUS(I,J,2)*(VFCOUS(I,J,1)-TMPSA(INODE)) 2110 CONTINUE 2111 CONTINUE C DO 2121 J=1,NDMASS DO 2120 I=1,NBFFLU NF = NFFLUS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFFLUS(I,J) 2120 CONTINUE 2121 CONTINUE C DO 2131 J=1,NDMASS DO 2130 I=1,NBFECH INODE = NODEUS(NFECHS(I),J) NF = NFECHS(I) TRAVF(NF,J) = TRAVF(NF,J) + & VFECHS(I,J,2)*(VFECHS(I,J,1)-TMPSA(INODE)) 2130 CONTINUE 2131 CONTINUE C C DO 2141 J=1,NDMASS DO 2140 I=1,NELERC INODE = NODEUS(NFRESC(I),J) NF = NFRESC(I) TRAVF(NF,J) = TRAVF(NF,J) + & VFRESC(I,J,2)*(VFRESC(I,J,1)-TMPSA(INODE)) 2140 CONTINUE 2141 CONTINUE C C DO 2151 J=1,NDMASS DO 2150 I=1,NBFRAI INODE = NODEUS(NFRAIS(I),J) NF = NFRAIS(I) HRAYI = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & HRAYI*(VFRAIS(I,J,1)-TMPSA(INODE)) 2150 CONTINUE 2151 CONTINUE C C DO 2161 J=1,NDMASS DO 2160 I=1,NELERA INODE = NODEUS(NFRAYS(I),J) NF = NFRAYS(I) HRAYT = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & HRAYT*(VFRAYS(I,J,1)-TMPSA(INODE)) 2160 CONTINUE 2161 CONTINUE C C 2.2 Prise en compte implicite des conditions d'echange C ------------------------------------------------------ ELSE C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEUS*NDMASS ) C DO 2211 J=1,NDMASS DO 2210 I=1,NELESS NF = NFCOUS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFCOUS(I,J,1)*VFCOUS(I,J,2) 2210 CONTINUE 2211 CONTINUE C DO 2231 J=1,NDMASS DO 2230 I=1,NBFECH NF = NFECHS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFECHS(I,J,1)*VFECHS(I,J,2) 2230 CONTINUE 2231 CONTINUE C C DO 2241 J=1,NDMASS DO 2240 I=1,NELERC NF = NFRESC(I) TRAVF(NF,J) = TRAVF(NF,J) + VFRESC(I,J,1)* VFRESC(I,J,2) 2240 CONTINUE 2241 CONTINUE C C DO 2251 J=1,NDMASS DO 2250 I=1,NBFRAI INODE = NODEUS(NFRAIS(I),J) NF = NFRAIS(I) HRAYI = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + VFRAIS(I,J,1)*HRAYI 2250 CONTINUE 2251 CONTINUE C C DO 2261 J=1,NDMASS DO 2260 I=1,NELERA INODE = NODEUS(NFRAYS(I),J) NF = NFRAYS(I) HRAYT = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) c print*,' T Tr Hray Flux_eq',i,j,TMPSA(INODE), c * VFRAYS(i,j,1),HRAYT,HRAYT* c * (TMPSA(INODE)-VFRAYS(i,j,1)) TRAVF(NF,J) = TRAVF(NF,J) + VFRAYS(I,J,1)*HRAYT 2260 CONTINUE 2261 CONTINUE C C DO 2311 J=1,NDMASS DO 2310 I=1,NBFFLU NF = NFFLUS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFFLUS(I,J) 2310 CONTINUE 2311 CONTINUE C C ENDIF C C C 3- CALCUL DU VECTEUR ELEMENTAIRE C ================================ C C 3.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 3.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 3110 I=1,NELEUS C SV12 = S12 * SURFUS(I) C F1 = TRAVF(I,1) * SV12 F2 = TRAVF(I,2) * SV12 F3 = TRAVF(I,3) * SV12 C C ATTENTION Le point 3 est au milieu du segment WCT(I,1) = F3+2*F1 WCT(I,2) = F3+2*F2 WCT(I,3) = 4*F3+F1+F2 3110 CONTINUE C C 3.1.2- Cas axisymetrique C ------------------------ ELSE DO 3120 I=1,NELEUS C SV48 = S48 * SURFUS(I) C R1 = ABS (COORDS(NODEUS(I,1),NCA)) R2 = ABS (COORDS(NODEUS(I,2),NCA)) C F1 = TRAVF(I,1) * SV48 F2 = TRAVF(I,2) * SV48 F3 = TRAVF(I,3) * SV48 C WCT(I,1) = R2*F3+R2*F1+3*R1*F3+7*R1*F1 WCT(I,2) = 3*R2*F3+7*R2*F2+R1*F3+R1*F2 WCT(I,3) = 8*R2*F3+R2*F1+8*R1*F3+3*R1*F1 & +3*R2*F2+R1*F2 C 3120 CONTINUE C ENDIF C C 3.2- Cas 3D C ----------- ELSE DO 3200 I=1,NELEUS C SV48 = S48 * SURFUS(I) C F1 = TRAVF(I,1) * SV48 F2 = TRAVF(I,2) * SV48 F3 = TRAVF(I,3) * SV48 F4 = TRAVF(I,4) * SV48 F5 = TRAVF(I,5) * SV48 F6 = TRAVF(I,6) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 3200 CONTINUE C ENDIF C CALL OV ( 'X=C ',TRAVP,TRAVP,TRAVP,ZERO,NPOINS ) CALL ASSEUS ( TRAVP,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS, & NDIM,WCT) C C C 4- MISE A JOUR DU SECOND MEMBRE C =============================== C DO 4000 I=1,NPOINS B(I) = B(I) + TRAVP(I) 4000 CONTINUE C C C 5- IMPRESSIONS POUR CONTROLE C ============================ C IF (NBLBLA.EQ.12) THEN WRITE(NFECRA,5001) DO 5000 I=1,NPOINS WRITE(NFECRA,5010) I,B(I),TRAVP(I) 5000 CONTINUE ENDIF C C-------- C FORMATS C-------- 5001 FORMAT(/,' *** SMFFLU : SECOND MEMBRE (PARTIE FLUX)',/, & ' NOEUD SECOND MEMBRE FLUX AJOUTE ') 5010 FORMAT(7X,I6,5X,G10.4,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/lecsy2.F0000666000175000017500000001532111524070641015253 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECSY2 C ***************** C C ---------------------------------------------------------------- *(NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN,IREF,INOEUD,IFACE,IELT) C ---------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE SYRTHES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "optct.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN INTEGER IREF(NPOINS),INOEUD(NELEMS*NN),IFACE(NELEMS*NBFACE) INTEGER IELT(NELEMS) C C.. Variables internes INTEGER I,J,N1,NBNO,N,IERR CHARACTER CH*80,CH1*10 LOGICAL LF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C IF (NDIELE.EQ.2) THEN NBNO = 6 ELSE NBNO = 10 ENDIF C C 2- NOMBRE DE NOEUDS ET D'ELEMENTS C ================================= C REWIND(NFSGCT) READ(NFSGCT,1000) CH,CH,CH,CH C READ(NFSGCT,1001) CH READ(NFSGCT,1001) CH C C 3- TABLE DES NOEUDS C =================== C IERR = 0 CALL SECGRF(NFSGCT,'C$ RUBRIQUE = NOEUDS',20,IERR) IF (IERR.NE.0) THEN WRITE(NFECRA,3100) STOP ENDIF C DO N=1,NPOINS READ(NFSGCT,3200) CH1,IREF(N) ENDDO C C C 4- TABLE DES ELEMENTS C ===================== C IERR = 0 CALL SECGRF(NFSGCT,'C$ RUBRIQUE = ELEMENTS',22,IERR) IF (IERR.NE.0) THEN WRITE(NFECRA,4100) STOP ENDIF C C IF (NBNO.EQ.6) THEN DO I=1,NELEMS READ(NFSGCT,4200) N1,IELT(I), & (INOEUD((J-1)*NELEMS+I),J=1,NBNO) ENDDO C ELSEIF (NBNO.EQ.10) THEN DO I=1,NELEMS READ(NFSGCT,4201) N1,IELT(I), & (INOEUD((J-1)*NELEMS+I),J=1,NBNO) ENDDO ENDIF C C C 5- REFERENCES SUR LES FACES C =========================== C IF (LCFACE) THEN C IERR = 0 CALL SECGRF(NFSGCT,'C$ RUBRIQUE = REFERENCES DES FACES',34,IERR) C LF = .FALSE. C IF (IERR.EQ.0) THEN LF = .TRUE. DO N=1,NELEMS READ(NFSGCT,5200) J,(IFACE((I-1)*NELEMS+N),I=1,NBFACE) ENDDO ENDIF C CALL INREFA (NDIM,NDIELE,NELEMS,NBNO,NBFACE,INOEUD,IFACE, * NPOINS,IREF) C ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(A80,/,A80,/,A80,/,A80) 1001 FORMAT(A80) C C 3100 FORMAT(//,' *** LECGR1 : LE FICHIER GEOMETRIQUE NE CONTIENT ', & 'PAS LA TABLE DES NOEUDS') 3200 FORMAT(A10,I3,1X,3E14.7) 4100 FORMAT(//,' *** LECGR1 : LE FICHIER GEOMETRIQUE NE CONTIENT ', & 'PAS LA TABLE DES ELEMENTS') 4200 FORMAT(I10,I3,6I10) 4201 FORMAT(I10,I3,10I10) 5200 FORMAT(I10,1X,4I5) C C C END syrthes-3.4.3-dfsg1/src/s/derriere_3d.c0000666000175000017500000010264111524070641016300 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "abs.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | derriere | | Detection des faces en arriere et retour d'un code de | | Classement | |======================================================================| */ void derriere_3d (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[],double zi[], double dsign[],int *code_decoupe) { int k; double epsder,testn,epsma; epsder = 5e-4; epsma = 1e-12; for (k=0;k<3;k++) dsign[k] = xnf[nel_j]*xi[k]+xnf[nel_j+nel2]*yi[k]+xnf[nel_j+nel2*2]*zi[k] + pland[nel_j] ; for (k=3;k<6;k++) dsign[k] = xnf[nel_i]*xi[k]+xnf[nel_i+nel2]*yi[k]+xnf[nel_i+nel2*2]*zi[k] + pland[nel_i] ; if (( dsign[0]< epsder && dsign[1]< epsder && dsign[2]< epsder) || ( dsign[3]< epsder && dsign[4]< epsder && dsign[5]< epsder)) *code_decoupe = -10; else if ( dsign[0]> -epsder && dsign[1]> -epsder && dsign[2]> -epsder && dsign[3]> -epsder && dsign[4]> -epsder && dsign[5]> -epsder ) *code_decoupe = 0; else if (( dsign[0]> -epsder && dsign[1]> -epsder && dsign[2]> -epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder ) && ( dsign[3]*dsign[4]*dsign[5]>= -epsma) ) *code_decoupe = 1; else if (( dsign[3]> -epsder && dsign[4]> -epsder && dsign[5]> -epsder) && ( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder ) && ( dsign[0]*dsign[1]*dsign[2]>= -epsma) ) *code_decoupe = -1; else if (( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder )&& ( dsign[0]*dsign[1]*dsign[2]>= -epsma) && ( dsign[3]*dsign[4]*dsign[5]>= -epsma) ) *code_decoupe = 3; else if (( dsign[0]> -epsder && dsign[1]> -epsder && dsign[2]> -epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder ) && ( dsign[3]*dsign[4]*dsign[5]< -epsma) ) *code_decoupe = 2; else if (( dsign[3]> -epsder && dsign[4]> -epsder && dsign[5]> -epsder) && ( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder ) && ( dsign[0]*dsign[1]*dsign[2]< -epsma) ) *code_decoupe = -2; else if (( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder )&& ( dsign[0]*dsign[1]*dsign[2]< -epsma) && ( dsign[3]*dsign[4]*dsign[5]< -epsma) ) *code_decoupe = 4; else if (( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder )&& ( dsign[0]*dsign[1]*dsign[2]> epsma) && ( dsign[3]*dsign[4]*dsign[5]< -epsma) ) *code_decoupe = 5; else if (( dsign[0]< epsder || dsign[1]< epsder || dsign[2]< epsder) && ( dsign[3]< epsder || dsign[4]< epsder || dsign[5]< epsder )&& ( dsign[0]*dsign[1]*dsign[2]< -epsma) && ( dsign[3]*dsign[4]*dsign[5]> epsma) ) *code_decoupe = -5; else if ((abs(dsign[0]) < epsder || abs(dsign[1])< epsder || abs(dsign[2])< epsder) || (abs(dsign[3]) < epsder || abs(dsign[4])< epsder || abs(dsign[5])< epsder)) { if ((abs(dsign[3]) < epsder && abs(dsign[4]) > epsder && abs(dsign[5]) > epsder ) || (abs(dsign[4]) < epsder && abs(dsign[3]) > epsder && abs(dsign[5]) > epsder ) || (abs(dsign[5]) < epsder && abs(dsign[3]) > epsder && abs(dsign[4]) > epsder )) { /* Soit le premier triangle n'a pas de point nul */ if (abs(dsign[0])> epsder && abs(dsign[1])>epsder && abs(dsign[2]) > epsder ) { if (dsign[0]>epsder && dsign[1]>epsder && dsign[2]>epsder) *code_decoupe = 1; else if (dsign[0]*dsign[1]*dsign[2] epsder && abs(dsign[2]) > epsder ) || (abs(dsign[1]) < epsder && abs(dsign[2]) > epsder && abs(dsign[0]) > epsder ) || (abs(dsign[2]) < epsder && abs(dsign[0]) > epsder && abs(dsign[1]) > epsder )) { if ( abs(dsign[0]) < epsder ) { /* triangle 1 partage */ if (dsign[1]*dsign[2] < -epsma ) *code_decoupe = 3; else /* pas de redecoupage du triangle 1 */ *code_decoupe = 1; } else if ( abs(dsign[1]) < epsder ) { /* triangle 1 partage */ if (dsign[0]*dsign[2] < -epsma ) *code_decoupe = 3; else /* pas de redecoupage du triangle 1 */ *code_decoupe = 1; } else if ( abs(dsign[2]) < epsder ) { /* triangle 1 partage */ if (dsign[0]*dsign[1] < -epsma ) *code_decoupe = 3; else /* pas de redecoupage du triangle 1 */ *code_decoupe = 1; } } else printf(" Ce cas aurait deja du etre traite facettes : %d %d \n",nel_i+1,nel_j+1); } else if ((abs(dsign[0]) < epsder && abs(dsign[1]) > epsder && abs(dsign[2]) > epsder ) || (abs(dsign[1]) < epsder && abs(dsign[2]) > epsder && abs(dsign[0]) > epsder ) || (abs(dsign[2]) < epsder && abs(dsign[0]) > epsder && abs(dsign[1]) > epsder )) { /* Soit le deuxieme triangle n'a pas de point nul */ if (abs(dsign[3])> epsder && abs(dsign[4])>epsder && abs(dsign[5]) > epsder ) { if (dsign[3]>epsder && dsign[4]>epsder && dsign[5]>epsder) *code_decoupe = -1; else if (dsign[3]*dsign[4]*dsign[5]=0.999) { printf("cas legerement ambigu mais sans consequence nel_i %d nel_j %d \n",nel_i+1,nel_j+1); } else { printf(" Cas ambigu pour les elements nel_i= %d nel_j=%d \n",nel_i+1,nel_j+1); printf("xi,yi,zi\n %f %f %f \n %f %f %f \n %f %f %f \n %f %f %f \n %f %f %f \n %f %f %f \n", xi[0],yi[0],zi[0],xi[1],yi[1],zi[1],xi[2],yi[2],zi[2], xi[3],yi[3],zi[3],xi[4],yi[4],zi[4],xi[5],yi[5],zi[5]); printf(" xn_i yn_i zn_i pland %f %f %f %f \n", xnf[nel_i],xnf[nel_i+nel2],xnf[nel_i+2*nel2],pland[nel_i]); printf(" xn_j yn_j zn_j pland %f %f %f %f \n", xnf[nel_j],xnf[nel_j+nel2],xnf[nel_j+2*nel2],pland[nel_j]); printf(" p0 p1 p2 : %f %f %f \n",dsign[0]*1e3,dsign[1]*1e3,dsign[2]*1e3); printf(" p3 p4 p5 : %f %f %f \n",dsign[3]*1e3,dsign[4]*1e3,dsign[5]*1e3); } *code_decoupe = -6; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_totd | | Apres inversion eventuelle entre nel_i et nel_j | | Decoupage du triangle nel_j pour donner un triangle | | le parametre code_decoupe est egal a 1 ou -1 | | | |======================================================================| */ void decoupe_totd (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[],double zi[], double dsign[],int code_decoupe) { int i,kdeb,seg1n1,seg1n2,seg2n1,seg2n2,kdebm1,kdebp1; double xa,ya,za,xb,yb,zb,xc,yc,zc,da,db,dc; double xnj1,xnj2,xnj3; double denom,numer,alfa; double xka,yka,zka,plac; double pa[3],pb[3]; double epsma=1e-10,epsd=1.e-5,eps=1.e-6; xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; if ( code_decoupe == -1 ) { xa=xi[0]; ya=yi[0]; za=zi[0]; xb=xi[1]; yb=yi[1]; zb=zi[1]; xc=xi[2]; yc=yi[2]; zc=zi[2]; da=dsign[0];db=dsign[1];dc=dsign[2]; xi[0]=xi[3]; yi[0]=yi[3]; zi[0]=zi[3]; xi[1]=xi[4]; yi[1]=yi[4]; zi[1]=zi[4]; xi[2]=xi[5]; yi[2]=yi[5]; zi[2]=zi[5]; dsign[0]=dsign[3]; dsign[1]=dsign[4]; dsign[2]=dsign[5]; xi[3]=xa; yi[3]=ya; zi[3]=za; xi[4]=xb; yi[4]=yb; zi[4]=zb; xi[5]=xc; yi[5]=yc; zi[5]=zc; dsign[3]=da; dsign[4]=db; dsign[5]=dc; xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; } for ( i=3;i<6;i++ )if ( dsign[i]> epsma ) kdeb = i ; if ( kdeb == 3 ) {seg1n1 = 5 ; seg1n2 = 3 ;seg2n1 = 3 ; seg2n2 = 4; } else if ( kdeb == 4 ) {seg1n1 = 3 ; seg1n2 = 4 ;seg2n1 = 4 ; seg2n2 = 5; } else {seg1n1 = 4 ; seg1n2 = 5 ;seg2n1 = 5 ; seg2n2 = 3; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom - epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 3) { kdebm1=5 ; kdebp1=4;} else if ( kdeb == 4 ) { kdebm1=3 ; kdebp1=5;} else { kdebm1=4 ; kdebp1=3;} xka=xi[kdeb];yka=yi[kdeb];zka=zi[kdeb]; xi[3]=pa[0]; yi[3]=pa[1]; zi[3]=pa[2]; xi[4]=xka ; yi[4]=yka ; zi[4]=zka ; xi[5]=pb[0]; yi[5]=pb[1]; zi[5]=pb[2]; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_toqd | | Apres inversion eventuelle entre nel_i et nel_j | | Decoupage du triangle nel_j pour donner deux triangles | | le parametre code_decoupe est egal a 2 ou -2 | | | |======================================================================| */ void decoupe_toqd (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[], double zi[], double xp[],double yp[],double zp[], double dsign[],int code_decoupe) { int i,kdeb,seg1n1,seg1n2,seg2n1,seg2n2,kdebm1,kdebp1; double xa,ya,za,xb,yb,zb,xc,yc,zc,da,db,dc; double xnj1,xnj2,xnj3; double denom,numer,alfa,epsd=1.e-5,eps=1.e-6; double diag1,diag2,plac; double pa[3],pb[3]; xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; if ( code_decoupe == -2 ) /* inversion des triangles */ { xa=xi[0]; ya=yi[0]; za=zi[0]; xb=xi[1]; yb=yi[1]; zb=zi[1]; xc=xi[2]; yc=yi[2]; zc=zi[2]; da=dsign[0];db=dsign[1];dc=dsign[2]; xi[0]=xi[3]; yi[0]=yi[3]; zi[0]=zi[3]; xi[1]=xi[4]; yi[1]=yi[4]; zi[1]=zi[4]; xi[2]=xi[5]; yi[2]=yi[5]; zi[2]=zi[5]; dsign[0]=dsign[3]; dsign[1]=dsign[4]; dsign[2]=dsign[5]; xi[3]=xa; yi[3]=ya; zi[3]=za; xi[4]=xb; yi[4]=yb; zi[4]=zb; xi[5]=xc; yi[5]=yc; zi[5]=zc; dsign[3]=da; dsign[4]=db; dsign[5]=dc; xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; } for ( i=3;i<6;i++ )if ( dsign[i]< 0 ) kdeb = i ; if ( kdeb == 3 ) {seg1n1 = 5 ; seg1n2 = 3 ;seg2n1 = 3 ; seg2n2 = 4; } else if ( kdeb == 4 ) {seg1n1 = 3 ; seg1n2 = 4 ;seg2n1 = 4 ; seg2n2 = 5; } else {seg1n1 = 4 ; seg1n2 = 5 ;seg2n1 = 5 ; seg2n2 = 3; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom - epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom + epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 3) { kdebm1=5 ; kdebp1=4;} else if ( kdeb == 4 ) { kdebm1=3 ; kdebp1=5;} else { kdebm1=4 ; kdebp1=3;} diag1 = (xi[kdebp1]-pa[0])*(xi[kdebp1]-pa[0]) + (yi[kdebp1]-pa[1])*(yi[kdebp1]-pa[1]) + (zi[kdebp1]-pa[2])*(zi[kdebp1]-pa[2]) ; diag2 = (xi[kdebm1]-pb[0])*(xi[kdebm1]-pb[0]) + (yi[kdebm1]-pb[1])*(yi[kdebm1]-pb[1]) + (zi[kdebm1]-pb[2])*(zi[kdebm1]-pb[2]) ; if ( diag1 < diag2 ) { xp[0]=pa[0] ; yp[0]=pa[1] ; zp[0]=pa[2] ; xp[1]=pb[0] ; yp[1]=pb[1] ; zp[1]=pb[2] ; xp[2]=xi[kdebp1]; yp[2]=yi[kdebp1]; zp[2]=zi[kdebp1]; xp[3]=xi[kdebm1]; yp[3]=yi[kdebm1]; zp[3]=zi[kdebm1]; } else { xp[0]=xi[kdebm1]; yp[0]=yi[kdebm1]; zp[0]=zi[kdebm1]; xp[1]=pa[0] ; yp[1]=pa[1] ; zp[1]=pa[2] ; xp[2]=pb[0] ; yp[2]=pb[1] ; zp[2]=pb[2] ; xp[3]=xi[kdebp1]; yp[3]=yi[kdebp1]; zp[3]=zi[kdebp1]; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_tdtd | | Decoupage du triangle nel_i pour donner un triangle | | Decoupage du triangle nel_j pour donner un triangle | | le parametre code_decoupe est egal a 3 | | | |======================================================================| */ void decoupe_tdtd (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[],double zi[], double dsign[],int code_decoupe) { int i,kdeb,seg1n1,seg1n2,seg2n1,seg2n2,kdebm1,kdebp1; double xnj1,xnj2,xnj3; double denom,numer,alfa; double xka,yka,zka,plac; double pa[3],pb[3]; double epsma=1e-14,epsd=1e-5,eps=1e-6; xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; for ( i=3;i<6;i++ )if ( dsign[i]> epsma ) kdeb = i ; if ( kdeb == 3 ) {seg1n1 = 5 ; seg1n2 = 3 ;seg2n1 = 3 ; seg2n2 = 4; } else if ( kdeb == 4 ) {seg1n1 = 3 ; seg1n2 = 4 ;seg2n1 = 4 ; seg2n2 = 5; } else {seg1n1 = 4 ; seg1n2 = 5 ;seg2n1 = 5 ; seg2n2 = 3; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom -epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 3) { kdebm1=5 ; kdebp1=4;} else if ( kdeb == 4 ) { kdebm1=3 ; kdebp1=5;} else { kdebm1=4 ; kdebp1=3;} xka=xi[kdeb];yka=yi[kdeb];zka=zi[kdeb]; xi[3]=pa[0]; yi[3]=pa[1]; zi[3]=pa[2]; xi[4]=xka ; yi[4]=yka ; zi[4]=zka ; xi[5]=pb[0]; yi[5]=pb[1]; zi[5]=pb[2]; xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; for ( i=0;i<3;i++ )if ( dsign[i]> epsma ) kdeb = i ; if ( kdeb == 0 ) {seg1n1 = 2 ; seg1n2 = 0 ;seg2n1 = 0 ; seg2n2 = 1; } else if ( kdeb == 1 ) {seg1n1 = 0 ; seg1n2 = 1 ;seg2n1 = 1 ; seg2n2 = 2; } else {seg1n1 = 1 ; seg1n2 = 2 ;seg2n1 = 2 ; seg2n2 = 0; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom -epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 0) { kdebm1=2 ; kdebp1=1;} else if ( kdeb == 1 ) { kdebm1=0 ; kdebp1=2;} else { kdebm1=1 ; kdebp1=0;} xka=xi[kdeb];yka=yi[kdeb];zka=zi[kdeb]; xi[0]=pa[0]; yi[0]=pa[1]; zi[0]=pa[2]; xi[1]=xka ; yi[1]=yka ; zi[1]=zka ; xi[2]=pb[0]; yi[2]=pb[1]; zi[2]=pb[2]; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_qdqd | | Decoupage du triangle nel_i pour donner deux triangles | | Decoupage du triangle nel_j pour donner deux triangles | | le parametre code_decoupe est egal a 4 | | | |======================================================================| */ void decoupe_qdqd (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[], double zi[], double xp[],double yp[],double zp[], double xq[],double yq[],double zq[], double dsign[],int code_decoupe) { int i,kdeb,seg1n1,seg1n2,seg2n1,seg2n2,kdebm1,kdebp1; double xnj1,xnj2,xnj3; double denom,numer,alfa; double diag1,diag2,plac; double pa[3],pb[3]; double epsd=1e-5,eps=1e-6; xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; for ( i=3;i<6;i++ )if ( dsign[i]< 0 ) kdeb = i ; if ( kdeb == 3 ) {seg1n1 = 5 ; seg1n2 = 3 ;seg2n1 = 3 ; seg2n2 = 4; } else if ( kdeb == 4 ) {seg1n1 = 3 ; seg1n2 = 4 ;seg2n1 = 4 ; seg2n2 = 5; } else {seg1n1 = 4 ; seg1n2 = 5 ;seg2n1 = 5 ; seg2n2 = 3; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom - epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom + epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 3) { kdebm1=5 ; kdebp1=4;} else if ( kdeb == 4 ) { kdebm1=3 ; kdebp1=5;} else { kdebm1=4 ; kdebp1=3;} diag1 = (xi[kdebp1]-pa[0])*(xi[kdebp1]-pa[0]) + (yi[kdebp1]-pa[1])*(yi[kdebp1]-pa[1]) + (zi[kdebp1]-pa[2])*(zi[kdebp1]-pa[2]) ; diag2 = (xi[kdebm1]-pb[0])*(xi[kdebm1]-pb[0]) + (yi[kdebm1]-pb[1])*(yi[kdebm1]-pb[1]) + (zi[kdebm1]-pb[2])*(zi[kdebm1]-pb[2]) ; if ( diag1 < diag2 ) { xq[0]=pa[0] ; yq[0]=pa[1] ; zq[0]=pa[2] ; xq[1]=pb[0] ; yq[1]=pb[1] ; zq[1]=pb[2] ; xq[2]=xi[kdebp1]; yq[2]=yi[kdebp1]; zq[2]=zi[kdebp1]; xq[3]=xi[kdebm1]; yq[3]=yi[kdebm1]; zq[3]=zi[kdebm1]; } else { xq[0]=xi[kdebm1]; yq[0]=yi[kdebm1]; zq[0]=zi[kdebm1]; xq[1]=pa[0] ; yq[1]=pa[1] ; zq[1]=pa[2] ; xq[2]=pb[0] ; yq[2]=pb[1] ; zq[2]=pb[2] ; xq[3]=xi[kdebp1]; yq[3]=yi[kdebp1]; zq[3]=zi[kdebp1]; } xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; for ( i=0;i<3;i++ )if ( dsign[i]< 0 ) kdeb = i ; if ( kdeb == 0 ) {seg1n1 = 2 ; seg1n2 = 0 ;seg2n1 = 0 ; seg2n2 = 1; } else if ( kdeb == 1 ) {seg1n1 = 0 ; seg1n2 = 1 ;seg2n1 = 1 ; seg2n2 = 2; } else {seg1n1 = 1 ; seg1n2 = 2 ;seg2n1 = 2 ; seg2n2 = 0; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom - epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom + epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 0) { kdebm1=2 ; kdebp1=1;} else if ( kdeb == 1 ) { kdebm1=0 ; kdebp1=2;} else { kdebm1=1 ; kdebp1=0;} diag1 = (xi[kdebp1]-pa[0])*(xi[kdebp1]-pa[0]) + (yi[kdebp1]-pa[1])*(yi[kdebp1]-pa[1]) + (zi[kdebp1]-pa[2])*(zi[kdebp1]-pa[2]) ; diag2 = (xi[kdebm1]-pb[0])*(xi[kdebm1]-pb[0]) + (yi[kdebm1]-pb[1])*(yi[kdebm1]-pb[1]) + (zi[kdebm1]-pb[2])*(zi[kdebm1]-pb[2]) ; if ( diag1 < diag2 ) { xp[0]=pa[0] ; yp[0]=pa[1] ; zp[0]=pa[2] ; xp[1]=pb[0] ; yp[1]=pb[1] ; zp[1]=pb[2] ; xp[2]=xi[kdebp1]; yp[2]=yi[kdebp1]; zp[2]=zi[kdebp1]; xp[3]=xi[kdebm1]; yp[3]=yi[kdebm1]; zp[3]=zi[kdebm1]; } else { xp[0]=xi[kdebm1]; yp[0]=yi[kdebm1]; zp[0]=zi[kdebm1]; xp[1]=pa[0] ; yp[1]=pa[1] ; zp[1]=pa[2] ; xp[2]=pb[0] ; yp[2]=pb[1] ; zp[2]=pb[2] ; xp[3]=xi[kdebp1]; yp[3]=yi[kdebp1]; zp[3]=zi[kdebp1]; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_tdqd | | Apres inversion eventuelle entre nel_i et nel_j | | Decoupage du triangle nel_i pour donner un triangle | | Decoupage du triangle nel_j pour donner deux triangles | | le parametre code_decoupe est egal a 5 ou -5 | | | |======================================================================| */ void decoupe_tdqd (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[], double zi[],double xt[],double yt[],double zt[], double xq[],double yq[],double zq[], double dsign[],int code_decoupe) { int i,kdeb,seg1n1,seg1n2,seg2n1,seg2n2,kdebm1,kdebp1; double xa,ya,za,xb,yb,zb,xc,yc,zc,da,db,dc; double xnj1,xnj2,xnj3; double denom,numer,alfa; double diag1,diag2,plac; double pa[3],pb[3]; double epsd=1e-5,epsma=1e-14,eps=1e-6; xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; if ( code_decoupe == -5 ) /* inversion des triangles */ { xa=xi[0]; ya=yi[0]; za=zi[0]; xb=xi[1]; yb=yi[1]; zb=zi[1]; xc=xi[2]; yc=yi[2]; zc=zi[2]; da=dsign[0];db=dsign[1];dc=dsign[2]; xi[0]=xi[3]; yi[0]=yi[3]; zi[0]=zi[3]; xi[1]=xi[4]; yi[1]=yi[4]; zi[1]=zi[4]; xi[2]=xi[5]; yi[2]=yi[5]; zi[2]=zi[5]; dsign[0]=dsign[3]; dsign[1]=dsign[4]; dsign[2]=dsign[5]; xi[3]=xa; yi[3]=ya; zi[3]=za; xi[4]=xb; yi[4]=yb; zi[4]=zb; xi[5]=xc; yi[5]=yc; zi[5]=zc; dsign[3]=da; dsign[4]=db; dsign[5]=dc; xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; } for ( i=3;i<6;i++ )if ( dsign[i]< -epsma ) kdeb = i ; if ( kdeb == 3 ) {seg1n1 = 5 ; seg1n2 = 3 ;seg2n1 = 3 ; seg2n2 = 4; } else if ( kdeb == 4 ) {seg1n1 = 3 ; seg1n2 = 4 ;seg2n1 = 4 ; seg2n2 = 5; } else {seg1n1 = 4 ; seg1n2 = 5 ;seg2n1 = 5 ; seg2n2 = 3; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom - epsd; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom + epsd; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 3) { kdebm1=5 ; kdebp1=4;} else if ( kdeb == 4 ) { kdebm1=3 ; kdebp1=5;} else { kdebm1=4 ; kdebp1=3;} diag1 = (xi[kdebp1]-pa[0])*(xi[kdebp1]-pa[0]) + (yi[kdebp1]-pa[1])*(yi[kdebp1]-pa[1]) + (zi[kdebp1]-pa[2])*(zi[kdebp1]-pa[2]) ; diag2 = (xi[kdebm1]-pb[0])*(xi[kdebm1]-pb[0]) + (yi[kdebm1]-pb[1])*(yi[kdebm1]-pb[1]) + (zi[kdebm1]-pb[2])*(zi[kdebm1]-pb[2]) ; if ( diag1 < diag2 ) { xq[0]=pa[0] ; yq[0]=pa[1] ; zq[0]=pa[2] ; xq[1]=pb[0] ; yq[1]=pb[1] ; zq[1]=pb[2] ; xq[2]=xi[kdebp1]; yq[2]=yi[kdebp1]; zq[2]=zi[kdebp1]; xq[3]=xi[kdebm1]; yq[3]=yi[kdebm1]; zq[3]=zi[kdebm1]; } else { xq[0]=xi[kdebm1]; yq[0]=yi[kdebm1]; zq[0]=zi[kdebm1]; xq[1]=pa[0] ; yq[1]=pa[1] ; zq[1]=pa[2] ; xq[2]=pb[0] ; yq[2]=pb[1] ; zq[2]=pb[2] ; xq[3]=xi[kdebp1]; yq[3]=yi[kdebp1]; zq[3]=zi[kdebp1]; } xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; xnj3 = xnf[nel_j+2*nel2]; plac = pland[nel_j]; if ( code_decoupe == -5 ) /* il faut penser a inverser les normales */ { xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; xnj3 = xnf[nel_i+2*nel2]; plac = pland[nel_i]; } for ( i=0;i<3;i++ )if ( dsign[i]> epsma ) kdeb = i ; if ( kdeb == 0 ) {seg1n1 = 2 ; seg1n2 = 0 ;seg2n1 = 0 ; seg2n2 = 1; } else if ( kdeb == 1 ) {seg1n1 = 0 ; seg1n2 = 1 ;seg2n1 = 1 ; seg2n2 = 2; } else {seg1n1 = 1 ; seg1n2 = 2 ;seg2n1 = 2 ; seg2n2 = 0; } denom = xnj1*(xi[seg1n2]-xi[seg1n1]) +xnj2*(yi[seg1n2]-yi[seg1n1]) +xnj3*(zi[seg1n2]-zi[seg1n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg1n1]+ xnj2*yi[seg1n1]+ xnj3*zi[seg1n1]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[seg1n1]+ alfa*(xi[seg1n2]-xi[seg1n1]); pa[1]= yi[seg1n1]+ alfa*(yi[seg1n2]-yi[seg1n1]); pa[2]= zi[seg1n1]+ alfa*(zi[seg1n2]-zi[seg1n1]); } denom = xnj1*(xi[seg2n2]-xi[seg2n1]) +xnj2*(yi[seg2n2]-yi[seg2n1]) +xnj3*(zi[seg2n2]-zi[seg2n1]); if ( abs(denom) > eps ) { numer = xnj1*xi[seg2n1]+ xnj2*yi[seg2n1]+ xnj3*zi[seg2n1]+ plac ; alfa = - numer/denom - epsd ; pb[0]= xi[seg2n1]+ alfa*(xi[seg2n2]-xi[seg2n1]); pb[1]= yi[seg2n1]+ alfa*(yi[seg2n2]-yi[seg2n1]); pb[2]= zi[seg2n1]+ alfa*(zi[seg2n2]-zi[seg2n1]); } if ( kdeb == 0) { kdebm1=2 ; kdebp1=1;} else if ( kdeb == 1 ) { kdebm1=0 ; kdebp1=2;} else { kdebm1=1 ; kdebp1=0;} if ( kdeb == 0) { kdebm1=2 ; kdebp1=1;} else if ( kdeb == 1 ) { kdebm1=0 ; kdebp1=2;} else { kdebm1=1 ; kdebp1=0;} xt[0]=pa[0]; yt[0]=pa[1]; zt[0]=pa[2]; xt[1]=xi[kdeb]; yt[1]=yi[kdeb]; zt[1]=zi[kdeb]; xt[2]=pb[0]; yt[2]=pb[1]; zt[2]=pb[2]; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | bary_cache_3d | | | |======================================================================| */ int bary_cache_3d(double xi[],double yi[],double zi[], double xn1,double yn1,double zn1) { double xg1,yg1,zg1,xg2,yg2,zg2,untier; double xgg,ygg,zgg,xn,epsi; epsi=1.E-4; untier=1./3.; xg1=(xi[0]+xi[1]+xi[2])*untier; yg1=(yi[0]+yi[1]+yi[2])*untier; zg1=(zi[0]+zi[1]+zi[2])*untier; xg2=(xi[3]+xi[4]+xi[5])*untier; yg2=(yi[3]+yi[4]+yi[5])*untier; zg2=(zi[3]+zi[4]+zi[5])*untier; xgg=xg2-xg1; ygg=yg2-yg1; zgg=zg2-zg1; xn=sqrt(xgg*xgg+ygg*ygg+zgg*zgg); xgg /=xn; ygg/=xn; zgg /=xn; if (xgg*xn1+ygg*yn1+zgg*zn1 < epsi) return(1); else return(0); } syrthes-3.4.3-dfsg1/src/s/limfso.F0000666000175000017500000003741711524070641015355 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMFSO C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NELEUS,NDMASS,NODEUS,NREFAL, * NBFFLU,NFFLUS,VFFLUS,NBDIRS,NDIRS,VDIRS,NBFECH,NFECHS,VFECHS, * NBFRAI,NFRAIS,VFRAIS,NELERC,NFRESC,VFRESC) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C (Sous-programme utilisateur) * C * C ATTENTION : * C =========== * C A l'aide de ce sous programme, il est possible d'imposer * C les conditions limites sur les faces, ce qui permet un * C "meilleur" traitement des conditions limites discontinues.* C Le cas typique ou ce traitement peut avoir un interet est * C par exemple celui du coin affecte par des conditions aux * C limites de type differentes sur chaque face, auquel cas, * C le point de coin peut etre considere comme singulier. * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFFLUS ! TE ! D ! No local de la face affecte par des flux ! C ! VFFLUS ! TR ! R ! Valeur du flux aux points de la facette ! C ! NBFFLU ! E ! R ! Nombre de facettes de type flux ! C ! NFECHS ! TE ! D ! No local de la facette avec c.l. d'echange ! C ! VFECHS ! TR ! R ! Valeur aux noeud de la face de type echange ! C ! ! ! ! VFECHS(.,..,1) = temperature exterieure ! C ! ! ! ! VFECHS(.,..,2) = coefficient d'echange ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAIS ! TE ! D ! No des facettes avec rayonnement infi ! C ! VFRAIS ! TR ! R ! Valeurs aux noeuds des faces de type ! C ! ! ! ! rayonnement infi. ! C ! ! ! ! VFRAIS(.,..,1) = temp exterieure equival ! C ! ! ! ! VFRAIS(.,..,2) = coef d'echange equival ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf ! C ! NFRESC ! TE ! D ! No des facettes avec resistance de contact ! C ! VFRESC ! TR ! R ! Valeurs des resistances aux noeuds de la face! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS,NDMASS INTEGER NBFFLU,NBDIRS,NBFECH,NELERC,NBFRAI,NELEUS INTEGER NODEUS(NELEUS,NDMASS) INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS),NREFAL(NELEUS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFFLUS(NBFFLU),NDIRS(NBDIRS),NFECHS(NBFECH) INTEGER NFRESC(NELERC),NFRAIS(NBFRAI) DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VDIRS(NBDIRS) DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) C C.. Variables internes INTEGER N,J,NUMFA,NUMREF,NNGLOB DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFFLU C C Numero global de la facette de bord CUTI NUMFA = NFFLUS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D C CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NNGLOB) C C Si la face porte la reference 3, le flux sur les neuds de C la face vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFFLUS(N,J) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N,J) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Exemple ... C CUTI DO N=1,NBDIRS C C On rappelle que les conditions de Dirichlet affecte des noeuds C et non pas des faces. C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C C Si le noeud porte la reference 3, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFECH C C Numero global de la facette de bord CUTI NUMFA = NFECHS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 et le coefficient d'echange de 10, C sinon, la temperature exterieure est de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VFECHS(N,J,1) = 20.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ELSE CUTI VFECHS(N,J,1) = 40.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Exemple ... C CUTI DO N=1,NELERC C C Numero global de la facette de bord CUTI NUMFA = NFRESC(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C C Si le noeud porte la reference 4 on a une resistance C de contact de 100. sinon de 1. (mauvaise transmission) C C CUTI IF (NUMREF.EQ.4) THEN CUTI VFRESC(N,J,2) = 100.0D0 CUTI ELSE CUTI VFRESC(N,J,2) = 1.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFRAI C C Numero global de la facette de bord CUTI NUMFA = NFRAIS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 C et l'emissivite de 0.8, C sinon, la temperature exterieure est de 10 C et epsilon 0.9 C CUTI IF (NUMREF.EQ.6) THEN CUTI VFRAIS(N,J,1) = 20.0D0 CUTI VFRAIS(N,J,2) = 0.8D0 CUTI ELSE CUTI VFRAIS(N,J,1) = 10.0D0 CUTI VFRAIS(N,J,2) = 0.9D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C CC C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFFLU.GT.0 .OR. NBDIRS.GT.0 .OR. NBFECH.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF C C Impression des flux IF (NBFFLU.GT.0) THEN WRITE(NFECRA,5010) DO 5051 N=1,NBFFLU DO 5052 J=1,NDMASS WRITE(NFECRA,5050) NFFLUS(N),VFFLUS(N,J) 5052 CONTINUE 5051 CONTINUE ENDIF C C Impression des Dirichlets IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF C C Impression des conditions d'echange IF (NBFECH.GT.0) THEN WRITE(NFECRA,5030) DO 5061 N=1,NBFECH DO 5062 J=1,NDMASS WRITE(NFECRA,5060) & NFECHS(N),VFECHS(N,J,1),VFECHS(N,J,2) 5062 CONTINUE 5061 CONTINUE ENDIF C C Impression des conditions de rayonnement infini IF (NBFRAI.GT.0) THEN WRITE(NFECRA,5040) DO 5071 N=1,NBFRAI DO 5072 J=1,NDMASS WRITE(NFECRA,5060) & NFRAIS(N),J,VFRAIS(N,J,1),VFRAIS(N,J,2) 5072 CONTINUE 5071 CONTINUE ENDIF C C Impression des conditions de resistance de contact IF (NELERC.GT.0) THEN WRITE(NFECRA,5045) DO 5081 N=1,NELERC DO 5082 J=1,NDMASS WRITE(NFECRA,5060) & NFRESC(N),J,VFRESC(N,J,2) 5082 CONTINUE 5081 CONTINUE ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMFSO : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMFSO : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux', & ' (face, noeud, flux)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange', & ' (face, noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement inifni', & ' (face, noeud, Tnoir, sigma)') 5045 FORMAT(/,' - Condition de type resistance', & ' (face, noeud, resistance)') 5050 FORMAT('(',I6,'-',I2,'-',G10.3,')') 5060 FORMAT(I6,'--',I2,'--',G10.3,'--',G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/dicora.F0000666000175000017500000001700111524070641015310 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE DICORA C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- VERIFICATION ORTHOGRAPHIQUE DU FICHIER DE DONNEES * C On verifie la reconnaissance des mots-cles) * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! R ! ! C !/NLOFCT/! ! D ! ! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : POSCOT C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISO1 C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "syrth.h" #include "nlofct.h" C C********************************************************************** C C INTEGER I1,I2,LCH LOGICAL ERR CHARACTER*200 CHAINE C C********************************************************************** C C 0- INITIALISATIONS C ================== C REWIND(NFCLRA) ERR = .FALSE. C C 1- LECTURE DU FICHIER C ===================== C C 10 CONTINUE C CHAINE = ' ' READ(NFCLRA,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) GOTO 10 C C C 2- COMPARAISON AVEC LES MOTS-CLES AUTORISES C ------------------------------------------- C IF (CHAINE(I1:I2).EQ. * 'PAS DES SORTIES CHRONO RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'STOCKAGE DES FACTEURS DE FORME SUR FICHIER=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'LECTURE DES FACTEURS DE FORME SUR FICHIER=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'STOCKAGE DES CORRESPONDANTS POUR RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'LECTURE DES CORRESPONDANTS POUR RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'NOMBRE DE PLANS DE SYMETRIE POUR LE RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'NOMBRE DE BANDES SPECTRALES POUR LE RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'PERIODICITE DE ROTATION POUR LE RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'NOMBRE DE REDECOUPAGES POUR CALCUL DES FACTEURS DE FORME=') * THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'NIVEAU DES IMPRESSIONS POUR LE RAYONNEMENT=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. * 'DOMAINE DE RAYONNEMENT CONFINE OUVERT SUR L EXTERIEUR=') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. 'HISTORIQUES RAYONNEMENT=') THEN GOTO 10 C C 3- COMPARAISON AVEC LES TYPES DE REFERENCES AUTORISEES C ------------------------------------------------------ C ELSEIF (CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS FLUIDES PAROI EQUIVALENTE') & THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT CONFINE') & THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES COUPLEES AU SOLIDE') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE '// & 'COUPLEES AU FLUIDE') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES TEMPERATURE IMPOSEE') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES FLUX IMPOSE') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2).EQ. & 'RAYONNEMENT : REFERENCES FACES PAROI EQUIVALENTE') THEN GOTO 10 C C C 3- COMPARAISON AVEC LES TYPES CONDITIONS AUTORISEES C --------------------------------------------------- C ELSEIF (CHAINE(I1:I2) .EQ. 'RAYT') THEN GOTO 10 C ELSEIF (CHAINE(I1:I2) .EQ. 'HISTORIQUES') THEN GOTO 10 C C ELSEIF (CHAINE(I1:I2) .EQ. 'MSTS') THEN GOTO 10 C C 5- MOT-CLE NON RECONNU C ---------------------- C ELSE ERR = .TRUE. WRITE (NFECRA,5000) CHAINE GOTO 10 C ENDIF C 999 CONTINUE C IF (ERR) STOP C C C-------- C FORMATS C-------- 1000 FORMAT(A200) 5000 FORMAT(/,' %% ERREUR DICORA : MOT-CLE NON RECONNU ',/, & '--> "',A,'"') C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/lrasy2.F0000666000175000017500000001225611524070641015272 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRASY2 C ***************** C C -------------------------------- *(NDIM,NPOINR,NELRAY,IREF,INOEUD) C -------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE SYRTHES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY,IREF(NELRAY),INOEUD(NELRAY*NDIM) C C.. Variables internes INTEGER I,J,N1,NBNO,IERR CHARACTER CH*80 C C*********************************************************************** C C 1- INITIALISATIONS C ================== C NBNO = NDIM C C 2- NOMBRE DE NOEUDS ET D'ELEMENTS C ================================= C REWIND(NFSGRA) READ(NFSGRA,1000) CH,CH,CH,CH READ(NFSGRA,1001) CH READ(NFSGRA,1001) CH READ(NFSGRA,1001) CH C C 4- TABLE DES ELEMENTS C ===================== C C 4.1- Recherche de la rubrique contenant la table des noeuds C ----------------------------------------------------------- IERR = 0 CALL SECGRF(NFSGRA,'C$ RUBRIQUE = ELEMENTS',22,IERR) IF (IERR.NE.0) THEN WRITE(NFECRA,4100) STOP ENDIF C C C 4.2- Lecture des elements C ------------------------- C DO I=1,NELRAY READ(NFSGRA,4200) N1,IREF(I), & (INOEUD((J-1)*NELRAY+I),J=1,NBNO) ENDDO C C C-------- C FORMATS C-------- C 1000 FORMAT(A80,/,A80,/,A80,/,A80) 1001 FORMAT(A80) C 4100 FORMAT(//,' *** LRASY2 : LE FICHIER GEOMETRIQUE NE CONTIENT ', & 'PAS LA TABLE DES ELEMENTS') 4200 FORMAT(I10,I3,3I10) C END syrthes-3.4.3-dfsg1/src/s/lecsy1.F0000666000175000017500000001151411524070641015252 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECSY1 C ***************** C C --------------- *(NPOINS,NELEMS) C --------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE SYRTHES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "optct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NELEMS C C.. Variables internes INTEGER LCH CHARACTER CH*80,FORMA*80 C C*********************************************************************** C C 1- NOMBRE DE NOEUDS ET D'ELEMENTS C ================================= C REWIND(NFSGCT) READ(NFSGCT,1000) CH,CH,CH,CH C READ(NFSGCT,1001) CH CALL CHFORM ('I',CH(22:),LCH,1,FORMA) READ(CH(22:),FORMA) NPOINS C READ(NFSGCT,1001) CH CALL CHFORM ('I',CH(23:),LCH,1,FORMA) READ(CH(23:),FORMA) NELEMS C IF (LSDEPL) THEN NPOINS = NPOINS / 2 NELEMS = NELEMS / 2 ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(A80,/,A80,/,A80,/,A80) 1001 FORMAT(A80) C END syrthes-3.4.3-dfsg1/src/s/calfdf_2d.c0000666000175000017500000007477011524070641015730 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" int ss_seg[2][2] = { {0,2}, {2,1} }; int nsp; double taille_boite,taille_seg; /* extern int nsp; */ /* variable globale (non xterne) definie dans calfdf_3d.c */ /* extern double taille_boite,taille_seg; */ /* idem */ /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cfdf2d | | Gestion du calcul des facteurs de forme en dimension 2 | |======================================================================| */ proc(void cfdf2d,void CFDF2D) (int *ndim,int *nelray,int *npoinr,int *nodray, double *cooray,double *sufray,double *fdf, int *nplasy,double *plasym, int *nperay,double *perray,int *ndecoup_max, int *nrfray,double *pvinter,int *numgu,int *ngumax,int *nblblr) { int i,n2; int faces_cachees ; double Pi ; int *nod2,nel2,npoin2; double *coo2,*xnf2,xmult,*xnfray; int *grconv, *grconv2; int imult; dimension_2d(*ndim,*nelray,*npoinr,nodray,cooray, &taille_boite,&taille_seg); imult = 0; xmult = 1.; if(taille_seg < 0.01 || taille_seg > 10) { imult = 1; if (taille_seg < 0.01) xmult = 0.1/taille_seg; if (taille_seg > 10 ) xmult = 1/taille_seg; if(*nblblr >= 10) printf("Facteur multiplicatif interne xmult= %f \n",xmult); for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) *= xmult ; taille_boite *= xmult; taille_seg *= xmult; for(i=0;i<3**ngumax;i++) *(pvinter+i)*=xmult; for(i=0;i<3;i++) *(perray+i)*=xmult; for(i=0;i<*nplasy;i++) plasym[i*4+2]*=xmult; } grconv = (int *)malloc( *nelray * sizeof(int) ); if (grconv==NULL) {printf(" ERREUR cfdf2d : probleme d'allocation memoire\n"); exit(0);} orie2d(nodray,*nelray,*npoinr,nrfray,cooray,pvinter,*numgu,*ndim,*nblblr, grconv); Pi = 3.141592653589793; surface_seg (*nelray,*npoinr,nodray,cooray,sufray); xnfray=(double*)malloc(*nelray * 2 * sizeof(double)); if (xnfray==NULL) {printf(" ERREUR cfdf2d : probleme d'allocation memoire\n"); exit(0);} cnor_2d(*ndim,*nelray,*npoinr,nodray,cooray,xnfray); if (*nplasy != 0 && *nperay == 0) { n2=1; if (*nplasy==1){n2=2;} else if (*nplasy==2){n2=4;} /* n2=(int)(pow(2.,*nplasy)+0.1);*/ nod2=(int*)malloc(n2 * *nelray * 2 * sizeof(int)); coo2=(double*)malloc(n2 * *npoinr * 2 * sizeof(double)); xnf2=(double*)malloc(n2 * *nelray * 2 * sizeof(double)); grconv2=(int*)malloc(n2 * *nelray * sizeof(int)); if (n2==0 || nod2==NULL || coo2==NULL || xnf2==NULL || grconv2==NULL ) {printf(" ERREUR cfdf2d : probleme d'allocation memoire\n"); exit(0);} dupliq2d_sym(*nplasy,plasym, *npoinr,*nelray,nodray,cooray,xnfray, &nel2,&npoin2,nod2,coo2,xnf2,grconv,grconv2); } else if (*nperay > 0) { n2=1; if (*nplasy==0){n2=*nperay;} else if (*nplasy==1){n2=*nperay*2;} else if (*nplasy==2){n2=*nperay*4;} /* n2=(int)(*nperay*pow(2.,*nplasy)+0.1); */ nod2=(int*)malloc(n2 * *nelray * 2 * sizeof(int)); coo2=(double*)malloc(n2 * *npoinr * 2 * sizeof(double)); xnf2=(double*)malloc(n2 * *nelray * 2 * sizeof(double)); grconv2=(int*)malloc(n2 * *nelray * sizeof(int)); if (n2==0 || nod2==NULL || coo2==NULL || xnf2==NULL || grconv2==NULL ) {printf(" ERREUR cfdf2d : probleme d'allocation memoire\n"); exit(0);} dupliq2d_per(*nplasy,plasym,*nperay,perray, *npoinr,*nelray,nodray,cooray,xnfray, &nel2,&npoin2,nod2,coo2,xnf2,grconv,grconv2); } if ( *nperay == 0 ) { if (*nplasy==0) nsp=1; else if (*nplasy==1) nsp=2; else if (*nplasy==2) nsp=4; } else { if (*nplasy==0) nsp=*nperay; else if (*nplasy==1) nsp=*nperay*2; else if (*nplasy==2) nsp=*nperay*4; } if (*nplasy == 0 && *nperay == 0) facecache_2d(*ndim,*npoinr,*nelray,*nelray,nodray,cooray,xnfray,&faces_cachees, *nplasy,*nperay) ; else facecache_2d(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,&faces_cachees, *nplasy,*nperay) ; if (*nplasy == 0 && *nperay == 0) { coo2=(double*)malloc(*npoinr * 2 * sizeof(double)); if (coo2==NULL) {printf(" ERREUR cfdf2d : probleme d'allocation memoire\n"); exit(0);} for (i=0;i<*npoinr;i++) { *(coo2+i) = *(cooray+i); *(coo2+i+*npoinr) = *(cooray+i+*npoinr); } } if (faces_cachees) { if (*nplasy == 0 && *nperay == 0) { box_2d(*npoinr,coo2); cnor_2d(*ndim,*nelray,*npoinr,nodray,coo2,xnfray); } else { box_2d(npoin2,coo2); cnor_2d(*ndim,nel2,npoin2,nod2,coo2,xnf2); } } if (*nplasy == 0 && *nperay == 0) if (!faces_cachees) facforme_2d(*ndim,*npoinr,*nelray,*nelray,nodray,cooray,xnfray,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv,*nblblr); else facforme_2d(*ndim,*npoinr,*nelray,*nelray,nodray,coo2,xnfray,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv,*nblblr); else facforme_2d(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv2,*nblblr); free(xnfray);free(grconv); if (*nplasy != 0 || *nperay != 0) {free(coo2); free(nod2); free(xnf2);free(grconv2); } if (*nplasy == 0 && *nperay == 0 && faces_cachees) {free(coo2); } if(imult) { for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) /= xmult ; for (i=0;i< *nelray ;i++) *(sufray+i) /= xmult; for (i=0 ; i<*nelray*(*nelray+1)/2 ; i++ ) *(fdf+i) /= xmult; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | facforme_2d | | calcul des facteurs de forme en dimension 2 | |======================================================================| */ void facforme_2d(int ndim, int npoin,int nel2,int nel, int *nod,double *coord,double *xnf,double *fdf,double *sufray, int *faces_cachees,int nplasy,int nperay,int ndecoup_max, int *grconv, int nblblr) { int i,j,k,npoin2,ns,ideb; int noeud[6],prem,ndecoup; int *voir; int codem10,code0,code1,codem1,code2,codem2,codem6; int nbfcoplanaire,code_decoupe; double xi[4],yi[4],fforme,*pland; double xn1,yn1,x,y,size_min,dim_boite[4],dsign[4]; double Pi; struct node *arbre; double titi1, titi2; int ncomplique; double total_fac,pourcent,pourcent_ecrit; /* Initialisations --------------- */ Pi = 3.141592653589793; npoin2 = npoin*2; nbfcoplanaire = 0 ; codem10 = 0; code0 = 0; code1 = 0; codem1 = 0; code2 = 0; codem2 = 0; codem6 = 0; ncomplique = 0; pland = (double*)malloc( nel2 * sizeof(double)); if (pland==NULL) {printf(" ERREUR facforme_2d : probleme d'allocation memoire\n"); exit(0);} for (i=0 ; i=10) printf(" *** FACFORME_2D : ns=%d facette i=%d \n",ns+1,i+1); pourcent=(ns+1)*i/total_fac; if (pourcent>pourcent_ecrit) { printf(" %5.2f %% du calcul effectue\n",pourcent_ecrit*100); pourcent_ecrit += 0.1; } xn1 = xnf[i]; yn1 = xnf[i+ nel2]; noeud[0] = nod[i]; noeud[1] = nod[i+ nel2]; for (j=ideb+i ; j-0.1) { nbfcoplanaire += 1; /* printf(" >>> calfdf : %d %d sont coplanaires fforme= %f \n",i+1,j+1,fforme);*/ } if (fforme<-1.) { noeud[2] = nod[j]; noeud[3] = nod[j+ nel2]; for (k=0;k<4;k++) { xi[k] = coord[noeud[k]-1]; yi[k] = coord[noeud[k]-1+ npoin]; } fforme=0.; if (!*faces_cachees) proc(cont2d,CONT2D)(xi,yi,&fforme); else { derriere_2d(nel2,i,j,xnf,pland,xi,yi,dsign,&code_decoupe) ; prem=1; fforme=0; ndecoup=0; if (code_decoupe == -10) /* les faces sont derrieres */ { codem10 += 1; fforme = 0; } else if (code_decoupe == 0) /* les faces se voient potentiellement */ { code0 += 1; segfdf (arbre,size_min,dim_boite,&prem,xi,yi, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } else if (abs(code_decoupe) == 1 || abs(code_decoupe)==2 ) { if (code_decoupe==1) code1 += 1; else if(code_decoupe==-1) codem1 += 1; else if(code_decoupe==2 ) code2 += 1; else codem2 += 1; decoupe_seg(nel2,i,j,xnf,pland,xi,yi,dsign,code_decoupe); segfdf (arbre,size_min,dim_boite,&prem,xi,yi, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } else if ( code_decoupe == -6 ) { codem6 += 1;} } /* else faces_cachees */ } /* if (fforme<-1.) les faces ne sont pas coplanaires */ if(fforme < 0.) { if (nblblr >= 11) printf(" fforme negatif ns%d i %d j %d fdf= %f\n",ns,i+1,j+1,1e6*fforme); } else fdf[i*nel-(i+1)*i/2+j%nel] += fforme; /* printf("i+1,j+1 %d %d fdf %f\n",i+1,j+1,fforme*1.e6); */ titi1 += fforme; } /* for (j=ideb+i ; jname,noeud_arr->name); */ ivoitj_2d(arbre,noeud_dep,noeud_arr,ro,rd,pt_arr, &intersect,size_min, nel2,npoin,nod,coord,&arrivee,dim_boite); /* printf(">>> calfdf k l %d %d inter %d\n",k,l,intersect); */ if (!intersect) ok += 1; } /* 2- En fonction du resultat -------------------------- */ /* si ok=0 => faces non visibles, on ne rajoute rien a fforme */ if ( 0 < ok && ok < 4 ) *ncomplique += 1; /* printf(">> facforme_2d : ok final =%d\n",ok); */ if (ok!=0) { proc(cont2d,CONT2D)(xi,yi,&fdf); /* printf(">> facforme_2d : estimation fdf =%f\n",fdf*1.E6); */ if (ok==4) {*fforme += fdf; } else if (*ndecoup>=ndecoup_max) { *fforme = *fforme + (fdf*ok/4.); } else { nd=*ndecoup+1; xp[0]=xi[0]; yp[0]=yi[0]; xp[1]=xi[1]; yp[1]=yi[1]; xp[2]=(xi[0]+xi[1])/2 ; yp[2]=(yi[0]+yi[1])/2.; xq[0]=xi[2]; yq[0]=yi[2]; xq[1]=xi[3]; yq[1]=yi[3]; xq[2]=(xi[2]+xi[3])/2 ; yq[2]=(yi[2]+yi[3])/2.; for (k=0;k<2;k++) for (l=0;l<2;l++) { xi[0]=xp[ss_seg[k][0]]; yi[0]=yp[ss_seg[k][0]]; xi[1]=xp[ss_seg[k][1]]; yi[1]=yp[ss_seg[k][1]]; xi[2]=xq[ss_seg[l][0]]; yi[2]=yq[ss_seg[l][0]]; xi[3]=xq[ss_seg[l][1]]; yi[3]=yq[ss_seg[l][1]]; segfdf (arbre,size_min,dim_boite,prem,xi,yi, noeud,voir,nel2,npoin,nod,coord, &nd,fforme,ncomplique,ndecoup_max); } (*ndecoup)++; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | dupliq2d_per | | Dupliquer le maillage pour le traitement de la periodicite | | avec eventuellement un plan de symetrie orthogonal a l'axe | | definissant la periodicite de rotation | |======================================================================| */ void dupliq2d_per(int nplasy,double *plasym,int nperay,double *perray, int npoinr,int nelray,int *nodray, double *cooray,double *xnfray, int *nel2,int *npoin2,int *nod2,double *coo2,double *xnf2, int *grconv, int *grconv2) { int i,n,idebnel,idebnp,numper,inverse; double t[3][3]; double Pi; double px,py,alfa,angle,x,y; Pi = 3.141592653589793; if (nplasy==0) { *nel2=nperay*nelray; *npoin2=nperay*npoinr; } else if (nplasy==1) { *nel2=nperay*2*nelray; *npoin2=nperay*2*npoinr; } else if (nplasy==2) { *nel2=nperay*4*nelray; *npoin2=nperay*4*npoinr; } else { printf("en 2D, 3 plans de symetrie sont impossibles\n"); exit(0); } for (i=0;i>> CONT2D : Facteur de forme = ',E16.9) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/limfnu.F0000666000175000017500000004102511524070641015344 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMFNU C ***************** C C ----------------------------------------------------- * (NCOUPS,NBCOUS,NFCOUS,NELESS,NFFLUS,NBFFLU,NDIRS,NBDIRS, * NFECHS,NBFECH,NRESCS,NBRESS,NFRESC,NELERC, * NRAYTS,NBRAYS,NFRAYS,NELERA,NFRAIS,NBFRAI, * NPRIOS,NBPRIO,NMOBIL,NBMOBS,NBCOPR,NREFS, * NPOINS,NDIELE,NELEUS,NDMASS,NODEUS, * NREFAL,ITRAV1,ITRAV2) C ----------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA NUMEROTATION LOCALE DES NOEUDS * C PORTANT DES CONDITIONS AUX LIMITES DIFFERENTES * C ET DES NOEUDS PORTANT UN FLUX VOLUMIQUE * C * C Cas des conditions aux limites traitees par face * C * C CAS DU MODELE GENERAL * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NCOUPS ! TE ! R ! Numero des noeuds solides couples ! C ! NBCOUS ! E ! D ! Nombre de noeuds solides couples ! C ! NFCOUS ! TE ! R ! Numero des faces solides couples ! C ! NELESS ! E ! D ! Nombre de faces solides couples ! C ! NFFLUS ! TE ! R ! Numero des faces portant une C.L. de flux ! C ! NBBFLU ! E ! D ! Nombre de faces portant une C.L. de flux ! C ! NDIRS ! TE ! R ! Numero des noeuds portant une C.L. Dirichlet ! C ! NBDIRS ! E ! D ! Nombre de noeuds portant une C.L. Dirichlet ! C ! NBECHS ! TE ! R ! Numero des faces avec C.L. coeff echange ! C ! NBBECH ! E ! D ! Nombre de faces avec C.L. coeff echange ! C ! NFRAYS ! TE ! R ! Numero des noeuds avec rayonnement confine ! C ! NFRAYS ! TE ! R ! Numero des faces avec rayonnement confine ! C ! NELERA ! E ! D ! Nombre de faces avec rayonnement confine ! C ! NFRAIS ! TE ! R ! Numero des faces avec rayonnement infini ! C ! NBFRAI ! E ! D ! Nombre de faces avec rayonnement infini ! C ! NFRESC ! TE ! R ! Numero des faces avec resistance de contact ! C ! NELERC ! E ! D ! Nombre de faces avec resistance de contact ! C ! NPRIOS ! TE ! R ! Numero des noeuds periodiques ! C ! NBPRIO ! E ! D ! Nombre de noeuds periodiques ! C ! NMOBIL ! TE ! R ! Numero des noeuds en mouvement ! C ! NBMOBS ! E ! D ! Nombre de noeuds en mouvement ! C ! NBCOPR ! E ! D ! NBRE DE CORREPONDANTS POUR LES NOEUDS PERIOD ! C ! NREFS ! TE ! D ! References des noeuds solides ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! NDIELE ! E ! D ! Dimension des elements ! C ! NELEUS ! E ! D ! Nombre d'elements surf avec flux ! C ! NDMASS ! E ! D ! Nombre de noeuds des elements surfaciques ! C ! NODEUS ! TE ! D ! Table des elements avec flux ! C ! ITRAV1,2 ! TE ! A ! Tableaux de travail ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIELE,NBCOUS,NELESS,NBFFLU,NBDIRS,NBFECH INTEGER NELERC,NBRESS,NBCOPR,NBPRIO,NBMOBS INTEGER NBRAYS,NELERA,NBFRAI INTEGER NELEUS INTEGER NCOUPS(NBCOUS),NFCOUS(NELESS),NFFLUS(NBFFLU) INTEGER NDIRS(NBDIRS),NFECHS(NBFECH) INTEGER NRAYTS(NBRAYS),NFRAYS(NELERA),NFRAIS(NBFRAI) INTEGER NMOBIL(NBMOBS,2) INTEGER NRESCS(NBRESS,2),NFRESC(NELERC) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NPOINS,NREFS(NPOINS),NREFAL(NELEUS) INTEGER NDMASS,NODEUS(NELEUS,NDMASS) INTEGER ITRAV1(NPOINS),ITRAV2(NPOINS) C C.. Variables internes INTEGER NUMREF,N,N1,NUM,NBFACE,M INTEGER NCOU,NDIR,NRES,NPR,NMOB INTEGER NFC,NFF,NFE,NFR,NFA,NBP,NFI,NRA LOGICAL ERR C C*********************************************************************** C C C 1- INITIALISATIONS C ================== C DO 1 N=1,NBCOUS NCOUPS(N) = 0 1 CONTINUE C DO 2 N=1,NELESS NFCOUS(N) = 0 2 CONTINUE C DO 3 N=1,NBFFLU NFFLUS(N) = 0 3 CONTINUE C DO 4 N=1,NBDIRS NDIRS(N) = 0 4 CONTINUE C DO 5 N=1,NBFECH NFECHS(N) = 0 5 CONTINUE C DO 7 N=1,NBRESS*2 NRESCS(N,1) = 0 7 CONTINUE C DO 8 N=1,NELERC NRESCS(N,1) = 0 8 CONTINUE C DO 9 N=1,NELERA NFRAYS(N) = 0 9 CONTINUE C DO 91 N=1,NBFRAI NFRAIS(N) = 0 91 CONTINUE C DO 10 N=1,NBPRIO*(1+NBCOPR) NPRIOS(N,1) = 0 10 CONTINUE C DO 11 N=1,NBMOBS*2 NMOBIL(N,1) = 0 11 CONTINUE C DO 12 N=1,NPOINS ITRAV1(N) = 0 ITRAV2(N) = 0 12 CONTINUE C C C Nombre de noeuds par face IF (NDIELE.EQ.2) THEN NBP = 3 NBFACE = 3 ELSE NBP = 6 NBFACE = 4 ENDIF C C NCOU = 0 NFC = 0 NFF = 0 NFE = 0 NDIR = 0 NRES = 0 NFR = 0 NFI = 0 NFA = 0 NRA = 0 NPR = 0 NMOB = 0 C C C C 2- COMPTE DES NOEUDS SUIVANT LES CL C =================================== C C DO 200 N=1,NPOINS C NUMREF = ABS(NREFS(N)) C DO 210 N1=1,NRFMAX C IF (IREFSD(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NDIR = NDIR + 1 NDIRS(NDIR) = N ENDIF C IF (IREFPR(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NPR = NPR + 1 NPRIOS(NPR,1) = N ENDIF C IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NMOB = NMOB + 1 NMOBIL(NMOB,1) = N ENDIF C 210 CONTINUE 200 CONTINUE C C C 3.1- COMPTE DES FACES (ET EVENT NOEUD) SUIVANT LES CL C ===================================================== DO 300 N=1,NELEUS C NUMREF = NREFAL(N) C DO 320 N1=1,NRFMAX C IF (IREFSC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFC = NFC + 1 NFCOUS(NFC) = N DO 321 M=1,NBP NUM = NODEUS(N,M) IF (ITRAV1(NUM).LE.0) THEN NCOU = NCOU + 1 NCOUPS(NCOU) = NUM ITRAV1(NUM) = 1 ENDIF 321 CONTINUE ENDIF C IF (IREFSF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFF = NFF + 1 NFFLUS(NFF) = N ENDIF C IF (IREFSE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFE = NFE + 1 NFECHS(NFE) = N ENDIF C IF (IREFRE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFR = NFR + 1 NFRESC(NFR) = N DO 322 M=1,NBP NUM = NODEUS(N,M) IF (ITRAV2(NUM).LE.0) THEN NRES = NRES + 1 NRESCS(NRES,1) = NUM ITRAV2(NUM) = 1 ENDIF 322 CONTINUE ENDIF C 320 CONTINUE 300 CONTINUE C C C 3.2- COMPTE DES FACES (ET EVENT NOEUD) POUR LE RAYONNEMENT C ======================================================== DO 32 N=1,NPOINS ITRAV1(N) = 0 32 CONTINUE DO 330 N=1,NELEUS C NUMREF = NREFAL(N) C DO 340 N1=1,NRFMAX C IF (IREFRA(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFA = NFA + 1 NFRAYS(NFA) = N DO 341 M=1,NBP NUM = NODEUS(N,M) IF (ITRAV1(NUM).LE.0) THEN NRA = NRA + 1 NRAYTS(NRA) = NUM ITRAV1(NUM) = 1 ENDIF 341 CONTINUE ENDIF C IF (IREFRI(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFI = NFI + 1 NFRAIS(NFI) = N ENDIF C 340 CONTINUE 330 CONTINUE C C C 4- CONTROLE DES DIMENSIONS C ========================== C ERR = .FALSE. C IF (NCOU.NE.NBCOUS) THEN WRITE(NFECRA,4000) 'noeuds couples',NCOU,NBCOUS ERR = .TRUE. ENDIF IF (NDIR.NE.NBDIRS) THEN WRITE(NFECRA,4000) 'noeuds Dirichlet',NDIR,NBDIRS ERR = .TRUE. ENDIF IF (NRES.NE.NBRESS) THEN WRITE(NFECRA,4000) 'noeuds avec resistance de contact', & NRES,NBRESS ERR = .TRUE. ENDIF IF (NPR .NE.NBPRIO) THEN WRITE(NFECRA,4000) 'noeuds periodiques',NPR ,NBPRIO ERR = .TRUE. ENDIF IF (NMOB.NE.NBMOBS) THEN WRITE(NFECRA,4000) 'noeuds en mouvement',NMOB ,NBMOBS ERR = .TRUE. ENDIF C C IF (NFC.NE.NELESS) THEN WRITE(NFECRA,4000) 'faces couplees',NFC,NELESS ERR = .TRUE. ENDIF IF (NFF.NE.NBFFLU) THEN WRITE(NFECRA,4000) 'faces avec flux',NFF,NBFFLU ERR = .TRUE. ENDIF IF (NFE.NE.NBFECH) THEN WRITE(NFECRA,4000) 'faces avec coefficient d''echange', & NFE,NBFECH ERR = .TRUE. ENDIF IF (NFR.NE.NELERC) THEN WRITE(NFECRA,4000) 'faces avec resit de contact',NFR,NELERC ERR = .TRUE. ENDIF IF (NFA.NE.NELERA) THEN WRITE(NFECRA,4000) 'faces avec rayonnement confine', * NFA,NELERA ERR = .TRUE. ENDIF IF (NFI.NE.NBFRAI) THEN WRITE(NFECRA,4000) 'faces avec rayonnement infini', * NFI,NBFRAI ERR = .TRUE. ENDIF C C C C 5- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) * WRITE(NFECRA,5000) NBCOUS,NELESS,NBFFLU,NBDIRS, * NBFECH,NBRAYS,NELERA,NBFRAI, * NELERC,NBRESS,NBPRIO,NBMOBS C IF (NBLBLA.EQ.10) THEN IF (NBCOUS.GT.0) THEN WRITE(NFECRA,5010) WRITE(NFECRA,5001) (NCOUPS(N),N=1,NBCOUS) ENDIF IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5001) (NDIRS(N),N=1,NBDIRS) ENDIF IF (NBRESS.GT.0) THEN WRITE(NFECRA,5040) WRITE(NFECRA,5001) (NRESCS(N,1),N=1,NBRESS) ENDIF IF (NBPRIO.GT.0) THEN WRITE(NFECRA,5050) WRITE(NFECRA,5001) (NPRIOS(N,1),N=1,NBPRIO) ENDIF IF (NBMOBS.GT.0) THEN WRITE(NFECRA,5060) WRITE(NFECRA,5001) (NMOBIL(N,1),N=1,NBMOBS) ENDIF IF (NBRAYS.GT.0) THEN WRITE(NFECRA,5070) WRITE(NFECRA,5001) (NRAYTS(N),N=1,NBRAYS) ENDIF C C IF (NELESS.GT.0) THEN WRITE(NFECRA,5110) WRITE(NFECRA,5001) (NFCOUS(N),N=1,NELESS) ENDIF IF (NBFFLU.GT.0) THEN WRITE(NFECRA,5120) WRITE(NFECRA,5001) (NFFLUS(N),N=1,NBFFLU) ENDIF IF (NBFECH.GT.0) THEN WRITE(NFECRA,5130) WRITE(NFECRA,5001) (NFECHS(N),N=1,NBFECH) ENDIF IF (NELERC.GT.0) THEN WRITE(NFECRA,5140) WRITE(NFECRA,5001) (NFRESC(N),N=1,NELERC) ENDIF IF (NELERA.GT.0) THEN WRITE(NFECRA,5150) WRITE(NFECRA,5001) (NFRAYS(N),N=1,NELERA) ENDIF IF (NBFRAI.GT.0) THEN WRITE(NFECRA,5160) WRITE(NFECRA,5001) (NFRAIS(N),N=1,NBFRAI) ENDIF ENDIF C C 6- ARRET DU PROGRAMME EN CAS D'ERREUR DE DIMENSION C ================================================== IF (ERR) STOP C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMFNU : Solide, nombre de ...:',/, & 8X,'- noeuds couples avec le fluide',23X,I10,/, & 8X,'- faces couplees avec le fluide',23X,I10,/, & 8X,'- faces avec condition de type flux',19X,I10,/, & 8X,'- noeuds avec condition de Dirichlet',18X,I10,/, & 8X,'- faces avec condition de type coefficient', & ' d''echange ',I10,/, & 8X,'- noeuds avec rayonnement confine',21X,I10,/, & 8X,'- faces avec rayonnement confine',22X,I10,/, & 8X,'- faces avec rayonnement infini',23X,I10,/, & 8X,'- faces avec resistance de contact',20X,I10,/, & 8X,'- noeuds avec resistance de contact',19X,I10,/, & 8X,'- noeuds periodiques',34X,I10,/, & 8X,'- noeuds en mouvement',33X,I10) C 4000 FORMAT(/,' %% ERREUR LIMFNU : incoherence sur les ',A,/, & ' On en compte :',I9,/, & ' Il y en a ',I9,' de declare(e)s') 5001 FORMAT(8X,12I10) 5010 FORMAT(/,8X,'Liste des noeuds solides couples :',/) 5020 FORMAT(/,8X,'Liste des noeuds solides avec Dirichlet :',/) 5040 FORMAT(/,8X,'Liste des noeuds solides avec ', & 'resistance de contact :',/) 5050 FORMAT(/,8X,'Liste des noeuds solides periodiques :',/) 5060 FORMAT(/,8X,'Liste des noeuds solides en mouvement :',/) 5070 FORMAT(/,8X,'Liste des noeuds avec rayonnement confine :',/) C 5110 FORMAT(/,8X,'Liste des faces solides couplees :',/) 5120 FORMAT(/,8X,'Liste des faces solides avec flux :',/) 5130 FORMAT(/,8X,'Liste des faces solides avec coefficient', & ' d''echange :',/) 5140 FORMAT(/,8X,'Liste des faces solides avec resistance', & ' de contact :',/) 5150 FORMAT(/,8X,'Liste des faces solides avec rayonnement confine') 5160 FORMAT(/,8X,'Liste des faces solides avec rayonnement infini') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/solray.F0000666000175000017500000001204611524070641015364 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SOLRAY,SSI=0 SUBROUTINE SOLRAY C ***************** C C --------------------------------------- * (NDIM,NPOINS,TMPS,NBRAYS,NRAYTS,VRAYTS) C --------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES DU SOLIDE AU TABLEAU VRAYTS * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBRAYS ! E ! D ! NOMBRE DE NOEUDS SOLIDE AVEC RAYT ! C ! NRAYTS ! TE ! D ! NUMERO DES NOEUDS SOLIDES AVEC RAYT ! C ! VRAYTS ! TR !D M ! VALEUR AUX NOEUDS SOLIDES AVEC RAYT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NDIM,NPOINS,NBRAYS,NRAYTS(NBRAYS) DOUBLE PRECISION TMPS(NPOINS),VRAYTS(NBRAYS,2) C C..Variables internes INTEGER N,NG C C*********************************************************************** C C C C 1- PASSAGE DU SOLIDE VERS LE RAYONNEMENT C ======================================== C DO 100 N=1,NBRAYS C NG = NRAYTS(N) C VRAYTS(N,1) = TMPS(NG) C 100 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,1010) DO 110 N=1,NBRAYS WRITE(NFECRA,1020) N,VRAYTS(N,1) 110 CONTINUE ENDIF C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** SOLRAY : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE RAYONNEMENT',/, & 9X,' N VRAYTS(N,1) ') 1020 FORMAT(5X,3X,I8,6X,E25.10) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/ecrg1.F0000666000175000017500000002124611524070641015056 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE ECRG1 C ***************** C C ------------------------------------------------- *( NFIC,LF,NDIM,NDIELE,NBPOIN,NBELE,NBNODE,NBFACE, * COORD,NODE,NREFER,NREFE,NREFAC) C ------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C GENERATION DU FICHIER GEOMETRIQUE POUR GRAFN3S * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! LF ! L ! D ! INDICATEUR ! C ! ! ! ! = vrai = ecriture des references des faces! C ! ! ! ! = faux = pas d'ecriture ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (LOCAL) ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS DU MAILLAGE ! C ! ! ! ! 1 -> segment ! C ! ! ! ! 2 -> triangle ! C ! ! ! ! 3 -> tetraedre ! C ! NBPOIN ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBELE ! E ! D ! NOMBRE D'ELEMENTS DU MAILLAGE ! C ! NBNODE ! L ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! COORD ! TR ! ! TABLE DES COORDONNEES ! C ! NODE ! TE ! M ! CONNECTIVITE DU MAILLAGE ! C ! NREFER ! TE ! D ! REFERENCES DES NOEUDS ! C ! NREFAC ! TE ! D ! REFERENCES DES FACES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" C C********************************************************************** C.. Variables externes INTEGER NDIM,NDIELE,NBPOIN,NBELE,NBNODE,NBFACE INTEGER NODE(NBELE,NBNODE),NREFER(NBPOIN),NFIC INTEGER NREFAC(NBELE,NBFACE),NREFE(NBELE) DOUBLE PRECISION COORD(NBPOIN,NDIM) LOGICAL LF C C.. Variables internes CHARACTER*1 CTP1P2 INTEGER N,I,NNSOM DOUBLE PRECISION XTCL C C********************************************************************** C C 0- INITIALISATIONS ET TRI DES NOEUDS C ==================================== C C 0.1- Initialisations C -------------------- C XTCL = 0 C C C 1- ENTETE DU FICHIER (EN COMMENTAIRES) C ====================================== WRITE(NFIC,1100) WRITE(NFIC,1110) NDIM,NDIELE,NBPOIN,NBELE,NBNODE C C C 2- ECRITURE DE LA TABLE DES NOEUDS C ================================== C C Ecriture du titre de la rubique WRITE(NFIC,2000) C DO 200 N=1,NBPOIN C DO 210 I = 1,NDIM IF (ABS(COORD(N,I)) .LE. 1.E-10) COORD(N,I) = 0.D0 210 CONTINUE C IF (NDIM.EQ.2) THEN C WRITE(NFIC,2100) & N,NREFER(N),(COORD(N,I),I=1,2),XTCL C ELSEIF (NDIM.EQ.3) THEN C WRITE(NFIC,2100) & N,NREFER(N),(COORD(N,I),I=1,3) C ENDIF C 200 CONTINUE C C C 3- ECRITURE DE LA TABLE DES ELEMENTS C ==================================== C C Ecriture du titre de la rubique WRITE(NFIC,3000) C C 3.0- Segments a 2 noeuds C ------------------------ IF (NDIELE.EQ.1 .AND. NBNODE.EQ.2) THEN DO 130 N=1,NBELE WRITE(NFIC,3100) N,NREFE(N),(NODE(N,I),I=1,2) 130 CONTINUE C C 3.1- Segments a 3 noeuds C ------------------------ ELSEIF (NDIELE.EQ.1 .AND. NBNODE.EQ.3) THEN DO 131 N=1,NBELE WRITE(NFIC,3200) N,NREFE(N),(NODE(N,I),I=1,3) 131 CONTINUE C C 3.2- Triangles a 3 noeuds C ------------------------- ELSEIF (NDIELE.EQ.2 .AND. NBNODE.EQ.3) THEN DO 132 N=1,NBELE WRITE(NFIC,3200) N,NREFE(N),(NODE(N,I),I=1,3) 132 CONTINUE C C 3.3- Triangles a 6 noeuds C ------------------------- ELSEIF (NDIELE.EQ.2 .AND. NBNODE.EQ.6) THEN DO 133 N=1,NBELE WRITE(NFIC,3300) N,NREFE(N),(NODE(N,I),I=1,6) 133 CONTINUE C C C 3.4- Tetraedre a 10 noeuds C -------------------------- ELSEIF (NDIELE.EQ.3 .AND. NBNODE.EQ.10) THEN DO 134 N=1,NBELE WRITE(NFIC,3400) N,NREFE(N),(NODE(N,I),I=1,10) 134 CONTINUE C ELSE WRITE(NFECRA,3500) STOP C ENDIF C C C 4- ECRITURE DES REFERENCES DES FACES C ==================================== C IF (LF) THEN C WRITE(NFIC,4000) C DO 400 N=1,NBELE WRITE(NFIC,4100) N,(NREFAC(N,I),I=1,NBFACE) 400 CONTINUE C ENDIF C CALL FLUSHF(NFIC) C C-------- C FORMATS C-------- C 999 FORMAT(' %% ERREUR ECRG1 : la dimension des elements (NDIELE)', & ' est incorrecte') 1100 FORMAT( & 'C************************************************C',/, & 'C FICHIER GEOMETRIQUE SYRTHES 3.4 C',/, & 'C************************************************C') 1110 FORMAT( & 'C DIMENSION = ',I1,' DIMENSION DES ELTS = ',I1,/, & 'C NOMBRE DE NOEUDS = ',I10,/, & 'C NOMBRE D''ELEMENTS =',I10,/, & 'C NOMBRE DE NOEUDS PAR ELEMENT = ',I3,/, & 'C************************************************C') C 2000 FORMAT('C',/,'C$ RUBRIQUE = NOEUDS',/,'C') 2100 FORMAT(I10,I3,1X,3(E14.7,1X)) C 3000 FORMAT('C',/,'C$ RUBRIQUE = ELEMENTS',/,'C') 3100 FORMAT(I10,I3,2I10) 3200 FORMAT(I10,I3,3I10) 3300 FORMAT(I10,I3,6I10) 3400 FORMAT(I10,I3,10I10) 3500 FORMAT(/,' %% ECRG1 : TYPE D''ELEMENTS INCONNUS') C C 4000 FORMAT('C',/,'C$ RUBRIQUE = REFERENCES DES FACES',/,'C') 4100 FORMAT(I10,1X,4I5) C END syrthes-3.4.3-dfsg1/src/s/fi2teq.F0000666000175000017500000002343411524070641015250 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE FI2TEQ C ***************** C C -------------------------------------------------------- * (NELRAY,NFFIRA,NGFFIR,EMISSI,TEMRAY,FIRAY,VFIRAY,FDFRAY, * RADIOS,ERAYEQ,TRAYEQ,SUFRAY,FDFNP1) C -------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C CALCUL DES TEMPERATURES ET EMISSIVITE EQUIVALENTE * C LORSQU'IL Y A PLUSIEURS BANDES SPECTRALES * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NELRAY ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! NODRAY ! TE ! D ! CONNECTIVITE DU MAILLAGE DE RAYONNEMENT ! C ! EMISSI ! TE ! D ! EMISSIVITE DE FACETTE POUR CHAQUE BANDE ! C ! TEMRAY ! TR ! D ! TEMPERATURE DE LA FACE DE RAYONNT A L'ETAPE N! C ! FIRAY ! TR ! R ! FLUX DE LA FACE DE RAYONNT A L'ETAPE N ! C ! FDFRAY ! TR ! R ! FACTEURS DE FORME RAYONNEMENT ! C ! RADIOS ! TR ! R ! RADIOSITE (maillage rayt) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "rayonn.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NFFIRA,NGFFIR(NFFIRA) DOUBLE PRECISION TEMRAY(NELRAY),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2),RADIOS(NELRAY,NBANDE) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),ERAYEQ(NELRAY) DOUBLE PRECISION TRAYEQ(NELRAY) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) DOUBLE PRECISION SUFRAY(NELRAY),FDFNP1(NELRAY) C C.. Variables internes INTEGER N,M,I,J,NGFAC DOUBLE PRECISION EPS DOUBLE PRECISION W1,W2,TFAC,XJ(NBAMAX) DOUBLE PRECISION C2,X1,X2,V,V2,V4,RR C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. EPS = 1E-6 C2 = 1.4388E-2 DO 100 I=1,NELRAY TRAYEQ(I) = 0.D0 ERAYEQ(I) = 0.D0 100 CONTINUE C C*********************************************************************** C C 2- Cas d'une seule bande spectrale C ================================== IF ( NBANDE .EQ. 1 ) THEN C IF (LROUVR) THEN XJ(1) = SIGMA * (TEMINF+TKEL)**4 ENDIF C DO 200 I=1,NELRAY ERAYEQ(I) = EMISSI(I,1,1) RR = 0. DO 210 J=1,I RR = RR + FDFRAY((J-1)*NELRAY-(J-1)*J/2+I)* RADIOS(J,1) 210 CONTINUE DO 211 J=I+1,NELRAY RR = RR + FDFRAY((I-1)*NELRAY-(I-1)*I/2+J)* RADIOS(J,1) 211 CONTINUE IF (LROUVR) THEN RR = RR + FDFNP1(I)*XJ(1) ENDIF TRAYEQ(I) = (RR/SUFRAY(I)/SIGMA)**0.25 C C C 2.1- Calcul du Flux de rayonnement C ----------------------------------------------------------- FIRAY(I,1) = EMISSI(I,1,1)*( SIGMA*TEMRAY(I)**4 - & RR/SUFRAY(I)) C 200 CONTINUE C C ELSE C C 3- Cas de plusieurs bandes spectrales C ===================================== C DO 300 N=1,NBANDE C X1 = C2/SPECTL(N,1) X2 = C2/SPECTL(N,2) C IF (LROUVR) THEN V = X1/(TEMINF+TKEL) CALL WIEBEL(V,W1) V = X2/(TEMINF+TKEL) CALL WIEBEL(V,W2) XJ(N) = SIGMA * (TEMINF+TKEL)**4 * (W2-W1) ENDIF C DO 310 I=1,NELRAY C V = X1/TEMRAY(I) CALL WIEBEL(V,W1) C V = X2/TEMRAY(I) CALL WIEBEL(V,W2) C ERAYEQ(I) = ERAYEQ(I) + (W2-W1) * EMISSI(I,1,N) 310 CONTINUE C 300 CONTINUE C DO 320 I=1,NELRAY RR = 0. DO 339 N=1,NBANDE DO 340 J=1,I RR = RR + FDFRAY((J-1)*NELRAY-(J-1)*J/2+I)* & EMISSI(I,1,N)*RADIOS(J,N) 340 CONTINUE DO 350 J=I+1,NELRAY RR = RR + FDFRAY((I-1)*NELRAY-(I-1)*I/2+J)* & EMISSI(I,1,N)*RADIOS(J,N) 350 CONTINUE IF (LROUVR) THEN RR = RR + FDFNP1(I)*XJ(N) ENDIF 339 CONTINUE TRAYEQ(I) = (RR/SUFRAY(I)/ERAYEQ(I)/SIGMA)**0.25 320 CONTINUE C C C 4.- Calcul du Flux de rayonnemnent (pour le post-processing) C ======================================================== DO 400 N=1,NBANDE C X1 = C2/SPECTL(N,1) X2 = C2/SPECTL(N,2) C DO 410 I=1,NELRAY C V = X1/TEMRAY(I) CALL WIEBEL(V,W1) C V = X2/TEMRAY(I) CALL WIEBEL(V,W2) C RR = 0. DO 440 J=1,I RR = RR + FDFRAY((J-1)*NELRAY-(J-1)*J/2+I)*RADIOS(J,N) 440 CONTINUE DO 450 J=I+1,NELRAY RR = RR + FDFRAY((I-1)*NELRAY-(I-1)*I/2+J)*RADIOS(J,N) 450 CONTINUE IF (LROUVR) THEN RR = RR + FDFNP1(I)*XJ(N) ENDIF FIRAY(I,N) = EMISSI(I,1,N)*(SIGMA* (W2-W1)*TEMRAY(I)**4- & RR/SUFRAY(I)) C 410 CONTINUE C 400 CONTINUE ENDIF C C C 5-Mise a jour des facettes avec flux imposee stockee dans vfiray C ================================================================ DO 500 N=1,NBANDE DO 510 I=1,NFFIRA NGFAC = NGFFIR(I) FIRAY(NGFAC,N) = VFIRAY(I,N,1) EMISSI(NGFAC,1,N) = VFIRAY(I,N,2) 510 CONTINUE 500 CONTINUE C C 6-Calcul de la temperature de la facette necessaire C ================================================================ DO 600 I=1,NFFIRA TFAC = 0. NGFAC = NGFFIR(I) DO 610 N=1,NBANDE TFAC = TFAC + (1. - VFIRAY(I,N,2)) / VFIRAY(I,N,2) * & VFIRAY(I,N,1) + RADIOS(I,N) 610 CONTINUE C TEMRAY(NGFAC) = (TFAC/SIGMA)**0.25 600 CONTINUE C C*********************************************************************** C C 8- IMPRESSION DE CONTROLE C ========================= C IF (NBLBLR .GE. 10) THEN WRITE(NFECRA,8000) WRITE(NFECRA,8010) DO 8100 I=1,NELRAY WRITE(NFECRA,8110) I,ERAYEQ(I),TRAYEQ(I)-TKEL 8100 CONTINUE ENDIF C C C-------- C FORMATS C-------- C 8000 FORMAT(/,' *** FI2TEQ : CALCUL DES EMISSIVITES EQUIVALENTES', & ' DES TEMPERATURES DE RAYONNEMENT EQUIVALENTES') 8010 FORMAT(/,' *** FI2TEQ : Facette Emissivite equivalente ', & ' Temp equivalente (degres C)') 8110 FORMAT(10X,I6,10X,E13.5,10X,E13.5) 9110 FORMAT(5X,I6,3X,E13.5,3X,E13.5,3X,E13.5,3X,E13.5,3X,E13.5) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/dgetcp.c0000666000175000017500000000617011524070641015357 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ #include "f2c_syrthes.h" #include #include #define SYRTHES_CHRONO 1 /* -------------------------------------------------------------- ! Recuperation du temps cpu pris par un process. ! ! SUN(et CONVEX) ou CETIA : choisir le bon define ! ! ! ! REFERENCE : SUN UNIX INTERFACE REFERENCE page 59 (et 63) ! ! CETIA UNIX SYSTEM V Reference Manual Chapter 4 ! ! Fonction times(2) ! ! ! ! attention suivant machine unix les noms des subroutines ! ! a l'appel ont besoin ou non d'un _ : proc ! ! exemple dgetcp_ sur convex et dgetcp sur hp9000 ! --------------------------------------------------------------- */ /*########*/ #ifdef SUN /*########*/ #include #include proc(dgetcp,DGETCP) (t) /* retourne le temps cpu sous la forme d'un tableau d'entiers t[0]=secondes pour le system mode t[1]=microsecondes pour le system mode t[2]= secondes pour le user mode t[3]= microsecondes pour le user mode temps cpu = somme des temps en user et system mode Remarque : pour avoir le temps cpu des process fils, il suffit de remplacer RUSAGE_SELF par RUSAGE_CHILDREN dans l'appel a getrusage. */ double t[4]; { struct rusage cpu; getrusage(RUSAGE_SELF,&cpu); t[0]=(double)cpu.ru_stime.tv_sec; t[1]=(double)cpu.ru_stime.tv_usec; t[2]=(double)cpu.ru_utime.tv_sec; t[3]=(double)cpu.ru_utime.tv_usec; } #endif /*#################*/ #ifdef SYRTHES_CHRONO /*#################*/ #include proc(dgetcp,DGETCP) (t) double t[4]; { struct tms cpu; times(&cpu); t[0]=(double)cpu.tms_utime; t[1]=(double)cpu.tms_stime; t[2]=(double)cpu.tms_utime; t[3]=(double)cpu.tms_stime; } #endif syrthes-3.4.3-dfsg1/src/s/orient_2d.c0000666000175000017500000006414411524070641016003 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | orie2d | | | |======================================================================| */ void orie2d (int *nodray, int nelray, int npoinr, int *nrfray, double *cooray, double *pvinter, int numgu,int ndim,int nblblr,int *grconv) { int *grconx, *norini, *ifabor; int numg,i,ielem,nbmalo ; ifabor = (int *)malloc( nelray * 2 * sizeof(int)); grconx = (int *)malloc( nelray * sizeof(int)); if (ifabor==NULL || grconx==NULL) {printf(" ERREUR orie2d : probleme d'allocation memoire\n"); exit(0);} nbmalo = 0 ; voisic_2d(ifabor,nodray,nelray,npoinr,nblblr) ; connex_2d(ifabor,grconx,nelray,npoinr,&numg,numgu,nblblr) ; /* On stockera autant d'elements de depart que de surfaces connexes trouves */ norini = (int *)malloc( numg * sizeof(int)); if (norini==NULL) {printf(" ERREUR orie2d : probleme d'allocation memoire\n"); exit(0);} iniori_2d(ifabor,nodray,cooray,nrfray,grconx,nelray,npoinr, pvinter,&numg,ndim,norini,grconv,numgu,&nbmalo,nblblr) ; oriene_2d( ifabor, nodray, nelray, grconx, norini, &numg, &nbmalo,nblblr) ; /* 4- Post processing pour developpeur (IR,CP) ---------------------------------------------- */ if ( nblblr > 10 ) { for ( i=0; i < 2 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] += 1 ; } printf(" \n Table des elements colles aux faces de chaque element \n ") ; for ( ielem=0; ielem < nelray; ielem++ ) { printf( " Element %d : %d %d \n", ielem+1, ifabor[ielem] ,ifabor[ielem+ nelray] ) ; } for ( ielem=0; ielem < nelray; ielem++ ) { printf( " Element %d : %d %d \n", ielem+1, nodray[ielem] ,nodray[ielem+ nelray] ) ; } } free(grconx);free(norini) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | voisic_2d | | | |======================================================================| */ void voisic_2d(int *ifabor,int *nodray,int nelray,int npoinr,int nblblr) { int i; int i1,i2; int ielem; int *itrav; itrav = (int *)malloc( (2* npoinr) * sizeof(int)); if (itrav==NULL) {printf(" ERREUR voisic_2d : probleme d'allocation memoire\n"); exit(0);} /* 1- INITIALISATION ==================== */ for (i=0; i < 2* npoinr ; i++) *(itrav+i) = -1 ; for (i=0; i < 2* nelray ; i++) *(ifabor+i) = -1 ; for ( ielem=0; ielem < nelray; ielem++ ) { i1 = nodray[ielem]-1; i2 = nodray[ielem+nelray]-1; if(itrav[i1]==-1) { itrav[i1] = ielem ; if(itrav[i2] == -1) itrav[i2] = ielem ; else if(itrav[i2+npoinr] == -1) itrav[i2+npoinr] = ielem ; else printf("\n *** VOISIC_2D : erreur 1 pour element ielem %d i1=%d i2=%d \n",ielem,i1,i2); } else if( itrav[i1+npoinr] == -1) { itrav[i1+npoinr] = ielem ; if(itrav[i2] == -1) itrav[i2] = ielem ; else if(itrav[i2+npoinr] == -1) itrav[i2+npoinr] = ielem ; else printf("\n *** VOISIC_2D : erreur 2 pour element ielem %d i1=%d i2=%d \n",ielem,i1,i2); } else printf("\n *** VOISIC_2D : erreur 3 pour element ielem %d i1=%d i2=%d \n",ielem,i1,i2); } if( nblblr > 10 ) {for (i=0;i 10 ) { for ( i=0; i < 2 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] += 1 ; } printf(" VOISIC_2D : Table des elements colles aux faces de chaque element \n ") ; for ( ielem=0; ielem < nelray; ielem++ ) { printf( " VOISIC_2D :Element %d : %d %d \n", ielem+1, ifabor[ielem] ,ifabor[ielem+ nelray] ) ; } for ( i=0; i < 2 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] -= 1 ; } } free(itrav) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | connex_2d | | | |======================================================================| */ void connex_2d(int *ifabor,int *grconx,int nelray,int npoinr,int *numg,int numgu, int nblblr) { int i; int iel1,iel2; for (i=0; i < nelray ; i++) *(grconx+i) = 0 ; iel1 = 0 ; iel2 = -10 ; *numg = 1 ; grconx[0] = *numg ; for (i=0; i < 2 ; i++ ) if ( ifabor[iel1+i* nelray] != -1 ) iel2 = ifabor[iel1+i* nelray]; if ( iel2 == -10 ) printf( " $$ ATTENTION CONNEX_2D : Element %d isole \n" , iel1+1) ; else { for (i=0; i < 2 ; i++ ) { iel2 = ifabor[iel1+i* nelray] ; if (iel2==-1) continue; if (grconx[iel2]!=0) continue ; group_2d(iel1,iel2,nelray,grconx,ifabor,nblblr) ; } } for (i=0; i < nelray ; i++ ) { if ( grconx[i] == 0 ) { if ( nblblr >10 ) printf(" CONNEX_2D : Le segment %d n'appartient pas encore a un groupe \n", i+1) ; iel1 = i ; iel2 = -10 ; *numg += 1 ; grconx[i] = *numg ; if(ifabor[iel1+nelray]+ifabor[iel1]==-2) { printf( " $$ ATTENTION CONNEX_2D : Element %d isole \n" , iel1+1) ; continue ; } for (i=0; i < 2 ; i++ ) { iel2 = ifabor[iel1+i* nelray] ; if (iel2==-1) continue; if (grconx[iel2]!=0) continue ; group_2d( iel1,iel2,nelray,grconx,ifabor,nblblr ) ; } /* fin de la boucle sur tous les cotes */ } /* Fin du test sur l'appartenance a un groupe */ } /* Fin de la boucle sur tous les elements */ printf("\n *** CONNEX_2D : Le maillage surfacique contient %d surfaces connexes et %d volumes connexes \n", *numg,numgu) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | group_2d | | | |======================================================================| */ void group_2d(int iel1,int iel2,int nelray,int *grconx,int *ifabor, int nblblr) { int i ; int ielv ; grconx[iel2] = grconx[iel1] ; /* printf(" dans group2 : iel1+1=%d iel2+1=%d \n",iel1+1,iel2+1); */ /* printf(" grconx[iel1]+1 : %d",grconx[iel1]); */ for (i=0; i < 2 ; i++ ) { ielv = ifabor[iel2+i* nelray] ; if ( ielv != -1 && grconx[ielv] == 0) { group_2d( iel2,ielv,nelray,grconx,ifabor,nblblr) ; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | oriene_2d | | | |======================================================================| */ void oriene_2d(int *ifabor, int *nodray, int nelray, int *grconx, int *norini, int *numg, int* nbmalo, int nblblr) { int i,ip,iel1,iel2; int ifp; for ( i=0 ; i < *numg ; i++ ) { iel1 = norini[i] ; for ( ifp=0 ; ifp < 2 ; ifp++ ) { ip = nodray[iel1+ifp*nelray] ; iel2 = ifabor[iel1+ifp*nelray] ; if ( iel2 != -1 && grconx[iel2] > 0 ) { rorien_2d(ifp,ip,iel2,ifabor,grconx,nodray,nelray, nbmalo,nblblr ) ; } } } printf("\n *** ORIENE_2D : Le nombre de facettes reorientees est : %d \n", *nbmalo ) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | rorien_2d | | | |======================================================================| */ void rorien_2d(int ifp,int ip,int iel2,int *ifabor,int *grconx, int *nodray,int nelray, int *nbmalo, int nblblr) { int jp; int ielv; int lmalo,nodaux,neleaux; lmalo = 0 ; jp = nodray[iel2+ifp*nelray] ; if ( ip == jp ) { lmalo = 1 ; } if ( lmalo == 1 ) { *nbmalo += 1 ; nodaux = nodray[iel2] ; nodray[iel2] = nodray[iel2+nelray] ; nodray[iel2+ nelray] = nodaux ; neleaux = ifabor[iel2] ; ifabor[iel2] = ifabor[iel2+nelray ] ; ifabor[iel2+nelray] = neleaux ; grconx[iel2] = - grconx[iel2] ; if ( nblblr > 10 ) printf( "RORIEN_2D : La facette %d etait mal orientee \n",iel2+1 ) ; } else { grconx[iel2] = - grconx[iel2] ; } jp = nodray[iel2+ ifp*nelray ] ; ielv = ifabor[iel2 + ifp* nelray] ; if ( ielv != -1 && grconx[ielv] > 0 ) { rorien_2d(ifp,jp,ielv,ifabor,grconx,nodray,nelray,nbmalo,nblblr) ; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | iniori_2d | | Initialisation des processus recursifs | |======================================================================| */ void iniori_2d(int *ifabor,int *nodray,double *cooray,int *nrfray, int *grconx,int nelray,int npoinr, double *pvinter,int *numg,int ndim,int *norini, int *grconv,int numgu, int *nbmalo, int nblblr) { int i,j,k,imin ; int n1,n2 ; int iel,nodaux,neleaux ; int iv,pintok,dejaunpoint; double xint,yint ; double dmin ; double x1,y1,x2,y2; double xnorelx,xnorely,xnormel ; double xvecgix,xvecgiy,xnormve ; double xvec1ix,xvec1iy ; double pscal ; double xxg,yyg; double dist; int *norinit, *npvint, *ncompteur ; double eps ; eps = 1e-6 ; norinit = (int *)malloc( *numg * numgu * sizeof(int) ); npvint = (int *)malloc( *numg * sizeof(int) ); ncompteur = (int *)malloc( *numg * sizeof(int) ); if (norinit==NULL || npvint==NULL || ncompteur==NULL) {printf(" ERREUR iniori_2d : probleme d'allocation memoire\n"); exit(0);} for (i=0; i < nelray ; i++) *(grconv+i) = 0 ; for (i=0; i < *numg ; i++) *(npvint+i) = 0 ; for (i=0; i < *numg ; i++) *(ncompteur+i) = 0 ; for (i=0; i < *numg*numgu ; i++) *(norinit+i) = 0 ; if ( nblblr > 10 ) { for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_2D : Element , nrfray : %d %d \n",i+1,nrfray[i] ) ; printf(" \n"); for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_2D : Element , grconx : %d %d \n",i+1,grconx[i] ) ; printf(" \n"); for ( i=0 ; i < npoinr ; i++ ) { printf(" INIORI_2D : Noeud %d x y z : %f %f %f \n",i+1,cooray[i],cooray[i+npoinr],cooray[i+2* npoinr]) ; } } /* Boucle sur les surfaces connexes */ for ( j=0 ; j < *numg ; j++ ) { /* boucle sur les points volumiques internes */ for (iv=0;iv -eps && xnormel < eps ) { printf( "\n *** INIORI_2D : L'element %d est vraisemblablement degenere (applati)\n",i+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; } xvecgix = xint - xxg ; xvecgiy = yint - yyg ; xnormve = sqrt( xvecgix*xvecgix + xvecgiy*xvecgiy) ; xvecgix = xvecgix / xnormve ; xvecgiy = xvecgiy / xnormve ; pscal = xnorelx*xvecgix + xnorely*xvecgiy ; if ( pscal > -eps && pscal < eps ) { printf("\n *** INIORI_2D : Le point interne %d de coordonnees xc = %f , yc = %f \n" " est mal choisi, car dans le plan de la facette %d \n", j+1,xint,yint,i+1) ; exit(0); } /* Verif de non recoupage de la surface connexe j */ xvecgix = xvecgix * xnormve ; xvecgiy = xvecgiy * xnormve ; for ( k=0;k changer la position du point %d \n",iv+1); exit(0);} } } /* Stockage tous les elements correspondants au couple iv et surface connexe j */ norinit[iv +j*numgu] = imin ; if (nblblr > 12 ) {for (k=0;k<*numg*numgu;k++) printf (" INIORI_2D : norinit[ %d ] = %d \n",k+1,norinit[k]+1);} } } if (nblblr>10) { printf(" \n"); for ( j=0;j<*numg ; j++ ) { printf(" \n"); for (iv=0;iv14) printf(" comp conex %d face depart %d noeud volumique %d facette ocultrice k = %d \n", j+1,iel+1,iv+1,k+1); if (racines_2d(x1,y1,x2,y2,xvecgix,xvecgiy,xxg,yyg,k)) { if (nblblr > 14 ) printf(" INIORI_2D : Intersection avec une autre surface connexe (face %d) composante connexe %d \n", k+1,grconx[k]-1); ncompteur[grconx[k]-1] += 1; } } } if (nblblr>10) printf("INIORI_2D : composante connexe j = %d noeud interieur iv = %d \n",j+1,iv+1); if (nblblr>13) {for (i=0;i<*numg;i++) printf( " INIORI_2D : ncompteur[ %d ] = %d \n",i+1,ncompteur[i]);} pintok =1; /* flag des intersections impaires */ for (i=0; i<*numg;i++) { if ((ncompteur[i]/2)*2-ncompteur[i]!=0) pintok = 0; } if (pintok == 0) {if (nblblr>10) printf( " INIORI_2D : le point interieur %d non ok pour la surface connexe %d \n",iv+1,j+1);} else { if(nblblr>10) printf(" INIORI_2D : le point interieur %d semble ok pour la surface connexe %d \n",iv+1,j+1); if (dejaunpoint==1) { printf("\n *** INIORI_2D : Ce volume est :\n"); printf(" soit deja defini par un point precedent \n"); printf(" soit une ambiguite existe sur le volume ---> a verifier tres soigneusement \n" ); printf(" --> essayer de modifier la position du noeud interieur %d \n",iv+1); exit(0); } else {norini[j] = iel;npvint[j]=iv;dejaunpoint=1;} } } if (dejaunpoint==0 ) { printf("\n *** INIORI_2D : Il y a un probleme pour la surface connexe j= %d\n" ,j+1); printf(" Aucun des points fournis par l'utilisateur ne permet de la definir \n"); printf(" Verifier bien que tous les volumes independants ont ete definis par un point \n"); exit(0); } } if (nblblr>=10) { printf("\n"); for (i=0;i<*numg;i++) printf(" *** INIORI_2D : Composante connexe %d face de depart %d point interieur %d \n", i+1,norini[i]+1,npvint[i]+1); } /* Traitement proprement dit */ for ( j= 0 ; j < *numg ; j++ ) { xint = pvinter[3*npvint[j]] ; yint = pvinter[3*npvint[j] + 1] ; iel = norini[j] ; n1 = nodray[iel]-1 ; x1 = cooray[n1] ; y1 = cooray[n1+ npoinr] ; n2 = nodray[iel+ nelray]-1 ; x2 = cooray[n2] ; y2 = cooray[n2+ npoinr] ; xnorelx = -y2+y1; xnorely = x2-x1; xnormel = sqrt( xnorelx*xnorelx + xnorely*xnorely) ; if ( xnormel > -eps && xnormel < eps ) { printf( "\n ERREUR CONNEX_2D : L'element %d est vraisemblablement degenere (longeur nulle) \n",iel+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; } xvec1ix = xint - x1 ; xvec1iy = yint - y1 ; xnormve = sqrt( xvec1ix*xvec1ix + xvec1iy*xvec1iy) ; if ( xnormve > -eps && xnormve < eps ) { printf("\n *** INIORI_2D : Le point interne %d de coordonnees xc = %f , yc = %f \n" " est mal choisi, car confondu avec le noeud %d\n", j+1,xint,yint,n1) ; exit(0) ; } else { xvec1ix = xvec1ix / xnormve ; xvec1iy = xvec1iy / xnormve ; } pscal = xnorelx*xvec1ix + xnorely*xvec1iy ; if ( pscal > -eps && pscal < eps ) { printf("\n *** INIORI_2D : Le point interne %d de coordonnees xc = %f , yc = %f \n" " est mal choisi, car dans l'alignement de l'element %d \n", j+1,xint,yint,iel) ; exit(0) ; } if ( pscal < -eps ) { nodaux = nodray[iel+ nelray ] ; nodray[iel+ nelray ] = nodray[iel] ; nodray[iel ] = nodaux ; neleaux = ifabor[iel] ; ifabor[iel] = ifabor[iel + nelray ] ; ifabor[iel + nelray] = neleaux ; *nbmalo += 1 ; if ( nblblr > 10 ) printf( "\n INIORI_2D : Le segment %d etait mal orientee \n",iel+1 ) ; } } /* Volumes connexes */ for (j=0;j<*numg;j++) { for (k=0;k10) {printf("\n");for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_2D : element , grconv : %d %d \n",i,grconv[i] ) ;} free(norinit);free(npvint);free(ncompteur) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | racines_2d | | Calcul de la racine eventuelle entre la facette consideree | | et le vecteur xvec,yvec | | Si l'intersection n'est pas dans le sgement on met 1e6 | | sur chaque composante | |======================================================================| */ int racines_2d(double x1,double y1, double x2,double y2, double xvec,double yvec, double xxg,double yyg,int iel) { int ii; double eps,xp,yp; double denom,numer,alfa,d; double xnorelx,xnorely,xnormel; eps = 1.e-5; xnorelx = -y2+y1 ; xnorely = x2-x1 ; xnormel = sqrt( xnorelx*xnorelx + xnorely*xnorely ) ; if ( xnormel > -eps && xnormel < eps ) { printf( "\n *** RACINES-2D : L'element %d est vraisemblablement degenere (longueur nulle) \n", iel+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; } d = -x1*xnorelx-y1*xnorely; denom = xnorelx*xvec+xnorely*yvec; if ( abs(denom) > eps ) { numer = - ( xnorelx*xxg + xnorely*yyg + d); alfa = numer/denom; } else alfa = 1.e6; if ((0. FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! VCOUPS ! TR !D M ! VALEUR AUX NOEUDS SOLIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELEMENTS FLUIDES COUPLES ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS FLUIDES + RAYO ! C ! NODRAF ! TE ! D ! TABLE DES ELEMENTS FLUIDES + RAYON (NUM LOC) ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SOLIDES COUPLES ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS SOLIDES COUPLES! C ! NODESS ! TE ! D ! TABLE DES ELEMENTS SOLIDES COUPLES (NUM LOC) ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! BARYF ! TR ! D ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELTS SOLIDES ! C ! NCBORF ! TE ! D ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! D ! CCORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELTS FLUIDES ! C ! NCBORS ! TE ! D ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" #include "xrefer.h" C C*********************************************************************** C C..Variables externes INTEGER MODE,NDIM,NBRAYS,NBRAF,NELRAY,NELRAF,NDMASF,NELERA,NDMASS INTEGER NNSRAY,NNFRAY,NPOINR INTEGER NFCFRA,NGFPEF(NFCFRA) INTEGER NRAYTS(NBRAYS),NRAPF(NBRAF,2),NODRAY(NELRAY,NDIM) INTEGER NCSRAY(NNSRAY),NCFRAY(NNFRAY),NRFRAY(NELRAY) INTEGER NODRAF(NELRAF,NDMASF),NODERA(NELERA,NDMASS) INTEGER NCFIN(NBRAYS),NCGROS(NNSRAY,2) INTEGER NCFINF(NBRAF),NCGROF(NNFRAY,2),ITYFAR(NELRAY) INTEGER ITRAV(NELRAY) DOUBLE PRECISION BARYGR(NNSRAY,NDIM),BARYFR(NNFRAY,NDIM) DOUBLE PRECISION BARYFF(NBRAF,NDIM),BARYFS(NBRAYS,NDIM) DOUBLE PRECISION VRAYTS(NBRAYS,2),VRAPF(NBRAF,2) DOUBLE PRECISION TEMRAY(NELRAY),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION ERAYEQ(NELRAY),TRAYEQ(NELRAY),PHFRAF(NFCFRA,4) DOUBLE PRECISION ERAYEN(NPOINR),TRAYEN(NPOINR) DOUBLE PRECISION SUFRAY(NELRAY),TRAV(NPOINR) DOUBLE PRECISION TRAV3(NELRAY),TRAV4(NELRAY) C C..Variables internes INTEGER NUMEL,NUMTRI,NUMSEG,N1,N2,N3,N,NN(3),M DOUBLE PRECISION XL1,XL2,XL3,TIERS,TT(3),XH(3) C C*********************************************************************** C C ++++++++++++++ C ++++++++++++++ C I. DIMENSION 2 C ++++++++++++++ C ++++++++++++++ IF (NDIM.EQ.2) THEN C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE RAYONNEMENT C ======================================== C DO N=1,NELRAY ITRAV(N) = 0 ENDDO DO N=1,NNSRAY ITRAV(NCSRAY(N)) = N ENDDO C DO 100 N=1,NELRAY C IF (ITYFAR(N).EQ.1) THEN C NN(1) = NODRAY(N,1) NN(2) = NODRAY(N,2) C DO 110 M=1,2 C IF (ITRAV(NN(M)).EQ.0) THEN GOTO 110 C ELSE C NUMEL = NCGROS(itrav(NN(M)),1) NUMSEG = NCGROS(itrav(NN(M)),2) C IF (NUMSEG .EQ. 0) THEN N1 = NODERA(NUMEL,1) N2 = NODERA(NUMEL,2) ELSEIF (NUMSEG .EQ. 1) THEN N1 = NODERA(NUMEL,1) N2 = NODERA(NUMEL,3) ELSE N1 = NODERA(NUMEL,2) N2 = NODERA(NUMEL,3) ENDIF C XL1 = BARYGR(itrav(NN(M)),1) XL2 = BARYGR(itrav(NN(M)),2) C TT(M) = VRAYTS(N1,1)*XL1 + VRAYTS(N2,1)*XL2 C ENDIF C 110 CONTINUE C TEMRAY(N) = (TT(1)+TT(2)) * 0.5 C ENDIF C 100 CONTINUE C C C 1.2 Impressions pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,1020) DO 120 N=1,NELRAY WRITE(NFECRA,1021) N,TEMRAY(N) 120 CONTINUE ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU RAYONNEMENT VERS LE SOLIDE C ======================================== C CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * TRAYEQ,TRAYEN,TRAV) CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * ERAYEQ,ERAYEN,TRAV) C DO 200 N=1,NBRAYS C NUMEL = NCFIN(N) C N1 = NODRAY(NUMEL,1) N2 = NODRAY(NUMEL,2) C XL1 = BARYFS(N,1) XL2 = BARYFS(N,2) C VRAYTS(N,1)= TRAYEN(N1)*XL1 + TRAYEN(N2)*XL2 VRAYTS(N,2)= ERAYEN(N1)*XL1 + ERAYEN(N2)*XL2 C 200 CONTINUE C C 2.1- Impression pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,2030) DO N=1,NBRAYS WRITE(NFECRA,2031) N,NRAYTS(N),VRAYTS(N,1),VRAYTS(N,2) ENDDO ENDIF C C ELSEIF (MODE.EQ.3) THEN C C 3- PASSAGE DU RAYONNEMENT VERS LE FLUIDE C ======================================== C CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * TEMRAY,TRAYEN,TRAV) DO 320 N=1,NBRAF C NUMEL = NCFINF(N) C N1 = NODRAY(NUMEL,1) N2 = NODRAY(NUMEL,2) C XL1 = BARYFF(N,1) XL2 = BARYFF(N,2) C VRAPF(N,1) = TRAYEN(N1)*XL1 + TRAYEN(N2)*XL2 C 320 CONTINUE C C C 3.1- Impression pour controle C ----------------------------- IF (NBRAF .GE. 1 .AND. NBLBLR.GE.10) THEN WRITE(NFECRA,3040) DO N=1,NBRAF WRITE(NFECRA,3041) N,NRAPF(N,1),VRAPF(N,1) ENDDO ENDIF C C ELSEIF (MODE.EQ.4) THEN C C 4- PASSAGE DU FLUIDE VERS LE RAYONNEMENT C ======================================== C DO N=1,NELRAY ITRAV(N)=0 TRAV3(N)=0. TRAV4(N)=0. ENDDO C DO N=1,NNFRAY ITRAV(NCFRAY(N)) = N ENDDO C DO 400 N=1,NELRAY C IF (ITYFAR(N).EQ.4 .OR. ITYFAR(N).EQ.5) THEN C NN(1) = NODRAY(N,1) NN(2) = NODRAY(N,2) C DO 410 M=1,2 C IF (ITRAV(NN(M)).EQ.0) THEN GOTO 410 C ELSE C NUMEL = NCGROF(ITRAV(NN(M)),1) C NUMSEG = NCGROF(ITRAV(NN(M)),2) C IF (NUMSEG .EQ. 0) THEN N1 = NODRAF(NUMEL,1) N2 = NODRAF(NUMEL,2) ELSEIF (NUMSEG .EQ. 1) THEN N1 = NODRAF(NUMEL,1) N2 = NODRAF(NUMEL,3) ELSE N1 = NODRAF(NUMEL,2) N2 = NODRAF(NUMEL,3) ENDIF C XL1 = BARYFR(ITRAV(NN(M)),1) XL2 = BARYFR(ITRAV(NN(M)),2) C TT(M) = VRAPF(N1,1)*XL1 + VRAPF(N2,1)*XL2 XH(M) = VRAPF(N1,2)*XL1 + VRAPF(N2,2)*XL2 C ENDIF C 410 CONTINUE C TRAV3(N) = (TT(1)+TT(2)) * 0.5 TRAV4(N) = (XH(1)+XH(2)) * 0.5 C ENDIF C 400 CONTINUE C C 1.2 Impressions pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,4020) DO N=1,NELRAY WRITE(NFECRA,4021) N,TRAV3(N),TRAV4(N) ENDDO ENDIF C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C +++++++++++++++ C +++++++++++++++ C II. DIMENSION 3 C +++++++++++++++ C +++++++++++++++ ELSE C C 0- INITIALISATIONS C ================== C TIERS = 1./3. C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE RAYONNEMENT C ======================================== C DO N=1,NNSRAY ITRAV(NCSRAY(N)) = N ENDDO C DO 500 N=1,NELRAY C IF (ITYFAR(N).EQ.1) THEN NN(1) = NODRAY(N,1) NN(2) = NODRAY(N,2) NN(3) = NODRAY(N,3) C DO 510 M=1,3 C IF (ITRAV(NN(M)).EQ.0) THEN GOTO 510 C ELSE C NUMEL = NCGROS(itrav(NN(M)),1) NUMTRI = NCGROS(itrav(NN(M)),2) C IF (NUMTRI .EQ. 0) THEN N1 = NODERA(NUMEL,1) N2 = NODERA(NUMEL,2) N3 = NODERA(NUMEL,3) ELSEIF (NUMTRI .EQ. 1) THEN N1 = NODERA(NUMEL,1) N2 = NODERA(NUMEL,4) N3 = NODERA(NUMEL,6) ELSEIF (NUMTRI .EQ. 2) THEN N1 = NODERA(NUMEL,4) N2 = NODERA(NUMEL,5) N3 = NODERA(NUMEL,6) ELSEIF (NUMTRI .EQ. 3) THEN N1 = NODERA(NUMEL,2) N2 = NODERA(NUMEL,4) N3 = NODERA(NUMEL,5) ELSE N1 = NODERA(NUMEL,3) N2 = NODERA(NUMEL,5) N3 = NODERA(NUMEL,6) ENDIF C XL1 = BARYGR(itrav(NN(M)),1) XL2 = BARYGR(itrav(NN(M)),2) XL3 = BARYGR(itrav(NN(M)),3) C TT(M) = VRAYTS(N1,1)*XL1 + VRAYTS(N2,1)*XL2 * + VRAYTS(N3,1)*XL3 C ENDIF C 510 CONTINUE C TEMRAY(N) = (TT(1)+TT(2)+TT(3)) * TIERS C ENDIF C 500 CONTINUE C C C 1.2 Impressions pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,1020) DO 520 N=1,NELRAY WRITE(NFECRA,1021) N,TEMRAY(N) 520 CONTINUE ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU RAYONNEMENT VERS LE SOLIDE C ======================================== C CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * TRAYEQ,TRAYEN,TRAV) CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * ERAYEQ,ERAYEN,TRAV) C DO 600 N=1,NBRAYS C NUMEL = NCFIN(N) N1 = NODRAY(NUMEL,1) N2 = NODRAY(NUMEL,2) N3 = NODRAY(NUMEL,3) C XL1 = BARYFS(N,1) XL2 = BARYFS(N,2) XL3 = BARYFS(N,3) C VRAYTS(N,1)= TRAYEN(N1)*XL1 + TRAYEN(N2)*XL2 & +TRAYEN(N3)*XL3 VRAYTS(N,2)= ERAYEN(N1)*XL1 + ERAYEN(N2)*XL2 & +ERAYEN(N3)*XL3 C 600 CONTINUE C C 2.1- Impression pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,2030) DO 630 N=1,NBRAYS WRITE(NFECRA,2031) N,NRAYTS(N),VRAYTS(N,1),VRAYTS(N,2) 630 CONTINUE ENDIF C C ELSEIF (MODE.EQ.3) THEN C C 3- PASSAGE DU RAYONNEMENT VERS LE FLUIDE C ======================================== C CALL PRRFVN (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * TEMRAY,TRAYEN,TRAV) DO 720 N=1,NBRAF C NUMEL = NCFINF(N) C N1 = NODRAY(NUMEL,1) N2 = NODRAY(NUMEL,2) N3 = NODRAY(NUMEL,3) C XL1 = BARYFF(N,1) XL2 = BARYFF(N,2) XL3 = BARYFF(N,3) C VRAPF(N,1)= TRAYEN(N1)*XL1 + TRAYEN(N2)*XL2 & +TRAYEN(N3)*XL3 C 720 CONTINUE C C 3.1- Impression pour controle C ----------------------------- IF (NBRAF .GE. 1 .AND. NBLBLR.GE.10) THEN WRITE(NFECRA,3040) DO N=1,NBRAF WRITE(NFECRA,3041) N,NRAPF(N,1),VRAPF(N,1) ENDDO ENDIF C ELSEIF (MODE.EQ.4) THEN C C 4- PASSAGE DU FLUIDE VERS LE RAYONNEMENT C ======================================== C DO N=1,NELRAY ITRAV(N)=0 TRAV3(N)=0. TRAV4(N)=0. ENDDO C DO N=1,NNFRAY ITRAV(NCFRAY(N)) = N ENDDO C DO 800 N=1,NELRAY C IF (ITYFAR(N).EQ.4 .OR. ITYFAR(N).EQ.5) THEN NN(1) = NODRAY(N,1) NN(2) = NODRAY(N,2) NN(3) = NODRAY(N,3) C DO 810 M=1,3 C IF (ITRAV(NN(M)).EQ.0) THEN GOTO 810 C ELSE C NUMEL = NCGROF(itrav(NN(M)),1) C NUMTRI = NCGROF(itrav(NN(M)),2) C IF (NUMTRI .EQ. 0) THEN N1 = NODRAF(NUMEL,1) N2 = NODRAF(NUMEL,2) N3 = NODRAF(NUMEL,3) ELSEIF (NUMTRI .EQ. 1) THEN N1 = NODRAF(NUMEL,1) N2 = NODRAF(NUMEL,4) N3 = NODRAF(NUMEL,6) ELSEIF (NUMTRI .EQ. 2) THEN N1 = NODRAF(NUMEL,4) N2 = NODRAF(NUMEL,5) N3 = NODRAF(NUMEL,6) ELSEIF (NUMTRI .EQ. 3) THEN N1 = NODRAF(NUMEL,2) N2 = NODRAF(NUMEL,4) N3 = NODRAF(NUMEL,5) ELSE N1 = NODRAF(NUMEL,3) N2 = NODRAF(NUMEL,5) N3 = NODRAF(NUMEL,6) ENDIF C XL1 = BARYFR(itrav(NN(M)),1) XL2 = BARYFR(itrav(NN(M)),2) XL3 = BARYFR(itrav(NN(M)),3) C TT(M) = VRAPF(N1,1)*XL1 + VRAPF(N2,1)*XL2 * + VRAPF(N3,1)*XL3 XH(M) = VRAPF(N1,2)*XL1 + VRAPF(N2,2)*XL2 * + VRAPF(N3,2)*XL3 C ENDIF C 810 CONTINUE C TRAV3(N) = (TT(1)+TT(2)+TT(3)) * TIERS TRAV4(N) = (XH(1)+XH(2)+XH(3)) * TIERS C ENDIF C 800 CONTINUE C C C 6.2 Impressions pour controle C ----------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,4020) DO N=1,NELRAY WRITE(NFECRA,4021) N,TRAV3(N),TRAV4(N) ENDDO ENDIF C C C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C +++++++++++++++ C +++++++++++++++ ENDIF C C------- C FORMAT C------- C 1020 FORMAT(/,' *** PASRAY : PASSAGE DES DONNEES VERS LE', & ' RAYONNEMENT',/, & 5X,'Face de rayonnement T ') 1021 FORMAT(5X,3X,I7,14X,G13.7) 2030 FORMAT(/,' *** PASRAY : PASSAGE DES DONNEES DU RAYONNEMENT', & ' VERS LE SOLIDE',/, & 5X,'N solide N_global T equiv Emis equiv') 2031 FORMAT(5X,3X,I7,2X,I7,3X,G10.4,3X,G10.4,3X,G10.4) 3040 FORMAT(/,' *** PASRAY : PASSAGE DES DONNEES DU RAYONNEMENT', & ' VERS LE FLUIDE',/, & 5X,'Num fluide local Num fluide global T fluide') 3041 FORMAT(5X,I7,10X,I7,10X,G10.4) 3000 FORMAT(/,' %% ERREUR PASRAY : OPTION DE PASSAGE INCORRECTE ') 4020 FORMAT(/,' *** PASRAY : PASSAGE DES DONNEES FLUIDES VERS LE', & ' RAYONNEMENT',/, & 5X,'Face de rayonnement T fluide h fluide') 4021 FORMAT(5X,3X,I7,14X,G13.7,3X,G13.7) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/difsol.F0000666000175000017500000004357711524070641015350 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 **************** SUBROUTINE DIFSOL C ***************** C C --------------------------------------------------- *( TMPS,TMPSA,B,DMAT,XMAT,PHYSOL, * COORDS,NODES,NODEUS,NFLUVS,VFLUVS,NDIRS,VDIRS, * NCOUPS,VCOUPS,NFLUSS,VFLUSS,NECHS,VECHS, * NODERC,NODEPR,NPRIOS,NRESCS,VRESCS, * NRAYTS,VRAYTS,NBRAYS, * NRAYIS,VRAYIS,NBRAIS, * VOLUME,SURFUS,DIAG, * NELEMS,NPOINS,NDIM,NDIELE,NDMATS,NDMASS,NCOEMA, * NPOUE,NPPEL,NBPHYS, * NELEUS,NELERC,NELEPR, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL,NBRESS, * NBPRIO,NBCOPR, * NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS,NANGLE,TRAVF, * TRAV1,TRAV2,TRAV3,TRAV4,WCT) C ------------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- TRAITEMENT DE LA DIFFUSION SOLIDE * C CAS BIDIMENSIONNEL, AXISYMETRIQUE, COQUE * C ET TRIDIMENSIONNEL, PAR LA METHODE * C DES ELEMENTS FINIS * C * C On notera que les conditions limites de type flux et echange * C peuvent etre prise en compte de deux facons differentes * C * C Soit par points --> ce qui induit une facilite de prise * C en compte pour l'utilisateur, mais tend * C a lisser les discontinuites * C qui, il faut bien le reconnaitre ne sont pas* C tres "physiques", sauf pour le cas d'une * C rupture brutale de geometrie (type coin) * C * C Soit par faces --> ce qui induit une complexite plus grande * C pour l'utilisateur (en particulier pour * C ideas ou les notions de faces n'existe pas) * C mais permet de mieux apprehender * C les chargements discontinus * C (singularite par exemple de type step !) * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! TMPS ! TR ! R ! TEMPERATURE EN CHAQUE POINT A T = N + 1 ! C ! TMPSA ! TR ! D ! TEMPERATURE EN CHAQUE POINS A T = N ! C ! DMAT ! TR ! M ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! M ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! PHYSOL ! TR ! D ! CARACTERISTIQUE DU SOLIDE ! C ! ! ! ! physol(n,1) = rho (masse volumique) ! C ! ! ! ! physol(n,2) = Cp (chaleur massique) ! C ! ! ! ! physol(n,3) = k conductivite (ou k11) ! C ! ! ! ! a partir de 4 c'est optionnel si anisotr! C ! ! ! ! physol(n,4) = k conductivite (k22) ! C ! ! ! ! physol(n,5) = k conductivite k23 ou k33 ! C ! ! ! ! physol(n,6) = k conductivite k12 ! C ! ! ! ! physol(n,7) = k conductivite k13 ! C ! ! ! ! physol(n,8) = k conductivite k23 ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! NODEUS ! TE ! D ! // NOEUDS LOCAUX FLUX BORD --> GLOBAUX ! C ! NFLUVS ! TE ! D ! NUMERO DES POINTS DE FLUX VOLUMIQUE ! C ! VFLUVS ! TR ! D ! VALEUR DU FLUX AU POINT DE FLUX VOLUMIQUE! C ! NCOUPS ! TE ! D ! NUMERO DES POINTS DE COUPLAGE ! C ! VCOUPS ! TR ! D ! VALEUR DU FLUX AU POINT DE COUPLAGE ! C ! NFLUSS ! TE ! D ! NUMERO DES POINTS DE FLUX ! C ! VFLUSS ! TR ! D ! VALEUR DU FLUX AU POINT DE FLUX ! C ! NDIRS ! TE ! D ! NUMERO DES POINTS DE DIRICHLET ! C ! VDIRS ! TR ! D ! VALEUR DE DIRICHLET ! C ! NECHS ! TE ! D ! NUMERO DES POINTS DE COEF D'ECHANGE ! C ! VECHS ! TR ! D ! VALEUR POUR LES POINTS A COEF D'ECHANGE ! C ! ! TR ! D ! VECHS(n,1) = Temperature exterieure ! C ! ! TR ! D ! VECHS(n,2) = Coef d'echange ! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayont conf ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo conf aux points de la face! C ! NELERA ! E ! D ! Nombre de facette de type rayonnnt conf ! C ! NFRAIS ! TE ! D ! No de facette rayont infi ---> face glob ! C ! VFRAIS ! TR ! D ! Valeur du rayo infi aux points de la face! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnnt infi ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! SURFUS ! TR ! D ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! TRAV1 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV2 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV3 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV4 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAVF ! TR ! M ! TABLEAU DE TRAVAIL(Taille: NELEUS*NDMASS)! C ! WCT ! TR ! M ! TABLEAU DE TRAVAIL ( NELEMS * NDMATS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" C C*********************************************************************** C.. Variables externes INTEGER NPOINS,NELEMS,NDMATS,NELEUS,NDMASS,NDIM,NCOEMA,NDIELE INTEGER NPOUE,NPPEL,NBPHYS INTEGER NBCOUS,NBFLUS,NBECHS,NBFLVS,NPFEL,NBDIRS,NBPRIO,NBCOPR INTEGER NBRAYS,NBRAIS INTEGER NELERA,NBFRAI INTEGER NBRESS INTEGER NELERC,NELEPR INTEGER NBFFLU,NBFECH,NELESS INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFCOUS(NELESS) C INTEGER NODES(NELEMS,NDMATS) INTEGER NODEUS(NELEUS,NDMASS) INTEGER NODERC(NELERC,NDMASS),NODEPR(NELEPR,NDMATS+1) INTEGER NFLUVS(NBFLVS) INTEGER NDIRS(NBDIRS),NCOUPS(NBCOUS),NFLUSS(NBFLUS),NECHS(NBECHS) INTEGER NRESCS(NBRESS,2),NPRIOS(NBPRIO,1+NBCOPR) INTEGER NRAYTS(NBRAYS),NRAYIS(NBRAIS) INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI) INTEGER NANGLE(NELEMS) C DOUBLE PRECISION COORDS(NPOINS,NDIM),B(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VDIRS(NBDIRS),VCOUPS(NBCOUS,2) DOUBLE PRECISION VFLUSS(NBFLUS),VECHS(NBECHS,2) DOUBLE PRECISION DIAG(NPOINS),VOLUME(NELEMS),SURFUS(NELEUS) DOUBLE PRECISION VRESCS(NBRESS,2) DOUBLE PRECISION VRAYTS(NBRAYS,2),VRAYIS(NBRAIS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) C C tableaux de travail DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION TRAVF(NELEUS,NDMASS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C.. Variables internes DOUBLE PRECISION ZERO,RINDTS INTEGER I LOGICAL LVERIF C*********************************************************************** C 1- INITIALISATIONS C ================== C LVERIF = .TRUE. ZERO = 0.D0 C C C 2- CALCUL DE LA MATRICE DE MASSE MASSLUMPEE C =========================================== C C 2.1 Prise en compte du terme d'evolution en temps C ------------------------------------------------- IF (NDPROP .EQ. 1) THEN RINDTS = 1.D0 / RDTTS DO 20 I=1,NPOINS TRAV1(I) = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS 20 CONTINUE ENDIF C CALL MATELE ('MASSE ',TRAV2,XMAT,TRAV1,PHYSOL,NODES,COORDS, & VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & NPOUE,NPPEL,NBPHYS, & WCT ) C C C 2.2 Prise en compte des termes du a l'implicitation suivant C le mot cle LCLEXP C IF ( LCLEXP ) THEN C CALL OV ('X=C ',TRAV4,TRAV4,TRAV4,ZERO,NPOINS ) C ELSE C C IF ( LCFACE ) THEN CALL MAFCLI ( NFECHS,VFECHS,NBFECH, & NFRESC,VFRESC,NELERC, & NFRAYS,VFRAYS,NELERA, & NFRAIS,VFRAIS,NBFRAI, & NFCOUS,VFCOUS,NELESS, & TMPSA,NODEUS,COORDS,SURFUS, & NPOINS,NELEMS,NDIM,NELEUS,NDMASS, & TRAVF,TRAV4,WCT) C ELSE CALL MATCLI ( NCOUPS,VCOUPS,NECHS,VECHS, & NRESCS,VRESCS, & NRAYTS,VRAYTS,NBRAYS, & NRAYIS,VRAYIS,NBRAIS, & TMPSA,NODEUS,COORDS,SURFUS, & NPOINS,NELEMS,NDIM,NELEUS,NDMASS, & NBCOUS,NBECHS,NBRESS, & TRAV1,TRAV4,DIAG,WCT) ENDIF C ATTENTION : C =========== C ENDIF C C 3- CALCUL DE LA MATRICE DE DIFFUSION C ===================================== C C 3.1 Affectation de la conductivite k dans TRAV1 C ----------------------------------------------- C CALL MATELE ('DIFFU ',TRAV3,XMAT,TRAV1,PHYSOL,NODES,COORDS, & VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & NPOUE,NPPEL,NBPHYS, & WCT ) C C IF ( LCFACE ) THEN DO 310 I=1,NPOINS DMAT(I) = TRAV2(I) + TRAV3(I) + TRAV4(I) 310 CONTINUE ELSE DO 311 I=1,NPOINS DMAT(I) = TRAV2(I) + TRAV3(I) + TRAV4(I) + DIAG(I) 311 CONTINUE ENDIF C C C 3.2 Prise en compte des conditions periodiques sur la diagonale C --------------------------------------------------------------- C IF (NBPRIO .GT. 0) THEN CALL PERIOD(DMAT,TRAV1,NPOINS,NPRIOS,NBPRIO,NBCOPR) ENDIF C C C 4- CALCUL DU SECOND MEMBRE C ========================== C C 4.1 Calcul du second membre explicite (Etape n) C ----------------------------------------------- CALL SMEXPS ( TMPSA,B,TRAV2,NPOINS ) C C 4.2 Prise en compte d'un flux volumique C --------------------------------------- IF ( NBFLVS .GT. 0 ) THEN CALL SMFVOS ( NFLUVS,VFLUVS,B,NODES,VOLUME,COORDS, & NELEMS,NPOINS,NDMATS,NDIM,NBFLVS,NPFEL, & NDIELE,TRAV1,WCT) ENDIF C C 4.3 Prise en compte des conditions periodiques C ------------------------------------------------ IF (NBPRIO .GT. 0) THEN CALL PERIOD(B,TRAV1,NPOINS,NPRIOS,NBPRIO,NBCOPR) ENDIF C C C 4.4 Prise en compte des conditions de flux a la frontiere C ------------------------------------------------------ C cela comprend : C -------------- la partie couplee au fluide C la partie avec flux de bord utilisateur C la partie avec coefficient d'echange. C la partie avec resistance de contact C la partie avec rayonnement C C IF ( LCFACE ) THEN CALL SMFFLU ( NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, & NFRESC,VFRESC,NELERC, & NFRAYS,VFRAYS,NELERA, & NFRAIS,VFRAIS,NBFRAI, & NFCOUS,VFCOUS,NELESS, & TMPSA,B,NODEUS,COORDS,SURFUS, & NPOINS,NELEMS,NDIM,NELEUS,NDMASS, & TRAVF,TRAV4,WCT) ELSE CALL SMFLUS ( NCOUPS,VCOUPS,NFLUSS,VFLUSS,NECHS,VECHS, & NRESCS,VRESCS, & NRAYTS,VRAYTS,NBRAYS, & NRAYIS,VRAYIS,NBRAIS, & TMPSA,B,NODEUS,COORDS,SURFUS, & NPOINS,NELEMS,NDIM,NELEUS,NDMASS, & NBCOUS,NBFLUS,NBECHS,NBRESS, & TRAV1,TRAV4,DIAG,TRAV2,WCT) ENDIF C C C C 4.5 Prise en compte des conditions de Dirichlet C ----------------------------------------------- IF ( NBDIRS .GT. 0 ) THEN CALL SMDIRS ( NDIRS,VDIRS,B,DMAT,XMAT,NODES, & TRAV1,TRAV2,TRAV3, & NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, & NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, & WCT ) ENDIF C C C 4.6 Correction de la matrice pour les angles ouverts C --------------------------------------------------- ch CALL ANGOUV(NDIM,NPOINS,NELEMS,NCOEMA,NDMATS,NODES, ch * NANGLE,DMAT,XMAT) C C 5- ETAPE DE RESOLUTION DU SYSTEME LINEAIRE C ========================================== C C 5.1- Cas general (bidimensionnel, axisymetrique et C ------------------------------------------------- C tridimensionnel. C ---------------- CALL FLUSHF(NFECRA) C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPS,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C cc CALL GRCON3 ( TMPS,DMAT,XMAT,B,DIAG,NODES, cc & TRAV1,TRAV2,TRAV3,TRAV4,WCT, cc & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, cc & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C END syrthes-3.4.3-dfsg1/src/s/whisol.F0000666000175000017500000001320311524070641015354 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 **************** SUBROUTINE WHISOL C ***************** C C ---------------------------------------------- *(NDIM,NPOINS,COORDS,TMPSA,TMPS) C ---------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C --------- C C ECRITURE DES HISTORIQUES EN TEMPS SUR LE SOLIDE C C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBHSOL ! E ! D ! NOMBRE DE NOEUDS AVEC HISTORIQUE ! C ! NHISOL ! TE ! D ! NUMEROS DES NOEUDS AVEC HISTORIQUE ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE ETAPE n+1 ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE ETAPE n ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/HISSOL/! ! D ! ! C !/NLOFIC/! ! D ! ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ------ C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C************************************************************************* C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C... Declaration des variables externes C INTEGER NDIM,NPOINS DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) C C... Declaration des variables internes C INTEGER N,NUM C C C*********************************************************************** C C ---------------------- C 1- CAS DU MODELE COQUE C ---------------------- C IF (NCTHFS.EQ.2) THEN C DO 10 N=1,NBHSOL NUM = NHISOL(N) WRITE(NFHRCT,1000) TEMPSS,NUM, & COORDS(NUM,1),COORDS(NUM,2),COORDS(NUM,3), & TMPSA(NUM),TMPS(NUM) 10 CONTINUE CALL FLUSHF(NFHRCT) C C C ------------------------------ C 2- CAS DU MODELE GENERAL EN 2D C ------------------------------ C ELSEIF (NCTHFS.EQ.3 .AND. NDIM.EQ.2) THEN C DO 20 N=1,NBHSOL NUM = NHISOL(N) WRITE(NFHRCT,2000) TEMPSS,NUM, & COORDS(NUM,1),COORDS(NUM,2), & TMPS(NUM) 20 CONTINUE CALL FLUSHF(NFHRCT) C C ------------------------------ C 2- CAS DU MODELE GENERAL EN 3D C ------------------------------ C ELSEIF (NCTHFS.EQ.3 .AND. NDIM.EQ.3) THEN C DO 30 N=1,NBHSOL NUM = NHISOL(N) WRITE(NFHRCT,3000) TEMPSS,NUM, & COORDS(NUM,1),COORDS(NUM,2),COORDS(NUM,3), & TMPS(NUM) 30 CONTINUE CALL FLUSHF(NFHRCT) C C ENDIF C C C------- C FORMAT C------- C 1000 FORMAT ( 1X,E15.9,1X,I6,5(1X,E15.9)) 2000 FORMAT ( 1X,E15.9,1X,I6,3(1X,E15.9)) 3000 FORMAT ( 1X,E15.9,1X,I6,4(1X,E15.9)) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/diffco.F0000666000175000017500000007157411524070641015320 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=DIFFCO,SSI=0 C SUBROUTINE DIFFCO C ***************** C C --------------------------------------------------- *( TMPS,TMPSA,TMPSC1,TMPSC2,TMPSC3,B,DMAT, * XMAT,PHYSOL,COORDS,NODES,NFLUVS,VFLUVS, * NDIRS,VDIRS,NFCOUS,VFCOUS,NFFLUS,VFFLUS, * NFECHS,VFECHS,NFRAYS,VFRAYS,NPRIOS,NODEPR, * VOLUME,DIAG, * NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM, * NBDIRS,NBFFLU,NBFLVS,NBFECH,NBPHYS, * NBFRAY,NBPRIO,NBCOPR,NELEPR,TRAVF, * TRAV1,TRAV2,TRAV3,TRAV4,WCT ) C ---------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- TRAITEMENT DE LA DIFFUSION SOLIDE * C CAS COQUE * C Ce sous-programme traite les conditions exterieurs* C a partir des faces,ce qui permet une meilleure * C prise en compte des discontinuites, qui dans le * C cas coque ont une justification physique moins * C grande. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! TMPSA ! TR ! R ! TEMPERATURE EN CHAQUE POINT interieur ! C ! TMPS ! TR ! D ! TEMPERATURE EN CHAQUE POINT exterieur ! C ! TMPSC1 ! TR ! D ! 1er COEF DE TEMPERATURE ! C ! TMPSC2 ! TR ! D ! 2eme COEF DE TEMPERATURE ! C ! TMPSC3 ! TR ! D ! 3eme COEF DE TEMPERATURE ! C ! DMAT ! TR ! M ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! M ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! PHYSOL ! TR ! D ! CARACTERISTIQUE DU SOLIDE ! C ! ! ! ! physol(n,1) = rho masse vol ! C ! ! ! ! physol(n,2) = Cp chaleur specifique ! C ! ! ! ! physol(n,3) = k conductivite surfacique! C ! ! ! ! physol(n,4) = K conductivite epaisseur ! C ! ! ! ! physol(n,5) = H (R courbure principal) ! C ! ! ! ! physol(n,6) = e (epaisseur locale) ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NBFRAY ! E ! D ! Nombre de facette de type rayonnement ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN COQUE ! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! TRAV1 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV2 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV3 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV4 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL NELEMS * NDMATS ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM INTEGER NBDIRS,NBFLVS,NBPHYS INTEGER NBPRIO,NBCOPR,NELEPR INTEGER NBFFLU,NBFECH,NBFRAY INTEGER NODES(NELEMS,NDMATS),NODEPR(NELEPR,NDMATS+1) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NFLUVS(NBFLVS) INTEGER NDIRS(NBDIRS) INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH) INTEGER NFRAYS(NBFRAY),NFCOUS(NELEMS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMATS),VFECHS(NBFECH,NDMATS,2) DOUBLE PRECISION VFRAYS(NBFRAY,NDMATS,2) DOUBLE PRECISION VFCOUS(NELEMS,NDMATS,2),TRAVF(NELEMS,NDMATS) C DOUBLE PRECISION COORDS(NPOINS,NDIM),B(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS) DOUBLE PRECISION TMPSC3(NPOINS) DOUBLE PRECISION PHYSOL(NPOINS,NBPHYS) DOUBLE PRECISION VFLUVS(NBFLVS) DOUBLE PRECISION VDIRS(NBDIRS) DOUBLE PRECISION DIAG(NPOINS),VOLUME(NELEMS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C..Variables locales INTEGER I,J,INODE,NF LOGICAL LVERIF DOUBLE PRECISION S2EP,EPAIS1,ZERO,SUR3,SUR5,ROCP1,RINDTS DOUBLE PRECISION HRAYO,SIG,SIGMA C C*********************************************************************** C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. ZERO = 0.D0 LCOSTA = .TRUE. SIGMA = 5.67D-8 SIG = SIGMA*273.15**3 C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 2- CALCUL DE L'EQUATION SUR LE PREMIER COEFFICIENT C ================================================== C C C 2.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- DO 2101 J=1,NDMATS DO 2100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(INODE,5)) * VFCOUS(I,J,2) 2100 CONTINUE 2101 CONTINUE C DO 2111 J=1,NDMATS DO 2110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(INODE,5)) * VFECHS(I,J,2) 2110 CONTINUE 2111 CONTINUE C IF (.NOT. LCOSTA) THEN RINDTS = 1.D0 / RDTTS DO 2121 J=1,NDMATS DO 2120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(INODE,6) 2120 CONTINUE 2121 CONTINUE ENDIF C DO 2131 J=1,NDMATS DO 2130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(INODE,5)) * HRAYO 2130 CONTINUE 2131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE, & WCT ) C C C 2.2- Calcul du second membre C ---------------------------- C cela comprend : C le flux couple au fluide C le flux exterieur utilisateur C le flux avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C le second membre explicite (iteration n) C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 2211 J=1,NDMATS DO 2210 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) =(1.D0-EPAIS1*PHYSOL(INODE,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 2210 CONTINUE 2211 CONTINUE C DO 2221 J=1,NDMATS DO 2220 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFFLUS(I,J) 2220 CONTINUE 2221 CONTINUE C DO 2231 J=1,NDMATS DO 2230 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 2230 CONTINUE 2231 CONTINUE C C C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) DO 2240 I=1,NBFLVS INODE = NFLUVS(I) TRAV1(INODE) = VFLUVS(I) * PHYSOL(INODE,6) 2240 CONTINUE C C DO 2242 J=1,NDMATS DO 2241 I=1,NELEMS INODE = NODES(I,J) TRAVF(I,J) = TRAVF(I,J) + TRAV1(INODE) 2241 CONTINUE 2242 CONTINUE C C C C DO 2251 J=1,NDMATS DO 2250 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 TRAVF(I,J) = TRAVF(I,J) & - (1.D0-EPAIS1*PHYSOL(INODE,5)) * VFCOUS(I,J,2) & * ( - TMPSC2(INODE) + TMPSC3(INODE) ) 2250 CONTINUE 2251 CONTINUE C DO 2261 J=1,NDMATS DO 2260 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(INODE,5)) * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC3(INODE) ) 2260 CONTINUE 2261 CONTINUE C C Prise en compte du terme explicite en T1 etape n C Terme de masse (en temps) pour tous les points (instationnaire) IF ( .NOT. LCOSTA ) THEN RINDTS = 1.D0 / RDTTS DO 2271 J=1,NDMATS DO 2270 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(INODE,6) & * TMPSC1(INODE) 2270 CONTINUE 2271 CONTINUE ENDIF C DO 2281 J=1,NDMATS DO 2280 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(INODE,5)) & * HRAYO * VFRAYS(I,J,1) 2280 CONTINUE 2281 CONTINUE C C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 2.3- Calcul de la matrice de diffusion C -------------------------------------- C DO 2300 I=1,NPOINS TRAV1(I) = PHYSOL(I,6) * PHYSOL(I,3) 2300 CONTINUE C C Calcul de la matrice complete C DMAT contient la matrice de masse assemblee C XMAT contient les termes extras diagonaux CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C C 2.4- Resolution de la premiere equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC1,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C C C 3- CALCUL DE L'EQUATION SUR LE DEUXIEME COEFFICIENT C ================================================== C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 3.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 2.D0 / EPAIS1 DO 3101 J=1,NDMATS DO 3100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 TRAVF(NF,J) = S2EP * PHYSOL(INODE,4) + & (1.D0-EPAIS1*PHYSOL(INODE,5)) * VFCOUS(I,J,2) 3100 CONTINUE 3101 CONTINUE C DO 3111 J=1,NDMATS DO 3110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) * VFECHS(I,J,2) 3110 CONTINUE 3111 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3121 J=1,NDMATS DO 3120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * PHYSOL(INODE,6) 3120 CONTINUE 3121 CONTINUE ENDIF C C DO 3131 J=1,NDMATS DO 3130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(INODE,5)) * HRAYO 3130 CONTINUE 3131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE, & WCT ) C C 3.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 3.D0 DO 3200 I=1,NPOINS TRAV1(I) = S2EP * PHYSOL(I,3) * PHYSOL(I,6) 3200 CONTINUE C CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 3.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 3311 J=1,NDMATS DO 3310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = - (1.D0-EPAIS1*PHYSOL(INODE,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 3310 CONTINUE 3311 CONTINUE C DO 3321 J=1,NDMATS DO 3320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFFLUS(I,J) 3320 CONTINUE 3321 CONTINUE C DO 3331 J=1,NDMATS DO 3330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 3330 CONTINUE 3331 CONTINUE C DO 3341 J=1,NDMATS DO 3340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * HRAYO & * VFRAYS(I,J,1) 3340 CONTINUE 3341 CONTINUE C DO 3351 J=1,NDMATS DO 3350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0-EPAIS1*PHYSOL(INODE,5)) & * VFCOUS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) & - 2.D0*PHYSOL(INODE,5)*PHYSOL(INODE,4) & * TMPSC3(INODE) 3350 CONTINUE 3351 CONTINUE C DO 3361 J=1,NDMATS DO 3360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFECHS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3360 CONTINUE 3361 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3371 J=1,NDMATS DO 3370 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * & PHYSOL(INODE,6) * TMPSC2(INODE) 3370 CONTINUE 3371 CONTINUE ENDIF C DO 3381 J=1,NDMATS DO 3380 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(INODE,5)) & * HRAYO & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3380 CONTINUE 3381 CONTINUE C C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) DO 3390 I=1,NBFLVS INODE = NFLUVS(I) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAV1(INODE) = VFLUVS(I) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(INODE,5) ) 3390 CONTINUE C C DO 3392 J=1,NDMATS DO 3391 I=1,NELEMS INODE = NODES(I,J) TRAVF(I,J) = TRAVF(I,J) + TRAV1(INODE) 3391 CONTINUE 3392 CONTINUE C C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 3.4- Resolution de la deuxieme equation C --------------------------------------- C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC2,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 4- CALCUL DE L'EQUATION SUR LE TROISIEME COEFFICIENT C ==================================================== C C On resout une equation de diffusion C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 4.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 6.D0 DO 4101 J=1,NDMATS DO 4100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = S2EP * PHYSOL(INODE,4) / EPAIS1 & + (1.D0-EPAIS1*PHYSOL(INODE,5)) * VFCOUS(I,J,2) 4100 CONTINUE 4101 CONTINUE C DO 4111 J=1,NDMATS DO 4110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) * VFECHS(I,J,2) 4110 CONTINUE 4111 CONTINUE C IF ( .NOT. LCOSTA) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4121 J=1,NDMATS DO 4120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 * PHYSOL(INODE,6) 4120 CONTINUE 4121 CONTINUE ENDIF C DO 4131 J=1,NDMATS DO 4130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(INODE,5)) * HRAYO 4130 CONTINUE 4131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE, & WCT ) C C 4.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 5.D0 DO 4200 I=1,NPOINS TRAV1(I) = S2EP * PHYSOL(I,3) * PHYSOL(I,6) 4200 CONTINUE C CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 4.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C IF ( .NOT. LCOSTA ) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4301 J=1,NDMATS DO 4300 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(INODE,1) * PHYSOL(INODE,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 & * PHYSOL(INODE,6) * TMPSC3(INODE) 4300 CONTINUE 4301 CONTINUE ENDIF C C DO 4311 J=1,NDMATS DO 4310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(INODE,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 4310 CONTINUE 4311 CONTINUE C DO 4321 J=1,NDMATS DO 4320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFFLUS(I,J) 4320 CONTINUE 4321 CONTINUE C DO 4331 J=1,NDMATS DO 4330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 4330 CONTINUE 4331 CONTINUE C DO 4341 J=1,NDMATS DO 4340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(INODE,5)) & * HRAYO & * VFRAYS(I,J,1) 4340 CONTINUE 4341 CONTINUE C C C DO 4351 J=1,NDMATS DO 4350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(INODE,6)* 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(INODE,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * VFCOUS(I,J,2) & - 2.D0*PHYSOL(INODE,5)*PHYSOL(INODE,4) & * TMPSC2(INODE) 4350 CONTINUE 4351 CONTINUE C DO 4361 J=1,NDMATS DO 4360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(INODE,5)) & * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC1(INODE) ) 4360 CONTINUE 4361 CONTINUE C DO 4371 J=1,NDMATS DO 4370 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(INODE,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIG*(TMPS(INODE)+VFRAYS(I,J,1))* & (TMPS(INODE)*TMPS(INODE)+VFRAYS(I,J,1)*VFRAYS(I,J,1)) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(INODE,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * HRAYO c & - 2.D0*PHYSOL(INODE,5)*PHYSOL(INODE,4) c & * TMPSC2(INODE) 4370 CONTINUE 4371 CONTINUE C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C C DO 438 I=1,NBDIRS VDIRS(I) = VDIRS(I) - TMPSC1(NDIRS(I)) & + TMPSC2(NDIRS(I)) 438 CONTINUE C C IF ( NBDIRS .GT. 0 ) THEN CALL SMDIRS ( NDIRS,VDIRS,B,DMAT,XMAT,NODES, & TRAV1,TRAV2,TRAV3, & NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, & NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, & WCT ) ENDIF C C 4.4- Resolution de la Troisieme equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC3,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 5- CALCUL DE LA TEMPERATURE SUR LES DEUX FACES INT ET EXT C ========================================================= C C 5.1 Calcul du point interieur C ----------------------------- DO 510 I=1,NPOINS TMPSA(I) = TMPSC1(I) - TMPSC2(I) + TMPSC3(I) 510 CONTINUE C C 5.2 Calcul du point exterieur C ----------------------------- DO 520 I=1,NPOINS TMPS(I) = TMPSC1(I) + TMPSC2(I) + TMPSC3(I) 520 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/ecrg2r.F0000666000175000017500000001127211524070641015237 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ECRG2R,SSI=0 C SUBROUTINE ECRG2R C ***************** C C ------------------------------- *(TRESU,NLONGT,NOMT,CT,NFIC) C ------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C * C FONCTION : * C -------- * C GENERATION DU FICHIER RESULTAT SYRTHES * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! TYPDOM ! A ! D ! TYPE DE MAILLAGE TRAITE (SOLIDE OU FUIDE) ! C ! ! ! ! (= 'S' pour le solide et 'F' pour le fluide)! C ! ! ! ! (non utilise dans cette version) ! C ! TRESU ! TR ! D ! TABLEAU DE RESULTATS A ECRIRE ! C ! NLONGT ! E ! D ! NOMBRE D'ELEMENTS DU TABLEAU TRESU ! C ! NOMT ! A ! D ! NOM DE LA VARIABLE A ECRIRE ! C ! LENTET ! L ! D ! INDICATEUR D'ECRITURE DE L'ENTETE ! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ECRSOL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C C********************************************************************** C C.. Variables externes INTEGER NLONGT,NFIC DOUBLE PRECISION TRESU(NLONGT) CHARACTER NOMT*12,CT*1 C C.. Variables internes INTEGER I CHARACTER CH*12 C C C********************************************************************** C C 1- TRAITEMENT DES VALEURS PSEUDO-NULLES C ======================================= C DO 10 I=1,NLONGT IF (ABS(TRESU(I)) .LE. 1.E-10) TRESU(I) = 0. 10 CONTINUE C C C 2- ECRITURE DU TABLEAU DE RESULTATS C =================================== C CH=CT//'-----------' WRITE(NFIC,1000) NOMT,CH WRITE(NFIC,1010) (TRESU(I),I=1,NLONGT) C C-------- C FORMATS C-------- 1000 FORMAT(A12,/,A12) 1010 FORMAT(6E13.7) C C C END syrthes-3.4.3-dfsg1/src/s/resray.F0000666000175000017500000001776711524070641015377 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE RESRAY C ***************** C C ------------------------------------------------------------- * (NDIM,NELRAY,NPOINR,COORAY,NODRAY,NRFRAY, * FDFRAY,SUFRAY,TEMRAY,RADIOS,FIRAY,TRAYEQ,ERAYEQ, * EMISSI,EPROPR,NFFIRA,NGFFIR,VFIRAY,TABRAY, * NFMST,NGFMST,FLUMST,PHMSTO) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C C TRAITEMENT DU RAYONNEMENT TRANSPARENT C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofct.h" #include "mobil.h" #include "divct.h" #include "nlofes.h" #include "rayonn.h" #include "syrthu.h" C C ********************************************************************** C C.. Variables externes INTEGER NDIM,NELRAY,NPOINR,NFFIRA,NFMST,NBSCAL INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY),NGFFIR(NFFIRA) INTEGER NGFMST(NFMST,2) DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION TEMRAY(NELRAY),RADIOS(NELRAY,NBANDE) DOUBLE PRECISION FIRAY(NELRAY,NBANDE),EMISSI(NELRAY,2,NBANDE) DOUBLE PRECISION EPROPR(NELRAY,NBANDE) DOUBLE PRECISION ERAYEQ(NELRAY),TRAYEQ(NELRAY) DOUBLE PRECISION SUFRAY(NELRAY) DOUBLE PRECISION COORAY(NPOINR,NDIM) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) DOUBLE PRECISION TABRAY(NELRAY,9) DOUBLE PRECISION FLUMST(NFMST,NBANDE),PHMSTO(NFMST,5,NBANDE) C C C..Variables Internes INTEGER NUMBS,N,NGFAC,I LOGICAL LPREM CHARACTER*2 CHI C C*********************************************************************** DATA LPREM / .TRUE. / SAVE LPREM C C 1- PROPRIETES PHYSIQUES ET CONDITIONS AUX LIMITES C ================================================= C DO N=1,NELRAY TEMRAY(N) = TEMRAY(N) + TKEL ENDDO C DO NUMBS=1,NBANDE DO N=1,NELRAY EMISSI(N,2,NUMBS)=1-EMISSI(N,1,NUMBS) ENDDO ENDDO C IF (NFMST.GT.0) THEN DO NUMBS=1,NBANDE DO N=1,NFMST EMISSI(NGFMST(N,1),1,NUMBS)=PHMSTO(N,1,NUMBS) EMISSI(NGFMST(N,1),2,NUMBS)=PHMSTO(N,2,NUMBS) ENDDO ENDDO ENDIF C C C 2- RESOLUTION DE LA DIFFUSION SOLIDE C ==================================== C DO 200 NUMBS=1,NBANDE C CALL SMBRAY (NUMBS,NELRAY,SUFRAY,TEMRAY,EMISSI,EPROPR, * TABRAY(1,9)) C DO N=1,NFFIRA NGFAC = NGFFIR(N) EPROPR(NGFAC,NUMBS) = VFIRAY(N,NUMBS,1)*SUFRAY(NGFAC) ENDDO C IF (NTSYR.GT.1) THEN DO N=1,NFMST NGFAC = NGFMST(N,1) EPROPR(NGFAC,NUMBS) = EPROPR(NGFAC,NUMBS) * + FLUMST(N,NUMBS)*SUFRAY(NGFAC) ENDDO ENDIF C 200 CONTINUE C IF (LPREM) THEN DO I=1,NBANDE DO N=1,NELRAY RADIOS(N,I) = EPROPR(N,I)/SUFRAY(N) ENDDO ENDDO LPREM = .FALSE. ENDIF C WRITE(NFECRA,2300) DO 230 NUMBS=1,NBANDE CALL GAUSEI(NELRAY,NUMBS,FDFRAY,SUFRAY,EMISSI,EPROPR, * NFFIRA,NGFFIR,RADIOS,TABRAY) 230 CONTINUE C C 3- PREPARATION DES DONNEES EQUIVALENTES C ======================================= C CALL FI2TEQ(NELRAY,NFFIRA,NGFFIR,EMISSI,TEMRAY,FIRAY,VFIRAY, * FDFRAY,RADIOS,ERAYEQ,TRAYEQ,SUFRAY,TABRAY(1,9)) C DO N=1,NELRAY TEMRAY(N) = TEMRAY(N) - TKEL TRAYEQ(N) = TRAYEQ(N) - TKEL ENDDO C C C 4- ECRITURES SUR FICHIERS C ========================= C IF (LHISOR) CALL WHISOR(NELRAY,TEMRAY) C C fichier chrono C -------------- IF (NCHROR.GE.1 .AND. * (MOD ((NTSYR-NTSYRD),NCHROR).EQ.0 .OR. * (MOD ((NTSYR-NTSYRD),NCHROR).NE.0 .AND. * (LDERN.OR.LSTOPS) )) ) THEN NBSCAL=1+NBANDE CALL ECRG2E(NBSCAL,NFGCRA,NDIM,NDIM-1,NELRAY,NPOINR) CALL ECRG3E(NFGCRA) C CALL ECRG2R(TEMRAY,NELRAY,'T_RAYT ','1',NFGCRA) DO NUMBS=1,NBANDE IF (NUMBS.LE.9) THEN CHI(1:1)='0' WRITE(CHI(2:2),'(I1)') NUMBS ELSE WRITE(CHI,'(I2)') NUMBS ENDIF CALL ECRG2R(FIRAY(1,NUMBS),NELRAY, & 'FLUX_RAY_B'//CHI,'1',NFGCRA) ENDDO CALL FLUSHF(NFGCRA) ENDIF C C fichier resultat C ---------------- IF (LDERN.OR.LSTOPS) THEN C CALL ECRG3E(NFGRRA) CALL ECRG2R(TEMRAY,NELRAY,'T_RAYT ','1',NFGRRA) DO NUMBS=1,NBANDE IF (NUMBS.LE.9) THEN CHI(1:1)='0' WRITE(CHI(2:2),'(I1)') NUMBS ELSE WRITE(CHI,'(I2)') NUMBS ENDIF CALL ECRG2R(FIRAY(1,NUMBS),NELRAY, & 'FLUX_RAY_B'//CHI,'1',NFGRRA) ENDDO CALL FLUSHF(NFGRRA) ENDIF C C C-------- C FORMATS C-------- C 1000 FORMAT(/, * 5X,30('-'),/, * 5X,'TRAITEMENT DU RAYONNEMENT',/, * 5X,30('-')) C 2300 FORMAT(/, * 5X,40('='),/, * 5X,'RESOLUTION DU SYSTEME LIE AU RAYONNEMENT',/, * 5X,40('='),/) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/lrasi3.F0000666000175000017500000002654411524070641015260 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRASI3 C ***************** C C ----------------------------------------- * (NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) C ----------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS RAYONNEMENT * C STRUCTURE DE DONNEE ISSUE DE SIMAIL * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (3 ) ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! D ! NOMBRE D'ELTS DU MAILLAGE RAYONNEMENT ! C ! NODRAY ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE RAYONNEMENT ! C ! NRFRAY ! TE ! R ! TABLEAU DES REFERENCES ELTS MAILLAGE RAYT ! C ! COORAY ! TR ! R ! COORD DES NOEUDS DU MAILLAGE RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! ! ! C ! /DIVCT/ ! ! ! ! C ! /NLOFES/ ! ! ! ! C ! /NLOFCT/ ! ! ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NPOINR,NDIM INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY) DOUBLE PRECISION COORAY(NPOINR,NDIM) C C.. Variables internes INTEGER I,J INTEGER LE,NT0,NT2,NT4,NT5,M(32),MM INTEGER NP,NCGE,NMAE,NNO,INING,NE,NN,NT3,NBEGM INTEGER NFAC(3), NARE(3), NSOM INTEGER NNMAE(0:20) C #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C C 1- INITIALISATION DES TABLEAUX D'INDICATEURS C ============================================ C NFAC(1) = 0 NFAC(2) = 0 NFAC(3) = 0 C IF (NDIM.EQ.3) THEN NARE(1) = 3 NARE(2) = 3 NARE(3) = 0 ELSE NARE(1) = 0 NARE(2) = 0 NARE(3) = 0 ENDIF C NSOM = NDIM C DO 5 I=0,20 NNMAE(I) = 1 5 CONTINUE NNMAE(0) = 0 C C C 2- LECTURE DU MAILLAGE C ====================== C #ifdef HAVE_C_IO CALL REWDBF (NFSGRA, IERROR) IF (IERROR .NE. 0) GOTO 998 #else REWIND NFSGRA #endif C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGRA) LE, (M(I), I=1,LE) #endif NT0 = M(2) NT2 = M(4) NT3 = M(5) NT4 = M(6) NT5 = M(7) C C C Lecture du tableau 0 C -------------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, NT0, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGRA) LE, (M(I), I=1,NT0) #endif C C Lecture du tableau 2 C -------------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, NT2, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGRA) LE,(M(I),I=1,NT2) #endif C NP = M(22) NN = M(15) NE = M(5) NBEGM=M(25) C #ifdef HAVE_C_IO IF (NT3.GT.0) THEN ccc IF (NBEGM.GT.0) THEN NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF ENDIF #else IF (NT3.GT.0) READ(NFSGRA,ERR=999) LE ccc IF (NBEGM.GT.0) READ(NFSGRA,ERR=999) LE #endif C C lecture du tableau 4 C -------------------- C #ifdef CRAY READ(NFSGRA) LE,( (COORAY(I,J),J=1,NDIM) , I=1,NP) #else CALL LCOODP(COORAY,COORAY,NP,NDIM,NPOINR,NFSGRA) #endif C C lecture du tableau 5 C -------------------- C #ifdef HAVE_C_IO C NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 C DO I = 1, NE C CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NCGE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NMAE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NRFRAY(I), & IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NNO, IERROR) IF (IERROR .NE. 0) GOTO 998 C DO J = 1, NNO CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NODRAY(I,J), & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO IF (NMAE.NE.0) THEN CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, INING, & IERROR) IF (IERROR .NE. 0) GOTO 998 IF (INING.EQ.1) THEN DO J = 1, NFAC(INING) CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF IF (INING.LE.2) THEN DO J = 1, NARE(INING) CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF DO J = 1, NSOM CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF C ENDDO C #else INING=1 READ(NFSGRA) LE, & ( NCGE,NMAE, & NRFRAY(I), & NNO, (NODRAY(I,J),J=1,NNO), & (INING, J=1,NNMAE(NMAE) ), & (MM, J=1,NFAC(INING)*NNMAE(NMAE) ), & (MM, J=1,NARE(INING)*NNMAE(NMAE) ), & (MM, J=1,NSOM*NNMAE(NMAE) ) & , I=1,NE ) #endif C C C 4- IMPRESSION SUR LISTING C ========================= C IF (NBLBLR.GT.0) THEN WRITE(NFECRA,4000) WRITE(NFECRA,4010) NDIM,NN,NE ENDIF C C C 6- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLR.GE.2) THEN C WRITE(NFECRA,5000) WRITE(NFECRA,5010) DO 100 I=1,10 WRITE(NFECRA,5011) I,(COORAY(I,J),J=1,NDIM) 100 CONTINUE C WRITE(NFECRA,5020) DO 110 I=1,10 WRITE(NFECRA,5012)I,(NODRAY(I,J),J=1,NDIM) 110 CONTINUE C WRITE(NFECRA,5030) DO 120 I=1,10 WRITE(NFECRA,5013)I,NRFRAY(I) 120 CONTINUE C ENDIF C RETURN C #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #else 999 CONTINUE WRITE(NFECRA,9999) STOP #endif /* HAVE_C_IO */ C C-------- C FORMATS C-------- C 4000 FORMAT(//,' *** LRASI3 : MAILLAGE POUR LE RAYONNEMENT :') 4010 FORMAT(8X,'- Dimension du maillage : ',I6,/ & 8X,'- Nombre de noeuds : ',I6,/ & 8X,'- Nombre d''elements : ',I6) C 5000 FORMAT(/,' *** LRASI3 : Verification du maillage rayonnement',/) 5010 FORMAT(/,14X,'Coordonnees des 10 premiers noeuds :',/) 5020 FORMAT(/,14X,'Table des 10 premiers elements :',/) 5030 FORMAT(/,14X,'References des 10 premiers elements :',/) 5011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 5012 FORMAT(14X,'N=',I2,' NOEUDS : ',10I6) 5013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LRASI3 : erreur de lecture du maillage ', * 'de rayonnement',/,' de type : ',A) #endif C 9999 FORMAT(' %% ERREUR LRASI3 : erreur de lecture du maillage ', * 'de rayonnement') END syrthes-3.4.3-dfsg1/src/s/flushf.F0000666000175000017500000000564311524070641015347 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE FLUSHF C ***************** C * (NFIC) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C VIDER UN BUFFER * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C*********************************************************************** C C*********************************************************************** integer nfic,stream_ptr,iretour C C #ifdef __hpux $alias flush_c='fflush'(%val) stream_ptr = FSTREAM (nfic) iretour = flush_c (stream_ptr) #else CALL FLUSH(NFIC) #endif C END syrthes-3.4.3-dfsg1/src/s/lecmaill.c0000666000175000017500000001574611524070641015704 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | lecmai | | Lecture des maillages | |======================================================================| */ proc(void lmails,void LMAILS)(int *type,int *lcface, int *ndim,int *ndiele,int *npoins,int *nelems, int *neless,int *neleus,int *nelepr,int *nelerc, int *nelera,int *nbface,int *nbcous,int *nbflus, int *nbdirs,int *nbechs,int *nbflvs,int *nbress, int *nbrays,int *nbrais,int *nbprio,int *nbmobs, int *nrajou,int *nbfflu,int *nbfech,int *nbfrai, int *nfbida) { int i,nt5; int nbfac,nbaret,nbsom,nn; int *iref,*inoeud,*iface,*ielt,*it5,*itab,*itab1,*itab2,*itrmed; if (*ndiele==2) {nbfac=0;nbaret=3;nbsom=3;nn=6;} else {nbfac=4;nbaret=6;nbsom=4;nn=10;} if (*type==1) proc(lecsi1,LECSI1)(npoins,nelems,&nt5); else if (*type==2) proc(lecid1,LECID1)(npoins,nelems,nfbida,ndiele); else if (*type==3) proc(lecsy1,LECSY1)(npoins,nelems); #ifdef MED else if (*type==4) proc(lecme1,LECME1)(npoins,nelems,&nn); #endif iref=(int*)malloc(*npoins*sizeof(int)); inoeud=(int*)malloc(*nelems*nn*sizeof(int)); iface=(int*)malloc(*nelems* *nbface*sizeof(int)); ielt=(int*)malloc(*nelems*sizeof(int)); if (!iref||!inoeud||!iface||!ielt) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} for(i=0;i<*npoins;i++) *(iref+i)=0; for(i=0;i<*nelems*nn;i++) *(inoeud+i)=0; for(i=0;i<*nelems* *nbface;i++) *(iface+i)=0; for(i=0;i<*nelems;i++) *(ielt+i)=0; if (*type==1) { it5=(int*)malloc(nt5*sizeof(int)); if (!it5) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} proc(lecsi2,LECSI2)(ndim,ndiele,npoins,nelems,nbface,&nn, iref,inoeud,iface,ielt,&nt5,it5); free(it5); } else if (*type==2) proc(lecid2,LECID2)(ndim,ndiele,npoins,nelems,nfbida,nbface,&nn, iref,inoeud,iface,ielt); else if (*type==3) proc(lecsy2,LECSY2)(ndim,ndiele,npoins,nelems,nbface,&nn, iref,inoeud,iface,ielt); #ifdef MED else if (*type==4) { itrmed=(int*)malloc(*nelems*nn*sizeof(int)); proc(lecme2,LECME2)(ndim,npoins,nelems,nbface,&nn, iref,inoeud,iface,ielt,itrmed); free(itrmed); } #endif if (!*lcface) { itab=(int*)malloc(*npoins*sizeof(int)); if (!itab) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} proc(cmptno,CMPTNO)(iref,npoins,nbcous,nbflus,nbdirs,nbechs, nbress,nbrays,nbrais,nbprio,nbmobs); proc(cmptel,CMPTEL)(inoeud,iref,itab, npoins,ndiele,&nn,nbface, nelems,neless,neleus,nelepr,nelerc,nelera, nbflus,nrajou); nbfflu = 0;nbfech = 0; nbfrai = 0; free(itab); } else { itab1=(int*)malloc(*npoins*sizeof(int)); itab2=(int*)malloc(*npoins*sizeof(int)); if (!itab1||!itab2) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} proc(cmptfa,CMPTFA)(ndiele,iface,inoeud,&nn,nelems,nbface, neless,neleus, nbfflu,nbfech,nelerc,nelepr,nelera,nbfrai, iref,npoins,nbcous,nbdirs,nbress,nbprio,nbmobs, nbflus,nbechs,nbrays,nbrais,itab1,itab2); free(itab1);free(itab2); } proc(cmptfv,CMPTFV)(iref,ielt,npoins,nelems,nbflvs); free(iref); free(inoeud); free(iface); free(ielt); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | lecmai | | Lecture des maillages | |======================================================================| */ proc(void lmailr,void LMAILR)(int *type, int *ndim,int *npoinr,int *nelray,int *nnsray, int *nnfray,int *nneray,int *nfcfra,int *nfcsra, int *nftira,int *nffira,int *nfpera, int *nfmst,int *nfmste) { int i; int *iref,*inoeud,*itab1,*itab2; if (*type==1) proc(lrasi1,LRASI1)(ndim,npoinr,nelray); else if (*type==2) proc(lraid1,LRAID1)(ndim,npoinr,nelray); else if (*type==3) proc(lrasy1,LRASY1)(ndim,npoinr,nelray); #ifdef MED else if (*type==4) proc(lrame1,LRAME1)(ndim,npoinr,nelray); #endif iref=(int*)malloc(*nelray*sizeof(int)); inoeud=(int*)malloc(*nelray* *ndim*sizeof(int)); if (!iref||!inoeud) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} for(i=0;i<*nelray;i++) *(iref+i)=0; for(i=0;i<*nelray* *ndim;i++) *(inoeud+i)=0; if (*type==1) proc(lrasi2,LRASI2)(ndim,npoinr,nelray,iref,inoeud); else if (*type==2) proc(lraid2,LRAID2)(ndim,npoinr,nelray,iref,inoeud); else if (*type==3) proc(lrasy2,LRASY2)(ndim,npoinr,nelray,iref,inoeud); #ifdef MED else if (*type==4) proc(lrame2,LRAME2)(ndim,npoinr,nelray,iref,inoeud); #endif itab1=(int*)malloc(*npoinr*sizeof(int)); itab2=(int*)malloc(*npoinr*sizeof(int)); if (!itab1||!itab2) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} proc(lnray1,LNRAY1) (ndim,nelray,inoeud,iref,npoinr, itab1,itab2,nnsray,nnfray,nneray); free(itab1); free(itab2); proc(lfray1,LFRAY1) (nelray,iref, nfcfra,nfcsra,nftira,nffira,nfpera, nfmst,nfmste); free(iref); free(inoeud); } syrthes-3.4.3-dfsg1/src/s/lnray1.F0000666000175000017500000001334711524070642015267 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LNRAY1 C ***************** C C ------------------------------------------------------------- * (NDIM,NELRAY,NODRAY,NRFRAY,NPOINR,ITRAV1,ITRAV2, * NNSRAY,NNFRAY,NNERAY) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C FONCTION : * C ---------- * C NOMBRES DE NOEUDS POUR LE MAILLAGE RAYONNEMENT * C - noeuds couples avec le fluide * C - noeuds couples avec le solide * C - noeuds entree/sortie * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (3 ) ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! D ! NOMBRE D'ELTS DU MAILLAGE RAYONNEMENT ! C ! NODRAY ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE RAYONNEMENT ! C ! NRFRAY ! TE ! R ! TABLEAU DES REFERENCES ELTS MAILLAGE RAYT ! C ! COORAY ! TR ! R ! COORD DES NOEUDS DU MAILLAGE RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! ! ! C ! /DIVCT/ ! ! ! ! C ! /NLOFES/ ! ! ! ! C ! /NLOFCT/ ! ! ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "xrefer.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NPOINR,NDIM,NNSRAY,NNFRAY,NNERAY INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY) INTEGER ITRAV1(NPOINR),ITRAV2(NPOINR) C C.. Variables internes INTEGER N,M,NF,I LOGICAL LS C C*********************************************************************** C C 1- INITIALISATION C ================= C DO N=1,NPOINR ITRAV1(N) = 0 ITRAV2(N) = 0 ENDDO C C C 2- MARQUAGE DES NOEUDS C ====================== C DO 200 N=1,NELRAY C NF = NRFRAY(N) C LS = .FALSE. DO M=1,NRFMAX IF (IRERCS(M).NE.0 .AND. NF.EQ.M) LS = .TRUE. ENDDO C IF (LS) THEN DO I=1,NDIM ITRAV1(NODRAY(N,I)) = 1 ENDDO ENDIF C LS = .FALSE. DO M=1,NRFMAX IF ((IRERCF(M).NE.0 .OR. IRESTF(M).NE.0 ) * .AND. NF.EQ.M) LS = .TRUE. ENDDO C IF (LS) THEN DO I=1,NDIM ITRAV2(NODRAY(N,I)) = 1 ENDDO ENDIF C 200 CONTINUE C C 3- GENERATION DES LISTES C ======================== C NNSRAY = 0 NNFRAY = 0 NNERAY = 0 C DO N=1,NPOINR IF (ITRAV1(N).EQ.1) NNSRAY = NNSRAY + 1 IF (ITRAV2(N).EQ.1) NNFRAY = NNFRAY + 1 ENDDO C C C C-------- C FORMATS C-------- C C END syrthes-3.4.3-dfsg1/src/s/cocoin.F0000666000175000017500000002123211524070642015323 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=COCOIN,SSI=0 SUBROUTINE COCOIN C ***************** C C ------------------------------------------------------- * (NDIM,NPOINS,NBCOUS,NBCOUF,NBICOR,COORDS,COORDF, * NCBORF,NCBORS,NCOUPS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA TABLE DE CORRESPONDANCE ENTRE LES * C NOEUDS COUPLES DES MAILLAGES FLUIDE ET SOLIDE * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! COORDF ! TR ! D ! COORDONNEES DES NOEUDS FLUIDES COUPLES ! C ! NCBORF ! TE ! R ! NUMERO DU NOEUD SOLIDE CORRESPONDANT ! C ! NCBORS ! TE ! R ! NUMERO DU NOEUD FLUIDE CORRESPONDANT ! C ! NCOUPS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "mobil.h" #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS INTEGER NBCOUS,NBCOUF,NBICOR INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) INTEGER NCOUPS(NBCOUS) DOUBLE PRECISION COORDS(NPOINS,NDIM),COORDF(NBCOUF,NDIM) C C.. Variables internes INTEGER N,NS,NF,NGS,NLMIN DOUBLE PRECISION XF,YF,ZF,XS,YS,ZS,D2,DMIN,DMAX C C*********************************************************************** C C 0.1- INITIALISATIONS C ==================== C DO 1 N=1,NBCOUS*NBICOR NCBORS(N,1) = -1 1 CONTINUE C DMAX = 0 C C 0.2- VERIFICATION DE BASE C ========================= C IF (NBCOUS.NE.NBCOUF) THEN WRITE(NFECRA,999) NBCOUS,NBCOUF STOP ENDIF C C 1- CORRESPONDANCE FLUIDE-->SOLIDE ET SOLIDE-->FLUIDE EN 2D C ========================================================== C IF (NDIM .EQ. 2) THEN C C IF (NBLBLA.GE.3) WRITE(NFECRA,1000) C C 1.1- Pour chaque point du maillage fluide... C -------------------------------------------- DO 100 NF=1,NBCOUF C DMIN = 1.D6 NLMIN = 0 C XF = COORDF(NF,1) YF = COORDF(NF,2) C C DO 110 NS=1,NBCOUS C NGS = NCOUPS(NS) C XS = COORDS(NGS,1) YS = COORDS(NGS,2) C D2 = (XS-XF)*(XS-XF) + (YS-YF)*(YS-YF) C IF (D2.LT.DMIN) THEN DMIN = D2 NLMIN = NS ENDIF C 110 CONTINUE C C 1.2- Mise a jour des correspondants C ----------------------------------- IF (NLMIN.NE.0) THEN NCBORF(NF,1) = NLMIN NCBORS(NLMIN,1) = NF IF (DMIN.GT.DMAX) DMAX = DMIN ELSE WRITE(NFECRA,1200) NF ENDIF C 100 CONTINUE C C C 2- CORRESPONDANCE FLUIDE-->SOLIDE EN DIMENSION 3 C ================================================ C ELSEIF (NDIM .EQ. 3) THEN C C IF (NBLBLA.GE.3) WRITE(NFECRA,1000) C C 2.1- Pour chaque point du maillage fluide... C -------------------------------------------- DO 200 NF=1,NBCOUF C DMIN = 1.D6 NLMIN = 0 C C Coordonnees du noeud fluide XF = COORDF(NF,1) YF = COORDF(NF,2) ZF = COORDF(NF,3) C C DO 210 NS=1,NBCOUS C NGS = NCOUPS(NS) C XS = COORDS(NGS,1) YS = COORDS(NGS,2) ZS = COORDS(NGS,3) C D2 = (XS-XF)*(XS-XF) + (YS-YF)*(YS-YF) + (ZS-ZF)*(ZS-ZF) C IF (D2.LT.DMIN) THEN DMIN = D2 NLMIN = NS ENDIF C 210 CONTINUE C C 2.2- Mise a jour des correspondants C ----------------------------------- IF (NLMIN.NE.0) THEN NCBORF(NF,1) = NLMIN NCBORS(NLMIN,1) = NF IF (DMIN.GT.DMAX) DMAX = DMIN ELSE WRITE(NFECRA,1200) NF ENDIF C 200 CONTINUE C C ENDIF C C 3- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) WRITE(NFECRA,3200) DMAX C IF (NBLBLA.GE.10) THEN WRITE (NFECRA,3000) DO 300 N=1,NBCOUF WRITE(NFECRA,3010) N,NCBORF(N,1) 300 CONTINUE WRITE (NFECRA,3100) DO 310 N=1,NBCOUS WRITE(NFECRA,3110) N,NCBORS(N,1) 310 CONTINUE ENDIF C C-------- C FORMATS C-------- C 999 FORMAT(/,' %% ERREUR COCOIN : les maillages sont dits ', & 'coincidents alors que ',/, & ' le nombre de noeuds couples fluides (',I5,') ',/, & ' n''est pas egal au nombre de noeuds solides', & ' couples (',I5,') ') 1000 FORMAT(/,' *** COCOIN :', & ' Elaboration de la table de correspondance entre', & ' fluide et solide') 1200 FORMAT(' %% ERREUR COCOIN : LA RECHERCHE DU CORRESPONDANT DU ', & ' NOEUD FLUIDE ',I6,' A ECHOUEE') C 3000 FORMAT(/,' *** COCOIN : correspondant des noeuds fluides :',/) 3010 FORMAT(4X,' Noeud fluide :',I6,' Correspondant solide : ',I6) 3100 FORMAT(/,' *** COCOIN : correspondant des noeuds solides :',/) 3110 FORMAT(4X,' Noeud solide :',I6,' Correspondant fluide : ',I6) 3200 FORMAT(' *** COCOIN : Distance maximale entre 2 noeuds ', & 'coincidents : ',E12.5) C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/ccondi.F0000666000175000017500000001330011524070642015305 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCONDI C ***************** C * ( VAL,NREF,NPE,NCOND,VCOND,NBCOND,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C ON REPERE LES NOEUDS EN UTILISANT LES REFERENCES * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NREF ! TE ! D ! REFERENCES DES NOEUDS OU ELTS SOLIDES ! C ! NPE ! E ! D ! NOMBRE DE NOEUDS OU ELT DU MAILLAGE SOLIDE ! C ! NCOND ! TE ! D ! NUMERO GLOB DES NOEUDS DE CONDITION "COND" ! C ! VCOND ! TR ! M ! VALEUR DE LA CONDITION "COND" ! C ! NBCOND ! E ! D ! NOMBRE DE NOEUDS DE CONDITION "COND" ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" C C********************************************************************** C C..Variables externes INTEGER NPE,NBCOND,NB INTEGER NREF(NPE),NCOND(NBCOND),IREF(NRFMAX) DOUBLE PRECISION VCOND(NBCOND),VAL C C..Variables internes INTEGER N,N1,NR,NBRE,NUMGLO,NUMREF C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NBCOND VCOND(N) = VAL NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NBCOND C NUMGLO = NCOND(N) NUMREF = NREF(NUMGLO) C IF (NUMREF .EQ. NR) THEN VCOND(N) = VAL NBRE = NBRE + 1 ENDIF C 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLA.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCONDI : Nombre de noeuds traites :',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/dptseg.F0000666000175000017500000001200611524070642015336 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=DPTSEG,SSI=0 SUBROUTINE DPTSEG C ***************** C C ------------------------------------------ * (XP1,YP1,XA,YA,XB,YB,DIST,XMIN,YMIN,ICODE) C ------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C RECHERCHE DU POINT D'UN SEGMENT QUI REALISE LA DISTANCE * C MINIMALE ENTRE UN POINT DONNE ET LE SEGMENT * C (DIMENSION 2) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! XP1,YP1 ! R ! D ! COORDONNEES DU POINT CONSIDERE ! C ! XA,YA ! R ! D ! COORDONNEES DU 1ER SOMMET DU SEGMENT ! C ! XB,YB ! R ! D ! COORDONNEES DU 2EME SOMMET DU SEGMENT ! C ! DIST ! R ! R ! DISTANCE DE P1 AU SEGMENT ! C ! XMIN,YMIN ! R ! R ! POINT DU SEGMENT QUI REALISE CETTE DIST MIN ! C ! ICODE ! E ! R ! CODE D'ERREUR EN CAS D'ECHEC DE LA RECHERCHE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : CORFS2 C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C C*********************************************************************** C INTEGER ICODE C DOUBLE PRECISION XA,YA,XB,YB,XAB,YAB DOUBLE PRECISION ABN,XE1,YE1,XE2,YE2 DOUBLE PRECISION XP1,YP1,XH,XANEW,YANEW,XBNEW,YBNEW,XP DOUBLE PRECISION XX,DIST,XMIN,YMIN C C C*********************************************************************** C XAB = XB - XA YAB = YB - YA C ABN = SQRT ( XAB*XAB + YAB*YAB ) C XE1 = XAB / ABN YE1 = YAB / ABN C XE2 = -YE1 YE2 = XE1 C XP = (XP1-XA)*XE1 + (YP1-YA)*YE1 C XH = (XP1-XA)*XE2 + (YP1-YA)*YE2 C XANEW = 0.D0 YANEW = 0.D0 XBNEW = ABN YBNEW = 0.D0 C IF (XP.GE.XANEW .AND. XP.LE.XBNEW) THEN XX = XP DIST = ABS (XH) C ELSEIF (XP.GT.XBNEW) THEN XX = XBNEW DIST = SQRT ( XH*XH + (XP-XBNEW)*(XP-XBNEW) ) C ELSEIF (XP.LT.XANEW) THEN XX = XANEW DIST = SQRT ( XH*XH + (XP-XANEW)*(XP-XANEW) ) C ELSE ICODE = 1 RETURN ENDIF C XMIN = XA + XX*XE1 YMIN = YA + XX*YE1 C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/moblg1.F0000666000175000017500000001157311524070642015241 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBLG1,SSI=0 SUBROUTINE MOBLG1 C ***************** C C -------------------- * (NDIM,NPOINS,COORDS) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C MAILLAGE MOBILE : RELECTURE DES COORDONNEES DES NOEUDS * C DANS LE FICHIER GEOMETRIQUE * C Rq : C'est une suite de calcul et le fichier est * C obligatoirement au format SYRTHES puisque * C c'est un resultat issu d'un precedent calcul * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! COORDS ! TR ! R ! COORD DES NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /MOBIL/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofct.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NDIM DOUBLE PRECISION COORDS(NPOINS,NDIM) C C.. Variables internes INTEGER N,I,J,IERR CHARACTER CH1*39 C C*********************************************************************** C C C C 1- Recherche de la rubrique contenant la table des noeuds C ----------------------------------------------------------- IERR = 0 CALL SECGRF(NFSGCT,'C$ RUBRIQUE = NOEUDS',20,IERR) C C 2- Coordonnees et references C ------------------------------ DO 220 N=1,NPOINS READ(NFSGCT,2000) CH1,I,(COORDS(N,J),J=1,NDIM) 220 CONTINUE C C C-------- C FORMATS C-------- 2000 FORMAT(A39,I3,1X,3E10.4) C C END syrthes-3.4.3-dfsg1/src/s/mafcli.F0000666000175000017500000002726411524070642015317 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE MAFCLI C ****************** C C ------------------------------------------------------ *( NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * TMPSA,NODEUS,COORDS,SURFUS, * NPOINS,NELEMS,NDIM,NELEUS,NDMASS, * TRAVF,TRAVP,WCT ) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DE LA CONTRIBUTION DES TERMES ECHANGE * C DU A L'IMPLICITATION DES TERMES D'ECHANGE * C * C On calcule les termes suivants * C Termes de couplage avec le fluide * C Termes de coefficient d'echange avec l'exterieure * C Terme de resistance de contact * C Terme de rayonnement * C * C On calcul ici la contribution des faces que l'on assemble * C et qu'on rajoute a la matrice de masse * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NELERA ! E ! D ! Nombre de facette de type rayonnement ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEUS,OV C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : DIFSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIM,NELEUS,NDMASS INTEGER NBFECH,NELERC,NELERA,NBFRAI,NELESS INTEGER NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI),NFCOUS(NELESS) INTEGER NODEUS(NELEUS,NDMASS) C DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) DOUBLE PRECISION TRAVP(NPOINS),TRAVF(NELEUS,NDMASS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMASS) DOUBLE PRECISION SURFUS(NELEUS) C C..Variables internes DOUBLE PRECISION ZERO DOUBLE PRECISION R1,R2 DOUBLE PRECISION CL1,CL2,CL3,CL4,CL5,CL6 INTEGER I,J,NF,INODE,NCA DOUBLE PRECISION S48,SV48,S12,SV12 DOUBLE PRECISION HRAYI,HRAYT C C*********************************************************************** C C 1- INITIALISATION C ================= C ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C S48 = 1.D0 / 48.D0 S12 = 1.D0 / 12.D0 C C CALL OV ('X=C ',TRAVP,TRAVP,TRAVP,ZERO,NPOINS ) CALL OV ('X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEUS*NDMASS ) C C C 2- PRISE EN COMPTE DES "COEFFICIENTS D'ECHANGE" C ============================================== C C 2.1 Termes de couplage thermique avec le fluide C ------------------------------------------------- DO 210 J=1,NDMASS DO 210 I=1,NELESS NF = NFCOUS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFCOUS(I,J,2) 210 CONTINUE 211 CONTINUE C C 2.2 Termes du au coefficient d'echange C ------------------------------------------------- DO 221 J=1,NDMASS DO 220 I=1,NBFECH NF = NFECHS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFECHS(I,J,2) 220 CONTINUE 221 CONTINUE C C 2.3 Termes du aux resistances de contact C ------------------------------------------------- DO 231 J=1,NDMASS DO 230 I=1,NELERC NF = NFRESC(I) TRAVF(NF,J) = TRAVF(NF,J) + VFRESC(I,J,2) 230 CONTINUE 231 CONTINUE C C 2.4 Termes du au rayonnement infini C ---------------------------------- DO 241 J=1,NDMASS DO 240 I=1,NBFRAI NF = NFRAIS(I) INODE = NODEUS(NFRAIS(I),J) HRAYI = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + HRAYI 240 CONTINUE 241 CONTINUE C C 2.5 Termes du au rayonnement C ----------------------------- DO 251 J=1,NDMASS DO 250 I=1,NELERA NF = NFRAYS(I) INODE = NODEUS(NFRAYS(I),J) HRAYT = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + HRAYT 250 CONTINUE 251 CONTINUE C C C 3- CALCUL DE LA MATRICE ELEMENTAIRE C ================================ C C 3.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 3.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 311 I=1,NELEUS C SV12 = S12 * SURFUS(I) C CL1 = TRAVF(I,1) * SV12 CL2 = TRAVF(I,2) * SV12 CL3 = TRAVF(I,3) * SV12 C WCT(I,1) = 2*CL1 + CL3 WCT(I,2) = 2*CL2 + CL3 WCT(I,3) = CL1 + CL2 + 4*CL3 311 CONTINUE C C 3.1.2- Cas axisymetrique C ------------------------ ELSE DO 312 I=1,NELEUS C C SV48 = S48 * SURFUS(I) C R1 = ABS(COORDS(NODEUS(I,1),NCA)) R2 = ABS(COORDS(NODEUS(I,2),NCA)) C CL1 = TRAVF(I,1) * SV48 CL2 = TRAVF(I,2) * SV48 CL3 = TRAVF(I,3) * SV48 C WCT(I,1) = R2*CL3+R2*CL1+3*R1*CL3+7*R1*CL1 WCT(I,2) = 3*R2*CL3+7*R2*CL2+R1*CL3+R1*CL2 WCT(I,3) = 8*R2*CL3+R2*CL1+8*R1*CL3+3*R1*CL1 & +3*R2*CL2+R1*CL2 C 312 CONTINUE C ENDIF C C 3.2- Cas 3D C ----------- ELSE DO 320 I=1,NELEUS C SV48 = S48 * SURFUS(I) C CL1 = TRAVF(I,1) * SV48 CL2 = TRAVF(I,2) * SV48 CL3 = TRAVF(I,3) * SV48 CL4 = TRAVF(I,4) * SV48 CL5 = TRAVF(I,5) * SV48 CL6 = TRAVF(I,6) * SV48 C C WCT(I,1) = 2*CL1 + CL4 + CL6 WCT(I,2) = 2*CL2 + CL4 + CL5 WCT(I,3) = 2*CL3 + CL5 + CL6 WCT(I,4) = CL1 + CL2 + 6*CL4 + 2*(CL5+CL6) WCT(I,5) = CL2 + CL3 + 6*CL5 + 2*(CL4+CL6) WCT(I,6) = CL1 + CL3 + 6*CL6 + 2*(CL4+CL5) C 320 CONTINUE C ENDIF C CALL ASSEUS ( TRAVP,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS, & NDIM,WCT) C C C 4- IMPRESSIONS POUR CONTROLE C ============================ C IF ( NBLBLA .EQ. 11 ) THEN WRITE(NFECRA,4000) DO 400 I=1,NPOINS WRITE(NFECRA,4010) I,TRAVP(I) 400 CONTINUE ENDIF C C-------- C FORMATS C-------- 4000 FORMAT(/,' *** MAFCLI : 1ER MEMBRE (PARTIE ECHANGE IMPLICITE)',/, & ' NOEUD MAT DE MASSE ') 4010 FORMAT(7X,I6,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/xmprio.F0000666000175000017500000001570111524070642015373 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=XMPRIO,SSI=0 SUBROUTINE XMPRIO C ***************** C C --------------------------------------------------------- * (NPOINS,NELEMS,NELEPR,NDMATS, * NODES,NODEPR,NPRIOS,NBPRIO,NBCOPR,NREFS,NTRAV) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C EXTRACTION DU MAILLAGE DE PEAU DU MAILLAGE ELEMENTS FINIS * C (On ne prend en compte que les noeuds couples) * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! NELEMS ! E ! D ! Nombre d'elements du maillage solide ! C ! NELEPR ! E ! D ! Nombre d'elts volumiques avec periodicite ! C ! NDMATS ! E ! D ! Nombre de noeuds par element volumique ! C ! NODES ! TE ! D ! Connectivite maillage volumique solide ! C ! NODEPR ! TE ! D ! Connectivite maillage volumique periodique ! C ! NPRIOS ! TE ! D ! Numeros des noeuds periodiques | C ! NBPRIO ! E ! D ! Nombre de noeuds periodiques | C ! NBCOPR ! E ! D ! Nbre de correspondants pour les noeuds period! C ! NREFS ! TE ! D ! Reference des noeuds du maillage vol. solide | C ! NTRAV ! TE ! A ! Tableau de travail | C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "optct.h" C C*********************************************************************** INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NELEMS,NDMATS,NPOINS,NELEPR,NBPRIO,NBCOPR INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS) INTEGER NODEPR(NELEPR,NDMATS+1) INTEGER NPRIOS(NBPRIO,1+NBCOPR),NTRAV(NPOINS) C C.. Variables internes INTEGER N,M,I,J,L,NR(NDX),NLPR LOGICAL LPERIO C C*********************************************************************** C C C 0- INITIALISATIONS C ================== C NLPR = 0 C DO 1 N=1,NPOINS NTRAV(N) = 0 1 CONTINUE C DO 2 N=1,NBPRIO NTRAV(NPRIOS(N,1)) = N 2 CONTINUE C C C 1- REPERAGE ET STOCKAGE DES ELEMENTS PERIODIQUES C ================================================ C DO 100 N=1,NELEMS C LPERIO = .FALSE. C DO 10 M=1,NDMATS NR(M) = NREFS( NODES(N,M)) 10 CONTINUE C DO 110 M=1,NRFMAX DO 111 L=1,NDMATS IF ( IREFPR(M).NE.0 .AND. NR(L).EQ.M ) LPERIO = .TRUE. 111 CONTINUE 110 CONTINUE C IF (LPERIO) THEN C NLPR = NLPR + 1 DO 120 M=1,NDMATS NODEPR(NLPR,M) = NTRAV(NODES(N,M)) 120 CONTINUE C NODEPR(NLPR,NDMATS+1) = N C ENDIF C C C 100 CONTINUE C C C 2- CONTROLE DES DEBORDEMENTS DE TABLEAU C ======================================= C IF (NLPR.GT.NELEPR) THEN WRITE(NFECRA,2000) NELEPR,NLPR STOP ENDIF C C 3- IMPREPRION SUR LISTING C ========================= C IF (NBLBLA.GT.0) WRITE(NFECRA,3000) NELEPR C C C 4- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLA.EQ.10) THEN C WRITE(NFECRA,4000) DO 400 I=1,NELEPR WRITE(NFECRA,4010) I ,(NODEPR(I,J),J=1,NDMATS) 400 CONTINUE C ENDIF C C-------- C FORMATS C-------- 2000 FORMAT(/,' %% ERREUR XMPRIO : LA DIMENSION DU TABLEAU DES ', & 'ELEMENTS DE PERIODIQUES (NELEPR) EST INSUFFISANTE',/, & ' IL VAUT : ',I9,/, & ' IL FAUDRAIT : ',I9) 3000 FORMAT(//,' *** XMPRIO : NOMBRE D''ELEMENTS PERIODIQUES : ',I9) 4000 FORMAT(/,' *** XMPRIO : VERIFICATION DU MAILLAGE SOLIDE', & ' DES ELEMENTS PERIODIQUES',/, & ' Table des elements : '/) 4010 FORMAT( ' Element ',I9,' Noeuds : ',6I9) C END syrthes-3.4.3-dfsg1/src/s/regusy.F0000666000175000017500000003066411524070642015400 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE REGUSY C ***************** C C ---------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,NBFLVS,NPFEL,NFLUVS,VFLUVS, * PHYSOL,NPOUE,NPPEL,NBPHYS) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C (Sous-programme utilisateur pour une regulation thermique * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TE ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS AVEC FLUX VOL ! C ! NFLUVS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOL ! C ! VFLUVS ! TR ! R ! VALEUR DU FLUX VOLUMIQUE EN CES NOEUDS ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /TEMPS/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "syrthu.h" #include "regul.h" C C*********************************************************************** C C.. Variables externes INTEGER NBPHYS,NPOUE,NPPEL INTEGER NDIM,NPOINS,NBFLVS,NPFEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NFLUVS(NBFLVS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C.. Variables internes INTEGER I,N,NUMREF,NUMEL DOUBLE PRECISION T LOGICAL OK C DOUBLE PRECISION PERIOR,FLUVOL DOUBLE PRECISION ER,UC,UIC,UDC,UPC,VER C INTEGER MATER,NEMPRE DOUBLE PRECISION DTAIR,DTSABL,TINI,TDEB SAVE VER SAVE UDC SAVE UIC C SAVE MATER SAVE TDEB C DATA MATER /1/ DATA TDEB /0./ DATA UIC /0./ DATA UDC /0./ DATA UPC /0./ C*********************************************************************** C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C Temps reel courant sur le solide T = TEMPSS C C PROGRAMATION DU CYCLAGE C ----------------------- C On rapelle que l'on commence par de l'air durant C la premiere phase (d'une duree de TINI) c TINI = 7200 c montee pendant une journee TINI = 3600 C C Duree du sable DTSABL = 64. C Duree de l'air DTAIR = 21. C C Reference element de la zone affectee NEMPRE = 8 C C----------------------------------------------------- IF (T .GT. TINI) THEN C On commence le cyclage (sable/air/sable/.....) IF (MATER .EQ. 1) THEN C On est dans la configuration ou l'on a de l'air IF ((T - TDEB) .LT. DTAIR) THEN C On continue avec l'air DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ.NEMPRE) THEN C On met du sable PHYSOL(N,1,1) = 1.283 PHYSOL(N,1,2) = 1293. PHYSOL(N,1,3) = 0.02454 ENDIF ENDDO ELSE C On arrive au changement MATER = 0 C On mets du sable et temperature a 20 degc DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ.NEMPRE) THEN C Pendant 80 secondes on met du sable PHYSOL(N,1,1) = 1500. PHYSOL(N,1,2) = 800. PHYSOL(N,1,3) = 0.58 ENDIF ENDDO C Remise a 20 deg de la temperature DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ.NEMPRE) THEN TMPS(NODES(N,1)) = 20. TMPS(NODES(N,2)) = 20. TMPS(NODES(N,3)) = 20. TMPS(NODES(N,4)) = 20. TMPS(NODES(N,5)) = 20. TMPS(NODES(N,6)) = 20. ENDIF ENDDO C DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.NE.NEMPRE) THEN TMPS(NODES(N,1)) = TMPSA(NODES(N,1)) TMPS(NODES(N,2)) = TMPSA(NODES(N,2)) TMPS(NODES(N,3)) = TMPSA(NODES(N,3)) TMPS(NODES(N,4)) = TMPSA(NODES(N,4)) TMPS(NODES(N,5)) = TMPSA(NODES(N,5)) TMPS(NODES(N,6)) = TMPSA(NODES(N,6)) ENDIF ENDDO C Reactualisation des temperatures aux noeuds DO N=1,NPOINS TMPSA(N) = TMPS(N) ENDDO C C Actualisation du TDEB TDEB = T C ENDIF C ELSE C configuration ou l'on a du sable (mater = 0) IF (T - TDEB .LT. DTSABL) THEN C On continue avec du sable DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ.NEMPRE) THEN C On met du sable PHYSOL(N,1,1) = 1500. PHYSOL(N,1,2) = 800. PHYSOL(N,1,3) = 0.58 ENDIF ENDDO ELSE MATER = 1 C On mets de l'air a temperature a 20 degc DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ.NEMPRE) THEN C Pendant 80 secondes on met du sable PHYSOL(N,1,1) = 1.283 PHYSOL(N,1,2) = 1293. PHYSOL(N,1,3) = 0.02454 ENDIF ENDDO C Remise a 20 deg de la temperature DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.EQ. NEMPRE) THEN TMPS(NODES(N,1)) = 20. TMPS(NODES(N,2)) = 20. TMPS(NODES(N,3)) = 20. TMPS(NODES(N,4)) = 20. TMPS(NODES(N,5)) = 20. TMPS(NODES(N,6)) = 20. ENDIF ENDDO C DO N=1,NELEMS C References de l'element courant NUMREF = NREFE(N) C IF ( NUMREF.NE. NEMPRE) THEN TMPS(NODES(N,1)) = TMPSA(NODES(N,1)) TMPS(NODES(N,2)) = TMPSA(NODES(N,2)) TMPS(NODES(N,3)) = TMPSA(NODES(N,3)) TMPS(NODES(N,4)) = TMPSA(NODES(N,4)) TMPS(NODES(N,5)) = TMPSA(NODES(N,5)) TMPS(NODES(N,6)) = TMPSA(NODES(N,6)) ENDIF ENDDO C Reactualisation des temperatures aux noeuds DO N=1,NPOINS TMPSA(N) = TMPS(N) ENDDO C Actualisation du TDEB TDEB = T ENDIF C ENDIF C ENDIF C cc print*, ' tdeb ', tdeb cc print*, ' rho ',physol(2768,1,1) cc print*, ' tmpsa(4232) ', tmpsa(4232) C C ======================================================= C FIN POUR LES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= C C Programmation du regulateur C ========================== C Pas de temps de la resolution PERIOR = RDTTS C C Algorithme du regulateur C ------------------------- ER = (TREG - TMPS(NODREG))/TREG IF (ER .GT. (1./KC)) THEN UC = 1. UIC = 0. UDC = 0. write(6,111) T,upc,uic,udc,uc ELSE UPC = KC * ER IF (UPC .LE. -1) UPC =-1. UIC = UIC+PERIOR/TIC*ER*KC IF (UPC.GT.0. .AND. (UIC .GT. 1.-UPC)) UIC = 1.-UPC IF (UPC.LT.0. .AND. (UIC .LT. -1.-UPC)) UIC =-1.-UPC UDC = TDC * ((ER-VER)*CN*KC+UDC) / (TDC+ CN*PERIOR) UC = UPC + UIC + UDC write(6,111) T,upc,uic,udc,uc 111 format(' p: ',5(2X,e15.5)) IF (UC .GT. 1.) UC = 1. IF (UC .LT. 0.) UC = 0. ENDIF C C reactualisation VER = ER C C Algorithme du regulateur C ------------------------- C C Calcul du flux volumique FLUVOL = PUINOM * UC cc print*,' UC : ',T,' ',UC C C C ============================================================ C TRAITEMENT PAR ELEMENT (FLUX VOLUMIQUE CONSTANT PAR ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique DO 100 N=1,NBFLVS C C Numero global de l'element NUMEL = NFLUVS(N) C C Reference de l'element NUMREF = NREFE(NUMEL) C OK=.FALSE. DO I=1,NBRREG IF (NUMREF.EQ.NRREG(I)) OK=.TRUE. ENDDO C IF (OK) VFLUVS(N,1) = FLUVOL C 100 CONTINUE C C Affichage : puissance em m3 et veritablement injectee c Print*,' temps Puissance',T,FLUVOL,FLUVOL*0.000193 C ============================================================ C FIN DU TRAITEMENT PAR ELEMENT (FLUX CONSTANT PAR ELEMENT) C ============================================================ C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/smbray.F0000666000175000017500000001334511524070642015354 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE SMBRAY C ***************** C C -------------------------------------------------- * (NUMBS,NELRAY,SUFRAY,TEMRAY,EMISSI,EPROPR,FDFNP1) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C C TRAITEMENT DU RAYONNEMENT TRANSPARENT C CALCUL DU SECOND MEMBRE C C Cas d'une seule bande spectrale = sigma.epsilon.T^4.surf C Cas de plusieurs bandes spectrales = calcul par serie C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NUMBS ! E ! D ! NUMERO DE LA BANDE SPECTRALE ! C ! NELRAY ! E ! D ! NOMBRE D'ELEMENTS (maillage rayt) ! C ! SUFRAY ! TR ! D ! SURFACE DES ELEMENTS (maillage rayt) ! C ! TEMRAY ! TR ! D ! TEMPERATURE (maillage rayt) ! C ! EMISSI ! TR ! D ! EMISSIVITE (maillage rayt) ! C ! EPROPR ! TR ! R ! EMISSION PROPRE (maillage rayt) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C ********************************************************************** C C.. Variables externes INTEGER NELRAY,NUMBS DOUBLE PRECISION TEMRAY(NELRAY),SUFRAY(NELRAY) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),EPROPR(NELRAY,NBANDE) DOUBLE PRECISION FDFNP1(NELRAY) C C..Variables Internes INTEGER N DOUBLE PRECISION C2,X1,X2,V,W1,W2,XJ C C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C2 = 1.4388E-2 C C C 1- CAS D'UNE SEULE BANDE SPECTRALE C ================================== C IF (NBANDE.EQ.1) THEN C DO 100 N=1,NELRAY EPROPR(N,1) = SIGMA * EMISSI(N,1,1) * TEMRAY(N)**4 * SUFRAY(N) 100 CONTINUE C IF (LROUVR) THEN XJ = SIGMA * (TEMINF+TKEL)**4 DO 110 N=1,NELRAY EPROPR(N,1) = EPROPR(N,1)+ * (1.-EMISSI(N,1,1)) *FDFNP1(N)*XJ 110 CONTINUE ENDIF C C 2- CAS DE BANDES SPECTRALES MULTIPLES C ===================================== ELSE C X1 = C2/SPECTL(NUMBS,1) X2 = C2/SPECTL(NUMBS,2) C DO 200 N=1,NELRAY C V = X1/TEMRAY(N) CALL WIEBEL(V,W1) C V = X2/TEMRAY(N) CALL WIEBEL(V,W2) C EPROPR(N,NUMBS) = SIGMA * EMISSI(N,1,NUMBS) * * TEMRAY(N)**4 * (W2-W1) * SUFRAY(N) C 200 CONTINUE C C IF (LROUVR) THEN C V = X1/(TEMINF+TKEL) CALL WIEBEL(V,W1) C V = X2/(TEMINF+TKEL) CALL WIEBEL(V,W2) C DO 250 N=1,NELRAY EPROPR(N,NUMBS) = EPROPR(N,NUMBS) + * (1.-EMISSI(N,1,NUMBS)) * FDFNP1(N) * * SIGMA * * (TEMINF+TKEL)**4 * (W2-W1) 250 CONTINUE ENDIF C ENDIF C C-------- C FORMATS C-------- C C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/xmaill.F0000666000175000017500000003130511524070642015341 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=XMAILL,SSI=0 SUBROUTINE XMAILL C ***************** C C --------------------------------------------------------- * (NDIELE,NPOINS,NELEMS,NELESS,NELEUS,NELERC,NELERA, * NDMATS,NDMASS, * NBFACE,NODES,NODESS,NODEUS,NODERC,NODERA, * NREFS,NREFAC,NREFAL) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C EXTRACTION DU MAILLAGE DE PEAU DU MAILLAGE ELEMENTS FINIS * C * C - faces couples (NODESS) * C - faces avec condition de type flux (NODEUS) * C (flux,couplees,coef ech,resistance de contact) * C - faces avec resistance de contact (NODERC) * C - faces avec rayonnement (NODERA) * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIELE ! E ! D ! Dimension des elements (2=trian, 3=tetra) ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! NELEMS ! E ! D ! Nombre d'elements du maillage solide ! C ! NELESS ! E ! D ! Nombre d'elts surfaciques couples ! C ! NELEUS ! E ! D ! Nombre d'elts surfaciques avec flux(general) | C ! NELERC ! E ! D ! Nombre d'elts surfaciques avec resistance ! C ! NELERA ! E ! D ! Nombre d'elts surfaciques avec rayonnement ! C ! NDMATS ! E ! D ! Nombre de noeuds par element volumique ! C ! NDMASS ! E ! D ! Nombre de noeuds par element surfacique ! C ! NBFACE ! E ! D ! Nombre de faces des elts vol solides ! C ! NODES ! TE ! D ! Connectivite maillage volumique solide ! C ! NODESS ! TE ! R ! Connectivite maillage surf couple ! C ! NODEUS ! TE ! R ! Connectivite maillage surf avec flux ! C ! NODERC ! TE ! R ! Connectivite maillage surf avec resistance ! C ! NODERA ! TE ! R ! Connectivite maillage surf avec rayonnement ! C ! NREFS ! TE ! D ! Reference des noeuds du maillage vol. solide | C ! NREFAC ! TE ! D ! Reference faces (aretes en 2D) (volumiques) | C ! NREFAL ! TE ! R ! Ref faces (aretes en 2D) num local ds NODEUS | C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIELE,NELEMS,NDMATS,NPOINS,NELESS,NELEUS,NELERC,NELERA INTEGER NDMASS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS),NODESS(NELESS,NDMASS) INTEGER NODEUS(NELEUS,NDMASS),NODERC(NELERC,NDMASS) INTEGER NODERA(NELERA,NDMASS) INTEGER NREFAC(NELEMS,NBFACE),NREFAL(NELEUS) C C.. Variables internes INTEGER N,M,I,J INTEGER NLSS,NLUS,NLRC,NLRA LOGICAL LFFLU(NDX),LFCOU(NDX),LFRES(NDX),LPDIR(NDX),LFRAY(NDX) LOGICAL ERR INTEGER NARE(3,3),NFAC(6,4) C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,3,2,7,6,5, 1,2,4,5,9,8, 1,4,3,8,10,7, 2,3,4,6,10,9/ C C C 0- INITIALISATIONS C ================== C NLSS = 0 NLUS = 0 NLRC = 0 NLRA = 0 C IF (LCFACE) THEN DO 10 N=1,NELEUS NREFAL(N) = 0 10 CONTINUE ENDIF C C C 1- CAS DES TRIANGLES C ==================== IF (NDIELE.EQ.2) THEN C DO 100 N=1,NELEMS C IF (LCFACE) THEN CALL EVAFAC(N,NDIELE,NELEMS,NREFAC, * LFFLU,LFCOU,LFRES,LFRAY,NBFACE) ELSE CALL EVATYP(N,NDIELE,NODES,NELEMS,NDMATS,NREFS,NPOINS, * LFFLU,LFCOU,LFRES,LFRAY,NBFACE,LPDIR) ENDIF C DO 110 M=1,NBFACE IF (LFCOU(M)) THEN NLSS = NLSS + 1 NODESS(NLSS,1) = NODES(N,NARE(1,M)) NODESS(NLSS,2) = NODES(N,NARE(2,M)) NODESS(NLSS,3) = NODES(N,NARE(3,M)) ENDIF IF (LFFLU(M)) THEN NLUS = NLUS + 1 NODEUS(NLUS,1) = NODES(N,NARE(1,M)) NODEUS(NLUS,2) = NODES(N,NARE(2,M)) NODEUS(NLUS,3) = NODES(N,NARE(3,M)) IF (LCFACE) NREFAL(NLUS) = NREFAC(N,M) ENDIF IF (LFRES(M)) THEN NLRC = NLRC + 1 NODERC(NLRC,1) = NODES(N,NARE(1,M)) NODERC(NLRC,2) = NODES(N,NARE(2,M)) NODERC(NLRC,3) = NODES(N,NARE(3,M)) ENDIF IF (LFRAY(M)) THEN NLRA = NLRA + 1 NODERA(NLRA,1) = NODES(N,NARE(1,M)) NODERA(NLRA,2) = NODES(N,NARE(2,M)) NODERA(NLRA,3) = NODES(N,NARE(3,M)) ENDIF 110 CONTINUE C 100 CONTINUE C C 2- CAS DES TETRAEDRES C ===================== C ELSEIF (NDIELE.EQ.3) THEN C DO 200 N=1,NELEMS C IF (LCFACE) THEN CALL EVAFAC(N,NDIELE,NELEMS,NREFAC, * LFFLU,LFCOU,LFRES,LFRAY,NBFACE) ELSE CALL EVATYP(N,NDIELE,NODES,NELEMS,NDMATS,NREFS,NPOINS, * LFFLU,LFCOU,LFRES,LFRAY,NBFACE,LPDIR) ENDIF C DO 210 M=1,NBFACE IF (LFCOU(M)) THEN NLSS = NLSS + 1 NODESS(NLSS,1) = NODES(N,NFAC(1,M)) NODESS(NLSS,2) = NODES(N,NFAC(2,M)) NODESS(NLSS,3) = NODES(N,NFAC(3,M)) NODESS(NLSS,4) = NODES(N,NFAC(4,M)) NODESS(NLSS,5) = NODES(N,NFAC(5,M)) NODESS(NLSS,6) = NODES(N,NFAC(6,M)) ENDIF IF (LFFLU(M)) THEN NLUS = NLUS + 1 NODEUS(NLUS,1) = NODES(N,NFAC(1,M)) NODEUS(NLUS,2) = NODES(N,NFAC(2,M)) NODEUS(NLUS,3) = NODES(N,NFAC(3,M)) NODEUS(NLUS,4) = NODES(N,NFAC(4,M)) NODEUS(NLUS,5) = NODES(N,NFAC(5,M)) NODEUS(NLUS,6) = NODES(N,NFAC(6,M)) IF (LCFACE) NREFAL(NLUS) = NREFAC(N,M) ENDIF IF (LFRES(M)) THEN NLRC = NLRC + 1 NODERC(NLRC,1) = NODES(N,NFAC(1,M)) NODERC(NLRC,2) = NODES(N,NFAC(2,M)) NODERC(NLRC,3) = NODES(N,NFAC(3,M)) NODERC(NLRC,4) = NODES(N,NFAC(4,M)) NODERC(NLRC,5) = NODES(N,NFAC(5,M)) NODERC(NLRC,6) = NODES(N,NFAC(6,M)) ENDIF IF (LFRAY(M)) THEN NLRA = NLRA + 1 NODERA(NLRA,1) = NODES(N,NFAC(1,M)) NODERA(NLRA,2) = NODES(N,NFAC(2,M)) NODERA(NLRA,3) = NODES(N,NFAC(3,M)) NODERA(NLRA,4) = NODES(N,NFAC(4,M)) NODERA(NLRA,5) = NODES(N,NFAC(5,M)) NODERA(NLRA,6) = NODES(N,NFAC(6,M)) ENDIF 210 CONTINUE C 200 CONTINUE C 3- ERREUR C ========= C ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C 4- CONTROLE DES DEBORDEMENTS DE TABLEAU C ======================================= C ERR = .FALSE. C IF (NLSS.NE.NELESS) THEN WRITE(NFECRA,4000) NELESS,NLSS ERR = .TRUE. ENDIF IF (NLUS.NE.NELEUS) THEN WRITE(NFECRA,4010) NELEUS,NLUS ERR = .TRUE. ENDIF C IF (NLRC.NE.NELERC) THEN WRITE(NFECRA,4020) NELERC,NLRC ERR = .TRUE. ENDIF C IF (NLRA.NE.NELERA) THEN WRITE(NFECRA,4030) NELERA,NLRA ERR = .TRUE. ENDIF C IF (ERR) STOP C C 5- IMPRESSION SUR LISTING C ========================= C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,5000) WRITE(NFECRA,5010) NELESS,NELEUS,NELERC,NELERA ENDIF C C C 6- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLA.EQ.10 .AND. NELESS.GT.0) THEN C WRITE(NFECRA,6000) DO 600 I=1,NELESS WRITE(NFECRA,6010) I ,(NODESS(I,J),J=1,NDMASS) 600 CONTINUE C ENDIF C C-------- C FORMATS C-------- 3000 FORMAT(/,' %% ERREUR XMAILL : DIMENSION DU PROBLEME INCOHERENTE') 4000 FORMAT(/,' %% ERREUR XMAILL : LA DIMENSION DU TABLEAU DES ', & 'ELEMENTS DE BORD COUPLES (NELESS) EST INSUFFISANTE',/, & ' IL VAUT : ',I10,/, & ' IL FAUDRAIT : ',I10) 4010 FORMAT(/,' %% ERREUR XMAILL : LA DIMENSION DU TABLEAU DES ', & 'ELEMENTS DE BORD AVEC FLUX (NELEUS) EST INSUFFISANTE',/, & ' IL VAUT : ',I10,/, & ' IL FAUDRAIT : ',I10) 4020 FORMAT(/,' %% ERREUR XMAILL : LA DIMENSION DU TABLEAU DES ', & 'ELEMENTS DE BORD AVEC RESISTANCE (NELERC) EST INSUFFISANTE',/, & ' IL VAUT : ',I10,/, & ' IL FAUDRAIT : ',I10) 4030 FORMAT(/,' %% ERREUR XMAILL : LA DIMENSION DU TABLEAU DES ', & 'ELEMENTS DE BORD AVEC RAYONNEMENT (NELERA) EST INSUFFISANTE',/, & ' IL VAUT : ',I10,/, & ' IL FAUDRAIT : ',I10) 5000 FORMAT(//,' *** XMAILL : MAILLAGE ELEMENTS FINIS SURFACIQUE ', & 'DU SOLIDE :') 5010 FORMAT( & 8X,'- Nombre d''elements de surface couples : ',I10,/, & 8X,'- Nombre d''elements de surface avec flux : ',I10,/, & 8X,'- Nombre d''elements de surface avec resistance : ',I10,/, & 8X,'- Nombre d''elements de surface avec rayonnement: ',I10) 6000 FORMAT(/,' *** XMAILL : VERIFICATION DU MAILLAGE SOLIDE', & ' DE SURFACE DES NOEUDS COUPLES',/, & ' Table des elements : '/) 6010 FORMAT( ' Element ',I10,' Noeuds : ',6I10) C END syrthes-3.4.3-dfsg1/src/s/idrbls.F0000666000175000017500000000441111524070642015330 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- INTEGER FUNCTION IDRBLS ( CHAINE, LCH ) C ==================================================================== C C BUT : DETERMINER LA POSITION DU DERNIER CARACTERE NON BLANC DANS C ---- CHAINE DE LONGUEUR LCH AVEC LA CONVENTION DE ZERO SI C LA CHAINE EST BLANCHE C C PARAMETRES D'ENTREE : C --------------------- C CHAINE : CHAINE DE CARACTERES C LCH : LONGUEUR DE LA CHAINE DE CARACTERES C C PARAMETRES DE SORTIE : C ---------------------- C AUCUN C C AUTEURS : SOCIETE SIMULOG : ALAIN DUTOYA C -------- C C ==================================================================== C IMPLICIT NONE C C ==================================================================== CHARACTER CHAINE*(*) INTEGER LCH C INTEGER I C C ==================================================================== C--------------- C POSITIONNEMENT C--------------- C DO 10 I = LCH, 1, -1 IF ( CHAINE (I:I) .NE. ' ' ) THEN IDRBLS = I GOTO 20 ENDIF 10 CONTINUE C IDRBLS = 0 C 20 CONTINUE C C----- C FIN C----- C END syrthes-3.4.3-dfsg1/src/s/whisor.F0000666000175000017500000000754511524070642015377 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE WHISOR C ***************** C C ---------------------------------------------- *(NELRAY,TEMRAY) C ---------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C --------- C C ECRITURE DES HISTORIQUES EN TEMPS SUR LE RAYONNEMENT C C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ------ C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C************************************************************************* C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "nlofes.h" #include "nlofct.h" #include "rayonn.h" C C*********************************************************************** C C... Declaration des variables externes C INTEGER NELRAY DOUBLE PRECISION TEMRAY(NELRAY) C C... Declaration des variables internes C INTEGER N,NUM C C C*********************************************************************** C DO N=1,NBHSOR NUM = NHISOR(N) WRITE(NFHIRA,1000) TEMPSS,NUM,TEMRAY(NUM) ENDDO C CALL FLUSHF(NFHIRA) C C C------- C FORMAT C------- C 1000 FORMAT ( 1X,E15.9,1X,I6,1X,E15.9) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/madif2.F0000666000175000017500000006452711524070642015231 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MADIF2,SSI=0 C SUBROUTINE MADIF2 C ***************** C C ------------------------------------------------------ *( XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DES MATRICES ELEMENTAIRES POUR * C PROBLEMES BIDIMENSIONNELS ET TRIDIMENSIONNEL * C POUR LES CAS ORTHOTROPES * C * C la matrice de conductivite dans le repere globale * C s exprime donc de la facon suivante : * C * C | AKXX 0 | * C | 0 AKYY | * C * C Les AKXX sont toujours variables en temps et en espace * C il seront donc discretise en iso-P2 * C * C Ce sous programme constitue une extension de travaux effectuees * C par F. JAUBERTEAU et J.P. GREGOIRE, portant sur l'integration * C analytique des matrices elementaires par les formules de * C Zienkiewicz * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! XMAT ! TR ! R ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! COEFMA ! TR ! D ! COEFFICIENTS DES MATRICES ! C ! ! ! ! coefma(n) = rho Cp / dt pour masse ! C ! PHYSOL ! TR ! D ! Tableau contenant les propri physiques ! C ! ! TR ! D ! On utilise uniquement PHYSOL(n,>=3) ! C ! ! ! ! contient les valeurs des kii sui isotro! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : MATELE C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA INTEGER NPOUE,NPPEL,NBPHYS INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION COEFMA(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS),VOLUME(NELEMS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes DOUBLE PRECISION ZERO,COEFF,S3,S18,S24 INTEGER I,NCA INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 DOUBLE PRECISION R1,R2,R3 DOUBLE PRECISION X75,Y75,Z75,X78,Y78,Z78 DOUBLE PRECISION X69,Y69,Z69,X65,Y65,Z65 DOUBLE PRECISION X710,Y710,Z710,X76,Y76,Z76 DOUBLE PRECISION X810,Y810,Z810,X89,Y89,Z89 C DOUBLE PRECISION AKXX1,AKXX2,AKXX3,AKXX4,AKXX5,AKXX6 DOUBLE PRECISION AKXX7,AKXX8,AKXX9,AKXX10 DOUBLE PRECISION AKYY1,AKYY2,AKYY3,AKYY4,AKYY5,AKYY6 DOUBLE PRECISION AKYY7,AKYY8,AKYY9,AKYY10 DOUBLE PRECISION AKZZ1,AKZZ2,AKZZ3,AKZZ4,AKZZ5,AKZZ6 DOUBLE PRECISION AKZZ7,AKZZ8,AKZZ9,AKZZ10 DOUBLE PRECISION XK1,XK2,XK3,XK4,XK5,XK6,XK7,XK8 DOUBLE PRECISION YK1,YK2,YK3,YK4,YK5,YK6,YK7,YK8 DOUBLE PRECISION ZK1,ZK2,ZK3,ZK4,ZK5,ZK6,ZK7,ZK8 DOUBLE PRECISION DX1,DX2,DX3,DX4,DY1,DY2,DY3,DY4 DOUBLE PRECISION DZ1,DZ2,DZ3,DZ4 DOUBLE PRECISION AKXXE,AKYYE,AKZZE C LOGICAL LVERIF C*********************************************************************** C C INITIALISATIONS C ================ C LVERIF = .FALSE. ZERO = 0.D0 S3 = 1.D0 / 3.D0 S18 = 1.D0 / 18.D0 S24 = 1.D0 / 24.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C C C 1- CAS BIDIMENSIONNEL C ====================== C IF ( NDIM . EQ . 2 ) THEN C C 1.1- CAS CARTESIEN C ------------------ IF (IAXISY.EQ.0) THEN C DO 110 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE C ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) ENDIF C XK1 = AKXX1 + AKXX4 + AKXX6 YK1 = AKYY1 + AKYY4 + AKYY6 XK2 = AKXX2 + AKXX4 + AKXX5 YK2 = AKYY2 + AKYY4 + AKYY5 XK3 = AKXX3 + AKXX5 + AKXX6 YK3 = AKYY3 + AKYY5 + AKYY6 XK4 = AKXX4 + AKXX5 + AKXX6 YK4 = AKYY4 + AKYY5 + AKYY6 C C DX1 = - (COORDS(N6,2)-COORDS(N4,2)) DY1 = (COORDS(N6,1)-COORDS(N4,1)) C DX2 = - (COORDS(N4,2)-COORDS(N5,2)) DY2 = (COORDS(N4,1)-COORDS(N5,1)) C DX3 = - (COORDS(N5,2)-COORDS(N6,2)) DY3 = (COORDS(N5,1)-COORDS(N6,1)) C C Calcul des termes diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ COEFF = S3 / VOLUME(I) C WCT(I,1) = COEFF*(DX1**2*XK1+DY1**2*YK1) WCT(I,2) = COEFF*(DX2**2*XK2+DY2**2*YK2) WCT(I,3) = COEFF*(DX3**2*XK3+DY3**2*YK3) WCT(I,4) = COEFF*(DX2**2*XK1+DY2**2*YK1+DX1**2*XK2+DY1**2*YK2+DX3 &**2*XK4+DY3**2*YK4) WCT(I,5) = COEFF*(DX3**2*XK2+DY3**2*YK2+DX2**2*XK3+DY2**2*YK3+DX1 &**2*XK4+DY1**2*YK4) WCT(I,6) = COEFF*(DX3**2*XK1+DY3**2*YK1+DX1**2*XK3+DY1**2*YK3+DX2 &**2*XK4+DY2**2*YK4) C C Calcul des termes extra-diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C XMAT(I,1) = COEFF*(DX1*DX2*XK1+DY1*DY2*YK1) XMAT(I,2) = COEFF*(DX1*DX3*XK1+DY1*DY3*YK1) C XMAT(I,3) = COEFF*(DX2*DX1*XK2+DY2*DY1*YK2) XMAT(I,4) = COEFF*(DX2*DX3*XK2+DY2*DY3*YK2) C XMAT(I,5) = COEFF*(DX3*DX2*XK3+DY3*DY2*YK3) XMAT(I,6) = COEFF*(DX3*DX1*XK3+DY3*DY1*YK3) C XMAT(I,7)=COEFF*(DX1*DX3*XK2+DY1*DY3*YK2+DX3*DX1*XK4+DY3*DY1*YK4) XMAT(I,8)=COEFF*(DX2*DX3*XK1+DY2*DY3*YK1+DX3*DX2*XK4+DY3*DY2*YK4) C XMAT(I,9)=COEFF*(DX2*DX1*XK3+DY2*DY1*YK3+DX1*DX2*XK4+DY1*DY2*YK4) C 110 CONTINUE C C C 1.2- CAS AXISYMETRIQUE (DONC 2D) C -------------------------------- ELSE C C DO 120 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C COEFF = S24 / VOLUME(I) C R1 = COEFF * ABS(COORDS(N1,NCA)) R2 = COEFF * ABS(COORDS(N2,NCA)) R3 = COEFF * ABS(COORDS(N3,NCA)) C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE C ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) ENDIF C XK1 = AKXX1*(6*R1+R2+R3) + AKXX4*(5*R1+2*R2+R3) & + AKXX6*(5*R1+R2+2*R3) YK1 = AKYY1*(6*R1+R2+R3) + AKYY4*(5*R1+2*R2+R3) & + AKYY6*(5*R1+R2+2*R3) XK2 = AKXX2*(R1+6*R2+R3) + AKXX4*(2*R1+5*R2+R3) & + AKXX5*(R1+5*R2+2*R3) YK2 = AKYY2*(R1+6*R2+R3) + AKYY4*(2*R1+5*R2+R3) & + AKYY5*(R1+5*R2+2*R3) XK3 = AKXX3*(R1+R2+6*R3) + AKXX5*(R1+2*R2+5*R3) & + AKXX6*(2*R1+R2+5*R3) YK3 = AKYY3*(R1+R2+6*R3) + AKYY5*(R1+2*R2+5*R3) & + AKYY6*(2*R1+R2+5*R3) XK4 = AKXX4*(3*R1+3*R2+2*R3) + AKXX5*(2*R1+3*R2+3*R3) & + AKXX6*(3*R1+2*R2+3*R3) YK4 = AKYY4*(3*R1+3*R2+2*R3) + AKYY5*(2*R1+3*R2+3*R3) & + AKYY6*(3*R1+2*R2+3*R3) C C C -> grad(Ph1) = (DX1,DY1) DX1 = - (COORDS(N6,2)-COORDS(N4,2)) DY1 = (COORDS(N6,1)-COORDS(N4,1)) C C -> grad(Ph2) = (DX2,DY2) DX2 = - (COORDS(N4,2)-COORDS(N5,2)) DY2 = (COORDS(N4,1)-COORDS(N5,1)) C C -> grad(Ph3) = (DX3,DY3) DX3 = - (COORDS(N5,2)-COORDS(N6,2)) DY3 = (COORDS(N5,1)-COORDS(N6,1)) C C Calcul des termes diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ C WCT(I,1) = (DX1**2*XK1+DY1**2*YK1) WCT(I,2) = (DX2**2*XK2+DY2**2*YK2) WCT(I,3) = (DX3**2*XK3+DY3**2*YK3) WCT(I,4) = (DX2**2*XK1+DY2**2*YK1+DX1**2*XK2+DY1**2*YK2+DX3 &**2*XK4+DY3**2*YK4) WCT(I,5) = (DX3**2*XK2+DY3**2*YK2+DX2**2*XK3+DY2**2*YK3+DX1 &**2*XK4+DY1**2*YK4) WCT(I,6) = (DX3**2*XK1+DY3**2*YK1+DX1**2*XK3+DY1**2*YK3+DX2 &**2*XK4+DY2**2*YK4) C C Calcul des termes extra-diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C XMAT(I,1) = (DX1*DX2*XK1+DY1*DY2*YK1) XMAT(I,2) = (DX1*DX3*XK1+DY1*DY3*YK1) C XMAT(I,3) = (DX2*DX1*XK2+DY2*DY1*YK2) XMAT(I,4) = (DX2*DX3*XK2+DY2*DY3*YK2) C XMAT(I,5) = (DX3*DX2*XK3+DY3*DY2*YK3) XMAT(I,6) = (DX3*DX1*XK3+DY3*DY1*YK3) C XMAT(I,7)= (DX1*DX3*XK2+DY1*DY3*YK2+DX3*DX1*XK4+DY3*DY1*YK4) XMAT(I,8)= (DX2*DX3*XK1+DY2*DY3*YK1+DX3*DX2*XK4+DY3*DY2*YK4) C XMAT(I,9)= (DX2*DX1*XK3+DY2*DY1*YK3+DX1*DX2*XK4+DY1*DY2*YK4) C 120 CONTINUE C C C ENDIF C C C C 2- CAS TRIDIMENSIONNEL C ====================== ELSE C C DO 200 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10 = NODES(I,10) C C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) AKXX7 = PHYSOL(N7,1,3) AKXX8 = PHYSOL(N8,1,3) AKXX9 = PHYSOL(N9,1,3) AKXX10 = PHYSOL(N10,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) AKYY7 = PHYSOL(N7,1,4) AKYY8 = PHYSOL(N8,1,4) AKYY9 = PHYSOL(N9,1,4) AKYY10 = PHYSOL(N10,1,4) C AKZZ1 = PHYSOL(N1,1,5) AKZZ2 = PHYSOL(N2,1,5) AKZZ3 = PHYSOL(N3,1,5) AKZZ4 = PHYSOL(N4,1,5) AKZZ5 = PHYSOL(N5,1,5) AKZZ6 = PHYSOL(N6,1,5) AKZZ7 = PHYSOL(N7,1,5) AKZZ8 = PHYSOL(N8,1,5) AKZZ9 = PHYSOL(N9,1,5) AKZZ10 = PHYSOL(N10,1,5) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) AKZZE = PHYSOL(I,1,5) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE AKXX7 = AKXXE AKXX8 = AKXXE AKXX9 = AKXXE AKXX10 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE AKYY7 = AKYYE AKYY8 = AKYYE AKYY9 = AKYYE AKYY10 = AKYYE C AKZZ1 = AKZZE AKZZ2 = AKZZE AKZZ3 = AKZZE AKZZ4 = AKZZE AKZZ5 = AKZZE AKZZ6 = AKZZE AKZZ7 = AKZZE AKZZ8 = AKZZE AKZZ9 = AKZZE AKZZ10 = AKZZE ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) AKXX7 = PHYSOL(I,7,3) AKXX8 = PHYSOL(I,8,3) AKXX9 = PHYSOL(I,9,3) AKXX10 = PHYSOL(I,10,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) AKYY7 = PHYSOL(I,7,4) AKYY8 = PHYSOL(I,8,4) AKYY9 = PHYSOL(I,9,4) AKYY10 = PHYSOL(I,10,4) C AKZZ1 = PHYSOL(I,1,5) AKZZ2 = PHYSOL(I,2,5) AKZZ3 = PHYSOL(I,3,5) AKZZ4 = PHYSOL(I,4,5) AKZZ5 = PHYSOL(I,5,5) AKZZ6 = PHYSOL(I,6,5) AKZZ7 = PHYSOL(I,7,5) AKZZ8 = PHYSOL(I,8,5) AKZZ9 = PHYSOL(I,9,5) AKZZ10 = PHYSOL(I,10,5) ENDIF C XK1 = AKXX1 + AKXX5 + AKXX7 + AKXX8 YK1 = AKYY1 + AKYY5 + AKYY7 + AKYY8 ZK1 = AKZZ1 + AKZZ5 + AKZZ7 + AKZZ8 C XK2 = AKXX2 + AKXX5 + AKXX6 + AKXX9 YK2 = AKYY2 + AKYY5 + AKYY6 + AKYY9 ZK2 = AKZZ2 + AKZZ5 + AKZZ6 + AKZZ9 C XK3 = AKXX3 + AKXX6 + AKXX7 + AKXX10 YK3 = AKYY3 + AKYY6 + AKYY7 + AKYY10 ZK3 = AKZZ3 + AKZZ6 + AKZZ7 + AKZZ10 C XK4 = AKXX4 + AKXX8 + AKXX9 + AKXX10 YK4 = AKYY4 + AKYY8 + AKYY9 + AKYY10 ZK4 = AKZZ4 + AKZZ8 + AKZZ9 + AKZZ10 C XK5 = AKXX5 + AKXX6 + AKXX7 + AKXX8 YK5 = AKYY5 + AKYY6 + AKYY7 + AKYY8 ZK5 = AKZZ5 + AKZZ6 + AKZZ7 + AKZZ8 C XK6 = AKXX5 + AKXX6 + AKXX8 + AKXX9 YK6 = AKYY5 + AKYY6 + AKYY8 + AKYY9 ZK6 = AKZZ5 + AKZZ6 + AKZZ8 + AKZZ9 C XK7 = AKXX6 + AKXX7 + AKXX8 + AKXX10 YK7 = AKYY6 + AKYY7 + AKYY8 + AKYY10 ZK7 = AKZZ6 + AKZZ7 + AKZZ8 + AKZZ10 C XK8 = AKXX6 + AKXX8 + AKXX9 + AKXX10 YK8 = AKYY6 + AKYY8 + AKYY9 + AKYY10 ZK8 = AKZZ6 + AKZZ8 + AKZZ9 + AKZZ10 C COEFF = S18 / VOLUME(I) C X75 = COORDS(N5,1) - COORDS(N7,1) Y75 = COORDS(N5,2) - COORDS(N7,2) Z75 = COORDS(N5,3) - COORDS(N7,3) C X78 = COORDS(N8,1) - COORDS(N7,1) Y78 = COORDS(N8,2) - COORDS(N7,2) Z78 = COORDS(N8,3) - COORDS(N7,3) C X69 = COORDS(N9,1) - COORDS(N6,1) Y69 = COORDS(N9,2) - COORDS(N6,2) Z69 = COORDS(N9,3) - COORDS(N6,3) C X65 = COORDS(N5,1) - COORDS(N6,1) Y65 = COORDS(N5,2) - COORDS(N6,2) Z65 = COORDS(N5,3) - COORDS(N6,3) C X710= COORDS(N10,1) - COORDS(N7,1) Y710= COORDS(N10,2) - COORDS(N7,2) Z710= COORDS(N10,3) - COORDS(N7,3) C X76 = COORDS(N6,1) - COORDS(N7,1) Y76 = COORDS(N6,2) - COORDS(N7,2) Z76 = COORDS(N6,3) - COORDS(N7,3) C X89 = COORDS(N9,1) - COORDS(N8,1) Y89 = COORDS(N9,2) - COORDS(N8,2) Z89 = COORDS(N9,3) - COORDS(N8,3) C X810= COORDS(N10,1) - COORDS(N8,1) Y810= COORDS(N10,2) - COORDS(N8,2) Z810= COORDS(N10,3) - COORDS(N8,3) C DX1 = (Y75*Z78 - Z75*Y78) DY1 = - (X75*Z78 - Z75*X78) DZ1 = (X75*Y78 - Y75*X78) C DX2 = (Y69*Z65 - Z69*Y65) DY2 = - (X69*Z65 - Z69*X65) DZ2 = (X69*Y65 - Y69*X65) C DX3 = (Y710*Z76 - Z710*Y76) DY3 = - (X710*Z76 - Z710*X76) DZ3 = (X710*Y76 - Y710*X76) C DX4 = (Y89*Z810 - Z89*Y810) DY4 = - (X89*Z810 - Z89*X810) DZ4 = (X89*Y810 - Y89*X810) C C C Calcul des termes diagonaux C --------------------------- C WCT(I,1) = COEFF*(DX1**2*XK1+DY1**2*YK1+DZ1**2*ZK1) WCT(I,2) = COEFF*(DX2**2*XK2+DY2**2*YK2+DZ2**2*ZK2) WCT(I,3) = COEFF*(DX3**2*XK3+DY3**2*YK3+DZ3**2*ZK3) WCT(I,4) = COEFF*(DX4**2*XK4+DY4**2*YK4+DZ4**2*ZK4) WCT(I,5) = COEFF*(DX2**2*XK1+DY2**2*YK1+DZ2**2*ZK1+DX1**2*XK2+DY1 &**2*YK2+DZ1**2*ZK2+(DX1+DX2)**2*XK5+(DY1+DY2)**2*YK5+(DZ1+DZ2)**2* &ZK5+(DX1+DX2)**2*XK6+(DY1+DY2)**2*YK6+(DZ1+DZ2)**2*ZK6) WCT(I,6) = COEFF*(DX3**2*XK2+DY3**2*YK2+DZ3**2*ZK2+DX2**2*XK3+DY2 &**2*YK3+DZ2**2*ZK3+DX1**2*XK5+DY1**2*YK5+DZ1**2*ZK5+DX3**2*XK6+DY3 &**2*YK6+DZ3**2*ZK6+DX2**2*XK7+DY2**2*YK7+DZ2**2*ZK7+DX4**2*XK8+DY4 &**2*YK8+DZ4**2*ZK8) WCT(I,7) = COEFF*(DX3**2*XK1+DY3**2*YK1+DZ3**2*ZK1+DX1**2*XK3+DY1 &**2*YK3+DZ1**2*ZK3+(-DX2-DX4)**2*XK5+(-DY2-DY4)**2*YK5+(-DZ2-DZ4)* &*2*ZK5+(-DX2-DX4)**2*XK7+(-DY2-DY4)**2*YK7+(-DZ2-DZ4)**2*ZK7) WCT(I,8) = COEFF*(DX4**2*XK1+DY4**2*YK1+DZ4**2*ZK1+DX1**2*XK4+DY1 &**2*YK4+DZ1**2*ZK4+DX4**2*XK5+DY4**2*YK5+DZ4**2*ZK5+DX2**2*XK6+DY2 &**2*YK6+DZ2**2*ZK6+DX3**2*XK7+DY3**2*YK7+DZ3**2*ZK7+DX1**2*XK8+DY1 &**2*YK8+DZ1**2*ZK8) WCT(I,9) = COEFF*(DX4**2*XK2+DY4**2*YK2+DZ4**2*ZK2+DX2**2*XK4+DY2 &**2*YK4+DZ2**2*ZK4+(-DX1-DX3)**2*XK6+(-DY1-DY3)**2*YK6+(-DZ1-DZ3)* &*2*ZK6+(-DX1-DX3)**2*XK8+(-DY1-DY3)**2*YK8+(-DZ1-DZ3)**2*ZK8) WCT(I,10) = COEFF*(DX4**2*XK3+DY4**2*YK3+DZ4**2*ZK3+DX3**2*XK4+D &Y3**2*YK4+DZ3**2*ZK4+(DX3+DX4)**2*XK7+(DY3+DY4)**2*YK7+(DZ3+DZ4)** &2*ZK7+(DX3+DX4)**2*XK8+(DY3+DY4)**2*YK8+(DZ3+DZ4)**2*ZK8) C C Calcul des termes extra-diagonaux C --------------------------------- C XMAT(I,1) = COEFF*(DX1*DX2*XK1+DY1*DY2*YK1+DZ1*DZ2*ZK1) XMAT(I,2) = COEFF*(DX1*DX3*XK1+DY1*DY3*YK1+DZ1*DZ3*ZK1) XMAT(I,3) = COEFF*(DX1*DX4*XK1+DY1*DY4*YK1+DZ1*DZ4*ZK1) C XMAT(I,4) = COEFF*(DX2*DX1*XK2+DY2*DY1*YK2+DZ2*DZ1*ZK2) XMAT(I,5) = COEFF*(DX2*DX3*XK2+DY2*DY3*YK2+DZ2*DZ3*ZK2) XMAT(I,6) = COEFF*(DX2*DX4*XK2+DY2*DY4*YK2+DZ2*DZ4*ZK2) C XMAT(I,7) = COEFF*(DX3*DX2*XK3+DY3*DY2*YK3+DZ3*DZ2*ZK3) XMAT(I,8) = COEFF*(DX3*DX1*XK3+DY3*DY1*YK3+DZ3*DZ1*ZK3) XMAT(I,9) = COEFF*(DX3*DX4*XK3+DY3*DY4*YK3+DZ3*DZ4*ZK3) C XMAT(I,10) = COEFF*(DX4*DX1*XK4+DY4*DY1*YK4+DZ4*DZ1*ZK4) XMAT(I,11) = COEFF*(DX4*DX2*XK4+DY4*DY2*YK4+DZ4*DZ2*ZK4) XMAT(I,12) = COEFF*(DX4*DX3*XK4+DY4*DY3*YK4+DZ4*DZ3*ZK4) C XMAT(I,13) =COEFF*(DX1*DX3*XK2+DY1*DY3*YK2+DZ1*DZ3*ZK2-(DX1+DX2)*D &X1*XK5-(DY1+DY2)*DY1*YK5-(DZ1+DZ2)*DZ1*ZK5+(DX1+DX2)*DX3*XK6+(DY1+ &DY2)*DY3*YK6+(DZ1+DZ2)*DZ3*ZK6) XMAT(I,14) =COEFF*(DX2*DX3*XK1+DY2*DY3*YK1+DZ2*DZ3*ZK1+(DX1+DX2)*( &-DX2-DX4)*XK5+(DY1+DY2)*(-DY2-DY4)*YK5+(DZ1+DZ2)*(-DZ2-DZ4)*ZK5) XMAT(I,15) =COEFF*(DX2*DX4*XK1+DY2*DY4*YK1+DZ2*DZ4*ZK1+(DX1+DX2)*D &X4*XK5+(DY1+DY2)*DY4*YK5+(DZ1+DZ2)*DZ4*ZK5-(DX1+DX2)*DX2*XK6-(DY1+ &DY2)*DY2*YK6-(DZ1+DZ2)*DZ2*ZK6) XMAT(I,16) =COEFF*(DX1*DX4*XK2+DY1*DY4*YK2+DZ1*DZ4*ZK2+(DX1+DX2)*( &-DX1-DX3)*XK6+(DY1+DY2)*(-DY1-DY3)*YK6+(DZ1+DZ2)*(-DZ1-DZ3)*ZK6) C XMAT(I,17) =COEFF*(DX2*DX1*XK3+DY2*DY1*YK3+DZ2*DZ1*ZK3-DX1*(-DX2-D &X4)*XK5-DY1*(-DY2-DY4)*YK5-DZ1*(-DZ2-DZ4)*ZK5+DX2*(-DX2-DX4)*XK7+D &Y2*(-DY2-DY4)*YK7+DZ2*(-DZ2-DZ4)*ZK7) XMAT(I,18) =COEFF*(-DX1*DX4*XK5-DY1*DY4*YK5-DZ1*DZ4*ZK5-DX3*DX2*XK &6-DY3*DY2*YK6-DZ3*DZ2*ZK6-DX2*DX3*XK7-DY2*DY3*YK7-DZ2*DZ3*ZK7-DX4* &DX1*XK8-DY4*DY1*YK8-DZ4*DZ1*ZK8) XMAT(I,19) =COEFF*(DX3*DX4*XK2+DY3*DY4*YK2+DZ3*DZ4*ZK2+DX3*(-DX1-D &X3)*XK6+DY3*(-DY1-DY3)*YK6+DZ3*(-DZ1-DZ3)*ZK6-DX4*(-DX1-DX3)*XK8-D &Y4*(-DY1-DY3)*YK8-DZ4*(-DZ1-DZ3)*ZK8) XMAT(I,20) = COEFF*(DX2*DX4*XK3+DY2*DY4*YK3+DZ2*DZ4*ZK3+DX2*(DX3+D &X4)*XK7+DY2*(DY3+DY4)*YK7+DZ2*(DZ3+DZ4)*ZK7-DX4*(DX3+DX4)*XK8-DY4* &(DY3+DY4)*YK8-DZ4*(DZ3+DZ4)*ZK8) C XMAT(I,21) =COEFF*(DX3*DX4*XK1+DY3*DY4*YK1+DZ3*DZ4*ZK1+(-DX2-DX4)* &DX4*XK5+(-DY2-DY4)*DY4*YK5+(-DZ2-DZ4)*DZ4*ZK5-(-DX2-DX4)*DX3*XK7-( &-DY2-DY4)*DY3*YK7-(-DZ2-DZ4)*DZ3*ZK7) XMAT(I,22) = COEFF*(DX1*DX4*XK3+DY1*DY4*YK3+DZ1*DZ4*ZK3+(-DX2-DX4) &*(DX3+DX4)*XK7+(-DY2-DY4)*(DY3+DY4)*YK7+(-DZ2-DZ4)*(DZ3+DZ4)*ZK7) C XMAT(I,23) =COEFF*(DX1*DX2*XK4+DY1*DY2*YK4+DZ1*DZ2*ZK4-DX2*(-DX1-D &X3)*XK6-DY2*(-DY1-DY3)*YK6-DZ2*(-DZ1-DZ3)*ZK6+DX1*(-DX1-DX3)*XK8+D &Y1*(-DY1-DY3)*YK8+DZ1*(-DZ1-DZ3)*ZK8) XMAT(I,24) = COEFF*(DX1*DX3*XK4+DY1*DY3*YK4+DZ1*DZ3*ZK4-DX3*(DX3+D &X4)*XK7-DY3*(DY3+DY4)*YK7-DZ3*(DZ3+DZ4)*ZK7+DX1*(DX3+DX4)*XK8+DY1* &(DY3+DY4)*YK8+DZ1*(DZ3+DZ4)*ZK8) C XMAT(I,25) = COEFF*(DX2*DX3*XK4+DY2*DY3*YK4+DZ2*DZ3*ZK4+(-DX1-DX3) &*(DX3+DX4)*XK8+(-DY1-DY3)*(DY3+DY4)*YK8+(-DZ1-DZ3)*(DZ3+DZ4)*ZK8) C C 200 CONTINUE C C C ENDIF C C------- C FORMAT C------- C END syrthes-3.4.3-dfsg1/src/s/syrban.F0000666000175000017500000001477311524070642015363 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE SYRBAN C ***************** C * ( I ) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C BANNIERES DE DEBUT ET DE FIN DE SYRTHES * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! I ! E ! D ! I= 1 => banniere de debut de programme ! C ! ! ! ! I=-1 => banniere de fin de programme ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : TERMIC C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C #include "nlofes.h" C C*********************************************************************** C.. Variables externes INTEGER I C C.. Variables internes C C*********************************************************************** C C ECRITURE DE LA BANNIERE C ----------------------- C IF (I.EQ.1) THEN C WRITE(NFECRA,*) WRITE(NFECRA,1000) WRITE(NFECRA,1010) WRITE(NFECRA,1100) WRITE(NFECRA,1200) C ELSE C WRITE(NFECRA,2000) WRITE(NFECRA,*) C ENDIF C C-------- C FORMATS C-------- 1000 FORMAT (/,4X,64('*'),/, & 4X,'*',62X,'*',/, & 4X,'* SSSSS YY YY RRRRRR TTTTTTTT ', & 'HH HH EEEEEE SSSSS *',/, & 4X,'* SS YY YY RR RR TT ', & 'HH HH EE SS *',/, & 4X,'* SS YYYY RR RR TT ', & 'HH HH EE SS *',/, & 4X,'* SSSS YY RRRRRR TT ', & 'HHHHHHH EEEE SSSS *',/, & 4X,'* SS YY RR RR TT ', & 'HH HH EE SS *',/, & 4X,'* SS YY RR RR TT ', & 'HH HH EE SS *',/, & 4X,'* SSSSS YY RR RR TT ', & 'HH HH EEEEEE SSSSS *',/, & 4X,'*',62X,'*',/, & 4X,64('*'),/) 1100 FORMAT( 'This file is part of the SYRTHES Kernel, element of the',/, &'thermal code SYRTHES.',/, &'Copyright (C) 1988-2008 EDF S.A., France',//, &'contact: syrthes-support@edf.fr',//, &'The SYRTHES Kernel is free software; you can redistribute it',/, &'and/or modify it under the terms of the GNU General ', &'Public License',/, &'as published by the Free Software Foundation; either version 2 ', &/,'of the License, or (at your option) any later version.') 1200 FORMAT('The SYRTHES Kernel is distributed in the hope', &' that it will be',/, &'useful, but WITHOUT ANY WARRANTY; without even the implied ', &'warranty',/, &'of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ', &'See the',/, &'GNU General Public License for more details.',//, &'You should have received a copy of the GNU General Public ', &'License',/, &'along with the Code_Saturne Kernel; if not, write to the',/, &'Free Software Foundation, Inc.,',/, &'51 Franklin St, Fifth Floor,',/, &'Boston, MA 02110-1301 USA',/) 1010 FORMAT(30X,'VERSION 3.4.2',//) 2000 FORMAT (///,80('*'),/, & '*',21X,'- SYRTHES - FIN NORMALE DU PROGRAMME',21X,'*',/, & 80('*'),/) C RETURN END syrthes-3.4.3-dfsg1/src/s/build_octree.c0000666000175000017500000003401011524070642016544 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "tree.h" # include "abs.h" # include "interfaces.h" extern int nelvoip; extern int nsp; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | build_octree | | Construction de l'octree | |======================================================================| */ void build_octree (struct node *arbre, int ndim, int npoinr,int nelray, int *nodray,double *cooray, double *size_min,double dim_boite[]) { struct element *f1,*f2; int i,npoinr2,nbface; double dx,dy,dz; double xmin,xmax,ymin,ymax,zmin,zmax; npoinr2 = 2*npoinr; xmin=dim_boite[0]; xmax=dim_boite[1]; ymin=dim_boite[2]; ymax=dim_boite[3]; zmin=dim_boite[4]; zmax=dim_boite[5]; dx = xmax-xmin; dy=ymax-ymin; dz=zmax-zmin; /* arbre->name = 1; */ arbre->xc = (xmin+xmax)*0.5; arbre->yc = (ymin+ymax)*0.5; arbre->zc = (zmin+zmax)*0.5; arbre->sizx = dx*0.5; arbre->sizy = dy*0.5; arbre->sizz = dz*0.5; arbre->lelement = NULL; arbre->lfils = NULL; *size_min = min(dx,dy); *size_min = min(*size_min,dz); f1 = (struct element *)malloc(sizeof(struct element)); if (f1==NULL) {printf(" ERREUR build_octree : probleme d'allocation memoire\n"); exit(0);} f1->num = 1; f1->suivant=NULL; arbre->lelement=f1; for (i=1;inum = i+1; f2->suivant=NULL; f1->suivant = f2; f1 = f2; } nbface = nelray; decoupe(arbre,nodray,cooray,nelray,npoinr,nbface,size_min); elague_tree(arbre,arbre,8); /* printf("\n\n Arbre apres elaguage\n"); affiche_tree(arbre,8); */ } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe | | Construction de l'octree | |======================================================================| */ void decoupe(struct node *noeud,int *nodray,double *cooray, int nelray,int npoinr,int nbface,double *size_min) { double xmin[8],xmax[8],ymin[8],ymax[8],zmin[8],zmax[8]; double x,y,z,dx,dy,dz ; int i,nbfac,nbelt_max; struct node *n1,*n2,*noeudi; struct child *f1,*f2; struct element *face1; nbelt_max=max(nelvoip*nsp+10,512); if (nbface>nbelt_max) { x = noeud->xc; y = noeud->yc; z = noeud->zc; dx = noeud->sizx; dy = noeud->sizy; dz = noeud->sizz; xmax[0]=xmax[3]=xmax[4]=xmax[7]= x; xmin[1]=xmin[2]=xmin[5]=xmin[6]= x; xmin[0]=xmin[3]=xmin[4]=xmin[7]= x - dx; xmax[1]=xmax[2]=xmax[5]=xmax[6]= x + dx; ymax[0]=ymax[1]=ymax[2]=ymax[3]= y; ymin[4]=ymin[5]=ymin[6]=ymin[7]= y; ymin[0]=ymin[1]=ymin[2]=ymin[3]= y - dy; ymax[4]=ymax[5]=ymax[6]=ymax[7]= y + dy; zmax[2]=zmax[3]=zmax[6]=zmax[7]= z; zmin[0]=zmin[1]=zmin[4]=zmin[5]= z; zmin[2]=zmin[3]=zmin[6]=zmin[7]= z - dz; zmax[0]=zmax[1]=zmax[4]=zmax[5]= z + dz; f1= (struct child *)malloc(sizeof(struct child)); n1= (struct node *) malloc(sizeof(struct node )); if (f1==NULL || n1==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} noeud->lfils = f1; /* f1->name = (noeud->name)*10 + 1; */ f1->fils = n1; f1->suivant = NULL; for (i=1;i<8;i++) { f2= (struct child *)malloc(sizeof(struct child)); n2= (struct node *) malloc(sizeof(struct node )); if (f2==NULL || n2==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} f1->suivant = f2; /* f2->name = (noeud->name)*10 + i+1; */ f2->fils = n2; f2->suivant = NULL; f1 = f2; } f1 = noeud->lfils; for (i=0;i<8;i++) { noeudi = f1->fils; /* noeudi->name = (noeud->name)*10 + i+1; */ noeudi->xc = (xmin[i]+xmax[i])*0.5; noeudi->yc = (ymin[i]+ymax[i])*0.5; noeudi->zc = (zmin[i]+zmax[i])*0.5; noeudi->sizx = (xmax[i]-xmin[i])*0.5; noeudi->sizy = (ymax[i]-ymin[i])*0.5; noeudi->sizz = (zmax[i]-zmin[i])*0.5; *size_min = min(*size_min,noeudi->sizx); *size_min = min(*size_min,noeudi->sizy); *size_min = min(*size_min,noeudi->sizz); noeudi->lfils = NULL; face1= (struct element *)malloc(sizeof(struct element)); if (face1==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} noeudi->lelement = face1; triface(noeud->lelement,noeudi->lelement, &nbfac,nelray,npoinr,nodray,cooray, noeudi->xc,noeudi->yc,noeudi->zc, noeudi->sizx,noeudi->sizy,noeudi->sizz); if (nbfac != 0) decoupe(noeudi,nodray,cooray,nelray,npoinr,nbfac,size_min); else { noeudi->lelement = NULL; free(face1); } f1 = f1->suivant; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | triface | | Tri des faces pour les placer dans l'octree | |======================================================================| */ void triface( struct element *face_pere, struct element *face_fils, int *nbfac,int nelray,int npoinr,int *nodray,double *cooray, double xcc,double ycc,double zcc,double dx,double dy,double dz) { int n,prem ; double xa,ya,za,xb,yb,zb,xc,yc,zc; struct element *fp1,*ff1,*ff2; prem = 1; fp1 = face_pere; ff1 = face_fils; *nbfac = 0; do { n = *(nodray+fp1->num-1); xa = *(cooray+n-1); ya = *(cooray+n-1+npoinr); za = *(cooray+n-1+npoinr*2); n = *(nodray+fp1->num-1+nelray); xb = *(cooray+n-1); yb = *(cooray+n-1+npoinr); zb = *(cooray+n-1+npoinr*2); n = *(nodray+fp1->num-1+nelray*2); xc = *(cooray+n-1); yc = *(cooray+n-1+npoinr); zc = *(cooray+n-1+npoinr*2); if (tria_in_cube(xa,ya,za,xb,yb,zb,xc,yc,zc,xcc,ycc,zcc,dx,dy,dz)) { if (prem) { prem = 0; ff1->num = fp1->num; ff1->suivant = NULL; } else { ff2= (struct element *)malloc(sizeof(struct element)); if (ff2==NULL) {printf(" ERREUR triface : probleme d'allocation memoire\n"); exit(0);} ff2->num = fp1->num; ff2->suivant = NULL; ff1->suivant = ff2; ff1 = ff2; } *nbfac += 1; } fp1 = fp1->suivant; }while (fp1 != NULL); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | tria_in_cube | | Tri des faces pour les placer dans l'octree | |======================================================================| */ int tria_in_cube(double xa,double ya,double za,double xb,double yb,double zb, double xc,double yc,double zc, double xcc,double ycc,double zcc,double dx,double dy,double dz) { double xmin,xmax,ymin,ymax,zmin,zmax; double ta,tb,tc,td,xab,yab,zab,xac,yac,zac,xp,yp,zp; double epsi,dxy,dxz,dyz,d3,t; epsi=1.E-5; dxy= dx+dy; dxz=dx+dz; dyz=dy+dz; d3=dxy+dz; xmin = xcc-dx-epsi; xmax = xcc+dx+epsi; ymin = ycc-dy-epsi; ymax = ycc+dy+epsi; zmin = zcc-dz-epsi; zmax = zcc+dz+epsi; if (in_boite (xa,ya,za,xmin,xmax,ymin,ymax,zmin,zmax)) return(1); else if (in_boite (xb,yb,zb,xmin,xmax,ymin,ymax,zmin,zmax)) return(1); else if (in_boite (xc,yc,zc,xmin,xmax,ymin,ymax,zmin,zmax)) return(1); /* tous les points sont du meme cote d'un plan ==> pas intersection */ else if (xa>xmax && xb>xmax && xc>xmax) return(0); else if (xaymax && yb>ymax && yc>ymax) return(0); else if (yazmax && zb>zmax && zc>zmax) return(0); else if (zadxz && xb-zb>dxz && xc-zc>dxz) return(0); else if (xa+za<-dxz && xb+zb<-dxz && xc+zc<-dxz) return(0); else if (xa+za>dxz && xb+zb>dxz && xc+zc>dxz) return(0); else if (ya-za<-dyz && yb-zb<-dyz && yc-zc<-dyz) return(0); else if (ya-za>dyz && yb-zb>dyz && yc-zc>dyz) return(0); else if (ya+za<-dyz && yb+zb<-dyz && yc+zc<-dyz) return(0); else if (ya+za>dyz && yb+zb>dyz && yc+zc>dyz) return(0); else if (xa-ya<-dxy && xb-yb<-dxy && xc-yc<-dxy) return(0); else if (xa-ya>dxy && xb-yb>dxy && xc-yc>dxy) return(0); else if (xa+ya<-dxy && xb+yb<-dxy && xc+yc<-dxy) return(0); else if (xa+ya>dxy && xb+yb>dxy && xc+yc>dxy) return(0); else if ( xa+ya-za>d3 && xb+yb-zb>d3 && xc+yc-zc>d3) return(0); else if (-xa+ya-za>d3 && -xb+yb-zb>d3 && -xc+yc-zc>d3) return(0); else if (-xa+ya+za>d3 && -xb+yb+zb>d3 && -xc+yc+zc>d3) return(0); else if ( xa+ya+za>d3 && xb+yb+zb>d3 && xc+yc+zc>d3) return(0); else if ( xa-ya-za>d3 && xb-yb-zb>d3 && xc-yc-zc>d3) return(0); else if (-xa-ya-za>d3 && -xb-yb-zb>d3 && -xc-yc-zc>d3) return(0); else if (-xa-ya+za>d3 && -xb-yb+zb>d3 && -xc-yc+zc>d3) return(0); else if ( xa-ya+za>d3 && xb-yb+zb>d3 && xc-yc+zc>d3) return(0); else if (seg_cubex( dx,dy,dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubex(-dx,dy,dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubey(dx, dy,dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubey(dx,-dy,dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubez(dx,dy, dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubez(dx,dy,-dz,xa,xb,ya,yb,za,zb)) return(1); else if (seg_cubex( dx,dy,dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubex(-dx,dy,dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubey(dx, dy,dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubey(dx,-dy,dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubez(dx,dy, dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubez(dx,dy,-dz,xb,xc,yb,yc,zb,zc)) return(1); else if (seg_cubex( dx,dy,dz,xa,xc,ya,yc,za,zc)) return(1); else if (seg_cubex(-dx,dy,dz,xa,xc,ya,yc,za,zc)) return(1); else if (seg_cubey(dx, dy,dz,xa,xc,ya,yc,za,zc)) return(1); else if (seg_cubey(dx,-dy,dz,xa,xc,ya,yc,za,zc)) return(1); else if (seg_cubez(dx,dy, dz,xa,xc,ya,yc,za,zc)) return(1); else if (seg_cubez(dx,dy,-dz,xa,xc,ya,yc,za,zc)) return(1); else { xab=xb-xa; yab=yb-ya; zab=zb-za; xac=xc-xa; yac=yc-ya; zac=zc-za; ta = yab*zac-zab*yac; tb = zab*xac-xab*zac; tc = xab*yac-yab*xac; td = -(ta*xa+tb*ya+tc*za); if (diag_tria(ta,tb,tc,td,dx,dy,dz,&t)) { xp=t*dx; yp=t*dy; zp=t*dz; if (in_triangle(ta,tb,tc,td,xa,ya,za,xab,yab,zab,xac,yac,zac,xp,yp,zp)) return(1); } if (diag_tria(ta,tb,tc,td,dx,dy,-dz,&t)) { xp=t*dx; yp=t*dy; zp=-t*dz; if (in_triangle(ta,tb,tc,td,xa,ya,za,xab,yab,zab,xac,yac,zac,xp,yp,zp)) return(1); } if (diag_tria(ta,tb,tc,td,-dx,dy,dz,&t)) { xp=-t*dx; yp=t*dy; zp=t*dz; if (in_triangle(ta,tb,tc,td,xa,ya,za,xab,yab,zab,xac,yac,zac,xp,yp,zp)) return(1); } if (diag_tria(ta,tb,tc,td,-dx,dy,-dz,&t)) { xp=-t*dx; yp=t*dy; zp=-t*dz; if (in_triangle(ta,tb,tc,td,xa,ya,za,xab,yab,zab,xac,yac,zac,xp,yp,zp)) return(1); } } } return(0); } syrthes-3.4.3-dfsg1/src/s/angouv.F0000666000175000017500000001413611524070642015355 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 **************** SUBROUTINE ANGOUV C ***************** C C --------------------------------------------------- *( NDIM,NPOINS,NELEMS,NCOEMA,NDMATS,NODES,NANGLE,DMAT,XMAT) C ------------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CORRECTION DE LA MATRICE POUR LE CAS DES * C ELEMENTS AVEC ANGLES OUVERTS * C Correction en cours de test mais pas vraiment * C concluante : il faut un peu raffiner * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! WCT ! TR ! M ! TABLEAU DE TRAVAIL ( NELEMS * NDMATS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C C*********************************************************************** C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS,NCOEMA INTEGER NANGLE(NELEMS),NODES(NELEMS,NDMATS) C DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) C C.. Variables internes INTEGER I,j,N1,N2,N3,N4,N5,N6 C*********************************************************************** C 1- INITIALISATIONS C ================== C IF (NDIM.EQ.2) THEN DO I=1,NELEMS c print*,'angle=',nangle(i),' --> ',(XMAT(i,j),j=1,ncoema) N1=NODES(I,1) N2=NODES(I,2) N3=NODES(I,3) N4=NODES(I,4) N5=NODES(I,5) N6=NODES(I,6) IF (NANGLE(I).NE.0) THEN IF (XMAT(I,1).GT.0) THEN DMAT(N1)=DMAT(N1)+XMAT(I,1) DMAT(N4)=DMAT(N4)+XMAT(I,1) XMAT(I,1)=0.D0 ENDIF IF (XMAT(I,2).GT.0) THEN DMAT(N1)=DMAT(N1)+XMAT(I,2) DMAT(N6)=DMAT(N6)+XMAT(I,2) XMAT(I,2)=0.D0 ENDIF IF (XMAT(I,3).GT.0) THEN DMAT(N2)=DMAT(N2)+XMAT(I,3) DMAT(N4)=DMAT(N4)+XMAT(I,3) XMAT(I,3)=0.D0 ENDIF IF (XMAT(I,4).GT.0) THEN DMAT(N2)=DMAT(N2)+XMAT(I,4) DMAT(N5)=DMAT(N5)+XMAT(I,4) XMAT(I,4)=0.D0 ENDIF IF (XMAT(I,5).GT.0) THEN DMAT(N3)=DMAT(N3)+XMAT(I,5) DMAT(N5)=DMAT(N5)+XMAT(I,5) XMAT(I,5)=0.D0 ENDIF IF (XMAT(I,6).GT.0) THEN DMAT(N3)=DMAT(N3)+XMAT(I,6) DMAT(N6)=DMAT(N6)+XMAT(I,6) XMAT(I,6)=0.D0 ENDIF IF (XMAT(I,7).GT.0) THEN DMAT(N4)=DMAT(N4)+XMAT(I,7) DMAT(N5)=DMAT(N5)+XMAT(I,7) XMAT(I,7)=0.D0 ENDIF IF (XMAT(I,8).GT.0) THEN DMAT(N4)=DMAT(N4)+XMAT(I,8) DMAT(N6)=DMAT(N6)+XMAT(I,8) XMAT(I,8)=0.D0 ENDIF IF (XMAT(I,9).GT.0) THEN DMAT(N5)=DMAT(N5)+XMAT(I,9) DMAT(N6)=DMAT(N6)+XMAT(I,9) XMAT(I,9)=0.D0 ENDIF ENDIF ENDDO ELSE print*,' Non fait pour l instant - Christophe ' ENDIF C END syrthes-3.4.3-dfsg1/src/s/mobtmp.F0000666000175000017500000001122011524070642015343 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBTMP,SSI=0 SUBROUTINE MOBTMP C ***************** C C ----------------------------- * (NUMA,NDIM,NPOINS,TMPSA,TMPS) C ----------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C SOLIDES EN TRANSLATION : REINITIALISATION DE LA TEMPERATURE * C SUR LE MAILLAGE QUI VIENT SE REPOSITIONNER AU DESSOUS * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NUMA ! E ! D ! Numero du maillage a translater (1 ou 2) ! C ! NDIM ! E ! D ! Dimension du probleme ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! TMPSA ! TR ! M ! Temperature solide etape N | C ! TMPS ! TR ! M ! Temperature solide etape N+1 | C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NUMA,NDIM,NPOINS DOUBLE PRECISION TMPSA(NPOINS),TMPS(NPOINS) C C.. Variables internes INTEGER N1,N2,N C*********************************************************************** C C C 0- INITIALISATIONS C ================== IF (NUMA.EQ.1) THEN N1 = 1 N2 = NBNMA1 ELSEIF (NUMA.EQ.2) THEN N1 = NBNMA1 + 1 N2 = NPOINS ELSEIF (NUMA.EQ.-1) THEN N1 = 1 N2 = NPOINS ENDIF C C 1- REINITIALISATION DE LA TEMPERATURE C ===================================== C DO 100 N=N1,N2 TMPS (N) = TENMOB TMPSA(N) = TENMOB 100 CONTINUE C C C RETURN END syrthes-3.4.3-dfsg1/src/s/lrame2.F0000666000175000017500000001165411524070642015242 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRAME2 C ***************** C C -------------------------------- *(NDIM,NPOINR,NELRAY,IREF,INOEUD) C -------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE SYRTHES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #ifdef MED #include "med.hf" #endif C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY,IREF(NELRAY),INOEUD(NELRAY*NDIM) C #ifdef MED C.. Variables internes INTEGER I,J,N1,NBNO,IERR CHARACTER CH*80 C C*********************************************************************** C C 1- INITIALISATIONS C ================== C NBNO = NDIM C C 4- TABLE DES ELEMENTS C ===================== C C 4.2- Lecture des elements C ------------------------- C IF (NBNO.EQ.3) THEN DO 420 I=1,NELRAY READ(NFSGRA,4200) N1,IREF(I), & (INOEUD((J-1)*NELRAY+I),J=1,NBNO) 420 CONTINUE C ELSEIF (NBNO.EQ.4) THEN DO 421 I=1,NELRAY READ(NFSGRA,4201) N1,IREF(I), & (INOEUD((J-1)*NELRAY+I),J=1,NBNO) 421 CONTINUE ENDIF C C C-------- C FORMATS C-------- C C 4100 FORMAT(//,' *** LRAME2 : LE FICHIER GEOMETRIQUE NE CONTIENT ', & 'PAS LA TABLE DES ELEMENTS') 4200 FORMAT(I7,I3,2I7) 4201 FORMAT(I7,I3,3I7) C #endif END syrthes-3.4.3-dfsg1/src/s/lrasi1.F0000666000175000017500000002004111524070642015241 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRASI1 C ***************** C C -------------------- *(NDIM,NPOINR,NELRAY) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE SIMAIL * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY C C.. Variables internes INTEGER NDIMEF,NCOPNP,NSOMP1 INTEGER I,M(32),LE,NSEG,NTRI,NTET CHARACTER*4 CHAR4 #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C C 0- INITIALISATIONS C ================== C #ifdef HAVE_C_IO CALL REWDBF (NFSGRA, IERROR) IF (IERROR .NE. 0) GOTO 998 #else REWIND (NFSGRA) #endif C C 1- LECTURE DE L'ENREGISTREMENT AVANT LE TABLEAU 0 C ================================================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGRA,ERR=999) LE,(M(I), I=1,LE) C REWIND (NFSGRA) READ (NFSGRA,ERR=999) LE,(M(I), I=1,LE) #endif C C 2- LECTURE DU TABLEAU 0 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGRA,ERR=999) LE, (M(I), I=1,LE) #endif C C verifications.... C - du nom de la structure c C = CHAR4(M(29)) c IF (C.NE.'NOPO') THEN c WRITE(NFECRA,1000) c CLOSE(NFSGRA) c STOP c ENDIF C - du nombre de tableaux associes IF (M(32).NE.0) THEN WRITE(NFECRA,1023) STOP ENDIF C C 3- LECTURE DU TABLEAU 2 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGRA,ERR=999) LE,(M(I),I=1,LE) #endif C NDIMEF = M(1) NCOPNP = M(4) NELRAY = M(5) NSEG = M(7) NTRI = M(8) NTET = M(10) NPOINR = M(15) NSOMP1 = M(22) C C C 4- VERIFICATIONS DIVERSES C ========================= C IF (NDIM.NE.NDIMEF) THEN WRITE(NFECRA,1021) STOP ENDIF C IF (NSOMP1.NE.NPOINR) THEN WRITE(NFECRA,1022) STOP ENDIF C IF (NTRI.NE.NELRAY .AND. NSEG.NE.NELRAY) THEN WRITE(NFECRA,1023) STOP ENDIF C C RETURN #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #else 999 CONTINUE WRITE(NFECRA,9999) STOP #endif C C-------- C FORMATS C-------- C 1000 FORMAT(' %% ERREUR LRASI1 : LE FICHIER NE CONTIENT PAS UNE S.D.', & ' DE MAILLAGE ') 1018 FORMAT(' %% ERREUR LRASI1 : DIMENSION DES MAILLAGES ', & 'INCOMPATIBLES') 1021 FORMAT(' %% ERREUR LRASI1 : La dimension du maillage rayonnement' & ,' n''est pas coherente',/, & 21X,'avec celle du solide') 1022 FORMAT(' %% ERREUR LRASI1 : LE MAILLAGE POSSEDE DES' & ,' NOEUDS MILIEUX') 1023 FORMAT(' %% ERREUR LRASI1 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES',/, & 20X,'Seuls sont autorises :',/, & 20X,' - les triangles (en dimension 3)',/, & 20X,' - les segments (en dimension 2)') C #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LRASI1 : erreur de lecture du maillage ', * ' rayonnement',/,' de type : ',A) #else 9999 FORMAT(' %% ERREUR LRASI1 : erreur de lecture du maillage ', * ' rayonnement') #endif C END syrthes-3.4.3-dfsg1/src/s/lecref.F0000666000175000017500000004414211524070642015316 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECREF C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER cl.data * C Lecture de la correspondance entre references * C et type de CL * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! M ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" #include "bilan.h" C C********************************************************************** C C INTEGER I,N,I1,I2,II1,II2,NB,LCH C INTEGER ITAB(NRFMAX) CHARACTER*200 CHAINE,FORMA C C********************************************************************** C C 0- INITIALISATIONS C ================== C DO I=1,NRFMAX IREFFC(I) = 0 IREFSC(I) = 0 IREFSD(I) = 0 IREFSF(I) = 0 IREFSE(I) = 0 IREFSV(I) = 0 IREFRE(I) = 0 IREFRI(I) = 0 IREFPR(I) = 0 IREFMO(I) = 0 ENDDO C DO I=1,NRFMAX ITAB(I) = 0 ENDDO C DO I=1,NRFMAX DO N=1,NBISMX IRBILS(I,N)=0 IRBILV(I,N)=0 ENDDO ENDDO C C C C 1- LECTURE DES REFERENCES DES CATEGORIES DE NOEUDS C ================================================== C REWIND(NFCLCT) C C Boucle de lecture.... 10 CONTINUE C CHAINE = ' ' READ(NFCLCT,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) GOTO 10 C C C 1.1- NOEUDS FLUIDES COUPLES AU SOLIDE C ------------------------------------ IF ( CHAINE(I1:I2).EQ. * 'REFERENCES NOEUDS FLUIDES COUPLES AU SOLIDE') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 110 N=1,NB IREFFC(ITAB(N)) = 1 110 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 111 N=1,NRFMAX IREFFC(N) = 1 111 CONTINUE ENDIF C C 1.2- NOEUDS SOLIDES COUPLES C --------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'REFERENCES NOEUDS OU FACES SOLIDES COUPLE(E)S') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 120 N=1,NB IREFSC(ITAB(N)) = 1 120 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 121 N=1,NRFMAX IREFSC(N) = 1 121 CONTINUE ENDIF C C C 1.3- NOEUDS SOLIDES AVEC DIRICHLET C ---------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS SOLIDES AVEC DIRICHLET') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 130 N=1,NB IREFSD(ITAB(N)) = 1 130 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 131 N=1,NRFMAX IREFSD(N) = 1 131 CONTINUE ENDIF C C 1.4- NOEUDS SOLIDES AVEC FLUX C ----------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC FLUX') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 140 N=1,NB IREFSF(ITAB(N)) = 1 140 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 141 N=1,NRFMAX IREFSF(N) = 1 141 CONTINUE ENDIF C C 1.5- NOEUDS SOLIDES AVEC COEFFICIENTS D'ECHANGE C ----------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC COEFFICIENT D ECHANGE') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 150 N=1,NB IREFSE(ITAB(N)) = 1 150 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 151 N=1,NRFMAX IREFSE(N) = 1 151 CONTINUE ENDIF C C 1.6- NOEUDS SOLIDES AVEC FLUX VOLUMIQUE C ---------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU ELEMENTS SOLIDES AVEC FLUX VOLUMIQUES') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 160 N=1,NB IREFSV(ITAB(N)) = 1 160 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 161 N=1,NRFMAX IREFSV(N) = 1 161 CONTINUE ENDIF C C 1.7- NOEUDS SOLIDES AVEC RESISTANCE DE CONTACT C ---------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RESISTANCE DE CONTACT') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 170 N=1,NB IREFRE(ITAB(N)) = 1 170 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 171 N=1,NRFMAX IREFRE(N) = 1 171 CONTINUE ENDIF C C 1.8- NOEUDS SOLIDES AVEC RAYONNEMENT INFINI C ------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT INFINI') & THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 182 N=1,NB IREFRI(ITAB(N)) = 1 182 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 183 N=1,NRFMAX IREFRI(N) = 1 183 CONTINUE ENDIF C C C 1.9- NOEUDS SOLIDES PERIODIQUES C ------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS SOLIDES PERIODIQUES') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 IF (NB.NE.0 .AND. NBDIPR.EQ.0) THEN WRITE(NFECRA,1900) STOP ENDIF C DO 190 N=1,NB IREFPR(ITAB(N)) = 1 190 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 191 N=1,NRFMAX IREFPR(N) = 1 191 CONTINUE ENDIF C C 1.10- NOEUDS SOLIDES EN ROTATION C -------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. & 'REFERENCES NOEUDS SOLIDES EN ROTATION') THEN C II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO 192 N=1,NB IREFMO(ITAB(N)) = 1 192 CONTINUE C IF (ITAB(1).LE.-1) THEN DO 193 N=1,NRFMAX IREFMO(N) = 1 193 CONTINUE ENDIF C C C C 1.11- BILAN DE FLUX SURFACIQUES C ------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. 'BILAN FLUX SURFACIQUES') THEN C NBILAS=NBILAS+1 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO N=1,NB IRBILS(ITAB(N),NBILAS) = 1 ENDDO C C 1.12- BILAN DE FLUX VOLUMIQUES C ------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. 'BILAN FLUX VOLUMIQUES') THEN C NBILAV=NBILAV+1 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (ITAB(1).EQ.0) NB = 0 C DO N=1,NB IRBILV(ITAB(N),NBILAV) = 1 ENDDO C C ENDIF C GOTO 10 C 999 CONTINUE C C 2- IMPRESSION POUR VERIFICATIONS C ================================ C IF (NBLBLA.GE.2) THEN C NB = 0 DO 309 N=1,NRFMAX IF (IREFFC(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 309 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2010) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 311 N=1,NRFMAX IF (IREFSC(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 311 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2020) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 312 N=1,NRFMAX IF (IREFSD(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 312 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2030) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 313 N=1,NRFMAX IF (IREFSF(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 313 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2040) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 314 N=1,NRFMAX IF (IREFSE(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 314 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2050) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 315 N=1,NRFMAX IF (IREFSV(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 315 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2060) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 316 N=1,NRFMAX IF (IREFRE(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 316 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2070) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 318 N=1,NRFMAX IF (IREFRI(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 318 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2081) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 319 N=1,NRFMAX IF (IREFPR(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 319 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2090) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C NB = 0 DO 320 N=1,NRFMAX IF (IREFMO(N).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF 320 CONTINUE IF (NB.NE.0) THEN WRITE(NFECRA,2100) WRITE(NFECRA,2001) (ITAB(N),N=1,NB) ENDIF C IF (NBILAS.GT.0) THEN WRITE(NFECRA,3100) DO I=1,NBILAS NB = 0 DO N=1,NRFMAX IF (IRBILS(N,I).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF ENDDO IF (NB.NE.0) THEN WRITE(NFECRA,3101) I,(ITAB(N),N=1,NB) ENDIF ENDDO ENDIF C C IF (NBILAV.GT.0) THEN WRITE(NFECRA,3200) DO I=1,NBILAV NB = 0 DO N=1,NRFMAX IF (IRBILV(N,I).NE.0) THEN NB = NB + 1 ITAB(NB) = N ENDIF ENDDO IF (NB.NE.0) THEN WRITE(NFECRA,3201) I,(ITAB(N),N=1,NB) ENDIF ENDDO ENDIF C C ENDIF C C GOTO 300 C C 3. GESTION DES ERREURS DE LECTURE C ================================= C 9999 WRITE(NFECRA,9000) CHAINE STOP C 300 CONTINUE C C-------- C FORMATS C-------- 1000 FORMAT(A200) C 1900 FORMAT(' %% ERREUR LECREF : On lit des references de noeuds', & ' periodiques alors qu''aucune',/, & 20X,'periodicite n''est declaree',/, & 20X,'(cf ''NOMBRE DE DIRECTIONS PERIODIQUES='')') 2010 FORMAT(//,80('*'),//, & ' *** LECREF : REFERENCES DES NOEUDS DU FLUIDE COUPLES') 2020 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'COUPLES') 2030 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC DIRICHLET') 2040 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC FLUX') 2050 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC COEFFICIENTS D''ECHANGE') 2060 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC FLUX VOLUMIQUE') 2070 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS DU SOLIDE ', & 'AVEC RESISTANCE DE CONTACT') 2081 FORMAT(/,' *** LECREF : REFERENCES NOEUDS OU FACES ', & 'SOLIDES AVEC RAYONNEMENT INFINI') 2090 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS SOLIDES ', & 'PERIODIQUES') 2100 FORMAT(/,' *** LECREF : REFERENCES DES NOEUDS SOLIDES ', & 'EN ROTATION') 2001 FORMAT(3X,32I3,/) 3100 FORMAT(/,' *** LECREF : Bilans surfaciques :') 3101 FORMAT( ' Bilan :',I2,' References :',99I3) 3200 FORMAT(/,' *** LECREF : Bilans volumiques :') 3201 FORMAT( ' Bilan :',I2,' References :',99I3) 9000 FORMAT(/,' %% ERREUR LECREF : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des references',/, * 20X,'Ligne concernee : ',A) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/rota3d.F0000666000175000017500000001055511524070642015253 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ROTA3D,SSI=0 SUBROUTINE ROTA3D C ***************** C C ---------------------------------------- * (AKXX,AKYY,AKZZ,TETA,PHI,AKXY,AKXZ,AKYZ) C ---------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! ! ! ! physol(n,2) = cp ! C ! ! ! ! physol(n,3) = k ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : CPHYSO C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C C.. Variables externes DOUBLE PRECISION TETA,PHI,AKXX,AKYY,AKZZ,AKXY,AKXZ,AKYZ C C.. Variables internes DOUBLE PRECISION XXK1,XXK2,XXK3 DOUBLE PRECISION ZCT,ZST,ZCP,ZSP,ZCT2,ZST2,ZCP2,ZSP2 C C*********************************************************************** C C 1- Calcul des cosinus et sinus C ============================== ZCT = COS(TETA) ZST = SIN(TETA) ZCP = COS(PHI) ZSP = SIN(PHI) ZCT2 = ZCT*ZCT ZST2 = ZST*ZST ZCP2 = ZCP*ZCP ZSP2 = ZSP*ZSP C C 2- Rotation C =========== XXK1 = AKXX*ZCT2*ZCP2 + AKYY*ZST2 + AKZZ*ZSP2*ZCT2 XXK2 = AKXX*ZST2*ZCP2 + AKYY*ZCT2 + AKZZ*ZSP2*ZST2 XXK3 = AKXX*ZSP2 + AKZZ*ZCP2 AKXY = (AKXX*ZCT*ZCP2-AKYY*ZST+AKZZ*ZSP2*ZST) * ZCT AKXZ = (AKXX - AKZZ) * ZCT*ZSP*ZCP AKYZ = (AKXX - AKZZ) * ZCP*ZSP*ZST C AKXX = XXK1 AKYY = XXK2 AKZZ = XXK3 C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/posnbr.F0000666000175000017500000001213211524070642015353 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=POSNBR,SSI=0 C SUBROUTINE POSNBR C ***************** C * ( CHAINE,IDEB,IFIN,NBB,LCH ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- DETERMINER LA POSITION (debut,fin et longeur) * C D'UN NOMBRE (entier ou reeel) DANS UNE CHAINE * C * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! CHAINE ! A ! D ! CHAINE DS LAQUELLE ON EFFECTUE LA RECHERCHE ! C ! IDEB ! E ! R ! POSITION DU DEBUT DU 1ER REEL ! C ! IFIN ! E ! R ! POSITION DE FINUDU DERNIER REEL ! C ! LCH ! E ! R ! LONGUEUR DE LA CHAINE CONTENANT LES NB REELS! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C C C********************************************************************** C C..Variables externes CHARACTER CHAINE*(*) INTEGER IDEB,IFIN,LCH,NBB C C..Variables internes CHARACTER CC INTEGER I LOGICAL LENT C C********************************************************************** C C I = 1 IDEB = 0 IFIN = 0 LCH = 0 NBB = 0 LENT = .FALSE. C C 10 CONTINUE C READ(CHAINE(I:I),1000,ERR=99,END=99) CC IF (.NOT.LENT .AND. CHAINE (I:I) .EQ. ' ' ) THEN NBB = NBB + 1 ELSEIF (.NOT.LENT .AND. CHAINE (I:I) .NE. ' ' ) THEN IDEB = I LENT = .TRUE. ELSEIF ( LENT .AND. CHAINE (I:I) .EQ. ' ' ) THEN LENT = .FALSE. IFIN = I-1 LCH = IFIN - IDEB + 1 RETURN ENDIF C I = I+1 GOTO 10 C C 99 CONTINUE IFIN = I-1 LCH = IFIN - IDEB + 1 C C-------- C FORMATS C-------- 1000 FORMAT(A1) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/lraid2.F0000666000175000017500000001140611524070642015230 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRAID2 C ***************** C C -------------------------------- *(NDIM,NPOINR,NELRAY,IREF,INOEUD) C -------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE IDEAS MS * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY,IREF(NELRAY),INOEUD(NELRAY*NDIM) C C.. Variables internes INTEGER NUM,ID,N1,N2,NBNO INTEGER I,N CHARACTER*80 CH C C*********************************************************************** C C C 0- INITIALISATIONS C ================== C REWIND (NFSGRA) C C 2- TABLE DES ELEMENTS C ===================== CALL SECIDE(NFSGRA,2412) C IF(NDIM.EQ.3) THEN DO N=1,NELRAY READ(NFSGRA,2201) NUM,ID,N1,N2,IREF(N),NBNO READ(NFSGRA,2202) (INOEUD((I-1)*NELRAY+N) ,I=1,NBNO) ENDDO ELSE DO N=1,NELRAY READ(NFSGRA,2201) NUM,ID,N1,N2,IREF(N),NBNO READ(NFSGRA,1201) CH READ(NFSGRA,2202) (INOEUD((I-1)*NELRAY+N) ,I=1,NBNO) ENDDO ENDIF C C C-------- C FORMATS C-------- C 1201 FORMAT(A80) 2201 FORMAT(6I10) 2202 FORMAT(8I10) C C END syrthes-3.4.3-dfsg1/src/s/cbary3.F0000666000175000017500000001200011524070642015225 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CBARY3,SSI=0 SUBROUTINE CBARY3 C ***************** C C -------------------------------------------------- * (XX,YY,ZZ,XA,YA,ZA,XB,YB,ZB,XC,YC,ZC,XL1,XL2,XL3) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C CALCUL DES COORDONNEES BARYCENTRIQUES D'UN POINT DANS * C UN TRIANGLE * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! XX,YY,ZZ ! R ! D ! COORDONNEES DU POINT DONT ON CHERCHE LES ! C ! ! ! ! COORD. BARYCENTRIQUES ! C ! XA,YA,ZA, ! R ! D ! COORD. DES 3 POINTS DU TRIANGLE PAR RAPPORT ! C ! XB,YB,ZB, ! R ! D ! AUXQUELS ON CHERCHE LES COORD. BARY. ! C ! XC,YC,ZC ! R ! D ! ! C !XL1,XL2,XL3! R ! R ! COORDONNEES BARYCENTRIQUES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : CORFS3 C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DOUBLE PRECISION XX,YY,ZZ,XA,YA,ZA,XB,YB,ZB,XC,YC,ZC DOUBLE PRECISION XL1,XL2,XL3,DENO DOUBLE PRECISION DETERM,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3 C C*********************************************************************** DETERM (X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3) = & X1*Y2*Z3 + X2*Y3*Z1 + Y1*Z2*X3 & - Z1*Y2*X3 - Y1*X2*Z3 - Z2*Y3*X1 C C*********************************************************************** C C DENO = DETERM (XA,YA,1.D0,XB,YB,1.D0,XC,YC,1.D0) C IF (ABS(DENO) .GT. 1.D-6) THEN C XL1 = DETERM (XX,YY,1.D0,XB,YB,1.D0,XC,YC,1.D0) XL2 = DETERM (XA,YA,1.D0,XX,YY,1.D0,XC,YC,1.D0) C ELSE C DENO = DETERM (YA,ZA,1.D0,YB,ZB,1.D0,YC,ZC,1.D0) C IF (ABS(DENO) .GT. 1.D-6) THEN XL1 = DETERM (YY,ZZ,1.D0,YB,ZB,1.D0,YC,ZC,1.D0) XL2 = DETERM (YA,ZA,1.D0,YY,ZZ,1.D0,YC,ZC,1.D0) C ELSE C DENO = DETERM (XA,ZA,1.D0,XB,ZB,1.D0,XC,ZC,1.D0) XL1 = DETERM (XX,ZZ,1.D0,XB,ZB,1.D0,XC,ZC,1.D0) XL2 = DETERM (XA,ZA,1.D0,XX,ZZ,1.D0,XC,ZC,1.D0) C ENDIF ENDIF C XL1 = XL1 / DENO XL2 = XL2 / DENO XL3 = 1.D0 - XL1 - XL2 END syrthes-3.4.3-dfsg1/src/s/mailff.F0000666000175000017500000002136411524070642015315 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE MAILFF C ***************** C C --------------------------------------------------------- *(NDIM,NPOINF,NELEBF,XYZF,NBCOUF,NELESF,NDMASF,NBRAF,NELRAF, * NREFAF,COORDF,NODEBF,NODESF,NCOUPF,COORAF,NRAPF,NODRAF, * NPOIFF,ICOLA,ITRAV, * NBFILS,NWMAIL,NWDN,NWDRN,NWDE,NWDRE, * NWNCF1,NWNRF1,NWECF1,NWERF1,NWDMA1) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 2.0 JUIL 93 COPYRIGHT EDF 1993 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C MAILLAGE FLUIDE TYPE N3S-NATUR * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NDIM ! TE ! E ! Dimension du probleme (2 pour 2D, 3 pour 3D)! C ! NBCOUF ! E ! D ! Nombre de points fluides couples ! C ! NBRAF ! E ! D ! Nombre de points fluides non couples + rayt ! C ! NPOINF ! E ! D ! Nombre de points fluide total ! C ! COORDF ! TR ! M ! Coordonnes des points fluides couples ! C ! COORAF ! TR ! M ! Coordonnes des pts fluides non couples+rayt ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! D ! ! C !/FICHCT/! ! D ! ! C !/XREFER/! ! D ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "optct.h" #include "nlofes.h" C C********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINF,NBCOUF,NBRAF INTEGER NELEBF,NELESF,NDMASF,NELRAF,NPOIFF INTEGER NODESF(NELESF,NDMASF), NODEBF(NELEBF,NDMASF) INTEGER NODRAF(NELRAF,NDMASF) INTEGER NCOUPF(NBCOUF,2),NRAPF(NBRAF,2) INTEGER NREFAF(NELEBF),ICOLA(NPOIFF),ITRAV(NPOIFF) INTEGER NBFILS,NWMAIL,NWDN,NWDRN,NWDE,NWDRE,NWDMA1 INTEGER NWNCF1,NWNRF1,NWECF1,NWERF1 DOUBLE PRECISION XYZF(NPOINF,NDIM) DOUBLE PRECISION COORDF(NBCOUF,NDIM),COORAF(NBRAF,NDIM) C C.. Variables internes INTEGER N,M,NC,NR,NE,NY,NUMREF,N1 C C********************************************************************** C IF (NWMAIL.EQ.1) THEN DO N=1,NELESF*NDMASF NODESF(N,1) = 0 ENDDO C DO N=1,NELRAF*NDMASF NODRAF(N,1) = 0 ENDDO ENDIF C DO N=1,NPOIFF ITRAV(N)=0 ENDDO C DO N=NWDN,NWDN+NWNCF1-1 NCOUPF(N,1) = 0 NCOUPF(N,2) = 0 ENDDO C DO N=NWDRN,NWDRN+NWNRF1-1 NRAPF(N,1) = 0 NRAPF(N,2) = 0 ENDDO C C 1- TABLE DES ELEMENTS FLUIDES COUPLES C ===================================== C NE = NWDE-1 NY = NWDRE-1 DO N=1,NELEBF NUMREF = NREFAF(N) IF (NUMREF.NE.0) THEN DO N1=1,NRFMAX IF (NUMREF.EQ.N1) THEN IF (IREFFC(N1).NE.0 .AND. IREFRF(N1).NE.0) THEN NE=NE+1 NY=NY+1 DO M=1,NWDMA1 ITRAV(NODEBF(N,M))=3 NODESF(NE,M) = NODEBF(N,M) NODRAF(NY,M) = NODRAF(N,M) ENDDO ELSEIF (IREFFC(N1).NE.0) THEN NE=NE+1 DO M=1,NWDMA1 ITRAV(NODEBF(N,M))=1 NODESF(NE,M) = NODEBF(N,M) ENDDO ELSEIF (IREFRF(N1).NE.0) THEN NY=NY+1 DO M=1,NWDMA1 NODRAF(NY,M) = NODEBF(N,M) ITRAV(NODEBF(N,M))=2 ENDDO ENDIF ENDIF ENDDO ENDIF ENDDO C C 2 noeuds fluides couples C ======================== NC = NWDN-1 NR = NWDRN-1 C C DO N=1,NPOIFF IF (ITRAV(N).EQ.1) THEN NC = NC + 1 COORDF(NC,1)=XYZF(ICOLA(N),1) COORDF(NC,2)=XYZF(ICOLA(N),2) IF (NDIM.EQ.3) COORDF(NC,3)=XYZF(ICOLA(N),3) NCOUPF(NC,1) = N ELSEIF (ITRAV(N).EQ.2) THEN NR = NR + 1 COORAF(NR,1)=XYZF(ICOLA(N),1) COORAF(NR,2)=XYZF(ICOLA(N),2) IF (NDIM.EQ.3) COORAF(NR,3)=XYZF(ICOLA(N),3) NRAPF(NR,1) = N ELSEIF (ITRAV(N).EQ.3) THEN NC = NC + 1 COORDF(NC,1)=XYZF(ICOLA(N),1) COORDF(NC,2)=XYZF(ICOLA(N),2) IF (NDIM.EQ.3) COORDF(NC,3)=XYZF(ICOLA(N),3) NR = NR + 1 COORAF(NR,1)=XYZF(ICOLA(N),1) COORAF(NR,2)=XYZF(ICOLA(N),2) IF (NDIM.EQ.3) COORAF(NR,3)=XYZF(ICOLA(N),3) NCOUPF(NC,1) = N NRAPF(NR,1) = N ENDIF ENDDO C C 3 numerotation locale pour les elements C ======================================== C DO N=1,NPOIFF ITRAV(N)=0 ENDDO C DO N=NWDN,NWDN+NWNCF1-1 ITRAV(NCOUPF(N,1)) = N ENDDO C DO M=1,NWDMA1 DO N=NWDE,NWDE+NWECF1-1 NODESF(N,M) = ITRAV (NODESF(N,M)) ENDDO ENDDO C DO N=1,NPOIFF ITRAV(N)=0 ENDDO C DO N=NWDRN,NWDRN+NWNRF1-1 ITRAV(NRAPF(N,1)) = N ENDDO C DO M=1,NWDMA1 DO N=NWDRE,NWDRE+NWERF1-1 NODRAF(N,M) = ITRAV (NODRAF(N,M)) ENDDO ENDDO C C 4 Controles C =========== C IF (NWMAIL.EQ.NBFILS .AND. * (NC.NE.NBCOUF .OR. NR.NE.NBRAF .OR. * NE.NE.NELESF .OR. NY.NE.NELRAF)) THEN WRITE(NFECRA,4000) NC,NBCOUF,NR,NBRAF,NE,NELESF,NY,NELRAF STOP ENDIF C C-------- C FORMATS C-------- 4000 FORMAT(/,' %% ERREUR MAILFF : lors de la lecture des coordonnees' & ,' pour le(s) fluide(s). On trouve :',/, & 20X,I6,' noeuds couples au lieu de ',I6,/, & 20X,I6,' noeuds avec rayonnement au lieu de ',I6,/, & 20X,I6,' elements couples au lieu de ',I6,/, & 20X,I6,' elements avec rayonnement au lieu de ',I6 ) C C END syrthes-3.4.3-dfsg1/src/s/lecmcl.F0000666000175000017500000006555511524070642015330 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 *********************** SUBROUTINE LECMCL (NDIM) C *********************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER syrthes.data * C Lecture des mots-cles pour les options du calcul * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! R ! ! C !/NLOFCT/! ! D ! ! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "divct.h" #include "nlofes.h" #include "nlofct.h" #include "syrth.h" #include "regul.h" C C********************************************************************** C INTEGER NDIM C INTEGER I1,I2,II1,II2,LCH LOGICAL LVERIF,ERR C CHARACTER*200 CHAINE,FORMA DOUBLE PRECISION XITER,XDT INTEGER NITER C C********************************************************************** C C 0- INITIALISATIONS C ================== C LVERIF = .TRUE. ERR = .FALSE. C C Valeurs par defaut des parametres C --------------------------------- C NDIM = 0 NCTHFS = 3 IAXISY = 0 LGEOMS = .TRUE. LGEOMF = .FALSE. LRESUF = .FALSE. LCHROF = .FALSE. LHISOL = .FALSE. LSDEPL = .FALSE. LCLEXP = .FALSE. LSTOKC = .FALSE. LECCOR = .FALSE. LCFACE = .FALSE. LCOSTA = .FALSE. LRAY = .FALSE. LTMAX = .FALSE. LREGUL = .FALSE. LCOIN = .FALSE. NITMXS = 50 NCHROS = -1 NLISTS = -1 NFREQS = 1 NAXE = 2 ISOTRO = 1 NBLBLA = 2 NDPROP = 1 NDFLUV = 1 EPSGCS = 1.D-6 NTSMAX = 0 DTAUTO = -1. DTAUTM = 1000. NDTMUL = 0 RDTTS = 0. DCORMX = 1.e6 C TITSOL = 'THERMIQUE SOLIDE SYRTHES' C C C 1- LECTURE DE LA CHAINE C ======================= C REWIND(NFCLCT) C C Boucle de lecture.... 10 CONTINUE C CHAINE = ' ' READ(NFCLCT,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) GOTO 10 C C C ======================= C 0- VARIABLES CARACTERES C ======================= C C 0.1- TITRE DU CALCUL (TITSOL) C ----------------------------- IF ( CHAINE(I1:I2).EQ. * 'TITRE POUR LE CALCUL SOLIDE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 TITSOL = ' ' TITSOL(1:LCH) = CHAINE(I1:I2) C C C 0.2- CONDITIONS AUX LIMITES PAR NOEUD OU FACE (LCFACE) C ------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'CONDITIONS LIMITES PAR NOEUD OU PAR FACE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'FACE') THEN LCFACE = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NOEUD') THEN LCFACE = .FALSE. ELSE GOTO 9999 ENDIF C C 0.4- DEFINITION DES FLUX VOLUMIQUES PAR (NDFLUV) C ------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'DEFINITION DES FLUX VOLUMIQUES PAR=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'NOEUD') THEN NDFLUV = 1 ELSEIF (CHAINE(I1:I2) .EQ. 'ELEMENT') THEN NDFLUV = 2 ELSEIF (CHAINE(I1:I2) .EQ. 'NOEUD PAR ELEMENT') THEN NDFLUV = 3 ELSE GOTO 9999 ENDIF C C 0.3- DEFINITION DES PROPRIETES PHYSIQUES PAR (NDPROP) C ------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'DEFINITION DES PROPRIETES PHYSIQUES PAR=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'NOEUD') THEN NDPROP = 1 ELSEIF (CHAINE(I1:I2) .EQ. 'ELEMENT') THEN NDPROP = 2 ELSEIF (CHAINE(I1:I2) .EQ. 'NOEUD PAR ELEMENT') THEN NDPROP = 3 ELSE GOTO 9999 ENDIF C C C ===================== C 1- VARIABLES LOGIQUES C ===================== C C 1.2- MAILLAGE FLUIDE = SOLIDE (LGEOMS) C ----------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'ECRITURE MAILLAGE SOLIDE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LGEOMS = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LGEOMS = .FALSE. ELSE GOTO 9999 ENDIF C C 1.3- ECRITURE MAILLAGE PEAU FLUIDE (LGEOMF) C ----------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'ECRITURE MAILLAGE PEAU FLUIDE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LGEOMF = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LGEOMF = .FALSE. ELSE GOTO 9999 ENDIF C C 1.4- ECRITURE RESULTATS PEAU FLUIDE (LRESUF) C ----------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'ECRITURE RESULTATS PEAU FLUIDE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LRESUF = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LRESUF = .FALSE. ELSE GOTO 9999 ENDIF C C 1.5- ECRITURE CHRONO PEAU FLUIDE (LCHROF) C --------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'ECRITURE CHRONO PEAU FLUIDE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LCHROF = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LCHROF = .FALSE. ENDIF C C 1.6- HISTORIQUE SOLIDE (LHISOL) C ------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'HISTORIQUES CONDUCTION=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LHISOL = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LHISOL = .FALSE. ELSE GOTO 9999 ENDIF C C 1.8- TRAITEMENT IMPLICITE DES TERMES D'ECHANGE (LCLEXP) C ------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'TRAITEMENT IMPLICITE DES TERMES D ECHANGE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LCLEXP = .FALSE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LCLEXP = .TRUE. ELSE GOTO 9999 ENDIF C C 1.9- SOLIDE EN TRANSLATION (LSDEPL) C ----------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'SOLIDE EN TRANSLATION=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LSDEPL = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LSDEPL = .FALSE. ELSE GOTO 9999 ENDIF C C 1.10- STOCKAGE DES CORRESPONDANTS SUR FICHIER (LSTOKC) C ------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'STOCKAGE DES CORRESPONDANTS SUR FICHIER=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LSTOKC = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LSTOKC = .FALSE. ELSE GOTO 9999 ENDIF C C 1.11- LECTURE DES CORRESPONDANTS SUR FICHIER (LECCOR) C ----------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'LECTURE DES CORRESPONDANTS SUR FICHIER=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LECCOR = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LECCOR = .FALSE. ELSE GOTO 9999 ENDIF C C 1.12- APPROCHE COQUE - SIMULATION STATIONNAIRE (LCOSTA) C ------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'APPROCHE COQUE - SIMULATION STATIONNAIRE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LCOSTA = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LCOSTA = .FALSE. ELSE GOTO 9999 ENDIF C C 1.13- PRISE EN COMPTE DU RAYONNEMENT (LRAY) C ------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'PRISE EN COMPTE DU RAYONNEMENT CONFINE=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LRAY = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LRAY = .FALSE. ELSE GOTO 9999 ENDIF C C 1.14- CHAMP DE TEMPERATURES MAXIMALES (LTMAX) C ------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'CHAMP DE TEMPERATURES MAXIMALES=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LTMAX = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LTMAX = .FALSE. ELSE GOTO 9999 ENDIF C C 1.15- ACTIVATION DU MODULE DE REGULATION (LREGUL) C ------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'ACTIVATION DU MODULE DE REGULATION=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LREGUL = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LREGUL = .FALSE. ELSE GOTO 9999 ENDIF C C 1.16- SUITE DE CALCUL (LSUISO) C ----------------------------- ELSEIF ( CHAINE(I1:I2).EQ. 'SUITE DE CALCUL=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LSUISO = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LSUISO = .FALSE. ELSE GOTO 9999 ENDIF C C 1.17- CALCUL AXISYMETRIQUE C -------------------------- ELSE IF ( CHAINE(I1:I2).EQ. * 'AXE D AXISYMETRIE (AUCUN,OX,OY)=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'AUCUN') THEN IAXISY=0 ELSEIF (CHAINE(I1:I2) .EQ. 'OX') THEN IAXISY=1 ELSEIF (CHAINE(I1:I2) .EQ. 'OY') THEN IAXISY=2 ELSE GOTO 9999 ENDIF C C ===================== C 2- VARIABLES ENTIERES C ===================== C C C 2.0- DIMENSION DU PROBLEME (NDIM) C --------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'DIMENSION DU PROBLEME=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NDIM C C 2.1- PAS DES SORTIES CHRONO SOLIDE (NCHROS) C ------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'PAS DES SORTIES CHRONO SOLIDE=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NCHROS C C 2.2- PAS DES SORTIES LISTING SOLIDE (NLISTS) C -------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'PAS DES SORTIES LISTING SOLIDE=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NLISTS C C C 2.3- NOMBRE ITERATIONS SOLVEUR SOLIDE (NITMXS) C ------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE ITERATIONS SOLVEUR SOLIDE=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NITMXS C C 2.4- FREQUENCE DU CALCUL SOLIDE (NFREQS) C ---------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'FREQUENCE DU CALCUL SOLIDE=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NFREQS C C 2.5- CONDUCTIVITE ISOTROPE, ORTHOTROPE OU ANISOTROPE (ISOTRO) C ------------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'ISOTROPIE DU MATERIAU=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) ISOTRO IF (ISOTRO.LT.1 .OR. ISOTRO.GT.3) THEN WRITE(NFECRA,2600) ERR = .TRUE. ENDIF C C 2.6- NOMBRE DE PAS DE TEMPS SOLIDE (NTSMAX) C ------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE DE PAS DE TEMPS SOLIDES=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NTSMAX C C 2.7- NOMBRE DE DIRECTIONS PERIODIQUES (NBDIPR) C ---------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE DE DIRECTIONS PERIODIQUES=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NBDIPR IF (ISOTRO.LT.0 .OR. ISOTRO.GT.3) THEN WRITE(NFECRA,2800) ERR = .TRUE. ENDIF C C C 2.8- NIVEAU DES IMPRESSIONS POUR LE SOLIDE (NBLBLA) C --------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'NIVEAU DES IMPRESSIONS POUR LE SOLIDE=') THEN C C Recherche de la position de l'entier CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NBLBLA IF(NBLBLA .GT. 3) NBLBLA=NBLBLA-1000 IF (NBLBLA.LT.0) THEN WRITE(NFECRA,2900) ERR = .TRUE. ENDIF C C C ==================== C 3- VARIABLES REELLES C ==================== C C 3.1- PRECISION POUR LE SOLVEUR SOLIDE (EPSGCS) C ------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'PRECISION POUR LE SOLVEUR SOLIDE=') THEN C C Recherche de la position du reel CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) EPSGCS C C 3.2- PAS DE TEMPS AUTOMATIQUE C ----------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'PAS DE TEMPS AUTOMATIQUE=') THEN C C Recherche de la position du reel CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) DTAUTO,DTAUTM C C 3.3- PAS DE TEMPS SOLIDE (RDTTS) C -------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'PAS DE TEMPS SOLIDE=') THEN C C Recherche de la position du reel CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) RDTTS C C 3.4- Pas de temps multiples C -------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'PAS DE TEMPS MULTIPLES=') THEN CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XITER,XDT NDTMUL=NDTMUL+1 NITER=INT(XITER) IF (NDTMUL.GT.1) THEN IF (NITER.LE.IDTMUL(NDTMUL-1)) THEN WRITE(NFECRA,3400) ERR=.TRUE. ENDIF ENDIF IDTMUL(NDTMUL)=NITER XDTMUL(NDTMUL)=XDT C C 3.5- Recherche optimisee des correspondants fluide/solide C Eloignement maxi des correspondnats (a priori) C -------------------------- ELSEIF (CHAINE(I1:I2) .EQ. * 'RECHERCHE OPTIMISEE DES CORRESPONDANTS - ELOIGNEMENT MAXI=') * THEN C Recherche de la position du reel CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) DCORMX ENDIF GOTO 10 C 999 CONTINUE C C C =================================================== C 4- GESTION DES OPTIONS PRIORITAIRES ET OBLIGATOIRES C =================================================== C C 4.1- "pas de temps solide" C -------------------------- IF (ABS(RDTTS).LT.1.D-16 .AND. NDTMUL.EQ.0) THEN WRITE(NFECRA,4000) ERR = .TRUE. ENDIF C IF (NDTMUL.GT.0) THEN IF (IDTMUL(NDTMUL).LT.NTSMAX) THEN WRITE(NFECRA,4050) ERR = .TRUE. ENDIF ENDIF C C 4.4- "lecture-ecriture des correspondants" C ----------------------------------------- C La lecture et l'ecriture ne sont pas permises simultanement IF (LSTOKC .AND. LECCOR) THEN WRITE(NFECRA,4400) LSTOKC = .FALSE. LECCOR = .FALSE. ENDIF C C 4.5- "Dimension du probeme C -------------------------- IF (NDIM.NE.2 .AND. NDIM.NE.3) THEN WRITE(NFECRA,4500) ERR = .TRUE. ENDIF C C C C STOP EN CAS D'ERREUR DE DONNEES C ------------------------------- IF (ERR) STOP C C C GOTO 500 C C ================================= C 5. GESTION DES ERREURS DE LECTURE C ================================= C 9999 WRITE(NFECRA,5000) CHAINE STOP C 500 CONTINUE C C-------- C FORMATS C-------- 1000 FORMAT(A200) 2600 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE "ISOTROPIE DU MATERIAU"',/, & ' Les valeurs possibles sont :',/, & ' 1 : materiau isotrope',/, & ' 2 : materiau orthotrope',/, & ' 3 : materiau anisotrope') C 2800 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE "NOMBRE DE DIRECTIONS', & ' PERIODIQUES"',/, & ' Les valeurs possibles sont 0,1,2 ou 3') 2900 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE "NIVEAU DES IMPRESSIONS ', & 'POUR LE SOLIDE"',/, & ' Les valeurs possibles sont 0,1,2 ou 3') 3400 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE "PAS DE TEMPS MULTIPLES"',/, & ' Les numeros d''iterations doivent etre ', & 'donnes en ordre croissant.') C 4000 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE "PAS DE TEMPS SOLIDE"',/, & ' Le pas de temps ne peut etre nul !') 4050 FORMAT(/,' %% ERREUR LECMCL : MOT-CLE ', & '"PAS DE TEMPS MULTIPLES"',/, & 13X,'Le pas de temps multiple n''est pas defini',/, & 13X,'jusqu''au nombre de pas de temps demande') 4300 FORMAT(/,' %% ERREUR LECMCL : OPTIONS INCOMPATIBLES',/, & 20X,'En modele coque sans fourniture d''un maillage exterieur',/, & 20X,'le traitement des conditions aux limites par face n''est', & ' pas autorise',/, & 20X,'Deux solutions s''offrent a vous :',/, & 20X,' --> realiser un maillage surfacique de la coque',/, & 20X,' --> traiter les conditions aux limites par noeud') C 4400 FORMAT(/,' $$ ATTENTION LECMCL : MOTS-CLES "STOCKAGE DES ', & 'CORRESPONDANTS SUR FICHIER"',/, & ' et "LECTURE DES ', & 'CORRESPONDANTS SUR FICHIER"',/, & ' Ces 2 options ne peuvent etre activees ', & 'simultanement ',/, & ' --> On recalcule les correspondants et ', & 'le calcul se poursuit de facon normale...') C 4500 FORMAT(/,' %% ERREUR SYRMCL : MOT-CLE "DIMENSION DU PROBLEME"',/, & 13X,'L''initialisation de ce mot-cle est obligatoire',/, & 13X,'Les valeurs possibles sont :',/, & 13X,' 2 : Probleme bidimensionnel',/, & 13X,' 3 : Probleme tridimensionnel') 5000 FORMAT(/,' %% ERREUR LECMCL : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des mots-cles ',/, * 20X,'Ligne concernee : ',A) c C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ccondv.F0000666000175000017500000001315511524070642015332 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCONDV C ***************** C * ( VAL,NREF,NPE,NCOND,VCOND,NBCOND,NPN,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES FLUX VOLUMIQUES * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NREF ! TE ! D ! REFERENCES DES NOEUDS OU ELTS SOLIDES ! C ! NPE ! E ! D ! NOMBRE DE NOEUDS OU ELT DU MAILLAGE SOLIDE ! C ! NCOND ! TE ! D ! NUMERO GLOB DES NOEUDS DE CONDITION "COND" ! C ! VCOND ! TR ! M ! VALEUR DE LA CONDITION "COND" ! C ! NBCOND ! E ! D ! NOMBRE DE NOEUDS DE CONDITION "COND" ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" C C********************************************************************** C C..Variables externes INTEGER NPE,NBCOND,NB,NPN INTEGER NREF(NPE),NCOND(NBCOND),IREF(NRFMAX) DOUBLE PRECISION VCOND(NBCOND,NPN),VAL C C..Variables internes INTEGER N,N1,NR,NBRE,NUMGLO,NUMREF,M C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NBCOND*NPN VCOND(N,1) = VAL NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 M=1,NPN DO 211 N=1,NBCOND C NUMGLO = NCOND(N) NUMREF = NREF(NUMGLO) C IF (NUMREF .EQ. NR) THEN VCOND(N,M) = VAL NBRE = NBRE + 1 ENDIF C 211 CONTINUE 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLA.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCONDV : Nombre de noeuds traites :',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/period.F0000666000175000017500000001214311524070642015334 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PERIOD,SSI=0 C SUBROUTINE PERIOD C ****************** C C ------------------------------------- *( X,TRAV1,NPOINS,NPRIOS,NBPRIO,NBCOPR) C ------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- Prise en compte des conditions de periodicite * C pour les termes diagonaux * C * * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! X ! TR ! M ! VECTEUR de dimension NPOINS ! C ! TRAV1 ! TR ! M ! Tableau de travail (npoins) ! C ! NPOINS ! E ! D ! Nombre de points du maillage ! C ! NPRIOS ! TE ! D ! CORRESPONDANCE noeuds periodique-num glob! C ! NBPRIO ! E ! D ! Nombre de noeuds periodique ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NBPRIO,NBCOPR INTEGER NPRIOS(NBPRIO,1+NBCOPR) C DOUBLE PRECISION X(NPOINS),TRAV1(NPOINS) C C..Variables locales INTEGER I,K,NG,NLC C C*********************************************************************** CC C 1. TRAITEMENT DES NOEUDS PERIODIQUES (partie diagonale) C ======================================================= C DO 100 I=1,NPOINS TRAV1(I) = 0.D0 100 CONTINUE C DO 110 I=1,NBPRIO NG = NPRIOS(I,1) NLC = NPRIOS(I,2) TRAV1(NG) = TRAV1(NG) + X(NPRIOS(NLC,1)) 110 CONTINUE C DO 120 K=3,NBCOPR+1 DO 130 I=1,NBPRIO NLC = NPRIOS(I,K) IF (NLC .GT. 0) THEN NG = NPRIOS(I,1) TRAV1(NG) = TRAV1(NG) + X(NPRIOS(NLC,1)) ENDIF 130 CONTINUE 120 CONTINUE C DO 140 I=1,NBPRIO NG = NPRIOS(I,1) X(NG) = X(NG) + TRAV1(NG) 140 CONTINUE C C C 2- IMPRESSIONS POUR CONTROLE C ============================ C IF ( NBLBLA.EQ.13 ) THEN WRITE(NFECRA,211) DO 200 I=1,NPOINS WRITE(NFECRA,210) I,X(I),TRAV1(I) 200 CONTINUE ENDIF C------ C FORMAT C------ 211 FORMAT(/,' *** PERIOD : AJOUT LIE A LA PERIODICITE ',/, & ' NOEUD DMAT AJOUT ') 210 FORMAT(7X,I6,5X,G10.4,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/cpusyr.F0000666000175000017500000001260611524070642015403 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE CPUSYR C ***************** C * ( TCPU ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C -------- C CALCUL DU TEMPS CPU RESTANT EN SECONDE C C Pour info, sur station C TT(1) = user time C TT(2) = system time C TT(3) = user time, children C TT(4) = system time, children C_______________________________________________________________________ C C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! TREST ! R ! R ! TEMPS CPU RESTANT ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/PORTAG/! ! D ! ! C !/TEMPAC/! ! D ! CF DETAILS DANS LE SOUS PROGRAMME LECDON ! C !________!____ !____!_____________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : TREMAIN (SUR CRAY) C OU C DGETCP (programme C) (SUR STATION) C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C C*********************************************************************** C C... Variables externes DOUBLE PRECISION TCPU C C... Variables externes LOGICAL LPAS DOUBLE PRECISION CPUDEB,S DOUBLE PRECISION TT(4) C C************************************************************************ C SAVE LPAS,CPUDEB DATA LPAS / .TRUE. / DATA CPUDEB / 0. / C C ================ C 0 - VERSION CRAY C ================ C #ifdef CRAY CALL TREMAIN ( TCPU ) C C ========================= C 1 - VERSION AUTRE MACHINE C ========================= C #else C C 1.1 INITIALISATION DU TEMPS CPU - DETERMINATION DE L'ORIGINE C ------------------------------------------------------------ C IF ( LPAS ) THEN C on utilise la fonction C Dgetcp.c C CPUDEB est en microsecondes. On ne convertit en secondes C que pour l'affichage de maniere a eviter les problemes de C precisions (si on convertit en secondes pour faire des C soustractions dans le GTCPUT ==> valeur negatives si C le temps progresse peu) C CALL DGETCP ( TT ) C CPUDEB = ( (TT (3) + TT (1) ) * 1.D+6 + * ( TT (4) + TT (2) ) * 1.D0 ) C LPAS = .FALSE. ENDIF C C 1.2 CALCUL DU TEMPS CPU RESTANT C ------------------------------- C C Appel systeme qui renvoi cpu time sous la forme hhhh:mm:ss.cc C C on utilise la fonction C dgetcp.c C temps cpu = temps renvoye par getcpu C (seconde-microsec) - temps au moment initial (CPUDEB) C CALL DGETCP ( TT ) C S = ( (TT(3)+TT(1)) * 1.D+6 + (TT(4)+TT(2)) * 1.D0 ) - CPUDEB C TCPU = S * 1.D-6 C C++ VERSION HP9000 DONNEE EN 100 IEME DE SECONDE => / 100 C TCPU = TCPU / 200. C++ C #endif C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/secgrf.F0000666000175000017500000001106611524070642015326 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SECGRF,SSI=0 SUBROUTINE SECGRF C ***************** C C ---------------------- *(NFIC,NOMSEC,LCH,IERR) C ---------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C POSITIONNEMENT SUR UNE SECTION DONNEE DU FICHIER GRAFN3S * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NOMSEC ! A ! D ! NOM DE LA SECTION RECHERCHEE ! C ! LCH ! E ! D ! LONGUEUR DE LA CHAINE RECHERCHEE ! C ! IERR ! E ! R ! INDICATEUR D'ERREUR ! C ! IERR ! E ! R ! (<>0 ==> section non trouvee ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECGR1,LECGR2 C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C..Variables externes INTEGER LCH,IERR,NFIC CHARACTER*(*) NOMSEC C C..Variables internes CHARACTER*80 CH C C*********************************************************************** C C C 0- INITIALISATIONS C ================== C REWIND (NFIC) C C 1- RECHERCHE DE LA RUBRIQUE C =========================== C 10 READ(NFIC,1000,ERR=99,END=99) CH IF (CH(1:LCH) .NE. NOMSEC) GOTO 10 C C 2- LECTURE DU COMMENTAIRE QUI SUIT C ================================== READ(NFIC,1000,ERR=99,END=99) CH RETURN C C 2- ERREURS C ========== C 99 CONTINUE IERR = 1 C C C-------- C FORMATS C-------- C 1000 FORMAT(A80) C C END syrthes-3.4.3-dfsg1/src/s/evadif.F0000666000175000017500000001426411524070642015316 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE EVADIF C ***************** C C -------------------------------------------------------------- *(NODEBF,NELEBF,NDMASF,NREFF,NPOINF,NBCOUF,NBRAF,NELESF,NELRAF) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C EVALUATION DES DIMENSIONS DES TABLEAUX NECESSAIRES * C POUR LE FLUIDE * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NODEBF ! TE ! D ! CONNECTIVITE DE MAILLAGE DE BORD FLUIDE ! C ! NELEBF ! E ! D ! NBRE D'ELEMENT DE BORD FLUIDE ! C ! NELESF ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF COUPLE FLUIDE ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS FLUIDES SURF ! C ! NREFF ! TE ! D ! REFERENCES DES NOEUDS FLUIDES ! C ! NPOINF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE FLUIDE VOL ! C ! NBCOUF ! E ! R ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "optct.h" C C********************************************************************** C C.. Variables externes INTEGER NELEBF,NELESF,NDMASF,NPOINF,NBCOUF INTEGER NELRAF,NBRAF INTEGER NODEBF(NELEBF,NDMASF),NREFF(NPOINF) C C C.. Variables internes LOGICAL LCOU,LRAF INTEGER I,M,N1,NUMREF C C********************************************************************** C C 1 Nombre de noeuds fluides couples C ----------------------------------- NBCOUF = 0 NBRAF = 0 C C DO 110 I=1,NPOINF C NUMREF = NREFF(I) C IF (NUMREF.NE.0) THEN C DO 111 N1=1,NRFMAX IF (IREFFC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBCOUF = NBCOUF + 1 ENDIF IF (IREFRF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBRAF = NBRAF + 1 ENDIF 111 CONTINUE C ENDIF C 110 CONTINUE C C 2 Nombre d'elements fluides couples C ------------------------------------- C NELESF = 0 NELRAF = 0 C DO 220 I=1,NELEBF C LCOU = .TRUE. LRAF = .TRUE. C DO 223 M=1,NDMASF IF ( IREFFC(NREFF(NODEBF(I,M))).EQ.0 ) LCOU = .FALSE. IF ( IREFRF(NREFF(NODEBF(I,M))).EQ.0 ) LRAF = .FALSE. 223 CONTINUE C IF (LCOU) NELESF = NELESF + 1 IF (LRAF) NELRAF = NELRAF + 1 C 220 CONTINUE C C C C 3- IMPRESSIONS C ============== C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,3000) NBCOUF,NELESF,NBRAF,NELRAF ENDIF C C C-------- C FORMATS C-------- C C 3000 FORMAT(/,' *** EVADIF : CARACTERISTIQUES DU MAILLAGE ', & 'FLUIDE : ',/, & ' NOMBRE DE ...',/, & 15X,'- nombre de noeuds couples avec le solide ',I9,/, & 15X,'- d''elements couples avec le solide ',I9,/, & 15X,'- nombre de noeuds avec rayonnement ',I9,/, & 15X,'- d''elements avec rayonnement ',I9) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/nvecto.F0000666000175000017500000003204311524070642015351 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=NVECTO,SSI=0 SUBROUTINE NVECTO C ***************** C C ----------------------------------------- * (NDMATS,NELEMS,NODES,NREFAC,NBFACE,NREFE) C ----------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C RENUMEROTATION DE LA TABLE DES ELEMENTS EN VUE * C DE FORCER LA VECTORISATION DANS LES BOUCLES * C D'ASSEMBLAGE. * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NODES ! TE ! M ! CONNECTIVITE DU MAILLAGE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "nlofes.h" #include "optct.h" C C*********************************************************************** C INTEGER ILVECM PARAMETER (ILVECM=1024) C C.. Variables externes INTEGER NELEMS,NDMATS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE),NREFE(NELEMS) C C.. Variables internes INTEGER N,I,J,M,ITAB(10,ILVECM),ILVEC,IR INTEGER NRES,NEL,IECHE,NB,NBBLOC,NROT,NGOTO LOGICAL LOK,LFINI,LBIS,LRATE C INTEGER INOK,INOKR,INOKG,IRESOK DOUBLE PRECISION TVEC1,TVEC2 C*********************************************************************** C C 0- INITIALISATIONS C ================== C CALL CPUSYR(TVEC1) ILVEC=1024 1111 CONTINUE NBBLOC = NELEMS / ILVEC IF (NBBLOC .LE. 5) THEN ILVEC=128 NBBLOC = NELEMS / ILVEC IF (NBBLOC .EQ. 0) THEN LRATE=.TRUE. GOTO 4999 ENDIF ENDIF C LFINI = .TRUE. LRATE = .FALSE. NGOTO = 0 IRESOK = 1 C WRITE(NFECRA,1000) C C C Statistique sur le maillage initial C ----------------------------------- INOKG =0 DO NB = 1,NBBLOC C INOK = 0 DO J=1,NDMATS DO I=1,ILVEC ITAB(J,I) = 0 ENDDO ENDDO C Traitement du bloc C ----------------------------------- DO N=1,ILVEC C NEL = (NB-1)*ILVEC + N NROT = 0 C DO I=1,NDMATS ITAB(I,N) = NODES(NEL,I) ENDDO C C L'element est-il compatible avec les precedents ? C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ DO I=1,NDMATS DO M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) INOK = INOK +1 ENDDO ENDDO ENDDO IF(NBLBLA.GE.8) THEN PRINT*,' nvecto : verif initiale bloc : ',NB,' pb = ',INOK ENDIF IF (INOK .GE.1) INOKG = INOKG+1 ENDDO C C Statistique sur le residu C -------------------------- NRES = NELEMS - (NBBLOC*ILVEC) INOKR = 0 DO N=1,NRES C NEL = NBBLOC*ILVEC + N C DO I=1,NDMATS ITAB(I,N) = NODES(NEL,I) ENDDO C DO I=1,NDMATS DO M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) INOKR = INOKR+1 ENDDO ENDDO ENDDO IF(NBLBLA.GE.8) THEN PRINT*,' nvecto : verif initiale residu : pb = ',INOKR ENDIF IF (INOKG.EQ.0 .AND. INOKR.EQ.0) THEN IVECTO = ILVEC WRITE(NFECRA,1100) ILVEC CALL CPUSYR(TVEC2) TVEC2=TVEC2-TVEC1 WRITE(NFECRA,5017) TVEC2 RETURN ELSE IF(INOKG.EQ.0 .AND. INOKR.NE.0) THEN IVECTO = -ILVEC WRITE(NFECRA,1101) -ILVEC WRITE(NFECRA,1102) NRES,INOKR CALL CPUSYR(TVEC2) TVEC2=TVEC2-TVEC1 WRITE(NFECRA,5017) TVEC2 RETURN ENDIF C C C 1- MELANGE DE LA TABLE DES ELEMENTS C =================================== C DO 100 N=1,NELEMS/2,2 CALL PERMUT(N,NELEMS-N+1,NODES,NELEMS,NDMATS) IF (LCFACE) CALL PERMUT(N,NELEMS-N+1,NREFAC,NELEMS,NBFACE) IR=NREFE(N) NREFE(N)=NREFE(NELEMS-N+1) NREFE(NELEMS-N+1)=IR 100 CONTINUE C C C 2- TRI DES ELEMENTS C =================== C 1 CONTINUE C NGOTO = NGOTO + 1 C IF (NBLBLA.GE.3) WRITE(NFECRA,2000) NGOTO C C C 2.0 Pour les nbbloc vecteurs independants a creer C ------------------------------------------------- DO 200 NB = 1,NBBLOC C DO J=1,NDMATS DO I=1,ILVEC ITAB(J,I) = 0 ENDDO ENDDO C C IECHE = NB * ILVEC C C C 2.1 Traitement du bloc C ---------------------- DO 210 N=1,ILVEC C NEL = (NB-1)*ILVEC + N NROT = 0 C LBIS = .FALSE. C 2119 CONTINUE C DO 211 I=1,NDMATS ITAB(I,N) = NODES(NEL,I) 211 CONTINUE C C 2.1.1 L'element est-il compatible avec les precedents ? C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ LOK = .TRUE. DO 212 I=1,NDMATS DO 213 M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) LOK = .FALSE. 213 CONTINUE 212 CONTINUE C C C 2.1.2 Traitement d'un element incompatible C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (.NOT. LOK) THEN C IF (IECHE.LT.NELEMS) THEN IECHE = IECHE + 1 ELSEIF (LBIS) THEN LRATE = .TRUE. GOTO 4999 ELSE IECHE = 1 LBIS = .TRUE. LFINI = .FALSE. ENDIF CALL PERMUT(NEL,IECHE,NODES,NELEMS,NDMATS) IF (LCFACE) CALL PERMUT(NEL,IECHE,NREFAC,NELEMS,NBFACE) IR=NREFE(NEL) NREFE(NEL)=NREFE(IECHE) NREFE(IECHE)=IR C GOTO 2119 C ENDIF C 210 CONTINUE C 200 CONTINUE C C C 3- ELEMENTS RESIDUELS DU DERNIER BLOC INCOMPLET C =============================================== C NRES = NELEMS - (NBBLOC*ILVEC) C DO 300 N=1,NRES C LBIS = .FALSE. NROT = 0 C NEL = NBBLOC*ILVEC + N 3119 CONTINUE C DO I=1,NDMATS ITAB(I,N) = NODES(NEL,I) ENDDO C C 3.1.1 L'element est-il compatible avec les precedents ? C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ LOK = .TRUE. DO 311 I=1,NDMATS DO 312 M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) LOK = .FALSE. 312 CONTINUE 311 CONTINUE C C 3.1.2 L'element est incompatible C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (.NOT. LOK .AND. NGOTO.LE.5) THEN IF (IECHE.LT.NELEMS) THEN IECHE = IECHE + 1 ELSEIF (LBIS) THEN LRATE = .TRUE. GOTO 4999 ELSE IECHE = 1 LBIS = .TRUE. LFINI = .FALSE. ENDIF CALL PERMUT(NEL,IECHE,NODES,NELEMS,NDMATS) IF (LCFACE) CALL PERMUT(NEL,IECHE,NREFAC,NELEMS,NBFACE) IR=NREFE(NEL) NREFE(NEL)=NREFE(IECHE) NREFE(IECHE)=IR GOTO 3119 ELSEIF (.NOT. LOK) THEN IRESOK=0 GOTO 301 ENDIF C 300 CONTINUE C 301 CONTINUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(NBLBLA.GE.9) THEN C Statistique sur le maillage iteration NGOTO C ----------------------------------- DO NB = 1,NBBLOC C INOK = 0 DO J=1,NDMATS DO I=1,ILVEC ITAB(J,I) = 0 ENDDO ENDDO C Traitement du bloc C ----------------------------------- DO N=1,ILVEC C NEL = (NB-1)*ILVEC + N NROT = 0 C DO I=1,NDMATS ITAB(I,N) = NODES(NEL,I) ENDDO C C L'element est-il compatible avec les precedents ? C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ DO I=1,NDMATS DO M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) INOK = INOK +1 ENDDO ENDDO ENDDO PRINT*,' verif iter',NGOTO,' bloc : ',NB,' pb = ',INOK ENDDO C C Statistique sur le residu C -------------------------- NRES = NELEMS - (NBBLOC*ILVEC) INOKR = 0 DO N=1,NRES C NEL = NBBLOC*ILVEC + N C DO I=1,NDMATS ITAB(I,N) = NODES(NEL,I) ENDDO C DO I=1,NDMATS DO M=1,N-1 IF (ITAB(I,M).EQ.ITAB(I,N)) INOKR = INOKR+1 ENDDO ENDDO ENDDO PRINT*,' verif iter',NGOTO,' residu : pb = ',INOKR ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 4- ON BOUCLE SI CE N'EST PAS BON C ================================ C IF (.NOT. LFINI .AND. NGOTO.LE.10) THEN LFINI = .TRUE. GOTO 1 ELSEIF (.NOT. LFINI .AND. NGOTO.GT.10) THEN LRATE = .TRUE. ENDIF C C 4999 CONTINUE C IF (LRATE .AND. ILVEC.EQ.1024) THEN ILVEC=128 GOTO 1111 ENDIF C CALL CPUSYR(TVEC2) TVEC2=TVEC2-TVEC1 WRITE(NFECRA,5017) TVEC2 C 5- IMPRESSIONS C ============== IF (LRATE) THEN WRITE(NFECRA,5100) IVECTO = 0 ELSE IF (IRESOK.EQ.0) THEN WRITE(NFECRA,5200) NGOTO,-ILVEC IVECTO = -ILVEC ELSE WRITE(NFECRA,5200) NGOTO,ILVEC IVECTO = ILVEC ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(/,' *** NVECTO : RENUMEROTATION DES ELEMENTS POUR', & ' LA VECTORISATION') 1100 FORMAT(' *** NVECTO : Maillage initial vectorisable : & taille du vecteur = ',I6) 1101 FORMAT(' *** NVECTO : Maillage initial partiellement & vectorisable : taille du vecteur = ',I6) 1102 FORMAT(' *** NVECTO : Traitement scalaire des ',I4,' derniers & elements. Nombre de conflis detectes : ',I7) 2000 FORMAT(' - iteration : ',I3) 5017 FORMAT(' *** NVECTO : temps CPU necessaire :',E15.5,' s') 5100 FORMAT(14X,'L''algorithme de renumerotation n''a pas converge',/, & 14X,' --> l''assemblage sera scalaire') 5200 FORMAT(14X,'Convergence de l''algorithme de renumerotation en ',I3 & ,' iteration(s)',/, & 14X,' --> vectorisation de l''assemblage des vecteurs ', & 'et matrices sur des vecteurs de ',I5) C END syrthes-3.4.3-dfsg1/src/s/mobmx2.F0000666000175000017500000001343611524070642015264 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBMX2,SSI=0 SUBROUTINE MOBMX2 C ***************** C C ----------------------------------------- * (NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, * NODES,NREFS,NREFAC,COORDS) C ----------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C SOLIDES EN TRANSLATION : GENERATION DU SECOND MAILLAGE TRANSLATE * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! Dimension du probleme ! C ! NDIELE ! E ! D ! Dimension des elements triangles ou tetra) ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! NELEMS ! E ! D ! Nombre d'elements du maillage solide ! C ! NDMATS ! E ! D ! Nombre de noeuds par element volumique ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NODES ! TE ! M ! Connectivite maillage volumique solide ! C ! NREFS ! TE ! M ! Reference des noeuds du maillage vol. solide | C ! NREFAC ! TE ! M ! Reference des faces | C ! COORDS ! TR ! M ! Coordonnees des noeuds | C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "mobil.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NPOINS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS),NREFAC(NELEMS,NBFACE) DOUBLE PRECISION COORDS(NPOINS,NDIM) C C.. Variables internes LOGICAL LVERIF INTEGER N,I,J C*********************************************************************** C C C 0- INITIALISATIONS C ================== C LVERIF = .FALSE. C C 1- DUPLICATION DES COORDONNEES C ------------------------------ C DO 100 N=1,NBNMA1 COORDS(NBNMA1+N,1) = COORDS(N,1) COORDS(NBNMA1+N,2) = COORDS(N,2) 100 CONTINUE C IF (NDIM.EQ.3) THEN DO 110 N=1,NBNMA1 COORDS(NBNMA1+N,3) = COORDS(N,3) 110 CONTINUE ENDIF C C C 2- DUPLICATION DES REFERENCES DES NOEUDS C ---------------------------------------- DO 200 N=1,NBNMA1 NREFS(NBNMA1+N) = NREFS(N) 200 CONTINUE C C C 3- DUPLICATION DES ELEMENTS C --------------------------- C DO 300 I=1,NDMATS DO 310 N=1,NBEMA1 NODES(NBEMA1+N,I) = NODES(N,I) + NBNMA1 310 CONTINUE 300 CONTINUE C C 4- DUPLICATION DES REFERENCES DES FACES C --------------------------------------- C IF (LCFACE) THEN C DO 400 J=1,NBFACE DO 410 I=1,NBEMA1 NREFAC(NBEMA1+I,J) = NREFAC(I,J) 410 CONTINUE 400 CONTINUE C ENDIF C END syrthes-3.4.3-dfsg1/src/s/mobres.F0000666000175000017500000001556511524070642015354 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBRES,SSI=0 C SUBROUTINE MOBRES C ***************** C C ------------------------------------------------------------- *(NPOINS,NBRESS,NRESCS,VRESCS,NREFS, * NODERC,NFRESC,VFRESC,NELERC,NDMASS,NREFAL,NELEUS,ITRAV1) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- AFFECTATION RESISTANCES DE CONTACT AUX 2 BOUTS * C DES 2 SOLIDES EN TRANSLATION * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBRESS ! E ! D ! NB DE NOEUDS SOLIDES AVEC RES DE CONTACT ! C ! NRESCS ! E ! D ! NOEUDS AVEC RESISTANCE DE CONTACT ! C ! VRESCS ! TR ! M ! CL SUR LES NOEUDS SOLIDES RES DE CONTACT ! C ! NREFS ! TE ! D ! REFERENCES NOEUDS SOLIDES ! C ! NODERC ! TE ! D ! TABLE DES ELEMENTS SURF AVEC REST DE CONT! C ! NFRESC ! TE ! D ! NUM DES FACES REST DE CONT DANS NODEUS ! C ! VFRESC ! TR ! M ! RESISTANCES CONTACT SUR LES FACES ! C ! NELERC ! E ! D ! NOMBRE D'ELETS AVEC RESTANCE DE CONTACT ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS AVEC RESIST ! C ! NREFAL ! TE ! D ! REFERENCES DES FACES ! C ! NELEUS ! E ! D ! NOMBRE D'ELEMENTS SURF DE TYPE FLUX ! C ! ITRAV1 ! TE ! A ! TABLEAU DE TRAVAIL ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C*********************************************************************** C IMPLICIT NONE C C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "mobil.h" #include "xrefer.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NBRESS,NRESCS(NBRESS,2),NREFS(NPOINS) DOUBLE PRECISION VRESCS(NBRESS,2) INTEGER NELERC,NDMASS INTEGER NODERC(NELERC,NDMASS) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) INTEGER NELEUS,NREFAL(NELEUS),ITRAV1(NPOINS),NFRESC(NELERC) C C..Variables internes INTEGER N,N1,NUMREF,M,NG,NL,NGC,NLC LOGICAL LBOUT C C*********************************************************************** C C 1- CAS DES CONDITIONS AUX LIMITES PAR NOEUD C =========================================== C IF (.NOT.LCFACE) THEN C DO 100 N=1,NBRESS C IF (NRESCS(N,2).EQ.-1) THEN VRESCS(N,1) = 0. VRESCS(N,2) = 0. C ELSE C LBOUT = .FALSE. NUMREF = NREFS(NRESCS(N,1)) C IF (NUMREF.NE.0) THEN DO 311 N1=1,NRFMAX IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN LBOUT = .TRUE. ENDIF 311 CONTINUE ENDIF C IF (LBOUT) THEN VRESCS(N,2) = 65000. ENDIF ENDIF C 100 CONTINUE C C 2- CAS DES CONDITIONS AUX LIMITES PAR FACE C ========================================== C ELSE C C 2.1- Inversion de la numerotation locale de NRESCS C --------------------------------------------------- C DO 210 N=1,NPOINS ITRAV1(N) = 0 210 CONTINUE C DO 211 N=1,NBRESS ITRAV1(NRESCS(N,1)) = N 211 CONTINUE C C C 2.2- Boucle sur les faces avec resistance C ----------------------------------------- DO 220 N=1,NELERC C NUMREF = NREFAL(NFRESC(N)) C LBOUT = .FALSE. C IF (NUMREF.NE.0) THEN DO 221 N1=1,NRFMAX IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN LBOUT = .TRUE. ENDIF 221 CONTINUE ENDIF C C C IF (LBOUT) THEN C DO 222 M=1,NDMASS NG = NODERC(N,M) NL = ITRAV1(NG) NLC = NRESCS(NL,2) NGC = NRESCS(NLC,1) C IF (NLC.EQ.-1) THEN VFRESC(N,M,1) = 0. VFRESC(N,M,2) = 0. ELSE VFRESC(N,M,2) = 65000. ENDIF 222 CONTINUE C ENDIF C C 220 CONTINUE C C ENDIF C RETURN END syrthes-3.4.3-dfsg1/src/s/icondu.F0000666000175000017500000002414611524070642015341 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE ICONDU C ***************** C * (VV,NVV,NDIM,NPE,NREF,IREF,NB,NPOUE,NPPEL,NBPHYS,PHYSOL) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- INITIALISATION DE LA CONDUCTIVITE DANS LE CAS * C OU ELLE EST ANISOTROPE * C * C L'utilisateur donne la transformation du repere * C d'origine vers le repere propre du solide (translation * C + rotation) et les valeurs de la conductivite dans * C chacune des directions du repere propre du solide * C (Kxx,Kyy,Kzz) * C On transforme alors ces donnees dans le repere d'origine * C et on obtient une matrice de conductivite (symetrique) * C * C en 2D : * C ( K11 K12 ) ( 3 5 ) * C ( K22 ) -- dans PHYSOL --> ( 4 ) * C * C en 3D : * C ( K11 K12 K13 ) ( 3 6 7 ) * C ( K22 K23 ) -- dans PHYSOL --> ( 4 8 ) * C ( K33 ) ( 5 ) * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VV ! TR ! D ! DONNEES DE LA TRANSFORMATION GEOMETRIQUE ! C ! ! ! ! ET DE LA CONDUCTIVITE DANS LE REPERE PROPRE ! C ! NVV ! E ! D ! TAILLE DU TABLEAU VV (IE : NBRE DE DONNEES) ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS SOLIDES ! C ! IREF ! TE ! D ! REFERENCES IMPLIQUEES ! C ! NB ! E ! D ! NOMBRE DE REFERENCES IMPLIQUEES ! C ! NBPHYS ! E ! D ! NOMBRE DE PROPRIETES PHYSIQUES DU SOLIDE ! C ! PHYSOL ! TR ! M ! PROPRIETES PHYSIQUES DU SOLIDE ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !/XREFER/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" C C********************************************************************** C C..Variables externes INTEGER NVV,NDIM,NPE,NBPHYS,NB,NPOUE,NPPEL INTEGER IREF(NRFMAX),NREF(NPE) DOUBLE PRECISION VV(NVV),PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes LOGICAL LVERIF INTEGER N,NR,N1,NBRE,M DOUBLE PRECISION PI,XK,YK,ZK,RX,RY,RZ,CRX,SRX,CRY,SRY,CRZ,SRZ DOUBLE PRECISION R(3,3),RM1(3,3),TR(3,3) C C********************************************************************** C C 0- Initialisations C ================== LVERIF = .FALSE. C PI = 3.141592654 C RX = VV(4) * PI / 180. RY = VV(5) * PI / 180. RZ = VV(6) * PI / 180. C CRX = COS(RX) SRX = SIN(RX) CRY = COS(RY) SRY = SIN(RY) CRZ = COS(RZ) SRZ = SIN(RZ) C XK = VV(1) YK = VV(2) ZK = VV(3) C C R(1,1) = CRZ*CRY R(1,3) = SRZ*SRX-CRZ*SRY*CRX R(3,1) = SRY R(1,2) = -SRZ*CRX-CRZ*SRY*SRX R(2,3) = -CRZ*SRX-SRZ*SRY*CRX R(3,2) = CRY*SRX R(3,3) = CRY*CRX R(2,1) = SRZ*CRY R(2,2) = CRZ*CRX-SRZ*SRY*SRX C C RM1(1,1) = CRZ*CRY/(CRZ**2*CRY**2+SRZ**2*CRY**2+SRZ**2*SRY**2+CRZ* &*2*SRY**2) RM1(1,3) = SRY/(CRY**2+SRY**2) RM1(3,1) = -(-SRZ*CRY**2*SRX+CRZ*SRY*CRX-SRZ*SRY**2*SRX)/(CRZ**2*C &RY**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY* &*2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+SRZ**2*SRX**2* &SRY**2+CRZ**2*SRY**2*CRX**2) RM1(1,2) = SRZ*CRY/(CRZ**2*CRY**2+SRZ**2*CRY**2+SRZ**2*SRY**2+CRZ* &*2*SRY**2) RM1(2,3) = CRY*SRX/(CRY**2*SRX**2+CRY**2*CRX**2+SRY**2*SRX**2+SRY* &*2*CRX**2) RM1(3,2) = -(CRZ*CRY**2*SRX+SRZ*SRY*CRX+CRZ*SRY**2*SRX)/(CRZ**2*CR &Y**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY** &2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+SRZ**2*SRX**2*S &RY**2+CRZ**2*SRY**2*CRX**2) RM1(3,3) = CRY*CRX/(CRY**2*SRX**2+CRY**2*CRX**2+SRY**2*SRX**2+SRY* &*2*CRX**2) RM1(2,1) = -(SRZ*CRY**2*CRX+CRZ*SRY*SRX+SRZ*SRY**2*CRX)/(CRZ**2*CR &Y**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY** &2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+SRZ**2*SRX**2*S &RY**2+CRZ**2*SRY**2*CRX**2) RM1(2,2) = (CRZ*CRY**2*CRX-SRZ*SRY*SRX+CRZ*SRY**2*CRX)/(CRZ**2*CRY &**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY**2 &*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+SRZ**2*SRX**2*SR &Y**2+CRZ**2*SRY**2*CRX**2) C C C TR(1,1) = R(1,1)*XK*RM1(1,1)+R(1,2)*YK*RM1(2,1)+R(1,3)*ZK*RM1(3,1) TR(1,2) = R(1,1)*XK*RM1(1,2)+R(1,2)*YK*RM1(2,2)+R(1,3)*ZK*RM1(3,2) TR(1,3) = R(1,1)*XK*RM1(1,3)+R(1,2)*YK*RM1(2,3)+R(1,3)*ZK*RM1(3,3) TR(2,2) = R(2,1)*XK*RM1(1,2)+R(2,2)*YK*RM1(2,2)+R(2,3)*ZK*RM1(3,2) TR(2,3) = R(2,1)*XK*RM1(1,3)+R(2,2)*YK*RM1(2,3)+R(2,3)*ZK*RM1(3,3) TR(3,3) = R(3,1)*XK*RM1(1,3)+R(3,2)*YK*RM1(2,3)+R(3,3)*ZK*RM1(3,3) C C NBRE = 0 C C IF (IREF(1) .EQ. -1 ) THEN C IF (NDIM.EQ.2) THEN DO 510 M=1,NPPEL DO 511 N=1,NPOUE PHYSOL(N,M,3) = TR(1,1) PHYSOL(N,M,4) = TR(2,2) PHYSOL(N,M,5) = TR(1,2) NBRE = NBRE + 1 511 CONTINUE 510 CONTINUE ELSE DO 512 M=1,NPPEL DO 513 N=1,NPOUE PHYSOL(N,M,3) = TR(1,1) PHYSOL(N,M,4) = TR(2,2) PHYSOL(N,M,5) = TR(3,3) PHYSOL(N,M,6) = TR(1,2) PHYSOL(N,M,7) = TR(1,3) PHYSOL(N,M,8) = TR(2,3) NBRE = NBRE + 1 513 CONTINUE 512 CONTINUE ENDIF C ELSE C C DO 520 N1=1,NB C NR = IREF(N1) C IF (NDIM.EQ.2) THEN DO 521 M=1,NPPEL DO 522 N=1,NPOUE IF (NREF(N) .EQ. NR) THEN PHYSOL(N,M,3) = TR(1,1) PHYSOL(N,M,4) = TR(2,2) PHYSOL(N,M,5) = TR(1,2) NBRE = NBRE + 1 ENDIF 522 CONTINUE 521 CONTINUE C ELSE DO 523 M=1,NPPEL DO 524 N=1,NPOUE IF (NREF(N) .EQ. NR) THEN PHYSOL(N,M,3) = TR(1,1) PHYSOL(N,M,4) = TR(2,2) PHYSOL(N,M,5) = TR(3,3) PHYSOL(N,M,6) = TR(1,2) PHYSOL(N,M,7) = TR(1,3) PHYSOL(N,M,8) = TR(2,3) NBRE = NBRE + 1 ENDIF 524 CONTINUE 523 CONTINUE ENDIF C 520 CONTINUE C ENDIF C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/moblim.F0000666000175000017500000002116411524070642015334 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE MOBLIM C ***************** C C ------------------------------------------------------------- *(NDIM,NPOINS,NBCOUS,NBICOR,NCOUPS,NCBORS,VCOUPS,NREFS,COORDS, * NODESS,VFCOUS,NELESS,NDMASS) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- AFFECTATION DES CONDITIONS AUX LIMITES DANS * C LE CAS DES SOLIDES MOBILES * C On affecte une conditions a tous les noeuds * C couples qui n'ont pas de correspondant a ce moment la* C * C SOUS PROGRAMME UTILISATEUR * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBICOR ! E ! D ! NOMBRE D'INFOS POUR LES CORRESPONDANT ! C ! NCBORS ! TE ! D ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C ! VCOUPS ! TR ! R ! CL SUR LES NOEUDS SOLIDES COUPLES ! C ! NREFS ! TE ! D ! REFERENCES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "mobil.h" #include "nlofes.h" #include "syrthu.h" C C*********************************************************************** C C..Variables externes INTEGER NDIM,NPOINS,NBCOUS,NBICOR INTEGER NCOUPS(NBCOUS),NCBORS(NBCOUS,NBICOR),NREFS(NPOINS) DOUBLE PRECISION COORDS(NPOINS,NDIM),VCOUPS(NBCOUS,2) INTEGER NELESS,NDMASS INTEGER NODESS(NELESS,NDMASS) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) C C..Variables internes INTEGER N,M,NL,NLC C C*********************************************************************** C C ==================================== C INITIALISATION : NE PAS MODIFIER C ==================================== C C 1.1- Conditions aux limites par noeud C ------------------------------------- C IF (.NOT.LCFACE) THEN C DO 100 N=1,NBCOUS C Si le noeud n'a pas de correspondant IF (NCBORS(N,1).EQ.-1) THEN VCOUPS(N,1) = TMOB VCOUPS(N,2) = XLMOB ENDIF 100 CONTINUE C C 1.2- Conditions aux limites par face C ------------------------------------ C ELSE C DO 120 N=1,NELESS DO 121 M=1,NDMASS C C Numero local du noeud et de son correspondant NL = NODESS(N,M) NLC = NCBORS(NL,1) IF (NLC.EQ.-1) THEN VFCOUS(N,M,1) = TMOB VFCOUS(N,M,2) = XLMOB ENDIF C 121 CONTINUE 120 CONTINUE C C ENDIF C C C ==================================================== C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ==================================================== C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C 1- Si les conditions aux limites sont imposees sur les noeuds C ------------------------------------------------------------- C CUTI IF (.NOT. LCFACE) THEN C CUTI DO 200 N=1,NBCOUS C Si le noeud n'a pas de correspondant CUTI IF (NCBORS(N,1).EQ.-1) THEN C C Numero global du noeud CUTI NG = NCOUPS(N) C C Coordonnees du noeud CUTI X = COORDS(NG,1) CUTI Y = COORDS(NG,2) CUTI IF (NDIM.EQ.3) Z = COORDS(NG,3) C C Numero de reference du noeud CUTI NUMREF = NREFS(NG) C C --> CL : temperature exterieure CUTI VCOUPS(N,1) = TMOB C --> CL : coefficient d'echange CUTI VCOUPS(N,2) = XLMOB C CUTI ENDIF CU200 CONTINUE C CUTI ENDIF C C 3- Si les conditions aux limites sont imposees sur les faces C ------------------------------------------------------------ C CUTI IF (LCFACE) THEN C C Pour chaque facette et pour chaque noeud de la facette CUTI DO 300 N=1,NELESS CUTI DO 310 M=1,NDMASS C C Num local du noeud et de son correspondant CUTI NL = NODESS(N,M) CUTI NLC = NCBORS(NL,1) C Numero global du noeud CUTI NG = NCOUPS(NL) C C Si le noeud n'a pas de correspondant CUTI IF (NLC.EQ.-1) THEN C Coordonnees du noeud CUTI X = COORDS(NG,1) CUTI Y = COORDS(NG,2) CUTI IF (NDIM.EQ.3) Z = COORDS(NG,3) C C Numero de reference du noeud CUTI NUMREF = NREFS(NG) C C --> CL : temperature exterieure CUTI VFCOUS(N,M,1) = TMOB C --> CL : coefficient d'echange CUTI VFCOUS(N,M,2) = XLMOB CUTI ENDIF C CU310 CONTINUE CU300 CONTINUE C CUTI ENDIF C C ==================================================== C FIN C ==================================================== C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.GE.10 .AND. .NOT. LCFACE) THEN WRITE(NFECRA,4010) DO N=1,NBCOUS WRITE(NFECRA,4020) N,VCOUPS(N,1),VCOUPS(N,2) ENDDO ELSE WRITE(NFECRA,4030) DO N=1,NELESS WRITE(NFECRA,4040) N,VFCOUS(N,1,1),VFCOUS(N,1,2) ENDDO ENDIF C C------- C FORMAT C------- C 4010 FORMAT(/,' *** MOBLIM : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (vcoups final)',/, & 5X,' N solide T h') 4020 FORMAT(8X,I4,6X,2G13.7) 4030 FORMAT(/,' *** MOBLIM : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (vfcous(1) final)',/, & 5X,' N solide T h') 4040 FORMAT(5X,3X,I4,6X,G13.7,3X,G13.7) C C RETURN END syrthes-3.4.3-dfsg1/src/s/lecsi3.F0000666000175000017500000004234311524070642015241 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECSI3 C ***************** C C ----------------------------------------- * (NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, * NODES,NREFS,NREFE,NREFAC,COORDS) C ----------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS * C STRUCTURE DE DONNEE ISSUE DE SIMAIL * C * C Modifications par Y. Fournier pour prendre en compte * C les aspects binaires Linux * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NODES ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SOLIDE ! C ! NREFS ! TE ! R ! REFERENCES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFAC ! TE ! R ! REFERENCES DES FACES ! C ! COORDS ! TR ! R ! COORD DES NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /GENECT/ ! ! D ! ! C ! /PORTAG/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS),NREFE(NELEMS) INTEGER NREFAC(NELEMS,NBFACE) DOUBLE PRECISION COORDS(NPOINS,NDIM) C INTEGER I,J INTEGER L,LE,NT0,NT2,NT3,NT4,NT5,M(32) INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 INTEGER NDSR,NP,NCGE,NMAE,NDSDE,NPO,NNO,INING,NE,NN INTEGER NFAC(3), NARE(3), NSOM INTEGER NNMAE(0:20) INTEGER IMIL(6) C INTEGER NFSISY(4) C #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C DATA NFSISY /1,3,2,4/ C C C 1- INITIALISATION DES TABLEAUX D'INDICATEURS C ============================================ C DO 2 I=1,NPOINS NREFS(I) = 0 2 CONTINUE C INING = 1 C IF (NDIELE.EQ.2) THEN NFAC(1) = 0 NFAC(2) = 0 NFAC(3) = 0 ELSE NFAC(1) = 4 NFAC(2) = 0 NFAC(3) = 0 ENDIF C IF (NDIELE.EQ.2) THEN NARE(1) = 3 NARE(2) = 3 NARE(3) = 0 ELSE NARE(1) = 6 NARE(2) = 6 NARE(3) = 0 ENDIF C IF (NDIELE.EQ.2) THEN NSOM = 3 ELSE NSOM = 4 ENDIF C DO 5 I=0,20 NNMAE(I) = 1 5 CONTINUE NNMAE(0) = 0 C IF (NDIELE.EQ.2) THEN IMIL(1) = 4 IMIL(2) = 5 IMIL(3) = 6 ELSE IMIL(1) = 5 IMIL(2) = 6 IMIL(3) = 7 IMIL(4) = 8 IMIL(5) = 9 IMIL(6) = 10 ENDIF C C C C 2- LECTURE DU MAILLAGE C ====================== C #ifdef HAVE_C_IO CALL REWDBF (NFSGCT, IERROR) IF (IERROR .NE. 0) GOTO 998 #else REWIND NFSGCT #endif C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL REWDBF (NFSGCT, IERROR) IF (IERROR .NE. 0) GOTO 998 #else READ(NFSGCT) LE REWIND (NFSGCT) #endif C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, L, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGCT) L, (M(I), I=1,LE) #endif NT0 = M(2) NT2 = M(4) NT3 = M(5) NT4 = M(6) NT5 = M(7) C C C Lecture du tableau 0 C -------------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, NT0, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGCT) LE, (M(I), I=1,NT0) #endif C C Lecture du tableau 2 C -------------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, NT2, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGCT) LE,(M(I),I=1,NT2) #endif C NDSR = M(2) NP = M(22) NN = M(15) C IF (NDIELE.EQ.2) THEN NE = M(8) ELSE NE = M(10) ENDIF C #ifdef HAVE_C_IO IF (NT3.NE.0) THEN NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF ENDIF #else IF (NT3.NE.0) READ(NFSGCT) LE #endif C C lecture du tableau 4 C -------------------- C #ifdef CRAY READ(NFSGCT) LE,( (COORDS(I,J),J=1,NDIM) , I=1,NP) #else CALL LCOODP(COORDS,COORDS,NP,NDIM,NPOINS,NFSGCT) #endif C C lecture du tableau 5 C -------------------- C #ifdef HAVE_C_IO C NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 C DO I = 1, NE C CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NCGE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NMAE, IERROR) IF (IERROR .NE. 0) GOTO 998 C CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NREFE(I), & IERROR) IF (IERROR .NE. 0) GOTO 998 C CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NNO, IERROR) IF (IERROR .NE. 0) GOTO 998 DO J = 1, NDMATS CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NODES(I,J), & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, NPO, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, NPO, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 C IF (NMAE.NE.0) THEN CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, INING, & IERROR) IF (IERROR .NE. 0) GOTO 998 IF (INING.EQ.1) THEN IF ((.NOT. LCFACE)) THEN CALL READBF (NFSGCT, 4, NFAC(INING), 1, & NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 ELSE DO J = 1, NFAC(INING) CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, & NREFAC(I,NFSISY(J)), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF ENDIF IF (INING.LE.2) THEN IF (LCFACE .AND. NDIELE.EQ.2) THEN DO J = 1, NARE(INING) CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, & NREFAC(I,J), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ELSE DO J = 1, NARE(INING) CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, & NREFS(NODES(I,IMIL(J))), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF ENDIF C DO J = 1, NSOM CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, & NREFS(NODES(I,J)), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF C ENDDO C C IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF C IF (NDIELE.EQ.2 .AND. NCTHFS.EQ.3 .AND. LCFACE) THEN DO J=1,3 DO I=1,NELEMS NREFS(NODES(I,IMIL(J))) = NREFAC(I,J) ENDDO ENDDO ENDIF C #else INING=1 IF (.NOT. LCFACE) THEN C READ(NFSGCT) LE, & ( NCGE,NMAE,NREFE(I), & NNO, (NODES(I,J), J=1,NDMATS), & NPO, (M(J), J=1,NPO ) , & (INING, J=1,NNMAE(NMAE) ), & (M(J), J=1,NFAC(INING)*NNMAE(NMAE) ), & (NREFS(NODES(I,IMIL(J))), J=1,NARE(INING)*NNMAE(NMAE) ), & (NREFS(NODES(I,J)) , J=1,NSOM*NNMAE(NMAE) ) & , I=1,NE ) C ELSE C c IF (NDIELE.EQ.2 .AND. NCTHFS.EQ.2) THEN c READ(NFSGCT) LE, c & ( NCGE,NMAE, c & NREFAC(I,1), c & NNO, (NODES(I,J), J=1,NDMATS), c & NPO, (M(J), J=1,NPO ) , c & (INING, J=1,NNMAE(NMAE) ), c & (M(J), J=1,NFAC(INING)*NNMAE(NMAE) ), c & (NREFS(NODES(I,IMIL(J))), J=1,NARE(INING)*NNMAE(NMAE) ), c & (NREFS(NODES(I,J)) , J=1,NSOM*NNMAE(NMAE) ) c & , I=1,NE ) C c ELSEIF (NDIELE.EQ.2 .AND. NCTHFS.NE.2) THEN c READ(NFSGCT) LE, c & ( NCGE,NMAE,NREFE(I), c & NNO, (NODES(I,J), J=1,NDMATS), c & NPO, (M(J), J=1,NPO ) , c & (INING, J=1,NNMAE(NMAE) ), c & (M(J), J=1,NFAC(INING)*NNMAE(NMAE) ), c & (NREFAC(I,J),J=1,NARE(INING)*NNMAE(NMAE) ), c & (NREFS(NODES(I,J)) , J=1,NSOM*NNMAE(NMAE) ) c & , I=1,NE ) cC c ELSE READ(NFSGCT) LE, & ( NCGE,NMAE,NREFE(I), & NNO, (NODES(I,J), J=1,NDMATS), & NPO, (M(J), J=1,NPO ) , & (INING, J=1,NNMAE(NMAE) ), & (NREFAC(I,NFSISY(J)),J=1,NFAC(INING)*NNMAE(NMAE) ), & (NREFS(NODES(I,IMIL(J))), J=1,NARE(INING)*NNMAE(NMAE) ), & (NREFS(NODES(I,J)) , J=1,NSOM*NNMAE(NMAE) ) & , I=1,NE ) c ENDIF C IF (NDIELE.EQ.2 .AND. NCTHFS.EQ.3 .AND. LCFACE) THEN DO 20 J=1,3 DO 21 I=1,NELEMS NREFS(NODES(I,IMIL(J))) = NREFAC(I,J) 21 CONTINUE 20 CONTINUE ENDIF C ENDIF C #endif C C 3- GENERATION DES COORDONNEES DES NOEUDS MILIEUX C ================================================ C IF (NDIELE.EQ.2) THEN DO 31 I=1,NE N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) DO 30 J=1,NDIM COORDS(N4,J) = (COORDS(N1,J) + COORDS(N2,J)) * 0.5D0 COORDS(N5,J) = (COORDS(N2,J) + COORDS(N3,J)) * 0.5D0 COORDS(N6,J) = (COORDS(N3,J) + COORDS(N1,J)) * 0.5D0 30 CONTINUE 31 CONTINUE C ELSEIF (NDIELE.EQ.3) THEN DO 36 I=1,NE N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10= NODES(I,10) DO 35 J=1,NDIM COORDS(N5,J) = (COORDS(N1,J) + COORDS(N2,J)) * 0.5D0 COORDS(N6,J) = (COORDS(N2,J) + COORDS(N3,J)) * 0.5D0 COORDS(N7,J) = (COORDS(N3,J) + COORDS(N1,J)) * 0.5D0 COORDS(N8,J) = (COORDS(N1,J) + COORDS(N4,J)) * 0.5D0 COORDS(N9,J) = (COORDS(N2,J) + COORDS(N4,J)) * 0.5D0 COORDS(N10,J)= (COORDS(N3,J) + COORDS(N4,J)) * 0.5D0 35 CONTINUE 36 CONTINUE C ENDIF C C 4- IMPRESSION SUR LISTING C ========================= C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,4000) WRITE(NFECRA,4010) NDIM, NP, NN, NE, NDSR ENDIF C C C 6- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLA.GE.2) THEN C WRITE(NFECRA,5000) WRITE(NFECRA,5010) ccc DO 100 I=1,NN DO 100 I=1,10 WRITE(NFECRA,5011) I,(COORDS(I,J),J=1,NDIM) 100 CONTINUE C WRITE(NFECRA,5020) ccc DO 110 I=1,NE DO 110 I=1,10 WRITE(NFECRA,5012) I,(NODES(I,J),J=1,NDMATS) 110 CONTINUE C WRITE(NFECRA,5030) ccc DO 120 I=1,NN DO 120 I=1,10 WRITE(NFECRA,5013) I,NREFS(I) 120 CONTINUE C IF (NDPROP.GT.1) THEN WRITE(NFECRA,5031) DO 121 I=1,10 WRITE(NFECRA,5013) I,NREFE(I) 121 CONTINUE ENDIF ENDIF C RETURN C #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #endif /* HAVE_C_IO */ C C-------- C FORMATS C-------- C 4000 FORMAT(//,' *** LECSI3 : MAILLAGE ELEMENTS FINIS DU SOLIDE :') 4010 FORMAT(8X,'- Dimension du maillage : ',I10,/ & 8X,'- Nombre de noeuds sommets : ',I10,/ & 8X,'- Nombre total de noeuds : ',I10,/ & 8X,'- Nombre d''elements : ',I10,/ & 8X,'- Maximum des numeros de reference : ',I10,/) C 5000 FORMAT(/,' *** LECSI3 : Verification du maillage solide',/) 5010 FORMAT(/,14X,'Coordonnees des 10 premiers noeuds :',/) 5020 FORMAT(/,14X,'Table des 10 premiers elements :',/) 5030 FORMAT(/,14X,'References des 10 premiers noeuds :',/) 5031 FORMAT(/,14X,'References des 10 premiers elements :',/) 5011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 5012 FORMAT(14X,'N=',I2,' NOEUDS : ',10I10) 5013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LECSI3 : erreur de lecture du maillage ', * ' solide',/,' de type : ',A) #endif C END syrthes-3.4.3-dfsg1/src/s/inisf1.F0000666000175000017500000001416711524070642015253 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INISF1 C ***************** C C ------------------------------------------------------------- *(NDIM,NPOINF,NELEBF,XYZF,NBCOUF,NELESF,NDMASF,NBRAF,NELRAF, * NREFF,COORDF,NODEBF,NODESF,NCOUPF,COORAF,NRAPF,NODRAF, * NBFILS,NWMAIL,NWDN,NWDRN,NWDE,NWDRE, * NWNCF1,NWNRF1,NWECF1,NWERF1,NWDMA1) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C INITIALISATIONS POUR LA PRISE EN COMPTE DU COUPLAGE C THERMIQUE FLUIDE/SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NPOINF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE FLUIDE ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF COUPLE FLUIDE ! C ! NBRAF ! E ! D ! NOMBRE DE NOEUDS FLUIDE NON COUPLE AVEC RAYT ! C ! NELRAF ! E ! D ! NBRE D'ELTS SURF FLUIDE NON COUPLE AVEC RAYT ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS FLUIDES SURF ! C ! NREFF ! TE ! R ! REFERENCES DES NOEUDS FLUIDES ! C ! COORDF ! TR ! R ! COORDONNEES DES NOEUDS DU MAILLAGE FLUIDE ! C ! NODESF ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SURF FLUIDE ! C ! NCOUPF ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS FLUIDES COUPLES ! C ! NODRAF ! TE ! R ! CONNECTIVITE NOEUDS FLUIDE NON COUPLE + RAYT ! C ! COORAY ! TR ! R ! COORD MAILLAGE EXT RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C ********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINF,NBCOUF,NELESF,NDMASF,NELEBF INTEGER NBRAF,NELRAF INTEGER NREFF(NPOINF),NCOUPF(NBCOUF,2),NRAPF(NBRAF,2) INTEGER NODESF(NELESF,NDMASF),NODEBF(NELEBF,NDMASF) INTEGER NODRAF(NELRAF,NDMASF) INTEGER NBFILS,NWMAIL,NWDN,NWDRN,NWDE,NWDRE INTEGER NWNCF1,NWNRF1,NWECF1,NWERF1,NWDMA1 C DOUBLE PRECISION XYZF(NPOINF,NDIM) DOUBLE PRECISION COORDF(NBCOUF,NDIM) DOUBLE PRECISION COORAF(NBRAF,NDIM) C C.. Variables internes C C C 2- INITIALISATIONS GEOMETRIQUES ET PHYSIQUES C ============================================ C CALL COORFL (NDIM,NBCOUF,NBRAF,NPOINF,NREFF,XYZF, * COORDF,COORAF,NBFILS,NWMAIL,NWDN,NWDRN) C CALL LIMNUF(NCOUPF,NBCOUF,NRAPF,NBRAF,NREFF,NPOINF, * NBFILS,NWMAIL,NWDN,NWDRN,NWNCF1,NWNRF1) C C C 3- Generation du maillage surfacique fluide couple C ================================================== C IF (.NOT.LCOIN ) THEN CALL XMFLUI (NDIM,NPOINF,NBCOUF,NELEBF,NELESF,NDMASF, * NODEBF,NREFF,NODESF,NELRAF,NODRAF, * NBFILS,NWMAIL,NWDE,NWDRE,NWDMA1) C CALL NDLOCF (NELESF,NDMASF,NBCOUF,NPOINF,NODESF,NCOUPF, * NRAPF,NBRAF,NELRAF,NODRAF,NREFF, * NBFILS,NWMAIL,NWDN,NWDRN,NWDE,NWDRE, * NWNCF1,NWNRF1,NWECF1,NWERF1,NWDMA1) ENDIF C C C-------- C FORMATS C-------- C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/lrasy3.F0000666000175000017500000001651611524070642015277 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRASY3 C ***************** C C ----------------------------------------- * (NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) C ------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS * C STRUCTURE DE DONNEE ISSUE DE SYRTHES * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (3 ) ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! D ! NOMBRE D'ELTS DU MAILLAGE RAYONNEMENT ! C ! NODRAY ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE RAYONNEMENT ! C ! NRFRAY ! TE ! R ! TABLEAU DES REFERENCES ELTS MAILLAGE RAYT ! C ! COORAY ! TR ! R ! COORD DES NOEUDS DU MAILLAGE RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /MOBIL/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NPOINR,NDIM INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY) DOUBLE PRECISION COORAY(NPOINR,NDIM) C C.. Variables internes INTEGER N,I,J,N1,NBNO,IERR CHARACTER CH1*7 LOGICAL LF C C*********************************************************************** C C NBNO = NDIM C C 2- LECTURE DE LA TABLE DES NOEUDS C ================================= C C 2.1- Recherche de la rubrique contenant la table des noeuds C ----------------------------------------------------------- IERR = 0 CALL SECGRF(NFSGRA,'C$ RUBRIQUE = NOEUDS',20,IERR) IF (IERR.NE.0) THEN WRITE(NFECRA,2100) STOP ENDIF C C 2.2- Coordonnees et references C ------------------------------ DO 220 N=1,NPOINR READ(NFSGRA,2200) CH1,N1,(COORAY(N,J),J=1,NDIM) 220 CONTINUE C C C 3- TABLE DES ELEMENTS C ===================== C C 3.1- Recherche de la rubrique contenant la table des noeuds C ----------------------------------------------------------- IERR = 0 CALL SECGRF(NFSGRA,'C$ RUBRIQUE = ELEMENTS',22,IERR) IF (IERR.NE.0) THEN WRITE(NFECRA,3100) STOP ENDIF C C 3.2- Lecture des elements C ------------------------- C DO N=1,NELRAY READ(NFSGRA,3200) N1,NRFRAY(N),(NODRAY(N,I),I=1,NBNO) ENDDO C C C 5- IMPRESSION SUR LISTING C ========================= C IF (NBLBLR.GT.0) THEN WRITE(NFECRA,5000) WRITE(NFECRA,5010) NDIM,NPOINR,NELRAY ENDIF C C C 6- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLR.GE.2) THEN C WRITE(NFECRA,6000) WRITE(NFECRA,6010) DO 100 I=1,10 WRITE(NFECRA,6011) I,(COORAY(I,J),J=1,NDIM) 100 CONTINUE C WRITE(NFECRA,6020) DO 110 I=1,10 WRITE(NFECRA,6012)I,(NODRAY(I,J),J=1,NDIM) 110 CONTINUE C WRITE(NFECRA,6030) DO 120 I=1,10 WRITE(NFECRA,6013)I,NRFRAY(I) 120 CONTINUE C C ENDIF C C-------- C FORMATS C-------- C 2100 FORMAT(//,' *** LRASY2 : LE FICHIER SUITE NE CONTIENT PAS LA', & ' TABLE DES NOEUDS') 2200 FORMAT(A10,I3,1X,3(E14.7,1X)) 3100 FORMAT(//,' *** LRASY2 : LE FICHIER SUITE NE CONTIENT PAS LA', & ' TABLE DES ELEMENTS') 3200 FORMAT(I10,I3,3I10) C 5000 FORMAT(//,' *** LRASY2 : MAILLAGE ELEMENTS FINIS DU SOLIDE :') 5010 FORMAT(8X,'- Dimension du maillage : ',I6,/ & 8X,'- Nombre total de noeuds : ',I6,/ & 8X,'- Nombre d''elements : ',I6) C 6000 FORMAT(//,' *** LRASY2 : Verification du maillage rayonnement',/) 6010 FORMAT(//,3X,'Coordonnees des 10 premiers noeuds :',/) 6020 FORMAT(//,3X,'Table des 10 premiers elements :',/) 6030 FORMAT(//,3X,'References des 10 premiers noeuds :',/) 6011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 6012 FORMAT(14X,'N=',I2,' NOEUDS : ',4I6) 6013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) C END syrthes-3.4.3-dfsg1/src/s/cadtmy.F0000666000175000017500000001224411524070642015335 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE CADTMY C ***************** C * (NTSYR_,DT_,DTIMPO,NPREM,NPOINS,TMPSA,TMPS) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C SOUS-PROGRAMME PRINCIPAL DE SYRTHES C C----------------------------------------------------------------------- C ARGUMENTS C .________________.____.______________________________________________. C ! NOM !MODE! ROLE ! C !________________!____!______________________________________________! C .________________.____.______________________________________________. C COMMONS C .________________.____.______________________________________________. C ! ! ! TOUS LES COMMONS SONT PRESENTS ICI ! C !________________!____!______________________________________________! C MODE:-->ENTREE,<--RESULTAT,<-->DONNEE MODIFIEE,--TABLEAU DE TRAVAIL C----------------------------------------------------------------------- C - SOUS PROGRAMME(S) APPELANT(S) : C - SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C #include "nlofes.h" #include "optct.h" #include "divct.h" C C*********************************************************************** C INTEGER NTSYR_,NPOINS,NPREM DOUBLE PRECISION DT_,DTIMPO,TMPSA(NPOINS),TMPS(NPOINS) C INTEGER I,NUM DOUBLE PRECISION DD,DTM C C*********************************************************************** C C Pas de temps impose en dur C (soit un pas de temps qui vient du fluide, soit si on veut ecraser C le pas de temps calcule normalement) IF (DTIMPO.GT.0) THEN RDTTS=DTIMPO DT_=DTIMPO C C C Pas de temps multiples ELSEIF (NDTMUL.GT.0) THEN C IF (NTSYR_.LE.IDTMUL(1)) THEN NUM=1 ELSEIF (NTSYR_.GT.IDTMUL(NDTMUL)) THEN NUM=NDTMUL ELSE DO I=1,NDTMUL-1 IF (IDTMUL(I).LT.NTSYR_ .AND. NTSYR_.LE.IDTMUL(I+1)) NUM=I+1 ENDDO ENDIF C RDTTS=XDTMUL(NUM) DT_=XDTMUL(NUM) C C C Pas de temps automatique ELSEIF (DTAUTO.GT.0) THEN IF (NPREM.EQ.1) THEN DT_=RDTTS ELSE DTM=0 DO I=1,NPOINS DD=ABS(TMPSA(I)-TMPS(I)) IF (DD.GT.DTM) DTM=DD ENDDO DD=RDTTS*DTAUTO/DTM IF (DD.GT.DTAUTM) DD=DTAUTM RDTTS=DD DT_=DD ENDIF ENDIF C C C si le pas de temps impose est negatif, on retourne C le pas de temps calcule par SYRTHES IF (DTIMPO.LT.0) THEN DTIMPO=RDTTS ENDIF C C C-------- C FORMATS C-------- C END syrthes-3.4.3-dfsg1/src/s/ificct.F0000666000175000017500000001244711524070642015322 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE IFICCT C ***************** C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : C ---------- C C INITIALISATION DES NUMEROS LOGIQUES DES FICHIERS DE SYRTHES C ----------------------------------------------------------- C C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! ! ! ! ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFIC/ ! ! R ! TOUTES LES VARIABLES ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C----------------------------------------------------------------------- C BIBLIOTHEQUES EXTERIEURES : --- C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON (VOIR LA SIGNIFICATION COMPLETE DANS LECDON) C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C 1- ECRAN, CLAVIER C ----------------- NFECRA = 6 NFCLAV = 5 C C 2- Conditions aux limites (syrthes.data) C --------------------------------------- NFCLCT = 50 C C 3- Solide : maillage Simail C --------------------------- NFSGCT = 51 C C 4- Solide : geometrie EF, resultat, chrono, suite C ------------------------------------------------- C (format SYRTHES) NFGGCT = 52 NFGRCT = 53 NFGCCT = 54 NFGSCT = 55 C C 5- Fluide : geometrie EF, resultats, chrono noeuds couples C ---------------------------------------------------------- C (format SYRTHES) NFGFCT = 56 NFRFCT = 57 NFCFCT = 58 C C 6- Solide : historiques en temps C -------------------------------- NFHRCT = 59 C C C 7- Solide : stockage des correspondants C --------------------------------------- NFCOCT = 60 C 8- Solide : rayonnement C ----------------------- NFSGRA = 61 NFGGRA = 62 NFGRRA = 63 NFGCRA = 64 NFFFRA = 65 C C 9- Conditions aux limites pour le rayonnement (syrthes.ray) C ----------------------------------------------------------- NFCLRA = 66 C C 10- Solide/fluide - rayonnement : stockage des coorespondants C ----------------------------------------------------------- NFCORA = 67 C C 11- Historiques en temps rayonnement C ------------------------------------ NFHIRA = 68 C C 12- Suite MSTS - Resultat C ------------------------ NFSMRA = 69 NFRMRA = 70 NFEMRA = 71 C RETURN END syrthes-3.4.3-dfsg1/src/s/lecid1.F0000666000175000017500000001772111524070642015222 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 SUBROUTINE LECID1 C ***************** C C ---------------------------------------------------------------- *(NPOINS,NELEMS,NFBIDA,NDIELE) C ---------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE IDEAS * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NELEMS,NDIELE C C.. Variables internes INTEGER NDSR,ITYE,NUM,ID,N1,N2,ICOU,NBNO CHARACTER*80 CH C INTEGER NFBIDA,NUMP,NELEP C*********************************************************************** C C 0- INITIALISATIONS C ================== NFBIDA = 0 NUMP = 0 C REWIND (NFSGCT) C 1- TABLE DES NOEUDS C =================== C CALL SECIDE(NFSGCT,2411) C 12 READ(NFSGCT,1200,ERR=19,END=19) NUM,N1,N1,N1 READ(NFSGCT,1201,ERR=19,END=19) CH IF (NUM .EQ. -1) THEN GOTO 19 ELSE NPOINS = NPOINS + 1 NUMP = NUM GOTO 12 ENDIF C 19 CONTINUE IF (NPOINS .NE. NUMP) THEN WRITE(NFECRA,2016) STOP ENDIF C CALL SECIDE(NFSGCT,2411) C C 2- TABLE DES ELEMENTS C ===================== C CALL SECIDE(NFSGCT,2412) C NDSR=0 NELEMS = 0 C 22 READ(NFSGCT,4200,ERR=28,END=28) NUM,ID,N1,N2,ICOU,NBNO IF (NUM .EQ. -1) THEN GOTO 28 ELSE C IF(NDIELE.EQ.3)THEN IF (ID.EQ.118) THEN NELEMS = NELEMS + 1 NELEP = NUM ELSE IF(ID.EQ.92) THEN IF (LCFACE) THEN NFBIDA = NFBIDA + 1 ELSE WRITE(NFECRA,2023) ENDIF ELSE WRITE(NFECRA,2022) STOP ENDIF ENDIF C IF(NDIELE.EQ.2)THEN IF (ID.EQ.92) THEN NELEMS = NELEMS + 1 NELEP = NUM ELSE IF(ID.EQ.24) THEN IF (LCFACE) THEN NFBIDA = NFBIDA + 1 ELSE WRITE(NFECRA,2023) ENDIF ELSE WRITE(NFECRA,2022) STOP ENDIF ENDIF C IF (NELEMS .NE. NELEP) THEN WRITE(NFECRA,2017) STOP ENDIF C NDSR=MAX(NDSR,ICOU) READ(NFSGCT,1201,ERR=28,END=28) CH IF (NDIELE.EQ.3) THEN IF (ID.EQ.118) THEN READ(NFSGCT,1201,ERR=28,END=28) CH ENDIF ITYE = ID GOTO 22 ELSE IF (NDIELE.EQ.2) THEN IF (ID.EQ.24) THEN READ(NFSGCT,1201,ERR=28,END=28) CH ENDIF ITYE = ID GOTO 22 ENDIF ENDIF 28 CONTINUE C C 4.1.1- VERIFICATIONS DIVERSES C ----------------------------- C CIR IF (NDIMEF.EQ.2 .AND. NDIM.NE.2) THEN CIR WRITE(NFECRA,2018) CIR STOP CIR ENDIF C IF (NDSR.GT.NRFMAX) THEN WRITE(NFECRA,2020) STOP ENDIF C chp IF (ITYE.NE.92 .AND. ITYE.NE.118) THEN chp WRITE(NFECRA,2023) chp STOP chp ENDIF C CC C-------- C FORMATS C-------- C 1200 FORMAT(4I10) 1201 FORMAT(A80) C 2016 FORMAT(/,' %% ERREUR LECID1 : Il est vraisemblable que le ', & 'maillage comporte une numerotation non continue ', & 'des noeuds') 2017 FORMAT(/,' %% ERREUR LECID1 : Il est vraisemblable que le ', & 'maillage comporte une numerotation non continue ', & 'des elements') 2018 FORMAT(/,' %% ERREUR LECID1 : DIMENSION DES MAILLAGES ', & 'INCOMPATIBLES') 2020 FORMAT(/,' %% ERREUR LECID1 : NUMERO(S) DE REFERENCES > 99') 2022 FORMAT(/,' %% ERREUR LECID1 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES') 2023 FORMAT(/,' %% WARNING LECID1 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES POUR LES ', & 'OPTIONS DU CALCUL') C 4200 FORMAT(6I10) 4201 FORMAT(8I10) C END syrthes-3.4.3-dfsg1/src/s/lraid1.F0000666000175000017500000001311111524070642015222 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRAID1 C ***************** C C -------------------- *(NDIM,NPOINR,NELRAY) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE IDEAS MS * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY C C.. Variables internes INTEGER NUM,ID,N1,N2,ICOU,NBNO,NN INTEGER ITYE CHARACTER*80 CH C C*********************************************************************** C C C 0- INITIALISATIONS C ================== C REWIND (NFSGRA) NPOINR = 0 NELRAY = 0 C C C 1- TABLE DES NOEUDS C =================== C CALL SECIDE(NFSGRA,2411) C 12 READ(NFSGRA,1200,ERR=19,END=19) NUM READ(NFSGRA,1201,ERR=19,END=19) CH IF (NUM .EQ. -1) THEN GOTO 19 ELSE NPOINR = NPOINR + 1 GOTO 12 ENDIF C 19 CONTINUE C C C 2- TABLE DES ELEMENTS C ===================== C C CALL SECIDE(NFSGRA,2412) C IF (NDIM .EQ. 3) THEN 221 READ(NFSGRA,2100,ERR=28,END=28) NUM,ID,N1,N2,ICOU,NN IF (NUM .EQ. -1) THEN GOTO 28 ELSE NELRAY = NELRAY + 1 NBNO=NN READ(NFSGRA,1201,ERR=28,END=28) CH ITYE = ID GOTO 221 ENDIF ELSE 222 READ(NFSGRA,2100,ERR=28,END=28) NUM,ID,N1,N2,ICOU,NN IF (NUM .EQ. -1) THEN GOTO 28 ELSE NELRAY = NELRAY + 1 NBNO=NN READ(NFSGRA,1201,ERR=28,END=28) CH READ(NFSGRA,1201,ERR=28,END=28) CH ITYE = ID GOTO 222 ENDIF ENDIF C 28 CONTINUE C C C C Il ne faut pas de noeuds milieux IF (NDIM .NE. NBNO) THEN WRITE(NFECRA,5000) STOP ENDIF C C-------- C FORMATS C-------- C 1200 FORMAT(4I10) 1201 FORMAT(A80) 2100 FORMAT(6I10) 5000 FORMAT(' %% ERREUR LRAID1 : LE MAILLAGE POSSEDE DES' & ,' NOEUDS MILIEUX') C C END syrthes-3.4.3-dfsg1/src/s/fic_bin_f.c0000666000175000017500000005706011524070642016014 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /*============================================================================* * Traitement de fichiers binaires Fortran de maniere portable sur les * * architectures 'big endian' et 'little endian' (en prenant le cas * * 'big endian' comme reference) depuis des programmes en C ou Fortran * * utilisant la librairie C standard * * * * Bibliotheque : Code_Saturne, SYRTHES Copyright EDF 2000 * *============================================================================*/ /* Includes systeme */ #include #include #include #include #include /* Includes librairie */ #include "fortran_c.h" #include "fic_bin_f.h" /* Positionner le code d'erreur pour un fichier donne */ #define FIC_ERR_TST(ficptr) \ ((integer_t)(ferror(ficptr) == 0 ? \ (feof(ficptr) == 0 ? 0 : FIC_ERR_FIN) : ferror(ficptr))) #ifdef FORTRAN_WRAPPER /* Si le code doit etre appele depuis du Fortran */ /* Variable globale : tableau pour correspondance unite logique/pointeur */ fic_bin_t fic_bin_f_ptr_unit[100]; #endif /* FORTRAN_WRAPPER */ /*============================================================================*/ /* Prototypes de fonctions privees */ /*============================================================================*/ /*----------------------------------------------------------------------------* * Permutation des octets pour passage de "little endian" a "big endian" * *----------------------------------------------------------------------------*/ static void fic_bin_f__endswap ( void *buf, /* Tampon contenant les elements */ size_t size, /* Taille d'un element */ size_t nitems /* Nombre d'elements */ ); /*============================================================================*/ /* Fonctions publiques */ /*============================================================================*/ /*----------------------------------------------------------------------------* * Ouverture d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine openbf(unit, ierror) char(*) nomfic ! -> Nom du fichier integer lnom ! -> Longueur du nom du fichier char modfic ! -> Mode d'ouverture demande ('r', 'w', ou 'a') integer lmod ! -> Longueur du nom du mode d'ouverture integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ #if defined(CHAINE_F_VERS_C_LEN_FIN) void fsymbol(openbf, OPENBF) ( char *nomfic, /* -> Nom du fichier */ integer_t *lnom , /* -> Longueur du nom de fichier */ char *modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ integer_t *lmod , /* -> Longueur de la chaine de mode d'ouverture */ integer_t *unit , /* <- Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror, /* <- Code de retour */ integer_t lennom, /* -> Longueur du nom de fichier */ integer_t lenmod /* -> Longueur de la chaine de mode d'ouverture */ ) #elif defined(CHAINE_F_VERS_C_STR_NUL) void fsymbol(openbf, OPENBF) ( char *nomfic, /* -> Nom du fichier */ integer_t *lnom , /* -> Longueur du nom de fichier */ char *modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ integer_t *lmod , /* -> Longueur de la chaine de mode d'ouverture */ integer_t *unit , /* <- Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ) #endif { int i, lmaxch = LEN_MAX_NOM_FIC_BIN_F; char chaine[LEN_MAX_NOM_FIC_BIN_F + 1]; fic_bin_t fic; if (*lnom < lmaxch) lmaxch = *lnom; for (i = 0; i < lmaxch && (nomfic[i] != ' ' && nomfic[i] != '\0'); i++) chaine[i] = nomfic[i]; if (i < LEN_MAX_NOM_FIC_BIN_F) { chaine[i] = '\0'; *ierror = ouvre_fic_bin_f(chaine, *modfic, &fic); fic_bin_f_ptr_unit[(int)(*unit)] = fic; } else { *ierror = FIC_ERR_LEN_NOM; fic.ptr = NULL; fic.end_swap = 0; fic_bin_f_ptr_unit[(int)(*unit)] = fic; } } #endif /* FORTRAN_WRAPPER */ integer_t ouvre_fic_bin_f ( char *nomfic, /* -> Nom du fichier */ char modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ fic_bin_t *fic /* <- Pointeur sur le descripteur de fichier */ ) { int int_endian; switch (modfic) { case 'r': fic->ptr = fopen(nomfic, "rb"); break ; case 'w': fic->ptr = fopen(nomfic, "wb"); break ; case 'a': fic->ptr = fopen(nomfic, "ab"); break ; default: assert (modfic == 'r' || modfic == 'w' || modfic == 'a'); } /* Detection systeme "big-endian/litte-endian" */ int_endian = 0 ; *((char *) (&int_endian)) = '\1' ; if (int_endian == 1) fic->end_swap = 1; else fic->end_swap = 0; /* Retour selon erreur ou reussite */ if (fic->ptr != NULL) return 0; else return errno; } /*----------------------------------------------------------------------------* * Fermeture d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine closbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(closbf, CLOSBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ) { fic_bin_t fic = fic_bin_f_ptr_unit[(int)(*unit)]; assert (*unit > -1 && *unit < 100); *ierror = ferme_fic_bin_f(&fic); if (*ierror == 0) fic_bin_f_ptr_unit[(int)(*unit)] = fic; } #endif /* FORTRAN_WRAPPER */ integer_t ferme_fic_bin_f ( fic_bin_t *fic /* -> Pointeur sur le descripteur de fichier */ ) { fic->end_swap = 0; return (integer_t)fclose(fic->ptr); } /*----------------------------------------------------------------------------* * Revenir au debut d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine rewdbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(rewdbf, REWDBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ) { fic_bin_t fic = fic_bin_f_ptr_unit[(int)(*unit)]; *ierror = debut_fic_bin_f(&fic); } #endif /* FORTRAN_WRAPPER */ integer_t debut_fic_bin_f ( fic_bin_t *fic /* -> Pointeur sur le descripteur de fichier */ ) { if (fseek(fic->ptr, 0L, SEEK_SET) == 0) return 0; else return errno; } /*----------------------------------------------------------------------------* * Tester si un fichier binaire est "big endian" ou "little endian". * * On suppose que l'on connait la longueur du premier enregistrement. * * Cette fonction doit s'appeller juste apres l'ouverture du fichier, et * * configure le fichier de maniere a ce que les lectures ulterieures se * * se fassent avec ou sans permutation des octets en fonction de ce test. * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine tendbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(tendbf, OPENBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *ierror /* <- Code de retour */ ) { fic_bin_t fic = fic_bin_f_ptr_unit[(int)(*unit)]; assert (*unit > -1 && *unit < 100); *ierror = test_end_fic_bin_f(&fic, *taille); fic_bin_f_ptr_unit[(int)(*unit)]=fic; } #endif /* FORTRAN_WRAPPER */ integer_t test_end_fic_bin_f ( fic_bin_t *fic, /* -> Pointeur sur le descripteur de fichier */ int trec /* -> Taille du premier l'enregistrement */ ) { integer_4_t itmp; if (fread(&itmp, 4, 1, fic->ptr) != 1) return FIC_ERR_TST(fic->ptr); fic->end_swap = 0; if ((int)itmp != trec) { fic_bin_f__endswap(&itmp, sizeof(integer_4_t), 1); if ((int)itmp == trec) fic->end_swap = 1; else return FIC_ERR_CONTENU; } return debut_fic_bin_f(fic); } /*----------------------------------------------------------------------------* * Lecture d'un enregistrement binaire IEEE de type Fortran ; * * * * On rappelle qu'un enregistrement commence et se termine par un marqueur * * (entier code sur 4 octets indiquant la taille en octets des donnees * * contenues dans l'enregistrement), permettant certaines operations de type * * lecture a vide ou retour en arriere d'un enregistrement. * * * * On fournit en argument un parametre mode indiquant le type de lecture : * * * * mode = 0 : Lecture complete de l'enregistrement * * 1 : Lecture partielle de 'nombre' d'elements * * 2 : Saut a la fin de l'enregistement * * * * On doit donc indiquer pour les modes 1 et 2 le nombre d'elements du meme * * enregistrement deja lus lors d'appels precedents a ce sous-programme, et * * si ce nombre est non nul, le nombre total d'elements de l'enregistrement * * (calcule a la premiere lecture). * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine readbf(unit, taille, nombre, mode, nbrlus, nbrtot, elems, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer nombre ! -> Nombre d'elements a lire au cours de cet appel integer mode ! -> Mode de lecture (0, 1, ou 2) integer nbrlus ! <-> Nombre d'elements de l'enregistrement deja lus integer nbrtot ! <-> Nombre total d'elements de l'enregistrement ? elems ! <-> Tableau des elements integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(readbf, READBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *nombre, /* -> Nombre d'elements a lire au cours de cet appel */ integer_t *mode , /* -> Mode de lecture de l'enregistrement (0, 1, ou 2) */ integer_t *nbrlus, /* <-> Nombre d'elements de l'enregistrement deja lus */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems , /* <-> Tableau des elements */ integer_t *ierror /* <- Code de retour */ ) { fic_bin_t fic = fic_bin_f_ptr_unit[(int)(*unit)]; assert (*unit > -1 && *unit < 100); *ierror = lit_fic_bin_f(&fic, *taille, *nombre, *mode, nbrlus, nbrtot, elems); } #endif /* FORTRAN_WRAPPER */ integer_t lit_fic_bin_f ( fic_bin_t *fic , /* -> Pointeur sur le descripteur de fichier */ integer_t taille, /* -> Taille des elements */ integer_t nombre, /* -> Nombre d'elements a lire au cours de cet appel */ integer_t mode , /* -> Mode de lecture de l'enregistrement (0, 1, ou 2) */ integer_t *nbrlus, /* <-> Nombre d'elements de l'enregistrement deja lus */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems /* <-> Tableau des elements */ ) { integer_t nbr; integer_4_t itmp; integer_4_t *ptmp = &itmp; /* Lecture indicateur de dimension avant enregistrement */ if (mode == 0 || *nbrlus == 0) { if (fread(ptmp, 4, 1, fic->ptr) != 1) return FIC_ERR_TST(fic->ptr); if (fic->end_swap != 0) fic_bin_f__endswap(ptmp, sizeof(integer_4_t), 1); nbr = (integer_t) (*ptmp / taille); if (mode == 1) { *nbrlus = 0 ; *nbrtot = (integer_t) nbr ; } } /* Verification que la taille correspond */ if ((mode == 0 && nombre != nbr) || (mode == 1 && nombre > (*nbrtot - *nbrlus))) return FIC_ERR_SZE_ENR; /* Lecture de l'enregistrement proprement dit */ if (mode == 0 || mode == 1) { if ((integer_t)fread(elems, (size_t)taille, (size_t)nombre, fic->ptr) < nombre) return FIC_ERR_TST(fic->ptr); if (fic->end_swap != 0) fic_bin_f__endswap(elems, taille, nombre); /* Mise a jour position si mode 1 */ if (mode == 1) *nbrlus += nombre; } else if (mode == 2) { if (fseek(fic->ptr, (long)((*nbrtot - *nbrlus) * taille), SEEK_CUR) != 0) return errno; *nbrlus = *nbrtot; } /* Lecture indicateur de dimension apres enregistrement */ if (! (mode == 1 && (*nbrlus < *nbrtot))) { if (fread(ptmp, 4, 1, fic->ptr) != 1) return FIC_ERR_TST(fic->ptr); if (fic->end_swap != 0) fic_bin_f__endswap(ptmp, sizeof(integer_4_t), 1); nbr = (integer_t) (*ptmp / taille); /* Verification que la taille correspond toujours */ if ((mode == 0 && nombre != nbr) || (mode == 1 && *nbrlus != nbr)) return FIC_ERR_SZE_ENR; } return 0; } /*----------------------------------------------------------------------------* * Ecriture d'un enregistrement binaire IEEE de type Fortran ; * * * * On rappelle qu'un enregistrement commence et se termine par un marqueur * * (entier code sur 4 octets indiquant la taille en octets des donnees * * contenues dans l'enregistrement), permettant certaines operations de type * * lecture a vide ou retour en arriere d'un enregistrement. * * * * On fournit en argument un parametre mode indiquant le type d'ecriture : * * * * mode = 0 : Ecriture complete de l'enregistrement * * 1 : Ecriture partielle de 'nombre' d'elements * * * * On doit donc indiquer pour le mode 1 le nombre d'elements du meme * * enregistrement deja ecrits lors d'appels precedents a ce sous-programme, * * ainsi que le nombre total d'elements a ecrire. * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine writbf(unit, taille, nombre, mode, nbrecr, nbrtot, elems, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer nombre ! -> Nombre d'elements a ecrire au cours de cet appel integer mode ! -> Mode de lecture (0 ou 1) integer nbrecr ! <-> Nombre d'elements de l'enregistrement deja ecrits integer nbrtot ! <-> Nombre total d'elements de l'enregistrement ? elems ! <-> Tableau des elements integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(writbf, WRITBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *nombre, /* -> Nombre d'elements */ integer_t *mode , /* -> Mode d'ecriture de l'enregistrement (0 ou 1) */ integer_t *nbrecr, /* <-> Nombre d'elements de l'enregistrement deja ecrits */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems, /* -> Tableau des elements */ integer_t *ierror /* <- Code de retour */ ) { fic_bin_t fic = fic_bin_f_ptr_unit[(int)(*unit)]; assert (*unit > -1 && *unit < 100); *ierror = ecr_fic_bin_f(&fic, *taille, *nombre, *mode, nbrecr, nbrtot, elems); } #endif /* FORTRAN_WRAPPER */ integer_t ecr_fic_bin_f ( fic_bin_t *fic , /* -> Pointeur sur le descripteur de fichier */ integer_t taille, /* -> Taille des elements */ integer_t nombre, /* -> Nombre d'elements a ecrire au cours de cet appel */ integer_t mode , /* -> Mode d'ecriture de l'enregistrement (0 ou 1) */ integer_t *nbrecr, /* <-> Nombre d'elements de l'enregistrement deja ecrits */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems /* <-> Tableau des elements */ ) { integer_4_t itmp; integer_4_t *ptmp = &itmp; /* Ecriture indicateur de dimension avant enregistrement */ if (mode == 0 || *nbrecr == 0) { if (mode == 0) *ptmp = (integer_4_t)(nombre * taille); else *ptmp = (integer_4_t)((*nbrtot) * taille); if (fic->end_swap != 0) fic_bin_f__endswap(ptmp, 4, 1); if (fwrite(ptmp, 4, 1, fic->ptr) != 1) return FIC_ERR_TST(fic->ptr); if (mode == 1) *nbrecr = 0 ; } /* Ecriture de l'enregistrement proprement dit */ if (fic->end_swap != 0) fic_bin_f__endswap(elems, taille, nombre); if ((integer_t)fwrite(elems, (size_t)taille, (size_t)nombre, fic->ptr) < nombre) return FIC_ERR_TST(fic->ptr); if (fic->end_swap != 0) fic_bin_f__endswap(elems, taille, nombre); /* Mise a jour position si mode 1 */ if (mode == 1) *nbrecr += nombre; /* Ecriture indicateur de dimension apres enregistrement */ if (mode == 0 || *nbrecr == *nbrtot) { if (mode == 0) *ptmp = (integer_4_t)(nombre * taille); else *ptmp = (integer_4_t)((*nbrtot) * taille); if (fic->end_swap != 0) fic_bin_f__endswap(ptmp, 4, 1); if (fwrite(ptmp, 4, 1, fic->ptr) != 1) return FIC_ERR_TST(fic->ptr); } return 0; } /*----------------------------------------------------------------------------*/ /* Ecriture d'une chaine de caracteres correspondant a un numero d'erreur */ /*----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine strebf(chaine, lchn, ierror) char(*) chaine ! <-> Chaine de caracteres receptrice integer lchn ! -> Longueur de la chaine receptrice integer ierror ! -> Code d'erreur */ #ifdef CHAINE_F_VERS_C_LEN_FIN void fsymbol(strebf, STREBF) ( char *chaine, /* <- Chaine de caracteres receptrice */ integer_t *lchn , /* -> Longueur de la chaine receptrice */ integer_t *ierror, /* -> Code d'erreur */ integer_t lenchn /* -> Longueur de la chaine receptrice */ ) #elif defined(CHAINE_F_VERS_C_STR_NUL) void fsymbol(strebf, STREBF) ( char *chaine, /* <- Chaine de caracteres receptrice */ integer_t *lchn , /* -> Longueur de la chaine receptrice */ integer_t *ierror /* -> Code d'erreur */ ) #endif { int i; integer_t lmaxch = LEN_MAX_NOM_FIC_BIN_F; if (*lchn < lmaxch) lmaxch = *lchn; err_fic_bin_f(chaine, *ierror, lmaxch - 1); for (i = strlen(chaine); i < (int)lmaxch - 1; i++) *(chaine + i) = ' '; } #endif /* FORTRAN_WRAPPER */ void err_fic_bin_f ( char *chaine, /* <-> Chaine de caracteres receptrice */ integer_t ierror, /* -> Code d'erreur */ integer_t lmaxch /* -> Longueur maximale de la chaine receptrice */ ) { switch(ierror) { case FIC_ERR_FIN: strncpy(chaine, FIC_ERR_FIN_MSG, lmaxch); break; case FIC_ERR_SZE_ENR: strncpy(chaine, FIC_ERR_SZE_ENR_MSG, lmaxch); break; case FIC_ERR_LEN_NOM: strncpy(chaine, FIC_ERR_LEN_NOM_MSG, lmaxch); break; default: strncpy(chaine, strerror((int)ierror), lmaxch); } chaine[lmaxch] = '\0'; } /*============================================================================*/ /* Fonctions privees */ /*============================================================================*/ /*----------------------------------------------------------------------------*/ /* Permutation des octets pour passage de "little endian" a "big endian" */ /*----------------------------------------------------------------------------*/ static void fic_bin_f__endswap ( void *buf, /* Tampon contenant les elements */ size_t size, /* Taille d'un element */ size_t nitems /* Nombre d'elements */ ) { char tmpswap; char *ptr = (char *)buf; size_t i, j, shift; for (j = 0; j < nitems; j++) { shift = j * size; for (i = 0; i < (size / 2); i++) { tmpswap = *(ptr + shift + i); *(ptr + shift + i ) = *(ptr + shift + (size - 1) - i); *(ptr + shift + (size - 1) - i) = tmpswap; } } } syrthes-3.4.3-dfsg1/src/s/lecg2e.F0000666000175000017500000001325611524070642015221 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECG2E C ***************** C C ----------------------------------------- * (NFIC,NDIM,NDIELE,NPOINS,NELEMS,NBSCAL) C ----------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C FICHIER SUITE FORMAT GRAFN3S : LECTURE DE L'ENTETE * C VERIFICATION DE LA COHERENCE AVEC LA GEOMETRIE * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS VOL SOLIDE ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECSOL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "divct.h" C C********************************************************************** C C.. Variables externes INTEGER NFIC,NDIM,NDIELE,NPOINS,NELEMS C C.. Variables internes INTEGER NNDIM,NNDIEL,NNELE,NPOIN1,NPOIN2,NBSCAL CHARACTER CH*72,C4*4 LOGICAL COHER C C********************************************************************** C C 0- INITIALISATIONS C ================== C REWIND (NFIC) C C 1- LECTURE DE L'ENTETE C ====================== C C NNDIM : Dimension du probleme C NNDIEL : Dimension des elements C NNELE : Nombre d'elements C NPOIN1 : Nombre de noeuds P1 C NPOIN2 : Nombre total de noeuds P2 C NTSYR : Numero du pas de temps C TEMPSS : Temps reel C READ(NFIC,1200,ERR=99) & CH,CH,CH,CH,C4,NNDIM,NNDIEL,NNELE,NPOIN2,NBSCAL READ(NFIC,1210,ERR=99) CH,C4,NTSYR,TEMPSS,CH,CH,CH C C C 2- VERIFICATION SUCCINCTE DE LA COHERENCE AVEC LA GEOMETRIE C =========================================================== C COHER = .TRUE. C IF (NNDIM.NE.NDIM) COHER = .FALSE. IF (NNDIEL.NE.NDIELE) COHER = .FALSE. C IF (NPOIN2 .NE. NPOINS) COHER = .FALSE. C IF (NNELE .NE. NELEMS) COHER = .FALSE. C IF (.NOT. COHER) THEN WRITE(NFECRA,2000) STOP ENDIF C RETURN C 99 CONTINUE WRITE (NFECRA,999) STOP C-------- C FORMATS C-------- C 1200 FORMAT(A72,/,A72,/,A72,/,A72,/,A4,5I10) 1210 FORMAT(A72,/,A4,I10,E20.13,/,A72,/,A72,/,A72) C 2000 FORMAT(/,' %% ERREUR LECG2E : LE FICHIER SUITE EST INCOHERENT', & ' AVEC LA GEOMETRIE !') C 999 FORMAT(/,' %% ERREUR LECG2E : ', & 'ERREUR DE LECTURE DU FICHIER SUITE') C C END syrthes-3.4.3-dfsg1/src/s/initmp.F0000666000175000017500000001366111524070642015360 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INITMP C ***************** C C -------------------------------------------------- * (NDIM,NPOINS,NELEMS,NDMATS,NODES, * COORDS,NREFS,NREFE,TMPSA,TMPS) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DE LA TEMPERATURE DANS LE SOLIDE * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C ! TMPS ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL,RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION TMPSA(NPOINS),TMPS(NPOINS) C C.. Variables internes DOUBLE PRECISION XX,YY,ZZ INTEGER N,I,NUMREF C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C =================================================== C C Methode 1 : boucle sur les noeuds C --------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque point solide C DO N=1,NPOINS C C Coordonnees du noeud courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Numero de reference du noeud CUTI NUMREF = NREFS(N) C C Si le noeud courant porte la reference 4 CUTI IF (NUMREF.EQ.4 ) THEN CUTI TMPS(N) = 20.D0 CUTI ELSE CUTI TMPS(N) = 10.D0 CUTI ENDIF C CUTI ENDDO C C Methode 2 : boucle sur les elements C ----------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque element solide C DO N=1,NELEMS C C C Numero de materiau de l'element CUTI NUMREF=NREFE(N) C C Si l'elements porte la reference 4, on met 20 degres sur tous C les noeuds de l'element sinon on met 10 degres CUTI IF (NUMREF.EQ.4 ) THEN CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 20.D0 CUTI ENDDO CUTI ELSE CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 10.D0 CUTI ENDDO CUTI ENDIF C CUTI ENDDO C C FIN D'INTERVENTION UTILISATEUR C ------------------------------ C*********************************************************************** C DO N=1,NPOINS TMPSA(N)=TMPS(N) ENDDO C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/mobtmx.F0000666000175000017500000001215511524070642015363 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBTMX,SSI=0 SUBROUTINE MOBTMX C ***************** C C ---------------------------------- * (NBCOUS,NBICOR,NCBORS,NCOUPS,NUMA) C ---------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C SOLIDES EN TRANSLATION : DETERMINER SI ON EST AU MAXIMUM DE LA * C TRANSLATION * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NBCOUS ! E ! D ! Nombre de noeuds solides couples ! C ! NBICOR ! E ! D ! Nombre d'infos pour les correspondants ! C ! NCBORS ! TE ! D ! Tableau des correspondants ! C ! NCOUPS ! TE ! D ! Numeros globaux des noeuds solides couples ! C ! NUMA ! E ! R ! Numero du maillage a decaler ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "optct.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NBCOUS,NBICOR,NCBORS(NBCOUS,NBICOR),NCOUPS(NBCOUS),NUMA C C.. Variables internes INTEGER N,N1,N2 C*********************************************************************** C C C 0- INITIALISATIONS C ================== C NUMA = 0 N1 = 0 N2 = 0 C C 1- COMPTE DES NOEUDS QUI N'ONT PAS DE CORRESPONDANT C =================================================== C DO 100 N=1,NBCOUS C IF (NCBORS(N,1).EQ.-1) THEN IF (NCOUPS(N).LE.NBNMA1) THEN N1 = N1 + 1 ELSE N2 = N2 + 1 ENDIF ENDIF C 100 CONTINUE C C 2- MISE A JOUR DU MAILLAGE A DEPLACER C ===================================== C IF (N1 .EQ. NBCOUS/2) THEN NUMA = 1 ELSEIF (N2 .EQ. NBCOUS/2) THEN NUMA = 2 ELSE NUMA = 0 ENDIF C C C 3- IMPRESSIONS C ============== IF (NUMA .NE.0 .AND. NBLBLA.GE.2) THEN WRITE(NFECRA,3000) NUMA ENDIF C C-------- C FORMATS C-------- 3000 FORMAT(' *** MOBTMX : Translation du maillage ',I1) C RETURN END syrthes-3.4.3-dfsg1/src/s/wiebel.F0000666000175000017500000001013111524070642015314 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE WIEBEL C ***************** C C ----- * (V,W) C ----- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C CALCUL DES PONDERATIONS DE WIEBELT * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C C*********************************************************************** C C.. Variables externes DOUBLE PRECISION V,W C C.. Variables internes INTEGER M DOUBLE PRECISION PI4,Z0,Z1,Z2,Z4,Z6,Z8,V2,V4 C C*********************************************************************** C DATA PI4 / .153989717364E+00 / DATA Z0 / .333333343267E+00 / DATA Z1 / .125000000000E+00 / DATA Z2 / .166666675359E-01 / DATA Z4 / .198412701138E-03 / DATA Z6 / .367430925508E-05 / DATA Z8 / .751563220547E-07 / C C IF (V .GE. 2.) THEN W = 0 DO 100 M=1,5 W = W + EXP(-M*V)/(M*M*M*M) * (((M*V+3)*M*V+6)*M*V+6) 100 CONTINUE W = W * PI4 ELSE V2 = V*V V4 = V2*V2 W = Z0 - Z1*V + Z2*V2 - Z4*V2*V2 + Z6*V4*V2 - Z8*V4*V4 W = 1. - PI4*V2*V*W ENDIF C C-------- C FORMATS C-------- C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/xmflui.F0000666000175000017500000002066211524070642015363 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE XMFLUI C ***************** C C ------------------------------------------------------------- * (NDIM,NPOINF,NBCOUF,NELEBF,NELESF,NDMASF,NODEBF,NREFF,NODESF, * NELRAF,NODRAF, * NBFILS,NWMAIL,NWDE,NWDRE,NWDMA1) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- GENERATION AUTOMATIQUE DU MAILLAGE ELEMENTS FINIS * C DE LA PEAU DU MAILLAGE FLUIDE * C (PRISE EN COMPTE DES NOEUDS COUPLES D'UNE PART * C ET DES NOEUDS NON COUPLES MAIS SOUMIS AU RAYONNEMENT) * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL FLUIDE ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELEBF ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF FLUIDE ! C ! NELESF ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF FLUIDE COUPLE! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS SURF FLUIDE ! C ! NODEBF ! TE ! D ! TABLE DES ELTS SURF FLUIDE ! C ! NREFF ! TE ! D ! REFERENCE DES NOEUDS VOL FLUIDES ! C ! NODESF ! TE ! R ! TABLE DES ELTS SURF FLUIDE COUPLES ! C ! NELRAF ! E ! D ! NBRE D'ELTS SURF FLUIDES NON COUPLES + RAYT ! C ! NODRAF ! TE ! R ! TABLE DES ELTS SURF NON COUPLES + RAYT ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! D ! ! C !/NLOFES/! ! D ! ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "optct.h" C C********************************************************************** C INTEGER NDX PARAMETER (NDX = 6) C C C.. Variables externes INTEGER NDIM,NPOINF,NBCOUF,NELEBF,NELESF,NDMASF,NELRAF INTEGER NODESF(NELESF,NDMASF), NODEBF(NELEBF,NDMASF) INTEGER NREFF(NPOINF),NODRAF(NELRAF,NDMASF) INTEGER NBFILS,NWMAIL,NWDE,NWDRE,NWDMA1 C C.. Variables internes INTEGER N,M,N1 INTEGER NE,NY LOGICAL LCOUPL,LRAYT,LC(NDX),LY(NDX),ERR INTEGER NR(NDX) C C C********************************************************************** C C C 1- INITIALISATIONS C ================== C IF (NWMAIL.EQ.1) THEN DO 11 N=1,NELESF*NDMASF NODESF(N,1) = 0 11 CONTINUE C DO 12 N=1,NELRAF*NDMASF NODRAF(N,1) = 0 12 CONTINUE ENDIF C C C 2- TABLE DES ELEMENTS FLUIDES COUPLES C ===================================== C NE = NWDE-1 NY = NWDRE-1 C DO 200 N=1,NELEBF C DO 201 M = 1,NWDMA1 NR(M) = NREFF(NODEBF(N,M)) 201 CONTINUE C DO 202 M=1,NWDMA1 LC(M) = .FALSE. LY(M) = .FALSE. 202 CONTINUE C DO 205 M=1,NWDMA1 DO 207 N1=1,NRFMAX IF (IREFFC(N1).NE.0 .AND. NR(M).EQ.N1) LC(M) = .TRUE. IF (IREFRF(N1).NE.0 .AND. NR(M).EQ.N1) LY(M) = .TRUE. 207 CONTINUE 205 CONTINUE C LCOUPL = .TRUE. DO 208 M=1,NWDMA1 LCOUPL = LCOUPL .AND. LC(M) 208 CONTINUE C LRAYT = .TRUE. DO 209 M=1,NWDMA1 LRAYT = LRAYT .AND. LY(M) 209 CONTINUE C CIR fin IF (LCOUPL) THEN NE = NE + 1 DO 215 M=1,NWDMA1 NODESF(NE,M) = NODEBF(N,M) 215 CONTINUE ENDIF C IF (LRAYT) THEN NY = NY + 1 DO 216 M=1,NWDMA1 NODRAF(NY,M) = NODEBF(N,M) 216 CONTINUE ENDIF C 200 CONTINUE C C C 3- CONTROLE DES DEBORDEMENTS DE TABLEAU C ======================================= C ERR = .FALSE. C IF (NWMAIL.EQ.NBFILS .AND. NE.NE.NELESF) THEN WRITE(NFECRA,3000) NELESF,NE ERR = .TRUE. ENDIF IF (NWMAIL.EQ.NBFILS .AND. NY.NE.NELRAF) THEN WRITE(NFECRA,3010) NELRAF,NY ERR = .TRUE. ENDIF C IF (ERR) STOP C C C 4- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) WRITE(NFECRA,4000) NWMAIL,NE-NWDE+1,NY-NWDRE+1 C IF (NBLBLA.EQ.11) THEN WRITE(NFECRA,4100) DO 400 N=NWDE,NE-NWDE+1 WRITE(NFECRA,4200) N,(NODESF(N,M),M=1,NWDMA1) 400 CONTINUE WRITE(NFECRA,4300) DO 410 N=NWDRE,NY-NWDRE+1 WRITE(NFECRA,4400) N,(NODRAF(N,M),M=1,NWDMA1) 410 CONTINUE C ENDIF C C------- C FORMAT C------- C 3000 FORMAT(/,' %% ERREUR XMFLUI : LE TABLEAU DU MAILLAGE DE BORD', & ' FLUIDE COUPLE EST MAL DIMENSIONNEE',/, & ' - SA TAILLE EST DE : ',I9,/, & ' - XMFLUI EN DEMANDE : ',I9) 3010 FORMAT(/,' %% ERREUR XMFLUI : LE TABLEAU DU MAILLAGE DE BORD', & ' RAYONNEMENT FLUIDE EST MAL DIMENSIONNEE',/, & ' - SA TAILLE EST DE : ',I9,/, & ' - XMFLUI EN DEMANDE : ',I9) 4000 FORMAT(/,' *** XMFLUI : Maillage fluide',I3,/, & ' - Maillage surfacique fluide couple : ', & I6,' elements',/, & ' - Maillage surfacique fluide non couple ', & 'mais avec rayonnement :',I6,' elements') 4100 FORMAT(/,' IMPRESSION DE LA TABLE DES ELEMENTS FLUIDES COUPLES') 4200 FORMAT( ' Element ',I9,' Noeuds : ',6I9) 4300 FORMAT(/,' IMPRESSION DE LA TABLE DES ELEMENTS FLUIDES+RAYT') 4400 FORMAT( ' Element ',I9,' Noeuds : ',6I9) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ecrg3e.F0000666000175000017500000001302011524070642015215 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE ECRG3E C ***************** C C -------------------------------------- * (NFIC) C -------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C GENERATION DE L'ENTETE DU FICHIER RESULTAT (partie 2) * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! TYPDOM ! A ! D ! INDIQUE SI ON TRAITE LE MAILLAGE SOLIDE OU ! C ! ! ! ! LA PEAU DU FLUIDE ! C ! ! ! ! TYPDOM = 'S' pour le solide ! C ! ! ! ! 'F' pour le fluide ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NELEM ! E ! D ! NOMBRE D'ELTS DU MAILLAGE TRAITE ! C ! NPOIN ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE TRAITE ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! D ! ! C !/DIVCT/ ! ! D ! ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "divct.h" C C********************************************************************** C C..Variables externes INTEGER NFIC C C..Variables internes CHARACTER VERSIO*8,DATE*11 C C********************************************************************** C FONCTIONS IMPLICITES C********************************************************************** C C********************************************************************** C C C 1- ECRITURE DE L'ENTETE DU PAS DE TEMPS C ======================================= C C 1.2- ENTETE DU PAS DE TEMPS C --------------------------- C NTSYR : Numero du pas de temps (total) C VERSIO : Numero de version du code C DATE : Date de l'execution C VERSIO = ' 3.4.1' DATE = ' TODAY' C C TEMPSS : Temps reel sur le solide C RDDTS : Pas de temps sur le solide C C 1.3- ENTETE DU PAS DE TEMPS : ECRITURE C -------------------------------------- C WRITE(NFIC,1210) NTSYR,TEMPSS,RDTTS WRITE(NFIC,1220) VERSIO,DATE C C C-------- C FORMATS C-------- C 1210 FORMAT('C3C* NPDT TEMPS DT',/, & 'C4C*',I10,2E20.13) 1220 FORMAT('C5C* VERSION DATE',/, & 'C6C*',A8,5X,A11,/,72('*')) C C C END syrthes-3.4.3-dfsg1/src/s/envosy.F0000666000175000017500000001056211524070642015400 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE ENVOSY C ***************** C * (LSYR_,NTSYR_,LDERN_,LSTOP_,TEMPS_,NTSMX_) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C SOUS-PROGRAMME PRINCIPAL DE SYRTHES C C----------------------------------------------------------------------- C ARGUMENTS C .________________.____.______________________________________________. C ! NOM !MODE! ROLE ! C !________________!____!______________________________________________! C .________________.____.______________________________________________. C COMMONS C .________________.____.______________________________________________. C ! ! ! TOUS LES COMMONS SONT PRESENTS ICI ! C !________________!____!______________________________________________! C MODE:-->ENTREE,<--RESULTAT,<-->DONNEE MODIFIEE,--TABLEAU DE TRAVAIL C----------------------------------------------------------------------- C - SOUS PROGRAMME(S) APPELANT(S) : C - SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C #include "syrth.h" #include "optct.h" #include "nlofct.h" #include "nlofes.h" #include "iadrct.h" #include "divct.h" #include "syrthu.h" #include "rayonn.h" C C*********************************************************************** C INTEGER LSYR_,NTSYR_,LDERN_,LSTOP_,NTSMX_ DOUBLE PRECISION TEMPS_ C C*********************************************************************** C NTSYR=NTSYR_ LDERN=.FALSE. IF (LDERN_.NE.0) LDERN=.TRUE. LSTOPS=.FALSE. IF (LSTOP_.NE.0) LSTOPS=.TRUE. TEMPSS=TEMPS_ NTSMAX=NTSMX_ C END syrthes-3.4.3-dfsg1/src/s/ccondm.F0000666000175000017500000001336111524070642015320 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCONDM C ***************** C * ( VAL1,VAL2,NRFRAY,NELRAY,NFMSTE,NGFMSE,VFMSTE,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C ON REPERE LES NOEUDS EN UTILISANT LES REFERENCES * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNE ! C ! NELRAY ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! TEMRAY ! TR ! R ! TEMPERATURE DE RAYONNEMENT ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIR C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" #include "rayonn.h" C C********************************************************************** C C..Variables externes INTEGER NELRAY,NB,NFMSTE INTEGER NRFRAY(NELRAY),IREF(NRFMAX),NGFMSE(NFMSTE) DOUBLE PRECISION VFMSTE(NFMSTE,2),VAL1,VAL2 C C..Variables internes INTEGER N,N1,NR,NBRE,NUMREF,NGFAC C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NFMSTE NGFAC = NGFMSE(N) VFMSTE(N,1) = VAL1 VFMSTE(N,2) = VAL2 NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NFMSTE C NGFAC = NGFMSE(N) NUMREF = NRFRAY(NGFAC) C IF (NUMREF .EQ. NR) THEN VFMSTE(N,1) = VAL1 VFMSTE(N,2) = VAL2 NBRE = NBRE + 1 ENDIF C 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLR.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCONDM : Nombre de faces MST traitees avec ', * 'coeff d''echange :',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/assemb.F0000666000175000017500000003563511524070642015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ASSEMB,SSI=0 C SUBROUTINE ASSEMB C ***************** C C -------------------------------------------- *( DMAT,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT) C ------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- ASSEMBLAGE DES VECTEURS POUR * C LE CAS BIDIMENSIONNEL, AXISYMETRIQUE, * C TRIDIMENSIONNEL ET COQUE. * C Vecteur non necessairement initialise a 0 * C * C ATTENTION : Dans ce sous-programme on force la vectorisation * C si l'instruction !OCL est active * C ce qui suppose un arrangement des elements adapte. * C Ordre ayant une importance uniquement sur VPP5000 * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! DMAT ! TR ! D ! DIAGONALE DE LA MATRICE M ! C ! NODES ! TE ! D ! NUMERO DES NOEUDS ( LOCALE --> GLOBALE ) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL (NELEMS*NDMATS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "divct.h" C C*********************************************************************** INTEGER NPOINS,NELEMS,NDMATS,NDIELE C DOUBLE PRECISION DMAT(NPOINS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C Variables locales INTEGER I,INODE INTEGER NBBLOC,ILONV C C*********************************************************************** C ILONV=ABS(IVECTO) C IF (ILONV.EQ.1024) THEN C Assemblage des vecteurs sur 1024 NBBLOC= NELEMS/ILONV C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO ENDIF C C C IF ( NDIELE .EQ. 3 ) THEN C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO ENDIF C !OCL NOVREC, VRL(16) DO I=1,NBBLOC*ILONV INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(16) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO ENDIF C ENDIF C ENDIF C C C------------------- IF (ILONV.EQ.128) THEN C Assemblage des vecteurs sur 128 NBBLOC= NELEMS/ILONV C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO ENDIF C C C IF ( NDIELE .EQ. 3 ) THEN C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO ENDIF C !OCL NOVREC, VRL(128) DO I=1,NBBLOC*ILONV INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO IF(IVECTO.GT.0) THEN !OCL NOVREC, VRL(128) DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO ELSE DO I=NBBLOC*ILONV+1,NELEMS INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO ENDIF C ENDIF C ENDIF C C C------------------------------ IF (ILONV.EQ.0) THEN C Assemblage scalaire des vecteurs DO I=1,NELEMS INODE = NODES(I,1) DMAT(INODE) = DMAT(INODE) + WCT(I,1) ENDDO C DO I=1,NELEMS INODE = NODES(I,2) DMAT(INODE) = DMAT(INODE) + WCT(I,2) ENDDO C DO I=1,NELEMS INODE = NODES(I,3) DMAT(INODE) = DMAT(INODE) + WCT(I,3) ENDDO C DO I=1,NELEMS INODE = NODES(I,4) DMAT(INODE) = DMAT(INODE) + WCT(I,4) ENDDO C DO I=1,NELEMS INODE = NODES(I,5) DMAT(INODE) = DMAT(INODE) + WCT(I,5) ENDDO C DO I=1,NELEMS INODE = NODES(I,6) DMAT(INODE) = DMAT(INODE) + WCT(I,6) ENDDO C C IF ( NDIELE .EQ. 3 ) THEN C DO I=1,NELEMS INODE = NODES(I,7) DMAT(INODE) = DMAT(INODE) + WCT(I,7) ENDDO C DO I=1,NELEMS INODE = NODES(I,8) DMAT(INODE) = DMAT(INODE) + WCT(I,8) ENDDO C DO I=1,NELEMS INODE = NODES(I,9) DMAT(INODE) = DMAT(INODE) + WCT(I,9) ENDDO C DO I=1,NELEMS INODE = NODES(I,10) DMAT(INODE) = DMAT(INODE) + WCT(I,10) ENDDO C ENDIF C ENDIF C RETURN END syrthes-3.4.3-dfsg1/src/s/smexps.F0000666000175000017500000001275011524070642015375 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMEXPS,SSI=0 C SUBROUTINE SMEXPS C ***************** C C ------------------------ *( TMPSA,B,DMATL,NPOINS ) C ----------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C PARTIE EXPLICITE * C * C / T * C / n * C / Rho Cp --- dV * C / n n dt * C / n * C * C En fait cela revient a faire un produit vecteur vecteur. * C car on travail sur des matrices de masse masslumpee * C * C Second membre i = DMATLii Ti * C n n n * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NPOINS ! E ! ! Nombre de poins du maillage solide ! C ! TMPSA ! TR ! M ! TEMPERATURE EN CHAQUE POINS A T = N - 1 ! C ! B ! TR ! M ! SECOND MEMBRE (Partie explicite ! C ! DMATL ! TR ! D ! DIAGONALE DE LA MATRICE M masse lumpee ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables internes INTEGER NPOINS C DOUBLE PRECISION DMATL(NPOINS) DOUBLE PRECISION B(NPOINS),TMPSA(NPOINS) C C..Variables locales INTEGER I DOUBLE PRECISION ZERO C C*********************************************************************** C C 1- INITIALISATIONS C ================== C ZERO = 0.D0 C CALL OV ( 'X=C ',B,B,B,ZERO,NPOINS ) C C 2- CALCUL DU SECOND MEMBRE (Partie explicite) C ============================================= C DO 20 I=1,NPOINS B(I) = DMATL(I) * TMPSA(I) 20 CONTINUE C C 3- IMPRESSIONS POUR CONTROLE C ============================ C IF ( NBLBLA.EQ.11 ) THEN WRITE(NFECRA,3000) DO 300 I=1,NPOINS WRITE(NFECRA,3010) I,B(I),DMATL(I),TMPSA(I) 300 CONTINUE ENDIF C C-------- C FORMATS C-------- 3000 FORMAT(/,' *** SMEXPS : SECOND MEMBRE (PARTIE EXPLICITE)',/, & ' NOEUD SECOND MEMBRE DMATL TMPSA ') 3010 FORMAT(7X,I10,5X,G10.4,5X,G10.4,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/char4.F0000666000175000017500000000370611524070642015060 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CHAR4,SSI=0 CHARACTER*4 FUNCTION CHAR4(ICHAR4) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C BUT : REALISER LA CONVERSION : INTEGER A4 -> CHARACTER*4 C PARAMETRE D'ENTREE : C ICHAR4 : ENTIER CONTENANT 4 CARACTERES C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ INTEGER ICHAR4 CHARACTER*4 BUFFE4 CHARACTER*8 BUFFE8 C C BUFFE4 = ' ' BUFFE8 = ' ' C C +++++ VERSION STANDARD PORTABLE c WRITE (BUFFE4,'(A4)') ICHAR4 C C +++++ VERSION VAX VMS c EQUIVALENCE ( BUFFE4 , J ) c J = ICHAR4 C C +++++ VERSION CRAY (entiers sur 64 bits) WRITE (BUFFE8,'(A8)') ICHAR4 BUFFE4 = BUFFE8(5:8) C C +++++ FIN VERSIONS CHAR4 = BUFFE4 END syrthes-3.4.3-dfsg1/src/s/coray2.F0000666000175000017500000002734211524070642015260 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CORAY2 C ***************** C C -------------------------------------------------------------- * (NDIM,NDMA1,NP1,COOR1,NEL1,NOD1,NGL1,NGLOB1,NC1,BARY1, * NDMA2,NP2,COOR2,NEL2,NOD2,NREF2,NGL2,NGLOB2,NC2,BARY2, * IREF,IIR,INDGLO) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA TABLE DE CORRESPONDANCE ENTRE LES * C MAILLAGES POUR LE RAYONNEMENT CONFINE * C ALGORITHME PENIGUEL/RUPP * C * C 1 : maillage fin * C 2 : maillage grossier * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! INDGLO ! E ! D ! =0 => il faut rechercher les numeros globaux ! C ! ! ! ! =1 => on a directement les coordonnees ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : DPTTRI, CBARY3 C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C INTEGER N64 PARAMETER (N64 = 128) C*********************************************************************** C DONNEES EN COMMON (VOIR LA SIGNIFICATION COMPLETE DANS LECDON) C ********************************************************************** C #include "nlofes.h" #include "optct.h" #include "mobil.h" #include "xrefer.h" C C*********************************************************************** C.. Variables externes INTEGER NDIM,NP1,NEL1,NDMA1,NGL1,NP2,NEL2,NDMA2,NGL2 INTEGER NOD1(NEL1,NDMA1),NGLOB1(NGL1),NC1(NGL1) INTEGER NOD2(NEL2,NDMA2),NGLOB2(NGL2),NREF2(NEL2),NC2(NGL2,2) DOUBLE PRECISION COOR1(NP1,NDIM),COOR2(NP2,NDIM) DOUBLE PRECISION BARY1(NGL1,NDIM),BARY2(NGL2,NDIM) INTEGER IIR,IREF(IIR),INDGLO C C C.. Variables internes INTEGER ICODE,NUMSEG INTEGER N,NPF,NA,NB,NF,NS INTEGER NELMIN,N1MIN,N2MIN,N3MIN,NPS INTEGER NBBOUC,NLONV,IDEB,I C DOUBLE PRECISION XA,YA,XB,YB DOUBLE PRECISION XP1,YP1 DOUBLE PRECISION XX,YY,DIST DOUBLE PRECISION XMIN,YMIN,DMIN DOUBLE PRECISION X1,Y1,X2,Y2,X3,Y3 C C C*********************************************************************** C C 0- INITIALISATIONS C ================== C IF (NGL1.EQ.0 .OR. NGL2.EQ.0) RETURN C DO 1 N=1,NGL2*NDIM BARY2(N,1) = 0.D0 1 CONTINUE C C IF (NBLBLR.GE.3) WRITE(NFECRA,1000) C DO 100 NPF=1,NGL1 C DMIN = 1.D6 XMIN = 0.D0 YMIN = 0.D0 NELMIN = 1 N1MIN = 0 N2MIN = 0 N3MIN = 0 C IF (INDGLO.EQ.1) THEN NF = NGLOB1(NPF) ELSE NF = NPF ENDIF C XP1 = COOR1(NF,1) YP1 = COOR1(NF,2) C NBBOUC = (NEL2/N64) NLONV = N64 C DO 110 N=1,NBBOUC+1 IDEB = (N-1)*N64 IF (N.EQ.NBBOUC+1) NLONV = MOD(NEL2,N64) DO 111 I=1,NLONV C ICODE = 0 C IF (IREF(NREF2(IDEB+I)).EQ.0) THEN GOTO 111 ENDIF C NA = NOD2(IDEB+I,1) NB = NOD2(IDEB+I,2) C XA = COOR2(NA,1) YA = COOR2(NA,2) XB = COOR2(NB,1) YB = COOR2(NB,2) C CALL DPTSEG (XP1,YP1,XA,YA,XB,YB,DIST,XX,YY,ICODE) C IF (ICODE.NE.0) THEN WRITE(NFECRA,1200) NF,XP1,YP1,IDEB+I,NA,NB STOP ENDIF C IF (DIST.LT.DMIN) THEN DMIN = DIST XMIN = XX YMIN = YY NELMIN = IDEB+I ENDIF C 111 CONTINUE C 110 CONTINUE C NC1(NPF) = NELMIN N1MIN = NOD2(NELMIN,1) N2MIN = NOD2(NELMIN,2) C X1 = COOR2(N1MIN,1) Y1 = COOR2(N1MIN,2) X2 = COOR2(N2MIN,1) Y2 = COOR2(N2MIN,2) CALL CBARY2 (XMIN,YMIN, & X1,Y1,X2,Y2, & BARY1(NPF,1),BARY1(NPF,2)) C IF (NBLBLR.GE.11) THEN WRITE(NFECRA,1700) NF,XP1,YP1, & NELMIN,N1MIN,N2MIN, & XMIN,YMIN,DMIN, & BARY1(NPF,1),BARY1(NPF,2) ENDIF C C 100 CONTINUE C IF (NBLBLR.GE.3) WRITE(NFECRA,2000) C C DO 200 NPS=1,NGL2 C NS = NGLOB2(NPS) C XP1 = COOR2(NS,1) YP1 = COOR2(NS,2) C DMIN = 1.D6 XMIN = 0.D0 YMIN = 0.D0 NELMIN = 1 C NBBOUC = (NEL1/N64) NLONV = N64 C DO 210 N=1,NBBOUC+1 IDEB = (N-1)*N64 IF (N.EQ.NBBOUC+1) NLONV = MOD(NEL1,N64) C DO 211 I=1,NLONV C ICODE = 0 C IF (INDGLO.EQ.1) THEN NA = NGLOB1(NOD1(IDEB+I,1)) NB = NGLOB1(NOD1(IDEB+I,2)) ELSE NA = NOD1(IDEB+I,1) NB = NOD1(IDEB+I,2) ENDIF C XA = COOR1(NA,1) YA = COOR1(NA,2) XB = COOR1(NB,1) YB = COOR1(NB,2) C CALL DPTSEG (XP1,YP1,XA,YA,XB,YB,DIST,XX,YY,ICODE) C IF (ICODE.NE.0) THEN IF (INDGLO.EQ.1) THEN WRITE(NFECRA,2200) NPS,XP1,YP1,IDEB+I, * NGLOB1(NA),NGLOB1(NB) ELSE WRITE(NFECRA,2200) NPS,XP1,YP1,IDEB+I,NA,NB ENDIF STOP ENDIF C IF (DIST.LT.DMIN) THEN DMIN = DIST XMIN = XX YMIN = YY NELMIN = IDEB+I ENDIF C 211 CONTINUE 210 CONTINUE C C IF (INDGLO.EQ.1) THEN N1MIN = NGLOB1(NOD1(NELMIN,1)) N2MIN = NGLOB1(NOD1(NELMIN,2)) ELSE N1MIN = NOD1(NELMIN,1) N2MIN = NOD1(NELMIN,2) ENDIF C X1 = COOR1(N1MIN,1) Y1 = COOR1(N1MIN,2) X2 = COOR1(N2MIN,1) Y2 = COOR1(N2MIN,2) C IF (NDMA1.EQ.3) THEN IF (INDGLO.EQ.1) THEN N3MIN = NGLOB1(NOD1(NELMIN,3)) ELSE N3MIN = NOD1(NELMIN,3) ENDIF X3 = COOR1(N3MIN,1) Y3 = COOR1(N3MIN,2) C CALL SOUSEG (XMIN,YMIN,X1,Y1,X2,Y2,NUMSEG) C IF (NUMSEG.EQ.1) THEN CALL CBARY2 (XMIN,YMIN, & X1,Y1,X3,Y3, & BARY2(NPS,1),BARY2(NPS,2)) ELSE CALL CBARY2 (XMIN,YMIN, & X2,Y2,X3,Y3, & BARY2(NPS,1),BARY2(NPS,2)) ENDIF C ELSE NUMSEG = 0 CALL CBARY2 (XMIN,YMIN, & X1,Y1,X2,Y2, & BARY2(NPS,1),BARY2(NPS,2)) ENDIF C NC2(NPS,1) = NELMIN NC2(NPS,2) = NUMSEG C IF (NBLBLR.GE.11) THEN WRITE(NFECRA,2700) NS,XP1,YP1, & NELMIN,N1MIN,N2MIN, & XMIN,YMIN,DMIN, & BARY2(NPS,1),BARY2(NPS,2) ENDIF C C 200 CONTINUE C C-------- C FORMATS C-------- C 1000 FORMAT(/,' *** CORAY2 :',/, & 5X,'Recherche des correspondances pour le rayonnement ', & 'confine : phase 1'/) 1200 FORMAT(/,' %% ERREUR CORAY2 : LA RECHERCHE DU CORRESPONDANT A ', & 'ECHOUEE : ',/, & ' POINT FIN :',I6,/, & ' ',2G10.3,/, & ' DANS LE SEGMENT GROSSIER :',I6,/, & ' ',2I6) 1700 FORMAT(/,' NOEUD FIN :',I6,', coordonnees :',2G10.3,/, & 'CORRESPONDANT GROSSIER :',/, & ' numero du segment grossier :',I6,/, & ' noeuds :',I6,' ',I6,/, & ' coord du point correspondant :',2G10.3,/, & ' distance minimale :',G10.3,/, & ' coord barycentriques :',2G10.3) C 2000 FORMAT(/,' *** CORAY2 :',/, & 5X,'Recherche des correspondances pour le rayonnement ', & 'confine : phase 2'/) 2200 FORMAT(/,' %% ERREUR CORAY2 : LA RECHERCHE DU CORRESPONDANT A ', & 'ECHOUEE : ',/, & ' POINT GROSSIER :',I6,/, & ' ',2G10.3,/, & ' DANS LE SEGMENT FIN :',I6,/, & ' ',2I6) 2700 FORMAT(/,'NOEUD GROSSIER :',I6,', coordonnees :',2G10.3,/, & ' CORRESPONDANT FIN :',/, & ' numero du segment fin :',I6,/, & ' noeuds :',I6,' ',I6,/, & ' coord du point correspondant :',2G10.3,/, & ' distance minimale :',G10.3,/, & ' coord barycentriques :',2G10.3) C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/cmptel.F0000666000175000017500000001623011524070643015340 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CMPTEL,SSI=0 SUBROUTINE CMPTEL C ***************** C C -------------------------------------------------- *(NODES,NREFS,ITAB,NPOINS,NDIELE,NDMATS,NBFACE,NELEMS, * NELESS,NELEUS,NELEPR,NELERC,NELERA,NBFLUS,NRAJOU) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C COMPTE DES ELEMENTS PORTANT LES DIVERSES CONDITIONS * C POSSIBLES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NREFS ! TE ! D ! NUMEROS DE REFERENCE DES NOEUDS ! C ! NPOINS ! E ! D ! NBRE DE NOEUDS SOLIDES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NDMATS ! E ! D ! NBRE DE NOEUDS DES ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACE DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NELEUS ! E ! R ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELEPR ! E ! R ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NELERA ! E ! R ! NBRE D'ELTS DU MAIL SURF SOLIDE RAYT ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NRAJOU ! E ! R ! NBRE DE NOEUDS RAJOUTES A LA TABLE DES FLUX ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "mobil.h" #include "nlofct.h" #include "divct.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NPOINS,NDIELE,NDMATS,NBFACE,NELEMS INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS),ITAB(NPOINS) INTEGER NELESS,NELEUS,NELEPR,NELERC,NBFLUS,NRAJOU,NELERA C C.. Variables internes LOGICAL LFFLU(NDX),LFCOU(NDX),LPDIR(NDX),LFRES(NDX),LFRAY(NDX) LOGICAL LPERIO INTEGER N,N1,N2,NUMREF INTEGER NO2(2,3),NO3(3,4) C C*********************************************************************** C DATA NO2 /1,2, 2,3, 3,1/ DATA NO3 /1,3,2, 1,2,4, 1,4,3, 2,3,4/ C C 0- INITIALISATIONS C ================== C NELESS = 0 NELEUS = 0 NELEPR = 0 NELERC = 0 NELERA = 0 NRAJOU = 0 C DO 10 N=1,NPOINS ITAB(N) = 0 10 CONTINUE C C 1- BOUCLE SUR LES ELEMENTS C ========================== DO 550 N=1,NELEMS C CALL EVATYP (N,NDIELE,NODES,NELEMS,NDMATS,NREFS,NPOINS, & LFFLU,LFCOU,LFRES,LFRAY,NBFACE,LPDIR) C DO 551 N1=1,NBFACE IF (LFFLU(N1)) NELEUS = NELEUS + 1 IF (LFCOU(N1)) NELESS = NELESS + 1 IF (LFRES(N1)) NELERC = NELERC + 1 IF (LFRAY(N1)) THEN NELERA = NELERA + 1 IF (NDIELE.EQ.2) THEN ITAB(NODES(N,NO2(1,N1))) = -1 ITAB(NODES(N,NO2(2,N1))) = -1 ELSE ITAB(NODES(N,NO3(1,N1))) = -1 ITAB(NODES(N,NO3(2,N1))) = -1 ITAB(NODES(N,NO3(3,N1))) = -1 ENDIF ENDIF 551 CONTINUE C DO 552 N1=1,NDMATS IF (LPDIR(N1)) THEN NBFLUS = NBFLUS + 1 NRAJOU = NRAJOU + 1 ENDIF 552 CONTINUE C LPERIO = .FALSE. DO 553 N1=1,NDMATS NUMREF = NREFS(NODES(N,N1)) IF (NUMREF.NE.0) THEN DO 554 N2=1,NRFMAX IF (IREFPR(N2).NE.0 .AND. NUMREF.EQ.N2) LPERIO = .TRUE. 554 CONTINUE ENDIF 553 CONTINUE IF (LPERIO) NELEPR = NELEPR + 1 C C 550 CONTINUE C C C 2- COMPTE DES NOEUDS SOMMETS AVEC RAYONNEMENT C ========================================== NPRAP1 = 0 DO 600 N=1,NPOINS IF (ITAB(N).NE.0) NPRAP1 = NPRAP1+1 600 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/mobdif.F0000666000175000017500000001466311524070643015324 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE MOBDIF C ***************** C C ------------------------------------------------------- *( NBMOBS,NDIM,NBCOUF,NELESF,NDMASF,NODESF,COORDF,CALCIU) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- * C SOLIDE MOBILE : INITIALISATION DE : * C - D1MAXF (taille du plus grand element de bord fluide * C - D2MAXF * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBMOBS ! E ! D ! NOMBRE DE NOEUDS MOBILES ! C ! NMOBIL ! E ! D ! NUM GLOB ET NUM DE SOLIDE DES NOEUDS MOB ! C ! COORDS ! TR ! M ! COORDONNEES DES NOEUDS DU MAILLAGE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ROTATI C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "mobil.h" #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NBMOBS,NDIM,NBCOUF,NELESF,NDMASF,NODESF(NELESF,NDMASF) INTEGER CALCIU DOUBLE PRECISION COORDF(NBCOUF,NDIM) C C..Variables internes INTEGER N,N1,N2,N3 DOUBLE PRECISION D1,D2,D3,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3 C C*********************************************************************** C C 0- INITIALISATIONS C ================== D1MAXF = 0. D2MAXF = 1.E6 C IF (NBMOBS.EQ.0 .AND. .NOT.LSDEPL .AND. * CALCIU.EQ.0) RETURN C C 1- CALCUL DE D1MAXF EN DIMENSION 2 C =================================== C IF (NDIM.EQ.2) THEN C DO 100 N=1,NELESF C N1 = NODESF(N,1) N2 = NODESF(N,2) C X1 = COORDF(N1,1) Y1 = COORDF(N1,2) X2 = COORDF(N2,1) Y2 = COORDF(N2,2) C D2 = (X2-X1)*(X2-X1) + (Y2-Y1)*(Y2-Y1) C IF (D2.GT.D1MAXF) D1MAXF = D2 IF (D2.LT.D2MAXF) D2MAXF = D2 C 100 CONTINUE C C C 2- CALCUL DE D1MAXF EN DIMENSION 3 C ================================== C ELSE C DO 200 N=1,NELESF C N1 = NODESF(N,1) N2 = NODESF(N,2) N3 = NODESF(N,3) C X1 = COORDF(N1,1) Y1 = COORDF(N1,2) Z1 = COORDF(N1,3) X2 = COORDF(N2,1) Y2 = COORDF(N2,2) Z2 = COORDF(N2,3) X3 = COORDF(N3,1) Y3 = COORDF(N3,2) Z3 = COORDF(N3,3) C D1 = (X2-X1)*(X2-X1) + (Y2-Y1)*(Y2-Y1) + (Z2-Z1)*(Z2-Z1) D2 = (X3-X1)*(X3-X1) + (Y3-Y1)*(Y3-Y1) + (Z3-Z1)*(Z3-Z1) D3 = (X2-X3)*(X2-X3) + (Y2-Y3)*(Y2-Y3) + (Z2-Z3)*(Z2-Z3) C IF (D1.GT.D1MAXF) D1MAXF = D1 IF (D2.GT.D1MAXF) D1MAXF = D2 IF (D3.GT.D1MAXF) D1MAXF = D3 IF (D1.LT.D2MAXF) D2MAXF = D1 IF (D2.LT.D2MAXF) D2MAXF = D2 IF (D3.LT.D2MAXF) D2MAXF = D3 C 200 CONTINUE C C ENDIF C C C 5- Correction pour les problemes d'arrondis C =========================================== D1MAXF = D1MAXF D2MAXF = SQRT(D2MAXF)/10. C C C 6- Impressions C ============== IF (NBLBLA.GT.0) WRITE(NFECRA,6000) * SQRT(D1MAXF),D2MAXF*10.,D2MAXF C C-------- C FORMATS C-------- 6000 FORMAT(/,' *** MOBDIF : ',/, & ' Taille du plus grand element de bord fluide : ',E12.5,/, & ' (distance d''acceptation pour le 1er tri)',/, & ' Taille du plus petit element de bord fluide : ',E12.5,/, & ' Distance d''acceptation des ', & 'correspondants fluide/solide : ',E12.5) C RETURN END syrthes-3.4.3-dfsg1/src/s/calfdf_2a.c0000666000175000017500000014015511524070643015716 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" #define nquartier 72 int tabint[nquartier]; const double Pi=3.141592653589793; int ss_sega[2][2] = { {0,2}, {2,1} }; int nsp,ordrei,ordrej; double taille_boite,taille_seg; double wi[24],xli[24],wj[24],xlj[24]; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cfdf2d | | Gestion du calcul des facteurs de forme en axisymetrique | |======================================================================| */ proc(void cfdf2a,void CFDF2A) (int *ndim,int *nelray,int *npoinr,int *nodray, double *cooray,double *sufray,double *fdf, int *nplasy,double *plasym, int *iaxi,int *ndecoup_max, int *nrfray,double *pvinter,int *numgu, int*ngumax, int *nblblr) { int i,n2; int faces_cachees ; int *nod2,nel2,npoin2; double *coo2,*xnf2,xmult; double *cooa1,*xnfa1; int iaxir; int *grconv, *grconv2; int imult; dimension_2d(*ndim,*nelray,*npoinr,nodray,cooray, &taille_boite,&taille_seg); imult = 0; xmult = 1.; if(taille_seg < 0.01 || taille_seg > 10) { imult = 1; if (taille_seg < 0.01) xmult = 0.1/taille_seg; if (taille_seg > 10 ) xmult = 1/taille_seg; if(*nblblr >= 10) printf("Facteur multiplicatif interne xmult= %f \n",xmult); for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) *= xmult ; taille_boite *= xmult; taille_seg *= xmult; for(i=0;i<3**ngumax;i++) *(pvinter+i)*=xmult; for(i=0;i<*nplasy;i++) plasym[i*4+2]*=xmult; } grconv = (int *)malloc( *nelray * sizeof(int) ); if (grconv==NULL) {printf(" ERREUR cfdf2a : probleme d'allocation memoire\n"); exit(0);} orie2d(nodray,*nelray,*npoinr,nrfray,cooray,pvinter,*numgu,*ndim,*nblblr, grconv); gauss(); surface_anneau (*iaxi,*nelray,*npoinr,nodray,cooray,sufray); if (*nplasy == 0) nsp=1; else nsp=2; cooa1=(double*)malloc( *npoinr * 2 * sizeof(double)); if (cooa1==NULL) {printf(" ERREUR cfdf2a : probleme d'allocation memoire\n"); exit(0);} alter_axi1(*iaxi,*npoinr,cooray,cooa1); xnfa1=(double*)malloc(*nelray * 2 * sizeof(double)); if (xnfa1==NULL) {printf(" ERREUR cfdf2a : probleme d'allocation memoire\n"); exit(0);} cnor_2d(*ndim,*nelray,*npoinr,nodray,cooa1,xnfa1); if (*nplasy != 0) { n2=1; if (*nplasy==1){n2=2;} else if (*nplasy==2){n2=4;} /* n2=(int)(pow(2,*nplasy)+0.1); */ nod2=(int*)malloc(n2 * *nelray * 2 * sizeof(int)); coo2=(double*)malloc(n2 * *npoinr * 2 * sizeof(double)); xnf2=(double*)malloc(n2 * *nelray * 2 * sizeof(double)); grconv2=(int*)malloc(n2 * *nelray * sizeof(int)); if (n2==0 || nod2==NULL || coo2==NULL || xnf2==NULL || grconv2==NULL ) {printf(" ERREUR cfdf2a : probleme d'allocation memoire\n"); exit(0);} dupliq2d_sym(*nplasy,plasym, *npoinr,*nelray,nodray,cooa1,xnfa1, &nel2,&npoin2,nod2,coo2,xnf2,grconv,grconv2); } if (*nplasy == 0) { faces_cachees=1;iaxir=2; if (faces_cachees) facforme_2a_fc(*ndim,*npoinr,*nelray,*nelray,nodray,cooa1,xnfa1,fdf,sufray, iaxir,*nplasy,*ndecoup_max,grconv,*nblblr); else facforme_2a_vis(*ndim,*npoinr,*nelray,*nelray,nodray,cooa1,xnfa1,fdf,sufray, iaxir,*nplasy,*ndecoup_max,grconv,*nblblr); } else { /* ca parait douteux : je prefere commenter pour l'instant 21/01/97 cp facecache_2a(*ndim,npoin2,nel2,*nelray,nod2,cooa1,xnfa1,&faces_cachees, *nplasy,*nblblr) ;*/ faces_cachees=1;iaxir=2; if (faces_cachees) facforme_2a_fc(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,fdf,sufray, iaxir,*nplasy,*ndecoup_max,grconv2,*nblblr); else facforme_2a_vis(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,fdf,sufray, iaxir,*nplasy,*ndecoup_max,grconv2,*nblblr); } free(grconv); if (*nplasy != 0) {free(coo2); free(nod2); free(xnf2);free(grconv2); } free(cooa1); free(xnfa1); if(imult) { for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) /= xmult ; xmult *= xmult; for (i=0;i< *nelray ;i++) *(sufray+i) /= xmult; for (i=0 ; i<*nelray*(*nelray+1)/2 ; i++ ) *(fdf+i) /= xmult; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | facforme_2a_vis | | calcul des facteurs de forme en axisymetrique | | pas de faces cachees | |======================================================================| */ void facforme_2a_vis(int ndim, int npoin,int nel2,int nel, int *nod,double *coord,double *xnf,double *fdf,double *sufray, int iaxi,int nplasy,int ndecoup_max,int *grconv,int nblblr) { int i,j,k,npoin2,ns,ideb,n; int noeud[6]; int nbfcoplanaire; double xi[4],yi[4],fforme,l1,l2,d,x1m,y1m,x2m,y2m; double xn1,yn1; double titi1, titi2; int ncomplique; int idec,jdec; double xi_ini[4],yi_ini[4]; double dist12,dist03; double total_fac,pourcent,pourcent_ecrit; int ndecmax; /* Initialisations --------------- */ npoin2 = npoin*2; nbfcoplanaire = 0 ; ncomplique = 0; ndecmax = (int)(pow(2,ndecoup_max) +0.1); for (i=0 ; ipourcent_ecrit) { printf(" %5.2f %% du calcul effectue\n",pourcent_ecrit*100); pourcent_ecrit += 0.2; } xn1 = xnf[i]; yn1 = xnf[i+ nel2]; noeud[0] = nod[i]; noeud[1] = nod[i+ nel2]; for (j=ideb+i ; j-0.1) { nbfcoplanaire += 1; } if (fforme<-1.) { noeud[2] = nod[j]; noeud[3] = nod[j+ nel2]; for (k=0;k<4;k++) { xi_ini[k] = coord[noeud[k]-1]; yi_ini[k] = coord[noeud[k]-1+ npoin]; } fforme=0.; for (idec=0;idec= 11) printf(" fforme negatif ns%d i %d j %d fdf= %f\n",ns,i+1,j+1,1e6*fforme); } else fdf[i*nel-(i+1)*i/2+j%nel] += fforme; /* printf(" facteur de forme i+1 j+1 %d %d %f \n",i+1,j+1,fforme*1e6); */ } } } } } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | facforme_2a_vis | | calcul des facteurs de forme en axisymetrique | | faces cachees | |======================================================================| */ void facforme_2a_fc(int ndim, int npoin,int nel2,int nel, int *nod,double *coord,double *xnf,double *fdf,double *sufray, int iaxi,int nplasy,int ndecoup_max,int *grconv,int nblblr ) { int i,j,k,npoin2,ns,ideb,n,icode; int noeud[6],idec,jdec; int nbfcoplanaire; double xi[4],yi[4],fforme; double xn1,yn1; double l1,l2,d,x1m,y1m,x2m,y2m; double titi1, titi2; double total_fac,pourcent,pourcent_ecrit; double xi_ini[4],yi_ini[4]; double dist12,dist03; int ndecmax; int iaxir ; npoin2 = npoin*2; nbfcoplanaire = 0 ; ndecmax = (int)(pow(2,ndecoup_max) +0.1); for (i=0 ; i=11) printf(" *** FACFORME_2A : ns=%d facette i=%d \n",ns+1,i+1); pourcent=(ns+1)*i/total_fac; if (pourcent>pourcent_ecrit) { printf(" %5.2f %% du calcul effectue\n",pourcent_ecrit*100); pourcent_ecrit += 0.1; } xn1 = xnf[i]; yn1 = xnf[i+ nel2]; noeud[0] = nod[i]; noeud[1] = nod[i+ nel2]; for (j=ideb+i ; j-0.1) { nbfcoplanaire += 1; } if (fforme<-1.) { noeud[2] = nod[j]; noeud[3] = nod[j+ nel2]; for (k=0;k<4;k++) { xi_ini[k] = coord[noeud[k]-1]; yi_ini[k] = coord[noeud[k]-1+ npoin]; } decouphor_2a(iaxi,xi_ini,yi_ini,xn1,yn1,xnf[j],xnf[j+nel2]); fforme=0.; for (idec=0;idec= 11) printf(" fforme negatif ns%d i %d j %d fdf= %f\n",ns,i+1,j+1,1e6*fforme); } else fdf[i*nel-(i+1)*i/2+j%nel] += fforme; /* printf("i+1,j+1 %d %d fdf %f\n",i+1,j+1,fforme*1.e6); */ } } } } } /* for (j=ideb+i ; j ymax || yk_max < ymin || xk_min >= xmax ) { /* printf(" on sort sur ce test yk=%f ymax=%f ymin=%f xkmin=%f xmax=%f\n",yk_min,yk_max,ymin,xk_min,xmax); */ continue; } s1=xn0*xc+yn0*yc+c0; s2=-xnpi*xc+ynpi*yc+cpi; s3=xn0*xd+yn0*yd+c0; s4=-xnpi*xd+ynpi*yd+cpi; if (s1*s3>0 && s2*s4>0 && s1*s2>0 && abs(yj-yi) < 1.e-5) { /* printf(" on sort sur ce test s1=%f s2=%f s3=%f s4=%f \n",s1,s2,s3,s4); */ continue; } if (abs(yi-yj) > 1e-5) quel_angle(ii,jj,xi,yi,xj,yj,xc,yc,xd-xc,yd-yc,&iq1,&iq2); else quel_angle_hide(ii,jj,xi,yi,xj,yj,xc,yc,xd-xc,yd-yc); } ns=0; for (n=0;n0) F += wi[i]*wj[j] *(c13*(t2-t1)-c14*c15*Pi*0.5); else F += wi[i]*wj[j] *(c13*(t2-t1)+c14*c15*Pi*0.5); } *fij=F; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | axi_integ_vis | | calcul du facteur de forme en axi | | (faces cachees algo CP-IR) | |======================================================================| */ void axi_integ_fc (double x[4],double y[4],double *fij) { double c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15; double h,dzi,dzj,dxi,dxj,xi2,xj2,h2,F,t1,t2,li,lj,xi,xj,pisnq; int i,j,ic,nc,couple[nquartier][2],n; dzi=y[1]-y[0]; dxi=x[1]-x[0]; dzj=y[3]-y[2]; dxj=x[3]-x[2]; pisnq=Pi/(nquartier-1); ic=tabint[0]; couple[0][0]=0; if (ic==1) nc=0; else nc=-1; for (i=1;i-0.1) { /* en 0 : ct=1 */ if (ii==jj) { voir0=1; } else if (abs(-v1*(xj-xi)+u1*(zj-zi))<1.e-5) { voir0=1; } else { ct = 1; b=b1+b2; c=c1+c2; d=d1+d2; delta=alpha + beta + gama; voir0=1; if (delta>=0) { aa = a*u1*u1+b*v1*v1; bb=2*a*u0*u1+2*b*v1*v0+c*v1; if (delta==0) rac1=rac2=-0.5*bb/aa; else { sqd=sqrt(delta); rac1=0.5*(-bb-sqd)/aa; rac2=0.5*(-bb+sqd)/aa; } rac= -1e6; if (rac1>=0 && rac1<=1) rac = rac1 ; else if ( rac2>=0 && rac2<=1) rac = rac2 ; if ( rac>=0 && rac<=1) { ratioz = (abs(v0+rac*v1)-zi)/(zj-zi); if (0 <= ratioz && ratioz <= 1.) {voir0=0;tabint[0] = 0 ;} } } } /* en Pi : ct=-1 */ ct = -1; b=b1-b2; c=c1-c2; d=d1-d2; delta=alpha - beta + gama; voirPi=1; if (delta>=0) { aa = a*u1*u1+b*v1*v1; bb=2*a*u0*u1+2*b*v1*v0+c*v1; if (delta==0) rac1=rac2=-0.5*bb/aa; else { sqd=sqrt(delta); rac1=0.5*(-bb-sqd)/aa; rac2=0.5*(-bb+sqd)/aa; } rac = -1e6; if (rac1>=0 && rac1<=1) rac = rac1 ; else if ( rac2>=0 && rac2<=1) rac = rac2 ; if ( rac>=0 && rac<=1) { ratioz = (abs(v0+rac*v1)-zi)/(zj-zi); if (0 < ratioz && ratioz < 1.) {voirPi=0;tabint[nquartier-1] = 0;} } } /* printf("voir0=%d voirPi=%d\n",voir0,voirPi); */ if (voir0==0 && voirPi==0) { /* printf("les facettes ne se voient jamais\n");*/ for(n=0;n=0) { aa = a*u1*u1+b*v1*v1; bb=2*a*u0*u1+2*b*v1*v0+c*v1; if (delta==0) rac1=rac2=-0.5*bb/aa; else { sqd=sqrt(delta); rac1=0.5*(-bb-sqd)/aa; rac2=0.5*(-bb+sqd)/aa; } rac = -1e6; if (rac1>=0 && rac1<=1) rac = rac1 ; else if ( rac2>=0 && rac2<=1) rac = rac2 ; /* printf(" i=%d rac1=%f rac2=%f \n",i,rac1,rac2); */ if ( rac>=0 && rac<=1) { ratioz = (abs(v0+rac*v1)-zi)/(zj-zi); if (0 < ratioz && ratioz < 1.) tabint[i] = 0 ; } } } teta+=dteta; } } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | tab_integ | | mise a jour des indicateurs d'integration | |======================================================================| */ void tab_integ(int iq1,int iq2) { int i; for(i=iq1;i<=iq2;i++) tabint[i]=0; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | derriere | | Detection des segments en arriere et retour d'un code de | | Classement (axisymetrique) | |======================================================================| */ void derriere_2a (int iaxi,int i,int j,double xni0,double yni0,double xnj0,double ynj0, double xi,double yi,double xj,double yj, int *icode) { int n; double xnipi,ynipi,xnjpi,ynjpi,xij0,yij0,xijpi,yijpi; double psi0,psj0,psipi,psjpi,xij,yij,zij,xnj,ynj,znj,psi,psj; double pisnq,t,epsi; epsi=1.e-6; if (i==j) { if (iaxi==2 && xni0>0) {*icode=0; /*printf(" --> face concave\n");*/ } else if (iaxi==1 && yni0>0) {*icode=0; /*printf(" --> face concave\n");*/ } else *icode=1; } else { pisnq=Pi/(nquartier-1); xnipi=-xni0; ynipi=yni0; xnjpi=-xnj0; ynjpi=ynj0; xij0=xj-xi; yij0=yj-yi; xijpi=-xj-xi; yijpi=yj-yi; psi0=xij0*xni0+yij0*yni0; psj0=-(xij0*xnj0+yij0*ynj0); psipi=xijpi*xni0+yijpi*yni0; psjpi=-(xijpi*xnjpi+yijpi*ynjpi); if ((psi0<-epsi || psj0<-epsi) && (psipi<-epsi || psjpi<-epsi)) {*icode=0; /*printf(" --> ne se voient jamais\n");*/} else if (psi0>0 && psipi>0 && psj0>0 && psjpi>0) {*icode=1;/*printf(" --> se voient potentiellement toujours\n");*/} else { *icode=2; for (n=0;n 0 ) {if (zi < v0 || v0+v1 < zi) return ; else test = 1;} else { if (zi < v0+v1 || v0 < zi) return ; test = 1; } if (test == 1) { u = u0 + (zi-v0)/v1*u1; /* en 0 : ct=1 */ if (ii==jj) { voir0=1; } else if (abs(-v1*(xj-xi)+u1*(zj-zi))<1.e-5) { voir0=1; } else { voir0=1; rac1 = (u-xi)/(xj-xi); rac2 = -(u+xi)/(xj-xi); if (rac1>=0 && rac1<=1 || rac2>=0 && rac2<=1) {voir0=0; tabint[0]=0;} } /* en Pi : ct=-1 */ voirPi=1; rac1 = - (u-xi)/(xj+xi); rac2 = (u+xi)/(xj+xi); if (rac1>=0 && rac1<=1 || rac2>=0 && rac2<=1) {voirPi=0; tabint[nquartier-1]=0;} /* printf("voir0=%d voirPi=%d\n",voir0,voirPi); */ if (voir0==0 && voirPi==0) { /* printf("les facettes ne se voient jamais\n");*/ tet[0]=tet[1]=0; for(n=0;n=0) { if (delta==0) rac1=rac2=-0.5*(xi*(xj*ct-xi))/((xj*xj+xi*xi)-2*xj*xi*ct); else { sqd=sqrt(delta); rac1=0.5*(-2*(xi*(xj*ct-xi))-sqd)/((xj*xj+xi*xi)-2*xj*xi*ct); rac2=0.5*(-2*(xi*(xj*ct-xi))+sqd)/((xj*xj+xi*xi)-2*xj*xi*ct); } if (rac1>=0 && rac1<=1 || rac2>=0 && rac2<=1) { tabint[i]=0; if (voir0==1) { if (voirPi==0) {tet[1]=i;for(n=i;n 0 ) { denom = xn_i*(xi_ini[3]-xi_ini[2]) + yn_i *(yi_ini[3]-yi_ini[2]); if ( abs(denom) > eps ) { numer = xn_i*xi_ini[2]+ yn_i*yi_ini[2]+ pland_i ; alfa = - numer/denom - epsd ; xi_ini[3]= xi_ini[2]+ alfa*(xi_ini[3]-xi_ini[2]); yi_ini[3]= yi_ini[2]+ alfa*(yi_ini[3]-yi_ini[2]); } } else { denom = xn_i*(xi_ini[3]-xi_ini[2]) + yn_i *(yi_ini[3]-yi_ini[2]); if ( abs(denom) > eps ) { numer = xn_i*xi_ini[2]+ yn_i*yi_ini[2]+ pland_i ; alfa = - numer/denom + epsd ; xi_ini[2]= xi_ini[2]+ alfa*(xi_ini[3]-xi_ini[2]); yi_ini[2]= yi_ini[2]+ alfa*(yi_ini[3]-yi_ini[2]); } } } else if (abs(xn_j) < epsih && s0*s1 < 0) { if ( s0 > 0 ) { /* deuxieme segment (wilkinson) */ denom = xn_j*(xi_ini[1]-xi_ini[0]) + yn_j *(yi_ini[1]-yi_ini[0]); if ( abs(denom) > eps ) { numer = xn_j*xi_ini[0]+ yn_j*yi_ini[0]+ pland_j ; alfa = - numer/denom - epsd ; xi_ini[1]= xi_ini[0]+ alfa*(xi_ini[1]-xi_ini[0]); yi_ini[1]= yi_ini[0]+ alfa*(yi_ini[1]-yi_ini[0]); } } else { denom = xn_j*(xi_ini[1]-xi_ini[0]) + yn_j *(yi_ini[1]-yi_ini[0]); if ( abs(denom) > eps ) { numer = xn_j*xi_ini[0]+ yn_j*yi_ini[0]+ pland_j ; alfa = - numer/denom + epsd ; xi_ini[0]= xi_ini[0]+ alfa*(xi_ini[1]-xi_ini[0]); yi_ini[0]= yi_ini[0]+ alfa*(yi_ini[1]-yi_ini[0]); } } } else { if (s2*s3 < 0 && xn_i >=0 ) { /* i (transformation wilkinson) j */ if ( s2 > 0 ) { denom = xn_i*(xi_ini[3]-xi_ini[2]) + yn_i *(yi_ini[3]-yi_ini[2]); if ( abs(denom) > eps ) { numer = xn_i*xi_ini[2]+ yn_i*yi_ini[2]+ pland_i ; alfa = - numer/denom - epsd ; xi_ini[3]= xi_ini[2]+ alfa*(xi_ini[3]-xi_ini[2]); yi_ini[3]= yi_ini[2]+ alfa*(yi_ini[3]-yi_ini[2]); } } else { denom = xn_i*(xi_ini[3]-xi_ini[2]) + yn_i *(yi_ini[3]-yi_ini[2]); if ( abs(denom) > eps ) { numer = xn_i*xi_ini[2]+ yn_i*yi_ini[2]+ pland_i ; alfa = - numer/denom + epsd ; xi_ini[2]= xi_ini[2]+ alfa*(xi_ini[3]-xi_ini[2]); yi_ini[2]= yi_ini[2]+ alfa*(yi_ini[3]-yi_ini[2]); } } } else if (s0*s1 < 0 && xn_j >=0 ) { if ( s0 > 0 ) { denom = xn_j*(xi_ini[1]-xi_ini[0]) + yn_j *(yi_ini[1]-yi_ini[0]); if ( abs(denom) > eps ) { numer = xn_j*xi_ini[0]+ yn_j*yi_ini[0]+ pland_j ; alfa = - numer/denom - epsd ; xi_ini[1]= xi_ini[0]+ alfa*(xi_ini[1]-xi_ini[0]); yi_ini[1]= yi_ini[0]+ alfa*(yi_ini[1]-yi_ini[0]); } } else { denom = xn_j*(xi_ini[1]-xi_ini[0]) + yn_j *(yi_ini[1]-yi_ini[0]); if ( abs(denom) > eps ) { numer = xn_j*xi_ini[0]+ yn_j*yi_ini[0]+ pland_j ; alfa = - numer/denom + epsd ; xi_ini[0]= xi_ini[0]+ alfa*(xi_ini[1]-xi_ini[0]); yi_ini[0]= yi_ini[0]+ alfa*(yi_ini[1]-yi_ini[0]); } } } } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | alter_axi1 | | alteration des coordonnees | | | |======================================================================| */ void alter_axi1(int iaxi, int npoinr, double *cooini , double *cooalt) { int i; double ymini ; ymini = 10000.; if (iaxi==1) { for (i=0;i= cooalt[i+npoinr]) ymini = cooalt[i+npoinr]; } if (ymini <= 0.) /* on decalle de ymini */ { for (i=0;i "',A,'"') C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ecrg1r.F0000666000175000017500000001726111524070643015244 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ECRG1R,SSI=0 C SUBROUTINE ECRG1R C ***************** C C ------------------------------------------------- *( NFIC,NDIM,NDIELE,NPOINR,NELRAY,NBNODE, * COORAY,NODRAY,NRFRAY) C ------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C GENERATION DU FICHIER GEOMETRIQUE POUR GRAFN3S * C (destine uniquement au rayonnement) * C Triangle a 3 noeuds * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (LOCAL) ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS DU MAILLAGE ! C ! ! ! ! 1 -> segment ! C ! ! ! ! 2 -> triangle ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NELRAY ! E ! D ! NOMBRE D'ELEMENTS DU MAILLAGE ! C ! NBNODE ! L ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! COORAY ! TR ! ! TABLE DES COORDONNEES ! C ! NODRAY ! TE ! M ! CONNECTIVITE DU MAILLAGE ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" C C********************************************************************** C.. Variables externes INTEGER NDIM,NDIELE,NPOINR,NELRAY,NBNODE INTEGER NODRAY(NELRAY,NBNODE),NRFRAY(NELRAY),NFIC DOUBLE PRECISION COORAY(NPOINR,NDIM) C C.. Variables internes INTEGER N,I,NNSOM,NG,ICOUL DOUBLE PRECISION XTCL C C********************************************************************** C C 0- INITIALISATIONS ET TRI DES NOEUDS C ==================================== C C 0.1- Initialisations C -------------------- C XTCL = 0 ICOUL = 0 C C 0.2- differentiation des noeuds milieux et des noeuds sommets C ------------------------------------------------------------- C IF (NDIELE.EQ.1) THEN NNSOM = 2 ELSEIF (NDIELE.EQ.2) THEN NNSOM = 3 ELSE WRITE(NFECRA,999) STOP ENDIF C C C 1- ENTETE DU FICHIER (EN COMMENTAIRES) C ====================================== WRITE(NFIC,1100) WRITE(NFIC,1110) NDIM,NDIELE,NPOINR,NELRAY,NBNODE C C C 2- ECRITURE DE LA TABLE DES NOEUDS C ================================== C WRITE(NFIC,2000) C DO 209 NG = 1,NPOINR DO 210 I = 1,NDIM IF (ABS(COORAY(NG,I)) .LE. 1.E-10) COORAY(NG,I) = 0.D0 210 CONTINUE 209 CONTINUE C IF (NDIM.EQ.2) THEN C DO 211 N=1,NPOINR WRITE(NFIC,2100) & N,ICOUL,(COORAY(N,I),I=1,2),XTCL 211 CONTINUE C ELSEIF (NDIM.EQ.3) THEN C DO 212 N=1,NPOINR WRITE(NFIC,2100) & N,ICOUL,(COORAY(N,I),I=1,3) 212 CONTINUE C ENDIF C 200 CONTINUE C C C 3- ECRITURE DE LA TABLE DES ELEMENTS C ==================================== C WRITE(NFIC,3000) C C C 3.1- Segements a 2 noeuds C ------------------------- IF (NDIELE.EQ.1 .AND. NBNODE.EQ.2) THEN DO 310 N=1,NELRAY WRITE(NFIC,3100) N,NRFRAY(N),(NODRAY(N,I),I=1,2) 310 CONTINUE C 3.2- Triangles a 3 noeuds C ------------------------- ELSEIF (NDIELE.EQ.2 .AND. NBNODE.EQ.3) THEN DO 320 N=1,NELRAY WRITE(NFIC,3200) N,NRFRAY(N),(NODRAY(N,I),I=1,3) 320 CONTINUE C C 3.3- Elements inconnus C ---------------------- ELSE WRITE(NFECRA,3300) STOP C ENDIF C CALL FLUSHF(NFIC) C C-------- C FORMATS C-------- C 999 FORMAT(' %% ERREUR ECRG1R : la dimension des elements (NDIELE)', & ' est incorrecte') 1100 FORMAT( & 'C************************************************C',/, & 'C FICHIER GEOMETRIQUE SYRTHES - Rayonnement - C',/, & 'C************************************************C') 1110 FORMAT( & 'C DIMENSION = ',I1,' DIMENSION DES ELTS = ',I1,/, & 'C NOMBRE DE NOEUDS = ',I10,/, & 'C NOMBRE D''ELEMENTS =',I10,/, & 'C NOMBRE DE NOEUDS PAR ELEMENT = ',I3,/, & 'C************************************************C') C 2000 FORMAT('C',/,'C$ RUBRIQUE = NOEUDS',/,'C') 2100 FORMAT(I10,I3,1X,3(E14.7,1X)) C 3000 FORMAT('C',/,'C$ RUBRIQUE = ELEMENTS',/,'C') 3100 FORMAT(I10,I3,2I10) 3200 FORMAT(I10,I3,3I10) 3300 FORMAT(/,' %% ECRG1R : TYPE D''ELEMENTS INCONNUS') C C END syrthes-3.4.3-dfsg1/src/s/ccomst.F0000666000175000017500000001634211524070643015350 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCOMST C ***************** C * ( VALEQ,NELRAY,NRFRAY,NFMST,PHMSTP,PHMSTO,NGFMST,IREF,NB,MODE ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C Programme valable pour le conditions physiques * C equivalente couple au fluide * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNE ! C ! NFCFRA ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! PHFRAF ! TR ! R ! PROPRIETES PHYSIQUES EQUIVQLENTE K,E,T,H ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIR C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" #include "rayonn.h" C C********************************************************************** C C..Variables externes INTEGER NELRAY,NB,NFMST,MODE INTEGER NRFRAY(NELRAY),IREF(NRFMAX),NGFMST(NFMST,2) DOUBLE PRECISION VALEQ(6),PHMSTP(NFMST,4),PHMSTO(NFMST,5,NBANDE) C C..Variables internes INTEGER N,N1,NR,NBRE,NUMREF,NBAN C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C IF (MODE.EQ.1) THEN C C 1.1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN DO N=1,NFMST PHMSTP(N,1) = VALEQ(1) PHMSTP(N,2) = VALEQ(2) PHMSTP(N,3) = VALEQ(3) PHMSTP(N,4) = VALEQ(4) NBRE = NBRE + 1 ENDDO C ELSE C C 1.2- Application de la condition aux references citees C ---------------------------------------------------- DO N1=1,NB NR = IREF(N1) DO N=1,NFMST NUMREF = NRFRAY(NGFMST(N,1)) IF (NUMREF .EQ. NR) THEN PHMSTP(N,1) = VALEQ(1) PHMSTP(N,2) = VALEQ(2) PHMSTP(N,3) = VALEQ(3) PHMSTP(N,4) = VALEQ(4) NBRE = NBRE + 1 ENDIF ENDDO ENDDO C ENDIF C C C 1.3- Impressions de controle C -------------------------- IF (NBLBLR.EQ.10) WRITE(NFECRA,1000) NBRE C ELSE C C 2.1- Cas ou la condition s'applique sur tous les noeuds C ------------------------------------------------------- NBAN=INT(VALEQ(1)+0.1) C IF (IREF(1) .EQ. -1 ) THEN DO N=1,NFMST PHMSTO(N,1,NBAN) = VALEQ(2) PHMSTO(N,2,NBAN) = VALEQ(3) PHMSTO(N,3,NBAN) = VALEQ(4) PHMSTO(N,4,NBAN) = VALEQ(5) PHMSTO(N,5,NBAN) = VALEQ(6) NBRE = NBRE + 1 ENDDO C ELSE C C 2.2- Application de la condition aux references citees C ------------------------------------------------------ DO N1=1,NB NR = IREF(N1) DO N=1,NFMST NUMREF = NRFRAY(NGFMST(N,1)) IF (NUMREF .EQ. NR) THEN PHMSTO(N,1,NBAN) = VALEQ(2) PHMSTO(N,2,NBAN) = VALEQ(3) PHMSTO(N,3,NBAN) = VALEQ(4) PHMSTO(N,4,NBAN) = VALEQ(5) PHMSTO(N,5,NBAN) = VALEQ(6) NBRE = NBRE + 1 ENDIF ENDDO ENDDO C ENDIF C C 1.3- Impressions de controle C -------------------------- IF (NBLBLR.GE.10) WRITE(NFECRA,1000) NBRE C ENDIF C C-------- C FORMATS C-------- 1000 FORMAT(' CCOMST : Rayonnement - Nombre de faces traitees', * ' de type milieu semi-transparent solide',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/lecsi2.F0000666000175000017500000003123611524070643015240 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECSI2 C ***************** C C -------------------------------------------------------------- *(NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN,IREF,INOEUD,IFACE,IELT, * NT5,IT5) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE SIMAIL * C (Necessaire pour les dimensionnements de tableaux) * C * C Modifications par Y. Fournier pour prendre en compte * C les aspects binaires Linux * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "mobil.h" #include "nlofct.h" #include "divct.h" #include "optct.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN,NT5 INTEGER IREF(NPOINS),INOEUD(NELEMS*NN),IFACE(NELEMS*NBFACE) INTEGER IELT(NELEMS),IT5(NT5) C C.. Variables internes INTEGER NDIMEF,NDSR,NDSD,NCOPNP INTEGER I,J,M(32),NU(10) INTEGER LE,L,NTRI,NTET,NT3 INTEGER NBFAC,NBARET,NBSOM,IDEB,NNO,NPO,INING,NUMREF INTEGER IDEBE,NMAE,NDSDE LOGICAL ERR C CHARACTER*4 CHAR4 INTEGER NFSISY(4) #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C numerotation des faces d'un tetraedre dans SIMAIL : C face 1 : 1 3 2 C face 2 : 1 4 3 C face 3 : 1 2 4 C face 4 : 2 3 4 C*********************************************************************** C DATA NFSISY /1,3,2,4/ C C 0- INITIALISATIONS C ================== IF (NDIELE.EQ.2) THEN NBFAC=0 NBARET=3 NBSOM=3 NN=6 ELSE NBFAC=4 NBARET=6 NBSOM=4 NN=10 ENDIF C #ifdef HAVE_C_IO CALL REWDBF (NFSGCT, IERROR) IF (IERROR .NE. 0) GOTO 998 #else REWIND (NFSGCT) #endif C C 1- LECTURE DE L'ENREGISTREMENT AVANT LE TABLEAU 0 C ================================================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 #else READ(NFSGCT,ERR=999) LE #endif C C Lecture du tableau "-1" #ifdef HAVE_C_IO CALL REWDBF (NFSGCT, IERROR) IF (IERROR .NE. 0) GOTO 998 NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, L, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else REWIND (NFSGCT) READ (NFSGCT,ERR=999) L, (M(I), I=1,LE) #endif NT3=M(5) C C 2- LECTURE DU TABLEAU 0 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGCT,ERR=999) LE, (M(I), I=1,LE) #endif C C 3- LECTURE DU TABLEAU 2 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGCT,ERR=999) LE,(M(I),I=1,LE) #endif C NDIMEF = M(1) NDSR = M(2) NDSD = M(3) NCOPNP = M(4) NELEMS = M(5) NTRI = M(8) NTET = M(10) NPOINS = M(15) NPSSP1 = M(22) C C 5- LECTURE DES TABLEAUX 3, 4 ET 5 C ================================= C C 5.0- Tableau 3 C -------------- #ifdef HAVE_C_IO IF (NT3.GT.0) THEN NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF ENDIF #else IF (NT3.GT.0) READ(NFSGCT,ERR=999) LE #endif C 5.1- Tableau 4 C -------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGCT,ERR=999) LE #endif C C 5.2- Tableau 5 C -------------- C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, IT5, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGCT,ERR=999) LE,(IT5(I), I=1,LE) #endif C C 5.3- Decryptage des references des noeuds C ----------------------------------------- C C IDEB = 0 C DO 530 I=1,NELEMS C IDEBE = IDEB C NMAE = IT5(IDEB+2) C NDSDE = IT5(IDEB+3) IELT(I) = NDSDE C En coque, ce numero sert de reference de face IF (NCTHFS.EQ.2) IFACE(I) = NDSDE C NNO = IT5(IDEB+4) DO 535 J=1,NNO NU(J) = IT5(IDEB+4+J) INOEUD((J-1)*NELEMS+I) = IT5(IDEB+4+J) 535 CONTINUE NPO = IT5(IDEB + 4 + NNO + 1) C IF (NMAE.EQ.0) THEN IDEB = IDEB + 4 + NNO + 1 + NPO ELSE INING = IT5(IDEB + 4 + NNO + 1 + NPO + 1) IDEB = IDEB + 4 + NNO + 1 + NPO + 1 C IF (INING.EQ.1 .AND. NDIELE.EQ.3) THEN DO 536 J=1,NBFAC IFACE((NFSISY(J)-1)*NELEMS+I) = IT5(IDEB + J) 536 CONTINUE ENDIF IF (INING.EQ.1) IDEB = IDEB + NBFAC C IF (INING.LE.2) THEN DO 532 J=1,NBARET NUMREF = IT5(IDEB+J) IREF(NU(NBSOM+J)) = NUMREF IF (NDIELE.EQ.2 .AND. NCTHFS.NE.2) & IFACE((J-1)*NELEMS+I) = NUMREF 532 CONTINUE IDEB = IDEB + NBARET ENDIF C IF (INING.LE.3) THEN DO 534 J=1,NBSOM NUMREF = IT5(IDEB+J) IREF(NU(J)) = NUMREF 534 CONTINUE IDEB = IDEB + NBSOM ENDIF C ENDIF C 530 CONTINUE C C RETURN #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #else 999 CONTINUE WRITE(NFECRA,9999) STOP #endif C C-------- C FORMATS C-------- C 1000 FORMAT(' %% ERREUR LECSI2 : LE FICHIER NE CONTIENT PAS UNE S.D.', & ' DE MAILLAGE ') 1018 FORMAT(' %% ERREUR LECSI2 : DIMENSION DES MAILLAGES ', & 'INCOMPATIBLES') 1020 FORMAT(' %% ERREUR LECSI2 : NUMERO(S) DE REFERENCES > 32') 1021 FORMAT(' %% ERREUR LECSI2 : NUMERO(S) DE SOUS-DOMAINES > 16') 1022 FORMAT(' %% ERREUR LECSI2 : LE MAILLAGE NE POSSEDE PAS DE' & ,' NOEUDS MILIEUX') 1023 FORMAT(' %% ERREUR LECSI2 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES') C 3000 FORMAT(/,'%% ERREUR LECSI2 : LA DIMENSION DU TABLEAU DES ENTIERS', & ' EST INSUFFISANTE ',/, & ' IL FAUT AU MINIMUM ',I9,' ENTIERS ') 3010 FORMAT(/,'%% ERREUR LECSI2 : LA DIMENSION DU TABLEAU DES REELS', & ' EST INSUFFISANTE ',/, & ' IL FAUT AU MINIMUM ',I9,' REELS ') C 7010 FORMAT(/,'%% ERREUR LECSI2 : ERREUR DE MAILLAGE',/, & 20X,'En modele coque, toute la coque doit etre couplee ', & 'au fluide',/, & 20X,'Ici, la coque comporte ',I9,' elements',/, & 20X,'Il y en a ',I9,' de declares couples') 7020 FORMAT(/,'%% ERREUR LECSI2 : ERREUR DE MAILLAGE',/, & 20X,'En modele coque, toute la coque doit etre couplee ', & 'au fluide',/, & 20X,'Ici, la coque comporte ',I9,' noeuds',/, & 20X,'Il y en a ',I9,' de declares couples') #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LECSI2 : erreur de lecture du maillage ', * ' solide',/,' de type : ',A) #else 9999 FORMAT(' %% ERREUR LECSI2 : erreur de lecture du maillage ', * ' solide') #endif C END syrthes-3.4.3-dfsg1/src/s/corresp.c0000666000175000017500000013263111524070643015572 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" #define N64 128 /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | coroct | | Gestion du calcul des correspondants en dimension 3 | |======================================================================| */ proc(void coroct,void COROCT) (int *ndim,int *npoins,int *neless,int *ndmass,int *nelesf, int *ndmasf,int *nbcous,int *nbcouf,double *coords, int *nodess,double *coordf,int *nodesf,double *baryf, int *ncborf,double *barys,int *ncbors,int *ncoups, int *nbicor,int *nblbla,double *d2maxf,double *dmax_util, double *trav1, double *trav2) { int i,n,npf,nps,ng,nlonv,nbcouf2,nbcous2,npoins2,neless2,nelesf2,num; int nelmin,n1min,n2min,n3min,n4min,n5min,n6min,numtri,nm,npfpb,npspb; int ntabel[N64],na[N64],nb[N64],nc[N64],icode[N64],lco[N64]; double xa[N64],xb[N64],xc[N64],ya[N64],yb[N64],yc[N64]; double za[N64],zb[N64],zc[N64]; int n1,n2,n3,n4,n5,n6,nonc,nb_passage; int *nodessg,nbhisto,*thisto; double vmin,interv; double x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,x5,y5,z5,x6,y6,z6; double dim_boite[6],xp1,yp1,zp1,dm,xm,ym,zm,dmin,xmin,ymin,zmin; double b1,b2,b3,size_min,dist_max,*distance,dist_moy,dist_var; struct element *fa; struct node *arbre,*noeud; nonc=0; for (n=0;n<*nbcouf* *ndim;n++) baryf[n]=0; for (n=0;n<*nbcous* *ndim;n++) barys[n]=0; nbcouf2=*nbcouf*2; nbcous2=*nbcous*2; npoins2=*npoins*2; neless2=*neless*2; nelesf2=*nelesf*2; boite2(*ndim,*npoins,coords,*nbcouf,coordf,dim_boite); size_min = 1.E8; arbre= (struct node *)malloc(sizeof(struct node)); if (arbre==NULL) {printf(" ERREUR coroct : probleme d'allocation memoire\n"); exit(0);} nodessg= (int *)malloc(*neless* *ndmass * sizeof(int)); if (nodessg==NULL) {printf(" ERREUR coroct : probleme d'allocation memoire\n"); exit(0);} for (nps=0 ; nps < *neless* *ndmass ; nps++ ) nodessg[nps]=ncoups[nodess[nps]-1]; build_octree (arbre,*ndim,*npoins,*neless,nodessg,coords,&size_min,dim_boite); free(nodessg); /* affiche_tree(arbre,8); */ printf("\n *** COROCT : Calcul des correspondants des noeuds fluides \n"); dist_max=0; dist_moy=0; dist_var=0; npfpb=0; distance= (double *)malloc(*nbcouf*sizeof(double)); if (distance==NULL) {printf(" ERREUR coroct : probleme d'allocation memoire\n"); exit(0);} for (npf=0 ; npf < *nbcouf ; npf++ ) trav1[npf]=0; for (npf=0 ; npf < *nbcouf ; npf++ ) /*--------------------------------*/ { dmin=1.e6; xmin=ymin=zmin=0; nelmin=1; n1min=n2min=n3min=n4min=n5min=0; nm=1; xm=ym=zm=0; dm=1.e6; xp1=coordf[npf]; yp1=coordf[npf+ *nbcouf]; zp1=coordf[npf+nbcouf2]; noeud=arbre; find_node_3d (&noeud,xp1,yp1,zp1); fa = noeud->lelement; if (fa==NULL) {noeud=arbre;fa = noeud->lelement;} nb_passage=1; onrecommence: while (fa != NULL) { nlonv=0; while (fa!=NULL && nlonvnum;nlonv+=1;fa=fa->suivant;} for (i=0;i*dmax_util && nb_passage==1) { noeud=arbre; fa = noeud->lelement; nb_passage++; goto onrecommence; } else if (dmin>99999. && nb_passage>1) { printf(" Pas de correspondant, noeud fluide %d de coord %f %f %f\n",npf+1,xp1,yp1,zp1); npfpb++; continue; } if (dmin>dist_max) dist_max=dmin; trav1[npf]=dmin; n1min=nodess[nelmin-1]; n2min=nodess[nelmin-1+ *neless]; n3min=nodess[nelmin-1+ *neless*2]; n4min=nodess[nelmin-1+ *neless*3]; n5min=nodess[nelmin-1+ *neless*4]; n6min=nodess[nelmin-1+ *neless*5]; n1=ncoups[n1min-1]; x1=coords[n1-1]; y1=coords[n1-1+ *npoins]; z1=coords[n1-1 +npoins2]; n2=ncoups[n2min-1]; x2=coords[n2-1]; y2=coords[n2-1+ *npoins]; z2=coords[n2-1 +npoins2]; n3=ncoups[n3min-1]; x3=coords[n3-1]; y3=coords[n3-1+ *npoins]; z3=coords[n3-1 +npoins2]; n4=ncoups[n4min-1]; x4=coords[n4-1]; y4=coords[n4-1+ *npoins]; z4=coords[n4-1 +npoins2]; n5=ncoups[n5min-1]; x5=coords[n5-1]; y5=coords[n5-1+ *npoins]; z5=coords[n5-1 +npoins2]; n6=ncoups[n6min-1]; x6=coords[n6-1]; y6=coords[n6-1+ *npoins]; z6=coords[n6-1 +npoins2]; proc(soutri,SOUTRI)(xmin,ymin,zmin, x4,y4,z4, x5,y5,z5, x6,y6,z6, &numtri); if (numtri==1) bary3d (xmin,ymin,zmin,x1,y1,z1, x4,y4,z4, x6,y6,z6,&b1,&b2,&b3); else if (numtri==2) bary3d (xmin,ymin,zmin,x4,y4,z4, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); else if (numtri==3) bary3d (xmin,ymin,zmin,x2,y2,z2, x4,y4,z4, x5,y5,z5,&b1,&b2,&b3); else if (numtri==4) bary3d (xmin,ymin,zmin,x3,y3,z3, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); baryf[npf]=b1; baryf[npf+ *nbcouf]=b2; baryf[npf+ nbcouf2]=b3; ncborf[npf]=nelmin; ncborf[npf+ *nbcouf]=numtri; distance[npf]=dmin; dist_moy+=dmin; dist_var+=(dmin*dmin); if (*nblbla==15) { printf("\n NOEUD FLUIDE : %6d coordonnees : %10.3f %10.3f %10.3f\n",npf+1,xp1,yp1,zp1); printf(" CORRESPONDANT SOLIDE :\n"); printf(" numero du triangle solide : %6d\n",nelmin); printf(" noeuds : %6d %6d %6d\n",n1,n2,n3); printf(" numero du sous-triangle : %6d\n",numtri); printf(" coord du correspondant : %10.3f %10.3f %10.3f\n",xmin,ymin,zmin); printf(" distance minimale :%10.3f\n",dmin); printf(" coord barycentriques : %10.3f %10.3f %10.3f\n",b1,b2,b3); } } if (npfpb) { printf("\n %%%% ERREUR COROCT : %d points du maillage fluide n'ont pas de correspondant\n",npfpb); printf(" sur le maillage solide \n"); printf(" Verifier les references et le fichier de donnees\n"); exit(0); } dist_moy /= *nbcouf; dist_var= dist_var/ *nbcouf-(dist_moy*dist_moy); printf("\n Distance de correspondance\n"); printf(" - maximale : %12.5e\n",dist_max); printf(" - moyenne : %12.5e\n",dist_moy); printf(" - variance : %12.5e\n",dist_var); tuer_tree(arbre,8); free(arbre); vmin=0; nbhisto=10; interv=dist_max/(nbhisto); thisto=(int *)malloc(nbhisto*sizeof(int)); if (thisto==NULL) {printf(" ERREUR coroct : probleme d'allocation memoire\n"); exit(0);} histog (*nbcouf,distance,vmin,dist_max,thisto,nbhisto); printf(" Histogramme de la distance (nombre de points=%5d)\n",*nbcouf); printf(" Intervalle nb_points Pourcentage\n"); for (i=0;ilelement; if (fa==NULL) {noeud=arbre;fa = noeud->lelement;} nb_passage=1; onrecommence2: while (fa != NULL) { nlonv=0; while (fa!=NULL && nlonvnum;nlonv+=1;fa=fa->suivant;} for (i=0;i*dmax_util && nb_passage==1) { noeud=arbre; fa = noeud->lelement; nb_passage++; goto onrecommence2; } else if (dmin>99999. && nb_passage>1) { printf(" Pas de correspondant, noeud solide %d de coord %f %f %f\n",ng,xp1,yp1,zp1); npspb++; continue; } if (dmin>dist_max) dist_max=dmin; if (dmin>*d2maxf) {nonc++; ncbors[nps] = -1; continue;} trav2[ng-1]=dmin; n1min=nodesf[nelmin-1]; n2min=nodesf[nelmin-1+ *nelesf]; n3min=nodesf[nelmin-1+ *nelesf*2]; x1=coordf[n1min-1]; y1=coordf[n1min-1+ *nbcouf]; z1=coordf[n1min-1 +nbcouf2]; x2=coordf[n2min-1]; y2=coordf[n2min-1+ *nbcouf]; z2=coordf[n2min-1 +nbcouf2]; x3=coordf[n3min-1]; y3=coordf[n3min-1+ *nbcouf]; z3=coordf[n3min-1 +nbcouf2]; /* if (*ndmasf==6 && nodess[nelmin-1+ *nelesf*3]!=0) a eliminer vraissemblablement */ if (*ndmasf==6) { n4min=nodesf[nelmin-1+ *nelesf*3]; n5min=nodesf[nelmin-1+ *nelesf*4]; n6min=nodesf[nelmin-1+ *nelesf*5]; x4=coordf[n4min-1]; y4=coordf[n4min-1+ *nbcouf]; z4=coordf[n4min-1 +nbcouf2]; x5=coordf[n5min-1]; y5=coordf[n5min-1+ *nbcouf]; z5=coordf[n5min-1 +nbcouf2]; x6=coordf[n6min-1]; y6=coordf[n6min-1+ *nbcouf]; z6=coordf[n6min-1 +nbcouf2]; proc(soutri,SOUTRI)(xmin,ymin,zmin, x4,y4,z4, x5,y5,z5, x6,y6,z6, &numtri); if (numtri==1) bary3d (xmin,ymin,zmin,x1,y1,z1, x4,y4,z4, x6,y6,z6,&b1,&b2,&b3); else if (numtri==2) bary3d (xmin,ymin,zmin,x4,y4,z4, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); else if (numtri==3) bary3d (xmin,ymin,zmin,x2,y2,z2, x4,y4,z4, x5,y5,z5,&b1,&b2,&b3); else if (numtri==4) bary3d (xmin,ymin,zmin,x3,y3,z3, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); barys[nps]=b1; barys[nps+ *nbcous]=b2; barys[nps+ nbcous2]=b3; } else { numtri = 0; bary3d (xmin,ymin,zmin,x1,y1,z1, x2,y2,z2, x3,y3,z3,&b1,&b2,&b3); barys[nps]=b1; barys[nps+ *nbcous]=b2; barys[nps+ nbcous2]=b3; } ncbors[nps]=nelmin; ncbors[nps+ *nbcous]=numtri; distance[nps]=dmin; dist_moy+=dmin; dist_var+=(dmin*dmin); if (*nblbla==15) { printf("\n NOEUD SOLIDE : %6d coordonnees : %10.3f %10.3f %10.3f\n",ng,xp1,yp1,zp1); printf(" CORRESPONDANT FLUIDE :\n"); printf(" numero du triangle fluide : %6d\n",nelmin); printf(" noeuds : %6d %6d %6d\n",n1min,n2min,n3min); printf(" numero du sous-triangle : %6d\n",numtri); printf(" coord du correspondant : %10.3f %10.3f %10.3f\n",xmin,ymin,zmin); printf(" distance minimale :%10.3f\n",dmin); printf(" coord barycentriques : %10.3f %10.3f %10.3f\n",b1,b2,b3); } } if (*nblbla==15) { printf(" *** COROCT :\n"); printf(" Nombre de noeuds solides candidats au couplage %d\n",*nbcous); printf(" Nombre de noeuds elimines du couplage %d\n",*nbcous); } if (npspb) { printf("\n %%%% ERREUR COROCT : %d points du maillage solide n'ont pas de correspondant\n",nps); printf(" sur le maillage fluide \n"); printf(" Verifier les references et le fichier de donnees\n"); exit(0); } dist_moy /= *nbcous; dist_var= dist_var/ *nbcous-(dist_moy*dist_moy); printf("\n Distance de correspondance\n"); printf(" - maximale : %12.5e\n",dist_max); printf(" - moyenne : %12.5e\n",dist_moy); printf(" - variance : %12.5e\n",dist_var); tuer_tree(arbre,8); free(arbre); vmin=0; nbhisto=10; interv=dist_max/(nbhisto); thisto=(int *)malloc(nbhisto*sizeof(int)); if (thisto==NULL) {printf(" ERREUR coroct : probleme d'allocation memoire\n"); exit(0);} histog (*nbcous,distance,vmin,dist_max,thisto,nbhisto); printf(" Histogramme de la distance (nombre de points=%5d)\n",*nbcous); printf(" Intervalle nb_points Pourcentage\n"); for (i=0;ilelement; if (fa==NULL) {noeud=arbre;fa = noeud->lelement;} while (fa != NULL) { nlonv=0; while (fa!=NULL && nlonvnum;nlonv+=1;fa=fa->suivant;} for (i=0;i99999.) {printf(" Pas de correspondant, noeud rayonnement %d\n",ngg+1); continue;} if (dmin>dist_max) dist_max=dmin; trav2[ngg]=dmin; if (*indglo==1) { n1min=nglob1[nod1[nelmin-1]-1]; n2min=nglob1[nod1[nelmin-1+ *nel1]-1]; n3min=nglob1[nod1[nelmin-1+ *nel1*2]-1]; } else { n1min=nod1[nelmin-1]; n2min=nod1[nelmin-1+ *nel1]; n3min=nod1[nelmin-1+ nel12]; } x1=coor1[n1min-1]; y1=coor1[n1min-1+ *np1]; z1=coor1[n1min-1 +np12]; x2=coor1[n2min-1]; y2=coor1[n2min-1+ *np1]; z2=coor1[n2min-1 +np12]; x3=coor1[n3min-1]; y3=coor1[n3min-1+ *np1]; z3=coor1[n3min-1 +np12]; if (*ndma1==6) { if (*indglo==1) { n4min=nglob1[nod1[nelmin-1+ *nel1*3]-1]; n5min=nglob1[nod1[nelmin-1+ *nel1*4]-1]; n6min=nglob1[nod1[nelmin-1+ *nel1*5]-1]; } else { n4min=nod1[nelmin-1+ *nel1*3]; n5min=nod1[nelmin-1+ *nel1*4]; n6min=nod1[nelmin-1+ *nel1*5]; } x4=coor1[n4min-1]; y4=coor1[n4min-1+ *np1]; z4=coor1[n4min-1 +np12]; x5=coor1[n5min-1]; y5=coor1[n5min-1+ *np1]; z5=coor1[n5min-1 +np12]; x6=coor1[n6min-1]; y6=coor1[n6min-1+ *np1]; z6=coor1[n6min-1 +np12]; proc(soutri,SOUTRI)(xmin,ymin,zmin, x4,y4,z4, x5,y5,z5, x6,y6,z6, &numtri); if (numtri==1) bary3d (xmin,ymin,zmin,x1,y1,z1, x4,y4,z4, x6,y6,z6,&b1,&b2,&b3); else if (numtri==2) bary3d (xmin,ymin,zmin,x4,y4,z4, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); else if (numtri==3) bary3d (xmin,ymin,zmin,x2,y2,z2, x4,y4,z4, x5,y5,z5,&b1,&b2,&b3); else if (numtri==4) bary3d (xmin,ymin,zmin,x3,y3,z3, x5,y5,z5, x6,y6,z6,&b1,&b2,&b3); } else { numtri=0; bary3d (xmin,ymin,zmin,x1,y1,z1, x2,y2,z2, x3,y3,z3,&b1,&b2,&b3); } bary2[ng]=b1; bary2[ng+ *ngl2]=b2; bary2[ng+ ngl22]=b3; nc2[ng]=nelmin; nc2[ng+ *ngl2]=numtri; distance[ng]=dmin; dist_moy+=dmin; dist_var+=(dmin*dmin); if (*nblbla==16) { printf("\n NOEUD GROSSIER : %6d coordonnees : %10.3f %10.3f %10.3f\n",ng+1,xp1,yp1,zp1); printf(" CORRESPONDANT FIN :\n"); printf(" numero du triangle fin : %6d\n",nelmin); printf(" noeuds : %6d %6d %6d\n",n1min,n2min,n3min); printf(" numero du sous-triangle : %6d\n",numtri); printf(" coord du correspondant : %10.3f %10.3f %10.3f\n",xmin,ymin,zmin); printf(" distance minimale :%10.3f\n",dmin); printf(" coord barycentriques : %10.3f %10.3f %10.3f\n",b1,b2,b3); } } if (dist_max>99999.) { printf("\n %%%% ERREUR CRROCT : des points du maillage de rayonnement n'ont pas de correspondant\n"); printf(" sur le maillage fin \n"); printf(" Verifier les references et le fichier de donnees\n"); exit(0); } dist_moy /= *ngl2; dist_var= dist_var/ *ngl2-(dist_moy*dist_moy); printf("\n Distance de correspondance\n"); printf(" - maximale : %12.5e\n",dist_max); printf(" - moyenne : %12.5e\n",dist_moy); printf(" - variance : %12.5e\n",dist_var); tuer_tree(arbre,8); vmin=0; nbhisto=10; interv=dist_max/(nbhisto); thisto=(int *)malloc(nbhisto*sizeof(int)); if (thisto==NULL) {printf(" ERREUR crroct : probleme d'allocation memoire\n"); exit(0);} histog (*ngl2,distance,vmin,dist_max,thisto,nbhisto); printf(" Histogramme de la distance (nombre de points=%5d)\n",*ngl2); printf(" Intervalle nb_points Pourcentage\n"); for (i=0;ilelement; if (fa==NULL) {noeud=arbre;fa = noeud->lelement;} while (fa != NULL) { nlonv=0; while (fa!=NULL && nlonvnum;nlonv+=1;fa=fa->suivant;} for (i=0;i99999.) {printf(" Pas de correspondant, noeud fin %d\n",nff+1); continue;} if (dmin>dist_max) dist_max=dmin; trav1[nff]=dmin; n1min=nod2[nelmin-1]; n2min=nod2[nelmin-1+ *nel2]; n3min=nod2[nelmin-1+ *nel2*2]; x1=coor2[n1min-1]; y1=coor2[n1min-1+ *np2]; z1=coor2[n1min-1 +np22]; x2=coor2[n2min-1]; y2=coor2[n2min-1+ *np2]; z2=coor2[n2min-1 +np22]; x3=coor2[n3min-1]; y3=coor2[n3min-1+ *np2]; z3=coor2[n3min-1 +np22]; bary3d (xmin,ymin,zmin,x1,y1,z1, x2,y2,z2, x3,y3,z3,&b1,&b2,&b3); bary1[nf]=b1; bary1[nf+ *ngl1]=b2; bary1[nf+ ngl12]=b3; nc1[nf]=nelmin; distance[nf]=dmin; dist_moy+=dmin; dist_var+=(dmin*dmin); if (*nblbla==16) { printf("\n NOEUD FIN : %6d coordonnees : %10.3f %10.3f %10.3f\n",nff+1,xp1,yp1,zp1); printf(" CORRESPONDANT GROSSIER :\n"); printf(" numero du triangle grossier : %6d\n",nelmin); printf(" noeuds : %6d %6d %6d\n",n1min,n2min,n3min); printf(" coord du correspondant : %10.3f %10.3f %10.3f\n",xmin,ymin,zmin); printf(" distance minimale :%10.3f\n",dmin); printf(" coord barycentriques : %10.3f %10.3f %10.3f\n",b1,b2,b3); } } if (dist_max>99999.) { if (*indglo==1) printf("\n %%%% ERREUR CRROCT : des points du maillage solide n'ont pas de correspondant\n"); else printf("\n %%%% ERREUR CRROCT : des points du maillage fluide n'ont pas de correspondant\n"); printf(" sur le maillage de rayonnement \n"); printf(" Verifier les references et le fichier de donnees\n"); exit(0); } dist_moy /= *ngl1; dist_var= dist_var/ *ngl1-(dist_moy*dist_moy); printf("\n Distance de correspondance\n"); printf(" - maximale : %12.5e\n",dist_max); printf(" - moyenne : %12.5e\n",dist_moy); printf(" - variance : %12.5e\n",dist_var); tuer_tree(arbre,8); vmin=0; nbhisto=10; interv=dist_max/(nbhisto); thisto=(int *)malloc(nbhisto*sizeof(int)); if (thisto==NULL) {printf(" ERREUR crroct : probleme d'allocation memoire\n"); exit(0);} histog (*ngl1,distance,vmin,dist_max,thisto,nbhisto); printf(" Histogramme de la distance (nombre de points=%5d)\n",*ngl1); printf(" Intervalle nb_points Pourcentage\n"); for (i=0;i0.) {a2=-a2;b2=-b2;c2=-c2;} aa = sqrt (a2*a2 + b2*b2); a2 /= aa; b2 /= aa; c2 /= aa; a3=-y6new; b3=x6new; c3=0.; if ((a3*x5new + b3*y5new + c3)>0.) {a3=-a3;b3=-b3;} /* position du point par rapport a ces 3 droites ---------------------------------------------- */ if ((a3*xxnew + b3*yynew + c3) > 0.) *numtri=1; else if ((a1*xxnew + b1*yynew + c1) > 0.) *numtri=3; else if ((a2*xxnew + b2*yynew + c2) > 0.) *numtri=4; else *numtri=2; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | bary3d | | Calcul des coefficients barycentriques | |======================================================================| */ void bary3d(double xx,double yy,double zz, double xa,double ya,double za,double xb,double yb,double zb, double xc,double yc,double zc, double *xl1,double *xl2,double *xl3) { double deno,deno1,deno2,deno3,un; int n; un=1.; deno = deno1 = determ (xa,ya,un,xb,yb,un,xc,yc,un); deno2 = determ (ya,za,un,yb,zb,un,yc,zc,un); deno3 = determ (xa,za,un,xb,zb,un,xc,zc,un); n=1; if (abs(deno2)>abs(deno)) {deno=deno2;n=2;} if (abs(deno3)>abs(deno)) {deno=deno3;n=3;} if (n==1) { *xl1 = determ (xx,yy,un,xb,yb,un,xc,yc,un); *xl2 = determ (xa,ya,un,xx,yy,un,xc,yc,un); } else if (n==2) { *xl1 = determ (yy,zz,un,yb,zb,un,yc,zc,un); *xl2 = determ (ya,za,un,yy,zz,un,yc,zc,un); } else { *xl1 = determ (xx,zz,un,xb,zb,un,xc,zc,un); *xl2 = determ (xa,za,un,xx,zz,un,xc,zc,un); } if (abs(deno) > 1e-10) {*xl1=*xl1/deno; *xl2=*xl2/deno; *xl3=1.-*xl1-*xl2;} else {*xl1 = 0.; *xl2 = 0. ; *xl3 = 1. ;} } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | determ | | Calcul d'un determinant | |======================================================================| */ double determ(double x1,double y1,double z1, double x2,double y2,double z2, double x3,double y3,double z3) { return(x1*y2*z3 + x2*y3*z1 + y1*z2*x3-z1*y2*x3 - y1*x2*z3 - z2*y3*x1); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cal_dmin | | Calcul du point qui realise la distance minimale | | | |======================================================================| */ void cal_dmin(double xp1,double yp1,double zp1, double *xa,double *ya,double *za,double *xb,double *yb,double *zb, double *xc,double *yc,double *zc, int nlonv,double *dmin,double *xmin,double *ymin, double *zmin,int *nelmin, int *lco,int *icode) { int i; double xx[N64],yy[N64],dist[N64],xdmi[N64],ydmi[N64],zdmi[N64]; double xab[N64],yab[N64],zab[N64],xac[N64],yac[N64],zac[N64]; double abn[N64],acn[N64],xabac[N64],yabac[N64],zabac[N64]; double xe1[N64],ye1[N64],ze1[N64],xe2[N64],ye2[N64],ze2[N64]; double ace1[N64],e2n[N64],xh[N64]; double xanew[N64],yanew[N64],xbnew[N64],ybnew[N64],xcnew[N64],ycnew[N64]; double xn[N64],yn[N64],zn[N64],xp[N64],yp[N64]; double a1[N64],b1[N64],c1[N64],a2[N64],b2[N64],c2[N64]; double a3[N64],b3[N64],c3[N64],d1[N64],d2[N64],d3[N64]; double cond12[N64],cond21[N64],cond13[N64]; double cond31[N64],cond23[N64],cond32[N64],deno[N64]; double xnn[N64]; *dmin=1.e10; for (i=0;i0.) {a2[i]=-a2[i];b2[i]=-b2[i]; c2[i]=-c2[i];} xx[i] = sqrt (a2[i]*a2[i] + b2[i]*b2[i]); a2[i] /= xx[i]; b2[i] /= xx[i]; c2[i] /= xx[i]; a3[i] = - ycnew[i]; b3[i]=xcnew[i]; c3[i]=0.; if ((a3[i]*xbnew[i] + b3[i]*ybnew[i] + c3[i])>0.) {a3[i]=-a3[i]; b3[i]=-b3[i];} xx[i] = sqrt ( a3[i]*a3[i] + b3[i]*b3[i] ); a3[i] /= xx[i]; b3[i] /= xx[i]; d1[i] = a1[i]*xp[i] + b1[i]*yp[i] + c1[i]; d2[i] = a2[i]*xp[i] + b2[i]*yp[i] + c2[i]; d3[i] = a3[i]*xp[i] + b3[i]*yp[i] + c3[i]; cond12[i] = d1[i] - d2[i]*(a2[i]*a1[i] + b2[i]*b1[i]); cond21[i] = d2[i] - d1[i]*(a1[i]*a2[i] + b1[i]*b2[i]); cond13[i] = d1[i] - d3[i]*(a3[i]*a1[i] + b3[i]*b1[i]); cond31[i] = d3[i] - d1[i]*(a1[i]*a3[i] + b1[i]*b3[i]); cond23[i] = d2[i] - d3[i]*(a3[i]*a2[i] + b3[i]*b2[i]); cond32[i] = d3[i] - d2[i]*(a2[i]*a3[i] + b2[i]*b3[i]); } } for (i=0;i0. && cond21[i]<=0. && cond31[i]<=0.) {xx[i]=xp[i]-d1[i]*a1[i];yy[i]=yp[i]-d1[i]*b1[i]; dist[i] = sqrt (xh[i]*xh[i] + d1[i]*d1[i]);} else if (d2[i]>0. && cond12[i]<=0. && cond32[i]<=0.) {xx[i]=xp[i]-d2[i]*a2[i]; yy[i]=yp[i]-d2[i]*b2[i]; dist[i] = sqrt (xh[i]*xh[i] + d2[i]*d2[i]);} else if (d3[i]>0. && cond13[i]<=0. && cond23[i]<=0.) {xx[i]=xp[i]-d3[i]*a3[i]; yy[i]=yp[i]-d3[i]*b3[i]; dist[i] = sqrt (xh[i]*xh[i] + d3[i]*d3[i]);} else if ( cond23[i]>0. && cond32[i]>0. && (d1[i]-(cond23[i]*(a1[i]*a2[i]+b1[i]*b2[i]) +cond32[i]*(a1[i]*a3[i]+b1[i]*b3[i]))/ (1.-(a2[i]*a3[i]+b2[i]*b3[i])*(a2[i]*a3[i]+b2[i]*b3[i])))<=0. ) {deno[i]= 1.-(a2[i]*a3[i]+b2[i]*b3[i])*(a2[i]*a3[i]+b2[i]*b3[i]); xx[i]=xp[i]-(cond23[i]*a2[i]+cond32[i]*a3[i]) / deno[i]; yy[i]=yp[i]-(cond23[i]*b2[i]+cond32[i]*b3[i]) / deno[i]; dist[i]= sqrt ( xh[i]*xh[i] + (xp[i]-xx[i])*(xp[i]-xx[i]) + (yp[i]-yy[i])*(yp[i]-yy[i]) );} else if (cond13[i]>0. && cond31[i]>0. && (d2[i]-(cond13[i]*(a2[i]*a1[i]+b2[i]*b1[i]) +cond31[i]*(a2[i]*a3[i]+b2[i]*b3[i]))/ (1.-(a1[i]*a3[i]+b1[i]*b3[i])*(a1[i]*a3[i]+b1[i]*b3[i])))<=0. ) {deno[i]=1.-(a1[i]*a3[i]+b1[i]*b3[i])*(a1[i]*a3[i]+b1[i]*b3[i]); xx[i]=xp[i]- (cond13[i]*a1[i]+cond31[i]*a3[i]) / deno[i]; yy[i]=yp[i]- (cond13[i]*b1[i]+cond31[i]*b3[i]) / deno[i]; dist[i]= sqrt ( xh[i]*xh[i] + (xp[i]-xx[i])*(xp[i]-xx[i]) + (yp[i]-yy[i])*(yp[i]-yy[i]) );} else if (cond21[i]>0. && cond12[i]>0. && (d3[i]-(cond12[i]*(a3[i]*a1[i]+b3[i]*b1[i]) +cond21[i]*(a3[i]*a2[i]+b3[i]*b2[i])) /(1-(a1[i]*a2[i]+b1[i]*b2[i])*(a1[i]*a2[i]+b1[i]*b2[i])))<=0.) {deno[i]= 1.-(a1[i]*a2[i]+b1[i]*b2[i])*(a1[i]*a2[i]+b1[i]*b2[i]); xx[i]=xp[i]- (cond12[i]*a1[i]+cond21[i]*a2[i]) / deno[i]; yy[i]=yp[i]- (cond12[i]*b1[i]+cond21[i]*b2[i]) / deno[i]; dist[i]=sqrt ( xh[i]*xh[i] + (xp[i]-xx[i])*(xp[i]-xx[i]) + (yp[i]-yy[i])*(yp[i]-yy[i]) );} else icode[i] = 1; xdmi[i] = xa[i] + xx[i]*xe1[i] + yy[i]*xe2[i]; ydmi[i] = ya[i] + xx[i]*ye1[i] + yy[i]*ye2[i]; zdmi[i] = za[i] + xx[i]*ze1[i] + yy[i]*ze2[i]; } } for (i=0;i GLOBALE 3D)! C ! SURFUS ! TR ! D ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE ! C ! TRAV ! TR ! R ! TABLEAU DE TRAVAIL (npmxs) ! C ! W1...W6 ! TR ! M ! TABLEAUX DE TRAVAIL. ATTENTION On utilise! C ! ! ! ! uniquement les NELEBS premieres cases ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" #include "syrth.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIM,NELEUS,NDMASS INTEGER NBCOUS,NBFLUS,NBECHS,NBRESS,NBRAYS INTEGER NCOUPS(NBCOUS),NFLUSS(NBFLUS),NECHS(NBECHS) INTEGER NODEUS(NELEUS,NDMASS) INTEGER NRESCS(NBRESS,2),NRAYTS(NBRAYS) INTEGER NBRAIS,NRAYIS(NBRAIS) DOUBLE PRECISION VRAYIS(NBRAIS,2) DOUBLE PRECISION VCOUPS(NBCOUS,2),VFLUSS(NBFLUS),VECHS(NBECHS,2) DOUBLE PRECISION VRESCS(NBRESS,2),VRAYTS(NBRAYS,2) DOUBLE PRECISION B(NPOINS),TRAV(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION DIAG(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMASS) DOUBLE PRECISION SURFUS(NELEUS) C C..Variables internes DOUBLE PRECISION R1,R2 DOUBLE PRECISION F1,F2,F3,F4,F5,F6 INTEGER I,INODE,NCA INTEGER N1,N2,N3,N4,N5,N6 DOUBLE PRECISION S48,SV48,S12,SV12 DOUBLE PRECISION ZERO DOUBLE PRECISION HRAYI,HRAYT C C*********************************************************************** C C 1- INITIALISATIONS C ================== IF (NBCOUS * .EQ.0 .AND. .NOT. LSYRTH) * NBCOUS = NPOINS C ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) CALL OV ( 'X=C ',TRAV2,TRAV2,TRAV2,ZERO,NPOINS ) C C Coefficients S48 = 1.D0 / 48.D0 S12 = 1.D0 / 12.D0 C C 2- CALCUL DES CONDITIONS SUR LES POINTS DE BORD CONCERNES C ========================================================= C C C 2.1 Prise en compte explicite C ----------------------------- IF ( LCLEXP ) THEN C DO 211 I=1,NBCOUS INODE = NCOUPS(I) TRAV(INODE) = TRAV(INODE) + & VCOUPS(I,2)*(VCOUPS(I,1)-TMPSA(INODE)) 211 CONTINUE C DO 212 I=1,NBFLUS INODE = NFLUSS(I) TRAV(INODE) = TRAV(INODE) + VFLUSS(I) 212 CONTINUE C DO 213 I=1,NBECHS INODE = NECHS(I) TRAV(INODE) = TRAV(INODE) + & VECHS(I,2) * (VECHS(I,1)-TMPSA(INODE)) 213 CONTINUE C C NRESCS(I,1) contient le numero global du noeud C DO 214 I=1,NBRESS INODE = NRESCS(I,1) TRAV(INODE) = TRAV(INODE) + & VRESCS(I,2) * (VRESCS(I,1)-TMPSA(INODE)) 214 CONTINUE C C DO 215 I=1,NBRAIS INODE = NRAYIS(I) HRAYI = VRAYIS(I,2)*SIGMA* & (TMPSA(INODE)+VRAYIS(I,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VRAYIS(I,1)+TKEL) * (VRAYIS(I,1)+TKEL) ) TRAV(INODE) = TRAV(INODE) + & HRAYI * (VRAYIS(I,1)-TMPSA(INODE)) 215 CONTINUE C C DO 216 I=1,NBRAYS INODE = NRAYTS(I) HRAYT = VRAYTS(I,2)*SIGMA* & (TMPSA(INODE)+VRAYTS(I,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VRAYTS(I,1) +TKEL) * (VRAYTS(I,1)+TKEL) ) TRAV(INODE) = TRAV(INODE) + & HRAYT * (VRAYTS(I,1)-TMPSA(INODE)) 216 CONTINUE C C C 2.2 Prise en compte implicite des conditions d'echange C ------------------------------------------------------ ELSE C Cessai CALL OV ( 'X=C ',TRAV,TRAV,TRAV,TMPSA,NPOINS ) C DO 221 I=1,NBCOUS INODE = NCOUPS(I) TRAV(INODE) = VCOUPS(I,1) 221 CONTINUE C DO 223 I=1,NBECHS INODE = NECHS(I) TRAV(INODE) = VECHS(I,1) 223 CONTINUE C C DO 224 I=1,NBRESS INODE = NRESCS(I,1) TRAV(INODE) = VRESCS(I,1) 224 CONTINUE C C DO 225 I=1,NBRAIS INODE = NRAYIS(I) c HRAYI = VRAYIS(I,2)*SIGMA* c & (TMPSA(INODE)+VRAYIS(I,1)+2*TKEL)* c & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + c & (VRAYIS(I,1)+TKEL) * (VRAYIS(I,1)+TKEL) ) TRAV2(INODE) = VRAYIS(I,1) 225 CONTINUE C C DO 226 I=1,NBRAYS INODE = NRAYTS(I) c HRAYT = VRAYTS(I,2)*SIGMA* c & (TMPSA(INODE)+VRAYTS(I,1)+2*TKEL)* c & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + c & (VRAYTS(I,1) +TKEL) * (VRAYTS(I,1)+TKEL) ) TRAV2(INODE) = VRAYTS(I,1) 226 CONTINUE C C DO 227 I=1,NPOINS B(I) = B(I) + TRAV4(I) * TRAV(I) + DIAG(I) * TRAV2(I) 227 CONTINUE C IF ( NBLBLA.EQ.12 ) THEN WRITE(NFECRA,2228) DO 2229 I=1,NPOINS WRITE(NFECRA,2230) I,B(I),TRAV4(I)*TRAV(I),DIAG(I)*TRAV2(I) 2229 CONTINUE ENDIF C C 2.3.1- Prise en compte des flux exterieurs C ---------------------------------------- C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) DO 231 I=1,NBFLUS TRAV(NFLUSS(I)) = VFLUSS(I) 231 CONTINUE C C ENDIF C C C 3- CALCUL DU VECTEUR ELEMENTAIRE C ================================ IF ( LCLEXP .OR. NBFLUS.GT.0 ) THEN C C 3.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 3.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 311 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV12 = S12 * SURFUS(I) C F1 = TRAV(N1) * SV12 F2 = TRAV(N2) * SV12 F3 = TRAV(N3) * SV12 C WCT(I,1) = F3+2*F1 WCT(I,2) = F3+2*F2 WCT(I,3) = 4*F3+F1+F2 311 CONTINUE C C 3.1.2- Cas axisymetrique C ------------------------ ELSE DO 312 I=1,NELEUS C C Calcul des indices globaux N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV48 = S48 * SURFUS(I) C R1 = ABS( COORDS(N1,NCA) ) R2 = ABS( COORDS(N2,NCA) ) C F1 = TRAV(N1) * SV48 F2 = TRAV(N2) * SV48 F3 = TRAV(N3) * SV48 C WCT(I,1) = R2*F3+R2*F1+3*R1*F3+7*R1*F1 WCT(I,2) = 3*R2*F3+7*R2*F2+R1*F3+R1*F2 WCT(I,3) = 8*R2*F3+R2*F1+8*R1*F3+3*R1*F1 & +3*R2*F2+R1*F2 C 312 CONTINUE C ENDIF C C 3.2- Cas 3D C ----------- ELSE DO 320 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) N4 = NODEUS(I,4) N5 = NODEUS(I,5) N6 = NODEUS(I,6) C SV48 = S48 * SURFUS(I) C F1 = TRAV(N1) * SV48 F2 = TRAV(N2) * SV48 F3 = TRAV(N3) * SV48 F4 = TRAV(N4) * SV48 F5 = TRAV(N5) * SV48 F6 = TRAV(N6) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 320 CONTINUE C ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) CALL ASSEUS ( TRAV,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS, & NDIM,WCT) C C C 4- MISE A JOUR DU SECOND MEMBRE C =============================== C DO 400 I=1,NPOINS B(I) = B(I) + TRAV(I) 400 CONTINUE C C ENDIF C C 5- IMPRESSIONS POUR CONTROLE C ============================ C IF ( NBLBLA.GE.11 ) THEN WRITE(NFECRA,5000) DO 500 I=1,NPOINS WRITE(NFECRA,5010) I,B(I),TRAV(I) 500 CONTINUE ENDIF C C-------- C FORMATS C-------- 2228 FORMAT(/,' *** SMFLUS : SECOND MEMBRE (PARTIE IMPLICITE)',/, & ' NOEUD SECOND MEMBRE ECHANGE ', & ' RAYONNEMENT') 2230 FORMAT(7X,I6,5X,G10.4,5X,G10.4,5X,G10.4) 5000 FORMAT(/,' *** SMFLUS : SECOND MEMBRE (PARTIE FLUX)',/, & ' NOEUD SECOND MEMBRE FLUX AJOUTE ', & ' CL ECHANGE IMPLI') 5010 FORMAT(7X,I6,5X,G10.4,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/lecid2.F0000666000175000017500000001735411524070643015226 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECID2 C ***************** C C ---------------------------------------------------------------- *(NDIM,NDIELE,NPOINS,NELEMS,NFBIDA, * NBFACE,NN,IREF,INOEUD,IFACE,IELT) C ---------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE IDEAS * C (Necessaire pour les dimensionnements de tableaux) * C * C Modif en cours pour pouvoir lire des faces dans ideas * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "mobil.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN INTEGER IREF(NPOINS),INOEUD(NELEMS*NN),IFACE(NELEMS*NBFACE) INTEGER IELT(NELEMS) C C.. Variables internes INTEGER NDIMEF, NDSR,ITYE INTEGER I,J,NUM,ID,N1,N2,ICOU,NBNO,N,NSYS CHARACTER*80 CH INTEGER ITRIA6(6),ITET10(10) C INTEGER NFBIDA,ICFA,NSF1,NSF2,NSF3 C*********************************************************************** C DATA ITRIA6 / 1,4,2,5,3,6 / DATA ITET10 / 1,8,4,9,2,5,7,10,6,3 / C DO I=1,NELEMS*NBFACE IFACE(I) = 0 ENDDO C C 0- INITIALISATIONS C ================== NDSR=0 C C 1- TABLE DES NOEUDS C =================== C CALL SECIDE(NFSGCT,2411) C DO 140 N=1,NPOINS READ(NFSGCT,1200) NUM,NSYS,J,IREF(N) READ(NFSGCT,1201) CH NDSR = MAX(NDSR,IREF(N)) 140 CONTINUE C C 4- TABLE DES ELEMENTS C ===================== C CALL SECIDE(NFSGCT,2412) C DO 420 I=1,NELEMS C READ(NFSGCT,4200,ERR=29,END=29) NUM,ID,N1,N2,IELT(I),NBNO C ITYE = ID IF (NDIELE.EQ.2) THEN IF (ID.EQ.92) THEN READ(NFSGCT,4201,ERR=29,END=29) & (INOEUD((ITRIA6(J)-1)*NELEMS+I),J=1,NBNO) ENDIF ELSEIF (NDIELE.EQ.3 ) THEN IF (ID.EQ.118) THEN READ(NFSGCT,4201,ERR=29,END=29) & (INOEUD((ITET10(J)-1)*NELEMS+I),J=1,NBNO) ELSE WRITE(NFECRA,5000) ENDIF ENDIF C 420 CONTINUE C 29 CONTINUE C C On fait un traitement pour les faces des elements DO I=1,NFBIDA READ(NFSGCT,4200,ERR=29,END=29) NUM,ID,N1,N2,ICFA,NBNO C ITYE = ID IF (NDIELE.EQ.3 .AND. ID.EQ.92) THEN READ(NFSGCT,4201,ERR=29,END=29) & NSF1,N1,NSF2,N1,NSF3,N1 CALL AFECTF(NSF1,NSF2,NSF3,ICFA, * NDIM,NDIELE,NELEMS,NBNO,NBFACE,INOEUD, * IFACE,NPOINS,IREF) ENDIF IF(NDIELE.EQ.2 .AND. ID.EQ.24) THEN NSF1 = 0 NSF3 = 0 READ(NFSGCT,4223) CH READ(NFSGCT,4224) NSF1,NSF3,NSF2 CALL AFECTF(NSF1,NSF2,NSF3,ICFA, * NDIM,NDIELE,NELEMS,NBNO,NBFACE,INOEUD, * IFACE,NPOINS,IREF) ENDIF ENDDO chp IF ((ID.EQ.92 .AND. NBNO.NE. 6) .OR. chp & (ID.EQ.118 .AND. NBNO.NE. 10)) THEN chp WRITE(NFECRA,4210) chp STOP chp ENDIF C C chp IF (ITYE.EQ.92) THEN chp NDIMEF = 2 chp ELSE chp NDIMEF = 3 chp ENDIF C C C 5- REFERENCES SUR LES FACES C =========================== C IF (LCFACE) THEN CALL INREFA (NDIM,NDIELE,NELEMS,NBNO,NBFACE,INOEUD,IFACE, * NPOINS,IREF) ENDIF C C-------- C FORMATS C-------- C 1200 FORMAT(4I10) 1201 FORMAT(A80) 1210 FORMAT(/,' %% ERREUR LECID2 : LES COORDONNEES NE SONT PAS DANS', & ' LE REPERE DE REFERENCE') C 1400 FORMAT(1P3D25.16) C 4200 FORMAT(6I10) 4201 FORMAT(8I10) 4223 FORMAT(A80) 4224 FORMAT(3I10) 4210 FORMAT(/,' %% ERREUR LECID2 : LES ELEMENTS DOIVENT POSSEDER DES', & ' NOEUDS MILIEUX') C 5000 FORMAT(/,' %% ERREUR LECID2 : Il y a une incoherence ') C END syrthes-3.4.3-dfsg1/src/s/pssclf.F0000666000175000017500000001407211524070643015350 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE PSSCLF C ***************** C C ------------------------------------------------------- * (NBCOUS,VCOUPS,NELESS,NDMASS,VFCOUS,NODESS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES DU SOLIDE VERS LE SOLIDE * C - dans le cas du traitement des condtions aux limites * C par face, il faut transferer la valeur du flux issu * C du fluide et stockee dans VCOUPS dans VFCOUS * C - dans le cas des solides mobiles, il faut mettre a jour * C la temperature exterieure sur les noeuds couples qui * C ne sont pas en face du fluide a ce moment * C * C .___________.____.____.______________________________________________. C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NCOUPS ! TE ! D ! NUMERO DES NOEUDS SOLIDES COUPLES ! C ! VCOUPS ! TR ! D ! VALEUR AUX NOEUDS SOLIDES COUPLES ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SURF SOLIDE COUPLES ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS SOLIDES COUPLES! C ! NFCOUS ! TE ! D ! NUMERO DES FACES SOLIDES COUPLES ! C ! VFCOUS ! TR ! R ! VALEUR AUX NOEUDS DES FACES SOLIDES COUPLEE ! C ! NODESS ! TE ! D ! TABLE DES ELEMENTS SURF SOLIDE COUPLES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS SOLIDES ! C ! TRAV1 ! TE ! A ! TABLEAU DE TRAVAIL ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NBCOUS,NDMASS,NELESS,NODESS(NELESS,NDMASS) DOUBLE PRECISION VCOUPS(NBCOUS,2),VFCOUS(NELESS,NDMASS,2) C C..Variables internes INTEGER N,M,NUML,NAFFIC C C*********************************************************************** C C 1- BOUCLES SUR LES FACES COUPLEES C --------------------------------- C DO 120 N=1,NELESS DO 121 M=1,NDMASS C NUML = NODESS(N,M) C VFCOUS(N,M,1) = VCOUPS(NUML,1) VFCOUS(N,M,2) = VCOUPS(NUML,2) C 121 CONTINUE 120 CONTINUE C C C 3- IMPRESSIONS POUR CONTROLE C ============================ IF (NBLBLA.EQ.14 .OR. NBLBLA.EQ.141) THEN IF (NBLBLA.EQ.14) THEN NAFFIC=NELESS ELSE NAFFIC=50 ENDIF WRITE(NFECRA,3000) DO 300 N=1,NAFFIC WRITE(NFECRA,3010) N,VFCOUS(N,1,1),VFCOUS(N,1,2) 300 CONTINUE CALL FLUSHF(NFECRA) ENDIF C C C C------- C FORMAT C------- C 3000 FORMAT(/,' *** PSSCLF : CONDITIONS AUX LIMITES SUR LES FACES,',/, & 14X,'Passage des donnees des noeuds sur les faces ',/, & 5X,' N solide T h') 3010 FORMAT(5X,3X,I10,6X,G13.7,3X,G13.7) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/rayflu.F0000666000175000017500000001715411524070643015364 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=RAYFLU,SSI=0 SUBROUTINE RAYFLU C ***************** C C ------------------------------------------------------- * (MODE, * NDIM,NFIXLT,NFXLP2,NPOINF,NBCOUF,NCOUPF,VCOUPF, * TFLUID,TEMPAR,LNUMP2,UTAUP,TPLUS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES VOL DU FLUIDE AU TABLEAU VCOUPF * C * C---------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NCOUPF ! TE ! D ! NUMERO DES NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C ********************************************************************** C Attention common issu de N3S DOUBLE PRECISION PI,DEGRAD,ZERO,UN,EPZERO INTEGER IZERO,IUN COMMON /CONST/ PI,DEGRAD,ZERO,UN,EPZERO,IZERO,IUN DOUBLE PRECISION DEN,VISC,SPHT,CONDUC,BETA,REY,PRNDLA COMMON /FLUID/ DEN,VISC,SPHT,CONDUC,BETA,REY,PRNDLA DOUBLE PRECISION VREF,RAYHYD,PREF,TREF,DX0,Y5PRND,ALMAX,GRAVIT COMMON /VALREF/ VREF,RAYHYD,PREF,TREF,DX0,Y5PRND,ALMAX,GRAVIT(3) C C*********************************************************************** C C..Variables externes INTEGER MODE,NDIM,NBCOUF,NFIXLT,NFXLP2,NPOINF INTEGER NCOUPF(NBCOUF,2),LNUMP2(NPOINF) DOUBLE PRECISION VCOUPF(NBCOUF,2) DOUBLE PRECISION TFLUID(NPOINF),TEMPAR(NFIXLT) DOUBLE PRECISION UTAUP(NFXLP2),TPLUS(NFIXLT) C C..Variables internes INTEGER NF,NTP,NGF,IP,N DOUBLE PRECISION XXH,UTEMPP C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE FLUIDE C =================================== C DO 100 NF=1,NBCOUF C NTP = NCOUPF(NF,2) C TEMPAR(NTP) = VCOUPF(NF,1) C 100 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLR.GE.10) THEN WRITE(NFECRA,1010) DO 110 N=1,NFIXLT WRITE(NFECRA,1020) N,TEMPAR(N) 110 CONTINUE ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU FLUIDE VERS LE SOLIDE C =================================== C DO 200 NF=1,NBCOUF C NGF = NCOUPF(NF,1) C NTP = NCOUPF(NF,2) C IF (TPLUS(NTP).LE.EPZERO) THEN XXH = CONDUC / (DX0/10.D0) ELSE IP = LNUMP2(NGF) UTEMPP = UTAUP(IP) XXH = DEN*SPHT*UTEMPP/TPLUS(NTP) ENDIF C VCOUPF(NF,1) = TFLUID(NGF) VCOUPF(NF,2) = XXH C C 200 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLR.GE.10) THEN IF (MODE.EQ.1) THEN WRITE(NFECRA,*) '>solflu>>>>TEMPAR>>>>>>',TEMPAR ELSE WRITE(NFECRA,*) '>solflu>>>>TFLUID>>>>>>',TFLUID WRITE(NFECRA,*) '>solflu>>>>TEMPAR>>>>>>',TEMPAR WRITE(NFECRA,*) '>solflu>>>>>UTAUP>>>>>>',UTAUP WRITE(NFECRA,*) '>solflu>>>>>TPLUS>>>>>',TPLUS ENDIF ENDIF C IF (NBLBLR.GE.10) THEN WRITE(NFECRA,2010) DO 210 N=1,NBCOUF WRITE(NFECRA,2020) N,VCOUPF(N,1),VCOUPF(N,2) 210 CONTINUE ENDIF C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** RAYFLU : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE',/, & 5X,' N fluide TEMPAR ') 1020 FORMAT(5X,3X,I4,6X,G13.7) 2010 FORMAT(/,' *** RAYFLU : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (tempar --> vcoupf)',/, & 5X,' N fluide T h') 2020 FORMAT(5X,3X,I4,6X,G13.7,3X,G13.7) 3000 FORMAT(/,' %% ERREUR RAYFLU : OPTION INCORRECTE ') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/cmptno.F0000666000175000017500000001437711524070643015366 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CMPTNO,SSI=0 SUBROUTINE CMPTNO C ***************** C C -------------------------------------------------- *(NREFS,NPOINS,NBCOUS,NBFLUS,NBDIRS,NBECHS, * NBRESS,NBRAYS,NBRAIS,NBPRIO,NBMOBS) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C COMPTE DES NOEUDS PORTANT LES DIVERSES CONDITIONS * C POSSIBLES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NBCOUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBRESS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBRAIS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT INF! C ! NBPRIO ! E ! R ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! R ! NOMBRE DE NOEUDS SOLIDES EN MOUVEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NREFS(NPOINS) INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBRESS,NBRAYS,NBRAIS INTEGER NBPRIO,NBMOBS C C.. Variables internes INTEGER I,NUMREF,N1 C C*********************************************************************** C C 1- INITIALISATIONS C ------------------ C NBCOUS = 0 NBFLUS = 0 NBDIRS = 0 NBECHS = 0 NBRESS = 0 NBRAYS = 0 NBRAIS = 0 NBPRIO = 0 NBMOBS = 0 C C DO 100 I=1,NPOINS C NUMREF = NREFS(I) C IF (NUMREF.NE.0) THEN C DO 105 N1=1,NRFMAX C IF (IREFSC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBCOUS = NBCOUS + 1 ENDIF C IF (IREFSF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFLUS = NBFLUS + 1 ENDIF C IF (IREFSD(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBDIRS = NBDIRS + 1 ENDIF C IF (IREFSE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBECHS = NBECHS + 1 ENDIF C IF (IREFRE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBRESS = NBRESS + 1 ENDIF C IF (IREFRA(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBRAYS = NBRAYS + 1 ENDIF C IF (IREFRI(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBRAIS = NBRAIS + 1 ENDIF C IF (IREFPR(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBPRIO = NBPRIO + 1 ENDIF C IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBMOBS = NBMOBS + 1 ENDIF C 105 CONTINUE C ENDIF C 100 CONTINUE C C END syrthes-3.4.3-dfsg1/src/s/coresc.F0000666000175000017500000001775211524070643015344 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CORESC,SSI=0 SUBROUTINE CORESC C ***************** C C ---------------------------------- * (NDIM,NPOINS,NBRESS,NRESCS,COORDS) C ---------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA TABLE DE CORRESPONDANCE ENTRE LES * C NOEUDS MUNIS DE RESISTANCES DE CONTACT * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NBRESS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NRESCS ! TE ! M ! TABLE DES NOEUDS AVEC RESISTANCE ! C ! ! ! ! (.,1) : numero global du noeud ! C ! ! ! ! (.,2) : numero local de son correspondant ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ---- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "nlofes.h" #include "optct.h" #include "mobil.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBRESS,NRESCS(NBRESS,2) DOUBLE PRECISION COORDS(NPOINS,NDIM) C C.. Variables internes INTEGER N,M,NG,MG,NLMIN DOUBLE PRECISION X,Y,Z,XC,YC,ZC,D2,DMIN,DMAX C C*********************************************************************** C C 0.1- INITIALISATIONS C ==================== C DO 1 N=1,NBRESS NRESCS(N,2) = 0 1 CONTINUE C DMAX = 0 C C 0.2- VERIFICATION DE BASE C ========================= C IF (MOD(NBRESS,2).NE.0) THEN WRITE(NFECRA,999) STOP ENDIF C C 1- CORRESPONDANCE EN 2D C ======================= C IF (NDIM .EQ. 2) THEN C C IF (NBLBLA.GT.0) WRITE(NFECRA,1000) C C 1.1- Pour chaque noeud avec resistance C -------------------------------------- DO 100 N=1,NBRESS C DMIN = 1.D6 NLMIN = 0 C NG = NRESCS(N,1) C XC = COORDS(NG,1) YC = COORDS(NG,2) C C DO 110 M=1,NBRESS C IF (M.NE.N) THEN MG = NRESCS(M,1) C C Coordonnees du noeud X = COORDS(MG,1) Y = COORDS(MG,2) C D2 = (X-XC)*(X-XC) + (Y-YC)*(Y-YC) C IF (D2.LT.DMIN) THEN DMIN = D2 NLMIN = M ENDIF C ENDIF 110 CONTINUE C C 1.2- Mise a jour des correspondants C ----------------------------------- IF (NLMIN.NE.0) THEN NRESCS(N,2) = NLMIN IF (DMIN.GT.DMAX) DMAX = DMIN IF (LSDEPL .AND. DMIN.GT.D1MAXS) NRESCS(N,2) = -1 ELSE WRITE(NFECRA,1200) NG ENDIF C C 100 CONTINUE C C C 2- CORRESPONDANCE FLUIDE-->SOLIDE EN DIMENSION 3 C ================================================ C ELSEIF (NDIM .EQ. 3) THEN C C IF (NBLBLA.GT.0) WRITE(NFECRA,1000) C C 2.1- Pour chaque noeud avec resistance C -------------------------------------- DO 200 N=1,NBRESS C DMIN = 1.D6 NLMIN = 0 C NG = NRESCS(N,1) C XC = COORDS(NG,1) YC = COORDS(NG,2) ZC = COORDS(NG,3) C C DO 210 M=1,NBRESS C IF (M.NE.N) THEN MG = NRESCS(M,1) C X = COORDS(MG,1) Y = COORDS(MG,2) Z = COORDS(MG,3) C D2 = (X-XC)*(X-XC) + (Y-YC)*(Y-YC) + (Z-ZC)*(Z-ZC) C IF (D2.LT.DMIN) THEN DMIN = D2 NLMIN = M ENDIF C ENDIF 210 CONTINUE C C 2.2- Mise a jour des correspondants C ----------------------------------- IF (NLMIN.NE.0) THEN NRESCS(N,2) = NLMIN IF (DMIN.GT.DMAX) DMAX = DMIN IF (LSDEPL .AND. DMIN.GT.D1MAXS) NRESCS(N,2) = -1 ELSE WRITE(NFECRA,1200) NG ENDIF C 200 CONTINUE C C ENDIF C C 3- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) WRITE(NFECRA,3200) DMAX C IF (NBLBLA.GE.10) THEN WRITE (NFECRA,3000) DO 300 N=1,NBRESS WRITE(NFECRA,3010) N,NRESCS(NRESCS(N,2),1) 300 CONTINUE ENDIF C C-------- C FORMATS C-------- C 999 FORMAT(/,' %% ERREUR CORESC : le nombre de noeuds avec ', & 'resistance de contact',/, & ' est impair ==> ils ne peuvent se correspondre', & ' 2 a 2 ! ') 1000 FORMAT(/,' *** CORESC : Recherche des couples de noeuds avec ', & 'resistance de contact') 1200 FORMAT(' %% ERREUR CORESC : LA RECHERCHE DU CORRESPONDANT DU ', & ' NOEUD AVEC RESIATNCE ',I6,' A ECHOUEE') C 3000 FORMAT(/,' *** CORESC : couples de noeuds avec resistance de', & ' contact :') 3010 FORMAT(4X,' Noeud :',I6,' Correspondant : ',I6) 3200 FORMAT(' Distance maximale entre 2 noeuds ', & 'coincidents : ',E12.5) C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/difcoq.F0000666000175000017500000007011011524070643015316 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE DIFCOQ C ***************** C C --------------------------------------------------- *( TMPS,TMPSA,TMPSC1,TMPSC2,TMPSC3,B,DMAT, * XMAT,PHYSOL,COORDS,NODES,NFLUVS,VFLUVS, * NDIRS,VDIRS,NCOUPS,VCOUPS,NFLUSS,VFLUSS, * NECHS,VECHS,NRAYTS,VRAYTS,NPRIOS,NODEPR, * VOLUME,DIAG, * NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM, * NBDIRS,NBCOUS,NBFLUS,NBFLVS,NPFEL,NBECHS, * NPOUE,NPPEL,NBPHYS, * NBRAYS,NBPRIO,NBCOPR,NELEPR, * TRAV1,TRAV2,TRAV3,TRAV4,WCT ) C ---------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- TRAITEMENT DE LA DIFFUSION SOLIDE * C CAS COQUE * C Dans un second temps, ce programme devrait * C etre a meme de traiter des materiaux multicouches * C et une coque qui se deplace (suivant certaines * C modalite qui reste a definir. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! TMPSA ! TR ! R ! TEMPERATURE EN CHAQUE POINT interieur ! C ! TMPS ! TR ! D ! TEMPERATURE EN CHAQUE POINT exterieur ! C ! TMPSC1 ! TR ! D ! 1er COEF DE TEMPERATURE ! C ! TMPSC2 ! TR ! D ! 2eme COEF DE TEMPERATURE ! C ! TMPSC3 ! TR ! D ! 3eme COEF DE TEMPERATURE ! C ! DMAT ! TR ! M ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! M ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! PHYSOL ! TR ! D ! CARACTERISTIQUE DU SOLIDE ! C ! ! ! ! physol(n,1) = k conductivite ! C ! ! ! ! physol(n,2) = H (R courbure principal) ! C ! ! ! ! physol(n,3) = e (epaisseur locale) ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! NFLUVS ! TR ! D ! NUMERO DES POINTS DE FLUX VOLUMIQUE ! C ! VFLUVS ! TR ! D ! VALEUR DU FLUX AU POINT DE FLUX VOLUMIQUE! C ! NCOUPS ! TR ! D ! NUMERO DES POINTS DE COUPLAGE ! C ! VCOUPS ! TR ! D ! VCOUPS(I,1) VALEUR DE T (FLUIDE) ! C ! ! TR ! D ! VCOUPS(I,2) coef d'echange (FLUIDE) ! C ! NFLUSS ! TR ! D ! NUMERO DES POINTS DE FLUX (surf externe) ! C ! VFLUSS ! TR ! D ! VALEUR DU FLUX AU POINT DE FLUX ( // ) ! C ! NDIRS ! TR ! D ! NUMERO DES POINTS DE DIRICHLET ! C ! VDIRS ! TR ! D ! VALEUR DE DIRICHLET ! C ! NECHS ! TR ! D ! NUMERO DES POINTS DE COEF D'ECHANGE ! C ! VECHS ! TR ! D ! VALEUR POUR LES POINTS A COEF D'ECHANGE ! C ! ! TR ! D ! VECHS(n,1) = Temperature exterieure ! C ! ! TR ! D ! VECHS(n,2) = Coef d'echange ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN COQUE ! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! TRAV1 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV2 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV3 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! TRAV4 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPMXS) ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (Taille: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM INTEGER NBDIRS,NBCOUS,NBFLUS,NBFLVS,NPFEL INTEGER NBECHS,NPOUE,NPPEL,NBPHYS INTEGER NBRAYS INTEGER NBPRIO,NBCOPR,NELEPR INTEGER NRAYTS(NBRAYS) INTEGER NODES(NELEMS,NDMATS),NODEPR(NELEPR,NDMATS+1) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NFLUVS(NBFLVS) INTEGER NDIRS(NBDIRS),NCOUPS(NBCOUS),NFLUSS(NBFLUS),NECHS(NBECHS) C DOUBLE PRECISION VRAYTS(NBRAYS,2) DOUBLE PRECISION COORDS(NPOINS,NDIM),B(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS) DOUBLE PRECISION TMPSC3(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VDIRS(NBDIRS),VCOUPS(NBCOUS,2) DOUBLE PRECISION VFLUSS(NBFLUS),VECHS(NBECHS,2) DOUBLE PRECISION DIAG(NPOINS),VOLUME(NELEMS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C..Variables locales INTEGER I,INODE INTEGER N1,N2,N3,N4,N5,N6,NJ,NJGL LOGICAL LVERIF DOUBLE PRECISION S2EP,EPAIS1,ZERO,SUR3,SUR5,ROCP1,RINDTS DOUBLE PRECISION HRAYO C C*********************************************************************** C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. ZERO = 0.D0 C C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C 2- CALCUL DE L'EQUATION SUR LE PREMIER COEFFICIENT C ================================================== C C 2.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- DO 210 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * VCOUPS(I,2) 210 CONTINUE C DO 211 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) + & (1.D0+EPAIS1*PHYSOL(INODE,1,5)) * VECHS(I,2) 211 CONTINUE C IF ( .NOT. LCOSTA ) THEN RINDTS = 1.D0 / RDTTS DO 212 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(I) = TRAV1(I) + ROCP1 * PHYSOL(I,1,6) 212 CONTINUE ENDIF C DO 213 I=1,NBRAYS INODE = NRAYTS(I) HRAYO = VRAYTS(I,2)*SIGMA*(TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + & (1.D0+EPAIS1*PHYSOL(INODE,1,5)) * HRAYO 213 CONTINUE C CALL MATELC ('MASSE ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 2.2- Calcul du second membre C ---------------------------- C cela comprend : C le flux couple au fluide C le flux exterieur utilisateur C le flux avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C le second membre explicite (iteration n) C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C C DO 221 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) =(1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * VCOUPS(I,2) & * VCOUPS(I,1) 221 CONTINUE C DO 222 I=1,NBFLUS INODE = NFLUSS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) + & (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VFLUSS(I) 222 CONTINUE C DO 223 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) + & (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VECHS(I,2) & * VECHS(I,1) 223 CONTINUE C C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN DO 2240 I=1,NBFLVS INODE = NFLUVS(I) TRAV1(INODE) = TRAV1(INODE) + & VFLUVS(I,1) * PHYSOL(INODE,1,6) 2240 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 2241 I=1,NBFLVS N1 = NODES(NFLUVS(I),1) N2 = NODES(NFLUVS(I),2) N3 = NODES(NFLUVS(I),3) N4 = NODES(NFLUVS(I),4) N5 = NODES(NFLUVS(I),5) N6 = NODES(NFLUVS(I),6) TRAV1(N1) = TRAV1(N1)+VFLUVS(I,1)*PHYSOL(N1,1,6) TRAV1(N2) = TRAV1(N2)+VFLUVS(I,1)*PHYSOL(N2,1,6) TRAV1(N3) = TRAV1(N3)+VFLUVS(I,1)*PHYSOL(N3,1,6) TRAV1(N4) = TRAV1(N4)+VFLUVS(I,1)*PHYSOL(N4,1,6) TRAV1(N5) = TRAV1(N5)+VFLUVS(I,1)*PHYSOL(N5,1,6) TRAV1(N6) = TRAV1(N6)+VFLUVS(I,1)*PHYSOL(N6,1,6) 2241 CONTINUE C ELSE DO 2242 I=1,NBFLVS N1 = NODES(NFLUVS(I),1) N2 = NODES(NFLUVS(I),2) N3 = NODES(NFLUVS(I),3) N4 = NODES(NFLUVS(I),4) N5 = NODES(NFLUVS(I),5) N6 = NODES(NFLUVS(I),6) TRAV1(N1) = TRAV1(N1)+VFLUVS(I,1)*PHYSOL(N1,1,6) TRAV1(N2) = TRAV1(N2)+VFLUVS(I,2)*PHYSOL(N2,1,6) TRAV1(N3) = TRAV1(N3)+VFLUVS(I,3)*PHYSOL(N3,1,6) TRAV1(N4) = TRAV1(N4)+VFLUVS(I,4)*PHYSOL(N4,1,6) TRAV1(N5) = TRAV1(N5)+VFLUVS(I,5)*PHYSOL(N5,1,6) TRAV1(N6) = TRAV1(N6)+VFLUVS(I,6)*PHYSOL(N6,1,6) 2242 CONTINUE ENDIF ENDIF C C C DO 225 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * VCOUPS(I,2) & * ( - TMPSC2(INODE) + TMPSC3(INODE) ) 225 CONTINUE C DO 226 I=1,NBECHS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0+EPAIS1*PHYSOL(INODE,1,5)) * VECHS(I,2) & * ( TMPSC2(INODE) + TMPSC3(INODE) ) 226 CONTINUE C IF ( .NOT. LCOSTA ) THEN RINDTS = 1.D0 / RDTTS DO 227 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(I) = TRAV1(I) + ROCP1 * PHYSOL(I,1,6) * TMPSC1(I) 227 CONTINUE ENDIF C DO 228 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) *0.5D0 HRAYO = VRAYTS(I,2)*SIGMA*(TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + & (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * HRAYO * VRAYTS(I,1) 228 CONTINUE C C CALL SMFCOQ ( TRAV1,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 2.3- Calcul de la matrice de diffusion C -------------------------------------- C DO 230 I=1,NPOINS TRAV1(I) = PHYSOL(I,1,6) * PHYSOL(I,1,3) 230 CONTINUE C CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C C 2.4- Resolution de la premiere equation C --------------------------------------- C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC1,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C C 3- CALCUL DE L'EQUATION SUR LE DEUXIEME COEFFICIENT C ================================================== C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C 3.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 2.D0 / EPAIS1 DO 310 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(I) = S2EP * PHYSOL(INODE,1,4) + & (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * VCOUPS(I,2) 310 CONTINUE C DO 311 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) * VECHS(I,2) 311 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 312 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(INODE) = TRAV1(INODE) + ROCP1 * SUR3 * & PHYSOL(I,1,6) 312 CONTINUE ENDIF C C DO 313 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 HRAYO = VRAYTS(I,2)*SIGMA*(TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+2.*TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + & (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * HRAYO 313 CONTINUE C CALL MATELC ('MASSE ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 3.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 3.D0 DO 320 I=1,NPOINS TRAV1(I) = S2EP * PHYSOL(I,1,3) * PHYSOL(I,1,6) 320 CONTINUE C CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 3.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C C DO 331 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = - (1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * VCOUPS(I,2) & * VCOUPS(I,1) 331 CONTINUE C DO 332 I=1,NBFLUS INODE = NFLUSS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VFLUSS(I) 332 CONTINUE C DO 333 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VECHS(I,2) & * VECHS(I,1) 333 CONTINUE C DO 334 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 HRAYO = VRAYTS(I,2)*SIGMA*(TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * HRAYO & * VRAYTS(I,1) 334 CONTINUE C DO 335 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * VCOUPS(I,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) & - 2.D0*PHYSOL(INODE,1,5)*PHYSOL(INODE,1,4) & * TMPSC3(INODE) 335 CONTINUE C DO 336 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VECHS(I,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 336 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 337 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(INODE) = TRAV1(INODE) + ROCP1 * SUR3 * & PHYSOL(I,1,6) * TMPSC2(I) 337 CONTINUE ENDIF C DO 338 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) * 0.5D0 HRAYO = VRAYTS(I,2)*SIGMA* & (TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) & - (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * HRAYO & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 338 CONTINUE CALL SMFCOQ ( TRAV1,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN DO 3390 I=1,NBFLVS INODE = NFLUVS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + VFLUVS(I,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(INODE,1,5) ) 3390 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 3391 I=1,NBFLVS DO 3392 NJ=1,NDMATS NJGL = NODES(NFLUVS(I),NJ) EPAIS1 = PHYSOL(NJGL,1,6) / 2.D0 TRAV1(NJGL) = TRAV1(NJGL) & + VFLUVS(I,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NJGL,1,5) ) 3392 CONTINUE 3391 CONTINUE C ELSE DO 3393 I=1,NBFLVS DO 3394 NJ=1,NDMATS NJGL = NODES(NFLUVS(I),NJ) EPAIS1 = PHYSOL(NJGL,1,6) / 2.D0 TRAV1(NJGL) = TRAV1(NJGL) & + VFLUVS(I,NJ) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NJGL,1,5) ) 3394 CONTINUE 3393 CONTINUE ENDIF ENDIF C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC2,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 4- CALCUL DE L'EQUATION SUR LE TROISIEME COEFFICIENT C ==================================================== C C C C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C 4.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 6.D0 DO 410 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = S2EP * PHYSOL(INODE,1,4) / EPAIS1 & + (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * VCOUPS(I,2) 410 CONTINUE C DO 411 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) * VECHS(I,2) 411 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 412 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(INODE) = TRAV1(INODE) + ROCP1*SUR5*PHYSOL(I,1,6) 412 CONTINUE ENDIF C DO 413 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 HRAYO = VRAYTS(I,2)*SIGMA* & (TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + & (1.D0-EPAIS1*PHYSOL(INODE,1,5)) * HRAYO 413 CONTINUE C CALL MATELC ('MASSE ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 4.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 5.D0 DO 420 I=1,NPOINS TRAV1(I) = S2EP * PHYSOL(I,1,3) * PHYSOL(I,1,6) 420 CONTINUE C CALL MATELC ('DIFFU ',DMAT,XMAT,TRAV1,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 4.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C C CALL OV ( 'X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C C IF ( .NOT. LCOSTA ) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 430 I=1,NPOINS ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAV1(INODE) = TRAV1(INODE) + ROCP1 * SUR5 & * PHYSOL(I,1,6) * TMPSC3(I) 430 CONTINUE ENDIF C C DO 431 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = (1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * VCOUPS(I,2) & * VCOUPS(I,1) 431 CONTINUE C DO 432 I=1,NBFLUS INODE = NFLUSS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VFLUSS(I) 432 CONTINUE C DO 433 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VECHS(I,2) & * VECHS(I,1) 433 CONTINUE C DO 434 I=1,NBRAYS INODE = NRAYTS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 HRAYO = VRAYTS(I,2)*SIGMA* & (TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) & + (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * HRAYO & * VRAYTS(I,1) 434 CONTINUE C C C DO 435 I=1,NBCOUS INODE = NCOUPS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * VCOUPS(I,2) & - 2.D0*PHYSOL(INODE,1,5)*PHYSOL(INODE,1,4) & * TMPSC2(INODE) 435 CONTINUE C DO 436 I=1,NBECHS INODE = NECHS(I) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0+EPAIS1*PHYSOL(INODE,1,5)) & * VECHS(I,2) & * ( TMPSC2(INODE) + TMPSC1(INODE) ) 436 CONTINUE C DO 437 I=1,NBRAYS INODE = NRAYTS(I) HRAYO = VRAYTS(I,2)*SIGMA* & (TMPS(INODE)+VRAYTS(I,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VRAYTS(I,1)+TKEL)*(VRAYTS(I,1)+TKEL) ) EPAIS1 = PHYSOL(INODE,1,6) / 2.D0 TRAV1(INODE) = TRAV1(INODE) & - (1.D0-EPAIS1*PHYSOL(INODE,1,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * HRAYO c & - 2.D0*PHYSOL(INODE,1,5)*PHYSOL(INODE,1,4) c & * TMPSC2(INODE) 437 CONTINUE C CALL SMFCOQ ( TRAV1,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C C DO 438 I=1,NBDIRS VDIRS(I) = VDIRS(I) - TMPSC1(NDIRS(I)) & + TMPSC2(NDIRS(I)) 438 CONTINUE C C IF ( NBDIRS .GT. 0 ) THEN CALL SMDIRS ( NDIRS,VDIRS,B,DMAT,XMAT,NODES, & TRAV1,TRAV2,TRAV3, & NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, & NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, & WCT ) ENDIF C C 4.4- Resolution de la Troisieme equation C --------------------------------------- C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC3,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 5- CALCUL DE LA TEMPERATURE SUR LES DEUX FACES INT ET EXT C ========================================================= C DO 510 I=1,NPOINS TMPSA(I) = TMPSC1(I) - TMPSC2(I) + TMPSC3(I) 510 CONTINUE C DO 520 I=1,NPOINS TMPS(I) = TMPSC1(I) + TMPSC2(I) + TMPSC3(I) 520 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/psfnc3.F0000666000175000017500000002276111524070643015256 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PSFNC3,SSI=0 SUBROUTINE PSFNC3 C ***************** C C ------------------------------------------------------- * (MODE, * NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, * NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, * NBICOR,BARYF,NCBORF,BARYS,NCBORS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES DU FLUIDE VERS LE SOLIDE ET INVERSE * C en 3D ==> maillage surfacique de dimension 2 * C Les maillages ne sont pas coincidents * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! VCOUPS ! TR !D M ! VALEUR AUX NOEUDS SOLIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELEMENTS FLUIDES COUPLES ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS FLUIDES COUPLES! C ! NODESF ! TE ! D ! TABLE DES ELEMENTS FLUIDES COUPLES (NUM LOC) ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SOLIDES COUPLES ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS SOLIDES COUPLES! C ! NODESS ! TE ! D ! TABLE DES ELEMENTS SOLIDES COUPLES (NUM LOC) ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! BARYF ! TR ! D ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELTS SOLIDES ! C ! NCBORF ! TE ! D ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! D ! CCORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELTS FLUIDES ! C ! NCBORS ! TE ! D ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER MODE,NDIM,NBCOUF,NBCOUS,NELESF,NDMASF,NELESS,NDMASS INTEGER NBICOR DOUBLE PRECISION VCOUPF(NBCOUF,2),VCOUPS(NBCOUS,2) INTEGER NODESF(NELESF,NDMASF),NODESS(NELESS,NDMASS) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) C C..Variables internes INTEGER NF,NUMELF,NUMTRI,NS,NUMELS,N1,N2,N3,N,NAFFIC DOUBLE PRECISION XL1,XL2,XL3 C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE FLUIDE C =================================== C DO 100 NF=1,NBCOUF C NUMELS = NCBORF(NF,1) C NUMTRI = NCBORF(NF,2) C IF (NUMTRI .EQ. 1) THEN N1 = NODESS(NUMELS,1) N2 = NODESS(NUMELS,4) N3 = NODESS(NUMELS,6) ELSEIF (NUMTRI .EQ. 2) THEN N1 = NODESS(NUMELS,4) N2 = NODESS(NUMELS,5) N3 = NODESS(NUMELS,6) ELSEIF (NUMTRI .EQ. 3) THEN N1 = NODESS(NUMELS,2) N2 = NODESS(NUMELS,4) N3 = NODESS(NUMELS,5) ELSE N1 = NODESS(NUMELS,3) N2 = NODESS(NUMELS,5) N3 = NODESS(NUMELS,6) ENDIF C XL1 = BARYF(NF,1) XL2 = BARYF(NF,2) XL3 = BARYF(NF,3) C VCOUPF(NF,1) = VCOUPS(N1,1)*XL1 + VCOUPS(N2,1)*XL2 * + VCOUPS(N3,1)*XL3 C 100 CONTINUE C C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14 .OR. NBLBLA.EQ.141) THEN IF (NBLBLA.EQ.14) THEN NAFFIC=NBCOUF ELSE NAFFIC=50 ENDIF WRITE(NFECRA,1010) DO N=1,NAFFIC WRITE(NFECRA,1020) N,VCOUPF(N,1) ENDDO CALL FLUSHF(NFECRA) ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU FLUIDE VERS LE SOLIDE C =================================== C DO 200 NS=1,NBCOUS C NUMELF = NCBORS(NS,1) C IF (NUMELF.NE.-1) THEN C NUMTRI = NCBORS(NS,2) C IF (NUMTRI .EQ. 0) THEN N1 = NODESF(NUMELF,1) N2 = NODESF(NUMELF,2) N3 = NODESF(NUMELF,3) ELSEIF (NUMTRI .EQ. 1) THEN N1 = NODESF(NUMELF,1) N2 = NODESF(NUMELF,4) N3 = NODESF(NUMELF,6) ELSEIF (NUMTRI .EQ. 2) THEN N1 = NODESF(NUMELF,4) N2 = NODESF(NUMELF,5) N3 = NODESF(NUMELF,6) ELSEIF (NUMTRI .EQ. 3) THEN N1 = NODESF(NUMELF,2) N2 = NODESF(NUMELF,4) N3 = NODESF(NUMELF,5) ELSE N1 = NODESF(NUMELF,3) N2 = NODESF(NUMELF,5) N3 = NODESF(NUMELF,6) ENDIF C XL1 = BARYS(NS,1) XL2 = BARYS(NS,2) XL3 = BARYS(NS,3) C VCOUPS(NS,1) = VCOUPF(N1,1)*XL1 + VCOUPF(N2,1)*XL2 * + VCOUPF(N3,1)*XL3 VCOUPS(NS,2) = VCOUPF(N1,2)*XL1 + VCOUPF(N2,2)*XL2 * + VCOUPF(N3,2)*XL3 C ENDIF C 200 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14 .OR. NBLBLA.EQ.141) THEN IF (NBLBLA.EQ.14) THEN NAFFIC=NBCOUS ELSE NAFFIC=50 ENDIF WRITE(NFECRA,2010) DO 210 N=1,NAFFIC IF (NCBORS(N,1).NE.-1) * WRITE(NFECRA,2020) N,VCOUPS(N,1),VCOUPS(N,2) 210 CONTINUE CALL FLUSHF(NFECRA) ENDIF C C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** PSFNC3 : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE',/, & 5X,' N fluide T ') 1020 FORMAT(5X,3X,I10,6X,G13.7) 2010 FORMAT(/,' *** PSFNC3 : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (vcoups)',/, & 5X,' N solide T h') 2020 FORMAT(5X,3X,I10,6X,G13.7,3X,G13.7) 3000 FORMAT(/,' %% ERREUR PSFNC3 : OPTION DE PASSAGE INCORRECTE ') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/ccondf.F0000666000175000017500000001350311524070643015310 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CCONDF,SSI=0 C SUBROUTINE CCONDF C ***************** C * ( VAL,NREFAL,NELEUS,NCOND,VCOND,NBCOND,NDMASS,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C ON REPERE LES NOEUDS EN UTILISANT LES REFERENCES * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NREFAL ! TE ! D ! REFERENCES DES FACES SOLIDES ! C ! NELEUS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF AVEC FLUX ! C ! NCOND ! TE ! D ! NUMERO GLOB DES NOEUDS DE CONDITION "COND" ! C ! VCOND ! TR ! M ! VALEUR DE LA CONDITION "COND" ! C ! NBCOND ! E ! D ! NOMBRE DE NOEUDS DE CONDITION "COND" ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS SURFACIQUES ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" C C********************************************************************** C C..Variables externes INTEGER NELEUS,NBCOND,NB,NDMASS INTEGER NREFAL(NELEUS),NCOND(NBCOND),IREF(NRFMAX) DOUBLE PRECISION VCOND(NBCOND,NDMASS),VAL C C..Variables internes INTEGER N,N1,NR,NBRE,M,NUMREF C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NBCOND*NDMASS VCOND(N,1) = VAL NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NBCOND C NUMREF = NREFAL(NCOND(N)) C IF (NUMREF .EQ. NR) THEN DO 220 M=1,NDMASS VCOND(N,M) = VAL 220 CONTINUE NBRE = NBRE + 1 ENDIF C 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLA.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' *** CCONDF : Nombre de faces traitees :',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/gausei.F0000666000175000017500000001245611524070643015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE GAUSEI C ***************** C C ---------------------------------------------------------------- * (NELRAY,NUMBS,FDFRAY,SUFRAY,EMISSI,EPROPR,NFFIRA,NGFFIR,RADIOS, * TABRAY) C ---------------------------------------------------------------- C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C Resolution du systeme de rayonnement pour la bande numbs C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NUMBS ! E ! D ! NUMERO DE LA BANDE SPECTRALE ! C ! NELRAY ! E ! D ! NOMBRE D'ELEMENTS (maillage rayt) ! C ! FDFRAY ! TR ! R ! FACTEURS DE FORME RAYONNEMENT ! C ! SUFRAY ! TR ! D ! SURFACE DES ELEMENTS (maillage rayt) ! C ! EMISSI ! TR ! D ! EMISSIVITE (maillage rayt) ! C ! EPROPR ! TR ! D ! EMISSION PROPRE (maillage rayt) ! C ! RADIOS ! TR ! R ! RADIOSITE (maillage rayt) ! C ! NFFIRA ! E ! D ! Nombre de facette de type flux impose ! C ! NGFFIR ! TE ! D ! Numerotation globale des faces a flux impose ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C ********************************************************************** C C.. Variables externes INTEGER NELRAY,NUMBS,NFFIRA INTEGER NGFFIR(NFFIRA) DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION SUFRAY(NELRAY),EPROPR(NELRAY,NBANDE) DOUBLE PRECISION RADIOS(NELRAY,NBANDE),EMISSI(NELRAY,2,NBANDE) DOUBLE PRECISION TABRAY(NELRAY,9) C C.. Variables internes INTEGER N,NGFAC C C*********************************************************************** C IF (NBLBLR.GT.1) WRITE(NFECRA,1000) NUMBS C C 1- TRANSFORMATION DE epsilon en 1-epsilon pour la bande numbs C =========================================================== C DO 11 N=1,NFFIRA NGFAC = NGFFIR(N) EMISSI(NGFAC,2,NUMBS) = 1. 11 CONTINUE C CALL RRAYRC(FDFRAY,SUFRAY,NELRAY,EMISSI,RADIOS,EPROPR,NUMBS, * TABRAY(1,1),TABRAY(1,2),TABRAY(1,3),TABRAY(1,4), * TABRAY(1,5),TABRAY(1,6),TABRAY(1,7),TABRAY(1,8)) C C-------- C FORMATS C-------- C 1000 FORMAT(/' *** GAUSEI : Traitement de la bande spectrale : ',I2) 1001 FORMAT(' *** GAUSEI : Iteration Erreur relative ', & ' Erreur absolue') 1100 FORMAT(18X,I4,9X,E12.7,11X,E12.7) 3020 FORMAT(I4,3X,I4,3X,E15.7,E15.7) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/ecrg2e.F0000666000175000017500000001307011524070643015222 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE ECRG2E C ***************** C C -------------------------------------- * (NBSCAL,NFIC,NDIM,NDIELE,NELEM,NPOIN) C -------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C GENERATION DE L'ENTETE DU FICHIER RESULTAT (partie 1) * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! TYPDOM ! A ! D ! INDIQUE SI ON TRAITE LE MAILLAGE SOLIDE OU ! C ! ! ! ! LA PEAU DU FLUIDE ! C ! ! ! ! TYPDOM = 'S' pour le solide ! C ! ! ! ! 'F' pour le fluide ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NELEM ! E ! D ! NOMBRE D'ELTS DU MAILLAGE TRAITE ! C ! NPOIN ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE TRAITE ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! D ! ! C !/DIVCT/ ! ! D ! ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "divct.h" C C********************************************************************** C C..Variables externes INTEGER NFIC,NDIM,NDIELE,NELEM,NPOIN,NBSCAL C C..Variables internes C C********************************************************************** C FONCTIONS IMPLICITES C********************************************************************** C C********************************************************************** C C C 1- ECRITURE DE L'ENTETE DU PAS DE TEMPS C ======================================= C C 1.1- MISE A JOUR DES VARIABLES PRESENTES DANS L'ENTETE C ------------------------------------------------------ C C TITSOL : Titre du calcul C NELEM : Nombre d'elements C NDIM : Dimension du probleme C NDIELE : Dimension des elements C NPOIN : Nombre total de noeuds P2 C NBSCAL : Nombre de variable scalaires a ecrire C C C 1.3- ENTETE DU PAS DE TEMPS : ECRITURE C -------------------------------------- C WRITE(NFIC,1200) TITSOL,NDIM,NDIELE,NELEM,NPOIN,NBSCAL C C C-------- C FORMATS C-------- C 1200 FORMAT(72('*'),/,A72,/,72('*'),/, & 'C1C* NDIM NDIELE NELEM NPOIN ', & 'NBSCAL',/, & 'C2C*',5I10) C C C END syrthes-3.4.3-dfsg1/src/s/leclir.F0000666000175000017500000010744111524070643015333 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECLIR C ***************** C * ( NDIM,NELRAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE, * NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF,NGFMST,NGFMSE, * EMISSI,TEMRAY,PHFRAF,PHFRAE,FIRAY,VFIRAY,VFMSTE, * PHMSTP,PHMSTO) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER syrthes.ray * C Lecture des CL et donnees physiques pour le rayonnement * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! D ! ! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : POSCOT,POSREE,POSLIS,CCONDR,CCONQ C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "mobil.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" #include "rayonn.h" C C********************************************************************** C INTEGER NVV PARAMETER (NVV=12) C C..Variables externes INTEGER NDIM,NELRAY INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE INTEGER NRFRAY(NELRAY) INTEGER NGFFIR(NFFIRA),NGFTIR(NFTIRA) INTEGER NGFPER(NFPERA),NGFPEF(NFCFRA) INTEGER NGFMST(NFMST,2),NGFMSE(NFMSTE) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE) DOUBLE PRECISION PHFRAF(NFCFRA,4),PHFRAE(NFPERA,4) DOUBLE PRECISION TEMRAY(NELRAY),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2),VFMSTE(NFMSTE,2) DOUBLE PRECISION PHMSTP(NFMST,4),PHMSTO(NFMST,5,NBANDE) C C..Variables internes INTEGER I,I1,I2,N,LCH,II1,II2,NB,NPS,NBAN INTEGER ITAB(NRFMAX) CHARACTER*200 CHAINE,FORMA LOGICAL ERR DOUBLE PRECISION EPSBDE,XLBDA1,XLBDA2,EMILBD,XNUMBA DOUBLE PRECISION VALEQ(4),VALEQ2(6) DOUBLE PRECISION TRIMP,XFLU,SCAPP,AAUX,XNP,APER DOUBLE PRECISION ANG,T,XH INTEGER NUMBAN,NPE C C C********************************************************************** C C 0- INITIALISATIONS C ================== ERR = .FALSE. REWIND (NFCLRA) NPS = 0 EPSBDE = 1E-10 NPE = 0 TEMINF = 20. NBHSOR=0 C C================================================================== C C 0.1- INITIALISATIONS DES BANDES SPECTRALES C ------------------------------------------ DO N=1,NBANDE SPECTL(N,1) = -1. SPECTL(N,2) = -1. ENDDO C C 0.2- INITIALISATIONS DES CARACTERISTIQUES PHYSIQUES C --------------------------------------------------- C DO I=1,NBANDE DO N=1,NELRAY EMISSI(N,1,I) = 1.0 EMISSI(N,2,I) = 0. FIRAY(N,I) = 0. ENDDO ENDDO C DO N=1,NELRAY TEMRAY(N) = 20. ENDDO C DO N=1,NFCFRA PHFRAF(N,1) = 25.1 PHFRAF(N,2) = 0.01 PHFRAF(N,3) = 20. PHFRAF(N,4) = 0. ENDDO C C DO N=1,NFPERA PHFRAE(N,1) = 25.1 PHFRAE(N,2) = 0.01 PHFRAE(N,3) = 20. PHFRAE(N,4) = 0. ENDDO C DO N=1,NFMST PHMSTP(N,1)=7000. PHMSTP(N,2)=460. PHMSTP(N,3)=5. PHMSTP(N,4)=0.005 ENDDO C DO I=1,NBANDE DO N=1,NFMST PHMSTO(N,1,I)=0.8 PHMSTO(N,2,I)=0.2 PHMSTO(N,3,I)=0. PHMSTO(N,4,I)=50. PHMSTO(N,5,I)=1.5 ENDDO ENDDO C DO I=1,NFMSTE VFMSTE(I,1)=20. VFMSTE(I,2)=0. ENDDO C C================================================================== C C C C 0.3- SYMETRIE POUR LE RAYONNEMENT C ---------------------------------- DO 131 N=1,12 PLASYM(N,1) = 0. 131 CONTINUE PLASYM(1,1) = 1. PLASYM(2,2) = 1. PLASYM(3,3) = 1. WRITE(NFECRA,*) C C 0.4- NOMBRE DE COMPOSANTES CONNEXES C ----------------------------------- NUMGU = 0 C C ===================== C 1- LECTURE DU FICHIER C ===================== C REWIND(NFCLRA) C C Boucle de lecture.... 10 CONTINUE C CHAINE = ' ' READ(NFCLRA,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) THEN C GOTO 10 C ELSE C C C ================================= C 2- CONDITIONS POUR LE RAYONNEMENT C ================================= C IF (CHAINE(I1:I2) .EQ. 'RAYT') THEN C C IF (.NOT. LRAY) THEN WRITE(NFECRA,2000) ERR = .TRUE. ELSE CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 2.1- Plans de symetrie C -------------------------- IF (CHAINE(I1:I2) .EQ. 'SYM3D') THEN NPS = NPS + 1 IF (NPS.GT.NPLASY) THEN WRITE (NFECRA,2110) ERR = .TRUE. ELSEIF (NDIM.NE.3) THEN WRITE (NFECRA,2120) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),4,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,4,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) * (PLASYM(I,NPS),I=1,4) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2130) (PLASYM(I,NPS),I=1,4) ENDIF ENDIF C ELSEIF (CHAINE(I1:I2) .EQ. 'SYM2D') THEN NPS = NPS + 1 IF (NPS.GT.NPLASY) THEN WRITE (NFECRA,2110) ERR = .TRUE. ELSEIF (NDIM.NE.2) THEN WRITE (NFECRA,2121) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) * (PLASYM(I,NPS),I=1,3) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2131) (PLASYM(I,NPS),I=1,3) ENDIF ENDIF C C 2.2- Composantes connexes C ------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'VOLUME CONNEXE') THEN CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) NUMGU = NUMGU + 1 READ(CHAINE(I1:I2),FORMA,ERR=9999) * (PINTER(I,NUMGU),I=1,3) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2250) (PINTER(I,NUMGU),I=1,3) ENDIF C C 2.3.1- Bandes spectrales C ----------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'BANDES SPECTRALES') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XNUMBA NUMBAN = INT(XNUMBA+0.1) IF (NUMBAN .LT. 1 .OR. NUMBAN .GT. NBANDE) THEN WRITE(NFECRA,2300) NUMBAN,NBANDE ERR = .TRUE. ENDIF CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XLBDA1,XLBDA2 IF ( SPECTL(NUMBAN,1) .LT. 0. .AND. * SPECTL(NUMBAN,2) .LT. 0.) THEN SPECTL(NUMBAN,1) = XLBDA1 SPECTL(NUMBAN,2) = XLBDA2 ELSEIF ( ABS(XLBDA1-SPECTL(NUMBAN,1)) .GT. EPSBDE * .OR. ABS(XLBDA2-SPECTL(NUMBAN,2)) .GT. EPSBDE ) * THEN WRITE(NFECRA,2310) NUMBAN,SPECTL(NUMBAN,1), * SPECTL(NUMBAN,2),XLBDA1,XLBDA2 ERR = .TRUE. ELSE SPECTL(NUMBAN,1) = XLBDA1 SPECTL(NUMBAN,2) = XLBDA2 ENDIF IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2320) NUMBAN,XLBDA1,XLBDA2 ENDIF C C C 2.3.2- Emissivite par bande spectrale C ----------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'EMISSIVITE PAR BANDE') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XNUMBA NUMBAN = INT(XNUMBA+0.1) IF (NUMBAN .LT. 1 .OR. NUMBAN .GT. NBANDE) THEN WRITE(NFECRA,2300) NUMBAN,NBANDE ERR = .TRUE. ENDIF CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) EMILBD II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2321) NUMBAN,EMILBD,(ITAB(I),I=1,NB) ENDIF CALL CCONDR(EMILBD,NRFRAY,NELRAY,EMISSI,NUMBAN, * ITAB,NB) C C 2.4- Initialisation pour les caracteristiques equiv des C zones de rayonnement couplee au fluide. C ------------------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. * 'PROPRIETES PAROI EQUIVALENTE COUPLEE FLUIDE') THEN CALL POSREE(CHAINE(I2+2:),4,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,4,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VALEQ(I),I=1,4) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,*) ENDIF II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCOEQF(VALEQ,NELRAY,NRFRAY,NFCFRA,PHFRAF,NGFPEF, * ITAB,NB) C C 2.5- Initialisation pour les caracteristiques equiv des C zones de rayonnement isolees. C ------------------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. * 'PROPRIETES PAROI EQUIVALENTE ISOLEE') THEN CALL POSREE(CHAINE(I2+2:),4,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,4,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VALEQ(I),I=1,4) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,*) ENDIF II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCOEQI(VALEQ,NELRAY,NRFRAY,NFPERA,PHFRAE,NGFPER, * ITAB,NB) C C 2.6- Traitement de la temperature impose C pour chaque element de rayonnement C ------------------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. * 'TEMPERATURE IMPOSEE') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) TRIMP IF (NBLBLR.GE.2) THEN WRITE(NFECRA,*) ENDIF II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONDT(TRIMP,NRFRAY,NELRAY,NFTIRA,NGFTIR, * TEMRAY,ITAB,NB) C C 2.7- Initialisation du flux impose pour chaque bande C pour chaque element de rayonnement C ------------------------------------------- ELSEIF (CHAINE(I1:I2) .EQ. * 'FLUX IMPOSE PAR BANDE') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XNUMBA NUMBAN = INT(XNUMBA+0.1) IF (NUMBAN .LT. 1 .OR. NUMBAN .GT. NBANDE) THEN WRITE(NFECRA,2300) NUMBAN,NBANDE ERR = .TRUE. ENDIF CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XFLU IF (NBLBLR.GE.2) THEN WRITE(NFECRA,*) ENDIF II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONFI(XFLU,NRFRAY,NELRAY,NFFIRA,NGFFIR,FIRAY, * VFIRAY,NUMBAN,ITAB,NB) C C 2.8- Periodicite en rayonnement C -------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'PERIO3D') THEN NPE = NPE + 1 IF (NPE.GT.0 .AND. .NOT.LPERAY) THEN WRITE (NFECRA,2800) ERR = .TRUE. ELSEIF (NDIM.NE.3) THEN WRITE (NFECRA,2810) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),7,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,7,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) * (PERRAY(I),I=1,7) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2820) (PERRAY(I),I=1,7) ENDIF C Normalisation APER = SQRT(PERRAY(4)*PERRAY(4)+PERRAY(5)*PERRAY(5)+ & PERRAY(6)*PERRAY(6)) PERRAY(4) = PERRAY(4)/APER PERRAY(5) = PERRAY(5)/APER PERRAY(6) = PERRAY(6)/APER ENDIF C ELSEIF (CHAINE(I1:I2) .EQ. 'PERIO2D') THEN NPE = NPE + 1 IF (NPE.GT.0 .AND. .NOT.LPERAY) THEN WRITE (NFECRA,2800) ERR = .TRUE. ELSEIF (NDIM.NE.2) THEN WRITE (NFECRA,2811) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) * (PERRAY(I),I=1,3) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,2821) (PERRAY(I),I=1,3) ENDIF ENDIF C C 2.10- Temperature pour l'infini (domaines ouverts) C ----------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'TEMPERATURE INFINI') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) TEMINF C ENDIF C ENDIF C C C ============ C HISTORIQUES C ============ C ELSEIF (CHAINE(I1:I2) .EQ. 'HISTORIQUES') THEN IF (.NOT.LHISOR) THEN WRITE (NFECRA,4000) ELSE II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) IF (NB.GT.NRFMAX) THEN WRITE(NFECRA,4010) NRFMAX ERR=.TRUE. ENDIF IF (NBHSOR+NB.GT.NHRMAX) THEN WRITE(NFECRA,4020) NHRMAX ERR=.TRUE. ENDIF I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) DO I=1,NB NHISOR(NBHSOR+I)=ITAB(I) ENDDO NBHSOR=NBHSOR+NB ENDIF C C ======================================================== C 3- CONDITIONS POUR LES MILIEUX SEMI TRANSPARENTS SOLIDES C ======================================================== C ELSEIF (CHAINE(I1:I2) .EQ. 'MSTS') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 3.1- Proprietes physiques C -------------------------- IF (CHAINE(I1:I2) .EQ. 'CPHY') THEN CALL POSREE(CHAINE(I2+2:),4,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,4,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VALEQ2(I),I=1,4) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCOMST(VALEQ2,NELRAY,NRFRAY,NFMST,PHMSTP,PHMSTO, * NGFMST,ITAB,NB,1) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,3210) (VALEQ2(I),I=1,4), * (ITAB(I),I=1,NB) ENDIF C C 3.2- Proprietes optiques C -------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'OPTIQUE') THEN CALL POSREE(CHAINE(I2+2:),6,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,6,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VALEQ2(I),I=1,6) NBAN=INT(VALEQ2(1)+0.1) IF (NBAN.LT.0 .OR. NBAN.GT.NBANDE) THEN WRITE(NFECRA,3200) NBAN,NBANDE ERR=.TRUE. ENDIF II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCOMST(VALEQ2,NELRAY,NRFRAY,NFMST,PHMSTP,PHMSTO, * NGFMST,ITAB,NB,2) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,3220) NBAN,(VALEQ2(I),I=2,6), * (ITAB(I),I=1,NB) ENDIF C C 3.3- Temperature initiale C ------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'T INITIALE') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) TRIMP II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONDT(TRIMP,NRFRAY,NELRAY,NFMST,NGFMST(1,1), * TEMRAY,ITAB,NB) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,3230) TRIMP,(ITAB(I),I=1,NB) ENDIF C C 3.4- T ext et coeff d'echange C ----------------------------- ELSEIF (CHAINE(I1:I2) .EQ. 'COEF ECH') THEN CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) T,XH II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONDM(T,XH,NRFRAY,NELRAY,NFMSTE,NGFMSE,VFMSTE, * ITAB,NB) IF (NBLBLR.GE.2) THEN WRITE(NFECRA,3240) T,XH,(ITAB(I),I=1,NB) ENDIF C ELSE WRITE(NFECRA,6000) CHAINE ERR=.TRUE. ENDIF C C ENDIF C ENDIF C GOTO 10 C 999 CONTINUE C C C 3- VERIFICATIONS C ================ C C IF (NUMGU.GT.NGUMAX) THEN WRITE(NFECRA,3000) NGUMAX ERR = .TRUE. ENDIF C IF (NDIM.EQ.2 .AND. LPERAY .AND. NPLASY .GT. 0) THEN WRITE(NFECRA,3010) ERR = .TRUE. ENDIF C IF (NDIM.EQ.2 .AND. NPLASY.GT.2) THEN WRITE(NFECRA,3020) ERR = .TRUE. ENDIF IF (NDIM.EQ.3 .AND. NPLASY.GT.3) THEN WRITE(NFECRA,3030) ERR = .TRUE. ENDIF C IF (LPERAY) THEN IF (NDIM.EQ.2) THEN ANG=PERRAY(3) ELSE ANG=PERRAY(7) ENDIF AAUX = INT(360./ANG+0.01)-360./ANG IF (ABS(AAUX) .GT. 0.001) THEN WRITE(NFECRA,3100) ANG ERR = .TRUE. ENDIF C IF (NDIM.EQ.3 .AND. NPS .EQ. 1) THEN XNP = SQRT(PLASYM(1,1)*PLASYM(1,1) & +PLASYM(2,1)*PLASYM(2,1) & +PLASYM(3,1)*PLASYM(3,1)) PLASYM(1,1) = PLASYM(1,1) / XNP PLASYM(2,1) = PLASYM(2,1) / XNP PLASYM(3,1) = PLASYM(3,1) / XNP SCAPP = PLASYM(1,1)*PERRAY(4)+ & PLASYM(2,1)*PERRAY(5)+ & PLASYM(3,1)*PERRAY(6) IF ( ABS(ABS(SCAPP)-1.) .GT. 1.E-5) THEN WRITE(NFECRA,3110) ERR = .TRUE. ENDIF ELSEIF (NDIM.EQ.2 .AND. NPS .EQ. 1) THEN WRITE(NFECRA,3120) ERR = .TRUE. ENDIF C ENDIF C IF (NBHSOR.EQ.0) LHISOR=.FALSE. C C 4- STOP EN CAS D'ERREUR DANS LES MOTS-CLES C ========================================== IF (ERR) STOP C C C 5- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLR.GE.3) THEN C IF (LHISOR) THEN WRITE(NFECRA,5010) NBHSOR WRITE(NFECRA,5011) (NHISOR(I),I=1,NBHSOR) ENDIF C ENDIF C GOTO 300 C C 6. Erreur de lecture sur le fichier C =================================== 9999 WRITE(NFECRA,6000) CHAINE STOP C 300 CONTINUE C-------- C FORMATS C-------- 1000 FORMAT(A200) C 1162 FORMAT(/,' %% ERREUR LECLIR : LE TYPE DE CONDITION A LA LIMITE', & ' CITE N''EST PAS RECONNU',/, & ' ??? ',A) C 1310 FORMAT(' *** LECLIR : Masse volumique',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1351 FORMAT(/,' %% ERREUR LECLIR : LA CONDITION PHYSIQUE INDIQUEE', & ' N''EST PAS RECONNUE',/, & ' ??? ',A) C C 1118 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''CLIM'' ''DIRICHLET'' ',/, * 20X,'alors qu''aucun Dirichlet n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS SOLIDES AVEC DIRICHLET'')') C 2000 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ',/, * 20X,'alors que le rayonnement n''est pas en pris ', * 'en compte ',/, * 20X,'(cf ''PRISE EN COMPTE DU RAYONNEMENT='')') 2110 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''SYM3D'' ',/, * 20X,'on definit plus de plans de symetrie qu''il n''y ', * 'en a de declares ',/, * 20X,'(cf ''NOMBRE DE PLANS DE SYMETRIE POUR ', * 'LE RAYONNEMENT='')') 2120 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''SYM3D'' ',/, * 20X,'Le probleme actuel n''est pas de dimension 3 ',/, * 20X,'(cf ''SYM2D'')') 2121 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''SYM2D'' ',/, * 20X,'Le probleme actuel n''est pas de dimension 2 ',/, * 20X,'(cf ''SYM3D'')') 2130 FORMAT(' *** LECLIR : Symetrie pour le rayonnement',/, * 14X,E12.5,' X + ',E12.5,' Y + ',E12.5,' Z + ', * E12.5,' = 0') 2131 FORMAT(' *** LECLIR : Symetrie pour le rayonnement',/, * 14X,E12.5,' X + ',E12.5,' Y + ',E12.5,' = 0') C 2250 FORMAT(' *** LECLIR : Rayonnement : composante connexe',/, * 14X,'Point interieur : ',3E12.5) C 2300 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''BANDES SPECTRALES'' ',/, * 20X,'le numero de bande spectrale indique :',I2,' est incoherent' * ,/,20X,'avec le nombre de bandes definies precedemment (',I2,')') 2310 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''BANDES SPECTRALES'' ',/, * 20X,'les bornes de la bande spectrale ',I2,' sont incoherentes' * ,/,20X,'avec les bornes precedemment definies pour cette bande.' * ,/,20X, * 'Precedente occurence : Lambda_1 = ',E10.5,' Lambda_2 = ',E10.5 * ,/,20X, * 'Presente occurence : Lambda_1 = ',E10.5,' Lambda_2 = ',E10.5) 2320 FORMAT(' *** LECLIR : Definition de la bande spectrale ',I2,/, * 14X,'Limites de la bande :',2E12.5) 2321 FORMAT(' *** LECLIR : emissivite de la bande spectrale ',I2,/, * 14X,'Emisivite :',E12.5,/, * 14X,'References : ',32I3) C 2800 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''PERIO3D'' ou ''PERIO2D'' ',/, * 20X,'La periodicite n''a pas ete declaree au prealable ',/, * 20X,'(cf ''PERIODICITE DE ROTATION POUR LE RAYONNEMENT'' ') 2810 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''PERIO3D'' ',/, * 20X,'Le probleme actuel n''est pas de dimension 3 ',/, * 20X,'(cf ''PERIO2D'')') 2811 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''PERIO2D'' ',/, * 20X,'Le probleme actuel n''est pas de dimension 2 ',/, * 20X,'(cf ''PERIO3D'')') 2820 FORMAT(' *** LECLIR : Periodicite pour le rayonnement',/, * 14X,'Point invariant : Px = ',E12.5,' Py = ',E12.5, * ' Pz = ',E12.5,/, * 14X,'Axe de la rotation : Ax = ',E12.5,' Ay = ',E12.5, * ' Az = ',E12.5,/, * 14X,'Angle = ',E12.5) 2821 FORMAT(' *** LECLIR : Periodicite pour le rayonnement',/, * 14X,'Point invariant : Px = ',E12.5,' Py = ',E12.5,/, * 14X,'Angle = ',E12.5) C 3000 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''VOLUME CONNEXE'' ',/, * 20X,'le nombre de composantes connexes definies est superieur ' * ,/,'au maximum autorise (',I2,')') 3010 FORMAT(/,' %% ERREUR LECLIR : MOT-CLE " NOMBRE DE ', & 'PLANS DE SYMETRIE POUR LE RAYONNEMENT="',/, & ' et " PERIODICITE', & 'DE ROTATION POUR LE RAYONNEMENT="',/, & ' Ces 2 options ne peuvent etre activees ', & 'simultanement en dimension 2',/) C 3020 FORMAT(/,' %% ERREUR LECLIR : MOT-CLE " NOMBRE DE ', & 'PLANS DE SYMETRIE POUR LE RAYONNEMENT="',/, & ' Il ne peut y avoir plus de 2 plans de symetrie ', & 'en dimension 2',/) 3030 FORMAT(/,' %% ERREUR LECLIR : MOT-CLE " NOMBRE DE ', & 'PLANS DE SYMETRIE POUR LE RAYONNEMENT="',/, & ' Il ne peut y avoir plus de 3 plans de symetrie ', & 'en dimension 3',/) C C 3100 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''PERIO3D'' ou ''PERIO2D'' ',/, * 20X,' L''angle defini',E12.5,' ne convient pas.',/, * 20X,'On doit pouvoir faire 360 degres avec un', * 'multiple entier de cet angle') 3110 FORMAT(/,' %% ERREUR LECLIR : utilisation du mot-cle', * ' ''RAYT'' ''PERIO3D'' ',/, * 20X,'L''axe definissant la periodicite n''est pas orthogonal', * 20X,'au plan de symetrie defini') 3120 FORMAT(/,' %% ERREUR LECLIR : en dimension 2 on ne peut definir', * ' a la fois',/, * 20X,'de la periodicite ET de la symetrie') 3200 FORMAT(/,' %% ERREUR LECLIR : proprietes optiques d''un milieu', * ' semi transparent',/, * 20X,'le numero de bande spectrale n''est pas coherent avec', * ' le nombre total de bandes definies',/, * 20X,'-> numero de bande fourni = ',I6,/, * 20x,'-> il devrait etre entre 0 et ',I3) 3210 FORMAT(' *** LECLIR : Proprietes physiques d''un MST',/, * 14X,'rho= ',E12.5,' Cp= ',E12.5,/, * 14X,' k= ',E12.5,' epaisseur= ',E12.5,/, * 14X,'References : ',32I3) 3220 FORMAT(' *** LECLIR : Proprietes optiques d''un MST',/, * 14X,' Bande : ',I3,/, * 14X,' emissivite= ',E12.5,' reflectivite= ',E12.5,/, * 14X,' transmittivite= ',E12.5,' extinction = ',E12.5,/, * 14X,' refraction= ',E12.5,/, * 14X,'References : ',32I3) 3230 FORMAT(' *** LECLIR : Temperature initiale d''un MST',/, * 14X,' T (C) = ',E12.5,/, * 14X,'References : ',32I3) 3240 FORMAT(' *** LECLIR : Echange sur un MST',/, * 14X,' T (C) = ',E12.5, 'h = ',E12.5,/, * 14X,'References : ',32I3) C 4000 FORMAT(/,' $$ ATTENTION LECLIR : MOT-CLE "HISTORIQUES" ',/, * 20X,'Les historiques sur les facettes de rayonnement ',/, * 20X,'n''ont pas ete demandes (cf ''HISTORIQUES'')',/, * 20X,'On continue normalement...') 4010 FORMAT(/,' %% ERREUR LECLIR : MOT-CLE "HISTORIQUES" ',/, * 20X,'Le nombre de facettes est limite a ',I3,' par ligne',/, * 20X,'Utiliser le mot-cle plusieurs fois pour definir ', * ' toutes vos facettes') 4020 FORMAT(/,' %% ERREUR LECLIR : MOT-CLE "HISTORIQUES" ',/, * 20X,'Le nombre total de facettes est limite a ',I4) C 5010 FORMAT(' *** LECLIR : Nombre d''historiques sur les facettes :', * I7,/, * 14X,'Liste des facettes :') 5011 FORMAT(100(1X,10I7,/)) C 6000 FORMAT(/,' %% ERREUR LECLIR : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des conditions limites et ', * 'physiques',/, * 20X,'Ligne concernee : ',A) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/mamass.F0000666000175000017500000003140611524070643015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MAMASS,SSI=0 C SUBROUTINE MAMASS C ****************** C C ------------------------------------------------------ *( XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DES MATRICES ELEMENTAIRES DE MASSE * C PROBLEMES BIDIMENSIONNELS ET TRIDIMENSIONNEL * C * C * C Ce sous programme constitue une extension de travaux effectuees * C par F. JAUBERTEAU et J.P. GREGOIRE, portant sur l'integration * C analytique des matrices elementaires par les formules de * C Zienkiewicz * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! XMAT ! TR ! R ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! COEFMA ! TR ! D ! COEFFICIENTS DES MATRICES ! C ! ! ! ! coefma(n) = rho Cp / dt pour masse ! C ! PHYSOL ! TR ! D ! Tableau contenant les propri physiques ! C ! ! TR ! D ! On utilise uniquement PHYSOL(n,>=3) ! C ! ! ! ! contient les valeurs des kii sui isotro! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C ! ! ! ! (diagonale non assemblee) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : MATELE C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA INTEGER NPOUE,NPPEL,NBPHYS INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION COEFMA(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS),VOLUME(NELEMS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes DOUBLE PRECISION ZERO INTEGER I,NCA INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 DOUBLE PRECISION S240,SV240,S960,SV960,S1440,SV1440 DOUBLE PRECISION R1,R2,R3 DOUBLE PRECISION RC1,RC2,RC3,RC4,RC5,RC6,RC7,RC8,RC9,RC10 DOUBLE PRECISION RINDTS,RIN960,RCE C LOGICAL LVERIF C*********************************************************************** C C INITIALISATIONS C ================ C LVERIF = .FALSE. ZERO = 0.D0 RINDTS = 1.D0 / RDTTS IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C S240 = 1.D0 / 240.D0 S960 = 1.D0 / 960.D0 S1440 = 1.D0 / 1440.D0 C C 1- CAS BIDIMENSIONNEL C ====================== C IF ( NDIM . EQ . 2 ) THEN C C 1.1 CAS BIDIMENSIONNEL CARTESIEN C -------------------------------- C IF (IAXISY.EQ.0) THEN C C DO 110 I=1,NELEMS C IF (NDPROP .EQ. 1) THEN N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C RC1 = COEFMA(N1) RC2 = COEFMA(N2) RC3 = COEFMA(N3) RC4 = COEFMA(N4) RC5 = COEFMA(N5) RC6 = COEFMA(N6) ELSEIF( NDPROP .EQ. 2) THEN RCE = PHYSOL(I,1,1)*PHYSOL(I,1,2)*RINDTS RC1 = RCE RC2 = RCE RC3 = RCE RC4 = RCE RC5 = RCE RC6 = RCE ELSE RC1 = PHYSOL(I,1,1)*PHYSOL(I,1,2)*RINDTS RC2 = PHYSOL(I,2,1)*PHYSOL(I,2,2)*RINDTS RC3 = PHYSOL(I,3,1)*PHYSOL(I,3,2)*RINDTS RC4 = PHYSOL(I,4,1)*PHYSOL(I,4,2)*RINDTS RC5 = PHYSOL(I,5,1)*PHYSOL(I,5,2)*RINDTS RC6 = PHYSOL(I,6,1)*PHYSOL(I,6,2)*RINDTS ENDIF C C Calcul des termes diagonaux (mass-lumpe) C ---------------------------------------- C SV240 = S240 * VOLUME(I) C C WCT(I,1) = SV240 * ( 10*RC1 + 5*(RC4+RC6) ) WCT(I,2) = SV240 * ( 5*(RC4+RC5) + 10*RC2 ) WCT(I,3) = SV240 * ( 5*(RC5+RC6) + 10*RC3 ) WCT(I,4) = SV240 * ( 5*(RC1+RC2) + 30*RC4 + 10*(RC5+RC6) ) WCT(I,5) = SV240 * ( 5*(RC2+RC3) + 30*RC5 + 10*(RC4+RC6) ) WCT(I,6) = SV240 * ( 5*(RC1+RC3) + 30*RC6 + 10*(RC4+RC5) ) C 110 CONTINUE C C C 1.2- CAS AXISYMETRIQUE (DONC 2D) C -------------------------------- ELSE C DO 120 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) C IF (NDPROP .EQ. 1) THEN N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C RC1 = COEFMA(N1) RC2 = COEFMA(N2) RC3 = COEFMA(N3) RC4 = COEFMA(N4) RC5 = COEFMA(N5) RC6 = COEFMA(N6) ELSEIF( NDPROP .EQ. 2) THEN RCE = PHYSOL(I,1,1)*PHYSOL(I,1,2)*RINDTS RC1 = RCE RC2 = RCE RC3 = RCE RC4 = RCE RC5 = RCE RC6 = RCE ELSE RC1 = PHYSOL(I,1,1)*PHYSOL(I,1,2)*RINDTS RC2 = PHYSOL(I,2,1)*PHYSOL(I,2,2)*RINDTS RC3 = PHYSOL(I,3,1)*PHYSOL(I,3,2)*RINDTS RC4 = PHYSOL(I,4,1)*PHYSOL(I,4,2)*RINDTS RC5 = PHYSOL(I,5,1)*PHYSOL(I,5,2)*RINDTS RC6 = PHYSOL(I,6,1)*PHYSOL(I,6,2)*RINDTS ENDIF C C Calcul des termes diagonaux (mass-lumpe) C --------------------------------------- SV1440 = S1440 * VOLUME(I) C C l'axe Y est pris comme coordonne radiale C l'axe X est pris comme axe de rotation R1 = ABS(COORDS(N1,NCA)) * SV1440 R2 = ABS(COORDS(N2,NCA)) * SV1440 R3 = ABS(COORDS(N3,NCA)) * SV1440 C C WCT(I,1) = RC1 * ( 48*R1 + 6*(R2+R3) ) + & RC4 * ( 21*R1 + 6*R2 + 3*R3 ) + & RC6 * ( 21*R1 + 3*R2 + 6*R3 ) WCT(I,2) = RC2 * ( 48*R2 + 6*(R1+R3) ) + & RC4 * ( 21*R2 + 6*R1 + 3*R3 ) + & RC5 * ( 21*R2 + 3*R1 + 6*R3 ) WCT(I,3) = RC3 * ( 48*R3 + 6*(R1+R2) ) + & RC5 * ( 21*R3 + 6*R2 + 3*R1 ) + & RC6 * ( 21*R3 + 3*R2 + 6*R1 ) WCT(I,4) = RC1 * ( 21*R1 + 6*R2 + 3*R3 ) + & RC2 * ( 6*R1 + 21*R2 + 3*R3 ) + & RC4 * ( 78*(R1+R2) + 24*R3 ) + & RC5 * ( 15*(R1+R3) + 30*R2 ) + & RC6 * ( 15*(R2+R3) + 30*R1 ) WCT(I,5) = RC2 * ( 21*R2 + 6*R3 + 3*R1 ) + & RC3 * ( 6*R2 + 21*R3 + 3*R1 ) + & RC5 * ( 78*(R2+R3) + 24*R1 ) + & RC4 * ( 15*(R1+R3) + 30*R2 ) + & RC6 * ( 15*(R1+R2) + 30*R3 ) WCT(I,6) = RC1 * ( 21*R1 + 6*R3 + 3*R2 ) + & RC3 * ( 6*R1 + 21*R3 + 3*R2 ) + & RC6 * ( 78*(R1+R3) + 24*R2 ) + & RC4 * ( 15*(R2+R3) + 30*R1 ) + & RC5 * ( 15*(R1+R2) + 30*R3 ) C 120 CONTINUE C ENDIF C C C C C 2- CAS TRIDIMENSIONNEL C ====================== ELSE C DO 210 I=1,NELEMS C SV960 = S960 * VOLUME(I) C IF (NDPROP .EQ. 1) THEN N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10 = NODES(I,10) C RC1 = SV960 * COEFMA(N1) RC2 = SV960 * COEFMA(N2) RC3 = SV960 * COEFMA(N3) RC4 = SV960 * COEFMA(N4) RC5 = SV960 * COEFMA(N5) RC6 = SV960 * COEFMA(N6) RC7 = SV960 * COEFMA(N7) RC8 = SV960 * COEFMA(N8) RC9 = SV960 * COEFMA(N9) RC10 = SV960 * COEFMA(N10) ELSEIF( NDPROP .EQ. 2) THEN RCE = SV960 * PHYSOL(I,1,1)*PHYSOL(I,1,2)*RINDTS RC1 = RCE RC2 = RCE RC3 = RCE RC4 = RCE RC5 = RCE RC6 = RCE RC7 = RCE RC8 = RCE RC9 = RCE RC10 = RCE ELSE RIN960 = RINDTS*SV960 RC1 = PHYSOL(I,1,1)*PHYSOL(I,1,2)*RIN960 RC2 = PHYSOL(I,2,1)*PHYSOL(I,2,2)*RIN960 RC3 = PHYSOL(I,3,1)*PHYSOL(I,3,2)*RIN960 RC4 = PHYSOL(I,4,1)*PHYSOL(I,4,2)*RIN960 RC5 = PHYSOL(I,5,1)*PHYSOL(I,5,2)*RIN960 RC6 = PHYSOL(I,6,1)*PHYSOL(I,6,2)*RIN960 RC7 = PHYSOL(I,7,1)*PHYSOL(I,7,2)*RIN960 RC8 = PHYSOL(I,8,1)*PHYSOL(I,8,2)*RIN960 RC9 = PHYSOL(I,9,1)*PHYSOL(I,9,2)*RIN960 RC10= PHYSOL(I,10,1)*PHYSOL(I,10,2)*RIN960 ENDIF C C WCT(I,1) = 12*RC1+6*(RC5+RC7+RC8) WCT(I,2) = 12*RC2+6*(RC5+RC6+RC9) WCT(I,3) = 12*RC3+6*(RC6+RC7+RC10) WCT(I,4) = 12*RC4+6*(RC8+RC9+RC10) WCT(I,5) = 6*(RC1+RC2)+12*(RC7+RC9)+18*(RC6+RC8)+48*RC5 WCT(I,6) = 6*(RC2+RC3)+18*(RC5+RC7+RC9+RC10)+24*RC8+72*RC6 WCT(I,7) = 6*(RC1+RC3)+12*(RC5+RC10)+18*(RC6+RC8)+48*RC7 WCT(I,8) = 6*(RC1+RC4)+18*(RC5+RC7+RC9+RC10)+24*RC6+72*RC8 WCT(I,9) = 6*(RC2+RC4)+12*(RC5+RC10)+18*(RC6+RC8)+48*RC9 WCT(I,10) = 6*(RC3+RC4)+12*(RC7+RC9)+18*(RC6+RC8)+48*RC10 C C 210 CONTINUE C C C Fin du cas 3D ENDIF C C------- C FORMAT C------- C C END syrthes-3.4.3-dfsg1/src/s/permut.F0000666000175000017500000001044011524070643015365 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PERMUT,SSI=0 SUBROUTINE PERMUT C ***************** C C ------------------ * (N1,N2,NTAB,MI,MJ) C ------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PERMUTATION DES ELEMENTS N1 ET N2 DANS LA TABLE NTAB * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! N1,N2 ! E ! D ! NUMERO DES 2 ELEMENTS A PERMUTER ! C ! MI,MJ ! E ! D ! DIMENSIONS DU TABLEAU NTAB ! C ! NTAB ! TE ! M ! TABLEAU OU IL FAUT FAIRE LA PERMUTATION ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C C*********************************************************************** C INTEGER IT PARAMETER (IT=10) C C.. Variables externes INTEGER N1,N2,MI,MJ,NTAB(MI,MJ) C C.. Variables internes INTEGER ITAB(IT),I C C*********************************************************************** C C 1- CONSERVATION DES NOEUDS DE L'ELEMENT N1 C ------------------------------------------ C DO 100 I=1,MJ ITAB(I) = NTAB(N1,I) 100 CONTINUE C C C 2- N2 EST MIS A LA PLACE DE N1 C ------------------------------ C DO 200 I=1,MJ NTAB(N1,I) = NTAB(N2,I) 200 CONTINUE C C 3- N2 REPREND LES NOEUDS DE N1 C ------------------------------ C DO 300 I=1,MJ NTAB(N2,I) = ITAB(I) 300 CONTINUE C C END syrthes-3.4.3-dfsg1/src/s/smdirs.F0000666000175000017500000002477511524070643015372 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMDIRS,SSI=0 C SUBROUTINE SMDIRS C ***************** C C --------------------------------------------------- *( NDIRS,VDIRS,B,DMAT,XMAT,NODES, * TRAV,DIRIND,DIRVAL, * NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, * NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, * WCT ) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C PRISE EN COMPTE DES CONDITIONS DE DIRICHLET * C * C On utilise la procedure suivante: * C * C On veut resoudre M X = B * C On initialise un vecteur DIRVAL de longueur NPOINS * C On stocke la valeur impose de dirichlet dans DIRVAL * C On effectue M . DIRVAL (contribution des noeuds dirichlet) * C On met a jour le second membre B - M . DIRVAL * C On modifie le second membre pour mettre la valeur Dirichlet * C On modifie la matrice M pour chaque noeud de dirichlet: * C on met les coefficients de ligne et colonne a 0 * C on met 1 sur la diagonale * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIRS ! TR ! D ! NUMERO DES POINTS DE DIRICHLET ! C ! VDIRS ! TR ! D ! VALEUR DE DIRICHLET ! C ! B ! TR ! R ! SECOND MEMBRE (Partie explicite ! C ! DMAT ! TR ! R ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! R ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! NODES ! TE ! D ! NUMERO DES NOEUDS ( LOCALE --> GLOBALE ) ! C ! DIRIND ! TR ! M ! INDICATEUR DE DIRICHLET (Tab Travail ) ! C ! DIRVAL ! TR ! M ! VALEUR DE DIRICHLET (Tab travail) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL (NELEMS*NDMATS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA,NDIELE INTEGER NBPRIO,NBCOPR,NELEPR INTEGER NODEPR(NELEPR,NDMATS+1),NPRIOS(NBPRIO,1+NBCOPR) INTEGER NODES(NELEMS,NDMATS) INTEGER NDIRS(NBDIRS) C DOUBLE PRECISION B(NPOINS),DMAT(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION VDIRS(NBDIRS) DOUBLE PRECISION DIRVAL(NPOINS),DIRIND(NPOINS),TRAV(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C DOUBLE PRECISION VIND1,VIND2,VIND3,VIND4,VIND5 DOUBLE PRECISION VIND6,VIND7,VIND8,VIND9,VIND10 C C..Variables locales DOUBLE PRECISION C,ZERO,ZUN INTEGER I,INODE LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .TRUE. ZERO = 0.D0 ZUN = 1.D0 C CALL OV ( 'X=C ',DIRIND,DIRIND,DIRIND,ZUN,NPOINS ) CALL OV ( 'X=C ',DIRVAL,DIRVAL,DIRVAL,ZERO,NPOINS ) CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) C C 2- MODIFICATION DU SECOND MEMBRE C ==================================== C 2.1- Changement des vecteurs DIRIND et DIRVAL C --------------------------------------------- C DO 200 I=1,NBDIRS INODE = NDIRS(I) DIRIND(INODE) = 0.D0 DIRVAL(INODE) = VDIRS(I) 200 CONTINUE C C 2.2- Modification du second membre pour noeud autre que C dirichlet C ---------------------------------- CALL OMV ( 'X=MY ',TRAV,DMAT,XMAT,DIRVAL,C,NODES,WCT, & NPOINS,NDMATS,NCOEMA,NDIELE,NELEMS, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR) CALL OV ( 'X=Y-Z ',B,B,TRAV,ZERO,NPOINS ) C C 2.3- Modification du second membre pour les noeuds dirichlets C ------------------------------------------------------------- C On fait B = valeur au noeud (ici DIRVAL ou VDIRS) DO 230 I=1,NBDIRS B(NDIRS(I)) = VDIRS(I) 230 CONTINUE C C 3- MODIFICATION DE LA MATRICE C ============================= C 3.1- Modification de la diagonale C ------------------------------------- C DO 310 I=1,NBDIRS DMAT(NDIRS(I)) = 1.D0 310 CONTINUE C C 3.2- Modification des termes extras diagonaux C ------------------------------------- C C 3.2.1- CAS des triangles C ------------------------ IF ( NDIELE .EQ. 2) THEN C DO 321 I=1,NELEMS C VIND1 = DIRIND(NODES(I,1)) VIND2 = DIRIND(NODES(I,2)) VIND3 = DIRIND(NODES(I,3)) VIND4 = DIRIND(NODES(I,4)) VIND5 = DIRIND(NODES(I,5)) VIND6 = DIRIND(NODES(I,6)) C XMAT(I,1) = XMAT(I,1) * VIND1 * VIND4 XMAT(I,2) = XMAT(I,2) * VIND1 * VIND6 XMAT(I,3) = XMAT(I,3) * VIND2 * VIND4 XMAT(I,4) = XMAT(I,4) * VIND2 * VIND5 XMAT(I,5) = XMAT(I,5) * VIND3 * VIND5 XMAT(I,6) = XMAT(I,6) * VIND3 * VIND6 XMAT(I,7) = XMAT(I,7) * VIND4 * VIND5 XMAT(I,8) = XMAT(I,8) * VIND4 * VIND6 XMAT(I,9) = XMAT(I,9) * VIND5 * VIND6 C 321 CONTINUE C C 3.2.2- CAS des tetraedre (ndiele=3) C ----------------------------------- ELSE C DO 322 I=1,NELEMS C VIND1 = DIRIND(NODES(I,1)) VIND2 = DIRIND(NODES(I,2)) VIND3 = DIRIND(NODES(I,3)) VIND4 = DIRIND(NODES(I,4)) VIND5 = DIRIND(NODES(I,5)) VIND6 = DIRIND(NODES(I,6)) VIND7 = DIRIND(NODES(I,7)) VIND8 = DIRIND(NODES(I,8)) VIND9 = DIRIND(NODES(I,9)) VIND10 = DIRIND(NODES(I,10)) C XMAT(I,1) = XMAT(I,1) * VIND1 * VIND5 XMAT(I,2) = XMAT(I,2) * VIND1 * VIND7 XMAT(I,3) = XMAT(I,3) * VIND1 * VIND8 XMAT(I,4) = XMAT(I,4) * VIND2 * VIND5 XMAT(I,5) = XMAT(I,5) * VIND2 * VIND6 XMAT(I,6) = XMAT(I,6) * VIND2 * VIND9 XMAT(I,7) = XMAT(I,7) * VIND3 * VIND6 XMAT(I,8) = XMAT(I,8) * VIND3 * VIND7 XMAT(I,9) = XMAT(I,9) * VIND3 * VIND10 XMAT(I,10) = XMAT(I,10) * VIND4 * VIND8 XMAT(I,11) = XMAT(I,11) * VIND4 * VIND9 XMAT(I,12) = XMAT(I,12) * VIND4 * VIND10 XMAT(I,13) = XMAT(I,13) * VIND5 * VIND6 XMAT(I,14) = XMAT(I,14) * VIND5 * VIND7 XMAT(I,15) = XMAT(I,15) * VIND5 * VIND8 XMAT(I,16) = XMAT(I,16) * VIND5 * VIND9 XMAT(I,17) = XMAT(I,17) * VIND6 * VIND7 XMAT(I,18) = XMAT(I,18) * VIND6 * VIND8 XMAT(I,19) = XMAT(I,19) * VIND6 * VIND9 XMAT(I,20) = XMAT(I,20) * VIND6 * VIND10 XMAT(I,21) = XMAT(I,21) * VIND7 * VIND8 XMAT(I,22) = XMAT(I,22) * VIND7 * VIND10 XMAT(I,23) = XMAT(I,23) * VIND8 * VIND9 XMAT(I,24) = XMAT(I,24) * VIND8 * VIND10 XMAT(I,25) = XMAT(I,25) * VIND9 * VIND10 C 322 CONTINUE C C Fin du cas 3D ENDIF C RETURN END syrthes-3.4.3-dfsg1/src/s/lecmcr.F0000666000175000017500000003321611524070643015324 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE LECMCR C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER syrthes.ray * C Lecture des mots-cles pour les options du calcul * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! R ! ! C !/NLOFCT/! ! D ! ! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "divct.h" #include "nlofes.h" #include "nlofct.h" #include "syrth.h" C C********************************************************************** C C INTEGER I1,I2,II1,II2,LCH LOGICAL LVERIF,ERR C CHARACTER*200 CHAINE,FORMA C C********************************************************************** C C 0- INITIALISATIONS C ================== C LVERIF = .TRUE. ERR = .FALSE. C C Valeurs par defaut des parametres C --------------------------------- C LSTOKF = .FALSE. LECFDF = .FALSE. LSTORA = .FALSE. LLCORA = .FALSE. LPERAY = .FALSE. LHISOR = .FALSE. NPLASY = 0 NBANDE = 1 NCHROR = -1 NDECMX = 0 NBLBLR = 2 LROUVR=.FALSE. C C C 1- LECTURE DE LA CHAINE C ======================= C REWIND(NFCLRA) C 10 CONTINUE C CHAINE = ' ' READ(NFCLRA,1000,END=999) CHAINE C IF (CHAINE(1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) GOTO 10 C C C ======================= C 0- VARIABLES CARACTERES C ======================= C C C ===================== C 1- VARIABLES LOGIQUES C ===================== C C C C 1.1- STOCKAGE DES FACTEURS DE FORME SUR FICHIER (LSTOKF) C ------------------------------------------------------- IF ( CHAINE(I1:I2).EQ. * 'STOCKAGE DES FACTEURS DE FORME SUR FICHIER=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LSTOKF = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LSTOKF = .FALSE. ELSE GOTO 9999 ENDIF C C 1.2- LECTURE DES FACTEURS DE FORME SUR FICHIER (LECFDF) C ------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'LECTURE DES FACTEURS DE FORME SUR FICHIER=') THEN C C Position de la reponse CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LECFDF = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LECFDF = .FALSE. ELSE GOTO 9999 ENDIF C C C 1.6- STOCKAGE DES CORRESPONDANTS DE RAYONNEMENT (LSTORA) C ----------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'STOCKAGE DES CORRESPONDANTS POUR RAYONNEMENT=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LSTORA = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LSTORA = .FALSE. ENDIF C C C 1.8- LECTURE DES CORRESPONDANTS DE RAYONNEMENT (LLCORA) C ----------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'LECTURE DES CORRESPONDANTS POUR RAYONNEMENT=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LLCORA = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LLCORA = .FALSE. ENDIF C C 1.9- PERIODICITE DE ROTATION POUR LE RAYONNEMENT C ------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'PERIODICITE DE ROTATION POUR LE RAYONNEMENT=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LPERAY = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LPERAY = .FALSE. ENDIF C C 1.10- DOMAINE DE RAYONNEMENT CONFINE OUVERT SUR L EXTERIEUR C ----------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'DOMAINE DE RAYONNEMENT CONFINE OUVERT SUR L EXTERIEUR=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LROUVR = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LROUVR = .FALSE. ENDIF C C C 1.11- HISTORIQUES C ----------------- ELSEIF ( CHAINE(I1:I2).EQ. 'HISTORIQUES RAYONNEMENT=') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 IF (CHAINE(I1:I2) .EQ. 'OUI') THEN LHISOR = .TRUE. ELSEIF (CHAINE(I1:I2) .EQ. 'NON') THEN LHISOR = .FALSE. ENDIF C C ===================== C 2- VARIABLES ENTIERES C ===================== C C C C 2.1- NOMBRE DE PLANS DE SYMETRIE POUR LE RAYONNEMENT (NPLASY) C ------------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE DE PLANS DE SYMETRIE POUR LE RAYONNEMENT=') THEN C CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NPLASY IF (NPLASY.LT.0 .OR. NPLASY.GT.3) THEN WRITE(NFECRA,2910) ERR = .TRUE. ENDIF C C C 2.2- NOMBRE DE BANDES SPECTRALES POUR LE RAYONNEMENT (NBANDE) C ------------------------------------------------------------ ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE DE BANDES SPECTRALES POUR LE RAYONNEMENT=') THEN C CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NBANDE IF (NBANDE.LT.0) THEN WRITE(NFECRA,2920) ERR = .TRUE. ENDIF C C C 2.3- PAS DES SORTIES CHRONO RAYONNEMENT (NCHROR) C ----------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'PAS DES SORTIES CHRONO RAYONNEMENT=') THEN C CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NCHROR C C 2.4- NOMBRE DE REDECOUPAGES POUR CALCUL DES FACTEURS DE FORME C (NDECMX) C ------------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'NOMBRE DE REDECOUPAGES POUR CALCUL DES FACTEURS DE FORME=') * THEN C CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NDECMX C C 2.5- NIVEAU DES IMPRESSIONS POUR LE RAYONNEMENT (NBLBLR) C -------------------------------------------------------- ELSEIF ( CHAINE(I1:I2).EQ. * 'NIVEAU DES IMPRESSIONS POUR LE RAYONNEMENT=') * THEN C CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NBLBLR IF(NBLBLR .GT. 3) NBLBLR=NBLBLR-1000 IF (NBLBLR.LT.0) THEN WRITE(NFECRA,2500) ERR = .TRUE. ENDIF C C C ==================== C 3- VARIABLES REELLES C ==================== C C ENDIF GOTO 10 C 999 CONTINUE C C C =================================================== C 4- GESTION DES OPTIONS PRIORITAIRES ET OBLIGATOIRES C =================================================== C IF (LSTOKF .AND. LECFDF) THEN WRITE(NFECRA,4500) LSTOKF = .FALSE. LECFDF = .FALSE. ENDIF C C IF (LPERAY .AND. NPLASY .GT. 1) THEN WRITE(NFECRA,4600) ERR = .TRUE. ENDIF C C STOP EN CAS D'ERREUR DE DONNEES C ------------------------------- C IF (ERR) STOP C GOTO 500 C C ================================= C 5. GESTION DES ERREURS DE LECTURE C ================================= C 9999 WRITE(NFECRA,5000) CHAINE STOP C 500 CONTINUE C C-------- C FORMATS C-------- 1000 FORMAT(A200) 2500 FORMAT(/,' %% ERREUR LECMCR : MOT-CLE "NIVEAU DES IMPRESSIONS ', & 'POUR LE RAYONNEMENT"',/, & ' Les valeurs possibles sont 0,1,2 ou 3') 2910 FORMAT(/,' %% ERREUR LECMCR : MOT-CLE "NOMBRE DE PLANS DE ', & 'SYMETRIE POUR LE RAYONNEMENT"',/, & ' Les valeurs possibles sont 0,1,2 ou 3') 2920 FORMAT(/,' %% ERREUR LECMCR : MOT-CLE "NOMBRE DE BANDES ', & 'SPECTRALES POUR LE RAYONNEMENT"',/, & ' Il faut un entier superieur ou egal a 1') C 4500 FORMAT(/,' $$ ATTENTION LECMCR : MOTS-CLES "STOCKAGE DES ', & 'FACTEURS DE FORME SUR FICHIER"',/, & ' et "LECTURE DES ', & 'FACTEURS DE FORME SUR FICHIER"',/, & ' Ces 2 options ne peuvent etre activees ', & 'simultanement ',/, & ' --> On recalcule les facteurs de forme et ', & 'le calcul se poursuit de facon normale...') 4600 FORMAT(/,' %% ERREUR LECMCR : MOTS-CLES " NOMBRE DE ', & 'PLANS DE SYMETRIE POUR LE RAYONNEMENT="',/, & ' et " PERIODICITE', & 'DE ROTATION POUR LE RAYONNEMENT="',/, & ' Ces 2 options ne peuvent etre activees ', & 'simultanement qu''avec 1 seul plan de symetrie',/) 5000 FORMAT(/,' %% ERREUR LECMCR : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des mots-cles ',/, * 20X,'Ligne concernee : ',A) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/recusy.F0000666000175000017500000001214411524070643015366 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE RECUSY C ***************** C * (LSYR_,LCFAC_,LRAY_,NTSYR_,NCTHF_,LDERN_,LSTOP_,LHISR_, * NCHRO_,LSDEP_,NTSMA_,NTSYD_,LHISO_,NHRMA_,NBAND_,NDPRO_, * RDTTS_,TEMPS_,NFREQ_,LTMAX_) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C SOUS-PROGRAMME PRINCIPAL DE SYRTHES C C----------------------------------------------------------------------- C ARGUMENTS C .________________.____.______________________________________________. C ! NOM !MODE! ROLE ! C !________________!____!______________________________________________! C .________________.____.______________________________________________. C COMMONS C .________________.____.______________________________________________. C ! ! ! TOUS LES COMMONS SONT PRESENTS ICI ! C !________________!____!______________________________________________! C MODE:-->ENTREE,<--RESULTAT,<-->DONNEE MODIFIEE,--TABLEAU DE TRAVAIL C----------------------------------------------------------------------- C - SOUS PROGRAMME(S) APPELANT(S) : C - SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C #include "syrth.h" #include "optct.h" #include "nlofct.h" #include "nlofes.h" #include "iadrct.h" #include "divct.h" #include "syrthu.h" #include "rayonn.h" C C*********************************************************************** C INTEGER LSYR_,LCFAC_,LRAY_,NTSYR_,NCTHF_,LDERN_,LSTOP_,LHISR_ INTEGER NCHRO_,LSDEP_,NTSMA_,NTSYD_,LHISO_,NHRMA_,NBAND_,NDPRO_ INTEGER NFREQ_,LTMAX_ DOUBLE PRECISION RDTTS_,TEMPS_ C C*********************************************************************** C C IF (NTSMAX.GT.0 .AND. NTSYR .GE. NTSMAX-1) THEN LDERN = .TRUE. ELSE LDERN = .FALSE. ENDIF C LCFAC_=0 IF (LCFACE) LCFAC_=1 LRAY_=0 IF (LRAY) LRAY_=1 NTSYR_=NTSYR NCTHF_=NCTHFS LDERN_=0 IF (LDERN) LDERN_=1 LSTOP_=0 IF (LSTOPS) LSTOP_=1 LHISO_=0 IF (LHISOL) LHISO_=1 NCHRO_=NCHROR LSDEP_=0 IF (LSDEPL) LSDEP_=1 NTSMA_=NTSMAX NTSYD_=NTSYRD LHISR_=0 IF (LHISOR) LHISR_=1 NHRMA_=NHRMAX NBAND_=NBANDE TEMPS_=TEMPSS NDPRO_=NDPROP NFREQ_=NFREQS LTMAX_=0 IF (LTMAX) LTMAX_=1 C RDTTS_=RDTTS C END syrthes-3.4.3-dfsg1/src/s/afaire.F0000666000175000017500000001607611524070643015313 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE AFAIRE C ***************** C C --------------------------------------------------- *( NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * NFLUVS,VFLUVS,NBFLVS,NPFEL, * TMPSA,NODEUS,SURFUS,VOLUME, * NPOINS,NDIM,NELEUS,NDMASS,NREFAL,COORDS, * NREFE,NELEMS,NDMATS,NODES,NODESS) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : Sous programme utilisateur * C --------- Acces a toutes les grandeurs pour traitements * C specifiques. * C * C Rq : pour des exemples d'utilisation des divers tableaux, se * C reporter aux sous-programmes utilisateurs traditionnels * C qui proposent des exemples. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NELERA ! E ! D ! Nombre de facette de type rayonnement ! C ! NFRAIS ! TE ! D ! No de facette rayonnt inf --> face glob ! C ! VFRAIS ! TR ! D ! Valeur du rayo inf aux points de la face ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! NODEUS ! TE ! D ! NOEUDS DE BORD( LOCALE 2D --> GLOBALE 3D)! C ! SURFUS ! TR ! D ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! VOLUME ! TR ! D ! EN 3D VOLUME DU TETRAEDRE ! C ! ! ! ! EN 2D SURFACE DU TRIANGLE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE ! C ! TEMPSA ! TR ! D ! CHAMP DE TEMPERATURE (CELSIUS) ! C ! NREFE ! TE ! D ! REFERENCES DES ELEMENTS ! C ! NREFAL ! TE ! D ! REFERENCES DES ELEMENTS DE BORD ! C ! NODESS ! TE ! D ! CONNECTIVITE BORD COUPLE AU FLUIDE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" #include "divct.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NDIM,NELEUS,NDMASS INTEGER NBFFLU,NBFECH,NELERC,NELERA,NBFRAI,NELESS INTEGER NELEMS,NDMATS,NBFLVS,NPFEL INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI),NFCOUS(NELESS) INTEGER NODEUS(NELEUS,NDMASS),NREFAL(NELEUS) INTEGER NREFE(NELEMS),NFLUVS(NBFLVS) INTEGER NODES(NELEMS,NDMATS),NODESS(NELESS,NDMASS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) DOUBLE PRECISION TMPSA(NPOINS) DOUBLE PRECISION SURFUS(NELEUS),COORDS(NPOINS,NDIM) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VOLUME(NELEMS) C C..Variables internes C C C C*********************************************************************** C C-------- C FORMATS C-------- C END syrthes-3.4.3-dfsg1/src/s/prosca.F0000666000175000017500000000753011524070643015346 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PROSCA,SSI=0 C SUBROUTINE PROSCA C ***************** C C ----------------- *( NP,X,Y,AUXR ) C ----------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- PRODUIT SCALAIRE DE DEUX VECTEURS X ET Y * C auxr = SOM ( Xi * Yi ) i = 1....NP * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NP ! E ! D ! DIMENSION DU VECTEUR ! C ! X ! TR ! D ! VECTEUR ! C ! Y ! TR ! D ! VECTEUR ! C ! AUXR ! R ! M ! PRODUIT SCALAIRE DES VECTEURS X ET Y ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : AUCUN C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : GRCONJ C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C C*********************************************************************** C INTEGER NP DOUBLE PRECISION X(NP),Y(NP) DOUBLE PRECISION AUXR C INTEGER I C C************************************************************************ C AUXR = 0.D0 C CCDIR$ IVDEP DO 10 I=1,NP AUXR = AUXR + X(I) * Y(I) 10 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/prrfvn.F0000666000175000017500000001323711524070643015375 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE PRRFVN C ***************** C C --------------------------------------------------------- * (NDIM,NPOINR,NELRAY,NODRAY,SUFRAY, * VFACER,VNODER,TRAV) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C Interpolation des faces de rayonnement aux noeuds de * C rayonnement de type shading de gouraud * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! VFACER ! R ! D ! Valeur stockee sur une face de rayonnement ! C ! VNODER ! R ! M ! Valeur stockee sur les noeuds de rayonnement ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NDIM,NELRAY,NPOINR INTEGER NODRAY(NELRAY,NDIM) DOUBLE PRECISION VFACER(NELRAY),VNODER(NPOINR),TRAV(NPOINR) DOUBLE PRECISION SUFRAY(NELRAY) C C..Variables internes INTEGER I,N,N1,N2,N3 C C*********************************************************************** C C 0- INITIALISATION C ================= DO 10 I=1,NPOINR TRAV(I) = 0. VNODER(I)= 0. 10 CONTINUE C IF (NBLBLR .GT. 3) WRITE(NFECRA,1000) C C 1- DIMENSION 2 C ============== IF (NDIM.EQ.2) THEN DO 100 I=1,NELRAY C N1 = NODRAY(I,1) N2 = NODRAY(I,2) C TRAV(N1) = TRAV(N1) + SUFRAY(I) TRAV(N2) = TRAV(N2) + SUFRAY(I) C VNODER(N1) = VNODER(N1) + VFACER(I)*SUFRAY(I) VNODER(N2) = VNODER(N2) + VFACER(I)*SUFRAY(I) C 100 CONTINUE C DO 110 N=1,NPOINR VNODER(N) = VNODER(N) / TRAV(N) 110 CONTINUE C ENDIF C C 2- DIMENSION 3 C ============== IF (NDIM.EQ.3) THEN DO 200 I=1,NELRAY C N1 = NODRAY(I,1) N2 = NODRAY(I,2) N3 = NODRAY(I,3) C TRAV(N1) = TRAV(N1) + SUFRAY(I) TRAV(N2) = TRAV(N2) + SUFRAY(I) TRAV(N3) = TRAV(N3) + SUFRAY(I) C VNODER(N1) = VNODER(N1) + VFACER(I)*SUFRAY(I) VNODER(N2) = VNODER(N2) + VFACER(I)*SUFRAY(I) VNODER(N3) = VNODER(N3) + VFACER(I)*SUFRAY(I) C 200 CONTINUE C DO 210 N=1,NPOINR VNODER(N) = VNODER(N) / TRAV(N) 210 CONTINUE C ENDIF C C C------- C FORMAT C------- C 1000 FORMAT(/,' *** PRRFVN : PROJECTION SUR LES NOEUDS DU MAILLAGE DE', & ' RAYONNEMENT',/) C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/lecme3.F0000666000175000017500000002563511524070643015235 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 SUBROUTINE LECME3 C ***************** C C ----------------------------------------- * (NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, * NODES,NREFS,NREFE,NREFAC,COORDS) C ------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS * C STRUCTURE DE DONNEE ISSUE DE MED * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NODES ! TE ! R ! TABLE DES ELEMENTS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! R ! REFERENCES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFAC ! TE ! R ! REFERENCES DES FACES ! C ! COORDS ! TR ! R ! COORD DES NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /MOBIL/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "xrefer.h" #ifdef MED #include "med.hf" #endif C C*********************************************************************** C C.. Variables externes INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFS(NPOINS),NREFE(NELEMS) INTEGER NREFAC(NELEMS,NBFACE),ITRMED(NDMATS,NELEMS) DOUBLE PRECISION COORDS(NPOINS,NDIM) C #ifdef MED C.. Variables internes INTEGER I,J,ITYCOO,NBFAM,IDIM,IRET,NBATT,NBIDON INTEGER NB,NGRO,NUMFAM,IFAN(NRFMAX),IFAE(NRFMAX) CHARACTER*8 NOMCO2(2),UNICO2(2),NOMCO3(3),UNICO3(3) CHARACTER*32 NOM,NOMFAM CHARACTER*80 GRO LOGICAL LFAE CHARACTER*200 ATDES0(1),ATDES2(4),ATDES3(5) INTEGER ATIDE0(1),ATIDE2(4),ATIDE3(5) INTEGER ATVAL0(1),ATVAL2(4),ATVAL3(5) C C*********************************************************************** C C 1- INITIALISATIONS C ================== C DO I=1,NPOINS NREFS(I) = 0 ENDDO DO I=1,NELEMS NREFE(I) = 0 ENDDO C C 2- LECTURE C ========== C lecture du nom du maillage CALL EFMAAI(NFSGCT,1,NOM,IDIM,IRET) C C lecture des noeuds IF (NDIM.EQ.2) THEN CALL EFCOOL(NFSGCT,NOM,NDIM,COORDS,MED_NO_INTERLACE,NPOINS, * ITYCOO,NOMCO2,UNICO2,IRET) ELSE CALL EFCOOL(NFSGCT,NOM,NDIM,COORDS,MED_NO_INTERLACE,NPOINS, * ITYCOO,NOMCO3,UNICO3,IRET) ENDIF C C lecture de la connectivite IF (NDMATS.EQ.6) THEN CMED20 CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,NELEMS, CMED20 * MED_MAILLE,MED_TRIA6,MED_NOD,IRET) CALL EFCONL(NFSGCT,NOM,NDIM,NODES,MED_NO_INTERLACE,NBIDON,0, * MED_MAILLE,MED_TRIA6,MED_NOD,IRET) ELSEIF (NDMATS.EQ.10) THEN CMED20 CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,NELEMS, CMED20 * MED_MAILLE,MED_TETRA10,MED_NOD,IRET) CALL EFCONL(NFSGCT,NOM,NDIM,NODES,MED_NO_INTERLACE,NBIDON,0, * MED_MAILLE,MED_TETRA10,MED_NOD,IRET) ENDIF C DO J=1,NDMATS DO I=1,NELEMS NODES(I,J)=ITRMED(J,I) ENDDO ENDDO C C lecture des numeros de famille des noeuds CALL EFFAML(NFSGCT,NOM,NREFS,NPOINS,MED_NOEUD,0,IRET) C C lecture des numeros de famille des elements IF (NDMATS.EQ.6) THEN CALL EFFAML(NFSGCT,NOM,NREFE,NELEMS,MED_MAILLE,MED_TRIA6,IRET) ELSEIF (NDMATS.EQ.10) THEN CALL EFFAML(NFSGCT,NOM,NREFE,NELEMS,MED_MAILLE,MED_TETRA10,IRET) ENDIF C C nombre de familles CALL EFNFAM(NFSGCT,NOM,0,0,NBFAM,IRET) C C lecture des familles LFAE=.FALSE. DO I=1,NBFAM CALL EFNFAM(NFSGCT,NOM,I,MED_ATTR,NBATT,IRET) IF (NBATT.EQ.1) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE0,ATVAL0,ATDES0,NB,GRO,NGRO,IRET) IF (NUMFAM.GT.0) THEN ! famille de noeud IFAN(NUMFAM)=ATVAL0(1) ELSEIF (NUMFAM.LT.0) THEN ! famille d'element LFAE=.TRUE. IFAE(-NUMFAM)=ATVAL0(1) ENDIF ELSEIF (NBATT.EQ.4) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE2,ATVAL2,ATDES2,NB,GRO,NGRO,IRET) NREFE(-NUMFAM)=ATVAL2(1) NREFAC(-NUMFAM,1)=ATVAL2(2) NREFAC(-NUMFAM,2)=ATVAL2(3) NREFAC(-NUMFAM,3)=ATVAL2(4) ELSEIF (NBATT.EQ.5) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE3,ATVAL3,ATDES3,NB,GRO,NGRO,IRET) NREFE(-NUMFAM)=ATVAL3(1) NREFAC(-NUMFAM,1)=ATVAL3(2) NREFAC(-NUMFAM,2)=ATVAL3(3) NREFAC(-NUMFAM,3)=ATVAL3(4) NREFAC(-NUMFAM,4)=ATVAL3(5) ENDIF ENDDO C C On remet d'aplomb les references des noeuds DO I=1,NPOINS NREFS(I)=IFAN(NREFS(I)) ENDDO C C Quand il n'y a pas de references de face on remet d'aplomb C les references des elements IF (LFAE) THEN DO I=1,NELEMS NREFE(I)=IFAE(-NREFE(I)) ENDDO ENDIF C C C 3- IMPRESSION SUR LISTING C ========================= C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,5000) WRITE(NFECRA,5010) NDIM,NPOINS,NELEMS IF (.NOT.LFAE) THEN WRITE(NFECRA,5020) ELSE WRITE(NFECRA,5030) ENDIF ENDIF C C C 6- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLA.GE.2) THEN C WRITE(NFECRA,6000) WRITE(NFECRA,6010) DO I=1,10 WRITE(NFECRA,6011) I,(COORDS(I,J),J=1,NDIM) ENDDO C WRITE(NFECRA,6020) DO I=1,10 WRITE(NFECRA,6012) I,(NODES(I,J),J=1,NDMATS) ENDDO C WRITE(NFECRA,6030) DO I=1,10 WRITE(NFECRA,6013) I,NREFS(I) ENDDO C IF (NDPROP.GT.1) THEN WRITE(NFECRA,6031) DO I=1,10 WRITE(NFECRA,6013) I,NREFE(I) ENDDO ENDIF C IF (.NOT.LFAE) THEN WRITE(NFECRA,6040) DO I=1,10 WRITE(NFECRA,6014) I,(NREFAC(I,J),J=1,NDIELE+1) ENDDO ENDIF C ENDIF C C C-------- C FORMATS C-------- C 2100 FORMAT(//,' *** LECME3 : LE FICHIER SUITE NE CONTIENT PAS LA', & ' TABLE DES NOEUDS') 2200 FORMAT(A7,I3,1X,3E14.7) 3100 FORMAT(//,' *** LECME3 : LE FICHIER SUITE NE CONTIENT PAS LA', & ' TABLE DES ELEMENTS') 3200 FORMAT(I7,I3,6I7) 3201 FORMAT(I7,I3,10I7) 4200 FORMAT(I6,1X,4I5) C 5000 FORMAT(//,' *** LECME3 : MAILLAGE ELEMENTS FINIS DU SOLIDE :') 5010 FORMAT(8X,'- Dimension du maillage : ',I6,/ & 8X,'- Nombre total de noeuds : ',I6,/ & 8X,'- Nombre d''elements : ',I6) 5020 FORMAT(8X,'- Il y a des references sur les faces') 5030 FORMAT(8X,'- Il n''y a pas de references sur les faces') C 6000 FORMAT(/,' *** LECME3 : Verification du maillage solide',/) 6010 FORMAT(/,14X,'Coordonnees des 10 premiers noeuds :',/) 6020 FORMAT(/,14X,'Table des 10 premiers elements :',/) 6030 FORMAT(/,14X,'References des 10 premiers noeuds :',/) 6031 FORMAT(/,14X,'References des 10 premiers elements :',/) 6040 FORMAT(/,14X,'References des faces des 10 premiers elements :',/) 6011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 6012 FORMAT(14X,'N=',I2,' NOEUDS : ',10I6) 6013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) 6014 FORMAT(14X,'N=',I2,' REFERENCE DES FACES : ',4I3) C #endif END syrthes-3.4.3-dfsg1/src/s/mobcor.F0000666000175000017500000002153211524070643015336 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBCOR,SSI=0 SUBROUTINE MOBCOR C ***************** C C -------------------------------------------------------------- * (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NCOUPF,NBICOR) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA TABLE DE CORRESPONDANCE ENTRE LES * C NOEUDS COUPLES DES MAILLAGES FLUIDE ET SOLIDE * C DANS LE CAS DES SOLIDES MOBILES * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS DU MAILLGE SURF SOLIDE ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELT SURF SOLIDE ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NDMASF ! E ! D ! NOMBRE D'ELEMENTS DU MAILLGE SURF FLUIDE ! C ! NCOUPF ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS FLUIDES COUPLES ! C ! NCOUPS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NODESS ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SURF SOLIDE ! C ! COORDF ! TR ! D ! COORDONNEES DES NOEUDS FLUIDES COUPLES ! C ! NODESF ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SURF FLUIDE ! C ! BARYF ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELEMENTS SOLIDES ! C ! NCBORF ! TE ! R ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELEMENTS FLUIDES ! C ! NCBORS ! TE ! R ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C ! NCOUPS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : DPTSEG, CBARY2 C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "mobil.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELESS,NDMASS INTEGER NELESF,NDMASF,NBCOUS,NBCOUF,NBICOR INTEGER NODESS(NELESS,NDMASS),NODESF(NELESF,NDMASS) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) INTEGER NCOUPS(NBCOUS),NCOUPF(NBCOUF,2) DOUBLE PRECISION COORDS(NPOINS,NDIM),COORDF(NBCOUF,NDIM) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) C C.. Variables internes INTEGER N,NGS,M,NONC DOUBLE PRECISION XS,YS,ZS,XF,YF,ZF,D2,DMIN C LOGICAL LVERIF C*********************************************************************** C C 0- INITIALISATIONS C ================== C LVERIF = .FALSE. NONC=0 C DO 1 N=1,NBCOUS*NBICOR NCBORS(N,1) = 0 1 CONTINUE C DO 2 N=1,NBCOUF*NBICOR NCBORF(N,1) = 0 2 CONTINUE C DO 3 N=1,NBCOUF*NDIM BARYF(N,1) = 0.D0 3 CONTINUE C DO 4 N=1,NBCOUS*NDIM BARYS(N,1) = 0.D0 4 CONTINUE C C C 1- REPERAGE DES NOEUDS SOLIDES QUI ONT UN CORRESPONDANT C ======================================================= C C IF (.NOT.LCOIN) THEN C C 1.1- En dimension 2 C ------------------- IF (NDIM.EQ.2) THEN C DO 110 N=1,NBCOUS C DMIN = 1.E6 NGS = NCOUPS(N) XS = COORDS(NGS,1) YS = COORDS(NGS,2) C DO 111 M=1,NBCOUF XF = COORDF(M,1) YF = COORDF(M,2) C D2 = (XS-XF)*(XS-XF) + (YS-YF)*(YS-YF) C IF (D2.LT.DMIN) THEN DMIN = D2 ENDIF C 111 CONTINUE C IF (DMIN.GT.D1MAXF) THEN NONC=NONC+1 NCBORS(N,1) = -1 ENDIF C 110 CONTINUE C C 1.2- En dimension 3 C ------------------- ELSE C DO 120 N=1,NBCOUS C DMIN = 1.E6 NGS = NCOUPS(N) XS = COORDS(NGS,1) YS = COORDS(NGS,2) ZS = COORDS(NGS,3) C DO 121 M=1,NBCOUF XF = COORDF(M,1) YF = COORDF(M,2) ZF = COORDF(M,3) C D2 = (XS-XF)*(XS-XF) + (YS-YF)*(YS-YF) + (ZS-ZF)*(ZS-ZF) C IF (D2.LT.DMIN) THEN DMIN = D2 ENDIF C 121 CONTINUE C IF (DMIN.GT.D1MAXF) THEN NONC=NONC+1 NCBORS(N,1) = -1 ENDIF C 120 CONTINUE C ENDIF C ENDIF C IF (NBLBLA.GE.10) WRITE(NFECRA,1000) NBCOUS,NONC C C 2- RECHERCHE DES CORRESPONDANTS C =============================== C IF (LCOIN) THEN C CALL COCOIN (NDIM,NPOINS,NBCOUS,NBCOUF,NBICOR, * COORDS,COORDF,NCBORF,NCBORS,NCOUPS) C ELSE C IF (NDIM.EQ.2) THEN CALL CORFS2 (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NBICOR) C ELSE CALL COROCT (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NBICOR, * NBLBLA,D2MAXF) ENDIF C ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(/,' *** MOBCOR : ',/, * ' Nombre de noeuds solides candidats au couplage ',I7,/, * ' Nombre de noeuds pre-elimines du couplage ',I7) C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/fdffin.F0000666000175000017500000001131211524070643015304 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE FDFFIN C ***************** C C ------------------------------------------------------------- * (NELRAY,SUFRAY,FDFRAY,FDFNP1) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C Maillage ouvert : completer les facteurs de forme C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! FDFRAY ! TR ! R ! FACTEURS DE FORME RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C ********************************************************************** C C.. Variables externes INTEGER NELRAY DOUBLE PRECISION SUFRAY(NELRAY),FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION FDFNP1(NELRAY) C C.. Variables internes INTEGER I,J DOUBLE PRECISION S,SFDF,UN C C*********************************************************************** C C 1- CALCUL C ========= C UN = 1. C DO 10 I=1,NELRAY C S =0. DO 11 J=1,I-1 S = S + FDFRAY((J-1)*NELRAY-(J-1)*J/2+I) 11 CONTINUE S = S + FDFRAY((I-1)*NELRAY-(I-1)*I/2+I) DO 12 J=I+1,NELRAY S = S + FDFRAY((I-1)*NELRAY-(I-1)*I/2+J) 12 CONTINUE C SFDF=S/SUFRAY(I) IF (SFDF.GE.1.) THEN FDFNP1(I) = 0. ELSE FDFNP1(I) = (1.- SFDF)*SUFRAY(I) ENDIF C 10 CONTINUE C C C 2- IMPRESSIONS C ============== IF (NBLBLR.GE.10) THEN WRITE(NFECRA,1000) DO 200 I=1,NELRAY WRITE(NFECRA,1100) I,SUFRAY(I),FDFNP1(I)/SUFRAY(I) 200 CONTINUE ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(/' *** FDFFIN : Domaines ouverts : completion ', * 'des facteurs de forme') 1100 FORMAT(5X,'Ligne : ',I5,' Surf elt = ',E12.7, * ' FDFi-ouvert = ',E21.15) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/lrame1.F0000666000175000017500000001212611524070643015235 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRAME1 C ***************** C C -------------------- *(NDIM,NPOINR,NELRAY) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE MED * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "optct.h" #ifdef MED #include "med.hf" #endif C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY C #ifdef MED C.. Variables internes C C*********************************************************************** C C lire la dimension le nombre de noeuds et d'elements C lire eventuellement le type d'elements C C 4- VERIFICATIONS DIVERSES C ========================= C C-------- C FORMATS C-------- C 1000 FORMAT(' %% ERREUR LRAME1 : LE FICHIER NE CONTIENT PAS UNE S.D.', & ' DE MAILLAGE ') 1018 FORMAT(' %% ERREUR LRAME1 : DIMENSION DES MAILLAGES ', & 'INCOMPATIBLES') 1021 FORMAT(' %% ERREUR LRAME1 : La dimension du maillage rayonnement' & ' n''est pas coherente',/, & 21X,'avec celle du solide') 1022 FORMAT(' %% ERREUR LRAME1 : LE MAILLAGE POSSEDE DES' & ,' NOEUDS MILIEUX') 1023 FORMAT(' %% ERREUR LRAME1 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES',/, & 20X,'Seuls sont autorises :',/, & 20X,' - les triangles (en dimension 3)',/, & 20X,' - les segments (en dimension 2)') C 9999 FORMAT(' %% ERREUR LRAME1 : erreur de lecture du maillage ', * ' rayonnement') C #endif END syrthes-3.4.3-dfsg1/src/s/matcli.F0000666000175000017500000003571311524070643015334 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MATCLI,SSI=0 C SUBROUTINE MATCLI C ****************** C C ------------------------------------------------------ * (NCOUPS,VCOUPS,NECHS,VECHS, * NRESCS,VRESCS, * NRAYTS,VRAYTS,NBRAYS, * NRAYIS,VRAYIS,NBRAIS, * TMPSA,NODEUS,COORDS,SURFUS, * NPOINS,NELEMS,NDIM,NELEUS,NDMASS, * NBCOUS,NBECHS,NBRESS, * TRAV1,TRAV4,DIAG,WCT) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DE LA CONTRIBUTION DES TERMES ECHANGE * C DU A L'IMPLICITATION DES TERMES D'ECHANGE * C * C On calcule les termes suivants * C Termes de couplage avec le fluide * C Termes de coefficient d'echange avec l'exterieure * C Terme de resistance de contact * C Terme de rayonnement * C * C Ces termes seront mass-lumpe pour etre coherent * C La diagonale correspondante (non nul sur les termes de bord) * C sera stokee dans le vecteur TRAV4 * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEUS,OV C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : DIFSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIM,NELEUS,NDMASS INTEGER NBCOUS,NBECHS,NBRESS,NBRAYS,NBRAIS INTEGER NCOUPS(NBCOUS),NECHS(NBECHS) INTEGER NODEUS(NELEUS,NDMASS) INTEGER NRESCS(NBRESS,2),NRAYTS(NBRAYS),NRAYIS(NBRAIS) C DOUBLE PRECISION VCOUPS(NBCOUS,2),VECHS(NBECHS,2) DOUBLE PRECISION VRESCS(NBRESS,2) DOUBLE PRECISION VRAYTS(NBRAYS,2),VRAYIS(NBRAIS,2) DOUBLE PRECISION TRAV1(NPOINS),TRAV4(NPOINS),DIAG(NPOINS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMASS) DOUBLE PRECISION SURFUS(NELEUS) C C..Variables internes DOUBLE PRECISION ZERO LOGICAL LVERIF DOUBLE PRECISION R1,R2 DOUBLE PRECISION CL1,CL2,CL3,CL4,CL5,CL6 INTEGER I,INODE,NCA INTEGER N1,N2,N3,N4,N5,N6 DOUBLE PRECISION S48,SV48,S12,SV12 DOUBLE PRECISION HRAYI,HRAYT C C*********************************************************************** C C 1- INITIALISATION C ================= C LVERIF = .FALSE. ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C S48 = 1.D0 / 48.D0 S12 = 1.D0 / 12.D0 C C CALL OV ('X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) CALL OV ('X=C ',TRAV4,TRAV4,TRAV4,ZERO,NPOINS ) CALL OV ('X=C ',DIAG,DIAG,DIAG,ZERO,NPOINS ) C C C 2- PRISE EN COMPTE DES "COEFFICIENTS D'ECHANGE" C ============================================== C DO 210 I=1,NBCOUS INODE = NCOUPS(I) TRAV1(INODE) = TRAV1(INODE) + VCOUPS(I,2) 210 CONTINUE C DO 220 I=1,NBECHS INODE = NECHS(I) TRAV1(INODE) = TRAV1(INODE) + VECHS(I,2) 220 CONTINUE C DO 230 I=1,NBRESS INODE = NRESCS(I,1) TRAV1(INODE) = TRAV1(INODE) + VRESCS(I,2) 230 CONTINUE C C C 3- CALCUL DE LA MATRICE ELEMENTAIRE (echange) C =========================================== C C 3.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 3.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 311 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV12 = S12 * SURFUS(I) C CL1 = TRAV1(N1) * SV12 CL2 = TRAV1(N2) * SV12 CL3 = TRAV1(N3) * SV12 C C ! Expression du vecteur C ATTENTION Le point 3 est au milieu du segment WCT(I,1) = 2*CL1 + CL3 WCT(I,2) = 2*CL2 + CL3 WCT(I,3) = CL1 + CL2 + 4*CL3 311 CONTINUE C C 3.1.2- Cas axisymetrique C ------------------------ ELSE DO 312 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV48 = S48 * SURFUS(I) C R1 = ABS (COORDS(N1,NCA)) R2 = ABS (COORDS(N2,NCA)) C CL1 = TRAV1(N1) * SV48 CL2 = TRAV1(N2) * SV48 CL3 = TRAV1(N3) * SV48 C WCT(I,1) = R2*CL3+R2*CL1+3*R1*CL3+7*R1*CL1 WCT(I,2) = 3*R2*CL3+7*R2*CL2+R1*CL3+R1*CL2 WCT(I,3) = 8*R2*CL3+R2*CL1+8*R1*CL3+3*R1*CL1 & +3*R2*CL2+R1*CL2 C 312 CONTINUE C ENDIF C C 3.2- Cas 3D C ----------- ELSE DO 320 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) N4 = NODEUS(I,4) N5 = NODEUS(I,5) N6 = NODEUS(I,6) C SV48 = S48 * SURFUS(I) C CL1 = TRAV1(N1) * SV48 CL2 = TRAV1(N2) * SV48 CL3 = TRAV1(N3) * SV48 CL4 = TRAV1(N4) * SV48 CL5 = TRAV1(N5) * SV48 CL6 = TRAV1(N6) * SV48 C C WCT(I,1) = 2*CL1 + CL4 + CL6 WCT(I,2) = 2*CL2 + CL4 + CL5 WCT(I,3) = 2*CL3 + CL5 + CL6 WCT(I,4) = CL1 + CL2 + 6*CL4 + 2*(CL5+CL6) WCT(I,5) = CL2 + CL3 + 6*CL5 + 2*(CL4+CL6) WCT(I,6) = CL1 + CL3 + 6*CL6 + 2*(CL4+CL5) C 320 CONTINUE C ENDIF C CALL OV ('X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) CALL ASSEUS ( TRAV1,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS, & NDIM,WCT) C C 3.3 Elimination des contributions parasites sur le bord C -------------------------------------------------------- C DO 331 I=1,NBCOUS INODE = NCOUPS(I) TRAV4(INODE) = TRAV1(INODE) 331 CONTINUE C DO 332 I=1,NBECHS INODE = NECHS(I) TRAV4(INODE) = TRAV1(INODE) 332 CONTINUE C DO 333 I=1,NBRESS INODE = NRESCS(I,1) TRAV4(INODE) = TRAV1(INODE) 333 CONTINUE C C C 4-TRAITEMENT DU RAYONNEMENT C =========================================== CALL OV ('X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) C DO 410 I=1,NBRAIS INODE = NRAYIS(I) HRAYI = VRAYIS(I,2)*SIGMA* & (TMPSA(INODE)+VRAYIS(I,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VRAYIS(I,1)+TKEL) * (VRAYIS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + HRAYI 410 CONTINUE C DO 420 I=1,NBRAYS INODE = NRAYTS(I) HRAYT = VRAYTS(I,2)*SIGMA* & (TMPSA(INODE)+VRAYTS(I,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VRAYTS(I,1) +TKEL) * (VRAYTS(I,1)+TKEL) ) TRAV1(INODE) = TRAV1(INODE) + HRAYT 420 CONTINUE C C 5- CALCUL DE LA MATRICE ELEMENTAIRE pour le rayonnemnt C ===================================================== IF ( NBRAYS .GT. 0 .OR. NBRAIS.GT.0 ) THEN C C 5.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 5.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 511 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV12 = S12 * SURFUS(I) C CL1 = TRAV1(N1) * SV12 CL2 = TRAV1(N2) * SV12 CL3 = TRAV1(N3) * SV12 C C ATTENTION Le point 3 est au milieu du segment WCT(I,1) = 2*CL1 + CL3 WCT(I,2) = 2*CL2 + CL3 WCT(I,3) = CL1 + CL2 + 4*CL3 511 CONTINUE C C 5.1.2- Cas axisymetrique C ------------------------ ELSE DO 512 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C SV48 = S48 * SURFUS(I) C R1 = ABS (COORDS(N1,NCA)) R2 = ABS (COORDS(N2,NCA)) C CL1 = TRAV1(N1) * SV48 CL2 = TRAV1(N2) * SV48 CL3 = TRAV1(N3) * SV48 C WCT(I,1) = R2*CL3+R2*CL1+3*R1*CL3+7*R1*CL1 WCT(I,2) = 3*R2*CL3+7*R2*CL2+R1*CL3+R1*CL2 WCT(I,3) = 8*R2*CL3+R2*CL1+8*R1*CL3+3*R1*CL1 & +3*R2*CL2+R1*CL2 C 512 CONTINUE C C Fin du cas axisymetrique ENDIF C C 5.2- Cas 3D C ----------- ELSE DO 520 I=1,NELEUS C N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) N4 = NODEUS(I,4) N5 = NODEUS(I,5) N6 = NODEUS(I,6) C SV48 = S48 * SURFUS(I) C CL1 = TRAV1(N1) * SV48 CL2 = TRAV1(N2) * SV48 CL3 = TRAV1(N3) * SV48 CL4 = TRAV1(N4) * SV48 CL5 = TRAV1(N5) * SV48 CL6 = TRAV1(N6) * SV48 C C WCT(I,1) = 2*CL1 + CL4 + CL6 WCT(I,2) = 2*CL2 + CL4 + CL5 WCT(I,3) = 2*CL3 + CL5 + CL6 WCT(I,4) = CL1 + CL2 + 6*CL4 + 2*(CL5+CL6) WCT(I,5) = CL2 + CL3 + 6*CL5 + 2*(CL4+CL6) WCT(I,6) = CL1 + CL3 + 6*CL6 + 2*(CL4+CL5) C 520 CONTINUE C ENDIF C CALL OV ('X=C ',TRAV1,TRAV1,TRAV1,ZERO,NPOINS ) CALL ASSEUS ( TRAV1,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS, & NDIM,WCT) C C 5.3 Elimination des contributions parasites sur le bord C -------------------------------------------------------- C DO 534 I=1,NBRAIS INODE = NRAYIS(I) DIAG(INODE) = TRAV1(INODE) 534 CONTINUE C DO 535 I=1,NBRAYS INODE = NRAYTS(I) DIAG(INODE) = TRAV1(INODE) 535 CONTINUE C ENDIF C C 6- IMPRESSIONS POUR CONTROLE C ============================ C IF ( LVERIF ) THEN WRITE(NFECRA,6000) DO 600 I=1,NPOINS WRITE(NFECRA,6010) I,TRAV4(I),DIAG(I) 600 CONTINUE ENDIF C C-------- C FORMATS C-------- 6000 FORMAT(/,' *** MATCLI : 1ER MEMBRE (PARTIE ECHANGE IMPLICITE)',/, & ' NOEUD MAT ML ECH MAT ML RAYONNEMENT') 6010 FORMAT(7X,I6,5X,G10.4,5X,G10.4) C END syrthes-3.4.3-dfsg1/src/s/ccoeqi.F0000666000175000017500000001374411524070643015326 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CCOEQI,SSI=0 C SUBROUTINE CCOEQI C ***************** C * ( VALEQ,NELRAY,NRFRAY,NFPERA,PHFRAE,NGFPER,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C Programme valable pour le conditions physiques * C equivalente couple au fluide * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNE ! C ! NFPERA ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! PHFRAE ! TR ! R ! PROPRIETES PHYSIQUES EQUIVQLENTE K,E,T,H ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIR C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" #include "rayonn.h" C C********************************************************************** C C..Variables externes INTEGER NELRAY,NB,NFPERA INTEGER NRFRAY(NELRAY),IREF(NRFMAX),NGFPER(NFPERA) DOUBLE PRECISION VALEQ(4),PHFRAE(NFPERA,4) C C..Variables internes INTEGER N,N1,NR,NBRE,NUMREF C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NFPERA PHFRAE(N,1) = VALEQ(1) PHFRAE(N,2) = VALEQ(2) PHFRAE(N,3) = VALEQ(3) PHFRAE(N,4) = VALEQ(4) NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NFPERA C NUMREF = NRFRAY(NGFPER(N)) C C Si le noeud porte la ref citee, on lui applique la cond IF (NUMREF .EQ. NR) THEN PHFRAE(N,1) = VALEQ(1) PHFRAE(N,2) = VALEQ(2) PHFRAE(N,3) = VALEQ(3) PHFRAE(N,4) = VALEQ(4) NBRE = NBRE + 1 ENDIF C 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLR.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCOEQI : Rayonnement - Nombre de faces traitees', * ' de type paroi equivalente isolee:',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/coorfl.F0000666000175000017500000001371211524070643015342 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE COORFL C ***************** C C --------------------------------------------------------- *(NDIM,NBCOUF,NBRAF,NPOINF,NREFF,XYZF,COORDF,COORAF, * NBFILS,NWMAIL,NWDN,NWDRN) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C LECTURE DES COORDONNEES DU MAILLAGE SURFACIQUE COUPLE * C CES DONNEEES SONT LUES DANS LE FICHIER DATA1 DE N3S * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NDIM ! TE ! E ! Dimension du probleme (2 pour 2D, 3 pour 3D)! C ! NBCOUF ! E ! D ! Nombre de points fluides couples ! C ! NBRAF ! E ! D ! Nombre de points fluides non couples + rayt ! C ! NPOINF ! E ! D ! Nombre de points fluide total ! C ! NREFF ! TE ! D ! Tableau des references fluides ! C ! COORDF ! TR ! M ! Coordonnes des points fluides couples ! C ! COORAF ! TR ! M ! Coordonnes des pts fluides non couples+rayt ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! D ! ! C !/FICHCT/! ! D ! ! C !/XREFER/! ! D ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "optct.h" #include "nlofes.h" C C********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINF,NBCOUF,NBRAF INTEGER NREFF(NPOINF),NBFILS,NWMAIL,NWDN,NWDRN DOUBLE PRECISION XYZF(NPOINF,NDIM) DOUBLE PRECISION COORDF(NBCOUF,NDIM),COORAF(NBRAF,NDIM) C C.. Variables internes INTEGER N,M,NC,NR LOGICAL LCOUPL,LRAYT C C********************************************************************** C C 1- INITIALISATION C ================= C NC = NWDN-1 NR = NWDRN-1 C DO 100 N=1,NPOINF C LCOUPL = .FALSE. LRAYT = .FALSE. DO 110 M=1,NRFMAX IF (IREFFC(M).NE.0 .AND. NREFF(N).EQ.M) LCOUPL = .TRUE. IF (IREFRF(M).NE.0 .AND. NREFF(N).EQ.M) LRAYT = .TRUE. 110 CONTINUE C IF (LCOUPL) THEN NC = NC + 1 COORDF(NC,1)=XYZF(N,1) COORDF(NC,2)=XYZF(N,2) IF (NDIM.EQ.3) COORDF(NC,3)=XYZF(N,3) ENDIF IF (LRAYT) THEN NR = NR + 1 COORAF(NR,1)=XYZF(N,1) COORAF(NR,2)=XYZF(N,2) IF (NDIM.EQ.3) COORAF(NR,3)=XYZF(N,3) ENDIF C 100 CONTINUE C IF (NWMAIL.EQ.NBFILS .AND. & (NC.NE.NBCOUF .OR. NR.NE.NBRAF)) THEN WRITE(NFECRA,4000) NC,NBCOUF,NR,NBRAF STOP ENDIF C C-------- C FORMATS C-------- 4000 FORMAT(/,' %% ERREUR COORFL : lors de la lecture des coordonnees' & ,' pour le(s) fluide(s). On trouve :',/, & 20X,I6,' noeuds couples au lieu de ',I6,/, & 20X,I6,' noeuds avec rayonnement au lieu de ',I6 ) C C END syrthes-3.4.3-dfsg1/src/s/psfcoi.F0000666000175000017500000001602311524070643015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PSFCOI,SSI=0 SUBROUTINE PSFCOI C ***************** C C ------------------------------------------------------- * (MODE, * NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, * NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, * NBICOR,NCBORF,NCBORS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES DU FLUIDE VERS LE SOLIDE ET INVERSE * C en 2D ==> maillage surfacique de dimension 1 * C Les maillages sont oincidents * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! VCOUPS ! TR !D M ! VALEUR AUX NOEUDS SOLIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELEMENTS FLUIDES COUPLES ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS FLUIDES COUPLES! C ! NODESF ! TE ! D ! TABLE DES ELEMENTS FLUIDES COUPLES (NUM LOC) ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SOLIDES COUPLES ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS SOLIDES COUPLES! C ! NODESS ! TE ! D ! TABLE DES ELEMENTS SOLIDES COUPLES (NUM LOC) ! C ! NCBORF ! TE ! D ! NUMERO DU NOEUD SOLIDE CORRESPONDANT ! C ! NCBORS ! TE ! D ! NUMERO DU NOEUD FLUIDE CORRESPONDANT ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER MODE,NDIM,NBCOUF,NBCOUS,NELESF,NDMASF,NELESS,NDMASS INTEGER NBICOR DOUBLE PRECISION VCOUPF(NBCOUF,2),VCOUPS(NBCOUS,2) INTEGER NODESF(NELESF,NDMASF),NODESS(NELESS,NDMASS) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) C C..Variables internes INTEGER NF,NS,NC,N C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE FLUIDE C =================================== C DO 100 NF=1,NBCOUF C NC = NCBORF(NF,1) C VCOUPF(NF,1) = VCOUPS(NC,1) C 100 CONTINUE C C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14) THEN WRITE(NFECRA,1010) DO 110 N=1,NBCOUF WRITE(NFECRA,1020) N,VCOUPF(N,1) 110 CONTINUE ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU FLUIDE VERS LE SOLIDE C =================================== C DO 200 NS=1,NBCOUS C NC = NCBORS(NS,1) C IF (NC.NE.-1) THEN VCOUPS(NS,1) = VCOUPF(NC,1) VCOUPS(NS,2) = VCOUPF(NC,2) ENDIF C 200 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14) THEN WRITE(NFECRA,2010) DO 210 N=1,NBCOUS WRITE(NFECRA,2020) N,VCOUPS(N,1),VCOUPS(N,2) 210 CONTINUE ENDIF C C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** PSFCOI : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE',/, & 5X,' N fluide T ') 1020 FORMAT(5X,3X,I4,6X,G13.7) 2010 FORMAT(/,' *** PSFCOI : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE',/, & 5X,' N solide T h') 2020 FORMAT(5X,3X,I4,6X,G13.7,3X,G13.7) 3000 FORMAT(/,' %% ERREUR PSFCOI : OPTION DE PASSAGE INCORRECTE ') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/poscot.F0000666000175000017500000001211111524070643015355 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=POSCOT,SSI=0 C SUBROUTINE POSCOT C ***************** C * ( CHAINE, IDEB,IFIN,LCH ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- DETERMINER LA POSITION (debut,fin et longeur) D'UNE * C CHAINE DANS UNE CHAINE * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! CHAINE ! A ! D ! CHAINE DS LAQUELLE ON EFFECTUE LA RECHERCHE ! C ! IDEB ! E ! R ! POSITION+1 DE LA PREMIERE COTE ! C ! IFIN ! E ! R ! POSITION-1 DE LA DERNIERE COTE ! C ! LCH ! E ! R ! LONGUEUR DE LA CHAINE CONTENANT ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" C C********************************************************************** C C CHARACTER CHAINE*(*) INTEGER IDEB,IFIN,LCH C CHARACTER CC INTEGER I C C C********************************************************************** C FONCTIONS IMPLICITES C********************************************************************** C C********************************************************************** C I = 1 IDEB = 0 IFIN = 0 LCH = 0 C 10 CONTINUE C READ(CHAINE(I:I),1000,ERR=99,END=99) CC IF ( CHAINE (I:I) .EQ. '''' ) THEN IF (IDEB.EQ.0) THEN IDEB = I+1 ELSE IFIN = I-1 ENDIF ENDIF C I = I+1 IF (IFIN.EQ.0 .AND. I.LE.200) GOTO 10 C C LCH = IFIN - IDEB + 1 C RETURN C 99 WRITE (NFECRA,9000) CHAINE C C-------- C FORMATS C-------- 1000 FORMAT(A1) 9000 FORMAT(' %% ERREUR POSCOT : CHAINE INCORRECTE',/, & ' CH = ',A80) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/noerot.F0000666000175000017500000001147111524070643015364 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=NOEROT,SSI=0 SUBROUTINE NOEROT C ***************** C C --------------------------- * (N1,NDMATS,NELEMS,NODES) C --------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PERMUTATION CIRCULAIRE DES NOEUDS D'UN ELEMENT * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! N1 ! E ! D ! NUMERO DE ELEMENT A MODIFIER ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NODES ! TE ! M ! CONNECTIVITE DU MAILLAGE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C C*********************************************************************** C INTEGER IT PARAMETER (IT=10) C C.. Variables externes INTEGER N1,NELEMS,NDMATS,NODES(NELEMS,NDMATS) C C.. Variables internes INTEGER ITAB(IT),I C C*********************************************************************** C C C C 1- CONSERVATION DES NOEUDS DE L'ELEMENT N1 C ------------------------------------------ C DO 100 I=1,NDMATS ITAB(I) = NODES(N1,I) 100 CONTINUE C C C 2- PERMUTATION CIRCULAIRE POUR LES TRIANGLES C -------------------------------------------- C IF (NDMATS.EQ.6) THEN C DO 200 I=1,3 NODES(N1,I) = ITAB(1+ MOD(I,3)) 200 CONTINUE C DO 210 I=4,6 NODES(N1,I) = ITAB(4+ MOD(I-3,3)) 210 CONTINUE C C 3- PERMUTATION CIRCULAIRE POUR LES TETRAEDRES C --------------------------------------------- C ELSE C DO 300 I=1,4 NODES(N1,I) = ITAB(1+ MOD(I,4)) 300 CONTINUE C NODES(N1,5) = ITAB(6) NODES(N1,6) = ITAB(10) NODES(N1,7) = ITAB(9) NODES(N1,8) = ITAB(5) NODES(N1,9) = ITAB(7) NODES(N1,10) = ITAB(8) C ENDIF C END syrthes-3.4.3-dfsg1/src/s/smfcoq.F0000666000175000017500000001562611524070643015354 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMFCOQ,SSI=0 C SUBROUTINE SMFCOQ C ***************** C C --------------------------------------------------- * (FLUX,B,NODES,VOLUME, * NPOINS,NELEMS,NDMATS,NDIELE, * WCT) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C POUR LE MODEL COQUE * C * C Le flux volumique (constant dans l'epaisseur!) * C * C Les flux sur les surfaces exterieurs et interieures sont du type* C Flux dus au couplage thermique fluide -solide * C Flux exterieurs imposes par l'utilisateur * C Flux ayant pour origine un coefficient d'echange * C * C Le flux est impose sur les noeuds definis par l'utilisateur * C * C En surfacique: * C ------------- * C / + - * C B = / ( PHI (+ ou -) PHI ) Phj dx dy * C / * C k et q sont discretises en iso-P2 * C dS element de surface de la coque * C Phj fonction de base iso-P2 * C * C Rq : Lorsque le flux n'est pas defini, cela revient a dire * C implicitement que ce flux est nul. * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! B ! TR ! R ! SECOND MEMBRE ! C ! NODES ! TE ! D ! NOEUDS DE BORD( LOCALE 2D --> GLOBALE 3D)! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE ! C ! FLUX ! TR ! R ! FLUX au second membre ! C ! W1...W6 ! TR ! M ! TABLEAUX DE TRAVAIL. ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NDIELE INTEGER NODES(NELEMS,NDMATS) C DOUBLE PRECISION FLUX(NPOINS) DOUBLE PRECISION B(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) DOUBLE PRECISION VOLUME(NELEMS) C C..Variables locales DOUBLE PRECISION ZERO DOUBLE PRECISION S48,SV48 DOUBLE PRECISION F1,F2,F3,F4,F5,F6 INTEGER I INTEGER N1,N2,N3,N4,N5,N6 C C*********************************************************************** C C 1- INITIALISATIONS C ================== C ZERO = 0.D0 S48 = 1.D0 / 48.D0 C C 3- CALCUL DU VECTEUR ELEMENTAIRE C ================================ C DO 311 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C SV48 = S48 * VOLUME(I) C F1 = FLUX(N1) * SV48 F2 = FLUX(N2) * SV48 F3 = FLUX(N3) * SV48 F4 = FLUX(N4) * SV48 F5 = FLUX(N5) * SV48 F6 = FLUX(N6) * SV48 C C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 311 CONTINUE C C Assemblage du vecteur au second membre CALL OV ( 'X=C ',B,B,B,ZERO,NPOINS ) CALL ASSEMB ( B,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C END syrthes-3.4.3-dfsg1/src/s/corfs2.F0000666000175000017500000003230711524070643015255 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CORFS2 C ***************** C C -------------------------------------------------------------- * (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF,BARYF,NCBORF, * BARYS,NCBORS,NCOUPS,NBICOR) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA TABLE DE CORRESPONDANCE ENTRE LES * C NOEUDS COUPLES DES MAILLAGES FLUIDE ET SOLIDE * C (CAS DES MAILLAGES NON COINCIDENTS) * C ALGORITHME PENIGUEL/RUPP * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS DU MAILLGE SURF SOLIDE ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELT SURF SOLIDE ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE VOL SOLIDE ! C ! NDMATF ! E ! D ! NOMBRE D'ELEMENTS DU MAILLGE SURF FLUIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NODESS ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SURF SOLIDE ! C ! COORDF ! TR ! D ! COORDONNEES DES NOEUDS FLUIDES COUPLES ! C ! NODESF ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SURF FLUIDE ! C ! BARYF ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELEMENTS SOLIDES ! C ! NCBORF ! TE ! R ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELEMENTS FLUIDES ! C ! NCBORS ! TE ! R ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C ! NCOUPS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : DPTSEG, CBARY2 C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "nlofes.h" #include "optct.h" #include "mobil.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELESS,NDMASS INTEGER NELESF,NDMASF,NBCOUS,NBCOUF,NBICOR INTEGER NODESS(NELESS,NDMASS),NODESF(NELESF,NDMASF) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) INTEGER NCOUPS(NBCOUS) DOUBLE PRECISION COORDS(NPOINS,NDIM),COORDF(NBCOUF,NDIM) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) C C.. Variables internes INTEGER ICODE,NUMSEG INTEGER N,NPF,NES,NA,NB,NELMIN,N1MIN,N2MIN,N3MIN INTEGER NPS,NEF,NG,NGA,NGB,NONC C DOUBLE PRECISION XA,YA,XB,YB,XP1,YP1 DOUBLE PRECISION XX,YY,DIST,XMIN,YMIN,DMIN DOUBLE PRECISION X1,Y1,X2,Y2,X3,Y3 C C*********************************************************************** C C 0- INITIALISATIONS C ================== C NONC=0 C DO 1 N=1,NBCOUF*NDIM BARYF(N,1) = 0.D0 1 CONTINUE C DO 2 N=1,NBCOUS*NDIM BARYS(N,1) = 0.D0 2 CONTINUE C C IF (NBLBLA.GE.2) WRITE(NFECRA,1000) C DO 100 NPF=1,NBCOUF C ICODE = 0 DMIN = 1.D6 C XP1 = COORDF(NPF,1) YP1 = COORDF(NPF,2) C DO 110 NES=1,NELESS C NA = NODESS(NES,1) NB = NODESS(NES,2) C IF (NCBORS(NA,1).EQ.-1 .OR. NCBORS(NB,1).EQ.-1) THEN GOTO 110 ENDIF C NGA = NCOUPS(NA) NGB = NCOUPS(NB) C XA = COORDS(NGA,1) YA = COORDS(NGA,2) XB = COORDS(NGB,1) YB = COORDS(NGB,2) C CALL DPTSEG (XP1,YP1,XA,YA,XB,YB,DIST,XX,YY,ICODE) C IF (ICODE.NE.0) THEN WRITE(NFECRA,1200) NPF,XP1,YP1,NES,NGA,NGB STOP ENDIF C IF (DIST.LT.DMIN) THEN DMIN = DIST XMIN = XX YMIN = YY NELMIN = NES ENDIF C 110 CONTINUE C N1MIN = NODESS(NELMIN,1) N2MIN = NODESS(NELMIN,2) N3MIN = NODESS(NELMIN,3) C X1 = COORDS(NCOUPS(N1MIN),1) Y1 = COORDS(NCOUPS(N1MIN),2) C X2 = COORDS(NCOUPS(N2MIN),1) Y2 = COORDS(NCOUPS(N2MIN),2) C X3 = COORDS(NCOUPS(N3MIN),1) Y3 = COORDS(NCOUPS(N3MIN),2) C CALL SOUSEG (XMIN,YMIN,X1,Y1, X2,Y2, NUMSEG) C IF (NUMSEG .EQ. 1) THEN CALL CBARY2 (XMIN,YMIN, & X1,Y1,X3,Y3, & BARYF(NPF,1),BARYF(NPF,2)) ELSE CALL CBARY2 (XMIN,YMIN, & X2,Y2,X3,Y3, & BARYF(NPF,1),BARYF(NPF,2)) ENDIF C NCBORF(NPF,1) = NELMIN NCBORF(NPF,2) = NUMSEG C IF (NBLBLA.GE.11) THEN WRITE(NFECRA,1700) NPF,XP1,YP1, & NELMIN,N1MIN,N2MIN, & NUMSEG, & XMIN,YMIN,DMIN, & BARYF(NPF,1),BARYF(NPF,2) ENDIF C 100 CONTINUE C IF (NBLBLA.GE.2) WRITE(NFECRA,2000) C DO 200 NPS=1,NBCOUS C IF (NCBORS(NPS,1).EQ.-1) THEN NONC=NONC+1 GOTO 200 ENDIF C NG = NCOUPS(NPS) C XP1 = COORDS(NG,1) YP1 = COORDS(NG,2) C ICODE = 0 DMIN = 1.D6 C DO 210 NEF=1,NELESF C NA = NODESF(NEF,1) NB = NODESF(NEF,2) C XA = COORDF(NA,1) YA = COORDF(NA,2) XB = COORDF(NB,1) YB = COORDF(NB,2) C CALL DPTSEG (XP1,YP1,XA,YA,XB,YB,DIST,XX,YY,ICODE) C IF (ICODE.NE.0) THEN WRITE(NFECRA,2200) NG,XP1,YP1,NEF,NA,NB STOP ENDIF C IF (DIST.LT.DMIN) THEN DMIN = DIST XMIN = XX YMIN = YY NELMIN = NEF ENDIF C 210 CONTINUE C IF (DMIN .GT. D2MAXF) THEN NONC=NONC+1 NCBORS(NPS,1) = -1 IF (NBLBLA.GE.11) THEN WRITE(NFECRA,2701) NG,XP1,YP1, & NELMIN,N1MIN,N2MIN, & XMIN,YMIN,DMIN ENDIF GOTO 200 ENDIF C N1MIN = NODESF(NELMIN,1) N2MIN = NODESF(NELMIN,2) X1 = COORDF(N1MIN,1) Y1 = COORDF(N1MIN,2) X2 = COORDF(N2MIN,1) Y2 = COORDF(N2MIN,2) C IF (NDMASF.EQ.3 .AND. NODESF(NELMIN,3).NE.0) THEN N3MIN = NODESF(NELMIN,3) X3 = COORDF(N3MIN,1) Y3 = COORDF(N3MIN,2) C CALL SOUSEG (XMIN,YMIN,X1,Y1, X2,Y2, NUMSEG) C IF (NUMSEG .EQ. 1) THEN C CALL CBARY2 (XMIN,YMIN, & X1,Y1,X3,Y3, & BARYS(NPS,1),BARYS(NPS,2)) C ELSE C CALL CBARY2 (XMIN,YMIN, & X2,Y2,X3,Y3, & BARYS(NPS,1),BARYS(NPS,2)) C ENDIF ELSE CALL CBARY2 (XMIN,YMIN, & X1,Y1,X2,Y2, & BARYS(NPS,1),BARYS(NPS,2)) NUMSEG = 0 ENDIF C NCBORS(NPS,1) = NELMIN NCBORS(NPS,2) = NUMSEG C C IF (NBLBLA.GE.11) THEN WRITE(NFECRA,2700) NG,XP1,YP1, & NELMIN,N1MIN,N2MIN, & XMIN,YMIN,DMIN, & BARYS(NPS,1),BARYS(NPS,2) ENDIF C C 200 CONTINUE C IF (NBLBLA.GE.3) WRITE(NFECRA,3000) NBCOUS,NONC C C-------- C FORMATS C-------- C 1000 FORMAT(/,' *** CORFS2 : ',/, & ' Recherche du correspondant de chaque noeud du', & ' maillage surfacique fluide',/) 1200 FORMAT(' %% ERREUR CORFS2 : LA RECHERCHE DU CORRESPONDANT A ', & 'ECHOUEE : ',/, & ' POINT FLUIDE :',I6,/, & ' ',2G10.3,/, & ' DANS LE SEGMENT SOLIDE :',I6,/, & ' ',2I6) 1700 FORMAT(/,' NOEUD FLUIDE :',I6,', coordonnees : ',2G10.3,/, & ' CORRESPONDANT SOLIDE : ',/, & ' numero du segment solide :',I6,/, & ' noeuds :',I6,' ',I6,/, & ' numero du sous-segment :',I6,/, & ' coord du correspondant :',2G10.3,/, & ' distance minimale :',G10.3,/, & ' coord barycentriques :',2G10.3) C 2000 FORMAT(/,' *** CORFS2 :',/, & ' Recherche du correspondant de chaque noeud du', & ' maillage surfacique solide',/) 2200 FORMAT(' %% ERREUR CORFS2 : LA RECHERCHE DU CORRESPONDANT A ', & 'ECHOUEE : ',/, & ' POINT SOLIDE :',I6,/, & ' ',2G10.3,/, & ' DANS LE SEGMENT FLUIDE :',I6,/, & ' ',2I6) 2700 FORMAT(/,' NOEUD SOLIDE :',I6,', coordonnees : ',2G10.3,/, & ' CORRESPONDANT FLUIDE : ',/, & ' numero du segment fluide :',I6,/, & ' noeuds :',I6,' ',I6,/, & ' coord du correspondant :',2G10.3,/, & ' distance minimale :',G10.3,/, & ' coord barycentriques :',2G10.3) 2701 FORMAT(/,' +++ NOEUD SOLIDE ELIMINE :',I6,', coordonnees : ', & 2G10.3,/, & ' CORRESPONDANT FLUIDE : ',/, & ' numero du segment fluide :',I6,/, & ' noeuds :',I6,' ',I6,/, & ' coord du correspondant :',2G10.3,/, & ' distance minimale :',G10.3) CC 3000 FORMAT(/,' *** CORFS2 : ',/, * ' Nombre de noeuds solides candidats au couplage ',I7,/, * ' Nombre de noeuds elimines du couplage ',I7) C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/iprbls.F0000666000175000017500000000440511524070643015350 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- INTEGER FUNCTION IPRBLS ( CHAINE, LCH ) C ==================================================================== C C BUT : DETERMINER LA POSITION DU PREMIER CARACTERE NON BLANC DANS C ---- CHAINE DE LONGUEUR LCH AVEC LA CONVENTION DE ZERO SI C LA CHAINE EST BLANCHE C C PARAMETRES D'ENTREE : C --------------------- C CHAINE : CHAINE DE CARACTERES C LCH : LONGUEUR DE LA CHAINE DE CARACTERES C C PARAMETRES DE SORTIE : C ---------------------- C AUCUN C C AUTEURS : SOCIETE SIMULOG : ALAIN DUTOYA C -------- C C ==================================================================== C IMPLICIT NONE C C ==================================================================== C CHARACTER CHAINE*(*) INTEGER LCH C INTEGER I C C ==================================================================== C--------------- C POSITIONNEMENT C--------------- C DO 10 I = 1, LCH IF ( CHAINE (I:I) .NE. ' ' ) THEN IPRBLS = I GOTO 20 ENDIF 10 CONTINUE C IPRBLS = 0 C 20 CONTINUE C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/flvnum.F0000666000175000017500000001521011524070643015360 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE FLVNUM C ***************** C C ----------------------------------------- * (NFLUVS,NBFLVS,NREFS,NPOINS,NREFE,NELEMS) C ----------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA NUMEROTATION LOCALE DES * C FLUX VOLUMIQUES * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NFLUVS ! TE ! R ! Numero des noeuds portant un flux volumique ! C ! NBFLVS ! E ! D ! Nombre de noeuds portant un flux volumique ! C ! NREFS ! TE ! D ! References des noeuds solides ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C ! NREFE ! TE ! D ! References des elements solides ! C ! NELEMS ! E ! D ! Nombre d'elements du maillage solide ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NBFLVS,NFLUVS(NBFLVS) INTEGER NPOINS,NREFS(NPOINS),NELEMS,NREFE(NELEMS) C C.. Variables internes INTEGER NUMREF,N,N1 INTEGER NFLV LOGICAL ERR C C*********************************************************************** C C 1- INITIALISATIONS C ================== C DO 1 N=1,NBFLVS NFLUVS(N) = 0 1 CONTINUE C NFLV = 0 C IF (NDFLUV.EQ.1) THEN C DO 200 N=1,NPOINS NUMREF = ABS(NREFS(N)) DO 201 N1=1,NRFMAX IF (IREFSV(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFLV = NFLV + 1 NFLUVS(NFLV) = N ENDIF C 201 CONTINUE 200 CONTINUE C ELSE C DO 210 N=1,NELEMS C NUMREF = ABS(NREFE(N)) DO 211 N1=1,NRFMAX IF (IREFSV(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFLV = NFLV + 1 NFLUVS(NFLV) = N ENDIF C 211 CONTINUE 210 CONTINUE C ENDIF C C 2- CONTROLE DES DIMENSIONS C ========================== C ERR = .FALSE. C IF (NFLV.NE.NBFLVS) THEN WRITE(NFECRA,2000) 'flux volumique',NFLV,NBFLVS ERR = .TRUE. ENDIF C C C C 3- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) THEN IF (NDFLUV.EQ.1) THEN WRITE(NFECRA,3000) NBFLVS ELSE WRITE(NFECRA,3001) NBFLVS ENDIF ENDIF C IF (NBLBLA.EQ.10) THEN IF (NBFLVS.GT.0) THEN IF (NDFLUV.EQ.1) THEN WRITE(NFECRA,3010) ELSE WRITE(NFECRA,3011) ENDIF WRITE(NFECRA,3009) (NFLUVS(N),N=1,NBFLVS) ENDIF ENDIF C C 6- ARRET DU PROGRAMME EN CAS D'ERREUR DE DIMENSION C ================================================== IF (ERR) STOP C-------- C FORMATS C-------- C 2000 FORMAT(' %% ERREUR FLVNUM : incoherence sur les ',A30,/, & ' On en compte :',I9,/, & ' Il y en a ',I9,' de declares') C 3000 FORMAT(/,' *** FLVNUM : Nombre de noeuds du solide',/, & ' portant un flux volumique : ',I10) 3001 FORMAT(/,' *** FLVNUM : Nombre d''elements du solide',/, & ' portant un flux volumique : ',I10) C 3009 FORMAT(8X,12I9) 3010 FORMAT(/,8X,'Liste des noeuds solides avec flux volumique :',/) 3011 FORMAT(/,8X,'Liste des elements solides avec flux volumique :',/) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/cmptfa.F0000666000175000017500000003117011524070643015326 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CMPTFA,SSI=0 SUBROUTINE CMPTFA C ***************** C C ------------------------------------------------- * (NDIELE,NREFAC,NODES,NDMATS,NELEMS,NBFACE,NELESS,NELEUS, * NBFFLU,NBFECH,NELERC,NELEPR,NELERA,NBFRAI, * NREFS,NPOINS,NBCOUS,NBDIRS,NBRESS,NBPRIO,NBMOBS, * NBFLUS,NBECHS,NBRAYS,NBRAIS,ITAB1,ITAB2) C ------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C COMPTE DES NOEUDS PORTANT LES DIVERSES CONDITIONS * C POSSIBLES * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NREFAC ! TE ! D ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! RNOMBRE DE NOEUDS PAR ELEMENTS ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACE DES ELEMENTS ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SURF COUPLES SOLIDES ! C ! NELEUS ! E ! D ! NOMBRE D'ELEMENTS SURF TYPE FLUX SOLIDES ! C ! NBFFLU ! E ! R ! NOMBRE DE FACES SOLIDES AVEC CL DE TYPE FLUX! C ! NBFECH ! E ! R ! NOMBRE DE FACES SOLIDES AVEC CL COEF ECH ! C ! NELERC ! E ! R ! NOMBRE DE FACES SOLIDES AVEC CL RESI CONTACT! C ! NELERA ! E ! R ! NOMBRE DE FACES SOLIDES AVEC CL RAYONNEMENT ! C ! NBFRAI ! E ! R ! NOMBRE DE FACES SOLIDES AVEC RAYONNEMENT INF! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NBCOUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBDIRS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBRESS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBPRIO ! E ! R ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! R ! NOMBRE DE NOEUDS SOLIDES EN MOUVEMENT ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBECHS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBRAYS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBRAIS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT INF! C ! NELEPR ! E ! R ! NOMBRE D'ELEMENTS PERIODIQUES ! C ! ITAB1 ! TE ! A ! TALBEAU DE TRAVAIL ! C ! IDIMT1 ! TE ! A ! DIMENSION DE ITAB1 ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" #include "optct.h" #include "divct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIELE,NELEMS,NBFACE,NDMATS INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE) INTEGER NELESS,NELEUS,NBFFLU,NBFECH,NELERC,NBFRAI,NELEPR,NELERA INTEGER NPOINS,NREFS(NPOINS) INTEGER NBCOUS,NBDIRS,NBRESS INTEGER NBPRIO,NBMOBS,ITAB1(NPOINS),ITAB2(NPOINS) INTEGER NBFLUS,NBECHS,NBRAYS,NBRAIS C C.. Variables internes INTEGER I,J,NUMREF,N1,N,NBP,NUM,N2 LOGICAL LPERIO C C NARE(noeud,arete), NFAC(noeud,face) INTEGER NARE(3,3),NFAC(6,4) C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,2,3,5,6,7, 1,2,4,5,9,8, 1,3,4,7,10,8, 2,3,4,6,10,9/ C C 1- INITIALISATIONS C ------------------ C NBFLUS = 0 NBRAYS = 0 NBRAIS = 0 NBECHS = 0 C NELESS = 0 NBFFLU = 0 NBFECH = 0 NELERC = 0 NELERA = 0 NBFRAI = 0 C NBCOUS = 0 NBDIRS = 0 NBRESS = 0 NBPRIO = 0 NBMOBS = 0 C NELEPR = 0 NELEUS = 0 C C DO 10 N=1,NPOINS ITAB1(N) = 0 ITAB2(N) = 0 10 CONTINUE C IF (NCTHFS.EQ.2) THEN NBP = 6 ELSE IF (NDIELE.EQ.2) THEN NBP = 3 ELSE NBP = 6 ENDIF ENDIF C C C 2.1- COMPTE DES FACES ET NOEUDS COUPLES OU REST DE CONTACT C ========================================================== C DO 200 J=1,NBFACE DO 210 I=1,NELEMS C NUMREF = NREFAC(I,J) C IF (NUMREF.NE.0) THEN C DO 205 N1=1,NRFMAX C IF (IREFSC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NELESS = NELESS + 1 DO 215 N=1,NBP IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN NUM = NODES(I,NARE(N,J)) ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN NUM = NODES(I,NFAC(N,J)) ELSE NUM = NODES(I,N) ENDIF IF (ITAB1(NUM).LE.0) THEN NBCOUS = NBCOUS + 1 ITAB1(NUM) = 1 ENDIF 215 CONTINUE ENDIF C IF (IREFSF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFFLU = NBFFLU + 1 ENDIF C IF (IREFSE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFECH = NBFECH + 1 ENDIF C IF (IREFRE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NELERC = NELERC + 1 DO 216 N=1,NBP IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN NUM = NODES(I,NARE(N,J)) ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN NUM = NODES(I,NFAC(N,J)) ELSE NUM = NODES(I,N) ENDIF IF (ITAB2(NUM).LE.0) THEN NBRESS = NBRESS + 1 ITAB2(NUM) = 1 ENDIF 216 CONTINUE ENDIF C 205 CONTINUE C ENDIF C 210 CONTINUE 200 CONTINUE C C 2.2- COMPTE DES FACES ET NOEUDS AVEC RAYONNEMENT C ================================================ DO 22 N=1,NPOINS ITAB1(N) = 0 ITAB2(N) = 0 22 CONTINUE C DO 220 J=1,NBFACE DO 230 I=1,NELEMS C NUMREF = NREFAC(I,J) C IF (NUMREF.NE.0) THEN C DO 235 N1=1,NRFMAX C IF (IREFRA(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NELERA = NELERA + 1 DO 236 N=1,NBP IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN NUM = NODES(I,NARE(N,J)) ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN NUM = NODES(I,NFAC(N,J)) ELSE NUM = NODES(I,N) ENDIF IF (ITAB1(NUM).EQ.0) THEN NBRAYS = NBRAYS + 1 IF (N.LE.NDIELE) THEN ITAB1(NUM) = 1 ELSE ITAB1(NUM) = -1 ENDIF ENDIF 236 CONTINUE ENDIF C IF (IREFRI(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFRAI = NBFRAI + 1 DO 237 N=1,NBP IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN NUM = NODES(I,NARE(N,J)) ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN NUM = NODES(I,NFAC(N,J)) ELSE NUM = NODES(I,N) ENDIF IF (ITAB2(NUM).LE.0) THEN NBRAIS = NBRAIS + 1 ITAB2(NUM) = 1 ENDIF 237 CONTINUE ENDIF C 235 CONTINUE C ENDIF C 230 CONTINUE 220 CONTINUE C C 2B- COMPTE DES NOEUDS SOMMET AVEC RAYONNEMENT C ============================================= C NPRAP1 = 0 C DO 250 N=1,NPOINS IF (ITAB1(N).EQ. 1) NPRAP1 = NPRAP1 + 1 250 CONTINUE C C C 3- COMPTE DES NOEUDS SUIVANTS LES CL C ==================================== C DO 300 I=1,NPOINS C NUMREF = NREFS(I) C IF (NUMREF.NE.0) THEN C DO 305 N1=1,NRFMAX C IF (IREFSD(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBDIRS = NBDIRS + 1 ENDIF C IF (IREFPR(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBPRIO = NBPRIO + 1 ENDIF C IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBMOBS = NBMOBS + 1 ENDIF C 305 CONTINUE C ENDIF C 300 CONTINUE C C C 4- COMPTE DES ELEMENTS PERIODIQUES C ================================== C DO 400 N=1,NELEMS C LPERIO = .FALSE. DO 401 N1=1,NDMATS NUMREF = NREFS(NODES(N,N1)) IF (NUMREF.NE.0) THEN DO 402 N2=1,NRFMAX IF (IREFPR(N2).NE.0 .AND. NUMREF.EQ.N2) LPERIO = .TRUE. 402 CONTINUE ENDIF 401 CONTINUE IF (LPERIO) NELEPR = NELEPR + 1 C 400 CONTINUE C C C 5- NOMBRE TOTAL D'ELEMENTS SURF DE TYPE FLUX C ============================================ DO 500 J=1,NBFACE DO 510 I=1,NELEMS C NUMREF = NREFAC(I,J) C IF (NUMREF.NE.0) THEN C DO 520 N1=1,NRFMAX C IF ( (IREFSC(N1).NE.0 .AND. NUMREF.EQ.N1) * .OR.(IREFSF(N1).NE.0 .AND. NUMREF.EQ.N1) * .OR.(IREFSE(N1).NE.0 .AND. NUMREF.EQ.N1) * .OR.(IREFRE(N1).NE.0 .AND. NUMREF.EQ.N1) * .OR.(IREFRA(N1).NE.0 .AND. NUMREF.EQ.N1) * .OR.(IREFRI(N1).NE.0 .AND. NUMREF.EQ.N1) ) * NELEUS = NELEUS + 1 520 CONTINUE ENDIF 510 CONTINUE 500 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/lraid3.F0000666000175000017500000001650211524070643015234 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 SUBROUTINE LRAID3 C ***************** C C ----------------------------------------------------- * (NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) C ----------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS RAYONNEMENT * C STRUCTURE DE DONNEE ISSUE DE IDEAS MS * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (3 ) ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! D ! NOMBRE D'ELTS DU MAILLAGE RAYONNEMENT ! C ! NODRAY ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE RAYONNEMENT ! C ! NRFRAY ! TE ! R ! TABLEAU DES REFERENCES ELTS MAILLAGE RAYT ! C ! COORAY ! TR ! R ! COORD DES NOEUDS DU MAILLAGE RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! ! ! C ! /DIVCT/ ! ! ! ! C ! /NLOFES/ ! ! ! ! C ! /NLOFCT/ ! ! ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "nlofes.h" #include "nlofct.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NPOINR,NDIM INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY) DOUBLE PRECISION COORAY(NPOINR,NDIM) C C.. Variables internes INTEGER N,I,J,NUMMAX INTEGER NUM,ID,N1,N2,N3,NBNO,NR CHARACTER*80 CH C C*********************************************************************** C C C 2- LECTURE DE LA TABLE DES NOEUDS C ================================= C CALL SECIDE(NFSGRA,2411) C DO 220 N=1,NPOINR READ(NFSGRA,2200) N1,N2,N3,NR READ(NFSGRA,2210) (COORAY(N,J),J=1,NDIM) 220 CONTINUE C C C C 3- TABLE DES ELEMENTS C ===================== C CALL SECIDE(NFSGRA,2412) C C IF(NDIM.EQ.3) THEN DO 320 N=1,NELRAY READ(NFSGRA,3200) NUM,ID,N1,N2,NRFRAY(N),NBNO READ(NFSGRA,3201) (NODRAY(N,I),I=1,NBNO) 320 CONTINUE ELSE DO 321 N=1,NELRAY READ(NFSGRA,3200) NUM,ID,N1,N2,NRFRAY(N),NBNO READ(NFSGRA,3000) CH READ(NFSGRA,3201) (NODRAY(N,I),I=1,NBNO) 321 CONTINUE ENDIF C NUMMAX=0 DO N=1,NELRAY DO I=1,NDIM NUMMAX=MAX(NUMMAX,NODRAY(N,I)) ENDDO ENDDO IF (NUMMAX.GT.NPOINR) THEN WRITE(NFECRA,6000) STOP ENDIF C C C 4- IMPRESSION SUR LISTING C ========================= C IF (NBLBLR.GT.0) THEN WRITE(NFECRA,4000) WRITE(NFECRA,4010) NDIM,NPOINR,NELRAY ENDIF C C C 5- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLR.GE.2) THEN C WRITE(NFECRA,5000) WRITE(NFECRA,5010) DO 100 I=1,10 WRITE(NFECRA,5011) I,(COORAY(I,J),J=1,NDIM) 100 CONTINUE C WRITE(NFECRA,5020) DO 110 I=1,10 WRITE(NFECRA,5012)I,(NODRAY(I,J),J=1,NDIM) 110 CONTINUE C WRITE(NFECRA,5030) DO 120 I=1,10 WRITE(NFECRA,5013)I,NRFRAY(I) 120 CONTINUE C C ENDIF C C-------- C FORMATS C-------- C 2200 FORMAT(4I10) 2210 FORMAT(1P3D25.16) 3000 FORMAT(A80) 3200 FORMAT(6I10) 3201 FORMAT(8I10) C 4000 FORMAT(//,' *** LRAID2 : MAILLAGE POUR LE RAYONNEMENT :') 4010 FORMAT(8X,'- Dimension du maillage : ',I6,/ & 8X,'- Nombre total de noeuds : ',I6,/ & 8X,'- Nombre d''elements : ',I6) C 5000 FORMAT(/,' *** LRAID2 : Verification du maillage solide',/) 5010 FORMAT(/,14X,'Coordonnees des 10 premiers noeuds :',/) 5020 FORMAT(/,14X,'Table des 10 premiers elements :',/) 5030 FORMAT(/,14X,'References des 10 premiers elements :',/) 5011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 5012 FORMAT(14X,'N=',I2,' NOEUDS : ',10I6) 5013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) C 6000 FORMAT(/,' %% ERREUR LRAID3 : LA NUMEROTATION DES NOEUDS DU', * ' MAILLAGE POUR LE RAYONNEMENT',/, * ' COMPORTE DES TROUS',/, * ' VEUILLEZ RENUMEROTER VOTRE', * ' MAILLAGE POUR AVOIR UNE NUMEROTATION CONTINUE') C END syrthes-3.4.3-dfsg1/src/s/lcoodp.F0000666000175000017500000001345411524070643015341 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LCOODP,SSI=0 SUBROUTINE LCOODP C ***************** C C -------------------------------- * (COODP,COOSP,NP,NDIM,NPOINS,NFIC) C -------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE EN DOUBLE PRECISION DES COORDONNES * C DU MAILLAGE SIMAIL QUI SONT EN SIMPLE PRECISION * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! COODP ! TR ! R ! COORDONNES EN DOUBLE PRECISION ! C ! COOSP ! TR ! R ! COORDONNES EN SIMPLE PRECISION ! C ! NP ! E ! D ! NBRE DE POINTS A LIRE ! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECSI2 C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #ifdef HAVE_C_IO #include "nlofes.h" #endif C C*********************************************************************** C C..Variables externes INTEGER NP,NDIM,NPOINS,NFIC DOUBLE PRECISION COODP(NPOINS,NDIM) REAL COOSP(2*NPOINS,NDIM) C C..Variables internes INTEGER LE,I,J C #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR REAL XE CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C C 0- INITIALISATIONS C ================== C DO 1 I=1,NP DO 1 J=1,NDIM COODP(I,J) = 0. 1 CONTINUE C 1- LECTURE DU TABLEAU 4 C ======================= C C Lecture du tableau en simple precision C -------------------------------------- #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFIC, 4, 1, 1, NBRLUS, NBRTOT, XE, IERROR) IF (IERROR .NE. 0) GOTO 998 DO I = 1, NP DO J = 1, NDIM CALL READBF (NFIC, 4, 1, 1, NBRLUS, NBRTOT, * COOSP(2*I,J), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDDO IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFIC, 4, 0, 2, NBRLUS, NBRTOT, 0.0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFIC) LE,( (COOSP(2*I,J),J=1,NDIM) , I=1,NP) #endif C C Passage en double precision C --------------------------- DO 10 I=1,NP DO 10 J=1,NDIM COODP(I,J) = DBLE(COOSP(2*I,J)) 10 CONTINUE C RETURN C #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP C C-------- C FORMATS C-------- C 9998 FORMAT(' %% ERREUR LCOODP : erreur de lecture du maillage ', * ' solide',/,' de type : ',A) #endif /* HAVE_C_IO */ C END syrthes-3.4.3-dfsg1/src/s/evadff.F0000666000175000017500000001502311524070643015306 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE EVADFF C ***************** C C -------------------------------------------------------------- *(NODEBF,NELEBF,NDMASF,NREFAF,NPOIFF,NBCOUF,NBRAF,NELESF,NELRAF, * ITRAV) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C EVALUATION DES DIMENSIONS DES TABLEAUX NECESSAIRES * C POUR LE FLUIDE * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NODEBF ! TE ! D ! CONNECTIVITE DE MAILLAGE DE BORD FLUIDE ! C ! NELEBF ! E ! D ! NBRE D'ELEMENT DE BORD FLUIDE ! C ! NELESF ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF COUPLE FLUIDE ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS FLUIDES SURF ! C ! NREFF ! TE ! D ! REFERENCES DES NOEUDS FLUIDES ! C ! NPOINF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE FLUIDE VOL ! C ! NBCOUF ! E ! R ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /XREFER/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "optct.h" C C********************************************************************** C C.. Variables externes INTEGER NELEBF,NELESF,NDMASF,NBCOUF INTEGER NELRAF,NBRAF INTEGER NODEBF(NELEBF,NDMASF),NREFAF(NELEBF) INTEGER NPOIFF,ITRAV(NPOIFF) C C C.. Variables internes INTEGER I,M,N1,NUMREF C C********************************************************************** C DO I=1,NPOIFF ITRAV(I)=0 ENDDO C C 1 Nombre d'elements fluides couples C ------------------------------------- C NELESF = 0 NELRAF = 0 C DO I=1,NELEBF NUMREF = NREFAF(I) IF (NUMREF.NE.0) THEN DO N1=1,NRFMAX IF (NUMREF.EQ.N1) THEN IF (IREFFC(N1).NE.0 .AND. IREFRF(N1).NE.0) THEN NELESF=NELESF+1 NELRAF=NELRAF+1 DO M=1,NDMASF ITRAV(NODEBF(I,M))=3 ENDDO ELSEIF (IREFFC(N1).NE.0) THEN NELESF=NELESF+1 DO M=1,NDMASF ITRAV(NODEBF(I,M))=1 ENDDO ELSEIF (IREFRF(N1).NE.0) THEN NELRAF=NELRAF+1 DO M=1,NDMASF ITRAV(NODEBF(I,M))=2 ENDDO ENDIF ENDIF ENDDO ENDIF ENDDO C C 2 Nombre de noeuds fluides couples C ----------------------------------- NBCOUF = 0 NBRAF = 0 C C DO I=1,NPOIFF IF (ITRAV(I).EQ.1) THEN NBCOUF=NBCOUF+1 ELSEIF (ITRAV(I).EQ.2) THEN NBRAF=NBRAF+1 ELSEIF (ITRAV(I).EQ.3) THEN NBCOUF=NBCOUF+1 NBRAF=NBRAF+1 ENDIF ENDDO C C C 3- IMPRESSIONS C ============== C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,3000) NBCOUF,NELESF,NBRAF,NELRAF ENDIF C C C-------- C FORMATS C-------- C C 3000 FORMAT(/,' *** EVADFF : CARACTERISTIQUES DU MAILLAGE ', & 'FLUIDE : ',/, & ' NOMBRE DE ...',/, & 15X,'- nombre de noeuds couples avec le solide ',I9,/, & 15X,'- d''elements couples avec le solide ',I9,/, & 15X,'- nombre de noeuds avec rayonnement ',I9,/, & 15X,'- d''elements avec rayonnement ',I9) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/lrasi2.F0000666000175000017500000002670711524070643015262 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LRASI2 C ***************** C C -------------------------------- *(NDIM,NPOINR,NELRAY,IREF,INOEUD) C -------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS POUR LE RAYONNEMENT * C --> STRUCTURE DE DONNEE ISSUE DE SIMAIL * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINR,NELRAY,IREF(NELRAY),INOEUD(NELRAY*NDIM) C C.. Variables internes INTEGER NDIMEF,NCOPNP,NSOMP1 INTEGER I,M(32),LE,NSEG,NTRI,NTET,J,MM,NT3 INTEGER NCGE,NMAE,NNO,INING,NBEGM INTEGER NFAC(3), NARE(3), NSOM INTEGER NNMAE(0:20) #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C C*********************************************************************** C C 0- INITIALISATIONS C ================== C #ifdef HAVE_C_IO CALL REWDBF (NFSGRA, IERROR) IF (IERROR .NE. 0) GOTO 998 #else REWIND (NFSGRA) #endif C NFAC(1) = 0 NFAC(2) = 0 NFAC(3) = 0 C IF (NDIM.EQ.3) THEN NARE(1) = 3 NARE(2) = 3 NARE(3) = 0 ELSE NARE(1) = 0 NARE(2) = 0 NARE(3) = 0 ENDIF C NSOM = NDIM C DO 5 I=0,20 NNMAE(I) = 1 5 CONTINUE NNMAE(0) = 0 C C C 1- LECTURE DE L'ENREGISTREMENT AVANT LE TABLEAU 0 C ================================================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 #else READ(NFSGRA,ERR=999) LE,(M(I), I=1,LE) #endif C #ifdef HAVE_C_IO CALL REWDBF (NFSGRA, IERROR) IF (IERROR .NE. 0) GOTO 998 NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else REWIND (NFSGRA) READ (NFSGRA,ERR=999) LE,(M(I), I=1,LE) #endif C NT3=M(5) C C C 2- LECTURE DU TABLEAU 0 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGRA,ERR=999) LE, (M(I), I=1,LE) #endif C C 3- LECTURE DU TABLEAU 2 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGRA,ERR=999) LE,(M(I),I=1,LE) #endif C NDIMEF = M(1) NCOPNP = M(4) NELRAY = M(5) NSEG = M(7) NTRI = M(8) NTET = M(10) NPOINR = M(15) NSOMP1 = M(22) NBEGM=M(25) C C C 5- LECTURE DES TABLEAUX 3, 4 ET 5 C ================================= C #ifdef HAVE_C_IO IF (NT3.GT.0) THEN ccc IF (NBEGM.GT.0) THEN NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF ENDIF #else IF (NT3.GT.0) READ(NFSGRA,ERR=999) LE ccc IF (NBEGM.GT.0) READ(NFSGRA,ERR=999) LE #endif C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGRA, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGRA,ERR=999) LE #endif C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 C DO I = 1, NELRAY C CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NCGE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NMAE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, IREF(I), IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, NNO, IERROR) IF (IERROR .NE. 0) GOTO 998 C DO J = 1, NNO CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, & INOEUD((J-1)*NELRAY+I), IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO IF (NMAE.NE.0) THEN CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, INING, & IERROR) IF (IERROR .NE. 0) GOTO 998 IF (INING.EQ.1) THEN DO J = 1, NFAC(INING) CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF IF (INING.LE.2) THEN DO J = 1, NARE(INING) CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF DO J = 1, NSOM CALL READBF (NFSGRA, 4, 1, 1, NBRLUS, NBRTOT, MM, & IERROR) IF (IERROR .NE. 0) GOTO 998 ENDDO ENDIF C ENDDO C #else INING=1 READ(NFSGRA,ERR=999) LE, & ( NCGE,NMAE, & IREF(I), & NNO, ( INOEUD((J-1)*NELRAY+I),J=1,NNO), & (INING, J=1,NNMAE(NMAE) ), & (MM, J=1,NFAC(INING)*NNMAE(NMAE) ), & (MM, J=1,NARE(INING)*NNMAE(NMAE) ), & (MM, J=1,NSOM*NNMAE(NMAE) ) & , I=1,NELRAY ) #endif C RETURN C #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #else 999 CONTINUE WRITE(NFECRA,9999) STOP #endif C C-------- C FORMATS C-------- C 1000 FORMAT(' %% ERREUR LRASI2 : LE FICHIER NE CONTIENT PAS UNE S.D.', & ' DE MAILLAGE ') 1018 FORMAT(' %% ERREUR LRASI2 : DIMENSION DES MAILLAGES ', & 'INCOMPATIBLES') 1021 FORMAT(' %% ERREUR LRASI2 : La dimension du maillage rayonnement' & ,' n''est pas coherente',/, & 21X,'avec celle du solide') 1022 FORMAT(' %% ERREUR LRASI1 : LE MAILLAGE POSSEDE DES' & ,' NOEUDS MILIEUX') 1023 FORMAT(' %% ERREUR LRASI2 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES',/, & 20X,'Seuls sont autorises :',/, & 20X,' - les triangles (en dimension 3)',/, & 20X,' - les segments (en dimension 2)') C 3000 FORMAT(/,'%% ERREUR LRASI2 : LA DIMENSION DU TABLEAU DES ENTIERS', & ' EST INSUFFISANTE ',/, & ' IL FAUT AU MINIMUM ',I9,' ENTIERS ') 3010 FORMAT(/,'%% ERREUR LRASI2 : LA DIMENSION DU TABLEAU DES REELS', & ' EST INSUFFISANTE ',/, & ' IL FAUT AU MINIMUM ',I9,' REELS ') C 5000 FORMAT(' %% ERREUR LRASI2 : la taille du tableau des entiers ',/, * 20X,'est insuffisante, il faut au moins : ',I9) #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LRASI2 : erreur de lecture du maillage ', * ' rayonnement',/,' de type : ',A) #else 9999 FORMAT(' %% ERREUR LRASI2 : erreur de lecture du maillage ', * ' rayonnement') #endif C END syrthes-3.4.3-dfsg1/src/s/manip_tree.c0000666000175000017500000001227011524070644016235 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ #include #include #include "tree.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | elague_tree | | Faire du menage dans l'arbre | |======================================================================| */ void elague_tree(struct node *pere,struct node *n1,int nbfils) { int i,nbf; struct element *el1,*el2; struct child *f1; nbf=nbfils-1; if (n1->lfils != NULL) { if (n1 != pere) { el1=n1->lelement; while (el1!=NULL) { el2=el1->suivant; free(el1); el1=el2; } n1->lelement = NULL; } f1 = n1->lfils; elague_tree(pere,f1->fils,nbfils); f1 = f1->suivant; for (i=0;ifils,nbfils); f1 = f1->suivant; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | tuer_tree | | Tuer l'arbre... | |======================================================================| */ void tuer_tree(struct node *noeud,int nbfils) { int i,nbf; struct element *el1,*el2; struct child *f1,*f2; nbf=nbfils-1; /* elimination de la liste d'element si elle existe */ if (noeud->lelement != NULL) { el1=noeud->lelement; while (el1!=NULL) { el2=el1->suivant; free(el1); el1=el2; } noeud->lelement = NULL; } if (noeud->lfils != NULL) { f1 = noeud->lfils; tuer_tree(f1->fils,nbfils); f2 = f1->suivant; free(f1); f1=f2; for (i=0;ifils,nbfils); f2 = f1->suivant; free(f1); f1=f2; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | affiche_tree | | Afficher un arbre | |======================================================================| */ void affiche_tree(struct node *n1, int nbfils) { int i,nbf; struct element *fa1; struct child *f1; nbf=nbfils-1; fa1 = n1->lelement; if (fa1 != NULL) { if (nbfils==4) printf("centre %f %f taille x et y %f %f \n", n1->xc,n1->yc,n1->sizx,n1->sizy); else printf("centre %f %f %f taille x y z %f %f %f \n", n1->xc,n1->yc,n1->zc, n1->sizx,n1->sizy,n1->sizz); } while (fa1 != NULL) { printf(" element %d \n",fa1->num); fa1=fa1->suivant; } f1 = n1->lfils; if (f1 != NULL) { /* printf("noeud %d \n",f1->name);*/ affiche_tree(f1->fils,nbfils); f1 = f1->suivant; for (i=0;ifils != NULL) { /* printf("noeud %d \n",f1->name);*/ affiche_tree(f1->fils,nbfils); } f1 = f1->suivant; } } } syrthes-3.4.3-dfsg1/src/s/inisol.F0000666000175000017500000007555611524070644015372 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INISOL C ***************** C C ------------------------------------------------------------- *(NDIM,NDIELE,NBFACE,NFBIDA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL,NPOINS,NELEMS,NDMATS, * NELESS,NDMASS,NELEUS,NELERC,NELEPR,NELERA,NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS,NBCOPR,NBPHYS,NPPEL,NPOUE,NBICOR, * NBFFLU,NBFECH,NBFRAI, * NCOUPS,NFLUSS,NDIRS,NECHS,NFLUVS,NRESCS,NRAYTS, * NRAYIS,NPRIOS,NMOBIL, * VFLUSS,VDIRS,VECHS,VFLUVS,VRESCS,VRAYTS,VRAYIS, * NREFAC,NREFAL,NFCOUS,NFFLUS,NFECHS,NFRESC,NFRAYS,NFRAIS, * VFFLUS,VFECHS,VFRESC,VFRAYS,VFRAIS, * NREFS,NREFE,COORDS,NODES,NODESS,NODEUS,NODERC,NODEPR,NODERA, * NANGLE,PHYSOL,TMPSA,TMPS,TMPSC1,TMPSC2,TMPSC3,VOLUME,SURFUS, * NELRAY,NPOINR,NNSRAY,NNFRAY,NNERAY,NFCFRA,NFCSRA,NFTIRA, * NFFIRA,NFPERA,NFMST,NFMSTE,NGFFIR,NGFTIR,NGFPER,NGFPEF, * NGFMST,NGFMSE,VFMSTE,PHMSTP,PHMSTO, * EMISSI,PHFRAF,PHFRAE,TEMRAY,FIRAY,VFIRAY,ERAYEQ,TRAYEQ, * NODRAY,NRFRAY,ITYFAR,COORAY,FDFRAY,SUFRAY,NCSRAY,NCFRAY,NESRAY, * NCFIN,NCGROS,BARYGR,BARYFS,ITRAV,IDTRAV,TABRAY,RADIOS, * ITRAV1,ITRAV2,TRAV1,TRAV2,TRAV3,TOTRAI,TMPMAX,TMPMIN,ITRMED) C ------------------------------------------------------------- C C Attention, les tableaux ITRAV2,TRAV1,TRAV2,TRAV3 C n'existent qu'en presence de noeuds periodiques C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C INITIALISATIONS POUR LA PRISE EN COMPTE DU COUPLAGE C THERMIQUE FLUIDE/SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBFLUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NELESS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NELEUS ! E ! D ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELERA ! E ! D ! NBRE D'ELTS DU MAIL SURF SOLIDE AVEC RAYT ! C ! NELEPR ! E ! D ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NBRESS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBPRIO ! E ! D ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! D ! NOMBRE DE NOEUDS SOLIDES EN MOUVEMENT ! C ! NBCOPR ! E ! D ! NBRE DE CORRESPONDANTS POUR LES NOEUDS PERIOD! C ! NBPHYS ! E ! D ! NOMBRE DE VARIABLES PHYSIQUES SUR LE SOLIDE ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NBFFLU ! E ! D ! NOMBRE DE FACES AVEC FLUX ! C ! NBFECH ! E ! D ! NOMBRE DE FACES AVEC COEF ECH ! C ! NCOUPS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NFLUSS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS AVEC CL FLUX ! C ! NDIRS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS AVEC CL DIRICHLET ! C ! NECHS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS AVEC CL COEFF ECH ! C ! NFLUVS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOLUM ! C ! NRESCS ! TE ! R ! NUMEROS GLOB DES NOEUDS AVEC RES DE CONTACT ! C ! NRAYTS ! TE ! R ! NUMEROS GLOB DES NOEUDS AVEC RAYONNEMENT ! C ! NPRIOS ! TE ! R ! NUMEROS GLOB DES NOEUDS PERIODIQUES ! C ! NMOBIL ! TE ! R ! NUMEROS GLOB DES NOEUDS EN MOUVEMENT ! C ! VFLUSS ! TR ! R ! VALEURS DE LA CL DE TYPE FLUX ! C ! VFDIRS ! TR ! R ! VALEURS DE LA CL DE TYPE DIRICHLET ! C ! VECHS ! TR ! R ! VALEURS DE LA CL DE TYPE COEFF D'ECHANGE ! C ! VFLUVS ! TR ! R ! VALEURS DU FLUX VOLUMIQUE ! C ! VRESCS ! TR ! R ! VALEURS DE LA CL DE TYPE RESIST DE CONTACT ! C ! VRAYTS ! TR ! R ! VALEURS DE LA CL DE TYPE RAYONNEMENT ! C ! NREFAC ! TE ! R ! REFERENCES DES FACES (volumique) ! C ! NREFAL ! TE ! R ! REFERENCES DES FACES (num loc dans NODEUS) ! C ! NFCOUS ! TE ! R ! NUM DANS NODEUS DES FACES COUPLEES ! C ! NFFLUS ! TE ! R ! NUM DANS NODEUS DES FACES AVEC FLUX ! C ! NFECHS ! TE ! R ! NUM DANS NODEUS DES FACES AVEC COEFF D'ECH ! C ! NFRESC ! TE ! R ! NUM DANS NODEUS DES FACES AVEC RES DE CONT ! C ! NFRAYS ! TE ! R ! NUM DANS NODEUS DES FACES AVEC RAYONNEMENT ! C ! VFFLUS ! TR ! R ! VAL DU FLUX AUX NOEUDS DE LA FACETTE ! C ! VFECHS ! TR ! R ! VAL DE T ET COEF ECH AUX NOEUDS DE LA FACETTE! C ! VFRESC ! TR ! R ! VAL DE T ET RES CONT AUX NOEUDS DE LA FACETTE! C ! VFRAYS ! TR ! R ! VAL DU RAYONNEMENT AUX NOEUDS DE LA FACETTE ! C ! NREFS ! TR ! R ! REFERENCES DES NOEUDS SOLIDES ! C ! NREFE ! TR ! R ! REFERENCES DES ELEMENTS SOLIDES ! C ! COORDS ! TR ! R ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NODES ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SOLIDE ! C ! NODESS ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SURF SOLIDE ! C ! NODEUS ! TE ! R ! CONNECTIVITE NOEUDS AVEC CL TYPE FLUX (SOL) ! C ! NODERC ! TE ! R ! CONNECTIVITE NOEUDS AVEC CL TYPE RES CONTACT ! C ! NODERA ! TE ! R ! CONNECTIVITE NOEUDS AVEC CL TYPE RAYT ! C ! PHYSOL ! TR ! R ! PROPRIETES PHYSIQUES DU SOLIDE ! C ! TMPSA ! TR ! M ! TEMPERATURE DANS LE SOLIDE ETAPE n ! C ! TMPS ! TR ! M ! TEMPERATURE DANS LE SOLIDE ETAPE n+1 ! C ! TMPSC1 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 1 ! C ! TMPSC2 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 2 ! C ! TMPSC3 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 3 ! C ! VOLUME ! TR ! R ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! SURFUS ! TR ! R ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! NODRAY ! TE ! R ! MAILLAGE EXT RAYONNEMENT ! C ! COORAY ! TR ! R ! COORD MAILLAGE EXT RAYONNEMENT ! C ! FDFRAY ! TR ! R ! FACTEURS DE FORME RAYONNEMENT ! C ! TEMRAY ! TR ! R ! TEMPERATURE DE FACETTE ! C ! FIRAY ! TR ! R ! FLUX SUR LA FACETTE (impose ou calcule) ! C ! NCFIN ! TE ! R ! NUMERO DE L'ELEMENT GROSSIER CORRESPONDANT ! C ! NCGROS ! TE ! R ! NUMERO DE L'ELEMENT FIN CORRESPONDANT ! C ! BARYGR ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS GROS! C ! ITRAV ! TE ! A ! TABLEAUX DE TRAVAIL ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "mobil.h" #include "nlofes.h" #include "nlofct.h" #include "fichct.h" #include "syrth.h" #include "rayonn.h" #include "xrefer.h" #include "f2c_syrthes.h" C C ********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NBFACE,NFBIDA INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL INTEGER NPOINS,NELEMS,NDMATS INTEGER NELESS,NELEUS,NDMASS,NELERC,NELERA,NELEPR,NBRESS,NBPRIO INTEGER NBRAYS,NBRAIS,NBMOBS,NBCOPR INTEGER NBPHYS,NPPEL,NPOUE,NBICOR,NBFFLU,NBFECH,NBFRAI INTEGER NCOUPS(NBCOUS),NFLUSS(NBFLUS),NDIRS(NBDIRS) INTEGER NECHS(NBECHS),NFLUVS(NBFLVS),NRESCS(NBRESS,2) INTEGER NRAYTS(NBRAYS),NPRIOS(NBPRIO,1+NBCOPR) INTEGER NRAYIS(NBRAIS),NMOBIL(NBMOBS,2) INTEGER NREFS(NPOINS),NREFE(NELEMS),NODES(NELEMS,NDMATS) INTEGER NANGLE(NELEMS) INTEGER NODESS(NELESS,NDMASS), NODEUS(NELEUS,NDMASS) INTEGER NODEPR(NELEPR,NDMATS+1),NODERC(NELERC,NDMASS) INTEGER NREFAC(NELEMS,NBFACE),NREFAL(NELEUS) INTEGER NFCOUS(NELESS),NFFLUS(NBFFLU),NFECHS(NBFECH) INTEGER NFRESC(NELERC),NFRAYS(NELERA),NFRAIS(NBFRAI) INTEGER NELRAY,NPOINR,NNSRAY,NNFRAY,NNERAY INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE INTEGER NODRAY(NELRAY,NDIM) INTEGER NODERA(NELERA,NDMASS) INTEGER NCFIN(NBRAYS),NCGROS(NNSRAY,2),NRFRAY(NELRAY) INTEGER ITYFAR(NELRAY) INTEGER NCSRAY(NNSRAY),NCFRAY(NNFRAY),NESRAY(NNERAY) C DOUBLE PRECISION VFLUSS(NBFLUS),VDIRS(NBDIRS) DOUBLE PRECISION VECHS(NBECHS,2),VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VRESCS(NBRESS,2) DOUBLE PRECISION VRAYTS(NBRAYS,2),VRAYIS(NBRAIS,2) DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS) DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2),VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION BARYGR(NNSRAY,NDIM) DOUBLE PRECISION BARYFS(NBRAYS,NDIM) DOUBLE PRECISION COORAY(NPOINR,NDIM) DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS),TMPSC3(NPOINS) DOUBLE PRECISION TMPSA(NPOINS), TMPS(NPOINS) DOUBLE PRECISION TMPMAX(NPOINS),TMPMIN(NPOINS) DOUBLE PRECISION VOLUME(NELEMS),SURFUS(NELEUS) INTEGER IDTRAV,ITRAV(IDTRAV),ITRAV1(IDTRAV),ITRAV2(NPOINS) INTEGER ITRMED(NDMATS,NELEMS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS),TRAV3(NPOINS) DOUBLE PRECISION SUFRAY(NELRAY),TABRAY(NELRAY,9) DOUBLE PRECISION TOTRAI C INTEGER NGFFIR(NFFIRA),NGFTIR(NFTIRA) INTEGER NGFPER(NFPERA),NGFPEF(NFCFRA) INTEGER NGFMST(NFMST,2),NGFMSE(NFMSTE) DOUBLE PRECISION VFMSTE(NFMSTE,2),EMISSI(NELRAY,2,NBANDE) DOUBLE PRECISION PHFRAF(NFCFRA,4),PHFRAE(NFPERA,4) DOUBLE PRECISION PHMSTP(NFMST,4),PHMSTO(NFMST,5,NBANDE) DOUBLE PRECISION TEMRAY(NELRAY),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION TRAYEQ(NELRAY),ERAYEQ(NELRAY) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) DOUBLE PRECISION RADIOS(NELRAY,NBANDE) C C.. Variables internes INTEGER N,NB,NBSOM,NUMA,INDGLO,NUMBAN,NGFAC,NPERAY,I,NBSCAL LOGICAL LF,LDEVDI,LDEVFD PARAMETER(LDEVDI=.FALSE., LDEVFD=.FALSE.) INTEGER IREF(NRFMAX),NBRE,MODE DOUBLE PRECISION T1 C DOUBLE PRECISION TFAC1,TFAC2,TCORR1,TCORR2 C C C*********************************************************************** C C ----------------------- C Lecture maillage solide C ----------------------- C C Si le maillage element fini a ete genere par SIMAIL IF (TYPEF .EQ. 'SIM') THEN IF (LCFACE) THEN DO N=1,NELEMS*NBFACE NREFAC(N,1) = 0 ENDDO ENDIF CALL LECSI3(NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, & NODES,NREFS,NREFE,NREFAC,COORDS) C C Si le maillage element fini a ete genere par IDEAS ELSEIF (TYPEF .EQ. 'IDE')THEN IF (LCFACE) THEN DO N=1,NELEMS*NBFACE NREFAC(N,1) = 0 ENDDO ENDIF CALL LECID3(NDIM,NDIELE,NPOINS,NELEMS,NFBIDA,NDMATS, & NODES,NREFS,NREFE,COORDS,NBFACE,NREFAC) C C Si le maillage element fini est au format SYRTHES ELSEIF (TYPEF .EQ. 'SYR')THEN IF (LCFACE) THEN DO N=1,NELEMS*NBFACE NREFAC(N,1) = 0 ENDDO ENDIF CALL LECSY3(NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, & NODES,NREFS,NREFE,NREFAC,COORDS) C ELSE WRITE(NFECRA,2100) STOP C ENDIF C C Ecriture du maillage solide sur fichier resu C -------------------------------------------- C LF = LCFACE C IF (LGEOMS) & CALL ECRG1 & ( NFGGCT,LF,NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, & COORDS,NODES,NREFS,NREFE,NREFAC) C C C Ecriture de l'entete du fichier resu C ------------------------------------ NBSCAL=1 IF (LTMAX) NBSCAL = NBSCAL+2 IF (LDEVDI .AND. LRAY) NBSCAL = NBSCAL+1 IF (LDEVDI .AND. .NOT.LSYRTH) NBSCAL = NBSCAL+1 CALL ECRG2E(NBSCAL,NFGRCT,NDIM,NDIELE,NELEMS,NPOINS) C C IVECTO = 0 CHRIS#ifdef __uxpv__ c IF (.NOT. LSDEPL) THEN c CALL NVECTO (NDMATS,NELEMS,NODES,NREFAC,NBFACE,NREFE) c ENDIF CHRIS#endif C IF (LCFACE .AND. (TYPEF.NE.'SIM')) THEN CALL INREFA (NDIM,NDIELE,NELEMS,NDMATS,NBFACE, * NODES,NREFAC,NPOINS,NREFS) ELSE WRITE(NFECRA,2200) ENDIF C IF (LCFACE) CALL VERIFA (NDIELE,NELEMS,NBFACE,NREFAC) C IF (LSDEPL) CALL MOBMX2 (NDIM,NDIELE,NPOINS,NELEMS,NDMATS,NBFACE, * NODES,NREFS,NREFAC,COORDS) C C C IF (NCTHFS.EQ.3) THEN CALL XMAILL(NDIELE,NPOINS, * NELEMS,NELESS,NELEUS,NELERC,NELERA, * NDMATS,NDMASS,NBFACE, * NODES,NODESS,NODEUS,NODERC,NODERA, * NREFS,NREFAC,NREFAL) c IF (.NOT. LSDEPL) THEN c MODE=2 c NB=1 c CALL NVECTO (MODE,NDMASS,NELEUS,NODEUS,ITRAV1,NB, c * NREFAL,NPOINS,ITRAV) c ELSE LVECTB = .FALSE. c ENDIF ENDIF C C C C 2.4- Numerotation locale des noeuds ou faces en fonction de leur C condition a la limite, num des noeuds avec flux volumique C ----------------------------------------------------------------- C IF (.NOT. LCFACE) THEN CALL LIMNUM (NCOUPS,NBCOUS,NFLUSS,NBFLUS,NDIRS,NBDIRS, * NECHS,NBECHS,NRAYTS,NBRAYS, * NRAYIS,NBRAIS,NRESCS,NBRESS,NPRIOS,NBPRIO, * NMOBIL,NBMOBS,NBCOPR,NREFS,NPOINS) C DO 250 N=1,NPOINS NREFS(N) = ABS(NREFS(N)) 250 CONTINUE C ELSEIF (NCTHFS.EQ.3) THEN CALL LIMFNU * (NCOUPS,NBCOUS,NFCOUS,NELESS,NFFLUS,NBFFLU,NDIRS,NBDIRS, * NFECHS,NBFECH,NRESCS,NBRESS,NFRESC,NELERC, * NRAYTS,NBRAYS,NFRAYS,NELERA,NFRAIS,NBFRAI, * NPRIOS,NBPRIO,NMOBIL,NBMOBS,NBCOPR,NREFS, * NPOINS,NDIELE,NELEUS,NDMASS,NODEUS, * NREFAL,ITRAV,ITRAV1) C ELSE CALL LIMFCO * (NCOUPS,NBCOUS,NFCOUS,NFFLUS,NBFFLU,NDIRS,NBDIRS, * NFECHS,NBFECH,NFRAYS,NELERA, * NPRIOS,NBPRIO, * NMOBIL,NBMOBS,NBCOPR,NREFS,NPOINS,NDIELE, * NELEMS,NDMATS,NODES, * NBFACE,NREFAC) C ENDIF C IF (NBFLVS.GT.0) * CALL FLVNUM (NFLUVS,NBFLVS,NREFS,NPOINS,NREFE,NELEMS) C C C 2.5- Initialisation puis lecture des conditions aux limites C ------------------------------------------------------------ C ITRAV a la dimension : NPOINS CALL LECLIM * ( NDIM,NPOINS,NELEMS,NREFS,NREFE, * TMPSA,TMPS,TMPSC1,TMPSC2,TMPSC3, * COORDS,NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS, * NBECHS,NECHS,VECHS,NBFLVS,NPFEL,NFLUVS,VFLUVS, * NBRESS,NRESCS,VRESCS, * NBPRIO,NBCOPR,NPRIOS,NBMOBS,NMOBIL, * NPOUE,NPPEL,NBPHYS,PHYSOL, * NDMASS,NREFAL,NELEUS,NFFLUS,VFFLUS,NBFFLU, * NFECHS,VFECHS,NBFECH,NFRESC,VFRESC,NELERC,NELERA, * NBRAIS,NRAYIS,VRAYIS,NBFRAI,NFRAIS,VFRAIS, * ITRAV,ITRAV1,ITRAV2,TRAV1,TRAV2,TRAV3) C C C C 2.6- Solides en translation : deplacement des coordonnees C --------------------------------------------------------- IF (LSDEPL) THEN IF (.NOT. LSUISO) THEN C maillage 1 NUMA = 2 CALL MOBTRA (NUMA,NDIM,NPOINS,COORDS, * -TRXMOB,-TRYMOB,-TRZMOB) ELSE CALL MOBLG1 (NDIM,NPOINS,COORDS) ENDIF ENDIF C C C 2.7- Passage a la numerotation locale C ------------------------------------- C IF (NCTHFS.EQ.3) THEN CALL NDLOCS (NELESS,NDMASS,NBCOUS,NPOINS,NODESS,NCOUPS,ITRAV) ENDIF C IF (LRAY) THEN CALL NDLOCS (NELERA,NDMASS,NBRAYS,NPOINS,NODERA,NRAYTS,ITRAV) ENDIF C C 2.8- Extraction du maillage des elts periodiques C ------------------------------------------------ C IF (NELEPR.NE.0) * CALL XMPRIO (NPOINS,NELEMS,NELEPR,NDMATS, * NODES,NODEPR,NPRIOS,NBPRIO,NBCOPR,NREFS,ITRAV) C C C 2.9- Calcul du volume des elements C -------------------------------------------------- C CALL SVOLUM ( NDIM,NDIELE,NELEMS,NDMATS,NELEUS,NDMASS,NPOINS, * VOLUME,SURFUS,NODES,NODEUS,COORDS,NANGLE) C C 2.10- Correspondants pour les resistances de contact C ---------------------------------------------------- IF (NBRESS.GT.0) CALL CORESC (NDIM,NPOINS,NBRESS,NRESCS,COORDS) C C 2.11- Calcul distance min C ------------------------- CALL MOBDIS (NBMOBS,NDIM,NODERC,NELERC,NDMASS,NPOINS,COORDS) C C 2.12- Rayonnement C ----------------- IF (LRAY) THEN C CALL CPUSYR(T1) C C IF (TYPRA.EQ.'SIM') THEN CALL LRASI3(NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) ELSEIF (TYPRA.EQ.'IDE') THEN CALL LRAID3(NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) ELSEIF (TYPRA.EQ.'SYR') THEN CALL LRASY3(NDIM,NPOINR,NELRAY,NODRAY,NRFRAY,COORAY) ENDIF C C Ecriture de la geometrie resultat C --------------------------------- CALL ECRG1R & ( NFGGRA,NDIM,NDIM-1,NPOINR,NELRAY,NDIM, & COORAY,NODRAY,NRFRAY) C Ecriture de l'entete du fichier resultat C ---------------------------------------- NBSCAL=1+NBANDE IF (LDEVDI) NBSCAL=NBSCAL+1 CALL ECRG2E(NBSCAL,NFGRRA,NDIM,NDIM-1,NELRAY,NPOINR) C Decompte C -------- CALL LNRAY2 (NDIM,NELRAY,NODRAY,NRFRAY,NPOINR, * ITRAV,ITRAV1, * NNSRAY,NNFRAY,NNERAY,NCSRAY,NCFRAY,NESRAY) C CALL LFRAY2 (NELRAY,NRFRAY, * NFCFRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE, * NGFFIR,NGFTIR,NGFPER,NGFPEF,NGFMST,NGFMSE,ITYFAR) C C CALL LECLIR (NDIM,NELRAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE, * NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF,NGFMST,NGFMSE, * EMISSI,TEMRAY,PHFRAF,PHFRAE,FIRAY,VFIRAY,VFMSTE, * PHMSTP,PHMSTO) C C C CALL CPUSYR(TFAC1) IF (LECFDF) THEN READ(NFFFRA,*) NBRE READ(NFFFRA,*) SUFRAY READ(NFFFRA,*) NBRE READ(NFFFRA,*) FDFRAY ELSE C IF (LPERAY) THEN IF (NDIM.EQ.2) THEN NPERAY = INT(360./PERRAY(3)+0.1) ELSE NPERAY = INT(360./PERRAY(7)+0.1) ENDIF ELSE NPERAY = 0 ENDIF C IF (NDIM .EQ. 3) THEN CALL CFDF3D (NDIM,NELRAY,NPOINR,NODRAY,COORAY, * SUFRAY,FDFRAY,NPLASY,PLASYM, * NPERAY,PERRAY,NDECMX,NRFRAY, * PINTER,NUMGU,NGUMAX,NBLBLR) ELSEIF (IAXISY.EQ.0) THEN CALL CFDF2D (NDIM,NELRAY,NPOINR,NODRAY,COORAY, * SUFRAY,FDFRAY,NPLASY,PLASYM, * NPERAY,PERRAY,NDECMX,NRFRAY, * PINTER,NUMGU,NGUMAX,NBLBLR) ELSE CALL CFDF2A (NDIM,NELRAY,NPOINR,NODRAY,COORAY, * SUFRAY,FDFRAY,NPLASY,PLASYM, * IAXISY,NDECMX,NRFRAY, * PINTER,NUMGU,NGUMAX,NBLBLR) ENDIF C IF (LROUVR) CALL FDFFIN(NELRAY,SUFRAY,FDFRAY,TABRAY(1,9)) C IF(NBLBLR.GE.10) CALL CNTLFF(NELRAY,SUFRAY,FDFRAY,TABRAY(1,9)) C IF (.NOT.LROUVR .AND. .NOT.LDEVFD) * CALL SMOOGC (FDFRAY,SUFRAY,NELRAY, * TABRAY(1,1),TABRAY(1,2),TABRAY(1,3),TABRAY(1,4), * TABRAY(1,5),TABRAY(1,6),TABRAY(1,7)) IF(NBLBLR.GE.10) CALL CNTLFF(NELRAY,SUFRAY,FDFRAY,TABRAY(1,9)) C ENDIF C IF (LSTOKF) THEN WRITE(NFFFRA,*) NELRAY WRITE(NFFFRA,*) SUFRAY WRITE(NFFFRA,*) NELRAY*(NELRAY+1)/2 WRITE(NFFFRA,*) FDFRAY ENDIF C CALL CPUSYR(TFAC2) TFAC2=TFAC2-TFAC1 WRITE(NFECRA,5017) TFAC2 C C CALL CPUSYR(TCORR1) IF (LLCORA) THEN IF (NBRAYS.GT.0) THEN READ (NFCORA,*) NBRE READ (NFCORA,*) NCFIN READ (NFCORA,*) NBRE READ (NFCORA,*) BARYFS ENDIF IF (NNSRAY.GT.0) THEN READ (NFCORA,*) NBRE READ (NFCORA,*) NCGROS READ (NFCORA,*) NBRE READ (NFCORA,*) BARYGR ENDIF ELSE C C DO N=1,NRFMAX IREF(N) = IRERCS(N) ENDDO INDGLO = 1 IF (NDIM.EQ.3) THEN CALL CRROCT (NDIM,NDMASS,NPOINS,COORDS,NELERA,NODERA, * NBRAYS,NRAYTS,NCFIN,BARYFS, * NDIM, NPOINR,COORAY,NELRAY,NODRAY,NRFRAY, * NNSRAY,NCSRAY,NCGROS,BARYGR, * IREF,INDGLO,NBLBLR,TRAV1,TRAV2) ELSE CALL CORAY2 (NDIM,NDMASS,NPOINS,COORDS,NELERA,NODERA, * NBRAYS,NRAYTS,NCFIN,BARYFS, * NDIM, NPOINR,COORAY,NELRAY,NODRAY,NRFRAY, * NNSRAY,NCSRAY,NCGROS,BARYGR, * IREF,NRFMAX,INDGLO) ENDIF ENDIF C IF (LDEVDI) THEN CALL ECRG3E(NFGRCT) CALL ECRG2R(TRAV1,NPOINS,'DIST_AU_RAY ','3',NFGRCT) CALL ECRG3E(NFGRRA) CALL ECRG2R(TRAV2,NPOINR,'DIST_AU_SOL ','3',NFGRRA) ENDIF C IF (LSTORA) THEN IF (NBRAYS.GT.0) THEN WRITE (NFCORA,*) NBRAYS WRITE (NFCORA,*) NCFIN WRITE (NFCORA,*) NBRAYS*NDIM WRITE (NFCORA,*) BARYFS ENDIF IF (NNSRAY.GT.0) THEN WRITE (NFCORA,*) NNSRAY*2 WRITE (NFCORA,*) NCGROS WRITE (NFCORA,*) NNSRAY*NDIM WRITE (NFCORA,*) BARYGR ENDIF ENDIF C CALL CPUSYR(TCORR2) TCORR2=TCORR2-TCORR1 WRITE(NFECRA,5018) TCORR2 C C IF (NFMST.GT.0) CALL COUMST (NDIM,NELRAY,NPOINR,NODRAY, * COORAY,NFMST,NGFMST,NBLBLR) C CALL CPUSYR(TOTRAI) TOTRAI = TOTRAI - T1 C ENDIF C C C 3- SOUS-PROGRAMMES UTILISATEUR C ============================== C C 3.1- Initialisation de la temperature dans le solide C ---------------------------------------------------- C (Sous-programme utilisateur) C CALL INITMP (NDIM,NPOINS,NELEMS,NDMATS,NODES, * COORDS,NREFS,NREFE,TMPSA,TMPS) C C 3.3.2- Initialisation des conditions aux limites de type C rayonnement confine transparent C -------------------------------------- C (Sous-programme utilisateur) C IF (LRAY) THEN C CALL LIMRAY (NDIM,NELRAY,NPOINR, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA, * NODRAY,NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF, * COORAY,EMISSI,TEMRAY,FIRAY,PHFRAF,PHFRAE,VFIRAY) C C 3.3.3- Remplissage des conditions de type flux impose par bande C ------------------------------------------------------------- DO 333 NUMBAN=1,NBANDE DO 334 N=1,NFFIRA NGFAC = NGFFIR(N) VFIRAY(N,NUMBAN,2) = EMISSI(NGFAC,1,NUMBAN) 334 CONTINUE 333 CONTINUE C ENDIF C C 3.4- Initialisation des flux volumiques C ---------------------------------------- C (Sous-programme utilisateur) C Inutile, fait dans RESSOL C C 4- CAS DES SOLIDES EN TRANSLATION C ================================= C IF (LSDEPL) THEN C C IF (NCTHFS.EQ.3) * CALL MOBRES (NPOINS,NBRESS,NRESCS,VRESCS,NREFS, * NODERC,NFRESC,VFRESC,NELERC,NDMASS, * NREFAL,NELEUS,ITRAV) C NUMA = 2 CALL MOBTMP (NUMA,NDIM,NPOINS,TMPSA,TMPS) C ENDIF C C C 5- LECTURE DU FICHIER SUITE (si suite de calcul) C ================================================ C NTSYRD=0 IF (LSUISO) THEN CALL LECSOL(NDIM,NDIELE,NPOINS,NELEMS, * TMPSA,TMPS,TMPSC1,TMPSC2,TMPSC3,TMPMAX,TMPMIN) NTSYRD=NTSYR ENDIF C IF (LRAY.AND.NFMST.GT.0) THEN DO I=1,NBANDE DO N=1,NFMST EMISSI(NGFMST(N,1),1,I)=PHMSTO(N,1,I) ENDDO ENDDO CALL INIMST(NELRAY,EMISSI,TEMRAY,FDFRAY,TABRAY(1,8), * SUFRAY,RADIOS) ENDIF C C 6- ECRITURE DU FICHIER CHRONO C ============================= C IF (LSUISO .AND. (NCHROS.GE.1)) THEN NBSCAL=1 CALL ECRG2E(NBSCAL,NFGCCT,NDIM,NDIELE,NELEMS,NPOINS) CALL ECRG3E(NFGCCT) CALL ECRG2R(TMPS,NPOINS,'TEMP_SOLIDE ','3',NFGCCT) CALL FLUSHF(NFGCCT) ENDIF C C 7- INITIALISATIONS C ================== C C C 7.1- Initialisation des coefficients du modele coque C ---------------------------------------------------- IF (NCTHFS.EQ.2 .AND. .NOT. LSUISO) THEN DO 700 N=1,NPOINS TMPSC1(N) = (TMPSA(N) + TMPS(N) ) * 0.5D0 TMPSC2(N) = 0.D0 TMPSC3(N) = 0.D0 700 CONTINUE ENDIF C C 7.2- Initialisations C -------------------- IF (LRAY) THEN DO 720 N=1,NELRAY TRAYEQ(N) = TEMRAY(N) ERAYEQ(N) = 1. 720 CONTINUE C IF (LCFACE) THEN DO 721 N=1,NELERA*NDMASS*2 VFRAYS(N,1,1) = 0. 721 CONTINUE ELSE DO 722 N=1,NBRAYS*2 VRAYTS(N,1) = 0. 722 CONTINUE ENDIF ENDIF C C 8- INITIALISATION DU TEMPS C ========================== C C 8.1- INITIALISATION DU TEMPS REEL C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C IF (.NOT. LSUISO) THEN cc IF (LSYRTH) THEN TEMPSS = 0. NTSYR = 0 cc ELSE cc TEMPSS = RDTTS cc NTSYR = 0 cc ENDIF ENDIF C C C 8.2- INITIALISATION DU PAS DE TEMPS SOLIDE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C PREMPA = .TRUE. C C C 9- HISTORIQUES EN TEMPS C ======================= IF (LHISOL) THEN C IF (LSUISO) THEN THISSO = INT (TEMPSS / XFREQS) * XFREQS ELSE THISSO = 0. ENDIF ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(/,' --> ATTENTION : LE CALCUL SOLIDE EST FAIT', & ' EN AXISYMETRIQUE') C 2100 FORMAT(/,' %% ERREUR INISOL : TYPE DE MAILLAGE ELEMENTS', & ' FINIS INCONNU') 2200 FORMAT(/,' $$ REMARQUE : DANS LE CAS D''UN MAILLAGE DE TYPE ', & ' SIMAIL,',/, & ' LES REFERENCES DES FACES SONT ', & 'IMPOSEES AU NIVEAU DU MAILLEUR',/, & ' LE SOUS-PROGRAMME inrefa DE ', & 'MODIFICATION MANUELLE DES REFERENCES DES FACES',/, & ' N''EST PAS PRIS EN COMPTE') 3100 FORMAT (/,'LA DATE D''UTILISATION DE SYRTHES EST EXPIREE',/) 3200 FORMAT (/,'VERSION SYRTHES NON ACTIVABLE --> Contacter C.P.',/) 5017 FORMAT(' *** INITIALISATION : temps CPU necessaire au calcul', & ' des facteurs de forme : ',E15.5,' s') 5018 FORMAT(' *** INITIALISATION : temps CPU necessaire au calcul', & ' des correspondants rayonnement : ',E15.5,' s') 9000 FORMAT(/,' %% ERREUR INISOL : Erreur sur le nombre de noeuds', & ' avec historiques en temps',/, & ' On en trouve : ',I6,/, & ' Le tableau est dimensionne a : ',I6) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/psfnc2.F0000666000175000017500000002034611524070644015253 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=PSFNC2,SSI=0 SUBROUTINE PSFNC2 C ***************** C C ------------------------------------------------------- * (MODE, * NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, * NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, * NBICOR,BARYF,NCBORF,BARYS,NCBORS) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES DU FLUIDE VERS LE SOLIDE ET INVERSE * C en 2D ==> maillage surfacique de dimension 1 * C Les maillages ne sont pas coincidents * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! VCOUPS ! TR !D M ! VALEUR AUX NOEUDS SOLIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELEMENTS FLUIDES COUPLES ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS FLUIDES COUPLES! C ! NODESF ! TE ! D ! TABLE DES ELEMENTS FLUIDES COUPLES (NUM LOC) ! C ! NELESS ! E ! D ! NOMBRE D'ELEMENTS SOLIDES COUPLES ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS SOLIDES COUPLES! C ! NODESS ! TE ! D ! TABLE DES ELEMENTS SOLIDES COUPLES (NUM LOC) ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! BARYF ! TR ! D ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELTS SOLIDES ! C ! NCBORF ! TE ! D ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! D ! CCORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELTS FLUIDES ! C ! NCBORS ! TE ! D ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER MODE,NDIM,NBCOUF,NBCOUS,NELESF,NDMASF,NELESS,NDMASS INTEGER NBICOR DOUBLE PRECISION VCOUPF(NBCOUF,2),VCOUPS(NBCOUS,2) INTEGER NODESF(NELESF,NDMASF),NODESS(NELESS,NDMASS) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) C C..Variables internes INTEGER NF,NUMELF,NUMSEG,NS,NUMELS,N1,N2,N DOUBLE PRECISION XL1,XL2 C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE FLUIDE C =================================== C DO 100 NF=1,NBCOUF C NUMELS = NCBORF(NF,1) C NUMSEG = NCBORF(NF,2) C IF (NUMSEG.EQ.1) THEN N1 = NODESS(NUMELS,1) N2 = NODESS(NUMELS,3) ELSE N1 = NODESS(NUMELS,2) N2 = NODESS(NUMELS,3) ENDIF C XL1 = BARYF(NF,1) XL2 = BARYF(NF,2) C VCOUPF(NF,1) = VCOUPS(N1,1)*XL1 + VCOUPS(N2,1)*XL2 C 100 CONTINUE C C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14) THEN WRITE(NFECRA,1010) DO 110 N=1,NBCOUF WRITE(NFECRA,1020) N,VCOUPF(N,1) 110 CONTINUE ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU FLUIDE VERS LE SOLIDE C =================================== C DO 200 NS=1,NBCOUS C NUMELF = NCBORS(NS,1) C IF (NUMELF.NE.-1) THEN C NUMSEG = NCBORS(NS,2) C IF (NUMSEG.EQ.0) THEN N1 = NODESF(NUMELF,1) N2 = NODESF(NUMELF,2) ELSEIF (NUMSEG.EQ.1) THEN N1 = NODESF(NUMELF,1) N2 = NODESF(NUMELF,3) ELSE N1 = NODESF(NUMELF,2) N2 = NODESF(NUMELF,3) ENDIF C XL1 = BARYS(NS,1) XL2 = BARYS(NS,2) C VCOUPS(NS,1) = VCOUPF(N1,1)*XL1 + VCOUPF(N2,1)*XL2 VCOUPS(NS,2) = VCOUPF(N1,2)*XL1 + VCOUPF(N2,2)*XL2 C ENDIF C 200 CONTINUE C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14) THEN WRITE(NFECRA,2010) DO 210 N=1,NBCOUS IF (NCBORS(N,1).NE.-1) * WRITE(NFECRA,2020) N,VCOUPS(N,1),VCOUPS(N,2) 210 CONTINUE ENDIF C C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** PSFNC2 : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE',/, & 5X,' N fluide T ') 1020 FORMAT(5X,3X,I10,6X,G13.7) 2010 FORMAT(/,' *** PSFCN2 : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (vcoups)',/, & 5X,' N solide T h') 2020 FORMAT(5X,3X,I10,6X,G13.7,3X,G13.7) 3000 FORMAT(/,' %% ERREUR PASSF2 : OPTION DE PASSAGE INCORRECTE ') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/int2eg.F0000666000175000017500000001577711524070644015264 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=INT2EG,SSI=0 C SUBROUTINE INT2EG C ***************** C -------------------- *(A,B,C,ITYP,VALINT) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- Calcul de facteur de forme par integrale de contour * C Application a des triangles * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! XI ! TR ! D ! Coordonnees X des 6 points des 2 triangles ! C ! ! ! ! (dans l'ordre xa,xb,xc, xd,xe,xf) ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! M ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C C C********************************************************************** C C.. Variables externes DOUBLE PRECISION A,B,C,RES INTEGER ITYP C C.. Variables locales DOUBLE PRECISION VALINT DOUBLE PRECISION TERM1,TERM2,AL,B2,U,V,U2,V2 DOUBLE PRECISION DEL,AL1,AL2,C2 C C********************************************************************** C C ===================== IF (ITYP .EQ. 1) THEN C ===================== C Dans tout ce qui suit, on a soit A = D soit B=C C C C AL = SQRT(ABS(4.*A*C-B*B)) U = 2.*A/AL V = B/AL U2 = U*U V2 = V*V C C RES = 0.5*U2/((V2+1.)*(V2+1.)) * * ( (V2-1)*(ATAN(V)-ATAN((U*V-1.-V2)/U)) - * V*(LOG(U2)-LOG(V2-2.*U*V+1.+U2)) ) * + 0.5*( ATAN(U-V) + U/(V2+1.) ) C RES = RES*AL/A C RES = RES + 0.5*AL/A*ATAN(B/AL) C C C U = 0.5*B/A C2 = C*C B2 = B*B DEL = SQRT(ABS(4.*C*A-B2)) AL1 = ATAN((2.*C-B)/DEL) AL2 = ATAN(B/DEL) TERM1 = 0.5/C2 * ( * (AL1+AL2) * (U*(B*B*B-4.*A*B*C)+2.*C*(4.*A*C-B2))/DEL * + 0.5 *(B*(2.*C-B*U)+2.*U*A*C) * LOG(A) * + (C2*(-U+2.)-C*(B+U*A)+0.5*U*B2) * LOG(A-B+C) * + U*B*C+C2*(U-4.) ) C C C TERM2 = 0.25*B/A *(LOG(C)-1.) C VALINT = RES + TERM1 + TERM2 -2. C C C ========================= ELSEIF (ITYP .EQ. 2) THEN C ========================= C Dans tout ce qui suit, on a A = C C C C AL = SQRT(ABS(4.*A*C-B*B)) U = 2.*A/AL V = B/AL U2 = U*U V2 = V*V C C RES = 0.5*U2/((V2+1.)*(V2+1.)) * * ( (V2-1)*(-ATAN(V)+ATAN((U*V+1.+V2)/U)) * + V*(LOG(U2)-LOG(V2+2.*U*V+1.+U2)) ) * + 0.5*( ATAN(U+V) + U/(V2+1.) ) C RES = RES*AL/A C RES = RES - 0.5*AL/A*ATAN(B/AL) C C C U = 0.5*B/A C2 = C*C B2 = B*B DEL = SQRT(ABS(4.*C*A-B2)) AL1 = ATAN((2.*C+B)/DEL) AL2 = ATAN(B/DEL) TERM1 = 0.5/C2 * ( * (AL1-AL2) * (U*(B*B*B-4.*A*B*C)+2.*C*(4.*A*C-B2))/DEL * - 0.5 *(B*(2.*C-B*U)+2.*U*A*C) * LOG(A) * + (C2*(U+2.)+C*(B+U*A)-0.5*U*B2) * LOG(A+B+C) * + U*B*C-C2*(U+4.) ) C C C TERM2 = 0.25*B/A *(-LOG(C)+1.) C VALINT = RES + TERM1 + TERM2 -2. C C C C ========================= ELSEIF (ITYP .EQ. 3) THEN C ========================= C C C AL = SQRT(4.*A*C-B*B) U = 2.*A/AL V = -B/AL U2 = U*U V2 = V*V C C RES = 0.5*U2/((V2+1.)*(V2+1.)) * * ( (V2-1)*(ATAN(V)-ATAN((U*V-1.-V2)/U)) - * V*(LOG(U2)-LOG(V2-2.*U*V+1.+U2)) ) * + 0.5*( ATAN(U-V) + U/(V2+1.) ) C RES = RES*AL/A C RES = RES - 0.5*AL/A*ATAN(B/AL) C C C U = 0.5*B/A C2 = C*C B2 = B*B DEL = SQRT(ABS(4.*C*A-B2)) AL1 = ATAN((2.*C+B)/DEL) AL2 = ATAN(B/DEL) TERM1 = 0.5/C2 * ( * (AL1-AL2) * (U*(B*B*B-4.*A*B*C)+2.*C*(4.*A*C-B2))/DEL * - 0.5 *(B*(2.*C-B*U)+2.*U*A*C) * LOG(A) * + (C2*(U+2.)+C*(B+U*A)-0.5*U*B2) * LOG(A+B+C) * + U*B*C-C2*(U+4.) ) C C C TERM2 = 0.25*B/A *(1.-LOG(C)) C VALINT = RES + TERM1 + TERM2 -2. C ENDIF C C-------- C FORMATS C-------- C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/inisf2.F0000666000175000017500000003145611524070644015256 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INISF2 C ***************** C C ------------------------------------------------------------- *(NDIM,NDIELE,NBCOUF,NELESF,NDMASF, * NBRAF,NELRAF,NBICOR,NBMOBS, * NBCOUS,NPOINS,NELEMS,NDMATS,NELESS,NDMASS, * COORDF,NODESF,NCOUPF,COORAF,NRAPF, * NCOUPS,NREFS,COORDS,NODES,NODESS, * NODRAF,NCBORS,NCBORF,BARYS,BARYF, * NELRAY,NRFRAY,NPOINR,NODRAY,COORAY, * NNFRAY,NCFRAY,NCFINF,NCGROF,BARYFR, BARYFF , * ITRAV,IDTRAV, * TOTRAI,CALCIU,TRAV1,TRAV2) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C INITIALISATIONS POUR LA PRISE EN COMPTE DU COUPLAGE C THERMIQUE FLUIDE/SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NPOINF ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE FLUIDE ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF COUPLE FLUIDE ! C ! NBRAF ! E ! D ! NOMBRE DE NOEUDS FLUIDE NON COUPLE AVEC RAYT ! C ! NELRAF ! E ! D ! NBRE D'ELTS SURF FLUIDE NON COUPLE AVEC RAYT ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS FLUIDES SURF ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NELESS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NREFF ! TE ! R ! REFERENCES DES NOEUDS FLUIDES ! C ! COORDF ! TR ! R ! COORDONNEES DES NOEUDS DU MAILLAGE FLUIDE ! C ! NODESF ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SURF FLUIDE ! C ! NCOUPF ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS FLUIDES COUPLES ! C ! NCOUPS ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NFCOUS ! TE ! R ! NUM DANS NODEUS DES FACES COUPLEES ! C ! VFRAYS ! TR ! R ! VAL DU RAYONNEMENT AUX NOEUDS DE LA FACETTE ! C ! NREFS ! TR ! R ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! R ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NODES ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SOLIDE ! C ! NODESS ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SURF SOLIDE ! C ! NODRAF ! TE ! R ! CONNECTIVITE NOEUDS FLUIDE NON COUPLE + RAYT ! C ! NCBORS ! TE ! R ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C ! NCBORF ! TE ! R ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELEMENTS FLUIDES ! C ! BARYF ! TR ! R ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELEMENTS SOLIDES ! C ! COORAY ! TR ! R ! COORD MAILLAGE EXT RAYONNEMENT ! C ! ITRAV ! TE ! A ! TABLEAUX DE TRAVAIL ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "mobil.h" #include "nlofes.h" #include "nlofct.h" #include "fichct.h" #include "syrth.h" #include "rayonn.h" #include "xrefer.h" C C ********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NBCOUF,NELESF,NDMASF INTEGER NBRAF,NELRAF,NBCOUS,NBICOR,NBMOBS INTEGER NPOINS,NELEMS,NDMATS,NELESS,NDMASS INTEGER NCOUPF(NBCOUF,2),NRAPF(NBRAF,2) INTEGER NODESF(NELESF,NDMASF) INTEGER NCOUPS(NBCOUS) INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS) INTEGER NODESS(NELESS,NDMASS) INTEGER NCBORS(NBCOUS,NBICOR),NCBORF(NBCOUF,NBICOR) INTEGER NELRAY,NPOINR,NNFRAY,NODRAY(NELRAY,NDIM) INTEGER NODRAF(NELRAF,NDMASF) INTEGER NCFINF(NBRAF),NCGROF(NNFRAY,2) INTEGER NRFRAY(NELRAY),NCFRAY(NNFRAY) C DOUBLE PRECISION COORDF(NBCOUF,NDIM) DOUBLE PRECISION COORAF(NBRAF,NDIM) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) DOUBLE PRECISION BARYFF(NBRAF,NDIM),BARYFR(NNFRAY,NDIM) DOUBLE PRECISION COORAY(NPOINR,NDIM) INTEGER IDTRAV,ITRAV(IDTRAV),CALCIU DOUBLE PRECISION TOTRAI DOUBLE PRECISION TRAV1(NBCOUF),TRAV2(NPOINS) C C C.. Variables internes LOGICAL LDEVDI PARAMETER(LDEVDI=.FALSE.) INTEGER N,INDGLO,I,NBSCAL LOGICAL LF INTEGER NBRE,IREF(NRFMAX) DOUBLE PRECISION T1,T2 C C C 1- ECRITURES SUR FICHIERS C ========================= C ITRAV de dimension : NBCOUF C DO I=1,NBCOUF ITRAV(I)=0 ENDDO LF = .FALSE. IF (LGEOMF) THEN CALL ECRG1 & ( NFGFCT,LF,NDIM,NDIM-1,NBCOUF,NELESF,NDMASF,NDIELE+1, & COORDF,NODESF,ITRAV,ITRAV,ITRAV) C Mise a jour du nombre de noeuds sommets ENDIF C c???????????? pb car on ne connait pas les references C C Ecriture de l'entete du fichier resultat IF (LRESUF) THEN NBSCAL = 2 IF (LDEVDI) NBSCAL=NBSCAL+1 CALL ECRG2E(NBSCAL,NFRFCT,NDIM,NDIM-1,NELESF,NBCOUF) ENDIF C C 4- Recherche des correspondants (fluide/solide et inverse) C ========================================================= C DO 1 N=1,NBCOUS*NBICOR NCBORS(N,1) = 0 1 CONTINUE C DO 2 N=1,NBCOUF*NBICOR NCBORF(N,1) = 0 2 CONTINUE C CALL MOBDIF(NBMOBS,NDIM,NBCOUF,NELESF,NDMASF,NODESF,COORDF,CALCIU) C IF (LCOIN) THEN C IF (LECCOR) THEN READ (NFCOCT,*) NBRE READ (NFCOCT,*) NCBORF READ (NFCOCT,*) NBRE READ (NFCOCT,*) NCBORS ELSE CALL COCOIN (NDIM,NPOINS,NBCOUS,NBCOUF,NBICOR, * COORDS,COORDF,NCBORF,NCBORS,NCOUPS) ENDIF C IF (LSTOKC) THEN WRITE (NFCOCT,*) NBCOUF*NBICOR WRITE (NFCOCT,*) NCBORF WRITE (NFCOCT,*) NBCOUS*NBICOR WRITE (NFCOCT,*) NCBORS ENDIF ELSE C IF (LECCOR) THEN READ (NFCOCT,*) NBRE READ (NFCOCT,*) NCBORF READ (NFCOCT,*) NBRE READ (NFCOCT,*) NCBORS READ (NFCOCT,*) NBRE READ (NFCOCT,*) BARYF READ (NFCOCT,*) NBRE READ (NFCOCT,*) BARYS ELSE C IF (NCTHFS.EQ.2) THEN c CALL CORFS3 (NDIM,NPOINS,NELEMS,NDMATS,NELESF,NDMASF, c * NBCOUS,NBCOUF,COORDS,NODES,COORDF,NODESF, c * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NBICOR) PRINT*,'MODELE COQUE NON DISPONIBLE' STOP ELSEIF (NDIM .EQ. 2) THEN CALL CORFS2 (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NBICOR) ELSE CALL COROCT (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NBICOR, * NBLBLA,D2MAXF,DCORMX,TRAV1,TRAV2) IF (LDEVDI) THEN CALL ECRG2R(TRAV1,NBCOUF,'DIST_AU_SOL ','3',NFRFCT) CALL ECRG2R(TRAV2,NPOINS,'DIST_AU_FLUI','3',NFGRCT) ENDIF ENDIF C IF (LSTOKC) THEN WRITE (NFCOCT,*) NBCOUF*NBICOR WRITE (NFCOCT,*) NCBORF WRITE (NFCOCT,*) NBCOUS*NBICOR WRITE (NFCOCT,*) NCBORS WRITE (NFCOCT,*) NBCOUF*NDIM WRITE (NFCOCT,*) BARYF WRITE (NFCOCT,*) NBCOUS*NDIM WRITE (NFCOCT,*) BARYS ENDIF C ENDIF C ENDIF C C 5- Recherche des correspondants (fluide/rayt et inverse) C ========================================================= IF (LRAY .AND. NBRAF.GT.0 .AND. NNFRAY.GT.0) THEN CALL CPUSYR(T1) IF (LLCORA) THEN IF (NBRAF.GT.0) THEN READ (NFCORA,*) NBRE READ (NFCORA,*) NCFINF READ (NFCORA,*) NBRE READ (NFCORA,*) BARYFF ENDIF IF (NNFRAY.GT.0) THEN READ (NFCORA,*) NBRE READ (NFCORA,*) NCGROF READ (NFCORA,*) NBRE READ (NFCORA,*) BARYFR ENDIF ELSE DO 213 N=1,NRFMAX IREF(N) = IRERCF(N) + IRESTF(N) 213 CONTINUE INDGLO = 0 IF (NDIM.EQ.3) THEN CALL CRROCT (NDIM,NDMASF,NBRAF,COORAF,NELRAF,NODRAF, * NBRAF,NRAPF,NCFINF,BARYFF, * NDIM, NPOINR,COORAY,NELRAY,NODRAY,NRFRAY, * NNFRAY,NCFRAY,NCGROF,BARYFR, * IREF,NRFMAX,INDGLO,NBLBLR,TRAV1,TRAV2) ELSE CALL CORAY2 (NDIM,NDMASF,NBRAF,COORAF,NELRAF,NODRAF, * NBRAF,NRAPF,NCFINF,BARYFF, * NDIM, NPOINR,COORAY,NELRAY,NODRAY,NRFRAY, * NNFRAY,NCFRAY,NCGROF,BARYFR, * IREF,NRFMAX,INDGLO) ENDIF ENDIF C IF (LSTORA) THEN IF (NBRAF.GT.0) THEN WRITE (NFCORA,*) NBRAF WRITE (NFCORA,*) NCFINF WRITE (NFCORA,*) NBRAF*NDIM WRITE (NFCORA,*) BARYFF ENDIF IF (NNFRAY.GT.0) THEN WRITE (NFCORA,*) NNFRAY*2 WRITE (NFCORA,*) NCGROF WRITE (NFCORA,*) NNFRAY,NDIM WRITE (NFCORA,*) BARYFR ENDIF ENDIF C CALL CPUSYR(T2) TOTRAI=TOTRAI+T2-T1 ENDIF C C C C-------- C FORMATS C-------- C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/contou.F0000666000175000017500000003307411524070644015371 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CONTOU,SSI=0 C SUBROUTINE CONTOU C ***************** C ------------------ *(XI,YI,ZI,FFORME) C ------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- Calcul de facteur de forme (methode PENIGUEL/RUPP) * C Application a des triangles * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! XI ! TR ! D ! Coordonnees X des 6 points des 2 triangles ! C ! ! ! ! (dans l'ordre xa,xb,xc, xd,xe,xf) ! C ! YI ! TR ! D ! Coordonnees Y des 6 points des 2 triangles ! C ! ZI ! TR ! D ! Coordonnees Z des 6 points des 2 triangles ! C ! FFORME ! R ! R ! Facteur de forme resultat C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! M ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "optct.h" C C********************************************************************** C C.. Variables externes DOUBLE PRECISION XI(6),YI(6),ZI(6),FFORME C C.. Variables locales INTEGER N,M,N2,M1,M2,ITYP DOUBLE PRECISION XAB,YAB,ZAB,XCD,YCD,ZCD,XAC,YAC,ZAC,AB,CD DOUBLE PRECISION XAD,YAD,ZAD,XBC,YBC,ZBC,XBD,YBD,ZBD,AC,AD,BC,BD DOUBLE PRECISION A,B,C,PABAC DOUBLE PRECISION COST,VALINT,PI DOUBLE PRECISION EPS C C********************************************************************** C C 1- INITIALISATION C ================= FFORME = 0. PI = 3.141592653589793 EPS = 1.E-6 C C C 2- BOUCLE SUR LES SEGMENTS C ========================== C DO 100 N=1,3 DO 100 M=1,3 C C 1.1 Initialisations C ------------------- N2 = MOD(N,3) + 1 M2 = 3+MOD(M,3) + 1 M1 = M+3 C C 1.2- Normes et cos entre les segments C ------------------------------------- C XAB = XI(N2)-XI(N) YAB = YI(N2)-YI(N) ZAB = ZI(N2)-ZI(N) XCD = XI(M2) - XI(M1) YCD = YI(M2) - YI(M1) ZCD = ZI(M2) - ZI(M1) C AB = SQRT(XAB*XAB + YAB*YAB + ZAB*ZAB) CD = SQRT(XCD*XCD + YCD*YCD + ZCD*ZCD) C COST = (XAB*XCD + YAB*YCD + ZAB*ZCD) / (AB*CD) C C 1.3 Orthogonalite des vecteurs C ------------------------------ IF (ABS(COST).LE.EPS) THEN VALINT = 0. C ELSE XAD = XI(M2) - XI(N) YAD = YI(M2) - YI(N) ZAD = ZI(M2) - ZI(N) XBC = XI(M1)- XI(N2) YBC = YI(M1)- YI(N2) ZBC = ZI(M1)- ZI(N2) XAC = XI(M1)- XI(N) YAC = YI(M1)- YI(N) ZAC = ZI(M1)- ZI(N) XBD = XI(M2)- XI(N2) YBD = YI(M2)- YI(N2) ZBD = ZI(M2)- ZI(N2) C C AD = SQRT(XAD*XAD + YAD*YAD + ZAD*ZAD) BC = SQRT(XBC*XBC + YBC*YBC + ZBC*ZBC) AC = SQRT(XAC*XAC + YAC*YAC + ZAC*ZAC) BD = SQRT(XBD*XBD + YBD*YBD + ZBD*ZBD) C C C 1.4 Cas general C --------------- IF (AD.GT.EPS .AND. BC.GT.EPS .AND. * AC.GT.EPS .AND. BD.GT.EPS ) THEN PABAC = (XAB*XAC + YAB*YAC + ZAB*ZAC)/(AB*AC) chris modif par chris le 27 08 97 (en toute rigueur a verifier) chris IF (ABS(COST).LE.0.9999 .OR. ABS(PABAC).LE.0.9999) THEN chris2 IF (ABS(COST).LE.1-eps .OR. ABS(PABAC).LE.1.) THEN IF (ABS(COST).LE.1-eps .OR. ABS(PABAC).LT.1.-eps) THEN CALL INTSEG(XAB,YAB,ZAB,XAC,YAC,ZAC,XCD,YCD,ZCD,VALINT) ELSE A = AB B = CD C = AC chris reblinder en log le 22 janv 1999 chris le cas ne devrait pas chris arrive mais peut avoir pour origine chris une erreur de precision sur intersection de decoupage chris pas tres grande importance liee a la decroissance du log IF (COST .GT. EPS .AND. PABAC .GT. EPS ) THEN VALINT = -3. + * ( -(-A+B+C)**2 * LOG(abs(-A+B+C)) * +(C-A)**2 * LOG(abs(C-A)) * - C**2 * LOG(C) * +(C+B)**2 * LOG(C+B) )/ (A*B) ELSEIF ( COST .GT. EPS .AND. PABAC .LE. -EPS ) THEN VALINT = -3. + * (-(C-B+A)**2 * LOG(abs(C-B+A)) * +(C-B)**2 * LOG(abs(C-B)) * +(C+A)**2 * LOG(A+C) * - C**2 * LOG(C) )/ (A*B) ELSEIF ( COST .LE. -EPS .AND. PABAC .GE. EPS ) THEN VALINT = -3. + * ( (-A-B+C)**2 * LOG(abs(C-B-A)) * -(C-B)**2 * LOG(abs(C-B)) * -(C-A)**2 * LOG(abs(C-A)) * + C**2 * LOG(C) )/(A*B) ELSEIF ( COST .LE. -EPS .AND. PABAC .LE. -EPS ) THEN VALINT = -3. + * ( (A+B+C)**2 * LOG(A+B+C) * -(B+C)**2 * LOG(B+C) * -(C+A)**2 * LOG(C+A) * + C**2 * LOG(C) )/(A*B) ELSE WRITE(NFECRA,*) * ' Ce cas ne devrait jamais intervenir ' WRITE(NFECRA,*) * ' Voir les concepteurs de Syrthes CP-IR' ENDIF ENDIF C C 1.5 Cas singuliers C ------------------ ELSEIF (AD .LE. EPS) THEN IF (ABS(COST) .GE. 1.-EPS*0.001) THEN IF ( ABS (AB-CD) .LT. EPS ) THEN IF (COST.LT. 0.) THEN VALINT = 2.*LOG(AB) - 3. ELSE VALINT = 2.*LOG(AB) -3. +4*LOG(2*AB) ENDIF ELSE IF (COST .LT. 0.) THEN VALINT = - 3. + * ( AB*AB*LOG(AB) + CD*CD*LOG(CD) - * (AB-CD)*(AB-CD)*LOG(ABS(CD-AB)) ) * /(AB*CD) ELSE VALINT = - 3. + * ( - AB*AB*LOG(AB) - CD*CD*LOG(CD) + * (AB+CD)*(AB+CD)*LOG(AB+CD) ) * /(AB*CD) ENDIF ENDIF C ELSE ITYP = 1 A = AB*AB B = 2.*(XAB*XAC + YAB*YAC + ZAB*ZAC) C = AC*AC CALL INT2EG(A,B,C,ITYP,VALINT) ENDIF C ELSEIF (BC .LE. EPS) THEN IF (ABS(COST) .GE. 1.-EPS*0.001) THEN IF (ABS(AB-CD) .LE. EPS) THEN IF (COST.LT. 0.) THEN print*,' Ce cas aurait deja du etre traite' VALINT = 2.*LOG(AB) - 3. ELSE VALINT = -2.*LOG(AB) -3. +4*LOG(2*AB) ENDIF ELSE IF (COST.LT.0.) THEN VALINT = - 3. + * ( CD*CD*LOG(CD) + AB*AB*LOG(AB) - * (AB-CD)*(AB-CD)*LOG(ABS(AB-CD)) ) * /(AB*CD) ELSE VALINT = - 3. + * (-CD*CD*LOG(CD) - AB*AB*LOG(AB) + * (AB+CD)*(AB+CD)*LOG(AB+CD) ) * /(AB*CD) ENDIF ENDIF ELSE A = CD*CD B = -2.*(XAB*XCD + YAB*YCD + ZAB*ZCD) C = AB*AB ITYP = 1 CALL INT2EG(A,B,C,ITYP,VALINT) ENDIF C C ELSEIF (AC .LE. EPS) THEN IF (ABS(COST) .GE. 1.-EPS*0.001) THEN IF (ABS(AB-CD) .LE. EPS) THEN IF (COST.LT. 0.) THEN VALINT = -2.*LOG(AB) -3. + 4*LOG(2*AB) ELSE VALINT = 2.*LOG(AB) - 3. ENDIF ELSE IF (COST.GT.0.) THEN VALINT = -3. + * ( CD*CD*LOG(CD) + AB*AB*LOG(AB) - * (AB-CD)*(AB-CD)*LOG(ABS(CD-AB)) ) * / (AB*CD) ELSE VALINT = -3. + * (-AB*AB*LOG(AB) -CD*CD*LOG(CD) + * (AB+CD)*(AB+CD)*LOG(AB+CD) ) * / (AB*CD) ENDIF ENDIF C ELSE A = AB*AB B = -2.*(XAB*XAD + YAB*YAD + ZAB*ZAD) C = AD*AD ITYP = 2 CALL INT2EG(A,B,C,ITYP,VALINT) ENDIF C ELSEIF (BD .LE. EPS) THEN IF (ABS(COST) .GE. 1.-EPS*.001) THEN IF (ABS(AB-CD) .LE. EPS) THEN IF (COST.LT. 0.) THEN VALINT = -2.*LOG(AB) -3. + 4*LOG(2*AB) ELSE print*,' Ce cas est a priori deja traite' VALINT = 2.*LOG(AB) - 3. ENDIF ELSE IF (COST.GT.0.) THEN VALINT = - 3. + * ( AB*AB*LOG(AB) + CD*CD*LOG(CD) - * (AB-CD)*(AB-CD)*LOG(ABS(AB-CD)) ) * / (AB*CD) ELSE VALINT = - 3. + * ( -AB*AB*LOG(AB) - CD*CD*LOG(CD) + * (AB+CD)*(AB+CD)*LOG(AB+CD) ) * / (AB*CD) ENDIF ENDIF C ELSE ITYP = 3 A = AB*AB B = 2.*(XAB*XBC + YAB*YBC + ZAB*ZBC) C = BC*BC CALL INT2EG(A,B,C,ITYP,VALINT) ENDIF C C 1.6- Erreur C ----------- ELSE WRITE(NFECRA,1600) STOP ENDIF C C 1.7- Mise a jour de la valeur de l'integrale C --------------------------------------------- ENDIF FFORME = FFORME + 0.5 * COST * AB * CD * VALINT C 100 CONTINUE C C 3- VALEUR DU FACTEUR DE FORME * SURFACE C ======================================= C FFORME = FFORME / (2.*PI) C C 4- IMPRESSIONS DE CONTROLE C ========================== C C-------- C FORMATS C-------- 1600 FORMAT('%% ERREUR CONTOU : on n''est dans aucun cas prevu !') 4000 FORMAT('>>> CONTOU : Facteur de forme = ',E16.9) C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/box.c0000666000175000017500000002523611524070644014710 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | box_3d | | Optimisation de la boite englobante en 3d | |======================================================================| */ void box_3d(int npoin,double *cooray) { int n,vpd; double xm,ym,zm,xm2,ym2,zm2,xmym,xmzm,ymzm; double c11,c22,c33,c12,c13,c21,c23,c31,c32,a,b,c; double a11,a22,a33,a12,a13,a23; double b11,b22,b33,b12,b13,b21,b23,b31,b32; double x1,x2,x3,x,y,z; double ux,uy,uz,vx,vy,vz,wx,wy,wz,tx,ty,tz,det; double epsi,epsir,delta ; double p,q,racp,aux,phi,pi ; epsi = 1e-6 ; epsir = 1e-20 ; pi = 3.141592653589793; xm=ym=zm=0.; for (n=0;n1) aux=1; if (aux<-1) aux=-1; phi = acos(aux); x1 = -2*racp*cos(phi/3) -a/3 ; x2 = 2*racp*cos((pi-phi)/3.) -a/3 ; x3 = 2*racp*cos((pi+phi)/3.) -a/3.; printf(" Valeur propres de la transformation l1=%f l2=%f l3=%f \n",x1,x2,x3); } else { printf(" $$ box_3d : pas de valeurs propres reelles 1\n"); return; } /* recherche des valeurs propres multiples */ /* elle est triple => rien a faire */ if (abs(x1-x2)epsi || abs(ty-wy)>epsi || abs(tz-wz)>epsi) {wx =-wx; wy=-wy; wz=-wz;} for (n=0;nepsi) { ux = a12/a11; uy = 1.;} else { ux = 1; uy = 0.;} a11 = c11-x2; a12 = c12; a21 = c21 ; a22 = c22-x2; if (abs(a11)>epsi) { vx = a12/a11; vy = 1.;} else { vx = 1; vy = 0.;} an = sqrt( ux*ux + uy*uy); ux /= an; uy /= an; an = sqrt( vx*vx + vy*vy); vx /= an; vy /= an; z= ux*vy - uy*vx; if (z<0.) { x=ux; y=uy; ux=vx; uy=vy; vx=x; vy=y; } for (n=0;nepsi || abs(abs(zz)-abs(z))>epsi || abs(abs(yy)-abs(y))>epsi) { n+=1; xx=x; yy=y; zz=z; x=b11*xx+b12*yy+b13*zz; y=b21*xx+b22*yy+b23*zz; z=b31*xx+b32*yy+b33*zz; xn=sqrt(x*x+y*y+z*z); x/=xn; y/=xn; z/= xn; } printf(" >>> resoud3 : vecteur propre en %d iterations\n",n); *ux=x; *uy=y; *uz=z; } syrthes-3.4.3-dfsg1/src/s/evafac.F0000666000175000017500000001445211524070644015306 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=EVAFAC,SSI=0 C SUBROUTINE EVAFAC C ***************** C C ------------------------------------------------------- * (NN,NDIELE,NELE,NREFAC,LFFLU,LFCOU,LFRES,LFRAY,NBFACE) C ------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C EVALUATION DES TYPES DE FACETTES D'UN ELEMENT EN 2D ET 3D * C On utilise ici les references des facettes * C Les facttes peuvent etre : * C - couplees * C - avec condition de flux * C - avec condition d'echange mais portant des Dirichlet * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NN ! E ! D ! NUMERO DE L'ELEMENT COURANT ! C ! NELE ! E ! D ! NOMBRE D'ELEMENTS DU MAILLAGE ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS ! C ! NREFAC ! E ! M ! REFERENCES DES FACES (ARETES EN 2D) ! C ! LFFLUi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS AVEC CONDITION DE FLUX ! C ! LFCOUi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS COUPLES ! C ! LFRESi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS AVEC RESIST DE CONTACT ! C ! LFRAYi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS AVEC RAYONNEMENT ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELEMENTS ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : XMAILL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" C C********************************************************************** C INTEGER NDX PARAMETER (NDX= 10) C C.. Variables externes INTEGER NN,NDIELE,NELE,NBFACE,NREFAC(NELE,NDIELE+1) LOGICAL LFFLU(NBFACE),LFCOU(NBFACE),LFRES(NBFACE),LFRAY(NBFACE) C.. Variables internes INTEGER NR(NDX),M,L,N C C********************************************************************** C C 0. INITIALISATIONS C ================== C DO N=1,NBFACE LFFLU(N) = .FALSE. LFCOU(N) = .FALSE. LFRES(N) = .FALSE. LFRAY(N) = .FALSE. NR(N) = NREFAC(NN,N) ENDDO C C 1. BOUCLE SUR LES FACES C ======================= C DO L=1,NBFACE DO M=1,NRFMAX C IF ( IREFSC(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFSF(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFSE(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRE(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRI(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRA(M).NE.0 .AND. ABS(NR(L)).EQ.M ) & LFFLU(L) = .TRUE. C IF ( IREFSC(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LFCOU(L) = .TRUE. C IF ( IREFRE(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LFRES(L) = .TRUE. C IF ( IREFRA(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LFRAY(L) = .TRUE. C ENDDO ENDDO C C C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/inrefa.F0000666000175000017500000001603111524070644015320 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=INREFA,SSI=0 SUBROUTINE INREFA C ***************** C C ----------------------------------- * (NDIM,NDIELE,NELEMS,NDMATS,NBFACE, * NODES,NREFAC,NPOINS,NREFS) C ----------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES REFERENCES DES FACES DANS LE CAS * C OU LE MAILLEUR UTILISE NE LES FOURNIT PAS * C Elles sont necessaires lorsque l'on veut imposer les * C conditions aux limites sur les faces. * C * C Sous programme utilisateur * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEMES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS(2=triangles,3=tetraed)! C ! NREFAC ! TE ! R ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS PAR ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE) INTEGER NPOINS,NREFS(NPOINS) C C.. Variables internes INTEGER I,J INTEGER N1,N2,N3,N4,N5,N6,NR1,NR2,NR3,NR4,NR5,NR6 C C NARE(noeud,arete), NFAC(noeud,face) INTEGER NARE(3,3),NFAC(6,4) C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,2,3,5,6,7, 1,2,4,5,9,8, 1,3,4,7,10,8, 2,3,4,6,10,9/ C C 1- INITIALISATIONS C ------------------ C C C 2- CAS D'UN MAILLAGE EN TRIANGLES C ================================= C IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C C Numeros des 3 noeuds de l'arete : 1----3----2 CUTI N1 = NODES(I,NARE(1,J)) CUTI N2 = NODES(I,NARE(2,J)) CUTI N3 = NODES(I,NARE(3,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C C C 3- CAS D'UN MAILLAGE EN TETRAEDRES C ================================== C ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C 3 C / \ C Numeros des 6 noeuds de la face : 6 5 C / \ C 1-----4-----2 CUTI N1 = NODES(I,NFAC(1,J)) CUTI N2 = NODES(I,NFAC(2,J)) CUTI N3 = NODES(I,NFAC(3,J)) CUTI N4 = NODES(I,NFAC(4,J)) CUTI N5 = NODES(I,NFAC(5,J)) CUTI N6 = NODES(I,NFAC(6,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) CUTI NR4 = NREFS(N4) CUTI NR5 = NREFS(N5) CUTI NR6 = NREFS(N6) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C ELSE C C 5- CAS D'ERREUR C =============== WRITE(NFECRA,5000) STOP C ENDIF C C-------- C FORMATS C-------- 5000 FORMAT(//,' %% ERREUR INREFA : ON N''EST DANS AUCUNE DES ', & 'CONFIGURATIONS PREVUES') C END syrthes-3.4.3-dfsg1/src/s/evatyp.F0000666000175000017500000003374711524070644015401 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=EVATYP,SSI=0 C SUBROUTINE EVATYP C ***************** C C --------------------------------------------------------- * (NN,NDIELE,NODE,NELE,NDMAT,NREF,NDREF, * LFFLU,LFCOU,LFRES,LFRAY,NBFACE,LPDIR) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C EVALUATION DES TYPES DE FACETTES D'UN ELEMENT EN 2D ET 3D * C On regarde si les facettes sont : * C - couplees * C - couplee mais portant des Dirichlet * C - avec condition de flux * C - avec condition de flux mais portant des Dirichlet * C - avec condition d'echange mais portant des Dirichlet * C * C En 2D des facettes du type : * C * C D ------- F -------- F ou D ------- D -------- F * C * C * C * C En 3D des facettes du type : * C * C D --- F --- F D --- D --- D F --- F --- F * C \ / \ / \ / * C \ / \ / \ / * C F F D D D D * C \ / \ / \ / * C \ / \ / \ / * C F F D * C * C donc en realite des que la facette possede au moins * C un noeud de type flux, il est necessaire de la prendre * C en compte dans le maillage des faces de flux * C en imposant Flux=0 au(x) noeud(s) Dirichlet * C Un tel noeud Dirichlet doit par consequent egalement * C appartenir a la liste des noeuds avec flux ! * C Cette meme remarque est vraie pour des facettes possedant * C noeuds couples et Dirichlet et coefficient d'echange et * C Dirichlet * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NN ! E ! D ! NUMERO DE L'ELEMENT COURANT ! C ! NODE ! E ! D ! CONNECTIVITE DU MAILLAGE ! C ! NELE ! E ! D ! NOMBRE D'ELEMENTS DU MAILLAGE ! C ! NDMAT ! E ! D ! NOMBRE DE NOEUDS DES ELEMENTS ! C ! NREF ! E ! M ! REFERENCES DES NOEUDS DU MAILLAGE ! C ! NDIREF ! E ! D ! DIMENSION DU TABLEAU DES REFERENCES ! C ! LFFLUi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS AVEC CONDITION DE FLUX ! C ! LFCOUi ! L ! R ! INDIQUE SI LA FACE i APPARTIENT AU MAILLAGE ! C ! ! ! ! DES NOEUDS COUPLES ! C ! LPDIR ! TL ! R ! INDIQUE SI LE POINT i PORTE UN DIRICHLET EN ! C ! ! ! ! EN APPARTENANT A UNE FACE DE TYPE FLUX ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "optct.h" C C********************************************************************** C INTEGER NDX PARAMETER (NDX= 10) C C.. Variables externes INTEGER NN,NDIELE,NDREF,NELE,NDMAT,NODE(NELE,NDMAT),NREF(NDREF) INTEGER NBFACE LOGICAL LFFLU(NBFACE),LFCOU(NBFACE),LFRES(NBFACE),LFRAY(NBFACE) LOGICAL LPDIR(NDMAT) C.. Variables internes LOGICAL LFLU(NDX),LCOU(NDX),LDIR(NDX),LRES(NDX),LRAYT(NDX) INTEGER N(NDX),NR(NDX),M,L,N1,N2,N3,N4,N5,N6,NS,NF C C********************************************************************** C FONCTIONS IMPLICITES C********************************************************************** C C C********************************************************************** C C 0. INITIALISATIONS C ================== C DO 10 M=1,NDMAT N(M) = NODE(NN,M) 10 CONTINUE C DO 20 M=1,NDMAT NR(M) = NREF(N(M)) 20 CONTINUE C DO 30 M=1,NDMAT LFLU(M) = .FALSE. 30 CONTINUE C DO 40 M=1,NDMAT LCOU(M) = .FALSE. 40 CONTINUE C DO 50 M=1,NBFACE LFFLU(M) = .FALSE. 50 CONTINUE C DO 60 M=1,NBFACE LFCOU(M) = .FALSE. 60 CONTINUE C DO 70 M=1,NDMAT LDIR(M) = .FALSE. 70 CONTINUE C DO 80 M=1,NDMAT LRES(M) = .FALSE. 80 CONTINUE C DO 90 M=1,NBFACE LFRES(M) = .FALSE. 90 CONTINUE C DO 94 M=1,NDMAT LRAYT(M) = .FALSE. 94 CONTINUE C DO 95 M=1,NBFACE LFRAY(M) = .FALSE. 95 CONTINUE C DO 99 M=1,NDMAT LPDIR(M) = .FALSE. 99 CONTINUE C C C 1. REPERAGE DU TYPE DES NOEUDS C ============================== C DO 110 M=1,NRFMAX C DO 111 L=1,NDMAT C IF ( IREFSC(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFSF(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFSE(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRE(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRA(M).NE.0 .AND. ABS(NR(L)).EQ.M .OR. & IREFRI(M).NE.0 .AND. ABS(NR(L)).EQ.M ) & LFLU(L) = .TRUE. C IF ( IREFSC(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LCOU(L) = .TRUE. C IF ( IREFSD(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LDIR(L) = .TRUE. C IF ( IREFRE(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LRES(L) = .TRUE. C IF ( IREFRA(M).NE.0 .AND. ABS(NR(L)).EQ.M ) LRAYT(L) = .TRUE. C 111 CONTINUE C 110 CONTINUE C C C 2- CAS DE LA DIMENSION 2 C ======================== C IF (NCTHFS.NE.2 .AND. NDIELE.EQ.2) THEN C DO 200 NS = 1,NBFACE C N1 = NS N2 = NS+3 N3 = NS+1 IF (N3.EQ.4) N3=1 C IF (LCOU(N1) .AND. LCOU(N2) .AND. LCOU(N3)) LFCOU(NS) = .TRUE. C IF (LRAYT(N1) .AND. LRAYT(N2) .AND. LRAYT(N3)) * LFRAY(NS) = .TRUE. C IF (LRES(N1) .AND. LRES(N2) .AND. LRES(N3)) LFRES(NS) = .TRUE. C IF (LFLU(N1) .OR. LFLU(N3)) THEN IF (LFLU(N2) .OR. LDIR(N2)) LFFLU(NS) = .TRUE. ENDIF C IF (LFFLU(NS)) THEN IF (LDIR(N1) .AND. NR(N1).GT.0) LPDIR(N1) = .TRUE. IF (LDIR(N2) .AND. NR(N2).GT.0) LPDIR(N2) = .TRUE. IF (LDIR(N3) .AND. NR(N3).GT.0) LPDIR(N3) = .TRUE. C IF (LDIR(N1) .AND. NREF(N(N1)).GT.0) NREF(N(N1))= - NR(N1) IF (LDIR(N2) .AND. NREF(N(N2)).GT.0) NREF(N(N2))= - NR(N2) IF (LDIR(N3) .AND. NREF(N(N3)).GT.0) NREF(N(N3))= - NR(N3) ENDIF C 200 CONTINUE C C C 3. CAS DE LA DIMENSION 3 C ======================== C ELSEIF (NDIELE.EQ.3) THEN C C DO 300 NF = 1,NBFACE C IF (NF.EQ.1) THEN N1 = 1 N2 = 5 N3 = 2 N4 = 6 N5 = 3 N6 = 7 ELSEIF (NF.EQ.2) THEN N1 = 1 N2 = 5 N3 = 2 N4 = 9 N5 = 4 N6 = 8 ELSEIF (NF.EQ.3) THEN N1 = 1 N2 = 7 N3 = 3 N4 = 10 N5 = 4 N6 = 8 ELSE N1 = 2 N2 = 6 N3 = 3 N4 = 10 N5 = 4 N6 = 9 ENDIF C IF (LCOU(N1) .AND. LCOU(N2) .AND. LCOU(N3) .AND. & LCOU(N4) .AND. LCOU(N5) .AND. LCOU(N6)) LFCOU(NF) = .TRUE. C IF (LRAYT(N1) .AND. LRAYT(N2) .AND. LRAYT(N3) .AND. & LRAYT(N4) .AND. LRAYT(N5) .AND. LRAYT(N6)) & LFRAY(NF) = .TRUE. C IF (LRES(N1) .AND. LRES(N2) .AND. LRES(N3) .AND. & LRES(N4) .AND. LRES(N5) .AND. LRES(N6)) LFRES(NF) = .TRUE. C IF (LFLU(N1) .OR. LFLU(N2) .OR. LFLU(N3) .OR. & LFLU(N4) .OR. LFLU(N5) .OR. LFLU(N6)) THEN IF ( (LFLU(N2).OR.LDIR(N2)) .AND. & (LFLU(N4).OR.LDIR(N4)) .AND. & (LFLU(N6).OR.LDIR(N6)) ) LFFLU(NF) = .TRUE. ENDIF C IF (LFFLU(NF)) THEN IF (LDIR(N1) .AND. NR(N1).GT.0) LPDIR(N1) = .TRUE. IF (LDIR(N2) .AND. NR(N2).GT.0) LPDIR(N2) = .TRUE. IF (LDIR(N3) .AND. NR(N3).GT.0) LPDIR(N3) = .TRUE. IF (LDIR(N4) .AND. NR(N4).GT.0) LPDIR(N4) = .TRUE. IF (LDIR(N5) .AND. NR(N5).GT.0) LPDIR(N5) = .TRUE. IF (LDIR(N6) .AND. NR(N6).GT.0) LPDIR(N6) = .TRUE. C C Marquage des Dirichlet IF (LDIR(N1) .AND. NREF(N(N1)).GT.0) NREF(N(N1))= - NR(N1) IF (LDIR(N2) .AND. NREF(N(N2)).GT.0) NREF(N(N2))= - NR(N2) IF (LDIR(N3) .AND. NREF(N(N3)).GT.0) NREF(N(N3))= - NR(N3) IF (LDIR(N4) .AND. NREF(N(N4)).GT.0) NREF(N(N4))= - NR(N4) IF (LDIR(N5) .AND. NREF(N(N5)).GT.0) NREF(N(N5))= - NR(N5) IF (LDIR(N6) .AND. NREF(N(N6)).GT.0) NREF(N(N6))= - NR(N6) ENDIF C 300 CONTINUE C C C C 4- CAS DU MODELE COQUE C ====================== C ELSE C NF = 1 C N1 = 1 N2 = 2 N3 = 3 N4 = 4 N5 = 5 N6 = 6 C IF (LCOU(N1) .AND. LCOU(N2) .AND. LCOU(N3) .AND. & LCOU(N4) .AND. LCOU(N5) .AND. LCOU(N6)) LFCOU(NF) = .TRUE. C IF (LRES(N1) .AND. LRES(N2) .AND. LRES(N3) .AND. & LRES(N4) .AND. LRES(N5) .AND. LRES(N6)) LFRES(NF) = .TRUE. C IF (LFLU(N1) .OR. LFLU(N2) .OR. LFLU(N3) .OR. & LFLU(N4) .OR. LFLU(N5) .OR. LFLU(N6)) THEN IF ( (LFLU(N2).OR.LDIR(N2)) .AND. & (LFLU(N4).OR.LDIR(N4)) .AND. & (LFLU(N6).OR.LDIR(N6)) ) LFFLU(NF) = .TRUE. ENDIF C IF (LFFLU(NF)) THEN IF (LDIR(N1) .AND. NR(N1).GT.0) LPDIR(N1) = .TRUE. IF (LDIR(N2) .AND. NR(N2).GT.0) LPDIR(N2) = .TRUE. IF (LDIR(N3) .AND. NR(N3).GT.0) LPDIR(N3) = .TRUE. IF (LDIR(N4) .AND. NR(N4).GT.0) LPDIR(N4) = .TRUE. IF (LDIR(N5) .AND. NR(N5).GT.0) LPDIR(N5) = .TRUE. IF (LDIR(N6) .AND. NR(N6).GT.0) LPDIR(N6) = .TRUE. C IF (LDIR(N1) .AND. NREF(N(N1)).GT.0) NREF(N(N1))= - NR(N1) IF (LDIR(N2) .AND. NREF(N(N2)).GT.0) NREF(N(N2))= - NR(N2) IF (LDIR(N3) .AND. NREF(N(N3)).GT.0) NREF(N(N3))= - NR(N3) IF (LDIR(N4) .AND. NREF(N(N4)).GT.0) NREF(N(N4))= - NR(N4) IF (LDIR(N5) .AND. NREF(N(N5)).GT.0) NREF(N(N5))= - NR(N5) IF (LDIR(N6) .AND. NREF(N(N6)).GT.0) NREF(N(N6))= - NR(N6) ENDIF C C ENDIF C ===== C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ivoitj_3d.c0000666000175000017500000002401611524070644016005 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "tree.h" # include "abs.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | ivoitj_3d | | Detecter si deux point se voient | |======================================================================| */ void ivoitj_3d(struct node *arbre, struct node *noeud, struct node *noeud_arr, double ro[],double rd[],double pt_arr[],int *intersect, double size_min, int nelray, int npoinr, int *nodray, double * cooray, int *arrivee, double dim_boite[]) { struct element *fa1; int numel; struct node *n_en_cours; /* int n_en_cours;*/ double xv,yv,zv,epsi; fa1 = noeud->lelement; n_en_cours = noeud; /* n_en_cours = noeud->name;*/ epsi=1.E-6; /* printf(">>> ivoitj_3d : on est dans la boite %d\n", noeud->name); printf(">>> ivoitj_3d : xmin,xmax,ymin,ymax,zmin,zmax %f %f %f %f %f %f \n", noeud->xc-noeud->size,noeud->xc+noeud->size, noeud->yc-noeud->size,noeud->yc+noeud->size, noeud->zc-noeud->size,noeud->zc+noeud->size ); */ /* printf(" on est dans la boite %d \n", noeud->name); */ if (abs(rd[0])num; /* printf(" on teste la facette %d\n",numel); */ /* printf(" ro, rd %f %f %f %f %f %f \n", ro[0],ro[1],ro[2],rd[0]*1.e6,rd[1]*1.e6,rd[2]*1.e6); */ *intersect = ray_inter_triangle(arbre,n_en_cours,numel,ro,rd, npoinr,nelray,nodray,cooray,arrivee); if (*intersect==0) { fa1 = fa1->suivant; continue; } else { /* printf(" >>> ivoitj_3d : intersection avec l'element %d \n",*intersect); */ break; } } /* fin du while */ /* printf(" >> ivoitj_3d : test d'intersection : *intersect %d *arrivee %d\n", *intersect,*arrivee);*/ /* if (!( *intersect || *arrivee ||(noeud->name==noeud_arr->name) )) */ if (!( *intersect || *arrivee ||(noeud==noeud_arr) )) { voxel_voisin_3d(&xv,&yv,&zv,noeud->xc,noeud->yc,noeud->zc, noeud->sizx,noeud->sizy,noeud->sizz, ro,rd,pt_arr,size_min); if (abs(rd[0])> ivoitj_3d : on sort par rd nul\n"); */ } else { noeud = arbre; find_node_3d(&noeud,xv,yv,zv); if (in_boite(xv,yv,zv,dim_boite[0],dim_boite[1], dim_boite[2],dim_boite[3], dim_boite[4],dim_boite[5])) ivoitj_3d(arbre,noeud,noeud_arr,ro,rd,pt_arr,intersect,size_min, nelray,npoinr,nodray,cooray,arrivee,dim_boite); else { *intersect=0; /* printf(" >> ivoitj_3d : on est sorti de la boite\n"); */ } } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | ray_inter_triangle | | detection de l'intersection entre un rayon et un triangle | |======================================================================| */ int ray_inter_triangle(struct node *arbre,struct node *n_en_cours, int numel,double ro[],double rd[], int npoinr,int nelray,int *nodray,double *cooray, int *arrivee) { int nelray2,npoinr2,na,nb,nc,i,j,k; double xa,ya,za,xb,yb,zb,xc,yc,zc,xab,yab,zab,xac,yac,zac; double a,b,c,d,t,den,epsi,xp,yp,zp,xn,den1; struct node *noeud; epsi=1.E-4; npoinr2 = npoinr*2; nelray2 = nelray*2; na = *(nodray+numel-1); nb = *(nodray+numel-1+nelray); nc = *(nodray+numel-1+nelray2); xa= *(cooray+na-1); ya= *(cooray+na-1+npoinr); za= *(cooray+na-1+npoinr2); xb= *(cooray+nb-1); yb= *(cooray+nb-1+npoinr); zb= *(cooray+nb-1+npoinr2); xc= *(cooray+nc-1); yc= *(cooray+nc-1+npoinr); zc= *(cooray+nc-1+npoinr2); /* equation du plan du triangle */ xab = xb-xa; yab = yb-ya; zab = zb-za; xac = xc-xa; yac = yc-ya; zac = zc-za; a = yab*zac-zab*yac; b = zab*xac-xab*zac; c = xab*yac-yab*xac; xn=sqrt(a*a+b*b+c*c); a /=xn; b /=xn; c /=xn; d = -(a*xa+b*ya+c*za); den = a*rd[0]+b*rd[1]+c*rd[2]; den1=den/(sqrt(rd[0]*rd[0]+rd[1]*rd[1]+rd[2]*rd[2])); /* printf( " den %f \n",den);*/ if (abs(den1)> ray_inter_tria t = %f \n", t); */ if (t le plan du triangle est derriere => pas d'intersection */ return(0); else if (t>(1+epsi)) /* ==> le plan du triangle est trop loin => pas d'intersection */ return(0); xp = ro[0]+t*rd[0]; yp = ro[1]+t*rd[1]; zp = ro[2]+t*rd[2]; /* intersection */ if (in_triangle(a,b,c,d,xa,ya,za,xab,yab,zab,xac,yac,zac,xp,yp,zp)) { if (abs(t-1.)name); */ for (i=-1;i<2;i=i+2) for (j=-1;j<2;j=j+2) for (k=-1;k<2;k=k+2) { noeud = arbre; find_node_3d(&noeud,xp+epsi*i,yp+epsi*j,zp+epsi*k); /* printf("i,j,k,noeud->name n_en_cours %d %d %d %d %d xp yp zp %f %f %f \n", i,j,k,noeud->name,n_en_cours,xp,yp,zp); */ if (noeud == n_en_cours) {*arrivee = 1;} } return(0); } else return(numel); } else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | voxel_voisin_3d | | Recherche du voxel voisin | |======================================================================| */ void voxel_voisin_3d (double *xv,double *yv, double *zv, double xc, double yc, double zc, double dx,double dy,double dz, double ro[], double rd[], double pt_arr[], double size_min) { int it; double t,tt[3],orient[3],xpi,ypi,zpi,ddx,ddy,ddz,size,epsv,xn; size = size_min/4.; epsv=1.E-10; if (abs(rd[0])tt[0]) {tt[0]=t; orient[0] = -1.;} /* plan x=xc-dx */ } if (abs(rd[1])tt[1]) {tt[1]=t; orient[1] = -1.;} /* plan y=yc-dy */ } if (abs(rd[2])tt[2]) {tt[2]=t; orient[2] = -1.;} /* plan z=zc-dz */ } it = 0; t=tt[0]; if (tt[1]>> ivoitj_3d : intersection avec boite %f %f %f \n",xpi,ypi,zpi); */ } syrthes-3.4.3-dfsg1/src/s/diffc3.F0000666000175000017500000007461611524070644015227 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE DIFFC3 C ***************** C C --------------------------------------------------- *( TMPS,TMPSA,TMPSC1,TMPSC2,TMPSC3,B,DMAT, * XMAT,PHYSOL,COORDS,NODES,NFLUVS,VFLUVS, * NDIRS,VDIRS,NFCOUS,VFCOUS,NFFLUS,VFFLUS, * NFECHS,VFECHS,NFRAYS,VFRAYS,NPRIOS,NODEPR, * VOLUME,DIAG, * NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM, * NBDIRS,NBFFLU,NBFLVS,NPFEL,NBFECH,NPOUE,NPPEL,NBPHYS, * NBFRAY,NBPRIO,NBCOPR,NELEPR,TRAVF, * TRAV1,TRAV2,TRAV3,TRAV4,WCT ) C ---------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- TRAITEMENT DE LA DIFFUSION SOLIDE * C CAS COQUE * C Ce sous-programme traite les conditions exterieurs* C a partir des faces,ce qui permet une meilleure * C prise en compte des discontinuites, qui dans le * C cas coque ont une justification physique moins * C grande. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! TMPSA ! TR ! R ! TEMPERATURE EN CHAQUE POINT interieur ! C ! TMPS ! TR ! D ! TEMPERATURE EN CHAQUE POINT exterieur ! C ! TMPSC1 ! TR ! D ! 1er COEF DE TEMPERATURE ! C ! TMPSC2 ! TR ! D ! 2eme COEF DE TEMPERATURE ! C ! TMPSC3 ! TR ! D ! 3eme COEF DE TEMPERATURE ! C ! DMAT ! TR ! M ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! M ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! PHYSOL ! TR ! D ! CARACTERISTIQUE DU SOLIDE ! C ! ! ! ! physol(n,1) = rho masse vol ! C ! ! ! ! physol(n,2) = Cp chaleur specifique ! C ! ! ! ! physol(n,3) = k conductivite surfacique! C ! ! ! ! physol(n,4) = K conductivite epaisseur ! C ! ! ! ! physol(n,5) = H (R courbure principal) ! C ! ! ! ! physol(n,6) = e (epaisseur locale) ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NBFRAY ! E ! D ! Nombre de facette de type rayonnement ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN COQUE ! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! TRAV1 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV2 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV3 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV4 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL NELEMS * NDMATS ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM INTEGER NBDIRS,NBFLVS,NPFEL,NPOUE,NPPEL,NBPHYS INTEGER NBPRIO,NBCOPR,NELEPR INTEGER NBFFLU,NBFECH,NBFRAY INTEGER NODES(NELEMS,NDMATS),NODEPR(NELEPR,NDMATS+1) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NFLUVS(NBFLVS) INTEGER NDIRS(NBDIRS) INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH) INTEGER NFRAYS(NBFRAY),NFCOUS(NELEMS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMATS),VFECHS(NBFECH,NDMATS,2) DOUBLE PRECISION VFRAYS(NBFRAY,NDMATS,2) DOUBLE PRECISION VFCOUS(NELEMS,NDMATS,2),TRAVF(NELEMS,NDMATS) C DOUBLE PRECISION COORDS(NPOINS,NDIM),B(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS) DOUBLE PRECISION TMPSC3(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VDIRS(NBDIRS) DOUBLE PRECISION DIAG(NPOINS),VOLUME(NELEMS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C..Variables locales INTEGER I,J,INODE,NF LOGICAL LVERIF DOUBLE PRECISION S2EP,EPAIS1,ZERO,SUR3,SUR5,ROCP1,RINDTS DOUBLE PRECISION HRAYO C C*********************************************************************** C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. ZERO = 0.D0 LCOSTA = .TRUE. C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 2- CALCUL DE L'EQUATION SUR LE PREMIER COEFFICIENT C ================================================== C C C 2.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- DO 2101 J=1,NDMATS DO 2100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,J,6) / 2.D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(I,J,5)) * VFCOUS(I,J,2) 2100 CONTINUE 2101 CONTINUE C DO 2111 J=1,NDMATS DO 2110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,J,5)) * VFECHS(I,J,2) 2110 CONTINUE 2111 CONTINUE C IF (.NOT. LCOSTA) THEN RINDTS = 1.D0 / RDTTS DO 2121 J=1,NDMATS DO 2120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(I,J,6) 2120 CONTINUE 2121 CONTINUE ENDIF C DO 2131 J=1,NDMATS DO 2130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,J,5)) * HRAYO 2130 CONTINUE 2131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 2.2- Calcul du second membre C ---------------------------- C cela comprend : C le flux couple au fluide C le flux exterieur utilisateur C le flux avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C le second membre explicite (iteration n) C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 2211 J=1,NDMATS DO 2210 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) =(1.D0-EPAIS1*PHYSOL(NF,J,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 2210 CONTINUE 2211 CONTINUE C DO 2221 J=1,NDMATS DO 2220 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFFLUS(I,J) 2220 CONTINUE 2221 CONTINUE C DO 2231 J=1,NDMATS DO 2230 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 2230 CONTINUE 2231 CONTINUE C C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN CALL OV('X=C ',WCT,WCT,WCT,ZERO,NELEMS*NDMATS) DO 2240 I=1,NBFLVS INODE = NFLUVS(I) WCT(INODE,1) = VFLUVS(I,1) 2240 CONTINUE C DO 2242 J=1,NPFEL DO 2241 NF=1,NELEMS INODE = NODES(NF,J) TRAVF(NF,J) = TRAVF(NF,J) + WCT(INODE,1)*PHYSOL(NF,J,6) 2241 CONTINUE 2242 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 2243 J=1,NPFEL DO 2244 I=1,NBFLVS NF = NFLUVS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,1)*PHYSOL(NF,J,6) 2244 CONTINUE 2243 CONTINUE C ELSE DO 2245 J=1,NPFEL DO 2246 I=1,NBFLVS NF = NFLUVS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,J)*PHYSOL(NF,J,6) 2246 CONTINUE 2245 CONTINUE ENDIF ENDIF C C C DO 2251 J=1,NDMATS DO 2250 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,J,6) * 0.5D0 TRAVF(I,J) = TRAVF(I,J) & - (1.D0-EPAIS1*PHYSOL(I,J,5)) * VFCOUS(I,J,2) & * ( - TMPSC2(INODE) + TMPSC3(INODE) ) 2250 CONTINUE 2251 CONTINUE C DO 2261 J=1,NDMATS DO 2260 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,J,5)) * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC3(INODE) ) 2260 CONTINUE 2261 CONTINUE C IF ( .NOT. LCOSTA ) THEN RINDTS = 1.D0 / RDTTS DO 2271 J=1,NDMATS DO 2270 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(I,J,6) & * TMPSC1(INODE) 2270 CONTINUE 2271 CONTINUE ENDIF C DO 2281 J=1,NDMATS DO 2280 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * HRAYO * VFRAYS(I,J,1) 2280 CONTINUE 2281 CONTINUE C C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 2.3- Calcul de la matrice de diffusion C -------------------------------------- C DO 2301 J=1,NDMATS DO 2300 I=1,NELEMS TRAVF(I,J) = PHYSOL(I,J,6) * PHYSOL(I,J,3) 2300 CONTINUE 2301 CONTINUE C CALL MATEFC ('DIFFU ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C C 2.4- Resolution de la premiere equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC1,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C C C 3- CALCUL DE L'EQUATION SUR LE DEUXIEME COEFFICIENT C ================================================== C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 3.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 2.D0 / EPAIS1 DO 3101 J=1,NDMATS DO 3100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 TRAVF(NF,J) = S2EP * PHYSOL(NF,J,4) + & (1.D0-EPAIS1*PHYSOL(NF,J,5)) * VFCOUS(I,J,2) 3100 CONTINUE 3101 CONTINUE C DO 3111 J=1,NDMATS DO 3110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) * VFECHS(I,J,2) 3110 CONTINUE 3111 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3121 J=1,NDMATS DO 3120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * PHYSOL(I,J,6) 3120 CONTINUE 3121 CONTINUE ENDIF C C DO 3131 J=1,NDMATS DO 3130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(NF,J,5)) * HRAYO 3130 CONTINUE 3131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 3.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 3.D0 DO 3201 J=1,NDMATS DO 3200 I=1,NELEMS TRAVF(I,J) = S2EP * PHYSOL(I,J,3) * PHYSOL(I,J,6) 3200 CONTINUE 3201 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 3.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 3311 J=1,NDMATS DO 3310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = - (1.D0-EPAIS1*PHYSOL(NF,J,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 3310 CONTINUE 3311 CONTINUE C DO 3321 J=1,NDMATS DO 3320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFFLUS(I,J) 3320 CONTINUE 3321 CONTINUE C DO 3331 J=1,NDMATS DO 3330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 3330 CONTINUE 3331 CONTINUE C DO 3341 J=1,NDMATS DO 3340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * HRAYO & * VFRAYS(I,J,1) 3340 CONTINUE 3341 CONTINUE C DO 3351 J=1,NDMATS DO 3350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0-EPAIS1*PHYSOL(NF,J,5)) & * VFCOUS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) & - 2.D0*PHYSOL(NF,J,5)*PHYSOL(NF,J,4) & * TMPSC3(INODE) 3350 CONTINUE 3351 CONTINUE C DO 3361 J=1,NDMATS DO 3360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFECHS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3360 CONTINUE 3361 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3371 J=1,NDMATS DO 3370 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * & PHYSOL(I,J,6) * TMPSC2(INODE) 3370 CONTINUE 3371 CONTINUE ENDIF C DO 3381 J=1,NDMATS DO 3380 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * HRAYO & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3380 CONTINUE 3381 CONTINUE C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN CALL OV('X=C ',WCT,WCT,WCT,ZERO,NELEMS*NDMATS) DO 3390 I=1,NBFLVS INODE = NFLUVS(I) WCT(INODE,1) = VFLUVS(I,1) 3390 CONTINUE C DO 3392 J=1,NDMATS DO 3391 NF=1,NELEMS INODE = NODES(NF,J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + WCT(INODE,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,J,5) ) 3391 CONTINUE 3392 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 3393 J=1,NDMATS DO 3394 I=1,NBFLVS NF=NFLUVS(I) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,J,5) ) 3394 CONTINUE 3393 CONTINUE C ELSE DO 3395 J=1,NPFEL DO 3396 I=1,NBFLVS NF=NFLUVS(I) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,J) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,J,5) ) 3396 CONTINUE 3395 CONTINUE ENDIF ENDIF C C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 3.4- Resolution de la deuxieme equation C --------------------------------------- C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC2,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 4- CALCUL DE L'EQUATION SUR LE TROISIEME COEFFICIENT C ==================================================== C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 4.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 6.D0 DO 4101 J=1,NDMATS DO 4100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,J,6) / 2.D0 TRAVF(NF,J) = S2EP * PHYSOL(I,J,4) / EPAIS1 & + (1.D0-EPAIS1*PHYSOL(I,J,5)) * VFCOUS(I,J,2) 4100 CONTINUE 4101 CONTINUE C DO 4111 J=1,NDMATS DO 4110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) * VFECHS(I,J,2) 4110 CONTINUE 4111 CONTINUE C IF ( .NOT. LCOSTA) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4121 J=1,NDMATS DO 4120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 * PHYSOL(I,J,6) 4120 CONTINUE 4121 CONTINUE ENDIF C DO 4131 J=1,NDMATS DO 4130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(NF,J,5)) * HRAYO 4130 CONTINUE 4131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 4.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 5.D0 DO 4201 J=1,NDMATS DO 4200 I=1,NELEMS TRAVF(I,J) = S2EP * PHYSOL(I,J,3) * PHYSOL(I,J,6) 4200 CONTINUE 4201 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 4.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C IF ( .NOT. LCOSTA ) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4301 J=1,NDMATS DO 4300 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,J,1) * PHYSOL(I,J,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 & * PHYSOL(I,J,6) * TMPSC3(INODE) 4300 CONTINUE 4301 CONTINUE ENDIF C C DO 4311 J=1,NDMATS DO 4310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(NF,J,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 4310 CONTINUE 4311 CONTINUE C DO 4321 J=1,NDMATS DO 4320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFFLUS(I,J) 4320 CONTINUE 4321 CONTINUE C DO 4331 J=1,NDMATS DO 4330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 4330 CONTINUE 4331 CONTINUE C DO 4341 J=1,NDMATS DO 4340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * HRAYO & * VFRAYS(I,J,1) 4340 CONTINUE 4341 CONTINUE C C C DO 4351 J=1,NDMATS DO 4350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,J,6)* 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(NF,J,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * VFCOUS(I,J,2) & - 2.D0*PHYSOL(NF,J,5)*PHYSOL(NF,J,4) & * TMPSC2(INODE) 4350 CONTINUE 4351 CONTINUE C DO 4361 J=1,NDMATS DO 4360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,J,5)) & * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC1(INODE) ) 4360 CONTINUE 4361 CONTINUE C DO 4371 J=1,NDMATS DO 4370 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,J,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(NF,J,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * HRAYO c & - 2.D0*PHYSOL(NF,J,5)*PHYSOL(NF,J,4) c & * TMPSC2(INODE) 4370 CONTINUE 4371 CONTINUE C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C DO 438 I=1,NBDIRS VDIRS(I) = VDIRS(I) - TMPSC1(NDIRS(I)) & + TMPSC2(NDIRS(I)) 438 CONTINUE C C IF ( NBDIRS .GT. 0 ) THEN CALL SMDIRS ( NDIRS,VDIRS,B,DMAT,XMAT,NODES, & TRAV1,TRAV2,TRAV3, & NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, & NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, & WCT ) ENDIF C C 4.4- Resolution de la Troisieme equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC3,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 5- CALCUL DE LA TEMPERATURE SUR LES DEUX FACES INT ET EXT C ========================================================= C DO 510 I=1,NPOINS TMPSA(I) = TMPSC1(I) - TMPSC2(I) + TMPSC3(I) 510 CONTINUE C DO 520 I=1,NPOINS TMPS(I) = TMPSC1(I) + TMPSC2(I) + TMPSC3(I) 520 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/iperio.F0000666000175000017500000001735011524070644015350 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=IPERIO,SSI=0 C SUBROUTINE IPERIO C ***************** C * (CTYP,VV,NVV,NBPRIO,NBCOPR,NDIM,NPOINS,NPRIOS,NREFS,IREF,NB, * COORDS,NPER1,NPER2,XTR,YTR,ZTR) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- INITIALISATION DES CORRESPONDANCES POUR LA PERIODICITE * C * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! CTYP ! C ! D ! TYPE DE TRANSFORMATION (T,R,TR ou RT) ! C ! VV ! TR ! D ! DONNEES DE LA TRANSFORMATION GEOMETRIQUE ! C ! NVV ! E ! D ! TAILLE DU TABLEAU VV (IE : NBRE DE DONNEES) ! C ! NBPRIO ! E ! D ! NBRE DE NOEUDS PERIODIQUES ! C ! NBCOPR ! E ! D ! NBRE DE CORRESPONDANTS D'UN NOEUD PERIODIQUE! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS SOLIDES ! C ! NPRIOS ! TE ! M ! NUMERO GLOB DU NOEUD PERIODIQUE ET NUMEROS ! C ! ! ! ! LOCAUX DE SES CORRESPONDANTS ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS ! C ! IREF ! TE ! D ! REFERENCES IMPLIQUEES ! C ! NB ! E ! D ! NOMBRE DE REFERENCES IMPLIQUEES ! C !NPER1,NPER2 TE ! A ! TABLEAUX DE TRAVAIL ! C !XTR,YTR,ZTR TR ! A ! TABLEAUX DE TRAVAIL ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !/XREFER/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : CORPER,ROTATS C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" C C********************************************************************** C C..Variables externes CHARACTER*1 CTYP INTEGER NVV,NDIM,NPOINS,NBPRIO,NBCOPR,NB INTEGER IREF(NRFMAX),NPRIOS(NBPRIO,1+NBCOPR),NREFS(NPOINS) INTEGER NPER1(NPOINS),NPER2(NPOINS) DOUBLE PRECISION VV(NVV),COORDS(NPOINS,NDIM) C C..Variables internes INTEGER N,N1,M,NB1,NB2,NR,NG DOUBLE PRECISION PI,X,Y,Z,XT,YT,ZT DOUBLE PRECISION TX,TY,TZ,ARX,ARY,ARZ,AROTX,AROTY,AROTZ DOUBLE PRECISION XTR(NPOINS),YTR(NPOINS),ZTR(NPOINS) LOGICAL LVERIF C C********************************************************************** C C 0- Initialisations C ================== LVERIF = .FALSE. C DO 10 N=1,NPOINS NPER1(N) = 0 NPER2(N) = 0 XTR(N) = 0. YTR(N) = 0. ZTR(N) = 0. 10 CONTINUE C NB1 = 0 NB2 = 0 C N = 0 11 N = N + 1 IF (IREF(N).GT.0) THEN GOTO 11 ENDIF NB1 = N - 1 C NB2 = NB - NB1 - 1 C C C 1- Reperage des noeuds concernes : on constitue les deux listes C de noeuds en vis-a-vis C =============================================================== C DO 100 N1=1,NB1 NR = IREF(N1) DO 110 M=1,NBPRIO IF (NREFS(NPRIOS(M,1)).EQ.NR) NPER1(M) = M 110 CONTINUE 100 CONTINUE C DO 120 N1=NB1+1,NB NR = IREF(N1) DO 130 M=1,NBPRIO IF (NREFS(NPRIOS(M,1)).EQ.NR) NPER2(M) = M 130 CONTINUE 120 CONTINUE C C 2- Transformation des coordonnees des noeuds de la liste 1 C ========================================================== C PI = 3.141592654 C IF (CTYP.EQ.'T') THEN TX = VV(1) TY = VV(2) TZ = VV(3) DO 210 N=1,NBPRIO IF (NPER1(N).GT.0) THEN NG = NPRIOS(N,1) XTR(NG) = COORDS(NG,1) + TX YTR(NG) = COORDS(NG,2) + TY IF (NDIM.EQ.3) ZTR(NG) = COORDS(NG,3) + TZ ENDIF 210 CONTINUE CALL CORPER(NDIM,NPOINS,NBPRIO,NBCOPR,NPRIOS,NPER1,NPER2, & COORDS,XTR,YTR,ZTR) C ELSEIF (CTYP.EQ.'R') THEN TX = VV(1) TY = VV(2) TZ = VV(3) ARX = VV(4) * PI / 180. ARY = VV(5) * PI / 180. ARZ = VV(6) * PI / 180. AROTX = VV(7) * PI / 180. AROTY = VV(8) * PI / 180. AROTZ = VV(9) * PI / 180. C C DO 220 N=1,NBPRIO IF (NPER1(N).GT.0) THEN NG = NPRIOS(N,1) X = COORDS(NG,1) Y = COORDS(NG,2) Z = 0. IF (NDIM.EQ.3) Z = COORDS(NG,3) CALL ROTATS (X,Y,Z,XT,YT,ZT,TX,TY,TZ, * ARX,ARY,ARZ,AROTX,AROTY,AROTZ) XTR(NG) = XT YTR(NG) = YT IF (NDIM.EQ.3) ZTR(NG) = ZT ENDIF 220 CONTINUE C CALL CORPER(NDIM,NPOINS,NBPRIO,NBCOPR,NPRIOS,NPER1,NPER2, & COORDS,XTR,YTR,ZTR) C ENDIF C C C C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/imobil.F0000666000175000017500000001404511524070644015332 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=IMOBIL,SSI=0 C SUBROUTINE IMOBIL C ***************** C * (CTYP,VV,NVV,NBMOBS,NDIM,NPOINS,NMOBIL,NREFS,IREF,NB,COORDS) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- INITIALISATION POUR LES SOLIDES EN ROTATION * C * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! CTYP ! C ! D ! TYPE DE TRANSFORMATION (T,R,TR ou RT) ! C ! VV ! TR ! D ! DONNEES DU MOUVEMENT ! C ! NVV ! E ! D ! TAILLE DU TABLEAU VV (IE : NBRE DE DONNEES) ! C ! NBMOBS ! E ! D ! NBRE DE NOEUDS EN MOUVEMENT ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS SOLIDES ! C ! NMOBIL ! TE ! M ! NUMERO GLOB DES NOEUDS MOBILES ET NUMERO DU ! C ! ! ! ! SOLIDE AUXQUEL ILS APPARTIENNENT ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS ! C ! IREF ! TE ! D ! REFERENCES IMPLIQUEES ! C ! NB ! E ! D ! NOMBRE DE REFERENCES IMPLIQUEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !/XREFER/! ! D ! ! C !/MOBIL/ ! ! M ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "mobil.h" #include "nlofes.h" #include "xrefer.h" C C********************************************************************** C C..Variables externes CHARACTER*1 CTYP INTEGER NVV,NDIM,NPOINS,NBMOBS,NB INTEGER IREF(NRFMAX),NMOBIL(NBMOBS,2),NREFS(NPOINS) DOUBLE PRECISION VV(NVV),COORDS(NPOINS,NDIM) C C..Variables internes INTEGER N,N1,M,NR,NBRE,NUMGLO,NUMREF LOGICAL LVERIF C C********************************************************************** C C 0- Initialisations C ------------------ LVERIF = .FALSE. NBRE = 0 C NBRMOB = NBRMOB +1 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C NBRMOB = 1 C DO 110 N=1,NBMOBS NMOBIL(N,2) = 1 NBRE = NBRE + 1 110 CONTINUE C DO 120 N=1,9 DEFMOB(1,N+1) = VV(N) 120 CONTINUE C C 2- Application de la condition aux references citees C ---------------------------------------------------- ELSE C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NBMOBS C NUMGLO = NMOBIL(N,1) NUMREF = NREFS(NUMGLO) C IF (NUMREF .EQ. NR) THEN NMOBIL(N,2) = NBRMOB NBRE = NBRE + 1 ENDIF C DO 220 M=1,9 DEFMOB(NBRMOB,M+1) = VV(M) 220 CONTINUE C 210 CONTINUE 200 CONTINUE C ENDIF CC C C C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/diffc2.F0000666000175000017500000007465511524070644015231 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE DIFFC2 C ***************** C C --------------------------------------------------- *( TMPS,TMPSA,TMPSC1,TMPSC2,TMPSC3,B,DMAT, * XMAT,PHYSOL,COORDS,NODES,NFLUVS,VFLUVS, * NDIRS,VDIRS,NFCOUS,VFCOUS,NFFLUS,VFFLUS, * NFECHS,VFECHS,NFRAYS,VFRAYS,NPRIOS,NODEPR, * VOLUME,DIAG, * NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM, * NBDIRS,NBFFLU,NBFLVS,NPFEL,NBFECH,NPOUE,NPPEL,NBPHYS, * NBFRAY,NBPRIO,NBCOPR,NELEPR,TRAVF, * TRAV1,TRAV2,TRAV3,TRAV4,WCT ) C ---------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- TRAITEMENT DE LA DIFFUSION SOLIDE * C CAS COQUE * C Ce sous-programme traite les conditions exterieurs* C a partir des faces,ce qui permet une meilleure * C prise en compte des discontinuites, qui dans le * C cas coque ont une justification physique moins * C grande. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! TMPSA ! TR ! R ! TEMPERATURE EN CHAQUE POINT interieur ! C ! TMPS ! TR ! D ! TEMPERATURE EN CHAQUE POINT exterieur ! C ! TMPSC1 ! TR ! D ! 1er COEF DE TEMPERATURE ! C ! TMPSC2 ! TR ! D ! 2eme COEF DE TEMPERATURE ! C ! TMPSC3 ! TR ! D ! 3eme COEF DE TEMPERATURE ! C ! DMAT ! TR ! M ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! M ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! PHYSOL ! TR ! D ! CARACTERISTIQUE DU SOLIDE ! C ! ! ! ! physol(n,1) = rho masse vol ! C ! ! ! ! physol(n,2) = Cp chaleur specifique ! C ! ! ! ! physol(n,3) = k conductivite surfacique! C ! ! ! ! physol(n,4) = K conductivite epaisseur ! C ! ! ! ! physol(n,5) = H (R courbure principal) ! C ! ! ! ! physol(n,6) = e (epaisseur locale) ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NBFRAY ! E ! D ! Nombre de facette de type rayonnement ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN COQUE ! C ! DIAG ! TR ! M ! DIAGONALE DE PRECONDITIONNEMENT ! C ! TRAV1 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV2 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV3 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! TRAV4 ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL NELEMS * NDMATS ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDIELE,NCOEMA,NDMATS,NDIM INTEGER NBDIRS,NBFLVS,NPFEL,NPOUE,NPPEL,NBPHYS INTEGER NBPRIO,NBCOPR,NELEPR INTEGER NBFFLU,NBFECH,NBFRAY INTEGER NODES(NELEMS,NDMATS),NODEPR(NELEPR,NDMATS+1) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NFLUVS(NBFLVS) INTEGER NDIRS(NBDIRS) INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH) INTEGER NFRAYS(NBFRAY),NFCOUS(NELEMS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMATS),VFECHS(NBFECH,NDMATS,2) DOUBLE PRECISION VFRAYS(NBFRAY,NDMATS,2) DOUBLE PRECISION VFCOUS(NELEMS,NDMATS,2),TRAVF(NELEMS,NDMATS) C DOUBLE PRECISION COORDS(NPOINS,NDIM),B(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DMAT(NPOINS) DOUBLE PRECISION TMPS(NPOINS),TMPSA(NPOINS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS) DOUBLE PRECISION TMPSC3(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VDIRS(NBDIRS) DOUBLE PRECISION DIAG(NPOINS),VOLUME(NELEMS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C..Variables locales INTEGER I,J,INODE,NF LOGICAL LVERIF DOUBLE PRECISION S2EP,EPAIS1,ZERO,SUR3,SUR5,ROCP1,RINDTS DOUBLE PRECISION HRAYO C C*********************************************************************** C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. ZERO = 0.D0 LCOSTA = .TRUE. C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 2- CALCUL DE L'EQUATION SUR LE PREMIER COEFFICIENT C ================================================== C C C 2.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- DO 2101 J=1,NDMATS DO 2100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,1,6) / 2.D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(I,1,5)) * VFCOUS(I,J,2) 2100 CONTINUE 2101 CONTINUE C DO 2111 J=1,NDMATS DO 2110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,1,5)) * VFECHS(I,J,2) 2110 CONTINUE 2111 CONTINUE C IF (.NOT. LCOSTA) THEN RINDTS = 1.D0 / RDTTS DO 2121 J=1,NDMATS DO 2120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(I,1,6) 2120 CONTINUE 2121 CONTINUE ENDIF C DO 2131 J=1,NDMATS DO 2130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,1,5)) * HRAYO 2130 CONTINUE 2131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 2.2- Calcul du second membre C ---------------------------- C cela comprend : C le flux couple au fluide C le flux exterieur utilisateur C le flux avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C le second membre explicite (iteration n) C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 2211 J=1,NDMATS DO 2210 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) =(1.D0-EPAIS1*PHYSOL(NF,1,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 2210 CONTINUE 2211 CONTINUE C DO 2221 J=1,NDMATS DO 2220 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFFLUS(I,J) 2220 CONTINUE 2221 CONTINUE C DO 2231 J=1,NDMATS DO 2230 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 2230 CONTINUE 2231 CONTINUE C C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN CALL OV('X=C ',WCT,WCT,WCT,ZERO,NELEMS*NDMATS) DO 2240 I=1,NBFLVS INODE = NFLUVS(I) WCT(INODE,1) = VFLUVS(I,1) 2240 CONTINUE C DO 2242 J=1,NDMATS DO 2241 NF=1,NELEMS INODE = NODES(NF,J) TRAVF(NF,J) = TRAVF(NF,J) + WCT(INODE,1)*PHYSOL(NF,1,6) 2241 CONTINUE 2242 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 2243 J=1,NDMATS DO 2244 I=1,NBFLVS NF = NFLUVS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,1)*PHYSOL(NF,1,6) 2244 CONTINUE 2243 CONTINUE C ELSE DO 2245 J=1,NPFEL DO 2246 I=1,NBFLVS NF = NFLUVS(I) TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,J)*PHYSOL(NF,1,6) 2246 CONTINUE 2245 CONTINUE ENDIF ENDIF C C C C DO 2251 J=1,NDMATS DO 2250 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,1,6) * 0.5D0 TRAVF(I,J) = TRAVF(I,J) & - (1.D0-EPAIS1*PHYSOL(I,1,5)) * VFCOUS(I,J,2) & * ( - TMPSC2(INODE) + TMPSC3(INODE) ) 2250 CONTINUE 2251 CONTINUE C DO 2261 J=1,NDMATS DO 2260 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,1,5)) * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC3(INODE) ) 2260 CONTINUE 2261 CONTINUE C IF ( .NOT. LCOSTA ) THEN RINDTS = 1.D0 / RDTTS DO 2271 J=1,NDMATS DO 2270 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * PHYSOL(I,1,6) & * TMPSC1(INODE) 2270 CONTINUE 2271 CONTINUE ENDIF C DO 2281 J=1,NDMATS DO 2280 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * HRAYO * VFRAYS(I,J,1) 2280 CONTINUE 2281 CONTINUE C C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 2.3- Calcul de la matrice de diffusion C -------------------------------------- C DO 2301 J=1,NDMATS DO 2300 I=1,NELEMS TRAVF(I,J) = PHYSOL(I,1,6) * PHYSOL(I,1,3) 2300 CONTINUE 2301 CONTINUE C CALL MATEFC ('DIFFU ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C C 2.4- Resolution de la premiere equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC1,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C C C 3- CALCUL DE L'EQUATION SUR LE DEUXIEME COEFFICIENT C ================================================== C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 3.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 2.D0 / EPAIS1 DO 3101 J=1,NDMATS DO 3100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 TRAVF(NF,J) = S2EP * PHYSOL(NF,1,4) + & (1.D0-EPAIS1*PHYSOL(NF,1,5)) * VFCOUS(I,J,2) 3100 CONTINUE 3101 CONTINUE C DO 3111 J=1,NDMATS DO 3110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) * VFECHS(I,J,2) 3110 CONTINUE 3111 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3121 J=1,NDMATS DO 3120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * PHYSOL(I,1,6) 3120 CONTINUE 3121 CONTINUE ENDIF C C DO 3131 J=1,NDMATS DO 3130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(NF,1,5)) * HRAYO 3130 CONTINUE 3131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 3.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 3.D0 DO 3201 J=1,NDMATS DO 3200 I=1,NELEMS TRAVF(I,J) = S2EP * PHYSOL(I,1,3) * PHYSOL(I,1,6) 3200 CONTINUE 3201 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 3.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C C DO 3311 J=1,NDMATS DO 3310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = - (1.D0-EPAIS1*PHYSOL(NF,1,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 3310 CONTINUE 3311 CONTINUE C DO 3321 J=1,NDMATS DO 3320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFFLUS(I,J) 3320 CONTINUE 3321 CONTINUE C DO 3331 J=1,NDMATS DO 3330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 3330 CONTINUE 3331 CONTINUE C DO 3341 J=1,NDMATS DO 3340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * HRAYO & * VFRAYS(I,J,1) 3340 CONTINUE 3341 CONTINUE C DO 3351 J=1,NDMATS DO 3350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0-EPAIS1*PHYSOL(NF,1,5)) & * VFCOUS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) & - 2.D0*PHYSOL(NF,1,5)*PHYSOL(NF,1,4) & * TMPSC3(INODE) 3350 CONTINUE 3351 CONTINUE C DO 3361 J=1,NDMATS DO 3360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFECHS(I,J,2) & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3360 CONTINUE 3361 CONTINUE C IF ( .NOT. LCOSTA ) THEN SUR3 = 1.D0 / 3.D0 RINDTS = 1.D0 / RDTTS DO 3371 J=1,NDMATS DO 3370 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR3 * & PHYSOL(I,1,6) * TMPSC2(INODE) 3370 CONTINUE 3371 CONTINUE ENDIF C DO 3381 J=1,NDMATS DO 3380 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * HRAYO & * ( TMPSC1(INODE) + TMPSC3(INODE) ) 3380 CONTINUE 3381 CONTINUE C IF (NBFLVS.GE.1) THEN IF(NDFLUV.EQ.1) THEN CALL OV('X=C ',WCT,WCT,WCT,ZERO,NELEMS*NDMATS) DO 3390 I=1,NBFLVS INODE = NFLUVS(I) WCT(INODE,1) = VFLUVS(I,1) 3390 CONTINUE C DO 3392 J=1,NDMATS DO 3391 NF=1,NELEMS INODE = NODES(NF,J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + WCT(INODE,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,1,5) ) 3391 CONTINUE 3392 CONTINUE C ELSEIF(NDFLUV.EQ.2) THEN DO 3393 J=1,NDMATS DO 3394 I=1,NBFLVS NF=NFLUVS(I) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,1) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,1,5) ) 3394 CONTINUE 3393 CONTINUE C ELSE DO 3395 J=1,NPFEL DO 3396 I=1,NBFLVS NF=NFLUVS(I) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) + VFLUVS(I,J) & * 2.D0/3.D0 * EPAIS1 * EPAIS1 & * ABS( PHYSOL(NF,1,5) ) 3396 CONTINUE 3395 CONTINUE ENDIF ENDIF C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C 3.4- Resolution de la deuxieme equation C --------------------------------------- C C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC2,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 4- CALCUL DE L'EQUATION SUR LE TROISIEME COEFFICIENT C ==================================================== C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C 4.1- Calcul de la matrice de masse mass-lumpee C ---------------------------------------------- S2EP = 6.D0 DO 4101 J=1,NDMATS DO 4100 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(I,1,6) / 2.D0 TRAVF(NF,J) = S2EP * PHYSOL(I,1,4) / EPAIS1 & + (1.D0-EPAIS1*PHYSOL(I,1,5)) * VFCOUS(I,J,2) 4100 CONTINUE 4101 CONTINUE C DO 4111 J=1,NDMATS DO 4110 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) * VFECHS(I,J,2) 4110 CONTINUE 4111 CONTINUE C IF ( .NOT. LCOSTA) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4121 J=1,NDMATS DO 4120 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 * PHYSOL(I,1,6) 4120 CONTINUE 4121 CONTINUE ENDIF C DO 4131 J=1,NDMATS DO 4130 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) + & (1.D0-EPAIS1*PHYSOL(NF,1,5)) * HRAYO 4130 CONTINUE 4131 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C 4.2- Calcul de la matrice de diffusion C -------------------------------------- S2EP = 1.D0 / 5.D0 DO 4201 J=1,NDMATS DO 4200 I=1,NELEMS TRAVF(I,J) = S2EP * PHYSOL(I,1,3) * PHYSOL(I,1,6) 4200 CONTINUE 4201 CONTINUE C CALL MATEFC ('MASSE ',DMAT,XMAT,TRAVF,NODES,COORDS,VOLUME, & NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, & WCT ) C C C 4.3- Calcul du second membre C ---------------------------- C cela comprend : C la partie couplee au fluide C la partie avec flux exterieur utilisateur C la partie avec coefficient d'echange. C le flux volumique constant dans l'epaisseur C C CALL OV ( 'X=C ',TRAVF,TRAVF,TRAVF,ZERO,NELEMS*NDMATS ) C C IF ( .NOT. LCOSTA ) THEN SUR5 = 1.D0 / 5.D0 RINDTS = 1.D0 / RDTTS DO 4301 J=1,NDMATS DO 4300 I=1,NELEMS INODE = NODES(I,J) ROCP1 = PHYSOL(I,1,1) * PHYSOL(I,1,2) * RINDTS TRAVF(I,J) = TRAVF(I,J) + ROCP1 * SUR5 & * PHYSOL(I,1,6) * TMPSC3(INODE) 4300 CONTINUE 4301 CONTINUE ENDIF C C DO 4311 J=1,NDMATS DO 4310 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 TRAVF(NF,J) = (1.D0-EPAIS1*PHYSOL(NF,1,5)) & * VFCOUS(I,J,2) & * VFCOUS(I,J,1) 4310 CONTINUE 4311 CONTINUE C DO 4321 J=1,NDMATS DO 4320 I=1,NBFFLU NF = NFFLUS(I) INODE = NODES(NFFLUS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFFLUS(I,J) 4320 CONTINUE 4321 CONTINUE C DO 4331 J=1,NDMATS DO 4330 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFECHS(I,J,2) & * VFECHS(I,J,1) 4330 CONTINUE 4331 CONTINUE C DO 4341 J=1,NDMATS DO 4340 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) / 2.D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & + (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * HRAYO & * VFRAYS(I,J,1) 4340 CONTINUE 4341 CONTINUE C C C DO 4351 J=1,NDMATS DO 4350 I=1,NELEMS NF = NFCOUS(I) INODE = NODES(NFCOUS(I),J) EPAIS1 = PHYSOL(NF,1,6)* 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(NF,1,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * VFCOUS(I,J,2) & - 2.D0*PHYSOL(NF,1,5)*PHYSOL(NF,1,4) & * TMPSC2(INODE) 4350 CONTINUE 4351 CONTINUE C DO 4361 J=1,NDMATS DO 4360 I=1,NBFECH NF = NFECHS(I) INODE = NODES(NFECHS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0+EPAIS1*PHYSOL(NF,1,5)) & * VFECHS(I,J,2) & * ( TMPSC2(INODE) + TMPSC1(INODE) ) 4360 CONTINUE 4361 CONTINUE C DO 4371 J=1,NDMATS DO 4370 I=1,NBFRAY NF = NFRAYS(I) INODE = NODES(NFRAYS(I),J) EPAIS1 = PHYSOL(NF,1,6) * 0.5D0 HRAYO = VFRAYS(I,J,2)*SIGMA* & (TMPS(INODE)+VFRAYS(I,J,1)+2.*TKEL)* & ((TMPS(INODE)+TKEL)*(TMPS(INODE)+TKEL)+ & (VFRAYS(I,J,1)+TKEL)*(VFRAYS(I,J,1)+TKEL) ) TRAVF(NF,J) = TRAVF(NF,J) & - (1.D0-EPAIS1*PHYSOL(NF,1,5)) & * ( -TMPSC2(INODE) + TMPSC1(INODE) ) & * HRAYO c & - 2.D0*PHYSOL(NF,1,5)*PHYSOL(NF,1,4) c & * TMPSC2(INODE) 4370 CONTINUE 4371 CONTINUE C CALL SMFFCO ( TRAVF,B,NODES,VOLUME, & NPOINS,NELEMS,NDMATS,NDIELE, & WCT ) C C C C DO 438 I=1,NBDIRS VDIRS(I) = VDIRS(I) - TMPSC1(NDIRS(I)) & + TMPSC2(NDIRS(I)) 438 CONTINUE C C IF ( NBDIRS .GT. 0 ) THEN CALL SMDIRS ( NDIRS,VDIRS,B,DMAT,XMAT,NODES, & TRAV1,TRAV2,TRAV3, & NPOINS,NELEMS,NDMATS,NBDIRS,NCOEMA, & NDIELE,NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR, & WCT ) ENDIF C C 4.4- Resolution de la Troisieme equation C --------------------------------------- C CALL OV ('X=1/Y ',DIAG,DMAT,DMAT,ZERO,NPOINS ) C CALL GRCONJ ( TMPSC3,DMAT,XMAT,B,DIAG,NODES, & TRAV1,TRAV2,TRAV3,TRAV4,WCT, & NPOINS,NELEMS,NDIELE,NDMATS,NCOEMA, & NODEPR,NELEPR,NPRIOS,NBPRIO,NBCOPR ) C C C 5- CALCUL DE LA TEMPERATURE SUR LES DEUX FACES INT ET EXT C ========================================================= C DO 510 I=1,NPOINS TMPSA(I) = TMPSC1(I) - TMPSC2(I) + TMPSC3(I) 510 CONTINUE C DO 520 I=1,NPOINS TMPS(I) = TMPSC1(I) + TMPSC2(I) + TMPSC3(I) 520 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/limray.F0000666000175000017500000003755611524070644015370 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LIMRAY,SSI=0 SUBROUTINE LIMRAY C ***************** C C ------------------------------------------------------------ * (NDIM,NELRAY,NPOINR, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA, * NODRAY,NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF, * COORAY,EMISSI,TEMRAY,FIRAY,PHFRAF,PHFRAE,VFIRAY) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES DE RAYONNEMENT * C TRANSPARENT CONFINE SUR LE MAILLAGE DE RAYONNEMENT * C * C Attention : Toutes les grandeurs entrees par l'utilisateur le sont * C au niveau des faces * C * C (Sous-programme utilisateur) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NELRAY ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUD DU MAILLAGE DE RAYONNEMENT ! C ! SPECTL ! TR ! R ! BORNES DE CHAQUE BANDE SPECTRALE ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNT ! C ! COORAY ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE DE RAYONNT! C ! NODRAY ! TE ! D ! CONNECTIVITE DU MAILLAGE DE RAYONNEMENT ! C ! EMISSI ! TE ! D ! EMISSIVITE DE FACETTE POUR CHAQUE BANDE ! C ! TEMRAY ! TR ! D ! TEMPERATURE DE LA FACE DE RAYONNT A L'ETAPE N! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "rayonn.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NELRAY,NPOINR INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA INTEGER NGFFIR(NFFIRA),NGFTIR(NFTIRA) INTEGER NGFPER(NFPERA),NGFPEF(NFCFRA) INTEGER NRFRAY(NELRAY),NODRAY(NELRAY,NDIM) DOUBLE PRECISION COORAY(NPOINR,NDIM),TEMRAY(NELRAY) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION PHFRAF(NFCFRA,4),PHFRAE(NFPERA,4) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) C C C.. Variables internes INTEGER N,NUMNO,NUMREF,I,NGFAC DOUBLE PRECISION T,XX1,YY1,ZZ1 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Temps courant sur le solide CUTI T = TEMPSS C C ================================================================ C 1- INITIALISATION DES BANDES SPECTRALES C ================================================================ C Definition des bandes spectrales si besoin est C Le nombre de bandes spectrales,NBANDE est defini dans le fichier C de mots-cles Syrthes.ray C Exemple : si le nombre de bandes (NBANDE) vaut 2, avec en metres C Premiere bande lambda_1 = 0 , lambda_2 = 5.e-6 (m) C Deuxieme bande lambda_1 = 5.e-6 , lambda_2 = 1. CUTI SPECTL(1,1) = 0 CUTI SPECTL(1,2) = 5.e-6 CUTI SPECTL(2,1) = 5.e-6 CUTI SPECTL(2,2) = 1. C C ================================================================ C 2- INITIALISATION DE l'EMISSIVITE POUR LE RAYONNEMENT C ================================================================ C C Exemple ... C CUTI DO N=1,NELRAY C C References de la face CUTI NUMREF = NRFRAY(N) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(N,1),1) CUTI YY1 = COORAY(NODRAY(N,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(N,1),3) C ... C C Temperature de la face de rayonnement CUTI TTFAC = TEMRAY(N) C C Exemple C Si la face porte la reference 3, l'emissivite vaut C 0.7 pour la premiere bande C 0.95 pour la deuxieme bande C sinon, elle vaut 0.5 (elle peut eventuellement dependre de la C temperature de la face calculee precedement (TTFAC) C CUTI IF (NUMREF.EQ.3) THEN CUTI EMISSI(N,1,1) = 0.7 CUTI EMISSI(N,1,2) = 0.95 CUTI ELSE CUTI EMISSI(N,1,1) = 0.5 CUTI EMISSI(N,1,2) = 0.5 CUTI ENDIF C CUTI ENDDO C C ================================================================ C 3- INITIALISATION DES TEMPERATURES DE FACES IMPOSEE C ================================================================ C CUTI DO N=1,NFTIRA C C Numero global de la face CUTI NGFAC = NGFTIR(N) C Reference de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Attention : La temperature de la face de rayonnement est en degre C C La references 5 designe une entree T = 30 degre C C La references 6 designe une sortie T = 50 degre C C CUTI IF ( NUMREF .EQ. 5 ) THEN CUTI TEMRAY(NGFAC) = 30. CUTI ELSEIF ( NUMREF .EQ. 6 ) THEN CUTI TEMRAY(NGFAC) = 50. CUTI ENDIF C CUTI ENDDO C C ================================================================ C 4- INITIALISATION DES FACES A FLUX IMPOSE PAR BANDE C ================================================================ C CUTI DO N=1,NFFIRA C C Numero global de la face CUTI NGFAC = NGFFIR(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C On a une seule bande spectrale --> NUMBAN = 1 C Si la reference de la face vaut 7 on a une paroi adiabatique C Si la reference de la face vaut 3 on a un flux de 500 W/m2 C CUTI NUMBAN = 1 C CUTI IF ( NUMREF .EQ. 7 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 0. CUTI ELSEIF ( NUMREF .EQ. 3 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 500. CUTI ENDIF C CUTI ENDDO C C C ================================================================ C 5- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C COUPLEE AU FLUIDE (attention sans solide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAF(..,1) est la conductivite du materiau C PHFRAF(..,2) est l'epaisseur du materiau C PHFRAF(..,3) est la temperature exterieure C PHFRAF(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFCFRA C C Numero global de la face CUTI NGFAC = NGFPEF(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 5 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : -10. degres C C H ext : 200 C CUTI IF (NUMREF.EQ.5) THEN CUTI PHFRAF(N,1) = 10. CUTI PHFRAF(N,2) = 0.01 CUTI PHFRAF(N,3) = -10. CUTI PHFRAF(N,4) = 200. CUTI ENDIF C C CUTI ENDDO C C ================================================================ C 6- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C DES FACES DE RAYONNEMENT ISOLEES C (ni couple au solide ni au fluide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAE(..,1) est la conductivite du materiau C PHFRAE(..,2) est l'epaisseur du materiau C PHFRAE(..,3) est la temperature exterieure C PHFRAE(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFPERA C C Numero global de la face CUTI NGFAC = NGFPER(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 12 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : 100. degres C C H ext : 10 C CUTI IF (NUMREF.EQ.12) THEN CUTI PHFRAE(N,1) = 10. CUTI PHFRAE(N,2) = 0.01 CUTI PHFRAE(N,3) = 100. CUTI PHFRAE(N,4) = 10. CUTI ENDIF C C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 7- IMPRESSION DE CONTROLE C ========================= C (il suffit de mettre LVERIF = .TRUE. en debut de programme) C IF (LVERIF) THEN C WRITE(NFECRA,7000) C IF (NBANDE .GT. 1) THEN WRITE(NFECRA,7100) NBANDE DO 7110 N=1,NBANDE WRITE(NFECRA,7120) SPECTL(N,1),SPECTL(N,2) 7110 CONTINUE ENDIF C DO 7200 N=1,NBANDE WRITE(NFECRA,7210) N WRITE(NFECRA,7220) WRITE(NFECRA,7230) ( I,EMISSI(I,1,N),I=1,NELRAY ) 7200 CONTINUE C C WRITE(NFECRA,7300) NFTIRA WRITE(NFECRA,7310) WRITE(NFECRA,7320) ( NGFTIR(I),TEMRAY(NGFTIR(I)),I=1,NFTIRA ) C C WRITE(NFECRA,7410) NFFIRA DO 7400 N=1,NBANDE WRITE(NFECRA,7415) N WRITE(NFECRA,7420) WRITE(NFECRA,7430) (NGFFIR(I),FIRAY(NGFFIR(I),N),I=1,NFFIRA) 7400 CONTINUE C C WRITE(NFECRA,7500) NFCFRA WRITE(NFECRA,7510) DO 7530 N=1,NFCFRA NGFAC = NGFPEF(N) WRITE(NFECRA,7520) N,PHFRAF(NGFAC,1),PHFRAF(NGFAC,2), & PHFRAF(NGFAC,3),PHFRAF(NGFAC,4) 7530 CONTINUE C C WRITE(NFECRA,7600) NFPERA WRITE(NFECRA,7610) DO 7630 N=1,NFPERA NGFAC = NGFPER(N) WRITE(NFECRA,7620) N,PHFRAE(NGFAC,1),PHFRAE(NGFAC,2), & PHFRAE(NGFAC,3),PHFRAE(NGFAC,4) 7630 CONTINUE C ENDIF C C-------- C FORMATS C-------- C 7000 FORMAT(/,' *** LIMRAY : IMPRESSION DES CONDITIONS AUX LIMITES', & ' DE TYPE RAYONNEMENT TRANSPARENT CONFINE') 7100 FORMAT(/,' Nombre de bandes spectrales definies',I2) 7120 FORMAT(/,' Bande spectrale :',I2,' Lamda_1 = ',E13.5, & ' Lamda_2 = ',E13.5) 7210 FORMAT(/,' Valeur des emissivites pour la bande : ',I2) 7220 FORMAT(/,' Numero de la facette - valeur de l''emissivite ') 7230 FORMAT('(',I6,' - ',G10.3,')') 7300 FORMAT(/,' Nombre de facette avec temperature imposee : ',I5) 7310 FORMAT(/,' Numero de la facette - valeur de la', & ' temperature imposee') 7320 FORMAT('(',I6,' - ',G10.3,')') 7410 FORMAT(/,' Nombre de facette avec Flux impose : ',I5) 7415 FORMAT(/,' Valeur des flux imposes pour la bande : ',I2) 7420 FORMAT(/,' Numero de la facette - valeur du flux impose') 7430 FORMAT('(',I6,' - ',G10.3,')') 7500 FORMAT(/,' Nombre de facette paroi equivalente couple au', & ' fluide : ',I5) 7510 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7520 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) 7600 FORMAT(/,' Nombre de facette paroi equivalente isolee : ',I5) 7610 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7620 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/verif_c3d.c0000666000175000017500000003613511524070644015764 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "abs.h" # include "const.h" # include "tree.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | verif_coor_3d | | Ce sousprogramme est charge de generer de faire des | | verifications un peu subtile lorsqu'on dispose d'un | | maillage implicite | |======================================================================| */ void verif_coor_3d (int ndim,int nelray,int npoinr, int *nodray, double *cooray,int nplasy,double *plasym, int nperay,double *perray, int nblblr,double taille_seg) { int *nfabor; int *nborglo,nnobor; nfabor = (int *)malloc(3*nelray * sizeof(int)); nborglo = (int *)malloc(npoinr * sizeof(int)); if (nfabor==NULL || nborglo==NULL) {printf(" ERREUR verif_coor_3d : probleme d'allocation memoire\n"); exit(0);} veri_fbor_3d(ndim,nelray,npoinr,nodray,nfabor); veri_nbor_3d(ndim,nelray,npoinr,nodray,nfabor,&nnobor,nborglo,nblblr); if (nplasy != 0) veri_sym_3d(ndim,nnobor,npoinr,nborglo,cooray,nplasy,plasym, nblblr,taille_seg); /* if (nperay>0) veri_per_3d(ndim,nnobor,npoinr,nborglo,cooray,nperay,perray); */ free(nfabor); free(nborglo); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | veri_fbor_3d | | Ce sousprogramme est charge de generer de faire des | | verifications un peu subtile lorsqu'on dispose d'un | | maillage implicite | |======================================================================| */ void veri_fbor_3d (int ndim,int nelray,int npoinr, int *nodray,int *nfabor) { int i; int is1,is2,isad,js1,js2; int iso1,iso2,jso1,jso2; int nmemax,nelep1,ip,ip1; int ipmax,ipmin; int nel,neli,nelj; int ifac,ifaci,ifacj; int ifauxi,ifauxj; int somfac[6]; int *iadr,*itrav; nmemax = nelray * 3 + 2 * npoinr; nelep1 = nelray + 1; ipmin = 2 * npoinr+1; ip = 2 * npoinr; somfac[0] = 0; somfac[1] = 1; somfac[2] = 1; somfac[3] = 2; somfac[4] = 2; somfac[5] = 0; iadr = (int *)malloc(nmemax * sizeof(int)); itrav = (int *)malloc(nmemax * sizeof(int)); if (iadr==NULL || itrav==NULL) {printf(" ERREUR veri_fbor_3d : probleme d'allocation memoire\n"); exit(0);} for (i=0; i < nmemax ; i++) *(iadr+i) = -1 ; for (i=0; i < nmemax ; i++) *(itrav+i) = 0 ; for (i=0; i < 3* nelray ; i++) *(nfabor+i) = 0 ; for ( ifac=0;ifac<3;ifac++) { for ( nel=0;nel=ipmin;i-= 1) { ifauxi = iadr[i]; ifaci = ifauxi/nelep1; neli = ifauxi-ifaci*nelep1; /* On teste si les cases sont deja remplies */ if (nfabor[neli + ifaci* nelray] != 0) continue; is1 = nodray[neli + nelray *somfac[2*ifaci]]; is2 = nodray[neli + nelray *somfac[2*ifaci+1]]; if ( is1= ipmin ) { ip1 = itrav[ip1]; ifauxj = iadr[ip1]; ifacj = ifauxj/nelep1; nelj = ifauxj-ifacj*nelep1; js1 = nodray[nelj + nelray *somfac[2*ifacj]]; js2 = nodray[nelj + nelray *somfac[2*ifacj+1]]; if ( js10) *nnobor += 1; printf("\n *** VERI_NBOR_3D : On compte %d noeuds de bord \n",*nnobor); ibor = 0; i = 0 ; while (i10) for(i=0;i<*nnobor;i++) printf(" VERI_NBOR_3D : nborloc %d numglobal %d \n",i,nborglo[i]); free(itrav); } /*|======================================================================| | SYRTHEL 0.0 FEVR 95 COPYRIGHT EDF/SIMULOG 1995| |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | veri_nbor_3d.c | | Codage des noeuds frontiere | | | |======================================================================| */ void veri_sym_3d (int ndim,int nnobor,int npoinr,int *nborglo,double *cooray, int nplasy,double *plasym,int nblblr,double taille_seg) { int i,jc,jnc,n,ng; double a,b,c,d,e,t[4][4]; double x,y,z,epssup,epsmin; double alfa,epsil; epssup = 0.001; epsmin = 0.00001; epsil =taille_seg*0.001; for (i=0;i epsmin) { printf("\n VERI_SYM_3D : Probleme sur les coordonnees du maillage: noeud %d distance %f \n",ng+1,tnor); cooray[ng] = (x+xtr)/2.; cooray[ng+npoinr] = (y+ytr)/2.; cooray[ng+npoinr*2] = (z+ztr)/2.; } } */ /* nouvelle technique chris du 6/03/98 par projection */ for (n=0,jc=jnc=0;n eps) { an = sqrt(ax*ax+ay*ay); phi = atan2(ay,ax); theta = atan2(az,an) ; c = cos(phi) ; s = sin(phi) ; c2 = cos(theta) ; s2 = sin(theta); } else if (abs(ay) > eps) { an = sqrt(ax*ax+ay*ay); theta = atan2(az,an) ; c = 0. ; s = 1. ; c2 = cos(theta) ; s2 = sin(theta) ; } else { c =1 ; s = 0 ; c2 = 0 ; s2 = 1 ; } aa = c2*c ; bb = -c2*s ; cc = s2 ; dd = cos(angle)*s+sin(angle)*s2*c ; ee = cos(angle)*c-sin(angle)*s*s2 ; ff = -sin(angle)*c2 ; gg = sin(angle)*s-cos(angle)*s2*c ; hh = sin(angle)*c+cos(angle)*s*s2 ; ii = cos(angle)*c2 ; t[0][0] = aa*aa+s*dd-c*s2*gg; t[1][1] = -s*c2*bb+c*ee+s*s2*hh; t[2][2] = s2*cc+c2*ii; t[1][0] = -s*c2*aa+c*dd+s*s2*gg; t[0][1] = aa*bb+s*ee-c*s2*hh; t[2][0] = s2*aa+c2*gg; t[0][2] = aa*cc+s*ff-c*s2*ii; t[2][1] = s2*bb+c2*hh; t[1][2] = -s*c2*cc+c*ff+s*s2*ii; t[3][0] = t[3][1] = t[3][2] = 0.; t[0][3]= px ; t[1][3]= py ; t[2][3]= pz ; t[3][3]=1; for (n=0;n= 0) { ng = nborglo[n]; x = *(cooray+ng); y = *(cooray+ng+npoinr); z = *(cooray+ng+npoinr*2); for (i=0;i=0) { nga = nborglo[i]; xa = *(cooray+nga); ya = *(cooray+nga+npoinr); za = *(cooray+nga+npoinr*2); xtper = t[0][0]*xa+t[0][1]*ya+t[0][2]*za + t[0][3]; ytper = t[1][0]*xa+t[1][1]*ya+t[1][2]*za + t[1][3]; ztper = t[2][0]*xa+t[2][1]*ya+t[2][2]*za + t[2][3]; tnorm = sqrt((xtper-x)*(xtper-x)+(ytper-y)*(ytper-y)+(ztper-z)*(ztper-z)); if (tnorm <= epsmin) { nborglo[n] = -nborglo[n]; if (i!= n) { nborglo[i] = -nborglo[i]; nincha +=2; cooray[ng] = xtper; cooray[ng+npoinr] = ytper; cooray[ng+npoinr*2] = ztper; } else nincha +=1 ; } if(tnorm < epssup && tnorm > epsmin) { cooray[ng] = xtper; cooray[ng+npoinr] = ytper; cooray[ng+npoinr*2] = ztper; nborglo[n] = -nborglo[n]; if (i!=n) nborglo[i] = -nborglo[i]; nmodif += 1; printf(" Probleme maillage : noeud %d noeud %d distance en mm %f \n", ng+1,nga+1,tnorm*1e3); } } } printf("\n VERI_PER_3D : Nombre de noeuds satisfaisant la transformation de periodicite %d \n",nincha); if (nmodif>0) printf("\n VERI_PER_3D : Nombre de noeuds modifies pour satisfaire la transformation %d \n",nmodif); ntest = 0; for (n=0;n> ivoitj_2d : test d'intersection : *intersect %d *arrivee %d\n", *intersect,*arrivee);*/ /* if (!( *intersect || *arrivee ||(noeud->name==noeud_arr->name) )) */ if (!( *intersect || *arrivee ||(noeud==noeud_arr) )) { voxel_voisin_2d(&xv,&yv,noeud->xc,noeud->yc, noeud->sizx,noeud->sizy, ro,rd,pt_arr,size_min); if (abs(rd[0])> ivoitj_2d : on sort par rd nul\n"); */ } else { noeud = arbre; find_node_2d(&noeud,xv,yv); if (in_rectan(xv,yv,dim_boite[0],dim_boite[1],dim_boite[2],dim_boite[3])) ivoitj_2d(arbre,noeud,noeud_arr,ro,rd,pt_arr,intersect,size_min, nelray,npoinr,nodray,cooray,arrivee,dim_boite); else { *intersect=0; /* printf(" >> ivoitj_2d : on est sorti de la boite noeud->name= %d\n",noeud->name); */ } } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | ray_inter_seg | | detection de l'intersection entre un rayon et un segment | |======================================================================| */ int ray_inter_seg(struct node *arbre,struct node *n_en_cours, int numel,double ro[],double rd[], int npoinr,int nelray,int *nodray,double *cooray, int *arrivee) { int nelray2,npoinr2,na,nb,i,j; double xa,ya,xb,yb; double a,b,c,t,den,epsi,xp,yp; struct node *noeud; epsi=1.E-6; npoinr2 = npoinr*2; nelray2 = nelray*2; na = *(nodray+numel-1); nb = *(nodray+numel-1+nelray); xa= *(cooray+na-1); ya= *(cooray+na-1+npoinr); xb= *(cooray+nb-1); yb= *(cooray+nb-1+npoinr); a = ya-yb; b = xb-xa; c = -(a*xa+b*ya); den = a*rd[0]+b*rd[1]; /* printf( " den %f \n",den);*/ if (abs(den)(1+epsi)) return(0); xp = ro[0]+t*rd[0]; yp = ro[1]+t*rd[1]; if (in_seg(xa,ya,xb,yb,xp,yp)) { if (abs(t-1.)name); */ for (i=-1;i<2;i=i+2) for (j=-1;j<2;j=j+2) { noeud = arbre; find_node_2d(&noeud,xp+epsi*i,yp+epsi*j); /* printf("i,j,k,noeud->name n_en_cours %d %d %d %d xp yp %f %f \n", i,j,k,noeud->name,n_en_cours,xp,yp); */ if (noeud == n_en_cours) {*arrivee = 1;} } return(0); } else return(numel); } else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | voxel_voisin_2d | | Recherche du voxel voisin | |======================================================================| */ void voxel_voisin_2d (double *xv,double *yv,double xc, double yc, double dx,double dy, double ro[], double rd[], double pt_arr[], double size_min) { int it; double t,tt[2],orient[2],xpi,ypi,ddx,ddy,size,epsv,xn; size = size_min/4.; epsv=1.E-6; if (abs(rd[0])tt[0]) {tt[0]=t; orient[0] = -1.;} /* plan x=xc-dx */ } if (abs(rd[1])tt[1]) {tt[1]=t; orient[1] = -1.;} /* plan y=yc-dy */ } it = 0; t=tt[0]; if (tt[1]>> ivoitj_2d : intersection avec boite %f %f %f \n",xpi,ypi,zpi); */ } syrthes-3.4.3-dfsg1/src/s/inomct.F0000666000175000017500000001203611524070644015346 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=INOMCT,SSI=0 C ***************** SUBROUTINE INOMCT C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : C ---------- C C INITIALISATION DES NOMS DES FICHIERS DE SYRTHES C C C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! ! ! ! ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /PORTAG/ ! ! D ! ! C ! /NOMFIC/ ! ! R ! TOUTES LES VARIABLES ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ENVFCT C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISO1 C----------------------------------------------------------------------- C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "divct.h" #include "fichct.h" C C*********************************************************************** c C ====================================== C 1- INITIALISATIONS DES NOMS PAR DEFAUT C ====================================== C C++ VERSION VAX/VMS CC RAMON = ' ' CC RAMON = '[]' C C++ VERSIONS UNIX HP, CRAY RAMON = ' ' RAMON = './' C RAVAL = ' ' RAVAL = RAMON C RSUITE = ' ' RSUITE = RAMON C CTCL = ' ' CTCL = 'syrthes.data' C CTMAEF = ' ' CTMAEF = 'geom_ef' C CTGRF1 = ' ' CTGRF1 = 'geoms' C CTGRF2 = ' ' CTGRF2 = 'resus' C CTGF2C = ' ' CTGF2C = 'chronos' C CTMAEF = ' ' CTMAEF = 'solide.des' C CTCORR = ' ' CTCORR = 'corresp' C CTSUIT = ' ' CTSUIT = 'suit_sol' C CTGEOF = ' ' CTGEOF = 'geomf_ef' C CTRESF = ' ' CTRESF = 'resuf_ef' C CTCHOF = ' ' CTCHOF = 'chronof_ef' C CTHISR = ' ' CTHISR = 'histos' C CTCORR = ' ' CTCORR = 'corresp' C CTCLRA = ' ' CTCLRA = 'syrthes.ray' C CTGERA = ' ' CTGERA = 'ray.des' C CTRGRA = ' ' CTRGRA = 'resu_ray.geom' C CTRRRA = ' ' CTRRRA = 'resu_ray' C CTRCRA = ' ' CTRCRA = 'chrono_ray' C CTFFRA = ' ' CTFFRA = 'fdf_ray' C CTCORA = ' ' CTCORA = 'corresp_ray' C CTHIRA = ' ' CTHIRA = 'histor' C C ============================ C 2- LECTURE DU FICHIER envfic C ============================ C CALL ENVFCT C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ov.F0000666000175000017500000002375211524070644014510 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=OV,SSI=0 C SUBROUTINE OV C ************* C C ----------------------- *( OP,X,Y,Z,C,NPOINS ) C ----------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- OPERATIONS SUR LES VECTEURS * C * C OP est une chaine de 8 caracteres qui indique * C l'ordre des operations effectuee sur les vecteurs * C X,Y,Z et la constante C. Le resultat est dans le * C vecteur X. * C * C OP = 'X=C ' : X mis a la valeur C * C OP = 'X=Y ' : Y copie dans X * C OP = 'X=1/Y ' : Inverse de Y mis dans X * C OP = 'X=1/X ' : Inverse de X mis dans X * C OP = ' * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! OP ! A ! D ! DEFINITION DU TYPE D'OPERATION ! C ! X ! TR ! M ! VECTEUR RESULTAT ! C ! Y ! TR ! D ! VECTEUR OPERANDE ! C ! Y ! TR ! D ! VECTEUR OPERANDE ! C ! C ! R ! D ! CONSTANTE ! C ! NPOINS ! E ! D ! NOMBRE DE POINTS DES VECTEURS ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "nlofes.h" C C*********************************************************************** INTEGER NPOINS C DOUBLE PRECISION X(NPOINS),Y(NPOINS),Z(NPOINS) DOUBLE PRECISION C CHARACTER*8 OP C C variables internes INTEGER I DOUBLE PRECISION EPSMAC C C*********************************************************************** C C INITIALISATIONS C =============== C EPSMAC = 1.D-30 C C CALCUL SUR LES VECTEURS C ======================= C IF ( OP(1:8).EQ.'X=C ') THEN DO 10 I=1,NPOINS X(I) = C 10 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=Y ') THEN DO 20 I=1,NPOINS X(I) = Y(I) 20 CONTINUE C C ------------------------------------------------------------------ C Il faut tester si y n'est pas nul (a faire) C ELSEIF ( OP(1:8).EQ.'X=1/Y ') THEN DO 30 I=1,NPOINS IF (ABS(Y(I)) .GT. EPSMAC) THEN X(I) = 1.D0 / Y(I) ELSE WRITE(NFECRA,*) * 'probleme de division par zero dans ov N=',i,' Y=',Y(I) ENDIF 30 CONTINUE C C ------------------------------------------------------------------ C Il faut tester si x n'est pas nul (a faire) C ELSEIF ( OP(1:8).EQ.'X=1/X ') THEN DO 40 I=1,NPOINS IF (ABS(X(I)) .GT. EPSMAC) THEN X(I) = 1.D0 / X(I) ELSE WRITE(NFECRA,*) * 'probleme de division par zero dans ov N=',i,' X=',X(I) ENDIF 40 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=Y+Z ') THEN DO 50 I=1,NPOINS X(I) = Y(I) + Z(I) 50 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=Y-Z ') THEN DO 60 I=1,NPOINS X(I) = Y(I) - Z(I) 60 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=YZ ') THEN DO 70 I=1,NPOINS X(I) = Y(I) * Z(I) 70 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=XY ') THEN DO 80 I=1,NPOINS X(I) = X(I) * Y(I) 80 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X+YZ ') THEN DO 90 I=1,NPOINS X(I) = X(I) + Y(I) * Z(I) 90 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X-YZ ') THEN DO 100 I=1,NPOINS X(I) = Y(I) * Z(I) 100 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=XY ') THEN DO 110 I=1,NPOINS X(I) = X(I) * Y(I) 110 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X-YZ ') THEN DO 120 I=1,NPOINS X(I) = X(I) - Y(I) * Z(I) 120 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X+CYZ ') THEN DO 130 I=1,NPOINS X(I) = X(I) + C * Y(I) * Z(I) 130 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=Y/Z ') THEN DO 140 I=1,NPOINS IF (ABS(Z(I)) .GT. EPSMAC) THEN X(I) = Y(I) / Z(I) ELSE WRITE(NFECRA,*) 'probleme de division par zero dans ov' STOP ENDIF 140 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X+Y ') THEN DO 150 I=1,NPOINS X(I) = X(I) + Y(I) 150 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X-Y ') THEN DO 160 I=1,NPOINS X(I) = X(I) - Y(I) 160 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=CX ') THEN DO 170 I=1,NPOINS X(I) = C * X(I) 170 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=CY ') THEN DO 180 I=1,NPOINS X(I) = C * Y(I) 180 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=X+CY ') THEN DO 190 I=1,NPOINS X(I) = X(I) + C * Y(I) 190 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=SQR(Y)') THEN DO 200 I=1,NPOINS X(I) = SQRT( Y(I) ) 200 CONTINUE C C ------------------------------------------------------------------ C ELSEIF ( OP(1:8).EQ.'X=Y+CZ') THEN DO 210 I=1,NPOINS X(I) = Y(I) + C * Z(I) 210 CONTINUE C C ------------------------------------------------------------------ C ELSE WRITE ( NFECRA,1000 ) OP STOP ENDIF C C************************************************************************ C FORMATS C------------------------------------------------------------------------ C 1000 FORMAT( / ,' %% ERREUR OV : OPERATION INCONNUE ', A8 ) C RETURN END syrthes-3.4.3-dfsg1/src/s/limres.F0000666000175000017500000001434611524070644015356 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LIMRES,SSI=0 SUBROUTINE LIMRES C ***************** C C ----------------------------------------------------------- * (NDIM,NPOINS,NBRESS,NRESCS,VRESCS, * NODERC,VFRESC,NELERC,NDMASS,TMPSA,ITRAV1) C ----------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C MISE A JOUR DES CONDITIONS AUX LIMITES POUR LE TRAITEMENT * C DES RESISTANCES DE CONTACT * C On rappelle que les resistances de contact sont traitees * C comme une condition a la limite du type coefficient * C d'echange. L'utilisateur donne la valeur de la resistance,* C le programme retrouve le temperature sur la face opposee * C L'objet de se sous-programme est justement de mettre * C a jour cette temperature "exterieure" en realite issue * C de l'autre face solide. * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NBRESS ! E ! D ! NOMBRE DE NOEUDS AVEC RESISTANCE DE CONTACT ! C ! NRESCS ! TE ! D ! NUMERO DES NOEUDS AVEC RESISTANCE DE CONTACT ! C ! VRESCS ! TR ! M ! VALEUR DE LA RESISTANCE ! C ! NODERC ! TE ! D ! TABLE DES ELEMENTS SURF AVEC REST DE CONTACT ! C ! VFRESC ! TR ! M ! RESISTANCES CONTACT SUR LES FACES ! C ! NELERC ! E ! D ! NOMBRE D'ELETS AVEC RESTANCE DE CONTACT ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS AVEC RESIST ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! ITRAV1 ! TE ! A ! TABLEAU DE TRAVAIL ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBRESS,NRESCS(NBRESS,2) INTEGER NELERC,NDMASS DOUBLE PRECISION TMPSA(NPOINS) DOUBLE PRECISION VRESCS(NBRESS,2),VFRESC(NELERC,NDMASS,2) INTEGER NODERC(NELERC,NDMASS) INTEGER ITRAV1(NPOINS) C C.. Variables internes INTEGER N,M,NG,NL,NGC,NLC C C*********************************************************************** C C 1- CAS DES CL SUR LES NOEUDS C ============================ C IF (.NOT. LCFACE) THEN C DO 100 N=1,NBRESS C IF (NRESCS(N,2).NE.-1) THEN VRESCS(N,1) = TMPSA( NRESCS(NRESCS(N,2),1) ) ENDIF C 100 CONTINUE C C 2- CAS DES CL SUR LES FACES C =========================== C ELSE C C DO 210 N=1,NPOINS ITRAV1(N) = 0 210 CONTINUE C DO 211 N=1,NBRESS ITRAV1(NRESCS(N,1)) = N 211 CONTINUE C C DO 220 N=1,NELERC DO 221 M=1,NDMASS C NG = NODERC(N,M) NL = ITRAV1(NG) NLC = NRESCS(NL,2) NGC = NRESCS(NLC,1) IF (NLC.NE.-1) THEN VFRESC(N,M,1) = TMPSA(NGC) ENDIF C 221 CONTINUE 220 CONTINUE C C ENDIF C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/secide.F0000666000175000017500000001076411524070644015317 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SECIDE,SSI=0 SUBROUTINE SECIDE C ***************** C C -------------- *(NFIC,NUMSEC) C -------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C POSITIONNEMENT SUR UNE SECTION DONNEE DU FICHIER IDEAS * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C ! NUMSEC ! E ! D ! NUMERO DE LA SECTION RECHERCHEE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NUMSEC,NFIC C C.. Variables internes INTEGER N CHARACTER*6 CH C C*********************************************************************** C C C 0- INITIALISATIONS C ================== C REWIND (NFIC) C C 1- PARCOURS DU FICHIER C ====================== C 10 READ(NFIC,1000,ERR=99,END=99) CH IF (CH .NE. ' -1') GOTO 10 C 20 READ(NFIC,*,ERR=99,END=99) N IF(N.EQ.-1) THEN GOTO 20 ELSEIF (N .NE. NUMSEC) THEN GOTO 10 ENDIF C RETURN C C 2- ERREURS C ========== C 99 CONTINUE WRITE(NFECRA,2000) NUMSEC STOP C C C-------- C FORMATS C-------- C 1000 FORMAT(A6) 2000 FORMAT(' %% ERREUR SECIDE : LE FICHIER IDEAS EST INCORRET',/, & 21X,'LA SECTION ',I6,' EST INTROUVABLE ') C C END syrthes-3.4.3-dfsg1/src/s/leclim.F0000666000175000017500000016275211524070644015335 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECLIM C ***************** C * ( NDIM,NPOINS,NELEMS,NREFS,NREFE, * TMPSA,TMPS,TMPSC1,TMPSC2,TMPSC3,COORDS, * NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS, * NBECHS,NECHS,VECHS,NBFLVS,NPFEL,NFLUVS,VFLUVS, * NBRESS,NRESCS,VRESCS, * NBPRIO,NBCOPR,NPRIOS,NBMOBS,NMOBIL, * NPOUE,NPPEL,NBPHYS,PHYSOL, * NDMASS,NREFAL,NELEUS,NFFLUS,VFFLUS,NBFFLU, * NFECHS,VFECHS,NBFECH,NFRESC,VFRESC,NELERC,NELERA, * NBRAIS,NRAYIS,VRAYIS,NBFRAI,NFRAIS,VFRAIS, * ITRAV,ITRAV1,ITRAV2,TRAV1,TRAV2,TRAV3) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- LECTURE ET INTERPRETATION DU FICHIER syrthes.data * C Lecture des CL et donnees physiques * C Il peut contenir (quand les valeurs sont constantes) : * C - les valeurs des CL * C - les proprietes physiques * C - les flux volumiques * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/XREFER/! ! D ! ! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C ! FONCTIONS IMPLICITES ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : POSCOT,POSREE,POSLIS,CCONDI C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "mobil.h" #include "xrefer.h" #include "nlofes.h" #include "nlofct.h" #include "divct.h" #include "regul.h" C C********************************************************************** C INTEGER NVV PARAMETER (NVV=12) C C..Variables externes INTEGER NDIM,NPOINS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL,NBRESS INTEGER NELERA,NPOUE,NPPEL,NELEMS INTEGER NBPHYS,NBPRIO,NBCOPR,NPRIOS(NBPRIO,1+NBCOPR) INTEGER NREFS(NPOINS),NREFE(NELEMS) INTEGER NFLUSS(NBFLUS),NDIRS(NBDIRS),NECHS(NBECHS) INTEGER NFLUVS(NBFLVS),NRESCS(NBRESS,2) INTEGER NBMOBS,NMOBIL(NBMOBS,2) INTEGER NDMASS,NELEUS,NBFFLU,NBFECH,NELERC INTEGER NREFAL(NELEUS),NFFLUS(NBFFLU) INTEGER NFECHS(NBFECH),NFRESC(NELERC) INTEGER NBRAIS,NRAYIS(NBRAIS),NBFRAI,NFRAIS(NBFRAI) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS),TMPSC3(NPOINS) DOUBLE PRECISION VFLUSS(NBFLUS),VDIRS(NBDIRS),VECHS(NBECHS,2) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL),VRESCS(NBRESS,2) DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS) DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VRAYIS(NBRAIS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) INTEGER ITRAV(NPOINS),ITRAV1(NPOINS),ITRAV2(NPOINS) DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS),TRAV3(NPOINS) C C..Variables internes INTEGER I,I1,I2,N,LCH,II1,II2,NB,M,J,NPS INTEGER ITAB(NRFMAX) CHARACTER*200 CHAINE,FORMA CHARACTER*1 CTYP DOUBLE PRECISION VAL,VAL1,VAL2,XK,YK,ZK DOUBLE PRECISION VV(NVV) LOGICAL ERR C C********************************************************************** C C 0- INITIALISATIONS C ================== ERR = .FALSE. REWIND (NFCLCT) NPS = 0 NBHSOL=0 C C 0.1- CONDITION DE TYPE FLUX : PAR DEFAUT FLUX NUL C ------------------------------------------------- C IF (LCFACE) THEN DO 111 N=1,NBFFLU DO 112 J=1,NDMASS VFFLUS(N,J) = 0.D0 112 CONTINUE 111 CONTINUE ELSE DO 110 N=1,NBFLUS VFLUSS(N) = 0.D0 110 CONTINUE ENDIF C C 0.2- CONDITION DE TYPE DIRICHLET : PAR DEFAUT 20 C C -------------------------------------------------- DO 120 N=1,NBDIRS VDIRS(N) = 20.D0 120 CONTINUE C C 0.3- CONDITION DE TYPE COEFFICIENT D'ECHANGE : C PAR DEFAUT 20 C ET UN COEFFICIENT H=0. C ----------------------------------------------- C IF (LCFACE) THEN DO 131 N=1,NBFECH DO 132 J=1,NDMASS VFECHS(N,J,1) = 20.D0 VFECHS(N,J,2) = 0.D0 132 CONTINUE 131 CONTINUE ELSE DO 130 N=1,NBECHS VECHS(N,1) = 20.D0 VECHS(N,2) = 0.D0 130 CONTINUE ENDIF C C C 0.4- CONDITION DE RESISTANCE DE CONTACT : C PAR DEFAUT 20 C ET UN COEFFICIENT H=0. C ------------------------------------------- C IF (LCFACE) THEN DO 141 N=1,NELERC DO 142 J=1,NDMASS VFRESC(N,J,1) = 20.D0 VFRESC(N,J,2) = 0.D0 142 CONTINUE 141 CONTINUE ELSE DO 140 N=1,NBRESS VRESCS(N,1) = 20.D0 VRESCS(N,2) = 0.D0 140 CONTINUE ENDIF C C C 0.6- INITIALISATIONS DES CARACTERISTIQUES PHYSIQUES C --------------------------------------------------- C IF (NCTHFS.EQ.2) THEN DO 160 M=1,NPPEL DO 161 N=1,NPOUE PHYSOL(N,M,1) = 7700. PHYSOL(N,M,2) = 460. PHYSOL(N,M,3) = 25.1 PHYSOL(N,M,4) = 25.1 PHYSOL(N,M,5) = 0. PHYSOL(N,M,6) = 0.01 161 CONTINUE 160 CONTINUE ELSE DO 162 M=1,NPPEL DO 163 N=1,NPOUE PHYSOL(N,M,1) = 7700. PHYSOL(N,M,2) = 460. IF (ISOTRO.EQ.1) THEN PHYSOL(N,M,3) = 25.1 ELSEIF (ISOTRO.EQ.2) THEN PHYSOL(N,M,3) = 25.1 PHYSOL(N,M,4) = 25.1 IF (NDIM.EQ.3) PHYSOL(N,M,5) = 25.1 ELSEIF (ISOTRO.EQ.3) THEN IF (NDIM.EQ.2) THEN PHYSOL(N,M,3) = 25.1 PHYSOL(N,M,4) = 25.1 PHYSOL(N,M,5) = 0. ELSE PHYSOL(N,M,3) = 25.1 PHYSOL(N,M,4) = 25.1 PHYSOL(N,M,5) = 25.1 PHYSOL(N,M,6) = 0. PHYSOL(N,M,7) = 0. PHYSOL(N,M,8) = 0. ENDIF ENDIF 163 CONTINUE 162 CONTINUE ENDIF C C 0.7- INITIALISATION DU CHAMP DE TEMPERATURE C ------------------------------------------- C DO 170 N=1,NPOINS TMPS(N) = 20.D0 TMPSA(N) = 20.D0 170 CONTINUE C IF (NCTHFS.EQ.2) THEN DO 171 N=1,NPOINS TMPSC1(N) = 20.D0 TMPSC2(N) = 0.D0 TMPSC3(N) = 0.D0 171 CONTINUE ENDIF C C C 0.8-CORRESPONDANTS NOEUDS PERIODIQUES C ------------------------------------- DO 180 N=1,NBPRIO DO 181 M=1,NBCOPR NPRIOS(N,M+1) = 0 181 CONTINUE 180 CONTINUE C C 0.9-SOLIDES MOBILES C ------------------- TMOB = 20. XLMOB = 0. C IF (LSDEPL) THEN DO 190 N=1,NRFMAX IREFMO (N) = 0 190 CONTINUE ENDIF C C 0.10- RAYONNEMENT INFINI C ------------------------ IF (LCFACE) THEN DO 200 N=1,NBFRAI DO 201 J=1,NDMASS VFRAIS(N,J,1) = 20.D0 VFRAIS(N,J,1) = 1. 201 CONTINUE 200 CONTINUE ELSE DO 202 N=1,NBRAIS VRAYIS(N,1) = 20. VRAYIS(N,2) = 1. 202 CONTINUE ENDIF C C 0.11-TABLEAU DE TRAVAIL C ----------------------- DO 210 N=1,NPOINS ITRAV(N) = N 210 CONTINUE C IF (NBPRIO.GT.0) THEN DO 211 N=1,NPOINS ITRAV1(N) = 0 ITRAV2(N) = 0 TRAV1(N) = 0. TRAV2(N) = 0. TRAV3(N) = 0. 211 CONTINUE ENDIF C WRITE(NFECRA,*) C C ===================== C 1- LECTURE DU FICHIER C ===================== C REWIND(NFCLCT) C 10 CONTINUE C CHAINE = ' ' READ(NFCLCT,1000,END=999) CHAINE C IF (CHAINE (1:1) .EQ. '/') GOTO 10 C CALL POSCOT(CHAINE,I1,I2,LCH) C IF (I1 .EQ. 0) THEN C GOTO 10 C ELSE C C 1.1- Traitement des conditions aux limites C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ C IF (CHAINE(I1:I2) .EQ. 'CLIM') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.1.1- Traitement des Dirichlet C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'DIRICHLET') THEN IF (NBDIRS.EQ.0) THEN WRITE(NFECRA,1118) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONDI(VAL,NREFS,NPOINS,NDIRS,VDIRS,NBDIRS,ITAB,NB) IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1110) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.1.2- Traitement des flux C ~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'FLUX') THEN IF ( LCFACE .AND. NBFFLU.EQ.0 .OR. & .NOT.LCFACE .AND. NBFLUS.EQ.0) THEN WRITE(NFECRA,1128) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (LCFACE) THEN CALL CCONDF(VAL,NREFAL,NELEUS,NFFLUS,VFFLUS,NBFFLU, & NDMASS,ITAB,NB) ELSE CALL CCONDI(VAL,NREFS,NPOINS,NFLUSS,VFLUSS,NBFLUS, & ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1120) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.1.3- Traitement des coefficients d'echange C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'COEF ECH') THEN IF ( LCFACE .AND. NBFECH.EQ.0 .OR. & .NOT.LCFACE .AND. NBECHS.EQ.0) THEN WRITE(NFECRA,1138) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL1,VAL2 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (LCFACE) THEN CALL CCONDF(VAL1,NREFAL,NELEUS,NFECHS,VFECHS(1,1,1), & NBFECH,NDMASS,ITAB,NB) CALL CCONDF(VAL2,NREFAL,NELEUS,NFECHS,VFECHS(1,1,2), & NBFECH,NDMASS,ITAB,NB) ELSE CALL CCONDI(VAL1,NREFS,NPOINS,NECHS,VECHS(1,1), * NBECHS,ITAB,NB) CALL CCONDI(VAL2,NREFS,NPOINS,NECHS,VECHS(1,2), * NBECHS,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1130) VAL1,VAL2,(ITAB(I),I=1,NB) ENDIF ENDIF C C C 1.1.4- Traitement des resistances de contact C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'RES CONTACT') THEN IF (NCTHFS.EQ.2) THEN WRITE(NFECRA,1147) ERR = .TRUE. ELSEIF ( LCFACE .AND. NELERC.EQ.0 .OR. & .NOT.LCFACE .AND. NBRESS.EQ.0) THEN WRITE(NFECRA,1148) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL2 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (LCFACE) THEN CALL CCONDF(VAL2,NREFAL,NELEUS,NFRESC,VFRESC(1,1,2), & NELERC,NDMASS,ITAB,NB) ELSE CALL CCONDI(VAL2,NREFS,NPOINS,NRESCS,VRESCS(1,2), * NBRESS,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1140) VAL2,(ITAB(I),I=1,NB) ENDIF ENDIF C C C 1.1.6- Traitement de la periodicite C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'PERIODICITE') THEN IF (NBPRIO.EQ.0) THEN WRITE(NFECRA,1168) ERR = .TRUE. ELSE CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C IF (CHAINE(I1:I2).EQ.'T') THEN CTYP = 'T' CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,3) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL IPERIO(CTYP,VV,NVV,NBPRIO,NBCOPR,NDIM,NPOINS, & NPRIOS,NREFS,ITAB,NB, & COORDS,ITRAV1,ITRAV2,TRAV1,TRAV2,TRAV3) ELSEIF (CHAINE(I1:I2).EQ.'R') THEN CTYP = 'R' CALL POSREE(CHAINE(I2+2:),9,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,9,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,9) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL IPERIO(CTYP,VV,NVV,NBPRIO,NBCOPR,NDIM,NPOINS, & NPRIOS,NREFS,ITAB,NB, & COORDS,ITRAV1,ITRAV2,TRAV1,TRAV2,TRAV3) C ELSE WRITE(NFECRA,1161) CHAINE(I1:I2) ERR = .TRUE. ENDIF C ENDIF C C 1.1.7- Traitement du rayonnement infini C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'RAYT INFINI') THEN IF ( LCFACE .AND. NBFRAI.EQ.0 .OR. & .NOT.LCFACE .AND. NBRAIS.EQ.0) THEN WRITE(NFECRA,1178) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL1,VAL2 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (LCFACE) THEN CALL CCONDF(VAL1,NREFAL,NELEUS,NFRAIS,VFRAIS(1,1,1), & NBFRAI,NDMASS,ITAB,NB) CALL CCONDF(VAL2,NREFAL,NELEUS,NFRAIS,VFRAIS(1,1,2), & NBFRAI,NDMASS,ITAB,NB) ELSE CALL CCONDI(VAL1,NREFS,NPOINS,NRAYIS,VRAYIS(1,1), * NBRAIS,ITAB,NB) CALL CCONDI(VAL2,NREFS,NPOINS,NRAYIS,VRAYIS(1,2), * NBRAIS,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1170) VAL1,VAL2,(ITAB(I),I=1,NB) ENDIF ENDIF C C ELSE WRITE(NFECRA,1162) CHAINE(I1:I2) ERR = .TRUE. ENDIF C C 1.2- Traitement des flux volumiques C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'CVOL') THEN IF (NBFLVS.EQ.0) THEN WRITE(NFECRA,1728) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDFLUV.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,NFLUVS,VFLUVS(1,1), * NBFLVS,ITAB,NB) ELSE CALL CCONDV(VAL,NREFE,NELEMS,NFLUVS,VFLUVS, * NBFLVS,NPFEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1200) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.3- Traitement des conditions physiques C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'CPHY') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.3.1- Masse volumique C ~~~~~~~~~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'RHO') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,1), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,1), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1310) VAL,(ITAB(I),I=1,NB) ENDIF C C 1.3.2- Chaleur specifique C ~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'CP') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,2), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,2), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1320) VAL,(ITAB(I),I=1,NB) ENDIF C C 1.3.3- Conductivite isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'K ISOTROPE') THEN IF (NCTHFS.EQ.2) THEN WRITE(NFECRA,1337) ERR = .TRUE. ELSEIF (ISOTRO.NE.1) THEN WRITE(NFECRA,1338) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,3), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,3), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NCTHFS.EQ.2) THEN IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,4), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,4), * NELEMS,NPPEL,ITAB,NB) ENDIF ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1330) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.3.4- Conductivite orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'K ORTHOTROPE') THEN IF (NCTHFS.EQ.2) THEN WRITE(NFECRA,1347) ERR = .TRUE. ELSEIF (ISOTRO.NE.2) THEN WRITE(NFECRA,1348) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XK,YK,ZK II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(XK,NREFS,NPOINS,ITRAV,PHYSOL(1,1,3), * NPOINS,ITAB,NB) CALL CCONDI(YK,NREFS,NPOINS,ITRAV,PHYSOL(1,1,4), * NPOINS,ITAB,NB) ELSE CALL CCONDP(XK,NREFE,NELEMS,PHYSOL(1,1,3), * NELEMS,NPPEL,ITAB,NB) CALL CCONDP(YK,NREFE,NELEMS,PHYSOL(1,1,4), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NDIM.EQ.3) THEN IF (NDPROP.EQ.1) THEN CALL CCONDI(ZK,NREFS,NPOINS,ITRAV,PHYSOL(1,1,5), * NPOINS,ITAB,NB) ELSE CALL CCONDP(ZK,NREFE,NELEMS,PHYSOL(1,1,5), * NELEMS,NPPEL,ITAB,NB) ENDIF ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1340) XK,YK,ZK,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.3.5- Conductivite anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'K ANISOTROPE') THEN IF (NCTHFS.EQ.2) THEN WRITE(NFECRA,1357) ERR = .TRUE. ELSEIF (ISOTRO.NE.3) THEN WRITE(NFECRA,1358) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),6,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,6,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,6) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL ICONDU (VV,NVV,NDIM,NPOINS,NREFS, * ITAB,NB,NPOUE,NPPEL,NBPHYS,PHYSOL) ELSE CALL ICONDU (VV,NVV,NDIM,NELEMS,NREFE, * ITAB,NB,NPOUE,NPPEL,NBPHYS,PHYSOL) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1350) (VV(I),I=1,6),(ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C ELSE WRITE(NFECRA,1351) CHAINE(I1:I2) ERR = .TRUE. ENDIF C C 1.4- Conditions pour le modele coque C ^^^^^^^^^^^^^^^~^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'CCOQ') THEN C CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.4.1- Epaisseur de la coque C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'EPAISSEUR') THEN IF (NCTHFS.EQ.3) THEN WRITE(NFECRA,1418) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,6), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,6), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1410) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.4.2- Invariant de Gauss (1/R) C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'INVARIANT GAUSS') THEN IF (NCTHFS.EQ.3) THEN WRITE(NFECRA,1428) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL,NREFS,NPOINS,ITRAV,PHYSOL(1,1,5), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL,NREFE,NELEMS,PHYSOL(1,1,5), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1420) VAL,(ITAB(I),I=1,NB) ENDIF ENDIF C C 1.4.3- Conductivite selon la coque et l'epaisseur C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'K SELON COQUE ET EPAISSEUR') THEN IF (NCTHFS.EQ.3) THEN WRITE(NFECRA,1438) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL1,VAL2 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NDPROP.EQ.1) THEN CALL CCONDI(VAL1,NREFS,NPOINS,ITRAV,PHYSOL(1,1,3), * NPOINS,ITAB,NB) CALL CCONDI(VAL2,NREFS,NPOINS,ITRAV,PHYSOL(1,1,4), * NPOINS,ITAB,NB) ELSE CALL CCONDP(VAL1,NREFE,NELEMS,PHYSOL(1,1,3), * NELEMS,NPPEL,ITAB,NB) CALL CCONDP(VAL2,NREFE,NELEMS,PHYSOL(1,1,4), * NELEMS,NPPEL,ITAB,NB) ENDIF IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1430) VAL1,VAL2,(ITAB(I),I=1,NB) ENDIF ENDIF C ELSE WRITE(NFECRA,1440) CHAINE(I1:I2) ERR = .TRUE. ENDIF C C C 1.5- Traitement des solides mobiles C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'SMOB') THEN CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.5.1- Solide en rotation sur lui-meme C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'R') THEN IF (NBMOBS.EQ.0) THEN WRITE(NFECRA,1518) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),9,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,9,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,9) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CTYP = 'R' CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL IMOBIL(CTYP,VV,NVV,NBMOBS,NDIM,NPOINS,NMOBIL, * NREFS,ITAB,NB,COORDS) IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1510) (VV(I),I=1,9),(ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C C 1.5.2- Solide en translation C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'T') THEN IF (.NOT.LSDEPL) THEN WRITE(NFECRA,1528) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),4,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,4,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,4) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CTYP = 'T' CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NB.NE.1 .AND. ITAB(1).NE.-1) THEN WRITE(NFECRA,1529) STOP ENDIF TRXMOB = VV(1) TRYMOB = VV(2) TRZMOB = VV(3) TRNMOB = SQRT(TRXMOB*TRXMOB+TRYMOB*TRYMOB+TRZMOB*TRZMOB) VTRMOB = VV(4) IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1520) (VV(I),I=1,4),(ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C C 1.5.3- Solide en mobile : CL sur les noeuds non en C regard du fluide C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'CL NOEUDS ISOLES') THEN IF (.NOT.LSDEPL .AND. .NOT. LSROTA) THEN WRITE(NFECRA,1538) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),2,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,2,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (VV(I),I=1,2) II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CTYP = 'T' CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NB.NE.1 .AND. ITAB(1).NE.-1) THEN WRITE(NFECRA,1529) STOP ENDIF TMOB = VV(1) XLMOB = VV(2) IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1530) (VV(I),I=1,2),(ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C C 1.5.4- Solide en translation : temperature d'entree C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'TEMPERATURE ENTREE') THEN IF (.NOT.LSDEPL) THEN WRITE(NFECRA,1548) ERR = .TRUE. ELSE CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) IF (NB.NE.1 .AND. ITAB(1).NE.-1) THEN WRITE(NFECRA,1549) STOP ENDIF TENMOB = VAL IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1540) VAL,(ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C C 1.5.5- Solide en translation : ref des noeuds extremes C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'REFERENCES EXTREMITES') THEN IF (.NOT.LSDEPL) THEN WRITE(NFECRA,1548) ERR = .TRUE. ELSE II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) DO 155 I=1,NB IREFMO(ITAB(I)) = 1 155 CONTINUE IF (NBLBLA.GE.2) THEN WRITE(NFECRA,1550) (ITAB(I),I=1,NB) WRITE(NFECRA,*) ENDIF ENDIF C ELSE WRITE(NFECRA,1560) CHAINE(I1:I2) ERR = .TRUE. C ENDIF C C C 1.6- Traitement des conditions initiales C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'CINI') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) VAL1 II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) CALL CCONDI(VAL1,NREFS,NPOINS,ITRAV,TMPSA,NPOINS,ITAB,NB) CALL CCONDI(VAL1,NREFS,NPOINS,ITRAV,TMPS, NPOINS,ITAB,NB) IF (NCTHFS.EQ.2) * CALL CCONDI(VAL1,NREFS,NPOINS,ITRAV,TMPSC1,NPOINS,ITAB,NB) C C C 1.7- Traitement des historiques C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'HIST') THEN CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.7.1- Frequence C ~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'FREQ') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) XFREQS C C 1.7.2- Liste de noeuds C ~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'NOEUDS') THEN II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) IF (NB.GT.NRFMAX) THEN WRITE(NFECRA,1721) NRFMAX ERR=.TRUE. ENDIF I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (ITAB(I),I=1,NB) DO I=1,NB NHISOL(NBHSOL+I)=ITAB(I) ENDDO NBHSOL=NBHSOL+NB IF (NBHSOL.GT.NHSMAX) THEN WRITE(NFECRA,1722) NHSMAX ERR=.TRUE. ENDIF ENDIF C C C C 1.8- Traitement de la regulation C ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ELSEIF (CHAINE(I1:I2) .EQ. 'REGUL') THEN CALL POSCOT(CHAINE(I2+2:),II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 C C 1.8.1- Gain C ~~~~~~~~~~~~~~~~ IF (CHAINE(I1:I2) .EQ. 'GAIN') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) KC C C 1.8.2- CONSTANTES C ~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'CONSTANTES') THEN CALL POSREE(CHAINE(I2+2:),3,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,3,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) TIC,TDC,CN C C 1.8.3- TEMP DE REGUL C ~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'TEMP DE REGUL') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) TREG C C 1.8.4- NOEUD DE REGUL C ~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'NOEUD DE REGUL') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) NODREG C C 1.8.5- PUISSANCE C ~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'PUISSANCE') THEN CALL POSREE(CHAINE(I2+2:),1,II1,II2,LCH) I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('R',CHAINE(I1:I2),LCH,1,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) PUINOM C C 1.8.3- Liste des references C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ELSEIF (CHAINE(I1:I2) .EQ. 'REFERENCES') THEN II1 = I2+2 CALL POSLIS(CHAINE(I2+2:),NB,II1,II2,LCH) IF (NB.GT.NRRMAX) THEN WRITE(NFECRA,1821) NRRMAX ERR=.TRUE. ENDIF NBRREG=NB I1 = I2 + II1 + 1 I2 = I1 + LCH - 1 CALL CHFORM('I',CHAINE(I1:I2),LCH,NB,FORMA) READ(CHAINE(I1:I2),FORMA,ERR=9999) (NRREG(I),I=1,NB) ENDIF C C C ENDIF ENDIF C GOTO 10 C 999 CONTINUE C C STOP EN CAS D'ERREUR DANS LES MOTS-CLES C --------------------------------------- IF (ERR) STOP C IF (NBHSOL.EQ.0) LHISOL=.FALSE. C C 2- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.EQ.10) THEN C IF (LCFACE) THEN WRITE(NFECRA,2003) WRITE(NFECRA,*) NFFLUS WRITE(NFECRA,2002) WRITE(NFECRA,*) VFFLUS ELSE WRITE(NFECRA,2001) WRITE(NFECRA,*) NFLUSS WRITE(NFECRA,2002) WRITE(NFECRA,*) VFLUSS ENDIF C WRITE(NFECRA,2011) WRITE(NFECRA,*) NDIRS WRITE(NFECRA,2012) WRITE(NFECRA,*) VDIRS C IF (LCFACE) THEN WRITE(NFECRA,2024) WRITE(NFECRA,*) NFECHS WRITE(NFECRA,2022) WRITE(NFECRA,*) (VFECHS(N,1,1),N=1,NBFECH) WRITE(NFECRA,2023) WRITE(NFECRA,*) (VFECHS(N,1,2),N=1,NBFECH) ELSE WRITE(NFECRA,2021) WRITE(NFECRA,*) NECHS WRITE(NFECRA,2022) WRITE(NFECRA,*) (VECHS(N,1),N=1,NBECHS) WRITE(NFECRA,2023) WRITE(NFECRA,*) (VECHS(N,2),N=1,NBECHS) ENDIF C WRITE(NFECRA,2031) WRITE(NFECRA,*) (NRESCS(N,1),N=1,NBRESS) IF (LCFACE) THEN WRITE(NFECRA,2033) WRITE(NFECRA,*) NFRESC WRITE(NFECRA,2032) WRITE(NFECRA,*) (VFRESC(N,1,2),N=1,NELERC) ELSE WRITE(NFECRA,2032) WRITE(NFECRA,*) (VRESCS(N,2),N=1,NBRESS) ENDIF C WRITE(NFECRA,2051) WRITE(NFECRA,*) NFLUVS WRITE(NFECRA,2052) WRITE(NFECRA,*) VFLUVS C WRITE(NFECRA,2061) WRITE(NFECRA,*) NPOINS WRITE(NFECRA,2062) WRITE(NFECRA,*) ((PHYSOL(N,M,1),M=1,NPPEL),N=1,NPOUE) C WRITE(NFECRA,2071) WRITE(NFECRA,*) NPOINS WRITE(NFECRA,2072) WRITE(NFECRA,*) ((PHYSOL(N,M,2),M=1,NPPEL),N=1,NPOUE) C WRITE(NFECRA,2081) WRITE(NFECRA,*) NPOINS WRITE(NFECRA,2082) WRITE(NFECRA,*) NBPHYS-2 WRITE(NFECRA,2083) WRITE(NFECRA,*) ((PHYSOL(N,M,3),M=1,NPPEL),N=1,NPOUE) C C ENDIF C GOTO 300 C C 3. Erreur de lecture sur le fichier C =================================== 9999 WRITE(NFECRA,3000) CHAINE STOP C 300 CONTINUE C-------- C FORMATS C-------- 1000 FORMAT(A200) C 1110 FORMAT(/,' *** LECLIM : Condition de Dirichlet',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1120 FORMAT(/,' *** LECLIM : Condition de type flux',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1130 FORMAT(/,' *** LECLIM : Condition de type coefficient ', * 'd''echange',/, * 14X,'Temperature : ',E12.5,4X,'Coefficient : ',E12.5,/, * 14X,'References : ',32I3) 1140 FORMAT(/,' *** LECLIM : Resistance de contact ',/, * 14X,'Coefficient : ',E12.5,4X,'References : ',32I3) 1200 FORMAT(/,' *** LECLIM : Flux volumiques',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1161 FORMAT(/,' %% ERREUR LECLIM : LE TYPE DE TRANSFORMATION INDIQUE', & ' POUR LES NOEUDS PERIODIQUES N''EST PAS RECONNU',/, & ' ??? ',A5) 1162 FORMAT(/,' %% ERREUR LECLIM : LE TYPE DE CONDITION A LA LIMITE', & ' CITE N''EST PAS RECONNU',/, & ' ??? ',A) 1170 FORMAT(/,' *** LECLIM : Condition de type rayonnement infini ',/, * 14X,'Temperature exterieure: ',E12.5,4X, * 'Emissivite : ',E12.5,/, * 14X,'References : ',32I3) C 1310 FORMAT(/,' *** LECLIM : Masse volumique',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1320 FORMAT(/,' *** LECLIM : Chaleur specifique',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1330 FORMAT(/,' *** LECLIM : Conductivite isotrope',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1340 FORMAT(/,' *** LECLIM : Conductivite orthotrope',/, * 14X,'K11,K22,K33 : ',3E12.5,/, * 14X,'References : ',32I3) 1350 FORMAT(/,' *** LECLIM : Conductivite anisotrope',/, * 14X,'K11,K22,K33 : ',3E12.5,/, * 14X,'TETA X, TETA Y, TETA Z :',3E12.5,/, * 14X,'References : ',32I3) 1351 FORMAT(/,' %% ERREUR LECLIM : LA CONDITION PHYSIQUE INDIQUEE', & ' N''EST PAS RECONNUE',/, & ' ??? ',A) C 1410 FORMAT(/,' *** LECLIM : Epaisseur de la coque',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1420 FORMAT(/,' *** LECLIM : Invariant de Gauss (1/R)',/, * 14X,'Valeur : ',E12.5,4X,'References : ',32I3) 1430 FORMAT(/,' *** LECLIM : Conductivites suivant la coque ', * 'et l''epaisseur',/, * 14X,'Valeurs : ',2E12.5,4X,'References : ',32I3) 1440 FORMAT(/,' %% ERREUR LECLIM : LA CONDITION INDIQUEE POUR LE', & ' MODELE COQUE N''EST PAS RECONNUE',/, & ' ??? ',A) C 1510 FORMAT(/,' *** LECLIM : Solide en rotation sur lui-meme ',/, * 14X,'Rotation : ',9E12.5,/, * 14X,'References : ',32I3) 1520 FORMAT(/,' *** LECLIM : Solide en translation ',/, * 14X,'Translation : ',3E12.5,/, * 14X,'Vitesse : ',E12.5, * 4X,'References : ',32I3) 1529 FORMAT(/,' %% ERREUR LECLIM : Translation d''un solide ',/, * ' On ne peut translater le solide que dans son', * ' integralite ==> reference = -1',/) 1530 FORMAT(/,' *** LECLIM : Solide en translation : CL sur les ', * 'noeuds non en regard du fluide',/, * 14X,'T : ',E12.5,4X,'h : ',E12.5, * 4X,'References : ',32I3) 1540 FORMAT(/,' *** LECLIM : Solide en translation : temperature ', * 'd''entree :',E12.5,/, * 14X,'References : ',32I3) 1549 FORMAT(/,' %% ERREUR LECLIM : Translation d''un solide ',/, * ' La temperature d''entree doit etre identique', * ' sur tous les noeuds ==> reference = -1',/) 1550 FORMAT(/,' *** LECLIM : Solide en translation : references', * ' des noeuds des extremites :',32I3) 1560 FORMAT(/,' %% ERREUR LECLIM : MOT-CLE "SMOB", LE PARAMETRE', & ' SUIVANT N''EST PAS RECONNU',/, & ' ??? ',A) C 1118 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''DIRICHLET'' ',/, * 20X,'alors qu''aucun Dirichlet n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS SOLIDES AVEC DIRICHLET'')') 1128 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''FLUX'' ',/, * 20X, 'alors qu''aucun flux n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS OU FACES SOLIDES AVEC FLUX'')') 1138 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''COEF ECH'' ',/, * 20X,'alors qu''aucun coefficient d''echange n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS OU FACES SOLIDES AVEC ', * 'COEFFICIENT D ECHANGE'')') 1147 FORMAT(/,' %% ERREUR LECLIM : Les resistances de contact ne', * ' peuvent etre prise en compte',/, * 20X,'dans le cas du modele coque') 1148 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''RES CONTACT'' ',/, * 20X,'alors qu''aucune resistance de contact n''a ete definie',/, * 20X,'(cf ''REFERENCES NOEUDS OU FACES SOLIDES AVEC ', * 'RESISTANCE DE CONTACT'')') 1158 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''RAYONNEMENT'' ',/, * 20X,'alors qu''aucun noeud avec rayonnement n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS OU FACES SOLIDES AVEC ', * 'RAYONNEMENT'')') 1168 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''PERIODICITE'' ',/, * 20X,'alors qu''aucun noeud periodique n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS SOLIDES PERIODIQUES'')') 1178 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CLIM'' ''RAYT INFINI'' ',/, * 20X,'alors qu''aucun noeud ou face de ce type ', * 'n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS OU FACES SOLIDES AVEC ', * 'RAYONNEMENT INFINI'')') C 1728 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CVOL'' ',/, * 20X,'alors qu''aucun noeud avec flux volumique', * ' n''a ete defini',/, * 20X,'(cf ''REFERENCES NOEUDS SOLIDES AVEC FLUX VOLUMIQUES'')') C 1337 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ISOTROPE'' ',/, * 20X,'non autorisee dans le cas du modele coque',/, * 20X,'(cf ''CCOQ'' ''K SELON COQUE ET EPAISSEUR'')') 1338 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ISOTROPE'' ',/, * 20X,'alors que le materiau n''est pas defini comme isotrope',/, * 20X,'(cf ''ISOTROPIE DU MATERIAU='')') 1347 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ORTHOTROPE'' ',/, * 20X,'non autorisee dans le cas du modele coque',/, * 20X,'(cf ''CCOQ'' ''K SELON COQUE ET EPAISSEUR'')') 1348 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ORTHOTROPE'' ',/, * 20X,'alors que le materiau n''est pas defini ', * 'comme orthotrope',/, * 20X,'(cf ''ISOTROPIE DU MATERIAU='')') 1357 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ANISOTROPE'' ',/, * 20X,'non autorisee dans le cas du modele coque',/, * 20X,'(cf ''CCOQ'' ''K SELON COQUE ET EPAISSEUR'')') 1358 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CPHY'' ''K ANISOTROPE'' ',/, * 20X,'alors que le materiau n''est pas defini ', * 'comme anisotrope',/, * 20X,'(cf ''ISOTROPIE DU MATERIAU='')') C 1418 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CCOQ'' ''EPAISSEUR'' ',/, * 20X,'sans objet dans le cas du modele general') 1428 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CCOQ'' ''INVARIANT GAUSS'' ',/, * 20X,'sans objet dans le cas du modele general') 1438 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''CCOQ'' ''K SELON COQUE ET EPAISSEUR'' ',/, * 20X,'sans objet dans le cas du modele general') C 1518 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''SMOB'' ''R'' ',/, * 20X,'alors qu''aucun noeud n''est defini comme etant ', * 'en rotation',/, * 20X,'(cf ''REFERENCES NOEUDS SOLIDES EN ROTATION'')') 1528 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''SMOB'' ''T'' ',/, * 20X,'alors que le solide n''est pas defini comme etant ', * 'en translation',/, * 20X,'(cf ''SOLIDE EN TRANSLATION='')') 1538 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''SMOB'' ''CL NOEUDS ISOLES'' ',/, * 20X,'alors que le solide n''est pas mobile ',/, * 20X,'(cf ''SOLIDE EN TRANSLATION='' ou', * ' ''REFERENCES NOEUDS SOLIDES EN ROTATION'')') 1548 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''SMOB'' ''TEMPERATURE ENTREE'' ',/, * 20X,'alors que le solide n''est pas en translation',/, * 20X,'(cf ''SOLIDE EN TRANSLATION='')') 1558 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''SMOB'' ''REFERENCES EXTREMITES'' ',/, * 20X,'alors que le solide n''est pas en translation ',/, * 20X,'(cf ''SOLIDE EN TRANSLATION='')') 1721 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''HIST'' ''NOEUDS'' ',/, * 20X,'Le nombre de noeuds est limite a ',I3,' par ligne',/, * 20X,'Utilisez le mot-cle plusieurs fois pour definir ', * ' tous vos noeuds') 1722 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''HIST'' ''NOEUDS'' ',/, * 20X,'le nombre d''historiques', * ' sur le solide est limite a ',I4) C 1821 FORMAT(/,' %% ERREUR LECLIM : utilisation du mot-cle', * ' ''REGU'' ''REFERENCES'' ',/, * 20X,'Le nombre de references limite a ',I3) C 2001 FORMAT(/,' --> LECLIM : Numeros des noeuds avec flux') 2002 FORMAT(/,' --> LECLIM : Valeurs des flux') 2003 FORMAT(/,' --> LECLIM : Numeros des faces avec flux') 2011 FORMAT(/,' --> LECLIM : Numeros des noeuds avec Dirichlet') 2012 FORMAT(/,' --> LECLIM : Valeurs des Dirichlet') 2021 FORMAT(/,' --> LECLIM : Numeros des noeuds avec coeff d''echange') 2022 FORMAT(/,' --> LECLIM : Valeurs de la temperature') 2023 FORMAT(/,' --> LECLIM : Valeurs des coeff d''echange') 2024 FORMAT(/,' --> LECLIM : Numeros des faces avec coeff d''echange') 2031 FORMAT(/,' --> LECLIM : Numeros des noeuds avec resistance de ', * 'contact') 2032 FORMAT(/,' --> LECLIM : Valeurs de la resistance de contact') 2033 FORMAT(/,' --> LECLIM : Numeros des faces avec resistance de ', * 'contact') 2051 FORMAT(/,' --> LECLIM : Numeros des noeuds avec flux volumique') 2052 FORMAT(/,' --> LECLIM : Valeurs des flux volumiques') 2061 FORMAT(/,' --> LECLIM : Nombre des points avec masse volumique') 2062 FORMAT(/,' --> LECLIM : Valeurs de la masse volumique') 2071 FORMAT(/,' --> LECLIM : Nombre des points avec CP') 2072 FORMAT(/,' --> LECLIM : Valeurs de CP') 2081 FORMAT(/,' --> LECLIM : Nombre des points avec conductivite') 2082 FORMAT(/,' --> LECLIM : Nombre de coeff de la mat de ', * 'conductivite') 2083 FORMAT(/,' --> LECLIM : Valeurs de la conductivite') C 3000 FORMAT(/,' %% ERREUR LECLIM : Erreur dans le fichier de donnees', * /,20X,'au cours de la lecture des conditions limites et ', * 'physiques',/, * 20X,'Ligne concernee : ',A) C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/lecid3.F0000666000175000017500000002266311524070644015227 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 SUBROUTINE LECID3 C ***************** C C ----------------------------------------------------- * (NDIM,NDIELE,NPOINS,NELEMS,NFBIDA,NDMATS,NODES,NREFS, * NREFE,COORDS,NBFACE,NREFAC) C ----------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C LECTURE DU MAILLAGE ELEMENTS FINIS * C STRUCTURE DE DONNEE ISSUE DE IDEAS * C * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NODES ! TE ! R ! TABLE DES ELEMENTS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! R ! REFERENCES DES NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! R ! COORD DES NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /GEOCOQ/ ! ! D ! ! C ! /GEOEF/ ! ! D ! ! C ! /GENECT/ ! ! D ! ! C ! /PORTAG/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "mobil.h" C C*********************************************************************** C INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NBFACE INTEGER NODES(NELEMS,NDMATS), NREFS(NPOINS),NREFE(NELEMS) INTEGER NREFAC(NELEMS,NBFACE) DOUBLE PRECISION COORDS(NPOINS,NDIM) C INTEGER N,I,J INTEGER NUM,ID,N1,N2,N3,NBNO,NDSDE,NUMMAX INTEGER ITRIA6(6),ITET10(10) C INTEGER NFBIDA,ICFA,NSF1,NSF2,NSF3 CHARACTER*80 CH C*********************************************************************** C DATA ITRIA6 / 1,4,2,5,3,6 / DATA ITET10 / 1,8,4,9,2,5,7,10,6,3 / C C 1- INITIALISATION DES TABLEAUX D'INDICATEURS C ============================================ C DO 2 I=1,NPOINS NREFS(I) = 0 2 CONTINUE C C C C 2- LECTURE DE LA TABLE DES NOEUDS C ================================= C C 2.1- Recherche de la section contenant la table des noeuds C ---------------------------------------------------------- CALL SECIDE(NFSGCT,2411) C C 2.2- Coordonnees et references C ------------------------------ DO 220 N=1,NBNMA1 READ(NFSGCT,2200) N1,N2,N3,NREFS(N) READ(NFSGCT,2210) (COORDS(N,J),J=1,NDIM) 220 CONTINUE C C C C 3- TABLE DES ELEMENTS C ===================== C C 3.1- Recherche de la section contenant la table des elements C ------------------------------------------------------------ CALL SECIDE(NFSGCT,2412) C C 3.2- Lecture des elements C ------------------------- C IF (NDIELE.EQ.2) THEN DO N=1,NBEMA1 READ(NFSGCT,3200) NUM,ID,N1,N2,NREFE(N),NBNO READ(NFSGCT,3201) (NODES(N,ITRIA6(I)),I=1,NBNO) ENDDO DO N=1,NFBIDA READ(NFSGCT,4200,ERR=28,END=28) NUM,ID,N1,N2,ICFA,NBNO IF (NDIELE.EQ.2 .AND. ID.EQ.24) THEN READ(NFSGCT,4223) CH READ(NFSGCT,4224) NSF1,NSF3,NSF2 CALL AFECTF(NSF1,NSF2,NSF3,ICFA, * NDIM,NDIELE,NELEMS,NBNO,NBFACE,NODES, * NREFAC,NPOINS,NREFS) ENDIF ENDDO 28 CONTINUE C ELSE DO N=1,NBEMA1 READ(NFSGCT,3200) NUM,ID,N1,N2,NREFE(N),NBNO READ(NFSGCT,3201) (NODES(N,ITET10(I)),I=1,NBNO) ENDDO DO N=1,NFBIDA READ(NFSGCT,4200,ERR=29,END=29) NUM,ID,N1,N2,ICFA,NBNO IF (NDIELE.EQ.3 .AND. ID.EQ.92) THEN READ(NFSGCT,4201,ERR=29,END=29) & NSF1,N1,NSF2,N1,NSF3,N1 CALL AFECTF(NSF1,NSF2,NSF3,ICFA, * NDIM,NDIELE,NELEMS,NBNO,NBFACE,NODES, * NREFAC,NPOINS,NREFS) ENDIF ENDDO 29 CONTINUE C ENDIF C C NUMMAX=0 DO N=1,NELEMS DO I=1,NDMATS NUMMAX=MAX(NUMMAX,NODES(N,I)) ENDDO ENDDO IF (NUMMAX.GT.NPOINS) THEN WRITE(NFECRA,6000) STOP ENDIF C C 4- IMPRESSION SUR LISTING C ========================= C IF (NBLBLA.GT.0) THEN WRITE(NFECRA,4000) WRITE(NFECRA,4010) NDIM,NBNMA1,NBEMA1 ENDIF C C C 5- VERIFICATION DU MAILLAGE LU C ============================== C IF (NBLBLA.GE.2) THEN C WRITE(NFECRA,5000) WRITE(NFECRA,5010) ccc DO 100 I=1,NBNMA1 DO 100 I=1,10 WRITE(NFECRA,5011) I,(COORDS(I,J),J=1,NDIM) 100 CONTINUE C WRITE(NFECRA,5020) ccc DO 110 I=1,NBEMA1 DO 110 I=1,10 WRITE(NFECRA,5012) I,(NODES(I,J),J=1,NDMATS) 110 CONTINUE C WRITE(NFECRA,5030) ccc DO 120 I=1,NBNMA1 DO 120 I=1,10 WRITE(NFECRA,5013) I,NREFS(I) 120 CONTINUE C IF (NDPROP.GT.1) THEN WRITE(NFECRA,5031) DO 121 I=1,10 WRITE(NFECRA,5013) I,NREFE(I) 121 CONTINUE ENDIF C ENDIF C C-------- C FORMATS C-------- C 2200 FORMAT(4I10) 2210 FORMAT(1P3D25.16) 3200 FORMAT(6I10) 3201 FORMAT(8I10) C 4000 FORMAT(//,' *** LECID2 : MAILLAGE ELEMENTS FINIS DU SOLIDE :') 4010 FORMAT(8X,'- Dimension du maillage : ',I6,/, & 8X,'- Nombre total de noeuds : ',I8,/, & 8X,'- Nombre d''elements : ',I8) 4200 FORMAT(6I10) 4201 FORMAT(8I10) 4223 FORMAT(A80) 4224 FORMAT(3I10) C 5000 FORMAT(/,' *** LECID2 : Verification du maillage solide',/) 5010 FORMAT(/,14X,'Coordonnees des 10 premiers noeuds :',/) 5020 FORMAT(/,14X,'Table des 10 premiers elements :',/) 5030 FORMAT(/,14X,'References des 10 premiers noeuds :',/) 5031 FORMAT(/,14X,'References des 10 premiers elements :',/) 5011 FORMAT(14X,'N=',I2,' COORDS : ',3E12.5) 5012 FORMAT(14X,'N=',I2,' NOEUDS : ',10I8) 5013 FORMAT(14X,'N=',I2,' REFERENCE : ',I3) C 6000 FORMAT(/,' %% ERREUR LECID3 : LA NUMEROTATION DES NOEUDS DU', * ' MAILLAGE POUR LE SOLIDE',/, * ' COMPORTE DES TROUS',/, * ' VEUILLEZ RENUMEROTER VOTRE', * ' MAILLAGE POUR AVOIR UNE NUMEROTATION CONTINUE') C END syrthes-3.4.3-dfsg1/src/s/find_node.c0000666000175000017500000001165511524070644016045 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "tree.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | find_node_3d | | dans quel noeud se trouve le point x,y,z | |======================================================================| */ void find_node_3d (struct node **noeud, double x, double y, double z) { struct child *p1; int i,nfils ; if ((**noeud).lfils != NULL) { nfils = quel_fils_3d((**noeud).xc,(**noeud).yc,(**noeud).zc,(**noeud).lfils,x,y,z); p1=(**noeud).lfils; for (i=0;isuivant; *noeud = p1->fils; find_node_3d(noeud, x, y,z); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | quel_fils_3d | | dans quel fils faut-il aller ensuite | |======================================================================| */ int quel_fils_3d (double xcc,double ycc,double zcc,struct child *pfils, double x, double y, double z) { if (x>xcc) if (y>ycc) if(z>zcc) return(6); else return(7); else if(z>zcc) return(2); else return(3); else if (y>ycc) if(z>zcc) return(5); else return(8); else if(z>zcc) return(1); else return(4); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | find_node_2d | | dans quel noeud se trouve le point x,y,z | |======================================================================| */ void find_node_2d (struct node **noeud, double x, double y) { struct child *p1; int i,nfils ; if ((**noeud).lfils != NULL) { nfils = quel_fils_2d((**noeud).xc,(**noeud).yc,(**noeud).lfils,x,y); p1=(**noeud).lfils; for (i=0;isuivant; *noeud = p1->fils; find_node_2d(noeud, x, y); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | quel_fils_2d | | dans quel fils faut-il aller ensuite | |======================================================================| */ int quel_fils_2d (double xcc,double ycc,struct child *pfils, double x, double y) { if (x>xcc) if (y>ycc) return(2); else return(3); else if (y>ycc) return(1); else return(4); } syrthes-3.4.3-dfsg1/src/s/openct.F0000666000175000017500000007305111524070644015351 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE OPENCT C ***************** C ------- * (CTYPE) C ------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C BUT : CENTRALISATION DES OUVERTURES DE TOUS LES FICHIERS DE SYRTHES C ---- C C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! CTYPE ! ! ! TYPE DES FICHIERS ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /FICHCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT : POINTO C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "divct.h" #include "fichct.h" #include "optct.h" #include "nlofct.h" #include "nlofes.h" #ifdef MED #include "med.hf" #endif C C*********************************************************************** C C... Declarations des variables externes CHARACTER CTYPE*5 C C C... Declarations des variables internes C CHARACTER NAME*200,FICH*200,CH*5 #ifdef HAVE_C_IO CHARACTER MSGIOS*80 #endif INTEGER NFIC,IOS,II1,II2,N1,N2,N3,LPOS,IDEB,IFIN,LCH,N,IRET INTEGER LE LOGICAL LEXTEN C C*********************************************************************** C C C*********************************************************************** C C ====================== C 1- FICHIER OBLIGATOIRE C ====================== C C C 1.1- FICHIER DE DONNEES DU COUPLAGE THERMIQUE syrthes.data C --------------------------------------------------------- C IF (CTYPE .EQ. 'OBLIG') THEN C FICH = ' ' FICH = RAMON CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCL CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCLCT OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) C C C ============================================================ C 1. bis - FICHIER OBLIGATOIRE POUR LE RAYONNEMENT syrthes.ray C ============================================================ C ELSEIF (CTYPE .EQ. 'RAYOB') THEN FICH = ' ' FICH = RAMON CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCLRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCLRA OPEN ( UNIT= NFIC, FILE=FICH (II1:II2), STATUS='OLD', & FORM='FORMATTED',ACCESS='SEQUENTIAL', & IOSTAT=IOS , ERR=99 ) REWIND(UNIT=NFIC,ERR=99) C C ============================= C 2- FICHIER GEOMETRIE RESULTAT C ============================= C C 2.1- FICHIER 1 DE RESULTATS SOLIDE (GEOMETRIE) C ---------------------------------------------- C ELSEIF (CTYPE .EQ. 'RGEOM') THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTGRF1 CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPGS='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPGS='MED' #ifndef MED TYPGS='SYR' #endif C IF (LSDEPL .OR. LSROTA) THEN WRITE(CH,2000) NTSYR CALL VERLOS (CH,IDEB,IFIN,LCH) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') THEN N3 = N LEXTEN = .TRUE. ENDIF ENDDO IF (LEXTEN) THEN NAME = NAME(N1:N3-1)//'_'//CH(IDEB:IFIN)//NAME(N3:N2) ELSE NAME = NAME(N1:N2)//'_'//CH(IDEB:IFIN) ENDIF CALL VERLOS ( NAME, N1, N2, LPOS ) ENDIF C FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGGCT IF (TYPGS.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGGCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C C =================== C 3- FICHIER RESULTAT C =================== C C 3.1- FICHIER 2 DE RESULTATS SOLIDE (RESULTATS) C ---------------------------------------------- C ELSEIF (CTYPE .EQ. 'RESUL') THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTGRF2 CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPRS='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPRS='MED' #ifndef MED TYPRS='SYR' #endif C IF (LSDEPL .OR. LSROTA) THEN WRITE(CH,2000) NTSYR CALL VERLOS (CH,IDEB,IFIN,LCH) LEXTEN = .FALSE. DO 130 N=N1,N2 IF (NAME(N:N).EQ.'.') THEN N3 = N LEXTEN = .TRUE. ENDIF 130 CONTINUE IF (LEXTEN) THEN NAME = NAME(N1:N3-1)//'_'//CH(IDEB:IFIN)//NAME(N3:N2) ELSE NAME = NAME(N1:N2)//'_'//CH(IDEB:IFIN) ENDIF CALL VERLOS ( NAME, N1, N2, LPOS ) ENDIF C FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGRCT IF (TYPRS.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGRCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C C ======================== C 4- FICHIER CHRONOLOGIQUE C ======================== C C 4.1- FICHIER 2 DE RESULTATS SOLIDE (CHRONOLOGIQUE) C -------------------------------------------------- C ELSEIF (CTYPE .EQ. 'RCHRO') THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTGF2C CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPCS='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPCS='MED' #ifndef MED TYPCS='SYR' #endif C IF (LSDEPL .OR. LSROTA) THEN WRITE(CH,2000) NTSYR CALL VERLOS (CH,IDEB,IFIN,LCH) LEXTEN = .FALSE. DO 140 N=N1,N2 IF (NAME(N:N).EQ.'.') THEN N3 = N LEXTEN = .TRUE. ENDIF 140 CONTINUE IF (LEXTEN) THEN NAME = NAME(N1:N3-1)//'_'//CH(IDEB:IFIN)//NAME(N3:N2) ELSE NAME = NAME(N1:N2)//'_'//CH(IDEB:IFIN) ENDIF CALL VERLOS ( NAME, N1, N2, LPOS ) ENDIF C FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGCCT IF (TYPCS.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGCCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C C ================== C 5- AUTRES FICHIERS C ================== C ELSEIF (CTYPE .EQ. 'AUTRE') THEN C C 5.1- FICHIER SUITE DE RESULTATS SOLIDE (RESULTATS) C -------------------------------------------------- C IF ( LSUISO ) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTSUIT CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPSU='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPSU='MED' #ifndef MED TYPSU='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGSCT IF (TYPSU.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGSCT,FICH(II1:II2),MED_LECT,IRET) #endif ENDIF ENDIF C C 5.2- FICHIER DE DONNEES DU MAILLAGE ELEMENTS FINIS SOLIDE C --------------------------------------------------------- C FICH = ' ' FICH = RAMON CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTMAEF CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFSGCT TYPEF = ' ' IF (NAME(N2-2:N2).EQ.'unv') THEN TYPEF = 'IDE' ELSEIF (NAME(N2-2:N2).EQ.'des') THEN TYPEF = 'SIM' ELSEIF (NAME(N2-2:N2).EQ.'syr') THEN TYPEF = 'SYR' #ifdef MED ELSEIF (NAME(N2-2:N2).EQ.'med') THEN TYPEF = 'MED' #endif ELSE WRITE(NFECRA,1200) STOP ENDIF IF (TYPEF.EQ.'SIM') THEN #ifndef HAVE_C_IO OPEN ( UNIT= NFIC, FILE=FICH (II1:II2), STATUS='OLD', & FORM='UNFORMATTED', IOSTAT=IOS , ERR=99 ) REWIND(UNIT=NFIC,ERR=99) #else CALL OPENBF(FICH(II1:II2), II2-II1+1, 'r', 1, NFIC, IOS) IF (IOS .NE. 0) GOTO 98 LE=56 CALL TENDBF(NFIC,LE,IOS) IF (IOS .NE. 0) GOTO 98 #endif ELSEIF (TYPEF.EQ.'IDE' .OR. TYPEF.EQ.'SYR') THEN OPEN ( UNIT= NFIC, FILE=FICH(II1:II2), STATUS='OLD', & FORM='FORMATTED', IOSTAT=IOS , ERR=99 ) REWIND(UNIT=NFIC,ERR=99) #ifdef MED ELSEIF (TYPEF.EQ.'MED') THEN CALL EFOUVR(NFSGCT,FICH(II1:II2),MED_LECT,IRET) #endif ENDIF C C C 5.3- FICHIER DE SAUVEGARDE DU MAILLAGE EF FLUIDE C (noeuds couples) C ---------------------------------------------------- IF (LGEOMF) THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTGEOF CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPGF='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPGF='MED' #ifndef MED TYPGF='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGFCT IF (TYPGF.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGFCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C ENDIF C C 5.4- FICHIER DE RESULTATS SUR LE MAILLAGE EF FLUIDE C (noeuds couples, temperature de peau du fluide C et coefficients d'echange) C ---------------------------------------------------- IF (LRESUF) THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTRESF CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPRF='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPRF='MED' #ifndef MED TYPRF='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFRFCT IF (TYPRF.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFRFCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C ENDIF C C 5.5- FICHIER DE RESULTATS SUR LE MAILLAGE EF FLUIDE C (noeuds couples, temperature de peau du fluide C et coefficients d'echange) C ---------------------------------------------------- IF (LCHROF) THEN C FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCHOF CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPCF='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPCF='MED' #ifndef MED TYPCF='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCFCT IF (TYPCF.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFCFCT,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C ENDIF C C 5.6- HISTORIQUES SOLIDES RESULTATS C ---------------------------------- C IF (LHISOL) THEN FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTHISR CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFHRCT OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C 5.7- STOCKAGE-LECTURE DES CORRESPONDANTS FLUIDE/SOLIDE C ------------------------------------------------------ IF (LSTOKC .OR. LECCOR) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCORR CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCOCT IF (LECCOR) THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ELSE OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ENDIF REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C C ============== C 6- RAYONNEMENT C ============== C ELSEIF (CTYPE .EQ. 'RAYTT') THEN C C 6.1- RAYONNEMENT MAILLAGE ELEMENTS FINIS DE PEAU C ----------------------------------------------- C FICH = ' ' FICH = RAMON CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTGERA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFSGRA TYPRA = ' ' IF (NAME(N2-2:N2).EQ.'unv') THEN TYPRA = 'IDE' ELSEIF (NAME(N2-2:N2).EQ.'des') THEN TYPRA = 'SIM' ELSEIF (NAME(N2-2:N2).EQ.'syr') THEN TYPRA = 'SYR' #ifdef MED ELSEIF (NAME(N2-2:N2).EQ.'med') THEN TYPRA = 'MED' #endif ELSE WRITE(NFECRA,1210) STOP ENDIF IF (TYPRA.EQ.'SIM') THEN #ifndef HAVE_C_IO OPEN ( UNIT= NFIC, FILE=FICH (II1:II2), STATUS='OLD', & FORM='UNFORMATTED', IOSTAT=IOS , ERR=99 ) REWIND(UNIT=NFIC,ERR=99) #else CALL OPENBF(FICH(II1:II2), II2-II1+1, 'r', 1, NFIC, IOS) IF (IOS .NE. 0) GOTO 98 LE=56 CALL TENDBF(NFIC,LE,IOS) IF (IOS .NE. 0) GOTO 98 #endif ELSEIF (TYPRA.EQ.'IDE' .OR. TYPRA.EQ.'SYR') THEN OPEN ( UNIT= NFIC, FILE=FICH(II1:II2), STATUS='OLD', & FORM='FORMATTED', IOSTAT=IOS , ERR=99 ) REWIND(UNIT=NFIC,ERR=99) #ifdef MED ELSEIF (TYPRA.EQ.'MED') THEN CALL EFOUVR(NFSGRA,FICH(II1:II2),MED_LECT,IRET) #endif ENDIF C C C 6.2- RAYONNEMENT : MAILLAGE RESULTAT C - FORMAT SYRTHES - C -------------------------------------- FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTRGRA CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPGR='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPGR='MED' #ifndef MED TYPGR='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGGRA IF (TYPGR.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGGRA,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C C C 6.3- RAYONNEMENT : RESULTAT MAILLAGE DE RAYONNEMENT C - FORMAT SYRTHES - C --------------------------------------------- FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTRRRA CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPRR='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPRR='MED' #ifndef MED TYPRR='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGRRA IF (TYPRR.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGRRA,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF C C C 6.4- RAYONNEMENT : CHRONO DE RAYONNEMENT C - FORMAT SYRTHES - C ---------------------------------------- IF (NCHROR.GT.0) THEN FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTRCRA CALL VERLOS ( NAME, N1, N2, LPOS ) LEXTEN = .FALSE. DO N=N1,N2 IF (NAME(N:N).EQ.'.') LEXTEN = .TRUE. ENDDO TYPCR='SYR' IF (LEXTEN.AND.NAME(N2-2:N2).EQ.'med') TYPCR='MED' #ifndef MED TYPCR='SYR' #endif FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFGCRA IF (TYPCR.EQ.'SYR') THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ELSE #ifdef MED CALL EFOUVR(NFGCRA,FICH(II1:II2),MED_REMP,IRET) #endif ENDIF ENDIF C C C C 6.5- STOCKAGE-LECTURE DES FACTEURS DE FORME C ------------------------------------------- IF (LSTOKF .OR. LECFDF) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTFFRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFFFRA IF (LECFDF) THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ELSE OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ENDIF REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C 6.6- STOCKAGE-LECTURE DES CORRESPONDANTS RAYONNEMENT C ---------------------------------------------------- IF (LSTORA .OR. LLCORA) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCORA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCORA IF (LLCORA) THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ELSE OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ENDIF REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C C 6.6- STOCKAGE-LECTURE DES CORRESPONDANTS RAYONNEMENT C ---------------------------------------------------- IF (LSTORA .OR. LLCORA) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTCORA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFCORA IF (LLCORA) THEN OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ELSE OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) ENDIF REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C 6.7- HISTORIQUES RAYONNEMENT C ---------------------------- IF (LHISOR) THEN FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTHIRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFHIRA OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C ================ C 7- FICHIERS MSTS C ================ C C ELSEIF (CTYPE .EQ. 'FMSTS') THEN C C 7.1- Fichier de resultats C ------------------------- FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTRMRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFRMRA OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) C C 7.2- Fichier suite C ------------------ IF ( LSUISO ) THEN FICH = ' ' FICH = RSUITE CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTSMRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFSMRA OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='OLD',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) ENDIF C C 7.3- Fichier resu epaisseur msts C -------------------------------- FICH = ' ' FICH = RAVAL CALL VERLOS ( FICH, II1, II2, LPOS ) NAME = ' ' NAME = CTEMRA CALL VERLOS ( NAME, N1, N2, LPOS ) FICH ( II2+1:II2+LPOS ) = NAME ( N1:N2 ) II2 = II2 + LPOS NFIC = NFEMRA OPEN ( UNIT=NFIC, FILE=FICH (II1:II2), * STATUS='UNKNOWN',FORM='FORMATTED', * ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 ) REWIND ( UNIT=NFIC,ERR=99 ) C ENDIF C RETURN C C ===================== C 3- ERREUR D'OUVERTURE C ===================== C #ifdef HAVE_C_IO 98 CONTINUE CALL STREBF (MSGIOS, LEN(MSGIOS), IOS) WRITE ( NFECRA,9998 ) FICH (II1:II2), NFIC, MSGIOS STOP #endif 99 CONTINUE WRITE ( NFECRA,9999 ) FICH (II1:II2), NFIC, IOS STOP C C------- C FORMAT C------- C 1000 FORMAT( /,' %% ERREUR OPENCT : MOT CLE INCONNU :', 1X,A,/ ) 1200 FORMAT(/,' %% ERREUR OPENCT : LE TYPE DE FICHIER DU MAILLAGE', & ' SOLIDE EST INCONNU',/, & 20X, 'Les types reconnus sont :',/, & 23X, '- Fichier SIMAIL : suffixe ".des"',/, & 23X, '- Fichier IDEAS : suffixe ".unv"',/, & 23X, '- Fichier SYRTHES : suffixe ".syr"',/, & 23X, '- Fichier MED : suffixe ".med"') 1210 FORMAT(/,' %% ERREUR OPENCT : LE TYPE DE FICHIER DU MAILLAGE', & ' POUR LE RAYONNEMENT EST INCONNU',/, & 20X, 'Les types reconnus sont :',/, & 23X, '- Fichier SIMAIL : suffixe ".des"',/, & 23X, '- Fichier IDEAS : suffixe ".unv"',/, & 23X, '- Fichier SYRTHES : suffixe ".syr"',/, & 23X, '- Fichier MED : suffixe ".med"') 2000 FORMAT(I5) #ifdef HAVE_C_IO 9998 FORMAT ( /,1X,'%% ERREUR D''OUVERTURE SUR LE FICHIER :',1X,A,/, * 4X,'DE NUMERO D''UNITE LOGIQUE :',1X,I2,/ * 4X,'AVEC L''ERREUR SUIVANTE :',1X,A ) #endif 9999 FORMAT ( /,1X,'%% ERREUR D''OUVERTURE SUR LE FICHIER :',1X,A,/, * 4X,'DE NUMERO D''UNITE LOGIQUE :',1X,I2,/ * 4X,'AVEC UN IOSTAT EGAL A :',1X,I6 ) C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/lecg2r.F0000666000175000017500000001172411524070644015236 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LECG2R,SSI=0 C SUBROUTINE LECG2R C ***************** C C ------------------------- *( TRESU,NLONGT,NOMT,NFIC) C ------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C LECTURE DU FICHIER RESULTAT SYRTHES POUR UNE SUITE DE CALCUL * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! TRESU ! TR ! D ! TABLEAU DE RESULTATS A ECRIRE ! C ! NLONGT ! E ! D ! DIMENSION DU TABLEAU TRESU ! C ! NOMT ! A ! D ! NOM DE LA VARIABLE A ECRIRE ! C ! LENTET ! L ! D ! INDICATEUR D'ECRITURE DE L'ENTETE ! C ! NFIC ! E ! D ! NUMERO LOGIQUE DU FICHIER ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" C********************************************************************** C C.. Variables externes INTEGER NLONGT,NFIC DOUBLE PRECISION TRESU(NLONGT) CHARACTER NOMT*12 C C.. Variables internes INTEGER I CHARACTER CH*12 C C C********************************************************************** C C 0- INITIALISATION C ================= C DO 1 I=1,NLONGT TRESU (I) = 0.D0 1 CONTINUE C C C 1- LECTURE DU TABLEAU DE RESULTATS C ================================== C READ(NFIC,1000,ERR=99) CH IF (CH.NE.NOMT) THEN WRITE(NFECRA,1999) CH,NOMT STOP ENDIF READ(NFIC,1000,ERR=99) CH READ(NFIC,1010,ERR=99) (TRESU(I),I=1,NLONGT) C RETURN C 99 CONTINUE WRITE(NFECRA,999) STOP C C-------- C FORMATS C-------- C 1000 FORMAT(A12) 1010 FORMAT(6E13.7) C 1999 FORMAT(/,' %% ERREUR LECG2R : ', & 'LE FICHIER SUITE N''EST PAS CORRECT',/, & ' ', & 'On lit ',A12,' au lieu de ',A12) C 999 FORMAT(/,' %% ERREUR LECG2R : ', & ' ERREUR DE LECTURE DU FICHIER SUITE') C C END syrthes-3.4.3-dfsg1/src/s/evadim.F0000666000175000017500000005037711524070644015334 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE EVADIM C ***************** C C --------------------------------------------------------- *(NDIM,NPOINS,NELEMS,NFBIDA,NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL, * NBRESS,NBRAYS,NBRAIS,NBPRIO, * NBMOBS, * NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NPPEL,NPOUE, * NBICOR,NBCOPR, * NBFFLU,NBFECH,NBFRAI, * NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C EVALUATION DES DIMENSIONS DES TABLEAUX NECESSAIRES * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NPOINS ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NELEUS ! E ! R ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELEPR ! E ! R ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NELERA ! E ! R ! NBRE D'ELTS DU MAIL SURF SOLIDE AVEC RAYT ! C ! NBCOUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBFLVS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C ! NBRESS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBRAIS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT INF! C ! NBFRAI ! E ! R ! NOMBRE DE FACES SOLIDES AVEC RAYONNEMENT INF ! C ! NBPRIO ! E ! R ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NDIELE ! E ! R ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NDMATS ! E ! R ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NDMASS ! E ! R ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NBFACE ! E ! R ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NCOEMA ! E ! R ! NOMBRE DE COEF EXTRA DIAG DES MATRICES ELEM ! C ! NBPHYS ! E ! R ! NOMBRE DE VARIABLES PHYSIQUES SUR LE SOLIDE ! C ! NBICOR ! E ! R ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NBCOPR ! E ! R ! NBRE DE CORRESPONDANTS POUR LES NOEUDS PERIOD! C ! NBMOBS ! E ! R ! NBRE DE NOEUDS EN MOUVEMENT ! C ! NPOINR ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! R ! NOMBRE D'ELEMENTS DU MAILLAGE RAYONNEMENT ! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "xrefer.h" #include "optct.h" #include "mobil.h" #include "fichct.h" #include "nlofes.h" #include "nlofct.h" #include "divct.h" #include "syrth.h" #include "syrthu.h" C C********************************************************************** C INTEGER NDX PARAMETER (NDX=10) C C.. Variables externes INTEGER NDIM,NDIELE INTEGER NPOINS,NELEMS,NELEPR,NELESS,NELEUS,NELERC,NELERA INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL INTEGER NBRESS,NBRAYS,NBRAIS INTEGER NBPRIO,NPPEL,NPOUE INTEGER NDMATS,NDMASS,NCOEMA,NBPHYS,NBICOR,NBCOPR,NBMOBS INTEGER NBFACE,NBFFLU,NBFECH,NBFRAI INTEGER NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE C C C.. Variables internes INTEGER I,LE,MM(15),ITYP INTEGER NRAJOU,NC LOGICAL ERR C INTEGER NFBIDA C********************************************************************** C C 0- CAS OU LE COUPLAGE N'EST PAS ACTIVE : METTRE TOUTES LES C DIMENSION A 0 C ========================================================== C IF (NCTHFS.EQ.0) THEN C NDIELE = 1 NDMATS = 1 NDMASS = 1 NCOEMA = 1 NPOINS = 1 NELEMS = 1 NELESS = 1 C RETURN C ENDIF C C C 1- INITIALISATIONS C ================== C C 1.1 Nombre de faces par elements C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (NCTHFS.EQ.2) THEN NBFACE = 1 ELSE IF (NDIM.EQ.2) THEN NBFACE = 3 ELSE NBFACE = 4 ENDIF ENDIF C C 1.2- Dimension des elements (ie: triangles ou tetraedres) C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (NCTHFS.EQ.2 .OR. NDIM .EQ. 2) THEN NDIELE = 2 ELSE NDIELE = 3 ENDIF C C C 1.2 Suite de calcul en maillage mobile C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C IF (LSUISO .AND. (LSDEPL.OR.LSROTA) .AND. TYPEF.NE.'SYR') THEN WRITE(NFECRA,1200) STOP ENDIF C C 2- INITIALISATION DES SIGNIFICATIONS DES REFERENCES C =================================================== C C CALL LECREF C IF (LRAY) CALL LECRER C C 5- MAILLAGE ELEMENTS FINIS DU SOLIDE C ==================================== C C 5.1- LECTURE DU MAILLAGE DU SOLIDE C ---------------------------------- C C Si le maillage element fini a ete genere par SIMAIL IF (TYPEF .EQ. 'SIM') THEN ITYP=1 ELSEIF (TYPEF .EQ. 'IDE') THEN ITYP=2 ELSEIF (TYPEF .EQ. 'SYR')THEN ITYP=3 ELSEIF (TYPEF .EQ. 'MED')THEN ITYP=4 ELSE WRITE(NFECRA,5100) STOP ENDIF CALL LMAILS(ITYP,LCFACE, * NDIM,NDIELE,NPOINS, * NELEMS,NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBFACE,NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS, * NBRESS,NBRAYS,NBRAIS,NBPRIO,NBMOBS,NRAJOU, * NBFFLU,NBFECH,NBFRAI,NFBIDA) C C 5.2 Solides en deplacement C -------------------------- C conservation du nombre initial de noeuds et d'elements NBNMA1 = NPOINS NBEMA1 = NELEMS C C C 5.3- VERIFICATIONS POUR LE MODELE COQUE C ======================================== C Toute la coque doit etre couplee C IF (NCTHFS.EQ.2) THEN ERR = .FALSE. IF (NELESS.NE.NELEMS) THEN WRITE (NFECRA,5010) NELEMS,NELESS ERR = .TRUE. ENDIF IF (NBCOUS.NE.NPOINS) THEN WRITE (NFECRA,5020) NPOINS,NBCOUS ERR = .TRUE. ENDIF IF (ERR) STOP ENDIF C C C C 6- RAYONNEMENT C ============== C C 6.1 Pre-lecture du maillage pour le rayonnement C ----------------------------------------------- IF (LRAY) THEN C IF (TYPRA .EQ. 'SIM') THEN ITYP=1 ELSEIF (TYPRA .EQ. 'IDE') THEN ITYP=2 ELSEIF (TYPRA .EQ. 'SYR')THEN ITYP=3 #ifdef MED ELSEIF (TYPRA .EQ. 'MED')THEN ITYP=4 #endif ELSE WRITE(NFECRA,5100) STOP ENDIF CALL LMAILR(ITYP, * NDIM,NPOINR,NELRAY, * NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C ENDIF C C C C 7- VARIABLES FIGEES C =================== C C 7.1- Cas des modeles coque et general C ------------------------------------- IF (NCTHFS .EQ. 2) THEN NDMATS = 6 NDMASS = 6 NCOEMA = 9 ELSEIF (NDIM .EQ. 2) THEN NDMATS = 6 NDMASS = 3 NCOEMA = 9 ELSE NDMATS = 10 NDMASS = 6 NCOEMA = 25 ENDIF IF ( (NBCOUS * .EQ.0) .AND. .NOT. LSYRTH ) * NCOEMA = NCOEMA/2 C C 7.2- Nombre de variables physiques C ---------------------------------- IF (NCTHFS.EQ.2) THEN NBPHYS = 6 ELSE IF (ISOTRO.EQ.1) THEN NBPHYS = 3 ELSEIF (ISOTRO.EQ.2) THEN IF (NDIM.EQ.2) THEN NBPHYS = 4 ELSE NBPHYS = 5 ENDIF ELSE IF (NDIM.EQ.2) THEN NBPHYS = 5 ELSE NBPHYS = 8 ENDIF ENDIF ENDIF C IF (NDPROP.EQ.3) THEN NPPEL = NDMATS NPOUE = NELEMS ELSEIF (NDPROP.EQ.2) THEN NPPEL = 1 NPOUE = NELEMS ELSE NPPEL = 1 NPOUE = NPOINS ENDIF C C 7.3- Flux volumiques C -------------------- IF (NDFLUV.EQ.3) THEN NPFEL = NDMATS ELSE NPFEL = 1 ENDIF C C 7.3- Maillages coincidents - Nbre d'info pour les correspondants C ---------------------------------------------------------------- C IF (LCOIN) THEN NBICOR = 1 ELSE NBICOR = 2 ENDIF C C 7.4- Periodicite : nombre de correspondants C ------------------------------------------- C IF (NBDIPR.LE.1) THEN NBCOPR = 1 ELSEIF (NBDIPR.EQ.2) THEN NBCOPR = 3 ELSE NBCOPR = 7 ENDIF C C 7.5- Modele coque C ----------------- IF (NCTHFS.EQ.2) THEN NELEUS = 0 NELERC = 0 NELESS = 0 ENDIF C C 7.6- Solides mobiles C -------------------- NBRMOB = 0 C IF ((LSTOKC .OR. LECCOR) .AND. (LSDEPL .OR. LSROTA)) THEN WRITE(NFECRA,7600) LSTOKC = .FALSE. LECCOR = .FALSE. ENDIF C C C 8- ARRET UTILISATEUR C ==================== LSTOPS = .FALSE. C C 9- IMPRESSIONS C ============== C IF (NBLBLA.GT.0) THEN IF (NCTHFS.EQ.3) THEN IF (.NOT.LCFACE) THEN WRITE(NFECRA,8000) NPOINS,NELEMS,NELEUS, & NELESS,NBCOUS,NBFLUS-NRAJOU,NBDIRS,NBECHS WRITE(NFECRA,8010) NELERC,NBRESS,NELEPR,NBPRIO, & NELERA,NBRAYS,NBRAIS,NBMOBS IF (NDFLUV.EQ.1) THEN WRITE(NFECRA,8011) NBFLVS ELSE WRITE(NFECRA,8012) NBFLVS ENDIF IF (LRAY) & WRITE(NFECRA,8015) NPOINR,NELRAY, & NFCSRA,NFCFRA,NFTIRA,NFFIRA,NFPERA,NFMST, & NNSRAY,NNFRAY,NNERAY ELSE WRITE(NFECRA,8020) NPOINS,NELEMS,NELEUS, & NELESS,NBCOUS,NBFFLU,NBDIRS,NBFECH WRITE(NFECRA,8030) NELERC,NBRESS,NELEPR,NBPRIO, & NELERA,NBRAYS,NBFRAI,NBMOBS IF (NDFLUV.EQ.1) THEN WRITE(NFECRA,8011) NBFLVS ELSE WRITE(NFECRA,8012) NBFLVS ENDIF IF (LRAY) & WRITE(NFECRA,8015) NPOINR,NELRAY, & NFCSRA,NFCFRA,NFTIRA,NFFIRA,NFPERA,NFMST, & NNSRAY,NNFRAY ENDIF ELSE IF (.NOT.LCFACE) THEN WRITE(NFECRA,8000) NPOINS,NELEMS,NELEMS, & NELEMS,NBCOUS,NBFLUS,NBDIRS,NBECHS WRITE(NFECRA,8010) NELERC,NBRESS,NELEPR,NBPRIO, & NELERA,NBRAYS,NBRAIS,NBMOBS ELSE WRITE(NFECRA,8020) NPOINS,NELEMS,NELEMS, & NELEMS,NBCOUS,NBFFLU,NBDIRS,NBFECH WRITE(NFECRA,8030) NELERC,NBRESS,NELEPR,NBPRIO, & NELERA,NBRAYS,NBFRAI,NBMOBS ENDIF IF (NDFLUV.EQ.1) THEN WRITE(NFECRA,8011) NBFLVS ELSE WRITE(NFECRA,8012) NBFLVS ENDIF ENDIF C ENDIF C C 10- STOP EN CAS D'ERREUR C ======================== C ERR=.FALSE. C 10.1- Resistances de contact ne sont pas autorisees en coque C ------------------------------------------------------------ C IF (NCTHFS.EQ.2 .AND. (NELERC.NE.0 .OR. NBRESS.NE.0)) THEN WRITE(NFECRA,9100) ERR=.TRUE. ENDIF C IF (LRAY.AND.NELERA.EQ.0) THEN WRITE(NFECRA,9200) ERR=.TRUE. ENDIF C IF (ERR) STOP C C-------- C FORMATS C-------- 1200 FORMAT(/,' %% ERREUR EVADIM : EN MAILLAGE MOBILE, LES SUITES DE ', & 'CALCUL NE PEUVENT ETRE REALISEES',/, & ' QU''A PARTIR DU FICHIER GEOMETRIQUE', & ' ISSU DU PRECEDENT CALCUL ',/, & ' (format SYRTHES) LES COORDONNEES DES', & ' NOEUDS AYANT ETE MODIFIEES') 1000 FORMAT(A80) 1100 FORMAT(2A16) 1105 FORMAT(36I2) 1330 FORMAT(/,' *** EVADIM : NOMBRE DE POINTS DE BORD FLUIDES: ',I6) 1410 FORMAT(12I6) 5100 FORMAT(/,' %% ERREUR EVADIM : TYPE DE MAILLAGE ELEMENTS', & ' FINIS INCONNU') 5010 FORMAT(/,'%% ERREUR EVADIM : ERREUR DE MAILLAGE',/, & 20X,'En modele coque, toute la coque doit etre couplee ', & 'au fluide',/, & 20X,'Ici, la coque comporte ',I9,' elements',/, & 20X,'Il y en a ',I9,' de declares couples') 5020 FORMAT(/,'%% ERREUR EVADIM : ERREUR DE MAILLAGE',/, & 20X,'En modele coque, toute la coque doit etre couplee ', & 'au fluide',/, & 20X,'Ici, la coque comporte ',I9,' noeuds',/, & 20X,'Il y en a ',I9,' de declares couples') 6100 FORMAT(/,' %% ERREUR EVADIM : TYPE DE MAILLAGE POUR LE', & ' RAYONNEMENT INCONNU') 7600 FORMAT(/,' $$ ATTENTION EVADIM : LECTURE OU ECRITURE DES ', & 'CORRESPONDANTS', & 13X,' Ces options sont sans objet en solide mobile ', & 'puisque les correspondants',/, & 13X,' sont recalcules tous les pas de temps',/, & 13X,' Ces options sont igorees, le calcul se poursuit de', & 'facon normale...') C 8000 FORMAT(/,' *** EVADIM : CARACTERISTIQUES DU MAILLAGE SOLIDE', & ' ELEMENTS FINIS : ',/, & ' NOMBRE DE ...',/, & 15X,'- noeuds ',I9,/, & 15X,'- elements volumiques ',I9,/, & 15X,'- elements de bord de type flux ',I9,/, & 15X,'- elements de bord couples ',I9,/, & 15X,'- noeuds couples ',I9,/, & 15X,'- noeuds avec CL flux ',I9,/, & 15X,'- noeuds avec CL Dirichlet ',I9,/, & 15X,'- noeuds avec CL coefficient d''echange ',I9) 8010 FORMAT( & 15X,'- elts de bord avec resistance de contact ',I9,/, & 15X,'- noeuds avec resistance de contact ',I9,/, & 15X,'- elements volumiques periodiques ',I9,/, & 15X,'- noeuds periodiques ',I9,/, & 15X,'- elements surfaciques avec rayt confine ',I9,/, & 15X,'- noeuds avec rayonnement confine ',I9,/, & 15X,'- noeuds avec rayonnement infini ',I9,/, & 15X,'- noeuds en rotation ',I9) 8011 FORMAT( & 15X,'- noeuds avec flux volumique ',I9) 8012 FORMAT( & 15X,'- elements avec flux volumique ',I9) 8015 FORMAT(/,' *** EVADIM : CARACTERISTIQUES DU MAILLAGE DE', & ' RAYONNEMENT : ',/, & ' NOMBRE DE ...',/, & 15X,'- maillage rayonnement - nombre de noeuds ',I9,/, & 15X,'- maillage rayonnement - nombre d''elements',I9,/, & 15X,'- facettes couplees avec le solide ',I9,/, & 15X,'- facettes couplees avec le fluide ',I9,/, & 15X,'- facettes a temperature imposee ',I9,/, & 15X,'- facettes a flux impose ',I9,/, & 15X,'- facettes de type paroi equivalente ',I9,/, & 15X,'- facettes de type milieu semi transparent',I9,/, & 15X,'- noeuds couples avec le solide ',I9,/, & 15X,'- noeuds couples avec le fluide ',I9) 8020 FORMAT(/,' *** EVADIM : CARACTERISTIQUES DU MAILLAGE SOLIDE', & ' ELEMENTS FINIS : ',/, & ' NOMBRE DE ...',/, & 15X,'- noeuds ',I9,/, & 15X,'- elements volumiques ',I9,/, & 15X,'- elements de bord de type flux ',I9,/, & 15X,'- faces couplees ',I9,/, & 15X,'- noeuds couples ',I9,/, & 15X,'- faces avec CL flux ',I9,/, & 15X,'- noeuds avec CL Dirichlet ',I9,/, & 15X,'- faces avec CL coefficient d''echange ',I9) 8030 FORMAT( & 15X,'- faces avec resistance de contact ',I9,/, & 15X,'- noeuds avec resistance de contact ',I9,/, & 15X,'- elements volumiques periodiques ',I9,/, & 15X,'- noeuds periodiques ',I9,/, & 15X,'- elements surfaciques avec rayt confine ',I9,/, & 15X,'- noeuds avec rayonnement confine ',I9,/, & 15X,'- faces avec rayonnement infini ',I9,/, & 15X,'- noeuds en rotation ',I9) C 9100 FORMAT(/,' %% ERREUR EVADIM : LES RESISTANCES DE CONTACT', & ' NE SONT PAS AUTORISEES EN MODELE COQUE') 9200 FORMAT(/,' %% ERREUR EVADIM : Rayonnement confine :',/, & 20X,'Aucun element de rayonnement n''est couple au solide') C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/touta0.F0000666000175000017500000001701511524070644015273 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE TOUTA0 C ***************** C C ------------------------------------------------------------- *(NPOINS,NELEMS,NELESS,NELEUS,NELEPR,NELERC,NELERA, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS,NBCOPR, * NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NBICOR, * NBFFLU,NBFECH,NBFRAI,NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C MISE A ZERO INITIALE DES VARIABLES RELATIVES AU SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NPOINS ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NELESS ! E ! R ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NELEUS ! E ! R ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELEPR ! E ! R ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NBCOUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NELERA ! E ! R ! NBRE D'ELTS DU MAIL SURF SOLIDE AVEC RAYONNT ! C ! NBFLUS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBFLVS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C ! NBRESS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBRAIS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT INF! C ! NBFRAI ! E ! R ! NOMBRE DE FACES SOLIDES AVEC RAYONNEMENT INF ! C ! NBPRIO ! E ! R ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! R ! NOMBRE DE NOEUDS SOLIDES EN MOUVEMENT ! C ! NBCOPR ! E ! R ! NBRE DE CORRESPONDANTS POUR LES NOEUDS PERIOD! C ! NDIELE ! E ! R ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NDMATS ! E ! R ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NDMASS ! E ! R ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NBFACE ! E ! R ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NCOEMA ! E ! R ! NOMBRE DE COEF EXTRA DIAG DES MATRICES ELEM ! C ! NBPHYS ! E ! R ! NOMBRE DE VARIABLES PHYSIQUES SUR LE SOLIDE ! C ! NBICOR ! E ! R ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NPOINR ! E ! R ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! R ! NOMBRE D'ELEMENTS DU MAILLAGE RAYONNEMENT ! C ! NNSRAY ! E ! R ! NOMBRE DE NOEUDS COUPLE AU SOLIDE ! C ! NNFRAY ! E ! R ! NOMBRE DE NOEUDS COUPLE AU FLUIDE ! C ! NNERAY ! E ! R ! NOMBRE DE NOEUDS DE TYPE ENTREE/SORTIE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : IFICCT,INOMCT,OPENCT,LECMCL,EVADIM C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "fichct.h" #include "syrth.h" #include "xrefer.h" C C ********************************************************************** C C C.. Variables externes C INTEGER NPOINS,NELEMS,NELESS,NELEUS,NELEPR,NELERC,NELERA INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NBRESS INTEGER NBRAYS,NBRAIS,NBPRIO,NBMOBS,NBCOPR INTEGER NDIELE,NDMATS,NDMASS,NBFACE,NCOEMA,NBPHYS,NBICOR INTEGER NBFFLU,NBFECH,NBFRAI,NPOINR,NELRAY,NNSRAY,NNFRAY,NNERAY INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA,NFMST,NFMSTE C INTEGER N C C*********************************************************************** C NPOINS = 0 NELEMS = 0 NELESS = 0 NELEUS = 0 NELEPR = 0 NELERC = 0 NELERA = 0 NBCOUS = 0 NBFLUS = 0 NBDIRS = 0 NBECHS = 0 NBFLVS = 0 NBRESS = 0 NBRAYS = 0 NBRAIS = 0 NBPRIO = 0 NBMOBS = 0 NBCOPR = 0 NDIELE = 0 NDMATS = 0 NDMASS = 0 NBFACE = 0 NCOEMA = 0 NBPHYS = 0 NBICOR = 0 NBFFLU = 0 NBFECH = 0 NBFRAI = 0 NPOINR = 0 NELRAY = 0 NNSRAY = 0 NNFRAY = 0 NNERAY = 0 NFCSRA = 0 NFCFRA = 0 NFTIRA = 0 NFFIRA = 0 NFPERA = 0 NFMST = 0 NFMSTE = 0 C DO N=1,NRFMAX IREFFC(N)=0 IREFSC(N)=0 IREFSD(N)=0 IREFSF(N)=0 IREFSE(N)=0 IREFSV(N)=0 IREFRE(N)=0 IREFRA(N)=0 IREFPR(N)=0 IREFMO(N)=0 IREFRI(N)=0 IREFRF(N)=0 IRERCS(N)=0 IRERCF(N)=0 IRERTI(N)=0 IRERFI(N)=0 IRERPE(N)=0 IRESTE(N)=0 IRESTF(N)=0 IRESTS(N)=0 IRESTB(N)=0 IRESTC(N)=0 ENDDO C END syrthes-3.4.3-dfsg1/src/s/lecme1.F0000666000175000017500000001177411524070644015233 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 SUBROUTINE LECME1 C ***************** C C ---------------------------------------------------------------- *(NPOINS,NELEMS,NBNO) C ---------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUEDE MED * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #ifdef MED #include "med.hf" #endif C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NELEMS,NBNO C #ifdef MED C.. Variables internes CHARACTER*32 NOM INTEGER IRET,IDIM,NN C C*********************************************************************** C C lire le nom du maillage CALL EFMAAI(NFSGCT,1,NOM,IDIM,IRET) C C nombre de noeuds CALL EFNEMA(NFSGCT,NOM,MED_COOR,MED_NOEUD,0,0,NPOINS,IRET) C C nombre d'elements IF (NBNO.EQ.2) THEN CALL EFNEMA(NFSGCT,NOM,MED_CONN, * MED_MAILLE,MED_SEG2,MED_NOD,NN,IRET) ELSEIF (NBNO.EQ.3) THEN CALL EFNEMA(NFSGCT,NOM,MED_CONN, * MED_MAILLE,MED_TRIA3,MED_NOD,NN,IRET) ELSEIF (NBNO.EQ.6) THEN CALL EFNEMA(NFSGCT,NOM,MED_CONN, * MED_MAILLE,MED_TRIA6,MED_NOD,NN,IRET) ELSEIF (NBNO.EQ.10) THEN CALL EFNEMA(NFSGCT,NOM,MED_CONN, * MED_MAILLE,MED_TETRA10,MED_NOD,NN,IRET) ELSE WRITE(NFECRA,2000) STOP ENDIF C NELEMS=NN C C-------- C FORMATS C-------- C C 2000 FORMAT(/,' %% ERREUR LECME1 : TYPE D''ELEMENT INCONNU') C #endif END syrthes-3.4.3-dfsg1/src/s/verlos.F0000666000175000017500000000437411524070644015375 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE VERLOS ( CHAINE, II1, II2, LPOS ) C ==================================================================== C C BUT : VERIFICATION DE LA LONGUEUR D'UNE CHAINE DE CARACTERES C ----- C C PARAMETRES D'ENTREE : C --------------------- C CHAINE : CHAINE DE CARACTERES A VERIFIER C C PARAMETRES DE SORTIE : C ---------------------- C II1 : POSITION DU PREMIER CARACTERE NON BLANC C II2 : POSITION DU DERNIER CARACTERE NON BLANC C LPOS : LONGUEUR EFFECTIVE DE LA CHAINE C C AUTEURS : SOCIETE SIMULOG : ALAIN DUTOYA C -------- C C ==================================================================== C IMPLICIT NONE C C ==================================================================== C CHARACTER CHAINE*(*) INTEGER II1,II2,LPOS C INTEGER N1,IPRBLS,IDRBLS C C ==================================================================== C II1 = 0 II2 = 0 LPOS = 0 N1 = LEN ( CHAINE ) IF ( N1 .LE. 0 ) RETURN C II1 = IPRBLS ( CHAINE, N1 ) II2 = IDRBLS ( CHAINE, N1 ) LPOS = II2 - II1 + 1 C END syrthes-3.4.3-dfsg1/src/s/orient_3d.c0000666000175000017500000007622311524070644016010 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" int nelvoip; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | orie3d | | | |======================================================================| */ void orie3d (int *nodray, int nelray, int npoinr, int *nrfray, double *cooray, double *pinter, int numgu, int ndim, int nblblr,int *grconv) { int *grconx, *norini, *ifabor ; int numg,i,ielem,nbmalo ; ifabor = (int *)malloc( nelray * 3 * sizeof(int)); grconx = (int *)malloc( nelray * sizeof(int)); if (ifabor==NULL || grconx==NULL) {printf(" ERREUR orie3d : probleme d'allocation memoire\n"); exit(0);} nbmalo = 0 ; voisic_3d(ifabor,nodray,nelray,npoinr,nblblr) ; connex_3d(ifabor,grconx,nelray,npoinr,&numg,numgu,nblblr) ; /* On stockera autant d'elements de depart que de surfaces connexes trouves */ norini = (int *)malloc( numg * sizeof(int)); if (norini==NULL) {printf(" ERREUR orie3d : probleme d'allocation memoire\n"); exit(0);} iniori_3d(ifabor,nodray,cooray,nrfray,grconx,nelray,npoinr, pinter,&numg,ndim,norini,grconv,numgu,&nbmalo,nblblr) ; oriene_3d( ifabor, nodray, nelray, grconx, norini, &numg, &nbmalo,nblblr) ; /* 4- Post processing pour developpeur (IR,CP) ---------------------------------------------- */ if ( nblblr > 10 ) { for ( i=0; i < 3 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] += 1 ; } printf("\n Table des elements colles aux faces de chaque element \n ") ; for ( ielem=0; ielem < nelray; ielem++ ) { printf( " Element %d : %d %d %d \n", ielem+1, ifabor[ielem] ,ifabor[ielem+ nelray] , ifabor[ielem+2* nelray] ) ; } } free(grconx) ;free(norini) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | voisic_3d | | | |======================================================================| */ void voisic_3d(int *ifabor, int *nodray, int nelray, int npoinr, int nblblr) { int i,m1,m2; int i1,i2,imax,npmax; int iface,iface2,ielem,ielem2; int somfac[6]; int *nvois,*iadr,*mat; somfac[0] = 0; somfac[1] = 1; somfac[2] = 1; somfac[3] = 2; somfac[4] = 2; somfac[5] = 0; nvois = (int *)malloc( (npoinr) * sizeof(int)); if (nvois==NULL) {printf(" ERREUR voisic_3d : probleme d'allocation memoire\n"); exit(0);} /* 1- INITIALISATION ==================== */ for (i=0; i < npoinr ; i++) *(nvois+i) = 2 ; for (iface=0; iface < 3 ; iface++) { for ( ielem=0; ielem < nelray; ielem++ ) { i1 = nodray[ielem + nelray*somfac[2*iface]]; i2 = nodray[ielem + nelray*somfac[2*iface+1]]; nvois[i1-1] += 1 ; nvois[i2-1] += 1 ; } } for (i=0; i < npoinr ; i++) nvois[i] = nvois[i] / 2 ; nelvoip = 0; for (i=0; i< npoinr;i++) if (nelvoip < nvois[i] ) {nelvoip = nvois[i] ; npmax = i;} if (nblblr>=10) { printf("\n *** VOISIC_3D : Point ayant le plus d'elements attaches : %d\n", npmax+1); printf(" Nombre d'elements rattaches : %d\n", nelvoip-1); } iadr = (int *)malloc( (npoinr) * sizeof(int)); mat = (int *)malloc( (npoinr) * 3*nelvoip * sizeof(int)); if (iadr==NULL || mat==NULL) {printf(" ERREUR voisic_3d : probleme d'allocation memoire\n"); exit(0);} /* 2- Calcul des adresses de chaque point dans une structure de type matrice compacte ========================================================= */ iadr[0] = 0 ; for (i=1; i < npoinr ; i++) { iadr[i] = iadr[i-1] + nvois[i-1] ; } imax = iadr[npoinr-1] + nvois[npoinr-1] ; if ( imax > 3*nelvoip* npoinr ) printf("\n Augmenter la taille memoire : voir developpeurs (CP,IR)\n"); for (i=0; i < imax ; i++) *(mat+i) = 0 ; /* 3- BOUCLE SUR LES FACES DE CHAQUE ELEMENT : =========================================== */ for (iface=0; iface < 3 ; iface++) { for ( ielem=0; ielem < nelray ; ielem++ ) { ifabor[ielem+ nelray*iface] = -1 ; i1 = nodray[ielem+nelray*somfac[2*iface]]; i2 = nodray[ielem+nelray*somfac[2*iface+1]]; if ( i1 < i2 ) { m1 = i1 ; m2 = i2 ; } else { m1 = i2 ; m2 = i1 ; } for ( i=1 ; i < nvois[m1-1]+1 ; i++ ) { if ( mat[iadr[m1-1]+i-1] == 0 ) { mat[iadr[m1-1]+i-1] = m2 ; mat[iadr[m1-1]+i-1+nelvoip* npoinr] = ielem ; mat[iadr[m1-1]+i-1+2*nelvoip* npoinr] = iface ; goto sortie ; } else if ( mat[iadr[m1-1]+i-1] == m2 ) { ielem2 = mat[iadr[m1-1]+i-1+nelvoip* npoinr] ; iface2 = mat[iadr[m1-1]+i-1+2*nelvoip* npoinr] ; ifabor[ielem+nelray*iface] = ielem2 ; ifabor[ielem2+nelray*iface2] = ielem ; goto sortie ; } } printf("\n --> ERREUR VOISIC_3D : erreur dans le maillage\n"); printf(" il y a peut etre des points confondus \n") ; sortie : ; } /* Fin de la boucle sur les elements */ } /* Fin de la boucle sur les faces */ /* 4- Post processing pour developpeur (IR,CP) ---------------------------------------------- */ if ( nblblr > 10 ) { for ( i=0; i < 3 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] += 1 ; } printf(" VOISIC_3D : Table des elements colles aux faces de chaque element \n ") ; for ( ielem=0; ielem < nelray; ielem++ ) { printf( " VOISIC_3D :Element %d : %d %d %d\n", ielem+1, ifabor[ielem] ,ifabor[ielem+ nelray],ifabor[ielem+ 2*nelray] ) ; } for ( i=0; i < 3 * nelray; i++ ) { if ( ifabor[i] != -1 ) ifabor[i] -= 1 ; } } free(nvois) ; free(mat) ; free(iadr) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | connex_3d | | | |======================================================================| */ void connex_3d(int *ifabor,int *grconx,int nelray,int npoinr, int *numg,int numgu, int nblblr) { int i,j; int iel1,iel2; for (i=0; i < nelray ; i++) *(grconx+i) = 0 ; *numg = 1 ; grconx[0] = *numg ; iel1=0; if (ifabor[iel1+2* nelray]+ifabor[iel1+nelray]+ifabor[iel1]==-3 ) { printf("\n $$ ATTENTION CONNEX_3D : element %d isole \n" , iel1+1) ; } else { for (i=0; i < 3 ; i++ ) { iel2 = ifabor[iel1+i* nelray] ; if (iel2==-1) continue; if (grconx[iel2]!=0) continue ; group_3d(iel1,iel2,nelray,grconx,ifabor,nblblr) ; } } for (j=0; j < nelray ; j++ ) { if ( grconx[j] == 0 ) { if ( nblblr>10 ) printf(" *** CONNEX_3D : l'element %d n'appartient pas encore a un groupe\n", j+1) ; iel1 = j ; iel2 = -10 ; *numg += 1 ; grconx[j] = *numg ; if(ifabor[iel1+2* nelray]+ifabor[iel1+nelray]+ifabor[iel1]==-3) { printf("\n $$ ATTENTION CONNEX_3 : element %d isole \n" , iel1+1) ; continue ; } for (i=0; i < 3 ; i++ ) { iel2 = ifabor[iel1+i* nelray] ; if (iel2 ==-1) continue; if (grconx[iel2]!=0) continue ; group_3d( iel1,iel2,nelray,grconx,ifabor,nblblr ) ; } } /* Fin du test sur l'appartenance a un groupe */ } /* Fin de la boucle sur tous les elements */ printf("\n *** CONNEX_3D : le maillage surfacique contient %d surfaces connexes et %d volumes connexes \n",*numg,numgu ); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | group_3d | | | |======================================================================| */ void group_3d(int iel1,int iel2,int nelray,int *grconx,int *ifabor, int nblblr) { int i ; int ielv ; grconx[iel2] = grconx[iel1] ; /* printf(" dans group2 : iel1+1=%d iel2+1=%d \n",iel1+1,iel2+1); printf(" grconx[iel1]+1 : %d",grconx[iel1]); */ for (i=0; i < 3 ; i++ ) { ielv = ifabor[iel2+i* nelray] ; if ( ielv != -1 && grconx[ielv] == 0) { group_3d( iel2,ielv,nelray,grconx,ifabor,nblblr) ; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | oriene_3d | | | |======================================================================| */ void oriene_3d(int *ifabor, int *nodray, int nelray, int *grconx, int *norini, int *numg, int* nbmalo, int nblblr) { int i,i1,i2,iel1,iel2; int iface; int somfac[6]; somfac[0] = 0; somfac[1] = 1; somfac[2] = 1; somfac[3] = 2; somfac[4] = 2; somfac[5] = 0; for ( i=0 ; i < *numg ; i++ ) { iel1 = norini[i] ; for ( iface=0 ; iface < 3 ; iface++ ) { i1 = nodray[iel1+ nelray * somfac[2*iface] ] ; i2 = nodray[iel1+ nelray * somfac[2*iface +1] ] ; iel2 = ifabor[iel1 + iface* nelray] ; if ( iel2 != -1 && grconx[iel2] > 0 ) { rorien_3d( iel1,i1,i2,iel2,ifabor,grconx,nodray,nelray, nbmalo,nblblr ) ; } } } printf("\n *** ORIENE_3D : le nombre de facettes reorientees est : %d \n", *nbmalo); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | rorien_3d | | | |======================================================================| */ void rorien_3d(int iel1,int i1,int i2,int iel2,int *ifabor,int *grconx, int *nodray,int nelray, int *nbmalo, int nblblr) { int j1,j2; int ielv,iface; int lmalo,nodaux,neleaux; int somfac[6]; somfac[0] = 0; somfac[1] = 1; somfac[2] = 1; somfac[3] = 2; somfac[4] = 2; somfac[5] = 0; lmalo = 0 ; for ( iface=0 ; iface < 3 ; iface++ ) { j1 = nodray[iel2+ nelray * somfac[2*iface] ] ; j2 = nodray[iel2+ nelray * somfac[2*iface +1] ] ; if ( j1 == i1 && j2 == i2 ) { lmalo = 1 ; } } if ( lmalo == 1 ) { *nbmalo += 1 ; nodaux = nodray[iel2+ nelray * somfac[2] ] ; nodray[iel2+ nelray * somfac[2] ] = nodray[iel2+ nelray * somfac[3] ] ; nodray[iel2+ nelray * somfac[3] ] = nodaux ; neleaux = ifabor[iel2] ; ifabor[iel2] = ifabor[iel2 + 2 * nelray ] ; ifabor[iel2 + 2 * nelray] = neleaux ; grconx[iel2] = - grconx[iel2] ; if (nblblr>10) printf("\n *** RORIEN_3D : la facette %d etait mal orientee \n",iel2+1 ); } else { /* L'element etait deja bien oriente */ grconx[iel2] = - grconx[iel2] ; } for ( iface=0 ; iface < 3 ; iface++ ) { j1 = nodray[iel2+ nelray * somfac[2*iface] ] ; j2 = nodray[iel2+ nelray * somfac[2*iface +1] ] ; ielv = ifabor[iel2 + iface* nelray] ; if ( ielv != -1 && grconx[ielv] > 0 ) { rorien_3d(iel1,j1,j2,ielv,ifabor,grconx,nodray,nelray,nbmalo,nblblr) ; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | iniori_3d | | Initialisation des processus recursifs | |======================================================================| */ void iniori_3d(int *ifabor,int *nodray,double *cooray,int *nrfray, int *grconx,int nelray,int npoinr, double *pvinter,int *numg,int ndim,int *norini, int *grconv,int numgu, int *nbmalo, int nblblr) { int i,j,k,imin ; int n1,n2,n3 ; int iel,nodaux,neleaux ; int iv,pintok,dejaunpoint; double xint,yint,zint ; double dmin ; double x1,y1,z1,x2,y2,z2,x3,y3,z3 ; double x12,y12,z12,x13,y13,z13 ; double xnorelx,xnorely,xnorelz,xnormel ; double xvecgix,xvecgiy,xvecgiz,xnormve ; double xvec1ix,xvec1iy,xvec1iz ; double pscal ; double xxg,yyg,zzg; double dist; int *norinit, *npvint, *ncompteur ; double eps ; eps = 1e-6 ; norinit = (int *)malloc( *numg * numgu * sizeof(int) ); npvint = (int *)malloc( *numg * sizeof(int) ); ncompteur = (int *)malloc( *numg * sizeof(int) ); if (norinit==NULL || npvint==NULL || ncompteur==NULL) {printf(" ERREUR iniori_3d : probleme d'allocation memoire\n"); exit(0);} for (i=0; i < nelray ; i++) *(grconv+i) = 0 ; for (i=0; i < *numg ; i++) *(npvint+i) = 0 ; for (i=0; i < *numg ; i++) *(ncompteur+i) = 0 ; for (i=0; i < *numg*numgu ; i++) *(norinit+i) = 0 ; if ( nblblr > 10 ) { for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_2D : Element , nrfray : %d %d \n",i+1,nrfray[i] ) ; printf("\n"); for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_2D : Element , grconx : %d %d \n",i+1,grconx[i] ) ; printf("\n"); for ( i=0 ; i < npoinr ; i++ ) { printf(" INIORI_2D : Noeud %d x y z : %f %f %f \n",i+1,cooray[i],cooray[i+npoinr],cooray[i+2* npoinr]) ; } } /* Boucle sur les surfaces connexes */ for ( j=0 ; j < *numg ; j++ ) { /* boucle sur les points volumiques internes */ for (iv=0;iv -eps && xnormel < eps ) { printf( "\n --> ERREUR INIORI_3D : l'element %d est vraisemblablement degenere\n", i+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; xnorelz = xnorelz / xnormel ; } xvecgix = xint - xxg ; xvecgiy = yint - yyg ; xvecgiz = zint - zzg ; xnormve = sqrt( xvecgix*xvecgix + xvecgiy*xvecgiy + xvecgiz*xvecgiz ) ; if ( xnormve > -eps && xnormve < eps ) { printf("\n $$ ATTENTION INIORI_3D : le point interne %d \n",j+1); printf(" de coordonnees xc = %f , yc = %f , zc = %f \n", xint,yint,zint); printf(" est mal choisi, car confondu avec le centre de gravite\n"); exit(0) ; } else { xvecgix = xvecgix / xnormve ; xvecgiy = xvecgiy / xnormve ; xvecgiz = xvecgiz / xnormve ; } pscal = xnorelx*xvecgix + xnorely*xvecgiy + xnorelz*xvecgiz ; if ( pscal > -eps && pscal < eps ) { printf("\n $$ ATTENTION INIORI_3D : le point interne %d \n",j+1); printf(" de coordonnees xc = %f , yc = %f , zc = %f \n", xint,yint,zint); printf(" est mal choisi, car dans le plan de la facette %d\n",i); exit(0) ; } /* Verification de non recoupage de la surface connexe j */ xvecgix = xvecgix * xnormve ; xvecgiy = xvecgiy * xnormve ; xvecgiz = xvecgiz * xnormve ; for ( k=0;k changer la position du point %d \n",iv+1); exit(0);} } } /* Stockage de tous les elements correspondants au couple iv et surface connexe j */ norinit[iv +j*numgu] = imin ; if (nblblr > 10 ) {for (k=0;k<*numg*numgu;k++) printf (" INIORI_3D : norinit[ %d ] = %d \n",k+1,norinit[k]+1);} } } if (nblblr>10) for (iv=0;iv10) printf(" *** INIORI_3D : composante connexe j = %d noeud interieur iv = %d \n",j+1,iv+1); for ( k=0;k10) printf(" comp conex %d facette testee k = %d \n",j+1,k+1); n1 = nodray[k]-1 ; x1 = cooray[n1] ; y1 = cooray[n1+ npoinr] ; z1 = cooray[n1+2 * npoinr] ; n2 = nodray[k+ nelray]-1 ; x2 = cooray[n2] ; y2 = cooray[n2+ npoinr] ; z2 = cooray[n2+2 * npoinr] ; n3 = nodray[k+ 2 * nelray]-1 ; x3 = cooray[n3] ; y3 = cooray[n3+ npoinr] ; z3 = cooray[n3+2 * npoinr] ; if (racines_3d(x1,y1,z1,x2,y2,z2,x3,y3,z3,xvecgix,xvecgiy,xvecgiz,xxg,yyg,zzg,k)) { if (nblblr > 10 ) printf(" *** INIORI_3D : Intersection avec une autre surface connexe (face %d) composante connexe %d \n", k+1,grconx[k]); ncompteur[grconx[k]-1] += 1; } } } if (nblblr>10) printf(" *** INIORI_3D : composante connexe j = %d noeud interieur iv = %d \n",j+1,iv+1); if (nblblr>10) {for (i=0;i<*numg;i++) printf( " INIORI_3D : ncompteur[ %d ] = %d \n",i+1,ncompteur[i]);} pintok =1; /* Flag des intersections impaires */ for (i=0; i<*numg;i++) { if ((ncompteur[i]/2)*2-ncompteur[i]!=0) pintok = 0; } if (pintok == 0) {if (nblblr>10) printf( " *** INIORI_3D : le point interieur %d non ok pour la surface connexe j %d \n",iv+1,j+1);} else { if (dejaunpoint==1) { printf("\n *** INIORI_3D : Ce volume est :\n"); printf(" soit deja defini par un point precedent \n"); printf(" soit une ambiguite existe sur le volume ---> a verifier tres soigneusement \n" ); printf(" --> essayer de modifier la position du noeud interieur %d \n",iv+1); exit(0); } else {norini[j] = iel;npvint[j]=iv;dejaunpoint=1;} } } if (dejaunpoint==0 ) { printf("\n *** INIORI_3D : Il y a un probleme pour la surface connexe j= %d\n" ,j+1); printf(" Aucun des points fournis par l'utilisateur ne permet de la definir \n"); printf(" Verifier bien que tous les volumes independants ont ete definis par un point \n"); exit(0); } } if (nblblr>=10) {for (i=0;i<*numg;i++) printf(" *** INIORI_3D : Composante connexe %d face de depart %d point interieur %d \n", i+1,norini[i]+1,npvint[i]+1);} /* Traitement proprement dit */ for ( j= 0 ; j < *numg ; j++ ) { xint = pvinter[3*npvint[j]] ; yint = pvinter[3*npvint[j] + 1] ; zint = pvinter[3*npvint[j] + 2] ; iel = norini[j] ; n1 = nodray[iel]-1 ; x1 = cooray[n1] ; y1 = cooray[n1+ npoinr] ; z1 = cooray[n1+2 * npoinr] ; n2 = nodray[iel+ nelray]-1 ; x2 = cooray[n2] ; y2 = cooray[n2+ npoinr] ; z2 = cooray[n2+2 * npoinr] ; n3 = nodray[iel+ 2 * nelray]-1 ; x3 = cooray[n3] ; y3 = cooray[n3+ npoinr] ; z3 = cooray[n3+2 * npoinr] ; x12 = x2 - x1 ; y12 = y2 - y1 ; z12 = z2 - z1 ; x13 = x3 - x1 ; y13 = y3 - y1 ; z13 = z3 - z1 ; xnorelx = y12*z13 - z12*y13 ; xnorely = -x12*z13 + z12*x13 ; xnorelz = x12*y13 - y12*x13 ; xnormel = sqrt( xnorelx*xnorelx + xnorely*xnorely + xnorelz*xnorelz ) ; if ( xnormel > -eps && xnormel < eps ) { printf( "\n --> ERREUR INIORI_3D : l'element %d est vraisemblablement degenere\n", iel+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; xnorelz = xnorelz / xnormel ; } xvec1ix = xint - x1 ; xvec1iy = yint - y1 ; xvec1iz = zint - z1 ; xnormve = sqrt( xvec1ix*xvec1ix + xvec1iy*xvec1iy + xvec1iz*xvec1iz ) ; if ( xnormve > -eps && xnormve < eps ) { printf("\n --> ERREUR INIORI_3D : le point interne %d \n",j+1); printf(" de coordonnees xc = %f , yc = %f , zc = %f \n", xint,yint,zint); printf(" est mal choisi, car confondu avec le noeud %d\n",n1); exit(0) ; } else { xvec1ix = xvec1ix / xnormve ; xvec1iy = xvec1iy / xnormve ; xvec1iz = xvec1iz / xnormve ; } pscal = xnorelx*xvec1ix + xnorely*xvec1iy + xnorelz*xvec1iz ; if ( pscal > -eps && pscal < eps ) { printf("\n --> ERREUR INIORI_3D : le point interne %d \n",j+1); printf(" de coordonnees xc = %f , yc = %f , zc = %f \n", xint,yint,zint); printf(" est mal choisi, car dans l'alignelement de la facette %d\n",iel); exit(0) ; } if ( pscal < -eps ) { nodaux = nodray[iel+ nelray ] ; nodray[iel+ nelray ] = nodray[iel+ nelray * 2 ] ; nodray[iel+ nelray * 2 ] = nodaux ; neleaux = ifabor[iel] ; ifabor[iel] = ifabor[iel + 2 * nelray ] ; ifabor[iel + 2 * nelray] = neleaux ; *nbmalo += 1 ; if ( nblblr == 11 ) printf( " INIORI_3D : la facette initiale %d etait mal orientee \n", iel+1 ) ; } } /* Volumes connexes */ for (j=0;j<*numg;j++) { for (k=0;k10) {for ( i=0 ; i < nelray ; i++ ) printf(" INIORI_3D : element , grconv : %d %d \n",i,grconv[i] ) ;} free(norinit);free(npvint);free(ncompteur) ; } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | racines_3d | | Calcul de la racine eventuelle entre la facette consideree | | et le vecteur xvec,yvec,zvec | | Si l'intersection n'est pas dans le triangle on met 1e6 | | sur chaque composante | |======================================================================| */ int racines_3d(double x1,double y1,double z1, double x2,double y2,double z2,double x3,double y3,double z3, double xvec,double yvec,double zvec, double xxg,double yyg,double zzg,int iel) { int ii; double eps; double denom,numer,alfa,d,xp,yp,zp; double x12,y12,z12,x13,y13,z13; double xnorelx,xnorely,xnorelz,xnormel; eps = 1.e-8; alfa = 1.e6; x12 = x2 - x1 ; y12 = y2 - y1 ; z12 = z2 - z1 ; x13 = x3 - x1 ; y13 = y3 - y1 ; z13 = z3 - z1 ; xnorelx = y12*z13 - z12*y13 ; xnorely = -x12*z13 + z12*x13 ; xnorelz = x12*y13 - y12*x13 ; xnormel = sqrt( xnorelx*xnorelx + xnorely*xnorely + xnorelz*xnorelz ) ; if ( xnormel > -eps && xnormel < eps ) { printf("\n --> ERREUR RACINES_3D : l'element %d est vraisemblablement degenere\n",iel+1 ) ; exit(0) ; } else { xnorelx = xnorelx / xnormel ; xnorely = xnorely / xnormel ; xnorelz = xnorelz / xnormel ; } d = -x1*xnorelx-y1*xnorely-z1*xnorelz; denom = xnorelx*xvec+xnorely*yvec+xnorelz*zvec; if ( abs(denom) > eps ) { numer = - ( xnorelx*xxg + xnorely*yyg + xnorelz*zzg + d); alfa = numer/denom; } if ((0. GLOBAUX ! C ! NODEUS ! TR ! D ! // NOEUDS BORD LOCAUX --> GLOBAUX ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NELEUS,NDMASS,NPOINS DOUBLE PRECISION VOLUME(NELEMS),COORDS(NPOINS,NDIM) INTEGER NODES(NELEMS,NDMATS),NODEUS(NELEUS,NDMASS) INTEGER NANGLE(NELEMS) DOUBLE PRECISION SURFUS(NELEUS) C INTEGER I,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 INTEGER NPETIT,NPETIU DOUBLE PRECISION EPSVOL,EPSVOU,S6,S23 DOUBLE PRECISION X1,Y1,Z1 DOUBLE PRECISION X2,Y2,Z2 DOUBLE PRECISION X3,Y3,Z3 DOUBLE PRECISION X4,Y4,Z4 DOUBLE PRECISION X12,Y12,Z12 DOUBLE PRECISION X13,Y13,Z13 DOUBLE PRECISION X14,Y14,Z14 C C..Variables internes DOUBLE PRECISION GRAND,CC LOGICAL LVERIF C INTEGER NANG C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. GRAND = 1.0D+6 C EPSVOL = 1.0D-6 C S6 = 1.D0 / 6.D0 S23 = 2.D0 / 3.D0 C DO 100 I=1,NELEMS VOLUME(I) = 0.D0 NANGLE(I) = 0 100 CONTINUE C DO 110 I=1,NELEUS SURFUS(I) = 0.D0 110 CONTINUE C NPETIT = 0 NPETIU = 0 C NANG=0 C C 2- CALCUL DE VOLUME , ET SURFUS C ======================================= C C 2.1- Cas d'un espace discretise en triangle C ------------------------------------------- IF ( NDIELE .EQ. 2 ) THEN C EPSVOU = EPSVOL EPSVOL = EPSVOL*EPSVOL C C 2.1.1- Cas bidimentionnel cartesien et axisymetrique C ---------------------------------------------------- IF ( NDIM .EQ. 2 ) THEN C DO 211 I=1,NELEMS C C Indices des noeuds N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) C X1 = COORDS(N1,1) Y1 = COORDS(N1,2) X2 = COORDS(N2,1) Y2 = COORDS(N2,2) X3 = COORDS(N3,1) Y3 = COORDS(N3,2) C X12 = X2 - X1 Y12 = Y2 - Y1 X13 = X3 - X1 Y13 = Y3 - Y1 C C S = ( 12 Vectoriel 13 ) / 2 VOLUME(I) = 0.5D0 * ABS ( X12*Y13 - Y12*X13 ) C IF( VOLUME(I) .LT. EPSVOL ) THEN NPETIT = NPETIT + 1 ENDIF C C Reperage des eventuels angles ouverts CC=(X12*X13+Y12*Y13)/ * (SQRT(X12**2+Y12**2)*SQRT(X13**2+Y13**2)) IF (CC.LT.0) NANGLE(I)=1 C X12 = X1 - X2 Y12 = Y1 - Y2 X13 = X3 - X2 Y13 = Y3 - Y2 CC=(X12*X13+Y12*Y13)/ * (SQRT(X12**2+Y12**2)*SQRT(X13**2+Y13**2)) IF (CC.LT.0) NANGLE(I)=2 C X12 = X1 - X3 Y12 = Y1 - Y3 X13 = X2 - X3 Y13 = Y2 - Y3 CC=(X12*X13+Y12*Y13)/ * (SQRT(X12**2+Y12**2)*SQRT(X13**2+Y13**2)) IF (CC.LT.0) NANGLE(I)=3 C 211 CONTINUE C C C C 2.1.2- Calcul de SURFUS (segment) C --------------------------------- C DO 212 I=1,NELEUS C C Calcul des indices N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C C X1 = COORDS(N1,1) Y1 = COORDS(N1,2) X2 = COORDS(N2,1) Y2 = COORDS(N2,2) C X12 = X2 - X1 Y12 = Y2 - Y1 C SURFUS(I) = SQRT ( X12 * X12 + Y12 * Y12 ) C IF( SURFUS(I) .LT. EPSVOU ) THEN NPETIU = NPETIU + 1 ENDIF C 212 CONTINUE C C 2.1.3- Cas coque (triangle dans espace 3D) C ------------------------------------------ ELSE C DO 213 I=1,NELEMS C C Calcul des indices N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) C C X1 = COORDS(N1,1) Y1 = COORDS(N1,2) Z1 = COORDS(N1,3) X2 = COORDS(N2,1) Y2 = COORDS(N2,2) Z2 = COORDS(N2,3) X3 = COORDS(N3,1) Y3 = COORDS(N3,2) Z3 = COORDS(N3,3) C X12 = X2 - X1 Y12 = Y2 - Y1 Z12 = Z2 - Z1 X13 = X3 - X1 Y13 = Y3 - Y1 Z13 = Z3 - Z1 C C S = ( 12 Vectoriel 13 ) / 2 VOLUME(I) = 0.5D0 * SQRT ( & ( Y12*Z13 - Z12*Y13 )*( Y12*Z13 - Z12*Y13 ) & + ( X12*Z13 - Z12*X13 )*( X12*Z13 - Z12*X13 ) & + ( X12*Y13 - Y12*X13 )*( X12*Y13 - Y12*X13 ) & ) C IF( VOLUME(I) .LT. EPSVOL ) THEN NPETIT = NPETIT + 1 ENDIF C 213 CONTINUE C C Fin du cas portant sur les triangles cartesiens C axisymetriques, et coque ENDIF C C C 2.2- Cas des tetraedres C ----------------------- ELSE C EPSVOU = EPSVOL*EPSVOL EPSVOL = EPSVOL*EPSVOL*EPSVOL C C 2.2.1- Calcul de VOLUME C ----------------------- DO 221 I=1,NELEMS C C Indices des noeuds N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) C X1 = COORDS(N1,1) X2 = COORDS(N2,1) X3 = COORDS(N3,1) X4 = COORDS(N4,1) Y1 = COORDS(N1,2) Y2 = COORDS(N2,2) Y3 = COORDS(N3,2) Y4 = COORDS(N4,2) Z1 = COORDS(N1,3) Z2 = COORDS(N2,3) Z3 = COORDS(N3,3) Z4 = COORDS(N4,3) C C Calcul du volume X12 = X2 - X1 X13 = X3 - X1 X14 = X4 - X1 Y12 = Y2 - Y1 Y13 = Y3 - Y1 Y14 = Y4 - Y1 Z12 = Z2 - Z1 Z13 = Z3 - Z1 Z14 = Z4 - Z1 C VOLUME(I) = S6 * ABS ( X12 * ( Y13*Z14 - Z13*Y14 ) & -X13 * ( Y12*Z14 - Z12*Y14 ) & +X14 * ( Y12*Z13 - Z12*Y13 ) ) C IF( VOLUME(I) .LT. EPSVOL ) THEN NPETIT = NPETIT + 1 WRITE(NFECRA,300) I,VOLUME(I) WRITE(NFECRA,301) N1,N2,N3,N4 WRITE(NFECRA,302) N1,X1,Y1,Z1 WRITE(NFECRA,302) N2,X2,Y2,Z2 WRITE(NFECRA,302) N3,X3,Y3,Z3 WRITE(NFECRA,302) N4,X4,Y4,Z4 ENDIF C C Reperage des eventuels angles ouverts c a completer si ca marche en 2D.... c CC=(X12*X13+Y12*Y13+Z12*Z13)/ c * (SQRT(X12**2+Y12**2+Z12**2)* c * SQRT(X13**2+Y13**2+Z13**2)) c IF (CC.LT.0) NANGLE(I)=1 C 221 CONTINUE C C C 2.2.5- Calcul de SURFUS C ----------------------- DO 225 I=1,NELEUS C C Calcul des indices N1 = NODEUS(I,1) N2 = NODEUS(I,2) N3 = NODEUS(I,3) C C X1 = COORDS(N1,1) X2 = COORDS(N2,1) X3 = COORDS(N3,1) Y1 = COORDS(N1,2) Y2 = COORDS(N2,2) Y3 = COORDS(N3,2) Z1 = COORDS(N1,3) Z2 = COORDS(N2,3) Z3 = COORDS(N3,3) C X12 = X2 - X1 X13 = X3 - X1 Y12 = Y2 - Y1 Y13 = Y3 - Y1 Z12 = Z2 - Z1 Z13 = Z3 - Z1 C C Calcul de la surface SURFUS(I) = 0.5D0 * SQRT ( & ( Y12*Z13 - Z12*Y13 ) * ( Y12*Z13 - Z12*Y13 ) & + ( X12*Z13 - Z12*X13 ) * ( X12*Z13 - Z12*X13 ) & + ( X12*Y13 - Y12*X13 ) * ( X12*Y13 - Y12*X13 ) & ) C C IF( SURFUS(I) .LT. EPSVOU ) THEN NPETIU = NPETIU + 1 ENDIF C 225 CONTINUE C C Fin du cas 3D ENDIF C C 2.3 Statistique et controle des elements degeneres C -------------------------------------------------- C IF ( NBLBLA.EQ.13 ) THEN C WRITE(NFECRA,1100) DO 230 I=1,NELEMS WRITE(NFECRA,1110) I,VOLUME(I) 230 CONTINUE C WRITE(NFECRA,1200) DO 231 I=1,NELEUS WRITE(NFECRA,1210) I,SURFUS(I) 231 CONTINUE C IF (NDIM.EQ.2) THEN DO I=1,NELEMS WRITE(NFECRA,104) I,NANGLE(I) ENDDO DO I=1,NELEMS IF(NANGLE(I).GE.1) NANG=NANG+1 ENDDO WRITE(NFECRA,105) NANG ENDIF C ENDIF C C IF ( NPETIT .GE. 1 .OR. NPETIU .GE. 1 ) THEN WRITE(NFECRA,2000) NPETIT,NPETIU STOP ENDIF C C-------- C FORMATS C-------- C 104 FORMAT (' SVOLUM : ELEMENT A ANGLE OUVERT ',I7,I7) 105 FORMAT (' SVOLUM : NOMBRE ELEMENT AVEC ANGLE OUVERT ',I7) 300 FORMAT (' SVOLUM : ELEMENT DEGENERE : ',I10,' VOLUME :',E12.5) 301 FORMAT (' SVOLUM : NOEUDS N1 N2 N3 N4 :',4I12) 302 FORMAT (' SVOLUM : NOEUD :',I12,' COORDS :',3E15.5) 1100 FORMAT (' SVOLUM : NUMERO DE L''ELEMENT ET VOLUME') 1110 FORMAT (I6,1X,E10.4) 1200 FORMAT (' SVOLUM : NUMERO DE L''ELEMENT DE BORD ET SURFUS') 1210 FORMAT (I6,1X,E10.4) 2000 FORMAT (/,' %% ERREUR SVOLUM : ',/ & 'NOMBRE D''ELEMENTS DEGENERES ',I4,/, & 19X,'NOMBRE D''ELEMENTS DE BORD DEGENERES ',I4 ) C RETURN END syrthes-3.4.3-dfsg1/src/s/matele.F0000666000175000017500000002040211524070644015320 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MATELE,SSI=0 C SUBROUTINE MATELE C ****************** C C ------------------------------------------------------ *( OP,DMAT,XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DES MATRICES ELEMENTAIRES POUR * C PROBLEMES BIDIMENSIONNELS ET TRIDIMENSIONNEL * C pour les cas isotropes et non isotropes * C * C * C * C Ce sous programme constitue une extension de travaux effectuees * C par F. JAUBERTEAU et J.P. GREGOIRE, portant sur l'integration * C analytique des matrices elementaires par les formules de * C Zienkiewicz * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! OP ! A ! D ! DEFINITION DU TYPE D'OPERATION ! C ! DMAT ! TR ! R ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! R ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! COEFMA ! TR ! D ! COEFFICIENTS DES MATRICES ! C ! ! ! ! coefma(n) = rho Cp / dt pour masse ! C ! PHYSOL ! TR ! D ! Tableau contenant les propri physiques ! C ! ! TR ! D ! On utilise uniquement PHYSOL(n,>=3) ! C ! ! ! ! contient les valeurs des kii sui isotro! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : DIFSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" C C*********************************************************************** C CHARACTER*8 OP INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA INTEGER NPOUE,NPPEL,NBPHYS C INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION DMAT(NPOINS),COEFMA(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS) DOUBLE PRECISION VOLUME(NELEMS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes DOUBLE PRECISION ZERO INTEGER I,J C C*********************************************************************** C C INITIALISATIONS C ================ C ZERO = 0.D0 C C C 1- CONSTRUCTION DE LA MATRICE DE MASSE ELEMENTAIRE C =================================================== C IF (OP(1:8).EQ.'MASSE ') THEN C CALL MAMASS( XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C C C 2- CONSTRUCTION DE LA MATRICE DE MASSE ELEMENTAIRE C =================================================== ELSEIF (OP(1:8).EQ.'DIFFU ') THEN C C 2.1 CAS ISOTROPES C ----------------- IF (ISOTRO .EQ. 1) THEN CALL MADIF1 (XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C C 2.2 CAS ORTHOTROPES C ------------------- ELSEIF (ISOTRO .EQ. 2) THEN CALL MADIF2 (XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C C 2.3 CAS ANISOTROPES C ------------------- ELSEIF (ISOTRO .EQ. 3) THEN CALL MADIF3 (XMAT,COEFMA,PHYSOL,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * NPOUE,NPPEL,NBPHYS, * WCT ) C ELSE WRITE(NFECRA,2309) STOP ENDIF C ELSE WRITE(NFECRA,2009) STOP ENDIF C C 3- ASSEMBLAGE DE LA DIAGONALE DE LA MATRICE C ============================================ C CALL OV ( 'X=C ',DMAT,DMAT,DMAT,ZERO,NPOINS ) CALL ASSEMB ( DMAT,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT) C C C 3- IMPRESSIONS DE CONTROLE C =========================== C IF (NBLBLA.EQ.11 .AND. OP(1:8).EQ.'MASSE ') THEN WRITE(NFECRA,3002) DO I=1,NPOINS WRITE(NFECRA,3003) I,DMAT(I) ENDDO ENDIF C IF ( NBLBLA.EQ.11 .AND. OP(1:8).EQ.'DIFFU ') THEN WRITE(NFECRA,3000) DO 300 I=1,NELEMS WRITE(NFECRA,3001) I,(XMAT(I,J),J=1,NCOEMA) 300 CONTINUE ENDIF C C C------ C FORMAT C------ C 2309 FORMAT(' %% ERREUR MATELE : Mauvaise valeur de ISOTRO') 2009 FORMAT(' %% ERREUR MATELE : Mauvais operateur demande') C 3000 FORMAT ( ' MATELE : NUMERO DE L''ELEMENT ', & 'ET VECTEURS ELEMENTAIRES POUR LA MATRICE DE DIFFUSION') 3001 FORMAT (I7,5X,25E22.15) 3002 FORMAT ( ' MATELE : NUMERO DE L''ELEMENT ', & 'ET MATRICE DE MASSE') 3003 FORMAT (I7,5X,E22.15) C END syrthes-3.4.3-dfsg1/src/s/asseus.F0000666000175000017500000001667011524070644015370 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ASSEUS,SSI=0 C SUBROUTINE ASSEUS C ***************** C C ----------------------------------------------------- *( VECTUS,NODEUS,NELEMS,NELEUS,NPOINS,NDMASS,NDIM,WCT) C ----------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- ASSEMBLAGE DES VECTEURS DE BORD POUR LES FLUX * C CAS BIDIMENSIONNEL, AXISYMETRIQUE * C ET TRIDIMENSIONNEL. * C Vecteur non necessairement initialise a 0 * C * C ATTENTION : Dans ce sous-programme on force la vectorisation * C si l'instruction CDIR$ est active * C ce qui suppose un arrangement des elements adapte. * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! VECTUS ! TR ! R ! VECTEUR CONTENANT LA CONTRIBUTION DE BORD! C ! NODEUS ! TE ! D ! NUMERO DES NOEUDS ( LOCALE --> GLOBALE ) ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL (NELEUS*NDMASS) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "divct.h" C C*********************************************************************** C INTEGER NPOINS,NDMASS,NELEMS,NELEUS,NDIM C INTEGER NODEUS(NELEUS,NDMASS) DOUBLE PRECISION VECTUS(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMASS) C C variables internes INTEGER I,INODE C C*********************************************************************** C C 1. BOUCLE SUR CHAQUE ELEMENT C ========================= C IF (LVECTB) THEN IF ( NDIM .EQ. 2 ) THEN C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,1) VECTUS(INODE) = VECTUS(INODE) + WCT(I,1) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,2) VECTUS(INODE) = VECTUS(INODE) + WCT(I,2) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,3) VECTUS(INODE) = VECTUS(INODE) + WCT(I,3) ENDDO C ELSE C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,1) VECTUS(INODE) = VECTUS(INODE) + WCT(I,1) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,2) VECTUS(INODE) = VECTUS(INODE) + WCT(I,2) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,3) VECTUS(INODE) = VECTUS(INODE) + WCT(I,3) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,4) VECTUS(INODE) = VECTUS(INODE) + WCT(I,4) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,5) VECTUS(INODE) = VECTUS(INODE) + WCT(I,5) ENDDO C CDIR$ IVDEP DO I=1,NELEUS INODE = NODEUS(I,6) VECTUS(INODE) = VECTUS(INODE) + WCT(I,6) ENDDO C C Fin du cas 3D ENDIF C ELSE IF ( NDIM .EQ. 2 ) THEN C DO I=1,NELEUS INODE = NODEUS(I,1) VECTUS(INODE) = VECTUS(INODE) + WCT(I,1) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,2) VECTUS(INODE) = VECTUS(INODE) + WCT(I,2) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,3) VECTUS(INODE) = VECTUS(INODE) + WCT(I,3) ENDDO C ELSE C DO I=1,NELEUS INODE = NODEUS(I,1) VECTUS(INODE) = VECTUS(INODE) + WCT(I,1) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,2) VECTUS(INODE) = VECTUS(INODE) + WCT(I,2) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,3) VECTUS(INODE) = VECTUS(INODE) + WCT(I,3) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,4) VECTUS(INODE) = VECTUS(INODE) + WCT(I,4) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,5) VECTUS(INODE) = VECTUS(INODE) + WCT(I,5) ENDDO C DO I=1,NELEUS INODE = NODEUS(I,6) VECTUS(INODE) = VECTUS(INODE) + WCT(I,6) ENDDO C C Fin du cas 3D ENDIF C ENDIF C RETURN END syrthes-3.4.3-dfsg1/src/s/intersect.c0000666000175000017500000004503211524070644016114 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "abs.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | seg_rectanx | | tester l'intersection entre un segment et un segment x=cte | |======================================================================| */ int seg_rectanx(double dx,double dy,double xa,double xb,double ya,double yb) { double t,d,y; d=xb-xa; if (abs(d)<1.e-8) return(0); else { t=(dx-xa)/d; y=ya+t*(yb-ya); if (-dy<=y && y<=dy) return(1); else return(0); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | seg_rectany | | tester l'intersection entre un segment et un segment y=cte | |======================================================================| */ int seg_rectany(double dx,double dy,double xa,double xb,double ya,double yb) { double t,d,x; d=yb-ya; if (abs(d)<1.e-8) return(0); else { t=(dy-ya)/d; x=xa+t*(xb-xa); if (-dx<=x && x<=dx) return(1); else return(0); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | seg_cubex | | tester l'intersection entre une face x=cte | |======================================================================| */ int seg_cubex(double dx,double dy,double dz, double xa,double xb,double ya,double yb,double za,double zb) { double t,d,y,z; d=xb-xa; if (abs(d)<1.e-8) return(0); else { t=(dx-xa)/d; y=ya+t*(yb-ya); if (-dy<=y && y<=dy) { z= za+t*(zb-za); if (-dz<=z && z<=dz) return(1); else return(0); } else return(0); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | seg_cubey | | tester l'intersection entre une face y=cte | |======================================================================| */ int seg_cubey(double dx,double dy,double dz, double xa,double xb,double ya,double yb,double za,double zb) { double t,d,x,z; d=yb-ya; if (abs(d)<1.e-8) return(0); else { t=(dy-ya)/d; x=xa+t*(xb-xa); if (-dx<=x && x<=dx) { z= za+t*(zb-za); if (-dz<=z && z<=dz) return(1); else return(0); } else return(0); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | seg_cubez | | tester l'intersection entre une face z=cte | |======================================================================| */ int seg_cubez(double dx,double dy,double dz, double xa,double xb,double ya,double yb,double za,double zb) { double t,d,x,y; d=zb-za; if (abs(d)<1.e-8) return(0); else { t=(dz-za)/d; y=ya+t*(yb-ya); if (-dy<=y && y<=dy) { x= xa+t*(xb-xa); if (-dx<=x && x<=dx) return(1); else return(0); } else return(0); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | diag_tria | | intersection d'une diagonale de cube avec un plan | |======================================================================| */ int diag_tria(double ta, double tb, double tc, double td, double dx, double dy, double dz,double *t) { double d,epsi; epsi =1.e-8; d=ta*dx+tb*dy+tc*dz; if (abs(d)coo_min) {i1=2;coo_min=abs(b);} if (abs(c)>coo_min) {i1=3;} switch (i1) { case 1 : u0=yp-ya; u1=yab; u2=yac; v0=zp-za; v1=zab; v2=zac; break; case 2 : u0=xp-xa; u1=xab; u2=xac; v0=zp-za; v1=zab; v2=zac; break; case 3 : u0=xp-xa; u1=xab; u2=xac; v0=yp-ya; v1=yab; v2=yac; break; } alpha = beta = -1; if (abs(u1)=0 && beta<=1) alpha = (v0-beta*v2)/v1; } else { beta = (v0*u1-u0*v1)/(v2*u1-u2*v1); if (abs(beta)=0 && beta<=1) alpha = (u0-beta*u2)/u1; } /* printf(" >> in_triangle: alpha, beta = %f %f\n", alpha,beta); */ if (alpha>=-epsi && beta>=-epsi && (alpha+beta)<=1.+ 2.*epsi) return(1); else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | in_seg | | voir si in point est dans un segment | |======================================================================| */ int in_seg (double xa, double ya, double xb, double yb, double xp, double yp) { double epsi,t; epsi = 1.E-6; if (abs(xb-xa)xmin-epsi && xvymin-epsi && yvxmin-epsi && xvymin-epsi && yvzmin-epsi && zv=0 && beta<=1) alpha = (v0-beta*v2)/v1; } else { beta = (v0*u1-u0*v1)/(v2*u1-u2*v1); if (abs(beta)=0 && beta<=1) alpha = (u0-beta*u2)/u1; } if (alpha>=-epsi && beta>=-epsi && (alpha+beta)<=1.+ 2.*epsi) return(1); else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | in_tria_2d | | voir si in point est dans un triangle en dimension 2 | |======================================================================| */ int in_tria_2d_norm (double a1,double b1,double c1,double a2,double b2,double c2, double a3,double b3,double c3,double x,double y) { double epsi; epsi = -1.E-8; if ( a1*x+b1*y+c1>epsi && a2*x+b2*y+c2>epsi && a3*x+b3*y+c3>epsi) return(1); else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | in_tetra | | voir si in point est dans un tetraedre | |======================================================================| */ int in_tetra_norm (double a1,double b1,double c1,double d1, double a2,double b2,double c2,double d2, double a3,double b3,double c3,double d3, double a4,double b4,double c4,double d4, double x,double y,double z) { double epsi; epsi = -1.E-8; if (a1*x+b1*y+c1*z+d1>epsi && a2*x+b2*y+c2*z+d2>epsi && a3*x+b3*y+c3*z+d3>epsi && a4*x+b4*y+c4*z+d4>epsi ) return(1); else return(0); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | in_tetra | | voir si in point est dans un tetraedre | |======================================================================| */ int in_tetra (double xa,double ya,double za,double xb,double yb,double zb, double xc,double yc,double zc,double xd,double yd,double zd, double x,double y,double z) { double epsi; double alpha,beta,gama,delta,det; double xab,yab,zab,xac,yac,zac,xad,yad,zad,xap,yap,zap; double xba,yba,zba,xbc,ybc,zbc,xbd,ybd,zbd,xbp,ybp,zbp; epsi = 1.E-8; xab=xb-xa; yab=yb-ya; zab=zb-za; xac=xc-xa; yac=yc-ya; zac=zc-za; xad=xd-xa; yad=yd-ya; zad=zd-za; xap=x -xa; yap=y -ya; zap=z -za; det = -xab*zac*yad+xab*yac*zad-yac*zab*xad-yab*xac*zad+zac*yab*xad+zab*xac*yad; if (abs(det)>epsi) { beta = (-xac*yap*zad+xac*yad*zap-xad*yac*zap+xad*zac*yap-xap*zac*yad+xap*yac*zad)/det; if (abs(beta)1) return(0); else { gama = -(-xab*yap*zad+xab*yad*zap-yab*xad*zap-yad*zab*xap+yap*zab*xad+yab*xap*zad)/det; if (abs(gama)1) return(0); else { delta = (xab*yac*zap+zab*xac*yap-yac*zab*xap-xab*zac*yap-yab*xac*zap+zac*yab*xap)/det; if (abs(delta)1) return(0); else { if (abs(xab)>epsi) alpha = -( x-xb - gama*(xc-xb)-delta*(xd-xb) )/xab; else if (abs(yab)>epsi) alpha = -( y-yb - gama*(yc-yb)-delta*(yd-yb) )/yab; else alpha = -( z-zb - gama*(zc-zb)-delta*(zd-zb) )/zab; if (abs(alpha)1) return(0); else if (alpha+beta+gama+delta<=1.+4*epsi) return(1); else return(0); } } } } else { xba=xa-xb; yba=ya-yb; zba=za-zb; xbc=xc-xb; ybc=yc-yb; zbc=zc-zb; xbd=xd-xb; ybd=yd-yb; zbd=zd-zb; xbp=x -xb; ybp=y -yb; zbp=z -zb; det = xba*ybc*zbd-xba*zbc*ybd-yba*xbc*zbd+zbc*yba*xbd-ybc*zba*xbd+zba*xbc*ybd; alpha = (xbc*ybd*zbp-xbc*zbd*ybp+zbc*xbd*ybp-ybc*xbd*zbp+zbd*ybc*xbp-ybd*zbc*xbp)/det; if (abs(alpha)1) return(0); else { gama=-(xba*ybd*zbp-xba*zbd*ybp-yba*xbd*zbp-ybd*zba*xbp+ybp*zba*xbd+yba*xbp*zbd)/det; if (abs(gama)1) return(0); else { delta=(zbc*yba*xbp-xba*zbc*ybp+xba*ybc*zbp-ybc*zba*xbp-yba*xbc*zbp+zba*xbc*ybp)/det; if (abs(delta)1) return(0); else { if (abs(xba)>epsi) beta = -( x-xa - gama*(xc-xa)-delta*(xd-xa) )/xba; else if (abs(yba)>epsi) beta = -( y-ya - gama*(yc-ya)-delta*(yd-ya) )/yba; else beta = -( z-za - gama*(zc-za)-delta*(zd-za) )/zba; if (abs(beta)1) return(0); else if (alpha+beta+gama+delta<=1.+4*epsi) return(1); else return(0); } } } } } syrthes-3.4.3-dfsg1/src/s/limnuf.F0000666000175000017500000001704511524070644015354 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMNUF C ***************** C C ---------------------------------------- * (NCOUPF,NBCOUF,NRAPF,NBRAF,NREFF,NPOINF, * NBFILS,NWMAIL,NWDN,NWDRN,NWNCF1,NWNRF1) C ---------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA NUMEROTATION LOCALE DES NOEUDS * C FLUIDES COUPLES * C --> INITIALISATION DE NCOUPF(..,1) * C --> INITIALISATION DE NRAPF(..,1) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !NCOUPF(.,1)! TE ! R ! Numero glob fluide des noeuds fluides couples! C ! ! ! ! NCOUPF(.,2) est initialise dans NULOCF ! C ! NBCOUF ! E ! D ! Nombre de noeuds fluides couples ! C ! NRAPF(.,1)! TE ! R ! Num glob fluide noeuds fluides non couples + ! C ! ! ! ! rayt. NRAPF(.,2) est initialise dans NULOCF ! C ! NBRAF ! E ! D ! Nombre de noeuds fluides non couples + rayt ! C ! NREFF ! TE ! D ! References des noeuds fluides ! C ! NPOINF ! E ! D ! Nombre de noeuds du maillage fluides ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "xrefer.h" #include "nlofes.h" #include "optct.h" C C*********************************************************************** C C.. Variables externes INTEGER NBCOUF,NCOUPF(NBCOUF,2),NBRAF,NRAPF(NBRAF,2) INTEGER NPOINF,NREFF(NPOINF) INTEGER NBFILS,NWMAIL,NWDN,NWDRN,NWNCF1,NWNRF1 C C.. Variables internes INTEGER NUMREF,N,N1 INTEGER NCOU,NRA LOGICAL ERR C C*********************************************************************** C C 1- INITIALISATIONS C ================== C DO 1 N=NWDN,NWDN+NWNCF1-1 NCOUPF(N,1) = 0 NCOUPF(N,2) = 0 1 CONTINUE C DO 2 N=NWDRN,NWDRN+NWNRF1-1 NRAPF(N,1) = 0 NRAPF(N,2) = 0 2 CONTINUE C NCOU = NWDN-1 NRA = NWDRN-1 C C 2- COMPTE DES NOEUDS C ==================== C DO 200 N=1,NPOINF C NUMREF = NREFF(N) C DO 210 N1=1,NRFMAX C IF (IREFFC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NCOU = NCOU + 1 NCOUPF(NCOU,1) = N ENDIF C IF (IREFRF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NRA = NRA + 1 NRAPF(NRA,1) = N ENDIF C 210 CONTINUE 200 CONTINUE C C C 3- CONTROLE DES DIMENSIONS C ========================== C ERR = .FALSE. C IF (NWMAIL.EQ.NBFILS .AND. NCOU.NE.NBCOUF) THEN WRITE(NFECRA,4000) 'noeuds fluides couples',NCOU,NBCOUF ERR = .TRUE. ENDIF C IF (NWMAIL.EQ.NBFILS .AND. NRA.NE.NBRAF) THEN WRITE(NFECRA,4000) 'noeuds fluides non couples + rayt', * NCOU,NBCOUF ERR = .TRUE. ENDIF C C 4- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) WRITE(NFECRA,4005) NWMAIL,NCOU-NWDN+1 C IF (NBLBLA.GE.3) THEN IF (NBCOUF.GT.0) THEN WRITE(NFECRA,4010) WRITE(NFECRA,4001) (NCOUPF(N,1),N=NWDN,NWDN+NWNCF1-1) ENDIF ENDIF C IF (NBLBLA.GT.0) WRITE(NFECRA,4015) NWMAIL,NRA-NWDRN+1 C IF (NBLBLA.GE.3) THEN IF (NBCOUF.GT.0) THEN WRITE(NFECRA,4020) WRITE(NFECRA,4001) (NRAPF(N,1),N=NWDRN,NWDRN+NWNRF1-1) ENDIF ENDIF C C C 6- ARRET DU PROGRAMME EN CAS D'ERREUR DE DIMENSION C ================================================== IF (ERR) STOP C-------- C FORMATS C-------- C 3000 FORMAT(' %% ERREUR LIMNUF : incoherence sur les ',A30,/, & ' On en compte :',I9,/, & ' Il y en a ',I9,' de declares') 4000 FORMAT(/,' %% ERREUR LIMNUF : incoherence sur les ',A,/, & ' On en compte :',I9,/, & ' Il y en a ',I9,' de declare(e)s') 4005 FORMAT(/,' *** LIMNUF : Maillage fluide ',I3,/, & ' Nombre de noeuds fluides couples :',I6) 4001 FORMAT(12I6) 4010 FORMAT(/,' Liste des noeuds fluides couples :',/) 4015 FORMAT(/,' *** LIMNUF : Maillage fluide ',I3,/, * ' Nombre de noeuds fluides non couples', * ' soumis au rayonnement :',I6) 4020 FORMAT(/,' Liste des noeuds fluides non couples soumis ', * 'au rayonnement :',/) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/lnray2.F0000666000175000017500000001552311524070644015270 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LNRAY2 C ***************** C C ----------------------------------------------- * (NDIM,NELRAY,NODRAY,NRFRAY,NPOINR,ITRAV1,ITRAV2, * NNSRAY,NNFRAY,NNERAY,NCSRAY,NCFRAY,NESRAY) C ----------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C FONCTION : * C ---------- * C GENERATION DES LISTES DE NOEUDS POUR LE MAILLAGE RAYONNEMENT * C - noeuds couples avec le fluide * C - noeuds couples avec le solide * C - noeuds entree/sortie * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (3 ) ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE RAYONNEMENT ! C ! NELRAY ! E ! D ! NOMBRE D'ELTS DU MAILLAGE RAYONNEMENT ! C ! NODRAY ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE RAYONNEMENT ! C ! NRFRAY ! TE ! R ! TABLEAU DES REFERENCES ELTS MAILLAGE RAYT ! C ! COORAY ! TR ! R ! COORD DES NOEUDS DU MAILLAGE RAYONNEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! ! ! C ! /DIVCT/ ! ! ! ! C ! /NLOFES/ ! ! ! ! C ! /NLOFCT/ ! ! ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "xrefer.h" C C*********************************************************************** C C.. Variables externes INTEGER NELRAY,NPOINR,NDIM,NNSRAY,NNFRAY,NNERAY INTEGER NODRAY(NELRAY,NDIM),NRFRAY(NELRAY) INTEGER NCSRAY(NNSRAY),NCFRAY(NNFRAY),NESRAY(NNERAY) INTEGER ITRAV1(NPOINR),ITRAV2(NPOINR) C C.. Variables internes INTEGER N,M,NR,NS,NF,NES,I LOGICAL LS,ERR C C*********************************************************************** C C 1- INITIALISATION C ================= C DO N=1,NPOINR ITRAV1(N) = 0 ITRAV2(N) = 0 ENDDO C C C 2- MARQUAGE DES NOEUDS C ====================== C DO 200 N=1,NELRAY C NR = NRFRAY(N) C LS = .FALSE. DO M=1,NRFMAX IF (IRERCS(M).NE.0 .AND. NR.EQ.M) LS = .TRUE. ENDDO C IF (LS) THEN DO I=1,NDIM ITRAV1(NODRAY(N,I)) = 1 ENDDO ENDIF C LS = .FALSE. DO M=1,NRFMAX IF ((IRERCF(M).NE.0 .OR. IRESTF(M).NE.0 ) * .AND. NR.EQ.M) LS = .TRUE. ENDDO C IF (LS) THEN DO I=1,NDIM ITRAV2(NODRAY(N,I)) = 1 ENDDO ENDIF C 200 CONTINUE C C 3- GENERATION DES LISTES C ======================== C NS = 0 NF = 0 NES = 0 C DO N=1,NPOINR IF (ITRAV1(N).EQ.1) THEN NS = NS + 1 NCSRAY(NS) = N ENDIF IF (ITRAV2(N).EQ.1) THEN NF = NF + 1 NCFRAY(NF) = N ENDIF ENDDO C C ERR=.FALSE. IF (NS.NE.NNSRAY) THEN WRITE(NFECRA,4010) NNSRAY,NS ERR = .TRUE. ENDIF IF (NF.NE.NNFRAY) THEN WRITE(NFECRA,4020) NNFRAY,NF ERR = .TRUE. ENDIF C IF (ERR) STOP C C 4- IMPRESSIONS C ============== C WRITE(NFECRA,4000) NS,NF C C C-------- C FORMATS C-------- C 4000 FORMAT(//,' *** LNRAY2 : MAILLAGE RAYONNEMENT',/, * 8X,'- Nombre de noeuds couples avec le solide :',I7,/, * 8X,'- Nombre de noeuds couples avec le fluide :',I7) 4010 FORMAT(/,' %% ERREUR LNRAY2 : LA DIMENSION DU TABLEAU DES ', & 'NOEUDS RAYT COUPLES SOLIDE EST MAUVAISE',/, & ' IL VAUT : ',I6,/, & ' IL FAUDRAIT : ',I6) 4020 FORMAT(/,' %% ERREUR LNRAY2 : LA DIMENSION DU TABLEAU DES ', & 'NOEUDS RAYT COUPLES FLUIDE EST MAUVAISE',/, & ' IL VAUT : ',I6,/, & ' IL FAUDRAIT : ',I6) C END syrthes-3.4.3-dfsg1/src/s/normale.c0000666000175000017500000000722011524070644015546 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cnorm2 | | Calcul de normales en dimension 2 | |======================================================================| */ void cnor_2d(int ndim,int nelray,int npoinr, int *nodray,double *cooray,double *xnfray) { int n,n1,n2; double xn,yn,an; for (n=0;n NUM_LOC_COUPLE C ----------------------------------------------------- DO 120 N=NWDN,NWDN+NWNCF1-1 ITRAV(NCOUPF(N,1)) = N 120 CONTINUE C C C 1.3- TRANSFORMATION DE LA TABLE DES ELEMENTS C -------------------------------------------- DO 130 M=1,NWDMA1 DO 131 N=NWDE,NWDE+NWECF1-1 NODESF(N,M) = ITRAV (NODESF(N,M)) 131 CONTINUE 130 CONTINUE C C C C 2. MAILLAGE DES NOEUDS FLUIDES NON COUPLES SOUMIS AU RAYT C ========================================================= C C 2.1- INITIALISATIONS C -------------------- C DO 210 N=1,NPOINF ITRAV(N) = 0 210 CONTINUE C C C 2.2- CREATION DE LA TABLE NUM_GLOG --> NUM_LOC_NON_COUPLE_RAYT C -------------------------------------------------------------- DO 220 N=NWDRN,NWDRN+NWNRF1-1 ITRAV(NRAPF(N,1)) = N 220 CONTINUE C C C 2.3- TRANSFORMATION DE LA TABLE DES ELEMENTS C -------------------------------------------- DO 230 M=1,NWDMA1 DO 231 N=NWDRE,NWDRE+NWERF1-1 NODRAF(N,M) = ITRAV (NODRAF(N,M)) 231 CONTINUE 230 CONTINUE C C C------- C FORMAT C------- C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/ccoeqf.F0000666000175000017500000001367111524070645015324 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCOEQF C ***************** C * ( VALEQ,NELRAY,NRFRAY,NFCFRA,PHFRAF,NGFPEF,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS (LIMITES, PHYSIQUES,...) * C DANS LES TABLEAUX ADAPTES * C Programme valable pour le conditions physiques * C equivalente couple au fluide * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNE ! C ! NFCFRA ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! PHFRAF ! TR ! R ! PROPRIETES PHYSIQUES EQUIVQLENTE K,E,T,H ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIR C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" #include "rayonn.h" C C********************************************************************** C C..Variables externes INTEGER NELRAY,NB,NFCFRA INTEGER NRFRAY(NELRAY),IREF(NRFMAX),NGFPEF(NFCFRA) DOUBLE PRECISION VALEQ(4),PHFRAF(NFCFRA,4) C C..Variables internes INTEGER N,N1,NR,NBRE,NUMREF C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NFCFRA PHFRAF(N,1) = VALEQ(1) PHFRAF(N,2) = VALEQ(2) PHFRAF(N,3) = VALEQ(3) PHFRAF(N,4) = VALEQ(4) NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 N=1,NFCFRA C NUMREF = NRFRAY(NGFPEF(N)) C IF (NUMREF .EQ. NR) THEN PHFRAF(N,1) = VALEQ(1) PHFRAF(N,2) = VALEQ(2) PHFRAF(N,3) = VALEQ(3) PHFRAF(N,4) = VALEQ(4) NBRE = NBRE + 1 ENDIF C 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLR.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCOEQF : Rayonnement - Nombre de faces traitees', * ' de type paroi equivalente et couplee au fluide:',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/couple_mst.c0000666000175000017500000001705311524070645016271 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "tree.h" # include "f2c_syrthes.h" # include "interfaces.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cfdf3d | | Gestion du calcul des facteurs de forme en dimension 3 | |======================================================================| */ proc(void coumst,void COUMST) (int *ndim,int *nelray,int *npoinr,int *nodray, double *cooray,int *nfmst,int *ngfmst,int *nblblr) { double *xnfray; if (*ndim==2) { xnfray=(double*)malloc(*nelray * 2 * sizeof(double)); if (xnfray==NULL) {printf(" ERREUR coumst : probleme d'allocation memoire\n"); exit(0);} cnor_2d(*ndim,*nelray,*npoinr,nodray,cooray,xnfray); couple_mst_2d(*nfmst,ngfmst,*nelray,*npoinr, nodray,cooray,xnfray,*nblblr); free(xnfray); } else { xnfray=(double*)malloc(*nelray * 3 * sizeof(double)); if (xnfray==NULL) {printf(" ERREUR coumst : probleme d'allocation memoire\n"); exit(0);} cnor_3d(*ndim,*nelray,*npoinr,nodray,cooray,xnfray); couple_mst_3d(*nfmst,ngfmst,*nelray,*npoinr, nodray,cooray,xnfray,*nblblr); free(xnfray); } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | couple_mst | | determination des couples de facettes des msts | |======================================================================| */ void couple_mst_2d(int nfmst,int *ngfmst, int nelray,int npoinr,int *nodray, double *cooray,double *xnf,int nblblr) { int i,j,num1,num2,n1,n2,nmin,jmin; double xn1,yn1,xn2,yn2,x1,x2,y1,y2; double xc1,yc1,xc2,yc2; double dmin,d; for (i=nfmst;i<2*nfmst;i++) ngfmst[i]=0; for (i=0;i=10) { printf(" *** COUPLE_MST_2D : couples de facettes rayonnement MSTS\n"); printf(" facette num_global Vis-a-vis : local global\n"); for (i=0;i=10) { printf(" *** COUPLE_MST_3D : couples de facettes rayonnement MSTS\n"); printf(" facette num_global Vis-a-vis : local global\n"); for (i=0;i=3) ! C ! ! ! ! contient les valeurs des kii sui isotro! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C ! ! ! ! (diagonale non assemblee) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : MATELE C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA INTEGER NPOUE,NPPEL,NBPHYS C INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION COEFMA(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS),VOLUME(NELEMS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes DOUBLE PRECISION ZERO INTEGER I,NCA INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 DOUBLE PRECISION S3,S4,SV1,S29,SV29,S24,SV24 DOUBLE PRECISION X5,X6,X7,X8,X9,X10 DOUBLE PRECISION Y5,Y6,Y7,Y8,Y9,Y10 DOUBLE PRECISION Z5,Z6,Z7,Z8,Z9,Z10 DOUBLE PRECISION R1,R2,R3 DOUBLE PRECISION X45,Y45,X46,Y46,X65,Y65 DOUBLE PRECISION XGRAD1,YGRAD1,ZGRAD1 DOUBLE PRECISION XGRAD2,YGRAD2,ZGRAD2 DOUBLE PRECISION XGRAD3,YGRAD3,ZGRAD3 DOUBLE PRECISION XGRAD4,YGRAD4,ZGRAD4 DOUBLE PRECISION XK1,XK2,XK3,XK4,XK5,XK6,XK7,XK8,XK9,XK10 DOUBLE PRECISION XKM1,XKM2,XKM3,XKM4,XKM5,XKM6,XKM7,XKM8 DOUBLE PRECISION ALFA1,ALFA2,ALFA3,ALFA4,ALFA5,ALFA6 DOUBLE PRECISION ALFA11,ALFA22,ALFA33,ALFA44 DOUBLE PRECISION XKE C C LOGICAL LVERIF C*********************************************************************** C C INITIALISATIONS C ================ C LVERIF = .FALSE. ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C C Constantes necessaires S3 = 1.D0 / 3.D0 S4 = 1.D0 / 4.D0 S24 = 1.D0 / 24.D0 S29 = - 2.D0 / 9.D0 C C 1- CAS BIDIMENSIONNEL C ====================== C C IF ( NDIM . EQ . 2 ) THEN C C 1.1 CAS BIDIMENSIONNEL CARTESIEN C -------------------------------- C IF (IAXISY.EQ.0) THEN C C DO 110 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C IF (NDPROP .EQ. 1) THEN XK1 = PHYSOL(N1,1,3) XK2 = PHYSOL(N2,1,3) XK3 = PHYSOL(N3,1,3) XK4 = PHYSOL(N4,1,3) XK5 = PHYSOL(N5,1,3) XK6 = PHYSOL(N6,1,3) ELSEIF( NDPROP.EQ. 2 ) THEN XKE = PHYSOL(I,1,3) XK1 = XKE XK2 = XKE XK3 = XKE XK4 = XKE XK5 = XKE XK6 = XKE ELSE XK1 = PHYSOL(I,1,3) XK2 = PHYSOL(I,2,3) XK3 = PHYSOL(I,3,3) XK4 = PHYSOL(I,4,3) XK5 = PHYSOL(I,5,3) XK6 = PHYSOL(I,6,3) ENDIF C C Calcul des termes diagonaux C --------------------------- C SV1 = 1.D0 / VOLUME(I) C C X45 = COORDS(N5,1) - COORDS(N4,1) Y45 = COORDS(N5,2) - COORDS(N4,2) X46 = COORDS(N6,1) - COORDS(N4,1) Y46 = COORDS(N6,2) - COORDS(N4,2) X65 = COORDS(N5,1) - COORDS(N6,1) Y65 = COORDS(N5,2) - COORDS(N6,2) C ALFA1 = SV1 * (X45*X65 + Y45*Y65) ALFA2 = -SV1 * (X46*X65 + Y46*Y65) ALFA3 = SV1 * (X46*X45 + Y46*Y45) C C XKM1 = S3 * (XK1+XK4+XK6) XKM2 = S3 * (XK4+XK2+XK5) XKM3 = S3 * (XK5+XK3+XK6) XKM4 = S3 * (XK4+XK5+XK6) C C WCT(I,1) = (ALFA2+ALFA3)*XKM1 WCT(I,2) = (ALFA1+ALFA3)*XKM2 WCT(I,3) = (ALFA1+ALFA2)*XKM3 WCT(I,4) = ALFA1*(XKM1+XKM4) + & ALFA2*(XKM2+XKM4) + & ALFA3*(XKM1+XKM2) WCT(I,5) = ALFA1*(XKM2+XKM3) + & ALFA2*(XKM4+XKM2) + & ALFA3*(XKM4+XKM3) WCT(I,6) = ALFA1*(XKM1+XKM4) + & ALFA2*(XKM1+XKM3) + & ALFA3*(XKM4+XKM3) C C XMAT(I,1) = -ALFA3*XKM1 XMAT(I,2) = -ALFA2*XKM1 C XMAT(I,3) = -ALFA3*XKM2 XMAT(I,4) = -ALFA1*XKM2 C XMAT(I,5) = -ALFA1*XKM3 XMAT(I,6) = -ALFA2*XKM3 C XMAT(I,7) = -ALFA2*(XKM2+XKM4) XMAT(I,8) = -ALFA1*(XKM1+XKM4) C XMAT(I,9) = -ALFA3*(XKM3+XKM4) C 110 CONTINUE C C C 1.2- CAS AXISYMETRIQUE (DONC 2D) C -------------------------------- ELSE C DO 120 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C IF (NDPROP.EQ.1) THEN XK1 = PHYSOL(N1,1,3) XK2 = PHYSOL(N2,1,3) XK3 = PHYSOL(N3,1,3) XK4 = PHYSOL(N4,1,3) XK5 = PHYSOL(N5,1,3) XK6 = PHYSOL(N6,1,3) ELSEIF(NDPROP.EQ.2) THEN XKE = PHYSOL(I,1,3) XK1 = XKE XK2 = XKE XK3 = XKE XK4 = XKE XK5 = XKE XK6 = XKE ELSE XK1 = PHYSOL(I,1,3) XK2 = PHYSOL(I,2,3) XK3 = PHYSOL(I,3,3) XK4 = PHYSOL(I,4,3) XK5 = PHYSOL(I,5,3) XK6 = PHYSOL(I,6,3) ENDIF C SV24 = S24 / VOLUME(I) C R1 = ABS(COORDS(N1,NCA)) * SV24 R2 = ABS(COORDS(N2,NCA)) * SV24 R3 = ABS(COORDS(N3,NCA)) * SV24 C C X45 = COORDS(N5,1) - COORDS(N4,1) Y45 = COORDS(N5,2) - COORDS(N4,2) X46 = COORDS(N6,1) - COORDS(N4,1) Y46 = COORDS(N6,2) - COORDS(N4,2) X65 = COORDS(N5,1) - COORDS(N6,1) Y65 = COORDS(N5,2) - COORDS(N6,2) C ALFA1 = X45*X65 + Y45*Y65 ALFA2 = -(X46*X65 + Y46*Y65) ALFA3 = X46*X45 + Y46*Y45 C C WCT(I,1) = (ALFA2+ALFA3)*( XK1*( 6*R1 + R2 + R3 ) & +XK4*( 5*R1 + 2*R2 + R3 ) & +XK6*( 5*R1 + R2 + 2*R3 ) ) WCT(I,2) = (ALFA1+ALFA3)*( XK2*( R1 + 6*R2 + R3 ) & +XK4*( 2*R1 + 5*R2 + R3 ) & +XK5*( R1 + 5*R2 + 2*R3 ) ) WCT(I,3) = (ALFA1+ALFA2)*( XK3*( R1 + R2 + 6*R3 ) & +XK5*( R1 + 2*R2 + 5*R3 ) & +XK6*( 2*R1 + R2 + 5*R3 ) ) WCT(I,4) = XK1 * (ALFA1+ALFA3) * ( 6*R1 + R2 + R3 ) + & XK2 * (ALFA2+ALFA3) * ( R1 + 6*R2 + R3 ) + & XK4 * ( ALFA1*( 8*R1 + 5*R2 + 3*R3 ) + & ALFA2*( 5*R1 + 8*R2 + 3*R3 ) + & ALFA3*( 7*(R1+R2) + 2*R3 ) ) + & XK5 * ( ALFA1*( 2*R1 + 3*(R2+R3) ) + & ALFA2*( 3*R1 + 8*R2 + 5*R3 ) + & ALFA3*( R1 + 5*R2 + 2*R3 ) ) + & XK6 * ( ALFA1*( 8*R1 + 3*R2 + 5*R3 ) + & ALFA2*( 3*(R1+R3) + 2*R2 ) + & ALFA3*( 5*R1 + R2 + 2*R3 ) ) WCT(I,5) = XK2 * ( ALFA1+ALFA2 ) * ( R1 + 6*R2 + R3 ) + & XK3 * ( ALFA1+ALFA3 ) * ( R1 + R2 + 6*R3 ) + & XK4 * ( ALFA1*( 2*R1 + 5*R2 + R3 ) + & ALFA2*( 5*R1 + 8*R2 + 3*R3 ) + & ALFA3*( 3*(R1+R2) + 2*R3 ) ) + & XK5 * ( ALFA1*( 2*R1 + 7*(R2+R3) ) + & ALFA2*( 3*R1 + 8*R2 + 5*R3 ) + & ALFA3*( 3*R1 + 5*R2 + 8*R3 ) ) + & XK6 * ( ALFA1*( 2*R1 + R2 + 5*R3 ) + & ALFA2*( 3*(R1+R3) + 2*R2 ) + & ALFA3*( 5*R1 + 3*R2 + 8*R3 ) ) WCT(I,6) = XK1 * ( ALFA1+ALFA2) * ( 6*R1 + R2 + R3 ) + & XK3 * ( ALFA2+ALFA3) * ( R1 + R2 + 6*R3 ) + & XK4 * ( ALFA1*( 8*R1 + 5*R2 + 3*R3 ) + & ALFA2*( 5*R1 + 2*R2 + R3 ) + & ALFA3*( 3*(R1+R2) + 2*R3 ) ) + & XK5 * ( ALFA1*( 2*R1 + 3*(R2+R3) ) + & ALFA2*( R1 + 2*R2 + 5*R3 ) + & ALFA3*( 3*R1 + 5*R2 + 8*R3 ) ) + & XK6 * ( ALFA1*( 8*R1 + 3*R2 + 5*R3 ) + & ALFA2*( 7*(R1+R3) + 2*R2 ) + & ALFA3*( 5*R1 + 3*R2 + 8*R3 ) ) C C C Premiere extra ligne de la matrice elementaire XMAT(I,1) = ALFA3*( XK1*( -6*R1 - (R2+R3) ) - & XK4*( 5*R1 + 2*R2 + R3 ) - & XK6*( 5*R1 + R2 + 2*R3 ) ) XMAT(I,2) = ALFA2*( XK1*( -6*R1 - (R2+R3) ) - & XK4*( 5*R1 + 2*R2 + R3 ) - & XK6*( 5*R1 + R2 + 2*R3 ) ) C Deuxieme extra ligne de la matrice elementaire XMAT(I,3) = ALFA3*( XK2*( -R1 - 6*R2 - R3 ) - & XK4*( 2*R1 + 5*R2 + R3 ) - & XK5*( R1 + 5*R2 + 2*R3 ) ) XMAT(I,4) = ALFA1*( XK2*( -R1 - 6*R2 - R3 ) - & XK4*( 2*R1 + 5*R2 + R3 ) - & XK5*( R1 + 5*R2 + 2*R3 ) ) C Troisieme extra ligne de la matrice elementaire XMAT(I,5) = ALFA1*( XK3*( -R1 - R2 - 6*R3 ) - & XK5*( R1 + 2*R2 + 5*R3 ) - & XK6*( 2*R1 + R2 + 5*R3 ) ) XMAT(I,6) = ALFA2*( XK3*( -R1 - R2 - 6*R3 ) - & XK5*( R1 + 2*R2 + 5*R3 ) - & XK6*( 2*R1 + R2 + 5*R3 ) ) C Quatrieme extra ligne de la matrice elementaire XMAT(I,7) = ALFA2*( XK2*( -R1 - 6*R2 - R3 ) - & XK4*( 5*R1 + 8*R2 + 3*R3 ) - & XK5*( 3*R1 + 8*R2 + 5*R3 ) - & XK6*( 3*(R1+R3) + 2*R2 ) ) XMAT(I,8) = ALFA1*( XK1*( -6*R1 - (R2+R3) ) - & XK4*( 8*R1 + 5*R2 + 3*R3 ) - & XK5*( 2*R1 + 3*(R2+R3) ) - & XK6*( 8*R1 + 3*R2 + 5*R3 ) ) C Cinquieme extra ligne de la matrice elementaire XMAT(I,9) = ALFA3*( XK3*( -R1 - R2 - 6*R3 ) - & XK4*( 3*(R1+R2) + 2*R3 ) - & XK5*( 3*R1 + 5*R2 + 8*R3 ) - & XK6*( 5*R1 + 3*R2 + 8*R3 ) ) 120 CONTINUE C ENDIF C C C 2- CAS TRIDIMENSIONNEL C ====================== ELSE C DO 200 I=1,NELEMS C SV29 = S29 / VOLUME(I) C C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10 = NODES(I,10) C C X5 = COORDS(N5,1) X6 = COORDS(N6,1) X7 = COORDS(N7,1) X8 = COORDS(N8,1) X9 = COORDS(N9,1) X10 = COORDS(N10,1) C Y5 = COORDS(N5,2) Y6 = COORDS(N6,2) Y7 = COORDS(N7,2) Y8 = COORDS(N8,2) Y9 = COORDS(N9,2) Y10 = COORDS(N10,2) C Z5 = COORDS(N5,3) Z6 = COORDS(N6,3) Z7 = COORDS(N7,3) Z8 = COORDS(N8,3) Z9 = COORDS(N9,3) Z10 = COORDS(N10,3) C IF (NDPROP.EQ.1) THEN XK1 = PHYSOL(N1,1,3) XK2 = PHYSOL(N2,1,3) XK3 = PHYSOL(N3,1,3) XK4 = PHYSOL(N4,1,3) XK5 = PHYSOL(N5,1,3) XK6 = PHYSOL(N6,1,3) XK7 = PHYSOL(N7,1,3) XK8 = PHYSOL(N8,1,3) XK9 = PHYSOL(N9,1,3) XK10 = PHYSOL(N10,1,3) ELSEIF(NDPROP.EQ.2) THEN XKE = PHYSOL(I,1,3) XK1 = XKE XK2 = XKE XK3 = XKE XK4 = XKE XK5 = XKE XK6 = XKE XK7 = XKE XK8 = XKE XK9 = XKE XK10 = XKE ELSE XK1 = PHYSOL(I,1,3) XK2 = PHYSOL(I,2,3) XK3 = PHYSOL(I,3,3) XK4 = PHYSOL(I,4,3) XK5 = PHYSOL(I,5,3) XK6 = PHYSOL(I,6,3) XK7 = PHYSOL(I,7,3) XK8 = PHYSOL(I,8,3) XK9 = PHYSOL(I,9,3) XK10 = PHYSOL(I,10,3) ENDIF XKM1 = S4 * (XK1+XK5+XK7+XK8) XKM2 = S4 * (XK2+XK5+XK6+XK9) XKM3 = S4 * (XK3+XK6+XK7+XK10) XKM4 = S4 * (XK4+XK8+XK9+XK10) XKM5 = S4 * (XK5+XK6+XK8+XK9) XKM6 = S4 * (XK5+XK6+XK7+XK8) XKM7 = S4 * (XK10+XK6+XK8+XK7) XKM8 = S4 * (XK10+XK6+XK8+XK9) C C XGRAD1 = Y7 * (Z5-Z8) - Y8 * (Z5-Z7) - Y5 * (Z7-Z8) YGRAD1 = X5 * (Z7-Z8) - X8 * (Z7-Z5) - X7 * (Z5-Z8) ZGRAD1 = X7 * (Y5-Y8) - X8 * (Y5-Y7) - X5 * (Y7-Y8) XGRAD2 = Y6 * (Z9-Z5) - Y5 * (Z9-Z6) - Y9 * (Z6-Z5) YGRAD2 = X9 * (Z6-Z5) - X5 * (Z6-Z9) - X6 * (Z9-Z5) ZGRAD2 = X6 * (Y9-Y5) - X5 * (Y9-Y6) - X9 * (Y6-Y5) XGRAD3 = Y7 * (Z10-Z6) - Y6 * (Z10-Z7) - Y10 * (Z7-Z6) YGRAD3 = X10 * (Z7-Z6) - X6 * (Z7-Z10) - X7 * (Z10-Z6) ZGRAD3 = X7 * (Y10-Y6) - X6 * (Y10-Y7) - X10 * (Y7-Y6) XGRAD4 = Y9 * (Z10-Z8) - Y8 * (Z10-Z9) - Y10 * (Z9-Z8) YGRAD4 = X10 * (Z9-Z8) - X8 * (Z9-Z10) - X9 * (Z10-Z8) ZGRAD4 = X9 * (Y10-Y8) - X8 * (Y10-Y9) - X10 * (Y9-Y8) C ALFA1 = SV29 * (XGRAD3*XGRAD4+YGRAD3*YGRAD4+ZGRAD3*ZGRAD4) ALFA2 = SV29 * (XGRAD2*XGRAD4+YGRAD2*YGRAD4+ZGRAD2*ZGRAD4) ALFA3 = SV29 * (XGRAD1*XGRAD4+YGRAD1*YGRAD4+ZGRAD1*ZGRAD4) ALFA4 = SV29 * (XGRAD2*XGRAD3+YGRAD2*YGRAD3+ZGRAD2*ZGRAD3) ALFA5 = SV29 * (XGRAD1*XGRAD3+YGRAD1*YGRAD3+ZGRAD1*ZGRAD3) ALFA6 = SV29 * (XGRAD1*XGRAD2+YGRAD1*YGRAD2+ZGRAD1*ZGRAD2) C ALFA11 = ALFA3 + ALFA5 + ALFA6 ALFA22 = ALFA2 + ALFA4 + ALFA6 ALFA33 = ALFA1 + ALFA4 + ALFA5 ALFA44 = ALFA1 + ALFA2 + ALFA3 C C WCT(I,1) = XKM1*ALFA11 WCT(I,2) = XKM2*ALFA22 WCT(I,3) = XKM3*ALFA33 WCT(I,4) = XKM4*ALFA44 WCT(I,5) = XKM1*ALFA22 + XKM2*ALFA11 + & (XKM5+XKM6)*(ALFA11+ALFA22-2*ALFA6) WCT(I,6) = (XKM2+XKM5)*ALFA33 + (XKM3+XKM7)*ALFA22 & +XKM6*ALFA11 + XKM8*ALFA44 WCT(I,7) = XKM1*ALFA33 + XKM3*ALFA11 + & (XKM6+XKM7)*(ALFA22+ALFA44-2*ALFA2) WCT(I,8) = (XKM1+XKM6)*ALFA44 + (XKM4+XKM8)*ALFA11 & +XKM5*ALFA22 + XKM7*ALFA33 WCT(I,9) = XKM2*ALFA44 + XKM4*ALFA22 + & (XKM5+XKM8)*(ALFA11+ALFA33-2*ALFA5) WCT(I,10) = XKM3*ALFA44 + XKM4*ALFA33 + & (XKM7+XKM8)*(ALFA33+ALFA44-2*ALFA1) C C XMAT(I,1) = -XKM1*ALFA6 XMAT(I,2) = -XKM1*ALFA5 XMAT(I,3) = -XKM1*ALFA3 C XMAT(I,4) = -XKM2*ALFA6 XMAT(I,5) = -XKM2*ALFA4 XMAT(I,6) = -XKM2*ALFA2 C XMAT(I,7) = -XKM3*ALFA4 XMAT(I,8) = -XKM3*ALFA5 XMAT(I,9) = -XKM3*ALFA1 C XMAT(I,10) = -XKM4*ALFA3 XMAT(I,11) = -XKM4*ALFA2 XMAT(I,12) = -XKM4*ALFA1 C XMAT(I,13) = -(XKM2+XKM5+XKM6)*ALFA5 - XKM5*ALFA4 - & XKM6*ALFA3 XMAT(I,14) = -ALFA4*XKM1 + (ALFA3-ALFA4)*XKM6 XMAT(I,15) = -(XKM1+XKM5+XKM6)*ALFA2 - XKM5*ALFA4 - & XKM6*ALFA3 XMAT(I,16) = -ALFA3*XKM2 + (ALFA4-ALFA3)*XKM5 C XMAT(I,17) = -(XKM3+XKM6+XKM7)*ALFA6 - XKM6*ALFA3 - & XKM7*ALFA4 XMAT(I,18) = (XKM5+XKM7)*ALFA4 + (XKM6+XKM8)*ALFA3 XMAT(I,19) = -(XKM2+XKM5+XKM8)*ALFA1 - XKM5*ALFA4 - & XKM8*ALFA3 XMAT(I,20) = -(XKM3+XKM7+XKM8)*ALFA2 - XKM7*ALFA4 - & XKM8*ALFA3 C XMAT(I,21) = -(XKM1+XKM6+XKM7)*ALFA1 - XKM6*ALFA3 - & XKM7*ALFA4 XMAT(I,22) = -XKM3*ALFA3 + XKM7*(ALFA4-ALFA3) C XMAT(I,23) = -(XKM4+XKM5+XKM8)*ALFA6 - XKM5*ALFA4 - & XKM8*ALFA3 XMAT(I,24) = -(XKM4+XKM7+XKM8)*ALFA5 - XKM7*ALFA4 - & XKM8*ALFA3 C XMAT(I,25) = -XKM4*ALFA4 + XKM8*(ALFA3-ALFA4) C 200 CONTINUE C C C ENDIF C C------- C FORMAT C------- C C END syrthes-3.4.3-dfsg1/src/s/lecsi1.F0000666000175000017500000002034011524070645015233 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECSI1 C ***************** C C -------------------- *(NPOINS,NELEMS,NT5) C -------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE SIMAIL * C (Necessaire pour les dimensionnements de tableaux) * C * C Modifications par Y. Fournier pour prendre en compte * C les aspects binaires Linux * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : LCOODP,CMPTNO,CMPTEL,CMPTFA,INREFA C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "nlofct.h" #include "xrefer.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NELEMS,NT5 C C.. Variables internes INTEGER I,NDIMEF,NDSR,NDSD,NCOPNP,M(32),LE #ifdef HAVE_C_IO INTEGER NBRLUS,NBRTOT,IERROR CHARACTER MSGIER*80 #endif /* HAVE_C_IO */ C*********************************************************************** C C 1- LECTURE DE L'ENREGISTREMENT AVANT LE TABLEAU 0 C ================================================= C Lecture du tableau "-1" C #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else REWIND (NFSGCT) READ (NFSGCT,ERR=999) LE, (M(I), I=1,LE) #endif NT5 = M(7) C C 2- LECTURE DU TABLEAU 0 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ (NFSGCT,ERR=999) LE, (M(I), I=1,LE) #endif C cc CIR : incompatible dans l'etat sur DEC cc C = CHAR4(M(29)) cc IF (C.NE.'NOPO') THEN cc WRITE(NFECRA,1000) cc CLOSE(NFSGCT) cc STOP cc ENDIF IF (M(32).NE.0) THEN WRITE(NFECRA,1023) STOP ENDIF C C 3- LECTURE DU TABLEAU 2 C ======================= #ifdef HAVE_C_IO NBRLUS = 0 CALL READBF (NFSGCT, 4, 1, 1, NBRLUS, NBRTOT, LE, IERROR) IF (IERROR .NE. 0) GOTO 998 CALL READBF (NFSGCT, 4, LE, 1, NBRLUS, NBRTOT, M, IERROR) IF (IERROR .NE. 0) GOTO 998 IF (NBRLUS .LT. NBRTOT) THEN CALL READBF (NFSGCT, 4, 0, 2, NBRLUS, NBRTOT, 0, IERROR) IF (IERROR .NE. 0) GOTO 998 ENDIF #else READ(NFSGCT,ERR=999) LE,(M(I),I=1,LE) #endif C NDIMEF = M(1) NDSR = M(2) NDSD = M(3) NCOPNP = M(4) NELEMS = M(5) NPOINS = M(15) C C 4- VERIFICATIONS DIVERSES C ========================= C cc IF (NDIMEF.EQ.2 .AND. NDIELE.NE.2) THEN cc WRITE(NFECRA,1018) cc STOP cc ENDIF C IF (NDSR.GT.NRFMAX) THEN WRITE(NFECRA,1020) STOP ENDIF IF (NDSD.GT.NRFMAX) THEN WRITE(NFECRA,1021) STOP ENDIF C IF (NCOPNP.NE.0) THEN WRITE(NFECRA,1022) STOP ENDIF C IF ( M(7).NE.0 .OR. M(9).NE.0 .OR. M(11).NE.0 & .OR. M(12).NE.0 .OR. M(13).NE.0 ) THEN WRITE(NFECRA,1023) STOP ENDIF C RETURN #ifdef HAVE_C_IO 998 CONTINUE CALL STREBF (MSGIER, LEN(MSGIER), IERROR) WRITE(NFECRA,9998) MSGIER STOP #else 999 CONTINUE WRITE(NFECRA,9999) STOP #endif C C-------- C FORMATS C-------- C 1000 FORMAT(' %% ERREUR LECSI1 : LE FICHIER NE CONTIENT PAS UNE S.D.', & ' DE MAILLAGE ') 1020 FORMAT(' %% ERREUR LECSI1 : NUMERO(S) DE REFERENCES > 99') 1021 FORMAT(' %% ERREUR LECSI1 : NUMERO(S) DE SOUS-DOMAINES > 99') 1022 FORMAT(' %% ERREUR LECSI1 : LE MAILLAGE NE POSSEDE PAS DE' & ,' NOEUDS MILIEUX') 1023 FORMAT(' %% ERREUR LECSI1 : UTILISATION D''ELEMENTS ', & 'NON CONFORMES') #ifdef HAVE_C_IO 9998 FORMAT(' %% ERREUR LECSI1 : erreur de lecture du maillage ', * ' solide',/,' de type : ',A) #else 9999 FORMAT(' %% ERREUR LECSI1 : erreur de lecture du maillage ', * ' solide') #endif C END syrthes-3.4.3-dfsg1/src/s/limnum.F0000666000175000017500000003244111524070645015361 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMNUM C ***************** C C ----------------------------------------------------- * (NCOUPS,NBCOUS,NFLUSS,NBFLUS,NDIRS,NBDIRS,NECHS,NBECHS, * NRAYTS,NBRAYS,NRAYIS,NBRAIS,NRESCS,NBRESS, * NPRIOS,NBPRIO,NMOBIL,NBMOBS,NBCOPR,NREFS,NPOINS) C ----------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ETABLISSEMENT DE LA NUMEROTATION LOCALE DES NOEUDS * C PORTANT DES CONDITIONS AUX LIMITES DIFFERENTES * C ET DES NOEUDS PORTANT UN FLUX VOLUMIQUE * C * C Cas des conditions aux limites traitees par noeud * C * C ON NE TRAITE ICI QUE lE SOLIDE * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NCOUPS ! TE ! R ! Numero des noeuds solides couples ! C ! NBCOUS ! E ! D ! Nombre de noeuds solides couples ! C ! NFLUSS ! TE ! R ! Numero des noeuds portant une C.L. de flux ! C ! NFLUSS ! E ! D ! Nombre de noeuds portant une C.L. de flux ! C ! NDIRS ! TE ! R ! Numero des noeuds portant une C.L. Dirichlet ! C ! NBDIRS ! E ! D ! Nombre de noeuds portant une C.L. Dirichlet ! C ! NECHS ! TE ! R ! Numero des noeuds avec C.L. coeff echange ! C ! NBECHS ! E ! D ! Nombre de noeuds avec C.L. coeff echange ! C ! NRAYTS ! TE ! R ! Numero des noeuds avec rayonnement confine ! C ! NBRAYS ! E ! D ! Nombre de noeuds avec rayonnement confine ! C ! NRAYIS ! TE ! R ! Numero des noeuds avec rayonnement infini ! C ! NBRAIS ! E ! D ! Nombre de noeuds avec rayonnement infini ! C ! NRESCS ! TE ! R ! Numero des noeuds avec resistance de contact ! C ! NBRESS ! E ! D ! Nombre de noeuds avec resistance de contact ! C ! NPRIOS ! TE ! R ! Numero des noeuds periodiques ! C ! NBPRIO ! E ! D ! Nombre de noeuds periodiques ! C ! NMOBIL ! TE ! R ! Numero des noeuds en mouvement ! C ! NBMOBS ! E ! D ! Nombre de noeuds en mouvement ! C ! NBCOPR ! E ! D ! NBRE DE CORREPONDANTS POUR LES NOEUDS PERIOD ! C ! NREFS ! TE ! D ! References des noeuds solides ! C ! NPOINS ! E ! D ! Nombre de noeuds du maillage solide ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "xrefer.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBRAYS,NBRAIS,NBRESS INTEGER NBCOPR,NBPRIO,NBMOBS INTEGER NCOUPS(NBCOUS),NFLUSS(NBFLUS),NDIRS(NBDIRS) INTEGER NECHS(NBECHS),NMOBIL(NBMOBS,2) INTEGER NRAYTS(NBRAYS),NRAYIS(NBRAIS),NRESCS(NBRESS,2) INTEGER NPRIOS(NBPRIO,1+NBCOPR) INTEGER NPOINS,NREFS(NPOINS) C C.. Variables internes INTEGER NUMREF,N,N1 INTEGER NCOU,NFLU,NDIR,NECH,NRES,NRAY,NRAI,NPR,NMOB LOGICAL ERR C C*********************************************************************** C Rq : attention, dans le cas du modele coque, il faut NCOUPS(I) = I C (car le tableau NODESS n'existe pas et on travaille directement C avec NODES) C*********************************************************************** C C 1- INITIALISATIONS C ================== C DO 1 N=1,NBCOUS NCOUPS(N) = 0 1 CONTINUE C DO 2 N=1,NBFLUS NFLUSS(N) = 0 2 CONTINUE C DO 3 N=1,NBDIRS NDIRS(N) = 0 3 CONTINUE C DO 4 N=1,NBECHS NECHS(N) = 0 4 CONTINUE C DO 6 N=1,NBRESS*2 NRESCS(N,1) = 0 6 CONTINUE C DO 7 N=1,NBRAYS NRAYTS(N) = 0 7 CONTINUE C DO 8 N=1,NBRAIS NRAYIS(N) = 0 8 CONTINUE C DO 9 N=1,NBPRIO*(1+NBCOPR) NPRIOS(N,1) = 0 9 CONTINUE C DO 10 N=1,NBMOBS*2 NMOBIL(N,1) = 0 10 CONTINUE C NCOU = 0 NFLU = 0 NDIR = 0 NECH = 0 NRES = 0 NRAY = 0 NRAI = 0 NPR = 0 NMOB = 0 C C C 2- COMPTE DES NOEUDS SUIVANT LES CL C =================================== C C DO 200 N=1,NPOINS C NUMREF = ABS(NREFS(N)) C DO 210 N1=1,NRFMAX C IF (IREFSC(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NCOU = NCOU + 1 NCOUPS(NCOU) = N ENDIF C IF (IREFSF(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NFLU = NFLU + 1 NFLUSS(NFLU) = N ENDIF C IF (IREFSD(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NDIR = NDIR + 1 NDIRS(NDIR) = N ENDIF C IF (IREFSE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NECH = NECH + 1 NECHS(NECH) = N ENDIF C IF (IREFRA(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NRAY = NRAY + 1 NRAYTS(NRAY) = N ENDIF C IF (IREFRI(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NRAI = NRAI + 1 NRAYIS(NRAI) = N ENDIF C IF (IREFRE(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NRES = NRES + 1 NRESCS(NRES,1) = N ENDIF C IF (IREFPR(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NPR = NPR + 1 NPRIOS(NPR,1) = N ENDIF C IF (IREFMO(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NMOB = NMOB + 1 NMOBIL(NMOB,1) = N ENDIF C 210 CONTINUE 200 CONTINUE C C C 3- TRAITEMENT SPECIFIQUE DE CERTAINS DIRICHLET C ============================================== C DO 300 N=1,NPOINS C IF (NREFS(N).LT.0) THEN NFLU = NFLU + 1 NFLUSS(NFLU) = N ENDIF C 300 CONTINUE C C C 4- CONTROLE DES DIMENSIONS C ========================== C ERR = .FALSE. C IF (NCOU.NE.NBCOUS) THEN WRITE(NFECRA,4000) 'noeuds couples',NCOU,NBCOUS ERR = .TRUE. ENDIF IF (NFLU.NE.NBFLUS) THEN WRITE(NFECRA,4000) 'noeuds avec flux',NFLU,NBFLUS ERR = .TRUE. ENDIF IF (NDIR.NE.NBDIRS) THEN WRITE(NFECRA,4000) 'noeuds Dirichlet',NDIR,NBDIRS ERR = .TRUE. ENDIF IF (NECH.NE.NBECHS) THEN WRITE(NFECRA,4000) 'noeuds avec echange',NECH,NBECHS ERR = .TRUE. ENDIF IF (NRAY.NE.NBRAYS) THEN WRITE(NFECRA,4000) 'noeuds avec rayonnement confine ', * NRAY,NBRAYS ERR = .TRUE. ENDIF IF (NRAI.NE.NBRAIS) THEN WRITE(NFECRA,4000) 'noeuds avec rayonnement infini', * NRAI,NBRAIS ERR = .TRUE. ENDIF IF (NRES.NE.NBRESS) THEN WRITE(NFECRA,4000) 'noeuds avec resistance de contact', & NRES,NBRESS ERR = .TRUE. ENDIF IF (NPR .NE.NBPRIO) THEN WRITE(NFECRA,4000) 'noeuds periodiques',NPR ,NBPRIO ERR = .TRUE. ENDIF IF (NMOB.NE.NBMOBS) THEN WRITE(NFECRA,4000) 'noeuds en mouvement',NMOB ,NBMOBS ERR = .TRUE. ENDIF C C C C 5- IMPRESSIONS DE CONTROLE C ========================== C IF (NBLBLA.GT.0) * WRITE(NFECRA,5000) NBCOUS,NBFLUS,NBDIRS,NBECHS,NBRESS, * NBRAYS,NBRAIS,NBPRIO,NBMOBS C IF (NBLBLA.EQ.10) THEN IF (NBCOUS.GT.0) THEN WRITE(NFECRA,5010) WRITE(NFECRA,5001) (NCOUPS(N),N=1,NBCOUS) ENDIF IF (NBFLUS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5001) (NFLUSS(N),N=1,NBFLUS) ENDIF IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5030) WRITE(NFECRA,5001) (NDIRS(N),N=1,NBDIRS) ENDIF IF (NBECHS.GT.0) THEN WRITE(NFECRA,5040) WRITE(NFECRA,5001) (NECHS(N),N=1,NBECHS) ENDIF IF (NBRAYS.GT.0) THEN WRITE(NFECRA,5060) WRITE(NFECRA,5001) (NRAYTS(N),N=1,NBRAYS) ENDIF IF (NBRAIS.GT.0) THEN WRITE(NFECRA,5061) WRITE(NFECRA,5001) (NRAYIS(N),N=1,NBRAIS) ENDIF IF (NBRESS.GT.0) THEN WRITE(NFECRA,5070) WRITE(NFECRA,5001) (NRESCS(N,1),N=1,NBRESS) ENDIF IF (NBPRIO.GT.0) THEN WRITE(NFECRA,5080) WRITE(NFECRA,5001) (NPRIOS(N,1),N=1,NBPRIO) ENDIF IF (NBMOBS.GT.0) THEN WRITE(NFECRA,5090) WRITE(NFECRA,5001) (NMOBIL(N,1),N=1,NBMOBS) ENDIF C ENDIF C C 6- ARRET DU PROGRAMME EN CAS D'ERREUR DE DIMENSION C ================================================== IF (ERR) STOP C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMNUM : Nombre de points du solide :',/, & ' - couples avec le fluide : ',I6,/, & ' - condition de type flux : ',I6,/, & ' - condition de Dirichlet : ',I6,/, & ' - condition de type coefficient d''echange : ' & ,I6,/, & ' - avec resistance de contact : ',I6,/, & ' - avec rayonnement confine : ',I6,/, & ' - avec rayonnement infini : ',I6,/, & ' - periodiques : ',I6,/, & ' - en mouvement : ',I6) C 4000 FORMAT(' %% ERREUR LIMNUM : incoherence sur les ',A30,/, & ' On en compte :',I9,/, & ' Il y en a ',I9,' de declares') 5001 FORMAT(8X,12I6) 5010 FORMAT(/,8X,'Liste des noeuds solides couples :',/) 5020 FORMAT(/,8X,'Liste des noeuds solides avec flux :',/) 5030 FORMAT(/,8X,'Liste des noeuds solides avec Dirichlet :',/) 5040 FORMAT(/,8X,'Liste des noeuds solides avec coeff d''echange :',/) 5060 FORMAT(/,8X,'Liste des noeuds solides avec rayonnement ', & 'confine :',/) 5061 FORMAT(/,8X,'Liste des noeuds solides avec rayonnement ', & 'infini :',/) 5070 FORMAT(/,8X,'Liste des noeuds solides avec ', & 'resistance de contact :',/) 5080 FORMAT(/,8X,'Liste des noeuds solides periodiques :',/) 5090 FORMAT(/,8X,'Liste des noeuds solides en mouvement :',/) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/cfluvs.F0000666000175000017500000002436111524070645015364 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CFLUVS C ***************** C C ---------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,NBFLVS,NPFEL,NFLUVS,VFLUVS) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DE FLUX VOLUMIQUES SUR LE SOLIDE * C (EN FONCTION DE L'ESPACE DU TEMPS ET DE LA TEMPERATURE) * C CAS DU MODELE GENERAL * C * C Dans la version 3.0, le flux volumiques peuvent etre * C definis sur les noeuds, les elements ou * C par noeud d'un element * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TE ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS AVEC FLUX VOL ! C ! NFLUVS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOL ! C ! VFLUVS ! TR ! R ! VALEUR DU FLUX VOLUMIQUE EN CES NOEUDS ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /TEMPS/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBFLVS,NPFEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NFLUVS(NBFLVS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) C C.. Variables internes INTEGER I,J,K,N,NUMREF,NUMNO,NUMEL DOUBLE PRECISION XX,YY,ZZ,TT1,TT2,T C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C --------------------------------------------------- C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ------------------------------------------------------------------ C Le flux volumique est stocke dans VFLUVS C Il peut etre fonction de l'espace (COORDS(...,1),COORDS(...,2), C COORDS(...,3)), du temps TEMPS, et de la temperature TMPS(...) C Dans le cas du modele coque, on dispose des temperatures C interne (TMPSA) et externe (TMPS) de la coque C ------------------------------------------------------------------ C C C Temps reel courant sur le solide CUTI T = TEMPSS C C C ============================================================ C TRAITEMENT PAR NOEUD C ============================================================ C Pour chaque point portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global du noeud CUTI NUMNO = NFLUVS(N) C C Reference du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud courant porte la reference 4 le flux vaut 1000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 C C Sinon il vaut 10000 W/M3 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 C CUTI ENDIF C CUTI ENDDO C ============================================================ C FIN DU TRAITEMENT PAR NOEUD C ============================================================ C C C C C ============================================================ C TRAITEMENT PAR ELEMENT (FLUX VOLUMIQUE CONSTANT PAR ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C C Numero des noeuds de l'element CUTI N1 = NODES(NUMEL,1) CUTI N2 = NODES(NUMEL,2) CUTI N3 = NODES(NUMEL,3) CUTI N4 = NODES(NUMEL,4) CUTI N5 = NODES(NUMEL,5) CUTI N6 = NODES(NUMEL,6) CUTI IF (NDIM.EQ.3) THEN CUTI N7 = NODES(NUMEL,7) CUTI N8 = NODES(NUMEL,8) CUTI N9 = NODES(NUMEL,9) CUTI N10= NODES(NUMEL,10) CUTI ENDIF C C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Coordonnees XXi YYi ZZi des noeuds de l'element C (6 en 2d, 10 en 3D) C Noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc... C C Temperatures TTi aux noeuds de l'element (6 en 2d 10 en 3d) C TT1 = Temperature au noeud courant n1 CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc... C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 CUTI ENDIF C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR ELEMENT (FLUX CONSTANT PAR ELEMENT) C ============================================================ C C C C C C C ============================================================ C TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Pour chaque noeud de l'element courant CUTI DO J=1,NPFEL C C Numero du noeud courant CUTI N1 = NODES(NUMEL,J) C C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT1 = TMPS(N1) C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 sur chacun des noeuds de l'element C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,J) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,J) = 10000.D0 CUTI ENDIF CUTI ENDDO C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/rotats.F0000666000175000017500000005072211524070645015376 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=ROTATS,SSI=0 C SUBROUTINE ROTATS C ***************** C * (X,Y,Z,XT,YT,ZT,TX,TY,TZ,ARX,ARY,ARZ,AROTX,AROTY,AROTZ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- A PARTIR D'UN POINT X,Y,Z, CALCULER SES NOUVELLES * C COORDONNEES APRES UNE ROTATION DEFINIE PAR * C TX,TY,TZ : translation du repere d'origine * C ARX,ARY,ARZ : rotation du repere d'origine * C AROTX,AROTY,AROTZ : rotation propre du solide * C * C | ROT * C Translation | Rotation \ / \ / * C | T | R \ / \ / * C | o------- \o/ \o/ * C | / | | * C o------- / | | * C / * C / Rotation du solide* C dans son repere * C -1 -1 * C D'ou la transformation : T . R . ROT . R . T * C * C*********************************************************************** C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! X,Y,Z ! R ! D ! COORDONNEES INITIALES DU POINT ! C !XT,YT,ZT! R ! R ! COORDONNEES TRANSFORMEES DU POINT ! C !TX,TY,TZ! R ! D ! VECTEUR TRANSLATION DU REPERE INITIALE ! C !ARX,ARY,! R ! D ! ANGLES DES AXES X, Y ET Z DU NOUVEAU REPERE ! C ! ARZ ! ! ! ! C !AROTX, ! ! ! ANGLES PAR RAPPORT A X,Y,ET Z DU REPERE ! C ! AROTY, ! R ! D ! LOCAL DE LA ROTATION DU SOLIDE ! C ! AROTZ ! ! ! ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !/XREFER/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : IPERIO,MOBROT C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" C C********************************************************************** C C..Variables externes DOUBLE PRECISION X,Y,Z,XT,YT,ZT,TX,TY,TZ,ARX,ARY,ARZ DOUBLE PRECISION AROTX,AROTY,AROTZ C C..Variables internes DOUBLE PRECISION PI,S1,S2,S3 DOUBLE PRECISION CRX,SRX,CRY,SRY,CRZ,SRZ DOUBLE PRECISION COX,SOX,COY,SOY,COZ,SOZ DOUBLE PRECISION TR(4,4),RM1(4,4) C C********************************************************************** C C 0- Initialisations C ================== C C PI = 3.141592654 C ARY = - ARY AROTY = - AROTY C CRX = COS(ARX) SRX = SIN(ARX) CRY = COS(ARY) SRY = SIN(ARY) CRZ = COS(ARZ) SRZ = SIN(ARZ) C COX = COS(AROTX) SOX = SIN(AROTX) COY = COS(AROTY) SOY = SIN(AROTY) COZ = COS(AROTZ) SOZ = SIN(AROTZ) C C C 1- RECALAGE DU REPERE LOCAL SUR LE REPERE GLOBAL C ================================================ C RM1(4,1) = 0 RM1(2,2) = (CRZ*CRY**2*CRX-SRZ*SRY*SRX+CRZ*SRY**2*CRX)/(CRZ**2*CRY &**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY**2 &*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+CRZ**2*CRX**2*SR &Y**2+SRZ**2*SRY**2*SRX**2) RM1(1,1) = CRZ*CRY/(CRZ**2*CRY**2+SRZ**2*CRY**2+SRZ**2*SRY**2+CRZ* &*2*SRY**2) RM1(4,2) = 0 RM1(1,4) = 0 RM1(2,3) = CRY*SRX/(CRY**2*SRX**2+CRY**2*CRX**2+SRY**2*SRX**2+CRX* &*2*SRY**2) RM1(1,2) = SRZ*CRY/(CRZ**2*CRY**2+SRZ**2*CRY**2+SRZ**2*SRY**2+CRZ* &*2*SRY**2) RM1(4,3) = 0 RM1(2,4) = 0 RM1(1,3) = SRY/(CRY**2+SRY**2) RM1(3,3) = CRY*CRX/(CRY**2*SRX**2+CRY**2*CRX**2+SRY**2*SRX**2+CRX* &*2*SRY**2) RM1(3,4) = 0 RM1(3,1) = -(-SRZ*CRY**2*SRX+CRZ*SRY*CRX-SRZ*SRY**2*SRX)/(CRZ**2*C &RY**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY* &*2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+CRZ**2*CRX**2* &SRY**2+SRZ**2*SRY**2*SRX**2) RM1(4,4) = 1 RM1(3,2) = -(CRZ*CRY**2*SRX+SRZ*SRY*CRX+CRZ*SRY**2*SRX)/(CRZ**2*CR &Y**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY** &2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+CRZ**2*CRX**2*S &RY**2+SRZ**2*SRY**2*SRX**2) RM1(2,1) = -(SRZ*CRY**2*CRX+CRZ*SRY*SRX+SRZ*SRY**2*CRX)/(CRZ**2*CR &Y**2*CRX**2+CRZ**2*CRY**2*SRX**2+SRZ**2*CRY**2*CRX**2+SRZ**2*CRY** &2*SRX**2+SRZ**2*CRX**2*SRY**2+CRZ**2*SRY**2*SRX**2+CRZ**2*CRX**2*S &RY**2+SRZ**2*SRY**2*SRX**2) C C C 2- TRANSFORMATION GENERALE C ========================== C TR(4,1) = RM1(4,1) TR(2,2) = RM1(1,2)*SRZ*CRY*COZ*COY+RM1(1,2)*SOZ*COY*CRZ*CRX-RM1(1, &2)*SOZ*COY*SRZ*SRY*SRX-RM1(1,2)*SOY*CRZ*SRX-RM1(1,2)*SOY*SRZ*SRY*C &RX-RM1(2,2)*SRZ*CRY*SOZ*COX-RM1(2,2)*SRZ*CRY*COZ*SOY*SOX+RM1(2,2)* &CRZ*CRX*COZ*COX-RM1(2,2)*CRZ*CRX*SOZ*SOY*SOX-RM1(2,2)*SRZ*SRY*SRX* &COZ*COX+RM1(2,2)*SRZ*SRY*SRX*SOZ*SOY*SOX-RM1(2,2)*COY*SOX*CRZ*SRX- &RM1(2,2)*COY*SOX*SRZ*SRY*CRX+RM1(3,2)*SRZ*CRY*SOZ*SOX-RM1(3,2)*SRZ &*CRY*COZ*SOY*COX-RM1(3,2)*CRZ*CRX*COZ*SOX-RM1(3,2)*CRZ*CRX*SOZ*SOY &*COX+RM1(3,2)*SRZ*SRY*SRX*COZ*SOX+RM1(3,2)*SRZ*SRY*SRX*SOZ*SOY*COX &-RM1(3,2)*COY*COX*CRZ*SRX-RM1(3,2)*COY*COX*SRZ*SRY*CRX+TY*RM1(4,2) TR(1,1) = RM1(1,1)*CRZ*CRY*COZ*COY-RM1(1,1)*SOZ*COY*SRZ*CRX-RM1(1, &1)*SOZ*COY*CRZ*SRY*SRX+RM1(1,1)*SOY*SRZ*SRX-RM1(1,1)*SOY*CRZ*SRY*C &RX-RM1(2,1)*CRZ*CRY*SOZ*COX-RM1(2,1)*CRZ*CRY*COZ*SOY*SOX-RM1(2,1)* &SRZ*CRX*COZ*COX+RM1(2,1)*SRZ*CRX*SOZ*SOY*SOX-RM1(2,1)*CRZ*SRY*SRX* &COZ*COX+RM1(2,1)*CRZ*SRY*SRX*SOZ*SOY*SOX+RM1(2,1)*COY*SOX*SRZ*SRX- &RM1(2,1)*COY*SOX*CRZ*SRY*CRX+RM1(3,1)*CRZ*CRY*SOZ*SOX-RM1(3,1)*CRZ &*CRY*COZ*SOY*COX+RM1(3,1)*SRZ*CRX*COZ*SOX+RM1(3,1)*SRZ*CRX*SOZ*SOY &*COX+RM1(3,1)*CRZ*SRY*SRX*COZ*SOX+RM1(3,1)*CRZ*SRY*SRX*SOZ*SOY*COX &+RM1(3,1)*COY*COX*SRZ*SRX-RM1(3,1)*COY*COX*CRZ*SRY*CRX+TX*RM1(4,1) TR(4,2) = RM1(4,2) s3 = -TY*RM1(1,2)*SOY*SRZ*SRX+TX*RM1(3,1)*COY*COX*CRZ*SRY*CRX-TX*R &M1(3,1)*CRZ*SRY*SRX*COZ*SOX-TX*RM1(3,1)*SRZ*CRX*SOZ*SOY*COX-TX*RM1 &(3,1)*COY*COX*SRZ*SRX+TX*RM1(3,1)*CRZ*CRY*COZ*SOY*COX+TZ*RM1(2,3)* &SRZ*CRX*COZ*COX+TZ*RM1(2,3)*CRZ*CRY*SOZ*COX+TZ*RM1(1,3)*SOY*CRZ*SR &Y*CRX-TZ*RM1(1,3)*SOY*SRZ*SRX+TZ*RM1(1,3)*SOZ*COY*SRZ*CRX s2 = s3-TZ*RM1(1,3)*CRZ*CRY*COZ*COY+TX*RM1(2,1)*COY*SOX*CRZ*SRY*CR &X+TX*RM1(2,1)*CRZ*SRY*SRX*COZ*COX-TX*RM1(2,1)*COY*SOX*SRZ*SRX-TX*R &M1(2,1)*SRZ*CRX*SOZ*SOY*SOX-TZ*TX*RM1(4,3)+TX*RM1(2,1)*CRZ*CRY*COZ &*SOY*SOX+TX*RM1(1,1)*SOZ*COY*CRZ*SRY*SRX-TX*RM1(1,1)*SOY*SRZ*SRX+T &Y*RM1(3,2)*COY*COX*CRZ*SRY*CRX-TY*TX*RM1(4,2) s3 = s2+TY*RM1(1,2)*SOY*CRZ*SRY*CRX+TY*RM1(1,2)*SOZ*COY*SRZ*CRX-TY &*RM1(1,2)*CRZ*CRY*COZ*COY-TZ*RM1(3,3)*COY*COX*SRZ*SRX-TZ*RM1(3,3)* &CRZ*SRY*SRX*SOZ*SOY*COX-TZ*RM1(3,3)*SRZ*CRX*COZ*SOX-TZ*RM1(3,3)*CR &Z*CRY*SOZ*SOX-TZ*RM1(2,3)*COY*SOX*SRZ*SRX-RM1(2,4)*CRZ*SRY*SRX*COZ &*COX-TZ*RM1(2,3)*CRZ*SRY*SRX*SOZ*SOY*SOX s1 = s3-TY*RM1(3,2)*CRZ*SRY*SRX*COZ*SOX-TX*RM1(3,1)*CRZ*SRY*SRX*SO &Z*SOY*COX-TX*RM1(3,1)*SRZ*CRX*COZ*SOX-TX*RM1(3,1)*CRZ*CRY*SOZ*SOX- &TX*RM1(2,1)*CRZ*SRY*SRX*SOZ*SOY*SOX+TX*RM1(2,1)*SRZ*CRX*COZ*COX+TX &*RM1(2,1)*CRZ*CRY*SOZ*COX+TX*RM1(1,1)*SOY*CRZ*SRY*CRX+TZ*RM1(1,3)* &SOZ*COY*CRZ*SRY*SRX+TX*RM1(1,1)*SOZ*COY*SRZ*CRX-TY*RM1(3,2)*SRZ*CR &X*SOZ*SOY*COX-TX*RM1(1,1)*CRZ*CRY*COZ*COY s3 = -TY*RM1(3,2)*COY*COX*SRZ*SRX-TY*RM1(3,2)*CRZ*SRY*SRX*SOZ*SOY* &COX-TY*RM1(3,2)*SRZ*CRX*COZ*SOX+RM1(3,4)*SRZ*CRX*COZ*SOX-TY*RM1(3, &2)*CRZ*CRY*SOZ*SOX-TY*RM1(2,2)*COY*SOX*SRZ*SRX-TY*RM1(2,2)*CRZ*SRY &*SRX*SOZ*SOY*SOX+TY*RM1(2,2)*SRZ*CRX*COZ*COX-TX**2*RM1(4,1)+TY*RM1 &(2,2)*CRZ*CRY*SOZ*COX+TZ*RM1(2,3)*CRZ*CRY*COZ*SOY*SOX s2 = s3-RM1(2,4)*CRZ*CRY*COZ*SOY*SOX-TZ*RM1(2,3)*SRZ*CRX*SOZ*SOY*S &OX+RM1(2,4)*SRZ*CRX*SOZ*SOY*SOX+TZ*RM1(2,3)*COY*SOX*CRZ*SRY*CRX+TZ &*RM1(2,3)*CRZ*SRY*SRX*COZ*COX+TZ*RM1(3,3)*CRZ*CRY*COZ*SOY*COX+s1-T &Y*RM1(2,2)*SRZ*CRX*SOZ*SOY*SOX+TY*RM1(2,2)*CRZ*CRY*COZ*SOY*SOX+TY* &RM1(1,2)*SOZ*COY*CRZ*SRY*SRX+TZ*RM1(3,3)*COY*COX*CRZ*SRY*CRX s3 = s2-TZ*RM1(3,3)*CRZ*SRY*SRX*COZ*SOX-TZ*RM1(3,3)*SRZ*CRX*SOZ*SO &Y*COX+TY*RM1(2,2)*COY*SOX*CRZ*SRY*CRX+TY*RM1(2,2)*CRZ*SRY*SRX*COZ* &COX+TY*RM1(3,2)*CRZ*CRY*COZ*SOY*COX+TX*RM1(4,4)+RM1(1,4)*CRZ*CRY*C &OZ*COY-RM1(1,4)*SOZ*COY*SRZ*CRX-RM1(1,4)*SOZ*COY*CRZ*SRY*SRX+RM1(1 &,4)*SOY*SRZ*SRX-RM1(1,4)*SOY*CRZ*SRY*CRX TR(1,4) = s3-RM1(2,4)*CRZ*CRY*SOZ*COX-RM1(2,4)*SRZ*CRX*COZ*COX+RM1 &(2,4)*CRZ*SRY*SRX*SOZ*SOY*SOX+RM1(2,4)*COY*SOX*SRZ*SRX-RM1(2,4)*CO &Y*SOX*CRZ*SRY*CRX+RM1(3,4)*CRZ*CRY*SOZ*SOX-RM1(3,4)*CRZ*CRY*COZ*SO &Y*COX+RM1(3,4)*SRZ*CRX*SOZ*SOY*COX+RM1(3,4)*CRZ*SRY*SRX*COZ*SOX+RM &1(3,4)*CRZ*SRY*SRX*SOZ*SOY*COX+RM1(3,4)*COY*COX*SRZ*SRX-RM1(3,4)*C &OY*COX*CRZ*SRY*CRX TR(2,3) = RM1(1,3)*SRZ*CRY*COZ*COY+RM1(1,3)*SOZ*COY*CRZ*CRX-RM1(1, &3)*SOZ*COY*SRZ*SRY*SRX-RM1(1,3)*SOY*CRZ*SRX-RM1(1,3)*SOY*SRZ*SRY*C &RX-RM1(2,3)*SRZ*CRY*SOZ*COX-RM1(2,3)*SRZ*CRY*COZ*SOY*SOX+RM1(2,3)* &CRZ*CRX*COZ*COX-RM1(2,3)*CRZ*CRX*SOZ*SOY*SOX-RM1(2,3)*SRZ*SRY*SRX* &COZ*COX+RM1(2,3)*SRZ*SRY*SRX*SOZ*SOY*SOX-RM1(2,3)*COY*SOX*CRZ*SRX- &RM1(2,3)*COY*SOX*SRZ*SRY*CRX+RM1(3,3)*SRZ*CRY*SOZ*SOX-RM1(3,3)*SRZ &*CRY*COZ*SOY*COX-RM1(3,3)*CRZ*CRX*COZ*SOX-RM1(3,3)*CRZ*CRX*SOZ*SOY &*COX+RM1(3,3)*SRZ*SRY*SRX*COZ*SOX+RM1(3,3)*SRZ*SRY*SRX*SOZ*SOY*COX &-RM1(3,3)*COY*COX*CRZ*SRX-RM1(3,3)*COY*COX*SRZ*SRY*CRX+TY*RM1(4,3) TR(1,2) = RM1(1,2)*CRZ*CRY*COZ*COY-RM1(1,2)*SOZ*COY*SRZ*CRX-RM1(1, &2)*SOZ*COY*CRZ*SRY*SRX+RM1(1,2)*SOY*SRZ*SRX-RM1(1,2)*SOY*CRZ*SRY*C &RX-RM1(2,2)*CRZ*CRY*SOZ*COX-RM1(2,2)*CRZ*CRY*COZ*SOY*SOX-RM1(2,2)* &SRZ*CRX*COZ*COX+RM1(2,2)*SRZ*CRX*SOZ*SOY*SOX-RM1(2,2)*CRZ*SRY*SRX* &COZ*COX+RM1(2,2)*CRZ*SRY*SRX*SOZ*SOY*SOX+RM1(2,2)*COY*SOX*SRZ*SRX- &RM1(2,2)*COY*SOX*CRZ*SRY*CRX+RM1(3,2)*CRZ*CRY*SOZ*SOX-RM1(3,2)*CRZ &*CRY*COZ*SOY*COX+RM1(3,2)*SRZ*CRX*COZ*SOX+RM1(3,2)*SRZ*CRX*SOZ*SOY &*COX+RM1(3,2)*CRZ*SRY*SRX*COZ*SOX+RM1(3,2)*CRZ*SRY*SRX*SOZ*SOY*COX &+RM1(3,2)*COY*COX*SRZ*SRX-RM1(3,2)*COY*COX*CRZ*SRY*CRX+TX*RM1(4,2) TR(4,3) = RM1(4,3) s3 = TZ*RM1(2,3)*SRZ*SRY*SRX*COZ*COX+TZ*RM1(2,3)*CRZ*CRX*SOZ*SOY*S &OX+TZ*RM1(2,3)*COY*SOX*CRZ*SRX+TZ*RM1(1,3)*SOZ*COY*SRZ*SRY*SRX+TX* &RM1(2,1)*SRZ*SRY*SRX*COZ*COX+TX*RM1(2,1)*COY*SOX*CRZ*SRX+TX*RM1(2, &1)*CRZ*CRX*SOZ*SOY*SOX+TX*RM1(2,1)*SRZ*CRY*COZ*SOY*SOX+TX*RM1(1,1) &*SOZ*COY*SRZ*SRY*SRX+TY*RM1(3,2)*COY*COX*SRZ*SRY*CRX-TY*RM1(3,2)*S &RZ*SRY*SRX*COZ*SOX s2 = s3+TY*RM1(3,2)*CRZ*CRX*SOZ*SOY*COX+TY*RM1(3,2)*SRZ*CRY*COZ*SO &Y*COX+TY*RM1(2,2)*COY*SOX*SRZ*SRY*CRX-RM1(3,4)*COY*COX*CRZ*SRX+TY* &RM1(2,2)*SRZ*SRY*SRX*COZ*COX-TY*RM1(2,2)*SRZ*SRY*SRX*SOZ*SOY*SOX+T &Y*RM1(1,2)*SOZ*COY*SRZ*SRY*SRX-TX*TY*RM1(4,1)+TZ*RM1(3,3)*COY*COX* &SRZ*SRY*CRX-TZ*RM1(3,3)*SRZ*SRY*SRX*COZ*SOX+TZ*RM1(3,3)*CRZ*CRX*SO &Z*SOY*COX s3 = s2+TZ*RM1(3,3)*COY*COX*CRZ*SRX+TZ*RM1(3,3)*SRZ*CRY*COZ*SOY*CO &X+TZ*RM1(3,3)*CRZ*CRX*COZ*SOX+TZ*RM1(2,3)*COY*SOX*SRZ*SRY*CRX+TZ*R &M1(2,3)*SRZ*CRY*COZ*SOY*SOX-TZ*RM1(2,3)*CRZ*CRX*COZ*COX+TY*RM1(2,2 &)*SRZ*CRY*COZ*SOY*SOX+TY*RM1(2,2)*CRZ*CRX*SOZ*SOY*SOX-TZ*TY*RM1(4, &3)-RM1(1,4)*SOY*CRZ*SRX s1 = s3+TX*RM1(3,1)*COY*COX*SRZ*SRY*CRX-TX*RM1(3,1)*SRZ*SRY*SRX*CO &Z*SOX-RM1(3,4)*COY*COX*SRZ*SRY*CRX+TX*RM1(3,1)*CRZ*CRX*SOZ*SOY*COX &+TX*RM1(2,1)*COY*SOX*SRZ*SRY*CRX+TX*RM1(3,1)*SRZ*CRY*COZ*SOY*COX-T &Z*RM1(2,3)*SRZ*SRY*SRX*SOZ*SOY*SOX+TX*RM1(1,1)*SOY*CRZ*SRX+TY*RM1( &1,2)*SOY*CRZ*SRX+TZ*RM1(2,3)*SRZ*CRY*SOZ*COX+TZ*RM1(1,3)*SOY*SRZ*S &RY*CRX-TZ*RM1(1,3)*SOZ*COY*CRZ*CRX s3 = -TY**2*RM1(4,2)+TZ*RM1(1,3)*SOY*CRZ*SRX-TZ*RM1(1,3)*SRZ*CRY*C &OZ*COY+TY*RM1(2,2)*COY*SOX*CRZ*SRX-TY*RM1(2,2)*CRZ*CRX*COZ*COX+TY* &RM1(2,2)*SRZ*CRY*SOZ*COX+TY*RM1(1,2)*SOY*SRZ*SRY*CRX-TY*RM1(1,2)*S &OZ*COY*CRZ*CRX-TY*RM1(1,2)*SRZ*CRY*COZ*COY-TZ*RM1(3,3)*SRZ*SRY*SRX &*SOZ*SOY*COX-TZ*RM1(3,3)*SRZ*CRY*SOZ*SOX s2 = s3-RM1(1,4)*SOY*SRZ*SRY*CRX-TX*RM1(2,1)*SRZ*SRY*SRX*SOZ*SOY*S &OX-TX*RM1(2,1)*CRZ*CRX*COZ*COX+TX*RM1(2,1)*SRZ*CRY*SOZ*COX+TX*RM1( &1,1)*SOY*SRZ*SRY*CRX-TX*RM1(1,1)*SOZ*COY*CRZ*CRX-TX*RM1(1,1)*SRZ*C &RY*COZ*COY+TY*RM1(3,2)*COY*COX*CRZ*SRX-TY*RM1(3,2)*SRZ*SRY*SRX*SOZ &*SOY*COX+TY*RM1(3,2)*CRZ*CRX*COZ*SOX-TY*RM1(3,2)*SRZ*CRY*SOZ*SOX s3 = s2+TX*RM1(3,1)*COY*COX*CRZ*SRX-TX*RM1(3,1)*SRZ*SRY*SRX*SOZ*SO &Y*COX+TX*RM1(3,1)*CRZ*CRX*COZ*SOX-TX*RM1(3,1)*SRZ*CRY*SOZ*SOX+s1+T &Y*RM1(4,4)+RM1(1,4)*SRZ*CRY*COZ*COY+RM1(1,4)*SOZ*COY*CRZ*CRX-RM1(1 &,4)*SOZ*COY*SRZ*SRY*SRX-RM1(2,4)*SRZ*CRY*SOZ*COX-RM1(2,4)*SRZ*CRY* &COZ*SOY*SOX TR(2,4) = s3+RM1(2,4)*CRZ*CRX*COZ*COX-RM1(2,4)*CRZ*CRX*SOZ*SOY*SOX &-RM1(2,4)*SRZ*SRY*SRX*COZ*COX+RM1(2,4)*SRZ*SRY*SRX*SOZ*SOY*SOX-RM1 &(2,4)*COY*SOX*CRZ*SRX-RM1(2,4)*COY*SOX*SRZ*SRY*CRX+RM1(3,4)*SRZ*CR &Y*SOZ*SOX-RM1(3,4)*SRZ*CRY*COZ*SOY*COX-RM1(3,4)*CRZ*CRX*COZ*SOX-RM &1(3,4)*CRZ*CRX*SOZ*SOY*COX+RM1(3,4)*SRZ*SRY*SRX*COZ*SOX+RM1(3,4)*S &RZ*SRY*SRX*SOZ*SOY*COX TR(1,3) = RM1(1,3)*CRZ*CRY*COZ*COY-RM1(1,3)*SOZ*COY*SRZ*CRX-RM1(1, &3)*SOZ*COY*CRZ*SRY*SRX+RM1(1,3)*SOY*SRZ*SRX-RM1(1,3)*SOY*CRZ*SRY*C &RX-RM1(2,3)*CRZ*CRY*SOZ*COX-RM1(2,3)*CRZ*CRY*COZ*SOY*SOX-RM1(2,3)* &SRZ*CRX*COZ*COX+RM1(2,3)*SRZ*CRX*SOZ*SOY*SOX-RM1(2,3)*CRZ*SRY*SRX* &COZ*COX+RM1(2,3)*CRZ*SRY*SRX*SOZ*SOY*SOX+RM1(2,3)*COY*SOX*SRZ*SRX- &RM1(2,3)*COY*SOX*CRZ*SRY*CRX+RM1(3,3)*CRZ*CRY*SOZ*SOX-RM1(3,3)*CRZ &*CRY*COZ*SOY*COX+RM1(3,3)*SRZ*CRX*COZ*SOX+RM1(3,3)*SRZ*CRX*SOZ*SOY &*COX+RM1(3,3)*CRZ*SRY*SRX*COZ*SOX+RM1(3,3)*CRZ*SRY*SRX*SOZ*SOY*COX &+RM1(3,3)*COY*COX*SRZ*SRX-RM1(3,3)*COY*COX*CRZ*SRY*CRX+TX*RM1(4,3) TR(3,3) = RM1(1,3)*SRY*COZ*COY+RM1(1,3)*CRY*SRX*SOZ*COY+RM1(1,3)*C &RY*CRX*SOY-RM1(2,3)*SRY*SOZ*COX-RM1(2,3)*SRY*COZ*SOY*SOX+RM1(2,3)* &CRY*SRX*COZ*COX-RM1(2,3)*CRY*SRX*SOZ*SOY*SOX+RM1(2,3)*CRY*CRX*COY* &SOX+RM1(3,3)*SRY*SOZ*SOX-RM1(3,3)*SRY*COZ*SOY*COX-RM1(3,3)*CRY*SRX &*COZ*SOX-RM1(3,3)*CRY*SRX*SOZ*SOY*COX+RM1(3,3)*CRY*CRX*COY*COX+TZ* &RM1(4,3) s2 = -RM1(2,4)*SRY*COZ*SOY*SOX+RM1(1,4)*SRY*COZ*COY+TY*RM1(2,2)*CR &Y*SRX*SOZ*SOY*SOX+TZ*RM1(3,3)*SRY*COZ*SOY*COX-TZ*RM1(2,3)*CRY*CRX* &COY*SOX+TZ*RM1(2,3)*CRY*SRX*SOZ*SOY*SOX+TZ*RM1(2,3)*SRY*COZ*SOY*SO &X-TZ*RM1(2,3)*CRY*SRX*COZ*COX+TY*RM1(3,2)*CRY*SRX*SOZ*SOY*COX+TX*R &M1(3,1)*CRY*SRX*SOZ*SOY*COX+TX*RM1(2,1)*CRY*SRX*SOZ*SOY*SOX+TZ*RM1 &(3,3)*CRY*SRX*COZ*SOX-TZ*RM1(3,3)*CRY*CRX*COY*COX+TZ*RM1(3,3)*CRY* &SRX*SOZ*SOY*COX s1 = s2-TX*RM1(1,1)*CRY*CRX*SOY-TX*RM1(1,1)*SRY*COZ*COY-TX*TZ*RM1( &4,1)+RM1(1,4)*CRY*SRX*SOZ*COY-TX*RM1(1,1)*CRY*SRX*SOZ*COY-TX*RM1(3 &,1)*SRY*SOZ*SOX+TX*RM1(2,1)*SRY*SOZ*COX-TY*TZ*RM1(4,2)-TZ**2*RM1(4 &,3)-TX*RM1(2,1)*CRY*CRX*COY*SOX+TY*RM1(2,2)*SRY*SOZ*COX-TY*RM1(1,2 &)*CRY*CRX*SOY-TY*RM1(1,2)*SRY*COZ*COY-TX*RM1(2,1)*CRY*SRX*COZ*COX s2 = s1+TX*RM1(2,1)*SRY*COZ*SOY*SOX-TX*RM1(3,1)*CRY*CRX*COY*COX+TX &*RM1(3,1)*CRY*SRX*COZ*SOX-TZ*RM1(3,3)*SRY*SOZ*SOX+TZ*RM1(2,3)*SRY* &SOZ*COX-TZ*RM1(1,3)*CRY*CRX*SOY-TZ*RM1(1,3)*SRY*COZ*COY+TX*RM1(3,1 &)*SRY*COZ*SOY*COX-TY*RM1(3,2)*SRY*SOZ*SOX-TZ*RM1(1,3)*CRY*SRX*SOZ* &COY-TY*RM1(3,2)*CRY*CRX*COY*COX+TY*RM1(3,2)*CRY*SRX*COZ*SOX+TY*RM1 &(3,2)*SRY*COZ*SOY*COX TR(3,4) = s2-TY*RM1(2,2)*CRY*CRX*COY*SOX-TY*RM1(2,2)*CRY*SRX*COZ*C &OX+TY*RM1(2,2)*SRY*COZ*SOY*SOX-TY*RM1(1,2)*CRY*SRX*SOZ*COY+TZ*RM1( &4,4)+RM1(1,4)*CRY*CRX*SOY-RM1(2,4)*SRY*SOZ*COX+RM1(2,4)*CRY*SRX*CO &Z*COX-RM1(2,4)*CRY*SRX*SOZ*SOY*SOX+RM1(2,4)*CRY*CRX*COY*SOX+RM1(3, &4)*SRY*SOZ*SOX-RM1(3,4)*SRY*COZ*SOY*COX-RM1(3,4)*CRY*SRX*COZ*SOX-R &M1(3,4)*CRY*SRX*SOZ*SOY*COX+RM1(3,4)*CRY*CRX*COY*COX TR(3,1) = RM1(1,1)*SRY*COZ*COY+RM1(1,1)*CRY*SRX*SOZ*COY+RM1(1,1)*C &RY*CRX*SOY-RM1(2,1)*SRY*SOZ*COX-RM1(2,1)*SRY*COZ*SOY*SOX+RM1(2,1)* &CRY*SRX*COZ*COX-RM1(2,1)*CRY*SRX*SOZ*SOY*SOX+RM1(2,1)*CRY*CRX*COY* &SOX+RM1(3,1)*SRY*SOZ*SOX-RM1(3,1)*SRY*COZ*SOY*COX-RM1(3,1)*CRY*SRX &*COZ*SOX-RM1(3,1)*CRY*SRX*SOZ*SOY*COX+RM1(3,1)*CRY*CRX*COY*COX+TZ* &RM1(4,1) TR(4,4) = -TX*RM1(4,1)-TY*RM1(4,2)-TZ*RM1(4,3)+RM1(4,4) TR(3,2) = RM1(1,2)*SRY*COZ*COY+RM1(1,2)*CRY*SRX*SOZ*COY+RM1(1,2)*C &RY*CRX*SOY-RM1(2,2)*SRY*SOZ*COX-RM1(2,2)*SRY*COZ*SOY*SOX+RM1(2,2)* &CRY*SRX*COZ*COX-RM1(2,2)*CRY*SRX*SOZ*SOY*SOX+RM1(2,2)*CRY*CRX*COY* &SOX+RM1(3,2)*SRY*SOZ*SOX-RM1(3,2)*SRY*COZ*SOY*COX-RM1(3,2)*CRY*SRX &*COZ*SOX-RM1(3,2)*CRY*SRX*SOZ*SOY*COX+RM1(3,2)*CRY*CRX*COY*COX+TZ* &RM1(4,2) TR(2,1) = RM1(1,1)*SRZ*CRY*COZ*COY+RM1(1,1)*SOZ*COY*CRZ*CRX-RM1(1, &1)*SOZ*COY*SRZ*SRY*SRX-RM1(1,1)*SOY*CRZ*SRX-RM1(1,1)*SOY*SRZ*SRY*C &RX-RM1(2,1)*SRZ*CRY*SOZ*COX-RM1(2,1)*SRZ*CRY*COZ*SOY*SOX+RM1(2,1)* &CRZ*CRX*COZ*COX-RM1(2,1)*CRZ*CRX*SOZ*SOY*SOX-RM1(2,1)*SRZ*SRY*SRX* &COZ*COX+RM1(2,1)*SRZ*SRY*SRX*SOZ*SOY*SOX-RM1(2,1)*COY*SOX*CRZ*SRX- &RM1(2,1)*COY*SOX*SRZ*SRY*CRX+RM1(3,1)*SRZ*CRY*SOZ*SOX-RM1(3,1)*SRZ &*CRY*COZ*SOY*COX-RM1(3,1)*CRZ*CRX*COZ*SOX-RM1(3,1)*CRZ*CRX*SOZ*SOY &*COX+RM1(3,1)*SRZ*SRY*SRX*COZ*SOX+RM1(3,1)*SRZ*SRY*SRX*SOZ*SOY*COX &-RM1(3,1)*COY*COX*CRZ*SRX-RM1(3,1)*COY*COX*SRZ*SRY*CRX+TY*RM1(4,1) C C C 3- CALCUL DES NOUVELLES COORDONNEES C =================================== C XT = TR(1,1)*X+TR(1,2)*Y+TR(1,3)*Z+TR(1,4) YT = TR(2,1)*X+TR(2,2)*Y+TR(2,3)*Z+TR(2,4) ZT = TR(3,1)*X+TR(3,2)*Y+TR(3,3)*Z+TR(3,4) C C C C-------- C FORMATS C-------- C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/mobrot.F0000666000175000017500000001227611524070645015366 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MOBROT,SSI=0 C SUBROUTINE MOBROT C ***************** C C ----------------------------------- *( NDIM,NPOINS,NBMOBS,NMOBIL,COORDS) C ----------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- SOLIDE MOBILE : CALCULE DES NOUVELLES * C COORDONNEES DES NOEUDS * C CAS DES SOLIDES EN ROTATIONS SUR EUX-MEMES * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBMOBS ! E ! D ! NOMBRE DE NOEUDS MOBILES ! C ! NMOBIL ! E ! D ! NUM GLOB ET NUM DE SOLIDE DES NOEUDS MOB ! C ! COORDS ! TR ! M ! COORDONNEES DES NOEUDS DU MAILLAGE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ROTATS C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "mobil.h" #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NDIM,NBMOBS,NMOBIL(NBMOBS,2) DOUBLE PRECISION COORDS(NPOINS,NDIM) C C..Variables internes INTEGER N,NUMSOL,NG DOUBLE PRECISION X,Y,Z,XT,YT,ZT,TX,TY,TZ,ARX,ARY,ARZ DOUBLE PRECISION AROTX,AROTY,AROTZ C C*********************************************************************** C C 0- Impression C ============= WRITE(NFECRA,1000) C C 1- CALCUL DES NOUVELLES COORDONNEES APRES ROTATION C ================================================== C DO 100 N=1,NBMOBS C NUMSOL = NMOBIL(N,2) C TX = DEFMOB(NUMSOL,2) TY = DEFMOB(NUMSOL,3) TZ = DEFMOB(NUMSOL,4) ARX = DEFMOB(NUMSOL,5) ARY = DEFMOB(NUMSOL,6) ARZ = DEFMOB(NUMSOL,7) AROTX = DEFMOB(NUMSOL,8) * RDTTS AROTY = DEFMOB(NUMSOL,9) * RDTTS AROTZ = DEFMOB(NUMSOL,10) * RDTTS C NG = NMOBIL(N,1) C X = COORDS(NG,1) Y = COORDS(NG,2) Z = 0. IF (NDIM.EQ.3) Z = COORDS(NG,3) C CALL ROTATS(X,Y,Z,XT,YT,ZT,TX,TY,TZ,ARX,ARY,ARZ, * AROTX,AROTY,AROTZ) C COORDS(NG,1) = XT COORDS(NG,2) = YT IF (NDIM.EQ.3) COORDS(NG,3) = ZT C 100 CONTINUE C C-------- C FORMATS C-------- 1000 FORMAT(' *** MOBROT : Calcul des nouvelles coordonnees') C RETURN END syrthes-3.4.3-dfsg1/src/s/ccondp.F0000666000175000017500000001314011524070645015321 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CCONDP C ***************** C * ( VAL,NREF,NPE,VCOND,NBCOND,NPN,IREF,NB ) C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- CODAGE DES CONDITIONS PHYSIQUES * C DANS LES TABLEAUX ADAPTES * C CAS DES CONDITIONS PAR ELEMENT C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! VAL ! R ! D ! VALEUR DE LA CONDITION A APPLIQUER ! C ! NREF ! TE ! D ! REFERENCES DES NOEUDS OU ELTS SOLIDES ! C ! NPE ! E ! D ! NOMBRE DE NOEUDS OU ELT DU MAILLAGE SOLIDE ! C ! NCOND ! TE ! D ! NUMERO GLOB DES NOEUDS DE CONDITION "COND" ! C ! VCOND ! TR ! M ! VALEUR DE LA CONDITION "COND" ! C ! NBCOND ! E ! D ! NOMBRE DE NOEUDS DE CONDITION "COND" ! C ! IREF ! TE ! D ! REFERENCES SUR LESQUELLES IL FAUT APPLIQUER ! C ! ! ! ! LA CONDITION "COND" ! C ! NB ! E ! D ! NOMBRE DE REFERENCES CONCERNEES ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : LECLIM C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "nlofes.h" #include "xrefer.h" #include "optct.h" C C********************************************************************** C C..Variables externes INTEGER NPE,NBCOND,NB,NPN INTEGER NREF(NPE),IREF(NRFMAX) DOUBLE PRECISION VCOND(NBCOND,NPN),VAL C C..Variables internes INTEGER N,M,N1,NR,NBRE,NUMREF C C********************************************************************** C C 0- Initialisations C ------------------ NBRE = 0 C C 1- Cas ou la condition s'applique sur tous les noeuds C ----------------------------------------------------- C IF (IREF(1) .EQ. -1 ) THEN C DO 110 N=1,NBCOND*NPN VCOND(N,1) = VAL NBRE = NBRE + 1 110 CONTINUE C ELSE C C 2- Application de la condition aux references citees C ---------------------------------------------------- C C DO 200 N1=1,NB C NR = IREF(N1) C DO 210 M=1,NPN DO 211 N=1,NBCOND C NUMREF = NREF(N) C IF (NUMREF .EQ. NR) THEN VCOND(N,M) = VAL NBRE = NBRE + 1 ENDIF C 211 CONTINUE 210 CONTINUE 200 CONTINUE C ENDIF C C C 3- Impressions de controle C -------------------------- C IF (NBLBLA.EQ.10) WRITE(NFECRA,3000) NBRE C C C-------- C FORMATS C-------- 3000 FORMAT(' CCONDI : Nombre de noeuds traites :',I6) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/afectf.F0000666000175000017500000001554411524070645015315 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE AFECTF C ***************** C C ----------------------------------- * (NSF1,NSF2,NSF3,ICFA, * NDIM,NDIELE,NELEMS,NDMATS,NBFACE, * NODES,NREFAC,NPOINS,NREFS) C ----------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C AFFECTATION DES FACES DE TYPE IDEAS * C MISES SUR DEES THIN SHELL * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C NSF1..23 ! ! ! Numero des neuds sommets de la face ! C ! ICFA ! ! ! COULEUR DE LA FACE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEMES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS(2=triangles,3=tetraed)! C ! NREFAC ! TE ! R ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS PAR ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE) INTEGER NPOINS,NREFS(NPOINS) C C.. Variables internes INTEGER I,J INTEGER N1,N2,N3,N4,N5,N6,NR1,NR2,NR3,NR4,NR5,NR6 C C NARE(noeud,arete), NFAC(noeud,face) INTEGER NARE(3,3),NFAC(6,4) C INTEGER OK,NSF1,NSF2,NSF3,ICFA C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,2,3,5,6,7, 1,2,4,5,9,8, 1,3,4,7,10,8, 2,3,4,6,10,9/ C C 1- INITIALISATIONS C ------------------ C C C 2- CAS D'UN MAILLAGE EN TRIANGLES ( a faire au 27/07/01) C ================================= C IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN C DO 200 J=1,NBFACE DO 210 I=1,NELEMS C C Numeros des 3 noeuds de l'arete : 1----3----2 N3 = NODES(I,NARE(3,J)) C IF (NSF3.EQ.N3) NREFAC(I,J) = ICFA C 210 CONTINUE 200 CONTINUE C C C 3- CAS D'UN MAILLAGE EN TETRAEDRES C ================================== C ELSEIF (NDIELE.EQ.3) THEN C DO J=1,NBFACE DO I=1,NELEMS C 3 C / \ C Numeros des 3 noeuds de la face : C / \ C 1----- -----2 N1 = NODES(I,NFAC(1,J)) N2 = NODES(I,NFAC(2,J)) N3 = NODES(I,NFAC(3,J)) C C C Mise en place de la reference de face courante OK = 0 IF (NSF1.EQ.N1.AND.NSF2.EQ.N2.AND.NSF3.EQ.N3) OK = 1 IF (NSF1.EQ.N1.AND.NSF2.EQ.N3.AND.NSF3.EQ.N2) OK = 1 IF (NSF1.EQ.N2.AND.NSF2.EQ.N3.AND.NSF3.EQ.N1) OK = 1 IF (NSF1.EQ.N2.AND.NSF2.EQ.N1.AND.NSF3.EQ.N3) OK = 1 IF (NSF1.EQ.N3.AND.NSF2.EQ.N1.AND.NSF3.EQ.N2) OK = 1 IF (NSF1.EQ.N3.AND.NSF2.EQ.N2.AND.NSF3.EQ.N1) OK = 1 C C Si OK il s'agit effectivement d'une face de bord IF (OK.EQ.1) NREFAC(I,J) = ICFA C ENDDO ENDDO C C ELSE C C 5- CAS D'ERREUR C =============== WRITE(NFECRA,5000) STOP C ENDIF C C-------- C FORMATS C-------- 5000 FORMAT(//,' %% ERREUR AFECFA : ON N''EST DANS AUCUNE DES ', & 'CONFIGURATIONS PREVUES') C END syrthes-3.4.3-dfsg1/src/s/lecme2.F0000666000175000017500000001756011524070645015234 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LECME2 C ***************** C C ---------------------------------------------------------------- *(NDIM,NPOINS,NELEMS,NBFACE,NN,IREF,INOEUD,IFACE,IELT,ITRMED) C ---------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C 1ere LECTURE DU MAILLAGE ELEMENTS FINIS * C --> STRUCTURE DE DONNEE ISSUE DE MED * C (Necessaire pour les dimensionnements de tableaux) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! A ! TR ! A ! TABLEAU DE TRAVAIL REEL ! C ! ILONRA ! E ! D ! DIMENSION DE A ! C ! IA ! TE ! A ! TABLEAUX DE TRAVAIL ENTIER ! C ! ILONIA ! E ! D ! DIMENSION DE IA ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "xrefer.h" #ifdef MED #include "med.hf" #endif C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NPOINS,NELEMS,NBFACE,NN INTEGER IREF(NPOINS),INOEUD(NELEMS*NN),IFACE(NELEMS*NBFACE) INTEGER IELT(NELEMS) CMED20 INTEGER ITRMED(NN,NELEMS) INTEGER ITRMED(NELEMS,NN) C #ifdef MED C.. Variables internes INTEGER I,J,NBFAM,IDIM,IRET,NBATT INTEGER NB,NGRO,NUMFAM,IFAN(NRFMAX),IFAE(NRFMAX),NBIDON CHARACTER*32 NOM,NOMFAM cc CHARACTER*80 GRO(5) LOGICAL LFAE CHARACTER*200 ATDES0(1),ATDES2(4),ATDES3(5) INTEGER ATIDE0(1),ATIDE2(4),ATIDE3(5) INTEGER ATVAL0(1),ATVAL2(4),ATVAL3(5) character*200 attdes(6) character*80 gro(6) integer attval(6),attide(6),natt C C*********************************************************************** C C lecture du nom du maillage CALL EFMAAI(NFSGCT,1,NOM,IDIM,IRET) C C lecture de la connectivite IF (NDIM.EQ.2) THEN CMED20 CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,NELEMS, CMED20 * MED_MAILLE,MED_TRIA6,MED_NOD,IRET) CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,MED_NO_INTERLACE,NBIDON,0, * MED_MAILLE,MED_TRIA6,MED_NOD,IRET) ELSEIF (NDIM.EQ.3) THEN CMED20 CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,NELEMS, CMED20 * MED_MAILLE,MED_TETRA10,MED_NOD,IRET) CALL EFCONL(NFSGCT,NOM,NDIM,ITRMED,MED_NO_INTERLACE,NBIDON,0, * MED_MAILLE,MED_TETRA10,MED_NOD,IRET) ENDIF C DO J=1,NN DO I=1,NELEMS CMED20 INOEUD((J-1)*NELEMS+I)=ITRMED(J,I) INOEUD((J-1)*NELEMS+I)=ITRMED(I,J) ENDDO ENDDO C C lecture des numeros de famille des noeuds CALL EFFAML(NFSGCT,NOM,IREF,NPOINS,MED_NOEUD,0,IRET) C C lecture des numeros de famille des elements IF (NDIM.EQ.2) THEN CALL EFFAML(NFSGCT,NOM,IELT,NELEMS,MED_MAILLE,MED_TRIA6,IRET) ELSEIF (NDIM.EQ.3) THEN CALL EFFAML(NFSGCT,NOM,IELT,NELEMS,MED_MAILLE,MED_TETRA10,IRET) ENDIF C C nombre de familles CALL EFNFAM(NFSGCT,NOM,0,0,NBFAM,IRET) C C C lecture des familles LFAE=.FALSE. DO I=1,NBFAM CALL EFNFAM(NFSGCT,NOM,I,MED_ATTR,NBATT,IRET) IF (NBATT.EQ.1) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE0,ATVAL0,ATDES0,NB,GRO,NGRO,IRET) IF (NUMFAM.GT.0) THEN ! famille de noeud IFAN(NUMFAM)=ATVAL0(1) ELSEIF (NUMFAM.LT.0) THEN ! famille d'element LFAE=.TRUE. IFAE(-NUMFAM)=ATVAL0(1) ENDIF ELSEIF (NBATT.EQ.4) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE2,ATVAL2,ATDES2,NB,GRO,NGRO,IRET) IELT(-NUMFAM)=ATVAL2(1) IFACE(-NUMFAM)=ATVAL2(2) IFACE(NELEMS-NUMFAM)=ATVAL2(3) IFACE(2*NELEMS-NUMFAM)=ATVAL2(4) ELSEIF (NBATT.EQ.5) THEN CALL EFFAMI(NFSGCT,NOM,I,NOMFAM,NUMFAM, * ATIDE3,ATVAL3,ATDES3,NB,GRO,NGRO,IRET) IELT(-NUMFAM)=ATVAL3(1) IFACE(-NUMFAM)=ATVAL3(2) IFACE(NELEMS-NUMFAM)=ATVAL3(3) IFACE(2*NELEMS-NUMFAM)=ATVAL3(4) IFACE(3*NELEMS-NUMFAM)=ATVAL3(5) ENDIF ENDDO C C On remet d'aplomb les references des noeuds DO I=1,NPOINS IREF(I)=IFAN(IREF(I)) ENDDO C C Quand il n'y a pas de references de face on remet d'aplomb C les references des elements IF (LFAE) THEN DO I=1,NELEMS IELT(I)=IFAE(-IELT(I)) ENDDO ENDIF C cc CALL INREFA (NDIM,NDIELE,NELEMS,NBNO,NBFACE,INOEUD,IFACE, cc * NPOINS,IREF) C #endif END syrthes-3.4.3-dfsg1/src/s/cmptfv.F0000666000175000017500000001157411524070645015363 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CMPTFV C ***************** C C ---------------------------------- *(NREFS,NREFE,NPOINS,NELEMS,NBFLVS) C ---------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C COMPTE DES FLUX VOLUMIQUES * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NREFE ! TE ! D ! REFERENCES DES ELEMENTS SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NBFLVS ! E ! R ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "xrefer.h" C C*********************************************************************** C C.. Variables externes INTEGER NPOINS,NELEMS,NREFS(NPOINS),NREFE(NELEMS) INTEGER NBFLVS C C.. Variables internes INTEGER I,NUMREF,N1 C C*********************************************************************** C C 1- INITIALISATIONS C ------------------ C NBFLVS = 0 C IF (NDFLUV.EQ.1) THEN C DO 100 I=1,NPOINS C NUMREF = NREFS(I) IF (NUMREF.NE.0) THEN DO 105 N1=1,NRFMAX C IF (IREFSV(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFLVS = NBFLVS + 1 ENDIF C 105 CONTINUE ENDIF 100 CONTINUE C ELSE C DO 110 I=1,NELEMS C NUMREF = NREFE(I) IF (NUMREF.NE.0) THEN DO 115 N1=1,NRFMAX C IF (IREFSV(N1).NE.0 .AND. NUMREF.EQ.N1) THEN NBFLVS = NBFLVS + 1 ENDIF C 115 CONTINUE ENDIF 110 CONTINUE C ENDIF C END syrthes-3.4.3-dfsg1/src/s/calfdf_3d.c0000666000175000017500000017022711524070645015727 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "tree.h" # include "abs.h" # include "interfaces.h" int ss_tria[4][3] = { {0,3,5}, {1,4,3}, {2,5,4}, {3,4,5} }; int nsp; double taille_boite,taille_seg; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | cfdf3d | | Gestion du calcul des facteurs de forme en dimension 3 | |======================================================================| */ proc(void cfdf3d,void CFDF3D) (int *ndim,int *nelray,int *npoinr,int *nodray, double *cooray,double *sufray,double *fdf, int *nplasy,double *plasym, int *nperay, double *perray,int *ndecoup_max, int *nrfray, double *pvinter,int *numgu,int *ngumax,int *nblblr) { int i,n2; int faces_cachees ; double Pi ; int *nod2,nel2,npoin2; double *coo2,*xnf2,xmult,*xnfray; int *grconv, *grconv2; int imult; dimension_3d(*ndim,*nelray,*npoinr,nodray,cooray, &taille_boite,&taille_seg); imult = 0; xmult = 1.; if(taille_seg < 0.01 || taille_seg > 10) { imult = 1; if (taille_seg < 0.01) xmult = 0.1/taille_seg; if (taille_seg > 10 ) xmult = 1/taille_seg; if(*nblblr >= 10) printf("Facteur multiplicatif interne xmult= %f \n",xmult); for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) *= xmult ; taille_boite *= xmult; taille_seg *= xmult; for(i=0;i<3**ngumax;i++) *(pvinter+i)*=xmult; for(i=0;i<3;i++) *(perray+i)*=xmult; for(i=0;i<*nplasy;i++) plasym[i*4+3]*=xmult; } grconv = (int *)malloc( *nelray * sizeof(int) ); if (grconv==NULL) {printf(" ERREUR cfdf3d : probleme d'allocation memoire\n"); exit(0);} orie3d(nodray,*nelray,*npoinr,nrfray,cooray,pvinter,*numgu,*ndim,*nblblr, grconv); Pi = 3.141592653589793; verif_coor_3d(*ndim,*nelray,*npoinr,nodray,cooray,*nplasy,plasym, *nperay,perray,*nblblr,taille_seg); surface_tria (*nelray,*npoinr,nodray,cooray,sufray); xnfray=(double*)malloc(*nelray * 3 * sizeof(double)); if (xnfray==NULL) {printf(" ERREUR cfdf3d : probleme d'allocation memoire\n"); exit(0);} cnor_3d(*ndim,*nelray,*npoinr,nodray,cooray,xnfray); if (*nplasy != 0 && *nperay == 0) { n2=1; if (*nplasy==1){n2=2;} else if (*nplasy==2){n2=4;} else if (*nplasy==3){n2=8;} nod2=(int*)malloc(n2 * *nelray * 3 * sizeof(int)); coo2=(double*)malloc(n2 * *npoinr * 3 * sizeof(double)); xnf2=(double*)malloc(n2 * *nelray * 3 * sizeof(double)); grconv2=(int*)malloc(n2 * *nelray * sizeof(int)); if (n2==0 || nod2==NULL || coo2==NULL || xnf2==NULL || grconv2==NULL ) {printf(" ERREUR cfdf3d : probleme d'allocation memoire\n"); exit(0);} dupliq3d_sym(*nplasy,plasym, *npoinr,*nelray,nodray,cooray,xnfray, &nel2,&npoin2,nod2,coo2,xnf2,grconv,grconv2); } else if (*nperay > 0) { n2=1; if (*nplasy==0){n2=*nperay;} else if (*nplasy==1){n2=*nperay*2;} else if (*nplasy==2){n2=*nperay*4;} else if (*nplasy==3){n2=*nperay*8;} nod2=(int*)malloc(n2 * *nelray * 3 * sizeof(int)); coo2=(double*)malloc(n2 * *npoinr * 3 * sizeof(double)); xnf2=(double*)malloc(n2 * *nelray * 3 * sizeof(double)); grconv2=(int*)malloc(n2 * *nelray * sizeof(int)); if (n2==0 || nod2==NULL || coo2==NULL || xnf2==NULL || grconv2==NULL ) {printf(" ERREUR cfdf3d : probleme d'allocation memoire\n"); exit(0);} dupliq3d_per(*nplasy,plasym,*nperay,perray, *npoinr,*nelray,nodray,cooray,xnfray, &nel2,&npoin2,nod2,coo2,xnf2,grconv,grconv2); } if ( *nperay == 0 ) { if (*nplasy==0) nsp=1; else if (*nplasy==1) nsp=2; else if (*nplasy==2) nsp=4; else if (*nplasy==3) nsp=8; } else { if (*nplasy==0) nsp=*nperay; else if (*nplasy==1) nsp=*nperay*2; else if (*nplasy==2) nsp=*nperay*4; else if (*nplasy==3) nsp=*nperay*8; } if (*nplasy == 0 && *nperay == 0) facecache_3d(*ndim,*npoinr,*nelray,*nelray,nodray,cooray,xnfray,&faces_cachees, *nplasy,*nperay) ; else facecache_3d(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,&faces_cachees, *nplasy,*nperay) ; if (*nplasy == 0 && *nperay == 0) { coo2=(double*)malloc(*npoinr * 3 * sizeof(double)); if (coo2==NULL) {printf(" ERREUR cfdf3d : probleme d'allocation memoire\n"); exit(0);} for (i=0;i<*npoinr;i++) { *(coo2+i) = *(cooray+i); *(coo2+i+*npoinr) = *(cooray+i+*npoinr); *(coo2+i+*npoinr*2) = *(cooray+i+*npoinr*2); } } if (faces_cachees) { if (*nplasy == 0 && *nperay == 0) { box_3d(*npoinr,coo2); cnor_3d(*ndim,*nelray,*npoinr,nodray,coo2,xnfray); } else { /* box_3d(npoin2,coo2); */ cnor_3d(*ndim,nel2,npoin2,nod2,coo2,xnf2); } } printf("\n *** CFDF3D : calcul des facteurs de forme\n"); if (*nplasy == 0 && *nperay == 0) if (!faces_cachees) facforme_3d(*ndim,*npoinr,*nelray,*nelray,nodray,cooray,xnfray,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv,*nblblr); else facforme_3d(*ndim,*npoinr,*nelray,*nelray,nodray,coo2,xnfray,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv,*nblblr); else facforme_3d(*ndim,npoin2,nel2,*nelray,nod2,coo2,xnf2,fdf,sufray, &faces_cachees,*nplasy,*nperay,*ndecoup_max,grconv2,*nblblr); free(xnfray); if (*nplasy != 0 || *nperay != 0) {free(coo2); free(nod2); free(xnf2);free(grconv2); } if (*nplasy == 0 && *nperay == 0 && faces_cachees) free(coo2); if(imult) { for (i=0;i< *npoinr* *ndim ;i++) *(cooray+i) /= xmult ; xmult *= xmult ; for (i=0;i< *nelray ;i++) *(sufray+i) /= xmult; for (i=0 ; i<*nelray*(*nelray+1)/2 ; i++ ) *(fdf+i) /= xmult; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | facforme_3d | | calcul des facteurs de forme en dimension 3 | |======================================================================| */ void facforme_3d(int ndim, int npoin,int nel2,int nel, int *nod,double *coord,double *xnf,double *fdf,double *sufray, int *faces_cachees,int nplasy,int nperay,int ndecoup_max, int *grconv,int nblblr) { int i,j,k,l,npoin2,id,ns,ideb; int noeud[6],prem,ndecoup; int *voir; int codem10,code0,code1,codem1,code2,codem2,code3,code4,code5,codem5,codem6; int nbfcoplanaire,code_decoupe; double xi[6],yi[6],zi[6],fforme,xp[6],yp[6],zp[6],xq[6],yq[6],zq[6]; double xii[6],yii[6],zii[6],xt[3],yt[3],zt[3],*pland; double xn1,yn1,zn1,x,y,z,size_min,dim_boite[6],dsign[6],xn2,yn2,zn2; double Pi,tiers; struct node *arbre; double xg1,yg1,zg1,xg2,yg2,zg2; double titi1, titi2; int ncomplique,pasok; double total_fac,pourcent,pourcent_ecrit; /* Initialisations --------------- */ Pi = 3.141592653589793; tiers=1./3.; npoin2 = npoin*2; nbfcoplanaire = 0 ; codem10 = 0; code0 = 0; code1 = 0; codem1 = 0; code2 = 0; codem2 = 0; code3 = 0; code4 = 0; code5 = 0; codem5 = 0; codem6 = 0; ncomplique = 0; pland = (double*)malloc( nel2 * sizeof(double)); if (pland==NULL) {printf(" ERREUR facforme_3d : probleme d'allocation memoire\n"); exit(0);} for (i=0 ; i=10) printf(" *** FACFORME_3D : ns=%d facette i=%d \n",ns+1,i+1); pourcent=(ns+1)*i/total_fac; if (pourcent>pourcent_ecrit) { printf(" %5.2f %% du calcul effectue\n",pourcent_ecrit*100); pourcent_ecrit += 0.1; } xn1 = xnf[i]; yn1 = xnf[i+ nel2]; zn1 = xnf[i+ nel2*2]; noeud[0] = nod[i]; noeud[1] = nod[i+ nel2]; noeud[2] = nod[i+ nel2 *2]; for (j=ideb+i ; j-0.1) { nbfcoplanaire += 1; /* printf(" >>> calfdf : %d %d sont coplanaires\n",i+1,j+1);*/ } /* les faces ne sont pas coplanaires */ if (fforme<-1.) { noeud[3] = nod[j]; noeud[4] = nod[j+ nel2]; noeud[5] = nod[j+ nel2*2]; for (k=0;k<6;k++) { xi[k] = coord[noeud[k]-1]; yi[k] = coord[noeud[k]-1+ npoin]; zi[k] = coord[noeud[k]-1+ npoin2]; } fforme=0.; if (!*faces_cachees) proc(contou,CONTOU)(xi,yi,zi,&fforme); else { derriere_3d(nel2,i,j,xnf,pland,xi,yi,zi,dsign,&code_decoupe) ; if (code_decoupe==0) prem=1; else prem=0; fforme=0; ndecoup=0; if (code_decoupe == -10) /* les faces sont derrieres */ { codem10 += 1; fforme = 0; } else if (code_decoupe == 0) /* les faces se voient potentiellement */ { code0 += 1; if (bary_cache_3d(xi,yi,zi,xn1,yn1,zn1)) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } else if (abs(code_decoupe) == 1) /* intersection To-Td ou Td-To */ { if (code_decoupe==1) code1 += 1; else codem1 += 1; decoupe_totd(nel2,i,j,xnf,pland,xi,yi,zi,dsign,code_decoupe); if (code_decoupe==1) pasok=bary_cache_3d(xi,yi,zi,xn1,yn1,zn1); else pasok=bary_cache_3d(xi,yi,zi,xn2,yn2,zn2); if(pasok) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } else if (abs(code_decoupe) == 2 ) /* intersection To-Qd ou Qd-To */ { if (code_decoupe==2) code2 += 1; else codem2 += 1; decoupe_toqd (nel2,i,j,xnf,pland,xi,yi,zi,xp,yp,zp, dsign,code_decoupe); xi[3]=xp[0]; yi[3]=yp[0]; zi[3]=zp[0]; xi[4]=xp[1]; yi[4]=yp[1]; zi[4]=zp[1]; xi[5]=xp[2]; yi[5]=yp[2]; zi[5]=zp[2]; if (code_decoupe==2) pasok=bary_cache_3d(xi,yi,zi,xn1,yn1,zn1); else pasok=bary_cache_3d(xi,yi,zi,xn2,yn2,zn2); if (pasok) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } if (code_decoupe==2) id=0; else id=3; for (k=0;k<3;k++) /* on recharche les xi originaux */ { xi[k] = coord[noeud[k+id]-1]; yi[k] = coord[noeud[k+id]-1+ npoin]; zi[k] = coord[noeud[k+id]-1+ npoin2]; } xi[3]=xp[0]; yi[3]=yp[0]; zi[3]=zp[0]; xi[4]=xp[2]; yi[4]=yp[2]; zi[4]=zp[2]; xi[5]=xp[3]; yi[5]=yp[3]; zi[5]=zp[3]; if (code_decoupe==2) pasok=bary_cache_3d(xi,yi,zi,xn1,yn1,zn1); else pasok=bary_cache_3d(xi,yi,zi,xn2,yn2,zn2); if (pasok) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } else if (code_decoupe == 3) /* intersection Td-Td */ { code3 += 1; decoupe_tdtd (nel2,i,j,xnf,pland,xi,yi,zi, dsign,code_decoupe); if(bary_cache_3d(xi,yi,zi,xn1,yn1,zn1)) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } else if (code_decoupe == 4) /* intersection Qd-Qd */ { code4 += 1; decoupe_qdqd (nel2,i,j,xnf,pland,xi,yi,zi, xp,yp,zp,xq,yq,zq,dsign,code_decoupe); for (k=0;k<2;k++) { xi[0]=xp[0]; yi[0]=yp[0]; zi[0]=zp[0]; xi[1]=xp[1+k]; yi[1]=yp[1+k]; zi[1]=zp[1+k]; xi[2]=xp[2+k]; yi[2]=yp[2+k]; zi[2]=zp[2+k]; for (l=0;l<2;l++) { xi[3]=xq[0]; yi[3]=yq[0]; zi[3]=zq[0]; xi[4]=xq[1+l]; yi[4]=yq[1+l]; zi[4]=zq[1+l]; xi[5]=xq[2+l]; yi[5]=yq[2+l]; zi[5]=zq[2+l]; if(bary_cache_3d(xi,yi,zi,xn1,yn1,zn1)) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } } } else if (abs(code_decoupe) == 5 ) /* intersection Td-Qd */ { if (code_decoupe == 5) code5 += 1; else codem5 += 1; decoupe_tdqd (nel2,i,j,xnf,pland,xi,yi,zi,xt,yt,zt,xp,yp,zp, dsign,code_decoupe); xi[0]=xt[0]; yi[0]=yt[0]; zi[0]=zt[0]; xi[1]=xt[1]; yi[1]=yt[1]; zi[1]=zt[1]; xi[2]=xt[2]; yi[2]=yt[2]; zi[2]=zt[2]; xi[3]=xp[0]; yi[3]=yp[0]; zi[3]=zp[0]; xi[4]=xp[1]; yi[4]=yp[1]; zi[4]=zp[1]; xi[5]=xp[2]; yi[5]=yp[2]; zi[5]=zp[2]; if (code_decoupe == 5) pasok=bary_cache_3d(xi,yi,zi,xn1,yn1,zn1); else pasok=bary_cache_3d(xi,yi,zi,xn2,yn2,zn2); if (pasok) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } xi[0]=xt[0]; yi[0]=yt[0]; zi[0]=zt[0]; xi[1]=xt[1]; yi[1]=yt[1]; zi[1]=zt[1]; xi[2]=xt[2]; yi[2]=yt[2]; zi[2]=zt[2]; xi[3]=xp[0]; yi[3]=yp[0]; zi[3]=zp[0]; xi[4]=xp[2]; yi[4]=yp[2]; zi[4]=zp[2]; xi[5]=xp[3]; yi[5]=yp[3]; zi[5]=zp[3]; if (code_decoupe == 5) pasok=bary_cache_3d(xi,yi,zi,xn1,yn1,zn1); else pasok=bary_cache_3d(xi,yi,zi,xn2,yn2,zn2); if (pasok) fforme=0; else { xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,&prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &ndecoup,&fforme,&ncomplique,ndecoup_max); } } else if ( code_decoupe == -6 ) { codem6 += 1;fforme=0; } } /* else faces_cachees */ } /* if (fforme<-1.) les faces ne sont pas coplanaires */ if(fforme < 0.) { if (nblblr >= 11) printf(" fforme negatif ns%d i %d j %d fdf= %f\n",ns,i+1,j+1,1e6*fforme); } else fdf[i*nel-(i+1)*i/2+j%nel] += fforme; /* titi1 += fforme ;printf(" ns %d i %d,j %d,fforme %f \n",ns,i+1,j+1-ns*nel,1.e6*fforme); */ } /* for (j=ideb+i ; j> facforme_3d : k l intersect %d %d %d\n",ik+1,il+1,intersect); */ } } else for (k=0;k<3;k++) for (l=3;l<6;l++) { intersect=0; ro[0]=xii[k]; ro[1]=yii[k]; ro[2]=zii[k]; pt_arr[0]=xii[l];pt_arr[1]=yii[l]; pt_arr[2]=zii[l]; rd[0]=pt_arr[0]-ro[0]; rd[1]=pt_arr[1]-ro[1]; rd[2]=pt_arr[2]-ro[2]; noeud_dep=arbre; noeud_arr=arbre; find_node_3d (&noeud_dep,ro[0],ro[1],ro[2]); find_node_3d (&noeud_arr,pt_arr[0],pt_arr[1],pt_arr[2]); arrivee = 0; /* printf(" \n noeud depart %d noeud arrivee %d\n",noeud_dep->name,noeud_arr->name); */ ivoitj_3d(arbre,noeud_dep,noeud_arr,ro,rd,pt_arr, &intersect,size_min, nel2,npoin,nod,coord,&arrivee,dim_boite); /* printf(">> facforme_3d (2): k l intersect %d %d %d\n",ik+1,il+1,intersect);*/ if (!intersect) ok += 1; } if ( 0 < ok && ok < 9 && dans_prem) { *ncomplique += 1; ok=0; for (k=0;k<3;k++) for (l=3;l<6;l++) if (vu[k][l-3]==0) { ro[0]=xii[k]; ro[1]=yii[k]; ro[2]=zii[k]; pt_arr[0]=xii[l];pt_arr[1]=yii[l]; pt_arr[2]=zii[l]; rd[0]=pt_arr[0]-ro[0]; rd[1]=pt_arr[1]-ro[1]; rd[2]=pt_arr[2]-ro[2]; noeud_dep=arbre; noeud_arr=arbre; find_node_3d (&noeud_dep,ro[0],ro[1],ro[2]); find_node_3d (&noeud_arr,pt_arr[0],pt_arr[1],pt_arr[2]); arrivee = 0; /* printf(" \n noeud depart %d noeud arrivee %d\n",noeud_dep->name,noeud_arr->name); */ ivoitj_3d(arbre,noeud_dep,noeud_arr,ro,rd,pt_arr, &intersect,size_min, nel2,npoin,nod,coord,&arrivee,dim_boite); /* printf(">> facforme_3d (2): k l intersect %d %d %d\n",ik+1,il+1,intersect);*/ if (!intersect) ok += 1; } } /* printf(">> facforme_3d : ok final =%d\n",ok); */ if (ok!=0) { proc(contou,CONTOU)(xi,yi,zi,&fdf); /* printf(">> facforme_3d : estimation fdf =%f, ok=%d\n",fdf*1.E6,ok); */ if (ok==9) {*fforme += fdf; } /* else if (*ndecoup>=ndecoup_max || fdf=ndecoup_max) { *fforme = *fforme + (fdf*ok/9.); /* if (ok>4) *fforme = *fforme + fdf; */ } else { nd=*ndecoup+1; xp[0]=xi[0]; yp[0]=yi[0]; zp[0]=zi[0]; xp[1]=xi[1]; yp[1]=yi[1]; zp[1]=zi[1]; xp[2]=xi[2]; yp[2]=yi[2]; zp[2]=zi[2]; xp[3]=(xi[0]+xi[1])/2.; yp[3]=(yi[0]+yi[1])/2.;zp[3]=(zi[0]+zi[1])/2.; xp[4]=(xi[2]+xi[1])/2.; yp[4]=(yi[2]+yi[1])/2.;zp[4]=(zi[2]+zi[1])/2.; xp[5]=(xi[0]+xi[2])/2.; yp[5]=(yi[0]+yi[2])/2.;zp[5]=(zi[0]+zi[2])/2.; xq[0]=xi[3]; yq[0]=yi[3]; zq[0]=zi[3]; xq[1]=xi[4]; yq[1]=yi[4]; zq[1]=zi[4]; xq[2]=xi[5]; yq[2]=yi[5]; zq[2]=zi[5]; xq[3]=(xi[3]+xi[4])/2.; yq[3]=(yi[3]+yi[4])/2.;zq[3]=(zi[3]+zi[4])/2.; xq[4]=(xi[5]+xi[4])/2.; yq[4]=(yi[5]+yi[4])/2.;zq[4]=(zi[5]+zi[4])/2.; xq[5]=(xi[3]+xi[5])/2.; yq[5]=(yi[3]+yi[5])/2.;zq[5]=(zi[3]+zi[5])/2.; for (k=0;k<4;k++) for (l=0;l<4;l++) { xi[0]=xp[ss_tria[k][0]]; yi[0]=yp[ss_tria[k][0]]; zi[0]=zp[ss_tria[k][0]]; xi[1]=xp[ss_tria[k][1]]; yi[1]=yp[ss_tria[k][1]]; zi[1]=zp[ss_tria[k][1]]; xi[2]=xp[ss_tria[k][2]]; yi[2]=yp[ss_tria[k][2]]; zi[2]=zp[ss_tria[k][2]]; xi[3]=xq[ss_tria[l][0]]; yi[3]=yq[ss_tria[l][0]]; zi[3]=zq[ss_tria[l][0]]; xi[4]=xq[ss_tria[l][1]]; yi[4]=yq[ss_tria[l][1]]; zi[4]=zq[ss_tria[l][1]]; xi[5]=xq[ss_tria[l][2]]; yi[5]=yq[ss_tria[l][2]]; zi[5]=zq[ss_tria[l][2]]; xg1=(xi[0]+xi[1]+xi[2])*tiers; yg1=(yi[0]+yi[1]+yi[2])*tiers; zg1=(zi[0]+zi[1]+zi[2])*tiers; xg2=(xi[3]+xi[4]+xi[5])*tiers; yg2=(yi[3]+yi[4]+yi[5])*tiers; zg2=(zi[3]+zi[4]+zi[5])*tiers; xii[0]=xi[0]+(xg1-xi[0])*0.001; yii[0]=yi[0]+(yg1-yi[0])*0.001; zii[0]=zi[0]+(zg1-zi[0])*0.001; xii[1]=xi[1]+(xg1-xi[1])*0.001; yii[1]=yi[1]+(yg1-yi[1])*0.001; zii[1]=zi[1]+(zg1-zi[1])*0.001; xii[2]=xi[2]+(xg1-xi[2])*0.001; yii[2]=yi[2]+(yg1-yi[2])*0.001; zii[2]=zi[2]+(zg1-zi[2])*0.001; xii[3]=xi[3]+(xg2-xi[3])*0.001; yii[3]=yi[3]+(yg2-yi[3])*0.001; zii[3]=zi[3]+(zg2-zi[3])*0.001; xii[4]=xi[4]+(xg2-xi[4])*0.001; yii[4]=yi[4]+(yg2-yi[4])*0.001; zii[4]=zi[4]+(zg2-zi[4])*0.001; xii[5]=xi[5]+(xg2-xi[5])*0.001; yii[5]=yi[5]+(yg2-yi[5])*0.001; zii[5]=zi[5]+(zg2-zi[5])*0.001; triafdf (arbre,size_min,dim_boite,prem,xi,yi,zi,xii,yii,zii, noeud,voir,nel2,npoin,nod,coord, &nd,fforme,ncomplique,ndecoup_max); } (*ndecoup)++; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | dupliq3d_per | | Dupliquer le maillage pour le traitement de la periodicite | | avec eventuellement un plan de symetrie orthogonal a l'axe | | definissant la periodicite de rotation | |======================================================================| */ void dupliq3d_per(int nplasy,double *plasym,int nperay,double *perray, int npoinr,int nelray,int *nodray, double *cooray,double *xnfray, int *nel2,int *npoin2,int *nod2,double *coo2,double *xnf2, int *grconv, int *grconv2) { int i,idebnel,idebnp,numper,npersym,inverse; double sa,sb,sc,sd,se,t[4][4],t1[4][4],t2[4][4]; double Pi; double phi,theta,c,s,c2,s2,an,aa,bb,cc,dd,ee,ff,gg,hh,ii; double px,py,pz,ax,ay,az,alfa,angle,eps=1.e-6; Pi = 3.141592653589793; /**nel2 = (int)(nperay*pow(2,nplasy)+0.1)*nelray; *npoin2 = (int)(nperay*pow(2,nplasy)+0.1)*npoinr;*/ if (nplasy==0) { *nel2=nperay*nelray; *npoin2=nperay*npoinr; } else if (nplasy==1) { *nel2=nperay*2*nelray; *npoin2=nperay*2*npoinr; } else if (nplasy==2) { *nel2=nperay*4*nelray; *npoin2=nperay*4*npoinr; } else if (nplasy==3) { *nel2=nperay*8*nelray; *npoin2=nperay*8*npoinr; } for (i=0;i eps) { an = sqrt(ax*ax+ay*ay); phi = atan2(ay,ax); theta = atan2(az,an) ; c = cos(phi) ; s = sin(phi) ; c2 = cos(theta) ; s2 = sin(theta); } else if (abs(ay) > eps) { an = sqrt(ax*ax+ay*ay); theta = atan2(az,an) ; c = 0. ; s = 1. ; c2 = cos(theta) ; s2 = sin(theta) ; } else { c =1 ; s = 0 ; c2 = 0 ; s2 = 1 ; } aa = c2*c ; bb = -c2*s ; cc = s2 ; dd = cos(angle)*s+sin(angle)*s2*c ; ee = cos(angle)*c-sin(angle)*s*s2 ; ff = -sin(angle)*c2 ; gg = sin(angle)*s-cos(angle)*s2*c ; hh = sin(angle)*c+cos(angle)*s*s2 ; ii = cos(angle)*c2 ; t[0][0] = aa*aa+s*dd-c*s2*gg; t[1][1] = -s*c2*bb+c*ee+s*s2*hh; t[2][2] = s2*cc+c2*ii; t[1][0] = -s*c2*aa+c*dd+s*s2*gg; t[0][1] = aa*bb+s*ee-c*s2*hh; t[2][0] = s2*aa+c2*gg; t[0][2] = aa*cc+s*ff-c*s2*ii; t[2][1] = s2*bb+c2*hh; t[1][2] = -s*c2*cc+c*ff+s*s2*ii; t[3][0] = t[3][1] = t[3][2] = 0.; t[0][3]= px ; t[1][3]= py ; t[2][3]= pz ; t[3][3]=1; numper +=1; inverse = 1 ; idebnel = (numper)*nelray; idebnp = (numper)*npoinr; persym3d(t,numper,inverse,npoinr,nelray,nodray,cooray,xnfray, *nel2,*npoin2,nod2,coo2,xnf2,idebnel,idebnp,grconv,grconv2); if (nplasy == 1) { inverse = -1; sa=plasym[0]; sb=plasym[1]; sc=plasym[2]; sd=plasym[3]; se=-2./(sa*sa+sb*sb+sc*sc); t1[0][0] = 1.+ sa*sa*se; t1[1][1] = 1.+ sb*sb*se; t1[2][2] = 1.+ sc*sc*se; t1[0][1] = t1[1][0] = sa*sb*se; t1[0][2] = t1[2][0] = sa*sc*se; t1[1][2] = t1[2][1] = sb*sc*se; t1[0][3] = sa*sd*se; t1[1][3] = sb*sd*se; t1[2][3] = sc*sd*se; t1[3][0]=t1[3][1]=t1[3][2]=0; t1[3][3]=1; t2[0][0]= t[0][0]*t1[0][0]+t[0][1]*t1[1][0]+t[0][2]*t1[2][0]+t[0][3]*t1[3][0]; t2[0][1]= t[0][0]*t1[0][1]+t[0][1]*t1[1][1]+t[0][2]*t1[2][1]+t[0][3]*t1[3][1]; t2[0][2]= t[0][0]*t1[0][2]+t[0][1]*t1[1][2]+t[0][2]*t1[2][2]+t[0][3]*t1[3][2]; t2[0][3]= t[0][0]*t1[0][3]+t[0][1]*t1[1][3]+t[0][2]*t1[2][3]+t[0][3]*t1[3][3]; t2[1][0]= t[1][0]*t1[0][0]+t[1][1]*t1[1][0]+t[1][2]*t1[2][0]+t[1][3]*t1[3][0]; t2[1][1]= t[1][0]*t1[0][1]+t[1][1]*t1[1][1]+t[1][2]*t1[2][1]+t[1][3]*t1[3][1]; t2[1][2]= t[1][0]*t1[0][2]+t[1][1]*t1[1][2]+t[1][2]*t1[2][2]+t[1][3]*t1[3][2]; t2[1][3]= t[1][0]*t1[0][3]+t[1][1]*t1[1][3]+t[1][2]*t1[2][3]+t[1][3]*t1[3][3]; t2[2][0]= t[2][0]*t1[0][0]+t[2][1]*t1[1][0]+t[2][2]*t1[2][0]+t[2][3]*t1[3][0]; t2[2][1]= t[2][0]*t1[0][1]+t[2][1]*t1[1][1]+t[2][2]*t1[2][1]+t[2][3]*t1[3][1]; t2[2][2]= t[2][0]*t1[0][2]+t[2][1]*t1[1][2]+t[2][2]*t1[2][2]+t[2][3]*t1[3][2]; t2[2][3]= t[2][0]*t1[0][3]+t[2][1]*t1[1][3]+t[2][2]*t1[2][3]+t[2][3]*t1[3][3]; t2[3][0]= t[3][0]*t1[0][0]+t[3][1]*t1[1][0]+t[3][2]*t1[2][0]+t[3][3]*t1[3][0]; t2[3][1]= t[3][0]*t1[0][1]+t[3][1]*t1[1][1]+t[3][2]*t1[2][1]+t[3][3]*t1[3][1]; t2[3][2]= t[3][0]*t1[0][2]+t[3][1]*t1[1][2]+t[3][2]*t1[2][2]+t[3][3]*t1[3][2]; t2[3][3]= t[3][0]*t1[0][3]+t[3][1]*t1[1][3]+t[3][2]*t1[2][3]+t[3][3]*t1[3][3]; npersym = numper+nperay ; idebnel = npersym*nelray; idebnp = npersym*npoinr; persym3d(t2,npersym,inverse,npoinr,nelray,nodray,cooray,xnfray, *nel2,*npoin2,nod2,coo2,xnf2,idebnel,idebnp,grconv,grconv2); } } /* impressions de controle */ /* printf(" coordonnees\n "); for (n=0;n<*npoin2;n++) printf(" point %d : %f %f %f \n",n, coo2[n],coo2[n+ *npoin2],coo2[n+ *npoin2*2]); printf(" normale \n"); for (n=0;n<*nel2;n++) printf(" face %d : %f %f %f \n",n, xnf2[n],xnf2[n+ *nel2],xnf2[n+ *nel2*2]); printf(" connectivite \n"); for (n=0;n<*nel2;n++) printf(" face %d : %d %d %d \n",n, nod2[n],nod2[n+ *nel2],nod2[n+ *nel2*2]); */ } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | persym3d | | Calculer le periodique d'un maillage | | et eventuellement son periodique et symetrique | |======================================================================| */ void persym3d(double t[4][4],int numsym,int inverse, int npoinr,int nelray,int *nodray,double *cooray,double *xnfray, int nel2,int npoin2,int *nod2,double *coo2,double *xnf2, int idebnel,int idebnp,int *grconv, int *grconv2) { int n; double x,y,z; for (n=0;n NUM_LOC_COUPLE C =================================================== C DO 200 N=1,NBCOUS ITRAV(NCOUPS(N)) = N 200 CONTINUE C C C 3- TRANSFORMATION DE LA TABLE DES ELEMENTS C ========================================== C DO 300 M=1,NDMASS DO 310 N=1,NELESS NODESS(N,M) = ITRAV (NODESS(N,M)) 310 CONTINUE 300 CONTINUE C C C------- C FORMAT C------- C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/build_quad1d.c0000666000175000017500000002354211524070645016455 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "tree.h" # include "abs.h" # include "interfaces.h" extern int nelvoip; extern int nsp; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | build_quadtree | | Construction du quadtree | |======================================================================| */ void build_quadtree_1d (struct node *arbre, int ndim, int npoinr,int nelray, int *nodray,double *cooray, double *size_min, double dim_boite[]) { struct element *f1,*f2; int i,nbelt; double dx,dy; double xmin,xmax,ymin,ymax; xmin = 1.E10; ymin= 1.E6 ; xmax = -1.E10; ymax= -1.E6 ; for (i=0;iname = 1; */ arbre->xc = (xmin+xmax)*0.5; arbre->yc = (ymin+ymax)*0.5; arbre->sizx = dx*0.5; arbre->sizy = dy*0.5; arbre->lelement = NULL; arbre->lfils = NULL; *size_min = min(dx,dy); f1 = (struct element *)malloc(sizeof(struct element)); if (f1==NULL) {printf(" ERREUR build_octree : probleme d'allocation memoire\n"); exit(0);} f1->num = 1; f1->suivant=NULL; arbre->lelement=f1; for (i=1;inum = i+1; f2->suivant=NULL; f1->suivant = f2; f1 = f2; } nbelt = nelray; decoupe1d(arbre,nodray,cooray,nelray,npoinr,nbelt,size_min); elague_tree(arbre,arbre,4); /* printf("\n\n Arbre apres elaguage\n"); affiche_tree(arbre,4); */ } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe2d | | Construction du quadtree | |======================================================================| */ void decoupe1d(struct node *noeud,int *nodray,double *cooray, int nelray,int npoinr,int nbelt,double *size_min) { double xmin[4],xmax[4],ymin[4],ymax[4]; double x,y,dx,dy ; int i,nbfac,nbelt_max; struct node *n1,*n2,*noeudi; struct child *f1,*f2; struct element *elt1; nbelt_max=max(nelvoip*nsp+10,30); if (nbelt>nbelt_max) { x = noeud->xc; y = noeud->yc; dx = noeud->sizx; dy = noeud->sizy; xmax[0]=xmax[3]= x; xmin[1]=xmin[2]= x; xmin[0]=xmin[3]= x - dx; xmax[1]=xmax[2]= x + dx; ymax[2]=ymax[3]= y; ymin[0]=ymin[1]= y; ymin[2]=ymin[3]= y - dy; ymax[0]=ymax[1]= y + dy; f1= (struct child *)malloc(sizeof(struct child)); n1= (struct node *) malloc(sizeof(struct node )); if (f1==NULL || n1==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} noeud->lfils = f1; /* f1->name = (noeud->name)*10 + 1; */ f1->fils = n1; f1->suivant = NULL; for (i=1;i<4;i++) { f2= (struct child *)malloc(sizeof(struct child)); n2= (struct node *) malloc(sizeof(struct node )); if (f2==NULL || n2==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} f1->suivant = f2; /* f2->name = (noeud->name)*10 + i+1; */ f2->fils = n2; f2->suivant = NULL; f1 = f2; } f1 = noeud->lfils; for (i=0;i<4;i++) { noeudi = f1->fils; /* noeudi->name = (noeud->name)*10 + i+1; */ noeudi->xc = (xmin[i]+xmax[i])*0.5; noeudi->yc = (ymin[i]+ymax[i])*0.5; noeudi->sizx = (xmax[i]-xmin[i])*0.5; noeudi->sizy = (ymax[i]-ymin[i])*0.5; *size_min = min(*size_min,noeudi->sizx); *size_min = min(*size_min,noeudi->sizy); noeudi->lfils = NULL; elt1= (struct element *)malloc(sizeof(struct element)); if (elt1==NULL) {printf(" ERREUR decoupe : probleme d'allocation memoire\n"); exit(0);} noeudi->lelement = elt1; triseg(noeud->lelement,noeudi->lelement, &nbfac,nelray,npoinr,nodray,cooray, noeudi->xc,noeudi->yc,noeudi->sizx,noeudi->sizy); if (nbfac != 0) decoupe1d(noeudi,nodray,cooray,nelray,npoinr,nbfac,size_min); else { noeudi->lelement = NULL; free(elt1); } f1 = f1->suivant; } } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | triseg | | Tri des segments pour les placer dans le quadtree | |======================================================================| */ void triseg( struct element *face_pere, struct element *face_fils, int *nbfac,int nelray,int npoinr,int *nodray,double *cooray, double xcc,double ycc,double dx,double dy) { int n,prem ; double xa,ya,xb,yb; struct element *fp1,*ff1,*ff2; prem = 1; fp1 = face_pere; ff1 = face_fils; *nbfac = 0; do { n = *(nodray+fp1->num-1); xa = *(cooray+n-1); ya = *(cooray+n-1+npoinr); n = *(nodray+fp1->num-1+nelray); xb = *(cooray+n-1); yb = *(cooray+n-1+npoinr); if (seg_in_rectan(xa,ya,xb,yb,xcc,ycc,dx,dy)) { if (prem) { prem = 0; ff1->num = fp1->num; ff1->suivant = NULL; } else { ff2= (struct element *)malloc(sizeof(struct element)); if (ff2==NULL) {printf(" ERREUR triface : probleme d'allocation memoire\n"); exit(0);} ff2->num = fp1->num; ff2->suivant = NULL; ff1->suivant = ff2; ff1 = ff2; } *nbfac += 1; } fp1 = fp1->suivant; }while (fp1 != NULL); } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | tria_in_rectan | | Tri des triangles pour les placer dans le quadtree | |======================================================================| */ int seg_in_rectan(double xa,double ya,double xb,double yb, double xcc,double ycc,double dx,double dy) { double xmin,xmax,ymin,ymax; double d2; double epsi; epsi=1.E-5; d2=dx+dy; xmin = xcc-dx-epsi; xmax = xcc+dx+epsi; ymin = ycc-dy-epsi; ymax = ycc+dy+epsi; if (in_rectan (xa,ya,xmin,xmax,ymin,ymax)) return(1); else if (in_rectan(xb,yb,xmin,xmax,ymin,ymax)) return(1); else if (xa>xmax && xb>xmax) return(0); else if (xaymax && yb>ymax) return(0); else if (yad2 && xb+yb>d2) return(0); else if (xa-ya>-d2 && xb-yb>-d2) return(0); else if (ya-ya=3) ! C ! ! ! ! contient les valeurs des kii sui isotro! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : MATELE C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables internes INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA INTEGER NPOUE,NPPEL,NBPHYS INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION COEFMA(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS),VOLUME(NELEMS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) C C..Variables internes DOUBLE PRECISION ZERO,COEFF,S3,S18,S24 INTEGER I,NCA INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 DOUBLE PRECISION R1,R2,R3 DOUBLE PRECISION AKXX1,AKXX2,AKXX3,AKXX4,AKXX5,AKXX6 DOUBLE PRECISION AKXX7,AKXX8,AKXX9,AKXX10 DOUBLE PRECISION AKYY1,AKYY2,AKYY3,AKYY4,AKYY5,AKYY6 DOUBLE PRECISION AKYY7,AKYY8,AKYY9,AKYY10 DOUBLE PRECISION AKZZ1,AKZZ2,AKZZ3,AKZZ4,AKZZ5,AKZZ6 DOUBLE PRECISION AKZZ7,AKZZ8,AKZZ9,AKZZ10 DOUBLE PRECISION AKXY1,AKXY2,AKXY3,AKXY4,AKXY5,AKXY6 DOUBLE PRECISION AKXY7,AKXY8,AKXY9,AKXY10 DOUBLE PRECISION AKXZ1,AKXZ2,AKXZ3,AKXZ4,AKXZ5,AKXZ6 DOUBLE PRECISION AKXZ7,AKXZ8,AKXZ9,AKXZ10 DOUBLE PRECISION AKYZ1,AKYZ2,AKYZ3,AKYZ4,AKYZ5,AKYZ6 DOUBLE PRECISION AKYZ7,AKYZ8,AKYZ9,AKYZ10 DOUBLE PRECISION X1K11,X1K12,X1K22,X2K11,X2K12,X2K22 DOUBLE PRECISION X3K11,X3K12,X3K22,X4K11,X4K12,X4K22 DOUBLE PRECISION X5K11,X5K12,X5K22,X6K11,X6K12,X6K22 DOUBLE PRECISION X7K11,X7K12,X7K22,X8K11,X8K12,X8K22 DOUBLE PRECISION X1K13,X1K23,X1K33,X2K13,X2K23,X2K33 DOUBLE PRECISION X3K13,X3K23,X3K33,X4K13,X4K23,X4K33 DOUBLE PRECISION X5K13,X5K23,X5K33,X6K13,X6K23,X6K33 DOUBLE PRECISION X7K13,X7K23,X7K33,X8K13,X8K23,X8K33 DOUBLE PRECISION DX1,DX2,DX3,DX4,DY1,DY2,DY3,DY4 DOUBLE PRECISION DZ1,DZ2,DZ3,DZ4 DOUBLE PRECISION X75,Y75,Z75,X78,Y78,Z78 DOUBLE PRECISION X69,Y69,Z69,X65,Y65,Z65 DOUBLE PRECISION X710,Y710,Z710,X76,Y76,Z76 DOUBLE PRECISION X810,Y810,Z810,X89,Y89,Z89 DOUBLE PRECISION AKXXE,AKYYE,AKZZE,AKXYE,AKXZE,AKYZE C LOGICAL LVERIF C*********************************************************************** C C INITIALISATIONS C ================ C LVERIF = .FALSE. ZERO = 0.D0 S3 = 1.D0 / 3.D0 S18 = 1.D0 / 18.D0 S24 = 1.D0 / 24.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C C C 1- CAS BIDIMENSIONNEL C ====================== C IF ( NDIM . EQ . 2 ) THEN C C 1.1 CAS BIDIMENSIONNEL CARTESIEN C -------------------------------- C IF (IAXISY.EQ.0) THEN C C DO 110 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) C AKXY1 = PHYSOL(N1,1,5) AKXY2 = PHYSOL(N2,1,5) AKXY3 = PHYSOL(N3,1,5) AKXY4 = PHYSOL(N4,1,5) AKXY5 = PHYSOL(N5,1,5) AKXY6 = PHYSOL(N6,1,5) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) AKXYE = PHYSOL(I,1,5) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE C AKXY1 = AKXYE AKXY2 = AKXYE AKXY3 = AKXYE AKXY4 = AKXYE AKXY5 = AKXYE AKXY6 = AKXYE C ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) C AKXY1 = PHYSOL(I,1,5) AKXY2 = PHYSOL(I,2,5) AKXY3 = PHYSOL(I,3,5) AKXY4 = PHYSOL(I,4,5) AKXY5 = PHYSOL(I,5,5) AKXY6 = PHYSOL(I,6,5) ENDIF C C C X1K11 = AKXX1 + AKXX4 + AKXX6 X1K12 = AKXY1 + AKXY4 + AKXY6 X1K22 = AKYY1 + AKYY4 + AKYY6 X2K11 = AKXX2 + AKXX4 + AKXX5 X2K12 = AKXY2 + AKXY4 + AKXY5 X2K22 = AKYY2 + AKYY4 + AKYY5 X3K11 = AKXX3 + AKXX5 + AKXX6 X3K12 = AKXY3 + AKXY5 + AKXY6 X3K22 = AKYY3 + AKYY5 + AKYY6 X4K11 = AKXX4 + AKXX5 + AKXX6 X4K12 = AKXY4 + AKXY5 + AKXY6 X4K22 = AKYY4 + AKYY5 + AKYY6 C C DX1 = - (COORDS(N6,2)-COORDS(N4,2)) DY1 = (COORDS(N6,1)-COORDS(N4,1)) C DX2 = - (COORDS(N4,2)-COORDS(N5,2)) DY2 = (COORDS(N4,1)-COORDS(N5,1)) C DX3 = - (COORDS(N5,2)-COORDS(N6,2)) DY3 = (COORDS(N5,1)-COORDS(N6,1)) C C Calcul des termes diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ COEFF = S3 / VOLUME(I) C WCT(I,1) = COEFF*(DX1**2*X1K11+2*DY1*DX1*X1K12+DY1**2*X1K22) WCT(I,2) = COEFF*(DX2**2*X2K11+2*DY2*DX2*X2K12+DY2**2*X2K22) WCT(I,3) = COEFF*(DX3**2*X3K11+2*DY3*DX3*X3K12+DY3**2*X3K22) WCT(I,4) = COEFF*(DX2**2*X1K11+2*DY2*DX2*X1K12+DY2**2*X1K22+DX1** &2*X2K11+2*DY1*DX1*X2K12+DY1**2*X2K22+DX3**2*X4K11+2*DY3*DX3*X4K12+ &DY3**2*X4K22) WCT(I,5) = COEFF*(DX3**2*X2K11+2*DY3*DX3*X2K12+DY3**2*X2K22+DX2** &2*X3K11+2*DY2*DX2*X3K12+DY2**2*X3K22+DX1**2*X4K11+2*DY1*DX1*X4K12+ &DY1**2*X4K22) WCT(I,6) = COEFF*(DX3**2*X1K11+2*DY3*DX3*X1K12+DY3**2*X1K22+DX1** &2*X3K11+2*DY1*DX1*X3K12+DY1**2*X3K22+DX2**2*X4K11+2*DY2*DX2*X4K12+ &DY2**2*X4K22) C C Calcul des termes extra-diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C XMAT(I,1) = COEFF*(DX1*DX2*X1K11+DY1*DX2*X1K12+DX1*DY2*X1K12+DY1*D &Y2*X1K22) XMAT(I,2) = COEFF*(DX1*DX3*X1K11+DY1*DX3*X1K12+DX1*DY3*X1K12+DY1*D &Y3*X1K22) C XMAT(I,3) = COEFF*(DX2*DX1*X2K11+DY2*DX1*X2K12+DX2*DY1*X2K12+DY2*D &Y1*X2K22) XMAT(I,4) = COEFF*(DX2*DX3*X2K11+DY2*DX3*X2K12+DX2*DY3*X2K12+DY2*D &Y3*X2K22) C XMAT(I,5) = COEFF*(DX3*DX2*X3K11+DY3*DX2*X3K12+DX3*DY2*X3K12+DY3*D &Y2*X3K22) XMAT(I,6) = COEFF*(DX3*DX1*X3K11+DY3*DX1*X3K12+DX3*DY1*X3K12+DY3*D &Y1*X3K22) C XMAT(I,7) = COEFF*(DX1*DX3*X2K11+DY1*DX3*X2K12+DX1*DY3*X2K12+DY1*D &Y3*X2K22+DX3*DX1*X4K11+DY3*DX1*X4K12+DX3*DY1*X4K12+DY3*DY1*X4K22) XMAT(I,8) = COEFF*(DX2*DX3*X1K11+DY2*DX3*X1K12+DX2*DY3*X1K12+DY2*D &Y3*X1K22+DX3*DX2*X4K11+DY3*DX2*X4K12+DX3*DY2*X4K12+DY3*DY2*X4K22) C XMAT(I,9) = COEFF*(DX2*DX1*X3K11+DY2*DX1*X3K12+DX2*DY1*X3K12+DY2*D &Y1*X3K22+DX1*DX2*X4K11+DY1*DX2*X4K12+DX1*DY2*X4K12+DY1*DY2*X4K22) C 110 CONTINUE C C 1.2- CAS AXISYMETRIQUE (DONC 2D) C -------------------------------- ELSE C DO 120 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C COEFF = S24 / VOLUME(I) C R1 = COEFF * ABS(COORDS(N1,NCA)) R2 = COEFF * ABS(COORDS(N2,NCA)) R3 = COEFF * ABS(COORDS(N3,NCA)) C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) C AKXY1 = PHYSOL(N1,1,5) AKXY2 = PHYSOL(N2,1,5) AKXY3 = PHYSOL(N3,1,5) AKXY4 = PHYSOL(N4,1,5) AKXY5 = PHYSOL(N5,1,5) AKXY6 = PHYSOL(N6,1,5) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) AKXYE = PHYSOL(I,1,5) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE C AKXY1 = AKXYE AKXY2 = AKXYE AKXY3 = AKXYE AKXY4 = AKXYE AKXY5 = AKXYE AKXY6 = AKXYE C ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) C AKXY1 = PHYSOL(I,1,5) AKXY2 = PHYSOL(I,2,5) AKXY3 = PHYSOL(I,3,5) AKXY4 = PHYSOL(I,4,5) AKXY5 = PHYSOL(I,5,5) AKXY6 = PHYSOL(I,6,5) ENDIF C C X1K11 = AKXX1*(6*R1+R2+R3) + AKXX4*(5*R1+2*R2+R3) & + AKXX6*(5*R1+R2+2*R3) X1K12 = AKXY1*(6*R1+R2+R3) + AKXY4*(5*R1+2*R2+R3) & + AKXY6*(5*R1+R2+2*R3) X1K22 = AKYY1*(6*R1+R2+R3) + AKYY4*(5*R1+2*R2+R3) & + AKYY6*(5*R1+R2+2*R3) C X2K11 = AKXX2*(R1+6*R2+R3) + AKXX4*(2*R1+5*R2+R3) & + AKXX5*(R1+5*R2+2*R3) X2K12 = AKXY2*(R1+6*R2+R3) + AKXY4*(2*R1+5*R2+R3) & + AKXY5*(R1+5*R2+2*R3) X2K22 = AKYY2*(R1+6*R2+R3) + AKYY4*(2*R1+5*R2+R3) & + AKYY5*(R1+5*R2+2*R3) C X3K11 = AKXX3*(R1+R2+6*R3) + AKXX5*(R1+2*R2+5*R3) & + AKXX6*(2*R1+R2+5*R3) X3K12 = AKXY3*(R1+R2+6*R3) + AKXY5*(R1+2*R2+5*R3) & + AKXY6*(2*R1+R2+5*R3) X3K22 = AKYY3*(R1+R2+6*R3) + AKYY5*(R1+2*R2+5*R3) & + AKYY6*(2*R1+R2+5*R3) C X4K11 = AKXX4*(3*R1+3*R2+2*R3) + AKXX5*(2*R1+3*R2+3*R3) & + AKXX6*(3*R1+2*R2+3*R3) X4K12 = AKXY4*(3*R1+3*R2+2*R3) + AKXY5*(2*R1+3*R2+3*R3) & + AKXY6*(3*R1+2*R2+3*R3) X4K22 = AKYY4*(3*R1+3*R2+2*R3) + AKYY5*(2*R1+3*R2+3*R3) & + AKYY6*(3*R1+2*R2+3*R3) C DX1 = - (COORDS(N6,2)-COORDS(N4,2)) DY1 = (COORDS(N6,1)-COORDS(N4,1)) C DX2 = - (COORDS(N4,2)-COORDS(N5,2)) DY2 = (COORDS(N4,1)-COORDS(N5,1)) C DX3 = - (COORDS(N5,2)-COORDS(N6,2)) DY3 = (COORDS(N5,1)-COORDS(N6,1)) C C Calcul des termes diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ C WCT(I,1) = (DX1**2*X1K11+2*DY1*DX1*X1K12+DY1**2*X1K22) WCT(I,2) = (DX2**2*X2K11+2*DY2*DX2*X2K12+DY2**2*X2K22) WCT(I,3) = (DX3**2*X3K11+2*DY3*DX3*X3K12+DY3**2*X3K22) WCT(I,4) = (DX2**2*X1K11+2*DY2*DX2*X1K12+DY2**2*X1K22+DX1** &2*X2K11+2*DY1*DX1*X2K12+DY1**2*X2K22+DX3**2*X4K11+2*DY3*DX3*X4K12+ &DY3**2*X4K22) WCT(I,5) = (DX3**2*X2K11+2*DY3*DX3*X2K12+DY3**2*X2K22+DX2** &2*X3K11+2*DY2*DX2*X3K12+DY2**2*X3K22+DX1**2*X4K11+2*DY1*DX1*X4K12+ &DY1**2*X4K22) WCT(I,6) = (DX3**2*X1K11+2*DY3*DX3*X1K12+DY3**2*X1K22+DX1** &2*X3K11+2*DY1*DX1*X3K12+DY1**2*X3K22+DX2**2*X4K11+2*DY2*DX2*X4K12+ &DY2**2*X4K22) C C Calcul des termes extra-diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C XMAT(I,1) = (DX1*DX2*X1K11+DY1*DX2*X1K12+DX1*DY2*X1K12+DY1*D &Y2*X1K22) XMAT(I,2) = (DX1*DX3*X1K11+DY1*DX3*X1K12+DX1*DY3*X1K12+DY1*D &Y3*X1K22) C XMAT(I,3) = (DX2*DX1*X2K11+DY2*DX1*X2K12+DX2*DY1*X2K12+DY2*D &Y1*X2K22) XMAT(I,4) = (DX2*DX3*X2K11+DY2*DX3*X2K12+DX2*DY3*X2K12+DY2*D &Y3*X2K22) C XMAT(I,5) = (DX3*DX2*X3K11+DY3*DX2*X3K12+DX3*DY2*X3K12+DY3*D &Y2*X3K22) XMAT(I,6) = (DX3*DX1*X3K11+DY3*DX1*X3K12+DX3*DY1*X3K12+DY3*D &Y1*X3K22) C XMAT(I,7) = (DX1*DX3*X2K11+DY1*DX3*X2K12+DX1*DY3*X2K12+DY1*D &Y3*X2K22+DX3*DX1*X4K11+DY3*DX1*X4K12+DX3*DY1*X4K12+DY3*DY1*X4K22) XMAT(I,8) = (DX2*DX3*X1K11+DY2*DX3*X1K12+DX2*DY3*X1K12+DY2*D &Y3*X1K22+DX3*DX2*X4K11+DY3*DX2*X4K12+DX3*DY2*X4K12+DY3*DY2*X4K22) C XMAT(I,9) = (DX2*DX1*X3K11+DY2*DX1*X3K12+DX2*DY1*X3K12+DY2*D &Y1*X3K22+DX1*DX2*X4K11+DY1*DX2*X4K12+DX1*DY2*X4K12+DY1*DY2*X4K22) C C 120 CONTINUE C C ENDIF C C C C C 2- CAS TRIDIMENSIONNEL C ====================== ELSE C DO 200 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10 = NODES(I,10) C IF(NDPROP.EQ.1) THEN AKXX1 = PHYSOL(N1,1,3) AKXX2 = PHYSOL(N2,1,3) AKXX3 = PHYSOL(N3,1,3) AKXX4 = PHYSOL(N4,1,3) AKXX5 = PHYSOL(N5,1,3) AKXX6 = PHYSOL(N6,1,3) AKXX7 = PHYSOL(N7,1,3) AKXX8 = PHYSOL(N8,1,3) AKXX9 = PHYSOL(N9,1,3) AKXX10 = PHYSOL(N10,1,3) C AKYY1 = PHYSOL(N1,1,4) AKYY2 = PHYSOL(N2,1,4) AKYY3 = PHYSOL(N3,1,4) AKYY4 = PHYSOL(N4,1,4) AKYY5 = PHYSOL(N5,1,4) AKYY6 = PHYSOL(N6,1,4) AKYY7 = PHYSOL(N7,1,4) AKYY8 = PHYSOL(N8,1,4) AKYY9 = PHYSOL(N9,1,4) AKYY10 = PHYSOL(N10,1,4) C AKZZ1 = PHYSOL(N1,1,5) AKZZ2 = PHYSOL(N2,1,5) AKZZ3 = PHYSOL(N3,1,5) AKZZ4 = PHYSOL(N4,1,5) AKZZ5 = PHYSOL(N5,1,5) AKZZ6 = PHYSOL(N6,1,5) AKZZ7 = PHYSOL(N7,1,5) AKZZ8 = PHYSOL(N8,1,5) AKZZ9 = PHYSOL(N9,1,5) AKZZ10 = PHYSOL(N10,1,5) C AKXY1 = PHYSOL(N1,1,6) AKXY2 = PHYSOL(N2,1,6) AKXY3 = PHYSOL(N3,1,6) AKXY4 = PHYSOL(N4,1,6) AKXY5 = PHYSOL(N5,1,6) AKXY6 = PHYSOL(N6,1,6) AKXY7 = PHYSOL(N7,1,6) AKXY8 = PHYSOL(N8,1,6) AKXY9 = PHYSOL(N9,1,6) AKXY10 = PHYSOL(N10,1,6) C AKXZ1 = PHYSOL(N1,1,7) AKXZ2 = PHYSOL(N2,1,7) AKXZ3 = PHYSOL(N3,1,7) AKXZ4 = PHYSOL(N4,1,7) AKXZ5 = PHYSOL(N5,1,7) AKXZ6 = PHYSOL(N6,1,7) AKXZ7 = PHYSOL(N7,1,7) AKXZ8 = PHYSOL(N8,1,7) AKXZ9 = PHYSOL(N9,1,7) AKXZ10 = PHYSOL(N10,1,7) C AKYZ1 = PHYSOL(N1,1,8) AKYZ2 = PHYSOL(N2,1,8) AKYZ3 = PHYSOL(N3,1,8) AKYZ4 = PHYSOL(N4,1,8) AKYZ5 = PHYSOL(N5,1,8) AKYZ6 = PHYSOL(N6,1,8) AKYZ7 = PHYSOL(N7,1,8) AKYZ8 = PHYSOL(N8,1,8) AKYZ9 = PHYSOL(N9,1,8) AKYZ10 = PHYSOL(N10,1,8) C ELSEIF(NDPROP.EQ.2) THEN AKXXE = PHYSOL(I,1,3) AKYYE = PHYSOL(I,1,4) AKZZE = PHYSOL(I,1,5) AKXYE = PHYSOL(I,1,6) AKXZE = PHYSOL(I,1,7) AKYZE = PHYSOL(I,1,8) C AKXX1 = AKXXE AKXX2 = AKXXE AKXX3 = AKXXE AKXX4 = AKXXE AKXX5 = AKXXE AKXX6 = AKXXE AKXX7 = AKXXE AKXX8 = AKXXE AKXX9 = AKXXE AKXX10 = AKXXE C AKYY1 = AKYYE AKYY2 = AKYYE AKYY3 = AKYYE AKYY4 = AKYYE AKYY5 = AKYYE AKYY6 = AKYYE AKYY7 = AKYYE AKYY8 = AKYYE AKYY9 = AKYYE AKYY10 = AKYYE C AKZZ1 = AKZZE AKZZ2 = AKZZE AKZZ3 = AKZZE AKZZ4 = AKZZE AKZZ5 = AKZZE AKZZ6 = AKZZE AKZZ7 = AKZZE AKZZ8 = AKZZE AKZZ9 = AKZZE AKZZ10 = AKZZE C AKXY1 = AKXYE AKXY2 = AKXYE AKXY3 = AKXYE AKXY4 = AKXYE AKXY5 = AKXYE AKXY6 = AKXYE AKXY7 = AKXYE AKXY8 = AKXYE AKXY9 = AKXYE AKXY10 = AKXYE C AKXZ1 = AKXZE AKXZ2 = AKXZE AKXZ3 = AKXZE AKXZ4 = AKXZE AKXZ5 = AKXZE AKXZ6 = AKXZE AKXZ7 = AKXZE AKXZ8 = AKXZE AKXZ9 = AKXZE AKXZ10 = AKXZE C AKYZ1 = AKYZE AKYZ2 = AKYZE AKYZ3 = AKYZE AKYZ4 = AKYZE AKYZ5 = AKYZE AKYZ6 = AKYZE AKYZ7 = AKYZE AKYZ8 = AKYZE AKYZ9 = AKYZE AKYZ10 = AKYZE ELSE AKXX1 = PHYSOL(I,1,3) AKXX2 = PHYSOL(I,2,3) AKXX3 = PHYSOL(I,3,3) AKXX4 = PHYSOL(I,4,3) AKXX5 = PHYSOL(I,5,3) AKXX6 = PHYSOL(I,6,3) AKXX7 = PHYSOL(I,7,3) AKXX8 = PHYSOL(I,8,3) AKXX9 = PHYSOL(I,9,3) AKXX10 = PHYSOL(I,10,3) C AKYY1 = PHYSOL(I,1,4) AKYY2 = PHYSOL(I,2,4) AKYY3 = PHYSOL(I,3,4) AKYY4 = PHYSOL(I,4,4) AKYY5 = PHYSOL(I,5,4) AKYY6 = PHYSOL(I,6,4) AKYY7 = PHYSOL(I,7,4) AKYY8 = PHYSOL(I,8,4) AKYY9 = PHYSOL(I,9,4) AKYY10 = PHYSOL(I,10,4) C AKZZ1 = PHYSOL(I,1,5) AKZZ2 = PHYSOL(I,2,5) AKZZ3 = PHYSOL(I,3,5) AKZZ4 = PHYSOL(I,4,5) AKZZ5 = PHYSOL(I,5,5) AKZZ6 = PHYSOL(I,6,5) AKZZ7 = PHYSOL(I,7,5) AKZZ8 = PHYSOL(I,8,5) AKZZ9 = PHYSOL(I,9,5) AKZZ10 = PHYSOL(I,10,5) C AKXY1 = PHYSOL(I,1,6) AKXY2 = PHYSOL(I,2,6) AKXY3 = PHYSOL(I,3,6) AKXY4 = PHYSOL(I,4,6) AKXY5 = PHYSOL(I,5,6) AKXY6 = PHYSOL(I,6,6) AKXY7 = PHYSOL(I,7,6) AKXY8 = PHYSOL(I,8,6) AKXY9 = PHYSOL(I,9,6) AKXY10 = PHYSOL(I,10,6) C AKXZ1 = PHYSOL(I,1,7) AKXZ2 = PHYSOL(I,2,7) AKXZ3 = PHYSOL(I,3,7) AKXZ4 = PHYSOL(I,4,7) AKXZ5 = PHYSOL(I,5,7) AKXZ6 = PHYSOL(I,6,7) AKXZ7 = PHYSOL(I,7,7) AKXZ8 = PHYSOL(I,8,7) AKXZ9 = PHYSOL(I,9,7) AKXZ10 = PHYSOL(I,10,7) C AKYZ1 = PHYSOL(I,1,8) AKYZ2 = PHYSOL(I,2,8) AKYZ3 = PHYSOL(I,3,8) AKYZ4 = PHYSOL(I,4,8) AKYZ5 = PHYSOL(I,5,8) AKYZ6 = PHYSOL(I,6,8) AKYZ7 = PHYSOL(I,7,8) AKYZ8 = PHYSOL(I,8,8) AKYZ9 = PHYSOL(I,9,8) AKYZ10 = PHYSOL(I,10,8) ENDIF C C X1K11 = AKXX1 + AKXX5 + AKXX7 + AKXX8 X1K12 = AKXY1 + AKXY5 + AKXY7 + AKXY8 X1K13 = AKXZ1 + AKXZ5 + AKXZ7 + AKXZ8 X1K22 = AKYY1 + AKYY5 + AKYY7 + AKYY8 X1K23 = AKYZ1 + AKYZ5 + AKYZ7 + AKYZ8 X1K33 = AKZZ1 + AKZZ5 + AKZZ7 + AKZZ8 C X2K11 = AKXX2 + AKXX5 + AKXX6 + AKXX9 X2K12 = AKXY2 + AKXY5 + AKXY6 + AKXY9 X2K13 = AKXZ2 + AKXZ5 + AKXZ6 + AKXZ9 X2K22 = AKYY2 + AKYY5 + AKYY6 + AKYY9 X2K23 = AKYZ2 + AKYZ5 + AKYZ6 + AKYZ9 X2K33 = AKZZ2 + AKZZ5 + AKZZ6 + AKZZ9 C X3K11 = AKXX3 + AKXX6 + AKXX7 + AKXX10 X3K12 = AKXY3 + AKXY6 + AKXY7 + AKXY10 X3K13 = AKXZ3 + AKXZ6 + AKXZ7 + AKXZ10 X3K22 = AKYY3 + AKYY6 + AKYY7 + AKYY10 X3K23 = AKYZ3 + AKYZ6 + AKYZ7 + AKYZ10 X3K33 = AKZZ3 + AKZZ6 + AKZZ7 + AKZZ10 C X4K11 = AKXX4 + AKXX8 + AKXX9 + AKXX10 X4K12 = AKXY4 + AKXY8 + AKXY9 + AKXY10 X4K13 = AKXZ4 + AKXZ8 + AKXZ9 + AKXZ10 X4K22 = AKYY4 + AKYY8 + AKYY9 + AKYY10 X4K23 = AKYZ4 + AKYZ8 + AKYZ9 + AKYZ10 X4K33 = AKZZ4 + AKZZ8 + AKZZ9 + AKZZ10 C X5K11 = AKXX5 + AKXX6 + AKXX7 + AKXX8 X5K12 = AKXY5 + AKXY6 + AKXY7 + AKXY8 X5K13 = AKXZ5 + AKXZ6 + AKXZ7 + AKXZ8 X5K22 = AKYY5 + AKYY6 + AKYY7 + AKYY8 X5K23 = AKYZ5 + AKYZ6 + AKYZ7 + AKYZ8 X5K33 = AKZZ5 + AKZZ6 + AKZZ7 + AKZZ8 C X6K11 = AKXX5 + AKXX6 + AKXX8 + AKXX9 X6K12 = AKXY5 + AKXY6 + AKXY8 + AKXY9 X6K13 = AKXZ5 + AKXZ6 + AKXZ8 + AKXZ9 X6K22 = AKYY5 + AKYY6 + AKYY8 + AKYY9 X6K23 = AKYZ5 + AKYZ6 + AKYZ8 + AKYZ9 X6K33 = AKZZ5 + AKZZ6 + AKZZ8 + AKZZ9 C X7K11 = AKXX6 + AKXX7 + AKXX8 + AKXX10 X7K12 = AKXY6 + AKXY7 + AKXY8 + AKXY10 X7K13 = AKXZ6 + AKXZ7 + AKXZ8 + AKXZ10 X7K22 = AKYY6 + AKYY7 + AKYY8 + AKYY10 X7K23 = AKYZ6 + AKYZ7 + AKYZ8 + AKYZ10 X7K33 = AKZZ6 + AKZZ7 + AKZZ8 + AKZZ10 C X8K11 = AKXX6 + AKXX8 + AKXX9 + AKXX10 X8K12 = AKXY6 + AKXY8 + AKXY9 + AKXY10 X8K13 = AKXZ6 + AKXZ8 + AKXZ9 + AKXZ10 X8K22 = AKYY6 + AKYY8 + AKYY9 + AKYY10 X8K23 = AKYZ6 + AKYZ8 + AKYZ9 + AKYZ10 X8K33 = AKZZ6 + AKZZ8 + AKZZ9 + AKZZ10 C COEFF = S18 / VOLUME(I) C X75 = COORDS(N5,1) - COORDS(N7,1) Y75 = COORDS(N5,2) - COORDS(N7,2) Z75 = COORDS(N5,3) - COORDS(N7,3) C X78 = COORDS(N8,1) - COORDS(N7,1) Y78 = COORDS(N8,2) - COORDS(N7,2) Z78 = COORDS(N8,3) - COORDS(N7,3) C X69 = COORDS(N9,1) - COORDS(N6,1) Y69 = COORDS(N9,2) - COORDS(N6,2) Z69 = COORDS(N9,3) - COORDS(N6,3) C X65 = COORDS(N5,1) - COORDS(N6,1) Y65 = COORDS(N5,2) - COORDS(N6,2) Z65 = COORDS(N5,3) - COORDS(N6,3) C X710= COORDS(N10,1) - COORDS(N7,1) Y710= COORDS(N10,2) - COORDS(N7,2) Z710= COORDS(N10,3) - COORDS(N7,3) C X76 = COORDS(N6,1) - COORDS(N7,1) Y76 = COORDS(N6,2) - COORDS(N7,2) Z76 = COORDS(N6,3) - COORDS(N7,3) C X89 = COORDS(N9,1) - COORDS(N8,1) Y89 = COORDS(N9,2) - COORDS(N8,2) Z89 = COORDS(N9,3) - COORDS(N8,3) C X810= COORDS(N10,1) - COORDS(N8,1) Y810= COORDS(N10,2) - COORDS(N8,2) Z810= COORDS(N10,3) - COORDS(N8,3) C DX1 = (Y75*Z78 - Z75*Y78) DY1 = - (X75*Z78 - Z75*X78) DZ1 = (X75*Y78 - Y75*X78) C DX2 = (Y69*Z65 - Z69*Y65) DY2 = - (X69*Z65 - Z69*X65) DZ2 = (X69*Y65 - Y69*X65) C DX3 = (Y710*Z76 - Z710*Y76) DY3 = - (X710*Z76 - Z710*X76) DZ3 = (X710*Y76 - Y710*X76) C DX4 = (Y89*Z810 - Z89*Y810) DY4 = - (X89*Z810 - Z89*X810) DZ4 = (X89*Y810 - Y89*X810) C C C C Calcul des termes diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~ C WCT(I,1) = COEFF*(DX1**2*X1K11+2*DY1*DX1*X1K12+2*DZ1*DX1*X1K13+DY &1**2*X1K22+2*DZ1*DY1*X1K23+DZ1**2*X1K33) WCT(I,2) = COEFF*(DX2**2*X2K11+2*DY2*DX2*X2K12+2*DZ2*DX2*X2K13+DY &2**2*X2K22+2*DZ2*DY2*X2K23+DZ2**2*X2K33) WCT(I,3) = COEFF*(DX3**2*X3K11+2*DY3*DX3*X3K12+2*DZ3*DX3*X3K13+DY &3**2*X3K22+2*DZ3*DY3*X3K23+DZ3**2*X3K33) WCT(I,4) = COEFF*(DX4**2*X4K11+2*DY4*DX4*X4K12+2*DZ4*DX4*X4K13+DY &4**2*X4K22+2*DZ4*DY4*X4K23+DZ4**2*X4K33) WCT(I,5) = COEFF*(DX2**2*X1K11+2*DY2*DX2*X1K12+2*DZ2*DX2*X1K13+DY &2**2*X1K22+2*DZ2*DY2*X1K23+DZ2**2*X1K33+DX1**2*X2K11+2*DY1*DX1*X2K &12+2*DZ1*DX1*X2K13+DY1**2*X2K22+2*DZ1*DY1*X2K23+DZ1**2*X2K33+(DX1+ &DX2)**2*X5K11+2*(DY1+DY2)*(DX1+DX2)*X5K12+2*(DZ1+DZ2)*(DX1+DX2)*X5 &K13+(DY1+DY2)**2*X5K22+2*(DZ1+DZ2)*(DY1+DY2)*X5K23+(DZ1+DZ2)**2*X5 &K33+(DX1+DX2)**2*X6K11+2*(DY1+DY2)*(DX1+DX2)*X6K12+2*(DZ1+DZ2)*(DX &1+DX2)*X6K13+(DY1+DY2)**2*X6K22+2*(DZ1+DZ2)*(DY1+DY2)*X6K23+(DZ1+D &Z2)**2*X6K33) WCT(I,6) = COEFF*(2*DZ2*DX2*X3K13+DZ3**2*X6K33+2*DZ3*DY3*X6K23+DY &3**2*X6K22+2*DZ3*DX3*X6K13+2*DY3*DX3*X6K12+DX3**2*X6K11+2*DZ3*DX3* &X2K13+DX2**2*X7K11+2*DY2*DX2*X7K12+2*DZ2*DX2*X7K13+DY2**2*X7K22+2* &DZ2*DY2*X7K23+DZ2**2*X7K33+2*DZ4*DY4*X8K23+DZ4**2*X8K33+DX4**2*X8K &11+2*DY4*DX4*X8K12+2*DZ4*DX4*X8K13+DY4**2*X8K22+DX3**2*X2K11+2*DY3 &*DX3*X2K12+DY3**2*X2K22+2*DZ3*DY3*X2K23+DZ3**2*X2K33+DX2**2*X3K11+ &2*DY2*DX2*X3K12+DY2**2*X3K22+2*DZ2*DY2*X3K23+DZ2**2*X3K33+DX1**2*X &5K11+2*DY1*DX1*X5K12+2*DZ1*DX1*X5K13+DY1**2*X5K22+2*DZ1*DY1*X5K23+ &DZ1**2*X5K33) WCT(I,7) = COEFF*(DX3**2*X1K11+2*DY3*DX3*X1K12+2*DZ3*DX3*X1K13+DY &3**2*X1K22+2*DZ3*DY3*X1K23+DZ3**2*X1K33+DX1**2*X3K11+2*DY1*DX1*X3K &12+2*DZ1*DX1*X3K13+DY1**2*X3K22+2*DZ1*DY1*X3K23+DZ1**2*X3K33+(-DX2 &-DX4)**2*X5K11+2*(-DY2-DY4)*(-DX2-DX4)*X5K12+2*(-DZ2-DZ4)*(-DX2-DX &4)*X5K13+(-DY2-DY4)**2*X5K22+2*(-DZ2-DZ4)*(-DY2-DY4)*X5K23+(-DZ2-D &Z4)**2*X5K33+(-DX2-DX4)**2*X7K11+2*(-DY2-DY4)*(-DX2-DX4)*X7K12+2*( &-DZ2-DZ4)*(-DX2-DX4)*X7K13+(-DY2-DY4)**2*X7K22+2*(-DZ2-DZ4)*(-DY2- &DY4)*X7K23+(-DZ2-DZ4)**2*X7K33) WCT(I,8) = COEFF*(DZ4**2*X5K33+DY1**2*X8K22+2*DY4*DX4*X1K12+DX4** &2*X1K11+2*DZ4*DX4*X1K13+DY4**2*X1K22+2*DZ4*DY4*X1K23+DZ4**2*X1K33+ &DZ3**2*X7K33+DX3**2*X7K11+2*DY3*DX3*X7K12+2*DZ3*DX3*X7K13+DY3**2*X &7K22+2*DZ3*DY3*X7K23+2*DY2*DX2*X6K12+2*DZ2*DX2*X6K13+DX2**2*X6K11+ &DY2**2*X6K22+DX1**2*X8K11+2*DY1*DX1*X8K12+2*DZ1*DX1*X8K13+DZ1**2*X &8K33+2*DZ1*DY1*X8K23+DZ2**2*X6K33+2*DZ2*DY2*X6K23+DX1**2*X4K11+2*D &Y1*DX1*X4K12+2*DZ1*DX1*X4K13+DY1**2*X4K22+2*DZ1*DY1*X4K23+DZ1**2*X &4K33+DX4**2*X5K11+2*DY4*DX4*X5K12+2*DZ4*DX4*X5K13+DY4**2*X5K22+2*D &Z4*DY4*X5K23) WCT(I,9) = COEFF*(DX4**2*X2K11+2*DY4*DX4*X2K12+2*DZ4*DX4*X2K13+DY &4**2*X2K22+2*DZ4*DY4*X2K23+DZ4**2*X2K33+DX2**2*X4K11+2*DY2*DX2*X4K &12+2*DZ2*DX2*X4K13+DY2**2*X4K22+2*DZ2*DY2*X4K23+DZ2**2*X4K33+(-DX1 &-DX3)**2*X6K11+2*(-DY1-DY3)*(-DX1-DX3)*X6K12+2*(-DZ1-DZ3)*(-DX1-DX &3)*X6K13+(-DY1-DY3)**2*X6K22+2*(-DZ1-DZ3)*(-DY1-DY3)*X6K23+(-DZ1-D &Z3)**2*X6K33+(-DX1-DX3)**2*X8K11+2*(-DY1-DY3)*(-DX1-DX3)*X8K12+2*( &-DZ1-DZ3)*(-DX1-DX3)*X8K13+(-DY1-DY3)**2*X8K22+2*(-DZ1-DZ3)*(-DY1- &DY3)*X8K23+(-DZ1-DZ3)**2*X8K33) WCT(I,10) = COEFF*(DX4**2*X3K11+2*DY4*DX4*X3K12+2*DZ4*DX4*X3K13+ &DY4**2*X3K22+2*DZ4*DY4*X3K23+DZ4**2*X3K33+DX3**2*X4K11+2*DY3*DX3*X &4K12+2*DZ3*DX3*X4K13+DY3**2*X4K22+2*DZ3*DY3*X4K23+DZ3**2*X4K33+(DX &3+DX4)**2*X7K11+2*(DY3+DY4)*(DX3+DX4)*X7K12+2*(DZ3+DZ4)*(DX3+DX4)* &X7K13+(DY3+DY4)**2*X7K22+2*(DZ3+DZ4)*(DY3+DY4)*X7K23+(DZ3+DZ4)**2* &X7K33+(DX3+DX4)**2*X8K11+2*(DY3+DY4)*(DX3+DX4)*X8K12+2*(DZ3+DZ4)*( &DX3+DX4)*X8K13+(DY3+DY4)**2*X8K22+2*(DZ3+DZ4)*(DY3+DY4)*X8K23+(DZ3 &+DZ4)**2*X8K33) C C Calcul des termes extra-diagonaux C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C XMAT(I,1) = COEFF*(DX1*DX2*X1K11+DY1*DX2*X1K12+DZ1*DX2*X1K13+DX1*D &Y2*X1K12+DY1*DY2*X1K22+DZ1*DY2*X1K23+DX1*DZ2*X1K13+DY1*DZ2*X1K23+D &Z1*DZ2*X1K33) XMAT(I,2) = COEFF*(DX1*DX3*X1K11+DY1*DX3*X1K12+DZ1*DX3*X1K13+DX1*D &Y3*X1K12+DY1*DY3*X1K22+DZ1*DY3*X1K23+DX1*DZ3*X1K13+DY1*DZ3*X1K23+D &Z1*DZ3*X1K33) XMAT(I,3) = COEFF*(DX1*DX4*X1K11+DY1*DX4*X1K12+DZ1*DX4*X1K13+DX1*D &Y4*X1K12+DY1*DY4*X1K22+DZ1*DY4*X1K23+DX1*DZ4*X1K13+DY1*DZ4*X1K23+D &Z1*DZ4*X1K33) C XMAT(I,4) = COEFF*(DX2*DX1*X2K11+DY2*DX1*X2K12+DZ2*DX1*X2K13+DX2*D &Y1*X2K12+DY2*DY1*X2K22+DZ2*DY1*X2K23+DX2*DZ1*X2K13+DY2*DZ1*X2K23+D &Z2*DZ1*X2K33) XMAT(I,5) = COEFF*(DX2*DX3*X2K11+DY2*DX3*X2K12+DZ2*DX3*X2K13+DX2*D &Y3*X2K12+DY2*DY3*X2K22+DZ2*DY3*X2K23+DX2*DZ3*X2K13+DY2*DZ3*X2K23+D &Z2*DZ3*X2K33) XMAT(I,6) = COEFF*(DX2*DX4*X2K11+DY2*DX4*X2K12+DZ2*DX4*X2K13+DX2*D &Y4*X2K12+DY2*DY4*X2K22+DZ2*DY4*X2K23+DX2*DZ4*X2K13+DY2*DZ4*X2K23+D &Z2*DZ4*X2K33) C XMAT(I,7) = COEFF*(DX3*DX2*X3K11+DY3*DX2*X3K12+DZ3*DX2*X3K13+DX3*D &Y2*X3K12+DY3*DY2*X3K22+DZ3*DY2*X3K23+DX3*DZ2*X3K13+DY3*DZ2*X3K23+D &Z3*DZ2*X3K33) XMAT(I,8) = COEFF*(DX3*DX1*X3K11+DY3*DX1*X3K12+DZ3*DX1*X3K13+DX3*D &Y1*X3K12+DY3*DY1*X3K22+DZ3*DY1*X3K23+DX3*DZ1*X3K13+DY3*DZ1*X3K23+D &Z3*DZ1*X3K33) XMAT(I,9) = COEFF*(DX3*DX4*X3K11+DY3*DX4*X3K12+DZ3*DX4*X3K13+DX3* &DY4*X3K12+DY3*DY4*X3K22+DZ3*DY4*X3K23+DX3*DZ4*X3K13+DY3*DZ4*X3K23+ &DZ3*DZ4*X3K33) C XMAT(I,10) =COEFF*(DX4*DX1*X4K11+DY4*DX1*X4K12+DZ4*DX1*X4K13+DX4*D &Y1*X4K12+DY4*DY1*X4K22+DZ4*DY1*X4K23+DX4*DZ1*X4K13+DY4*DZ1*X4K23+D &Z4*DZ1*X4K33) XMAT(I,11) =COEFF*(DX4*DX2*X4K11+DY4*DX2*X4K12+DZ4*DX2*X4K13+DX4*D &Y2*X4K12+DY4*DY2*X4K22+DZ4*DY2*X4K23+DX4*DZ2*X4K13+DY4*DZ2*X4K23+D &Z4*DZ2*X4K33) XMAT(I,12) =COEFF*(DX4*DX3*X4K11+DY4*DX3*X4K12+DZ4*DX3*X4K13+DX4* &DY3*X4K12+DY4*DY3*X4K22+DZ4*DY3*X4K23+DX4*DZ3*X4K13+DY4*DZ3*X4K23+ &DZ4*DZ3*X4K33) C XMAT(I,13) =COEFF*((DY1+DY2)*DZ3*X6K23+DY1*DZ3*X2K23+DX1*DX3*X2K11 &+(DX1+DX2)*DY3*X6K12+(DX1+DX2)*DX3*X6K11+(DZ1+DZ2)*DY3*X6K23+DY1*D &X3*X2K12+DX1*DY3*X2K12+(DZ1+DZ2)*DX3*X6K13+DZ1*DX3*X2K13+DY1*DY3*X &2K22+DZ1*DY3*X2K23+DX1*DZ3*X2K13+DZ1*DZ3*X2K33-(DX1+DX2)*DX1*X5K11 &-(DY1+DY2)*DX1*X5K12-(DZ1+DZ2)*DX1*X5K13-(DX1+DX2)*DY1*X5K12-(DY1+ &DY2)*DY1*X5K22-(DZ1+DZ2)*DY1*X5K23-(DX1+DX2)*DZ1*X5K13-(DY1+DY2)*D &Z1*X5K23-(DZ1+DZ2)*DZ1*X5K33+(DY1+DY2)*DX3*X6K12+(DY1+DY2)*DY3*X6K &22+(DX1+DX2)*DZ3*X6K13+(DZ1+DZ2)*DZ3*X6K33) XMAT(I,14) =COEFF*(DX2*DX3*X1K11+DY2*DX3*X1K12+DZ2*DX3*X1K13+DX2*D &Y3*X1K12+DY2*DY3*X1K22+DZ2*DY3*X1K23+DX2*DZ3*X1K13+DY2*DZ3*X1K23+D &Z2*DZ3*X1K33+(DX1+DX2)*(-DX2-DX4)*X5K11+(DY1+DY2)*(-DX2-DX4)*X5K12 &+(DZ1+DZ2)*(-DX2-DX4)*X5K13+(DX1+DX2)*(-DY2-DY4)*X5K12+(DY1+DY2)*( &-DY2-DY4)*X5K22+(DZ1+DZ2)*(-DY2-DY4)*X5K23+(DX1+DX2)*(-DZ2-DZ4)*X5 &K13+(DY1+DY2)*(-DZ2-DZ4)*X5K23+(DZ1+DZ2)*(-DZ2-DZ4)*X5K33) XMAT(I,15) =COEFF*(DX2*DY4*X1K12+DX2*DZ4*X1K13+DY2*DY4*X1K22+DY2*D &Z4*X1K23+(DX1+DX2)*DZ4*X5K13+(DX1+DX2)*DY4*X5K12-(DY1+DY2)*DY2*X6K &22+DY2*DX4*X1K12+DX2*DX4*X1K11+DZ2*DX4*X1K13+DZ2*DY4*X1K23+DZ2*DZ4 &*X1K33+(DX1+DX2)*DX4*X5K11+(DY1+DY2)*DX4*X5K12+(DZ1+DZ2)*DX4*X5K13 &+(DY1+DY2)*DY4*X5K22+(DZ1+DZ2)*DY4*X5K23+(DY1+DY2)*DZ4*X5K23+(DZ1+ &DZ2)*DZ4*X5K33-(DX1+DX2)*DX2*X6K11-(DY1+DY2)*DX2*X6K12-(DZ1+DZ2)*D &X2*X6K13-(DX1+DX2)*DY2*X6K12-(DZ1+DZ2)*DY2*X6K23-(DX1+DX2)*DZ2*X6K &13-(DY1+DY2)*DZ2*X6K23-(DZ1+DZ2)*DZ2*X6K33) XMAT(I,16) =COEFF*(DX1*DX4*X2K11+DY1*DX4*X2K12+DZ1*DX4*X2K13+DX1*D &Y4*X2K12+DY1*DY4*X2K22+DZ1*DY4*X2K23+DX1*DZ4*X2K13+DY1*DZ4*X2K23+D &Z1*DZ4*X2K33+(DX1+DX2)*(-DX1-DX3)*X6K11+(DY1+DY2)*(-DX1-DX3)*X6K12 &+(DZ1+DZ2)*(-DX1-DX3)*X6K13+(DX1+DX2)*(-DY1-DY3)*X6K12+(DY1+DY2)*( &-DY1-DY3)*X6K22+(DZ1+DZ2)*(-DY1-DY3)*X6K23+(DX1+DX2)*(-DZ1-DZ3)*X6 &K13+(DY1+DY2)*(-DZ1-DZ3)*X6K23+(DZ1+DZ2)*(-DZ1-DZ3)*X6K33) C XMAT(I,17) =COEFF*(DZ2*(-DY2-DY4)*X7K23+DY2*DZ1*X3K23+DZ2*DX1*X3K1 &3+DX2*DY1*X3K12+DZ2*(-DZ2-DZ4)*X7K33+DX2*(-DX2-DX4)*X7K11+DY2*(-DX &2-DX4)*X7K12+DZ2*(-DX2-DX4)*X7K13+DX2*(-DY2-DY4)*X7K12+DY2*(-DY2-D &Y4)*X7K22+DX2*(-DZ2-DZ4)*X7K13+DY2*(-DZ2-DZ4)*X7K23+DX2*DX1*X3K11+ &DY2*DX1*X3K12+DY2*DY1*X3K22+DZ2*DY1*X3K23+DX2*DZ1*X3K13+DZ2*DZ1*X3 &K33-DX1*(-DX2-DX4)*X5K11-DY1*(-DX2-DX4)*X5K12-DZ1*(-DX2-DX4)*X5K13 &-DX1*(-DY2-DY4)*X5K12-DY1*(-DY2-DY4)*X5K22-DZ1*(-DY2-DY4)*X5K23-DX &1*(-DZ2-DZ4)*X5K13-DY1*(-DZ2-DZ4)*X5K23-DZ1*(-DZ2-DZ4)*X5K33) XMAT(I,18) =COEFF*(-DY3*DY2*X6K22-DX3*DY2*X6K12-DZ3*DX2*X6K13-DY3* &DX2*X6K12-DX3*DX2*X6K11-DZ3*DY2*X6K23-DZ3*DZ2*X6K33-DY3*DZ2*X6K23- &DX2*DX3*X7K11-DY2*DX3*X7K12-DZ2*DX3*X7K13-DX2*DY3*X7K12-DY2*DY3*X7 &K22-DZ2*DY3*X7K23-DX2*DZ3*X7K13-DY2*DZ3*X7K23-DZ2*DZ3*X7K33-DX3*DZ &2*X6K13-DX4*DX1*X8K11-DY4*DX1*X8K12-DZ4*DX1*X8K13-DX4*DY1*X8K12-DY &4*DY1*X8K22-DZ4*DY1*X8K23-DX4*DZ1*X8K13-DY4*DZ1*X8K23-DZ4*DZ1*X8K3 &3-DX1*DX4*X5K11-DY1*DX4*X5K12-DZ1*DX4*X5K13-DX1*DY4*X5K12-DY1*DY4* &X5K22-DZ1*DY4*X5K23-DX1*DZ4*X5K13-DY1*DZ4*X5K23-DZ1*DZ4*X5K33) XMAT(I,19) =COEFF*(DZ3*DX4*X2K13+DX3*DZ4*X2K13+DX3*DY4*X2K12+DX3*( &-DY1-DY3)*X6K12+DZ3*(-DX1-DX3)*X6K13-DX4*(-DX1-DX3)*X8K11-DY4*(-DX &1-DX3)*X8K12-DZ4*(-DX1-DX3)*X8K13-DX4*(-DY1-DY3)*X8K12-DY4*(-DY1-D &Y3)*X8K22-DZ4*(-DY1-DY3)*X8K23-DX4*(-DZ1-DZ3)*X8K13-DY4*(-DZ1-DZ3) &*X8K23-DZ4*(-DZ1-DZ3)*X8K33+DX3*DX4*X2K11+DY3*DX4*X2K12+DY3*(-DX1- &DX3)*X6K12+DY3*DY4*X2K22+DZ3*DY4*X2K23+DY3*DZ4*X2K23+DZ3*DZ4*X2K33 &+DX3*(-DX1-DX3)*X6K11+DY3*(-DZ1-DZ3)*X6K23+DX3*(-DZ1-DZ3)*X6K13+DZ &3*(-DY1-DY3)*X6K23+DY3*(-DY1-DY3)*X6K22+DZ3*(-DZ1-DZ3)*X6K33) XMAT(I,20) = COEFF*(DZ2*DZ4*X3K33+DZ2*DX4*X3K13+DX2*(DX3+DX4)*X7K1 &1+DY2*(DX3+DX4)*X7K12+DZ2*(DX3+DX4)*X7K13+DX2*(DY3+DY4)*X7K12+DY2* &(DY3+DY4)*X7K22+DZ2*(DY3+DY4)*X7K23+DX2*(DZ3+DZ4)*X7K13+DY2*(DZ3+D &Z4)*X7K23+DZ2*(DZ3+DZ4)*X7K33-DX4*(DX3+DX4)*X8K11-DY4*(DX3+DX4)*X8 &K12-DZ4*(DX3+DX4)*X8K13-DX4*(DY3+DY4)*X8K12-DY4*(DY3+DY4)*X8K22-DZ &4*(DY3+DY4)*X8K23-DX4*(DZ3+DZ4)*X8K13-DY4*(DZ3+DZ4)*X8K23-DZ4*(DZ3 &+DZ4)*X8K33+DX2*DX4*X3K11+DY2*DX4*X3K12+DX2*DY4*X3K12+DY2*DY4*X3K2 &2+DZ2*DY4*X3K23+DX2*DZ4*X3K13+DY2*DZ4*X3K23) C XMAT(I,21) =COEFF*(DX3*DX4*X1K11+(-DY2-DY4)*DZ4*X5K23+(-DZ2-DZ4)*D &Y4*X5K23+(-DY2-DY4)*DX4*X5K12+DY3*DZ4*X1K23+DX3*DY4*X1K12+DZ3*DX4* &X1K13+(-DX2-DX4)*DX4*X5K11+(-DZ2-DZ4)*DZ4*X5K33+(-DZ2-DZ4)*DX4*X5K &13+DY3*DX4*X1K12-(-DX2-DX4)*DX3*X7K11-(-DY2-DY4)*DX3*X7K12-(-DZ2-D &Z4)*DX3*X7K13-(-DX2-DX4)*DY3*X7K12-(-DY2-DY4)*DY3*X7K22-(-DZ2-DZ4) &*DY3*X7K23-(-DX2-DX4)*DZ3*X7K13-(-DY2-DY4)*DZ3*X7K23-(-DZ2-DZ4)*DZ &3*X7K33+DY3*DY4*X1K22+DZ3*DY4*X1K23+DX3*DZ4*X1K13+DZ3*DZ4*X1K33+(- &DX2-DX4)*DY4*X5K12+(-DY2-DY4)*DY4*X5K22+(-DX2-DX4)*DZ4*X5K13) XMAT(I,22) = COEFF*(DX1*DX4*X3K11+DY1*DX4*X3K12+DZ1*DX4*X3K13+DX1* &DY4*X3K12+DY1*DY4*X3K22+DZ1*DY4*X3K23+DX1*DZ4*X3K13+DY1*DZ4*X3K23+ &DZ1*DZ4*X3K33+(-DX2-DX4)*(DX3+DX4)*X7K11+(-DY2-DY4)*(DX3+DX4)*X7K1 &2+(-DZ2-DZ4)*(DX3+DX4)*X7K13+(-DX2-DX4)*(DY3+DY4)*X7K12+(-DY2-DY4) &*(DY3+DY4)*X7K22+(-DZ2-DZ4)*(DY3+DY4)*X7K23+(-DX2-DX4)*(DZ3+DZ4)*X &7K13+(-DY2-DY4)*(DZ3+DZ4)*X7K23+(-DZ2-DZ4)*(DZ3+DZ4)*X7K33) C XMAT(I,23) =COEFF*(DY1*(-DY1-DY3)*X8K22+DY1*(-DZ1-DZ3)*X8K23+DX1*( &-DY1-DY3)*X8K12+DX1*DZ2*X4K13+DZ1*DZ2*X4K33+DX1*DX2*X4K11-DX2*(-DX &1-DX3)*X6K11-DY2*(-DX1-DX3)*X6K12-DZ2*(-DX1-DX3)*X6K13+DX1*(-DX1-D &X3)*X8K11+DY1*(-DX1-DX3)*X8K12+DZ1*(-DX1-DX3)*X8K13+DZ1*(-DY1-DY3) &*X8K23+DX1*(-DZ1-DZ3)*X8K13+DZ1*(-DZ1-DZ3)*X8K33-DX2*(-DY1-DY3)*X6 &K12-DY2*(-DY1-DY3)*X6K22-DZ2*(-DY1-DY3)*X6K23+DY1*DX2*X4K12+DZ1*DX &2*X4K13+DX1*DY2*X4K12+DY1*DY2*X4K22+DZ1*DY2*X4K23+DY1*DZ2*X4K23-DY &2*(-DZ1-DZ3)*X6K23-DZ2*(-DZ1-DZ3)*X6K33-DX2*(-DZ1-DZ3)*X6K13) XMAT(I,24) = COEFF*(DZ1*DY3*X4K23+DY1*DY3*X4K22+DZ1*(DZ3+DZ4)*X8K3 &3-DX3*(DX3+DX4)*X7K11-DY3*(DX3+DX4)*X7K12-DZ3*(DX3+DX4)*X7K13-DX3* &(DY3+DY4)*X7K12-DY3*(DY3+DY4)*X7K22-DZ3*(DY3+DY4)*X7K23-DX3*(DZ3+D &Z4)*X7K13-DY3*(DZ3+DZ4)*X7K23-DZ3*(DZ3+DZ4)*X7K33+DX1*(DX3+DX4)*X8 &K11+DY1*(DX3+DX4)*X8K12+DZ1*(DX3+DX4)*X8K13+DX1*(DY3+DY4)*X8K12+DY &1*(DY3+DY4)*X8K22+DZ1*(DY3+DY4)*X8K23+DX1*(DZ3+DZ4)*X8K13+DY1*(DZ3 &+DZ4)*X8K23+DX1*DX3*X4K11+DY1*DX3*X4K12+DZ1*DX3*X4K13+DX1*DY3*X4K1 &2+DX1*DZ3*X4K13+DY1*DZ3*X4K23+DZ1*DZ3*X4K33) C XMAT(I,25) = COEFF*(DX2*DX3*X4K11+DY2*DX3*X4K12+DZ2*DX3*X4K13+DX2* &DY3*X4K12+DY2*DY3*X4K22+DZ2*DY3*X4K23+DX2*DZ3*X4K13+DY2*DZ3*X4K23+ &DZ2*DZ3*X4K33+(-DX1-DX3)*(DX3+DX4)*X8K11+(-DY1-DY3)*(DX3+DX4)*X8K1 &2+(-DZ1-DZ3)*(DX3+DX4)*X8K13+(-DX1-DX3)*(DY3+DY4)*X8K12+(-DY1-DY3) &*(DY3+DY4)*X8K22+(-DZ1-DZ3)*(DY3+DY4)*X8K23+(-DX1-DX3)*(DZ3+DZ4)*X &8K13+(-DY1-DY3)*(DZ3+DZ4)*X8K23+(-DZ1-DZ3)*(DZ3+DZ4)*X8K33) C 200 CONTINUE C ENDIF C C------- C FORMAT C------- C C END syrthes-3.4.3-dfsg1/src/s/corper.F0000666000175000017500000001653411524070645015357 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=CORPER,SSI=0 C SUBROUTINE CORPER C ***************** C * (NDIM,NPOINS,NBPRIO,NBCOPR,NPRIOS,NPER1,NPER2, * COORDS,XTR,YTR,ZTR) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C RECHERCHE DES CORRESPONDANTS * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS ! C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/NLOFES/! ! D ! ! C !/XREFER/! ! D ! ! C !__________________________________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : -- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : IPERIO C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "nlofes.h" #include "xrefer.h" C C********************************************************************** C INTEGER NNX PARAMETER (NNX=8) C C..Variables externes INTEGER NDIM,NPOINS,NBPRIO,NBCOPR,NPRIOS(NBPRIO,1+NBCOPR) INTEGER NPER1(NPOINS),NPER2(NPOINS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION XTR(NPOINS),YTR(NPOINS),ZTR(NPOINS) C C..Variables internes INTEGER N,M,NLMIN,NC,NNL(NNX) DOUBLE PRECISION DMIN,DMAX,X1,Y1,Z1,X2,Y2,Z2,D2 LOGICAL ERR DOUBLE PRECISION EPSMAC C C********************************************************************** C C 0- Initialisations C ================== DMAX = 0. EPSMAC = 1.E-30 ERR = .FALSE. C DO 10 N=1,NBPRIO X2 = ABS(COORDS(NPRIOS(N,1),1)) Y2 = ABS(COORDS(NPRIOS(N,1),2)) IF (NDIM .EQ. 3) Z2 = ABS(COORDS(NPRIOS(N,1),3)) IF (X2 .LT. EPSMAC) X2 = 0.D0 IF (Y2 .LT. EPSMAC) Y2 = 0.D0 IF (NDIM .EQ. 3 .AND. Z2 .LT. EPSMAC) Z2 = 0.D0 10 CONTINUE C C DO 100 N=1,NBPRIO C IF (NPER1(N).NE.0) THEN C DMIN = 1.E6 NLMIN = 0 X1 = XTR(NPRIOS(N,1)) Y1 = YTR(NPRIOS(N,1)) IF (NDIM.EQ.3) Z1 = ZTR(NPRIOS(N,1)) C DO 110 M = 1,NBPRIO IF (NPER2(M).NE.0) THEN X2 = COORDS(NPRIOS(M,1),1) Y2 = COORDS(NPRIOS(M,1),2) IF (NDIM.EQ.3) Z2 = COORDS(NPRIOS(M,1),3) D2 = (X2-X1)*(X2-X1) + (Y2-Y1)*(Y2-Y1) IF (NDIM.EQ.3) D2 = D2 + (Z2-Z1)*(Z2-Z1) IF (D2.LT.DMIN) THEN DMIN = D2 NLMIN = M ENDIF ENDIF 110 CONTINUE C IF (NLMIN.NE.0 .AND. NBCOPR.EQ.1) THEN NPRIOS(N,2) = NLMIN NPRIOS(NLMIN,2) = N ELSEIF (NLMIN.NE.0) THEN NC = 1 120 NC = NC + 1 IF (NPRIOS(N,NC).NE.0) GOTO 120 IF (NC.GT.NBCOPR+1) THEN WRITE(NFECRA,1001) N,NPRIOS(N,1) ERR = .TRUE. ELSE NPRIOS(N,NC) = NLMIN ENDIF NC = 1 130 NC = NC + 1 IF (NPRIOS(NLMIN,NC).NE.0) GOTO 130 IF (NC.GT.NBCOPR+1) THEN WRITE(NFECRA,1001) NLMIN,NPRIOS(NLMIN,1) ERR = .TRUE. ELSE NPRIOS(NLMIN,NC) = N ENDIF ELSE WRITE(NFECRA,1002) N,NPRIOS(N,1) ERR = .TRUE. ENDIF IF (DMIN.GT.DMAX) DMAX = DMIN C ENDIF C 100 CONTINUE C C 2- Impressions C -------------- IF (NBLBLA.GE.10) THEN WRITE(NFECRA,2000) DO 200 N=1,NBPRIO DO 210 M=1,NBCOPR NNL(M) = NPRIOS(N,M+1) IF (NNL(M).GT.0) NNL(M) = NPRIOS(NNL(M),1) 210 CONTINUE WRITE(NFECRA,2001) N,NPRIOS(N,1), & (NNL(M),M=1,NBCOPR) 200 CONTINUE ENDIF C IF (NBLBLA.GT.0) WRITE(NFECRA,2010) DMAX C C 3- Arret en erreur C ------------------ IF (ERR) STOP C C-------- C FORMATS C-------- 1001 FORMAT(/,' %% ERREUR CORPER : Le nombre maxi de correspondants', & ' pour un noeud est depasse',/, & ' pour le noeud ',I6,' de numero global ',I6) 1002 FORMAT(/,' %% ERREUR CORPER : On n''a pas trouve de correspondant' & ,' pour le noeud periodique : ',I6,/, & ' de numero global : ',I6 ) 2000 FORMAT(' *** CORPER : Correspondants des noeuds periodiques :') 2001 FORMAT(9I6) 2010 FORMAT(' *** CORPER : Distance relative maximale entre 2 ', & 'noeuds periodiques : ',E12.5) C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/s/matelc.F0000666000175000017500000002363411524070645015331 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=MATELC,SSI=0 C SUBROUTINE MATELC C ***************** C C ------------------------------------------------------ *( OP,DMAT,XMAT,COEFMA,NODES,COORDS,VOLUME, * NELEMS,NPOINS,NDMATS,NDIM,NDIELE,NCOEMA, * WCT ) C ------------------------------------------------------ C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DES MATRICES ELEMENTAIRES POUR * C PROBLEMES COQUES * C * C * C * C On s'appuit sur les travaux effectuees par J.P. GREGOIRE * C portant sur l'integration analytique des matrices elementaires * C matrices elementaires par les formules de Zienkiewicz * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! OP ! A ! D ! DEFINITION DU TYPE D'OPERATION ! C ! DMAT ! TR ! R ! DIAGONALE DE LA MATRICE M ! C ! XMAT ! TR ! R ! TERMES EXTRA DIAGONAUX DE LA MATRICE M ! C ! COEFMA ! TR ! D ! COEFFICIENTS DES MATRICES ! C ! ! ! ! coefma(n) = rho Cp / dt pour masse ! C ! ! ! ! coefma(n) = k (conductivite) pour diffu ! C ! COORDS ! TR ! D ! COORDONNEES DU MAILLAGE ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! W1...W6 ! TR ! M ! TABLEAUX DE TRAVAIL (TAILLE: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ASSEMB,OV C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" C C*********************************************************************** C C..Variables externes CHARACTER*8 OP INTEGER NELEMS,NDMATS,NPOINS,NDIM,NDIELE,NCOEMA C INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION DMAT(NPOINS),COEFMA(NPOINS) DOUBLE PRECISION XMAT(NELEMS,NCOEMA) DOUBLE PRECISION WCT(NELEMS,NDMATS) DOUBLE PRECISION VOLUME(NELEMS) C C.. Variables internes DOUBLE PRECISION ZERO INTEGER I INTEGER N1,N2,N3,N4,N5,N6 DOUBLE PRECISION S3,SV1,S240,SV240 DOUBLE PRECISION X45,Y45,Z45,X46,Y46,Z46,X65,Y65,Z65 DOUBLE PRECISION RC1,RC2,RC3,RC4,RC5,RC6 DOUBLE PRECISION XK1,XK2,XK3,XK4,XK5,XK6 DOUBLE PRECISION XKM1,XKM2,XKM3,XKM4 DOUBLE PRECISION ALFA1,ALFA2,ALFA3 C C*********************************************************************** C C INITIALISATIONS C ================ C ZERO = 0.D0 S240 = 1.D0 / 240.D0 C C 1- CAS COQUE C ============ C C 1.1 CONSTRUCTION DE LA MATRICE DE MASSE ELEMENTAIRE C =============================================== C IF ( OP(1:8).EQ.'MASSE ' ) THEN C C DO 111 I=1,NELEMS C C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C RC1 = COEFMA(N1) RC2 = COEFMA(N2) RC3 = COEFMA(N3) RC4 = COEFMA(N4) RC5 = COEFMA(N5) RC6 = COEFMA(N6) C C Calcul des termes diagonaux (mass-lumpe) C ---------------------------------------- C SV240 = S240 * VOLUME(I) C C WCT(I,1) = SV240 * ( 10*RC1 + 5*(RC4+RC6) ) WCT(I,2) = SV240 * ( 5*(RC4+RC5) + 10*RC2 ) WCT(I,3) = SV240 * ( 5*(RC5+RC6) + 10*RC3 ) WCT(I,4) = SV240 * ( 5*(RC1+RC2) + 30*RC4 + 10*(RC5+RC6) ) WCT(I,5) = SV240 * ( 5*(RC2+RC3) + 30*RC5 + 10*(RC4+RC6) ) WCT(I,6) = SV240 * ( 5*(RC1+RC3) + 30*RC6 + 10*(RC4+RC5) ) C 111 CONTINUE C C CALL OV ( 'X=C ',DMAT,DMAT,DMAT,ZERO,NPOINS ) CALL ASSEMB ( DMAT,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT) C C C 1.2 CONSTRUCTION DE LA MATRICE DE DIFFUSION ELEMENTAIRE C =================================================== C ELSE IF ( OP(1:8).EQ.'DIFFU ' ) THEN C S3 = 1.D0 / 3.D0 C DO 121 I=1,NELEMS C C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C XK1 = COEFMA(N1) XK2 = COEFMA(N2) XK3 = COEFMA(N3) XK4 = COEFMA(N4) XK5 = COEFMA(N5) XK6 = COEFMA(N6) C C Calcul des termes diagonaux C --------------------------- C SV1 = 1.D0 / VOLUME(I) C C X45 = COORDS(N5,1) - COORDS(N4,1) Y45 = COORDS(N5,2) - COORDS(N4,2) Z45 = COORDS(N5,3) - COORDS(N4,3) X46 = COORDS(N6,1) - COORDS(N4,1) Y46 = COORDS(N6,2) - COORDS(N4,2) Z46 = COORDS(N6,3) - COORDS(N4,3) X65 = COORDS(N5,1) - COORDS(N6,1) Y65 = COORDS(N5,2) - COORDS(N6,2) Z65 = COORDS(N5,3) - COORDS(N6,3) C ALFA1 = SV1 * (X45*X65 + Y45*Y65 + Z45*Z65 ) ALFA2 = -SV1 * (X46*X65 + Y46*Y65 + Z46*Z65 ) ALFA3 = SV1 * (X46*X45 + Y46*Y45 + Z46*Z45 ) C C XKM1 = S3 * (XK1+XK4+XK6) XKM2 = S3 * (XK4+XK2+XK5) XKM3 = S3 * (XK5+XK3+XK6) XKM4 = S3 * (XK4+XK5+XK6) C C WCT(I,1) = (ALFA2+ALFA3)*XKM1 WCT(I,2) = (ALFA1+ALFA3)*XKM2 WCT(I,3) = (ALFA1+ALFA2)*XKM3 WCT(I,4) = ALFA1*(XKM1+XKM4) + & ALFA2*(XKM2+XKM4) + & ALFA3*(XKM1+XKM2) WCT(I,5) = ALFA1*(XKM2+XKM3) + & ALFA2*(XKM4+XKM2) + & ALFA3*(XKM4+XKM3) WCT(I,6) = ALFA1*(XKM1+XKM4) + & ALFA2*(XKM1+XKM3) + & ALFA3*(XKM4+XKM3) C C Calcul des termes extra-diagonaux C ---------------------------------- C XMAT(I,1) = -ALFA3*XKM1 XMAT(I,2) = -ALFA2*XKM1 C XMAT(I,3) = -ALFA3*XKM2 XMAT(I,4) = -ALFA1*XKM2 C XMAT(I,5) = -ALFA1*XKM3 XMAT(I,6) = -ALFA2*XKM3 C XMAT(I,7) = -ALFA2*(XKM2+XKM4) XMAT(I,8) = -ALFA1*(XKM1+XKM4) C XMAT(I,9) = -ALFA3*(XKM3+XKM4) C 121 CONTINUE C C CALL ASSEMB ( DMAT,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT) C C C ---- FIN DU CALCUL DES MATRICES POUR PROBLEMES COQUES --- C ELSE PRINT*,'MATELE erreur dans expression de diffusion coque',OP ENDIF C C------ C FORMAT C------ C C RETURN END syrthes-3.4.3-dfsg1/src/s/derriere_2d.c0000666000175000017500000001472711524070645016312 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "abs.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | derriere | | Detection des segments en arriere et retour d'un code de | | Classement | |======================================================================| */ void derriere_2d (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[], double dsign[],int *code_decoupe) { int k; double epsder; epsder = 1e-3; for (k=0;k<2;k++) dsign[k] = xnf[nel_j]*xi[k]+xnf[nel_j+nel2]*yi[k] + pland[nel_j] ; for (k=2;k<4;k++) dsign[k] = xnf[nel_i]*xi[k]+xnf[nel_i+nel2]*yi[k] + pland[nel_i] ; if (( dsign[0]< epsder && dsign[1]< epsder) || ( dsign[2]< epsder && dsign[3]< epsder)) *code_decoupe = -10; else if ( dsign[0]> -epsder && dsign[1]> -epsder && dsign[2]> -epsder && dsign[3]> -epsder ) *code_decoupe = 0; else if ( dsign[0]> -epsder && dsign[1]> -epsder && dsign[2]> -epsder && dsign[3]< epsder) *code_decoupe = 1; else if ( dsign[0]> -epsder && dsign[1]> -epsder && dsign[3]> -epsder && dsign[2]< epsder) *code_decoupe = -1; else if ( dsign[2]> -epsder && dsign[3]> -epsder && dsign[0]> -epsder && dsign[1]< epsder) *code_decoupe = 2; else if ( dsign[2]> -epsder && dsign[3]> -epsder && dsign[1]> -epsder && dsign[0]< epsder) *code_decoupe = -2; else if ( dsign[0]*dsign[1]< epsder && dsign[2]*dsign[3]< epsder ) { printf( " Erreur DERRIERE : il semble y avoir une erreur dans le maillage. \n\ les elements %d et %d sont superposes \n",nel_i+1,nel_j+1) ; exit(0); } else { printf(" Cas non prevu pour les elements nel_i= %d nel_j=%d \n",nel_i+1,nel_j+1); *code_decoupe = -6; } } /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | decoupe_seg | | Decoupage de segment pour optimisation de la qualite | | | |======================================================================| */ void decoupe_seg (int nel2, int nel_i, int nel_j, double *xnf,double *pland,double xi[],double yi[], double dsign[],int code_decoupe) { double xnj1,xnj2; double denom,numer,alfa; double pa[2],plac; double epsd=1.e-5,eps=1.e-6; if ( code_decoupe == 1 ) { xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; plac = pland[nel_i]; /* Determination de la racine pa */ denom = xnj1*(xi[3]-xi[2]) +xnj2*(yi[3]-yi[2]); if ( abs(denom) > eps ) { numer = xnj1*xi[2]+ xnj2*yi[2]+ plac ; alfa = - numer/denom - epsd ; pa[0]= xi[2]+ alfa*(xi[3]-xi[2]); pa[1]= yi[2]+ alfa*(yi[3]-yi[2]); } xi[0]=xi[0]; yi[0]=yi[0]; xi[1]=xi[1]; yi[1]=yi[1]; xi[2]=xi[2]; yi[2]=yi[2]; xi[3]=pa[0]; yi[3]=pa[1]; } else if( code_decoupe == -1 ) { xnj1 = xnf[nel_i]; xnj2 = xnf[nel_i+nel2]; plac = pland[nel_i]; denom = xnj1*(xi[3]-xi[2]) +xnj2*(yi[3]-yi[2]); if ( abs(denom) > eps ) { numer = xnj1*xi[2]+ xnj2*yi[2]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[2]+ alfa*(xi[3]-xi[2]); pa[1]= yi[2]+ alfa*(yi[3]-yi[2]); } xi[0]=xi[0]; yi[0]=yi[0]; xi[1]=xi[1]; yi[1]=yi[1]; xi[2]=pa[0]; yi[2]=pa[1]; xi[3]=xi[3]; yi[3]=yi[3]; } else if( code_decoupe == 2 ) { xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; plac = pland[nel_j]; denom = xnj1*(xi[1]-xi[0]) +xnj2*(yi[1]-yi[0]); if ( abs(denom) > eps ) { numer = xnj1*xi[0]+ xnj2*yi[0]+ plac ; alfa = - numer/denom - epsd ; pa[0]= xi[0]+ alfa*(xi[1]-xi[0]); pa[1]= yi[0]+ alfa*(yi[1]-yi[0]); } xi[0]=xi[0]; yi[0]=yi[0]; xi[1]=pa[0]; yi[1]=pa[1]; xi[2]=xi[2]; yi[2]=yi[2]; xi[3]=xi[3]; yi[3]=yi[3]; } else if( code_decoupe == -2 ) { xnj1 = xnf[nel_j]; xnj2 = xnf[nel_j+nel2]; plac = pland[nel_j]; denom = xnj1*(xi[1]-xi[0]) +xnj2*(yi[1]-yi[0]); if ( abs(denom) > eps ) { numer = xnj1*xi[0]+ xnj2*yi[0]+ plac ; alfa = - numer/denom + epsd ; pa[0]= xi[0]+ alfa*(xi[1]-xi[0]); pa[1]= yi[0]+ alfa*(yi[1]-yi[0]); } xi[0]=pa[0]; yi[0]=pa[1]; xi[1]=xi[1]; yi[1]=yi[1]; xi[2]=xi[2]; yi[2]=yi[2]; xi[3]=xi[3]; yi[3]=yi[3]; } else printf(" Erreur derriere_2d : Cas non prevu \n" ); } syrthes-3.4.3-dfsg1/src/s/bilflu.F0000666000175000017500000004503411524070645015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE BILFLU C ***************** C C --------------------------------------------------- *( NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * TMPSA,NODEUS,SURFUS, * NPOINS,NDIM,NELEUS,NDMASS,NREFAL,COORDS) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- BILANS DE FLUX * C * C Les flux au bord du solide sont de plusieurs types: * C Flux dus au couplage thermique fluide -solide * C Flux imposes par l'utilisateur * C Flux ayant pour origine un coefficient d'echange * C Flux ayant pour origine une resitance de contact * C Flux ayant pour origine un rayonnement * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NELERA ! E ! D ! Nombre de facette de type rayonnement ! C ! NFRAIS ! TE ! D ! No de facette rayonnt inf --> face glob ! C ! VFRAIS ! TR ! D ! Valeur du rayo inf aux points de la face ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! B ! TR ! R ! SECOND MEMBRE ! C ! NODEUS ! TE ! D ! NOEUDS DE BORD( LOCALE 2D --> GLOBALE 3D)! C ! SURFUS ! TR ! D ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE ! C ! TRAV ! TR ! R ! TABLEAU DE TRAVAIL ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL. ATTENTION On utilise! C ! ! ! ! uniquement les premieres cases ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "rayonn.h" #include "bilan.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NDIM,NELEUS,NDMASS INTEGER NBFFLU,NBFECH,NELERC,NELERA,NBFRAI,NELESS INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI),NFCOUS(NELESS) INTEGER NODEUS(NELEUS,NDMASS),NREFAL(NELEUS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) DOUBLE PRECISION TMPSA(NPOINS) DOUBLE PRECISION SURFUS(NELEUS),COORDS(NPOINS,NDIM) C C..Variables internes INTEGER I,J,NB,N1,INODE,NUMREF INTEGER I1,I2,I3,I4,I5,I6,NCA DOUBLE PRECISION HRAYI(6),S,PHI,S24,S12,R1,R2 DOUBLE PRECISION F1,F2,F3,F4,F5,F6 LOGICAL OK C C*********************************************************************** IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C S24=1./24. S12=1./12. C DO NB=1,NBISMX BFLUSU(NB,1)=0. BFLUSU(NB,2)=0. BFLUSU(NB,3)=0. ENDDO C C CALCUL DES CONDITIONS SUR LES FACES DE BORD CONCERNEES C ========================================================= C DO NB=1,NBILAS C DO I=1,NELESS NUMREF=NREFAL(NFCOUS(I)) OK=.FALSE. DO N1=1,NRFMA2 IF (IRBILS(N1,NB).NE.0 .AND. NUMREF.EQ.N1) OK=.TRUE. ENDDO IF (OK) THEN S=SURFUS(NFCOUS(I)) PHI=0. IF (NDIM.EQ.2 .AND.IAXISY.EQ.0) THEN I1=NODEUS(NFCOUS(I),1) I2=NODEUS(NFCOUS(I),2) I3=NODEUS(NFCOUS(I),3) F1=VFCOUS(I,1,2)*(VFCOUS(I,1,1)-TMPSA(I1)) F2=VFCOUS(I,2,2)*(VFCOUS(I,2,1)-TMPSA(I2)) F3=VFCOUS(I,3,2)*(VFCOUS(I,3,1)-TMPSA(I3)) BFLUSU(NB,3)=BFLUSU(NB,3)+(F1+F2+2*F3)*0.25*S ELSEIF (NDIM.EQ.2 .AND.IAXISY.NE.0) THEN R1 = ABS (COORDS(NODEUS(NFCOUS(I),1),NCA)) R2 = ABS (COORDS(NODEUS(NFCOUS(I),2),NCA)) I1=NODEUS(NFCOUS(I),1) I2=NODEUS(NFCOUS(I),2) I3=NODEUS(NFCOUS(I),3) F1=VFCOUS(I,1,2)*(VFCOUS(I,1,1)-TMPSA(I1)) F2=VFCOUS(I,2,2)*(VFCOUS(I,2,1)-TMPSA(I2)) F3=VFCOUS(I,3,2)*(VFCOUS(I,3,1)-TMPSA(I3)) PHI=6*R2*F3+R2*F1+6*R1*F3+5*R1*F1+5*R2*F2+R1*F2 BFLUSU(NB,3)=BFLUSU(NB,3)+PHI*S24*S ELSE I1=NODEUS(NFCOUS(I),1) I2=NODEUS(NFCOUS(I),2) I3=NODEUS(NFCOUS(I),3) I4=NODEUS(NFCOUS(I),4) I5=NODEUS(NFCOUS(I),5) I6=NODEUS(NFCOUS(I),6) F1=VFCOUS(I,1,2)*(VFCOUS(I,1,1)-TMPSA(I1)) F2=VFCOUS(I,2,2)*(VFCOUS(I,2,1)-TMPSA(I2)) F3=VFCOUS(I,3,2)*(VFCOUS(I,3,1)-TMPSA(I3)) F4=VFCOUS(I,4,2)*(VFCOUS(I,4,1)-TMPSA(I4)) F5=VFCOUS(I,5,2)*(VFCOUS(I,5,1)-TMPSA(I5)) F6=VFCOUS(I,6,2)*(VFCOUS(I,6,1)-TMPSA(I6)) PHI=F1+F2+F3+ 3*(F4+F5+F6) BFLUSU(NB,3)=BFLUSU(NB,3)+PHI*S12*S ENDIF ENDIF ENDDO C DO I=1,NBFFLU NUMREF=NREFAL(NFFLUS(I)) OK=.FALSE. DO N1=1,NRFMA2 IF (IRBILS(N1,NB).NE.0 .AND. NUMREF.EQ.N1) OK=.TRUE. ENDDO IF (OK) THEN S=SURFUS(NFFLUS(I)) PHI=0. IF (NDIM.EQ.2 .AND.IAXISY.EQ.0) THEN I1=NODEUS(NFFLUS(I),1) I2=NODEUS(NFFLUS(I),2) I3=NODEUS(NFFLUS(I),3) F1=VFFLUS(I,1) F2=VFFLUS(I,2) F3=VFFLUS(I,3) BFLUSU(NB,1)=BFLUSU(NB,1)+(F1+F2+2*F3)*0.25*S ELSEIF (NDIM.EQ.2 .AND.IAXISY.NE.0) THEN R1 = ABS (COORDS(NODEUS(NFFLUS(I),1),NCA)) R2 = ABS (COORDS(NODEUS(NFFLUS(I),2),NCA)) I1=NODEUS(NFFLUS(I),1) I2=NODEUS(NFFLUS(I),2) I3=NODEUS(NFFLUS(I),3) F1=VFFLUS(I,1) F2=VFFLUS(I,2) F3=VFFLUS(I,3) PHI=6*R2*F3+R2*F1+6*R1*F3+5*R1*F1+5*R2*F2+R1*F2 BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S24*S ELSE I1=NODEUS(NFFLUS(I),1) I2=NODEUS(NFFLUS(I),2) I3=NODEUS(NFFLUS(I),3) I4=NODEUS(NFFLUS(I),4) I5=NODEUS(NFFLUS(I),5) I6=NODEUS(NFFLUS(I),6) F1=VFFLUS(I,1) F2=VFFLUS(I,2) F3=VFFLUS(I,3) F4=VFFLUS(I,4) F5=VFFLUS(I,5) F6=VFFLUS(I,6) PHI=F1+F2+F3+ 3*(F4+F5+F6) BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S12*S ENDIF ENDIF ENDDO C DO I=1,NBFECH NUMREF=NREFAL(NFECHS(I)) OK=.FALSE. DO N1=1,NRFMA2 IF (IRBILS(N1,NB).NE.0 .AND. NUMREF.EQ.N1) OK=.TRUE. ENDDO IF (OK) THEN S=SURFUS(NFECHS(I)) PHI=0. IF (NDIM.EQ.2 .AND.IAXISY.EQ.0) THEN I1=NODEUS(NFECHS(I),1) I2=NODEUS(NFECHS(I),2) I3=NODEUS(NFECHS(I),3) F1=VFECHS(I,1,2)*(VFECHS(I,1,1)-TMPSA(I1)) F2=VFECHS(I,2,2)*(VFECHS(I,2,1)-TMPSA(I2)) F3=VFECHS(I,3,2)*(VFECHS(I,3,1)-TMPSA(I3)) BFLUSU(NB,1)=BFLUSU(NB,1)+(F1+F2+2*F3)*0.25*S ELSEIF (NDIM.EQ.2 .AND.IAXISY.NE.0) THEN R1 = ABS (COORDS(NODEUS(NFECHS(I),1),NCA)) R2 = ABS (COORDS(NODEUS(NFECHS(I),2),NCA)) I1=NODEUS(NFECHS(I),1) I2=NODEUS(NFECHS(I),2) I3=NODEUS(NFECHS(I),3) F1=VFECHS(I,1,2)*(VFECHS(I,1,1)-TMPSA(I1)) F2=VFECHS(I,2,2)*(VFECHS(I,2,1)-TMPSA(I2)) F3=VFECHS(I,3,2)*(VFECHS(I,3,1)-TMPSA(I3)) PHI=6*R2*F3+R2*F1+6*R1*F3+5*R1*F1+5*R2*F2+R1*F2 BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S24*S ELSE I1=NODEUS(NFECHS(I),1) I2=NODEUS(NFECHS(I),2) I3=NODEUS(NFECHS(I),3) I4=NODEUS(NFECHS(I),4) I5=NODEUS(NFECHS(I),5) I6=NODEUS(NFECHS(I),6) F1=VFECHS(I,1,2)*(VFECHS(I,1,1)-TMPSA(I1)) F2=VFECHS(I,2,2)*(VFECHS(I,2,1)-TMPSA(I2)) F3=VFECHS(I,3,2)*(VFECHS(I,3,1)-TMPSA(I3)) F4=VFECHS(I,4,2)*(VFECHS(I,4,1)-TMPSA(I4)) F5=VFECHS(I,5,2)*(VFECHS(I,5,1)-TMPSA(I5)) F6=VFECHS(I,6,2)*(VFECHS(I,6,1)-TMPSA(I6)) PHI=F1+F2+F3+ 3*(F4+F5+F6) BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S12*S ENDIF ENDIF ENDDO C DO I=1,NBFRAI NUMREF=NREFAL(NFRAIS(I)) OK=.FALSE. DO N1=1,NRFMA2 IF (IRBILS(N1,NB).NE.0 .AND. NUMREF.EQ.N1) OK=.TRUE. ENDDO IF (OK) THEN S=SURFUS(NFRAIS(I)) PHI=0. IF (NDIM.EQ.2 .AND.IAXISY.EQ.0) THEN I1=NODEUS(NFRAIS(I),1) I2=NODEUS(NFRAIS(I),2) I3=NODEUS(NFRAIS(I),3) DO J=1,3 INODE=NODEUS(NFRAIS(I),J) HRAYI(J) = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAIS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAIS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAIS(I,3,1)-TMPSA(I3)) BFLUSU(NB,1)=BFLUSU(NB,1)+(F1+F2+2*F3)*0.25*S ELSEIF (NDIM.EQ.2 .AND.IAXISY.NE.0) THEN R1 = ABS (COORDS(NODEUS(NFRAIS(I),1),NCA)) R2 = ABS (COORDS(NODEUS(NFRAIS(I),2),NCA)) I1=NODEUS(NFRAIS(I),1) I2=NODEUS(NFRAIS(I),2) I3=NODEUS(NFRAIS(I),3) DO J=1,3 INODE=NODEUS(NFRAIS(I),J) HRAYI(J) = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAIS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAIS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAIS(I,3,1)-TMPSA(I3)) PHI=6*R2*F3+R2*F1+6*R1*F3+5*R1*F1+5*R2*F2+R1*F2 BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S24*S ELSE I1=NODEUS(NFRAIS(I),1) I2=NODEUS(NFRAIS(I),2) I3=NODEUS(NFRAIS(I),3) I4=NODEUS(NFRAIS(I),4) I5=NODEUS(NFRAIS(I),5) I6=NODEUS(NFRAIS(I),6) DO J=1,6 INODE=NODEUS(NFRAIS(I),J) HRAYI(J) = VFRAIS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAIS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAIS(I,J,1)+TKEL) * (VFRAIS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAIS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAIS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAIS(I,3,1)-TMPSA(I3)) F4=HRAYI(4)*(VFRAIS(I,4,1)-TMPSA(I4)) F5=HRAYI(5)*(VFRAIS(I,5,1)-TMPSA(I5)) F6=HRAYI(6)*(VFRAIS(I,6,1)-TMPSA(I6)) PHI=F1+F2+F3+ 3*(F4+F5+F6) BFLUSU(NB,1)=BFLUSU(NB,1)+PHI*S12*S ENDIF ENDIF ENDDO C DO I=1,NELERA NUMREF=NREFAL(NFRAYS(I)) OK=.FALSE. DO N1=1,NRFMA2 IF (IRBILS(N1,NB).NE.0 .AND. NUMREF.EQ.N1) OK=.TRUE. ENDDO IF (OK) THEN S=SURFUS(NFRAYS(I)) PHI=0. IF (NDIM.EQ.2 .AND.IAXISY.EQ.0) THEN I1=NODEUS(NFRAYS(I),1) I2=NODEUS(NFRAYS(I),2) I3=NODEUS(NFRAYS(I),3) DO J=1,3 INODE=NODEUS(NFRAYS(I),J) HRAYI(J) = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAYS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAYS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAYS(I,3,1)-TMPSA(I3)) BFLUSU(NB,2)=BFLUSU(NB,2)+(F1+F2+2*F3)*0.25*S ELSEIF (NDIM.EQ.2 .AND.IAXISY.NE.0) THEN R1 = ABS (COORDS(NODEUS(NFRAYS(I),1),NCA)) R2 = ABS (COORDS(NODEUS(NFRAYS(I),2),NCA)) I1=NODEUS(NFRAYS(I),1) I2=NODEUS(NFRAYS(I),2) I3=NODEUS(NFRAYS(I),3) DO J=1,3 INODE=NODEUS(NFRAYS(I),J) HRAYI(J) = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAYS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAYS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAYS(I,3,1)-TMPSA(I3)) PHI=6*R2*F3+R2*F1+6*R1*F3+5*R1*F1+5*R2*F2+R1*F2 BFLUSU(NB,2)=BFLUSU(NB,2)+PHI*S24*S ELSE I1=NODEUS(NFRAYS(I),1) I2=NODEUS(NFRAYS(I),2) I3=NODEUS(NFRAYS(I),3) I4=NODEUS(NFRAYS(I),4) I5=NODEUS(NFRAYS(I),5) I6=NODEUS(NFRAYS(I),6) DO J=1,6 INODE=NODEUS(NFRAYS(I),J) HRAYI(J) = VFRAYS(I,J,2)*SIGMA* & (TMPSA(INODE)+VFRAYS(I,J,1)+2*TKEL)* & ((TMPSA(INODE)+TKEL) * (TMPSA(INODE)+TKEL) + & (VFRAYS(I,J,1)+TKEL) * (VFRAYS(I,J,1)+TKEL) ) ENDDO F1=HRAYI(1)*(VFRAYS(I,1,1)-TMPSA(I1)) F2=HRAYI(2)*(VFRAYS(I,2,1)-TMPSA(I2)) F3=HRAYI(3)*(VFRAYS(I,3,1)-TMPSA(I3)) F4=HRAYI(4)*(VFRAYS(I,4,1)-TMPSA(I4)) F5=HRAYI(5)*(VFRAYS(I,5,1)-TMPSA(I5)) F6=HRAYI(6)*(VFRAYS(I,6,1)-TMPSA(I6)) PHI=F1+F2+F3+ 3*(F4+F5+F6) BFLUSU(NB,2)=BFLUSU(NB,2)+PHI*S12*S ENDIF ENDIF ENDDO C ENDDO C C IMPRESSIONS C ----------- C WRITE(NFECRA,1000) DO NB=1,NBILAS WRITE(NFECRA,1010) NB,(BFLUSU(NB,I),I=1,3) ENDDO C C-------- C FORMATS C-------- 1000 FORMAT(/,'Bilans de Flux surfaciques :') 1010 FORMAT( ' * Bilan ',I2,' * Cond Lim :',E12.5, & ' Radiatif :',E12.5,' Convectif :',E12.5) C END syrthes-3.4.3-dfsg1/src/s/mobdis.F0000666000175000017500000001456011524070645015337 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE MOBDIS C ***************** C C ------------------------------------------------- *( NBMOBS,NDIM,NODERC,NELERC,NDMASS,NPOINS,COORDS) C ------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- * C SOLIDE MOBILE : INITIALISATION DE : * C - D1MAXS (plus petite distance entre 2 noeuds de bords * C du solide) * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE ! C ! NBMOBS ! E ! D ! NOMBRE DE NOEUDS MOBILES ! C ! NMOBIL ! E ! D ! NUM GLOB ET NUM DE SOLIDE DES NOEUDS MOB ! C ! COORDS ! TR ! M ! COORDONNEES DES NOEUDS DU MAILLAGE ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ROTATI C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "mobil.h" #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C..Variables externes INTEGER NBMOBS,NDIM INTEGER NELERC,NDMASS,NPOINS,NODERC(NELERC,NDMASS) DOUBLE PRECISION COORDS(NPOINS,NDIM) C C..Variables internes INTEGER N,N1,N2,N3,N4,N5,N6 DOUBLE PRECISION X1,Y1,Z1,X2,Y2,Z2,X3,Y3 DOUBLE PRECISION X4,Y4,Z4,X5,Y5,Z5,X6,Y6,Z6 DOUBLE PRECISION D14,D16,D25,D13 C C*********************************************************************** C C 0- INITIALISATIONS C ================== D1MAXS = 1.E6 C IF (NBMOBS.EQ.0 .AND. .NOT.LSDEPL) RETURN C C C 3- CALCUL DE D1MAXS EN DIMENSION 2 C ================================== C IF (NDIM.EQ.2) THEN C DO 300 N=1,NELERC C N1 = NODERC(N,1) N2 = NODERC(N,2) N3 = NODERC(N,3) C X1 = COORDS(N1,1) Y1 = COORDS(N1,2) X3 = COORDS(N3,1) Y3 = COORDS(N3,2) C D13 = (X3-X1)*(X3-X1) + (Y3-Y1)*(Y3-Y1) C IF (D13.LT.D1MAXS) D1MAXS = D13 C 300 CONTINUE C C C 4- CALCUL DE D1MAXS EN DIMENSION 3 C ================================== C ELSE C DO 400 N=1,NELERC C N1 = NODERC(N,1) N2 = NODERC(N,2) N4 = NODERC(N,4) N5 = NODERC(N,5) N6 = NODERC(N,6) C X1 = COORDS(N1,1) Y1 = COORDS(N1,2) Z1 = COORDS(N1,3) X2 = COORDS(N2,1) Y2 = COORDS(N2,2) Z2 = COORDS(N2,3) X4 = COORDS(N4,1) Y4 = COORDS(N4,2) Z4 = COORDS(N4,3) X5 = COORDS(N5,1) Y5 = COORDS(N5,2) Z5 = COORDS(N5,3) X6 = COORDS(N6,1) Y6 = COORDS(N6,2) Z6 = COORDS(N6,3) C D14 = (X4-X1)*(X4-X1) + (Y4-Y1)*(Y4-Y1) + (Z4-Z1)*(Z4-Z1) D16 = (X6-X1)*(X6-X1) + (Y6-Y1)*(Y6-Y1) + (Z6-Z1)*(Z6-Z1) D25 = (X5-X2)*(X5-X2) + (Y5-Y2)*(Y5-Y2) + (Z5-Z2)*(Z5-Z2) C IF (D14.LT.D1MAXS) D1MAXS = D14 IF (D16.LT.D1MAXS) D1MAXS = D16 IF (D25.LT.D1MAXS) D1MAXS = D25 C 400 CONTINUE C C C ENDIF C C C 5- Correction pour les problemes d'arrondis C =========================================== D1MAXS = D1MAXS / 2. C C C 6- Impressions C ============== IF (NELERC.GT.0 .AND. NBLBLA.GT.0) & WRITE(NFECRA,6010) SQRT(D1MAXS) C C-------- C FORMATS C-------- 6010 FORMAT(/,' *** MOBDIS : ',/, & ' Distance d''acceptation des correspondants',/, & ' pour les resistances de contact : ',E12.5) C RETURN END syrthes-3.4.3-dfsg1/src/s/limsol.F0000666000175000017500000003117211524070645015357 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMSOL C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS,NBECHS,NECHS,VECHS, * NBRAIS,NRAYIS,VRAYIS,NBRESS,NRESCS,VRESCS) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C POUR LE CALCUL COUPLE FLUIDE-SOLIDE * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFLUSS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DE FLUX ! C ! VFLUSS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE FLUX ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C ! NECHS ! TE ! D ! NUMERO DES NOEUDS AVEC C.L. COEFF ECHANGE ! C ! VECHS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE COEFF ECHANGE! C ! ! ! ! VECHS(...,1) = temperature exterieure ! C ! ! ! ! VECHS(...,2) = coefficient d'echange ! C ! NRAYIS ! TE ! D ! NUMERO DES NOEUDS AVEC RAYONNEMENT infi ! C ! VRAYIS ! TR ! R ! VALEUR DES PARAMETRES POUR LE RAYONNEMENTinfi! C ! NRESCS ! TE ! D ! NUMERO DES NOEUDS AVEC RESISTANCE DE CONTACT ! C ! VRESCS ! TR ! R ! VALEUR DE LA RESISTANCE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NBFLUS,NBDIRS,NBECHS,NBRESS,NBRAIS INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFLUSS(NBFLUS),NDIRS(NBDIRS),NECHS(NBECHS) INTEGER NRESCS(NBRESS,2),NRAYIS(NBRAIS) DOUBLE PRECISION VFLUSS(NBFLUS),VDIRS(NBDIRS),VECHS(NBECHS,2) DOUBLE PRECISION VRESCS(NBRESS,2),VRAYIS(NBRAIS,2) C C.. Variables internes INTEGER N,NUMNO,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFLUS C C Numero global du noeud CUTI NUMNO = NFLUSS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 3, le flux vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFLUSS(N) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBDIRS C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 5, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBECHS C C Numero global du noeud CUTI NUMNO = NECHS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure est C de 20 et le coefficient d'echange de 10, sinon, la temperature C exterieure et de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VECHS(N,1) = 20.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ELSE CUTI VECHS(N,1) = 40.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRESS C C Numero global du noeud CUTI NUMNO = NRESCS(N,1) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 4 C CUTI IF (NUMREF.EQ.4) THEN CUTI VRESCS(N,2) = 0.5D0 CUTI ELSE CUTI VRESCS(N,2) = 0.7D0 CUTI ENDIF C CUTI ENDDO C C ==================================================== C 6- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RAYONNEMENT INFINI C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRAIS C C Numero global du noeud CUTI NUMNO = NRAYIS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure C utilisee pour le rayonnement est de 100 degree C C L'emissivite est de 0.8 C de 20 degree et epsilon=0.9 autrement C CUTI IF (NUMREF.EQ.6) THEN CUTI VRAYIS(N,1) = 100.0D0 CUTI VRAYIS(N,2) = 0.8D0 CUTI ELSE CUTI VRAYIS(N,1) = 20.D0 CUTI VRAYIS(N,2) = 0.9 CUTI ENDIF C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFLUS.GT.0 .OR. NBDIRS.GT.0 .OR. NBECHS.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF IF (NBFLUS.GT.0) THEN WRITE(NFECRA,5010) WRITE(NFECRA,5050) (NFLUSS(N),VFLUSS(N),N=1,NBFLUS) ENDIF IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF IF (NBECHS.GT.0) THEN WRITE(NFECRA,5030) WRITE(NFECRA,5060) & (NECHS(N),VECHS(N,1),VECHS(N,2),N=1,NBECHS) ENDIF IF (NBRAIS.GT.0) THEN WRITE(NFECRA,5040) WRITE(NFECRA,5060) & (NRAYIS(N),VRAYIS(N,1),VRAYIS(N,2),N=1,NBRAIS) ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMSOL : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMSOL : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux (noeud, valeur)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange (noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement infini', & ' (noeud, T, sigma)') 5050 FORMAT('(',I6,'-',G10.3,')') 5060 FORMAT('(',I6,'-',G10.3,',',G10.3,')') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/inimst.F0000666000175000017500000001425011524070645015361 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INIMST C ***************** C C ------------------------------------------------------------- * (NELRAY,EMISSI,TEMRAY,FDFRAY,FDFNP1,SUFRAY,RADIOS) C ------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C INITIALISATIONDE MSTS C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFES/ ! ! D ! ! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "nlofes.h" #include "nlofct.h" #include "fichct.h" #include "syrth.h" #include "rayonn.h" C C ********************************************************************** C C.. Variables externes INTEGER NELRAY DOUBLE PRECISION FDFRAY(NELRAY*(NELRAY+1)/2) DOUBLE PRECISION SUFRAY(NELRAY),FDFNP1(NELRAY),TEMRAY(NELRAY) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),RADIOS(NELRAY,NBANDE) C C.. Variables internes INTEGER N,NBF,NBB,NUMBS,I CHARACTER*80 CH DOUBLE PRECISION C2,X1,X2,V,W1,W2,XJ C C ********************************************************************** C C 1- Suite de calcul C ================== IF (LSUISO) THEN C REWIND (NFSMRA) READ(NFSMRA,1000) NBF,NBB IF (NBF.NE.NELRAY .OR. NBB.NE.NBANDE) THEN WRITE(NFECRA,2000) NBF,NBB,NELRAY,NBANDE STOP ENDIF READ(NFSMRA,1010) CH READ(NFSMRA,1010) CH READ(NFSMRA,1020) (TEMRAY(I),I=1,NELRAY) DO N=1,NBANDE READ(NFSMRA,1010) CH READ(NFSMRA,1010) CH READ(NFSMRA,1020) (RADIOS(I,N),I=1,NELRAY) ENDDO C ELSE C IF (NBANDE.EQ.1) THEN DO N=1,NELRAY RADIOS(N,1)=SIGMA*EMISSI(N,1,1)*(TEMRAY(N)+TKEL)**4 ENDDO IF (LROUVR) THEN XJ = SIGMA * (TEMINF+TKEL)**4 DO N=1,NELRAY RADIOS(N,1) = RADIOS(N,1) + * (1.-EMISSI(N,1,1))*FDFNP1(N)*XJ ENDDO ENDIF C ELSE C2 = 1.4388E-2 DO NUMBS=1,NBANDE X1 = C2/SPECTL(NUMBS,1) X2 = C2/SPECTL(NUMBS,2) DO N=1,NELRAY V = X1/(TEMRAY(N)+TKEL) CALL WIEBEL(V,W1) V = X2/(TEMRAY(N)+TKEL) CALL WIEBEL(V,W2) RADIOS(N,NUMBS) = SIGMA * EMISSI(N,1,NUMBS) * * (TEMRAY(N)+TKEL)**4 * (W2-W1) ENDDO IF (LROUVR) THEN V = X1/(TEMINF+TKEL) CALL WIEBEL(V,W1) V = X2/(TEMINF+TKEL) CALL WIEBEL(V,W2) DO N=1,NELRAY RADIOS(N,NUMBS) = RADIOS(N,NUMBS) + * (1.-EMISSI(N,1,NUMBS)) * FDFNP1(N) * * SIGMA * * (TEMINF+TKEL)**4 * (W2-W1) ENDDO ENDIF ENDDO ENDIF C ENDIF C C-------- C FORMATS C-------- C 1000 FORMAT(9X,I7,9X,I4) 1010 FORMAT(A80) 1020 FORMAT(6E13.7) C 2000 FORMAT(/,' %% ERREUR INIMST : FICHIER SUITE INCOHERENT',/, & ' On lit :',I7,' facettes et ',I4,' bandes',/, & ' On attendait :',I7,' facettes et ',I4,' bandes') C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/smffco.F0000666000175000017500000001536411524070645015342 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMFFCO,SSI=0 C SUBROUTINE SMFFCO C ***************** C C --------------------------------------------------- * (TRAVF,B,NODES,VOLUME, * NPOINS,NELEMS,NDMATS,NDIELE, * WCT) C --------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C POUR LE MODEL COQUE * C * C Le flux volumique (constant dans l'epaisseur!) * C * C Les flux sur les surfaces exterieurs et interieures sont du type* C Flux dus au couplage thermique fluide -solide * C Flux exterieurs imposes par l'utilisateur * C Flux ayant pour origine un coefficient d'echange * C * C Le flux est impose sur les facettes definies par * C l'utilisateur * C * C En surfacique: * C ------------- * C / + - * C B = / ( PHI (+ ou -) PHI ) Phj dx dy * C / * C PHI sont discretises en iso-P2 * C dS element de surface de la coque * C Phj fonction de base iso-P2 * C * C Rq : Lorsque le flux n'est pas defini, cela revient a dire * C implicitement que ce flux est nul. * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! B ! TR ! R ! SECOND MEMBRE ! C ! NODES ! TE ! D ! NOEUDS DE BORD( LOCALE 2D --> GLOBALE 3D)! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE ! C ! FLUX ! TR ! R ! flux au second membre par facette ! C ! WCT ! TR ! M ! TABLEAUX DE TRAVAIL. ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NDIELE INTEGER NODES(NELEMS,NDMATS) C DOUBLE PRECISION TRAVF(NELEMS,NDMATS) DOUBLE PRECISION B(NPOINS) DOUBLE PRECISION WCT(NELEMS,NDMATS) DOUBLE PRECISION VOLUME(NELEMS) C C..Variables locales DOUBLE PRECISION ZERO DOUBLE PRECISION S48,SV48 DOUBLE PRECISION F1,F2,F3,F4,F5,F6 INTEGER I C C*********************************************************************** C C 1- INITIALISATIONS C ================== C ZERO = 0.D0 S48 = 1.D0 / 48.D0 C C 3- CALCUL DU VECTEUR ELEMENTAIRE C ================================ C DO 311 I=1,NELEMS C SV48 = S48 * VOLUME(I) C F1 = TRAVF(I,1) * SV48 F2 = TRAVF(I,2) * SV48 F3 = TRAVF(I,3) * SV48 F4 = TRAVF(I,4) * SV48 F5 = TRAVF(I,5) * SV48 F6 = TRAVF(I,6) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 311 CONTINUE C CALL OV ( 'X=C ',B,B,B,ZERO,NPOINS ) CALL ASSEMB ( B,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C END syrthes-3.4.3-dfsg1/src/s/ressol.F0000666000175000017500000006431611524070645015375 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 **************** SUBROUTINE RESSOL C ***************** C C ------------------------------------------------------------- * (NDIM,NDIELE,NBCOUF,NELESF,NDMASF,NBFACE, * NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL,NPOINS,NELEMS,NDMATS, * NELESS,NDMASS,NELEUS,NELERC,NELEPR,NBRESS,NBRAYS,NBRAIS, * NBPRIO,NBMOBS, * NBCOPR,NBPHYS,NPPEL,NPOUE,NCOEMA,NBICOR, * NODESF,NCOUPF,VCOUPF, * NCOUPS,NFLUSS,NDIRS,NECHS,NFLUVS,NRESCS,NRAYTS,NRAYIS, * NPRIOS,NMOBIL, * VCOUPS,VFLUSS,VDIRS,VECHS,VFLUVS,VRESCS,VRAYTS,VRAYIS, * NREFAC,NREFAL, * NREFS,NREFE,COORDS,NODES,NODESS,NODEUS,NODERC,NODEPR, * NANGLE,NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS, * NCBORS,NCBORF,BARYS,BARYF,COORDF, * PHYSOL,TMPSA,TMPS,TMPSC1,TMPSC2,TMPSC3, * VOLUME,SURFUS, * B,DMAT,XMAT,DIAG, * TRAVF,TRAV1,TRAV2,TRAV3,TRAV4,WCT,TMPMAX,TMPMIN) C C --------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C FONCTION : C ---------- C C RESOLUTION DE LA THERMIQUE DANS LE SOLIDE C C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME (2 OU 3) ! C ! NDIELE ! E ! D ! DIMENSION DES ELTS DU PB (2 OU 3) ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NELESF ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF COUPLE FLUIDE ! C ! NDMASF ! E ! D ! NOMBRE DE NOEUDS DES ELTS FLUIDES SURF ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NBCOUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES COUPLES ! C ! NBFLUS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL DE TYPE FLUX! C ! NBDIRS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL DIRICHLET ! C ! NBECHS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL COEF ECH ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC FLUX VOLUMIQUE ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE VOL SOLIDE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS DES ELTS VOL SOLIDES ! C ! NELESS ! E ! D ! NOMBRE D'ELTS DU MAILLAGE SURF SOLIDE ! C ! NDMASS ! E ! D ! NOMBRE DE NOEUDS DES ELTS SURF SOLIDES ! C ! NELEUS ! E ! D ! NBRE D'ELTS DU MAILLAGE SURF SOLIDE AVEC FLUX! C ! NELEPR ! E ! D ! NBRE D'ELTS DU MAIL VOL SOLIDE PERIODIQUE ! C ! NBRESS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC CL RESI CONTACT! C ! NBRAYS ! E ! D ! NOMBRE DE NOEUDS SOLIDES AVEC RAYONNEMENT ! C ! NBPRIO ! E ! D ! NOMBRE DE NOEUDS SOLIDES PERIODIQUES ! C ! NBMOBS ! E ! D ! NOMBRE DE NOEUDS EN MOUVEMENT ! C ! NBPHYS ! E ! D ! NOMBRE DE VARIABLES PHYSIQUES SUR LE SOLIDE ! C ! NCOEMA ! E ! D ! NOMBRE DE COEF EXTRA DIAGONAUX DES MAT ELEM ! C ! NBICOR ! E ! D ! NOMBRE D'INFO SUR LES CORRSPONDANTS (1 ou 2) ! C ! NODESF ! TE ! R ! TABLEAU DE CONNECTIVITE MAILLAGE SURF FLUIDE ! C ! NCOUPF ! TE ! R ! NUMEROS GLOBAUX DES NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR ! M ! VALEURS DE LA CL ENTRE FLUIDE ET SOLIDE ! C ! NCOUPS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS SOLIDES COUPLES ! C ! NFLUSS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC CL FLUX ! C ! NDIRS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC CL DIRICHLET ! C ! NECHS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC CL COEFF ECH ! C ! NFLUVS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOLUM ! C ! NMOBIL ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS EN MOUVEMENT ! C ! VRESCS ! TR ! M ! VALEURS DE LA CL DE TYPE RESIST DE CONTACT ! C ! VRAYTS ! TR ! M ! VALEURS DE LA CL DE TYPE RAYONNEMENT ! C ! NFFLUS ! TE ! D ! No de facette flux ---> face glob ! C ! VFFLUS ! TR ! D ! Valeur des flux a chaque point de la face ! C ! NBFFLU ! E ! D ! Nombre de facette de type flux ! C ! NFECHS ! TE ! D ! No de facette echange ---> face glob ! C ! VFECHS ! TR ! D ! Valeur des echan aux points de la face ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRESC ! TE ! D ! No de facette resistance ---> face glob ! C ! VFRESC ! TR ! D ! Valeur des resista aux points de la face ! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NFRAYS ! TE ! D ! No de facette rayonnement ---> face glob ! C ! VFRAYS ! TR ! D ! Valeur du rayo aux points de la face ! C ! NELERA ! E ! D ! Nombre de facette de type rayonnement ! C ! NFCOUS ! TE ! D ! No de facette couplee ---> face glob ! C ! VFCOUS ! TR ! D ! Valeur du couplage aux points de la face ! C ! NELESS ! E ! D ! Nombre de facette de type couplee ! C ! NREFS ! TR ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NODES ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SOLIDE ! C ! NODESS ! TE ! D ! TABLEAU DE CONNECTIVITE MAILLAGE SURF SOLIDE ! C ! NODEUS ! TE ! D ! CONNECTIVITE NOEUDS AVEC CL TYPE FLUX (SOL) ! C ! NODERC ! TE ! M ! CONNECTIVITE NOEUDS AVEC CL TYPE RES CONTACT ! C ! NCBORS ! TE ! M ! NUMERO DE L'ELEMENT FLUIDE CORRESPONDANT ! C ! NCBORF ! TE ! M ! NUMERO DE L'ELEMENT SOLIDE CORRESPONDANT ! C ! BARYS ! TR ! M ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! SOLIDES DANS LES ELEMENTS FLUIDES ! C ! BARYF ! TR ! M ! COORD BARY DES CORRESPONDANTS DES NOEUDS ! C ! ! ! ! FLUIDES DANS LES ELEMENTS SOLIDES ! C ! PHYSOL ! TR ! M ! PROPRIETES PHYSIQUES DU SOLIDE ! C ! TMPSA ! TR ! M ! TEMPERATURE DANS LE SOLIDE ETAPE n ! C ! TMPS ! TR ! M ! TEMPERATURE DANS LE SOLIDE ETAPE n+1 ! C ! TMPSC1 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 1 ! C ! TMPSC2 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 2 ! C ! TMPSC3 ! TR ! M ! MODELE COQUE : TEMPERATURE COMPOSANTE 3 ! C ! VOLUME ! TR ! R ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! SURFUS ! TR ! R ! EN 3D SURFACE DU TRIANGLE DE BORD (flux) ! C ! ! ! ! EN 2D LONGUEUR DU SEGMENT DE BORD (flux) ! C ! B ! TR ! M ! Seccond membrede l'equation ! C ! DMAT ! TR ! M ! Diagonale de la matrice complete (mass+diff) ! C ! XMAT ! TR ! M ! Termes extra-diagonaux de la mat de diffusion! C ! DIAG ! TR ! M ! Diagonale inverse de la mat complete ! C !TRAV1-TRAV4! TR ! A ! TABLEAUX DE TRAVAIL ! C ! WCT ! TR ! A ! TABLEAUX DE TRAVAIL ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C !___________!____!____!______________________________________________! C C TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C L (LOGIQUE) .. ET TYPES COMPOSES (EX : TR TABLEAU REEL) C MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (AUXILIAIRE MODIFIE) C----------------------------------------------------------------------- C SOUS PROGRAMME APPELANT : C C SOUS PROGRAMME(S) APPELE(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "mobil.h" #include "divct.h" #include "nlofes.h" #include "nlofct.h" #include "syrthu.h" #include "bilan.h" C C ********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NBCOUF,NELESF,NDMASF,NBFACE INTEGER NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL INTEGER NPOINS,NELEMS,NDMATS INTEGER NELESS,NELEUS,NDMASS,NELERC,NELEPR,NBRESS INTEGER NBPRIO,NBCOPR,NBMOBS INTEGER NBPHYS,NPPEL,NPOUE,NCOEMA,NBICOR INTEGER NBFFLU,NBFECH INTEGER NFFLUS(NBFFLU),NFECHS(NBFECH),NFRESC(NELERC) INTEGER NFCOUS(NELESS) C INTEGER NBRAYS,NBRAIS INTEGER NELERA,NBFRAI INTEGER NFRAYS(NELERA),NFRAIS(NBFRAI) INTEGER NRAYTS(NBRAYS),NRAYIS(NBRAIS) C INTEGER NCOUPF(NBCOUF,2),NODESF(NELESF,NDMASF) INTEGER NCOUPS(NBCOUS),NFLUSS(NBFLUS),NDIRS(NBDIRS) INTEGER NECHS(NBECHS),NFLUVS(NBFLVS),NRESCS(NBRESS,2) INTEGER NPRIOS(NBPRIO,1+NBCOPR),NMOBIL(NBMOBS,2) INTEGER NREFAC(NELEMS,NBFACE),NREFAL(NELEUS) INTEGER NREFS(NPOINS),NREFE(NELEMS),NODES(NELEMS,NDMATS) INTEGER NODESS(NELESS,NDMASS), NODEUS(NELEUS,NDMASS) INTEGER NODEPR(NELEPR,NDMATS+1),NODERC(NELERC,NDMASS) INTEGER NCBORS(NBCOUS,NBICOR),NCBORF(NBCOUF,NBICOR) INTEGER NANGLE(NELEMS) C DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2) DOUBLE PRECISION VFCOUS(NELESS,NDMASS,2) C DOUBLE PRECISION VRAYTS(NBRAYS,2),VRAYIS(NBRAIS,2) DOUBLE PRECISION VFRAYS(NELERA,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) C DOUBLE PRECISION COORDF(NBCOUF,NDIM),VCOUPF(NBCOUF,2) DOUBLE PRECISION VCOUPS(NBCOUS,2),VFLUSS(NBFLUS),VDIRS(NBDIRS) DOUBLE PRECISION VECHS(NBECHS,2),VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION VRESCS(NBRESS,2) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION BARYF(NBCOUF,NDIM), BARYS(NBCOUS,NDIM) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS) DOUBLE PRECISION TMPSC1(NPOINS),TMPSC2(NPOINS),TMPSC3(NPOINS) DOUBLE PRECISION TMPSA(NPOINS), TMPS(NPOINS) DOUBLE PRECISION VOLUME(NELEMS),SURFUS(NELEUS) DOUBLE PRECISION B(NPOINS),DMAT(NPOINS),XMAT(NELEMS,NCOEMA) DOUBLE PRECISION DIAG(NPOINS),TMPMAX(NPOINS),TMPMIN(NPOINS) C C Tableaux de travail DOUBLE PRECISION TRAV1(NPOINS),TRAV2(NPOINS) DOUBLE PRECISION TRAV3(NPOINS),TRAV4(NPOINS) DOUBLE PRECISION TRAVF(NELEUS,NDMASS) DOUBLE PRECISION WCT(NELEMS,NDMATS) DOUBLE PRECISION TX,TY,TZ C C..Variables Internes INTEGER N,MODE,NG,NB,NUMA,NPMAX,NPMIN,NPTMAX,NPTMIN,ITMIN,ITMAX INTEGER I,NBSCAL DOUBLE PRECISION COEF,TMIN,TMAX,TTMIN,TTMAX,TTTMIN,TTTMAX LOGICAL LF C DATA NPTMAX /0/ DATA NPTMIN /0/ DATA TTMIN /1.e8/ DATA TTMAX /0./ DATA ITMIN /0/ DATA ITMAX /0/ DATA TTTMIN /0./ DATA TTTMAX /0./ C C*********************************************************************** C C C MISE A JOUR DE LA TEMPERATURE C ============================= C DO 111 N=1,NPOINS TMPSA(N) = TMPS(N) 111 CONTINUE C C C 0.- TRAITEMENT DES SOLIDES MOBILES C ================================== C IF (NBMOBS.GT.0) THEN C CALL MOBROT (NDIM,NPOINS,NBMOBS,NMOBIL,COORDS) C CALL MOBCOR (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NCOUPF,NBICOR) ENDIF C IF (LSDEPL) THEN C COEF = VTRMOB * RDTTS / TRNMOB TX = TRXMOB * COEF TY = TRYMOB * COEF TZ = TRZMOB * COEF C NUMA = -1 CALL MOBTRA (NUMA,NDIM,NPOINS,COORDS,TX,TY,TZ) C CALL MOBCOR (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NCOUPF,NBICOR) C CALL MOBTMX (NBCOUS,NBICOR,NCBORS,NCOUPS,NUMA) C Si NUMA=0 --> rien a faire, sinon decaler le maillage NUMA C IF (NUMA.NE.0) THEN CALL MOBTRA (NUMA,NDIM,NPOINS,COORDS, * -2.*TRXMOB,-2.*TRYMOB,-2.*TRZMOB) C CALL MOBTMP (NUMA,NDIM,NPOINS,TMPSA,TMPS) C CALL MOBCOR (NDIM,NPOINS,NELESS,NDMASS,NELESF,NDMASF, * NBCOUS,NBCOUF,COORDS,NODESS,COORDF,NODESF, * BARYF,NCBORF,BARYS,NCBORS,NCOUPS,NCOUPF, * NBICOR) C CALL CORESC (NDIM,NPOINS,NBRESS,NRESCS,COORDS) C CALL MOBRES (NPOINS,NBRESS,NRESCS,VRESCS,NREFS, * NODERC,NFRESC,VFRESC,NELERC,NDMASS, * NREFAL,NELEUS,TRAV1) ENDIF C ENDIF C C 1- MISE A JOUR DES PROPRIETES PHYSIQUES C ======================================= C CALL CPHYSO (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS, & NODES,NDMATS,TMPSA,TMPS, & PHYSOL,NPOUE,NPPEL,NBPHYS,VOLUME) C CALL FLUSHF(NFECRA) C C 2- MISE A JOUR DES FLUX VOLUMIQUES C ================================== C IF (NBFLVS.GT.0) & CALL CFLUVS (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS, & NODES,NDMATS,TMPSA,TMPS, & NBFLVS,NPFEL,NFLUVS,VFLUVS) C C 2.1- Mise em place d'une regulation thermique C ============================================= IF (NBFLVS.GT.0 .AND. LREGUL) * CALL REGUSY (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS, * NODES,NDMATS,TMPSA,TMPS, * NBFLVS,NPFEL,NFLUVS,VFLUVS, * PHYSOL,NPOUE,NPPEL,NBPHYS) C C 3- CALCUL DES CONDITIONS AUX LIMITES POUR LE SOLIDE C =================================================== C C C 3.0- MISE A JOUR DE LA "TEMPERATURE EXTERIEURE" POUR LES C RESISTANCES DE CONTACT C -------------------------------------------------------- IF (NBRESS.GT.0 .OR. NELERC.GT.0) & CALL LIMRES(NDIM,NPOINS,NBRESS,NRESCS,VRESCS, & NODERC,VFRESC,NELERC,NDMASS,TMPSA,TRAV1) C C C 3.1- MISE A JOUR DES CONDITIONS VARIABLES F(x,y,z,t,T) C ------------------------------------------------------ C IF (LCFACE) THEN CALL LIMFSO (NDIM,NPOINS,NELEMS,NDMATS, * NREFS,COORDS,NODES,TMPSA,TMPS, * NELEUS,NDMASS,NODEUS,NREFAL, * NBFFLU,NFFLUS,VFFLUS,NBDIRS,NDIRS,VDIRS, * NBFECH,NFECHS,VFECHS, * NBFRAI,NFRAIS,VFRAIS,NELERC,NFRESC,VFRESC) ELSE CALL LIMSOL (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES, & TMPSA,TMPS, & NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS, & NBECHS,NECHS,VECHS, & NBRAIS,NRAYIS,VRAYIS,NBRESS,NRESCS,VRESCS) ENDIF C CALL FLUSHF(NFECRA) C C 3.3- PASSAGE DU FLUX SUR LES POINTS CORRESPONDANTS DU SOLIDE C ------------------------------------------------------------ C IF (NBCOUS.GT.0) THEN MODE = 2 IF (LCOIN) THEN CALL PSFCOI (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,NCBORF,NCBORS) ELSE IF (NDIM .EQ. 2) THEN CALL PSFNC2 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ELSE CALL PSFNC3 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ENDIF ENDIF ENDIF C C C C 3.5- COND LIM PAR FACES : REMPLISSAGE DE VFCOUS C ----------------------------------------------- IF (NBCOUS.GT.0) THEN IF (LCFACE) & CALL PSSCLF (NBCOUS,VCOUPS,NELESS,NDMASS,VFCOUS,NODESS) ENDIF C CALL FLUSHF(NFECRA) C C 3.6- MISE A JOUR DES CL DANS LE CAS DES SOLIDES MOBILES C -------------------------------------------------------- IF (NBMOBS.GT.0 .OR. LSDEPL) & CALL MOBLIM (NDIM,NPOINS,NBCOUS,NBICOR, & NCOUPS,NCBORS,VCOUPS,NREFS,COORDS, & NODESS,VFCOUS,NELESS,NDMASS) C C C 4- RESOLUTION DE LA DIFFUSION SOLIDE C ==================================== C CALL DIFSOL (TMPS,TMPSA,B,DMAT,XMAT,PHYSOL, & COORDS,NODES,NODEUS,NFLUVS,VFLUVS,NDIRS,VDIRS, & NCOUPS,VCOUPS,NFLUSS,VFLUSS,NECHS,VECHS, & NODERC,NODEPR,NPRIOS,NRESCS,VRESCS, & NRAYTS,VRAYTS,NBRAYS, & NRAYIS,VRAYIS,NBRAIS, & VOLUME,SURFUS,DIAG, & NELEMS,NPOINS,NDIM,NDIELE,NDMATS,NDMASS,NCOEMA, & NPOUE,NPPEL,NBPHYS, & NELEUS,NELERC,NELEPR, & NBCOUS,NBFLUS,NBDIRS,NBECHS,NBFLVS,NPFEL,NBRESS, & NBPRIO,NBCOPR, & NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, & NFRESC,VFRESC, & NFRAYS,VFRAYS,NELERA, & NFRAIS,VFRAIS,NBFRAI, & NFCOUS,VFCOUS,NELESS,NANGLE,TRAVF, & TRAV1,TRAV2,TRAV3,TRAV4,WCT) C C C C 5- ECRITURES SUR LA PEAU DU FLUIDE (avant de les ecraser) C ========================================================= IF (NCHROS.GE.1 .AND. LCHROF .AND. * (MOD ((NTSYR-NTSYRD),NCHROS).EQ.0 .OR. * (MOD ((NTSYR-NTSYRD),NCHROS).NE.0 .AND. * (LDERN.OR.LSTOPS) )) ) THEN NBSCAL=2 CALL ECRG2E(NBSCAL,NFCFCT,NDIM,NDIM-1,NELESF,NBCOUF) CALL ECRG3E(NFCFCT) CALL ECRG2R(VCOUPF(1,1),NBCOUF,'T_PEAU_FLUID','3',NFCFCT) CALL ECRG2R(VCOUPF(1,2),NBCOUF,'COEF_ECHANGE','3',NFCFCT) ENDIF C IF ((LDERN.OR.LSTOPS) .AND. LRESUF) THEN CALL ECRG3E(NFRFCT) CALL ECRG2R(VCOUPF(1,1),NBCOUF,'T_PEAU_FLUID','3',NFRFCT) CALL ECRG2R(VCOUPF(1,2),NBCOUF,'COEF_ECHANGE','3',NFRFCT) ENDIF C C C 6- PASSAGE DE LA TEMPERATURE DU SOLIDE VERS LE FLUIDE C ===================================================== C DO 611 N=1,NBCOUS NG = NCOUPS(N) VCOUPS(N,1) = TMPS(NG) 611 CONTINUE C IF (NBCOUS.GT.0) THEN MODE = 1 IF (LCOIN) THEN CALL PSFCOI (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,NCBORF,NCBORS) ELSE IF (NDIM .EQ. 2) THEN CALL PSFNC2 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ELSE CALL PSFNC3 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ENDIF ENDIF ENDIF C C C Temperature max C --------------- IF (LTMAX) THEN DO N=1,NPOINS IF (TMPS(N).GT.TMPMAX(N)) TMPMAX(N)=TMPS(N) IF (TMPS(N).LT.TMPMIN(N)) TMPMIN(N)=TMPS(N) ENDDO ENDIF C 1- Ecriture sur fichiers chronologiques C ======================================== LF = LCFACE C IF (NCHROS.GE.1 .AND. * (MOD ((NTSYR-NTSYRD),NCHROS).EQ.0 .OR. * (MOD ((NTSYR-NTSYRD),NCHROS).NE.0 .AND. * (LDERN.OR.LSTOPS) )) ) THEN C NBSCAL=1 IF (LTMAX) NBSCAL = NBSCAL+2 CALL ECRG2E(NBSCAL,NFGCCT,NDIM,NDIELE,NELEMS,NPOINS) CALL ECRG3E(NFGCCT) CALL ECRG2R(TMPS,NPOINS,'TEMP_SOLIDE ','3',NFGCCT) IF (LTMAX) THEN CALL ECRG2R(TMPMIN,NPOINS,'TEMP_MIN ','3',NFGCCT) CALL ECRG2R(TMPMAX,NPOINS,'TEMP_MAX ','3',NFGCCT) ENDIF CALL FLUSHF(NFGCCT) C ENDIF C C 2- Ecriture sur fichier resultat C ================================ IF (LDERN.OR.LSTOPS) THEN CALL ECRG3E(NFGRCT) CALL ECRG2R(TMPS,NPOINS,'TEMP_SOLIDE ','3',NFGRCT) IF (LTMAX) THEN CALL ECRG2R(TMPMIN,NPOINS,'TEMP_MIN ','3',NFGRCT) CALL ECRG2R(TMPMAX,NPOINS,'TEMP_MAX ','3',NFGRCT) ENDIF ENDIF C C C 3- ECRITURE DES HISTORIQUES EN TEMPS C ==================================== IF (LHISOL .AND. (TEMPSS - THISSO .GE. XFREQS) ) THEN THISSO = THISSO + XFREQS CALL WHISOL (NDIM,NPOINS,COORDS,TMPSA,TMPS) ENDIF C C 4- MIN-MAX DU CHAMP C =================== C TMIN=1.e8 TMAX=-273. NPMIN=0 NPMAX=0 DO N=1,NPOINS IF (TMPS(N).GT.TMAX) THEN TMAX=TMPS(N) NPMAX=N ENDIF IF (TMPS(N).LT.TMIN) THEN TMIN=TMPS(N) NPMIN=N ENDIF ENDDO WRITE(NFECRA,5000) TMIN,NPMIN,TMAX,NPMAX IF (TMAX.GT.TTMAX) THEN TTMAX=TMAX ITMAX=NTSYR TTTMAX=TEMPSS NPTMAX=NPMAX ENDIF IF (TMIN.LT.TTMIN) THEN TTMIN=TMIN ITMIN=NTSYR TTTMIN=TEMPSS NPTMIN=NPMIN ENDIF IF (LDERN) THEN IF (NDIM.EQ.2) THEN WRITE(NFECRA,5010) * TTMIN,TTTMIN,ITMIN,NPTMIN, * COORDS(NPTMIN,1),COORDS(NPTMIN,2), * TTMAX,TTTMAX,ITMAX,NPTMAX, * COORDS(NPTMAX,1),COORDS(NPTMAX,2) ELSE WRITE(NFECRA,5011) * TTMIN,TTTMIN,ITMIN,NPTMIN, * COORDS(NPTMIN,1),COORDS(NPTMIN,2),COORDS(NPTMIN,3), * TTMAX,TTTMAX,ITMAX,NPTMAX, * COORDS(NPTMAX,1),COORDS(NPTMAX,2),COORDS(NPTMAX,3) ENDIF ENDIF C C C 5- BILANS DU FLUX C ================= IF (NBILAS.GT.0) THEN CALL BILFLU (NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * TMPSA,NODEUS,SURFUS, * NPOINS,NDIM,NELEUS,NDMASS,NREFAL,COORDS) ENDIF IF (NBILAV.GT.0) THEN CALL BILFLV (NREFE,NELEMS,NBFLVS,NPFEL,NFLUVS,VFLUVS,VOLUME, * NPOINS,NDIM,COORDS,NDMATS,NODES) ENDIF C C 6- UTILISATEUR C ============== CALL AFAIRE ( NFFLUS,VFFLUS,NBFFLU,NFECHS,VFECHS,NBFECH, * NFRESC,VFRESC,NELERC, * NFRAYS,VFRAYS,NELERA, * NFRAIS,VFRAIS,NBFRAI, * NFCOUS,VFCOUS,NELESS, * NFLUVS,VFLUVS,NBFLVS,NPFEL, * TMPSA,NODEUS,SURFUS,VOLUME, * NPOINS,NDIM,NELEUS,NDMASS,NREFAL,COORDS, * NREFE,NELEMS,NDMATS,NODES,NODESS) C C-------- C FORMATS C-------- C 4000 FORMAT(/,'IL Y A UNE INCOHERENCE ENTRE : ',/, * 'TRAITEMENT PAR FACE OU NOEUD ET LA ', * 'DEFINITION DES PROPRIETES PHYSIQUES',I2) 5000 FORMAT(/,' -> Temperature min :',F12.5,' noeud ',I8, * ' -- Temperature max :',F12.5,' noeud ',I8) 5010 FORMAT(//,78('='),//, * 5X,'Temperature minimale atteinte : ',F12.5,/, * 5X,' - au temps : ',E12.5,/, * 5X,' - a l''iteration : ',I12,/, * 5X,' - au noeud : ',I12,/, * 5X,' - coordonnees : ',2(F12.5,1X),//, * 5X,'Temperature maximale atteinte : ',F12.5,/, * 5X,' - au temps : ',E12.5,/, * 5X,' - a l''iteration : ',I12,/, * 5X,' - au noeud : ',I12,/, * 5X,' - coordonnees : ',2(F12.5,1X)) 5011 FORMAT(//,78('='),//, * 5X,'Temperature minimale atteinte : ',F12.5,/, * 5X,' - au temps : ',E12.5,/, * 5X,' - a l''iteration : ',I12,/, * 5X,' - au noeud : ',I12,/, * 5X,' - coordonnees : ',3(F12.5,1X),//, * 5X,'Temperature maximale atteinte : ',F12.5,/, * 5X,' - au temps : ',E12.5,/, * 5X,' - a l''iteration : ',I12,/, * 5X,' - au noeud : ',I12,/, * 5X,' - coordonnees : ',3(F12.5,1X)) C C---- C FIN C---- C END syrthes-3.4.3-dfsg1/src/s/smfvos.F0000666000175000017500000005470211524070645015401 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SMFVOS,SSI=0 C SUBROUTINE SMFVOS C ***************** C C ---------------------------------------------------- *( NFLUVS,VFLUVS,B,NODES,VOLUME,COORDS, * NELEMS,NPOINS,NDMATS,NDIM,NBFLVS,NPFEL,NDIELE, * TRAV,WCT ) C ---------------------------------------------------- C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C --------- CALCUL DU SECOND MEMBRE * C PARTIE FLUX VOLUMIQUE * C * C Le flux est discretise en iso P2 * C ce qui revient a * C * C / * C B = B + / ( FLUX PHI . PHI ) dV * C i i / j j i * C * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .___________.______._______________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !___________!______!____!__________________________________________! C ! NFLUVS ! TR ! D ! NOEUD FLUX VOLUMIQUE LOCAL --> GLOBAL ! C ! VFLUVS ! TR ! D ! VALEUR DU FLUX VOLUMIQUE AU NOEUD ! C ! B ! TR ! M ! SECOND MEMBRE (Partie explicite ! C ! NODES ! TE ! D ! CORRESPONDANCE NOEUDS LOCAUX GLOBAUX ! C ! VOLUME ! TR ! D ! SURFACE DU TRIANGLE EN 2D ! C ! ! ! ! VOLUME DU TETRAEDRE EN 3D ! C ! TRAV ! TR ! M ! TABLEAU DE TRAVAIL (Taille: NPOINS) ! C ! W1...W10! TR ! M ! TABLEAUX DE TRAVAIL (Taille: NELMXS ) ! C !___________!______!____!__________________________________________! C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : ???? C ???? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : ???? C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" C C*********************************************************************** C C..Variables externes INTEGER NPOINS,NELEMS,NDMATS,NBFLVS,NPFEL,NDIM,NDIELE INTEGER NFLUVS(NBFLVS),NODES(NELEMS,NDMATS) C DOUBLE PRECISION B(NPOINS),COORDS(NPOINS,NDIM) DOUBLE PRECISION TRAV(NPOINS),VOLUME(NELEMS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) DOUBLE PRECISION WCT(NELEMS,NDMATS) C C..Variables internes DOUBLE PRECISION ZERO DOUBLE PRECISION R1,R2,R3 DOUBLE PRECISION S48,SV48,S160,SV160,S480,SV480 DOUBLE PRECISION F1,F2,F3,F4,F5,F6,F7,F8,F9,F10 INTEGER N1,N2,N3,N4,N5,N6,N7,N8,N9,N10 INTEGER I,IFLV,NCA LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .TRUE. ZERO = 0.D0 IF (IAXISY.EQ.1) THEN NCA=2 ELSE NCA=1 ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) C S48 = 1.D0 / 48.D0 S160 = 1.D0 / 160.D0 S480 = 1.D0 / 480.D0 C CALL OV('X=C ',WCT,TRAV,TRAV,ZERO,NELEMS*NDMATS) C C 2- PRISE EN COMPTE DU FLUX VOLUMIQUE PAR NOEUD C ============================================== IF(NDFLUV.EQ.1) THEN C On stocke toutes les informations sur le flux dans un vecteur DO 210 I=1,NBFLVS TRAV(NFLUVS(I)) = VFLUVS(I,1) 210 CONTINUE C C C 3- CALCUL DU VECTEUR ELEMENTAIRE C ================================ C 3.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 3.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 311 I=1,NELEMS C C Calcul des indices globaux N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C SV48 = S48 * VOLUME(I) C C F1 = TRAV(N1) * SV48 F2 = TRAV(N2) * SV48 F3 = TRAV(N3) * SV48 F4 = TRAV(N4) * SV48 F5 = TRAV(N5) * SV48 F6 = TRAV(N6) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 311 CONTINUE C C 3.1.2- Cas axisymetrique C ------------------------ ELSE C DO 312 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) C C SV480 = S480 * VOLUME(I) C C l'axe Y est pris comme coordonne radiale C l'axe X est pris comme axe de rotation R1 = ABS( COORDS(N1,NCA) ) * SV480 R2 = ABS( COORDS(N2,NCA) ) * SV480 R3 = ABS( COORDS(N3,NCA) ) * SV480 C F1 = TRAV(N1) F2 = TRAV(N2) F3 = TRAV(N3) F4 = TRAV(N4) F5 = TRAV(N5) F6 = TRAV(N6) C C WCT(I,1) = F1 * ( 16*R1 + 2*R2 + 2*R3 ) & +F4 * ( 7*R1 + 2*R2 + R3 ) & +F6 * ( 7*R1 + R2 + 2*R3 ) WCT(I,2) = F2 * ( 2*R1 + 16*R2 + 2*R3 ) & +F4 * ( 2*R1 + 7 *R2 + R3 ) & +F5 * ( R1 + 7*R2 + 2*R3 ) WCT(I,3) = F3 * ( 2*R1 + 2*R2 + 16*R3 ) & +F5 * ( R1 + 2*R2 + 7*R3 ) & +F6 * ( 2*R1 + R2 + 7*R3 ) WCT(I,4) = F1 * ( 7*R1 + 2*R2 + R3 ) & +F2 * ( 2*R1 + 7*R2 + R3 ) & +F4 * ( 26*R1 + 26*R2 + 8*R3 ) & +F5 * ( 5*R1 + 10*R2 +5*R3 ) & +F6 * ( 10*R1 + 5*R2 + 5*R3 ) WCT(I,5) = F2 * ( R1 + 7*R2 + 2*R3 ) & +F3 * ( R1 + 2*R2 + 7*R3 ) & +F4 * ( 5*R1 + 10*R2 + 5*R3 ) & +F5 * ( 8*R1 + 26*R2 + 26*R3 ) & +F6 * ( 5*R1 + 5*R2 + 10*R3 ) WCT(I,6) = F1 * ( 7*R1 + R2 + 2*R3 ) & +F3 * ( 2*R1 + R2 + 7*R3 ) & +F4 * ( 10*R1 + 5*R2 + 5*R3 ) & +F5 * ( 5*R1 + 5*R2 + 10*R3 ) & +F6 * ( 26*R1 + 8*R2 + 26*R3 ) C 312 CONTINUE C ENDIF C C 3.2- Cas 3D C ----------- ELSE C DO 320 I=1,NELEMS C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) N4 = NODES(I,4) N5 = NODES(I,5) N6 = NODES(I,6) N7 = NODES(I,7) N8 = NODES(I,8) N9 = NODES(I,9) N10 = NODES(I,10) C SV160 = S160 * VOLUME(I) C F1 = TRAV(N1) * SV160 F2 = TRAV(N2) * SV160 F3 = TRAV(N3) * SV160 F4 = TRAV(N4) * SV160 F5 = TRAV(N5) * SV160 F6 = TRAV(N6) * SV160 F7 = TRAV(N7) * SV160 F8 = TRAV(N8) * SV160 F9 = TRAV(N9) * SV160 F10 = TRAV(N10) * SV160 C C WCT(I,1) = 2 * F1 + F5 + F7 + F8 WCT(I,2) = 2 * F2 + F5 + F6 + F9 WCT(I,3) = 2 * F3 + F6 + F7 + F10 WCT(I,4) = 2 * F4 + F8 + F9 + F10 WCT(I,5) = F1 + F2 + 8 * F5 + 3 * F6 + 2 * F7 & + 3 * F8 + 2 * F9 WCT(I,6) = F2 + F3 + 3 * F5 + 12 * F6 + 3 * F7 & + 4 * F8 + 3 * F9 + 3 * F10 WCT(I,7) = F1 + F3 + 2 * F5 + 3 * F6 + 8 * F7 & + 3 * F8 + 2 * F10 WCT(I,8) = F1 + F4 + 3 * F5 + 4 * F6 + 3 * F7 & + 12 * F8 + 3 * F9 + 3 * F10 WCT(I,9) = F2 + F4 + 2 * F5 + 3 * F6 + 3 * F8 & + 8 * F9 + 2 * F10 WCT(I,10) = F3 + F4 + 3 * F6 + 2 * F7 + 3 * F8 & + 2 * F9 + 8 * F10 C 320 CONTINUE C C Fin du cas 3D ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) CALL ASSEMB ( TRAV,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C ELSEIF(NDFLUV.EQ.2) THEN C 4- PRISE EN COMPTE DU FLUX VOLUMIQUE CONSTANT PAR ELEMENT C ========================================================= C 4.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 4.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 411 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV48 = S48 * VOLUME(I) C C F1 = VFLUVS(IFLV,1) * SV48 F2 = VFLUVS(IFLV,1) * SV48 F3 = VFLUVS(IFLV,1) * SV48 F4 = VFLUVS(IFLV,1) * SV48 F5 = VFLUVS(IFLV,1) * SV48 F6 = VFLUVS(IFLV,1) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 411 CONTINUE C C 4.1.2- Cas axisymetrique C ------------------------ ELSE C DO 412 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV480 = S480 * VOLUME(I) C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) C R1 = ABS( COORDS(N1,NCA) ) * SV480 R2 = ABS( COORDS(N2,NCA) ) * SV480 R3 = ABS( COORDS(N3,NCA) ) * SV480 C F1 = VFLUVS(IFLV,1) F2 = VFLUVS(IFLV,1) F3 = VFLUVS(IFLV,1) F4 = VFLUVS(IFLV,1) F5 = VFLUVS(IFLV,1) F6 = VFLUVS(IFLV,1) C C WCT(I,1) = F1 * ( 16*R1 + 2*R2 + 2*R3 ) & +F4 * ( 7*R1 + 2*R2 + R3 ) & +F6 * ( 7*R1 + R2 + 2*R3 ) WCT(I,2) = F2 * ( 2*R1 + 16*R2 + 2*R3 ) & +F4 * ( 2*R1 + 7 *R2 + R3 ) & +F5 * ( R1 + 7*R2 + 2*R3 ) WCT(I,3) = F3 * ( 2*R1 + 2*R2 + 16*R3 ) & +F5 * ( R1 + 2*R2 + 7*R3 ) & +F6 * ( 2*R1 + R2 + 7*R3 ) WCT(I,4) = F1 * ( 7*R1 + 2*R2 + R3 ) & +F2 * ( 2*R1 + 7*R2 + R3 ) & +F4 * ( 26*R1 + 26*R2 + 8*R3 ) & +F5 * ( 5*R1 + 10*R2 +5*R3 ) & +F6 * ( 10*R1 + 5*R2 + 5*R3 ) WCT(I,5) = F2 * ( R1 + 7*R2 + 2*R3 ) & +F3 * ( R1 + 2*R2 + 7*R3 ) & +F4 * ( 5*R1 + 10*R2 + 5*R3 ) & +F5 * ( 8*R1 + 26*R2 + 26*R3 ) & +F6 * ( 5*R1 + 5*R2 + 10*R3 ) WCT(I,6) = F1 * ( 7*R1 + R2 + 2*R3 ) & +F3 * ( 2*R1 + R2 + 7*R3 ) & +F4 * ( 10*R1 + 5*R2 + 5*R3 ) & +F5 * ( 5*R1 + 5*R2 + 10*R3 ) & +F6 * ( 26*R1 + 8*R2 + 26*R3 ) C 412 CONTINUE C ENDIF C C 4.2- Cas 3D C ----------- ELSE C DO 420 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV160 = S160 * VOLUME(I) C F1 = VFLUVS(IFLV,1) * SV160 F2 = VFLUVS(IFLV,1) * SV160 F3 = VFLUVS(IFLV,1) * SV160 F4 = VFLUVS(IFLV,1) * SV160 F5 = VFLUVS(IFLV,1) * SV160 F6 = VFLUVS(IFLV,1) * SV160 F7 = VFLUVS(IFLV,1) * SV160 F8 = VFLUVS(IFLV,1) * SV160 F9 = VFLUVS(IFLV,1) * SV160 F10 = VFLUVS(IFLV,1) * SV160 C C WCT(I,1) = 2 * F1 + F5 + F7 + F8 WCT(I,2) = 2 * F2 + F5 + F6 + F9 WCT(I,3) = 2 * F3 + F6 + F7 + F10 WCT(I,4) = 2 * F4 + F8 + F9 + F10 WCT(I,5) = F1 + F2 + 8 * F5 + 3 * F6 + 2 * F7 & + 3 * F8 + 2 * F9 WCT(I,6) = F2 + F3 + 3 * F5 + 12 * F6 + 3 * F7 & + 4 * F8 + 3 * F9 + 3 * F10 WCT(I,7) = F1 + F3 + 2 * F5 + 3 * F6 + 8 * F7 & + 3 * F8 + 2 * F10 WCT(I,8) = F1 + F4 + 3 * F5 + 4 * F6 + 3 * F7 & + 12 * F8 + 3 * F9 + 3 * F10 WCT(I,9) = F2 + F4 + 2 * F5 + 3 * F6 + 3 * F8 & + 8 * F9 + 2 * F10 WCT(I,10) = F3 + F4 + 3 * F6 + 2 * F7 + 3 * F8 & + 2 * F9 + 8 * F10 C 420 CONTINUE C C Fin du cas 3D ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) CALL ASSEMB ( TRAV,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C ELSE C 5- PRISE EN COMPTE DU FLUX VOLUMIQUE PAR NOEUD PAR ELEMENT C ========================================================== C 5.1- Cas 2D C ----------- IF ( NDIM .EQ. 2 ) THEN C C 5.1.1- Cas cartesien C -------------------- IF (IAXISY.EQ.0) THEN C DO 511 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV48 = S48 * VOLUME(I) C F1 = VFLUVS(IFLV,1) * SV48 F2 = VFLUVS(IFLV,2) * SV48 F3 = VFLUVS(IFLV,3) * SV48 F4 = VFLUVS(IFLV,4) * SV48 F5 = VFLUVS(IFLV,5) * SV48 F6 = VFLUVS(IFLV,6) * SV48 C C WCT(I,1) = 2 * F1 + F4 + F6 WCT(I,2) = 2 * F2 + F4 + F5 WCT(I,3) = 2 * F3 + F5 + F6 WCT(I,4) = F1 + F2 + 6 * F4 + 2 * F5 + 2 * F6 WCT(I,5) = F2 + F3 + 2 * F4 + 6 * F5 + 2 * F6 WCT(I,6) = F1 + F3 + 2 * F4 + 2 * F5 + 6 * F6 C 511 CONTINUE C C 5.1.2- Cas axisymetrique C ------------------------ ELSE C DO 512 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV480 = S480 * VOLUME(I) C N1 = NODES(I,1) N2 = NODES(I,2) N3 = NODES(I,3) C C l'axe Y est pris comme coordonne radiale C l'axe X est pris comme axe de rotation R1 = ABS( COORDS(N1,NCA) ) * SV480 R2 = ABS( COORDS(N2,NCA) ) * SV480 R3 = ABS( COORDS(N3,NCA) ) * SV480 C F1 = VFLUVS(IFLV,1) F2 = VFLUVS(IFLV,2) F3 = VFLUVS(IFLV,3) F4 = VFLUVS(IFLV,4) F5 = VFLUVS(IFLV,5) F6 = VFLUVS(IFLV,6) C C WCT(I,1) = F1 * ( 16*R1 + 2*R2 + 2*R3 ) & +F4 * ( 7*R1 + 2*R2 + R3 ) & +F6 * ( 7*R1 + R2 + 2*R3 ) WCT(I,2) = F2 * ( 2*R1 + 16*R2 + 2*R3 ) & +F4 * ( 2*R1 + 7 *R2 + R3 ) & +F5 * ( R1 + 7*R2 + 2*R3 ) WCT(I,3) = F3 * ( 2*R1 + 2*R2 + 16*R3 ) & +F5 * ( R1 + 2*R2 + 7*R3 ) & +F6 * ( 2*R1 + R2 + 7*R3 ) WCT(I,4) = F1 * ( 7*R1 + 2*R2 + R3 ) & +F2 * ( 2*R1 + 7*R2 + R3 ) & +F4 * ( 26*R1 + 26*R2 + 8*R3 ) & +F5 * ( 5*R1 + 10*R2 +5*R3 ) & +F6 * ( 10*R1 + 5*R2 + 5*R3 ) WCT(I,5) = F2 * ( R1 + 7*R2 + 2*R3 ) & +F3 * ( R1 + 2*R2 + 7*R3 ) & +F4 * ( 5*R1 + 10*R2 + 5*R3 ) & +F5 * ( 8*R1 + 26*R2 + 26*R3 ) & +F6 * ( 5*R1 + 5*R2 + 10*R3 ) WCT(I,6) = F1 * ( 7*R1 + R2 + 2*R3 ) & +F3 * ( 2*R1 + R2 + 7*R3 ) & +F4 * ( 10*R1 + 5*R2 + 5*R3 ) & +F5 * ( 5*R1 + 5*R2 + 10*R3 ) & +F6 * ( 26*R1 + 8*R2 + 26*R3 ) C 512 CONTINUE C ENDIF C C 5.2- Cas 3D C ----------- ELSE C DO 520 IFLV=1,NBFLVS C I = NFLUVS(IFLV) C SV160 = S160 * VOLUME(I) C F1 = VFLUVS(IFLV,1) * SV160 F2 = VFLUVS(IFLV,2) * SV160 F3 = VFLUVS(IFLV,3) * SV160 F4 = VFLUVS(IFLV,4) * SV160 F5 = VFLUVS(IFLV,5) * SV160 F6 = VFLUVS(IFLV,6) * SV160 F7 = VFLUVS(IFLV,7) * SV160 F8 = VFLUVS(IFLV,8) * SV160 F9 = VFLUVS(IFLV,9) * SV160 F10 = VFLUVS(IFLV,10) * SV160 C C WCT(I,1) = 2 * F1 + F5 + F7 + F8 WCT(I,2) = 2 * F2 + F5 + F6 + F9 WCT(I,3) = 2 * F3 + F6 + F7 + F10 WCT(I,4) = 2 * F4 + F8 + F9 + F10 WCT(I,5) = F1 + F2 + 8 * F5 + 3 * F6 + 2 * F7 & + 3 * F8 + 2 * F9 WCT(I,6) = F2 + F3 + 3 * F5 + 12 * F6 + 3 * F7 & + 4 * F8 + 3 * F9 + 3 * F10 WCT(I,7) = F1 + F3 + 2 * F5 + 3 * F6 + 8 * F7 & + 3 * F8 + 2 * F10 WCT(I,8) = F1 + F4 + 3 * F5 + 4 * F6 + 3 * F7 & + 12 * F8 + 3 * F9 + 3 * F10 WCT(I,9) = F2 + F4 + 2 * F5 + 3 * F6 + 3 * F8 & + 8 * F9 + 2 * F10 WCT(I,10) = F3 + F4 + 3 * F6 + 2 * F7 + 3 * F8 & + 2 * F9 + 8 * F10 C 520 CONTINUE C C Fin du cas 3D ENDIF C CALL OV ( 'X=C ',TRAV,TRAV,TRAV,ZERO,NPOINS ) CALL ASSEMB ( TRAV,NODES,NELEMS,NDIELE,NPOINS,NDMATS,WCT ) C ENDIF C C C 6- MISE A JOUR DU SECOND MEMBRE C =============================== C DO 600 I=1,NPOINS B(I) = B(I) + TRAV(I) 600 CONTINUE C END syrthes-3.4.3-dfsg1/src/s/envoif.F0000666000175000017500000000764211524070645015353 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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----------------------------------------------------------------------- SUBROUTINE ENVOIF C ***************** C * (SUIT) C C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C SOUS-PROGRAMME PRINCIPAL DE SYRTHES C C----------------------------------------------------------------------- C ARGUMENTS C .________________.____.______________________________________________. C ! NOM !MODE! ROLE ! C !________________!____!______________________________________________! C .________________.____.______________________________________________. C COMMONS C .________________.____.______________________________________________. C ! ! ! TOUS LES COMMONS SONT PRESENTS ICI ! C !________________!____!______________________________________________! C MODE:-->ENTREE,<--RESULTAT,<-->DONNEE MODIFIEE,--TABLEAU DE TRAVAIL C----------------------------------------------------------------------- C - SOUS PROGRAMME(S) APPELANT(S) : C - SOUS PROGRAMME(S) APPELE(S) : C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C #include "optct.h" C C*********************************************************************** C INTEGER SUIT C C*********************************************************************** C LSUISO=.FALSE. IF (SUIT.NE.0) LSUISO=.TRUE. C END syrthes-3.4.3-dfsg1/src/s/souseg.F0000666000175000017500000001112311524070645015357 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=SOUSEG,SSI=0 SUBROUTINE SOUSEG C ***************** C C -------------------------- * (XX,YY,XA,YA,XB,YB,NUMSEG) C -------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C RECHERCHE DU SOUS SEGMENT (iso P2) DANS LEQUEL SE TROUVE * C LE POINT XX,YY * C (DIMENSION 2) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! XX,YY ! R ! D ! POINT DONT CHERCHE LA POSITION ! C ! XA,YA ! R ! D ! COORDONNEES DU 1ER SOMMET DU SEGMENT (solide)! C ! XB,YB ! R ! D ! COORDONNEES DU 2EME SOMMET DU SEGMENT(solide)! C ! NUMSEG ! E ! R ! NUMERO DU SOUS SEGMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : CORFS2 C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C C*********************************************************************** C INTEGER NUMSEG C DOUBLE PRECISION XA,YA,XB,YB,XAB,YAB DOUBLE PRECISION ABN,XE1,YE1 DOUBLE PRECISION XXNEW,XANEW,XBNEW DOUBLE PRECISION XX,YY C C*********************************************************************** C C 1- DEFINITION DU REPERE LOCAL LIE AU SEGMENT C -------------------------------------------- C XAB = XB - XA YAB = YB - YA C ABN = SQRT ( XAB*XAB + YAB*YAB ) C XE1 = XAB / ABN YE1 = YAB / ABN C C C 2- COORD DANS LE NOUVEAU REPERE C -------------------------------- C XANEW = 0.D0 XBNEW = ABN C XXNEW = (XX-XA)*XE1 + (YY-YA)*YE1 C C C 3- POSITION DU POINT C -------------------- C IF (XXNEW .GT. XBNEW*0.5D0) THEN NUMSEG = 2 ELSE NUMSEG = 1 ENDIF C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/s/closct.F0000666000175000017500000000736111524070645015352 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CLOSCT C ***************** C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C C BUT : CENTRALISATION DES FERMETURES DES FICHIERS DE SYRTHES C ---- C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! ! ! ! ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !___________!____!____!______________________________________________! C ! /NLOFCT/ ! ! D ! ! C ! /OPTCT/ ! ! D ! ! C !___________!____!____!______________________________________________! C C---------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT : ??? C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C----------------------------------------------------------------------- C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "nlofct.h" #include "fichct.h" #include "optct.h" #ifdef MED #include "med.hf" #endif C INTEGER IRET C*********************************************************************** C CLOSE (NFCLCT) CLOSE(NFSGCT) C IF (TYPGS.EQ.'SYR') THEN CLOSE(NFGGCT) ELSE #ifdef MED CALL EFFERM(NFGGCT,IRET) #endif ENDIF CLOSE(NFGRCT) IF (NCHROS.GE.1) CLOSE(NFGCCT) IF (LSUISO) CLOSE(NFGSCT) IF (LGEOMF) CLOSE(NFGFCT) IF (LRESUF) CLOSE(NFRFCT) IF (LCHROF) CLOSE(NFCFCT) IF (LHISOL) CLOSE(NFHRCT) C C C---- C FIN C---- C RETURN END syrthes-3.4.3-dfsg1/src/sc/0000777000175000017500000000000011524070646014111 5ustar pinipinisyrthes-3.4.3-dfsg1/src/sc/syrtc2.c0000666000175000017500000002531211524070645015505 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "abs.h" /* tableaux */ extern int *ncoups,*nfluss,*ndirs,*nechs,*nfluvs,*nrescs,*nrayts; extern int *nrayis,*nprios,*nmobil; extern double *vfluss,*vdirs,*vechs,*vfluvs,*vrescs,*vrayts,*vrayis; extern int *nrefac,*nrefal,*nfcous,*nfflus,*nfechs,*nfresc,*nfrays,*nfrais; extern double *vfflus,*vfechs,*vfresc,*vfrays,*vfrais,*coords; extern int *nrefs,*nrefe,*nodes,*nangle,*nodess,*nodeus,*noderc,*nodepr,*nodera; extern double *physol,*tmpsa,*tmps,*tmpsc1,*tmpsc2,*tmpsc3,*volume,*surfus; extern double *tmpmax, *tmpmin; extern int *ngffir,*ngftir,*ngfper,*ngfpef; extern int *ngfmst,*ngfmse; extern double *vfmste,*phmstp,*phmsto; extern double *emissi,*phfraf,*phfrae,*temray,*firay,*vfiray; extern double *erayeq,*trayeq,*erayen,*trayen,*epropr; extern int *nodray,*nrfray,*ityfar,*ncsray,*ncfray,*nesray; extern double *cooray,*fdfray,*sufray; extern int *ncfin,*ncgros,*itrav; extern double *tabray,*radios,*flumst,*barygr,*baryfs; extern double *b,*dmat,*xmat,*diag,*wct; extern int *itrav1,*itrav2; extern double *trav1,*trav2,*trav3,*trav4,*travf; extern int *ncfinf,*ncgrof,*ncbors,*ncborf,*nodesf,*ncoupf,*nrapf,*nodraf; extern double *baryfr,*baryff,*barys,*baryf,*vcoups,*vcoupf,*vfcous; extern double *cooraf,*coordf,*vrapf; /* constantes */ extern int ndim,nelesf,nbcouf,nbraf,nelraf,ndmasf; extern int npoins,nelems,neless,neleus,nelepr,nelerc,nelera; extern int nbcous,nbflus,nbdirs,nbechs,nbflvs,nbress; extern int nbrays,nbrais,nbprio,nbmobs,nbfflu,nbfech,nbfrai; extern int ndiele,ndmats,ndmass,ncoema,nbphys,nbface; extern int nbcopr,nbicor,nppel,npoue,npfel; extern int npoinr,nelray,nnsray,nnfray,nneray; extern int nfcfra,nfcsra,nftira,nffira,nfpera,nfmst,nfmste; extern int nbpaso,nbpara; extern double timso,totso,totray; extern double totsoi,totrai; extern double *b,*trav1,*trav2,*trav3,*trav4,*dmat,*diag,*xmat,*wct,*travf; extern int idtrav; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | syrtc2 | | Resolution Syrthes avec couplage avec Code_Saturne | |======================================================================| */ proc(syrtc2,SYRTC2)(int *fin,int *npoinf,double *dtfluid,double *tf,double *hht) { /* variable pour tests sorties */ int test_sortie = 0; /* double *b,*trav1,*trav2,*trav3,*trav4,*dmat,*diag,*xmat,*wct,*travf; */ double timra1,timra2,timso1,timso2; int un=1,deux=2,i,nb,nnn,prem=1; /* variables a recuperer des communs */ int lcface,lray,ntsyr,ncthfs,ldern,lstops,lhisor,ltmax; int nchror,lsdepl,ntsmax,ntsyrd,lhisol,nhrmax,nbande,ndprop,nfreqs; double rdtts,tempss; int lsyrth=0; /* 0- MISE A JOUR DU TEMPS REEL ============================*/ proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); if (*fin) ldern = 1; ntsyr++; proc(cadtmy,CADTMY)(&ntsyr,&rdtts,dtfluid,&prem,&npoins,tmpsa,tmps); prem=0;tempss+=rdtts; proc(envosy,ENVOSY)(&lsyrth,&ntsyr,&ldern,&lstops,&tempss,&ntsmax); /* 1- BANNIERE ===========*/ printf("\n ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n"); printf(" ITERATION SOLIDE NTSYR=%7d TEMPSS=%14.8e dt=%12.5e\n",ntsyr,tempss,rdtts); printf(" ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n\n"); /* 2- Passage des conditions limites du fluide vers le solide ==========================================================*/ proc(solflc,SOLFLC)(&deux,&un, &ndim,&nbcouf,ncoupf,vcoupf,vcoupf+nbcouf, npoinf,tf,hht,&un,&nbcouf); /* 2- RESOLUTION RAYONNEMENT ========================= */ if (lray) { proc(cpusyr,CPUSYR)(&timra1); nbpara++; printf("\n **TEMPS D'ENTREE RAYONNEMENT : %f\n",timra1); proc(solray,SOLRAY)(&ndim,&npoins,tmps,&nbrays,nrayts,vrayts); proc(limray,LIMRAY)(&ndim,&nelray,&npoinr, &nfcfra,&nfcsra,&nftira,&nffira,&nfpera, nodray,nrfray,ngffir,ngftir,ngfper,ngfpef, cooray,emissi,temray,firay,phfraf,phfrae,vfiray); for (i=0;i0) proc(resrer,RESRER)(&un,&nfpera,&nelray, ngfper,temray,trayeq,erayeq,phfrae,trav3,trav4); if (nfcfra>0) proc(resrer,RESRER)(&deux,&nfcfra,&nelray,ngfper, temray,trayeq,erayeq,phfrae,trav3,trav4); proc(resray,RESRAY)(&ndim,&nelray,&npoinr, cooray,nodray,nrfray, fdfray,sufray,temray,radios,firay,trayeq,erayeq, emissi,epropr,&nffira,ngffir,vfiray,tabray, &nfmst,ngfmst,flumst,phmsto); proc(pasray,PASRAY)(&deux,&ndim,&npoinr,&nbrays, nrayts,vrayts,&nbraf,nrapf,vrapf,nrfray, ityfar,&nelray,nodray,&nelraf,&ndmasf, &nelera,&ndmass,nodera,nodraf, &nnsray,&nnfray,&nfcfra,ngfpef,ncsray,ncfray, ncfin,ncgros,barygr,ncfinf,ncgrof,baryfr,baryff,baryfs, temray,firay,erayeq,trayeq,phfraf,trayen,erayen,sufray, trav1,trav2,trav3,trav4); if (lcface) proc(pssclf,PSSCLF)(&nbrays,vrayts,&nelera,&ndmass,vfrays,nodera); /* temps CPU rayonnement --------------------- */ proc(cpusyr,CPUSYR)(&timra2); totray+=abs(timra2-timra1); fflush(stdout); } /* 3- RESOLUTION CONDUCTION ======================== */ proc(cpusyr,CPUSYR)(&timso1); nbpaso++; proc(ressol, RESSOL) (&ndim,&ndiele,&nbcouf,&nelesf,&ndmasf,&nbface, &nbcous,&nbflus,&nbdirs,&nbechs,&nbflvs,&npfel,&npoins,&nelems,&ndmats, &neless,&ndmass,&neleus,&nelerc,&nelepr,&nbress,&nbrays,&nbrais, &nbprio,&nbmobs,&nbcopr,&nbphys,&nppel,&npoue,&ncoema,&nbicor, nodesf,ncoupf,vcoupf,ncoups,nfluss,ndirs,nechs,nfluvs, nrescs,nrayts,nrayis,nprios,nmobil, vcoups,vfluss,vdirs,vechs,vfluvs,vrescs,vrayts,vrayis,nrefac,nrefal, nrefs,nrefe,coords,nodes,nodess,nodeus,noderc,nodepr, nangle,nfflus,vfflus,&nbfflu,nfechs,vfechs,&nbfech, nfresc,vfresc, nfrays,vfrays,&nelera, nfrais,vfrais,&nbfrai, nfcous,vfcous, ncbors,ncborf,barys,baryf,coordf, physol,tmpsa,tmps,tmpsc1,tmpsc2,tmpsc3, volume,surfus, b,dmat,xmat,diag, travf,trav1,trav2,trav3,trav4,wct,tmpmax,tmpmin); proc(cpusyr,CPUSYR)(&timso2);totso+=abs(timso2-timso1); timso=abs(timso2-timso1); /* Passage des conditions limites du solide vers le fluide =======================================================*/ proc(solflc,SOLFLC)(&un,&un, &ndim,&nbcouf,ncoupf,vcoupf,vcoupf+nbcouf, npoinf,tf,hht,&un,&nbcouf); if (ntsyr==ntsmax) *fin=1; if (*fin) { proc(closct,CLOSCT)(); printf("\n\n ============================================================================\n"); proc(cpusyr,CPUSYR)(&timso2); printf("\n **TEMPS FINAL : %f\n",timso2); printf("\n\n ================================================\n"); printf(" SYRTHES : BILAN DU CALCUL\n\n"); printf(" CONDUCTION : %9d PAS DE TEMPS\n",nbpaso); printf(" %9d NOEUDS\n",npoins); printf(" %9d ELEMENTS\n",nelems); if (lray) { printf(" RAYONNEMENT : %9d PAS DE TEMPS\n",nbpara); printf(" %9d FACETTES\n",nelray); } printf(" ================================================\n\n\n\n"); printf(" TEMPS CPU (secondes)\n"); printf(" =========\n\n"); printf(" PHASE INITIALE POUR LA CONDUCTION . . . . . . . . %12.4f\n",abs(totsoi-totrai)); printf(" RESOLUTION DE LA CONDUCTION . . . . . . . . . . . %12.4f\n",abs(totso)); if (lray) { printf(" PHASE INITIALE POUR LE RAYONNEMENT. . . . . . . . %12.4f\n",abs(totrai)); printf(" RESOLUTION DU RAYONNEMENT . . . . . . . . . . . . %12.4f\n",abs(totray)); } printf(" T E M P S T O T A L . . . . . . . . . . . . . %12.4f\n",abs(totsoi+totso+totray)); printf(" D U R E E S M O Y E N N E S\n"); printf(" - RESOLUTION DE LA CONDUCTION\n"); printf(" par pas de temps . .%12.4f\n",abs(totso)/nbpaso); printf(" par pas de temps pour 1000 noeuds . .%12.4f\n",abs(totso)*1000./(nbpaso*npoins)); if (lray) { printf(" - RESOLUTION DU RAYONNEMENT\n"); printf(" par pas de temps . .%12.4f\n",abs(totray)/max(nbpara,1)); } } fflush(stdout); return 0; } syrthes-3.4.3-dfsg1/src/sc/trans1.F0000666000175000017500000001324111524070646015431 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE TRANS1 C ***************** C * (NDIM,NPOINS,TMPS, * NBCOUF,NCOUPF,VCOUPF, * NBCOUS,NCOUPS,VCOUPS, * NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, * NBICOR,BARYF,NCBORF,BARYS,NCBORS, * NPOINF,TF,HHT) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- C Premier passage des donnees du solide vers le fluide * C pour fournir a Saturne des conditions initiales * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NCOUPF ! TE ! D ! NUMERO DES NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C ********************************************************************** C..Variables externes INTEGER NDIM,NPOINS,NBCOUF,NPOINF INTEGER NBCOUS,NELESF,NDMASF,NELESS,NDMASS,NBICOR INTEGER NCOUPF(NBCOUF,2),NCOUPS(NBCOUS) INTEGER NODESF(NELESF,NDMASF),NODESS(NELESS,NDMASS) INTEGER NCBORF(NBCOUF,NBICOR),NCBORS(NBCOUS,NBICOR) DOUBLE PRECISION TMPS(NPOINS) DOUBLE PRECISION VCOUPF(NBCOUF,2),VCOUPS(NBCOUS,2) DOUBLE PRECISION BARYF(NBCOUF,NDIM),BARYS(NBCOUS,NDIM) DOUBLE PRECISION TF(NPOINF),HHT(NPOINF) C C..Variables internes INTEGER N,NG INTEGER MODE,N1 C C*********************************************************************** C C Passage de la temperature solide dans le tableau local C des noeuds couples DO N=1,NBCOUS NG = NCOUPS(N) VCOUPS(N,1) = TMPS(NG) ENDDO C C Passage de la temperature solide (vcoups) a la temperature C fluide vue de Syrthes (vcoupf) MODE=1 IF (NDIM .EQ. 2) THEN CALL PSFNC2 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ELSE CALL PSFNC3 (MODE, & NDIM,NBCOUF,VCOUPF,NBCOUS,VCOUPS, & NELESF,NDMASF,NODESF,NELESS,NDMASS,NODESS, & NBICOR,BARYF,NCBORF,BARYS,NCBORS) ENDIF C C C Passage de la temperature fluide vue de Syrthes (vcoupf) C a la temperature fluide vue de Saturne (TF) N1=1 CALL SOLFLC (N1,N1, & NDIM,NBCOUF,NCOUPF,VCOUPF(1,1),VCOUPF(1,2), & NPOINF,TF,HHT,N1,NBCOUF) C C C------- C FORMAT C------- C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/sc/mailfc.F0000666000175000017500000001370511524070646015461 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE MAILFC C ***************** C C --------------------------------------------------------- *(NDIM,NPOINF,NELEBF,XYZF,NBCOUF,NELESF,NDMASF, * COORDF,NODEBF,NODESF,NCOUPF, * NBFILS,NWMAIL,NWDN,NWDE,NWNCF1,NWECF1,NWDMA1) C --------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C * C FONCTION : * C -------- * C MAILLAGE FLUIDE TYPE SOLVEUR COMMUN * C * C----------------------------------------------------------------------- C (*) (*) ARGUMENTS C .________.______.____._____________________________________________. C ! NOM ! TYPE !MODE! ROLE ! C !________!______!____!_____________________________________________! C ! NDIM ! TE ! E ! Dimension du probleme (2 pour 2D, 3 pour 3D)! C ! NBCOUF ! E ! D ! Nombre de points fluides couples ! C ! NBRAF ! E ! D ! Nombre de points fluides non couples + rayt ! C ! NPOINF ! E ! D ! Nombre de points fluide total ! C ! COORDF ! TR ! M ! Coordonnes des points fluides couples ! C ! COORAF ! TR ! M ! Coordonnes des pts fluides non couples+rayt ! C !________!______!____!_____________________________________________! C ! COMMONS ! C !__________________________________________________________________! C !/OPTCT/ ! ! D ! ! C !/FICHCT/! ! D ! ! C !/XREFER/! ! D ! C !________!______!____!_____________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C********************************************************************** C DONNEES EN COMMON C********************************************************************** C #include "optct.h" #include "nlofes.h" C C********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINF,NBCOUF INTEGER NELEBF,NELESF,NDMASF INTEGER NODESF(NELESF,NDMASF), NODEBF(NELEBF,NDMASF) INTEGER NCOUPF(NBCOUF,2) INTEGER NBFILS,NWMAIL,NWDN,NWDE,NWDMA1 INTEGER NWNCF1,NWECF1 DOUBLE PRECISION XYZF(NPOINF,NDIM),COORDF(NBCOUF,NDIM) C C.. Variables internes INTEGER N,M,NC,NE C C********************************************************************** C IF (NWMAIL.EQ.1) THEN DO N=1,NELESF*NDMASF NODESF(N,1) = 0 ENDDO ENDIF C DO N=NWDN,NWDN+NWNCF1-1 NCOUPF(N,1) = 0 NCOUPF(N,2) = 0 ENDDO C C 1- TABLE DES ELEMENTS FLUIDES COUPLES C ===================================== C NE = NWDE-1 DO N=1,NELEBF NE=NE+1 DO M=1,NWDMA1 NODESF(NE,M) = NODEBF(N,M) ENDDO ENDDO C C 2 noeuds fluides couples C ======================== NC = NWDN-1 C C DO N=1,NPOINF NC = NC + 1 COORDF(NC,1)=XYZF(N,1) COORDF(NC,2)=XYZF(N,2) IF (NDIM.EQ.3) COORDF(NC,3)=XYZF(N,3) NCOUPF(NC,1) = N ENDDO C C 4 Controles C =========== C IF (NWMAIL.EQ.NBFILS .AND. * (NC.NE.NBCOUF .OR. NE.NE.NELESF)) THEN WRITE(NFECRA,4000) NC,NBCOUF,NE,NELESF STOP ENDIF C C-------- C FORMATS C-------- 4000 FORMAT(/,' %% ERREUR MAILFC : lors de la lecture des coordonnees' & ,' pour le(s) fluide(s). On trouve :',/, & 20X,I6,' noeuds couples au lieu de ',I6,/, & 20X,I6,' elements couples au lieu de ',I6) C C END syrthes-3.4.3-dfsg1/src/sc/solflc.F0000666000175000017500000001563511524070646015514 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE SOLFLC C ***************** C * (MODE,ITYECH, * NDIM,NBCOUF,NCOUPF,VCOUP1,VCOUP2, * NPOINF,TF,HHT,NWDN,NWN1) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C PASSAGE DES DONNES VOL DU FLUIDE AU TABLEAU VCOUPF * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! MODE ! E ! D ! SENS DE L'INTERPOLATION ! C ! ! ! ! = 1 PASSAGE SOLIDE --> FLUIDE ! C ! ! ! ! = 2 PASSAGE FLUIDE --> SOLIDE ! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NBCOUF ! E ! D ! NOMBRE DE NOEUDS FLUIDES COUPLES ! C ! NCOUPF ! TE ! D ! NUMERO DES NOEUDS FLUIDES COUPLES ! C ! VCOUPF ! TR !D M ! VALEUR AUX NOEUDS FLUIDES COUPLES ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "nlofes.h" #include "optct.h" C C ********************************************************************** C..Variables externes INTEGER MODE,NDIM,NBCOUF,ITYECH,NPOINF INTEGER NCOUPF(NBCOUF,2),NWDN,NWN1 DOUBLE PRECISION VCOUP1(NBCOUF),VCOUP2(NBCOUF) DOUBLE PRECISION TF(NPOINF),HHT(NPOINF) C C..Variables internes INTEGER NF,NTP,N,NAFFIC C C*********************************************************************** C C 0- INITIALISATIONS C ================== C C IF (MODE.EQ.1) THEN C C 1- PASSAGE DU SOLIDE VERS LE FLUIDE C =================================== C DO NF=NWDN,NWDN+NWN1-1 NTP = NCOUPF(NF,1) TF(NTP) = VCOUP1(NF) ENDDO C C IMPRESSIONS POUR CONTROLE C ------------------------- IF (NBLBLA.EQ.14 .OR. NBLBLA.EQ.141) THEN IF (ITYECH.EQ.1) THEN WRITE(NFECRA,1010) ELSE WRITE(NFECRA,1011) ENDIF IF (NBLBLA.EQ.14) THEN NAFFIC=NPOINF ELSE NAFFIC=50 ENDIF DO N=1,NAFFIC WRITE(NFECRA,1020) N,TF(N) ENDDO CALL FLUSHF(NFECRA) ENDIF C C ELSEIF (MODE.EQ.2) THEN C C 2- PASSAGE DU FLUIDE VERS LE SOLIDE C =================================== C DO NF=NWDN,NWDN+NWN1-1 NTP = NCOUPF(NF,1) VCOUP1(NF) = TF(NTP) VCOUP2(NF) = HHT(NTP) ENDDO C C IF (NBLBLA.EQ.14 .OR. NBLBLA.EQ.141) THEN IF (ITYECH.EQ.1) THEN WRITE(NFECRA,2010) ELSE WRITE(NFECRA,2011) ENDIF IF (NBLBLA.EQ.14) THEN NAFFIC=NWN1-1 ELSE NAFFIC=50 ENDIF DO N=NWDN,NWDN+NAFFIC WRITE(NFECRA,2020) N,VCOUP1(N),VCOUP2(N) ENDDO CALL FLUSHF(NFECRA) ENDIF C C 3- SORTIE EN ERREUR C =================== ELSE C WRITE(NFECRA,3000) STOP C ENDIF C C C C------- C FORMAT C------- C 1010 FORMAT(/,' *** SOLFLC : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE',/, & 5X,' N fluide UB3(5,..) ') 1011 FORMAT(/,' *** SOLFLC : PASSAGE DES DONNEES DU SOLIDE', & ' VERS LE FLUIDE POUR LE RAYONNEMENT EQUIVALENT 1D',/, & 5X,' N fluide UB3(5,..)') 1020 FORMAT(5X,3X,I10,6X,G13.7) 2010 FORMAT(/,' *** SOLFLC : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE (TF,HHT --> vcoupf)',/, & 5X,' N fluide T h') 2011 FORMAT(/,' *** SOLFLC : PASSAGE DES DONNEES DU FLUIDE', & ' VERS LE SOLIDE 1D RAYONEMENT EQUIVALENT ', & ' (TF,HHT --> vrapf)',/, & 5X,' N_loc N_inumt N_globfluide T_fluide ', & ' h_fluide') 2020 FORMAT(5X,3X,I10,6X,G13.7,3X,G13.7) 3000 FORMAT(/,' %% ERREUR SOLFLC : OPTION DE PASSAGE INCORRECTE ') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/src/sc/syrtc1.c0000666000175000017500000006010611524070646015505 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ # include # include # include # include "f2c_syrthes.h" # include "abs.h" /* tableaux */ int *ncoups,*nfluss,*ndirs,*nechs,*nfluvs,*nrescs,*nrayts; int *nrayis,*nprios,*nmobil; double *vfluss,*vdirs,*vechs,*vfluvs,*vrescs,*vrayts,*vrayis; int *nrefac,*nrefal,*nfcous,*nfflus,*nfechs,*nfresc,*nfrays,*nfrais; double *vfflus,*vfechs,*vfresc,*vfrays,*vfrais,*coords; int *nrefs,*nrefe,*nodes,*nangle,*nodess,*nodeus,*noderc,*nodepr,*nodera; double *physol,*tmpsa,*tmps,*tmpsc1,*tmpsc2,*tmpsc3,*volume,*surfus; double *tmpmax,*tmpmin; int *ngffir,*ngftir,*ngfper,*ngfpef; int *ngfmst,*ngfmse; double *vfmste,*phmstp,*phmsto; double *emissi,*phfraf,*phfrae,*temray,*firay,*vfiray; double *erayeq,*trayeq,*erayen,*trayen,*epropr; int *nodray,*nrfray,*ityfar,*ncsray,*ncfray,*nesray; double *cooray,*fdfray,*sufray; int *ncfin,*ncgros,*itrav; double *tabray,*radios,*flumst,*barygr,*baryfs; double *b,*dmat,*xmat,*diag,*wct; int *itrav1,*itrav2,*itrmed; int *ncfinf,*ncgrof,*ncbors,*ncborf,*nodesf,*ncoupf,*nrapf,*nodraf; double *baryfr,*baryff,*barys,*baryf,*vcoups,*vcoupf,*vfcous; double *cooraf,*coordf,*vrapf; /* constantes */ int ndim,nelesf,nbcouf,nbraf,nelraf,ndmasf; int npoins,nelems,nfbida,neless,neleus,nelepr,nelerc,nelera; int nbcous,nbflus,nbdirs,nbechs,nbflvs,nbress; int nbrays,nbrais,nbprio,nbmobs,nbfflu,nbfech,nbfrai; int ndiele,ndmats,ndmass,ncoema,nbphys,nbface; int nbcopr,nbicor,nppel,npoue,npfel; int npoinr,nelray,nnsray,nnfray,nneray; int nfcfra,nfcsra,nftira,nffira,nfpera,nfmst,nfmste; double totso,timso,totsoi,totray,timray,totrai; int nbpaso,nbpara; double *b,*trav1,*trav2,*trav3,*trav4,*dmat,*diag,*xmat,*wct,*travf; int idtrav; /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | syrtc1 | | Initialisation de Syrthes avec couplage avec le Solveur Commun | |======================================================================| */ proc(syrtc1,SYRTC1)(int *ndim_, int *npoinf,int *nodebf,int *nelebf, double *xyzf, double *tf, double *hht) { int un=1,calcium=0; /* variables a recuperer des communs */ int lcface,lray,ntsyr,ncthfs,ldern,lstops,lhisor,lsyrth,ltmax; int nchror,lsdepl,ntsmax,ntsyrd,lhisol,nhrmax,nbande,ndprop,nfreqs; double rdtts,tempss; double timso1,timso2,timsobc,timsoac; int nbfils,nwmail,nwdn,nwdrn,nwde,nwdre; int nwncf1,nwnrf1,nwecf1,nwerf1,nwdma1; int taill_i,taill_r,taill_it,taill_rt,taill_rr; int i; proc(syrban,SYRBAN)(&un); proc(cpusyr,CPUSYR)(&timso1); printf("\n **TEMPS D'ENTREE ETAPE D'INITIALISATION : %f\n",timso1); totso=totsoi=totray=totrai=timray=timso=0.; ntsmax=nbpaso=nbpara=taill_i=taill_r=taill_it=taill_rt=taill_rr=0; lsyrth=0; proc(syrban,SYRBAN)(&un); proc(iniso1,INISO1) (&ndim,&npoins,&nelems,&nfbida,&neless,&neleus,&nelepr,&nelerc,&nelera, &nbcous,&nbflus,&nbdirs,&nbechs,&nbflvs,&npfel,&nbress, &nbrays,&nbrais,&nbprio,&nbmobs,&nbcopr, &ndiele,&ndmats,&ndmass,&nbface,&ncoema,&nbphys,&nppel,&npoue,&nbicor, &nbfflu,&nbfech,&nbfrai,&npoinr,&nelray,&nnsray,&nnfray,&nneray, &nfcfra,&nfcsra,&nftira,&nffira,&nfpera,&nfmst,&nfmste); if (ndim != *ndim_) { printf("\n ERREUR SYRTHES : les dimensions des domaines fluide et solide sont incompatibles\n"); exit(0); } ndmasf=ndim; nbcouf=*npoinf; nelesf=*nelebf; nbraf=nelraf=0; fflush(stdout); nbfils=1;nwmail=1;nwdn=1;nwdrn=1;nwde=1;nwdre=1;nwncf1=nbcouf; nwnrf1=nbraf;nwecf1=nelesf;nwerf1=nelraf;nwdma1=ndmasf; if (nbcouf==0) {printf(" $$ ATTENTION :\n"); printf(" VOUS UTILISEZ LE COUPLAGE THERMIQUE \n"); printf(" CODE_SATURNE (FLUIDE) / SYRTHES (SOLIDE)\n"); printf(" AUCUN NOEUD FLUIDE COUPLE AU SOLIDE N''EST DETECTE\n"); printf(" ==> UTILISEZ SYRTHES POUR LES CALCULS DE THERMIQUE\n"); printf(" DANS DES SOLIDES\n"); exit(0); } proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); idtrav=max(nbcouf,npoins); idtrav=max(idtrav,npoinr);idtrav=max(idtrav,nelray); ncoups=(int*)malloc(max(nbcous,1)*sizeof(int)); taill_i+=max(nbcous,1); nfluss=(int*)malloc(max(nbflus,1)*sizeof(int)); taill_i+=max(nbflus,1); ndirs=(int*)malloc(max(nbdirs,1)*sizeof(int)); taill_i+=max(nbdirs,1); nechs=(int*)malloc(max(nbechs*2,1)*sizeof(int)); taill_i+=max(nbechs*2,1); nfluvs=(int*)malloc(max(nbflvs,1)*sizeof(int)); taill_i+=max(nbflvs,1); nrescs=(int*)malloc(max(nbress*2,1)*sizeof(int)); taill_i+=max(nbress*2,1); nrayts=(int*)malloc(max(nbrays,1)*sizeof(int)); taill_i+=max(nbrays,1); nrayis=(int*)malloc(max(nbrais,1)*sizeof(int)); taill_i+=max(nbrais,1); nprios=(int*)malloc(max(nbprio*(nbcopr+1),1)*sizeof(int)); taill_i+=max(nbprio*(nbcopr+1),1); nmobil=(int*)malloc(max(nbmobs*2,1)*sizeof(int)); taill_i+=max(nbmobs*2,1); vfluss=(double*)malloc(max(nbflus,1)*sizeof(double)); taill_r+=max(nbflus,1); vdirs=(double*)malloc(max(nbdirs,1)*sizeof(double)); taill_r+=max(nbdirs,1); vechs=(double*)malloc(max(nbechs*2,1)*sizeof(double)); taill_r+=max(nbechs*2,1); vfluvs=(double*)malloc(max(nbflvs*npfel,1)*sizeof(double)); taill_r+=max(nbflvs*npfel,1); vrescs=(double*)malloc(max(nbress*2,1)*sizeof(double)); taill_r+=max(nbress*2,1); vrayts=(double*)malloc(max(nbrays*2,1)*sizeof(double)); taill_r+=max(nbrays*2,1); vrayis=(double*)malloc(max(nbrais*2,1)*sizeof(double)); taill_r+=max(nbrais*2,1); nrefe=(int*)malloc(nelems*sizeof(int)); taill_i+=nelems; if (!ncoups|| !ndirs|| !nechs|| !nfluvs|| !nrescs|| !nrayts|| !nrayis|| !nprios|| !nmobil || !vfluss|| !vdirs|| !vechs|| !vfluvs|| !vrescs|| !vrayts|| !vrayis|| !nrefe) { printf("\n ERREUR D'ALLOCATION MEMOIRE 1\n");exit(0);} if (lcface) { nrefac=(int*)malloc(nelems*nbface*sizeof(int)); taill_i+=nelems*nbface; nrefal=(int*)malloc(max(neleus,1)*sizeof(int)); taill_i+=max(neleus,1); if (ncthfs==2) {nfcous=(int*)malloc(max(nelems,1)*sizeof(int)); taill_i+=max(nelems,1);} else if (ncthfs==3) {nfcous=(int*)malloc(max(neless,1)*sizeof(int)); taill_i+=max(neless,1);} nfflus=(int*)malloc(max(nbfflu,1)*sizeof(int)); taill_i+=max(nbfflu,1); nfechs=(int*)malloc(max(nbfech,1)*sizeof(int)); taill_i+=max(nbfech,1); nfresc=(int*)malloc(max(nelerc,1)*sizeof(int)); taill_i+=max(nelerc,1); nfrays=(int*)malloc(max(nelera,1)*sizeof(int)); taill_i+=max(nelera,1); nfrais=(int*)malloc(max(nbfrai,1)*sizeof(int)); taill_i+=max(nbfrai,1); vfflus=(double*)malloc(max(nbfflu*ndmass,1)*sizeof(double)); taill_r+=max(nbfflu*ndmass,1); vfechs=(double*)malloc(max(nbfech*ndmass*2,1)*sizeof(double)); taill_r+=max(nbfech*ndmass*2,1); vfresc=(double*)malloc(max(nelerc*ndmass*2,1)*sizeof(double)); taill_r+=max(nelerc*ndmass*2,1); vfrays=(double*)malloc(max(nelera*ndmass*2,1)*sizeof(double)); taill_r+=max(nelera*ndmass*2,1); vfrais=(double*)malloc(max(nbfrai*ndmass*2,1)*sizeof(double)); taill_r+=max(nbfrai*ndmass*2,1); vfcous=(double*)malloc(max(neless*ndmass*2,1)*sizeof(double)); taill_r+=max(neless*ndmass*2,1); if ( !nrefal || !nfcous || !nfflus || !nfechs || !nfresc || !nfrays || !nfrais || !vfflus || !vfechs || !vfresc || !vfrays || !vfrais || !nrefac || !vfcous) {printf("\n ERREUR D'ALLOCATION MEMOIRE 2\n");exit(0);} } nrefs=(int*)malloc(npoins*sizeof(int)); taill_i+=npoins; coords=(double*)malloc(npoins*ndim*sizeof(double)); taill_r+=npoins*ndim; nodes=(int*)malloc(nelems*ndmats*sizeof(int)); taill_i+=nelems*ndmats; nangle=(int*)malloc(nelems*sizeof(int)); taill_i+=nelems; nodess=(int*)malloc(max(neless*ndmass,1)*sizeof(int)); taill_i+=max(neless*ndmass,1); nodeus=(int*)malloc(max(neleus*ndmass,1)*sizeof(int)); taill_i+=max(neleus*ndmass,1); noderc=(int*)malloc(max(nelerc*ndmass,1)*sizeof(int)); taill_i+=max(nelerc*ndmass,1); nodepr=(int*)malloc(max(nelepr*(ndmats+1),1)*sizeof(int)); taill_i+=max(nelepr*(ndmats+1),1); nodera=(int*)malloc(max(nelera*ndmass,1)*sizeof(int)); taill_i+=max(nelera*ndmass,1); physol=(double*)malloc(max(npoue*nppel*nbphys,1)*sizeof(double)); taill_r+=max(npoue*nppel*nbphys,1); tmpsa=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; tmps=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; if ( !coords|| !nodes|| !nodess|| !nodeus|| !noderc|| !nodepr|| !nodera|| !physol || !tmpsa || !tmps || !nrefs) { printf("\n ERREUR D'ALLOCATION MEMOIRE 3\n");exit(0);} if (ncthfs!=2) { volume=(double*)malloc(nelems*sizeof(double)); taill_r+=nelems; surfus=(double*)malloc(max(neleus,1)*sizeof(double)); taill_r+=max(neleus,1); if ( !volume|| !surfus) { printf("\n ERREUR D'ALLOCATION MEMOIRE 4\n");exit(0);} } if (ltmax) { tmpmax=(double*)malloc(npoins*sizeof(double)); tmpmin=(double*)malloc(npoins*sizeof(double)); if (!tmpmax || !tmpmin) { printf("\n ERREUR D'ALLOCATION MEMOIRE 5\n");exit(0);} } if (lray) { ngffir=(int*)malloc(max(nffira,1)*sizeof(int)); taill_i+=max(nffira,1); ngftir=(int*)malloc(max(nftira,1)*sizeof(int)); taill_i+=max(nftira,1); ngfper=(int*)malloc(max(nfpera,1)*sizeof(int)); taill_i+=max(nfpera,1); ngfpef=(int*)malloc(max(nfcfra,1)*sizeof(int)); taill_i+=max(nfcfra,1); ngfmst=(int*)malloc(max(nfmst*2,1)*sizeof(int)); taill_i+=max(nfmst*2,1); ngfmse=(int*)malloc(max(nfmste,1)*sizeof(int)); taill_i+=max(nfmste,1); vfmste=(double*)malloc(max(nfmste*2,1)*sizeof(double)); taill_r+=max(nfmste*2,1); phmstp=(double*)malloc(max(nfmst*4,1)*sizeof(double)); taill_r+=max(nfmst*4,1) ; phmsto=(double*)malloc(max(nfmst*5*nbande,1)*sizeof(double)); taill_r+=max(nfmst*5*nbande,1); flumst=(double*)malloc(max(nfmst*nbande,1)*sizeof(double)); taill_r+=max(nfmst*nbande,1); emissi=(double*)malloc(max(nelray*2*nbande,1)*sizeof(double)); taill_r+=max(nelray*2*nbande,1); epropr=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nelray*nbande,1); phfraf=(double*)malloc(max(nfcfra*4,1)*sizeof(double)); taill_r+=max(nfcfra*4,1); phfrae=(double*)malloc(max(nfpera*4,1)*sizeof(double)); taill_r+=max(nfpera*4,1); temray=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); firay=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nelray*nbande,1); vfiray=(double*)malloc(max(nffira*nbande*2,1)*sizeof(double)); taill_r+=max(nffira*nbande*2,1); erayeq=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); trayeq=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); erayen=(double*)malloc(max(npoinr,1)*sizeof(double)); taill_r+=max(npoinr,1); trayen=(double*)malloc(max(npoinr,1)*sizeof(double)); taill_r+=max(npoinr,1); nodray=(int*)malloc(max(nelray*ndim,1)*sizeof(int)); taill_i+=max(nelray*ndim,1); nrfray=(int*)malloc(max(nelray,1)*sizeof(int)); taill_i+=max(nelray,1); ityfar=(int*)malloc(max(nelray,1)*sizeof(int)); taill_i+=max(nelray,1); cooray=(double*)malloc(max(npoinr*ndim,1)*sizeof(double)); taill_r+=max(npoinr*ndim,1); fdfray=(double*)malloc(max(nelray*(nelray+1)/2,1)*sizeof(double)); taill_r+=max(nelray*(nelray+1)/2,1); sufray=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); ncsray=(int*)malloc(max(nnsray,1)*sizeof(int)); taill_i+=max(nnsray,1); ncfray=(int*)malloc(max(nnfray,1)*sizeof(int)); taill_i+=max(nnfray,1); nesray=(int*)malloc(max(nneray,1)*sizeof(int)); taill_i+=max(nneray,1); ncfin=(int*)malloc(max(nbrays,1)*sizeof(int)); taill_i+=max(nbrays,1); ncgros=(int*)malloc(max(nnsray*2,1)*sizeof(int)); taill_i+=max(nnsray*2,1); barygr=(double*)malloc(max(nnsray*ndim,1)*sizeof(double)); taill_r+=max(nnsray*ndim,1); baryfs=(double*)malloc(max(nbrays*ndim,1)*sizeof(double)); taill_r+=max(nbrays*ndim,1); tabray=(double*)malloc(max(nelray*9,1)*sizeof(double)); taill_r+=max((nelray+1)*8,1); radios=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nfmst*5*nbande,1); if (!ngffir || !ngftir || !ngfper || !ngfpef || !ngfmst || !ngfmse || !vfmste || !phmstp || !phmsto || !flumst || !emissi || !epropr || !phfraf || !phfrae || !temray || !firay || !vfiray || !erayeq || !trayen || !erayen || !trayen || !nodray || !nrfray || !ityfar || !cooray || !fdfray || !sufray || !ncsray || !ncfray || !nesray || !ncfin || !ncgros || !barygr || !baryfs || !tabray || !radios) {printf("\n ERREUR D'ALLOCATION MEMOIRE 6\n");exit(0);} } itrav=(int*)malloc(max(idtrav,1)*sizeof(int)); taill_it+=max(idtrav,1); itrav1=(int*)malloc(max(idtrav,1)*sizeof(int)); taill_it+=max(idtrav,1); itrmed=(int*)malloc(max(ndmats*nelems,1)*sizeof(int)); taill_it+=max(ndmats*nelems,1); if (!itrav||!itrav1){printf("\n ERREUR D'ALLOCATION MEMOIRE 7\n");exit(0);} trav1=(double*)malloc(max(npoins,nbcouf)*sizeof(double)); taill_rt+=npoins; trav2=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rt+=npoins; if (!trav1||!trav2) {printf("\n ERREUR D'ALLOCATION MEMOIRE 8\n");exit(0);} if (nbprio) { itrav2=(int*)malloc(max(npoins,1)*sizeof(int)); taill_it+=npoins; trav3=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rt+=npoins; if (!itrav2||!trav3) {printf("\n ERREUR D'ALLOCATION MEMOIRE 8\n");exit(0);} } printf("\n\n ============================================================\n"); printf(" Memoire totale pour la phase initiale :\n\n"); printf(" Nombre d'entiers reserves : %9d\n",taill_i+taill_it); printf(" soit par noeud : %9d\n\n",(taill_i+taill_it)/npoins); printf(" Nombre de reels reserves : %9d\n",taill_r+taill_rt); printf(" soit par noeud : %9d\n",(taill_r+taill_rt)/npoins); printf("============================================================\n\n"); proc(inisol,INISOL) (&ndim,&ndiele,&nbface,&nfbida, &nbcous,&nbflus,&nbdirs,&nbechs,&nbflvs,&npfel,&npoins,&nelems,&ndmats, &neless,&ndmass,&neleus,&nelerc,&nelepr,&nelera,&nbress, &nbrays,&nbrais,&nbprio,&nbmobs,&nbcopr,&nbphys,&nppel,&npoue,&nbicor, &nbfflu,&nbfech,&nbfrai, ncoups,nfluss,ndirs,nechs,nfluvs,nrescs,nrayts, nrayis,nprios,nmobil, vfluss,vdirs,vechs,vfluvs,vrescs,vrayts,vrayis, nrefac,nrefal,nfcous,nfflus,nfechs,nfresc,nfrays,nfrais, vfflus,vfechs,vfresc,vfrays,vfrais, nrefs,nrefe,coords,nodes,nodess,nodeus,noderc,nodepr,nodera, nangle,physol,tmpsa,tmps,tmpsc1,tmpsc2,tmpsc3,volume,surfus, &nelray,&npoinr,&nnsray,&nnfray,&nneray,&nfcfra,&nfcsra,&nftira, &nffira,&nfpera,&nfmst,&nfmste,ngffir,ngftir,ngfper,ngfpef, ngfmst,ngfmse,vfmste,phmstp,phmsto, emissi,phfraf,phfrae,temray,firay,vfiray,erayeq,trayeq, nodray,nrfray,ityfar,cooray,fdfray,sufray,ncsray,ncfray,nesray, ncfin,ncgros,barygr,baryfs,itrav,&idtrav,tabray,radios, itrav1,itrav2,trav1,trav2,trav3,&totrai,tmpmax,tmpmin,itrmed); proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); fflush(stdout); free(itrav); free(itrav1); free(itrav2); free(itrmed); nodesf=(int*)malloc(max(nelesf*ndmasf,1)*sizeof(int)); taill_i+=max(nelesf*ndmasf,1); nodraf=(int*)malloc(max(nelraf*ndmasf,1)*sizeof(int)); taill_i+=max(nelraf*ndmasf,1); coordf=(double*)malloc(max(nbcouf*ndim,1)*sizeof(double)); taill_r+=max(nbcouf*ndim,1); cooraf=(double*)malloc(max(nbraf*ndim,1)*sizeof(double)); taill_r+=max(nbraf*ndim,1); ncoupf=(int*)malloc(max(nbcouf*2,1)*sizeof(int)); taill_i+=max(nbcouf*2,1); nrapf=(int*)malloc(max(nbraf*2,1)*sizeof(int)); taill_i+=max(nbraf*2,1); if (!nodesf||!nodraf||!coordf||!cooraf||!ncoupf||!nrapf) {printf("\n ERREUR D'ALLOCATION MEMOIRE 9\n");exit(0);} proc(mailfc,MAILFC) (&ndim,npoinf,nelebf,xyzf,&nbcouf,&nelesf,&ndmasf, coordf,nodebf,nodesf,ncoupf, &nbfils,&nwmail,&nwdn,&nwde,&nwncf1,&nwecf1,&nwdma1); ncfinf=(int*)malloc(max(nbraf,1)*sizeof(int)); taill_i+=max(nbraf,1); ncgrof=(int*)malloc(max(nnfray*2,1)*sizeof(int)); taill_i+=max(nnfray*2,1); ncbors=(int*)malloc(max(nbcous*nbicor,1)*sizeof(int)); taill_i+=max(nbcous*nbicor,1); ncborf=(int*)malloc(max(nbcouf*nbicor,1)*sizeof(int)); taill_i+=max(nbcouf*nbicor,1); baryfr=(double*)malloc(max(nnfray*ndim,1)*sizeof(double)); taill_r+=max(nnfray*ndim,1); baryff=(double*)malloc(max(nbraf*ndim,1)*sizeof(double)); taill_r+=max(nbraf*ndim,1); barys=(double*)malloc(max(nbcous*ndim,1)*sizeof(double)); taill_r+=max(nbcous*ndim,1); baryf=(double*)malloc(max(nbcouf*ndim,1)*sizeof(double)); taill_r+=max(nbcouf*ndim,1); vcoups=(double*)malloc(max(nbcous*2,1)*sizeof(double)); taill_r+=max(nbcous*2,1); vcoupf=(double*)malloc(max(nbcouf*2,1)*sizeof(double)); taill_r+=max(nbcouf*2,1); vrapf=(double*)malloc(max(nbraf*2,1)*sizeof(double)); taill_r+=max(nbraf*2,1); if (!ncfinf||!ncgrof||!ncbors||!ncborf|| !nodraf||!baryfr||!baryff|| !barys||!baryf||!vcoups||!vcoupf||!vrapf) {printf("\n ERREUR D'ALLOCATION MEMOIRE 10\n");exit(0);} fflush(stdout); proc(cpusyr,CPUSYR)(&timsobc); itrav=(int*)malloc(max(idtrav,1)*sizeof(int)); proc(inisf2,INISF2) (&ndim,&ndiele,&nbcouf,&nelesf,&ndmasf,&nbraf,&nelraf,&nbicor,&nbmobs, &nbcous,&npoins,&nelems,&ndmats,&neless,&ndmass, coordf,nodesf,ncoupf,cooraf,nrapf, ncoups,nrefs,coords,nodes,nodess, nodraf,ncbors,ncborf,barys,baryf, &nelray,nrfray,&npoinr,nodray,cooray, &nnfray,ncfray,ncfinf,ncgrof,baryfr,baryff, itrav,&idtrav,&totrai,&calcium,trav1,trav2); free(itrav); proc(cpusyr,CPUSYR)(&timsoac); printf("\n **Temps CPU pour le calcul des correspondants fluide/solide: %f\n",abs(timsoac-timsobc)); fflush(stdout); if (ntsmax==0) ntsmax=1000000; if (ltmax) for (i=0;i # include # include # include "f2c_syrthes.h" # include "abs.h" /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| | AUTEURS : C. PENIGUEL, I. RUPP | |======================================================================| | termic | | Programme principal de SYRTHES | |======================================================================| */ proc(void termic,void TERMIC)() { int ndim,nelesf,nbcouf,nbraf,nelraf,ndmasf; int npoins,nelems,neless,neleus,nelepr,nelerc,nelera; int nbcous,nbflus,nbdirs,nbechs,nbflvs,nbress; int nbrays,nbrais,nbprio,nbmobs,nbfflu,nbfech,nbfrai; int ndiele,ndmats,ndmass,ncoema,nbphys,nbface; int nbcopr,nbicor,nppel,npoue,npfel; int npoinr,nelray,nnsray,nnfray,nneray; int nfcfra,nfcsra,nftira,nffira,nfpera,nfmst,nfmste; int idtrav,mtotia,mtotra,nbpaso,memuti,memutr,nbpara; int nfbida; double tcpu,tcpu1,tcpui; double totrai=0,totsoi=0,totso=0,totray=0; int nb,un=1,zero=0,deux=2,moinsun=-1,nnn,i,prem=1; int taill_i,taill_r,taill_it,taill_rt,taill_rr; /* variables a recuperer des communs */ int lcface,lray,ntsyr,ncthfs,ldern,lstops,lhisor,ltmax; int nchror,lsdepl,ntsmax,ntsyrd,lhisol,nhrmax,nbande,ndprop,nfreqs; double rdtts,dtimpo,tempss; int lsyrth=1; /* tableaux */ int *ncoups,*nfluss,*ndirs,*nechs,*nfluvs,*nrescs,*nrayts; int *nrayis,*nprios,*nmobil; double *vfluss,*vdirs,*vechs,*vfluvs,*vrescs,*vrayts,*vrayis; int *nrefac,*nrefal,*nfcous,*nfflus,*nfechs,*nfresc,*nfrays,*nfrais; double *vfflus,*vfechs,*vfresc,*vfrays,*vfrais,*coords; int *nrefs,*nrefe,*nodes,*nodess,*nodeus,*noderc,*nodepr,*nodera,*angles; double *physol,*tmpsa,*tmps,*tmpsc1,*tmpsc2,*tmpsc3,*volume,*surfus; double *tmpmax,*tmpmin; int *ngffir,*ngftir,*ngfper,*ngfpef; int *ngfmst,*ngfmse; double *vfmste,*phmstp,*phmsto; double *emissi,*phfraf,*phfrae,*temray,*firay,*vfiray; double *erayeq,*trayeq,*erayen,*trayen,*epropr; int *nodray,*nrfray,*ityfar,*ncsray,*ncfray,*nesray; double *cooray,*fdfray,*sufray; int *ncfin,*ncgros,*itrav,*itravmed; double *tabray,*radios,*flumst,*barygr,*baryfs; double *b,*dmat,*xmat,*diag,*wct; int *itrav1,*itrav2; double *trav1,*trav2,*trav3,*trav4,*travf; /* inutile : ne sert que pour le fluide */ int *ncfinf,*ncgrof,*ncbors,*ncborf,*nodesf,*ncoupf,*nrapf; double *baryfr,*baryff,*barys,*baryf,*vcoups,*vcoupf,*vfcous,*coordf,*vrapf; int *bidon,nbidon=0; /* inutile : ne sert que pour le fluide */ proc(cpusyr,CPUSYR)(&tcpu); tcpui=tcpu; totso=totray=0.; nbpaso=nbpara=taill_i=taill_r=taill_it=taill_rt=taill_rr=0; proc(syrban,SYRBAN)(&un); proc(cpusyr,CPUSYR)(&tcpu); printf("\n **TEMPS D'ENTREE ETAPE D'INITIALISATION : %f\n",tcpu); proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); proc(iniso1,INISO1) (&ndim,&npoins,&nelems,&nfbida, &neless,&neleus,&nelepr,&nelerc,&nelera, &nbcous,&nbflus,&nbdirs,&nbechs,&nbflvs,&npfel,&nbress, &nbrays,&nbrais,&nbprio,&nbmobs,&nbcopr, &ndiele,&ndmats,&ndmass,&nbface,&ncoema,&nbphys,&nppel,&npoue, &nbicor,&nbfflu,&nbfech,&nbfrai, &npoinr,&nelray,&nnsray,&nnfray,&nneray, &nfcfra,&nfcsra,&nftira,&nffira,&nfpera,&nfmst,&nfmste); proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); nelesf=nbcouf=nbraf=nelraf=ndmasf=0; idtrav=max(nbcouf,npoins); idtrav=max(idtrav,npoinr);idtrav=max(idtrav,nelray); fflush(stdout); ncoups=(int*)malloc(max(nbcous,1)*sizeof(int)); taill_i+=max(nbcous,1); nfluss=(int*)malloc(max(nbflus,1)*sizeof(int)); taill_i+=max(nbflus,1); ndirs=(int*)malloc(max(nbdirs,1)*sizeof(int)); taill_i+=max(nbdirs,1); nechs=(int*)malloc(max(nbechs*2,1)*sizeof(int)); taill_i+=max(nbechs*2,1); nfluvs=(int*)malloc(max(nbflvs,1)*sizeof(int)); taill_i+=max(nbflvs,1); nrescs=(int*)malloc(max(nbress*2,1)*sizeof(int)); taill_i+=max(nbress*2,1); nrayts=(int*)malloc(max(nbrays,1)*sizeof(int)); taill_i+=max(nbrays,1); nrayis=(int*)malloc(max(nbrais,1)*sizeof(int)); taill_i+=max(nbrais,1); nprios=(int*)malloc(max(nbprio*(nbcopr+1),1)*sizeof(int)); taill_i+=max(nbprio*(nbcopr+1),1); nmobil=(int*)malloc(max(nbmobs*2,1)*sizeof(int)); taill_i+=max(nbmobs*2,1); vfluss=(double*)malloc(max(nbflus,1)*sizeof(double)); taill_r+=max(nbflus,1); vdirs=(double*)malloc(max(nbdirs,1)*sizeof(double)); taill_r+=max(nbdirs,1); vechs=(double*)malloc(max(nbechs*2,1)*sizeof(double)); taill_r+=max(nbechs*2,1); vfluvs=(double*)malloc(max(nbflvs*npfel,1)*sizeof(double)); taill_r+=max(nbflvs*npfel,1); vrescs=(double*)malloc(max(nbress*2,1)*sizeof(double)); taill_r+=max(nbress*2,1); vrayts=(double*)malloc(max(nbrays*2,1)*sizeof(double)); taill_r+=max(nbrays*2,1); vrayis=(double*)malloc(max(nbrais*2,1)*sizeof(double)); taill_r+=max(nbrais*2,1); nrefe=(int*)malloc(nelems*sizeof(int)); taill_i+=nelems; if (!ncoups|| !ndirs|| !nechs|| !nfluvs|| !nrescs|| !nrayts|| !nrayis|| !nprios|| !nmobil || !vfluss|| !vdirs|| !vechs|| !vfluvs|| !vrescs|| !vrayts|| !vrayis|| !nrefe) { printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} if (lcface) { nrefac=(int*)malloc(nelems*nbface*sizeof(int)); taill_i+=nelems*nbface; nrefal=(int*)malloc(max(neleus,1)*sizeof(int)); taill_i+=max(neleus,1); if (ncthfs==2) {nfcous=(int*)malloc(max(nelems,1)*sizeof(int)); taill_i+=max(nelems,1);} else if (ncthfs==3) {nfcous=(int*)malloc(max(neless,1)*sizeof(int)); taill_i+=max(neless,1);} nfflus=(int*)malloc(max(nbfflu,1)*sizeof(int)); taill_i+=max(nbfflu,1); nfechs=(int*)malloc(max(nbfech,1)*sizeof(int)); taill_i+=max(nbfech,1); nfresc=(int*)malloc(max(nelerc,1)*sizeof(int)); taill_i+=max(nelerc,1); nfrays=(int*)malloc(max(nelera,1)*sizeof(int)); taill_i+=max(nelera,1); nfrais=(int*)malloc(max(nbfrai,1)*sizeof(int)); taill_i+=max(nbfrai,1); vfflus=(double*)malloc(max(nbfflu*ndmass,1)*sizeof(double)); taill_r+=max(nbfflu*ndmass,1); vfechs=(double*)malloc(max(nbfech*ndmass*2,1)*sizeof(double)); taill_r+=max(nbfech*ndmass*2,1); vfresc=(double*)malloc(max(nelerc*ndmass*2,1)*sizeof(double)); taill_r+=max(nelerc*ndmass*2,1); vfrays=(double*)malloc(max(nelera*ndmass*2,1)*sizeof(double)); taill_r+=max(nelera*ndmass*2,1); vfrais=(double*)malloc(max(nbfrai*ndmass*2,1)*sizeof(double)); taill_r+=max(nbfrai*ndmass*2,1); if ( !nrefal || !nfcous || !nfflus || !nfechs || !nfresc || !nfrays || !nfrais || !vfflus || !vfechs || !vfresc || !vfrays || !vfrais || !nrefac) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } nrefs=(int*)malloc(npoins*sizeof(int)); taill_i+=npoins; coords=(double*)malloc(npoins*ndim*sizeof(double)); taill_r+=npoins*ndim; nodes=(int*)malloc(nelems*ndmats*sizeof(int)); taill_i+=nelems*ndmats; angles=(int*)malloc(nelems*sizeof(int)); taill_i+=nelems; nodess=(int*)malloc(max(neless*ndmass,1)*sizeof(int)); taill_i+=max(neless*ndmass,1); nodeus=(int*)malloc(max(neleus*ndmass,1)*sizeof(int)); taill_i+=max(neleus*ndmass,1); noderc=(int*)malloc(max(nelerc*ndmass,1)*sizeof(int)); taill_i+=max(nelerc*ndmass,1); nodepr=(int*)malloc(max(nelepr*(ndmats+1),1)*sizeof(int)); taill_i+=max(nelepr*(ndmats+1),1); nodera=(int*)malloc(max(nelera*ndmass,1)*sizeof(int)); taill_i+=max(nelera*ndmass,1); physol=(double*)malloc(max(npoue*nppel*nbphys,1)*sizeof(double)); taill_r+=max(npoue*nppel*nbphys,1); tmpsa=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; tmps=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; if ( !coords|| !nodes|| !angles || !nodess|| !nodeus|| !noderc|| !nodepr|| !nodera|| !physol || !tmpsa || !tmps || !nrefs) { printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} if (ncthfs==2) { tmpsc1=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; tmpsc2=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; tmpsc3=(double*)malloc(npoins*sizeof(double)); taill_r+=npoins; if ( !tmpsc1|| !tmpsc2|| !tmpsc3) { printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } if (ncthfs!=2) { volume=(double*)malloc(nelems*sizeof(double)); taill_r+=nelems; surfus=(double*)malloc(max(neleus,1)*sizeof(double)); taill_r+=max(neleus,1); if ( !volume|| !surfus) { printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } if (ltmax) { tmpmax=(double*)malloc(npoins*sizeof(double)); tmpmin=(double*)malloc(npoins*sizeof(double)); if (!tmpmax || !tmpmin) { printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } if (lray) { ngffir=(int*)malloc(max(nffira,1)*sizeof(int)); taill_i+=max(nffira,1); ngftir=(int*)malloc(max(nftira,1)*sizeof(int)); taill_i+=max(nftira,1); ngfper=(int*)malloc(max(nfpera,1)*sizeof(int)); taill_i+=max(nfpera,1); ngfpef=(int*)malloc(max(nfcfra,1)*sizeof(int)); taill_i+=max(nfcfra,1); ngfmst=(int*)malloc(max(nfmst*2,1)*sizeof(int)); taill_i+=max(nfmst*2,1); ngfmse=(int*)malloc(max(nfmste,1)*sizeof(int)); taill_i+=max(nfmste,1); vfmste=(double*)malloc(max(nfmste*2,1)*sizeof(double)); taill_r+=max(nfmste*2,1); phmstp=(double*)malloc(max(nfmst*4,1)*sizeof(double)); taill_r+=max(nfmst*4,1) ; phmsto=(double*)malloc(max(nfmst*5*nbande,1)*sizeof(double)); taill_r+=max(nfmst*5*nbande,1); flumst=(double*)malloc(max(nfmst*nbande,1)*sizeof(double)); taill_r+=max(nfmst*nbande,1); emissi=(double*)malloc(max(nelray*2*nbande,1)*sizeof(double)); taill_r+=max(nelray*2*nbande,1); epropr=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nelray*nbande,1); phfraf=(double*)malloc(max(nfcfra*4,1)*sizeof(double)); taill_r+=max(nfcfra*4,1); phfrae=(double*)malloc(max(nfpera*4,1)*sizeof(double)); taill_r+=max(nfpera*4,1); temray=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); firay=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nelray*nbande,1); vfiray=(double*)malloc(max(nffira*nbande*2,1)*sizeof(double)); taill_r+=max(nffira*nbande*2,1); erayeq=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); trayeq=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); erayen=(double*)malloc(max(npoinr,1)*sizeof(double)); taill_r+=max(npoinr,1); trayen=(double*)malloc(max(npoinr,1)*sizeof(double)); taill_r+=max(npoinr,1); nodray=(int*)malloc(max(nelray*ndim,1)*sizeof(int)); taill_i+=max(nelray*ndim,1); nrfray=(int*)malloc(max(nelray,1)*sizeof(int)); taill_i+=max(nelray,1); ityfar=(int*)malloc(max(nelray,1)*sizeof(int)); taill_i+=max(nelray,1); cooray=(double*)malloc(max(npoinr*ndim,1)*sizeof(double)); taill_r+=max(npoinr*ndim,1); fdfray=(double*)malloc(max(nelray*(nelray+1)/2,1)*sizeof(double)); taill_r+=max(nelray*(nelray+1)/2,1); sufray=(double*)malloc(max(nelray,1)*sizeof(double)); taill_r+=max(nelray,1); ncsray=(int*)malloc(max(nnsray,1)*sizeof(int)); taill_i+=max(nnsray,1); ncfray=(int*)malloc(max(nnfray,1)*sizeof(int)); taill_i+=max(nnfray,1); nesray=(int*)malloc(max(nneray,1)*sizeof(int)); taill_i+=max(nneray,1); ncfin=(int*)malloc(max(nbrays,1)*sizeof(int)); taill_i+=max(nbrays,1); ncgros=(int*)malloc(max(nnsray*2,1)*sizeof(int)); taill_i+=max(nnsray*2,1); barygr=(double*)malloc(max(nnsray*ndim,1)*sizeof(double)); taill_r+=max(nnsray*ndim,1); baryfs=(double*)malloc(max(nbrays*ndim,1)*sizeof(double)); taill_r+=max(nbrays*ndim,1); tabray=(double*)malloc(max(nelray*9,1)*sizeof(double)); taill_r+=max((nelray+1)*8,1); radios=(double*)malloc(max(nelray*nbande,1)*sizeof(double)); taill_r+=max(nfmst*5*nbande,1); if (!ngffir || !ngftir || !ngfper || !ngfpef || !ngfmst || !ngfmse || !vfmste || !phmstp || !phmsto || !flumst || !emissi || !epropr || !phfraf || !phfrae || !temray || !firay || !vfiray || !erayeq || !trayen || !erayen || !trayen || !nodray || !nrfray || !ityfar || !cooray || !fdfray || !sufray || !ncsray || !ncfray || !nesray || !ncfin || !ncgros || !barygr || !baryfs || !tabray || !radios) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } itrav=(int*)malloc(max(idtrav,1)*sizeof(int)); taill_it+=max(idtrav,1); itrav1=(int*)malloc(max(idtrav,1)*sizeof(int)); taill_it+=max(idtrav,1); if (!itrav||!itrav1){printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} trav1=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rt+=npoins; trav2=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rt+=npoins; if (!trav1||!trav2) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} if (nbprio) { itrav2=(int*)malloc(max(npoins,1)*sizeof(int)); taill_it+=npoins; trav3=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rt+=npoins; if (!itrav2||!trav3) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } #ifdef MED itravmed=(int*)malloc(max(nelems*ndmats,1)*sizeof(int)); taill_rt+=nelems*ndmats; if (!itravmed) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} #endif printf("\n\n ============================================================\n"); printf(" Memoire totale pour la phase initiale :\n\n"); printf(" Nombre d'entiers reserves : %9d\n",taill_i+taill_it); printf(" soit par noeud : %9d\n\n",(taill_i+taill_it)/npoins); printf(" Nombre de reels reserves : %9d\n",taill_r+taill_rt); printf(" soit par noeud : %9d\n",(taill_r+taill_rt)/npoins); printf("============================================================\n\n"); proc(inisol,INISOL) (&ndim,&ndiele,&nbface,&nfbida, &nbcous,&nbflus,&nbdirs,&nbechs,&nbflvs,&npfel,&npoins,&nelems, &ndmats,&neless,&ndmass,&neleus,&nelerc,&nelepr,&nelera,&nbress, &nbrays,&nbrais,&nbprio,&nbmobs,&nbcopr, &nbphys,&nppel,&npoue,&nbicor,&nbfflu,&nbfech,&nbfrai, ncoups,nfluss,ndirs,nechs,nfluvs,nrescs,nrayts, nrayis,nprios,nmobil, vfluss,vdirs,vechs,vfluvs,vrescs,vrayts,vrayis, nrefac,nrefal,nfcous,nfflus,nfechs,nfresc,nfrays,nfrais, vfflus,vfechs,vfresc,vfrays,vfrais, nrefs,nrefe,coords,nodes,nodess,nodeus,noderc,nodepr,nodera,angles, physol,tmpsa,tmps,tmpsc1,tmpsc2,tmpsc3,volume,surfus, &nelray,&npoinr,&nnsray,&nnfray,&nneray,&nfcfra,&nfcsra,&nftira, &nffira,&nfpera,&nfmst,&nfmste, ngffir,ngftir,ngfper,ngfpef, ngfmst,ngfmse,vfmste,phmstp,phmsto, emissi,phfraf,phfrae,temray,firay,vfiray,erayeq,trayeq, nodray,nrfray,ityfar,cooray,fdfray,sufray,ncsray,ncfray,nesray, ncfin,ncgros,barygr,baryfs,itrav,&idtrav,tabray,radios, itrav1,itrav2,trav1,trav2,trav3,&totrai,tmpmax,tmpmin,itravmed); proc(recusy,RECUSY)(&lsyrth,&lcface,&lray,&ntsyr,&ncthfs,&ldern,&lstops,&lhisor, &nchror,&lsdepl,&ntsmax,&ntsyrd,&lhisol,&nhrmax,&nbande,&ndprop, &rdtts,&tempss,&nfreqs,<max); free(itrav); free(itrav1); free(trav1); free(trav2); if (nbprio) {free(itrav2); free(trav3);} idtrav=max(npoins,npoinr);idtrav=max(idtrav,nelray); b=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rr+=npoins; trav1=(double*)malloc(max(idtrav,1)*sizeof(double)); taill_rr+=idtrav; trav2=(double*)malloc(max(idtrav,1)*sizeof(double)); taill_rr+=idtrav; trav3=(double*)malloc(max(idtrav,1)*sizeof(double)); taill_rr+=idtrav; trav4=(double*)malloc(max(idtrav,1)*sizeof(double)); taill_rr+=idtrav; dmat=(double*)malloc(max(idtrav,1)*sizeof(double)); taill_rr+=idtrav; xmat=(double*)malloc(max(nelems*ncoema,1)*sizeof(double)); taill_rr+=nelems*ncoema; diag=(double*)malloc(max(npoins,1)*sizeof(double)); taill_rr+=npoins; wct=(double*)malloc(max(nelems*ndmats,1)*sizeof(double)); taill_rr+=nelems*ndmats; if (!b||!trav1||!trav2||!trav3||!trav4||!dmat||!xmat||!diag||!wct) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} if (lcface) { travf=(double*)malloc(max(neleus*ndmass,1)*sizeof(double)); if (!travf) {printf("\n ERREUR D'ALLOCATION MEMOIRE\n");exit(0);} } if (ltmax) for (i=0;i the NOM_ARCH variable according your own system (if not detected automatically) --> the PATHSYR (generally, PATHSYR=/home/syrthes) 2. source the file syrthes.profile 3. Edit the file Makefile.in and check the compilers names and options In particular you may need to modify the following: a. The CC variable, to be the name of the ANSI C compiler in your system. The GNU C compiler (gcc) will do. b. The FC variable, to be the name of the FORTRAN compiler in your system. The GNU Fortran compiler (g77) will do. c. You can use CFLAGS, FCFLAGS and LDFLAGS to provide additional command line options that are required by your compilers and linker. 4. build the libraries and utilities : type 'make install' ========================= RUN PROCEDURE FOR SYRTHES ========================= Go to the directory where you want to perform SYRTHES calcultation. 1. make sure that the environment variable $SYRTHES_HOME is OK (if not, source the file /home/syrthes/syrthes3.4.3/bin/syrthes.profile) 2. create a new case with the command : syrthes_create_case mycase 3. cd mycase 4. prepare the data : - create a mesh (use convert2syrthes to convert format if needed) - update the data files syrthes.env, syrthes.data, syrthes.ray (if needed) - if needed, move some user files (usr/*.F) in the current directory and programm them 5. build the SYRTHES code : type 'make exe' or 'make' 6. run the code : type 'syrthes' 7. convert the result files for Ensight use : type 'syrthes2ensight -h' for help about this utility ========================= Contact Information ========================= If you have any comments, suggestions, or bug reports, please send them to syrthes-support@edf.fr Any bug fixes and upgrades of the SYRTHES packages is available on WWW at URL: http://rd.edf.com/syrthes syrthes-3.4.3-dfsg1/include/0000777000175000017500000000000011524070646014340 5ustar pinipinisyrthes-3.4.3-dfsg1/include/fic_bin_f.h0000666000175000017500000004110211524070646016405 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /*============================================================================* * Traitement de fichiers binaires Fortran de maniere portable sur les * * architectures 'big endian' et 'little endian' (en prenant le cas * * 'big endian' comme reference) depuis des programmes en C ou Fortran * * utilisant la librairie C standard * * * * Bibliotheque : Code_Saturne, SYRTHES Copyright EDF 2000 * *============================================================================*/ #ifndef _FIC_BIN_F_H_ #define _FIC_BIN_F_H_ #undef FORTRAN_WRAPER #define FORTRAN_WRAPPER /* Includes librairie */ #include "fortran_c.h" /* Longueur maximale de nom de fichier en cas d'appel depuis du code Fortran */ #define LEN_MAX_NOM_FIC_BIN_F 256 /* Code d'erreur `local' pour fin de fichier */ #define FIC_ERR_FIN 6532 #define FIC_ERR_FIN_MSG "Fin de fichier" /* Code d'erreur `local' pour contenu de fichier inattendu */ #define FIC_ERR_CONTENU 7653 #define FIC_ERR_CONTENU_MSG "Contenu de fichier inattendu" /* Code d'erreur `local' pour nom Fortran de fichier trop long */ #define FIC_ERR_LEN_NOM 8765 #define FIC_ERR_LEN_NOM_MSG "Nom de fichier trop long" /* Code d'erreur `local' pour taille enregistrement incompatible avec lecture */ #define FIC_ERR_SZE_ENR 9876 #define FIC_ERR_SZE_ENR_MSG "Taille d'enregistrement incompatible" /*============================================================================*/ /* Structures locales */ /*============================================================================*/ typedef struct { FILE *ptr; /* Pointeur de fichier */ int end_swap; /* 0 si l'on ne permute pas les octets, 1 sinon */ } fic_bin_t ; /*============================================================================*/ /* Prototypes de fonctions publiques */ /*============================================================================*/ /*----------------------------------------------------------------------------* * Ouverture d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine openbf(unit, ierror) char(*) nomfic ! -> Nom du fichier integer lnom ! -> Longueur du nom du fichier char modfic ! -> Mode d'ouverture demande ('r', 'w', ou 'a') integer lmod ! -> Longueur du nom du mode d'ouverture integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ #if defined(CHAINE_F_VERS_C_LEN_FIN) void fsymbol(openbf, OPENBF) ( char *nomfic, /* -> Nom du fichier */ integer_t *lnom , /* -> Longueur du nom de fichier */ char *modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ integer_t *lmod , /* -> Longueur de la chaine de mode d'ouverture */ integer_t *unit , /* <- Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror, /* <- Code de retour */ integer_t lennom, /* -> Longueur du nom de fichier */ integer_t lenmod /* -> Longueur de la chaine de mode d'ouverture */ ); #elif defined(CHAINE_F_VERS_C_STR_NUL) void fsymbol(openbf, OPENBF) ( char *nomfic, /* -> Nom du fichier */ integer_t *lnom , /* -> Longueur du nom de fichier */ char *modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ integer_t *lmod , /* -> Longueur de la chaine de mode d'ouverture */ integer_t *unit , /* <- Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ); #endif #endif /* FORTRAN_WRAPPER */ integer_t ouvre_fic_bin_f ( char *nomfic, /* -> Nom du fichier */ char modfic, /* -> Mode d'ouverture demande ('r', 'w', ou 'a') */ fic_bin_t *fic /* <- Pointeur sur le descripteur de fichier */ ); /*----------------------------------------------------------------------------* * Fermeture d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine closbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(closbf, CLOSBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ); #endif /* FORTRAN_WRAPPER */ integer_t ferme_fic_bin_f ( fic_bin_t *fic /* -> Pointeur sur le descripteur de fichier */ ); /*----------------------------------------------------------------------------* * Revenir au debut d'un fichier * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine rewdbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(rewdbf, REWDBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *ierror /* <- Code de retour */ ); #endif /* FORTRAN_WRAPPER */ integer_t debut_fic_bin_f ( fic_bin_t *fic /* -> Pointeur sur le descripteur de fichier */ ); /*----------------------------------------------------------------------------* * Tester si un fichier binaire est "big endian" ou "little endian". * * On suppose que l'on connait la longueur du premier enregistrement. * * Cette fonction doit s'appeller juste apres l'ouverture du fichier, et * * configure le fichier de maniere a ce que les lectures ulterieures se * * se fassent avec ou sans permutation des octets en fonction de ce test. * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine tendbf(unit, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(tendbf, OPENBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *ierror /* <- Code de retour */ ); #endif /* FORTRAN_WRAPPER */ integer_t test_end_fic_bin_f ( fic_bin_t *fic, /* -> Pointeur sur le descripteur de fichier */ int trec /* -> Taille du premier l'enregistrement */ ); /*----------------------------------------------------------------------------* * Lecture d'un enregistrement binaire IEEE de type Fortran ; * * * * On rappelle qu'un enregistrement commence et se termine par un marqueur * * (entier code sur 4 octets indiquant la taille en octets des donnees * * contenues dans l'enregistrement), permettant certaines operations de type * * lecture a vide ou retour en arriere d'un enregistrement. * * * * On fournit en argument un parametre mode indiquant le type de lecture : * * * * mode = 0 : Lecture complete de l'enregistrement * * 1 : Lecture partielle de 'nombre' d'elements * * 2 : Saut a la fin de l'enregistement * * * * On doit donc indiquer pour les modes 1 et 2 le nombre d'elements du meme * * enregistrement deja lus lors d'appels precedents a ce sous-programme, et * * si ce nombre est non nul, le nombre total d'elements de l'enregistrement * * (calcule a la premiere lecture). * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine readbf(unit, taille, nombre, mode, nbrlus, nbrtot, elems, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer nombre ! -> Nombre d'elements a lire au cours de cet appel integer mode ! -> Mode de lecture (0, 1, ou 2) integer nbrlus ! <-> Nombre d'elements de l'enregistrement deja lus integer nbrtot ! <-> Nombre total d'elements de l'enregistrement ? elems ! <-> Tableau des elements integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(readbf, READBF) ( integer_t *unit , /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *nombre, /* -> Nombre d'elements a lire au cours de cet appel */ integer_t *mode , /* -> Mode de lecture de l'enregistrement (0, 1, ou 2) */ integer_t *nbrlus, /* <-> Nombre d'elements de l'enregistrement deja lus */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems , /* <-> Tableau des elements */ integer_t *ierror /* <- Code de retour */ ); #endif /* FORTRAN_WRAPPER */ integer_t lit_fic_bin_f ( fic_bin_t *fic , /* -> Pointeur sur le descripteur de fichier */ integer_t taille, /* -> Taille des elements */ integer_t nombre, /* -> Nombre d'elements a lire au cours de cet appel */ integer_t mode , /* -> Mode de lecture de l'enregistrement (0, 1, ou 2) */ integer_t *nbrlus, /* <-> Nombre d'elements de l'enregistrement deja lus */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems /* <-> Tableau des elements */ ); /*----------------------------------------------------------------------------* * Ecriture d'un enregistrement binaire IEEE de type Fortran ; * * * * On rappelle qu'un enregistrement commence et se termine par un marqueur * * (entier code sur 4 octets indiquant la taille en octets des donnees * * contenues dans l'enregistrement), permettant certaines operations de type * * lecture a vide ou retour en arriere d'un enregistrement. * * * * On fournit en argument un parametre mode indiquant le type d'ecriture : * * * * mode = 0 : Ecriture complete de l'enregistrement * * 1 : Ecriture partielle de 'nombre' d'elements * * * * On doit donc indiquer pour le mode 1 le nombre d'elements du meme * * enregistrement deja ecrits lors d'appels precedents a ce sous-programme, * * ainsi que le nombre total d'elements a ecrire. * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine writbf(unit, taille, nombre, mode, nbrecr, nbrtot, elems, ierror) integer unit ! -> Numero d'unite logique du fichier (0 a 99) integer taille ! -> Taille d'un element integer nombre ! -> Nombre d'elements a ecrire au cours de cet appel integer mode ! -> Mode de lecture (0 ou 1) integer nbrecr ! <-> Nombre d'elements de l'enregistrement deja ecrits integer nbrtot ! <-> Nombre total d'elements de l'enregistrement ? elems ! <-> Tableau des elements integer ierror ! <- Code de retour (different de 0 en cas d'erreur) */ void fsymbol(writbf, WRITBF) ( integer_t *ptrfic, /* -> Numero d'unite logique du fichier (0 a 99) */ integer_t *taille, /* -> Taille des elements */ integer_t *nombre, /* -> Nombre d'elements */ integer_t *mode , /* -> Mode d'ecriture de l'enregistrement (0 ou 1) */ integer_t *nbrecr, /* <-> Nombre d'elements de l'enregistrement deja ecrits */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems, /* -> Tableau des elements */ integer_t *ierror /* <- Code de retour */ ); #endif /* FORTRAN_WRAPPER */ integer_t ecr_fic_bin_f ( fic_bin_t *fic , /* -> Pointeur sur descripteur de fichier */ integer_t taille, /* -> Taille des elements */ integer_t nombre, /* -> Nombre d'elements a ecrire au cours de cet appel */ integer_t mode , /* -> Mode d'ecriture de l'enregistrement (0 ou 1) */ integer_t *nbrecr, /* <-> Nombre d'elements de l'enregistrement deja ecrits */ integer_t *nbrtot, /* <-> Nombre total d'elements de l'enregistrement */ void *elems /* <-> Tableau des elements */ ); /*----------------------------------------------------------------------------* * Ecriture d'une chaine de caracteres correspondant a un numero d'erreur * *----------------------------------------------------------------------------*/ #ifdef FORTRAN_WRAPPER /* Equivalent Fortran : subroutine strebf(chaine, lchn, ierror) char(*) chaine ! <-> Chaine de caracteres receptrice integer lchn ! -> Longueur de la chaine receptrice integer ierror ! -> Code d'erreur */ #ifdef CHAINE_F_VERS_C_LEN_FIN void fsymbol(strebf, STREBF) ( char *chaine, /* <- Chaine de caracteres receptrice */ integer_t *lchn , /* -> Longueur de la chaine receptrice */ integer_t *ierror, /* -> Code d'erreur */ integer_t lenchn /* -> Longueur de la chaine receptrice */ ); #elif defined(CHAINE_F_VERS_C_STR_NUL) void fsymbol(strebf, STREBF) ( char *chaine, /* <- Chaine de caracteres receptrice */ integer_t *lchn , /* -> Longueur de la chaine receptrice */ integer_t *ierror /* -> Code d'erreur */ ); #endif #endif /* FORTRAN_WRAPPER */ void err_fic_bin_f ( char *chaine, /* <-> Chaine de caracteres receptrice */ integer_t ierror, /* -> Code d'erreur */ integer_t lmaxch /* -> Longueur maximale de la chaine receptrice */ ); #endif /* _FIC_BIN_F_H_ */ syrthes-3.4.3-dfsg1/include/regul.h0000666000175000017500000000320211524070646015624 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NRRMAX PARAMETER (NRRMAX=100) C INTEGER KC,NODREG,NBRREG,NRREG COMMON /IREGUL/ KC,NODREG,NBRREG,NRREG(NRRMAX) C DOUBLE PRECISION TIC,TDC,CN,TREG,PUINOM COMMON /RREGUL/ TIC,TDC,CN,TREG,PUINOM C syrthes-3.4.3-dfsg1/include/optct.h0000666000175000017500000000463011524070646015645 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NCTHFS,NITMXS,NCHROS,NLISTS,NFREQS,NAXE INTEGER ISOTRO,NTSMAX,NBDIPR,NBLBLA,NPLASY,NBANDE INTEGER NDPROP,NDFLUV,NCHROR,NDECMX,IAXISY,NBLBLR COMMON /OPTCTI/ NCTHFS,NITMXS,NCHROS,NLISTS,NFREQS,NAXE, * ISOTRO,NTSMAX,NBDIPR,NBLBLA,NPLASY,NBANDE, * NDPROP,NDFLUV,NCHROR,NDECMX,IAXISY,NBLBLR C DOUBLE PRECISION EPSGCS,RDTTS,DCORMX COMMON /OPTCTR/ EPSGCS,RDTTS,DCORMX C LOGICAL LGEOMF,LRESUF,LCHROF LOGICAL LHISOL,LCOIN,LSUISO,LCLEXP,LSDEPL,LSROTA LOGICAL LSTOKC,LECCOR,LCFACE,LCOSTA,LROUVR LOGICAL LRAY,LSTOKF,LECFDF,LSTORA,LLCORA,LPERAY LOGICAL LHISOR,LTMAX,LGEOMS,LREGUL C COMMON /OPTCTL/ LGEOMF,LRESUF,LCHROF, & LHISOL,LCOIN,LSUISO,LCLEXP,LSDEPL,LSROTA, & LSTOKC,LECCOR,LCFACE,LCOSTA,LROUVR, & LRAY,LSTOKF,LECFDF,LSTORA,LLCORA,LPERAY, & LHISOR,LTMAX,LGEOMS,LREGUL C syrthes-3.4.3-dfsg1/include/tree.h0000666000175000017500000000333011524070646015447 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| */ struct element { int num; struct element *suivant; } ; struct node { int name; double xc; double yc; double zc; double sizx; double sizy; double sizz; struct element *lelement; struct child *lfils; } ; struct child { int name; struct node *fils; struct child *suivant; } ; syrthes-3.4.3-dfsg1/include/fichct.h0000666000175000017500000000435311524070646015756 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C COMMON / REPCT / RAMON,RAVAL,RSUITE CHARACTER*200 RAMON,RAVAL,RSUITE C CHARACTER*200 CTCL,CTMAEF,CTGRF1,CTGRF2,CTGF2C,CTSUIT,CTGEOF CHARACTER*200 CTRESF,CTCHOF,CTHISR,CTCORR CHARACTER*200 CTGERA,CTRGRA,CTRRRA,CTRCRA,CTFFRA,CTCLRA CHARACTER*200 CTCORA,CTHIRA,CTSMRA,CTRMRA,CTEMRA COMMON / FICHCT / CTCL,CTMAEF,CTGRF1,CTGRF2,CTGF2C,CTSUIT,CTGEOF, & CTRESF,CTCHOF,CTHISR,CTCORR, & CTGERA,CTRGRA,CTRRRA,CTRCRA,CTFFRA,CTCLRA, & CTCORA,CTHIRA,CTSMRA,CTRMRA,CTEMRA C CHARACTER*3 TYPEF,TYPRA,TYPGS,TYPRS,TYPCS,TYPGR,TYPRR,TYPCR CHARACTER*3 TYPGF,TYPRF,TYPCF,TYPSU COMMON / TYPFCT / TYPEF,TYPRA,TYPGS,TYPRS,TYPCS,TYPGR,TYPRR,TYPCR, & TYPGF,TYPRF,TYPCF,TYPSU C syrthes-3.4.3-dfsg1/include/divct.h0000666000175000017500000000403611524070646015625 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NHSMAX,NDTMAX PARAMETER (NHSMAX=1000,NDTMAX=100) C INTEGER NPSSP1,NPFFP1,NPRAP1,NTSYR,NTSYRD INTEGER NBHSOL,NHISOL,NDTMUL,IDTMUL,IVECTO COMMON /DIVCTI/ NPSSP1,NPFFP1,NPRAP1,NTSYR,NTSYRD, * NBHSOL,NHISOL(NHSMAX),NDTMUL,IDTMUL(NDTMAX), * IVECTO C DOUBLE PRECISION TEMPSS,XFREQS,THISSO,XDTMUL,DTAUTO,DTAUTM COMMON /DIVCTR/ TEMPSS,XFREQS,THISSO,XDTMUL(NDTMAX), * DTAUTO,DTAUTM C CHARACTER TITSOL*80 COMMON /DIVCTC/ TITSOL C LOGICAL PREMPA,LDERN,LVECTB COMMON /DIVCTL/ PREMPA,LDERN,LVECTB syrthes-3.4.3-dfsg1/include/abs.h0000666000175000017500000000274511524070646015266 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| */ #define min(a,b) (ab ? a:b) #define abs(a) (a>=0 ? a:-(a)) syrthes-3.4.3-dfsg1/include/const.h0000666000175000017500000000226611524070646015645 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ #define eps 1.E-6 syrthes-3.4.3-dfsg1/include/rayonn.h0000666000175000017500000000360311524070646016021 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NGUMAX,NHRMAX,NBAMAX PARAMETER (NGUMAX=32,NHRMAX=1000,NBAMAX=100) C DOUBLE PRECISION SIGMA,TKEL PARAMETER (SIGMA=5.6696D-8, TKEL=273.15D0) C DOUBLE PRECISION PLASYM ,PINTER ,SPECTL , & PERRAY ,TEMINF COMMON / RAYONR / PLASYM(4,3),PINTER(3,NGUMAX),SPECTL(NBAMAX,2), & PERRAY(7),TEMINF C INTEGER NUMGU,NBHSOR,NHISOR COMMON / RAYONI / NUMGU,NBHSOR,NHISOR(NHRMAX) syrthes-3.4.3-dfsg1/include/bilan.h0000666000175000017500000000326711524070646015606 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NBISMX,NRFMA2 PARAMETER (NRFMA2 = 99,NBISMX= 99) C INTEGER IRBILS(NRFMA2,NBISMX),NBILAS,IRBILV(NRFMA2,NBISMX),NBILAV DOUBLE PRECISION BFLUSU(NBISMX,3),BFLUVO(NBISMX) C COMMON /IBILAN/ IRBILS,IRBILV,NBILAS,NBILAV C COMMON /RBILAN/ BFLUSU,BFLUVO C syrthes-3.4.3-dfsg1/include/mobil.h0000666000175000017500000000353611524070646015622 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NMOBMX PARAMETER (NMOBMX = 10) C DOUBLE PRECISION D1MAXF,D2MAXF,D1MAXS,DEFMOB(NMOBMX,10) DOUBLE PRECISION TRXMOB,TRYMOB,TRZMOB,VTRMOB,TMOB,XLMOB,TENMOB DOUBLE PRECISION TRNMOB COMMON /MOBILR/ D1MAXF,D2MAXF,D1MAXS,DEFMOB, * TRXMOB,TRYMOB,TRZMOB,VTRMOB,TMOB,XLMOB,TENMOB, * TRNMOB C INTEGER NBRMOB,NBNMA1,NBEMA1 COMMON /MOBILI/ NBRMOB,NBNMA1,NBEMA1 C syrthes-3.4.3-dfsg1/include/syrthu.h0000666000175000017500000000271611524070646016055 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C LOGICAL LSTOPS COMMON /SYRTHU/ LSTOPS syrthes-3.4.3-dfsg1/include/fortran_c.h0000666000175000017500000000231711524070646016471 0ustar pinipini/*============================================================================*/ /* Definitions pour la combinaison de sous-programmes en Fortran et en C */ /* */ /* Bibliotheque : Code_Saturne, SYRTHES Copyright EDF 2000 */ /*============================================================================*/ #ifndef _FORTRAN_C_H_ #define _FORTRAN_C_H_ /* Definitions de types */ #undef integer_t #undef real_t #define integer_t int /* Type "INTEGER" en Fortran */ #define real_t double /* Type "REAL*8" ou "DOUBLE PRECISION" en Fortran */ #define integer_4_t int /* Entier de 4 octets de long */ #ifndef __hpux #define UNDERSCORE #endif #ifdef UNDERSCORE #define fsymbol(x, y) x##_ #else #define fsymbol(x, y) x #endif /* Passage d'argument de type chaine de caracteres Fortran -> C rencontre sur de nombreux systemes : les longeurs des chaines Fortran sont ajoutees a la fin de la liste des arguments de la fonction C correspondante */ #ifndef __uxpv__ #define CHAINE_F_VERS_C_LEN_FIN #else #define CHAINE_F_VERS_C_STR_NUL #endif #endif /* _FORTRAN_C_H_ */ syrthes-3.4.3-dfsg1/include/f2c_syrthes.h0000666000175000017500000000143011524070646016742 0ustar pinipini#ifdef __sgi #define name2(a,b) a##b #define proc(x,y) name2(x,_) #define proci(x) x #else #ifdef sun #define name2(a,b) a/**/b #define proc(x,y) name2(x,_) #define proci(x) x #else #ifdef __alpha #define name2(a,b) a/**/b #define proc(x,y) name2(x,_) #define proci(x) x #else #ifdef CRAY #define name2(a,b) a/**/b #define proc(x,y) y #define proci(x) x #else #ifdef __uxpv__ #define name2(a,b) a##b #define proc(x,y) name2(x,_) #define proci(x) x #else #ifdef __linux__ #define name2(a,b) a##b #define proc(x,y) name2(x,_) #define proci(x) x #else #ifdef __aix__ #define name2(a,b) a##b #define proc(x,y) name2(x,_) #define proci(x) x #else #define name2(a,b) a/**/b #define proc(x,y) x #define proci(x) name2(x,_) #endif #endif #endif #endif #endif #endif #endif syrthes-3.4.3-dfsg1/include/interfaces.h0000666000175000017500000002744211524070646016645 0ustar pinipini/*----------------------------------------------------------------------- SYRTHES version 3.4 ------------------- This file is part of the SYRTHES Kernel, element of the thermal code SYRTHES. Copyright (C) 1988-2008 EDF S.A., France contact: syrthes-support@edf.fr The SYRTHES Kernel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The SYRTHES Kernel is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the Code_Saturne Kernel; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -----------------------------------------------------------------------*/ /*|======================================================================| | SYRTHES 3.4.3 COPYRIGHT EDF 2008 | |======================================================================| */ #include "f2c_syrthes.h" void alter_axi1 (int,int,double*,double*); void affiche_tree (struct node *,int); void axi_integ_fc (double*,double*,double*); void axi_integ_vis (double*,double*,double*); void bary3d (double,double,double,double,double,double,double,double,double, double,double,double,double *,double *,double *); void boite (int,int,double*,double*); void boite2 (int,int,double*,int,double*,double*); void box_2d (int,double *); void box_3d (int,double *); void build_octree (struct node * ,int,int ,int ,int *,double *,double *,double *); void build_octree_1d (struct node * ,int,int ,int ,int *,double *,double *,double *); void build_quadtree_1d(struct node *, int,int ,int, int *,double *,double *,double *); void cal_dmin (double,double,double, double *,double *,double *,double *, double *,double *, double *,double *,double *, int,double *,double *,double *, double *,int *,int *,int *); void cnor_2d (int,int,int,int *,double *,double *); void cnor_3d (int,int,int,int *,double *,double *); void connex_2d (int*, int*, int, int, int*, int, int) ; void connex_3d (int*, int*, int, int, int*, int, int) ; double coplanaire_2a (int,double,double,double,double); double coplanaire_2d (double,double,double,double); double coplanaire_3d (double,double,double,double,double,double); void couple_mst_2d (int,int*,int,int,int*,double*,double*,int); void couple_mst_3d (int,int*,int,int,int*,double*,double*,int); int diag_tria (double,double,double,double,double,double,double,double*); void decoupe (struct node *,int *,double *,int,int,int,double*); void decoupe1d (struct node *,int *,double *,int,int,int,double*); void decoupe_seg (int,int,int,double *,double *,double *,double *,double *,int); void decoupe_totd (int,int,int,double *,double *,double *,double *,double *,double *,int); void decoupe_toqd (int,int,int,double *,double *,double *,double *,double *, double *,double *,double *,double *,int); void decoupe_tdtd (int,int,int,double *,double *,double *,double *,double *, double *,int); void decoupe_qdqd (int,int,int,double *,double *,double *,double *,double *, double *,double *,double *,double *,double *,double *, double *,int); void decoupe_tdqd (int,int,int,double *,double *,double *,double *,double *, double *,double *,double *,double *,double *,double *,double *,int); void decouphor_2a (int,double * , double *, double, double, double ,double); void derriere_2a (int,int,int,double,double,double,double,double,double,double,double,int*); void derriere_2d (int,int,int,double*,double*,double*,double*,double*,int*); void derriere_3d (int,int,int,double*,double*,double*,double*,double*,double*,int*); double determ (double,double,double, double,double,double,double,double,double); void dimension_3d (int,int,int,int *,double *,double *,double *); void dimension_2d (int,int,int,int *,double *,double *,double *); void dupliq2d_per (int,double*,int,double*, int,int,int*,double*,double*,int*,int*,int*,double*,double*,int*,int*); void dupliq3d_per (int,double*,int,double*, int,int,int*,double*,double*,int*,int*,int*,double*,double*,int*,int*); void dupliq2d_sym (int,double*, int,int,int*,double*,double*,int*,int*,int*,double*,double*,int*,int*); void dupliq3d_sym (int,double*, int,int,int*,double*,double*,int*,int*,int*,double*,double*,int*,int*); void elague_tree (struct node *,struct node *,int); void facforme_2a_fc (int,int,int,int,int*,double*,double*,double*,double*,int,int,int,int*,int); void facforme_2a_vis (int,int,int,int,int*,double*,double*,double*,double*,int,int,int,int*,int); void facforme_2d (int,int,int,int,int*,double*,double*,double*,double*,int*,int,int,int,int*,int); void facforme_3d (int,int,int,int,int*,double*,double*,double*,double*,int*,int,int,int,int*,int); void facecache_2d (int,int,int,int,int*,double*,double*, int* ,int,int); void facecache_2a (int,int,int,int,int*,double*,double*, int* ,int); void facecache_3d (int,int,int,int,int*,double*,double*, int* ,int,int); void find_node_2d (struct node **, double , double); void find_node_3d (struct node **, double , double , double); void gauss (void); void group_2d (int,int,int,int*,int*,int); void group_3d (int,int,int,int*,int*,int); int indvoir (int,int,int); void iniori_2d (int*, int*, double*, int*, int*, int, int , double*, int*, int, int*, int*, int , int*, int) ; void iniori_3d (int*, int*, double*, int*, int*, int, int , double*, int*, int, int*, int*, int , int*, int) ; int in_boite (double,double,double, double,double,double,double,double,double); int in_triangle (double , double , double , double , double ,double ,double ,double ,double ,double , double ,double ,double , double ,double ,double); int in_rectan (double,double,double,double,double,double); int in_seg (double, double, double, double,double, double); void ivoitj_2d (struct node *,struct node *, struct node *, double *,double *,double *,int *,double,int ,int, int *, double *, int *,double *); void ivoitj_3d (struct node *,struct node *, struct node *, double *,double *,double *,int *,double,int ,int, int *, double *,int *,double *); void histog (int,double *,double,double,int *,int); void orie2d (int *,int,int,int *,double *,double *,int,int,int,int *); void oriene_2d (int*, int*, int, int*, int*, int*, int*, int); void oriene_3d (int*, int*, int, int*, int*, int*, int*, int); void persym3d (double[4][4],int,int,int,int,int*,double*,double*,int,int,int*, double*,double*,int,int,int*,int*); void quel_angle (int,int,double ,double,double,double,double,double,double,double,int*,int*); void quel_angle_hide (int,int,double ,double,double,double,double,double,double,double); int quel_fils_3d (double , double , double, struct child *, double , double , double); int quel_fils_2d (double , double , struct child *, double , double); int racines_2d (double ,double,double,double, double,double,double,double,int); int racines_3d (double,double,double, double,double,double,double,double,double, double,double,double,double,double,double,int); int ray_inter_seg (struct node *,struct node * ,int,double *,double *, int,int,int *,double *,int *); int ray_inter_triangle(struct node *,struct node * ,int,double *,double *, int,int,int *,double *,int *); void resoud3 (double,double,double,double,double,double,double,double,double, double *,double *,double *); void rorien_2d (int,int,int,int*,int*,int*,int,int*,int ) ; void rorien_3d ( int,int,int,int,int*,int*,int*,int,int*,int ) ; void segfdf (struct node* ,double,double*,int*,double*,double*, int*,int*,int,int,int*,double*,int*,double*,int*,int); void segfdfaxi (int,int,int,double*,double*,int,int,int*,double*,double*); int seg_cubex (double,double,double,double,double,double,double,double,double); int seg_cubey (double,double,double,double,double,double,double,double,double); int seg_cubez (double,double,double,double,double,double,double,double,double); int seg_in_rectan (double,double,double,double, double,double,double,double); int seg_rectanx (double,double,double,double,double,double); int seg_rectany (double,double,double,double,double,double); void soutri (double,double,double,double,double,double,double,double,double, double,double,double,int *); void surface_anneau (int,int,int,int*,double*,double*); void surface_seg (int,int,int*,double*,double*); void surface_tria (int,int,int*,double*,double*); void sym2d (double[3][3],int,int,int,int,int*,double*,double*,int,int,int*, double*,double*,int,int,int*,int*); void sym3d (double[4][4],int,int,int,int,int*,double*,double*,int,int,int*, double*,double*,int,int,int*,int*); void tab_integ (int,int); void triafdf (struct node* ,double,double*,int*, double*,double*,double*,double*,double*,double*, int*,int*,int,int,int*,double*,int*,double*,int*,int); int tria_in_cube (double,double,double,double,double,double, double,double,double,double,double,double, double,double,double); void triface (struct element *,struct element *,int*, int,int, int *,double *, double,double,double,double,double,double); void triseg (struct element *,struct element *,int*,int,int, int *,double *, double,double,double,double); void tuer_tree (struct node *,int); void verif_coor_3d (int,int,int,int *,double *,int ,double *, int ,double *,int,double); void veri_fbor_3d (int,int,int, int *, int *); void veri_nbor_3d (int,int,int,int*,int*,int*, int *,int); void veri_per_3d (int,int,int,int*,double*,int,double*); void veri_sym_3d (int,int,int,int *,double *,int,double *,int,double); void voisic_2d (int*, int*, int, int, int) ; void voisic_3d (int*, int*, int, int, int) ; void voxel_voisin_2d (double *,double *,double,double, double,double, double*,double*,double *,double); void voxel_voisin_3d (double *,double *,double *,double,double,double, double,double,double, double*,double*,double *,double); /* Fonctions C appellees depuis des sous-programmes Fortran */ void proc (soutri, SOUTRI) (double, double, double, double, double, double, double, double, double, double, double, double, int *); syrthes-3.4.3-dfsg1/include/nlofct.h0000666000175000017500000000357611524070646016011 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NFSGCT,NFCLCT,NFGGCT,NFGRCT,NFGCCT,NFGSCT,NFGFCT INTEGER NFRFCT,NFCFCT,NFHRCT,NFCOCT INTEGER NFSGRA,NFGGRA,NFGRRA,NFGCRA,NFFFRA,NFCLRA INTEGER NFCORA,NFHIRA,NFSMRA,NFRMRA,NFEMRA COMMON /NLOFCT/ NFSGCT,NFCLCT,NFGGCT,NFGRCT,NFGCCT,NFGSCT,NFGFCT, & NFRFCT,NFCFCT,NFHRCT,NFCOCT, & NFSGRA,NFGGRA,NFGRRA,NFGCRA,NFFFRA,NFCLRA, & NFCORA,NFHIRA,NFSMRA,NFRMRA,NFEMRA C syrthes-3.4.3-dfsg1/include/nlofes.h0000666000175000017500000000274311524070646016005 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NFECRA,NFCLAV COMMON / NLOFES / NFECRA,NFCLAV C syrthes-3.4.3-dfsg1/include/xrefer.h0000666000175000017500000000425311524070646016010 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C INTEGER NRFMAX PARAMETER (NRFMAX = 99) C INTEGER IREFFC(NRFMAX) INTEGER IREFSC(NRFMAX), IREFSD(NRFMAX), IREFSF(NRFMAX) INTEGER IREFSE(NRFMAX), IREFSV(NRFMAX), IREFRE(NRFMAX) INTEGER IREFRA(NRFMAX), IREFPR(NRFMAX), IREFMO(NRFMAX) INTEGER IREFRI(NRFMAX), IREFRF(NRFMAX) INTEGER IRERCS(NRFMAX), IRERCF(NRFMAX), IRERTI(NRFMAX) INTEGER IRERFI(NRFMAX), IRERPE(NRFMAX) INTEGER IRESTE(NRFMAX), IRESTF(NRFMAX), IRESTS(NRFMAX) INTEGER IRESTB(NRFMAX), IRESTC(NRFMAX) C COMMON /IREFER/ IREFFC, IREFSC, IREFSD, IREFSF, IREFSE, IREFSV, * IREFRE, IREFRA, IREFPR, IREFMO, IREFRI, IREFRF, * IRERCS, IRERCF, IRERTI, IRERFI, IRERPE, * IRESTE, IRESTF, IRESTS, IRESTB, IRESTC C syrthes-3.4.3-dfsg1/include/syrth.h0000666000175000017500000000303211524070646015660 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C LOGICAL LSYRTH COMMON /SYRTHL/ LSYRTH C INTEGER NSYRTI,NSYRTR COMMON /SYRTHI/ NSYRTI,NSYRTR C syrthes-3.4.3-dfsg1/include/iadrct.h0000666000175000017500000000734311524070646015766 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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*********************************************************************** C* SYRTHES 3.4.3 COPYRIGHT EDF 2008 * C*********************************************************************** C C INTEGER INCOUS,INCOUF,INFLSS,INDIRS,INECHS,INRESS,INRAYS INTEGER INFLVS,INPRIO,IREFS ,INODES,IVCOUS,IVCOUF,IVFLSS INTEGER IVDIRS,IVECHS,IVRESS,IVRAYS,IVFLVS,ICOORF,ICOORS INTEGER IPHYSO,ITMPA ,ITMP ,IVOLU ,INCS ,INCF ,INODSF INTEGER IBARYS,IBARYF,ITMPC1,ITMPC2,ITMPC3,INODSS,INODUS INTEGER INODRS,INODRA,ISURFU, INMOBS,ITRV ,INHSOL INTEGER IB ,IDMAT ,IXMAT ,IDIAG ,ITRA1 ,ITRA2 ,ITRA3 INTEGER ITRA4 ,ITRA5 ,IWCT ,INODPR,INFCOU,INFFLS,INFECH INTEGER INFRES,INFRAY,IVFCOU,IVFFLS,IVFECH,IVFRES,IVFRAY INTEGER INRFA ,INRFAL,ITRAFA,ICOORA,INORAY,IFDF INTEGER IBARYR,INCGRO,INCFIN,INRAYI,IVRAYI,INFRAI,IVFRAI INTEGER ISURAY,INDRAF,IRFRAY,INRAF ,IVRAF ,INCSR ,INCFR INTEGER INESR ,INCFI2,INCGR2,IBARY2,ICAF ,IRAD ,IFIR INTEGER IEMI ,IEMP ,IPHRF ,ITRAY ,ITREQ ,IEREQ ,IPHRE INTEGER IFFIR ,IFTIR ,IFPER ,IFPERF,IVFIR ,IREFE INTEGER IBARFS,IBARFF,ITREN ,IEREN ,ITRESR,ITFR ,IFPST INTEGER IPHSTP,IPHSTO,INHSOR,IFLUST,IFPSTE,IMSTEC C COMMON /IADRCT/ INCOUS,INCOUF,INFLSS,INDIRS,INECHS,INRESS,INRAYS, * INFLVS,INPRIO,IREFS ,INODES,IVCOUS,IVCOUF,IVFLSS, * IVDIRS,IVECHS,IVRESS,IVRAYS,IVFLVS,ICOORF,ICOORS, * IPHYSO,ITMPA ,ITMP ,IVOLU ,INCS ,INCF ,INODSF, * IBARYS,IBARYF,ITMPC1,ITMPC2,ITMPC3,INODSS,INODUS, * INODRS,INODRA,ISURFU, INMOBS,ITRV ,INHSOL, * IB ,IDMAT ,IXMAT ,IDIAG ,ITRA1 ,ITRA2 ,ITRA3, * ITRA4 ,ITRA5 ,IWCT ,INODPR,INFCOU,INFFLS,INFECH, * INFRES,INFRAY,IVFCOU,IVFFLS,IVFECH,IVFRES,IVFRAY, * INRFA ,INRFAL,ITRAFA,ICOORA,INORAY,IFDF, * IBARYR,INCGRO,INCFIN,INRAYI,IVRAYI,INFRAI,IVFRAI, * ISURAY,INDRAF,IRFRAY,INRAF ,IVRAF ,INCSR ,INCFR, * INESR ,INCFI2,INCGR2,IBARY2,ICAF ,IRAD ,IFIR , * IEMI ,IEMP ,IPHRF ,ITRAY ,ITREQ ,IEREQ ,IPHRE, * IFFIR ,IFTIR ,IFPER ,IFPERF,IVFIR ,IREFE , * IBARFS,IBARFF,ITREN ,IEREN ,ITRESR,ITFR ,IFPST, * IPHSTP,IPHSTO,INHSOR,IFLUST,IFPSTE,IMSTEC C syrthes-3.4.3-dfsg1/bin/0000777000175000017500000000000011524070646013465 5ustar pinipinisyrthes-3.4.3-dfsg1/bin/Makefile.in0000666000175000017500000001000111524070646015522 0ustar pinipini#----------------------------------------------------------------------- # # SYRTHES version 3.4 # ------------------- # # This file is part of the SYRTHES Kernel, element of the # thermal code SYRTHES. # # Copyright (C) 1988-2008 EDF S.A., France # # contact: syrthes-support@edf.fr # # # The SYRTHES Kernel is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # The SYRTHES Kernel is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # # You should have received a copy of the GNU General Public License # along with the Code_Saturne Kernel; if not, write to the # Free Software Foundation, Inc., # 51 Franklin St, Fifth Floor, # Boston, MA 02110-1301 USA # #----------------------------------------------------------------------- # # Compilers names and options ####################################### # ifeq ($(NOM_ARCH), Linux) #------------------------ # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/gcc CFLAGS = -O2 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/g77 FCFLAGS = -O2 -DHAVE_C_IO -D_FILE_OFFSET_BITS=64 # loader LD = /usr/bin/g77 LDFLAGS = -O2 # endif ifeq ($(NOM_ARCH), Linux_x86_64) #------------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/gcc CFLAGS = -O2 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/g77 FCFLAGS = -O2 -DHAVE_C_IO -D_FILE_OFFSET_BITS=64 # loader LD = /usr/bin/g77 LDFLAGS = -O2 # endif ifeq ($(NOM_ARCH), Linux_Ch) #--------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/gcc CFLAGS = -O2 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/g77 FCFLAGS = -O2 -DHAVE_C_IO -D_FILE_OFFSET_BITS=64 # loader LD = /usr/bin/g77 LDFLAGS = -O2 # endif ifeq ($(NOM_ARCH), HP-UX) #------------------------ # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/cc CFLAGS = +O3 +DAportable -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/f90 FCFLAGS = +O3 +DAportable -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # loader LD = /usr/bin/f90 LDFLAGS = +U77 +DAportable +O3 # endif ifeq ($(NOM_ARCH), IRIX64) #------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/gcc CFLAGS = -cckr -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/g77 FCFLAGS = -cckr -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # loader LD = /usr/bin/g77 LDFLAGS = -O2 # endif ifeq ($(NOM_ARCH), Linux_IA64) #---------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = /usr/bin/cc CFLAGS = -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = /usr/bin/f77 FCFLAGS = -O2 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # loader LD = /usr/bin/f77 LDFLAGS = -O2 # endif ifeq ($(NOM_ARCH), Blue_Gene_L) #------------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = mpicc CFLAGS = -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = bgxlf FCFLAGS = -O3 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # loader LD = bgxlf LDFLAGS = -O3 # endif ifeq ($(NOM_ARCH), Blue_Gene_P) #------------------------------- # Preprocesseur PREPROC = PREPROCFLAGS = # C compiler CC = bgxlc CFLAGS = -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # FORTRAN compiler FC = bgxlf FCFLAGS = -O3 -D_FILE_OFFSET_BITS=64 -DHAVE_C_IO # loader LD = bgxlf LDFLAGS = -O3 # endif syrthes-3.4.3-dfsg1/bin/Makefile0000666000175000017500000001231511524070646015127 0ustar pinipini#----------------------------------------------------------------------- # # SYRTHES version 3.4 # ------------------- # # This file is part of the SYRTHES Kernel, element of the # thermal code SYRTHES. # # Copyright (C) 1988-2008 EDF S.A., France # # contact: syrthes-support@edf.fr # # # The SYRTHES Kernel is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # The SYRTHES Kernel is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # # You should have received a copy of the GNU General Public License # along with the Code_Saturne Kernel; if not, write to the # Free Software Foundation, Inc., # 51 Franklin St, Fifth Floor, # Boston, MA 02110-1301 USA # #----------------------------------------------------------------------- # # Makefile for Syrthes ###################### include $(SYRTHES_HOME)/bin/Makefile.in # Environment Macros # ================== SHELL = /bin/sh VERSION = "3.4.3" # Project configuration macros # ============================ # Test if variable SYRTHES_HOME is set ifndef SYRTHES_HOME $(error SYRTHES_HOME is not defined, run 'syrthes.profile' to set a correct value) endif ifeq ($(SYRTHES_HOME),) $(error SYRTHES_HOME is a empty string, run 'syrthes.profile' to set a correct value) endif # Base project directories DIR_SYRTHES = $(SYRTHES_HOME) BIN_SYRTHES = $(DIR_SYRTHES)/bin INC_SYRTHES = $(DIR_SYRTHES)/include SRC_SYRTHES = $(DIR_SYRTHES)/src UTIL_SYRTHES = $(SRC_SYRTHES)/util ARCH_SYRTHES = $(DIR_SYRTHES)/lib/$(NOM_ARCH) EXEC_SYRTHES = $(DIR_SYRTHES)/bin/$(NOM_ARCH) # Names of the base library and Syrthes executable file NOM_PREFIX = "syrthes" NOM_LIB_MAIN = "libmain"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_LIB_SAT = "libsat"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_LIB_SYRTHES = "lib"$(NOM_PREFIX)$(VERSION)_$(NOM_ARCH) NOM_EXE = "syrthes" NOM_UTIL1 = "syrthes2ensight" # Presentation macros #-------------------- BO = `tput bold` SO = `tput smso` NO = `tput rmso; tput sgr0` # Target definitions #=================== exe: @for ffile in *.F ; do \ if [ -f $${ffile} ] ; then \ echo "$${ffile} " ;\ $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $${ffile} ;\ fi ;\ done @for cfile in *.c ; do \ if [ -f $${cfile} ] ; then \ echo "$${cfile} " ;\ $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $${cfile} ;\ fi ;\ done ar xv $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a syrthes.o $(LD) $(LDFLAGS) -o $(NOM_EXE) *.o \ $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a \ $(ARCH_SYRTHES)/$(NOM_LIB_SYRTHES).a -lm @rm *.o @echo "*** Executable '$(NOM_EXE)' created " lib: $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/s/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/s/*.c @ar rv $(NOM_LIB_SYRTHES).a *.o @rm -f *.o $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/ss/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/ss/*.c @ar rv $(NOM_LIB_MAIN).a *.o @rm -f *.o $(FC) -c $(FCFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/sc/*.F $(CC) -c $(CFLAGS) -I$(INC_SYRTHES) $(SRC_SYRTHES)/sc/*.c @ar rv $(NOM_LIB_SAT).a *.o @rm -f *.o @if [ ! -d "$(ARCH_SYRTHES)" ] ;\ then mkdir "$(ARCH_SYRTHES)" ;\ fi ;\ @mv *.a $(ARCH_SYRTHES) # @echo "*** Libraries created in directory $(ARCH_SYRTHES)" install: lib util @echo "*** installation successfull" util: $(CC) $(CFLAGS) -o $(NOM_UTIL1) $(UTIL_SYRTHES)/$(NOM_UTIL1).c @if [ ! -d "$(EXEC_SYRTHES)" ] ; then \ mkdir "$(EXEC_SYRTHES)" ;\ fi ;\ @mv $(NOM_UTIL1) $(EXEC_SYRTHES) # @echo "***Executable '$(NOM_UTIL1)' created in directory $(EXEC_SYRTHES)" clean: @rm -f *.o distclean: clean @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_SYRTHES).a @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_MAIN).a @rm -f $(ARCH_SYRTHES)/$(NOM_LIB_SAT).a @rm -f $(NOM_EXE) @rm -f $(EXEC_SYRTHES)/$(NOM_UTIL1) help info: @echo @echo "*** Syrthes $(VERSION) compilation/link" @echo "*** System: $(NOM_ARCH)" @echo @echo @echo "Usage : $(BO)make$(NO) $(SO)$(NO) (in a user directory)" @echo " for Syrthes link" @echo @echo " with :" @echo " $(SO)$(NO) : $(BO)exe$(NO) : 'syrthes' executable (default)" @echo " $(BO)install$(NO) : libraries creation and utilitaries" @echo " $(BO)lib$(NO) : libraries creation" @echo " $(BO)util$(NO) : utilitaries" @echo " $(BO)clean$(NO) : deletes object files" @echo " $(BO)distclean$(NO) : deletes object files, libraries, and utilitaries" @echo " $(BO)help$(NO) : this message" @echo " $(BO)info$(NO) : same" @echo @echo " and the additional user options:" @echo " $(SO)$(NO) : C compiler options" @echo " $(SO)$(NO) : Fortran compiler options" @echo " $(SO)$(NO): linker options" @echo syrthes-3.4.3-dfsg1/bin/syrthes.profile0000666000175000017500000000455711524070646016563 0ustar pinipini#----------------------------------------------------------------------- # # SYRTHES version 3.4 # ------------------- # # This file is part of the SYRTHES Kernel, element of the # thermal code SYRTHES. # # Copyright (C) 1988-2008 EDF S.A., France # # contact: syrthes-support@edf.fr # # # The SYRTHES Kernel is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # The SYRTHES Kernel is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # # You should have received a copy of the GNU General Public License # along with the Code_Saturne Kernel; if not, write to the # Free Software Foundation, Inc., # 51 Franklin St, Fifth Floor, # Boston, MA 02110-1301 USA # #----------------------------------------------------------------------- # Architecture name and location of the directory for installation # ================================================================ NOM_ARCH=`uname -s` PATHSYR=/home/syrthes #------------------------------------------------------------------------ # Only in case of installation on multiple architectures # Architecture NOM_ARCH=`uname -s` if [ "$NOM_ARCH" = "Linux" ] ; then if [ "`hostname | cut -c1-7`" = "platine" ] ; then NOM_ARCH=Linux_IA64 elif [ "`domainname 2>/dev/null`" = "cluster-chatou" ] ; then NOM_ARCH=Linux_Ch elif [ -d /bgl/BlueLight/ppcfloor ] ; then NOM_ARCH=Blue_Gene_L elif [ -d /bgsys/drivers/ppcfloor ] ; then NOM_ARCH=Blue_Gene_P else MACHINE=`uname -m` case "$MACHINE" in *86) NOM_ARCH=Linux ;; x86_64) NOM_ARCH=Linux_x86_64 ;; ia64) NOM_ARCH=Linux_IA64 ;; *) NOM_ARCH=Linux_$MACHINE ;; esac fi fi #----------------------------------------------------------- # SYRTHES_HOME=${PATHSYR}/syrthes3.4.3 # # Path PATH=${SYRTHES_HOME}/bin:${SYRTHES_HOME}/bin/${NOM_ARCH}:$PATH export PATH # Export des variables export NOM_ARCH NOM_USER SYRTHES_HOME syrthes-3.4.3-dfsg1/bin/syrthes_create_case0000666000175000017500000000215511524070646017432 0ustar pinipini#!/bin/sh #========================================================================== # Creation d'un cas SYRTHES #========================================================================== echo echo "***************************************** " echo " $1 : creating SYRTHES case... " if [ $# -eq 0 ] ; then echo " too few arguments for syrthes_case " echo " --> usage : syrthes_case name" echo "***************************************** " exit fi if [ -d "$1" -o -f "$1" ]; then echo " --> file exists, choose another name" echo "***************************************** " exit fi if [ -z "$SYRTHES_HOME" ]; then echo " --> SYRTHES_HOME not found" echo "***************************************** " exit fi #========================================================================== # creation du cas #========================================================================== mkdir $1 cd $1 cp -r ${SYRTHES_HOME}/usr . cp ${SYRTHES_HOME}/bin/Makefile . cp ${SYRTHES_HOME}/data/* . cd .. echo " OK ! " echo "***************************************** " echo syrthes-3.4.3-dfsg1/usr/0000777000175000017500000000000011524070646013526 5ustar pinipinisyrthes-3.4.3-dfsg1/usr/cphyso.F0000666000175000017500000004176511524070646015157 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CPHYSO C ***************** C C --------------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,PHYSOL,NPOUE,NPPEL,NBPHYS,VOLUME) C -------------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DES CARACTERISTIQUES PHYSIQUES DU SOLIDE * C RHO(x,y,z,t,T), CP(x,y,z,t,T), K(x,y,z,t,T) * C + invariant de Gauss et epaisseur pour le modele coque * C * C Dans la version 3.0 de SYRTHES, il est possible de definir * C les caracteristiques soit par noeud soit par element soit * C par noeud pour un element. Parmi les trois choix suivant, * C un seul doit etre retenu et en coherence avec l'option prise * C dans le fichier des mots-cles. * C Pour plus de clarte, on engage meme les utilisateurs a * C supprimer les lignes non utiles dans leur cas. * C * C Attention : toute variable utilisee doit etre declaree * C ========= * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! PHYSOL ! TR ! R ! CARACTERISTIQUES PHYSIQUES DU SOLIDE ! C ! NPOUE ! E ! D ! NOMBRE DE NOEUDS OU D'ELTS ! C ! NPPEL ! E ! D ! NOMBRE DE NOEUD PAR ELEMENTS ! C ! VOLUME ! E ! D ! VOLUME DE CHAQUE ELEMENT ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /TEMPS / ! ! D ! ! C ! /OPTCT / ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "divct.h" #include "optct.h" #include "syrthu.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBPHYS,NPOUE,NPPEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION PHYSOL(NPOUE,NPPEL,NBPHYS),VOLUME(NELEMS) C C.. Variables internes INTEGER I,J,K,N,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2,TT C C*********************************************************************** C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C -------------------------------------------------- C 2- INTERVENTION UTILISATEUR POUR LE MODELE GENERAL C -------------------------------------------------- C Les conditions physiques peuvent etre fonction C de l'espace (COORDS(...,1),COORDS(...,2),COORDS(...,3)), C du temps (TEMPS) et de la temperature TMPS(...) C On donne : C Si la conductivite est isotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k C Si la conductivite est orthotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x | 3 | C - PHYSOL(.,.,4) : conductivite k suivant y | 4 | C - PHYSOL(.,.,5) : conductivite k suivant z | 5 | C Si la conductivite est anisotrope on donne : C - PHYSOL(.,.,1) : masse volumique rho C - PHYSOL(.,.,2) : chaleur specifique cp C - PHYSOL(.,.,3) : conductivite k suivant x C - PHYSOL(.,.,4) : conductivite k suivant y | 3 6 7 | C - PHYSOL(.,.,5) : conductivite k suivant z | 4 8 | C - PHYSOL(.,.,6) : conductivite k suivant xy | 5 | C - PHYSOL(.,.,7) : conductivite k suivant xz C - PHYSOL(.,.,8) : conductivite k suivant yz C C Temps reel courant sur le solide CUTI T = TEMPSS C C ===================================================== C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== CUTI IF(NDPROP .NE. 1) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque point solide CUTI DO N=1,NPOINS C C References du point courant CUTI NUMREF = NREFS(N) C C Coordonnees du point courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Temperature du noeud CUTI TT = TMPS(N) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C ===================================================== C FIN POUR LES CARACTERISTIQUES PHYSIQUES PAR NOEUD C ===================================================== C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 2) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero des noeuds de l'element ( 6 en 2D, 10 en 3D) CUTI point 1 a 6 CUTI N1 = NODES(N,1) CUTI N2 = NODES(N,2) CUTI N3 = NODES(N,3) CUTI N4 = NODES(N,4) CUTI N5 = NODES(N,5) CUTI N6 = NODES(N,6) C CUTI IF (NDIM .EQ. 3) THEN CUTI N7 = NODES(N,7) CUTI N8 = NODES(N,8) CUTI N9 = NODES(N,9) CUTI N10= NODES(N,10) CUTI ENDIF C C Coordonnees des points de l'element courant C Pour le noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Pour le noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc C C Temperature des noeuds de l'element CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,1,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,1,1) = CUTI PHYSOL(N,1,2) = CUTI PHYSOL(N,1,3) = CUTI PHYSOL(N,1,4) = CUTI PHYSOL(N,1,5) = CUTI PHYSOL(N,1,6) = CUTI PHYSOL(N,1,7) = CUTI PHYSOL(N,1,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO C C ======================================================= C FIN DES CARACTERISTIQUES PHYSIQUES PAR ELEMENT C LES PROPRIETES SONTS CONSTANTES SUR l"ELEMENT C ======================================================= C C C C C C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= CUTI IF(NDPROP .NE. 3) THEN CUTI WRITE(NFECRA,1000) CUTI STOP CUTI ENDIF C C Pour chaque noeud de l'element CUTI DO J=1,NDMATS C Pour chaque element du solide CUTI DO N=1,NELEMS C C References de l'element courant CUTI NUMREF = NREFE(N) C CUTI Numero global du noeud CUTI N1 = NODES(N,J) C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT = TMPS(N1) C C Si la conductivite est isotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.1) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI ENDIF CUTI ENDIF CUTI C Si la conductivite est orthotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.2) THEN C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI IF (NDIM.EQ.3) PHYSOL(N,J,5) = CUTI ENDIF CUTI ENDIF C C Si la conductivite est anisotrope C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUTI IF (ISOTRO.EQ.3) THEN C C Cas de la dimension 2 CUTI IF (NDIM.EQ.2) THEN C C Si le noeud courant porte la reference 4 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI ENDIF C CUTI ELSEIF (NDIM.EQ.3) THEN CUTI IF ( NUMREF.EQ.4 ) THEN CUTI PHYSOL(N,J,1) = CUTI PHYSOL(N,J,2) = CUTI PHYSOL(N,J,3) = CUTI PHYSOL(N,J,4) = CUTI PHYSOL(N,J,5) = CUTI PHYSOL(N,J,6) = CUTI PHYSOL(N,J,7) = CUTI PHYSOL(N,J,8) = CUTI ENDIF CUTI ENDIF C CUTI ENDIF C CUTI ENDDO CUTI ENDDO C ======================================================= C SI ON INDIQUE LES CARACTERISTIQUES PHYSIQUES PAR C NOEUD POUR CHAQUE ELEMENT C LES PROPRIETES PEUVENT ALORS ETRE VARIABLE DANS UN ELEMENT C ======================================================= C C C C*********************************************************************** C 1000 FORMAT(' CPHYSO : ATTENTION LE CHOIX EST CONTRADICTOIRE AVEC',/, & 'CELUI RETENU DANS LES MOTS-CLES') C---- C FIN C---- END syrthes-3.4.3-dfsg1/usr/limfso.F0000666000175000017500000003741711524070646015142 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMFSO C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NELEUS,NDMASS,NODEUS,NREFAL, * NBFFLU,NFFLUS,VFFLUS,NBDIRS,NDIRS,VDIRS,NBFECH,NFECHS,VFECHS, * NBFRAI,NFRAIS,VFRAIS,NELERC,NFRESC,VFRESC) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C (Sous-programme utilisateur) * C * C ATTENTION : * C =========== * C A l'aide de ce sous programme, il est possible d'imposer * C les conditions limites sur les faces, ce qui permet un * C "meilleur" traitement des conditions limites discontinues.* C Le cas typique ou ce traitement peut avoir un interet est * C par exemple celui du coin affecte par des conditions aux * C limites de type differentes sur chaque face, auquel cas, * C le point de coin peut etre considere comme singulier. * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFFLUS ! TE ! D ! No local de la face affecte par des flux ! C ! VFFLUS ! TR ! R ! Valeur du flux aux points de la facette ! C ! NBFFLU ! E ! R ! Nombre de facettes de type flux ! C ! NFECHS ! TE ! D ! No local de la facette avec c.l. d'echange ! C ! VFECHS ! TR ! R ! Valeur aux noeud de la face de type echange ! C ! ! ! ! VFECHS(.,..,1) = temperature exterieure ! C ! ! ! ! VFECHS(.,..,2) = coefficient d'echange ! C ! NBFECH ! E ! D ! Nombre de facette de type echange ! C ! NFRAIS ! TE ! D ! No des facettes avec rayonnement infi ! C ! VFRAIS ! TR ! R ! Valeurs aux noeuds des faces de type ! C ! ! ! ! rayonnement infi. ! C ! ! ! ! VFRAIS(.,..,1) = temp exterieure equival ! C ! ! ! ! VFRAIS(.,..,2) = coef d'echange equival ! C ! NBFRAI ! E ! D ! Nombre de facette de type rayonnement inf ! C ! NFRESC ! TE ! D ! No des facettes avec resistance de contact ! C ! VFRESC ! TR ! R ! Valeurs des resistances aux noeuds de la face! C ! NELERC ! E ! D ! Nombre de facette de type resistance ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS,NDMASS INTEGER NBFFLU,NBDIRS,NBFECH,NELERC,NBFRAI,NELEUS INTEGER NODEUS(NELEUS,NDMASS) INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS),NREFAL(NELEUS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFFLUS(NBFFLU),NDIRS(NBDIRS),NFECHS(NBFECH) INTEGER NFRESC(NELERC),NFRAIS(NBFRAI) DOUBLE PRECISION VFFLUS(NBFFLU,NDMASS),VDIRS(NBDIRS) DOUBLE PRECISION VFECHS(NBFECH,NDMASS,2) DOUBLE PRECISION VFRESC(NELERC,NDMASS,2),VFRAIS(NBFRAI,NDMASS,2) C C.. Variables internes INTEGER N,J,NUMFA,NUMREF,NNGLOB DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFFLU C C Numero global de la facette de bord CUTI NUMFA = NFFLUS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D C CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NNGLOB) C C Si la face porte la reference 3, le flux sur les neuds de C la face vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFFLUS(N,J) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N,J) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Exemple ... C CUTI DO N=1,NBDIRS C C On rappelle que les conditions de Dirichlet affecte des noeuds C et non pas des faces. C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C C Si le noeud porte la reference 3, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFECH C C Numero global de la facette de bord CUTI NUMFA = NFECHS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 et le coefficient d'echange de 10, C sinon, la temperature exterieure est de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VFECHS(N,J,1) = 20.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ELSE CUTI VFECHS(N,J,1) = 40.0D0 CUTI VFECHS(N,J,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Exemple ... C CUTI DO N=1,NELERC C C Numero global de la facette de bord CUTI NUMFA = NFRESC(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C C Si le noeud porte la reference 4 on a une resistance C de contact de 100. sinon de 1. (mauvaise transmission) C C CUTI IF (NUMREF.EQ.4) THEN CUTI VFRESC(N,J,2) = 100.0D0 CUTI ELSE CUTI VFRESC(N,J,2) = 1.0D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Exemple ... C CUTI DO N=1,NBFRAI C C Numero global de la facette de bord CUTI NUMFA = NFRAIS(N) C C References de la facette de bord CUTI NUMREF = NREFAL(NUMFA) C C Il y a NDMASS noeuds par facette de bords C 6 en 3D et en modele coque, 3 en 2D CUTI DO J=1,NDMASS C C Coordonnees des noeuds sur la facette de bord CUTI NNGLOB = NODEUS(NUMFA,J) CUTI XX = COORDS(NNGLOB,1) CUTI YY = COORDS(NNGLOB,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NNGLOB,3) C C Si le noeud porte la reference 6, la temperature exterieure C est de 20 C et l'emissivite de 0.8, C sinon, la temperature exterieure est de 10 C et epsilon 0.9 C CUTI IF (NUMREF.EQ.6) THEN CUTI VFRAIS(N,J,1) = 20.0D0 CUTI VFRAIS(N,J,2) = 0.8D0 CUTI ELSE CUTI VFRAIS(N,J,1) = 10.0D0 CUTI VFRAIS(N,J,2) = 0.9D0 CUTI ENDIF C CUTI ENDDO C CUTI ENDDO C CC C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFFLU.GT.0 .OR. NBDIRS.GT.0 .OR. NBFECH.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF C C Impression des flux IF (NBFFLU.GT.0) THEN WRITE(NFECRA,5010) DO 5051 N=1,NBFFLU DO 5052 J=1,NDMASS WRITE(NFECRA,5050) NFFLUS(N),VFFLUS(N,J) 5052 CONTINUE 5051 CONTINUE ENDIF C C Impression des Dirichlets IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF C C Impression des conditions d'echange IF (NBFECH.GT.0) THEN WRITE(NFECRA,5030) DO 5061 N=1,NBFECH DO 5062 J=1,NDMASS WRITE(NFECRA,5060) & NFECHS(N),VFECHS(N,J,1),VFECHS(N,J,2) 5062 CONTINUE 5061 CONTINUE ENDIF C C Impression des conditions de rayonnement infini IF (NBFRAI.GT.0) THEN WRITE(NFECRA,5040) DO 5071 N=1,NBFRAI DO 5072 J=1,NDMASS WRITE(NFECRA,5060) & NFRAIS(N),J,VFRAIS(N,J,1),VFRAIS(N,J,2) 5072 CONTINUE 5071 CONTINUE ENDIF C C Impression des conditions de resistance de contact IF (NELERC.GT.0) THEN WRITE(NFECRA,5045) DO 5081 N=1,NELERC DO 5082 J=1,NDMASS WRITE(NFECRA,5060) & NFRESC(N),J,VFRESC(N,J,2) 5082 CONTINUE 5081 CONTINUE ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMFSO : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMFSO : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux', & ' (face, noeud, flux)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange', & ' (face, noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement inifni', & ' (face, noeud, Tnoir, sigma)') 5045 FORMAT(/,' - Condition de type resistance', & ' (face, noeud, resistance)') 5050 FORMAT('(',I6,'-',I2,'-',G10.3,')') 5060 FORMAT(I6,'--',I2,'--',G10.3,'--',G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/usr/initmp.F0000666000175000017500000001366111524070646015144 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE INITMP C ***************** C C -------------------------------------------------- * (NDIM,NPOINS,NELEMS,NDMATS,NODES, * COORDS,NREFS,NREFE,TMPSA,TMPS) C -------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DE LA TEMPERATURE DANS LE SOLIDE * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C ! TMPS ! TR ! R ! TEMPERATURE INITIALE DANS LE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : INISOL,RESSOL C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NREFS(NPOINS),NREFE(NELEMS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM) DOUBLE PRECISION TMPSA(NPOINS),TMPS(NPOINS) C C.. Variables internes DOUBLE PRECISION XX,YY,ZZ INTEGER N,I,NUMREF C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C =================================================== C C Methode 1 : boucle sur les noeuds C --------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque point solide C DO N=1,NPOINS C C Coordonnees du noeud courant CUTI XX = COORDS(N,1) CUTI YY = COORDS(N,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(N,3) C C Numero de reference du noeud CUTI NUMREF = NREFS(N) C C Si le noeud courant porte la reference 4 CUTI IF (NUMREF.EQ.4 ) THEN CUTI TMPS(N) = 20.D0 CUTI ELSE CUTI TMPS(N) = 10.D0 CUTI ENDIF C CUTI ENDDO C C Methode 2 : boucle sur les elements C ----------------------------------- C La temperature du solide est stockee dans TMPS(...) C C Pour chaque element solide C DO N=1,NELEMS C C C Numero de materiau de l'element CUTI NUMREF=NREFE(N) C C Si l'elements porte la reference 4, on met 20 degres sur tous C les noeuds de l'element sinon on met 10 degres CUTI IF (NUMREF.EQ.4 ) THEN CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 20.D0 CUTI ENDDO CUTI ELSE CUTI DO I=1,NDMATS CUTI TMPS(NODES(N,I)) = 10.D0 CUTI ENDDO CUTI ENDIF C CUTI ENDDO C C FIN D'INTERVENTION UTILISATEUR C ------------------------------ C*********************************************************************** C DO N=1,NPOINS TMPSA(N)=TMPS(N) ENDDO C C---- C FIN C---- END syrthes-3.4.3-dfsg1/usr/inrefa.F0000666000175000017500000001603111524070646015102 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=INREFA,SSI=0 SUBROUTINE INREFA C ***************** C C ----------------------------------- * (NDIM,NDIELE,NELEMS,NDMATS,NBFACE, * NODES,NREFAC,NPOINS,NREFS) C ----------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES REFERENCES DES FACES DANS LE CAS * C OU LE MAILLEUR UTILISE NE LES FOURNIT PAS * C Elles sont necessaires lorsque l'on veut imposer les * C conditions aux limites sur les faces. * C * C Sous programme utilisateur * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEMES ! C ! NDIELE ! E ! D ! DIMENSION DES ELEMENTS(2=triangles,3=tetraed)! C ! NREFAC ! TE ! R ! REFERENCES DES FACES SOLIDES (volumiques) ! C ! NODES ! TE ! D ! CONNECTIVITE ! C ! NDMATS ! E ! D ! NOMBRE DE NOEUDS PAR ELEMENTS ! C ! NBFACE ! E ! D ! NOMBRE DE FACES DES ELTS VOL SOLIDES ! C ! NELEMS ! E ! D ! NOMBRE D'ELEMENTS ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /XREFER/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "nlofes.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NDIELE,NELEMS,NDMATS,NBFACE INTEGER NODES(NELEMS,NDMATS),NREFAC(NELEMS,NBFACE) INTEGER NPOINS,NREFS(NPOINS) C C.. Variables internes INTEGER I,J INTEGER N1,N2,N3,N4,N5,N6,NR1,NR2,NR3,NR4,NR5,NR6 C C NARE(noeud,arete), NFAC(noeud,face) INTEGER NARE(3,3),NFAC(6,4) C*********************************************************************** C DATA NARE/1,2,4, 2,3,5, 3,1,6/ DATA NFAC/1,2,3,5,6,7, 1,2,4,5,9,8, 1,3,4,7,10,8, 2,3,4,6,10,9/ C C 1- INITIALISATIONS C ------------------ C C C 2- CAS D'UN MAILLAGE EN TRIANGLES C ================================= C IF (NCTHFS.EQ.3 .AND. NDIELE.EQ.2) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C C Numeros des 3 noeuds de l'arete : 1----3----2 CUTI N1 = NODES(I,NARE(1,J)) CUTI N2 = NODES(I,NARE(2,J)) CUTI N3 = NODES(I,NARE(3,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C C C 3- CAS D'UN MAILLAGE EN TETRAEDRES C ================================== C ELSEIF (NCTHFS.EQ.3 .AND. NDIELE.EQ.3) THEN C CUTI DO J=1,NBFACE CUTI DO I=1,NELEMS C 3 C / \ C Numeros des 6 noeuds de la face : 6 5 C / \ C 1-----4-----2 CUTI N1 = NODES(I,NFAC(1,J)) CUTI N2 = NODES(I,NFAC(2,J)) CUTI N3 = NODES(I,NFAC(3,J)) CUTI N4 = NODES(I,NFAC(4,J)) CUTI N5 = NODES(I,NFAC(5,J)) CUTI N6 = NODES(I,NFAC(6,J)) C C References des 3 noeuds CUTI NR1 = NREFS(N1) CUTI NR2 = NREFS(N2) CUTI NR3 = NREFS(N3) CUTI NR4 = NREFS(N4) CUTI NR5 = NREFS(N5) CUTI NR6 = NREFS(N6) C C Mise en place de la reference de l'arete courante CUTI NREFAC(I,J) = ... C CUTI ENDDO CUTI ENDDO C ELSE C C 5- CAS D'ERREUR C =============== WRITE(NFECRA,5000) STOP C ENDIF C C-------- C FORMATS C-------- 5000 FORMAT(//,' %% ERREUR INREFA : ON N''EST DANS AUCUNE DES ', & 'CONFIGURATIONS PREVUES') C END syrthes-3.4.3-dfsg1/usr/limray.F0000666000175000017500000003755611524070646015152 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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/MEMBR ADD NAME=LIMRAY,SSI=0 SUBROUTINE LIMRAY C ***************** C C ------------------------------------------------------------ * (NDIM,NELRAY,NPOINR, * NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA, * NODRAY,NRFRAY,NGFFIR,NGFTIR,NGFPER,NGFPEF, * COORAY,EMISSI,TEMRAY,FIRAY,PHFRAF,PHFRAE,VFIRAY) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES DE RAYONNEMENT * C TRANSPARENT CONFINE SUR LE MAILLAGE DE RAYONNEMENT * C * C Attention : Toutes les grandeurs entrees par l'utilisateur le sont * C au niveau des faces * C * C (Sous-programme utilisateur) * C * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NELRAY ! E ! D ! NOMBRE DE FACES DU MAILLAGE DE RAYONNEMENT ! C ! NPOINR ! E ! D ! NOMBRE DE NOEUD DU MAILLAGE DE RAYONNEMENT ! C ! SPECTL ! TR ! R ! BORNES DE CHAQUE BANDE SPECTRALE ! C ! NRFRAY ! TE ! D ! REFERENCES DES FACES DU MAILLAGE DE RAYONNT ! C ! COORAY ! TR ! D ! COORDONNEES DES NOEUDS DU MAILLAGE DE RAYONNT! C ! NODRAY ! TE ! D ! CONNECTIVITE DU MAILLAGE DE RAYONNEMENT ! C ! EMISSI ! TE ! D ! EMISSIVITE DE FACETTE POUR CHAQUE BANDE ! C ! TEMRAY ! TR ! D ! TEMPERATURE DE LA FACE DE RAYONNT A L'ETAPE N! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "rayonn.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NELRAY,NPOINR INTEGER NFCFRA,NFCSRA,NFTIRA,NFFIRA,NFPERA INTEGER NGFFIR(NFFIRA),NGFTIR(NFTIRA) INTEGER NGFPER(NFPERA),NGFPEF(NFCFRA) INTEGER NRFRAY(NELRAY),NODRAY(NELRAY,NDIM) DOUBLE PRECISION COORAY(NPOINR,NDIM),TEMRAY(NELRAY) DOUBLE PRECISION EMISSI(NELRAY,2,NBANDE),FIRAY(NELRAY,NBANDE) DOUBLE PRECISION PHFRAF(NFCFRA,4),PHFRAE(NFPERA,4) DOUBLE PRECISION VFIRAY(NFFIRA,NBANDE,2) C C C.. Variables internes INTEGER N,NUMNO,NUMREF,I,NGFAC DOUBLE PRECISION T,XX1,YY1,ZZ1 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C Temps courant sur le solide CUTI T = TEMPSS C C ================================================================ C 1- INITIALISATION DES BANDES SPECTRALES C ================================================================ C Definition des bandes spectrales si besoin est C Le nombre de bandes spectrales,NBANDE est defini dans le fichier C de mots-cles Syrthes.ray C Exemple : si le nombre de bandes (NBANDE) vaut 2, avec en metres C Premiere bande lambda_1 = 0 , lambda_2 = 5.e-6 (m) C Deuxieme bande lambda_1 = 5.e-6 , lambda_2 = 1. CUTI SPECTL(1,1) = 0 CUTI SPECTL(1,2) = 5.e-6 CUTI SPECTL(2,1) = 5.e-6 CUTI SPECTL(2,2) = 1. C C ================================================================ C 2- INITIALISATION DE l'EMISSIVITE POUR LE RAYONNEMENT C ================================================================ C C Exemple ... C CUTI DO N=1,NELRAY C C References de la face CUTI NUMREF = NRFRAY(N) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(N,1),1) CUTI YY1 = COORAY(NODRAY(N,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(N,1),3) C ... C C Temperature de la face de rayonnement CUTI TTFAC = TEMRAY(N) C C Exemple C Si la face porte la reference 3, l'emissivite vaut C 0.7 pour la premiere bande C 0.95 pour la deuxieme bande C sinon, elle vaut 0.5 (elle peut eventuellement dependre de la C temperature de la face calculee precedement (TTFAC) C CUTI IF (NUMREF.EQ.3) THEN CUTI EMISSI(N,1,1) = 0.7 CUTI EMISSI(N,1,2) = 0.95 CUTI ELSE CUTI EMISSI(N,1,1) = 0.5 CUTI EMISSI(N,1,2) = 0.5 CUTI ENDIF C CUTI ENDDO C C ================================================================ C 3- INITIALISATION DES TEMPERATURES DE FACES IMPOSEE C ================================================================ C CUTI DO N=1,NFTIRA C C Numero global de la face CUTI NGFAC = NGFTIR(N) C Reference de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Attention : La temperature de la face de rayonnement est en degre C C La references 5 designe une entree T = 30 degre C C La references 6 designe une sortie T = 50 degre C C CUTI IF ( NUMREF .EQ. 5 ) THEN CUTI TEMRAY(NGFAC) = 30. CUTI ELSEIF ( NUMREF .EQ. 6 ) THEN CUTI TEMRAY(NGFAC) = 50. CUTI ENDIF C CUTI ENDDO C C ================================================================ C 4- INITIALISATION DES FACES A FLUX IMPOSE PAR BANDE C ================================================================ C CUTI DO N=1,NFFIRA C C Numero global de la face CUTI NGFAC = NGFFIR(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C On a une seule bande spectrale --> NUMBAN = 1 C Si la reference de la face vaut 7 on a une paroi adiabatique C Si la reference de la face vaut 3 on a un flux de 500 W/m2 C CUTI NUMBAN = 1 C CUTI IF ( NUMREF .EQ. 7 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 0. CUTI ELSEIF ( NUMREF .EQ. 3 ) THEN CUTI VFIRAY(N,NUMBAN,1) = 500. CUTI ENDIF C CUTI ENDDO C C C ================================================================ C 5- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C COUPLEE AU FLUIDE (attention sans solide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAF(..,1) est la conductivite du materiau C PHFRAF(..,2) est l'epaisseur du materiau C PHFRAF(..,3) est la temperature exterieure C PHFRAF(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFCFRA C C Numero global de la face CUTI NGFAC = NGFPEF(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 5 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : -10. degres C C H ext : 200 C CUTI IF (NUMREF.EQ.5) THEN CUTI PHFRAF(N,1) = 10. CUTI PHFRAF(N,2) = 0.01 CUTI PHFRAF(N,3) = -10. CUTI PHFRAF(N,4) = 200. CUTI ENDIF C C CUTI ENDDO C C ================================================================ C 6- INITIALISATION DES PROPRIETES DE PAROI EQUIVALENTE C DES FACES DE RAYONNEMENT ISOLEES C (ni couple au solide ni au fluide) C ================================================================ C On indique pour chaque face de ce type : C PHFRAE(..,1) est la conductivite du materiau C PHFRAE(..,2) est l'epaisseur du materiau C PHFRAE(..,3) est la temperature exterieure C PHFRAE(..,4) est le coefficient d'echange exterieur C C Attention : Toutes les grandeurs entrees par l'utilisateur C le sont au niveau des faces C CUTI DO N=1,NFPERA C C Numero global de la face CUTI NGFAC = NGFPER(N) C References de la face CUTI NUMREF = NRFRAY(NGFAC) C C Coordonnees des noeuds de la face CUTI XX1 = COORAY(NODRAY(NGFAC,1),1) CUTI YY1 = COORAY(NODRAY(NGFAC,1),2) CUTI IF(NDIM.EQ.3) ZZ1 = COORAY(NODRAY(NGFAC,1),3) C ... C C Exemple C Si la references 12 designe une paroi equivalente, ayant pour C caracteristiques : C Conductivite : 10 W/M/K C Epaisseur : 1 cm C Temp ext : 100. degres C C H ext : 10 C CUTI IF (NUMREF.EQ.12) THEN CUTI PHFRAE(N,1) = 10. CUTI PHFRAE(N,2) = 0.01 CUTI PHFRAE(N,3) = 100. CUTI PHFRAE(N,4) = 10. CUTI ENDIF C C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 7- IMPRESSION DE CONTROLE C ========================= C (il suffit de mettre LVERIF = .TRUE. en debut de programme) C IF (LVERIF) THEN C WRITE(NFECRA,7000) C IF (NBANDE .GT. 1) THEN WRITE(NFECRA,7100) NBANDE DO 7110 N=1,NBANDE WRITE(NFECRA,7120) SPECTL(N,1),SPECTL(N,2) 7110 CONTINUE ENDIF C DO 7200 N=1,NBANDE WRITE(NFECRA,7210) N WRITE(NFECRA,7220) WRITE(NFECRA,7230) ( I,EMISSI(I,1,N),I=1,NELRAY ) 7200 CONTINUE C C WRITE(NFECRA,7300) NFTIRA WRITE(NFECRA,7310) WRITE(NFECRA,7320) ( NGFTIR(I),TEMRAY(NGFTIR(I)),I=1,NFTIRA ) C C WRITE(NFECRA,7410) NFFIRA DO 7400 N=1,NBANDE WRITE(NFECRA,7415) N WRITE(NFECRA,7420) WRITE(NFECRA,7430) (NGFFIR(I),FIRAY(NGFFIR(I),N),I=1,NFFIRA) 7400 CONTINUE C C WRITE(NFECRA,7500) NFCFRA WRITE(NFECRA,7510) DO 7530 N=1,NFCFRA NGFAC = NGFPEF(N) WRITE(NFECRA,7520) N,PHFRAF(NGFAC,1),PHFRAF(NGFAC,2), & PHFRAF(NGFAC,3),PHFRAF(NGFAC,4) 7530 CONTINUE C C WRITE(NFECRA,7600) NFPERA WRITE(NFECRA,7610) DO 7630 N=1,NFPERA NGFAC = NGFPER(N) WRITE(NFECRA,7620) N,PHFRAE(NGFAC,1),PHFRAE(NGFAC,2), & PHFRAE(NGFAC,3),PHFRAE(NGFAC,4) 7630 CONTINUE C ENDIF C C-------- C FORMATS C-------- C 7000 FORMAT(/,' *** LIMRAY : IMPRESSION DES CONDITIONS AUX LIMITES', & ' DE TYPE RAYONNEMENT TRANSPARENT CONFINE') 7100 FORMAT(/,' Nombre de bandes spectrales definies',I2) 7120 FORMAT(/,' Bande spectrale :',I2,' Lamda_1 = ',E13.5, & ' Lamda_2 = ',E13.5) 7210 FORMAT(/,' Valeur des emissivites pour la bande : ',I2) 7220 FORMAT(/,' Numero de la facette - valeur de l''emissivite ') 7230 FORMAT('(',I6,' - ',G10.3,')') 7300 FORMAT(/,' Nombre de facette avec temperature imposee : ',I5) 7310 FORMAT(/,' Numero de la facette - valeur de la', & ' temperature imposee') 7320 FORMAT('(',I6,' - ',G10.3,')') 7410 FORMAT(/,' Nombre de facette avec Flux impose : ',I5) 7415 FORMAT(/,' Valeur des flux imposes pour la bande : ',I2) 7420 FORMAT(/,' Numero de la facette - valeur du flux impose') 7430 FORMAT('(',I6,' - ',G10.3,')') 7500 FORMAT(/,' Nombre de facette paroi equivalente couple au', & ' fluide : ',I5) 7510 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7520 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) 7600 FORMAT(/,' Nombre de facette paroi equivalente isolee : ',I5) 7610 FORMAT(/,' Face - Conductivite - Epaisseur - ', & 'Temp exterieure - Coef d''echange exterieur') 7620 FORMAT(I6,20X,G10.3,20X,G10.3,20X,G10.3,20X,G10.3) C C---- C FIN C---- END syrthes-3.4.3-dfsg1/usr/cfluvs.F0000666000175000017500000002436111524070646015145 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE CFLUVS C ***************** C C ---------------------------------------------------------- * (NDIM,NPOINS,COORDS,NREFS,NREFE,NELEMS,NODES,NDMATS, * TMPSA,TMPS,NBFLVS,NPFEL,NFLUVS,VFLUVS) C ---------------------------------------------------------- C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C ENTREE DE FLUX VOLUMIQUES SUR LE SOLIDE * C (EN FONCTION DE L'ESPACE DU TEMPS ET DE LA TEMPERATURE) * C CAS DU MODELE GENERAL * C * C Dans la version 3.0, le flux volumiques peuvent etre * C definis sur les noeuds, les elements ou * C par noeud d'un element * C * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! E ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! E ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! COORDS ! TE ! D ! COORDONNEES DES NOEUDS DU MAILLAGE SOLIDE ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NBFLVS ! E ! D ! NOMBRE DE NOEUDS AVEC FLUX VOL ! C ! NFLUVS ! TE ! D ! NUMEROS GLOBAUX DES NOEUDS AVEC FLUX VOL ! C ! VFLUVS ! TR ! R ! VALEUR DU FLUX VOLUMIQUE EN CES NOEUDS ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /TEMPS/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : --- C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C ********************************************************************** C #include "optct.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NBFLVS,NPFEL,NELEMS,NDMATS INTEGER NREFS(NPOINS),NFLUVS(NBFLVS),NREFE(NELEMS) INTEGER NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPSA(NPOINS),TMPS(NPOINS) DOUBLE PRECISION VFLUVS(NBFLVS,NPFEL) C C.. Variables internes INTEGER I,J,K,N,NUMREF,NUMNO,NUMEL DOUBLE PRECISION XX,YY,ZZ,TT1,TT2,T C C*********************************************************************** C C 1- INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C --------------------------------------------------- C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C ------------------------------------------------------------------ C Le flux volumique est stocke dans VFLUVS C Il peut etre fonction de l'espace (COORDS(...,1),COORDS(...,2), C COORDS(...,3)), du temps TEMPS, et de la temperature TMPS(...) C Dans le cas du modele coque, on dispose des temperatures C interne (TMPSA) et externe (TMPS) de la coque C ------------------------------------------------------------------ C C C Temps reel courant sur le solide CUTI T = TEMPSS C C C ============================================================ C TRAITEMENT PAR NOEUD C ============================================================ C Pour chaque point portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global du noeud CUTI NUMNO = NFLUVS(N) C C Reference du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF (NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud courant porte la reference 4 le flux vaut 1000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 C C Sinon il vaut 10000 W/M3 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 C CUTI ENDIF C CUTI ENDDO C ============================================================ C FIN DU TRAITEMENT PAR NOEUD C ============================================================ C C C C C ============================================================ C TRAITEMENT PAR ELEMENT (FLUX VOLUMIQUE CONSTANT PAR ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C C Numero des noeuds de l'element CUTI N1 = NODES(NUMEL,1) CUTI N2 = NODES(NUMEL,2) CUTI N3 = NODES(NUMEL,3) CUTI N4 = NODES(NUMEL,4) CUTI N5 = NODES(NUMEL,5) CUTI N6 = NODES(NUMEL,6) CUTI IF (NDIM.EQ.3) THEN CUTI N7 = NODES(NUMEL,7) CUTI N8 = NODES(NUMEL,8) CUTI N9 = NODES(NUMEL,9) CUTI N10= NODES(NUMEL,10) CUTI ENDIF C C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Coordonnees XXi YYi ZZi des noeuds de l'element C (6 en 2d, 10 en 3D) C Noeud n1 CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C Noeud n2 CUTI XX2 = COORDS(N2,1) CUTI YY2 = COORDS(N2,2) CUTI IF (NDIM.EQ.3) ZZ2 = COORDS(N2,3) CUTI . CUTI . CUTI etc... C C Temperatures TTi aux noeuds de l'element (6 en 2d 10 en 3d) C TT1 = Temperature au noeud courant n1 CUTI TT1 = TMPS(N1) CUTI TT2 = TMPS(N2) CUTI . CUTI . CUTI etc... C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,1) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,1) = 10000.D0 CUTI ENDIF C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR ELEMENT (FLUX CONSTANT PAR ELEMENT) C ============================================================ C C C C C C C ============================================================ C TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C Pour chaque element portant un flux volumique CUTI DO N=1,NBFLVS C C Numero global de l'element CUTI NUMEL = NFLUVS(N) C Reference de l'element CUTI NUMREF = NREFE(NUMEL) C C Pour chaque noeud de l'element courant CUTI DO J=1,NPFEL C C Numero du noeud courant CUTI N1 = NODES(NUMEL,J) C C C Coordonnees du noeud courant CUTI XX1 = COORDS(N1,1) CUTI YY1 = COORDS(N1,2) CUTI IF (NDIM.EQ.3) ZZ1 = COORDS(N1,3) C C Temperature du noeud courant CUTI TT1 = TMPS(N1) C C Si l'element courant porte la reference 4 C alors le flux vaut 1000 W/M3 sur chacun des noeuds de l'element C Sinon il vaut 10000 W/M3 CUTI IF ( NUMREF.EQ.4 ) THEN CUTI VFLUVS(N,J) = 1000.D0 CUTI ELSE CUTI VFLUVS(N,J) = 10000.D0 CUTI ENDIF CUTI ENDDO C CUTI ENDDO C C ============================================================ C FIN DU TRAITEMENT PAR NOEUD D'UN ELEMENT C (LE FLUX VOLUMIQUE PEUT VARIER DANS L'ELEMENT) C ============================================================ C C C C---- C FIN C---- END syrthes-3.4.3-dfsg1/usr/limsol.F0000666000175000017500000003117211524070646015140 0ustar pinipiniC----------------------------------------------------------------------- C C SYRTHES version 3.4 C ------------------- C C This file is part of the SYRTHES Kernel, element of the C thermal code SYRTHES. C C Copyright (C) 1988-2008 EDF S.A., France C C contact: syrthes-support@edf.fr C C C The SYRTHES 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 SYRTHES 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 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 ***************** SUBROUTINE LIMSOL C ***************** C C ------------------------------------------------------------ * (NDIM,NPOINS,NELEMS,NDMATS,NREFS,COORDS,NODES,TMPSA,TMPS, * NBFLUS,NFLUSS,VFLUSS,NBDIRS,NDIRS,VDIRS,NBECHS,NECHS,VECHS, * NBRAIS,NRAYIS,VRAYIS,NBRESS,NRESCS,VRESCS) C ------------------------------------------------------------ C C*********************************************************************** C* SYRTHES 3.4.2 COPYRIGHT EDF 2008 * C*********************************************************************** C AUTEURS : C. PENIGUEL, I. RUPP * C*********************************************************************** C FONCTION : * C ---------- * C INITIALISATION DES CONDITIONS AUX LIMITES SUR LE SOLIDE * C POUR LE CALCUL COUPLE FLUIDE-SOLIDE * C (Sous-programme utilisateur) * C----------------------------------------------------------------------- C ARGUMENTS C .___________.____.____.______________________________________________. C ! NOM !TYPE!MODE! ROLE ! C !___________!____!____!______________________________________________! C ! NDIM ! TE ! D ! DIMENSION DU PROBLEME ! C ! NPOINS ! TE ! D ! NOMBRE DE NOEUDS DU MAILLAGE SOLIDE ! C ! NELEMS ! TE ! D ! NOMBRE D'ELEMENTS DU MAILLAGE SOLIDE ! C ! NDMATS ! TE ! D ! NOMBRE DE NOEUDS PAR ELEMENT ! C ! NREFS ! TE ! D ! REFERENCES DES NOEUDS SOLIDES ! C ! COORDS ! TR ! D ! COORDONNEES DES NOEUDS SOLIDES ! C ! NODES ! TE ! D ! CONNECTIVITE DU MAILLAGE SOLIDE ! C ! TMPSA ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! TMPS ! TR ! D ! TEMPERATURE DANS LE SOLIDE A L'ETAPE N ! C ! NFLUSS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DE FLUX ! C ! VFLUSS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE FLUX ! C ! NDIRS ! TE ! D ! NUMERO DES NOEUDS PORTANT UNE C.L. DIRICHLET ! C ! VDIRS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE DIRICHLET ! C ! NECHS ! TE ! D ! NUMERO DES NOEUDS AVEC C.L. COEFF ECHANGE ! C ! VECHS ! TR ! R ! VALEUR DE LA CONDITION DE TYPE COEFF ECHANGE! C ! ! ! ! VECHS(...,1) = temperature exterieure ! C ! ! ! ! VECHS(...,2) = coefficient d'echange ! C ! NRAYIS ! TE ! D ! NUMERO DES NOEUDS AVEC RAYONNEMENT infi ! C ! VRAYIS ! TR ! R ! VALEUR DES PARAMETRES POUR LE RAYONNEMENTinfi! C ! NRESCS ! TE ! D ! NUMERO DES NOEUDS AVEC RESISTANCE DE CONTACT ! C ! VRESCS ! TR ! R ! VALEUR DE LA RESISTANCE ! C !___________!____!____!______________________________________________! C ! COMMONS ! C !____________________________________________________________________! C ! /OPTCT/ ! ! D ! ! C ! /NLOFES/ ! ! D ! ! C !___________!____!____!______________________________________________! C C (*) TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU) C ET TYPES COMPOSES C (*) MODE : D (DONNEE NON MODIFIEE), R (RESULTAT), M (DONNEE MODIFIEE) C A (TABLEAU AUXILIAIRE) C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELE(S) : C C----------------------------------------------------------------------- C SOUS PROGRAMME(S) APPELANT(S) : C C*********************************************************************** C IMPLICIT NONE C C*********************************************************************** C DONNEES EN COMMON C*********************************************************************** C #include "optct.h" #include "nlofes.h" #include "divct.h" #include "syrthu.h" C C*********************************************************************** C C.. Variables externes INTEGER NDIM,NPOINS,NELEMS,NDMATS INTEGER NBFLUS,NBDIRS,NBECHS,NBRESS,NBRAIS INTEGER NREFS(NPOINS),NODES(NELEMS,NDMATS) DOUBLE PRECISION COORDS(NPOINS,NDIM),TMPS(NPOINS),TMPSA(NPOINS) INTEGER NFLUSS(NBFLUS),NDIRS(NBDIRS),NECHS(NBECHS) INTEGER NRESCS(NBRESS,2),NRAYIS(NBRAIS) DOUBLE PRECISION VFLUSS(NBFLUS),VDIRS(NBDIRS),VECHS(NBECHS,2) DOUBLE PRECISION VRESCS(NBRESS,2),VRAYIS(NBRAIS,2) C C.. Variables internes INTEGER N,NUMNO,NUMREF DOUBLE PRECISION T,XX,YY,ZZ,TT1,TT2 C LOGICAL LVERIF C C*********************************************************************** C C 1- INITIALISATIONS C ================== C LVERIF = .FALSE. C C*********************************************************************** C C INTERVENTION UTILISATEUR A PARTIR DE CETTE LIGNE C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C Pour stopper l'execution proprement en cas de probleme C mettre LSTOPS a "TRUE" dans vos tests C LSTOPS = .FALSE. C C C ========================================================= C 2- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE FLUX C ========================================================= C C C Temps courant sur le solide CUTI T = TEMPSS C C C Exemple ... C CUTI DO N=1,NBFLUS C C Numero global du noeud CUTI NUMNO = NFLUSS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 3, le flux vaut 1000 W/M2 C sinon, il vaut 10000 W/M2 C CUTI IF (NUMREF.EQ.3) THEN CUTI VFLUSS(N) = 1000.0D0 CUTI ELSE CUTI VFLUSS(N) = 10000.0D0 CUTI ENDIF C CUTI ENDDO C C ============================================================== C 3- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE DIRICHLET C ============================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBDIRS C C Numero global du noeud CUTI NUMNO = NDIRS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 5, le dirichlet vaut 2 sinon 3 C CUTI IF (NUMREF.EQ.3) THEN CUTI VDIRS(N) = 2.0D0 CUTI ELSE CUTI VDIRS(N) = 3.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 4- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C COEFFICIENT D'ECHANGE C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBECHS C C Numero global du noeud CUTI NUMNO = NECHS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure est C de 20 et le coefficient d'echange de 10, sinon, la temperature C exterieure et de 40 C C CUTI IF (NUMREF.EQ.6) THEN CUTI VECHS(N,1) = 20.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ELSE CUTI VECHS(N,1) = 40.0D0 CUTI VECHS(N,2) = 10.0D0 CUTI ENDIF C CUTI ENDDO C C C ==================================================== C 5- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RESISTANCE DE CONTACT C ==================================================== C Il s'agit d'initialiser la resistance de contact C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRESS C C Numero global du noeud CUTI NUMNO = NRESCS(N,1) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 4 C CUTI IF (NUMREF.EQ.4) THEN CUTI VRESCS(N,2) = 0.5D0 CUTI ELSE CUTI VRESCS(N,2) = 0.7D0 CUTI ENDIF C CUTI ENDDO C C ==================================================== C 6- INITIALISATION DES CONDITIONS AUX LIMITES DE TYPE C RAYONNEMENT INFINI C ==================================================== C C Temps courant sur le solide CUTI T = TEMPSS C C Exemple ... C CUTI DO N=1,NBRAIS C C Numero global du noeud CUTI NUMNO = NRAYIS(N) C C References du noeud CUTI NUMREF = NREFS(NUMNO) C C Coordonnees du noeud CUTI XX = COORDS(NUMNO,1) CUTI YY = COORDS(NUMNO,2) CUTI IF(NDIM.EQ.3) ZZ = COORDS(NUMNO,3) C C TT1 = Temperature au noeud courant CUTI TT1 = TMPS(NUMNO) C C Si le noeud porte la reference 6, la temperature exterieure C utilisee pour le rayonnement est de 100 degree C C L'emissivite est de 0.8 C de 20 degree et epsilon=0.9 autrement C CUTI IF (NUMREF.EQ.6) THEN CUTI VRAYIS(N,1) = 100.0D0 CUTI VRAYIS(N,2) = 0.8D0 CUTI ELSE CUTI VRAYIS(N,1) = 20.D0 CUTI VRAYIS(N,2) = 0.9 CUTI ENDIF C CUTI ENDDO C C FIN INTERVENTION UTILISATEUR C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C C*********************************************************************** C C 5- IMPRESSION DE CONTROLE C ========================= C IF (LVERIF) THEN C IF (NBFLUS.GT.0 .OR. NBDIRS.GT.0 .OR. NBECHS.GT.0) THEN WRITE(NFECRA,5000) ELSE WRITE(NFECRA,5001) ENDIF IF (NBFLUS.GT.0) THEN WRITE(NFECRA,5010) WRITE(NFECRA,5050) (NFLUSS(N),VFLUSS(N),N=1,NBFLUS) ENDIF IF (NBDIRS.GT.0) THEN WRITE(NFECRA,5020) WRITE(NFECRA,5050) (NDIRS(N),VDIRS(N),N=1,NBDIRS) ENDIF IF (NBECHS.GT.0) THEN WRITE(NFECRA,5030) WRITE(NFECRA,5060) & (NECHS(N),VECHS(N,1),VECHS(N,2),N=1,NBECHS) ENDIF IF (NBRAIS.GT.0) THEN WRITE(NFECRA,5040) WRITE(NFECRA,5060) & (NRAYIS(N),VRAYIS(N,1),VRAYIS(N,2),N=1,NBRAIS) ENDIF C ENDIF C C-------- C FORMATS C-------- C 5000 FORMAT(/,' *** LIMSOL : IMPRESSION DES CONDITIONS AUX LIMITES') 5001 FORMAT(/,' *** LIMSOL : CONDITIONS AUX LIMITES = FLUX NUL') 5010 FORMAT(/,' - Condition de type flux (noeud, valeur)') 5020 FORMAT(/,' - Condition de type Dirichlet (noeud, valeur)') 5030 FORMAT(/,' - Condition de type coeff echange (noeud, T, h)') 5040 FORMAT(/,' - Condition de type rayonnement infini', & ' (noeud, T, sigma)') 5050 FORMAT('(',I6,'-',G10.3,')') 5060 FORMAT('(',I6,'-',G10.3,',',G10.3,')') C C---- C FIN C---- END syrthes-3.4.3-dfsg1/data/0000777000175000017500000000000011524070646013626 5ustar pinipinisyrthes-3.4.3-dfsg1/data/syrthes.env0000666000175000017500000000224711524070646016046 0ustar pinipini* ************************************************************************ * EMPLACEMENT ET NOM DES FICHIERS DU MODULE SYRTHES * ************************************************************************ * * EMPLACEMENT DES FICHIERS POUR SYRTHES AMONT : ./ SUITE : ./ AVAL : ./ * * NOM DES FICHIERS AMONT POUR SYRTHES DONNEES DU CALCUL : syrthes.data GEOMETRIE SOLIDE : maillage.des DONNEES POUR LE RAYONNEMENT : syrthes.ray MAILLAGE RAYONNEMENT : maillray.des * * NOM DES FICHIERS SUITE POUR SYRTHES SUITE SOLIDE RESU : resus1.res STOCKAGE DES CORRESPONDANTS : corresp FACTEURS DE FORME RAYONNEMENT : fdf STOCKAGE DES CORRESPONDANTS RAYONNEMENT : corresp.ray * * NOM DES FICHIERS AVAL POUR SYRTHES RESU SYRTHES 1 : geoms.syr RESU SYRTHES 2 : resus1.res CHRONO SYRTHES 2 : resusc1.res HISTORIQUE SOLIDE RESULTAT : histos1 MAILLAGE PEAU FLUIDE : ff1 RESULTATS PEAU FLUIDE : ff2 CHRONO PEAU FLUIDE : ff2c MAILLAGE DE RAYONNEMENT : ray_geo.res RESULTATS DE RAYONNEMENT : ray_resu1.res CHRONO DE RAYONNEMENT : ray_chro1.res HISTORIQUE RAYONNEMENT : ray_histo1 * syrthes-3.4.3-dfsg1/data/syrthes.ray0000666000175000017500000000625711524070646016056 0ustar pinipini/********************************************************************* / Fichier de donnees pour SYRTHES 3.0 RAYONNEMENT /********************************************************************* / - Les lignes qui commencent par '/' sont des commentaires / - Dans une meme ligne, les blancs sont des separateurs, / leur nombre est quelconque / - L'ordre d'enumeration des conditions n'a aucune importance / - Les chaines sont donnees entre cotes / /********************************************************************* / Definitions / ----------- 'PERIODICITE DE ROTATION POUR LE RAYONNEMENT=' 'NON' 'NOMBRE DE PLANS DE SYMETRIE POUR LE RAYONNEMENT=' 0 / 'NOMBRE DE BANDES SPECTRALES POUR LE RAYONNEMENT=' 1 / / Sorties / ------- 'NIVEAU DES IMPRESSIONS POUR LE RAYONNEMENT=' 2 'PAS DES SORTIES CHRONO RAYONNEMENT=' -1 'HISTORIQUES RAYONNEMENT='NON' / / Gestion des correspondants et facteurs de forme /------------------------------------------------ 'NOMBRE DE REDECOUPAGES POUR CALCUL DES FACTEURS DE FORME=' 0 'DOMAINE DE RAYONNEMENT CONFINE OUVERT SUR L EXTERIEUR=' 'NON' 'STOCKAGE DES FACTEURS DE FORME SUR FICHIER=' 'OUI' 'LECTURE DES FACTEURS DE FORME SUR FICHIER=' 'NON' / 'STOCKAGE DES CORRESPONDANTS POUR RAYONNEMENT=' 'OUI' 'LECTURE DES CORRESPONDANTS POUR RAYONNEMENT=' 'NON' / /********************************************************************* / / References sur le solide / ------------------------ 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT CONFINE' 0 / / References sur le maillage de rayonnement / ----------------------------------------- 'RAYONNEMENT : REFERENCES FACES COUPLEES AU SOLIDE' 0 'RAYONNEMENT : REFERENCES FACES TEMPERATURE IMPOSEE' 0 'RAYONNEMENT : REFERENCES FACES FLUX IMPOSE' 0 / /********************************************************************* / ----------------------------------------- / Entree des conditions pour le rayonnement / ----------------------------------------- /'RAYT' 'SYM3D' ax + by + cz + d = 0 /'RAYT' 'SYM3D' 0. 0. 1. -0.5 / /'RAYT' 'SYM2D' ax + by + c = 0 /'RAYT' 'SYM2D' 0. 1. -0.5 / / 'RAYT' 'VOLUME CONNEXE' Px Py Pz /'RAYT' 'VOLUME CONNEXE' 0.1 0. 0.01 / / /'RAYT' 'PERIO3D' Px Py Pz Ax Ay Az alfa /'RAYT' 'PERIO3D' 0 0 0 0 0 1 90 / /'RAYT' 'PERIO2D' Px Py alfa /'RAYT' 'PERIO2D' 0 1 90 / / bande lbd1 lbd2 'RAYT' 'BANDES SPECTRALES' 1 1.e-10 10. / / bande emissi ref 'RAYT' 'EMISSIVITE PAR BANDE' 1 0.95 -1 / / /'RAYT' 'TEMPERATURE INFINI' 20. / / /********************************************************************* / ----------------------------------------- / Initialisation des temperature de face pour le rayonnement / ----------------------------------------- /'RAYT' 'TEMPERATURE IMPOSEE' temp (degre C) ref /'RAYT' 'TEMPERATURE IMPOSEE' 30. 3 / /'RAYT' 'FLUX IMPOSE PAR BANDE' bande flux (w/m2) ref / /********************************************************************* / ----------- / Historiques / ----------- /'HISTORIQUES' liste_des_facettes syrthes-3.4.3-dfsg1/data/syrthes.data0000666000175000017500000001006511524070646016164 0ustar pinipini/********************************************************************* / Fichier de donnees pour le couplage thermique /********************************************************************* / - Les lignes qui commencent par '/' sont des commentaires / - Dans une meme ligne, les blancs sont des separateurs, / leur nombre est quelconque / - L'ordre d'enumeration des conditions n'a aucune importance / - Les chaines sont donnees entre cotes / /********************************************************************* 'TITRE POUR LE CALCUL SOLIDE=' 'CALCUL SYRTHES : test' / / Definitions /------------- 'DIMENSION DU PROBLEME=' 2 'AXE D AXISYMETRIE (AUCUN,OX,OY)=' 'AUCUN' 'SUITE DE CALCUL=' 'NON' / 'ISOTROPIE DU MATERIAU=' 1 'NOMBRE DE DIRECTIONS PERIODIQUES=' 0 / 'CONDITIONS LIMITES PAR NOEUD OU PAR FACE=' 'FACE' 'DEFINITION DES PROPRIETES PHYSIQUES PAR=' 'ELEMENT' 'DEFINITION DES FLUX VOLUMIQUES PAR=' 'ELEMENT' / / Rayonnement /------------ 'PRISE EN COMPTE DU RAYONNEMENT CONFINE=' 'NON' / / Pas de temps /--------------- 'PAS DE TEMPS SOLIDE=' 100. /'PAS DE TEMPS AUTOMATIQUE=' variation_temperature(C) pas_de_tps_max(s) /'PAS DE TEMPS AUTOMATIQUE=' 0.1 1000. /'PAS DE TEMPS MULTIPLES=' iteration_max pas_de_temps /'PAS DE TEMPS MULTIPLES=' 100 1. /'PAS DE TEMPS MULTIPLES=' 200 10. 'NOMBRE DE PAS DE TEMPS SOLIDES=' 3 / / / Gestion des correspondants /--------------------------- 'STOCKAGE DES CORRESPONDANTS SUR FICHIER=' 'OUI' 'LECTURE DES CORRESPONDANTS SUR FICHIER=' 'NON' / / Sorties /-------- 'NIVEAU DES IMPRESSIONS POUR LE SOLIDE=' 2 'PAS DES SORTIES CHRONO SOLIDE=' -1 'ECRITURE MAILLAGE SOLIDE=' 'OUI' 'ECRITURE MAILLAGE PEAU FLUIDE=' 'NON' 'ECRITURE RESULTATS PEAU FLUIDE=' 'NON' 'ECRITURE CHRONO PEAU FLUIDE=' 'NON' 'HISTORIQUES CONDUCTION=' 'NON' 'CHAMP DE TEMPERATURES MAXIMALES=' 'NON' / / / Choix numeriques /----------------- 'NOMBRE ITERATIONS SOLVEUR SOLIDE=' 100 'PRECISION POUR LE SOLVEUR SOLIDE=' 1.E-6 / / /*************************************************************** / 'REFERENCES NOEUDS OU FACES SOLIDES COUPLE(E)S' 0 'REFERENCES NOEUDS SOLIDES AVEC DIRICHLET' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC FLUX' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC COEFFICIENT D ECHANGE' 0 'REFERENCES NOEUDS OU ELEMENTS SOLIDES AVEC FLUX VOLUMIQUES' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RESISTANCE DE CONTACT' 0 'REFERENCES NOEUDS SOLIDES PERIODIQUES' 0 'REFERENCES NOEUDS OU FACES SOLIDES AVEC RAYONNEMENT INFINI' 0 / / ------------------------------- / Entree des conditions initiales / ------------------------------- / mot-cle valeur liste des references 'CINI' 20. -1 / / / ----------------------------------------------------- / Entree des conditions aux limites constantes par bloc / ----------------------------------------------------- / mot-cle type valeur liste des references / /'CLIM' 'FLUX' flux. 1 /'CLIM' 'DIRICHLET' T 2 /'CLIM' 'COEF ECH' Text h 3 /'CLIM' 'COEF ECH' 20 6.3 2 /'CLIM' 'RES CONTACT' g 4 /'CLIM' 'PERIODICITE' 'T' vx vy vz 1 3 -1 4 5 /'CLIM' 'PERIODICITE' 'R' vx vy vz a1 a2 a3 b1 b2 b3 1 2 -1 3 4 /'CLIM' 'RAYT INFINI' T emiss 5 /'CLIM' 'RAYT INFINI' 20. 1. 2 / /'CVOL' valeur references / / --------------------------------------------------- / Entree des conditions physiques constantes par bloc / --------------------------------------------------- / mot-cle type valeur liste des references 'CPHY' 'RHO' 7700. -1 'CPHY' 'CP' 460. -1 'CPHY' 'K ISOTROPE' 25. -1 / / 'CPHY' 'K ORTHOTROPE' k11 k22 k33 ref / 'CPHY' 'K ANISOTROPE' k11 k22 k33 a1 a2 a3 ref / / / ----------- / Historiques / ----------- /'HIST' 'FREQ' 100. /'HIST' 'NOEUDS' 1 34 143 4 / / ------------- / bilan de flux / ------------- /'BILAN FLUX SURFACIQUES' 12 3 /'BILAN FLUX VOLUMIQUES' 12 3 /