1 subroutine gmshfs ( tab , adnew , adold , nbval )
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 translate le contenu du tableau caracteres 8 tab
23 c de l'adresse adold a l'adresse adnew et cela pour nbval valeurs.
24 c ______________________________________________________________________
26 c . nom . e/s . taille . description .
27 c .____________________________________________________________________.
28 c . tab . es . * . tableau dans lequel on decale .
29 c . . . . sa longueur est a priori inconnue .
30 c . adnew . e . 1 . adresse a laquelle on placera les valeurs .
31 c . adold . e . 1 . adresse a laquelle sont les valeurs .
32 c . nbval . e . 1 . nombre de valeurs a transferer .
33 c ______________________________________________________________________
36 c 0. declarations et dimensionnement
39 c 0.1. ==> generalites
52 integer adnew , adold , nbval
54 c 0.4. ==> variables locales
56 integer iaux, ifin, decal
59 c 1. decalage des valeur au sein du tableau tab
60 c a condition que adnew <= adold
61 c remarque : cette programmation de la boucle est celle qui entraine
62 c le moins de calculs sur machine scalaire.
63 c sur CRAY, les options de compilation vectorisent
64 c totalement le traitement.
68 if ( decal.lt.0 ) then
70 write(ulsort,1000) adnew, adold
71 1000 format(//2x,' ====== spg gmshfs ========',/2x,
72 > ' le decalage d''indice ne peut s''effectuer car le nouvel',
73 > /2x,' indice (',i6,') est superieur a l''ancien (',i6,') .')
74 call ugstop('gmshfs',ulsort,0,1,1)
79 ifin = adnew + nbval - 1
81 do 10 , iaux = adnew , ifin
82 tab(iaux) = tab(decal+iaux)