| 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 |
Parent Directory
| 
Revision Log
| 
Revision Graph