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