Changeset e9e0f06 in flexpart.git


Ignore:
Timestamp:
Dec 12, 2018, 1:35:46 PM (5 years ago)
Author:
Sabine <sabine.eckhardt@…>
Branches:
master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug
Children:
79996be9
Parents:
db91eb7
Message:

Removed kao and ass_spec and obsolete lines in get_wetscav.f90

Location:
src
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • src/FLEXPART.f90

    ra9cf4b1 re9e0f06  
    451451  call timemanager(metdata_format)
    452452
     453  if (verbosity.gt.0) then
    453454! NIK 16.02.2005
    454   do i=1,nspec
    455     write(*,*) '**********************************************'
    456     write(*,*) 'Scavenging statistics for species ', species(i), ':'
    457     write(*,*) 'Total number of occurences of below-cloud scavenging', &
    458          & tot_blc_count(i)
    459     write(*,*) 'Total number of occurences of in-cloud    scavenging', &
    460          & tot_inc_count(i)
    461     write(*,*) '**********************************************'
    462   end do
     455    do i=1,nspec
     456      if (tot_inc_count(i).gt.0) then
     457         write(*,*) '**********************************************'
     458         write(*,*) 'Scavenging statistics for species ', species(i), ':'
     459         write(*,*) 'Total number of occurences of below-cloud scavenging', &
     460           & tot_blc_count(i)
     461         write(*,*) 'Total number of occurences of in-cloud    scavenging', &
     462           & tot_inc_count(i)
     463         write(*,*) '**********************************************'
     464      endif
     465    end do
     466    write (*,*) 'timemanager> call wetdepo'
     467  endif
    463468 
    464469  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
  • src/com_mod.f90

    rc2bd55e re9e0f06  
    174174  real :: ri(5,numclass),rac(5,numclass),rcl(maxspec,5,numclass)
    175175  real :: rgs(maxspec,5,numclass),rlu(maxspec,5,numclass)
    176   real :: rm(maxspec),dryvel(maxspec),kao(maxspec)
     176  real :: rm(maxspec),dryvel(maxspec)
    177177  real :: ohcconst(maxspec),ohdconst(maxspec),ohnconst(maxspec)
    178   ! se  it is possible to associate a species with a second one to make transfer from gas to aerosol
    179   integer :: spec_ass(maxspec)
    180178
    181179  real :: area_hour(maxspec,24),point_hour(maxspec,24)
  • src/get_wetscav.f90

    r79e0349 re9e0f06  
    151151      if (height(il).gt.ztra1(jpart)) then
    152152        hz=il-1
    153 !        goto 26
    154153        exit
    155154      endif
    156155    end do
    157 !26  continue
    158 
    159156
    160157    if (ngrid.eq.0) then
     
    203200
    204201
    205 !ZHG oct 2014 : Calculated for 1) both 2) lsp 3) convp
     202!ZHG oct 2014 : Calculated for 1) both 2) lsp 3) convp - 2 and 3 not used removed by SE
    206203! Tentatively differentiate the grfraction for lsp and convp for treating differently the two forms
    207204! for now they are treated the same
    208205    grfraction(1)=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp))
    209     grfraction(2)=max(0.05,cc*(lfr(i)))
    210     grfraction(3)=max(0.05,cc*(cfr(j)))
    211 
    212206
    213207! 2) Computation of precipitation rate in sub-grid cell
    214208!******************************************************
    215209    prec(1)=(lsp+convp)/grfraction(1)
    216     prec(2)=(lsp)/grfraction(2)
    217     prec(3)=(convp)/grfraction(3)
    218 
    219210
    220211! 3) Computation of scavenging coefficients for all species
    221212!    Computation of wet deposition
    222213!**********************************************************
    223 
    224214
    225215      if (ngrid.gt.0) then
     
    237227!******************************************************************
    238228        if ((dquer(ks).le.0.).and.(weta_gas(ks).gt.0..or.wetb_gas(ks).gt.0.)) then
    239           !        if (weta(ks).gt.0. .or. wetb(ks).gt.0.) then
    240229          blc_count(ks)=blc_count(ks)+1
    241230          wetscav=weta_gas(ks)*prec(1)**wetb_gas(ks)
     
    271260          endif
    272261         
    273 !             write(*,*) 'bl-cloud, act_temp=',act_temp, ',prec=',prec(1),',wetscav=', wetscav, ', jpart=',jpart
    274 
    275262        endif ! gas or particle
    276263!      endif ! positive below-cloud scavenging parameters given in Species file
     
    285272        if ((ccn_aero(ks).gt.0. .or. in_aero(ks).gt.0.).or.(henry(ks).gt.0.and.dquer(ks).le.0)) then
    286273          inc_count(ks)=inc_count(ks)+1
    287 !          write(*,*) 'Incloud: ',inc_count
    288274! if negative coefficients (turned off) set to zero for use in equation
    289275          if (ccn_aero(ks).lt.0.) ccn_aero(ks)=0.
     
    300286! sec test
    301287!           cl=1E6*1E-7*prec(1)**0.3 !Sec GFS new
    302             cl=1E6*2E-7*prec(1)**0.36 !Sec ECMWF new
     288            cl=1E6*2E-7*prec(1)**0.36 !Sec ECMWF new, is also suitable for GFS
    303289!           cl=2E-7*prec(1)**0.36 !Andreas
    304290!           cl=1.6E-6*prec(1)**0.36 !Henrik
     
    322308          if (dquer(ks).gt.0.) then
    323309            S_i= frac_act/cl
    324 !           write(*,*) 'Si: ',S_i
    325 
    326310! GAS
    327311!****
    328312          else
    329 
    330313            cle=(1-cl)/(henry(ks)*(r_air/3500.)*act_temp)+cl
    331 !REPLACE to switch old/ new scheme
    332           ! S_i=frac_act/cle
    333314            S_i=1/cle
    334315          endif ! gas or particle
    335316
    336317! scavenging coefficient based on Hertel et al 1995 - using the S_i for either gas or aerosol
    337 !OLD
    338           if ((readclouds.and.ngrid.eq.0).or.(readclouds_this_nest.and.ngrid.gt.0)) then
     318!SEC wetscav fix, the cloud height is no longer needed, it gives wrong results
    339319            wetscav=incloud_ratio*S_i*(prec(1)/3.6E6)
    340           else
    341 !SEC wetscav fix
    342              wetscav=incloud_ratio*S_i*(prec(1)/3.6E6)
    343 !            wetscav=incloud_ratio*S_i*(prec(1)/3.6E6)/clouds_h
    344           endif
    345320        endif ! positive in-cloud scavenging parameters given in Species file
    346321      endif !incloud
  • src/netcdf_output_mod.f90

    rae43937 re9e0f06  
    6767                       ccn_aero,in_aero, & ! wetc_in,wetd_in, &
    6868                       reldiff,henry,f0,density,dquer,dsigma,dryvel,&
    69 !                       weightmolar,ohreact,spec_ass,kao,vsetaver,&
    70                        weightmolar,ohcconst,ohdconst,spec_ass,kao,vsetaver,&
     69                       weightmolar,ohcconst,ohdconst,vsetaver,&
    7170                       ! for concoutput_netcdf and concoutput_nest_netcdf
    7271                       nxmin1,nymin1,nz,oro,oron,rho,rhon,&
     
    512511        call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
    513512        call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
    514         call nf90_err(nf90_put_att(ncid, sID, 'kao', kao(i)))
    515513        call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
    516         call nf90_err(nf90_put_att(ncid, sID, 'spec_ass', spec_ass(i)))
    517514
    518515        if (lnest) then
     
    535532        call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
    536533        call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
    537         call nf90_err(nf90_put_att(ncid, sID, 'kao', kao(i)))
    538534        call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
    539         call nf90_err(nf90_put_att(ncid, sID, 'spec_ass', spec_ass(i)))
    540535
    541536        if (lnest) then
  • src/readspecies.f90

    raa8c34a re9e0f06  
    6767  character(len=16) :: pspecies
    6868  real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer
    69   real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, pkao
     69  real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
    7070  real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
    71   integer :: readerror, pspec_ass
     71  integer :: readerror
    7272
    7373! declare namelist
     
    7676       pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, &
    7777       preldiff, phenry, pf0, pdensity, pdquer, &
    78        pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, pspec_ass, pkao
     78       pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
    7979
    8080  pspecies="" ! read failure indicator value
     
    9696  pohdconst=-9.9E-09
    9797  pohnconst=2.0
    98   pspec_ass=-9
    99   pkao=-99.99
    10098  pweightmolar=-999.9
    10199
     
    164162    read(unitspecies,'(f8.2)',end=22) ohnconst(pos_spec)
    165163!  write(*,*) ohnconst(pos_spec)
    166     read(unitspecies,'(i18)',end=22) spec_ass(pos_spec)
    167 !  write(*,*) spec_ass(pos_spec)
    168     read(unitspecies,'(f18.2)',end=22) kao(pos_spec)
    169 !       write(*,*) kao(pos_spec)
    170164
    171165    pspecies=species(pos_spec)
     
    188182    pohdconst=ohdconst(pos_spec)
    189183    pohnconst=ohnconst(pos_spec)
    190     pspec_ass=spec_ass(pos_spec)
    191     pkao=kao(pos_spec)
    192184
    193185  else
     
    212204    ohdconst(pos_spec)=pohdconst
    213205    ohnconst(pos_spec)=pohnconst
    214     spec_ass(pos_spec)=pspec_ass
    215     kao(pos_spec)=pkao
    216 
    217206  endif
    218207
     
    303292  end if
    304293
    305   if (spec_ass(pos_spec).gt.0) then
    306     spec_found=.FALSE.
    307     do j=1,pos_spec-1
    308       if (spec_ass(pos_spec).eq.specnum(j)) then
    309         spec_ass(pos_spec)=j
    310         spec_found=.TRUE.
    311         ASSSPEC=.TRUE.
    312       endif
    313     end do
    314     if (spec_found.eqv..false.) then
    315       goto 997
    316     endif
    317   endif
    318 
    319   if (dsigma(i).eq.1.) dsigma(i)=1.0001   ! avoid floating exception
    320294  if (dsigma(i).eq.0.) dsigma(i)=1.0001   ! avoid floating exception
    321295
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG