[16] | 1 | !*********************************************************************** |
---|
| 2 | !* Copyright 2012,2013 * |
---|
| 3 | !* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine, * |
---|
| 4 | !* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,* |
---|
| 5 | !* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso, * |
---|
| 6 | !* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann, * |
---|
| 7 | !* * |
---|
| 8 | !* This file is part of FLEXPART WRF * |
---|
| 9 | !* * |
---|
| 10 | !* FLEXPART is free software: you can redistribute it and/or modify * |
---|
| 11 | !* it under the terms of the GNU General Public License as published by* |
---|
| 12 | !* the Free Software Foundation, either version 3 of the License, or * |
---|
| 13 | !* (at your option) any later version. * |
---|
| 14 | !* * |
---|
| 15 | !* FLEXPART is distributed in the hope that it will be useful, * |
---|
| 16 | !* but WITHOUT ANY WARRANTY; without even the implied warranty of * |
---|
| 17 | !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * |
---|
| 18 | !* GNU General Public License for more details. * |
---|
| 19 | !* * |
---|
| 20 | !* You should have received a copy of the GNU General Public License * |
---|
| 21 | !* along with FLEXPART. If not, see <http://www.gnu.org/licenses/>. * |
---|
| 22 | !*********************************************************************** |
---|
| 23 | |
---|
| 24 | ! 8/30/2007 Created by Weiguo Wang |
---|
| 25 | ! Notes: |
---|
| 26 | ! THIS CODE IS TO prepare meteorology data for REDISTRIBUTing PARTICLES |
---|
| 27 | ! INVOLVED IN UPDRAFT OR/AND DOWDRAFT |
---|
| 28 | ! Estimate fraction of particles that may be well-mixed (for well-mixing option) |
---|
| 29 | |
---|
| 30 | ! prob of particle involving in clouds can be pre-computed here. will optimize code later |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | ! SUBROUTINE NAME: pre_redist_kf |
---|
| 34 | ! INPUT: |
---|
| 35 | ! nuvzmax-- max # of layers of flux |
---|
| 36 | ! nuvz -- # of layer for work array |
---|
| 37 | ! umf -- updraft mass flux (kg/s ?) |
---|
| 38 | ! dmf -- downdraft mass flux |
---|
| 39 | ! dz -- different height between full levels (m) |
---|
| 40 | ! p1d -- press (pa) |
---|
| 41 | ! dx -- horizontal grid size(m) |
---|
| 42 | ! dt -- time step (s) |
---|
| 43 | !C cu_top1 -- cloud top index, zh(cu_top1) |
---|
| 44 | !C cu_bot1 -- cloud bottom index, ,zh(cu_bot1) |
---|
| 45 | ! OUTPUT: |
---|
| 46 | ! zf -- height above ground level at full levels (ddz) |
---|
| 47 | ! zh -- height above ground level at half levels |
---|
| 48 | ! only for option of simple mixing |
---|
| 49 | ! |
---|
| 50 | ! umfzf -- normalized updraft mass flux*distance,min=0,max=1 |
---|
| 51 | ! dmfzf -- normalized downdraft mass flux*distance |
---|
| 52 | ! fmix -- fraction of paricels in cloud levels is mixed |
---|
| 53 | ! CALLED by convmix_kf.f |
---|
| 54 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 55 | |
---|
| 56 | Subroutine pre_redist_kf(nuvzmax,nuvz,umf,dmf,dz,p1d,dx,dt, & ! IN & |
---|
| 57 | cu_bot1,cu_top1, & ! IN |
---|
| 58 | zf,zh, & ! OUT |
---|
| 59 | umfzf,dmfzf,fmix) ! OUT |
---|
| 60 | |
---|
| 61 | IMPLICIT NONE |
---|
| 62 | integer :: nuvzmax,nuvz,ldirection,n1,i,j,k |
---|
| 63 | real :: cu_bot1,cu_top1,dx,dt |
---|
| 64 | real,dimension(nuvzmax) :: umf,dmf,dz,umfdz,dmfdz,zh, & |
---|
| 65 | p1d |
---|
| 66 | |
---|
| 67 | real,dimension(nuvzmax+1) :: dmfzf,umfzf,zf |
---|
| 68 | real :: t1,t2,fmix,mass |
---|
| 69 | |
---|
| 70 | ! Compute flux height, here height is above the ground level |
---|
| 71 | |
---|
| 72 | zf(1)=0.0 ! ground level |
---|
| 73 | do i=2,nuvz+1 |
---|
| 74 | zf(i) = zf(i-1) + dz(i) |
---|
| 75 | zh(i-1) = 0.5*( zf(i-1) + zf(i) ) |
---|
| 76 | enddo |
---|
| 77 | |
---|
| 78 | !! cululative dz in cloud level, for reposition option 'well-mixed' |
---|
| 79 | do i=1,nuvz |
---|
| 80 | umfdz(i) = 0.0 |
---|
| 81 | dmfdz(i) = 0.0 |
---|
| 82 | if(umf(i).ne.0.0 .and. i.le.int(cu_top1) & |
---|
| 83 | .and.i.ge.int(cu_bot1)) umfdz(i)=dz(i) ! mixed within cloud |
---|
| 84 | ! if(umf(i).ne.0.0 .and. i.le.int(cu_top1) ! mixed between ground and cloud top |
---|
| 85 | ! & ) umfdz(i)=dz(i) |
---|
| 86 | |
---|
| 87 | if(dmf(i).ne.0.0) dmfdz(i)=dz(i) |
---|
| 88 | enddo |
---|
| 89 | ! assume zero umf or dmf means no-cloud area |
---|
| 90 | ! Nomalize non-zero values (cloud up/downdraft) |
---|
| 91 | t1 = 0.0 |
---|
| 92 | t2 = 0.0 |
---|
| 93 | do i=1,nuvz |
---|
| 94 | t1=t1+umfdz(i) |
---|
| 95 | t2=t2+dmfdz(i) |
---|
| 96 | enddo |
---|
| 97 | |
---|
| 98 | if (t1 .gt. 0.0) then |
---|
| 99 | do i=1,nuvz |
---|
| 100 | umfdz(i)=umfdz(i)/t1 |
---|
| 101 | enddo |
---|
| 102 | endif |
---|
| 103 | if (t2 .gt. 0.0) then |
---|
| 104 | DO i=1,nuvz |
---|
| 105 | dmfdz(i)=dmfdz(i)/t2 |
---|
| 106 | ENDDO |
---|
| 107 | endif |
---|
| 108 | |
---|
| 109 | ! Weighted distance stating 0, ending 1.0 |
---|
| 110 | umfzf(1)=0.0 |
---|
| 111 | dmfzf(1)=0.0 |
---|
| 112 | Do i=2,nuvz+1 |
---|
| 113 | umfzf(i)=0.0 |
---|
| 114 | dmfzf(i)=0.0 |
---|
| 115 | if (i .le. int(cu_top1)) & |
---|
| 116 | umfzf(i)=umfzf(i-1)+abs(umfdz(i-1)) |
---|
| 117 | |
---|
| 118 | dmfzf(i)=dmfzf(i-1)+abs(dmfdz(i-1)) |
---|
| 119 | if (i .eq. 2)write(*,*)'int(cu_top1)=',int(cu_top1) |
---|
| 120 | ! write(*,*)i,umfzf(i),umfdz(i) |
---|
| 121 | ENDdo |
---|
| 122 | ! estimate fraction of particles in the convective column will be mixed by cloud |
---|
| 123 | ! fmix=updraft flux at cloud base*dt/mass below cloud |
---|
| 124 | ! fmix*dt=fraction |
---|
| 125 | mass=abs(p1d(1)-p1d( int(cu_bot1) )) |
---|
| 126 | if (mass .le. 5000.0) mass=5000.0 |
---|
| 127 | mass=dx*dx*mass/9.81 |
---|
| 128 | fmix=abs(umf(int(cu_bot1)))*dt/mass |
---|
| 129 | write(*,*)'PRE_redist_kf.f, mass=,fmix=',mass,fmix |
---|
| 130 | |
---|
| 131 | return |
---|
| 132 | end subroutine pre_redist_kf |
---|
| 133 | |
---|
| 134 | |
---|