1 : C PENT SOURCE LEPOTIER 09/10/12 21:15:08 6527
2 : SUBROUTINE PENT()
3 : C************************************************************************
4 : C
5 : C PROJET : CASTEM 2000
6 : C
7 : C NOM : PENT (OPERATEUR GIBIANE)
8 : C
9 : C DESCRIPTION : Calcul du gradient d'un CHPOINT 2D/3D de type CENTRE
10 : C avec possible limitation LED ("Local extremum
11 : C diminishing");
12 : C
13 : C Calcul du gradient d'un CHPOINT 2D/3D de type FACE
14 : C avec la methode du diamant linaire exacte
15 : C
16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
17 : C
18 : C AUTEURS : A. BECCANTINI, R. MOREL, C. LEPOTIER, DEN/DM2S
19 : C
20 : C************************************************************************
21 : C
22 : C**** Variables de COOPTIO
23 : C
24 : IMPLICIT INTEGER(I-N)
25 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
26 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
27 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
28 : & ,IECHO, IIMPI, IOSPI
29 : & ,IDIM
30 : & ,MCOORD
31 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
32 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
33 : & ,NORINC,NORVAL,NORIND,NORVAD
34 : & ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
35 : -INC CCOPTIO
36 : C
37 : INTEGER IDOMA, ICOND, IRET1, NBOPT1,NBOPT2,NBOPT3,IOP1,IOP2,IOP3
38 : & ,INEFMD,MMODEL
39 : C
40 : PARAMETER(NBOPT1 = 3,NBOPT2 = 6,NBOPT3=2)
41 : CHARACTER*(8) LISMC1(NBOPT1),LISMC2(NBOPT2),LISMC3(NBOPT3),MOT
42 : & ,TYPE
43 : DATA LISMC1 /'CENTRE ','SOMMET ','FACE '/
44 : DATA LISMC2 /'EULESCAL','EULEVECT','DIAMANT','MPFA','DIAMAN2',
45 : & 'VFSYM'/
46 : DATA LISMC3 /'NOLIMITE','LIMITEUR'/
47 : C
48 : C**** Lecture de l'objet MODELE
49 : C
50 : ICOND = 1
50 : CALL QUETYP(TYPE,ICOND,IRET1)
51 :
52 : IF(IRET1.EQ.0.AND.TYPE.NE.'MMODEL')THEN
53 : WRITE(6,*)' On attend un objet MMODEL'
54 : RETURN
55 : ENDIF
55 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET1)
56 : IF(IERR.NE.0)GOTO 9999
56 : CALL LEKMOD(MMODEL,IDOMA,INEFMD)
57 : IF(IERR.NE.0)GOTO 9999
58 : C
59 : C**** Les options
60 : C
61 : C CENTRE, SOMMET ou FACE
62 : C
62 : CALL LIRCHA(MOT,1,IRET1)
63 : IF(IERR .NE. 0) GOTO 9999
63 : CALL OPTLI(IOP1,LISMC1,MOT,NBOPT1)
64 : IF(IERR .NE. 0) GOTO 9999
65 : IF(IOP1 .EQ. 0) THEN
66 : C
67 : C******* Message d'erreur standard
68 : C 251 2
69 : C Tentative d'utilisation d'une option non implémentée
70 :
70 : CALL ERREUR(251)
71 : GOTO 9999
72 : ENDIF
73 : C
74 : C**** Les differentes methodes (voir LISMC2)
75 : C
75 : CALL LIRCHA(MOT,1,IRET1)
76 : IF(IERR .NE. 0) GOTO 9999
76 : CALL OPTLI(IOP2,LISMC2,MOT,NBOPT2)
77 : IF(IOP2 .EQ. 0) THEN
78 : C
79 : C******* Message d'erreur standard
80 : C 251 2
81 : C Tentative d'utilisation d'une option non implémentée
82 :
82 : CALL ERREUR(251)
83 : GOTO 9999
84 : ENDIF
85 : C
86 : C
87 : C**** Les cas 1-2 ('EULESCAL','EULEVECT') sont traités ensembles
88 : C
89 : IF(IOP2.LE.2)THEN
90 : C
91 : C**** Limiteur ou non
92 : C
92 : CALL LIRCHA(MOT,1,IRET1)
93 : IF(IERR .NE. 0) GOTO 9999
93 : CALL OPTLI(IOP3,LISMC3,MOT,NBOPT3)
94 : IF(IOP3 .EQ. 0) THEN
95 : C
96 : C******* Message d'erreur standard
97 : C 251 2
98 : C Tentative d'utilisation d'une option non implémentée
99 :
99 : CALL ERREUR(251)
100 : GOTO 9999
101 : ENDIF
102 : C
103 : C******* Pour l'instant les cas 1-5 sont donnent des gradients
104 : C aux centres
105 : C
106 : IF(IOP1 .NE. 1)THEN
107 : C
108 : C********** Message d'erreur standard
109 : C 251 2
110 : C Tentative d'utilisation d'une option non implémentée
111 : C
111 : CALL ERREUR(251)
112 : GOTO 9999
113 : ENDIF
113 : CALL PENT15(IDOMA,IOP2,IOP3)
114 : IF(IERR.NE.0) GOTO 9999
115 : ELSEIF(IOP2.EQ.3)THEN
116 : C
117 : C******* Pour l'instant les cas 3 ('DIAMANT') donne un gradient aux
118 : C interfaces
119 : C
120 : IF(IOP1 .NE. 3)THEN
121 : C
122 : C********** Message d'erreur standard
123 : C 251 2
124 : C Tentative d'utilisation d'une option non implémentée
125 : C
125 : CALL ERREUR(251)
126 : GOTO 9999
127 : ENDIF
127 : CALL PENDIA(IDOMA)
128 : IF(IERR.NE.0) GOTO 9999
129 : ELSEIF(IOP2.EQ.4)THEN
130 : C
131 : C******* Le cas 4 ('NORVEGE') donne un gradient aux
132 : C interfaces
133 : C
134 : IF(IOP1 .NE. 3)THEN
135 : C
136 : C********** Message d'erreur standard
137 : C 251 2
138 : C Tentative d'utilisation d'une option non implémentée
139 : C
139 : CALL ERREUR(251)
140 : GOTO 9999
141 : ENDIF
141 : CALL NORV(IDOMA)
142 : IF(IERR.NE.0) GOTO 9999
143 : ELSEIF(IOP2.EQ.5)THEN
144 : C
145 : C******* Le cas 5 ('DIAMAN2') donne un gradient aux
146 : C interfaces
147 : C
148 : IF(IOP1 .NE. 3)THEN
149 : C
150 : C********** Message d'erreur standard
151 : C 251 2
152 : C Tentative d'utilisation d'une option non implémentée
153 : C
153 : CALL ERREUR(251)
154 : GOTO 9999
155 : ENDIF
155 : CALL PENDI2(IDOMA)
156 : IF(IERR.NE.0) GOTO 9999
157 : ELSEIF(IOP2.EQ.6)THEN
158 : C
159 : C******* Le cas 6 ('VFSYM') donne un gradient aux
160 : C SCHEMA PROPOSE PAR Christophe Le Potier
161 : C Références : {C. Le Potier}
162 : c \emph{Schema volumes finis pour des operateurs de diffusion
163 : c fortement anisotropes sur des maillages non structures},
164 : C C. R. Acad. Sci. Ser. I \textbf{340}, 2005, pp. 921--926.
165 : C interfaces
166 : C
167 : IF(IOP1 .NE. 3)THEN
168 : C
169 : C********** Message d'erreur standard
170 : C 251 2
171 : C Tentative d'utilisation d'une option non implémentée
172 : C
172 : CALL ERREUR(251)
173 : GOTO 9999
174 : ENDIF
174 : CALL VFSYM(IDOMA)
175 : IF(IERR.NE.0) GOTO 9999
176 : ENDIF
177 : C
178 : 9999 RETURN
179 : END
180 :
181 :
182 :
183 :
184 :
185 :
186 :
187 :
188 :
189 :
190 :
191 :
© Cast3M 2003 - All rights reserved.
Disclaimer