Page 1 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1 PROGRAM BUFR_TRANTMI 2 3 !$$$ MAIN PROGRAM DOCUMENTATION BLOCK 4 ! 5 ! MAIN PROGRAM: BUFR_TRANTMI 6 ! PRGMMR: KEYSER ORG: NP22 DATE: 2012-12-14 7 ! 8 ! Abstract: Reads in TRMM TMI rainfall data from a raw HDF format file and 9 ! reformats them into BUFR in preparation for their ingest into the BUFR data 10 ! base on the NCEP supercomputers. Some observations may be filtered based on 11 ! q.c. 12 ! 13 ! Program history log: 14 ! 2001-03-09 Treadon -- Original author. 15 ! 2001-03-09 Sager -- Added BUFR output. 16 ! 2007-10-24 Keyser -- Corrected error in BUFR encoding of 17 ! longitude, was 0-360 East, now properly encoded as -180 to +180, East +, 18 ! West - 19 ! 2011-09-28 Keyser -- now writes output BUFR files without the 20 ! dictionary table at the top (needed so that tranjb won't default to 21 ! using this table instead of the external buftab.012 when creating a new 22 ! tank, a possibility now under the 2011 version of bufrlib); now stops 23 ! abnormally with condition code 99 if "istat" returned from the call to 24 ! HDF library routine vsfsfld (to determine the fields that will be read) 25 ! is non-zero - this indicates that the raw data file is corrupt 26 ! 2012-05-15 Y. Ling -- modified the HDF handling code to be able to handle 27 ! both TRMM V6 and TRMM V7 2A-12 TMI profiling data 28 ! 2012-12-14 Keyser -- Changes to run on WCOSS (minor). 29 ! 30 ! Usage: 31 ! 32 ! Input files: 33 ! tmi.hdf - binary file containing raw TRMM TMI data 34 ! unit 20 - BUFR mnemonic table 35 ! 36 ! Output files: 37 ! unit 06 - printout 38 ! unit 51 - BUFR file containing TRMM TMI data 39 ! unit 53 - GRADS file (currently not used) 40 ! unit 61 - date file (currently not used) 41 ! unit 62 - date file (currently not used) 42 ! 43 ! Subprograms called: 44 ! Unique: - BUFTRM STATS 45 ! Library: 46 ! W3NCO - W3TAGB W3TAGE ERREXIT 47 ! BUFRLIB - OPENBF CLOSBF OPENMB WRITSB UFBSEQ 48 ! HDF4LIB - HOPEN VFSTART VSFGID VSFATCH VSFEX 49 ! VSFDTCH VFEND SFSTART SFFINFO SFSELECT 50 ! SFGINFO SFENDACC SFN2INDEX SFRDATA SFEND 51 ! HEPRNT VSFINQ VSFGCLS VSFSFLD VSFRD 52 ! VSFNPAK HCLOSE 53 ! 54 ! 55 ! Exit states 56 ! 0 = no errors detected 57 ! >0 = some type of error detected Page 2 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 58 ! 59 ! Remarks: 60 ! None, 61 ! 62 ! Attributes: 63 ! Language: FORTRAN 90 (free format) 64 ! Machine: NCEP WCOSS 65 ! 66 !$$$ 67 ! 68 ! ***MUST DEFINE ALL VARIABLES*** 69 implicit none 70 71 72 ! Set parameters 73 integer nreal,ioff,nint 74 integer*4 DFACC_CREATE, DFNT_INT16, DFACC_READ 75 integer*4 DIM1, DIM0, FAIL, MAX_VAR_DIMS 76 integer*4 FULL_INTERLACE, HDF_VSUNPACK 77 parameter (DFACC_CREATE = 4, DFNT_INT16 = 22, DIM1 = 5) 78 parameter (DIM0 = 10, DFACC_READ = 1, FAIL = -1 ) 79 parameter (MAX_VAR_DIMS=5) 80 parameter (FULL_INTERLACE=0, HDF_VSUNPACK=1) 81 parameter (nreal=6,nint=7) 82 integer, parameter :: DEBUG = 0 83 84 ! Declare variables 85 character*7 infile 86 character*8 subset,statid 87 character*30 vdata_name 88 character*60 fields 89 character name*(64) 90 character*4 vdata_class 91 92 integer*4 sd_id, sds_id, sd_index 93 integer*4 file_id, vdata_ref, vdata_id, vdata_index 94 integer n_records, interlace, vdata_size 95 integer n_datasets, n_file_attrs, index, rank 96 integer i_lat, i_lon !************ilat ilon in V6 code 97 integer istat, attributes, data_type, nscan, nvariable, npix 98 ! integer dims(2), start(2), edges(2), stride(2) 99 ! integer start2(2),edge2(2),stride2(2) 100 integer i, j, k, jscan,ipix, ii, jj 101 integer start3(3),edge3(3), stride3(3) 102 integer sfstart, sfcreate, sfwdata, sfendacc, sfend 103 integer sfrdata, sfselect, sffinfo, sfginfo, sfgetinfo 104 integer sfreaddata 105 integer sfn2index 106 integer vsfgcls, vsfinq, vsfsfld, hopen,vsfgid, vsfatch, vsfex 107 integer vfstart,vsfread,vsfnpak, vfend, vsfdtch, hclose 108 integer vsfrd 109 integer*4 dim_sizes(MAX_VAR_DIMS) 110 integer*2 array_data(DIM1, DIM0) 111 integer*2 new_array(DIM1, DIM0) 112 integer heprnt 113 integer stdout,lundx,lubufr,lungrd,lundat1,lundat2 114 integer ngood,imo,idy,kx,iyr,isc,ihr,imn,ibad,nobs,ifirst,nbad Page 3 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 115 integer nflag,nlev,nflag0,nlev0,nmiss,npts 116 integer idata(nint) 117 integer*8 idate1,idate2 118 integer :: start(3), stride(3), edge(3) 119 integer :: start1, stride1, edge1 120 integer :: start2(2), stride2(2), edge2(2) 121 logical :: found_trmm_v6 122 123 real rmiss,fmin,fmax,favg,fmad,fsdv 124 real rdata(nreal),rtim,rtim0,xlat0,xlon0 125 126 integer :: nquality_bad 127 128 ! Allocatable arrays 129 integer*4,allocatable,dimension(:):: databuf 130 integer*2,allocatable,dimension(:):: year,doy 131 integer*1,allocatable,dimension(:):: month,days,hour,min,second 132 integer*1,allocatable,dimension(:):: data_quality !data scan quality 133 integer*1,allocatable,dimension(:,:):: sfcflag 134 integer*2,allocatable,dimension(:,:):: sfcrain,cvcrain,intwater,intice 135 integer*2,allocatable,dimension(:,:):: quality_flag !pixel quality 136 integer*2,allocatable,dimension(:,:):: ilat, ilon !lat/lon 137 integer*2,allocatable,dimension(:,:,:):: geolocat 138 real,allocatable,dimension(:,:):: rlat,rlon,rainrate,convect,clw,cli,rainflag 139 real,allocatable,dimension(:):: time2 140 141 142 ! Declare i/o units 143 data stdout / 6 / 144 data lundx,lubufr / 20, 51 / 145 data lungrd / 53 / 146 data lundat1,lundat2 / 61, 62 / 147 148 ! Set satellite id and other variables 149 data kx / 282 / 150 data infile / 'tmi.hdf' / 151 data subset / 'NC012013' / 152 data rmiss / -999. / 153 154 155 !****************************************************************************** 156 ! Start trantrmi here. 157 ! 158 ! Call w3tagb 159 call w3tagb('BUFR_TRANTMI',2012,0349,0068,'NP22') 160 161 write(stdout,*) ' ' 162 write(stdout,*) 'Welcome to BUFR_TRANTMI - 12/14/2012' 163 write(stdout,*) ' ' 164 165 ! Initialize variables 166 nobs=0; ngood=0; nbad=0 167 nflag = 1 168 nlev = 1 169 nflag0 = 0 170 nlev0 = 0 171 rtim = 0.0 Page 4 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 172 rtim0 = 0.0 173 xlat0 = 0.0 174 xlon0 = 0.0 175 176 177 ! Open bufr file for output 178 !!!!! call openbf(lubufr,'OUT',lundx) 179 call openbf(lubufr,'NODX',lundx) 180 181 182 !! Define the location, pattern, and size of the data set that will be read. 183 ! start(1) = 0 184 ! start(2) = 0 185 ! edges(1) = DIM1 186 ! edges(2) = DIM0 187 ! stride(1) = 1 188 ! stride(2) = 1 189 190 191 ! Open file to read VD (table) information 192 file_id = hopen(infile,DFACC_READ,0) 193 194 ! Initialize the Vset interface 195 istat = vfstart(file_id) 196 197 ! Get the reference number for the first Vdata in the file 198 vdata_ref=-1 199 200 !VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 201 ! Check and see if it is a TRMM v6 or v7 file. V6 file has 202 ! year, month, dayOfMonth ... in vdata table. Otherwise it is 203 ! a v7 file (those are in sdata table) 204 205 found_trmm_v6 = .FALSE. 206 vdata_index = 0 207 208 outer: do 209 vdata_ref=vsfgid(file_id,vdata_ref) 210 if (vdata_ref .eq. -1) exit 211 212 !Attach to the first Vdata in read mode. 213 vdata_id=vsfatch(file_id,vdata_ref,'r') 214 istat = vsfex(vdata_id,'year,month,dayOfMonth,hour,minute,second,dayOfYear') 215 if (istat .ne. -1) then 216 found_trmm_v6 = .TRUE. 217 exit outer 218 end if 219 220 vdata_index = vdata_index + 1 221 222 end do outer 223 224 if (.NOT. found_trmm_v6) then 225 write(stdout,*) 'This is a TRMM V7 HDF file' 226 else 227 write(stdout,*) 'This is a TRMM V6 HDF file, scan_time found in vdata index: ', vdata_index 228 end if Page 5 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 229 230 !VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 231 232 if(.NOT. found_trmm_v6) then 233 ! Detach from the Vdata, close the Vset interface and the file 234 istat = vsfdtch(vdata_id) 235 istat = vfend(file_id) 236 237 !read the variables from TRMM V7 data 238 !Open the file and initiate the SD interface 239 sd_id = sfstart(infile, DFACC_READ) 240 if (sd_id .eq. FAIL) then 241 istat=heprnt(0) 242 else 243 write(stdout,*) infile,' opened with READ access' 244 end if 245 246 !Determine the contents of the file. 247 istat = sffinfo(sd_id, n_datasets, n_file_attrs) 248 write(stdout,*)'n_datasets =',n_datasets 249 write(stdout,*)'n_file_attrs=',n_file_attrs 250 write(stdout,*)' ' 251 252 !Access and print the names of every data set in the file. 253 do index = 0, n_datasets - 1 254 sds_id = sfselect(sd_id, index) 255 256 rank=0 257 dim_sizes=0 258 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 259 260 write(stdout,*)' ' 261 write(stdout,*)'index=',index 262 write(stdout,*)'name = ', name 263 write(stdout,*)'rank = ', rank 264 write(stdout,*)'dim_sizes = ', (dim_sizes(i), i=1,rank) 265 write(stdout,*)'data_type = ',data_type 266 write(stdout,*)'number of attributes = ', attributes 267 268 istat = sfendacc(sds_id) 269 end do 270 271 !----------------------------------------------------------- 272 ! Year 273 ! 16-bit integer 274 ! units = years 275 !----------------------------------------------------------- 276 !---- Select the desired SDS ---- 277 ! sds_id = sfselect(sd_id, 0) 278 sds_id = sfselect(sd_id, sfn2index(sd_id,'Year')) 279 write(stdout,*)' ' 280 write(stdout,*) 'Year: sds_id=', sds_id 281 if ( sds_id .eq. -1 ) then 282 write(stdout,*) 'Error selecting the Year', sds_id 283 call w3tage('BUFR_TRANTMI') 284 call errexit(99) 285 endif Page 6 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 286 287 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 288 289 if(DEBUG .ne. 0) then 290 write(stdout,*)' ' 291 write(stdout,*) "name = ", name 292 write(stdout,*) "rank = ", rank 293 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 294 write(stdout,*) "data type is ", data_type 295 write(stdout,*) "number of attributes is ", attributes 296 end if 297 298 nscan = dim_sizes(1) 299 300 !---- Read Year ---- 301 start1 = 0 302 stride1 = 1 303 edge1 = nscan 304 305 allocate( year(nscan) ) 306 istat = sfrdata(sds_id, start1, stride1, edge1, year) 307 308 IF ( istat .ne. 0 ) THEN 309 write(stdout,*) 'Error reading Year', istat 310 call w3tage('BUFR_TRANTMI') 311 call errexit(99) 312 ENDIF 313 314 istat = sfendacc(sds_id) 315 IF ( istat .ne. 0 ) THEN 316 write(stdout,*) 'Error ending Year', istat 317 call w3tage('BUFR_TRANTMI') 318 call errexit(99) 319 ENDIF 320 321 !----------------------------------------------------------- 322 ! Month 323 ! 8-bit integer 324 ! units = months 325 !----------------------------------------------------------- 326 !---- Select the desired SDS ---- 327 ! sds_id = sfselect(sd_id, 1) 328 sds_id = sfselect(sd_id, sfn2index(sd_id,'Month')) 329 write(stdout,*)' ' 330 write(stdout,*) 'Month: sds_id=', sds_id 331 if ( sds_id .eq. -1 ) then 332 write(stdout,*) 'Error selecting the Month', sds_id 333 call w3tage('BUFR_TRANTMI') 334 call errexit(99) 335 endif 336 337 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 338 339 if(DEBUG .ne. 0) then 340 write(stdout,*)' ' 341 write(stdout,*) "name = ", name 342 write(stdout,*) "rank = ", rank Page 7 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 343 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 344 write(stdout,*) "data type is ", data_type 345 write(stdout,*) "number of attributes is ", attributes 346 end if 347 348 nscan = dim_sizes(1) 349 350 !---- Read Month ---- 351 start1 = 0 352 stride1 = 1 353 edge1 = nscan 354 355 allocate( month(nscan) ) 356 istat = sfrdata(sds_id, start1, stride1, edge1, month) 357 358 IF ( istat .ne. 0 ) THEN 359 write(stdout,*) 'Error reading Month', istat 360 call w3tage('BUFR_TRANTMI') 361 call errexit(99) 362 ENDIF 363 364 istat = sfendacc(sds_id) 365 IF ( istat .ne. 0 ) THEN 366 write(stdout,*) 'Error ending Month', istat 367 call w3tage('BUFR_TRANTMI') 368 call errexit(99) 369 ENDIF 370 371 !----------------------------------------------------------- 372 ! DayOfMonth 373 ! 8-bit integer 374 ! units = days 375 !----------------------------------------------------------- 376 !---- Select the desired SDS ---- 377 ! sds_id = sfselect(sd_id, 2) 378 sds_id = sfselect(sd_id, sfn2index(sd_id,'DayOfMonth')) 379 write(stdout,*)' ' 380 write(stdout,*) 'DayOfMonth: sds_id=', sds_id 381 if ( sds_id .eq. -1 ) then 382 write(stdout,*) 'Error selecting the DayOfMonth', sds_id 383 call w3tage('BUFR_TRANTMI') 384 call errexit(99) 385 endif 386 387 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 388 389 if(DEBUG .ne. 0) then 390 write(stdout,*)' ' 391 write(stdout,*) "name = ", name 392 write(stdout,*) "rank = ", rank 393 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 394 write(stdout,*) "data type is ", data_type 395 write(stdout,*) "number of attributes is ", attributes 396 end if 397 398 nscan = dim_sizes(1) 399 Page 8 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 400 !---- Read DayOfMonth ---- 401 start1 = 0 402 stride1 = 1 403 edge1 = nscan 404 405 allocate( days(nscan) ) 406 istat = sfrdata(sds_id, start1, stride1, edge1, days) 407 408 IF ( istat .ne. 0 ) THEN 409 write(stdout,*) 'Error reading DayOfMonth', istat 410 call w3tage('BUFR_TRANTMI') 411 call errexit(99) 412 ENDIF 413 414 istat = sfendacc(sds_id) 415 IF ( istat .ne. 0 ) THEN 416 write(stdout,*) 'Error ending DayOfMonth', istat 417 call w3tage('BUFR_TRANTMI') 418 call errexit(99) 419 ENDIF 420 421 IF ( istat .ne. 0 ) THEN 422 write(stdout,*) 'Error ending DayOfMonth', istat 423 call w3tage('BUFR_TRANTMI') 424 call errexit(99) 425 ENDIF 426 427 428 !----------------------------------------------------------- 429 ! Hour 430 ! 8-bit integer 431 ! units = hours 432 !----------------------------------------------------------- 433 !---- Select the desired SDS ---- 434 ! sds_id = sfselect(sd_id, 3) 435 sds_id = sfselect(sd_id, sfn2index(sd_id,'Hour')) 436 write(stdout,*)' ' 437 write(stdout,*) 'Hour: sds_id=', sds_id 438 if ( sds_id .eq. -1 ) then 439 write(stdout,*) 'Error selecting the Hour', sds_id 440 call w3tage('BUFR_TRANTMI') 441 call errexit(99) 442 endif 443 444 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 445 446 if(DEBUG .ne. 0) then 447 write(stdout,*)' ' 448 write(stdout,*) "name = ", name 449 write(stdout,*) "rank = ", rank 450 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 451 write(stdout,*) "data type is ", data_type 452 write(stdout,*) "number of attributes is ", attributes 453 end if 454 455 nscan = dim_sizes(1) 456 Page 9 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 457 !---- Read Hour ---- 458 start1 = 0 459 stride1 = 1 460 edge1 = nscan 461 462 allocate( hour(nscan) ) 463 istat = sfrdata(sds_id, start1, stride1, edge1, hour) 464 465 IF ( istat .ne. 0 ) THEN 466 write(stdout,*) 'Error reading Hour', istat 467 call w3tage('BUFR_TRANTMI') 468 call errexit(99) 469 ENDIF 470 471 istat = sfendacc(sds_id) 472 IF ( istat .ne. 0 ) THEN 473 write(stdout,*) 'Error ending Hour', istat 474 call w3tage('BUFR_TRANTMI') 475 call errexit(99) 476 ENDIF 477 478 479 !----------------------------------------------------------- 480 ! Minute 481 ! 8-bit integer 482 ! units = minutes 483 !----------------------------------------------------------- 484 !---- Select the desired SDS ---- 485 sds_id = sfselect(sd_id, sfn2index(sd_id,'Minute')) 486 ! sds_id = sfselect(sd_id, 4) 487 write(stdout,*)' ' 488 write(stdout,*) 'Minute: sds_id=', sds_id 489 if ( sds_id .eq. -1 ) then 490 write(stdout,*) 'Error selecting the Minute', sds_id 491 call w3tage('BUFR_TRANTMI') 492 call errexit(99) 493 endif 494 495 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 496 497 if(DEBUG .ne. 0) then 498 write(stdout,*)' ' 499 write(stdout,*) "name = ", name 500 write(stdout,*) "rank = ", rank 501 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 502 write(stdout,*) "data type is ", data_type 503 write(stdout,*) "number of attributes is ", attributes 504 end if 505 506 nscan = dim_sizes(1) 507 508 !---- Read Minute ---- 509 start1 = 0 510 stride1 = 1 511 edge1 = nscan 512 513 allocate( min(nscan) ) Page 10 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 514 istat = sfrdata(sds_id, start1, stride1, edge1, min) 515 516 IF ( istat .ne. 0 ) THEN 517 write(stdout,*) 'Error reading minute', istat 518 call w3tage('BUFR_TRANTMI') 519 call errexit(99) 520 ENDIF 521 522 istat = sfendacc(sds_id) 523 IF ( istat .ne. 0 ) THEN 524 write(stdout,*) 'Error ending minute', istat 525 call w3tage('BUFR_TRANTMI') 526 call errexit(99) 527 ENDIF 528 529 !----------------------------------------------------------- 530 ! Second 531 ! 8-bit integer 532 ! units = seconds 533 !----------------------------------------------------------- 534 !---- Select the desired SDS ---- 535 ! sds_id = sfselect(sd_id, 5) 536 sds_id = sfselect(sd_id, sfn2index(sd_id,'Second')) 537 write(stdout,*)' ' 538 write(stdout,*) 'Second: sds_id=', sds_id 539 if ( sds_id .eq. -1 ) then 540 write(stdout,*) 'Error selecting the Second', sds_id 541 call w3tage('BUFR_TRANTMI') 542 call errexit(99) 543 endif 544 545 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 546 547 if(DEBUG .ne. 0) then 548 write(stdout,*)' ' 549 write(stdout,*) "name = ", name 550 write(stdout,*) "rank = ", rank 551 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 552 write(stdout,*) "data type is ", data_type 553 write(stdout,*) "number of attributes is ", attributes 554 end if 555 556 nscan = dim_sizes(1) 557 558 !---- Read Second ---- 559 start1 = 0 560 stride1 = 1 561 edge1 = nscan 562 563 allocate( second(nscan) ) 564 istat = sfrdata(sds_id, start1, stride1, edge1, second) 565 566 IF ( istat .ne. 0 ) THEN 567 write(stdout,*) 'Error reading second', istat 568 call w3tage('BUFR_TRANTMI') 569 call errexit(99) 570 ENDIF Page 11 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 571 572 istat = sfendacc(sds_id) 573 IF ( istat .ne. 0 ) THEN 574 write(stdout,*) 'Error ending second', istat 575 call w3tage('BUFR_TRANTMI') 576 call errexit(99) 577 ENDIF 578 579 !----------------------------------------------------------- 580 ! Latitude 581 ! 16-bit integer 582 ! Number of attributes: 6 583 ! Scale factor = 100.0 584 ! Scale factor error = 0.0 585 ! Add_offset= 0.0 586 ! Add_offset_error = 0.0 587 ! Calibrated_nt = 22 588 ! Units = degree 589 !----------------------------------------------------------- 590 !---- Select the desired SDS ---- 591 sds_id = sfselect(sd_id, sfn2index(sd_id,'Latitude')) 592 ! sds_id = sfselect(sd_id, 8) 593 write(stdout,*)' ' 594 write(stdout,*) 'latitude: sds_id=', sds_id 595 if ( sds_id .eq. -1 ) then 596 write(stdout,*) 'Error selecting the latitude', sds_id 597 call w3tage('BUFR_TRANTMI') 598 call errexit(99) 599 endif 600 601 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 602 603 if(DEBUG .ne. 0) then 604 write(stdout,*)' ' 605 write(stdout,*) "name = ", name 606 write(stdout,*) "rank = ", rank 607 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 608 write(stdout,*) "data type is ", data_type 609 write(stdout,*) "number of attributes is ", attributes 610 end if 611 612 npix = dim_sizes(1) 613 nscan = dim_sizes(2) 614 615 !---- Read latitude---- 616 start2(1) = 0 617 start2(2) =0 618 619 stride2(1) = 1 620 stride2(2) = 1 621 622 edge2(1) = npix 623 edge2(2) = nscan 624 625 allocate ( ilat(npix,nscan) ) 626 allocate ( rlat(npix,nscan) ) 627 Page 12 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 628 istat = sfrdata(sds_id, start2, stride2, edge2, ilat) 629 630 IF ( istat .ne. 0 ) THEN 631 write(stdout,*) 'Error reading latitude', istat 632 call w3tage('BUFR_TRANTMI') 633 call errexit(99) 634 ENDIF 635 636 istat = sfendacc(sds_id) 637 IF ( istat .ne. 0 ) THEN 638 write(stdout,*) 'Error ending latitude', istat 639 call w3tage('BUFR_TRANTMI') 640 call errexit(99) 641 ENDIF 642 643 rlat = ilat/100.0 644 645 if(DEBUG .ne. 0) then 646 do jscan=1, 5 647 do ipix=1, 5 648 write(stdout, '(f7.2)') rlat(ipix,jscan) 649 end do 650 end do 651 end if 652 653 !----------------------------------------------------------- 654 ! Longitude 655 ! 16-bit integer 656 ! Number of attributes: 6 657 ! Scale factor = 100.0 658 ! Scale factor error = 0.0 659 ! Add_offset= 0.0 660 ! Add_offset_error = 0.0 661 ! Calibrated_nt = 22 662 ! Units = degree 663 !----------------------------------------------------------- 664 !---- Select the desired SDS ---- 665 sds_id = sfselect(sd_id, sfn2index(sd_id,'Longitude')) 666 ! sds_id = sfselect(sd_id, 9) 667 write(stdout,*)' ' 668 write(stdout,*) 'longitude: sds_id=', sds_id 669 if ( sds_id .eq. -1 ) then 670 write(stdout,*) 'Error selecting the longitude', sds_id 671 call w3tage('BUFR_TRANTMI') 672 call errexit(99) 673 endif 674 675 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 676 677 if(DEBUG .ne. 0) then 678 write(stdout,*)' ' 679 write(stdout,*) "name = ", name 680 write(stdout,*) "rank = ", rank 681 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 682 write(stdout,*) "data type is ", data_type 683 write(stdout,*) "number of attributes is ", attributes 684 end if Page 13 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 685 686 npix = dim_sizes(1) 687 nscan = dim_sizes(2) 688 689 !---- Read longitude---- 690 start2(1) = 0 691 start2(2) =0 692 693 stride2(1) = 1 694 stride2(2) = 1 695 696 edge2(1) = npix 697 edge2(2) = nscan 698 699 allocate ( ilon(npix,nscan) ) 700 allocate ( rlon(npix,nscan) ) 701 702 istat = sfrdata(sds_id, start2, stride2, edge2, ilon) 703 704 IF ( istat .ne. 0 ) THEN 705 write(stdout,*) 'Error reading longitude', istat 706 call w3tage('BUFR_TRANTMI') 707 call errexit(99) 708 ENDIF 709 710 istat = sfendacc(sds_id) 711 IF ( istat .ne. 0 ) THEN 712 write(stdout,*) 'Error ending longitude', istat 713 call w3tage('BUFR_TRANTMI') 714 call errexit(99) 715 ENDIF 716 717 rlon = ilon/100.0 718 719 do jscan=1, nscan 720 do ipix=1, npix 721 if (rlon(ipix,jscan) > 180.0) then 722 rlon(ipix,jscan)=rlon(ipix,jscan) - 360.0 723 end if 724 end do 725 end do 726 727 if(DEBUG .ne. 0) then 728 do jscan=1, 5 729 do ipix=1, 5 730 write(stdout, '(f8.3)') rlon(ipix,jscan) 731 end do 732 end do 733 end if 734 735 ! !----------------------------------------------------------- 736 ! ! dataQuality (A flag for overall scan quality, unless 737 ! ! this is 0, the scan data is meaningless for higher 738 ! ! science processing 739 ! ! 8-bit integer 740 ! !----------------------------------------------------------- 741 ! !---- Select the desired SDS ---- Page 14 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 742 ! sds_id = sfselect(sd_id, sfn2index(sd_id,'dataQuality')) 743 !! sds_id = sfselect(sd_id, 14) 744 ! write(stdout,*)' ' 745 ! write(stdout,*) 'dataQuality: sds_id=', sds_id 746 ! if ( sds_id .eq. -1 ) then 747 ! write(stdout,*) 'Error selecting the dataQuality', sds_id 748 ! call w3tage('BUFR_TRANTMI') 749 ! call errexit(99) 750 ! endif 751 ! 752 ! istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 753 ! 754 ! if(DEBUG .ne. 0) then 755 ! write(stdout,*)' ' 756 ! write(stdout,*) "name = ", name 757 ! write(stdout,*) "rank = ", rank 758 ! write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 759 ! write(stdout,*) "data type is ", data_type 760 ! write(stdout,*) "number of attributes is ", attributes 761 ! end if 762 ! 763 ! nscan = dim_sizes(1) 764 ! 765 ! !---- Read dataQuality ---- 766 ! start1 = 0 767 ! stride1 = 1 768 ! edge1 = nscan 769 ! 770 ! allocate( data_quality(nscan) ) 771 ! istat = sfrdata(sds_id, start1, stride1, edge1, data_quality) 772 ! 773 ! IF ( istat .ne. 0 ) THEN 774 ! write(stdout,*) 'Error reading dataQuality', istat 775 ! call w3tage('BUFR_TRANTMI') 776 ! call errexit(99) 777 ! ENDIF 778 ! 779 ! istat = sfendacc(sds_id) 780 ! IF ( istat .ne. 0 ) THEN 781 ! write(stdout,*) 'Error ending dataQuality', istat 782 ! call w3tage('BUFR_TRANTMI') 783 ! call errexit(99) 784 ! ENDIF 785 786 787 !----------------------------------------------------------- 788 ! qualityFlag (indicates a generalized quality of the 789 ! retrieved pixel. 0-high, 1-medium, 2-low, -99 - missing 790 ! 8-bit integer 791 ! Number of attributes: 0 792 !----------------------------------------------------------- 793 !---- Select the desired SDS ---- 794 sds_id = sfselect(sd_id, sfn2index(sd_id,'qualityFlag')) 795 ! sds_id = sfselect(sd_id, 20) 796 write(stdout,*)' ' 797 write(stdout,*) 'qualityFlag: sds_id=', sds_id 798 if ( sds_id .eq. -1 ) then Page 15 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 799 write(stdout,*) 'Error selecting the qualityFlag', sds_id 800 call w3tage('BUFR_TRANTMI') 801 call errexit(99) 802 endif 803 804 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 805 806 if(DEBUG .ne. 0) then 807 write(stdout,*)' ' 808 write(stdout,*) "name = ", name 809 write(stdout,*) "rank = ", rank 810 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 811 write(stdout,*) "data type is ", data_type 812 write(stdout,*) "number of attributes is ", attributes 813 end if 814 815 npix = dim_sizes(1) 816 nscan = dim_sizes(2) 817 818 !---- Read qualityFlag---- 819 start2(1) = 0 820 start2(2) =0 821 822 stride2(1) = 1 823 stride2(2) = 1 824 825 edge2(1) = npix 826 edge2(2) = nscan 827 828 allocate ( quality_flag(npix,nscan) ) 829 830 istat = sfrdata(sds_id, start2, stride2, edge2, quality_flag) 831 832 IF ( istat .ne. 0 ) THEN 833 write(stdout,*) 'Error reading quality_flag', istat 834 call w3tage('BUFR_TRANTMI') 835 call errexit(99) 836 ENDIF 837 838 istat = sfendacc(sds_id) 839 IF ( istat .ne. 0 ) THEN 840 write(stdout,*) 'Error ending quality_flag', istat 841 call w3tage('BUFR_TRANTMI') 842 call errexit(99) 843 ENDIF 844 845 846 !----------------------------------------------------------- 847 ! surfacePrecipitation 848 ! 16-bit integer 849 ! Number of attributes: 6 850 ! Scale factor = 10.0 851 ! Scale factor error = 0.0 852 ! Add_offset= 0.0 853 ! Add_offset_error = 0.0 854 ! Calibrated_nt = 22 855 ! Units = mm/hr Page 16 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 856 !----------------------------------------------------------- 857 !---- Select the desired SDS ---- 858 sds_id = sfselect(sd_id, sfn2index(sd_id,'surfacePrecipitation')) 859 ! sds_id = sfselect(sd_id, 26) 860 write(stdout,*)' ' 861 write(stdout,*) 'surfacePrecipitation: sds_id=', sds_id 862 if ( sds_id .eq. -1 ) then 863 write(stdout,*) 'Error selecting the surfacePrecipitation', sds_id 864 call w3tage('BUFR_TRANTMI') 865 call errexit(99) 866 endif 867 868 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 869 870 if(DEBUG .ne. 0) then 871 write(stdout,*)' ' 872 write(stdout,*) "name = ", name 873 write(stdout,*) "rank = ", rank 874 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 875 write(stdout,*) "data type is ", data_type 876 write(stdout,*) "number of attributes is ", attributes 877 end if 878 879 npix = dim_sizes(1) 880 nscan = dim_sizes(2) 881 write(stdout,*)'npix,nscan=',npix,nscan 882 883 !---- Read surfacePrecipitation---- 884 start2(1) = 0 885 start2(2) =0 886 887 stride2(1) = 1 888 stride2(2) = 1 889 890 edge2(1) = npix 891 edge2(2) = nscan 892 893 allocate ( sfcrain(npix,nscan) ) 894 allocate ( rainrate(npix,nscan) ) 895 896 istat = sfrdata(sds_id, start2, stride2, edge2, sfcrain) 897 898 IF ( istat .ne. 0 ) THEN 899 write(stdout,*) 'Error reading surfacePrecipitation', istat 900 call w3tage('BUFR_TRANTMI') 901 call errexit(99) 902 ENDIF 903 904 istat = sfendacc(sds_id) 905 IF ( istat .ne. 0 ) THEN 906 write(stdout,*) 'Error ending surfacePrecipitation', istat 907 call w3tage('BUFR_TRANTMI') 908 call errexit(99) 909 ENDIF 910 911 do jscan = 1,nscan 912 do ipix = 1,npix Page 17 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 913 rainrate(ipix,jscan) = float(sfcrain(ipix,jscan))/10. 914 end do 915 end do 916 917 deallocate(sfcrain) 918 919 if(DEBUG .ne. 0) then 920 write(stdout,*) "*******surface rain rate = ************" 921 do jscan=1, 5 922 do ipix=1, 5 923 write(stdout,'(f5.2)') rainrate(ipix,jscan) 924 end do 925 end do 926 end if 927 928 !----------------------------------------------------------- 929 ! convectPrecipitation 930 ! 16-bit integer 931 ! Number of attributes: 6 932 ! Scale factor = 10 933 ! Scale factor error = 0.0 934 ! Add_offset= 0.0 935 ! Add_offset_error = 0.0 936 ! Calibrated_nt = 22 937 ! Units = mm/hr 938 !----------------------------------------------------------- 939 !---- Select the desired SDS ---- 940 sds_id = sfselect(sd_id, sfn2index(sd_id,'convectPrecipitation')) 941 ! sds_id = sfselect(sd_id, 27) 942 write(stdout,*)' ' 943 write(stdout,*) 'convectPrecipitation: sds_id=', sds_id 944 if ( sds_id .eq. -1 ) then 945 write(stdout,*) 'Error selecting the surfacePrecipitation', sds_id 946 call w3tage('BUFR_TRANTMI') 947 call errexit(99) 948 endif 949 950 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 951 952 if(DEBUG .ne. 0) then 953 write(stdout,*)' ' 954 write(stdout,*) "name = ", name 955 write(stdout,*) "rank = ", rank 956 write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 957 write(stdout,*) "data type is ", data_type 958 write(stdout,*) "number of attributes is ", attributes 959 end if 960 961 npix = dim_sizes(1) 962 nscan = dim_sizes(2) 963 write(stdout,*)'npix,nscan=',npix,nscan 964 965 !---- Read convectPrecipitation---- 966 start2(1) = 0 967 start2(2) =0 968 969 stride2(1) = 1 Page 18 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 970 stride2(2) = 1 971 972 edge2(1) = npix 973 edge2(2) = nscan 974 975 allocate ( cvcrain(npix,nscan) ) !convect precipitation 976 allocate ( convect(npix,nscan) ) !covect rain rate 977 978 istat = sfrdata(sds_id, start2, stride2, edge2, cvcrain) 979 980 IF ( istat .ne. 0 ) THEN 981 write(stdout,*) 'Error reading convectPrecipitation', istat 982 call w3tage('BUFR_TRANTMI') 983 call errexit(99) 984 ENDIF 985 986 istat = sfendacc(sds_id) 987 IF ( istat .ne. 0 ) THEN 988 write(stdout,*) 'Error ending convectPrecipitation', istat 989 call w3tage('BUFR_TRANTMI') 990 call errexit(99) 991 ENDIF 992 993 do jscan = 1,nscan 994 do ipix = 1,npix 995 convect(ipix,jscan) = float(cvcrain(ipix,jscan))/10. 996 end do 997 end do 998 999 deallocate(cvcrain) 1000 1001 if(DEBUG .ne. 0) then 1002 write(stdout,*) "*******convect rain rate = ************" 1003 do jscan=1, 5 1004 do ipix=1, 5 1005 write(stdout,'(f5.2)') convect(ipix,jscan) 1006 end do 1007 end do 1008 end if 1009 1010 ! ! *********************************************************! 1011 ! ! Total cloud liquid water ! 1012 ! ! *********************************************************! 1013 ! ! cloud liquid water and cloud ice water are not available ! 1014 ! ! in TRMM V7 2A12 TMI profiling real time data ! 1015 ! ! 2A12.????-??-??T??-??-??Z.7.rt.gz ! 1016 ! ! turn this on when ingest other TRMM product with these ! 1017 ! ! 2 variables ! 1018 ! ! *********************************************************! 1019 ! ! 16-bit integer 1020 ! ! Number of attributes: 6 1021 ! ! Scale factor = 10 1022 ! ! Scale factor error = 0.0 1023 ! ! Add_offset= 0.0 1024 ! ! Add_offset_error = 0.0 1025 ! ! Calibrated_nt = 22 1026 ! ! Units = mm/hr Page 19 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1027 ! !----------------------------------------------------------- 1028 ! !---- Select the desired SDS ---- 1029 ! sds_id = sfselect(sd_id, sfn2index(sd_id, 'cloudWaterPath') ) 1030 ! write(stdout,*)' ' 1031 ! write(stdout,*) 'cloudWaterPath: sds_id=', sds_id 1032 ! if ( sds_id .eq. -1 ) then 1033 ! write(stdout,*) 'Error selecting the cloudWaterPath', sds_id 1034 ! call w3tage('BUFR_TRANTMI') 1035 ! call errexit(99) 1036 ! endif 1037 ! 1038 ! istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1039 ! 1040 ! write(stdout,*)' ' 1041 ! write(stdout,*) "name = ", name 1042 ! write(stdout,*) "rank = ", rank 1043 ! write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 1044 ! write(stdout,*) "data type is ", data_type 1045 ! write(stdout,*) "number of attributes is ", attributes 1046 ! 1047 ! npix = dim_sizes(1) 1048 ! nscan = dim_sizes(2) 1049 ! write(stdout,*)'npix,nscan=',npix,nscan 1050 ! 1051 ! !---- Read cloudWaterPath---- 1052 ! start2(1) = 0 1053 ! start2(2) =0 1054 ! 1055 ! stride2(1) = 1 1056 ! stride2(2) = 1 1057 ! 1058 ! edge2(1) = npix 1059 ! edge2(2) = nscan 1060 ! 1061 ! allocate ( intwater(npix,nscan) ) 1062 ! allocate ( clw(npix,nscan) ) 1063 ! 1064 ! istat = sfrdata(sds_id, start2, stride2, edge2, intwater) 1065 ! 1066 ! IF ( istat .ne. 0 ) THEN 1067 ! write(stdout,*) 'Error reading cloudWaterPath', istat 1068 ! call w3tage('BUFR_TRANTMI') 1069 ! call errexit(99) 1070 ! ENDIF 1071 ! 1072 ! istat = sfendacc(sds_id) 1073 ! IF ( istat .ne. 0 ) THEN 1074 ! write(stdout,*) 'Error ending cloudWaterPath', istat 1075 ! call w3tage('BUFR_TRANTMI') 1076 ! call errexit(99) 1077 ! ENDIF 1078 ! 1079 ! do jscan = 1,nscan 1080 ! do ipix = 1,npix 1081 ! clw(ipix,jscan) = float(intwater(ipix,jscan))/10. 1082 ! end do 1083 ! end do Page 20 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1084 ! 1085 ! deallocate(intwater) 1086 ! 1087 ! write(stdout,*) "*******cloud liquid water************" 1088 ! do jscan=1, 5 1089 ! do ipix=1, 5 1090 ! write(stdout,'(f5.2)') clw(ipix,jscan) 1091 ! end do 1092 ! end do 1093 1094 ! ! *********************************************************! 1095 ! ! Total cloud ice ! 1096 ! ! *********************************************************! 1097 ! ! cloud liquid water and cloud ice water are not available ! 1098 ! ! in TRMM V7 2A12 TMI profiling real time data ! 1099 ! ! 2A12.????-??-??T??-??-??Z.7.rt.gz ! 1100 ! ! turn this on when ingest other TRMM product with these ! 1101 ! ! 2 variables ! 1102 ! ! *********************************************************! 1103 ! ! 16-bit integer 1104 ! ! Number of attributes: 6 1105 ! ! Scale factor = 10 1106 ! ! Scale factor error = 0.0 1107 ! ! Add_offset= 0.0 1108 ! ! Add_offset_error = 0.0 1109 ! ! Calibrated_nt = 22 1110 ! ! Units = kg/m^2 1111 ! !----------------------------------------------------------- 1112 ! !---- Select the desired SDS ---- 1113 ! sds_id = sfselect(sd_id, sfn2index(sd_id, 'iceWaterPath') ) 1114 ! write(stdout,*)' ' 1115 ! write(stdout,*) 'iceWaterPath: sds_id=', sds_id 1116 ! if ( sds_id .eq. -1 ) then 1117 ! write(stdout,*) 'Error selecting the iceWaterPath', sds_id 1118 ! call w3tage('BUFR_TRANTMI') 1119 ! call errexit(99) 1120 ! endif 1121 ! 1122 ! istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1123 ! 1124 ! write(stdout,*)' ' 1125 ! write(stdout,*) "name = ", name 1126 ! write(stdout,*) "rank = ", rank 1127 ! write(stdout,*) "dimension sizes are : ", (dim_sizes(i), i=1, rank) 1128 ! write(stdout,*) "data type is ", data_type 1129 ! write(stdout,*) "number of attributes is ", attributes 1130 ! 1131 ! npix = dim_sizes(1) 1132 ! nscan = dim_sizes(2) 1133 ! write(stdout,*)'npix,nscan=',npix,nscan 1134 ! 1135 ! !---- Read cloud ice water ---- 1136 ! start2(1) = 0 1137 ! start2(2) =0 1138 ! 1139 ! stride2(1) = 1 1140 ! stride2(2) = 1 Page 21 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1141 ! 1142 ! edge2(1) = npix 1143 ! edge2(2) = nscan 1144 ! 1145 ! allocate ( intice(npix,nscan) ) 1146 ! allocate ( cli(npix,nscan) ) 1147 ! 1148 ! istat = sfrdata(sds_id, start2, stride2, edge2, intice) 1149 ! 1150 ! IF ( istat .ne. 0 ) THEN 1151 ! write(stdout,*) 'Error reading iceWaterPath', istat 1152 ! call w3tage('BUFR_TRANTMI') 1153 ! call errexit(99) 1154 ! ENDIF 1155 ! 1156 ! istat = sfendacc(sds_id) 1157 ! IF ( istat .ne. 0 ) THEN 1158 ! write(stdout,*) 'Error ending iceWaterPath', istat 1159 ! call w3tage('BUFR_TRANTMI') 1160 ! call errexit(99) 1161 ! ENDIF 1162 ! 1163 ! deallocate(intice) 1164 ! 1165 ! write(stdout,*) "*******cloud ice water************" 1166 ! do jscan=1, 5 1167 ! do ipix=1, 5 1168 ! write(stdout,'(f5.2)') cli(ipix,jscan) 1169 ! end do 1170 ! end do 1171 1172 ! Terminate access to the SD interface and close the file. 1173 istat = sfend(sd_id) 1174 if (istat .eq. FAIL) then 1175 istat=heprnt(0) 1176 else 1177 write(stdout,*)'...Reading TRMM V7 HDF file closed' 1178 print* 1179 end if 1180 1181 else 1182 ! Read TRMM V6 HDF file 1183 ! Open file to read VD (table) information 1184 file_id = hopen(infile,DFACC_READ,0) 1185 1186 ! Initialize the Vset interface 1187 istat = vfstart(file_id) 1188 1189 1190 ! Get the reference number for the first Vdata in the file 1191 vdata_ref=-1 1192 vdata_ref=vsfgid(file_id,vdata_ref) 1193 write(stdout,*)'after vsfgid, file_id,istat,vdata_ref=',file_id,istat,vdata_ref 1194 1195 ! Attach to the first Vdata in read mode. 1196 vdata_id=vsfatch(file_id,vdata_ref,'r') 1197 Page 22 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1198 ! Get the list of field names. 1199 istat = vsfinq(vdata_id,n_records,interlace,fields,vdata_size,vdata_name) 1200 1201 ! Get the class. 1202 istat = vsfgcls(vdata_id,vdata_class) 1203 1204 ! Determine the fields that will be read. 1205 istat = vsfsfld(vdata_id,'year,month,dayOfMonth,hour,minute,second,dayOfYear') 1206 write(stdout,*)'istat after vsfsfld is ',istat 1207 1208 if(istat.ne.0) then 1209 print *,'###### STOP 99 - CORRUPT FILE!!!' 1210 call w3tage('BUFR_TRANTMI') 1211 call errexit(99) 1212 endif 1213 1214 write(stdout,*)' current vdata name : ',vdata_name 1215 write(stdout,*)' current vdata class: ',vdata_class 1216 write(stdout,*)' vdata_size : ',vdata_size 1217 write(stdout,*)' n_records,interlace: ',n_records,interlace 1218 1219 allocate ( year(n_records) ) 1220 allocate ( doy(n_records) ) 1221 allocate ( month(n_records) ) 1222 allocate ( days(n_records) ) 1223 allocate ( hour(n_records) ) 1224 allocate ( min(n_records) ) 1225 allocate ( second(n_records) ) 1226 allocate ( databuf(n_records*vdata_size) ) 1227 1228 1229 ! Read data 1230 istat = vsfrd(vdata_id,databuf,n_records,FULL_INTERLACE) 1231 write(stdout,*)'after vsfrd, istat=',istat 1232 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'year',year) 1233 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'month',month) 1234 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'dayOfMonth',days) 1235 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'hour',hour) 1236 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'minute',min) 1237 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'second',second) 1238 istat = vsfnpak(vdata_id,HDF_VSUNPACK,fields,databuf,n_records*vdata_size,n_records,'dayOfYear',doy) 1239 1240 deallocate (databuf) 1241 ! write(stdout,*)'after vsfnpak, istat=',istat 1242 ! write(stdout,*)'year=',year 1243 1244 ! Detach from the Vdata, close the Vset interface and the file 1245 istat = vsfdtch(vdata_id) 1246 istat = vfend(file_id) 1247 istat = hclose(file_id) 1248 1249 1250 ! Open the file and initiate the SD interface 1251 sd_id = sfstart(infile, DFACC_READ) 1252 if (sd_id .eq. FAIL) then 1253 istat=heprnt(0) 1254 else Page 23 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1255 write(stdout,*) infile,' opened with READ access' 1256 end if 1257 1258 !Determine the contents of the file. 1259 istat = sffinfo(sd_id, n_datasets, n_file_attrs) 1260 write(stdout,*)'n_datasets =',n_datasets 1261 write(stdout,*)'n_file_attrs=',n_file_attrs 1262 write(stdout,*)' ' 1263 1264 !Access and print the names of every data set in the file. 1265 do index = 0, n_datasets - 1 1266 sds_id = sfselect(sd_id, index) 1267 1268 rank=0 1269 dim_sizes=0 1270 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1271 1272 write(stdout,*)' ' 1273 write(stdout,*)'index=',index 1274 write(stdout,*)'name = ', name 1275 write(stdout,*)'rank = ', rank 1276 write(stdout,*)'dim_sizes = ',dim_sizes 1277 write(stdout,*)'data_type = ',data_type 1278 write(stdout,*)'number of attributes = ', attributes 1279 1280 istat = sfendacc(sds_id) 1281 1282 end do 1283 1284 !Get geolocation information (field 0) 1285 ! sds_id = sfselect(sd_id,0) 1286 sds_id = sfselect(sd_id, sfn2index(sd_id, 'geolocation')) 1287 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1288 write(stdout,*)' ' 1289 write(stdout,*)'name=',name 1290 write(stdout,*)'rank=',rank 1291 write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1292 write(stdout,*)'data_type =',data_type 1293 1294 nvariable = dim_sizes(1) 1295 npix = dim_sizes(2) 1296 nscan = dim_sizes(3) 1297 write(stdout,*)'nvariable,npix,nscan=',nvariable,npix,nscan 1298 1299 allocate ( geolocat(nvariable,npix,nscan) ) 1300 allocate ( rlat(npix,nscan) ) 1301 allocate ( rlon(npix,nscan) ) 1302 1303 start3=0 1304 stride3=1 1305 edge3(1)=nvariable 1306 edge3(2)=npix 1307 edge3(3)=nscan 1308 istat = sfrdata(sds_id, start3, stride3, edge3, geolocat) 1309 write(stdout,*)'after sfrdata with istat=',istat 1310 do jscan = 1,nscan 1311 do ipix = 1,npix Page 24 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1312 rlat(ipix,jscan) = geolocat(1,ipix,jscan)/100. 1313 rlon(ipix,jscan) = geolocat(2,ipix,jscan)/100. 1314 ! Corrected to properly encode longitude as -180. to +180. (E+, W-) 1315 ! in BUFR 1316 !DAK if (rlon(ipix,jscan).lt.0.) rlon(ipix,jscan)=rlon(ipix,jscan) + 360. 1317 end do 1318 end do 1319 deallocate(geolocat) 1320 1321 ! 1322 ! Extract rain flag (field 1) 1323 ! dim_sizes=0 1324 ! sds_id = sfselect(sd_id,1) 1325 ! istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1326 ! write(stdout,*)' ' 1327 ! write(stdout,*)'name=',name 1328 ! write(stdout,*)'rank=',rank 1329 ! write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1330 ! write(stdout,*)'data_type =',data_type 1331 1332 ! npix = dim_sizes(1) 1333 ! nscan = dim_sizes(2) 1334 ! write(stdout,*)'npix,nscan=',npix,nscan 1335 1336 ! allocate ( sfcflag(npix,nscan) ) 1337 ! allocate ( rainflag(npix,nscan) ) 1338 1339 ! start2=0 1340 ! stride2=1 1341 ! edge2(1)=npix 1342 ! edge2(2)=nscan 1343 ! istat = sfrdata(sds_id, start2, stride2, edge2, sfcrain) 1344 ! write(stdout,*)'after sfrdata with istat=',istat 1345 ! rainflag=rmiss 1346 ! if (istat==0) then 1347 ! do jscan = 1,nscan 1348 ! do ipix = 1,npix 1349 ! rainflag(ipix,jscan) = float(sfcflag(ipix,jscan)) 1350 ! end do 1351 ! end do 1352 ! endif 1353 ! deallocate(sfcflag) 1354 1355 ! 1356 ! Extract surface rain rate (field 2) 1357 dim_sizes=0 1358 ! sds_id = sfselect(sd_id,2) 1359 sds_id = sfselect(sd_id, sfn2index(sd_id, 'surfaceRain')) 1360 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1361 write(stdout,*)' ' 1362 write(stdout,*)'name=',name 1363 write(stdout,*)'rank=',rank 1364 write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1365 write(stdout,*)'data_type =',data_type 1366 1367 npix = dim_sizes(1) 1368 nscan = dim_sizes(2) Page 25 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1369 write(stdout,*)'npix,nscan=',npix,nscan 1370 1371 allocate ( sfcrain(npix,nscan) ) 1372 allocate ( rainrate(npix,nscan) ) 1373 1374 start2=0 1375 stride2=1 1376 edge2(1)=npix 1377 edge2(2)=nscan 1378 istat = sfrdata(sds_id, start2, stride2, edge2, sfcrain) 1379 write(stdout,*)'after sfrdata with istat=',istat 1380 do jscan = 1,nscan 1381 do ipix = 1,npix 1382 rainrate(ipix,jscan) = float(sfcrain(ipix,jscan))/10. 1383 end do 1384 end do 1385 deallocate(sfcrain) 1386 1387 ! 1388 ! Extract convective rain (field 3) 1389 dim_sizes=0 1390 ! sds_id = sfselect(sd_id,3) 1391 sds_id = sfselect(sd_id, sfn2index(sd_id, 'convectRain')) 1392 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1393 write(stdout,*)' ' 1394 write(stdout,*)'name=',name 1395 write(stdout,*)'rank=',rank 1396 write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1397 write(stdout,*)'data_type =',data_type 1398 1399 npix = dim_sizes(1) 1400 nscan = dim_sizes(2) 1401 write(stdout,*)'npix,nscan=',npix,nscan 1402 1403 allocate ( cvcrain(npix,nscan) ) 1404 allocate ( convect(npix,nscan) ) 1405 1406 start2=0 1407 stride2=1 1408 edge2(1)=npix 1409 edge2(2)=nscan 1410 istat = sfrdata(sds_id, start2, stride2, edge2, cvcrain) 1411 write(stdout,*)'after sfrdata with istat=',istat 1412 do jscan = 1,nscan 1413 do ipix = 1,npix 1414 convect(ipix,jscan) = float(cvcrain(ipix,jscan))/10. 1415 end do 1416 end do 1417 deallocate (cvcrain) 1418 1419 ! 1420 ! Extract total cloud liquid water (field 4) 1421 dim_sizes=0 1422 ! sds_id = sfselect(sd_id,4) 1423 sds_id = sfselect(sd_id, sfn2index(sd_id, 'cldWater')) 1424 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1425 write(stdout,*)' ' Page 26 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1426 write(stdout,*)'name=',name 1427 write(stdout,*)'rank=',rank 1428 write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1429 write(stdout,*)'data_type =',data_type 1430 1431 npix = dim_sizes(1) 1432 nscan = dim_sizes(2) 1433 write(stdout,*)'npix,nscan=',npix,nscan 1434 1435 allocate ( intwater(npix,nscan) ) 1436 allocate ( clw(npix,nscan) ) 1437 1438 start2=0 1439 stride2=1 1440 edge2(1)=npix 1441 edge2(2)=nscan 1442 istat = sfrdata(sds_id, start2, stride2, edge2, intwater) 1443 write(stdout,*)'after sfrdata with istat=',istat 1444 do jscan = 1,nscan 1445 do ipix = 1,npix 1446 clw(ipix,jscan) = float(intwater(ipix,jscan))/1000. 1447 end do 1448 end do 1449 deallocate (intwater) 1450 1451 1452 ! 1453 ! Extract total cloud ice (field 5) 1454 dim_sizes=0 1455 ! sds_id = sfselect(sd_id,5) 1456 sds_id = sfselect(sd_id, sfn2index(sd_id, 'precipIce')) 1457 istat = sfginfo(sds_id, name, rank, dim_sizes, data_type, attributes) 1458 write(stdout,*)' ' 1459 write(stdout,*)'name=',name 1460 write(stdout,*)'rank=',rank 1461 write(stdout,*)'dim_sizes=',(dim_sizes(i),i=1,rank) 1462 write(stdout,*)'data_type =',data_type 1463 1464 npix = dim_sizes(1) 1465 nscan = dim_sizes(2) 1466 write(stdout,*)'npix,nscan=',npix,nscan 1467 1468 allocate ( intice(npix,nscan) ) 1469 allocate ( cli(npix,nscan) ) 1470 1471 start2=0 1472 stride2=1 1473 edge2(1)=npix 1474 edge2(2)=nscan 1475 istat = sfrdata(sds_id, start2, stride2, edge2, intice) 1476 write(stdout,*)'after sfrdata with istat=',istat 1477 do jscan = 1,nscan 1478 do ipix = 1,npix 1479 cli(ipix,jscan) = float(intice(ipix,jscan))/1000. 1480 end do 1481 end do 1482 deallocate (intice) Page 27 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1483 1484 ! Terminate access to the SD interface and close the file. 1485 istat = sfend(sd_id) 1486 if (istat .eq. FAIL) then 1487 istat=heprnt(0) 1488 else 1489 print*,'... file closed' 1490 print* 1491 end if 1492 1493 end if !end if reading variables from TRMM V7 HDF file 1494 1495 1496 ! Loop over records in data file.. Extract observation times. 1497 allocate ( time2(nscan) ) 1498 ifirst=1 1499 do j=1,nscan 1500 1501 ! Generate date/time stamp for output obs file. 1502 ! Periodically echo date/time stamp to stdout. 1503 iyr = year(j) 1504 imo = month(j) 1505 idy = days(j) 1506 ihr = hour(j) 1507 imn = min(j) 1508 isc = second(j) 1509 idate2 = 100000000*iyr + 1000000*imo + 10000*idy + 100*ihr + imn 1510 ! time2(j) = 3600*ihr + 60*imn + isc 1511 if (j==1 .and. ifirst==1) then 1512 write(stdout,*)'1st date: ',kx,iyr,imo,idy,ihr,imn,isc 1513 idate1 = idate2 1514 ifirst = 0 1515 endif 1516 if (mod(j,100).eq.0) & 1517 write(stdout,*)'date: ',kx,iyr,imo,idy,ihr,imn,isc 1518 ! 1519 end do 1520 1521 if(.NOT. found_trmm_v6) then 1522 write(stdout,*)'trmm v7 allocate missing clw cli, npix nscan: ', npix, nscan 1523 allocate ( clw(npix,nscan) ) 1524 allocate ( cli(npix,nscan) ) 1525 1526 !set cloud liquid water and cloud ice water to missing value 1527 !since they are not available in trmm V7 real time data 1528 clw = 10E10 1529 cli = 10E10 1530 1531 end if 1532 1533 1534 if(found_trmm_v6) then 1535 !quality flag not available in trmm v6, set all to 0 1536 allocate ( quality_flag(npix,nscan) ) 1537 quality_flag = 0.0 1538 end if 1539 Page 28 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1540 ! Write data to observation file 1541 do j = 1,nscan 1542 ibad = 0 1543 do i = 1,npix 1544 nobs = nobs + 1 1545 ! if(rainrate(i,j) .lt. 0.0) ibad=1 1546 if((rainrate(i,j) .lt. 0.0) .or. (quality_flag(i,j) .ne. 0)) ibad=1 1547 nbad = nbad + ibad 1548 if (ibad==0) then 1549 ngood = ngood + 1 1550 idata(1) = kx ! satellite id 1551 idata(2) = year(j) ! observation year 1552 idata(3) = month(j) ! observation month 1553 idata(4) = days(j) ! observation day 1554 idata(5) = hour(j) ! observation hour 1555 idata(6) = min(j) ! observation minute 1556 idata(7) = second(j) ! observation second 1557 1558 rdata(1) = rlat(i,j) ! observation latitude (deg. N+,S-) 1559 rdata(2) = rlon(i,j) ! observation longitude (deg. E+,W-) 1560 rdata(3)= rainrate(i,j) ! total rain rate (mm/hr) 1561 rdata(4)= convect(i,j) ! convective rain rate (mm/hr) 1562 rdata(5)= clw(i,j) ! rain+cloud liquid water (mm) 1563 rdata(6)= cli(i,j) ! precipitation+cloud ice (mm) 1564 1565 call buftrm(lubufr,subset,nint,nreal,idata,rdata) 1566 1567 ! write(statid,'(i8)') ngood 1568 ! write(lungrd) statid,rlat(i,j),rlon(i,j),rtim,nlev,nflag 1569 ! write(lungrd) (rdata(k),k=1,13) 1570 1571 endif 1572 end do 1573 end do 1574 1575 nquality_bad=0 1576 1577 if(.not. found_trmm_v6) then 1578 do j = 1,nscan 1579 ibad = 0 1580 do i = 1,npix 1581 if((rainrate(i,j).ge.0.) .and. (quality_flag(i,j) .ne. 0)) then 1582 nquality_bad = nquality_bad + 1 1583 end if 1584 end do 1585 end do 1586 end if 1587 1588 ! Compute stats for data 1589 npts = nscan*npix 1590 call stats(rainrate,npts,fmin,fmax,favg,fmad,fsdv,rmiss,nmiss) 1591 write(stdout,100)'rainrate',npts,nmiss,favg,fmad,fsdv,fmin,fmax 1592 1593 !100 format(a8,1x,2(i8,1x),5(f8.4,1x)) 1594 100 format(a8,1x,2(i8,1x),5(g13.6,1x)) 1595 1596 call stats(convect,npts,fmin,fmax,favg,fmad,fsdv,rmiss,nmiss) Page 29 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1597 write(stdout,100)'convect',npts,nmiss,favg,fmad,fsdv,fmin,fmax 1598 1599 if(found_trmm_v6) then 1600 call stats(clw,npts,fmin,fmax,favg,fmad,fsdv,rmiss,nmiss) 1601 write(stdout,100)'clw',npts,nmiss,favg,fmad,fsdv,fmin,fmax 1602 1603 call stats(cli,npts,fmin,fmax,favg,fmad,fsdv,rmiss,nmiss) 1604 write(stdout,100)'cli',npts,nmiss,favg,fmad,fsdv,fmin,fmax 1605 1606 end if 1607 1608 ! Deallocate allocated arrays 1609 deallocate (rlat,rlon,rainrate,convect,clw,cli) 1610 deallocate (year,month,days,hour,min,second) 1611 deallocate (time2) 1612 1613 write(stdout,*)' ' 1614 write(stdout,*)'npix, nscan=',npix, nscan 1615 write(stdout,*)'number of obs read, bad, good is ',nobs,nbad,ngood 1616 write(stdout,*)'******number of obs with bad quality falg (not 0) ', nquality_bad 1617 1618 ! Close bufr file 1619 call closbf(lubufr) 1620 1621 ! Write terminator record to grads file 1622 ! statid = 'last' 1623 ! write(lungrd) statid,xlat0,xlon0,rtim0,nlev0,nflag0 1624 ! write(lundat1,1000) idate1 1625 ! write(lundat2,1000) idate2 1626 1627 1000 format(i12) 1628 1629 ! Call w3tage 1630 call w3tage('BUFR_TRANTMI') 1631 1632 !End of program 1633 stop 1634 end Page 30 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Entry Points trantmi.f90 ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 1594 1591,1597,1601,1604 1000 Label 1627 ARRAY_DATA Local 110 I(2) 2 2 50 ATTRIBUTES Local 97 I(4) 4 scalar 258,266,287,295,337,345,387,395,44 4,452,495,503,545,553,601,609,675, 683,804,812,868,876,950,958,1270,1 278,1287,1360,1392,1424,1457 BUFR_TRANTMI Prog 1 BUFTRM Subr 1565 1565 CLI Local 138 R(4) 4 2 1 ALC 1469,1479,1524,1529,1563,1603,1609 CLOSBF Subr 1619 1619 CLW Local 138 R(4) 4 2 1 ALC 1436,1446,1523,1528,1562,1600,1609 CONVECT Local 138 R(4) 4 2 1 ALC 976,995,1005,1404,1414,1561,1596,1 609 CVCRAIN Local 134 I(2) 2 2 1 ALC 975,978,995,999,1403,1410,1414,141 7 DATABUF Local 129 I(4) 4 1 1 ALC 1226,1230,1232,1233,1234,1235,1236 ,1237,1238,1240 DATA_QUALITY Local 132 I(1) 1 1 1 ALC DATA_TYPE Local 97 I(4) 4 scalar 258,265,287,294,337,344,387,394,44 4,451,495,502,545,552,601,608,675, 682,804,811,868,875,950,957,1270,1 277,1287,1292,1360,1365,1392,1397, 1424,1429,1457,1462 DAYS Local 131 I(1) 1 1 1 ALC 405,406,1222,1234,1505,1553,1610 DEBUG Param 82 I(4) 4 scalar 289,339,389,446,497,547,603,645,67 7,727,806,870,919,952,1001 DFACC_CREATE Param 74 I(4) 4 scalar DFACC_READ Param 74 I(4) 4 scalar 192,239,1184,1251 DFNT_INT16 Param 74 I(4) 4 scalar DIM0 Param 75 I(4) 4 scalar 110,111 DIM1 Param 75 I(4) 4 scalar 110,111 DIM_SIZES Local 109 I(4) 4 1 5 257,258,264,287,293,298,337,343,34 8,387,393,398,444,450,455,495,501, 506,545,551,556,601,607,612,613,67 5,681,686,687,804,810,815,816,868, 874,879,880,950,956,961,962,1269,1 270,1276,1287,1291,1294,1295,1296, 1357,1360,1364,1367,1368,1389,1392 ,1396,1399,1400,1421,1424,1428,143 1,1432,1454,1457,1461,1464,1465 DOY Local 130 I(2) 2 1 1 ALC 1220,1238 EDGE Local 118 I(4) 4 1 3 EDGE1 Local 119 I(4) 4 scalar 303,306,353,356,403,406,460,463,51 Page 31 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1,514,561,564 EDGE2 Local 120 I(4) 4 1 2 622,623,628,696,697,702,825,826,83 0,890,891,896,972,973,978,1376,137 7,1378,1408,1409,1410,1440,1441,14 42,1473,1474,1475 EDGE3 Local 101 I(4) 4 1 3 1305,1306,1307,1308 ERREXIT Subr 284 284,311,318,334,361,368,384,411,41 8,424,441,468,475,492,519,526,542, 569,576,598,633,640,672,707,714,80 1,835,842,865,901,908,947,983,990, 1211 FAIL Param 75 I(4) 4 scalar 240,1174,1252,1486 FAVG Local 123 R(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 FIELDS Local 88 CHAR 60 scalar 1199,1232,1233,1234,1235,1236,1237 ,1238 FILE_ID Local 93 I(4) 4 scalar 192,195,209,213,235,1184,1187,1192 ,1193,1196,1246,1247 FLOAT Func 913 scalar 913,995,1382,1414,1446,1479 FMAD Local 123 R(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 FMAX Local 123 R(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 FMIN Local 123 R(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 FOUND_TRMM_V6 Local 121 L(4) 4 scalar 205,216,224,232,1521,1534,1577,159 9 FSDV Local 123 R(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 FULL_INTERLACE Param 76 I(4) 4 scalar 1230 GEOLOCAT Local 137 I(2) 2 3 1 ALC 1299,1308,1312,1313,1319 HCLOSE Func 107 I(4) 4 scalar 1247 HDF_VSUNPACK Param 76 I(4) 4 scalar 1232,1233,1234,1235,1236,1237,1238 HEPRNT Func 112 I(4) 4 scalar 241,1175,1253,1487 HOPEN Func 106 I(4) 4 scalar 192,1184 HOUR Local 131 I(1) 1 1 1 ALC 462,463,1223,1235,1506,1554,1610 I Local 100 I(4) 4 scalar 264,293,343,393,450,501,551,607,68 1,810,874,956,1291,1364,1396,1428, 1461,1543,1546,1558,1559,1560,1561 ,1562,1563,1580,1581 IBAD Local 114 I(4) 4 scalar 1542,1546,1547,1548,1579 IDATA Local 116 I(4) 4 1 7 1550,1551,1552,1553,1554,1555,1556 ,1565 IDATE1 Local 117 I(8) 8 scalar 1513 IDATE2 Local 117 I(8) 8 scalar 1509,1513 IDY Local 114 I(4) 4 scalar 1505,1509,1512,1517 IFIRST Local 114 I(4) 4 scalar 1498,1511,1514 IHR Local 114 I(4) 4 scalar 1506,1509,1512,1517 II Local 100 I(4) 4 scalar ILAT Local 136 I(2) 2 2 1 ALC 625,628,643 ILON Local 136 I(2) 2 2 1 ALC 699,702,717 IMN Local 114 I(4) 4 scalar 1507,1509,1512,1517 IMO Local 114 I(4) 4 scalar 1504,1509,1512,1517 INDEX Local 95 I(4) 4 scalar 253,254,261,1265,1266,1273 INFILE Local 85 CHAR 7 scalar 150,192,239,243,1184,1251,1255 Page 32 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References INTERLACE Local 94 I(4) 4 scalar 1199,1217 INTICE Local 134 I(2) 2 2 1 ALC 1468,1475,1479,1482 INTWATER Local 134 I(2) 2 2 1 ALC 1435,1442,1446,1449 IOFF Local 73 I(4) 4 scalar IPIX Local 100 I(4) 4 scalar 647,648,720,721,722,729,730,912,91 3,922,923,994,995,1004,1005,1311,1 312,1313,1381,1382,1413,1414,1445, 1446,1478,1479 ISC Local 114 I(4) 4 scalar 1508,1512,1517 ISTAT Local 97 I(4) 4 scalar 195,214,215,234,235,241,247,258,26 8,287,306,308,309,314,315,316,337, 356,358,359,364,365,366,387,406,40 8,409,414,415,416,421,422,444,463, 465,466,471,472,473,495,514,516,51 7,522,523,524,545,564,566,567,572, 573,574,601,628,630,631,636,637,63 8,675,702,704,705,710,711,712,804, 830,832,833,838,839,840,868,896,89 8,899,904,905,906,950,978,980,981, 986,987,988,1173,1174,1175,1187,11 93,1199,1202,1205,1206,1208,1230,1 231,1232,1233,1234,1235,1236,1237, 1238,1245,1246,1247,1253,1259,1270 ,1280,1287,1308,1309,1360,1378,137 9,1392,1410,1411,1424,1442,1443,14 57,1475,1476,1485,1486,1487 IYR Local 114 I(4) 4 scalar 1503,1509,1512,1517 I_LAT Local 96 I(4) 4 scalar I_LON Local 96 I(4) 4 scalar J Local 100 I(4) 4 scalar 1499,1503,1504,1505,1506,1507,1508 ,1511,1516,1541,1546,1551,1552,155 3,1554,1555,1556,1558,1559,1560,15 61,1562,1563,1578,1581 JJ Local 100 I(4) 4 scalar JSCAN Local 100 I(4) 4 scalar 646,648,719,721,722,728,730,911,91 3,921,923,993,995,1003,1005,1310,1 312,1313,1380,1382,1412,1414,1444, 1446,1477,1479 K Local 100 I(4) 4 scalar KX Local 114 I(4) 4 scalar 149,1512,1517,1550 LUBUFR Local 113 I(4) 4 scalar 144,179,1565,1619 LUNDAT1 Local 113 I(4) 4 scalar 146 LUNDAT2 Local 113 I(4) 4 scalar 146 LUNDX Local 113 I(4) 4 scalar 144,179 LUNGRD Local 113 I(4) 4 scalar 145 MAX_VAR_DIMS Param 75 I(4) 4 scalar 109 MIN Local 131 I(1) 1 1 1 ALC 513,514,1224,1236,1507,1555,1610 MOD Func 1516 scalar 1516 MONTH Local 131 I(1) 1 1 1 ALC 355,356,1221,1233,1504,1552,1610 NAME Local 89 CHAR 64 scalar 258,262,287,291,337,341,387,391,44 4,448,495,499,545,549,601,605,675, 679,804,808,868,872,950,954,1270,1 274,1287,1289,1360,1362,1392,1394, 1424,1426,1457,1459 NBAD Local 114 I(4) 4 scalar 166,1547,1615 Page 33 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NEW_ARRAY Local 111 I(2) 2 2 50 NFLAG Local 115 I(4) 4 scalar 167 NFLAG0 Local 115 I(4) 4 scalar 169 NGOOD Local 114 I(4) 4 scalar 166,1549,1615 NINT Param 73 I(4) 4 scalar 116,1565 NLEV Local 115 I(4) 4 scalar 168 NLEV0 Local 115 I(4) 4 scalar 170 NMISS Local 115 I(4) 4 scalar 1590,1591,1596,1597,1600,1601,1603 ,1604 NOBS Local 114 I(4) 4 scalar 166,1544,1615 NPIX Local 97 I(4) 4 scalar 612,622,625,626,686,696,699,700,72 0,815,825,828,879,881,890,893,894, 912,961,963,972,975,976,994,1295,1 297,1299,1300,1301,1306,1311,1367, 1369,1371,1372,1376,1381,1399,1401 ,1403,1404,1408,1413,1431,1433,143 5,1436,1440,1445,1464,1466,1468,14 69,1473,1478,1522,1523,1524,1536,1 543,1580,1589,1614 NPTS Local 115 I(4) 4 scalar 1589,1590,1591,1596,1597,1600,1601 ,1603,1604 NQUALITY_BAD Local 126 I(4) 4 scalar 1575,1582,1616 NREAL Param 73 I(4) 4 scalar 124,1565 NSCAN Local 97 I(4) 4 scalar 298,303,305,348,353,355,398,403,40 5,455,460,462,506,511,513,556,561, 563,613,623,625,626,687,697,699,70 0,719,816,826,828,880,881,891,893, 894,911,962,963,973,975,976,993,12 96,1297,1299,1300,1301,1307,1310,1 368,1369,1371,1372,1377,1380,1400, 1401,1403,1404,1409,1412,1432,1433 ,1435,1436,1441,1444,1465,1466,146 8,1469,1474,1477,1497,1499,1522,15 23,1524,1536,1541,1578,1589,1614 NVARIABLE Local 97 I(4) 4 scalar 1294,1297,1299,1305 N_DATASETS Local 95 I(4) 4 scalar 247,248,253,1259,1260,1265 N_FILE_ATTRS Local 95 I(4) 4 scalar 247,249,1259,1261 N_RECORDS Local 94 I(4) 4 scalar 1199,1217,1219,1220,1221,1222,1223 ,1224,1225,1226,1230,1232,1233,123 4,1235,1236,1237,1238 OPENBF Subr 179 179 OUTER Label 208 scalar 217,222 QUALITY_FLAG Local 135 I(2) 2 2 1 ALC 828,830,1536,1537,1546,1581 RAINFLAG Local 138 R(4) 4 2 1 ALC RAINRATE Local 138 R(4) 4 2 1 ALC 894,913,923,1372,1382,1546,1560,15 81,1590,1609 RANK Local 95 I(4) 4 scalar 256,258,263,264,287,292,293,337,34 2,343,387,392,393,444,449,450,495, 500,501,545,550,551,601,606,607,67 5,680,681,804,809,810,868,873,874, 950,955,956,1268,1270,1275,1287,12 90,1291,1360,1363,1364,1392,1395,1 396,1424,1427,1428,1457,1460,1461 RDATA Local 124 R(4) 4 1 6 1558,1559,1560,1561,1562,1563,1565 RLAT Local 138 R(4) 4 2 1 ALC 626,643,648,1300,1312,1558,1609 Page 34 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References RLON Local 138 R(4) 4 2 1 ALC 700,717,721,722,730,1301,1313,1559 ,1609 RMISS Local 123 R(4) 4 scalar 152,1590,1596,1600,1603 RTIM Local 124 R(4) 4 scalar 171 RTIM0 Local 124 R(4) 4 scalar 172 SDS_ID Local 92 I(4) 4 scalar 254,258,268,278,280,281,282,287,30 6,314,328,330,331,332,337,356,364, 378,380,381,382,387,406,414,435,43 7,438,439,444,463,471,485,488,489, 490,495,514,522,536,538,539,540,54 5,564,572,591,594,595,596,601,628, 636,665,668,669,670,675,702,710,79 4,797,798,799,804,830,838,858,861, 862,863,868,896,904,940,943,944,94 5,950,978,986,1266,1270,1280,1286, 1287,1308,1359,1360,1378,1391,1392 ,1410,1423,1424,1442,1456,1457,147 5 SD_ID Local 92 I(4) 4 scalar 239,240,247,254,278,328,378,435,48 5,536,591,665,794,858,940,1173,125 1,1252,1259,1266,1286,1359,1391,14 23,1456,1485 SD_INDEX Local 92 I(4) 4 scalar SECOND Local 131 I(1) 1 1 1 ALC 563,564,1225,1237,1508,1556,1610 SFCFLAG Local 133 I(1) 1 2 1 ALC SFCRAIN Local 134 I(2) 2 2 1 ALC 893,896,913,917,1371,1378,1382,138 5 SFCREATE Local 102 I(4) 4 scalar SFEND Func 102 I(4) 4 scalar 1173,1485 SFENDACC Func 102 I(4) 4 scalar 268,314,364,414,471,522,572,636,71 0,838,904,986,1280 SFFINFO Func 103 I(4) 4 scalar 247,1259 SFGETINFO Local 103 I(4) 4 scalar SFGINFO Func 103 I(4) 4 scalar 258,287,337,387,444,495,545,601,67 5,804,868,950,1270,1287,1360,1392, 1424,1457 SFN2INDEX Func 105 I(4) 4 scalar 278,328,378,435,485,536,591,665,79 4,858,940,1286,1359,1391,1423,1456 SFRDATA Func 103 I(4) 4 scalar 306,356,406,463,514,564,628,702,83 0,896,978,1308,1378,1410,1442,1475 SFREADDATA Local 104 I(4) 4 scalar SFSELECT Func 103 I(4) 4 scalar 254,278,328,378,435,485,536,591,66 5,794,858,940,1266,1286,1359,1391, 1423,1456 SFSTART Func 102 I(4) 4 scalar 239,1251 SFWDATA Local 102 I(4) 4 scalar START Local 118 I(4) 4 1 3 START1 Local 119 I(4) 4 scalar 301,306,351,356,401,406,458,463,50 9,514,559,564 START2 Local 120 I(4) 4 1 2 616,617,628,690,691,702,819,820,83 0,884,885,896,966,967,978,1374,137 8,1406,1410,1438,1442,1471,1475 START3 Local 101 I(4) 4 1 3 1303,1308 STATID Local 86 CHAR 8 scalar STATS Subr 1590 1590,1596,1600,1603 Page 35 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References STDOUT Local 113 I(4) 4 scalar 143,161,162,163,225,227,243,248,24 9,250,260,261,262,263,264,265,266, 279,280,282,290,291,292,293,294,29 5,309,316,329,330,332,340,341,342, 343,344,345,359,366,379,380,382,39 0,391,392,393,394,395,409,416,422, 436,437,439,447,448,449,450,451,45 2,466,473,487,488,490,498,499,500, 501,502,503,517,524,537,538,540,54 8,549,550,551,552,553,567,574,593, 594,596,604,605,606,607,608,609,63 1,638,648,667,668,670,678,679,680, 681,682,683,705,712,730,796,797,79 9,807,808,809,810,811,812,833,840, 860,861,863,871,872,873,874,875,87 6,881,899,906,920,923,942,943,945, 953,954,955,956,957,958,963,981,98 8,1002,1005,1177,1193,1206,1214,12 15,1216,1217,1231,1255,1260,1261,1 262,1272,1273,1274,1275,1276,1277, 1278,1288,1289,1290,1291,1292,1297 ,1309,1361,1362,1363,1364,1365,136 9,1379,1393,1394,1395,1396,1397,14 01,1411,1425,1426,1427,1428,1429,1 433,1443,1458,1459,1460,1461,1462, 1466,1476,1512,1517,1522,1591,1597 ,1601,1604,1613,1614,1615,1616 STRIDE Local 118 I(4) 4 1 3 STRIDE1 Local 119 I(4) 4 scalar 302,306,352,356,402,406,459,463,51 0,514,560,564 STRIDE2 Local 120 I(4) 4 1 2 619,620,628,693,694,702,822,823,83 0,887,888,896,969,970,978,1375,137 8,1407,1410,1439,1442,1472,1475 STRIDE3 Local 101 I(4) 4 1 3 1304,1308 SUBSET Local 86 CHAR 8 scalar 151,1565 TIME2 Local 139 R(4) 4 1 1 ALC 1497,1611 VDATA_CLASS Local 90 CHAR 4 scalar 1202,1215 VDATA_ID Local 93 I(4) 4 scalar 213,214,234,1196,1199,1202,1205,12 30,1232,1233,1234,1235,1236,1237,1 238,1245 VDATA_INDEX Local 93 I(4) 4 scalar 206,220,227 VDATA_NAME Local 87 CHAR 30 scalar 1199,1214 VDATA_REF Local 93 I(4) 4 scalar 198,209,210,213,1191,1192,1193,119 6 VDATA_SIZE Local 94 I(4) 4 scalar 1199,1216,1226,1232,1233,1234,1235 ,1236,1237,1238 VFEND Func 107 I(4) 4 scalar 235,1246 VFSTART Func 107 I(4) 4 scalar 195,1187 VSFATCH Func 106 I(4) 4 scalar 213,1196 VSFDTCH Func 107 I(4) 4 scalar 234,1245 VSFEX Func 106 I(4) 4 scalar 214 VSFGCLS Func 106 I(4) 4 scalar 1202 VSFGID Func 106 I(4) 4 scalar 209,1192 VSFINQ Func 106 I(4) 4 scalar 1199 VSFNPAK Func 107 I(4) 4 scalar 1232,1233,1234,1235,1236,1237,1238 Page 36 Source Listing BUFR_TRANTMI 2013-01-11 18:32 Symbol Table trantmi.f90 Name Object Declared Type Bytes Dimen Elements Attributes References VSFRD Func 108 I(4) 4 scalar 1230 VSFREAD Local 107 I(4) 4 scalar VSFSFLD Func 106 I(4) 4 scalar 1205 W3TAGB Subr 159 159 W3TAGE Subr 283 283,310,317,333,360,367,383,410,41 7,423,440,467,474,491,518,525,541, 568,575,597,632,639,671,706,713,80 0,834,841,864,900,907,946,982,989, 1210,1630 XLAT0 Local 124 R(4) 4 scalar 173 XLON0 Local 124 R(4) 4 scalar 174 YEAR Local 130 I(2) 2 1 1 ALC 305,306,1219,1232,1503,1551,1610 Page 37 Source Listing BUFR_TRANTMI 2013-01-11 18:32 trantmi.f90 1635 1636 1637 ! 1638 ! Add Larry Sager routine to encode output in BUFR. 1639 1640 SUBROUTINE BUFTRM(LUBFR,SUBSET,nint,NREAL,idata,rdata) 1641 1642 PARAMETER(NDAT=100) 1643 1644 CHARACTER*8 SUBSET 1645 integer idata(nint) 1646 REAL*4 RDATA(NREAL) 1647 REAL*8 BUFRF(NDAT) 1648 1649 !----------------------------------------------------------------------- 1650 !----------------------------------------------------------------------- 1651 1652 ! TRANSLATE THE TRMM RECORD TO BUFR FORMAT 1653 ! ------------------------------------------------------------ 1654 ! NC012013 | SAID YEAR MNTH DAYS HOUR MINU 1655 ! NC012013 | SECO CLAT CLON TRRT CRRT RCWA 1656 ! NC012013 | PCIA 1657 ! ------------------------------------------------------------ 1658 1659 bufrf = 0.0 1660 BUFRF( 1) = idata(1) ! satellite id 1661 BUFRF( 2) = idata(2) ! year 1662 BUFRF( 3) = idata(3) ! month 1663 BUFRF( 4) = idata(4) ! days 1664 BUFRF( 5) = idata(5) ! hour 1665 BUFRF( 6) = idata(6) ! minute 1666 BUFRF( 7) = idata(7) ! second 1667 BUFRF( 8) = RDATA(1) ! latitude (N+, S-) 1668 BUFRF( 9) = RDATA(2) ! longitude (-180 to +180, W-, E+) 1669 BUFRF(10) = RDATA(3) ! total rain rate 1670 BUFRF(11) = RDATA(4) ! convective rain rate 1671 BUFRF(12) = RDATA(5) ! rain+cloud liquid water 1672 BUFRF(13) = RDATA(6) ! precipitation+cloud ice 1673 1674 1675 !C WRITE THIS ARRAY INTO BUFR 1676 !C -------------------------- 1677 iyr=idata(2) 1678 imo=idata(3) 1679 idy=idata(4) 1680 ihr=idata(5) 1681 IDATE = IYR*1000000+IMO*10000+IDY*100+IHR 1682 CALL OPENMB(LUBFR,SUBSET,IDATE) 1683 CALL UFBSEQ(LUBFR,BUFRF,NDAT,1,IRET,SUBSET) 1684 CALL WRITSB(LUBFR) 1685 1686 !C EXIT HERE 1687 !C --------- 1688 1689 RETURN 1690 END Page 38 Source Listing BUFTRM 2013-01-11 18:32 Entry Points trantmi.f90 ENTRY POINTS Name buftrm_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References BUFRF Local 1647 R(8) 8 1 100 1659,1660,1661,1662,1663,1664,1665 ,1666,1667,1668,1669,1670,1671,167 2,1683 BUFTRM Subr 1640 IDATA Dummy 1640 I(4) 4 1 0 ARG,INOUT 1660,1661,1662,1663,1664,1665,1666 ,1677,1678,1679,1680 IDATE Local 1681 I(4) 4 scalar 1681,1682 IDY Local 1679 I(4) 4 scalar 1679,1681 IHR Local 1680 I(4) 4 scalar 1680,1681 IMO Local 1678 I(4) 4 scalar 1678,1681 IRET Local 1683 I(4) 4 scalar 1683 IYR Local 1677 I(4) 4 scalar 1677,1681 LUBFR Dummy 1640 I(4) 4 scalar ARG,INOUT 1682,1683,1684 NDAT Param 1642 I(4) 4 scalar 1647,1683 NINT Dummy 1640 I(4) 4 scalar ARG,INOUT 1645 NREAL Dummy 1640 I(4) 4 scalar ARG,INOUT 1646 OPENMB Subr 1682 1682 RDATA Dummy 1640 R(4) 4 1 0 ARG,INOUT 1667,1668,1669,1670,1671,1672 SUBSET Dummy 1640 CHAR 8 scalar ARG,INOUT 1682,1683 UFBSEQ Subr 1683 1683 WRITSB Subr 1684 1684 Page 39 Source Listing BUFTRM 2013-01-11 18:32 Subprograms/Common Blocks trantmi.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References BUFR_TRANTMI Prog 1 BUFTRM Subr 1640 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume nobyterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume noold_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores no -auto -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __i686 -D __i686__ -D __pentiumpro -D __pentiumpro__ -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE__ -D __MMX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -fpe3 Page 40 Source Listing BUFTRM 2013-01-11 18:32 trantmi.f90 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.6/include/.f, /usr/include/.f,/usr/include/.f -list filename : trantmi.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100