source: LMDZ.3.3/trunk/libf/dyn3d/bin2grads56.F @ 2

      PROGRAM avarlect
      implicit none
#include "dimensions.h"
#include "paramet.h"
#include "stations56.h"

      integer jour0,im,jm,nq,nday,j1,j2,delai,iexplo,nexplo,nqs
       integer iqs,ierr
      integer iday,irec,i,j,iq,nfichiers

      real longitude(iip1),latitude(jjp1),pi

      real q(iip1,jjp1,nqmx),qsum(iip1,jjp1,nqmx)
      real qtot(iip1,jjp1),qsumtot(iip1,jjp1)
      logical qlogic(iip1,jjp1,nqmx)

      integer ilec(30),indice_st(nqmx)

      integer lstr,lnblnk
      character*3 strj
      character*5 str5

c   Lecture eventuelle d'une liste de stations
      open(99,file='stations.def',form='formatted',status='old'
     s   ,iostat=ierr)
      if(ierr.eq.0) then
         read(99,*) nqs
         read(99,*) (indice_st(iq),iq=1,nqs)
         close(99)
      else
         print*,'On utilise les 79 stations du reseau'
         nqs=56
         do iq=1,nqs
            indice_st(iq)=iq
         enddo
      endif
      if(nqs.gt.nqmx) stop'surdimensioner nqmx'

      str5='     '
      pi=2.*asin(1.)
      irec=0

      print*,'Nom du fichier '
      read(*,'(a3)') strj
      if(strj(3:3).eq." ") then
         lstr=2
      else
         lstr=3
      endif
      print*,'Longueur de la chaine de caracteres'
      print*,lstr

      open(10,file=strj(1:lstr)//'.dat',status='new'
     s ,form='unformatted',access='direct',recl=4*iip1*jjp1)
      open(11,file=strj(1:lstr)//'.ctl'
     s ,status='unknown',form='formatted')


      do i=1,30
         ilec(i)=0
      enddo

c   Ouverture des fichiers qj
         open(20,file=strj(1:lstr),form='unformatted',status='old')
         read(20) im,jm,nq,nday,longitude,latitude
         print*,im,jm,nq,nday,'   ',strj(1:lstr)

c   lecture pour rien
         do iday=1,nday
            call readbin(20,iip1*jjp1*nq,qlogic)
            ilec(jour0)=ilec(jour0)+1
            do iq=1,nq
               do j=1,jjp1
                  do i=1,iip1
                     if(qlogic(i,j,iq)) then
                        qtot(i,j)=1.
                     else
                        qtot(i,j)=0.
                     endif
                  enddo
               enddo
               write(10,rec=(iday-1)*nq+iq) qtot
            enddo
         enddo

      do i=1,iip1
        longitude(i)=longitude(i)*180./pi
      enddo

      do j=1,jjp1
         latitude(j)=latitude(j)*180./pi
      enddo

      write(11,'(a4,2x,a40)')
     &       'DSET ','^'//strj(1:lstr)//'.dat'
 
      write(11,'(a12)') 'UNDEF 1.0E30'
      write(11,'(a5,1x,a40)') 'TITLE ','Titre a voir'
      call formcoord(11,iip1,longitude,1.,.false.,'XDEF')
      call formcoord(11,jjp1,latitude,1.,.true.,'YDEF')
      call formcoord(11,1,0.,1.,.false.,'ZDEF')
      write(11,'(a4,i10,a30)')
     &       'TDEF ',nday,' LINEAR 02JAN1987 1DY '
      write(11,'(a4,2x,i5)') 'VARS',nq
      do iqs=1,nqs
         iq=i56(iqs)
         if(iq.lt.10) then
            write(str5(1:1),'(i1.1)') iq
         else
            write(str5(1:2),'(i2.2)') iq
         endif
         PRINT*,'iqs,i56,iq,str5',iqs,i56(iqs),iq,str5
         write(11,1000) 'q'//str5,0,99,'Traceurs '//str5
      enddo
      write(11,'(a7)') 'ENDVARS'

      close(10)

1000  format(a5,3x,i4,i3,x,a39)


 300  FORMAT('1'/15x'run du pas'i7,2x,'au pas'i7,2x,  'c"est a dire du
     * jour'i7,3x'au jour'i7//)

      end