Salome HOME
Homard executable
[modules/homard.git] / src / tool / Gestion_MTU / gbalme.F
1       subroutine gbalme ( typzon, lgzone, adress )
2 c ______________________________________________________________________
3 c
4 c                             H O M A R D
5 c
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
7 c
8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
9 c aupres des huissiers de justice Simart et Lavoir a Clamart
10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
11 c aupres des huissiers de justice
12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
13 c
14 c    HOMARD est une marque deposee d'Electricite de France
15 c
16 c Copyright EDF 1996
17 c Copyright EDF 1998
18 c Copyright EDF 2002
19 c Copyright EDF 2020
20 c ______________________________________________________________________
21 c
22 c     allocation d'une zone de lgzone places dans le type 'typzon'
23 c ______________________________________________________________________
24 c .        .     .        .                                            .
25 c .  nom   . e/s . taille .           description                      .
26 c .____________________________________________________________________.
27 c . typzon . e   . char*1 . type de la zone a allouer                  .
28 c . lgzone . e   .    1   . longueur de la zone                        .
29 c . adress .  s  .    1   . adresse du premier element de la zone      .
30 c ______________________________________________________________________
31 c
32 c====
33 c 0. declarations et dimensionnement
34 c====
35 c
36 c 0.1. ==> generalites
37 c
38       implicit none
39       save
40 c
41       character*6 nompro
42       parameter ( nompro = 'GBALME' )
43 c
44 #include "genbla.h"
45 c
46 c 0.2. ==> communs
47 c
48 #include "gmtail.h"
49 c
50 #include "gmimpr.h"
51 #include "envex1.h"
52 #include "gmlang.h"
53 #include "gmcoer.h"
54 c
55 c 0.3. ==> arguments
56 c
57       character*1 typzon
58       integer lgzone, adress
59 c
60 c 0.4. ==> variables locales
61 c
62       integer ltype, taille
63       integer iaux
64 c
65       integer nbmess
66       parameter ( nbmess = 10 )
67       character*80 texte(nblang,nbmess)
68 c
69 c====
70 c 1. initialisations
71 c====
72 c
73 #include "impr01.h"
74 c
75 #ifdef _DEBUG_HOMARD_
76       write (ulsort,texte(langue,1)) 'Entree', nompro
77       call dmflsh (iaux)
78 #endif
79 c
80 c====
81 c 2. controle du type et de sa longueur
82 c====
83 c
84       if ( typzon.eq.'i'.or.typzon.eq.'I') then
85        ltype = tentie
86       elseif ( typzon.eq.'s'.or.typzon.eq.'S') then
87        ltype = tchain
88       elseif ( typzon.eq.'r'.or.typzon.eq.'R') then
89        ltype = treel
90       else
91         write(ulsort,*) nompro, ', type inconnu ', typzon
92         coergm = 1
93       endif
94 c
95 c====
96 c 3. Allocations
97 c====
98 c
99       if ( coergm.eq.0 ) then
100 c
101       taille = ltype*lgzone
102 #ifdef _DEBUG_HOMARD_
103       write (ulsort,*) '..... taille : ', taille
104 #endif
105 #ifdef _DEBUG_HOMARD_
106       write (ulsort,texte(langue,3)) 'DMALME', nompro
107 #endif
108       call dmalme ( adress, taille, coergm )
109 c
110       endif
111 c
112 c====
113 c 4. Fin
114 c====
115 c
116       if ( coergm.ne.0 ) then
117 c
118 #include "envex2.h"
119 c
120       endif
121 c
122       end