| 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 | |
|---|
| 22 | c 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 | |
|---|
| 62 | c 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 | |
|---|
| 67 | c 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 | |
|---|
| 117 | 1000 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 |
|---|
