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 : 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 if (cret .ne. 0 ) then 40 print *,'Erreur ouverture du fichier' 41 call efexit(-1) 42 endif 43 print *,'On ouvre le fichier test2.med' 44 C 45 C ** Lecture du nombre de champ 46 call efncha(fid,0,ncha,cret) 47 print *,cret 48 if (cret .ne. 0 ) then 49 print *,'Erreur lecture du nombre de champ' 50 call efexit(-1) 51 endif 52 print *,'Nombre de champs dans test2.med : ',ncha 53 C 54 C ** Montage du fichier test10.med (acces aux champs) 55 call efmont(fid,'test10.med',MED_CHAMP,mid,cret) 56 print *,cret 57 if (cret .ne. 0 ) then 58 print *,'Erreur montage du fichier' 59 call efexit(-1) 60 endif 61 print *,'On monte les champs du fichier test10.med' 62 C 63 C ** Lecture du nombre de champ apres montage 64 call efncha(fid,0,ncha,cret) 65 print *,cret 66 if (cret .ne. 0 ) then 67 print *,'Erreur lecture du nombre de champ' 68 call efexit(-1) 69 endif 70 print *,'Nombre de champs dans test2.med apres montage : ',ncha 71 C 72 C ** Acces a tous les champs de test10.med a travers le point de 73 C ** montage 74 C 75 do 10 i = 1,ncha 76 C 77 C ** Lecture du nombre de composante dans le champ 78 call efncha(fid,i,ncomp,cret) 79 print *,cret 80 if (cret .ne. 0 ) then 81 print *,'Erreur lecture du nombre de composante' 82 call efexit(-1) 83 endif 84 C 85 C ** Lecture des informations sur le champ 86 call efchai(fid,i,nom,type,comp,unit,ncomp,cret) 87 print *,cret 88 if (cret .ne. 0 ) then 89 print *,'Erreur lecture des infos sur le champ' 90 call efexit(-1) 91 endif 92 print *,'Champ de nom ',nom 93 print *,' avec ', ncomp, ' composantes' 94 C 95 10 continue 96 C 97 C 98 C ** Demontage de test10.med 99 call efdemo(fid,mid,MED_CHAMP,cret) 100 print *,cret 101 if (cret .ne. 0 ) then 102 print *,'Erreur demontage du fichier' 103 call efexit(-1) 104 endif 105 print *,'On demonte le fichier test10.med' 106 C 107 C ** Lecture du nombre de champ apres demontage 108 call efncha(fid,0,ncha,cret) 109 print *,cret 110 if (cret .ne. 0 ) then 111 print *,'Erreur lecture du nombre de champ' 112 call efexit(-1) 113 endif 114 print *,'Nombre de champs apres demontage : ',ncha 115 C 116 C ** Fermeture du fichier 117 call efferm(fid,cret) 118 print *, cret 119 if (cret .ne. 0 ) then 120 print *,'Erreur fermeture du fichier' 121 call efexit(-1) 122 endif 123 print *,'On ferme le fichier test2.med' 124 C 125 C ** Creation du fichier test20.med 126 call efouvr(fid,'test20.med',MED_LECTURE_ECRITURE,cret) 127 print *,cret 128 if (cret .ne. 0 ) then 129 print *,'Erreur creation du fichier' 130 call efexit(-1) 131 endif 132 print *,'Creation du fichier test20.med' 133 C 134 C ** Montage du fichier test2.med (acces aux maillages) 135 call efmont(fid,'test2.med',MED_MAILLAGE,mid,cret) 136 print *,cret 137 if (cret .ne. 0 ) then 138 print *,'Erreur montage du fichier' 139 call efexit(-1) 140 endif 141 print *,'On monte le fichier test2.med' 142 C 143 C ** Lecture du nombre de maillage apres montage 144 call efnmaa(fid,nmaa,cret) 145 print *,cret 146 if (cret .ne. 0 ) then 147 print *,'Erreur lecture du nombre de maillage' 148 call efexit(-1) 149 endif 150 print *,'Nombre de maillage apres montage : ', nmaa 151 C 152 C ** Montage du fichier test10.med (acces aux champs) 153 call efmont(fid,'test10.med',MED_CHAMP,mid2,cret) 154 print *,cret 155 if (cret .ne. 0 ) then 156 print *,'Erreur montage du fichier' 157 call efexit(-1) 158 endif 159 print *,'On monte le fichier test10.med' 160 C 161 C ** Lecture du nombre de champs apres montage 162 call efncha(fid,0,ncha,cret) 163 print *,cret 164 if (cret .ne. 0 ) then 165 print *,'Erreur lecture du nombre de champ' 166 call efexit(-1) 167 endif 168 print *,'Nombre de champ apres montage : ',ncha 169 C 170 C ** Demontage de test10.med 171 call efdemo(fid,mid2,MED_CHAMP,cret) 172 print *,cret 173 if (cret .ne. 0 ) then 174 print *,'Erreur demontage du fichier' 175 call efexit(-1) 176 endif 177 print *,'On demonte test10.med' 178 C 179 C ** Demontage de test2.med 180 call efdemo(fid,mid,MED_MAILLAGE,cret) 181 print *,cret 182 if (cret .ne. 0 ) then 183 print *,'Erreur demontage du fichier' 184 call efexit(-1) 185 endif 186 print *,'On demonte test2.med' 187 C 188 C ** Fermeture du fichier 189 call efferm(fid,cret) 190 print *,cret 191 if (cret .ne. 0 ) then 192 print *,'Erreur fermeture du fichier' 193 call efexit(-1) 194 endif 195 print *,'Fermeture du fichier test20.med' 196 C 197 end 198 C