Page 1 Source Listing 2025-03-12 18:21 /tmp/ifortp8IRt4.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 #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 #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 2025-03-12 18:21 /tmp/ifortp8IRt4.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 2025-03-12 18:21 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 2025-03-12 18:21 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 2025-03-12 18:21 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 2025-03-12 18:21 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 2025-03-12 18:21 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 2025-03-12 18:21 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 (1) 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: 709 IF (APREC(I,J).GT.0.) THEN 710 TTEMP=0.025*(T(I,J,L)-273.16) Page 9 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 766 IF (HTM(I,J,L).LT.0.5) GO TO 140 767 PETAL=PDSL(I,J)*AETA(L)+PT Page 10 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 (1) 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 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 Page 11 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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) 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 Page 12 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 932 C 933 C---------CHOOSE CLOUD BASE AS MODEL LEVEL JUST BELOW PSP-------------- 934 C 935 DO 190 L=1,LM1 Page 13 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 Page 14 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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) Page 15 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 1103 TREFK (L)=TKL 1104 QKL =Q(I,J,L) 1105 QK (L)=QKL 1106 QREFK (L)=QKL Page 16 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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) Page 17 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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) 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 Page 18 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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 Page 19 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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 Page 20 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 1388 c endif 1389 CWM(I,J,L) = AMAX1(WMIN,CWM(I,J,L)*ADJUST) 1390 ENDIF 1391 c Page 21 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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------------------------------ 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. Page 22 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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. Page 23 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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/ 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 Page 24 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 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 Page 25 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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: 1670 C 1671 TLAT = 0.0 1672 C 1673 IF (MYPE.EQ.MTSTPE) THEN Page 26 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F 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 627 562,572 110 Label 628 561 128 Label 807 805 129 Label 706 704,1284 130 Label 737 676,677 140 Label 843 765,766 150 Label 864 860 170 Label 931 866,867 190 Label 940 935,936 200 Label 954 950,951 250 Label 1002 962,963 280 Label 1007 1004,1005 410 Label 1113 1097,1098 420 Label 1142 1129 430 Label 1147 1131 440 Label 1153 1151 445 Label 1157 1145 450 Label 1203 460 Label 1229 1206 530 Label 1235 1233 580 Label 1286 1249 600 Label 1293 1037,1173 640 Label 1406 1328,1329,1331 650 Label 1463 1429,1430 660 Label 1478 1468,1469,1471 670 Label 1525 1520,1521 680 Label 1533 1531 689 Label 1566 1564 690 Label 1588 1545 700 Label 1620 1601 710 Label 1650 1626 900 Label 1665 658,660,746,847,1298 910 Label 1666 657 A2 Param 62 R(4) 4 scalar 143,681,700,772,801,1224,1253,1265 ,1333,1356,1440,1573,1606 Page 27 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References A23M4L Param 143 R(4) 4 scalar A3 Param 62 R(4) 4 scalar 143,681,700,772,801,1224,1253,1265 ,1333,1341,1356,1440,1547,1573,160 6 A4 Param 62 R(4) 4 scalar 143,681,700,772,801,1225,1253,1265 ,1333,1356,1440,1573,1606 ACMCLH Common 353 6463824 SAVE ADATA Local 423 R(4) 4 2 17955 1036,1171,1243,1247,1304,1323,1410 ,1499,1504,1512,1528,1571,1602 ADJPPT Subr 2 ADJUST Local 757 R(4) 4 scalar 757,761,778,788,791,826,1323,1325, 1326,1338,1345,1348,1377,1389,1411 AETAL Local 937 R(4) 4 scalar 937,938 AFAC Local 587 R(4) 4 scalar 587,588 AI Local 1433 R(4) 4 scalar 1433,1436,1441 AINT Func 877 scalar 877,899 AMAX1 Func 826 scalar 826,1389,1607,1638 AMIN1 Func 720 scalar 720,1267,1432,1441 APE Local 424 R(4) 4 3 807975 862,875,1110 APEBT Local 415 R(4) 4 2 17955 APEK Local 406 R(4) 4 1 45 1111,1125,1127,1138,1149,1152,1223 APEKL Local 1110 R(4) 4 scalar 1110,1111,1112 APEKXX Local 1125 R(4) 4 scalar 1125,1134,1136 APEKXY Local 1127 R(4) 4 scalar 1127,1134,1136,1138 APESK Local 407 R(4) 4 1 45 1222,1224,1225 APESP Local 921 R(4) 4 scalar 921,922 APESTS Local 861 R(4) 4 scalar 861,862 AVGEFI Param 130 R(4) 4 scalar BI Local 1434 R(4) 4 scalar 1434,1437,1441 BQ Local 896 R(4) 4 scalar 896,898 BQS00K Local 891 R(4) 4 scalar 891,896 BQS10K Local 893 R(4) 4 scalar 893,896 CAPA Param 60 R(4) 4 scalar 862,921,1222 CLDWTR Common 399 3447720 SAVE CLIMIT Local 1427 R(4) 4 scalar 1427,1447,1455 CNVCLD Common 314 287280 SAVE COUNT Local 492 R(4) 4 scalar 492,496,499 CP Param 60 R(4) 4 scalar 144,792,793,795,797,1349,1351,1354 ,1555,1557,1558,1560,1563 CPRLG Param 144 R(4) 4 scalar 1161,1239,1240,1241,1242,1243 CRATIO Local 763 R(4) 4 scalar 763,793,797,846 CTHRS Local 490 R(4) 4 scalar 490,1058 CTLBLK Common 245 112 SAVE DDATA Local 423 R(4) 4 2 17955 576,578,588,602,619,620,660,674,75 1,757,760,1011,1036,1049,1058,1171 ,1182,1243 DELCWM Local 728 R(4) 4 scalar 728,731,735,834,837,841,1397,1400, 1404,1644,1645,1648 DELQ Local 727 R(4) 4 scalar 727,730,734,833,836,840,1274,1275, 1278,1396,1399,1403,1582,1583,1585 ,1613,1614,1617 DELT Local 788 R(4) 4 scalar 788,792,1345,1349,1555,1556,1557,1 558,1560,1563 DELTACP Local 791 R(4) 4 scalar 791,793,795,797,1348,1351,1353 DEPMIN Local 1028 R(4) 4 scalar 1028,1032,1034 Page 28 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References DEPTH Local 1029 R(4) 4 scalar 1029,1032,1034,1204,1208 DEPWL Local 1205 R(4) 4 scalar 1205,1208 DETACL Local 1529 R(4) 4 scalar 1529,1532 DIFQ Local 408 R(4) 4 1 45 1100 DIFT Local 408 R(4) 4 1 45 1099 DLDT Param 235 R(4) 4 scalar 1341,1547 DSP Local 1210 R(4) 4 scalar 1210,1212,1215,1217,1221 DSP0FL Param 111 R(4) 4 scalar 116,136 DSP0FS Param 115 R(4) 4 scalar 117,139 DSP0K Local 1198 R(4) 4 scalar 1198,1210,1212,1215,1217 DSP0SL Param 116 R(4) 4 scalar 136,1199 DSP0SS Param 117 R(4) 4 scalar 139,1198 DSPBFL Param 111 R(4) 4 scalar 116,135 DSPBFS Param 115 R(4) 4 scalar 117,138 DSPBK Local 1196 R(4) 4 scalar 1196,1212 DSPBSL Param 116 R(4) 4 scalar 135,1197 DSPBSS Param 117 R(4) 4 scalar 138,1196 DSPC Param 130 R(4) 4 scalar DSPTFL Param 111 R(4) 4 scalar 116,137 DSPTFS Param 115 R(4) 4 scalar 117,140 DSPTK Local 1200 R(4) 4 scalar 1200,1210,1217 DSPTSL Param 116 R(4) 4 scalar 137,1201 DSPTSS Param 117 R(4) 4 scalar 140,1200 DTCNVC Local 487 R(4) 4 scalar 487,488,489,490,494 DTHEM Local 1149 R(4) 4 scalar 1149,1152 DTTOP Param 64 R(4) 4 scalar 1006 EFI Local 1055 R(4) 4 scalar 1055,1056,1057,1058,1059,1082,1185 ,1196,1197,1198,1199,1200,1201 EFIFC Param 129 R(4) 4 scalar EFIMN Param 101 R(4) 4 scalar 130,135,136,137,138,139,140,141,11 85,1186,1196,1197,1198,1199,1200,1 201 EFINEW Local 1054 R(4) 4 scalar 1054,1055 EFMNT Param 101 R(4) 4 scalar 141 ELIV Param 235 R(4) 4 scalar 786,1343,1549 ELIVW Param 61 R(4) 4 scalar 144 ELOCP Param 144 R(4) 4 scalar 922 ELV Local 784 R(4) 4 scalar 784,786,792,793,795,797,1341,1343, 1349,1351,1354,1547,1549,1555,1557 ,1559,1561,1563 ELWV Param 61 R(4) 4 scalar 143,144,784,1341,1547 ENDFCTR Local 516 R(4) 4 scalar 516,519,546,619,791,1240,1241,1242 ,1348,1559,1561 EPSDN Param 66 R(4) 4 scalar EPSNTP Param 129 R(4) 4 scalar EPSP Param 130 R(4) 4 scalar EPSQ Param 61 R(4) 4 scalar 863 EPSTH Param 66 R(4) 4 scalar EPSUP Param 66 R(4) 4 scalar ETABOT Local 1544 R(4) 4 scalar 1544,1552,1554 ETATOP Local 1543 R(4) 4 scalar 1543,1552,1554 ETBIG Local 1552 R(4) 4 scalar 1552,1553,1564 EXP Func 604 scalar 604,681,700,711,712,772,801,816,81 7,922,1224,1253,1265,1333,1356,137 9,1380,1440,1573,1606,1629,1630 Page 29 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References FACTOR Local 1049 R(4) 4 scalar 1049,1053,1054 FCB Param 101 R(4) 4 scalar 1055 FCC Param 101 R(4) 4 scalar 101,1055 FI Local 1446 R(4) 4 scalar 1446,1447 FIW Local 1448 R(4) 4 scalar 1448,1450,1454,1455,1458,1460,1461 FIWL1 Local 1426 R(4) 4 scalar 1426,1455,1461 FLOAT Func 1604 scalar 1604,1661,1662 FPK Local 409 R(4) 4 1 45 FRACT Local 497 R(4) 4 scalar 497,499,524,545,576,578,579,602 FSL Param 111 R(4) 4 scalar 116 FSS Param 101 R(4) 4 scalar 117 G Param 60 R(4) 4 scalar 144,727,728,792,793,795,797,833,83 4,1274,1349,1351,1354,1396,1397,15 55,1557,1559,1561,1563,1582,1613,1 644 GLATD Local 567 R(4) 4 scalar 567,568,586,587 GLATMAX Local 566 R(4) 4 scalar 566,568,586,587 GLATMIN Local 565 R(4) 4 scalar 565,586,587 GLB_TABLE Common 209 128 SAVE I Local 562 I(4) 4 scalar 562,567,568,569,572,575,576,578,57 9,585,588,602,606,617,619,620,621, 622,658,659,660,664,665,666,667,66 8,674,675,677,679,681,684,685,686, 687,692,694,695,697,700,701,702,70 3,704,705,709,710,720,727,728,730, 731,734,735,741,742,743,744,745,75 1,757,758,760,761,763,766,767,772, 773,775,776,778,783,788,791,792,79 3,794,795,796,797,798,801,802,803, 804,805,806,813,814,815,826,833,83 4,836,837,840,841,846,861,862,863, 867,869,870,871,874,875,924,925,92 6,927,936,938,939,945,946,947,949, 951,952,953,955,958,959,963,969,97 3,977,1005,1006,1009,1011,1012,101 3,1014,1016,1017,1018,1020,1021,10 22,1027,1029,1030,1031,1035,1036,1 049,1053,1054,1055,1058,1059,1066, 1071,1072,1073,1074,1076,1077,1082 ,1098,1101,1104,1107,1110,1112,113 1,1161,1163,1169,1170,1171,1172,11 82,1186,1187,1196,1197,1198,1199,1 200,1201,1227,1239,1240,1241,1242, 1243,1244,1245,1246,1247,1251,1253 ,1254,1257,1259,1260,1265,1267,126 8,1274,1275,1278,1283,1284,1285,12 98,1302,1304,1323,1324,1329,1330,1 333,1334,1335,1336,1338,1340,1341, 1345,1348,1349,1350,1351,1352,1353 ,1354,1356,1357,1358,1377,1378,138 9,1396,1397,1399,1400,1403,1404,14 10,1425,1430,1431,1439,1440,1446,1 447,1455,1462,1469,1470,1472,1473, 1474,1476,1477,1480,1495,1499,1504 ,1505,1506,1512,1513,1514,1521,152 Page 30 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 2,1523,1524,1528,1546,1547,1551,15 53,1555,1556,1557,1558,1559,1560,1 561,1562,1563,1564,1565,1571,1572, 1573,1574,1582,1583,1585,1602,1603 ,1605,1606,1607,1613,1614,1617,162 7,1628,1638,1644,1645,1648,1661,16 62 IDIM1 Param 165 I(4) 4 scalar 256,263,264,266,267,268,285,286,28 7,288,289,290,291,292,293,294,295, 304,306,307,308,315,316,323,324,32 5,326,327,328,329,330,331,332,333, 334,335,336,337,338,339,341,346,35 5,356,364,374,375,377,378,400,402, 412,413,414,415,416,417,418,419,42 0,423,424,425,452,453,984,985,986, 988,989,995,996,997,999,1000 IDIM2 Param 165 I(4) 4 scalar 233,256,263,264,266,267,268,285,28 6,287,288,289,290,291,292,293,294, 295,304,306,307,308,315,316,323,32 4,325,326,327,328,329,330,331,332, 333,334,335,336,337,338,339,341,34 6,355,356,364,374,375,377,378,400, 402,412,413,414,415,416,417,418,41 9,420,423,424,425,452,453 IERR Local 688 I(4) 4 scalar 688 IGSADJ Local 452 L(4) 4 2 17955 483,1035,1172,1187,1298 IGSTL Param 160 I(4) 4 scalar 165 IGSTR Param 160 I(4) 4 scalar 165 IHR Local 493 I(4) 4 scalar 493,547,569,572,575,576,578,579,65 9,1011,1012 IHRES Local 422 I(4) 4 1 15327 977,996 ILRES Local 421 I(4) 4 1 15327 973,985 IM Param 149 I(4) 4 scalar 162,165,215,216,217,218,219,223,22 4,229,232,368 IMJM Param 232 I(4) 4 scalar IMJM_LOC Param 233 I(4) 4 scalar 421,422 INDX Common 361 6564 SAVE INDXG Common 367 8084 SAVE INPES Param 157 I(4) 4 scalar 162,165,199,200,201,210,211 INT Func 878 scalar 878,900 IPTB Local 414 I(4) 4 2 17955 988,999 IQ Local 912 I(4) 4 scalar 912,914,915,916,917 IQTB Local 900 I(4) 4 scalar 900,902,903,907,908,912 IT Local 913 I(4) 4 scalar 913,914,915,916,917 ITAIL Param 162 I(4) 4 scalar ITB Param 170 I(4) 4 scalar 282,297,907,908,984 ITBQ Param 170 I(4) 4 scalar 283,297,995 ITHTB Local 414 I(4) 4 2 17955 989,1000 ITTB Local 878 I(4) 4 scalar 878,880,881,885,886,890,913 ITTBK Local 890 I(4) 4 scalar 890,891,892,893,894 IVI Local 1130 I(4) 4 scalar 1130,1131,1135,1138,1139,1140 J Local 561 I(4) 4 scalar 561,567,568,569,572,575,576,578,57 9,585,588,602,606,617,619,620,621, 622,657,659,660,664,665,666,667,66 8,674,675,677,679,681,684,685,686, Page 31 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 687,692,694,695,697,700,701,702,70 3,704,705,709,710,720,727,728,730, 731,734,735,741,742,743,744,745,75 1,757,758,760,761,763,766,767,772, 773,775,776,778,783,788,791,792,79 3,794,795,796,797,798,801,802,803, 804,805,806,813,814,815,826,833,83 4,836,837,840,841,846,861,862,863, 867,869,870,871,874,875,924,925,92 6,927,936,938,939,945,946,947,949, 951,952,953,955,958,959,963,969,97 4,978,1005,1006,1009,1011,1012,101 3,1014,1016,1017,1018,1020,1021,10 22,1027,1029,1030,1031,1035,1036,1 049,1053,1054,1055,1058,1059,1066, 1071,1072,1073,1074,1076,1077,1082 ,1098,1101,1104,1107,1110,1112,113 1,1161,1163,1169,1170,1171,1172,11 82,1186,1187,1196,1197,1198,1199,1 200,1201,1227,1239,1240,1241,1242, 1243,1244,1245,1246,1247,1251,1253 ,1254,1257,1259,1260,1265,1267,126 8,1274,1275,1278,1283,1284,1285,12 98,1302,1304,1323,1324,1329,1330,1 333,1334,1335,1336,1338,1340,1341, 1345,1348,1349,1350,1351,1352,1353 ,1354,1356,1357,1358,1377,1378,138 9,1396,1397,1399,1400,1403,1404,14 10,1425,1430,1431,1439,1440,1446,1 447,1455,1462,1469,1470,1472,1473, 1474,1476,1477,1480,1495,1499,1504 ,1505,1506,1512,1513,1514,1521,152 2,1523,1524,1528,1546,1547,1551,15 53,1555,1556,1557,1558,1559,1560,1 561,1562,1563,1564,1565,1571,1572, 1573,1574,1582,1583,1585,1602,1603 ,1605,1606,1607,1613,1614,1617,162 7,1628,1638,1644,1645,1648,1661,16 62 JAM Param 232 I(4) 4 scalar 255 JDIM1 Param 166 I(4) 4 scalar 256,263,264,266,267,268,285,286,28 7,288,289,290,291,292,293,294,295, 304,306,307,308,315,316,323,324,32 5,326,327,328,329,330,331,332,333, 334,335,336,337,338,339,341,346,35 5,356,362,363,374,375,377,378,400, 402,412,413,414,415,416,417,418,41 9,420,423,424,425,452,453,984,985, 986,988,989,995,996,997,999,1000 JDIM2 Param 166 I(4) 4 scalar 233,256,263,264,266,267,268,285,28 6,287,288,289,290,291,292,293,294, 295,304,306,307,308,315,316,323,32 4,325,326,327,328,329,330,331,332, 333,334,335,336,337,338,339,341,34 6,355,356,362,363,374,375,377,378, Page 32 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References 400,402,412,413,414,415,416,417,41 8,419,420,423,424,425,452,453 JGSTL Param 161 I(4) 4 scalar 166 JGSTR Param 161 I(4) 4 scalar 166 JHRES Local 422 I(4) 4 1 15327 978,996 JLRES Local 421 I(4) 4 1 15327 974,985 JM Param 149 I(4) 4 scalar 163,166,215,216,217,218,219,223,22 4,229,232,368 JNPES Param 157 I(4) 4 scalar 163,166,199,200,201,210,211 JTAIL Param 163 I(4) 4 scalar JTB Param 170 I(4) 4 scalar 282,297,885,886,984 JTBQ Param 170 I(4) 4 scalar 297,995 KB Local 866 I(4) 4 scalar 866,869,873,874,875 KNUMH Local 967 I(4) 4 scalar 967,976,977,978,994,995 KNUML Local 966 I(4) 4 scalar 966,972,973,974,983,984 L Local 676 I(4) 4 scalar 676,677,679,681,684,685,686,687,69 2,694,695,697,700,702,704,705,710, 711,720,727,728,765,766,767,772,77 3,775,776,778,783,788,791,792,793, 795,797,801,803,805,806,813,814,81 5,816,826,833,834,860,861,862,863, 867,935,936,937,939,950,951,952,95 3,962,963,969,984,985,995,996,1004 ,1005,1006,1065,1066,1097,1098,109 9,1100,1101,1102,1103,1104,1105,11 06,1107,1108,1109,1110,1111,1112,1 129,1130,1151,1152,1160,1161,1190, 1191,1206,1209,1210,1212,1216,1217 ,1220,1221,1222,1223,1224,1225,122 7,1233,1234,1249,1251,1253,1254,12 57,1259,1260,1265,1268,1274,1284,1 285,1328,1329,1330,1333,1334,1335, 1336,1338,1340,1341,1345,1348,1349 ,1351,1353,1356,1358,1377,1378,137 9,1389,1396,1397,1429,1430,1431,14 39,1440,1446,1447,1455,1460,1462,1 468,1469,1470,1472,1473,1477,1520, 1521,1522,1523,1524,1531,1532,1545 ,1546,1547,1551,1552,1555,1556,155 7,1558,1560,1563,1564,1572,1573,15 74,1582,1601,1603,1604,1605,1606,1 607,1613,1626,1627,1628,1629,1638, 1644 L0 Local 1121 I(4) 4 scalar 1121,1140,1141,1144,1147,1149,1209 ,1216 L0M1 Local 1144 I(4) 4 scalar 1144,1147,1151 LB Local 1081 I(4) 4 scalar 1081,1117,1118,1121,1122,1123,1124 ,1125,1160,1190,1206,1233,1249 LBM1 Local 1117 I(4) 4 scalar 1117,1126,1127,1129,1130 LBOT Local 412 I(4) 4 2 17955 666,667,939,946,949,953,955,958,10 13,1016,1017,1021,1077,1169,1662 LBTK Local 1077 I(4) 4 scalar 1077,1081 LCBOT Local 1523 I(4) 4 scalar 1523,1527,1531,1544,1545,1600,1601 ,1604,1626 LCBOTTM Local 1600 I(4) 4 scalar 1600,1601 Page 33 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References LCTOP Local 1524 I(4) 4 scalar 1524,1527,1531,1543,1545,1626 LM Param 149 I(4) 4 scalar 224,234,266,267,281,306,307,341,35 5,356,374,400,401,406,407,408,409, 416,424,425,676,765,860,866,962,10 04,1065,1097,1520 LM1 Param 234 I(4) 4 scalar 935 LMHIJ Local 945 I(4) 4 scalar 945,947,949,950 LMHK Local 870 I(4) 4 scalar 870,871,873,1302,1328,1429,1468,16 00 LOOPS Common 254 158840 SAVE LP1 Param 234 I(4) 4 scalar 281 LSM Param 149 I(4) 4 scalar LTOP Local 412 I(4) 4 2 17955 958,1006,1009,1013,1016,1017,1021, 1076,1169,1661 LTP1 Local 1116 I(4) 4 scalar 1116 LTPK Local 1076 I(4) 4 scalar 1076,1116,1119,1129,1130,1151,1160 ,1190,1206,1233,1249 MAPPINGS Common 228 5024 SAVE MASKS Common 262 6894720 SAVE MAX Func 1662 scalar 1662 MIN Func 1661 scalar 1661 MIN0 Func 1600 scalar 1600 MOD Func 492 scalar 492 MPI_FINALIZE Subr 688 688 MPPCOM Common 173 1464 SAVE NUMLEV Local 1527 I(4) 4 scalar 1527,1528 OCT90 Param 57 L(4) 4 scalar OLDCWM Local 695 R(4) 4 scalar 695,728,776,834,1336,1397,1627,164 4 OLDQ Local 694 R(4) 4 scalar 694,705,727,775,806,833,1257,1274, 1285,1335,1396,1551,1582,1603,1613 OLDRH Local 693 R(4) 4 scalar 693,704,774,805,1256,1284 P Local 420 R(4) 4 2 17955 938,939,952,953 P00K Local 914 R(4) 4 scalar 914,919,920 P01K Local 916 R(4) 4 scalar 916,919,920 P10K Local 915 R(4) 4 scalar 915,919,920 P11K Local 917 R(4) 4 scalar 917,920 PBM Param 67 R(4) 4 scalar PBOT Local 413 R(4) 4 2 17955 667,946,949,955,959,1014,1018,1022 ,1029,1031,1170,1465,1472,1473,147 4,1476,1480,1495,1505,1513,1523 PDIFF Local 602 R(4) 4 scalar 602,604,622 PDSL Local 415 R(4) 4 2 17955 665,667,679,727,728,767,792,793,79 5,797,833,834,861,869,871,938,946, 947,952,955,969,985,996,1009,1107, 1161,1239,1240,1241,1242,1243,1251 ,1274,1330,1349,1351,1353,1396,139 7,1439,1470,1473,1477,1522,1555,15 57,1558,1560,1563,1572,1582,1605,1 613,1644 PETAL Local 679 R(4) 4 scalar 679,680,685,687,699,704,733,767,77 1,800,805,839,1251,1252,1264,1277, 1284,1330,1331,1332,1356,1402,1470 ,1471,1584,1616,1647 PEXP Local 604 R(4) 4 scalar 604,605,606,623 Page 34 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References PFACTOR Local 453 R(4) 4 2 17955 558,606,622,701,704,802,1267,1284, 1357 PFRZ Param 68 R(4) 4 scalar 1204 PHYS Common 276 1788916 SAVE PHYST Local 494 R(4) 4 scalar 494,496,497,514,516,523,526,532 PK Local 406 R(4) 4 1 45 1108,1118,1119,1122,1141,1152,1210 ,1212,1217,1220,1221,1522,1523,152 4 PK0 Local 1122 R(4) 4 scalar 1122,1141,1148,1205,1210,1212,1217 PKB Local 1118 R(4) 4 scalar 1118,1205,1212 PKL Local 869 R(4) 4 scalar 869,873,1107,1108,1109 PKT Local 1119 R(4) 4 scalar 1119,1148,1152,1210,1217 PNO Param 67 R(4) 4 scalar PONE Param 67 R(4) 4 scalar 949,953 PP Local 418 R(4) 4 2 17955 986,997 PP1 Local 899 R(4) 4 scalar 899,904,909,919,920 PPTASM Common 373 3878292 SAVE PPTSUM Local 469 R(4) 4 scalar SAVE 468,619,621 PQ0 Param 63 R(4) 4 scalar 680,685,687,699,771,800,1224,1252, 1264,1332,1356,1439,1572,1605 PQM Param 67 R(4) 4 scalar 939,1220 PREC1 Local 1528 R(4) 4 scalar 1528,1553 PRECK Local 1231 R(4) 4 scalar 1231,1234,1239,1240,1241,1242,1243 PRECL Local 416 R(4) 4 2 17955 1553,1555,1564 PRECMAX Local 1158 R(4) 4 scalar 1158,1161,1164,1166,1182 PRESK Local 969 R(4) 4 scalar 969,971 PSFC Local 1425 R(4) 4 scalar 1425,1495 PSFCIJ Local 1027 R(4) 4 scalar 1027,1028,1204 PSFCK Local 871 R(4) 4 scalar 871,873,947,949,953 PSH Param 67 R(4) 4 scalar PSHNEW Local 633 R(4) 4 scalar 633,1028,1170 PSHU Param 68 R(4) 4 scalar PSK Local 407 R(4) 4 1 45 1109,1221,1222,1224 PSP Local 419 R(4) 4 2 17955 925,939 PTOP Local 413 R(4) 4 2 17955 959,1009,1014,1018,1022,1029,1031, 1170,1466,1474,1476,1477,1480,1499 ,1505,1506,1513,1514,1524 PTRES1 Local 538 R(4) 4 scalar 538,1499,1504 PTRES2 Local 539 R(4) 4 scalar 539,1504,1512 PTRES3 Local 540 R(4) 4 scalar 540,1571,1602 PVRBLS Common 322 5530140 SAVE Q2BT Local 417 R(4) 4 2 17955 QBT Local 874 R(4) 4 scalar 874,898,922 QC Local 416 R(4) 4 1 45 1460,1462,1572,1574,1605,1607 QCKL Local 680 R(4) 4 scalar 680,683,684,686,692,699,702,771,77 3,800,803,1252,1254,1264,1268,1332 ,1334,1356,1358 QI Local 1441 R(4) 4 scalar 1441,1443,1446,1460 QINT Local 1442 R(4) 4 scalar 1442,1443,1460 QK Local 407 R(4) 4 1 45 1105 QKL Local 1104 R(4) 4 scalar 1104,1105,1106 QQ Local 418 R(4) 4 2 17955 986,997 QQ1 Local 877 R(4) 4 scalar 877,882,887,896,897,919,920 QREFK Local 406 R(4) 4 1 45 1106,1224,1227,1260 QSATK Local 409 R(4) 4 1 45 Page 35 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References QW Local 1439 R(4) 4 scalar 1439,1441,1442 R2D Local 564 R(4) 4 scalar 564,567 RATIO Local 1182 R(4) 4 scalar 1182,1183,1184,1191 RCP Param 144 R(4) 4 scalar RDP0T Local 1148 R(4) 4 scalar 1148,1152 RDTCNVC Local 488 R(4) 4 scalar 488 RELH Local 409 R(4) 4 1 45 1462,1472,1477 RELHUM Local 692 R(4) 4 scalar 692,693,701,702,705,773,774,802,80 3,806,1254,1256,1267,1268,1285,133 4,1357,1358 RHF Param 66 R(4) 4 scalar RHFCTR Local 1604 R(4) 4 scalar 1604,1607 ROW Param 61 R(4) 4 scalar 144,792,793,795,797,1349,1351,1354 ,1555,1557,1559,1561,1563 SINGLRST Local 243 L(4) 4 scalar SIXSIX Local 532 R(4) 4 scalar 532,538,539,540,579 SLOP0L Param 136 R(4) 4 scalar 1199 SLOP0S Param 139 R(4) 4 scalar 1198 SLOPBL Param 135 R(4) 4 scalar 1197 SLOPBS Param 138 R(4) 4 scalar 1196 SLOPE Param 141 R(4) 4 scalar SLOPTL Param 137 R(4) 4 scalar 1201 SLOPTS Param 140 R(4) 4 scalar 1200 SQ Local 897 R(4) 4 scalar 897,898 SQS00K Local 892 R(4) 4 scalar 892,897 SQS10K Local 894 R(4) 4 scalar 894,897 STABD Param 64 R(4) 4 scalar 1132 STABDL Local 1132 R(4) 4 scalar 1132,1133 STABFC Param 64 R(4) 4 scalar STABS Param 64 R(4) 4 scalar STEFI Param 131 R(4) 4 scalar 675 STRESH Param 63 R(4) 4 scalar T1 Param 63 R(4) 4 scalar TAUK Local 489 R(4) 4 scalar 489 TBT Local 417 R(4) 4 2 17955 TEMPCOM Common 214 6603768 SAVE TEND Local 512 R(4) 4 scalar 512,514,516 TFRZ Param 63 R(4) 4 scalar 1131 THBT Local 419 R(4) 4 2 17955 926 THERK Local 407 R(4) 4 1 45 1112,1124,1126,1139,1149,1152 THERKX Local 1124 R(4) 4 scalar 1124,1133,1137 THERKY Local 1126 R(4) 4 scalar 1126,1133,1137,1139 THESP Local 420 R(4) 4 2 17955 664,924,927,988,999 THEVRF Local 408 R(4) 4 1 45 THSK Local 407 R(4) 4 1 45 1223,1224,1225 THVMOD Local 408 R(4) 4 1 45 THVREF Local 408 R(4) 4 1 45 TIMES Local 491 R(4) 4 scalar 491,492,493,514,516,523,545 TK Local 406 R(4) 4 1 45 1102,1161,1191,1234 TKL Local 1101 R(4) 4 scalar 1101,1102,1103 TMT0 Local 1431 R(4) 4 scalar 1431,1432,1435,1441,1443,1445,1453 ,1457 TMT15 Local 1432 R(4) 4 scalar 1432,1442 TOPO Common 222 17478548 SAVE TPSP Local 919 R(4) 4 scalar 919,921,925 Page 36 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Object Declared Type Bytes Dimen Elements Attributes References TQ Local 898 R(4) 4 scalar 898,899,900 TREF Local 425 R(4) 4 3 807975 668,984,995,1006,1112 TREFK Local 406 R(4) 4 1 45 1103,1123,1135,1149,1152,1161,1191 ,1223,1234,1259 TREFKX Local 1123 R(4) 4 scalar 1123,1133,1134,1135 TREL Param 129 R(4) 4 scalar 489 TTBLEX Subr 984 984,995 TTEMP Local 710 R(4) 4 scalar 710,712,815,817,1378,1380,1628,163 0 TTH Local 876 R(4) 4 scalar 876,877,878 TTHBT Local 875 R(4) 4 scalar 875,876,922,926 TTHES Local 922 R(4) 4 scalar 922,924,927 UNIL Param 57 L(4) 4 scalar UNIS Param 57 L(4) 4 scalar VRBLS Common 303 13143060 SAVE WFIX Local 711 R(4) 4 scalar 711,712,816,817,1379,1380,1629,163 0 WMIN Local 712 R(4) 4 scalar 712,720,814,817,826,1380,1389,1630 ,1638 YLTMP Local 1563 R(4) 4 scalar 1563,1564 ZER Local 524 R(4) 4 scalar 524,526,621,660,674,1011,1012,1053 ,1304,1410 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References ACCLIQ R(4) 4 1292760 2 17955 COM ACPREC R(4) 4 1220940 2 17955 COM 741,795,796,1073,1242,1247,1353,13 54,1558,1559,1676 ACUTIM R(4) 4 20 scalar COM AETA R(4) 4 264 1 45 COM 667,679,767,861,869,871,937,946,94 7,952,955,969,985,996,1009,1107,12 51,1330,1439,1470,1473,1477,1522,1 543,1544,1552,1572,1605 AFSI R(4) 4 5458320 2 17955 COM AKHS R(4) 4 646380 2 17955 COM AKMS R(4) 4 574560 2 17955 COM ALBASE R(4) 4 1009004 2 17955 COM ALBEDO R(4) 4 1080824 2 17955 COM APREC R(4) 4 3519180 2 17955 COM 621,709,742,743,745,763,813,846,10 71,1072,1244,1304,1323,1351,1352,1 410,1528,1560,1561,1565,1675 ARATIM R(4) 4 16 scalar COM AVCNVC R(4) 4 12 scalar COM AVRAIN R(4) 4 8 scalar COM CFRACH R(4) 4 215460 2 17955 COM CFRACL R(4) 4 71820 2 17955 COM CFRACM R(4) 4 143640 2 17955 COM CI R(4) 4 40 scalar COM CLDEFI R(4) 4 1077300 2 17955 COM 675,1054,1055,1059,1082,1186 CLDINC R(4) 4 3734652 2 17955 COM 731,837,1400,1645 CLDINC7 R(4) 4 3806472 2 17955 COM 735,841,1404,1648 CNVBOT R(4) 4 721724 2 17955 COM Page 37 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References CNVTOP R(4) 4 649904 2 17955 COM CS R(4) 4 28 scalar COM CUPPT R(4) 4 0 2 17955 COM 743,797,798,1072,1241 CUPREC R(4) 4 1364580 2 17955 COM 742,793,794,1071,1240,1247,1677 CWM R(4) 4 0 3 807975 COM 695,720,728,776,814,826,834,1336,1 389,1397,1447,1455,1627,1638,1644 CZEN R(4) 4 434444 2 17955 COM CZMEAN R(4) 4 1296284 2 17955 COM DETA R(4) 4 84 1 45 COM 727,728,792,793,795,797,833,834,11 61,1234,1274,1349,1351,1353,1396,1 397,1532,1543,1544,1555,1557,1558, 1560,1563,1582,1613,1644 DFRLG R(4) 4 444 1 46 COM DI R(4) 4 44 scalar COM DS R(4) 4 32 scalar COM DT R(4) 4 48 scalar COM 487,491 DTD R(4) 4 16 scalar COM DTQ2 R(4) 4 8 scalar COM EPSR R(4) 4 75344 2 17955 COM FIRST L(4) 4 24 scalar COM FIS R(4) 4 12999420 2 17955 COM G2LI I(4) 4 0 1 239 COM G2LJ I(4) 4 1912 1 389 COM GFFC R(4) 4 865364 2 17955 COM GLAT R(4) 4 290804 2 17955 COM 567 GLON R(4) 4 362624 2 17955 COM HBM2 R(4) 4 6751080 2 17955 COM 1020 HBM3 R(4) 4 6822900 2 17955 COM HBOT R(4) 4 578084 2 17955 COM 1662 HDAC R(4) 4 1152644 2 17955 COM HDACV R(4) 4 1224464 2 17955 COM HTM R(4) 4 287280 3 807975 COM 677,766,863,867,936,951,963,985,99 6,1005,1066,1098,1329,1430,1469,15 21,1572,1573,1605,1606 HTMG R(4) 4 743768 3 4183695 COM HTOP R(4) 4 506264 2 17955 COM 1661 IBROW I(4) 4 404 scalar COM ICHUNKTAB I(4) 4 620 1 8 COM IDAT I(4) 4 8 1 3 COM IDTAD I(4) 4 72 scalar COM IE_GLB_TABLE I(4) 4 32 1 8 COM IE_LOC_TABLE I(4) 4 556 1 8 COM IHE I(4) 4 0 1 399 COM IHEG I(4) 4 0 1 387 COM IHHA I(4) 4 3040 1 760 COM IHLA I(4) 4 0 1 760 COM IHRST I(4) 4 20 scalar COM IHW I(4) 4 1596 1 399 COM IHWG I(4) 4 1548 1 387 COM ILCOL I(4) 4 396 scalar COM ILPAD1 I(4) 4 412 scalar COM ILPAD2 I(4) 4 416 scalar COM ILPAD3 I(4) 4 420 scalar COM ILPAD4 I(4) 4 424 scalar COM ILPAD5 I(4) 4 428 scalar COM Page 38 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References INUMQ I(4) 4 1064 1 100 COM IOUT I(4) 4 44 scalar COM IQUILT_GROUP I(4) 4 1060 scalar COM IRAD I(4) 4 6384 1 45 COM IRADG I(4) 4 6192 1 473 COM IRCOL I(4) 4 400 scalar COM IRPAD1 I(4) 4 432 scalar COM IRPAD2 I(4) 4 436 scalar COM IRPAD3 I(4) 4 440 scalar COM IRPAD4 I(4) 4 444 scalar COM IRPAD5 I(4) 4 448 scalar COM IS_GLB_TABLE I(4) 4 0 1 8 COM IS_LOC_TABLE I(4) 4 492 1 8 COM ITEMP I(4) 4 5870016 2 91719 COM ITEMP2 I(4) 4 6236892 2 91719 COM ITROW I(4) 4 408 scalar COM ITSTLOC I(4) 4 3591000 scalar COM 547,617,703,758,804,1030,1163,1245 ,1283,1324,1562,1674,1675,1676,167 7 IVE I(4) 4 3192 1 399 COM IVEG I(4) 4 3096 1 387 COM IVHA I(4) 4 9120 1 760 COM IVLA I(4) 4 6080 1 760 COM IVW I(4) 4 4788 1 399 COM IVWG I(4) 4 4644 1 387 COM JBPAD1 I(4) 4 452 scalar COM JBPAD2 I(4) 4 456 scalar COM JBPAD3 I(4) 4 460 scalar COM JBPAD4 I(4) 4 464 scalar COM JBPAD5 I(4) 4 468 scalar COM JE_GLB_TABLE I(4) 4 96 1 8 COM JE_LOC_TABLE I(4) 4 588 1 8 COM JRA I(4) 4 12160 1 760 COM JS_GLB_TABLE I(4) 4 64 1 8 COM JS_LOC_TABLE I(4) 4 524 1 8 COM JTPAD1 I(4) 4 472 scalar COM JTPAD2 I(4) 4 476 scalar COM JTPAD3 I(4) 4 480 scalar COM JTPAD4 I(4) 4 484 scalar COM JTPAD5 I(4) 4 488 scalar COM JTSTLOC I(4) 4 3591004 scalar COM 547,617,703,758,804,1030,1163,1245 ,1283,1324,1562,1674,1675,1676,167 7 KTM I(4) 4 0 scalar COM L2GI I(4) 4 956 1 239 COM L2GJ I(4) 4 3468 1 389 COM LC I(4) 4 3304080 2 17955 COM LIST I(4) 4 40 scalar COM LMH I(4) 4 15200 2 17955 COM 666,870,945,1302 LMV I(4) 4 87020 2 17955 COM MPI_COMM_COMP I(4) 4 652 scalar COM MPI_COMM_INTER I(4) 4 656 scalar COM MPI_COMM_INTER_ARRAY I(4) 4 660 1 100 COM MTSTPE I(4) 4 3591008 scalar COM 544,617,703,758,804,1030,1163,1245 ,1283,1324,1562,1673 Page 39 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References MXSNAL R(4) 4 3524 2 17955 COM MYIE I(4) 4 52 scalar COM 562,658 MYIE1 I(4) 4 56 scalar COM MYIE1_P1 I(4) 4 120 scalar COM MYIE1_P2 I(4) 4 124 scalar COM MYIE1_P3 I(4) 4 128 scalar COM MYIE1_P4 I(4) 4 132 scalar COM MYIE2 I(4) 4 60 scalar COM MYIE2_P1 I(4) 4 136 scalar COM MYIE_P1 I(4) 4 100 scalar COM MYIE_P2 I(4) 4 104 scalar COM MYIE_P3 I(4) 4 108 scalar COM MYIE_P4 I(4) 4 112 scalar COM MYIE_P5 I(4) 4 116 scalar COM MYIS I(4) 4 40 scalar COM 562,658 MYIS1 I(4) 4 44 scalar COM MYIS1_P1 I(4) 4 84 scalar COM MYIS1_P2 I(4) 4 88 scalar COM MYIS1_P3 I(4) 4 92 scalar COM MYIS1_P4 I(4) 4 96 scalar COM MYIS2 I(4) 4 48 scalar COM MYIS_P1 I(4) 4 64 scalar COM MYIS_P2 I(4) 4 68 scalar COM MYIS_P3 I(4) 4 72 scalar COM MYIS_P4 I(4) 4 76 scalar COM MYIS_P5 I(4) 4 80 scalar COM MYJE I(4) 4 236 scalar COM 561,657 MYJE1 I(4) 4 240 scalar COM MYJE1_P1 I(4) 4 280 scalar COM MYJE1_P2 I(4) 4 284 scalar COM MYJE1_P3 I(4) 4 288 scalar COM MYJE1_P4 I(4) 4 292 scalar COM MYJE2 I(4) 4 244 scalar COM MYJE2_P1 I(4) 4 296 scalar COM MYJE2_P2 I(4) 4 300 scalar COM MYJE2_P3 I(4) 4 304 scalar COM MYJE2_P4 I(4) 4 308 scalar COM MYJE3 I(4) 4 248 scalar COM MYJE3_P4 I(4) 4 312 scalar COM MYJE4 I(4) 4 252 scalar COM MYJE4_P1 I(4) 4 316 scalar COM MYJE4_P4 I(4) 4 320 scalar COM MYJE5 I(4) 4 256 scalar COM MYJE5_P1 I(4) 4 324 scalar COM MYJE5_P2 I(4) 4 328 scalar COM MYJE_P1 I(4) 4 260 scalar COM MYJE_P2 I(4) 4 264 scalar COM MYJE_P3 I(4) 4 268 scalar COM MYJE_P4 I(4) 4 272 scalar COM MYJE_P5 I(4) 4 276 scalar COM MYJS I(4) 4 140 scalar COM 561,657 MYJS1 I(4) 4 144 scalar COM MYJS1_P1 I(4) 4 184 scalar COM MYJS1_P2 I(4) 4 188 scalar COM MYJS1_P3 I(4) 4 192 scalar COM Page 40 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References MYJS1_P4 I(4) 4 196 scalar COM MYJS2 I(4) 4 148 scalar COM MYJS2_P1 I(4) 4 200 scalar COM MYJS2_P2 I(4) 4 204 scalar COM MYJS2_P3 I(4) 4 208 scalar COM MYJS2_P4 I(4) 4 212 scalar COM MYJS3 I(4) 4 152 scalar COM MYJS3_P4 I(4) 4 216 scalar COM MYJS4 I(4) 4 156 scalar COM MYJS4_P1 I(4) 4 220 scalar COM MYJS4_P4 I(4) 4 224 scalar COM MYJS5 I(4) 4 160 scalar COM MYJS5_P1 I(4) 4 228 scalar COM MYJS5_P2 I(4) 4 232 scalar COM MYJS_P1 I(4) 4 164 scalar COM MYJS_P2 I(4) 4 168 scalar COM MYJS_P3 I(4) 4 172 scalar COM MYJS_P4 I(4) 4 176 scalar COM MYJS_P5 I(4) 4 180 scalar COM MYPE I(4) 4 0 scalar COM 544,617,684,686,703,758,804,1030,1 163,1245,1283,1324,1562,1673 MY_E I(4) 4 336 scalar COM MY_IE_GLB I(4) 4 12 scalar COM MY_IE_LOC I(4) 4 28 scalar COM MY_IS_GLB I(4) 4 8 scalar COM MY_IS_LOC I(4) 4 24 scalar COM MY_JE_GLB I(4) 4 20 scalar COM MY_JE_LOC I(4) 4 36 scalar COM MY_JS_GLB I(4) 4 16 scalar COM MY_JS_LOC I(4) 4 32 scalar COM MY_N I(4) 4 332 scalar COM MY_NE I(4) 4 348 scalar COM MY_NEB I(4) 4 364 1 8 COM MY_NW I(4) 4 360 scalar COM MY_S I(4) 4 340 scalar COM MY_SE I(4) 4 352 scalar COM MY_SW I(4) 4 356 scalar COM MY_W I(4) 4 344 scalar COM NBC I(4) 4 36 scalar COM NBOCO I(4) 4 76 scalar COM NCNVC I(4) 4 92 scalar COM 487 NCP I(4) 4 84 scalar COM NEST I(4) 4 108 scalar COM NFCST I(4) 4 32 scalar COM NHEAT I(4) 4 4 scalar COM 476 NPES I(4) 4 4 scalar COM NPHS I(4) 4 88 scalar COM NPREC I(4) 4 68 scalar COM NRADL I(4) 4 100 scalar COM NRADS I(4) 4 96 scalar COM NSHDE I(4) 4 80 scalar COM NSTART I(4) 4 60 scalar COM NTDDMP I(4) 4 64 scalar COM NTSD I(4) 4 52 scalar COM 472,476,491,545 NTSTM I(4) 4 56 scalar COM Page 41 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References PD R(4) 4 0 2 17955 COM 665,1027,1425 PHOUR R(4) 4 0 2 17955 COM PL R(4) 4 48 scalar COM 986 PLQ R(4) 4 72 scalar COM 971,997 PPTDAT R(4) 4 3303720 3 53865 COM 547,569,572,575,576,578,579,659,10 11,1012 PREC R(4) 4 1149120 2 17955 COM 588,602,620,660,674,741,742,743,74 4,751,757,760,763,792,846,1049,105 3,1071,1072,1073,1074,1239,1246,13 49,1350,1557,1565,1674 PSHLTR R(4) 4 2154600 2 17955 COM PT R(4) 4 4 scalar COM 667,679,767,861,869,871,938,946,94 7,952,955,969,986,997,1009,1027,11 07,1251,1330,1425,1439,1470,1473,1 477,1522,1572,1605 PTBL R(4) 4 1439924 2 10184 COM 914,915,916,917 Q R(4) 4 9767520 3 807975 COM 692,694,702,705,727,773,775,803,80 6,833,863,874,1104,1227,1254,1257, 1260,1268,1274,1285,1334,1335,1358 ,1396,1446,1462,1551,1574,1582,160 3,1607,1613 Q10 R(4) 4 1795500 2 17955 COM Q2 R(4) 4 2226420 3 807975 COM Q30 R(4) 4 1508220 2 17955 COM QS R(4) 4 502740 2 17955 COM QS0 R(4) 4 628 1 134 COM 891,893 QSHLTR R(4) 4 2082780 2 17955 COM QWBS R(4) 4 861840 2 17955 COM QZ0 R(4) 4 359100 2 17955 COM RADIN R(4) 4 147164 2 17955 COM RADOT R(4) 4 218984 2 17955 COM RDP R(4) 4 64 scalar COM 987 RDPQ R(4) 4 76 scalar COM 998 RDQ R(4) 4 56 scalar COM 898 RDTH R(4) 4 60 scalar COM 876 RDTHE R(4) 4 68 scalar COM 987 RDTHEQ R(4) 4 80 scalar COM 998 RES R(4) 4 13071240 2 17955 COM 665 RESTRT L(4) 4 28 scalar COM RF R(4) 4 718200 2 17955 COM ROI R(4) 4 36 scalar COM ROS R(4) 4 24 scalar COM RUN L(4) 4 4 scalar COM SI R(4) 4 1005480 2 17955 COM SICE R(4) 4 215460 2 17955 COM 568 SIGMA L(4) 4 0 scalar COM SIGT4 R(4) 4 1368104 2 17955 COM SM R(4) 4 143640 2 17955 COM 568,585,1058,1196,1197,1198,1199,1 200,1201 SNO R(4) 4 933660 2 17955 COM SQS R(4) 4 1164 1 134 COM 892,894 SR R(4) 4 3375900 2 17955 COM 761,1340 SST R(4) 4 937184 2 17955 COM STHE R(4) 4 2004 1 76 COM 987 STHEQ R(4) 4 2916 1 152 COM 998 Page 42 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References SUBPOST L(4) 4 104 scalar COM T R(4) 4 71820 3 807975 COM 668,681,685,687,697,700,710,772,77 8,783,801,805,815,875,1006,1066,11 01,1131,1253,1259,1265,1333,1338,1 340,1341,1356,1378,1431,1440,1546, 1547,1556,1573,1606,1628 TCUCN R(4) 4 3231924 3 807975 COM TDTD R(4) 4 20 scalar COM TDTQ2 R(4) 4 12 scalar COM TEMP1 R(4) 4 0 2 91719 COM TEMP10 R(4) 4 3301884 2 91719 COM TEMP11 R(4) 4 3668760 2 91719 COM TEMP12 R(4) 4 4035636 2 91719 COM TEMP13 R(4) 4 4402512 2 91719 COM TEMP14 R(4) 4 4769388 2 91719 COM TEMP15 R(4) 4 5136264 2 91719 COM TEMP16 R(4) 4 5503140 2 91719 COM TEMP2 R(4) 4 366876 2 91719 COM TEMP2X R(4) 4 0 2 92971 COM TEMP3 R(4) 4 733752 2 91719 COM TEMP4 R(4) 4 1100628 2 91719 COM TEMP5 R(4) 4 1467504 2 91719 COM TEMP6 R(4) 4 1834380 2 91719 COM TEMP7 R(4) 4 2201256 2 91719 COM TEMP8 R(4) 4 2568132 2 91719 COM TEMP9 R(4) 4 2935008 2 91719 COM TG R(4) 4 793544 2 17955 COM TH10 R(4) 4 1723680 2 17955 COM TH30 R(4) 4 1436400 2 17955 COM THE0 R(4) 4 1700 1 76 COM 987 THE0Q R(4) 4 2308 1 152 COM 998 THEAT R(4) 4 0 scalar COM THL R(4) 4 52 scalar COM 876 THS R(4) 4 430920 2 17955 COM THZ0 R(4) 4 287280 2 17955 COM TLAT R(4) 4 71820 3 807975 COM 473,697,702,704,778,788,791,803,80 5,813,1066,1284,1338,1345,1348,137 7,1671 TRAIN R(4) 4 24 3 807975 COM TSHLTR R(4) 4 2010960 2 17955 COM TTBL R(4) 4 1480660 2 10184 COM 984 TTBLQ R(4) 4 1521396 2 66880 COM 995 TTVG R(4) 4 371884 2 92971 COM TWBS R(4) 4 790020 2 17955 COM U R(4) 4 3303720 3 807975 COM U00 R(4) 4 3231900 2 17955 COM U10 R(4) 4 1867320 2 17955 COM U30 R(4) 4 1580040 2 17955 COM UL R(4) 4 3303720 1 90 COM USTAR R(4) 4 71820 2 17955 COM UZ0 R(4) 4 143640 2 17955 COM V R(4) 4 6535620 3 807975 COM V10 R(4) 4 1939140 2 17955 COM V30 R(4) 4 1651860 2 17955 COM VAPINC R(4) 4 3591012 2 17955 COM 730,836,1275,1399,1583,1614 Page 43 Source Listing ADJPPT 2025-03-12 18:21 Symbol Table ADJPPT.F Name Type Bytes Offset Dimen Elements Attributes References VAPINC7 R(4) 4 3662832 2 17955 COM 734,840,1278,1403,1585,1617 VBM2 R(4) 4 0 2 17955 COM VBM3 R(4) 4 71820 2 17955 COM VTM R(4) 4 3519180 3 807975 COM VZ0 R(4) 4 215460 2 17955 COM Z0 R(4) 4 0 2 17955 COM Page 44 Source Listing ADJPPT 2025-03-12 18:21 Subprograms/Common Blocks ADJPPT.F SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ACMCLH Common 353 6463824 SAVE ADJPPT Subr 2 CLDWTR Common 399 3447720 SAVE CNVCLD Common 314 287280 SAVE CTLBLK Common 245 112 SAVE GLB_TABLE Common 209 128 SAVE INDX Common 361 6564 SAVE INDXG Common 367 8084 SAVE LOOPS Common 254 158840 SAVE MAPPINGS Common 228 5024 SAVE MASKS Common 262 6894720 SAVE MPPCOM Common 173 1464 SAVE PHYS Common 276 1788916 SAVE PPTASM Common 373 3878292 SAVE PVRBLS Common 322 5530140 SAVE TEMPCOM Common 214 6603768 SAVE TOPO Common 222 17478548 SAVE VRBLS Common 303 13143060 SAVE COMPILER OPTIONS BEING USED -align noall -align nonone -align nocommons -align nodcommons -align noqcommons -align nozcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -align norec32byte -align norec64byte -align noarray8byte -align noarray16byte -align noarray32byte -align noarray64byte -align noarray128byte -align noarray256byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume nobuffered_stdout -assume byterecl -assume nocontiguous_assumed_shape -assume nocontiguous_pointer -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_complex_align -assume old_unit_star -assume old_inquire_recl -assume old_ldout_format -assume old_ldout_zero -assume noold_logical_assign -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume noprotect_allocates -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume std_minus0_rounding -assume nostd_mod_proc_name -assume std_value -assume realloc_lhs -assume underscore -assume no2underscores -assume norecursion no -auto -auto_scalar Page 45 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F no -bintext -ccdefault default -check noarg_temp_created -check noassume -check nobounds -check nocontiguous -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check noshape -check nostack -check nouninitialized -check noudio_iostat -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1910 -D __INTEL_COMPILER_UPDATE=3 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D __amd64 -D __amd64__ -D __INTEL_COMPILER_BUILD_DATE=20200925 -D __INTEL_OFFLOAD -D __MMX__ -D __SSE__ -D __SSE_MATH__ -D __SSE2__ -D __SSE2_MATH__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __POPCNT__ -D __PCLMUL__ -D __AES__ -D __AVX__ -D __F16C__ -D __AVX_I__ -D __RDRND__ -D __FMA__ -D __FP_FAST_FMA -D __FP_FAST_FMAF -D __BMI__ -D __LZCNT__ -D __AVX2__ -D __haswell -D __haswell__ -D __tune_haswell__ -D __core_avx2 -D __core_avx2__ -D __tune_core_avx2__ -D __CRAY_X86_ROME -D __CRAYXT_COMPUTE_LINUX_TARGET -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 Page 46 Source Listing ADJPPT 2025-03-12 18:21 ADJPPT.F -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 -init noarrays -init nohuge -init noinfinity -init nominus_huge -init nominus_infinity -init nominus_tiny -init nonan -init nosnan -init notiny -init nozero no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude no -o -offload-build=host -openmp-simd -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded -vec=simd -show nofullpath -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w nodeclarations -w noexternals -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w noshape -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage no -wrap-margins -includepath : /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/, .f90,./.f90,/opt/cray/pe/mpich/8.1.12/ofi/intel/19.0/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/stdlib/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/tbb/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/icc/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/.f90,/usr/lib64/gcc/x86_64-suse-linux/7/include/.f90, /usr/lib64/gcc/x86_64-suse-linux/7/include-fixed/.f90,/usr/include/.f90,/usr/include/.f90,/usr/include/.f90 -list filename : ADJPPT.lst no -o COMPILER: Intel(R) Fortran 19.1-1655