Ignore:
Timestamp:
Dec 23, 2013, 6:23:38 PM (9 years ago)
Author:
igpis
Message:

move version 9.1.8 form branches to trunk. Contributions from HSO, saeck, pesei, NIK, RT, XKF, IP and others

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/src/interpol_rain.f90

    r4 r20  
    2020!**********************************************************************
    2121
    22 subroutine interpol_rain(yy1,yy2,yy3,nxmax,nymax,nzmax,nx, &
    23        ny,memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3)
    24   !                          i   i   i    i    i     i   i
    25   !i    i    i  i    i     i      i      i     o     o     o
     22!subroutine interpol_rain(yy1,yy2,yy3,nxmax,nymax,nzmax,nx, &
     23!       ny,memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3)
     24!  !                          i   i   i    i    i     i   i
     25!  !i    i    i  i    i     i      i      i     o     o     o
     26
     27      subroutine interpol_rain(yy1,yy2,yy3,iy1,iy2,nxmax,nymax,nzmax,nx, &
     28     ny,memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3, &
     29     intiy1,intiy2,icmv)
     30!                               i   i   i    i    i     i   i
     31!     i    i    i  i    i     i      i      i     o     o     o
     32
    2633  !****************************************************************************
    2734  !                                                                           *
     
    4047  !                                                                           *
    4148  !     30 August 1996                                                        *
    42   !                                                                           *
     49  !
     50  !*  Petra Seibert, 2011/2012:
     51  !*  Add interpolation of cloud bottom and cloud thickness
     52  !*  for fix to SE's new wet scavenging scheme  *
    4353  !****************************************************************************
    4454  !                                                                           *
     
    7080
    7181  integer :: nx,ny,nxmax,nymax,nzmax,memind(2),m,ix,jy,ixp,jyp
    72   integer :: itime,itime1,itime2,level,indexh
     82  !integer :: itime,itime1,itime2,level,indexh
     83  integer :: itime,itime1,itime2,level,indexh,ip1,ip2,ip3,ip4
     84  integer :: intiy1,intiy2,ipsum,icmv 
    7385  real :: yy1(0:nxmax-1,0:nymax-1,nzmax,2)
    7486  real :: yy2(0:nxmax-1,0:nymax-1,nzmax,2)
    7587  real :: yy3(0:nxmax-1,0:nymax-1,nzmax,2)
    76   real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2)
    77   real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4
     88  integer iy1(0:nxmax-1,0:nymax-1,2),iy2(0:nxmax-1,0:nymax-1,2)
     89  real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2),yi1(2),yi2(2)
     90  !real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2)
     91  real :: xt,yt,yint1,yint2,yint3,yint4,p1,p2,p3,p4 
     92  !real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4
    7893
    7994
     
    127142         + p3*yy3(ix ,jyp,level,indexh) &
    128143         + p4*yy3(ixp,jyp,level,indexh)
     144
     145!CPS clouds:
     146        ip1=1
     147        ip2=1
     148        ip3=1
     149        ip4=1
     150        if (iy1(ix ,jy ,indexh) .eq. icmv) ip1=0
     151        if (iy1(ixp,jy ,indexh) .eq. icmv) ip2=0
     152        if (iy1(ix ,jyp,indexh) .eq. icmv) ip3=0
     153        if (iy1(ixp,jyp,indexh) .eq. icmv) ip4=0
     154        ipsum= ip1+ip2+ip3+ip4
     155        if (ipsum .eq. 0) then
     156          yi1(m)=icmv
     157        else
     158          yi1(m)=(ip1*p1*iy1(ix ,jy ,indexh)    &
     159             + ip2*p2*iy1(ixp,jy ,indexh)       &
     160             + ip3*p3*iy1(ix ,jyp,indexh)       &
     161             + ip4*p4*iy1(ixp,jyp,indexh))/ipsum
     162        endif
     163       
     164        ip1=1
     165        ip2=1
     166        ip3=1
     167        ip4=1
     168        if (iy2(ix ,jy ,indexh) .eq. icmv) ip1=0
     169        if (iy2(ixp,jy ,indexh) .eq. icmv) ip2=0
     170        if (iy2(ix ,jyp,indexh) .eq. icmv) ip3=0
     171        if (iy2(ixp,jyp,indexh) .eq. icmv) ip4=0
     172        ipsum= ip1+ip2+ip3+ip4
     173        if (ipsum .eq. 0) then
     174          yi2(m)=icmv
     175        else
     176          yi2(m)=(ip1*p1*iy2(ix ,jy ,indexh)  &
     177             + ip2*p2*iy2(ixp,jy ,indexh)     &
     178             + ip3*p3*iy2(ix ,jyp,indexh)     &
     179             + ip4*p4*iy2(ixp,jyp,indexh))/ipsum
     180        endif
     181!CPS end clouds
     182
    129183  end do
    130184
     
    134188  !************************************
    135189
     190      if (abs(itime) .lt. abs(itime1)) then
     191        print*,'interpol_rain.f90'
     192        print*,itime,itime1,itime2
     193        stop 'ITIME PROBLEM'
     194      endif
     195
     196
    136197  dt1=real(itime-itime1)
    137198  dt2=real(itime2-itime)
     
    143204
    144205
     206!PS clouds:
     207      intiy1=(yi1(1)*dt2 + yi1(2)*dt1)/dt
     208      if (yi1(1) .eq. float(icmv)) intiy1=yi1(2)
     209      if (yi1(2) .eq. float(icmv)) intiy1=yi1(1)
     210
     211      intiy2=(yi2(1)*dt2 + yi2(2)*dt1)/dt
     212      if (yi2(1) .eq. float(icmv)) intiy2=yi2(2) 
     213      if (yi2(2) .eq. float(icmv)) intiy2=yi2(1)
     214     
     215      if (intiy1 .ne. icmv .and. intiy2 .ne. icmv) then
     216        intiy2 = intiy1 + intiy2 ! convert cloud thickness to cloud top
     217      else
     218        intiy1=icmv
     219        intiy2=icmv
     220      endif
     221!PS end clouds
     222
    145223end subroutine interpol_rain
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG