| 1 | !------------------------------------------------ |
|---|
| 2 | ! extract_iii |
|---|
| 3 | ! |
|---|
| 4 | ! Usage: |
|---|
| 5 | ! extract_iii FlagCarto FlagHeader Lati Long DataFile ResuFile Mot1 ... MotN |
|---|
| 6 | ! |
|---|
| 7 | ! FlagCarto = 'TRUE'/'false' = genere des sorties au format carto |
|---|
| 8 | ! FlagHeader = 'TRUE'/'false' = genere un header pour DataFile |
|---|
| 9 | ! Lati = bornes en latitude (latmin,latmax) |
|---|
| 10 | ! Long = bornes en longitude (lonmin,lonmax) |
|---|
| 11 | ! Indtm = indice terre/mer (0=mer,1=terre, 2=mer+terre) |
|---|
| 12 | ! Indjn = indice jour+nuit (0=nuit,1=jour, 2=nuit+jour) |
|---|
| 13 | ! DataFile = fichier contenant la liste des donnees |
|---|
| 14 | ! ResuFile = fichier resultat (longueur=9!!!) |
|---|
| 15 | ! Mot1...N = entiers designant le mot a extraire |
|---|
| 16 | ! |
|---|
| 17 | ! Creation : |
|---|
| 18 | ! 12/11/2003 - O.Maury |
|---|
| 19 | !------------------------------------------------ |
|---|
| 20 | ! Modifications : |
|---|
| 21 | ! 24/11/2003 - O.Maury : |
|---|
| 22 | ! - ajout d'un header a ResuFile |
|---|
| 23 | ! - ajout des mots par defaut |
|---|
| 24 | ! - ajout sorties carto (ResuFile_III-*) |
|---|
| 25 | ! 25/11/2003 - O.Maury : |
|---|
| 26 | ! - ajout de la date dans mots par defaut (228) |
|---|
| 27 | ! 26/11/2003 - O.Maury |
|---|
| 28 | ! - correction date : lue dans le header (228) |
|---|
| 29 | ! 03/12/2003 - R. Armante |
|---|
| 30 | ! - passage des coordonnees d'une zone geographique |
|---|
| 31 | ! par defaut, -90,90 en latitude et -180,180 en longitude |
|---|
| 32 | ! - choix de l'indice terre/mer (terre+mer par defaut) |
|---|
| 33 | ! - choix de l'indice jour/nuit (jour/nuit par defaut) |
|---|
| 34 | ! - correction bug sur la date : lorsque l'on ecrit la date sous la forme |
|---|
| 35 | ! ddmmyyyy, on depasse la precision de la machine sur le nombre de chiffre |
|---|
| 36 | ! apres la virgule sur les flottants. |
|---|
| 37 | ! ==> correction en ramenant la date sous la forme ddmmyy |
|---|
| 38 | !------------------------------------------------ |
|---|
| 39 | ! Definition des variables |
|---|
| 40 | ! |
|---|
| 41 | PARAMETER (Nbval_Header=8,npt_iasi=8461) |
|---|
| 42 | CHARACTER DataFile*50,ResuFile*9 |
|---|
| 43 | |
|---|
| 44 | INTEGER MotDefaut(Nbval_Header) |
|---|
| 45 | INTEGER MotDesire(500) |
|---|
| 46 | INTEGER IndiceMot(500) |
|---|
| 47 | |
|---|
| 48 | LOGICAL DateIdentique |
|---|
| 49 | |
|---|
| 50 | REAL*4 ValeurMot(500),Corrige(500) |
|---|
| 51 | REAL Latmin,Latmax,Lonmin,Lonmax |
|---|
| 52 | REAL Indice_tm,Indice_jn |
|---|
| 53 | real cor_ang(324,13),ang_zen(13) |
|---|
| 54 | data ang_zen/00.00,05.72,09.19,12.93,16.69,20.41,24.04,27.85,31.67,35.28,39.18,43.47,47.14/ |
|---|
| 55 | |
|---|
| 56 | CHARACTER*5 FlagCarto |
|---|
| 57 | CHARACTER*5 FlagHeader |
|---|
| 58 | CHARACTER*20 Lati,Longi |
|---|
| 59 | CHARACTER*4 arg |
|---|
| 60 | CHARACTER*3 extract |
|---|
| 61 | CHARACTER*8 Suff |
|---|
| 62 | CHARACTER*15 carac |
|---|
| 63 | |
|---|
| 64 | ! 29 = latitude (°) |
|---|
| 65 | ! 30 = longitude (°) |
|---|
| 66 | ! 31 = local zenith angle for the box (°) |
|---|
| 67 | ! 35 = surface elevation (m) |
|---|
| 68 | ! 36 = identification of cloud test |
|---|
| 69 | ! 37 = time (hhmmss) |
|---|
| 70 | ! 39 = land/sea + day/night flag |
|---|
| 71 | ! 228 ou 230 (du header)= date du spot (ddmmyy) |
|---|
| 72 | ! Rq: le mot 228 est celui du header, pas des donnees |
|---|
| 73 | DATA MotDefaut /0,0,0,0,0,0,0,0/ |
|---|
| 74 | ! DATA MotDefaut /29,30,31,35,36,37,39,228/ |
|---|
| 75 | ! Declaration partie Airs |
|---|
| 76 | INTEGER,PARAMETER :: NCHANNELMAXIASI=8461,NCHANNELMAXAMSU=15 |
|---|
| 77 | INTEGER yy,mm,dd,hh,mn,ss,yyyymmd,hhmnss |
|---|
| 78 | |
|---|
| 79 | REAL IASI_Time,IASI_Latitude,IASI_Longitude, & |
|---|
| 80 | IASI_Satellite_Zenith,IASI_Solar_Zenith,Cloud_Cover |
|---|
| 81 | INTEGER Land_Sea_Alti |
|---|
| 82 | REAL ,DIMENSION(NCHANNELMAXIASI) :: IASI_Radiances |
|---|
| 83 | REAL*8 date_iasi |
|---|
| 84 | integer Orbit_number |
|---|
| 85 | character*4 IASI_Quality_Flag |
|---|
| 86 | |
|---|
| 87 | REAL ,DIMENSION(NCHANNELMAXAMSU) :: AMSU_BT |
|---|
| 88 | REAL AMSU_Quality_Flag |
|---|
| 89 | |
|---|
| 90 | CHARACTER*100 Nom_buffer !nom du fichier buffer à lire |
|---|
| 91 | CHARACTER*100 SORTIE !sortie ascii |
|---|
| 92 | CHARACTER*5 process !nom de l'action à effectuer : NCEP,Prcom,STRAT,DAO |
|---|
| 93 | CHARACTER*3 CGRANULE,CJOUR |
|---|
| 94 | CHARACTER*2 CHEUREDEB,CHEUREFIN,CMINDEB,CMINFIN,CANNEE |
|---|
| 95 | CHARACTER*40 PREFIXE,SUFFIXE,PATH_DATA |
|---|
| 96 | INTEGER Ngranule,ANNEE,HEUREDEB,MINDEB,HEUREFIN,MINFIN,JOUR |
|---|
| 97 | real freq_iasi(8461),tb_hs(8461) |
|---|
| 98 | !**Test ciel clair** |
|---|
| 99 | integer test_ciel_clair, couv_nuage |
|---|
| 100 | !**Test terre/mer** |
|---|
| 101 | integer*4 indtermer(2160,1080),flagtermer,terre_mer,inittm,iunittm |
|---|
| 102 | character*200 nomfichtermer |
|---|
| 103 | |
|---|
| 104 | INTEGER ii |
|---|
| 105 | |
|---|
| 106 | include 'iasidatafile.h' |
|---|
| 107 | ! definition des canaux HS |
|---|
| 108 | do i=1,npt_iasi |
|---|
| 109 | tb_hs(i)=0 |
|---|
| 110 | enddo |
|---|
| 111 | ! canaux 128 et 263 morts a partir de mars 2003 |
|---|
| 112 | ! tb_hs(116)=1. |
|---|
| 113 | do i=1,npt_iasi |
|---|
| 114 | if(tb_hs(i).eq.1) write(*,*)'canal',i, & |
|---|
| 115 | ' HS ==> flag quality pas pris en compte' |
|---|
| 116 | enddo |
|---|
| 117 | !***Lecture des frequences des canaux*** |
|---|
| 118 | do i=1, NCHANNELMAXIASI |
|---|
| 119 | freq_iasi(i)=645.+(i-1)*0.25 |
|---|
| 120 | enddo |
|---|
| 121 | |
|---|
| 122 | !***Terre/mer*** |
|---|
| 123 | nomfichtermer=trim(racine_iasidata)//'/land_sea_alti_map.dat' |
|---|
| 124 | inittm = 0 |
|---|
| 125 | iunittm = 1 |
|---|
| 126 | !*CHARGEMENT DE LA BANQUE TERRE/MER DANS LE TABLEAU indtermer* |
|---|
| 127 | CALL sub_land_sea_alti(0.,0.,inittm,terre_mer,iunittm & |
|---|
| 128 | ,indtermer,nomfichtermer) |
|---|
| 129 | !*DRAPEAU D'UTILISATION DE LA BANQUE TERRE/MER* |
|---|
| 130 | inittm = 1 |
|---|
| 131 | |
|---|
| 132 | !***Test ciel clair*** |
|---|
| 133 | ! test_ciel_clair=couv_nuage & |
|---|
| 134 | ! (0,AIRS_Radiances,AMSU_BT & |
|---|
| 135 | ! ,1,1,freq_airs,0) |
|---|
| 136 | cloud_cover=-1. |
|---|
| 137 | |
|---|
| 138 | !------------------------------------------------ |
|---|
| 139 | ! Lecture arguments (pas de test) |
|---|
| 140 | ! |
|---|
| 141 | CALL getarg(1,FlagCarto) |
|---|
| 142 | CALL getarg(2,FlagHeader) |
|---|
| 143 | CALL getarg(3,Lati) |
|---|
| 144 | CALL getarg(4,Longi) |
|---|
| 145 | CALL getarg(5,arg) |
|---|
| 146 | read(arg,*) Indice_tm |
|---|
| 147 | CALL getarg(6,arg) |
|---|
| 148 | read(arg,*) Indice_jn |
|---|
| 149 | CALL getarg(7,DataFile) |
|---|
| 150 | CALL getarg(8,ResuFile) |
|---|
| 151 | |
|---|
| 152 | IFIN = iargc() |
|---|
| 153 | NbrDesire = IFIN-8 |
|---|
| 154 | DO ind = 9,IFIN |
|---|
| 155 | CALL getarg(ind,arg) |
|---|
| 156 | read (arg,*) Mot |
|---|
| 157 | MotDesire(ind-8)=Mot |
|---|
| 158 | END DO |
|---|
| 159 | |
|---|
| 160 | ! print *,FlagCarto |
|---|
| 161 | ! print *,FlagHeader |
|---|
| 162 | ! print *,DataFile |
|---|
| 163 | ! print *,ResuFile |
|---|
| 164 | ! print *,NbrDesire |
|---|
| 165 | do indi=1,len(Lati) |
|---|
| 166 | if(Lati(indi:indi).eq.',') Ind_lati=indi |
|---|
| 167 | enddo |
|---|
| 168 | do indi=1,len(Longi) |
|---|
| 169 | if(Longi(indi:indi).eq.',') Ind_long=indi |
|---|
| 170 | enddo |
|---|
| 171 | read(Lati(1:Ind_lati-1),*) Latmin |
|---|
| 172 | read(Lati(Ind_lati+1:len(Lati)),*) Latmax |
|---|
| 173 | read(Longi(1:Ind_long-1),*) Lonmin |
|---|
| 174 | read(Longi(Ind_long+1:len(Longi)),*) Lonmax |
|---|
| 175 | |
|---|
| 176 | !------------------------------------------------ |
|---|
| 177 | ! Ajout mots par defaut |
|---|
| 178 | ! |
|---|
| 179 | DO ii=1,Nbval_Header |
|---|
| 180 | IndiceMot(ii)=MotDefaut(ii) |
|---|
| 181 | END DO |
|---|
| 182 | DO jj=1,NbrDesire |
|---|
| 183 | ii=jj+Nbval_Header |
|---|
| 184 | IndiceMot(ii)=MotDesire(jj) |
|---|
| 185 | END DO |
|---|
| 186 | NbrMots = NbrDesire+Nbval_Header |
|---|
| 187 | |
|---|
| 188 | ! print *,NbrMots |
|---|
| 189 | ! print *,IndiceMot |
|---|
| 190 | |
|---|
| 191 | !------------------------------------------------ |
|---|
| 192 | ! Ouverture des fichiers |
|---|
| 193 | ! |
|---|
| 194 | close(11) |
|---|
| 195 | open(unit=10, file = DataFile) |
|---|
| 196 | open(unit=20, file = ResuFile, form='unformatted') |
|---|
| 197 | open(599,file='fort.599',form='unformatted') |
|---|
| 198 | ! Option Carto ? |
|---|
| 199 | IF (FlagCarto .eq. 'TRUE') THEN |
|---|
| 200 | DO iCarto=1,NbrDesire |
|---|
| 201 | write(Suff,FMT='(A5,I3.3)') '_III-',MotDesire(iCarto) |
|---|
| 202 | open(unit=(40+iCarto), file = ResuFile // Suff, & |
|---|
| 203 | form='unformatted') |
|---|
| 204 | END DO |
|---|
| 205 | END IF |
|---|
| 206 | |
|---|
| 207 | !------------------------------------------------ |
|---|
| 208 | ! Ecriture du header |
|---|
| 209 | ! |
|---|
| 210 | IF (FlagHeader .eq. 'TRUE') THEN |
|---|
| 211 | ! print *, NbrMots,(IndiceMot(ind),ind=1,NbrMots) |
|---|
| 212 | WRITE (20) NbrMots,(IndiceMot(ind),ind=1,NbrMots) |
|---|
| 213 | WRITE (*,*) 'Header',NbrMots,(IndiceMot(ind),ind=1,NbrMots) |
|---|
| 214 | END IF |
|---|
| 215 | |
|---|
| 216 | !================================================ |
|---|
| 217 | ! Debut boucle sur les fichiers de donnees |
|---|
| 218 | !================================================ |
|---|
| 219 | 5 CONTINUE |
|---|
| 220 | !------------------------------------------------ |
|---|
| 221 | ! Lit le nom du fichier courrant puis l'ouvre |
|---|
| 222 | ! |
|---|
| 223 | read(10,'(a100)', END = 15) Nom_buffer |
|---|
| 224 | !lecture iasi bufr |
|---|
| 225 | open(1111,file=Nom_buffer,form='formatted') |
|---|
| 226 | read(1111,*) |
|---|
| 227 | read(1111,*) |
|---|
| 228 | read(1111,*) |
|---|
| 229 | read(1111,*) date_iasi |
|---|
| 230 | yyyymmdd=int(date_iasi) |
|---|
| 231 | hhmnss=int((date_iasi-yyyymmdd*1.)*1000000.) |
|---|
| 232 | write(*,*) date_iasi,hhmnss |
|---|
| 233 | read(1111,*) Orbit_number |
|---|
| 234 | read(1111,*) IASI_Quality_Flag |
|---|
| 235 | if(IASI_Quality_Flag.ne.'good') then |
|---|
| 236 | close(1111) |
|---|
| 237 | goto 5 |
|---|
| 238 | endif |
|---|
| 239 | read(1111,*) Rlat |
|---|
| 240 | read(1111,*) Rlon |
|---|
| 241 | read(1111,*) IASI_Satellite_Zenith |
|---|
| 242 | read(1111,*) IASI_Satellite_Azimuth |
|---|
| 243 | read(1111,*) IASI_Solar_Zenith |
|---|
| 244 | read(1111,*) IASI_Solar_Azimuth |
|---|
| 245 | read(1111,*) IASI_Satellite_Alt |
|---|
| 246 | read(1111,*) IASI_Cloud_Free |
|---|
| 247 | ! skip avhrr informations |
|---|
| 248 | do i=1,18 |
|---|
| 249 | read(1111,*) |
|---|
| 250 | enddo |
|---|
| 251 | read(1111,*) wavenb_deb |
|---|
| 252 | read(1111,*) wavenb_fin |
|---|
| 253 | read(1111,*) |
|---|
| 254 | read(1111,*) |
|---|
| 255 | do i=1,npt_iasi |
|---|
| 256 | read(1111,*) IASI_Radiances(i) |
|---|
| 257 | enddo |
|---|
| 258 | close(1111) |
|---|
| 259 | |
|---|
| 260 | nbatm_tot=0 |
|---|
| 261 | nbatm_clear=0 |
|---|
| 262 | ! DO I=1,number_of_golf_balls |
|---|
| 263 | extract='oui' |
|---|
| 264 | CALL sub_land_sea_alti(IASI_Latitude,IASI_Longitude & |
|---|
| 265 | ,inittm,Land_Sea_Alti,iunittm,indtermer,nomfichtermer) |
|---|
| 266 | indtm=0 |
|---|
| 267 | if(Land_Sea_Alti.ge.0) indtm=1 |
|---|
| 268 | ! cloud_cover=couv_nuage(1,IASI_Radiances,AMSU_BT & |
|---|
| 269 | ! ,I,J,freq_airs,indtm) |
|---|
| 270 | ! if(cloud_cover.ne.0) extract='non' |
|---|
| 271 | Do j=1,NbrMots+1 |
|---|
| 272 | ValeurMot(j)=0. |
|---|
| 273 | Enddo |
|---|
| 274 | ! determination de l'angle le plus proche |
|---|
| 275 | angmin=99.99 |
|---|
| 276 | do iiang=1,13 |
|---|
| 277 | dist=abs(IASI_Satellite_Zenith-ang_zen(iiang)) |
|---|
| 278 | if(dist.lt.angmin) then |
|---|
| 279 | angmin=dist |
|---|
| 280 | iiangmin=iiang |
|---|
| 281 | endif |
|---|
| 282 | enddo |
|---|
| 283 | ! Do J=1,IASI_FOVS |
|---|
| 284 | if(Rlat.lt.Latmin.or.Rlat.gt.Latmax) extract='non' |
|---|
| 285 | if(Rlon.lt.Lonmin.or.Rlon.gt.Lonmax) extract='non' |
|---|
| 286 | if(extract.eq.'oui') then |
|---|
| 287 | indtm=0 |
|---|
| 288 | if(Land_Sea_Alti.ge.0) indtm=1 |
|---|
| 289 | endif |
|---|
| 290 | indjn=1 |
|---|
| 291 | if(IASI_Solar_Zenith.ge.90) indjn=0 |
|---|
| 292 | if(indtm.ne.Indice_tm.and.Indice_tm.ne.2) extract='non' |
|---|
| 293 | if(indjn.ne.Indice_jn.and.Indice_jn.ne.2) extract='non' |
|---|
| 294 | if(extract.eq.'oui') then |
|---|
| 295 | ValeurMot(1)=Rlat |
|---|
| 296 | ValeurMot(2)=Rlon |
|---|
| 297 | ValeurMot(3)=IASI_Satellite_Zenith |
|---|
| 298 | ValeurMot(4)=Land_Sea_Alti |
|---|
| 299 | ValeurMot(5)=cloud_cover |
|---|
| 300 | ! call seconds_to_calender(dble(IASI_Time/1000.),yy,mm,dd,hh,mn,ss) |
|---|
| 301 | ValeurMot(6)=hhmnss |
|---|
| 302 | ValeurMot(7)=float(indtm*10+indjn) |
|---|
| 303 | ValeurMot(8)=yyyymmdd |
|---|
| 304 | DO ind = 1, NbrDesire |
|---|
| 305 | if(tb_hs(MotDesire(ind)).ne.1.and.IASI_Quality_Flag.ne.'good') & |
|---|
| 306 | write(*,*) MotDesire(ind),IASI_Quality_Flag |
|---|
| 307 | if(MotDesire(ind).le.npt_iasi.and.IASI_Quality_Flag.ne.'good') extract='non' |
|---|
| 308 | if(MotDesire(ind).le.npt_iasi.and.IASI_Quality_Flag.eq.'good') then |
|---|
| 309 | ! ValeurMot(Nbval_Header+ind)= IASI_Radiances(MotDesire(ind)) |
|---|
| 310 | ValeurMot(Nbval_Header+ind)=tbrillans(freq_iasi(MotDesire(ind)), & |
|---|
| 311 | 1e02*IASI_Radiances(MotDesire(ind))) |
|---|
| 312 | endif |
|---|
| 313 | ! if(MotDesire(ind).gt.npt_iasi.and.AMSU_Quality_Flag(MotDesire(ind)-npt_iasi,1,I).ne.0) extract='non' |
|---|
| 314 | ! if(MotDesire(ind).gt.npt_iasi.and.AMSU_Quality_Flag(MotDesire(ind)-npt_iasi,1,I).eq.0) & |
|---|
| 315 | ! ValeurMot(Nbval_Header+ind)=AMSU_BT(MotDesire(ind)-npt_iasi,1,I) |
|---|
| 316 | ! endif |
|---|
| 317 | END DO |
|---|
| 318 | ValeurMot(NbrMots+1)=IASI_Solar_Zenith |
|---|
| 319 | |
|---|
| 320 | nbatm_tot=nbatm_tot+1 |
|---|
| 321 | if(extract.eq.'oui') then |
|---|
| 322 | nbatm_clear=nbatm_clear+1 |
|---|
| 323 | WRITE (20) (ValeurMot(ind),ind=1,NbrMots+1),Orbit_number |
|---|
| 324 | endif |
|---|
| 325 | |
|---|
| 326 | ! WRITE (20) (ValeurMot(ind),ind=1,NbrMots+1) |
|---|
| 327 | ! Option Carto ? |
|---|
| 328 | IF (FlagCarto .eq. 'TRUE') THEN |
|---|
| 329 | DO iCarto=1,NbrDesire |
|---|
| 330 | write(40+iCarto) ValeurMot(1),ValeurMot(2), & |
|---|
| 331 | ValeurMot(iCarto+Nbval_Header) |
|---|
| 332 | END DO |
|---|
| 333 | END IF |
|---|
| 334 | end if |
|---|
| 335 | write(*,*) 'Nb clear',nbatm_clear,nbatm_tot |
|---|
| 336 | |
|---|
| 337 | !================================================ |
|---|
| 338 | ! Fin boucle |
|---|
| 339 | !================================================ |
|---|
| 340 | GO TO 5 |
|---|
| 341 | 15 CONTINUE |
|---|
| 342 | |
|---|
| 343 | !------------------------------------------------ |
|---|
| 344 | ! Fermeture des fichiers |
|---|
| 345 | ! |
|---|
| 346 | close (10) |
|---|
| 347 | close (20) |
|---|
| 348 | |
|---|
| 349 | IF (FlagCarto .eq. 'TRUE') THEN |
|---|
| 350 | DO iCarto=1,NbrDesire |
|---|
| 351 | close(40+iCarto) |
|---|
| 352 | END DO |
|---|
| 353 | END IF |
|---|
| 354 | !------------------------------------------------ |
|---|
| 355 | ! FIN PROGRAM extract_iii |
|---|
| 356 | ! |
|---|
| 357 | ! 777 CONTINUE |
|---|
| 358 | |
|---|
| 359 | END |
|---|
