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