source: LMDZ.3.3/branches/rel-LF/libf/dyn3d/bin2grads56.F @ 403

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