C*************************************************************************
C COPYRIGHT (C) 1999 - 2003  EDF R&D
C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
C
C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
C
C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
C
C**************************************************************************

C ******************************************************************************
C * - Nom du fichier : test10.f
C *
C * - Description : ecriture de champs de resultats MED 
C *
C ******************************************************************************
	program test10
C     
	implicit none
	include 'med.hf'
C
	integer      cret,fid
	character*32 maa
	integer      mdim
	character*16  comp1(2), unit1(2),comp2(3), unit2(3)
        character*16  dtunit1
	character*32 nomcha1, nomcha2
	integer      ncomp1, nval1, ngauss1, ncomp2, nval2, ngauss2
        integer      profil1(2) , profil2(3)
	real*8       valr1(3*2*2), valr1p(2*2*2)
	integer      valr2(5*3),   valr2p(3*3)
	real*8       dt
        
	
	parameter (maa = "maa1", mdim = 3,ncomp1 = 2, ncomp2 = 3)
C       ** 3 valeurs et 2 points de gauss par valeur pour le champ reel */
C       ** 5 valeurs et pas de  points de gauss pour le champ entier    */
	parameter (ngauss1 = 2, ngauss2 = 1, nval1 = 3*2, nval2 = 5)
	
	data comp1 /"comp1", "comp2"/
        data unit1 /"unit1","unit2"/
	data comp2 /"comp1", "comp2", "comp3"/
        data unit2 /"unit1","unit2", "unit3"/
	data nomcha1 /"champ reel"/, nomcha2 /"champ entier"/
        
	parameter (dtunit1 = "")
        
	data valr1  /0.,1.,2.,3.,  10.,11.,12.,13.,  20.,21.,22.,23./
	data valr1p /              10.,11.,12.,13.,  20.,21.,22.,23./
        data valr2  /0,1,2, 10,11,12,  20,21,22,  30,31,32,  40,41,42/
        data valr2p /0,1,2,            20,21,22,             40,41,42/

	data profil1 /2,3/
	data profil2 /1,3,5/
        
C     ** ouverture du fichier                            **
 	call efouvr(fid,'test10.med',MED_CREATION, cret)
	print *,'Creation du fichier  : ',cret

        
C     ** creation du maillage maa de dimension 3         **
	if (cret .eq. 0) then
	   call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     1                 "description",cret)
	endif
	print *,'Creation du maillage : ',cret
     

C     ** creation du champ n°1                               **
	if (cret .eq. 0) then
	   call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,cret)
	endif
	print *,'Creation du champ reel : ', cret

C     ** creation du champ n°2                               **
	if (cret .eq. 0) then
	   call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,cret)
	endif
	print *,'Creation du champ entier : ', cret

	
C     ** Ecriture du champ n°1
C     ** - enregistre uniquement la composante n°2 de valr1
C     ** - pas de pas de temps, ni de numero d'ordre
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha1,valr1,MED_FULL_INTERLACE,nval1,
     1               ngauss1,2,MED_NOPFL,MED_MAILLE,MED_TRIA3,
     1               MED_NOPDT,dtunit1,0.0,MED_NONOR,cret)
      endif
      print *,'Premiere ecriture du champ reel : ', cret

C     ** Nouvelle Ecriture du champ reel en mode remplacement
C     ** - complete le champ precedent en enregistrant les composantes 1
C     ** - pas de pas de temps, ni de numero d'ordre 
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha1,valr1,MED_FULL_INTERLACE,nval1,
     1               ngauss1,1,MED_NOPFL,MED_MAILLE,MED_TRIA3,
     1               MED_NOPDT,dtunit1,0.0,MED_NONOR,cret)
      endif
      print *,'Complement ecriture du champ reel : ', cret

C     ** Ecriture sur le champ reel
C     ** - De la 1ere composante du tableau valr1
C     ** - Avec un pas de temps égal a 5.5
C     ** - Pas de numero d'ordre
      if (cret .eq. 0) then
	 dt = 5.5
	 call efchae(fid,maa,nomcha1,valr1,MED_FULL_INTERLACE,nval1,
     1               ngauss1,1,MED_NOPFL,MED_MAILLE,MED_TRIA3,
     1               1,"ms",dt,MED_NONOR,cret)
      endif
      print *,'Idem avec un pas de tps et numero ordre : ',cret

