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