!
! $Header$
!
      subroutine inigrads(if,im
     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
     s  ,dt,file,titlel)


      implicit none

      integer if,im,jm,lm,i,j,l,lnblnk
      real x(im),y(jm),z(lm),fx,fy,fz,dt
      real xmin,xmax,ymin,ymax

      character file*10,titlel*40

#include "gradsdef.h"

c     data unit/66,32,34,36,38,40,42,44,46,48/
      integer nf
      save nf
      data nf/0/

      unit(1)=66
      unit(2)=32
      unit(3)=34
      unit(4)=36
      unit(5)=38
      unit(6)=40
      unit(7)=42
      unit(8)=44
      unit(9)=46

      if (if.le.nf) stop'verifier les appels a inigrads'

      print*,'Entree dans inigrads'

      nf=if
      title(if)=titlel
      ivar(if)=0

      fichier(if)=file(1:lnblnk(file))

      firsttime(if)=.true.
      dtime(if)=dt

      iid(if)=1
      ifd(if)=im
      imd(if)=im
      do i=1,im
         xd(i,if)=x(i)*fx
         if(xd(i,if).lt.xmin) iid(if)=i+1
         if(xd(i,if).le.xmax) ifd(if)=i
      enddo
      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'

      jid(if)=1
      jfd(if)=jm
      jmd(if)=jm
      do j=1,jm
         yd(j,if)=y(j)*fy
         if(yd(j,if).gt.ymax) jid(if)=j+1
         if(yd(j,if).ge.ymin) jfd(if)=j
      enddo
      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'

      print*,'Open de dat'
      print*,'file=',file
      print*,'fichier(if)=',fichier(if)

      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
      print*,file(1:lnblnk(file))//'.dat'

      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat'
     s   ,FORM='unformatted',
     s   ACCESS='direct'
     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))

      print*,'Open de dat ok'

      lmd(if)=lm
      do l=1,lm
         zd(l,if)=z(l)*fz
      enddo

      irec(if)=0

      print*,if,imd(if),jmd(if),lmd(if)
      print*,'if,imd(if),jmd(if),lmd(if)'

      return
      end
!
! $Header$
!
      INTEGER FUNCTION lnblnk (letter)

C--------------------------------------------------------
C Fonction qui determine la longeur d'un string sans les
C blancs qui suivent. Le critere pour determiner la fin du
C string est, trois blancs de suite
C---------------------------------------------------------
C     ARGUMENTS
C     +++++++++
C     letter: CHARACTER*xxx (xxx < imax)
C             le string dont on determine la longuer
C     lnblnk: INTEGER
C             le nombre de characteres
C
C     PARAMETER
C     +++++++++
C     imax : INTEGER
C            le nombre maximale de character que peut contenir le string
C            a traiter

      IMPLICIT NONE
      INTEGER i,imax
      PARAMETER (imax = 256)
      CHARACTER*256 letter

      i=0

10    i=i+1
      IF (letter(i:i+3) . EQ . '   ') GOTO 20
      GOTO 10

20    lnblnk=i-1

      RETURN
      END

!
! $Header$
!
      subroutine formcoord(unit,n,x,a,rev,text)
      implicit none
      integer n,unit,ndec
      logical rev
      real x(n),a
      character*4 text

      integer i,id,i1,i2,in
      real dx,dxmin

      if(rev) then
         id=-1
         i1=n
         i2=n-1
         in=1
         write(unit,3000) text(1:1)
      else
         id=1
         i1=1
         i2=2
         in=n
      endif

      if (n.lt.2) then
         ndec=1
         write(unit,1000) text,n,x(1)*a
      else
         dxmin=abs(x(2)-x(1))
         do i=2,n-1
            dx=abs(x(i+1)-x(i))
            if (dx.lt.dxmin) dxmin=dx
         enddo

         ndec=-log10(dxmin)+2
         if(mod(n,6).eq.1) then
            write(unit,1000) text,n,x(i1)*a
            write(unit,2000) (x(i)*a,i=i2,in,id)
         else
            write(unit,1000) text,n
            write(unit,2000) (x(i)*a,i=i1,in,id)
         endif
      endif

1000  format(a4,2x,i4,' LEVELS',43x,f12.2)
2000  format(6f12.2)
c1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
c2000  format(6f12.<ndec>)
3000  format('FORMAT ',a1,'REV')
      return

      end
