| 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 |
c |
| 62 |
do L = 1,Nr |
| 63 |
do j = j1,j2 |
| 64 |
do i = i1,i2+1 |
| 65 |
nlperdyn(i,j,L,bi,bj) = 0 |
| 66 |
enddo |
| 67 |
enddo |
| 68 |
enddo |
| 69 |
c |
| 70 |
c Figure out how many physics levels there will be |
| 71 |
c (need 12 between sfc and 300 mb above it - see how many |
| 72 |
c there are in the dynamics if the surface pressure is at |
| 73 |
c the sum of drF, ie, the maximum dynamics grid layers possible) |
| 74 |
nlevs = 0 |
| 75 |
dpstar_accum = 0. |
| 76 |
do L = 1,Nr |
| 77 |
dpstar_accum = dpstar_accum + drF(L) |
| 78 |
if(dpstar_accum.le.30000.) nlevs = nlevs+1 |
| 79 |
enddo |
| 80 |
numlevphys = Nr - nlevs + ntry + 1 |
| 81 |
c |
| 82 |
dptry_accum(1) = dptry(1) |
| 83 |
do Lnew = 2,ntry |
| 84 |
dptry_accum(Lnew) = dptry_accum(Lnew-1) + dptry(Lnew) |
| 85 |
enddo |
| 86 |
c |
| 87 |
c do for each grid point: |
| 88 |
do j = j1,j2 |
| 89 |
do i = i1,i2+1 |
| 90 |
Lbotij = Lbot(i,j,bi,bj) |
| 91 |
c |
| 92 |
c Find the maximum number of physics levels to fit in the bottom level |
| 93 |
c |
| 94 |
nlbotmax = 0 |
| 95 |
do Lnew = 1,ntry |
| 96 |
if ( (nlbotmax.eq.0) .and. |
| 97 |
. (dptry_accum(Lnew).gt.(hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij))))then |
| 98 |
nlbotmax = Lnew |
| 99 |
endif |
| 100 |
enddo |
| 101 |
if(nlbotmax.eq.0)then |
| 102 |
nlbotmax = ntry |
| 103 |
endif |
| 104 |
c |
| 105 |
c See how many of the physics levs can fit in the bottom level |
| 106 |
c |
| 107 |
nlphys = 0 |
| 108 |
deltap = 0. |
| 109 |
do Lnew = 1,nlbotmax |
| 110 |
c Test to see if the next physics level fits, if yes, add it |
| 111 |
if((hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)).ge. |
| 112 |
. deltap+dptry(Lnew))then |
| 113 |
nlphys = nlphys + 1 |
| 114 |
dpphys(i,j,nlphys,bi,bj) = dptry(Lnew) |
| 115 |
deltap = deltap + dptry(Lnew) |
| 116 |
else |
| 117 |
c If the level does not fit, decide whether to make a new thinner |
| 118 |
c one or make the one below a bit thicker |
| 119 |
if((dptry(Lnew-1)+(hfacC(i,j,Lbotij,bi,bj)* |
| 120 |
. drF(Lbotij)-deltap)) .gt. (dptry(Lnew-1)*1.5) ) then |
| 121 |
c Add a new thin layer |
| 122 |
nlphys = nlphys + 1 |
| 123 |
dpphys(i,j,nlphys,bi,bj) = |
| 124 |
. (hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij))-deltap |
| 125 |
else |
| 126 |
c Make the one below thicker |
| 127 |
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj) + |
| 128 |
. (hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)-deltap) |
| 129 |
endif |
| 130 |
deltap = deltap+(hfacC(i,j,Lbotij,bi,bj)*drF(Lbotij)-deltap) |
| 131 |
endif |
| 132 |
enddo |
| 133 |
c |
| 134 |
nlperdyn(i,j,Lbotij,bi,bj) = nlphys |
| 135 |
c |
| 136 |
c Now proceed upwards - see how many physics levels fit in each |
| 137 |
c subsequent dynamics level - go through all 12 required levels |
| 138 |
c |
| 139 |
do L = Lbotij+1,Nr |
| 140 |
ndone = 0 |
| 141 |
if(nlphys.lt.ntry)then |
| 142 |
deltap = 0. |
| 143 |
nstart = nlphys + 1 |
| 144 |
do Lnew = nstart,ntry |
| 145 |
if((hfacC(i,j,L,bi,bj)*drF(L)).ge.deltap+dptry(Lnew))then |
| 146 |
nlphys = nlphys + 1 |
| 147 |
dpphys(i,j,nlphys,bi,bj) = dptry(Lnew) |
| 148 |
deltap = deltap + dptry(Lnew) |
| 149 |
ndone = 0 |
| 150 |
elseif (ndone.eq.0) then |
| 151 |
c If the level does not fit, decide whether to make a new thinner |
| 152 |
c one or make the one below a bit thicker |
| 153 |
ndone = 1 |
| 154 |
if( (dptry(Lnew-1)+(hfacC(i,j,L,bi,bj)*drF(L)-deltap)) |
| 155 |
. .gt. (dptry(Lnew-1)*1.5) ) then |
| 156 |
c Add a new thin layer |
| 157 |
nlphys = nlphys + 1 |
| 158 |
dpphys(i,j,nlphys,bi,bj) = |
| 159 |
. (hfacC(i,j,L,bi,bj)*drF(L))-deltap |
| 160 |
deltap = hfacC(i,j,L,bi,bj)*drF(L) |
| 161 |
else |
| 162 |
c Make the one below thicker |
| 163 |
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj) + |
| 164 |
. (hfacC(i,j,L,bi,bj)*drF(L)-deltap) |
| 165 |
deltap = hfacC(i,j,L,bi,bj)*drF(L) |
| 166 |
endif |
| 167 |
endif |
| 168 |
enddo |
| 169 |
elseif(nlphys.eq.ntry)then |
| 170 |
c Mostly done with new layers - make sure we end at dynamics edge, |
| 171 |
c if not, make one more thinner (thinner than dyn grid) layer |
| 172 |
if(abs(deltap-hfacC(i,j,L-1,bi,bj)*drF(L-1)).gt.0.001)then |
| 173 |
nlphys = nlphys + 1 |
| 174 |
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L-1,bi,bj)*drF(L-1) |
| 175 |
. - deltap |
| 176 |
nlphys = nlphys + 1 |
| 177 |
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 178 |
else |
| 179 |
nlphys = nlphys + 1 |
| 180 |
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 181 |
endif |
| 182 |
else |
| 183 |
c we are done adding new physics layers, just copy the rest |
| 184 |
c of the dynamics grid onto the physics grid |
| 185 |
nlphys = nlphys + 1 |
| 186 |
dpphys(i,j,nlphys,bi,bj) = hfacC(i,j,L,bi,bj)*drF(L) |
| 187 |
endif |
| 188 |
nlperdyn(i,j,L,bi,bj) = nlphys |
| 189 |
enddo |
| 190 |
c |
| 191 |
c All done adding layers - if we need more to make numlevphys, put |
| 192 |
c them as thin (1 mb) layers near the top |
| 193 |
if(nlphys.lt.numlevphys)then |
| 194 |
nlevs = numlevphys-nlphys |
| 195 |
dpphys(i,j,nlphys,bi,bj) = dpphys(i,j,nlphys,bi,bj)-100. * nlevs |
| 196 |
do Lnew = nlphys+1,numlevphys |
| 197 |
dpphys(i,j,Lnew,bi,bj) = 100. |
| 198 |
enddo |
| 199 |
nlperdyn(i,j,Nr,bi,bj) = numlevphys |
| 200 |
endif |
| 201 |
c END OF LOOP OVER GRID POINTS |
| 202 |
enddo |
| 203 |
enddo |
| 204 |
|
| 205 |
return |
| 206 |
end |
Parent Directory
| 
Revision Log
| 
Revision Graph