00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024         program test10
00025 
00026         implicit none
00027         include 'med.hf'
00028 
00029         integer      ret,fid,USER_INTERLACE,USER_MODE
00030         real*8       a,b,p1,p2,dt
00031 
00032         character*32 maa1,maa2,maa3
00033         character*13 lien_maa2
00034 
00035         character*32 nomcha1
00036         character*16 comp1(2), unit1(2)
00037         character*16 dtunit1, nounit
00038         integer      ncomp1
00039 
00040         integer      ngauss1_1
00041         character*32 gauss1_1
00042         real*8       refcoo1(12), gscoo1_1(12), wg1_1(6)
00043         integer      nval1_1
00044         real*8       valr1_1(1*6*2)
00045 
00046         integer      ngauss1_2
00047         character*32 gauss1_2
00048         real*8       gscoo1_2(6), wg1_2(3)
00049         integer      nval1_2
00050         real*8       valr1_2(2*3*2)
00051         real*8       valr1_2p(2*3)
00052 
00053         integer      ngauss1_3,nval1_3
00054         real*8       valr1_3(2*3*2)
00055         real*8       valr1_3p(2*2)
00056 
00057 
00058         character*32 nomcha2
00059         character*16 comp2(3), unit2(3)
00060         integer      ncomp2, nval2
00061         integer      valr2(5*3),   valr2p(3*3)
00062 
00063 
00064         character*32 nomprofil1
00065         integer      profil1(2) , profil2(3)
00066 
00067         parameter (USER_INTERLACE = MED_FULL_INTERLACE)
00068         parameter (USER_MODE = MED_COMPACT )
00069         parameter ( a=0.446948490915965D0, b=0.091576213509771D0    )
00070         parameter ( p1=0.11169079483905D0, p2=0.0549758718227661D0  )
00071 
00072         parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" )
00073         parameter ( lien_maa2= "./testfoo.med"                  )
00074 
00075         parameter ( nomcha1 = "champ reel" )
00076         parameter ( ncomp1 = 2 )
00077         parameter ( dtunit1 = "                ")
00078         parameter ( nounit  = "                ")
00079 
00080         parameter ( gauss1_1 = "Model n1" )
00081         parameter ( ngauss1_1 = 6 )
00082 
00083         parameter ( gauss1_2  = "Model n2" )
00084         parameter ( ngauss1_2 = 3 )
00085 
00086         parameter ( ngauss1_3 = 6 )
00087         parameter ( nval1_3 = 6 )
00088 
00089         parameter ( nomcha2="champ entier")
00090         parameter ( ncomp2 = 3, nval2= 5  )
00091 
00092         parameter ( nomprofil1  = "PROFIL(champ(1))" )
00093         
00094 
00095 
00096         data comp1 /"comp1", "comp2"/
00097         data unit1 /"unit1","unit2"/
00098 
00099         data nval1_1  / 1*6 /
00100         data refcoo1  / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0, 
00101      1                  0.0,-1.0, 0.0,0.0 / 
00102         data valr1_1  /  0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
00103      1                   20.0,21.0, 22.0,23.0/
00104 
00105         data valr1_2  / 0.0,1.0, 2.0,3.0, 10.0,11.0,
00106      1                  12.0,13.0, 20.0,21.0, 22.0,23.0 /
00107         data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
00108 
00109         data valr1_3  / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0, 
00110      1                  20.0,21.0, 22.0,23.0 /
00111         data valr1_3p / 2.0,3.0, 10.0,11.0   /
00112 
00113         data comp2 /"comp1", "comp2", "comp3"/
00114         data unit2 /"unit1","unit2", "unit3"/
00115         data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
00116         data valr2p / 0,1,2,           20,21,22,           40,41,42 /
00117 
00118         data profil1 /2,3/
00119         data profil2 /1,3,5/
00120         
00121         ret = 0
00122 
00123         gscoo1_1(1) =  2*b-1
00124         gscoo1_1(2) =  1-4*b
00125         gscoo1_1(3) =  2*b-1
00126         gscoo1_1(4) =  2*b-1
00127         gscoo1_1(5) =  1-4*b
00128         gscoo1_1(6) =  2*b-1
00129         gscoo1_1(7) =  1-4*a
00130         gscoo1_1(8) =  2*a-1
00131         gscoo1_1(9) =  2*a-1
00132         gscoo1_1(10) =  1-4*a
00133         gscoo1_1(11) =  2*a-1
00134         gscoo1_1(12) =  2*a-1
00135 
00136         wg1_1(1) =  4*p2
00137         wg1_1(2) =  4*p2
00138         wg1_1(3) =  4*p2
00139         wg1_1(4) =  4*p1
00140         wg1_1(5) =  4*p1
00141         wg1_1(6) =  4*p1
00142 
00143         nval1_2 = 2*3
00144         gscoo1_2(1) = -2.0D0/3
00145         gscoo1_2(2) =  1.0D0/3 
00146         gscoo1_2(3) = -2.0D0/3
00147         gscoo1_2(4) = -2.0D0/3
00148         gscoo1_2(5) =  1.0D0/3
00149         gscoo1_2(6) = -2.0D0/3
00150 
00151         wg1_2(1) =  2.0D0/3
00152         wg1_2(2) =  2.0D0/3
00153         wg1_2(3) =  2.0D0/3 
00154                    
00155 
00156         call efouvr(fid,'test10.med',MED_LECTURE_ECRITURE, ret)
00157         if (ret .ne. 0 ) then
00158            print *,'Erreur à l''ouverture du fichier  : ','test10.med'
00159            call efexit(-1)
00160         endif
00161         
00162 
00163         call efmaac(fid,maa1,3,MED_NON_STRUCTURE,
00164      1                 "Maillage vide",ret)
00165         if (ret .ne. 0 ) then
00166            print *,'Erreur à la création du maillage : ', maa1
00167            call efexit(-1)
00168         endif
00169              
00170 
00171         call efmaac(fid,maa3,3,MED_NON_STRUCTURE,
00172      1                 "Maillage vide",ret)
00173         if (ret .ne. 0 ) then
00174            print *,'Erreur à la création du maillage : ', maa3
00175            call efexit(-1)
00176         endif
00177              
00178 
00179 
00180         call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,ret)
00181         if (ret .ne. 0 ) then
00182            print *,'Erreur à la création du champ : ', nomcha1
00183            ret = -1
00184         endif
00185              
00186 
00187         call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,ret)
00188         if (ret .ne. 0 ) then
00189            print *,'Erreur à la création du champ : ', nomcha2
00190            ret = -1
00191         endif
00192  
00193 
00194         call efliee(fid,lien_maa2,maa2,ret)
00195         if (ret .ne. 0 ) then
00196            print *,'Erreur à la création du lien : ', lien_maa2
00197            ret = -1
00198         endif
00199  
00200 
00201         call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
00202      1               ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret)
00203         if (ret .ne. 0 ) then
00204            print *,'Erreur à la création du modèle n°1 : ', gauss1_1
00205            ret = -1
00206         endif
00207 
00208 
00209         call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
00210      1               ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret)
00211         if (ret .ne. 0 ) then
00212            print *,'Erreur à la création du modèle n°2 : ', gauss1_2
00213            ret = -1
00214         endif
00215 
00216         
00217 
00218 
00219 
00220         dt = 0.0D0
00221         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00222      1               gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
00223      2               MED_MAILLE,MED_TRIA6,
00224      3               MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
00225         if (ret .ne. 0 ) then
00226            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1'
00227            ret = -1
00228         endif
00229 
00230 
00231 
00232 
00233         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00234      1               gauss1_1,1,MED_NOPFL,MED_NO_PFLMOD,
00235      2               MED_MAILLE,MED_TRIA6,
00236      3               MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
00237         if (ret .ne. 0 ) then
00238            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2'
00239            ret = -1
00240         endif
00241          
00242 
00243 
00244 
00245 
00246 
00247         dt = 5.5D0
00248         call efchae(fid,maa2,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
00249      1               gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
00250      2               MED_MAILLE,MED_TRIA6,
00251      3               1,"ms",dt,MED_NONOR,ret)
00252         if (ret .ne. 0 ) then
00253            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3'
00254            ret = -1
00255         endif
00256 
00257 
00258 
00259 
00260 
00261 
00262         dt = 5.5D0
00263         call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00264      1               gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
00265      2               MED_MAILLE,MED_TRIA6,
00266      3               1,"ms",dt,MED_NONOR,ret)
00267         if (ret .ne. 0 ) then
00268            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4'
00269            ret = -1
00270         endif
00271 
00272       
00273 
00274 
00275 
00276 
00277 
00278         dt = 5.5D0
00279         call efchae(fid,maa3,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
00280      1               gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
00281      2               MED_MAILLE,MED_TRIA6,
00282      3               1,"ms",dt,2,ret)
00283         if (ret .ne. 0 ) then
00284            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5'
00285            ret = -1
00286         endif
00287     
00288 
00289 
00290         call efpfle(fid,profil1,1,nomprofil1,ret)
00291         if (ret .ne. 0 ) then
00292            print *,'Erreur à la création du profil : ', nomprofil1
00293            ret = -1
00294         endif
00295 
00296 
00297 
00298 
00299 
00300 
00301 
00302         dt = 5.6D0
00303         call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
00304      1               MED_NOGAUSS,MED_ALL,nomprofil1,USER_MODE,
00305      2               MED_MAILLE,MED_TRIA6,
00306      3               2,"ms",dt,2,ret)
00307         if (ret .ne. 0 ) then
00308            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6'
00309            ret = -1
00310         endif
00311 
00312 
00313 
00314 
00315 
00316 
00317         dt = 5.6D0
00318         call efchae(fid,maa2,nomcha1,valr1_2p,USER_INTERLACE,nval1_2,
00319      1               gauss1_2,MED_ALL,nomprofil1,USER_MODE,
00320      2               MED_MAILLE,MED_TRIA6,
00321      3               2,"ms",dt,2,ret)
00322         if (ret .ne. 0 ) then
00323            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7'
00324            ret = -1
00325         endif
00326 
00327 
00328 
00329 
00330 
00331 
00332 
00333         dt = 5.7D0
00334         call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
00335      1               MED_NOGAUSS,2,nomprofil1,USER_MODE,
00336      2               MED_MAILLE,MED_TRIA6,
00337      3               3,"ms",dt,2,ret)
00338         if (ret .ne. 0 ) then
00339            print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8'
00340            ret = -1
00341         endif
00342 
00343 
00344 
00345 
00346 
00347         dt = 0.0D0
00348         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00349      1     MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_ARETE,
00350      1               MED_SEG2,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00351         if (ret .ne. 0 ) then
00352            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1'
00353            ret = -1
00354         endif   
00355 
00356 
00357 
00358 
00359 
00360 
00361         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00362      1     MED_NOGAUSS,2,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD,
00363      1               0,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00364         if (ret .ne. 0 ) then
00365            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2'
00366            ret = -1
00367         endif   
00368 
00369 
00370 
00371 
00372 
00373 
00374 
00375         call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00376      1     MED_NOGAUSS,3,MED_NOPFL,MED_NO_PFLMOD,MED_FACE,
00377      1               MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00378         if (ret .ne. 0 ) then
00379            print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3'
00380            ret = -1
00381         endif   
00382 
00383 
00384 
00385         call efpfle(fid,profil2,3,"PROFIL(champ2)",ret)
00386         if (ret .ne. 0 ) then
00387            print *,'Erreur à l''écriture du profil : ',
00388      1              'profil2(champ2)'
00389            ret = -1
00390         endif   
00391 
00392 
00393 
00394 
00395 
00396 
00397 
00398 
00399         call efchae(fid,maa1,nomcha2,valr2p,USER_INTERLACE,nval2,
00400      1     MED_NOGAUSS,3,"PROFIL(champ2)",USER_MODE,MED_MAILLE,
00401      1               MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00402         if (ret .ne. 0 ) then
00403            print *,'Erreur à l''écriture du profil : ',
00404      1             'profil2(champ2)'
00405            ret = -1
00406         endif   
00407 
00408 
00409         call efferm (fid,ret)
00410         if (ret .ne. 0 ) then
00411            print *,'Erreur à la fermeture du fichier : '
00412            ret = -1
00413         endif   
00414 
00415         print *,"Le code retour : ",ret
00416         call efexit(ret)
00417 
00418         end 
00419 
00420 
00421