1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 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 : test20.f 21 C * 22 C * - Description : montage/demontage de fichiers MED. 23 C * 24 C ****************************************************************************** 25 program test20 26 C 27 implicit none 28 include 'med.hf' 29 C 30 C 31 integer cret, fid, ncha, nmaa, mid, mid2 32 integer i, ncomp, type 33 character*16 comp(3), unit(3) 34 character*32 nom 35 C 36 C ** Ouverture du fichier test2.med en mode lecture ajout 37 call efouvr(fid,'test2.med',MED_LECTURE_AJOUT, cret) 38 print *,cret 39 print *,'On ouvre le fichier test2.med' 40 C 41 C ** Lecture du nombre de champ 42 if (cret .eq. 0) then 43 call efncha(fid,0,ncha,cret) 44 print *,cret 45 print *,'Nombre de champs dans test2.med : ',ncha 46 endif 47 C 48 C ** Montage du fichier test10.med (acces aux champs) 49 if (cret .eq. 0) then 50 call efmont(fid,'test10.med',MED_CHAMP,mid,cret) 51 print *,cret 52 print *,'On monte les champs du fichier test10.med' 53 endif 54 C 55 C ** Lecture du nombre de champ apres montage 56 if (cret .eq. 0) then 57 call efncha(fid,0,ncha,cret) 58 print *,cret 59 print *,'Nombre de champs dans test2.med apres montage : ',ncha 60 endif 61 C 62 C ** Acces a tous les champs de test10.med a travers le point de 63 C ** montage 64 if (cret .eq. 0) then 65 C 66 do 10 i = 1,ncha 67 C 68 C ** Lecture du nombre de composante dans le champ 69 if (cret .eq. 0) then 70 call efncha(fid,i,ncomp,cret) 71 print *,cret 72 endif 73 C 74 C ** Lecture des informations sur le champ 75 if (cret .eq. 0) then 76 call efchai(fid,i,nom,type,comp,unit,ncomp,cret) 77 print *,cret 78 print *,'Champ de nom ',nom 79 print *,' avec ', ncomp, ' composantes' 80 endif 81 10 continue 82 C 83 end if 84 C 85 C ** Demontage de test10.med 86 if (cret .eq. 0) then 87 call efdemo(fid,mid,MED_CHAMP,cret) 88 print *,cret 89 print *,'On demonte le fichier test10.med' 90 endif 91 C 92 C ** Lecture du nombre de champ apres demontage 93 if (cret .eq. 0) then 94 call efncha(fid,0,ncha,cret) 95 print *,cret 96 print *,'Nombre de champs apres demontage : ',ncha 97 endif 98 C 99 C ** Fermeture du fichier 100 call efferm(fid,cret) 101 print *, cret 102 print *,'On ferme le fichier test2.med' 103 C 104 C ** Creation du fichier test20.med 105 call efouvr(fid,'test20.med',MED_CREATION,cret) 106 print *,cret 107 print *,'Creation du fichier test20.med' 108 C 109 C ** Montage du fichier test2.med (acces aux maillages) 110 if (cret .eq. 0) then 111 call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret) 112 print *,cret 113 print *,'On monte le fichier test2.med' 114 endif 115 C 116 C ** Lecture du nombre de maillage apres montage 117 if (cret .eq. 0) then 118 call efnmaa(fid,nmaa,cret) 119 print *,cret 120 print *,'Nombre de maillages apres montage : ', nmaa 121 endif 122 C 123 C ** Montage du fichier test10.med (acces aux champs) 124 if (cret .eq. 0) then 125 call efmont(fid,'test10.med',MED_CHAMP,mid2,cret) 126 print *,cret 127 print *,'On monte le fichier test10.med' 128 endif 129 C 130 C ** Lecture du nombre de champs apres montage 131 if (cret .eq. 0) then 132 call efncha(fid,0,ncha,cret) 133 print *,cret 134 print *,'Nombre de champs apres montage : ',ncha 135 endif 136 C 137 C ** Demontage de test10.med 138 if (cret .eq. 0) then 139 call efdemo(fid,mid2,MED_CHAMP,cret) 140 print *,cret 141 print *,'On demonte test10.med' 142 endif 143 C 144 C ** Demontage de test2.med 145 if (cret .eq. 0) then 146 call efdemo(fid,mid,MED_MAILLAGE,cret) 147 print *,cret 148 print *,'On demonte test2.med' 149 endif 150 C 151 C ** Fermeture du fichier 152 call efferm(fid,cret) 153 print *,cret 154 print *,'Fermeture du fichier test20.med' 155 C 156 end 157 C