1 |
jmc |
1.7 |
C $Header: /u/gcmpack/MITgcm/pkg/gridalt/dyn2phys.F,v 1.6 2008/11/18 21:39:38 jmc Exp $ |
2 |
edhill |
1.4 |
C $Name: $ |
3 |
|
|
|
4 |
jmc |
1.7 |
#include "GRIDALT_OPTIONS.h" |
5 |
|
|
|
6 |
molod |
1.1 |
subroutine dyn2phys(qdyn,pedyn,im1,im2,jm1,jm2,lmdyn,Nsx,Nsy, |
7 |
|
|
. idim1,idim2,jdim1,jdim2,bi,bj,windphy,pephy,Lbot,lmphy,nlperdyn, |
8 |
|
|
. flg,qphy) |
9 |
|
|
C*********************************************************************** |
10 |
|
|
C Purpose: |
11 |
|
|
C To interpolate an arbitrary quantity from the 'dynamics' eta (pstar) |
12 |
jmc |
1.7 |
C grid to the higher resolution physics grid |
13 |
molod |
1.1 |
C Algorithm: |
14 |
|
|
C Routine works one layer (edge to edge pressure) at a time. |
15 |
|
|
C Dynamics -> Physics retains the dynamics layer mean value, |
16 |
jmc |
1.7 |
C weights the field either with the profile of the physics grid |
17 |
molod |
1.1 |
C wind speed (for U and V fields), or uniformly (T and Q) |
18 |
|
|
C |
19 |
|
|
C Input: |
20 |
|
|
C qdyn..... [im,jm,lmdyn] Arbitrary Quantity on Input Grid |
21 |
|
|
C pedyn.... [im,jm,lmdyn+1] Pressures at bottom edges of input levels |
22 |
|
|
C im1,2 ... Limits for Longitude Dimension of Input |
23 |
|
|
C jm1,2 ... Limits for Latitude Dimension of Input |
24 |
|
|
C lmdyn.... Vertical Dimension of Input |
25 |
|
|
C Nsx...... Number of processes in x-direction |
26 |
|
|
C Nsy...... Number of processes in y-direction |
27 |
|
|
C idim1,2.. Beginning and ending i-values to calculate |
28 |
|
|
C jdim1,2.. Beginning and ending j-values to calculate |
29 |
|
|
C bi....... Index of process number in x-direction |
30 |
|
|
C bj....... Index of process number in x-direction |
31 |
|
|
C windphy.. [im,jm,lmphy] Magnitude of the wind on the output levels |
32 |
|
|
C pephy.... [im,jm,lmphy+1] Pressures at bottom edges of output levels |
33 |
|
|
C lmphy.... Vertical Dimension of Output |
34 |
|
|
C nlperdyn. [im,jm,lmdyn] Highest Physics level in each dynamics level |
35 |
|
|
C flg...... Flag to indicate field type (0 for T or Q, 1 for U or V) |
36 |
|
|
C |
37 |
|
|
C Output: |
38 |
|
|
C qphy..... [im,jm,lmphy] Quantity at output grid (physics grid) |
39 |
|
|
C |
40 |
|
|
C Notes: |
41 |
|
|
C 1) This algorithm assumes that the output (physics) grid levels |
42 |
|
|
C fit exactly into the input (dynamics) grid levels |
43 |
|
|
C*********************************************************************** |
44 |
|
|
implicit none |
45 |
|
|
|
46 |
|
|
integer im1, im2, jm1, jm2, lmdyn, lmphy, Nsx, Nsy, flg |
47 |
|
|
integer idim1, idim2, jdim1, jdim2, bi, bj |
48 |
|
|
_RL qdyn(im1:im2,jm1:jm2,lmdyn,Nsx,Nsy) |
49 |
|
|
_RL pedyn(im1:im2,jm1:jm2,lmdyn+1,Nsx,Nsy) |
50 |
|
|
_RL pephy(im1:im2,jm1:jm2,lmphy+1,Nsx,Nsy) |
51 |
|
|
_RL windphy(im1:im2,jm1:jm2,lmphy,Nsx,Nsy) |
52 |
|
|
integer nlperdyn(im1:im2,jm1:jm2,lmdyn,Nsx,Nsy) |
53 |
|
|
_RL qphy(im1:im2,jm1:jm2,lmphy,Nsx,Nsy) |
54 |
|
|
integer Lbot(im1:im2,jm1:jm2,Nsx,Nsy) |
55 |
|
|
|
56 |
|
|
_RL weights(im1:im2,jm1:jm2,lmphy) |
57 |
molod |
1.5 |
_RL pphy(im1:im2,jm1:jm2,lmphy) |
58 |
molod |
1.3 |
_RL dpkedyn, dpkephy, windsum, qd |
59 |
molod |
1.1 |
integer i,j,L,Lout1,Lout2,Lphy |
60 |
jmc |
1.6 |
cinterp1 _RL kappa |
61 |
|
|
#ifdef ALLOW_FIZHI |
62 |
|
|
cinterp1 _RL getcon |
63 |
|
|
#else |
64 |
|
|
cinterp1 #include 'SIZE.h' |
65 |
|
|
cinterp1 #include 'EEPARAMS.h' |
66 |
|
|
cinterp1 #include 'PARAMS.h' |
67 |
|
|
#endif |
68 |
|
|
|
69 |
|
|
#ifdef ALLOW_FIZHI |
70 |
|
|
cinterp1 kappa = getcon('KAPPA') |
71 |
|
|
#else |
72 |
|
|
cinterp1 kappa = atm_kappa |
73 |
|
|
#endif |
74 |
molod |
1.1 |
|
75 |
molod |
1.5 |
C define physics grid mid level pressures |
76 |
|
|
do Lphy = 1,lmphy |
77 |
|
|
do j = jdim1,jdim2 |
78 |
|
|
do i = idim1,idim2 |
79 |
jmc |
1.7 |
pphy(i,j,Lphy) = |
80 |
molod |
1.5 |
. (pephy(i,j,Lphy,bi,bj)+pephy(i,j,Lphy+1,bi,bj))/2. |
81 |
|
|
enddo |
82 |
|
|
enddo |
83 |
|
|
enddo |
84 |
|
|
|
85 |
molod |
1.3 |
c do loop for all dynamics (input) levels |
86 |
|
|
do L = 1,lmdyn |
87 |
molod |
1.1 |
c do loop for all grid points |
88 |
molod |
1.3 |
do j = jdim1,jdim2 |
89 |
|
|
do i = idim1,idim2 |
90 |
|
|
qd = qdyn(i,j,L,bi,bj) |
91 |
molod |
1.1 |
c Check to make sure we are above ground - if not, do nothing |
92 |
|
|
if(L.ge.Lbot(i,j,bi,bj))then |
93 |
|
|
if(L.eq.Lbot(i,j,bi,bj)) then |
94 |
|
|
Lout1 = 0 |
95 |
|
|
else |
96 |
|
|
Lout1 = nlperdyn(i,j,L-1,bi,bj) |
97 |
|
|
endif |
98 |
|
|
Lout2 = nlperdyn(i,j,L,bi,bj) |
99 |
|
|
c for U and V fields, need to compute for the weights: |
100 |
molod |
1.5 |
cinterp1 dpkedyn = (pedyn(i,j,L,bi,bj)**kappa)- |
101 |
|
|
cinterp1 (pedyn(i,j,L+1,bi,bj)**kappa) |
102 |
|
|
dpkedyn = pedyn(i,j,L,bi,bj)-pedyn(i,j,L+1,bi,bj) |
103 |
molod |
1.1 |
if(flg.eq.1)then |
104 |
|
|
windsum = 0. |
105 |
|
|
do Lphy = Lout1+1,Lout2 |
106 |
molod |
1.2 |
cinterp1 dpkephy = (pephy(i,j,Lphy,bi,bj)**kappa)- |
107 |
|
|
cinterp1 (pephy(i,j,Lphy+1,bi,bj)**kappa) |
108 |
|
|
dpkephy = pephy(i,j,Lphy,bi,bj)-pephy(i,j,Lphy+1,bi,bj) |
109 |
molod |
1.1 |
windsum = windsum+(windphy(i,j,Lphy,bi,bj)*dpkephy)/dpkedyn |
110 |
|
|
enddo |
111 |
|
|
endif |
112 |
|
|
c do loop for all physics levels contained in this dynamics level |
113 |
|
|
do Lphy = Lout1+1,Lout2 |
114 |
|
|
weights(i,j,Lphy) = 1. |
115 |
|
|
if( (flg.eq.1).and.(windsum.ne.0.) ) |
116 |
|
|
. weights(i,j,Lphy)=windphy(i,j,Lphy,bi,bj)/windsum |
117 |
molod |
1.5 |
if( (flg.eq.2) .and. (pedyn(i,j,L,bi,bj).lt.10000.)) then |
118 |
jmc |
1.7 |
weights(i,j,Lphy) = |
119 |
molod |
1.5 |
. (qd-5. + (10.*(pedyn(i,j,L,bi,bj)-pphy(i,j,Lphy))/dpkedyn))/qd |
120 |
|
|
elseif( (flg.eq.2) .and. (pedyn(i,j,L,bi,bj).ge.10000.)) then |
121 |
|
|
weights(i,j,Lphy) = 1. |
122 |
jmc |
1.7 |
endif |
123 |
molod |
1.3 |
qphy(i,j,Lphy,bi,bj) = qd * weights(i,j,Lphy) |
124 |
molod |
1.1 |
enddo |
125 |
|
|
endif |
126 |
|
|
enddo |
127 |
|
|
enddo |
128 |
|
|
enddo |
129 |
|
|
|
130 |
|
|
return |
131 |
|
|
end |