C     ** Ecriture sur le champ reel
C     ** - De la 1ere composante du tableau valr1
C     ** - Avec un pas de temps égal a 5.5
C     ** - Numero d'ordre egal a 2
      if (cret .eq. 0) then
	 dt = 5.5
	 call efchae(fid,maa,nomcha1,valr1,MED_FULL_INTERLACE,nval1,
     1               ngauss1,1,MED_NOPFL,MED_MAILLE,MED_TRIA3,
     1               1,"ms",dt,2,cret)
      endif
      print *,'Ecriture du champ reel avec pdt et numero ordre : ',cret

C     ** Creation de profil
C     ** - qui selectionne uniquement le 2e element du tableau valr1
      if (cret .eq. 0) then
	 call efpfle(fid,profil1,1,"profil1(1)",cret)
      endif
      print *,'Ecriture de profil n°1 : ',cret


C     ** Ecriture du champ reel 
C     ** - Toutes les composantes du 2e element du champ (MED_ALL)
C     ** - Extrait a partir du profil de nom "profil1(1)"
C     ** - Pas de temps = 5.6
C     ** - Numero d'ordre = 2 
      if (cret .eq. 0) then
	 dt = 5.6
	 call efchae(fid,maa,nomcha1,valr1p,MED_FULL_INTERLACE,nval1,
     1               ngauss1,MED_ALL,"profil1(1)",MED_MAILLE,
     1               MED_TRIA3,2,"ms",dt,2,cret)
      endif
      print *,'Ecriture du champ reel avec profil : ',cret

C     ** Ecriture du champ reel 
C     ** - 2e composante du 2e element du champ
C     ** - Extrait a partir du profil de nom "profil1(1)"
C     ** - Pas de temps = 5.7
C     ** - Numero d'ordre = 2 
      if (cret .eq. 0) then
	 dt = 5.7
	 call efchae(fid,maa,nomcha1,valr1p,MED_FULL_INTERLACE,nval1,
     1               ngauss1,2,"profil1(1)",MED_MAILLE,
     1               MED_TRIA3,3,"ms",dt,2,cret)
      endif
      print *,'Ecriture du champ reel avec profil : ',cret

C     ** Ecriture du champ entier n°2
C     ** - 1ere composante des éléments de valr2
C     ** - pas de pas de temps, ni de numero d'ordre
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha2,valr2,MED_FULL_INTERLACE,nval2,
     1     ngauss2,1,MED_NOPFL,MED_ARETE,
     1               MED_SEG2,MED_NOPDT,"",0.0,MED_NONOR,cret)
      endif
      print *,'Ecriture du champ entier (1) : ',cret

C     ** Ecriture du champ entier n°2
C     ** - 2ere composante des éléments de valr2
C     ** - pas de pas de temps, ni de numero d'ordre
C     ** - pour des raisons de complétude des tests on change 
C     **   le type d'élément (aucun sens phys.))
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha2,valr2,MED_FULL_INTERLACE,nval2,
     1     ngauss2,2,MED_NOPFL,MED_NOEUD,
     1               0,MED_NOPDT,"",0.0,MED_NONOR,cret)
      endif
      print *,'Ecriture du champ entier (2) : ',cret

C     ** Ecriture du champ entier n°2
C     ** - 3ere composante des éléments de valr2
C     ** - pas de pas de temps, ni de numero d'ordre
C     ** - pour des raisons de complétude des tests on change 
C     **   le type d'élément (aucun sens phys.))
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha2,valr2,MED_FULL_INTERLACE,nval2,
     1     ngauss2,3,MED_NOPFL,MED_FACE,
     1               MED_TRIA3,MED_NOPDT,"",0.0,MED_NONOR,cret)
      endif
      print *,'Ecriture du champ entier (3) : ',cret

C     ** Creation de profil
C     ** - selectionne les elements 1,3,5 du tableau valr2
      if (cret .eq. 0) then
	 call efpfle(fid,profil2,3,"profil2(champ2)",cret)
      endif
      print *,'Ecriture de profil n°2 : ',cret

C     ** Ecriture du champ entier n°2
C     ** - 3eme composante des éléments de valr2
C     ** - pas de pas de temps, ni de numero d'ordre
C     ** - profils 
C     ** - pour des raisons de complétude des tests on change 
C     **   le type d'élément (aucun sens phys.))
      if (cret .eq. 0) then
	 call efchae(fid,maa,nomcha2,valr2p,MED_FULL_INTERLACE,nval2,
     1     ngauss2,3,"profil2(champ2)",MED_MAILLE,
     1               MED_TRIA3,MED_NOPDT,"",0.0,MED_NONOR,cret)
      endif
      print *,'Ecriture du champ entier avec profil : ',cret

C     ** Fermeture du fichier *
 	call efferm (fid,cret)
	print *,'Fermeture du fichier : ', cret


	end 



