Page 1 Source Listing 2014-12-17 20:46 /tmpnwprd/ifortu09b2f.i ADJPPT.F(1251): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in this ed... 689 format(i2,3x,5(2x,e12.6)) ----------------------------------^ ADJPPT.F(492): remark #8290: Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edi... 128 FORMAT(I2,X,f7.0,x,f7.4,X,F7.2,2(2X,F6.4), X, 2(2X,E12.6)) -------------------------------------------------^ ADJPPT.F(492): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edi... 128 FORMAT(I2,X,f7.0,x,f7.4,X,F7.2,2(2X,F6.4), X, 2(2X,E12.6)) ----------------------------------------------------------------^ ADJPPT.F(391): remark #8290: Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edi... 129 FORMAT(I2,X,f7.0,x,f7.4,X,3(2X,F6.4), X, 2(2X,E12.6)) --------------------------------------------^ ADJPPT.F(391): remark #8291: Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edi... 129 FORMAT(I2,X,f7.0,x,f7.4,X,3(2X,F6.4), X, 2(2X,E12.6)) -----------------------------------------------------------^ Page 2 Source Listing ADJPPT 2014-12-17 20:46 /tmpnwprd/ifortu09b2f.i 1 # 1 "ADJPPT.F" 2 SUBROUTINE ADJPPT 3 C ****************************************************************** 4 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 5 C . . . 6 C SUBPROGRAM: ADJPPT PRECIPITATION ASSIMILATION ADJUSTMENT 7 C PRGRMMR: BALDWIN ORG: W/NP22 DATE: 98-08-26 8 C 9 C ABSTRACT: 10 C ADJPPT MODIFIES THE ENVIRONMENT AND RELEASES LATENT HEAT 11 C TO ATTEMPT TO MATCH THE AMOUNT OF OBSERVED PRECIPITATION. 12 C IF THE OBSERVED PRECIPITATION IS DETERMINED TO BE CONVECTIVE IN TYPE, 13 C THE LATENT HEAT RELEASE AND MOISTURE CHANGE IS FORMULATED TO FOLLOW 14 C THE BETTS-MILLER-JANJIC SCHEME. OTHERWISE ADJUSTMENTS ARE MADE 15 C IN A MANNER CONSISTENT WITH THE GRID-SCALE CLOUD PHYSICS SCHEME. 16 C 17 C 18 C PROGRAM HISTORY LOG: 19 C 98-08-26 BALDWIN - ORIGINATOR 20 C 21 C USAGE: CALL ADJPPT FROM MAIN PROGRAM EBU 22 C 23 C INPUT ARGUMENT LIST: 24 C NONE 25 C 26 C OUTPUT ARGUMENT LIST: 27 C NONE 28 C 29 C OUTPUT FILES: 30 C NONE 31 C 32 C SUBPROGRAMS CALLED: 33 C 34 C UNIQUE: 35 C TTBLEX 36 C 37 C LIBRARY: 38 C NONE 39 C 40 C COMMON BLOCKS: CTLBLK 41 C LOOPS 42 C MASKS 43 C PHYS 44 C VRBLS 45 C CNVCLD 46 C PVRBLS 47 C ACMCLH 48 C INDX 49 C 50 C ATTRIBUTES: 51 C LANGUAGE: FORTRAN 90 52 C MACHINE : IBM SP 53 C$$$ 54 C---------------------------------------------------------------------- 55 INCLUDE "cuparm" 146 INCLUDE "parmeta" 169 INCLUDE "parm.tbl" Page 3 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 171 INCLUDE "mpp.h" 172 C---------------------------------------------------------------------- 231 P A R A M E T E R 232 & (IMJM=IM*JM,JAM=6+2*(JM-10) 233 &, IMJM_LOC=IDIM2*JDIM2 234 &, LP1=LM+1,LM1=LM-1) 235 PARAMETER (ELIV=2.834E6, DLDT=2274.E0) 236 C---------------------------------------------------------------------- 237 L O G I C A L 238 & RUN,FIRST,RESTRT,SIGMA 239 C---------------------------------------------------------------------- 240 INCLUDE "CTLBLK.comm" 241 C----------------------------------------------------------------------- 251 INCLUDE "LOOPS.comm" 252 C----------------------------------------------------------------------- 259 INCLUDE "MASKS.comm" 260 C----------------------------------------------------------------------- 271 INCLUDE "PHYS.comm" 272 C----------------------------------------------------------------------- 300 INCLUDE "VRBLS.comm" 301 C----------------------------------------------------------------------- 311 INCLUDE "CNVCLD.comm" 312 C----------------------------------------------------------------------- 319 INCLUDE "PVRBLS.comm" 320 C----------------------------------------------------------------------- 350 INCLUDE "ACMCLH.comm" 351 C----------------------------------------------------------------------- 358 INCLUDE "INDX.comm" 359 C----------------------------------------------------------------------- 371 INCLUDE "PPTASM.comm" 372 C----------------------------------------------------------------------- 396 INCLUDE "CLDWTR.comm" 397 C----------------------------------------------------------------------- 405 D I M E N S I O N 406 & TREFK (LM),QREFK (LM),PK (LM),APEK (LM),TK (LM) 407 &,THSK (LM),PSK (LM),APESK (LM),QK (LM),THERK (LM) 408 &,THVREF(LM),THEVRF(LM),THVMOD(LM),DIFT (LM),DIFQ (LM) 409 &,QSATK (LM),FPK (LM),RELH (LM) 410 C 411 D I M E N S I O N 412 & LTOP (IDIM1:IDIM2,JDIM1:JDIM2),LBOT (IDIM1:IDIM2,JDIM1:JDIM2) 413 &,PTOP (IDIM1:IDIM2,JDIM1:JDIM2),PBOT (IDIM1:IDIM2,JDIM1:JDIM2) 414 &,IPTB (IDIM1:IDIM2,JDIM1:JDIM2),ITHTB (IDIM1:IDIM2,JDIM1:JDIM2) 415 &,PDSL (IDIM1:IDIM2,JDIM1:JDIM2),APEBT (IDIM1:IDIM2,JDIM1:JDIM2) 416 &,PRECL(IDIM1:IDIM2,JDIM1:JDIM2), QC(LM) 417 &,TBT (IDIM1:IDIM2,JDIM1:JDIM2),Q2BT (IDIM1:IDIM2,JDIM1:JDIM2) 418 &,QQ (IDIM1:IDIM2,JDIM1:JDIM2),PP (IDIM1:IDIM2,JDIM1:JDIM2) 419 &,PSP (IDIM1:IDIM2,JDIM1:JDIM2),THBT (IDIM1:IDIM2,JDIM1:JDIM2) 420 &,THESP (IDIM1:IDIM2,JDIM1:JDIM2),P (IDIM1:IDIM2,JDIM1:JDIM2) 421 &,ILRES (IMJM_LOC),JLRES (IMJM_LOC) 422 &,IHRES (IMJM_LOC),JHRES (IMJM_LOC) 423 &,DDATA(IDIM1:IDIM2,JDIM1:JDIM2), ADATA(IDIM1:IDIM2,JDIM1:JDIM2) 424 &,APE (IDIM1:IDIM2,JDIM1:JDIM2,LM) 425 &,TREF (IDIM1:IDIM2,JDIM1:JDIM2,LM) 426 C 427 C----------------------------------------------------------------------- 428 C CPREC: model convective precip at each time step. Page 4 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 429 C PREC = CPREC + APREC 430 C 431 C DDATA: Pobs at each time step 432 C 433 C If observed precip is larger than model precip, give the 434 C convective adjustment the first chance to make the rain. (Initially 435 C I wanted to keep the conv/gridscale precip invariant through ADJPPT, 436 C but then thought better of it - in the case of Pobs >> Pmod, the 437 C instability might build up too much if we don't let the conv adj 438 C take care of as much of it as possible). 439 C 440 C ADATA: After convective adjustment, let ADATA = DDATA - CPREC 441 C (i.e. ADATA is the portion of the observed precip not able to 442 C be accounted for by convective adjustment, and to be accounted 443 C for in the grid-scale portion of the adjustment scheme). 444 C 'CPREC' is not an actual variable in this routine. 445 C 446 C PPTSUM is used to keep track of total observed precip at grid point 447 C (itest,jtest) during the 3-hour assimilation period (to make sure that 448 C we are partitioning the hourly precip obs correctly). PPTSUM is zero 449 C before the first call to ADJPPT, and the accumulated value is saved 450 C between subsequent calls. 451 C 452 LOGICAL IGSADJ(IDIM1:IDIM2,JDIM1:JDIM2) 453 REAL PFACTOR(IDIM1:IDIM2,JDIM1:JDIM2) 454 C 455 C IGSADJ: flag for whether to make grid-scale adjustment 456 C (T - do GS adjustment. F - don't do GS adjustment) 457 C IGSADJ is false if 458 C 1) PPTDAT = 999., or 459 C 2) DDATA = 0., or 460 C 3) DDATA .LE. PREC, or 461 C 4) While DDATA > PREC, all (pre-adj) Pmod is convective, and 462 C the entire amount of DDATA is accounted for during convective 463 C adjustment 464 C IGSADJ is true if the convective adjustment does not 465 C produce enough convective precip to account for DDATA 466 467 C 468 DATA PPTSUM/0./ 469 SAVE PPTSUM 470 C 471 C---------------------------------------------------------------------- 472 IF (NTSD.EQ.1) THEN 473 TLAT=0. 474 RETURN 475 ENDIF 476 IF (NTSD.GT.NHEAT) RETURN 477 C 478 C----------------------------------------------------------------------- 479 C--------------INITIALIZE GRID-SCALE ADJUSTMENT MASK-------------------- 480 C--------------(later the mask will be updated during conv adj)--------- 481 C----------------------------------------------------------------------- 482 C 483 IGSADJ = .FALSE. 484 C 485 C PREPATORY CALCULATIONS Page 5 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 486 C----------------------------------------------------------------------- 487 DTCNVC=NCNVC*DT 488 RDTCNVC=1./DTCNVC 489 TAUK=DTCNVC/TREL 490 CTHRS=(0.006350/86400.)*DTCNVC 491 TIMES=(NTSD-1)*DT 492 COUNT=MOD(TIMES,3600.) 493 IHR=(TIMES-1.0)/3600.+1 494 PHYST=DTCNVC 495 C 496 IF (COUNT.GE.PHYST.OR.COUNT.EQ.0.0) THEN 497 FRACT=PHYST/3600. 498 ELSE 499 FRACT=COUNT/3600. 500 END IF 501 C 502 c 503 c Check to see if this is the last time step before the end. If so, 504 c applying the remaining fraction of precip to this time step. 505 c 506 c No, don't do that. For the 80km runs, this would mean an 25% increase 507 c of precip in the last time step, and it'll affect the temperature and 508 c the moisture fields inappriately. Better to increase the model precip 509 c after precip assim adjustment by 25% in the end (i.e. multiply by 510 c 'ENDFCTR'). 511 c 512 TEND=3.0 513 c print*,'tend=',tend 514 IF (TEND*3600.-TIMES .LT. PHYST) THEN 515 c FEND = TEND - TIMES/3600. 516 ENDFCTR = (TEND*3600-TIMES+PHYST)/PHYST 517 ELSE 518 c FEND = 0. 519 ENDFCTR = 1. 520 ENDIF 521 c 522 C 523 IF (TIMES .LT. PHYST) THEN 524 ZER=1.0E-05*FRACT 525 ELSE 526 ZER=1.0E-05*PHYST/3600. 527 ENDIF 528 C 529 C ZER IS OUR ZERO THRESHOLD; .01 MM PER HOUR 530 C (CORRESPONDS TO 1 HUNDRETH OF AN INCH PER DAY) 531 C 532 SIXSIX=PHYST/3600. 533 C 534 C Under one of the scenarios (when Pobs > 0 and Pmod=0), we need to 535 C create a layer of precipitating cloud from scratch. We specify 3 536 C cloud-thicknesses based on the precipitation amount: 537 C 538 PTRES1=2.81E-03*SIXSIX 539 PTRES2=3.75E-04*SIXSIX 540 PTRES3=1.0E-03*SIXSIX 541 C 542 c print*,'mype,mtstpe=',mype,mtstpe Page 6 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 543 c print*,'itstloc,jtstloc=',itstloc,jtstloc 544 IF (MYPE.EQ.MTSTPE) THEN 545 WRITE(98,*) 'NTSD=',NTSD,' TIMES=',TIMES,' FRACT=',FRACT, 546 & ' ENDFCTR=', ENDFCTR 547 WRITE(98,*) 'IHR=', IHR,' PPTDAT=',PPTDAT(ITSTLOC,JTSTLOC,IHR) 548 c print*,'pptdat(itstloc,jtstloc,ihr)=',pptdat(itstloc,jtstloc,ihr) 549 ENDIF 550 C----------------------------------------------------------------------- 551 C FRACT IS THE FRACTION OF IHR'S PRECIP THAT WE WANT FOR 552 C THIS ADJUSTMENT, WE WANT (PHYST/3600-FRACT) WORTH OF IHR-1 PRECIP 553 C WE HAVE DATA ONLY FOR IHR=1,3 554 C----------------------------------------------------------------------- 555 C SET UP OBSERVED PRECIP FOR THIS TIMESTEP IN DDATA 556 C----------------------------------------------------------------------- 557 C 558 PFACTOR = 1. 559 C 560 !$omp parallel do private(pdiff,pexp,pptsum) 561 DO 110 J=MYJS,MYJE 562 DO 100 I=MYIS,MYIE 563 C--- 564 R2D=57.2957795 ! 180.0/PI 565 GLATMIN=27.5 566 GLATMAX=42.5 567 GLATD=GLAT(I,J)*R2D 568 IF (GLATD.GE.GLATMAX .AND. (SM(I,J)+SICE(I,J)).GT.0.5) THEN 569 PPTDAT(I,J,IHR)=999.0 570 END IF 571 C--- 572 IF (PPTDAT(I,J,IHR).GT.900.) GO TO 100 573 C---- rewrite 12-11 WNE 574 C IF (IHR.EQ.1 .OR. PPTDAT(I,J,IHR-1).GT.900.) THEN 575 IF (.not.(IHR.NE.1 .AND. PPTDAT(I,J,IHR-1).LE.900.)) THEN 576 DDATA(I,J) = PPTDAT(I,J,IHR)*FRACT 577 ELSE 578 DDATA(I,J) = PPTDAT(I,J,IHR)*FRACT 579 & + PPTDAT(I,J,IHR-1)*(SIXSIX-FRACT) 580 c & + PPTDAT(I,J,3)*FEND 581 582 ENDIF 583 C--- 584 CC IF ((SM(I,J)+SICE(I,J)).GT.0.5) THEN 585 IF (SM(I,J).GT.0.5) THEN 586 IF (GLATD.GT.GLATMIN .AND. GLATD.LT.GLATMAX) THEN 587 AFAC=1.0-((GLATD-GLATMIN)/(GLATMAX-GLATMIN)) 588 DDATA(I,J) = AFAC*DDATA(I,J) + (1.0-AFAC)*PREC(I,J) 589 END IF 590 END IF 591 C--- 592 C 593 C Use the difference between Pobs and Pmod to modify RH in the cloud 594 C (M. Baldwin, 20 Apr 99) by a factor of 595 C 1.0+0.2*(exp(r)-exp(-r))/(exp(r)+exp(-r)) where: r=(Pobs-Pmod in mm)/25mm 596 C (Pobs and Pmod are hourly precip). The value of the factor would be 597 C between 0.8 and 1.2. 598 C 599 CC The moisture field at T0 seems to be too wet. So only use PFACTOR to Page 7 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 600 CC dry the atmosphere if Pobs < Pmod. Otherwise set PFACTOR to 1. 601 CC No, don't do that ... for now. 602 PDIFF = (DDATA(I,J)-PREC(I,J))/(0.025*FRACT) 603 CC PDIFF = AMIN1(0.,PDIFF) 604 PEXP = EXP(PDIFF) 605 PEXP = PEXP * PEXP 606 PFACTOR(I,J) = 1.0 + 0.2 * (PEXP-1.)/(PEXP+1.) 607 C 608 C 609 C If PREC > 0 (i.e. Pmod > 0), partition DDATA into 'convective' 610 C and 'grid scale', based on the ratio of APREC/PREC. 611 C 612 C IF Pmod = 0, first assume that all observed precip are in fact 613 C convective (we will try to let convective adjustment take care 614 C of it first. If there's any leftover DDATA un-accounted for, 615 C we then let grid-scale precip take care of it. 616 C 617 IF (I.EQ.ITSTLOC .AND. J.EQ.JTSTLOC .AND. MYPE.EQ.MTSTPE) THEN 618 c print*,'should be writing to unit 98' 619 PPTSUM = PPTSUM + DDATA(I,J)*ENDFCTR 620 WRITE(98,*) 'DDATA=',DDATA(I,J),' PREC=',PREC(I,J), 621 & ' APREC=', APREC(I,J), ' ZER=',ZER,' PPTSUM=', PPTSUM 622 WRITE(98,*) 'PFACTOR=', PFACTOR(I,J), ' PDIFF=', PDIFF, 623 & ' PEXP=', PEXP 624 c print*,'i,j,ddata(i,j),prec(i,j),pptsum=', 625 c * i,j,ddata(i,j),prec(i,j),pptsum 626 ENDIF 627 100 CONTINUE 628 110 CONTINUE 629 C 630 C Set minimum cloud depth for deep convection. This would be scaled 631 C by the total atmosphere depth (PSFCIJ) at this horizontal point later on. 632 C 633 PSHNEW=20000. 634 C 635 C The big loop - looping through all horizontal grid points 636 C In M. Baldwin's original ADJPPT.f, there was no 'big (i,j) loop'. 637 C I am replacing the many little loops in his code with this big loop. 638 C The upper and lower limits of I and J are chosen to be this way to 639 C be consistent with his loop limits in the buoyancy calculation. 640 C 641 !$omp parallel do 642 !$omp& private(adjust,ai,apekl,apekxx,apekxy,apesp,apests, 643 !$omp& bi,bq,bqs00k,bqs10k,climit,cratio, 644 !$omp& delt,deltacp,delcwm,delq,depmin,depth,depwl,detacl, 645 !$omp& dsp,dsp0k,dspbk,dsptk,dthem, 646 !$omp& efi,efinew,elv,etabot,etatop,etbig, 647 !$omp& factor,fi,fiw,fiwl1, 648 !$omp& iq,iqtb,it,itb,ittb,ittbk,ivi, 649 !$omp& knuml,knunh,l0,l0m1,lb,lbtk,lbm1,lcbottm, 650 !$omp& lmhij,lmhk,ltp1,ltpk,numlev,oldcwm,oldq,oldrh, 651 !$omp& p00k,p01k,p10k,p11k,petal,pk0,pkb,pkl,pkt, 652 !$omp& pp1,prec1,preck,precmax,presk,psfc,psfck, 653 !$omp& qbt,qckl,qkl,qq1,qi,qint,qw, 654 !$omp& ratio,rdp0t,relhum,rhfctr,sq,sqs00k,sqs10k,stabdl, 655 !$omp& therkx,therky,tkl,tmt0,tmt15,tpsp,tq,trefkx, 656 !$omp& ttemp,tth,tthbt,tthes,wfix,wmin,yltmp) Page 8 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 657 DO 910 J=MYJS,MYJE 658 DO 900 I=MYIS,MYIE 659 IF (PPTDAT(I,J,IHR).GT.900. .OR. 660 & DDATA(I,J).LE.ZER .AND. PREC(I,J).LE.ZER) GOTO 900 661 C----------------------------------------------------------------------- 662 C--------------PREPARATIONS--------------------------------------------- 663 C----------------------------------------------------------------------- 664 THESP(I,J)=0. 665 PDSL (I,J)=RES(I,J)*PD(I,J) 666 LBOT (I,J)=LMH(I,J) 667 PBOT(I,J)=AETA(LBOT(I,J))*PDSL(I,J)+PT 668 TREF(I,J,1)=T(I,J,1) 669 C----------------------------------------------------------------------- 670 C--- CASE 1. Pobs = 0, Pmod > 0 671 C--------------IF OBSERVED PRECIP IS LESS THAN OR EQUAL TO ZER---------- 672 C--------------TAKE BACK THE LATENT HEAT RELEASE------------------------ 673 C----------------------------------------------------------------------- 674 IF (DDATA(I,J).LE.ZER .AND. PREC(I,J).GT.ZER) THEN 675 CLDEFI(I,J)=STEFI 676 DO 130 L=1,LM 677 IF (HTM(I,J,L).LT.0.5) GO TO 130 678 C--------- -FIND THE PRE-MODIFIED RELATIVE HUMIDITY FOR THIS POINT------ 679 PETAL=PDSL(I,J)*AETA(L)+PT 680 QCKL=PQ0/PETAL 681 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 682 683 if (QCKL.eq.0.0) then 684 write(0,*)"QCKL=0.0",QCKL,I,J,L,MYPE 685 write(0,*)PQ0,PETAL,T(I,J,L) 686 write(*,*)"QCKL=0.0",QCKL,I,J,L,MYPE 687 write(*,*)PQ0,PETAL,T(I,J,L) 688 CALL MPI_FINALIZE(IERR) 689 STOP 8 690 end if 691 692 RELHUM=Q(I,J,L)/QCKL 693 OLDRH=RELHUM 694 OLDQ=Q(I,J,L) 695 OLDCWM=CWM(I,J,L) 696 C MODIFY THE TEMP AND PRECIP 697 T(I,J,L)=T(I,J,L)-TLAT(I,J,L) 698 C Reduce RH by the factor PFACTOR: 699 QCKL=PQ0/PETAL 700 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 701 RELHUM= RELHUM * PFACTOR(I,J) 702 IF (TLAT(I,J,L).GT.0.) Q(I,J,L)=RELHUM*QCKL 703 IF (I.EQ.ITSTLOC .AND. J.EQ.JTSTLOC .AND. MYPE.EQ.MTSTPE) 704 2 WRITE(98,129) L, PETAL,TLAT(I,J,L), OLDRH, PFACTOR(I,J), 705 2 RELHUM, OLDQ, Q(I,J,L) 706 129 FORMAT(I2,X,f7.0,x,f7.4,X,3(2X,F6.4), X, 2(2X,E12.6)) ............................................1..............2 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+3'. (2) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 707 C If any part of model-predicted rainfall was grid-scale, decrease the 708 C cloud water mixing ratio ( if > WMIN) to the minimum value, WMIN: Page 9 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 709 IF (APREC(I,J).GT.0.) THEN 710 TTEMP=0.025*(T(I,J,L)-273.16) 711 WFIX=0.9814*EXP(0.01873*L) 712 WMIN=0.1E-3*EXP(TTEMP)*WFIX 713 c if(mype.eq.17) then 714 c print*,'in 130 loop' 715 c print*,'i,j,l=',i,j,l 716 c print*,'cwm(i,j,l),wmin=',cwm(i,j,l),wmin 717 c print*,'ttemp=',ttemp 718 c print*,'t(i,j,l)=',t(i,j,l) 719 c endif 720 CWM(I,J,L) = AMIN1(WMIN,CWM(I,J,L)) 721 ENDIF 722 c 723 c Calculate the water vapor and cloud water/ice increments for 724 c 1) the entire column 725 c 2) sfc-700mb 726 c 727 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 728 DELCWM = (CWM(I,J,L)-OLDCWM) * DETA(L)*PDSL(I,J)/G 729 c 730 VAPINC(I,J)=VAPINC(I,J)+DELQ 731 CLDINC(I,J)=CLDINC(I,J)+DELCWM 732 C 733 IF (PETAL.GE.70000.) THEN 734 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 735 CLDINC7(I,J)=CLDINC7(I,J)+DELCWM 736 ENDIF 737 130 CONTINUE 738 C Take back the PREC from ACPREC and CUPREC as well. For CUPREC, 739 C the amount taken back depends how much convective precip there 740 C was before the adjustment. 741 ACPREC(I,J)=ACPREC(I,J)-PREC(I,J) 742 CUPREC(I,J)=CUPREC(I,J)-(PREC(I,J)-APREC(I,J)) 743 CUPPT(I,J)= CUPPT(I,J)-(PREC(I,J)-APREC(I,J)) 744 PREC(I,J)=0. 745 APREC(I,J)=0. 746 GO TO 900 747 ENDIF 748 C 749 C CASE 2, Pmod > Pobs > 0 750 C 751 IF (DDATA(I,J).LE.PREC(I,J)) THEN 752 C THIS IS THE ADJUSTMENT WE DO IF WE HAD TOO MUCH PRECIP, CONVECTIVE 753 C OR OTHERWISE, IN THE MODEL. MULTIPLY THE LATENT HEAT 754 C AT EACH LEVEL BY THE FRACTION: DATA/MODEL RAINFALL 755 C MATCH THE RH THAT THE PROFILE HAD PRIOR TO THIS ADJUSTMENT 756 C-----------FIND THE PRE-MODIFIED RELATIVE HUMIDITY FOR THIS POINT------ 757 ADJUST=DDATA(I,J)/PREC(I,J) 758 if (i.eq.itstloc .and. j.eq.jtstloc .and. mype.eq.mtstpe) 759 & write(98,*) 760 & 'Check for Case 2, DDATA=', DDATA(I,J),' PREC=',PREC(I,J), 761 & ' ADJUST=', ADJUST, ' SR=', SR(I,J) 762 C Compute the ratio of convective precip/total precip: 763 CRATIO=(PREC(I,J)-APREC(I,J))/PREC(I,J) 764 C 765 DO 140 L=1,LM Page 10 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 766 IF (HTM(I,J,L).LT.0.5) GO TO 140 767 PETAL=PDSL(I,J)*AETA(L)+PT 768 c if(i.eq.16.and.j.eq.35.and.mype.eq.13.and.ntsd.eq.26) then 769 c print*,'i,j,l,aeta(l),pdsl(i,j)=',i,j,l,aeta(l),pdsl(i,j) 770 c endif 771 QCKL=PQ0/PETAL 772 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 773 RELHUM=Q(I,J,L)/QCKL 774 OLDRH=RELHUM 775 OLDQ=Q(I,J,L) 776 OLDCWM=CWM(I,J,L) 777 C MODIFY THE TEMP CHANGE AND PRECIP 778 T(I,J,L)=T(I,J,L)+TLAT(I,J,L)*(ADJUST-1.) 779 CYL 780 CYL Assume ice process below freezing, and water process otherwise. 781 CYL This is to be consistent with the latent heat calculation in PRECPD. 782 CYL 783 IF (T(I,J,L).GE.273.15) THEN 784 ELV=ELWV 785 ELSE 786 ELV=ELIV 787 ENDIF 788 DELT=TLAT(I,J,L)*(ADJUST-1.) 789 C The following is the 'accum pcp' version of DELT to take care of the 790 C fractional time step at the end of each EDAS segment: 791 DELTACP=TLAT(I,J,L)*(ADJUST*ENDFCTR-1.) 792 PREC(I,J)=DELT*DETA(L)*PDSL(I,J)*CP/(ROW*G*ELV)+PREC(I,J) 793 CUPREC(I,J)=DELTACP*DETA(L)*PDSL(I,J)*CP/(ROW*G*ELV)*CRATIO 794 2 +CUPREC(I,J) 795 ACPREC(I,J)=DELTACP*DETA(L)*PDSL(I,J)*CP/(ROW*G*ELV) 796 2 +ACPREC(I,J) 797 CUPPT(I,J)=DELTACP*DETA(L)*PDSL(I,J)*CP/(ROW*G*ELV)*CRATIO 798 2 +CUPPT(I,J) 799 C Reduce RH by the factor PFACTOR: 800 QCKL=PQ0/PETAL 801 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 802 RELHUM= RELHUM * PFACTOR(I,J) 803 IF (TLAT(I,J,L).GT.0.) Q(I,J,L)=RELHUM*QCKL 804 IF (I.EQ.ITSTLOC .AND. J.EQ.JTSTLOC .AND. MYPE.EQ.MTSTPE) 805 2 WRITE(98,128) L, PETAL,TLAT(I,J,L), T(I,J,L), OLDRH, 806 3 RELHUM, OLDQ, Q(I,J,L) 807 128 FORMAT(I2,X,f7.0,x,f7.4,X,F7.2,2(2X,F6.4), X, 2(2X,E12.6)) .................................................1..............2 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+3'. (2) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 808 C 809 C If the model had grid-scale precip prior to the adjustment, and 810 C the cloud water is above the minimum (WMIN) for generating rain, 811 C reduce the cloud water(CWM) proportionally, but keep it above WMIN, 812 C 813 IF (TLAT(I,J,L).GT.0. .and. APREC(I,J).GT.0. 814 2 .and. CWM(I,J,L).GT. WMIN) THEN 815 TTEMP=0.025*(T(I,J,L)-273.16) 816 WFIX=0.9814*EXP(0.01873*L) 817 WMIN=0.1E-3*EXP(TTEMP)*WFIX Page 11 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 818 c if(mype.eq.17) then 819 c print*,'in 140 loop' 820 c print*,'i,j,l=',i,j,l 821 c print*,'cwm(i,j,l),wmin=',cwm(i,j,l),wmin 822 c print*,'ttemp=',ttemp 823 c print*,'t(i,j,l)=',t(i,j,l) 824 c print*,'adjust=',adjust 825 c endif 826 CWM(I,J,L) = AMAX1(WMIN,CWM(I,J,L)*ADJUST) 827 ENDIF 828 c 829 c Calculate the water vapor and cloud water/ice increments for 830 c 1) the entire column 831 c 2) sfc-700mb 832 c 833 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 834 DELCWM = (CWM(I,J,L)-OLDCWM) * DETA(L)*PDSL(I,J)/G 835 c 836 VAPINC(I,J)=VAPINC(I,J)+DELQ 837 CLDINC(I,J)=CLDINC(I,J)+DELCWM 838 C 839 IF (PETAL.GE.70000.) THEN 840 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 841 CLDINC7(I,J)=CLDINC7(I,J)+DELCWM 842 ENDIF 843 140 CONTINUE 844 C 845 C We didn't adjust APREC yet. Here we'll reduce APREC proportionally: 846 APREC(I,J) = PREC(I,J) * (1.-CRATIO) 847 GO TO 900 848 ENDIF 849 C 850 C----------------------------------------------------------------------- 851 C Case 3 ------IF WE ARE HERE, THEN Pmod < Pobs ------------------------ 852 C--------------IF OBSERVED PRECIP IS GREATER THAN ZER------------------- 853 C--------------DETERMINE IF IT IS CONVECTIVE OR GRID-SCALE-------------- 854 C----------------------------------------------------------------------- 855 C GO THROUGH THE BETTS/MILLER/JANJIC CLOUD SEARCH, IF THE CLOUD 856 C IS CONSIDERED DEEP, THEN WE HAVE CONVECTION. 857 C----------------------------------------------------------------------- 858 C--------------PADDING SPECIFIC HUMIDITY IF TOO SMALL------------------- 859 C RESTORE APE TO SCRATCH ARRAY 860 DO 150 L=1,LM 861 APESTS=PDSL(I,J)*AETA(L)+PT 862 APE(I,J,L)=(1.E5/APESTS)**CAPA 863 IF(Q(I,J,L).LT.EPSQ)Q(I,J,L)=HTM(I,J,L)*EPSQ 864 150 CONTINUE 865 C--------------SEARCH FOR MAXIMUM BUOYANCY LEVEL------------------------ 866 DO 170 KB=1,LM 867 IF (HTM(I,J,L).LT.0.5) GO TO 170 868 C--------------TRIAL MAXIMUM BUOYANCY LEVEL VARIABLES------------------- 869 PKL=AETA(KB)*PDSL(I,J)+PT 870 LMHK=LMH(I,J) 871 PSFCK=AETA(LMHK)*PDSL(I,J)+PT 872 C 873 IF(KB.LE.LMHK .AND. PKL.GE.0.80*PSFCK) THEN 874 QBT=Q(I,J,KB) Page 12 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 875 TTHBT=T(I,J,KB)*APE(I,J,KB) 876 TTH=(TTHBT-THL)*RDTH 877 QQ1=TTH-AINT(TTH) 878 ITTB=INT(TTH)+1 879 C--------------KEEPING INDICES WITHIN THE TABLE------------------------- 880 IF(ITTB.LT.1)THEN 881 ITTB=1 882 QQ1=0. 883 ENDIF 884 C 885 IF(ITTB.GE.JTB)THEN 886 ITTB=JTB-1 887 QQ1=0. 888 ENDIF 889 C--------------BASE AND SCALING FACTOR FOR SPEC. HUMIDITY--------------- 890 ITTBK=ITTB 891 BQS00K=QS0(ITTBK) 892 SQS00K=SQS(ITTBK) 893 BQS10K=QS0(ITTBK+1) 894 SQS10K=SQS(ITTBK+1) 895 C--------------SCALING SPEC. HUMIDITY & TABLE INDEX--------------------- 896 BQ = (BQS10K-BQS00K)*QQ1+BQS00K 897 SQ = (SQS10K-SQS00K)*QQ1+SQS00K 898 TQ = (QBT-BQ)/SQ*RDQ 899 PP1 =TQ - AINT(TQ) 900 IQTB=INT(TQ)+1 901 C--------------KEEPING INDICES WITHIN THE TABLE------------------------- 902 IF(IQTB.LT.1)THEN 903 IQTB=1 904 PP1=0. 905 ENDIF 906 C 907 IF(IQTB.GE.ITB)THEN 908 IQTB=ITB-1 909 PP1=0. 910 ENDIF 911 C--------------SATURATION PRESSURE AT FOUR SURROUNDING TABLE PTS.------- 912 IQ=IQTB 913 IT=ITTB 914 P00K=PTBL(IQ ,IT ) 915 P10K=PTBL(IQ+1,IT ) 916 P01K=PTBL(IQ ,IT+1) 917 P11K=PTBL(IQ+1,IT+1) 918 C--------------SATURATION POINT VARIABLES AT THE BOTTOM----------------- 919 TPSP=P00K+(P10K-P00K)*PP1+(P01K-P00K)*QQ1 920 1 +(P00K-P10K-P01K+P11K)*PP1*QQ1 921 APESP=(1.E5/TPSP)**CAPA 922 TTHES=TTHBT*EXP(ELOCP*QBT*APESP/TTHBT) 923 C--------------CHECK FOR MAXIMUM BUOYANCY------------------------------- 924 IF(TTHES.GT.THESP(I,J))THEN 925 PSP (I,J)=TPSP 926 THBT (I,J)=TTHBT 927 THESP(I,J)=TTHES 928 ENDIF 929 ENDIF 930 C----------------------------------------------------------------------- 931 170 CONTINUE Page 13 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 932 C 933 C---------CHOOSE CLOUD BASE AS MODEL LEVEL JUST BELOW PSP-------------- 934 C 935 DO 190 L=1,LM1 936 IF (HTM(I,J,L).LT.0.5) GO TO 190 937 AETAL=AETA(L) 938 P(I,J)=PDSL(I,J)*AETAL+PT 939 IF(P(I,J).LT.PSP(I,J).AND.P(I,J).GE.PQM)LBOT(I,J)=L+1 940 190 CONTINUE 941 C*** 942 C*** WARNING: LBOT MUST NOT BE GT LMH(I,J)-1 IN SHALLOW CONVECTION 943 C*** MAKE SURE CLOUD BASE IS AT LEAST PONE ABOVE THE SURFACE 944 C*** 945 LMHIJ=LMH(I,J) 946 PBOT(I,J)=AETA(LBOT(I,J))*PDSL(I,J)+PT 947 PSFCK=AETA(LMHIJ)*PDSL(I,J)+PT 948 C 949 IF(PBOT(I,J).GE.PSFCK-PONE.OR.LBOT(I,J).GE.LMHIJ)THEN 950 DO 200 L=1,LMHIJ-1 951 IF (HTM(I,J,L).LT.0.5) GO TO 200 952 P(I,J)=AETA(L)*PDSL(I,J)+PT 953 IF(P(I,J).LT.PSFCK-PONE)LBOT(I,J)=L 954 200 CONTINUE 955 PBOT(I,J)=AETA(LBOT(I,J))*PDSL(I,J)+PT 956 ENDIF 957 C--------------CLOUD TOP COMPUTATION------------------------------------ 958 LTOP(I,J)=LBOT(I,J) 959 PTOP(I,J)=PBOT(I,J) 960 C----------------------------------------------------------------------- 961 c 962 DO 250 L=LM,1,-1 963 IF (HTM(I,J,L).LT.0.5) GO TO 250 964 c 965 C--------------SCALING PRESSURE & TT TABLE INDEX------------------------ 966 KNUML=0 967 KNUMH=0 968 C 969 PRESK=PDSL(I,J)*AETA(L)+PT 970 C 971 IF(PRESK.LT.PLQ)THEN 972 KNUML=KNUML+1 973 ILRES(KNUML)=I 974 JLRES(KNUML)=J 975 ELSE 976 KNUMH=KNUMH+1 977 IHRES(KNUMH)=I 978 JHRES(KNUMH)=J 979 ENDIF 980 C*** 981 C*** COMPUTE PARCEL TEMPERATURE ALONG MOIST ADIABAT FOR PRESSUREPL 993 C** 994 IF(KNUMH.GT.0)THEN 995 CALL TTBLEX(TREF(IDIM1,JDIM1,L),TTBLQ,ITBQ,JTBQ,KNUMH 996 1, IHRES,JHRES,PDSL,AETA(L),HTM(IDIM1,JDIM1,L) 997 2, PT,PLQ,QQ(IDIM1,JDIM1),PP(IDIM1,JDIM1) 998 3, RDPQ,THE0Q,STHEQ,RDTHEQ 999 4, THESP(IDIM1,JDIM1),IPTB(IDIM1,JDIM1) 1000 5, ITHTB(IDIM1,JDIM1)) 1001 ENDIF 1002 250 CONTINUE 1003 C--------------BUOYANCY CHECK------------------------------------------- 1004 DO 280 L=LM,1,-1 1005 IF (HTM(I,J,L).LT.0.5) GO TO 280 1006 IF(TREF(I,J,L).GT.T(I,J,L)-DTTOP)LTOP(I,J)=L 1007 280 CONTINUE 1008 C-----------------CLOUD TOP PRESSURE------------------------------------ 1009 PTOP(I,J)=AETA(LTOP(I,J))*PDSL(I,J)+PT 1010 C--------------CLEAN UP AND GATHER DEEP CONVECTION POINTS--------------- 1011 IF ((PPTDAT(I,J,IHR).LT.900 .AND. DDATA(I,J).LE.ZER).OR. 1012 & PPTDAT(I,J,IHR).LT.ZER) THEN 1013 LTOP(I,J)=LBOT(I,J) 1014 PTOP(I,J)=PBOT(I,J) 1015 ENDIF 1016 IF(LTOP(I,J).GT.LBOT(I,J))THEN 1017 LTOP(I,J)=LBOT(I,J) 1018 PTOP(I,J)=PBOT(I,J) 1019 ENDIF 1020 IF(HBM2(I,J).LT.0.90)THEN 1021 LTOP(I,J)=LBOT(I,J) 1022 PTOP(I,J)=PBOT(I,J) 1023 ENDIF 1024 C 1025 C If the cloud is too shallow for convective precip, go to grid scale. 1026 C 1027 PSFCIJ=PD(I,J)+PT 1028 DEPMIN=PSHNEW*PSFCIJ*1.E-5 1029 DEPTH=PBOT(I,J)-PTOP(I,J) 1030 if (i.eq.itstloc .and. j.eq.jtstloc .and. mype.eq.mtstpe) 1031 & write(98,*) 'PTOP=',ptop(i,j), ' PBOT=',pbot(i,j), 1032 & ' DEPTH=', DEPTH, ' DEPMIN=', DEPMIN 1033 C 1034 IF(DEPTH .LT. DEPMIN) THEN 1035 IGSADJ(I,J) = .TRUE. 1036 ADATA(I,J) = DDATA(I,J) 1037 GOTO 600 1038 ENDIF 1039 C*********************************************************************** 1040 C************* IF CLOUD IS DEEP ENOUGH THEN ASSUME CONVECTION ********** 1041 C************* IS OBSERVED, MAKE CONVECTIVE-TYPE ADJUSTMENT ************ 1042 C*********************************************************************** 1043 C*********************************************************************** 1044 C 1045 C ESTIMATE THE CHANGE IN EFI, BASIALLY MULTIPLYING CURRENT EFI Page 15 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1046 C BY FORECAST PREC/OBS PREC 1047 C 1048 C Don't worry - if we are here then DDATA > 0. 1049 FACTOR=PREC(I,J)/DDATA(I,J) 1050 C 1051 C IF THERE WAS NO FORECAST PRECIP, LEAVE EFI ALONE 1052 C 1053 IF (PREC(I,J).LE.ZER) FACTOR=1. 1054 EFINEW=CLDEFI(I,J)*FACTOR 1055 EFI=CLDEFI(I,J)*FCB+EFINEW*FCC 1056 IF (EFI.GT.1.0) EFI=1.0 1057 IF (EFI.LT.0.2) EFI=0.2 1058 IF (SM(I,J).LT.1.0.AND.DDATA(I,J).LT.CTHRS) EFI=1.0 1059 CLDEFI(I,J)=EFI 1060 C 1061 C TAKE BACK ANY LATENT HEAT/PRECIP THAT WAS RELEASED PREVIOUSLY 1062 C SINCE WE'LL BE ADJUSTING TO THE PROFILE THAT RELEASES HEAT 1063 C THAT SUMS UP TO THE OBSERVED PRECIP 1064 C 1065 DO L=1,LM 1066 IF (HTM(I,J,L).GT.0.5) T(I,J,L)=T(I,J,L)-TLAT(I,J,L) 1067 ENDDO 1068 C 1069 C TAKE BACK THE PRECIP TOO 1070 C 1071 CUPREC(I,J)=CUPREC(I,J)-(PREC(I,J)-APREC(I,J)) 1072 CUPPT(I,J)= CUPPT(I,J)-(PREC(I,J)-APREC(I,J)) 1073 ACPREC(I,J)=ACPREC(I,J)-PREC(I,J) 1074 PREC (I,J)=0. 1075 C 1076 LTPK=LTOP(I,J) 1077 LBTK=LBOT(I,J) 1078 CDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD 1079 CDCDCDCDCDCDC DEEP CONVECTION DCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD 1080 CDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD 1081 LB =LBTK 1082 EFI =CLDEFI(I,J) 1083 C--------------INITIALIZE VARIABLES IN THE CONVECTIVE COLUMN------------ 1084 C*** 1085 C*** ONE SHOULD NOTE THAT THE VALUES ASSIGNED TO THE ARRAY TREFK 1086 C*** IN THE 410 LOOP ARE REALLY ONLY RELEVANT IN ANCHORING THE 1087 C*** REFERENCE TEMPERATURE PROFILE AT LEVEL LB. WHEN BUILDING THE 1088 C*** REFERENCE PROFILE FROM CLOUD BASE, THEN ASSIGNING THE 1089 C*** AMBIENT TEMPERATURE TO TREFK IS ACCEPTABLE. HOWEVER, WHEN 1090 C*** BUILDING THE REFERENCE PROFILE FROM SOME OTHER LEVEL (SUCH AS 1091 C*** ONE LEVEL ABOVE THE GROUND), THEN TREFK SHOULD BE FILLED WITH 1092 C*** THE TEMPERATURES IN TREF(I,J,L) WHICH ARE THE TEMPERATURES OF 1093 C*** THE MOIST ADIABAT THROUGH CLOUD BASE. BY THE TIME THE LINE 1094 C*** NUMBERED 450 HAS BEEN REACHED, TREFK ACTUALLY DOES HOLD THE 1095 C*** REFERENCE TEMPERATURE PROFILE. 1096 C*** 1097 DO 410 L=1,LM 1098 IF (HTM(I,J,L).LT.0.5) GO TO 410 1099 DIFT (L)=0. 1100 DIFQ (L)=0. 1101 TKL =T(I,J,L) 1102 TK (L)=TKL Page 16 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1103 TREFK (L)=TKL 1104 QKL =Q(I,J,L) 1105 QK (L)=QKL 1106 QREFK (L)=QKL 1107 PKL =AETA(L)*PDSL(I,J)+PT 1108 PK (L)=PKL 1109 PSK (L)=PKL 1110 APEKL =APE(I,J,L) 1111 APEK (L)=APEKL 1112 THERK (L)=TREF(I,J,L)*APEKL 1113 410 CONTINUE 1114 C--------------DEEP CONVECTION REFERENCE TEMPERATURE PROFILE------------ 1115 cdrun 1116 LTP1=LTPK+1 1117 LBM1=LB-1 1118 PKB=PK(LB) 1119 PKT=PK(LTPK) 1120 C--------------TEMPERATURE REFERENCE PROFILE BELOW FREEZING LEVEL------- 1121 L0=LB 1122 PK0=PK(LB) 1123 TREFKX=TREFK(LB) 1124 THERKX=THERK(LB) 1125 APEKXX=APEK(LB) 1126 THERKY=THERK(LBM1) 1127 APEKXY=APEK(LBM1) 1128 C 1129 DO 420 L=LTPK,LBM1 1130 IVI=LTPK+LBM1-L 1131 IF(T(I,J,IVI+1).LT.TFRZ)GO TO 430 1132 STABDL=STABD 1133 TREFKX=((THERKY-THERKX)*STABDL 1134 1 +TREFKX*APEKXX)/APEKXY 1135 TREFK(IVI)=TREFKX 1136 APEKXX=APEKXY 1137 THERKX=THERKY 1138 APEKXY=APEK(IVI-1) 1139 THERKY=THERK(IVI-1) 1140 L0=IVI 1141 PK0=PK(L0) 1142 420 CONTINUE 1143 C--------------FREEZING LEVEL AT OR ABOVE THE CLOUD TOP----------------- 1144 L0M1=L0-1 1145 GO TO 445 1146 C--------------TEMPERATURE REFERENCE PROFILE ABOVE FREEZING LEVEL------- 1147 430 L0M1=L0-1 1148 RDP0T=1./(PK0-PKT) 1149 DTHEM=THERK(L0)-TREFK(L0)*APEK(L0) 1150 CCCCCCCCCCCCCCCDIR$ SHORTLOOP 1151 DO 440 L=LTPK,L0M1 1152 TREFK(L)=(THERK(L)-(PK(L)-PKT)*DTHEM*RDP0T)/APEK(L) 1153 440 CONTINUE 1154 C----------------------------------------------------------------------- 1155 C------------- ADJUST TEMP PROFILE TO MATCH OBSERVED PPT --------------- 1156 C----------------------------------------------------------------------- 1157 445 CONTINUE 1158 PRECMAX=0. 1159 C Page 17 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1160 DO L=LTPK,LB 1161 PRECMAX=PDSL(I,J)*DETA(L)*(TREFK(L)-TK(L))*CPRLG+PRECMAX 1162 ENDDO 1163 if (i.eq.itstloc .and. j.eq.jtstloc .and. mype.eq.mtstpe) 1164 & write(98,*)'PRECMAX=', PRECMAX 1165 C 1166 IF (PRECMAX.LE.0.) THEN 1167 C SEND THIS TO THE GRID-SCALE ADJUSTMENT 1168 C NOT ENOUGH POSITIVE AREA TO DO CONVECTIVE ADJUSTMENT 1169 LTOP(I,J)=LBOT(I,J)-3 1170 PTOP(I,J)=PBOT(I,J)-2.*PSHNEW 1171 ADATA(I,J) = DDATA(I,J) 1172 IGSADJ(I,J) = .TRUE. 1173 GOTO 600 1174 ENDIF 1175 C 1176 C IF THE OBS PRECIP IS GREATER THAN THE MAX POSSIBLE PRECIP 1177 C (WHICH IS THE AMOUNT YOU'D GET BY GOING ALL THE WAY TO THE 1178 C REF PROFILE) ONLY DO THE MAX POSSIBLE PRECIP. SET EFI TO EFIMN 1179 C IN AN ATTEMPT TO TRY TO GET THE GRID-SCALE PRECIP TO START 1180 C TAKING OVER 1181 C 1182 RATIO=DDATA(I,J)/PRECMAX 1183 IF (RATIO.GT.1.) THEN 1184 RATIO=1. 1185 EFI=EFIMN 1186 CLDEFI(I,J)=EFIMN 1187 IGSADJ(I,J) = .TRUE. 1188 ENDIF 1189 C 1190 DO L=LTPK,LB 1191 TREFK(L)=TK(L)+RATIO*(TREFK(L)-TK(L)) 1192 ENDDO 1193 1194 C--------------DEEP CONVECTION REFERENCE HUMIDITY PROFILE--------------- 1195 C DEFINE DSPS 1196 DSPBK=((EFI-EFIMN)*SLOPBS+DSPBSS)*SM(I,J) 1197 1 +((EFI-EFIMN)*SLOPBL+DSPBSL)*(1.-SM(I,J)) 1198 DSP0K=((EFI-EFIMN)*SLOP0S+DSP0SS)*SM(I,J) 1199 1 +((EFI-EFIMN)*SLOP0L+DSP0SL)*(1.-SM(I,J)) 1200 DSPTK=((EFI-EFIMN)*SLOPTS+DSPTSS)*SM(I,J) 1201 1 +((EFI-EFIMN)*SLOPTL+DSPTSL)*(1.-SM(I,J)) 1202 cccccccccccccccccCDIR$ SHORTLOOP 1203 450 CONTINUE 1204 DEPTH=PFRZ*PSFCIJ*1.E-5 1205 DEPWL=PKB-PK0 1206 DO 460 L=LTPK,LB 1207 C--------------SATURATION PRESSURE DIFFERENCE--------------------------- 1208 IF(DEPWL .GE. DEPTH) THEN 1209 IF(L.LT.L0)THEN 1210 DSP=((PK0-PK(L))*DSPTK+(PK(L)-PKT)*DSP0K)/(PK0-PKT) 1211 ELSE 1212 DSP=((PKB-PK(L))*DSP0K+(PK(L)-PK0)*DSPBK)/(PKB-PK0) 1213 ENDIF 1214 ELSE 1215 DSP=DSP0K 1216 IF(L.LT.L0) Page 18 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1217 1 DSP=((PK0-PK(L))*DSPTK+(PK(L)-PKT)*DSP0K)/(PK0-PKT) 1218 ENDIF 1219 C--------------HUMIDITY PROFILE----------------------------------------- 1220 IF(PK(L).GT.PQM)THEN 1221 PSK(L)=PK(L)+DSP 1222 APESK(L)=(1.E5/PSK(L))**CAPA 1223 THSK(L)=TREFK(L)*APEK(L) 1224 QREFK(L)=PQ0/PSK(L)*EXP(A2*(THSK(L)-A3*APESK(L)) 1225 1 /(THSK(L)-A4*APESK(L))) 1226 ELSE 1227 QREFK(L)=Q(I,J,L) 1228 ENDIF 1229 460 CONTINUE 1230 C--------------HEATING, MOISTENING, PRECIPITATION----------------------- 1231 PRECK =0. 1232 cccccccccccccccccccccccCDIR$ SHORTLOOP 1233 DO 530 L=LTPK,LB 1234 PRECK =DETA(L)*(TREFK(L)-TK(L))+PRECK 1235 530 CONTINUE 1236 C 1237 C--------------UPDATE PRECIPITATION, TEMPERATURE & MOISTURE------------- 1238 C 1239 PREC (I,J)=PDSL(I,J)*PRECK*CPRLG+PREC (I,J) 1240 CUPREC(I,J)=PDSL(I,J)*PRECK*CPRLG*ENDFCTR + CUPREC(I,J) 1241 CUPPT(I,J)=PDSL(I,J)*PRECK*CPRLG*ENDFCTR + CUPPT(I,J) 1242 ACPREC(I,J)=PDSL(I,J)*PRECK*CPRLG*ENDFCTR + ACPREC(I,J) 1243 ADATA(I,J)=DDATA(I,J)-PDSL(I,J)*PRECK*CPRLG 1244 APREC(I,J) = 0. 1245 if (i.eq.itstloc .and. j.eq.jtstloc .and. mype.eq.mtstpe) 1246 & write(98,*) 'After deep conv, PREC=',PREC(I,J),' CUPREC=', 1247 & CUPREC(I,J),' ACPREC=',ACPREC(I,J),' ADATA=',ADATA(I,J) 1248 C 1249 DO 580 L=LTPK,LB 1250 C Calculate the relative humidity before the T and Q update: 1251 PETAL=PDSL(I,J)*AETA(L)+PT 1252 QCKL=PQ0/PETAL 1253 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1254 RELHUM=Q(I,J,L)/QCKL 1255 C 1256 OLDRH=RELHUM 1257 OLDQ=Q(I,J,L) 1258 C 1259 T(I,J,L)=TREFK(L) 1260 Q(I,J,L)=QREFK(L) 1261 C 1262 C Increase RH by factor PFACTOR, but keep it under 90%: 1263 C 1264 QCKL=PQ0/PETAL 1265 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1266 C 1267 RELHUM= AMIN1(0.80, RELHUM*PFACTOR(I,J)) 1268 Q(I,J,L)=RELHUM*QCKL 1269 C 1270 c Calculate the water vapor increment for 1271 c 1) the entire column 1272 c 2) sfc-700mb 1273 c Page 19 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1274 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 1275 VAPINC(I,J)=VAPINC(I,J)+DELQ 1276 C 1277 IF (PETAL.GE.70000.) THEN 1278 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 1279 ENDIF 1280 1281 C tlat(l) in the following print is meaningless. Included so as to be 1282 C consistent with the earlier prints (for Pobs < Pmod) 1283 IF (MYPE.EQ.MTSTPE .AND. I.EQ.ITSTLOC .AND. J.EQ.JTSTLOC) 1284 2 WRITE(98,129) L,PETAL,TLAT(I,J,L), OLDRH, PFACTOR(I,J), 1285 3 RELHUM, OLDQ, Q(I,J,L) 1286 580 CONTINUE 1287 C 1288 CDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD 1289 CDCDCDCDCDCDC END OF DEEP CONVECTION DCDCDCDCDCDCDCD 1290 CDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCDCD 1291 C 1292 C----------------------------------------------------------------------- 1293 600 CONTINUE 1294 C----------------------------------------------------------------------- 1295 C--------------GATHER GRID-SCALE PRECIP ADJUSTMENT POINTS--------------- 1296 C----------------------------------------------------------------------- 1297 C 1298 IF(.NOT.IGSADJ(I,J)) GO TO 900 1299 C 1300 C*********************************************************************** 1301 C 1302 LMHK=LMH(I,J) 1303 C 1304 IF (APREC(I,J).GT.ZER.AND.ADATA(I,J).GT.ZER) THEN 1305 C 1306 C THIS IS THE ADJUSTMENT WE DO IF WE HAVE RAIN BOTH IN THE 1307 C DATA AND IN THE MODEL, MULTIPLY THE LATENT HEAT 1308 C AT EACH LEVEL BY THE FRACTION: DATA/MODEL RAINFALL 1309 C WHILE NOT CHANGING DELTA Q 1310 C THE Q CHANGE IS IMPLICIT, INCREASING Q 1311 C AND THEN REMOVING IT VIA CONDENSATION. 1312 C MATCH THE RH THAT THE PROFILE HAD PRIOR TO THIS ADJUSTMENT 1313 C IF THE RATIO OF OBS PPT TO PREC(K) IS > 10, SEND IT TO THE 1314 C PARABOLIC PROFILE PART OF THIS ROUTINE 1315 C 1316 C Near the top of the model, the cirrus clouds produce a not-insignificant 1317 C amount of snow. Whether this is physically true is debatable (the ice 1318 C crystals dropping from these cirri play a role, to be sure, but it should 1319 C be more in the sense of a catalyst (seeder-feeder mechanism) than in terms 1320 C of _amount_ of snow. Anyway, if we increase the TLAT and Q at these levels 1321 C we could be in trouble. Let's only do the adjustment below 200mb. 1322 C 1323 ADJUST=ADATA(I,J)/APREC(I,J) 1324 if (i.eq.itstloc .and. j.eq.jtstloc .and. mype.eq.mtstpe) 1325 & write(98,*) 'adjust=', adjust 1326 IF (ADJUST.LE.10.0) THEN 1327 C-----------FIND THE PRE-MODIFIED RELATIVE HUMIDITY FOR THIS POINT------ 1328 DO 640 L=1,LMHK 1329 IF (HTM(I,J,L).LT.0.5) GO TO 640 1330 PETAL=PDSL(I,J)*AETA(L)+PT Page 20 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1331 IF (PETAL.LE.20000.) go to 640 1332 QCKL=PQ0/PETAL 1333 2 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1334 RELHUM=Q(I,J,L)/QCKL 1335 OLDQ=Q(I,J,L) 1336 OLDCWM=CWM(I,J,L) 1337 C MODIFY THE TEMP CHANGE AND PRECIP 1338 T(I,J,L)=T(I,J,L)+TLAT(I,J,L)*(ADJUST-1.) 1339 CYL IF (T(I,J,L).GT.258.) THEN 1340 IF (T(I,J,L).GT.258. .and. SR(I,J).LT.0.9) THEN 1341 ELV=ELWV-DLDT*(T(I,J,L)-A3) 1342 ELSE 1343 ELV=ELIV 1344 END IF 1345 DELT=TLAT(I,J,L)*(ADJUST-1.) 1346 C The following is the 'accum pcp' version of DELT to take care of the 1347 C fractional time step at the end of each EDAS segment: 1348 DELTACP=TLAT(I,J,L)*(ADJUST*ENDFCTR-1.) 1349 PREC(I,J)=DELT*DETA(L)*PDSL(I,J)*CP/(ELV*ROW*G) 1350 2 +PREC(I,J) 1351 APREC(I,J)=DELTACP*DETA(L)*PDSL(I,J)*CP/(ELV*ROW*G) 1352 2 +APREC(I,J) 1353 ACPREC(I,J)=DELTACP*DETA(L)*PDSL(I,J) 1354 2 *CP/(ELV*ROW*G) + ACPREC(I,J) 1355 C SET THE RH TO BE THE SAME AS IT WAS BEFORE THE LATENT HEAT MODIFI. 1356 QCKL=PQ0/PETAL * EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1357 RELHUM= RELHUM * PFACTOR(I,J) 1358 Q(I,J,L)=RELHUM*QCKL 1359 C 1360 C Cloud adjustment for grid-scale precip: increase/decrease 1361 C the cloud water mixing ratio proportionally (take care not to go below 1362 C the minimum CWM to produce rain). If the precip is convective, 1363 C not adjusting cloud. 1364 C 1365 C Cloud adjustment. 1366 C First, calculate minimum cloud water for rain production. Note: we're 1367 C only doing the adjustment in levels where TLAT > 0, i.e. where rain was 1368 C produced. 1369 C 1370 C 2002/10/11: only do the cloud adjustment if ADJUST < 1 (i.e. to only reduce 1371 C cloud, not to increase it. Remember that CWM is cloud water+cloud ice. 1372 C If we just increase CWM proportionally, we could be increasing cloud ice 1373 C by nearly 10 fold right underneath 200mb (10 fold is the cap). 1374 C Much more prudent to not increase CWM at all, just make sure it's above 1375 C the minimum required to form precip. 1376 C 1377 IF (TLAT(I,J,L).GT.0. .and. ADJUST.LT.1.) THEN 1378 TTEMP=0.025*(T(I,J,L)-273.16) 1379 WFIX=0.9814*EXP(0.01873*L) 1380 WMIN=0.1E-3*EXP(TTEMP)*WFIX 1381 c if(mype.eq.17) then 1382 c print*,'in 640 loop' 1383 c print*,'i,j,l=',i,j,l 1384 c print*,'cwm(i,j,l),wmin=',cwm(i,j,l),wmin 1385 c print*,'ttemp=',ttemp 1386 c print*,'t(i,j,l)=',t(i,j,l) 1387 c print*,'adjust=',adjust Page 21 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1388 c endif 1389 CWM(I,J,L) = AMAX1(WMIN,CWM(I,J,L)*ADJUST) 1390 ENDIF 1391 c 1392 c Calculate the water vapor and cloud water/ice increments for 1393 c 1) the entire column 1394 c 2) sfc-700mb 1395 c 1396 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 1397 DELCWM = (CWM(I,J,L)-OLDCWM) * DETA(L)*PDSL(I,J)/G 1398 c 1399 VAPINC(I,J)=VAPINC(I,J)+DELQ 1400 CLDINC(I,J)=CLDINC(I,J)+DELCWM 1401 C 1402 IF (PETAL.GE.70000.) THEN 1403 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 1404 CLDINC7(I,J)=CLDINC7(I,J)+DELCWM 1405 ENDIF 1406 640 CONTINUE 1407 ENDIF 1408 ENDIF 1409 C 1410 IF ((APREC(I,J).LE.ZER.AND.ADATA(I,J).GT.ZER) 1411 & .OR.ADJUST.GT.10.) THEN 1412 C FINALLY, IF THE MODEL SAYS THAT NO RAIN OCCURED WHILE THE 1413 C DATA SAYS THAT WE GOT SOMETHING, 1414 C OR IF THE RATIO OF OBS PRECIP TO FORECASTED PRECIP IS > 10 1415 C THE FOLLOWING OCCURS 1416 C WE SPECIFY A PARABOLIC LATENT HEAT PROFILE 1417 C AND COLLECT THE APPROPRIATE AMOUNT OF RAIN FROM THIS HEAT PROFILE 1418 C WE ARE GOING TO INCREASE Q IN THE HEATED LAYERS SO THE RH WILL BE 1419 C 80%. THIS SHOULD HELP TO GET SOME MODEL PRECIP THE NEXT TIMESTEP 1420 C CLOUD BASE IS THE FIRST LEVEL ABOVE GROUND WHERE RH>80% 1421 C CLOUD TOP IS THE FIRST LEVEL ABOVE CLOUD BASE WHERE RH<80% 1422 C IF THIS CLOUD IS TOO SHALLOW, THEN SPECIFY A X MB CLOUD 1423 C X MB ABOVE GROUND, DEPENDING UPON PPT RATE 1424 C----------------------------------------------------------------------- 1425 PSFC=PD(I,J)+PT 1426 FIWL1=0. 1427 CLIMIT=1.E-20 1428 C 1429 DO 650 L=1,LMHK 1430 IF (HTM(I,J,L).LT.0.5) GO TO 650 1431 TMT0=(T(I,J,L)-273.16) 1432 TMT15=AMIN1(TMT0,-15.) 1433 AI=0.008855 1434 BI=1. 1435 IF(TMT0.LT.-20.)THEN 1436 AI=0.007225 1437 BI=0.9674 1438 ENDIF 1439 QW=PQ0/(PDSL(I,J)*AETA(L)+PT) 1440 1 *EXP(A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1441 QI=QW*(BI+AI*AMIN1(TMT0,0.)) 1442 QINT=QW*(1.-0.00032*TMT15*(TMT15+15.)) 1443 IF(TMT0.LE.-40.)QINT=QI 1444 C-------------------ICE-WATER ID NUMBER IW------------------------------ Page 22 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1445 IF(TMT0.LT.-15.)THEN 1446 FI=Q(I,J,L)-0.75*QI 1447 IF(FI.GT.0.0.OR.CWM(I,J,L).GT.CLIMIT) THEN 1448 FIW=1. 1449 ELSE 1450 FIW=0. 1451 ENDIF 1452 ENDIF 1453 IF(TMT0.LT.0.0.AND.TMT0.GE.-15.0)THEN 1454 FIW=0. 1455 IF(FIWL1.GT.0.0.AND.CWM(I,J,L).GT.CLIMIT)FIW=1. 1456 ENDIF 1457 IF(TMT0.GE.0.)THEN 1458 FIW=0. 1459 ENDIF 1460 QC(L)=(1.-FIW)*QINT+FIW*QI 1461 FIWL1=FIW 1462 RELH(L)=Q(I,J,L)/QC(L) 1463 650 CONTINUE 1464 C 1465 PBOT=0. 1466 PTOP=0. 1467 C 1468 DO 660 L=LMHK,2,-1 1469 IF (HTM(I,J,L).LT.0.5) GO TO 660 1470 PETAL=PDSL(I,J)*AETA(L)+PT 1471 IF (PETAL.LT.20000.) go to 660 1472 IF(PBOT(I,J).EQ.0.0.AND.RELH(L).GE.0.80) THEN 1473 PBOT(I,J)=PDSL(I,J)*AETA(L)+PT 1474 PTOP(I,J)=PBOT(I,J) 1475 ENDIF 1476 IF(PBOT(I,J).GT.0.0.AND.PTOP(I,J).EQ.PBOT(I,J) 1477 & .AND. RELH(L).LT.0.80) PTOP(I,J)=PDSL(I,J)*AETA(L)+PT 1478 660 CONTINUE 1479 C 1480 IF (PBOT(I,J)-PTOP(I,J).LT.20000.0) THEN 1481 C 1482 C CLOUD SEARCH BASED UPON RH FAILED TO PRODUCE A SIGNIFICANT CLOUD 1483 C SO SPECIFIY CLOUD FROM PRECIP RATE 1484 C 1485 C the following have been specified before loop 900: 1486 C PTRES1=2.81E-03*SIXSIX 1487 C PTRES2=3.75E-04*SIXSIX 1488 C PTRES3=1.0E-03*SIXSIX 1489 C 1490 C THIS IS THE THRESHOLD VALUE FOR DETERMINING THE DEPTH OF CLOUD 1491 C TO BE HEATED (OR WHETHER TO INCREASE RH IN Q ENHANCEMENT) 1492 C 1493 C CLOUD BASE IS 150 MB ABOVE SURFACE FOR ALL CLOUDS 1494 C 1495 PBOT(I,J)=PSFC-15000. 1496 C 1497 C CLOUD TOP IS AT 200 MB FOR INTENSE PRECIP 1498 C 1499 IF (ADATA(I,J).GE.PTRES1) PTOP(I,J)=20000. 1500 C 1501 C CLOUD DEPTH IS 450 MB FOR MODERATE PRECIP Page 23 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1502 C (HIGHEST CLOUD TOP ALLOWED IS AT 200 MB) 1503 C 1504 IF (ADATA(I,J).GE.PTRES2.AND.ADATA(I,J).LT.PTRES1) THEN 1505 PTOP(I,J)=PBOT(I,J)-45000. 1506 IF (PTOP(I,J).LT.20000.) PTOP(I,J)=20000. 1507 END IF 1508 C 1509 C CLOUD DEPTH IS 300 MB FOR LIGHT PRECIP 1510 C (HIGHEST CLOUD TOP ALLOWED IS AT 200 MB) 1511 C 1512 IF (ADATA(I,J).LT.PTRES2) THEN 1513 PTOP(I,J)=PBOT(I,J)-30000. 1514 IF (PTOP(I,J).LT.20000.) PTOP(I,J)=20000. 1515 ENDIF 1516 ENDIF 1517 C 1518 C FIND LAYERS JUST ABOVE PTOP AND PBOT 1519 C 1520 DO 670 L=1,LM 1521 IF (HTM(I,J,L).LT.0.5) GO TO 670 1522 PK(L)=PDSL(I,J)*AETA(L)+PT 1523 IF (PK(L).LT.PBOT(I,J)) LCBOT=L 1524 IF (PK(L).LT.PTOP(I,J)) LCTOP=L 1525 670 CONTINUE 1526 C 1527 NUMLEV=LCBOT-LCTOP+1 1528 PREC1=(ADATA(I,J)-APREC(I,J))/NUMLEV 1529 DETACL=0.0 1530 C 1531 DO 680 L=LCTOP,LCBOT 1532 DETACL=DETACL+DETA(L) 1533 680 CONTINUE 1534 C 1535 C THIS VERSION HAS A PARABOLIC PROFILE OF PRECIP 1536 C WHICH ALLOWS FOR A CHANGE IN LATENT HEATING WITH 1537 C TEMPERATURE, ESPECIALLY NEAR THE FREEZING LEVEL 1538 C 1539 C I DEFINE THE ETATOP AND ETABOT TO BE THE INTERFACIAL 1540 C LAYERS OF THE CLOUD OUTSIDE THE ACTUAL AETA(LCTOP) 1541 C AND AETA(LCBOT) 1542 C 1543 ETATOP=AETA(LCTOP)-DETA(LCTOP)/2.0 1544 ETABOT=AETA(LCBOT)+DETA(LCBOT)/2.0 1545 DO 690 L=LCTOP,LCBOT 1546 IF (T(I,J,L).GT.258.) THEN 1547 ELV=ELWV-DLDT*(T(I,J,L)-A3) 1548 ELSE 1549 ELV=ELIV 1550 END IF 1551 OLDQ=Q(I,J,L) 1552 ETBIG=AETA(L)*AETA(L)-(ETATOP+ETABOT)*AETA(L)+ETABOT*ETATOP 1553 PRECL(I,J)=-6.0*PREC1*ETBIG/ 1554 & ((ETATOP-ETABOT)*(ETATOP-ETABOT)) 1555 DELT=PRECL(I,J)*G*ROW*ELV/(CP*DETA(L)*PDSL(I,J)) 1556 T(I,J,L)=DELT+T(I,J,L) 1557 PREC(I,J)=DELT*DETA(L)*PDSL(I,J)*CP/(ELV*ROW*G)+PREC(I,J) 1558 ACPREC(I,J)=DELT*DETA(L)*PDSL(I,J)*CP/ Page 24 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1559 & (ELV*ROW*G)*ENDFCTR + ACPREC(I,J) 1560 APREC(I,J)=DELT*DETA(L)*PDSL(I,J)*CP/ 1561 & (ELV*ROW*G)*ENDFCTR + APREC(I,J) 1562 IF (I.EQ.ITSTLOC .AND. J.EQ.JTSTLOC .AND. MYPE.EQ.MTSTPE) THEN 1563 yltmp = DELT*DETA(L)*PDSL(I,J)*CP/(ELV*ROW*G) 1564 write(98,689) L, etbig,precl(i,j),yltmp, 1565 & aprec(i,j), prec(i,j) 1566 689 format(i2,3x,5(2x,e12.6)) ..................................1 (1) Recommended relationship between field width 'W' and the number of fractional digits 'D' in this edit descriptor is 'W>=D+7'. 1567 endif 1568 C 1569 C KICK THE RH UP TO 80% IN THE HEATED LAYERS IF THE OBS PRECIP 1570 C RATE IS MORE THAN 1.0 MM/HR 1571 IF (ADATA(I,J).GE.PTRES3) THEN 1572 QC(L)=HTM(I,J,L)*PQ0/(PDSL(I,J)*AETA(L)+PT) 1573 2 *EXP(HTM(I,J,L)*A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1574 Q(I,J,L)=0.80*QC(L) 1575 END IF 1576 C 1577 c 1578 c Calculate the water vapor increment for 1579 c 1) the entire column 1580 c 2) sfc-700mb 1581 c 1582 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 1583 VAPINC(I,J)=VAPINC(I,J)+DELQ 1584 IF (PETAL.GE.70000.) THEN 1585 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 1586 ENDIF 1587 1588 690 CONTINUE 1589 CYL If below this newly added layer of cloud, the air is too dry, the 1590 c added rain will quickly evaporate, leading to rapid cooling (could 1591 c be 3 degs in one timestep in PRECPD), and the shock might lead to 1592 c a blowup. So we need to moisten the air below the cloud layer too. 1593 c We first tried setting it to 80%, minimum (80% or the original RH, 1594 c whichever is greater), but that proved to be too much. So now 1595 c I'm just moistening (when necessary) the three layers underneath 1596 c the cloud base - 80% at LCBOT+1, 70% at LCBOT+2, and 60% at LCBOT+3. 1597 c 1598 c The cloud base shouldn't go below the ground surface. 1599 c 1600 LCBOTTM = MIN0(LMHK,LCBOT+3) 1601 DO 700 L = LCBOT+1, LCBOTTM 1602 IF (ADATA(I,J).GE.PTRES3) THEN 1603 OLDQ=Q(I,J,L) 1604 RHFCTR = 1. - 0.1*FLOAT(L-LCBOT+1) 1605 QC(L)=HTM(I,J,L)*PQ0/(PDSL(I,J)*AETA(L)+PT) 1606 2 *EXP(HTM(I,J,L)*A2*(T(I,J,L)-A3)/(T(I,J,L)-A4)) 1607 Q(I,J,L)=AMAX1(Q(I,J,L),RHFCTR*QC(L)) 1608 C 1609 c Calculate the water vapor increment for 1610 c 1) the entire column 1611 c 2) sfc-700mb 1612 c Page 25 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1613 DELQ = (Q(I,J,L)-OLDQ) * DETA(L)*PDSL(I,J)/G 1614 VAPINC(I,J)=VAPINC(I,J)+DELQ 1615 C 1616 IF (PETAL.GE.70000.) THEN 1617 VAPINC7(I,J)=VAPINC7(I,J)+DELQ 1618 ENDIF 1619 END IF 1620 700 CONTINUE 1621 C 1622 C Cloud adjustment: for the layer of cloud we specified, 1623 C we set cloud water mixing ratio to WMIN or the original CWM, which 1624 C ever is greater. 1625 C 1626 DO 710 L = LCTOP, LCBOT 1627 OLDCWM=CWM(I,J,L) 1628 TTEMP=0.025*(T(I,J,L)-273.16) 1629 WFIX=0.9814*EXP(0.01873*L) 1630 WMIN=0.1E-3*EXP(TTEMP)*WFIX 1631 c if(mype.eq.17) then 1632 c print*,'in 710 loop' 1633 c print*,'i,j,l=',i,j,l 1634 c print*,'cwm(i,j,l),wmin=',cwm(i,j,l),wmin 1635 c print*,'ttemp=',ttemp 1636 c print*,'t(i,j,l)=',t(i,j,l) 1637 c endif 1638 CWM(I,J,L) = AMAX1(WMIN,CWM(I,J,L)) 1639 c 1640 c Calculate the cloud water/ice increment for 1641 c 1) the entire column 1642 c 2) sfc-700mb 1643 c 1644 DELCWM = (CWM(I,J,L)-OLDCWM) * DETA(L)*PDSL(I,J)/G 1645 CLDINC(I,J)=CLDINC(I,J)+DELCWM 1646 C 1647 IF (PETAL.GE.70000.) THEN 1648 CLDINC7(I,J)=CLDINC7(I,J)+DELCWM 1649 ENDIF 1650 710 CONTINUE 1651 C 1652 ENDIF 1653 C 1654 C----------------------------------------------------------------------- 1655 C*********************************************************************** 1656 C*******END OF HORIZONTAL LOOP FOR GRID-SCALE TYPE ADJUSTMENT ********** 1657 C*********************************************************************** 1658 C----------------------------------------------------------------------- 1659 C----------------------------------------------------------------------- 1660 C--------------SAVE CLOUD TOP AND BOTTOM FOR RADIATION------------------ 1661 HTOP(I,J)=MIN(FLOAT(LTOP(I,J)),HTOP(I,J)) 1662 HBOT(I,J)=MAX(FLOAT(LBOT(I,J)),HBOT(I,J)) 1663 C*********************************************************************** 1664 C 1665 900 CONTINUE 1666 910 CONTINUE 1667 C 1668 C Zero out latent heat array to be ready for the next round of tracking/ 1669 C adjustments: Page 26 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F 1670 C 1671 TLAT = 0.0 1672 C 1673 IF (MYPE.EQ.MTSTPE) THEN 1674 WRITE(98,*) ' AT END OF ADJPPT, PREC=',PREC(ITSTLOC,JTSTLOC), 1675 & ' APREC=',APREC(ITSTLOC,JTSTLOC), 1676 & ' ACPREC=',ACPREC(ITSTLOC,JTSTLOC), 1677 & ' CUPREC=', CUPREC(ITSTLOC,JTSTLOC) 1678 WRITE(98,*) 1679 ENDIF 1680 C 1681 RETURN 1682 END ENTRY POINTS Name adjppt_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 312 247,257 110 Label 313 246 128 Label 492 490 129 Label 391 389,969 130 Label 422 361,362 140 Label 528 450,451 150 Label 549 545 170 Label 616 551,552 190 Label 625 620,621 200 Label 639 635,636 250 Label 687 647,648 280 Label 692 689,690 410 Label 798 782,783 420 Label 827 814 430 Label 832 816 440 Label 838 836 445 Label 842 830 450 Label 888 460 Label 914 891 530 Label 920 918 580 Label 971 934 600 Label 978 722,858 640 Label 1091 1013,1014,1016 650 Label 1148 1114,1115 660 Label 1163 1153,1154,1156 670 Label 1210 1205,1206 680 Label 1218 1216 689 Label 1251 1249 690 Label 1273 1230 700 Label 1305 1286 710 Label 1335 1311 Page 27 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 1350 343,345,431,532,983 910 Label 1351 342 A2 Param 7 R(4) 4 scalar 88,366,385,457,486,909,938,950,101 8,1041,1125,1258,1291 A23M4L Param 88 R(4) 4 scalar A3 Param 7 R(4) 4 scalar 88,366,385,457,486,909,938,950,101 8,1026,1041,1125,1232,1258,1291 A4 Param 7 R(4) 4 scalar 88,366,385,457,486,910,938,950,101 8,1041,1125,1258,1291 ACCLIQ Scalar 13 R(4) 4 2 17955 COM ACMCLH Common 2 6463824 ACPREC Scalar 12 R(4) 4 2 17955 COM 426,480,481,758,927,932,1038,1039, 1243,1244,1361 ACUTIM Scalar 3 R(4) 4 scalar COM ADATA Local 108 R(4) 4 2 17955 721,856,928,932,989,1008,1095,1184 ,1189,1197,1213,1256,1287 ADJPPT Subr 1 ADJUST Local 442 R(4) 4 scalar 442,446,463,473,476,511,1008,1010, 1011,1023,1030,1033,1062,1074,1096 AETA Scalar 9 R(4) 4 1 45 COM 352,364,452,546,554,556,622,631,63 2,637,640,654,670,681,694,792,936, 1015,1124,1155,1158,1162,1207,1228 ,1229,1237,1257,1290 AETAL Local 622 R(4) 4 scalar 622,623 AFAC Local 272 R(4) 4 scalar 272,273 AFSI Scalar 26 R(4) 4 2 17955 COM AI Local 1118 R(4) 4 scalar 1118,1121,1126 AINT Func 562 scalar 562,584 AKHS Scalar 7 R(4) 4 2 17955 COM AKMS Scalar 7 R(4) 4 2 17955 COM ALBASE Scalar 20 R(4) 4 2 17955 COM ALBEDO Scalar 21 R(4) 4 2 17955 COM AMAX1 Func 511 scalar 511,1074,1292,1323 AMIN1 Func 405 scalar 405,952,1117,1126 APE Local 109 R(4) 4 3 807975 547,560,795 APEBT Local 100 R(4) 4 2 17955 APEK Local 91 R(4) 4 1 45 796,810,812,823,834,837,908 APEKL Local 795 R(4) 4 scalar 795,796,797 APEKXX Local 810 R(4) 4 scalar 810,819,821 APEKXY Local 812 R(4) 4 scalar 812,819,821,823 APESK Local 92 R(4) 4 1 45 907,909,910 APESP Local 606 R(4) 4 scalar 606,607 APESTS Local 546 R(4) 4 scalar 546,547 APREC Scalar 3 R(4) 4 2 17955 COM 306,394,427,428,430,448,498,531,75 6,757,929,989,1008,1036,1037,1095, 1213,1245,1246,1250,1360 ARATIM Scalar 3 R(4) 4 scalar COM AVCNVC Scalar 3 R(4) 4 scalar COM AVGEFI Param 75 R(4) 4 scalar AVRAIN Scalar 3 R(4) 4 scalar COM BI Local 1119 R(4) 4 scalar 1119,1122,1126 BQ Local 581 R(4) 4 scalar 581,583 BQS00K Local 576 R(4) 4 scalar 576,581 BQS10K Local 578 R(4) 4 scalar 578,581 CAPA Param 5 R(4) 4 scalar 547,606,907 Page 28 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References CFRACH Scalar 4 R(4) 4 2 17955 COM CFRACL Scalar 3 R(4) 4 2 17955 COM CFRACM Scalar 4 R(4) 4 2 17955 COM CI Scalar 6 R(4) 4 scalar COM CLDEFI Scalar 11 R(4) 4 2 17955 COM 360,739,740,744,767,871 CLDINC Scalar 6 R(4) 4 2 17955 COM 416,522,1085,1330 CLDINC7 Scalar 6 R(4) 4 2 17955 COM 420,526,1089,1333 CLDWTR Common 2 3447720 CLIMIT Local 1112 R(4) 4 scalar 1112,1132,1140 CNVBOT Scalar 18 R(4) 4 2 17955 COM CNVCLD Common 2 287280 CNVTOP Scalar 18 R(4) 4 2 17955 COM COUNT Local 177 R(4) 4 scalar 177,181,184 CP Param 5 R(4) 4 scalar 89,477,478,480,482,1034,1036,1039, 1240,1242,1243,1245,1248 CPRLG Param 89 R(4) 4 scalar 846,924,925,926,927,928 CRATIO Local 448 R(4) 4 scalar 448,478,482,531 CS Scalar 6 R(4) 4 scalar COM CTHRS Local 175 R(4) 4 scalar 175,743 CTLBLK Common 4 112 CUPPT Scalar 3 R(4) 4 2 17955 COM 428,482,483,757,926 CUPREC Scalar 13 R(4) 4 2 17955 COM 427,478,479,756,925,932,1362 CWM Scalar 3 R(4) 4 3 807975 COM 380,405,413,461,499,511,519,1021,1 074,1082,1132,1140,1312,1323,1329 CZEN Scalar 16 R(4) 4 2 17955 COM CZMEAN Scalar 23 R(4) 4 2 17955 COM DDATA Local 108 R(4) 4 2 17955 261,263,273,287,304,305,345,359,43 6,442,445,696,721,734,743,856,867, 928 DELCWM Local 413 R(4) 4 scalar 413,416,420,519,522,526,1082,1085, 1089,1329,1330,1333 DELQ Local 412 R(4) 4 scalar 412,415,419,518,521,525,959,960,96 3,1081,1084,1088,1267,1268,1270,12 98,1299,1302 DELT Local 473 R(4) 4 scalar 473,477,1030,1034,1240,1241,1242,1 243,1245,1248 DELTACP Local 476 R(4) 4 scalar 476,478,480,482,1033,1036,1038 DEPMIN Local 713 R(4) 4 scalar 713,717,719 DEPTH Local 714 R(4) 4 scalar 714,717,719,889,893 DEPWL Local 890 R(4) 4 scalar 890,893 DETA Scalar 9 R(4) 4 1 45 COM 412,413,477,478,480,482,518,519,84 6,919,959,1034,1036,1038,1081,1082 ,1217,1228,1229,1240,1242,1243,124 5,1248,1267,1298,1329 DETACL Local 1214 R(4) 4 scalar 1214,1217 DFRLG Scalar 9 R(4) 4 1 46 COM DI Scalar 6 R(4) 4 scalar COM DIFQ Local 93 R(4) 4 1 45 785 DIFT Local 93 R(4) 4 1 45 784 DLDT Param 63 R(4) 4 scalar 1026,1232 DS Scalar 6 R(4) 4 scalar COM DSP Local 895 R(4) 4 scalar 895,897,900,902,906 DSP0FL Param 56 R(4) 4 scalar 61,81 DSP0FS Param 60 R(4) 4 scalar 62,84 DSP0K Local 883 R(4) 4 scalar 883,895,897,900,902 Page 29 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References DSP0SL Param 61 R(4) 4 scalar 81,884 DSP0SS Param 62 R(4) 4 scalar 84,883 DSPBFL Param 56 R(4) 4 scalar 61,80 DSPBFS Param 60 R(4) 4 scalar 62,83 DSPBK Local 881 R(4) 4 scalar 881,897 DSPBSL Param 61 R(4) 4 scalar 80,882 DSPBSS Param 62 R(4) 4 scalar 83,881 DSPC Param 75 R(4) 4 scalar DSPTFL Param 56 R(4) 4 scalar 61,82 DSPTFS Param 60 R(4) 4 scalar 62,85 DSPTK Local 885 R(4) 4 scalar 885,895,902 DSPTSL Param 61 R(4) 4 scalar 82,886 DSPTSS Param 62 R(4) 4 scalar 85,885 DT Scalar 6 R(4) 4 scalar COM 172,176 DTCNVC Local 172 R(4) 4 scalar 172,173,174,175,179 DTD Scalar 5 R(4) 4 scalar COM DTHEM Local 834 R(4) 4 scalar 834,837 DTQ2 Scalar 5 R(4) 4 scalar COM DTTOP Param 9 R(4) 4 scalar 691 EFI Local 740 R(4) 4 scalar 740,741,742,743,744,767,870,881,88 2,883,884,885,886 EFIFC Param 74 R(4) 4 scalar EFIMN Param 46 R(4) 4 scalar 75,80,81,82,83,84,85,86,870,871,88 1,882,883,884,885,886 EFINEW Local 739 R(4) 4 scalar 739,740 EFMNT Param 46 R(4) 4 scalar 86 ELIV Param 63 R(4) 4 scalar 471,1028,1234 ELIVW Param 6 R(4) 4 scalar 89 ELOCP Param 89 R(4) 4 scalar 607 ELV Local 469 R(4) 4 scalar 469,471,477,478,480,482,1026,1028, 1034,1036,1039,1232,1234,1240,1242 ,1244,1246,1248 ELWV Param 6 R(4) 4 scalar 88,89,469,1026,1232 ENDFCTR Local 201 R(4) 4 scalar 201,204,231,304,476,925,926,927,10 33,1244,1246 EPSDN Param 11 R(4) 4 scalar EPSNTP Param 74 R(4) 4 scalar EPSP Param 75 R(4) 4 scalar EPSQ Param 6 R(4) 4 scalar 548 EPSR Scalar 13 R(4) 4 2 17955 COM EPSTH Param 11 R(4) 4 scalar EPSUP Param 11 R(4) 4 scalar ETABOT Local 1229 R(4) 4 scalar 1229,1237,1239 ETATOP Local 1228 R(4) 4 scalar 1228,1237,1239 ETBIG Local 1237 R(4) 4 scalar 1237,1238,1249 EXP Func 289 scalar 289,366,385,396,397,457,486,501,50 2,607,909,938,950,1018,1041,1064,1 065,1125,1258,1291,1314,1315 FACTOR Local 734 R(4) 4 scalar 734,738,739 FCB Param 46 R(4) 4 scalar 740 FCC Param 46 R(4) 4 scalar 46,740 FI Local 1131 R(4) 4 scalar 1131,1132 FIRST Scalar 66 L(4) 4 scalar COM FIS Scalar 7 R(4) 4 2 17955 COM FIW Local 1133 R(4) 4 scalar 1133,1135,1139,1140,1143,1145,1146 Page 30 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References FIWL1 Local 1111 R(4) 4 scalar 1111,1140,1146 FLOAT Func 1289 scalar 1289,1346,1347 FPK Local 94 R(4) 4 1 45 FRACT Local 182 R(4) 4 scalar 182,184,209,230,261,263,264,287 FSL Param 56 R(4) 4 scalar 61 FSS Param 46 R(4) 4 scalar 62 G Param 5 R(4) 4 scalar 89,412,413,477,478,480,482,518,519 ,959,1034,1036,1039,1081,1082,1240 ,1242,1244,1246,1248,1267,1298,132 9 G2LI Scalar 55 I(4) 4 1 239 COM G2LJ Scalar 55 I(4) 4 1 389 COM GFFC Scalar 19 R(4) 4 2 17955 COM GLAT Scalar 15 R(4) 4 2 17955 COM 252 GLATD Local 252 R(4) 4 scalar 252,253,271,272 GLATMAX Local 251 R(4) 4 scalar 251,253,271,272 GLATMIN Local 250 R(4) 4 scalar 250,271,272 GLB_TABLE Common 37 128 GLON Scalar 15 R(4) 4 2 17955 COM HBM2 Scalar 8 R(4) 4 2 17955 COM 705 HBM3 Scalar 8 R(4) 4 2 17955 COM HBOT Scalar 17 R(4) 4 2 17955 COM 1347 HDAC Scalar 22 R(4) 4 2 17955 COM HDACV Scalar 22 R(4) 4 2 17955 COM HTM Scalar 6 R(4) 4 3 807975 COM 362,451,548,552,621,636,648,670,68 1,690,751,783,1014,1115,1154,1206, 1257,1258,1290,1291 HTMG Scalar 52 R(4) 4 3 4183695 COM HTOP Scalar 17 R(4) 4 2 17955 COM 1346 I Local 247 I(4) 4 scalar 247,252,253,254,257,260,261,263,26 4,270,273,287,291,302,304,305,306, 307,343,344,345,349,350,351,352,35 3,359,360,362,364,366,369,370,371, 372,377,379,380,382,385,386,387,38 8,389,390,394,395,405,412,413,415, 416,419,420,426,427,428,429,430,43 6,442,443,445,446,448,451,452,457, 458,460,461,463,468,473,476,477,47 8,479,480,481,482,483,486,487,488, 489,490,491,498,499,500,511,518,51 9,521,522,525,526,531,546,547,548, 552,554,555,556,559,560,609,610,61 1,612,621,623,624,630,631,632,634, 636,637,638,640,643,644,648,654,65 8,662,690,691,694,696,697,698,699, 701,702,703,705,706,707,712,714,71 5,716,720,721,734,738,739,740,743, 744,751,756,757,758,759,761,762,76 7,783,786,789,792,795,797,816,846, 848,854,855,856,857,867,871,872,88 1,882,883,884,885,886,912,924,925, 926,927,928,929,930,931,932,936,93 8,939,942,944,945,950,952,953,959, 960,963,968,969,970,983,987,989,10 08,1009,1014,1015,1018,1019,1020,1 Page 31 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 021,1023,1025,1026,1030,1033,1034, 1035,1036,1037,1038,1039,1041,1042 ,1043,1062,1063,1074,1081,1082,108 4,1085,1088,1089,1095,1110,1115,11 16,1124,1125,1131,1132,1140,1147,1 154,1155,1157,1158,1159,1161,1162, 1165,1180,1184,1189,1190,1191,1197 ,1198,1199,1206,1207,1208,1209,121 3,1231,1232,1236,1238,1240,1241,12 42,1243,1244,1245,1246,1247,1248,1 249,1250,1256,1257,1258,1259,1267, 1268,1270,1287,1288,1290,1291,1292 ,1298,1299,1302,1312,1313,1323,132 9,1330,1333,1346,1347 IBROW Scalar 22 I(4) 4 scalar COM ICHUNKTAB Scalar 29 I(4) 4 1 8 COM IDAT Scalar 5 I(4) 4 1 3 COM IDIM1 Param 19 I(4) 4 scalar 2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,26,97,98,9 9,100,101,102,103,104,105,108,109, 110,137,138,669,670,671,673,674,68 0,681,682,684,685 IDIM2 Param 19 I(4) 4 scalar 2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,26,61,97,9 8,99,100,101,102,103,104,105,108,1 09,110,137,138 IDTAD Scalar 6 I(4) 4 scalar COM IERR Local 373 I(4) 4 scalar 373 IE_GLB_TABLE Scalar 38 I(4) 4 1 8 COM IE_LOC_TABLE Scalar 28 I(4) 4 1 8 COM IGSADJ Local 137 L(4) 4 2 17955 168,720,857,872,983 IGSTL Param 14 I(4) 4 scalar 19 IGSTR Param 14 I(4) 4 scalar 19 IHE Scalar 3 I(4) 4 1 399 COM IHEG Scalar 9 I(4) 4 1 387 COM IHHA Scalar 3 I(4) 4 1 760 COM IHLA Scalar 3 I(4) 4 1 760 COM IHR Local 178 I(4) 4 scalar 178,232,254,257,260,261,263,264,34 4,696,697 IHRES Local 107 I(4) 4 1 15327 662,681 IHRST Scalar 5 I(4) 4 scalar COM IHW Scalar 3 I(4) 4 1 399 COM IHWG Scalar 9 I(4) 4 1 387 COM ILCOL Scalar 22 I(4) 4 scalar COM ILPAD1 Scalar 23 I(4) 4 scalar COM ILPAD2 Scalar 23 I(4) 4 scalar COM ILPAD3 Scalar 23 I(4) 4 scalar COM ILPAD4 Scalar 23 I(4) 4 scalar COM ILPAD5 Scalar 23 I(4) 4 scalar COM ILRES Local 106 I(4) 4 1 15327 658,670 IM Param 3 I(4) 4 scalar 9,16,19,43,44,45,46,47,51,52,57,60 IMJM Param 60 I(4) 4 scalar IMJM_LOC Param 61 I(4) 4 scalar 106,107 INDX Common 2 6564 INDXG Common 8 8084 Page 32 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References INPES Param 11 I(4) 4 scalar 16,19,27,28,29,38,39 INT Func 563 scalar 563,585 INUMQ Scalar 34 I(4) 4 1 100 COM IOUT Scalar 5 I(4) 4 scalar COM IPTB Local 99 I(4) 4 2 17955 673,684 IQ Local 597 I(4) 4 scalar 597,599,600,601,602 IQTB Local 585 I(4) 4 scalar 585,587,588,592,593,597 IQUILT_GROUP Scalar 33 I(4) 4 scalar COM IRAD Scalar 5 I(4) 4 1 45 COM IRADG Scalar 9 I(4) 4 1 473 COM IRCOL Scalar 22 I(4) 4 scalar COM IRPAD1 Scalar 24 I(4) 4 scalar COM IRPAD2 Scalar 24 I(4) 4 scalar COM IRPAD3 Scalar 24 I(4) 4 scalar COM IRPAD4 Scalar 24 I(4) 4 scalar COM IRPAD5 Scalar 24 I(4) 4 scalar COM IS_GLB_TABLE Scalar 38 I(4) 4 1 8 COM IS_LOC_TABLE Scalar 27 I(4) 4 1 8 COM IT Local 598 I(4) 4 scalar 598,599,600,601,602 ITAIL Param 16 I(4) 4 scalar ITB Param 1 I(4) 4 scalar 10,25,592,593,669 ITBQ Param 1 I(4) 4 scalar 11,25,680 ITEMP Scalar 47 I(4) 4 2 91719 COM ITEMP2 Scalar 47 I(4) 4 2 91719 COM ITHTB Local 99 I(4) 4 2 17955 674,685 ITROW Scalar 22 I(4) 4 scalar COM ITSTLOC Scalar 4 I(4) 4 scalar COM 232,302,388,443,489,715,848,930,96 8,1009,1247,1359,1360,1361,1362 ITTB Local 563 I(4) 4 scalar 563,565,566,570,571,575,598 ITTBK Local 575 I(4) 4 scalar 575,576,577,578,579 IVE Scalar 4 I(4) 4 1 399 COM IVEG Scalar 9 I(4) 4 1 387 COM IVHA Scalar 3 I(4) 4 1 760 COM IVI Local 815 I(4) 4 scalar 815,816,820,823,824,825 IVLA Scalar 3 I(4) 4 1 760 COM IVW Scalar 4 I(4) 4 1 399 COM IVWG Scalar 9 I(4) 4 1 387 COM J Local 246 I(4) 4 scalar 246,252,253,254,257,260,261,263,26 4,270,273,287,291,302,304,305,306, 307,342,344,345,349,350,351,352,35 3,359,360,362,364,366,369,370,371, 372,377,379,380,382,385,386,387,38 8,389,390,394,395,405,412,413,415, 416,419,420,426,427,428,429,430,43 6,442,443,445,446,448,451,452,457, 458,460,461,463,468,473,476,477,47 8,479,480,481,482,483,486,487,488, 489,490,491,498,499,500,511,518,51 9,521,522,525,526,531,546,547,548, 552,554,555,556,559,560,609,610,61 1,612,621,623,624,630,631,632,634, 636,637,638,640,643,644,648,654,65 9,663,690,691,694,696,697,698,699, 701,702,703,705,706,707,712,714,71 5,716,720,721,734,738,739,740,743, Page 33 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 744,751,756,757,758,759,761,762,76 7,783,786,789,792,795,797,816,846, 848,854,855,856,857,867,871,872,88 1,882,883,884,885,886,912,924,925, 926,927,928,929,930,931,932,936,93 8,939,942,944,945,950,952,953,959, 960,963,968,969,970,983,987,989,10 08,1009,1014,1015,1018,1019,1020,1 021,1023,1025,1026,1030,1033,1034, 1035,1036,1037,1038,1039,1041,1042 ,1043,1062,1063,1074,1081,1082,108 4,1085,1088,1089,1095,1110,1115,11 16,1124,1125,1131,1132,1140,1147,1 154,1155,1157,1158,1159,1161,1162, 1165,1180,1184,1189,1190,1191,1197 ,1198,1199,1206,1207,1208,1209,121 3,1231,1232,1236,1238,1240,1241,12 42,1243,1244,1245,1246,1247,1248,1 249,1250,1256,1257,1258,1259,1267, 1268,1270,1287,1288,1290,1291,1292 ,1298,1299,1302,1312,1313,1323,132 9,1330,1333,1346,1347 JAM Param 60 I(4) 4 scalar 3 JBPAD1 Scalar 25 I(4) 4 scalar COM JBPAD2 Scalar 25 I(4) 4 scalar COM JBPAD3 Scalar 25 I(4) 4 scalar COM JBPAD4 Scalar 25 I(4) 4 scalar COM JBPAD5 Scalar 25 I(4) 4 scalar COM JDIM1 Param 20 I(4) 4 scalar 2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,26,97,98,9 9,100,101,102,103,104,105,108,109, 110,137,138,669,670,671,673,674,68 0,681,682,684,685 JDIM2 Param 20 I(4) 4 scalar 2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,26,61,97,9 8,99,100,101,102,103,104,105,108,1 09,110,137,138 JE_GLB_TABLE Scalar 39 I(4) 4 1 8 COM JE_LOC_TABLE Scalar 28 I(4) 4 1 8 COM JGSTL Param 15 I(4) 4 scalar 20 JGSTR Param 15 I(4) 4 scalar 20 JHRES Local 107 I(4) 4 1 15327 663,681 JLRES Local 106 I(4) 4 1 15327 659,670 JM Param 3 I(4) 4 scalar 9,17,20,43,44,45,46,47,51,52,57,60 JNPES Param 11 I(4) 4 scalar 17,20,27,28,29,38,39 JRA Scalar 3 I(4) 4 1 760 COM JS_GLB_TABLE Scalar 39 I(4) 4 1 8 COM JS_LOC_TABLE Scalar 27 I(4) 4 1 8 COM JTAIL Param 17 I(4) 4 scalar JTB Param 1 I(4) 4 scalar 10,25,570,571,669 JTBQ Param 1 I(4) 4 scalar 25,680 JTPAD1 Scalar 26 I(4) 4 scalar COM JTPAD2 Scalar 26 I(4) 4 scalar COM JTPAD3 Scalar 26 I(4) 4 scalar COM JTPAD4 Scalar 26 I(4) 4 scalar COM Page 34 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References JTPAD5 Scalar 26 I(4) 4 scalar COM JTSTLOC Scalar 4 I(4) 4 scalar COM 232,302,388,443,489,715,848,930,96 8,1009,1247,1359,1360,1361,1362 KB Local 551 I(4) 4 scalar 551,554,558,559,560 KNUMH Local 652 I(4) 4 scalar 652,661,662,663,679,680 KNUML Local 651 I(4) 4 scalar 651,657,658,659,668,669 KTM Scalar 5 I(4) 4 scalar COM L Local 361 I(4) 4 scalar 361,362,364,366,369,370,371,372,37 7,379,380,382,385,387,389,390,395, 396,405,412,413,450,451,452,457,45 8,460,461,463,468,473,476,477,478, 480,482,486,488,490,491,498,499,50 0,501,511,518,519,545,546,547,548, 552,620,621,622,624,635,636,637,63 8,647,648,654,669,670,680,681,689, 690,691,750,751,782,783,784,785,78 6,787,788,789,790,791,792,793,794, 795,796,797,814,815,836,837,845,84 6,875,876,891,894,895,897,901,902, 905,906,907,908,909,910,912,918,91 9,934,936,938,939,942,944,945,950, 953,959,969,970,1013,1014,1015,101 8,1019,1020,1021,1023,1025,1026,10 30,1033,1034,1036,1038,1041,1043,1 062,1063,1064,1074,1081,1082,1114, 1115,1116,1124,1125,1131,1132,1140 ,1145,1147,1153,1154,1155,1157,115 8,1162,1205,1206,1207,1208,1209,12 16,1217,1230,1231,1232,1236,1237,1 240,1241,1242,1243,1245,1248,1249, 1257,1258,1259,1267,1286,1288,1289 ,1290,1291,1292,1298,1311,1312,131 3,1314,1323,1329 L0 Local 806 I(4) 4 scalar 806,825,826,829,832,834,894,901 L0M1 Local 829 I(4) 4 scalar 829,832,836 L2GI Scalar 57 I(4) 4 1 239 COM L2GJ Scalar 57 I(4) 4 1 389 COM LB Local 766 I(4) 4 scalar 766,802,803,806,807,808,809,810,84 5,875,891,918,934 LBM1 Local 802 I(4) 4 scalar 802,811,812,814,815 LBOT Local 97 I(4) 4 2 17955 351,352,624,631,634,638,640,643,69 8,701,702,706,762,854,1347 LBTK Local 762 I(4) 4 scalar 762,766 LC Scalar 5 I(4) 4 2 17955 COM LCBOT Local 1208 I(4) 4 scalar 1208,1212,1216,1229,1230,1285,1286 ,1289,1311 LCBOTTM Local 1285 I(4) 4 scalar 1285,1286 LCTOP Local 1209 I(4) 4 scalar 1209,1212,1216,1228,1230,1311 LIST Scalar 5 I(4) 4 scalar COM LM Param 3 I(4) 4 scalar 2,3,4,5,6,7,9,21,52,62,91,92,93,94 ,101,109,110,361,450,545,551,647,6 89,750,782,1205 LM1 Param 62 I(4) 4 scalar 620 LMH Scalar 4 I(4) 4 2 17955 COM 351,555,630,987 LMHIJ Local 630 I(4) 4 scalar 630,632,634,635 Page 35 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References LMHK Local 555 I(4) 4 scalar 555,556,558,987,1013,1114,1153,128 5 LMV Scalar 4 I(4) 4 2 17955 COM LOOPS Common 2 158840 LP1 Param 62 I(4) 4 scalar 9 LSM Param 3 I(4) 4 scalar LTOP Local 97 I(4) 4 2 17955 643,691,694,698,701,702,706,761,85 4,1346 LTP1 Local 801 I(4) 4 scalar 801 LTPK Local 761 I(4) 4 scalar 761,801,804,814,815,836,845,875,89 1,918,934 MAPPINGS Common 56 5024 MASKS Common 2 6894720 MAX Func 1347 scalar 1347 MIN Func 1346 scalar 1346 MIN0 Func 1285 scalar 1285 MOD Func 177 scalar 177 MPI_COMM_COMP Scalar 30 I(4) 4 scalar COM MPI_COMM_INTER Scalar 31 I(4) 4 scalar COM MPI_COMM_INTER_ARRAY Scalar 32 I(4) 4 1 100 COM MPI_FINALIZE Subr 373 373 MPPCOM Common 1 1464 MTSTPE Scalar 4 I(4) 4 scalar COM 229,302,388,443,489,715,848,930,96 8,1009,1247,1358 MXSNAL Scalar 2 R(4) 4 2 17955 COM MYIE Scalar 4 I(4) 4 scalar COM 247,343 MYIE1 Scalar 4 I(4) 4 scalar COM MYIE1_P1 Scalar 8 I(4) 4 scalar COM MYIE1_P2 Scalar 8 I(4) 4 scalar COM MYIE1_P3 Scalar 8 I(4) 4 scalar COM MYIE1_P4 Scalar 8 I(4) 4 scalar COM MYIE2 Scalar 4 I(4) 4 scalar COM MYIE2_P1 Scalar 9 I(4) 4 scalar COM MYIE_P1 Scalar 7 I(4) 4 scalar COM MYIE_P2 Scalar 7 I(4) 4 scalar COM MYIE_P3 Scalar 7 I(4) 4 scalar COM MYIE_P4 Scalar 7 I(4) 4 scalar COM MYIE_P5 Scalar 7 I(4) 4 scalar COM MYIS Scalar 4 I(4) 4 scalar COM 247,343 MYIS1 Scalar 4 I(4) 4 scalar COM MYIS1_P1 Scalar 6 I(4) 4 scalar COM MYIS1_P2 Scalar 6 I(4) 4 scalar COM MYIS1_P3 Scalar 6 I(4) 4 scalar COM MYIS1_P4 Scalar 6 I(4) 4 scalar COM MYIS2 Scalar 4 I(4) 4 scalar COM MYIS_P1 Scalar 5 I(4) 4 scalar COM MYIS_P2 Scalar 5 I(4) 4 scalar COM MYIS_P3 Scalar 5 I(4) 4 scalar COM MYIS_P4 Scalar 5 I(4) 4 scalar COM MYIS_P5 Scalar 5 I(4) 4 scalar COM MYJE Scalar 15 I(4) 4 scalar COM 246,342 MYJE1 Scalar 15 I(4) 4 scalar COM MYJE1_P1 Scalar 17 I(4) 4 scalar COM MYJE1_P2 Scalar 17 I(4) 4 scalar COM MYJE1_P3 Scalar 17 I(4) 4 scalar COM Page 36 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References MYJE1_P4 Scalar 17 I(4) 4 scalar COM MYJE2 Scalar 15 I(4) 4 scalar COM MYJE2_P1 Scalar 18 I(4) 4 scalar COM MYJE2_P2 Scalar 18 I(4) 4 scalar COM MYJE2_P3 Scalar 18 I(4) 4 scalar COM MYJE2_P4 Scalar 18 I(4) 4 scalar COM MYJE3 Scalar 15 I(4) 4 scalar COM MYJE3_P4 Scalar 18 I(4) 4 scalar COM MYJE4 Scalar 15 I(4) 4 scalar COM MYJE4_P1 Scalar 19 I(4) 4 scalar COM MYJE4_P4 Scalar 19 I(4) 4 scalar COM MYJE5 Scalar 15 I(4) 4 scalar COM MYJE5_P1 Scalar 19 I(4) 4 scalar COM MYJE5_P2 Scalar 19 I(4) 4 scalar COM MYJE_P1 Scalar 16 I(4) 4 scalar COM MYJE_P2 Scalar 16 I(4) 4 scalar COM MYJE_P3 Scalar 16 I(4) 4 scalar COM MYJE_P4 Scalar 16 I(4) 4 scalar COM MYJE_P5 Scalar 16 I(4) 4 scalar COM MYJS Scalar 10 I(4) 4 scalar COM 246,342 MYJS1 Scalar 10 I(4) 4 scalar COM MYJS1_P1 Scalar 12 I(4) 4 scalar COM MYJS1_P2 Scalar 12 I(4) 4 scalar COM MYJS1_P3 Scalar 12 I(4) 4 scalar COM MYJS1_P4 Scalar 12 I(4) 4 scalar COM MYJS2 Scalar 10 I(4) 4 scalar COM MYJS2_P1 Scalar 13 I(4) 4 scalar COM MYJS2_P2 Scalar 13 I(4) 4 scalar COM MYJS2_P3 Scalar 13 I(4) 4 scalar COM MYJS2_P4 Scalar 13 I(4) 4 scalar COM MYJS3 Scalar 10 I(4) 4 scalar COM MYJS3_P4 Scalar 13 I(4) 4 scalar COM MYJS4 Scalar 10 I(4) 4 scalar COM MYJS4_P1 Scalar 14 I(4) 4 scalar COM MYJS4_P4 Scalar 14 I(4) 4 scalar COM MYJS5 Scalar 10 I(4) 4 scalar COM MYJS5_P1 Scalar 14 I(4) 4 scalar COM MYJS5_P2 Scalar 14 I(4) 4 scalar COM MYJS_P1 Scalar 11 I(4) 4 scalar COM MYJS_P2 Scalar 11 I(4) 4 scalar COM MYJS_P3 Scalar 11 I(4) 4 scalar COM MYJS_P4 Scalar 11 I(4) 4 scalar COM MYJS_P5 Scalar 11 I(4) 4 scalar COM MYPE Scalar 2 I(4) 4 scalar COM 229,302,369,371,388,443,489,715,84 8,930,968,1009,1247,1358 MY_E Scalar 20 I(4) 4 scalar COM MY_IE_GLB Scalar 2 I(4) 4 scalar COM MY_IE_LOC Scalar 3 I(4) 4 scalar COM MY_IS_GLB Scalar 2 I(4) 4 scalar COM MY_IS_LOC Scalar 3 I(4) 4 scalar COM MY_JE_GLB Scalar 2 I(4) 4 scalar COM MY_JE_LOC Scalar 3 I(4) 4 scalar COM MY_JS_GLB Scalar 2 I(4) 4 scalar COM MY_JS_LOC Scalar 3 I(4) 4 scalar COM MY_N Scalar 20 I(4) 4 scalar COM Page 37 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References MY_NE Scalar 21 I(4) 4 scalar COM MY_NEB Scalar 21 I(4) 4 1 8 COM MY_NW Scalar 21 I(4) 4 scalar COM MY_S Scalar 20 I(4) 4 scalar COM MY_SE Scalar 21 I(4) 4 scalar COM MY_SW Scalar 21 I(4) 4 scalar COM MY_W Scalar 20 I(4) 4 scalar COM NBC Scalar 5 I(4) 4 scalar COM NBOCO Scalar 6 I(4) 4 scalar COM NCNVC Scalar 7 I(4) 4 scalar COM 172 NCP Scalar 6 I(4) 4 scalar COM NEST Scalar 7 I(4) 4 scalar COM NFCST Scalar 5 I(4) 4 scalar COM NHEAT Scalar 3 I(4) 4 scalar COM 161 NPES Scalar 2 I(4) 4 scalar COM NPHS Scalar 7 I(4) 4 scalar COM NPREC Scalar 6 I(4) 4 scalar COM NRADL Scalar 7 I(4) 4 scalar COM NRADS Scalar 7 I(4) 4 scalar COM NSHDE Scalar 6 I(4) 4 scalar COM NSTART Scalar 6 I(4) 4 scalar COM NTDDMP Scalar 6 I(4) 4 scalar COM NTSD Scalar 6 I(4) 4 scalar COM 157,161,176,230 NTSTM Scalar 6 I(4) 4 scalar COM NUMLEV Local 1212 I(4) 4 scalar 1212,1213 OCT90 Param 2 L(4) 4 scalar OLDCWM Local 380 R(4) 4 scalar 380,413,461,519,1021,1082,1312,132 9 OLDQ Local 379 R(4) 4 scalar 379,390,412,460,491,518,942,959,97 0,1020,1081,1236,1267,1288,1298 OLDRH Local 378 R(4) 4 scalar 378,389,459,490,941,969 P Local 105 R(4) 4 2 17955 623,624,637,638 P00K Local 599 R(4) 4 scalar 599,604,605 P01K Local 601 R(4) 4 scalar 601,604,605 P10K Local 600 R(4) 4 scalar 600,604,605 P11K Local 602 R(4) 4 scalar 602,605 PBM Param 12 R(4) 4 scalar PBOT Local 98 R(4) 4 2 17955 352,631,634,640,644,699,703,707,71 4,716,855,1150,1157,1158,1159,1161 ,1165,1180,1190,1198,1208 PD Scalar 3 R(4) 4 2 17955 COM 350,712,1110 PDIFF Local 287 R(4) 4 scalar 287,289,307 PDSL Local 100 R(4) 4 2 17955 350,352,364,412,413,452,477,478,48 0,482,518,519,546,554,556,623,631, 632,637,640,654,670,681,694,792,84 6,924,925,926,927,928,936,959,1015 ,1034,1036,1038,1081,1082,1124,115 5,1158,1162,1207,1240,1242,1243,12 45,1248,1257,1267,1290,1298,1329 PETAL Local 364 R(4) 4 scalar 364,365,370,372,384,389,418,452,45 6,485,490,524,936,937,949,962,969, 1015,1016,1017,1041,1087,1155,1156 ,1269,1301,1332 PEXP Local 289 R(4) 4 scalar 289,290,291,308 PFACTOR Local 138 R(4) 4 2 17955 243,291,307,386,389,487,952,969,10 Page 38 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 42 PFRZ Param 13 R(4) 4 scalar 889 PHOUR Scalar 2 R(4) 4 2 17955 COM PHYS Common 4 1788916 PHYST Local 179 R(4) 4 scalar 179,181,182,199,201,208,211,217 PK Local 91 R(4) 4 1 45 793,803,804,807,826,837,895,897,90 2,905,906,1207,1208,1209 PK0 Local 807 R(4) 4 scalar 807,826,833,890,895,897,902 PKB Local 803 R(4) 4 scalar 803,890,897 PKL Local 554 R(4) 4 scalar 554,558,792,793,794 PKT Local 804 R(4) 4 scalar 804,833,837,895,902 PL Scalar 7 R(4) 4 scalar COM 671 PLQ Scalar 8 R(4) 4 scalar COM 656,682 PNO Param 12 R(4) 4 scalar PONE Param 12 R(4) 4 scalar 634,638 PP Local 103 R(4) 4 2 17955 671,682 PP1 Local 584 R(4) 4 scalar 584,589,594,604,605 PPTASM Common 1 3878292 PPTDAT Scalar 3 R(4) 4 3 53865 COM 232,254,257,260,261,263,264,344,69 6,697 PPTSUM Local 154 R(4) 4 scalar 153,304,306 PQ0 Param 8 R(4) 4 scalar 365,370,372,384,456,485,909,937,94 9,1017,1041,1124,1257,1290 PQM Param 12 R(4) 4 scalar 624,905 PREC Scalar 12 R(4) 4 2 17955 COM 273,287,305,345,359,426,427,428,42 9,436,442,445,448,477,531,734,738, 756,757,758,759,924,931,1034,1035, 1242,1250,1359 PREC1 Local 1213 R(4) 4 scalar 1213,1238 PRECK Local 916 R(4) 4 scalar 916,919,924,925,926,927,928 PRECL Local 101 R(4) 4 2 17955 1238,1240,1249 PRECMAX Local 843 R(4) 4 scalar 843,846,849,851,867 PRESK Local 654 R(4) 4 scalar 654,656 PSFC Local 1110 R(4) 4 scalar 1110,1180 PSFCIJ Local 712 R(4) 4 scalar 712,713,889 PSFCK Local 556 R(4) 4 scalar 556,558,632,634,638 PSH Param 12 R(4) 4 scalar PSHLTR Scalar 19 R(4) 4 2 17955 COM PSHNEW Local 318 R(4) 4 scalar 318,713,855 PSHU Param 13 R(4) 4 scalar PSK Local 92 R(4) 4 1 45 794,906,907,909 PSP Local 104 R(4) 4 2 17955 610,624 PT Scalar 5 R(4) 4 scalar COM 352,364,452,546,554,556,623,631,63 2,637,640,654,671,682,694,712,792, 936,1015,1110,1124,1155,1158,1162, 1207,1257,1290 PTBL Scalar 25 R(4) 4 2 10184 COM 599,600,601,602 PTOP Local 98 R(4) 4 2 17955 644,694,699,703,707,714,716,855,11 51,1159,1161,1162,1165,1184,1190,1 191,1198,1199,1209 PTRES1 Local 223 R(4) 4 scalar 223,1184,1189 PTRES2 Local 224 R(4) 4 scalar 224,1189,1197 PTRES3 Local 225 R(4) 4 scalar 225,1256,1287 PVRBLS Common 2 5530140 Q Scalar 6 R(4) 4 3 807975 COM 377,379,387,390,412,458,460,488,49 Page 39 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 1,518,548,559,789,912,939,942,945, 953,959,970,1019,1020,1043,1081,11 31,1147,1236,1259,1267,1288,1292,1 298 Q10 Scalar 16 R(4) 4 2 17955 COM Q2 Scalar 21 R(4) 4 3 807975 COM Q2BT Local 102 R(4) 4 2 17955 Q30 Scalar 14 R(4) 4 2 17955 COM QBT Local 559 R(4) 4 scalar 559,583,607 QC Local 101 R(4) 4 1 45 1145,1147,1257,1259,1290,1292 QCKL Local 365 R(4) 4 scalar 365,368,369,371,377,384,387,456,45 8,485,488,937,939,949,953,1017,101 9,1041,1043 QI Local 1126 R(4) 4 scalar 1126,1128,1131,1145 QINT Local 1127 R(4) 4 scalar 1127,1128,1145 QK Local 92 R(4) 4 1 45 790 QKL Local 789 R(4) 4 scalar 789,790,791 QQ Local 103 R(4) 4 2 17955 671,682 QQ1 Local 562 R(4) 4 scalar 562,567,572,581,582,604,605 QREFK Local 91 R(4) 4 1 45 791,909,912,945 QS Scalar 6 R(4) 4 2 17955 COM QS0 Scalar 10 R(4) 4 1 134 COM 576,578 QSATK Local 94 R(4) 4 1 45 QSHLTR Scalar 18 R(4) 4 2 17955 COM QW Local 1124 R(4) 4 scalar 1124,1126,1127 QWBS Scalar 9 R(4) 4 2 17955 COM QZ0 Scalar 5 R(4) 4 2 17955 COM R2D Local 249 R(4) 4 scalar 249,252 RADIN Scalar 14 R(4) 4 2 17955 COM RADOT Scalar 14 R(4) 4 2 17955 COM RATIO Local 867 R(4) 4 scalar 867,868,869,876 RCP Param 89 R(4) 4 scalar RDP Scalar 7 R(4) 4 scalar COM 672 RDP0T Local 833 R(4) 4 scalar 833,837 RDPQ Scalar 8 R(4) 4 scalar COM 683 RDQ Scalar 7 R(4) 4 scalar COM 583 RDTCNVC Local 173 R(4) 4 scalar 173 RDTH Scalar 7 R(4) 4 scalar COM 561 RDTHE Scalar 7 R(4) 4 scalar COM 672 RDTHEQ Scalar 8 R(4) 4 scalar COM 683 RELH Local 94 R(4) 4 1 45 1147,1157,1162 RELHUM Local 377 R(4) 4 scalar 377,378,386,387,390,458,459,487,48 8,491,939,941,952,953,970,1019,104 2,1043 RES Scalar 7 R(4) 4 2 17955 COM 350 RESTRT Scalar 66 L(4) 4 scalar COM RF Scalar 8 R(4) 4 2 17955 COM RHF Param 11 R(4) 4 scalar RHFCTR Local 1289 R(4) 4 scalar 1289,1292 ROI Scalar 6 R(4) 4 scalar COM ROS Scalar 6 R(4) 4 scalar COM ROW Param 6 R(4) 4 scalar 89,477,478,480,482,1034,1036,1039, 1240,1242,1244,1246,1248 RUN Scalar 66 L(4) 4 scalar COM SI Scalar 10 R(4) 4 2 17955 COM Page 40 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References SICE Scalar 4 R(4) 4 2 17955 COM 253 SIGMA Scalar 66 L(4) 4 scalar COM SIGT4 Scalar 23 R(4) 4 2 17955 COM SINGLRST Local 2 L(4) 4 scalar SIXSIX Local 217 R(4) 4 scalar 217,223,224,225,264 SLOP0L Param 81 R(4) 4 scalar 884 SLOP0S Param 84 R(4) 4 scalar 883 SLOPBL Param 80 R(4) 4 scalar 882 SLOPBS Param 83 R(4) 4 scalar 881 SLOPE Param 86 R(4) 4 scalar SLOPTL Param 82 R(4) 4 scalar 886 SLOPTS Param 85 R(4) 4 scalar 885 SM Scalar 4 R(4) 4 2 17955 COM 253,270,743,881,882,883,884,885,88 6 SNO Scalar 10 R(4) 4 2 17955 COM SQ Local 582 R(4) 4 scalar 582,583 SQS Scalar 10 R(4) 4 1 134 COM 577,579 SQS00K Local 577 R(4) 4 scalar 577,582 SQS10K Local 579 R(4) 4 scalar 579,582 SR Scalar 5 R(4) 4 2 17955 COM 446,1025 SST Scalar 20 R(4) 4 2 17955 COM STABD Param 9 R(4) 4 scalar 817 STABDL Local 817 R(4) 4 scalar 817,818 STABFC Param 9 R(4) 4 scalar STABS Param 9 R(4) 4 scalar STEFI Param 76 R(4) 4 scalar 360 STHE Scalar 10 R(4) 4 1 76 COM 672 STHEQ Scalar 11 R(4) 4 1 152 COM 683 STRESH Param 8 R(4) 4 scalar SUBPOST Scalar 2 L(4) 4 scalar COM T Scalar 5 R(4) 4 3 807975 COM 353,366,370,372,382,385,395,457,46 3,468,486,490,500,560,691,751,786, 816,938,944,950,1018,1023,1025,102 6,1041,1063,1116,1125,1231,1232,12 41,1258,1291,1313 T1 Param 8 R(4) 4 scalar TAUK Local 174 R(4) 4 scalar 174 TBT Local 102 R(4) 4 2 17955 TCUCN Scalar 5 R(4) 4 3 807975 COM TDTD Scalar 5 R(4) 4 scalar COM TDTQ2 Scalar 5 R(4) 4 scalar COM TEMP1 Scalar 43 R(4) 4 2 91719 COM TEMP10 Scalar 45 R(4) 4 2 91719 COM TEMP11 Scalar 45 R(4) 4 2 91719 COM TEMP12 Scalar 45 R(4) 4 2 91719 COM TEMP13 Scalar 46 R(4) 4 2 91719 COM TEMP14 Scalar 46 R(4) 4 2 91719 COM TEMP15 Scalar 46 R(4) 4 2 91719 COM TEMP16 Scalar 46 R(4) 4 2 91719 COM TEMP2 Scalar 43 R(4) 4 2 91719 COM TEMP2X Scalar 51 R(4) 4 2 92971 COM TEMP3 Scalar 43 R(4) 4 2 91719 COM TEMP4 Scalar 43 R(4) 4 2 91719 COM TEMP5 Scalar 44 R(4) 4 2 91719 COM TEMP6 Scalar 44 R(4) 4 2 91719 COM Page 41 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References TEMP7 Scalar 44 R(4) 4 2 91719 COM TEMP8 Scalar 44 R(4) 4 2 91719 COM TEMP9 Scalar 45 R(4) 4 2 91719 COM TEMPCOM Common 42 6603768 TEND Local 197 R(4) 4 scalar 197,199,201 TFRZ Param 8 R(4) 4 scalar 816 TG Scalar 19 R(4) 4 2 17955 COM TH10 Scalar 16 R(4) 4 2 17955 COM TH30 Scalar 14 R(4) 4 2 17955 COM THBT Local 104 R(4) 4 2 17955 611 THE0 Scalar 10 R(4) 4 1 76 COM 672 THE0Q Scalar 11 R(4) 4 1 152 COM 683 THEAT Scalar 3 R(4) 4 scalar COM THERK Local 92 R(4) 4 1 45 797,809,811,824,834,837 THERKX Local 809 R(4) 4 scalar 809,818,822 THERKY Local 811 R(4) 4 scalar 811,818,822,824 THESP Local 105 R(4) 4 2 17955 349,609,612,673,684 THEVRF Local 93 R(4) 4 1 45 THL Scalar 7 R(4) 4 scalar COM 561 THS Scalar 6 R(4) 4 2 17955 COM THSK Local 92 R(4) 4 1 45 908,909,910 THVMOD Local 93 R(4) 4 1 45 THVREF Local 93 R(4) 4 1 45 THZ0 Scalar 5 R(4) 4 2 17955 COM TIMES Local 176 R(4) 4 scalar 176,177,178,199,201,208,230 TK Local 91 R(4) 4 1 45 787,846,876,919 TKL Local 786 R(4) 4 scalar 786,787,788 TLAT Scalar 2 R(4) 4 3 807975 COM 158,382,387,389,463,473,476,488,49 0,498,751,969,1023,1030,1033,1062, 1356 TMT0 Local 1116 R(4) 4 scalar 1116,1117,1120,1126,1128,1130,1138 ,1142 TMT15 Local 1117 R(4) 4 scalar 1117,1127 TOPO Common 50 17478548 TPSP Local 604 R(4) 4 scalar 604,606,610 TQ Local 583 R(4) 4 scalar 583,584,585 TRAIN Scalar 4 R(4) 4 3 807975 COM TREF Local 110 R(4) 4 3 807975 353,669,680,691,797 TREFK Local 91 R(4) 4 1 45 788,808,820,834,837,846,876,908,91 9,944 TREFKX Local 808 R(4) 4 scalar 808,818,819,820 TREL Param 74 R(4) 4 scalar 174 TSHLTR Scalar 18 R(4) 4 2 17955 COM TTBL Scalar 25 R(4) 4 2 10184 COM 669 TTBLEX Subr 669 669,680 TTBLQ Scalar 25 R(4) 4 2 66880 COM 680 TTEMP Local 395 R(4) 4 scalar 395,397,500,502,1063,1065,1313,131 5 TTH Local 561 R(4) 4 scalar 561,562,563 TTHBT Local 560 R(4) 4 scalar 560,561,607,611 TTHES Local 607 R(4) 4 scalar 607,609,612 TTVG Scalar 51 R(4) 4 2 92971 COM TWBS Scalar 9 R(4) 4 2 17955 COM U Scalar 5 R(4) 4 3 807975 COM U00 Scalar 3 R(4) 4 2 17955 COM Page 42 Source Listing ADJPPT 2014-12-17 20:46 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References U10 Scalar 17 R(4) 4 2 17955 COM U30 Scalar 15 R(4) 4 2 17955 COM UL Scalar 4 R(4) 4 1 90 COM UNIL Param 2 L(4) 4 scalar UNIS Param 2 L(4) 4 scalar USTAR Scalar 3 R(4) 4 2 17955 COM UZ0 Scalar 4 R(4) 4 2 17955 COM V Scalar 6 R(4) 4 3 807975 COM V10 Scalar 17 R(4) 4 2 17955 COM V30 Scalar 15 R(4) 4 2 17955 COM VAPINC Scalar 5 R(4) 4 2 17955 COM 415,521,960,1084,1268,1299 VAPINC7 Scalar 5 R(4) 4 2 17955 COM 419,525,963,1088,1270,1302 VBM2 Scalar 3 R(4) 4 2 17955 COM VBM3 Scalar 3 R(4) 4 2 17955 COM VRBLS Common 2 13143060 VTM Scalar 7 R(4) 4 3 807975 COM VZ0 Scalar 4 R(4) 4 2 17955 COM WFIX Local 396 R(4) 4 scalar 396,397,501,502,1064,1065,1314,131 5 WMIN Local 397 R(4) 4 scalar 397,405,499,502,511,1065,1074,1315 ,1323 YLTMP Local 1248 R(4) 4 scalar 1248,1249 Z0 Scalar 3 R(4) 4 2 17955 COM ZER Local 209 R(4) 4 scalar 209,211,306,345,359,696,697,738,98 9,1095 Page 43 Source Listing ADJPPT 2014-12-17 20:46 Subprograms/Common Blocks ADJPPT.F SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ACMCLH Common 2 6463824 ADJPPT Subr 1 CLDWTR Common 2 3447720 CNVCLD Common 2 287280 CTLBLK Common 4 112 GLB_TABLE Common 37 128 INDX Common 2 6564 INDXG Common 8 8084 LOOPS Common 2 158840 MAPPINGS Common 56 5024 MASKS Common 2 6894720 MPPCOM Common 1 1464 PHYS Common 4 1788916 PPTASM Common 1 3878292 PVRBLS Common 2 5530140 TEMPCOM Common 42 6603768 TOPO Common 50 17478548 VRBLS Common 2 13143060 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 byterecl -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 big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux Page 44 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F -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 -fpe3 -fprm nearest no -ftz -fp_model precise -fp_model nofast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -fp_modbits nofp_contract -fp_modbits nono_fp_contract -fp_modbits nofenv_access -fp_modbits nono_fenv_access -fp_modbits nocx_limited_range -fp_modbits nono_cx_limited_range -fp_modbits noprec_div -fp_modbits nono_prec_div -fp_modbits noprec_sqrt -fp_modbits nono_prec_sqrt -fp_modbits noftz -fp_modbits no_ftz -fp_modbits nointrin_limited_range -fp_modbits nono_intrin_limited_range -fp_modbits notrunc_compares -fp_modbits nono_trunc_compares -fp_modbits noieee_nan_compares -fp_modbits nono_ieee_nan_compares -fp_modbits nohonor_f32_conversion -fp_modbits nono_honor_f32_conversion -fp_modbits nohonor_f64_conversion -fp_modbits nono_honor_f64_conversion -fp_modbits nono_x87_copy -fp_modbits nono_no_x87_copy -fp_modbits noexception_semantics -fp_modbits nono_exception_semantics -fp_modbits noprecise_libm_functions -fp_modbits nono_precise_libm_functions -heap_arrays 0 no -threadprivate_compat -g2 -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 Page 45 Source Listing ADJPPT 2014-12-17 20:46 ADJPPT.F -includepath : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/opt/ibmhpc/pe1308/mpich2/intel/include64/, /opt/ibmhpc/pe1308/base/include64/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : ADJPPT.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100