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