1 subroutine gmcpoj (nom1,nom2,codret)
2 c ______________________________________________________________________
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
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
14 c HOMARD est une marque deposee d'Electricite de France
20 c ______________________________________________________________________
22 c copier l'objet 'nom1' a la place de l'objet 'nom2'
23 c 'nom1' et 'nom2' doivent etre de meme type
24 c s'ils sont de type structure : on copie les attributs
25 c s'ils sont de type simple : on copie le contenu
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nom1 . e . char(*). nom etendu source .
32 c . nom2 . e .char(*) . nom etendu destinataire .
33 c . codret . s . ent . code retour de l'operation .
35 c . . . . -1 : 'nom1' invalide ou non alloue .
36 c . . . . -2 : objets destinataire et source ne sont .
37 c . . . . pas de meme type .
38 c . . . . -3 : nom etendu invalide .
39 c . . . . -4 : premier caractere interdit .
40 c ______________________________________________________________________
43 c 0. declarations et dimensionnement
46 c 0.1. ==> generalites
69 character*(*) nom1,nom2
71 c 0.4. ==> variables locales
75 character*8 obrep1,obter1,chter1
76 character*8 obrep2,obter2,chter2
81 integer ide1,ioa1,ity1,ide2,ioa2,ity2
82 integer ial2,irt2,iob1,ity,nba,iob2,ia,iat1,iat2
83 integer long1,iad1,long2,iad2,il,llres
86 c 1. decodage du nom etendu 'nom1'
89 call gbdnoe(nom1,obrep1,obter1,chter1,ide1)
91 if ((ide1.lt.0).or.(ide1.eq.1).or.(ide1.eq.2)) then
93 c 'nom1' invalide ou non alloue
102 call gbobal(obter1,ity1,ioa1)
115 c 2.1. obter1 est un objet structure (alloue)
120 call gbdnoe(nom2,obrep2,obter2,chter2,ide2)
124 else if (ide2.eq.0) then
125 call gbobal(obter2,ity2,ioa2)
127 call gmaloj(obter2,typ1,0,ial2,irt2)
136 if ((irt2.ne.0).and.(irt2.ne.-5)) then
137 mess = ' gmcpoj -> gmaloj -> codret : '
138 write(mess(29:30),'(i2)') irt2
140 call ugstop('gmcpoj',ulsort,1,1,1)
146 call gmaloj(nom2,typ1,0,ial2,irt2)
155 if ((irt2.ne.0).and.(irt2.ne.-5)) then
156 mess = ' gmcpoj -> gmaloj -> codret : '
157 write(mess(29:30),'(i2)') irt2
159 call ugstop('gmcpoj',ulsort,1,1,1)
163 call gbdnoe(nom2,obrep2,obter2,chter2,ide2)
164 call gbobal(obter2,ity2,ioa2)
167 if (ity1.ne.ity2) then
172 do 10 , iob1 = 1,iptobj-1
173 if (nomobj(iob1).eq.obter1) then
184 do 12 , iob2 = 1,iptobj-1
185 if (nomobj(iob2).eq.obter2) then
194 iat1 = adrdsa(iob1)+ia-1
195 iat2 = adrdsa(iob2)+ia-1
196 valatt(iat2) = valatt(iat1)
199 else if (ioa1.eq.2) then
201 c 2.2. obter1 est un objet simple (alloue)
203 call gbcara(obter1,nrotab,iad1,long1,letype)
209 call gbdnoe(nom2,obrep2,obter2,chter2,ide2)
213 else if (ide2.eq.0) then
214 call gbobal(obter2,ity2,ioa2)
216 call gmaloj(obter2,typ1,long1,ial2,irt2)
225 if ((irt2.ne.0).and.(irt2.ne.-5)) then
226 mess = ' gmcpoj -> gmaloj -> codret : '
227 write(mess(29:30),'(i2)') irt2
229 call ugstop('gmcpoj',ulsort,1,1,1)
235 call gmaloj(nom2,typ1,long1,ial2,irt2)
244 if ((irt2.ne.0).and.(irt2.ne.-5)) then
245 mess = ' gmcpoj -> gmaloj -> codret : '
246 write(mess(29:30),'(i2)') irt2
248 call ugstop('gmcpoj',ulsort,1,1,1)
252 call gbdnoe(nom2,obrep2,obter2,chter2,ide2)
253 call gbobal(obter2,ity2,ioa2)
256 if (ity1.ne.ity2) then
261 call gbcara(obter2,nrotab,iad2,long2,letype)
263 if (long1.gt.long2) then
266 if ( coergm.ne.0 ) then
272 call gmaloi(obter2,iad2,long1)
273 else if (ity1.eq.-2) then
274 call gmalor(obter2,iad2,long1)
275 else if (ity1.eq.-3) then
276 call gmalos(obter2,iad2,long1)
280 if (typ1.eq.nomtyb(1)) then
282 imem(iad2+il-1) = imem(iad1+il-1)
284 else if (typ1.eq.nomtyb(2)) then
286 rmem(iad2+il-1) = rmem(iad1+il-1)
288 else if (typ1.eq.nomtyb(3)) then
290 smem(iad2+il-1) = smem(iad1+il-1)
294 if (long1.lt.long2) then
298 call gmdesi(obter2,llres,detlg0)
299 else if (ity1.eq.-2) then
300 call gmdesr(obter2,llres,detlg0)
301 else if (ity1.eq.-3) then
302 call gmdess(obter2,llres,detlg0)