/[MITgcm]/MITgcm/pkg/gridalt/dyn2phys.F
ViewVC logotype

Contents of /MITgcm/pkg/gridalt/dyn2phys.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Tue Mar 30 23:44:43 2004 UTC (20 years, 2 months ago) by molod
Branch: MAIN
CVS Tags: checkpoint52m_post
Changes since 1.2: +7 -6 lines
Speed up vertical interpolation - use cache better

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

  ViewVC Help
Powered by ViewVC 1.1.22