source: LMDZ.3.3/trunk/libf/dyn3d/bin2grads.F @ 545

Last change on this file since 545 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
RevLine 
[2]1      PROGRAM avarlect
2      implicit none
3#include "dimensions.h"
4#include "paramet.h"
5
6      integer jour0,im,jm,nq,nday,j1,j2,delai,iexplo,nexplo,nqs
7       integer iqs,ierr
8      integer iday,irec,i,j,iq,nfichiers
9
10      real longitude(iip1),latitude(jjp1),pi
11
12      real q(iip1,jjp1,nqmx),qsum(iip1,jjp1,nqmx)
13      real qtot(iip1,jjp1),qsumtot(iip1,jjp1)
14      logical qlogic(iip1,jjp1,nqmx)
15
16      integer ilec(30),indice_st(nqmx)
17
18      integer lstr,lnblnk
19      character*3 strj
20      character*5 str5
21
22c   Lecture eventuelle d'une liste de stations
23      open(99,file='stations.def',form='formatted',status='old'
24     s   ,iostat=ierr)
25      if(ierr.eq.0) then
26         read(99,*) nqs
27         read(99,*) (indice_st(iq),iq=1,nqs)
28         close(99)
29      else
30         print*,'On utilise les 80 stations du reseau'
31         nqs=80
32         do iq=1,nqs
33            indice_st(iq)=iq
34         enddo
35      endif
36      if(nqs.gt.nqmx) stop'surdimensioner nqmx'
37
38      str5='     '
39      pi=2.*asin(1.)
40      irec=0
41
42      print*,'Nom du fichier '
43      read(*,'(a3)') strj
44      if(strj(3:3).eq." ") then
45         lstr=2
46      else
47         lstr=3
48      endif
49      print*,'Longueur de la chaine de caracteres'
50      print*,lstr
51
52      open(10,file=strj(1:lstr)//'.dat',status='new'
53     s ,form='unformatted',access='direct',recl=4*iip1*jjp1)
54      open(11,file=strj(1:lstr)//'.ctl'
55     s ,status='unknown',form='formatted')
56
57
58      do i=1,30
59         ilec(i)=0
60      enddo
61
62c   Ouverture des fichiers qj
63         open(20,file=strj(1:lstr),form='unformatted',status='old')
64         read(20) im,jm,nq,nday,longitude,latitude
65         print*,im,jm,nq,nday,'   ',strj(1:lstr)
66
67c   lecture pour rien
68         do iday=1,nday
69            call readbin(20,iip1*jjp1*nq,qlogic)
70            ilec(jour0)=ilec(jour0)+1
71            do iq=1,max(nq,80)
72               do j=1,jjp1
73                  do i=1,iip1
74                     if(qlogic(i,j,iq)) then
75                        qtot(i,j)=1.
76                     else
77                        qtot(i,j)=0.
78                     endif
79                  enddo
80               enddo
81               write(10,rec=(iday-1)*nq+iq) qtot
82            enddo
83         enddo
84
85      do i=1,iip1
86        longitude(i)=longitude(i)*180./pi
87      enddo
88
89      do j=1,jjp1
90         latitude(j)=latitude(j)*180./pi
91      enddo
92
93      write(11,'(a4,2x,a40)')
94     &       'DSET ','^'//strj(1:lstr)//'.dat'
95 
96      write(11,'(a12)') 'UNDEF 1.0E30'
97      write(11,'(a5,1x,a40)') 'TITLE ','Titre a voir'
98      call formcoord(11,iip1,longitude,1.,.false.,'XDEF')
99      call formcoord(11,jjp1,latitude,1.,.true.,'YDEF')
100      call formcoord(11,1,0.,1.,.false.,'ZDEF')
101      write(11,'(a4,i10,a30)')
102     &       'TDEF ',nday,' LINEAR 02JAN1987 1DY '
103      write(11,'(a4,2x,i5)') 'VARS',max(nq,80)
104      do iqs=1,nqs
105         iq=iqs
106         if(iq.lt.10) then
107            write(str5(1:1),'(i1.1)') iq
108         else
109            write(str5(1:2),'(i2.2)') iq
110         endif
111         write(11,1000) 'q'//str5,0,99,'Traceurs '//str5
112      enddo
113      write(11,'(a7)') 'ENDVARS'
114
115      close(10)
116
1171000  format(a5,3x,i4,i3,x,a39)
118
119
120 300  FORMAT('1'/15x'run du pas'i7,2x,'au pas'i7,2x,  'c"est a dire du
121     * jour'i7,3x'au jour'i7//)
122
123      end
Note: See TracBrowser for help on using the repository browser.