resf.f

Aller à la documentation de ce fichier.
00001 C*  This file is part of MED.
00002 C*
00003 C*  COPYRIGHT (C) 1999 - 2011  EDF R&D, CEA/DEN
00004 C*  MED is free software: you can redistribute it and/or modify
00005 C*  it under the terms of the GNU Lesser General Public License as published by
00006 C*  the Free Software Foundation, either version 3 of the License, or
00007 C*  (at your option) any later version.
00008 C*
00009 C*  MED is distributed in the hope that it will be useful,
00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 C*  GNU Lesser General Public License for more details.
00013 C*
00014 C*  You should have received a copy of the GNU Lesser General Public License
00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 C*
00017 
00018       subroutine efchac(fid,cha,type,comp,unit,ncomp,cret)
00019 c
00020       implicit none
00021       save
00022 c      
00023       character *(*) cha,comp,unit
00024       integer fid, ncomp, cret, type
00025       integer edfchac
00026 c
00027       cret = edfchac (fid, cha,len(cha),type, comp,16*ncomp,
00028      1     unit, 16*ncomp, ncomp)
00029 c      
00030       return
00031       end
00032 c
00033 c
00034 c
00035       subroutine efchae(fid,maa,cha,val,interlace,n,locname,numco,
00036      1                  profil,pflmod,typent,typgeo,numdt,dtunit,
00037      1                  dt,numo,cret)
00038 c
00039       implicit none
00040       save
00041 c      
00042       character *(*) cha,maa,profil,locname
00043       character*(*) dtunit
00044       integer fid,val(*)
00045       integer n,pflmod,typent,typgeo,cret
00046       integer interlace,numco,numdt,numo
00047       real*8 dt
00048       integer edfchae
00049 c
00050       cret = edfchae(fid,maa,len(maa),cha,len(cha),val,
00051      1     interlace,n,locname,len(locname),numco,
00052      1     profil,len(profil),pflmod,
00053      1     typent,typgeo,numdt,dtunit,len(dtunit),
00054      1     dt,numo)
00055 c      
00056       return
00057       end
00058 c
00059 c     Ecriture des champs en differenciant ENTIERS et REELS
00060 c
00061       subroutine efchie(fid,maa,cha,val,interlace,n,locname,numco,
00062      1                  profil,pflmod,typent,typgeo,numdt,dtunit,
00063      1                  dt,numo,cret)
00064 c
00065       implicit none
00066       save
00067 c      
00068       character *(*) cha,maa,profil,locname
00069       character*(*) dtunit
00070       integer fid,val(*),n,pflmod,typent,typgeo,cret
00071       integer interlace,numco,numdt,numo
00072       real*8 dt
00073       integer edfchae
00074 c
00075       cret = edfchae(fid,maa,len(maa),cha,len(cha),val,
00076      1     interlace,n,locname,len(locname),numco,
00077      1     profil,len(profil),pflmod,
00078      1     typent,typgeo,numdt,dtunit,len(dtunit),
00079      1     dt,numo)
00080 c      
00081       return
00082       end
00083 c
00084 c    
00085 c     
00086       subroutine efchre(fid,maa,cha,val,interlace,n,locname,numco,
00087      1                  profil,pflmod,typent,typgeo,numdt,dtunit,
00088      1                  dt,numo,cret)
00089 c
00090       implicit none
00091       save
00092 c      
00093       character *(*) cha,maa,profil,locname
00094       character*(*) dtunit
00095       integer fid,n,pflmod,typent,typgeo,cret
00096       integer interlace,numco,numdt,numo
00097       real*8 dt
00098       real*8 val(*)
00099       integer edfchae
00100 c
00101       cret = edfchae(fid,maa,len(maa),cha,len(cha),val,
00102      1     interlace,n,locname,len(locname),numco,
00103      1     profil,len(profil),pflmod,
00104      1     typent,typgeo,numdt,dtunit,len(dtunit),
00105      1     dt,numo)
00106 c      
00107       return
00108       end
00109 c
00110 c
00111 c
00112       subroutine efchal(fid,maa,cha,val,
00113      1                  interlace,numco,locname,
00114      1                  profil,pflmod,
00115      1                  typent,typgeo,
00116      1                  numdt, numo,cret)
00117 c
00118       implicit none
00119       save
00120 c      
00121       character *(*) cha,maa,locname,profil
00122       integer fid,val(*),pflmod,typent,typgeo,cret
00123       integer interlace,numco,numdt,numo
00124       integer edfchal
00125 c
00126       cret = edfchal(fid,maa,len(maa),cha,len(cha),val,
00127      1     interlace,numco,locname,profil,pflmod,
00128      1     typent,typgeo,numdt,numo)
00129 c      
00130       return
00131       end
00132 c      
00133 c
00134 c     Lecture des champs en distinguant les reels et les entiers
00135 c     
00136       subroutine efchil(fid,maa,cha,val,
00137      1                  interlace,numco,locname,
00138      1                  profil,pflmod,
00139      1                  typent,typgeo,
00140      1                  numdt, numo,cret)
00141 c
00142       implicit none
00143       save
00144 c      
00145       character *(*) cha,maa,locname,profil
00146       integer fid,val(*),typent,typgeo,cret,pflmod
00147       integer interlace,numco,numdt,numo
00148       integer edfchal
00149 c
00150       cret = edfchal(fid,maa,len(maa),cha,len(cha),val,
00151      1     interlace,numco,locname,profil,pflmod,
00152      1     typent,typgeo,numdt,numo)
00153 c      
00154       return
00155       end
00156 c
00157 c
00158 c
00159       subroutine efchrl(fid,maa,cha,val,
00160      1                  interlace,numco,locname,profil,pflmod,
00161      1                  typent,typgeo,
00162      1                  numdt, numo,cret)
00163 c
00164       implicit none
00165       save
00166 c      
00167       character *(*) cha,maa,locname,profil
00168       integer fid,typent,typgeo,cret
00169       integer interlace,numco,numdt,numo,pflmod
00170       integer edfchal
00171       real*8 val(*)
00172 c
00173       cret = edfchal(fid,maa,len(maa),cha,len(cha),val,
00174      1     interlace,numco,locname,profil,pflmod,
00175      1     typent,typgeo,numdt,numo)
00176 c      
00177       return
00178       end
00179 c
00180 c
00181 c
00182       subroutine efchai(fid,ind,cha,type,comp,unit,ncomp,cret)
00183 c
00184       implicit none
00185       save
00186 c      
00187       character *(*) cha,comp,unit
00188       integer fid,ind,type,ncomp,cret
00189       integer edfchai
00190 c
00191       cret = edfchai(fid,ind,cha,type,
00192      1     comp,unit,ncomp)
00193 c      
00194       return
00195       end
00196 c
00197       subroutine efncha(fid,ind,n,cret)
00198 c
00199       implicit none
00200       save
00201 c      
00202       integer fid,ind,cret,n
00203       integer edfncha
00204 c
00205       n = edfncha(fid,ind)
00206       if (n.lt.0) then
00207          cret = -1
00208       else
00209          cret = 0
00210       endif
00211 c
00212       return
00213       end
00214 c
00215 
00216       subroutine efnval(fid,cha,typent,typgeo,numdt,numo,maa,pflmod,
00217      1     n,cret)
00218 c
00219       implicit none
00220       save
00221 c      
00222       integer fid,typent,typgeo,n,cret
00223       integer numdt, numo, pflmod
00224       character *(*) cha, maa
00225       integer edfnval
00226 c
00227       n = edfnval(fid,cha,len(cha),typent,typgeo,
00228      1            numdt,numo,maa,len(maa),pflmod)
00229       if (n.lt.0) then
00230          cret = -1
00231       else
00232          cret = 0
00233       endif
00234 c
00235       return
00236       end
00237 c
00238 
00239 C Nouvelles routines pour MED V2.1
00240 
00241 
00242       subroutine efnpdt(fid,cha,type,geo,n,cret)
00243 c
00244       implicit none
00245       save
00246 c      
00247       integer fid,type,geo,n,cret
00248       character*32 cha
00249       integer edfnpdt
00250 c
00251       n = edfnpdt(fid,cha,len(cha),type,geo)
00252 c
00253       if (n.lt.0) then
00254          cret = -1
00255       else
00256          cret = 0
00257       endif
00258 c
00259       return
00260       end
00261 c
00262 
00263       subroutine efpdti(fid,cha,typent,typgeo,ind,ngauss,
00264      1                  numdt,numo,dtunit,dt,maa,local,nmaa,cret)
00265 c
00266       implicit none
00267       save
00268 c      
00269       integer fid,typent,typgeo,ind,ngauss,numdt,numo,nmaa,cret
00270       character*32 cha,maa
00271       character*16 dtunit
00272       real*8 dt
00273       logical local
00274       integer edfpdti
00275 c
00276       cret = edfpdti(fid,cha,len(cha),typent,typgeo,ind,
00277      1               ngauss,numdt,numo,dtunit,dt,maa,local,nmaa)
00278 c
00279       return
00280       end
00281 c
00282 c     NOUVELLE ROUTINE MED2.2
00283 
00284       subroutine efnref(fid,cha,typent,typgeo,numdt,numo,n,cret)
00285 c
00286       implicit none
00287       save
00288 c
00289       integer fid,typent,typgeo,n,cret
00290       integer numdt, numo
00291       character *(*) cha
00292       integer edfnref
00293 
00294       n = edfnref(fid,cha,len(cha),typent,typgeo,
00295      1            numdt,numo)
00296 
00297       if (n.lt.0) then
00298          cret = -1
00299       else
00300          cret = 0
00301       endif
00302 c
00303       return
00304       end
00305 c
00306 
00307       subroutine efrefi(fid,cha, typent, typgeo, indice, numdt, numo,
00308      1                  maa, local, ngauss, cret)
00309 c
00310       implicit none
00311       save
00312 c
00313       integer fid,typent,typgeo,indice,n,cret
00314       integer numdt, numo, ngauss
00315       character *(*) cha, maa
00316       logical local
00317       integer edfrefi
00318 
00319       n = edfrefi(fid,cha,len(cha),typent,typgeo,indice,
00320      1            numdt,numo,maa,local,ngauss)
00321 
00322       if (n.lt.0) then
00323          cret = -1
00324       else
00325          cret = 0
00326       endif
00327 c
00328       return
00329       end
00330 c
00331 
00332       subroutine efliee(fid,lienval,maa,cret)
00333       integer fid,cret
00334       character *(*) lienval, maa
00335       integer   edfliee
00336 
00337 c     
00338       cret = edfliee(fid,lienval,len(lienval),maa,len(maa))
00339 c     
00340       return
00341       end
00342 c
00343 
00344 
00345       subroutine efnlie(fid,n,cret)
00346 c
00347       implicit none
00348       save
00349 c      
00350       integer fid,cret,n
00351       integer edfnlie
00352 c
00353       n = edfnlie(fid)
00354 c
00355       if (n.lt.0) then
00356          cret = -1
00357       else
00358          cret = 0
00359       endif
00360 c
00361       return
00362       end
00363 
00364       subroutine efliei( fid , indice , maa , n , cret)
00365 c
00366       implicit none
00367       save
00368 c
00369       integer fid,n,cret,indice
00370       character *(*) maa
00371       integer edfliei
00372 c
00373       maa = ' ' 
00374 c
00375       cret = edfliei (fid,indice,maa,n)
00376 c     
00377       return
00378       end
00379 
00380       subroutine efnvli(fid,maa,n,cret)
00381 c
00382       implicit none
00383       save
00384 c      
00385       integer fid,cret,n
00386       character *(*) maa
00387       integer edfnvli
00388 c
00389       n = edfnvli(fid,maa,len(maa))
00390 c
00391       if (n.lt.0) then
00392          cret = -1
00393       else
00394          cret = 0
00395       endif
00396 c
00397       return
00398       end
00399 c
00400 
00401       subroutine efliel(fid,lienval,n,maa,cret)
00402 c
00403       implicit none
00404       save
00405 c      
00406       integer fid,n,cret
00407       character *(*) maa,lienval
00408       integer edfliel
00409 c
00410       cret = edfliel(fid,lienval,n,maa,len(maa))
00411 c     
00412       return
00413       end
00414 c
00415 

Généré le Mon May 16 17:10:23 2011 pour MED fichier par  doxygen 1.6.1