Page 1 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 1 C MAIN PROGRAM DOCUMENTATION BLOCK 2 C 3 C MAIN PROGRAM: ENSSTAT 4 C PRGMMR: WOBUS ORG: NP20 DATE: 2006-05-10 5 C 6 C ABSTRACT: THIS PROGRAM creates components of the mean and 7 C spread members and of selected enspost and ensstat 8 C files 9 C 10 C PROGRAM HISTORY LOG: 11 C 00-04-03 RICHARD WOBUS (WX20RW) NEW PROGRAM ON IBM-SP 12 C 00-04-21 RICHARD WOBUS (WX20RW) SET UP FOR VARIABLE NUMBERS 13 C OF 00Z AND/OR 12Z MEMBERS and add 14 c decaying averages in ensstat files 15 c 00-09-05 RICHARD WOBUS (WX20RW) move decaying averages to 16 c separate job step 17 c 01-03-14 RICHARD WOBUS (WX20RW) update diagnostic output 18 c 01-09-04 Richard Wobus (wx20rw) variable resolution, single cycle 19 c 01-11-09 Richard Wobus (wx20rw) add single-run output 20 c 03-09-10 Richard Wobus (wx20rw) add search for 6-hourly 21 c 04-03-12 Richard Wobus (wx20rw) add interval-average 22 c 06-05-10 Richard Wobus (wx20rw) reorganize for pgrba files 23 c and control by namelist 24 c 11-06-20 Richard Wobus (wx20rw) enable separate runs for 25 c mean/spread and enspost 26 c 12-02-23 Richard Wobus (wx20rw) calculate output mask 27 c defined to include only points 28 c present in at least 2 members; 29 c output files are written only if 30 c at least 3 members were read in 31 c 32 C 33 C USAGE: 34 C 35 C INPUT FILES: 36 C UNIT 5 NAMELIST 37 C as assigned by namelist -- input grib and index files 38 C 39 C OUTPUT FILES: 40 C as assigned by namelist -- output grib and index files 41 C as assigned by namelist -- output enspost files 42 C as assigned by namelist -- output ensstat files 43 C 44 C SUBPROGRAMS CALLED: 45 c baopenr -- bacio routine 46 c baopenwa-- bacio routine 47 c baclose -- bacio routine 48 C GETGBE -- W3LIB ROUTINE 49 C PUTGBEX -- W3LIB ROUTINE 50 C PUTGBE -- W3LIB ROUTINE 51 C SRANGE -- LOCAL ROUTINE ( included after main program ) 52 C 53 C ATTRIBUTES: 54 C LANGUAGE: FORTRAN 55 C 56 C$$$ 57 program ensstat Page 2 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 58 parameter(nmemd=100,nenspostd=100) 59 allocatable f(:) 60 allocatable ecnt(:) 61 allocatable eatot(:) 62 allocatable eavg(:) 63 allocatable evtot(:) 64 allocatable evar(:) 65 allocatable estd(:) 66 dimension xprob(2),imembr(80) 67 dimension yprob(2),jmembr(80) 68 dimension zprob(2),kmembr(80) 69 dimension ipds(200),igds(200),iens(200),iprob(2),iclust(16) 70 dimension jpds(200),jgds(200),jens(200),jprob(2),jclust(16) 71 dimension kpds(200),kgds(200),kens(200),kprob(2),kclust(16) 72 dimension lens(200) 73 logical*1,allocatable::lb(:) 74 logical fp 75 76 dimension ivar(nenspostd) 77 dimension ilvt(nenspostd) 78 dimension ilev(nenspostd) 79 c allocatable ivar(:) 80 c allocatable ilvt(:) 81 c allocatable ilev(:) 82 83 character*120 cfipg(nmemd) 84 character*120 cfipi(nmemd) 85 c character*120,allocatable:: cfipg(:) 86 c character*120,allocatable:: cfipi(:) 87 character*120 cfoag 88 character*120 cfosg 89 character*120 cfopg(nenspostd) 90 character*120 cfotg(nenspostd) 91 c character*120,allocatable:: cfopg(:) 92 c character*120,allocatable:: cfotg(:) 93 94 dimension lfipg(nmemd) 95 dimension lfipi(nmemd) 96 c allocatable lfipg(:) 97 c allocatable lfipi(:) 98 dimension lfopg(nenspostd) 99 dimension lfotg(nenspostd) 100 c allocatable lfopg(:) 101 c allocatable lfotg(:) 102 103 dimension icfipg(nmemd) 104 dimension icfipi(nmemd) 105 c allocatable icfipg(:) 106 c allocatable icfipi(:) 107 dimension icfopg(nenspostd) 108 dimension icfotg(nenspostd) 109 c allocatable icfopg(:) 110 c allocatable icfotg(:) 111 112 dimension jpos(nmemd) 113 dimension kpos(nmemd) 114 dimension iskip(nmemd) Page 3 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 115 c allocatable jpos(:) 116 c allocatable kpos(:) 117 c allocatable iskip(:) 118 119 logical inindxf 120 121 namelist /namdim/ nmemdim,nenspostdim,lfdim 122 123 namelist /namens/ nfiles,iskip,cfipg,cfipi, 124 , nenspost,ivar,ilev,ilvt,cfopg,cfotg, 125 , cfoag,cfosg,inindxf 126 127 ccc 128 CALL W3TAGB('ENSSTAT',2000,0243,0069,'NP21') 129 130 read (5,namdim) 131 write (6,namdim) 132 133 c nmemd=nmemdim 134 c nenspostd=nenspostdim 135 lfm=lfdim 136 137 c allocate(ivar(nenspostd)) 138 c allocate(ilvt(nenspostd)) 139 c allocate(ilev(nenspostd)) 140 c allocate(cfopg(nenspostd)) 141 c allocate(cfotg(nenspostd)) 142 c allocate(lfopg(nenspostd)) 143 c allocate(lfotg(nenspostd)) 144 c allocate(icfopg(nenspostd)) 145 c allocate(icfotg(nenspostd)) 146 147 c allocate(cfipg(nmemd)) 148 c allocate(cfipi(nmemd)) 149 c allocate(ifipg(nmemd)) 150 c allocate(ifipi(nmemd)) 151 c allocate(icfipg(nmemd)) 152 c allocate(icfipi(nmemd)) 153 c allocate(jpos(nmemd)) 154 c allocate(kpos(nmemd)) 155 c allocate(iskip(nmemd)) 156 157 allocate(f(lfm)) 158 allocate(ecnt(lfm)) 159 allocate(eatot(lfm)) 160 allocate(eavg(lfm)) 161 allocate(evtot(lfm)) 162 allocate(evar(lfm)) 163 allocate(estd(lfm)) 164 allocate(lb(lfm)) 165 166 inindxf=.true. 167 read (5,namens) 168 write (6,namens) 169 170 lfipg=len_trim(cfipg) 171 lfipi=len_trim(cfipi) Page 4 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 172 lfoag=len_trim(cfoag) 173 lfosg=len_trim(cfosg) 174 lfotg=len_trim(cfopg) 175 lfopg=len_trim(cfotg) 176 177 c open files 178 179 iunit=9 180 nskip=0 181 do ifile=1,nfiles 182 if ( iskip(ifile) .eq. 1 ) then 183 nskip=nskip+1 184 endif 185 186 iunit=iunit+1 187 icfipg(ifile)=iunit 188 print *, icfipg(ifile),cfipg(ifile)(1:lfipg(ifile)) 189 call baopenr(icfipg(ifile),cfipg(ifile)(1:lfipg(ifile)),iretipg) 190 if ( iretipg .ne. 0 ) then 191 print *,'ifile,iretipg = ',ifile,iretipg 192 endif 193 194 if (inindxf) then 195 iunit=iunit+1 196 icfipi(ifile)=iunit 197 call baopenr(icfipi(ifile),cfipi(ifile)(1:lfipi(ifile)),iretipi) 198 if ( iretipi .ne. 0 ) then 199 print *,'ifile,iretipi = ',ifile,iretipi 200 icfipi(ifile)=0 201 endif 202 else 203 icfipi(ifile)=0 204 endif 205 206 print *, icfipi(ifile),cfipi(ifile)(1:lfipi(ifile)) 207 208 enddo 209 210 if ( iunit .lt. 50) then 211 iunit=50 212 endif 213 214 if ( nfiles > (nskip+2) ) then 215 216 iunit=iunit+1 217 icfoag=iunit 218 call baopenwa(icfoag,cfoag(1:lfoag),iretoag) 219 if ( iretoag .ne. 0 ) then 220 print *,'iretoag = ',iretoag 221 endif 222 print *, icfoag,cfoag(1:lfoag) 223 224 iunit=iunit+1 225 icfosg=iunit 226 call baopenwa(icfosg,cfosg(1:lfosg),iretosg) 227 if ( iretosg .ne. 0 ) then 228 print *,'iretosg = ',iretosg Page 5 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 229 endif 230 print *, icfosg,cfosg(1:lfosg) 231 232 endif 233 234 do iep=1,nenspost 235 iunit=iunit+1 236 icfopg(iep)=iunit 237 call baopenwa(icfopg(iep),cfopg(iep)(1:lfopg(iep)),iretopg) 238 if ( iretopg .ne. 0 ) then 239 print *,'iep,iretopg = ',iep,iretopg 240 endif 241 print *, icfopg(iep),cfopg(iep)(1:lfopg(iep)) 242 iunit=iunit+1 243 icfotg(iep)=iunit 244 call baopenwa(icfotg(iep),cfotg(iep)(1:lfotg(iep)),iretotg) 245 if ( iretotg .ne. 0 ) then 246 print *,'iep,iretotg = ',iep,iretotg 247 endif 248 print *, icfotg(iep),cfotg(iep)(1:lfotg(iep)) 249 enddo 250 251 c loop over variables 252 jpos=0 253 kpos=0 254 255 lvar: do iv=1,100 256 print *,'begin variable loop iv=',iv 257 if ( 0 .eq. nfiles ) then 258 print *,' nfiles=',nfiles 259 print *,' exiting' 260 exit lvar 261 endif 262 263 ncnt=0 264 iprob=0 265 xprob=0.0 266 iclust=0 267 imembr=0 268 kpds=0 269 kgds=0 270 kens=0 271 kprob=0 272 zprob=0.0 273 kclust=0 274 kmembr=0 275 lens(1)=1 276 lens(2)=0 277 lens(3)=0 278 lens(4)=1 279 lens(5)=255 280 281 icnt=0 282 ecnt=0.0 283 eatot=0.0 284 eavg=0.0 285 evtot=0.0 Page 6 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 286 evar=0.0 287 estd=0.0 288 289 c loop over files 290 291 lmem: do ifile=nfiles,1,-1 292 print *,'begin member input loop ifile=' ,ifile 293 294 c read a field 295 296 jpds=-1 297 jgds=-1 298 jens=-1 299 if ( ifile .ne. nfiles ) then 300 jpds(5)=kpds(5) 301 jpds(6)=kpds(6) 302 jpds(7)=kpds(7) 303 endif 304 kpds=0 305 kgds=0 306 kens=0 307 kprob=0 308 zprob=0.0 309 kclust=0 310 kmembr=0 311 if ((ifile.ge.nfiles-3).or.(ifile.le.3)) then 312 print * 313 print *,' before getgbex' 314 print *,' jpds=',(jpds(l),l=1,25) 315 print *,' jens=',(jens(l),l=1,5) 316 print *,' before getgbex' 317 print *,' kpds=',(kpds(l),l=1,25) 318 print *,' kens=',(kens(l),l=1,5) 319 print *,' kprob=',kprob 320 print *,' zprob=',zprob 321 print *,' kclust=',kclust 322 print *,' kmembr=',kmembr 323 print *,' jpos,kpos=',jpos(ifile),kpos(ifile) 324 endif 325 call getgbex(icfipg(ifile),icfipi(ifile), 326 & lfm,jpos(ifile),jpds,jgds,jens, 327 & kf,kpos(ifile),kpds,kgds,kens, 328 & kprob,zprob,kclust,kmembr, 329 & lb,f,iret) 330 if ((ifile.ge.nfiles-3).or. 331 & (ifile.le.3).or. 332 & (iret.ne.0)) then 333 print *,' after getgbex' 334 print *,' jpds=',(jpds(l),l=1,25) 335 print *,' jens=',(jens(l),l=1,5) 336 print *,' after getgbex' 337 print *,' kpds=',(kpds(l),l=1,25) 338 print *,' kens=',(kens(l),l=1,5) 339 print *,' kprob=',kprob 340 print *,' zprob=',zprob 341 print *,' kclust=',kclust 342 print *,' kmembr=',kmembr Page 7 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 343 print *,' jpos,kpos=',jpos(ifile),kpos(ifile) 344 endif 345 if (iret.eq.0) then 346 jpos(ifile)=kpos(ifile) 347 print *,' jpos,kpos=',jpos(ifile),kpos(ifile) 348 if ( ifile .eq. nfiles ) then 349 ipds=kpds 350 igds=kgds 351 iens=kens 352 endif 353 354 call srange(kf,lb,f,fp,dmin,dmax,dmean,adev,sdev,skew, 355 & nmsk,nmin,nmax) 356 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 357 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 358 & nmsk,nmin,dmin,nmax,dmax, 359 & dmean,adev,sdev,skew 360 361 c write the field to enspost if asked 362 363 do iep=1,nenspost 364 if (kpds(5).eq.ivar(iep)) then 365 if (kpds(6).eq.ilvt(iep)) then 366 if (kpds(7).eq.ilev(iep)) then 367 print * 368 print *,' before putgbex enspost' 369 print *,' kpds=',(kpds(l),l=1,25) 370 print *,' kens=',(kens(l),l=1,5) 371 print *,' kprob=',kprob 372 print *,' zprob=',zprob 373 print *,' kclust=',kclust 374 print *,' kmembr=',kmembr 375 call putgbex(icfopg(iep),kf,kpds,kgds,kens, 376 & kprob,zprob,kclust,kmembr,lb,f,iret) 377 if (iret.eq.0) then 378 print *,'putgbex enspost succeeded' 379 else 380 print *,'putgbex enspost failed, iret=',iret 381 endif 382 endif 383 endif 384 endif 385 enddo 386 387 c add the field to the running totals if not skipped 388 389 if (iskip(ifile).eq.0) then 390 icnt=icnt + 1 391 do ii=1,kf 392 if (lb(ii)) then 393 ecnt(ii)=ecnt(ii)+1.0 394 eatot(ii)=eatot(ii)+f(ii) 395 evtot(ii)=evtot(ii)+f(ii)**2 396 endif 397 enddo 398 lf=kf 399 endif Page 8 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 400 401 else 402 if ( ifile .eq. nfiles ) then 403 print *,'iret=',iret 404 print *,' exiting' 405 exit lvar 406 endif 407 endif 408 409 enddo lmem 410 411 412 c calculate the ensemble mean and spread 413 414 lb=.false. 415 if (icnt.ge.3) then 416 print *,'begin calculating mean and spread' 417 kpds=ipds 418 kgds=igds 419 kf=lf 420 iens=0 421 422 print *,' before calculations' 423 print *,' ipds=',(ipds(l),l=1,25) 424 print *,' iens=',(iens(l),l=1,5) 425 print *,' iprob=',iprob 426 print *,' xprob=',xprob 427 print *,' iclust=',iclust 428 print *,' imembr=',imembr 429 lb=.true. 430 print * 431 print *,'number of members' 432 call srange(kf,lb,ecnt(1),fp,dmin,dmax,dmean, 433 & adev, sdev,skew, 434 & nmsk,nmin,nmax) 435 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 436 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 437 & nmsk,nmin,dmin,nmax,dmax, 438 & dmean,adev,sdev,skew 439 print * 440 print *,'ensemble totals' 441 call srange(kf,lb,eatot(1),fp,dmin,dmax,dmean, 442 & adev, sdev,skew, 443 & nmsk,nmin,nmax) 444 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 445 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 446 & nmsk,nmin,dmin,nmax,dmax, 447 & dmean,adev,sdev,skew 448 print * 449 print *,'ensemble square totals' 450 call srange(kf,lb,evtot(1),fp,dmin,dmax,dmean, 451 & adev, sdev,skew, 452 & nmsk,nmin,nmax) 453 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 454 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 455 & nmsk,nmin,dmin,nmax,dmax, 456 & dmean,adev,sdev,skew Page 9 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 457 print * 458 do ii=1,kf 459 c this point will only be included in the output mask if it is 460 c defined in at least two ensemble members 461 if (ecnt(ii).ge.1.5) then 462 lb(ii)=.true. 463 eavg(ii)=eatot(ii)/ecnt(ii) 464 eavt=eatot(ii)*eavg(ii) 465 c use of ecnt-1 means that these are estimates of 466 c the population variance and standard deviation 467 if (evtot(ii).ge.eavt) then 468 evar(ii)=(evtot(ii)-eavt)/(ecnt(ii)-1.0) 469 estd(ii)=sqrt(evar(ii)) 470 else 471 c this test allows for small roundoff errors 472 c in the variance calculation 473 if (evtot(ii).lt.(eavt*0.99)) then 474 print *,'bad variance', 475 & evtot(ii),eatot(ii),eavg(ii),eavt 476 & ,ecnt(ii),ii,n 477 endif 478 endif 479 else 480 lb(ii)=.false. 481 endif 482 enddo 483 print *,' after calculations' 484 print * 485 print *,'number of members' 486 call srange(kf,lb,ecnt(1),fp,dmin,dmax,dmean, 487 & adev, sdev,skew, 488 & nmsk,nmin,nmax) 489 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 490 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 491 & nmsk,nmin,dmin,nmax,dmax, 492 & dmean,adev,sdev,skew 493 print * 494 print *,'ensemble totals' 495 call srange(kf,lb,eatot(1),fp,dmin,dmax,dmean, 496 & adev, sdev,skew, 497 & nmsk,nmin,nmax) 498 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 499 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 500 & nmsk,nmin,dmin,nmax,dmax, 501 & dmean,adev,sdev,skew 502 print * 503 print *,'ensemble square totals' 504 call srange(kf,lb,evtot(1),fp,dmin,dmax,dmean, 505 & adev, sdev,skew, 506 & nmsk,nmin,nmax) 507 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 508 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 509 & nmsk,nmin,dmin,nmax,dmax, 510 & dmean,adev,sdev,skew 511 print * 512 print *,'ensemble mean' 513 call srange(kf,lb,eavg(1),fp,dmin,dmax,dmean, Page 10 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 514 & adev, sdev,skew, 515 & nmsk,nmin,nmax) 516 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 517 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 518 & nmsk,nmin,dmin,nmax,dmax, 519 & dmean,adev,sdev,skew 520 print * 521 print *,'ensemble variance' 522 call srange(kf,lb,evar(1),fp,dmin,dmax,dmean, 523 & adev, sdev,skew, 524 & nmsk,nmin,nmax) 525 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 526 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 527 & nmsk,nmin,dmin,nmax,dmax, 528 & dmean,adev,sdev,skew 529 print * 530 print *,'ensemble standard deviation' 531 call srange(kf,lb,estd(1),fp,dmin,dmax,dmean, 532 & adev, sdev,skew, 533 & nmsk,nmin,nmax) 534 print '(i3,i3,2i5,4i3,i4,4i2,i4,3i6,g11.4,i6,5g11.4)', 535 & n,(kpds(i),i=5,11),kpds(14),(kens(i),i=1,5),kf, 536 & nmsk,nmin,dmin,nmax,dmax, 537 & dmean,adev,sdev,skew 538 print * 539 print *,'end calculating mean and spread' 540 541 c write out ensemble mean and spread 542 543 print * 544 print *,'begin writing mean and spread' 545 546 c extensions for ensemble mean 547 ipds=kpds 548 igds=kgds 549 iens=0 550 551 ipds(23)=2 552 iens(1)=1 !: OCT 41 553 iens(2)=5 !: OCT 42 554 iens(3)=0 !: OCT 43 555 iens(4)=1 !: OCT 44 556 iprob(1)=0 !: OCT 46 557 iprob(2)=0 !: OCT 47 558 xprob(1)=0.0 !: OCT 48-51 559 xprob(2)=0.0 !: OCT 52-55 560 iclust(1)=icnt !: OCT 61 561 print * 562 print *,' before putgbex mean' 563 print *,' ipds=',(ipds(l),l=1,25) 564 print *,' iens=',(iens(l),l=1,5) 565 print *,' iprob=',iprob 566 print *,' xprob=',xprob 567 print *,' iclust=',iclust 568 print *,' imembr=',imembr 569 570 c write to mean member Page 11 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 571 572 if ( nfiles > (nskip+2) ) then 573 call putgbex(icfoag, 574 & lf,ipds,igds,iens,iprob,xprob, 575 & iclust,imembr,lb,eavg(1),iret) 576 if (iret.eq.0) then 577 print *,'putgbex mean succeeded' 578 else 579 print *,'putgbex mean failed, iret=',iret 580 endif 581 endif 582 583 c write mean to old style ensstat file if asked 584 585 do iep=1,nenspost 586 if (kpds(5).eq.ivar(iep)) then 587 if (kpds(6).eq.ilvt(iep)) then 588 if (kpds(7).eq.ilev(iep)) then 589 call putgbex(icfotg(iep), 590 & lf,ipds,igds,iens,iprob,xprob, 591 & iclust,imembr,lb,eavg(1),iret) 592 if (iret.eq.0) then 593 print *,'putgbex es mean succeeded' 594 else 595 print *,'putgbex es mean failed, iret=',iret 596 endif 597 endif 598 endif 599 endif 600 enddo 601 602 c extensions for ensemble standard deviation 603 ipds=kpds 604 igds=kgds 605 iens=0 606 607 ipds(23)=2 608 iens(1)=1 !: OCT 41 609 iens(2)=5 !: OCT 42 610 iens(3)=0 !: OCT 43 611 iens(4)=11 !: OCT 44 612 iprob(1)=0 !: OCT 46 613 iprob(2)=0 !: OCT 47 614 xprob(1)=0.0 !: OCT 48-51 615 xprob(2)=0.0 !: OCT 52-55 616 print * 617 print *,' before putgbex std' 618 print *,' ipds=',(ipds(l),l=1,25) 619 print *,' iens=',(iens(l),l=1,5) 620 print *,' iprob=',iprob 621 print *,' xprob=',xprob 622 print *,' iclust=',iclust 623 print *,' imembr=',imembr 624 625 c write to spread member 626 627 if ( nfiles > (nskip+2) ) then Page 12 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 628 call putgbex(icfosg,lf,ipds,igds,iens,iprob,xprob, 629 & iclust,imembr,lb,estd(1),iret) 630 if (iret.eq.0) then 631 print *,'putgbex std succeeded' 632 else 633 print *,'putgbex std failed, iret=',iret 634 endif 635 endif 636 637 c write spread to old style ensstat file if asked 638 639 do iep=1,nenspost 640 if (kpds(5).eq.ivar(iep)) then 641 if (kpds(6).eq.ilvt(iep)) then 642 if (kpds(7).eq.ilev(iep)) then 643 call putgbex(icfotg(iep), 644 & lf,ipds,igds,iens,iprob,xprob, 645 & iclust,imembr,lb,estd(1),iret) 646 if (iret.eq.0) then 647 print *,'putgbex es std succeeded' 648 else 649 print *,'putgbex es std failed, iret=',iret 650 endif 651 endif 652 endif 653 endif 654 enddo 655 656 endif 657 658 enddo lvar 659 660 c close files and deallocate arrays 661 662 do ifile=1,nfiles 663 call baclose(icfipg(ifile),iretipg) 664 if ( iretipg .ne. 0 ) then 665 print *,'ifile,iretipg = ',ifile,iretipg 666 endif 667 call baclose(icfipi(ifile),iretipi) 668 if ( iretipi .ne. 0 ) then 669 print *,'ifile,iretipi = ',ifile,iretipi 670 endif 671 enddo 672 673 if ( nfiles > (nskip+2) ) then 674 call baclose(icfoag,iretoag) 675 if ( iretoag .ne. 0 ) then 676 print *,'iretoag = ',iretoag 677 endif 678 call baclose(icfosg,iretosg) 679 if ( iretosg .ne. 0 ) then 680 print *,'iretosg = ',iretosg 681 endif 682 endif 683 684 do iep=1,nenspost Page 13 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 685 call baclose(icfopg(iep),iretopg) 686 if ( iretopg .ne. 0 ) then 687 print *,'iep,iretopg = ',iep,iretopg 688 endif 689 call baclose(icfotg(iep),iretotg) 690 if ( iretotg .ne. 0 ) then 691 print *,'iep,iretotg = ',iep,iretotg 692 endif 693 enddo 694 695 c deallocate(ivar) 696 c deallocate(ilvt) 697 c deallocate(ilev) 698 c deallocate(cfopg) 699 c deallocate(cfotg) 700 c deallocate(lfopg) 701 c deallocate(lfotg) 702 c deallocate(icfopg) 703 c deallocate(icfotg) 704 705 c deallocate(cfipg) 706 c deallocate(cfipi) 707 c deallocate(ifipg) 708 c deallocate(ifipi) 709 c deallocate(icfipg) 710 c deallocate(icfipi) 711 c deallocate(jpos) 712 c deallocate(kpos) 713 c deallocate(iskip) 714 715 deallocate(f) 716 deallocate(ecnt) 717 deallocate(eatot) 718 deallocate(eavg) 719 deallocate(evtot) 720 deallocate(evar) 721 deallocate(estd) 722 deallocate(lb) 723 724 CALL W3TAGE('ENSSTAT') 725 726 stop 727 end Page 14 Source Listing ENSSTAT 2013-12-16 19:38 Entry Points gefs_ensstat.f ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ADEV Local 354 R(4) 4 scalar 354,359,433,438,442,447,451,456,48 7,492,496,501,505,510,514,519,523, 528,532,537 BACLOSE Subr 663 663,667,674,678,685,689 BAOPENR Subr 189 189,197 BAOPENWA Subr 218 218,226,237,244 CFIPG Local 83 CHAR 120 1 100 123,170,188,189 CFIPI Local 84 CHAR 120 1 100 123,171,197,206 CFOAG Local 87 CHAR 120 scalar 125,172,218,222 CFOPG Local 89 CHAR 120 1 100 124,174,237,241 CFOSG Local 88 CHAR 120 scalar 125,173,226,230 CFOTG Local 90 CHAR 120 1 100 124,175,244,248 DMAX Local 354 R(4) 4 scalar 354,358,432,437,441,446,450,455,48 6,491,495,500,504,509,513,518,522, 527,531,536 DMEAN Local 354 R(4) 4 scalar 354,359,432,438,441,447,450,456,48 6,492,495,501,504,510,513,519,522, 528,531,537 DMIN Local 354 R(4) 4 scalar 354,358,432,437,441,446,450,455,48 6,491,495,500,504,509,513,518,522, 527,531,536 EATOT Local 61 R(4) 4 1 1 ALC 159,283,394,441,463,464,475,495,71 7 EAVG Local 62 R(4) 4 1 1 ALC 160,284,463,464,475,513,575,591,71 8 EAVT Local 464 R(4) 4 scalar 464,467,468,473,475 ECNT Local 60 R(4) 4 1 1 ALC 158,282,393,432,461,463,468,476,48 6,716 ENSSTAT Prog 57 ESTD Local 65 R(4) 4 1 1 ALC 163,287,469,531,629,645,721 EVAR Local 64 R(4) 4 1 1 ALC 162,286,468,469,522,720 EVTOT Local 63 R(4) 4 1 1 ALC 161,285,395,450,467,468,473,475,50 4,719 F Local 59 R(4) 4 1 1 ALC 157,329,354,376,394,395,715 FP Local 74 L(4) 4 scalar 354,432,441,450,486,495,504,513,52 2,531 GETGBEX Subr 325 325 I Local 357 I(4) 4 scalar 357,436,445,454,490,499,508,517,52 6,535 ICFIPG Local 103 I(4) 4 1 100 187,188,189,325,663 ICFIPI Local 104 I(4) 4 1 100 196,197,200,203,206,325,667 ICFOAG Local 217 I(4) 4 scalar 217,218,222,573,674 ICFOPG Local 107 I(4) 4 1 100 236,237,241,375,685 ICFOSG Local 225 I(4) 4 scalar 225,226,230,628,678 Page 15 Source Listing ENSSTAT 2013-12-16 19:38 Symbol Table gefs_ensstat.f Name Object Declared Type Bytes Dimen Elements Attributes References ICFOTG Local 108 I(4) 4 1 100 243,244,248,589,643,689 ICLUST Local 69 I(4) 4 1 16 266,427,560,567,575,591,622,629,64 5 ICNT Local 281 I(4) 4 scalar 281,390,415,560 IENS Local 69 I(4) 4 1 200 351,420,424,549,552,553,554,555,56 4,574,590,605,608,609,610,611,619, 628,644 IEP Local 234 I(4) 4 scalar 234,236,237,239,241,243,244,246,24 8,363,364,365,366,375,585,586,587, 588,589,639,640,641,642,643,684,68 5,687,689,691 IFILE Local 181 I(4) 4 scalar 181,182,187,188,189,191,196,197,19 9,200,203,206,291,292,299,311,323, 325,326,327,330,331,343,346,347,34 8,389,402,662,663,665,667,669 IGDS Local 69 I(4) 4 1 200 350,418,548,574,590,604,628,644 II Local 391 I(4) 4 scalar 391,392,393,394,395,458,461,462,46 3,464,467,468,469,473,475,476,480 ILEV Local 78 I(4) 4 1 100 124,366,588,642 ILVT Local 77 I(4) 4 1 100 124,365,587,641 IMEMBR Local 66 I(4) 4 1 80 267,428,568,575,591,623,629,645 ININDXF Local 119 L(4) 4 scalar 125,166,194 IPDS Local 69 I(4) 4 1 200 349,417,423,547,551,563,574,590,60 3,607,618,628,644 IPROB Local 69 I(4) 4 1 2 264,425,556,557,565,574,590,612,61 3,620,628,644 IRET Local 329 I(4) 4 scalar 329,332,345,376,377,380,403,575,57 6,579,591,592,595,629,630,633,645, 646,649 IRETIPG Local 189 I(4) 4 scalar 189,190,191,663,664,665 IRETIPI Local 197 I(4) 4 scalar 197,198,199,667,668,669 IRETOAG Local 218 I(4) 4 scalar 218,219,220,674,675,676 IRETOPG Local 237 I(4) 4 scalar 237,238,239,685,686,687 IRETOSG Local 226 I(4) 4 scalar 226,227,228,678,679,680 IRETOTG Local 244 I(4) 4 scalar 244,245,246,689,690,691 ISKIP Local 114 I(4) 4 1 100 123,182,389 IUNIT Local 179 I(4) 4 scalar 179,186,187,195,196,210,211,216,21 7,224,225,235,236,242,243 IV Local 255 I(4) 4 scalar 255,256 IVAR Local 76 I(4) 4 1 100 124,364,586,640 JCLUST Local 70 I(4) 4 1 16 JENS Local 70 I(4) 4 1 200 298,315,326,335 JGDS Local 70 I(4) 4 1 200 297,326 JMEMBR Local 67 I(4) 4 1 80 JPDS Local 70 I(4) 4 1 200 296,300,301,302,314,326,334 JPOS Local 112 I(4) 4 1 100 252,323,326,343,346,347 JPROB Local 70 I(4) 4 1 2 KCLUST Local 71 I(4) 4 1 16 273,309,321,328,341,373,376 KENS Local 71 I(4) 4 1 200 270,306,318,327,338,351,357,370,37 5,436,445,454,490,499,508,517,526, 535 KF Local 327 I(4) 4 scalar 327,354,357,375,391,398,419,432,43 6,441,445,450,454,458,486,490,495, 499,504,508,513,517,522,526,531,53 5 Page 16 Source Listing ENSSTAT 2013-12-16 19:38 Symbol Table gefs_ensstat.f Name Object Declared Type Bytes Dimen Elements Attributes References KGDS Local 71 I(4) 4 1 200 269,305,327,350,375,418,548,604 KMEMBR Local 68 I(4) 4 1 80 274,310,322,328,342,374,376 KPDS Local 71 I(4) 4 1 200 268,300,301,302,304,317,327,337,34 9,357,364,365,366,369,375,417,436, 445,454,490,499,508,517,526,535,54 7,586,587,588,603,640,641,642 KPOS Local 113 I(4) 4 1 100 253,323,327,343,346,347 KPROB Local 71 I(4) 4 1 2 271,307,319,328,339,371,376 L Local 314 I(4) 4 scalar 314,315,317,318,334,335,337,338,36 9,370,423,424,563,564,618,619 LB Local 73 L(1) 1 1 1 ALC 164,329,354,376,392,414,429,432,44 1,450,462,480,486,495,504,513,522, 531,575,591,629,645,722 LENS Local 72 I(4) 4 1 200 275,276,277,278,279 LEN_TRIM Func 170 scalar 170,171,172,173,174,175 LF Local 398 I(4) 4 scalar 398,419,574,590,628,644 LFDIM Local 121 I(4) 4 scalar 121,135 LFIPG Local 94 I(4) 4 1 100 170,188,189 LFIPI Local 95 I(4) 4 1 100 171,197,206 LFM Local 135 I(4) 4 scalar 135,157,158,159,160,161,162,163,16 4,326 LFOAG Local 172 I(4) 4 scalar 172,218,222 LFOPG Local 98 I(4) 4 1 100 175,237,241 LFOSG Local 173 I(4) 4 scalar 173,226,230 LFOTG Local 99 I(4) 4 1 100 174,244,248 LMEM Label 291 scalar 409 LVAR Label 255 scalar 260,405,658 N Local 357 I(4) 4 scalar 357,436,445,454,476,490,499,508,51 7,526,535 NAMDIM Local 121 scalar 130,131 NAMENS Local 123 scalar 167,168 NCNT Local 263 I(4) 4 scalar 263 NENSPOST Local 124 I(4) 4 scalar 124,234,363,585,639,684 NENSPOSTD Param 58 I(4) 4 scalar 76,77,78,89,90,98,99,107,108 NENSPOSTDIM Local 121 I(4) 4 scalar 121 NFILES Local 123 I(4) 4 scalar 123,181,214,257,258,291,299,311,33 0,348,402,572,627,662,673 NMAX Local 355 I(4) 4 scalar 355,358,434,437,443,446,452,455,48 8,491,497,500,506,509,515,518,524, 527,533,536 NMEMD Param 58 I(4) 4 scalar 83,84,94,95,103,104,112,113,114 NMEMDIM Local 121 I(4) 4 scalar 121 NMIN Local 355 I(4) 4 scalar 355,358,434,437,443,446,452,455,48 8,491,497,500,506,509,515,518,524, 527,533,536 NMSK Local 355 I(4) 4 scalar 355,358,434,437,443,446,452,455,48 8,491,497,500,506,509,515,518,524, 527,533,536 NSKIP Local 180 I(4) 4 scalar 180,183,214,572,627,673 PUTGBEX Subr 375 375,573,589,628,643 SDEV Local 354 R(4) 4 scalar 354,359,433,438,442,447,451,456,48 7,492,496,501,505,510,514,519,523, 528,532,537 SKEW Local 354 R(4) 4 scalar 354,359,433,438,442,447,451,456,48 7,492,496,501,505,510,514,519,523, Page 17 Source Listing ENSSTAT 2013-12-16 19:38 Symbol Table gefs_ensstat.f Name Object Declared Type Bytes Dimen Elements Attributes References 528,532,537 SQRT Func 469 scalar 469 SRANGE Subr 354 354,432,441,450,486,495,504,513,52 2,531 W3TAGB Subr 128 128 W3TAGE Subr 724 724 XPROB Local 66 R(4) 4 1 2 265,426,558,559,566,574,590,614,61 5,621,628,644 YPROB Local 67 R(4) 4 1 2 ZPROB Local 68 R(4) 4 1 2 272,308,320,328,340,372,376 Page 18 Source Listing ENSSTAT 2013-12-16 19:38 gefs_ensstat.f 728 729 subroutine srange(n,ld,d,fprint,dmin,dmax,dmean,adev,sdev,skew, 730 & nmsk,nmin,nmax) 731 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 732 C 733 C SUBPROGRAM: SRANGE(N,LD,D,FPRINT,DMIN,DMAX,DMEAN,ADEV,SDEV,SKEW, 734 C & NMSK,NMIN,NMAX) 735 C PRGMMR:Richard Wobus ORG:NP20 DATE: 01-11-09 736 C 737 C ABSTRACT: THIS SUBROUTINE WILL CALCULATE THE MAXIMUM AND 738 C MINIMUM AND OTHER STATISTICS OF AN ARRAY 739 C 740 C PROGRAM HISTORY LOG: 741 C 97-03-17 YUEJIAN ZHU (WD20YZ) 742 C 01-03-14 Richard Wobus (wx20rw) added deviations and skew 743 C 01-11-09 Richard Wobus (wx20rw) corrected names and indices 744 C 12-02-23 Richard Wobus (wx20rw) added mask counts 745 C 746 C USAGE: 747 C 748 C INPUT ARGUMENTS: 749 C N -- INTEGER 750 C LD(N) -- LOGICAL OF DIMENSION N 751 C D(N) -- REAL ARRAY OF DIMENSION N 752 C FPRINT -- LOGICAL PRINT FLAG 753 C 754 C OUTPUT ARGUMENTS: 755 C DMIN -- REAL NUMBER ( MINIMUM ) 756 C DMAX -- REAL NUMBER ( MAXIMUM ) 757 C DMEAN -- REAL NUMBER ( MEAN ) 758 C ADEV -- REAL NUMBER ( AVERAGE DEVIATION ) 759 C SDEV -- REAL NUMBER ( STANDARD DEVIATION ) 760 C SKEW -- REAL NUMBER ( SKEWNESS ) 761 C NMSK -- INTEGER ( NUMBER OF VALID POINTS ) 762 C NMIN -- INTEGER ( NUMBER OF POINTS AT MIN ) 763 C NMAX -- INTEGER ( NUMBER OF POINTS AT MAX ) 764 C 765 C ATTRIBUTES: 766 C LANGUAGE: FORTRAN 767 C 768 C$$$ 769 logical*1 ld 770 logical fprint 771 dimension ld(n),d(n) 772 dmin=1.e30 773 dmax=-1.e30 774 sa=0.0 775 nmsk=0 776 nmin=0 777 nmax=0 778 do i=1,n 779 if(ld(i)) then 780 nmsk=nmsk+1 781 if (dmin.gt.d(i)) then 782 dmin=d(i) 783 nmin=1 784 elseif (dmin.eq.d(i)) then Page 19 Source Listing SRANGE 2013-12-16 19:38 gefs_ensstat.f 785 nmin=nmin+1 786 endif 787 if (dmax.lt.d(i)) then 788 dmax=d(i) 789 nmax=1 790 elseif (dmax.eq.d(i)) then 791 nmax=nmax+1 792 endif 793 sa=sa+d(i) 794 endif 795 enddo 796 if (nmsk.gt.0) then 797 ptsn=nmsk 798 dmean=sa/ptsn 799 else 800 dmean=0.0 801 endif 802 sl=0.0 803 sv=0.0 804 do i=1,n 805 if (ld(i)) then 806 sl=sl+abs(d(i)-dmean) 807 sv=sv+(d(i)-dmean)**2 808 endif 809 enddo 810 if (nmsk.gt.0) then 811 adev=sl/ptsn 812 else 813 adev=0.0 814 endif 815 if (nmsk.gt.1) then 816 sdev=sqrt(sv/(ptsn-1.0)) 817 else 818 sdev=0.0 819 endif 820 if (sdev .gt. 0.0) then 821 ss=0.0 822 do i=1,n 823 if (ld(i)) then 824 devn=(d(i)-dmean)/sdev 825 ss=ss+devn**3 826 endif 827 enddo 828 skew=ss/ptsn 829 else 830 skew=0.0 831 endif 832 if (fprint) then 833 print *,n,nmsk,nmin,dmin,nmax,dmax,avg,adev,sdev,skew 834 endif 835 return 836 end Page 20 Source Listing SRANGE 2013-12-16 19:38 Entry Points gefs_ensstat.f ENTRY POINTS Name srange_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 806 scalar 806 ADEV Dummy 729 R(4) 4 scalar ARG,INOUT 811,813,833 AVG Local 833 R(4) 4 scalar 833 D Dummy 729 R(4) 4 1 0 ARG,INOUT 781,782,784,787,788,790,793,806,80 7,824 DEVN Local 824 R(4) 4 scalar 824,825 DMAX Dummy 729 R(4) 4 scalar ARG,INOUT 773,787,788,790,833 DMEAN Dummy 729 R(4) 4 scalar ARG,INOUT 798,800,806,807,824 DMIN Dummy 729 R(4) 4 scalar ARG,INOUT 772,781,782,784,833 FPRINT Dummy 729 L(4) 4 scalar ARG,INOUT 832 I Local 778 I(4) 4 scalar 778,779,781,782,784,787,788,790,79 3,804,805,806,807,822,823,824 LD Dummy 729 L(1) 1 1 0 ARG,INOUT 779,805,823 N Dummy 729 I(4) 4 scalar ARG,INOUT 771,778,804,822,833 NMAX Dummy 730 I(4) 4 scalar ARG,INOUT 777,789,791,833 NMIN Dummy 730 I(4) 4 scalar ARG,INOUT 776,783,785,833 NMSK Dummy 730 I(4) 4 scalar ARG,INOUT 775,780,796,797,810,815,833 PTSN Local 797 R(4) 4 scalar 797,798,811,816,828 SA Local 774 R(4) 4 scalar 774,793,798 SDEV Dummy 729 R(4) 4 scalar ARG,INOUT 816,818,820,824,833 SKEW Dummy 729 R(4) 4 scalar ARG,INOUT 828,830,833 SL Local 802 R(4) 4 scalar 802,806,811 SQRT Func 816 scalar 816 SRANGE Subr 729 SS Local 821 R(4) 4 scalar 821,825,828 SV Local 803 R(4) 4 scalar 803,807,816 Page 21 Source Listing SRANGE 2013-12-16 19:38 gefs_ensstat.f 837 Page 22 Source Listing SRANGE 2013-12-16 19:38 Subprograms/Common Blocks gefs_ensstat.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ENSSTAT Prog 57 SRANGE Subr 729 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 old_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 native -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 -fixed no -fpconstant Page 23 Source Listing SRANGE 2013-12-16 19:38 gefs_ensstat.f -fpe3 -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 -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/tp1/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/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/tp1/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 : gefs_ensstat.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100