GPLHGT.inc
References to this file elsewhere.
1 SUBROUTINE GPLHGT
2 I (GPS ,GTMP,GWV ,GPHIS,IMAX,JMAX,KMAX,RGAS,G,A,B,
3 I JSTA,JFIN,
4 O GHGT)
5 C***********************************************************************
6 C CALCULATION OF GEOPOTENTIAL HEIGHT
7 C***********************************************************************
8 ! WRFVAR compiles at double precision by default, so DOUBLE PRECISION is
9 ! overkill
10 ! IMPLICIT DOUBLE PRECISION (A-H,O-Z)
11 C
12 REAL*8 RGAS,G
13 REAL*8 GPS (IMAX,JMAX ), GTMP(IMAX,JMAX,KMAX),
14 & GWV (IMAX,JMAX,KMAX), GPHIS(IMAX,JMAX )
15 REAL*8 GHGT(IMAX,JMAX,KMAX)
16 C
17 PARAMETER (KM=50)
18 C
19 C DIMENSION PHALF(KM), DELP(KM), ALPHA(KM), TV(KM)
20 DIMENSION PHALF(KM), ALPHA(KM), TV(KM)
21 DIMENSION PHALFL(KM)
22 Crizvi REAL*8 A(50), B(50)
23 REAL*8 A(KMAX+1), B(KMAX+1)
24 C
25 C DATA COEF /0.608D0/
26 C********************* PROCEDURE *************************************
27 COEF=0.608D0
28 IF (KMAX.GT.KM) THEN
29 WRITE(6,*) ' ERROR: <KMAX> IS TOO LARGE. in GPLHGT'
30 STOP 100
31 END IF
32 RGASG = RGAS/G
33 ALPHA(KMAX) = LOG(2.D0)
34 CPOPTION PARALLEL,DIVNUM(12),PRIND((J,1))
35 C2000.08.25
36 CLSW*POPTION PARALLEL
37 CLSW*POPTION TLOCAL(J,I,K,DELP,SHGT,HYDRO,
38 CLSW*POPTION PHALF,TV,ALPHA,PHALFL)
39 CLSW*POPTION INIT(ALPHA(KMAX))
40 DO 1000 J = JSTA,JFIN
41 C DO 1000 J = 1, JMAX
42 DO 1000 I = 1, IMAX
43 DO 100 K = 1, KMAX
44 PHALF(K) = A(K) + B(K)*GPS (I,J)
45 C TV (K) = (1.D0+COEF*GWV(I,J,K))*GTMP(I,J,K)
46 TV (K) = (1.D0+COEF*GWV(I,J,K))*GTMP(I,J,K)*RGASG
47 C WRITE(6,*) ' K,PHALF,TV=',K,PHALF(K),TV(K)
48 100 CONTINUE
49 DO 200 K = 1, KMAX-1
50 C DELP (K) = PHALF(K) - PHALF(K+1)
51 DELP = PHALF(K) - PHALF(K+1)
52 C ALPHA(K) = 1.D0-PHALF(K+1)*LOG(PHALF(K)/PHALF(K+1))/DELP(K)
53 PHALFL(K)= LOG(PHALF(K)/PHALF(K+1))
54 C ALPHA(K) = 1.D0-PHALF(K+1)*PHALFL(K)/DELP(K)
55 ALPHA(K) = 1.D0-PHALF(K+1)*PHALFL(K)/DELP
56 200 CONTINUE
57 C ALPHA(KMAX) = LOG(2.D0)
58 SHGT = GPHIS(I,J)/G !SHCO
59 C SHGT = GPHIS(I,J) !SHCN
60 C WRITE(6,*) ' SHGT=',SHGT
61 DO 300 K = 1, KMAX
62 C GHGT(I,J,K) = SHGT + ALPHA(K)*RGASG*TV(K)
63 GHGT(I,J,K) = SHGT + ALPHA(K)*TV(K)
64 C WRITE(6,*) ' K,SHGT+LEVEL K-1/2 TO K=',K,GHGT(I,J,K)
65 300 CONTINUE
66 HYDRO = 0.D0
67 C WRITE(6,*) ' K,GHGT=',1,GHGT(I,J,1)
68 DO 400 K = 2, KMAX
69 C HYDRO = HYDRO + RGASG*TV(K-1)*LOG(PHALF(K-1)/PHALF(K))
70 HYDRO = HYDRO + TV(K-1)*PHALFL(K-1)
71 GHGT(I,J,K) = GHGT(I,J,K) + HYDRO
72 C WRITE(6,*) ' K,GHGT=',K,GHGT(I,J,K)
73 400 CONTINUE
74 C
75 1000 CONTINUE
76 C
77 RETURN
78 END SUBROUTINE GPLHGT