      1 C*************************************************************************
      2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
      3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
      4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
      5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
      6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
      7 C
      8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
      9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
     10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
     11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
     12 C
     13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
     14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
     15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
     16 C
     17 C**************************************************************************
     18
     19 C ******************************************************************************
     20 C * - Nom du fichier : test10.f
     21 C *
     22 C * - Description : ecriture de champs de resultats MED
     23 C *
     24 C ******************************************************************************
     25         program test10
     26 C
     27         implicit none
     28         include 'med.hf'
     29 C
     30         integer      ret,fid,USER_INTERLACE,USER_MODE
     31         real*8       a,b,p1,p2,dt
     32
     33         character*32 maa1,maa2,maa3
     34         character*13 lien_maa2
     35 C       CHAMP N°1
     36         character*32 nomcha1
     37         character*16 comp1(2), unit1(2)
     38         character*16 dtunit1, nounit
     39         integer      ncomp1
     40 C       MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1
     41         integer      ngauss1_1
     42         character*32 gauss1_1
     43         real*8       refcoo1(12), gscoo1_1(12), wg1_1(6)
     44         integer      nval1_1
     45         real*8       valr1_1(1*6*2)
     46 C       MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1
     47         integer      ngauss1_2
     48         character*32 gauss1_2
     49         real*8       gscoo1_2(6), wg1_2(3)
     50         integer      nval1_2
     51         real*8       valr1_2(2*3*2)
     52         real*8       valr1_2p(2*3)
     53 C       MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1
     54         integer      ngauss1_3,nval1_3
     55         real*8       valr1_3(2*3*2)
     56         real*8       valr1_3p(2*2)
     57
     58 C       CHAMP N°2
     59         character*32 nomcha2
     60         character*16 comp2(3), unit2(3)
     61         integer      ncomp2, nval2
     62         integer      valr2(5*3),   valr2p(3*3)
     63
     64 C       CHAMP N°3
     65         character*32 nomcha3
     66         character*16 comp3(2), unit3(2)
     67         integer      ncomp3, nval3
     68         integer      valr3(5*4*2),   valr3p(3*4*2)
     69
     70 C       PROFILS UTILISES
     71         character*32 nomprofil1
     72         integer      profil1(2) , profil2(3)
     73
     74         parameter (USER_INTERLACE = MED_FULL_INTERLACE)
     75         parameter (USER_MODE = MED_COMPACT )
     76         parameter ( a=0.446948490915965D0, b=0.091576213509771D0    )
     77         parameter ( p1=0.11169079483905D0, p2=0.0549758718227661D0  )
     78 C       MAILLAGES
     79         parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" )
     80         parameter ( lien_maa2= "./testfoo.med"                  )
     81 C       CHAMP N°1
     82         parameter ( nomcha1 = "champ reel" )
     83         parameter ( ncomp1 = 2 )
     84         parameter ( dtunit1 = "                ")
     85         parameter ( nounit  = "                ")
     86 C       MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1
     87         parameter ( gauss1_1 = "Model n1" )
     88         parameter ( ngauss1_1 = 6 )
     89 C       MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1
     90         parameter ( gauss1_2  = "Model n2" )
     91         parameter ( ngauss1_2 = 3 )
     92 C       MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1
     93         parameter ( ngauss1_3 = 6 )
     94         parameter ( nval1_3 = 6 )
     95 C       CHAMP N°2
     96         parameter ( nomcha2="champ entier")
     97         parameter ( ncomp2 = 3, nval2= 5  )
     98 C       CHAMP N°3
     99         parameter ( nomcha3="champ entier 3")
    100         parameter ( ncomp3 = 2, nval3= 5*4  )
    101 C       PROFILS
    102         parameter ( nomprofil1  = "PROFIL(champ(1))" )
    103
    104
    105 C       CHAMP N°1
    106         data comp1 /"comp1", "comp2"/
    107         data unit1 /"unit1","unit2"/
    108 C       MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1
    109         data nval1_1  / 1*6 /
    110         data refcoo1  / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
    111      1                  0.0,-1.0, 0.0,0.0 /
    112         data valr1_1  /  0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
    113      1                   20.0,21.0, 22.0,23.0/
    114 C       MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1
    115         data valr1_2  / 0.0,1.0, 2.0,3.0, 10.0,11.0,
    116      1                  12.0,13.0, 20.0,21.0, 22.0,23.0 /
    117         data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
    118 C       MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1
    119         data valr1_3  / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
    120      1                  20.0,21.0, 22.0,23.0 /
    121         data valr1_3p / 2.0,3.0, 10.0,11.0   /
    122 C       CHAMP N°2
    123         data comp2 /"comp1", "comp2", "comp3"/
    124         data unit2 /"unit1","unit2", "unit3"/
    125         data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
    126         data valr2p / 0,1,2,           20,21,22,           40,41,42 /
    127 C       CHAMP N°3
    128         data comp3 /"comp1", "comp2"/
    129         data unit3 /"unit1","unit2"/
    130         data valr3 / 0,1, 10,11, 20,21, 30,31,
    131      1           40,41, 50,51, 60,61, 70,71,
    132      1           80,81, 90,91, 100,101, 110,111,
    133      1           120,121, 130,131, 140,141, 150,151,
    134      1           160,161, 170,171, 180,181, 190,191 /
    135         data valr3p / 0,1, 10,11, 20,21, 30,31,
    136      1            80,81, 90,91, 100,101, 110,111,
    137      1            160,161, 170,171, 180,181, 190,191 /
    138
    139
    140 C       PROFILS
    141         data profil1 /2,3/
    142         data profil2 /1,3,5/
    143
    144         ret = 0
    145
    146         gscoo1_1(1) =  2*b-1
    147         gscoo1_1(2) =  1-4*b
    148         gscoo1_1(3) =  2*b-1
    149         gscoo1_1(4) =  2*b-1
    150         gscoo1_1(5) =  1-4*b
    151         gscoo1_1(6) =  2*b-1
    152         gscoo1_1(7) =  1-4*a
    153         gscoo1_1(8) =  2*a-1
    154         gscoo1_1(9) =  2*a-1
    155         gscoo1_1(10) =  1-4*a
    156         gscoo1_1(11) =  2*a-1
    157         gscoo1_1(12) =  2*a-1
    158
    159         wg1_1(1) =  4*p2
    160         wg1_1(2) =  4*p2
    161         wg1_1(3) =  4*p2
    162         wg1_1(4) =  4*p1
    163         wg1_1(5) =  4*p1
    164         wg1_1(6) =  4*p1
    165
    166         nval1_2 = 2*3
    167         gscoo1_2(1) = -2.0D0/3
    168         gscoo1_2(2) =  1.0D0/3
    169         gscoo1_2(3) = -2.0D0/3
    170         gscoo1_2(4) = -2.0D0/3
    171         gscoo1_2(5) =  1.0D0/3
    172         gscoo1_2(6) = -2.0D0/3
    173
    174         wg1_2(1) =  2.0D0/3
    175         wg1_2(2) =  2.0D0/3
    176         wg1_2(3) =  2.0D0/3
    177
    178 C     ** ouverture du fichier                            **
    179         call efouvr(fid,'test10.med',MED_LECTURE_ECRITURE, ret)
    180         if (ret .ne. 0 ) then
    181            print *,'Erreur à l''ouverture du fichier  : ','test10.med'
    182            call efexit(-1)
    183         endif
    184
    185 C     ** creation du maillage maa1 de dimension 3         **
    186         call efmaac(fid,maa1,3,MED_NON_STRUCTURE,
    187      1                 "Maillage vide",ret)
    188         if (ret .ne. 0 ) then
    189            print *,'Erreur à la création du maillage : ', maa1
    190            call efexit(-1)
    191         endif
    192
    193 C     ** creation du maillage maa3 de dimension 3         **
    194         call efmaac(fid,maa3,3,MED_NON_STRUCTURE,
    195      1                 "Maillage vide",ret)
    196         if (ret .ne. 0 ) then
    197            print *,'Erreur à la création du maillage : ', maa3
    198            call efexit(-1)
    199         endif
    200
    201
    202 C     ** creation du champ réel n°1                        **
    203         call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,ret)
    204         if (ret .ne. 0 ) then
    205            print *,'Erreur à la création du champ : ', nomcha1
    206            call efexit(-1)
    207         endif
    208
    209 C     ** creation du champ entier n°2                      **
    210         call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,ret)
    211         if (ret .ne. 0 ) then
    212            print *,'Erreur à la création du champ : ', nomcha2
    213            call efexit(-1)
    214         endif
    215
    216 C     ** creation du lien au fichier distant contenant maa2 **
    217         call efliee(fid,lien_maa2,maa2,ret)
    218         if (ret .ne. 0 ) then
    219            print *,'Erreur à la création du lien : ', lien_maa2
    220            call efexit(-1)
    221         endif
    222
    223 C     ** creation de la localisation des points de Gauss modèle n°1 **
    224         call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
    225      1               ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret)
    226         if (ret .ne. 0 ) then
    227            print *,'Erreur à la création du modèle n°1 : ', gauss1_1
    228            call efexit(-1)
    229         endif
    230
    231 C     ** creation de la localisation des points de Gauss modèle n°2 **
    232         call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
    233      1               ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret)
    234         if (ret .ne. 0 ) then
    235            print *,'Erreur à la création du modèle n°2 : ', gauss1_2
    236            call efexit(-1)
    237         endif
    238
    239
    240 C     ** Ecriture du champ n°1
    241 C     ** - enregistre uniquement la composante n°2 de valr1_1
    242 C     ** - pas de pas de temps, ni de numero d'ordre
    243         dt = 0.0D0
    244         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
    245      1               gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
    246      2               MED_MAILLE,MED_TRIA6,
    247      3               MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
    248         if (ret .ne. 0 ) then
    249            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1'
    250            call efexit(-1)
    251         endif
    252
    253 C     ** Nouvelle Ecriture du champ reel en mode remplacement
    254 C     ** - complete le champ precedent en enregistrant les composantes 1
    255 C     ** - pas de pas de temps, ni de numero d'ordre
    256         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
    257      1               gauss1_1,1,MED_NOPFL,MED_NO_PFLMOD,
    258      2               MED_MAILLE,MED_TRIA6,
    259      3               MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
    260         if (ret .ne. 0 ) then
    261            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2'
    262            call efexit(-1)
    263         endif
    264
    265 C     ** Ecriture sur le champ reel
    266 C     ** - De la 1ere composante du tableau valr1_2
    267 C     ** - Avec un pas de temps égal a 5.5
    268 C     ** - Pas de numero d'ordre
    269 C     ** - maa2 est distant
    270         dt = 5.5D0
    271         call efchae(fid,maa2,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
    272      1               gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
    273      2               MED_MAILLE,MED_TRIA6,
    274      3               1,"ms",dt,MED_NONOR,ret)
    275         if (ret .ne. 0 ) then
    276            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3'
    277            call efexit(-1)
    278         endif
    279
    280 C     ** Ecriture sur le champ reel
    281 C     ** - De la 2ere composante du tableau valr1_2
    282 C     ** - Avec un pas de temps égal a 5.5
    283 C     ** - Pas de numero d'ordre
    284 C     ** - maa1 est local
    285         dt = 5.5D0
    286         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
    287      1               gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
    288      2               MED_MAILLE,MED_TRIA6,
    289      3               1,"ms",dt,MED_NONOR,ret)
    290         if (ret .ne. 0 ) then
    291            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4'
    292            call efexit(-1)
    293         endif
    294
    295
    296 C     ** Ecriture sur le champ reel
    297 C     ** - De la 1ere composante du tableau valr1_1
    298 C     ** - Avec un pas de temps égal a 5.5
    299 C     ** - Numero d'ordre egal a 2
    300 C     ** - maa3 est local
    301         dt = 5.5D0
    302         call efchae(fid,maa3,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
    303      1               gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
    304      2               MED_MAILLE,MED_TRIA6,
    305      3               1,"ms",dt,2,ret)
    306         if (ret .ne. 0 ) then
    307            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5'
    308            call efexit(-1)
    309         endif
    310
    311 C     ** Creation de profil
    312 C     ** - qui selectionne uniquement le 2e element du tableau valr1
    313         call efpfle(fid,profil1,1,nomprofil1,ret)
    314         if (ret .ne. 0 ) then
    315            print *,'Erreur à la création du profil : ', nomprofil1
    316            call efexit(-1)
    317         endif
    318
    319
    320 C     ** Ecriture du champ reel
    321 C     ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL)
    322 C     ** - Extrait a partir du profil de nom "profil1(1)"
    323 C     ** - Pas de temps = 5.6
    324 C     ** - Numero d'ordre = 2
    325         dt = 5.6D0
    326         call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
    327      1               MED_NOGAUSS,MED_ALL,nomprofil1,USER_MODE,
    328      2               MED_MAILLE,MED_TRIA6,
    329      3               2,"ms",dt,2,ret)
    330         if (ret .ne. 0 ) then
    331            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6'
    332            call efexit(-1)
    333         endif
    334
    335 C     ** Ecriture du champ reel
    336 C     ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL)
    337 C     ** - Extrait a partir du profil de nom "profil1(1)"
    338 C     ** - Pas de temps = 5.6
    339 C     ** - Numero d'ordre = 2
    340         dt = 5.6D0
    341         call efchae(fid,maa2,nomcha1,valr1_2p,USER_INTERLACE,nval1_2,
    342      1               gauss1_2,MED_ALL,nomprofil1,USER_MODE,
    343      2               MED_MAILLE,MED_TRIA6,
    344      3               2,"ms",dt,2,ret)
    345         if (ret .ne. 0 ) then
    346            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7'
    347            call efexit(-1)
    348         endif
    349
    350
    351 C     ** Ecriture du champ reel
    352 C     ** - 2e composante du 2e element du champ
    353 C     ** - Extrait a partir du profil de nom "profil1(1)"
    354 C     ** - Pas de temps = 5.7
    355 C     ** - Numero d'ordre = 2
    356         dt = 5.7D0
    357         call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
    358      1               MED_NOGAUSS,2,nomprofil1,USER_MODE,
    359      2               MED_MAILLE,MED_TRIA6,
    360      3               3,"ms",dt,2,ret)
    361         if (ret .ne. 0 ) then
    362            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8'
    363            call efexit(-1)
    364         endif
    365
    366
    367 C     ** Ecriture du champ entier n°2
    368 C     ** - 1ere composante des éléments de valr2
    369 C     ** - pas de pas de temps, ni de numero d'ordre
    370         dt = 0.0D0
    371         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
    372      1     MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_ARETE,
    373      1               MED_SEG2,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    374         if (ret .ne. 0 ) then
    375            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1'
    376            call efexit(-1)
    377         endif
    378
    379 C     ** Ecriture du champ entier n°2
    380 C     ** - 2ere composante des éléments de valr2
    381 C     ** - pas de pas de temps, ni de numero d'ordre
    382 C     ** - pour des raisons de complétude des tests on change
    383 C     **   le type d'élément (aucun sens phys.))
    384         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
    385      1     MED_NOGAUSS,2,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD,
    386      1               0,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    387         if (ret .ne. 0 ) then
    388            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2'
    389            call efexit(-1)
    390         endif
    391
    392
    393 C     ** Ecriture du champ entier n°2
    394 C     ** - 3ere composante des éléments de valr2
    395 C     ** - pas de pas de temps, ni de numero d'ordre
    396 C     ** - pour des raisons de complétude des tests on change
    397 C     **   le type d'élément (aucun sens phys.))
    398         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
    399      1     MED_NOGAUSS,3,MED_NOPFL,MED_NO_PFLMOD,MED_FACE,
    400      1               MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    401         if (ret .ne. 0 ) then
    402            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3'
    403            call efexit(-1)
    404         endif
    405
    406 C     ** Creation de profil
    407 C     ** - selectionne les elements 1,3,5 du tableau valr2
    408         call efpfle(fid,profil2,3,"PROFIL(champ2)",ret)
    409         if (ret .ne. 0 ) then
    410            print *,'Erreur à l''écriture du profil : ',
    411      1              'profil2(champ2)'
    412            call efexit(-1)
    413         endif
    414
    415
    416 C     ** Ecriture du champ entier n°2
    417 C     ** - 3eme composante des éléments de valr2
    418 C     ** - pas de pas de temps, ni de numero d'ordre
    419 C     ** - profils
    420 C     ** - pour des raisons de complétude des tests on change
    421 C     **   le type d'élément (aucun sens phys.))
    422         call efchae(fid,maa1,nomcha2,valr2p,USER_INTERLACE,nval2,
    423      1     MED_NOGAUSS,3,"PROFIL(champ2)",USER_MODE,MED_MAILLE,
    424      1               MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    425         if (ret .ne. 0 ) then
    426            print *,'Erreur à l''écriture du profil : ',
    427      1             'profil2(champ2)'
    428            call efexit(-1)
    429         endif
    430
    431 C     ** creation du champ entier n°3                      **
    432         call efchac(fid,nomcha3,MED_INT32,comp3,unit3,ncomp3,ret)
    433         if (ret .ne. 0 ) then
    434            print *,'Erreur à la création du champ : ', nomcha3
    435            call efexit(-1)
    436         endif
    437
    438 C     ** Ecriture du champ entier n°3
    439 C     ** - 1ere composante des éléments de valr3
    440 C     ** - pas de pas de temps, ni de numero d'ordre
    441 C     ** - pour des raisons de complétude des tests on change
    442 C     **   le type d'élément (aucun sens phys.))
    443         call efchae(fid,maa1,nomcha3,valr3,USER_INTERLACE,nval3,
    444      1     MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD_MAILLE,
    445      1               MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    446         if (ret .ne. 0 ) then
    447            print *,'Erreur à l''écriture du champ : ', nomcha3,'et.1'
    448            call efexit(-1)
    449         endif
    450
    451 C     ** Ecriture du champ entier n°3
    452 C     ** - les composantes des éléments de valr3
    453 C     ** - pas de pas de temps, ni de numero d'ordre
    454 C     ** - pour des raisons de complétude des tests on change
    455 C     **   le type d'élément (aucun sens phys.))
    456         call efchae(fid,maa2,nomcha3,valr3,USER_INTERLACE,nval3,
    457      1     MED_NOGAUSS,MED_ALL,MED_NOPFL,MED_NO_PFLMOD,
    458      1               MED_NOEUD_MAILLE,
    459      1               MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    460         if (ret .ne. 0 ) then
    461            print *,'Erreur à l''écriture du champ : ', nomcha3,'et.2'
    462            call efexit(-1)
    463         endif
    464
    465 C     ** Ecriture du champ entier n°3
    466 C     ** - les composantes des éléments de valr3
    467 C     ** - pas de pas de temps, ni de numero d'ordre
    468 C     ** - profils
    469 C     ** - pour des raisons de complétude des tests on change
    470 C     **   le type d'élément (aucun sens phys.))
    471         call efchae(fid,maa3,nomcha3,valr3p,USER_INTERLACE,nval3,
    472      1     MED_NOGAUSS,MED_ALL,"PROFIL(champ2)",USER_MODE,
    473      1               MED_NOEUD_MAILLE,
    474      1               MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret)
    475         if (ret .ne. 0 ) then
    476            print *,'Erreur à l''écriture du profil : ',
    477      1             'profil2(champ2)'
    478            call efexit(-1)
    479         endif
    480
    481 C     ** Fermeture du fichier *
    482         call efferm (fid,ret)
    483         if (ret .ne. 0 ) then
    484            print *,'Erreur à la fermeture du fichier : '
    485            ret = -1
    486         endif
    487
    488         print *,"Le code retour : ",ret
    489         call efexit(ret)
    490
    491         end
    492
    493
    494