1 |
molod |
1.1 |
subroutine plume2dyn(qplume,idimin,jdimin,Lmplume, |
2 |
|
|
. idim1,idim2,jdim1,jdim2,Lmout,Nsx,Nsy,bi,bj,qdyn) |
3 |
|
|
C*********************************************************************** |
4 |
|
|
C Purpose: |
5 |
|
|
C To interpolate an arbitrary quantity from higher resolution plumes |
6 |
|
|
C grid to the model's dynamics grid |
7 |
|
|
C Algorithm: |
8 |
|
|
C Plumes -> Dynamics computes the plumes are mean value |
9 |
|
|
C |
10 |
|
|
C Input: |
11 |
|
|
C qplume... [im,jm,Lmplume] Arbitrary Quantity on Input Grid |
12 |
|
|
C pephy.... [im,jm,Lmplume+1] Pressures at bottom edges of input levels |
13 |
|
|
C idimin... Longitude Dimension of Input |
14 |
|
|
C jdimin... Latitude Dimension of Input |
15 |
|
|
C Lmplume.. Vertical Dimension of Input |
16 |
|
|
C Nsx...... Number of processes in x-direction |
17 |
|
|
C Nsy...... Number of processes in y-direction |
18 |
|
|
C idim1,2.. Beginning and ending i-values to calculate |
19 |
|
|
C jdim1,2.. Beginning and ending j-values to calculate |
20 |
|
|
C bi....... Index of process number in x-direction |
21 |
|
|
C bj....... Index of process number in x-direction |
22 |
|
|
C pedyn.... [im,jm,Lmout+1] Pressures at bottom edges of output levels |
23 |
|
|
C Lmout.... Vertical Dimension of Output |
24 |
|
|
C nlperdyn. Mapping Array-Highest Physics level in each dynmics level |
25 |
|
|
C |
26 |
|
|
C Output: |
27 |
|
|
C qdyn..... [im,jm,Lmout] Quantity at output grid (physics grid) |
28 |
|
|
C |
29 |
|
|
C Notes: |
30 |
|
|
C 1) This algorithm assumes that the output (physics) grid levels |
31 |
|
|
C fit exactly into the input (dynamics) grid levels |
32 |
|
|
C*********************************************************************** |
33 |
|
|
implicit none |
34 |
|
|
#include "CPP_OPTIONS.h" |
35 |
|
|
|
36 |
|
|
integer idimin, jdimin, Lmout, Lmplume, Nsx, Nsy |
37 |
|
|
integer idim1, idim2, jdim1, jdim2, bi, bj |
38 |
|
|
_RL qplume(idimin,jdimin,Lmplume,Nsx,Nsy) |
39 |
|
|
_RL pedyn(idimin,jdimin,Lmout+1,Nsx,Nsy) |
40 |
|
|
_RL pephy(idimin,jdimin,Lmplume+1,Nsx,Nsy) |
41 |
|
|
integer nlperdyn(idimin,jdimin,Lmout,Nsx,Nsy) |
42 |
|
|
_RL qdyn(idimin,jdimin,Lmout,Nsx,Nsy) |
43 |
|
|
integer Lbot(idimin,jdimin,Nsx,Nsy) |
44 |
|
|
|
45 |
|
|
integer i,j,L,Lout1,Lout1p1,Lout2,Lphy |
46 |
|
|
_RL getcon, kappa, dpkephy, dpkedyn, sum |
47 |
|
|
|
48 |
|
|
kappa = getcon('KAPPA') |
49 |
|
|
|
50 |
|
|
c do loop for all dynamics (output) levels |
51 |
|
|
do L = 1,Lmout |
52 |
|
|
c do loop for all grid points |
53 |
|
|
do j = jdim1,jdim2 |
54 |
|
|
do i = idim1,idim2 |
55 |
|
|
qdyn(i,j,L,bi,bj) = 0. |
56 |
|
|
c Check to make sure we are above ground - otherwise do nothing |
57 |
|
|
if(L.ge.Lbot(i,j,bi,bj))then |
58 |
|
|
if(L.eq.Lbot(i,j,bi,bj)) then |
59 |
|
|
Lout1 = 0 |
60 |
|
|
else |
61 |
|
|
Lout1 = nlperdyn(i,j,L-1,bi,bj) |
62 |
|
|
endif |
63 |
|
|
Lout2 = nlperdyn(i,j,L,bi,bj) |
64 |
|
|
c do loop for all physics levels contained in this dynamics level |
65 |
|
|
cinterp1 dpkedyn = (pedyn(i,j,L,bi,bj)**kappa)- |
66 |
|
|
cinterp1 (pedyn(i,j,L+1,bi,bj)**kappa) |
67 |
|
|
dpkedyn = pedyn(i,j,L,bi,bj)-pedyn(i,j,L+1,bi,bj) |
68 |
|
|
sum = 0. |
69 |
|
|
Lout1p1 = Lout1+1 |
70 |
|
|
do Lphy = Lout1p1,Lout2 |
71 |
|
|
cinterp1 dpkephy = (pephy(i,j,Lphy,bi,bj)**kappa)- |
72 |
|
|
cinterp1 (pephy(i,j,Lphy+1,bi,bj)**kappa) |
73 |
|
|
dpkephy = pephy(i,j,Lphy,bi,bj)-pephy(i,j,Lphy+1,bi,bj) |
74 |
|
|
sum=sum+qplume(i,j,Lphy,bi,bj)*(dpkephy/dpkedyn) |
75 |
|
|
enddo |
76 |
|
|
qdyn(i,j,L,bi,bj) = sum |
77 |
|
|
endif |
78 |
|
|
enddo |
79 |
|
|
enddo |
80 |
|
|
enddo |
81 |
|
|
|
82 |
|
|
return |
83 |
|
|
end |