| 1 |
C $Header: /u/gcmpack/MITgcm/pkg/gridalt/dyn2phys.F,v 1.6 2008/11/18 21:39:38 jmc Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "GRIDALT_OPTIONS.h" |
| 5 |
|
| 6 |
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 |
C grid to the higher resolution physics grid |
| 13 |
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 |
C weights the field either with the profile of the physics grid |
| 17 |
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 |
_RL pphy(im1:im2,jm1:jm2,lmphy) |
| 58 |
_RL dpkedyn, dpkephy, windsum, qd |
| 59 |
integer i,j,L,Lout1,Lout2,Lphy |
| 60 |
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 |
|
| 75 |
C define physics grid mid level pressures |
| 76 |
do Lphy = 1,lmphy |
| 77 |
do j = jdim1,jdim2 |
| 78 |
do i = idim1,idim2 |
| 79 |
pphy(i,j,Lphy) = |
| 80 |
. (pephy(i,j,Lphy,bi,bj)+pephy(i,j,Lphy+1,bi,bj))/2. |
| 81 |
enddo |
| 82 |
enddo |
| 83 |
enddo |
| 84 |
|
| 85 |
c do loop for all dynamics (input) levels |
| 86 |
do L = 1,lmdyn |
| 87 |
c do loop for all grid points |
| 88 |
do j = jdim1,jdim2 |
| 89 |
do i = idim1,idim2 |
| 90 |
qd = qdyn(i,j,L,bi,bj) |
| 91 |
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 |
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 |
if(flg.eq.1)then |
| 104 |
windsum = 0. |
| 105 |
do Lphy = Lout1+1,Lout2 |
| 106 |
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 |
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 |
if( (flg.eq.2) .and. (pedyn(i,j,L,bi,bj).lt.10000.)) then |
| 118 |
weights(i,j,Lphy) = |
| 119 |
. (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 |
endif |
| 123 |
qphy(i,j,Lphy,bi,bj) = qd * weights(i,j,Lphy) |
| 124 |
enddo |
| 125 |
endif |
| 126 |
enddo |
| 127 |
enddo |
| 128 |
enddo |
| 129 |
|
| 130 |
return |
| 131 |
end |
Parent Directory
| 
Revision Log
| 
Revision Graph