1 : C FIMVF1 SOURCE CHAT 05/01/13 00:01:02 5004
2 : SUBROUTINE FIMVF1
3 : C************************************************************************
4 : C
5 : C PROJET : CASTEM 2000
6 : C
7 : C NOM : FIMVF1
8 : C
9 : C DESCRIPTION : Subroutine appellée par FIMPVF
10 : C
11 : C Modelisation 2D/3D des equations d'Euler
12 : C Gravité
13 : C
14 : C Calcul du flux/residu
15 : C
16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
17 : C
18 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
19 : C
20 : C************************************************************************
21 : C
22 : C*** SYNTAXE
23 : C
24 : C Discrétisation en VF "cell-centered" des équations d'Euler pour
25 : C un gaz parfait polytropique
26 : C Inconnues: densités, quantité de mouvement, énergie totale par
27 : C unité de volumes (variables conservatives)
28 : C Gravité
29 : C
30 : C RESU = 'FIMP' 'VF' 'GRAVMONO'
31 : C MOT1 LMOTC CHPRN CHPGN CHGRA ;
32 : C
33 : C MOT1 : MOT, 'RESI', 'JACOCONS'
34 : C
35 : C LMOTC : LISTMOTS, noms des variables conservatives
36 : C
37 : C CHPRN : densité (SPG = 'CENTRE', une seule
38 : C composante, 'SCAL')
39 : C
40 : C CHPGN : qdm (SPG = meme que CHPRN,
41 : C composantes: 'UX', 'UY', ('UZ'))
42 : C
43 : C CHPGRA : gravité (SPG = meme que CHPRN,
44 : C composantes: 'UX', 'UY', ('UZ'))
45 : C
46 : C
47 : C SORTIES
48 : C
49 : C RESU : residu ou matrice jacobienne
50 : C
51 : C
52 : C************************************************************************
53 : C
54 : C HISTORIQUE (Anomalies et modifications éventuelles)
55 : C
56 : C HISTORIQUE :
57 : C
58 : C************************************************************************
59 : IMPLICIT INTEGER(I-N)
60 : -INC CCOPTIO
61 : -INC SMLMOTS
62 : -INC SMCHPOI
63 : C
64 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
65 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
66 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
67 : & ,IECHO, IIMPI, IOSPI
68 : & ,IDIM, IFICLE, IPREFI
69 : & ,MCOORD
70 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
71 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
72 : & ,NORINC,NORVAL,NORIND,NORVAD
73 : & ,NUCROU, IPSAUV
74 : C
75 : INTEGER NBOPT, IMET, IRET, IRO, ICEN, INDIC, NBCOMP
76 : & , IROVIT, JGN, JGM, IGRAV, ILIINC, IJAC, IRES
77 : C
78 : PARAMETER (NBOPT=2)
79 : CHARACTER*8 LOPT(NBOPT)
80 : CHARACTER*4 MOT(1)
81 : C
82 : DATA LOPT/'RESI ','JACOCONS'/
83 : C
84 : C**** IMET = 1 -> residuu
85 : C IMET = 2 -> jacobienne
86 : C
86 : CALL LIRMOT(LOPT,NBOPT,IMET,1)
87 : IF(IERR.NE.0)GOTO 9999
88 : C
89 : C**** Noms de variables conservatives
90 : C
90 : CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
91 : IF(IERR .NE. 0) GOTO 9999
92 : MLMOTS = ILIINC
93 : SEGACT MLMOTS
94 : NBCOMP = MLMOTS.MOTS(/2)
95 : SEGDES MLMOTS
96 : IF(NBCOMP .NE. (IDIM+2))THEN
97 : MOTERR(1:40) = 'LISTINCO = ???'
98 : WRITE(IOIMP,*) MOTERR
99 : C
100 : C******* Message d'erreur standard
101 : C 21 2
102 : C Données incompatibles
103 : C
103 : CALL ERREUR(21)
104 : GOTO 9999
105 : ENDIF
106 : C
107 : C**** Densité
108 : C
108 : CALL LIROBJ('CHPOINT',IRO,1,IRET)
109 : IF (IERR.NE.0) GOTO 9999
110 : C
111 : C**** On cherche le pointeur de son maillage et on l'impose sur les
112 : C autres CHPOINT
113 : C
114 : MCHPOI = IRO
115 : SEGACT MCHPOI
116 : MSOUPO = MCHPOI.IPCHP(1)
117 : SEGACT MSOUPO
118 : ICEN = MSOUPO.IGEOC
119 : SEGDES MSOUPO
120 : SEGDES MCHPOI
121 : C
122 : C**** Control du CHPOINT: QUEPOI
123 : C
124 : INDIC = 1
125 : NBCOMP = 1
126 : MOT(1) = 'SCAL'
126 : CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
127 : IF(IERR .NE. 0) GOTO 9999
128 : C
129 : C**** Lecture du CHPOINT DEBIT.
130 : C
130 : CALL LIROBJ('CHPOINT',IROVIT,1,IRET)
131 : IF (IERR.NE.0) GOTO 9999
132 : C
133 : C**** Control du CHPOINT
134 : C
135 : JGN = 4
136 : JGM = IDIM
137 : SEGINI MLMOTS
138 : MLMOTS.MOTS(1) = 'UX '
139 : MLMOTS.MOTS(2) = 'UY '
140 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
140 : CALL QUEPO1(IROVIT, ICEN, MLMOTS)
141 : IF(IERR .NE. 0) GOTO 9999
142 : C
143 : C
144 : C**** Lecture du CHPOINT GRAVITE.
145 : C
145 : CALL LIROBJ('CHPOINT',IGRAV,1,IRET)
146 : IF (IERR.NE.0) GOTO 9999
147 : C
148 : C**** Control du CHPOINT
149 : C
149 : CALL QUEPO1(IGRAV, ICEN, MLMOTS)
150 : IF(IERR .NE. 0) GOTO 9999
151 : SEGSUP MLMOTS
152 : C
153 : C**** Results
154 : C
155 : IF(IMET.EQ.1)THEN
156 : C
157 : C******* On calcule le residu
158 : C
159 : IJAC=0
159 : CALL FIMVF2(ILIINC,ICEN,IRO,IROVIT,IGRAV,IRES)
160 : ELSE
161 : IRES=0
161 : CALL FIMVF3(ILIINC,ICEN,IGRAV,IJAC)
162 : ENDIF
163 : C
163 : IF(IRES .NE. 0) CALL ECROBJ('CHPOINT ',IRES)
163 : IF(IJAC .NE. 0) CALL ECROBJ('MATRIK ',IJAC)
164 : C
165 : 9999 CONTINUE
166 : RETURN
167 : END
168 :
169 :
170 :
171 :
© Cast3M 2003 - All rights reserved.
Disclaimer