| 1 |
molod |
1.1 |
subroutine make_phys_grid(drF,hfacC,im1,im2,jm1,jm2,Nr, |
| 2 |
|
|
. Nsx,Nsy,i1,i2,j1,j2,bi,bj,Nrphys,Lbot,dpphys,numlevphys,nlperdyn) |
| 3 |
|
|
c*********************************************************************** |
| 4 |
|
|
c subroutine make_phys_grid |
| 5 |
|
|
c |
| 6 |
|
|
c Purpose: Define the grid that the will be used to run the high-end |
| 7 |
|
|
c atmospheric physics. |
| 8 |
|
|
c |
| 9 |
|
|
c Algorithm: Fit additional levels of some (~) known thickness in |
| 10 |
|
|
c between existing levels of the grid used for the dynamics |
| 11 |
|
|
c |
| 12 |
|
|
c Need: Information about the dynamics grid vertical spacing |
| 13 |
|
|
c |
| 14 |
|
|
c Input: drF - delta r (p*) edge-to-edge |
| 15 |
|
|
c hfacC - fraction of grid box above topography |
| 16 |
|
|
c im1, im2 - beginning and ending i - dimensions |
| 17 |
|
|
c jm1, jm2 - beginning and ending j - dimensions |
| 18 |
|
|
c Nr - number of levels in dynamics grid |
| 19 |
|
|
c Nsx,Nsy - number of processes in x and y direction |
| 20 |
|
|
c i1, i2 - beginning and ending i - index to fill |
| 21 |
|
|
c j1, j2 - beginning and ending j - index to fill |
| 22 |
|
|
c bi, bj - x-dir and y-dir index of process |
| 23 |
|
|
c Nrphys - number of levels in physics grid |
| 24 |
|
|
c |
| 25 |
|
|
c Output: dpphys - delta r (p*) edge-to-edge of physics grid |
| 26 |
|
|
c numlevphys - number of levels used in the physics |
| 27 |
|
|
c nlperdyn - physics level number atop each dynamics layer |
| 28 |
|
|
c |
| 29 |
|
|
c NOTES: 1) Pressure levs are built up from bottom, using p0, ps and dp: |
| 30 |
|
|
c p(i,j,k)=p(i,j,k-1) + dp(k)*ps(i,j)/p0(i,j) |
| 31 |
|
|
c 2) Output dp's are aligned to fit EXACTLY between existing |
| 32 |
|
|
c levels of the dynamics vertical grid |
| 33 |
|
|
c 3) IMPORTANT! This routine assumes the levels are numbered |
| 34 |
|
|
c from the bottom up, ie, level 1 is the surface. |
| 35 |
|
|
c IT WILL NOT WORK OTHERWISE!!! |
| 36 |
|
|
c 4) This routine does NOT work for surface pressures less |
| 37 |
|
|
c (ie, above in the atmosphere) than about 350 mb |
| 38 |
|
|
c*********************************************************************** |
| 39 |
|
|
implicit none |
| 40 |
|
|
c |
| 41 |
|
|
#include "CPP_OPTIONS.h" |
| 42 |
|
|
|
| 43 |
|
|
integer im1,im2,jm1,jm2,Nr,Nsx,Nsy,Nrphys |
| 44 |
|
|
integer i1,i2,j1,j2,bi,bj |
| 45 |
|
|
integer numlevphys |
| 46 |
|
|
_RL hfacC(im1:im2,jm1:jm2,Nr,Nsx,Nsy) |
| 47 |
|
|
_RL dpphys(im1:im2,jm1:jm2,Nrphys,Nsx,Nsy) |
| 48 |
|
|
_RL drF(Nr) |
| 49 |
|
|
integer Lbot(im1:im2,jm1:jm2,Nsx,Nsy) |
| 50 |
|
|
integer nlperdyn(im1:im2,jm1:jm2,Nr,Nsx,Nsy) |
| 51 |
|
|
c |
| 52 |
|
|
integer i,j,L,Lbotij,Lnew |
| 53 |
|
|
c Require 12 bottom levels (300 mb worth) for the physics, the dp's are: |
| 54 |
|
|
integer ntry |
| 55 |
|
|
data ntry /12/ |
| 56 |
|
|
_RL dptry(12), dptry_accum(12) |
| 57 |
|
|
data dptry /300.000, 600.000,1000.000,1400.000,1700.000,2500.000, |
| 58 |
|
|
. 2500.000,2500.000,2500.000,5000.000,5000.000,5000.000/ |
| 59 |
|
|
_RL deltap, dpstar_accum |
| 60 |
|
|
integer nlbotmax, nstart, nlevs, nlphys, ndone |
| 61 |
molod |
1.2 |
integer nextra |
| 62 |
|
|
c |
| 63 |
|
|
nextra = ntry |
| 64 |
molod |
1.1 |
c |
| 65 |
|
|
do L = 1,Nr |
| 66 |
|
|
do j = j1,j2 |
| 67 |
|
|
do i = i1,i2+1 |
| 68 |
|
|
nlperdyn(i,j,L,bi,bj) = 0 |
| 69 |
|
|
enddo |
| 70 |
|
|
enddo |
| 71 |
|
|
enddo |
| 72 |
|
|
c |
| 73 |
|
|
c Figure out how many physics levels there will be |
| 74 |
|
|
c (need 12 between sfc and 300 mb above it - see how many |
| 75 |
|
|
c there are in the dynamics if the surface pressure is at |
| 76 |
|
|
c the sum of drF, ie, the maximum dynamics grid layers possible) |
| 77 |
|
|
nlevs = 0 |
| 78 |
|
|
dpstar_accum = 0. |
| 79 |
|
|
do L = 1,Nr |
| 80 |
|
|
dpstar_accum = dpstar_accum + drF(L) |
| 81 |
|
|
if(dpstar_accum.le.30000.) nlevs = nlevs+1 |
| 82 |
|
|
enddo |
| 83 |
|
|
numlevphys = Nr - nlevs + ntry + 1 |
| 84 |
|
|
c |
| 85 |
|
|
dptry_accum(1) = dptry(1) |
| 86 |
|
|
do Lnew = 2,ntry |
| 87 |
|
|
dptry_accum(Lnew) = dptry_accum(Lnew-1) + dptry(Lnew) |
| 88 |
|
|
enddo |
| 89 |
|
|
c |
| 90 |
|
|
c do for each grid point: |
| 91 |
|
|
do j = j1,j2 |
| 92 |
molod |
1.2 |
do i = i1,i2 |
| 93 |
molod |
1.1 |
Lbotij = Lbot(i,j,bi,bj) |
| 94 |
|
|
c |
| 95 |
|
|
c Find the maximum number of physics levels to fit in the bottom level |
| 96 |
|
|
c |
| 97 |
|
|
nlbotmax = 0 |
| 98 |
|
|
do Lnew = 1,ntry |
| 99 |
|
|
if ( (nlbotmax.eq.0) .and. |
| 100 |
|
|
. (dptry_accum(Lnew).gt.(hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij))))then |
| 101 |
|
|
nlbotmax = Lnew |
| 102 |
|
|
endif |
| 103 |
|
|
enddo |
| 104 |
|
|
if(nlbotmax.eq.0)then |
| 105 |
|
|
nlbotmax = ntry |
| 106 |
|
|
endif |
| 107 |
|
|
c |
| 108 |
|
|
c See how many of the physics levs can fit in the bottom level |
| 109 |
|
|
c |
| 110 |
|
|
nlphys = 0 |
| 111 |
|
|
deltap = 0. |
| 112 |
|
|
do Lnew = 1,nlbotmax |
| 113 |
|
|
c Test to see if the next physics level fits, if yes, add it |
| 114 |
|
|
if((hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)).ge. |
| 115 |
|
|
. deltap+dptry(Lnew))then |
| 116 |
|
|
nlphys = nlphys + 1 |
| 117 |
|
|
dpphys(i,j,nlphys,bi,bj) = dptry(Lnew) |
| 118 |
|
|
deltap = deltap + dptry(Lnew) |
| 119 |
|
|
else |
| 120 |
|
|
c If the level does not fit, decide whether to make a new thinner |
| 121 |
|
|
c one or make the one below a bit thicker |
| 122 |
|
|
if((dptry(Lnew-1)+(hfacC(i,j,Lbotij,bi,bj)* |
| 123 |
|
|
. drF(Lbotij)-deltap)) .gt. (dptry(Lnew-1)*1.5) ) then |
| 124 |
|
|
c Add a new thin layer |
| 125 |
|
|
nlphys = nlphys + 1 |
| 126 |
|
|
dpphys(i,j,nlphys,bi,bj) = |
| 127 |
|
|
. (hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij))-deltap |
| 128 |
|
|
else |
| 129 |
|
|
c Make the one below thicker |
| 130 |
|
|
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj) + |
| 131 |
|
|
. (hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)-deltap) |
| 132 |
|
|
endif |
| 133 |
|
|
deltap = deltap+(hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)-deltap) |
| 134 |
|
|
endif |
| 135 |
|
|
enddo |
| 136 |
|
|
c |
| 137 |
|
|
nlperdyn(i,j,Lbotij,bi,bj) = nlphys |
| 138 |
|
|
c |
| 139 |
|
|
c Now proceed upwards - see how many physics levels fit in each |
| 140 |
|
|
c subsequent dynamics level - go through all 12 required levels |
| 141 |
|
|
c |
| 142 |
|
|
do L = Lbotij+1,Nr |
| 143 |
|
|
ndone = 0 |
| 144 |
|
|
if(nlphys.lt.ntry)then |
| 145 |
|
|
deltap = 0. |
| 146 |
|
|
nstart = nlphys + 1 |
| 147 |
|
|
do Lnew = nstart,ntry |
| 148 |
|
|
if((hfacC(i,j,L,bi,bj)*drF(L)).ge.deltap+dptry(Lnew))then |
| 149 |
|
|
nlphys = nlphys + 1 |
| 150 |
|
|
dpphys(i,j,nlphys,bi,bj) = dptry(Lnew) |
| 151 |
|
|
deltap = deltap + dptry(Lnew) |
| 152 |
|
|
ndone = 0 |
| 153 |
|
|
elseif (ndone.eq.0) then |
| 154 |
|
|
c If the level does not fit, decide whether to make a new thinner |
| 155 |
|
|
c one or make the one below a bit thicker |
| 156 |
|
|
ndone = 1 |
| 157 |
|
|
if( (dptry(Lnew-1)+(hfacC(i,j,L,bi,bj)*drF(L)-deltap)) |
| 158 |
|
|
. .gt. (dptry(Lnew-1)*1.5) ) then |
| 159 |
|
|
c Add a new thin layer |
| 160 |
|
|
nlphys = nlphys + 1 |
| 161 |
|
|
dpphys(i,j,nlphys,bi,bj) = |
| 162 |
|
|
. (hfacC(i,j,L,bi,bj)*drF(L))-deltap |
| 163 |
|
|
deltap = hfacC(i,j,L,bi,bj)*drF(L) |
| 164 |
|
|
else |
| 165 |
|
|
c Make the one below thicker |
| 166 |
|
|
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj) + |
| 167 |
|
|
. (hfacC(i,j,L,bi,bj)*drF(L)-deltap) |
| 168 |
|
|
deltap = hfacC(i,j,L,bi,bj)*drF(L) |
| 169 |
|
|
endif |
| 170 |
|
|
endif |
| 171 |
|
|
enddo |
| 172 |
molod |
1.2 |
C Need one more peice of logic - if we finished Lnew loop and |
| 173 |
|
|
C now we are done adding new physics layers, we need to be sure |
| 174 |
|
|
C that we are at the edge of a dynamics layer. if not, we need |
| 175 |
|
|
C to add one more layer. |
| 176 |
|
|
if(nlphys.ge.ntry)then |
| 177 |
|
|
if(abs(deltap-hfacC(i,j,L-1,bi,bj)*drF(L-1)).gt.0.001)then |
| 178 |
|
|
nlphys = nlphys + 1 |
| 179 |
|
|
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L-1,bi,bj)*drF(L-1) |
| 180 |
|
|
. - deltap |
| 181 |
|
|
endif |
| 182 |
|
|
endif |
| 183 |
|
|
|
| 184 |
molod |
1.1 |
elseif(nlphys.eq.ntry)then |
| 185 |
|
|
c Mostly done with new layers - make sure we end at dynamics edge, |
| 186 |
|
|
c if not, make one more thinner (thinner than dyn grid) layer |
| 187 |
|
|
if(abs(deltap-hfacC(i,j,L-1,bi,bj)*drF(L-1)).gt.0.001)then |
| 188 |
|
|
nlphys = nlphys + 1 |
| 189 |
|
|
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L-1,bi,bj)*drF(L-1) |
| 190 |
|
|
. - deltap |
| 191 |
|
|
nlphys = nlphys + 1 |
| 192 |
|
|
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 193 |
|
|
else |
| 194 |
|
|
nlphys = nlphys + 1 |
| 195 |
|
|
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 196 |
|
|
endif |
| 197 |
|
|
else |
| 198 |
|
|
c we are done adding new physics layers, just copy the rest |
| 199 |
|
|
c of the dynamics grid onto the physics grid |
| 200 |
|
|
nlphys = nlphys + 1 |
| 201 |
|
|
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 202 |
|
|
endif |
| 203 |
|
|
nlperdyn(i,j,L,bi,bj) = nlphys |
| 204 |
|
|
enddo |
| 205 |
|
|
c |
| 206 |
|
|
c All done adding layers - if we need more to make numlevphys, put |
| 207 |
|
|
c them as thin (1 mb) layers near the top |
| 208 |
|
|
if(nlphys.lt.numlevphys)then |
| 209 |
|
|
nlevs = numlevphys-nlphys |
| 210 |
|
|
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj)-100. * nlevs |
| 211 |
|
|
do Lnew = nlphys+1,numlevphys |
| 212 |
|
|
dpphys(i,j,Lnew,bi,bj) = 100. |
| 213 |
|
|
enddo |
| 214 |
|
|
nlperdyn(i,j,Nr,bi,bj) = numlevphys |
| 215 |
|
|
endif |
| 216 |
|
|
c END OF LOOP OVER GRID POINTS |
| 217 |
|
|
enddo |
| 218 |
|
|
enddo |
| 219 |
|
|
|
| 220 |
|
|
return |
| 221 |
|
|
end |
Parent Directory
| 
Revision Log
| 
Revision Graph