ČVUT FS Ústav procesní a zpracovatelské techniky
FEMINA Část III. FEMINA V2: Data, algoritmy, výpisy programu
Autor: R.Žitný duben-září 2002
1
OBSAH 1. 2. 3. 4. 5.
FEMINA datové struktury FEMINA algoritmy sestavení a řešení soustavy rovnic FEMINA způsob zpracování příkazového řádku FEMINA interaktivně definované funkce a tabulky FEMINA poznámky k programu
Příloha FEMINA výpis zdrojového programu
2
1. FEMINA - DATOVÉ STRUKTURY verze V2 DATOVÉ STRUKTURY GEOMETRICKÉHO MODELU 1. Základní entitou jsou body, určené kartézskými souřadnicemi PTX(*),PTY(*),PTZ(*). Maximální počet bodů MAXPT (100). 2. Křivky jsou definované jako lineární nebo kvadratické funkce parametru t a jsou jednoznačně určeny dvěma, resp. třemi body PT. Nemají žádnou jednotnou vnitřní reprezentaci, takže změna souřadnic bodu PT automaticky znamená změnu tvaru křivky. Maximální počet křivek MAXCR (50). 3. Plochy jsou topologicky vždy čtyřúhelníky, definované čtyřmi, resp. osmi body PT. Při vytvoření nové plochy jsou automaticky generovány i čtyři nové křivky, ale ty nejsou součástí definice plochy (zrušení křivky ještě neznamená zrušení příslušné plochy). Geometrie křivočarého čtyřúhelníku je definována isoparametrickou transformací a je kompatibilní s definicí křivky třemi body. Maximální počet ploch MAXSF (20). 4. Objemy jsou definované 6 nebo 20 body PT a jsou to šestistěny. Maximální počet objemů MAXVL (10). Skutečnost, že neexistuje jednotná vnitřní reprezentace křivek nebo ploch znamená, že např. není možné definovat s dostatečnou přesností kružnici jen ze čtyř křivek (příkazem CIRCLE se generují čtyři kvadratické křivky, které jsou ale jen hrubým nahrazením kružnice). Neexistují atributy bodů, které by explicitně vyjadřovaly jejich příslušnost nadřazeným entitám (křivkám, plochám). Pokud tedy má být zrušen bod PT je třeba projít seznam všech křivek i ploch a ty z nich, v nichž se bod vyskytuje, zrušit také. DATOVÉ STRUKTURY KONEČNÝCH ELEMENTU: 1. Matice konektivity se nahrazuje vektorem konektivity IUE(*), a vektorem ukazovátek do tohoto vektoru LUE(*). To umožňuje, aby byly ve vektoru konektivity ukládány elementy s různými počty uzlů. Počet uzlů elementu IE je MUE(IE), a index I-tého uzlu elementu IE je IUE(LUE(IE)+I). Vektor LUE musí mít délku NE+1. Totéž co FEMINA ve verzi V1. Maximální počet elementů MAXEL (10000). 2. Informace o uzlech jsou v polích IPU,JPU,MPU,KINDU,XX,YY,V. Maximální počet uzlů je MAXND (10000), maximální počet parametrů uzlu MAXDOF (10). IPU(LPU(ND)+IP) - status uzlového parametru IP, uzlu ND. Záporné hodnoty IPU<0 označují silnou okrajovou podmínku, kladné hodnoty IPU>=0 neznámé. JPU(LPU(ND)+IP) - typ uzlového parametru (index): 1-TEMP[K], 2-UX[m], 3-UY[m], 4-UZ[m], 5-RX[rad], 6-RY, 7-RZ, 8-VOLT[V], 9-VX[m/s], 10-VY, 11-VZ, 12-PRES [Pa], 13-OMG [1/s], 14-PS [m2/s], 15-PSX [m/s], 16-PSY[m/s], 17PSXX[1/s], 18-PSXY[1/s], 19-PSYY[1/s], 20-CA[kg/m3], 21-CN[kg/m3], 22-CD[kg/m3], 23KT[m2/s2], 24-EPS[m2/s3]. Z těchto 24 parametrů se pro určitý typ úloh vybírá relevantní podskupina, přiřazovaná jako uzlové parametry generovaným uzlům. Zatím se rozlišují 3 typy úloh: STR (strukturní analýza), PSI (použití proudové funkce), UVP (výpočty rychlostí a tlaků). Před řešením konkrétní rovnice frontální metodou se specifikují aktivní uzlové parametry ve vektoru JDOF(NDOF). VAL(LPU(ND)+IP,3) - hodnota uzlového parametru (1-zadání,2-řešení,3-počáteční podmínka) KINDU(ND) - druh uzlu (=1 vrcholy, =2 středy stran, =3 těžiště) MPU(ND) - počet uzlových parametrů. 3. Každému elementu přiřazují vektory IGROUP(NE),IRCONS(NE),IMAT(NE) indexy skupin: 3
EGROUP (1-Steady/Transient, 2-NGauss, 3-Axisym, 4-Plane/Stress, 5-Boundary element) RCONST (1-H, 2-D, 3-p, 4-α, 5-Te, 6-Area, 7-Periphery, 8-Jz) MPROP (1-K, 2-Cp, 3-rho, 4-kappa, 5-E, 6-mi, 7-visc, 8-beta, 9-Dab, 10-Eakt, 11-Af). K-tepelná vodivost, Cp-měrná tepelná kapacita, RHO-hustota, Kappa-měrná elektrická vodivost, E-Youngův modul pružnosti, Mi-Poissonova konstanta, Visc-dynamická viskozita, Beta-teplotní roztažnost, Dab-difuzní součinitel, Eakt-aktivační energie, Af-preexponenciální faktor. Dále je pro každý element vyhrazena skupina matice EPAR(NE,*), jejíž prvky určují proměnné objemové zdroje, nebo výsledky postprocessingu. Je využívána např. pro uložení výsledných napětí, momentů a posouvajících sil v elementech (SHELLAX). 2. FEMINA V2 - Použité algoritmy řešení: Algoritmy jsou stejné jako programu FEMINA V1. Odlišnost se týká jen procedury FTFRON, která dostává seznam aktuálních DOF, které má brát v úvahu (tento seznam se definuje vždy před voláním FTFRON u konkrétního typu řešení, např. THERMAL nastaví jediný aktivní DOF – teplotu). Procedura FTFRON zajistí sestavení elementu IE=1,2,...,NE a řešení soustavy rovnic A.X=F, podrobněji (∑ As + Al ) X = F + ∑ ( Fs + Fl ) , As = ∫ N i , x N j , x dS , Al = ∫ N i N j dΓ , Fs = ∫ N i QdS , Fl = ∫ pN i dΓ e
e
S
Γ
S
Γ
kde As jsou příspěvky lokální matice elementů odpovídající integraci přes oblast S, Al odpovídá integraci přes hranici Γ, což zpravidla odpovídá okrajovým podmínkám třetího druhu. Vektor F jsou bodové zdroje (osamělé síly, zdroje tepla), zatímco Fs jsou plošné zdroje tepla nebo zatížení vlastni vahou, Fl odpovídá spojitému zdroji nebo zatížení tlakem p na hranici Γ. Pro vektor řešení X(*) i pro vektor pravé strany F(*) používá FTFRON jediný společný vektor V2(*)=VAL(,,2). Na vstupu do FTFRON obsahuje V2(*) uzlové hodnoty předepsaných silných okrajových podmínek pokud je status parametru IPU<0, nebo hodnoty bodového zatížení F (status parametru IPU>=0), všechny ostatní prvky V2(*) musí být nulové. Na výstupu FTFRON jsou tyto hodnoty V(*) přepsány řešením (samozřejmě s výjimkou silných okrajových podmínek). Procedura FTFRON volá v každém elementu uživatelskou proceduru FEL, která musí spočítat matici As+Al a vektory Fs+Fl. Pro jejich výpočet dostává k dispozici jedinou informaci, index elementu IE. Z vektoru konektivity IUE(*) musí stanovit indexy uzlů elementu ND, a status jednotlivých uzlových parametrů IPU(ND,IP). Zatímco FTFRON rozlišuje jen záporné a nezáporné hodnoty IPU (a ignoruje pasivované parametry |IPU|>1000000), mohou být konkrétní hodnoty IPU pro proceduru FEL významné. Dle nich se procedura FEL rozhoduje, zda se má počítat Al,Fs,Fl a jaká transformační funkce zatížení nebo okrajových podmínek se má použít. V programu FEMINA je procedura FTFRON využívána následujícím způsobem. Při řešení se používají dva vektory V1(*) (=VAL(,,1)) a V2(*) (=VAL(,,2)) se stejným významem prvku, určeným hodnotou IPU(*). Vektor V1(*) je připravován preprocesorem (procedury NFCR, MSF nastavují hodnoty IPU i konkrétní parametry) a teprve před voláním FTFRON se V1 transformuje do V2(*). Při této transformaci V1(*)→V2(*) se provádí následující konverze zajišťované procedurou LOADIN: 1. Je-li -10<=IPU<=10 volá se transformační funkce V1.f(IPU,x,y,t,T)→V2 2. Je-li 10
Funkce s indexem –10 až –1 jsou tedy určeny pro transforamce silných okrajových podmínek, indexy 0 až 10 transformují zatížení, zbývající indexy jsou určeny pro modelování závislostí materiálových parametrů na teplotě a invariantech. 3. FEMINA V2 – Způsob zpracování textu příkazového řádku Editaci textu zapisovaného do příkazového řádku zajišťuje procedura GMFEDL(10,LINE,IEND). Délka řádku LINE (LENLIN viz $DIAL) je 100 znaků a neexistuje režim pokračovacího řádku. Odeditovaný text LINE je předán proceduře PROCOM, která zajistí jeho zpracování: 1) Text LINE se konvertuje na velká písmena. 2) Identifikuje se klíčové slovo (6 znaků). 3) Zjistí se, zda řádek není zakončen středníkem (jeho pozice je ISEMI). 4) Identifikují se jednotlivé položky – parametry, oddělovačem je mezera nebo čárka, počet položek je LAST (procedura SELITE). Každá položka se překládá a okamžitě interpretuje jako výraz s výslednou hodnotou typu REAL, která se ukládá do vektoru P(1),…,P(LAST). Tyto hodnoty se ukládají i jako celočíselné do vektoru IP a text položky (max. 40 znaků) do textové proměnné TP. Toto vše zajišťuje procedura PROITE, výsledky jsou v COMMON /DIAL$/P(MAXPAR),IP(MAXPAR),TP(MAXPAR),LAST,ISEMI. Procedura PROCOM neví, jaký příkaz se zpracovává, ani kolik by měl mít parametrů. Je ale určeno klíčové slovo, dle kterého se větví hlavní program (SELECT CASE KEYW). Každá větev potom začíná voláním procedury DIAP(implic, KEYW, IEND), která zajišťuje dialog zadávání parametrů, které nebyly uvedeny na příkazovém řádku. DIAP se dle klíčového slova dozví, kolik má příkaz parametrů (NPAR≥LAST), a jaké jsou jejich default hodnoty. Pokud řádek LINE končil středníkem, doplní se default hodnoty zbývajících parametrů, v opačném případě se zahajuje dialog: nabídka voleb s implicitní hodnotou parametru a editace parametru, zpracovávaného opět jako výraz. Středník umožní dialog předčasně ukončit a pro zbývající parametry se pak použijí default hodnoty. Po provedení příkazu je zpravidla zapisován jeho otisk do souboru s příponou SES (Session file). To zajišťuje procedura WRITEL(KEYW), která zapíše řádek začínající klíčovým slovem KEYW za nímž následují textové položky TP(1),…,TP(NPAR) oddělené čárkami. 4. FEMINA V2 Interaktivní definice funkcí a tabulek Všechny definované funkce jsou vyčíslovány funkční procedurou CURFUN(IFUN), jejímž jediným parametrem je index funkce v rozsahu MIFUN až MAFUN (od –10 do 50). Argument IFUN je indexem vektoru INDFUN(ifun), který je v zóně FUNC$ / / /
COMMON /FUNC$/INDFUN(MIFUN:MAFUN), MFUNCT,MRPN(MAXFUN),IRPN(MAXRPN,MAXFUN),FUNTXT(MAXFUN), MTABLE,KTABLE(MAXTAB), MTPT(MAXTAB),XTAB(MAXTPT,MAXTAB),YTAB(MAXTPT,MAXTAB)
Pokud je hodnota INDFUN(ifun) nulová nebo když je IFUN mimo rozsah –10:50, není transformace IFUN definována ani tabulkou ani funkčním předpisem a procedura CURFUN předává hodnotu 1 (identická transformace). Pokud je INDFUN(ifun)=IFF větší než nula, je IFF indexem funkce, která se okamžitě vyčíslí (její přeložený kód délky MRPN(IFF) je v matici IRPN(*,IFF)), přičemž hodnoty argumentů i konstant jsou v zóně FEM$. Pokud je INDFUN(ifun)=IFF menší než nula, je -IFF indexem tabulky v níž se lineárně interpoluje. Tabulka, na rozdíl od funkce, umožňuje jen jediný argument, buď TIME,TEMP, X,Y,Z, UX,UY,UZ, SINV a jedna z těchto 9-ti možností je každé tabulce přiřazena vektorem KTABLE. 5
Funkce CURFUN je programy FEMINx používána explicitně při definici počátečních podmínek (hlavní program CASE INITIAL) a vždy před spuštěním frontální metody (procedura LOADIN). V proceduře LOADIN se postupně procházejí všechny aktivní uzlové parametry všech uzlových bodů (IDOF-index uzlového parametru), aktualizují se hodnoty pracovních proměnných X,Y (souřadnice uzlu), do pracovní zóny AUX se přenese i hodnota počáteční podmínky V3(IDOF) a pak se volá procedura CURFUN(IPU(IDOF)). Pokud je status uzlového parametru v absolutní hodnotě menší nebo roven 10 (tj. IPU(IDOF)= –10, -9,..,-1,0,1,…,10) násobí se hodnotou CURFUN(IPU(IDOF)) vektor V1(IDOF) a přiřadí odpovídající hodnotě V2 (tj. pracovnímu vektoru frontální metody) – to je nejčastější případ, odpovídající transformaci silných okrajových podmínek a zatížení. Pokud je status uzlového parametru IPU(IDOF)=11,12,…,20 hodnota V2(IDOF) se vynuluje, tj. neuvažuje se žádné zatížení, ale funkční hodnota CURFUN(IPU(IDOF)) se přesto použije – dosadí se do zóny V1(IDOF). Tato varianta má smysl v případě proměnných okrajových podmínek třetího druhu, když např. součinitel přestupu tepla α závisí na teplotě. Funkce CURFUN pak jeho hodnotu uloží do V1 a tam je dostupná proceduře, která konstruuje lokální matice elementů, jejichž prvky mohou na α záviset. Podobná operace probíhá při definování počátečních podmínek (V3). I zde se prochází seznam všech uzlových bodů a upravuje jeden výslovně specifikovaný uzlový parametr (např. teplota). Pokud je parametr fixován silnou okrajovou podmínkou (IPU(IDOF)<0) násobí se jeho hodnota transformační funkcí CURFUN(IPU(IDOF)) a vloží do V3. Pokud je IPU(IDOF) kladné, volá se funkce CURFUN(IFUN) a její hodnota se dosadí do V3(IDOF). Argument funkce IFUN je parametr příkazu, kterým byla inicializace vyvolána a může to být hodnota –10 až 50. Pozor na možné kolize s definicí funkčních závislostí okrajových podmínek, FEMINx způsob využití definovaných funkcí nikde nekontroluje! Bylo by např. chybou, kdyby byla funkce 10 použita pro definici počátečních podmínek a pokud by současně existovaly uzlové parametry se statusem IPU(IDOF)=10 – pak by totiž funkce 10 automaticky transformovala i zatížení. CURFUN se volá i v procedurách výpočtu lokálních matic elementů kde slouží pro přepočet teplotní závislosti termofyzikálních parametrů. K tomuto volání dochází v případě, že je u příslušného materiálového parametru specifikována funkce s argumentem IFUN různým od nuly. Stejně jako u počátečních podmínek lze použít jakýkoliv index IFUN (-10 až 50), ale je třeba dát pozor na eventuální kolize funkčních transformací okrajových podmínek a zatížení. Při definici nové funkce nebo tabulky (příkazy FUNDEF, CURDEF) se specifikuje index funkce IFUN. Pokud je hodnota INDFUN(IFUN) rovna nule, znamená to, že tato funkce ještě nebyla definovaná a vytvoří se nová (maximální počet různých funkcí je MAXFUN). Co se stane, když INDFUN(IFUN)=0, ale je překročen maximální počet funkcí MAXFUN a není tedy místo pro novou? V tom případě se definice nové funkce uloží pod číslem 0, což je pracovní zóna, která bude při nejbližší příležitosti přepsána. Pokud je INDFUN(IFUN)>0, funkce s tímto indexem již existuje, a je předefinována. Úplně stejně se postupuje v případě tabulek.
5. FEMINA poznámky k programu Program FEMINA.EXE zajišťuje čtení příkazů buď z klávesnice nebo ze souboru (makra) a jejich provedení. Přesněji řečeno existují 3 režimy zpracování příkazů: 1. Interpretace session souboru (.SES): Každý řádek souboru .SES představuje jeden příkaz, interpretovatelný procedurou OPERAT(LINE,IUNIT) (viz soubor $O-main); příkaz musí obsahovat všechny potřebné parametry - nelze je totiž dodatečně doplňovat, např. zadávat chybějící souřadnice myší. Mezi příkazy zpracovávané procedurou OPERAT nepatří např. 6
příkazy typu LIST, PLOT, GRAF určené pro interaktivní práci, ale patří sem příkazy pro řízení sekvence zpracování, např. #GOTO, #LOOP,…, a pochopitelně všechny výkonné příkazy (definice entit, generování sítě, vlastní výpočty a dokonce i volání externích programů). Zpracováním souboru *.SES je pověřena procedura COMFIL(iunit1,iunit2,icontrol), kterou lze považovat za modul, jehož zavolání vyřeší konkrétní úlohu popsanou příkazy na IUNIT1. Pokud je ICONTROL=.true., zjišťují se nejprve adresy skoků, které se vyskytují v příkazech #GOTO, #LABEL,… a pak teprve začíná interpretace jednotlivých příkazů ze souboru na jednotce IUNIT1, přičemž kopie příkazů se zapisuje na IUNIT2 (soubory přiřazené jednotkám IUNIT1,2 již musí být otevřené). Jestliže je ICONTROL=.false. příkazy typu #GOTO,… se ignorují a ani se nezapisuje kopie provedených příkazů na IUNIT2; všechny ostatní příkazy se ovšem provedou. 2. Režim MACRO je zdánlivě podobný: opět se interpretují příkazy zapsané v textovém souboru, jenomže tentokrát soubor není zpracován jako uzavřená a předem plně definovaná úloha procedurou COMFIL, nýbrž se pouze přepne vstup zadávání textu příkazů z klávesnice na zvolený soubor. To znamená, že nelze provádět příkazy skoků #GOTO, #LOOP, ale zase na druhé straně je možné doplňovat chybějící parametry v navazujícím dialogu: Soubor tudíž může představovat jen obecný předpis pro řešení určitého typu problému (může obsahovat třeba jen názvy jednotlivých příkazů, které je třeba provést) a konkrétní hodnoty parametrů se doplňují až během dialogu. Součástí makra mohou být všechny příkazy, používané v interaktivním režimu, tj. příkazy typu LIST, PLOT, GRAF… Zvláštní význam mají řádky začínající na C* (celý řádek je pak jen poznámkou), Q* (zpracování makra se předčasně ukončí a přechází se do normálního interaktivnímu režimu) a R* (nabídka možnosti zopakování předchozího příkazu, ale patrně s jinými parametry). 3. Interaktivní režim, v němž se příkazy zadávají z klávesnice a parametry příkazů během dialogu. Pokud není nalezeno klíčové slovo příkazu z taxativního seznamu jmen, zjišťuje se, zda by nemohlo být jménem externího programu (seznam těchto jmen je v inicializačním souboru FEMINA.CMD, který se čte vždy při spouštění programu FEMINA.EXE). Pokud tomu tak je, rozvine se standardní dialog zadávání potřebných parametrů (popis dialogu je uveden v souboru FEMINA.CMD) a pak se externí program spustí. Když klíčové slovo (začátek příkazového řádku) není¨klíčovým slovem je učiněn pokus interpretovat ho jako příkaz interního interpretu programů (např. A=1.234) – to je koneckonců asi nejjednodušší a nejrychleší způsob zadávání parametrů. Pokud je zjištěna chyba syntaxe patrně nešlo o příkaz interpretu programů, a zkouší se ještě poslední možnost – chápat klíčové slovo jako příkaz operačního systému MS-DOS. Teprve tehdy, když ani tento pokus nekončí úspěšně, zobrazí se text „unrecognized commad“ a volá se procedura HELP, která se snaží nalézt podobně zněnící příkazy (obvykle nabízí několik variant). Poznámky, týkající se volání jiných programů z FEMINA.EXE Libovolný program lze z programu FEMINA spouštět příkazem RUN jméno.exe. V tomto případě ale není zajišťován přenos dat mezi FEMINou a externím programem a FEMINA samozřejmě nezajišťuje ani jakýkoliv specializovaný dialog zadávání potřebných parametrů, který potom musí převzít na svá bedra externí program. Ve vyjmenovaných případech to ale jde (příprava a přenos vstupních dat i výsledků přímo v programu FEMINA): Po spuštění programu FEMINA.EXE se nejprve čte inicializační soubor FEMINA.CMD, např. \\extern TUPL TUPLEX.EXE Prumer trubky: 1.111 Delka trubky: 2.222 Hmotnostni prutok:3.333 Teplota na vstupu: 20 \\model SERIES mod1.txt 7
V současné době může FEMINA.CMD obsahovat pouze sekce \\extern a \\model (v libovolném pořadí). Každému externímu programu odpovídá jedna sekce \\extern začínající řádkem na němž je uvedeno nové klíčové slovo (např. TUPL) a pak jméno souboru spouštěného programu (např. TUPLEX.EXE). Na následujících řádcích je vždy název zadávaného parametru a jeho implicitní (default) hodnota. Hodnoty zadávaných parametrů jsou součástí databáze (DEXPAR(j,i) – j-tý parametr i-tého programu). Sekce \\model je jen seznamem jmen interpretovaných programů, používaných pro definici modelů soustavy obyčejných diferenciálních rovnic. Tyto modely jsou v textových souborech a jejich jména jsou přiřazena novým klíčovým slovům, např.
8
Příloha: Výpisy programů k datu 3.9.2002 Souborová struktura FEMINA.FOR Hlavní program $FEMLOC
$S-GRAF ident, grafy, plot,…
end main $S0-DIAL
DIAP
$S0-HELP HELP,SHOWFILE,SHOWTC,HELPC, COMHELP, VARHELP
$S1-PLOT … PLOTSF,…PLOTMOD,…GMFTXI,… GPIPE, GRAFTC… $S2-INIT …INIT, ANASET $S3-COMM …WRITEL [call OPERAT],… COMPEX[runqq COMPEX.EXE] $$COMM … PROCOM,PROITE,TRAN,TINE,TFUW,LOADIN,CURFUN,READBIN,WRITEBIN $S4-KLOC … PIPE,HEXC,RTD $S5-KLOC … THER,CONC,ELEC $S6-KLOC … MIKE,UVP,UVPP $S7-KLOC … CREE,PSIN,PSBL $S8-KLOC …PSOM,PENS,MIDE $S9-KLOC … SHEL,TRUSE,PLANE2 $S10-AUX … NCOMPRES,NDDEL,EDEL,NIDENT,PIDENT,…UIDENT, FTMCR2,…,RANGE,MOFE, P2ONCR,.. SF2CR,CHECK,CRCOMP,SORTRNUM $S11-MOD … READMOD,MODLI,GETPAR,RPNINI,RPNMOD,RUNGE,RUMODL,TCDV,SMOOTH,RNMOM,RNORM
$O-MAIN SUBROUTINE OPERAT END
$O-COMPU … call COMPEX …
$O-WREAD … WRNOD,RENOD,WRELE,RELE,WRTE,RETE,FOPEN $BLOCKD
9
C $fem
for FEMINA INCLUDE '$FEM-PAR' INCLUDE '$FEM-COM'
C $fem-PARAMETERS for /$FEM/ C FINITE ELEMENTS DATABASE pro 3D (popis viz. $FEM) C PARAMETER (MAXND=100000,MAXDOF=17,MAXTDOF=30,MAXEL=100000, / MAXANA=10,MAXEPA=7, / MAXGR=5,MAXRC=5,MAXMAT=5,MAXPEG=6,MAXPRC=11,MAXPMP=11) PARAMETER (MAXPT=100,MAXCR=100,MAXSF=100,MAXVL=10) PARAMETER (MAXAUX=70) PARAMETER (MAXCON=300) PARAMETER (MIFUN=-10,MAFUN=50,MAXFUN=9,MAXRPN=200, / MAXTAB=9,MAXTPT=8) PARAMETER (MAXMRPN=2000,MAXMCON=200,MAXCMOD=200,MAXPMOD=20, / MAXINPUTS=5,MAXOUTPUTS=5,MAXMOD=20) PARAMETER (MAXPAR=23,LENLIN=100,LENITE=80,LENDIAL=40, / LENMODEL=8000,MAXLABELS=100,MAXLINES=200) PARAMETER (MAXNTS=1024,MAXSEL=10) PARAMETER (MAXEXCOM=10) PARAMETER (MAXATR=300) PARAMETER (MAXCIND=30)
10
C $fem-com C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C
(parametry definovane v $fem-par)
FINITE ELEMENTS DATABASE pro 3D COMMON /FEM/ Maximalni pocet aktivnich DOF v uzlu MAXDOF=17, definovanych MAXTDOF=30, typu analyzy MAXANA=10, parametru elementu MAXEPA=7 GEOMETRIE :MAXPT-POINTS, MAXCR-CURVES, MAXSF-SURFACES,MAXVL-VOLUMES Zona IAUX je vicemene pracovni, nejsou v ni ulozena stala data. Cast A,...Z je vyhrazena uzivateli bez blizsiho urceni. Prvni promenne TIME,X,Y,Z a druhy invariant (tenzoru deformace, resp. rychlosti deformace) jsou hodnoty, ktere se aktualizuji v jednotlivych uzlech nebo elementech a pouzivaji je pak uzivatelsky definovane funkce ci tabulky definujici viskozitu a dalsi promenne termofyzikalni vlastnosti. 1 2 3 4 5 6 7 8 9 10 IAUX - TIME,X,Y,Z,SINVAR,free,free,free,free,free, 11 12 13 14 15 16 17 18 19 20 21 22 TEMP,UX,UY,UZ,RX,RY,RZ,VOLT,VX,VY,VZ,PRES, 23 24 25 26 27 28 29 OMG,PS,PSX,PSY,PSXX,PSYY,PSXY, 30 31 32 33 34 35 36 37 38 39 40 CN,CD,CA,KT,EPS,d25,d26,d27,d28,d29,d30 41 42 66 uzivatelske promenne A, B,...,Z, pro interpret ISEED - generator nahodnych cisel (NOT USED) ICOUNTS - citac elementu (pomocna promenna) POWER - dissipovany vykon (pomocna promenna) JEPA - index urcujici vyznam parametru v matici EPAR (tzn. typ posledne provadeneho postprocesingu 1-shell,2-pipe,3-flow,4-stress). NPT,NCR,NSF,NVL-POCET BODU, KRIVEK, PLOCH, OBJEMU NE,ND - POCET ELEMENTU, UZLU NGROUP,NRCONS,NMAT - POCET SKUPIN ELEMENTU, REALNYCH KONSTANT A VLASTNOSTI
NDOF KANAL
MPEG MPRC MPMP NTSTEP DTIME IALGOR(30)
RALGOR(30)
(67) (68) (69) (70) (71,...,74) (75,76) (77,..,79)
NDOF,JDOF(NDOF) se nastavuje vzdy pred volanim LOADIN,FTFRIN,FTFRON a urcuji pocet a vyznam aktivnich DOF: - Pocet aktivnich DOF uzlu pro danou operaci (delka JDOF(NDOF)) (80) - TYP ANALYZY (81) (1-STR,2-PSI,3-UVP,4-PSB,5-RTD,6-FULL... viz DATA TANAL(MAXANA)). Volba KANAL urcuje vyznam a pocet uzlovych parametru (JKIND), vyber atributu elementu (LGROUP), RC (LRCONS) i materialovych parametru (LRMAT). Tato nastaveni provadi SUBROUTINE ANASET. - POCET ATRIBUTU ELEMENTU PRO TYP ANALYZY KANAL (viz. LGROUP(MPEG)) (82) - POCET REALNYCH KONSTANT PRO TYP ANALYZY KANAL (viz. LRCONS(MPRC)) (83) - POCET MATERIALOVYCH PARAMETRU PRO TYP ANALYZY KANAL (viz. LRMAT(MPMP)) (84) - POCET CASOVYCH (iteracnich) KROKU (85) - CASOVY KROK (86) - BLIZSI SPECIFIKACE ALGORITMU VYPOCTU MATICE ELEMENTU (87) IALGOR(1)-vypocet matice hmotnosti, IALGOR(2)-uvazovani rychlosti, IALGOR(3)-prirozena konvekce, IALGOR(4)-uvazovani zdrojovych clenu IALGOR(5)-upwind IALGOR(6)-fouling. 7...10 volne. IALGOR(11)-operace ELEC (poc.iter.) IALGOR(12)-operace THER IALGOR(13)-operace CONC IALGOR(14)-operace UVP IALGOR(15)-operace UVPP IALGOR(16)-operace MIKE IALGOR(17)-operace PENS IALGOR(18)-operace PSIN IALGOR(19)-operace PSOM IALGOR(20)-operace PSBL IALGOR(21)-operace PIPE IALGOR(22)-operace HEXC IALGOR(23)-operace RTD IALGOR(24)-operace MIDE IALGOR(25) ... zatim nevyuzito - podobne jako IALGOR mohou byt v tomto vektoru konstanty (realne) specifikujici algoritmus reseni (117) RALGOR(1) -gx zrychleni, RALGOR(2)-gy zrychleni , RALGOR(3) -alpha (prestup tepla), RALGOR(4)-Te okolni teplota, RALGOR(5) -korekce upwind, RALGOR(6)-EPS pivot, RALGOR(7) -relaxacni faktor, RALGOR(8)-Scale DEFORM RALGOR(9) -penal.parametr Lambda RALGOR(10)-TOL vzdalenost bodu RALGOR(11)-residuum TEMP RALGOR(12)-residuum UX,UY,UZ RALGOR(13)-residuum RX,RY,RZ RALGOR(14)-residuum VOLT RALGOR(15)-residuum VX,VY,VZ RALGOR(16)-residuum PRES RALGOR(17)-residuum OMG RALGOR(18)-residuum PS RALGOR(19)-residuum PSX,PSY RALGOR(20)-residuum CN,CD,CA RALGOR(21)-optimalizovana hodnota RALGOR(22) ... zatim nevyuzito
11
C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C
NKIND,JKIND je informace pro generator uzlu, urcuje pocet a typ DOF: NKIND(3) - pocet uzlovych parametru pro uzly typu vrchol, strana, teziste JKIND(3,MAXDOF)-vyznam velicin v uzlech typu vrchol, strana, teziste (uplatni se pri generovani novych elementu) 1-TEMP, 2-Ux, 3-Uy, 4-Uz, 5-Rx, 6-Ry, 7-Rz, 8-Volt, 9-Vx, 10-Vy, 11-Vz, 12-pres, 13-omg, 14-ps, 15-psx, 16-psy, 17-psxx, 18-psyy, 19-psxy, 20-Cn, 21-Cd, 22-Ca, 23-k, 24-Eps, 25,...30 nevyuzito. Vyznam velicin je popsan v hlavnim programu DATA TDOF(MAXTDOF). JDOF(MAXDOF)
- Aktivni DOF (VYBER SHODNYCH PARAMETRU V JPU(*)). Tento vektor je predavan procedure FTFRON aby vedela, ktere parametry ma pocitat.
LGROUP,LRCONS,LRMAT slouzi jen pro dialog zadavani parametru LGROUP(MAXPEG)- Vyber sloupcu JGROUP,tj. vyber atributu elementu pro zvoleny typ analyzy (KANAL) JGROUP(,) - ATRIBUTY SKUPINY ELEMENTU sloupec 1 2 3 4 5 6 Steady/Trans. GAUSS-pt XY/XR Strain/Stress Boundary Optional
(147) (150)
(180)
(190) (196)
LRCONS(MAXPRC)- Vyber sloupcu RCONST, tj. vyber realnych konstant (226) RCONST(,) - REALNE KONSTANTY (RADEK JE SKUPINA, SLOUPEC PARAMETR) (237) sloupec 1 2 3 4 5 6 7 8 9 10 11 H D p alpha Te Area Perim Vol Ratio fi Jz Poznamka: parametr fi je hydraulicka charakteristika (funkce nebo tabulka) LRMAT(MAXPMP) - Vyber sloupcu RMAT,tj.materialovych parametru pro dany typ analyzy (292) RMAT(,) - MATERIALOVE PARAMETRY (303) JMAT(,) - CISLO FUNKCE, KTERYMI SE NASOBI HODNOTY MATERIALOVYCH PARAMETRU v matici RMAT sloupec 1 2 3 4 5 6 7 8 9 10 11 (358) Kx Cp RHO KAPPA E MI VISC beta Dn En An IUE() - VEKTOR KONEKTIVITY (413) LUE(ie) - LUE(IE)+I POZICE I-TEHO UZLU ELEMENTU IE VE VEKTORU KONEKTIVITY (40413) MUE(ie) - |MUE| POCET UZLU ELEMENTU (50413) EPAR(ie,maxepa)-PARAMETRY ELEMENTU (NAPR. DISSIPOVANY VYKON, VYPOCITANE VYSLEDKY) (60413) vyznam sloupcu je urcen parametrem JEPA (viz vyse): JEPA=1 (shellax) 1-Nalfa 2-Nbeta 3-Malfa 4-Mbeta 5-Q JEPA=2 (pipeline) 1-Q 2-Re 3-Tauw 4-Rfoul 5-Tmean 6/7 indexy JEPA=3 (flow) 1-Pdiss. 2-Wdiss. 3-II inv. 4-dT/dx 5-dT/dy JEPA=4 (stress) 1-Sxx 2-Syy 3-Txy 4-vMises IGROUP(ie) - CISLO SKUPINY EGROUP ELEMENTU (130413) IRCONS(ie) - CISLO SKUPINY RC ELEMENTU (140413) IMAT(ie) - CISLO SKUPINY MPROP ELEMENTU (150413) KINDE(ie) - 0-GENERAL,1-STR,2-PSI,3-UVP,4-PSB,5-RTD Hodnota KINDE se elementu prideluje pri jeho vytvareni (info pro sestaveni) NAMELE(ie) - 0-GENERAL,1-PIPE,2-CSTR,3-DIVIDER,4-HEXC zatim jen pro ikony elementu XX,YY,ZZ(nd) - SOURADNICE UZLU KINDU(nd) - TYP UZLU (=1 VRCHOLY,2=STRANY,3=TEZISTE) LPU(ND+1) - POINTER UZLOVYCH PARAMETRU MPU(ND) - POCET UZLOVYCH PARAMETRU UZLU IPU(*) - STATUS UZLOVEHO PARAMETRU JPU(*) - TYP UZLOVEHO PARAMETRU (VIZ JDOF()) VAL(*,4) - UZLOVE PARAMETRY, 1.SLOUPEC: ZADAVANE HODNOTY zatizeni, okrajove podminky (PREPROCESOR), 2.SLOUPEC: Transformace prvniho sloupce (LOADIN). Vstup i vystup FTFRON. 3.SLOUPEC: POCATECNI PODMINKY NEBO HODNOTY Z PREDCHOZIHO CASOVEHO KROKU. 4.SLOUPEC: hodnoty z predchozi iterace (v ramci jednoho cas.kroku) XGR(ND) - vybrane hodnoty uzloveho parametru pro grafiku (pomocny vektor) VGR(ND) - vybrane hodnoty uzloveho parametru pro grafiku (pomocny vektor) PTX,PTY,PTZ(npt)- SOURADNICE BODU NEARND(npt) - INDEX NEJBLIZSIHO UZLU ISF(8,*),MSF(*) - INDEXY BODU PLOCH, POCET TVORICICH BODU (4 NEBO 8) ICR(3,*),MCR(*) - INDEXY BODU KRIVEK, POCET TVORICICH BODU (2 NEBO 3) NXCR(maxcr) - informace o mesovani (pocet elementu na krivce) FLAFI(maxcr) - informace o mesovani (rovnomernost deleni) IVL(20,*),MVL(*)- INDEXY BODU OBJEMU, POCET TVORICICH BODU (8 NEBO 20) DOFMIN(MAXTDOF) - MINIMALNI HODNOTY UZLOVYCH PARAMETRU DOFMAX(MAXTDOF) - MAXIMALNI HODNOTY UZLOVYCH PARAMETRU DOFRESI(MAXTDOF)- aktualni hodnoty rezidui parametru pocitanych procedurou FTFRON DOFMEAN(MAXTDOF)- stredni absolutni hodnoty uzlovych parametru IMARK(MAXTDOF) - cislo znacky odpovidajici stupni volnosti 1-troj.nahoru,2-troj.dolu,3-krizek,4-ctver s troj.,5-kosoctverec, 6-ctverec s diag,7-kolecko,8-svisla sipka,9-vodorovna sipka IACT(8)
- 0/1 ACTIVATION
--------------- FUNCTIONS AND TABLES pro interpretaci parametru prikazu a funkci
12
C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C
PARAMETER (MAXCON=300) =MAXCINT*10 PARAMETER (MIFUN=-10,MAFUN=50,MAXFUN=9,MAXRPN=200,MAXTAB=9,MAXTPT=8) IICONS - zona konstant pro 10 FUNKCI (max. 15 konstant pro funkci, kazda konstanta potrebuje 2 slova) INDFUN -10,...-1 OKRAJOVE PODMINKY, 1:50 ZATIZENI A SLABE OKRAJ.PODMINKY MFUNCT - POCET DEFINOVANYCH FUNKCI (maximalne MAXFUN) MRPN(I) - DELKA KODU IRPN (maximalne MAXRPN) IRPN(,J) - KOD RPN J-TE FUNKCE MTABLE - POCET DEFINOVANYCH TABULEK (maximalne MAXTAB) KTABLE(J) - =0 TABULKA F(TEMPERATURE) =1 TABULKA F(TIME) =2 TABULKA F(X) =3 TABULKA F(Y) MTPT(J) - POCET BODU (X,Y) J-TE TABULKY (maximalne MAXTPT) XTAB,YTAB - HODNOTY NEZAVISLE A ZAVISLE PROMENNE --------------- PROGRAM interpretovaneho modelu PARAMETER (MAXMRPN=2000,MAXMCON=200,MAXCMOD=200,MAXPMOD=20) Model vznikne prekladem dvou sekci (\\IN a \\MO ) a vysledny kod je ulozen do vektoru MODRPN. Nejprve sekce \\IN a delce MIRPN a hned za ni sekce model o delce MMRPN. Celkova delka obou sekci je maximalne MAXMRPN. Obe sekce vyuzivaji stejnou zonu konstant a nove definovanych promennych MODCON. IMODELA - index aktivniho modelu (index klicoveho slova a jmena souboru) MIRPN - DELKA KODU RPN modelu (sekce \\IN). Vlastni kod je vektor MODRPN. MMRPN - DELKA KODU RPN modelu (sekce \\MO). Vlastni kod je MODRPN ale az od indexu MIRPN+1 NUMLINES - pocet radku textu modelu MODTXT (ma vyznam pouze pro zobrazovani textu) LINESRPN(MAXLINES) - pozice znaku v retezci MODTXT indikujici zacatky radku MODRPN(*) - KOD RPN modelu (obou sekci) MODCON(*) - konstanty modelu (obou sekci) CMODEL(MAXCMOD,2)-koncentrace (1.sloupec hodnoty C(i), 2.sloupec derivace DC(i)) IDENUM -identifikacni cislo modelu (uvadene v datovem souboru popisu modelu) METHOD -metoda reseni soustavy diferencialnich rovnic METHOD=0 Eulerova metoda, METHOD>0 RK s konstantnim krokem DTIME METHOD<0 RK s promennym krokem a pozadovanou presnosti EPS=10**METHOD NEQUAT -pocet resenych rovnic (delka vektoru CMODEL) NINPUTS -pocet vzruchovych funkci x(t,i) MINPUTS(MAXINPUTS) - indexy funkcnich prubehu (viz TGR,YGR) XINPUTS(MAXINPUTS) - pracovni vektor hodnot vzruchovych funkci (pro aktualni cas) NOUTPUTS -pocet odezvovych funkci y(t,i) MOUTPUTS(MAXOUTPUTS) - indexy funkcnich prubehu (viz TGR,YGR) YOUTPUTS(MAXOUTPUTS) - pracovni vektor hodnot odezvovych funkci (pro aktualni cas) NUMODP -pocet parametru modelu PMODEL(MAXPMOD) -pomocny vektor (muze to byt vektor parametru modelu, zalezi na LMODEL) RMODEL(MAXPMOD) -vektor relaxacnich parametru (pro kazdy optimalizovany parametr) ZMINP(MAXPMOD) -vektor urcujici dolni meze optimalizovanych parametru ZMAXP(MAXPMOD) -vektor urcujici horni meze optimalizovanych parametru LMODEL(MAXPMOD) -indexy parametru odkazujici na prvek /FEM/. Tento prvek (a ne nutne vektor PMODEL) je povazovan za parametr pri regresni analyze. JMODEL(MAXPMOD) -typ parametru =1 real, =2 integer KMODEL(MAXPMOD) -urceni toho, zda ma byt parametr stanoven regresi (0-nepocitat, 1-linearni parametr, 2-nelinearni, 3-linear search) --------------- DIALOG MAXPAR-maximalni pocet PARAMETRU PRIKAZU, LENLIN-delka prikaz.radku, LENITE-max.delka polozky (napr. vyrazu jako parametru) LENDIAL-delka napovedneho textu pri zadavani parametru LENMODEL-delka textu modelu (ve znacich) MAXLABELS-max.pocet navesti pouzitych v session filu PARAMETER (MAXPAR=23,LENLIN=100,LENITE=80,LENDIAL=40,LENMODEL=8000,MAXLABELS=100) RP(MAXPAR) - hodnota I-teho parametru prikazu (REAL) IP(MAXPAR) - hodnota I-teho parametru prikazu (INTEGER) LAST - INDEX POSLEDNIHO PRIKAZU ZADAVANEHO PRIMO, LAST+1,... V DIALOGU ISEMI - POZICE UKONCOVACIHO STREDNIKU v textu NLABELS - pocet navesti Kazde navesti ma tyto charakteristiky: LABELINE() - cislo radku v interpretovanem souboru, ktere odpovida navesti LOOPMAX() - pocet cyklu LOOP LOOPCOUNT() - pocitadlo cyklu LOOPLINE() - cislo radku za prikazem #LOOP --------------- RTD casove krivky MAXNTS-maximalni pocet casovych kroku, MAXSEL-maximalni pocet casovych prubehu, PARAMETER (MAXNTS=1000,MAXSEL=10) TGR(MAXNTS,MAXSEL) - nezavisle promenne (cas) YGR(MAXNTS,MAXSEL) - zavisle promenne (koncentrace, teploty,...)
13
C NGR(MAXSEL) - pocet bodu C INDG(MAXSEL) - (1) index uzlu ND, kteremu odpovida casovy prubeh nebo C (2) index souboru experimentalnich dat (t,c) nebo C (3) index vzruchove funkce modelu x(t,i) (inlet i) nebo C (4) index odezvove funkce modely y(t,i) (outlet i) C IQGR(MAXSEL) - typ casoveho prubehu (1-FEM, 2-experiment, 3-inlet, 4-outlet) C DTGR(MAXSEL) - casovy krok (pokud je DTGR<=0 uplatni se hodnoty TGR) C C KCOMPAR - kriterium pouzite pro porovnani krivek C =0 sum(abs(Y1-Y2))/n C =1 sum(abs((Y1-Y2)/max(Y1,Y2))/n C =2 sqrt(sum((Y1-Y2)**2)/n) C =3 sqrt(sum((Y1-Y2)/max(Y1,Y2))**2)/n C =4 intg(abs(Y1-Y2)) C =5 intg(abs((Y1-Y2)/max(Y1,Y2)) C =6 sqrt(intg((Y1-Y2)**2)) C =7 sqrt(intg((Y1-Y2)/max(Y1,Y2))**2) C SCOMPAR - hodnota sumy odchylek vsech porovnavanych krivek C NCOMPAR - pocet porovnavanych dvojic TC C ICOMPAR(2,MAXSEL/2) - indexy porovnavanych TC krivek C C MEXPERI - pocet definovanych datovych krivek c(t) C MEXPERI(maxsel) - indexy techto krivek (viz. TGR,YGR), jmena souboru FILEXPERI C C<--------------- AZ SEM SE NULUJE DATABAZE PRI INICIALIZACI (NOVY PROBLEM) C C --------------- EXTERNAL programs C C PARAMETER (MAXEXCOM=10) C NEXCOM - pocet definovanych externich programu C NEXPAR(i) - pocet parametru zadavanych pred spustenim programu i C DEXPAR(j,i) - default hodnota j-teho parametru programu i C NMODELS - pocet externich modelu (a tez klicovych slov i jmen souboru) C C --------------- logical LOGICAL READFI,RECORD,READMA C READFI - priznak cteni prikazu ze souboru pri interpretaci (logical) C RECORD - zaznam prikazu do souboru a potlaceni interpretace prikazu #xxx (logical) C READMA - read macro C C --------------- strings CHARACTER*4 LABELS,NEXKWD,MODKWD,TDOF CHARACTER*6 KEYW CHARACTER*8 PROBLEM,KEYW8 CHARACTER*12 FILENAM,FILEDAT,FILEXPERI,NEXFILE,MODFILE,VARTXT CHARACTER*(LENMODEL) MODTXT CHARACTER*(LENITE) TP,FUNTXT CHARACTER*(LENDIAL) NEXPARTXT,MODPARTXT C PROBLEM - character *8 nazev problemu (nebo vystupnich souboru) C FILENAM - character *12 jmeno souboru (s priponou - napr. record) C FILEDAT - default jmeno pro datovy soubor C FILEXPERI(MAXSEL)- nazev souboru casove krivky (odpovida vektoru NEXPER) C LABELS() - jmena navesti (na 4 znaky), viz #GOTO, #LABEL, #LOOP C NEXKWD(i) - klicove slovo (pouze na 4 znaky) volani externiho programu C NEXFILE(i) - jmeno souboru externiho programu cislo i C NEXPARTXT(j,i)- text hlavicky zadavani j-teho parametru i-teho EXterniho programu C MODKWD(i) - klicove slovo (pouze na 4 znaky) interpretovaneho modelu C MODFILE(i) - jmeno souboru interpretovaneho programu cislo i C MODTXT - TEXT modelu (aktualniho) C MODPARTXT(j) - text hlavicky zadavani j-teho parametru aktualniho modelu C VARTXT(j) - jmeno j-teho parametru C TP(MAXPAR) - text I-teho parametru prikazu (dialog zadavani parametru) C FUNTXT(MAXFUN)- text J-te funkce (viz FUNDEF casove nebo teplotni zavislosti) C TDOF(MAXTDOF) - nazvy DOF (4 znaky) / / / / / / / / / / / / / /
COMMON /FEM/ IAUX(MAXAUX), NPT,NCR,NSF,NVL, NE,ND, NGROUP,NRCONS,NMAT,NDOF,KANAL, MPEG,MPRC,MPMP,NTSTEP,DTIME, IALGOR(30),RALGOR(30), NKIND(3),JKIND(3,MAXDOF), JDOF(MAXDOF), LGROUP(MAXPEG),JGROUP(MAXGR,MAXPEG), LRCONS(MAXPRC),RCONST(MAXRC,MAXPRC), LRMAT(MAXPMP),RMAT(MAXMAT,MAXPMP),JMAT(MAXMAT,MAXPMP), IUE(4*MAXEL),LUE(MAXEL+1),MUE(MAXEL),EPAR(MAXEL,MAXEPA), IGROUP(MAXEL),IRCONS(MAXEL),IMAT(MAXEL), KINDE(MAXEL),NAMELE(MAXEL),
14
/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
XX(MAXND),YY(MAXND),ZZ(MAXND),KINDU(MAXND), LPU(MAXND+1),MPU(MAXND), IPU(MAXND*MAXDOF),JPU(MAXND*MAXDOF),VAL(MAXND*MAXDOF,4), XGR(MAXND),VGR(MAXND), PTX(MAXPT),PTY(MAXPT),PTZ(MAXPT),NEARND(MAXPT), ISF(8,MAXSF),MSF(MAXSF), ICR(3,MAXCR),MCR(MAXCR),NXCR(MAXCR),FLAFI(MAXCR), IVL(20,MAXVL),MVL(MAXVL), DOFMIN(MAXTDOF),DOFMAX(MAXTDOF), DOFRESI(MAXTDOF),DOFMEAN(MAXTDOF), IMARK(MAXTDOF),IACT(8), IICONS(MAXCON), INDFUN(MIFUN:MAFUN), MFUNCT,MRPN(MAXFUN),IRPN(MAXRPN,MAXFUN), MTABLE,KTABLE(MAXTAB), MTPT(MAXTAB),XTAB(MAXTPT,MAXTAB),YTAB(MAXTPT,MAXTAB), IMODELA,MIRPN,MMRPN,NUMLINES,LINESRPN(MAXLINES), MODRPN(MAXMRPN),MODCON(MAXMCON), CMODEL(MAXCMOD,2), IDENUM,METHOD,NEQUAT, NINPUTS,MINPUTS(MAXINPUTS),XINPUTS(MAXINPUTS), NOUTPUTS,MOUTPUTS(MAXOUTPUTS),YOUTPUTS(MAXOUTPUTS), NUMODP, PMODEL(MAXPMOD),RMODEL(MAXPMOD),ZMINP(MAXPMOD),ZMAXP(MAXPMOD), LMODEL(MAXPMOD),JMODEL(MAXPMOD),KMODEL(MAXPMOD), RP(MAXPAR),IP(MAXPAR),LAST,ISEMI, NLABELS,LABELINE(MAXLABELS), LOOPMAX(MAXLABELS),LOOPCOUNT(MAXLABELS),LOOPLINE(MAXLABELS), TGR(MAXNTS,MAXSEL),YGR(MAXNTS,MAXSEL),NGR(MAXSEL), INDG(MAXSEL),IQGR(MAXSEL),DTGR(MAXSEL), KCOMPAR,SCOMPAR,NCOMPAR,ICOMPAR(2,MAXSEL/2), NEXPERI,MEXPERI(MAXSEL), NEXCOM,NEXPAR(MAXEXCOM),DEXPAR(MAXPAR,MAXEXCOM), NMODELS, READFI,RECORD,READMA, PROBLEM,FILENAM,FILEDAT,FILEXPERI(MAXSEL), LABELS(MAXLABELS), NEXKWD(MAXEXCOM),NEXFILE(MAXEXCOM),NEXPARTXT(MAXPAR,MAXEXCOM), MODKWD(MAXMOD),MODFILE(MAXMOD), MODTXT,MODPARTXT(MAXPMOD),VARTXT(MAXPMOD), TP(MAXPAR),FUNTXT(MAXFUN), TDOF(MAXTDOF), KEYW8,IENDCHECK
C C Popisy EQUIVALENCE C DIMENSION AUX(MAXAUX),IEPAR(MAXEL,MAXEPA) EQUIVALENCE (IAUX,AUX,TIME),(IEPAR,EPAR),(IAUX(MAXAUX),JEPA), / (IAUX(MAXAUX-1),POWER),(IAUX(MAXAUX-2),ICOUNTS), / (IAUX(MAXAUX-3),ISEED), / (RALGOR(1),GX),(RALGOR(2),GY),(RALGOR(5),RUPW), / (RALGOR(6),EPSPIV),(RALGOR(9),PENFAKT),(RALGOR(10),TOL), / (NITELEC,IALGOR(11)),(NITTHER,IALGOR(12)),(NITCONC,IALGOR(13)), / (NITUVP ,IALGOR(14)),(NITUVPP,IALGOR(15)),(NITMIKE,IALGOR(16)), / (NITPENS,IALGOR(17)),(NITPSIN,IALGOR(18)),(NITPSOM,IALGOR(19)), / (NITPSBL,IALGOR(20)),(NITPIPE,IALGOR(21)),(NITHEXC,IALGOR(22)), / (NITRTD ,IALGOR(23)),(NITMIDE,IALGOR(24)), / (EPSTEMP,RALGOR(11)),(EPSVXYZ,RALGOR(15)),(EPSPRES,RALGOR(16)), / (EPSOMG ,RALGOR(17)),(EPSPS ,RALGOR(18)),(EPSCN ,RALGOR(20)), / (SUMREZ ,RALGOR(21)), / (KEYW,KEYW8) C----------------------------------------------
15
C $fem-loc
(parametry definovany v $fem-par)
C FINITE ELEMENTS DATABASE COMMON /FEM/ (vcetne DIAL,FUNC,RTD) C MAXEND JE CELKOVA DELKA ZONY /FEM/ C C Promenne pouzivane procedurou TRAN pro lokalizaci vektoru C LOCVST - 1.sloupec EGROUP (Steady/Transient) C LOCVGSS- 2.sloupec EGROUP (Gauss points) C LOCVPAX- 3.sloupec EGROUP (Planar/Axial sym) C LOCVH - 1.sloupec RCONST (h) C LOCVD - 2.sloupec RCONST (D) C LOCVPRS- 3.sloupec RCONST (P) C LOCVALF- 4.sloupec RCONST (ALF) C LOCVTE - 5.sloupec RCONST (Te) C LOCVARE- 6.sloupec RCONST (ARE) C LOCVPER- 7.sloupec RCONST (PER) C LOCVJZ - 8.sloupec RCONST (JZ) C LOCVKX - 1.sloupec RMAT (Kx-tepelna vodivost) C LOCVCP - 2.sloupec RMAT (Cp) C LOCVDEN- 3.sloupec RMAT (Density) C LOCVKAP- 4.sloupec RMAT (kappa) C LOCVEX - 5.sloupec RMAT (E-modul pruznosti) C LOCVMI - 6.sloupec RMAT (mi-Poisson const.) C LOCVISC- 7.sloupec RMAT (viskozita Pa.s) C LOCBETA- 8.sloupec RMAT (beta-roztaznost) C LOCVDN - 9.sloupec RMAT (Dn - difuzni soucinitel) C LOCVEN -10.sloupec RMAT (En - aktivacni energie) C LOCVAN -11.sloupec RMAT (An - frekvencni faktor) C LOCKIND- vektor typu uzlu (vrchol,strana,teziste) C LOCLPU - pointer uzlovych parametru (definuje IPU,JPU,VAL) C LOCMPU - pocty uzlovych parametru C LOCIPU - status uzloveho parametru C LOCJPU - vyznam uzlovych parametru (1-T,2-Ux,...) C LOCVAL - zacatek matice uzlovych parametru (jsou to vlastne 3 matice: C vstupni data, vysledek reseni, pocatecni podminky) C LOCV2 - vysledek reseni C LOCV3 - pocatecni podminky C LOCRANGE - DOFMIN,DOFMAX (rozsah hodnot vypoctenych uzlovych parametru) C---------------------------------------------PARAMETER ( / LOCAUX1=MAXAUX+1, / LOCAUX2=MAXAUX+2, / LOCAUX3=MAXAUX+3, / LOCAUX4=MAXAUX+4, / LOCAUX5=MAXAUX+5, / LOCAUX6=MAXAUX+6, / LOCAUX7=MAXAUX+7, / LOCAUX8=MAXAUX+8, / LOCAUX9=MAXAUX+9, / LOCAUX15=MAXAUX+15, / LOCAUX16=MAXAUX+16, / LOCIALG1=MAXAUX+17, / LOCIVELO=LOCIALG1+1, / LOCIBUOY=LOCIALG1+2, / LOCIOHMI=LOCIALG1+3, / LOCIUPW =LOCIALG1+4, / LOCIELEC=LOCIALG1+10, / LOCITHER=LOCIALG1+11, / LOCICONC=LOCIALG1+12, / LOCIUVP =LOCIALG1+13, / LOCIUVPP=LOCIALG1+14, / LOCIMIKE=LOCIALG1+15, / LOCIPENS=LOCIALG1+16, / LOCIPSIN=LOCIALG1+17, / LOCIPSOM=LOCIALG1+18, / LOCIPSBL=LOCIALG1+19, / LOCIPIPE=LOCIALG1+20, / LOCIHEXC=LOCIALG1+21, / LOCIRTD =LOCIALG1+22, / LOCIMIDE=LOCIALG1+23, / LOCRALG1=LOCIALG1+30, / LOCRALG2=LOCRALG1+1, / LOCRUPW =LOCRALG1+4, / LOCPIVT =LOCRALG1+5, / LOCRSCL =LOCRALG1+7, / LOCRLAMB=LOCRALG1+8, / LOCRTOL =LOCRALG1+9, / LOCSUMREZ=LOCRALG1+20, / LOCVST=MAXAUX+80+MAXDOF*4+MAXPEG,
16
/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
LOCVGSS=LOCVST+MAXGR, LOCVPAX=LOCVGSS+MAXGR, LOCVSTS=LOCVPAX+MAXGR, LOCVH=LOCVST+MAXPEG*MAXGR+MAXPRC, LOCVD=LOCVH+MAXRC, LOCVPRS=LOCVD+MAXRC, LOCVALF=LOCVPRS+MAXRC, LOCVTE=LOCVALF+MAXRC, LOCVARE=LOCVTE+MAXRC, LOCVPER=LOCVARE+MAXRC, LOCVJZ=LOCVPER+MAXRC, LOCVKX=LOCVH+MAXPRC*MAXRC+MAXPMP, LOCVCP=LOCVKX+MAXMAT, LOCVDEN=LOCVCP+MAXMAT, LOCVKAP=LOCVDEN+MAXMAT, LOCVEX=LOCVKAP+MAXMAT, LOCVMI=LOCVEX+MAXMAT, LOCVISC=LOCVMI+MAXMAT, LOCVBET=LOCVISC+MAXMAT, LOCVDN=LOCVBET+MAXMAT, LOCVEN=LOCVDN+MAXMAT, LOCVAN=LOCVEN+MAXMAT, LOCVKXF=LOCVKX+MAXMAT*MAXPMP, LOCIUE=LOCVKX+2*MAXMAT*MAXPMP, LOCLUE=LOCIUE+4*MAXEL, LOCMUE=LOCLUE+MAXEL+1, LOCEPAR=LOCMUE+MAXEL, LOCEPA2=LOCEPAR+MAXEL, LOCEPA3=LOCEPA2+MAXEL, LOCEPA4=LOCEPA3+MAXEL, LOCEPA5=LOCEPA4+MAXEL, LOCIGROUP=LOCEPAR+MAXEL*MAXEPA, LOCIRCONS=LOCIGROUP+MAXEL, LOCIMAT=LOCIRCONS+MAXEL, LOCKINDE=LOCIMAT+MAXEL, LOCXX=LOCKINDE+2*MAXEL, LOCYY=LOCXX+MAXND, LOCZZ=LOCYY+MAXND, LOCKIND=LOCZZ+MAXND, LOCLPU=LOCKIND+MAXND, LOCMPU=LOCLPU+MAXND+1, LOCIPU=LOCMPU+MAXND, LOCJPU=LOCIPU+MAXDOF*MAXND, LOCVAL=LOCJPU+MAXDOF*MAXND, LOCV2 =LOCVAL+MAXDOF*MAXND, LOCV3 =LOCV2 +MAXDOF*MAXND, LOCXGR=LOCVAL+4*MAXDOF*MAXND, LOCVGR=LOCXGR+MAXND, LOCPTX=LOCVGR+MAXND, LOCPTY=LOCPTX+MAXPT, LOCPTZ=LOCPTY+MAXPT, LOCNEAR=LOCPTZ+MAXPT, LOCRANGE=LOCNEAR+MAXPT+9*MAXSF+6*MAXCR+21*MAXVL, LOCRESI=LOCRANGE+2*MAXTDOF, LOCMEAN=LOCRESI+MAXTDOF, LOCIACT=LOCRANGE+5*MAXTDOF, LOCONST=LOCIACT+8, LOCIFUN=LOCONST+MAXCON, LOCMFUN=LOCIFUN+MAFUN-MIFUN+1, LOCMTAB=LOCMFUN+(MAXRPN+1)*MAXFUN+1, LOCIMODELA=LOCMTAB+(MAXTPT*2+2)*MAXTAB+1, LOCMODRPN=LOCIMODELA+4+MAXLINES, LOCMODCON=LOCMODRPN+MAXMRPN, LOCMVAL=LOCMODCON+MAXMCON, LOCMDER=LOCMVAL+MAXCMOD, LOCMETHOD=LOCMDER+MAXCMOD+1, LOCNEQUAT=LOCMETHOD+1, LOCNINPUTS=LOCNEQUAT+1, LOCMINPUTS=LOCNINPUTS+1, LOCXINPUTS=LOCMINPUTS+MAXINPUTS, LOCNOUTPUTS=LOCXINPUTS+MAXINPUTS, LOCMOUTPUTS=LOCNOUTPUTS+1, LOCYOUTPUTS=LOCMOUTPUTS+MAXOUTPUTS, LOCNUMODP=LOCYOUTPUTS+MAXOUTPUTS, LOCPMOD=LOCNUMODP+1, LOCRMOD=LOCPMOD+MAXPMOD, LOCZMINP=LOCRMOD+MAXPMOD, LOCZMAXP=LOCZMINP+MAXPMOD, LOCLMOD=LOCZMAXP+MAXPMOD, LOCJMOD=LOCLMOD+MAXPMOD,
17
/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
LOCKMOD=LOCJMOD+MAXPMOD, LOCNLABELS=LOCKMOD+MAXPMOD+2*MAXPAR+2, LOCTG1=LOCNLABELS+1+4*MAXLABELS, LOCTG2=LOCTG1+MAXNTS, LOCTG3=LOCTG2+MAXNTS, LOCTG4=LOCTG3+MAXNTS, LOCTG5=LOCTG4+MAXNTS, LOCTG6=LOCTG5+MAXNTS, LOCYG1=LOCTG1+MAXNTS*MAXSEL, LOCYG2=LOCYG1+MAXNTS, LOCYG3=LOCYG2+MAXNTS, LOCYG4=LOCYG3+MAXNTS, LOCYG5=LOCYG4+MAXNTS, LOCYG6=LOCYG5+MAXNTS, LOCNGR=LOCYG1+MAXNTS*MAXSEL, LOCINDG=LOCNGR+MAXSEL, LOCIQGR=LOCINDG+MAXSEL, LOCDTGR=LOCIQGR+MAXSEL, LOCKCOMPAR=LOCDTGR+MAXSEL, LOCSCOMPAR=LOCKCOMPAR+1, LOCNCOMPAR=LOCSCOMPAR+1, LOCICOMPAR=LOCNCOMPAR+1, LOCNEXPERI=LOCICOMPAR+MAXSEL, LOCMEXPERI=LOCNEXPERI+1, LOCNEXCOM=LOCMEXPERI+MAXSEL, LOCNMODELS=LOCNEXCOM+MAXEXCOM*(MAXPAR+1)+1, LOCPROBLEM=LOCNMODELS+4, MAXEND=LOCPROBLEM+10+3*MAXSEL+MAXLABELS+ (LENITE/4)*(MAXPAR+MAXFUN)+4*MAXMOD+ LENMODEL/4+(LENDIAL/4)*(MAXPMOD+MAXPAR*MAXEXCOM)+ 3*MAXPMOD+4*MAXEXCOM+MAXTDOF)
C $FEMLOC C FINITE ELEMENTS DATABASE COMMON /FEM/ (vcetne DIAL,FUNC,RTD) INCLUDE '$FEM-PAR' INCLUDE '$FEM-COM' INCLUDE '$FEM-LOC' DIMENSION INTERC(MAXEND),REALRC(MAXEND) EQUIVALENCE (INTERC,REALRC,IAUX)
18
BLOCK DATA INCLUDE '$FEM-PAR' INCLUDE '$FEM-LOC' CHARACTER *8 NAME COMMON /TRANDAT/NVARSYS,NVARTOT,IATTR(2,MAXATR),IATTW(2,MAXATR), / NAME(MAXATR) DATA NVARSYS,NVARTOT/205,205/ DATA IATTR / / 1,1, 2,1, 3,1, 4,1, 5,1, / 11,1,12,1,13,1,14,1,15,1,16,1,17,1,18,1,19,1,20,1, / 21,1,22,1,23,1,24,1,25,1,26,1,27,1,28,1,29,1,30,1, / 31,1,32,1,33,1,34,1, / 41,1,42,1,43,1,44,1,45,1,46,1,47,1,48,1,49,2,50,2, / 51,2,52,2,53,2,54,2,55,1,56,1,57,1,58,1,59,1,60,1, / 61,1,62,1,63,1,64,1,65,1,66,1, / LOCAUX1,2,LOCAUX2,2,LOCAUX3,2,LOCAUX4,2,LOCAUX5,2, / LOCAUX6,2,LOCAUX7,2,LOCAUX8,2,LOCAUX9,2, / LOCAUX15,2,LOCAUX16,1, / LOCIALG1,4,LOCRALG1,3, / LOCIVELO,2,LOCIBUOY,2,LOCIOHMI,2,LOCIUPW,2,LOCIELEC,2, / LOCITHER,2,LOCICONC,2,LOCIUVP,2,LOCIPENS,2,LOCIPSIN,2, / LOCIPSOM,2,LOCIPSBL,2,LOCIPIPE,2,LOCIHEXC,2,LOCIRTD,2, / LOCIMIKE,2,LOCIUVPP,2,LOCIMIDE,2, / LOCRALG1,1,LOCRALG2,1,LOCRUPW,1,LOCRSCL,1,LOCRLAMB,1, / LOCPIVT,1,LOCRTOL,1, / LOCXX,3,LOCYY,3,LOCZZ,3,LOCKIND,4,LOCLPU,4,LOCMPU,4, / LOCIPU,4,LOCJPU,4, / LOCVAL,3,LOCV2,3,LOCV3,3, / LOCEPAR,3,LOCEPA2,3,LOCEPA3,3,LOCEPA4,3,LOCEPA5,3, / LOCVST,4,LOCVGSS,4,LOCVPAX,4,LOCVSTS,4, / LOCVH,3,LOCVD,3,LOCVPRS,3,LOCVALF,3, / LOCVTE,3,LOCVARE,3,LOCVPER,3,LOCVJZ,3, / LOCVPRS,3,LOCVALF,3, / LOCVTE,3,LOCVARE,3,LOCVPER,3,LOCVJZ,3, / LOCVKX,3,LOCVCP,3,LOCVDEN,3,LOCVKAP,3, / LOCVEX,3,LOCVMI,3,LOCVISC,3,LOCVBET,3, / LOCVDN,3,LOCVEN,3,LOCVAN,3,LOCRANGE,3, / LOCRESI,3,LOCMEAN,3, / LOCVKX,3,LOCVCP,3,LOCVDEN,3,LOCVKAP,3, / LOCVEX,3,LOCVMI,3, LOCVBET,3, / LOCVDN,3,LOCVEN,3,LOCVAN,3, / LOCPTX,3,LOCPTY,3,LOCPTZ,3, / LOCMVAL,3,LOCMDER,3,LOCPMOD,3,LOCPMOD,4,LOCRMOD,3, / LOCZMINP,3,LOCZMAXP,3, / LOCLMOD,4,LOCKMOD,4,LOCNUMODP,2,LOCMETHOD,2, / LOCNEQUAT,2,LOCNMODELS,2, / LOCNINPUTS,2,LOCMINPUTS,4,LOCXINPUTS,3, / LOCNOUTPUTS,2,LOCMOUTPUTS,4,LOCYOUTPUTS,3, / LOCTG1,3,LOCTG2,3,LOCTG3,3,LOCTG4,3,LOCTG5,3,LOCTG6,3, / LOCYG1,3,LOCYG2,3,LOCYG3,3,LOCYG4,3,LOCYG5,3,LOCYG6,3, / LOCNGR,4,LOCINDG,4,LOCIQGR,4,LOCDTGR,3, / LOCKCOMPAR,2,LOCSCOMPAR,1,LOCNCOMPAR,2,LOCICOMPAR,4, / 1,5, 2,5, 3,5, 4,5, 5,5, 6,5, 7,5, 8,5, / 9,5,10,5,11,5, / MAXEND,2,190*0/ DATA NAME / / 'TIME ','$X ','$Y ','$Z ','$SINV ', / 'TEMP ','UX ','UY ','UZ ', / 'RX ','RY ','RZ ','VOLT ','VX ', / 'VY ','VZ ','PRES ','OMG ', / 'PS ','PSX ','PSY ','PSXX ','PSYY ', / 'PSXY ', / 'CN ','CD ','CA ','KT ','EPS ', / 'A ','B ','C ','D ','E ', / 'F ','G ','H ','I ', / 'J ','K ','L ','M ','N ', / 'O ','P ','Q ','R ', / 'S ','T ','U ','V ','W ', / 'X ','Y ','Z ', / 'NPT ','NCR ','NSF ','NVL ','NE ', / 'ND ','NGRP ','NRC ','NMAT ', / 'STEP ','DT ','IALG ','RALG ', / 'VELO ','BUOY ','OHMI ','UPW ','ELEC ', / 'THER ','CONC ','UVP ','PENS ','PSIN ', / 'PSOM ','PSBL ','PIPE ','HEXC ','RTD ', / 'MIKE ','UVPP ','MIDE ', / 'GX ','GY ','RUPW ','SCL ','LAMB ', / 'PIVT ','TOL ',
19
/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
'XND 'MPU 'V1 'E1 'VST 'VH 'VAREA 'VP 'JZ 'VKX 'VMI 'VAN 'CP 'BETA 'XPT 'CM 'PMIN 'NP 'NINP 'YV 'T1 'T6 'C1 'C6 'NTC 'KCOMP 'MIN 'PLG 'XVT 'ENDC END
','YND ','IPU ','V2 ','E2 ','VGSS ','VD ','VPERIM ','ALPHA ', ','VCP ','VISC ','VRNG ','DENS ','DN ','YPT ','DCM ','PMAX ','METH ','VINP ', ','T2 ', ','C2 ', ','ITC ','SCOMP ','MAX ','PTC ','YVT ',95*' '/
','ZND ','JPU ','V3 ','E3 ','VAX ','VPRS ','VJZ ','TE
','KIND ', ', ','E4 ','VSTS ','VALPHA ', ','AREA
','LPU
',
','E5 ', ','VTE
',
','PERIM
',
','VDENS ','VBETA ','VDEV ','KAPPA ','EN ','ZPT ','PM ','PLOC ','NEQ ','XV
','VKAPPA ','VDN ','MEAN ','EX ','AN ', ','IP ','REGR ','NMOD ','NOUT
','VEX ','VEN ','KX ','MI ',
', ', ', ',
','WM ', ', ','VOUT
',
','T3
','T4
','T5
',
','C3
','C4
','C5
',
','QTC ','NCOMP ','ATN ','RND ','CVT
','DTC ','ICOMP ','ERF ', ',
', ', ','PLE
',
',
',
20
C FEMINA.for C UNITS C 1 session file C 2 session file interpret, UNDO files C 3 OUT files, binary files, nacteni textu programu MODEL C 4 MACRO files C 8 record C 9 dbg C 10 window console C 11 window status C 20 window MODEL C 21 window GRAPH C 30 window LIST C 40 window HELP C USE MSFLIB COMMON /$RPN/NCRPN,ICRPN(200) INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ INCLUDE '$C0-HELP' INCLUDE '$FEMLOC' C MAXLIST vypis definovanych funkci a DOF ve stavovem radku C MAXOPER max.pocet operaci (ELEC,THER,...) C MAXCNTR pocet vrstevnic PARAMETER (MAXLIST=10,MAXOPER=14,MAXCNTR=8) CHARACTER*1 TLISFUN(MAXLIST),CH CHARACTER*6 POSIT CHARACTER*8 CLOCKDATE,NAME CHARACTER*10 CLOCKTIME CHARACTER*12 STATUS,FILESES CHARACTER*(LENLIN) LINE,TXTV DIMENSION X8(8),Y8(8),Z8(8),V8(8),NSORT(MAXATR) C LISTFUN - pouziva se pro vytvoreni a zobrazeni indexu definovanych funkci C TLISFUN bud T nebo F oznaceni tabulky nebo funkce v seznamu funkci C LISTALG - seznam operaci s nenulovym poctem iteraci (viz. CLIST) DIMENSION LISTFUN(MAXLIST),LISALG(MAXLIST) LOGICAL FIRST,GRIDON,EXPROG,RESULT COMMON /TRANDAT/NVARSYS,NVARTOT,IATTR(2,MAXATR),IATTW(2,MAXATR), / NAME(MAXATR) CHARACTER*9 LABEL, LEPA(MAXEPA,4)*8, LALG(MAXOPER)*4 DATA LEPA/ /'N-alpha ','N-beta ','M-alpha ','M-beta ','Q ', / 'E1 ','E2 ', /'Q-m^3/s ','Reynolds','Tau_wall','RFouling','Tmean ', / 'E1 ','E2 ', /'P-dissip','W-dissip','II-inv. ','Tx ','Ty ', / 'E1 ','E2 ', /'S_xx ','S_yy ','Tau_xy ','von Mis.','NAN ', / 'E1 ','E2 '/ C LALG(LISTALG()) prikaz CL viz $S-PLIST DATA LALG/ / 'ELEC','THER','CONC','UVP ','UVPP','MIKE','PENS', / 'PSIN','PSOM','PSBL','PIPE','HEXC','RTD ','MIDE'/ C DOF, EGROUP, REALCONST, MPROP names C TANAL nazev aktivniho typu analyzy (KANAL) CHARACTER*4 TEG(MAXPEG),TRC(MAXPRC),TMAT(MAXPMP),TANAL(MAXANA) DATA TMAT/'Kx ','Cp ','Dens','Kapp','Ex ','mi ','visc','beta', / 'DN ','EN ','AN '/ DATA TRC /'h[m]','D[m]','pres','Alfa','Te ','Area','Peri','Vol ', / 'Rati','Fidp','Jz '/ DATA TEG /'S/T ','Gaus','Cyl.','P/St','Bnd ','Opt6'/ DATA TANAL/'STR ','PSI ','UVP ','PSBL','RTD ','full',4*' '/ C Kresba vrstevnic parametru elementu DIMENSION IVCOLOR(MAXCNTR),VCOLOR(MAXCNTR) DATA IVCOLOR/1,2,12,9,13,11,14,10/
NEXPARTXT(NPP,NEXCOM)=LINE(1:IND-1) CALL TAKERD(LINE,LENLIN,IND,DEXPAR(NPP,NEXCOM),K) NEXPAR(NEXCOM)=NPP GOTO 2002 ELSE GOTO 2003 ENDIF ELSEIF(LINE(1:7).EQ.'\\MODEL')THEN READ(1,'(A)',END=2001)LINE CALL TUPC(LENLINE,LINE,LINE) NMODELS=NMODELS+1 CALL SELITE(LINE,0,TXTV,K) MODKWD(NMODELS)=TRIM(TXTV) CALL SELITE(LINE,K,TXTV,K) MODFILE(NMODELS)=TRIM(ADJUSTL(TXTV)) ENDIF GOTO 2000 2001 CLOSE(1) C-----------------------------------------------C ISEED=425001 GRIDON=.FALSE. IP1=1 JEPA=1 C Pocet radek v okne LIST je 13 NBCK=13 IZONE=2 ZDEF=0 FILENAM='DEFAULT' FILEDAT='*.*' STATUS='' C Aktivace WIN CALL WFULL C pocet radku, sloupcu, offset sloupec, offset radek, pixx,pixy CALL WOPEN(10,'CONSOLE',11, 90, 0, 33, 640,145) CALL WOPEN(20,'MODEL', 29, 90, 0, 0, 640,460) CALL WOPEN(30,'LIST DBG-file (use U,D,PU,PD)', / 14, 50, 93, 0, 364,215) II=SETBKCOLOR(3) CALL CLEARSCREEN($GCLEARSCREEN) CALL WOPEN(21,'GRAPHS', 20, 60, 93, 15, 364,273) II=SETBKCOLOR(3) CALL CLEARSCREEN($GCLEARSCREEN) CALL WOPEN(40,'HELP', 8, 50, 93, 33, 0,0) II=SETBKCOLOR(3) CALL CLEARSCREEN($GCLEARSCREEN) CALL HELP C Initialise default analysis, open session file and draw axis II=FOCUSQQ(10) II=SETTEXTCOLOR(int2(11)) WRITE(10,'('' PROBLEM (MAX.8 CHARACTERS)> ''\)') II=SETTEXTCOLOR(int2(15)) READ(10,'(A)')PROBLEM C ----------------------------------------------1000 CALL INIT ISTATUS=1 CLOSE(1) CLOSE(2) CLOSE(3) CLOSE(8) CLOSE(9) RECORD=.FALSE. READFI=.FALSE. READMA=.FALSE. II=SETACTIVEQQ(20) OPEN(1,FILE=TRIM(PROBLEM)//'.SES') C This file 9 is only for debugging and LIST window OPEN(9,FILE=TRIM(PROBLEM)//'.DBG',BLOCKSIZE=15000) CALL DATE_AND_TIME(CLOCKDATE,CLOCKTIME) WRITE(9,'('' Opening '',A,'' date:'',A,''.'',A,''.'',A,'' at '',A, TDOF=(/ /'':'',A)')TRIM(PROBLEM), / 'TEMP','UX ','UY ','UZ ','RX ','RY ','RZ ','VOLT', / CLOCKDATE(7:8),CLOCKDATE(5:6),CLOCKDATE(3:4), / 'VX ','VY ','VZ ','PRES', / CLOCKTIME(1:2),CLOCKTIME(3:4) / 'OMG ','PS ','PSX ','PSY ','PSXX','PSYY','PSXY', WRITE(1,'(''C* Opening '',A,'' date:'',A,''.'',A,''.'',A, / 'CN ','CD ','CA ','KT ','EPS ','FI ','d26 ', /'' at '',A,'':'',A)')TRIM(PROBLEM), / 'd27 ','d28 ','d29 ','d30 '/) / IMARK=(/6,9,8,8,9,8,8,5,9,8,8,3,2,1,19,18,29,28,28,4,4,4,0, CLOCKDATE(7:8),CLOCKDATE(5:6),CLOCKDATE(3:4), / 0,0,0,0,0,0,0/) / CLOCKTIME(1:2),CLOCKTIME(3:4) IENDCHECK=99999 CALL GMFSTW(2,0,21,5,8,'X','Y',0.,1.,0.,1.,0.,1.,0.,1.) C-----Data pro volani vnejsich programu a interpretovanych modelu CALL GMFSTW(1,1,20,1,16,'X','Y',.0,1.,0.,1.,-0.05,1.05,OPEN(1,FILE='FEMINA.CMD') 0.05,1.05) NEXCOM=0 XMI=-.05 NMODELS=0 XMA=1.05 C hodnoty IND,... maji vyznam jen jako default hodnoty pro interakci YMI=-0.05 IND=1 YMA=1.05 INDC=0 CALL GMFAXE(1,7,15) INDS=0 INDF=0 C--------------- Nekonecna smycka zpracovani PRIKAZU 2000 READ(1,'(A)',END=2001)LINE 2003 CALL TUPC(LENLIN,LINE,LINE) 51 READMA=.FALSE. IF(LINE(1:7).EQ.'\\EXTER')THEN CLOSE(4) READ(1,'(A)',END=2001)LINE DO WHILE(KEYW(1:4).NE.'EXIT') CALL TUPC(LENLIN,LINE,LINE) NEXCOM=NEXCOM+1 C Zobrazeni aktualnich informaci ve stavovem radku (UNIT=11) CALL SELITE(LINE,0,TXTV,K) INQUIRE(UNIT=1,NAME=FILESES) NEXKWD(NEXCOM)=TRIM(TXTV) IF(FILESES.NE.STATUS)THEN CALL SELITE(LINE,K,TXTV,K) STATUS=FILESES NEXFILE(NEXCOM)=TRIM(ADJUSTL(TXTV)) CLOSE(11) NPP=0 CALL WOPEN(11,STATUS//' opened', 2, 90, 0, 29, 640, 35) 2002 READ(1,'(A)',END=2001)LINE II=SETBKCOLOR(3) NPP=NPP+1 CALL CLEARSCREEN($GCLEARSCREEN) IND=INDEX(LINE,':') ENDIF IF(IND.GT.1)THEN
21
C Obsah okna 11 zavisi na ISTATUS (=1 FEM, =2 MODEL, =3 RTD) SELECT CASE(ISTATUS) CASE(1) CSTATUS FEM Seznam definovanych funkci NDEFUN=0 DO I=MIFUN,MAFUN IF(INDFUN(I).NE.0)THEN NDEFUN=MIN0(10,NDEFUN+1) LISTFUN(NDEFUN)=I IF(INDFUN(I).GT.0)THEN TLISFUN(NDEFUN)='F' ELSE TLISFUN(NDEFUN)='T' ENDIF ENDIF ENDDO C je malo mista v okne 11 - proto se voli dva ruzne formaty dle poctu DOF IF(NKIND(1).le.10)THEN WRITE(11,50)NPT,NCR,NSF,NE,ND, / (LISTFUN(I),TLISFUN(I),I=1,NDEFUN) 50 FORMAT(' NPT=',I2,' NCR=',I2,' NSF=',I2,' NE=',I4,' ND=',I4, / ' Funct: ',10(I3,'(',A1,') ')) WRITE(11,49)NGROUP,NRCONS,NMAT,time, / TANAL(KANAL),(TDOF(JKIND(1,I)),I=1,NKIND(1)) 49 FORMAT(' EG=',I2,' RC=',I2,' MP=',I2,' t=',E8.2, / ' DOF(',A3,'): ',9(A4,','),A4) ELSE WRITE(11,48)NE,ND,NGROUP,NRCONS,NMAT,TIME, / (LISTFUN(I),TLISFUN(I),I=1,NDEFUN) 48 FORMAT(' NE=',I4,' ND=',I4,' EG=',I2,' RC=',I2,' MP=',I2, / ' t=',E8.2,' Funct: ',10(I3,'(',A1,') ')) WRITE(11,47)(TDOF(JKIND(1,I)),I=1,NKIND(1)) 47 FORMAT(' DOF: ',16(A4,','),A4) ENDIF CASE(2) CSTATUS MODEL LL=MIN0(LINESRPN(2),LEN(MODTXT)) IF(LL.GT.0)THEN WRITE(11,46)NEQUAT,METHOD,NTSTEP,DTIME,NINPUTS,NOUTPUTS, / NUMODP,MODTXT(1:LL) 46 FORMAT(' Nequat.=',I3,' Method[',I2,'] N-steps=',i4,' Dt=', / E10.3,' No.inputs=',i2,' outputs=',i2,' NP=',i2/1x,a) ELSE WRITE(11,45)NTSTEP,DTIME 45 FORMAT(' N-steps=',i4,' Dt=',E10.3/' model is not defined') ENDIF CASE(3) CSTATUS RTD WRITE(11,44)NTSTEP,DTIME 44 FORMAT(' N-steps=',i4,' Dt=',E10.3) CALL SHOWTC(11) END SELECT C WINDOW 30-LIST vypis poslednich 10 radku ze souboru 9 (*.dbg)
400 403
II=FOCUSQQ(30) CALL CLEARSCREEN($GCLEARSCREEN) DO IBCK=1,NBCK INQUIRE(9,POSITION=POSIT) IF(POSIT(1:6).NE.'REWIND')THEN BACKSPACE 9 ELSE EXIT ENDIF ENDDO DO IBCK=1,NBCK READ(9,'(A)',END=400)LINE WRITE(30,'(A)')TRIM(LINE) ENDDO GOTO 403 BACKSPACE 9 CONTINUE
C Editace nebo precteni prikazoveho radku
409
II=FOCUSQQ(10) II=SETTEXTCOLOR(int2(11)) WRITE(10,'('' >''\)') II=SETTEXTCOLOR(int2(15)) II=DISPLAYCURSOR($GCURSOROFF) IF(READMA)THEN READ(4,'(A)',END=51,ERR=51)LINE SELECT CASE(LINE(1:2)) CASE ('C*') WRITE(10,'('' ['',A,'']'')')TRIM(LINE) GOTO 409 CASE ('Q*') GOTO 51 CASE ('R*') WRITE(10,'('' [Enter]-next, [F1]-repeat'')') CALL GC(CH,IEND) IF(IEND.EQ.259)THEN BACKSPACE 4 BACKSPACE 4 GOTO 409 ENDIF END SELECT WRITE(10,'('' ['',A,'']'')')TRIM(LINE) ELSE CALL GMFEDL(10,LINE,IEND) IF(IEND.NE.0)GOTO 51 ENDIF CALL PROCOM(LINE)
C Procom vygeneruje KEYW a vektory parametru IP,RP,TP C================================================ C COMMANDS SELECT CASE(KEYW) CASES CONTROL------------------------------------CASE('NEWPRO','NEW ','RESET ') WRITE(10,'('' Close old and open a new problem'')') CALL DIAP(1,'FILE',IEND) IF(IEND.EQ.0)THEN PROBLEM=TRIM(TP(1)) GOTO 1000 ENDIF CASE('FILE ') WRITE(10,'('' Interpret session file'')') CALL DIAP(1,'FILENAM',IEND) IF(IEND.EQ.0)THEN FILENAM=TRIM(TP(1)) CALL FOPEN(2,FILENAM) C Interpretace prikazu na UNIT=2. Treti parametr (.TRUE.) znamena, ze se C budou identifikovat navesti, soucasne kopirovat radky do souboru 1 (druhy C parametr) a pak teprve probehne zpracovani vsech prikazu C (vcetne cyklu). Soubor zustava otevreny a je mozne ho doplnovat. C CALL COMFIL(2,1,.TRUE.) CLOSE(2) ENDIF CASE('UNDO ') CALL DIAP(1,'UNDO ',IEND) IF(IEND.EQ.0.AND.IP(1).GE.1)THEN C UNDO se provadi tak, ze se vytvori novy session file UNIT=1 PROBLEM.SES C z nehoz je odstraneno nekolik poslednich radku, a tento soubor se necha C interpretovat, procedurou COMFIL az do konce (ale s vynechanim navesti). DO I=1,IP(1) INQUIRE(1,POSITION=POSIT) IF(POSIT(1:6).NE.'REWIND')THEN BACKSPACE 1 ELSE EXIT ENDIF ENDDO ENDFILE 1 REWIND 1 CALL INIT C Protoze je treti parametr false, nekopiruji se radky do session filu, C ani se neuvazuji prikazy cyklu apod (rezim READFI=.false.) CALL COMFIL(1,1,.FALSE.) ENDIF CASE('MACRO ') WRITE(10,'('' Interpret macro file'')') CALL DIAP(1,'FILENAM',IEND) IF(IEND.EQ.0)THEN FILENAM=TRIM(TP(1)) CALL FOPEN(4,FILENAM) READMA=.TRUE. ENDIF CASE('RECORD') WRITE(10,'('' Following commands will be saved into a file, u /ntill ENDREC'')') CALL DIAP(1,'FILENAM',IEND) IF(IEND.EQ.0)THEN FILENAM=TRIM(TP(1)) CALL FOPEN(8,FILENAM) RECORD=.TRUE. ENDIF CASE('ENDREC') CLOSE(8) RECORD=.FALSE. CASE('#GOTO ') CALL WRITEL('#GOTO') CASE('#LABEL') CALL WRITEL('#LABEL') CASE('#LOOP ') CALL WRITEL('#LOOP') CASE('#IF ') CALL WRITEL('#IF') CASE('#ELSE ') CALL WRITEL('#ELSE') CASE('#ENDIF') CALL WRITEL('#ENDIF') CASE('U ') CONTROL UP n-lines CALL DIAP(1,'LINE',IEND) IF(IEND.EQ.0)THEN DO I=1,IP(1) INQUIRE(9,POSITION=POSIT) IF(POSIT(1:6).NE.'REWIND')THEN BACKSPACE 9 ELSE EXIT ENDIF ENDDO ENDIF CASE('PU ') CONTROL PAGE UP DO I=1,NBCK-1 INQUIRE(9,POSITION=POSIT) IF(POSIT(1:6).NE.'REWIND')THEN BACKSPACE 9
22
ELSE EXIT ENDIF ENDDO CASE('D ') CONTROL DOWN n-lines CALL DIAP(1,'LINE',IEND) IF(IEND.EQ.0)THEN CGEOM DO I=1,IP(1) READ(9,*,END=401) ENDDO GOTO 402 401 BACKSPACE 9 402 CONTINUE ENDIF CASE('PD ') CONTROL PAGE DOWN DO I=1,NBCK-1 READ(9,*,END=405) ENDDO GOTO 406 405 BACKSPACE 9 406 CONTINUE CASE('REM ') WRITE(9,'(10(1X,A))')(TRIM(TP(I)),I=1,LAST) CASE('HELP ') II=FOCUSQQ(40) II=SETBKCOLOR(3) CALL CLEARSCREEN($GCLEARSCREEN) CALL HELP CASE('STATUS') CALL DIAP(1,'STATUS',IEND) IF(IEND.EQ.0)ISTATUS=IP(1) CASE('LOC ') CONTROL LLL - pozice promenne TP(1), JJJ - typ (1-real, 2-integer) CALL LOVARI(ICRPN,NCRPN,LLL,JJJ) IF(JJJ.EQ.1)THEN WRITE(9,'(1X,A,'' position='',i10,'' value='',e10.3)') / TRIM(TP(1)),LLL,REALRC(LLL) ELSEIF(JJJ.EQ.2)THEN CGEOM WRITE(9,'(1X,A,'' position='',i10,'' value='',I10)') / TRIM(TP(1)),LLL,INTERC(LLL) ELSE WRITE(9,'(1X,A,'' is not a correct expression'')') / TRIM(TP(1)) ENDIF IF(JJJ.GT.0)THEN CALL FEMHELP(LLL,TXTV,IENDH) IF(IENDH.GT.0)WRITE(9,'('' :'',A)')TRIM(TXTV) ENDIF CASE('BKCOLO') CALL DIAP(0,'ANALYS',IEND) IF(IEND.EQ.0)II=SETBKCOLOR(IP(1)) CASE('ANALYS','ACTMSH','ANAL ','AN ') CALL DIAP(0,'ANALYS',IEND) CALL WRITEL('ANALYS') CASE('ACTNUM') CALL DIAP(0,'ACTNUM',IEND) IF(IEND.EQ.0.AND.IP(1).GE.1.AND.IP(1).LE.5)IACT(IP(1)+3)=1 CASE('INACTN') CALL DIAP(0,'ACTNUM',IEND)
CASE('MPROP ','MP ') CALL DIAP(MIN0(MAXMAT,NMAT+1),'MPROP',IEND) IF(IEND.EQ.0) CALL WRITEL('MPROP') CASE('EGROUP','EG ') CALL DIAP(MIN0(MAXGR,NGROUP+1),'EGROUP',IEND) IF(IEND.EQ.0) CALL WRITEL('EGROUP') CASE('RCONST','RC ') CALL DIAP(MIN0(MAXRC,NRCONS+1),'RCONST',IEND) IF(IEND.EQ.0) CALL WRITEL('RCONST') CASE('FUNDEF','FDEF ','FD ','DF ') CALL DIAP(INDF+1,'FUNDEF',IEND) INDF=IP(1) IF(IEND.EQ.0) CALL WRITEL('FUNDEF') CASE('CURDEF','CDEF ','CD ','DC ','TABLE ','TAB CALL DIAP(INDF+1,'CURDEF',IEND) INDF=IP(1) IF(IEND.EQ.0) CALL WRITEL('CURDEF')
CASES GEOM---------------------------------------
CGEOM
200
C
200
DEFAULT Z-SOURADNICE CASE('ZD ','ZDEF ') CALL DIAP(0,'ZDEF',IEND) IF(IEND.EQ.0) CALL WRITEL('ZDEF') definice bodu a uzlu lokatorem CASE('PT ') CALL DIAP(NPT+1,'PT',IEND) IF(IEND.EQ.0)THEN IND=IP(1) II=SETACTIVEQQ(20) CALL GMFSW(1) IF(IND.GT.0)THEN IF(LAST.LT.2)THEN PX=XMI PY=YMI KBD=1 DO WHILE(KBD.EQ.1.AND.IND.LE.MAXPT) II=FOCUSQQ(20) CALL GMFLCQ(-1,PX,PY,PX,PY,KBD) IF(KBD.EQ.1)THEN IF(GRIDON)THEN PX=GRIDX0+INT((PX-GRIDX0)/GRIDX+.5)*GRIDX PY=GRIDY0+INT((PY-GRIDY0)/GRIDY+.5)*GRIDY ENDIF TEST KOINCIDENCE TOL2=TOL**2 DO I=1,NPT IF((PX-PTX(I))**2+(PY-PTY(I))**2.LE.TOL2)GOTO ENDDO WRITE(TP(1),'(I4)')IND WRITE(TP(2),'(E10.3)')PX WRITE(TP(3),'(E10.3)')PY CALL WRITEL('PT') IND=IND+1 ENDIF ENDDO
--------------------definice krivek a ploch CASE('CR2PT ','C2P ') CALL DIAP(NCR+1,'CR2PT',IEND) IF(IEND.EQ.0) CALL WRITEL('CR2PT') CASE('CR3PT ','C3P ') CALL DIAP(NCR+1,'CR3PT',IEND) IF(IEND.EQ.0) CALL WRITEL('CR3PT') CASE('CIRCLE','CIR ') CALL DIAP(NCR+1,'CIRCLE',IEND) IF(IEND.EQ.0) CALL WRITEL('CIRCLE') CASE('SF4PT ','S4P ') CALL DIAP(NSF+1,'SF4PT',IEND) IF(IEND.EQ.0) CALL WRITEL('SF4PT') CASE('SF8PT ','S8P ') CALL DIAP(NSF+1,'SF8PT',IEND) IF(IEND.EQ.0) CALL WRITEL('SF8PT') CASE('SFCR ') CALL DIAP(NSF+1,'SFCR',IEND) IF(IEND.EQ.0) CALL WRITEL('SFCR')
CASES GROUP -------------------------------------
IF(IEND.EQ.0.AND.IP(1).GE.1.AND.IP(1).LE.5)IACT(IP(1)+3)=0 CASE('ACTSET') CALL DIAP(0,'ACTSET',IEND) IF(IEND.EQ.0)CALL WRITEL('ACTSET')
CGEOM
ELSE CALL WRITEL('PT') ENDIF PT$=1 ENDIF ENDIF CASE('ND ') ND KIND,X,Y CALL DIAP(1,'ND',IEND) KIND=IP(1) IF(IEND.EQ.0.AND.KIND.GE.1.AND.KIND.LE.3)THEN IND=MIN0(ND+1,MAXND) II=SETACTIVEQQ(20) CALL GMFSW(1) IF(LAST.LT.2)THEN PX=XMI PY=YMI KBD=1 DO WHILE(KBD.EQ.1.AND.IND.LE.MAXND) II=FOCUSQQ(20) CALL GMFLCQ(-1,PX,PY,PX,PY,KBD) IF(KBD.EQ.1)THEN IF(GRIDON)THEN PX=GRIDX0+INT((PX-GRIDX0)/GRIDX+.5)*GRIDX PY=GRIDY0+INT((PY-GRIDY0)/GRIDY+.5)*GRIDY ENDIF WRITE(TP(1),'(I4)')KIND WRITE(TP(2),'(E10.3)')PX WRITE(TP(3),'(E10.3)')PY CALL WRITEL('ND') IND=IND+1 ENDIF ENDDO ELSE CALL WRITEL('ND') ENDIF ND$=1 ENDIF
')
CASES MESH -------------------------------------CMESH
CMESH CMESH
CASE('E ') E no.of nodes, n1,n2,.. CALL DIAP(4,'E',IEND) IF(IEND.EQ.0) CALL WRITEL('E') CASE('MSF ') CALL DIAP(MIN0(NSF,INDS+1),'MSF',IEND) INDS=IP(1) IF(IEND.EQ.0) CALL WRITEL('MSF') CASE('MCR ','MCRC ') CALL DIAP(MIN0(NCR,INDC+1),KEYW,IEND) INDC=IP(1) IF(IEND.EQ.0) CALL WRITEL(KEYW) CASE('MCR2 ','MCRHEX','MHEX ') ELEMENTY TYPU VYMENIK MCR2 IC1,IC2,NX,MP1,MP2,RC1,RC2,RCHEX CALL DIAP(MIN0(NCR,INDC+1),'MCR2',IEND) INDC=IP(1) IF(IEND.EQ.0) CALL WRITEL('MCR2') CASE('NMERGE','NM ') CALL WRITEL('NMERGE')
CASES FORCES, INITIAL---------------------------CASE('NFCR ','FCR ') CALL DIAP(MIN0(NCR,INDC),'NFCR',IEND) INDC=IP(1)
23
IF(IEND.EQ.0) CALL WRITEL('NFCR') CASE('NFSF ','FSF ') CALL DIAP(MIN0(NSF,INDS),'NFSF',IEND) INDS=IP(1) IF(IEND.EQ.0) CALL WRITEL('NFSF') CASE('NF ','F ','FN ','NDF ') CALL DIAP(MIN0(ND,IND),'NF',IEND) IF(IEND.EQ.0) CALL WRITEL('NF') CASE('NFPT ','FPT ','FP ','PF ','PTF CALL DIAP(MIN0(NPT,IND),'NFPT',IEND) IF(IEND.EQ.0) CALL WRITEL('NFPT') CASE('INITIA','INI ') CALL DIAP(IFUN,'INITIA',IEND) IF(IEND.EQ.0) CALL WRITEL('INITIA') CASE('MOFE ') CALL DIAP(1,'MOFE',IEND) IF(IEND.EQ.0) CALL WRITEL('MOFE')
')
CASES FEM analyzy--------------------------------
/
/ /
CASE('APIPEQ','APIPE ','A_PIPE','A_P ') CALL DIAP(1,'APIPE',IEND) IF(IEND.EQ.0) CALL WRITEL('APIPEQ') CASE('PIPEQ ','PIPEC ','PIPE ','R_PIPE','R_P 'HEXC ','RTD ') CALL DIAP(1,'THERMA',IEND) IF(IEND.EQ.0) CALL WRITEL(KEYW) CASE('ATRANE','A_TRAN','A_T ') CALL DIAP(1,'ATRANE',IEND) IF(IEND.EQ.0) CALL WRITEL('ATRANE') CASE('TRANEQ','TRANEC','R_TRAN','R_T ', 'THERMA','CONTHE','ELEC ','CONC ','UVPP 'UVP ','PSOM ','PSIN ','PENS ','THER CALL DIAP(1,'THERMA',IEND) IF(IEND.EQ.0) CALL WRITEL(KEYW) CASE('CREEP ','CREE ') CALL WRITEL('CREEP') CASE('MIKE ') CALL WRITEL('MIKE') CASE('MIDE ') CALL WRITEL('MIDE') CASE('SHELLA','SHEL ') CALL WRITEL('SHELLA') CASE('TRUSS ','TRUS ') CALL DIAP(1000,'TRUSS ',IEND) IF(IEND.EQ.0) CALL WRITEL('TRUSS') CASE('PLANE2','PLAN ') CALL WRITEL('PLANE2')
',
', ')
CASES MODEL-------------------------------------CASE('TIMES ','TSTEP ') CALL DIAP(1,'TSTEP ',IEND) IF(IEND.EQ.0)CALL WRITEL('TSTEP ') CASE('RMODEL','RM ') CALL DIAP(1,'RMODEL',IEND) IF(IEND.EQ.0)THEN CALL WRITEL('RMODEL') ISTATUS=2 ENDIF CASE('PARLIM','PARL ') CALL DIAP(1,'PARLIM',IEND) IF(IEND.EQ.0)CALL WRITEL('PARLIM') CASE('PARSET','PARS ') CALL DIAP(1,'PARSET',IEND) IF(IEND.EQ.0)CALL WRITEL('PARSET') CASE('METHOD','MET ') CALL DIAP(1,'METHOD',IEND) IF(IEND.EQ.0)CALL WRITEL('METHOD') CASE('INPUT ','INP ') CALL DIAP(1,'INPUT',IEND) IF(IEND.EQ.0)CALL WRITEL('INPUT ') CASE('OUTPUT','OUT ') CALL DIAP(1,'OUTPUT',IEND) IF(IEND.EQ.0)CALL WRITEL('OUTPUT') CASE('INIMOD','IMOD ','IM ') CALL WRITEL('INIMOD') CASE('CONVOL','CON ') CALL DIAP(1,'METHOD',IEND) IF(IEND.EQ.0)CALL WRITEL('CONVOL') CASE('IMPULS','IMP ') CALL DIAP(1,'METHOD',IEND) IF(IEND.EQ.0)CALL WRITEL('IMPULS') CASES RTD---------------------------------------CASE('COMPAR','TCOMP ','TCOM ') CALL DIAP(1,'COMPAR',IEND) IF(IEND.EQ.0)CALL WRITEL('COMPAR') CASE('CRITER','TCRIT ','TCRI ') CALL DIAP(1,'CRITER',IEND) IF(IEND.EQ.0)CALL WRITEL('CRITER') CASE('TCDEV ','TCF ') CALL WRITEL('TCDEV ') WRITE(10,'('' Calculated deviation='',e12.5)')SCOMPAR CASE('COPYTO','COTO ','TCO ') CALL DIAP(1,'COPYTO',IEND) IF(IEND.EQ.0)CALL WRITEL('COPYTO') CASE('MOMENT','MOM','TCLIST','TCL ') CALL DIAP(1,'MOMENT',IEND) IF(IEND.EQ.0)CALL WRITEL('MOMENT') CASE('NORM ','NOR ') CALL DIAP(1,'NORM',IEND) IF(IEND.EQ.0)CALL WRITEL('NORM ') CASE('IDMSER','IDM ') CALL DIAP(1,'IDMSER',IEND) IF(IEND.EQ.0)CALL WRITEL('IDMSER')
CASE('PASERI','PAS ') CALL DIAP(1,'PASERI',IEND) IF(IEND.EQ.0)CALL WRITEL('PASERI') CASE('SMOOTH','SM ','TCSMOO','TCS ') CALL DIAP(1,'SMOOTH',IEND) IF(IEND.EQ.0)THEN IG=IP(1) IF(IG.GT.0.AND.IG.LE.MAXSEL)THEN IF(LAST.LT.5)THEN WRITE(10,'('' Identify first point by mouse (L-
click /confirms, R-click quit)'')') CALL UIDENT(N1,IG,KBD) IF(KBD.EQ.1)THEN WRITE(10,'('' Identify END point by mouse (Lclick /confirms, R-click quit)'')') CALL UIDENT(N2,IG,KBD) IF(KBD.EQ.1)THEN WRITE(TP(4),'(I4)')N1 WRITE(TP(5),'(I4)')N2 CALL WRITEL('SMOOTH') ENDIF ENDIF ELSE CALL WRITEL('SMOOTH') ENDIF ENDIF ENDIF CASE('TAIL ') CALL DIAP(0,'TAIL',IEND) C IG ID IMETH IF(IEND.EQ.0)THEN IG=IP(1) IF(IG.GT.0.AND.IG.LE.MAXSEL)THEN IF(LAST.LT.6)THEN WRITE(10,'('' Identify regression range: Pick FIRST /point by mouse (L-click confirms, R-click quit)'')') CALL UIDENT(N1,IG,KBD) IF(KBD.EQ.1)THEN WRITE(10,'('' Pick END point by mouse (L-click conf /irms, R-click quit)'')') CALL UIDENT(N2,IG,KBD) IF(KBD.EQ.1)THEN WRITE(10,'('' Pick a point where the tail begins / by mouse (L-click confirs, R-click quit)'')') CALL UIDENT(N3,IG,KBD) IF(KBD.EQ.1)THEN WRITE(TP(4),'(I4)')N1 WRITE(TP(5),'(I4)')N2 WRITE(TP(6),'(I4)')N3 CALL WRITEL('TAIL ') ENDIF ENDIF ENDIF ELSE CALL WRITEL('TAIL ') ENDIF ENDIF ENDIF CASE('TCBGR ','BGR ') CALL DIAP(1,'TCBGR',IEND) IF(IEND.EQ.0)CALL WRITEL('TCBGR ') CASE('TCRND ','RND ') CALL DIAP(1,'TCRND',IEND) IF(IEND.EQ.0)CALL WRITEL('TCRND ') CASE('TCLIP ','CLIP ') CALL DIAP(1,'TCLIP',IEND) IF(IEND.EQ.0)CALL WRITEL('TCLIP ') CASE('TCYSHF') CALL DIAP(1,'TCYSHF',IEND) IF(IEND.EQ.0)CALL WRITEL('TCYSHF') CASES WRITE/READ--------------------------------CASE('LOADT ','LT ') CALL DIAP(1,'LOADT',IEND) IF(IEND.EQ.0)THEN TIME=RP(1) REWIND(3) READ(3,*,END=51) READ(3,*,END=51,ERR=51)TTT READ(3,*,END=51) DO WHILE(TTT.LT.TIME) DO I=1,ND READ(3,*,END=51) ENDDO READ(3,*,END=51,ERR=51)TTT WRITE(*,'('' TIME='',F10.2)')TTT READ(3,*,END=51) ENDDO WRITE(*,*)' LOADING DATA FROM TIME=',TTT DO I=1,ND LOC=LPU(I) READ(3,*,END=51,ERR=51)IDUM,(VAL(LOC+J,3),J=1,MPU(I)) ENDDO ENDIF CASE('WRITE ','W ') CALL DIAP(1,'WRITE',IEND) CWRITE [ 1-Nod,2-Ele,...] PROBLEM IF(IEND.EQ.0)THEN PROBLEM=TP(2)
24
SELECT CASE(IP(1)) CASE(1) CWRITE Souradnice uzlu a Uzlove parametry OPEN(3,FILE=TRIM(PROBLEM)//'.NOD') CALL WRNOD(3) CASE(2) CWRITE Matice konektivity OPEN(3,FILE=TRIM(PROBLEM)//'.ELE') CALL WRELE(3) CASE(3) CWRITE EGROUPS, RCONST, MPROP, FUNCTIONS OPEN(3,FILE=TRIM(PROBLEM)//'.GRP') WRITE(3,133)PROBLEM,TANAL(KANAL),NGROUP,NRCONS,NMAT 133 FORMAT(1X,A,5X,A/3I5,' (Number of E-groups, RConst, MP)') WRITE(3,134) (TEG(LGROUP(J)),J=1,MPEG) 134 FORMAT(/' E-group ',20(X,A)) DO I=1,NGROUP WRITE(3,135)I,(JGROUP(I,LGROUP(J)),J=1,MPEG) 135 FORMAT(I8,X,20I5) ENDDO WRITE(3,136) (TRC(LRCONS(J)),J=1,MPRC) 136 FORMAT(/' RC-group ',10(6X,A)) DO I=1,NRCONS WRITE(3,137)I,(RCONST(I,LRCONS(J)),J=1,MPRC) 137 FORMAT(I8,2X,10E10.3) ENDDO WRITE(3,138) (TMAT(LRMAT(J)),J=1,MPMP) 138 FORMAT(/' MP-group ',10(6X,A)) DO I=1,NMAT WRITE(3,139)I,(RMAT(I,LRMAT(J)),J=1,MPMP) 139 FORMAT(I8,2X,10E10.3) WRITE(3,140)(JMAT(I,LRMAT(J)),J=1,MPMP) 140 FORMAT(8X,10I10) ENDDO CWRITE List of functions and tables WRITE(3,'(/'' Index_RPN_Function'')') DO J=MIFUN,MAFUN IFF=INDFUN(J) IF(IFF.GT.0)THEN WRITE(3,'(I6.2,I6.3,'' : '',A)') / J,MRPN(IFF),FUNTXT(IFF) ELSEIF(IFF.LT.0)THEN WRITE(3,'(I6.2,I6.3,'' table'')')J,MTPT(-IFF) ENDIF ENDDO CASE(4) CWRITE EPAR / parametry elementu jako vysledek postprocessingu OPEN(3,FILE=TRIM(PROBLEM)//'.EPA') WRITE(3,'(/'' Auxilliary parameters of elements'')') WRITE(3,'(/'' Index '',5(A4,6X))')(LEPA(I,JEPA),I=1,5) DO I=1,NE WRITE(3,'(I6,5E10.3,2i10)')I, /(EPAR(I,J),J=1,MAXEPA-2),(IEPAR(I,J),J=MAXEPA-1,MAXEPA) ENDDO CASE(5) CWRITE ALL OPEN(3,FILE=TRIM(PROBLEM)//'.DBS') NZER=0 NONE=0 RONE=0. DO I=1,LOCPROBLEM-4 CALL FEMHELP(I,TXTV,IENDH) IF(IENDH.GT.0) / WRITE(3,'(''LOC ('',I9,'') '',A)')I,TRIM(TXTV) INTRC=INTERC(I) REARC=REALRC(I) IF(IABS(INTRC).LE.10000000)THEN CWRITE INTEGER?? RONE=RONE+1. IF(INTRC.EQ.NONE)THEN NZER=NZER+1 IF(NZER.LE.6)THEN WRITE(3,'(I14,I10)')I,INTRC ELSEIF(NZER.EQ.7)THEN WRITE(3,'('' ... '')') ENDIF ELSE NZER=0 NONE=INTRC WRITE(3,'(I14,I10)')I,INTRC ENDIF ELSE CWRITE REAL?? NONE=NONE+1 IF(REARC.EQ.RONE)THEN NZER=NZER+1 IF(NZER.LE.4)THEN WRITE(3,'(I14,E10.3)')I,REARC ELSEIF(NZER.EQ.5)THEN WRITE(3,'('' ... '')') ENDIF ELSE NZER=0 RONE=REARC WRITE(3,'(I14,E10.3)')I,REARC ENDIF ENDIF ENDDO CASE(6) CWRITE C(t) OPEN(3,FILE=TRIM(PROBLEM)//'.TC') WRITE(3,'(/'' Time curves'')') DO I=1,MAXSEL IF(NGR(I).GT.0)THEN SELECT CASE(IQGR(I)) CASE(1)
WRITE(3,'(/I3,'' node'',I7)')I,INDG(I) CASE(2) WRITE(3,'(/I3,'' '',A)')I,FILEXPERI(I) CASE(3) WRITE(3,'(/I3,'' CASE(4) WRITE(3,'(/I3,'' CASE DEFAULT WRITE(3,'(/I3,'' END SELECT CALL WRTC(3,I) ENDIF ENDDO END SELECT CLOSE(3) ENDIF
Time history in Experiment.data Stimulus function'',I3)')I,INDG(I) Response function'',I3)')I,INDG(I) Undefined meaning'')')I
CASE('WRITEB','WB ') WRITE(10,'('' Writing database to a file.BIN'')') CALL DIAP(1,'FILEBIN',IEND) IF(IEND.EQ.0)CALL WRITEL('WRITEB') CASE('READBI','READB ','RB ') WRITE(10,'('' Reading database from a binary file.BIN'')') CALL DIAP(1,'FILE',IEND) IF(IEND.EQ.0)CALL WRITEL('READB ')
CREAD
CREAD CREAD CREAD CREAD CREAD CREAD
CASE('READ ','R ','RTC ','RNOD ') CALL DIAP(6,'READ',IEND) FILE, 1-Nod,2-Ele,3-Grp,4-Epa,5-Dbs,6-Tc IF(IEND.EQ.0)THEN FILEDAT=TP(2) CALL FOPEN(3,FILEDAT) SELECT CASE(IP(1)) CASE(1) Souradnice uzlu a uzlove parametry CALL RENOD(3) CASE(2) Matice konektivity CALL RELE(3) CASE(3) Funkce apod. CASE(4) Parametry elementu CASE(5) Cela databaze CASE(6) t-c KRIVKA CALL DIAP(1,'READTC',IEND) IF(IEND.EQ.0.AND.IP(3).GT.0.AND.IP(3).LE.MAXSEL)THEN CALL RETC(3,IP(3)) IGRAF=IP(3) FILEXPERI(IGRAF)=FILEDAT IQGR(IGRAF)=2 CALL GRAFTC(1,IGRAF) CALL GMFSW(1) ENDIF ENDSELECT CLOSE(3) ENDIF
CASES PLISTS------------------------------------CASE('MPLIST','MPL ') CALL DIAP(NMAT,'FLI',IEND) IF(IEND.EQ.0.AND.IP(2).LE.NMAT.AND.IP(1).GE.1)THEN WRITE(9,'('' MPROP_[FUNCTION]_VALUE'')') DO I=IP(1),IP(2),IP(3) DO J=1,MPMP WRITE(9,'(1X,I4.3,2X,''_____['',I3.3,'']_____'',A4,''='',E10.3)') / I,JMAT(I,LRMAT(J)),TMAT(LRMAT(J)),RMAT(I,LRMAT(J)) ENDDO ENDDO ENDIF CASE('RCLIST','RCL ') CALL DIAP(NRCONS,'FLI',IEND) IF(IEND.EQ.0.AND.IP(2).LE.NRCONS.AND.IP(1).GE.1)THEN WRITE(9,'('' RC___VALUE'')') DO I=IP(1),IP(2),IP(3) DO J=1,MPRC WRITE(9,'(1X,I4.3,2X,A4,''='',E10.3)') / I,TRC(LRCONS(J)),RCONST(I,LRCONS(J)) ENDDO ENDDO ENDIF CASE('EGLIST','EGL ') CALL DIAP(NGROUP,'FLI',IEND) IF(IEND.EQ.0.AND.IP(2).LE.NGROUP.AND.IP(1).GE.1)THEN NN=MIN0(3,MPEG) WRITE(9,'(/'' EG__'',3(A4,''____''))')(TEG(LGROUP(I)),I=1,NN) DO I=IP(1),IP(2),IP(3) WRITE(9,'(I4.3,'':'',3I10.2)') / I,(JGROUP(I,LGROUP(J)),J=1,NN) ENDDO ENDIF CASE('ELIST ','EL ') CALL DIAP(NE,'FLI',IEND) IF(IEND.EQ.0)THEN WRITE(9,'(/'' EL EG RC MP ND1 ND2 ND3 ND4 ND5 ND6 ND7'')') DO IE=IP(1),IP(2),IP(3)
25
NUE=MUE(IE) L0=LUE(IE) WRITE(9,'(I5.3,'':'',3I3,3X,9I5.3)')IE,IGROUP(IE), / IRCONS(IE),IMAT(IE),(IUE(L0+K),K=1,NUE) ENDDO ENDIF CASE('EPLIST','EPL ') CALL DIAP(NE,'EPLIST',IEND) IF(IEND.EQ.0.AND.IP(4).GE.1.AND.IP(4).LE.MAXEPA)THEN WRITE(9,'(/'' EL_____'',A8)')LEPA(IP(4),JEPA) DO IE=IP(1),IP(2),IP(3) WRITE(9,'(I6.3,'':'',E10.3)')IE,EPAR(IE,IP(4)) ENDDO ENDIF CASE('NDLIST','NDL ') C Vypisuje se jen jeden specifikovany uzlove parametry C NDL first,last,increment,dof CALL DIAP(ND,'NFPLOT',IEND) IF(IEND.EQ.0)THEN JDDOF=MAX0(1,IP(4)) WRITE(9,'(/'' ND_____X______Y______'',A4,''1__'',A4, /''2__STATUS'')') / TDOF(JDDOF),TDOF(JDDOF) DO J=IP(1),IP(2),IP(3) LOC=LPU(J) IND=0 DO I1=1,MPU(J) IF(JPU(LOC+I1).EQ.JDDOF)IND=LOC+I1 ENDDO IF(IND.LE.0)THEN WRITE(9,'('' Parameter '',A,'' not DOF'')')TDOF(JDDOF) IND=LOC+1 ENDIF WRITE(9,'(I5.3,'':'',2E9.2,2E10.3,3X,I4.2)') / J,XX(J),YY(J),VAL(IND,1),VAL(IND,2),IPU(IND) ENDDO ENDIF CASE('PTLIST','PTL ') CALL DIAP(NPT,'FLI',IEND) IF(IEND.EQ.0)THEN WRITE(9,'(/'' PT_____X_______Y________Z'')') DO J=IP(1),IP(2),IP(3) WRITE(9,'(I4.3,'':'',3E9.2)')J,PTX(J),PTY(J),PTZ(J) ENDDO ENDIF CASE('SFLIST','SFL ') CALL DIAP(NSF,'FLI',IEND) IF(IEND.EQ.0)THEN WRITE(9,'(/'' SF PT1 PT2 PT3 PT4 pt5 pt6 pt7 pt8'')') DO J=IP(1),IP(2),IP(3) WRITE(9,'(I4.3,'':'',T7,8I5.2)')J,(ISF(K,J),K=1,MSF(J)) ENDDO ENDIF CASE('CRLIST','CRL ') CALL DIAP(NCR,'FLI',IEND) IF(IEND.EQ.0)THEN WRITE(9,'(/'' LINE PT1 PT2 pt3'')') DO J=IP(1),IP(2),IP(3) WRITE(9,'(I4.3,'':'',3I5.2)')J,(ICR(K,J),K=1,MCR(J)) ENDDO ENDIF CASE('NFLIST','NFL ') CALL DIAP(ND,'FLI',IEND) IF(IEND.EQ.0)THEN WRITE(9,'(/'' ND_PAR__FUN__VALUE(B.C.)'')') DO J=IP(1),IP(2),IP(3) LOC=LPU(J) DO K=1,MPU(J) IF(IPU(LOC+K).NE.0) / WRITE(9,'(I4.3,1X,A4,I5.2,'':'',E10.3)') / J,TDOF(JPU(LOC+K)),IPU(LOC+K),VAL(LOC+K,1) ENDDO ENDDO ENDIF CASE('DOFLIS','DOFL ','RANGE ') CALL DIAP(IZONE,'DOFLIS',IEND) IF(IEND.EQ.0.AND.IP(1).GT.0.AND.IP(1).LE.4)THEN IZONE=IP(1) CALL RANGE(IZONE) WRITE(9,'(/'' VARIABLE MIN MAX zone '',I2)')IZONE DO I=1,MAXTDOF IF(DOFMIN(I).LT.DOFMAX(I))WRITE(9,'(1X,A4,'':'',2E10.3)') / TDOF(I),DOFMIN(I),DOFMAX(I) ENDDO ENDIF CASE('CURLIS','CURL ') WRITE(9,'(/'' Index_Typ_NPT'')') DO J=MIFUN,MAFUN IF(INDFUN(J).LT.0)THEN IFF=-INDFUN(J) WRITE(9,'(3I6.2)')J,KTABLE(IFF),MTPT(IFF) WRITE(9,'('' point_____X______Y'')') WRITE(9,'(I5.2,2E10.3)') / (I,XTAB(I,IFF),YTAB(I,IFF),I=1,MTPT(IFF)) ENDIF ENDDO CASE('FUNLIS','FUNL ') WRITE(9,'(/'' Index_RPN_Function'')') DO J=MIFUN,MAFUN IFF=INDFUN(J) IF(IFF.GT.0)THEN WRITE(9,'(I6.2,I6.3,'' : '',A)') / J,MRPN(IFF),FUNTXT(IFF)
ELSEIF(IFF.LT.0)THEN WRITE(9,'(I6.2,I6.3,'' table'')')J,MTPT(-IFF) ENDIF ENDDO CASE('CLIST ','CL ','SETTIN') WRITE(9,'(/'' SETTINGS'')') IF(IALGOR(1).NE.0)THEN WRITE(9,'('' Mass matrix enabled'')') ELSE WRITE(9,'('' Mass matrix disabled'')') ENDIF IF(IALGOR(2).NE.0)THEN WRITE(9,'('' Convection enabled (VELO>0)'')') ELSE WRITE(9,'('' Convection disabled (VELO=0)'')') ENDIF IF(IALGOR(3).NE.0)THEN WRITE(9,'('' Natural convection (BUOY) enabled Gx='', /f8.2,'' Gy='',f8.2)')GX,GY ELSE WRITE(9,'('' Natural convection (BUOY=0) disabled'')') ENDIF IF(IALGOR(4).NE.0)THEN WRITE(9,'('' Ohmic heating enabled (OHMI>0)'')') ELSE WRITE(9,'('' Ohmic heating disabled (OHMI=0)'')') ENDIF IF(IALGOR(5).NE.0)THEN WRITE(9,'('' Upwind enabled Correct='',f8.2)')RUPW ELSE WRITE(9,'('' Upwind disabled (UPW=0)'')') ENDIF NOPER=0 DO I=1,MAXOPER IF(IALGOR(I+10).NE.0.AND.NOPER.LT.MAXLIST)THEN NOPER=NOPER+1 LISALG(NOPER)=I ENDIF ENDDO WRITE(9,'('' Operations: '',8(A4,'',''))') / (LALG(LISALG(I)),I=1,NOPER) CASE('VARLIS','VARL ') CALL DIAP(1,'VARL',IEND) IF(IEND.EQ.0.AND.IP(1).EQ.0)THEN WRITE(9,'(/'' NAME[1-Real,2-Int,3-Real vect,4-Int vect,5-F /un]''/)') WRITE(9,'('' System variables='',i3/(4(5X,A,''['',I1,'']'' /)))') NVARSYS,(TRIM(NAME(I)),IATTR(2,I),I=1,NVARSYS) IF(NVARTOT.GT.NVARSYS) / WRITE(9,'('' User variables='',i3/(4(5X,A,''['',I1,''] /'')))') / NVARTOT-NVARSYS, / (TRIM(NAME(I)),IATTR(2,I),I=NVARSYS+1,NVARTOT) WRITE(9,'('' -----------use LOC variable for more deta /ils'')') ELSEIF(IEND.EQ.0)THEN WRITE(9,'(/'' Important items in /FEM/ '')') CALL SORTNUM(NVARSYS,IATTR,NSORT) DO II=1,NVARSYS CALL VARHELP(NSORT(II),TXTV,LOC) WRITE(9,'(I10,1X,A)')LOC,TRIM(TXTV) IF(LOC.GT.0)THEN CALL FEMHELP(LOC,TXTV,IENDH) IF(IENDH.EQ.1)WRITE(9,'('' :'',A)')TRIM(TXTV) ENDIF ENDDO ENDIF CASE('MODLIS','MODL ','ML ') CALL MODLIST CASES GRAF--------------------------------------INCLUDE '$S-GRAF' CASE('EXIT ') WRITE(10,'(1X,''Do you want to reformat your hard disc?'')') CASE DEFAULT C Neznamy prikaz je automaticky zapsan do session filu C nejprve zjisteni zda nejde o jmeno vnejsiho programu EXPROG=.FALSE. DO I=1,NEXCOM IF(KEYW(1:4).EQ.NEXKWD(I))THEN CALL DIAP(1,NEXKWD(I),IEND) IF(IEND.EQ.0)THEN CALL WRITEL(NEXKWD(I)) EXPROG=.TRUE. EXIT ENDIF ENDIF ENDDO IF(.NOT.EXPROG)THEN CALL PROITE(1,LINE,IEND) IF(IEND.LT.0.AND. / LINE(1:2).NE.'C*'.AND. / LINE(1:2).NE.'Q*'.AND. / LINE(1:2).NE.'R*')THEN C DOSOVSKY prikaz RESULT=.FALSE. IF(LINE(1:1).EQ.':'.OR. / LINE(1:1).EQ.'/'.OR.LINE(1:1).EQ.'\') / RESULT=SYSTEMQQ(LINE(2:))
26
command'')')KEYW
IF(.NOT.RESULT)THEN WRITE(10,'(1X,A,'' unrecognized
CALL HELPC(KEYW) ENDIF ELSE WRITE(1,'(A)')TRIM(LINE) IF(RECORD)THEN WRITE(8,'(A)')TRIM(LINE) INQUIRE(UNIT=8,NAME=FILENAM)
INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE
WRITE(10,'('' Recording ['',A,''] into file '',A)') /
ENDIF ENDIF ENDIF ENDSELECT ENDDO END
TRIM(LINE),FILENAM
'$S0-DIAL' '$S1-PLOT' '$S2-INIT' '$S3-COMM' '$S4-KLOC' '$S5-KLOC' '$S6-KLOC' '$S7-KLOC' '$S8-KLOC' '$S9-KLOC' '$S10-AUX' '$S11-MOD' '$O-MAIN' '$O-WREAD' '$BLOCKD'
27
C $S0-DIAL SUBROUTINE DIAP(IDEF,ICOM,IEND) C DIALOG - DOPLNENI PARAMETRU NEZADANYCH V PRIKAZOVEM RADKU C NCMAX - POCET PRIKAZU, NPMAX - POCET POLOZEK USE MSFLIB INCLUDE '$FEMLOC' C PD -default par, PDD-for table definition DIMENSION PD(MAXPAR),PDD(MAXPAR) C NAME true-jen text, false-ciselna hodnota nebo vyraz LOGICAL REA,NAME(MAXPAR) CHARACTER*1 CH CHARACTER*8 TTP(MAXPAR) CHARACTER*5 POSTFIX(6) CHARACTER TEXT(MAXPAR)*(LENDIAL),LINE*(LENITE),ICOM*(*) CHARACTER*30 TEG(MAXPEG),TRC(MAXPRC),TMAT(MAXPMP) DATA TMAT/'Kx-heat conductivity [W/m/K] ', / 'Cp-heat capacity [J/kg/K]', / 'Density [kg/m^3]', / 'Kappa-elect.conductivity [S/m]', / 'Ex-Young''s elast. modulus [Pa]', / 'mi-Poisson''s constant [-]', / 'dynamic viscosity [Pa.s]', / 'beta-thermal expansion [1/K]', / 'Dn-diffusion coef. [m^2/s]', / 'En-activation energy [J/mol]', / 'An-frequency factor'/ DATA TRC /'h[m]-thickness','D[m]-diameter','pressure [Pa]', / 'alpha[W/m^2/K]-heat trans.co.', / 'Te[C]-external temperature', / 'Area [m^2]','Perimeter [m]','Volume [m^3]', / 'Ratio [-]', / 'Fi(dp)-flow coefficient', / 'Jz [m^4]-moment of intertia'/ DATA TEG /'S/T-static (0) / transient (1)', / 'Number of Gauss-points', / 'Cartesian (0), Cylindrical (1)', / 'Plane stress (0), strain (1)', / 'Boundary element (1)','Opt '/ DATA PDD /-1.,0.,8.,20*0./ DATA JDDOF,NUCR,NUSF,XLAFI,YLAFI,ZDEF,METFLOW,ITERFLOW,ICURVE, / IDESTIN,PMIX1,PMIX2,F,ALFA,TMEAN,AMPLIT / /1,2,4,1.,1.,0.,1,1,1,2,2.,2.,0.5,1.,1.,0.1/ DATA POSTFIX/'*.NOD','*.ELE','*.GRP','*.EPA','*.DBS','*.TC '/ TEXT='' NAME=.FALSE. C LAST - pocet parametru zadanych primo na prikazovem radku SELECT CASE(ICOM) CASES CONTROL--------------------------CASE('FILE') C FILE NPAR=1 TTP(1)=PROBLEM NAME(1)=.TRUE. TEXT(1)='File name (without extension)' CASE('FILEBIN') C FILE NPAR=2 TTP(1)=PROBLEM PD(2)=1 NAME(1)=.TRUE. TEXT(1)='File name (without extension)' TEXT(2)='0-shortened 1-full database' CASE('FILENAM') C FILE NPAR=1 TTP(1)=FILENAM NAME(1)=.TRUE. TEXT(1)='File name (max.12 characters)' CALL SHOWFILE(10,'*.geo') CASE('FLI') C FIRST, LAST, INC NPAR=3 PD(1:3)=(/1,IDEF,1/) TEXT(1:3)=(/'first','last','increment'/) CASE('LINE') C LINE (UP/DOWN) NPAR=1 PD(1)=IDEF TEXT(1)='No. of lines' CASE('UNDO') C UNDO NPAR=1 PD(1)=IDEF TEXT(1)='No.of backsteps' CASE('ANALYS') C ANALYSIS NPAR=1 PD(1)=1 TEXT(1)='1-STRuct,2-PSI,3-UVP,4-PSBL,5-RTD,6-FULL' WRITE(10,'('' Activate DOF for meshing and dialogs'')') CASE('ACTNUM') C ACTNUM NPAR=1 PD(1)=1 TEXT(1)='1-nd,2-el,3-pt,4-cr,5-sf' WRITE(10,'('' Activate numbering in following plots'')') CASE('ACTSET') C ACTSET NPAR=2 PD(1:2)=(/1,1/) TEXT(1:2)=(/'1-egroup,2-mprop,3-rconst','group no.'/)
WRITE(10,'('' Activate groups for following meshing'')') CASE('STATUS') C ACTNUM NPAR=1 PD(1)=1 TEXT(1)='1-FEM,2-MODEL,3-CURVES' WRITE(10,'('' Set status window (displays either FEM parameters /, model, or information about time curves'')') CASES GEOM-----------------------------CASE('ZDEF') C ZDEF NPAR=1 PD(1)=ZDEF TEXT(1)='Z-coordinate for following definitions' CASE('PT') C PT NPAR=1 PD(1)=IDEF TEXT(1)='PT index' IF(LAST.LT.3) / WRITE(10,'('' Define points using mouse (L-click create PT, R-c /lick quit) at plane Z='',e9.2)')ZDEF CASE('ND') C ND NPAR=1 PD(1)=IDEF TEXT(1)='Kind (1-Vertex,2-Side,3-Center)' IF(LAST.LT.3) / WRITE(10,'('' Define new nodes using mouse (L-click R-click end /s)'')') CASE('CR2PT') C CR2PT NPAR=3 PD(1:3)=(/IDEF,1,2/) TEXT(1:3)=(/ 'CR index','PT1','PT2'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(1) WRITE(10,'('' Define CuRve (line) from 2 points'')') ENDIF CASE('CR3PT') C CR3PT NPAR=4 PD(1:4)=(/IDEF,1,2,3/) TEXT(1:4)=(/ 'CR index','PT1(left)','PT2(right)','PT3(mid)'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(1) WRITE(10,'('' Define quadratic CuRve from 3 points'')') ENDIF CASE('CIRCLE') C CIRCLE NPAR=3 PD(1:3)=(/IDEF,1,2/) TEXT(1:3)=(/'CR first','PT-center','PT-zero deg'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(1) WRITE(10,'('' Define Circle from 2 points (center and one point / at perimeter)'')') ENDIF CASE('SF4PT') C SF4PT NPAR=5 PD(1:5)=(/IDEF,1,2,3,4/) TEXT(1:5)=(/ 'SF index','PT1','PT2','PT3','PT4'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(1) WRITE(10,'('' Define Surface in space by 4 corner points'')') ENDIF CASE('SF8PT') C SF8PT NPAR=9 PD(1:9)=(/IDEF,1,2,3,4,5,6,7,8/) TEXT(1:9)=(/'SF index','PT1','PT2','PT3','PT4', / 'pt5','pt6','pt7','pt8'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(1) WRITE(10,'('' Define curved surface in space by 8 points'')') ENDIF CASE('SFCR') C SFCR NPAR=3 PD(1:3)=(/IDEF,1,2/) TEXT(1:3)=(/ 'SF index','CR1','CR2'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Define surface by selecting 2 sides (curves)'')') ENDIF CASES GROUP----------------------------CASE('EGROUP') C EGROUP NPAR=MPEG+1 PD(1)=IDEF
28
TEXT(1)='Egroup no.' CASE('MPROP') C MPROP NPAR=2*MPMP+1 PD(1)=IDEF TEXT(1)='Mprop group no.' CASE('RCONST') C RCGROUP NPAR=MPRC+1 PD(1)=IDEF TEXT(1)='RC group no.' CASE('FUNDEF') C FUNDEF NPAR=2 PD(1:2)=(/-1,1/) TEXT(1:2)=(/'Index of Function (-10:50)', / 'f(TIME,TEMP,XX,YY,UX,UY)'/) CASE('CURDEF') C CURDEF NPAR=19 PD(1:19)=PDD(1:19) TEXT(1:19)=(/ / 'Index of curve (-10:50)','0-time,1-temp,2-x,3-y,4-z,5-ux', / 'No of points (max 8)', / 'x1','y1','x2','y2','x3','y3','x4','y4','x5','y5','x6','y6', / 'x7','y7','x8','y8'/) WRITE(10,'('' Define table'')') CASES MESH-----------------------------C MSF
CASE('MSF')
NPAR=6 PD(1:3)=(/IDEF,MAX0(NX,1),MAX0(NY,1)/) PD(4:5)=(/XLAFI,YLAFI/) PD(6)=NUSF TEXT(1:6)=(/'SF index','Nx','Ny','Last_x/First_x(+/-)', / 'Last_y/First_y(+/-)', / 'No.of Nodes (3,4,5,6,7,8,9/-center/)'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(3) WRITE(10,'('' Mesh selected surface (triagles or quadrilaterals /)'')') ENDIF CASE('MCR ') C MCR NPAR=4 PD(1:2)=(/IDEF,MAX0(NX,1)/) PD(3)=XLAFI PD(4)=NUCR TEXT(1:4)=(/'CR index','Nx','Last/First(+ one side, sym.)', / 'No.of Nodes (2,3)'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Mesh curve by default 2-3 node elements'')') ENDIF CASE('MCRC ') C MCRC nestandardni elementy NPAR=6 PD(1:6)=(/IDEF,20,1,2,1,2/) TEXT(1:6)=(/'CR index','Nx','Last/First(+/-)', / 'No.of Nodes (2,3)', / 'RConst group', / 'Kind: 1-pipe,2-CSTR,3-divider'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Mesh curve by nonstandard elements'')') ENDIF CASE('MCR2') C MCR2 vymenik tepla NPAR=8 PD(1:8)=(/IDEF,IDEF+1,MAX0(NX,1),1,2,1,2,3/) TEXT(1:8)=(/'CR1 index','CR2 index','No elements on one curve', / 'Mprop group-pipe1', 'Mprop group-pipe2', / 'RConst group-pipe1','RConst group-pipe2', / 'RC-heat exchanger'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Mesh pair of curves by HEAT-Exchanger elements'') /') ENDIF CASES FORCES---------------------------CASE('NFCR') C NFCR NPAR=6 PD(1:3)=(/IDEF,JDDOF,-1/) PD(4:6)=(/P1,P2,P3/) TEXT(1:6)=(/'CR index', / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', / 'status (<0-Bound.Cond.,>0-load)', / 'P1(left)','P2(right)','P3(midpoint)'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Specify DOF or LOAD in nodes on a curve'')') ENDIF CASE('NFSF') C NFSF NPAR=11 PD(1:3)=(/IDEF,JDDOF,-1/) PD(4:11)=(/P1,P2,P3,P4,P5,P6,P7,P8/)
TEXT(1:11)=(/'SF index', 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', 'status (<0-Bound.Cond.,>0-load)', 'P1','P2','P3','P4','P5m','P6m','P7m','P8m'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(3) WRITE(10,'('' Specify DOF or LOAD in nodes inside surface'')') ENDIF CASE('NF') C NF NPAR=4 PD(1:3)=(/IDEF,JDDOF,-1/) PD(4)=P1 TEXT(1:4)=(/ 'ND index', / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', / 'status (<0-Bound.Cond.,>0-load)','Value'/) IF(LAST.LT.NPAR) / WRITE(10,'('' Specify DOF or LOAD in a node'')') CASE('NFPT') C NFPT NPAR=4 PD(1:3)=(/IDEF,JDDOF,-1/) PD(4)=P1 TEXT(1:4)=(/ 'PT index', / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', / 'status (<0-Bound.Cond.,>0-load)','Value'/) IF(LAST.LT.NPAR) / WRITE(10,'('' Specify DOF or LOAD in a point'')') CASE('INITIA') C INITIA NPAR=2 PD(1:2)=(/JDDOF,IDEF/) TEXT(1:2)=(/ / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', / 'Function (-10:50)'/) IF(LAST.LT.NPAR) / WRITE(10,'('' Assignment of initial conditions using specified /function'')') CASE('MOFE') NPAR=2 PD(1:2)=(/IDEF,1/) TEXT(1:2)=(/'DOF:TEMP,UX,UY,...', / 'Mean DOF transferred into EPAR(1:5)'/) / / /
CASES FEM-----------------------------CASE('APIPE') C A_PIPE NPAR=8 PD(1:2)=(/RALGOR(1),RALGOR(2)/) PD(3)=IALGOR(4) PD(4)=RALGOR(5) PD(5)=IALGOR(6) PD(6:8)=IALGOR(21:23) TEXT(1:8)=(/'gx [m^2/s]','gy [m^2/s]', / 'source, e.g.ohmic (0-supressed)', / 'Upwind correction (0-1)', / 'Fouling (0-supressed)', / 'PIPE iter.pressure', / 'HEXC iter.temperature', / 'RTD iter.concentration'/) WRITE(10,'('' Specify parameters for operation PIPEQ.'')') CASE('ATRANE') C A_TRANE NPAR=10 PD(1:2)=(/RALGOR(1),RALGOR(2)/) PD(3)=IALGOR(4) PD(4:5)=(/RALGOR(5),RALGOR(9)/) PD(6:7)=(/METFLOW,ITERFLOW/) PD(8:10)=IALGOR(11:13) TEXT(1:10)=(/'gx [m^2/s]','gy [m^2/s]', / 'source, e.g.ohmic (0-supressed)', / 'Upwind correction (0-1)', / 'Penalty factor (lambda)', / '1-PENalty,2-UVP,3-UVPP,4-PSiOMega,5-PSi', / 'Flow iterations', / 'ELEC electric field (0-supressed)', / 'THER iter.temperature', / 'CONC iter.concentration'/) WRITE(10,'('' Specify parameters for operation TRANE. Selection / method for Navier Stokes eq. solution:''/'' Press.elimination by /penalty m.,UVP method with primitive variables,UVPP pseudocompres. /''/'' PSI/OMEGA, PSI-methods based upon stream function and vortic /ity'')') CASE('CONTHE') C CONTHERMAL NPAR=2 PD(1:2)=(/FLOAT(NTSTEP),DTIME/) TEXT(1:2)=(/'No. of new time steps','new time step dt [s]'/) WRITE(10,'('' CONTINUE calculations (thermal, flow, diffusion.. /.)'')') CASE('THERMA') C THERMAL NPAR=3 PD(1:3)=(/TIME,FLOAT(NTSTEP),DTIME/) TEXT(1:3)=(/'Initial Time','No. of time steps','dt [s]'/) CASE('TRUSS ') C MONTE CARLO FOR TRUSSES NPAR=2
29
PD(1:2)=(/FLOAT(IDEF),DTIME/) TEXT(1:2)=(/'Number of random trials','Increment U'/) CASE('ITER ') C ITER NPAR=1 PD(1)=IDEF TEXT(1)='No. of iterations' CASES MODEL----------------------------CASE('TSTEP') C TIME STEPS NPAR=2 PD(1:2)=(/FLOAT(NTSTEP),DTIME/) TEXT(1:2)=(/'No. of time steps','Time step dt [s]'/) CASE('RMODEL') C RMODEL NPAR=1 TTP(1)=MODKWD(1) NAME(1)=.TRUE. TEXT(1)='Model name' WRITE(10,'('' Select model:'',12(1X,A))') / (MODKWD(I),I=1,NMODELS) CASE('PARLIM') C nastaveni MEZI parametru aktivniho modelu NPAR=2*NUMODP DO I=1,NUMODP PD(2*I-1)=ZMINP(I) PD(2*I)=ZMAXP(I) TEXT(2*I-1)='MIN '//TRIM(MODPARTXT(I)) TEXT(2*I)='MAX '//TRIM(MODPARTXT(I)) ENDDO WRITE(10,'('' Set lower and upper bound of parameters (number o /f parameters='',i2)')NUMODP CASE('PARSET') C nastaveni pozadavku na regresi aktivniho modelu a default hodnoty NPAR=2*NUMODP DO I=1,NUMODP PD(2*I)=KMODEL(I) TEXT(2*I)='0-supressed,1-linear,2-nonlin,3-search' IF(LMODEL(I).GT.0)THEN TEXT(2*I-1)=TRIM(MODPARTXT(I))//' value' IF(JMODEL(I).EQ.1)THEN PD(2*I-1)=REALRC(LMODEL(I)) ELSE PD(2*I-1)=INTERC(LMODEL(I)) ENDIF ENDIF ENDDO WRITE(10,'('' Set default values of model parameters and requir /ement for regression analysis:''/'' 0-fixed parameter, 1linear pa /rameter, 2-nonlinear, 3-line search (nonderivative)'')') CASE('METHOD') NPAR=4 PD(1:3)=(/METHOD,NEQUAT,NTSTEP/) PD(4)=DTIME TEXT(1:4)=(/'M: 0-Euler,>0-RK fix.dt,<0-variab.step', / 'no.of equations', / 'no.of basic time steps','basic time step'/) WRITE(10,'('' Method of integration (dif.eqs.model), specified /by parameter M: Euler for basic time''/'' step (M=0), Runge Kutta / with step dt/M (for M>0), or variable time step (eps=10**M)'')') CASE('INPUT') NPAR=NINPUTS+1 TEXT(1)='Number of stimulus functions X' PD(1)=NINPUTS DO I=1,MAXINPUTS PD(I+1)=MINPUTS(I) WRITE(CH,'(I1)')I TEXT(I+1)='Index of TC as input X'//CH ENDDO WRITE(10,'('' Select TC-curves as input functions X(i,t), i=1,. /..'',i2)') MAXINPUTS CALL SHOWTC(10) CASE('OUTPUT') NPAR=NOUTPUTS+1 PD(1)=NOUTPUTS TEXT(1)='Number of response functions Y' DO I=1,MAXOUTPUTS PD(I+1)=MOUTPUTS(I) WRITE(CH,'(I1)')I TEXT(I+1)='Index of TC as response Y'//CH ENDDO WRITE(10,'('' Select TC functions as responses Y(i,t), i=1,...' /',i2)')MAXOUTPUTS CALL SHOWTC(10) CASES RTD------------------------------CASE('COMPAR') C N C1-C1, C2-C2 promenny pocet argumentu NPAR=3 PD(1)=NCOMPAR TEXT(1)='Number of TC pairs' DO I=1,MAXSEL/2 PD(2*I)=ICOMPAR(1,I) PD(2*I+1)=ICOMPAR(2,I) WRITE(CH,'(I1)')I TEXT(2*I)='Index of the first TC in the pair'//CH
norm
TEXT(2*I+1)='Index of the second TC in the pair'//CH ENDDO WRITE(10,'('' Select TC curves for comparison (difference
/calculation).'')') CASE('CRITER') C KCOMPAR NPAR=1 PD(1)=KCOMPAR TEXT(1)='Criterion for TC comparison' WRITE(10,'('' Select criterion for evaluation of distance betwe /en pair of TC curves.'')') CASE('COPYTO') C COPY TC FROM TO NPAR=2 PD(1:2)=(/ICURVE,IDESTIN/) TEXT(1:2)=(/'Copy from (curve index)','to (curve index)'/) WRITE(10,'('' Copy a time curve (rewrite old one). Current indi /ces are:'')') CALL SHOWTC(10) CASE('MOMENT') C Momenty TC krivky NPAR=1 PD(1)=ICURVE TEXT(1)='Index of curve' WRITE(10,'('' Calculate moments (area, center, variance) of a t /ime curve (max.index'',i2,'')'')')MAXSEL CALL SHOWTC(10) CASE('NORM') C Normalizace TC krivky (bud na plochu nebo i na prvni moment) NPAR=3 PD(1:3)=(/ICURVE,IDESTIN,0/) TEXT(1:3)=(/'Index of source curve', / 'Index of normalised curve', / '0-unit area,1-unit mean time'/) WRITE(10,'('' Normalize a time curve to area or mean time (sour /ce and resulting curves may be identical)'')') CALL SHOWTC(10) CASE('IDMSER') C Serie idealnich misicu IG, P-misicu, Tmean NPAR=3 PD(1)=ICURVE PD(2:3)=(/PMIX1,TMEAN/) TEXT(1:3)=(/'Index of new curve','No.of mixers (real!)', / 'Mean residence time'/) WRITE(10,'('' Impulse response of a series of mixers for time /step'',e9.2,'' and'',i4,'' points'')')DTIME,NTSTEP CASE('PASERI') C 2 Serie idealnich misicu IG, P1,P2-misicu, f-delici pomer, alfaV1/V2, Tmean NPAR=6 PD(1)=ICURVE PD(2:6)=(/PMIX1,PMIX2,F,ALFA,TMEAN/) TEXT(1:6)=(/'Index of new curve','No.of mixers 1.serie', / 'No.of mixers 2.serie','f=Q1/Q flowrate ratio', / 'alfa=V1/V volume ratio','Mean residence time'/) WRITE(10,'('' Impulse response of two parallel series of mixers / for time step'',e9.2,'' and'',i4,'' points'')')DTIME,NTSTEP CASE('SMOOTH') C Smoothing a Time Curve NPAR=3 PD(1:3)=(/ICURVE,IDESTIN,IDEF/) TEXT(1:3)=(/'Index of source curve','Smoothed curve index', / 'Method 0-linear,>0-quadratic (points)'/) WRITE(10,'('' Smoothing a part of time curve using linear or qu /adratic splines.''/'' For linear spline 4, for quadratic up to 40 /points can be used in local regression.'')') CALL SHOWTC(10) CASE('TCRND') C Randomizing Time Curve NPAR=4 PD(1:3)=(/ICURVE,IDESTIN,IDEF/) PD(4)=AMPLIT TEXT(1:4)=(/'Index of source curve','NOISED curve index', / 'Noise 0-absolute,1-relative', / 'Value of mean amplitude'/) WRITE(10,'('' Randomising time curve by superposition of noise /(absolute/relative,Gauss distribution)'')') CALL SHOWTC(10) CASE('TAIL') C Exponential/convectional tail NPAR=3 PD(1:3)=(/ICURVE,IDESTIN,IDEF/) TEXT(1:3)=(/'Index of source curve','Corrected curve index', / 'Tail: 0-exp(t), 1-t.exp(t), 2-A/t^3'/) WRITE(10,'('' Replace tail of a time curve by exponential or po /wer function.''/'' Range of points used for function approximation / is specified by mouse (R-click quits)'')') CALL SHOWTC(10) CASE('TCLIP') C Odriznuti zapornych hodnot NPAR=1 PD(1)=ICURVE TEXT(1)='Index of curve'
30
WRITE(10,'('' Clipping a time curve to positive values only'')') CALL SHOWTC(10) CASE('TCBGR') C Odriznuti zvedajiciho se pozadi NPAR=2 PD(1:2)=(/ICURVE,IDESTIN/) TEXT(1:2)=(/'Source curve (curve index)', / 'corrected curve (index)'/) WRITE(10,'('' Raising background subtraction'')') CALL SHOWTC(10) CASE('TCYSHF') C Posu ve vertikalnim smeru (pricteni P2) NPAR=3 PD(1:3)=(/ICURVE,IDESTIN,0/) TEXT(1:3)=(/'Index of curve (source)', / 'Index of modified curve','Shift vertically by increment'/) WRITE(10,'('' Vertical shift of a time curve by increment'')') CALL SHOWTC(10)
C GE3-flow NPAR=1 TEXT(1)='1-power,2-dissip.,3-II,4-dT/dx,5-dT/dy' WRITE(10,'('' Graph 2D - contours of dissipated power and secon /d invariant of shear rate, grad T'')') CASE('GE4') C GE4-rovinna napjatost NPAR=1 TEXT(1)='1-Sxx,2-Syy,3-Sxy,4-von Mises' WRITE(10,'('' Graph 2D - contours of element stresses'')') CASE('GPIPE') C GRAPH PIPE NPAR=3 PD(1:3)=(/IDEF,2,2/) TEXT(1:3)=(/ / 'DOF:Temp,Pres,Cn,Ux,Uy,Rz,Volt', / '1-Bound.Cond.,2-result,3-Init.Cond.','Thickness [1-4]'/) WRITE(10,'('' Graph 1D (Pipes,Heat exchangers,Shells)degree o /f freedom'')') CASE('GRAPH') CASES WRITE/READ-----------------------C GRAPH NPAR=2 CASE('LOADT') PD(1:2)=(/IDEF,2/) C LOADTIME TEXT(1:2)=(/ NPAR=1 / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..', PD(1)=TIME / '1-Bound.Cond.,2-result,3-Init.Cond.'/) TEXT(1)='Results from time [s]' WRITE(10,'('' Graph 2D - degree of freedom (contours)'')') IF(LAST.LT.NPAR) CASE('GRAFUN') / WRITE(10,'('' Read data from OUT-file (time history)'')') C GRAFUN CASE('WRITE') NPAR=3 C WRITE PD(1:3)=(/-1.,0.,1./) NPAR=2 TEXT(1:3)=(/'Function (-10:50)','from','to'/) NAME(2)=.TRUE. CASE('GRATIM') TTP(2)=PROBLEM C GRAPH TIME COURSES AND ANIMATION PD(1)=IDEF NPAR=1 TEXT(2)='File name (without extension)' PD(1)=IDEF TEXT(1)='1-Nod,2-Ele,3-Grp,4-Epa,5-Dbs,6-Tc' TEXT(1)='Recorded parameter TEMP,UX,...' WRITE(10,'('' Data in ASCII format written into a *.nod WRITE(10,'('' Time course of DOF in picked nodes (L-click *.ele selec /*.grp *.epa *.dbs *.tc file'')') /t, R-click end)'')') CASE('READ') CASE('GTC') C READ ASCII C Graf nekolika t-C krivek NPAR=2 NPAR=MAXSEL+1 PD(1)=IDEF TEXT(1)='Number of curves for plotting' NAME(2)=.TRUE. PD(1)=MAXSEL TTP(2)=FILEDAT DO I=1,MAXSEL TEXT(1)='1-Nod,2-Ele,3-Grp,4-Epa,5-Dbs,6-Tc' PD(I+1)=I TEXT(2)='File name (with extension, max.12 char)' WRITE(CH,'(I1)')I WRITE(10,'('' ASCII data read from a specified file'')') TEXT(I+1)='Index of curve '//CH ENDDO CASE('READTC') WRITE(10,'('' Select curves for plotting i=1,...'',i2)') C READ TC-krivku / MAXSEL NPAR=3 CALL SHOWTC(10) LAST=2 CASE('NFPLOT') PD(3)=IDEF C NFPLOT TEXT(3)='Column of T,C matrix' NPAR=4 CALL SHOWTC(10) PD(1:4)=(/1,IDEF,1,JDDOF/) TEXT(1:4)=(/'first node','last node','increment', CASES LISTS----------------------------/ 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..'/) CASE('PFPLOT') CASE('EPLIST') C PFPLOT C EPLIST NPAR=3 NPAR=4 PD(1:3)=(/IDEF,JDDOF,1/) PD(1:4)=(/1,IDEF,1,1/) TEXT(1:3)=(/'Zone 1-Bound.Cond.,2-Result,3-Init.Cond.', TEXT(1:4)=(/'first element','last element','increment', / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..','Size (0/ 'index of parameter (EPAR)'/) 3)'/) WRITE(10,'('' Element parameter list WRITE(10,'('' Calculates min/max values of selected DOF and (EPAR(ie,parameter))'')') dis CASE('DOFLIS') /plays it graphically in points PT'')') C DOFlist CASE('TCP') NPAR=1 C Plot TC krivka PD(1)=2 NPAR=1 TEXT(1)='1-Bound.Cond.,2-result,3-Init.Cond.,4-temporary' PD(1)=IDEF WRITE(10,'('' Calculate and display min/max DOF-values'')') TEXT(1)='Number of curve' CASE('VARL') WRITE(10,'('' Plot a time curve'')') C VARLIST CALL SHOWTC(10) NPAR=1 PD(1)=IDEF TEXT(1)='Only list of variabs=0, with comments =1' CASES IDENT----------------------------CASES GRAF-----------------------------CASE('GCR') C GCR - kresli XY graf prubehu DOF podel vybrane krivky NPAR=3 PD(1:3)=(/IDEF,JDDOF,2/) TEXT(1:3)=(/'Curve','DOF:TEMP,PRES,...', / '1-Bound.Cond.,2-Result,3-Init.Cond.'/) IF(LAST.LT.NPAR)THEN CALL DRAWE(2) WRITE(10,'('' Graph XY - selected DOF along selected CURVE'')') ENDIF CASE('GE1') C GE1-shellax NPAR=1 TEXT(1)='1-Nalpha,2-Nbeta,3-Malpha,4-Mbeta,5-Q' WRITE(10,'('' Graph 1D - stresses in shells'')') CASE('GE2') C GE2-pipe NPAR=1 TEXT(1)='1-Q,2-Re,3-Tauw' WRITE(10,'('' Graph 1D - flowrate,Re,shear stress in pipes'')') CASE('GE3')
CASE('EID') C EIDENT NPAR=1 PD(1)=IDEF TEXT(1)='1-Egroup,2-Rconst,3-Mprop,4-EPAR' WRITE(10,'('' Information on elements selected by mouse (Rclic /k terminates the operation)'')') CASE('NID') C NIDENT NPAR=2 PD(1:2)=(/IDEF,JDDOF/) TEXT(1:2)=(/'Zone 1-Bound.Cond.,2-Result,3-Init.Cond.', / 'DOF:Temp,Ux,..,Rx,..,Vx,..,Pres,Ps,Psx,..'/) WRITE(10,'('' Information on Nodes selected by mouse (Rclick t /erminates the operation)'')') CASES SCREEN---------------------------CASE('SCALE') C SCALE NPAR=4 PD(1:4)=(/xmin,xmax,ymin,ymax/)
31
TEXT(1:4)=(/'xmin','xmax','ymin','ymax'/) WRITE(10,'(1X,A,'' ['',I4,''] >''\)') CASE('GRIDON') / TRIM(TEXT(I)),IPD C GRIDON ELSE NPAR=4 WRITE(10,'(1X,A,'' ['',E9.2,''] >''\)') PD(1:4)=(/0.,0.,0.1,0.1/) / TRIM(TEXT(I)),PD(I) TEXT(1:4)=(/'Origin X','Origin Y', ENDIF / 'Increment DX','Increment DY'/) II=SETTEXTCOLOR(int2(15)) WRITE(10,'('' Grid for PT/ND definition using mouse (GRIDOF CALL GMFEDL(10,LINE,IEND) C IEND=F1,F2,... moznost aktivace lokatoru end /s)'')') C zatim neimplementovano IF(IEND.EQ.-1)GOTO 99 CALL PROITE(I,LINE,IEND) CASE DEFAULT IF(INDEX(LINE,';').GT.0)REA=.FALSE. C Prohlizeni seznamu jmen vnejsich programu ENDIF DO I=1,NEXCOM IF(IEND.LE.0)THEN IF(ICOM.EQ.NEXKWD(I))THEN C DEFAULT NPAR=NEXPAR(I) C PROITE konci bud hodnotou DO J=1,NPAR C IEND>0 spravny vyraz, IEND=0 zadny text, IEND<0 chyba PD(J)=DEXPAR(J,I) RP(I)=PD(I) TEXT(J)=NEXPARTXT(J,I) IPD=FLOOR(RP(I)+.5) ENDDO IF(NAME(I))THEN ENDIF IF(IEND.EQ.0)TP(I)=TRIM(TTP(I)) ENDDO ELSEIF(FLOAT(IPD).EQ.RP(I).AND.ABS(RP(I)).LT.10000.)THEN END SELECT WRITE(TP(I),'(I5)')IPD C====================================== ELSE WRITE(TP(I),'(E10.3)')RP(I) II=FOCUSQQ(10) ENDIF IF(ISEMI.EQ.0)THEN ENDIF REA=.TRUE. IP(I)=FLOOR(RP(I)+.5) ELSE C Vyznam nasledujiciho prirazeni je v tom, ze nasledujici zadavani REA=.FALSE. C parametru I+1,..., se muze ridit predchozimi vysledky ENDIF PD(I)=RP(I) C cyklus I-parametr nezadany na prikazovem radku. Pouziva se C while, aby bylo mozne v prubehu zadavani modifikovat pocet porametru.
C Nove default hodnoty SELECT CASE(ICOM) CASE('ATRANE') METFLOW=IP(6) I=LAST+1 ITERFLOW=IP(7) DO WHILE(I.LE.NPAR) CASE('SCALE') IEND=0 XMIN=RP(1) IG=FLOOR(PD(1)+.5) XMAX=RP(2) YMIN=RP(3) IF(I.EQ.2.AND.IG.GE.1)THEN YMAX=RP(4) C Nasledujici sekce se provadi jen jednou pri zpracovani druheho CASE('NFPLOT') parametru, JDDOF=IP(4) C tj. az po zadani prvniho parametru, ktery urcil skupinu nebo index CASE('MCR ','MCRC ') entity IG. NX=IP(2) C Ve vyjmenovanych pripadech se pak bud nastavi default hodnoty XLAFI=RP(3) C nebo se zobrazi napoveda (napr. se zobrazi prislusna entita NUCR=IP(4) C s orientaci stran apod.) CASE('MCR2') SELECT CASE(ICOM) NX=IP(3) CASE('MPROP') CASE('MSF') C DEFAULT MPROP NX=IP(2) DO J=1,MPMP NY=IP(3) IF(LRMAT(J).GE.1.AND.LRMAT(J).LE.MAXPMP)THEN XLAFI=RP(4) TEXT(2*J)=TMAT(LRMAT(J)) YLAFI=RP(5) TEXT(2*J+1)=TRIM(TMAT(LRMAT(J)))//'_function' NUSF=IP(6) PD(2*J)=RMAT(IG,LRMAT(J)) CASE('NFCR') PD(2*J+1)=JMAT(IG,LRMAT(J)) JDDOF=IP(2) ENDIF P1=RP(4) ENDDO P2=RP(5) CASE('EGROUP') P3=RP(6) C DEFAULT EGROUP CASE('NFSF') DO J=1,MPEG JDDOF=IP(2) IF(LGROUP(J).GE.1.AND.LGROUP(J).LE.MAXPEG)THEN P1=RP(4) TEXT(J+1)=TEG(LGROUP(J)) P2=RP(5) PD(J+1)=JGROUP(IG,LGROUP(J)) P3=RP(6) ENDIF P4=RP(7) ENDDO P5=RP(8) CASE('RCONST') P6=RP(9) C DEFAULT RC P7=RP(10) DO J=1,MPRC P8=RP(11) IF(LRCONS(J).GE.1.AND.LRCONS(J).LE.MAXPRC)THEN CASE('NF','NFPT') TEXT(J+1)=TRC(LRCONS(J)) JDDOF=IP(2) PD(J+1)=RCONST(IG,LRCONS(J)) P1=RP(4) ENDIF CASE('NID','PFPLOT','GCR') ENDDO JDDOF=IP(2) CASE('MSF','NFSF') CASE('CURDEF') C Vykresleni vybrane plochy PDD(1:19)=RP(1:19) CALL PLDSF(IG) CASE('ZDEF') CASE('MCR','NFCR') ZDEF=RP(1) C Vykresleni vybrane krivky CASE('MOMENT') CALL PLDCR(IG) ICURVE=IP(1) CASE('INPUT','OUTPUT') CASE('IDMSER') C Vzruchove a odezvove funkce (seznam) ICURVE=IP(1) NPAR=IG+1 PMIX1=RP(2) CASE('COMPAR') TMEAN=RP(3) C Comparison of pairs CASE('PASERI') NPAR=2*IG+1 ICURVE=IP(1) CASE('GTC') PMIX1=RP(2) C Graf nekolika krivek. Pokud je zadano IG=MAXSEL kresli se vsechny PMIX2=RP(3) NPAR=IG+1 TMEAN=RP(3) IF(IG.EQ.MAXSEL)REA=.FALSE. CASE('READ','WRITE') CASE('TAIL','NORM','TCBGR','COPYTO','TCRND','SMOOTH','TCYSHF') C Vypis souboru s pozadovanou priponou ICURVE=IP(1) CALL SHOWFILE(10,POSTFIX(IG)) IDESTIN=IP(2) END SELECT ENDSELECT ENDIF I=I+1 ENDDO IF(REA)THEN II=SETTEXTCOLOR(int2(15)) C prikaz nebyl ukoncen strednikem, proto dialog IEND=0 II=SETTEXTCOLOR(int2(11)) 99 END IPD=FLOOR(PD(I)+.5) IF(NAME(I))THEN INCLUDE '$S0-HELP' WRITE(10,'(1X,A,'' ['',A,''] >''\)') / TRIM(TEXT(I)),TRIM(TTP(I)) ELSEIF(FLOAT(IPD).EQ.PD(I).AND.ABS(PD(I)).LT.1000.)THEN
32
$S0-help SUBROUTINE HELP USE MSFLIB INCLUDE '$FEM' II=SETBKCOLOR(1) WRITE(40,30) 30 FORMAT(' AVAILABLE COMMANDS: ') II=SETBKCOLOR(3) WRITE(40,40) 40 FORMAT( /' NEWPROB(clear database) FILE(read and interpret session file) EX /IT(terminate program) UNDO(return back) RECORD(macro) ENDREC'/ /' control: #LABEL xxxx, #GOTO xxxx, #LOOP xxxx N (repeat Ntimes u /p to label xxxx), #IF relation THEN, #ELSE, #ENDIF'/ /' windows: SCALE(range of model window) CLS(clear model) ZOOMI(or /ZI) ZOOMOUT(or ZO) U(up list window) D(down) PU(PgUp) PD(PgDn)'/ /' export/import: WRITE (or W, text files) WRITEB,READBI (or WB,RB, / database as a binary file) REM (write comment)'/ /' groups: EGROUP(or EG, element group) MPROP (or MP,material pr /operties) RCONST (or RC, real constants)'/ /' functions: CURDEF(or CD, table of points) FUNDEF(or FD, expressi /on) CURLIST FUNLIST (or CURL,FUNL, lists)'/ /' geometry: ZDEF(default Z) PT(point by mouse) CR2PT(curve by 2 po /ints) CR3PT SF4PT(surface) SF8PT'/ /' SFCR(surface by 2 curves) CIRCLE(center and point)'/ /' listings (abbr.form PTL,CRL,...): PTLIST CRLIST SFLIST NDLIST(no /des and DOFs) NFLIST(forces and fixed DOF in nodes)'/ /' ELIST EPLIST(element parameters EPAR) MPLIST RCLIST EG /LIST CLIST(Control parameters) DOFLIS(DOF range)'/ /' activation: ACTNUM(numbering) INACTNUM ACTSET(element groups for / meshing) GRIDON GRIDOF (grid for PT definition)'/ /' plots (abbr.PTP,CRP,...): PTPLOT CRPLOT SFPLOT NDPLOT NFPLOT EPL /OT PFPLOT(or METER-displays analog dial)'/ /' graphs: GD1(DOF in 1D models) GD2(DOF contours in 2D models) GE1 /(element parameter) GE2(contours of element parameters)'/ /' GC(plot DOF along a curve) GRAFUN(plot function) GRATIM /(time courses of picked DOFs) LOADT(load results from time)'/ /' picking (abbr.NID,PID,EID,CID): NIDENT(nodes and DOFs) PIDENT(po /ints) EIDENT(elements and parameters) CIDENT(curves)'/ /' nodes: NMERGE(merge and compress nodes) ND(define node by mouse) / E (define element directly)'/ /' meshing: MCR(mesh curve) MCRC MCR2(Heat Exchanger), MSF(mesh s /urface)'/ /' forces, boundary, initial conditions: NFCR(DOF on a curve) NFSF /(on surface) NF(in node) NFPT(in point) WALL INLETA'/ /' INITIAL(condition by function) MOFE(move DOFs to EPAR)' // /' run: ATRANE (or A_T) adjusts parameters for TRANEQ TRANEC (2D tr /ansport equations: fluid flow, heat, concentrations)'/ /' APIPE (or A_P) prepares operations PIPEQ PIPEC (1D mod /els of pipelines: pressures, temperatures, concentrations)'/ /' run individ.2D operations: THER(thermal) ELEC(volt) CONC(cn) UVP /(vel.+pres) PSOM(psi+omega) PSIN(psi) PENS(penalty)'/ /' CREEP(stream funct.) MIKE(min.kinetic energy) MIDE(mini /mum dissipation)'/ /' run individ.1D operations: PIPE(pressure and flowrates) HEXC(hea /t transport and heat exchangers) RTD(concentration in pipelines)'/ /' run struct.analysis: SHELLAX(rotationally sym. shells) TRUSS (MC / method for trusses) PLANE2(plane strain/stress)') IF(NEXCOM.GT.0)WRITE(40,90)(NEXKWD(I),I=1,NEXCOM) 90 FORMAT(' Externals:',10(1X,A)) II=SETBKCOLOR(1) WRITE(40,50) 50 FORMAT(' SYSTEM VARIABLES $XXXX: ($-sign omitted, use VARL, or LOC / Variable for details)') II=SETBKCOLOR(3) WRITE(40,60) 60 FORMAT( / ' auxilliary variables: A,B,...,Z, current nodal values: X,Y,Z, /TIME,TEMP,UX,UY,UZ'/ / ' entities: NPT,NCR,NSF,NVL,NE,ND,NGRP,NRC,NMAT'/ / ' number of iterations for individual operations:'/ / ' 2D: THER(heat),ELEC(volt),CONC(mass), PENS,UVP,UVPP(velocity), /PSIN,PSOM(stream funct.),MIKE,MIDE(flow minimising energy)'/
/ ' 1D: PIPE(pressure and flowrate),HEXC(heat),RTD(concentration) /analysis of pipelines, heat exchangers, mixers'/ / ' switches,general constants: BUOY(buoyancy),GX,GY(acceler.),LAM /B(penalty factor),OHMI(sources),PIVT(mininum pivot for elimination /)'/ / ' DT(time step),STEP(no.of steps),RUPW(upwind correct.),SCL(sc /ale deformed),TOL(distance),UPW(enable upwind),VELO(enable convect /.)'/ / ' coordinates: XND(i),YND(i),ZND(i),XPT(i),YPT(i),ZPT(i)'/ / ' real constants: VH(rc)-thickness,VD(rc)-diameter, VPRS,VP(rc)/pressure,VALPHA,ALPHA(rc)-heat trans.coef,VTE,TE(rc)-Te'/ / ' VAREA,AREA(rc)-area,VPERIM,PERIM(rc)perimeter,VJZ,JZ(rc)-in /ertia moment'/ / ' material properties: VKX,KX(m)-thermal cond.,VCP,CP(m)heat ca /pacity,VDENS,DENS(m)-density,VKAPPA,KAPPA(m)-elec.cond.'/ / ' VEX,EX(m)-Young mod.,VISC(m),VBETA,BETA(m)therm.expansion, /VDN,DN(m)-dif.coef.,VEN,EN(m)-activ.energy,VAN,AN(m)freq.fact.'/ / ' element group: VST(eg)-static/transient,VGSS(eg)-Gauss points, /VPAX(eg)-Cartesian/Cylindrical,VSTS(eg)-stress/strain'/ / ' VDEV(dof)-deviation,MEAN(dof)-mean abs.value of DOF,VRNG(dof)/min/max values of DOF.'/ / ' LPU(i)-location of DOF,MPU(i)-no.of DOF in a node,IPU(i)statu /s,JPU(i)-dof identification,KIND(i)-vertex,midside,center'/ / ' nodal parameters: V1(i)-boundary cond.,V2(i)solution,V3(i)-in /itial cond., element parameters: E1(i),E2(i),...,E5(i)'/ / ' Models and time curves: T1(i),C1(i),...,NGR(i), DTGR(i)time /courses, C(i),DC(i)-variab.,deriv., P(i)-model parameters') II=SETBKCOLOR(1) WRITE(40,70) 70 FORMAT(' FUNCTIONS: ') II=SETBKCOLOR(3) WRITE(40,80) 80 FORMAT(' SIN(x),COS(x),EXP(x),LOG(x),LGT(x),ABS(x),MIN(x1,x2,...), /MAX(x1,x2,..),ATN(x),ERF(x),PLE(n,x),PLG(n,x),PTC(n,x),RND(0)') END SUBROUTINE SHOWFILE(IUN,FILESPEC) USE MSFLIB CHARACTER *(*) FILESPEC CHARACTER *100 LINE TYPE (FILE$INFO) INFO LLIN=0 IHANDLE=FILE$FIRST LEN=GETFILEINFOQQ(FILESPEC,INFO,IHANDLE) DO WHILE(LEN.GT.0.AND.LLIN+LEN+1.LE.100) LINE(LLIN+1:LLIN+LEN+1)=INFO.NAME//' ' LLIN=LLIN+LEN+1 LEN=GETFILEINFOQQ(FILESPEC,INFO,IHANDLE) IF(IHANDLE.EQ.FILE$LAST)EXIT ENDDO IF(LLIN.GT.0)WRITE(IUN,'(1X,A)')TRIM(LINE) END SUBROUTINE SHOWTC(IUN) C Informace o vsech TC funkcich, ktere jsou nenulove INCLUDE '$FEM' INTEGER MEMPTY(MAXSEL) CHARACTER*1 TYP(5) LOGICAL EXIST DATA TYP/' ','F','E','X','Y'/ NEMPTY=0 EXIST=.FALSE. DO IG=1,MAXSEL IF(NGR(IG).GT.0)THEN WRITE(IUN,'(1X,I2,''['',I4,'','',A1,'']:'',A\)') / IG,NGR(IG),TYP(MIN0(5,IQGR(IG)+1)),TRIM(FILEXPERI(IG)) EXIST=.TRUE. ELSE NEMPTY=NEMPTY+1 MEMPTY(NEMPTY)=IG ENDIF ENDDO IF(EXIST)THEN C WRITE(IUN,*) WRITE(IUN,'('' Empty curves:'',10I3)')(MEMPTY(I),I=1,NEMPTY) IF(IUN.NE.11)THEN CALL GRAFTC(0,1) CALL GMFSW(1) ENDIF ENDIF END SUBROUTINE HELPC(KEYW) C C Reakce na nerozpoznany prikaz C USE MSFLIB CHARACTER *(*) KEYW CHARACTER *100 LINE
33
CHARACTER *40 KEYC,TXTV*17 INTEGER IREAD(200) LOGICAL FIRST II=FOCUSQQ(40) CALL CLEARSCREEN($GCLEARSCREEN) C C Testovani prirazovaciho prikazu provadime jen v pripade, ze KEYW obsahuje rovnitko C IEQ=INDEX(KEYW,'=') IF(IEQ.GT.1)THEN WRITE(40,'(5x,A,''-unknown. Probably Assignment with a syntax /error'')')TRIM(KEYW) IZAV=INDEX(KEYW,'(') IF(IZAV.GT.1)THEN LK=MIN0(3,IZAV-1) ELSE LK=MIN0(3,IEQ-1) ENDIF CALL TUPC(LK,KEYW,KEYW) DO I=1,201 CALL VARHELP(I,TXTV,LOC) IND=INDEX(TXTV,KEYW(1:LK)) IF(IND.GT.0)WRITE(40,'('' Variable '',A)')TXTV ENDDO ELSE C C Operace C OPEN(2,FILE='COMMANDS.TXT') KEYC=','//KEYW LK=MIN0(7,LEN(TRIM(KEYC))) C Testujeme jen pripady, kdy klicove slovo jsou alespon 2 znaky IF(LK.LE.2)RETURN C Prvni faze hledani: zamena jedineho znaku, eventualne jeden nadbytecny C znak (pokud je delka klicoveho slova 4,5,6) FIRST=.TRUE. IC=0 IREAD=0 I=0 IF(LK.GE.4)THEN 1 READ(2,'(A)',END=100)LINE I=MIN0(200,I+1) CALL INDEXI(LINE,KEYC,2,LK,LOC) IF(LOC.GT.0.AND.IREAD(I).EQ.0)THEN IC=IC+1 IF(FIRST)THEN WRITE(40,'(5X,A,''-unknown. Try similar commands:'')') / KEYW FIRST=.FALSE. ENDIF CALL WRITECOM(TRIM(LINE)) IREAD(I)=1 ENDIF GOTO 1 ENDIF C Druha faze: prohledavani s postupne zkracovanym klicovym slovem od zacatku C Alespon prvni dva znaky musi byt shodne 100 REWIND 2 LK=MIN0(6,LK) DO WHILE(IC.LE.10.AND.LK.GE.3) I=0 2 READ(2,'(A)',END=200)LINE I=MIN0(200,I+1) LOC=INDEX(LINE,KEYC(1:LK)) IF(LOC.GT.0.AND.IREAD(I).EQ.0)THEN IC=IC+1 IF(FIRST)THEN WRITE(40,'(5X,A,''-unknown. Try similar commands:'')') / KEYW FIRST=.FALSE. ENDIF CALL WRITECOM(TRIM(LINE)) IREAD(I)=1 ENDIF GOTO 2 200 REWIND 2 LK=LK-1 ENDDO C Treti faze: prohledavani se zkracovanim klicoveho slova, ne od zacatku IF(LEN(TRIM(KEYW)).GE.2.AND.IC.LE.3)THEN FIRST=.TRUE. LK=MIN0(6,LEN(TRIM(KEYW))) DO WHILE(IC.LE.10.AND.LK.GE.(2+IC/4)) I=0 3 READ(2,'(A)',END=300)LINE I=MIN0(200,I+1) LOC=INDEX(LINE,KEYW(1:LK)) IF(LOC.GT.0.AND.IREAD(I).EQ.0)THEN IC=IC+1 IF(FIRST)THEN WRITE(40,'(5X,''Trying not very probable alternatives / of ['',A,''] but who knows...'')')KEYW FIRST=.FALSE. ENDIF CALL WRITECOM(TRIM(LINE)) IREAD(I)=1 ENDIF GOTO 3
300
REWIND 2 LK=LK-1 ENDDO ENDIF CLOSE(2) ENDIF END
SUBROUTINE INDEXI(TEXT,KEYW,L1,L2,LOC) PARAMETER (NCH=32) CHARACTER*(*) TEXT,KEYW CHARACTER*1 A(NCH) CHARACTER*7 KEYC DATA A/'A','B','C','D','E','F','G','H','I','J','K','L','M','N', / 'O','P','Q','R','S','T','U','V','W','X','Y','Z', / '2','3','4','6','8','#'/ C Test zameny znaku na pozici L1,...,L2 DO L=L1,L2 KEYC=KEYW DO I=1,NCH KEYC(L:L)=A(I) LOC=INDEX(TEXT,KEYC(1:L2)) IF(LOC.GT.0)RETURN ENDDO ENDDO C Test vynechani znaku L na pozici L1,...,L2 IF(L2.GT.4)THEN DO L=L1,L2-1 IF(L.LT.L2-1)THEN KEYC=KEYW(1:L-1)//KEYW(L+1:L2) ELSE KEYC=KEYW(1:L) ENDIF LOC=INDEX(TEXT,KEYC(1:L2-1)) IF(LOC.GT.0)RETURN ENDDO ENDIF END SUBROUTINE WRITECOM(TXKEYW) CHARACTER*(*) TXKEYW CHARACTER*35 TXCOM CALL COMHELP(TXKEYW,TXCOM,IEND) IF(IEND.EQ.0)THEN WRITE(40,'(1X,A)')TXKEYW ELSE WRITE(40,'(1X,A,'' : '',A)')TXKEYW,TXCOM ENDIF END SUBROUTINE COMHELP(TXKEYW,TXCOM,IEND) C C TXKEYW - nazev prikazu, napr. ,EGROUP,EG, C TXCOM - nalezeny komentar k prikazu C IEND =0 komentar neni, C >0 delka komentare PARAMETER (NKW=69) CHARACTER*(*) TXKEYW,TXCOM CHARACTER*5 KW(NKW) CHARACTER*35 TKW(NKW) DATA (KW(I),TKW(I),I=1,NKW) / / 'IDENT','entity picking by mouse', / 'SFCR ','surface created from curves', / 'CR2PT','curve defined by two points', / 'MPROP','material properties', / 'EGROU','element group properties', / 'RCONS','real constants of elements', / 'METER','display DOF values in points', / 'FUNDE','dependent properties or B.C.', / 'MSF ','mesh surface', / 'MCR ','mesh curve', / 'MERGE','nodes merging', / 'NFCR ','DOF or force on a curve', / 'NFSF ','DOF or force on a surface', / 'INITI','initial conditions for FEM', / 'IMOD ','run model initialization', / 'MOFE ','move DOF into element parameters', / 'MIKE ','run flow with min.kinetic energy', / 'MIDE ','run flow with min.dissipation', / 'HEXC ','run 1D FEM analysis', / 'CREEP','run creeping flow', / 'SHELL','run shell analysis', / 'THERM','run transp.eq.solver', / 'RMODE','read model definition', / 'WRITE','write data into a file', / 'READ ','read data from a file', / 'PLOT ','plot a selected entity', / 'VARLI','list system variables', / 'MODLI','active model listing', / 'LIST ','list selected entity', / 'NDF ','force or DOF in a node', / 'PTF ','force or DOF in a point', / 'IDMSE','series of ideal mixers', / 'PASER','two parallel series of mixers', / 'TIMES','set time step and number of steps', / 'METHO','solution of dif.eq. by Euler/RK', / 'INPUT','stimulus functions of a model', / 'OUTPU','recorded responses of a model', / 'IMPUL','run solver of model', / 'NORM ','normalize a time curve', / 'MOMEN','moments of a time curve', / 'TCYSH','shift a time curve', / 'SMOOT','local smoothing of a time curve', / 'COPYT','copy a time curve', / 'TCBGR','background raise correction', / 'TCRND','randomise a time curve',
34
/ 'TCLIP','suppress negative values', / 'LOC ','information about system variables', / 'DISP ','display values (error in argument?)', / 'FOR ','FOR i=i1,i2 DO [block]', / 'WHILE','WHILE relation DO [block]', / 'IF ','IF relation THEN [block]', / 'NEWPR','close old, open new problem', / 'ACTNU','activate numbering of entities', / 'STATU','set type of status window', / 'RECOR','start recording macro', / 'ENDRE','close macro recording file', / 'MACRO','run macro file', / 'FILE ','run session file', / '#LOOP','#LOOP label n-times', / '#GOTO','#GOTO label', / 'EXIT ','quit FEMINA', / 'PU ','Page Up in window LIST', / 'PD ','Page Down in window LIST', / 'GRAPH','2D contours of a DOF', / 'GRAPS','1D graphs of a DOF', / 'GTIME','time history of a DOF', / 'GRAFU','graph of function (properties)', / 'GTC ','graph of multiple time curves', / 'GE2 ','2D contours of element parameter'/ C zjistujeme, zda se nektere klicove slovo neobjevuje v textu IEND=0 DO I=1,NKW IF(INDEX(TXKEYW,TRIM(KW(I))).GT.0)THEN TXCOM=TKW(I) IEND=LEN(TKW(I)) EXIT ENDIF ENDDO END SUBROUTINE VARHELP(I,TXTV,LOC) C C I - index atributu (poradi preddefinovanych promennych v BLOCK DATA) C TXTV - vystupni retezec (informace o promenne) C LOC - POZICE PROMENNE V /FEM (1 az MAXEND) C INCLUDE '$FEM-PAR' INCLUDE '$FEM-LOC' CHARACTER *(*) TXTV,NAME*8 COMMON /TRANDAT/NVARSYS,NVARTOT,IATTR(2,MAXATR),IATTW(2,MAXATR), / NAME(MAXATR) LOC=0 IF(I.LE.0.OR.I.GT.NVARTOT)RETURN SELECT CASE(IATTR(2,I)) CASE(1) TXTV=NAME(I)//' real ' CASE(2) TXTV=NAME(I)//' int ' CASE(3) TXTV=NAME(I)//'(i) real ' CASE(4) TXTV=NAME(I)//'(i) int ' CASE(5) TXTV=NAME(I)//' funct. ' END SELECT IF(IATTR(2,I).LE.4)LOC=IATTR(1,I) END SUBROUTINE FEMHELP(LOC,TXTH,IENDH) C C LOC - POZICE PROMENNE V /FEM (1 az MAXEND) C TXTH - vystupni retezec (informace o promenne pokud je na pozici LOC definovana) C IENDH- =0 nebyla nalezena polozka HELP C INCLUDE '$FEM-PAR' INCLUDE '$FEM-LOC' CHARACTER *(*) TXTH IENDH=1 SELECT CASE(LOC) CASE(1) TXTH='current time (transient analysis)' CASE(2) TXTH='current coordinate (set before funct.evaluation)' CASE(5) TXTH='second invariant of rate od deformation' CASE(11) TXTH='DOF identification as temperature (value 1)' CASE(12) TXTH='DOF identification as UX displacement (value 2)' CASE(15) TXTH='DOF identification as RX rotation (value 5)' CASE(18) TXTH='DOF identification as voltage (value 8)' CASE(19) TXTH='DOF identification as VX velocity (value 9)' CASE(22) TXTH='DOF identification as pressure (value 12)' CASE(23) TXTH='DOF identification as vorticity omega (value 13)' CASE(24) TXTH='DOF identification as stream function (value 14)' CASE(30) TXTH='DOF identification as concentration CN (value 20)' CASE(41) TXTH='user variables A,B,...H-real, I,J,...N-integer' CASE(LOCAUX1) TXTH='number of points created by PT command (geometry)' CASE(LOCAUX1+1) TXTH='number of curves created by using CR2PT,CR3PT'
CASE(LOCAUX1+2) TXTH='number of surfaces created from points or curves' CASE(LOCAUX1+3) TXTH='number of volumes (volumes are not supported yet)' CASE(LOCAUX1+4) TXTH='number of finite elements (created by MCR,MSF,...)' CASE(LOCAUX1+5) TXTH='number of nodes (created by MCR,MSF,... or by ND)' CASE(LOCAUX1+6) TXTH='number of E-groups (defined by EG command)' CASE(LOCAUX1+7) TXTH='number of RC-groups (defined by RC command)' CASE(LOCAUX1+8) TXTH='number of MPROP-groups (defined by MP command)' CASE(MAXAUX+11) TXTH='1-STRuctural anal.,2-PSI,3-UVP,4-PSBL,5-RTD' CASE(LOCAUX15) TXTH='number of time steps' CASE(LOCAUX16) TXTH='time step [s]' CASE(LOCIALG1) TXTH='switches (MASS-matrix,CONVECTion,BUOYANCY,SOURCe)' CASE(LOCIELEC) TXTH='max.iterations ELEC (2D voltage)' CASE(LOCIELEC+1) TXTH='max.iterations THER (2D thermal)' CASE(LOCIELEC+2) TXTH='max.iterations CONC (2D concentration)' CASE(LOCIELEC+3) TXTH='max.iterations UVP (Nav.Stokes, prim.variables)' CASE(LOCIELEC+4) TXTH='max.iterations UVPP (Nav.Stokes pseudocompres.)' CASE(LOCIELEC+5) TXTH='max.iterations MIKE (flow with min.kinetic energy)' CASE(LOCIELEC+6) TXTH='max.iterations PENS (Nav.Stokes penalty method)' CASE(LOCIELEC+7) TXTH='max.iterations PSIN (Nav.Stokes stream funct.)' CASE(LOCIELEC+8) TXTH='max.iterations PSOM (Stream funct.+vorticity)' CASE(LOCIELEC+9) TXTH='max.iterations PSBL (Creep-stream function)' CASE(LOCIELEC+10) TXTH='max.iterations PIPE (pressures in pipelines)' CASE(LOCIELEC+11) TXTH='max.iterations HEXC (temp.in pipelines)' CASE(LOCIELEC+12) TXTH='max.iterations RTD (concentration in pipelines)' CASE(LOCIMIDE) TXTH='max.iterations MIDE (flow with minim.dissipation)' CASE(LOCRALG1) TXTH='GX-gravity acceleration (effects natural convec.)' CASE(LOCRUPW) TXTH='upwind correction (a value between 0 and 1)' CASE(LOCPIVT) TXTH='minimum of pivot (frontal method); default 1e-6' CASE(LOCRTOL) TXTH='minimum distance of points or nodes for merging' CASE(LOCRSCL) TXTH='scale factor for displacement (graphics)' CASE(LOCRLAMB) TXTH='LAMBDA-penalty factor (should be 10**7 or so)' CASE(LOCRALG1+10) TXTH='Residuals ELEC,THER,CONC,...' CASE(LOCVST) TXTH='EGROUP Static/Transient algorithms' CASE(LOCVGSS) TXTH='EGROUP number of Gauss Points' CASE(LOCVPAX) TXTH='EGROUP Cartesian/Cylindrical coord.syst. assumed' CASE(LOCVH) TXTH='RCONST H [m] thickness of a plate' CASE(LOCVD) TXTH='RCONST D [m] diameter of a pipe' CASE(LOCVPRS) TXTH='RCONST Inner pressure [Pa] applied to a shell' CASE(LOCVALF) TXTH='RCONST Alpha [W/m^2/K] heat transfer coef.' CASE(LOCVTE) TXTH='RCONST Te [C] ambient temperature' CASE(LOCVARE) TXTH='RCONST Area [m^2] -usually heat transfer surface' CASE(LOCVPER) TXTH='RCONST Perimeter [m] of a cross section' CASE(LOCVKX) TXTH='MPROP KX [W/m/K] heat conductivity' CASE(LOCVCP) TXTH='MPROP CP [J/kg/K] heat capacity' CASE(LOCVDEN) TXTH='MPROP RHO [kg/m^3] density' CASE(LOCVKAP) TXTH='MPROP KAPPA [S/m] electrical conductivity' CASE(LOCVEX) TXTH='MPROP E [Pa] (Young modulus)' CASE(LOCVMI) TXTH='MPROP MI (Poisson constant)' CASE(LOCVISC) TXTH='MPROP Viscosity [Pa.s]' CASE(LOCVBET) TXTH='MPROP Beta [1/K] thermal expansion' CASE(LOCVDN) TXTH='MPROP Dn [m^2/s] diffusion coeffient' CASE(LOCVEN) TXTH='MPROP En activation energy (Arrhenius)' CASE(LOCVAN) TXTH='MPROP An frequency factor dc/dt=An*exp(En/RT)*c' CASE(LOCVKXF)
35
TXTH='MPROP Kx -index of function multiplying Kx' CASE(LOCIUE) TXTH='Connect: IUE(lue(i)+j) j-th node of i-th element' CASE(LOCLUE) TXTH='LUE(i) pointer to i-th element connectivity' CASE(LOCMUE) TXTH='MUE(i) number of i-th element nodes' CASE(LOCEPAR) TXTH='first parameter of i-th element (postproc.result)' CASE(LOCEPA2) TXTH='second parameter of i-th element (postproc.result)' CASE(LOCEPA3) TXTH='third parameter of i-th element (postproc.result)' CASE(LOCEPA4) TXTH='fourth parameter of i-th element (postproc.result)' CASE(LOCEPA5) TXTH='fifth parameter of i-th element (postproc.result)' CASE(LOCIGROUP) TXTH='E-GROUP index of an element' CASE(LOCIRCONS) TXTH='RC-GROUP index of an element ' CASE(LOCIMAT) TXTH='MPROP-GROUP index of an element' CASE(LOCKINDE) TXTH='element kind 0-general,1-pipe,2-tank,4-heat exch.' CASE(LOCXX) TXTH='nodal coordinates X' CASE(LOCYY) TXTH='nodal coordinates Y' CASE(LOCKIND) TXTH='Kind of node in element 1-vertex, 2-side, 3-center' CASE(LOCLPU) TXTH='Lpu(i)+j pointer to j-th DOF in node i' CASE(LOCMPU) TXTH='number of DOF in a node' CASE(LOCIPU) TXTH='IPU(lpu(i)+j) status of DOF (<0 fixed, >0 load)' CASE(LOCJPU) TXTH='JPU(lpu(i)+j) type of DOF (1-TEMP,2-UX,...)' CASE(LOCVAL) TXTH='V1(lpu(i)+j) j-th DOF of i-th node (input values)' CASE(LOCV2) TXTH='V2(lpu(i)+j) j-th DOF of i-th node (results)' CASE(LOCV3) TXTH='V1(lpu(i)+j) j-th DOF of i-th node (initial cond.)' CASE(LOCPTX) TXTH='point coordinate x' CASE(LOCPTY) TXTH='point coordinate y' CASE(LOCNEAR) TXTH='nearest NODE to a point' CASE(LOCRANGE) TXTH='DOF-Minimum values of all DOFs (command RANGE)' CASE(LOCRESI) TXTH='Abs.values of DOF differences (iterat.termination)' CASE(LOCMEAN) TXTH='Mean values of DOF''s (calculated by RANGE)' CASE(LOCMFUN) TXTH='number of functions (var.propert.,bound.cond...)' CASE(LOCMTAB) TXTH='number of tables (var.properties.,bound.cond...)' CASE(LOCMVAL) TXTH='C(i) concentration in i-th vessel (lump.par.model)' CASE(LOCMDER) TXTH='DC(i) time derivative of C(i) ' CASE(LOCMETHOD) TXTH='solution of eqs. by 0-Euler,1-Runge Kutta' CASE(LOCNEQUAT) TXTH='number of equations and unknowns cm(1),...cm(neq)' CASE(LOCPMOD) TXTH='lumped model parameters' CASE(LOCNUMODP) TXTH='number of lumped model parameters PM(1),...' CASE(LOCRMOD) TXTH='lumped model parameters relaxation factor WM(1),..' CASE(LOCZMINP) TXTH='lumped model parameters lower bounds' CASE(LOCZMAXP) TXTH='lumped model parameters upper bounds' CASE(LOCLMOD) TXTH='association of parameter PM to a variable in FEM' CASE(LOCKMOD) TXTH='regression parameter identification (=1)' CASE(LOCNINPUTS) TXTH='number of stimulus functions xvt(i,t) for a model' CASE(LOCMINPUTS) TXTH='index of curve describing i-th stimulus xvt(i,t)' CASE(LOCXINPUTS) TXTH='actual value of i-th stimulus functions xv(i)' CASE(LOCNOUTPUTS) TXTH='number of recorded responses yvt(i,t) of model' CASE(LOCMOUTPUTS) TXTH='index of curve describing i-th response yvt(i,t)' CASE(LOCYOUTPUTS) TXTH='actual value of i-th response functions yv(i)' CASE(LOCTG1) TXTH='time values of curve (nodal history,experiment...)' CASE(LOCYG1) TXTH='values of curve (nodal history, experiment,...)' CASE(LOCNGR) TXTH='number of points of a curve (no.of time steps)' CASE(LOCINDG) TXTH='correponding node(1),exper.(2),inlet(3),outlet(4)' CASE(LOCIQGR) TXTH='time course: 1-FEM,2-experiment,3-inlet,4-outlet' CASE(LOCDTGR) TXTH='time steps (curves). <0 non.equidistant points.'
CASE(LOCNEXPERI) TXTH='number of experimental curves' CASE(LOCMEXPERI) TXTH='indices of experimental curves' CASE(LOCNMODELS) TXTH='number of interpreted models defined in ext.files' CASE(LOCKCOMPAR) TXTH='criterion for TC comparison 0-sum,...4-integral...' CASE(LOCSCOMPAR) TXTH='norm of TC differences' CASE(LOCNCOMPAR) TXTH='number of pairs of compared TC curves' CASE(LOCICOMPAR) TXTH='indices of compared curves...' CASE DEFAULT IENDH=0 TXTH=' ' END SELECT END
36
Y1=Y8(J) Y2=Y8(J1) Y3=Y8(J+4) DO I=1,11 R=RG(I) XG(I)=X1*R*(R-1)/2.+X2*R*(R+1)/2.+X3*(1-R**2) YG(I)=Y1*R*(R-1)/2.+Y2*R*(R+1)/2.+Y3*(1-R**2) ENDDO CALL GMFPL(11,XG,YG,J) IF(J.LE.2)THEN CALL GMFMRK(XG(3),YG(3),25) CALL GMFTEXT(XG(3),YG(3),J,2,LABEL(J)) ENDIF ENDDO ELSE CALL GMFPLC(4,X8,Y8,0) DO J=1,2 CALL GMFPL(2,X8(J),Y8(J),J) CALL GMFTEXT((X8(J)+X8(J+1))/2,(Y8(J)+Y8(J+1))/2, / J,2,LABEL(J)) CALL GMFMRK(X8(J)+(X8(J+1)-X8(J))*.2, / Y8(J)+(Y8(J+1)-Y8(J))*.2,25) ENDDO ENDIF CALL GMFSW(1) END
C $s1-plot SUBROUTINE CLEARPLOT INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ ND$=0 EL$=0 TC$=0 PT$=0 CR$=0 SF$=0 END
C C
SUBROUTINE PLOTSF(K,ICOL,KSF) INCLUDE '$fem' INCLUDE '$gmf' INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ DIMENSION X8(8),Y8(8),XG(11),YG(11),RG(11) EQUIVALENCE (IACT(4),KND),(IACT(5),KEL),(IACT(6),KPT), / (IACT(7),KCR),(IACT(8),KSF) DATA RG/-1.,-.8,-.6,-.4,-.2,0.,.2,.4,.6,.8,1./ IF(K.LE.0.OR.K.GT.NSF)RETURN NPTSF=MSF(K) XA=0 YA=0 DO J=1,NPTSF IU=MAX0(1,ISF(J,K)) X8(J)=PTX(IU) Y8(J)=PTY(IU) XA=XA+X8(J)/NPTSF YA=YA+Y8(J)/NPTSF ENDDO
IF(XA.GT.FXMI.AND.XA.LE.FXMA.AND.YA.GE.FYMI.AND.XA.LE.FYMA)THEN IF(KSF.NE.0)CALL GMFTXC(XA,YA,ICOL,K) IF(NPTSF.EQ.8)THEN DO J=1,4 J1=MOD(J,4)+1 X1=X8(J) X2=X8(J1) X3=X8(J+4) Y1=Y8(J) Y2=Y8(J1) Y3=Y8(J+4) DO I=1,11 R=RG(I) XG(I)=X1*R*(R-1)/2.+X2*R*(R+1)/2.+X3*(1-R**2) YG(I)=Y1*R*(R-1)/2.+Y2*R*(R+1)/2.+Y3*(1-R**2) ENDDO CALL GMFPL(11,XG,YG,ICOL) ENDDO ELSE CALL GMFPLC(4,X8,Y8,ICOL) ENDIF SF$=1 ENDIF END SUBROUTINE PLDSF(K) C Vykresleni plochy cislo K pro dialog zadavani site INCLUDE '$fem' INCLUDE '$gmf' CHARACTER *2 LABEL(4),PT DIMENSION X8(8),Y8(8),XG(11),YG(11),RG(11) DATA RG/-1.,-.8,-.6,-.4,-.2,0.,.2,.4,.6,.8,1./ DATA LABEL /'Nx','Ny','Nx','Ny'/ IF(K.LE.0.OR.K.GT.NSF)RETURN NPTSF=MSF(K) XA=0 YA=0 XMI=1E10 YMI=1E10 XMA=-1E10 YMA=-1E10 DO J=1,NPTSF IU=MAX0(1,ISF(J,K)) X8(J)=PTX(IU) Y8(J)=PTY(IU) XA=XA+X8(J)/NPTSF YA=YA+Y8(J)/NPTSF XMI=AMIN1(XMI,X8(J)) YMI=AMIN1(YMI,Y8(J)) XMA=AMAX1(XMA,X8(J)) YMA=AMAX1(YMA,Y8(J)) ENDDO DX=(XMA-XMI)*.1 DY=(YMA-YMI)*.1 CALL GMFSTW(3,1,21,5,12,'X','Y',0.,1.,0.,1., / XMI-DX,XMA+DX,YMI-DY,YMA+DY) CALL GMFAXE(3,7,15) CALL GMFFONT(1,16) CALL GMFTXC(XA,YA,1,K) DO J=1,NPTSF CALL GMFMRK(X8(J),Y8(J),40) WRITE(PT,'(''P'',I1)')J CALL GMFTEXT(X8(J),Y8(J),0,2,PT) ENDDO IF(NPTSF.EQ.8)THEN DO J=1,4 J1=MOD(J,4)+1 X1=X8(J) X2=X8(J1) X3=X8(J+4)
C C
SUBROUTINE PLOTCR(K,ICOL,KCR) INCLUDE '$fem' INCLUDE '$gmf' INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ DIMENSION X3(3),Y3(3),XG(11),YG(11),RG(11) EQUIVALENCE (IACT(4),KND),(IACT(5),KEL),(IACT(6),KPT), / (IACT(7),KCR),(IACT(8),KSF) DATA RG/-1.,-.8,-.6,-.4,-.2,0.,.2,.4,.6,.8,1./ IF(K.LE.0.OR.K.GT.NCR)RETURN NPTCR=MCR(K) XA=0 YA=0 DO J=1,NPTCR IU=MAX0(1,ICR(J,K)) X3(J)=PTX(IU) Y3(J)=PTY(IU) XA=XA+X3(J)/NPTCR YA=YA+Y3(J)/NPTCR ENDDO
IF(XA.GT.FXMI.AND.XA.LE.FXMA.AND.YA.GE.FYMI.AND.XA.LE.FYMA)THEN IF(NPTCR.EQ.3)THEN DO I=1,11 R=RG(I) XG(I)=X3(1)*R*(R-1)/2.+X3(2)*R*(R+1)/2.+X3(3)*(1-R**2) YG(I)=Y3(1)*R*(R-1)/2.+Y3(2)*R*(R+1)/2.+Y3(3)*(1-R**2) ENDDO CALL GMFPL(11,XG,YG,ICOL) CALL GMFMRK(XG(2),YG(2),35) ELSE CALL GMFPL(2,X3,Y3,ICOL) CALL GMFMRK(X3(1)+.1*(X3(2)-X3(1)),Y3(1)+.1*(Y3(2)Y3(1)),35) ENDIF IF(KCR.NE.0)CALL GMFTXC(XA,YA,ICOL,K) CR$=1 ENDIF END SUBROUTINE PLDCR(K) INCLUDE '$fem' INCLUDE '$gmf' CHARACTER *2 PT DIMENSION X3(3),Y3(3),XG(11),YG(11),RG(11) DATA RG/-1.,-.8,-.6,-.4,-.2,0.,.2,.4,.6,.8,1./ IF(K.LE.0.OR.K.GT.NCR)RETURN NPTCR=MCR(K) XA=0 YA=0 XMI=1E10 YMI=1E10 XMA=-1E10 YMA=-1E10 DO J=1,NPTCR IU=MAX0(1,ICR(J,K)) X3(J)=PTX(IU) Y3(J)=PTY(IU) XA=XA+X3(J)/NPTCR YA=YA+Y3(J)/NPTCR XMI=AMIN1(XMI,X3(J)) YMI=AMIN1(YMI,Y3(J)) XMA=AMAX1(XMA,X3(J)) YMA=AMAX1(YMA,Y3(J)) ENDDO DX=AMAX1(0.01,(XMA-XMI)*.1) DY=AMAX1(0.01,(YMA-YMI)*.1) CALL GMFSTW(3,1,21,5,12,'X','Y',0.,1.,0.,1., / XMI-DX,XMA+DX,YMI-DY,YMA+DY) CALL GMFAXE(3,7,15) CALL GMFFONT(1,16) CALL GMFTXC(XA,YA,1,K) DO J=1,NPTCR CALL GMFMRK(X3(J),Y3(J),40) WRITE(PT,'(''P'',I1)')J CALL GMFTEXT(X3(J),Y3(J),0,2,PT) ENDDO IF(NPTCR.EQ.3)THEN DO I=1,11 R=RG(I)
37
XG(I)=X3(1)*R*(R-1)/2.+X3(2)*R*(R+1)/2.+X3(3)*(1-R**2) YG(I)=Y3(1)*R*(R-1)/2.+Y3(2)*R*(R+1)/2.+Y3(3)*(1-R**2) ENDDO CALL GMFPL(11,XG,YG,ICOL) CALL GMFMRK(XG(3),YG(3),25) ELSE
LOC=LPU(IU) DO I=1,MPU(IU) IF(JPU(LOC+I).EQ.IPX)XX(IU)=XX(IU)+VAL(LOC+I,2)*SCL IF(JPU(LOC+I).EQ.IPY)YY(IU)=YY(IU)+VAL(LOC+I,2)*SCL ENDDO ENDDO DO IE=1,NE CALL PLOTEL(IE,ICOL) ENDDO DO IU=1,ND LOC=LPU(IU) DO I=1,MPU(IU) IF(JPU(LOC+I).EQ.IPX)XX(IU)=XX(IU)-VAL(LOC+I,2)*SCL IF(JPU(LOC+I).EQ.IPY)YY(IU)=YY(IU)-VAL(LOC+I,2)*SCL ENDDO ENDDO END
CALL GMFPL(2,X3,Y3,ICOL) CALL GMFMRK(X3(1)+.2*(X3(2)-X3(1)),Y3(1)+.2*(Y3(2)-
Y3(1)),25) ENDIF CALL GMFSW(1) END SUBROUTINE DRAWE(K) C C Vykresleni vsech entit typu K=1 PT, K=2 CR, K=3 SF pro dialog C INCLUDE '$fem' XMI=1E10 YMI=1E10 XMA=-1E10 YMA=-1E10 DO J=1,NPT XMI=AMIN1(XMI,PTX(J)) YMI=AMIN1(YMI,PTY(J)) XMA=AMAX1(XMA,PTX(J)) YMA=AMAX1(YMA,PTY(J)) ENDDO DX=(XMA-XMI)*.15 DY=(YMA-YMI)*.15 CALL GMFSTW(3,1,21,5,12,'X','Y',0.,1.,0.,1., / XMI-DX,XMA+DX,YMI-DY,YMA+DY) CALL GMFAXE(3,7,15) CALL GMFFONT(1,16) SELECT CASE(K) CASE(1) DO I=1,NPT CALL GMFMRKL(PTX(I),PTY(I),37,I,2) ENDDO DO I=1,NCR CALL PLOTCR(I,2,0) ENDDO CASE(2) DO I=1,NCR CALL PLOTCR(I,2,1) ENDDO CASE(3) DO I=1,NSF CALL PLOTSF(I,2,1) ENDDO END SELECT CALL GMFSW(1) END SUBROUTINE DEFPLOT(IPX,IPY,ICOL) C C Vykresleni deformovane konstrukce. C 1. Pricteni prirustku uzlovych parametru IPX,IPY k souradnicim uzlu C Meritko je promenna vektoru RALGOR(8). C 2. Vykresleni vsech elementu C 3. Regenerace puvodnich souradnic C C Pokud je RALGOR(8), meritko SCL, rovno nule, pocita se minimalni C a maximalni UX,UY,X,Y a meritko se dle toho nastavi C INCLUDE '$FEM' SCL=RALGOR(8) IF(SCL.EQ.0.)THEN UXMIN=1E10 UYMIN=1E10 UXMAX=-1E10 UYMAX=-1E10 XMIN=1E10 YMIN=1E10 XMAX=-1E10 YMAX=-1E10 DO IU=1,ND XMIN=AMIN1(XMIN,XX(IU)) YMIN=AMIN1(YMIN,YY(IU)) XMAX=AMAX1(XMAX,XX(IU)) YMAX=AMAX1(YMAX,YY(IU)) LOC=LPU(IU) DO I=1,MPU(IU) IF(JPU(LOC+I).EQ.IPX)DX=VAL(LOC+I,2) IF(JPU(LOC+I).EQ.IPY)DY=VAL(LOC+I,2) ENDDO UXMIN=AMIN1(UXMIN,DX) UYMIN=AMIN1(UYMIN,DY) UXMAX=AMAX1(UXMAX,DX) UYMAX=AMAX1(UYMAX,DY) ENDDO DUX=UXMAX-UXMIN DUY=UYMAX-UYMIN IF(DUX.LE.0.)THEN SCLX=0 ELSE SCLX=0.05*(XMAX-XMIN)/DUX ENDIF IF(DUY.LE.0.)THEN SCLY=0 ELSE SCLY=0.05*(YMAX-YMIN)/DUY ENDIF SCL=AMAX1(SCLX,SCLY) ENDIF DO IU=1,ND
C C C
C
SUBROUTINE PLOTEL(IE,ICOL) INCLUDE '$fem' INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ DIMENSION X8(8),Y8(8) EQUIVALENCE (IACT(4),KND),(IACT(5),KEL),(IACT(6),KPT), / (IACT(7),KCR),(IACT(8),KSF) IF(IE.LE.0.OR.IE.GT.NE)RETURN NUG=IABS(MUE(IE)) IF(MUE(IE).LT.0)NUG=NUG-1 L0=LUE(IE) IF(NUG.LE.4)THEN DO J=1,NUG IU=IABS(IUE(L0+J)) X8(J)=XX(IU) Y8(J)=YY(IU) ENDDO ELSE NUM=NUG/2 K=0 DO J=1,NUM IU=IABS(IUE(L0+J)) K=K+1 X8(K)=XX(IU) Y8(K)=YY(IU) IU=IABS(IUE(L0+J+NUM)) K=K+1 X8(K)=XX(IU) Y8(K)=YY(IU) ENDDO ENDIF CALL GMFPLC(NUG,X8,Y8,ICOL) XA=0 YA=0 DO J=1,NUG IU=IABS(IUE(L0+J)) XA=XA+XX(IU) YA=YA+YY(IU) ENDDO XT=XA/NUG YT=YA/NUG SELECT CASE(NAMELE(IE)) CASE(1) PIPE IE,IHEIGHT,ICOL,IDOF,VMIN,VMAX,IVMIN,IVMAX CALL GPIPE(IE,1,0,12,VMIN,VMAX,0,500) CASE(2) CSTR DX=X8(2)-X8(1) DY=Y8(2)-Y8(1) H=AMAX1(DX,DY)*.4 CALL PLOTMIX(XT,YT,H,H) CASE(4) HEXC CALL GMFPLC(3,X8,Y8,0) CALL GMFPLC(3,X8(2),Y8(2),0) END SELECT IF(KEL.NE.0)THEN CALL GMFTXC(XT,YT,3,IE) ENDIF EL$=1 END
SUBROUTINE PLOTMIX(XT,YT,HX,HY) C Vykresleni ikonky mixeru DIMENSION XG(7),YG(7) XG(1)=XT-HX XG(2)=XT+HX XG(3)=XT+HX XG(4)=XT-HX YG(1)=YT-HY YG(2)=YT-HY YG(3)=YT+HY YG(4)=YT+HY CALL GMFPLC(4,XG,YG,1) CALL GMFILL(XT,YT,11,1) CALL GMFPLC(4,XG,YG,0) XG(1)=XT YG(1)=YT+1.2*HY XG(2)=XT YG(2)=YT XG(3)=XT-0.8*HX YG(3)=YT+0.2*HY XG(4)=XG(3) YG(4)=YT-0.2*HY XG(5)=XT+0.8*HX YG(5)=YT+0.2*HY XG(6)=XG(5) YG(6)=YT-0.2*HY
38
XG(7)=XT YG(7)=YT CALL GMFPL(7,XG,YG,0) END SUBROUTINE PLOTARR(X1,Y1,X2,Y2) C Usecka zakoncena sipkou DIMENSION X(3),Y(3) X(1)=X1 Y(1)=Y1 X(2)=X2 Y(2)=Y2 CALL GMFPL(2,X,Y,0) IF(X1.NE.X2)THEN C vodorovna X(1)=X(2)-SIGN(2.2,X2-X1) Y(1)=Y(2)+1.1 X(3)=X(1) Y(3)=Y(2)-1.1 ELSE C svisla X(1)=X(2)-1.1 X(3)=X(2)+1.1 Y(1)=Y(2)-SIGN(2.0,Y2-Y1) Y(3)=Y(1) ENDIF XT=0 YT=0 DO I=1,3 XT=XT+X(I) YT=YT+Y(I) ENDDO CALL GMFPLC(3,X,Y,1) CALL GMFILL(XT/3.,YT/3.,11,1) CALL GMFPLC(3,X,Y,0) END SUBROUTINE PLOTSER(ITYP,X1,Y1,X2,Y2,N,HH,HV) C C Ikona serie N-misicu. Velikost HH-HORIZONTALNI, HV-VERTIKALNI C ITYP=0 serie C =1 serie se zpetnym promichavanim C IF(N.GT.0)THEN D=SQRT((X2-X1)**2+(Y2-Y1)**2) CALL PLOTARR(X1,Y1,X2,Y2) T0=D*(0.02-0.45/N) DT=D*0.9/N DO I=1,N T=T0+I*DT IF(X1.NE.X2)THEN CALL PLOTMIX(X1+T,Y1,HH,HV) IF(ITYP.EQ.1.AND.I.GT.1)CALL PLOTARR / (X1+T-HH,Y2+HV/2,X1+T-DT+HH,Y2+HV/2) ELSEIF(Y1.NE.Y2)THEN CALL PLOTMIX(X1,Y1+T,HH,HV) ENDIF ENDDO ENDIF END
C C C C C C C C C C C C C C C
C C C C C
SUBROUTINE PLOTMOD(ITYP,N1,N2,VOLRAT) USE MSFLIB IKONA MODELU ITYP =1 serie N1 misicu =2 paralelni serie N1,N2 misicu =3 serie se zpetnym promichavanim N1,N2 pocet prvku serie VOLRAT pomer objemu V1/V2 Lokalni promenne ITE =0 usecka =1 serie =2 backmixing =3 pistovy tok NMX parametr elementu (pocet misicu) HVE vertikalni rozmer PARAMETER (MAXP=14,MAXE=10) DIMENSION PX(MAXP),PY(MAXP), / IE1(MAXE),IE2(MAXE),ITE(MAXE),NMX(MAXE),HVE(MAXE) DATA PX,PY/ / 1.,10.,90.,99.,10.,90.,10.,90.,20.,80.,20.,80.,20.,80., /50.,50.,50.,50.,30.,30.,70.,70.,30.,30.,50.,50.,70.,70./ 1
7 2 5
13 11 9
14 12 10
8 3 6
4
CALL GMFSTW(2,1,21,5,12,'t','Y',0.,1.,0.,1.,0.,100.,0.,100.) CALL GMFSW(2) II=SETBKCOLOR(3) CALL CLEARSCREEN($GCLEARSCREEN) ITE=0 NMX=0 HVE=0. SELECT CASE(ITYP) CASE(1) C SERIE N1 WRITE(21,'('' Series of'',i3,'' ideally mixed tanks'')')N1 NE=1 IE1(1)=1 IE2(1)=4 ITE(1)=1 NMX(1)=N1 HVE(1)=10. CASE(2)
C PARALELNI SERIE WRITE(21,'('' Two parallel series of'',i3,'' and '',i3,'' mixed /tanks''/'' Volume ratio='',f9.3)')N1,N2,VOLRAT NE=8 IE1(1:8)=(/1,2,2,5,7,6,8,3/) IE2(1:8)=(/2,7,5,6,8,3,3,4/) ITE(4:5)=(/1,1/) NMX(4:5)=(/N1,N2/) H2=10./(1.+(VOLRAT*N2)/N1) H1=AMAX1(1.,10.-H2) HVE(4:5)=(/H1,H2/) CASE(3) C SERIE SE ZPETNYM PROMICHAVANIM WRITE(21,'('' Series of'',i3,'' mixed tanks with backmixing'')') /N1 NE=1 IE1(1)=1 IE2(1)=4 ITE(1)=2 NMX(1)=N1 HVE(1)=15. END SELECT C Vykresleni elementu. HH/HV -horizontalni/vertikalni vyska HH=AMIN1(17.,30./MAX0(N1,N2)) DO I=1,NE I1=IE1(I) I2=IE2(I) HV=HVE(I) IF(I1.GE.1.AND.I2.GE.1.AND.I1.LE.8.AND.I2.LE.8)THEN SELECT CASE(ITE(I)) CASE(0) CALL PLOTARR(PX(I1),PY(I1),PX(I2),PY(I2)) CASE(1) CALL PLOTSER(0,PX(I1),PY(I1),PX(I2),PY(I2),NMX(I),HH,HV) CASE(2) CALL PLOTSER(1,PX(I1),PY(I1),PX(I2),PY(I2),NMX(I),HH,HV) END SELECT ENDIF ENDDO CALL GMFSW(1) END SUBROUTINE PLOTAL USE MSFLIB C Vykresleni vsech elementu a krivek INCLUDE '$FEM' INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ C IACT (KGROUP,KMAT,KRCONS,KND,KEL,KPT) - priznak cislovani entit EQUIVALENCE (IACT(1),KGROUP),(IACT(2),KMAT),(IACT(3),KRCONS), / (IACT(4),KND),(IACT(5),KEL),(IACT(6),KPT), / (IACT(7),KCR),(IACT(8),KSF) II=SETACTIVEQQ(20) IF(EL$.NE.0)THEN DO I=1,NE CALL PLOTEL(I,KEL) ENDDO ENDIF IF(CR$.NE.0)THEN DO I=1,NCR CALL PLOTCR(I,2,KCR) ENDDO ENDIF IF(ND$.NE.0)THEN DO I=1,ND CALL GMFMRKL(XX(I),YY(I),30,I,KND) ENDDO ENDIF IF(PT$.NE.0)THEN DO I=1,NPT CALL GMFMRKL(PTX(I),PTY(I),27,I,KPT) ENDDO ENDIF IF(TC$.NE.0)THEN DO I=1,MAXSEL IF(NGR(I).GT.1)CALL GMFPL(NGR(I),TGR(1,I),YGR(1,I),I) ENDDO ENDIF END SUBROUTINE GMFMRKL(X,Y,ISYM,INUM,INU) INCLUDE '$gmf' IF(X.GT.FXMI.AND.X.LE.FXMA.AND.Y.GE.FYMI.AND.Y.LE.FYMA)THEN IF(INU.NE.0)CALL GMFTXI(X,Y,0,INUM) CALL GMFMRK(X,Y,ISYM) ENDIF END SUBROUTINE GMFTXI(XT,YT,ICOL,IND) C C ZOBRAZENI INDEXU IND VPRAVO OD BODU XT,YT BARVOU ICOL C INCLUDE '$gmf' CHARACTER *4 CIND C C VELIKOST OKENKA DLE POCTU CISLIC IND C SELECT CASE(IND) CASE(0:9) DX=SNGL((WXMA-WXMI)/75) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I1)')IND
39
ID=1 CASE(10:99) DX=SNGL((WXMA-WXMI)/40) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I2)')IND ID=2 CASE(100:999) DX=SNGL((WXMA-WXMI)/25) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I3)')IND ID=3 CASE DEFAULT DX=SNGL((WXMA-WXMI)/22) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I4)')IND ID=4 END SELECT X=XT+SNGL((WXMA-WXMI)/100) Y=YT+SNGL((WYMA-WYMI)/50) CALL GMFREC(X,X+DX,Y,Y-DY,8) CALL GMFILL(X+DX/2,Y-DY/2,15,8) CALL GMFREC(X,X+DX,Y,Y-DY,15) CALL GMFTEXT(X,Y,ICOL,ID,CIND) END SUBROUTINE GMFTXC(XT,YT,ICOL,IND) C C ZOBRAZENI INDEXU IND S CENTREM XT,YT BARVOU ICOL C INCLUDE '$gmf' CHARACTER *4 CIND C C VELIKOST OKENKA DLE POCTU CISLIC IND C SELECT CASE(IND) CASE(0:9) DX=SNGL((WXMA-WXMI)/75) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I1)')IND ID=1 CASE(10:99) DX=SNGL((WXMA-WXMI)/40) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I2)')IND ID=2 CASE(100:999) DX=SNGL((WXMA-WXMI)/25) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I3)')IND ID=3 CASE DEFAULT DX=SNGL((WXMA-WXMI)/22) DY=SNGL((WYMA-WYMI)/32) WRITE(CIND,'(I4)')IND ID=4 END SELECT X=XT-DX/2. Y=YT+SNGL((WYMA-WYMI)/50) CALL GMFREC(X,X+DX,Y,Y-DY,8) CALL GMFILL(X+DX/2,Y-DY/2,15,8) CALL GMFREC(X,X+DX,Y,Y-DY,15) CALL GMFTEXT(X,Y,ICOL,ID,CIND) END SUBROUTINE GPIPE(IE,IHEIGH,ICOL,IDOF,VMIN,VMAX,IVMIN,IVMAX) C C Vykresleni obrysu elementu typu usecka barvou ICOL. Obrys je obdelnik C se zkosenymi stranami dle navazujicich elementu, pricemz tloustka obdelniku C je urcena parametrem IHEIGHT = 0 (mala), 1 (stredni),... C Vnitrek obrysu je vytonovan barvou dle hodnoty uzlovych parametru IDOF v C uzlech elementu. VMIN,VMAX je rozsah hodnot parametru, kteremu jsou prirazeny C barvy IVMIN,IVMAX (povoleny rozsah 0 az 2850) C DIMENSION X(6),Y(6),IU(2),V(2),VG(3),XG(3),YG(3),ISX(3,4),ISV(3,4) INCLUDE '$FEM' INCLUDE '$gmf' C ROZKLAD NA 4 TROJUHELNIKY (KAZDY TROJUHELNI KE SLOUPEC MATIC ISI,ISV C 1 2 (1) 6 (2), 2 3 (1) 4 (2), 4 5 (2) 2 (1), 5 6 (2) 2 (1) DATA ISX /1,2,6, 2,3,4, 4,5,2, 5,6,2/ DATA ISV /1,1,2, 1,1,2, 2,2,1, 2,2,1/ C PREVOD DO NORMALIZOVANYCH SOURADNIC 0-1 XXW(I)=(XX(I)-WXMI)/(WXMA-WXMI) YYW(I)=(YY(I)-WYMI)/(WYMA-WYMI) C ZPETNA TRANSFORMACE XXR(A)=WXMI+A*(WXMA-WXMI) YYR(A)=WYMI+A*(WYMA-WYMI) C Tloustka obdelniku V NORMALIZOVANYCH SOURADNICICH H=0.01*IHEIGH C Indexy uzlu elementu LOC=LUE(IE) DO J=1,2 IU(J)=IABS(IUE(LOC+J)) ENDDO RI=SQRT((XXW(IU(2))-XXW(IU(1)))**2+(YYW(IU(2))-YYW(IU(1)))**2) C HLEDANI NAVAZUJICI ELEMENTU C UVAZUJEME KONFIGURACI TRI UZLU 1 - 2 (ELEMENT IE) 2 - 3 (NAVAZUJICI JE) DO IEND=1,2 I1=IU(IEND) I2=IU(MOD(IEND,2)+1) COSI=(XXW(I2)-XXW(I1))/RI
SINI=(YYW(I2)-YYW(I1))/RI C HLEDANI NAVAZUJICI ELEMENTU V UZLU I2 C Prohledani matice konektivity: vsechny dvouuzlove elementy (s vyjimkou IE), C v nichz se vyskytuje uzel I2 (uzel I1 slouzi jen k urceni smeru elementu IE) DETMAX=-1e6 DETMIN=1e6 DO JE=1,NE IF(MUE(JE).EQ.2.AND.JE.NE.IE)THEN LOCJ=LUE(JE) I3=IABS(IUE(LOCJ+1)) I4=IABS(IUE(LOCJ+2)) IF(I3.EQ.I2.OR.I4.EQ.I2)THEN C Element JE navazuje v uzlu I2 na element IE. IF(I3.EQ.I2)I3=I4 RJ=SQRT((XXW(I3)-XXW(I2))**2+(YYW(I3)-YYW(I2))**2) COSJ=(XXW(I3)-XXW(I2))/RJ SINJ=(YYW(I3)-YYW(I2))/RJ C VYPOCET DVOU PRUSECIKU PARALELNICH PRIMEK (H +-) DET=-COSI*SINJ+SINI*COSJ IF(DET.GT.DETMAX)THEN DETMAX=DET COSMAX=COSJ SINMAX=SINJ ENDIF IF(DET.LE.DETMIN)THEN DETMIN=DET COSMIN=COSJ SINMIN=SINJ ENDIF ENDIF ENDIF ENDDO C C Probehlo zpracovani vsech elementu. Pokud zadny neni je DETMIN>DETMAX, C pokud je to primka plati DETMIN=DETMAX=0, jinak se jedna o zmenu smeru. C V kazdem pripade musime vygenerovat dvojici bodu: T1,T2 C IF(ABS(DETMAX).LT.1E-4)THEN T1=0 ELSE C + H ODPOVIDA HODNOTE DETMAX T1=-H*((SINMAX-SINI)*SINMAX-(COSI-COSMAX)*COSMAX)/DETMAX ENDIF IF(ABS(DETMIN).LT.1E-4)THEN T2=0 ELSE C - H ODPOVIDA HODNOTE DETMIN T2= H*((SINMIN-SINI)*SINMIN-(COSI-COSMIN)*COSMIN)/DETMIN ENDIF X(3*IEND-2)=XXR(XXW(I2)+H*SINI+COSI*T1) Y(3*IEND-2)=YYR(YYW(I2)-H*COSI+SINI*T1) X(3*IEND)=XXR(XXW(I2)-H*SINI+COSI*T2) Y(3*IEND)=YYR(YYW(I2)+H*COSI+SINI*T2) X(3*IEND-1)=XX(I2) Y(3*IEND-1)=YY(I2) C UZLOVE PARAMETRY LOCU=LPU(I2) DO J=1,MPU(I2) IF(JPU(LOCU+J).EQ.IDOF)V(IEND)=VAL(LOCU+J,2) ENDDO ENDDO CALL GMFPLC(6,X,Y,ICOL) C VYTONOVANI HODNOTAMI UZLOVEHO PARAMETRU. V(1,2) JSOU VYBRANE UZLOVE HODNOTY. C ROZKLAD NA 4 TROJUHELNIKY C 1 2 (1) 6 (2), 2 3 (1) 4 (2), 4 5 (2) 2 (1), 5 6 (2) 2 (1) DO IT=1,4 DO IV=1,3 XG(IV)=X(ISX(IV,IT)) YG(IV)=Y(ISX(IV,IT)) VG(IV)=V(ISV(IV,IT)) ENDDO C VYTONOVANI CALL GMFCTR(VG,XG,YG,VMIN,VMAX,IVMIN,IVMAX) ENDDO END SUBROUTINE GFND(XC,YC,VALUE,IHEIG) C C C C C C C
Vykresleni znacky v bode Xc,Yc (teziste) Vykresli se kolecko se segmentem odpovidajicim VALUE VALUE relativni hodnota v intervalu 0,1 IHEIG relativni velikost znacky =0 mala, 1-stredni DIMENSION XG(32),YG(32) INCLUDE '$gmf'
DR=0.01*(IHEIG+1) C Budik v normalizovanych souradnicich DO I=1,28 FI=(I-1)*3.141/14 XG(I)=DR*SIN(FI) YG(I)=DR*COS(FI) ENDDO XG(29)=XG(1) YG(29)=YG(1) XG(30)=0 YG(30)=0 FI=6.282*VALUE DO I=1,2 DR=DR/I FI=FI/I
40
XG(30+I)=DR*SIN(FI) YG(30+I)=DR*COS(FI) ENDDO C Prevod do uzivatelskych souradnic DO I=1,32 XG(I)=XC+XG(I)*(WXMA-WXMI) YG(I)=YC+YG(I)*(WYMA-WYMI)*1.4 ENDDO CALL GMFPL(29,XG,YG,8) CALL GMFILL(XC,YC,15,8) CALL GMFPL(31,XG,YG,0) C FILL jen kdyz je FI>0 IF(FI.GT.0.)CALL GMFILL(XG(32),YG(32),11,0) CALL GMFMRK(XC,YC,56) END SUBROUTINE GRAFTC(ICNTR,IGRAF1) C Vykresleni TC krivek do maleho okna 21. C ICNTR=0 vsechny krivky C =1 jen krivku IGRAF1 C =2 jen krivky typu IGRAF1 (typ je dan vektorem IQGR()) INCLUDE '$FEM' INTEGER EL$,TC$,PT$,CR$,SF$ COMMON /$PLOT/ND$,EL$,TC$,PT$,CR$,SF$ C Stanoveni meritka YMINI=1E10 YMAXI=-1E10 TMAXI=0 DO IGRAF=1,MAXSEL IF(ICNTR.EQ.0.OR.(ICNTR.EQ.1.AND.IGRAF.EQ.IGRAF1) / .OR.(ICNTR.EQ.2.AND.IQGR(IGRAF).EQ.IGRAF1))THEN IF(NGR(IGRAF).GT.1)THEN DO I=1,NGR(IGRAF) YMINI=AMIN1(YMINI,YGR(I,IGRAF)) YMAXI=AMAX1(YMAXI,YGR(I,IGRAF)) IF(ABS(YGR(I,IGRAF)).GT.1E-5)THEN IF(DTGR(IGRAF).GT.0.)THEN TMAXI=AMAX1(TMAXI,DTGR(IGRAF)*I) ELSE TMAXI=AMAX1(TMAXI,TGR(I,IGRAF)) ENDIF ENDIF ENDDO ENDIF ENDIF ENDDO C Aktivace YMAXI=YMAXI+0.02*(YMAXI-YMINI) IF(TMAXI.GT.0.0.AND.YMINI.LT.YMAXI)THEN CALL GMFSTW(2,1,21,5,14,'t','Y',0.,1.,0.,1., / 0.,TMAXI,YMINI,YMAXI) CALL GMFAXE(2,3,15) DO IGRAF=1,MAXSEL IF(ICNTR.EQ.0.OR.(ICNTR.EQ.1.AND.IGRAF.EQ.IGRAF1) / .OR.(ICNTR.EQ.2.AND.IQGR(IGRAF).EQ.IGRAF1))THEN IF(NGR(IGRAF).GT.1)THEN CALL GMFPL(NGR(IGRAF),TGR(1,IGRAF),YGR(1,IGRAF),IGRAF) C Vyhledej maximum a oznac bod cislem krivky IM=1 YM=0 DO I=1,NGR(IGRAF) IF(YGR(I,IGRAF).GT.YM)THEN IM=I YM=YGR(I,IGRAF) ENDIF ENDDO CALL GMFMRKL(TGR(IM,IGRAF),YGR(IM,IGRAF),30,IGRAF,1) TC$=1 ENDIF ENDIF ENDDO ENDIF END
41
C $s2-init SUBROUTINE INIT C FINITE ELEMENTS DATABASE C GEOMETRY DATABASE INCLUDE '$femloc' C Vynulovani priznaku kresleni entit CALL CLEARPLOT C Kompletni vymazani ciselne casti databaze DO I=1,LOCNEXCOM-1 INTERC(I)=0 ENDDO JEPA=1 C Egroup RCgroup MPgroup IACT(1:3)=1 C Pt,Cr,Sf numbering IACT(6:8)=1 C All elements are groups 1 (EL,RC,MP) IGROUP=1 IRCONS=1 IMAT=1 RCONST(1,1)=1. RMAT(1,1)=0.6 RMAT(1,2)=4200. RMAT(1,3)=998. RMAT(1,4)=0.04 RMAT(1,5)=2.1E11 RMAT(1,6)=0.28 RMAT(1,7)=0.001 C IALGOR: IALGOR(1)=1 IALGOR(2)=1 IALGOR(12)=1 IALGOR(16)=1 C RALGOR: RUPW=1 GX=9.81 PENFAKT=1E7 EPSPIV=1E-12 TOL=0.002 DO I=11,20 RALGOR(I)=1E-5 ENDDO CALL ANASET(6) END SUBROUTINE ANASET(KANA) INCLUDE '$FEM' KANAL=KANA SELECT CASE(KANAL) CASE(1) C STRuctural 2D (UX,UY,RZ) JEPA=4 C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/3,2,0/) JKIND(1,1:3)=(/2,3,7/) JKIND(2,1:2)=(/2,3/) C mpeg-pocet atributu elementu (static, gauss, symetrie) MPEG=3 C lgroup-vyber 3-sloupcu matice atributu elementu urcujici static,gauss,symetrie LGROUP(1:3)=(/1,2,3/) C mprc-pocet realnych konstant (H,PRES,AREA) MPRC=3 LRCONS(1:3)=(/1,3,6/) C mpmp-pocet materialovych parametru (E,MI) MPMP=2 LRMAT(1:2)=(/5,6/)
LRMAT(1:9)=(/1,2,3,4,7,8,9,10,11/) CASE(4) C PSBL (TEMP,VX,VY,PRES,PS,PSX,PSY,PSXX,PSYY,PSXY) JEPA=3 C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/10,3,0/) JKIND(1,1:10)=(/1,9,10,12,14,15,16,17,18,19/) JKIND(2,1:3)=(/1,9,10/) C mpeg-pocet atributu elementu (static, gauss, symetrie) MPEG=3 LGROUP(1:3)=(/1,2,3/) C mprc-pocet realnych konstant (H) MPRC=1 LRCONS(1)=1 C mpmp-pocet materialovych parametru (KX,CP,DENS,KAPP,VISC,BETA,DN,EN,AN) MPMP=9 LRMAT(1:9)=(/1,2,3,4,7,8,9,10,11/) CASE(5) C PIPE (TEMP,VOLT,VX,PRES,CN) JEPA=2 C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/5,5,0/) JKIND(1,1:5)=(/1,8,9,12,20/) JKIND(2,1:5)=(/1,8,9,12,20/) C mpeg-pocet atributu elementu (S/T,Gauss) MPEG=2 LGROUP(1:2)=(/1,2/) C mprc-pocet realnych konstant (H,D,ALFA,TE,A,VOL,PERIM,RATIO,kS) MPRC=9 LRCONS(1:9)=(/1,2,4,5,6,7,8,9,10/) C mpmp-pocet materialovych parametru (KX,CP,DENS,KAPP,VISC,BETA,DN,EN,AN) MPMP=9 LRMAT(1:9)=(/1,2,3,4,7,8,9,10,11/) CASE(6) C full (TEMP,ux,uy,uz,rx,ry,rz,VOLT,VX,VY,VZ,PRES,OMG,PS,PSX,PSY,CN) C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/17,16,1/) JKIND(1,1:17)=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,20/) JKIND(2,1:16)=(/1,2,3,4,5,6,7,8,9,10,11,13,14,15,16,20/) JKIND(3,1)=12 C mpeg-pocet atributu elementu (static, gauss, symetrie) MPEG=3 LGROUP(1:3)=(/1,2,3/) C mprc-pocet realnych konstant (H,D,PRES,ALFA,TE,A,VOL,PERIM,RATIO,kS) MPRC=10 LRCONS(1:10)=(/1,2,3,4,5,6,7,8,9,10/) C mpmp-pocet materialovych parametru (KX,CP,DENS,KAPP,EX,MI,VISC,BETA,DN,EN,AN) MPMP=11 LRMAT(1:11)=(/1,2,3,4,5,6,7,8,9,10,11/) END SELECT END
CASE(2) C PSI (TEMP,VOLT,VX,VY,PRES,OMG,PS,PSX,PSY,CN) JEPA=3 C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/10,9,0/) JKIND(1,1:10)=(/1,8,9,10,12,13,14,15,16,20/) JKIND(2,1:9)=(/1,8,9,10,13,14,15,16,20/) C mpeg-pocet atributu elementu (static, gauss, symetrie) MPEG=3 LGROUP(1:3)=(/1,2,3/) C mprc-pocet realnych konstant (H) MPRC=1 LRCONS(1)=1 C mpmp-pocet materialovych parametru (KX,CP,DENS,KAPP,VISC,BETA,DN,EN,AN) MPMP=9 LRMAT(1:9)=(/1,2,3,4,7,8,9,10,11/) CASE(3) C UVP (TEMP,VOLT,VX,VY,VZ,PRES,CN) JEPA=3 C pocty a typy uzlovych parametru ve vrcholech a stredech stran NKIND(1:3)=(/7,6,1/) JKIND(1,1:7)=(/1,8,9,10,11,12,20/) JKIND(2,1:6)=(/1,8,9,10,11,20/) JKIND(3,1)=12 C mpeg-pocet atributu elementu (static, gauss, symetrie) MPEG=3 LGROUP(1:3)=(/1,2,3/) C mprc-pocet realnych konstant (H) MPRC=1 LRCONS(1)=1 C mpmp-pocet materialovych parametru (KX,CP,DENS,KAPP,VISC,BETA,DN,EN,AN) MPMP=9
42
C $s3-comm SUBROUTINE WRITEL(KEYWORD) C C ZAPIS TEXTU PRIKAZOVEHO RADKU DO SESSION FILU (UNIT=1) C a provedeni vykonne operace C INCLUDE '$fem' CHARACTER *(*) KEYWORD CHARACTER *(LENLIN) LINE,LINOP CHARACTER *(LENITE) ITEM LINE='' N=0 DO J=1,MAXPAR C C ODSTRANENI LEVYCH A PRAVYCH MEZER Z POLOZKY J C ITEM=TRIM(ADJUSTL(TP(J))) LITEM=LEN_TRIM(ITEM) IF(LITEM.GT.0.AND.N+LITEM.LE.LENLIN)THEN IF(N.GT.0)LINE(N:N)=',' LINE(N+1:N+LITEM)=ITEM N=N+LITEM+1 ELSE N=MAX0(1,N) IF(N.LE.LENLIN)LINE(N:N)=';' EXIT ENDIF ENDDO WRITE(1,'(A,1X,A)')KEYWORD,TRIM(LINE) IF(RECORD)THEN CALL TUPC(LENLIN,LINE,LINE) WRITE(8,'(A,1X,A)')KEYWORD,TRIM(LINE) INQUIRE(UNIT=8,NAME=FILENAM) WRITE(10,'('' Recording '',A,'' into file '',A)') / KEYWORD,FILENAM ENDIF LINOP=KEYWORD//' '//TRIM(LINE) CALL OPERAT(LINOP,1) END
300
ILINE=ILINE+1 WRITE(10,'(I3,'':'',A)')ILINE,TRIM(LINE) GOTO 3 READFI=.FALSE. BACKSPACE IUNIT END
SUBROUTINE LABINT(ITEM,NUMLAB) C C VYHLEDEJ CISLO NAVESTI ITEM C INCLUDE '$fem' CHARACTER *(*) ITEM NUMLAB=0 CALL TUPC(4,ITEM,ITEM) CALL CITEM(ITEM) DO I=1,NLABELS IF(ITEM.EQ.LABELS(I))THEN NUMLAB=I EXIT ENDIF ENDDO IF(NUMLAB.EQ.0)WRITE(10,*)' MISSING LABEL ',ITEM END SUBROUTINE SKIPE(IUNIT) C C IUNIT - cislo zarizeni, kde je interpretovany session file C SKIP COMMANDS UNTIL #E... C CHARACTER *2 LINE LINE=' ' DO WHILE(LINE.NE.'#E') READ(IUNIT,'(A)',END=100)LINE ENDDO 100 RETURN END
SUBROUTINE GOLINE(ILINE,IUNIT) C C Nastav UNIT=IUNIT na radku ILINE C REWIND IUNIT SUBROUTINE COMFIL(IUNIT,IUNCOPY,RUN) DO I=1,ILINE C READ(IUNIT,*,END=100) C ZPRACOVANI SOUBORU UNIT=IUNIT PRO INTERPRETACI PRIKAZU ENDDO C RUN=.TRUE. IDENTIFIKACE NAVESTI A CYKLU A KOPIROVANI DO SOUBORU 100 RETURN IUNCOPY END C RUN=.FALSE.PROBEHNE JEN ZPRACOVANI VSECH PRIKAZU NA IUNIT V REZIMU READFI=.FALSE. SUBROUTINE LOVARI(ICRPN,NCRPN,LLL,JJJ) C C INCLUDE '$fem' C Zjisteni pozice promenne nebo prvku vektoru v zone /FEM/ C NLABELS - pocet navesti C Vstup: C kazde navesti ma tyto charakteristiky C ICRPN vektor kodu RPN, prelozeny procedurou TRANSQ C LABELS - jmena navesti (na 4 znaky) C NCRPN delka kodu RPN C LABELINE - cislo radku v interpretovanem souboru, ktere odpovida C Kod RPN muze mit v nejjednodussim pripade nasledujici tvar: navesti C 100 3 -LLL JJJ 0 (jednoduche promenne) C LOOPMAX - pocet cyklu LOOP C 100 5 -LOCONST JJJindex -LLLVECT JJJ+2 0 (vektor s indexem C LOOPCOUNT- pocitadlo cyklu jako konstanta) C LOOPLINE - cislo radku za prikazem #LOOP C Vystup: LOGICAL RUN C LLL - pozice promenne CHARACTER *(LENLIN) LINE,ITEM*4,PROCNAME*12 C JJJ - typ promenne (=1 real,=2 integer) IF(RUN)THEN C C HLEDANI NAVESTI INCLUDE '$FEMLOC' READFI=.TRUE. INTEGER ICRPN(*) REWIND(IUNIT) COMMON /SCOM/IER,LASTINDEX,F(48) IC=0 EXTERNAL TFUW NLABELS=0 LLL=1 1 READ(IUNIT,'(A)',END=100)LINE JJJ=0 WRITE(IUNCOPY,'(A)')TRIM(LINE) IF(NCRPN.GE.5)THEN CALL TUPC(40,LINE,LINE) IF(ICRPN(2).EQ.3)THEN IC=IC+1 C Jednoducha promenna WRITE(9,'(I3,1X,A)')IC,LINE LLL=-ICRPN(3) IF(LINE(1:6).EQ.'#LABEL')THEN JJJ=ICRPN(4) NLABELS=NLABELS+1 ELSEIF(ICRPN(2).EQ.5)THEN ITEM=ADJUSTL(LINE(8:40)) C Prvek vektoru s indexem jako konstanta CALL CITEM(ITEM) IF(ICRPN(4).EQ.1)THEN LABELS(NLABELS)=ITEM RINDEX=REALRC(-ICRPN(3)) LABELINE(NLABELS)=IC ELSE LOOPMAX(NLABELS)=-1 RINDEX=INTERC(-ICRPN(3)) ENDIF ENDIF GOTO 1 LLL=-ICRPN(5)+FLOOR(RINDEX-.5) C HLEDANI LOOPS A PRIRAZENI ADRES SKOKU JJJ=ICRPN(6)-2 100 IC=0 ELSE REWIND(IUNIT) C Prvek vektoru s indexem, ktery je definovan jako libovolny vyraz 2 READ(IUNIT,'(A)',END=200)LINE CALL TINE(ICRPN(3),ICRPN(2),IAUX,TFUW,RES) CALL TUPC(40,LINE,LINE) IF(IER.EQ.0)THEN IC=IC+1 JJJ=ICRPN(NCRPN-1)-2 IF(LINE(1:5).EQ.'#LOOP')THEN LLL=LASTINDEX ITEM=ADJUSTL(LINE(7:40)) ENDIF CALL LABINT(ITEM,NUMLAB) ENDIF IF(NUMLAB.GE.1)LOOPLINE(NUMLAB)=IC ENDIF ENDIF END GOTO 2 200
REWIND (IUNIT) IF(NLABELS.GT.0)THEN WRITE(9,'('' Labels'',I3/('' ['',A,''] GOTO'',I3))') / NLABELS,(LABELS(I),LOOPLINE(I),I=1,NLABELS) ENDIF ENDIF C Interpretace REWIND (IUNIT) INQUIRE(UNIT=IUNIT,NAME=PROCNAME) WRITE(10,'('' Processing file ['',A,'']'')')PROCNAME ILINE=0 3 READ(IUNIT,'(A)',END=300)LINE CALL OPERAT(LINE,IUNIT)
SUBROUTINE COMPEX USE MSFLIB INCLUDE '$FEMLOC' C Volani experniho programu COMPEX.EXE a predani dat v souboru COMPEX.BIN WRITE(10,'('' Writing database to COMPEX.BIN'')') OPEN(3,FILE='COMPEX.BIN',FORM='BINARY') CALL WRITEBIN(3,0) CLOSE(3) WRITE(10,'('' Running COMPEX.EXE with keyword '',A)')KEYW IRESULT=RUNQQ('COMPEX.EXE','') WRITE(10,'('' Reading results from COMPEX.BIN'')') OPEN(3,FILE='COMPEX.BIN',FORM='BINARY')
43
CALL READBIN(3) CLOSE(3) END
INCLUDE '$$-COMM'
44
C $S4-KLOC C C C C C C C C C C C C C C C
SUBROUTINE PIPE(ICONTR,IE,NL,NUE,AL,BL) POTRUBNI SIT Vypocet tlaku v uzlovych bodech Elementy: L2 (blokovani sestaveni pro NUE<>2) Laminarni Newtonska kapalina / turbulentni tok (Blasius) Teplotne zavisla viskozita a hustota Tlaky potrebne pro odhad prutokoveho soucinitele v zone 3 Teploty pro odhad viskozity v zone 3 ICONTR=1 vypocet parametru zony EPAR(MAXEL,MAXEPA) 1. sloupec Q prutok [m^3/s] 2. sloupec Re 3. sloupec Tau smykove napeti na stene [Pa]
INCLUDE '$FEM' DIMENSION X(2),Y(2),AL(NL,NL),BL(NL),T(2),PP(2) C C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY C T-TEPLOTY Z PREDCHOZI ITERACE (zona 3) C p-TLAKY Z PREDCHOZI ITERACE (zona 3) C IF(NUE.NE.2)THEN C Blokuj sestaveni pro jine nez dvouuzlove elementy NUE=0 RETURN ENDIF C Pocitadlo zpracovanych elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.GE.0)THEN C NORMALNI VYPOCET FTFRON L0=LUE(IE) DO IU=1,2 IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)THEN T(IU)=VAL(LOC+I,3) ELSEIF(JPU(LOC+I).EQ.12)THEN PP(IU)=VAL(LOC+I,3) ENDIF ENDDO ENDDO C H-delka trubky H=SQRT((X(1)-X(2))**2+(Y(1)-Y(2))**2) C EGROUP,MPROP,RCONST LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C RCONST (2-DIAMETER) C Prurez charakterizuji 3 parametry zony RC: D,Area,Perim, ktere nemusi C byt konzistentni. Za smerodatne se povazuji nenulove hodnoty Area a Perim, C z nichz se pocita ekvivalentni hydraulicky prumer. V opacnem pripade C (tj. pokud je Area=Perim=0 a D>0, se predpoklada kruhovy prurez). R=RCONST(LRCON,2)/2. AREA=RCONST(LRCON,6) PERIM=RCONST(LRCON,7) IF(R.LE.0..AND.AREA.GT.0..AND.PERIM.GT.0.)THEN R=2.*AREA/PERIM RCONST(LRCON,2)=2*R ELSEIF(R.GT.0.)THEN AREA=3.141*R**2 PERIM=6.282*R RCONST(LRCON,6)=AREA RCONST(LRCON,7)=PERIM ELSE WRITE(*,*)' Zero cross section' STOP ENDIF C Stredni teplota elementu pro vypocet viskozity AUX(11)=(T(1)+T(2))/2. C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) RHO =RMAT(LPROP,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,3).NE.0)RHO =RHO *CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) C Tlakova ztrata DP z predchozi iterace DP=ABS(PP(1)-PP(2)) IF(VISC.LE.0.)THEN WRITE(*,*)' ZERO VISCOSITY IN PIPE' STOP ENDIF RE=R**3*DP*RHO/(4*VISC**2*H) IF(RE.LE.2300.)THEN FI=3.141*R**4/(8*VISC*H) ELSE FI=(0.558/H)**(4./7.)*(2*R)**(19./7.)/((RHO*DP)**(3./7.)* / VISC**(1./7.)) ENDIF C Hydrostaticky tlak H-delka trubky DY=(Y(2)-Y(1)) DX=(X(2)-X(1)) DQ=RHO*(GY*DY+GX*DX)*FI IF(ICONTR.EQ.0)THEN C Vypocet matice prutokovych koeficientu AL(1,1)=FI AL(2,2)=FI AL(1,2)=-FI
C
AL(2,1)=-FI BL(1)=DQ BL(2)=-DQ
ELSEIF(ICONTR.GT.0)THEN C C ICONTR>0 Vypocet prutoku Q, Re, Tau C EPAR(IE,1)=(PP(1)-PP(2))*FI+DQ UMEAN=EPAR(IE,1)/AREA RE=UMEAN*2*R*RHO/VISC IF(RE.GT.2300.)THEN FAN=0.0792/RE**0.25 ELSEIF(RE.GT.0.)THEN FAN=16/RE ELSE FAN=0 ENDIF EPAR(IE,2)=RE EPAR(IE,3)=0.5*RHO*FAN*UMEAN**2 ENDIF C ICONTR-IF ENDIF END SUBROUTINE HEXC(ICONTR,IE,NL,NUE,AL,BL) C C C C C C C C C C C C C C C C C C C
POTRUBNI SIT Vypocet TEPLOT v uzlovych bodech na zaklade stanovenych prutoku Elementy: L2, V4 (specialni 4-uzlovy prvek vymenik) Laminarni Newtonska kapalina Teplotne zavisla vodivost, cp, hustota (teploty v zone 4) Ohmicky ohrev (napeti v zone 3) Rychlost proudeni ze zony EPAR EPAR vstup EPAR vystup (post processing ICONTR=1) 1-Q prutok 1-Q-tepelny vykon pro 4-uzlovy prvek (vymenik) 2-Re 3-tauw 4-RF fouling 5-Tmean 6-index pipe1 7-index pipe2
INCLUDE '$FEM' DIMENSION X(4),Y(4),AL(NL,NL),BL(NL), / RM(2,2),AM(2,2),T(4),TBC(4),U(2),IEH(2),F(2),FX(2),B(2) C Pocitadlo elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.GE.0)THEN C Reseni i postprocessing C NEPROVADI SE ZADNE KONTROLY BLOKOVANI C EGROUP,MPROP,RCONST LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) LEGRP=MAX0(1,IGROUP(IE)) C EGROUP stationarni/nestacionarni (1.PARAMETR) NONST=JGROUP(LEGRP,1) C RCONST (2-DIAMETER,4-alpha,5-Te,6-Area,7-Perim,8-Volume,9ratio,10-k) C Zakladni charakteristiky stejne pro 2-uzlove segmenty i 4-uzlovy vymenik C ale trochu odlisne interpretovane: U elementu vymenik oznacuje ALPHA souC cinitel prostupu tepla mezi proudy, AREA teplosmennou plochu (a ne plochu C prurezu kanalu) R =RCONST(LRCON,2)/2. ALPHA=RCONST(LRCON,4) TE =RCONST(LRCON,5) AREA =RCONST(LRCON,6) PERIM=RCONST(LRCON,7) C IF(NUE.EQ.2)THEN C C 2-UZLOVY SEGMENT TRUBKA C Tlaky i prutoky jiz musi byt vypocteny. C Prutoky Q jsou v 1.sloupci matice EPAR. Kladna hodnota Q znamena smer 1-2. C Druhy sloupec EPAR je Reynoldsovo cislo. C Treti sloupec Tau na stene. C Parametry ALPHA a TE maji vyznam pro vypocet tepelnych ztrat do okoli. C C T-TEPLOTY Z PREDCHOZI ITERACE (zona 4 pro vlastnosti, ze zony 3 pro poc.podminky) C U-napeti ze zony pocatecnich podminek (zona 3) C L0=LUE(IE) DO IU=1,2 IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)THEN T(IU)=VAL(LOC+I,4) TBC(IU)=VAL(LOC+I,3) ELSEIF(JPU(LOC+I).EQ.8)THEN U(IU)=VAL(LOC+I,3) ENDIF ENDDO ENDDO C H-delka trubky H=SQRT((X(1)-X(2))**2+(Y(1)-Y(2))**2) C Stredni teplota elementu pro vypocet viskozity
45
TMEAN=(T(1)+T(2))/2. EPAR(IE,5)=TMEAN IF(ICONTR.EQ.0)THEN C C 2-UZLOVY ELEMENT GENEROVANI SOUSTAVY ROVNIC C AUX(11)=TMEAN C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) RKX =RMAT(LPROP,1) CP =RMAT(LPROP,2) RHO =RMAT(LPROP,3) RKAP=RMAT(LPROP,4) IF(JMAT(LPROP,1).NE.0)RKX =RKX *CURFUN(JMAT(LPROP,1)) IF(JMAT(LPROP,2).NE.0)CP =CP *CURFUN(JMAT(LPROP,2)) IF(JMAT(LPROP,3).NE.0)RHO =RHO *CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,4).NE.0)RKAP=RKAP*CURFUN(JMAT(LPROP,4)) IF(AREA.GT.0..AND.PERIM.GT.0.)THEN R=2.*AREA/PERIM ELSEIF(R.GT.0.)THEN AREA=3.141*R**2 PERIM=6.282*R ELSE WRITE(*,*)' Zero cross section' STOP ENDIF C Elektricky vykon IF(IALGOR(4).NE.0)THEN Q=RKAP*((U(2)-U(1))/H)**2/(RHO*CP) ELSE Q=0 ENDIF C A - teplotni vodivost A=RKX/(RHO*CP) HH=ALPHA*PERIM/(RHO*CP*AREA) C Stredni rychlost UMEAN=EPAR(IE,1)/AREA AUMEAN=ABS(UMEAN) IF(AUMEAN.LE.1e-10)THEN WRITE(9,'('' Zero Flowrate in Element'',I6)')IE ENDIF C Vypocet teplotni disperse AEFF (efektivni teplotni vodivost) RE=ABS(EPAR(IE,2)) IF(RE.LE.2300.)THEN C Taylor Arisova disperze AEFF=A+(AUMEAN*2*R)**2/(192.*A) ELSEIF(RE.GT.0.)THEN C Disperse v turbulentnim rezimu AEFF=AUMEAN*2*R*(3E7/RE**2.1+1.35/RE**0.125) ENDIF IF(IALGOR(5).NE.0)THEN C UPWIND C Peclet (VZTAZENY NA DELKU ELEMENTU, NE PRUMER TRUBKY) PE=AMIN1(20.,AUMEAN*H/AEFF) IF(PE.GT.0.)THEN EE=EXP(PE) ALF=(EE+1./EE)/(EE-1./EE)-1./PE AOPT=ALF*RUPW*H/(2*AEFF) ENDIF IF(MOD(ICOUNTS,10).EQ.1)write(9,900)ie,re,pe,alf 900 format(' E',i3.3,' Re=',e9.2,' Pe=',e9.2,' Alpha(upw)=',f5.3) Z=AOPT*H*UMEAN/(2*AUMEAN) ELSE C UPWIND SUPPRESSED Z=0 ENDIF C Bazove funkce a derivace v tezisti elementu (1 bodova Gaussova integrace) F(1)=0.5 F(2)=0.5 FX(1)=-1./H FX(2)=1./H DO I=1,2 CONV=F(I)+Z*FX(I) DO J=1,2 RM(I,J)=CONV*F(J)*H AM(I,J)=(CONV*FX(J)*UMEAN+AEFF*FX(I)*FX(J)+CONV*HH*F(J))*H ENDDO B(I)=CONV*(HH*TE+Q)*H ENDDO C Lokalni matice elementu C IF(NONST)THEN DO I=1,2 BL(I)=DTIME*B(I) DO J=1,2 AL(I,J)=RM(I,J)+DTIME*AM(I,J) BL(I)=BL(I)+RM(I,J)*TBC(J) ENDDO ENDDO ELSE C STACIONARNI PRIPAD DO I=1,2 BL(I)=B(I) DO J=1,2 AL(I,J)=AM(I,J) ENDDO ENDDO ENDIF ELSE C 2-UZLOVY ELEMENT POSTPROCESSING (ICONTR.EQ.1) VYPOCET FOULINGU C Vyznam parametru zony elementu EPAR: 1-Q, 2-Re, 3-Tau, 4-RF, 5Tmean
C
c
RFOLD=EPAR(IE,4) TAU=EPAR(IE,3) RE=EPAR(IE,2) Konstanty modelu Ebert Panchal (alfa, aktiv.energie, gamma): EPALP=8.39 EPE=68E3 EPGAM=4.03E-11 RGAS=8.314 RF=RFOLD+DTIME*(EPALP/RE**0.88*EXP(-EPE/(RGAS*(TMEAN+273))) / -EPGAM*TAU) EPAR(IE,4)=RF write(9,*)rfold,rf ENDIF
ELSE C C 4-UZLOVY ELEMENT VYMENIKU TEPLA, TVORENY DVEMA SEGMENTY, JEJICHZ C INDEXY JSOU V ZONE EPAR (MAXEPA-1, MAXEPA). C IEH(1)=IEPAR(IE,MAXEPA-1) IEH(2)=IEPAR(IE,MAXEPA) IF(ALPHA.LE.0..OR.AREA.LE.0.)THEN WRITE(9,'('' ZERO ALPHA OR AREA IN ELEMENT'',I6)')IE ENDIF DO K=1,2 C Termofyzikalni vlastnosti proudu K LPROP=MAX0(1,IMAT(IEH(K))) LRCON=MAX0(1,IRCONS(IEH(K))) DK=RCONST(LRCON,2) AREAK=RCONST(LRCON,6) IF(AREAK.LE.0.)THEN C Vypocet plochy z prumeru trubky AREAK=3.141*DK**2/4. ENDIF RKK =RMAT(LPROP,1) CPK =RMAT(LPROP,2) RHOK =RMAT(LPROP,3) C Stredni teplota pro korekce termofyzikalnich vlastnosti AUX(11)=EPAR(IEH(K),5) IF(JMAT(LPROP,1).NE.0)RKK =RKK *CURFUN(JMAT(LPROP,1)) IF(JMAT(LPROP,2).NE.0)CPK =CPK *CURFUN(JMAT(LPROP,2)) IF(JMAT(LPROP,3).NE.0)RHOK=RHOK*CURFUN(JMAT(LPROP,3)) C RFK termicky odpor foulingu C REK Reynolds C AREAK plocha prurezu K-te trubky C AREA teplosmenna plocha C ALPHA soucinitel prostupu tepla bez korekce na fouling RFK=EPAR(IEH(K),4) REK=ABS(EPAR(IEH(K),2)) ALPHAR=ALPHA/(1+ALPHA*RFK) SK=AREA*ALPHAR/(RHOK*CPK*AREAK) C Delka segmentu K LO=LUE(IEH(K)) DO IU=1,2 IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) ENDDO HK=SQRT((X(1)-X(2))**2+(Y(1)-Y(2))**2) AK=RKK/(RHOK*CPK) C Stredni rychlost UMEAN=EPAR(IEH(K),1)/AREAK AUMEAN=ABS(UMEAN) IF(REK.LE.2300.)THEN C Taylor Arisova disperze AKEFF=AK+(AUMEAN*DK)**2/(192.*AK) ELSEIF(REK.GT.0.)THEN C Disperse v turbulentnim rezimu AKEFF=AUMEAN*DK*(3E7/REK**2.1+1.35/REK**0.125) ENDIF C Peclet (VZTAZENY NA DELKU ELEMENTU, NE PRUMER TRUBKY) PE=AMIN1(20.,AUMEAN*HK/AKEFF) IF(PE.GT.0.)THEN EE=EXP(PE) ALF=(EE+1./EE)/(EE-1./EE)-1./PE AOPT=ALF*RUPW*HK/(2*AKEFF) ENDIF Z=AOPT*HK*UMEAN/(2*AUMEAN) C Bazove funkce a derivace v tezisti elementu (1 bodova Gaussova integrace) F(1)=0.5 F(2)=0.5 FX(1)=-1./HK FX(2)=1./HK BL=0 AL=0 DO I=1,2 CONV=F(I)+Z*FX(I) DO J=1,2 BIJ=CONV*F(J)*SK*DTIME AL(2*(K-1)+I,J)=BIJ AL(2*(K-1)+I,J+2)=-BIJ ENDDO ENDDO C konec cyklu pres K-segmenty vymeniku ENDDO ENDIF C VYNECHANI TELA PROCEDURY PRI KONTROLE BLOKOVANI PROCEDUROU FTFRIN ENDIF END SUBROUTINE RTD(ICONTR,IE,NL,NUE,AL,BL) C C POTRUBNI SIT C Vypocet koncentraci v uzlovych bodech (nestacionarni pripad) C C Elementy: L2 (AXIALNI DISPERZE, CSTR)
46
C Rozliseni techto dvou typu je dano hodnotou NAMELE =1 (pipe), =2 (CSTR) C Pocatecni koncentrace je v zone 3. C INCLUDE '$FEM' DIMENSION X(2),Y(2),AL(NL,NL),BL(NL),T(2),C(2), / RM(2,2),AM(2,2),F(2),FX(2) IF(NUE.NE.2.OR.KINDE(IE).NE.5)THEN NUE=0 RETURN ENDIF C Pocitadlo zpracovanych elementu PREFRONT, FRONT, POSTPROCESSING ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C NORMALNI VYPOCET FTFRON C C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY C T-TEPLOTY ZE ZONY 3 C C-KONCENTRACE V ZONE 3 C L0=LUE(IE) DO IU=1,2 IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)THEN T(IU)=VAL(LOC+I,3) ELSEIF(JPU(LOC+I).EQ.20)THEN C(IU)=VAL(LOC+I,3) ENDIF ENDDO ENDDO C H-delka trubky H=SQRT((X(1)-X(2))**2+(Y(1)-Y(2))**2) C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT) NONST=JGROUP(LEGRP,1) C RCONST (2-DIAMETER), AREA-prut.prurez, PERIM-smoceny obvod, Vobjem misice R=RCONST(LRCON,2)/2. AREA=RCONST(LRCON,6) PERIM=RCONST(LRCON,7) V=RCONST(LRCON,8) IF(AREA.GT.0..AND.PERIM.GT.0.)THEN R=2.*AREA/PERIM ELSEIF(R.GT.0.)THEN AREA=3.141*R**2 PERIM=6.282*R ELSE WRITE(*,*)' Zero cross section' STOP ENDIF C Stredni teplota elementu pro vypocet koeficientu difuze TMEAN=(T(1)+T(2))/2. AUX(11)=TMEAN C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA,9-DN,10EN,11-AN) DN =RMAT(LPROP,9) EN =RMAT(LPROP,10) AN =RMAT(LPROP,11) IF(JMAT(LPROP,9).NE.0)DN=DN*CURFUN(JMAT(LPROP,9)) IF(JMAT(LPROP,10).NE.0)EN=EN*CURFUN(JMAT(LPROP,10)) IF(JMAT(LPROP,11).NE.0)AN=AN*CURFUN(JMAT(LPROP,11)) RGAS=8.314 ARRHEN=AN*EXP(-EN/(RGAS*(TMEAN+273))) UMEAN=EPAR(IE,1)/AREA AUMEAN=ABS(UMEAN) IF(NAMELE(IE).EQ.1)THEN C C PIPE model axialni disperze s chemickou reakci C C Dispersni koeficient DNEFF C RE=ABS(EPAR(IE,2)) IF(RE.LE.2300.)THEN C Taylor Arisova disperze DNEFF=DN+(AUMEAN*2*R)**2/(192.*DN) ELSEIF(RE.GT.0.)THEN C Disperse v turbulentnim rezimu DNEFF=AUMEAN*2*R*(3E7/RE**2.1+1.35/RE**0.125) ENDIF IF(IALGOR(5).NE.0)THEN C UPWIND C Difuzni Peclet (VZTAZENY NA DELKU ELEMENTU, NE PRUMER TRUBKY) PE=ABS(UMEAN)*H/DNEFF IF(PE.GT.0.)THEN EE=EXP(PE) ALF=(EE+1./EE)/(EE-1./EE)-1./PE AOPT=ALF*RUPW*H/(2*DNEFF) ENDIF Z=AOPT*H*UMEAN/(2*AUMEAN) ELSE C UPWIND SUPPRESSED Z=0 ENDIF C Bazove funkce a derivace v tezisti elementu (1 bodova Gaussova integrace) F(1)=0.5 F(2)=0.5 FX(1)=-1./H FX(2)=1./H
DO I=1,2 CONV=F(I)+Z*FX(I) DO J=1,2 RM(I,J)=CONV*F(J)*H AM(I,J)=(CONV*FX(J)*UMEAN+DNEFF*FX(I)*FX(J)+ / CONV*F(J)*ARRHEN)*H ENDDO ENDDO C Lokalni matice elementu DO I=1,2 BL(I)=0 DO J=1,2 IF(NONST)THEN AL(I,J)=RM(I,J)+DTIME*AM(I,J) BL(I)=BL(I)+RM(I,J)*C(J) ELSE AL(I,J)=AM(I,J) ENDIF ENDDO ENDDO ELSEIF(NAMELE(IE).EQ.2)THEN C C CSTR - idealne michany reaktor (cista konvekce) C IF(V.LE.0.)THEN WRITE(*,'(''ZERO VOLUME OF CSTR ELEMENT='',I6)')IE STOP ENDIF Q=EPAR(IE,1) AA=DTIME*ABS(Q)/V AC=ARRHEN*DTIME AL=0 BL=0 IF(Q.GT.0.)THEN C Uzel 1 je vstup, 2 vystup idealniho misice AL(2,1)=AA AL(2,2)=1+AA+AC BL(2)=C(2) ELSE C Uzel 2 je vstup, 1 vystup idealniho misice AL(1,2)=AA AL(1,1)=1+AA+AC BL(1)=C(1) ENDIF ENDIF ENDIF END
47
C $S5-KLOC SUBROUTINE THER(ICONTR,IE,NL,NUE,AL,BL) C C HEAT TRANSFER C OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT C C Elementy: T3,T6,Q4,Q8 C Gaussova integrace T:1,3,4,7 Q:1,2,3 C Konvekce: UPWIND (Zienkiewicz) C Zdrojovy clen: ohmicky ohrev C Okrajove podminky 3.druhu (alfa-parametr uzlu, Te-Real Const.), IPU>20 C Integrace v case: implicitni, 1.rad C C Postprocessing ICONTR=1 vypocet gradientu teploty C EPAR(*,4)=dT/dx EPAR(*,5)=dT/dy C INCLUDE '$FEM' DIMENSION X(9),Y(9),AL(NL,NL),BL(NL), / AM(9,9),RM(9,9),BM(9),XG(3),YG(3), / T(9),TOLD(9),U(9),VX(9),VY(9), / IBND(9),IBCR(3,3),ALPHA(9), / G(3),G1(9),G2(9),WT(9),W(3),F(9),FX(9),FY(9),FK(3) C C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY C AM-MATICE VODIVOSTI, RM-MATICE TEPELNYCH KAPACIT, BM-ZDROJ TEPLA C T-TEPLOTY Z PREDCHOZI ITERACE (zona 4),TOLD-POCATECNI PODMINKA (zona 3), C U-elektricky potencial, C VX,VY-rychlosti proudeni (zona 3) C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO TROJUHELNIK C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO TROJUHELNIK C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE (FK - derivace dle ksi) C C Ze zony $FEM jsou vyuzivany i prvky C IALGOR(2)-potlaceni vypoctu konvektivnich clenu C IALGOR(4)-potlaceni vypoctu zdroje tepla C IALGOR(5)-upwind C IF(NUE.LT.3.OR.NUE.EQ.5.OR.NUE.EQ.7.OR.NUE.GT.8)THEN C BLOKOVANI sestaveni pro nevhodny typ elementu NUE=0 RETURN ENDIF C Pocitadlo skutecne zpracovavanych elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C Stanoveni uzlovych teplot T(*), elektrickeho potencialu U(*), C a rychlosti VX(*),VY(*) z predchozich kroku. C Identifikace uzlu elementu IBND(*), v nich je status teploty C 20 < IPU . C Tento uzel je povazovan za uzel lezici na hranici Gamma, kde je predepsana C okrajova podminka tretiho druhu (soucinitel prostupu tepla ALPHA C je primo uzlovy parametr, proto ho ukladame do vektoru ALPHA(ibnd), C vnejsi teplota Te je ve vektoru realnych konstant elementu - je tedy C konstantni). C Dale je urcovan obdelnik ramujici dany element (Xmin,Xmax,Ymin,Ymax), C a pocita se vektor stredni rychlosti proudeni VXM,VYM. Tyto hodnoty C budou vyuzity pro vypocet Pecletova cisla elementu. C XMIN=1E10 XMAX=-1E10 YMIN=1E10 YMAX=-1E10 VXM=0 VYM=0 L0=LUE(IE) C NBND - pocet uzlu elementu s okrajovou podminkou tretiho druhu NBND=0 DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) XMIN=AMIN1(XMIN,X(IU)) XMAX=AMAX1(XMAX,X(IU)) YMIN=AMIN1(YMIN,Y(IU)) YMAX=AMAX1(YMAX,Y(IU)) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T (IU)=VAL(LOC+I,4) TOLD(IU)=VAL(LOC+I,3) C Identifikace uzlu s okrajovou podminkou tretiho druhu pro teplotu C IPU>20 IF(IPU(LOC+I).GT.20)THEN NBND=NBND+1 IBND(NBND)=IU ALPHA(IU)=VAL(LOC+I,1) ENDIF CASE(8) C elektricky potencial je pouze v zone 2 U(IU)=VAL(LOC+I,2) CASE(9) VX(IU)=VAL(LOC+I,3) CASE(10)
VY(IU)=VAL(LOC+I,3) END SELECT ENDDO VXM=VXM+VX(IU) VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE VYM=VYM/NUE DX=XMAX-XMIN DY=YMAX-YMIN C Skalarni soucin rychlosti a "uhlopricky" HV=VXM*DX+VYM*DY C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST UMEAN=SQRT(VXM**2+VYM**2) IF(UMEAN.GT.0.)THEN HMEAN=HV/UMEAN ELSE HMEAN=SQRT(DX**2+DY**2) ENDIF C ==================================================================== == C Urceni krivek, ktere tvori hranici elementu a na nichz je predepsana C okrajova podminka tretiho druhu. Vychazi se ze seznamu hranicnich uzlu C IBND(NBND). Vysledkem je matice IBCR(3,*), jejich sloupce definuji krivku C indexy (1,2,..NUE) uzlu. Krivka je urcena dvema nebo tremi body, zalezi C na typu elementu. Pocet krivek je NBCR. C NBCR=0 IBCR=0 IF(NBND.GT.1)THEN SELECT CASE(NUE) CASE (3) C C Trojuhelnik se 3 uzly. 1 nebo 2 strany jsou casti hranice (2 nebo 3 uzly). C 33333333333333333333333333333333333333333333333333333333333333333333 33333 IF(NBND.EQ.2)THEN C Jen jedna strana je casti hranice NBCR=1 IBCR(1,1)=IBND(1) IBCR(2,1)=IBND(2) ELSE C Dve strany jsou casti hranice. Vsechny 3 vrcholy lezi na hranici a neni jasne C kterou ze tri stran vyradit. Tato vyjimecna situace se resi prohlizenim C cele matice konektivity - hleda se vrchol, jehoz uzel neni soucasti zadneho C jineho elementu. DO IB=1,3 C Stanoveni globalniho indexu uzlu INDU=IABS(IUE(L0+IBND(IB))) NB=0 DO J=1,NE LOC=LUE(J) DO K=1,NUE IF(IABS(IUE(LOC+K)).EQ.INDU)NB=NB+1 ENDDO ENDDO IF(NB.EQ.1)THEN ICORN=IB EXIT ENDIF ENDDO C Uzel ICORN (1,2,3) je roh - v matici konektivity se vyskytl jen jednou. IF(ICORN.NE.0)THEN NBCR=2 IBCR(1,1)=IBND(ICORN) IBCR(1,2)=IBND(ICORN) IC1=MOD(ICORN,3)+1 IC2=MOD(IC1,3)+1 IBCR(2,1)=IBND(IC1) IBCR(2,2)=IBND(IC2) ENDIF ENDIF CASE(4) C Ctyruhelnik se 4-uzly. 1 nebo 2 strany casti hranice (2 nebo 3 uzly) C 44444444444444444444444444444444444444444444444444444444444444444444 IF(NBND.EQ.2)THEN C Jen jedna strana je casti hranice NBCR=1 IBCR(1,1)=IBND(1) IBCR(2,1)=IBND(2) ELSE C Soucasti hranice jsou dve strany (3 vylucujeme, i kdyz je to teoreticky mozne) NBCR=2 IF(IBND(1).EQ.1.AND.IBND(2).EQ.2.AND.IBND(3).EQ.3)THEN IBCR(1,1)=1 IBCR(2,1)=2 IBCR(1,2)=2 IBCR(2,2)=3 ELSEIF(IBND(1).EQ.2.AND.IBND(2).EQ.3.AND.IBND(3).EQ.4)THEN IBCR(1,1)=2 IBCR(2,1)=3
48
IBCR(1,2)=3 IBCR(2,2)=4
WT(NGSS)=W(I)*W(J) ENDDO ENDDO ELSEIF(IBND(1).EQ.1.AND.IBND(2).EQ.3.AND.IBND(3).EQ.4)THEN ENDIF IBCR(1,1)=3 C ---------------konec sekce vypoctu souradnic integracnich bodu IBCR(2,1)=4 C IBCR(1,2)=4 C NULOVANI MATIC VODIVOSTI, TEPELNYCH KAPACIT A ZDROJOVYCH CLENU IBCR(2,2)=1 AM=0 RM=0 ELSEIF(IBND(1).EQ.1.AND.IBND(2).EQ.2.AND.IBND(3).EQ.4)THEN BM=0 IBCR(1,1)=1 C IBCR(2,1)=2 C SESTAVENI MATICE AM(VODIVOSTI),RM(TEPELNYCH KAPACIT), vektor BM IBCR(1,2)=4 DO IG=1,NGSS IBCR(2,2)=1 C Bazove funkce F(i) a jejich derivace v integracnim bode IG ENDIF IF(NUE.EQ.3.OR.NUE.EQ.6)THEN ENDIF CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) CASE (6) ELSE C CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) C Trojuhelnik se 6 uzly. 1 nebo 2 strany (3 nebo 5 uzlu na hranici) ENDIF C 66666666666666666666666666666666666666666666666666666666666666666 C-------------------------------------------------------NBCR=NBND/2 C Bazove funkce F(i) umoznuji vypocitat teplotu v uzlu (z vektoru TM) DO IB=1,NBCR C Stredni uzel identifikuje stranu C a pro tuto teplotu pak vypocitat termofyzikalni parametry IBCR(3,IB)=IBND(NBCR+1+IB) C (hustotu, el.vodivost, cp, tepelnou vodivost). TEMP je promenna AUX(11). IBCR(1,IB)=IBCR(3,IB)-3 IBCR(2,IB)=IBCR(3,IB)-2 C Soucasne se pocita intenzita elektrickeho pole UX,UY (vyuzivaji se IF(IBCR(2,IB).GT.3)IBCR(2,IB)=1 C derivace bazovych funkci FX,FY) a vektor rychlosti VVX,VVY. ENDDO C CASE (8) TEMP=0 C UX=0 C Ctyruhelnik s 8 uzly. 1,2 nebo 3 strany (3,5 nebo 7 uzlu na UY=0 hranici) VVX=0 C VVY=0 88888888888888888888888888888888888888888888888888888888888888888888 RR=0 NBCR=NBND/2 DO I=1,NUE DO IB=1,NBCR TEMP=TEMP+F(I)*T(I) C Stredni uzel identifikuje stranu UX=UX+FX(I)*U(I) IBCR(3,IB)=IBND(NBCR+1+IB) UY=UY+FY(I)*U(I) IBCR(1,IB)=IBCR(3,IB)-4 RR=RR+Y(I)*F(I) IBCR(2,IB)=IBCR(3,IB)-3 VVX=VVX+VX(I)*F(I) IF(IBCR(2,IB).GT.4)IBCR(2,IB)=1 VVY=VVY+VY(I)*F(I) ENDDO ENDDO END SELECT AUX(11)=TEMP ENDIF C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) C Konec sekce, ktera identifikovala hranicni krivky (IBCR) RK=RMAT(LPROP,1) C CP=RMAT(LPROP,2) ==================================================================== RHO=RMAT(LPROP,3) = RKAPA=RMAT(LPROP,4) C EGROUP,MPROP,RCONST IF(JMAT(LPROP,1).NE.0)RK=RK*CURFUN(JMAT(LPROP,1)) LEGRP=MAX0(1,IGROUP(IE)) IF(JMAT(LPROP,2).NE.0)CP=CP*CURFUN(JMAT(LPROP,2)) LPROP=MAX0(1,IMAT(IE)) IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) LRCON=MAX0(1,IRCONS(IE)) IF(JMAT(LPROP,4).NE.0)RKAPA=RKAPA*CURFUN(JMAT(LPROP,4)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) AOPT=0 NONST=JGROUP(LEGRP,1) C Vypocet Pecletova cisla jen pro pripad uvazovani konvekce NGAUS=JGROUP(LEGRP,2) (IALGOR(2)) NAXIS=JGROUP(LEGRP,3) C a nastaveni upwindu (IALGOR(5)) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE,5-TE) IF(IALGOR(2).NE.0.AND.IALGOR(5).NE.0)THEN H=RCONST(LRCON,1) C Soucinitel upwind ALF jako funkce Pecletova cisla elementu TE=RCONST(LRCON,5) PE=UMEAN*HMEAN*RHO*CP/(2*RK) C IF(PE.GT.0.)THEN C Vypocet uzlu Gaussovy integrace zvlast pro trojuhelniky a PE=AMIN1(PE,50.) EE=EXP(PE) ctyruhelniky C -----------------------------------------------------------------ALF=(EE+1./EE)/(EE-1./EE)-1./PE --C Korekcni koeficient zadavany uzivatelem RUPW IF(NUE.EQ.3.OR.NUE.EQ.6)THEN AOPT=ALF*RUPW*HMEAN/(2*UMEAN) C trojuhelnikove elementy ELSE NGSS=NGAUS AOPT=0 IF(NGAUS.EQ.3)THEN ENDIF G1(1:3)=(/.5,.0,0.5/) ENDIF G2(1:3)=(/.5,.5,0./) C Hustota tepelneho vykonu WT(1:3)=(/.333333,.333333,.333333/) Q=RKAPA*(UX**2+UY**2) ELSEIF(NGAUS.EQ.4)THEN C Cylindricky souradny system - vse je nasobeno polomerem RR G1(1:4)=(/.333333,11./15.,2./15.,2./15./) IF(NAXIS.EQ.1)H=RR G2(1:4)=(/.333333,2./15.,11./15.,2./15./) E1=DET*WT(IG)*H*RK WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) C1=DET*WT(IG)*H*RHO*CP ELSEIF(NGAUS.EQ.7)THEN D1=DET*WT(IG)*H G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, DO I=1,NUE / .1012865,.1012865/) CONV=F(I)+AOPT*(VVX*FX(I)+VVY*FY(I)) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, C Respektovani zdroje tepla jen pri nastavenem priznaku IALGOR(4) / .797427,.1012865/) IF(IALGOR(4).NE.0)BM(I)=BM(I)+D1*CONV*Q WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, DO J=1,NUE / .12593918,.12593918/) C Viz rovnice (75) ELSE AM(I,J)=AM(I,J)+E1*(FX(I)*FX(J)+FY(I)*FY(J)) NGSS=1 G1(1)=0.3333333 IF(IALGOR(2).NE.0)AM(I,J)=AM(I,J)+C1*CONV*(VVX*FX(J)+VVY*FY(J)) G2(1)=0.3333333 RM(I,J)=RM(I,J)+C1*F(I)*F(J) WT(1)=1. ENDDO ENDIF ENDDO ELSE C---------------------------------------------C Isoparametric 4 or 8-node element. ENDDO IF(NGAUS.EQ.2)THEN C G(1:2)=(/-.57735,.57735/) C Prispevek hranicnich integralu k matici AM a k vektoru BL W(1:2)=(/1.,1./) C Krivkove integraly pocitane 3-bodovou Gaussovou integraci ELSEIF(NGAUS.EQ.3)THEN C G(1:3)=(/-.77459666,0.,.77459666/) G(1:3)=(/-.77459666,0.,.77459666/) W(1:3)=(/.5555555,.8888888,.555555/) W(1:3)=(/.5555555,.8888888,.555555/) ELSE C Pocet hranicnich krivek je NBCR NGAUS=1 DO IC=1,NBCR G(1)=0. IF(IBCR(3,IC).EQ.0)THEN W(1)=2. NU=2 ENDIF ELSE NGSS=0 NU=3 DO I=1,NGAUS ENDIF DO J=1,NGAUS DO I=1,NU NGSS=NGSS+1 XG(I)=X(IBCR(I,IC)) G1(NGSS)=G(I) YG(I)=Y(IBCR(I,IC)) G2(NGSS)=G(J) ENDDO
49
DO IG=1,3 C Bazove funkce F(*) v integracnim uzlu IG pocita procedura FDCR CALL FDCR(NU,XG,YG,G(IG),F,FK,FX,FY,DET) C Polomer RR a ALPHA (oznacovane AA) v integracnim uzlu IG RR=0 AA=0 DO I=1,NU RR=RR+YG(I)*F(I) AA=AA+ALPHA(IBCR(I,IC))*F(I) ENDDO IF(NAXIS.EQ.1)H=RR C Pricteni prispevku k vektoru BL a matici AM DO I=1,NU IQ=IBCR(I,IC) BM(IQ)=BM(IQ)+F(I)*TE*W(IG)*DET*H*AA DO J=1,NU JQ=IBCR(J,IC) AM(IQ,JQ)=AM(IQ,JQ)+F(I)*F(J)*W(IG)*DET*H*AA ENDDO ENDDO ENDDO ENDDO C C MATICE SOUSTAVY [[AL]]=[[CM]] + [[AM]]*dt C PRAVA STRANA [BL] =[[CM]]*[X0] + [Q]*dt C ...uvazovani okrajovych podminek [[AM]]= ++ alfa*Ni*Nj C ...konvekce [[AM]]= ++ rho*cp*Ni*(ux*Nj,x+uy*Nj,y) C ...zdrojovy clen [Q]= qNi + (alfa*Ni*Te)|gamma C C DTIME je systemova promenna COMMON /FEM/... C DO I=1,NL IF(NONST.EQ.1)THEN BL(I)=BM(I)*DTIME DO J=1,NL C NONSTEADY AL(I,J)=RM(I,J)+AM(I,J)*DTIME BL(I)=BL(I)+RM(I,J)*TOLD(J) ENDDO ELSE C STEADY STATE BL(I)=0 DO J=1,NL AL(I,J)=AM(I,J) ENDDO ENDIF ENDDO ELSEIF(ICONTR.GT.0)THEN C C Postprocessing, vypocet gradientu teploty C L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)T(IU)=VAL(LOC+I,2) ENDDO ENDDO C Bazove funkce v tezisti elementu IF(NUE.EQ.3.OR.NUE.EQ.6)THEN CALL FDFT(NUE,X,Y,.3333,.3333,F,FX,FY,DET) ELSE CALL FDFQ(NUE,X,Y,0.,0.,F,FX,FY,DET) ENDIF GRADX=0 GRADY=0 DO I=1,NUE GRADX=GRADX+FX(I)*T(I) GRADY=GRADY+FY(I)*T(I) ENDDO EPAR(IE,4)=GRADX EPAR(IE,5)=GRADY ENDIF END SUBROUTINE CONC(ICONTR,IE,NL,NUE,AL,BL) C C C C C C C C C C
KONCENTRACE - TRANSPORTNI ROVNICE HMOTY S REAKCI PRVNIHO RADU OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT Elementy: T3,T6,Q4,Q8 Gaussova integrace T:1,3,4,7 Q:1,2,3 Konvekce: UPWIND (Zienkiewicz) Zdrojovy clen: CHEMICKA REAKCE Integrace v case: implicitni, 1.rad INCLUDE '$FEM' DIMENSION X(9),Y(9),AL(NL,NL),BL(NL), / AM(9,9),RM(9,9), / T(9),C(9),VX(9),VY(9), / G(3),G1(9),G2(9),WT(9),W(3),F(9),FX(9),FY(9)
C C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY C AM-MATICE DIFUZE, RM-MATICE HMOT, C T,C-TEPLOTY A KONCENTRACE Z PREDCHOZIHO CASOVEHO KROKU, C VX,VY-rychlosti proudeni C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO TROJUHELNIK C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO TROJUHELNIK C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE C C Ze zony $FEM jsou vyuzivany i prvky
C C C C
IALGOR(2)-potlaceni vypoctu konvektivnich clenu IALGOR(4)-potlaceni vypoctu reakcniho clenu IALGOR(5)-upwind
IF(NUE.LT.3)THEN NUE=0 RETURN ENDIF C Pocitadlo skutecne zpracovavanych elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C Stanoveni uzlovych teplot T(*), koncentraci C(*), C a rychlosti VX(*),VY(*) z predchozich kroku. C Dale je urcovan obdelnik ramujici dany element (Xmin,Xmax,Ymin,Ymax), C a pocita se vektor stredni rychlosti proudeni VXM,VYM. Tyto hodnoty C budou vyuzity pro vypocet difuzniho Pecletova cisla elementu. C XMIN=1E10 XMAX=-1E10 YMIN=1E10 YMAX=-1E10 VXM=0 VYM=0 L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) XMIN=AMIN1(XMIN,X(IU)) XMAX=AMAX1(XMAX,X(IU)) YMIN=AMIN1(YMIN,Y(IU)) YMAX=AMAX1(YMAX,Y(IU)) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(20) C(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,3) CASE(10) VY(IU)=VAL(LOC+I,3) END SELECT ENDDO VXM=VXM+VX(IU) VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE VYM=VYM/NUE DX=XMAX-XMIN DY=YMAX-YMIN C Skalarni soucin rychlosti a "uhlopricky" HV=VXM*DX+VYM*DY C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST UMEAN=SQRT(VXM**2+VYM**2) IF(UMEAN.GT.0.)THEN HMEAN=HV/UMEAN ELSE HMEAN=SQRT(DX**2+DY**2) ENDIF C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2) NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE,5-TE) H=RCONST(LRCON,1) C C Vypocet uzlu Gaussovy integrace zvlast pro trojuhelniky a ctyruhelniky C -------------------------------------------------------------------IF(NUE.EQ.3.OR.NUE.EQ.6)THEN C trojuhelnikove elementy NGSS=NGAUS IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGSS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF ELSE C Isoparametric 4 or 8-node element. IF(NGAUS.EQ.2)THEN G(1:2)=(/-.57735,.57735/)
50
W(1:2)=(/1.,1./) ELSEIF(NGAUS.EQ.3)THEN G(1:3)=(/-.77459666,0.,.77459666/) W(1:3)=(/.5555555,.8888888,.555555/) ELSE NGAUS=1 G(1)=0. W(1)=2. ENDIF NGSS=0 DO I=1,NGAUS DO J=1,NGAUS NGSS=NGSS+1 G1(NGSS)=G(I) G2(NGSS)=G(J) WT(NGSS)=W(I)*W(J) ENDDO ENDDO ENDIF C ---------------konec sekce vypoctu souradnic integracnich bodu C C NULOVANI MATIC DIFUZE, HMOT AM=0 RM=0 C C SESTAVENI MATICE AM(DIFUZE),RM(HMOT) DO IG=1,NGSS C Bazove funkce F(i) a jejich derivace v integracnim bode IG IF(NUE.EQ.3.OR.NUE.EQ.6)THEN CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ELSE CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ENDIF C-------------------------------------------------------C Bazove funkce F(i) umoznuji vypocitat teplotu v uzlu (z vektoru T()) C a pro tuto teplotu pak vypocitat termofyzikalni parametry C (difuzni soucinitel, aktivacni energie, frekvencni faktor). C TEMP je promenna AUX(11). C TEMP=0 VVX=0 VVY=0 RR=0 DO I=1,NUE TEMP=TEMP+F(I)*T(I) RR=RR+Y(I)*F(I) VVX=VVX+VX(I)*F(I) VVY=VVY+VY(I)*F(I) ENDDO AUX(11)=TEMP C MPROP (9-DN,10-EN,11-AN) DN=RMAT(LPROP,9) EN=RMAT(LPROP,10) AN=RMAT(LPROP,11) IF(JMAT(LPROP,9).NE.0)DN=DN*CURFUN(JMAT(LPROP,9)) IF(JMAT(LPROP,10).NE.0)EN=EN*CURFUN(JMAT(LPROP,10)) IF(JMAT(LPROP,11).NE.0)AN=AN*CURFUN(JMAT(LPROP,11)) AOPT=0 C Vypocet Pecletova cisla jen pro pripad uvazovani konvekce (IALGOR(2)) C a nastaveni upwindu (IALGOR(5)) IF(IALGOR(2).NE.0.AND.IALGOR(5).NE.0)THEN C Soucinitel upwind ALF jako funkce Pecletova cisla elementu PE=UMEAN*HMEAN/(2*DN) IF(PE.GT.0.)THEN PE=AMIN1(PE,50.) EE=EXP(PE) ALF=(EE+1./EE)/(EE-1./EE)-1./PE C Korekcni koeficient zadavany uzivatelem RUPW AOPT=ALF*RUPW*HMEAN/(2*UMEAN) ELSE AOPT=0 ENDIF ENDIF C Spotreba slozky N chemickou reakci Q=AN*EXP(-EN/(8.314*(TEMP+273))) C Cylindricky souradny system - vse je nasobeno polomerem RR IF(NAXIS.EQ.1)H=RR E1=DET*WT(IG)*H*DN C1=DET*WT(IG)*H DO I=1,NUE CONV=F(I)+AOPT*(VVX*FX(I)+VVY*FY(I)) DO J=1,NUE C Viz rovnice (86) AM(I,J)=AM(I,J)+E1*(FX(I)*FX(J)+FY(I)*FY(J)) IF(IALGOR(2).NE.0) / AM(I,J)=AM(I,J)+C1*CONV*(VVX*FX(J)+VVY*FY(J)) C Respektovani REAKCE jen pri nastavenem priznaku IALGOR(4) IF(IALGOR(4).NE.0) / AM(I,J)=AM(I,J)+C1*CONV*Q*F(J) RM(I,J)=RM(I,J)+C1*F(I)*F(J) ENDDO ENDDO ENDDO C C MATICE SOUSTAVY [[AL]]=[[CM]] + [[AM]]*dt C PRAVA STRANA [BL] =[[CM]]*[X0] + [Q]*dt C C DTIME je systemova promenna COMMON /FEM/... C DO I=1,NL BL(I)=0 DO J=1,NL IF(NONST.EQ.1)THEN C NONSTEADY AL(I,J)=RM(I,J)+AM(I,J)*DTIME
BL(I)=BL(I)+RM(I,J)*C(J) ELSE C STEADY STATE AL(I,J)=AM(I,J) ENDIF ENDDO ENDDO ENDIF END C C C C C C
SUBROUTINE ELEC(ICONTR,IE,NL,NUE,AL,BL) ELEKTRICKY POTENCIAL - TEPLOTNE ZAVISLA KONDUKTIVITA OPTIONS: PLANE/AXISYM, Elementy: T3,T6, Q4,Q8 Volitelny pocet Gaussovych uzlu integrace T:1,3,4,7 Q:1,2,3
INCLUDE '$FEM' DIMENSION X(9),Y(9),AL(NL,NL),BL(NL) DIMENSION G(3),G1(9),G2(9),WT(9),W(3),F(9),FX(9),FY(9),T(9) C AL-MATICE SOUSTAVY, AM-MATICE ELEKTRICKE VODIVOSTI, C T -TEPLOTY Z PREDCHOZI ITERACE, C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO TROJUHELNIK C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO TROJUHELNIK C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE C IF(NUE.LT.3)THEN NUE=0 RETURN ENDIF C Pocitadlo skutecne zpracovavanych elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C Stanoveni teplot v uzlovych bodech aby bylo mozne pocitat teplotne C zavislou elektrickou vodivost C L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)THEN T(IU)=VAL(LOC+I,3) EXIT ENDIF ENDDO ENDDO C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2) NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE) H=RCONST(LRCON,1) C NULOVANI MATICE ELEKTRICKE VODIVOSTI A PRAVE STRANY AL=0 BL=0 IF(NUE.EQ.3.OR.NUE.EQ.6)THEN C TROJUHELNIKOVY ELEMENT T3 NEBO T6 NGSS=NGAUS IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGSS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF ELSE C Q4 NEBO Q8 IF(NGAUS.EQ.2)THEN G(1:2)=(/-.57735,.57735/) W(1:2)=(/1.,1./) ELSEIF(NGAUS.EQ.3)THEN G(1:3)=(/-.77459666,0.,.77459666/) W(1:3)=(/.5555555,.8888888,.555555/) ELSE NGAUS=1 G(1)=0. W(1)=2. ENDIF NGSS=0 DO I=1,NGAUS DO J=1,NGAUS NGSS=NGSS+1 G1(NGSS)=G(I)
51
C
C
C C
G2(NGSS)=G(J) WT(NGSS)=W(I)*W(J) ENDDO ENDDO ENDIF LOKALNI MATICE AL(VODIVOSTI) DO IG=1,NGSS IF(NUE.EQ.3.OR.NUE.EQ.6)THEN CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ELSE CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ENDIF Polomer a teplota RR=0 TEMP=0 DO I=1,NUE RR=RR+Y(I)*F(I) TEMP=TEMP+T(I)*F(I) ENDDO AUX(11)=TEMP Vypocet merne elektricke vodivosti v integracnim uzlu MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) RKAPPA=RMAT(LPROP,4) IF(JMAT(LPROP,4).NE.0)RKAPPA=RKAPPA*CURFUN(JMAT(LPROP,4)) IF(NAXIS.EQ.1)H=RR E1=DET*WT(IG)*H*RKAPPA DO I=1,NUE DO J=1,NUE AL(I,J)=AL(I,J)+E1*(FX(I)*FX(J)+FY(I)*FY(J)) ENDDO ENDDO ENDDO ENDIF END
52
C $S6-KLOC SUBROUTINE MIKE(ICONTR,IE,NL,NUE,AL,BL) C C PROUDENI S MINIMALNI KINETICKOU ENERGII C Dve varianty trojuhelnikovych elementu: C 1) Trojuhelnikove elementy 6 uzlu (tlaky jen ve vrcholech), 15 DOF C Kvadraticke bazove funkce pro rychlosti, linearni pro tlaky C 2) Trojuhelnikove elementy 4 uzly (tlak jen v tezisti), 7 DOF C Linearni bazove funkce rychlosti, konstantni pro tlak C INCLUDE '$FEM' DIMENSION X(6),Y(6),AL(NL,NL),BL(NL),RM(6,6), / PMX(6,3),PMY(6,3),BX(3) DIMENSION G1(7),G2(7),WT(7),T(6),IZ(6),VX(6),VY(6), / F(6),FX(6),FY(6),FL(3),FLX(3),FLY(3) C Blokovani sestaveni pro nevhodny typ elementu IF((NUE.NE.6.AND.NUE.NE.4).OR. / (NL.NE.15.AND.NL.NE.7))THEN NUE=0 RETURN ENDIF C Pocitadlo zpracovanych elementu ICOUNTS=ICOUNTS+1 C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2) NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE,4-ALPHA,5-TE) H=RCONST(LRCON,1) IF(ICONTR.EQ.0)THEN C Telo procedury jen v rezimu ICONTR=0 L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) IF(JPU(LOC+I).EQ.1)T(IU)=VAL(LOC+I,3) ENDDO ENDDO C TROJUHELNIKOVY ELEMENT IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGAUS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF C C NULOVANI MATIC HMOTNOSTI (RM 6 x 6) C TLAKU (PPX,PPY 6 x 3) EXPANZE (BX 6 x 1) RM=0 PMX=0 PMY=0 BX=0 DO IG=1,NGAUS C C Teprve nyni se vypocet deli na variantu se 6 resp. 4 uzly C IF(NUE.EQ.6)THEN IMX=6 KMX=3 CALL FDFT(6,X,Y,G1(IG),G2(IG),F,FX,FY,DET) CALL FDFT(3,X,Y,G1(IG),G2(IG),FL,FLX,FLY,DETL) ELSE IMX=3 KMX=1 CALL FDFT(3,X,Y,G1(IG),G2(IG),F,FX,FY,DET) FL(1)=1 ENDIF DETWT=DET*WT(IG) C Rychlosti a teploty z predchozi iterace v Gaussove uzlu C Teplota se prirazuje promenne AUX(11) pro interpret funkci TEMP=0 DO I=1,IMX TEMP=TEMP+T(I)*F(I) ENDDO AUX(11)=TEMP C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) BETA=RMAT(LPROP,8) C TEMPERATURE DEPENDENCIES IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,8)) C------------------------------------------------------------
C Matice M
DO I=1,IMX DO J=1,IMX
RM(I,J)=RM(I,J)+F(I)*F(J)*DETWT ENDDO C Matice PXX,PYY DO J=1,KMX C Matice P varianta s uvazovanim asymetricke slozky PMX(I,J)=PMX(I,J)-FL(J)*FX(I)*DETWT PMY(I,J)=PMY(I,J)-FL(J)*FY(I)*DETWT ENDDO ENDDO DO I=1,KMX BX(I)=BX(I)-BETA*FL(I)*DETWT ENDDO ENDDO C C Nulovani matice soustavy a vektoru prave strany C AL=0 BL=0 C C Casovy krok DTIME je systemova promenna C IF(NUE.EQ.6)THEN C C 6 UZLOVY TROJUHELNIK Sestaveni matic 15 x 15 C Matice M (6 x 6) se presouvaji na pozice 1,4,7,10,12,14 (+1) C IZ(1:6)=(/1,4,7,10,12,14/) DO I=1,6 DO J=1,6 AL(IZ(I),IZ(J))=2*RM(I,J) AL(IZ(I)+1,IZ(J)+1)=2*RM(I,J) ENDDO ENDDO C Umisteni prvku PMX a PMY DO I=1,3 BL(3*I)=BX(I) DO J=1,3 AL(3*I-2,3*J)=PMX(I,J)*DTIME AL(3*I-1,3*J)=PMY(I,J)*DTIME AL(3*I,3*J-2)=PMX(I,J)*DTIME AL(3*I,3*J-1)=PMY(I,J)*DTIME ENDDO ENDDO DO I=4,6 DO J=1,3 AL(2*I+2,3*J)=PMX(I,J)*DTIME AL(2*I+3,3*J)=PMY(I,J)*DTIME AL(3*J,2*I+2)=PMX(I,J)*DTIME AL(3*J,2*I+3)=PMY(I,J)*DTIME ENDDO ENDDO ELSE C C 4 UZLOVY TROJUHELNIK MATICE 7 x 7 C DO I=1,3 I2=2*I DO J=1,3 AL(I2-1,2*J-1)=2*RM(I,J) AL(I2,2*J)=2*RM(I,J) ENDDO AL(I2-1,7)=PMX(I,1) AL(I2,7)=PMY(I,1) AL(7,I2-1)=PMX(I,1) AL(7,I2)=PMY(I,1) ENDDO ENDIF ELSEIF(ICONTR.GT.0)THEN C C Postprocessing - vypocet invariantu, hustoty dissipovane energie a vykonu C IF(NUE.EQ.6)THEN NVEL=6 ELSE NVEL=3 ENDIF L0=LUE(IE) DO IU=1,NVEL IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,2) CASE(10) VY(IU)=VAL(LOC+I,2) END SELECT ENDDO ENDDO C 1.POINT GAUSS CALL FDFT(NVEL,X,Y,0.33333,0.33333,F,FX,FY,DET) VYM=0 DVXDX=0 DVXDY=0 DVYDX=0 DVYDY=0 TEMP=0 R=0
53
C C C
C C C
DO I=1,NVEL VYM=VYM+F(I)*VY(I) DVXDX=DVXDX+VX(I)*FX(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) TEMP=TEMP+T(I)*F(I) R=R+Y(I)*F(I) ENDDO IF(NAXIS.EQ.0)THEN Kartezsky souradny system DRUHY INVARIANT EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET ELSE CYLINDRICKY SOURADNY SYSTEM DRUHY INVARIANT
EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2+(VYM/R)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET*R*6.282 ENDIF POWER=POWER+EPAR(IE,1) ENDIF END SUBROUTINE UVP(ICONTR,IE,NL,NUE,AL,BL) C C NAVIER STOKESOVY ROVNICE - UPWIND C OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT C Dve varianty trojuhelnikovych elementu: C 1) Trojuhelnikove elementy 6 uzlu (tlaky jen ve vrcholech), 15 DOF C Kvadraticke bazove funkce pro rychlosti, linearni pro tlaky C 2) Trojuhelnikove elementy 4 uzly (tlak jen v tezisti), 7 DOF C Linearni bazove funkce rychlosti, konstantni pro tlak C INCLUDE '$FEM' DIMENSION X(6),Y(6),AL(NL,NL),BL(NL),RM(6,6), / AAX(6,6),AAY(6,6), / PMX(6,3),PMY(6,3),BX(6),BY(6),VX(6),VY(6), / VXOLD(6),VYOLD(6) DIMENSION G1(7),G2(7),WT(7),T(6),IZ(6), / F(6),FX(6),FY(6),FL(3),FLX(3),FLY(3) C Blokovani sestaveni pro nevhodny typ elementu IF((NUE.NE.6.AND.NUE.NE.4).OR. / (NL.NE.15.AND.NL.NE.7))THEN NUE=0 RETURN ENDIF C Pocitadlo zpracovanych elementu ICOUNTS=ICOUNTS+1 C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2) NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE,4-ALPHA,5-TE) H=RCONST(LRCON,1) IF(ICONTR.EQ.0)THEN C SESTAVENI A VYPOCET L0=LUE(IE) C Souradnice, stare hodnoty rychlosti a teplot v 6-ti uzlech C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST C Hodnoty rychlosti z predchozi iterace v zone 4 C Pocatecni podminka pro rychlosti - zona 3 XMIN=1E10 XMAX=-1E10 YMIN=1E10 YMAX=-1E10 VXM=0 VYM=0 DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) XMIN=AMIN1(XMIN,X(IU)) XMAX=AMAX1(XMAX,X(IU)) YMIN=AMIN1(YMIN,Y(IU)) YMAX=AMAX1(YMAX,Y(IU)) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,4) VXOLD(IU)=VAL(LOC+I,3) CASE(10) VY(IU)=VAL(LOC+I,4)
VYOLD(IU)=VAL(LOC+I,3) END SELECT ENDDO VXM=VXM+VX(IU) VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE VYM=VYM/NUE DX=XMAX-XMIN DY=YMAX-YMIN C Skalarni soucin rychlosti a "uhlopricky" HV=VXM*DX+VYM*DY UMEAN=SQRT(VXM**2+VYM**2) IF(UMEAN.GT.0.)THEN HMEAN=HV/UMEAN ELSE HMEAN=SQRT(DX**2+DY**2) ENDIF C TROJUHELNIKOVY ELEMENT IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGAUS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF C C NULOVANI MATIC HMOTNOSTI (RM 6 x 6) , TRANSPORTU (AAX,AAY 6 x 6) C TLAKU (PPX,PPY 6 x 3), VZTLAKU (BX,BY 6 x 1) RM=0 AAX=0 AAY=0 PMX=0 PMY=0 BX=0 BY=0 DO IG=1,NGAUS C C Varianta 6-uzlu (kvadraticke rychlosti) nebo 4-uzly (linearni rychlosti) C IF(NUE.EQ.6)THEN IMX=6 KMX=3 CALL FDFT(6,X,Y,G1(IG),G2(IG),F,FX,FY,DET) CALL FDFT(3,X,Y,G1(IG),G2(IG),FL,FLX,FLY,DETL) ELSE IMX=3 KMX=1 CALL FDFT(3,X,Y,G1(IG),G2(IG),F,FX,FY,DET) FL(1)=1 ENDIF DETWT=DET*WT(IG) C Rychlosti a teploty z predchozi iterace v Gaussove uzlu C Teplota se prirazuje promenne AUX(11) pro interpret funkci VVX=0 VVY=0 RR=0 TEMP=0 DO I=1,IMX VVX=VVX+VX(I)*F(I) VVY=VVY+VY(I)*F(I) RR=RR+F(I)*Y(I) TEMP=TEMP+T(I)*F(I) ENDDO AUX(11)=TEMP C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) VISC=RMAT(LPROP,7) RHO=RMAT(LPROP,3) BETA=RMAT(LPROP,8) C TEMPERATURE DEPENDENCIES IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,8)) IF(JMAT(LPROP,7).NE.0)THEN C Vypocet invariantu rychlosti deformace jen v pripade, C ze je uvazovana promenna viskozita DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 DO I=1,IMX DVXDX=DVXDX+VX(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) ENDDO C Druhy invariant je AUX(5) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF C Soucinitel upwind ALPHA jako funkce Pecletova cisla elementu C Upwind se uvazuje jen tehdy kdyz je nastaven priznak IALGOR(5) AOPT=0
54
IF(IALGOR(5).NE.0)THEN PE=UMEAN*HMEAN*RHO/(2*VISC) IF(PE.GT.0.)THEN PE=AMIN1(PE,50.) EE=EXP(PE) ALPHA=(EE+1./EE)/(EE-1./EE)-1./PE C Korekcni koeficient ALPHA zadavany uzivatelem RALGOR(5)=RUPW AOPT=ALPHA*RUPW*HMEAN/(2*UMEAN) ELSE AOPT=0 ENDIF ENDIF C-----------------------------------------------------------DO I=1,IMX ASYM=AOPT*(VVX*FX(I)+VVY*FY(I)) DO J=1,IMX C Matice M RM(I,J)=RM(I,J)+RHO*F(I)*F(J)*DETWT C Matice A CONV=RHO*(F(I)+ASYM)*(VVX*FX(J)+VVY*FY(J)) C kartezsky souradny system DAX=CONV+VISC*(FX(I)*FX(J)+FY(I)*FY(J)) DAY=DAX IF(NAXIS.EQ.1)THEN C cylindricky souradny system DAX=DAX-VISC*F(I)*FY(J)/RR DAY=DAY+VISC*F(J)*FY(I)/RR ENDIF AAX(I,J)=AAX(I,J)+DAX*DETWT AAY(I,J)=AAY(I,J)+DAY*DETWT ENDDO C Matice PXX,PYY i vektory BX,BY jsou stejne v cylindrickem i kartezskem s.s. DO J=1,KMX C Matice P C varianta bez asymetrie PMX(I,J)=PMX(I,J)-FL(J)*FX(I)*DETWT PMY(I,J)=PMY(I,J)-FL(J)*FY(I)*DETWT ENDDO C Vektor B GX,GZ jsou slozky zrychleni BX(I)=BX(I)+(F(I)+ASYM)*RHO*GX*(1-BETA*TEMP)*DETWT BY(I)=BY(I)+(F(I)+ASYM)*RHO*GY*(1-BETA*TEMP)*DETWT ENDDO C KONEC CYKLU PRES GAUSSOVY BODY ENDDO C C Nulovani matice soustavy a vektoru prave strany C AL=0 BL=0 C C Casovy krok DTIME je systemova promenna C IF(NUE.EQ.6)THEN C C 6 UZLOVY TROJUHELNIK sestaveni matice 15 x 15 C Matice M,A (6 x 6) se presouvaji na pozice 1,4,7,10,12,14 (+1) C IZ(1:6)=(/1,4,7,10,12,14/) DO I=1,6 BL(IZ(I))=BX(I)*DTIME BL(IZ(I)+1)=BY(I)*DTIME DO J=1,6 AL(IZ(I),IZ(J))=AAX(I,J)*DTIME+RM(I,J) AL(IZ(I)+1,IZ(J)+1)=AAY(I,J)*DTIME+RM(I,J) BL(IZ(I))=BL(IZ(I))+RM(I,J)*VXOLD(J) BL(IZ(I)+1)=BL(IZ(I)+1)+RM(I,J)*VYOLD(J) ENDDO ENDDO C Umisteni prvku PMX a PMY DO I=1,3 DO J=1,3 AL(3*I-2,3*J)=PMX(I,J)*DTIME AL(3*I-1,3*J)=PMY(I,J)*DTIME AL(3*I,3*J-2)=PMX(I,J)*DTIME AL(3*I,3*J-1)=PMY(I,J)*DTIME ENDDO ENDDO DO I=4,6 DO J=1,3 AL(2*I+2,3*J)=PMX(I,J)*DTIME AL(2*I+3,3*J)=PMY(I,J)*DTIME AL(3*J,2*I+2)=PMX(I,J)*DTIME AL(3*J,2*I+3)=PMY(I,J)*DTIME ENDDO ENDDO ELSE C C 4 UZLOVY TROJUHELNIK sestaveni matice 7 x 7 C DO I=1,3 I2=2*I BL(I2-1)=BX(I)*DTIME BL(I2)=BY(I)*DTIME DO J=1,3 AL(I2-1,2*J-1)=AAX(I,J)*DTIME+RM(I,J) AL(I2,2*J)=AAY(I,J)*DTIME+RM(I,J) BL(I2-1)=BL(I2-1)+RM(I,J)*VXOLD(J) BL(I2)=BL(I2)+RM(I,J)*VYOLD(J) ENDDO AL(I2-1,7)=PMX(I,1)*DTIME AL(I2,7)=PMY(I,1)*DTIME AL(7,I2-1)=PMX(I,1)*DTIME AL(7,I2)=PMY(I,1)*DTIME ENDDO ENDIF
ELSEIF(ICONTR.GT.0)THEN C C Postprocessing - vypocet invariantu, hustoty dissipovane energie a vykonu C IF(NUE.EQ.6)THEN NVEL=6 ELSE NVEL=3 ENDIF L0=LUE(IE) DO IU=1,NVEL IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,2) CASE(10) VY(IU)=VAL(LOC+I,2) END SELECT ENDDO ENDDO C 1.POINT GAUSS CALL FDFT(NVEL,X,Y,0.33333,0.33333,F,FX,FY,DET) VYM=0 DVXDX=0 DVXDY=0 DVYDX=0 DVYDY=0 TEMP=0 R=0 DO I=1,NVEL VYM=VYM+F(I)*VY(I) DVXDX=DVXDX+VX(I)*FX(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) TEMP=TEMP+T(I)*F(I) R=R+Y(I)*F(I) ENDDO IF(NAXIS.EQ.0)THEN C Kartezsky souradny system C DRUHY INVARIANT EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET ELSE C CYLINDRICKY SOURADNY SYSTEM C DRUHY INVARIANT EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2+(VYM/R)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET*R*6.282 ENDIF POWER=POWER+EPAR(IE,1) ENDIF C ENDIF ICONTR END C C C C C C C C
C
C C
C
SUBROUTINE UVPP(ICONTR,IE,NL,NUE,AL,BL) NAVIER STOKESOVY ROVNICE - UPWIND metoda pseudostlacitelnosti OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT A) Trojuhelnikove elementy 6 uzlu (tlaky jen ve vrcholech) Kvadraticke bazove funkce pro rychlosti, linearni pro tlaky B) Trojuhelnikove prvky 4-uzlove (tlaky jen v tezisti) linearni bazove funkce pro rychlosti INCLUDE '$FEM' DIMENSION X(6),Y(6),AL(NL,NL),BL(NL),RM(6,6), / AAX(6,6),AAY(6,6),POLD(9),H(3,3), / PMX(6,3),PMY(6,3),BX(6),BY(6), / VX(6),VY(6),VXOLD(6),VYOLD(6) DIMENSION G1(7),G2(7),WT(7),T(6),IZ(6), / F(6),FX(6),FY(6),FL(3),FLX(3),FLY(3) TEST PRIPUSTNOSTI ELEMENTU IF((NUE.NE.6.AND.NUE.NE.4).OR. / (NL.NE.15.AND.NL.NE.7))THEN NUE=0 RETURN ENDIF Pocitadlo zpracovanych elementu ICOUNTS=ICOUNTS+1 EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2)
55
NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE,4-ALPHA,5-TE) H=RCONST(LRCON,1) IF(ICONTR.EQ.0)THEN C SESTAVENI A VYPOCET L0=LUE(IE) C Souradnice, stare hodnoty rychlosti, a teplot v 6-ti uzlech, C tlaku ve vrcholech C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST XMIN=1E10 XMAX=-1E10 YMIN=1E10 YMAX=-1E10 VXM=0 VYM=0 DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) XMIN=AMIN1(XMIN,X(IU)) XMAX=AMAX1(XMAX,X(IU)) YMIN=AMIN1(YMIN,Y(IU)) YMAX=AMAX1(YMAX,Y(IU)) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,4) VXOLD(IU)=VAL(LOC+I,3) CASE(10) VY(IU)=VAL(LOC+I,3) VYOLD(IU)=VAL(LOC+I,3) CASE(12) POLD(IU)=VAL(LOC+I,3) END SELECT ENDDO VXM=VXM+VX(IU) VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE VYM=VYM/NUE DX=XMAX-XMIN DY=YMAX-YMIN C Skalarni soucin rychlosti a "uhlopricky" HV=VXM*DX+VYM*DY UMEAN=SQRT(VXM**2+VYM**2) IF(UMEAN.GT.0.)THEN HMEAN=HV/UMEAN ELSE HMEAN=SQRT(DX**2+DY**2) ENDIF C TROJUHELNIKOVY ELEMENT IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGAUS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF C C NULOVANI MATIC HMOTNOSTI (RM 6 x 6) , TRANSPORTU (AAX,AAY 6 x 6) C TLAKU (PPX,PPY 6 x 3), VZTLAKU (BX,BY 6 x 1) C H (3 x 3) RM=0 AAX=0 AAY=0 PMX=0 PMY=0 BX=0 BY=0 H=0 DO IG=1,NGAUS C C Varianta 6-uzlu (kvadraticke rychlosti) nebo 4-uzly (linearni rychlosti) C IF(NUE.EQ.6)THEN IMX=6 KMX=3 CALL FDFT(6,X,Y,G1(IG),G2(IG),F,FX,FY,DET) CALL FDFT(3,X,Y,G1(IG),G2(IG),FL,FLX,FLY,DETL) ELSE IMX=3 KMX=1 CALL FDFT(3,X,Y,G1(IG),G2(IG),F,FX,FY,DET) FL(1)=1 ENDIF DETWT=DET*WT(IG) C Rychlosti a teploty z predchozi iterace v Gaussove uzlu C Teplota se prirazuje promenne AUX(11) pro interpret funkci
VVX=0 VVY=0 RR=0 TEMP=0 DO I=1,IMX VVX=VVX+VX(I)*F(I) VVY=VVY+VY(I)*F(I) RR=RR+F(I)*Y(I) TEMP=TEMP+T(I)*F(I) ENDDO AUX(11)=TEMP C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) VISC=RMAT(LPROP,7) RHO=RMAT(LPROP,3) BETA=RMAT(LPROP,8) C TEMPERATURE DEPENDENCIES IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,8)) IF(JMAT(LPROP,7).NE.0)THEN C Vypocet invariantu rychlosti deformace jen v pripade, C ze je uvazovana promenna viskozita DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 DO I=1,IMX DVXDX=DVXDX+VX(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) ENDDO C Druhy invariant je AUX(5) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF C Soucinitel upwind ALPHA jako funkce Pecletova cisla elementu C Upwind se uvazuje jen tehdy kdyz je nastaven priznak IALGOR(5) AOPT=0 IF(IALGOR(5).NE.0)THEN PE=UMEAN*HMEAN*RHO/(2*VISC) IF(PE.GT.0.)THEN PE=AMIN1(PE,50.) EE=EXP(PE) ALPHA=(EE+1./EE)/(EE-1./EE)-1./PE C Korekcni koeficient ALPHA zadavany uzivatelem RALGOR(5) AOPT=ALPHA*RUPW*HMEAN/(2*UMEAN) ELSE AOPT=0 ENDIF ENDIF C-----------------------------------------------------------DO I=1,IMX ASYM=AOPT*(VVX*FX(I)+VVY*FY(I)) DO J=1,IMX C Matice M RM(I,J)=RM(I,J)+RHO*F(I)*F(J)*DETWT C Matice A CONV=RHO*(F(I)+ASYM)*(VVX*FX(J)+VVY*FY(J)) C kartezsky souradny system DAX=CONV+VISC*(FX(I)*FX(J)+FY(I)*FY(J)) DAY=DAX IF(NAXIS.EQ.1)THEN C cylindricky souradny system DAX=DAX-VISC*F(I)*FY(J)/RR DAY=DAY+VISC*F(J)*FY(I)/RR ENDIF AAX(I,J)=AAX(I,J)+DAX*DETWT AAY(I,J)=AAY(I,J)+DAY*DETWT ENDDO C Matice PXX,PYY i vektory BX,BY jsou stejne v cylindrickem i kartezskem s.s. DO J=1,KMX C Matice P varianta bez asymetrie PMX(I,J)=PMX(I,J)-FL(J)*FX(I)*DETWT PMY(I,J)=PMY(I,J)-FL(J)*FY(I)*DETWT ENDDO C Vektor B GX,GZ jsou slozky zrychleni BX(I)=BX(I)+(F(I)+ASYM)*RHO*GX*(1-BETA*TEMP)*DETWT BY(I)=BY(I)+(F(I)+ASYM)*RHO*GY*(1-BETA*TEMP)*DETWT ENDDO C Matice H - souciny linearnich bazovych funkci Hi * Hj DO I=1,KMX DO J=1,KMX H(I,J)=H(I,J)+FL(I)*FL(J)*DETWT ENDDO ENDDO ENDDO C C Nulovani matice soustavy a vektoru prave strany C AL=0 BL=0 C C Casovy krok DTIME je systemova promenna C IF(NUE.EQ.6)THEN C 6 UZLOVY TROJUHELNIK sestaveni matic 15 x 15 C Matice M,A (6 x 6) se presouvaji na pozice 1,4,7,10,12,14 (+1) C IZ(1:6)=(/1,4,7,10,12,14/) DO I=1,6 BL(IZ(I))=BX(I)*DTIME BL(IZ(I)+1)=BY(I)*DTIME DO J=1,6 AL(IZ(I),IZ(J))=AAX(I,J)*DTIME+RM(I,J) AL(IZ(I)+1,IZ(J)+1)=AAY(I,J)*DTIME+RM(I,J) BL(IZ(I))=BL(IZ(I))+RM(I,J)*VXOLD(J)
56
BL(IZ(I)+1)=BL(IZ(I)+1)+RM(I,J)*VYOLD(J) ENDDO ENDDO C Umisteni prvku PMX a PMY a H DO I=1,3 BL(3*I)=0 DO J=1,3 BL(3*I)=BL(3*I)-H(I,J)*POLD(J)/PENFAKT AL(3*I-2,3*J)=PMX(I,J)*DTIME AL(3*I-1,3*J)=PMY(I,J)*DTIME AL(3*I,3*J-2)=PMX(I,J)*DTIME AL(3*I,3*J-1)=PMY(I,J)*DTIME AL(3*I,3*J)=-H(I,J)/PENFAKT ENDDO ENDDO DO I=4,6 DO J=1,3 AL(2*I+2,3*J)=PMX(I,J)*DTIME AL(2*I+3,3*J)=PMY(I,J)*DTIME AL(3*J,2*I+2)=PMX(I,J)*DTIME AL(3*J,2*I+3)=PMY(I,J)*DTIME ENDDO ENDDO ELSE C C 4 UZLOVY TROJUHELNIK sestaveni matice 7 x 7 C DO I=1,3 I2=2*I BL(I2-1)=BX(I)*DTIME BL(I2)=BY(I)*DTIME DO J=1,3 AL(I2-1,2*J-1)=AAX(I,J)*DTIME+RM(I,J) AL(I2,2*J)=AAY(I,J)*DTIME+RM(I,J) BL(I2-1)=BL(I2-1)+RM(I,J)*VXOLD(J) BL(I2)=BL(I2)+RM(I,J)*VYOLD(J) ENDDO AL(I2-1,7)=PMX(I,1)*DTIME AL(I2,7)=PMY(I,1)*DTIME AL(7,I2-1)=PMX(I,1)*DTIME AL(7,I2)=PMY(I,1)*DTIME AL(7,7)=-H(1,1)/PENFAKT BL(7)=-H(1,1)+POLD(1)/PENFAKT ENDDO ENDIF
EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2+(VYM/R)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET*R*6.282 ENDIF POWER=POWER+EPAR(IE,1) ENDIF C ENDIF ICONTR END
ELSEIF(ICONTR.GT.0)THEN C C Postprocessing - vypocet invariantu, hustoty dissipovane energie a vykonu C IF(NUE.EQ.6)THEN NVEL=6 ELSE NVEL=3 ENDIF L0=LUE(IE) DO IU=1,NVEL IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,2) CASE(10) VY(IU)=VAL(LOC+I,2) END SELECT ENDDO ENDDO C 1.POINT GAUSS CALL FDFT(NVEL,X,Y,0.33333,0.33333,F,FX,FY,DET) VYM=0 DVXDX=0 DVXDY=0 DVYDX=0 DVYDY=0 TEMP=0 R=0 DO I=1,NVEL VYM=VYM+F(I)*VY(I) DVXDX=DVXDX+VX(I)*FX(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) TEMP=TEMP+T(I)*F(I) R=R+Y(I)*F(I) ENDDO IF(NAXIS.EQ.0)THEN C Kartezsky souradny system C DRUHY INVARIANT EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET ELSE C CYLINDRICKY SOURADNY SYSTEM C DRUHY INVARIANT
57
C $S7-KLOC C C C C C C C C C C C
SUBROUTINE CREE(ICONTR,IE,NL,NUE,AL,BL) PLOUZIVY TOK NEWTONSKE KAPALINY: RESENI PROUDOVOU FUNKCI CYLINDRICKY/KARTEZSKY SOURADNY SYSTEM Z,R STACIONARNI PRIPAD. ELEMENTY T3. POUZITI TROJUHELNIKOVYCH PRVKU BAZELEY (NEUPLNE KUBICKE POLYNOMY) VIZ ZIENKIEWICZ (RUSKY PREKLAD), STR. 203 GAUSSOVA INTEGRACE 7 UZLU Vypocet rychlosti ze stanovenych hodnot derivaci proudove funkce INCLUDE '$FEM' PARAMETER (NGAUS=7) DIMENSION AL(NL,NL),BL(NL), / X(3),Y(3),GL1(NGAUS),GL2(NGAUS),W(NGAUS), / F(9),FX(9),FY(9),FXX(9),FYY(9),FXY(9),FL(3),FLX(3),FLY(3), / T(3),VX(3),VY(3) DATA GL1,GL2,W/
/.3333333,.05971587,.4701421,.4701421,.797427,.1012865,.1012865, /.3333333,.4701421,.05971587,.4701421,.1012865,.797427,.1012865, /.225,.13239415,.13239415,.13239415,.12593918,.12593918,.12593918/ IF(NUE.NE.3)THEN C BLOKUJ SESTAVENI WRITE(*,*)' BLOCK NUE=',NUE NUE=0 RETURN ENDIF C ICOUNTS - pocet elementu pro sestaveni/postprocessing/prefront ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C ICONTR=0 proudove funkce L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) X(I)=XX(IU) Y(I)=YY(IU) LOC=LPU(IU) DO J=1,MPU(IU) SELECT CASE(JPU(LOC+J)) CASE(1) T(I)=VAL(LOC+J,3) CASE(9) VX(I)=VAL(LOC+J,3) CASE(10) VY(I)=VAL(LOC+J,3) END SELECT ENDDO ENDDO C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) C EGROUP (1-THERMAL|STRESS,2-NGAUS,3-PLANE/AXISYM) NAXIS=JGROUP(LEGRP,3) C C NULOVANI VEKTORU PRAVE STRANY A MATICE AL BL=0 AL=0 DO IG=1,NGAUS C Vypocet kubickych bazovych funkci CALL FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S) C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)THEN C Vypocet invariantu rychlosti deformace a teploty jen v pripade, C ze je uvazovana promenna viskozita. Pro aproximaci teploty a C rychlosti se pouziji linearni bazove funkce CALL FDFT(3,X,Y,GL1(IG),GL2(IG),FL,FLX,FLY,S) DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 TEMP=0 DO I=1,3 DVXDX=DVXDX+VX(I)*FLX(I) DVYDY=DVYDY+VY(I)*FLY(I) DVXDY=DVXDY+VX(I)*FLY(I) DVYDX=DVYDX+VY(I)*FLX(I) TEMP=TEMP+T(I)*F(I) ENDDO C Druhy invariant je AUX(5), teplota AUX(11) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 AUX(11)=TEMP VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF RR=Y(1)*GL1(IG)+Y(2)*GL2(IG)+Y(3)*(1-GL1(IG)-GL2(IG)) DO I=1,NL DO J=1,NL IF(NAXIS.EQ.1)THEN C Rov.(7) DA=4*(FXY(I)*FXY(J)+FX(I)*FX(J)/RR**2) / -2/RR*(FXY(I)*FX(J)+FXY(J)*FX(I)) / +(FXX(J)-FYY(J)+FY(J)/RR)*(FXX(I)-FYY(I)+FY(I)/RR) AL(I,J)=AL(I,J)+DA*S*W(IG)*VISC/RR ELSE C Rov.(9) DA=(FYY(I)-FXX(I))*(FYY(J)-FXX(J))+4*FXY(I)*FXY(J) AL(I,J)=AL(I,J)+DA*S*W(IG)*VISC ENDIF
C
ENDDO ENDDO ENDDO
ELSEIF(ICONTR.GT.0)THEN C C ICONTR=1 Postprocessing - vypocet rychlosti VX,VY z vypoctenych PSX,PSY C ve vsech uzlech elementu C BL ps1,psx1,psy1, ps2,psx2,psy2, ... C LEGRP=MAX0(1,IGROUP(IE)) NAXIS=JGROUP(LEGRP,3) C Nejprve je treba definovat souradnice, aby bylo mozne v dalsi fazi C pocitat bazove funkce L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) X(I)=XX(IU) Y(I)=YY(IU) ENDDO DO I=1,NUE IU=IABS(IUE(L0+I)) LOC=LPU(IU) DO J=1,MPU(IU) SELECT CASE(JPU(LOC+J)) CASE(9) C VX=DPS/DY IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=BL(3*I) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=BL(3*I)/Y(I) ELSE C rychlost v ose - spravne by to mela byt druha derivace proudove funkce dle R C musela by se tudiz pouzit FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S), C pro bod na ose (musel by se stanovit gaussuv uzel). Spokojime se s hodnotou C druhe derivace FYY v tezisti elementu. CALL FDF3(X,Y,0.33333,0.33333,F,FX,FY,FXX,FYY,FXY,S) VAX=0 DO K=1,9 VAX=VAX+FYY(K)*BL(K) ENDDO VAL(LOC+J,3)=VAX ENDIF CASE(10) C VY=-DPS/DX IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=-BL(3*I-1) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=-BL(3*I-1)/Y(I) ELSE C Radialni slozka rychlosti na ose je nulova VAL(LOC+J,3)=0 ENDIF END SELECT ENDDO ENDDO ENDIF END SUBROUTINE PSIN(ICONTR,IE,NL,NUE,AL,BL) C C C C C C C C C C
PROUDENI NEWTONSKE KAPALINY: RESENI CYLINDRICKY NEBO KARTEZSKY SOURADNY UVAZUJI SE NESTACIONARNI CLENY (BEZ ITERACNI RESENI JE NEZBYTNE, CASOVY
PROUDOVOU FUNKCI SYSTEM Z,R UPWINDU). KROK MUSI BYT VETSI NEZ 0.
POUZITI TROJUHELNIKOVYCH PRVKU BAZELEY (NEUPLNE KUBICKE POLYNOMY) SEE ZIENKIEWICZ, STR. 203 GAUSSOVA INTEGRACE 7 UZLU INCLUDE '$FEM' PARAMETER (NGAUS=7) DIMENSION AL(NL,NL),BL(NL),RM(9,9),BK(9,3), / X(3),Y(3),GL1(NGAUS),GL2(NGAUS),W(NGAUS), / F(9),FX(9),FY(9),FXX(9),FYY(9),FXY(9),FL(3),FLX(3),FLY(3), / VX(3),VY(3),T(3),POLD(9) DATA GL1,GL2,W/
/.3333333,.05971587,.4701421,.4701421,.797427,.1012865,.1012865, /.3333333,.4701421,.05971587,.4701421,.1012865,.797427,.1012865, /.225,.13239415,.13239415,.13239415,.12593918,.12593918,.12593918/ C TEST PRIPUSTNOSTI ELEMENTU IF(NUE.NE.3)THEN NUE=0 RETURN ENDIF C Pocitadlo zpracovanych elementu ICOUNTS=ICOUNTS+1 IF(ICONTR.EQ.0)THEN C C Vypocet proudove funkce C L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) X(I)=XX(IU) Y(I)=YY(IU) LOC=LPU(IU) C stanoveni rychlosti, teploty a predchozich hodnot proudove funkce C ve trech vrcholech trojuhelnikoveho elementu
58
C VX-9,VY-10,T-1,PS-14 DO J=1,MPU(IU) SELECT CASE (JPU(LOC+J)) CASE(1) T(I)=VAL(LOC+J,3) CASE(9) VX(I)=VAL(LOC+J,3) CASE(10) VY(I)=VAL(LOC+J,3) CASE(14) POLD(3*I-2)=VAL(LOC+J,3) CASE(15) POLD(3*I-1)=VAL(LOC+J,3) CASE(16) POLD(3*I)=VAL(LOC+J,3) ENDSELECT ENDDO ENDDO C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-THERMAL|STRESS,2-NGAUS,3-PLANE/AXISYM) NAXIS=JGROUP(LEGRP,3) C C NULOVANI VEKTORU PRAVE STRANY, MATICE AL, MATICE HMOT RM, VZTLAKU BK B=0 AL=0 RM=0 BK=0 C 7-mi bodova Gaussova integrace matic DO IG=1,NGAUS C Linearni bazove funkce a jejich derivace CALL FDFT(3,X,Y,GL1(IG),GL2(IG),FL,FLX,FLY,S) C Rychlosti a teploty v integracnim uzlu VVX=0 VVY=0 TMEAN=0 DO I=1,3 VVX=VVX+VX(I)*FL(I) VVY=VVY+VY(I)*FL(I) TMEAN=TMEAN+T(I)*FL(I) ENDDO C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) VISC=RMAT(LPROP,7) RHO=RMAT(LPROP,3) BETA=RMAT(LPROP,8) C TEMPERATURE DEPENDENCIES AUX(11)=TEMP IF(JMAT(LPROP,7).NE.0)THEN DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 TEMP=0 DO I=1,3 DVXDX=DVXDX+VX(I)*FLX(I) DVYDY=DVYDY+VY(I)*FLY(I) DVXDY=DVXDY+VX(I)*FLY(I) DVYDX=DVYDX+VY(I)*FLX(I) TEMP=TEMP+T(I)*F(I) ENDDO C Druhy invariant je AUX(5), teplota AUX(11) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,8)) C Kubicke bazove funkce a jejich derivace CALL FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S) C RR-polomer Gaussova uzlu RR=Y(1)*GL1(IG)+Y(2)*GL2(IG)+Y(3)*(1-GL1(IG)-GL2(IG)) DO I=1,NL DO J=1,NL IF(NAXIS.EQ.1)THEN C cylindricky s.s. rovnice (34) DA=(FXX(J)+FYY(J)-FY(J)/RR)/RR* / (RHO*(VVX*FX(I)+VVY*FY(I))+ / VISC*(FXX(I)+FYY(I)-FY(I)/RR)) C Rov.(33) DC=RHO*(FX(I)*FX(J)+FY(I)*FY(J))/RR ELSE C kartezsky souradny system, Rov.(22) DA=(FXX(J)+FYY(J))* / (RHO*(VVX*FX(I)+VVY*FY(I))+ / VISC*(FXX(I)+FYY(I))) C Rov.(21) DC=RHO*(FX(I)*FX(J)+FY(I)*FY(J)) ENDIF AL(I,J)=AL(I,J)+DA*S*W(IG) RM(I,J)=RM(I,J)+DC*S*W(IG) ENDDO C Prirozena konvekce. RALGOR(1)-gx, RALGOR(2)-gy (nezavisle na s.s.) DO J=1,3 C Rov.(24) DB=RHO*BETA*F(I)*(GX*FLY(J)-GY*FLX(J)) BK(I,J)=BK(I,J)+DB*S*W(IG) ENDDO ENDDO ENDDO C (M+dt.A).PS = M.PS0+dt.B.T, Rov.(25) DO I=1,NL DO J=1,NL AL(I,J)=RM(I,J)+AL(I,J)*DTIME BL(I)=BL(I)+RM(I,J)*POLD(J) ENDDO
C
DO J=1,3 BL(I)=BL(I)+DTIME*BK(I,J)*T(J) ENDDO ENDDO
ELSEIF(ICONTR.GT.0)THEN C C ICONTR=1 Postprocessing - vypocet rychlosti VX,VY z vypoctenych PSX,PSY C ve vsech uzlech elementu C BL ps1,psx1,psy1, ps2,psx2,psy2, ... C LEGRP=MAX0(1,IGROUP(IE)) NAXIS=JGROUP(LEGRP,3) L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) Y(I)=YY(IU) LOC=LPU(IU) DO J=1,MPU(IU) SELECT CASE(JPU(LOC+J)) CASE(9) C VX=DPS/DY IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=BL(3*I) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=BL(3*I)/Y(I) ELSE C rychlost v ose - spravne by to mela byt druha derivace proudove funkce dle R C musela by se tudiz pouzit FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S), C pro bod na ose (musel by se stanovit gaussuv uzel). Spokojime se s hodnotou C druhe derivace FYY v tezisti elementu. CALL FDF3(X,Y,0.33333,0.33333,F,FX,FY,FXX,FYY,FXY,S) VAX=0 DO K=1,9 VAX=VAX+FYY(K)*BL(K) ENDDO VAL(LOC+J,3)=VAX ENDIF CASE(10) C VY=-DPS/DX IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=-BL(3*I-1) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=-BL(3*I-1)/Y(I) ELSE C Radialni slozka rychlosti na ose je nulova VAL(LOC+J,3)=0 ENDIF END SELECT ENDDO ENDDO ENDIF END SUBROUTINE PSBL(ICONTR,IE,NL,NUE,AL,BL) C C PROUDENI NEWTONSKE KAPALINY: RESENI PROUDOVOU FUNKCI C CYLINDRICKY NEBO KARTEZSKY SOURADNY SYSTEM Z,R C UVAZUJI SE NESTACIONARNI CLENY (BEZ UPWINDU). C C POUZITI TROJUHELNIKOVYCH PRVKU BELL (POLYNOMY 5-TEHO STUPNE, 18 DOF) C GAUSSOVA INTEGRACE 7 UZLU C INCLUDE '$FEM' PARAMETER (NGAUS=7) DIMENSION AL(NL,NL),BL(NL),RM(18,18),BK(18,3), / X(3),Y(3),GL1(NGAUS),GL2(NGAUS),W(NGAUS), / F(18),FX(18),FY(18),FXX(18),FYY(18),FXY(18),FL(3),FLX(3),FLY(3), / VX(3),VY(3),T(3),POLD(18) DATA GL1,GL2,W/ /.3333333,.05971587,.4701421,.4701421,.797427,.1012865,.1012865, /.3333333,.4701421,.05971587,.4701421,.1012865,.797427,.1012865, /.225,.13239415,.13239415,.13239415,.12593918,.12593918,.12593918/ IF(ICONTR.EQ.0)THEN C C Vypocet proudove funkce C L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) X(I)=XX(IU) Y(I)=YY(IU) LOC=LPU(IU) C stanoveni rychlosti, teploty a predchozich hodnot proudove funkce C ve trech vrcholech trojuhelnikoveho elementu C VX-9,VY-10,T-1,PS-14 DO J=1,MPU(IU) SELECT CASE (JPU(LOC+J)) CASE(1) T(I)=VAL(LOC+J,3) CASE(9) VX(I)=VAL(LOC+J,3) CASE(10) VY(I)=VAL(LOC+J,3) CASE(14) POLD(3*I-2)=VAL(LOC+J,3) CASE(15)
59
POLD(3*I-1)=VAL(LOC+J,3) CASE(16) POLD(3*I)=VAL(LOC+J,3) ENDSELECT ENDDO ENDDO C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-THERMAL|STRESS,2-NGAUS,3-PLANE/AXISYM) NAXIS=JGROUP(LEGRP,3) C C NULOVANI VEKTORU PRAVE STRANY, MATICE AL, MATICE HMOT RM, VZTLAKU BK B=0 AL=0 RM=0 BK=0 C 7-mi bodova Gaussova integrace matic DO IG=1,NGAUS C Linearni bazove funkce a jejich derivace CALL FDFT(3,X,Y,GL1(IG),GL2(IG),FL,FLX,FLY,S) C Rychlosti a teploty v integracnim uzlu VVX=0 VVY=0 TMEAN=0 DO I=1,3 VVX=VVX+VX(I)*FL(I) VVY=VVY+VY(I)*FL(I) TMEAN=TMEAN+T(I)*FL(I) ENDDO C MPROP (1-K,2-C,3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-beta) VISC=RMAT(LPROP,7) RHO=RMAT(LPROP,3) BETA=RMAT(LPROP,8) C TEMPERATURE DEPENDENCIES AUX(11)=TEMP IF(JMAT(LPROP,7).NE.0)THEN DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 TEMP=0 DO I=1,3 DVXDX=DVXDX+VX(I)*FLX(I) DVYDY=DVYDY+VY(I)*FLY(I) DVXDY=DVXDY+VX(I)*FLY(I) DVYDX=DVYDX+VY(I)*FLX(I) TEMP=TEMP+T(I)*F(I) ENDDO C Druhy invariant je AUX(5), teplota AUX(11) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,8)) C Kubicke bazove funkce a jejich derivace CALL FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S) C RR-polomer Gaussova uzlu RR=Y(1)*GL1(IG)+Y(2)*GL2(IG)+Y(3)*(1-GL1(IG)-GL2(IG)) DO I=1,NL DO J=1,NL IF(NAXIS.EQ.1)THEN C cylindricky s.s. rovnice (34) DA=(FXX(J)+FYY(J)-FY(J)/RR)/RR* / (RHO*(VVX*FX(I)+VVY*FY(I))+ / VISC*(FXX(I)+FYY(I)-FY(I)/RR)) C Rov.(33) DC=RHO*(FX(I)*FX(J)+FY(I)*FY(J))/RR ELSE C kartezsky souradny system, Rov.(22) DA=(FXX(J)+FYY(J))* / (RHO*(VVX*FX(I)+VVY*FY(I))+ / VISC*(FXX(I)+FYY(I))) C Rov.(21) DC=RHO*(FX(I)*FX(J)+FY(I)*FY(J)) ENDIF AL(I,J)=AL(I,J)+DA*S*W(IG) RM(I,J)=RM(I,J)+DC*S*W(IG) ENDDO C Prirozena konvekce. RALGOR(1)-gx, RALGOR(2)-gy (nezavisle na s.s.) DO J=1,3 C Rov.(24) DB=RHO*BETA*F(I)*(GX*FLY(J)-GY*FLX(J)) BK(I,J)=BK(I,J)+DB*S*W(IG) ENDDO ENDDO ENDDO C (M+dt.A).PS = M.PS0+dt.B.T, Rov.(25) DO I=1,NL DO J=1,NL AL(I,J)=RM(I,J)+AL(I,J)*DTIME BL(I)=BL(I)+RM(I,J)*POLD(J) ENDDO DO J=1,3 BL(I)=BL(I)+DTIME*BK(I,J)*T(J) ENDDO ENDDO ELSE C C ICONTR=1 Postprocessing - vypocet rychlosti VX,VY z vypoctenych PSX,PSY C ve vsech uzlech elementu C BL ps1,psx1,psy1, ps2,psx2,psy2, ... C LEGRP=MAX0(1,IGROUP(IE))
NAXIS=JGROUP(LEGRP,3) L0=LUE(IE) DO I=1,NUE IU=IABS(IUE(L0+I)) Y(I)=YY(IU) LOC=LPU(IU) DO J=1,MPU(IU) SELECT CASE(JPU(LOC+J)) CASE(9) C VX=DPS/DY IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=BL(3*I) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=BL(3*I)/Y(I) ELSE C rychlost v ose - spravne by to mela byt druha derivace proudove funkce dle R C musela by se tudiz pouzit FDF3(X,Y,GL1(IG),GL2(IG),F,FX,FY,FXX,FYY,FXY,S), C pro bod na ose (musel by se stanovit gaussuv uzel). Spokojime se s hodnotou C druhe derivace FYY v tezisti elementu. CALL FDF3(X,Y,0.33333,0.33333,F,FX,FY,FXX,FYY,FXY,S) VAX=0 DO K=1,9 VAX=VAX+FYY(K)*BL(K) ENDDO VAL(LOC+J,3)=VAX ENDIF CASE(10) C VY=-DPS/DX IF(NAXIS.EQ.0)THEN VAL(LOC+J,3)=-BL(3*I-1) ELSEIF(Y(I).NE.0.)THEN VAL(LOC+J,3)=-BL(3*I-1)/Y(I) ELSE C Radialni slozka rychlosti na ose je nulova VAL(LOC+J,3)=0 ENDIF END SELECT ENDDO ENDDO ENDIF END
60
VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE VYM=VYM/NUE SUBROUTINE PSOM(ICONTR,IE,NL,NUE,AL,BL) DX=XMAX-XMIN C DY=YMAX-YMIN C NAVIER STOKES - PSI (promenna 14), OMEGA (promenna 13) C Skalarni soucin rychlosti a "uhlopricky" C OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT HV=VXM*DX+VYM*DY C C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST C Elementy: T3,T6,Q4,Q8 (v kazdem uzlu dva parametry PSI,OMEGA) UMEAN=SQRT(VXM**2+VYM**2) C Gaussova integrace T:1,3,4,7 Q:1,2,3 IF(UMEAN.GT.0.)THEN C Konvekce: UPWIND (Zienkiewicz) HMEAN=HV/UMEAN C Zdrojovy clen: prirozena konvekce ELSE C Okrajove podminky: je treba vyznacit cast hranice, HMEAN=SQRT(DX**2+DY**2) C kde neni zadane omega, IPU>20 (typicky STENA) ENDIF C Integrace v case: implicitni, 1.rad C C Rychlosti VX,VY z predchozi iterace v zone 3 ==================================================================== C (na rychlosti se nevztahuji pocatecni podminky) == C C Urceni krivek, ktere tvori hranici elementu a na nichz je treba INCLUDE '$FEM' C vyhodnotit krivkovy integral. Vychazi se ze seznamu hranicnich DIMENSION X(9),Y(9),AL(NL,NL),BL(NL), / AM(9,9),RM(9,9),CM(9,9),DM(9,9),BM(9,9),XG(3),YG(3), uzlu C IBND(NBND). Vysledkem je matice IBCR(3,*), jejich sloupce definuji / T(9),VX(9),VY(9),OMG(9), krivku / IBND(9),IBCR(3,3),NINER(3),VGX(3),VGY(3), C indexy (1,2,..NUE) uzlu. Krivka je urcena dvema nebo tremi body, / G(3),G1(9),G2(9),WT(9),W(3),F(9),FK(3),FX(9),FY(9) zalezi C C na typu elementu. Pocet krivek je NBCR. Kazde krivce je take C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY prirazen C AM-MATICE PRENOSU, RM-MATICE HMOT, CM-MATICE VIRIVOSTI C uzel NINER(*) lezici uvnitr oblasti - tim je definovan vnitrek a C DM-MATICE LAPLAC.OP.,BM-VZTLAK vnejsek. C T,OMG-TEPLOTY,VIRIVOSTI Z PREDCHOZI ITERACE, C C VX,VY-rychlosti proudeni IF(NBND.GT.1)THEN C IBND-indexy uzlu na hranici Gamma, NBCR=0 C IBCR-uzly hranicnich krivek, IBCR=0 C NINER-kazde hranicni krivce je prirazen uzel lezici uvnitr oblasti SELECT CASE(NUE) C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO CASE (3) TROJUHELNIK C C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO C Trojuhelnik se 3 uzly. 1 nebo 2 strany jsou casti hranice (2 nebo TROJUHELNIK 3 uzly). C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE (FK derivace dle ksi) C C 33333333333333333333333333333333333333333333333333333333333333333333 C Ze zony $FEM jsou vyuzivany i prvky 33333 C IALGOR(2)-potlaceni vypoctu konvektivnich clenu IF(NBND.EQ.2)THEN C IALGOR(4)-potlaceni vypoctu zdroje tepla C Jen jedna strana je casti hranice C IALGOR(5)-upwind NBCR=1 C IBCR(1,1)=IBND(1) C TEST PRIPUSTNOSTI ELEMENTU IBCR(2,1)=IBND(2) IF(NUE.LT.3)THEN NINER(1)=IIND NUE=0 ELSE RETURN C Dve strany jsou casti hranice. Vsechny 3 vrcholy lezi na hranici a ENDIF neni jasne C Pocitadlo zpracovavanych elementu C kterou ze tri stran vyradit. Tato vyjimecna situace se resi ICOUNTS=ICOUNTS+1 prohlizenim IF(ICONTR.EQ.0)THEN C cele matice konektivity - hleda se vrchol, jehoz uzel neni C soucasti zadneho C ICONTR=0 Vypocet proudove funkce a virivosti C jineho elementu. C DO IB=1,3 C Stanoveni uzlovych teplot T(*) a rychlosti VX(*),VY(*) z C Stanoveni globalniho indexu uzlu predchozich kroku. INDU=IABS(IUE(L0+IBND(IB))) C Identifikace uzlu elementu IBND(*), v nich je status teploty NB=0 C 20 < IPU . DO J=1,NE C Tento uzel je povazovan za uzel lezici na STENE, kde neni znama LOC=LUE(J) virivost. DO K=1,NUE C Dale je urcovan obdelnik ramujici dany element IF(IABS(IUE(LOC+K)).EQ.INDU)NB=NB+1 (Xmin,Xmax,Ymin,Ymax), ENDDO C a pocita se vektor stredni rychlosti proudeni VXM,VYM. Tyto ENDDO hodnoty IF(NB.EQ.1)THEN C budou vyuzity pro vypocet Pecletova cisla elementu. ICORN=IB C EXIT XMIN=1E10 ENDIF XMAX=-1E10 ENDDO YMIN=1E10 C Uzel ICORN (1,2,3) je roh - v matici konektivity se vyskytl jen YMAX=-1E10 jednou. VXM=0 IF(ICORN.NE.0)THEN VYM=0 NBCR=2 L0=LUE(IE) IBCR(1,1)=IBND(ICORN) C NBND - pocet uzlu elementu na hranici s neznamou hodnotou pro IBCR(1,2)=IBND(ICORN) OMEGA (stena) IC1=MOD(ICORN,3)+1 NBND=0 IC2=MOD(IC1,3)+1 DO IU=1,NUE IBCR(2,1)=IBND(IC1) IND=IABS(IUE(L0+IU)) IBCR(2,2)=IBND(IC2) X(IU)=XX(IND) NINER(1)=IBND(IC2) Y(IU)=YY(IND) NINER(2)=IBND(IC1) XMIN=AMIN1(XMIN,X(IU)) ENDIF XMAX=AMAX1(XMAX,X(IU)) ENDIF YMIN=AMIN1(YMIN,Y(IU)) CASE(4) YMAX=AMAX1(YMAX,Y(IU)) C Ctyruhelnik se 4-uzly. 1 nebo 2 strany casti hranice (2 nebo 3 LOC=LPU(IND) uzly) DO I=1,MPU(IND) C SELECT CASE(JPU(LOC+I)) 44444444444444444444444444444444444444444444444444444444444444444444 CASE(1) IF(NBND.EQ.2)THEN T(IU)=VAL(LOC+I,3) C Jen jedna strana je casti hranice CASE(9) NBCR=1 VX(IU)=VAL(LOC+I,3) IBCR(1,1)=IBND(1) CASE(10) IBCR(2,1)=IBND(2) VY(IU)=VAL(LOC+I,3) NINER(1)=IIND CASE(13) ELSE OMG(IU)=VAL(LOC+I,3) C Soucasti hranice jsou dve strany (3 vylucujeme, i kdyz je to C Identifikace uzlu steny (virivost) IPU>20 teoreticky mozne) IF(IPU(LOC+I).GT.20)THEN NBCR=2 NBND=NBND+1 NINER(1)=IIND IBND(NBND)=IU NINER(2)=IIND ELSE IIND=IU IF(IBND(1).EQ.1.AND.IBND(2).EQ.2.AND.IBND(3).EQ.3)THEN ENDIF IBCR(1,1)=1 END SELECT IBCR(2,1)=2 ENDDO IBCR(1,2)=2 VXM=VXM+VX(IU) IBCR(2,2)=3
C $S8-KLOC
61
DO I=1,NGAUS DO J=1,NGAUS NGSS=NGSS+1 G1(NGSS)=G(I) G2(NGSS)=G(J) WT(NGSS)=W(I)*W(J) ENDDO ELSEIF(IBND(1).EQ.1.AND.IBND(2).EQ.3.AND.IBND(3).EQ.4)THEN ENDDO IBCR(1,1)=3 ENDIF IBCR(2,1)=4 C ---------------konec sekce vypoctu souradnic integracnich bodu IBCR(1,2)=4 C IBCR(2,2)=1 C NULOVANI MATIC PRENOSU A HMOTNOSTI A ZDROJOVYCH CLENU - rozmer NUE AM=0 ELSEIF(IBND(1).EQ.1.AND.IBND(2).EQ.2.AND.IBND(3).EQ.4)THEN RM=0 IBCR(1,1)=1 DM=0 IBCR(2,1)=2 CM=0 IBCR(1,2)=4 BM=0 IBCR(2,2)=1 C ENDIF C SESTAVENI MATICE AM(vazke sily a konvekce),RM(hmotnosti), vektor ENDIF BM CASE (6) DO IG=1,NGSS C C Bazove funkce F(i) a jejich derivace v integracnim bode IG C Trojuhelnik se 6 uzly. 1 nebo 2 strany (3 nebo 5 uzlu na hranici) IF(NUE.EQ.3.OR.NUE.EQ.6)THEN C 66666666666666666666666666666666666666666666666666666666666666666 CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) NBCR=NBND/2 ELSE DO IB=1,NBCR CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) NINER(IB)=IIND ENDIF C Stredni uzel identifikuje stranu DETWT=DET*WT(IG) IBCR(3,IB)=IBND(NBCR+1+IB) C-------------------------------------------------------IBCR(1,IB)=IBCR(3,IB)-3 C Bazove funkce F(i) umoznuji vypocitat teplotu v uzlu (z vektoru IBCR(2,IB)=IBCR(3,IB)-2 TM) IF(IBCR(2,IB).GT.3)IBCR(2,IB)=1 C a pro tuto teplotu pak vypocitat termofyzikalni parametry ENDDO C CASE (8) TEMP=0 C VVX=0 C Ctyruhelnik s 8 uzly. 1,2 nebo 3 strany (3,5 nebo 7 uzlu na VVY=0 hranici) RR=0 C DO I=1,NUE 88888888888888888888888888888888888888888888888888888888888888888888 TEMP=TEMP+F(I)*T(I) NBCR=NBND/2 RR=RR+Y(I)*F(I) DO IB=1,NBCR VVX=VVX+VX(I)*F(I) NINER(IB)=IIND VVY=VVY+VY(I)*F(I) C Stredni uzel identifikuje stranu ENDDO IBCR(3,IB)=IBND(NBCR+1+IB) AUX(11)=TEMP IBCR(1,IB)=IBCR(3,IB)-4 C MPROP (3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) IBCR(2,IB)=IBCR(3,IB)-3 RHO=RMAT(LPROP,3) IF(IBCR(2,IB).GT.4)IBCR(2,IB)=1 VISC=RMAT(LPROP,7) ENDDO BETA=RMAT(LPROP,8) END SELECT IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) ENDIF IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,4)) C Konec sekce, ktera identifikovala hranicni krivky (IBCR) IF(JMAT(LPROP,7).NE.0)THEN C C Vypocet invariantu rychlosti deformace jen v pripade, ==================================================================== C ze je uvazovana promenna viskozita = DVXDX=0 C EGROUP,MPROP,RCONST DVYDY=0 LEGRP=MAX0(1,IGROUP(IE)) DVXDY=0 LPROP=MAX0(1,IMAT(IE)) DVYDX=0 LRCON=MAX0(1,IRCONS(IE)) DO I=1,NUE C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) DVXDX=DVXDX+VX(I)*FX(I) NONST=JGROUP(LEGRP,1) DVYDY=DVYDY+VY(I)*FY(I) NGAUS=JGROUP(LEGRP,2) DVXDY=DVXDY+VX(I)*FY(I) NAXIS=JGROUP(LEGRP,3) DVYDX=DVYDX+VY(I)*FX(I) C RCONST (1-THICKNESS) ENDDO H=RCONST(LRCON,1) C Druhy invariant je AUX(5) C AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 C Vypocet uzlu Gaussovy integrace zvlast pro trojuhelniky a VISC=VISC*CURFUN(JMAT(LPROP,7)) ctyruhelniky ENDIF C -----------------------------------------------------------------AOPT=0 --C Vypocet REYNOLDSOVA cisla jen pro pripad uvazovani konvekce IF(NUE.EQ.3.OR.NUE.EQ.6)THEN (IALGOR(2)) C trojuhelnikove elementy C a nastaveni upwindu (IALGOR(5)) NGSS=NGAUS IF(IALGOR(2).NE.0.AND.IALGOR(5).NE.0)THEN IF(NGAUS.EQ.3)THEN C Soucinitel upwind ALF jako funkce REYNOLDSOVA cisla elementu G1(1:3)=(/.5,.0,0.5/) PE=UMEAN*HMEAN*RHO/(2*VISC) G2(1:3)=(/.5,.5,0./) IF(PE.GT.0.)THEN WT(1:3)=(/.333333,.333333,.333333/) PE=AMIN1(PE,50.) ELSEIF(NGAUS.EQ.4)THEN EE=EXP(PE) G1(1:4)=(/.333333,11./15.,2./15.,2./15./) ALF=(EE+1./EE)/(EE-1./EE)-1./PE G2(1:4)=(/.333333,2./15.,11./15.,2./15./) C Korekcni koeficient zadavany uzivatelem RALGOR(5)=RUPW WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) AOPT=ALF*RUPW*HMEAN/(2*UMEAN) ELSEIF(NGAUS.EQ.7)THEN ELSE G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, AOPT=0 / .1012865,.1012865/) ENDIF G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, ENDIF / .797427,.1012865/) C SESTAVENI WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, DO I=1,NUE / .12593918,.12593918/) IF(NAXIS.EQ.1)THEN ELSE ASYM=AOPT*(VVX*FX(I)+VVY*FY(I)-VVY*F(I)/RR) NGSS=1 ELSE G1(1)=0.3333333 ASYM=AOPT*(VVX*FX(I)+VVY*FY(I)) G2(1)=0.3333333 ENDIF WT(1)=1. DO J=1,NUE ENDIF C Matice M ELSE RM(I,J)=RM(I,J)+RHO*F(I)*F(J)*DETWT C Isoparametric 4 or 8-node element. CM(I,J)=CM(I,J)+F(I)*F(J)*DETWT IF(NGAUS.EQ.2)THEN IF(NAXIS.EQ.1)THEN G(1:2)=(/-.57735,.57735/) C Cylindricky souradny system W(1:2)=(/1.,1./) C Matice A ELSEIF(NGAUS.EQ.3)THEN CONV=RHO*(F(I)+ASYM)*(VVX*FX(J)+VVY*FY(J)G(1:3)=(/-.77459666,0.,.77459666/) VVY*F(J)/RR) W(1:3)=(/.5555555,.8888888,.555555/) ELSE DA=CONV+VISC*(FX(I)*FX(J)+FY(I)*FY(J)+F(J)*FY(I)/RR) NGAUS=1 DM(I,J)=DM(I,J)+(FX(I)*FX(J)+FY(I)*FY(J))/RR*DETWT G(1)=0. ELSE W(1)=2. C kartezsky souradny system ENDIF CONV=RHO*(F(I)+ASYM)*(VVX*FX(J)+VVY*FY(J)) NGSS=0 DA=CONV+VISC*(FX(I)*FX(J)+FY(I)*FY(J)) ELSEIF(IBND(1).EQ.2.AND.IBND(2).EQ.3.AND.IBND(3).EQ.4)THEN IBCR(1,1)=2 IBCR(2,1)=3 IBCR(1,2)=3 IBCR(2,2)=4
62
DM(I,J)=DM(I,J)+(FX(I)*FX(J)+FY(I)*FY(J))*DETWT ENDIF AM(I,J)=AM(I,J)+DA*DETWT C Vektor B GX,GZ jsou slozky zrychleni BM(I,J)=BM(I,J)+CONV*BETA*(GY*FX(J)-GX*FY(J))*DETWT ENDDO ENDDO ENDDO C C Prispevek hranicnich integralu k matici AM. Pocet krivek je NBCR, C tvorici uzly ve sloupcich IBCR. NINER-uzel lezici uvnitr. C Krivkove integraly pocitane 3-bodovou Gaussovou integraci C G(1:3)=(/-.77459666,0.,.77459666/) W(1:3)=(/.5555555,.8888888,.555555/) C Pocet hranicnich krivek je NBCR DO IC=1,NBCR IF(IBCR(3,IC).EQ.0)THEN NU=2 ELSE NU=3 ENDIF DO I=1,NU XG(I)=X(IBCR(I,IC)) YG(I)=Y(IBCR(I,IC)) VGX(I)=VX(IBCR(I,IC)) VGY(I)=VY(IBCR(I,IC)) ENDDO C Souradnice vnitrniho uzlu XINER=X(NINER(IC)) YINER=Y(NINER(IC)) DO IG=1,3 C Bazove funkce F(*) v integracnim uzlu IG pocita procedura FDCR CALL FDCR(NU,XG,YG,G(IG),F,FK,FX,FY,DET) C Polomer RR v integracnim uzlu IG RR=0 AA=0 XKSI=0 YKSI=0 DO I=1,NU RR=RR+YG(I)*F(I) XKSI=XKSI+XG(I)*FK(I) YKSI=YKSI+YG(I)*FK(I) ENDDO SUMS=SQRT(XKSI**2+YKSI**2) RNX=YKSI/SUMS RNY=-XKSI/SUMS C Urceni smeru normaly RNX,RNY ze znamenka skalarniho soucinu normaly C a vnitrni strany SKS=RNX*(XINER-XG(1))+RNY*(YINER*YG(1)) IF(SKS.GT.0.)THEN RNX=-RNX RNY=-RNY ENDIF C Urceni viskozity na stene VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)THEN C Vypocet invariantu rychlosti deformace na stene DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 DO I=1,NU DVXDX=DVXDX+VGX(I)*FX(I) DVYDY=DVYDY+VGY(I)*FY(I) DVXDY=DVXDY+VGX(I)*FY(I) DVYDX=DVYDX+VGY(I)*FX(I) ENDDO C Druhy invariant je AUX(5) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF C Pricteni prispevku k matici AM DO I=1,NU IQ=IBCR(I,IC) DO J=1,NU JQ=IBCR(J,IC) IF(NAXIS.EQ.1)THEN AM(IQ,JQ)=AM(IQ,JQ)-VISC*F(I)* / (FX(J)*RNX+FY(J)*RNY+F(J)*RNY/RR)*W(IG)*DET*H*AA ELSE AM(IQ,JQ)=AM(IQ,JQ)-VISC*F(I)* / (FX(J)*RNX+FY(J)*RNY)*W(IG)*DET*H*AA ENDIF ENDDO ENDDO ENDDO ENDDO C C MATICE SOUSTAVY [[AL]] ma rozmer NL = 2 x NUE C C DTIME je systemova promenna COMMON /FEM/... C AL=0 BL=0 DO I=1,NUE IF(NONST.EQ.1)THEN C Nestacionarni pripad DO J=1,NUE BL(2*I-1)=BL(2*I-1)+RM(I,J)*OMG(J)+BM(I,J)*T(J)*DTIME AL(2*I-1,2*J-1)=RM(I,J)+AM(I,J)*DTIME AL(2*I,2*J-1)=CM(I,J) AL(2*I,2*J)=DM(I,J) ENDDO ELSE
C Stacionarni pripad DO J=1,NUE BL(2*I-1)=BL(2*I-1)+BM(I,J)*T(J) AL(2*I-1,2*J-1)=AM(I,J) AL(2*I,2*J-1)=CM(I,J) AL(2*I,2*J)=DM(I,J) ENDDO ENDIF ENDDO ELSE C C ICONTR=1 Postprocessing - vypocet rychlosti z proudove funkce C ENDIF END SUBROUTINE PENS(ICONTR,IE,NL,NUE,AL,BL) C C NAVIER STOKESOVY ROVNICE - UPWIND PENALTY METHOD (uzlove prametry Vx,Vy) C OPTIONS: PLANE/AXISYM, STEADY/TRANSIENT C Elementy: T3,T6,Q4,Q8 (v kazdem uzlu dva parametry VX,VY) C Gaussova integrace T:1,3,4,7 Q:1,2,3 C Konvekce: UPWIND (Zienkiewicz) C Zdrojovy clen: prirozena konvekce C Integrace v case: implicitni, 1.rad C INCLUDE '$FEM' DIMENSION X(9),Y(9),AL(NL,NL),BL(NL), / AMX(9,9),AMY(9,9),RM(9,9),PMX(9,9),PMY(9,9), / BMX(9),BMY(9), / T(9),VX(9),VY(9),VXOLD(9),VYOLD(9), / G(3),G1(9),G2(9),WT(9),W(3),F(9),FX(9),FY(9) C C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY C AM-MATICE PRENOSU, RM-MATICE HMOT, PM-NAHRADA GRAD.TLAKU C BM-VZTLAK C T -TEPLOTY Z PREDCHOZI ITERACE, C VX,VY-rychlosti proudeni C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO TROJUHELNIK C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO TROJUHELNIK C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE (FK derivace dle ksi) C C Ze zony $FEM jsou vyuzivany i prvky C IALGOR(2)-potlaceni vypoctu konvektivnich clenu C IALGOR(4)-potlaceni vypoctu zdroje tepla C IALGOR(5)-upwind C C TEST PRIPUSTNOSTI ELEMENTU C IF(NUE.LT.3)THEN NUE=0 RETURN ENDIF C Pocitadlo zpracovavanych elementu ICOUNTS=ICOUNTS+1 C EGROUP,MPROP,RCONST LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) NONST=JGROUP(LEGRP,1) NGAUS=JGROUP(LEGRP,2) NAXIS=JGROUP(LEGRP,3) C RCONST (1-THICKNESS) H=RCONST(LRCON,1) IF(ICONTR.EQ.0)THEN C C Stanoveni uzlovych teplot T(*) a rychlosti VX(*),VY(*) z predchozich kroku. C XMIN=1E10 XMAX=-1E10 YMIN=1E10 YMAX=-1E10 VXM=0 VYM=0 L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) XMIN=AMIN1(XMIN,X(IU)) XMAX=AMAX1(XMAX,X(IU)) YMIN=AMIN1(YMIN,Y(IU)) YMAX=AMAX1(YMAX,Y(IU)) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,4) VXOLD(IU)=VAL(LOC+I,3) CASE(10) VY(IU)=VAL(LOC+I,4) VYOLD(IU)=VAL(LOC+I,3) END SELECT ENDDO VXM=VXM+VX(IU) VYM=VYM+VY(IU) ENDDO VXM=VXM/NUE
63
VYM=VYM/NUE DX=XMAX-XMIN DY=YMAX-YMIN C Skalarni soucin rychlosti a "uhlopricky" HV=VXM*DX+VYM*DY C CHARAKTERISTICKY ROZMER ELEMENTU A CHARAKTERISTICKA RYCHLOST UMEAN=SQRT(VXM**2+VYM**2) IF(UMEAN.GT.0.)THEN HMEAN=HV/UMEAN ELSE HMEAN=SQRT(DX**2+DY**2) ENDIF C C Vypocet uzlu Gaussovy integrace zvlast pro trojuhelniky a ctyruhelniky C -------------------------------------------------------------------IF(NUE.EQ.3.OR.NUE.EQ.6)THEN C trojuhelnikove elementy NGSS=NGAUS IF(NGAUS.EQ.3)THEN G1(1:3)=(/.5,.0,0.5/) G2(1:3)=(/.5,.5,0./) WT(1:3)=(/.333333,.333333,.333333/) ELSEIF(NGAUS.EQ.4)THEN G1(1:4)=(/.333333,11./15.,2./15.,2./15./) G2(1:4)=(/.333333,2./15.,11./15.,2./15./) WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) ELSEIF(NGAUS.EQ.7)THEN G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, / .1012865,.1012865/) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, / .797427,.1012865/) WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, / .12593918,.12593918/) ELSE NGSS=1 G1(1)=0.3333333 G2(1)=0.3333333 WT(1)=1. ENDIF ELSE C Isoparametric 4 or 8-node element. IF(NGAUS.EQ.2)THEN G(1:2)=(/-.57735,.57735/) W(1:2)=(/1.,1./) ELSEIF(NGAUS.EQ.3)THEN G(1:3)=(/-.77459666,0.,.77459666/) W(1:3)=(/.5555555,.8888888,.555555/) ELSE NGAUS=1 G(1)=0. W(1)=2. ENDIF NGSS=0 DO I=1,NGAUS DO J=1,NGAUS NGSS=NGSS+1 G1(NGSS)=G(I) G2(NGSS)=G(J) WT(NGSS)=W(I)*W(J) ENDDO ENDDO ENDIF C ---------------konec sekce vypoctu souradnic integracnich bodu C GX,GY jsou slozky zrychleni C PENFAKT penalizacni faktor C C NULOVANI MATIC PRENOSU A HMOTNOSTI A ZDROJOVYCH CLENU - rozmer NUE AMX=0 AMY=0 RM=0 PMX=0 PMY=0 BM=0 C C SESTAVENI MATICE AM(vazke sily a konvekce),RM(hmotnosti), vektor BM DO IG=1,NGSS C Bazove funkce F(i) a jejich derivace v integracnim bode IG IF(NUE.EQ.3.OR.NUE.EQ.6)THEN CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ELSE CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) ENDIF DETWT=DET*WT(IG) C-------------------------------------------------------C Bazove funkce F(i) umoznuji vypocitat teplotu v uzlu (z vektoru TM) C a pro tuto teplotu pak vypocitat termofyzikalni parametry C TEMP=0 VVX=0 VVY=0 RR=0 DO I=1,NUE TEMP=TEMP+F(I)*T(I) RR=RR+Y(I)*F(I) VVX=VVX+VX(I)*F(I) VVY=VVY+VY(I)*F(I) ENDDO AUX(11)=TEMP C MPROP (3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) RHO=RMAT(LPROP,3) VISC=RMAT(LPROP,7) BETA=RMAT(LPROP,8) IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3))
IF(JMAT(LPROP,8).NE.0)BETA=BETA*CURFUN(JMAT(LPROP,4)) IF(JMAT(LPROP,7).NE.0)THEN C Vypocet invariantu rychlosti deformace jen v pripade, C ze je uvazovana promenna viskozita DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 DO I=1,NUE DVXDX=DVXDX+VX(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) ENDDO C Druhy invariant je AUX(5) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF AOPT=0 C Vypocet REYNOLDSOVA cisla jen pro pripad uvazovani konvekce (IALGOR(2)) C a nastaveni upwindu (IALGOR(5)) IF(IALGOR(2).NE.0.AND.IALGOR(5).NE.0)THEN C Soucinitel upwind ALF jako funkce REYNOLDSOVA cisla elementu PE=UMEAN*HMEAN*RHO/(2*VISC) IF(PE.GT.0.)THEN PE=AMIN1(PE,50.) EE=EXP(PE) ALF=(EE+1./EE)/(EE-1./EE)-1./PE C Korekcni koeficient zadavany uzivatelem RALGOR(5)=RUPW AOPT=ALF*RUPW*HMEAN/(2*UMEAN) ELSE AOPT=0 ENDIF ENDIF C SESTAVENI DO I=1,NUE ASYM=AOPT*(VVX*FX(I)+VVY*FY(I)) BMX(I)=BMX(I)+(F(I)+ASYM)*RHO*BETA*GX*(1BETA*TEMP)*DETWT BMY(I)=BMY(I)+(F(I)+ASYM)*RHO*BETA*GY*(1BETA*TEMP)*DETWT DO J=1,NUE C Matice M RM(I,J)=RM(I,J)+RHO*F(I)*F(J)*DETWT CONV=RHO*(F(I)+ASYM)*(VVX*FX(J)+VVY*FY(J)) IF(NAXIS.EQ.1)THEN C Cylindricky souradny system C Matice A,P DAX=CONV+VISC*(FY(I)*FY(J)-F(I)*FY(J)/RR)+ / (VISC+PENFAKT)*FX(I)*FX(J) DAY=CONV+(VISC+PENFAKT)*(FY(I)*FY(J)+F(J)*FY(I)/RR)+ / VISC*FX(I)*FX(J) DPX=PENFAKT*(FX(I)*FY(J)+F(J)*FX(I)/RR) DPY=PENFAKT*FX(I)*FY(J) ELSE C kartezsky souradny system DAX=CONV+VISC*FY(I)*FY(J)+ / (VISC+PENFAKT)*FX(I)*FX(J) DAY=CONV+(VISC+PENFAKT)*FY(I)*FY(J)+ / VISC*FX(I)*FX(J) DPX=PENFAKT*0.5*(FX(I)*FY(J)+FY(I)*FX(J)) DPY=DPX ENDIF AMX(I,J)=AMX(I,J)+DAX*DETWT AMY(I,J)=AMY(I,J)+DAY*DETWT PMX(I,J)=PMX(I,J)+DPX*DETWT PMY(I,J)=PMY(I,J)+DPY*DETWT ENDDO ENDDO ENDDO C C MATICE SOUSTAVY [[AL]] ma rozmer NL = 2 x NUE C C DTIME je systemova promenna COMMON /FEM/... C AL=0 BL=0 DO I=1,NUE IF(NONST.EQ.1)THEN C Nestacionarni pripad BL(2*I-1)=BMX(I)*DTIME BL(2*I)=BMY(I)*DTIME DO J=1,NUE BL(2*I-1)=BL(2*I-1)+RM(I,J)*VXOLD(J) BL(2*I)=BL(2*I)+RM(I,J)*VYOLD(J) AL(2*I-1,2*J-1)=RM(I,J)+AMX(I,J)*DTIME AL(2*I,2*J)=RM(I,J)+AMY(I,J)*DTIME AL(2*I-1,2*J)=PMX(I,J)*DTIME AL(2*I,2*J-1)=PMY(I,J)*DTIME ENDDO ELSE C Stacionarni BL(2*I-1)=BMX(I) BL(2*I)=BMY(I) DO J=1,NUE AL(2*I-1,2*J-1)=AMX(I,J) AL(2*I,2*J)=AMY(I,J) AL(2*I-1,2*J)=PMX(I,J) AL(2*I,2*J-1)=PMY(I,J) ENDDO ENDIF ENDDO C
ELSEIF(ICONTR.GT.0)THEN
64
C Postprocessing - vypocet invariantu, hustoty dissipovane energie a C EGROUP,MPROP,RCONST vykonu LEGRP=MAX0(1,IGROUP(IE)) C LPROP=MAX0(1,IMAT(IE)) L0=LUE(IE) LRCON=MAX0(1,IRCONS(IE)) DO IU=1,NUE C EGROUP (1-TRANSIENT|STATIC,2-NGAUS,3-PLANE/AXISYM) IND=IABS(IUE(L0+IU)) NGAUS=JGROUP(LEGRP,2) X(IU)=XX(IND) NAXIS=JGROUP(LEGRP,3) Y(IU)=YY(IND) C RCONST (1-THICKNESS) LOC=LPU(IND) H=RCONST(LRCON,1) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) IF(ICONTR.EQ.0)THEN CASE(1) C T(IU)=VAL(LOC+I,3) C Stanoveni uzlovych teplot T(*) a rychlosti VX(*),VY(*) z CASE(9) predchozich kroku. VX(IU)=VAL(LOC+I,2) C CASE(10) L0=LUE(IE) VY(IU)=VAL(LOC+I,2) DO IU=1,NUE END SELECT IND=IABS(IUE(L0+IU)) ENDDO X(IU)=XX(IND) ENDDO Y(IU)=YY(IND) C 1.POINT GAUSS LOC=LPU(IND) IF(NUE.EQ.3.OR.NUE.EQ.6)THEN DO I=1,MPU(IND) CALL FDFT(NUE,X,Y,.33333,.33333,F,FX,FY,DET) SELECT CASE(JPU(LOC+I)) ELSE CASE(1) CALL FDFQ(NUE,X,Y,0.,0.,F,FX,FY,DET) T(IU)=VAL(LOC+I,3) DET=DET*4 CASE(9) ENDIF VX(IU)=VAL(LOC+I,3) VYM=0 CASE(10) DVXDX=0 VY(IU)=VAL(LOC+I,3) DVXDY=0 END SELECT DVYDX=0 ENDDO DVYDY=0 ENDDO TEMP=0 C R=0 C Vypocet uzlu Gaussovy integrace zvlast pro trojuhelniky a DO I=1,NUE ctyruhelniky VYM=VYM+F(I)*VY(I) C -------------------------------------------------------------------DVXDX=DVXDX+VX(I)*FX(I) DVXDY=DVXDY+VX(I)*FY(I) IF(NUE.EQ.3.OR.NUE.EQ.6)THEN DVYDX=DVYDX+VY(I)*FX(I) C trojuhelnikove elementy DVYDY=DVYDY+VY(I)*FY(I) NGSS=NGAUS TEMP=TEMP+T(I)*F(I) IF(NGAUS.EQ.3)THEN R=R+Y(I)*F(I) G1(1:3)=(/.5,.0,0.5/) ENDDO G2(1:3)=(/.5,.5,0./) IF(NAXIS.EQ.0)THEN WT(1:3)=(/.333333,.333333,.333333/) C Kartezsky souradny system ELSEIF(NGAUS.EQ.4)THEN C DRUHY INVARIANT G1(1:4)=(/.333333,11./15.,2./15.,2./15./) EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 G2(1:4)=(/.333333,2./15.,11./15.,2./15./) C DISSIPACE WT(1:4)=(/-27./48.,25./48.,25./48.,25./48./) AUX(11)=TEMP ELSEIF(NGAUS.EQ.7)THEN AUX(5)=EPAR(IE,3) G1(1:7)=(/.3333333,.05971587,.4701421,.4701421,.797427, VISC=RMAT(LPROP,7) / .1012865,.1012865/) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) G2(1:7)=(/.3333333,.4701421,.05971587,.4701421,.1012865, EPAR(IE,2)=2*VISC*EPAR(IE,3) / .797427,.1012865/) C DISSIPOVANY VYKON WT(1:7)=(/.225,.13239415,.13239415,.13239415,.12593918, EPAR(IE,1)=EPAR(IE,2)*DET / .12593918,.12593918/) ELSE ELSE C CYLINDRICKY SOURADNY SYSTEM NGSS=1 C DRUHY INVARIANT G1(1)=0.3333333 G2(1)=0.3333333 EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2+(VYM/R)**2 WT(1)=1. C DISSIPACE ENDIF AUX(11)=TEMP ELSE AUX(5)=EPAR(IE,3) C Isoparametric 4 or 8-node element. VISC=RMAT(LPROP,7) IF(NGAUS.EQ.2)THEN IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) G(1:2)=(/-.57735,.57735/) EPAR(IE,2)=2*VISC*EPAR(IE,3) W(1:2)=(/1.,1./) C DISSIPOVANY VYKON ELSEIF(NGAUS.EQ.3)THEN EPAR(IE,1)=EPAR(IE,2)*DET*R*6.282 G(1:3)=(/-.77459666,0.,.77459666/) ENDIF W(1:3)=(/.5555555,.8888888,.555555/) POWER=POWER+EPAR(IE,1) ELSE ENDIF NGAUS=1 C ENDIF ICONTR G(1)=0. END W(1)=2. ENDIF NGSS=0 SUBROUTINE MIDE(ICONTR,IE,NL,NUE,AL,BL) DO I=1,NGAUS C DO J=1,NGAUS C MINIMUM DISSPIVANE A KINETICKE ENERGIE metoda nejmensich ctvercu NGSS=NGSS+1 (uzlove prametry Vx,Vy) G1(NGSS)=G(I) C OPTIONS: PLANE/AXISYM, G2(NGSS)=G(J) C Elementy: T3,T6,Q4,Q8 (v kazdem uzlu dva parametry VX,VY) WT(NGSS)=W(I)*W(J) C Gaussova integrace T:1,3,4,7 Q:1,2,3 ENDDO C ENDDO INCLUDE '$FEM' ENDIF DIMENSION X(9),Y(9),AL(NL,NL),BL(NL), C ---------------konec sekce vypoctu souradnic integracnich bodu / AXX(9,9),AXY(9,9),AYX(9,9),AYY(9,9), C PENFAKT penalizacni faktor (viz $FEM) / T(9),VX(9),VY(9), C / G(3),G1(9),G2(9),WT(9),W(3),F(9),FX(9),FY(9) C NULOVANI MATIC PRENOSU - rozmer NUE C AXX=0 C AL-MATICE SOUSTAVY, BL-VEKTOR PRAVE STRANY AXY=0 C AM-MATICE PRENOSU, AYX=0 C T -TEPLOTY Z PREDCHOZI ITERACE, AYY=0 C VX,VY-rychlosti proudeni C C G -GAUSSOVY UZLY PRO 4-UHELNIK, G1,G2-GAUSSOVY UZLY PRO C SESTAVENI MATIC AXX TROJUHELNIK C C W -VAHY GAUS.UZLU PRO 4-UHELNIK, WT-VAHY GAUS. UZLU PRO DO IG=1,NGSS TROJUHELNIK C Bazove funkce F(i) a jejich derivace v integracnim bode IG C F,FX,FY-BAZOVE FUNKCE A JEJICH DERIVACE (FK derivace dle ksi) IF(NUE.EQ.3.OR.NUE.EQ.6)THEN C CALL FDFT(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) C TEST PRIPUSTNOSTI ELEMENTU ELSE C CALL FDFQ(NUE,X,Y,G1(IG),G2(IG),F,FX,FY,DET) IF(NUE.LT.3)THEN ENDIF NUE=0 DETWT=DET*WT(IG) RETURN C-------------------------------------------------------ENDIF C Bazove funkce F(i) umoznuji vypocitat teplotu v uzlu (z vektoru C Pocitadlo zpracovavanych elementu TM) ICOUNTS=ICOUNTS+1 C a pro tuto teplotu pak vypocitat termofyzikalni parametry
65
C
C
C C
C
C
C
C
TEMP=0 VVX=0 VVY=0 RR=0 DO I=1,NUE TEMP=TEMP+F(I)*T(I) RR=RR+Y(I)*F(I) VVX=VVX+VX(I)*F(I) VVY=VVY+VY(I)*F(I) ENDDO AUX(11)=TEMP MPROP (3-RHO,4-KAPPA,5-E,6-MU,7-VISC,8-BETA) RHO=RMAT(LPROP,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,3).NE.0)RHO=RHO*CURFUN(JMAT(LPROP,3)) IF(JMAT(LPROP,7).NE.0)THEN Vypocet invariantu rychlosti deformace jen v pripade, ze je uvazovana promenna viskozita DVXDX=0 DVYDY=0 DVXDY=0 DVYDX=0 DO I=1,NUE DVXDX=DVXDX+VX(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) ENDDO Druhy invariant je AUX(5) AUX(5)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 VISC=VISC*CURFUN(JMAT(LPROP,7)) ENDIF SESTAVENI DO I=1,NUE DO J=1,NUE IF(NAXIS.EQ.1)THEN Cylindricky souradny system DXX=RR*((4*VISC+2*PENFAKT)*FX(I)*FX(J)+ / 2*VISC*FY(I)*FY(J)+RHO*F(I)*F(J)) DXY=2*RR*(VISC*FY(I)*FX(J)+PENFAKT*FX(I)*FY(J)+ / PENFAKT*F(J)/RR*FX(I)) DYX=2*RR*(VISC*FX(I)*FY(J)+PENFAKT*FY(I)*FX(J)+ / PENFAKT*F(I)/RR*FX(J)) DYY=RR*((4*VISC+2*PENFAKT)*FY(I)*FY(J)+ / 2*VISC*FX(I)*FX(J)+ / (RHO+(4*VISC+2*PENFAKT)/RR**2)*F(I)*F(J)+ / 2*PENFAKT/RR*(F(I)*FY(J)+F(J)*FY(I))) ELSE kartezsky souradny system DXX=(4*VISC+2*PENFAKT)*FX(I)*FX(J)+ / 2*VISC*FY(I)*FY(J)+RHO*F(I)*F(J) DXY=2*(VISC*FY(I)*FX(J)+PENFAKT*FX(I)*FY(J)) DYX=2*(VISC*FX(I)*FY(J)+PENFAKT*FY(I)*FX(J)) DYY=(4*VISC+2*PENFAKT)*FY(I)*FY(J)+ / 2*VISC*FX(I)*FX(J)+RHO*F(I)*F(J) ENDIF AXX(I,J)=AXX(I,J)+DXX*DETWT AXY(I,J)=AXY(I,J)+DXY*DETWT AYX(I,J)=AYX(I,J)+DYX*DETWT AYY(I,J)=AYY(I,J)+DYY*DETWT ENDDO ENDDO ENDDO
C C C
C C C
ENDIF VYM=0 DVXDX=0 DVXDY=0 DVYDX=0 DVYDY=0 TEMP=0 R=0 DO I=1,NUE VYM=VYM+F(I)*VY(I) DVXDX=DVXDX+VX(I)*FX(I) DVXDY=DVXDY+VX(I)*FY(I) DVYDX=DVYDX+VY(I)*FX(I) DVYDY=DVYDY+VY(I)*FY(I) TEMP=TEMP+T(I)*F(I) R=R+Y(I)*F(I) ENDDO IF(NAXIS.EQ.0)THEN Kartezsky souradny system DRUHY INVARIANT EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2 DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET ELSE CYLINDRICKY SOURADNY SYSTEM DRUHY INVARIANT
EPAR(IE,3)=DVXDX**2+DVYDY**2+0.5*(DVXDY+DVYDX)**2+(VYM/R)**2 C DISSIPACE AUX(11)=TEMP AUX(5)=EPAR(IE,3) VISC=RMAT(LPROP,7) IF(JMAT(LPROP,7).NE.0)VISC=VISC*CURFUN(JMAT(LPROP,7)) EPAR(IE,2)=2*VISC*EPAR(IE,3) C DISSIPOVANY VYKON EPAR(IE,1)=EPAR(IE,2)*DET*R*6.282 ENDIF POWER=POWER+EPAR(IE,1) C ----ENDIF ICONTR ENDIF END
C C MATICE SOUSTAVY [[AL]] ma rozmer NL = 2 x NUE C AL=0 BL=0 DO I=1,NUE C Stacionarni DO J=1,NUE AL(2*I-1,2*J-1)=AXX(I,J) AL(2*I,2*J)=AYY(I,J) AL(2*I-1,2*J)=AXY(I,J) AL(2*I,2*J-1)=AYX(I,J) ENDDO ENDDO
ELSEIF(ICONTR.GT.0)THEN C C Postprocessing - vypocet invariantu, hustoty dissipovane energie a vykonu C L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) DO I=1,MPU(IND) SELECT CASE(JPU(LOC+I)) CASE(1) T(IU)=VAL(LOC+I,3) CASE(9) VX(IU)=VAL(LOC+I,2) CASE(10) VY(IU)=VAL(LOC+I,2) END SELECT ENDDO ENDDO C 1.POINT GAUSS IF(NUE.EQ.3.OR.NUE.EQ.6)THEN CALL FDFT(NUE,X,Y,.33333,.33333,F,FX,FY,DET) ELSE CALL FDFQ(NUE,X,Y,0.,0.,F,FX,FY,DET) DET=DET*4
66
C $S9-KLOC SUBROUTINE SHEL(ICONTR,IE,NL,NUE,AL,BL) C C ICONTR=0 - LOKALNI MATICE TUHOSTI A VEKTOR ZATIZENI TLAKEM C ICONTR=1 - VYPOCET VNITRNICH SIL V TEZISTI ELEMENTU C INCLUDE '$FEM' DIMENSION AL(NL,NL),BL(NL),R(2),X(2),U(2),W(2),BETA(2) IF(NUE.NE.2.OR.NL.NE.6)THEN NUE=0 RETURN ENDIF ICOUNTS=ICOUNTS+1 L0=LUE(IE) C C SOURADNICE X-VODOROVNE OSA SYMETRIE, Y-POLOMER C 2-UX 3-UY (OZNACENI U,W) DO IU=1,NUE IND=IABS(IUE(L0+IU)) R(IU)=YY(IND) X(IU)=XX(IND) LOC=LPU(IND) U(IU)=VAL(LOC+1,2) W(IU)=VAL(LOC+2,2) BETA(IU)=VAL(LOC+3,2) ENDDO C VLASTNOSTI LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C MPROP (1-K,2-C,3-RHO,KAPPA,E,MU) A=K/(RHO*C) E=RMAT(LPROP,5) RMI=RMAT(LPROP,6) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE) T=RCONST(LRCON,1) P=RCONST(LRCON,3) C D11=E*T/(1-RMI**2) D22=D11 D12=D11*RMI D33=D11*T**2/12 D44=D33 D34=D33*RMI D55=5*E*T/(12*(1+RMI)) RL=SQRT((R(1)-R(2))**2+(X(1)-X(2))**2) C=(X(2)-X(1))/RL S=(R(2)-R(1))/RL RC=(R(1)+R(2))*.5 IF(ICONTR.EQ.0)THEN C C FRONTALNI METODA C S2=S**2 C2=C**2 RC4=4*RC**2 AL(1,1)=RC*(D11*C2+D55*S2)/RL AL(4,4)=AL(1,1) AL(1,4)=-AL(1,1) AL(1,2)=C*RC*(S*(D11-D55)-RL*D12/(2*RC))/RL AL(2,4)=-AL(1,2) AL(4,5)=C*RC*(S*(D11-D55)+RL*D12/(2*RC))/RL AL(1,5)=-AL(4,5) AL(3,4)=RC*S/2*D55 AL(1,6)=-AL(3,4) AL(1,3)=-AL(3,4) AL(4,6)=AL(3,4) AL(2,3)=RC*C/2*D55 AL(5,6)=-AL(2,3) AL(3,5)=-AL(2,3) AL(2,6)=AL(2,3) H1=S*D34/RC H2=D33/RL+D55*RL/4+S2*RL*D44/RC4 AL(3,3)=RC*(H2-H1) AL(6,6)=RC*(H2+H1) W1=(S2*D11+C2*D55)/RL W2=RL*D22/RC4 AL(2,2)=RC*(W1+W2-S*D12/RC) AL(5,5)=RC*(W1+W2+S*D12/RC) AL(2,5)=RL*D22/(4*RC)-RC*W1 AL(3,6)=RC*(-D33/RL+S2*RL*D44/RC4+D55*RL/4) DO1I=2,6 DO1J=1,I-1 1 AL(I,J)=AL(J,I) PL8=P*RL/8 BL(1)=-PL8*S*(3*R(1)+R(2)) BL(2)= PL8*C*(3*R(1)+R(2)) BL(3)=0 BL(4)=-PL8*S*(R(1)+3*R(2)) BL(5)= PL8*C*(R(1)+3*R(2)) BL(6)=0 ELSE C C VNITRNI SILY: U-POSUN X W-POSUN R C WM=W(2)-W(1) UM=U(2)-U(1) UP=U(1)+U(2) c WM=U(2)-U(1) c UM=W(2)-W(1) c UP=W(1)+W(1) BM=BETA(2)-BETA(1) BP=BETA(1)+BETA(2) RN1=C*D11/RL*WM+S*D11/RL*UM+D12*UP/(2*RC) RN2=C*D12/RL*WM+S*D12/RL*UM+D22*UP/(2*RC)
RM1=D33*BM/RL+S*D34*BP/(2*RC) RM2=D34/RL*BM+S*D33*BP/(2*RC) Q=S*D55*WM/RL+C*D55*UM/RL+D55*BP/2 EPAR(IE,1)=RN1 EPAR(IE,2)=RN2 EPAR(IE,3)=RM1 EPAR(IE,4)=RM2 EPAR(IE,5)=Q ENDIF END SUBROUTINE TRUSEN(ENERGY) INCLUDE '$FEM' C C Celkova energie prutove soustavy C DIMENSION UX(2),UY(2),X(2),Y(2) ENERGY=0 DO IE=1,NE C C Modul pruznosti EX a prurez tahla A C LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) EX=RMAT(LPROP,5) A=RCONST(LRCON,6) L0=LUE(IE) DO I=1,2 IU=IABS(IUE(L0+I)) X(I)=XX(IU) Y(I)=YY(IU) LOC=LPU(IU) DO J=1,MPU(IU) C C Urceni posuvu C IF(JPU(LOC+J).EQ.2)THEN UX(I)=VAL(LOC+J,2) ELSEIF(JPU(LOC+J).EQ.3)THEN UY(I)=VAL(LOC+J,2) ENDIF ENDDO ENDDO RL0=SQRT((X(1)-X(2))**2+(Y(1)-Y(2))**2) RL1=SQRT((X(1)+UX(1)-X(2)-UX(2))**2+(Y(1)+UY(1)-Y(2)UY(2))**2) ENERGY=ENERGY+0.5*EX*A*(RL1-RL0)**2/RL0 ENDDO C Zmena potencialni energie pusobenim vnejsich sil DO IU=1,ND LOC=LPU(IU) DO J=1,MPU(IU) IF((JPU(LOC+J).EQ.2.OR.JPU(LOC+J).EQ.3) / .AND.IPU(LOC+J).GT.0) / ENERGY=ENERGY-VAL(LOC+J,1)*VAL(LOC+J,2) ENDDO ENDDO END SUBROUTINE PLANE2(ICONTR,IE,NL,NUE,A,B) INCLUDE '$FEM' C Input: IE-index of element, NL-dimension, NUE-number of nodes DIMENSION A(NL,NL),B(NL), / X(8),Y(8),G(2),W(2),F(8),FX(8),FY(8),U(8),V(8) DATA G,W,NGAUS/-.57735,.57735, /1.,1.,2/ IF(NUE.NE.3.AND.NUE.NE.4.AND.NUE.NE.8)THEN NUE=0 RETURN ENDIF ICOUNTS=ICOUNTS+1 C C Nodal values C L0=LUE(IE) DO IU=1,NUE IND=IABS(IUE(L0+IU)) X(IU)=XX(IND) Y(IU)=YY(IND) LOC=LPU(IND) U(IU)=VAL(LOC+1,2) V(IU)=VAL(LOC+2,2) ENDDO C VLASTNOSTI LEGRP=MAX0(1,IGROUP(IE)) LPROP=MAX0(1,IMAT(IE)) LRCON=MAX0(1,IRCONS(IE)) C MPROP (1-K,2-C,3-RHO,KAPPA,E,MU) A=K/(RHO*C) E=RMAT(LPROP,5) RMI=RMAT(LPROP,6) C RCONST (1-THICKNESS,2-DIAMETER,3-PRESSURE) T=RCONST(LRCON,1) C IF(ICONTR.EQ.0)THEN C C ASSEMBLY C Type of element according to DOF C IF(NUE.EQ.3)THEN C triangular element (S2 is twice the triangle area) S2=X(2)*Y(3)-X(3)*Y(2)-X(1)*Y(3)+X(3)*Y(1)+ / X(1)*Y(2)-X(2)*Y(1) E1=S2/2.*E/(1-RMI**2) DO I=1,3 I1=MOD(I,3)+1 I2=MOD(I1,3)+1 FX(I)=(Y(I1)-Y(I2))/S2
67
FY(I)=(X(I2)-X(I1))/S2 ENDDO DO I=1,3 DO J=1,3 A(2*I-1,2*J-1)=E1*(FX(I)*FX(J)+(1-RMI)/2.*FY(I)*FY(J)) A(2*I,2*J)=E1*(FY(I)*FY(J)+(1-RMI)/2.*FX(I)*FX(J)) A(2*I,2*J-1)=E1*(RMI*FY(I)*FX(J)+(1RMI)/2.*FX(I)*FY(J)) A(2*I-1,2*J)=E1*(RMI*FX(I)*FY(J)+(1RMI)/2.*FY(I)*FX(J)) ENDDO ENDDO ELSEIF(NUE.EQ.4.OR.NUE.EQ.8)THEN C Isoparametric 4 or 8-node element. Gaussian integration 2 x 2 DO I=1,NL DO J=1,NL A(I,J)=0. ENDDO B(I)=0 ENDDO DO IG=1,NGAUS DO JG=1,NGAUS CALL FDFQ(NUEQ,X,Y,G(IG),G(JG),F,FX,FY,DET) E1=DET*W(IG)*W(JG)*E/(1-RMI**2) DO I=1,NUE I1=2*I-1 I2=2*I DO J=1,NUE J1=2*J-1 J2=2*J A(I1,J1)=A(I1,J1)+E1*(FX(I)*FX(J)+ / (1-RMI)/2.*FY(I)*FY(J)) A(I2,J2)=A(I2,J2)+E1*(FY(I)*FY(J)+ / (1-RMI)/2.*FX(I)*FX(J)) A(I2,J1)=A(I2,J1)+E1*(RMI*FY(I)*FX(J)+ / (1-RMI)/2.*FX(I)*FY(J)) A(I1,J2)=A(I1,J2)+E1*(RMI*FX(I)*FY(J)+ / (1-RMI)/2.*FY(I)*FX(J)) ENDDO ENDDO ENDDO ENDDO ENDIF ELSE C Post processing - vypocet deformaci a napeti ENDIF END
68
C $S10-AUX SUBROUTINE NCOMPRES C C Vyrazeni uzlu, ktere se nevyskytuji v matici konektivity C INCLUDE '$FEM' IU=0 NDLOOP:DO WHILE(IU.LT.ND) IU=IU+1 C Hledej vyskyt uzlu v matici konektivity DO IE=1,NE LOC=LUE(IE) MU=IABS(MUE(IE)) DO J=1,MU IN=IABS(IUE(LOC+J)) IF(IU.EQ.IN)CYCLE NDLOOP ENDDO ENDDO C Uzel nenalezen - ZRUSIT CALL NDDEL(IU) IU=IU-1 ENDDO NDLOOP END SUBROUTINE NDDEL(IND) C C Zruseni uzlu cislo IND C C 1) zkraceni vektoru (presun o 1 vlevo) LPU(),KINDU(),MPU(),XX(),YY(),ZZ() C 2) v matici konektivity zmensit o jednicku vsechny indexy >IND (uzel IND by C v matici konektivity vubec nemel byt,mela by predchazet procedura MERGE). C Pokud se IND v matici konektivity vyskytne, musi byt odpovidajici element C take vyrazen. C INCLUDE '$FEM' IF(IND.GT.0.AND.IND.LE.ND)THEN ND=ND-1 DO I=IND,ND LPU(I)=LPU(I+1) MPU(I)=MPU(I+1) XX(I)=XX(I+1) YY(I)=YY(I+1) KINDU(I)=KINDU(I+1) ENDDO LPU(ND+1)=LPU(ND+2) C Uprava matice konektivity IE=0 DO WHILE(IE.LT.NE) IE=IE+1 LOC=LUE(IE) MU=IABS(MUE(IE)) DO J=1,MU IU=IABS(IUE(LOC+J)) IF(IU.GT.IND)THEN IUE(LOC+J)=IU-1 ELSEIF(IU.EQ.IND)THEN CALL EDEL(IE) EXIT ENDIF ENDDO ENDDO ENDIF END SUBROUTINE EDEL(IEL) C C Zruseni elementu IEL cislo ND C C Zkraceni vektoru (presun o 1 vlevo) LUE(),MUE() C INCLUDE '$FEM' IF(IEL.GT.0.AND.IEL.LE.NE)THEN NE=NE-1 DO I=IEL,NE LUE(I)=LUE(I+1) MUE(I)=MUE(I+1) ENDDO LUE(NE+1)=LUE(NE+2) ENDIF END SUBROUTINE NIDENT(JMI,KBD) C C IDENTIFIKACE UZLU LOKATOREM C USE MSFLIB INCLUDE '$FEM' II=SETACTIVEQQ(20) II=FOCUSQQ(20) C operace GMFCOM je nejasna, ale bez ni to nefunguje c CALL GMFCOM(1) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 JMI=1 DO J=1,ND DIST=(XX(J)-PX)**2+(YY(J)-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST JMI=J
ENDIF ENDDO CALL GMFMRKL(XX(JMI),YY(JMI),20,JMI,1) END SUBROUTINE PIDENT(JMI,KBD) C C IDENTIFIKACE PT LOKATOREM C USE MSFLIB INCLUDE '$FEM' II=SETACTIVEQQ(20) II=FOCUSQQ(20) C operace GMFCOM je nejasna, ale bez ni to nefunguje c CALL GMFCOM(1) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 JMI=1 DO J=1,NPT DIST=(PTX(J)-PX)**2+(PTY(J)-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST JMI=J ENDIF ENDDO CALL GMFMRK(PTX(JMI),PTY(JMI),37) END SUBROUTINE EIDENT(JMI,KBD) C C IDENTIFIKACE EL LOKATOREM C USE MSFLIB INCLUDE '$FEM' II=SETACTIVEQQ(20) II=FOCUSQQ(20) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 XTE=0 YTE=0 JMI=1 DO J=1,NE C teziste elementu J XT=0 YT=0 L0=LUE(J) NUE=MAX0(IABS(MUE(J)),1) DO I=1,NUE IND=MAX0(IABS(IUE(L0+I)),1) XT=XT+XX(IND) YT=YT+YY(IND) ENDDO XT=XT/NUE YT=YT/NUE DIST=(XT-PX)**2+(YT-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST XTE=XT YTE=YT JMI=J ENDIF ENDDO CALL GMFMRKL(XTE,YTE,20,JMI,1) END SUBROUTINE CIDENT(JMI,KBD) C C IDENTIFIKACE CR LOKATOREM C USE MSFLIB INCLUDE '$FEM' II=SETACTIVEQQ(20) II=FOCUSQQ(20) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 XTE=0 YTE=0 JMI=1 DO J=1,NCR C teziste KRIVKY J XT=0 YT=0 DO I=1,MCR(J) IND=ICR(I,J) XT=XT+PTX(IND) YT=YT+PTY(IND) ENDDO XT=XT/MCR(J) YT=YT/MCR(J) DIST=(XT-PX)**2+(YT-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST XTE=XT YTE=YT JMI=J ENDIF ENDDO CALL GMFMRKL(XTE,YTE,20,JMI,1) END SUBROUTINE TIDENT(IMI,JMI,KBD) C C IDENTIFIKACE TC krivky LOKATOREM C IMI -index bodu krivky JMI C USE MSFLIB INCLUDE '$FEM'
69
II=SETACTIVEQQ(20) II=FOCUSQQ(20) C operace GMFCOM je nejasna, ale bez ni to nefunguje c CALL GMFCOM(1) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 JMI=1 IMI=1 DO J=1,MAXSEL DO I=1,NGR(J) DIST=(TGR(I,J)-PX)**2+(YGR(I,J)-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST JMI=J IMI=I ENDIF ENDDO ENDDO CALL GMFMRKL(TGR(IMI,JMI),YGR(IMI,JMI),20,JMI,1) END SUBROUTINE UIDENT(IMI,J,KBD) C C IDENTIFIKACE jednoho bodu TC krivky LOKATOREM C J - zadany index krivky C IMI - index nejblizsiho bodu krivky JMI C USE MSFLIB INCLUDE '$FEM' II=SETACTIVEQQ(20) II=FOCUSQQ(20) C operace GMFCOM je nejasna, ale bez ni to nefunguje c CALL GMFCOM(1) CALL GMFLCC(PX,PY,KBD) DISMIN=1E10 IMI=1 DO I=1,NGR(J) DIST=(TGR(I,J)-PX)**2+(YGR(I,J)-PY)**2 IF(DIST.LT.DISMIN)THEN DISMIN=DIST IMI=I ENDIF ENDDO CALL GMFMRKL(TGR(IMI,J),YGR(IMI,J),20,IMI,1) END SUBROUTINE FTMCR2(IC1,IC2,NX, / IRC1,IRC2,IMAT1,IMAT2,KGROUP,IRHEXC) C C C C C C
ELEMENTY TYPU VYMENIK DEFINOVANE ZE DVOU KRIVEK IC1,IC2 (NX elementu na kazde krivce). GENERUJI SE SOUCASNE I ELEMENTY TYPU PIPE (RC skupiny IRC1,IRC2, MPROP skupiny IMAT1,IMAT2, elementove skupiny KGROUP)
INCLUDE '$FEM' DIMENSION I1(2),I2(2),IR(2),IM(2) C IR(K),IM(K) skupina RC resp MPROP krivky K IR(1)=IRC1 IR(2)=IRC2 IM(1)=IMAT1 IM(2)=IMAT2 C I1(K)-PRVNI, I2(K)-DRUHY bod krivky K I1(1)=ICR(1,IC1) I2(1)=ICR(2,IC1) I1(2)=ICR(1,IC2) I2(2)=ICR(2,IC2) C TEST SPRAVNE ORIENTACE BODU DX1=PTX(I2(1))-PTX(I1(1)) DX2=PTX(I2(2))-PTX(I1(2)) DY1=PTY(I2(1))-PTY(I1(1)) DY2=PTY(I2(2))-PTY(I1(2)) IF(DX1*DX2.LT.0..OR.DY1*DY2.LT.0.)THEN C PREHOZENI INDEXU 1 A 2 I=I1(1) I1(1)=I2(1) I2(1)=I ENDIF NDOLD=ND DO I=1,NX+1 DO IC=1,2 IP1=I1(IC) IP2=I2(IC) DX=(PTX(IP2)-PTX(IP1))/NX DY=(PTY(IP2)-PTY(IP1))/NX C UZEL NA KRIVCE IX V POZICI I ND=ND+1 XX(ND)=PTX(IP1)+DX*(I-1) YY(ND)=PTY(IP1)+DY*(I-1) LPU(ND+1)=LPU(ND)+NKIND(1) LOC=LPU(ND) MPU(ND)=NKIND(1) KINDU(ND)=1 DO J=1,MPU(ND) JPU(LOC+J)=JKIND(1,J) IPU(LOC+J)=0 ENDDO C ELEMENT PIPE NA KRIVCE IC IF(I.GT.1)THEN NE=NE+1 LOC=LUE(NE) LUE(NE+1)=LOC+2 MUE(NE)=2 IUE(LOC+1)=ND-2 IUE(LOC+2)=ND IGROUP(NE)=KGROUP IRCONS(NE)=IR(IC) IMAT(NE)=IM(IC)
KINDE(NE)=KANAL NAMELE(NE)=1 ENDIF ENDDO C GENEROVANI ELEMENTU 4-UZLOVEHO IF(I.GT.1)THEN NE=NE+1 LOC=LUE(NE) LUE(NE+1)=LOC+4 MUE(NE)=4 IUE(LOC+1)=ND-3 IUE(LOC+2)=ND-1 IUE(LOC+3)=ND-2 IUE(LOC+4)=ND IGROUP(NE)=KGROUP IRCONS(NE)=IRHEXC KINDE(NE)=KANAL NAMELE(NE)=4 C ODKAZY NA DVOJICI ELEMENTU PIPE DO ZONY IEPAR IEPAR(NE,MAXEPA-1)=NE-2 IEPAR(NE,MAXEPA)=NE-1 ENDIF ENDDO END SUBROUTINE RANGE(IZONE) C C Ukolem teto procedury je aktualizovat DOFMIN a DOFMAX dle aktualnich hodnot C zonach 1,2,3,4 pole VAL C INCLUDE '$FEM' DOFMIN=1E10 DOFMAX=-1E10 C Cyklus pres vsechny uzlove body DO I=1,ND LOC=LPU(I) DO J=1,MPU(I) V=VAL(LOC+J,IZONE) K=JPU(LOC+J) DOFMIN(K)=AMIN1(DOFMIN(K),V) DOFMAX(K)=AMAX1(DOFMAX(K),V) ENDDO ENDDO END SUBROUTINE MOFE(IDOF,IPE) C C Vypocet stredni hodnotu uzloveho parametru IDOF ve vsech elementech C a presun do sloupce IPE matice parametru elementu EPAR C include '$FEM' DO IE=1,NE IS=0 S=0. LOC=LUE(IE) DO IU=1,MUE(IE) IND=IABS(IUE(LOC+IU)) LOCP=LPU(IND) DO J=1,MPU(IND) IF(JPU(LOCP+J).EQ.IDOF)THEN IS=IS+1 S=S+VAL(LOCP+J,2) ENDIF ENDDO ENDDO IF(IS.GT.0)S=S/IS EPAR(IE,IPE)=S ENDDO END LOGICAL FUNCTION P2ONC(IP1,IP2,IC) C Lezi body IP1,IP2 na krivce IC? INCLUDE '$FEM' IPC1=ICR(1,IC) IPC2=ICR(2,IC) IF((IPC1.EQ.IP1.AND.IPC2.EQ.IP2).OR. / (IPC1.EQ.IP2.AND.IPC2.EQ.IP1))THEN P2ONC=.TRUE. ELSE P2ONC=.FALSE. ENDIF END SUBROUTINE INTC2(IC1,IC2,IPT,IPT1,IPT2) C Jsou dany dve krivky IC1,IC2 (se 2 nebo 3 body). C Ukolem je zjistit, zda maji spolecny bod IPT, a pokud ano (IPT>0) C urcit indexy koncovych bodu IPT1,IPT2 na krivkach IC1,IC2. INCLUDE '$FEM' IP1C1=ICR(1,IC1) IP2C1=ICR(2,IC1) IP1C2=ICR(1,IC2) IP2C2=ICR(2,IC2) IF(IP1C1.EQ.IP1C2)THEN IPT=IP1C1 IPT1=IP2C1 IPT2=IP2C2 ELSEIF(IP1C1.EQ.IP2C2)THEN IPT=IP1C1 IPT1=IP2C1 IPT2=IP1C2 ELSEIF(IP2C1.EQ.IP1C2)THEN IPT=IP2C1 IPT1=IP1C1 IPT2=IP2C2 ELSEIF(IP2C1.EQ.IP2C2)THEN
70
IPT=IP2C1 IPT1=IP1C1 IPT2=IP1C2 ELSE IPT=0 ENDIF END
C
INCLUDE '$FEM' DIMENSION NELET(10), / NDOFU(MAXTDOF),NFIXDOF(MAXTDOF),NLOADOF(MAXTDOF) EQUIVALENCE /(LTERM,NDOFU(1)),(LFTERM,NFIXDOF(1)),(LLTERM,NLOADOF(1)), /(LPRES,NDOFU(12)),(LFPRES,NFIXDOF(12)),(LLPRES,NLOADOF(12)), /(LVX,NDOFU(9)),(LFVX,NFIXDOF(9)),(LLVX,NLOADOF(9)), SUBROUTINE P2ONCS(IP1,IP2,IC) /(LVY,NDOFU(10)),(LFVY,NFIXDOF(10)),(LLVY,NLOADOF(10)), C Nalezeni krivky IC na niz lezi dvojice bodu IP1,IP2 /(LPS,NDOFU(14)),(LFPS,NFIXDOF(14)),(LLPS,NLOADOF(14)), INCLUDE '$FEM' /(LOMG,NDOFU(13)),(LFOMG,NFIXDOF(13)),(LLOMG,NLOADOF(13)), LOGICAL P2ONC /(LPSX,NDOFU(15)),(LFPSX,NFIXDOF(15)),(LLPSX,NLOADOF(15)), IC=0 /(LPSY,NDOFU(16)),(LFPSY,NFIXDOF(16)),(LLPSY,NLOADOF(16)), DO I=1,NCR /(LVOLT,NDOFU(8)),(LFVOLT,NFIXDOF(8)),(LLVOLT,NLOADOF(8)), IF(P2ONC(IP1,IP2,I))THEN /(LCONC,NDOFU(20)),(LFCONC,NFIXDOF(20)),(LLCONC,NLOADOF(20)) IC=I WRITE(9,'(/'' Check operations '',i2,'' - '',i2)')I1,I2 RETURN C MATERIALOVE PARAMETRY ENDIF VISC=RMAT(1,7) ENDDO RKAP=RMAT(1,4) END EX=RMAT(1,5) RKX=RMAT(1,1) SUBROUTINE SF2CR(IND,IC1,IC2,IEND) DN=RMAT(1,9) C C REALNE KONSTANTY C Vytvoreni plochy IND (4 nebo 8 bodu) na zaklade dvou krivek H=RCONST(1,1) IC1,IC2, D=RCONST(1,2) C ktere mohou byt dvojici prilehlych nebo protilehlych stran P=RCONST(1,3) C ALFA=RCONST(1,4) C IEND <>0 plochu nelze vytvorit C POCTY ELEMENTU SE 2,3,4,6,8 UZLY C NELET=0 INCLUDE '$FEM' DO I=1,NE IEND=0 M=IABS(MUE(I)) CALL INTC2(IC1,IC2,IPT,IPT1,IPT2) IF(M.GT.1)THEN IF(IPT.GT.0)THEN NELET(M)=NELET(M)+1 C IPT je prusecik IC1,IC2 (prilehle strany) ELSE C Hledani ctvrteho vrcholu IPP. WRITE(9,'('' ELEMENT'',I6,'' has'',I2,'' nodes'')')I,M DO IPP=1,NPT ENDIF IF(IPP.NE.IPT)THEN ENDDO CALL P2ONCS(IPT1,IPP,IC3) C POCTY UZLOVYCH PARAMETRU, FIXOVANYCH PARAMETRU A ZATIZENI CALL P2ONCS(IPT2,IPP,IC4) NDOFU=0 IF(IC3.GT.0.AND.IC4.GT.0)THEN NFIXDOF=0 ISF(1,IND)=IPT NLOADOF=0 ISF(2,IND)=IPT1 DO I=1,ND ISF(3,IND)=IPP DO J=1,MPU(I) ISF(4,IND)=IPT2 LOC=LPU(I)+J MSF(IND)=4 IND=JPU(LOC) IF(MCR(IC1).EQ.3.AND.MCR(IC2).EQ.3.AND. IF(IND.GT.0.AND.IND.LE.MAXTDOF)THEN / MCR(IC3).EQ.3.AND.MCR(IC4).EQ.3)THEN NDOFU(IND)=NDOFU(IND)+1 MSF(IND)=8 IF(IPU(LOC).LT.0)NFIXDOF(IND)=NFIXDOF(IND)+1 ISF(5,IND)=ICR(3,IC1) IF(IPU(LOC).GT.0)NLOADOF(IND)=NLOADOF(IND)+1 ISF(6,IND)=ICR(3,IC3) ELSE ISF(7,IND)=ICR(3,IC4) WRITE(9,'('' NODE'',I6,'' has'',I3,'' wrong DOF'')')I,IND ISF(8,IND)=ICR(3,IC2) ENDIF ENDIF WRITE(9,'('' Surface'',i3,'' from intersecting CR'',4i3)')ind, ENDDO / ic1,ic2,ic3,ic4 ENDDO RETURN C ENDIF DO I=I1,I2 ENDIF IF(IALGOR(I).GT.0)THEN ENDDO SELECT CASE(I) ELSE CASE(11) C Krivky IC1 IC2 nemaji spolecny bod - jsou to protilehle strany C ELEC - test elektricke vodivosti IPT1=ICR(1,IC1) NERELE=NELET(3)+NELET(6)+NELET(4)+NELET(8) IPT2=ICR(1,IC2) WRITE(9,'('' ELEC ELEMENTS='',I6)')NERELE CALL P2ONCS(IPT1,IPT2,IC3) WRITE(9,'('' DOF VOLT='',I4,'' IF(IC3.GT.0)THEN fixed='',i3)')LVOLT,LFVOLT IPT3=ICR(2,IC1) IF(RKAP.LE.0..OR.LFVOLT.LE.0.OR.NERELE.LE.0)THEN IPT4=ICR(2,IC2) WRITE(9,'('' Suppressed ELEC'')') ELSE IALGOR(11)=0 IPT2=ICR(2,IC2) ENDIF CALL P2ONCS(IPT1,IPT2,IC3) CASE(12) IF(IC3.GT.0)THEN C THER IPT3=ICR(2,IC1) NERELE=NELET(2)+NELET(3)+NELET(6)+NELET(4)+NELET(8) IPT4=ICR(1,IC2) WRITE(9,'('' THER ELEMENTS='',I6)')NERELE ELSE WRITE(9,'('' DOF TERM='',I4,'' WRITE(9,'('' UNABLE TO CREATE SURFACE'',i5)')IND fixed='',i3)')LTERM,LFTERM IEND=-1 IF(RKX.LE.0..OR.LFTERM.LE.0.OR.NERELE.LE.0)THEN RETURN WRITE(9,'('' Suppressed TERM'')') ENDIF IALGOR(12)=0 ENDIF ENDIF CALL P2ONCS(IPT3,IPT4,IC4) CASE(13) IF(IC4.GT.0)THEN C CONC ISF(1,IND)=IPT1 NERELE=NELET(3)+NELET(6)+NELET(4)+NELET(8) ISF(2,IND)=IPT3 WRITE(9,'('' CONC ELEMENTS='',I6)')NERELE ISF(3,IND)=IPT4 WRITE(9,'('' DOF CONC='',I4,'' ISF(4,IND)=IPT2 fixed='',i3)')LCONC,LFCONC MSF(IND)=4 IF(RKAP.LE.0..OR.LFCONC.LE.0.OR.NERELE.LE.0)THEN IF(MCR(IC1).EQ.3.AND.MCR(IC2).EQ.3.AND. WRITE(9,'('' Suppressed CONC'')') / MCR(IC3).EQ.3.AND.MCR(IC4).EQ.3)THEN IALGOR(13)=0 MSF(IND)=8 ENDIF ISF(5,IND)=ICR(3,IC1) CASE(14) ISF(6,IND)=ICR(3,IC4) C UVP ISF(7,IND)=ICR(3,IC2) NERELE=NELET(4)+NELET(6) ISF(8,IND)=ICR(3,IC3) WRITE(9,'('' UVP ELEMENTS='',I6)')NERELE ENDIF WRITE(9,'('' DOF VX='',I4,'' fixed='',i3)')LVX,LFVX ELSE WRITE(9,'('' DOF VY='',I4,'' fixed='',i3)')LVY,LFVY WRITE(9,'('' UNABLE TO CREATE SURFACE'',i5)')IND WRITE(9,'('' DOF PRES='',I4,'' IEND=-2 fixed='',i3)')LPRES,LFPRES RETURN IF(VISC.LE.0..OR.LFVX+LFVY.LE.0.OR.LFPRES.LE.0 ENDIF / .OR.NERELE.LE.0)THEN WRITE(9,'('' Surface'',i3,'' from PARALEL CR'',4i3)')ind, WRITE(9,'('' Suppressed UVP'')') / ic1,ic2,ic3,ic4 IALGOR(14)=0 ENDIF ENDIF END CASE(15) C UVPP SUBROUTINE CHECK(I1,I2) NERELE=NELET(4)+NELET(6) C WRITE(9,'('' UVPP ELEMENTS='',I6)')NERELE C Testovani parametru poptrebnych pro operace I1 az I2 WRITE(9,'('' DOF VX='',I4,'' fixed='',i3)')LVX,LFVX
71
WRITE(9,'('' DOF VY='',I4,'' fixed='',i3)')LVY,LFVY WRITE(9,'('' DOF PRES='',I4,'' fixed='',i3)')LPRES,LFPRES IF(VISC.LE.0..OR.LFVX+LFVY.LE.0.OR.LFPRES.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed UVPP'')') IALGOR(15)=0 ENDIF CASE(16) C MIKE NERELE=NELET(4)+NELET(6) WRITE(9,'('' MIKE ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF VX='',I4,'' fixed='',i3)')LVX,LFVX WRITE(9,'('' DOF VY='',I4,'' fixed='',i3)')LVY,LFVY WRITE(9,'('' DOF PRES='',I4,'' fixed='',i3)')LPRES,LFPRES IF(VISC.LE.0..OR.LFVX+LFVY.LE.0.OR.LFPRES.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed MIKE'')') IALGOR(16)=0 ENDIF CASE(17) C PENS NERELE=NELET(3)+NELET(6)+NELET(4)+NELET(8) WRITE(9,'('' PENS ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF VX='',I4,'' fixed='',i3)')LVX,LFVX WRITE(9,'('' DOF VY='',I4,'' fixed='',i3)')LVY,LFVY IF(VISC.LE.0..OR.LFVX+LFVY.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed PENS'')') IALGOR(17)=0 ENDIF CASE(18) C PSIN NERELE=NELET(3) WRITE(9,'('' PSIN ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF PS='',I4,'' fixed='',i3)')LPS,LFPS WRITE(9,'('' DOF PSX='',I4,'' fixed='',i3)')LPSX,LFPSX WRITE(9,'('' DOF PSY='',I4,'' fixed='',i3)')LPSY,LFPSY IF(VISC.LE.0..OR.LFPSX+LFPSY.LE.0.OR.LFPS.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed PSIN'')') IALGOR(18)=0 ENDIF CASE(19) C PSOM NERELE=NELET(3) WRITE(9,'('' PSOM ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF PS='',I4,'' fixed='',i3)')LPS,LFPS WRITE(9,'('' DOF OMG='',I4,'' fixed='',i3)')LOMG,LFOMG IF(VISC.LE.0..OR.LFPS.LE.0.OR.LFOMG.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed PSOM'')') IALGOR(19)=0 ENDIF CASE(20) C PSBL NERELE=NELET(3) WRITE(9,'('' PSBL ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF PS='',I4,'' fixed='',i3)')LPS,LFPS WRITE(9,'('' DOF PSX='',I4,'' fixed='',i3)')LPSX,LFPSX WRITE(9,'('' DOF PSY='',I4,'' fixed='',i3)')LPSY,LFPSY IF(VISC.LE.0..OR.LFPSX+LFPSY.LE.0.OR.LFPS.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed PSBL'')') IALGOR(20)=0 ENDIF CASE(21) C PIPE NERELE=NELET(2) WRITE(9,'('' PIPE ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF PRES='',I4,'' fixed='',i3)')LPRES,LFPRES IF(VISC.LE.0..OR.D.LE.0..OR.LFPRES.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed PIPE'')') IALGOR(21)=0 ENDIF CASE(22) C HEXC NERELE=NELET(2)+NELET(4) WRITE(9,'('' HEXC elem.pipe='',I3,'' hexc='',i2)') / NELET(2),NELET(4) WRITE(9,'('' DOF TERM='',I4,'' fixed='',i3)')LTERM,LFTERM
SUBROUTINE CRCOMP C C Vyrazeni duplicitnich krivek ze seznamu C INCLUDE '$FEM' I=1 DO WHILE(I.LT.NCR) J=I+1 DO WHILE(J.LE.NCR) C POROVNEJ KRIVKY I a J IF((MCR(I).EQ.MCR(J).AND.ICR(3,I).EQ.ICR(3,J)).AND. / (ICR(1,I).EQ.ICR(1,J).AND.ICR(2,I).EQ.ICR(2,J).OR. / ICR(2,I).EQ.ICR(1,J).AND.ICR(1,I).EQ.ICR(2,J)))THEN C Krivky I a J jsou totozne: Vyrad krivku J a zmensi NCR C MCR-pocet bodu krivky, NXCR,FLAFI-informace o meshovani C Pokud byla krivka J jiz meshovana, prekopiruji se meshovaci informace do I IF(NXCR(J).GT.0)THEN NXCR(I)=NXCR(J) FLAFI(I)=FLAFI(J) ENDIF C Vyrad krivku J a zmensi NCR DO K=J,NCR-1 MCR(K)=MCR(K+1) NXCR(K)=NXCR(K+1) FLAFI(K)=FLAFI(K+1) ICR(3,K)=0 DO L=1,MCR(K) ICR(L,K)=ICR(L,K+1) ENDDO ENDDO NCR=NCR-1 ELSE J=J+1 ENDIF ENDDO I=I+1 ENDDO END SUBROUTINE SORTNUM(N,IATTR,NSORT) C Setrideni seznamu cisel IATTR(1,1),IATTR(1,2)... vzestupne. Nove indexy jsou NSORT(1),... C Slouzi k setrideni pole IATTR(2,*) DIMENSION IATTR(2,*),NSORT(*) LOGICAL SORTED DO I=1,N NSORT(I)=I ENDDO SORTED=.FALSE. DO WHILE(.NOT.SORTED) SORTED=.TRUE. DO I=1,N-1 IF(IATTR(1,NSORT(I)).GT.IATTR(1,NSORT(I+1)))THEN SORTED=.FALSE. J=NSORT(I) NSORT(I)=NSORT(I+1) NSORT(I+1)=J ENDIF ENDDO ENDDO END
IF(RKX.LE.0..OR.LFTERM.LE.0.OR.NERELE.LE.0.OR.NELET(2).LE.0) / THEN WRITE(9,'('' Suppressed HEXC'')') IALGOR(22)=0 ENDIF CASE(23) C RTD NERELE=NELET(2) WRITE(9,'('' RTD ELEMENTS='',I6)')NERELE WRITE(9,'('' DOF CONC='',I4,'' fixed='',i3)')LCONC,LFCONC IF(DN.LE.0..OR.D.LE.0..OR.LFCONC.LE.0 / .OR.NERELE.LE.0)THEN WRITE(9,'('' Suppressed CONC'')') IALGOR(23)=0 ENDIF END SELECT ENDIF ENDDO END
72
$S11-mod C C C C C C C C C C C C C C C C C
SUBROUTINE READMOD(IM) IM - index modelu, cteneho ze souboru MODFILE(im) --------------------------------priklad Serie idealnich misicu. \\ini $neq=n \\mod $dc(1)=$xv(1) for i=2,$neq do $dc(i)=$p(1)*($c(i-1)-$c(i)) $yv(1)=$c($neq) \\par idenum=1234 method=1 inp=1 out=1 npar=1 x1=3 y1=4 prvni parametr: $p(2) default=123 min=-12 max=500 relax=0.3 ---------------------------------konec prikladu
PARAMETER (MAXCRPN=200) INCLUDE '$FEMLOC' CHARACTER *8 NAME CHARACTER *(MAXATR*8) NAMES COMMON /TRANDAT/NVARSYS,NVARTOT,IATTR(2,MAXATR),IATTW(2,MAXATR), / NAME(MAXATR) COMMON /$RPN/NRPN,ICRPN(MAXCRPN) CHARACTER *(LENLIN)LINE,ITEM, CH3*3 DIMENSION LSBEG(4),LSEND(4) EQUIVALENCE (NAME,NAMES) IF(IM.LE.0.OR.IM.GT.NMODELS)RETURN IMODELA=IM OPEN(3,FILE=MODFILE(IM)) LOC=0 NUMLINES=1 LINESRPN(1)=0 LSBEG(1)=0 C Sekce popis (ukoncena //INI), inicializace (ukoncena //MOD), C vypocet (ukoncena //PAR), pak nasleduji parametry DO IS=1,3 1 READ(3,'(A)',END=1000)LINE LLIN=LEN(TRIM(LINE)) CALL TUPC(LLIN,LINE,LINE) LEND=LOC+LLIN+1 IF(LEND.GT.LENMODEL)THEN WRITE(10,'('' Text of model is too long...'')') GOTO 1000 ENDIF NUMLINES=NUMLINES+1 LINESRPN(NUMLINES)=LEND MODTXT(LOC+1:LEND)=TRIM(LINE)//' ' IF(LINE(1:2).NE.'\\')THEN LOC=LEND GOTO 1 ENDIF LSEND(IS)=LOC LSBEG(IS+1)=LEND LOC=LEND ENDDO C Preklad inicializacni sekce, prekopirovani atributu do pomocne zony DO I=1,NVARSYS IATTW(1,I)=IATTR(1,I) IATTW(2,I)=IATTR(2,I) ENDDO CALL TRANSQ(MODTXT,LSEND(2),LSBEG(2),NAMES,IATTW,8,NVARSYS, / LOCMODCON-1,MAXATR,LOCMVAL-1,MAXMRPN, / LASTVAR,LASTCON,MIRPN, IAUX,MODRPN,IEND) IF(IEND.LT.0)THEN WRITE(10,'('' Syntax error in INI section'')') ELSE WRITE(10,'('' INI section translated. Code length='',i4)') / MIRPN ENDIF C Preklad vykone sekce CALL TRANSQ(MODTXT,LSEND(3),LSBEG(3),NAMES,IATTW,8,LASTVAR, / LASTCON,MAXATR,LOCMVAL-1,MAXMRPN-MIRPN, / NVARTOT,KLST,MMRPN, IAUX,MODRPN(MIRPN+1),IEND) C names const lenRPN Vars RPN IF(IEND.LT.0)THEN WRITE(10,'('' Syntax error in MOD section'')') ELSE WRITE(10,'('' MOD section translated. Code length='',i4)') / MMRPN ENDIF C Cteni a dekodovani parametru C Prvni radek dat: IDENUM=x METHOD=x NEQ=x NPAR=x INP=x OUT=x IDENUM=0 METHOD=0 NEQUAT=0 NUMODP=0 NINPUTS=0 NOUTPUTS=0 READ(3,'(A)',END=1000)LINE LLIN=LEN(TRIM(LINE)) CALL TUPC(LLIN,LINE,LINE) CALL TAKISD(LINE,LLIN,INDEX(LINE,'IDENUM=')+6,IDENUM,K) CALL TAKISD(LINE,LLIN,INDEX(LINE,'METHOD=')+6,METHOD,K) CALL TAKISD(LINE,LLIN,INDEX(LINE,'NEQ=')+3,NEQUAT,K) CALL TAKISD(LINE,LLIN,INDEX(LINE,'NPAR=')+4,NUMODP,K)
CALL TAKISD(LINE,LLIN,INDEX(LINE,'INP=')+3,NINPUTS,K) CALL TAKISD(LINE,LLIN,INDEX(LINE,'OUT=')+3,NOUTPUTS,K) C Druhy radek dat parametru: X1=x X2=x ... Y1=x Y2=x... C pouze kdyz NINPUTS+NOUTPUTS>0 IF(NINPUTS+NOUTPUTS.GT.0)THEN READ(3,'(A)',END=1000)LINE LLIN=LEN(TRIM(LINE)) CALL TUPC(LLIN,LINE,LINE) DO I=1,NINPUTS WRITE(CH3,'(''X'',I1,''='')')I CALL TAKISD(LINE,LLIN,INDEX(LINE,CH3)+2,MINPUTS(I),K) IG=MINPUTS(I) IF(IG.GT.0.AND.IG.LE.MAXSEL)THEN IF(IQGR(IG).LE.0)IQGR(IG)=3 IF(DTGR(IG).EQ.0.)DTGR(IG)=DTIME IF(NGR(IG).LE.0)NGR(IG)=NTSTEP ENDIF ENDDO DO I=1,NOUTPUTS WRITE(CH3,'(''Y'',I1,''='')')I CALL TAKISD(LINE,LLIN,INDEX(LINE,CH3)+2,MOUTPUTS(I),K) IG=MOUTPUTS(I) IF(IG.GT.0.AND.IG.LE.MAXSEL)THEN IF(IQGR(IG).LE.0)IQGR(IG)=4 IF(DTGR(IG).EQ.0.)DTGR(IG)=DTIME IF(NGR(IG).LE.0)NGR(IG)=NTSTEP ENDIF ENDDO ENDIF C popis parametru modelu DO I=1,NUMODP READ(3,'(A)',END=1000)LINE LTEXT=INDEX(LINE,':') IF(LTEXT.GT.1)MODPARTXT(I)=LINE(1:LTEXT-1) ITEM=LINE(LTEXT+1:LENLIN) LITM=LEN(TRIM(ITEM)) CALL TUPC(LITM,ITEM,ITEM) LINE=' ' CALL SELITE(ITEM,0,LINE,K) LLIN=LEN(TRIM(LINE)) VARTXT(I)=TRIM(LINE) CALL TRAN(LINE,LLIN,0,ICRPN,MAXCRPN,NRPN,IEND) CALL LOVARI(ICRPN,NRPN,LMODEL(I),JMODEL(I)) CALL TAKERD(ITEM,LITM,INDEX(ITEM,'MIN=')+3,ZMINP(I),K) CALL TAKERD(ITEM,LITM,INDEX(ITEM,'MAX=')+3,ZMAXP(I),K) CALL TAKERD(ITEM,LITM,INDEX(ITEM,'RELFAKT=')+7,RMODEL(I),K) CALL TAKISD(ITEM,LITM,INDEX(ITEM,'REGRES=')+6,KMODEL(I),K) IDEFAULT=INDEX(ITEM,'DEFAULT=') IF(IDEFAULT.GT.0.AND.JMODEL(I).EQ.1.AND.LMODEL(I).GT.0)THEN CALL TAKERD(ITEM,LITM,IDEFAULT+7,REALRC(LMODEL(I)),K) ELSEIF(IDEFAULT.GT.0.AND.JMODEL(I).EQ.2.AND.LMODEL(I).GT.0)THEN CALL TAKISD(ITEM,LITM,IDEFAULT+7,INTERC(LMODEL(I)),K) ENDIF ENDDO 1000 CLOSE(3) END SUBROUTINE MODLIST C C Vypis aktivniho modelu a zobrazeni schematu C INCLUDE '$FEMLOC' WRITE(9,'(/'' Active model'',I2,'' number='',i7)')IMODELA,IDENUM DO I=1,NUMLINES-1 WRITE(9,'(1X,A)')MODTXT(LINESRPN(I)+1:LINESRPN(I+1)) ENDDO WRITE(9,'('' NPAR='',I2,'' NEQ='',I3,'' METHOD='',I2,'' INP='',I2, /'' OUT='',I2)')NUMODP,NEQUAT,METHOD,NINPUTS,NOUTPUTS WRITE(9,'('' INPUTS :'',5I10)')(MINPUTS(I),I=1,NINPUTS) WRITE(9,'('' OUTPUTS:'',5I10)')(MOUTPUTS(I),I=1,NOUTPUTS) WRITE(9,'('' Params Name [Min,Value,Max] Regr, Relfakt'')') DO I=1,NUMODP CALL GETPAR(I,VALDEF,IVALDEF,IR) IF(IR.EQ.1)THEN WRITE(9,'(I3,1X,A,''['',3E9.2,'']'',I3,F5.2)') / I,TRIM(VARTXT(I)),ZMINP(I),VALDEF,ZMAXP(I),KMODEL(I),RMODEL(I) ELSEIF(IR.EQ.2)THEN WRITE(9,'(I3,1X,A,''['',E9.2,I9,E9.2,'']'',I3)') / I,TRIM(VARTXT(I)),ZMINP(I),IVALDEF,ZMAXP(I),KMODEL(I) ENDIF ENDDO C IDENUM ttaan2n1 C Rozkodovani IDECODE=IDENUM LN1=MOD(IDECODE,100) IDECODE=IDECODE/100 LN2=MOD(IDECODE,100) IDECODE=IDECODE/100 LAV=MOD(IDECODE,100) ITYP=IDECODE/100 IF(ITYP.GE.1.AND.ITYP.LE.10)THEN CALL GETPAR(LN1,RN1,N1,IR) CALL GETPAR(LN2,RN2,N2,IR) CALL GETPAR(LAV,VREL,IVREL,IR) CALL PLOTMOD(ITYP,N1,N2,VREL) ENDIF END SUBROUTINE GETPAR(I,RVALUE,IVALUE,IR) INCLUDE '$FEMLOC' IR=0 IF(I.GE.1.AND.I.LE.NUMODP)THEN IR=JMODEL(I)
73
IF(IR.EQ.1)THEN IF(LMODEL(I).GT.0)THEN RVALUE=REALRC(LMODEL(I)) ELSE RVALUE=PMODEL(I) ENDIF IVALUE=RVALUE ELSEIF(IR.EQ.2)THEN IF(LMODEL(I).GT.0)THEN IVALUE=INTERC(LMODEL(I)) ELSE IVALUE=IFIX(PMODEL(I)+.5) ENDIF RVALUE=IVALUE ENDIF ENDIF END SUBROUTINE RPNINI C C Provedeni interpretace programu \\INI sekce C INCLUDE '$FEM' EXTERNAL TFUW TIME=0 C hodnoty vstupnich a vystupnich funkci v case 0 DO I=1,NINPUTS CALL CVAL(MINPUTS(I),0.,XINPUTS(I),1) ENDDO DO I=1,NOUTPUTS CALL CVAL(MOUTPUTS(I),0.,YOUTPUTS(I),1) ENDDO C vynulovani derivaci i c(i) DO I=1,NEQUAT CMODEL(I,1)=0. CMODEL(I,2)=0. ENDDO CALL TINQ(MODRPN,MIRPN,IAUX,TFUW,RESULT,9) END SUBROUTINE RPNMOD(T,IX) C C Interpretace sekce \\MOD v case T C IX=.FALSE. nulovani vzruchovych funkci C INCLUDE '$FEM' EXTERNAL TFUW LOGICAL IX TIME=T C hodnoty vstupnich a vystupnich funkci v case 0 DO I=1,NINPUTS IF(IX)THEN CALL CVAL(MINPUTS(I),T,XINPUTS(I),1) ELSE XINPUTS(I)=0. ENDIF ENDDO DO I=1,NOUTPUTS CALL CVAL(MOUTPUTS(I),T,YOUTPUTS(I),1) ENDDO CALL TINQ(MODRPN(MIRPN+1),MMRPN,IAUX,TFUW,RESULT,9) END SUBROUTINE RUNGE(T,DT,IX) C C 3 kroky metody Runge-Kutta; zvetseni aktualniho casu T = T + dT C INCLUDE '$FEM' DIMENSION FF(4),HH(4),DS(MAXCMOD),CS(MAXCMOD) LOGICAL IX DATA FF,HH/.1666666,2*.3333333,.1666666,2*.5,2*1./ IF(METHOD.NE.0)THEN C RUNGE KUTTA TS=T DTK=HH(1)*DT T=TS+DTK DO J=1,NEQUAT IF(ABS(CMODEL(J,2)).GT.1E10) CMODEL(J,2)=0. DS(J)=CMODEL(J,2)*FF(1) CS(J)=CMODEL(J,1) CMODEL(J,1)=CS(J)+DTK*CMODEL(J,2) ENDDO DO K=2,4 CALL RPNMOD(T,IX) DTK=HH(K)*DT T=TS+DTK DO J=1,NEQUAT DS(J)=DS(J)+CMODEL(J,2)*FF(K) CMODEL(J,1)=CS(J)+DTK*CMODEL(J,2) ENDDO ENDDO DO J=1,NEQUAT CMODEL(J,1)=CS(J)+DS(J)*DT IF(ABS(CMODEL(J,1)).GT.1E10)THEN WRITE(10,'('' Error in Runge, time='',e9.2)')T CMODEL(J,1)=0 ENDIF ENDDO ELSE C EULER T=T+DT DO J=1,NEQUAT CMODEL(J,1)=CMODEL(J,1)+DT*CMODEL(J,2) IF(ABS(CMODEL(J,1)).GT.1E10)THEN WRITE(10,'('' Error in Euler, time='',e9.2)')T CMODEL(J,1)=0 ENDIF
ENDDO ENDIF END SUBROUTINE RUMODL(IX) C C Vypocet vektoru odezvy CY(NY) pro dany vzruch CX(NX) a model aparatu, C zadany jako soustava algebraickych / diferencialnich rovnic.: C ------------------------------------------------------------------C IX =true - nuluji se vsechny pocatecni podminky a respektuje se funkce X C false- uvazuji se pocatecni podminky a X=0 (impulsni odezva -time) C X=1 (impulsni odezva -Lapl) C INCLUDE '$FEMLOC' LOGICAL DTHIGH,IX EXTERNAL TFUW DIMENSION CS(MAXCMOD),DS(MAXCMOD),CSF(MAXCMOD),YSCALE(MAXCMOD) C C Inicializace (pocatecni podminky C(i)) C IF(METHOD.LT.0) EPS=10.**METHOD CALL RPNINI C Korekce parametru dle zadanych mezi (mozna modifikovanych v sekci INI) DO J=1,NUMODP IF(LMODEL(J).LE.0)THEN WRITE(10,'('' Error in parameter '',i2,'' definition'')')J RETURN ENDIF IF(JMODEL(J).EQ.1)THEN PARAM=REALRC(LMODEL(J)) ELSE PARAM=INTERC(LMODEL(J)) ENDIF IF(PARAM.LT.ZMINP(J).OR.PARAM.GT.ZMAXP(J))THEN PARAM=AMIN1(ZMAXP(J),AMAX1(ZMINP(J),PARAM)) IF(JMODEL(J).EQ.1)THEN REALRC(LMODEL(J))=PARAM ELSE INTERC(LMODEL(J))=PARAM+.5 ENDIF ENDIF ENDDO C Pri konvoluci IX=true vynulujeme vsechny pocatecni podminky IF(IX)THEN DO J=1,NEQUAT CMODEL(J,1)=0. ENDDO ENDIF C C <------CYKLUS CASOVYCH KROKU IND=1,...,NTSTEP C DTIME-tabelacni krok C DT -integracni krok C DT=DTIME/MAX(1,IABS(METHOD)) DTMIN=DTIME*.002 T=0 DO IND=1,NTSTEP TIND=T CALL RPNMOD(T,IX) C Ulozeni NOUTPUTS vypoctenych hodnot CALL SAVEOUT(IND,T) C IF(METHOD.GE.0)THEN C konstantni integracni krok DT CALL RUNGE(T,DT,IX) DO I=2,METHOD CALL RPNMOD(T,IX) CALL RUNGE(T,DT,IX) ENDDO ELSE C promenny integracni krok DT TLAST=T+DTIME 100 DTC=DT DT=AMIN1(DT,TLAST-T) DO J=1,NEQUAT YSCALE(J)=ABS(CMODEL(J,1))+ABS(DT*CMODEL(J,2))+1E-7 CS(J)=CMODEL(J,1) DS(J)=CMODEL(J,2) ENDDO TS=T DTHIGH=.TRUE. C plny krok DT 20 CALL RUNGE(T,DT,IX) DO J=1,NEQUAT CSF(J)=CMODEL(J,1) CMODEL(J,1)=CS(J) CMODEL(J,2)=DS(J) ENDDO C polovicny dvoukrok DTH DTH=DT*.5 T=TS CALL RUNGE(T,DTH,IX) CALL RPNMOD(T,IX) CALL RUNGE(T,DTH,IX) C porovnani C(DTH) a CSF(DT) ERRMAX=0. DO J=1,NEQUAT CSF(J)=CMODEL(J,1)-CSF(J) ERRMAX=AMAX1(ERRMAX,ABS(CSF(J))/YSCALE(J))
74
ENDDO ERRMAX=ERRMAX/EPS IF(ERRMAX.GT.1..AND.DT.GT.DTMIN)THEN C zkraceni DT a navrat na zacatek DT=.9*DT*ERRMAX**(-.25) DO J=1,NEQUAT CMODEL(J,1)=CS(J) CMODEL(J,2)=DS(J) ENDDO T=TS DTHIGH=.FALSE. GOTO20 ELSE IF(DTC.GT.DT.AND.DTHIGH)THEN DT=DTC ELSEIF(ERRMAX.GT.6E-4)THEN DT=0.9*DT*ERRMAX**(-.2) ELSE DT=4.*DT ENDIF C vylepseni vysledku DO J=1,NEQUAT CMODEL(J,1)=CMODEL(J,1)+CSF(J)/15. ENDDO IF(T.LT.TLAST-DTMIN)THEN CALL RPNMOD(T,IX) GOTO 100 ENDIF ENDIF ENDIF T=TIND+DTIME ENDDO C ulozeni vektoru parametru modelu do interface END SUBROUTINE SAVEOUT(IND,T) C Ulozeni docasnych hodnot Y INCLUDE '$FEM' DO I=1,NOUTPUTS LOC=MOUTPUTS(I) TGR(IND,LOC)=T YGR(IND,LOC)=YOUTPUTS(I) NGR(LOC)=IND ENDDO END SUBROUTINE TCDEV C Vypocet odchylek TC Krivek dle zvoleneho kriteria INCLUDE '$FEM' SCOMPAR=0 END SUBROUTINE SMOOTH(N,T,Y,C,ISMOOTH) C Vyhlazeni neekvidistantni krivky spliny (ze 4 sousednich bodu). C ISMOOTH =0 linearni spliny C >0 kvadraticke spliny C Vektory Y a C mohou byt totozne (vyhlazeni na miste). DIMENSION T(*),Y(*),C(*),YS(40) C(1)=Y(1) C(2)=Y(2) NSAV=MIN0(40,MAX0(1,ISMOOTH)+1) YS(NSAV)=Y(2) YS(NSAV-1)=Y(1) DO I=2,N-2 DT=T(I+1)-T(I) C Linearni spliny IF(ISMOOTH.EQ.0)THEN SC=0 SJ=0 J1=MAX0(1,I-NSAV+1) J2=MIN0(N,I+NSAV) DO J=J1,J2 IF(J.LE.I)THEN YJ=YS(NSAV+J-I) ELSE YJ=Y(J) ENDIF SC=SC+(YJ-C(I)*(T(I+1)-T(J))/DT)*(T(J)-T(I))/DT SJ=SJ+((T(J)-T(I))/DT)**2 ENDDO DO K=1,NSAV-1 YS(K)=YS(K+1) ENDDO YS(NSAV)=Y(I+1) C(I+1)=SC/SJ ELSEIF(ISMOOTH.GE.1)THEN C Kvadraticke spliny A2=0 A3=0 A4=0 B1=0 B2=0 J1=MAX0(1,I-NSAV+1) J2=MIN0(N,I+NSAV) DO J=J1,J2 IF(J.LE.I)THEN YJ=YS(NSAV+J-I) ELSE YJ=Y(J) ENDIF DT=T(J)-T(I) A2=A2+DT*DT A3=A3+DT**3 A4=A4+DT**4 B1=B1+DT*(YJ-C(I)) B2=B2+DT*DT*(YJ-C(I)) ENDDO
DET=A2*A4-A3*A3 DT=T(I+1)-T(I) DO K=1,NSAV-1 YS(K)=YS(K+1) ENDDO YS(NSAV)=Y(I+1) C(I+1)=C(I)+((B1*A4-B2*A3)*DT+(A2*B2-A3*B1)*DT*DT)/DET ENDIF ENDDO C(N)=Y(N) END SUBROUTINE RNMOM(T,C,NC,V) C C Plocha, 1. a 2. moment pro neekvidistantni data (t,c) V1,V2,V3 C a dale teziste V4 a variance V5 C DIMENSION T(*),C(*),V(*) DOUBLE PRECISION T1,T2,C1,C2 RM0=0. RM1=0. RM2=0. DO I=1,NC-1 T1=T(I) T2=T(I+1) C1=C(I) C2=C(I+1) IF(T1.GE.T2)EXIT RM0=RM0+(C1+C2)*(T2-T1)/2. RM1=RM1+(C1*(T2**2+T1*T2-2.*T1**2)-C2*(T1**2+T1*T22.*T2**2))/6. RM2=RM2+C1*(T2**3-T1**3)/3.+(C2-C1)/(T2-T1)*((T2**4T1**4)/4./ T1*(T2**3-T1**3)/3.) ENDDO V(1)=RM0 V(2)=RM1 V(3)=RM2 IF(RM0.LE.0.)THEN WRITE(10,'('' Zero area '')') ELSE V(4)=RM1/RM0 V(5)=RM2/RM0-V(4)**2 ENDIF END SUBROUTINE RNORM(ICT,T,C,NC,V) C C ICT=0 normalizace na plochu C =1 na plochu i prvni moment C DIMENSION T(*),C(*),V(*) C Vypocet momentu CALL RNMOM(T,C,NC,V) IF(V(1).NE.0..AND.V(4).NE.0.)THEN IF(ICT.EQ.0)THEN DO1I=1,NC 1 C(I)=C(I)/V(1) ELSE DO2I=1,NC C(I)=C(I)*V(4)/V(1) 2 T(I)=T(I)/V(4) ENDIF ENDIF END SUBROUTINE RCMIDM(T,C,NC,DT,PMIX,TMEAN) C C Odezva serie PMIX-idealnich misicu se zadanou stredni dobou TMEAN C DIMENSION T(NC),C(NC) IF(TMEAN.GT.0.)THEN IF(PMIX.EQ.1.)THEN C(1)=1./TMEAN ELSE C(1)=0. ENDIF T(1)=0 CON=EXP(PMIX*LOG(PMIX)-LOG(TMEAN)-GAMMLN(PMIX)) DO I=2,NC T(I)=T(I-1)+DT TM=T(I)/TMEAN C(I)=CON*TM**(PMIX-1.)*EXP(-PMIX*TM) ENDDO ELSE WRITE(10,'('' Zero mean time'')') ENDIF END SUBROUTINE RCMPAS(T,C,NC,DT,PM1,PM2,F,ALFA,TMEAN) C C C C C C
Paralelni serie IDM Bishoff, Mc Cranken Ind.Eng.Chem. 18, 58 (1966) PM1-M, MP2-N pocet IDM ve vetvi 1 a 2, F=Q1/Q, ALFA=T2/T1 DIMENSION T(*),C(*) IF(ALFA.GT.0..AND.TMEAN.GT.0..AND.PM1.GT.0..AND.PM2.GT.0.)THEN C(1)=0. T(1)=0 BETA=F+ALFA*(1-F) BA=BETA/ALFA C1=F/TMEAN*EXP(PM1*LOG(PM1*BETA)-GAMMLN(PM1)) C2=(1-F)/TMEAN*EXP(PM2*LOG(PM2*BA)-GAMMLN(PM2)) DO I=2,NC T(I)=T(I-1)+DT TM=T(I)/TMEAN
75
C(I)=C1*TM**(PM1-1)*EXP(-PM1*BETA*TM)+C2*TM**(PM2-1)* EXP(-PM2*BA*TM) ENDDO ELSE WRITE(10,'('' Zero mean time or model parameters N1,N2'')') ENDIF END
/
FUNCTION GAMMLN(XX) C GAMMA FUNCTION NUMERICAL RECIPES P.157 REAL*8 COF(6),STP,HALF,ONE,FPF,X,TMP,SER DATA COF,STP/76.18009173D0,-86.50532033D0,24.01409822D0, / -1.231739516D0,.120858003D-2,-0.536382D5,2.50662827465D0/ DATA HALF,ONE,FPF/0.5D0,1.0D0,5.5D0/ X=XX-ONE TMP=X+FPF TMP=(X+HALF)*LOG(TMP)-TMP SER=ONE DO J=1,6 X=X+ONE SER=SER+COF(J)/X ENDDO GAMMLN=TMP+LOG(STP*SER) END SUBROUTINE TCOPY(I1,I2) INCLUDE '$FEM' DO I=1,NGR(I1) TGR(I,I2)=TGR(I,I1) YGR(I,I2)=YGR(I,I1) ENDDO NGR(I2)=NGR(I1) DTGR(I2)=DTGR(I1) IQGR(I2)=IQGR(I1) INDG(I2)=INDG(I1) FILEXPERI(I2)=FILEXPERI(I1) END SUBROUTINE RCRND(N,Y,C,STD,ICT) DIMENSION Y(*),C(*) DO I=1,N S=RNDG(IDUMMY)*STD IF(ICT.EQ.0)THEN C(I)=Y(I)+S ELSE C(I)=Y(I)*(1.+S) ENDIF ENDDO END SUBROUTINE TCBGR(N,T,YIN,YOUT) DIMENSION T(*),YIN(*),YOUT(*) C YIN merena data (treba posunout do nuly) IF(N.LE.1.OR.T(N).LE.T(1))RETURN Y0=YIN(1) Y1=YIN(N) DO I=1,N YOUT(I)=YIN(I)-Y0-(Y1-Y0)/(T(N)-T(1))*(T(I)-T(1)) ENDDO C ODHAD PLOCHY DO ITER=1,3 AREA=0 DO I=1,N-1 AREA=AREA+(YOUT(I+1)+YOUT(I))*.5*(T(I+1)-T(I)) ENDDO IF(AREA.EQ.0.)RETURN RK=(Y0-Y1)/AREA DO I=2,N SUM=0 DO J=1,I-1 C INTEGRAL OD T=0 TO T(I) SUM=SUM+((YIN(J)-Y0)*EXP(-RK*(T(I)-T(J))) / +(YIN(J+1)-Y0)*EXP(-RK*(T(I)-T(J+1)))) / *(T(J+1)-T(J)) ENDDO YOUT(I)=YIN(I)-Y0-SUM*RK ENDDO ENDDO END C C C C C C C
SUBROUTINE TAIL(N,TV,YV,CV,ICT,M1,M2,NBEG,CINF,A,B) YV(*) CV(*) ICT=0 ICT=1 ICT=2
zdrojova data (nemela by byt prepsana) data s chvostem a odriznutym pozadim exponencialni chvost Y=CINF+A*EXP(-B*T) Y=CINF+A*T*EXP(-B*T) mocninovy chvost Y=CINF+A/T**3
DIMENSION TV(*),CV(*),YV(*) C Nejprve logaritmicka aproximace CINF=1E10 DO I=1,N CINF=AMIN1(CINF,YV(I)) ENDDO CINF=CINF-0.0001 A12=0 A22=0 B1=0 B2=0 DO I=M1,M2 T=TV(I) IF(T.GT.0.)THEN Z=YV(I)-CINF SELECT CASE(ICT) CASE(0) A12=A12+T
A22=A22+T*T ZZ=LOG(Z) B1=B1+ZZ B2=B2+ZZ*T CASE(1) A12=A12+T A22=A22+T*T ZZ=LOG(Z/T) B1=B1+ZZ B2=B2+ZZ*T CASE(2) RT=1./T**3 A12=A12+RT A22=A22+RT*RT B1=B1+YV(I) B2=B2+YV(I)*RT ENDSELECT ENDIF ENDDO M=(M2-M1)+1 DET=M*A22-A12*A12 IF(ABS(DET).GT.1E-20)THEN A=(B1*A22-B2*A12)/DET B=-(B2*M-B1*A12)/DET ELSE RETURN ENDIF C ZPRESNENI NELINEARNI REGRESI PRO IF(ICT.EQ.0)THEN C = CINF + A * EXP(-B*T) C NEJPRVE METODA PULENI INTERVALU BL=B/10. BR=B*30. CALL FTAIL(TV,YV,M1,M2,BL,FL,CL,AL) CALL FTAIL(TV,YV,M1,M2,BR,FR,CR,AR) IHALF=0 DO WHILE(FL*FR.LE.0..AND.IHALF.LE.50) IHALF=IHALF+1 B=(BL+BR)*.5 CALL FTAIL(TV,YV,M1,M2,B,F,CINF,A) IF(F*FL.LE.0.)THEN BR=B FR=F ELSE BL=B FL=F ENDIF ENDDO WRITE(9,'('' Y(t)='',e9.2,''+'',e9.2,''*EXP('',e9.2,''*t)'')') / CINF,A,B ELSEIF(ICT.EQ.1)THEN WRITE(9,'('' Y='',e9.2,''+'',e9.2,''*t*EXP('',e9.2,''*t)'')') / CINF,A,B ELSEIF(ICT.EQ.2)THEN CINF=A WRITE(9,'('' Y(t)='',e9.2,''+'',e9.2,''/t^3'')') / CINF,-B ENDIF DO I=1,N IF(I.LE.NBEG)THEN CV(I)=YV(I)-CINF ELSE SELECT CASE(ICT) CASE(0) CV(I)=A*EXP(-B*TV(I)) CASE(1) CV(I)=TV(I)*EXP(A-B*TV(I)) CASE(2) CV(I)=-B/TV(I)**3 ENDSELECT ENDIF ENDDO END SUBROUTINE FTAIL(T,Y,N1,N2,B,FT,CINF,A) C hodnota FT by mela byt nulova - je to rovnice pro neznamou hodnotu B C DFT je derivace FT dle parametru B DIMENSION T(*),Y(*) REAL*8 SYTE,SE,SE2,STE,SYE,SY,STE2,E SYTE=0 SE=0 SE2=0 STE=0 SYE=0 SY=0 STE2=0 DO I=N1,N2 E=DEXP(-DBLE(B*T(I))) SYTE=SYTE+Y(I)*T(I)*E SE=SE+E SE2=SE2+E*E STE=STE+T(I)*E SYE=SYE+Y(I)*E SY=SY+Y(I) STE2=STE2+T(I)*E*E ENDDO NP=N2-N1+1 FT=SYTE*(SE**2-NP*SE2)-STE*(SYE*SE-SY*SE2)-STE2*(SE*SY-NP*SYE) DET=SE**2-NP*SE2 IF(ABS(DET).GT.1E-20)THEN CINF=(SYE*SE-SY*SE2)/DET A=(SE*SY-NP*SYE)/DET ENDIF END
76
$S-graf CASES GRAF VYSLEDKY-----------------------------CASE('GRAPH ','GD2 ','G2 ','D2 ') CGRAF DOF 2D vrstevnice CALL DIAP(IP1,'GRAPH',IEND) C DOF,Zone IF(IEND.EQ.0)THEN C Kresleni vrstevnic veliciny IP1 (viz TDOF) na zaklade hodnot VAL(*,IP2) VMI=1E10 VMA=-1E10 IP1=MAX0(1,MIN0(20,IP(1))) IP2=MAX0(1,MIN0(3,IP(2))) DO J=1,ND LOC=LPU(J) DO I=1,MPU(J) IF(JPU(LOC+I).EQ.IP1)VGR(J)=VAL(LOC+I,IP2) ENDDO VMI=AMIN1(VMI,VGR(J)) VMA=AMAX1(VMA,VGR(J)) ENDDO CALL GMFSTW(2,0,21,5,12,'X','Y',0.,1.,0.,1., / XMI,XMA,YMI,YMA) CALL GMFECTR(.TRUE.,2,' DOF: '//TDOF(IP1),10, / XX,YY,VGR,IUE,LUE,MUE,NE, / XMI,XMA,YMI,YMA,VMI,VMA,1,500,0) CALL GMFSW(1) ENDIF CASE('GD1 ','G1 ','D1 ') CGRAF DOF 1D tonovani (potrubni site apod) CALL DIAP(IP1,'GPIPE',IEND) C GD1 DOF,ZONE,THICKNESS IF(IEND.EQ.0.AND.IP(1).GT.0)THEN CALL GMFSTW(2,1,21,5,12,'X','Y',0.,1.,0.,1., / XMI,XMA,YMI,YMA) CALL GMFAXE(2,7,15) IP1=IP(1) CALL RANGE(IP(2)) DOFMI=DOFMIN(IP1) DOFMA=DOFMAX(IP1) DO IE=1,NE CALL GPIPE(IE,IP(3),0,IP1,DOFMI,DOFMA,0,500) ENDDO C Legenda skaly barev DGX=(XMA-XMI)*.25 DGY=(YMA-YMI)*.015 X8(1:3)=(/XMA-DGX,XMI+DGX,XMI+DGX/) Y8(1:3)=(/YMA,YMA-DGY,YMA/) V8(1:3)=(/DOFMA,DOFMI,DOFMI/) CALL GMFCTR(V8,X8,Y8,DOFMI,DOFMA,0,500) X8(3)=XMA-DGX Y8(3)=YMA-DGY V8(3)=DOFMA CALL GMFCTR(V8,X8,Y8,DOFMI,DOFMA,0,500) WRITE(LABEL,'(E9.2)')DOFMA CALL GMFTEXT(XMA-DGX,YMA,1,9,LABEL) WRITE(LABEL,'(E9.2)')DOFMI CALL GMFTEXT(XMI,YMA,1,14,TDOF(IP1)//' '//LABEL) CALL GMFSW(1) ENDIF CASE('GRAPS ','GE1 ','E1 ') CGRAF EPAR 1D (napr. SHELLAX) - JEPA je index hlavicky parametru EPAR WRITE(CH,'(I1)')JEPA CALL DIAP(1,'GE'//CH,IEND) IF(IEND.EQ.0.AND.IP(1).GT.0.AND.IP(1).LE.5)THEN IFORCE=IP(1) FMAX=1E-15 IMAX=1 DO IE=1,NE AFORCE=ABS(EPAR(IE,IFORCE)) IF(AFORCE.GT.FMAX)THEN FMAX=AFORCE IMAX=IE ENDIF ENDDO CALL GMFSTW(2,1,21,5,12,'X','R',0.,1.,0.,1., / XMI,XMA,YMI,YMA) CALL GMFAXE(2,7,15) CALL GMFTEXT(XMI+(XMA-XMI)*.03,YMA-(YMA-YMI)*.01,1,8, / LEPA(IFORCE,JEPA)) DO IE=1,NE IRG=MAX0(1,IRCONS(IE)) T=RCONST(IRG,1) L0=LUE(IE) DO I=1,2 IND=IABS(IUE(L0+I)) X8(I)=XX(IND) Y8(I)=YY(IND) ENDDO FORC=EPAR(IE,IFORCE)/FMAX*.15 C Kresleni usecky (2 body X8,Y8) se zadanymi hodnotami (FORC1,FORC2) C v koncovych bodech. Hodnoty FORC musi byt normalizovane v rozsahu (-1,1). C Usecka se kresli jako obdelnik o tloustce T*0.007 barvou 1. Barvou 4 C se vykresluje obrys lichobezniku (prubeh FORC), ktery se vyplni barvou 12. C Parametry RC,XC jsou vystupni: teziste lichobeznika (napr. pro popis). CALL GMFECR(X8,Y8,FORC,FORC,T*.007,1,4,12,RC,XC)
IF(IE.EQ.IMAX)THEN CALL GMFMRK(RC,XC,40+IFORCE) WRITE(LABEL,'(E9.2)')EPAR(IE,IFORCE) CALL GMFTEXT(RC,XC,1,9,LABEL) ENDIF ENDDO CALL GMFSW(1) ENDIF CASE('GE2 ','E2 ') CGRAF EPAR 2D vrstevnice WRITE(CH,'(I1)')JEPA CALL DIAP(1,'GE'//CH,IEND) C IEPAR IF(IEND.EQ.0)THEN C Kresleni vrstevnic IP1-teho sloupce EPAR(*,IP1) VMI=1E10 VMA=-1E10 IP1=MAX0(1,MIN0(5,IP(1))) DO J=1,NE VMI=AMIN1(VMI,EPAR(J,IP1)) VMA=AMAX1(VMA,EPAR(J,IP1)) ENDDO CALL GMFSTW(2,0,21,5,12,'X','Y',0.,1.,0.,1., / XMI,XMA,YMI,YMA) DV=(VMA-VMI)/(MAXCNTR-1) DO J=1,MAXCNTR VCOLOR(J)=VMI+(J-1)*DV ENDDO CALL GMFECTE(2,' EPAR:'//LEPA(IP1,JEPA),14, / XX,YY,EPAR(1,IP1),IUE,LUE,MUE,NE, / XMI,XMA,YMI,YMA,VCOLOR,IVCOLOR,MAXCNTR,0) CALL GMFSW(1) WRITE(9,'(1X,A8,'' range:'',2e9.2)')LEPA(IP1,JEPA),VMI,VMA ENDIF CASE('GCR ','GC ','GDCR ','GDC ') C XY-graf prubehu vybraneho DOF na specifikovane krivce C GCR Cr,Dof,Zone C kreslene hodnoty jsou presouvany do pracovnich vektoru XGR a VGR CALL DIAP(1,'GCR',IEND) IC=IP(1) IDF=IP(2) IZON=IP(3) IF(IEND.EQ.0.AND.IC.GT.0.AND.IC.LE.NCR.AND. / IDF.GT.0.AND.IZON.GT.0.AND.IZON.LE.4)THEN DO I=1,MCR(IC) X8(I)=PTX(ICR(I,IC)) Y8(I)=PTY(ICR(I,IC)) Z8(I)=PTZ(ICR(I,IC)) ENDDO N=0 YMINI=1E10 YMAXI=-1E10 DO I=1,ND CALL FTN3CR(X8,Y8,Z8,MCR(IC),XX(I),YY(I),ZZ(I),TOL,T) IF(T.GT.-.5)THEN C Uzel I lezi na krivce. Vyber uzloveho parametru IDF ze zony IZON LOC0=LPU(I) DO J=1,MPU(I) IF(JPU(LOC0+J).EQ.IDF)THEN N=MIN0(MAXNTS,N+1) VGR(N)=VAL(LOC0+J,IZON) XGR(N)=T YMINI=AMIN1(YMINI,VGR(N)) YMAXI=AMAX1(YMAXI,VGR(N)) EXIT ENDIF ENDDO ENDIF ENDDO CALL GMFSTW(2,1,21,5,12,'T',TDOF(IDF),0.,1.,0.,1., / 0.,1.,YMINI,YMAXI) CALL GMFAXE(2,3,15) CALL FSORT(N,XGR,VGR) CALL GMFPL(N,XGR,VGR,12) CALL GMFSW(1) ENDIF CASE('GRATIM','GT ','GTIM ','GTIME ') CALL DIAP(IP1,'GRATIM',IEND) IF(IEND.EQ.0.AND.IP(1).GT.0.AND.IP(1).LE.MAXTDOF)THEN NDG=0 IP1=IP(1) C Vyber uzlu, pro ktere se budou kreslit casove prubehy CALL NIDENT(JMI,KBD) DO WHILE(KBD.EQ.1.AND. / NDG.LT.MAXSEL.AND.JMI.GT.0.AND.JMI.LE.MAXND) NDG=NDG+1 INDG(NDG)=JMI CALL NIDENT(JMI,KBD) ENDDO IF(NDG.GT.0)THEN CALL GMFSTW(2,0,21,5,12,'X','Y',0.,1.,0.,1., / XMI,XMA,YMI,YMA) REWIND(3) C Soubor *.OUT (UNIT=3) vypada zhruba takto C PIPELINES test ND= 21 C .0 1.000 (time, dtime) INITIAL C TEMP VOLT VX PRES CN C 1 100.000 .000 .000 20000.000 .000 C 2 1.000 .000 .000 19500.000 .000 C ...... C 21 30.000 .000 .000 10000.000 .000 C 1.0 1.000 (time, dtime) C TEMP VOLT VX PRES CN C 1 100.000 .000 .000 20000.000 .000
77
C 2 43.457 .000 .000 19500.000 .000 C C Preskoc radek hlavicky (PIPELINES test ...) READ(3,*,END=51) NTS=0 YMINI=1E10 YMAXI=-1E10 FIRST=.TRUE. DO WHILE(NTS.LE.MAXNTS) C Cteni radku CAS napr. 0.1 1.000 (time,dtime).... READ(3,*,END=40,ERR=40)TTT C Preskoc radek nazvu, napr. TEMP VOLT .... READ(3,*,END=40,ERR=40) VMI=1E10 VMA=-1E10 DO I=1,ND LOC=LPU(I) READ(3,*,END=40,ERR=40)IDUM,(VAL(LOC+J,3),J=1,MPU(I)) DO J=1,MPU(I) IF(JPU(LOC+J).EQ.IP1)VGR(I)=VAL(LOC+J,3) ENDDO VMI=AMIN1(VMI,VGR(I)) VMA=AMAX1(VMA,VGR(I)) ENDDO IF(NTS.LT.5.OR.MOD(NTS,10).EQ.0)THEN WRITE(LABEL,'(F9.0)')TTT CALL GMFECTR(FIRST,2,' TIME:'//LABEL,15, / XX,YY,VGR,IUE,LUE,MUE, / NE,XMI,XMA,YMI,YMA,VMI,VMA,1,500,0) ENDIF FIRST=.FALSE. NTS=NTS+1 XGR(NTS)=TTT DO I=1,NDG J=INDG(I) LOC=LPU(J) DO K=1,MPU(J) IF(JPU(LOC+K).EQ.IP1)YGR(NTS,I)=VAL(LOC+K,3) ENDDO YMINI=AMIN1(YMINI,YGR(NTS,I)) YMAXI=AMAX1(YMAXI,YGR(NTS,I)) ENDDO ENDDO C Soubor 3 by mel zustat stale otevreny pro pokracovani vypoctu proto C navrat pred EOF 40 BACKSPACE 3 CALL GMFSTW(2,1,21,5,12,'time','Y',0.,1.,0.,1., / 0.,TTT,YMINI,YMAXI) CALL GMFAXE(2,7,15) DO I=1,NDG CALL GMFPL(NTS,XGR,YGR(1,I),I) WRITE(LABEL(1:6),'(I6.2)')INDG(I) CALL GMFTEXT(TTT*.1*I,YMAXI,I,6,LABEL) ENDDO ENDIF CALL GMFSW(1) ENDIF CASE('GRAFUN','GF ') CALL DIAP(1,'GRAFUN',IEND) IF(IEND.EQ.0.AND.IFUN.GE.-10.AND.IFUN.LE.50)THEN IFUN=IP(1) X1=RP(2) X2=RP(3) YMINI=1E10 YMAXI=-1E10 N=100 DX=(X2-X1)/N X0=X1 DO I=1,N DO J=1,6 AUX(J)=X0 ENDDO VGR(I)=CURFUN(IFUN) YMINI=AMIN1(YMINI,VGR(I)) YMAXI=AMAX1(YMAXI,VGR(I)) X0=X0+DX ENDDO CALL GMFSTW(2,1,21,5,12,'X','Y',0.,1.,0.,1., / X1,X2,YMINI,YMAXI) CALL GMFAXE(2,3,15) CALL GMFPLD(X1,DX,N,VGR,12) CALL GMFSW(1) ENDIF CGRAF TC CASE('GTC ','GXY ') CALL DIAP(1,'GTC',IEND) IF(IEND.EQ.0)THEN NGRAF=IP(1) YMITC=1E10 YMATC=-1E10 XMATC=0 DO IG=1,NGRAF IGR=IP(IG+1) IF(IGR.GT.0.AND.IGR.LE.MAXSEL.AND.NGR(IGR).GT.0)THEN DO I=1,NGR(IGR) YMITC=AMIN1(YMITC,YGR(I,IGR)) YMATC=AMAX1(YMATC,YGR(I,IGR)) ENDDO IF(DTGR(IGR).GT.0.)THEN XMATC=AMAX1(XMATC,DTGR(IGR)*NGR(IGR)) ELSE XMATC=AMAX1(XMATC,TGR(NGR(IGR),IGR)) ENDIF ENDIF ENDDO
/
IF(XMATC.GT.0..AND.YMITC.LT.YMATC)THEN XMITC=0. CALL GMFSTW(1,1,20,1,16,'time','Y',0.,1.,0.,1., XMITC,XMATC,YMITC,YMATC) CALL GMFAXE(1,3,15) CALL CLEARPLOT DO IG=1,NGRAF IGR=IP(IG+1)
IF(IGR.GT.0.AND.IGR.LE.MAXSEL.AND.NGR(IGR).GT.0)THEN CALL GMFPL(NGR(IGR),TGR(1,IGR),YGR(1,IGR),IGR) ENDIF ENDDO ENDIF CALL GMFSW(1) TC$=1 ISTATUS=3 ENDIF CASES PLOTS--------------------------------------
C
C C C C
C C C
CASE('TCPLOT','TCP ') CALL DIAP(1,'TCP',IEND) IG=IP(1) IF(IEND.EQ.0.AND.IG.GT.0.AND.IG.LE.MAXSEL)THEN II=SETACTIVEQQ(20) CALL GMFPL(NGR(IG),TGR(1,IG),YGR(1,IG),IG) TC$=1 ENDIF CASE('PTPLOT','PTP ') CALL DIAP(NPT,'FLI',IEND) IF(IEND.EQ.0)THEN II=SETACTIVEQQ(20) DO J=IP(1),IP(2),IP(3) CALL GMFMRKL(PTX(J),PTY(J),27,J,KPT) ENDDO PT$=1 ENDIF CASE('NDPLOT','NDP ') CALL DIAP(ND,'FLI',IEND) IF(IEND.EQ.0)THEN II=SETACTIVEQQ(20) DO J=IP(1),IP(2),IP(3) CALL GMFMRKL(XX(J),YY(J),30,J,KND) ENDDO ND$=1 ENDIF CASE('SFPLOT','SFP ') CALL DIAP(NSF,'FLI',IEND) IF(IEND.EQ.0)THEN II=SETACTIVEQQ(20) DO K=IP(1),IP(2),IP(3) CALL PLOTSF(K,1,KSF) ENDDO ENDIF CASE('CRPLOT','CRP ') CALL DIAP(NCR,'FLI',IEND) IF(IEND.EQ.0)THEN II=SETACTIVEQQ(20) DO K=IP(1),IP(2),IP(3) CALL PLOTCR(K,2,KCR) ENDDO ENDIF CASE('EPLOT ','EP ') CALL DIAP(NE,'FLI',IEND) IF(IEND.EQ.0)THEN II=SETACTIVEQQ(20) CALL RANGE(2) DO IE=IP(1),IP(2),IP(3) CALL PLOTEL(IE,0) ENDDO ENDIF CASE('DEFPLO') Deformovany tvar II=SETACTIVEQQ(20) CALL DEFPLOT(2,3,12) CASE('NFPLOT','NFP ') IP1,IP2,IP3 - rozsah uzlovych bodu IP4 - typ parametru (viz. TFOF: 1-T,2-Ux,...) U kazdeho uzlu je treba vyhledat, zda parametr IP4 existuje a zda jeho status odpovida okrajove podmince, tj. IPU<0. CALL DIAP(ND,'NFPLOT',IEND) IF(IEND.EQ.0.AND.IP(4).GT.0)THEN II=SETACTIVEQQ(20) DO J=IP(1),IP(2),IP(3) LOC=LPU(J) DO I=1,MPU(J) IF(JPU(LOC+I).EQ.IP(4).AND.IPU(LOC+I).LT.0) / CALL GMFMRK(XX(J),YY(J),IMARK(IP(4))+20) ENDDO ENDDO ENDIF CASE('PFPLOT','PFP ','DIAL ','METER ') IP1 - ZONA 1-BC,2-RESULTS,3-IC IP2 - typ parametru (viz. TFOF: 1-T,2-Ux,...) IP3 - velikost CALL DIAP(IZONE,'PFPLOT',IEND) IZONE=IP(1) ID=IP(2) IF(IEND.EQ.0.AND.ID.GT.0.AND. / IZONE.GT.0.AND.IZONE.LE.4)THEN CALL RANGE(IZONE) IF(DOFMAX(ID).GT.DOFMIN(ID))THEN II=SETACTIVEQQ(20) DO IND=1,NPT J=NEARND(IND) IF(J.GT.0.AND.J.LE.ND)THEN
78
LOC=LPU(J) DO I=1,MPU(J) IF(JPU(LOC+I).EQ.ID)THEN VALUE=(VAL(LOC+I,IZONE)-DOFMIN(ID))/ (DOFMAX(ID)-DOFMIN(ID)) CALL GFND(XX(J),YY(J),VALUE,IP(3)) ENDIF ENDDO ENDIF ENDDO ENDIF ENDIF
/e9.2,'' alpha='',f6.0,'' Te='',f6.0,'' Area='',e9.2,'' V='',E9.2)' /)JMI,MUE(JMI),IGRO,IRCO,IRMA,NAMELE(JMI), / (RCONST(IRCO,J),J=1,6),RCONST(IRCO,8) / CASE(3) CIDENT MPROP WRITE(11, / '('' E'',I6.4,'' NUE='',I2,'' EGROUP='',I1,'' RCONST='',I1, /'' MPROP='',I1,'' NAME='',i1/'' K='',e9.2,'' Cp='',e9.2, /'' Rho='',e9.2,'' Kappa='',E9.2,'' E='',e9.2,'' Visc='',e9.2)') / JMI,MUE(JMI),IGRO,IRCO,IRMA,NAMELE(JMI), / (RMAT(IRMA,J),J=1,5),RMAT(IRMA,7) CASES IDENTifikace lokatorem--------------------CIDENT EPAR CASE(4) CASE('PIDENT','PID ') WRITE(11, KBD=1 / '('' E'',I6.4,'' NUE='',I2,'' EGROUP='',I1,'' RCONST='',I1, WRITE(10,'('' Identify PT by mouse (R-click /'' MPROP='',I1,'' NAME='',i1,'' Last EPAR:'',2i5/5(1X,A,''='', terminates)'')') /e9.2))') DO WHILE(KBD.EQ.1) / JMI,MUE(JMI),IGRO,IRCO,IRMA,NAMELE(JMI), CALL PIDENT(JMI,KBD) / IEPAR(JMI,MAXEPA-1),IEPAR(JMI,MAXEPA), WRITE(11,'('' Point'',I4.3,'' X='',E10.3,'' Y='',E10.3, / (TRIM(LEPA(J,JEPA)),EPAR(JMI,J),J=1,5) /'' Z='',E10.3/'' nearest Node='',i6)') END SELECT / JMI,PTX(JMI),PTY(JMI),PTZ(JMI),NEARND(JMI) ENDIF ENDDO ENDDO CASE('CIDENT','CID ') ENDIF KBD=1 WRITE(10,'('' Identify CURVE by mouse (R-click CASES GSCREEN-----------------------------------terminates)'') /') CASE('CLS ') DO WHILE(KBD.EQ.1) CALL GMFAXE(1,7,15) CALL CIDENT(JMI,KBD) CALL CLEARPLOT WRITE(11,'('' Curve'',I3.2,'' N_mesh='',I3,'' CASE('SCALE ') Last/First='' CALL DIAP(0,'SCALE',IEND) /,E10.3/'' Points:'',3i6.2)') IF(IEND.EQ.0)CALL WRITEL('SCALE') / JMI,NXCR(JMI),FLAFI(JMI),(ICR(I,JMI),I=1,MCR(JMI)) CASE('ZOOMI ','ZI ') ENDDO II=SETACTIVEQQ(20) CASE('TIDENT','TID ') II=FOCUSQQ(20) KBD=1 CALL GMFSW(1) WRITE(10,'('' Identify TIME CURVE by mouse (R-click CALL GMFLCW(XMI,YMI,XMI1,XMA1,YMI1,YMA1,KBD) terminate IF(KBD.EQ.1)THEN /s)'')') CALL GMFSTW(1,1,20,1,16,'X','Y',0.,1.,0.,1., DO WHILE(KBD.EQ.1) / XMI1,XMA1,YMI1,YMA1) CALL TIDENT(IMI,JMI,KBD) CALL GMFAXE(1,7,15) CALL RNMOM(TGR(1,JMI),YGR(1,JMI),NGR(JMI),V8) CALL PLOTAL WRITE(11,'('' Curve'',I3,'': points='',I4,'' ENDIF Dt='',E10.3, CASE('ZOOMOU','ZOOMO ','ZO ') /'' t-mean='',e10.3,'' var.='',e10.3,'' 3M=''E10.3/ II=SETACTIVEQQ(20) /'' Point'',i4,'': time='',e10.3,'' value='',e10.3)') CALL GMFSTW(1,1,20,1,16,'X','Y',0.,1.,0.,1., / JMI,NGR(JMI),DTGR(JMI),V8(4),V8(5),V8(3), / XMI,XMA,YMI,YMA) / IMI,TGR(IMI,JMI),YGR(IMI,JMI) CALL GMFAXE(1,7,15) ENDDO CALL PLOTAL CASE('NIDENT','NID ') CASE('GRIDON','GRID ') CALL DIAP(IZONE,'NID',IEND) CALL DIAP(0,'GRIDON',IEND) IZONE=IP(1) C GRIDON X0,Y0,DX,DY ITYP=IP(2) IF(IEND.EQ.0)THEN IF(IEND.EQ.0.AND.IZONE.GT.0.AND.IZONE.LE.4)THEN II=SETACTIVEQQ(20) KBD=1 GRIDON=.TRUE. DO WHILE(KBD.EQ.1) GRIDX0=RP(1) CALL NIDENT(JMI,KBD) GRIDY0=RP(2) NDPAR=MPU(JMI) GRIDX=RP(3) LOC=LPU(JMI) GRIDY=RP(4) CIDENT VYHLEDANI PARAMETRU ITYP C Vykresleni mrizky JS=1 DO G=GRIDX0,XMA,GRIDX DO J=1,MPU(JMI) X8(1)=G IF(ITYP.EQ.JPU(LOC+J))JS=J X8(2)=G ENDDO Y8(1)=GRIDY0 MMPU=MIN0(5,MPU(JMI)) Y8(2)=YMA WRITE(11, CALL GMFDASH(2,X8,Y8,0,XMA,YMA,40) / '('' Node'',I5.4,'' XY:'',2F8.4,'' Zone '',I1,'': '',A4, ENDDO /'' status['',I3.2,''] DO G=GRIDY0,YMA,GRIDY value='',E10.3/5(X,A4,I3.2,E9.2,''|''))') Y8(1)=G / JMI,XX(JMI),YY(JMI), Y8(2)=G / IZONE,TDOF(ITYP),IPU(LOC+JS),VAL(LOC+JS,IZONE), X8(1)=GRIDX0 / (TDOF(JPU(LOC+J)),IPU(LOC+J),VAL(LOC+J,IZONE),J=1,MMPU) X8(2)=XMA ENDDO CALL GMFDASH(2,X8,Y8,0,XMA,YMA,50) ENDIF ENDDO ENDIF CASE('EIDENT','EID ') CASE('GRIDOF') CALL DIAP(ITYP,'EID',IEND) GRIDON=.FALSE. ITYP=IP(1) CIDENT ITYP=1 EGROUP, =2 RCONST, =3 MPROP, =4 EPAR IF(IEND.EQ.0.AND.ITYP.GT.0.AND.ITYP.LE.4)THEN KBD=1 DO WHILE(KBD.EQ.1) CALL EIDENT(JMI,KBD) IF(JMI.GT.0.AND.JMI.LE.NE)THEN IGRO=IGROUP(JMI) IRCO=IRCONS(JMI) IRMA=IMAT(JMI) SELECT CASE(ITYP) CASE(1) CIDENT EGROUP WRITE(11, / '('' E'',I6.4,'' NUE='',I2,'' EGROUP='',I1,'' RCONST='',I1, /'' MPROP='',I1,'' NAME='',i1/'' TRANSIENT='',I1,'' GAUSS='',I2, /'' CYLINDRICAL COORD.='',I1))') / JMI,MUE(JMI),IGRO,IRCO,IRMA,NAMELE(JMI), / (JGROUP(IGRO,J),J=1,3) CASE(2) CIDENT RCONST WRITE(11, / '('' E'',I6.4,'' NUE='',I2,'' EGROUP='',I1,'' RCONST='',I1, /'' MPROP='',I1,'' NAME='',i1/'' H='',e9.2,'' D='',e9.2,'' p='',
79
C COMPEX.for C
C
USE MSFLIB INCLUDE '$FEMLOC' EXTERNAL THER,PSIN,PSBL,PSOM,PENS,UVP,UVPP,CONC,ELEC, / PIPE,HEXC,RTD LOGICAL PRESSED OPEN(1,FILE='COMPEX.BIN',FORM='BINARY',ERR=1000) CALL READBIN(1)
C================================================ C COMMANDS SELECT CASE(KEYW) CASES CONTROL------------------------------------INCLUDE '$COMPEX' ENDSELECT 999 1000
WRITE(*,'(1X,''Exit from COMPEX, writting COMPEX.BIN'')') REWIND 1 CALL WRITEBIN(1,0) CONTINUE END INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE INCLUDE
'$BLOCKD' '$S4-KLOC' '$S5-KLOC' '$S6-KLOC' '$S7-KLOC' '$S8-KLOC' '$$-COMM'
CASE('PIPEQ ','PIPEC ','PIPE ','R_PIPE','R_P ', / 'HEXC ','RTD ') COPER FEM ITERACNI VYPOCET rovnic POTRUBNICH SITI v nasledujicim poradi C (aktivovane vektorem IALGOR=pocet iteraci) C PIPE, HEXC, RTD C 21 22 23 TIME=RP(1) NTSTEP=IP(2) DTIME=RP(3) C JEPA=1-shell, 2-pipe, 3-flow, 4-stress JEPA=2 C Pri prvnim pouziti otevreni souboru PROBLEM.OUT a prefront IF(KEYW.NE.'PIPEC ')THEN CLOSE(3) WRITE(*,'(/'' Open file ['',A,''.OUT] for PIPELINES'')') / TRIM(PROBLEM) OPEN(3,FILE=TRIM(PROBLEM)//'.OUT') WRITE(3,'('' PIPELINES '',A,'' ND='',I6)') / PROBLEM,ND WRITE(3,'(F10.1,F15.3,'' (time, dtime) INITIAL'')') / TIME,DTIME C Nazvy pouzitych velicin - hlavicka tabulky (nazvy voleny dle prvniho uzlu)
WRITE(*,'('' PIPE FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER C LOADIN kopiruje tlaky (JDOF(NDOF)) V1->V2 (s eventualni funkcni transformaci dle IPU) CALL LOADIN ICOUNTS=0 C PIPE pocita PRES na zaklade teplot a tlaku ze zony 3-BC CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PIPE) C Procedura COPY kopiruje tlaky do zony 3, a soucasne pocita jejich residua CALL COPY(2,3) WRITE(*,'(I3,'' PIPE FTFRON(0;'',i5,'') Resid.[PRES]='',e9.3)') / ITER,ICOUNTS,DOFRESI(12) C Ukonceni iteraci po dosazeni presnosti IF(DOFRESI(12).LT.EPSPRES)EXIT ENDDO C Vypocet PRUTOKU-Q z vypoctenych tlaku do zony EPAR(Q-1,Re-2,Tauw3) ICOUNTS=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PIPE) WRITE(*,'('' PIPE FTFRON(1;'',I5,'') calculated EPAR: Q,Re,Tauw'' /)')ICOUNTS ENDIF C HEXC 22 C DOF: TEMP IF(KEYW.EQ.'HEXC ')THEN NITER=MAX0(1,NITHEXC) ELSE NITER=NITHEXC ENDIF IF(NITER.GT.0)THEN NDOF=1 JDOF(1)=1 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / HEXC) WRITE(*,'('' HEXC FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER CALL LOADIN ICOUNTS=0 C HEXC pocita teploty na z CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,HEXC) C prekopirovani teploty do docasne zony 4 a vypocet residua CALL COPY(2,4) WRITE(*,'(I3,'' HEXC FTFRON(0;'',i5,'') Resid.[TEMP]='',E9.3)') / ITER,ICOUNTS,DOFRESI(1) IF(DOFRESI(1).LT.EPSTEMP)EXIT ENDDO C FOULING ICOUNTS=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,HEXC) WRITE(*,'('' HEXC FTFRON(1;'',i5,'') calculated EPAR: RFoul'')') / ICOUNTS CALL COPY(2,3) ENDIF C RTD 23 C DOF: CN IF(KEYW.EQ.'RTD '.OR.NITRTD.GT.0)THEN NDOF=1 JDOF(1)=20 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / RTD) WRITE(*,'('' RTD FTFRIN('',I6,'' elements)'')')ICOUNTS CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,RTD) WRITE(*,'('' RTD FTFRON(0;'',I6,'' elements)'')')ICOUNTS C prekopirovani KONCENTRACE do novych pocatecnich podminek CALL COPY(2,3) ENDIF C -------------------------------------C Zapis vysledku casoveho kroku POTRUBNICH SITI C WRITE(*,'('' END of TIME STEP='',I3,'' time='',E9.2)') / ITIME,TIME WRITE(3,'(F10.1,F15.3,'' (time, dtime)'')')TIME,DTIME
WRITE(3,'(6X,10(6X,A4))')(TDOF(JPU(LPU(1)+J)),J=1,MPU(1)) DO I=1,ND LOC=LPU(I) WRITE(3,'(I6,10F10.3)')I,(VAL(LOC+J,3),J=1,MPU(I)) ENDDO C Prenos pocatecnich podminek T,P,C do pracovni zony 4 NDOF=3 JDOF(1)=1 JDOF(2)=12 JDOF(3)=20 CALL COPY(3,4) C Vynulovani pracovni zony elemenetu EPAR (s vyjimkou poslednich dvou sloupcu, C ktere obsahuji indexy proudu vymeniku). Nuluje se (Q,Re,Tau),Rfoul,Tmean. DO IE=1,NE DO J=4,5 EPAR(IE,J)=0. ENDDO ENDDO ENDIF COPER FEM PIPE Cyklus casovych / iteracnich kroku POTRUBNICH SITI C ------------------------------------DO ITIME=1,NTSTEP TIME=TIME+DTIME WRITE(*,'(/'' BEGIN TIME STEP='',I2)')ITIME C PIPE 21 C DOF: PRES IF(KEYW.EQ.'PIPE ')THEN WRITE(3,'(6X,10(6X,A4))')(TDOF(JPU(LPU(1)+J)),J=1,MPU(1)) NITER=MAX0(1,NITPIPE) DO I=1,ND ELSE LOC=LPU(I) NITER=NITPIPE WRITE(3,'(I6,10F10.3)')I,(VAL(LOC+J,3),J=1,MPU(I)) ENDIF ENDDO IF(NITER.GT.0)THEN ENDDO NDOF=1 C -------------------------------------JDOF(1)=12 CASE('TRANEQ','TRANEC','R_TRAN','R_T ', C UKOLEM FTFRIN JE VYFILTROVAT JEN DVOUUZLOVE ELEMENTY / 'THERMA','CONTHE','ELEC ','CONC ','UVPP ', ICOUNTS=0 / 'UVP ','PSOM ','PSIN ','PENS ','THER ') CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / PIPE) COPER FEM ITERACNI VYPOCET TRANSPORTNICH rovnic v nasledujicim poradi
80
C C C
(aktivovane vektorem IALGOR=pocet iteraci) PENS, UVP, PSOM, PSIN, THER, ELEC, CONC, UVPP 17 14 19 18 12 11 13 15
TIME=RP(1) NTSTEP=IP(2) DTIME=RP(3) JEPA=3 C Pri prvnim pouziti otevreni souboru PROBLEM.OUT a prefront IF(KEYW.NE.'TRANEC'.AND.KEYW.NE.'CONTHE')THEN CLOSE(3) WRITE(*,'(/'' Open file ['',A,''.OUT] for TRANEQ'')') / TRIM(PROBLEM) OPEN(3,FILE=TRIM(PROBLEM)//'.OUT') WRITE(3,'('' TRANSPORT EQUATIONS '',A,'' ND='',I6)') / PROBLEM,ND WRITE(3,'(F10.1,F15.3,'' (time, dtime) INITIAL'')') / TIME,DTIME C Nazvy pouzitych velicin - hlavicka tabulky (nazvy voleny dle prvniho uzlu) WRITE(3,'(6X,10(6X,A4))')(TDOF(JPU(LPU(1)+J)),J=1,MPU(1)) DO I=1,ND LOC=LPU(I) WRITE(3,'(I6,10F10.3)')I,(VAL(LOC+J,3),J=1,MPU(I)) ENDDO C Prenos pocatecnich hodnot teplot a rychlosti VX,VY do pracovni zony 4 NDOF=3 JDOF(1)=1 JDOF(2)=9 JDOF(3)=10 CALL COPY(3,4) ENDIF C C Cyklus casovych / iteracnich kroku TRANSPORTNICH ROVNIC C ------------------------------------DO ITIME=1,NTSTEP TIME=TIME+DTIME WRITE(*,'(/'' BEGIN TIME STEP='',I2)')ITIME C C PENS 17 C Niter je pocet iteraci - pokud je operace volana C prikazem PENS, provede se vzdy alespon 1 iterace C IF(KEYW.EQ.'PENS ')THEN NITER=MAX0(1,NITPENS) ELSE NITER=NITPENS ENDIF IF(NITER.GT.0)THEN C Frontalni metodou budou pocitany 2 uzlove parametry VX,VY NDOF=2 JDOF(1)=9 JDOF(2)=10 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / PENS) WRITE(*,'('' PENS FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER C Loadin inicializuje zonu VAL(,2) CALL LOADIN ICOUNTS=0 C Parametry FTFRON: C (ICTR,IDOF,NDOF,IPU,JPU,LPU,MPU,X,IUE,LUE,MUE,NE,EPS,NFLIM,procedura ) CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,PENS) C Preneseni vysledku VX,VY ze zony VAL(,2) do VAL(,4) CALL COPY(2,4) WRITE(*,'(I3,'' PENS FTFRON(0;'',I6,'') Resid.[VXY]='',E9.3)') / ITER,ICOUNTS,DOFRESI(9)+DOFRESI(10) IF(DOFRESI(9)+DOFRESI(10).LT.EPSVXYZ)EXIT ENDDO C Po posledni iteraci se vysledky prenesou do zony poc.podminek CALL COPY(2,3) ICOUNTS=0 POWER=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,PENS) WRITE(*,'('' PENS FTFRON(1;'',I6,'') Dissipation and power='', /E9.3)')ICOUNTS,POWER ENDIF C UVP 14 C DOF: VX,VY,PRES IF(KEYW.EQ.'UVP ')THEN NITER=MAX0(1,NITUVP) ELSE NITER=NITUVP ENDIF IF(NITER.GT.0)THEN NDOF=3 JDOF(1)=9 JDOF(2)=10 JDOF(3)=12 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / UVP) WRITE(*,'('' UVP FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER
CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,UVP) CALL COPY(2,4) WRITE(*,'(I3,'' UVP FTFRON(0;'',I6,'') Resid.[VXY+PRES]='',E9.3)') / ITER,ICOUNTS,DOFRESI(9)+DOFRESI(10)+DOFRESI(12) IF(DOFRESI(9)+DOFRESI(10).LT.EPSVXYZ.AND. / DOFRESI(12).LT.EPSPRES)EXIT ENDDO CALL COPY(2,3) ICOUNTS=0 POWER=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,UVP) WRITE(*,'('' UVP FTFRON(1;'',I6,'') Dissipation and power='', /E9.3)')ICOUNTS,POWER ENDIF C UVPP 15 C DOF: VX,VY (eliminace tlaku metodou pokutove funkce) IF(KEYW.EQ.'UVPP ')THEN NITER=MAX0(1,NITUVPP) ELSE NITER=NITUVPP ENDIF IF(NITER.GT.0)THEN NDOF=3 JDOF(1)=9 JDOF(2)=10 JDOF(3)=12 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / UVPP) WRITE(*,'('' UVPP FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,UVPP) CALL COPY(2,4) WRITE(*,'(I3,'' UVPP FTFRON(0;'',I6,'') Res.[VXY+PRES]='',E9.3)') / ITER,ICOUNTS,DOFRESI(9)+DOFRESI(10)+DOFRESI(12) IF(DOFRESI(9)+DOFRESI(10).LT.EPSVXYZ.AND. / DOFRESI(12).LT.EPSPRES)EXIT ENDDO CALL COPY(2,3) ICOUNTS=0 POWER=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,25,0,UVP) WRITE(*,'('' UVPP FTFRON(1;'',I6,'') Dissipation and power='', /E9.3)')ICOUNTS,POWER ENDIF C PSOM 19 C DOF: OMG, PS (rychlosti a tlak pocitany az ex post) IF(KEYW.EQ.'PSOM ')THEN NITER=MAX0(1,NITPSOM) ELSE NITER=NITPSOM ENDIF IF(NITER.GT.0)THEN NDOF=2 JDOF(1)=13 JDOF(2)=14 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / PSOM) WRITE(*,'('' PSOM FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PSOM) WRITE(*,'(I3,'' PSOM FTFRON(0;'',I6,'')')ITER,ICOUNTS C Vypocet rychlosti z hodnot PSX,PSY do zony 4 ICOUNTS=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PSOM) WRITE(*,'(I3,'' PSOM FTFRON(1;'',I6,'')')ITER,ICOUNTS C Prenos PSI a OMEGA do zony 4 CALL COPY(2,4) WRITE(*,'(I3,'' PSOM COPY(2,4) Res.[PS+OMG]='',E9.3)') / ITER,DOFRESI(13)+DOFRESI(14) IF(DOFRESI(14).LT.EPSPS .AND. / DOFRESI(13).LT.EPSOMG)EXIT ENDDO CALL COPY(2,3) ENDIF C PSIN 18 C DOF: PS,PSX,PSY (rychlosti a tlaky az ex post) IF(KEYW.EQ.'PSIN ')THEN NITER=MAX0(1,NITPSIN) ELSE NITER=NITPSIN ENDIF IF(NITER.GT.0)THEN NDOF=3 JDOF(1)=14 JDOF(2)=15
81
JDOF(3)=16 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / PSIN) WRITE(*,'('' PSIN FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PSIN) WRITE(*,'(I3,'' PSIN FTFRON(0;'',I6,'')')ITER,ICOUNTS C Vypocet rychlosti z hodnot PSX,PSY a prenos do zony 4 ICOUNTS=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,PSIN) WRITE(*,'(I3,'' PSIN FTFRON(1;'',I6,'')')ITER,ICOUNTS ENDDO CALL COPY(2,3) ENDIF C ELEC 11 C DOF: VOLT (neni duvod iterovat) IF(KEYW.EQ.'ELEC '.OR.NITELEC.GT.0)THEN NDOF=1 JDOF(1)=8 CALL LOADIN ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / ELEC) WRITE(*,'('' ELEC FTFRIN('',I6,'' elements)'')')ICOUNTS ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,15,0,ELEC) WRITE(*,'('' ELEC FTFRON(0;'',I6,'' elements)'')')ICOUNTS CALL COPY(2,3) ENDIF C THERMA 12 C DOF: TEMP IF(KEYW.EQ.'THERMA'.OR.KEYW.EQ.'THER ')THEN NITER=MAX0(1,NITTHER) ELSE NITER=NITTHER ENDIF IF(NITER.GT.0)THEN NDOF=1 JDOF(1)=1 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / THER)
WRITE(*,'('' THER FTFRIN('',I6,'' elements)'')')ICOUNTS DO ITER=1,NITER CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,5,0,THER) CALL COPY(2,4) WRITE(*,'(I3,'' THER FTFRON(0;'',i5,'') Resid.[TEMP]='',E9.3)') / ITER,ICOUNTS,DOFRESI(1) IF(DOFRESI(1).LT.EPSTEMP)EXIT ENDDO CALL COPY(2,3) ICOUNTS=0 CALL FTFRON(1,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,5,0,THER) WRITE(*,'('' THER FTFRON(1;'',i5,'') dT/dx,dT/dy to EPAR'')') / ICOUNTS ENDIF C CONC 13 C DOF: CN (linearni rovnice, bez iteraci) IF(KEYW.EQ.'CONC '.OR.NITCONC.GT.0)THEN NDOF=1 JDOF(1)=20 ICOUNTS=0 CALL FTFRIN(JDOF,NDOF,JPU,LPU,MPU,IUE,LUE,MUE,NE,ND, / CONC) WRITE(*,'('' CONC FTFRIN('',I6,'' elements)'')')ICOUNTS CALL LOADIN ICOUNTS=0 CALL FTFRON(0,JDOF,NDOF,IPU,JPU,LPU,MPU,VAL(1,2), / IUE,LUE,MUE,NE,EPSPIV,5,0,CONC) WRITE(*,'('' CONC FTFRON(0;'',I6,'' elements)'')')ICOUNTS CALL COPY(2,3) ENDIF C -------------------------------------C Zapis vysledku casoveho kroku TRANSPORTNICH ROVNIC WRITE(*,'('' END of TIME STEP='',I4)')ITIME WRITE(3,'(F10.1,F15.3,'' (time, dtime)'')')TIME,DTIME WRITE(3,'(6X,10(6X,A4))')(TDOF(JPU(LPU(1)+J)),J=1,MPU(1)) DO I=1,ND LOC=LPU(I) WRITE(3,'(I6,10F10.3)')I,(VAL(LOC+J,3),J=1,MPU(I)) ENDDO PRESSED=PEEKCHARQQ() IF(PRESSED)GOTO 999 ENDDO
82
