Salome HOME
Homard executable
[modules/homard.git] / src / tool / AP_Conversion / pcmanc.F
1       subroutine pcmanc ( lgopti, taopti, lgoptr, taoptr,
2      >                    lgopts, taopts,
3      >                    lgetco, taetco,
4      >                    ulsort, langue, codret)
5 c ______________________________________________________________________
6 c
7 c                             H O M A R D
8 c
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c
17 c    HOMARD est une marque deposee d'Electricite de France
18 c
19 c Copyright EDF 1996
20 c Copyright EDF 1998
21 c Copyright EDF 2002
22 c Copyright EDF 2020
23 c ______________________________________________________________________
24 c
25 c    aPres adaptation - Conversion de MAillage - Non Conforme
26 c     -                 -             --         -   -
27 c ______________________________________________________________________
28 c .        .     .        .                                            .
29 c .  nom   . e/s . taille .           description                      .
30 c .____________________________________________________________________.
31 c . lgopti . e   .   1    . longueur du tableau des options            .
32 c . taopti . e   . lgopti . tableau des options                        .
33 c . lgoptr . e   .   1    . longueur du tableau des options reelles    .
34 c . taoptr . e   . lgoptr . tableau des options                        .
35 c . lgopts . e   .   1    . longueur du tableau des options caracteres .
36 c . taopts . e   . lgopts . tableau des options caracteres             .
37 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
38 c . taetco . e   . lgetco . tableau de l'etat courant                  .
39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
40 c . langue . e   .    1   . langue des messages                        .
41 c .        .     .        . 1 : francais, 2 : anglais                  .
42 c . codret . es  .    1   . code de retour des modules                 .
43 c .        .     .        . 0 : pas de probleme                        .
44 c .        .     .        . 5 : mauvais type de code de calcul associe .
45 c ______________________________________________________________________
46 c
47 c====
48 c 0. declarations et dimensionnement
49 c====
50 c
51 c 0.1. ==> generalites
52 c
53       implicit none
54       save
55 c
56       character*6 nompro
57       parameter ( nompro = 'PCMANC' )
58 c
59 #include "nblang.h"
60 #include "motcle.h"
61 c
62 c 0.2. ==> communs
63 c
64 #include "envex1.h"
65 c
66 c 0.3. ==> arguments
67 c
68       integer lgopti
69       integer taopti(lgopti)
70 c
71       integer lgoptr
72       double precision taoptr(lgoptr)
73 c
74       integer lgopts
75       character*8 taopts(lgopts)
76 c
77       integer lgetco
78       integer taetco(lgetco)
79 c
80       integer ulsort, langue, codret
81 c
82 c 0.4. ==> variables locales
83 c
84       integer codava
85       integer nretap, nrsset
86       integer iaux
87       integer nonexm
88 c
89       character*6 saux
90       character*7 saux07
91 c
92       integer nbmess
93       parameter ( nbmess = 10 )
94       character*80 texte(nblang,nbmess)
95 c
96 c 0.5. ==> initialisations
97 c ______________________________________________________________________
98 c
99       codava = codret
100 c
101 c=======================================================================
102       if ( codava.eq.0 ) then
103 c=======================================================================
104 c
105 c====
106 c 1. messages
107 c====
108 c
109 #include "impr01.h"
110 c
111 #ifdef _DEBUG_HOMARD_
112       write (ulsort,texte(langue,1)) 'Entree', nompro
113       call dmflsh (iaux)
114 #endif
115 c
116       if ( taopti(11).eq.26 .or.
117      >     taopti(11).eq.36 ) then
118         saux07 = 'SATURNE'
119       elseif ( taopti(11).eq.46 .or.
120      >         taopti(11).eq.56 ) then
121         saux07 = 'NEPTUNE'
122       elseif ( taopti(11).eq.46 .or.
123      >         taopti(11).eq.76 ) then
124         saux07 = 'CARMEL '
125       else
126         saux07 = 'NON CFM'
127       endif
128 c
129       texte(1,4) = '(/,a6,1x,'''//saux07//' - COMPLEMENTS'')'
130       texte(1,5) = '(28(''=''),/)'
131 c
132       texte(2,4) = '(/,a6,1x,'''//saux07//' - ADDITIONAL OPERATIONS'')'
133       texte(2,5) = '(38(''=''),/)'
134 c
135 #include "impr03.h"
136 c
137 c 1.4. ==> le numero de sous-etape
138 c
139       nretap = taetco(1)
140       nrsset = taetco(2) + 1
141       taetco(2) = nrsset
142 c
143       call utcvne ( nretap, nrsset, saux, iaux, codret )
144 c
145 c 1.5 ==> le titre
146 c
147       write (ulsort,texte(langue,4)) saux
148       write (ulsort,texte(langue,5))
149 c
150 c====
151 c 2. Passage du maillage 2D au maillage 3D pour un maillage extrude
152 c====
153 #ifdef _DEBUG_HOMARD_
154       write (ulsort,90002) '2. 2D -> 3D ; codret', codret
155 #endif
156 c
157       if ( codret.eq.0 ) then
158 c
159       if ( taopti(39).ne.0 ) then
160 c
161 #ifdef _DEBUG_HOMARD_
162         write (ulsort,texte(langue,3)) 'PCMA23', nompro
163 #endif
164         call pcma23 ( taopts(2),
165      >                taopti(40), taoptr(4), taopts(20),
166      >                ulsort, langue, codret )
167 c
168       endif
169 c
170       endif
171 c
172 c====
173 c 3. Les recollements par equivalence
174 c====
175 #ifdef _DEBUG_HOMARD_
176       write (ulsort,90002) '3. recollements ; codret', codret
177 #endif
178 c
179       if ( taopti(30).eq.-2 .or.
180      >     taopti(30).eq.1 .or.
181      >     taopti(30).eq.2 .or.
182      >     taopti(30).eq.3 ) then
183 c
184         if ( codret.eq.0 ) then
185 c
186         nonexm = 1
187         if ( ( taopti(11).eq.36 ) .or. ( taopti(11).eq.56 ) ) then
188           nonexm = nonexm*2
189         endif
190 #ifdef _DEBUG_HOMARD_
191       write (ulsort,90002) 'nonexm', nonexm
192 #endif
193 c
194 #ifdef _DEBUG_HOMARD_
195       write (ulsort,texte(langue,3)) 'PCMARC', nompro
196 #endif
197         call pcmarc ( taopts(2), taopts(20),
198      >                nonexm,
199      >                ulsort, langue, codret )
200 c
201         endif
202 c
203       endif
204 c
205 c====
206 c 4. la fin
207 c====
208 c
209       if ( codret.ne.0 ) then
210 c
211 #include "envex2.h"
212 c
213       write (ulsort,texte(langue,1)) 'Sortie', nompro
214       write (ulsort,texte(langue,2)) codret
215 c
216       endif
217 c
218 #ifdef _DEBUG_HOMARD_
219       write (ulsort,texte(langue,1)) 'Sortie', nompro
220       call dmflsh (iaux)
221 #endif
222 c
223 c=======================================================================
224       endif
225 c=======================================================================
226 c
227       end