Changeset 3c1da52 in flexpart.git for src/interpol_rain_nests.f90
- Timestamp:
- Jul 15, 2015, 9:45:31 AM (9 years ago)
- Branches:
- svn-petra
- Children:
- c07b09e
- Parents:
- 31674b5
- git-author:
- Ignacio Pisso <Ignacio.Pisso@…> (07/15/15 09:23:56)
- git-committer:
- Ignacio Pisso <Ignacio.Pisso@…> (07/15/15 09:45:31)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
src/interpol_rain_nests.f90
re200b7a r3c1da52 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 21 21 22 22 subroutine interpol_rain_nests(yy1,yy2,yy3,nxmaxn,nymaxn,nzmax, & 23 maxnests,ngrid,nxn,nyn,memind,xt,yt,level,itime1,itime2,itime, & 24 yint1,yint2,yint3) 23 maxnests,ngrid,nxn,nyn, & 24 memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3, & 25 icbot,ictop) 25 26 ! i i i i i i 26 27 ! i i i i i i i i i i i … … 44 45 ! * 45 46 ! 15 March 2000 * 47 ! * 48 !**************************************************************************** 49 ! Petra Seibert, 2011/2012-2015: 50 ! Add interpolation of cloud bottom and cloud thickness 51 ! for fix to SE's new wet scavenging scheme 46 52 ! * 47 53 !**************************************************************************** … … 71 77 !**************************************************************************** 72 78 79 use com_mod, only: icloudbotn, icloudthckn 80 use par_mod, only: icmv 81 73 82 implicit none 74 83 75 84 integer :: maxnests,ngrid 76 integer :: nxn(maxnests),nyn(maxnests),nxmaxn,nymaxn,nzmax,memind(2) 77 integer :: m,ix,jy,ixp,jyp,itime,itime1,itime2,level,indexh 85 integer :: nxn(maxnests),nyn(maxnests),nxmaxn,nymaxn,nzmax,memind(2),m 86 integer :: ix,jy,ixp,jyp 87 integer :: itime,itime1,itime2,level,indexh,ip1,ip2,ip3,ip4 88 integer :: icbot,ictop,icthck,ipsum 78 89 real :: yy1(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests) 79 90 real :: yy2(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests) 80 91 real :: yy3(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests) 81 real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2) 92 real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2),cbot(2),cthck(2) 82 93 real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4 83 84 85 94 86 95 ! If point at border of grid -> small displacement into grid 87 96 !*********************************************************** 88 97 89 if (xt.ge.(real(nxn(ngrid)-1)-0.0001)) & 90 xt=real(nxn(ngrid)-1)-0.0001 91 if (yt.ge.(real(nyn(ngrid)-1)-0.0001)) & 92 yt=real(nyn(ngrid)-1)-0.0001 98 if (xt.ge.(real(nxn(ngrid)-1)-0.0001)) xt=real(nxn(ngrid)-1)-0.0001 99 if (yt.ge.(real(nyn(ngrid)-1)-0.0001)) yt=real(nyn(ngrid)-1)-0.0001 93 100 94 101 … … 119 126 !*********************** 120 127 128 memind_loop: & 121 129 do m=1,2 130 122 131 indexh=memind(m) 123 132 … … 134 143 + p3*yy3(ix ,jyp,level,indexh,ngrid) & 135 144 + p4*yy3(ixp,jyp,level,indexh,ngrid) 136 end do 145 146 ! PS clouds: 147 ip1=1 148 ip2=1 149 ip3=1 150 ip4=1 151 if (icloudbotn(ix ,jy ,indexh,ngrid) .eq. icmv) ip1=0 152 if (icloudbotn(ixp,jy ,indexh,ngrid) .eq. icmv) ip2=0 153 if (icloudbotn(ix ,jyp,indexh,ngrid) .eq. icmv) ip3=0 154 if (icloudbotn(ixp,jyp,indexh,ngrid) .eq. icmv) ip4=0 155 ipsum = ip1+ip2+ip3+ip4 156 if (ipsum .eq. 0) then 157 cbot(m)=icmv 158 else 159 cbot(m)=(ip1*p1*icloudbotn(ix ,jy ,indexh,ngrid) & 160 + ip2*p2*icloudbotn(ixp,jy ,indexh,ngrid) & 161 + ip3*p3*icloudbotn(ix ,jyp,indexh,ngrid) & 162 + ip4*p4*icloudbotn(ixp,jyp,indexh,ngrid)) / ipsum 163 endif 164 165 ip1=1 166 ip2=1 167 ip3=1 168 ip4=1 169 if (icloudthckn(ix ,jy ,indexh,ngrid) .eq. icmv) ip1=0 170 if (icloudthckn(ixp,jy ,indexh,ngrid) .eq. icmv) ip2=0 171 if (icloudthckn(ix ,jyp,indexh,ngrid) .eq. icmv) ip3=0 172 if (icloudthckn(ixp,jyp,indexh,ngrid) .eq. icmv) ip4=0 173 ipsum = ip1+ip2+ip3+ip4 174 if (ipsum .eq. 0) then 175 cthck(m)=icmv 176 else 177 cthck(m)=(ip1*p1*icloudthckn(ix ,jy ,indexh,ngrid) & 178 + ip2*p2*icloudthckn(ixp,jy ,indexh,ngrid) & 179 + ip3*p3*icloudthckn(ix ,jyp,indexh,ngrid) & 180 + ip4*p4*icloudthckn(ixp,jyp,indexh,ngrid)) / ipsum 181 endif 182 ! PS end clouds 183 184 enddo memind_loop 137 185 138 186 … … 150 198 151 199 200 ! PS clouds: 201 icbot = nint( (cbot(1)*dt2 + cbot(2)*dt1)/dt ) 202 if (nint(cbot(1)) .eq. icmv) icbot=cbot(2) 203 if (nint(cbot(2)) .eq. icmv) icbot=cbot(1) 204 205 icthck = nint( (cthck(1)*dt2 + cthck(2)*dt1)/dt ) 206 if (nint(cthck(1)) .eq. icmv) icthck=cthck(2) 207 if (nint(cthck(2)) .eq. icmv) icthck=cthck(1) 208 209 if (icbot .ne. icmv .and. icthck .ne. icmv) then 210 ictop = icbot + icthck ! convert cloud thickness to cloud top 211 else 212 icbot=icmv 213 ictop=icmv 214 endif 215 ! PS end clouds 216 217 152 218 end subroutine interpol_rain_nests
Note: See TracChangeset
for help on using the changeset viewer.