From 85d32354a9a432f8ac4f5fbdbc46883fca2e22e3 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Tue, 28 Jun 2016 18:18:14 +0200 Subject: [PATCH 01/88] Updated version number --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 41df3fab..31aeaf0f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -37,7 +37,7 @@ endif() PROJECT(DALES Fortran) cmake_minimum_required(VERSION 2.6) set(VERSION_MAJOR "4") -set(VERSION_MINOR "1") +set(VERSION_MINOR "2") set(VERSION_PATCH "0") ### If necessary, resort to BASH-methods to find netcdf-directory From 582b6f358bacd1975b78403344069a593e7736d1 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Tue, 28 Jun 2016 18:41:56 +0200 Subject: [PATCH 02/88] Also added the right version in modglobal --- src/modglobal.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index a533443a..8a2a18b1 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -213,7 +213,7 @@ module modglobal logical :: leq = .true. !< switch for (non)-equidistant mode. logical :: lmomsubs = .false. !< switch to apply subsidence on the momentum or not - character(80) :: author='', version='DALES 4.1' + character(80) :: author='', version='DALES 4.2' contains !> Initialize global settings. From ddea51658e431006b0249ea3b30fd9e86bb0e00a Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Tue, 28 Jun 2016 17:52:22 -0400 Subject: [PATCH 03/88] Fielddump: Include scalar dumps, defined start/end times, and coarse graining --- src/modfielddump.f90 | 124 +++++++++++++++++++++++++++---------------- 1 file changed, 77 insertions(+), 47 deletions(-) diff --git a/src/modfielddump.f90 b/src/modfielddump.f90 index a2d4c6a6..c7cdc54a 100644 --- a/src/modfielddump.f90 +++ b/src/modfielddump.f90 @@ -27,7 +27,7 @@ ! module modfielddump - use modglobal, only : longint + use modglobal, only : longint, nsv implicit none private @@ -40,9 +40,9 @@ module modfielddump character(80),dimension(nvar,4) :: ncname character(80),dimension(1,4) :: tncname - real :: dtav - integer(kind=longint) :: idtav,tnext - integer :: klow,khigh + real :: dtav, tmin, tmax + integer(kind=longint) :: idtav,tnext,itmax,itmin + integer :: klow,khigh,ncoarse=-1 logical :: lfielddump= .false. !< switch to enable the fielddump (on/off) logical :: ldiracc = .false. !< switch for doing direct access writing (on/off) logical :: lbinary = .false. !< switch for doing direct access writing (on/off) @@ -54,15 +54,18 @@ subroutine initfielddump use modglobal,only :imax,jmax,kmax,cexpnr,ifnamopt,fname_options,dtmax,dtav_glob,kmax, ladaptive,dt_lim,btime,tres use modstat_nc,only : lnetcdf,open_nc, define_nc,ncinfo,writestat_dims_nc implicit none - integer :: ierr + integer :: ierr, n + character(3) :: csvname namelist/NAMFIELDDUMP/ & - dtav,lfielddump,ldiracc,lbinary,klow,khigh + dtav,lfielddump,ldiracc,lbinary,klow,khigh,ncoarse, tmin, tmax dtav=dtav_glob klow=1 khigh=kmax + tmin = 0. + tmax = 1e8 if(myid==0)then open(ifnamopt,file=fname_options,status='old',iostat=ierr) read (ifnamopt,NAMFIELDDUMP,iostat=ierr) @@ -74,13 +77,21 @@ subroutine initfielddump write(6 ,NAMFIELDDUMP) close(ifnamopt) end if + call MPI_BCAST(ncoarse ,1,MPI_INTEGER,0,comm3d,ierr) call MPI_BCAST(klow ,1,MPI_INTEGER,0,comm3d,ierr) call MPI_BCAST(khigh ,1,MPI_INTEGER,0,comm3d,ierr) call MPI_BCAST(dtav ,1,MY_REAL ,0,comm3d,ierr) + call MPI_BCAST(tmin ,1,MY_REAL ,0,comm3d,ierr) + call MPI_BCAST(tmax ,1,MY_REAL ,0,comm3d,ierr) call MPI_BCAST(lfielddump ,1,MPI_LOGICAL,0,comm3d,ierr) call MPI_BCAST(ldiracc ,1,MPI_LOGICAL,0,comm3d,ierr) call MPI_BCAST(lbinary ,1,MPI_LOGICAL,0,comm3d,ierr) + if (ncoarse==-1) then + ncoarse = 1 + end if idtav = dtav/tres + itmin = tmin/tres + itmax = tmax/tres tnext = idtav +btime if(.not.(lfielddump)) return @@ -89,6 +100,8 @@ subroutine initfielddump if (.not. ladaptive .and. abs(dtav/dtmax-nint(dtav/dtmax))>1e-4) then stop 'dtav should be a integer multiple of dtmax' end if + + nvar = nvar + nsv if (lnetcdf) then write(fname,'(A,i3.3,A,i3.3,A)') 'fielddump.', myidx, '.', myidy, '.xxx.nc' fname(19:21) = cexpnr @@ -99,12 +112,16 @@ subroutine initfielddump call ncinfo(ncname( 4,:),'qt','Total water specific humidity','1e-5kg/kg','tttt') call ncinfo(ncname( 5,:),'ql','Liquid water specific humidity','1e-5kg/kg','tttt') call ncinfo(ncname( 6,:),'thl','Liquid water potential temperature above 300K','K','tttt') - call ncinfo(ncname( 7,:),'qr','Rain water specific humidity','1e-5kg/kg','tttt') - call ncinfo(ncname( 8,:),'buoy','Buoyancy','K','tttt') - call open_nc(fname, ncid,nrec,n1=imax,n2=jmax,n3=khigh-klow+1) +! call ncinfo(ncname( 7,:),'qr','Rain water mixing ratio','1e-5kg/kg','tttt') + call ncinfo(ncname( 7,:),'buoy','Buoyancy','K','tttt') + do n=1,nsv + write (csvname(1:3),'(i3.3)') n + call ncinfo(ncname(7+n,:),'sv'//csvname,'Scalar '//csvname//' specific concentration','(kg/kg)','tttt') + end do + call open_nc(fname, ncid,nrec,n1=ceiling(1.0*imax/ncoarse),n2=ceiling(1.0*jmax/ncoarse),n3=khigh-klow+1) if (nrec==0) then call define_nc( ncid, 1, tncname) - call writestat_dims_nc(ncid) + call writestat_dims_nc(ncid, ncoarse) end if call define_nc( ncid, NVar, ncname) end if @@ -113,7 +130,7 @@ end subroutine initfielddump !> Do fielddump. Collect data to truncated (2 byte) integers, and write them to file subroutine fielddump - use modfields, only : um,vm,wm,thlm,qtm,ql0,svm,thv0h,thvh + use modfields, only : u0,v0,w0,thl0,qt0,ql0,sv0,thv0h,thvh use modsurfdata,only : thls,qts,thvs use modglobal, only : imax,i1,ih,jmax,j1,jh,k1,rk3step,& timee,dt_lim,cexpnr,ifoutput,rtimee @@ -122,7 +139,8 @@ subroutine fielddump use modmicrodata, only : iqr, imicro, imicro_none implicit none - integer(KIND=selected_int_kind(4)), allocatable :: field(:,:,:),vars(:,:,:,:) + integer(KIND=selected_int_kind(4)), allocatable :: field(:,:,:) + real, allocatable :: vars(:,:,:,:) integer i,j,k integer :: writecounter = 1 integer :: reclength @@ -140,84 +158,84 @@ subroutine fielddump dt_lim = minval((/dt_lim,tnext-timee/)) allocate(field(2-ih:i1+ih,2-jh:j1+jh,k1)) - allocate(vars(imax,jmax,khigh-klow+1,nvar)) + allocate(vars(ceiling(1.0*imax/ncoarse),ceiling(1.0*jmax/ncoarse),khigh-klow+1,nvar)) - reclength = imax*jmax*(khigh-klow+1)*2 + reclength = ceiling(1.0*imax/ncoarse)*ceiling(1.0*jmax/ncoarse)*(khigh-klow+1)*2 - field = NINT(1.0E3*um,2) - if (lnetcdf) vars(:,:,:,1) = field(2:i1,2:j1,klow:khigh) + field = NINT(1.0E3*u0,2) + if (lnetcdf) vars(:,:,:,1) = u0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbuu.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbuu.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif - field = NINT(1.0E3*vm,2) - if (lnetcdf) vars(:,:,:,2) = field(2:i1,2:j1,klow:khigh) + field = NINT(1.0E3*v0,2) + if (lnetcdf) vars(:,:,:,2) = v0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbvv.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbvv.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif - field = NINT(1.0E3*wm,2) - if (lnetcdf) vars(:,:,:,3) = field(2:i1,2:j1,klow:khigh) + field = NINT(1.0E3*w0,2) + if (lnetcdf) vars(:,:,:,3) = w0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbww.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbww.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif - field = NINT(1.0E5*qtm,2) - if (lnetcdf) vars(:,:,:,4) = field(2:i1,2:j1,klow:khigh) + field = NINT(1.0E5*qt0,2) + if (lnetcdf) vars(:,:,:,4) = qt0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbqt.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbqt.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif field = NINT(1.0E5*ql0,2) - if (lnetcdf) vars(:,:,:,5) = field(2:i1,2:j1,klow:khigh) + if (lnetcdf) vars(:,:,:,5) = ql0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbql.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbql.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif - field = NINT(1.0E2*(thlm-300),2) - if (lnetcdf) vars(:,:,:,6) = field(2:i1,2:j1,klow:khigh) + field = NINT(1.0E2*(thl0-300),2) + if (lnetcdf) vars(:,:,:,6) = thl0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbthl.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbthl.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) end if @@ -226,22 +244,20 @@ subroutine fielddump do i=2-ih,i1+ih do j=2-jh,j1+jh do k=1,k1 - field(i,j,k) = NINT(1.0E5*svm(i,j,k,iqr),2) + field(i,j,k) = NINT(1.0E5*sv0(i,j,k,iqr),2) enddo enddo enddo else field = 0. endif - - if (lnetcdf) vars(:,:,:,7) = field(2:i1,2:j1,klow:khigh) if (lbinary) then if (ldiracc) then open (ifoutput,file='wbqr.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbqr.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif @@ -254,23 +270,37 @@ subroutine fielddump enddo enddo enddo - - if (lnetcdf) vars(:,:,:,8) = field(2:i1,2:j1,klow:khigh) + + if (lnetcdf) then + vars(:,:,:,7) = thv0h(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) + do k=klow,khigh + vars(:,:,k,7) = vars(:,:,k,7) - thvh(k) + end do + end if + do i=2-ih,i1+ih, ncoarse + do j=2-jh,j1+jh, ncoarse + do k=2,k1 + field(i,j,k) = NINT(1.0E2*(thv0h(i,j,k)-thvh(k)),2) + enddo + enddo + enddo if (lbinary) then if (ldiracc) then open (ifoutput,file='wbthv.'//cmyidx//'.'//cmyidy//'.'//cexpnr,access='direct', form='unformatted', recl=reclength) - write (ifoutput, rec=writecounter) field(2:i1,2:j1,klow:khigh) + write (ifoutput, rec=writecounter) field(2:i1:ncoarse,2:j1:ncoarse,klow:khigh) else open (ifoutput,file='wbthv.'//cmyidx//'.'//cmyidy//'.'//cexpnr,form='unformatted',position='append') - write (ifoutput) (((field(i,j,k),i=2,i1),j=2,j1),k=klow,khigh) + write (ifoutput) (((field(i,j,k),i=2,i1, ncoarse),j=2,j1, ncoarse),k=klow,khigh) end if close (ifoutput) endif + if (lnetcdf) vars(:,:,:,8:nvar) = sv0(2:i1:ncoarse,2:j1:ncoarse,klow:khigh,:) + if(lnetcdf) then call writestat_nc(ncid,1,tncname,(/rtimee/),nrec,.true.) - call writestat_nc(ncid,nvar,ncname,vars,nrec,imax,jmax,khigh-klow+1) + call writestat_nc(ncid,nvar,ncname,vars,nrec,ceiling(1.0*imax/ncoarse),ceiling(1.0*jmax/ncoarse),khigh-klow+1) end if if(lbinary) then From 3ae9a71879f7e168ac48e5a0afd1f040b33f9f1d Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Tue, 28 Jun 2016 18:22:14 -0400 Subject: [PATCH 04/88] Changes to stat_nc to facilitate coarsegraining in fielddump --- src/modstat_nc.f90 | 63 ++++++++++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 27 deletions(-) diff --git a/src/modstat_nc.f90 b/src/modstat_nc.f90 index da21aa4f..7f6b4e5e 100644 --- a/src/modstat_nc.f90 +++ b/src/modstat_nc.f90 @@ -73,11 +73,11 @@ end subroutine initstat_nc ! ---------------------------------------------------------------------- !> Subroutine Open_NC: Opens a NetCDF File and identifies starting record ! - subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq) + subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq, ncoarse) use modglobal, only : author,version,rtimee implicit none integer, intent (out) :: ncid,nrec - integer, optional, intent (in) :: n1, n2, n3, ns, nq + integer, optional, intent (in) :: n1, n2, n3, ns, ncoarse, nq character (len=40), intent (in) :: fname character (len=12):: date='',time='' @@ -91,7 +91,7 @@ subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq) if (.not.exans) then call date_and_time(date,time) - iret = nf90_create(fname,NF90_SHARE,ncid) + iret = nf90_create(fname,NF90_NETCDF4,ncid) iret = nf90_put_att(ncid,NF90_GLOBAL,'title',fname) iret = nf90_put_att(ncid,NF90_GLOBAL,'history','Created on '//trim(date)//' at '//trim(time)) iret = nf90_put_att(ncid, NF90_GLOBAL, 'Source',trim(version)) @@ -245,44 +245,45 @@ subroutine define_nc(ncID, nVar, sx) iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt,VarID) !2D Fields case ('t0tt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tt,VarID, deflate_level = 2) case ('t0mt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0mt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0mt,VarID, deflate_level = 2) case ('m0tt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_m0tt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_m0tt,VarID, deflate_level = 2) case ('tt0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tt0t,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tt0t,VarID, deflate_level = 2) case ('tm0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tm0t,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tm0t,VarID, deflate_level = 2) case ('mt0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt0t,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt0t,VarID, deflate_level = 2) case ('0ttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttt,VarID, deflate_level = 2) case ('0tmt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0tmt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0tmt,VarID, deflate_level = 2) case ('0mtt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0mtt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0mtt,VarID, deflate_level = 2) !3D Fields case ('tttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttt,VarID, deflate_level = 2) case ('mttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mttt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mttt,VarID, deflate_level = 2) case ('tmtt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tmtt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tmtt,VarID, deflate_level = 2) case ('ttmt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_ttmt,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_ttmt,VarID, deflate_level = 2) !Soil fields case ('tts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tts ,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tts ,VarID, deflate_level = 2) case ('t0tts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tts,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tts,VarID, deflate_level = 2) case ('0ttts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttts,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttts,VarID, deflate_level = 2) case ('tttts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttts,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttts,VarID, deflate_level = 2) + !Quadrant analysis fields case('qt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_qt ,VarID) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_qt ,VarID, deflate_level = 2) case default print *, 'ABORTING: Bad dimensional information ',sx(n,:) stop @@ -317,26 +318,34 @@ subroutine exitstat_nc(ncid) status = nf90_close(ncid) if (status /= nf90_noerr) call nchandle_error(status) end subroutine exitstat_nc - subroutine writestat_dims_nc(ncid) + subroutine writestat_dims_nc(ncid, ncoarse) use modglobal, only : dx,dy,zf,zh,jmax use modsurfdata, only : zsoilc,isurf use modmpi, only : myid implicit none integer, intent(in) :: ncid - integer :: i=0,iret,length,varid + integer, optional, intent(in) :: ncoarse + integer :: i=0,iret,length,varid, nc + + if (present(ncoarse)) then + nc = ncoarse + else + nc = 1 + end if + iret = nf90_inq_varid(ncid, 'xt', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid, xtID, len=length) - if (iret==0) iret = nf90_put_var(ncid, varID, (/(dx*(0.5+i),i=0,length-1)/),(/1/)) + if (iret==0) iret = nf90_put_var(ncid, varID, (/(dx*(0.5+nc*i),i=0,length-1)/),(/1/)) iret = nf90_inq_varid(ncid, 'xm', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid, xmID, len=length) - if (iret==0) iret = nf90_put_var(ncid, varID, (/(dx*i,i=0,length-1)/),(/1/)) + if (iret==0) iret = nf90_put_var(ncid, varID, (/(dx*nc*i,i=0,length-1)/),(/1/)) iret = nf90_inq_varid(ncid, 'yt', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid, ytID, len=length) - if (iret==0) iret = nf90_put_var(ncid, varID, (/(dy*(0.5+i)+myid*jmax*dy,i=0,length-1)/),(/1/)) + if (iret==0) iret = nf90_put_var(ncid, varID, (/(dy*(0.5+nc*i)+myid*jmax*dy,i=0,length-1)/),(/1/)) iret = nf90_inq_varid(ncid, 'ym', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid, ymID, len=length) - if (iret==0) iret = nf90_put_var(ncid, varID, (/(dy*i+myid*jmax*dy,i=0,length-1)/),(/1/)) + if (iret==0) iret = nf90_put_var(ncid, varID, (/(dy*nc*i+myid*jmax*dy,i=0,length-1)/),(/1/)) iret = nf90_inq_varid(ncid, 'zt', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid,ztID, len=length) From 17c04a915731ffe12583b45f9e053cbfec341ff0 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 13:04:34 -0400 Subject: [PATCH 05/88] Bugfixes in fielddump modifications. It now compiles, at least. --- src/modfielddump.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modfielddump.f90 b/src/modfielddump.f90 index c7cdc54a..f08524a5 100644 --- a/src/modfielddump.f90 +++ b/src/modfielddump.f90 @@ -34,10 +34,10 @@ module modfielddump PUBLIC :: initfielddump, fielddump,exitfielddump save !NetCDF variables - integer,parameter :: nvar = 8 + integer :: nvar = 7 integer :: ncid,nrec = 0 character(80) :: fname = 'fielddump.xxx.xxx.xxx.nc' - character(80),dimension(nvar,4) :: ncname + character(80),dimension(:,:), allocatable :: ncname character(80),dimension(1,4) :: tncname real :: dtav, tmin, tmax @@ -105,6 +105,7 @@ subroutine initfielddump if (lnetcdf) then write(fname,'(A,i3.3,A,i3.3,A)') 'fielddump.', myidx, '.', myidy, '.xxx.nc' fname(19:21) = cexpnr + allocate(ncname(nvar,4)) call ncinfo(tncname(1,:),'time','Time','s','time') call ncinfo(ncname( 1,:),'u','West-East velocity','m/s','mttt') call ncinfo(ncname( 2,:),'v','South-North velocity','m/s','tmtt') From dc14b1554fcc03dea17ccde7899b074e3b332dd9 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 13:05:33 -0400 Subject: [PATCH 06/88] CMake changes so that dales compiles on Fedora 24 --- CMakeLists.txt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 31aeaf0f..d65f33e7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,9 +26,14 @@ elseif("$ENV{SYST}" STREQUAL "HYDRA") set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "FEDORA") + set(CMAKE_Fortran_COMPILER "mpif90") + set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none -I /usr/lib64/gfortran/modules/mpich/" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") else() set(CMAKE_Fortran_COMPILER "mpif90") - set(CMAKE_Fortran_FLAGS "-finit-real=nan -W -Wall -fdefault-real-8 -ffree-line-length-none" CACHE STRING "") + set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none " CACHE STRING "") set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") endif() From b56b1945e7297875b2077088894d26bd2d46abb7 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 13:06:17 -0400 Subject: [PATCH 07/88] Testbed on DALES4.2. Not guaranteed to do anything reasonable yet --- src/modfields.f90 | 30 +- src/modforces.f90 | 36 +- src/modglobal.f90 | 3 + src/modradfull.f90 | 167 +++++++-- src/modstartup.f90 | 96 ++++-- src/modtestbed.f90 | 799 +++++++++++++++++++++++++++++++++++++++++++ src/modtimedep.f90 | 295 ++++++++++------ src/modtimedepsv.f90 | 10 +- src/program.f90 | 3 + 9 files changed, 1274 insertions(+), 165 deletions(-) create mode 100644 src/modtestbed.f90 diff --git a/src/modfields.f90 b/src/modfields.f90 index 90cd0d82..9a6bde47 100644 --- a/src/modfields.f90 +++ b/src/modfields.f90 @@ -103,14 +103,20 @@ module modfields real, allocatable :: dthldxls(:) !< large scale x-gradient of th_liq real, allocatable :: dthldyls(:) !< large scale y-gradient of th_liq + real, allocatable :: dthldtls(:) !< large scale tendency of thl + real, allocatable :: dqtdxls(:) !< large scale x-gradient of q_tot real, allocatable :: dqtdyls(:) !< large scale y-gradient of q_tot - real, allocatable :: dqtdtls(:) !< large scale y-gradient of q_tot - real, allocatable :: dudxls(:) !< large scale x-gradient of u + real, allocatable :: dqtdtls(:) !< large scale tendency of q_tot + real, allocatable :: dudxls(:) !< large scale x-gradient of u real, allocatable :: dudyls(:) !< large scale y-gradient of u + real, allocatable :: dudtls(:) !< large scale tendency of u + real, allocatable :: dvdxls(:) !< large scale x-gradient of v real, allocatable :: dvdyls(:) !< large scale y-gradient of v + real, allocatable :: dvdtls(:) !< large scale tendency of v + real, allocatable :: wfls (:) !< large scale y-gradient of v real, allocatable :: ql0h(:,:,:) real, allocatable :: dthvdz(:,:,:)!< theta_v at half level @@ -200,15 +206,23 @@ subroutine initfields allocate(vg(k1)) allocate(dpdxl(k1)) allocate(dpdyl(k1)) + allocate(dthldxls(k1)) allocate(dthldyls(k1)) + allocate(dthldtls(k1)) + allocate(dqtdxls(k1)) allocate(dqtdyls(k1)) allocate(dqtdtls(k1)) + allocate(dudxls(k1)) allocate(dudyls(k1)) + allocate(dudtls(k1)) + allocate(dvdxls(k1)) allocate(dvdyls(k1)) + allocate(dvdtls(k1)) + allocate(wfls (k1)) allocate(ql0h(2-ih:i1+ih,2-jh:j1+jh,k1)) allocate(dthvdz(2-ih:i1+ih,2-jh:j1+jh,k1)) @@ -242,8 +256,12 @@ subroutine initfields presf=0.;presh=0.;exnf=0.;exnh=0.;thvh=0.;thvf=0.;rhof=0. ! OG qt0av=0.;ql0av=0.;thl0av=0.;u0av=0.;v0av=0.;sv0av=0. thlprof=0.;qtprof=0.;uprof=0.;vprof=0.;e12prof=0.;svprof=0. - ug=0.;vg=0.;dpdxl=0.;dpdyl=0.;wfls=0.;whls=0.;thlpcar = 0. - dthldxls=0.;dthldyls=0.;dqtdxls=0.;dqtdyls=0.;dudxls=0.;dudyls=0.;dvdxls=0.;dvdyls=0. + ug=0.;vg=0.;dpdxl=0.;dpdyl=0.;wfls=0.;whls=0. + thlpcar = 0. + dthldxls=0.;dthldyls=0.;dthldtls=0. + dqtdxls=0.;dqtdyls=0.;dqtdtls=0. + dudxls=0.;dudyls=0.;dudtls=0. + dvdxls=0.;dvdyls=0.;dvdtls=0. dthvdz=0. SW_up_TOA=0.;SW_dn_TOA=0.;LW_up_TOA=0.;LW_dn_TOA=0. qvsl=0.;qvsi=0.;esl=0. @@ -261,7 +279,9 @@ subroutine exitfields deallocate(rhobf,rhobh) deallocate(drhobdzf,drhobdzh) deallocate(ql0,tmp0,ql0h,thv0h,dthvdz,whls,presf,presh,exnf,exnh,thvh,thvf,rhof,qt0av,ql0av,thl0av,u0av,v0av) - deallocate(ug,vg,dpdxl,dpdyl,dthldxls,dthldyls,dqtdxls,dqtdyls,dqtdtls,dudxls,dudyls,dvdxls,dvdyls,wfls) + deallocate(ug,vg,dpdxl,dpdyl,wfls) + deallocate(dthldxls,dthldyls,dthldtls,dqtdxls,dqtdyls,dqtdtls) + deallocate(dudxls,dudyls,dudtls,dvdxls,dvdyls,dvdtls) deallocate(thlprof,qtprof,uprof,vprof,e12prof,sv0av,svprof) deallocate(thlpcar) deallocate(SW_up_TOA,SW_dn_TOA,LW_up_TOA,LW_dn_TOA) diff --git a/src/modforces.f90 b/src/modforces.f90 index 682ef583..44b6c183 100644 --- a/src/modforces.f90 +++ b/src/modforces.f90 @@ -60,7 +60,7 @@ subroutine forces ! | !-----------------------------------------------------------------| - use modglobal, only : i1,j1,kmax,dzh,dzf,grav + use modglobal, only : i1,j1,kmax,dzh,dzf,grav, lpressgrad use modfields, only : sv0,up,vp,wp,thv0h,dpdxl,dpdyl,thvh use moduser, only : force_user use modmicrodata, only : imicro, imicro_bulk, imicro_bin, imicro_sice,iqr @@ -78,8 +78,11 @@ subroutine forces jp=j+1 jm=j-1 do i=2,i1 - up(i,j,k) = up(i,j,k) - dpdxl(k) + + if (lpressgrad) then + up(i,j,k) = up(i,j,k) - dpdxl(k) !RN LS pressure gradient force in x,y directions; vp(i,j,k) = vp(i,j,k) - dpdyl(k) + end if wp(i,j,k) = wp(i,j,k) + grav*(thv0h(i,j,k)-thvh(k))/thvh(k) - & grav*(sv0(i,j,k,iqr)*dzf(k-1)+sv0(i,j,k-1,iqr)*dzf(k))/(2.0*dzh(k)) end do @@ -110,9 +113,10 @@ subroutine forces jm = j-1 do i=2,i1 - up(i,j,1) = up(i,j,1) - dpdxl(1) - - vp(i,j,1) = vp(i,j,1) - dpdyl(1) + if (lpressgrad) then + up(i,j,1) = up(i,j,1) - dpdxl(1) + vp(i,j,1) = vp(i,j,1) - dpdyl(1) + end if wp(i,j,1) = 0.0 @@ -220,10 +224,11 @@ subroutine lstend ! | !-----------------------------------------------------------------| - use modglobal, only : i1,j1,kmax,dzh,nsv,lmomsubs + use modglobal, only : i1,j1,k1,kmax,dzh,nsv,lmomsubs,llstend use modfields, only : up,vp,thlp,qtp,svp,& whls, u0av,v0av,thl0,qt0,sv0,u0,v0,& - dudxls,dudyls,dvdxls,dvdyls,dthldxls,dthldyls,dqtdxls,dqtdyls,dqtdtls + dudxls,dudyls,dvdxls,dvdyls,dthldxls,dthldyls,dqtdxls,dqtdyls, & + dqtdtls, dthldtls, dudtls, dvdtls implicit none integer i,j,k,n,kp,km @@ -255,10 +260,10 @@ subroutine lstend svp(i,j,1,n) = svp(i,j,1,n)-subs_sv enddo endif - thlp(i,j,1) = thlp(i,j,1) -u0av(1)*dthldxls(1)-v0av(1)*dthldyls(1)-subs_thl - qtp(i,j,1) = qtp (i,j,1) -u0av(1)*dqtdxls (1)-v0av(1)*dqtdyls (1)-subs_qt +dqtdtls(1) - up (i,j,1) = up (i,j,1) -u0av(1)*dudxls (1)-v0av(1)*dudyls (1)-subs_u - vp (i,j,1) = vp (i,j,1) -u0av(1)*dvdxls (1)-v0av(1)*dvdyls (1)-subs_v + thlp(i,j,1) = thlp(i,j,1) -u0av(1)*dthldxls(1)-v0av(1)*dthldyls(1)-subs_thl + dthldtls(1) + qtp(i,j,1) = qtp (i,j,1) -u0av(1)*dqtdxls (1)-v0av(1)*dqtdyls (1)-subs_qt + dqtdtls(1) + up (i,j,1) = up (i,j,1) -u0av(1)*dudxls (1)-v0av(1)*dudyls (1)-subs_u + dudtls(1) + vp (i,j,1) = vp (i,j,1) -u0av(1)*dvdxls (1)-v0av(1)*dvdyls (1)-subs_v + dvdtls(1) end do end do @@ -292,11 +297,12 @@ subroutine lstend svp(i,j,k,n) = svp(i,j,k,n)-subs_sv enddo endif + + thlp(i,j,k) = thlp(i,j,k)-u0av(k)*dthldxls(k)-v0av(k)*dthldyls(k)-subs_thl + dthldtls(k) + qtp (i,j,k) = qtp (i,j,k)-u0av(k)*dqtdxls (k)-v0av(k)*dqtdyls (k)-subs_qt + dqtdtls(k) + up (i,j,k) = up (i,j,k)-u0av(k)*dudxls (k)-v0av(k)*dudyls (k)-subs_u + dudtls(k) + vp (i,j,k) = vp (i,j,k)-u0av(k)*dvdxls (k)-v0av(k)*dvdyls (k)-subs_v + dvdtls(k) - thlp(i,j,k) = thlp(i,j,k)-u0av(k)*dthldxls(k)-v0av(k)*dthldyls(k)-subs_thl - qtp (i,j,k) = qtp (i,j,k)-u0av(k)*dqtdxls (k)-v0av(k)*dqtdyls (k)-subs_qt+dqtdtls(k) - up (i,j,k) = up (i,j,k)-u0av(k)*dudxls (k)-v0av(k)*dudyls (k)-subs_u - vp (i,j,k) = vp (i,j,k)-u0av(k)*dvdxls (k)-v0av(k)*dvdyls (k)-subs_v enddo enddo enddo diff --git a/src/modglobal.f90 b/src/modglobal.f90 index 8a2a18b1..012653a5 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -55,6 +55,7 @@ module modglobal character(50) :: startfile !< * name of the restart file logical :: llsadv = .false. !< switch for large scale forcings + logical :: llstend = .true. !< switch for large scale forcings !< Parameter kinds, for rrtmg radiation scheme integer, parameter :: kind_rb = selected_real_kind(12) ! 8 byte real @@ -99,6 +100,8 @@ module modglobal real,parameter :: boltz = 5.67e-8 !< *Stefan-Boltzmann constant logical :: lcoriol = .true. !< switch for coriolis force + logical :: lpressgrad = .true. !< switch for horizontal pressure gradient force + integer :: igrw_damp = 2 !< switch to enable gravity wave damping real :: geodamptime = 7200. !< time scale for nudging to geowind in sponge layer, prevents oscillations real :: om22 !< *2.*omega_earth*cos(lat) diff --git a/src/modradfull.f90 b/src/modradfull.f90 index ad7ca4dd..ba28cb21 100644 --- a/src/modradfull.f90 +++ b/src/modradfull.f90 @@ -29,6 +29,7 @@ module modradfull use RandomNumbers + use modglobal, only : pi implicit none private public :: radfull,d4stream @@ -197,6 +198,7 @@ subroutine d4stream(i1,ih,j1,jh,k1, tskin, albedo, CCN, dn0, & use modglobal, only : cexpnr,cp,cpr,pi,pref0,rtimee,xday,xlat,xlon,xtime,rhow use modraddata,only : useMcICA,zenith,sw0,SW_up_TOA, SW_dn_TOA, LW_up_TOA, LW_dn_TOA, & SW_up_ca_TOA, SW_dn_ca_TOA, LW_up_ca_TOA, LW_dn_ca_TOA + use modtestbed, only : ltestbed implicit none integer, intent (in) :: i1,ih,j1,jh,k1 @@ -213,18 +215,30 @@ subroutine d4stream(i1,ih,j1,jh,k1, tskin, albedo, CCN, dn0, & real :: prw, p0(k1), exner(k1), pres(k1) character (len=19) :: background - if (.not. d4stream_initialized) then - p0(k1) = (pref0*(pi0(k1)/cp)**cpr) / 100. - p0(k1-1) = (pref0*(pi0(k1-1)/cp)**cpr) / 100. - background = 'backrad.inp.'//cexpnr - call d4stream_setup(background,k1,npts,nv1,nv,p0) - d4stream_initialized = .True. - if (allocated(pre)) pre(:) = 0. - if (allocated(pde)) pde(:) = 0. - if (allocated(piwc)) piwc(:) = 0. - if (allocated(prwc)) prwc(:) = 0. - if (allocated(plwc)) plwc(:) = 0. - if (allocated(pgwc)) pgwc(:) = 0. + if (ltestbed) then + p0(k1) = (pref0*(pi0(k1)/cp)**cpr) / 100. + p0(k1-1) = (pref0*(pi0(k1-1)/cp)**cpr) / 100. + call d4stream_tb_setup(k1,npts,nv1,nv,p0) + if (allocated(pre)) pre(:) = 0. + if (allocated(pde)) pde(:) = 0. + if (allocated(piwc)) piwc(:) = 0. + if (allocated(prwc)) prwc(:) = 0. + if (allocated(plwc)) plwc(:) = 0. + if (allocated(pgwc)) pgwc(:) = 0. + else + if (.not. d4stream_initialized) then + p0(k1) = (pref0*(pi0(k1)/cp)**cpr) / 100. + p0(k1-1) = (pref0*(pi0(k1-1)/cp)**cpr) / 100. + background = 'backrad.inp.'//cexpnr + call d4stream_setup(background,k1,npts,nv1,nv,p0) + d4stream_initialized = .True. + if (allocated(pre)) pre(:) = 0. + if (allocated(pde)) pde(:) = 0. + if (allocated(piwc)) piwc(:) = 0. + if (allocated(prwc)) prwc(:) = 0. + if (allocated(plwc)) plwc(:) = 0. + if (allocated(pgwc)) pgwc(:) = 0. + end if end if if (present(lclear)) then doclear=lclear @@ -383,6 +397,7 @@ subroutine d4stream_setup(filenm,k1,npts,nv1,nv,zp) pt(1:norig) = st(1:norig) ph(1:norig) = sh(1:norig) po(1:norig) = so(1:norig) + plwc(1:norig) = sl(1:norig) do k=norig+1,npts pp(k) = (ptop + pp(k-1))*0.5 @@ -390,6 +405,7 @@ subroutine d4stream_setup(filenm,k1,npts,nv1,nv,zp) pt(k) = intrpl(sp(index),st(index),sp(index+1),st(index+1),pp(k)) ph(k) = intrpl(sp(index),sh(index),sp(index+1),sh(index+1),pp(k)) po(k) = intrpl(sp(index),so(index),sp(index+1),so(index+1),pp(k)) + plwc(k) = intrpl(sp(index),sl(index),sp(index+1),sl(index+1),pp(k)) end do ! ! set the ozone constant below the reference profile @@ -400,6 +416,120 @@ subroutine d4stream_setup(filenm,k1,npts,nv1,nv,zp) end if end subroutine d4stream_setup + + subroutine d4stream_tb_setup(k1,npts,nv1,nv,zp) + use modmpi, only : myid + use modtestbed, only : tbrad_p, tbrad_t, tbrad_ql, tbrad_qv, tbrad_o3, testbed_getinttime, nknudge + implicit none + + integer, intent (in) :: k1 + integer, intent (out):: npts,nv1,nv + real, intent (in) :: zp(k1) + + real, allocatable :: sp(:), st(:), sh(:), so(:), sl(:) + + integer :: k, norig, index, t + logical :: blend + real :: pa, pb, ptop, ptest, test, dp1, dp2, dp3, dtm, dtp + + norig = 0 + allocate ( sp(nknudge), st(nknudge), sh(nknudge), so(nknudge), sl(nknudge)) + if (allocated(pp)) then + deallocate (pp,fds,fus,fdir,fuir) + deallocate (pt,ph,po,pre,pde,plwc,prwc) + end if + call testbed_getinttime(t, dtm, dtp) + sp = tbrad_p (t,:) * dtp + tbrad_p (t+1,:) * dtm /100. !convert to hPa + st = tbrad_t (t,:) * dtp + tbrad_t (t+1,:) * dtm + sh = tbrad_qv(t,:) * dtp + tbrad_qv(t+1,:) * dtm + so = tbrad_o3(t,:) * dtp + tbrad_o3(t+1,:) * dtm + sl = tbrad_ql(t,:) * dtp + tbrad_ql(t+1,:) * dtm + +! open ( unit = 08, file = filenm, status = 'old' ) +! if (myid==0) print *, 'Reading Background Sounding: ',filenm +! read (08,*) Tsurf, ns +! allocate ( sp(ns), st(ns), sh(ns), so(ns), sl(ns)) +! do k=1,ns +! read ( 08, *) sp(k), st(k), sh(k), so(k), sl(k) +! sp(k) = sp(k) / 100. !convert to hPa +! enddo +! close (08) + + ! + ! identify what part, if any, of background sounding to use + ! + ptop = zp(k1) + if (sp(2) < ptop) then + pa = sp(1) + pb = sp(2) + k = 3 + do while (sp(k) < ptop) + pa = pb + pb = sp(k) + k = k+1 + end do + k=k-1 ! identify first level above top of input + blend = .True. + else + blend = .False. + end if + ! + ! if blend is true then the free atmosphere above the sounding will be + ! specified based on the specified background climatology, here the + ! pressure levels for this part of the sounding are determined + ! + if (blend) then + dp1 = pb-pa + dp2 = ptop - pb + dp3 = zp(k1-1) - zp(k1) + if (dp1 > 2.*dp2) k = k-1 ! first level is too close, blend from prev + npts = k + norig = k + ptest = sp(k) + test = ptop-ptest + do while (test > 2*dp3) + ptest = (ptest+ptop)*0.5 + test = ptop-ptest + npts = npts + 1 + end do + nv1 = npts + k1 + else + nv1 = k1 + end if + nv = nv1-1 + ! + ! allocate the arrays for the sounding data to be used in the radiation + ! profile and then fill them first with the sounding data, by afill, then + ! by interpolating the background profile at pressures less than the + ! pressure at the top fo the sounding + ! + allocate (pp(nv1),fds(nv1),fus(nv1),fdir(nv1),fuir(nv1)) + allocate (pt(nv),ph(nv),po(nv),pre(nv),pde(nv),plwc(nv),prwc(nv)) + + if (blend) then + pp(1:norig) = sp(1:norig) + pt(1:norig) = st(1:norig) + ph(1:norig) = sh(1:norig) + po(1:norig) = so(1:norig) + plwc(1:norig) = sl(1:norig) + + do k=norig+1,npts + pp(k) = (ptop + pp(k-1))*0.5 + index = getindex(sp,nknudge,pp(k)) + pt(k) = intrpl(sp(index),st(index),sp(index+1),st(index+1),pp(k)) + ph(k) = intrpl(sp(index),sh(index),sp(index+1),sh(index+1),pp(k)) + po(k) = intrpl(sp(index),so(index),sp(index+1),so(index+1),pp(k)) + plwc(k) = intrpl(sp(index),sl(index),sp(index+1),sl(index+1),pp(k)) + end do + ! + ! set the ozone constant below the reference profile + ! + do k=npts+1,nv + po(k) = po(npts) + end do + end if + + end subroutine d4stream_tb_setup !> coefficient calculations for four first-order differential equations. !> !> See the paper by Liou, Fu and Ackerman (1988) for the formulation of @@ -426,7 +556,7 @@ subroutine coefft(solar,w,w1,w2,w3,t0,t1,u0,f0,aa,zz,a1,z1,fk1,fk2) q2 = w2w * ( 1.5 * fw - 0.5 ) q3 = - w3w * ( 2.5 * fw - 1.5 ) * u0 do i = 1, 4 - c(i,5) = (w0w + q1*p1d(i) + q2*p2d(i) + q3*p3d(i))/(u(i) + epsilon(u(i))) + c(i,5) = (w0w + q1*p1d(i) + q2*p2d(i) + q3*p3d(i))/(u(i)+epsilon(u0)) end do else do i = 1, 4 @@ -944,9 +1074,8 @@ end subroutine adjust !> Subroutine qft: Delta 4-stream solver for fluxes !> subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) - use modglobal, only : pi + logical, intent (in) :: solar - logical :: ldummy ! serves to make radiation scheme work under O4 real, intent (in) :: ee, as, u0 real, dimension (nv), intent (in) :: tt,ww,ww1,ww2,ww3,ww4 real, dimension (nv1), intent (in) :: bf @@ -975,13 +1104,9 @@ subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) tkm1 = 0.0 do k = 1, nv f0a(k) = 2.0 * ( 1.0 - w(k) ) * bf(k) - u0a(k) = -(t(k)-tkm1) / ( alog( bf(k+1)/bf(k) ) + epsilon(1.)) + u0a(k) = -(t(k)-tkm1) / ( alog( bf(k+1)/bf(k) )) + u0a(k) = sign(max(abs(u0a(k)),1.e-8),u0a(k)) tkm1 = t(k) - if(abs(u0a(k))<10.e-10) then - ldummy=.true. - else - ldummy=.false. - endif end do end if diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 89a9f6a8..3d10dbf3 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -56,7 +56,7 @@ subroutine startup use modglobal, only : initglobal,iexpnr,runtime, dtmax,dtav_glob,timeav_glob,& lwarmstart,startfile,trestart,& nsv,itot,jtot,kmax,xsize,ysize,xlat,xlon,xday,xtime,& - lmoist,lcoriol,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,& + lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,llstend,& ibas_prf,lambda_crit,iadv_mom,iadv_tke,iadv_thl,iadv_qt,iadv_sv,courant,peclet,ladaptive,author,lnoclouds,lrigidlid,unudge use modforces, only : lforce_user use modsurfdata, only : z0,ustin,wtsurf,wqsurf,wsvsurf,ps,thls,isurf @@ -68,6 +68,8 @@ subroutine startup rad_ls,rad_longw,rad_shortw,rad_smoke,useMcICA,& timerad,rka,dlwtop,dlwbot,sw0,gc,reff,isvsmoke,lcloudshading use modtimedep, only : inittimedep,ltimedep + use modtimedepsv, only : inittimedepsv,ltimedepsv + use modtestbed, only : inittestbed use modboundary, only : initboundary,ksp use modthermodynamics, only : initthermodynamics,lqlnr, chi_half use modmicrophysics, only : initmicrophysics @@ -91,10 +93,10 @@ subroutine startup namelist/PHYSICS/ & !cstep z0,ustin,wtsurf,wqsurf,wsvsurf,ps,thls,chi_half,lmoist,isurf,lneutraldrag,& z0,ustin,wtsurf,wqsurf,wsvsurf,ps,thls,lmoist,isurf,chi_half,& - lcoriol,igrw_damp,geodamptime,lmomsubs,ltimedep,irad,timerad,iradiation,rad_ls,rad_longw,rad_shortw,rad_smoke,useMcICA,& + lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,ltimedep,ltimedepsv,irad,timerad,iradiation,rad_ls,rad_longw,rad_shortw,rad_smoke,useMcICA,& rka,dlwtop,dlwbot,sw0,gc,reff,isvsmoke,lforce_user,lcloudshading,lrigidlid,unudge namelist/DYNAMICS/ & - llsadv, lqlnr, lambda_crit, cu, cv, ibas_prf, iadv_mom, iadv_tke, iadv_thl, iadv_qt, iadv_sv, lnoclouds + llsadv, llstend, lqlnr, lambda_crit, cu, cv, ibas_prf, iadv_mom, iadv_tke, iadv_thl, iadv_qt, iadv_sv, lnoclouds ! get myid call MPI_INIT(mpierr) @@ -180,11 +182,13 @@ subroutine startup call MPI_BCAST(chi_half ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lmoist ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lcoriol ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(lpressgrad ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(igrw_damp ,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(geodamptime,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lforce_user,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lmomsubs ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(ltimedep ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(ltimedepsv ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lrigidlid ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(unudge ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) @@ -207,6 +211,7 @@ subroutine startup call MPI_BCAST(lcloudshading,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(llsadv ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(llstend ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lqlnr ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lambda_crit,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(cu ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) @@ -241,6 +246,8 @@ subroutine startup call initglobal call initfields + call inittestbed !reads initial profiles from scm_in.nc, to be used in readinitfiles + call initboundary call initthermodynamics call initradiation @@ -363,12 +370,14 @@ subroutine readinitfiles use modsurfdata, only : wsvsurf, & thls,tskin,tskinm,tsoil,tsoilm,phiw,phiwm,Wl,Wlm,thvs,qts,isurf,svs,obl,oblav,& thvs_patch,lhetero,qskin - use modsurface, only : surface,qtsurf,dthldz + use modsurface, only : surface,qtsurf,dthldz,ps use modboundary, only : boundary use modmpi, only : slabsum,myid,comm3d,mpierr,my_real use modthermodynamics, only : thermodynamics,calc_halflev use moduser, only : initsurf_user + use modtestbed, only : ltestbed,tb_ps,tb_thl,tb_qt,tb_u,tb_v,tb_w,tb_ug,tb_vg,& + tb_dqtdxls,tb_dqtdyls,tb_uadv,tb_vadv,tb_qtadv,tb_thladv integer i,j,k,n real, allocatable :: height(:), th0av(:) @@ -396,22 +405,47 @@ subroutine readinitfiles dt = floor(rdt/tres) timee = 0 if (myid==0) then - open (ifinput,file='prof.inp.'//cexpnr) - read (ifinput,'(a80)') chmess - write(*, '(a80)') chmess - read (ifinput,'(a80)') chmess - do k=1,kmax - read (ifinput,*) & + if (ltestbed) then + + write(*,*) 'readinitfiles: testbed mode: profiles for initialization obtained from scm_in.nc' + + do k=1,kmax + height (k) = zf(k) + thlprof(k) = tb_thl(1,k) + qtprof (k) = tb_qt(1,k) + uprof (k) = tb_u(1,k) + vprof (k) = tb_v(1,k) + e12prof(k) = e12min + end do + + ps = tb_ps(1) + !qts + !thls + !wtsurf + !wqsurf + + else + + open (ifinput,file='prof.inp.'//cexpnr) + read (ifinput,'(a80)') chmess + write(*, '(a80)') chmess + read (ifinput,'(a80)') chmess + + do k=1,kmax + read (ifinput,*) & height (k), & thlprof(k), & qtprof (k), & uprof (k), & vprof (k), & e12prof(k) - end do + end do + + close(ifinput) + + end if !ltestbed - close(ifinput) write(*,*) 'height thl qt u v e12' do k=kmax,1,-1 write (*,'(f7.1,f8.1,e12.4,3f7.1)') & @@ -648,13 +682,29 @@ subroutine readinitfiles if(myid==0)then - open (ifinput,file='lscale.inp.'//cexpnr) - read (ifinput,'(a80)') chmess - read (ifinput,'(a80)') chmess - write(6,*) ' height u_geo v_geo subs ' & - ,' dqtdx dqtdy dqtdtls thl_rad ' - do k=1,kmax - read (ifinput,*) & + + if (ltestbed) then + + write(*,*) 'readinitfiles: testbed mode: profiles for ls forcing obtained from scm_in.nc' + + do k=1,kmax + height (k) = zf(k) + ug (k) = tb_ug(1,k) + vg (k) = tb_vg(1,k) + wfls (k) = tb_w(1,k) + dqtdxls(k) = tb_dqtdxls(1,k) + dqtdyls(k) = tb_dqtdyls(1,k) + dqtdtls(k) = tb_qtadv(1,k) + thlpcar(k) = tb_thladv(1,k) + end do + + else + + open (ifinput,file='lscale.inp.'//cexpnr) + read (ifinput,'(a80)') chmess + read (ifinput,'(a80)') chmess + do k=1,kmax + read (ifinput,*) & height (k), & ug (k), & vg (k), & @@ -663,9 +713,13 @@ subroutine readinitfiles dqtdyls(k), & dqtdtls(k), & thlpcar(k) - end do - close(ifinput) + end do + close(ifinput) + + end if + write(6,*) ' height u_geo v_geo subs ' & + ,' dqtdx dqtdy dqtdtls thl_rad ' do k=kmax,1,-1 write (6,'(3f7.1,5e12.4)') & height (k), & diff --git a/src/modtestbed.f90 b/src/modtestbed.f90 new file mode 100644 index 00000000..52bc9497 --- /dev/null +++ b/src/modtestbed.f90 @@ -0,0 +1,799 @@ +!> \file modtestbed.f90 +!! Testbed continuous forcing & nudging +!> + +!> +!! Testbed continuous forcing & nudging +!> +!! \author Roel Neggers, IGMK +!! \par Revision list +!! \todo Documentation +! This file is part of DALES. +! +! DALES is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 3 of the License, or +! (at your option) any later version. +! +! DALES is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +! Copyright 1993-2009 Delft University of Technology, Wageningen University, Utrecht University, KNMI +! + + + +module modtestbed + +use netcdf + +implicit none +PRIVATE +PUBLIC :: inittestbed, testbednudge, exittestbed, ltestbed,testbed_getinttime, ntnudge, nknudge, & + tb_time,tb_ps,tb_qts,tb_thls,tb_wqs,tb_wts, tb_z0h, tb_z0m, tb_alb, tb_Qnet, & + tb_u,tb_v,tb_w,tb_thl,tb_qt,tb_ug,tb_vg, & + tb_dqtdxls,tb_dqtdyls, & + tb_qtadv,tb_thladv,tb_uadv,tb_vadv, & + tb_tsoilav,tb_phiwav, & + tbrad_p, tbrad_ql, tbrad_qv, tbrad_t, tbrad_o3 +SAVE + real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,tb_qt,tb_ug,tb_vg, & + tb_dqtdxls,tb_dqtdyls, & + tb_qtadv,tb_thladv,tb_uadv,tb_vadv, & + tb_tsoilav,tb_phiwav, & + tbrad_p, tbrad_t, tbrad_qv, tbrad_ql, tbrad_o3 + real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts, tb_z0h, tb_z0m, tb_alb, tb_Qnet + real :: tb_taunudge = 10800. + logical :: ltestbed = .false., & + ltb_nudge = .false., & + ltb_u,ltb_v,ltb_w,ltb_thl,ltb_qt + integer :: nknudge,ntnudge + +contains + subroutine inittestbed + + use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer + use modglobal,only :ifnamopt,fname_options,runtime,btime,cexpnr,ifinput,k1,kmax,tres,& + grav,rd,cp,pref0,rlv,zf,dzf,dzh + use modsurfdata,only : ksoilmax, phifc, phiwp, dzsoil + use modforces, only : lforce_user + + implicit none + + real, dimension(:,:), allocatable :: dumomega,dumqv,dumql,dumqi,dumt,dumpf, dumo3,& + dumheight,dumqt,dumthl,dumu,dumv,dumw, & + dumug,dumvg,dumqtadv,dumthladv,dumuadv,dumvadv, & + dumqadv,dumladv,dumiadv,dumtadv, & + dumtsoilav,dumphiwav,dumswi,& + dumlwnet,dumswnet + + real, dimension(:), allocatable :: dumheights + + real :: dumphifc,dumphiwp + + INTEGER NCID, STATUS, VARID, timID + INTEGER start2(2), count2(2) + character(len = nf90_max_name) :: RecordDimName + + integer :: ierr,i,k,ik,nknudgep1,nknudges + character(1) :: chmess1 + real tv,rho,iexner,fac + + namelist /NAMTESTBED/ & + ltestbed, ltb_nudge, tb_taunudge + + if(myid==0)then + + open(ifnamopt,file=fname_options,status='old',iostat=ierr) + read (ifnamopt,NAMTESTBED,iostat=ierr) + if (ierr > 0) then + print *, 'Problem in namoptions NAMTESTBED' + print *, 'iostat error: ', ierr + stop 'ERROR: Problem in namoptions NAMTESTBED' + endif + write(6 ,NAMTESTBED) + close(ifnamopt) + + end if + + call MPI_BCAST(ltestbed , 1,MPI_LOGICAL,0,comm3d,mpierr) + call MPI_BCAST(ltb_nudge , 1,MPI_LOGICAL,0,comm3d,mpierr) + + if (.not. ltestbed) return + + lforce_user = .true. + + if(myid==0) then + !--- open nc file --- + STATUS = NF90_OPEN('scm_in.nc', nf90_nowrite, NCID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + + !--- get time & height dimensions --- + status = nf90_inq_dimid(ncid, "time", timID) + if (status /= nf90_noerr) call handle_err(status) + status = nf90_inquire_dimension(NCID, timID, len=ntnudge, name=RecordDimName) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + +! write(6,'(a15,i10," ",a10)') 'scm_in time:',ntnudge,RecordDimName + + status = nf90_inq_dimid(ncid, "nlev", timID) + if (status /= nf90_noerr) call handle_err(status) + status = nf90_inquire_dimension(NCID, timID, len=nknudge, name=RecordDimName) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + status = nf90_inq_dimid(ncid, "nlevp1", timID) + if (status /= nf90_noerr) call handle_err(status) + status = nf90_inquire_dimension(NCID, timID, len=nknudgep1, name=RecordDimName) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + status = nf90_inq_dimid(ncid, "nlevs", timID) + if (status /= nf90_noerr) call handle_err(status) + status = nf90_inquire_dimension(NCID, timID, len=nknudges, name=RecordDimName) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + end if + + call MPI_BCAST(ntnudge , 1,MPI_INTEGER,0,comm3d,mpierr) + call MPI_BCAST(nknudge , 1,MPI_INTEGER,0,comm3d,mpierr) + call MPI_BCAST(nknudgep1 , 1,MPI_INTEGER,0,comm3d,mpierr) + call MPI_BCAST(nknudges , 1,MPI_INTEGER,0,comm3d,mpierr) + + !--- allocate space for input variables & reset--- + allocate( tnudge (ntnudge,k1), & + tb_u (ntnudge,k1), & + tb_v (ntnudge,k1), & + tb_w (ntnudge,k1), & + tb_thl (ntnudge,k1), & + tb_qt (ntnudge,k1), & + tb_ug (ntnudge,k1), & + tb_vg (ntnudge,k1), & + tb_dqtdxls(ntnudge,k1), & + tb_dqtdyls(ntnudge,k1), & + tb_qtadv (ntnudge,k1), & + tb_thladv (ntnudge,k1), & + tb_uadv (ntnudge,k1), & + tb_vadv (ntnudge,k1), & + tb_time (ntnudge), & + tb_ps (ntnudge), & + tb_qts (ntnudge), & + tb_thls (ntnudge), & + tb_wts (ntnudge), & + tb_wqs (ntnudge), & + tb_z0m (ntnudge), & + tb_z0h (ntnudge), & + tb_alb (ntnudge), & + tb_Qnet (ntnudge), & + tb_tsoilav(ntnudge,ksoilmax), & + tb_phiwav (ntnudge,ksoilmax), & + tbrad_p (ntnudge, nknudge), & + tbrad_t (ntnudge, nknudge), & + tbrad_qv (ntnudge, nknudge), & + tbrad_ql (ntnudge, nknudge), & + tbrad_o3 (ntnudge, nknudge) & + ) + + tnudge = tb_taunudge !nudging timescale + + tb_time=0 + tb_ps=0 + tb_qts=0 + tb_thls=0 + tb_wts=0 + tb_wqs=0 + tb_z0m=0 + tb_z0h=0 + tb_alb=0 + tb_Qnet=0 + + tb_u=0 + tb_v=0 + tb_w=0 + tb_thl=0 + tb_qt=0 + tb_ug=0 + tb_vg=0 + tb_dqtdxls=0 + tb_dqtdyls=0 + tb_qtadv=0 + tb_thladv=0 + tb_uadv=0 + tb_vadv=0 + + tb_tsoilav=0 + tb_phiwav=0 + + + if(myid==0) then + + allocate(dumomega (nknudge,ntnudge), & + dumheight(nknudge,ntnudge), & + dumpf (nknudge,ntnudge), & + dumqv (nknudge,ntnudge), & + dumql (nknudge,ntnudge), & + dumqi (nknudge,ntnudge), & + dumo3 (nknudge,ntnudge), & + dumt (nknudge,ntnudge), & + dumqt (nknudge,ntnudge), & + dumthl (nknudge,ntnudge), & + dumu (nknudge,ntnudge), & + dumv (nknudge,ntnudge), & + dumw (nknudge,ntnudge), & + dumug (nknudge,ntnudge), & + dumvg (nknudge,ntnudge), & + dumqtadv (nknudge,ntnudge), & + dumthladv(nknudge,ntnudge), & + dumuadv (nknudge,ntnudge), & + dumvadv (nknudge,ntnudge), & + dumqadv (nknudge,ntnudge), & + dumladv (nknudge,ntnudge), & + dumiadv (nknudge,ntnudge), & + dumtadv (nknudge,ntnudge), & + dumswnet (nknudgep1,ntnudge), & + dumlwnet (nknudgep1,ntnudge), & + dumheights (nknudges), & + dumtsoilav (nknudges,ntnudge), & + dumphiwav (nknudges,ntnudge), & + dumswi (nknudges,ntnudge) & + ) + + + !--- timeseries --- + + ! time + STATUS = NF90_INQ_VARID(NCID, 'time', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_time, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) +! write(6,'(a30,5f10.2)') 'inittestbed: tb_time:',& +! tb_time(1),tb_time(2),tb_time(3),tb_time(ntnudge-1),tb_time(ntnudge) + + ! surface pressure + STATUS = NF90_INQ_VARID(NCID, 'ps', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_ps, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! surface temperature + STATUS = NF90_INQ_VARID(NCID, 't_skin', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_thls, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! surface humidity +! STATUS = NF90_INQ_VARID(NCID, '', VARID) +! if (STATUS .ne. nf90_noerr) call handle_err(STATUS) +! STATUS = NF90_GET_VAR (NCID, VARID, tb_qts, start=(/1/), count=(/ntnudge/) ) +! if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! surface T flux + STATUS = NF90_INQ_VARID(NCID, 'sfc_sens_flx', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_wts, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! surface q flux + STATUS = NF90_INQ_VARID(NCID, 'sfc_lat_flx', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_wqs, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + + rho = tb_ps(i) / (rd * tb_thls(i)) + tb_wts(i) = -tb_wts(i) / (cp * rho) !Change sign: upward = positive in LES, but by convention upward = negative in most GCMs. + tb_wqs(i) = -tb_wqs(i) / (rlv * rho) + + iexner = (tb_ps(i)/pref0)**(-rd/cp) + tb_thls(i) = iexner * tb_thls(i) + + end do + + ! roughness length for momentum + STATUS = NF90_INQ_VARID(NCID, 'mom_rough', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_z0m, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! roughness length for heat and moisture + STATUS = NF90_INQ_VARID(NCID, 'heat_rough', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_z0h, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! surface albedo, for radiation + STATUS = NF90_INQ_VARID(NCID, 'albedo', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, tb_alb, start=(/1/), count=(/ntnudge/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + + + !--- profiles full levels --- + start2 = (/ 1 , 1 /) + count2 = (/ nknudge, ntnudge /) + + ! height + STATUS = NF90_INQ_VARID(NCID, 'height_f', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumheight, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) +! write(6,'(a30,91f10.2)') 'inittestbed: heightnudge:',& +! & ( dumheight(k,1),k=1,nknudge ) + + ! u + STATUS = NF90_INQ_VARID(NCID, 'u', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumu, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! v + STATUS = NF90_INQ_VARID(NCID, 'v', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! qt + STATUS = NF90_INQ_VARID(NCID, 'q', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumqv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + STATUS = NF90_INQ_VARID(NCID, 'ql', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumql, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + STATUS = NF90_INQ_VARID(NCID, 'qi', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumqi, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + do k=1,nknudge + dumqt(k,i) = dumqv(k,i) + dumql(k,i) + dumqi(k,i) + enddo + enddo + + ! thl + STATUS = NF90_INQ_VARID(NCID, 't', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumt, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + STATUS = NF90_INQ_VARID(NCID, 'pressure_f', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumpf, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + do k=1,nknudge + iexner = (dumpf(k,i)/pref0)**(-rd/cp) + dumthl(k,i) = dumt(k,i) * iexner - (rlv * dumql(k,i)) / cp + enddo + enddo + + ! Ozone + STATUS = NF90_INQ_VARID(NCID, 'o3', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumo3, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! w + STATUS = NF90_INQ_VARID(NCID, 'omega', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumomega, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + do k=1,nknudge + tv = dumt(k,i) * (1.+0.61*dumqv(k,i)) + rho = dumpf(k,i) / (rd*tv) + dumw(k,i) = - dumomega(k,i) / ( rho * grav ) !convert from Pa/s to m/s + enddo + enddo + + ! ug + STATUS = NF90_INQ_VARID(NCID, 'ug', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumug, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! vg + STATUS = NF90_INQ_VARID(NCID, 'vg', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumvg, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! uadv + STATUS = NF90_INQ_VARID(NCID, 'uadv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumuadv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! vadv + STATUS = NF90_INQ_VARID(NCID, 'vadv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumvadv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! qtadv + STATUS = NF90_INQ_VARID(NCID, 'qadv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumqadv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + STATUS = NF90_INQ_VARID(NCID, 'ladv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumladv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + STATUS = NF90_INQ_VARID(NCID, 'iadv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumiadv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + do k=1,nknudge + dumqtadv(k,i) = dumqadv(k,i) + dumladv(k,i) + dumiadv(k,i) + enddo + enddo + + ! thladv + STATUS = NF90_INQ_VARID(NCID, 'tadv', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumtadv, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + do k=1,nknudge + iexner = (dumpf(k,i)/pref0)**(-rd/cp) + dumthladv(k,i) = dumtadv(k,i) * iexner + enddo + enddo + + + + !--- profiles half levels --- + start2 = (/ 1 , 1 /) + count2 = (/ nknudgep1, ntnudge /) + + ! net SW downward flux + STATUS = NF90_INQ_VARID(NCID, 'fradSWnet', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumswnet, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! net LW downward flux + STATUS = NF90_INQ_VARID(NCID, 'fradLWnet', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumlwnet, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + do i=1,ntnudge + tb_Qnet(i) = dumswnet(nknudgep1,i) + dumlwnet(nknudgep1,i) !flux at surface is stored in lowest half level of profile +! write(6,*) "modtestbed: qnet:",i,tb_Qnet(i),nknudge,nknudgep1 + enddo + + + !--- soil profiles --- + + STATUS = NF90_INQ_VARID(NCID, 'h_soil', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumheights, start=(/1/), count=(/nknudges/) ) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + start2 = (/ 1 , 1 /) + count2 = (/ nknudges, ntnudge /) + + ! tsoilav + STATUS = NF90_INQ_VARID(NCID, 't_soil', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumtsoilav, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! phiwav + STATUS = NF90_INQ_VARID(NCID, 'q_soil', VARID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + STATUS = NF90_GET_VAR (NCID, VARID, dumphiwav, start=start2, count=count2) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + ! field capacity + status = nf90_inquire_attribute(ncid, nf90_global, "field_capacity") + if (status /= nf90_noerr) call handle_err(status) + status = nf90_get_att(ncid, nf90_global, "field_capacity", dumphifc) + if (status /= nf90_noerr) call handle_err(status) + + ! wilting point + status = nf90_inquire_attribute(ncid, nf90_global, "wilting_point") + if (status /= nf90_noerr) call handle_err(status) + status = nf90_get_att(ncid, nf90_global, "wilting_point", dumphiwp) + if (status /= nf90_noerr) call handle_err(status) + + dumswi = ( dumphiwav - dumphiwp ) / ( dumphifc - dumphiwp ) !soil wetness index, using input values for wilting point and field capacity + + + + !--- close nc file --- + STATUS = NF90_CLOSE(NCID) + if (STATUS .ne. nf90_noerr) call handle_err(STATUS) + + + + do i=1,ntnudge + + + !--- interpolate towards LES levels, reverse height-order, switch dimensions --- + ik = nknudge + do k=1,k1 + + do while( zf(k).gt.dumheight(ik,i) .and. ik.gt.1) + ik=ik-1 + enddo + if ( ik.lt.nknudge ) then + ik=ik+1 + endif + + fac = ( zf(k)-dumheight(ik,i) ) / ( dumheight(ik-1,i)-dumheight(ik,i) ) + + tb_thl (i,k) = dumthl (ik,i) + fac * ( dumthl (ik-1,i) - dumthl (ik,i) ) + tb_qt (i,k) = dumqt (ik,i) + fac * ( dumqt (ik-1,i) - dumqt (ik,i) ) + tb_u (i,k) = dumu (ik,i) + fac * ( dumu (ik-1,i) - dumu (ik,i) ) + tb_v (i,k) = dumv (ik,i) + fac * ( dumv (ik-1,i) - dumv (ik,i) ) + tb_w (i,k) = dumw (ik,i) + fac * ( dumw (ik-1,i) - dumw (ik,i) ) + tb_ug (i,k) = dumug (ik,i) + fac * ( dumug (ik-1,i) - dumug (ik,i) ) + tb_vg (i,k) = dumvg (ik,i) + fac * ( dumvg (ik-1,i) - dumvg (ik,i) ) + tb_uadv (i,k) = dumuadv (ik,i) + fac * ( dumuadv (ik-1,i) - dumuadv (ik,i) ) + tb_vadv (i,k) = dumvadv (ik,i) + fac * ( dumvadv (ik-1,i) - dumvadv (ik,i) ) + tb_qtadv (i,k) = dumqtadv (ik,i) + fac * ( dumqtadv (ik-1,i) - dumqtadv (ik,i) ) + tb_thladv (i,k) = dumthladv (ik,i) + fac * ( dumthladv (ik-1,i) - dumthladv (ik,i) ) + + !if (i.eq.1) write(6,*) k, zf(k), " : ", ik, dumheight(ik,i), ik-1, dumheight(ik-1,i) + + enddo + + + !--- soil & surface properties --- + tb_qts(i) = tb_qt(i,1) !qts seems not really used anymore (see subr. timedepsurf in modtimedep.f90) + +! if (i.eq.1) then +! do k=1,nknudges +! write(6,*) "modtestbed: soil: ", k, dumheights(k), dumtsoilav(k,i), dumphiwav(k,i) +! end do +! end if + + !dzsoil + + !tb_tsoilav(i,:) = dumtsoilav(:,i) + + !tb_phiwav (i,:) = phiwp + dumswi(:,i) * (phifc - phiwp ) !scale soil moisture using field capacity and wilting point + do k = 1, nknudge + tbrad_p(i,k) = dumpf(k,i) + tbrad_t(i,k) = dumt(k,i) + tbrad_qv(i,k) = dumqv(k,i) + tbrad_ql(i,k) = dumql(k,i) + dumqi(k,i) + tbrad_o3(i,k) = dumo3(k,i) + end do + + enddo + + + !--- clean-up --- + deallocate(dumomega) + deallocate(dumqv) + deallocate(dumql) + deallocate(dumqi) + deallocate(dumt) + deallocate(dumpf) + deallocate(dumo3) + + deallocate(dumheight) + deallocate(dumqt) + deallocate(dumthl) + deallocate(dumu) + deallocate(dumv) + deallocate(dumw) + deallocate(dumug) + deallocate(dumvg) + + deallocate(dumuadv) + deallocate(dumvadv) + deallocate(dumqtadv) + deallocate(dumthladv) + deallocate(dumqadv) + deallocate(dumladv) + deallocate(dumiadv) + deallocate(dumtadv) + deallocate(dumswnet) + deallocate(dumlwnet) + + deallocate(dumheights) + deallocate(dumtsoilav) + deallocate(dumphiwav) + deallocate(dumswi) + + + !--- do some output to screen --- +! do i=1,2 +! !do i=1,ntnudge +! +! write(6,'(a20,f10.2,a15,3f10.2)') 'modtestbed: scm_in time:',tb_time(i),' sfc pressure:',tb_ps(i),tb_thls(i),tb_qts(i) +! +! write(6,*) ' zf tnudge tb_u tb_v tb_w tb_thl tb_qt tb_ug tb_vg' +! do k=kmax,1,-1 +! write (6,'(f7.1,8e12.4)') & +! zf (k), & +! tnudge (i,k), & +! tb_u (i,k), & +! tb_v (i,k), & +! tb_w (i,k), & +! tb_thl (i,k), & +! tb_qt (i,k), & +! tb_ug (i,k), & +! tb_vg (i,k) +! end do +! +! end do + + end if + + call MPI_BCAST(ntnudge , 1,MPI_INTEGER,0,comm3d,mpierr) + + call MPI_BCAST(tb_time ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_ps ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_qts ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_thls ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_wts ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_wqs ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_z0h ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_z0m ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_Qnet ,ntnudge ,MY_REAL ,0,comm3d,mpierr) + + call MPI_BCAST(tnudge ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_u ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_v ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_w ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_thl ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_qt ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_ug ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_vg ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_uadv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_vadv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_qtadv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_thladv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_uadv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_vadv ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_dqtdxls ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_dqtdyls ,ntnudge*k1,MY_REAL ,0,comm3d,mpierr) + + call MPI_BCAST(tb_tsoilav ,ntnudge*ksoilmax,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tb_phiwav ,ntnudge*ksoilmax,MY_REAL ,0,comm3d,mpierr) + + call MPI_BCAST(tbrad_p ,ntnudge*nknudge,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tbrad_qv ,ntnudge*nknudge,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tbrad_ql ,ntnudge*nknudge,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tbrad_t ,ntnudge*nknudge,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(tbrad_o3 ,ntnudge*nknudge,MY_REAL ,0,comm3d,mpierr) + + ltb_u = any(abs(tb_u)>1e-8) + ltb_v = any(abs(tb_v)>1e-8) + ltb_w = any(abs(tb_w)>1e-8) + ltb_thl = any(abs(tb_thl)>1e-8) + ltb_qt = any(abs(tb_qt)>1e-8) + + + end subroutine inittestbed + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine testbednudge + use modglobal, only : rtimee,i1,j1,k1,kmax,rdt + use modfields, only : up,vp,wp,thlp, qtp,u0av,v0av,qt0av,thl0av + use modmpi, only : myid + implicit none + + integer k,t + real :: dtm,dtp,currtnudge, qttnudge,qtthres + + if (.not.(ltestbed .and. ltb_nudge)) return + + if (rtimee==0) return + + t=1 + do while(rtimee>tb_time(t)) + t=t+1 + end do + if (rtimee/=tb_time(1)) then + t=t-1 + end if + + dtm = ( rtimee-tb_time(t) ) / ( tb_time(t+1)-tb_time(t) ) + dtp = ( tb_time(t+1)-rtimee)/ ( tb_time(t+1)-tb_time(t) ) + + qtthres = 1e-6 + do k=1,kmax + + currtnudge = max(rdt,tnudge(k,t)*dtp+tnudge(k,t+1)*dtm) + + if (ltb_u) up(2:i1,2:j1,k) = up(2:i1,2:j1,k) - & + ( u0av(k) - (tb_u(t,k) *dtp + tb_u(t+1,k) *dtm) ) / currtnudge + + if (ltb_v) vp(2:i1,2:j1,k) = vp(2:i1,2:j1,k) - & + ( v0av(k) - (tb_v(t,k) *dtp + tb_v(t+1,k) *dtm) ) / currtnudge + + if (ltb_w) wp(2:i1,2:j1,k) = wp(2:i1,2:j1,k) - & + ( - (tb_w(t,k) *dtp + tb_w(t+1,k) *dtm) ) / currtnudge + + if (ltb_thl) thlp(2:i1,2:j1,k) = thlp(2:i1,2:j1,k) - & + ( thl0av(k) - (tb_thl(t,k)*dtp + tb_thl(t+1,k)*dtm) ) / currtnudge + + if (ltb_qt) then + if (qt0av(k)< qtthres) then + qttnudge = rdt + else + qttnudge = currtnudge + end if + qtp(2:i1,2:j1,k) = qtp(2:i1,2:j1,k) - & + ( qt0av(k) - (tb_qt(t,k) *dtp + tb_qt(t+1,k) *dtm) ) / qttnudge + end if + end do + + !write(6,*) 'testbednudge:', rtimee, t, tb_time(t), tb_time(t+1), currtnudge, dtm, dtp, qt0av (1),tb_qt (t,1),tb_qt (t+1,1) + !write(6,*) 'testbednudge:', rtimee, t, tb_time(t), tb_time(t+1), currtnudge, dtm, dtp, qt0av (kmax),tb_qt (t,kmax),tb_qt (t+1,kmax) + + !write(6,*) 'testbednudge:', rtimee, t, tb_time(t), tb_time(t+1), currtnudge, dtm, dtp, thl0av(1),tb_thl(t,1),tb_thl(t+1,1) + !write(6,*) 'testbednudge:', rtimee, t, tb_time(t), tb_time(t+1), currtnudge, dtm, dtp, thl0av(kmax),tb_thl(t,kmax),tb_thl(t+1,kmax) + + end subroutine testbednudge +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine testbed_getinttime(t, dtm, dtp) + use modglobal, only : rtimee +! use modfields, only : up,vp,wp,thlp, qtp,u0av,v0av,qt0av,thl0av +! use modmpi, only : myid + implicit none + integer, intent(out) :: t + real, intent(out) :: dtm, dtp + + + t=1 + do while(rtimee>tb_time(t)) + t=t+1 + end do + if (rtimee/=tb_time(1)) then + t=t-1 + end if + + dtm = ( rtimee-tb_time(t) ) / ( tb_time(t+1)-tb_time(t) ) + dtp = ( tb_time(t+1)-rtimee)/ ( tb_time(t+1)-tb_time(t) ) + + + end subroutine testbed_getinttime + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine exittestbed + if (allocated(tb_time)) then + deallocate(tb_time) + end if + end subroutine exittestbed + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine handle_err(errcode) + + implicit none + + integer errcode + + write(6,*) 'Error: ', nf90_strerror(errcode) + stop 2 + + end subroutine handle_err + + +end module modtestbed diff --git a/src/modtimedep.f90 b/src/modtimedep.f90 index 0e6656c4..8d67d4d2 100644 --- a/src/modtimedep.f90 +++ b/src/modtimedep.f90 @@ -1,8 +1,8 @@ -!> \file modtimedepsv.f90 -!! Prescribes surface values, fluxes and LS forcings at certain times for scalars +!> \file modtimedep.f90 +!! Prescribes surface values, fluxes and LS forcings at certain times !> -!! Prescribes surface values, fluxes and LS forcings at certain times for scalars +!! Prescribes surface values, fluxes and LS forcings at certain times !> !! \author Roel Neggers, KNMI !! \author Thijs Heus,MPI-M @@ -42,14 +42,16 @@ module modtimedep logical :: ltimedepz = .true. !< Switch for large scale forcings logical :: ltimedepsurf = .true. !< Switch for surface fluxes - integer, parameter :: kflux = 100 - integer, parameter :: kls = 100 + integer :: kflux + integer :: kls + real, allocatable :: timeflux (:) real, allocatable :: wqsurft (:) real, allocatable :: wtsurft (:) real, allocatable :: thlst (:) real, allocatable :: qtst (:) real, allocatable :: pst (:) + real, allocatable :: Qnetavt (:) real, allocatable :: timels (:) real, allocatable :: ugt (:,:) @@ -58,7 +60,10 @@ module modtimedep real, allocatable :: dqtdxlst(:,:) real, allocatable :: dqtdylst(:,:) real, allocatable :: dqtdtlst(:,:) + real, allocatable :: dthldtlst(:,:) real, allocatable :: thlpcart(:,:) + real, allocatable :: dudtlst (:,:) + real, allocatable :: dvdtlst (:,:) real, allocatable :: thlproft(:,:) real, allocatable :: qtproft (:,:) @@ -68,9 +73,15 @@ module modtimedep !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine inittimedep use modmpi, only :myid,my_real,mpi_logical,mpierr,comm3d - use modglobal, only :btime,cexpnr,k1,kmax,ifinput,runtime,tres - use modsurfdata,only :ps,qts,wqsurf,wtsurf,thls + use modglobal, only :btime,cexpnr,k1,kmax,ifinput,runtime,zf,tres + use modsurfdata,only :ps,qts,wqsurf,wtsurf,thls, Qnetav use modtimedepsv, only : inittimedepsv + + use modtestbed, only : ltestbed,ntnudge,& + tb_time,tb_ps,tb_qts,tb_thls,tb_wqs,tb_wts,& + tb_w,tb_ug,tb_vg,& + tb_uadv,tb_vadv,tb_qtadv,tb_thladv,tb_Qnet + implicit none character (80):: chmess @@ -80,120 +91,189 @@ subroutine inittimedep real, allocatable, dimension (:) :: height if (.not. ltimedep) return - allocate(height(k1)) + if (ltestbed) then + kflux = ntnudge + kls = ntnudge + else + kflux = 100 + kls = 100 + end if + + allocate(height (k1)) + allocate(timeflux (0:kflux)) allocate(wqsurft (kflux)) allocate(wtsurft (kflux)) - allocate(timels (0:kls)) - allocate(ugt (k1,kls)) - allocate(vgt (k1,kls)) - allocate(wflst (k1,kls)) - allocate(dqtdxlst(k1,kls)) - allocate(dqtdylst(k1,kls)) - allocate(dqtdtlst(k1,kls)) - allocate(thlpcart(k1,kls)) - allocate(thlproft(k1,kls)) - allocate(qtproft(k1,kls)) - allocate(thlst (0:kls)) - allocate(qtst (0:kls)) - allocate(pst (0:kls)) + allocate(thlst (kflux)) + allocate(qtst (kflux)) + allocate(pst (kflux)) + allocate(Qnetavt (kflux)) + + allocate(timels (0:kls)) + allocate(ugt (k1,kls)) + allocate(vgt (k1,kls)) + allocate(wflst (k1,kls)) + + allocate(dqtdxlst (k1,kls)) + allocate(dqtdylst (k1,kls)) + + allocate(dqtdtlst (k1,kls)) + allocate(dthldtlst(k1,kls)) + allocate(dudtlst (k1,kls)) + allocate(dvdtlst (k1,kls)) + + allocate(thlpcart (k1,kls)) + + allocate(thlproft (k1,kls)) + allocate(qtproft (k1,kls)) timeflux = 0 + timels = 0 + wqsurft = wqsurf wtsurft = wtsurf thlst = thls qtst = qts pst = ps + Qnetavt = Qnetav - timels = 0 ugt = 0 vgt = 0 wflst = 0 + dqtdxlst = 0 dqtdylst = 0 + dqtdtlst = 0 + dthldtlst= 0 + dudtlst = 0 + dvdtlst = 0 + thlpcart = 0 + thlproft = 0 qtproft = 0 if (myid==0) then -! --- load lsforcings--- - - - open(ifinput,file='ls_flux.inp.'//cexpnr) - read(ifinput,'(a80)') chmess - write(6,*) chmess - read(ifinput,'(a80)') chmess - write(6,*) chmess - read(ifinput,'(a80)') chmess - write(6,*) chmess + !--- load lsforcings--- timeflux = 0 timels = 0 + if (ltestbed) then + + write(*,*) 'inittimedep: testbed mode: data for time-dependent forcing obtained from scm_in.nc' + + timeflux(1:kflux) = tb_time + timels (1:kls ) = tb_time + + pst = tb_ps + qtst = tb_qts + thlst = tb_thls + wqsurft = tb_wqs + wtsurft = tb_wts + Qnetavt = tb_Qnet + + height (:) = zf + do t=1,kls + ugt (:,t) = tb_ug (t,:) + vgt (:,t) = tb_vg (t,:) + wflst (:,t) = tb_w (t,:) + dqtdxlst (:,t) = 0. + dqtdylst (:,t) = 0. + dqtdtlst (:,t) = tb_qtadv (t,:) + dthldtlst(:,t) = tb_thladv(t,:) + dudtlst (:,t) = tb_uadv (t,:) + dvdtlst (:,t) = tb_vadv (t,:) + end do -! --- load fluxes--- - - t = 0 - ierr = 0 - do while (timeflux(t) < (tres*real(btime)+runtime)) - t=t+1 - read(ifinput,*, iostat = ierr) timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t) - write(*,'(i8,6e12.4)') t,timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t) - if (ierr < 0) then + else + + open(ifinput,file='ls_flux.inp.'//cexpnr) + read(ifinput,'(a80)') chmess + write(6,*) chmess + read(ifinput,'(a80)') chmess + write(6,*) chmess + read(ifinput,'(a80)') chmess + write(6,*) chmess + + timeflux = 0 + timels = 0 + + + !--- load fluxes--- + t = 0 + ierr = 0 + do while (timeflux(t) < (tres*real(btime)+runtime)) + t=t+1 + read(ifinput,*, iostat = ierr) timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) + write(*,'(i8,7e12.4)') t,timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) + if (ierr < 0) then stop 'STOP: No time dependend data for end of run (surface fluxes)' - end if - end do - if(timeflux(1)>(tres*real(btime)+runtime)) then + end if + end do + if(timeflux(1)>(tres*real(btime)+runtime)) then write(6,*) 'Time dependent surface variables do not change before end of' write(6,*) 'simulation. --> only large scale forcings' ltimedepsurf=.false. - endif -! flush to the end of fluxlist - do while (ierr ==0) - read (ifinput,*,iostat=ierr) dummyr - end do - backspace (ifinput) -! ---load large scale forcings---- - - t = 0 - - do while (timels(t) < (tres*real(btime)+runtime)) - t = t + 1 - chmess1 = "#" - ierr = 1 ! not zero - !search for the next line consisting of "# time", from there onwards the profiles will be read - do while (.not.(chmess1 == "#" .and. ierr ==0)) - read(ifinput,*,iostat=ierr) chmess1,timels(t) - if (ierr < 0) then - stop 'STOP: No time dependend data for end of run' - end if - end do - write (*,*) 'timels = ',timels(t) - do k=1,kmax - read (ifinput,*) & - height (k) , & - ugt (k,t), & - vgt (k,t), & - wflst (k,t), & - dqtdxlst(k,t), & - dqtdylst(k,t), & - dqtdtlst(k,t), & - thlpcart(k,t) + endif + ! flush to the end of fluxlist + do while (ierr ==0) + read (ifinput,*,iostat=ierr) dummyr end do - do k=kmax,1,-1 - write (6,'(3f7.1,5e12.4)') & - height (k) , & - ugt (k,t), & - vgt (k,t), & - wflst (k,t), & - dqtdxlst(k,t), & - dqtdylst(k,t), & - dqtdtlst(k,t), & - thlpcart(k,t) + backspace (ifinput) + + + !---load large scale forcings---- + t = 0 + do while (timels(t) < (runtime+btime)) + t = t + 1 + chmess1 = "#" + ierr = 1 ! not zero + do while (.not.(chmess1 == "#" .and. ierr ==0)) !search for the next line consisting of "# time", from there onwards the profiles will be read + read(ifinput,*,iostat=ierr) chmess1,timels(t) + if (ierr < 0) then + stop 'STOP: No time dependend data for end of run' + end if + end do + write (*,*) 'timels = ',timels(t) + do k=1,kmax + read (ifinput,*) & + height (k) , & + ugt (k,t), & + vgt (k,t), & + wflst (k,t), & + dqtdxlst(k,t), & + dqtdylst(k,t), & + dqtdtlst(k,t), & + thlpcart(k,t) + end do end do - end do + + close(ifinput) + + end if !ltestbed + + +! do k=kmax,1,-1 +! write (6,'(3f7.1,5e12.4)') & +! height (k) , & +! ugt (k,t), & +! vgt (k,t), & +! wflst (k,t), & +! dqtdxlst(k,t), & +! dqtdylst(k,t), & +! dqtdtlst(k,t), & +! thlpcart(k,t) +! end do + + + if(timeflux(1)>(runtime+btime)) then + write(6,*) 'Time dependent surface variables do not change before end of' + write(6,*) 'simulation. --> only large scale forcings' + ltimedepsurf=.false. + endif if ((timels(1) > (tres*real(btime)+runtime)) .or. (timeflux(1) > (tres*real(btime)+runtime))) then write(6,*) 'Time dependent large scale forcings sets in after end of simulation -->' @@ -211,6 +291,7 @@ subroutine inittimedep call MPI_BCAST(thlst ,kflux,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(qtst ,kflux,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(pst ,kflux,MY_REAL,0,comm3d,mpierr) + call MPI_BCAST(Qnetavt ,kflux,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(timels(1:kls) ,kls,MY_REAL ,0,comm3d,mpierr) call MPI_BCAST(ugt ,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(vgt ,kmax*kls,MY_REAL,0,comm3d,mpierr) @@ -218,12 +299,16 @@ subroutine inittimedep call MPI_BCAST(dqtdxlst,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(dqtdylst,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(dqtdtlst,kmax*kls,MY_REAL,0,comm3d,mpierr) + call MPI_BCAST(dthldtlst,kmax*kls,MY_REAL,0,comm3d,mpierr) + call MPI_BCAST(dudtlst,kmax*kls,MY_REAL,0,comm3d,mpierr) + call MPI_BCAST(dvdtlst,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(thlpcart,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(thlproft,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(qtproft ,kmax*kls,MY_REAL,0,comm3d,mpierr) call MPI_BCAST(ltimedepsurf ,1,MPI_LOGICAL,0,comm3d,mpierr) call MPI_BCAST(ltimedepz ,1,MPI_LOGICAL,0,comm3d,mpierr) + call inittimedepsv call timedep @@ -264,10 +349,17 @@ subroutine timedep end subroutine timedep subroutine timedepz - use modfields, only : ug, vg, dqtdtls,dqtdxls,dqtdyls, wfls,whls, & - thlpcar,dthldxls,dthldyls,dudxls,dudyls,dvdxls,dvdyls,dpdxl,dpdyl + use modfields, only : ug, vg, wfls,whls,thlprof,qtprof, & + dqtdtls,dqtdxls,dqtdyls, & + dthldtls,dthldxls,dthldyls,thlpcar, & + dudtls,dudxls,dudyls, & + dvdtls,dvdxls,dvdyls, & + dpdxl,dpdyl, & + u0,v0,w0,u0av,v0av,e120,rhobf use modglobal, only : rtimee,om23_gs,dzf,dzh,k1,kmax,llsadv + use modtestbed, only : ltestbed use modmpi, only : myid + implicit none integer t,k @@ -285,13 +377,16 @@ subroutine timedepz end if fac = ( rtimee-timels(t) ) / ( timels(t+1)-timels(t) ) - ug = ugt (:,t) + fac * ( ugt (:,t+1) - ugt (:,t) ) - vg = vgt (:,t) + fac * ( vgt (:,t+1) - vgt (:,t) ) - wfls = wflst (:,t) + fac * ( wflst (:,t+1) - wflst (:,t) ) - dqtdxls = dqtdxlst(:,t) + fac * ( dqtdxlst(:,t+1) - dqtdxlst(:,t) ) - dqtdyls = dqtdylst(:,t) + fac * ( dqtdylst(:,t+1) - dqtdylst(:,t) ) - dqtdtls = dqtdtlst(:,t) + fac * ( dqtdtlst(:,t+1) - dqtdtlst(:,t) ) - thlpcar = thlpcart(:,t) + fac * ( thlpcart(:,t+1) - thlpcart(:,t) ) + ug = ugt (:,t) + fac * ( ugt (:,t+1) - ugt (:,t) ) + vg = vgt (:,t) + fac * ( vgt (:,t+1) - vgt (:,t) ) + wfls = wflst (:,t) + fac * ( wflst (:,t+1) - wflst (:,t) ) + dqtdxls = dqtdxlst (:,t) + fac * ( dqtdxlst (:,t+1) - dqtdxlst (:,t) ) + dqtdyls = dqtdylst (:,t) + fac * ( dqtdylst (:,t+1) - dqtdylst (:,t) ) + dqtdtls = dqtdtlst (:,t) + fac * ( dqtdtlst (:,t+1) - dqtdtlst (:,t) ) + dthldtls = dthldtlst(:,t) + fac * ( dthldtlst(:,t+1) - dthldtlst(:,t) ) + dudtls = dudtlst (:,t) + fac * ( dudtlst (:,t+1) - dudtlst (:,t) ) + dvdtls = dvdtlst (:,t) + fac * ( dvdtlst (:,t+1) - dvdtlst (:,t) ) + thlpcar = thlpcart (:,t) + fac * ( thlpcart (:,t+1) - thlpcart (:,t) ) do k=1,kmax @@ -319,12 +414,13 @@ subroutine timedepz dthldxls = 0.0 dthldyls = 0.0 + return end subroutine timedepz subroutine timedepsurf use modglobal, only : rtimee, lmoist - use modsurfdata, only : wtsurf,wqsurf,thls,qts,ps + use modsurfdata, only : wtsurf,wqsurf,thls,qts,ps, Qnetav use modsurface, only : qtsurf implicit none integer t @@ -345,6 +441,7 @@ subroutine timedepsurf wtsurf = wtsurft(t) + fac * ( wtsurft(t+1) - wtsurft(t) ) thls = thlst(t) + fac * ( thlst(t+1) - thlst(t) ) ps = pst(t) + fac * ( pst(t+1) - pst(t) ) + Qnetav = Qnetavt(t) + fac * ( Qnetavt(t+1) - Qnetavt(t) ) !cstep: not necessary to provide qts in ls_flux file qts = qtst(t) + fac * ( qtst(t+1) - qtst(t) ) if (lmoist) then call qtsurf @@ -360,8 +457,8 @@ subroutine exittimedep use modtimedepsv, only : exittimedepsv implicit none if (.not. ltimedep) return - deallocate(timels,ugt,vgt,wflst,dqtdxlst,dqtdylst,dqtdtlst,thlpcart) - deallocate(timeflux, wtsurft,wqsurft,thlst,qtst,pst) + deallocate(timels,ugt,vgt,wflst,dqtdxlst,dqtdylst,dqtdtlst,dthldtlst,dudtlst,dvdtlst,thlpcart) + deallocate(timeflux, wtsurft,wqsurft,thlst,qtst,pst,Qnetavt) call exittimedepsv end subroutine diff --git a/src/modtimedepsv.f90 b/src/modtimedepsv.f90 index e56d4045..22b99f49 100644 --- a/src/modtimedepsv.f90 +++ b/src/modtimedepsv.f90 @@ -35,9 +35,10 @@ module modtimedepsv implicit none private -public :: inittimedepsv, timedepsv,exittimedepsv +public :: inittimedepsv, timedepsv,ltimedepsv,exittimedepsv save ! switches for timedependent surface fluxes and large scale forcings + logical :: ltimedepsv = .false. !< Overall switch, input in namoptions logical :: ltimedepsvz = .false. !< Switch for large scale forcings logical :: ltimedepsvsurf = .true. !< Switch for surface fluxes @@ -64,7 +65,8 @@ subroutine inittimedepsv integer :: k,t,n, ierr real :: dummyr real, allocatable, dimension (:) :: height - if (nsv==0) return + + if (nsv==0 .or. .not.ltimedepsv ) return allocate(height(k1)) allocate(timesvsurf (0:kflux)) @@ -165,7 +167,7 @@ subroutine timedepsv use modglobal, only : nsv implicit none - if(nsv==0) return + if(nsv==0 .or. .not.ltimedepsv) return call timedepsvz call timedepsvsurf @@ -209,7 +211,7 @@ end subroutine timedepsvsurf subroutine exittimedepsv use modglobal, only : nsv implicit none - if (nsv==0) return + if (nsv==0 .or. .not.ltimedepsv) return deallocate(timesvz,svzt,timesvsurf) end subroutine exittimedepsv diff --git a/src/program.f90 b/src/program.f90 index a080494e..58a990d8 100644 --- a/src/program.f90 +++ b/src/program.f90 @@ -144,6 +144,7 @@ program DALES !Version 4.0.0alpha !use modtilt, only : inittilt, tiltedgravity, tiltedboundary, exittilt !use modparticles, only : initparticles, particles, exitparticles use modnudge, only : initnudge, nudge, exitnudge + use modtestbed, only : inittestbed, testbednudge, exittestbed !use modprojection, only : initprojection, projection use modchem, only : initchem,twostep use modcanopy, only : initcanopy, canopy, exitcanopy @@ -235,6 +236,7 @@ program DALES !Version 4.0.0alpha ! 3.4 EXECUTE ADD ONS !------------------------------------------------------ call nudge + call testbednudge ! call dospecs ! call tiltedgravity @@ -300,6 +302,7 @@ program DALES !Version 4.0.0alpha call exitlsmstat !call exitparticles call exitnudge + call exittestbed call exitsampling call exitquadrant call exitsamptend From dd5d7b7d05e8881a4dad8e3640737c65b989157e Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 14:06:20 -0400 Subject: [PATCH 08/88] Exit based on wall clock time --- src/modglobal.f90 | 2 +- src/modmpi.f90 | 8 +++++++ src/modstartup.f90 | 55 +++++++++++++++++++--------------------------- src/program.f90 | 13 +++++++++-- 4 files changed, 43 insertions(+), 35 deletions(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index 012653a5..5c507c0c 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -171,7 +171,7 @@ module modglobal integer :: ntimee !< * number of timesteps since the cold start integer :: ntrun !< * number of timesteps since the start of the run integer(kind=longint) :: timeleft - + real :: wctime=8640000. !< * The maximum wall clock time of a simulation (set to 100 days by default) logical :: ladaptive = .false. !< * adaptive timestepping on or off real :: courant = -1 diff --git a/src/modmpi.f90 b/src/modmpi.f90 index aa5be7fd..f2046359 100644 --- a/src/modmpi.f90 +++ b/src/modmpi.f90 @@ -424,6 +424,14 @@ subroutine slabsum(aver,ks,kf,var,ib,ie,jb,je,kb,ke,ibs,ies,jbs,jes,kbs,kes) return end subroutine slabsum + + subroutine mpi_get_time(val) + real, intent(out) :: val + + val = MPI_Wtime() + call MPI_BCAST(val,1,MY_REAL ,0,comm3d,mpierr) + + end subroutine mpi_get_time ! Gather a variable l(imax,jmax) along a row (ie. constant myidy) ! into g(itot,jmax) at the processor with myix=0 diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 3d10dbf3..984accc1 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -53,7 +53,7 @@ subroutine startup ! Thijs Heus 15/06/2007 | !-----------------------------------------------------------------| - use modglobal, only : initglobal,iexpnr,runtime, dtmax,dtav_glob,timeav_glob,& + use modglobal, only : initglobal,iexpnr,runtime, dtmax, wctime, dtav_glob,timeav_glob,& lwarmstart,startfile,trestart,& nsv,itot,jtot,kmax,xsize,ysize,xlat,xlon,xday,xtime,& lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,llstend,& @@ -82,7 +82,7 @@ subroutine startup !declare namelists namelist/RUN/ & - iexpnr,lwarmstart,startfile,runtime,dtmax,dtav_glob,timeav_glob,& + iexpnr,lwarmstart,startfile,runtime,dtmax,wctime,dtav_glob,timeav_glob,& trestart,irandom,randthl,randqt,krand,nsv,courant,peclet,ladaptive,author,& krandumin, krandumax, randu,& nprocx,nprocy @@ -156,6 +156,7 @@ subroutine startup call MPI_BCAST(trestart ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(dtmax ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(dtav_glob ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(wctime ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(timeav_glob,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(nsv ,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(nprocx ,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) @@ -900,26 +901,23 @@ subroutine writerestartfiles use modsubgriddata, only : ekm implicit none - logical :: lexitnow = .false. integer imin,ihour integer i,j,k,n character(50) name,linkname if (timee == 0) return - if (rk3step /=3) return - name = 'exit_now.'//cexpnr - inquire(file=trim(name), EXIST=lexitnow) + if (rk3Step/=3) return if (timee=tnextrestart .or. lexitnow) then + if (timee>=tnextrestart .or. timeleft==0) then tnextrestart = tnextrestart+itrestart ihour = floor(rtimee/3600) imin = floor((rtimee-ihour * 3600) /3600. * 60.) name = 'initd h m .' - write (name(6:7) ,'(i2.2)') ihour - write (name(9:10) ,'(i2.2)') imin - name(12:19)= cmyid - name(21:23)= cexpnr + write (name(6:8) ,'(i3.3)') ihour + write (name(10:11),'(i2.2)') imin + name(13:15)= cmyid + name(17:19)= cexpnr open (ifoutput,file=name,form='unformatted',status='replace') write(ifoutput) (((u0 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) @@ -959,14 +957,14 @@ subroutine writerestartfiles close (ifoutput) linkname = name linkname(6:11) = "latest" - call system("ln -sf "//name //" "//linkname) + call system("cp "//name //" "//linkname) if (nsv>0) then - name = 'inits h m .' - write (name(6:7) ,'(i2.2)') ihour - write (name(9:10) ,'(i2.2)') imin - name(12:19) = cmyid - name(21:23) = cexpnr + name = 'inits h m .' + write (name(6:8) ,'(i3.3)') ihour + write (name(10:11),'(i2.2)') imin + name(13:15) = cmyid + name(17:19) = cexpnr open (ifoutput,file=name,form='unformatted') write(ifoutput) ((((sv0(i,j,k,n),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1),n=1,nsv) write(ifoutput) (((svflux(i,j,n),i=1,i2),j=1,j2),n=1,nsv) @@ -976,16 +974,16 @@ subroutine writerestartfiles close (ifoutput) linkname = name linkname(6:11) = "latest" - call system("ln -sf "//name //" "//linkname) + call system("cp "//name //" "//linkname) end if if (isurf == 1) then - name = 'initl h m .' - write (name(6:7) ,'(i2.2)') ihour - write (name(9:10) ,'(i2.2)') imin - name(12:19) = cmyid - name(21:23) = cexpnr + name = 'initl h m .' + write (name(6:8) ,'(i3.3)') ihour + write (name(10:11),'(i2.2)') imin + name(13:15) = cmyid + name(17:19) = cexpnr open (ifoutput,file=name,form='unformatted') write(ifoutput) (((tsoil(i,j,k),i=1,i2),j=1,j2),k=1,ksoilmax) write(ifoutput) (((phiw(i,j,k),i=1,i2),j=1,j2),k=1,ksoilmax) @@ -1003,17 +1001,10 @@ subroutine writerestartfiles close (ifoutput) linkname = name linkname(6:11) = "latest" - call system("ln -sf "//name //" "//linkname) - end if - if (lexitnow) then - timeleft = 0 !jump out of the time loop - end if - if (lexitnow .and. myid == 0 ) then - open(1, file=trim(name), status='old') - close(1,status='delete') - write(*,*) 'Stopped at t=',rtimee + call system("cp "//name //" "//linkname) end if + if (myid==0) then write(*,'(A,F15.7,A,I4)') 'dump at time = ',rtimee,' unit = ',ifoutput end if diff --git a/src/program.f90 b/src/program.f90 index 58a990d8..535ab546 100644 --- a/src/program.f90 +++ b/src/program.f90 @@ -100,7 +100,8 @@ program DALES !Version 4.0.0alpha !!---------------------------------------------------------------- !! 0.0 USE STATEMENTS FOR CORE MODULES !!---------------------------------------------------------------- - use modglobal, only : rk3step,timeleft + use modglobal, only : rk3step,timeleft, wctime + use modmpi, only : mpi_get_time use modstartup, only : startup, writerestartfiles,exitmodules use modtimedep, only : timedep use modboundary, only : boundary, grwdamp! JvdD ,tqaver @@ -151,6 +152,7 @@ program DALES !Version 4.0.0alpha implicit none + real :: t0,t2 !---------------------------------------------------------------- ! 1 READ NAMELISTS,INITIALISE GRID, CONSTANTS AND FIELDS @@ -194,6 +196,8 @@ program DALES !Version 4.0.0alpha !------------------------------------------------------ ! 3.0 MAIN TIME LOOP !------------------------------------------------------ + call mpi_get_time(t0) + do while (timeleft>0 .or. rk3step < 3) call tstep_update ! Calculate new timestep call timedep @@ -285,8 +289,13 @@ program DALES !Version 4.0.0alpha call budgetstat !call stressbudgetstat call heterostats - + call mpi_get_time(t2) + if (t2-t0>=wctime) then + write (*,*) wctime, "NO WALL CLOCK TIME LEFT" + timeleft=0 + end if call writerestartfiles + end do !------------------------------------------------------- From ac4c5ee37ea3a1be352df4f4242ddb5143724f5b Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 18:33:58 -0400 Subject: [PATCH 09/88] UCLALES-style CMake. Easier to set up new/own environments, control of library paths etc --- CMakeLists.txt | 173 +-- config/archlinux.cmake | 15 + config/blizzard.cmake | 15 + config/cheopsgcc.cmake | 15 + config/cheopsintel.cmake | 15 + config/cheopsintel_localnetcdf.cmake | 15 + config/default.cmake | 19 + config/default.cmake~ | 15 + config/defaultgcc.cmake | 15 + config/defaultintel.cmake | 15 + config/doxygen.conf.in | 1662 ++++++++++++++++++++++++++ config/juropa.cmake | 16 + config/oakley.cmake | 15 + config/osx.cmake | 15 + config/ruby.cmake | 15 + config/supermuc.cmake | 15 + config/thunder.cmake | 15 + config/thunder.cmake.orig | 10 + config/ubuntu.cmake | 15 + src/CMakeLists.txt | 9 +- 20 files changed, 1986 insertions(+), 113 deletions(-) create mode 100644 config/archlinux.cmake create mode 100644 config/blizzard.cmake create mode 100644 config/cheopsgcc.cmake create mode 100644 config/cheopsintel.cmake create mode 100644 config/cheopsintel_localnetcdf.cmake create mode 100755 config/default.cmake create mode 100644 config/default.cmake~ create mode 100644 config/defaultgcc.cmake create mode 100644 config/defaultintel.cmake create mode 100644 config/doxygen.conf.in create mode 100644 config/juropa.cmake create mode 100644 config/oakley.cmake create mode 100755 config/osx.cmake create mode 100644 config/ruby.cmake create mode 100644 config/supermuc.cmake create mode 100644 config/thunder.cmake create mode 100644 config/thunder.cmake.orig create mode 100755 config/ubuntu.cmake diff --git a/CMakeLists.txt b/CMakeLists.txt index d65f33e7..98a16116 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,127 +1,71 @@ -### Choose CMAKE Type -if(NOT CMAKE_BUILD_TYPE) - set (CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are: None Debug Release." - FORCE) -endif() - -### Set compiler flags -if("$ENV{SYST}" STREQUAL "HUYGENS") - set(CMAKE_Fortran_COMPILER "mpfort") - set(CMAKE_Fortran_FLAGS "-qfree=F90 -qrealsize=8 -qwarn64 -qflttrap=en:ov:zero:inv:imp -qflag=w:e" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_RELEASE "-O4 -qnoipa -qstrict=none:exceptions" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_DEBUG "-O2 -g -qfullpath -C -qflttrp=enable:nanq:overflow:zerodivide -qsigtrap -qinitauto=ff" CACHE STRING "") -elseif("$ENV{SYST}" STREQUAL "CARTESIUS") - set(CMAKE_Fortran_COMPILER "mpiifort") - set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") -elseif("$ENV{SYST}" STREQUAL "localpc_ifort") - set(CMAKE_Fortran_COMPILER "mpif90") - set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") -elseif("$ENV{SYST}" STREQUAL "HYDRA") - set(CMAKE_Fortran_COMPILER "mpiifort") - set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") - set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") -elseif("$ENV{SYST}" STREQUAL "FEDORA") - set(CMAKE_Fortran_COMPILER "mpif90") - set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none -I /usr/lib64/gfortran/modules/mpich/" CACHE STRING "") - set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") - set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") -else() - set(CMAKE_Fortran_COMPILER "mpif90") - set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none " CACHE STRING "") - set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") - set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") -endif() - -## Project parameters -PROJECT(DALES Fortran) -cmake_minimum_required(VERSION 2.6) -set(VERSION_MAJOR "4") -set(VERSION_MINOR "2") -set(VERSION_PATCH "0") +############################ +# DALES CMAKE FILE +# Supports (thusfar) GNU, Intel and IBM compilers +# To set the compiler to a specific one, set the FC environment variable +# NETCDF can be set in the config/default.cmake, or through command line options +# NETCDF_INCLUDE, NETCDF_LIB, FFTW_INCLUDE and FFTW_LIB, respectively. +# Command line options are fed to CMake using the -D switch +# Options include: +# * MPI (TRUE/FALSE) to toggle the use of MPI. True by default. +# * PROFILER (SCALASCA/MARMOT) to enable a specific profiler. Default is none. +# * CMAKE_BUILD_TYPE (RELEASE/DEBUG) to build in optimized or debug mode. Default is RELEASE +# All options are persistent in the sense that once set, they will last until changed by the user. +# For daily use "cmake .. && make" should suffice to build the code, but a command line could look like: +# export FC="gfortran" && cmake -D SYST=tornado -D MPI=TRUE -D PROFILER=SCALASCA -D CMAKE_BUILD_TYPE=DEBUG .. && make +############################ +set (CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${CMAKE_CURRENT_SOURCE_DIR}/config) -### If necessary, resort to BASH-methods to find netcdf-directory -EXEC_PROGRAM(${CMAKE_CURRENT_SOURCE_DIR}/findnetcdf OUTPUT_VARIABLE ADDMODULEPATH) +INCLUDE(CMakeForceCompiler) #Necessary to change between MPI/parallel/profiler compilers, without having to do a make clean +cmake_minimum_required (VERSION 2.8.1) +set (CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}) -### Find NetCDF files -FIND_PATH(NETCDF_INCLUDE_DIR netcdf.mod NETCDF.mod - PATHS - $ENV{SARA_NETCDF_INCLUDE} - $ENV{SURFSARA_NETCDF_INCLUDE} - $ENV{NETCDF_INCLUDE} - ${ADDMODULEPATH}/include - /usr/include - $ENV{HOME}/include - /usr/lib64/gfortran/modules - DOC "NetCDF include directory (must contain netcdf.mod)" -) -FIND_LIBRARY(NETCDF_C_LIB netcdf - PATHS - $ENV{SARA_NETCDF_LIB} - $ENV{SURFSARA_NETCDF_LIB} - $ENV{NETCDF_LIB} - ${ADDMODULEPATH}/lib - ${ADDMODULEPATH}/lib64 - /usr/lib - /usr/lib64 - $ENV{HOME}/lib - $ENV{HOME}/lib64 - DOC "NetCDF C library" -) +# make sure that the default is a RELEASE +if (NOT CMAKE_BUILD_TYPE) + set (CMAKE_BUILD_TYPE RELEASE CACHE STRING + "Choose the type of build, options are: None Debug Release." FORCE ) +else() + string(TOUPPER ${CMAKE_BUILD_TYPE} TEMP) + set(CMAKE_BUILD_TYPE ${TEMP} CACHE STRING + "Choose the type of build, options are: None Debug Release." FORCE) +endif () -FIND_LIBRARY(NETCDF_FORTRAN_LIB netcdff - PATHS - $ENV{SARA_NETCDF_LIB} - $ENV{SURFSARA_NETCDF_LIB} - $ENV{NETCDF_LIB} - ${ADDMODULEPATH}/lib - ${ADDMODULEPATH}/lib64 - /usr/lib - /usr/lib64 - $ENV{HOME}/lib - $ENV{HOME}/lib64 - DOC "NetCDF Fortran library" -) +#Load system specific settings +if (NOT SYST) + set (SYST default CACHE STRING + "Choose the location: mpipc thunder fedora archlinux supermuc jugene" FORCE ) +endif () +include (${SYST} OPTIONAL) -if(NETCDF_INCLUDE_DIR) - include_directories(${NETCDF_INCLUDE_DIR}) -else(NETCDF_INCLUDE_DIR) - MESSAGE(STATUS "WARNING: No NETCDF bindings are found.") -endif(NETCDF_INCLUDE_DIR) +#Start the project only after all the variables are set +project (dales Fortran) -if(NETCDF_C_LIB) - set(NETCDF_LIBS ${NETCDF_C_LIB}) -else(NETCDF_C_LIB) - MESSAGE(STATUS "WARNING: No NETCDF bindings are found.") -endif(NETCDF_C_LIB) +get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER_ID} NAME) -if(NETCDF_FORTRAN_LIB) - set(NETCDF_LIBS ${NETCDF_LIBS} ${NETCDF_FORTRAN_LIB}) -else(NETCDF_FORTRAN_LIB) - MESSAGE(STATUS "WARNING: No Fortran NETCDF bindings are found.") -endif(NETCDF_FORTRAN_LIB) +if (NOT ${Fortran_COMPILER_WRAPPER} STREQUAL "") + CMAKE_FORCE_Fortran_COMPILER(${Fortran_COMPILER_WRAPPER} ${Fortran_COMPILER_NAME}) +endif () +MESSAGE(STATUS "Fortran Compiler " ${CMAKE_Fortran_COMPILER}) -### Documentation -INCLUDE(FindDoxygen) -if(DOXYGEN) - ADD_SUBDIRECTORY(utils/doc) +set(CMAKE_Fortran_FLAGS ${USER_Fortran_FLAGS} ) +set(CMAKE_Fortran_FLAGS_RELEASE ${USER_Fortran_FLAGS_RELEASE} ) +set(CMAKE_Fortran_FLAGS_DEBUG ${USER_Fortran_FLAGS_DEBUG}) +MESSAGE(STATUS "Build Type " ${CMAKE_BUILD_TYPE}) +if (CMAKE_BUILD_TYPE STREQUAL "RELEASE") + MESSAGE(STATUS "Compiler Flags " ${CMAKE_Fortran_FLAGS} ${CMAKE_Fortran_FLAGS_RELEASE}) else() - MESSAGE(STATUS "WARNING: Doxygen not found - Reference manual will not be created") + MESSAGE(STATUS "Compiler Flags " ${CMAKE_Fortran_FLAGS} ${CMAKE_Fortran_FLAGS_DEBUG}) endif() + +set(INCLUDE_DIRS ${NETCDF_INCLUDE_DIR}) ### Set case if(NOT CASE) set (CASE standard CACHE STRING "Set the case." FORCE) endif() - + ### Add case specific file FILE(GLOB usrfile "${CMAKE_CURRENT_SOURCE_DIR}/cases/${CASE}/moduser.f90") if(usrfile STREQUAL "") @@ -130,4 +74,17 @@ endif() execute_process(COMMAND ${CMAKE_COMMAND} -E copy_if_different ${usrfile} ${CMAKE_CURRENT_SOURCE_DIR}/src/moduser.f90) MESSAGE(STATUS "Case " ${CASE} " uses " ${usrfile}) -ADD_SUBDIRECTORY(src) +add_subdirectory(src) + + +##################### +# DOCUMENTATION +##################### +add_custom_target(todo ALL) +ADD_CUSTOM_COMMAND(TARGET todo POST_BUILD + COMMAND echo "UCLALES TODO LIST" > TODO + COMMAND date >> TODO + COMMAND grep -Rin \\todo src | sed 's/!.*TODO//I' >> TODO + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + ) + diff --git a/config/archlinux.cmake b/config/archlinux.cmake new file mode 100644 index 00000000..13d1eb36 --- /dev/null +++ b/config/archlinux.cmake @@ -0,0 +1,15 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "/usr/bin/gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/usr/include") +set(NETCDF_LIB_1 "/usr/lib64/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/lib64/libnetcdf.so") +set(HDF5_LIB_1 "/usr/lib64/libhdf5_hl.so") +set(HDF5_LIB_2 "/usr/lib64/libhdf5.so") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/blizzard.cmake b/config/blizzard.cmake new file mode 100644 index 00000000..d88d191c --- /dev/null +++ b/config/blizzard.cmake @@ -0,0 +1,15 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "xlf") +set(Fortran_COMPILER_WRAPPER mpxlf90) + +set(USER_Fortran_FLAGS "-qfree=F90 -qrealsize=8 -qwarn64 -qnosave -qinitauto=FFF00000 -qflttrap=en:ov:zero:inv:imp -qflag=w:e") +set(USER_Fortran_FLAGS_RELEASE "-O4 -qnoipa -qstrict=none:exceptions -qinitauto=ff -qsigtrap") +set(USER_Fortran_FLAGS_DEBUG "-O0 -qfullpath -C -g -qflttrp=enable:inexact:invalid:nanq:overflow:zerodivide -qsigtrap -qinitauto") + +set(NETCDF_INCLUDE_DIR "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/include") +set(NETCDF_LIB_1 "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/lib/libnetcdf.a") +set(HDF5_LIB_1 "/sw/aix61/hdf5-1.8.6-threadsafe/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/sw/aix61/hdf5-1.8.6-threadsafe/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z) diff --git a/config/cheopsgcc.cmake b/config/cheopsgcc.cmake new file mode 100644 index 00000000..3353d384 --- /dev/null +++ b/config/cheopsgcc.cmake @@ -0,0 +1,15 @@ +# CHEOPS GCC +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/opt/rrzk/lib/netcdf/4.1.3/include") +set(NETCDF_LIB_1 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdf.a") +set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") +set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/cheopsintel.cmake b/config/cheopsintel.cmake new file mode 100644 index 00000000..5e6b5a54 --- /dev/null +++ b/config/cheopsintel.cmake @@ -0,0 +1,15 @@ +# CHEOPS Intel +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/opt/rrzk/lib/netcdf/4.1.3/include") +set(NETCDF_LIB_1 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdf.a") +set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") +set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/cheopsintel_localnetcdf.cmake b/config/cheopsintel_localnetcdf.cmake new file mode 100644 index 00000000..d6817bf4 --- /dev/null +++ b/config/cheopsintel_localnetcdf.cmake @@ -0,0 +1,15 @@ +# CHEOPS Intel +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpiifort) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/home/rneggers/bin/netcdf-4.3.0_ifort/include") +set(NETCDF_LIB_1 "/home/rneggers/bin/netcdf-4.3.0_ifort/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/home/rneggers/bin/netcdf-4.3.0_ifort/lib/libnetcdf.a") +set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") +set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/default.cmake b/config/default.cmake new file mode 100755 index 00000000..ae68862b --- /dev/null +++ b/config/default.cmake @@ -0,0 +1,19 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/usr/include") +set(NETCDF_LIB_1 "/usr/lib64/libnetcdff.so") +set(NETCDF_LIB_2 "/usr/lib64/libnetcdf.so") +set(HDF5_LIB_1 "/usr/lib64/libhdf5_hl.so") +set(HDF5_LIB_2 "/usr/lib64/libhdf5.so") +# set(HDF4_LIB_1 "/usr/lib64/hdf/libdf.a") +# set(HDF4_LIB_2 "/usr/lib64/hdf/libmfhdf.a") +set(HDF4_LIB_1 "") +set(HDF4_LIB_2 "") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${HDF4_LIB_2} ${HDF4_LIB_1} ${SZIP_LIB} dl m z curl) diff --git a/config/default.cmake~ b/config/default.cmake~ new file mode 100644 index 00000000..4da7a8d0 --- /dev/null +++ b/config/default.cmake~ @@ -0,0 +1,15 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/usr/include") +set(NETCDF_LIB_1 "/usr/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/lib/libnetcdf.a") +set(HDF5_LIB_1 "/usr/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2}) diff --git a/config/defaultgcc.cmake b/config/defaultgcc.cmake new file mode 100644 index 00000000..c0d6a034 --- /dev/null +++ b/config/defaultgcc.cmake @@ -0,0 +1,15 @@ +# Default GCC +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf-latest-static-gcc47/include") +set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf-latest-static-gcc47/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-latest-static-gcc47/lib/libnetcdf.a") +set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5.a") +set(SZIP_LIB "/sw/squeeze-x64/szip-2.1-static/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/defaultintel.cmake b/config/defaultintel.cmake new file mode 100644 index 00000000..05a9e4f3 --- /dev/null +++ b/config/defaultintel.cmake @@ -0,0 +1,15 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf_fortran-latest-static-intel13/include") +set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf_fortran-latest-static-intel13/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-4.2-static/lib/libnetcdf.a") +set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/doxygen.conf.in b/config/doxygen.conf.in new file mode 100644 index 00000000..fc84e563 --- /dev/null +++ b/config/doxygen.conf.in @@ -0,0 +1,1662 @@ +# Doxyfile 1.7.1 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project +# +# All text after a hash (#) is considered a comment and will be ignored +# The format is: +# TAG = value [value, ...] +# For lists items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (" ") + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the config file +# that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# http://www.gnu.org/software/libiconv for the list of possible encodings. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded +# by quotes) that should identify the project. + +PROJECT_NAME = UCLALES + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. +# This could be handy for archiving the generated documentation or +# if some version control system is used. + +PROJECT_NUMBER = V3.x + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) +# base path where the generated documentation will be put. +# If a relative path is entered, it will be relative to the location +# where doxygen was started. If left blank the current directory will be used. + +OUTPUT_DIRECTORY = ../doc/doxygen + +# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create +# 4096 sub-directories (in 2 levels) under the output directory of each output +# format and will distribute the generated files over these directories. +# Enabling this option can be useful when feeding doxygen a huge amount of +# source files, where putting all generated files in the same directory would +# otherwise cause performance problems for the file system. + +CREATE_SUBDIRS = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# The default language is English, other supported languages are: +# Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional, +# Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German, +# Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English +# messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian, +# Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrilic, Slovak, +# Slovene, Spanish, Swedish, Ukrainian, and Vietnamese. + +OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will +# include brief member descriptions after the members that are listed in +# the file and class documentation (similar to JavaDoc). +# Set to NO to disable this. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend +# the brief description of a member or function before the detailed description. +# Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator +# that is used to form the text in various listings. Each string +# in this list, if found as the leading text of the brief description, will be +# stripped from the text and the result after processing the whole list, is +# used as the annotated text. Otherwise, the brief description is used as-is. +# If left blank, the following values are used ("$name" is automatically +# replaced with the name of the entity): "The $name class" "The $name widget" +# "The $name file" "is" "provides" "specifies" "contains" +# "represents" "a" "an" "the" + +ABBREVIATE_BRIEF = "The $name class" \ + "The $name widget" \ + "The $name file" \ + is \ + provides \ + specifies \ + contains \ + represents \ + a \ + an \ + the + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# Doxygen will generate a detailed section even if there is only a brief +# description. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full +# path before files name in the file list and in the header files. If set +# to NO the shortest path that makes the file name unique will be used. + +FULL_PATH_NAMES = YES + +# If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag +# can be used to strip a user-defined part of the path. Stripping is +# only done if one of the specified strings matches the left-hand part of +# the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the +# path to strip. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of +# the path mentioned in the documentation of a class, which tells +# the reader which header file to include in order to use a class. +# If left blank only the name of the header file containing the class +# definition is used. Otherwise one should specify the include paths that +# are normally passed to the compiler using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter +# (but less readable) file names. This can be useful is your file systems +# doesn't support long names like on DOS, Mac, or CD-ROM. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen +# will interpret the first line (until the first dot) of a JavaDoc-style +# comment as the brief description. If set to NO, the JavaDoc +# comments will behave just like regular Qt-style comments +# (thus requiring an explicit @brief command for a brief description.) + +JAVADOC_AUTOBRIEF = NO + +# If the QT_AUTOBRIEF tag is set to YES then Doxygen will +# interpret the first line (until the first dot) of a Qt-style +# comment as the brief description. If set to NO, the comments +# will behave just like regular Qt-style comments (thus requiring +# an explicit \brief command for a brief description.) + +QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen +# treat a multi-line C++ special comment block (i.e. a block of //! or /// +# comments) as a brief description. This used to be the default behaviour. +# The new default is to treat a multi-line C++ comment block as a detailed +# description. Set this tag to YES if you prefer the old behaviour instead. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES (the default) then an undocumented +# member inherits the documentation from any documented member that it +# re-implements. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce +# a new page for each member. If set to NO, the documentation of a member will +# be part of the file/class/namespace that contains it. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. +# Doxygen uses this value to replace tabs by spaces in code fragments. + +TAB_SIZE = 8 + +# This tag can be used to specify a number of aliases that acts +# as commands in the documentation. An alias has the form "name=value". +# For example adding "sideeffect=\par Side Effects:\n" will allow you to +# put the command \sideeffect (or @sideeffect) in the documentation, which +# will result in a user-defined paragraph with heading "Side Effects:". +# You can put \n's in the value part of an alias to insert newlines. + +ALIASES = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C +# sources only. Doxygen will then generate output that is more tailored for C. +# For instance, some of the names that are used will be different. The list +# of all members will be omitted, etc. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java +# sources only. Doxygen will then generate output that is more tailored for +# Java. For instance, namespaces will be presented as packages, qualified +# scopes will look different, etc. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources only. Doxygen will then generate output that is more tailored for +# Fortran. + +OPTIMIZE_FOR_FORTRAN = YES + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for +# VHDL. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given extension. +# Doxygen has a built-in mapping, but you can override or extend it using this +# tag. The format is ext=language, where ext is a file extension, and language +# is one of the parsers supported by doxygen: IDL, Java, Javascript, CSharp, C, +# C++, D, PHP, Objective-C, Python, Fortran, VHDL, C, C++. For instance to make +# doxygen treat .inc files as Fortran files (default is PHP), and .f files as C +# (default is Fortran), use: inc=Fortran f=C. Note that for custom extensions +# you also need to set FILE_PATTERNS otherwise the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should +# set this tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); v.s. +# func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip sources only. +# Doxygen will parse them like normal C++ but will assume all classes use public +# instead of private inheritance when no explicit protection keyword is present. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate getter +# and setter methods for a property. Setting this option to YES (the default) +# will make doxygen to replace the get and set methods by a property in the +# documentation. This will only work if the methods are indeed getting or +# setting a simple type. If this is not the case, or you want to show the +# methods anyway, you should set this option to NO. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES, then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. + +DISTRIBUTE_GROUP_DOC = NO + +# Set the SUBGROUPING tag to YES (the default) to allow class member groups of +# the same type (for instance a group of public functions) to be put as a +# subgroup of that type (e.g. under the Public Functions section). Set it to +# NO to prevent subgrouping. Alternatively, this can be done per class using +# the \nosubgrouping command. + +SUBGROUPING = YES + +# When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum +# is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically +# be useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. + +TYPEDEF_HIDES_STRUCT = NO + +# The SYMBOL_CACHE_SIZE determines the size of the internal cache use to +# determine which symbols to keep in memory and which to flush to disk. +# When the cache is full, less often used symbols will be written to disk. +# For small to medium size projects (<1000 input files) the default value is +# probably good enough. For larger projects a too small cache size can cause +# doxygen to be busy swapping symbols to and from disk most of the time +# causing a significant performance penality. +# If the system has enough physical memory increasing the cache will improve the +# performance by keeping more symbols in memory. Note that the value works on +# a logarithmic scale so increasing the size by one will rougly double the +# memory usage. The cache size is given by this formula: +# 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0, +# corresponding to a cache size of 2^16 = 65536 symbols + +SYMBOL_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in +# documentation are documented, even if no documentation was available. +# Private class members and static file members will be hidden unless +# the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES + +EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES all private members of a class +# will be included in the documentation. + +EXTRACT_PRIVATE = NO + +# If the EXTRACT_STATIC tag is set to YES all static members of a file +# will be included in the documentation. + +EXTRACT_STATIC = NO + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) +# defined locally in source files will be included in the documentation. +# If set to NO only classes defined in header files are included. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. When set to YES local +# methods, which are defined in the implementation section but not in +# the interface are included in the documentation. +# If set to NO (the default) only methods in the interface are included. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base +# name of the file that contains the anonymous namespace. By default +# anonymous namespace are hidden. + +EXTRACT_ANON_NSPACES = NO + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all +# undocumented members of documented classes, files or namespaces. +# If set to NO (the default) these members will be included in the +# various overviews, but no documentation section is generated. +# This option has no effect if EXTRACT_ALL is enabled. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. +# If set to NO (the default) these classes will be included in the various +# overviews. This option has no effect if EXTRACT_ALL is enabled. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all +# friend (class|struct|union) declarations. +# If set to NO (the default) these declarations will be included in the +# documentation. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any +# documentation blocks found inside the body of a function. +# If set to NO (the default) these blocks will be appended to the +# function's detailed documentation block. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation +# that is typed after a \internal command is included. If the tag is set +# to NO (the default) then the documentation will be excluded. +# Set it to YES to include the internal documentation. + +INTERNAL_DOCS = NO + +# If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate +# file names in lower-case letters. If set to YES upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# and Mac users are advised to set this option to NO. + +CASE_SENSE_NAMES = NO + +# If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen +# will show members with their full class and namespace scopes in the +# documentation. If set to YES the scope will be hidden. + +HIDE_SCOPE_NAMES = NO + +# If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen +# will put a list of the files that are included by a file in the documentation +# of that file. + +SHOW_INCLUDE_FILES = YES + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen +# will list include files with double quotes in the documentation +# rather than with sharp brackets. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES (the default) then a tag [inline] +# is inserted in the documentation for inline members. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen +# will sort the (detailed) documentation of file and class members +# alphabetically by member name. If set to NO the members will appear in +# declaration order. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the +# brief documentation of file, namespace and class members alphabetically +# by member name. If set to NO (the default) the members will appear in +# declaration order. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen +# will sort the (brief and detailed) documentation of class members so that +# constructors and destructors are listed first. If set to NO (the default) +# the constructors will appear in the respective orders defined by +# SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. +# This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO +# and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the +# hierarchy of group names into alphabetical order. If set to NO (the default) +# the group names will appear in their defined order. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be +# sorted by fully-qualified names, including namespaces. If set to +# NO (the default), the class list will be sorted only by class name, +# not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the +# alphabetical list. + +SORT_BY_SCOPE_NAME = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or +# disable (NO) the todo list. This list is created by putting \todo +# commands in the documentation. + +GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or +# disable (NO) the test list. This list is created by putting \test +# commands in the documentation. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or +# disable (NO) the bug list. This list is created by putting \bug +# commands in the documentation. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or +# disable (NO) the deprecated list. This list is created by putting +# \deprecated commands in the documentation. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional +# documentation sections, marked by \if sectionname ... \endif. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines +# the initial value of a variable or define consists of for it to appear in +# the documentation. If the initializer consists of more lines than specified +# here it will be hidden. Use a value of 0 to hide initializers completely. +# The appearance of the initializer of individual variables and defines in the +# documentation can be controlled using \showinitializer or \hideinitializer +# command in the documentation regardless of this setting. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated +# at the bottom of the documentation of classes and structs. If set to YES the +# list will mention the files that were used to generate the documentation. + +SHOW_USED_FILES = YES + +# If the sources in your project are distributed over multiple directories +# then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy +# in the documentation. The default is NO. + +SHOW_DIRECTORIES = NO + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. +# This will remove the Files entry from the Quick Index and from the +# Folder Tree View (if specified). The default is YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the +# Namespaces page. This will remove the Namespaces entry from the Quick Index +# and from the Folder Tree View (if specified). The default is YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command , where is the value of +# the FILE_VERSION_FILTER tag, and is the name of an input file +# provided by doxygen. Whatever the program writes to standard output +# is used as the file version. See the manual for examples. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. The create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. +# You can optionally specify a file name after the option, if omitted +# DoxygenLayout.xml will be used as the name of the layout file. + +LAYOUT_FILE = + +#--------------------------------------------------------------------------- +# configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated +# by doxygen. Possible values are YES and NO. If left blank NO is used. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated by doxygen. Possible values are YES and NO. If left blank +# NO is used. + +WARNINGS = YES + +# If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings +# for undocumented members. If EXTRACT_ALL is set to YES then this flag will +# automatically be disabled. + +WARN_IF_UNDOCUMENTED = YES + +# If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some +# parameters in a documented function, or documenting parameters that +# don't exist or using markup commands wrongly. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be abled to get warnings for +# functions that are documented, but have no documentation for their parameters +# or return value. If set to NO (the default) doxygen will only warn about +# wrong or incomplete parameter documentation, but not about the absence of +# documentation. + +WARN_NO_PARAMDOC = NO + +# The WARN_FORMAT tag determines the format of the warning messages that +# doxygen can produce. The string should contain the $file, $line, and $text +# tags, which will be replaced by the file and line number from which the +# warning originated and the warning text. Optionally the format may contain +# $version, which will be replaced by the version of the file (if it could +# be obtained via FILE_VERSION_FILTER) + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning +# and error messages should be written. If left blank the output is written +# to stderr. + +WARN_LOGFILE = + +#--------------------------------------------------------------------------- +# configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag can be used to specify the files and/or directories that contain +# documented source files. You may enter file names like "myfile.cpp" or +# directories like "/usr/src/myproject". Separate the files or directories +# with spaces. + +INPUT = ../src + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is +# also the default input encoding. Doxygen uses libiconv (or the iconv built +# into libc) for the transcoding. See http://www.gnu.org/software/libiconv for +# the list of possible encodings. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp +# and *.h) to filter out the source-files in the directories. If left +# blank the following patterns are tested: +# *.c *.cc *.cxx *.cpp *.c++ *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh *.hxx +# *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.py *.f90 + +FILE_PATTERNS = *.c \ + *.cc \ + *.cxx \ + *.cpp \ + *.c++ \ + *.d \ + *.java \ + *.ii \ + *.ixx \ + *.ipp \ + *.i++ \ + *.inl \ + *.h \ + *.hh \ + *.hxx \ + *.hpp \ + *.h++ \ + *.idl \ + *.odl \ + *.cs \ + *.php \ + *.php3 \ + *.inc \ + *.m \ + *.mm \ + *.dox \ + *.py \ + *.F90 \ + *.f90 \ + *.f \ + *.vhd \ + *.vhdl + +# The RECURSIVE tag can be used to turn specify whether or not subdirectories +# should be searched for input files as well. Possible values are YES and NO. +# If left blank NO is used. + +RECURSIVE = NO + +# The EXCLUDE tag can be used to specify files and/or directories that should +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used select whether or not files or +# directories that are symbolic links (a Unix filesystem feature) are excluded +# from the input. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. Note that the wildcards are matched +# against the file with absolute path, so to exclude all test directories +# for example use the pattern */test/* + +EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or +# directories that contain example code fragments that are included (see +# the \include command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp +# and *.h) to filter out the source-files in the directories. If left +# blank all files are included. + +EXAMPLE_PATTERNS = * + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude +# commands irrespective of the value of the RECURSIVE tag. +# Possible values are YES and NO. If left blank NO is used. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or +# directories that contain image that are included in the documentation (see +# the \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command , where +# is the value of the INPUT_FILTER tag, and is the name of an +# input file. Doxygen will then use the output that the filter program writes +# to standard output. If FILTER_PATTERNS is specified, this tag will be +# ignored. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: +# pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further +# info on how filters are used. If FILTER_PATTERNS is empty, INPUT_FILTER +# is applied to all files. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will be used to filter the input files when producing source +# files to browse (i.e. when SOURCE_BROWSER is set to YES). + +FILTER_SOURCE_FILES = NO + +#--------------------------------------------------------------------------- +# configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will +# be generated. Documented entities will be cross-referenced with these sources. +# Note: To get rid of all source code in the generated output, make sure also +# VERBATIM_HEADERS is set to NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body +# of functions and classes directly in the documentation. + +INLINE_SOURCES = YES + +# Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct +# doxygen to hide any special comment blocks from generated source code +# fragments. Normal C and C++ comments will always remain visible. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES +# then for each documented function all documented +# functions referencing it will be listed. + +REFERENCED_BY_RELATION = YES + +# If the REFERENCES_RELATION tag is set to YES +# then for each documented function all documented entities +# called/used by that function will be listed. + +REFERENCES_RELATION = YES + +# If the REFERENCES_LINK_SOURCE tag is set to YES (the default) +# and SOURCE_BROWSER tag is set to YES, then the hyperlinks from +# functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will +# link to the source code. Otherwise they will link to the documentation. + +REFERENCES_LINK_SOURCE = YES + +# If the USE_HTAGS tag is set to YES then the references to source code +# will point to the HTML generated by the htags(1) tool instead of doxygen +# built-in source browser. The htags tool is part of GNU's global source +# tagging system (see http://www.gnu.org/software/global/global.html). You +# will need version 4.8.6 or higher. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen +# will generate a verbatim copy of the header file for each class for +# which an include is specified. Set to NO to disable this. + +VERBATIM_HEADERS = YES + +#--------------------------------------------------------------------------- +# configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index +# of all compounds will be generated. Enable this if the project +# contains a lot of classes, structs, unions or interfaces. + +ALPHABETICAL_INDEX = YES + +# If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then +# the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns +# in which this list will be split (can be a number in the range [1..20]) + +COLS_IN_ALPHA_INDEX = 5 + +# In case all classes in a project start with a common prefix, all +# classes will be put under the same header in the alphabetical index. +# The IGNORE_PREFIX tag can be used to specify one or more prefixes that +# should be ignored while generating the index headers. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES (the default) Doxygen will +# generate HTML output. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `html' will be used as the default path. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for +# each generated HTML page (for example: .htm,.php,.asp). If it is left blank +# doxygen will generate files with .html extension. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a personal HTML header for +# each generated HTML page. If it is left blank doxygen will generate a +# standard header. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a personal HTML footer for +# each generated HTML page. If it is left blank doxygen will generate a +# standard footer. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading +# style sheet that is used by each HTML page. It can be used to +# fine-tune the look of the HTML output. If the tag is left blank doxygen +# will generate a default style sheet. Note that doxygen will try to copy +# the style sheet file to the HTML output directory, so don't put your own +# stylesheet in the HTML output directory as well, or it will be erased! + +HTML_STYLESHEET = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. +# Doxygen will adjust the colors in the stylesheet and background images +# according to this color. Hue is specified as an angle on a colorwheel, +# see http://en.wikipedia.org/wiki/Hue for more information. +# For instance the value 0 represents red, 60 is yellow, 120 is green, +# 180 is cyan, 240 is blue, 300 purple, and 360 is red again. +# The allowed range is 0 to 359. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of +# the colors in the HTML output. For a value of 0 the output will use +# grayscales only. A value of 255 will produce the most vivid colors. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to +# the luminance component of the colors in the HTML output. Values below +# 100 gradually make the output lighter, whereas values above 100 make +# the output darker. The value divided by 100 is the actual gamma applied, +# so 80 represents a gamma of 0.8, The value 220 represents a gamma of 2.2, +# and 100 does not change the gamma. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting +# this to NO can help when comparing the output of multiple runs. + +HTML_TIMESTAMP = YES + +# If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes, +# files or namespaces will be aligned in HTML using tables. If set to +# NO a bullet list will be used. + +HTML_ALIGN_MEMBERS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. For this to work a browser that supports +# JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox +# Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari). + +HTML_DYNAMIC_SECTIONS = NO + +# If the GENERATE_DOCSET tag is set to YES, additional index files +# will be generated that can be used as input for Apple's Xcode 3 +# integrated development environment, introduced with OSX 10.5 (Leopard). +# To create a documentation set, doxygen will generate a Makefile in the +# HTML output directory. Running make will produce the docset in that +# directory and running "make install" will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find +# it at startup. +# See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html +# for more information. + +GENERATE_DOCSET = NO + +# When GENERATE_DOCSET tag is set to YES, this tag determines the name of the +# feed. A documentation feed provides an umbrella under which multiple +# documentation sets from a single provider (such as a company or product suite) +# can be grouped. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# When GENERATE_DOCSET tag is set to YES, this tag specifies a string that +# should uniquely identify the documentation set bundle. This should be a +# reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen +# will append .docset to the name. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# When GENERATE_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The GENERATE_PUBLISHER_NAME tag identifies the documentation publisher. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES, additional index files +# will be generated that can be used as input for tools like the +# Microsoft HTML help workshop to generate a compiled HTML help file (.chm) +# of the generated HTML documentation. + +GENERATE_HTMLHELP = NO + +# If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can +# be used to specify the file name of the resulting .chm file. You +# can add a path in front of the file if the result should not be +# written to the html output directory. + +CHM_FILE = + +# If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can +# be used to specify the location (absolute path including file name) of +# the HTML help compiler (hhc.exe). If non-empty doxygen will try to run +# the HTML help compiler on the generated index.hhp. + +HHC_LOCATION = + +# If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag +# controls if a separate .chi index file is generated (YES) or that +# it should be included in the master .chm file (NO). + +GENERATE_CHI = NO + +# If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING +# is used to encode HtmlHelp index (hhk), content (hhc) and project file +# content. + +CHM_INDEX_ENCODING = + +# If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag +# controls whether a binary table of contents is generated (YES) or a +# normal table of contents (NO) in the .chm file. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members +# to the contents of the HTML help documentation and to the tree view. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated +# that can be used as input for Qt's qhelpgenerator to generate a +# Qt Compressed Help (.qch) of the generated HTML documentation. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can +# be used to specify the file name of the resulting .qch file. +# The path specified is relative to the HTML output folder. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating +# Qt Help Project output. For more information please see +# http://doc.trolltech.com/qthelpproject.html#namespace + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating +# Qt Help Project output. For more information please see +# http://doc.trolltech.com/qthelpproject.html#virtual-folders + +QHP_VIRTUAL_FOLDER = doc + +# If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to +# add. For more information please see +# http://doc.trolltech.com/qthelpproject.html#custom-filters + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see +# +# Qt Help Project / Custom Filters. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's +# filter section matches. +# +# Qt Help Project / Filter Attributes. + +QHP_SECT_FILTER_ATTRS = + +# If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can +# be used to specify the location of Qt's qhelpgenerator. +# If non-empty doxygen will try to run qhelpgenerator on the generated +# .qhp file. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files +# will be generated, which together with the HTML files, form an Eclipse help +# plugin. To install this plugin and make it available under the help contents +# menu in Eclipse, the contents of the directory containing the HTML and XML +# files needs to be copied into the plugins directory of eclipse. The name of +# the directory within the plugins directory should be the same as +# the ECLIPSE_DOC_ID value. After copying Eclipse needs to be restarted before +# the help appears. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have +# this name. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# The DISABLE_INDEX tag can be used to turn on/off the condensed index at +# top of each HTML page. The value NO (the default) enables the index and +# the value YES disables it. + +DISABLE_INDEX = NO + +# This tag can be used to set the number of enum values (range [1..20]) +# that doxygen will group on one line in the generated HTML documentation. + +ENUM_VALUES_PER_LINE = 4 + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. +# If the tag value is set to YES, a side panel will be generated +# containing a tree-like index structure (just like the one that +# is generated for HTML Help). For this to work a browser that supports +# JavaScript, DHTML, CSS and frames is required (i.e. any modern browser). +# Windows users are probably better off using the HTML help feature. + +GENERATE_TREEVIEW = NO + +# By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories, +# and Class Hierarchy pages using a tree view instead of an ordered list. + +USE_INLINE_TREES = NO + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be +# used to set the initial width (in pixels) of the frame in which the tree +# is shown. + +TREEVIEW_WIDTH = 250 + +# When the EXT_LINKS_IN_WINDOW option is set to YES doxygen will open +# links to external symbols imported via tag files in a separate window. + +EXT_LINKS_IN_WINDOW = NO + +# Use this tag to change the font size of Latex formulas included +# as images in the HTML documentation. The default is 10. Note that +# when you change the font size after a successful doxygen run you need +# to manually remove any form_*.png images from the HTML output directory +# to force them to be regenerated. + +FORMULA_FONTSIZE = 10 + +# Use the FORMULA_TRANPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are +# not supported properly for IE 6.0, but are supported on all modern browsers. +# Note that when changing this option you need to delete any form_*.png files +# in the HTML output before the changes have effect. + +FORMULA_TRANSPARENT = YES + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box +# for the HTML output. The underlying search engine uses javascript +# and DHTML and should work on any modern browser. Note that when using +# HTML help (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets +# (GENERATE_DOCSET) there is already a search function so this one should +# typically be disabled. For large projects the javascript based search engine +# can be slow, then enabling SERVER_BASED_SEARCH may provide a better solution. + +SEARCHENGINE = YES + +# When the SERVER_BASED_SEARCH tag is enabled the search engine will be +# implemented using a PHP enabled web server instead of at the web client +# using Javascript. Doxygen will generate the search PHP script and index +# file to put on the web server. The advantage of the server +# based approach is that it scales better to large projects and allows +# full text search. The disadvances is that it is more difficult to setup +# and does not have live searching capabilities. + +SERVER_BASED_SEARCH = NO + +#--------------------------------------------------------------------------- +# configuration options related to the LaTeX output +#--------------------------------------------------------------------------- + +# If the GENERATE_LATEX tag is set to YES (the default) Doxygen will +# generate Latex output. + +GENERATE_LATEX = YES + +# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `latex' will be used as the default path. + +LATEX_OUTPUT = latex + +# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be +# invoked. If left blank `latex' will be used as the default command name. +# Note that when enabling USE_PDFLATEX this option is only used for +# generating bitmaps for formulas in the HTML output, but not in the +# Makefile that is written to the output directory. + +LATEX_CMD_NAME = latex + +# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to +# generate index for LaTeX. If left blank `makeindex' will be used as the +# default command name. + +MAKEINDEX_CMD_NAME = makeindex + +# If the COMPACT_LATEX tag is set to YES Doxygen generates more compact +# LaTeX documents. This may be useful for small projects and may help to +# save some trees in general. + +COMPACT_LATEX = NO + +# The PAPER_TYPE tag can be used to set the paper type that is used +# by the printer. Possible values are: a4, a4wide, letter, legal and +# executive. If left blank a4wide will be used. + +PAPER_TYPE = a4wide + +# The EXTRA_PACKAGES tag can be to specify one or more names of LaTeX +# packages that should be included in the LaTeX output. + +EXTRA_PACKAGES = + +# The LATEX_HEADER tag can be used to specify a personal LaTeX header for +# the generated latex document. The header should contain everything until +# the first chapter. If it is left blank doxygen will generate a +# standard header. Notice: only use this tag if you know what you are doing! + +LATEX_HEADER = + +# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated +# is prepared for conversion to pdf (using ps2pdf). The pdf file will +# contain links (just like the HTML output) instead of page references +# This makes the output suitable for online browsing using a pdf viewer. + +PDF_HYPERLINKS = YES + +# If the USE_PDFLATEX tag is set to YES, pdflatex will be used instead of +# plain latex in the generated Makefile. Set this option to YES to get a +# higher quality PDF documentation. + +USE_PDFLATEX = YES + +# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \\batchmode. +# command to the generated LaTeX files. This will instruct LaTeX to keep +# running if errors occur, instead of asking the user for help. +# This option is also used when generating formulas in HTML. + +LATEX_BATCHMODE = NO + +# If LATEX_HIDE_INDICES is set to YES then doxygen will not +# include the index chapters (such as File Index, Compound Index, etc.) +# in the output. + +LATEX_HIDE_INDICES = NO + +# If LATEX_SOURCE_CODE is set to YES then doxygen will include +# source code with syntax highlighting in the LaTeX output. +# Note that which sources are shown also depends on other settings +# such as SOURCE_BROWSER. + +LATEX_SOURCE_CODE = NO + +#--------------------------------------------------------------------------- +# configuration options related to the RTF output +#--------------------------------------------------------------------------- + +# If the GENERATE_RTF tag is set to YES Doxygen will generate RTF output +# The RTF output is optimized for Word 97 and may not look very pretty with +# other RTF readers or editors. + +GENERATE_RTF = NO + +# The RTF_OUTPUT tag is used to specify where the RTF docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `rtf' will be used as the default path. + +RTF_OUTPUT = rtf + +# If the COMPACT_RTF tag is set to YES Doxygen generates more compact +# RTF documents. This may be useful for small projects and may help to +# save some trees in general. + +COMPACT_RTF = NO + +# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated +# will contain hyperlink fields. The RTF file will +# contain links (just like the HTML output) instead of page references. +# This makes the output suitable for online browsing using WORD or other +# programs which support those fields. +# Note: wordpad (write) and others do not support links. + +RTF_HYPERLINKS = NO + +# Load stylesheet definitions from file. Syntax is similar to doxygen's +# config file, i.e. a series of assignments. You only have to provide +# replacements, missing definitions are set to their default value. + +RTF_STYLESHEET_FILE = + +# Set optional variables used in the generation of an rtf document. +# Syntax is similar to doxygen's config file. + +RTF_EXTENSIONS_FILE = + +#--------------------------------------------------------------------------- +# configuration options related to the man page output +#--------------------------------------------------------------------------- + +# If the GENERATE_MAN tag is set to YES (the default) Doxygen will +# generate man pages + +GENERATE_MAN = YES + +# The MAN_OUTPUT tag is used to specify where the man pages will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `man' will be used as the default path. + +MAN_OUTPUT = $(HOME)/man + +# The MAN_EXTENSION tag determines the extension that is added to +# the generated man pages (default is the subroutine's section .3) + +MAN_EXTENSION = .3 + +# If the MAN_LINKS tag is set to YES and Doxygen generates man output, +# then it will generate one additional man file for each entity +# documented in the real man page(s). These additional files +# only source the real man page, but without them the man command +# would be unable to find the correct page. The default is NO. + +MAN_LINKS = NO + +#--------------------------------------------------------------------------- +# configuration options related to the XML output +#--------------------------------------------------------------------------- + +# If the GENERATE_XML tag is set to YES Doxygen will +# generate an XML file that captures the structure of +# the code including all documentation. + +GENERATE_XML = NO + +# The XML_OUTPUT tag is used to specify where the XML pages will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `xml' will be used as the default path. + +XML_OUTPUT = xml + +# The XML_SCHEMA tag can be used to specify an XML schema, +# which can be used by a validating XML parser to check the +# syntax of the XML files. + +XML_SCHEMA = + +# The XML_DTD tag can be used to specify an XML DTD, +# which can be used by a validating XML parser to check the +# syntax of the XML files. + +XML_DTD = + +# If the XML_PROGRAMLISTING tag is set to YES Doxygen will +# dump the program listings (including syntax highlighting +# and cross-referencing information) to the XML output. Note that +# enabling this will significantly increase the size of the XML output. + +XML_PROGRAMLISTING = YES + +#--------------------------------------------------------------------------- +# configuration options for the AutoGen Definitions output +#--------------------------------------------------------------------------- + +# If the GENERATE_AUTOGEN_DEF tag is set to YES Doxygen will +# generate an AutoGen Definitions (see autogen.sf.net) file +# that captures the structure of the code including all +# documentation. Note that this feature is still experimental +# and incomplete at the moment. + +GENERATE_AUTOGEN_DEF = NO + +#--------------------------------------------------------------------------- +# configuration options related to the Perl module output +#--------------------------------------------------------------------------- + +# If the GENERATE_PERLMOD tag is set to YES Doxygen will +# generate a Perl module file that captures the structure of +# the code including all documentation. Note that this +# feature is still experimental and incomplete at the +# moment. + +GENERATE_PERLMOD = NO + +# If the PERLMOD_LATEX tag is set to YES Doxygen will generate +# the necessary Makefile rules, Perl scripts and LaTeX code to be able +# to generate PDF and DVI output from the Perl module output. + +PERLMOD_LATEX = NO + +# If the PERLMOD_PRETTY tag is set to YES the Perl module output will be +# nicely formatted so it can be parsed by a human reader. This is useful +# if you want to understand what is going on. On the other hand, if this +# tag is set to NO the size of the Perl module output will be much smaller +# and Perl will parse it just the same. + +PERLMOD_PRETTY = YES + +# The names of the make variables in the generated doxyrules.make file +# are prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. +# This is useful so different doxyrules.make files included by the same +# Makefile don't overwrite each other's variables. + +PERLMOD_MAKEVAR_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the preprocessor +#--------------------------------------------------------------------------- + +# If the ENABLE_PREPROCESSING tag is set to YES (the default) Doxygen will +# evaluate all C-preprocessor directives found in the sources and include +# files. + +ENABLE_PREPROCESSING = YES + +# If the MACRO_EXPANSION tag is set to YES Doxygen will expand all macro +# names in the source code. If set to NO (the default) only conditional +# compilation will be performed. Macro expansion can be done in a controlled +# way by setting EXPAND_ONLY_PREDEF to YES. + +MACRO_EXPANSION = NO + +# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES +# then the macro expansion is limited to the macros specified with the +# PREDEFINED and EXPAND_AS_DEFINED tags. + +EXPAND_ONLY_PREDEF = NO + +# If the SEARCH_INCLUDES tag is set to YES (the default) the includes files +# in the INCLUDE_PATH (see below) will be search if a #include is found. + +SEARCH_INCLUDES = YES + +# The INCLUDE_PATH tag can be used to specify one or more directories that +# contain include files that are not input files but should be processed by +# the preprocessor. + +INCLUDE_PATH = + +# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard +# patterns (like *.h and *.hpp) to filter out the header-files in the +# directories. If left blank, the patterns specified with FILE_PATTERNS will +# be used. + +INCLUDE_FILE_PATTERNS = + +# The PREDEFINED tag can be used to specify one or more macro names that +# are defined before the preprocessor is started (similar to the -D option of +# gcc). The argument of the tag is a list of macros of the form: name +# or name=definition (no spaces). If the definition and the = are +# omitted =1 is assumed. To prevent a macro definition from being +# undefined via #undef or recursively expanded use the := operator +# instead of the = operator. + +PREDEFINED = + +# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then +# this tag can be used to specify a list of macro names that should be expanded. +# The macro definition that is found in the sources will be used. +# Use the PREDEFINED tag if you want to use a different macro definition. + +EXPAND_AS_DEFINED = + +# If the SKIP_FUNCTION_MACROS tag is set to YES (the default) then +# doxygen's preprocessor will remove all function-like macros that are alone +# on a line, have an all uppercase name, and do not end with a semicolon. Such +# function macros are typically used for boiler-plate code, and will confuse +# the parser if not removed. + +SKIP_FUNCTION_MACROS = YES + +#--------------------------------------------------------------------------- +# Configuration::additions related to external references +#--------------------------------------------------------------------------- + +# The TAGFILES option can be used to specify one or more tagfiles. +# Optionally an initial location of the external documentation +# can be added for each tagfile. The format of a tag file without +# this location is as follows: +# TAGFILES = file1 file2 ... +# Adding location for the tag files is done as follows: +# TAGFILES = file1=loc1 "file2 = loc2" ... +# where "loc1" and "loc2" can be relative or absolute paths or +# URLs. If a location is present for each tag, the installdox tool +# does not have to be run to correct the links. +# Note that each tag file must have a unique name +# (where the name does NOT include the path) +# If a tag file is not located in the directory in which doxygen +# is run, you must also specify the path to the tagfile here. + +TAGFILES = + +# When a file name is specified after GENERATE_TAGFILE, doxygen will create +# a tag file that is based on the input files it reads. + +GENERATE_TAGFILE = + +# If the ALLEXTERNALS tag is set to YES all external classes will be listed +# in the class index. If set to NO only the inherited external classes +# will be listed. + +ALLEXTERNALS = NO + +# If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed +# in the modules index. If set to NO, only the current project's groups will +# be listed. + +EXTERNAL_GROUPS = YES + +# The PERL_PATH should be the absolute path and name of the perl script +# interpreter (i.e. the result of `which perl'). + +PERL_PATH = /usr/bin/perl + +#--------------------------------------------------------------------------- +# Configuration options related to the dot tool +#--------------------------------------------------------------------------- + +# If the CLASS_DIAGRAMS tag is set to YES (the default) Doxygen will +# generate a inheritance diagram (in HTML, RTF and LaTeX) for classes with base +# or super classes. Setting the tag to NO turns the diagrams off. Note that +# this option is superseded by the HAVE_DOT option below. This is only a +# fallback. It is recommended to install and use dot, since it yields more +# powerful graphs. + +CLASS_DIAGRAMS = NO + +# You can define message sequence charts within doxygen comments using the \msc +# command. Doxygen will then run the mscgen tool (see +# http://www.mcternan.me.uk/mscgen/) to produce the chart and insert it in the +# documentation. The MSCGEN_PATH tag allows you to specify the directory where +# the mscgen tool resides. If left empty the tool is assumed to be found in the +# default search path. + +MSCGEN_PATH = + +# If set to YES, the inheritance and collaboration graphs will hide +# inheritance and usage relations if the target is undocumented +# or is not a class. + +HIDE_UNDOC_RELATIONS = YES + +# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is +# available from the path. This tool is part of Graphviz, a graph visualization +# toolkit from AT&T and Lucent Bell Labs. The other options in this section +# have no effect if this option is set to NO (the default) + +HAVE_DOT = YES + +# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is +# allowed to run in parallel. When set to 0 (the default) doxygen will +# base this on the number of processors available in the system. You can set it +# explicitly to a value larger than 0 to get control over the balance +# between CPU load and processing speed. + +DOT_NUM_THREADS = 0 + +# By default doxygen will write a font called FreeSans.ttf to the output +# directory and reference it in all dot files that doxygen generates. This +# font does not include all possible unicode characters however, so when you need +# these (or just want a differently looking font) you can specify the font name +# using DOT_FONTNAME. You need need to make sure dot is able to find the font, +# which can be done by putting it in a standard location or by setting the +# DOTFONTPATH environment variable or by setting DOT_FONTPATH to the directory +# containing the font. + +DOT_FONTNAME = FreeSans.ttf + +# The DOT_FONTSIZE tag can be used to set the size of the font of dot graphs. +# The default size is 10pt. + +DOT_FONTSIZE = 10 + +# By default doxygen will tell dot to use the output directory to look for the +# FreeSans.ttf font (which doxygen will put there itself). If you specify a +# different font using DOT_FONTNAME you can set the path where dot +# can find it using this tag. + +DOT_FONTPATH = + +# If the CLASS_GRAPH and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for each documented class showing the direct and +# indirect inheritance relations. Setting this tag to YES will force the +# the CLASS_DIAGRAMS tag to NO. + +CLASS_GRAPH = YES + +# If the COLLABORATION_GRAPH and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for each documented class showing the direct and +# indirect implementation dependencies (inheritance, containment, and +# class references variables) of the class with other documented classes. + +COLLABORATION_GRAPH = YES + +# If the GROUP_GRAPHS and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for groups, showing the direct groups dependencies + +GROUP_GRAPHS = YES + +# If the UML_LOOK tag is set to YES doxygen will generate inheritance and +# collaboration diagrams in a style similar to the OMG's Unified Modeling +# Language. + +UML_LOOK = NO + +# If set to YES, the inheritance and collaboration graphs will show the +# relations between templates and their instances. + +TEMPLATE_RELATIONS = NO + +# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDE_GRAPH, and HAVE_DOT +# tags are set to YES then doxygen will generate a graph for each documented +# file showing the direct and indirect include dependencies of the file with +# other documented files. + +INCLUDE_GRAPH = YES + +# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDED_BY_GRAPH, and +# HAVE_DOT tags are set to YES then doxygen will generate a graph for each +# documented header file showing the documented files that directly or +# indirectly include this file. + +INCLUDED_BY_GRAPH = YES + +# If the CALL_GRAPH and HAVE_DOT options are set to YES then +# doxygen will generate a call dependency graph for every global function +# or class method. Note that enabling this option will significantly increase +# the time of a run. So in most cases it will be better to enable call graphs +# for selected functions only using the \callgraph command. + +CALL_GRAPH = YES + +# If the CALLER_GRAPH and HAVE_DOT tags are set to YES then +# doxygen will generate a caller dependency graph for every global function +# or class method. Note that enabling this option will significantly increase +# the time of a run. So in most cases it will be better to enable caller +# graphs for selected functions only using the \callergraph command. + +CALLER_GRAPH = YES + +# If the GRAPHICAL_HIERARCHY and HAVE_DOT tags are set to YES then doxygen +# will graphical hierarchy of all classes instead of a textual one. + +GRAPHICAL_HIERARCHY = YES + +# If the DIRECTORY_GRAPH, SHOW_DIRECTORIES and HAVE_DOT tags are set to YES +# then doxygen will show the dependencies a directory has on other directories +# in a graphical way. The dependency relations are determined by the #include +# relations between the files in the directories. + +DIRECTORY_GRAPH = YES + +# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images +# generated by dot. Possible values are png, jpg, or gif +# If left blank png will be used. + +DOT_IMAGE_FORMAT = png + +# The tag DOT_PATH can be used to specify the path where the dot tool can be +# found. If left blank, it is assumed the dot tool can be found in the path. + +DOT_PATH = + +# The DOTFILE_DIRS tag can be used to specify one or more directories that +# contain dot files that are included in the documentation (see the +# \dotfile command). + +DOTFILE_DIRS = + +# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of +# nodes that will be shown in the graph. If the number of nodes in a graph +# becomes larger than this value, doxygen will truncate the graph, which is +# visualized by representing a node as a red box. Note that doxygen if the +# number of direct children of the root node in a graph is already larger than +# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note +# that the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH. + +DOT_GRAPH_MAX_NODES = 50 + +# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the +# graphs generated by dot. A depth value of 3 means that only nodes reachable +# from the root by following a path via at most 3 edges will be shown. Nodes +# that lay further from the root node will be omitted. Note that setting this +# option to 1 or 2 may greatly reduce the computation time needed for large +# code bases. Also note that the size of a graph can be further restricted by +# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction. + +MAX_DOT_GRAPH_DEPTH = 0 + +# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent +# background. This is disabled by default, because dot on Windows does not +# seem to support this out of the box. Warning: Depending on the platform used, +# enabling this option may lead to badly anti-aliased labels on the edges of +# a graph (i.e. they become hard to read). + +DOT_TRANSPARENT = NO + +# Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output +# files in one run (i.e. multiple -o and -T options on the command line). This +# makes dot run faster, but since only newer versions of dot (>1.8.10) +# support this, this feature is disabled by default. + +DOT_MULTI_TARGETS = NO + +# If the GENERATE_LEGEND tag is set to YES (the default) Doxygen will +# generate a legend page explaining the meaning of the various boxes and +# arrows in the dot generated graphs. + +GENERATE_LEGEND = YES + +# If the DOT_CLEANUP tag is set to YES (the default) Doxygen will +# remove the intermediate dot files that are used to generate +# the various graphs. + +DOT_CLEANUP = YES diff --git a/config/juropa.cmake b/config/juropa.cmake new file mode 100644 index 00000000..dd6940a7 --- /dev/null +++ b/config/juropa.cmake @@ -0,0 +1,16 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") +set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/v4.3.2/include") +set(NETCDF_LIB_1 "/usr/local/netcdf/v4.3.2/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/local/netcdf/v4.3.2/lib/libnetcdf.a") +set(HDF5_LIB_1 "/usr/local/hdf5/v1.8.13_serial/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/local/hdf5/v1.8.13_serial/lib/libhdf5.a") +set(SZIP_LIB "/usr/local/szip/lib/libsz.a") +set(ZLIB_LIB "/usr/local/zlib/lib/libz.a") +set(CURL_LIB "/usr/local/curl/lib/libcurl.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m ${ZLIB_LIB} curl) diff --git a/config/oakley.cmake b/config/oakley.cmake new file mode 100644 index 00000000..a583d622 --- /dev/null +++ b/config/oakley.cmake @@ -0,0 +1,15 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-debug -traceback -r8 -ftz -extend_source ") +set(USER_Fortran_FLAGS_RELEASE " -O3 -no-prec-div -xHost") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created ") + +set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/include") +set(NETCDF_LIB_1 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdf.a") +set(HDF5_LIB_1 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/osx.cmake b/config/osx.cmake new file mode 100755 index 00000000..cf1d185e --- /dev/null +++ b/config/osx.cmake @@ -0,0 +1,15 @@ +# OS X +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/opt/local/include") +set(NETCDF_LIB_1 "/opt/local/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/opt/local/lib/libnetcdf.a") +set(HDF5_LIB_1 "/opt/local/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/opt/local/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/ruby.cmake b/config/ruby.cmake new file mode 100644 index 00000000..5b44f9be --- /dev/null +++ b/config/ruby.cmake @@ -0,0 +1,15 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source ") +set(USER_Fortran_FLAGS_RELEASE " -O3 -no-prec-div -xHost") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created ") + +set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/include") +set(NETCDF_LIB_1 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdf.a") +set(HDF5_LIB_1 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/supermuc.cmake b/config/supermuc.cmake new file mode 100644 index 00000000..9e048d86 --- /dev/null +++ b/config/supermuc.cmake @@ -0,0 +1,15 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpfort) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -fp-model source -xAVX") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/lrz/sys/libraries/netcdf/4.2.1.1/include") +set(NETCDF_LIB_1 "/lrz/sys/libraries/netcdf/4.2.1.1/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/lrz/sys/libraries/netcdf/4.2.1.1/lib/libnetcdf.a") +set(HDF5_LIB_1 "/lrz/sys/libraries/netcdf/hdf5_1.8.9/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/lrz/sys/libraries/netcdf/hdf5_1.8.9/lib/libhdf5.a") +set(SZIP_LIB "/lrz/sys/libraries/hdf5/szip_2.1_u1/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/thunder.cmake b/config/thunder.cmake new file mode 100644 index 00000000..40571e08 --- /dev/null +++ b/config/thunder.cmake @@ -0,0 +1,15 @@ +# Thunder +set(CMAKE_Fortran_COMPILER "ifort") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") +set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xAVX -fp-model source") +set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") + +set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf_fortran-4.2-static-intel13/include") +set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf_fortran-4.2-static-intel13/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-4.2-static/lib/libnetcdf.a") +set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.8-static/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.8-static/lib/libhdf5.a") +set(SZIP_LIB "/sw/squeeze-x64/szip-2.1-static/lib/libsz.a") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/thunder.cmake.orig b/config/thunder.cmake.orig new file mode 100644 index 00000000..b29c9136 --- /dev/null +++ b/config/thunder.cmake.orig @@ -0,0 +1,10 @@ +<<<<<<< HEAD +set (ENV{NETCDF_ROOT} /sw/squeeze-x64/netcdf-4.2-static/:/sw/squeeze-x64/netcdf_fortran-latest-static-intel13) +set (ENV{HDF5_ROOT} /sw/squeeze-x64/hdf5-1.8.8-static) +======= +set (ENV{NETCDF_ROOT} /sw/squeeze-x64/netcdf-latest-static-intel12) +set (ENV{HDF5_ROOT} /sw/squeeze-x64/hdf5-latest-static) +set (ENV{FFTW_ROOT} /sw/squeeze-x64/fftw-3.2.1) +>>>>>>> annkristin +set (NETCDF_USE_STATIC_LIBRARIES TRUE) +set (HDF5_USE_STATIC_LIBRARIES TRUE) diff --git a/config/ubuntu.cmake b/config/ubuntu.cmake new file mode 100755 index 00000000..921a5ce3 --- /dev/null +++ b/config/ubuntu.cmake @@ -0,0 +1,15 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/usr/include") +set(NETCDF_LIB_1 "/usr/lib/libnetcdff.a") +set(NETCDF_LIB_2 "/usr/lib/libnetcdf.a") +set(HDF5_LIB_1 "/usr/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4570e3b2..071bd5f4 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,5 +1,4 @@ -set(target_name dales4) -FILE(GLOB sourcefiles "*.f90") -add_executable(${target_name} ${sourcefiles}) -target_link_libraries(${target_name} ${NETCDF_LIBS}) -install(TARGETS dales4 DESTINATION ${CMAKE_BINARY_DIR}) +FILE(GLOB sourcefiles "*.?90") +add_executable(${PROJECT_NAME} ${sourcefiles}) +include_directories(${INCLUDE_DIRS}) +target_link_libraries(${PROJECT_NAME} ${LIBS}) From b8e5375213b3de0871dcafb03450d4e0029317f4 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 29 Jun 2016 18:36:08 -0400 Subject: [PATCH 10/88] Default.cmake should never be commited to git --- config/default.cmake | 19 ------------------- config/default.cmake~ | 15 --------------- config/thunder.cmake.orig | 10 ---------- 3 files changed, 44 deletions(-) delete mode 100755 config/default.cmake delete mode 100644 config/default.cmake~ delete mode 100644 config/thunder.cmake.orig diff --git a/config/default.cmake b/config/default.cmake deleted file mode 100755 index ae68862b..00000000 --- a/config/default.cmake +++ /dev/null @@ -1,19 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/usr/include") -set(NETCDF_LIB_1 "/usr/lib64/libnetcdff.so") -set(NETCDF_LIB_2 "/usr/lib64/libnetcdf.so") -set(HDF5_LIB_1 "/usr/lib64/libhdf5_hl.so") -set(HDF5_LIB_2 "/usr/lib64/libhdf5.so") -# set(HDF4_LIB_1 "/usr/lib64/hdf/libdf.a") -# set(HDF4_LIB_2 "/usr/lib64/hdf/libmfhdf.a") -set(HDF4_LIB_1 "") -set(HDF4_LIB_2 "") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${HDF4_LIB_2} ${HDF4_LIB_1} ${SZIP_LIB} dl m z curl) diff --git a/config/default.cmake~ b/config/default.cmake~ deleted file mode 100644 index 4da7a8d0..00000000 --- a/config/default.cmake~ +++ /dev/null @@ -1,15 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/usr/include") -set(NETCDF_LIB_1 "/usr/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/lib/libnetcdf.a") -set(HDF5_LIB_1 "/usr/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2}) diff --git a/config/thunder.cmake.orig b/config/thunder.cmake.orig deleted file mode 100644 index b29c9136..00000000 --- a/config/thunder.cmake.orig +++ /dev/null @@ -1,10 +0,0 @@ -<<<<<<< HEAD -set (ENV{NETCDF_ROOT} /sw/squeeze-x64/netcdf-4.2-static/:/sw/squeeze-x64/netcdf_fortran-latest-static-intel13) -set (ENV{HDF5_ROOT} /sw/squeeze-x64/hdf5-1.8.8-static) -======= -set (ENV{NETCDF_ROOT} /sw/squeeze-x64/netcdf-latest-static-intel12) -set (ENV{HDF5_ROOT} /sw/squeeze-x64/hdf5-latest-static) -set (ENV{FFTW_ROOT} /sw/squeeze-x64/fftw-3.2.1) ->>>>>>> annkristin -set (NETCDF_USE_STATIC_LIBRARIES TRUE) -set (HDF5_USE_STATIC_LIBRARIES TRUE) From 2af42f9fb58153937e1a1813c204a8cb1cdeb525 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 30 Jun 2016 16:31:07 -0400 Subject: [PATCH 11/88] Bug in case files: Namoptions still used imax instead of itot --- cases/arm_brown/namoptions.001 | 2 +- cases/arm_unstable/namoptions.001 | 2 +- cases/atex/namoptions.001 | 2 +- cases/bomex/namoptions.001 | 2 +- cases/cblstrong/namoptions.001 | 2 +- cases/chem/input/namoptions.001 | 2 +- cases/dycoms_rf02/namoptions.001 | 2 +- cases/example/input/namoptions.001 | 2 +- cases/example/input/namoptions.lsm | 2 +- cases/example/input/namoptions.lsmrad | 2 +- cases/example/inputwindnoneq/namoptions.001 | 2 +- cases/example/namoptions.001 | 2 +- cases/example/namoptions.lsm | 2 +- cases/example/namoptions.lsmrad | 2 +- cases/fog/namoptions.001 | 2 +- cases/gabls1/namoptions.001 | 2 +- cases/heterogen/namoptions.841 | 2 +- cases/heterogen/namoptions.941 | 2 +- cases/hireslapse/namoptions.001 | 2 +- cases/neutral/namoptions.001 | 2 +- cases/rico/namoptions.001 | 2 +- cases/smoke/namoptions.001 | 2 +- 22 files changed, 22 insertions(+), 22 deletions(-) diff --git a/cases/arm_brown/namoptions.001 b/cases/arm_brown/namoptions.001 index 39b71ce4..400ad73a 100644 --- a/cases/arm_brown/namoptions.001 +++ b/cases/arm_brown/namoptions.001 @@ -13,7 +13,7 @@ nsv = 0 / &DOMAIN -imax = 512 +itot = 512 jtot = 512 kmax = 224 diff --git a/cases/arm_unstable/namoptions.001 b/cases/arm_unstable/namoptions.001 index 39b71ce4..400ad73a 100644 --- a/cases/arm_unstable/namoptions.001 +++ b/cases/arm_unstable/namoptions.001 @@ -13,7 +13,7 @@ nsv = 0 / &DOMAIN -imax = 512 +itot = 512 jtot = 512 kmax = 224 diff --git a/cases/atex/namoptions.001 b/cases/atex/namoptions.001 index 9f3313b1..8a17f0bc 100644 --- a/cases/atex/namoptions.001 +++ b/cases/atex/namoptions.001 @@ -12,7 +12,7 @@ nsv = 0 / &DOMAIN -imax = 256 +itot = 256 jtot = 256 kmax = 200 diff --git a/cases/bomex/namoptions.001 b/cases/bomex/namoptions.001 index 61799230..80435485 100644 --- a/cases/bomex/namoptions.001 +++ b/cases/bomex/namoptions.001 @@ -12,7 +12,7 @@ nsv = 0 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 80 diff --git a/cases/cblstrong/namoptions.001 b/cases/cblstrong/namoptions.001 index 5cfbf1db..8c2874bb 100644 --- a/cases/cblstrong/namoptions.001 +++ b/cases/cblstrong/namoptions.001 @@ -12,7 +12,7 @@ nsv = 1 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/chem/input/namoptions.001 b/cases/chem/input/namoptions.001 index 0331d9af..566ad744 100644 --- a/cases/chem/input/namoptions.001 +++ b/cases/chem/input/namoptions.001 @@ -14,7 +14,7 @@ timeav_glob= 60. / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 128 diff --git a/cases/dycoms_rf02/namoptions.001 b/cases/dycoms_rf02/namoptions.001 index 94b4aaa5..c0bdacd0 100644 --- a/cases/dycoms_rf02/namoptions.001 +++ b/cases/dycoms_rf02/namoptions.001 @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 128 +itot = 128 jtot = 128 kmax = 160 diff --git a/cases/example/input/namoptions.001 b/cases/example/input/namoptions.001 index 5ddae934..717f21fe 100644 --- a/cases/example/input/namoptions.001 +++ b/cases/example/input/namoptions.001 @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/input/namoptions.lsm b/cases/example/input/namoptions.lsm index f32c3fda..70afd02c 100644 --- a/cases/example/input/namoptions.lsm +++ b/cases/example/input/namoptions.lsm @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/input/namoptions.lsmrad b/cases/example/input/namoptions.lsmrad index 1c5c21bc..a3343a5e 100644 --- a/cases/example/input/namoptions.lsmrad +++ b/cases/example/input/namoptions.lsmrad @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/inputwindnoneq/namoptions.001 b/cases/example/inputwindnoneq/namoptions.001 index 74e4a9ab..f87a082c 100644 --- a/cases/example/inputwindnoneq/namoptions.001 +++ b/cases/example/inputwindnoneq/namoptions.001 @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/namoptions.001 b/cases/example/namoptions.001 index 5ddae934..717f21fe 100644 --- a/cases/example/namoptions.001 +++ b/cases/example/namoptions.001 @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/namoptions.lsm b/cases/example/namoptions.lsm index f32c3fda..70afd02c 100644 --- a/cases/example/namoptions.lsm +++ b/cases/example/namoptions.lsm @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/example/namoptions.lsmrad b/cases/example/namoptions.lsmrad index 1c5c21bc..a3343a5e 100644 --- a/cases/example/namoptions.lsmrad +++ b/cases/example/namoptions.lsmrad @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 96 diff --git a/cases/fog/namoptions.001 b/cases/fog/namoptions.001 index 956020d7..86cb9bc0 100644 --- a/cases/fog/namoptions.001 +++ b/cases/fog/namoptions.001 @@ -13,7 +13,7 @@ courant = 1. / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 64 diff --git a/cases/gabls1/namoptions.001 b/cases/gabls1/namoptions.001 index c98defaa..fb2de06d 100644 --- a/cases/gabls1/namoptions.001 +++ b/cases/gabls1/namoptions.001 @@ -12,7 +12,7 @@ ladaptive = .true. / &DOMAIN -imax = 128 +itot = 128 jtot = 128 kmax = 128 diff --git a/cases/heterogen/namoptions.841 b/cases/heterogen/namoptions.841 index 1baa7ee1..31b7ba9e 100644 --- a/cases/heterogen/namoptions.841 +++ b/cases/heterogen/namoptions.841 @@ -14,7 +14,7 @@ timeav_glob= 60. / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 128 diff --git a/cases/heterogen/namoptions.941 b/cases/heterogen/namoptions.941 index 8ca8997a..d678f248 100644 --- a/cases/heterogen/namoptions.941 +++ b/cases/heterogen/namoptions.941 @@ -14,7 +14,7 @@ timeav_glob= 60. / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 128 diff --git a/cases/hireslapse/namoptions.001 b/cases/hireslapse/namoptions.001 index f9416c7a..a169c8d7 100644 --- a/cases/hireslapse/namoptions.001 +++ b/cases/hireslapse/namoptions.001 @@ -12,7 +12,7 @@ nsv = 0 / &DOMAIN -imax = 128 +itot = 128 jtot = 128 kmax = 196 diff --git a/cases/neutral/namoptions.001 b/cases/neutral/namoptions.001 index e8acb2ed..e8a1a7b1 100644 --- a/cases/neutral/namoptions.001 +++ b/cases/neutral/namoptions.001 @@ -12,7 +12,7 @@ nsv = 0 / &DOMAIN -imax = 96 +itot = 96 jtot = 96 kmax = 100 diff --git a/cases/rico/namoptions.001 b/cases/rico/namoptions.001 index d1d48f99..e7a7eebd 100644 --- a/cases/rico/namoptions.001 +++ b/cases/rico/namoptions.001 @@ -12,7 +12,7 @@ nsv = 2 / &DOMAIN -imax = 128 +itot = 128 jtot = 128 kmax = 126 diff --git a/cases/smoke/namoptions.001 b/cases/smoke/namoptions.001 index 7bcc21a0..e0af0e0a 100644 --- a/cases/smoke/namoptions.001 +++ b/cases/smoke/namoptions.001 @@ -13,7 +13,7 @@ courant = 0.5 / &DOMAIN -imax = 64 +itot = 64 jtot = 64 kmax = 250 From 72f5610635c2b71df670372dd4e6b8451af93df8 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 30 Jun 2016 17:35:23 -0400 Subject: [PATCH 12/88] Add cmake config for Thijs' PC --- config/fedora.cmake | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100755 config/fedora.cmake diff --git a/config/fedora.cmake b/config/fedora.cmake new file mode 100755 index 00000000..813e61f7 --- /dev/null +++ b/config/fedora.cmake @@ -0,0 +1,16 @@ +# ARCH Linux +set(CMAKE_Fortran_COMPILER "gfortran") +set(Fortran_COMPILER_WRAPPER mpif90) + +set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none -I/usr/lib64/gfortran/modules -I/usr/lib64/gfortran/modules/mpich ") +set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") +set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") + +set(NETCDF_INCLUDE_DIR "/usr/include") +set(NETCDF_LIB_1 "/usr/lib64/mpich/lib/libnetcdff.so") +set(NETCDF_LIB_2 "/usr/lib64/mpich/lib/libnetcdf.so") +set(HDF5_LIB_1 "/usr/lib64/mpich/lib/libhdf5_hl.a") +set(HDF5_LIB_2 "/usr/lib64/mpich/lib/libhdf5.a") +set(SZIP_LIB "") +set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2}) +# set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} /usr/lib64/hdf/libmfhdf.a /usr/lib64/libdl.so ${SZIP_LIB} m z curl) From d0307cebc77369582118aedc2b490b4c3526259b Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 30 Jun 2016 17:55:27 -0400 Subject: [PATCH 13/88] Fix restartfile naming --- src/modstartup.f90 | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 984accc1..643434b3 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -816,7 +816,7 @@ subroutine readrestartfiles !----------------------------------------------------------------- name = startfile name(5:5) = 'd' - name(12:19)=cmyid + name(13:20)=cmyid write(6,*) 'loading ',name open(unit=ifinput,file=name,form='unformatted', status='old') @@ -913,11 +913,11 @@ subroutine writerestartfiles tnextrestart = tnextrestart+itrestart ihour = floor(rtimee/3600) imin = floor((rtimee-ihour * 3600) /3600. * 60.) - name = 'initd h m .' + name = 'initdXXXhXXmXXXXXXXX.XXX' write (name(6:8) ,'(i3.3)') ihour write (name(10:11),'(i2.2)') imin - name(13:15)= cmyid - name(17:19)= cexpnr + name(13:20)= cmyid + name(22:24)= cexpnr open (ifoutput,file=name,form='unformatted',status='replace') write(ifoutput) (((u0 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) @@ -960,11 +960,7 @@ subroutine writerestartfiles call system("cp "//name //" "//linkname) if (nsv>0) then - name = 'inits h m .' - write (name(6:8) ,'(i3.3)') ihour - write (name(10:11),'(i2.2)') imin - name(13:15) = cmyid - name(17:19) = cexpnr + name(5:5)='s' open (ifoutput,file=name,form='unformatted') write(ifoutput) ((((sv0(i,j,k,n),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1),n=1,nsv) write(ifoutput) (((svflux(i,j,n),i=1,i2),j=1,j2),n=1,nsv) @@ -979,11 +975,7 @@ subroutine writerestartfiles end if if (isurf == 1) then - name = 'initl h m .' - write (name(6:8) ,'(i3.3)') ihour - write (name(10:11),'(i2.2)') imin - name(13:15) = cmyid - name(17:19) = cexpnr + name(5:5)='l' open (ifoutput,file=name,form='unformatted') write(ifoutput) (((tsoil(i,j,k),i=1,i2),j=1,j2),k=1,ksoilmax) write(ifoutput) (((phiw(i,j,k),i=1,i2),j=1,j2),k=1,ksoilmax) From 2b9a090bfb18cea03ee2326b90f5b2adc5ce50c6 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Mon, 4 Jul 2016 10:56:09 -0400 Subject: [PATCH 14/88] BUG FIX: ii is an unnecessary counter in the mpi exchange if there is only 1 proc. Caused crash in debug mode. --- src/modmpi.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/modmpi.f90 b/src/modmpi.f90 index f2046359..592fb140 100644 --- a/src/modmpi.f90 +++ b/src/modmpi.f90 @@ -213,7 +213,7 @@ subroutine excj( a, sx, ex, sy, ey, sz,ez) else do k=sz,ez do i=sx,ex - ii = ii + 1 +! ii = ii + 1 a(i,sy,k) = a(i,ey-1,k) a(i,ey,k) = a(i,sy+1,k) enddo @@ -259,7 +259,7 @@ subroutine excj( a, sx, ex, sy, ey, sz,ez) else do k=sz,ez do i=sy,ey - ii = ii + 1 +! ii = ii + 1 a(sx,i,k) = a(ex-1,i,k) a(ex,i,k) = a(sx+1,i,k) enddo From 33d431a4f9f134c02296d057b0b32bce8e1d5f60 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Mon, 4 Jul 2016 11:16:08 -0400 Subject: [PATCH 15/88] BUG FIX Testbed: Tnudge array dimensions were reversed --- src/modtestbed.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modtestbed.f90 b/src/modtestbed.f90 index 52bc9497..d85a198d 100644 --- a/src/modtestbed.f90 +++ b/src/modtestbed.f90 @@ -717,7 +717,7 @@ subroutine testbednudge qtthres = 1e-6 do k=1,kmax - currtnudge = max(rdt,tnudge(k,t)*dtp+tnudge(k,t+1)*dtm) + currtnudge = max(rdt,tnudge(t,k)*dtp+tnudge(t+1,k)*dtm) if (ltb_u) up(2:i1,2:j1,k) = up(2:i1,2:j1,k) - & ( u0av(k) - (tb_u(t,k) *dtp + tb_u(t+1,k) *dtm) ) / currtnudge From e6941b25f64ddacb9ae1f9b28a4f76fa1da58106 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Sat, 9 Jul 2016 13:22:46 -0400 Subject: [PATCH 16/88] Radiation: sw0 was not set to the solar constant, but to some arbitrary value --- src/modraddata.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/modraddata.f90 b/src/modraddata.f90 index c508d065..da5332ec 100644 --- a/src/modraddata.f90 +++ b/src/modraddata.f90 @@ -56,7 +56,9 @@ module modraddata real :: rka = 130. !< extinction coefficient in radpar scheme real :: dlwtop = 74. !< longwave radiative flux divergence at top of domain real :: dlwbot = 0. !< longwave radiative flux divergence near the surface - real :: sw0 = 1100.0 !< direct component at top of the cloud (W/m^2) + real :: sw0 = 1368.22 !< Solar constant (in W/m2). SWD at TOA = sw0*cos(mu) + !< NOTE: when using delta-Eddington (iradiation=2) this represents the downwelling solar + ! radiation at the top of the domain/cloud real :: gc = 0.85 !< asymmetry factor of droplet scattering angle distribution real :: SSA = 0.999 !< typical single scattering albedo for clouds From 9bb4997e430f4f7f3cc1d49410f8f8dcc2e54007 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Mon, 11 Jul 2016 09:30:42 -0400 Subject: [PATCH 17/88] Revert "UCLALES-style CMake. Easier to set up new/own environments, control of library paths etc" This reverts commit ac4c5ee37ea3a1be352df4f4242ddb5143724f5b. --- CMakeLists.txt | 173 ++- config/archlinux.cmake | 15 - config/blizzard.cmake | 15 - config/cheopsgcc.cmake | 15 - config/cheopsintel.cmake | 15 - config/cheopsintel_localnetcdf.cmake | 15 - config/defaultgcc.cmake | 15 - config/defaultintel.cmake | 15 - config/doxygen.conf.in | 1662 -------------------------- config/fedora.cmake | 16 - config/juropa.cmake | 16 - config/oakley.cmake | 15 - config/osx.cmake | 15 - config/ruby.cmake | 15 - config/supermuc.cmake | 15 - config/thunder.cmake | 15 - config/ubuntu.cmake | 15 - src/CMakeLists.txt | 9 +- 18 files changed, 113 insertions(+), 1958 deletions(-) delete mode 100644 config/archlinux.cmake delete mode 100644 config/blizzard.cmake delete mode 100644 config/cheopsgcc.cmake delete mode 100644 config/cheopsintel.cmake delete mode 100644 config/cheopsintel_localnetcdf.cmake delete mode 100644 config/defaultgcc.cmake delete mode 100644 config/defaultintel.cmake delete mode 100644 config/doxygen.conf.in delete mode 100755 config/fedora.cmake delete mode 100644 config/juropa.cmake delete mode 100644 config/oakley.cmake delete mode 100755 config/osx.cmake delete mode 100644 config/ruby.cmake delete mode 100644 config/supermuc.cmake delete mode 100644 config/thunder.cmake delete mode 100755 config/ubuntu.cmake diff --git a/CMakeLists.txt b/CMakeLists.txt index 98a16116..d65f33e7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,71 +1,127 @@ -############################ -# DALES CMAKE FILE -# Supports (thusfar) GNU, Intel and IBM compilers -# To set the compiler to a specific one, set the FC environment variable -# NETCDF can be set in the config/default.cmake, or through command line options -# NETCDF_INCLUDE, NETCDF_LIB, FFTW_INCLUDE and FFTW_LIB, respectively. -# Command line options are fed to CMake using the -D switch -# Options include: -# * MPI (TRUE/FALSE) to toggle the use of MPI. True by default. -# * PROFILER (SCALASCA/MARMOT) to enable a specific profiler. Default is none. -# * CMAKE_BUILD_TYPE (RELEASE/DEBUG) to build in optimized or debug mode. Default is RELEASE -# All options are persistent in the sense that once set, they will last until changed by the user. -# For daily use "cmake .. && make" should suffice to build the code, but a command line could look like: -# export FC="gfortran" && cmake -D SYST=tornado -D MPI=TRUE -D PROFILER=SCALASCA -D CMAKE_BUILD_TYPE=DEBUG .. && make -############################ -set (CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${CMAKE_CURRENT_SOURCE_DIR}/config) +### Choose CMAKE Type +if(NOT CMAKE_BUILD_TYPE) + set (CMAKE_BUILD_TYPE RELEASE CACHE STRING + "Choose the type of build, options are: None Debug Release." + FORCE) +endif() -INCLUDE(CMakeForceCompiler) #Necessary to change between MPI/parallel/profiler compilers, without having to do a make clean -cmake_minimum_required (VERSION 2.8.1) -set (CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}) +### Set compiler flags +if("$ENV{SYST}" STREQUAL "HUYGENS") + set(CMAKE_Fortran_COMPILER "mpfort") + set(CMAKE_Fortran_FLAGS "-qfree=F90 -qrealsize=8 -qwarn64 -qflttrap=en:ov:zero:inv:imp -qflag=w:e" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-O4 -qnoipa -qstrict=none:exceptions" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-O2 -g -qfullpath -C -qflttrp=enable:nanq:overflow:zerodivide -qsigtrap -qinitauto=ff" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "CARTESIUS") + set(CMAKE_Fortran_COMPILER "mpiifort") + set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "localpc_ifort") + set(CMAKE_Fortran_COMPILER "mpif90") + set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "HYDRA") + set(CMAKE_Fortran_COMPILER "mpiifort") + set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "FEDORA") + set(CMAKE_Fortran_COMPILER "mpif90") + set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none -I /usr/lib64/gfortran/modules/mpich/" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") +else() + set(CMAKE_Fortran_COMPILER "mpif90") + set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none " CACHE STRING "") + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") +endif() +## Project parameters +PROJECT(DALES Fortran) +cmake_minimum_required(VERSION 2.6) +set(VERSION_MAJOR "4") +set(VERSION_MINOR "2") +set(VERSION_PATCH "0") -# make sure that the default is a RELEASE -if (NOT CMAKE_BUILD_TYPE) - set (CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are: None Debug Release." FORCE ) -else() - string(TOUPPER ${CMAKE_BUILD_TYPE} TEMP) - set(CMAKE_BUILD_TYPE ${TEMP} CACHE STRING - "Choose the type of build, options are: None Debug Release." FORCE) -endif () +### If necessary, resort to BASH-methods to find netcdf-directory +EXEC_PROGRAM(${CMAKE_CURRENT_SOURCE_DIR}/findnetcdf OUTPUT_VARIABLE ADDMODULEPATH) -#Load system specific settings -if (NOT SYST) - set (SYST default CACHE STRING - "Choose the location: mpipc thunder fedora archlinux supermuc jugene" FORCE ) -endif () -include (${SYST} OPTIONAL) +### Find NetCDF files +FIND_PATH(NETCDF_INCLUDE_DIR netcdf.mod NETCDF.mod + PATHS + $ENV{SARA_NETCDF_INCLUDE} + $ENV{SURFSARA_NETCDF_INCLUDE} + $ENV{NETCDF_INCLUDE} + ${ADDMODULEPATH}/include + /usr/include + $ENV{HOME}/include + /usr/lib64/gfortran/modules + DOC "NetCDF include directory (must contain netcdf.mod)" +) -#Start the project only after all the variables are set -project (dales Fortran) +FIND_LIBRARY(NETCDF_C_LIB netcdf + PATHS + $ENV{SARA_NETCDF_LIB} + $ENV{SURFSARA_NETCDF_LIB} + $ENV{NETCDF_LIB} + ${ADDMODULEPATH}/lib + ${ADDMODULEPATH}/lib64 + /usr/lib + /usr/lib64 + $ENV{HOME}/lib + $ENV{HOME}/lib64 + DOC "NetCDF C library" +) -get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER_ID} NAME) +FIND_LIBRARY(NETCDF_FORTRAN_LIB netcdff + PATHS + $ENV{SARA_NETCDF_LIB} + $ENV{SURFSARA_NETCDF_LIB} + $ENV{NETCDF_LIB} + ${ADDMODULEPATH}/lib + ${ADDMODULEPATH}/lib64 + /usr/lib + /usr/lib64 + $ENV{HOME}/lib + $ENV{HOME}/lib64 + DOC "NetCDF Fortran library" +) -if (NOT ${Fortran_COMPILER_WRAPPER} STREQUAL "") - CMAKE_FORCE_Fortran_COMPILER(${Fortran_COMPILER_WRAPPER} ${Fortran_COMPILER_NAME}) -endif () -MESSAGE(STATUS "Fortran Compiler " ${CMAKE_Fortran_COMPILER}) +if(NETCDF_INCLUDE_DIR) + include_directories(${NETCDF_INCLUDE_DIR}) +else(NETCDF_INCLUDE_DIR) + MESSAGE(STATUS "WARNING: No NETCDF bindings are found.") +endif(NETCDF_INCLUDE_DIR) -set(CMAKE_Fortran_FLAGS ${USER_Fortran_FLAGS} ) -set(CMAKE_Fortran_FLAGS_RELEASE ${USER_Fortran_FLAGS_RELEASE} ) -set(CMAKE_Fortran_FLAGS_DEBUG ${USER_Fortran_FLAGS_DEBUG}) -MESSAGE(STATUS "Build Type " ${CMAKE_BUILD_TYPE}) -if (CMAKE_BUILD_TYPE STREQUAL "RELEASE") - MESSAGE(STATUS "Compiler Flags " ${CMAKE_Fortran_FLAGS} ${CMAKE_Fortran_FLAGS_RELEASE}) +if(NETCDF_C_LIB) + set(NETCDF_LIBS ${NETCDF_C_LIB}) +else(NETCDF_C_LIB) + MESSAGE(STATUS "WARNING: No NETCDF bindings are found.") +endif(NETCDF_C_LIB) + +if(NETCDF_FORTRAN_LIB) + set(NETCDF_LIBS ${NETCDF_LIBS} ${NETCDF_FORTRAN_LIB}) +else(NETCDF_FORTRAN_LIB) + MESSAGE(STATUS "WARNING: No Fortran NETCDF bindings are found.") +endif(NETCDF_FORTRAN_LIB) + +### Documentation +INCLUDE(FindDoxygen) +if(DOXYGEN) + ADD_SUBDIRECTORY(utils/doc) else() - MESSAGE(STATUS "Compiler Flags " ${CMAKE_Fortran_FLAGS} ${CMAKE_Fortran_FLAGS_DEBUG}) + MESSAGE(STATUS "WARNING: Doxygen not found - Reference manual will not be created") endif() - -set(INCLUDE_DIRS ${NETCDF_INCLUDE_DIR}) ### Set case if(NOT CASE) set (CASE standard CACHE STRING "Set the case." FORCE) endif() - + ### Add case specific file FILE(GLOB usrfile "${CMAKE_CURRENT_SOURCE_DIR}/cases/${CASE}/moduser.f90") if(usrfile STREQUAL "") @@ -74,17 +130,4 @@ endif() execute_process(COMMAND ${CMAKE_COMMAND} -E copy_if_different ${usrfile} ${CMAKE_CURRENT_SOURCE_DIR}/src/moduser.f90) MESSAGE(STATUS "Case " ${CASE} " uses " ${usrfile}) -add_subdirectory(src) - - -##################### -# DOCUMENTATION -##################### -add_custom_target(todo ALL) -ADD_CUSTOM_COMMAND(TARGET todo POST_BUILD - COMMAND echo "UCLALES TODO LIST" > TODO - COMMAND date >> TODO - COMMAND grep -Rin \\todo src | sed 's/!.*TODO//I' >> TODO - WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} - ) - +ADD_SUBDIRECTORY(src) diff --git a/config/archlinux.cmake b/config/archlinux.cmake deleted file mode 100644 index 13d1eb36..00000000 --- a/config/archlinux.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "/usr/bin/gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/usr/include") -set(NETCDF_LIB_1 "/usr/lib64/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/lib64/libnetcdf.so") -set(HDF5_LIB_1 "/usr/lib64/libhdf5_hl.so") -set(HDF5_LIB_2 "/usr/lib64/libhdf5.so") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/blizzard.cmake b/config/blizzard.cmake deleted file mode 100644 index d88d191c..00000000 --- a/config/blizzard.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "xlf") -set(Fortran_COMPILER_WRAPPER mpxlf90) - -set(USER_Fortran_FLAGS "-qfree=F90 -qrealsize=8 -qwarn64 -qnosave -qinitauto=FFF00000 -qflttrap=en:ov:zero:inv:imp -qflag=w:e") -set(USER_Fortran_FLAGS_RELEASE "-O4 -qnoipa -qstrict=none:exceptions -qinitauto=ff -qsigtrap") -set(USER_Fortran_FLAGS_DEBUG "-O0 -qfullpath -C -g -qflttrp=enable:inexact:invalid:nanq:overflow:zerodivide -qsigtrap -qinitauto") - -set(NETCDF_INCLUDE_DIR "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/include") -set(NETCDF_LIB_1 "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/sw/aix61/netcdf-4.1.2-hdf5-threadsafe/lib/libnetcdf.a") -set(HDF5_LIB_1 "/sw/aix61/hdf5-1.8.6-threadsafe/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/sw/aix61/hdf5-1.8.6-threadsafe/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z) diff --git a/config/cheopsgcc.cmake b/config/cheopsgcc.cmake deleted file mode 100644 index 3353d384..00000000 --- a/config/cheopsgcc.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# CHEOPS GCC -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/opt/rrzk/lib/netcdf/4.1.3/include") -set(NETCDF_LIB_1 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdf.a") -set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") -set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/cheopsintel.cmake b/config/cheopsintel.cmake deleted file mode 100644 index 5e6b5a54..00000000 --- a/config/cheopsintel.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# CHEOPS Intel -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/opt/rrzk/lib/netcdf/4.1.3/include") -set(NETCDF_LIB_1 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/opt/rrzk/lib/netcdf/4.1.3/lib/libnetcdf.a") -set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") -set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/cheopsintel_localnetcdf.cmake b/config/cheopsintel_localnetcdf.cmake deleted file mode 100644 index d6817bf4..00000000 --- a/config/cheopsintel_localnetcdf.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# CHEOPS Intel -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpiifort) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/home/rneggers/bin/netcdf-4.3.0_ifort/include") -set(NETCDF_LIB_1 "/home/rneggers/bin/netcdf-4.3.0_ifort/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/home/rneggers/bin/netcdf-4.3.0_ifort/lib/libnetcdf.a") -set(HDF5_LIB_1 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/opt/rrzk/lib/hdf5/1.8.11/lib/libhdf5.a") -set(SZIP_LIB "/opt/rrzk/lib/szip/szip-2.1/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/defaultgcc.cmake b/config/defaultgcc.cmake deleted file mode 100644 index c0d6a034..00000000 --- a/config/defaultgcc.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Default GCC -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf-latest-static-gcc47/include") -set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf-latest-static-gcc47/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-latest-static-gcc47/lib/libnetcdf.a") -set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5.a") -set(SZIP_LIB "/sw/squeeze-x64/szip-2.1-static/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/defaultintel.cmake b/config/defaultintel.cmake deleted file mode 100644 index 05a9e4f3..00000000 --- a/config/defaultintel.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xHOST -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf_fortran-latest-static-intel13/include") -set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf_fortran-latest-static-intel13/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-4.2-static/lib/libnetcdf.a") -set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.7-static/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/doxygen.conf.in b/config/doxygen.conf.in deleted file mode 100644 index fc84e563..00000000 --- a/config/doxygen.conf.in +++ /dev/null @@ -1,1662 +0,0 @@ -# Doxyfile 1.7.1 - -# This file describes the settings to be used by the documentation system -# doxygen (www.doxygen.org) for a project -# -# All text after a hash (#) is considered a comment and will be ignored -# The format is: -# TAG = value [value, ...] -# For lists items can also be appended using: -# TAG += value [value, ...] -# Values that contain spaces should be placed between quotes (" ") - -#--------------------------------------------------------------------------- -# Project related configuration options -#--------------------------------------------------------------------------- - -# This tag specifies the encoding used for all characters in the config file -# that follow. The default is UTF-8 which is also the encoding used for all -# text before the first occurrence of this tag. Doxygen uses libiconv (or the -# iconv built into libc) for the transcoding. See -# http://www.gnu.org/software/libiconv for the list of possible encodings. - -DOXYFILE_ENCODING = UTF-8 - -# The PROJECT_NAME tag is a single word (or a sequence of words surrounded -# by quotes) that should identify the project. - -PROJECT_NAME = UCLALES - -# The PROJECT_NUMBER tag can be used to enter a project or revision number. -# This could be handy for archiving the generated documentation or -# if some version control system is used. - -PROJECT_NUMBER = V3.x - -# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) -# base path where the generated documentation will be put. -# If a relative path is entered, it will be relative to the location -# where doxygen was started. If left blank the current directory will be used. - -OUTPUT_DIRECTORY = ../doc/doxygen - -# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create -# 4096 sub-directories (in 2 levels) under the output directory of each output -# format and will distribute the generated files over these directories. -# Enabling this option can be useful when feeding doxygen a huge amount of -# source files, where putting all generated files in the same directory would -# otherwise cause performance problems for the file system. - -CREATE_SUBDIRS = NO - -# The OUTPUT_LANGUAGE tag is used to specify the language in which all -# documentation generated by doxygen is written. Doxygen will use this -# information to generate all constant output in the proper language. -# The default language is English, other supported languages are: -# Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional, -# Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German, -# Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English -# messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian, -# Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrilic, Slovak, -# Slovene, Spanish, Swedish, Ukrainian, and Vietnamese. - -OUTPUT_LANGUAGE = English - -# If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will -# include brief member descriptions after the members that are listed in -# the file and class documentation (similar to JavaDoc). -# Set to NO to disable this. - -BRIEF_MEMBER_DESC = YES - -# If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend -# the brief description of a member or function before the detailed description. -# Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the -# brief descriptions will be completely suppressed. - -REPEAT_BRIEF = YES - -# This tag implements a quasi-intelligent brief description abbreviator -# that is used to form the text in various listings. Each string -# in this list, if found as the leading text of the brief description, will be -# stripped from the text and the result after processing the whole list, is -# used as the annotated text. Otherwise, the brief description is used as-is. -# If left blank, the following values are used ("$name" is automatically -# replaced with the name of the entity): "The $name class" "The $name widget" -# "The $name file" "is" "provides" "specifies" "contains" -# "represents" "a" "an" "the" - -ABBREVIATE_BRIEF = "The $name class" \ - "The $name widget" \ - "The $name file" \ - is \ - provides \ - specifies \ - contains \ - represents \ - a \ - an \ - the - -# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then -# Doxygen will generate a detailed section even if there is only a brief -# description. - -ALWAYS_DETAILED_SEC = NO - -# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all -# inherited members of a class in the documentation of that class as if those -# members were ordinary class members. Constructors, destructors and assignment -# operators of the base classes will not be shown. - -INLINE_INHERITED_MEMB = NO - -# If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full -# path before files name in the file list and in the header files. If set -# to NO the shortest path that makes the file name unique will be used. - -FULL_PATH_NAMES = YES - -# If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag -# can be used to strip a user-defined part of the path. Stripping is -# only done if one of the specified strings matches the left-hand part of -# the path. The tag can be used to show relative paths in the file list. -# If left blank the directory from which doxygen is run is used as the -# path to strip. - -STRIP_FROM_PATH = - -# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of -# the path mentioned in the documentation of a class, which tells -# the reader which header file to include in order to use a class. -# If left blank only the name of the header file containing the class -# definition is used. Otherwise one should specify the include paths that -# are normally passed to the compiler using the -I flag. - -STRIP_FROM_INC_PATH = - -# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter -# (but less readable) file names. This can be useful is your file systems -# doesn't support long names like on DOS, Mac, or CD-ROM. - -SHORT_NAMES = NO - -# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen -# will interpret the first line (until the first dot) of a JavaDoc-style -# comment as the brief description. If set to NO, the JavaDoc -# comments will behave just like regular Qt-style comments -# (thus requiring an explicit @brief command for a brief description.) - -JAVADOC_AUTOBRIEF = NO - -# If the QT_AUTOBRIEF tag is set to YES then Doxygen will -# interpret the first line (until the first dot) of a Qt-style -# comment as the brief description. If set to NO, the comments -# will behave just like regular Qt-style comments (thus requiring -# an explicit \brief command for a brief description.) - -QT_AUTOBRIEF = NO - -# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen -# treat a multi-line C++ special comment block (i.e. a block of //! or /// -# comments) as a brief description. This used to be the default behaviour. -# The new default is to treat a multi-line C++ comment block as a detailed -# description. Set this tag to YES if you prefer the old behaviour instead. - -MULTILINE_CPP_IS_BRIEF = NO - -# If the INHERIT_DOCS tag is set to YES (the default) then an undocumented -# member inherits the documentation from any documented member that it -# re-implements. - -INHERIT_DOCS = YES - -# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce -# a new page for each member. If set to NO, the documentation of a member will -# be part of the file/class/namespace that contains it. - -SEPARATE_MEMBER_PAGES = NO - -# The TAB_SIZE tag can be used to set the number of spaces in a tab. -# Doxygen uses this value to replace tabs by spaces in code fragments. - -TAB_SIZE = 8 - -# This tag can be used to specify a number of aliases that acts -# as commands in the documentation. An alias has the form "name=value". -# For example adding "sideeffect=\par Side Effects:\n" will allow you to -# put the command \sideeffect (or @sideeffect) in the documentation, which -# will result in a user-defined paragraph with heading "Side Effects:". -# You can put \n's in the value part of an alias to insert newlines. - -ALIASES = - -# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C -# sources only. Doxygen will then generate output that is more tailored for C. -# For instance, some of the names that are used will be different. The list -# of all members will be omitted, etc. - -OPTIMIZE_OUTPUT_FOR_C = NO - -# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java -# sources only. Doxygen will then generate output that is more tailored for -# Java. For instance, namespaces will be presented as packages, qualified -# scopes will look different, etc. - -OPTIMIZE_OUTPUT_JAVA = NO - -# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran -# sources only. Doxygen will then generate output that is more tailored for -# Fortran. - -OPTIMIZE_FOR_FORTRAN = YES - -# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL -# sources. Doxygen will then generate output that is tailored for -# VHDL. - -OPTIMIZE_OUTPUT_VHDL = NO - -# Doxygen selects the parser to use depending on the extension of the files it -# parses. With this tag you can assign which parser to use for a given extension. -# Doxygen has a built-in mapping, but you can override or extend it using this -# tag. The format is ext=language, where ext is a file extension, and language -# is one of the parsers supported by doxygen: IDL, Java, Javascript, CSharp, C, -# C++, D, PHP, Objective-C, Python, Fortran, VHDL, C, C++. For instance to make -# doxygen treat .inc files as Fortran files (default is PHP), and .f files as C -# (default is Fortran), use: inc=Fortran f=C. Note that for custom extensions -# you also need to set FILE_PATTERNS otherwise the files are not read by doxygen. - -EXTENSION_MAPPING = - -# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want -# to include (a tag file for) the STL sources as input, then you should -# set this tag to YES in order to let doxygen match functions declarations and -# definitions whose arguments contain STL classes (e.g. func(std::string); v.s. -# func(std::string) {}). This also make the inheritance and collaboration -# diagrams that involve STL classes more complete and accurate. - -BUILTIN_STL_SUPPORT = NO - -# If you use Microsoft's C++/CLI language, you should set this option to YES to -# enable parsing support. - -CPP_CLI_SUPPORT = NO - -# Set the SIP_SUPPORT tag to YES if your project consists of sip sources only. -# Doxygen will parse them like normal C++ but will assume all classes use public -# instead of private inheritance when no explicit protection keyword is present. - -SIP_SUPPORT = NO - -# For Microsoft's IDL there are propget and propput attributes to indicate getter -# and setter methods for a property. Setting this option to YES (the default) -# will make doxygen to replace the get and set methods by a property in the -# documentation. This will only work if the methods are indeed getting or -# setting a simple type. If this is not the case, or you want to show the -# methods anyway, you should set this option to NO. - -IDL_PROPERTY_SUPPORT = YES - -# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC -# tag is set to YES, then doxygen will reuse the documentation of the first -# member in the group (if any) for the other members of the group. By default -# all members of a group must be documented explicitly. - -DISTRIBUTE_GROUP_DOC = NO - -# Set the SUBGROUPING tag to YES (the default) to allow class member groups of -# the same type (for instance a group of public functions) to be put as a -# subgroup of that type (e.g. under the Public Functions section). Set it to -# NO to prevent subgrouping. Alternatively, this can be done per class using -# the \nosubgrouping command. - -SUBGROUPING = YES - -# When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum -# is documented as struct, union, or enum with the name of the typedef. So -# typedef struct TypeS {} TypeT, will appear in the documentation as a struct -# with name TypeT. When disabled the typedef will appear as a member of a file, -# namespace, or class. And the struct will be named TypeS. This can typically -# be useful for C code in case the coding convention dictates that all compound -# types are typedef'ed and only the typedef is referenced, never the tag name. - -TYPEDEF_HIDES_STRUCT = NO - -# The SYMBOL_CACHE_SIZE determines the size of the internal cache use to -# determine which symbols to keep in memory and which to flush to disk. -# When the cache is full, less often used symbols will be written to disk. -# For small to medium size projects (<1000 input files) the default value is -# probably good enough. For larger projects a too small cache size can cause -# doxygen to be busy swapping symbols to and from disk most of the time -# causing a significant performance penality. -# If the system has enough physical memory increasing the cache will improve the -# performance by keeping more symbols in memory. Note that the value works on -# a logarithmic scale so increasing the size by one will rougly double the -# memory usage. The cache size is given by this formula: -# 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0, -# corresponding to a cache size of 2^16 = 65536 symbols - -SYMBOL_CACHE_SIZE = 0 - -#--------------------------------------------------------------------------- -# Build related configuration options -#--------------------------------------------------------------------------- - -# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in -# documentation are documented, even if no documentation was available. -# Private class members and static file members will be hidden unless -# the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES - -EXTRACT_ALL = YES - -# If the EXTRACT_PRIVATE tag is set to YES all private members of a class -# will be included in the documentation. - -EXTRACT_PRIVATE = NO - -# If the EXTRACT_STATIC tag is set to YES all static members of a file -# will be included in the documentation. - -EXTRACT_STATIC = NO - -# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) -# defined locally in source files will be included in the documentation. -# If set to NO only classes defined in header files are included. - -EXTRACT_LOCAL_CLASSES = YES - -# This flag is only useful for Objective-C code. When set to YES local -# methods, which are defined in the implementation section but not in -# the interface are included in the documentation. -# If set to NO (the default) only methods in the interface are included. - -EXTRACT_LOCAL_METHODS = NO - -# If this flag is set to YES, the members of anonymous namespaces will be -# extracted and appear in the documentation as a namespace called -# 'anonymous_namespace{file}', where file will be replaced with the base -# name of the file that contains the anonymous namespace. By default -# anonymous namespace are hidden. - -EXTRACT_ANON_NSPACES = NO - -# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all -# undocumented members of documented classes, files or namespaces. -# If set to NO (the default) these members will be included in the -# various overviews, but no documentation section is generated. -# This option has no effect if EXTRACT_ALL is enabled. - -HIDE_UNDOC_MEMBERS = NO - -# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all -# undocumented classes that are normally visible in the class hierarchy. -# If set to NO (the default) these classes will be included in the various -# overviews. This option has no effect if EXTRACT_ALL is enabled. - -HIDE_UNDOC_CLASSES = NO - -# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all -# friend (class|struct|union) declarations. -# If set to NO (the default) these declarations will be included in the -# documentation. - -HIDE_FRIEND_COMPOUNDS = NO - -# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any -# documentation blocks found inside the body of a function. -# If set to NO (the default) these blocks will be appended to the -# function's detailed documentation block. - -HIDE_IN_BODY_DOCS = NO - -# The INTERNAL_DOCS tag determines if documentation -# that is typed after a \internal command is included. If the tag is set -# to NO (the default) then the documentation will be excluded. -# Set it to YES to include the internal documentation. - -INTERNAL_DOCS = NO - -# If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate -# file names in lower-case letters. If set to YES upper-case letters are also -# allowed. This is useful if you have classes or files whose names only differ -# in case and if your file system supports case sensitive file names. Windows -# and Mac users are advised to set this option to NO. - -CASE_SENSE_NAMES = NO - -# If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen -# will show members with their full class and namespace scopes in the -# documentation. If set to YES the scope will be hidden. - -HIDE_SCOPE_NAMES = NO - -# If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen -# will put a list of the files that are included by a file in the documentation -# of that file. - -SHOW_INCLUDE_FILES = YES - -# If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen -# will list include files with double quotes in the documentation -# rather than with sharp brackets. - -FORCE_LOCAL_INCLUDES = NO - -# If the INLINE_INFO tag is set to YES (the default) then a tag [inline] -# is inserted in the documentation for inline members. - -INLINE_INFO = YES - -# If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen -# will sort the (detailed) documentation of file and class members -# alphabetically by member name. If set to NO the members will appear in -# declaration order. - -SORT_MEMBER_DOCS = YES - -# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the -# brief documentation of file, namespace and class members alphabetically -# by member name. If set to NO (the default) the members will appear in -# declaration order. - -SORT_BRIEF_DOCS = NO - -# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen -# will sort the (brief and detailed) documentation of class members so that -# constructors and destructors are listed first. If set to NO (the default) -# the constructors will appear in the respective orders defined by -# SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. -# This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO -# and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO. - -SORT_MEMBERS_CTORS_1ST = NO - -# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the -# hierarchy of group names into alphabetical order. If set to NO (the default) -# the group names will appear in their defined order. - -SORT_GROUP_NAMES = NO - -# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be -# sorted by fully-qualified names, including namespaces. If set to -# NO (the default), the class list will be sorted only by class name, -# not including the namespace part. -# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. -# Note: This option applies only to the class list, not to the -# alphabetical list. - -SORT_BY_SCOPE_NAME = NO - -# The GENERATE_TODOLIST tag can be used to enable (YES) or -# disable (NO) the todo list. This list is created by putting \todo -# commands in the documentation. - -GENERATE_TODOLIST = YES - -# The GENERATE_TESTLIST tag can be used to enable (YES) or -# disable (NO) the test list. This list is created by putting \test -# commands in the documentation. - -GENERATE_TESTLIST = YES - -# The GENERATE_BUGLIST tag can be used to enable (YES) or -# disable (NO) the bug list. This list is created by putting \bug -# commands in the documentation. - -GENERATE_BUGLIST = YES - -# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or -# disable (NO) the deprecated list. This list is created by putting -# \deprecated commands in the documentation. - -GENERATE_DEPRECATEDLIST= YES - -# The ENABLED_SECTIONS tag can be used to enable conditional -# documentation sections, marked by \if sectionname ... \endif. - -ENABLED_SECTIONS = - -# The MAX_INITIALIZER_LINES tag determines the maximum number of lines -# the initial value of a variable or define consists of for it to appear in -# the documentation. If the initializer consists of more lines than specified -# here it will be hidden. Use a value of 0 to hide initializers completely. -# The appearance of the initializer of individual variables and defines in the -# documentation can be controlled using \showinitializer or \hideinitializer -# command in the documentation regardless of this setting. - -MAX_INITIALIZER_LINES = 30 - -# Set the SHOW_USED_FILES tag to NO to disable the list of files generated -# at the bottom of the documentation of classes and structs. If set to YES the -# list will mention the files that were used to generate the documentation. - -SHOW_USED_FILES = YES - -# If the sources in your project are distributed over multiple directories -# then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy -# in the documentation. The default is NO. - -SHOW_DIRECTORIES = NO - -# Set the SHOW_FILES tag to NO to disable the generation of the Files page. -# This will remove the Files entry from the Quick Index and from the -# Folder Tree View (if specified). The default is YES. - -SHOW_FILES = YES - -# Set the SHOW_NAMESPACES tag to NO to disable the generation of the -# Namespaces page. This will remove the Namespaces entry from the Quick Index -# and from the Folder Tree View (if specified). The default is YES. - -SHOW_NAMESPACES = YES - -# The FILE_VERSION_FILTER tag can be used to specify a program or script that -# doxygen should invoke to get the current version for each file (typically from -# the version control system). Doxygen will invoke the program by executing (via -# popen()) the command , where is the value of -# the FILE_VERSION_FILTER tag, and is the name of an input file -# provided by doxygen. Whatever the program writes to standard output -# is used as the file version. See the manual for examples. - -FILE_VERSION_FILTER = - -# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed -# by doxygen. The layout file controls the global structure of the generated -# output files in an output format independent way. The create the layout file -# that represents doxygen's defaults, run doxygen with the -l option. -# You can optionally specify a file name after the option, if omitted -# DoxygenLayout.xml will be used as the name of the layout file. - -LAYOUT_FILE = - -#--------------------------------------------------------------------------- -# configuration options related to warning and progress messages -#--------------------------------------------------------------------------- - -# The QUIET tag can be used to turn on/off the messages that are generated -# by doxygen. Possible values are YES and NO. If left blank NO is used. - -QUIET = NO - -# The WARNINGS tag can be used to turn on/off the warning messages that are -# generated by doxygen. Possible values are YES and NO. If left blank -# NO is used. - -WARNINGS = YES - -# If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings -# for undocumented members. If EXTRACT_ALL is set to YES then this flag will -# automatically be disabled. - -WARN_IF_UNDOCUMENTED = YES - -# If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for -# potential errors in the documentation, such as not documenting some -# parameters in a documented function, or documenting parameters that -# don't exist or using markup commands wrongly. - -WARN_IF_DOC_ERROR = YES - -# This WARN_NO_PARAMDOC option can be abled to get warnings for -# functions that are documented, but have no documentation for their parameters -# or return value. If set to NO (the default) doxygen will only warn about -# wrong or incomplete parameter documentation, but not about the absence of -# documentation. - -WARN_NO_PARAMDOC = NO - -# The WARN_FORMAT tag determines the format of the warning messages that -# doxygen can produce. The string should contain the $file, $line, and $text -# tags, which will be replaced by the file and line number from which the -# warning originated and the warning text. Optionally the format may contain -# $version, which will be replaced by the version of the file (if it could -# be obtained via FILE_VERSION_FILTER) - -WARN_FORMAT = "$file:$line: $text" - -# The WARN_LOGFILE tag can be used to specify a file to which warning -# and error messages should be written. If left blank the output is written -# to stderr. - -WARN_LOGFILE = - -#--------------------------------------------------------------------------- -# configuration options related to the input files -#--------------------------------------------------------------------------- - -# The INPUT tag can be used to specify the files and/or directories that contain -# documented source files. You may enter file names like "myfile.cpp" or -# directories like "/usr/src/myproject". Separate the files or directories -# with spaces. - -INPUT = ../src - -# This tag can be used to specify the character encoding of the source files -# that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is -# also the default input encoding. Doxygen uses libiconv (or the iconv built -# into libc) for the transcoding. See http://www.gnu.org/software/libiconv for -# the list of possible encodings. - -INPUT_ENCODING = UTF-8 - -# If the value of the INPUT tag contains directories, you can use the -# FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp -# and *.h) to filter out the source-files in the directories. If left -# blank the following patterns are tested: -# *.c *.cc *.cxx *.cpp *.c++ *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh *.hxx -# *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.py *.f90 - -FILE_PATTERNS = *.c \ - *.cc \ - *.cxx \ - *.cpp \ - *.c++ \ - *.d \ - *.java \ - *.ii \ - *.ixx \ - *.ipp \ - *.i++ \ - *.inl \ - *.h \ - *.hh \ - *.hxx \ - *.hpp \ - *.h++ \ - *.idl \ - *.odl \ - *.cs \ - *.php \ - *.php3 \ - *.inc \ - *.m \ - *.mm \ - *.dox \ - *.py \ - *.F90 \ - *.f90 \ - *.f \ - *.vhd \ - *.vhdl - -# The RECURSIVE tag can be used to turn specify whether or not subdirectories -# should be searched for input files as well. Possible values are YES and NO. -# If left blank NO is used. - -RECURSIVE = NO - -# The EXCLUDE tag can be used to specify files and/or directories that should -# excluded from the INPUT source files. This way you can easily exclude a -# subdirectory from a directory tree whose root is specified with the INPUT tag. - -EXCLUDE = - -# The EXCLUDE_SYMLINKS tag can be used select whether or not files or -# directories that are symbolic links (a Unix filesystem feature) are excluded -# from the input. - -EXCLUDE_SYMLINKS = NO - -# If the value of the INPUT tag contains directories, you can use the -# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude -# certain files from those directories. Note that the wildcards are matched -# against the file with absolute path, so to exclude all test directories -# for example use the pattern */test/* - -EXCLUDE_PATTERNS = - -# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names -# (namespaces, classes, functions, etc.) that should be excluded from the -# output. The symbol name can be a fully qualified name, a word, or if the -# wildcard * is used, a substring. Examples: ANamespace, AClass, -# AClass::ANamespace, ANamespace::*Test - -EXCLUDE_SYMBOLS = - -# The EXAMPLE_PATH tag can be used to specify one or more files or -# directories that contain example code fragments that are included (see -# the \include command). - -EXAMPLE_PATH = - -# If the value of the EXAMPLE_PATH tag contains directories, you can use the -# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp -# and *.h) to filter out the source-files in the directories. If left -# blank all files are included. - -EXAMPLE_PATTERNS = * - -# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be -# searched for input files to be used with the \include or \dontinclude -# commands irrespective of the value of the RECURSIVE tag. -# Possible values are YES and NO. If left blank NO is used. - -EXAMPLE_RECURSIVE = NO - -# The IMAGE_PATH tag can be used to specify one or more files or -# directories that contain image that are included in the documentation (see -# the \image command). - -IMAGE_PATH = - -# The INPUT_FILTER tag can be used to specify a program that doxygen should -# invoke to filter for each input file. Doxygen will invoke the filter program -# by executing (via popen()) the command , where -# is the value of the INPUT_FILTER tag, and is the name of an -# input file. Doxygen will then use the output that the filter program writes -# to standard output. If FILTER_PATTERNS is specified, this tag will be -# ignored. - -INPUT_FILTER = - -# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern -# basis. Doxygen will compare the file name with each pattern and apply the -# filter if there is a match. The filters are a list of the form: -# pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further -# info on how filters are used. If FILTER_PATTERNS is empty, INPUT_FILTER -# is applied to all files. - -FILTER_PATTERNS = - -# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using -# INPUT_FILTER) will be used to filter the input files when producing source -# files to browse (i.e. when SOURCE_BROWSER is set to YES). - -FILTER_SOURCE_FILES = NO - -#--------------------------------------------------------------------------- -# configuration options related to source browsing -#--------------------------------------------------------------------------- - -# If the SOURCE_BROWSER tag is set to YES then a list of source files will -# be generated. Documented entities will be cross-referenced with these sources. -# Note: To get rid of all source code in the generated output, make sure also -# VERBATIM_HEADERS is set to NO. - -SOURCE_BROWSER = YES - -# Setting the INLINE_SOURCES tag to YES will include the body -# of functions and classes directly in the documentation. - -INLINE_SOURCES = YES - -# Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct -# doxygen to hide any special comment blocks from generated source code -# fragments. Normal C and C++ comments will always remain visible. - -STRIP_CODE_COMMENTS = YES - -# If the REFERENCED_BY_RELATION tag is set to YES -# then for each documented function all documented -# functions referencing it will be listed. - -REFERENCED_BY_RELATION = YES - -# If the REFERENCES_RELATION tag is set to YES -# then for each documented function all documented entities -# called/used by that function will be listed. - -REFERENCES_RELATION = YES - -# If the REFERENCES_LINK_SOURCE tag is set to YES (the default) -# and SOURCE_BROWSER tag is set to YES, then the hyperlinks from -# functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will -# link to the source code. Otherwise they will link to the documentation. - -REFERENCES_LINK_SOURCE = YES - -# If the USE_HTAGS tag is set to YES then the references to source code -# will point to the HTML generated by the htags(1) tool instead of doxygen -# built-in source browser. The htags tool is part of GNU's global source -# tagging system (see http://www.gnu.org/software/global/global.html). You -# will need version 4.8.6 or higher. - -USE_HTAGS = NO - -# If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen -# will generate a verbatim copy of the header file for each class for -# which an include is specified. Set to NO to disable this. - -VERBATIM_HEADERS = YES - -#--------------------------------------------------------------------------- -# configuration options related to the alphabetical class index -#--------------------------------------------------------------------------- - -# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index -# of all compounds will be generated. Enable this if the project -# contains a lot of classes, structs, unions or interfaces. - -ALPHABETICAL_INDEX = YES - -# If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then -# the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns -# in which this list will be split (can be a number in the range [1..20]) - -COLS_IN_ALPHA_INDEX = 5 - -# In case all classes in a project start with a common prefix, all -# classes will be put under the same header in the alphabetical index. -# The IGNORE_PREFIX tag can be used to specify one or more prefixes that -# should be ignored while generating the index headers. - -IGNORE_PREFIX = - -#--------------------------------------------------------------------------- -# configuration options related to the HTML output -#--------------------------------------------------------------------------- - -# If the GENERATE_HTML tag is set to YES (the default) Doxygen will -# generate HTML output. - -GENERATE_HTML = YES - -# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. -# If a relative path is entered the value of OUTPUT_DIRECTORY will be -# put in front of it. If left blank `html' will be used as the default path. - -HTML_OUTPUT = html - -# The HTML_FILE_EXTENSION tag can be used to specify the file extension for -# each generated HTML page (for example: .htm,.php,.asp). If it is left blank -# doxygen will generate files with .html extension. - -HTML_FILE_EXTENSION = .html - -# The HTML_HEADER tag can be used to specify a personal HTML header for -# each generated HTML page. If it is left blank doxygen will generate a -# standard header. - -HTML_HEADER = - -# The HTML_FOOTER tag can be used to specify a personal HTML footer for -# each generated HTML page. If it is left blank doxygen will generate a -# standard footer. - -HTML_FOOTER = - -# The HTML_STYLESHEET tag can be used to specify a user-defined cascading -# style sheet that is used by each HTML page. It can be used to -# fine-tune the look of the HTML output. If the tag is left blank doxygen -# will generate a default style sheet. Note that doxygen will try to copy -# the style sheet file to the HTML output directory, so don't put your own -# stylesheet in the HTML output directory as well, or it will be erased! - -HTML_STYLESHEET = - -# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. -# Doxygen will adjust the colors in the stylesheet and background images -# according to this color. Hue is specified as an angle on a colorwheel, -# see http://en.wikipedia.org/wiki/Hue for more information. -# For instance the value 0 represents red, 60 is yellow, 120 is green, -# 180 is cyan, 240 is blue, 300 purple, and 360 is red again. -# The allowed range is 0 to 359. - -HTML_COLORSTYLE_HUE = 220 - -# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of -# the colors in the HTML output. For a value of 0 the output will use -# grayscales only. A value of 255 will produce the most vivid colors. - -HTML_COLORSTYLE_SAT = 100 - -# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to -# the luminance component of the colors in the HTML output. Values below -# 100 gradually make the output lighter, whereas values above 100 make -# the output darker. The value divided by 100 is the actual gamma applied, -# so 80 represents a gamma of 0.8, The value 220 represents a gamma of 2.2, -# and 100 does not change the gamma. - -HTML_COLORSTYLE_GAMMA = 80 - -# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML -# page will contain the date and time when the page was generated. Setting -# this to NO can help when comparing the output of multiple runs. - -HTML_TIMESTAMP = YES - -# If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes, -# files or namespaces will be aligned in HTML using tables. If set to -# NO a bullet list will be used. - -HTML_ALIGN_MEMBERS = YES - -# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML -# documentation will contain sections that can be hidden and shown after the -# page has loaded. For this to work a browser that supports -# JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox -# Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari). - -HTML_DYNAMIC_SECTIONS = NO - -# If the GENERATE_DOCSET tag is set to YES, additional index files -# will be generated that can be used as input for Apple's Xcode 3 -# integrated development environment, introduced with OSX 10.5 (Leopard). -# To create a documentation set, doxygen will generate a Makefile in the -# HTML output directory. Running make will produce the docset in that -# directory and running "make install" will install the docset in -# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find -# it at startup. -# See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html -# for more information. - -GENERATE_DOCSET = NO - -# When GENERATE_DOCSET tag is set to YES, this tag determines the name of the -# feed. A documentation feed provides an umbrella under which multiple -# documentation sets from a single provider (such as a company or product suite) -# can be grouped. - -DOCSET_FEEDNAME = "Doxygen generated docs" - -# When GENERATE_DOCSET tag is set to YES, this tag specifies a string that -# should uniquely identify the documentation set bundle. This should be a -# reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen -# will append .docset to the name. - -DOCSET_BUNDLE_ID = org.doxygen.Project - -# When GENERATE_PUBLISHER_ID tag specifies a string that should uniquely identify -# the documentation publisher. This should be a reverse domain-name style -# string, e.g. com.mycompany.MyDocSet.documentation. - -DOCSET_PUBLISHER_ID = org.doxygen.Publisher - -# The GENERATE_PUBLISHER_NAME tag identifies the documentation publisher. - -DOCSET_PUBLISHER_NAME = Publisher - -# If the GENERATE_HTMLHELP tag is set to YES, additional index files -# will be generated that can be used as input for tools like the -# Microsoft HTML help workshop to generate a compiled HTML help file (.chm) -# of the generated HTML documentation. - -GENERATE_HTMLHELP = NO - -# If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can -# be used to specify the file name of the resulting .chm file. You -# can add a path in front of the file if the result should not be -# written to the html output directory. - -CHM_FILE = - -# If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can -# be used to specify the location (absolute path including file name) of -# the HTML help compiler (hhc.exe). If non-empty doxygen will try to run -# the HTML help compiler on the generated index.hhp. - -HHC_LOCATION = - -# If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag -# controls if a separate .chi index file is generated (YES) or that -# it should be included in the master .chm file (NO). - -GENERATE_CHI = NO - -# If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING -# is used to encode HtmlHelp index (hhk), content (hhc) and project file -# content. - -CHM_INDEX_ENCODING = - -# If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag -# controls whether a binary table of contents is generated (YES) or a -# normal table of contents (NO) in the .chm file. - -BINARY_TOC = NO - -# The TOC_EXPAND flag can be set to YES to add extra items for group members -# to the contents of the HTML help documentation and to the tree view. - -TOC_EXPAND = NO - -# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and -# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated -# that can be used as input for Qt's qhelpgenerator to generate a -# Qt Compressed Help (.qch) of the generated HTML documentation. - -GENERATE_QHP = NO - -# If the QHG_LOCATION tag is specified, the QCH_FILE tag can -# be used to specify the file name of the resulting .qch file. -# The path specified is relative to the HTML output folder. - -QCH_FILE = - -# The QHP_NAMESPACE tag specifies the namespace to use when generating -# Qt Help Project output. For more information please see -# http://doc.trolltech.com/qthelpproject.html#namespace - -QHP_NAMESPACE = org.doxygen.Project - -# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating -# Qt Help Project output. For more information please see -# http://doc.trolltech.com/qthelpproject.html#virtual-folders - -QHP_VIRTUAL_FOLDER = doc - -# If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to -# add. For more information please see -# http://doc.trolltech.com/qthelpproject.html#custom-filters - -QHP_CUST_FILTER_NAME = - -# The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the -# custom filter to add. For more information please see -# -# Qt Help Project / Custom Filters. - -QHP_CUST_FILTER_ATTRS = - -# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this -# project's -# filter section matches. -# -# Qt Help Project / Filter Attributes. - -QHP_SECT_FILTER_ATTRS = - -# If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can -# be used to specify the location of Qt's qhelpgenerator. -# If non-empty doxygen will try to run qhelpgenerator on the generated -# .qhp file. - -QHG_LOCATION = - -# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files -# will be generated, which together with the HTML files, form an Eclipse help -# plugin. To install this plugin and make it available under the help contents -# menu in Eclipse, the contents of the directory containing the HTML and XML -# files needs to be copied into the plugins directory of eclipse. The name of -# the directory within the plugins directory should be the same as -# the ECLIPSE_DOC_ID value. After copying Eclipse needs to be restarted before -# the help appears. - -GENERATE_ECLIPSEHELP = NO - -# A unique identifier for the eclipse help plugin. When installing the plugin -# the directory name containing the HTML and XML files should also have -# this name. - -ECLIPSE_DOC_ID = org.doxygen.Project - -# The DISABLE_INDEX tag can be used to turn on/off the condensed index at -# top of each HTML page. The value NO (the default) enables the index and -# the value YES disables it. - -DISABLE_INDEX = NO - -# This tag can be used to set the number of enum values (range [1..20]) -# that doxygen will group on one line in the generated HTML documentation. - -ENUM_VALUES_PER_LINE = 4 - -# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index -# structure should be generated to display hierarchical information. -# If the tag value is set to YES, a side panel will be generated -# containing a tree-like index structure (just like the one that -# is generated for HTML Help). For this to work a browser that supports -# JavaScript, DHTML, CSS and frames is required (i.e. any modern browser). -# Windows users are probably better off using the HTML help feature. - -GENERATE_TREEVIEW = NO - -# By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories, -# and Class Hierarchy pages using a tree view instead of an ordered list. - -USE_INLINE_TREES = NO - -# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be -# used to set the initial width (in pixels) of the frame in which the tree -# is shown. - -TREEVIEW_WIDTH = 250 - -# When the EXT_LINKS_IN_WINDOW option is set to YES doxygen will open -# links to external symbols imported via tag files in a separate window. - -EXT_LINKS_IN_WINDOW = NO - -# Use this tag to change the font size of Latex formulas included -# as images in the HTML documentation. The default is 10. Note that -# when you change the font size after a successful doxygen run you need -# to manually remove any form_*.png images from the HTML output directory -# to force them to be regenerated. - -FORMULA_FONTSIZE = 10 - -# Use the FORMULA_TRANPARENT tag to determine whether or not the images -# generated for formulas are transparent PNGs. Transparent PNGs are -# not supported properly for IE 6.0, but are supported on all modern browsers. -# Note that when changing this option you need to delete any form_*.png files -# in the HTML output before the changes have effect. - -FORMULA_TRANSPARENT = YES - -# When the SEARCHENGINE tag is enabled doxygen will generate a search box -# for the HTML output. The underlying search engine uses javascript -# and DHTML and should work on any modern browser. Note that when using -# HTML help (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets -# (GENERATE_DOCSET) there is already a search function so this one should -# typically be disabled. For large projects the javascript based search engine -# can be slow, then enabling SERVER_BASED_SEARCH may provide a better solution. - -SEARCHENGINE = YES - -# When the SERVER_BASED_SEARCH tag is enabled the search engine will be -# implemented using a PHP enabled web server instead of at the web client -# using Javascript. Doxygen will generate the search PHP script and index -# file to put on the web server. The advantage of the server -# based approach is that it scales better to large projects and allows -# full text search. The disadvances is that it is more difficult to setup -# and does not have live searching capabilities. - -SERVER_BASED_SEARCH = NO - -#--------------------------------------------------------------------------- -# configuration options related to the LaTeX output -#--------------------------------------------------------------------------- - -# If the GENERATE_LATEX tag is set to YES (the default) Doxygen will -# generate Latex output. - -GENERATE_LATEX = YES - -# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. -# If a relative path is entered the value of OUTPUT_DIRECTORY will be -# put in front of it. If left blank `latex' will be used as the default path. - -LATEX_OUTPUT = latex - -# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be -# invoked. If left blank `latex' will be used as the default command name. -# Note that when enabling USE_PDFLATEX this option is only used for -# generating bitmaps for formulas in the HTML output, but not in the -# Makefile that is written to the output directory. - -LATEX_CMD_NAME = latex - -# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to -# generate index for LaTeX. If left blank `makeindex' will be used as the -# default command name. - -MAKEINDEX_CMD_NAME = makeindex - -# If the COMPACT_LATEX tag is set to YES Doxygen generates more compact -# LaTeX documents. This may be useful for small projects and may help to -# save some trees in general. - -COMPACT_LATEX = NO - -# The PAPER_TYPE tag can be used to set the paper type that is used -# by the printer. Possible values are: a4, a4wide, letter, legal and -# executive. If left blank a4wide will be used. - -PAPER_TYPE = a4wide - -# The EXTRA_PACKAGES tag can be to specify one or more names of LaTeX -# packages that should be included in the LaTeX output. - -EXTRA_PACKAGES = - -# The LATEX_HEADER tag can be used to specify a personal LaTeX header for -# the generated latex document. The header should contain everything until -# the first chapter. If it is left blank doxygen will generate a -# standard header. Notice: only use this tag if you know what you are doing! - -LATEX_HEADER = - -# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated -# is prepared for conversion to pdf (using ps2pdf). The pdf file will -# contain links (just like the HTML output) instead of page references -# This makes the output suitable for online browsing using a pdf viewer. - -PDF_HYPERLINKS = YES - -# If the USE_PDFLATEX tag is set to YES, pdflatex will be used instead of -# plain latex in the generated Makefile. Set this option to YES to get a -# higher quality PDF documentation. - -USE_PDFLATEX = YES - -# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \\batchmode. -# command to the generated LaTeX files. This will instruct LaTeX to keep -# running if errors occur, instead of asking the user for help. -# This option is also used when generating formulas in HTML. - -LATEX_BATCHMODE = NO - -# If LATEX_HIDE_INDICES is set to YES then doxygen will not -# include the index chapters (such as File Index, Compound Index, etc.) -# in the output. - -LATEX_HIDE_INDICES = NO - -# If LATEX_SOURCE_CODE is set to YES then doxygen will include -# source code with syntax highlighting in the LaTeX output. -# Note that which sources are shown also depends on other settings -# such as SOURCE_BROWSER. - -LATEX_SOURCE_CODE = NO - -#--------------------------------------------------------------------------- -# configuration options related to the RTF output -#--------------------------------------------------------------------------- - -# If the GENERATE_RTF tag is set to YES Doxygen will generate RTF output -# The RTF output is optimized for Word 97 and may not look very pretty with -# other RTF readers or editors. - -GENERATE_RTF = NO - -# The RTF_OUTPUT tag is used to specify where the RTF docs will be put. -# If a relative path is entered the value of OUTPUT_DIRECTORY will be -# put in front of it. If left blank `rtf' will be used as the default path. - -RTF_OUTPUT = rtf - -# If the COMPACT_RTF tag is set to YES Doxygen generates more compact -# RTF documents. This may be useful for small projects and may help to -# save some trees in general. - -COMPACT_RTF = NO - -# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated -# will contain hyperlink fields. The RTF file will -# contain links (just like the HTML output) instead of page references. -# This makes the output suitable for online browsing using WORD or other -# programs which support those fields. -# Note: wordpad (write) and others do not support links. - -RTF_HYPERLINKS = NO - -# Load stylesheet definitions from file. Syntax is similar to doxygen's -# config file, i.e. a series of assignments. You only have to provide -# replacements, missing definitions are set to their default value. - -RTF_STYLESHEET_FILE = - -# Set optional variables used in the generation of an rtf document. -# Syntax is similar to doxygen's config file. - -RTF_EXTENSIONS_FILE = - -#--------------------------------------------------------------------------- -# configuration options related to the man page output -#--------------------------------------------------------------------------- - -# If the GENERATE_MAN tag is set to YES (the default) Doxygen will -# generate man pages - -GENERATE_MAN = YES - -# The MAN_OUTPUT tag is used to specify where the man pages will be put. -# If a relative path is entered the value of OUTPUT_DIRECTORY will be -# put in front of it. If left blank `man' will be used as the default path. - -MAN_OUTPUT = $(HOME)/man - -# The MAN_EXTENSION tag determines the extension that is added to -# the generated man pages (default is the subroutine's section .3) - -MAN_EXTENSION = .3 - -# If the MAN_LINKS tag is set to YES and Doxygen generates man output, -# then it will generate one additional man file for each entity -# documented in the real man page(s). These additional files -# only source the real man page, but without them the man command -# would be unable to find the correct page. The default is NO. - -MAN_LINKS = NO - -#--------------------------------------------------------------------------- -# configuration options related to the XML output -#--------------------------------------------------------------------------- - -# If the GENERATE_XML tag is set to YES Doxygen will -# generate an XML file that captures the structure of -# the code including all documentation. - -GENERATE_XML = NO - -# The XML_OUTPUT tag is used to specify where the XML pages will be put. -# If a relative path is entered the value of OUTPUT_DIRECTORY will be -# put in front of it. If left blank `xml' will be used as the default path. - -XML_OUTPUT = xml - -# The XML_SCHEMA tag can be used to specify an XML schema, -# which can be used by a validating XML parser to check the -# syntax of the XML files. - -XML_SCHEMA = - -# The XML_DTD tag can be used to specify an XML DTD, -# which can be used by a validating XML parser to check the -# syntax of the XML files. - -XML_DTD = - -# If the XML_PROGRAMLISTING tag is set to YES Doxygen will -# dump the program listings (including syntax highlighting -# and cross-referencing information) to the XML output. Note that -# enabling this will significantly increase the size of the XML output. - -XML_PROGRAMLISTING = YES - -#--------------------------------------------------------------------------- -# configuration options for the AutoGen Definitions output -#--------------------------------------------------------------------------- - -# If the GENERATE_AUTOGEN_DEF tag is set to YES Doxygen will -# generate an AutoGen Definitions (see autogen.sf.net) file -# that captures the structure of the code including all -# documentation. Note that this feature is still experimental -# and incomplete at the moment. - -GENERATE_AUTOGEN_DEF = NO - -#--------------------------------------------------------------------------- -# configuration options related to the Perl module output -#--------------------------------------------------------------------------- - -# If the GENERATE_PERLMOD tag is set to YES Doxygen will -# generate a Perl module file that captures the structure of -# the code including all documentation. Note that this -# feature is still experimental and incomplete at the -# moment. - -GENERATE_PERLMOD = NO - -# If the PERLMOD_LATEX tag is set to YES Doxygen will generate -# the necessary Makefile rules, Perl scripts and LaTeX code to be able -# to generate PDF and DVI output from the Perl module output. - -PERLMOD_LATEX = NO - -# If the PERLMOD_PRETTY tag is set to YES the Perl module output will be -# nicely formatted so it can be parsed by a human reader. This is useful -# if you want to understand what is going on. On the other hand, if this -# tag is set to NO the size of the Perl module output will be much smaller -# and Perl will parse it just the same. - -PERLMOD_PRETTY = YES - -# The names of the make variables in the generated doxyrules.make file -# are prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. -# This is useful so different doxyrules.make files included by the same -# Makefile don't overwrite each other's variables. - -PERLMOD_MAKEVAR_PREFIX = - -#--------------------------------------------------------------------------- -# Configuration options related to the preprocessor -#--------------------------------------------------------------------------- - -# If the ENABLE_PREPROCESSING tag is set to YES (the default) Doxygen will -# evaluate all C-preprocessor directives found in the sources and include -# files. - -ENABLE_PREPROCESSING = YES - -# If the MACRO_EXPANSION tag is set to YES Doxygen will expand all macro -# names in the source code. If set to NO (the default) only conditional -# compilation will be performed. Macro expansion can be done in a controlled -# way by setting EXPAND_ONLY_PREDEF to YES. - -MACRO_EXPANSION = NO - -# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES -# then the macro expansion is limited to the macros specified with the -# PREDEFINED and EXPAND_AS_DEFINED tags. - -EXPAND_ONLY_PREDEF = NO - -# If the SEARCH_INCLUDES tag is set to YES (the default) the includes files -# in the INCLUDE_PATH (see below) will be search if a #include is found. - -SEARCH_INCLUDES = YES - -# The INCLUDE_PATH tag can be used to specify one or more directories that -# contain include files that are not input files but should be processed by -# the preprocessor. - -INCLUDE_PATH = - -# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard -# patterns (like *.h and *.hpp) to filter out the header-files in the -# directories. If left blank, the patterns specified with FILE_PATTERNS will -# be used. - -INCLUDE_FILE_PATTERNS = - -# The PREDEFINED tag can be used to specify one or more macro names that -# are defined before the preprocessor is started (similar to the -D option of -# gcc). The argument of the tag is a list of macros of the form: name -# or name=definition (no spaces). If the definition and the = are -# omitted =1 is assumed. To prevent a macro definition from being -# undefined via #undef or recursively expanded use the := operator -# instead of the = operator. - -PREDEFINED = - -# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then -# this tag can be used to specify a list of macro names that should be expanded. -# The macro definition that is found in the sources will be used. -# Use the PREDEFINED tag if you want to use a different macro definition. - -EXPAND_AS_DEFINED = - -# If the SKIP_FUNCTION_MACROS tag is set to YES (the default) then -# doxygen's preprocessor will remove all function-like macros that are alone -# on a line, have an all uppercase name, and do not end with a semicolon. Such -# function macros are typically used for boiler-plate code, and will confuse -# the parser if not removed. - -SKIP_FUNCTION_MACROS = YES - -#--------------------------------------------------------------------------- -# Configuration::additions related to external references -#--------------------------------------------------------------------------- - -# The TAGFILES option can be used to specify one or more tagfiles. -# Optionally an initial location of the external documentation -# can be added for each tagfile. The format of a tag file without -# this location is as follows: -# TAGFILES = file1 file2 ... -# Adding location for the tag files is done as follows: -# TAGFILES = file1=loc1 "file2 = loc2" ... -# where "loc1" and "loc2" can be relative or absolute paths or -# URLs. If a location is present for each tag, the installdox tool -# does not have to be run to correct the links. -# Note that each tag file must have a unique name -# (where the name does NOT include the path) -# If a tag file is not located in the directory in which doxygen -# is run, you must also specify the path to the tagfile here. - -TAGFILES = - -# When a file name is specified after GENERATE_TAGFILE, doxygen will create -# a tag file that is based on the input files it reads. - -GENERATE_TAGFILE = - -# If the ALLEXTERNALS tag is set to YES all external classes will be listed -# in the class index. If set to NO only the inherited external classes -# will be listed. - -ALLEXTERNALS = NO - -# If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed -# in the modules index. If set to NO, only the current project's groups will -# be listed. - -EXTERNAL_GROUPS = YES - -# The PERL_PATH should be the absolute path and name of the perl script -# interpreter (i.e. the result of `which perl'). - -PERL_PATH = /usr/bin/perl - -#--------------------------------------------------------------------------- -# Configuration options related to the dot tool -#--------------------------------------------------------------------------- - -# If the CLASS_DIAGRAMS tag is set to YES (the default) Doxygen will -# generate a inheritance diagram (in HTML, RTF and LaTeX) for classes with base -# or super classes. Setting the tag to NO turns the diagrams off. Note that -# this option is superseded by the HAVE_DOT option below. This is only a -# fallback. It is recommended to install and use dot, since it yields more -# powerful graphs. - -CLASS_DIAGRAMS = NO - -# You can define message sequence charts within doxygen comments using the \msc -# command. Doxygen will then run the mscgen tool (see -# http://www.mcternan.me.uk/mscgen/) to produce the chart and insert it in the -# documentation. The MSCGEN_PATH tag allows you to specify the directory where -# the mscgen tool resides. If left empty the tool is assumed to be found in the -# default search path. - -MSCGEN_PATH = - -# If set to YES, the inheritance and collaboration graphs will hide -# inheritance and usage relations if the target is undocumented -# or is not a class. - -HIDE_UNDOC_RELATIONS = YES - -# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is -# available from the path. This tool is part of Graphviz, a graph visualization -# toolkit from AT&T and Lucent Bell Labs. The other options in this section -# have no effect if this option is set to NO (the default) - -HAVE_DOT = YES - -# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is -# allowed to run in parallel. When set to 0 (the default) doxygen will -# base this on the number of processors available in the system. You can set it -# explicitly to a value larger than 0 to get control over the balance -# between CPU load and processing speed. - -DOT_NUM_THREADS = 0 - -# By default doxygen will write a font called FreeSans.ttf to the output -# directory and reference it in all dot files that doxygen generates. This -# font does not include all possible unicode characters however, so when you need -# these (or just want a differently looking font) you can specify the font name -# using DOT_FONTNAME. You need need to make sure dot is able to find the font, -# which can be done by putting it in a standard location or by setting the -# DOTFONTPATH environment variable or by setting DOT_FONTPATH to the directory -# containing the font. - -DOT_FONTNAME = FreeSans.ttf - -# The DOT_FONTSIZE tag can be used to set the size of the font of dot graphs. -# The default size is 10pt. - -DOT_FONTSIZE = 10 - -# By default doxygen will tell dot to use the output directory to look for the -# FreeSans.ttf font (which doxygen will put there itself). If you specify a -# different font using DOT_FONTNAME you can set the path where dot -# can find it using this tag. - -DOT_FONTPATH = - -# If the CLASS_GRAPH and HAVE_DOT tags are set to YES then doxygen -# will generate a graph for each documented class showing the direct and -# indirect inheritance relations. Setting this tag to YES will force the -# the CLASS_DIAGRAMS tag to NO. - -CLASS_GRAPH = YES - -# If the COLLABORATION_GRAPH and HAVE_DOT tags are set to YES then doxygen -# will generate a graph for each documented class showing the direct and -# indirect implementation dependencies (inheritance, containment, and -# class references variables) of the class with other documented classes. - -COLLABORATION_GRAPH = YES - -# If the GROUP_GRAPHS and HAVE_DOT tags are set to YES then doxygen -# will generate a graph for groups, showing the direct groups dependencies - -GROUP_GRAPHS = YES - -# If the UML_LOOK tag is set to YES doxygen will generate inheritance and -# collaboration diagrams in a style similar to the OMG's Unified Modeling -# Language. - -UML_LOOK = NO - -# If set to YES, the inheritance and collaboration graphs will show the -# relations between templates and their instances. - -TEMPLATE_RELATIONS = NO - -# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDE_GRAPH, and HAVE_DOT -# tags are set to YES then doxygen will generate a graph for each documented -# file showing the direct and indirect include dependencies of the file with -# other documented files. - -INCLUDE_GRAPH = YES - -# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDED_BY_GRAPH, and -# HAVE_DOT tags are set to YES then doxygen will generate a graph for each -# documented header file showing the documented files that directly or -# indirectly include this file. - -INCLUDED_BY_GRAPH = YES - -# If the CALL_GRAPH and HAVE_DOT options are set to YES then -# doxygen will generate a call dependency graph for every global function -# or class method. Note that enabling this option will significantly increase -# the time of a run. So in most cases it will be better to enable call graphs -# for selected functions only using the \callgraph command. - -CALL_GRAPH = YES - -# If the CALLER_GRAPH and HAVE_DOT tags are set to YES then -# doxygen will generate a caller dependency graph for every global function -# or class method. Note that enabling this option will significantly increase -# the time of a run. So in most cases it will be better to enable caller -# graphs for selected functions only using the \callergraph command. - -CALLER_GRAPH = YES - -# If the GRAPHICAL_HIERARCHY and HAVE_DOT tags are set to YES then doxygen -# will graphical hierarchy of all classes instead of a textual one. - -GRAPHICAL_HIERARCHY = YES - -# If the DIRECTORY_GRAPH, SHOW_DIRECTORIES and HAVE_DOT tags are set to YES -# then doxygen will show the dependencies a directory has on other directories -# in a graphical way. The dependency relations are determined by the #include -# relations between the files in the directories. - -DIRECTORY_GRAPH = YES - -# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images -# generated by dot. Possible values are png, jpg, or gif -# If left blank png will be used. - -DOT_IMAGE_FORMAT = png - -# The tag DOT_PATH can be used to specify the path where the dot tool can be -# found. If left blank, it is assumed the dot tool can be found in the path. - -DOT_PATH = - -# The DOTFILE_DIRS tag can be used to specify one or more directories that -# contain dot files that are included in the documentation (see the -# \dotfile command). - -DOTFILE_DIRS = - -# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of -# nodes that will be shown in the graph. If the number of nodes in a graph -# becomes larger than this value, doxygen will truncate the graph, which is -# visualized by representing a node as a red box. Note that doxygen if the -# number of direct children of the root node in a graph is already larger than -# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note -# that the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH. - -DOT_GRAPH_MAX_NODES = 50 - -# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the -# graphs generated by dot. A depth value of 3 means that only nodes reachable -# from the root by following a path via at most 3 edges will be shown. Nodes -# that lay further from the root node will be omitted. Note that setting this -# option to 1 or 2 may greatly reduce the computation time needed for large -# code bases. Also note that the size of a graph can be further restricted by -# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction. - -MAX_DOT_GRAPH_DEPTH = 0 - -# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent -# background. This is disabled by default, because dot on Windows does not -# seem to support this out of the box. Warning: Depending on the platform used, -# enabling this option may lead to badly anti-aliased labels on the edges of -# a graph (i.e. they become hard to read). - -DOT_TRANSPARENT = NO - -# Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output -# files in one run (i.e. multiple -o and -T options on the command line). This -# makes dot run faster, but since only newer versions of dot (>1.8.10) -# support this, this feature is disabled by default. - -DOT_MULTI_TARGETS = NO - -# If the GENERATE_LEGEND tag is set to YES (the default) Doxygen will -# generate a legend page explaining the meaning of the various boxes and -# arrows in the dot generated graphs. - -GENERATE_LEGEND = YES - -# If the DOT_CLEANUP tag is set to YES (the default) Doxygen will -# remove the intermediate dot files that are used to generate -# the various graphs. - -DOT_CLEANUP = YES diff --git a/config/fedora.cmake b/config/fedora.cmake deleted file mode 100755 index 813e61f7..00000000 --- a/config/fedora.cmake +++ /dev/null @@ -1,16 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none -I/usr/lib64/gfortran/modules -I/usr/lib64/gfortran/modules/mpich ") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/usr/include") -set(NETCDF_LIB_1 "/usr/lib64/mpich/lib/libnetcdff.so") -set(NETCDF_LIB_2 "/usr/lib64/mpich/lib/libnetcdf.so") -set(HDF5_LIB_1 "/usr/lib64/mpich/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/lib64/mpich/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2}) -# set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} /usr/lib64/hdf/libmfhdf.a /usr/lib64/libdl.so ${SZIP_LIB} m z curl) diff --git a/config/juropa.cmake b/config/juropa.cmake deleted file mode 100644 index dd6940a7..00000000 --- a/config/juropa.cmake +++ /dev/null @@ -1,16 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") -set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/v4.3.2/include") -set(NETCDF_LIB_1 "/usr/local/netcdf/v4.3.2/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/local/netcdf/v4.3.2/lib/libnetcdf.a") -set(HDF5_LIB_1 "/usr/local/hdf5/v1.8.13_serial/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/local/hdf5/v1.8.13_serial/lib/libhdf5.a") -set(SZIP_LIB "/usr/local/szip/lib/libsz.a") -set(ZLIB_LIB "/usr/local/zlib/lib/libz.a") -set(CURL_LIB "/usr/local/curl/lib/libcurl.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m ${ZLIB_LIB} curl) diff --git a/config/oakley.cmake b/config/oakley.cmake deleted file mode 100644 index a583d622..00000000 --- a/config/oakley.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-debug -traceback -r8 -ftz -extend_source ") -set(USER_Fortran_FLAGS_RELEASE " -O3 -no-prec-div -xHost") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created ") - -set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/include") -set(NETCDF_LIB_1 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdf.a") -set(HDF5_LIB_1 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/osx.cmake b/config/osx.cmake deleted file mode 100755 index cf1d185e..00000000 --- a/config/osx.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# OS X -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/opt/local/include") -set(NETCDF_LIB_1 "/opt/local/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/opt/local/lib/libnetcdf.a") -set(HDF5_LIB_1 "/opt/local/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/opt/local/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/ruby.cmake b/config/ruby.cmake deleted file mode 100644 index 5b44f9be..00000000 --- a/config/ruby.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source ") -set(USER_Fortran_FLAGS_RELEASE " -O3 -no-prec-div -xHost") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created ") - -set(NETCDF_INCLUDE_DIR "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/include") -set(NETCDF_LIB_1 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/local/netcdf/intel/15/mvapich2/2.1/4.3.3.1/lib/libnetcdf.a") -set(HDF5_LIB_1 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/local/hdf5/intel/15/mvapich2/2.1/1.8.15/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/supermuc.cmake b/config/supermuc.cmake deleted file mode 100644 index 9e048d86..00000000 --- a/config/supermuc.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpfort) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -fp-model source -xAVX") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/lrz/sys/libraries/netcdf/4.2.1.1/include") -set(NETCDF_LIB_1 "/lrz/sys/libraries/netcdf/4.2.1.1/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/lrz/sys/libraries/netcdf/4.2.1.1/lib/libnetcdf.a") -set(HDF5_LIB_1 "/lrz/sys/libraries/netcdf/hdf5_1.8.9/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/lrz/sys/libraries/netcdf/hdf5_1.8.9/lib/libhdf5.a") -set(SZIP_LIB "/lrz/sys/libraries/hdf5/szip_2.1_u1/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/thunder.cmake b/config/thunder.cmake deleted file mode 100644 index 40571e08..00000000 --- a/config/thunder.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# Thunder -set(CMAKE_Fortran_COMPILER "ifort") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-traceback -r8 -ftz -extend_source") -set(USER_Fortran_FLAGS_RELEASE "-O3 -no-prec-div -xAVX -fp-model source") -set(USER_Fortran_FLAGS_DEBUG "-fpe0 -O0 -g -check all -check nopointers -check noarg_temp_created") - -set(NETCDF_INCLUDE_DIR "/sw/squeeze-x64/netcdf_fortran-4.2-static-intel13/include") -set(NETCDF_LIB_1 "/sw/squeeze-x64/netcdf_fortran-4.2-static-intel13/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/sw/squeeze-x64/netcdf-4.2-static/lib/libnetcdf.a") -set(HDF5_LIB_1 "/sw/squeeze-x64/hdf5-1.8.8-static/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/sw/squeeze-x64/hdf5-1.8.8-static/lib/libhdf5.a") -set(SZIP_LIB "/sw/squeeze-x64/szip-2.1-static/lib/libsz.a") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/config/ubuntu.cmake b/config/ubuntu.cmake deleted file mode 100755 index 921a5ce3..00000000 --- a/config/ubuntu.cmake +++ /dev/null @@ -1,15 +0,0 @@ -# ARCH Linux -set(CMAKE_Fortran_COMPILER "gfortran") -set(Fortran_COMPILER_WRAPPER mpif90) - -set(USER_Fortran_FLAGS "-fbacktrace -finit-real=nan -fdefault-real-8 -fno-f2c -ffree-line-length-none") -set(USER_Fortran_FLAGS_RELEASE "-funroll-all-loops -O3 -march=native -mtune=native") -set(USER_Fortran_FLAGS_DEBUG "-W -Wall -Wuninitialized -fcheck=all -fbacktrace -O0 -g -ffpe-trap=invalid,zero,overflow") - -set(NETCDF_INCLUDE_DIR "/usr/include") -set(NETCDF_LIB_1 "/usr/lib/libnetcdff.a") -set(NETCDF_LIB_2 "/usr/lib/libnetcdf.a") -set(HDF5_LIB_1 "/usr/lib/libhdf5_hl.a") -set(HDF5_LIB_2 "/usr/lib/libhdf5.a") -set(SZIP_LIB "") -set(LIBS ${NETCDF_LIB_1} ${NETCDF_LIB_2} ${HDF5_LIB_1} ${HDF5_LIB_2} ${SZIP_LIB} m z curl) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 071bd5f4..4570e3b2 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,4 +1,5 @@ -FILE(GLOB sourcefiles "*.?90") -add_executable(${PROJECT_NAME} ${sourcefiles}) -include_directories(${INCLUDE_DIRS}) -target_link_libraries(${PROJECT_NAME} ${LIBS}) +set(target_name dales4) +FILE(GLOB sourcefiles "*.f90") +add_executable(${target_name} ${sourcefiles}) +target_link_libraries(${target_name} ${NETCDF_LIBS}) +install(TARGETS dales4 DESTINATION ${CMAKE_BINARY_DIR}) From a1e6f6525f0dd3493cecbaee544a871069219299 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Tue, 12 Jul 2016 11:20:55 -0400 Subject: [PATCH 18/88] New swithc ltotruntime, to let runtime being the time from the first cold start instead of since the last warm start --- src/addon/modnudge.f90 | 2 +- src/addon/modparticles.f90 | 2 +- src/modglobal.f90 | 5 +++-- src/modnudge.f90 | 2 +- src/modstartup.f90 | 16 +++++++++++----- src/modtestbed.f90 | 2 +- src/modtimedep.f90 | 12 ++++++------ src/modtimedepsv.f90 | 10 +++++----- 8 files changed, 29 insertions(+), 22 deletions(-) diff --git a/src/addon/modnudge.f90 b/src/addon/modnudge.f90 index 4a1c0d3b..479bf55b 100644 --- a/src/addon/modnudge.f90 +++ b/src/addon/modnudge.f90 @@ -81,7 +81,7 @@ subroutine initnudge t = 0 open (ifinput,file='nudge.inp.'//cexpnr) - do while (timenudge(t) < tres*real(runtime+btime)) + do while (timenudge(t) < tres*real(runtime)) t = t + 1 chmess1 = "#" ierr = 1 ! not zero diff --git a/src/addon/modparticles.f90 b/src/addon/modparticles.f90 index 5c7e014d..1b409959 100644 --- a/src/addon/modparticles.f90 +++ b/src/addon/modparticles.f90 @@ -87,7 +87,7 @@ module modparticles subroutine initparticles use modmpi, only : myid,my_real,mpierr,comm3d,mpi_integer,mpi_logical,nprocs use modglobal,only : ifnamopt,fname_options,ifinput,dtmax,cexpnr,& - dx,dy,dzf,zh,kmax,k1,iexpnr,runtime,timee,ysize,dt_lim,btime,rtimee,tres + dx,dy,dzf,zh,kmax,k1,iexpnr,timee,ysize,dt_lim,btime,rtimee,tres implicit none diff --git a/src/modglobal.f90 b/src/modglobal.f90 index 5c507c0c..c528eb61 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -173,6 +173,7 @@ module modglobal integer(kind=longint) :: timeleft real :: wctime=8640000. !< * The maximum wall clock time of a simulation (set to 100 days by default) logical :: ladaptive = .false. !< * adaptive timestepping on or off + logical :: ltotruntime = .false. !< * Whether the runtime is counted since the last cold start (if true) or the last warm start (if false, default) real :: courant = -1 real :: peclet = 0.15 @@ -458,8 +459,8 @@ subroutine initglobal write(6,'(i4,5f10.2)') k,dzf(k),zf(k),zh(k),dzh(k),delta(k) end do end if - tnextrestart = trestart/tres - timeleft=ceiling(runtime/tres) +! tnextrestart = trestart/tres +! timeleft=ceiling(runtime/tres) end subroutine initglobal !> Clean up when leaving the run diff --git a/src/modnudge.f90 b/src/modnudge.f90 index 8eb6edd4..7119a022 100644 --- a/src/modnudge.f90 +++ b/src/modnudge.f90 @@ -81,7 +81,7 @@ subroutine initnudge t = 0 open (ifinput,file='nudge.inp.'//cexpnr) - do while (timenudge(t) < tres*real(btime)+runtime) + do while (timenudge(t) < runtime) t = t + 1 chmess1 = "#" ierr = 1 ! not zero diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 643434b3..962296a8 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -53,7 +53,7 @@ subroutine startup ! Thijs Heus 15/06/2007 | !-----------------------------------------------------------------| - use modglobal, only : initglobal,iexpnr,runtime, dtmax, wctime, dtav_glob,timeav_glob,& + use modglobal, only : initglobal,iexpnr, ltotruntime, runtime, dtmax, wctime, dtav_glob,timeav_glob,& lwarmstart,startfile,trestart,& nsv,itot,jtot,kmax,xsize,ysize,xlat,xlon,xday,xtime,& lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,llstend,& @@ -82,7 +82,7 @@ subroutine startup !declare namelists namelist/RUN/ & - iexpnr,lwarmstart,startfile,runtime,dtmax,wctime,dtav_glob,timeav_glob,& + iexpnr,lwarmstart,startfile,ltotruntime, runtime,dtmax,wctime,dtav_glob,timeav_glob,& trestart,irandom,randthl,randqt,krand,nsv,courant,peclet,ladaptive,author,& krandumin, krandumax, randu,& nprocx,nprocy @@ -156,6 +156,7 @@ subroutine startup call MPI_BCAST(trestart ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(dtmax ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(dtav_glob ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) + call MPI_BCAST(ltotruntime,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(wctime ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(timeav_glob,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(nsv ,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) @@ -245,8 +246,9 @@ subroutine startup ! Allocate and initialize core modules call initglobal +print *, runtime call initfields - +print *, runtime call inittestbed !reads initial profiles from scm_in.nc, to be used in readinitfiles call initboundary @@ -365,7 +367,7 @@ subroutine readinitfiles use modglobal, only : i1,i2,ih,j1,j2,jh,kmax,k1,dtmax,idtmax,dt,rdt,runtime,timeleft,tres,& rtimee,timee,ntimee,ntrun,btime,dt_lim,nsv,& zf,dzf,dzh,rv,rd,cp,rlv,pref0,om23_gs,& - ijtot,cu,cv,e12min,dzh,cexpnr,ifinput,lwarmstart,itrestart,& + ijtot,cu,cv,e12min,dzh,cexpnr,ifinput,lwarmstart,ltotruntime,itrestart,& trestart, ladaptive,llsadv,tnextrestart use modsubgrid, only : ekm,ekh use modsurfdata, only : wsvsurf, & @@ -782,7 +784,11 @@ subroutine readinitfiles idtmax = floor(dtmax/tres) btime = timee - timeleft=ceiling(runtime/tres) + if (.not.(ltotruntime)) then + runtime = runtime + btime*tres + end if + timeleft=ceiling((runtime)/tres-btime) + dt_lim = timeleft rdt = real(dt)*tres ntrun = 0 diff --git a/src/modtestbed.f90 b/src/modtestbed.f90 index d85a198d..c1d428fb 100644 --- a/src/modtestbed.f90 +++ b/src/modtestbed.f90 @@ -58,7 +58,7 @@ module modtestbed subroutine inittestbed use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer - use modglobal,only :ifnamopt,fname_options,runtime,btime,cexpnr,ifinput,k1,kmax,tres,& + use modglobal,only :ifnamopt,fname_options,cexpnr,ifinput,k1,kmax,& grav,rd,cp,pref0,rlv,zf,dzf,dzh use modsurfdata,only : ksoilmax, phifc, phiwp, dzsoil use modforces, only : lforce_user diff --git a/src/modtimedep.f90 b/src/modtimedep.f90 index 8d67d4d2..c75e3961 100644 --- a/src/modtimedep.f90 +++ b/src/modtimedep.f90 @@ -73,7 +73,7 @@ module modtimedep !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine inittimedep use modmpi, only :myid,my_real,mpi_logical,mpierr,comm3d - use modglobal, only :btime,cexpnr,k1,kmax,ifinput,runtime,zf,tres + use modglobal, only :cexpnr,k1,kmax,ifinput,runtime,zf use modsurfdata,only :ps,qts,wqsurf,wtsurf,thls, Qnetav use modtimedepsv, only : inittimedepsv @@ -205,7 +205,7 @@ subroutine inittimedep !--- load fluxes--- t = 0 ierr = 0 - do while (timeflux(t) < (tres*real(btime)+runtime)) + do while (timeflux(t) < runtime) t=t+1 read(ifinput,*, iostat = ierr) timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) write(*,'(i8,7e12.4)') t,timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) @@ -213,7 +213,7 @@ subroutine inittimedep stop 'STOP: No time dependend data for end of run (surface fluxes)' end if end do - if(timeflux(1)>(tres*real(btime)+runtime)) then + if(timeflux(1)>runtime) then write(6,*) 'Time dependent surface variables do not change before end of' write(6,*) 'simulation. --> only large scale forcings' ltimedepsurf=.false. @@ -227,7 +227,7 @@ subroutine inittimedep !---load large scale forcings---- t = 0 - do while (timels(t) < (runtime+btime)) + do while (timels(t) < runtime) t = t + 1 chmess1 = "#" ierr = 1 ! not zero @@ -269,13 +269,13 @@ subroutine inittimedep ! end do - if(timeflux(1)>(runtime+btime)) then + if(timeflux(1)>runtime) then write(6,*) 'Time dependent surface variables do not change before end of' write(6,*) 'simulation. --> only large scale forcings' ltimedepsurf=.false. endif - if ((timels(1) > (tres*real(btime)+runtime)) .or. (timeflux(1) > (tres*real(btime)+runtime))) then + if ((timels(1) > runtime) .or. (timeflux(1) > runtime)) then write(6,*) 'Time dependent large scale forcings sets in after end of simulation -->' write(6,*) '--> only time dependent surface variables' ltimedepz=.false. diff --git a/src/modtimedepsv.f90 b/src/modtimedepsv.f90 index 22b99f49..c0b3ef3d 100644 --- a/src/modtimedepsv.f90 +++ b/src/modtimedepsv.f90 @@ -56,7 +56,7 @@ module modtimedepsv !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine inittimedepsv use modmpi, only :myid,my_real,mpi_logical,mpierr,comm3d - use modglobal,only :btime,cexpnr,kmax,k1,ifinput,runtime,tres,nsv + use modglobal,only :cexpnr,kmax,k1,ifinput,runtime,nsv implicit none character (80):: chmess @@ -98,7 +98,7 @@ subroutine inittimedepsv write(outputfmt(8:10),'(I3)') nsv t = 0 ierr = 0 - do while (timesvsurf(t)< tres*real(btime)+runtime) + do while (timesvsurf(t)< runtime) t=t+1 read(ifinput,*, iostat = ierr) timesvsurf(t), (svst(t,n),n=1,nsv) write(*,'(f7.1,4e12.4)') timesvsurf(t), (svst(t,n),n=1,nsv) @@ -106,7 +106,7 @@ subroutine inittimedepsv stop 'STOP: No time dependend data for end of run (surface fluxes of scalar)' end if end do - if(timesvsurf(1)>tres*real(btime)+runtime) then + if(timesvsurf(1)>runtime) then write(6,*) 'Time dependent surface variables do not change before end of' write(6,*) 'simulation. --> only large scale changes in scalars' ltimedepsvsurf=.false. @@ -118,7 +118,7 @@ subroutine inittimedepsv ! ---load large scale forcings---- t = 0 - do while (timesvz(t) < tres*(btime)+runtime) + do while (timesvz(t) < runtime) t = t + 1 chmess1 = "#" ierr = 1 ! not zero @@ -138,7 +138,7 @@ subroutine inittimedepsv end do end do - if ((timesvz(1) > tres*real(btime)+runtime) .or. (timesvsurf(1) > tres*real(btime)+runtime)) then + if ((timesvz(1) > runtime) .or. (timesvsurf(1) > runtime)) then write(6,*) 'Time dependent large scale forcings sets in after end of simulation -->' write(6,*) '--> only time dependent surface variables (scalars)' ltimedepsvz=.false. From 50fca14b592f47efefa068f84fd89f67c1008f20 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Tue, 12 Jul 2016 12:31:10 -0400 Subject: [PATCH 19/88] Update restart filenames in namoptions files --- cases/arm_brown/namoptions.001 | 2 +- cases/arm_unstable/namoptions.001 | 2 +- cases/atex/namoptions.001 | 2 +- cases/bomex/namoptions.001 | 2 +- cases/cblstrong/namoptions.001 | 2 +- cases/cblweak/namoptions.001 | 2 +- cases/dycoms_rf02/namoptions.001 | 2 +- cases/example/input/namoptions.001 | 2 +- cases/example/input/namoptions.lsm | 2 +- cases/example/input/namoptions.lsmrad | 2 +- cases/example/inputwindnoneq/namoptions.001 | 2 +- cases/example/namoptions.001 | 2 +- cases/example/namoptions.lsm | 2 +- cases/example/namoptions.lsmrad | 2 +- cases/fog/namoptions.001 | 2 +- cases/gabls1/namoptions.001 | 2 +- cases/hireslapse/namoptions.001 | 2 +- cases/neutral/namoptions.001 | 2 +- cases/rico/namoptions.001 | 2 +- cases/smoke/namoptions.001 | 2 +- 20 files changed, 20 insertions(+), 20 deletions(-) diff --git a/cases/arm_brown/namoptions.001 b/cases/arm_brown/namoptions.001 index 400ad73a..4fc30cec 100644 --- a/cases/arm_brown/namoptions.001 +++ b/cases/arm_brown/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 50400 trestart = 7200 dtmax = 10 diff --git a/cases/arm_unstable/namoptions.001 b/cases/arm_unstable/namoptions.001 index 400ad73a..4fc30cec 100644 --- a/cases/arm_unstable/namoptions.001 +++ b/cases/arm_unstable/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 50400 trestart = 7200 dtmax = 10 diff --git a/cases/atex/namoptions.001 b/cases/atex/namoptions.001 index 8a17f0bc..bf2a8382 100644 --- a/cases/atex/namoptions.001 +++ b/cases/atex/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd06h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 28800.0 trestart = 3600 ladaptive = .true. diff --git a/cases/bomex/namoptions.001 b/cases/bomex/namoptions.001 index 80435485..f461e80e 100644 --- a/cases/bomex/namoptions.001 +++ b/cases/bomex/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd08h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 28800 trestart = 3600 ladaptive = .true. diff --git a/cases/cblstrong/namoptions.001 b/cases/cblstrong/namoptions.001 index 8c2874bb..06bb0ba7 100644 --- a/cases/cblstrong/namoptions.001 +++ b/cases/cblstrong/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd03h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 14400 trestart = 3600 ladaptive = .true. diff --git a/cases/cblweak/namoptions.001 b/cases/cblweak/namoptions.001 index 75dd1054..85750116 100644 --- a/cases/cblweak/namoptions.001 +++ b/cases/cblweak/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd03h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 14400 trestart = 3600 ladaptive = .true. diff --git a/cases/dycoms_rf02/namoptions.001 b/cases/dycoms_rf02/namoptions.001 index c0bdacd0..03c00b20 100644 --- a/cases/dycoms_rf02/namoptions.001 +++ b/cases/dycoms_rf02/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd01h00m002.999' +startfile = 'initd001h00mx000y000.001' runtime = 21600 trestart = 10800 ladaptive = .true. diff --git a/cases/example/input/namoptions.001 b/cases/example/input/namoptions.001 index 717f21fe..e4ae7fb7 100644 --- a/cases/example/input/namoptions.001 +++ b/cases/example/input/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/example/input/namoptions.lsm b/cases/example/input/namoptions.lsm index 70afd02c..de7fcab3 100644 --- a/cases/example/input/namoptions.lsm +++ b/cases/example/input/namoptions.lsm @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/example/input/namoptions.lsmrad b/cases/example/input/namoptions.lsmrad index a3343a5e..a92b809b 100644 --- a/cases/example/input/namoptions.lsmrad +++ b/cases/example/input/namoptions.lsmrad @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/example/inputwindnoneq/namoptions.001 b/cases/example/inputwindnoneq/namoptions.001 index f87a082c..8ffeb62f 100644 --- a/cases/example/inputwindnoneq/namoptions.001 +++ b/cases/example/inputwindnoneq/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd03h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 260000 trestart = 3600 ladaptive = .true. diff --git a/cases/example/namoptions.001 b/cases/example/namoptions.001 index 717f21fe..e4ae7fb7 100644 --- a/cases/example/namoptions.001 +++ b/cases/example/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/example/namoptions.lsm b/cases/example/namoptions.lsm index 70afd02c..de7fcab3 100644 --- a/cases/example/namoptions.lsm +++ b/cases/example/namoptions.lsm @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/example/namoptions.lsmrad b/cases/example/namoptions.lsmrad index a3343a5e..a92b809b 100644 --- a/cases/example/namoptions.lsmrad +++ b/cases/example/namoptions.lsmrad @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 7200 trestart = 3600 ladaptive = .true. diff --git a/cases/fog/namoptions.001 b/cases/fog/namoptions.001 index 86cb9bc0..9900031f 100644 --- a/cases/fog/namoptions.001 +++ b/cases/fog/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 36000 trestart = 3600 ladaptive = .true. diff --git a/cases/gabls1/namoptions.001 b/cases/gabls1/namoptions.001 index fb2de06d..32ac391b 100644 --- a/cases/gabls1/namoptions.001 +++ b/cases/gabls1/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd04h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 32400 trestart = 3600 irandom = 43 diff --git a/cases/hireslapse/namoptions.001 b/cases/hireslapse/namoptions.001 index a169c8d7..fbec8c75 100644 --- a/cases/hireslapse/namoptions.001 +++ b/cases/hireslapse/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initdlatest000.001' +startfile = 'initd001h00mx000y000.001' runtime = 10800 trestart = 3600 ladaptive = .true. diff --git a/cases/neutral/namoptions.001 b/cases/neutral/namoptions.001 index e8a1a7b1..eac29230 100644 --- a/cases/neutral/namoptions.001 +++ b/cases/neutral/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd40h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 180000 trestart = 36000 ladaptive = .true. diff --git a/cases/rico/namoptions.001 b/cases/rico/namoptions.001 index e7a7eebd..524997d7 100644 --- a/cases/rico/namoptions.001 +++ b/cases/rico/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h01m000.000' +startfile = 'initd001h00mx000y000.001' runtime = 86400 trestart = 3600 ladaptive = .true. diff --git a/cases/smoke/namoptions.001 b/cases/smoke/namoptions.001 index e0af0e0a..b862be0f 100644 --- a/cases/smoke/namoptions.001 +++ b/cases/smoke/namoptions.001 @@ -1,7 +1,7 @@ &RUN iexpnr = 001 lwarmstart = .false. -startfile = 'initd00h00m000.001' +startfile = 'initd001h00mx000y000.001' runtime = 10800 trestart = 3600 ladaptive = .true. From e3c1ec8d706498fdb3a8b682ace9a4487c30dcb2 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Tue, 12 Jul 2016 16:39:28 -0400 Subject: [PATCH 20/88] Got rid of most of the compiler warnings in most of the source code --- src/addon/modgenstat.f90 | 2 +- src/addon/modheterostats.f90 | 2 +- src/addon/modnetcdfstats.f90 | 2 +- src/addon/modnudge.f90 | 6 ++-- src/addon/modtimestat.f90 | 13 ++++---- src/modAGScross.f90 | 11 +++---- src/modboundary.f90 | 9 +++--- src/modbulkmicro.f90 | 4 +-- src/modcanopy.f90 | 10 +++--- src/modchem.f90 | 4 +-- src/modcrosssection.f90 | 2 +- src/modforces.f90 | 2 +- src/modgenstat.f90 | 2 +- src/modglobal.f90 | 31 +++++++++---------- src/modheterostats.f90 | 2 +- src/modnudge.f90 | 8 ++--- src/modpois.f90 | 4 +-- src/modquadrant.f90 | 4 +-- src/modradfull.f90 | 59 ++++++++++++++++++------------------ src/modstartup.f90 | 10 +++--- src/modstat_nc.f90 | 4 +-- src/modsubgrid.f90 | 2 +- src/modsurface.f90 | 2 +- src/modsurfdata.f90 | 4 +-- src/modtestbed.f90 | 16 +++++----- src/modtimedep.f90 | 10 +++--- src/modtimedepsv.f90 | 2 +- src/modtimestat.f90 | 10 +++--- src/tstep.f90 | 5 +-- 29 files changed, 115 insertions(+), 127 deletions(-) diff --git a/src/addon/modgenstat.f90 b/src/addon/modgenstat.f90 index 7068bea4..ad5191e8 100644 --- a/src/addon/modgenstat.f90 +++ b/src/addon/modgenstat.f90 @@ -667,7 +667,7 @@ subroutine do_genstat qls = 0.0 ! hj: no liquid water at the surface tsurf = thls*exnh(1)+(rlv/cp)*qls qsat = qts - qls - if (qls==0) then + if (qls < eps1) then !TH: Should always be the case at the surface c1 = 1.+(rv/rd-1)*qts c2 = (rv/rd-1) else diff --git a/src/addon/modheterostats.f90 b/src/addon/modheterostats.f90 index 1ef9e31e..2e63a2f2 100644 --- a/src/addon/modheterostats.f90 +++ b/src/addon/modheterostats.f90 @@ -233,7 +233,7 @@ end subroutine initheterostats subroutine heterostats - use modglobal, only : rk3step,ntimee,dt_lim,timee + use modglobal, only : rk3step,dt_lim,timee implicit none if (.not. lheterostats) return diff --git a/src/addon/modnetcdfstats.f90 b/src/addon/modnetcdfstats.f90 index a719be0d..42abbd3f 100644 --- a/src/addon/modnetcdfstats.f90 +++ b/src/addon/modnetcdfstats.f90 @@ -196,7 +196,7 @@ end subroutine initnetcdfstats subroutine netcdfstats - use modglobal, only : rk3step,ntimee + use modglobal, only : rk3step implicit none if (.not. lnetcdf) return diff --git a/src/addon/modnudge.f90 b/src/addon/modnudge.f90 index 479bf55b..22fde8fa 100644 --- a/src/addon/modnudge.f90 +++ b/src/addon/modnudge.f90 @@ -136,7 +136,7 @@ end subroutine initnudge !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine nudge - use modglobal, only : rtimee,i1,j1,k1,rk3step,kmax,rdt + use modglobal, only : timee,i1,j1,k1,rk3step,kmax,rdt use modfields, only : up,vp,wp,thlp, qtp,u0av,v0av,qt0av,thl0av use modmpi, only : myid implicit none @@ -146,13 +146,13 @@ subroutine nudge if (.not.(lnudge)) return ! if (rk3step/=3) return - if (rtimee==0) return + if (timee==0) return t=1 do while(rtimee>timenudge(t)) t=t+1 end do - if (rtimee/=timenudge(1)) then + if (rtimee>timenudge(1)) then t=t-1 end if diff --git a/src/addon/modtimestat.f90 b/src/addon/modtimestat.f90 index 93e2def9..3b0a2e11 100644 --- a/src/addon/modtimestat.f90 +++ b/src/addon/modtimestat.f90 @@ -77,8 +77,7 @@ subroutine inittimestat namelist/NAMTIMESTAT/ & !< namelist dtav,ltimestat,blh_thres,iblh_meth,iblh_var,blh_nsamp,blh_thres !! namelist contents -!!bla -!!dibla + dtav=dtav_glob if(myid==0)then @@ -217,7 +216,7 @@ end subroutine inittimestat !>Run timestat. Calculate and write the statistics subroutine timestat - use modglobal, only : i1,j1,kmax,zf,dzf,cu,cv,rv,rd,& + use modglobal, only : i1,j1,kmax,zf,dzf,cu,cv,rv,rd,eps1,& ijtot,timee,rtimee,dt_lim,rk3step,cexpnr,ifoutput ! use modfields, only : um,vm,wm,e12m,ql0,u0av,v0av,rhof @@ -498,13 +497,13 @@ subroutine timestat if (lnetcdf) then vars( 1) = rtimee vars( 2) = cc - if (vars(2)==0) vars(2) = nc_fillvalue + if (vars(2) Initializing AGScross. Read out the namelist, initializing the variables subroutine initAGScross - use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer,cmyid - use modglobal,only :imax,jmax,ifnamopt,fname_options,dtmax,rk3step, dtav_glob,ladaptive,j1,kmax,i1,dt_lim,cexpnr,tres,btime + use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,cmyid + use modglobal,only :imax,jmax,ifnamopt,fname_options,dtmax, dtav_glob,ladaptive,dt_lim,cexpnr,tres,btime use modstat_nc,only : open_nc, define_nc,ncinfo,writestat_dims_nc use modsurfdata, only : lrsAgs, ksoilmax implicit none - integer :: ierr,k + integer :: ierr namelist/NAMAGScross/ & lAGScross, dtav @@ -131,7 +131,7 @@ subroutine initAGScross end subroutine initAGScross !>Run AGScross. Mainly timekeeping subroutine AGScross - use modglobal, only : rk3step,timee,rtimee,dt_lim + use modglobal, only : rk3step,timee,dt_lim use modstat_nc, only : writestat_nc implicit none @@ -162,8 +162,7 @@ subroutine AGShorz ! LOCAL - integer i,j,n - character(40) :: name + integer i,j real, allocatable :: vars(:,:,:) real :: lwp(2:i1,2:j1) diff --git a/src/modboundary.f90 b/src/modboundary.f90 index 74fa21d2..2f3581ad 100644 --- a/src/modboundary.f90 +++ b/src/modboundary.f90 @@ -92,10 +92,11 @@ end subroutine exitboundary !> Sets lateral periodic boundary conditions for the scalars subroutine cyclich - use modglobal, only : i1,i2,ih,j1,jh,k1,nsv + use modglobal, only : i1,ih,j1,jh,k1,nsv use modfields, only : thl0,thlm,qt0,qtm,sv0,svm use modmpi, only : excjs - integer n,m + + integer n call excjs( thl0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( qt0 , 2,i1,2,j1,1,k1,ih,jh) @@ -113,12 +114,10 @@ end subroutine cyclich !>set lateral periodic boundary conditions for momentum subroutine cyclicm - use modglobal, only : i1,i2,ih,j1,jh,k1 + use modglobal, only : i1,ih,j1,jh,k1 use modfields, only : u0,um,v0,vm,w0,wm,e120,e12m use modmpi, only : excjs - integer m - call excjs( u0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( v0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( w0 , 2,i1,2,j1,1,k1,ih,jh) diff --git a/src/modbulkmicro.f90 b/src/modbulkmicro.f90 index 8b015732..1fd9672f 100644 --- a/src/modbulkmicro.f90 +++ b/src/modbulkmicro.f90 @@ -149,7 +149,7 @@ subroutine bulkmicro delt = rdt/ (4. - dble(rk3step)) - if ( timee .eq. 0. .and. rk3step .eq. 1 .and. myid .eq. 0) then + if ( timee .eq. 0 .and. rk3step .eq. 1 .and. myid .eq. 0) then write(*,*) 'l_lognormal',l_lognormal write(*,*) 'rhof(1)', rhof(1),' rhof(10)', rhof(10) write(*,*) 'l_mur_cst',l_mur_cst,' mur_cst',mur_cst @@ -697,7 +697,7 @@ subroutine sedimentation_rain enddo enddo - if ( jn == 1. ) then + if ( jn == 1 ) then do j=2,j1 do i=2,i1 precep(i,j,k) = sed_qr(i,j,k)/rhof(k) ! kg kg-1 m s-1 diff --git a/src/modcanopy.f90 b/src/modcanopy.f90 index 641f484e..f0b00b80 100644 --- a/src/modcanopy.f90 +++ b/src/modcanopy.f90 @@ -56,7 +56,7 @@ module modcanopy !----------------------------------------------------------------------------------------- SUBROUTINE initcanopy use modmpi, only : myid, mpi_logical, mpi_integer, my_real, comm3d, mpierr - use modglobal, only : kmax,k1, ifnamopt, fname_options, ifinput, ifoutput, cexpnr, zh, dzh, dzf, nsv + use modglobal, only : kmax, ifnamopt, fname_options, ifinput, cexpnr, zh, dzh, dzf implicit none @@ -180,7 +180,7 @@ SUBROUTINE initcanopy end subroutine initcanopy subroutine canopy - use modfields, only : up,vp,wp,e12p,thlp,qtp,sv0,svp + use modfields, only : up,vp,wp,e12p,thlp,qtp,svp use modsurfdata, only : thlflux, qtflux, svflux use modglobal, only : nsv,i2,j2 @@ -237,7 +237,7 @@ subroutine exitcanopy end subroutine exitcanopy subroutine canopyu (putout) - use modglobal, only : i1, i2, ih, j1, j2, jh, k1, cu, cv, dzh, dzf, imax, jmax + use modglobal, only : i1, ih, j1, j2, jh, k1, cu, cv, dzh, imax, jmax use modfields, only : u0, v0, w0 implicit none @@ -264,7 +264,7 @@ subroutine canopyu (putout) end subroutine canopyu subroutine canopyv (putout) - use modglobal, only : i1, i2, ih, j1, j2, jh, k1, cu, cv, dzh, dzf, imax, jmax + use modglobal, only : i1, i2, ih, j1, jh, k1, cu, cv, dzh, imax, jmax use modfields, only : u0, v0, w0 implicit none @@ -318,7 +318,7 @@ subroutine canopyw (putout) end subroutine canopyw subroutine canopye (putout) - use modglobal, only : i1, i2, ih, j1, j2, jh, k1, cu, cv, dzh, dzf, imax, jmax + use modglobal, only : i1, i2, ih, j1, j2, jh, k1, cu, cv, dzh, imax, jmax use modfields, only : u0, v0, w0, e120 implicit none diff --git a/src/modchem.f90 b/src/modchem.f90 index b280594b..d8c16eeb 100644 --- a/src/modchem.f90 +++ b/src/modchem.f90 @@ -238,7 +238,7 @@ module modchem contains !----------------------------------------------------------------------------------------- SUBROUTINE initchem - use modglobal, only : i1,j1,i2,nsv, ifnamopt, fname_options, ifoutput, cexpnr,timeav_glob,btime,tres + use modglobal, only : i1,j1,nsv, ifnamopt, fname_options, ifoutput, cexpnr,timeav_glob,btime,tres use modmpi, only : myid, mpi_logical, mpi_integer, my_real, comm3d, mpierr use modsurfdata, only : lCHon implicit none @@ -1787,7 +1787,7 @@ subroutine ratech !----------------------------------------------------------------- ! - use modglobal, only : i1,j1,i2,kmax,pi,xtime,timee,rtimee,xday,xlat,xlon, & + use modglobal, only : i1,j1,kmax,pi,xtime,timee,rtimee,xday,xlat,xlon, & zf,dzf,ijtot,ifoutput,cexpnr use modfields, only : qt0, ql0 ,rhof use modmpi, only : myid, comm3d, mpierr, mpi_max, my_real, mpi_sum diff --git a/src/modcrosssection.f90 b/src/modcrosssection.f90 index cb1ca49c..6bf03cfe 100644 --- a/src/modcrosssection.f90 +++ b/src/modcrosssection.f90 @@ -428,7 +428,7 @@ subroutine wrtorth ! LOCAL integer j,k,n - character(20) :: name + character(21) :: name real, allocatable :: thv0(:,:),vars(:,:,:),buoy(:,:) diff --git a/src/modforces.f90 b/src/modforces.f90 index 44b6c183..9d227edf 100644 --- a/src/modforces.f90 +++ b/src/modforces.f90 @@ -224,7 +224,7 @@ subroutine lstend ! | !-----------------------------------------------------------------| - use modglobal, only : i1,j1,k1,kmax,dzh,nsv,lmomsubs,llstend + use modglobal, only : i1,j1,kmax,dzh,nsv,lmomsubs use modfields, only : up,vp,thlp,qtp,svp,& whls, u0av,v0av,thl0,qt0,sv0,u0,v0,& dudxls,dudyls,dvdxls,dvdyls,dthldxls,dthldyls,dqtdxls,dqtdyls, & diff --git a/src/modgenstat.f90 b/src/modgenstat.f90 index 08f4a84c..69a7a7a6 100644 --- a/src/modgenstat.f90 +++ b/src/modgenstat.f90 @@ -701,7 +701,7 @@ subroutine do_genstat qls = 0.0 ! hj: no liquid water at the surface tsurf = thls*exnh(1)+(rlv/cp)*qls qsat = qts - qls - if (qls==0) then + if (qls< eps1) then ! TH: Should always be true c1 = 1.+(rv/rd-1)*qts c2 = (rv/rd-1) else diff --git a/src/modglobal.f90 b/src/modglobal.f90 index c528eb61..b16e4d32 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -168,7 +168,6 @@ module modglobal integer(kind=longint) :: timee !< * elapsed time since the "cold" start real :: rtimee !< * elapsed time since the "cold" start integer(kind=longint) :: btime !< * time of (re)start - integer :: ntimee !< * number of timesteps since the cold start integer :: ntrun !< * number of timesteps since the start of the run integer(kind=longint) :: timeleft real :: wctime=8640000. !< * The maximum wall clock time of a simulation (set to 100 days by default) @@ -424,7 +423,7 @@ subroutine initglobal leq=.true. dz = dzf(1) do k=1,k1 - if (dzf(k)/=dz) then + if ((dzf(k)-dz)/dz>eps1) then leq = .false. end if end do @@ -584,30 +583,30 @@ FUNCTION LACZ_GAMMA(X) RESULT(fn_val) !---------------------------------------------------------------------- ! Machine dependent parameters !---------------------------------------------------------------------- -REAL (dp), PARAMETER :: xbig = 171.624_dp, xminin = 2.23D-308, & - eps = 2.22D-16, xinf = 1.79D308 +REAL (dp), PARAMETER :: xbig = 171.624_dp, xminin = 2.23E-308_dp, & + eps = 2.22E-16_dp, xinf = 1.79E308_dp !---------------------------------------------------------------------- ! Numerator and denominator coefficients for rational minimax ! approximation over (1,2). !---------------------------------------------------------------------- REAL (dp), PARAMETER :: P(8) = & - (/ -1.71618513886549492533811D+0, 2.47656508055759199108314D+1, & - -3.79804256470945635097577D+2, 6.29331155312818442661052D+2, & - 8.66966202790413211295064D+2, -3.14512729688483675254357D+4, & - -3.61444134186911729807069D+4, 6.64561438202405440627855D+4 /) + (/ -1.71618513886549492533811E+0_dp, 2.47656508055759199108314E+1_dp, & + -3.79804256470945635097577E+2_dp, 6.29331155312818442661052E+2_dp, & + 8.66966202790413211295064E+2_dp, -3.14512729688483675254357E+4_dp, & + -3.61444134186911729807069E+4_dp, 6.64561438202405440627855E+4_dp /) REAL (dp), PARAMETER :: Q(8) = & - (/ -3.08402300119738975254353D+1, 3.15350626979604161529144D+2, & - -1.01515636749021914166146D+3, -3.10777167157231109440444D+3, & - 2.25381184209801510330112D+4, 4.75584627752788110767815D+3, & - -1.34659959864969306392456D+5, -1.15132259675553483497211D+5 /) + (/ -3.08402300119738975254353E+1_dp, 3.15350626979604161529144E+2_dp, & + -1.01515636749021914166146E+3_dp, -3.10777167157231109440444E+3_dp, & + 2.25381184209801510330112E+4_dp, 4.75584627752788110767815E+3_dp, & + -1.34659959864969306392456E+5_dp, -1.15132259675553483497211E+5_dp /) !---------------------------------------------------------------------- ! Coefficients for minimax approximation over (12, INF). !---------------------------------------------------------------------- REAL (dp), PARAMETER :: c(7) = & - (/ -1.910444077728D-03, 8.4171387781295D-04, & - -5.952379913043012D-04, 7.93650793500350248D-04, & - -2.777777777777681622553D-03, 8.333333333333333331554247D-02, & - 5.7083835261D-03 /) + (/ -1.910444077728E-03_dp, 8.4171387781295E-04_dp, & + -5.952379913043012E-04_dp, 7.93650793500350248E-04_dp, & + -2.777777777777681622553E-03_dp, 8.333333333333333331554247E-02_dp, & + 5.7083835261E-03_dp /) !---------------------------------------------------------------------- parity = .false. diff --git a/src/modheterostats.f90 b/src/modheterostats.f90 index 1ff742e8..cce46864 100644 --- a/src/modheterostats.f90 +++ b/src/modheterostats.f90 @@ -1136,7 +1136,7 @@ subroutine exitheterostats use typeSizes use netcdf - use modmpi, only : myid,myidx + use modmpi, only : myidx implicit none diff --git a/src/modnudge.f90 b/src/modnudge.f90 index 7119a022..3e6c6f8d 100644 --- a/src/modnudge.f90 +++ b/src/modnudge.f90 @@ -44,7 +44,7 @@ module modnudge contains subroutine initnudge use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical - use modglobal,only :ifnamopt,fname_options,runtime,btime,cexpnr,ifinput,k1,kmax,tres + use modglobal,only :ifnamopt,fname_options,runtime,cexpnr,ifinput,k1,kmax implicit none integer :: ierr,k,t @@ -137,7 +137,7 @@ end subroutine initnudge !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine nudge - use modglobal, only : rtimee,i1,j1,kmax,rdt + use modglobal, only : timee,rtimee,i1,j1,kmax,rdt use modfields, only : up,vp,wp,thlp, qtp,u0av,v0av,qt0av,thl0av implicit none @@ -146,13 +146,13 @@ subroutine nudge if (.not.(lnudge)) return ! if (rk3step/=3) return - if (rtimee==0) return + if (timee==0) return t=1 do while(rtimee>timenudge(t)) t=t+1 end do - if (rtimee/=timenudge(1)) then + if (rtimee>timenudge(1)) then t=t-1 end if diff --git a/src/modpois.f90 b/src/modpois.f90 index 8c5f4dff..2c692cc2 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -229,7 +229,7 @@ subroutine solmpj ! copy times all included use modfft2d, only : fft2df, fft2db - use modglobal, only : kmax,dzf,dzh,i1,j1,ih,jh + use modglobal, only : kmax,dzf,dzh,i1,j1,ih,jh,eps1 use modfields, only : rhobf, rhobh implicit none @@ -284,7 +284,7 @@ subroutine solmpj do i=2,i1 bbk = bk + rhobf(kmax)*xyrt(i,j) z = bbk-ak*d(i,j,kmax-1) - if(z/=0.) then + if(abs(z) linear interpolation between two points, returns indicies of the - !> interpolation points and weights - !> - subroutine interpolate(x,ny,y,i1,i2,alpha) - - integer, intent (in) :: ny - real, intent (in) :: x, y(ny) - - integer, intent (out) :: i1, i2 - real, intent (out) :: alpha - - if (y(1) < y(2)) stop 'TERMINATING: band centers increasing' - - i2 = 1 - do while (x < y(i2) .and. i2 < ny) - i2 = i2+1 - end do - i1 = max(1,i2-1) - alpha = 1. - - if(i2.ne.i1) alpha = (x-y(i1))/(y(i2)-y(i1)) - if (alpha <0 .or. alpha >1) print 600, x, y(1), y(ny), alpha - - return - -600 format(/'CLOUD_INIT WARNING: Extrapolating because data out of range', & - /1x,'x = ',F8.1,', ymax = ',F7.0,', ymin =',F7.0,', alpha = ',F6.3) - end subroutine interpolate +! +! !> linear interpolation between two points, returns indicies of the +! !> interpolation points and weights +! !> +! subroutine interpolate(x,ny,y,i1,i2,alpha) +! +! integer, intent (in) :: ny +! real, intent (in) :: x, y(ny) +! +! integer, intent (out) :: i1, i2 +! real, intent (out) :: alpha +! +! if (y(1) < y(2)) stop 'TERMINATING: band centers increasing' +! +! i2 = 1 +! do while (x < y(i2) .and. i2 < ny) +! i2 = i2+1 +! end do +! i1 = max(1,i2-1) +! alpha = 1. +! +! if(i2.ne.i1) alpha = (x-y(i1))/(y(i2)-y(i1)) +! if (alpha <0 .or. alpha >1) print 600, x, y(1), y(ny), alpha +! +! return +! +! 600 format(/'CLOUD_INIT WARNING: Extrapolating because data out of range', & +! /1x,'x = ',F8.1,', ymax = ',F7.0,', ymin =',F7.0,', alpha = ',F6.3) +! end subroutine interpolate subroutine initvar_cldwtr(cntrs,re,fl,bz,wz,gz) real, dimension(:),intent(out) :: cntrs,re,fl real, dimension(:,:),intent(out) :: bz,wz,gz diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 962296a8..7a2f9b66 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -337,8 +337,8 @@ subroutine checkinitvalues case(1) case(2,10) case(3:4) - if (wtsurf == -1) stop 'wtsurf not set' - if (wqsurf == -1) stop 'wqsurf not set' + if (wtsurf <-1e10) stop 'wtsurf not set' + if (wqsurf <-1e10) stop 'wqsurf not set' case default stop 'isurf out of range/not set' end select @@ -365,7 +365,7 @@ subroutine readinitfiles v0av,u0av,qt0av,ql0av,thl0av,sv0av,exnf,exnh,presf,presh,rhof,& thlpcar,thvh,thvf use modglobal, only : i1,i2,ih,j1,j2,jh,kmax,k1,dtmax,idtmax,dt,rdt,runtime,timeleft,tres,& - rtimee,timee,ntimee,ntrun,btime,dt_lim,nsv,& + rtimee,timee,ntrun,btime,dt_lim,nsv,& zf,dzf,dzh,rv,rd,cp,rlv,pref0,om23_gs,& ijtot,cu,cv,e12min,dzh,cexpnr,ifinput,lwarmstart,ltotruntime,itrestart,& trestart, ladaptive,llsadv,tnextrestart @@ -380,7 +380,7 @@ subroutine readinitfiles use moduser, only : initsurf_user use modtestbed, only : ltestbed,tb_ps,tb_thl,tb_qt,tb_u,tb_v,tb_w,tb_ug,tb_vg,& - tb_dqtdxls,tb_dqtdyls,tb_uadv,tb_vadv,tb_qtadv,tb_thladv + tb_dqtdxls,tb_dqtdyls,tb_qtadv,tb_thladv integer i,j,k,n real, allocatable :: height(:), th0av(:) @@ -793,7 +793,6 @@ subroutine readinitfiles rdt = real(dt)*tres ntrun = 0 rtimee = real(timee)*tres - ntimee = nint(timee/dtmax) itrestart = floor(trestart/tres) tnextrestart = btime + itrestart deallocate (height,th0av) @@ -1050,7 +1049,6 @@ subroutine randomnize(field,klev,ampl,ir,ihl,jhl) integer ihl, jhl integer i,j,klev integer is,ie,js,je - integer m,mfac real ran,ampl real field(2-ihl:i1+ihl,2-jhl:j1+jhl,k1) parameter (imm = 134456, ia = 8121, ic = 28411) diff --git a/src/modstat_nc.f90 b/src/modstat_nc.f90 index 7f6b4e5e..1f647fc2 100644 --- a/src/modstat_nc.f90 +++ b/src/modstat_nc.f90 @@ -73,11 +73,11 @@ end subroutine initstat_nc ! ---------------------------------------------------------------------- !> Subroutine Open_NC: Opens a NetCDF File and identifies starting record ! - subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq, ncoarse) + subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq) use modglobal, only : author,version,rtimee implicit none integer, intent (out) :: ncid,nrec - integer, optional, intent (in) :: n1, n2, n3, ns, ncoarse, nq + integer, optional, intent (in) :: n1, n2, n3, ns, nq character (len=40), intent (in) :: fname character (len=12):: date='',time='' diff --git a/src/modsubgrid.f90 b/src/modsubgrid.f90 index 40c55f98..25eaeb88 100644 --- a/src/modsubgrid.f90 +++ b/src/modsubgrid.f90 @@ -69,7 +69,7 @@ subroutine initsubgrid ce1 = (cn**2)* (cm/Rigc - ch1*cm ) ce2 = ceps - ce1 - if(cs == -1.) then + if(cs < 0.) then csz(:) = (cm**3/ceps)**0.25 !< Smagorinsky constant else csz(:) = cs diff --git a/src/modsurface.f90 b/src/modsurface.f90 index b9d4fc53..7dc9dfb5 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -1365,7 +1365,7 @@ function E1(x) real :: E1 real, intent(in) :: x real :: E1sum!, factorial - integer :: k,t + integer :: k E1sum = 0.0 do k=1,99 diff --git a/src/modsurfdata.f90 b/src/modsurfdata.f90 index b4545dbb..64af284c 100644 --- a/src/modsurfdata.f90 +++ b/src/modsurfdata.f90 @@ -223,8 +223,8 @@ module modsurfdata ! prescribed surface fluxes real :: ustin = -1 !< Prescribed friction velocity [m/s] - real :: wtsurf = -1 !< Prescribed kinematic temperature flux [K m/s] - real :: wqsurf = -1 !< Prescribed kinematic moisture flux [kg/kg m/s] + real :: wtsurf = -1e-20 !< Prescribed kinematic temperature flux [K m/s] + real :: wqsurf = -1e-20 !< Prescribed kinematic moisture flux [kg/kg m/s] real :: wsvsurf(100) = 0 !< Prescribed surface scalar(n) flux [- m/s] ! Heterogeneous surfaces diff --git a/src/modtestbed.f90 b/src/modtestbed.f90 index c1d428fb..8322be75 100644 --- a/src/modtestbed.f90 +++ b/src/modtestbed.f90 @@ -58,9 +58,9 @@ module modtestbed subroutine inittestbed use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer - use modglobal,only :ifnamopt,fname_options,cexpnr,ifinput,k1,kmax,& - grav,rd,cp,pref0,rlv,zf,dzf,dzh - use modsurfdata,only : ksoilmax, phifc, phiwp, dzsoil + use modglobal,only :ifnamopt,fname_options,k1,& + grav,rd,cp,pref0,rlv,zf + use modsurfdata,only : ksoilmax use modforces, only : lforce_user implicit none @@ -81,7 +81,6 @@ subroutine inittestbed character(len = nf90_max_name) :: RecordDimName integer :: ierr,i,k,ik,nknudgep1,nknudges - character(1) :: chmess1 real tv,rho,iexner,fac namelist /NAMTESTBED/ & @@ -691,9 +690,8 @@ end subroutine inittestbed !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine testbednudge - use modglobal, only : rtimee,i1,j1,k1,kmax,rdt + use modglobal, only : timee,rtimee,i1,j1,kmax,rdt use modfields, only : up,vp,wp,thlp, qtp,u0av,v0av,qt0av,thl0av - use modmpi, only : myid implicit none integer k,t @@ -701,13 +699,13 @@ subroutine testbednudge if (.not.(ltestbed .and. ltb_nudge)) return - if (rtimee==0) return + if (timee==0) return t=1 do while(rtimee>tb_time(t)) t=t+1 end do - if (rtimee/=tb_time(1)) then + if (rtimee>tb_time(1)) then t=t-1 end if @@ -764,7 +762,7 @@ subroutine testbed_getinttime(t, dtm, dtp) do while(rtimee>tb_time(t)) t=t+1 end do - if (rtimee/=tb_time(1)) then + if (rtimee>tb_time(1)) then t=t-1 end if diff --git a/src/modtimedep.f90 b/src/modtimedep.f90 index c75e3961..694de711 100644 --- a/src/modtimedep.f90 +++ b/src/modtimedep.f90 @@ -349,13 +349,13 @@ subroutine timedep end subroutine timedep subroutine timedepz - use modfields, only : ug, vg, wfls,whls,thlprof,qtprof, & + use modfields, only : ug, vg, wfls,whls, & dqtdtls,dqtdxls,dqtdyls, & dthldtls,dthldxls,dthldyls,thlpcar, & dudtls,dudxls,dudyls, & dvdtls,dvdxls,dvdyls, & - dpdxl,dpdyl, & - u0,v0,w0,u0av,v0av,e120,rhobf + dpdxl,dpdyl + use modglobal, only : rtimee,om23_gs,dzf,dzh,k1,kmax,llsadv use modtestbed, only : ltestbed use modmpi, only : myid @@ -372,7 +372,7 @@ subroutine timedepz do while(rtimee>timels(t)) t=t+1 end do - if (rtimee/=timels(1)) then + if (rtimee>timels(1)) then t=t-1 end if @@ -432,7 +432,7 @@ subroutine timedepsurf do while(rtimee>timeflux(t)) t=t+1 end do - if (rtimee/=timeflux(t)) then + if (rtimee>timeflux(t)) then t=t-1 endif diff --git a/src/modtimedepsv.f90 b/src/modtimedepsv.f90 index c0b3ef3d..91b5a401 100644 --- a/src/modtimedepsv.f90 +++ b/src/modtimedepsv.f90 @@ -196,7 +196,7 @@ subroutine timedepsvsurf do while(rtimee>timesvsurf(t)) t=t+1 end do - if (rtimee/=timesvsurf(t)) then + if (rtimee>timesvsurf(t)) then t=t-1 end if diff --git a/src/modtimestat.f90 b/src/modtimestat.f90 index d6db35e4..75e4e6a6 100644 --- a/src/modtimestat.f90 +++ b/src/modtimestat.f90 @@ -336,7 +336,7 @@ end subroutine inittimestat !>Run timestat. Calculate and write the statistics subroutine timestat - use modglobal, only : i1,j1,kmax,zf,dzf,cu,cv,rv,rd,& + use modglobal, only : i1,j1,kmax,zf,dzf,cu,cv,rv,rd,eps1,& ijtot,timee,rtimee,dt_lim,rk3step,cexpnr,ifoutput ! use modfields, only : um,vm,wm,e12m,ql0,u0av,v0av,rhof,u0,v0,w0 @@ -818,13 +818,13 @@ subroutine timestat if (lnetcdf) then vars( 1) = rtimee vars( 2) = cc - if (vars(2)==0) vars(2) = nc_fillvalue + if (vars(2) Date: Wed, 13 Jul 2016 16:54:32 +0200 Subject: [PATCH 21/88] Renamed (outdated) files in addon folder with version in main src folder Updated tags file accordingly --- src/addon/{modbudget.f90 => modbudget.old} | 0 .../{modbulkmicro.f90 => modbulkmicro.old} | 0 ...bulkmicrostat.f90 => modbulkmicrostat.old} | 0 .../{modchecksim.f90 => modchecksim.old} | 0 src/addon/{modchem.f90 => modchem.old} | 0 .../{modcloudfield.f90 => modcloudfield.old} | 0 ...odcrosssection.f90 => modcrosssection.old} | 0 .../{modfielddump.f90 => modfielddump.old} | 0 src/addon/{modgenstat.f90 => modgenstat.old} | 0 ...{modheterostats.f90 => modheterostats.old} | 0 ...odmicrophysics.f90 => modmicrophysics.old} | 0 src/addon/{modnudge.f90 => modnudge.old} | 0 .../{modprojection.f90 => modprojection.old} | 0 src/addon/{modradstat.f90 => modradstat.old} | 0 .../{modsampling.f90 => modsampling.old} | 0 src/addon/{modstat_nc.f90 => modstat_nc.old} | 0 .../{modstattend.f90 => modstattend.old} | 0 .../{modtimestat.f90 => modtimestat.old} | 0 tags | 939 +++--------------- 19 files changed, 125 insertions(+), 814 deletions(-) rename src/addon/{modbudget.f90 => modbudget.old} (100%) rename src/addon/{modbulkmicro.f90 => modbulkmicro.old} (100%) rename src/addon/{modbulkmicrostat.f90 => modbulkmicrostat.old} (100%) rename src/addon/{modchecksim.f90 => modchecksim.old} (100%) rename src/addon/{modchem.f90 => modchem.old} (100%) rename src/addon/{modcloudfield.f90 => modcloudfield.old} (100%) rename src/addon/{modcrosssection.f90 => modcrosssection.old} (100%) rename src/addon/{modfielddump.f90 => modfielddump.old} (100%) rename src/addon/{modgenstat.f90 => modgenstat.old} (100%) rename src/addon/{modheterostats.f90 => modheterostats.old} (100%) rename src/addon/{modmicrophysics.f90 => modmicrophysics.old} (100%) rename src/addon/{modnudge.f90 => modnudge.old} (100%) rename src/addon/{modprojection.f90 => modprojection.old} (100%) rename src/addon/{modradstat.f90 => modradstat.old} (100%) rename src/addon/{modsampling.f90 => modsampling.old} (100%) rename src/addon/{modstat_nc.f90 => modstat_nc.old} (100%) rename src/addon/{modstattend.f90 => modstattend.old} (100%) rename src/addon/{modtimestat.f90 => modtimestat.old} (100%) diff --git a/src/addon/modbudget.f90 b/src/addon/modbudget.old similarity index 100% rename from src/addon/modbudget.f90 rename to src/addon/modbudget.old diff --git a/src/addon/modbulkmicro.f90 b/src/addon/modbulkmicro.old similarity index 100% rename from src/addon/modbulkmicro.f90 rename to src/addon/modbulkmicro.old diff --git a/src/addon/modbulkmicrostat.f90 b/src/addon/modbulkmicrostat.old similarity index 100% rename from src/addon/modbulkmicrostat.f90 rename to src/addon/modbulkmicrostat.old diff --git a/src/addon/modchecksim.f90 b/src/addon/modchecksim.old similarity index 100% rename from src/addon/modchecksim.f90 rename to src/addon/modchecksim.old diff --git a/src/addon/modchem.f90 b/src/addon/modchem.old similarity index 100% rename from src/addon/modchem.f90 rename to src/addon/modchem.old diff --git a/src/addon/modcloudfield.f90 b/src/addon/modcloudfield.old similarity index 100% rename from src/addon/modcloudfield.f90 rename to src/addon/modcloudfield.old diff --git a/src/addon/modcrosssection.f90 b/src/addon/modcrosssection.old similarity index 100% rename from src/addon/modcrosssection.f90 rename to src/addon/modcrosssection.old diff --git a/src/addon/modfielddump.f90 b/src/addon/modfielddump.old similarity index 100% rename from src/addon/modfielddump.f90 rename to src/addon/modfielddump.old diff --git a/src/addon/modgenstat.f90 b/src/addon/modgenstat.old similarity index 100% rename from src/addon/modgenstat.f90 rename to src/addon/modgenstat.old diff --git a/src/addon/modheterostats.f90 b/src/addon/modheterostats.old similarity index 100% rename from src/addon/modheterostats.f90 rename to src/addon/modheterostats.old diff --git a/src/addon/modmicrophysics.f90 b/src/addon/modmicrophysics.old similarity index 100% rename from src/addon/modmicrophysics.f90 rename to src/addon/modmicrophysics.old diff --git a/src/addon/modnudge.f90 b/src/addon/modnudge.old similarity index 100% rename from src/addon/modnudge.f90 rename to src/addon/modnudge.old diff --git a/src/addon/modprojection.f90 b/src/addon/modprojection.old similarity index 100% rename from src/addon/modprojection.f90 rename to src/addon/modprojection.old diff --git a/src/addon/modradstat.f90 b/src/addon/modradstat.old similarity index 100% rename from src/addon/modradstat.f90 rename to src/addon/modradstat.old diff --git a/src/addon/modsampling.f90 b/src/addon/modsampling.old similarity index 100% rename from src/addon/modsampling.f90 rename to src/addon/modsampling.old diff --git a/src/addon/modstat_nc.f90 b/src/addon/modstat_nc.old similarity index 100% rename from src/addon/modstat_nc.f90 rename to src/addon/modstat_nc.old diff --git a/src/addon/modstattend.f90 b/src/addon/modstattend.old similarity index 100% rename from src/addon/modstattend.f90 rename to src/addon/modstattend.old diff --git a/src/addon/modtimestat.f90 b/src/addon/modtimestat.old similarity index 100% rename from src/addon/modtimestat.f90 rename to src/addon/modtimestat.old diff --git a/tags b/tags index ad944f62..47467678 100644 --- a/tags +++ b/tags @@ -3,25 +3,19 @@ !_TAG_PROGRAM_AUTHOR Darren Hiebert /dhiebert@users.sourceforge.net/ !_TAG_PROGRAM_NAME Exuberant Ctags // !_TAG_PROGRAM_URL http://ctags.sourceforge.net /official site/ -!_TAG_PROGRAM_VERSION 5.7 // +!_TAG_PROGRAM_VERSION 5.8 // 1 src/modcanopy.f90 /^ 1 continue$/;" l subroutine:splint file: -100 src/addon/modchem.f90 /^100 if (myid == 0) then$/;" l subroutine:inputchem file: -100 src/addon/modchem.f90 /^100 print *, 'error in reading chem species in inputchem'$/;" l subroutine:read_chem file: 100 src/modchem.f90 /^100 if (myid == 0) then$/;" l subroutine:inputchem file: 100 src/modchem.f90 /^100 print *, 'error in reading chem species in inputchem'$/;" l subroutine:read_chem file: 1000 src/rrtmg_lw_rtrn.f90 /^ 1000 continue$/;" l subroutine:rtrn file: 1000 src/rrtmg_lw_rtrnmr.f90 /^ 1000 continue$/;" l subroutine:rtrnmr file: -120 src/addon/modchem.f90 /^120 t=tb$/;" l subroutine:twostep2 file: 120 src/modchem.f90 /^120 t=tb$/;" l subroutine:twostep2 file: -25 src/addon/modchem.f90 /^25 nstart=nstart+1$/;" l subroutine:twostep2 file: 25 src/modchem.f90 /^25 nstart=nstart+1$/;" l subroutine:twostep2 file: -300 src/addon/modchem.f90 /^300 j=j-1$/;" l subroutine:inputchem file: 300 src/modchem.f90 /^300 j=j-1$/;" l subroutine:inputchem file: 5300 src/rrtmg_lw_setcoef.f90 /^ 5300 continue$/;" l subroutine:setcoef file: 5300 src/rrtmg_sw_setcoef.f90 /^ 5300 continue$/;" l subroutine:setcoef_sw file: 5400 src/rrtmg_lw_setcoef.f90 /^ 5400 continue$/;" l subroutine:setcoef file: 5400 src/rrtmg_sw_setcoef.f90 /^ 5400 continue$/;" l subroutine:setcoef_sw file: -60 src/addon/modchem.f90 /^60 continue$/;" l subroutine:twostep2 file: 60 src/modchem.f90 /^60 continue$/;" l subroutine:twostep2 file: 600 src/modradfull.f90 /^600 format ('-----------------------------------------------------------', &$/;" l subroutine:init_ckd file: 600 src/modradfull.f90 /^600 format(\/'CLOUD_INIT WARNING: Extrapolating because data out of range', &$/;" l subroutine:interpolate file: @@ -30,36 +24,27 @@ 604 src/modradfull.f90 /^604 format ('---------------------------------------- Finished band init ')$/;" l subroutine:init_ckd file: 900 src/modglobal.f90 /^900 RETURN$/;" l function:LACZ_GAMMA file: 998 src/modradrrtmg.f90 /^998 format(i4,f8.3,f8.3,e12.4)$/;" l subroutine:readSounding file: -A src/addon/modchem.f90 /^ real A$/;" k type:RCdef A src/modchem.f90 /^ real A$/;" k type:RCdef AGScross src/modAGScross.f90 /^ subroutine AGScross$/;" s module:modAGScross AGShorz src/modAGScross.f90 /^ subroutine AGShorz$/;" s module:modAGScross Absorber src/rrlw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberN/;" v module:rrlw_ncpar -Absorber src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberN/;" v module:rrsw_ncpar +Absorber src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberN/;" v module:rrsw_ncpar AbsorberNames src/rrlw_ncpar.f90 /^ character(len = maxAbsorberNameLength), dimension(Absorber), parameter :: &$/;" v module:rrlw_ncpar AbsorberNames src/rrsw_ncpar.f90 /^ character(len = maxAbsorberNameLength), dimension(Absorber), parameter :: &$/;" v module:rrsw_ncpar Ammax298 src/modsurfdata.f90 /^ real :: Ammax298 /;" v module:modsurfdata AnField src/modsurfdata.f90 /^ real, allocatable :: AnField /;" v module:modsurfdata Anav src/modsurfdata.f90 /^ real :: Anav /;" v module:modsurfdata -Avogrado src/addon/modchem.f90 /^ real, parameter :: Avogrado /;" v module:modchem Avogrado src/modchem.f90 /^ real, parameter :: Avogrado /;" v module:modchem -B src/addon/modchem.f90 /^ real B$/;" k type:RCdef B src/modchem.f90 /^ real B$/;" k type:RCdef -BandNums src/rrsw_ncpar.f90 /^ integer(kind=im), dimension(band) :: BandNums /;" v module:rrsw_ncpar -C src/addon/modchem.f90 /^ real C$/;" k type:RCdef +BandNums src/rrsw_ncpar.f90 /^ integer(kind=im), dimension(band) :: BandNums /;" v module:rrsw_ncpar C src/modchem.f90 /^ real C$/;" k type:RCdef -CH2O src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2, H2O, NH3, H2SO4, CH2O,/;" v module:modchem -CH3O2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2, H2O, NH3, H2SO4, CH2O, CH3O2,/;" v module:modchem -CO src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO,/;" v module:modchem CO src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2, HO, CO,/;" v module:modchem -CO2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2,/;" v module:modchem CO2 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2, HO, CO, CO2,/;" v module:modchem CO2comp298 src/modsurfdata.f90 /^ real :: CO2comp298 /;" v module:modsurfdata CO2flux src/modsurfdata.f90 /^ real, allocatable :: CO2flux(/;" v module:modsurfdata CO2loc src/modsurfdata.f90 /^ integer :: CO2loc /;" v module:modsurfdata CPU_program src/modmpi.f90 /^ real :: CPU_program /;" v module:modmpi CPU_program0 src/modmpi.f90 /^ real :: CPU_program0 /;" v module:modmpi -Chem src/addon/modchem.f90 /^ type Chem$/;" t subroutine:inputchem Chem src/modchem.f90 /^ type Chem$/;" t subroutine:inputchem Cm src/modsurfdata.f90 /^ real, allocatable :: Cm /;" v module:modsurfdata Cs src/modsurfdata.f90 /^ real, allocatable :: Cs /;" v module:modsurfdata @@ -68,7 +53,6 @@ Cskin_land src/modsurfdata.f90 /^ real :: Cskin_land(/;" v module: Cskin_patch src/modsurfdata.f90 /^ real, allocatable :: Cskin_patch(/;" v module:modsurfdata Cskinav src/modsurfdata.f90 /^ real :: Cskinav /;" v module:modsurfdata Cw src/modsurfdata.f90 /^ real :: Cw /;" v module:modsurfdata -D src/addon/modchem.f90 /^ real D$/;" k type:RCdef D src/modchem.f90 /^ real D$/;" k type:RCdef D0_kk src/addon/modbulkmicrodata.f90 /^ real, parameter :: D0_kk /;" v module:modbulkmicrodata D0_kk src/modmicrodata.f90 /^ real, parameter :: D0_kk /;" v module:modmicrodata @@ -90,70 +74,50 @@ Dvcmin src/addon/modbulkmicrodata.f90 /^ ,Dvcmin /;" v module:modb Dvcmin src/modmicrodata.f90 /^ ,Dvcmin /;" v module:modmicrodata Dvr src/addon/modbulkmicrodata.f90 /^ ,Dvr /;" v module:modbulkmicrodata Dvr src/modmicrodata.f90 /^ ,Dvr /;" v module:modmicrodata -Dvrav src/addon/modbulkmicrostat.f90 /^ Dvravl/;" v module:modbulkmicrostat Dvrav src/modbulkmicrostat.f90 /^ Dvravl/;" v module:modbulkmicrostat Dvrav src/modsimpleicestat.f90 /^ Dvravl/;" v module:modsimpleicestat -Dvravl src/addon/modbulkmicrostat.f90 /^ qrmn , &$/;" v module:modbulkmicrostat Dvravl src/modbulkmicrostat.f90 /^ qrmn , &$/;" v module:modbulkmicrostat Dvravl src/modsimpleicestat.f90 /^ qrmn , &$/;" v module:modsimpleicestat Dvrmax src/addon/modbulkmicrodata.f90 /^ ,Dvrmax /;" v module:modbulkmicrodata Dvrmax src/modmicrodata.f90 /^ ,Dvrmax /;" v module:modmicrodata Dvrmin src/addon/modbulkmicrodata.f90 /^ ,Dvrmin /;" v module:modbulkmicrodata Dvrmin src/modmicrodata.f90 /^ ,Dvrmin /;" v module:modmicrodata -Dvrmn src/addon/modbulkmicrostat.f90 /^ Dvrav , &$/;" v module:modbulkmicrostat Dvrmn src/modbulkmicrostat.f90 /^ Dvrav , &$/;" v module:modbulkmicrostat Dvrmn src/modsimpleicestat.f90 /^ Dvrav , &$/;" v module:modsimpleicestat -E src/addon/modchem.f90 /^ real E$/;" k type:RCdef E src/modchem.f90 /^ real E$/;" k type:RCdef E1 src/modsurface.f90 /^ function E1(/;" f module:modsurface Eact0 src/modsurfdata.f90 /^ real :: Eact0 /;" v module:modsurfdata -F src/addon/modchem.f90 /^ real F$/;" k type:RCdef F src/modchem.f90 /^ real F$/;" k type:RCdef -FIT src/addon/modchem.f90 /^subroutine FIT(/;" s module:modchem FIT src/modchem.f90 /^subroutine FIT(/;" s module:modchem -Form src/addon/modchem.f90 /^ type,PUBLIC :: Form$/;" t module:modchem Form src/modchem.f90 /^ type,PUBLIC :: Form$/;" t module:modchem -G src/addon/modchem.f90 /^ real G$/;" k type:RCdef G src/modchem.f90 /^ real G$/;" k type:RCdef G0 src/modsurfdata.f90 /^ real, allocatable :: G0 /;" v module:modsurfdata G0_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch, H_patch, LE_patch, G0_patch,/;" v module:modtimestat G0id src/addon/modnetcdfmovie.f90 /^ integer :: Hid, LEid, G0id,/;" v module:modnetcdfmovie GPoint src/rrlw_ncpar.f90 /^ band = 16, &$/;" v module:rrlw_ncpar -GPoint src/rrsw_ncpar.f90 /^ band = 14, &$/;" v module:rrsw_ncpar +GPoint src/rrsw_ncpar.f90 /^ band = 14, &$/;" v module:rrsw_ncpar GPointSet src/rrlw_ncpar.f90 /^ GPoint = 16, &$/;" v module:rrlw_ncpar -GPointSet src/rrsw_ncpar.f90 /^ GPoint = 16, &$/;" v module:rrsw_ncpar +GPointSet src/rrsw_ncpar.f90 /^ GPoint = 16, &$/;" v module:rrsw_ncpar H src/modsurfdata.f90 /^ real, allocatable :: H /;" v module:modsurfdata -H2O src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2/;" v module:modchem H2O src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2/;" v module:modchem -H2O2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2,/;" v module:modchem H2O2 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2,/;" v module:modchem -H2SO4 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2, H2O, NH3, H2SO4,/;" v module:modchem H2SO4 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2, HO, CO, CO2, H2O, NH3, H2SO4$/;" v module:modchem -HNO3 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3,/;" v module:modchem HNO3 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3,/;" v module:modchem -HO src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2/;" v module:modchem HO src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2/;" v module:modchem -HO2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2,/;" v module:modchem HO2 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2,/;" v module:modchem H_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch, H_patch,/;" v module:modtimestat Hid src/addon/modnetcdfmovie.f90 /^ integer :: Hid,/;" v module:modnetcdfmovie -INERT src/addon/modchem.f90 /^ type (location) :: INERT,/;" v module:modchem INERT src/modchem.f90 /^ type (location) :: INERT,/;" v module:modchem -ISO src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO,/;" v module:modchem ISO src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO,/;" v module:modchem -ITER src/addon/modchem.f90 /^subroutine ITER(/;" s module:modchem ITER src/modchem.f90 /^subroutine ITER(/;" s module:modchem IWP_slice src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: LWP_slice,IWP_slice /;" v module:modraddata Ke src/modsurfdata.f90 /^ real :: Ke /;" v module:modsurfdata -Keff src/addon/modchem.f90 /^ real Keff /;" k type:RCdef Keff src/modchem.f90 /^ real Keff /;" k type:RCdef -KeySpeciesLower src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(keylower) :: KeySpeciesLower /;" v module:rrsw_ncpar -KeySpeciesNamesLower src/rrsw_ncpar.f90 /^ character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &$/;" v module:rrsw_ncpar -KeySpeciesNamesUpper src/rrsw_ncpar.f90 /^ character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &$/;" v module:rrsw_ncpar -KeySpeciesUpper src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(keyupper) :: KeySpeciesUpper /;" v module:rrsw_ncpar -Kindex src/addon/modchem.f90 /^ integer Kindex /;" k type:RCdef +KeySpeciesLower src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(keylower) :: KeySpeciesLower /;" v module:rrsw_ncpar +KeySpeciesNamesLower src/rrsw_ncpar.f90 /^ character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &$/;" v module:rrsw_ncpar +KeySpeciesNamesUpper src/rrsw_ncpar.f90 /^ character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &$/;" v module:rrsw_ncpar +KeySpeciesUpper src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(keyupper) :: KeySpeciesUpper /;" v module:rrsw_ncpar Kindex src/modchem.f90 /^ integer Kindex /;" k type:RCdef -Kreact src/addon/modchem.f90 /^ real Kreact /;" k type:RCdef Kreact src/modchem.f90 /^ real Kreact /;" k type:RCdef Kt src/addon/modbulkmicrodata.f90 /^ ,Kt /;" v module:modbulkmicrodata Kt src/modmicrodata.f90 /^ ,Kt /;" v module:modmicrodata @@ -167,7 +131,6 @@ LE src/modsurfdata.f90 /^ real, allocatable :: LE /;" v module:modsurfdata LE_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch, H_patch, LE_patch,/;" v module:modtimestat LEid src/addon/modnetcdfmovie.f90 /^ integer :: Hid, LEid,/;" v module:modnetcdfmovie LMASK src/rad_rndnmb.f90 /^ integer, parameter :: LMASK /;" v module:RandomNumbers -LOSS src/addon/modchem.f90 /^ integer PRODUCTION, LOSS$/;" v module:modchem LOSS src/modchem.f90 /^ integer PRODUCTION, LOSS$/;" v module:modchem LWP_slice src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: LWP_slice,/;" v module:modraddata LW_dn_TOA src/modfields.f90 /^ real, allocatable :: SW_up_TOA(:,:), SW_dn_TOA(:,:), LW_up_TOA(:,:), LW_dn_TOA(/;" v module:modfields @@ -178,81 +141,52 @@ LW_up_TOA src/modraddata.f90 /^ real, allocatable :: SW_up_TOA(:,:), SW_dn_TOA( LW_up_ca_TOA src/modraddata.f90 /^ real, allocatable :: SW_up_ca_TOA(:,:), SW_dn_ca_TOA(:,:), LW_up_ca_TOA(/;" v module:modraddata M src/rad_rndnmb.f90 /^ integer, parameter :: blockSize = 624, &$/;" v module:RandomNumbers MATRIX_A src/rad_rndnmb.f90 /^ M = 397, &$/;" v module:RandomNumbers -MVK src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2, H2O, NH3, H2SO4, CH2O, CH3O2, MVK$/;" v module:modchem -MW_H2O src/addon/modchem.f90 /^ real, parameter :: MW_H2O /;" v module:modchem MW_H2O src/modchem.f90 /^ real, parameter :: MW_H2O /;" v module:modchem -MW_air src/addon/modchem.f90 /^ real, parameter :: MW_air /;" v module:modchem MW_air src/modchem.f90 /^ real, parameter :: MW_air /;" v module:modchem -N2O5 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5,/;" v module:modchem N2O5 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5,/;" v module:modchem NAMAGScross src/modAGScross.f90 /^ namelist\/NAMAGScross\//;" n subroutine:initAGScross -NAMBUDGET src/addon/modbudget.f90 /^ namelist\/NAMBUDGET\//;" n subroutine:initbudget NAMBUDGET src/modbudget.f90 /^ namelist\/NAMBUDGET\//;" n subroutine:initbudget -NAMBULKMICROSTAT src/addon/modbulkmicrostat.f90 /^ namelist\/NAMBULKMICROSTAT\//;" n subroutine:initbulkmicrostat NAMBULKMICROSTAT src/modbulkmicrostat.f90 /^ namelist\/NAMBULKMICROSTAT\//;" n subroutine:initbulkmicrostat NAMCANOPY src/modcanopy.f90 /^ namelist\/NAMCANOPY\//;" n subroutine:initcanopy NAMCAPE src/modcape.f90 /^ namelist\/NAMCAPE\//;" n subroutine:initcape -NAMCHECKSIM src/addon/modchecksim.f90 /^ namelist\/NAMCHECKSIM\//;" n subroutine:initchecksim NAMCHECKSIM src/modchecksim.f90 /^ namelist\/NAMCHECKSIM\//;" n subroutine:initchecksim -NAMCHEM src/addon/modchem.f90 /^ namelist\/NAMCHEM\//;" n subroutine:initchem NAMCHEM src/modchem.f90 /^ namelist\/NAMCHEM\//;" n subroutine:initchem -NAMCLOUDFIELD src/addon/modcloudfield.f90 /^ namelist\/NAMCLOUDFIELD\//;" n subroutine:initcloudfield NAMCLOUDFIELD src/modcloudfield.f90 /^ namelist\/NAMCLOUDFIELD\//;" n subroutine:initcloudfield -NAMCROSSSECTION src/addon/modcrosssection.f90 /^ namelist\/NAMCROSSSECTION\//;" n subroutine:initcrosssection NAMCROSSSECTION src/modcrosssection.f90 /^ namelist\/NAMCROSSSECTION\//;" n subroutine:initcrosssection NAMDE src/modradiation.f90 /^ namelist\/NAMDE\//;" n subroutine:initradiation -NAMFIELDDUMP src/addon/modfielddump.f90 /^ namelist\/NAMFIELDDUMP\//;" n subroutine:initfielddump NAMFIELDDUMP src/modfielddump.f90 /^ namelist\/NAMFIELDDUMP\//;" n subroutine:initfielddump -NAMGENSTAT src/addon/modgenstat.f90 /^ namelist\/NAMGENSTAT\//;" n subroutine:initgenstat NAMGENSTAT src/modgenstat.f90 /^ namelist\/NAMGENSTAT\//;" n subroutine:initgenstat -NAMHETEROSTATS src/addon/modheterostats.f90 /^ namelist\/NAMHETEROSTATS\//;" n subroutine:initheterostats NAMHETEROSTATS src/modheterostats.f90 /^ namelist\/NAMHETEROSTATS\//;" n subroutine:initheterostats NAMLSMCROSSSECTION src/modlsmcrosssection.f90 /^ namelist\/NAMLSMCROSSSECTION\//;" n subroutine:initlsmcrosssection NAMLSMSTAT src/modlsmstat.f90 /^ namelist\/NAMLSMSTAT\//;" n subroutine:initlsmstat -NAMMICROPHYSICS src/addon/modmicrophysics.f90 /^ namelist\/NAMMICROPHYSICS\//;" n subroutine:initmicrophysics NAMMICROPHYSICS src/modmicrophysics.f90 /^ namelist\/NAMMICROPHYSICS\//;" n subroutine:initmicrophysics NAMNETCDFMOVIE src/addon/modnetcdfmovie.f90 /^ namelist\/NAMNETCDFMOVIE\//;" n subroutine:initnetcdfmovie NAMNETCDFSTATS src/addon/modnetcdfstats.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initnetcdfstats -NAMNETCDFSTATS src/addon/modstat_nc.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initstat_nc NAMNETCDFSTATS src/addon/stat_nc_dummy.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initstat_nc NAMNETCDFSTATS src/modstat_nc.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initstat_nc -NAMNUDGE src/addon/modnudge.f90 /^ namelist \/NAMNUDGE\//;" n subroutine:initnudge NAMNUDGE src/modnudge.f90 /^ namelist \/NAMNUDGE\//;" n subroutine:initnudge NAMPARTICLES src/addon/modparticles.f90 /^ namelist\/NAMPARTICLES\//;" n subroutine:initparticles NAMRADIATION src/modradiation.f90 /^ namelist\/NAMRADIATION\//;" n subroutine:initradiation -NAMRADSTAT src/addon/modradstat.f90 /^ namelist\/NAMRADSTAT\//;" n subroutine:initradstat NAMRADSTAT src/modradstat.f90 /^ namelist\/NAMRADSTAT\//;" n subroutine:initradstat -NAMSAMPLING src/addon/modsampling.f90 /^ namelist\/NAMSAMPLING\//;" n subroutine:initsampling NAMSAMPLING src/modsampling.f90 /^ namelist\/NAMSAMPLING\//;" n subroutine:initsampling NAMSIMPLEICESTAT src/modsimpleicestat.f90 /^ namelist\/NAMSIMPLEICESTAT\//;" n subroutine:initsimpleicestat -NAMSTATTEND src/addon/modstattend.f90 /^ namelist\/NAMSTATTEND\//;" n subroutine:initstattend NAMSTATTEND src/modstattend.f90 /^ namelist\/NAMSTATTEND\//;" n subroutine:initstattend NAMSTRESS src/addon/modstress.f90 /^ namelist\/NAMSTRESS\//;" n subroutine:initstressbudget NAMSUBGRID src/modsubgrid.f90 /^ namelist\/NAMSUBGRID\//;" n subroutine:subgridnamelist NAMSURFACE src/modsurface.f90 /^ namelist\/NAMSURFACE\//;" n subroutine:initsurface +NAMTESTBED src/modtestbed.f90 /^ namelist \/NAMTESTBED\//;" n subroutine:inittestbed NAMTILT src/addon/modtilt.f90 /^ namelist\/NAMTILT\//;" n subroutine:inittilt -NAMTIMESTAT src/addon/modtimestat.f90 /^ namelist\/NAMTIMESTAT\//;" n subroutine:inittimestat NAMTIMESTAT src/modtimestat.f90 /^ namelist\/NAMTIMESTAT\//;" n subroutine:inittimestat -NAMprojection src/addon/modprojection.f90 /^ namelist\/NAMprojection\//;" n subroutine:initprojection NAMprojection src/modprojection.f90 /^ namelist\/NAMprojection\//;" n subroutine:initprojection NAMquadrant src/modquadrant.f90 /^ namelist\/NAMquadrant\//;" n subroutine:initquadrant -NCCAA src/addon/modchem.f90 /^ integer,parameter :: NCCAA /;" v module:modchem NCCAA src/modchem.f90 /^ integer,parameter :: NCCAA /;" v module:modchem -NCCBA src/addon/modchem.f90 /^ integer,parameter :: NCCBA /;" v module:modchem NCCBA src/modchem.f90 /^ integer,parameter :: NCCBA /;" v module:modchem -NEWDT src/addon/modchem.f90 /^subroutine NEWDT(/;" s module:modchem NEWDT src/modchem.f90 /^subroutine NEWDT(/;" s module:modchem -NH3 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2, H2O2, HO2, HO, CO, CO2, H2O, NH3,/;" v module:modchem NH3 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, H2O2, HO2, HO, CO, CO2, H2O, NH3,/;" v module:modchem -NNSPEC src/addon/modchem.f90 /^ integer,parameter :: NNSPEC /;" v module:modchem NNSPEC src/modchem.f90 /^ integer,parameter :: NNSPEC /;" v module:modchem -NO src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2/;" v module:modchem NO src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2/;" v module:modchem -NO2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2,/;" v module:modchem NO2 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2,/;" v module:modchem -NO3 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3,/;" v module:modchem NO3 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3,/;" v module:modchem -Name_Number src/addon/modchem.f90 /^ type,PUBLIC :: Name_Number$/;" t module:modchem Name_Number src/modchem.f90 /^ type,PUBLIC :: Name_Number$/;" t module:modchem Nc src/addon/modbulkmicrodata.f90 /^ ,Nc /;" v module:modbulkmicrodata Nc src/modmicrodata.f90 /^ ,Nc /;" v module:modmicrodata @@ -260,10 +194,8 @@ Nc_0 src/addon/modbulkmicrodata.f90 /^ ,Nc_0 /;" v module:modbul Nc_0 src/modmicrodata.f90 /^ ,Nc_0 /;" v module:modmicrodata Nevap src/addon/modbulkmicrodata.f90 /^ ,Nevap /;" v module:modbulkmicrodata Nevap src/modmicrodata.f90 /^ ,Nevap /;" v module:modmicrodata -Npav src/addon/modbulkmicrostat.f90 /^ real, allocatable, dimension(:,:) :: Npav /;" v module:modbulkmicrostat Npav src/modbulkmicrostat.f90 /^ real, allocatable, dimension(:,:) :: Npav /;" v module:modbulkmicrostat Npav src/modsimpleicestat.f90 /^ real, allocatable, dimension(:,:) :: Npav /;" v module:modsimpleicestat -Npmn src/addon/modbulkmicrostat.f90 /^ real, allocatable, dimension(:,:) :: Npav , &$/;" v module:modbulkmicrostat Npmn src/modbulkmicrostat.f90 /^ real, allocatable, dimension(:,:) :: Npav , &$/;" v module:modbulkmicrostat Npmn src/modsimpleicestat.f90 /^ real, allocatable, dimension(:,:) :: Npav , &$/;" v module:modsimpleicestat Nr src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,/;" v module:modbulkmicrodata @@ -272,33 +204,22 @@ Nr_spl src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: Nr_spl src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: qr_spl, Nr_spl$/;" v module:modmicrodata Nrp src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,/;" v module:modbulkmicrodata Nrp src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,/;" v module:modmicrodata -Nrrainav src/addon/modbulkmicrostat.f90 /^ Nrrainavl/;" v module:modbulkmicrostat Nrrainav src/modbulkmicrostat.f90 /^ Nrrainavl/;" v module:modbulkmicrostat Nrrainav src/modsimpleicestat.f90 /^ Nrrainavl/;" v module:modsimpleicestat -Nrrainavl src/addon/modbulkmicrostat.f90 /^ raincountmn , &$/;" v module:modbulkmicrostat Nrrainavl src/modbulkmicrostat.f90 /^ raincountmn , &$/;" v module:modbulkmicrostat Nrrainavl src/modsimpleicestat.f90 /^ raincountmn , &$/;" v module:modsimpleicestat -Nrrainmn src/addon/modbulkmicrostat.f90 /^ Nrrainav , &$/;" v module:modbulkmicrostat Nrrainmn src/modbulkmicrostat.f90 /^ Nrrainav , &$/;" v module:modbulkmicrostat Nrrainmn src/modsimpleicestat.f90 /^ Nrrainav , &$/;" v module:modsimpleicestat -O1D src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D,/;" v module:modchem -O3 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3,/;" v module:modchem O3 src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3,/;" v module:modchem -Order src/addon/modchem.f90 /^ integer Order /;" k type:Reaction Order src/modchem.f90 /^ integer Order /;" k type:Reaction PHYSICS src/modstartup.f90 /^ namelist\/PHYSICS\//;" n subroutine:startup -PL src/addon/modchem.f90 /^ type (Form) PL(/;" k type:Name_Number PL src/modchem.f90 /^ type (Form) PL(/;" k type:Name_Number -PL_scheme src/addon/modchem.f90 /^ type (Name_Number), allocatable ::PL_scheme(/;" v module:modchem PL_scheme src/modchem.f90 /^ type (Name_Number), allocatable ::PL_scheme(/;" v module:modchem -PRODUC src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC /;" v module:modchem PRODUC src/modchem.f90 /^ type (location) :: INERT, PRODUC /;" v module:modchem -PRODUCTION src/addon/modchem.f90 /^ integer PRODUCTION,/;" v module:modchem PRODUCTION src/modchem.f90 /^ integer PRODUCTION,/;" v module:modchem -PorL src/addon/modchem.f90 /^ integer PorL /;" k type:Form PorL src/modchem.f90 /^ integer PorL /;" k type:Form Prandtl src/modsubgriddata.f90 /^ real :: Prandtl /;" v module:modsubgriddata -PressForeign src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(pforeign) :: PressForeign /;" v module:rrsw_ncpar +PressForeign src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(pforeign) :: PressForeign /;" v module:rrsw_ncpar Q10CO2 src/modsurfdata.f90 /^ real :: Q10CO2 /;" v module:modsurfdata Q10am src/modsurfdata.f90 /^ real :: Q10am /;" v module:modsurfdata Q10gm src/modsurfdata.f90 /^ real :: Q10gm /;" v module:modsurfdata @@ -307,7 +228,7 @@ Qnet_land src/modsurfdata.f90 /^ real :: Qnet_land(/;" v module:mo Qnet_patch src/modsurfdata.f90 /^ real, allocatable :: Qnet_patch(/;" v module:modsurfdata Qnet_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch,/;" v module:modtimestat Qnetav src/modsurfdata.f90 /^ real :: Qnetav /;" v module:modsurfdata -R src/addon/modchem.f90 /^ type (location) :: INERT/;" v module:modchem +Qnetavt src/modtimedep.f90 /^ real, allocatable :: Qnetavt /;" v module:modtimedep R src/modchem.f90 /^ type (location) :: INERT/;" v module:modchem R10 src/modsurfdata.f90 /^ real :: R10 /;" v module:modsurfdata RADB2 src/fftnew.f90 /^ subroutine RADB2 /;" s @@ -320,9 +241,7 @@ RADF3 src/fftnew.f90 /^ subroutine RADF3 /;" s RADF4 src/fftnew.f90 /^ subroutine RADF4 /;" s RADF5 src/fftnew.f90 /^ subroutine RADF5 /;" s RADFG src/fftnew.f90 /^ subroutine RADFG /;" s -RC src/addon/modchem.f90 /^ type (RCd/;" v module:modchem RC src/modchem.f90 /^ type (RCd/;" v module:modchem -RCdef src/addon/modchem.f90 /^ type RCdef$/;" t module:modchem RCdef src/modchem.f90 /^ type RCdef$/;" t module:modchem RFFTB src/fftnew.f90 /^ subroutine RFFTB /;" s RFFTB1 src/fftnew.f90 /^ subroutine RFFTB1 /;" s @@ -330,14 +249,10 @@ RFFTF src/fftnew.f90 /^ subroutine RFFTF /;" s RFFTF1 src/fftnew.f90 /^ subroutine RFFTF1 /;" s RFFTI src/fftnew.f90 /^ subroutine RFFTI /;" s RFFTI1 src/fftnew.f90 /^ subroutine RFFTI1 /;" s -RH src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH,/;" v module:modchem RH src/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, NO2, NO, NO3, N2O5, HNO3, RH,/;" v module:modchem -RO2 src/addon/modchem.f90 /^ type (location) :: INERT, PRODUC , O3, O1D, NO2, NO, NO3, N2O5, HNO3, RH, R, ISO, RO2,/;" v module:modchem RUN src/modstartup.f90 /^ namelist\/RUN\//;" n subroutine:startup -RadDep src/addon/modchem.f90 /^ integer RadDep /;" k type:Reaction RadDep src/modchem.f90 /^ integer RadDep /;" k type:Reaction RandomNumbers src/rad_rndnmb.f90 /^module RandomNumbers$/;" m -Reaction src/addon/modchem.f90 /^ type Reaction$/;" t subroutine:inputchem Reaction src/modchem.f90 /^ type Reaction$/;" t subroutine:inputchem RespField src/modsurfdata.f90 /^ real, allocatable :: RespField /;" v module:modsurfdata Respav src/modsurfdata.f90 /^ real :: Respav /;" v module:modsurfdata @@ -365,28 +280,27 @@ Sc_num src/addon/modbulkmicrodata.f90 /^ ,Sc_num /;" v module:modbulkmic Sc_num src/modmicrodata.f90 /^ ,Sc_num /;" v module:modmicrodata SolarConstant src/modradfull.f90 /^ real,parameter :: SolarConstant /;" v module:modradfull T src/rrlw_ncpar.f90 /^ pforeign = 4, &$/;" v module:rrlw_ncpar -T src/rrsw_ncpar.f90 /^ pforeign = 4, &$/;" v module:rrsw_ncpar +T src/rrsw_ncpar.f90 /^ pforeign = 4, &$/;" v module:rrsw_ncpar T1Am src/modsurfdata.f90 /^ real :: T1Am /;" v module:modsurfdata T1gm src/modsurfdata.f90 /^ real :: T1gm /;" v module:modsurfdata T2Am src/modsurfdata.f90 /^ real :: T2Am /;" v module:modsurfdata T2gm src/modsurfdata.f90 /^ real :: T2gm /;" v module:modsurfdata TMASKB src/rad_rndnmb.f90 /^ integer, parameter :: TMASKB=/;" v module:RandomNumbers TMASKC src/rad_rndnmb.f90 /^ integer, parameter :: TMASKB= -1658038656, & ! (0x9d2c5680UL)$/;" v module:RandomNumbers -T_abs src/addon/modchem.f90 /^ real, allocatable :: T_abs(/;" v module:modchem T_abs src/modchem.f90 /^ real, allocatable :: T_abs(/;" v module:modchem Tdiff src/rrlw_ncpar.f90 /^ keyupper = 5, &$/;" v module:rrlw_ncpar -Tdiff src/rrsw_ncpar.f90 /^ keyupper = 5, &$/;" v module:rrsw_ncpar -Temp src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(T) :: Temp /;" v module:rrsw_ncpar -TempDiffs src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tdiff) :: TempDiffs /;" v module:rrsw_ncpar -TempForeignlower src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tforeignlower) :: TempForeignlower /;" v module:rrsw_ncpar -TempForeignupper src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tforeignupper) :: TempForeignupper /;" v module:rrsw_ncpar -TempSelf src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tself) :: TempSelf /;" v module:rrsw_ncpar +Tdiff src/rrsw_ncpar.f90 /^ keyupper = 5, &$/;" v module:rrsw_ncpar +Temp src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(T) :: Temp /;" v module:rrsw_ncpar +TempDiffs src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tdiff) :: TempDiffs /;" v module:rrsw_ncpar +TempForeignlower src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tforeignlower) :: TempForeignlower /;" v module:rrsw_ncpar +TempForeignupper src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tforeignupper) :: TempForeignupper /;" v module:rrsw_ncpar +TempSelf src/rrsw_ncpar.f90 /^ real(kind=rb), dimension(Tself) :: TempSelf /;" v module:rrsw_ncpar Tforeign src/rrlw_ncpar.f90 /^ Tself = 10, &$/;" v module:rrlw_ncpar -Tforeignlower src/rrsw_ncpar.f90 /^ Tself = 10, &$/;" v module:rrsw_ncpar -Tforeignupper src/rrsw_ncpar.f90 /^ Tforeignlower = 3, &$/;" v module:rrsw_ncpar +Tforeignlower src/rrsw_ncpar.f90 /^ Tself = 10, &$/;" v module:rrsw_ncpar +Tforeignupper src/rrsw_ncpar.f90 /^ Tforeignlower = 3, &$/;" v module:rrsw_ncpar Tplanck src/rrlw_ncpar.f90 /^ T = 19, &$/;" v module:rrlw_ncpar Tself src/rrlw_ncpar.f90 /^ pupper = 47, &$/;" v module:rrlw_ncpar -Tself src/rrsw_ncpar.f90 /^ pupper = 47, &$/;" v module:rrsw_ncpar +Tself src/rrsw_ncpar.f90 /^ pupper = 47, &$/;" v module:rrsw_ncpar UMASK src/rad_rndnmb.f90 /^ integer, parameter :: LMASK = huge(M), & ! least significant r bits$/;" v module:RandomNumbers Wl src/modsurfdata.f90 /^ real, allocatable :: Wl /;" v module:modsurfdata Wl_land src/modsurfdata.f90 /^ real :: Wl_land(/;" v module:modsurfdata @@ -476,9 +390,7 @@ abso3bo src/rrsw_kg25.f90 /^ real(kind=rb) :: abso3ao(no25), abso3bo(/;" v ac src/addon/modbulkmicrodata.f90 /^ ,ac /;" v module:modbulkmicrodata ac src/modmicrodata.f90 /^ ,ac /;" v module:modmicrodata accrete src/modsimpleice.f90 /^ subroutine accrete$/;" s module:modsimpleice -accretion src/addon/modbulkmicro.f90 /^ subroutine accretion$/;" s module:modbulkmicro accretion src/modbulkmicro.f90 /^ subroutine accretion$/;" s module:modbulkmicro -active src/addon/modchem.f90 /^ logical active /;" k type:Name_Number active src/modchem.f90 /^ logical active /;" k type:Name_Number ad src/modsurfdata.f90 /^ real :: ad /;" v module:modsurfdata adjust src/modradfull.f90 /^ subroutine adjust /;" s module:modradfull @@ -526,14 +438,11 @@ asyice2 src/rrsw_cld.f90 /^ real(kind=rb) :: extice2(43,16:29), ssaice2(43, asyice3 src/rrsw_cld.f90 /^ real(kind=rb) :: extice3(46,16:29), ssaice3(46,16:29), asyice3(/;" v module:rrsw_cld asyliq1 src/rrsw_cld.f90 /^ real(kind=rb) :: extliq1(58,16:29), ssaliq1(58,16:29), asyliq1(/;" v module:rrsw_cld at src/modglobal.f90 /^ real,parameter :: at /;" v module:modglobal -atol src/addon/modchem.f90 /^ real atol$/;" k type:Name_Number -atol src/addon/modchem.f90 /^ real, allocatable :: atol(/;" v module:modchem atol src/modchem.f90 /^ real atol$/;" k type:Name_Number atol src/modchem.f90 /^ real, allocatable :: atol(/;" v module:modchem au src/addon/modbulkmicrodata.f90 /^ ,au /;" v module:modbulkmicrodata au src/modmicrodata.f90 /^ ,au /;" v module:modmicrodata author src/modglobal.f90 /^ character(80) :: author=/;" v module:modglobal -autoconversion src/addon/modbulkmicro.f90 /^ subroutine autoconversion$/;" s module:modbulkmicro autoconversion src/modbulkmicro.f90 /^ subroutine autoconversion$/;" s module:modbulkmicro autoconvert src/modsimpleice.f90 /^ subroutine autoconvert$/;" s module:modsimpleice avf src/addon/modbulkmicrodata.f90 /^ ,avf /;" v module:modbulkmicrodata @@ -544,7 +453,7 @@ b_tvsb src/addon/modbulkmicrodata.f90 /^ ,b_tvsb /;" v module:modbulkmic b_tvsb src/modmicrodata.f90 /^ ,b_tvsb /;" v module:modmicrodata band src/modradfull.f90 /^ TYPE (band_/;" v module:modradfull band src/rrlw_ncpar.f90 /^ Tplanck = 181, &$/;" v module:rrlw_ncpar -band src/rrsw_ncpar.f90 /^ T = 19, &$/;" v module:rrsw_ncpar +band src/rrsw_ncpar.f90 /^ T = 19, &$/;" v module:rrsw_ncpar band_properties src/modradfull.f90 /^ TYPE band_properties$/;" t module:modradfull barrou src/modmpi.f90 /^ subroutine barrou(/;" s module:modmpi baseprofs src/modstartup.f90 /^ subroutine baseprofs$/;" s module:modstartup @@ -558,11 +467,8 @@ betag src/modmicrodata.f90 /^ ,betag=/;" v module:modmicrodata betakessi src/modmicrodata.f90 /^ ,betakessi=/;" v module:modmicrodata betar src/modmicrodata.f90 /^ ,betar=/;" v module:modmicrodata betas src/modmicrodata.f90 /^ ,betas=/;" v module:modmicrodata -blh_nsamp src/addon/modtimestat.f90 /^ integer :: blh_nsamp /;" v module:modtimestat blh_nsamp src/modtimestat.f90 /^ integer :: blh_nsamp /;" v module:modtimestat -blh_sign src/addon/modtimestat.f90 /^ real :: blh_thres=-1 ,blh_sign=/;" v module:modtimestat blh_sign src/modtimestat.f90 /^ real :: blh_thres=-1 ,blh_sign=/;" v module:modtimestat -blh_thres src/addon/modtimestat.f90 /^ real :: blh_thres=/;" v module:modtimestat blh_thres src/modtimestat.f90 /^ real :: blh_thres=/;" v module:modtimestat bllmx src/modradfull.f90 /^ real, save :: bllmx,/;" v module:modradfull blockSize src/rad_rndnmb.f90 /^ integer, parameter :: blockSize /;" v module:RandomNumbers @@ -577,19 +483,13 @@ br src/modmicrodata.f90 /^ ,br /;" v module:modmicrodata brlmn src/modradfull.f90 /^ real, save :: bllmx, brlmn$/;" v module:modradfull bt src/modglobal.f90 /^ real,parameter :: bt /;" v module:modglobal btime src/modglobal.f90 /^ integer(kind=longint) :: btime /;" v module:modglobal -budgetstat src/addon/modbudget.f90 /^ subroutine budgetstat$/;" s module:modbudget budgetstat src/modbudget.f90 /^ subroutine budgetstat$/;" s module:modbudget -budgmn src/addon/modbudget.f90 /^ real, allocatable :: budgmn(/;" v module:modbudget budgmn src/modbudget.f90 /^ real, allocatable :: budgmn(/;" v module:modbudget bufin src/modfft2d.f90 /^ real, dimension(:), allocatable :: bufin,/;" v module:modfft2d bufout src/modfft2d.f90 /^ real, dimension(:), allocatable :: bufin, bufout$/;" v module:modfft2d -bulkmicro src/addon/modbulkmicro.f90 /^ subroutine bulkmicro$/;" s module:modbulkmicro bulkmicro src/modbulkmicro.f90 /^ subroutine bulkmicro$/;" s module:modbulkmicro -bulkmicrostat src/addon/modbulkmicrostat.f90 /^ subroutine bulkmicrostat$/;" s module:modbulkmicrostat bulkmicrostat src/modbulkmicrostat.f90 /^ subroutine bulkmicrostat$/;" s module:modbulkmicrostat -bulkmicrotend src/addon/modbulkmicrostat.f90 /^ subroutine bulkmicrotend$/;" s module:modbulkmicrostat bulkmicrotend src/modbulkmicrostat.f90 /^ subroutine bulkmicrotend$/;" s module:modbulkmicrostat -buomn src/addon/modbudget.f90 /^ real, allocatable :: buomn(/;" v module:modbudget buomn src/modbudget.f90 /^ real, allocatable :: buomn(/;" v module:modbudget bvf src/addon/modbulkmicrodata.f90 /^ ,bvf /;" v module:modbulkmicrodata bvf src/modmicrodata.f90 /^ ,bvf /;" v module:modmicrodata @@ -602,14 +502,10 @@ c_evapkk src/addon/modbulkmicrodata.f90 /^ ,c_evapkk /;" v module:modbul c_evapkk src/modmicrodata.f90 /^ ,c_evapkk /;" v module:modmicrodata c_tvsb src/addon/modbulkmicrodata.f90 /^ ,c_tvsb /;" v module:modbulkmicrodata c_tvsb src/modmicrodata.f90 /^ ,c_tvsb /;" v module:modmicrodata -calc_K src/addon/modchem.f90 /^subroutine calc_K(/;" s module:modchem calc_K src/modchem.f90 /^subroutine calc_K(/;" s module:modchem calc_halflev src/modthermodynamics.f90 /^ subroutine calc_halflev$/;" s module:modthermodynamics -calcblheight src/addon/modtimestat.f90 /^ subroutine calcblheight$/;" s module:modtimestat calcblheight src/modtimestat.f90 /^ subroutine calcblheight$/;" s module:modtimestat -calccourant src/addon/modchecksim.f90 /^ subroutine calccourant$/;" s module:modchecksim calccourant src/modchecksim.f90 /^ subroutine calccourant$/;" s module:modchecksim -calcpeclet src/addon/modchecksim.f90 /^ subroutine calcpeclet$/;" s module:modchecksim calcpeclet src/modchecksim.f90 /^ subroutine calcpeclet$/;" s module:modchecksim caldefh src/addon/modtilt.f90 /^ subroutine caldefh$/;" s module:modtilt calthv src/modthermodynamics.f90 /^ subroutine calthv$/;" s module:modthermodynamics @@ -620,7 +516,6 @@ canopyu src/modcanopy.f90 /^ subroutine canopyu /;" s module:modcanopy canopyv src/modcanopy.f90 /^ subroutine canopyv /;" s module:modcanopy canopyw src/modcanopy.f90 /^ subroutine canopyw /;" s module:modcanopy cbari src/rrsw_cld.f90 /^ real(kind=rb) :: abari(5),bbari(5),cbari(/;" v module:rrsw_cld -cc src/addon/modtimestat.f90 /^ real :: cc,/;" v module:modtimestat cc src/modtimestat.f90 /^ real :: cc,/;" v module:modtimestat cc_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field, ztop_field, cc_field,/;" v module:modtimestat cc_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cc_patch,/;" v module:modtimestat @@ -661,9 +556,7 @@ cfc22 src/modraddata.f90 /^ o3, co2, ch4, n2o, o2, cfc11, cfc12, cfc22,/;" cfc22adj src/rrlw_kg08.f90 /^ real(kind=rb) , dimension(ng8) :: cfc22adj$/;" v module:rrlw_kg08 cfc22adjo src/rrlw_kg08.f90 /^ real(kind=rb) , dimension(no8) :: cfc22adjo$/;" v module:rrlw_kg08 cfc22vmr src/modraddata.f90 /^ cfc12vmr, &$/;" v module:modraddata -cfracav src/addon/modgenstat.f90 /^ real, allocatable :: cfracav /;" v module:modgenstat cfracav src/modgenstat.f90 /^ real, allocatable :: cfracav /;" v module:modgenstat -cfracmn src/addon/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn (:), qlhmn(:),cfracmn(/;" v module:modgenstat cfracmn src/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn (:), qlhmn(:),cfracmn(/;" v module:modgenstat cgils_case_nr src/modraddata.f90 /^ integer :: cgils_case_nr$/;" v module:modraddata ch1 src/modsubgriddata.f90 /^ real :: ch1 /;" v module:modsubgriddata @@ -672,22 +565,15 @@ ch4 src/modraddata.f90 /^ o3, co2, ch4,/;" v module:modraddata ch4vmr src/modraddata.f90 /^ co2vmr, &$/;" v module:modraddata checkbound src/addon/modparticles.f90 /^ subroutine checkbound(/;" s module:modparticles checkinitvalues src/modstartup.f90 /^ subroutine checkinitvalues$/;" s module:modstartup -checksim src/addon/modchecksim.f90 /^ subroutine checksim$/;" s module:modchecksim checksim src/modchecksim.f90 /^ subroutine checksim$/;" s module:modchecksim -cheight src/addon/modcrosssection.f90 /^ character(4) :: cheight$/;" v module:modcrosssection cheight src/modcrosssection.f90 /^ character(4) :: cheight$/;" v module:modcrosssection cheight src/modlsmcrosssection.f90 /^ character(4) :: cheight$/;" v module:modlsmcrosssection -chem_nr src/addon/modchem.f90 /^ integer chem_nr$/;" k type:Chem chem_nr src/modchem.f90 /^ integer chem_nr$/;" k type:Chem -chem_number src/addon/modchem.f90 /^ integer chem_number /;" k type:Name_Number chem_number src/modchem.f90 /^ integer chem_number /;" k type:Name_Number -chemmovie src/addon/modchem.f90 /^subroutine chemmovie(/;" s module:modchem chemmovie src/modchem.f90 /^subroutine chemmovie(/;" s module:modchem chi_half src/modthermodynamics.f90 /^ real :: chi_half=/;" v module:modthermodynamics chi_mls src/rrlw_ref.f90 /^ real(kind=rb) :: chi_mls(/;" v module:rrlw_ref -chkdiv src/addon/modchecksim.f90 /^ subroutine chkdiv$/;" s module:modchecksim chkdiv src/modchecksim.f90 /^ subroutine chkdiv$/;" s module:modchecksim -choffset src/addon/modchem.f90 /^ integer choffset /;" v module:modchem choffset src/modchem.f90 /^ integer choffset /;" v module:modchem ciField src/modsurfdata.f90 /^ real, allocatable :: ciField /;" v module:modsurfdata ci_inf src/modsurfdata.f90 /^ real :: ci_inf /;" v module:modsurfdata @@ -706,16 +592,12 @@ closure src/modsubgrid.f90 /^ subroutine closure$/;" s module:modsubgrid cloudFrac src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: LWP_slice,IWP_slice ,cloudFrac,/;" v module:modraddata cloud_water src/modradfull.f90 /^ subroutine cloud_water /;" s module:modradfull cloudarea src/modfields.f90 /^ real, allocatable :: cloudarea(/;" v module:modfields -cloudcountav src/addon/modbulkmicrostat.f90 /^ cloudcountavl/;" v module:modbulkmicrostat cloudcountav src/modbulkmicrostat.f90 /^ cloudcountavl/;" v module:modbulkmicrostat cloudcountav src/modsimpleicestat.f90 /^ cloudcountavl/;" v module:modsimpleicestat -cloudcountavl src/addon/modbulkmicrostat.f90 /^ prec_prcmn , &$/;" v module:modbulkmicrostat cloudcountavl src/modbulkmicrostat.f90 /^ prec_prcmn , &$/;" v module:modbulkmicrostat cloudcountavl src/modsimpleicestat.f90 /^ prec_prcmn , &$/;" v module:modsimpleicestat -cloudcountmn src/addon/modbulkmicrostat.f90 /^ cloudcountav , &$/;" v module:modbulkmicrostat cloudcountmn src/modbulkmicrostat.f90 /^ cloudcountav , &$/;" v module:modbulkmicrostat cloudcountmn src/modsimpleicestat.f90 /^ cloudcountav , &$/;" v module:modsimpleicestat -cloudfield src/addon/modcloudfield.f90 /^ subroutine cloudfield$/;" s module:modcloudfield cloudfield src/modcloudfield.f90 /^ subroutine cloudfield$/;" s module:modcloudfield cloudnr src/modfields.f90 /^ real, allocatable :: cloudnr(/;" v module:modfields cloudnrold src/modfields.f90 /^ real, allocatable :: cloudnrold(/;" v module:modfields @@ -758,9 +640,7 @@ cnstZenith src/modraddata.f90 /^ real :: cnstZenith=/;" v module:modraddata co2 src/modraddata.f90 /^ o3, co2,/;" v module:modraddata co2factor src/modraddata.f90 /^ real :: co2factor /;" v module:modraddata co2vmr src/modraddata.f90 /^ o3vmr, &$/;" v module:modraddata -coef src/addon/modchem.f90 /^ real coef /;" k type:Form coef src/modchem.f90 /^ real coef /;" k type:Form -coeff src/addon/modchem.f90 /^ real coeff$/;" k type:Chem coeff src/modchem.f90 /^ real coeff$/;" k type:Chem coefft src/modradfull.f90 /^ subroutine coefft(/;" s module:modradfull coefft0 src/modradfull.f90 /^ subroutine coefft0(/;" s module:modradfull @@ -768,18 +648,13 @@ combineOpticalProperties src/modradfull.f90 /^ subroutine combineOpticalPropert comm3d src/modmpi.f90 /^ integer :: comm3d,/;" v module:modmpi commcol src/modmpi.f90 /^ integer :: comm3d, commrow, commcol$/;" v module:modmpi commrow src/modmpi.f90 /^ integer :: comm3d, commrow,/;" v module:modmpi -comp1 src/addon/modchem.f90 /^ integer comp1 /;" k type:Form comp1 src/modchem.f90 /^ integer comp1 /;" k type:Form -comp2 src/addon/modchem.f90 /^ integer comp2 /;" k type:Form comp2 src/modchem.f90 /^ integer comp2 /;" k type:Form -comp3 src/addon/modchem.f90 /^ integer comp3 /;" k type:Form comp3 src/modchem.f90 /^ integer comp3 /;" k type:Form -comp4 src/addon/modchem.f90 /^ integer comp4 /;" k type:Form comp4 src/modchem.f90 /^ integer comp4 /;" k type:Form computeIRBandWeights src/modradfull.f90 /^ subroutine computeIRBandWeights(/;" s module:modradfull computeRe_Liquid src/modradrrtmg.f90 /^ elemental real function computeRe_Liquid(/;" f module:modradrrtmg computeSolarBandWeights src/modradfull.f90 /^ subroutine computeSolarBandWeights(/;" s module:modradfull -convppb src/addon/modchem.f90 /^ real, allocatable :: T_abs(:,:),convppb(/;" v module:modchem convppb src/modchem.f90 /^ real, allocatable :: T_abs(:,:),convppb(/;" v module:modchem copy_band_properties src/modradfull.f90 /^ function copy_band_properties(/;" f module:modradfull coriolis src/modforces.f90 /^ subroutine coriolis$/;" s module:modforces @@ -789,25 +664,18 @@ cp src/modglobal.f90 /^ real,parameter :: cp /;" v module:modglobal cpdair src/rrlw_ncpar.f90 /^ real(kind=rb), parameter :: cpdair /;" v module:rrlw_ncpar cpdair src/rrsw_ncpar.f90 /^ real(kind=rb), parameter :: cpdair /;" v module:rrsw_ncpar cpr src/modglobal.f90 /^ real,parameter :: cpr /;" v module:modglobal -cross src/addon/modcrosssection.f90 /^ integer :: cross$/;" v module:modcrosssection cross src/modcrosssection.f90 /^ integer :: cross$/;" v module:modcrosssection -crossheight src/addon/modcrosssection.f90 /^ integer :: crossheight(/;" v module:modcrosssection crossheight src/modcrosssection.f90 /^ integer :: crossheight(/;" v module:modcrosssection crossheight src/modlsmcrosssection.f90 /^ integer :: crossheight$/;" v module:modlsmcrosssection -crossortho src/addon/modcrosssection.f90 /^ integer :: crossortho /;" v module:modcrosssection crossortho src/modcrosssection.f90 /^ integer :: crossortho /;" v module:modcrosssection -crossplane src/addon/modcrosssection.f90 /^ integer :: crossplane /;" v module:modcrosssection crossplane src/modcrosssection.f90 /^ integer :: crossplane /;" v module:modcrosssection crossplane src/modlsmcrosssection.f90 /^ integer :: crossplane /;" v module:modlsmcrosssection -crosssection src/addon/modcrosssection.f90 /^ subroutine crosssection$/;" s module:modcrosssection crosssection src/modcrosssection.f90 /^ subroutine crosssection$/;" s module:modcrosssection cs src/modsubgriddata.f90 /^ real :: cs /;" v module:modsubgriddata csed src/addon/modbulkmicrodata.f90 /^ real :: csed /;" v module:modbulkmicrodata csed src/modmicrodata.f90 /^ real :: csed /;" v module:modmicrodata csz src/modsubgriddata.f90 /^ real, allocatable :: csz(/;" v module:modsubgriddata -cszav src/addon/modgenstat.f90 /^ real, allocatable :: cszav(/;" v module:modgenstat cszav src/modgenstat.f90 /^ real, allocatable :: cszav(/;" v module:modgenstat -cszmn src/addon/modgenstat.f90 /^ real, allocatable :: cszmn(/;" v module:modgenstat cszmn src/modgenstat.f90 /^ real, allocatable :: cszmn(/;" v module:modgenstat cu src/modglobal.f90 /^ real :: cu /;" v module:modglobal currentElement src/rad_rndnmb.f90 /^ integer :: currentElement /;" k type:randomNumberSequence @@ -822,12 +690,12 @@ cyclicx src/addon/modstress.f90 /^ subroutine cyclicx(/;" s module:modstress d4stream src/modradfull.f90 /^ subroutine d4stream(/;" s module:modradfull d4stream_initialized src/modradfull.f90 /^ logical, save :: d4stream_initialized /;" v module:modradfull d4stream_setup src/modradfull.f90 /^ subroutine d4stream_setup(/;" s module:modradfull +d4stream_tb_setup src/modradfull.f90 /^ subroutine d4stream_tb_setup(/;" s module:modradfull dbari src/rrsw_cld.f90 /^ real(kind=rb) :: abari(5),bbari(5),cbari(5),dbari(/;" v module:rrsw_cld ddg src/modmicrodata.f90 /^ ,ddg=/;" v module:modmicrodata ddr src/modmicrodata.f90 /^ ,ddr=/;" v module:modmicrodata dds src/modmicrodata.f90 /^ ,dds=/;" v module:modmicrodata default_conc src/modradfull.f90 /^ real :: mweight, default_conc,/;" k type:ckd_properties -define_nc src/addon/modstat_nc.f90 /^ subroutine define_nc(/;" s module:modstat_nc define_nc src/addon/stat_nc_dummy.f90 /^ subroutine define_nc(/;" s module:modstat_nc define_nc src/modstat_nc.f90 /^ subroutine define_nc(/;" s module:modstat_nc delt src/addon/modbulkmicrodata.f90 /^ real :: delt$/;" v module:modbulkmicrodata @@ -843,7 +711,6 @@ diffe src/modsubgrid.f90 /^ subroutine diffe(/;" s module:modsubgrid diffu src/modsubgrid.f90 /^ subroutine diffu /;" s module:modsubgrid diffv src/modsubgrid.f90 /^ subroutine diffv /;" s module:modsubgrid diffw src/modsubgrid.f90 /^ subroutine diffw(/;" s module:modsubgrid -dissmn src/addon/modbudget.f90 /^ real, allocatable :: dissmn(/;" v module:modbudget dissmn src/modbudget.f90 /^ real, allocatable :: dissmn(/;" v module:modbudget distbuoy src/modfields.f90 /^ real, allocatable :: distbuoy(/;" v module:modfields distcld src/modfields.f90 /^ real, allocatable :: distcld(/;" v module:modfields @@ -854,34 +721,26 @@ distqr src/modfields.f90 /^ real, allocatable :: distqr(/;" v module:modfields distw src/modfields.f90 /^ real, allocatable :: distw(/;" v module:modfields dlwbot src/modraddata.f90 /^ real :: dlwbot /;" v module:modraddata dlwtop src/modraddata.f90 /^ real :: dlwtop /;" v module:modraddata -do_genbudget src/addon/modbudget.f90 /^ subroutine do_genbudget$/;" s module:modbudget do_genbudget src/modbudget.f90 /^ subroutine do_genbudget$/;" s module:modbudget -do_gensbbudget src/addon/modbudget.f90 /^ subroutine do_gensbbudget$/;" s module:modbudget do_gensbbudget src/modbudget.f90 /^ subroutine do_gensbbudget$/;" s module:modbudget -do_genstat src/addon/modgenstat.f90 /^ subroutine do_genstat$/;" s module:modgenstat do_genstat src/modgenstat.f90 /^ subroutine do_genstat$/;" s module:modgenstat -do_heterostats src/addon/modheterostats.f90 /^ subroutine do_heterostats$/;" s module:modheterostats do_heterostats src/modheterostats.f90 /^ subroutine do_heterostats$/;" s module:modheterostats do_lsm src/modsurface.f90 /^ subroutine do_lsm$/;" s module:modsurface do_lsmstat src/modlsmstat.f90 /^ subroutine do_lsmstat$/;" s module:modlsmstat do_netcdfmovie src/addon/modnetcdfmovie.f90 /^ subroutine do_netcdfmovie$/;" s module:modnetcdfmovie do_netcdfstats src/addon/modnetcdfstats.f90 /^ subroutine do_netcdfstats$/;" s module:modnetcdfstats -do_radstat src/addon/modradstat.f90 /^ subroutine do_radstat$/;" s module:modradstat do_radstat src/modradstat.f90 /^ subroutine do_radstat$/;" s module:modradstat do_stressbudget src/addon/modstress.f90 /^ subroutine do_stressbudget$/;" s module:modstress do_tiltstat src/addon/modtilt.f90 /^ subroutine do_tiltstat$/;" s module:modtilt -dobulkmicrostat src/addon/modbulkmicrostat.f90 /^ subroutine dobulkmicrostat$/;" s module:modbulkmicrostat dobulkmicrostat src/modbulkmicrostat.f90 /^ subroutine dobulkmicrostat$/;" s module:modbulkmicrostat docape src/modcape.f90 /^ subroutine docape$/;" s module:modcape doperpetual src/modraddata.f90 /^ logical :: doperpetual /;" v module:modraddata doquadrant src/modquadrant.f90 /^ subroutine doquadrant$/;" s module:modquadrant -dosampling src/addon/modsampling.f90 /^ subroutine dosampling$/;" s module:modsampling dosampling src/modsampling.f90 /^ subroutine dosampling$/;" s module:modsampling doseasons src/modraddata.f90 /^ logical :: doseasons /;" v module:modraddata dosimpleicestat src/modsimpleicestat.f90 /^ subroutine dosimpleicestat$/;" s module:modsimpleicestat dpdxl src/modfields.f90 /^ real, allocatable :: dpdxl(/;" v module:modfields dpdyl src/modfields.f90 /^ real, allocatable :: dpdyl(/;" v module:modfields -dpdzhavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,pavl,dwdthavl,dwwdzhavl,dpdzhavl,/;" v module:modsampling dpdzhavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,pfavl,dwdthavl,dwwdzhavl,dpdzhavl,/;" v module:modsampling dqt src/modglobal.f90 /^ real :: dqt /;" v module:modglobal dqtdtls src/modfields.f90 /^ real, allocatable :: dqtdtls(/;" v module:modfields @@ -893,7 +752,6 @@ dqtdylst src/modtimedep.f90 /^ real, allocatable :: dqtdylst(/;" v module:m dqtdz src/modsurfdata.f90 /^ real, allocatable :: dqtdz /;" v module:modsurfdata drhobdzf src/modfields.f90 /^ real, allocatable :: drhobdzf(/;" v module:modfields drhobdzh src/modfields.f90 /^ real, allocatable :: drhobdzh(/;" v module:modfields -drizzle src/addon/modmicrophysics.f90 /^ subroutine drizzle$/;" s module:modmicrophysics drizzle src/modmicrophysics.f90 /^ subroutine drizzle$/;" s module:modmicrophysics dsigma2dt_sgs src/addon/modparticles.f90 /^ real :: dsigma2dx_sgs=0, dsigma2dy_sgs=0, dsigma2dz_sgs=0, dsigma2dt_sgs=/;" v module:modparticles dsigma2dx_sgs src/addon/modparticles.f90 /^ real :: dsigma2dx_sgs=/;" v module:modparticles @@ -902,33 +760,19 @@ dsigma2dz_sgs src/addon/modparticles.f90 /^ real :: dsigma2dx_sgs=0, dsigma2dy_ dsv src/modglobal.f90 /^ real,allocatable :: dsv(/;" v module:modglobal dt src/modglobal.f90 /^ integer(kind=longint) :: dt /;" v module:modglobal dt_lim src/modglobal.f90 /^ integer(kind=longint) :: dt_lim$/;" v module:modglobal -dtaudxhavl src/addon/modsampling.f90 /^ duwdxhavl,dtaudxhavl,/;" v module:modsampling dtaudxhavl src/modsampling.f90 /^ duwdxhavl,dtaudxhavl,/;" v module:modsampling -dtaudzhavl src/addon/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,/;" v module:modsampling dtaudzhavl src/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,/;" v module:modsampling -dtav src/addon/modbudget.f90 /^ real :: dtav,/;" v module:modbudget -dtav src/addon/modbulkmicrostat.f90 /^ real :: dtav,/;" v module:modbulkmicrostat -dtav src/addon/modcloudfield.f90 /^ real :: dtav$/;" v module:modcloudfield -dtav src/addon/modcrosssection.f90 /^ real :: dtav$/;" v module:modcrosssection -dtav src/addon/modfielddump.f90 /^ real :: dtav$/;" v module:modfielddump -dtav src/addon/modgenstat.f90 /^ real :: dtav,/;" v module:modgenstat -dtav src/addon/modheterostats.f90 /^ real :: dtav$/;" v module:modheterostats dtav src/addon/modnetcdfstats.f90 /^ real :: dtav,/;" v module:modnetcdfstats dtav src/addon/modparticles.f90 /^ real :: dtav /;" v module:modparticles -dtav src/addon/modprojection.f90 /^ real :: dtav$/;" v module:modprojection -dtav src/addon/modradstat.f90 /^ real :: dtav,/;" v module:modradstat -dtav src/addon/modsampling.f90 /^ real :: dtav,/;" v module:modsampling -dtav src/addon/modstattend.f90 /^ real :: dtav,/;" v module:modstattend dtav src/addon/modstress.f90 /^ real :: dtav,/;" v module:modstress dtav src/addon/modtilt.f90 /^ real :: dtav,/;" v module:modtilt -dtav src/addon/modtimestat.f90 /^ real :: dtav$/;" v module:modtimestat dtav src/modAGScross.f90 /^ real :: dtav$/;" v module:modAGScross dtav src/modbudget.f90 /^ real :: dtav,/;" v module:modbudget dtav src/modbulkmicrostat.f90 /^ real :: dtav,/;" v module:modbulkmicrostat dtav src/modcape.f90 /^ real :: dtav$/;" v module:modcape dtav src/modcloudfield.f90 /^ real :: dtav$/;" v module:modcloudfield dtav src/modcrosssection.f90 /^ real :: dtav$/;" v module:modcrosssection -dtav src/modfielddump.f90 /^ real :: dtav$/;" v module:modfielddump +dtav src/modfielddump.f90 /^ real :: dtav,/;" v module:modfielddump dtav src/modgenstat.f90 /^ real :: dtav,/;" v module:modgenstat dtav src/modheterostats.f90 /^ real :: dtav$/;" v module:modheterostats dtav src/modlsmcrosssection.f90 /^ real :: dtav$/;" v module:modlsmcrosssection @@ -941,28 +785,29 @@ dtav src/modsimpleicestat.f90 /^ real :: dtav,/;" v module:modsimpleic dtav src/modstattend.f90 /^ real :: dtav,/;" v module:modstattend dtav src/modtimestat.f90 /^ real :: dtav$/;" v module:modtimestat dtav_glob src/modglobal.f90 /^ real :: dtav_glob /;" v module:modglobal -dtchmovie src/addon/modchem.f90 /^ real itermin,dtchmovie$/;" v module:modchem dtchmovie src/modchem.f90 /^ real itermin,dtchmovie$/;" v module:modchem dtheta src/modglobal.f90 /^ real :: dtheta /;" v module:modglobal +dthldtls src/modfields.f90 /^ real, allocatable :: dthldtls(/;" v module:modfields +dthldtlst src/modtimedep.f90 /^ real, allocatable :: dthldtlst(/;" v module:modtimedep dthldxls src/modfields.f90 /^ real, allocatable :: dthldxls(/;" v module:modfields dthldyls src/modfields.f90 /^ real, allocatable :: dthldyls(/;" v module:modfields dthldz src/modsurfdata.f90 /^ real, allocatable :: dthldz(/;" v module:modsurfdata dthvdz src/modfields.f90 /^ real, allocatable :: dthvdz(/;" v module:modfields dtmax src/modglobal.f90 /^ real :: dtmax /;" v module:modglobal -dtmn src/addon/modchecksim.f90 /^ real :: dtmn /;" v module:modchecksim dtmn src/modchecksim.f90 /^ real :: dtmn /;" v module:modchecksim dtmovie src/addon/modnetcdfmovie.f90 /^ real :: dtmovie /;" v module:modnetcdfmovie +dudtls src/modfields.f90 /^ real, allocatable :: dudtls(/;" v module:modfields +dudtlst src/modtimedep.f90 /^ real, allocatable :: dudtlst /;" v module:modtimedep dudxls src/modfields.f90 /^ real, allocatable :: dudxls(/;" v module:modfields dudyls src/modfields.f90 /^ real, allocatable :: dudyls(/;" v module:modfields dudz src/modsurfdata.f90 /^ real, allocatable :: dudz /;" v module:modsurfdata -duwdxhavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,pavl,dwdthavl,dwwdzhavl,dpdzhavl, &$/;" v module:modsampling duwdxhavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,pfavl,dwdthavl,dwwdzhavl,dpdzhavl, &$/;" v module:modsampling +dvdtls src/modfields.f90 /^ real, allocatable :: dvdtls(/;" v module:modfields +dvdtlst src/modtimedep.f90 /^ real, allocatable :: dvdtlst /;" v module:modtimedep dvdxls src/modfields.f90 /^ real, allocatable :: dvdxls(/;" v module:modfields dvdyls src/modfields.f90 /^ real, allocatable :: dvdyls(/;" v module:modfields dvdz src/modsurfdata.f90 /^ real, allocatable :: dvdz /;" v module:modsurfdata -dwdthavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,pavl,dwdthavl,/;" v module:modsampling dwdthavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,pfavl,dwdthavl,/;" v module:modsampling -dwwdzhavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,pavl,dwdthavl,dwwdzhavl,/;" v module:modsampling dwwdzhavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,pfavl,dwdthavl,dwwdzhavl,/;" v module:modsampling dx src/modglobal.f90 /^ real :: dx /;" v module:modglobal dx2i src/modglobal.f90 /^ real :: dx2i /;" v module:modglobal @@ -988,7 +833,6 @@ e12min src/modglobal.f90 /^ real,parameter :: e12min /;" v module:modglobal e12p src/modfields.f90 /^ real, allocatable :: e12p(/;" v module:modfields e12prof src/modfields.f90 /^ real, allocatable :: e12prof(/;" v module:modfields earth_sun src/rrtmg_sw_rad.f90 /^ real(kind=rb) function earth_sun(/;" f module:rrtmg_sw_rad -eavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid, qlavgid, eavgid$/;" v module:modheterostats eavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, qtavgid, eavgid$/;" v module:modnetcdfstats eavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid, qlavgid, eavgid$/;" v module:modheterostats ebari src/rrsw_cld.f90 /^ real(kind=rb) :: abari(5),bbari(5),cbari(5),dbari(5),ebari(/;" v module:rrsw_cld @@ -998,7 +842,6 @@ ee src/modradfull.f90 /^ real :: ee,/;" v module:modradfull ekh src/modsubgriddata.f90 /^ real, allocatable :: ekh(/;" v module:modsubgriddata ekm src/modsubgriddata.f90 /^ real, allocatable :: ekm(/;" v module:modsubgriddata ekmin src/modglobal.f90 /^ real,parameter :: ekmin /;" v module:modglobal -ekmmn src/addon/modbudget.f90 /^ real, allocatable :: ekmmn(/;" v module:modbudget ekmmn src/modbudget.f90 /^ real, allocatable :: ekmmn(/;" v module:modbudget ep src/modglobal.f90 /^ real,parameter :: ep /;" v module:modglobal ep2 src/modglobal.f90 /^ real,parameter :: ep2 /;" v module:modglobal @@ -1011,86 +854,67 @@ epsprec src/addon/modbulkmicrodata.f90 /^ ,epsprec /;" v mod epsprec src/modmicrodata.f90 /^ ,epsprec /;" v module:modmicrodata epsqr src/addon/modbulkmicrodata.f90 /^ ,epsqr /;" v module:modbulkmicrodata epsqr src/modmicrodata.f90 /^ ,epsqr /;" v module:modmicrodata -erfint src/addon/modbulkmicro.f90 /^ real function erfint(/;" f module:modbulkmicro erfint src/modbulkmicro.f90 /^ real function erfint(/;" f module:modbulkmicro es0 src/modglobal.f90 /^ real,parameter :: es0 /;" v module:modglobal -esatitab src/modglobal.f90 /^ real, dimension(1:2000) :: esatitab /;" v module:modglobal +esatitab src/modglobal.f90 /^ real, dimension(1:2000) :: esatitab$/;" v module:modglobal esatltab src/modglobal.f90 /^ real, dimension(1:2000) :: esatltab$/;" v module:modglobal esl src/modfields.f90 /^ real, allocatable :: esl(/;" v module:modfields evap src/addon/modbulkmicrodata.f90 /^ ,evap /;" v module:modbulkmicrodata evap src/modmicrodata.f90 /^ ,evap /;" v module:modmicrodata evapdep src/modsimpleice.f90 /^ subroutine evapdep$/;" s module:modsimpleice evapfactor src/modmicrodata.f90 /^ real :: evapfactor /;" v module:modmicrodata -evaporation src/addon/modbulkmicro.f90 /^ subroutine evaporation$/;" s module:modbulkmicro evaporation src/modbulkmicro.f90 /^ subroutine evaporation$/;" s module:modbulkmicro excj src/modmpi.f90 /^ subroutine excj(/;" s module:modmpi excjs src/modmpi.f90 /^ subroutine excjs(/;" s module:modmpi exitAGScross src/modAGScross.f90 /^ subroutine exitAGScross$/;" s module:modAGScross exitboundary src/modboundary.f90 /^ subroutine exitboundary$/;" s module:modboundary -exitbudget src/addon/modbudget.f90 /^ subroutine exitbudget$/;" s module:modbudget exitbudget src/modbudget.f90 /^ subroutine exitbudget$/;" s module:modbudget -exitbulkmicro src/addon/modbulkmicro.f90 /^ subroutine exitbulkmicro$/;" s module:modbulkmicro exitbulkmicro src/modbulkmicro.f90 /^ subroutine exitbulkmicro$/;" s module:modbulkmicro -exitbulkmicrostat src/addon/modbulkmicrostat.f90 /^ subroutine exitbulkmicrostat$/;" s module:modbulkmicrostat exitbulkmicrostat src/modbulkmicrostat.f90 /^ subroutine exitbulkmicrostat$/;" s module:modbulkmicrostat exitcanopy src/modcanopy.f90 /^ subroutine exitcanopy$/;" s module:modcanopy exitcape src/modcape.f90 /^ subroutine exitcape$/;" s module:modcape -exitcrosssection src/addon/modcrosssection.f90 /^ subroutine exitcrosssection$/;" s module:modcrosssection exitcrosssection src/modcrosssection.f90 /^ subroutine exitcrosssection$/;" s module:modcrosssection -exitfielddump src/addon/modfielddump.f90 /^ subroutine exitfielddump$/;" s module:modfielddump exitfielddump src/modfielddump.f90 /^ subroutine exitfielddump$/;" s module:modfielddump exitfields src/modfields.f90 /^ subroutine exitfields$/;" s module:modfields -exitgenstat src/addon/modgenstat.f90 /^ subroutine exitgenstat$/;" s module:modgenstat exitgenstat src/modgenstat.f90 /^ subroutine exitgenstat$/;" s module:modgenstat exitglobal src/modglobal.f90 /^ subroutine exitglobal$/;" s module:modglobal -exitheterostats src/addon/modheterostats.f90 /^ subroutine exitheterostats$/;" s module:modheterostats exitheterostats src/modheterostats.f90 /^ subroutine exitheterostats$/;" s module:modheterostats exitlsmcrosssection src/modlsmcrosssection.f90 /^ subroutine exitlsmcrosssection$/;" s module:modlsmcrosssection exitlsmstat src/modlsmstat.f90 /^ subroutine exitlsmstat$/;" s module:modlsmstat -exitmicrophysics src/addon/modmicrophysics.f90 /^ subroutine exitmicrophysics$/;" s module:modmicrophysics exitmicrophysics src/modmicrophysics.f90 /^ subroutine exitmicrophysics$/;" s module:modmicrophysics exitmodules src/modstartup.f90 /^ subroutine exitmodules$/;" s module:modstartup exitmpi src/modmpi.f90 /^ subroutine exitmpi$/;" s module:modmpi exitnetcdfmovie src/addon/modnetcdfmovie.f90 /^ subroutine exitnetcdfmovie$/;" s module:modnetcdfmovie exitnetcdfstats src/addon/modnetcdfstats.f90 /^ subroutine exitnetcdfstats$/;" s module:modnetcdfstats -exitnudge src/addon/modnudge.f90 /^ subroutine exitnudge$/;" s module:modnudge exitnudge src/modnudge.f90 /^ subroutine exitnudge$/;" s module:modnudge exitparticles src/addon/modparticles.f90 /^ subroutine exitparticles$/;" s module:modparticles exitpois src/modpois.f90 /^ subroutine exitpois$/;" s module:modpois exitquadrant src/modquadrant.f90 /^ subroutine exitquadrant$/;" s module:modquadrant exitradiation src/modradiation.f90 /^ subroutine exitradiation$/;" s module:modradiation -exitradstat src/addon/modradstat.f90 /^ subroutine exitradstat$/;" s module:modradstat exitradstat src/modradstat.f90 /^ subroutine exitradstat$/;" s module:modradstat -exitsampling src/addon/modsampling.f90 /^ subroutine exitsampling$/;" s module:modsampling exitsampling src/modsampling.f90 /^ subroutine exitsampling$/;" s module:modsampling exitsamptend src/modsamptend.f90 /^ subroutine exitsamptend$/;" s module:modsamptend exitsimpleice src/modsimpleice.f90 /^ subroutine exitsimpleice$/;" s module:modsimpleice exitsimpleicestat src/modsimpleicestat.f90 /^ subroutine exitsimpleicestat$/;" s module:modsimpleicestat -exitstat_nc src/addon/modstat_nc.f90 /^ subroutine exitstat_nc(/;" s module:modstat_nc exitstat_nc src/addon/stat_nc_dummy.f90 /^ subroutine exitstat_nc(/;" s module:modstat_nc exitstat_nc src/modstat_nc.f90 /^ subroutine exitstat_nc(/;" s module:modstat_nc -exitstattend src/addon/modstattend.f90 /^ subroutine exitstattend$/;" s module:modstattend exitstattend src/modstattend.f90 /^ subroutine exitstattend$/;" s module:modstattend exitstressbudget src/addon/modstress.f90 /^ subroutine exitstressbudget$/;" s module:modstress exitsubgrid src/modsubgrid.f90 /^ subroutine exitsubgrid$/;" s module:modsubgrid exitsurface src/modsurface.f90 /^ subroutine exitsurface$/;" s module:modsurface +exittestbed src/modtestbed.f90 /^ subroutine exittestbed$/;" s module:modtestbed exitthermodynamics src/modthermodynamics.f90 /^ subroutine exitthermodynamics$/;" s module:modthermodynamics exittilt src/addon/modtilt.f90 /^ subroutine exittilt$/;" s module:modtilt exittimedep src/modtimedep.f90 /^ subroutine exittimedep$/;" s module:modtimedep exittimedepsv src/modtimedepsv.f90 /^ subroutine exittimedepsv$/;" s module:modtimedepsv -exittimestat src/addon/modtimestat.f90 /^ subroutine exittimestat$/;" s module:modtimestat exittimestat src/modtimestat.f90 /^ subroutine exittimestat$/;" s module:modtimestat exnf src/modfields.f90 /^ real, allocatable :: exnf(/;" v module:modfields exnf_b src/modradfull.f90 /^ real, allocatable :: rhof_b(:),exnf_b(/;" v module:modradfull exnh src/modfields.f90 /^ real, allocatable :: exnh(/;" v module:modfields exnz src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: &$/;" v module:modbulkmicrodata -exp1 src/addon/modchem.f90 /^ integer exp1$/;" k type:Form exp1 src/modchem.f90 /^ integer exp1$/;" k type:Form -exp2 src/addon/modchem.f90 /^ integer exp2$/;" k type:Form exp2 src/modchem.f90 /^ integer exp2$/;" k type:Form -exp3 src/addon/modchem.f90 /^ integer exp3$/;" k type:Form exp3 src/modchem.f90 /^ integer exp3$/;" k type:Form -exp4 src/addon/modchem.f90 /^ integer exp4$/;" k type:Form exp4 src/modchem.f90 /^ integer exp4$/;" k type:Form exp_tbl src/rrlw_tbl.f90 /^ real(kind=rb) , dimension(0:ntbl) :: exp_tbl$/;" v module:rrlw_tbl exp_tbl src/rrsw_tbl.f90 /^ real(kind=rb) , dimension(0:ntbl) :: exp_tbl$/;" v module:rrsw_tbl @@ -1098,12 +922,10 @@ extice2 src/rrsw_cld.f90 /^ real(kind=rb) :: extice2(/;" v module:rrsw_cld extice3 src/rrsw_cld.f90 /^ real(kind=rb) :: extice3(/;" v module:rrsw_cld extliq1 src/rrsw_cld.f90 /^ real(kind=rb) :: extliq1(/;" v module:rrsw_cld f0 src/modsurfdata.f90 /^ real :: f0 /;" v module:modsurfdata -f_gamma src/addon/modbulkmicro.f90 /^ function f_gamma(/;" f module:modbulkmicro f_lai_h src/modcanopy.f90 /^ real :: f_lai_h /;" v module:modcanopy factorial src/modsurface.f90 /^ function factorial(/;" f module:modsurface fbari src/rrsw_cld.f90 /^ real(kind=rb) :: abari(5),bbari(5),cbari(5),dbari(5),ebari(5),fbari(/;" v module:rrsw_cld fce src/addon/modparticles.f90 /^ real :: fce$/;" v module:modparticles -fcoravl src/addon/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,thvhavl, &$/;" v module:modsampling fcorhavl src/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,thvhavl, &$/;" v module:modsampling fdir src/modradfull.f90 /^ plwc(:), piwc(:), prwc(:), pgwc(:), fds(:), fus(:), fdir(/;" v module:modradfull fdlice3 src/rrsw_cld.f90 /^ real(kind=rb) :: fdlice3(/;" v module:rrsw_cld @@ -1112,22 +934,15 @@ fft2db src/modfft2d.f90 /^ subroutine fft2db(/;" s module:modfft2d fft2dexit src/modfft2d.f90 /^ subroutine fft2dexit(/;" s module:modfft2d fft2df src/modfft2d.f90 /^ subroutine fft2df(/;" s module:modfft2d fft2dinit src/modfft2d.f90 /^ subroutine fft2dinit(/;" s module:modfft2d -fielddump src/addon/modfielddump.f90 /^ subroutine fielddump$/;" s module:modfielddump fielddump src/modfielddump.f90 /^ subroutine fielddump$/;" s module:modfielddump fillps src/modpois.f90 /^ subroutine fillps$/;" s module:modpois filter src/addon/filter.f90 /^subroutine filter(/;" s finalize_RandomNumberSequence src/rad_rndnmb.f90 /^ subroutine finalize_RandomNumberSequence(/;" s module:RandomNumbers -firstchem src/addon/modchem.f90 /^ integer tnor, firstchem,/;" v module:modchem firstchem src/modchem.f90 /^ integer tnor, firstchem,/;" v module:modchem fkar src/modglobal.f90 /^ real,parameter :: fkar /;" v module:modglobal fl src/modradfull.f90 /^ real, allocatable :: re(:), fl(/;" v module:modradfull fluxfac src/rrlw_con.f90 /^ real(kind=rb) :: fluxfac,/;" v module:rrlw_con fluxfac src/rrsw_con.f90 /^ real(kind=rb) :: fluxfac,/;" v module:rrsw_con -fname src/addon/modbulkmicrostat.f90 /^ character(80) :: fname /;" v module:modbulkmicrostat -fname src/addon/modfielddump.f90 /^ character(80) :: fname /;" v module:modfielddump -fname src/addon/modgenstat.f90 /^ character(80) :: fname /;" v module:modgenstat -fname src/addon/modstattend.f90 /^ character(80) :: fname /;" v module:modstattend -fname src/addon/modtimestat.f90 /^ character(80) :: fname /;" v module:modtimestat fname src/modcape.f90 /^ character(80) :: fname /;" v module:modcape fname src/modfielddump.f90 /^ character(80) :: fname /;" v module:modfielddump fname src/modgenstat.f90 /^ character(80) :: fname /;" v module:modgenstat @@ -1137,20 +952,16 @@ fname src/modsampling.f90 /^ character(80) :: fname /;" v module:modsampling fname src/modsamptend.f90 /^ character(80) :: fname /;" v module:modsamptend fname src/modstattend.f90 /^ character(80) :: fname /;" v module:modstattend fname src/modtimestat.f90 /^ character(80) :: fname /;" v module:modtimestat -fname1 src/addon/modcrosssection.f90 /^ character(80) :: fname1 /;" v module:modcrosssection fname1 src/modcrosssection.f90 /^ character(80) :: fname1 /;" v module:modcrosssection fname1 src/modlsmcrosssection.f90 /^ character(80) :: fname1 /;" v module:modlsmcrosssection -fname2 src/addon/modcrosssection.f90 /^ character(80) :: fname2 /;" v module:modcrosssection fname2 src/modcrosssection.f90 /^ character(80) :: fname2 /;" v module:modcrosssection fname2 src/modlsmcrosssection.f90 /^ character(80) :: fname2 /;" v module:modlsmcrosssection -fname3 src/addon/modcrosssection.f90 /^ character(80) :: fname3 /;" v module:modcrosssection fname3 src/modcrosssection.f90 /^ character(80) :: fname3 /;" v module:modcrosssection fname3 src/modlsmcrosssection.f90 /^ character(80) :: fname3 /;" v module:modlsmcrosssection fnameAGS src/modAGScross.f90 /^ character(80) :: fnameAGS /;" v module:modAGScross fname_options src/modglobal.f90 /^ character(50) :: fname_options /;" v module:modglobal force_user src/moduser.f90 /^subroutine force_user$/;" s module:moduser forces src/modforces.f90 /^ subroutine forces$/;" s module:modforces -formula src/addon/modchem.f90 /^ integer formula /;" k type:Form formula src/modchem.f90 /^ integer formula /;" k type:Form forref src/rrlw_kg01.f90 /^ real(kind=rb) :: selfref(10,ng1), forref(/;" v module:rrlw_kg01 forref src/rrlw_kg02.f90 /^ real(kind=rb) :: selfref(10,ng2), forref(/;" v module:rrlw_kg02 @@ -1267,7 +1078,6 @@ fsm src/addon/modparticles.f90 /^ real,allocatable :: fsm(/;" v module:modparti fstrField src/modsurfdata.f90 /^ real, allocatable :: fstrField /;" v module:modsurfdata fuir src/modradfull.f90 /^ plwc(:), piwc(:), prwc(:), pgwc(:), fds(:), fus(:), fdir(:), fuir(/;" v module:modradfull fuliou_Initialized src/modradfull.f90 /^ logical, save :: fuliou_Initialized /;" v module:modradfull -func1 src/addon/modchem.f90 /^ integer func1$/;" k type:RCdef func1 src/modchem.f90 /^ integer func1$/;" k type:RCdef fus src/modradfull.f90 /^ plwc(:), piwc(:), prwc(:), pgwc(:), fds(:), fus(/;" v module:modradfull gD src/modsurfdata.f90 /^ real, allocatable :: gD /;" v module:modsurfdata @@ -1307,17 +1117,15 @@ gc src/modraddata.f90 /^ real :: gc /;" v module:modraddata gc_inf src/modsurfdata.f90 /^ real :: gc_inf /;" v module:modsurfdata gc_old src/modsurfdata.f90 /^ real, allocatable :: gc_old /;" v module:modsurfdata gc_old_set src/modsurfdata.f90 /^ logical :: gc_old_set /;" v module:modsurfdata -genstat src/addon/modgenstat.f90 /^ subroutine genstat$/;" s module:modgenstat genstat src/modgenstat.f90 /^ subroutine genstat$/;" s module:modgenstat geodamptime src/modglobal.f90 /^ real :: geodamptime /;" v module:modglobal getAbsorberIndex src/rrlw_ncpar.f90 /^ subroutine getAbsorberIndex(/;" s module:rrlw_ncpar -getAbsorberIndex src/rrsw_ncpar.f90 /^ subroutine getAbsorberIndex(/;" s module:rrsw_ncpar +getAbsorberIndex src/rrsw_ncpar.f90 /^ subroutine getAbsorberIndex(/;" s module:rrsw_ncpar getRandomInt src/rad_rndnmb.f90 /^ function getRandomInt(/;" f module:RandomNumbers getRandomPositiveInt src/rad_rndnmb.f90 /^ function getRandomPositiveInt(/;" f module:RandomNumbers getRandomReal src/rad_rndnmb.f90 /^ function getRandomReal(/;" f module:RandomNumbers getindex src/modradfull.f90 /^ integer function getindex(/;" f module:modradfull getobl src/modsurface.f90 /^ subroutine getobl$/;" s module:modsurface -getth src/addon/modchem.f90 /^real function getth(/;" f module:modchem getth src/modchem.f90 /^real function getth(/;" f module:modchem gm298 src/modsurfdata.f90 /^ real :: gm298 /;" v module:modsurfdata gmin src/modsurfdata.f90 /^ real :: gmin /;" v module:modsurfdata @@ -1327,13 +1135,12 @@ grav src/rrsw_con.f90 /^ real(kind=rb) :: oneminus, pi, grav$/;" v module:r grwdamp src/modboundary.f90 /^ subroutine grwdamp$/;" s module:modboundary gz src/modradfull.f90 /^ real, allocatable :: re(:), fl(:), bz(:,:), wz(:,:), gz(/;" v module:modradfull h2ovmr src/modraddata.f90 /^ layerT, &$/;" v module:modraddata -h_ref src/addon/modchem.f90 /^ real t_ref,q_ref,p_ref,h_ref$/;" v module:modchem h_ref src/modchem.f90 /^ real t_ref,q_ref,p_ref,h_ref$/;" v module:modchem halflev_kappa src/advec_kappa.f90 /^subroutine halflev_kappa(/;" s +handle_err src/modtestbed.f90 /^ subroutine handle_err(/;" s module:modtestbed head src/addon/modparticles.f90 /^ TYPE (particle_record), POINTER:: head,/;" v module:modparticles heatfac src/rrlw_con.f90 /^ real(kind=rb) :: fluxfac, heatfac$/;" v module:rrlw_con heatfac src/rrsw_con.f90 /^ real(kind=rb) :: fluxfac, heatfac$/;" v module:rrsw_con -heterostats src/addon/modheterostats.f90 /^ subroutine heterostats$/;" s module:modheterostats heterostats src/modheterostats.f90 /^ subroutine heterostats$/;" s module:modheterostats hk src/modradfull.f90 /^ real, allocatable :: hk(/;" k type:band_properties hk src/modradfull.f90 /^ real, allocatable :: hk(/;" k type:ckd_properties @@ -1395,11 +1202,10 @@ hvrvqd src/rrsw_vsn.f90 /^ hvrspc,hvrset,hvrtau,hvrvqd,/;" v m i src/addon/modparticles.f90 /^ in/;" v module:modparticles i src/modradfull.f90 /^ in/;" v module:modradfull i src/rrlw_ncpar.f90 /^ in/;" v module:rrlw_ncpar -i src/rrsw_ncpar.f90 /^ in/;" v module:rrsw_ncpar +i src/rrsw_ncpar.f90 /^ in/;" v module:rrsw_ncpar i1 src/modglobal.f90 /^ integer :: i1$/;" v module:modglobal i2 src/modglobal.f90 /^ integer :: i2$/;" v module:modglobal iDE src/modraddata.f90 /^ integer :: iDE /;" v module:modraddata -iaccr src/addon/modbulkmicrostat.f90 /^ iauto = 2 , &$/;" v module:modbulkmicrostat iaccr src/modbulkmicrostat.f90 /^ iauto = 2 , &$/;" v module:modbulkmicrostat iaccr src/modsimpleicestat.f90 /^ iauto = 2 , &$/;" v module:modsimpleicestat iadv_52 src/modglobal.f90 /^ integer, parameter :: iadv_52 /;" v module:modglobal @@ -1415,7 +1221,6 @@ iadv_sv src/modglobal.f90 /^ integer :: iadv_mom = 5, iadv_tke = -1, iadv_t iadv_thl src/modglobal.f90 /^ integer :: iadv_mom = 5, iadv_tke = -1, iadv_thl /;" v module:modglobal iadv_tke src/modglobal.f90 /^ integer :: iadv_mom = 5, iadv_tke /;" v module:modglobal iadv_upw src/modglobal.f90 /^ integer, parameter :: iadv_upw /;" v module:modglobal -iauto src/addon/modbulkmicrostat.f90 /^ integer, parameter :: nrfields = 5 , &$/;" v module:modbulkmicrostat iauto src/modbulkmicrostat.f90 /^ integer, parameter :: nrfields = 5 , &$/;" v module:modbulkmicrostat iauto src/modsimpleicestat.f90 /^ integer, parameter :: nrfields = 5 , &$/;" v module:modsimpleicestat iband src/modradfull.f90 /^ integer :: ng, nt, np, noverlap, iband$/;" k type:ckd_properties @@ -1425,42 +1230,22 @@ ibas_st1 src/modglobal.f90 /^ integer, parameter :: ibas_st1 /;" v module:m ibas_st2 src/modglobal.f90 /^ integer, parameter :: ibas_st2 /;" v module:modglobal ibas_thv src/modglobal.f90 /^ integer, parameter :: ibas_thv /;" v module:modglobal ibas_usr src/modglobal.f90 /^ integer, parameter :: ibas_usr /;" v module:modglobal -iblh_flux src/addon/modtimestat.f90 /^ integer, parameter :: iblh_flux /;" v module:modtimestat iblh_flux src/modtimestat.f90 /^ integer, parameter :: iblh_flux /;" v module:modtimestat -iblh_grad src/addon/modtimestat.f90 /^ integer, parameter :: iblh_flux = 1, iblh_grad /;" v module:modtimestat iblh_grad src/modtimestat.f90 /^ integer, parameter :: iblh_flux = 1, iblh_grad /;" v module:modtimestat -iblh_meth src/addon/modtimestat.f90 /^ integer :: iblh_meth /;" v module:modtimestat iblh_meth src/modtimestat.f90 /^ integer :: iblh_meth /;" v module:modtimestat -iblh_qt src/addon/modtimestat.f90 /^ integer, parameter :: iblh_thv = -1,iblh_thl = -2, iblh_qt /;" v module:modtimestat iblh_qt src/modtimestat.f90 /^ integer, parameter :: iblh_thv = -1,iblh_thl = -2, iblh_qt /;" v module:modtimestat -iblh_thl src/addon/modtimestat.f90 /^ integer, parameter :: iblh_thv = -1,iblh_thl /;" v module:modtimestat iblh_thl src/modtimestat.f90 /^ integer, parameter :: iblh_thv = -1,iblh_thl /;" v module:modtimestat -iblh_thres src/addon/modtimestat.f90 /^ integer, parameter :: iblh_flux = 1, iblh_grad = 2, iblh_thres /;" v module:modtimestat iblh_thres src/modtimestat.f90 /^ integer, parameter :: iblh_flux = 1, iblh_grad = 2, iblh_thres /;" v module:modtimestat -iblh_thv src/addon/modtimestat.f90 /^ integer, parameter :: iblh_thv /;" v module:modtimestat iblh_thv src/modtimestat.f90 /^ integer, parameter :: iblh_thv /;" v module:modtimestat -iblh_var src/addon/modtimestat.f90 /^ integer :: iblh_meth = iblh_grad, iblh_var /;" v module:modtimestat iblh_var src/modtimestat.f90 /^ integer :: iblh_meth = iblh_grad, iblh_var /;" v module:modtimestat iceRe src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: LWP_slice,IWP_slice ,cloudFrac,liquidRe,iceRe$/;" v module:modraddata iceflglw src/modraddata.f90 /^ integer :: iceflglw /;" v module:modraddata iceflgsw src/modraddata.f90 /^ integer :: iceflgsw /;" v module:modraddata icethermo0 src/modthermodynamics.f90 /^ subroutine icethermo0$/;" s module:modthermodynamics icethermoh src/modthermodynamics.f90 /^ subroutine icethermoh$/;" s module:modthermodynamics -idtav src/addon/modbudget.f90 /^ integer(kind=longint) :: idtav,/;" v module:modbudget -idtav src/addon/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav,/;" v module:modbulkmicrostat -idtav src/addon/modcloudfield.f90 /^ integer(kind=longint) :: idtav,/;" v module:modcloudfield -idtav src/addon/modcrosssection.f90 /^ integer(kind=longint) :: idtav,/;" v module:modcrosssection -idtav src/addon/modfielddump.f90 /^ integer(kind=longint) :: idtav,/;" v module:modfielddump -idtav src/addon/modgenstat.f90 /^ integer(kind=longint) :: idtav,/;" v module:modgenstat -idtav src/addon/modheterostats.f90 /^ integer(kind=longint):: idtav,/;" v module:modheterostats idtav src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,idtav,/;" v module:modparticles -idtav src/addon/modprojection.f90 /^ integer(kind=longint) :: idtav,/;" v module:modprojection -idtav src/addon/modradstat.f90 /^ integer(kind=longint) :: idtav,/;" v module:modradstat -idtav src/addon/modsampling.f90 /^ integer(kind=longint) :: idtav,/;" v module:modsampling -idtav src/addon/modstattend.f90 /^ integer(kind=longint) :: idtav,/;" v module:modstattend idtav src/addon/modstress.f90 /^ integer(kind=longint) :: idtav,/;" v module:modstress idtav src/addon/modtilt.f90 /^ integer(kind=longint) :: idtav,/;" v module:modtilt -idtav src/addon/modtimestat.f90 /^ integer(kind=longint) :: idtav,/;" v module:modtimestat idtav src/modAGScross.f90 /^ integer(kind=longint) :: idtav,/;" v module:modAGScross idtav src/modbudget.f90 /^ integer(kind=longint) :: idtav,/;" v module:modbudget idtav src/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav,/;" v module:modbulkmicrostat @@ -1480,11 +1265,9 @@ idtav src/modsamptend.f90 /^ integer(kind=longint) :: idtav,/;" v module:modsam idtav src/modsimpleicestat.f90 /^ integer(kind=longint):: idtav,/;" v module:modsimpleicestat idtav src/modstattend.f90 /^ integer(kind=longint) :: idtav,/;" v module:modstattend idtav src/modtimestat.f90 /^ integer(kind=longint) :: idtav,/;" v module:modtimestat -idtchmovie src/addon/modchem.f90 /^ integer(kind=longint) :: itimeav,tnextwrite,idtchmovie$/;" v module:modchem idtchmovie src/modchem.f90 /^ integer(kind=longint) :: itimeav,tnextwrite,idtchmovie$/;" v module:modchem idtmax src/modglobal.f90 /^ integer(kind=longint) :: idtmax /;" v module:modglobal idum src/addon/modparticles.f90 /^ integer (KIND=selected_int_kind(10)):: idum /;" v module:modparticles -ievap src/addon/modbulkmicrostat.f90 /^ iaccr = 3 , &$/;" v module:modbulkmicrostat ievap src/modbulkmicrostat.f90 /^ iaccr = 3 , &$/;" v module:modbulkmicrostat ievap src/modsimpleicestat.f90 /^ iaccr = 3 , &$/;" v module:modsimpleicestat iexpnr src/modglobal.f90 /^ integer :: iexpnr /;" v module:modglobal @@ -1506,7 +1289,6 @@ imicro_user src/modmicrodata.f90 /^ integer, parameter :: imicro_user /;" v mod inatm src/rrtmg_lw_rad.f90 /^ subroutine inatm /;" s module:rrtmg_lw_rad inatm_sw src/rrtmg_sw_rad.f90 /^ subroutine inatm_sw /;" s module:rrtmg_sw_rad indCO2 src/modsurfdata.f90 /^ integer :: indCO2 /;" v module:modsurfdata -index_sv0 src/addon/modchem.f90 /^ integer index_sv0$/;" k type:Chem index_sv0 src/modchem.f90 /^ integer index_sv0$/;" k type:Chem inflglw src/modraddata.f90 /^ integer :: inflglw /;" v module:modraddata inflgsw src/modraddata.f90 /^ integer :: inflgsw /;" v module:modraddata @@ -1514,76 +1296,57 @@ initAGScross src/modAGScross.f90 /^ subroutine initAGScross$/;" s module:modAGS init_ckd src/modradfull.f90 /^ subroutine init_ckd$/;" s module:modradfull init_cldwtr src/modradfull.f90 /^ subroutine init_cldwtr$/;" s module:modradfull initboundary src/modboundary.f90 /^ subroutine initboundary$/;" s module:modboundary -initbudget src/addon/modbudget.f90 /^ subroutine initbudget$/;" s module:modbudget initbudget src/modbudget.f90 /^ subroutine initbudget$/;" s module:modbudget -initbulkmicro src/addon/modbulkmicro.f90 /^ subroutine initbulkmicro$/;" s module:modbulkmicro initbulkmicro src/modbulkmicro.f90 /^ subroutine initbulkmicro$/;" s module:modbulkmicro -initbulkmicrostat src/addon/modbulkmicrostat.f90 /^subroutine initbulkmicrostat$/;" s module:modbulkmicrostat initbulkmicrostat src/modbulkmicrostat.f90 /^subroutine initbulkmicrostat$/;" s module:modbulkmicrostat initcanopy src/modcanopy.f90 /^ SUBROUTINE initcanopy$/;" s module:modcanopy initcape src/modcape.f90 /^ subroutine initcape$/;" s module:modcape -initchecksim src/addon/modchecksim.f90 /^ subroutine initchecksim$/;" s module:modchecksim initchecksim src/modchecksim.f90 /^ subroutine initchecksim$/;" s module:modchecksim -initchem src/addon/modchem.f90 /^SUBROUTINE initchem$/;" s module:modchem initchem src/modchem.f90 /^SUBROUTINE initchem$/;" s module:modchem -initcloudfield src/addon/modcloudfield.f90 /^ subroutine initcloudfield$/;" s module:modcloudfield initcloudfield src/modcloudfield.f90 /^ subroutine initcloudfield$/;" s module:modcloudfield -initcrosssection src/addon/modcrosssection.f90 /^ subroutine initcrosssection$/;" s module:modcrosssection initcrosssection src/modcrosssection.f90 /^ subroutine initcrosssection$/;" s module:modcrosssection -initfielddump src/addon/modfielddump.f90 /^ subroutine initfielddump$/;" s module:modfielddump initfielddump src/modfielddump.f90 /^ subroutine initfielddump$/;" s module:modfielddump initfields src/modfields.f90 /^subroutine initfields$/;" s module:modfields -initgenstat src/addon/modgenstat.f90 /^ subroutine initgenstat$/;" s module:modgenstat initgenstat src/modgenstat.f90 /^ subroutine initgenstat$/;" s module:modgenstat initglobal src/modglobal.f90 /^ subroutine initglobal$/;" s module:modglobal -initheterostats src/addon/modheterostats.f90 /^ subroutine initheterostats$/;" s module:modheterostats initheterostats src/modheterostats.f90 /^ subroutine initheterostats$/;" s module:modheterostats initialize_scalar src/rad_rndnmb.f90 /^ function initialize_scalar(/;" f module:RandomNumbers initialize_vector src/rad_rndnmb.f90 /^ function initialize_vector(/;" f module:RandomNumbers initlsm src/modsurface.f90 /^ subroutine initlsm$/;" s module:modsurface initlsmcrosssection src/modlsmcrosssection.f90 /^ subroutine initlsmcrosssection$/;" s module:modlsmcrosssection initlsmstat src/modlsmstat.f90 /^ subroutine initlsmstat$/;" s module:modlsmstat -initmicrophysics src/addon/modmicrophysics.f90 /^ subroutine initmicrophysics$/;" s module:modmicrophysics initmicrophysics src/modmicrophysics.f90 /^ subroutine initmicrophysics$/;" s module:modmicrophysics initmpi src/modmpi.f90 /^ subroutine initmpi$/;" s module:modmpi initnetcdfmovie src/addon/modnetcdfmovie.f90 /^ subroutine initnetcdfmovie$/;" s module:modnetcdfmovie initnetcdfstats src/addon/modnetcdfstats.f90 /^ subroutine initnetcdfstats$/;" s module:modnetcdfstats -initnudge src/addon/modnudge.f90 /^ subroutine initnudge$/;" s module:modnudge initnudge src/modnudge.f90 /^ subroutine initnudge$/;" s module:modnudge initparticles src/addon/modparticles.f90 /^ subroutine initparticles$/;" s module:modparticles initpois src/modpois.f90 /^ subroutine initpois$/;" s module:modpois -initprojection src/addon/modprojection.f90 /^ subroutine initprojection$/;" s module:modprojection initprojection src/modprojection.f90 /^ subroutine initprojection$/;" s module:modprojection initquadrant src/modquadrant.f90 /^ subroutine initquadrant$/;" s module:modquadrant initradiation src/modradiation.f90 /^ subroutine initradiation$/;" s module:modradiation -initradstat src/addon/modradstat.f90 /^ subroutine initradstat$/;" s module:modradstat initradstat src/modradstat.f90 /^ subroutine initradstat$/;" s module:modradstat -initsampling src/addon/modsampling.f90 /^ subroutine initsampling$/;" s module:modsampling initsampling src/modsampling.f90 /^ subroutine initsampling$/;" s module:modsampling initsamptend src/modsamptend.f90 /^subroutine initsamptend$/;" s module:modsamptend initsimpleice src/modsimpleice.f90 /^ subroutine initsimpleice$/;" s module:modsimpleice initsimpleicestat src/modsimpleicestat.f90 /^subroutine initsimpleicestat$/;" s module:modsimpleicestat -initstat_nc src/addon/modstat_nc.f90 /^ subroutine initstat_nc$/;" s module:modstat_nc initstat_nc src/addon/stat_nc_dummy.f90 /^ subroutine initstat_nc$/;" s module:modstat_nc initstat_nc src/modstat_nc.f90 /^ subroutine initstat_nc$/;" s module:modstat_nc -initstattend src/addon/modstattend.f90 /^subroutine initstattend$/;" s module:modstattend initstattend src/modstattend.f90 /^subroutine initstattend$/;" s module:modstattend initstressbudget src/addon/modstress.f90 /^ subroutine initstressbudget$/;" s module:modstress initsubgrid src/modsubgrid.f90 /^ subroutine initsubgrid$/;" s module:modsubgrid initsurf_user src/moduser.f90 /^subroutine initsurf_user$/;" s module:moduser initsurface src/modsurface.f90 /^ subroutine initsurface$/;" s module:modsurface +inittestbed src/modtestbed.f90 /^ subroutine inittestbed$/;" s module:modtestbed initthermodynamics src/modthermodynamics.f90 /^ subroutine initthermodynamics$/;" s module:modthermodynamics initthla src/addon/modtilt.f90 /^ subroutine initthla$/;" s module:modtilt inittilt src/addon/modtilt.f90 /^ subroutine inittilt$/;" s module:modtilt inittimedep src/modtimedep.f90 /^ subroutine inittimedep$/;" s module:modtimedep inittimedepsv src/modtimedepsv.f90 /^ subroutine inittimedepsv$/;" s module:modtimedepsv -inittimestat src/addon/modtimestat.f90 /^ subroutine inittimestat$/;" s module:modtimestat inittimestat src/modtimestat.f90 /^ subroutine inittimestat$/;" s module:modtimestat initvar_cldwtr src/modradfull.f90 /^ subroutine initvar_cldwtr(/;" s module:modradfull inomove src/addon/modparticles.f90 /^ integer,parameter :: inomove=/;" v module:modparticles -inp src/addon/modchem.f90 /^ type (Chem) inp(/;" k type:Reaction inp src/modchem.f90 /^ type (Chem) inp(/;" k type:Reaction -inputchem src/addon/modchem.f90 /^subroutine inputchem$/;" s module:modchem inputchem src/modchem.f90 /^subroutine inputchem$/;" s module:modchem inr src/addon/modbulkmicrodata.f90 /^ integer :: inr /;" v module:modbulkmicrodata inr src/modmicrodata.f90 /^ integer :: inr /;" v module:modmicrodata @@ -1638,31 +1401,19 @@ isInitializedRrtmg src/modraddata.f90 /^ logical :: isInitializedRrtmg /;" v mo isReadSounding src/modraddata.f90 /^ logical :: isReadSounding /;" v module:modraddata isReadTraceProfiles src/modraddata.f90 /^ logical :: isReadTraceProfiles /;" v module:modraddata isSolar src/modradfull.f90 /^ elemental logical function isSolar(/;" f module:modradfull -isamp src/addon/modsampling.f90 /^ integer :: nsamples,isamp,/;" v module:modsampling isamp src/modquadrant.f90 /^ integer :: isamp$/;" v module:modquadrant isamp src/modsampling.f90 /^ integer :: nsamples,isamp,/;" v module:modsampling isamp src/modsamptend.f90 /^ integer :: nsamples,isamp,/;" v module:modsamptend -isamptot src/addon/modsampling.f90 /^ integer :: nsamples,isamp,isamptot$/;" v module:modsampling isamptot src/modquadrant.f90 /^ integer, parameter :: isamptot=/;" v module:modquadrant isamptot src/modsampling.f90 /^ integer :: nsamples,isamp,isamptot$/;" v module:modsampling isamptot src/modsamptend.f90 /^ integer :: nsamples,isamp,isamptot$/;" v module:modsamptend -ised src/addon/modbulkmicrostat.f90 /^ ievap = 4 , &$/;" v module:modbulkmicrostat ised src/modbulkmicrostat.f90 /^ ievap = 4 , &$/;" v module:modbulkmicrostat ised src/modsimpleicestat.f90 /^ ievap = 4 , &$/;" v module:modsimpleicestat isurf src/modsurfdata.f90 /^ integer :: isurf /;" v module:modsurfdata isvsmoke src/modraddata.f90 /^ integer :: isvsmoke /;" v module:modraddata -itcheck src/addon/modchecksim.f90 /^ integer(kind=longint) :: tnext = 3600.,itcheck$/;" v module:modchecksim itcheck src/modchecksim.f90 /^ integer(kind=longint) :: tnext = 3600.,itcheck$/;" v module:modchecksim -itermin src/addon/modchem.f90 /^ real itermin,/;" v module:modchem itermin src/modchem.f90 /^ real itermin,/;" v module:modchem -itimeav src/addon/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,/;" v module:modbudget -itimeav src/addon/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav, itimeav,/;" v module:modbulkmicrostat -itimeav src/addon/modchem.f90 /^ integer(kind=longint) :: itimeav,/;" v module:modchem -itimeav src/addon/modgenstat.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modgenstat itimeav src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,/;" v module:modparticles -itimeav src/addon/modradstat.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modradstat -itimeav src/addon/modsampling.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modsampling -itimeav src/addon/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modstattend itimeav src/addon/modstress.f90 /^ integer(kind=longint) :: idtav, itimeav,/;" v module:modstress itimeav src/addon/modtilt.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modtilt itimeav src/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,/;" v module:modbudget @@ -1678,6 +1429,8 @@ itimeav src/modsimpleicestat.f90 /^ integer(kind=longint):: idtav, itimeav,/;" itimeav src/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,/;" v module:modstattend itimedump src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,idtav,itimedump,/;" v module:modparticles itimerad src/modraddata.f90 /^ integer(kind=longint) :: itimerad /;" v module:modraddata +itmax src/modfielddump.f90 /^ integer(kind=longint) :: idtav,tnext,itmax,/;" v module:modfielddump +itmin src/modfielddump.f90 /^ integer(kind=longint) :: idtav,tnext,itmax,itmin$/;" v module:modfielddump itot src/modglobal.f90 /^ integer :: itot /;" v module:modglobal itrestart src/modglobal.f90 /^ integer(kind=longint) :: itrestart /;" v module:modglobal iwind src/modquadrant.f90 /^ integer :: iwind /;" v module:modquadrant @@ -1702,7 +1455,6 @@ k src/addon/modparticles.f90 /^ integer :: ipuresprev,ipvresprev,ipwresprev,ipx k src/modradfull.f90 /^ integer :: i,j,k,/;" v module:modradfull k1 src/modglobal.f90 /^ integer :: k1$/;" v module:modglobal k2 src/modglobal.f90 /^ integer :: k2$/;" v module:modglobal -k3d src/addon/modchem.f90 /^ real*4, allocatable :: k3d(/;" v module:modchem k3d src/modchem.f90 /^ real*4, allocatable :: k3d(/;" v module:modchem k_1 src/addon/modbulkmicrodata.f90 /^ ,k_1 /;" v module:modbulkmicrodata k_1 src/modmicrodata.f90 /^ ,k_1 /;" v module:modmicrodata @@ -1870,40 +1622,31 @@ kbo_mo2 src/rrlw_kg11.f90 /^ real(kind=rb) :: kbo_mo2(/;" v module:rrlw_kg1 kbo_mo3 src/rrlw_kg13.f90 /^ real(kind=rb) :: kbo_mo3(/;" v module:rrlw_kg13 kcb src/modglobal.f90 /^ integer :: kcb=/;" v module:modglobal kci src/modsurfdata.f90 /^ real :: kci /;" v module:modsurfdata -keff src/addon/modchem.f90 /^ real, allocatable :: keff(/;" v module:modchem keff src/modchem.f90 /^ real, allocatable :: keff(/;" v module:modchem -keffT src/addon/modchem.f90 /^ real, allocatable :: keffT(/;" v module:modchem keffT src/modchem.f90 /^ real, allocatable :: keffT(/;" v module:modchem -keffT3D src/addon/modchem.f90 /^ real, allocatable :: keffT3D(/;" v module:modchem -keff_index src/addon/modchem.f90 /^ integer keff_index$/;" k type:Reaction keff_index src/modchem.f90 /^ integer keff_index$/;" k type:Reaction -kefftemp src/addon/modchem.f90 /^ real, allocatable :: kefftemp(/;" v module:modchem kefftemp src/modchem.f90 /^ real, allocatable :: kefftemp(/;" v module:modchem keylower src/rrlw_ncpar.f90 /^ integer(kind=im), parameter :: keylower /;" v module:rrlw_ncpar -keylower src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: keylower /;" v module:rrsw_ncpar +keylower src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: keylower /;" v module:rrsw_ncpar keyupper src/rrlw_ncpar.f90 /^ integer(kind=im), parameter :: keylower = 9, &$/;" v module:rrlw_ncpar -keyupper src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: keylower = 9, &$/;" v module:rrsw_ncpar -kflux src/modtimedep.f90 /^ integer, parameter :: kflux /;" v module:modtimedep +keyupper src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: keylower = 9, &$/;" v module:rrsw_ncpar +kflux src/modtimedep.f90 /^ integer :: kflux$/;" v module:modtimedep kflux src/modtimedepsv.f90 /^ integer, parameter :: kflux /;" v module:modtimedepsv kg src/modradfull.f90 /^ integer :: kg,/;" k type:band_properties kg src/modradfull.f90 /^ elemental integer function kg(/;" f module:modradfull kgc src/modsurfdata.f90 /^ real :: kgc /;" v module:modsurfdata kh src/modglobal.f90 /^ integer :: kh=/;" v module:modglobal -khigh src/addon/modfielddump.f90 /^ integer :: klow,khigh$/;" v module:modfielddump -khigh src/modfielddump.f90 /^ integer :: klow,khigh$/;" v module:modfielddump +khigh src/modfielddump.f90 /^ integer :: klow,khigh,/;" v module:modfielddump khigh src/modquadrant.f90 /^ integer :: nvar, klow, khigh,/;" v module:modquadrant -khkmmn src/addon/modbudget.f90 /^ real, allocatable :: khkmmn(/;" v module:modbudget khkmmn src/modbudget.f90 /^ real, allocatable :: khkmmn(/;" v module:modbudget kind_im src/modglobal.f90 /^ integer, parameter :: kind_im /;" v module:modglobal kind_rb src/modglobal.f90 /^ integer, parameter :: kind_rb /;" v module:modglobal -klow src/addon/modfielddump.f90 /^ integer :: klow,/;" v module:modfielddump klow src/modfielddump.f90 /^ integer :: klow,/;" v module:modfielddump klow src/modquadrant.f90 /^ integer :: nvar, klow,/;" v module:modquadrant -kls src/modtimedep.f90 /^ integer, parameter :: kls /;" v module:modtimedep +kls src/modtimedep.f90 /^ integer :: kls$/;" v module:modtimedep kls src/modtimedepsv.f90 /^ integer, parameter :: kls /;" v module:modtimedepsv kmax src/modglobal.f90 /^ integer :: kmax /;" v module:modglobal knr src/modquadrant.f90 /^ integer :: nvar, klow, khigh, knr$/;" v module:modquadrant -kr src/addon/modchem.f90 /^ real kr /;" k type:Reaction kr src/modchem.f90 /^ real kr /;" k type:Reaction krad1 src/modraddata.f90 /^ integer :: kradmax, krad1,/;" v module:modraddata krad2 src/modraddata.f90 /^ integer :: kradmax, krad1, krad2 /;" v module:modraddata @@ -1911,7 +1654,6 @@ kradmax src/modraddata.f90 /^ integer :: kradmax,/;" v module:modraddata krand src/modstartup.f90 /^ integer :: krand /;" v module:modstartup krandumax src/modstartup.f90 /^ integer :: krand = huge(0), krandumin=1,krandumax=/;" v module:modstartup krandumin src/modstartup.f90 /^ integer :: krand = huge(0), krandumin=/;" v module:modstartup -kreact src/addon/modchem.f90 /^ real, allocatable :: rk1(:,:),rk2(:,:),rk(:,:),kreact(/;" v module:modchem kreact src/modchem.f90 /^ real, allocatable :: rk1(:,:),rk2(:,:),rk(:,:),kreact(/;" v module:modchem ksoilmax src/modsurfdata.f90 /^ integer, parameter :: ksoilmax /;" v module:modsurfdata ksp src/modboundary.f90 /^ integer :: ksp /;" v module:modboundary @@ -1936,7 +1678,6 @@ l_sedc src/addon/modbulkmicrodata.f90 /^ logical :: l_sb = .true. , &!< l_sedc src/modmicrodata.f90 /^ logical :: l_sb = .true. , &!< SB scheme (.true.) \/ KK00 scheme (.false.) (in namelist NAMMICROPHYSICS)$/;" v module:modmicrodata l_warm src/modmicrodata.f90 /^ logical :: l_warm /;" v module:modmicrodata ladaptive src/modglobal.f90 /^ logical :: ladaptive /;" v module:modglobal -laddinfo src/addon/modcloudfield.f90 /^ logical :: laddinfo /;" v module:modcloudfield laddinfo src/modcloudfield.f90 /^ logical :: laddinfo /;" v module:modcloudfield laero src/modraddata.f90 /^ logical :: laero /;" v module:modraddata lai src/modcanopy.f90 /^ real :: lai /;" v module:modcanopy @@ -1964,7 +1705,6 @@ lambm0 src/modraddata.f90 /^ o land_use src/modsurfdata.f90 /^ integer :: land_use(/;" v module:modsurfdata landname src/modsurfdata.f90 /^ character(len=10),dimension(max_lands) :: landname /;" v module:modsurfdata landtype src/modsurfdata.f90 /^ integer :: landtype(/;" v module:modsurfdata -lastchem src/addon/modchem.f90 /^ integer tnor, firstchem, lastchem$/;" v module:modchem lastchem src/modchem.f90 /^ integer tnor, firstchem, lastchem$/;" v module:modchem lastrk3coef src/modsamptend.f90 /^ real :: lastrk3coef$/;" v module:modsamptend layerP src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: layerP,/;" v module:modraddata @@ -1973,43 +1713,31 @@ lbdr src/addon/modbulkmicrodata.f90 /^ ,lbdr /;" v module:modbulkmicrod lbdr src/modmicrodata.f90 /^ ,lbdr /;" v module:modmicrodata lbinary src/modcrosssection.f90 /^ logical :: lbinary /;" v module:modcrosssection lbinary src/modfielddump.f90 /^ logical :: lbinary /;" v module:modfielddump -lbudget src/addon/modbudget.f90 /^ logical :: lbudget=/;" v module:modbudget lbudget src/modbudget.f90 /^ logical :: lbudget=/;" v module:modbudget lcanopy src/modcanopy.f90 /^ logical :: lcanopy /;" v module:modcanopy lcape src/modcape.f90 /^ logical :: lcape /;" v module:modcape -lchconst src/addon/modchem.f90 /^ logical lchem, ldiuvar,lchconst,/;" v module:modchem lchconst src/modchem.f90 /^ logical lchem, ldiuvar,lchconst,/;" v module:modchem -lchem src/addon/modchem.f90 /^ logical lchem,/;" v module:modchem lchem src/modchem.f90 /^ logical lchem,/;" v module:modchem -lchmovie src/addon/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,/;" v module:modchem lchmovie src/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,/;" v module:modchem -lcloudKconst src/addon/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,lcloudKconst,/;" v module:modchem lcloudKconst src/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,lcloudKconst,/;" v module:modchem -lcloudfield src/addon/modcloudfield.f90 /^ logical :: lcloudfield=/;" v module:modcloudfield lcloudfield src/modcloudfield.f90 /^ logical :: lcloudfield=/;" v module:modcloudfield lcloudshading src/modraddata.f90 /^ logical :: lcloudshading /;" v module:modraddata lcoriol src/modglobal.f90 /^ logical :: lcoriol /;" v module:modglobal -lcross src/addon/modcrosssection.f90 /^ logical :: lcross /;" v module:modcrosssection lcross src/modcrosssection.f90 /^ logical :: lcross /;" v module:modcrosssection lcross src/modlsmcrosssection.f90 /^ logical :: lcross /;" v module:modlsmcrosssection ldelta src/modsubgriddata.f90 /^ logical :: ldelta /;" v module:modsubgriddata -ldiracc src/addon/modfielddump.f90 /^ logical :: ldiracc /;" v module:modfielddump ldiracc src/modfielddump.f90 /^ logical :: ldiracc /;" v module:modfielddump -ldiuvar src/addon/modchem.f90 /^ logical lchem, ldiuvar,/;" v module:modchem ldiuvar src/modchem.f90 /^ logical lchem, ldiuvar,/;" v module:modchem ldosamptendleib src/modsamptend.f90 /^ logical :: ldosamptendleib /;" v module:modsamptend ldosamptendwrite src/modsamptend.f90 /^ logical :: ldosamptendwrite /;" v module:modsamptend ldump src/addon/modparticles.f90 /^ logical :: ldump /;" v module:modparticles leibniztend src/modsamptend.f90 /^ subroutine leibniztend$/;" s module:modsamptend leq src/modglobal.f90 /^ logical :: leq /;" v module:modglobal -lfielddump src/addon/modfielddump.f90 /^ logical :: lfielddump=/;" v module:modfielddump lfielddump src/modfielddump.f90 /^ logical :: lfielddump=/;" v module:modfielddump lforce_user src/modforces.f90 /^logical :: lforce_user /;" v module:modforces lhetero src/modsurfdata.f90 /^ logical :: lhetero /;" v module:modsurfdata -lheterostats src/addon/modheterostats.f90 /^ logical :: lheterostats /;" v module:modheterostats lheterostats src/modheterostats.f90 /^ logical :: lheterostats /;" v module:modheterostats linags src/modsurfdata.f90 /^ logical :: linags /;" v module:modsurfdata -liq_cont src/addon/modbulkmicro.f90 /^ real function liq_cont(/;" f module:modbulkmicro liq_cont src/modbulkmicro.f90 /^ real function liq_cont(/;" f module:modbulkmicro liqflglw src/modraddata.f90 /^ integer :: liqflglw /;" v module:modraddata liqflgsw src/modraddata.f90 /^ integer :: liqflgsw /;" v module:modraddata @@ -2017,8 +1745,8 @@ liquidRe src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: llimit src/modradfull.f90 /^ real :: llimit,/;" k type:band_properties llimit src/modradfull.f90 /^ elemental real function llimit(/;" f module:modradfull llsadv src/modglobal.f90 /^ logical :: llsadv /;" v module:modglobal +llstend src/modglobal.f90 /^ logical :: llstend /;" v module:modglobal lmason src/modsubgriddata.f90 /^ logical :: lmason /;" v module:modsubgriddata -lmicrostat src/addon/modbulkmicrostat.f90 /^ logical :: lmicrostat /;" v module:modbulkmicrostat lmicrostat src/modbulkmicrostat.f90 /^ logical :: lmicrostat /;" v module:modbulkmicrostat lmicrostat src/modsimpleicestat.f90 /^ logical :: lmicrostat /;" v module:modsimpleicestat lmoist src/modglobal.f90 /^ logical :: lmoist /;" v module:modglobal @@ -2026,62 +1754,47 @@ lmomsubs src/modglobal.f90 /^ logical :: lmomsubs /;" v module:modglobal lmostlocal src/modsurfdata.f90 /^ logical :: lmostlocal /;" v module:modsurfdata lmoviez src/addon/modnetcdfmovie.f90 /^ logical :: lmoviez /;" v module:modnetcdfmovie lnetcdf src/addon/modnetcdfstats.f90 /^ logical :: lnetcdf /;" v module:modnetcdfstats -lnetcdf src/addon/modstat_nc.f90 /^ logical :: lnetcdf$/;" v module:modstat_nc lnetcdf src/addon/stat_nc_dummy.f90 /^ logical :: lnetcdf$/;" v module:modstat_nc lnetcdf src/modstat_nc.f90 /^ logical :: lnetcdf /;" v module:modstat_nc lnetcdfmovie src/addon/modnetcdfmovie.f90 /^ logical :: lnetcdfmovie /;" v module:modnetcdfmovie lneutral src/modsurfdata.f90 /^ logical :: lneutral /;" v module:modsurfdata lnoclouds src/modglobal.f90 /^ logical :: lnoclouds /;" v module:modglobal -lnudge src/addon/modnudge.f90 /^ logical :: lnudge,/;" v module:modnudge lnudge src/modnudge.f90 /^ logical :: lnudge /;" v module:modnudge -loc src/addon/modchem.f90 /^ integer loc$/;" k type:location loc src/modchem.f90 /^ integer loc$/;" k type:location -location src/addon/modchem.f90 /^ type, PUBLIC :: location$/;" t module:modchem location src/modchem.f90 /^ type, PUBLIC :: location$/;" t module:modchem loldtable src/modsurfdata.f90 /^ logical :: loldtable /;" v module:modsurfdata longint src/modglobal.f90 /^ integer, parameter :: longint=/;" v module:modglobal -longsamplname src/addon/modsampling.f90 /^ character(20),dimension(10) :: samplname,longsamplname$/;" v module:modsampling longsamplname src/modquadrant.f90 /^ character(30),dimension(4) :: samplname,longsamplname$/;" v module:modquadrant longsamplname src/modsampling.f90 /^ character(20),dimension(10) :: samplname,longsamplname$/;" v module:modsampling longsamplname src/modsamptend.f90 /^ character(20),dimension(10) :: samplname,longsamplname$/;" v module:modsamptend lpaddistr src/modcanopy.f90 /^ logical :: lpaddistr /;" v module:modcanopy lpartic src/addon/modparticles.f90 /^ logical :: lpartic /;" v module:modparticles lpartsgs src/addon/modparticles.f90 /^ logical :: lpartsgs /;" v module:modparticles -lproject src/addon/modprojection.f90 /^ logical:: lproject /;" v module:modprojection +lpressgrad src/modglobal.f90 /^ logical :: lpressgrad /;" v module:modglobal lproject src/modprojection.f90 /^ logical:: lproject /;" v module:modprojection lqlnr src/modthermodynamics.f90 /^ logical :: lqlnr /;" v module:modthermodynamics -lqtnudge src/addon/modnudge.f90 /^ logical :: lnudge,lunudge,lvnudge,lwnudge,lthlnudge,lqtnudge$/;" v module:modnudge lqtnudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,lvnudge,lwnudge,lthlnudge,lqtnudge$/;" v module:modnudge lquadrant src/modquadrant.f90 /^ logical :: lquadrant /;" v module:modquadrant -lradclearair src/addon/modradstat.f90 /^ logical :: lradclearair=/;" v module:modradstat lradclearair src/modradstat.f90 /^ logical :: lradclearair=/;" v module:modradstat lrelaxci src/modsurfdata.f90 /^ logical :: lrelaxci /;" v module:modsurfdata lrelaxgc src/modsurfdata.f90 /^ logical :: lrelaxgc /;" v module:modsurfdata lrigidlid src/modglobal.f90 /^ logical :: lrigidlid /;" v module:modglobal lrsAgs src/modsurfdata.f90 /^ logical :: lrsAgs /;" v module:modsurfdata lsampall src/modsampdata.f90 /^ logical :: lsampall /;" v module:modsampdata -lsampbuup src/addon/modsampling.f90 /^ logical :: lsampbuup /;" v module:modsampling lsampbuup src/modsampdata.f90 /^ logical :: lsampbuup /;" v module:modsampdata -lsampcl src/addon/modsampling.f90 /^ logical :: lsampcl /;" v module:modsampling lsampcl src/modsampdata.f90 /^ logical :: lsampcl /;" v module:modsampdata lsampcldup src/modsampdata.f90 /^ logical :: lsampcldup /;" v module:modsampdata -lsampco src/addon/modsampling.f90 /^ logical :: lsampco /;" v module:modsampling lsampco src/modsampdata.f90 /^ logical :: lsampco /;" v module:modsampdata lsamptend src/modsampdata.f90 /^ logical :: lsamptend /;" v module:modsampdata -lsampup src/addon/modsampling.f90 /^ logical :: lsampup /;" v module:modsampling lsampup src/modsampdata.f90 /^ logical :: lsampup /;" v module:modsampdata -lsbtkeb src/addon/modbudget.f90 /^ logical :: lsbtkeb /;" v module:modbudget lsbtkeb src/modbudget.f90 /^ logical :: lsbtkeb /;" v module:modbudget -lsegr src/addon/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,lcloudKconst,lsegr$/;" v module:modchem lsegr src/modchem.f90 /^ logical lchem, ldiuvar,lchconst,lchmovie,lcloudKconst,lsegr$/;" v module:modchem lsgbucorr src/modglobal.f90 /^ logical :: lsgbucorr=/;" v module:modglobal lsmagorinsky src/modsubgriddata.f90 /^ logical :: lsmagorinsky /;" v module:modsubgriddata lsmcrosssection src/modlsmcrosssection.f90 /^ subroutine lsmcrosssection$/;" s module:modlsmcrosssection lsmoothflux src/modsurfdata.f90 /^ logical :: lsmoothflux /;" v module:modsurfdata lsmstat src/modlsmstat.f90 /^ subroutine lsmstat$/;" s module:modlsmstat -lstat src/addon/modgenstat.f90 /^ logical :: lstat=/;" v module:modgenstat lstat src/addon/modparticles.f90 /^ logical :: lstat /;" v module:modparticles -lstat src/addon/modradstat.f90 /^ logical :: lstat=/;" v module:modradstat lstat src/addon/modtilt.f90 /^ logical :: lstat /;" v module:modtilt lstat src/modgenstat.f90 /^ logical :: lstat=/;" v module:modgenstat lstat src/modlsmstat.f90 /^ logical :: lstat=/;" v module:modlsmstat @@ -2089,23 +1802,25 @@ lstat src/modradstat.f90 /^ logical :: lstat=/;" v module:modradstat lstend src/modforces.f90 /^ subroutine lstend$/;" s module:modforces lstress src/addon/modstress.f90 /^ logical :: lstress=/;" v module:modstress lstressb src/addon/modstress.f90 /^ logical :: lstressb /;" v module:modstress -ltend src/addon/modstattend.f90 /^ logical :: ltend /;" v module:modstattend +ltb_nudge src/modtestbed.f90 /^ logical :: ltestbed = .false., &$/;" v module:modtestbed +ltb_qt src/modtestbed.f90 /^ ltb_u,ltb_v,ltb_w,ltb_thl,ltb_qt$/;" v module:modtestbed +ltb_thl src/modtestbed.f90 /^ ltb_u,ltb_v,ltb_w,ltb_thl,/;" v module:modtestbed +ltb_u src/modtestbed.f90 /^ ltb_nudge = .false., &$/;" v module:modtestbed +ltb_v src/modtestbed.f90 /^ ltb_u,ltb_v,/;" v module:modtestbed +ltb_w src/modtestbed.f90 /^ ltb_u,ltb_v,ltb_w,/;" v module:modtestbed ltend src/modstattend.f90 /^ logical :: ltend /;" v module:modstattend -lthlnudge src/addon/modnudge.f90 /^ logical :: lnudge,lunudge,lvnudge,lwnudge,lthlnudge,/;" v module:modnudge +ltestbed src/modtestbed.f90 /^ logical :: ltestbed /;" v module:modtestbed lthlnudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,lvnudge,lwnudge,lthlnudge,/;" v module:modnudge ltilted src/addon/modtilt.f90 /^ logical :: ltilted /;" v module:modtilt ltimedep src/modtimedep.f90 /^ logical :: ltimedep /;" v module:modtimedep ltimedepsurf src/modtimedep.f90 /^ logical :: ltimedepsurf /;" v module:modtimedep +ltimedepsv src/modtimedepsv.f90 /^ logical :: ltimedepsv /;" v module:modtimedepsv ltimedepsvsurf src/modtimedepsv.f90 /^ logical :: ltimedepsvsurf /;" v module:modtimedepsv ltimedepsvz src/modtimedepsv.f90 /^ logical :: ltimedepsvz /;" v module:modtimedepsv ltimedepz src/modtimedep.f90 /^ logical :: ltimedepz /;" v module:modtimedep -ltimestat src/addon/modtimestat.f90 /^ logical :: ltimestat=/;" v module:modtimestat ltimestat src/modtimestat.f90 /^ logical :: ltimestat=/;" v module:modtimestat -ltkeb src/addon/modbudget.f90 /^ logical :: ltkeb /;" v module:modbudget ltkeb src/modbudget.f90 /^ logical :: ltkeb /;" v module:modbudget -lunudge src/addon/modnudge.f90 /^ logical :: lnudge,lunudge,/;" v module:modnudge lunudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,/;" v module:modnudge -lvnudge src/addon/modnudge.f90 /^ logical :: lnudge,lunudge,lvnudge,/;" v module:modnudge lvnudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,lvnudge,/;" v module:modnudge lwDownCS_slice src/modraddata.f90 /^ lwUpCS_slice, & ! Upwelling longwave rad, clear sky value (2D slice)$/;" v module:modraddata lwDown_slice src/modraddata.f90 /^ lwUp_slice, & ! Upwelling longwave rad (2D slice)$/;" v module:modraddata @@ -2119,16 +1834,16 @@ lw_kgb03 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb03$/;" s lw_kgb04 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb04$/;" s lw_kgb05 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb05$/;" s lw_kgb06 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb06$/;" s -lw_kgb07 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb07 /;" s -lw_kgb08 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb08 /;" s -lw_kgb09 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb09 /;" s -lw_kgb10 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb10 /;" s +lw_kgb07 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb07$/;" s +lw_kgb08 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb08$/;" s +lw_kgb09 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb09$/;" s +lw_kgb10 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb10$/;" s lw_kgb11 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb11$/;" s lw_kgb12 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb12$/;" s -lw_kgb13 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb13 /;" s -lw_kgb14 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb14 /;" s -lw_kgb15 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb15 /;" s -lw_kgb16 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb16 /;" s +lw_kgb13 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb13$/;" s +lw_kgb14 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb14$/;" s +lw_kgb15 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb15$/;" s +lw_kgb16 src/rrtmg_lw_read_nc.f90 /^subroutine lw_kgb16$/;" s lwarmstart src/modglobal.f90 /^ logical :: lwarmstart /;" v module:modglobal lwatmref src/rrtmg_lw_setcoef.f90 /^ subroutine lwatmref$/;" s module:rrtmg_lw_setcoef lwavplank src/rrtmg_lw_setcoef.f90 /^ subroutine lwavplank$/;" s module:rrtmg_lw_setcoef @@ -2136,36 +1851,25 @@ lwcldpr src/rrtmg_lw_init.f90 /^ subroutine lwcldpr$/;" s module:rrtmg_lw_i lwcmbdat src/rrtmg_lw_init.f90 /^ subroutine lwcmbdat$/;" s module:rrtmg_lw_init lwd src/modraddata.f90 /^ real, allocatable :: lwd(/;" v module:modraddata lwdatinit src/rrtmg_lw_init.f90 /^ subroutine lwdatinit(/;" s module:rrtmg_lw_init -lwdav src/addon/modradstat.f90 /^ real, allocatable :: lwdav(/;" v module:modradstat lwdav src/modradstat.f90 /^ real, allocatable :: lwdav(/;" v module:modradstat lwdavn src/modsurfdata.f90 /^ real, allocatable :: lwdavn /;" v module:modsurfdata lwdca src/modraddata.f90 /^ real, allocatable :: lwdca(/;" v module:modraddata -lwdcaav src/addon/modradstat.f90 /^ real, allocatable :: lwdcaav(/;" v module:modradstat lwdcaav src/modradstat.f90 /^ real, allocatable :: lwdcaav(/;" v module:modradstat -lwdcamn src/addon/modradstat.f90 /^ real, allocatable :: lwdcamn(/;" v module:modradstat lwdcamn src/modradstat.f90 /^ real, allocatable :: lwdcamn(/;" v module:modradstat -lwdmn src/addon/modradstat.f90 /^ real, allocatable :: lwdmn(/;" v module:modradstat lwdmn src/modradstat.f90 /^ real, allocatable :: lwdmn(/;" v module:modradstat -lwnudge src/addon/modnudge.f90 /^ logical :: lnudge,lunudge,lvnudge,lwnudge,/;" v module:modnudge lwnudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,lvnudge,lwnudge,/;" v module:modnudge -lwpid src/addon/modheterostats.f90 /^ integer :: lwpid$/;" v module:modheterostats lwpid src/modheterostats.f90 /^ integer :: lwpid$/;" v module:modheterostats lwu src/modraddata.f90 /^ real, allocatable :: lwu(/;" v module:modraddata -lwuav src/addon/modradstat.f90 /^ real, allocatable :: lwuav(/;" v module:modradstat lwuav src/modradstat.f90 /^ real, allocatable :: lwuav(/;" v module:modradstat lwuavn src/modsurfdata.f90 /^ real, allocatable :: lwuavn /;" v module:modsurfdata lwuca src/modraddata.f90 /^ real, allocatable :: lwuca(/;" v module:modraddata -lwucaav src/addon/modradstat.f90 /^ real, allocatable :: lwucaav(/;" v module:modradstat lwucaav src/modradstat.f90 /^ real, allocatable :: lwucaav(/;" v module:modradstat -lwucamn src/addon/modradstat.f90 /^ real, allocatable :: lwucamn(/;" v module:modradstat lwucamn src/modradstat.f90 /^ real, allocatable :: lwucamn(/;" v module:modradstat -lwumn src/addon/modradstat.f90 /^ real, allocatable :: lwumn(/;" v module:modradstat lwumn src/modradstat.f90 /^ real, allocatable :: lwumn(/;" v module:modradstat mair src/modglobal.f90 /^ real,parameter :: mair /;" v module:modglobal -massflxavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,qtavl,qlavl,nrsampl,massflxavl,/;" v module:modsampling massflxhavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,qtfavl,qlfavl,nrsampfl,massflxhavl,/;" v module:modsampling maxAbsorberNameLength src/rrlw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberNameLength /;" v module:rrlw_ncpar -maxAbsorberNameLength src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberNameLength /;" v module:rrsw_ncpar +maxAbsorberNameLength src/rrsw_ncpar.f90 /^ integer(kind=im), parameter :: maxAbsorberNameLength /;" v module:rrsw_ncpar maxKeySpeciesNameLength src/rrsw_ncpar.f90 /^ Absorber = 12, &$/;" v module:rrsw_ncpar maxKeySpeciesNames src/rrsw_ncpar.f90 /^ maxKeySpeciesNameLength = 3, &$/;" v module:rrsw_ncpar max_lands src/modsurfdata.f90 /^ integer, parameter:: max_lands /;" v module:modsurfdata @@ -2176,90 +1880,71 @@ mg src/parrrsw.f90 /^ integer(kind=im), parameter :: mg /;" v module:parrrs mg src/parrrtm.f90 /^ integer(kind=im), parameter :: mg /;" v module:parrrtm micro_user src/addon/micro_user.f90 /^subroutine micro_user$/;" s micro_user src/moduser.f90 /^subroutine micro_user$/;" s module:moduser -microphysics src/addon/modmicrophysics.f90 /^ subroutine microphysics$/;" s module:modmicrophysics microphysics src/modmicrophysics.f90 /^ subroutine microphysics$/;" s module:modmicrophysics -microsources src/addon/modmicrophysics.f90 /^ subroutine microsources$/;" s module:modmicrophysics microsources src/modmicrophysics.f90 /^ subroutine microsources$/;" s module:modmicrophysics minSolarZenithCosForVis src/modradfull.f90 /^ real, parameter :: minSolarZenithCosForVis /;" v module:modradfull mineps src/addon/modbulkmicrodata.f90 /^ ,mineps /;" v module:modbulkmicrodata mixbits src/rad_rndnmb.f90 /^ elemental function mixbits(/;" f module:RandomNumbers modAGScross src/modAGScross.f90 /^module modAGScross$/;" m modboundary src/modboundary.f90 /^module modboundary$/;" m -modbudget src/addon/modbudget.f90 /^module modbudget$/;" m modbudget src/modbudget.f90 /^module modbudget$/;" m -modbulkmicro src/addon/modbulkmicro.f90 /^module modbulkmicro$/;" m modbulkmicro src/modbulkmicro.f90 /^module modbulkmicro$/;" m modbulkmicrodata src/addon/modbulkmicrodata.f90 /^ module modbulkmicrodata$/;" m -modbulkmicrostat src/addon/modbulkmicrostat.f90 /^module modbulkmicrostat$/;" m modbulkmicrostat src/modbulkmicrostat.f90 /^module modbulkmicrostat$/;" m modcanopy src/modcanopy.f90 /^module modcanopy$/;" m modcape src/modcape.f90 /^module modcape$/;" m -modchecksim src/addon/modchecksim.f90 /^module modchecksim$/;" m modchecksim src/modchecksim.f90 /^module modchecksim$/;" m -modchem src/addon/modchem.f90 /^module modchem$/;" m modchem src/modchem.f90 /^module modchem$/;" m -modcloudfield src/addon/modcloudfield.f90 /^module modcloudfield$/;" m modcloudfield src/modcloudfield.f90 /^module modcloudfield$/;" m -modcrosssection src/addon/modcrosssection.f90 /^module modcrosssection$/;" m modcrosssection src/modcrosssection.f90 /^module modcrosssection$/;" m modfft2d src/modfft2d.f90 /^module modfft2d$/;" m -modfielddump src/addon/modfielddump.f90 /^module modfielddump$/;" m modfielddump src/modfielddump.f90 /^module modfielddump$/;" m modfields src/modfields.f90 /^module modfields$/;" m modforces src/modforces.f90 /^module modforces$/;" m -modgenstat src/addon/modgenstat.f90 /^module modgenstat$/;" m modgenstat src/modgenstat.f90 /^module modgenstat$/;" m modglobal src/modglobal.f90 /^module modglobal$/;" m -modheterostats src/addon/modheterostats.f90 /^module modheterostats$/;" m modheterostats src/modheterostats.f90 /^module modheterostats$/;" m modlsmcrosssection src/modlsmcrosssection.f90 /^module modlsmcrosssection$/;" m modlsmstat src/modlsmstat.f90 /^module modlsmstat$/;" m modmicrodata src/modmicrodata.f90 /^ module modmicrodata$/;" m -modmicrophysics src/addon/modmicrophysics.f90 /^module modmicrophysics$/;" m modmicrophysics src/modmicrophysics.f90 /^module modmicrophysics$/;" m modmpi src/modmpi.f90 /^module modmpi$/;" m modnetcdfmovie src/addon/modnetcdfmovie.f90 /^module modnetcdfmovie$/;" m modnetcdfstats src/addon/modnetcdfstats.f90 /^module modnetcdfstats$/;" m -modnudge src/addon/modnudge.f90 /^module modnudge$/;" m modnudge src/modnudge.f90 /^module modnudge$/;" m modparticles src/addon/modparticles.f90 /^module modparticles$/;" m modpois src/modpois.f90 /^module modpois$/;" m -modprojection src/addon/modprojection.f90 /^module modprojection$/;" m modprojection src/modprojection.f90 /^module modprojection$/;" m modquadrant src/modquadrant.f90 /^module modquadrant$/;" m modraddata src/modraddata.f90 /^module modraddata$/;" m modradfull src/modradfull.f90 /^module modradfull$/;" m modradiation src/modradiation.f90 /^module modradiation$/;" m modradrrtmg src/modradrrtmg.f90 /^module modradrrtmg$/;" m -modradstat src/addon/modradstat.f90 /^module modradstat$/;" m modradstat src/modradstat.f90 /^module modradstat$/;" m modsampdata src/modsampdata.f90 /^module modsampdata$/;" m -modsampling src/addon/modsampling.f90 /^module modsampling$/;" m modsampling src/modsampling.f90 /^module modsampling$/;" m modsamptend src/modsamptend.f90 /^module modsamptend$/;" m modsimpleice src/modsimpleice.f90 /^module modsimpleice$/;" m modsimpleicestat src/modsimpleicestat.f90 /^module modsimpleicestat$/;" m modstartup src/modstartup.f90 /^module modstartup$/;" m -modstat_nc src/addon/modstat_nc.f90 /^module modstat_nc$/;" m modstat_nc src/addon/stat_nc_dummy.f90 /^module modstat_nc$/;" m modstat_nc src/modstat_nc.f90 /^module modstat_nc$/;" m -modstattend src/addon/modstattend.f90 /^module modstattend$/;" m modstattend src/modstattend.f90 /^module modstattend$/;" m modstress src/addon/modstress.f90 /^module modstress$/;" m modsubgrid src/modsubgrid.f90 /^module modsubgrid$/;" m modsubgriddata src/modsubgriddata.f90 /^module modsubgriddata$/;" m modsurface src/modsurface.f90 /^module modsurface$/;" m modsurfdata src/modsurfdata.f90 /^module modsurfdata$/;" m +modtestbed src/modtestbed.f90 /^module modtestbed$/;" m modthermodynamics src/modthermodynamics.f90 /^module modthermodynamics$/;" m modtilt src/addon/modtilt.f90 /^module modtilt$/;" m modtimedep src/modtimedep.f90 /^module modtimedep$/;" m modtimedepsv src/modtimedepsv.f90 /^module modtimedepsv$/;" m -modtimestat src/addon/modtimestat.f90 /^module modtimestat$/;" m modtimestat src/modtimestat.f90 /^module modtimestat$/;" m moduser src/moduser.f90 /^module moduser$/;" m mpatch src/modsurfdata.f90 /^ integer, parameter:: mpatch /;" v module:modsurfdata +mpi_get_time src/modmpi.f90 /^ subroutine mpi_get_time(/;" s module:modmpi mpierr src/modmpi.f90 /^ integer :: mpierr$/;" v module:modmpi -mrpcc src/addon/modchem.f90 /^ integer mrpcc$/;" v module:modchem mrpcc src/modchem.f90 /^ integer mrpcc$/;" v module:modchem mu src/modraddata.f90 /^ real mu /;" v module:modraddata mu0_cgils src/modraddata.f90 /^ real :: mu0_cgils$/;" v module:modraddata @@ -2288,10 +1973,6 @@ n0rs src/modmicrodata.f90 /^ ,n0rs=/;" v module:modmicrodata n2o src/modraddata.f90 /^ o3, co2, ch4, n2o,/;" v module:modraddata n2ovmr src/modraddata.f90 /^ ch4vmr, &$/;" v module:modraddata naerec src/parrrsw.f90 /^ integer(kind=im), parameter :: naerec /;" v module:parrrsw -name src/addon/modchem.f90 /^ character (len = 6) name$/;" k type:location -name src/addon/modchem.f90 /^ character (len=6) name /;" k type:Name_Number -name src/addon/modchem.f90 /^ character (len=6) name$/;" k type:Chem -name src/addon/modchem.f90 /^ character*6 name$/;" k type:Reaction name src/modchem.f90 /^ character (len = 6) name$/;" k type:location name src/modchem.f90 /^ character (len=6) name /;" k type:Name_Number name src/modchem.f90 /^ character (len=6) name$/;" k type:Chem @@ -2304,32 +1985,20 @@ nbreast src/modmpi.f90 /^ integer :: nbreast$/;" v module:modmpi nbrnorth src/modmpi.f90 /^ integer :: nbrnorth$/;" v module:modmpi nbrsouth src/modmpi.f90 /^ integer :: nbrsouth$/;" v module:modmpi nbrwest src/modmpi.f90 /^ integer :: nbrwest$/;" v module:modmpi -nc_fillvalue src/addon/modstat_nc.f90 /^ real(kind=4) :: nc_fillvalue /;" v module:modstat_nc nc_fillvalue src/addon/stat_nc_dummy.f90 /^ real :: nc_fillvalue=/;" v module:modstat_nc nc_fillvalue src/modstat_nc.f90 /^ real(kind=4) :: nc_fillvalue /;" v module:modstat_nc ncanopy src/modcanopy.f90 /^ integer :: ncanopy /;" v module:modcanopy -nccall src/addon/modheterostats.f90 /^ integer :: nccall /;" v module:modheterostats nccall src/addon/modnetcdfmovie.f90 /^ integer :: nccall /;" v module:modnetcdfmovie nccall src/addon/modnetcdfstats.f90 /^ integer :: nccall /;" v module:modnetcdfstats nccall src/modheterostats.f90 /^ integer :: nccall /;" v module:modheterostats ncfieldflag src/addon/modnetcdfstats.f90 /^ integer :: ncfieldflag$/;" v module:modnetcdfstats -nchandle_error src/addon/modheterostats.f90 /^ subroutine nchandle_error(/;" s module:modheterostats nchandle_error src/addon/modnetcdfmovie.f90 /^ subroutine nchandle_error(/;" s module:modnetcdfmovie nchandle_error src/addon/modnetcdfstats.f90 /^ subroutine nchandle_error(/;" s module:modnetcdfstats -nchandle_error src/addon/modstat_nc.f90 /^ subroutine nchandle_error(/;" s module:modstat_nc nchandle_error src/modheterostats.f90 /^ subroutine nchandle_error(/;" s module:modheterostats nchandle_error src/modstat_nc.f90 /^ subroutine nchandle_error(/;" s module:modstat_nc -nchsp src/addon/modchem.f90 /^ integer nchsp /;" v module:modchem nchsp src/modchem.f90 /^ integer nchsp /;" v module:modchem -ncid src/addon/modbudget.f90 /^ integer :: ncid,/;" v module:modbudget -ncid src/addon/modbulkmicrostat.f90 /^ integer :: ncid,/;" v module:modbulkmicrostat -ncid src/addon/modfielddump.f90 /^ integer :: ncid,/;" v module:modfielddump -ncid src/addon/modgenstat.f90 /^ integer :: ncid,/;" v module:modgenstat -ncid src/addon/modheterostats.f90 /^ integer :: ncid$/;" v module:modheterostats ncid src/addon/modnetcdfmovie.f90 /^ integer :: ncid$/;" v module:modnetcdfmovie ncid src/addon/modnetcdfstats.f90 /^ integer :: ncid$/;" v module:modnetcdfstats -ncid src/addon/modstattend.f90 /^ integer :: ncid,/;" v module:modstattend -ncid src/addon/modtimestat.f90 /^ integer :: ncid,/;" v module:modtimestat ncid src/modfielddump.f90 /^ integer :: ncid,/;" v module:modfielddump ncid src/modgenstat.f90 /^ integer :: ncid,/;" v module:modgenstat ncid src/modheterostats.f90 /^ integer :: ncid$/;" v module:modheterostats @@ -2339,13 +2008,10 @@ ncid src/modsampling.f90 /^ integer :: ncid,/;" v module:modsampling ncid src/modsamptend.f90 /^ integer :: ncid,/;" v module:modsamptend ncid src/modstattend.f90 /^ integer :: ncid,/;" v module:modstattend ncid src/modtimestat.f90 /^ integer :: ncid,/;" v module:modtimestat -ncid1 src/addon/modcrosssection.f90 /^ integer :: ncid1 /;" v module:modcrosssection ncid1 src/modcrosssection.f90 /^ integer :: ncid1 /;" v module:modcrosssection ncid1 src/modlsmcrosssection.f90 /^ integer :: ncid1 /;" v module:modlsmcrosssection -ncid2 src/addon/modcrosssection.f90 /^ integer,allocatable :: ncid2(/;" v module:modcrosssection ncid2 src/modcrosssection.f90 /^ integer,allocatable :: ncid2(/;" v module:modcrosssection ncid2 src/modlsmcrosssection.f90 /^ integer :: ncid2 /;" v module:modlsmcrosssection -ncid3 src/addon/modcrosssection.f90 /^ integer :: ncid3 /;" v module:modcrosssection ncid3 src/modcrosssection.f90 /^ integer :: ncid3 /;" v module:modcrosssection ncid3 src/modlsmcrosssection.f90 /^ integer :: ncid3 /;" v module:modlsmcrosssection ncid4 src/modcape.f90 /^ integer :: ncid4 /;" v module:modcape @@ -2356,26 +2022,16 @@ ncidfieldu src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu,/;" v module:m ncidfieldv src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu, ncidfieldv,/;" v module:modnetcdfstats ncidfieldw src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu, ncidfieldv, ncidfieldw,/;" v module:modnetcdfstats ncidmovie src/addon/modnetcdfstats.f90 /^ integer :: ncidmovie$/;" v module:modnetcdfstats -ncinfo src/addon/modstat_nc.f90 /^ subroutine ncinfo(/;" s module:modstat_nc ncinfo src/addon/stat_nc_dummy.f90 /^ subroutine ncinfo(/;" s module:modstat_nc ncinfo src/modstat_nc.f90 /^ subroutine ncinfo(/;" s module:modstat_nc -ncklimit src/addon/modheterostats.f90 /^ integer :: ncklimit /;" v module:modheterostats ncklimit src/addon/modnetcdfmovie.f90 /^ integer :: ncklimit /;" v module:modnetcdfmovie ncklimit src/addon/modnetcdfstats.f90 /^ integer :: ncklimit /;" v module:modnetcdfstats -ncklimit src/modheterostats.f90 /^ integer :: ncklimit /;" v module:modheterostats -ncname src/addon/modbudget.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modbudget -ncname src/addon/modbulkmicrostat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modbulkmicrostat -ncname src/addon/modfielddump.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modfielddump -ncname src/addon/modgenstat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modgenstat -ncname src/addon/modradstat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modradstat -ncname src/addon/modsampling.f90 /^ character(80),allocatable,dimension(:,:,:) :: ncname$/;" v module:modsampling -ncname src/addon/modstattend.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modstattend +ncklimit src/modheterostats.f90 /^ integer :: ncklimit$/;" v module:modheterostats ncname src/addon/modstress.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modstress -ncname src/addon/modtimestat.f90 /^ character(80), allocatable, dimension(:,:) :: ncname$/;" v module:modtimestat ncname src/modbudget.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modbudget ncname src/modbulkmicrostat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modbulkmicrostat ncname src/modcape.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modcape -ncname src/modfielddump.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modfielddump +ncname src/modfielddump.f90 /^ character(80),dimension(:,:), allocatable :: ncname$/;" v module:modfielddump ncname src/modgenstat.f90 /^ character(80),allocatable, dimension(:,:) :: ncname$/;" v module:modgenstat ncname src/modlsmstat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modlsmstat ncname src/modprojection.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modprojection @@ -2386,18 +2042,15 @@ ncname src/modsamptend.f90 /^ character(80),allocatable,dimension(:,:,:) :: ncn ncname src/modsimpleicestat.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modsimpleicestat ncname src/modstattend.f90 /^ character(80),dimension(nvar,4) :: ncname$/;" v module:modstattend ncname src/modtimestat.f90 /^ character(80), allocatable, dimension(:,:) :: ncname$/;" v module:modtimestat -ncname1 src/addon/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname1$/;" v module:modcrosssection ncname1 src/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname1$/;" v module:modcrosssection ncname1 src/modlsmcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname1$/;" v module:modlsmcrosssection -ncname2 src/addon/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname2$/;" v module:modcrosssection ncname2 src/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname2$/;" v module:modcrosssection ncname2 src/modlsmcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname2$/;" v module:modlsmcrosssection -ncname3 src/addon/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname3$/;" v module:modcrosssection ncname3 src/modcrosssection.f90 /^ character(80),dimension(nvar,4) :: ncname3$/;" v module:modcrosssection ncname3 src/modlsmcrosssection.f90 /^ character(80),dimension(nvar3,4) :: ncname3$/;" v module:modlsmcrosssection ncnameAGS src/modAGScross.f90 /^ character(80),dimension(nvar,4) :: ncnameAGS$/;" v module:modAGScross +ncoarse src/modfielddump.f90 /^ integer :: klow,khigh,ncoarse=/;" v module:modfielddump ncosv src/modglobal.f90 /^ integer :: ncosv /;" v module:modglobal -ndt src/addon/modchecksim.f90 /^ real :: dtmn =0.,ndt /;" v module:modchecksim ndt src/modchecksim.f90 /^ real :: dtmn =0.,ndt /;" v module:modchecksim ndtmovie src/addon/modnetcdfmovie.f90 /^ integer :: ndtmovie$/;" v module:modnetcdfmovie netcdfmovie src/addon/modnetcdfmovie.f90 /^ subroutine netcdfmovie$/;" s module:modnetcdfmovie @@ -2496,6 +2149,7 @@ ngs6 src/parrrtm.f90 /^ integer(kind=im), parameter :: ngs6 /;" v module:pa ngs7 src/parrrtm.f90 /^ integer(kind=im), parameter :: ngs7 /;" v module:parrrtm ngs8 src/parrrtm.f90 /^ integer(kind=im), parameter :: ngs8 /;" v module:parrrtm ngs9 src/parrrtm.f90 /^ integer(kind=im), parameter :: ngs9 /;" v module:parrrtm +nknudge src/modtestbed.f90 /^ integer :: nknudge,/;" v module:modtestbed nkonx src/modfft2d.f90 /^ integer :: nkonx,/;" v module:modfft2d nkony src/modfft2d.f90 /^ integer :: nkonx, nkony$/;" v module:modfft2d nmason src/modsubgriddata.f90 /^ real :: nmason /;" v module:modsubgriddata @@ -2543,24 +2197,12 @@ nprocs src/modmpi.f90 /^ integer :: nprocs$/;" v module:modmpi nprocx src/modmpi.f90 /^ integer :: nprocx /;" v module:modmpi nprocy src/modmpi.f90 /^ integer :: nprocy /;" v module:modmpi npts src/modradfull.f90 /^ integer :: i,j,k, npts$/;" v module:modradfull -nr_PL src/addon/modchem.f90 /^ integer nr_PL /;" k type:Name_Number nr_PL src/modchem.f90 /^ integer nr_PL /;" k type:Name_Number -nr_chem src/addon/modchem.f90 /^ integer nr_chem /;" k type:Reaction nr_chem src/modchem.f90 /^ integer nr_chem /;" k type:Reaction -nr_chem_inp src/addon/modchem.f90 /^ integer nr_chem_inp /;" k type:Reaction nr_chem_inp src/modchem.f90 /^ integer nr_chem_inp /;" k type:Reaction -nr_chem_outp src/addon/modchem.f90 /^ integer nr_chem_outp /;" k type:Reaction nr_chem_outp src/modchem.f90 /^ integer nr_chem_outp /;" k type:Reaction -nr_raddep src/addon/modchem.f90 /^ integer nr_raddep /;" v module:modchem nr_raddep src/modchem.f90 /^ integer nr_raddep /;" v module:modchem nradtime src/modsurfdata.f90 /^ integer :: nradtime /;" v module:modsurfdata -nrc src/addon/modcrosssection.f90 /^ integer :: nrc$/;" v module:modcrosssection -nrec src/addon/modbudget.f90 /^ integer :: ncid,nrec /;" v module:modbudget -nrec src/addon/modbulkmicrostat.f90 /^ integer :: ncid,nrec /;" v module:modbulkmicrostat -nrec src/addon/modfielddump.f90 /^ integer :: ncid,nrec /;" v module:modfielddump -nrec src/addon/modgenstat.f90 /^ integer :: ncid,nrec /;" v module:modgenstat -nrec src/addon/modstattend.f90 /^ integer :: ncid,nrec /;" v module:modstattend -nrec src/addon/modtimestat.f90 /^ integer :: ncid,nrec /;" v module:modtimestat nrec src/modcape.f90 /^ integer :: nrec /;" v module:modcape nrec src/modfielddump.f90 /^ integer :: ncid,nrec /;" v module:modfielddump nrec src/modgenstat.f90 /^ integer :: ncid,nrec /;" v module:modgenstat @@ -2570,18 +2212,13 @@ nrec src/modsampling.f90 /^ integer :: ncid,nrec /;" v module:modsampling nrec src/modsamptend.f90 /^ integer :: ncid,nrec /;" v module:modsamptend nrec src/modstattend.f90 /^ integer :: ncid,nrec /;" v module:modstattend nrec src/modtimestat.f90 /^ integer :: ncid,nrec /;" v module:modtimestat -nrec1 src/addon/modcrosssection.f90 /^ integer :: nrec1 /;" v module:modcrosssection nrec1 src/modcrosssection.f90 /^ integer :: nrec1 /;" v module:modcrosssection nrec1 src/modlsmcrosssection.f90 /^ integer :: nrec1 /;" v module:modlsmcrosssection -nrec2 src/addon/modcrosssection.f90 /^ integer,allocatable :: nrec2(/;" v module:modcrosssection nrec2 src/modcrosssection.f90 /^ integer,allocatable :: nrec2(/;" v module:modcrosssection nrec2 src/modlsmcrosssection.f90 /^ integer :: nrec2 /;" v module:modlsmcrosssection -nrec3 src/addon/modcrosssection.f90 /^ integer :: nrec3 /;" v module:modcrosssection nrec3 src/modcrosssection.f90 /^ integer :: nrec3 /;" v module:modcrosssection nrec3 src/modlsmcrosssection.f90 /^ integer :: nrec3 /;" v module:modlsmcrosssection nrecAGS src/modAGScross.f90 /^ integer :: nrecAGS /;" v module:modAGScross -nrfields src/addon/modbulkmicrostat.f90 /^ integer, parameter :: nrfields /;" v module:modbulkmicrostat -nrfields src/addon/modstattend.f90 /^ integer,parameter :: nrfields /;" v module:modstattend nrfields src/modbulkmicrostat.f90 /^ integer, parameter :: nrfields /;" v module:modbulkmicrostat nrfields src/modsamptend.f90 /^ integer,parameter :: nrfields /;" v module:modsamptend nrfields src/modsimpleicestat.f90 /^ integer, parameter :: nrfields /;" v module:modsimpleicestat @@ -2592,22 +2229,14 @@ nrpmn src/modsamptend.f90 /^ real, allocatable :: upmn(:,:,:),vpmn(:,:,:),wpmn( nrptm src/modsamptend.f90 /^ real, allocatable :: uptm(:,:,:),vptm(:,:,:),wptm(:,:,:),thlptm(:,:,:),qtptm(:,:,:),qrptm(:,:,:),nrptm(/;" v module:modsamptend nrsamp src/modsamptend.f90 /^ integer, allocatable :: nrsampt/;" v module:modsamptend nrsampfl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,qtfavl,qlfavl,nrsampfl,/;" v module:modsampling -nrsamphl src/addon/modsampling.f90 /^ fcoravl,nrsamphl$/;" v module:modsampling nrsamphl src/modsampling.f90 /^ fcorhavl,nrsamphl$/;" v module:modsampling -nrsampl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,qtavl,qlavl,nrsampl,/;" v module:modsampling nrsampl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: nrsampl$/;" v module:modquadrant nrsamplast src/modsamptend.f90 /^ integer, allocatable :: nrsamptot(:,:),nrsamp(:,:),nrsamplast(/;" v module:modsamptend nrsampnew src/modsamptend.f90 /^ integer, allocatable :: nrsamptot(:,:),nrsamp(:,:),nrsamplast(:,:),nrsampnew(/;" v module:modsamptend nrsamptot src/modsamptend.f90 /^ integer, allocatable :: nrsamptot(/;" v module:modsamptend nrst src/modsamptend.f90 /^ real, allocatable :: ust(:,:),vst(:,:),wst(:,:),thlst(:,:),qtst(:,:),qrst(:,:),nrst(/;" v module:modsamptend nrtsamphav src/modsampling.f90 /^ integer,allocatable, dimension(:,:) :: nrtsamphav$/;" v module:modsampling -nsamples src/addon/modbudget.f90 /^ integer :: nsamples$/;" v module:modbudget -nsamples src/addon/modbulkmicrostat.f90 /^ integer :: nsamples$/;" v module:modbulkmicrostat -nsamples src/addon/modgenstat.f90 /^ integer :: nsamples$/;" v module:modgenstat nsamples src/addon/modparticles.f90 /^ integer :: nsamples$/;" v module:modparticles -nsamples src/addon/modradstat.f90 /^ integer :: nsamples$/;" v module:modradstat -nsamples src/addon/modsampling.f90 /^ integer :: nsamples,/;" v module:modsampling -nsamples src/addon/modstattend.f90 /^ integer :: nsamples$/;" v module:modstattend nsamples src/addon/modstress.f90 /^ integer :: nsamples$/;" v module:modstress nsamples src/addon/modtilt.f90 /^ integer :: nsamples$/;" v module:modtilt nsamples src/modbudget.f90 /^ integer :: nsamples$/;" v module:modbudget @@ -2631,36 +2260,25 @@ nt src/modradfull.f90 /^ inte/;" k type:ckd_properties ntbl src/rrlw_tbl.f90 /^ integer(kind=im), parameter :: ntbl /;" v module:rrlw_tbl ntbl src/rrsw_tbl.f90 /^ integer(kind=im), parameter :: ntbl /;" v module:rrsw_tbl ntimee src/modglobal.f90 /^ integer :: ntimee /;" v module:modglobal -ntnudge src/addon/modnudge.f90 /^ integer :: ntnudge /;" v module:modnudge ntnudge src/modnudge.f90 /^ integer :: ntnudge /;" v module:modnudge +ntnudge src/modtestbed.f90 /^ integer :: nknudge,ntnudge$/;" v module:modtestbed ntrun src/modglobal.f90 /^ integer :: ntrun /;" v module:modglobal nu_a src/addon/modbulkmicrodata.f90 /^ ,nu_a /;" v module:modbulkmicrodata nu_a src/modmicrodata.f90 /^ ,nu_a /;" v module:modmicrodata nuc src/addon/modbulkmicrodata.f90 /^ ,nuc /;" v module:modbulkmicrodata nuc src/modmicrodata.f90 /^ ,nuc /;" v module:modmicrodata nuco2q src/modsurfdata.f90 /^ real :: nuco2q /;" v module:modsurfdata -nudge src/addon/modnudge.f90 /^ subroutine nudge$/;" s module:modnudge nudge src/modnudge.f90 /^ subroutine nudge$/;" s module:modnudge -numit src/addon/modchem.f90 /^ integer ,parameter :: numit /;" v module:modchem numit src/modchem.f90 /^ integer ,parameter :: numit /;" v module:modchem nv src/modradfull.f90 /^ integer :: nv,/;" v module:modradfull nv1 src/modradfull.f90 /^ integer :: nv,nv1,/;" v module:modradfull -nvar src/addon/modbudget.f90 /^ integer,parameter :: nvar /;" v module:modbudget -nvar src/addon/modbulkmicrostat.f90 /^ integer,parameter :: nvar /;" v module:modbulkmicrostat -nvar src/addon/modcrosssection.f90 /^ integer,parameter :: nvar /;" v module:modcrosssection -nvar src/addon/modfielddump.f90 /^ integer,parameter :: nvar /;" v module:modfielddump -nvar src/addon/modgenstat.f90 /^ integer,parameter :: nvar /;" v module:modgenstat -nvar src/addon/modradstat.f90 /^ integer,parameter :: nvar /;" v module:modradstat -nvar src/addon/modsampling.f90 /^ integer,parameter :: nvar /;" v module:modsampling -nvar src/addon/modstattend.f90 /^ integer,parameter :: nvar /;" v module:modstattend nvar src/addon/modstress.f90 /^ integer,parameter :: nvar /;" v module:modstress -nvar src/addon/modtimestat.f90 /^ integer :: nvar$/;" v module:modtimestat nvar src/modAGScross.f90 /^ integer,parameter :: nvar /;" v module:modAGScross nvar src/modbudget.f90 /^ integer,parameter :: nvar /;" v module:modbudget nvar src/modbulkmicrostat.f90 /^ integer,parameter :: nvar /;" v module:modbulkmicrostat nvar src/modcape.f90 /^ integer,parameter :: nvar /;" v module:modcape nvar src/modcrosssection.f90 /^ integer,parameter :: nvar /;" v module:modcrosssection -nvar src/modfielddump.f90 /^ integer,parameter :: nvar /;" v module:modfielddump +nvar src/modfielddump.f90 /^ integer :: nvar /;" v module:modfielddump nvar src/modgenstat.f90 /^ integer :: nvar /;" v module:modgenstat nvar src/modlsmcrosssection.f90 /^ integer,parameter :: nvar /;" v module:modlsmcrosssection nvar src/modlsmstat.f90 /^ integer,parameter :: nvar /;" v module:modlsmstat @@ -2674,7 +2292,6 @@ nvar src/modstattend.f90 /^ integer,parameter :: nvar /;" v module:modstattend nvar src/modtimestat.f90 /^ integer :: nvar$/;" v module:modtimestat nvar3 src/modlsmcrosssection.f90 /^ integer,parameter :: nvar = 2,nvar3=/;" v module:modlsmcrosssection nxmol src/rrlw_wvn.f90 /^ integer(kind=im) :: nxmol$/;" v module:rrlw_wvn -nxy src/addon/modcrosssection.f90 /^ integer :: nxy /;" v module:modcrosssection nxy src/modcrosssection.f90 /^ integer :: nxy /;" v module:modcrosssection nzrad src/modraddata.f90 /^ integer :: nzrad /;" v module:modraddata nzsnd src/modraddata.f90 /^ integer, parameter :: nzsnd /;" v module:modraddata @@ -2697,10 +2314,8 @@ om23 src/modglobal.f90 /^ real :: om23 /;" v module:modglobal om23_gs src/modglobal.f90 /^ real :: om23_gs /;" v module:modglobal oneminus src/rrlw_con.f90 /^ real(kind=rb) :: oneminus,/;" v module:rrlw_con oneminus src/rrsw_con.f90 /^ real(kind=rb) :: oneminus,/;" v module:rrsw_con -open_nc src/addon/modstat_nc.f90 /^ subroutine open_nc /;" s module:modstat_nc open_nc src/addon/stat_nc_dummy.f90 /^ subroutine open_nc /;" s module:modstat_nc open_nc src/modstat_nc.f90 /^ subroutine open_nc /;" s module:modstat_nc -outp src/addon/modchem.f90 /^ type (Chem) outp(/;" k type:Reaction outp src/modchem.f90 /^ type (Chem) outp(/;" k type:Reaction p src/modpois.f90 /^ real,allocatable :: p(/;" v module:modpois p11d src/modradfull.f90 /^ real, parameter, dimension(4, 4) :: &$/;" v module:modradfull @@ -2712,7 +2327,6 @@ p3d src/modradfull.f90 /^ real, parameter :: p3d(/;" v module:modradfull pCm src/modsurfdata.f90 /^ real, parameter :: pCm /;" v module:modsurfdata pCs src/modsurfdata.f90 /^ real, allocatable :: pCs /;" v module:modsurfdata pCw src/modsurfdata.f90 /^ real, parameter :: pCw /;" v module:modsurfdata -p_ref src/addon/modchem.f90 /^ real t_ref,q_ref,p_ref,/;" v module:modchem p_ref src/modchem.f90 /^ real t_ref,q_ref,p_ref,/;" v module:modchem pade src/rrlw_tbl.f90 /^ real(kind=rb), parameter :: pade /;" v module:rrlw_tbl pade src/rrsw_tbl.f90 /^ real(kind=rb), parameter :: pade /;" v module:rrsw_tbl @@ -2736,12 +2350,11 @@ partstep src/addon/modparticles.f90 /^ integer :: partstep$/;" k type:particl patchsum_1level src/modtimestat.f90 /^ function patchsum_1level(/;" f module:modtimestat patchxnr src/modsurface.f90 /^ function patchxnr(/;" f module:modsurface patchynr src/modsurface.f90 /^ function patchynr(/;" f module:modsurface -pavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,pavl,/;" v module:modsampling pde src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(:), ph(:), po(:), pre(:), pde(/;" v module:modradfull peclet src/modglobal.f90 /^ real :: peclet /;" v module:modglobal pfavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,pfavl,/;" v module:modsampling pforeign src/rrlw_ncpar.f90 /^ Tforeign = 4, &$/;" v module:rrlw_ncpar -pforeign src/rrsw_ncpar.f90 /^ Tforeignupper = 2, &$/;" v module:rrsw_ncpar +pforeign src/rrsw_ncpar.f90 /^ Tforeignupper = 2, &$/;" v module:rrsw_ncpar pgwc src/modradfull.f90 /^ plwc(:), piwc(:), prwc(:), pgwc(/;" v module:modradfull ph src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(:), ph(/;" v module:modradfull phi src/addon/modbulkmicrodata.f90 /^ ,phi /;" v module:modbulkmicrodata @@ -2770,7 +2383,7 @@ planck src/rrlw_con.f90 /^ real(kind=rb) :: planck,/;" v module:rrlw_con planck src/rrsw_con.f90 /^ real(kind=rb) :: planck,/;" v module:rrsw_con planttype src/modsurfdata.f90 /^ integer :: planttype /;" v module:modsurfdata plower src/rrlw_ncpar.f90 /^ ps = 59, &$/;" v module:rrlw_ncpar -plower src/rrsw_ncpar.f90 /^ ps = 59, &$/;" v module:rrsw_ncpar +plower src/rrsw_ncpar.f90 /^ ps = 59, &$/;" v module:rrsw_ncpar pluseps src/addon/modbulkmicrodata.f90 /^ ,pluseps /;" v module:modbulkmicrodata plwc src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(:), ph(:), po(:), pre(:), pde(:), &$/;" v module:modradfull po src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(:), ph(:), po(/;" v module:modradfull @@ -2779,37 +2392,27 @@ power src/modradfull.f90 /^ real :: llimit, rlimit, center, power src/modradfull.f90 /^ elemental real function power(/;" f module:modradfull pp src/modradfull.f90 /^ real, allocatable, save :: pp(/;" v module:modradfull ppad src/modcanopy.f90 /^ real, allocatable :: ppad(/;" v module:modcanopy -ppb src/addon/modchem.f90 /^ real, parameter :: ppb /;" v module:modchem ppb src/modchem.f90 /^ real, parameter :: ppb /;" v module:modchem pre src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(:), ph(:), po(:), pre(/;" v module:modradfull -prec_prcav src/addon/modbulkmicrostat.f90 /^ prec_prcavl/;" v module:modbulkmicrostat prec_prcav src/modbulkmicrostat.f90 /^ prec_prcavl/;" v module:modbulkmicrostat prec_prcav src/modsimpleicestat.f90 /^ prec_prcavl/;" v module:modsimpleicestat -prec_prcavl src/addon/modbulkmicrostat.f90 /^ preccountmn , &$/;" v module:modbulkmicrostat prec_prcavl src/modbulkmicrostat.f90 /^ preccountmn , &$/;" v module:modbulkmicrostat prec_prcavl src/modsimpleicestat.f90 /^ preccountmn , &$/;" v module:modsimpleicestat -prec_prcmn src/addon/modbulkmicrostat.f90 /^ prec_prcav , &$/;" v module:modbulkmicrostat prec_prcmn src/modbulkmicrostat.f90 /^ prec_prcav , &$/;" v module:modbulkmicrostat prec_prcmn src/modsimpleicestat.f90 /^ prec_prcav , &$/;" v module:modsimpleicestat -precav src/addon/modbulkmicrostat.f90 /^ real, allocatable, dimension(:) :: precavl/;" v module:modbulkmicrostat precav src/modbulkmicrostat.f90 /^ real, allocatable, dimension(:) :: precavl/;" v module:modbulkmicrostat precav src/modsimpleicestat.f90 /^ real, allocatable, dimension(:) :: precavl/;" v module:modsimpleicestat -precavl src/addon/modbulkmicrostat.f90 /^ real, allocatable, dimension(:) :: precavl /;" v module:modbulkmicrostat precavl src/modbulkmicrostat.f90 /^ real, allocatable, dimension(:) :: precavl /;" v module:modbulkmicrostat precavl src/modsimpleicestat.f90 /^ real, allocatable, dimension(:) :: precavl /;" v module:modsimpleicestat -preccountav src/addon/modbulkmicrostat.f90 /^ preccountavl/;" v module:modbulkmicrostat preccountav src/modbulkmicrostat.f90 /^ preccountavl/;" v module:modbulkmicrostat preccountav src/modsimpleicestat.f90 /^ preccountavl/;" v module:modsimpleicestat -preccountavl src/addon/modbulkmicrostat.f90 /^ precmn , &$/;" v module:modbulkmicrostat preccountavl src/modbulkmicrostat.f90 /^ precmn , &$/;" v module:modbulkmicrostat preccountavl src/modsimpleicestat.f90 /^ precmn , &$/;" v module:modsimpleicestat -preccountmn src/addon/modbulkmicrostat.f90 /^ preccountav , &$/;" v module:modbulkmicrostat preccountmn src/modbulkmicrostat.f90 /^ preccountav , &$/;" v module:modbulkmicrostat preccountmn src/modsimpleicestat.f90 /^ preccountav , &$/;" v module:modsimpleicestat precep src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: precep$/;" v module:modbulkmicrodata precep src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: precep$/;" v module:modmicrodata precipitate src/modsimpleice.f90 /^ subroutine precipitate$/;" s module:modsimpleice -precmn src/addon/modbulkmicrostat.f90 /^ precav , &$/;" v module:modbulkmicrostat precmn src/modbulkmicrostat.f90 /^ precav , &$/;" v module:modbulkmicrostat precmn src/modsimpleicestat.f90 /^ precav , &$/;" v module:modsimpleicestat pref src/rrlw_ref.f90 /^ real(kind=rb) , dimension(59) :: pref$/;" v module:rrlw_ref @@ -2824,15 +2427,12 @@ presh_input src/modraddata.f90 /^ real,allocatable,dimension(:) :: presf_inpu presz src/addon/modbulkmicrodata.f90 /^ ,presz /;" v module:modbulkmicrodata presz src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: &$/;" v module:modmicrodata prev src/addon/modparticles.f90 /^ TYPE (particle_record), POINTER:: next,prev$/;" k type:particle_record -projectheight src/addon/modprojection.f90 /^ integer :: projectheight /;" v module:modprojection projectheight src/modprojection.f90 /^ real :: projectheight /;" v module:modprojection -projection src/addon/modprojection.f90 /^ subroutine projection$/;" s module:modprojection projection src/modprojection.f90 /^ subroutine projection$/;" s module:modprojection -projectplane src/addon/modprojection.f90 /^ integer :: projectplane /;" v module:modprojection prwc src/modradfull.f90 /^ plwc(:), piwc(:), prwc(/;" v module:modradfull ps src/modsurfdata.f90 /^ real :: ps /;" v module:modsurfdata ps src/rrlw_ncpar.f90 /^ Tdiff = 5, &$/;" v module:rrlw_ncpar -ps src/rrsw_ncpar.f90 /^ Tdiff = 5, &$/;" v module:rrsw_ncpar +ps src/rrsw_ncpar.f90 /^ Tdiff = 5, &$/;" v module:rrsw_ncpar ps_land src/modsurfdata.f90 /^ real :: ps_land(/;" v module:modsurfdata ps_patch src/modsurfdata.f90 /^ real, allocatable :: ps_patch(/;" v module:modsurfdata psih src/modsurface.f90 /^ function psih(/;" f module:modsurface @@ -2841,11 +2441,9 @@ psisat src/modsurfdata.f90 /^ real, parameter :: psisat /;" v module:modsurfd psnd src/modraddata.f90 /^ real,allocatable,dimension(:) :: psnd,/;" v module:modraddata pst src/modtimedep.f90 /^ real, allocatable :: pst /;" v module:modtimedep pt src/modradfull.f90 /^ real, allocatable, save :: pp(:), pt(/;" v module:modradfull -ptrspmn src/addon/modbudget.f90 /^ real, allocatable :: ptrspmn(/;" v module:modbudget ptrspmn src/modbudget.f90 /^ real, allocatable :: ptrspmn(/;" v module:modbudget pupper src/rrlw_ncpar.f90 /^ plower = 13, &$/;" v module:rrlw_ncpar -pupper src/rrsw_ncpar.f90 /^ plower = 13, &$/;" v module:rrsw_ncpar -q_ref src/addon/modchem.f90 /^ real t_ref,q_ref,/;" v module:modchem +pupper src/rrsw_ncpar.f90 /^ plower = 13, &$/;" v module:rrsw_ncpar q_ref src/modchem.f90 /^ real t_ref,q_ref,/;" v module:modchem qc src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: qc /;" v module:modbulkmicrodata qc src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: qc /;" v module:modmicrodata @@ -2862,56 +2460,40 @@ qk src/modradfull.f90 /^ subroutine qk /;" s module:modradfull ql0 src/modfields.f90 /^ real, allocatable :: ql0(/;" v module:modfields ql0av src/modfields.f90 /^ real, allocatable :: ql0av(/;" v module:modfields ql0h src/modfields.f90 /^ real, allocatable :: ql0h(/;" v module:modfields -ql2mn src/addon/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(:), th2mn(:), ql2mn(/;" v module:modgenstat ql2mn src/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(:), th2mn(:), ql2mn(/;" v module:modgenstat ql_b src/modradfull.f90 /^ real, allocatable :: temp_b(:,:,:),qv_b(:,:,:),ql_b(/;" v module:modradfull -qlavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid, qlavgid,/;" v module:modheterostats qlavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid, qlavgid,/;" v module:modheterostats -qlavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,qtavl,qlavl,/;" v module:modsampling qlfavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,qtfavl,qlfavl,/;" v module:modsampling -qlhmn src/addon/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn (:), qlhmn(/;" v module:modgenstat qlhmn src/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn (:), qlhmn(/;" v module:modgenstat qli0 src/modmicrodata.f90 /^ ,qli0=/;" v module:modmicrodata -qlint src/addon/modtimestat.f90 /^ real :: qlint$/;" v module:modtimestat qlint src/modtimestat.f90 /^ real :: qlint$/;" v module:modtimestat qlint_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field, ztop_field, cc_field, qlint_field,/;" v module:modtimestat qlint_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cc_patch, qlint_patch,/;" v module:modtimestat -qlintav src/addon/modtimestat.f90 /^ real :: qlintav,/;" v module:modtimestat qlintav src/modtimestat.f90 /^ real :: qlintav,/;" v module:modtimestat -qlintmax src/addon/modtimestat.f90 /^ real :: qlintav, qlintmax,/;" v module:modtimestat qlintmax src/modtimestat.f90 /^ real :: qlintav, qlintmax,/;" v module:modtimestat qlintmax_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cc_patch, qlint_patch, qlintmax_patch,/;" v module:modtimestat qlintmax_patchl src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cc_patch, qlint_patch, qlintmax_patch, qlintmax_patchl,/;" v module:modtimestat qll0 src/modmicrodata.f90 /^ ,qll0=/;" v module:modmicrodata -qlmav src/addon/modgenstat.f90 /^ real, allocatable :: qlmav /;" v module:modgenstat qlmav src/modgenstat.f90 /^ real, allocatable :: qlmav /;" v module:modgenstat -qlmax src/addon/modtimestat.f90 /^ real :: cc, wmax, qlmax$/;" v module:modtimestat qlmax src/modtimestat.f90 /^ real :: cc, wmax, qlmax$/;" v module:modtimestat qlmax_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch, wmax_patchl, qlmax_patch,/;" v module:modtimestat qlmax_patchl src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch, wmax_patchl, qlmax_patch, qlmax_patchl,/;" v module:modtimestat -qlmn src/addon/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn /;" v module:modgenstat qlmn src/modgenstat.f90 /^ real, allocatable :: qtmn (:) ,qlmn /;" v module:modgenstat qlmnlast src/modgenstat.f90 /^ real, allocatable :: qlmnlast(/;" v module:modgenstat -qlpav src/addon/modbulkmicrostat.f90 /^ Npmn , &$/;" v module:modbulkmicrostat qlpav src/modbulkmicrostat.f90 /^ Npmn , &$/;" v module:modbulkmicrostat qlpav src/modsimpleicestat.f90 /^ Npmn , &$/;" v module:modsimpleicestat -qlpmn src/addon/modbulkmicrostat.f90 /^ qlpav , &$/;" v module:modbulkmicrostat qlpmn src/modbulkmicrostat.f90 /^ qlpav , &$/;" v module:modbulkmicrostat qlpmn src/modsimpleicestat.f90 /^ qlpav , &$/;" v module:modsimpleicestat -qlptav src/addon/modgenstat.f90 /^ real, allocatable :: qlptav(/;" v module:modgenstat qlptav src/modgenstat.f90 /^ real, allocatable :: qlptav(/;" v module:modgenstat qltot src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,/;" v module:modbulkmicrodata qltot src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,/;" v module:modmicrodata -qlvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid, qtvarid, qlvarid$/;" v module:modheterostats qlvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid, qtvarid, qlvarid$/;" v module:modheterostats qr src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,/;" v module:modbulkmicrodata qr src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,/;" v module:modmicrodata qr_spl src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: qr_spl,/;" v module:modbulkmicrodata qr_spl src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: qr_spl,/;" v module:modmicrodata -qrav src/addon/modbulkmicrostat.f90 /^ qravl/;" v module:modbulkmicrostat qrav src/modbulkmicrostat.f90 /^ qravl/;" v module:modbulkmicrostat qrav src/modsimpleicestat.f90 /^ qravl/;" v module:modsimpleicestat -qravl src/addon/modbulkmicrostat.f90 /^ Nrrainmn , &$/;" v module:modbulkmicrostat qravl src/modbulkmicrostat.f90 /^ Nrrainmn , &$/;" v module:modbulkmicrostat qravl src/modsimpleicestat.f90 /^ Nrrainmn , &$/;" v module:modsimpleicestat qrfavl src/modsampling.f90 /^ wthlthavl,wthvthavl,wqtthavl,wqlthavl,uwthavl,vwthavl,qrfavl$/;" v module:modsampling @@ -2919,7 +2501,6 @@ qrmask src/addon/modbulkmicrodata.f90 /^ logical ,allocatable,dimension(:,:,:): qrmask src/modmicrodata.f90 /^ logical ,allocatable,dimension(:,:,:):: qcmask,qrmask$/;" v module:modmicrodata qrmin src/addon/modbulkmicrodata.f90 /^ ,qrmin /;" v module:modbulkmicrodata qrmin src/modmicrodata.f90 /^ ,qrmin /;" v module:modmicrodata -qrmn src/addon/modbulkmicrostat.f90 /^ qrav , &$/;" v module:modbulkmicrostat qrmn src/modbulkmicrostat.f90 /^ qrav , &$/;" v module:modbulkmicrostat qrmn src/modsimpleicestat.f90 /^ qrav , &$/;" v module:modsimpleicestat qrp src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,qrp,/;" v module:modbulkmicrodata @@ -2934,12 +2515,9 @@ qst_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: ust_patch, qt0 src/modfields.f90 /^ real, allocatable :: qt0(/;" v module:modfields qt0av src/modfields.f90 /^ real, allocatable :: qt0av(/;" v module:modfields qt0h src/modfields.f90 /^ real, allocatable :: qt0h(/;" v module:modfields -qt2mn src/addon/modgenstat.f90 /^ real, allocatable :: u2mn (:), v2mn (:), qt2mn(/;" v module:modgenstat qt2mn src/modgenstat.f90 /^ real, allocatable :: u2mn (:), v2mn (:), qt2mn(/;" v module:modgenstat -qtavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid,/;" v module:modheterostats qtavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, qtavgid,/;" v module:modnetcdfstats qtavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid, qtavgid,/;" v module:modheterostats -qtavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,qtavl,/;" v module:modsampling qtavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,wavl,utotavl,thlavl,qtavl$/;" v module:modquadrant qtfavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,qtfavl,/;" v module:modsampling qtflux src/modsurfdata.f90 /^ real, allocatable :: qtflux /;" v module:modsurfdata @@ -2947,23 +2525,16 @@ qtid src/addon/modnetcdfmovie.f90 /^ integer :: uid, vid, wid, thlid, qtid$/;" qtidfield src/addon/modnetcdfstats.f90 /^ integer :: uidfield, vidfield, widfield, thlidfield, qtidfield$/;" v module:modnetcdfstats qtidmovie src/addon/modnetcdfstats.f90 /^ integer :: uidmovie, vidmovie, widmovie, thlidmovie, qtidmovie$/;" v module:modnetcdfstats qtm src/modfields.f90 /^ real, allocatable :: qtm(/;" v module:modfields -qtmav src/addon/modgenstat.f90 /^ real, allocatable :: qtmav /;" v module:modgenstat qtmav src/modgenstat.f90 /^ real, allocatable :: qtmav /;" v module:modgenstat -qtmn src/addon/modgenstat.f90 /^ real, allocatable :: qtmn /;" v module:modgenstat qtmn src/modgenstat.f90 /^ real, allocatable :: qtmn /;" v module:modgenstat -qtnudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,thlnudge,qtnudge$/;" v module:modnudge qtnudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,thlnudge,qtnudge$/;" v module:modnudge qtp src/modfields.f90 /^ real, allocatable :: qtp(/;" v module:modfields -qtpav src/addon/modbulkmicrostat.f90 /^ qlpmn , &$/;" v module:modbulkmicrostat -qtpav src/addon/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(:,:),thlpav(:,:),qtpav(/;" v module:modstattend qtpav src/modbulkmicrostat.f90 /^ qlpmn , &$/;" v module:modbulkmicrostat qtpav src/modsamptend.f90 /^ real, allocatable :: upav(:,:,:),vpav(:,:,:),wpav(:,:,:),thlpav(:,:,:),qtpav(/;" v module:modsamptend qtpav src/modsimpleicestat.f90 /^ qlpmn , &$/;" v module:modsimpleicestat qtpav src/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(:,:),thlpav(:,:),qtpav(/;" v module:modstattend qtpmcr src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,qrp,thlpmcr,qtpmcr$/;" v module:modbulkmicrodata qtpmcr src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,qrp,thlpmcr,qtpmcr$/;" v module:modmicrodata -qtpmn src/addon/modbulkmicrostat.f90 /^ qtpav , &$/;" v module:modbulkmicrostat -qtpmn src/addon/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(:,:),wpmn(:,:),thlpmn(:,:),qtpmn(/;" v module:modstattend qtpmn src/modbulkmicrostat.f90 /^ qtpav , &$/;" v module:modbulkmicrostat qtpmn src/modsamptend.f90 /^ real, allocatable :: upmn(:,:,:),vpmn(:,:,:),wpmn(:,:,:),thlpmn(:,:,:),qtpmn(/;" v module:modsamptend qtpmn src/modsimpleicestat.f90 /^ qtpav , &$/;" v module:modsimpleicestat @@ -2976,7 +2547,6 @@ qts_patch src/modsurfdata.f90 /^ real, allocatable :: qts_patch(/;" v module:mo qtst src/modsamptend.f90 /^ real, allocatable :: ust(:,:),vst(:,:),wst(:,:),thlst(:,:),qtst(/;" v module:modsamptend qtst src/modtimedep.f90 /^ real, allocatable :: qtst /;" v module:modtimedep qtsurf src/modsurface.f90 /^ subroutine qtsurf$/;" s module:modsurface -qtvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid, qtvarid,/;" v module:modheterostats qtvarid src/addon/modnetcdfstats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, qtvarid$/;" v module:modnetcdfstats qtvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid, qtvarid,/;" v module:modheterostats qtvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,vvarl,wvarl,utotvarl,thlvarl,qtvarl$/;" v module:modquadrant @@ -2985,7 +2555,6 @@ qv_b src/modradfull.f90 /^ real, allocatable :: temp_b(:,:,:),qv_b(/;" v modul qv_slice src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: tabs_slice, & ! Absolute temperature (2D slice)$/;" v module:modraddata qvsi src/modfields.f90 /^ real, allocatable :: qvsi(/;" v module:modfields qvsl src/modfields.f90 /^ real, allocatable :: qvsl(/;" v module:modfields -r_nr src/addon/modchem.f90 /^ integer r_nr /;" k type:Form r_nr src/modchem.f90 /^ integer r_nr /;" k type:Form ra src/modsurfdata.f90 /^ real, allocatable :: ra /;" v module:modsurfdata ra_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch, H_patch, LE_patch, G0_patch, tendskin_patch,rs_patch,ra_patch$/;" v module:modtimestat @@ -2998,15 +2567,12 @@ rad_shortw src/modraddata.f90 /^ logical :: rad_shortw /;" v module:modraddata rad_smoke src/modraddata.f90 /^ logical :: rad_smoke /;" v module:modraddata rad_user src/moduser.f90 /^subroutine rad_user$/;" s module:moduser rad_vis src/modradfull.f90 /^ subroutine rad_vis /;" s module:modradfull -radclearair src/addon/modradstat.f90 /^ subroutine radclearair$/;" s module:modradstat radclearair src/modradstat.f90 /^ subroutine radclearair$/;" s module:modradstat radcn1 src/rrlw_con.f90 /^ real(kind=rb) :: radcn1,/;" v module:rrlw_con radcn1 src/rrsw_con.f90 /^ real(kind=rb) :: radcn1,/;" v module:rrsw_con radcn2 src/rrlw_con.f90 /^ real(kind=rb) :: radcn1, radcn2$/;" v module:rrlw_con radcn2 src/rrsw_con.f90 /^ real(kind=rb) :: radcn1, radcn2$/;" v module:rrsw_con -raddep src/addon/modchem.f90 /^ integer raddep /;" k type:RCdef raddep src/modchem.f90 /^ integer raddep /;" k type:RCdef -raddep_RCindex src/addon/modchem.f90 /^ integer, allocatable :: raddep_RCindex(/;" v module:modchem raddep_RCindex src/modchem.f90 /^ integer, allocatable :: raddep_RCindex(/;" v module:modchem radfull src/modradfull.f90 /^ subroutine radfull$/;" s module:modradfull radiation src/modradiation.f90 /^ subroutine radiation$/;" s module:modradiation @@ -3014,15 +2580,11 @@ radlsm src/modradiation.f90 /^ subroutine radlsm$/;" s module:modradiation radpar src/modradiation.f90 /^subroutine radpar$/;" s module:modradiation radprof src/modradiation.f90 /^ subroutine radprof$/;" s module:modradiation radrrtmg src/modradrrtmg.f90 /^ subroutine radrrtmg$/;" s module:modradrrtmg -radstat src/addon/modradstat.f90 /^ subroutine radstat$/;" s module:modradstat radstat src/modradstat.f90 /^ subroutine radstat$/;" s module:modradstat -raincountav src/addon/modbulkmicrostat.f90 /^ raincountavl/;" v module:modbulkmicrostat raincountav src/modbulkmicrostat.f90 /^ raincountavl/;" v module:modbulkmicrostat raincountav src/modsimpleicestat.f90 /^ raincountavl/;" v module:modsimpleicestat -raincountavl src/addon/modbulkmicrostat.f90 /^ cloudcountmn , &$/;" v module:modbulkmicrostat raincountavl src/modbulkmicrostat.f90 /^ cloudcountmn , &$/;" v module:modbulkmicrostat raincountavl src/modsimpleicestat.f90 /^ cloudcountmn , &$/;" v module:modsimpleicestat -raincountmn src/addon/modbulkmicrostat.f90 /^ raincountav , &$/;" v module:modbulkmicrostat raincountmn src/modbulkmicrostat.f90 /^ raincountav , &$/;" v module:modbulkmicrostat raincountmn src/modsimpleicestat.f90 /^ raincountav , &$/;" v module:modsimpleicestat ran1 src/addon/modparticles.f90 /^ function ran1(/;" f module:modparticles @@ -3032,13 +2594,12 @@ randoms src/modradfull.f90 /^ type(randomNumberSequence), save :: randoms$/;" v randqt src/modstartup.f90 /^ real :: randthl= 0.1,randqt=/;" v module:modstartup randthl src/modstartup.f90 /^ real :: randthl=/;" v module:modstartup randu src/modstartup.f90 /^ real :: randu /;" v module:modstartup -ratech src/addon/modchem.f90 /^subroutine ratech$/;" s module:modchem ratech src/modchem.f90 /^subroutine ratech$/;" s module:modchem rayl src/rrsw_kg16.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg16 rayl src/rrsw_kg17.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg17 rayl src/rrsw_kg18.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg18 rayl src/rrsw_kg19.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg19 -rayl src/rrsw_kg20.f90 /^ real(kind=rb) :: rayl /;" v module:rrsw_kg20 +rayl src/rrsw_kg20.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg20 rayl src/rrsw_kg21.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg21 rayl src/rrsw_kg22.f90 /^ real(kind=rb) :: rayl$/;" v module:rrsw_kg22 rayl src/rrsw_kg23.f90 /^ real(kind=rb) :: sfluxref(ng23), rayl(/;" v module:rrsw_kg23 @@ -3060,22 +2621,18 @@ rcp src/modglobal.f90 /^ real,parameter :: rcp /;" v module:modglobal rd src/modglobal.f90 /^ real,parameter :: rd /;" v module:modglobal rdt src/modglobal.f90 /^ real :: rdt /;" v module:modglobal re src/modradfull.f90 /^ rea/;" v module:modradfull -reaction_ev src/addon/modchem.f90 /^ logical, allocatable :: reaction_ev(/;" v module:modchem reaction_ev src/modchem.f90 /^ logical, allocatable :: reaction_ev(/;" v module:modchem readSounding src/modradrrtmg.f90 /^ subroutine readSounding(/;" s module:modradrrtmg readTraceProfs src/modradrrtmg.f90 /^ subroutine readTraceProfs /;" s module:modradrrtmg -read_chem src/addon/modchem.f90 /^SUBROUTINE read_chem(/;" s module:modchem read_chem src/modchem.f90 /^SUBROUTINE read_chem(/;" s module:modchem readinitfiles src/modstartup.f90 /^ subroutine readinitfiles$/;" s module:modstartup readrestartfiles src/modstartup.f90 /^ subroutine readrestartfiles$/;" s module:modstartup readthla src/addon/modtilt.f90 /^ subroutine readthla$/;" s module:modtilt -redefine_nc src/addon/modstat_nc.f90 /^ subroutine redefine_nc(/;" s module:modstat_nc redefine_nc src/addon/stat_nc_dummy.f90 /^ subroutine redefine_nc(/;" s module:modstat_nc redefine_nc src/modstat_nc.f90 /^ subroutine redefine_nc(/;" s module:modstat_nc reff src/modraddata.f90 /^ real :: reff /;" v module:modraddata refparam src/rrlw_kg02.f90 /^ real(kind=rb) :: refparam(/;" v module:rrlw_kg02 reftra_sw src/rrtmg_sw_reftra.f90 /^ subroutine reftra_sw(/;" s module:rrtmg_sw_reftra -residmn src/addon/modbudget.f90 /^ real, allocatable :: residmn(/;" v module:modbudget residmn src/modbudget.f90 /^ real, allocatable :: residmn(/;" v module:modbudget rho_c src/addon/modbulkmicrodata.f90 /^ real :: rho_c /;" v module:modbulkmicrodata rho_c src/modmicrodata.f90 /^ real :: rho_c /;" v module:modmicrodata @@ -3087,11 +2644,8 @@ rhow src/modglobal.f90 /^ real,parameter :: rhow /;" v module:modglobal rhoz src/addon/modbulkmicrodata.f90 /^ ,rhoz /;" v module:modbulkmicrodata rhoz src/modmicrodata.f90 /^ ,rhoz /;" v module:modmicrodata riv src/modglobal.f90 /^ real,parameter :: riv /;" v module:modglobal -rk src/addon/modchem.f90 /^ real, allocatable :: rk1/;" v module:modchem rk src/modchem.f90 /^ real, allocatable :: rk1/;" v module:modchem -rk1 src/addon/modchem.f90 /^ real, allocatable :: rk1(/;" v module:modchem rk1 src/modchem.f90 /^ real, allocatable :: rk1(/;" v module:modchem -rk2 src/addon/modchem.f90 /^ real, allocatable :: rk1(:,:),rk2(/;" v module:modchem rk2 src/modchem.f90 /^ real, allocatable :: rk1(:,:),rk2(/;" v module:modchem rk3 src/addon/modparticles.f90 /^ subroutine rk3(/;" s module:modparticles rk3step src/modglobal.f90 /^ integer :: rk3step /;" v module:modglobal @@ -3101,7 +2655,6 @@ rlimit src/modradfull.f90 /^ real :: llimit, rlimit,/;" k ty rlimit src/modradfull.f90 /^ elemental real function rlimit(/;" f module:modradfull rlv src/modglobal.f90 /^ real,parameter :: rlv /;" v module:modglobal rlvocp src/modglobal.f90 /^ real,parameter :: rlvocp /;" v module:modglobal -rname src/addon/modchem.f90 /^ character*6 rname$/;" k type:RCdef rname src/modchem.f90 /^ character*6 rname$/;" k type:RCdef rnu0 src/modboundary.f90 /^ real :: rnu0 /;" v module:modboundary rootf src/modsurfdata.f90 /^ real, allocatable :: rootf /;" v module:modsurfdata @@ -3197,8 +2750,6 @@ rstre src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: rstrb, rsveg src/modsurfdata.f90 /^ real, allocatable :: rsveg /;" v module:modsurfdata rsveg_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cliq_patch, wl_patch, rsveg_patch,/;" v module:modtimestat rtimee src/modglobal.f90 /^ real :: rtimee /;" v module:modglobal -rtol src/addon/modchem.f90 /^ real rtol$/;" k type:Name_Number -rtol src/addon/modchem.f90 /^ real, allocatable :: atol(:),rtol(/;" v module:modchem rtol src/modchem.f90 /^ real rtol$/;" k type:Name_Number rtol src/modchem.f90 /^ real, allocatable :: atol(:),rtol(/;" v module:modchem rtrn src/rrtmg_lw_rtrn.f90 /^ subroutine rtrn(/;" s module:rrtmg_lw_rtrn @@ -3207,71 +2758,48 @@ runtime src/modglobal.f90 /^ real :: runtime /;" v module:modglobal rv src/modglobal.f90 /^ real,parameter :: rv /;" v module:modglobal rwgt src/rrlw_wvn.f90 /^ real(kind=rb) :: rwgt(/;" v module:rrlw_wvn rwgt src/rrsw_wvn.f90 /^ real(kind=rb) :: rwgt(/;" v module:rrsw_wvn -sampling src/addon/modsampling.f90 /^ subroutine sampling$/;" s module:modsampling sampling src/modsampling.f90 /^ subroutine sampling$/;" s module:modsampling -samplname src/addon/modsampling.f90 /^ character(20),dimension(10) :: samplname,/;" v module:modsampling samplname src/modquadrant.f90 /^ character(30),dimension(4) :: samplname,/;" v module:modquadrant samplname src/modsampling.f90 /^ character(20),dimension(10) :: samplname,/;" v module:modsampling samplname src/modsamptend.f90 /^ character(20),dimension(10) :: samplname,/;" v module:modsamptend samptend src/modsamptend.f90 /^ subroutine samptend(/;" s module:modsamptend -sbbudgmn src/addon/modbudget.f90 /^ real, allocatable :: sbbudgmn(/;" v module:modbudget sbbudgmn src/modbudget.f90 /^ real, allocatable :: sbbudgmn(/;" v module:modbudget sbbuo src/modsubgriddata.f90 /^ real, allocatable :: sbbuo(/;" v module:modsubgriddata -sbbuomn src/addon/modbudget.f90 /^ real, allocatable :: sbbuomn(/;" v module:modbudget sbbuomn src/modbudget.f90 /^ real, allocatable :: sbbuomn(/;" v module:modbudget sbcnst src/rrlw_con.f90 /^ real(kind=rb) :: sbcnst,/;" v module:rrlw_con sbcnst src/rrsw_con.f90 /^ real(kind=rb) :: sbcnst,/;" v module:rrsw_con sbdiss src/modsubgriddata.f90 /^ real, allocatable :: sbdiss(/;" v module:modsubgriddata -sbdissmn src/addon/modbudget.f90 /^ real, allocatable :: sbdissmn(/;" v module:modbudget sbdissmn src/modbudget.f90 /^ real, allocatable :: sbdissmn(/;" v module:modbudget -sbresidmn src/addon/modbudget.f90 /^ real, allocatable :: sbresidmn(/;" v module:modbudget sbresidmn src/modbudget.f90 /^ real, allocatable :: sbresidmn(/;" v module:modbudget sbshr src/modsubgriddata.f90 /^ real, allocatable :: sbshr(/;" v module:modsubgriddata -sbshrmn src/addon/modbudget.f90 /^ real, allocatable :: sbshrmn(/;" v module:modbudget sbshrmn src/modbudget.f90 /^ real, allocatable :: sbshrmn(/;" v module:modbudget -sbstormn src/addon/modbudget.f90 /^ real, allocatable :: sbstormn(/;" v module:modbudget sbstormn src/modbudget.f90 /^ real, allocatable :: sbstormn(/;" v module:modbudget -sbtkeav src/addon/modbudget.f90 /^ real, allocatable :: sbtkeav(/;" v module:modbudget sbtkeav src/modbudget.f90 /^ real, allocatable :: sbtkeav(/;" v module:modbudget -sbtkeb src/addon/modbudget.f90 /^ real, allocatable :: sbtkeb(/;" v module:modbudget sbtkeb src/modbudget.f90 /^ real, allocatable :: sbtkeb(/;" v module:modbudget -sbtkemn src/addon/modbudget.f90 /^ real, allocatable :: sbtkemn(/;" v module:modbudget sbtkemn src/modbudget.f90 /^ real, allocatable :: sbtkemn(/;" v module:modbudget sc src/addon/modbulkmicrodata.f90 /^ ,sc /;" v module:modbulkmicrodata sc src/modmicrodata.f90 /^ ,sc /;" v module:modmicrodata scalintp src/addon/modparticles.f90 /^ function scalintp(/;" f module:modparticles -scon src/modraddata.f90 /^ real :: scon /;" v module:modraddata +scon src/modraddata.f90 /^ real :: scon$/;" v module:modraddata secdy src/rrlw_con.f90 /^ real(kind=rb) :: sbcnst, secdy$/;" v module:rrlw_con secdy src/rrsw_con.f90 /^ real(kind=rb) :: sbcnst, secdy$/;" v module:rrsw_con sed_Nr src/addon/modbulkmicrodata.f90 /^ sed_qr, & !< sedimentation rain drops mix. ratio$/;" v module:modbulkmicrodata sed_Nr src/modmicrodata.f90 /^ sed_qr, & !< sedimentation rain drops mix. ratio$/;" v module:modmicrodata -sed_flux src/addon/modbulkmicro.f90 /^ real function sed_flux(/;" f module:modbulkmicro sed_flux src/modbulkmicro.f90 /^ real function sed_flux(/;" f module:modbulkmicro sed_qr src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: sedc, & !< sedimentation cloud droplets mix. ratio$/;" v module:modbulkmicrodata sed_qr src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: sedc, & !< sedimentation cloud droplets mix. ratio$/;" v module:modmicrodata sedc src/addon/modbulkmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: sedc,/;" v module:modbulkmicrodata sedc src/modmicrodata.f90 /^ real,allocatable, dimension(:,:,:) :: sedc,/;" v module:modmicrodata -sedimentation_cloud src/addon/modbulkmicro.f90 /^ subroutine sedimentation_cloud$/;" s module:modbulkmicro sedimentation_cloud src/modbulkmicro.f90 /^ subroutine sedimentation_cloud$/;" s module:modbulkmicro -sedimentation_rain src/addon/modbulkmicro.f90 /^ subroutine sedimentation_rain$/;" s module:modbulkmicro sedimentation_rain src/modbulkmicro.f90 /^ subroutine sedimentation_rain$/;" s module:modbulkmicro -seg_conc src/addon/modchem.f90 /^ real, allocatable :: seg_conc(/;" v module:modchem seg_conc src/modchem.f90 /^ real, allocatable :: seg_conc(/;" v module:modchem -seg_conc_mult src/addon/modchem.f90 /^ real, allocatable :: seg_conc_mult(/;" v module:modchem seg_conc_mult src/modchem.f90 /^ real, allocatable :: seg_conc_mult(/;" v module:modchem -seg_conc_mult_vert src/addon/modchem.f90 /^ real, allocatable :: seg_conc_mult_vert(/;" v module:modchem seg_conc_mult_vert src/modchem.f90 /^ real, allocatable :: seg_conc_mult_vert(/;" v module:modchem -seg_conc_prod src/addon/modchem.f90 /^ real, allocatable :: seg_conc_prod(/;" v module:modchem seg_conc_prod src/modchem.f90 /^ real, allocatable :: seg_conc_prod(/;" v module:modchem -seg_conc_prod_vert src/addon/modchem.f90 /^ real, allocatable :: seg_conc_prod_vert(/;" v module:modchem seg_conc_prod_vert src/modchem.f90 /^ real, allocatable :: seg_conc_prod_vert(/;" v module:modchem -seg_conc_prodl src/addon/modchem.f90 /^ real, allocatable :: seg_conc_prodl(/;" v module:modchem seg_conc_prodl src/modchem.f90 /^ real, allocatable :: seg_conc_prodl(/;" v module:modchem -seg_concl src/addon/modchem.f90 /^ real, allocatable :: seg_concl(/;" v module:modchem seg_concl src/modchem.f90 /^ real, allocatable :: seg_concl(/;" v module:modchem -segregation src/addon/modchem.f90 /^ real, allocatable :: segregation(/;" v module:modchem segregation src/modchem.f90 /^ real, allocatable :: segregation(/;" v module:modchem -segregation_vert src/addon/modchem.f90 /^ real, allocatable :: segregation_vert(/;" v module:modchem segregation_vert src/modchem.f90 /^ real, allocatable :: segregation_vert(/;" v module:modchem select_bandg src/modradfull.f90 /^ subroutine select_bandg(/;" s module:modradfull select_gas src/modradfull.f90 /^ subroutine select_gas /;" s module:modradfull @@ -3369,9 +2897,7 @@ shr_orb_decl src/shr_orb_mod.f90 /^ SUBROUTINE shr_orb_decl(/;" s module:shr_or shr_orb_mod src/shr_orb_mod.f90 /^MODULE shr_orb_mod$/;" m shr_orb_params src/shr_orb_mod.f90 /^SUBROUTINE shr_orb_params(/;" s module:shr_orb_mod shr_orb_print src/shr_orb_mod.f90 /^SUBROUTINE shr_orb_print(/;" s module:shr_orb_mod -shrmn src/addon/modbudget.f90 /^ real, allocatable :: shrmn(/;" v module:modbudget shrmn src/modbudget.f90 /^ real, allocatable :: shrmn(/;" v module:modbudget -sig_el src/addon/modsampling.f90 /^ real,allocatable, dimension(:,:) :: w_el,sig_el$/;" v module:modsampling sig_g src/addon/modbulkmicrodata.f90 /^ ,sig_g /;" v module:modbulkmicrodata sig_g src/modmicrodata.f90 /^ ,sig_g /;" v module:modmicrodata sig_gr src/addon/modbulkmicrodata.f90 /^ ,sig_gr /;" v module:modbulkmicrodata @@ -3382,7 +2908,6 @@ sigma2_sgs src/addon/modparticles.f90 /^ real ::sigma2_sgs$/;" k type:particl simpleice src/modsimpleice.f90 /^ subroutine simpleice$/;" s module:modsimpleice simpleicestat src/modsimpleicestat.f90 /^ subroutine simpleicestat$/;" s module:modsimpleicestat simpleicetend src/modsimpleicestat.f90 /^ subroutine simpleicetend$/;" s module:modsimpleicestat -skewmn src/addon/modgenstat.f90 /^ real, allocatable :: w2mn (:), skewmn /;" v module:modgenstat skewmn src/modgenstat.f90 /^ real, allocatable :: w2mn (:), skewmn /;" v module:modgenstat slabsum src/modmpi.f90 /^ subroutine slabsum(/;" s module:modmpi slicex src/addon/modnetcdfmovie.f90 /^ integer :: slicex /;" v module:modnetcdfmovie @@ -3404,12 +2929,10 @@ startfilepart src/addon/modparticles.f90 /^ character(30) :: startfilepart$/;" startup src/modstartup.f90 /^ subroutine startup$/;" s module:modstartup state src/rad_rndnmb.f90 /^ integer, dimension(0:blockSize -1) :: state /;" k type:randomNumberSequence statistics src/addon/modparticles.f90 /^ subroutine statistics$/;" s module:modparticles -stattend src/addon/modstattend.f90 /^ subroutine stattend(/;" s module:modstattend stattend src/modstattend.f90 /^ subroutine stattend(/;" s module:modstattend status src/rrlw_ncpar.f90 /^ integer(kind=im), dimension(40) :: status$/;" v module:rrlw_ncpar -status src/rrsw_ncpar.f90 /^ integer(kind=im), dimension(50) :: status$/;" v module:rrsw_ncpar +status src/rrsw_ncpar.f90 /^ integer(kind=im), dimension(50) :: status$/;" v module:rrsw_ncpar store_zi src/modtimestat.f90 /^ logical:: store_zi /;" v module:modtimestat -stormn src/addon/modbudget.f90 /^ real, allocatable :: stormn(/;" v module:modbudget stormn src/modbudget.f90 /^ real, allocatable :: stormn(/;" v module:modbudget str_budg src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: str_budg /;" v module:modstress str_res src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: str_res /;" v module:modstress @@ -3423,32 +2946,22 @@ surf_user src/moduser.f90 /^subroutine surf_user$/;" s module:moduser surface src/modsurface.f90 /^ subroutine surface$/;" s module:modsurface sv0 src/modfields.f90 /^ real, allocatable :: sv0(/;" v module:modfields sv0av src/modfields.f90 /^ real, allocatable :: sv0av(/;" v module:modfields -sv2mn src/addon/modgenstat.f90 /^ real, allocatable :: sv2mn(/;" v module:modgenstat sv2mn src/modgenstat.f90 /^ real, allocatable :: sv2mn(/;" v module:modgenstat -svavgid src/addon/modheterostats.f90 /^ integer, allocatable :: svavgid(/;" v module:modheterostats svavgid src/modheterostats.f90 /^ integer, allocatable :: svavgid(/;" v module:modheterostats svavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:,:) :: svavl,/;" v module:modquadrant svflux src/modsurfdata.f90 /^ real, allocatable :: svflux /;" v module:modsurfdata svm src/modfields.f90 /^ real, allocatable :: svm(/;" v module:modfields -svmav src/addon/modgenstat.f90 /^ real, allocatable :: svmav /;" v module:modgenstat svmav src/modgenstat.f90 /^ real, allocatable :: svmav /;" v module:modgenstat -svmmn src/addon/modgenstat.f90 /^ real, allocatable :: svmmn(/;" v module:modgenstat svmmn src/modgenstat.f90 /^ real, allocatable :: svmmn(/;" v module:modgenstat svp src/modfields.f90 /^ real, allocatable :: svp(/;" v module:modfields -svpav src/addon/modgenstat.f90 /^ real, allocatable :: svpav(/;" v module:modgenstat svpav src/modgenstat.f90 /^ real, allocatable :: svpav(/;" v module:modgenstat -svplsmn src/addon/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(:,:),svplsmn(/;" v module:modgenstat svplsmn src/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(:,:),svplsmn(/;" v module:modgenstat -svpmn src/addon/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(:,:),svplsmn(:,:),svpmn(/;" v module:modgenstat svpmn src/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(:,:),svplsmn(:,:),svpmn(/;" v module:modgenstat svprof src/modfields.f90 /^ real, allocatable :: svprof(/;" v module:modfields -svptav src/addon/modgenstat.f90 /^ real, allocatable :: svptav(/;" v module:modgenstat svptav src/modgenstat.f90 /^ real, allocatable :: svptav(/;" v module:modgenstat -svptmn src/addon/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(/;" v module:modgenstat svptmn src/modgenstat.f90 /^ real, allocatable :: svmmn(:,:),svptmn(/;" v module:modgenstat svs src/modsurfdata.f90 /^ real, allocatable :: svs /;" v module:modsurfdata svst src/modtimedepsv.f90 /^ real, allocatable :: svst /;" v module:modtimedepsv -svvarid src/addon/modheterostats.f90 /^ integer, allocatable :: svvarid(/;" v module:modheterostats svvarid src/modheterostats.f90 /^ integer, allocatable :: svvarid(/;" v module:modheterostats svvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:,:) :: svavl,svvarl$/;" v module:modquadrant svzt src/modtimedepsv.f90 /^ real, allocatable :: svzt(/;" v module:modtimedepsv @@ -3465,27 +2978,24 @@ sw_kgb18 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb18$/;" s sw_kgb19 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb19$/;" s sw_kgb20 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb20$/;" s sw_kgb21 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb21$/;" s -sw_kgb22 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb22 /;" s -sw_kgb23 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb23 /;" s -sw_kgb24 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb24 /;" s -sw_kgb25 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb25 /;" s +sw_kgb22 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb22$/;" s +sw_kgb23 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb23$/;" s +sw_kgb24 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb24$/;" s +sw_kgb25 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb25$/;" s sw_kgb26 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb26$/;" s sw_kgb27 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb27$/;" s -sw_kgb28 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb28 /;" s -sw_kgb29 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb29 /;" s +sw_kgb28 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb28$/;" s +sw_kgb29 src/rrtmg_sw_read_nc.f90 /^subroutine sw_kgb29$/;" s swaerpr src/rrtmg_sw_init.f90 /^ subroutine swaerpr$/;" s module:rrtmg_sw_init swatmref src/rrtmg_sw_setcoef.f90 /^ subroutine swatmref$/;" s module:rrtmg_sw_setcoef swcldpr src/rrtmg_sw_init.f90 /^ subroutine swcldpr$/;" s module:rrtmg_sw_init swcmbdat src/rrtmg_sw_init.f90 /^ subroutine swcmbdat$/;" s module:rrtmg_sw_init swd src/modraddata.f90 /^ real, allocatable :: swd(/;" v module:modraddata swdatinit src/rrtmg_sw_init.f90 /^ subroutine swdatinit(/;" s module:rrtmg_sw_init -swdav src/addon/modradstat.f90 /^ real, allocatable :: swdav(/;" v module:modradstat swdav src/modradstat.f90 /^ real, allocatable :: swdav(/;" v module:modradstat swdavn src/modsurfdata.f90 /^ real, allocatable :: swdavn /;" v module:modsurfdata swdca src/modraddata.f90 /^ real, allocatable :: swdca(/;" v module:modraddata -swdcaav src/addon/modradstat.f90 /^ real, allocatable :: swdcaav(/;" v module:modradstat swdcaav src/modradstat.f90 /^ real, allocatable :: swdcaav(/;" v module:modradstat -swdcamn src/addon/modradstat.f90 /^ real, allocatable :: swdcamn(/;" v module:modradstat swdcamn src/modradstat.f90 /^ real, allocatable :: swdcamn(/;" v module:modradstat swdif src/modraddata.f90 /^ real, allocatable :: swdif(/;" v module:modraddata swdifav src/modradstat.f90 /^ real, allocatable :: swdifav(/;" v module:modradstat @@ -3493,22 +3003,17 @@ swdifmn src/modradstat.f90 /^ real, allocatable :: swdifmn(/;" v module:modrads swdir src/modraddata.f90 /^ real, allocatable :: swdir(/;" v module:modraddata swdirav src/modradstat.f90 /^ real, allocatable :: swdirav(/;" v module:modradstat swdirmn src/modradstat.f90 /^ real, allocatable :: swdirmn(/;" v module:modradstat -swdmn src/addon/modradstat.f90 /^ real, allocatable :: swdmn(/;" v module:modradstat swdmn src/modradstat.f90 /^ real, allocatable :: swdmn(/;" v module:modradstat -switch src/addon/modchem.f90 /^ logical switch$/;" v module:modchem switch src/modchem.f90 /^ logical switch$/;" v module:modchem swu src/modraddata.f90 /^ real, allocatable :: swu(/;" v module:modraddata -swuav src/addon/modradstat.f90 /^ real, allocatable :: swuav(/;" v module:modradstat swuav src/modradstat.f90 /^ real, allocatable :: swuav(/;" v module:modradstat swuavn src/modsurfdata.f90 /^ real, allocatable :: swuavn /;" v module:modsurfdata swuca src/modraddata.f90 /^ real, allocatable :: swuca(/;" v module:modraddata -swucaav src/addon/modradstat.f90 /^ real, allocatable :: swucaav(/;" v module:modradstat swucaav src/modradstat.f90 /^ real, allocatable :: swucaav(/;" v module:modradstat -swucamn src/addon/modradstat.f90 /^ real, allocatable :: swucamn(/;" v module:modradstat swucamn src/modradstat.f90 /^ real, allocatable :: swucamn(/;" v module:modradstat -swumn src/addon/modradstat.f90 /^ real, allocatable :: swumn(/;" v module:modradstat swumn src/modradstat.f90 /^ real, allocatable :: swumn(/;" v module:modradstat -t_ref src/addon/modchem.f90 /^ real t_ref,/;" v module:modchem +t0 src/program.f90 /^ real :: t0,/;" v program:DALES +t2 src/program.f90 /^ real :: t0,t2$/;" v program:DALES t_ref src/modchem.f90 /^ real t_ref,/;" v module:modchem tabs_slice src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: tabs_slice,/;" v module:modraddata tadv src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tadv /;" v module:modstress @@ -3550,11 +3055,41 @@ taumol27 src/rrtmg_sw_taumol.f90 /^ subroutine taumol27$/;" s subroutine:ta taumol28 src/rrtmg_sw_taumol.f90 /^ subroutine taumol28$/;" s subroutine:taumol_sw taumol29 src/rrtmg_sw_taumol.f90 /^ subroutine taumol29$/;" s subroutine:taumol_sw taumol_sw src/rrtmg_sw_taumol.f90 /^ subroutine taumol_sw(/;" s module:rrtmg_sw_taumol +tb_Qnet src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts, tb_z0h, tb_z0m, tb_alb, tb_Qnet$/;" v module:modtestbed +tb_alb src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts, tb_z0h, tb_z0m, tb_alb,/;" v module:modtestbed +tb_dqtdxls src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,tb_qt,tb_ug,tb_vg, &$/;" v module:modtestbed +tb_dqtdyls src/modtestbed.f90 /^ tb_dqtdxls,tb_dqtdyls,/;" v module:modtestbed +tb_phiwav src/modtestbed.f90 /^ tb_tsoilav,tb_phiwav,/;" v module:modtestbed +tb_ps src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps,/;" v module:modtestbed +tb_qt src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,tb_qt,/;" v module:modtestbed +tb_qtadv src/modtestbed.f90 /^ tb_dqtdxls,tb_dqtdyls, &$/;" v module:modtestbed +tb_qts src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts,/;" v module:modtestbed +tb_taunudge src/modtestbed.f90 /^ real :: tb_taunudge /;" v module:modtestbed +tb_thl src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,/;" v module:modtestbed +tb_thladv src/modtestbed.f90 /^ tb_qtadv,tb_thladv,/;" v module:modtestbed +tb_thls src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls,/;" v module:modtestbed +tb_time src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time,/;" v module:modtestbed +tb_tsoilav src/modtestbed.f90 /^ tb_qtadv,tb_thladv,tb_uadv,tb_vadv, &$/;" v module:modtestbed +tb_u src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,/;" v module:modtestbed +tb_uadv src/modtestbed.f90 /^ tb_qtadv,tb_thladv,tb_uadv,/;" v module:modtestbed +tb_ug src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,tb_qt,tb_ug,/;" v module:modtestbed +tb_v src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,/;" v module:modtestbed +tb_vadv src/modtestbed.f90 /^ tb_qtadv,tb_thladv,tb_uadv,tb_vadv,/;" v module:modtestbed +tb_vg src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,tb_thl,tb_qt,tb_ug,tb_vg,/;" v module:modtestbed +tb_w src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,tb_u,tb_v,tb_w,/;" v module:modtestbed +tb_wqs src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs,/;" v module:modtestbed +tb_wts src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts,/;" v module:modtestbed +tb_z0h src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts, tb_z0h,/;" v module:modtestbed +tb_z0m src/modtestbed.f90 /^ real, dimension(:) , allocatable :: tb_time, tb_ps, tb_qts, tb_thls, tb_wqs, tb_wts, tb_z0h, tb_z0m,/;" v module:modtestbed tbase src/modradfull.f90 /^ real :: mweight, default_conc, tbase$/;" k type:ckd_properties tblint src/rrlw_tbl.f90 /^ real(kind=rb), parameter :: tblint /;" v module:rrlw_tbl tblint src/rrsw_tbl.f90 /^ real(kind=rb), parameter :: tblint /;" v module:rrsw_tbl +tbrad_o3 src/modtestbed.f90 /^ tbrad_p, tbrad_t, tbrad_qv, tbrad_ql, tbrad_o3$/;" v module:modtestbed +tbrad_p src/modtestbed.f90 /^ tb_tsoilav,tb_phiwav, &$/;" v module:modtestbed +tbrad_ql src/modtestbed.f90 /^ tbrad_p, tbrad_t, tbrad_qv, tbrad_ql,/;" v module:modtestbed +tbrad_qv src/modtestbed.f90 /^ tbrad_p, tbrad_t, tbrad_qv,/;" v module:modtestbed +tbrad_t src/modtestbed.f90 /^ tbrad_p, tbrad_t,/;" v module:modtestbed tbuo src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tbuo /;" v module:modstress -tcheck src/addon/modchecksim.f90 /^ real :: tcheck /;" v module:modchecksim tcheck src/modchecksim.f90 /^ real :: tcheck /;" v module:modchecksim tcor src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tcor /;" v module:modstress tderive src/modpois.f90 /^ subroutine tderive$/;" s module:modpois @@ -3565,40 +3100,28 @@ tdnsg src/modmicrodata.f90 /^ ,tdnsg=/;" v module:modmicrodata temp_b src/modradfull.f90 /^ real, allocatable :: temp_b(/;" v module:modradfull temper src/rad_rndnmb.f90 /^ function temper(/;" f module:RandomNumbers tempskin src/modradfull.f90 /^ real, allocatable :: tempskin(/;" v module:modradfull -tend_addon src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=/;" v module:modstattend tend_addon src/modsamptend.f90 /^ tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=/;" v module:modsamptend tend_addon src/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=/;" v module:modstattend -tend_adv src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=/;" v module:modstattend tend_adv src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=1,tend_adv=/;" v module:modsamptend tend_adv src/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=/;" v module:modstattend -tend_coriolis src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=10, tend_coriolis=/;" v module:modstattend tend_coriolis src/modsamptend.f90 /^ tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=10, tend_coriolis=/;" v module:modsamptend tend_coriolis src/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=10, tend_coriolis=/;" v module:modstattend -tend_force src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=/;" v module:modstattend tend_force src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=/;" v module:modsamptend tend_force src/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=/;" v module:modstattend -tend_ls src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=/;" v module:modstattend tend_ls src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=4,tend_rad=5,&$/;" v module:modsamptend tend_ls src/modstattend.f90 /^ tend_rad=5,tend_ls=/;" v module:modstattend -tend_micro src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=/;" v module:modstattend tend_micro src/modsamptend.f90 /^ tend_ls=6,tend_micro=/;" v module:modsamptend tend_micro src/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=/;" v module:modstattend -tend_pois src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=/;" v module:modstattend tend_pois src/modsamptend.f90 /^ tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=/;" v module:modsamptend tend_pois src/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=/;" v module:modstattend -tend_rad src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=4,&$/;" v module:modstattend tend_rad src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=4,tend_rad=/;" v module:modsamptend tend_rad src/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=3,tend_force=4,&$/;" v module:modstattend -tend_start src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=/;" v module:modstattend tend_start src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=/;" v module:modsamptend tend_start src/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=/;" v module:modstattend -tend_subg src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=/;" v module:modstattend tend_subg src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=/;" v module:modsamptend tend_subg src/modstattend.f90 /^ integer,parameter :: tend_tot=1,tend_start=1,tend_adv=2,tend_subg=/;" v module:modstattend -tend_topbound src/addon/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=/;" v module:modstattend tend_topbound src/modsamptend.f90 /^ tend_ls=6,tend_micro=7, tend_topbound=/;" v module:modsamptend tend_topbound src/modstattend.f90 /^ tend_rad=5,tend_ls=6,tend_micro=7, tend_topbound=/;" v module:modstattend -tend_tot src/addon/modstattend.f90 /^ integer,parameter :: tend_tot=/;" v module:modstattend tend_tot src/modsamptend.f90 /^ integer,public,parameter :: tend_tot=/;" v module:modsamptend tend_tot src/modstattend.f90 /^ integer,parameter :: tend_tot=/;" v module:modstattend tend_totlb src/modsamptend.f90 /^ tend_ls=6,tend_micro=7, tend_topbound=8,tend_pois=9,tend_addon=10, tend_coriolis=11, tend_totlb=/;" v module:modsamptend @@ -3606,12 +3129,12 @@ tendmask src/modsamptend.f90 /^ logical, allocatable :: tendmask(/;" v module:m tendskin src/modsurfdata.f90 /^ real, allocatable :: tendskin /;" v module:modsurfdata tendskin_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_patch, H_patch, LE_patch, G0_patch, tendskin_patch,/;" v module:modtimestat tendskinid src/addon/modnetcdfmovie.f90 /^ integer :: Hid, LEid, G0id, tendskinid,/;" v module:modnetcdfmovie +testbed_getinttime src/modtestbed.f90 /^ subroutine testbed_getinttime(/;" s module:modtestbed +testbednudge src/modtestbed.f90 /^ subroutine testbednudge$/;" s module:modtestbed tfn_tbl src/rrlw_tbl.f90 /^ real(kind=rb) , dimension(0:ntbl) :: tfn_tbl$/;" v module:rrlw_tbl tg_slice src/modraddata.f90 /^ real,allocatable,dimension(:) :: tg_slice /;" v module:modraddata -th0av src/addon/modgenstat.f90 /^ real, allocatable :: th0av(/;" v module:modgenstat th0av src/modgenstat.f90 /^ real, allocatable :: th0av(/;" v module:modgenstat th0av src/modthermodynamics.f90 /^ real, allocatable :: th0av(/;" v module:modthermodynamics -th2mn src/addon/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(:), th2mn(/;" v module:modgenstat th2mn src/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(:), th2mn(/;" v module:modgenstat thermo src/modthermodynamics.f90 /^ subroutine thermo /;" s module:modthermodynamics thermodynamics src/modthermodynamics.f90 /^ subroutine thermodynamics$/;" s module:modthermodynamics @@ -3620,11 +3143,9 @@ thicks src/modradfull.f90 /^ subroutine thicks(/;" s module:modradfull thl0 src/modfields.f90 /^ real, allocatable :: thl0(/;" v module:modfields thl0av src/modfields.f90 /^ real, allocatable :: thl0av(/;" v module:modfields thl0h src/modfields.f90 /^ real, allocatable :: thl0h(/;" v module:modfields -thl2mn src/addon/modgenstat.f90 /^ real, allocatable :: thl2mn /;" v module:modgenstat thl2mn src/modgenstat.f90 /^ real, allocatable :: thl2mn /;" v module:modgenstat thla src/addon/modtilt.f90 /^ real, allocatable :: thla(/;" v module:modtilt thlaav src/addon/modtilt.f90 /^ real, allocatable :: thlaav(/;" v module:modtilt -thlavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid,/;" v module:modheterostats thlavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid,/;" v module:modnetcdfstats thlavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid,/;" v module:modheterostats thlavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,wavl,utotavl,thlavl,/;" v module:modquadrant @@ -3641,28 +3162,22 @@ thlidmovie src/addon/modnetcdfstats.f90 /^ integer :: uidmovie, vidmovie, widmo thllwtendav src/modradstat.f90 /^ real, allocatable :: thllwtendav(/;" v module:modradstat thllwtendmn src/modradstat.f90 /^ real, allocatable :: thllwtendmn(/;" v module:modradstat thlm src/modfields.f90 /^ real, allocatable :: thlm(/;" v module:modfields -thlmav src/addon/modgenstat.f90 /^ real, allocatable :: thlmav /;" v module:modgenstat thlmav src/modgenstat.f90 /^ real, allocatable :: thlmav /;" v module:modgenstat -thlmn src/addon/modgenstat.f90 /^ real, allocatable :: thlmn /;" v module:modgenstat thlmn src/modgenstat.f90 /^ real, allocatable :: thlmn /;" v module:modgenstat -thlnudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,thlnudge,/;" v module:modnudge thlnudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,thlnudge,/;" v module:modnudge thlp src/modfields.f90 /^ real, allocatable :: thlp(/;" v module:modfields -thlpav src/addon/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(:,:),thlpav(/;" v module:modstattend thlpav src/modsamptend.f90 /^ real, allocatable :: upav(:,:,:),vpav(:,:,:),wpav(:,:,:),thlpav(/;" v module:modsamptend thlpav src/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(:,:),thlpav(/;" v module:modstattend thlpcar src/modfields.f90 /^ real, allocatable :: thlpcar(/;" v module:modfields thlpcart src/modtimedep.f90 /^ real, allocatable :: thlpcart(/;" v module:modtimedep thlpmcr src/addon/modbulkmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,qrp,thlpmcr,/;" v module:modbulkmicrodata thlpmcr src/modmicrodata.f90 /^ real,allocatable,dimension(:,:,:) :: Nr,Nrp,qltot,qr,qrp,thlpmcr,/;" v module:modmicrodata -thlpmn src/addon/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(:,:),wpmn(:,:),thlpmn(/;" v module:modstattend thlpmn src/modsamptend.f90 /^ real, allocatable :: upmn(:,:,:),vpmn(:,:,:),wpmn(:,:,:),thlpmn(/;" v module:modsamptend thlpmn src/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(:,:),wpmn(:,:),thlpmn(/;" v module:modstattend thlprad src/modraddata.f90 /^ real, allocatable :: thlprad(/;" v module:modraddata thlprof src/modfields.f90 /^ real, allocatable :: thlprof(/;" v module:modfields thlproft src/modtimedep.f90 /^ real, allocatable :: thlproft(/;" v module:modtimedep thlptm src/modsamptend.f90 /^ real, allocatable :: uptm(:,:,:),vptm(:,:,:),wptm(:,:,:),thlptm(/;" v module:modsamptend -thlqcovid src/addon/modheterostats.f90 /^ integer :: thlqcovid$/;" v module:modheterostats thlqcovid src/addon/modnetcdfstats.f90 /^ integer :: thlqcovid$/;" v module:modnetcdfstats thlqcovid src/modheterostats.f90 /^ integer :: thlqcovid$/;" v module:modheterostats thlqtcovl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: thlqtcovl$/;" v module:modquadrant @@ -3676,38 +3191,28 @@ thlswtendav src/modradstat.f90 /^ real, allocatable :: thlswtendav(/;" v module thlswtendmn src/modradstat.f90 /^ real, allocatable :: thlswtendmn(/;" v module:modradstat thltendav src/modradstat.f90 /^ real, allocatable :: thltendav(/;" v module:modradstat thltendmn src/modradstat.f90 /^ real, allocatable :: thltendmn(/;" v module:modradstat -thlvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid,/;" v module:modheterostats thlvarid src/addon/modnetcdfstats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid,/;" v module:modnetcdfstats thlvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid,/;" v module:modheterostats thlvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,vvarl,wvarl,utotvarl,thlvarl,/;" v module:modquadrant -thmav src/addon/modgenstat.f90 /^ real, allocatable :: thmav /;" v module:modgenstat thmav src/modgenstat.f90 /^ real, allocatable :: thmav /;" v module:modgenstat -thptav src/addon/modgenstat.f90 /^ real, allocatable :: thptav(/;" v module:modgenstat thptav src/modgenstat.f90 /^ real, allocatable :: thptav(/;" v module:modgenstat thres src/modglobal.f90 /^ real :: thres /;" v module:modglobal thv0 src/modthermodynamics.f90 /^ real, allocatable :: thv0(/;" v module:modthermodynamics thv0h src/modfields.f90 /^ real, allocatable :: thv0h(/;" v module:modfields -thv2mn src/addon/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(/;" v module:modgenstat thv2mn src/modgenstat.f90 /^ real, allocatable :: thl2mn (:), thv2mn(/;" v module:modgenstat -thvavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid,/;" v module:modheterostats thvavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid, thlavgid, thvavgid,/;" v module:modheterostats thvf src/modfields.f90 /^ real, allocatable :: thvf(/;" v module:modfields thvfavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,/;" v module:modsampling thvh src/modfields.f90 /^ real, allocatable :: thvh(/;" v module:modfields -thvhav src/addon/modgenstat.f90 /^ real, allocatable :: thvhav(/;" v module:modgenstat thvhav src/modgenstat.f90 /^ real, allocatable :: thvhav(/;" v module:modgenstat -thvhavl src/addon/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,thvhavl,/;" v module:modsampling thvhavl src/modsampling.f90 /^ duwdxhavl,dtaudxhavl,dtaudzhavl,thvhavl,/;" v module:modsampling -thvmn src/addon/modgenstat.f90 /^ real, allocatable :: thlmn (:) ,thvmn /;" v module:modgenstat thvmn src/modgenstat.f90 /^ real, allocatable :: thlmn (:) ,thvmn /;" v module:modgenstat thvs src/modsurfdata.f90 /^ real :: thvs /;" v module:modsurfdata thvs_patch src/modsurfdata.f90 /^ real, allocatable :: thvs_patch(/;" v module:modsurfdata -thvvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid,/;" v module:modheterostats thvvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid, thlvarid, thvvarid,/;" v module:modheterostats -tid src/addon/modheterostats.f90 /^ integer :: xid, yid, zid, tid /;" v module:modheterostats tid src/addon/modnetcdfmovie.f90 /^ integer :: xid, yid, zid, tid$/;" v module:modnetcdfmovie tid src/addon/modnetcdfstats.f90 /^ integer :: xid, yid, zid, tid$/;" v module:modnetcdfstats -tid src/modheterostats.f90 /^ integer :: xid, yid, zid, tid /;" v module:modheterostats +tid src/modheterostats.f90 /^ integer :: xid, yid, zid, tid$/;" v module:modheterostats tidfieldqt src/addon/modnetcdfstats.f90 /^ integer :: xidfieldqt, yidfieldqt, zidfieldqt, tidfieldqt$/;" v module:modnetcdfstats tidfieldthl src/addon/modnetcdfstats.f90 /^ integer :: xidfieldthl, yidfieldthl, zidfieldthl, tidfieldthl$/;" v module:modnetcdfstats tidfieldu src/addon/modnetcdfstats.f90 /^ integer :: xidfieldu, yidfieldu, zidfieldu, tidfieldu$/;" v module:modnetcdfstats @@ -3717,16 +3222,9 @@ tidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie, zidmovi tiltedboundary src/addon/modtilt.f90 /^ subroutine tiltedboundary$/;" s module:modtilt tiltedgravity src/addon/modtilt.f90 /^ subroutine tiltedgravity$/;" s module:modtilt tiltstat src/addon/modtilt.f90 /^ subroutine tiltstat$/;" s module:modtilt -timeID src/addon/modstat_nc.f90 /^ integer, save :: timeID=/;" v module:modstat_nc timeID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=/;" v module:modstat_nc timeID src/modstat_nc.f90 /^ integer, save :: timeID=/;" v module:modstat_nc -timeav src/addon/modbudget.f90 /^ real :: dtav, timeav$/;" v module:modbudget -timeav src/addon/modbulkmicrostat.f90 /^ real :: dtav, timeav$/;" v module:modbulkmicrostat -timeav src/addon/modgenstat.f90 /^ real :: dtav, timeav$/;" v module:modgenstat timeav src/addon/modparticles.f90 /^ real :: timeav /;" v module:modparticles -timeav src/addon/modradstat.f90 /^ real :: dtav, timeav$/;" v module:modradstat -timeav src/addon/modsampling.f90 /^ real :: dtav, timeav$/;" v module:modsampling -timeav src/addon/modstattend.f90 /^ real :: dtav, timeav$/;" v module:modstattend timeav src/addon/modstress.f90 /^ real :: dtav, timeav$/;" v module:modstress timeav src/addon/modtilt.f90 /^ real :: dtav, timeav$/;" v module:modtilt timeav src/modbudget.f90 /^ real :: dtav, timeav$/;" v module:modbudget @@ -3751,39 +3249,22 @@ timeflux src/modtimedep.f90 /^ real, allocatable :: timeflux /;" v module:m timekessl src/modmicrodata.f90 /^ ,timekessl=/;" v module:modmicrodata timeleft src/modglobal.f90 /^ integer(kind=longint) :: timeleft$/;" v module:modglobal timels src/modtimedep.f90 /^ real, allocatable :: timels /;" v module:modtimedep -timenudge src/addon/modnudge.f90 /^ real, dimension(:) , allocatable :: timenudge$/;" v module:modnudge timenudge src/modnudge.f90 /^ real, dimension(:) , allocatable :: timenudge$/;" v module:modnudge timerad src/modraddata.f90 /^ real :: timerad /;" v module:modraddata -timestat src/addon/modtimestat.f90 /^ subroutine timestat$/;" s module:modtimestat timestat src/modtimestat.f90 /^ subroutine timestat$/;" s module:modtimestat timesvsurf src/modtimedepsv.f90 /^ real, allocatable :: timesvsurf /;" v module:modtimedepsv timesvz src/modtimedepsv.f90 /^ real, allocatable :: timesvz /;" v module:modtimedepsv -tke_tot src/addon/modtimestat.f90 /^ real :: qlintav, qlintmax, tke_tot$/;" v module:modtimestat tke_tot src/modtimestat.f90 /^ real :: qlintav, qlintmax, tke_tot$/;" v module:modtimestat tke_tot_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field, ztop_field, cc_field, qlint_field, tke_tot_field$/;" v module:modtimestat tke_tot_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cc_patch, qlint_patch, qlintmax_patch, qlintmax_patchl, tke_tot_patch$/;" v module:modtimestat -tkeav src/addon/modbudget.f90 /^ real, allocatable :: tkeav(/;" v module:modbudget tkeav src/modbudget.f90 /^ real, allocatable :: tkeav(/;" v module:modbudget -tkeb src/addon/modbudget.f90 /^ real, allocatable :: tkeb(/;" v module:modbudget tkeb src/modbudget.f90 /^ real, allocatable :: tkeb(/;" v module:modbudget -tkemn src/addon/modbudget.f90 /^ real, allocatable :: tkemn(/;" v module:modbudget tkemn src/modbudget.f90 /^ real, allocatable :: tkemn(/;" v module:modbudget -tlavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,/;" v module:modsampling -tllwtendav src/addon/modradstat.f90 /^ real, allocatable :: tllwtendav(/;" v module:modradstat -tllwtendmn src/addon/modradstat.f90 /^ real, allocatable :: tllwtendmn(/;" v module:modradstat -tlradlsmn src/addon/modradstat.f90 /^ real, allocatable :: tlradlsmn(/;" v module:modradstat -tlswtendav src/addon/modradstat.f90 /^ real, allocatable :: tlswtendav(/;" v module:modradstat -tlswtendmn src/addon/modradstat.f90 /^ real, allocatable :: tlswtendmn(/;" v module:modradstat -tltendav src/addon/modradstat.f90 /^ real, allocatable :: tltendav(/;" v module:modradstat -tltendmn src/addon/modradstat.f90 /^ real, allocatable :: tltendmn(/;" v module:modradstat +tmax src/modfielddump.f90 /^ real :: dtav, tmin, tmax$/;" v module:modfielddump tmelt src/modglobal.f90 /^ real,parameter :: tmelt /;" v module:modglobal tmelt src/modraddata.f90 /^ real, parameter :: tmelt /;" v module:modraddata +tmin src/modfielddump.f90 /^ real :: dtav, tmin,/;" v module:modfielddump tmp0 src/modfields.f90 /^ real, allocatable :: tmp0(/;" v module:modfields -tncname src/addon/modbudget.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modbudget -tncname src/addon/modbulkmicrostat.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modbulkmicrostat -tncname src/addon/modfielddump.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modfielddump -tncname src/addon/modgenstat.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modgenstat -tncname src/addon/modstattend.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modstattend tncname src/modbulkmicrostat.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modbulkmicrostat tncname src/modcape.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modcape tncname src/modfielddump.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modfielddump @@ -3794,34 +3275,18 @@ tncname src/modsampling.f90 /^ character(80),dimension(1,4) :: tncname$/;" v mo tncname src/modsamptend.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modsamptend tncname src/modsimpleicestat.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modsimpleicestat tncname src/modstattend.f90 /^ character(80),dimension(1,4) :: tncname$/;" v module:modstattend -tncname1 src/addon/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname1$/;" v module:modcrosssection tncname1 src/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname1$/;" v module:modcrosssection tncname1 src/modlsmcrosssection.f90 /^ character(80),dimension(1,4) :: tncname1$/;" v module:modlsmcrosssection -tncname2 src/addon/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname2$/;" v module:modcrosssection tncname2 src/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname2$/;" v module:modcrosssection tncname2 src/modlsmcrosssection.f90 /^ character(80),dimension(1,4) :: tncname2$/;" v module:modlsmcrosssection -tncname3 src/addon/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname3$/;" v module:modcrosssection tncname3 src/modcrosssection.f90 /^ character(80),dimension(1,4) :: tncname3$/;" v module:modcrosssection tncname3 src/modlsmcrosssection.f90 /^ character(80),dimension(1,4) :: tncname3$/;" v module:modlsmcrosssection tncnameAGS src/modAGScross.f90 /^ character(80),dimension(1,4) :: tncnameAGS$/;" v module:modAGScross -tnext src/addon/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,/;" v module:modbudget -tnext src/addon/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav, itimeav, tnext,/;" v module:modbulkmicrostat -tnext src/addon/modchecksim.f90 /^ integer(kind=longint) :: tnext /;" v module:modchecksim -tnext src/addon/modcloudfield.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modcloudfield -tnext src/addon/modcrosssection.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modcrosssection -tnext src/addon/modfielddump.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modfielddump -tnext src/addon/modgenstat.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modgenstat -tnext src/addon/modheterostats.f90 /^ integer(kind=longint):: idtav,tnext$/;" v module:modheterostats tnext src/addon/modnetcdfmovie.f90 /^ real :: tnext$/;" v module:modnetcdfmovie tnext src/addon/modnetcdfstats.f90 /^ real :: dtav,tnext$/;" v module:modnetcdfstats tnext src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,idtav,itimedump,tnext,/;" v module:modparticles -tnext src/addon/modprojection.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modprojection -tnext src/addon/modradstat.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modradstat -tnext src/addon/modsampling.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modsampling -tnext src/addon/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modstattend tnext src/addon/modstress.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,/;" v module:modstress tnext src/addon/modtilt.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modtilt -tnext src/addon/modtimestat.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modtimestat tnext src/modAGScross.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modAGScross tnext src/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,/;" v module:modbudget tnext src/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav, itimeav, tnext,/;" v module:modbulkmicrostat @@ -3829,7 +3294,7 @@ tnext src/modcape.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modc tnext src/modchecksim.f90 /^ integer(kind=longint) :: tnext /;" v module:modchecksim tnext src/modcloudfield.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modcloudfield tnext src/modcrosssection.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modcrosssection -tnext src/modfielddump.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modfielddump +tnext src/modfielddump.f90 /^ integer(kind=longint) :: idtav,tnext,/;" v module:modfielddump tnext src/modgenstat.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v module:modgenstat tnext src/modheterostats.f90 /^ integer(kind=longint):: idtav,tnext$/;" v module:modheterostats tnext src/modlsmcrosssection.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modlsmcrosssection @@ -3845,14 +3310,7 @@ tnext src/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,/;" v tnext src/modtimestat.f90 /^ integer(kind=longint) :: idtav,tnext$/;" v module:modtimestat tnextdump src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,idtav,itimedump,tnext,tnextwrite,tnextdump$/;" v module:modparticles tnextrestart src/modglobal.f90 /^ integer(kind=longint) :: tnextrestart /;" v module:modglobal -tnextwrite src/addon/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,tnextwrite$/;" v module:modbudget -tnextwrite src/addon/modbulkmicrostat.f90 /^ integer(kind=longint):: idtav, itimeav, tnext, tnextwrite$/;" v module:modbulkmicrostat -tnextwrite src/addon/modchem.f90 /^ integer(kind=longint) :: itimeav,tnextwrite,/;" v module:modchem -tnextwrite src/addon/modgenstat.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modgenstat tnextwrite src/addon/modparticles.f90 /^ integer(kind=longint) :: itimeav,idtav,itimedump,tnext,tnextwrite,/;" v module:modparticles -tnextwrite src/addon/modradstat.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modradstat -tnextwrite src/addon/modsampling.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modsampling -tnextwrite src/addon/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modstattend tnextwrite src/addon/modstress.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,tnextwrite$/;" v module:modstress tnextwrite src/addon/modtilt.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modtilt tnextwrite src/modbudget.f90 /^ integer(kind=longint) :: idtav, itimeav,tnext,tnextwrite$/;" v module:modbudget @@ -3866,11 +3324,9 @@ tnextwrite src/modsampling.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext, tnextwrite src/modsamptend.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modsamptend tnextwrite src/modsimpleicestat.f90 /^ integer(kind=longint):: idtav, itimeav, tnext, tnextwrite$/;" v module:modsimpleicestat tnextwrite src/modstattend.f90 /^ integer(kind=longint) :: idtav,itimeav,tnext,tnextwrite$/;" v module:modstattend -tnor src/addon/modchem.f90 /^ integer tnor,/;" v module:modchem tnor src/modchem.f90 /^ integer tnor,/;" v module:modchem -tnudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,/;" v module:modnudge tnudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,/;" v module:modnudge -tnudgefac src/addon/modnudge.f90 /^ real :: tnudgefac /;" v module:modnudge +tnudge src/modtestbed.f90 /^ real, dimension(:,:), allocatable :: tnudge,/;" v module:modtestbed tnudgefac src/modnudge.f90 /^ real :: tnudgefac /;" v module:modnudge toph src/modboundary.f90 /^ subroutine toph$/;" s module:modboundary topm src/modboundary.f90 /^ subroutine topm$/;" s module:modboundary @@ -3886,7 +3342,6 @@ tref src/rrlw_ref.f90 /^ real(kind=rb) , dimension(59) :: tref$/;" v module tref src/rrsw_ref.f90 /^ real(kind=rb) , dimension(59) :: tref$/;" v module:rrsw_ref tres src/modglobal.f90 /^ real :: tres /;" v module:modglobal trestart src/modglobal.f90 /^ real :: trestart /;" v module:modglobal -trspmn src/addon/modbudget.f90 /^ real, allocatable :: trspmn(/;" v module:modbudget trspmn src/modbudget.f90 /^ real, allocatable :: trspmn(/;" v module:modbudget tsc src/modboundary.f90 /^ real,allocatable :: tsc(/;" v module:modboundary tshr src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tshr /;" v module:modstress @@ -3916,20 +3371,15 @@ tttr src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tttr /; tup src/modglobal.f90 /^ real,parameter :: tup /;" v module:modglobal tuprsg src/modmicrodata.f90 /^ ,tuprsg=/;" v module:modmicrodata tupsg src/modmicrodata.f90 /^ ,tupsg=/;" v module:modmicrodata -tvavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,/;" v module:modsampling twist src/rad_rndnmb.f90 /^ elemental function twist(/;" f module:RandomNumbers -twostep src/addon/modchem.f90 /^SUBROUTINE twostep(/;" s module:modchem twostep src/modchem.f90 /^SUBROUTINE twostep(/;" s module:modchem -twostep2 src/addon/modchem.f90 /^SUBROUTINE twostep2(/;" s module:modchem twostep2 src/modchem.f90 /^SUBROUTINE twostep2(/;" s module:modchem u src/modradfull.f90 /^ real, parameter :: u(/;" v module:modradfull u0 src/modfields.f90 /^ real, allocatable :: u0(/;" v module:modfields u0 src/modradfull.f90 /^ real :: ee, u0$/;" v module:modradfull u0av src/modfields.f90 /^ real, allocatable :: u0av(/;" v module:modfields u0av_patch src/modtimestat.f90 /^ real, allocatable :: u0av_patch /;" v module:modtimestat -u2mn src/addon/modgenstat.f90 /^ real, allocatable :: u2mn /;" v module:modgenstat u2mn src/modgenstat.f90 /^ real, allocatable :: u2mn /;" v module:modgenstat -uavgid src/addon/modheterostats.f90 /^ integer :: uavgid,/;" v module:modheterostats uavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid,/;" v module:modnetcdfstats uavgid src/modheterostats.f90 /^ integer :: uavgid,/;" v module:modheterostats uavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,/;" v module:modquadrant @@ -3939,27 +3389,19 @@ uid src/addon/modnetcdfmovie.f90 /^ integer :: uid,/;" v module:modnetcdfmovie uidfield src/addon/modnetcdfstats.f90 /^ integer :: uidfield,/;" v module:modnetcdfstats uidmovie src/addon/modnetcdfstats.f90 /^ integer :: uidmovie,/;" v module:modnetcdfstats um src/modfields.f90 /^ real, allocatable :: um(/;" v module:modfields -umav src/addon/modgenstat.f90 /^ real, allocatable :: umav /;" v module:modgenstat umav src/modgenstat.f90 /^ real, allocatable :: umav /;" v module:modgenstat -umn src/addon/modgenstat.f90 /^ real, allocatable :: umn /;" v module:modgenstat umn src/modgenstat.f90 /^ real, allocatable :: umn /;" v module:modgenstat unique src/addon/modparticles.f90 /^ real :: unique,/;" k type:particle_record -unudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,/;" v module:modnudge unudge src/modglobal.f90 /^ real :: unudge /;" v module:modglobal unudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,/;" v module:modnudge up src/modfields.f90 /^ real, allocatable :: up(/;" v module:modfields -upav src/addon/modstattend.f90 /^ real, allocatable :: upav(/;" v module:modstattend upav src/modsamptend.f90 /^ real, allocatable :: upav(/;" v module:modsamptend upav src/modstattend.f90 /^ real, allocatable :: upav(/;" v module:modstattend -upmn src/addon/modstattend.f90 /^ real, allocatable :: upmn(/;" v module:modstattend upmn src/modsamptend.f90 /^ real, allocatable :: upmn(/;" v module:modsamptend upmn src/modstattend.f90 /^ real, allocatable :: upmn(/;" v module:modstattend uprof src/modfields.f90 /^ real, allocatable :: uprof(/;" v module:modfields -uptav src/addon/modgenstat.f90 /^ real, allocatable :: uptav(/;" v module:modgenstat uptav src/modgenstat.f90 /^ real, allocatable :: uptav(/;" v module:modgenstat uptm src/modsamptend.f90 /^ real, allocatable :: uptm(/;" v module:modsamptend -uqlcovid src/addon/modheterostats.f90 /^ integer :: uqlcovid,/;" v module:modheterostats -uqtcovid src/addon/modheterostats.f90 /^ integer :: uqtcovid,/;" v module:modheterostats uqtcovid src/addon/modnetcdfstats.f90 /^ integer :: uqtcovid,/;" v module:modnetcdfstats ures src/addon/modparticles.f90 /^ real :: x,x_prev, xstart, ures,/;" k type:particle_record useMcICA src/modraddata.f90 /^ logical :: useMcICA /;" v module:modraddata @@ -3972,44 +3414,28 @@ ustar src/modsurfdata.f90 /^ real, allocatable :: ustar /;" v module:modsurfdat ustin src/modsurfdata.f90 /^ real :: ustin /;" v module:modsurfdata ustin_land src/modsurfdata.f90 /^ real :: ustin_land(/;" v module:modsurfdata ustin_patch src/modsurfdata.f90 /^ real, allocatable :: ustin_patch(/;" v module:modsurfdata -usvcovid src/addon/modheterostats.f90 /^ integer, allocatable :: usvcovid(/;" v module:modheterostats usvcovid src/modheterostats.f90 /^ integer, allocatable :: usvcovid(/;" v module:modheterostats -uthlcovid src/addon/modheterostats.f90 /^ integer :: uthlcovid,/;" v module:modheterostats uthlcovid src/addon/modnetcdfstats.f90 /^ integer :: uthlcovid,/;" v module:modnetcdfstats -uthvcovid src/addon/modheterostats.f90 /^ integer :: uthvcovid,/;" v module:modheterostats utotavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,wavl,utotavl,/;" v module:modquadrant utotvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,vvarl,wvarl,utotvarl,/;" v module:modquadrant -uvarid src/addon/modheterostats.f90 /^ integer :: uvarid,/;" v module:modheterostats uvarid src/addon/modnetcdfstats.f90 /^ integer :: uvarid,/;" v module:modnetcdfstats uvarid src/modheterostats.f90 /^ integer :: uvarid,/;" v module:modheterostats uvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,/;" v module:modquadrant -uvcovid src/addon/modheterostats.f90 /^ integer :: uvcovid,/;" v module:modheterostats uvcovid src/addon/modnetcdfstats.f90 /^ integer :: uvcovid,/;" v module:modnetcdfstats -uwavl src/addon/modsampling.f90 /^ wtlavl,wtvavl,wqtavl,wqlavl,uwavl,/;" v module:modsampling -uwcovid src/addon/modheterostats.f90 /^ integer :: uvcovid, uwcovid,/;" v module:modheterostats uwcovid src/addon/modnetcdfstats.f90 /^ integer :: uvcovid, uwcovid,/;" v module:modnetcdfstats uwcovid src/modheterostats.f90 /^ integer :: uwcovid,/;" v module:modheterostats -uwcovsid src/addon/modheterostats.f90 /^ integer :: uwcovsid,/;" v module:modheterostats uwcovsid src/modheterostats.f90 /^ integer :: uwcovsid,/;" v module:modheterostats -uwres src/addon/modgenstat.f90 /^ real, allocatable :: uwres /;" v module:modgenstat uwres src/modgenstat.f90 /^ real, allocatable :: uwres /;" v module:modgenstat -uwrmn src/addon/modgenstat.f90 /^ real, allocatable :: uwrmn /;" v module:modgenstat uwrmn src/modgenstat.f90 /^ real, allocatable :: uwrmn /;" v module:modgenstat -uwsmn src/addon/modgenstat.f90 /^ real, allocatable :: uwsmn /;" v module:modgenstat uwsmn src/modgenstat.f90 /^ real, allocatable :: uwsmn /;" v module:modgenstat -uwsub src/addon/modgenstat.f90 /^ real, allocatable :: uwsub /;" v module:modgenstat uwsub src/modgenstat.f90 /^ real, allocatable :: uwsub /;" v module:modgenstat uwthavl src/modsampling.f90 /^ wthlthavl,wthvthavl,wqtthavl,wqlthavl,uwthavl,/;" v module:modsampling -uwtmn src/addon/modgenstat.f90 /^ real, allocatable :: uwtmn /;" v module:modgenstat uwtmn src/modgenstat.f90 /^ real, allocatable :: uwtmn /;" v module:modgenstat -uwtot src/addon/modgenstat.f90 /^ real, allocatable :: uwtot /;" v module:modgenstat uwtot src/modgenstat.f90 /^ real, allocatable :: uwtot /;" v module:modgenstat v0 src/modfields.f90 /^ real, allocatable :: v0(/;" v module:modfields v0av src/modfields.f90 /^ real, allocatable :: v0av(/;" v module:modfields v0av_patch src/modtimestat.f90 /^ real, allocatable :: v0av_patch /;" v module:modtimestat -v2mn src/addon/modgenstat.f90 /^ real, allocatable :: u2mn (:), v2mn /;" v module:modgenstat v2mn src/modgenstat.f90 /^ real, allocatable :: u2mn (:), v2mn /;" v module:modgenstat -vavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid,/;" v module:modheterostats vavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid, vavgid,/;" v module:modnetcdfstats vavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid,/;" v module:modheterostats vavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,/;" v module:modquadrant @@ -4026,80 +3452,54 @@ vid src/addon/modnetcdfmovie.f90 /^ integer :: uid, vid,/;" v module:modnetcdfm vidfield src/addon/modnetcdfstats.f90 /^ integer :: uidfield, vidfield,/;" v module:modnetcdfstats vidmovie src/addon/modnetcdfstats.f90 /^ integer :: uidmovie, vidmovie,/;" v module:modnetcdfstats vm src/modfields.f90 /^ real, allocatable :: vm(/;" v module:modfields -vmav src/addon/modgenstat.f90 /^ real, allocatable :: vmav /;" v module:modgenstat vmav src/modgenstat.f90 /^ real, allocatable :: vmav /;" v module:modgenstat -vmn src/addon/modgenstat.f90 /^ real, allocatable :: umn (:) ,vmn /;" v module:modgenstat vmn src/modgenstat.f90 /^ real, allocatable :: umn (:) ,vmn /;" v module:modgenstat -vnudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,/;" v module:modnudge vnudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,/;" v module:modnudge vp src/modfields.f90 /^ real, allocatable :: vp(/;" v module:modfields -vpav src/addon/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(/;" v module:modstattend vpav src/modsamptend.f90 /^ real, allocatable :: upav(:,:,:),vpav(/;" v module:modsamptend vpav src/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(/;" v module:modstattend -vpmn src/addon/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(/;" v module:modstattend vpmn src/modsamptend.f90 /^ real, allocatable :: upmn(:,:,:),vpmn(/;" v module:modsamptend vpmn src/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(/;" v module:modstattend vprof src/modfields.f90 /^ real, allocatable :: vprof(/;" v module:modfields -vptav src/addon/modgenstat.f90 /^ real, allocatable :: vptav(/;" v module:modgenstat vptav src/modgenstat.f90 /^ real, allocatable :: vptav(/;" v module:modgenstat vptm src/modsamptend.f90 /^ real, allocatable :: uptm(:,:,:),vptm(/;" v module:modsamptend -vqlcovid src/addon/modheterostats.f90 /^ integer :: uqlcovid, vqlcovid,/;" v module:modheterostats -vqtcovid src/addon/modheterostats.f90 /^ integer :: uqtcovid, vqtcovid,/;" v module:modheterostats vqtcovid src/addon/modnetcdfstats.f90 /^ integer :: uqtcovid, vqtcovid,/;" v module:modnetcdfstats vres src/addon/modparticles.f90 /^ real :: y,y_prev, ystart, vres,/;" k type:particle_record vrtqdr_sw src/rrtmg_sw_vrtqdr.f90 /^ subroutine vrtqdr_sw(/;" s module:rrtmg_sw_vrtqdr vsgs src/addon/modparticles.f90 /^ real :: y,y_prev, ystart, vres, vsgs,/;" k type:particle_record vsgs_prev src/addon/modparticles.f90 /^ real :: y,y_prev, ystart, vres, vsgs, vsgs_prev$/;" k type:particle_record vst src/modsamptend.f90 /^ real, allocatable :: ust(:,:),vst(/;" v module:modsamptend -vsvcovid src/addon/modheterostats.f90 /^ integer, allocatable :: usvcovid(:), vsvcovid(/;" v module:modheterostats vsvcovid src/modheterostats.f90 /^ integer, allocatable :: usvcovid(:), vsvcovid(/;" v module:modheterostats -vthlcovid src/addon/modheterostats.f90 /^ integer :: uthlcovid, vthlcovid,/;" v module:modheterostats vthlcovid src/addon/modnetcdfstats.f90 /^ integer :: uthlcovid, vthlcovid,/;" v module:modnetcdfstats -vthvcovid src/addon/modheterostats.f90 /^ integer :: uthvcovid, vthvcovid,/;" v module:modheterostats -vvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid,/;" v module:modheterostats vvarid src/addon/modnetcdfstats.f90 /^ integer :: uvarid, vvarid,/;" v module:modnetcdfstats vvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid,/;" v module:modheterostats vvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,vvarl,/;" v module:modquadrant -vwavl src/addon/modsampling.f90 /^ wtlavl,wtvavl,wqtavl,wqlavl,uwavl,vwavl$/;" v module:modsampling -vwcovid src/addon/modheterostats.f90 /^ integer :: uvcovid, uwcovid, vwcovid$/;" v module:modheterostats vwcovid src/addon/modnetcdfstats.f90 /^ integer :: uvcovid, uwcovid, vwcovid$/;" v module:modnetcdfstats vwcovid src/modheterostats.f90 /^ integer :: uwcovid, vwcovid$/;" v module:modheterostats -vwcovsid src/addon/modheterostats.f90 /^ integer :: uwcovsid, vwcovsid$/;" v module:modheterostats vwcovsid src/addon/modnetcdfstats.f90 /^ integer :: vwcovsid$/;" v module:modnetcdfstats vwcovsid src/modheterostats.f90 /^ integer :: uwcovsid, vwcovsid$/;" v module:modheterostats -vwres src/addon/modgenstat.f90 /^ real, allocatable :: vwres /;" v module:modgenstat vwres src/modgenstat.f90 /^ real, allocatable :: vwres /;" v module:modgenstat -vwrmn src/addon/modgenstat.f90 /^ real, allocatable :: uwrmn (:),vwrmn /;" v module:modgenstat vwrmn src/modgenstat.f90 /^ real, allocatable :: uwrmn (:),vwrmn /;" v module:modgenstat -vwsmn src/addon/modgenstat.f90 /^ real, allocatable :: uwsmn (:),vwsmn /;" v module:modgenstat vwsmn src/modgenstat.f90 /^ real, allocatable :: uwsmn (:),vwsmn /;" v module:modgenstat -vwsub src/addon/modgenstat.f90 /^ real, allocatable :: vwsub /;" v module:modgenstat vwsub src/modgenstat.f90 /^ real, allocatable :: vwsub /;" v module:modgenstat vwthavl src/modsampling.f90 /^ wthlthavl,wthvthavl,wqtthavl,wqlthavl,uwthavl,vwthavl,/;" v module:modsampling -vwtmn src/addon/modgenstat.f90 /^ real, allocatable :: uwtmn (:),vwtmn /;" v module:modgenstat vwtmn src/modgenstat.f90 /^ real, allocatable :: uwtmn (:),vwtmn /;" v module:modgenstat -vwtot src/addon/modgenstat.f90 /^ real, allocatable :: vwtot /;" v module:modgenstat vwtot src/modgenstat.f90 /^ real, allocatable :: vwtot /;" v module:modgenstat w0 src/modfields.f90 /^ real, allocatable :: w0(/;" v module:modfields w0av_patch src/modtimestat.f90 /^ real, allocatable :: w0av_patch /;" v module:modtimestat -w2mn src/addon/modgenstat.f90 /^ real, allocatable :: w2mn /;" v module:modgenstat w2mn src/modgenstat.f90 /^ real, allocatable :: w2mn /;" v module:modgenstat -w2submn src/addon/modgenstat.f90 /^ real, allocatable :: w2submn /;" v module:modgenstat w2submn src/modgenstat.f90 /^ real, allocatable :: w2submn /;" v module:modgenstat -w_el src/addon/modsampling.f90 /^ real,allocatable, dimension(:,:) :: w_el,/;" v module:modsampling wadvhavl src/modsampling.f90 /^ real,allocatable, dimension(:,:) :: wadvhavl,/;" v module:modsampling wavenum1 src/rrlw_wvn.f90 /^ real(kind=rb) :: wavenum1(/;" v module:rrlw_wvn wavenum1 src/rrsw_wvn.f90 /^ real(kind=rb) :: wavenum1(/;" v module:rrsw_wvn wavenum2 src/rrlw_wvn.f90 /^ real(kind=rb) :: wavenum2(/;" v module:rrlw_wvn wavenum2 src/rrsw_wvn.f90 /^ real(kind=rb) :: wavenum2(/;" v module:rrsw_wvn -wavgid src/addon/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid,/;" v module:modheterostats wavgid src/addon/modnetcdfstats.f90 /^ integer :: uavgid, vavgid, wavgid,/;" v module:modnetcdfstats wavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid,/;" v module:modheterostats -wavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,/;" v module:modsampling wavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,wavl,/;" v module:modquadrant wco2Field src/modsurfdata.f90 /^ real, allocatable :: wco2Field /;" v module:modsurfdata wco2av src/modsurfdata.f90 /^ real :: wco2av /;" v module:modsurfdata -we src/addon/modtimestat.f90 /^ real :: zi,ziold=-1, we$/;" v module:modtimestat +wctime src/modglobal.f90 /^ real :: wctime=/;" v module:modglobal we src/modtimestat.f90 /^ real :: zi,ziold=-1, we$/;" v module:modtimestat we_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,ziold_patch,we_patch,/;" v module:modtimestat wfall_Nr src/addon/modbulkmicrodata.f90 /^ ,wfall_Nr /;" v module:modbulkmicrodata @@ -4118,126 +3518,85 @@ winew src/modfft2d.f90 /^ real, dimension(:), allocatable :: winew,/;" v mo wjnew src/modfft2d.f90 /^ real, dimension(:), allocatable :: winew, wjnew$/;" v module:modfft2d wl_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: cliq_patch, wl_patch,/;" v module:modtimestat wm src/modfields.f90 /^ real, allocatable :: wm(/;" v module:modfields -wmax src/addon/modtimestat.f90 /^ real :: cc, wmax,/;" v module:modtimestat wmax src/modtimestat.f90 /^ real :: cc, wmax,/;" v module:modtimestat wmax_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch,/;" v module:modtimestat wmax_patchl src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch, wmax_patchl,/;" v module:modtimestat -wnudge src/addon/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,/;" v module:modnudge wnudge src/modnudge.f90 /^ real, dimension(:,:), allocatable :: tnudge,unudge,vnudge,wnudge,/;" v module:modnudge worka src/modfft2d.f90 /^ real, dimension(:,:,:), allocatable :: worka,/;" v module:modfft2d workb src/modfft2d.f90 /^ real, dimension(:,:,:), allocatable :: worka, workb$/;" v module:modfft2d wp src/modfields.f90 /^ real, allocatable :: wp(/;" v module:modfields wp_store src/modfields.f90 /^ real, allocatable :: wp_store(/;" v module:modfields -wpav src/addon/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(/;" v module:modstattend wpav src/modsamptend.f90 /^ real, allocatable :: upav(:,:,:),vpav(:,:,:),wpav(/;" v module:modsamptend wpav src/modstattend.f90 /^ real, allocatable :: upav(:,:),vpav(:,:),wpav(/;" v module:modstattend -wpmn src/addon/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(:,:),wpmn(/;" v module:modstattend wpmn src/modsamptend.f90 /^ real, allocatable :: upmn(:,:,:),vpmn(:,:,:),wpmn(/;" v module:modsamptend wpmn src/modstattend.f90 /^ real, allocatable :: upmn(:,:),vpmn(:,:),wpmn(/;" v module:modstattend wptm src/modsamptend.f90 /^ real, allocatable :: uptm(:,:,:),vptm(:,:,:),wptm(/;" v module:modsamptend wq_land src/modsurfdata.f90 /^ real :: wq_land(/;" v module:modsurfdata wq_patch src/modsurfdata.f90 /^ real, allocatable :: wq_patch(/;" v module:modsurfdata -wqlavl src/addon/modsampling.f90 /^ wtlavl,wtvavl,wqtavl,wqlavl,/;" v module:modsampling -wqlcovid src/addon/modheterostats.f90 /^ integer :: uqlcovid, vqlcovid, wqlcovid$/;" v module:modheterostats wqlcovid src/modheterostats.f90 /^ integer :: wqlcovid$/;" v module:modheterostats -wqlcovsid src/addon/modheterostats.f90 /^ integer :: wqlcovsid$/;" v module:modheterostats wqlcovsid src/modheterostats.f90 /^ integer :: wqlcovsid$/;" v module:modheterostats -wqlres src/addon/modgenstat.f90 /^ real, allocatable :: wqlres(/;" v module:modgenstat wqlres src/modgenstat.f90 /^ real, allocatable :: wqlres(/;" v module:modgenstat -wqlrmn src/addon/modgenstat.f90 /^ real, allocatable :: wqlsmn (:),wqlrmn /;" v module:modgenstat wqlrmn src/modgenstat.f90 /^ real, allocatable :: wqlsmn (:),wqlrmn /;" v module:modgenstat wqls_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: ust_patch, qst_patch, tst_patch, wthls_patch, wqls_patch,/;" v module:modtimestat -wqlsmn src/addon/modgenstat.f90 /^ real, allocatable :: wqlsmn /;" v module:modgenstat wqlsmn src/modgenstat.f90 /^ real, allocatable :: wqlsmn /;" v module:modgenstat -wqlsub src/addon/modgenstat.f90 /^ real, allocatable :: wqlsub(/;" v module:modgenstat wqlsub src/modgenstat.f90 /^ real, allocatable :: wqlsub(/;" v module:modgenstat wqlthavl src/modsampling.f90 /^ wthlthavl,wthvthavl,wqtthavl,wqlthavl,/;" v module:modsampling -wqltmn src/addon/modgenstat.f90 /^ real, allocatable :: wqlsmn (:),wqlrmn (:),wqltmn(/;" v module:modgenstat wqltmn src/modgenstat.f90 /^ real, allocatable :: wqlsmn (:),wqlrmn (:),wqltmn(/;" v module:modgenstat -wqltot src/addon/modgenstat.f90 /^ real, allocatable :: wqltot(/;" v module:modgenstat wqltot src/modgenstat.f90 /^ real, allocatable :: wqltot(/;" v module:modgenstat wqsurf src/modsurfdata.f90 /^ real :: wqsurf /;" v module:modsurfdata wqsurft src/modtimedep.f90 /^ real, allocatable :: wqsurft /;" v module:modtimedep wqt_alph src/modcanopy.f90 /^ real :: wqt_alph /;" v module:modcanopy wqt_can src/modcanopy.f90 /^ real :: wqt_can /;" v module:modcanopy wqt_total src/modcanopy.f90 /^ logical :: wqt_total /;" v module:modcanopy -wqtavl src/addon/modsampling.f90 /^ wtlavl,wtvavl,wqtavl,/;" v module:modsampling -wqtcovid src/addon/modheterostats.f90 /^ integer :: uqtcovid, vqtcovid, wqtcovid$/;" v module:modheterostats wqtcovid src/addon/modnetcdfstats.f90 /^ integer :: uqtcovid, vqtcovid, wqtcovid$/;" v module:modnetcdfstats wqtcovid src/modheterostats.f90 /^ integer :: wqtcovid$/;" v module:modheterostats -wqtcovsid src/addon/modheterostats.f90 /^ integer :: wqtcovsid$/;" v module:modheterostats wqtcovsid src/addon/modnetcdfstats.f90 /^ integer :: wqtcovsid$/;" v module:modnetcdfstats wqtcovsid src/modheterostats.f90 /^ integer :: wqtcovsid$/;" v module:modheterostats -wqtres src/addon/modgenstat.f90 /^ real, allocatable :: wqtres(/;" v module:modgenstat wqtres src/modgenstat.f90 /^ real, allocatable :: wqtres(/;" v module:modgenstat wqtresl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wuresl,wvresl,wthlresl,wqtresl$/;" v module:modquadrant -wqtrmn src/addon/modgenstat.f90 /^ real, allocatable :: wqtsmn (:),wqtrmn /;" v module:modgenstat wqtrmn src/modgenstat.f90 /^ real, allocatable :: wqtsmn (:),wqtrmn /;" v module:modgenstat -wqtsmn src/addon/modgenstat.f90 /^ real, allocatable :: wqtsmn /;" v module:modgenstat wqtsmn src/modgenstat.f90 /^ real, allocatable :: wqtsmn /;" v module:modgenstat -wqtsub src/addon/modgenstat.f90 /^ real, allocatable :: wqtsub(/;" v module:modgenstat wqtsub src/modgenstat.f90 /^ real, allocatable :: wqtsub(/;" v module:modgenstat wqtsubl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wusubl,wvsubl,wthlsubl,wqtsubl$/;" v module:modquadrant wqtthavl src/modsampling.f90 /^ wthlthavl,wthvthavl,wqtthavl,/;" v module:modsampling -wqttmn src/addon/modgenstat.f90 /^ real, allocatable :: wqtsmn (:),wqtrmn (:),wqttmn(/;" v module:modgenstat wqttmn src/modgenstat.f90 /^ real, allocatable :: wqtsmn (:),wqtrmn (:),wqttmn(/;" v module:modgenstat -wqttot src/addon/modgenstat.f90 /^ real, allocatable :: wqttot(/;" v module:modgenstat wqttot src/modgenstat.f90 /^ real, allocatable :: wqttot(/;" v module:modgenstat wres src/addon/modparticles.f90 /^ real :: z,z_prev, zstart, wres,/;" k type:particle_record -write_chem_scheme src/addon/modchem.f90 /^subroutine write_chem_scheme(/;" s module:modchem write_chem_scheme src/modchem.f90 /^subroutine write_chem_scheme(/;" s module:modchem -writearray src/addon/modchem.f90 /^ real, allocatable :: writearray(/;" v module:modchem writearray src/modchem.f90 /^ real, allocatable :: writearray(/;" v module:modchem -writebudget src/addon/modbudget.f90 /^ subroutine writebudget$/;" s module:modbudget writebudget src/modbudget.f90 /^ subroutine writebudget$/;" s module:modbudget -writebulkmicrostat src/addon/modbulkmicrostat.f90 /^ subroutine writebulkmicrostat$/;" s module:modbulkmicrostat writebulkmicrostat src/modbulkmicrostat.f90 /^ subroutine writebulkmicrostat$/;" s module:modbulkmicrostat writelsmstat src/modlsmstat.f90 /^ subroutine writelsmstat$/;" s module:modlsmstat writeparticles src/addon/modparticles.f90 /^ subroutine writeparticles$/;" s module:modparticles writequadrant src/modquadrant.f90 /^ subroutine writequadrant$/;" s module:modquadrant -writeradstat src/addon/modradstat.f90 /^ subroutine writeradstat$/;" s module:modradstat writeradstat src/modradstat.f90 /^ subroutine writeradstat$/;" s module:modradstat writerestartfiles src/modstartup.f90 /^ subroutine writerestartfiles$/;" s module:modstartup -writesampling src/addon/modsampling.f90 /^ subroutine writesampling$/;" s module:modsampling writesampling src/modsampling.f90 /^ subroutine writesampling$/;" s module:modsampling writesamptend src/modsamptend.f90 /^ subroutine writesamptend$/;" s module:modsamptend writesimpleicestat src/modsimpleicestat.f90 /^ subroutine writesimpleicestat$/;" s module:modsimpleicestat -writestat src/addon/modgenstat.f90 /^ subroutine writestat$/;" s module:modgenstat writestat src/modgenstat.f90 /^ subroutine writestat$/;" s module:modgenstat -writestat_1D_nc src/addon/modstat_nc.f90 /^ subroutine writestat_1D_nc(/;" s module:modstat_nc writestat_1D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_1D_nc(/;" s module:modstat_nc writestat_1D_nc src/modstat_nc.f90 /^ subroutine writestat_1D_nc(/;" s module:modstat_nc -writestat_2D_nc src/addon/modstat_nc.f90 /^ subroutine writestat_2D_nc(/;" s module:modstat_nc writestat_2D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_2D_nc(/;" s module:modstat_nc writestat_2D_nc src/modstat_nc.f90 /^ subroutine writestat_2D_nc(/;" s module:modstat_nc -writestat_3D_nc src/addon/modstat_nc.f90 /^ subroutine writestat_3D_nc(/;" s module:modstat_nc writestat_3D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_3D_nc(/;" s module:modstat_nc writestat_3D_nc src/modstat_nc.f90 /^ subroutine writestat_3D_nc(/;" s module:modstat_nc -writestat_3D_short_nc src/addon/modstat_nc.f90 /^ subroutine writestat_3D_short_nc(/;" s module:modstat_nc writestat_3D_short_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_3D_short_nc(/;" s module:modstat_nc writestat_3D_short_nc src/modstat_nc.f90 /^ subroutine writestat_3D_short_nc(/;" s module:modstat_nc -writestat_dims_nc src/addon/modstat_nc.f90 /^ subroutine writestat_dims_nc(/;" s module:modstat_nc writestat_dims_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_dims_nc(/;" s module:modstat_nc writestat_dims_nc src/modstat_nc.f90 /^ subroutine writestat_dims_nc(/;" s module:modstat_nc writestat_dims_q_nc src/modstat_nc.f90 /^ subroutine writestat_dims_q_nc(/;" s module:modstat_nc -writestat_time_nc src/addon/modstat_nc.f90 /^ subroutine writestat_time_nc(/;" s module:modstat_nc writestat_time_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_time_nc(/;" s module:modstat_nc writestat_time_nc src/modstat_nc.f90 /^ subroutine writestat_time_nc(/;" s module:modstat_nc -writestattend src/addon/modstattend.f90 /^ subroutine writestattend$/;" s module:modstattend writestattend src/modstattend.f90 /^ subroutine writestattend$/;" s module:modstattend writestressbudget src/addon/modstress.f90 /^ subroutine writestressbudget$/;" s module:modstress writethla src/addon/modtilt.f90 /^ subroutine writethla$/;" s module:modtilt writetiltstat src/addon/modtilt.f90 /^ subroutine writetiltstat$/;" s module:modtilt -wrthorz src/addon/modcrosssection.f90 /^ subroutine wrthorz$/;" s module:modcrosssection -wrthorz src/addon/modprojection.f90 /^ subroutine wrthorz$/;" s module:modprojection wrthorz src/modcrosssection.f90 /^ subroutine wrthorz$/;" s module:modcrosssection wrthorz src/modlsmcrosssection.f90 /^ subroutine wrthorz$/;" s module:modlsmcrosssection wrthorz src/modprojection.f90 /^ subroutine wrthorz$/;" s module:modprojection -wrtorth src/addon/modcrosssection.f90 /^ subroutine wrtorth$/;" s module:modcrosssection wrtorth src/modcrosssection.f90 /^ subroutine wrtorth$/;" s module:modcrosssection wrtsurf src/modlsmcrosssection.f90 /^ subroutine wrtsurf$/;" s module:modlsmcrosssection -wrtvert src/addon/modcrosssection.f90 /^ subroutine wrtvert$/;" s module:modcrosssection -wrtvert src/addon/modprojection.f90 /^ subroutine wrtvert$/;" s module:modprojection wrtvert src/modcrosssection.f90 /^ subroutine wrtvert$/;" s module:modcrosssection wrtvert src/modlsmcrosssection.f90 /^ subroutine wrtvert$/;" s module:modlsmcrosssection wsgs src/addon/modparticles.f90 /^ real :: z,z_prev, zstart, wres, wsgs,/;" k type:particle_record @@ -4250,24 +3609,16 @@ wsv_can src/modcanopy.f90 /^ real :: wsv_can(/;" v module:modcanopy wsv_land src/modsurfdata.f90 /^ real :: wsv_land(/;" v module:modsurfdata wsv_patch src/modsurfdata.f90 /^ real, allocatable :: wsv_patch(/;" v module:modsurfdata wsv_total src/modcanopy.f90 /^ logical :: wsv_total(/;" v module:modcanopy -wsvcovid src/addon/modheterostats.f90 /^ integer, allocatable :: usvcovid(:), vsvcovid(:), wsvcovid(/;" v module:modheterostats wsvcovid src/modheterostats.f90 /^ integer, allocatable :: usvcovid(:), vsvcovid(:), wsvcovid(/;" v module:modheterostats -wsvcovsid src/addon/modheterostats.f90 /^ integer, allocatable :: wsvcovsid(/;" v module:modheterostats wsvcovsid src/modheterostats.f90 /^ integer, allocatable :: wsvcovsid(/;" v module:modheterostats -wsvres src/addon/modgenstat.f90 /^ real, allocatable :: wsvres(/;" v module:modgenstat wsvres src/modgenstat.f90 /^ real, allocatable :: wsvres(/;" v module:modgenstat wsvresl src/modquadrant.f90 /^ real, allocatable, dimension(:,:,:) :: wsvresl,/;" v module:modquadrant -wsvrmn src/addon/modgenstat.f90 /^ real, allocatable :: wsvsmn (:,:),wsvrmn(/;" v module:modgenstat wsvrmn src/modgenstat.f90 /^ real, allocatable :: wsvsmn (:,:),wsvrmn(/;" v module:modgenstat -wsvsmn src/addon/modgenstat.f90 /^ real, allocatable :: wsvsmn /;" v module:modgenstat wsvsmn src/modgenstat.f90 /^ real, allocatable :: wsvsmn /;" v module:modgenstat -wsvsub src/addon/modgenstat.f90 /^ real, allocatable :: wsvsub(/;" v module:modgenstat wsvsub src/modgenstat.f90 /^ real, allocatable :: wsvsub(/;" v module:modgenstat wsvsubl src/modquadrant.f90 /^ real, allocatable, dimension(:,:,:) :: wsvresl,wsvsubl$/;" v module:modquadrant wsvsurf src/modsurfdata.f90 /^ real :: wsvsurf(/;" v module:modsurfdata -wsvtmn src/addon/modgenstat.f90 /^ real, allocatable :: wsvsmn (:,:),wsvrmn(:,:),wsvtmn(/;" v module:modgenstat wsvtmn src/modgenstat.f90 /^ real, allocatable :: wsvsmn (:,:),wsvrmn(:,:),wsvtmn(/;" v module:modgenstat -wsvtot src/addon/modgenstat.f90 /^ real, allocatable :: wsvtot(/;" v module:modgenstat wsvtot src/modgenstat.f90 /^ real, allocatable :: wsvtot(/;" v module:modgenstat wt src/rrlw_wvn.f90 /^ real(kind=rb) :: wt(/;" v module:rrlw_wvn wt src/rrsw_wvn.f90 /^ real(kind=rb) :: wt(/;" v module:rrsw_wvn @@ -4276,10 +3627,8 @@ wt_patch src/modsurfdata.f90 /^ real, allocatable :: wt_patch(/;" v module:mods wth_alph src/modcanopy.f90 /^ real :: wth_alph /;" v module:modcanopy wth_can src/modcanopy.f90 /^ real :: wth_can /;" v module:modcanopy wth_total src/modcanopy.f90 /^ logical :: wth_total /;" v module:modcanopy -wthlcovid src/addon/modheterostats.f90 /^ integer :: uthlcovid, vthlcovid, wthlcovid$/;" v module:modheterostats wthlcovid src/addon/modnetcdfstats.f90 /^ integer :: uthlcovid, vthlcovid, wthlcovid$/;" v module:modnetcdfstats wthlcovid src/modheterostats.f90 /^ integer :: wthlcovid$/;" v module:modheterostats -wthlcovsid src/addon/modheterostats.f90 /^ integer :: wthlcovsid$/;" v module:modheterostats wthlcovsid src/addon/modnetcdfstats.f90 /^ integer :: wthlcovsid$/;" v module:modnetcdfstats wthlcovsid src/modheterostats.f90 /^ integer :: wthlcovsid$/;" v module:modheterostats wthlres src/modgenstat.f90 /^ real, allocatable :: wthlres(/;" v module:modgenstat @@ -4292,9 +3641,7 @@ wthlsubl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: w wthlthavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wfavl,thlfavl,thvfavl,qtfavl,qlfavl,nrsampfl,massflxhavl, &$/;" v module:modsampling wthltmn src/modgenstat.f90 /^ real, allocatable :: wthlsmn (:),wthlrmn (:),wthltmn(/;" v module:modgenstat wthltot src/modgenstat.f90 /^ real, allocatable :: wthltot(/;" v module:modgenstat -wthvcovid src/addon/modheterostats.f90 /^ integer :: uthvcovid, vthvcovid, wthvcovid$/;" v module:modheterostats wthvcovid src/modheterostats.f90 /^ integer :: wthvcovid$/;" v module:modheterostats -wthvcovsid src/addon/modheterostats.f90 /^ integer :: wthvcovsid$/;" v module:modheterostats wthvcovsid src/modheterostats.f90 /^ integer :: wthvcovsid$/;" v module:modheterostats wthvres src/modgenstat.f90 /^ real, allocatable :: wthvres(/;" v module:modgenstat wthvrmn src/modgenstat.f90 /^ real, allocatable :: wthvsmn (:),wthvrmn /;" v module:modgenstat @@ -4305,31 +3652,15 @@ wthvthavl src/modsampling.f90 /^ wthlthav wthvtmn src/modgenstat.f90 /^ real, allocatable :: wthvsmn (:),wthvrmn (:),wthvtmn(/;" v module:modgenstat wthvtmnlast src/modgenstat.f90 /^ real, allocatable :: wthvtmnlast(/;" v module:modgenstat wthvtot src/modgenstat.f90 /^ real, allocatable :: wthvtot(/;" v module:modgenstat -wtlavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wavl,tlavl,tvavl,qtavl,qlavl,nrsampl,massflxavl, &$/;" v module:modsampling -wtlres src/addon/modgenstat.f90 /^ real, allocatable :: wtlres(/;" v module:modgenstat -wtlrmn src/addon/modgenstat.f90 /^ real, allocatable :: wtlsmn (:),wtlrmn /;" v module:modgenstat -wtlsmn src/addon/modgenstat.f90 /^ real, allocatable :: wtlsmn /;" v module:modgenstat -wtlsub src/addon/modgenstat.f90 /^ real, allocatable :: wtlsub(/;" v module:modgenstat -wtltmn src/addon/modgenstat.f90 /^ real, allocatable :: wtlsmn (:),wtlrmn (:),wtltmn(/;" v module:modgenstat -wtltot src/addon/modgenstat.f90 /^ real, allocatable :: wtltot(/;" v module:modgenstat wtsurf src/modsurfdata.f90 /^ real :: wtsurf /;" v module:modsurfdata wtsurft src/modtimedep.f90 /^ real, allocatable :: wtsurft /;" v module:modtimedep -wtvavl src/addon/modsampling.f90 /^ wtlavl,wtvavl,/;" v module:modsampling -wtvres src/addon/modgenstat.f90 /^ real, allocatable :: wtvres(/;" v module:modgenstat -wtvrmn src/addon/modgenstat.f90 /^ real, allocatable :: wtvsmn (:),wtvrmn /;" v module:modgenstat -wtvsmn src/addon/modgenstat.f90 /^ real, allocatable :: wtvsmn /;" v module:modgenstat -wtvsub src/addon/modgenstat.f90 /^ real, allocatable :: wtvsub(/;" v module:modgenstat -wtvtmn src/addon/modgenstat.f90 /^ real, allocatable :: wtvsmn (:),wtvrmn (:),wtvtmn(/;" v module:modgenstat -wtvtot src/addon/modgenstat.f90 /^ real, allocatable :: wtvtot(/;" v module:modgenstat wuresl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wuresl,/;" v module:modquadrant wusubl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wusubl,/;" v module:modquadrant -wvarid src/addon/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid,/;" v module:modheterostats wvarid src/addon/modnetcdfstats.f90 /^ integer :: uvarid, vvarid, wvarid,/;" v module:modnetcdfstats wvarid src/modheterostats.f90 /^ integer :: uvarid, vvarid, wvarid,/;" v module:modheterostats wvarl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uvarl,vvarl,wvarl,/;" v module:modquadrant wvresl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wuresl,wvresl,/;" v module:modquadrant wvsubl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: wusubl,wvsubl,/;" v module:modquadrant -wwavl src/addon/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwavl,/;" v module:modsampling wwrhavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,/;" v module:modsampling wwsfavl src/modsampling.f90 /^ real, allocatable, dimension(:,:) :: wwrhavl,wwsfavl,/;" v module:modsampling wz src/modradfull.f90 /^ real, allocatable :: re(:), fl(:), bz(:,:), wz(/;" v module:modradfull @@ -4344,7 +3675,6 @@ xcmax src/modmicrodata.f90 /^ ,xcmax /;" v module:modmicrodata xcmin src/addon/modbulkmicrodata.f90 /^ ,xcmin /;" v module:modbulkmicrodata xcmin src/modmicrodata.f90 /^ ,xcmin /;" v module:modmicrodata xday src/modglobal.f90 /^ real :: xday /;" v module:modglobal -xid src/addon/modheterostats.f90 /^ integer :: xid,/;" v module:modheterostats xid src/addon/modnetcdfmovie.f90 /^ integer :: xid,/;" v module:modnetcdfmovie xid src/addon/modnetcdfstats.f90 /^ integer :: xid,/;" v module:modnetcdfstats xid src/modheterostats.f90 /^ integer :: xid,/;" v module:modheterostats @@ -4357,7 +3687,6 @@ xidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie,/;" v module:modne xk src/modradfull.f90 /^ real, allocatable :: hk(:),sp(:),xk(/;" k type:ckd_properties xlat src/modglobal.f90 /^ real :: xlat /;" v module:modglobal xlon src/modglobal.f90 /^ real :: xlon /;" v module:modglobal -xmID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=/;" v module:modstat_nc xmID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=/;" v module:modstat_nc xmID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=/;" v module:modstat_nc xpatches src/modsurfdata.f90 /^ integer :: xpatches /;" v module:modsurfdata @@ -4371,14 +3700,12 @@ xrmin src/addon/modbulkmicrodata.f90 /^ ,xrmin /;" v module:modbulk xrmin src/modmicrodata.f90 /^ ,xrmin /;" v module:modmicrodata xsize src/modglobal.f90 /^ real :: xsize /;" v module:modglobal xstart src/addon/modparticles.f90 /^ real :: x,x_prev, xstart,/;" k type:particle_record -xtID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=/;" v module:modstat_nc xtID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=/;" v module:modstat_nc xtID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=/;" v module:modstat_nc xtime src/modglobal.f90 /^ real :: xtime /;" v module:modglobal xyrt src/modpois.f90 /^ real,allocatable :: xyrt(/;" v module:modpois y src/addon/modparticles.f90 /^ real :: y,/;" k type:particle_record y_prev src/addon/modparticles.f90 /^ real :: y,y_prev,/;" k type:particle_record -yid src/addon/modheterostats.f90 /^ integer :: xid, yid,/;" v module:modheterostats yid src/addon/modnetcdfmovie.f90 /^ integer :: xid, yid,/;" v module:modnetcdfmovie yid src/addon/modnetcdfstats.f90 /^ integer :: xid, yid,/;" v module:modnetcdfstats yid src/modheterostats.f90 /^ integer :: xid, yid,/;" v module:modheterostats @@ -4388,24 +3715,17 @@ yidfieldu src/addon/modnetcdfstats.f90 /^ integer :: xidfieldu, yidfieldu,/;" yidfieldv src/addon/modnetcdfstats.f90 /^ integer :: xidfieldv, yidfieldv,/;" v module:modnetcdfstats yidfieldw src/addon/modnetcdfstats.f90 /^ integer :: xidfieldw, yidfieldw,/;" v module:modnetcdfstats yidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie,/;" v module:modnetcdfstats -yl src/addon/modchem.f90 /^ real, allocatable,target :: yl(/;" v module:modchem yl src/modchem.f90 /^ real, allocatable,target :: yl(/;" v module:modchem -ymID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=/;" v module:modstat_nc ymID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=/;" v module:modstat_nc ymID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=/;" v module:modstat_nc -ynew src/addon/modchem.f90 /^ real, allocatable :: ynew(/;" v module:modchem ynew src/modchem.f90 /^ real, allocatable :: ynew(/;" v module:modchem -yold src/addon/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(/;" v module:modchem yold src/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(/;" v module:modchem -yp src/addon/modchem.f90 /^ real, allocatable,target :: yl(:,:,:),yp(/;" v module:modchem yp src/modchem.f90 /^ real, allocatable,target :: yl(:,:,:),yp(/;" v module:modchem ypatches src/modsurfdata.f90 /^ integer :: ypatches /;" v module:modsurfdata ysize src/modglobal.f90 /^ real :: ysize /;" v module:modglobal ysizelocal src/addon/modparticles.f90 /^ real :: ysizelocal$/;" v module:modparticles ystart src/addon/modparticles.f90 /^ real :: y,y_prev, ystart,/;" k type:particle_record -ysum src/addon/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(:,:,:),ysum(/;" v module:modchem ysum src/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(:,:,:),ysum(/;" v module:modchem -ytID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=/;" v module:modstat_nc ytID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=/;" v module:modstat_nc ytID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=/;" v module:modstat_nc z src/addon/modparticles.f90 /^ real :: z,/;" k type:particle_record @@ -4421,20 +3741,16 @@ z0mav_patch src/modsurfdata.f90 /^ real, allocatable :: z0mav_patch(/;" v modul z_prev src/addon/modparticles.f90 /^ real :: z,z_prev,/;" k type:particle_record zbase_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field,/;" v module:modtimestat zbase_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_patch,/;" v module:modtimestat -zbaseav src/addon/modtimestat.f90 /^ real :: zbaseav,/;" v module:modtimestat zbaseav src/modtimestat.f90 /^ real :: zbaseav,/;" v module:modtimestat -zbasemin src/addon/modtimestat.f90 /^ real :: zbaseav, ztopav, ztopmax,zbasemin$/;" v module:modtimestat zbasemin src/modtimestat.f90 /^ real :: zbaseav, ztopav, ztopmax,zbasemin$/;" v module:modtimestat zbasemin_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_patch, ztop_patch, zbasemin_patch,/;" v module:modtimestat zbasemin_patchl src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_patch, ztop_patch, zbasemin_patch, zbasemin_patchl$/;" v module:modtimestat zenith src/modraddata.f90 /^ real function zenith(/;" f module:modraddata zf src/modglobal.f90 /^ real, allocatable :: zf(/;" v module:modglobal zh src/modglobal.f90 /^ real, allocatable :: zh(/;" v module:modglobal -zi src/addon/modtimestat.f90 /^ real :: zi,/;" v module:modtimestat zi src/modtimestat.f90 /^ real :: zi,/;" v module:modtimestat zi_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,ziold_patch,we_patch, zi_field$/;" v module:modtimestat zi_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,/;" v module:modtimestat -zid src/addon/modheterostats.f90 /^ integer :: xid, yid, zid,/;" v module:modheterostats zid src/addon/modnetcdfmovie.f90 /^ integer :: xid, yid, zid,/;" v module:modnetcdfmovie zid src/addon/modnetcdfstats.f90 /^ integer :: xid, yid, zid,/;" v module:modnetcdfstats zid src/modheterostats.f90 /^ integer :: xid, yid, zid,/;" v module:modheterostats @@ -4444,11 +3760,9 @@ zidfieldu src/addon/modnetcdfstats.f90 /^ integer :: xidfieldu, yidfieldu, zidfieldv src/addon/modnetcdfstats.f90 /^ integer :: xidfieldv, yidfieldv, zidfieldv,/;" v module:modnetcdfstats zidfieldw src/addon/modnetcdfstats.f90 /^ integer :: xidfieldw, yidfieldw, zidfieldw,/;" v module:modnetcdfstats zidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie, zidmovie,/;" v module:modnetcdfstats -ziold src/addon/modtimestat.f90 /^ real :: zi,ziold=/;" v module:modtimestat ziold src/modtimestat.f90 /^ real :: zi,ziold=/;" v module:modtimestat ziold_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,ziold_patch,/;" v module:modtimestat zlt src/modsubgriddata.f90 /^ real, allocatable :: zlt(/;" v module:modsubgriddata -zmID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=/;" v module:modstat_nc zmID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=/;" v module:modstat_nc zmID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=/;" v module:modstat_nc zpad src/modcanopy.f90 /^ real, allocatable :: zpad(/;" v module:modcanopy @@ -4456,14 +3770,11 @@ zqID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, zsoil src/modsurfdata.f90 /^ real, allocatable :: zsoil /;" v module:modsurfdata zsoilc src/modsurfdata.f90 /^ real, allocatable :: zsoilc /;" v module:modsurfdata zstart src/addon/modparticles.f90 /^ real :: z,z_prev, zstart,/;" k type:particle_record -ztID src/addon/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=/;" v module:modstat_nc ztID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=/;" v module:modstat_nc ztID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=/;" v module:modstat_nc ztop_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field, ztop_field,/;" v module:modtimestat ztop_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_patch, ztop_patch,/;" v module:modtimestat -ztopav src/addon/modtimestat.f90 /^ real :: zbaseav, ztopav,/;" v module:modtimestat ztopav src/modtimestat.f90 /^ real :: zbaseav, ztopav,/;" v module:modtimestat -ztopmax src/addon/modtimestat.f90 /^ real :: zbaseav, ztopav, ztopmax,/;" v module:modtimestat ztopmax src/modtimestat.f90 /^ real :: zbaseav, ztopav, ztopmax,/;" v module:modtimestat ztopmax_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch, wmax_patchl, qlmax_patch, qlmax_patchl, ztopmax_patch,/;" v module:modtimestat ztopmax_patchl src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: wmax_patch, wmax_patchl, qlmax_patch, qlmax_patchl, ztopmax_patch, ztopmax_patchl$/;" v module:modtimestat From 6fc13e3c4705df4924f1a241a23f79385617a93a Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Wed, 13 Jul 2016 17:01:27 +0200 Subject: [PATCH 22/88] Also renamed stat_nc_dummy for proper matching --- .../{stat_nc_dummy.f90 => modstat_nc.dummy} | 0 tags | 23 ------------------- 2 files changed, 23 deletions(-) rename src/addon/{stat_nc_dummy.f90 => modstat_nc.dummy} (100%) diff --git a/src/addon/stat_nc_dummy.f90 b/src/addon/modstat_nc.dummy similarity index 100% rename from src/addon/stat_nc_dummy.f90 rename to src/addon/modstat_nc.dummy diff --git a/tags b/tags index 47467678..57f53761 100644 --- a/tags +++ b/tags @@ -162,7 +162,6 @@ NAMLSMSTAT src/modlsmstat.f90 /^ namelist\/NAMLSMSTAT\//;" n subroutine:initl NAMMICROPHYSICS src/modmicrophysics.f90 /^ namelist\/NAMMICROPHYSICS\//;" n subroutine:initmicrophysics NAMNETCDFMOVIE src/addon/modnetcdfmovie.f90 /^ namelist\/NAMNETCDFMOVIE\//;" n subroutine:initnetcdfmovie NAMNETCDFSTATS src/addon/modnetcdfstats.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initnetcdfstats -NAMNETCDFSTATS src/addon/stat_nc_dummy.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initstat_nc NAMNETCDFSTATS src/modstat_nc.f90 /^ namelist\/NAMNETCDFSTATS\//;" n subroutine:initstat_nc NAMNUDGE src/modnudge.f90 /^ namelist \/NAMNUDGE\//;" n subroutine:initnudge NAMPARTICLES src/addon/modparticles.f90 /^ namelist\/NAMPARTICLES\//;" n subroutine:initparticles @@ -696,7 +695,6 @@ ddg src/modmicrodata.f90 /^ ,ddg=/;" v module:modmicrodata ddr src/modmicrodata.f90 /^ ,ddr=/;" v module:modmicrodata dds src/modmicrodata.f90 /^ ,dds=/;" v module:modmicrodata default_conc src/modradfull.f90 /^ real :: mweight, default_conc,/;" k type:ckd_properties -define_nc src/addon/stat_nc_dummy.f90 /^ subroutine define_nc(/;" s module:modstat_nc define_nc src/modstat_nc.f90 /^ subroutine define_nc(/;" s module:modstat_nc delt src/addon/modbulkmicrodata.f90 /^ real :: delt$/;" v module:modbulkmicrodata delt src/modmicrodata.f90 /^ real :: delt$/;" v module:modmicrodata @@ -896,7 +894,6 @@ exitsampling src/modsampling.f90 /^ subroutine exitsampling$/;" s module:modsam exitsamptend src/modsamptend.f90 /^ subroutine exitsamptend$/;" s module:modsamptend exitsimpleice src/modsimpleice.f90 /^ subroutine exitsimpleice$/;" s module:modsimpleice exitsimpleicestat src/modsimpleicestat.f90 /^ subroutine exitsimpleicestat$/;" s module:modsimpleicestat -exitstat_nc src/addon/stat_nc_dummy.f90 /^ subroutine exitstat_nc(/;" s module:modstat_nc exitstat_nc src/modstat_nc.f90 /^ subroutine exitstat_nc(/;" s module:modstat_nc exitstattend src/modstattend.f90 /^ subroutine exitstattend$/;" s module:modstattend exitstressbudget src/addon/modstress.f90 /^ subroutine exitstressbudget$/;" s module:modstress @@ -1330,7 +1327,6 @@ initsampling src/modsampling.f90 /^ subroutine initsampling$/;" s module:modsam initsamptend src/modsamptend.f90 /^subroutine initsamptend$/;" s module:modsamptend initsimpleice src/modsimpleice.f90 /^ subroutine initsimpleice$/;" s module:modsimpleice initsimpleicestat src/modsimpleicestat.f90 /^subroutine initsimpleicestat$/;" s module:modsimpleicestat -initstat_nc src/addon/stat_nc_dummy.f90 /^ subroutine initstat_nc$/;" s module:modstat_nc initstat_nc src/modstat_nc.f90 /^ subroutine initstat_nc$/;" s module:modstat_nc initstattend src/modstattend.f90 /^subroutine initstattend$/;" s module:modstattend initstressbudget src/addon/modstress.f90 /^ subroutine initstressbudget$/;" s module:modstress @@ -1754,7 +1750,6 @@ lmomsubs src/modglobal.f90 /^ logical :: lmomsubs /;" v module:modglobal lmostlocal src/modsurfdata.f90 /^ logical :: lmostlocal /;" v module:modsurfdata lmoviez src/addon/modnetcdfmovie.f90 /^ logical :: lmoviez /;" v module:modnetcdfmovie lnetcdf src/addon/modnetcdfstats.f90 /^ logical :: lnetcdf /;" v module:modnetcdfstats -lnetcdf src/addon/stat_nc_dummy.f90 /^ logical :: lnetcdf$/;" v module:modstat_nc lnetcdf src/modstat_nc.f90 /^ logical :: lnetcdf /;" v module:modstat_nc lnetcdfmovie src/addon/modnetcdfmovie.f90 /^ logical :: lnetcdfmovie /;" v module:modnetcdfmovie lneutral src/modsurfdata.f90 /^ logical :: lneutral /;" v module:modsurfdata @@ -1927,7 +1922,6 @@ modsamptend src/modsamptend.f90 /^module modsamptend$/;" m modsimpleice src/modsimpleice.f90 /^module modsimpleice$/;" m modsimpleicestat src/modsimpleicestat.f90 /^module modsimpleicestat$/;" m modstartup src/modstartup.f90 /^module modstartup$/;" m -modstat_nc src/addon/stat_nc_dummy.f90 /^module modstat_nc$/;" m modstat_nc src/modstat_nc.f90 /^module modstat_nc$/;" m modstattend src/modstattend.f90 /^module modstattend$/;" m modstress src/addon/modstress.f90 /^module modstress$/;" m @@ -1985,7 +1979,6 @@ nbreast src/modmpi.f90 /^ integer :: nbreast$/;" v module:modmpi nbrnorth src/modmpi.f90 /^ integer :: nbrnorth$/;" v module:modmpi nbrsouth src/modmpi.f90 /^ integer :: nbrsouth$/;" v module:modmpi nbrwest src/modmpi.f90 /^ integer :: nbrwest$/;" v module:modmpi -nc_fillvalue src/addon/stat_nc_dummy.f90 /^ real :: nc_fillvalue=/;" v module:modstat_nc nc_fillvalue src/modstat_nc.f90 /^ real(kind=4) :: nc_fillvalue /;" v module:modstat_nc ncanopy src/modcanopy.f90 /^ integer :: ncanopy /;" v module:modcanopy nccall src/addon/modnetcdfmovie.f90 /^ integer :: nccall /;" v module:modnetcdfmovie @@ -2022,7 +2015,6 @@ ncidfieldu src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu,/;" v module:m ncidfieldv src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu, ncidfieldv,/;" v module:modnetcdfstats ncidfieldw src/addon/modnetcdfstats.f90 /^ integer :: ncidfieldu, ncidfieldv, ncidfieldw,/;" v module:modnetcdfstats ncidmovie src/addon/modnetcdfstats.f90 /^ integer :: ncidmovie$/;" v module:modnetcdfstats -ncinfo src/addon/stat_nc_dummy.f90 /^ subroutine ncinfo(/;" s module:modstat_nc ncinfo src/modstat_nc.f90 /^ subroutine ncinfo(/;" s module:modstat_nc ncklimit src/addon/modnetcdfmovie.f90 /^ integer :: ncklimit /;" v module:modnetcdfmovie ncklimit src/addon/modnetcdfstats.f90 /^ integer :: ncklimit /;" v module:modnetcdfstats @@ -2314,7 +2306,6 @@ om23 src/modglobal.f90 /^ real :: om23 /;" v module:modglobal om23_gs src/modglobal.f90 /^ real :: om23_gs /;" v module:modglobal oneminus src/rrlw_con.f90 /^ real(kind=rb) :: oneminus,/;" v module:rrlw_con oneminus src/rrsw_con.f90 /^ real(kind=rb) :: oneminus,/;" v module:rrsw_con -open_nc src/addon/stat_nc_dummy.f90 /^ subroutine open_nc /;" s module:modstat_nc open_nc src/modstat_nc.f90 /^ subroutine open_nc /;" s module:modstat_nc outp src/modchem.f90 /^ type (Chem) outp(/;" k type:Reaction p src/modpois.f90 /^ real,allocatable :: p(/;" v module:modpois @@ -2628,7 +2619,6 @@ read_chem src/modchem.f90 /^SUBROUTINE read_chem(/;" s module:modchem readinitfiles src/modstartup.f90 /^ subroutine readinitfiles$/;" s module:modstartup readrestartfiles src/modstartup.f90 /^ subroutine readrestartfiles$/;" s module:modstartup readthla src/addon/modtilt.f90 /^ subroutine readthla$/;" s module:modtilt -redefine_nc src/addon/stat_nc_dummy.f90 /^ subroutine redefine_nc(/;" s module:modstat_nc redefine_nc src/modstat_nc.f90 /^ subroutine redefine_nc(/;" s module:modstat_nc reff src/modraddata.f90 /^ real :: reff /;" v module:modraddata refparam src/rrlw_kg02.f90 /^ real(kind=rb) :: refparam(/;" v module:rrlw_kg02 @@ -3222,7 +3212,6 @@ tidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie, zidmovi tiltedboundary src/addon/modtilt.f90 /^ subroutine tiltedboundary$/;" s module:modtilt tiltedgravity src/addon/modtilt.f90 /^ subroutine tiltedgravity$/;" s module:modtilt tiltstat src/addon/modtilt.f90 /^ subroutine tiltstat$/;" s module:modtilt -timeID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=/;" v module:modstat_nc timeID src/modstat_nc.f90 /^ integer, save :: timeID=/;" v module:modstat_nc timeav src/addon/modparticles.f90 /^ real :: timeav /;" v module:modparticles timeav src/addon/modstress.f90 /^ real :: dtav, timeav$/;" v module:modstress @@ -3575,18 +3564,12 @@ writesampling src/modsampling.f90 /^ subroutine writesampling$/;" s module:mods writesamptend src/modsamptend.f90 /^ subroutine writesamptend$/;" s module:modsamptend writesimpleicestat src/modsimpleicestat.f90 /^ subroutine writesimpleicestat$/;" s module:modsimpleicestat writestat src/modgenstat.f90 /^ subroutine writestat$/;" s module:modgenstat -writestat_1D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_1D_nc(/;" s module:modstat_nc writestat_1D_nc src/modstat_nc.f90 /^ subroutine writestat_1D_nc(/;" s module:modstat_nc -writestat_2D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_2D_nc(/;" s module:modstat_nc writestat_2D_nc src/modstat_nc.f90 /^ subroutine writestat_2D_nc(/;" s module:modstat_nc -writestat_3D_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_3D_nc(/;" s module:modstat_nc writestat_3D_nc src/modstat_nc.f90 /^ subroutine writestat_3D_nc(/;" s module:modstat_nc -writestat_3D_short_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_3D_short_nc(/;" s module:modstat_nc writestat_3D_short_nc src/modstat_nc.f90 /^ subroutine writestat_3D_short_nc(/;" s module:modstat_nc -writestat_dims_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_dims_nc(/;" s module:modstat_nc writestat_dims_nc src/modstat_nc.f90 /^ subroutine writestat_dims_nc(/;" s module:modstat_nc writestat_dims_q_nc src/modstat_nc.f90 /^ subroutine writestat_dims_q_nc(/;" s module:modstat_nc -writestat_time_nc src/addon/stat_nc_dummy.f90 /^ subroutine writestat_time_nc(/;" s module:modstat_nc writestat_time_nc src/modstat_nc.f90 /^ subroutine writestat_time_nc(/;" s module:modstat_nc writestattend src/modstattend.f90 /^ subroutine writestattend$/;" s module:modstattend writestressbudget src/addon/modstress.f90 /^ subroutine writestressbudget$/;" s module:modstress @@ -3687,7 +3670,6 @@ xidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie,/;" v module:modne xk src/modradfull.f90 /^ real, allocatable :: hk(:),sp(:),xk(/;" k type:ckd_properties xlat src/modglobal.f90 /^ real :: xlat /;" v module:modglobal xlon src/modglobal.f90 /^ real :: xlon /;" v module:modglobal -xmID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=/;" v module:modstat_nc xmID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=/;" v module:modstat_nc xpatches src/modsurfdata.f90 /^ integer :: xpatches /;" v module:modsurfdata xr src/addon/modbulkmicrodata.f90 /^ ,xr /;" v module:modbulkmicrodata @@ -3700,7 +3682,6 @@ xrmin src/addon/modbulkmicrodata.f90 /^ ,xrmin /;" v module:modbulk xrmin src/modmicrodata.f90 /^ ,xrmin /;" v module:modmicrodata xsize src/modglobal.f90 /^ real :: xsize /;" v module:modglobal xstart src/addon/modparticles.f90 /^ real :: x,x_prev, xstart,/;" k type:particle_record -xtID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=/;" v module:modstat_nc xtID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=/;" v module:modstat_nc xtime src/modglobal.f90 /^ real :: xtime /;" v module:modglobal xyrt src/modpois.f90 /^ real,allocatable :: xyrt(/;" v module:modpois @@ -3716,7 +3697,6 @@ yidfieldv src/addon/modnetcdfstats.f90 /^ integer :: xidfieldv, yidfieldv,/;" yidfieldw src/addon/modnetcdfstats.f90 /^ integer :: xidfieldw, yidfieldw,/;" v module:modnetcdfstats yidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie,/;" v module:modnetcdfstats yl src/modchem.f90 /^ real, allocatable,target :: yl(/;" v module:modchem -ymID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=/;" v module:modstat_nc ymID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=/;" v module:modstat_nc ynew src/modchem.f90 /^ real, allocatable :: ynew(/;" v module:modchem yold src/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(/;" v module:modchem @@ -3726,7 +3706,6 @@ ysize src/modglobal.f90 /^ real :: ysize /;" v module:modglobal ysizelocal src/addon/modparticles.f90 /^ real :: ysizelocal$/;" v module:modparticles ystart src/addon/modparticles.f90 /^ real :: y,y_prev, ystart,/;" k type:particle_record ysum src/modchem.f90 /^ real, allocatable :: ynew(:,:,:),yold(:,:,:),ysum(/;" v module:modchem -ytID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=/;" v module:modstat_nc ytID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=/;" v module:modstat_nc z src/addon/modparticles.f90 /^ real :: z,/;" k type:particle_record z0 src/modsurfdata.f90 /^ real :: z0 /;" v module:modsurfdata @@ -3763,14 +3742,12 @@ zidmovie src/addon/modnetcdfstats.f90 /^ integer :: xidmovie, yidmovie, zidmovi ziold src/modtimestat.f90 /^ real :: zi,ziold=/;" v module:modtimestat ziold_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,ziold_patch,/;" v module:modtimestat zlt src/modsubgriddata.f90 /^ real, allocatable :: zlt(/;" v module:modsubgriddata -zmID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=0, zmID=/;" v module:modstat_nc zmID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=/;" v module:modstat_nc zpad src/modcanopy.f90 /^ real, allocatable :: zpad(/;" v module:modcanopy zqID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=0, zmID=0, xtID=0, xmID=0, ytID=0, ymID=0,ztsID=0, zqID=/;" v module:modstat_nc zsoil src/modsurfdata.f90 /^ real, allocatable :: zsoil /;" v module:modsurfdata zsoilc src/modsurfdata.f90 /^ real, allocatable :: zsoilc /;" v module:modsurfdata zstart src/addon/modparticles.f90 /^ real :: z,z_prev, zstart,/;" k type:particle_record -ztID src/addon/stat_nc_dummy.f90 /^ integer, save :: timeID=0, ztID=/;" v module:modstat_nc ztID src/modstat_nc.f90 /^ integer, save :: timeID=0, ztID=/;" v module:modstat_nc ztop_field src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_field, ztop_field,/;" v module:modtimestat ztop_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zbase_patch, ztop_patch,/;" v module:modtimestat From f2d8eb09c7c426dfc1ecab8896085508423f9bbb Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Wed, 13 Jul 2016 18:05:17 +0200 Subject: [PATCH 23/88] Further cleaning --- src/modradfull.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/modradfull.f90 b/src/modradfull.f90 index ba28cb21..4eb4b76e 100644 --- a/src/modradfull.f90 +++ b/src/modradfull.f90 @@ -195,7 +195,7 @@ end subroutine radfull subroutine d4stream(i1,ih,j1,jh,k1, tskin, albedo, CCN, dn0, & pi0, tk, rv, rc, fds3D,fus3D,fdir3D,fuir3D, rr,lclear) - use modglobal, only : cexpnr,cp,cpr,pi,pref0,rtimee,xday,xlat,xlon,xtime,rhow + use modglobal, only : cexpnr,cp,cpr,pref0,rtimee,xday,xlat,xlon,xtime,rhow use modraddata,only : useMcICA,zenith,sw0,SW_up_TOA, SW_dn_TOA, LW_up_TOA, LW_dn_TOA, & SW_up_ca_TOA, SW_dn_ca_TOA, LW_up_ca_TOA, LW_dn_ca_TOA use modtestbed, only : ltestbed @@ -1104,9 +1104,9 @@ subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) tkm1 = 0.0 do k = 1, nv f0a(k) = 2.0 * ( 1.0 - w(k) ) * bf(k) - u0a(k) = -(t(k)-tkm1) / ( alog( bf(k+1)/bf(k) )) - u0a(k) = sign(max(abs(u0a(k)),1.e-8),u0a(k)) - tkm1 = t(k) + u0a(k) = -(t(k)-tkm1) / ( alog( bf(k+1)/bf(k) )) + u0a(k) = sign(max(abs(u0a(k)),1.e-8),u0a(k)) + tkm1 = t(k) end do end if @@ -1211,7 +1211,6 @@ end subroutine rad !> subroutine rad_ir (pts, ee, pp, pt, ph, po, fdir, fuir, & plwc, pre, useMcICA ) - use modglobal, only : pi real, intent (in) :: pp (nv1) ! pressure at interfaces From 04acf9ce0b278f2abfe9f5e0c2ddde3e57d95b73 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Wed, 13 Jul 2016 20:54:15 +0200 Subject: [PATCH 24/88] Remove unused variable --- src/modstat_nc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/modstat_nc.f90 b/src/modstat_nc.f90 index 7f6b4e5e..1f647fc2 100644 --- a/src/modstat_nc.f90 +++ b/src/modstat_nc.f90 @@ -73,11 +73,11 @@ end subroutine initstat_nc ! ---------------------------------------------------------------------- !> Subroutine Open_NC: Opens a NetCDF File and identifies starting record ! - subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq, ncoarse) + subroutine open_nc (fname, ncid,nrec,n1, n2, n3, ns,nq) use modglobal, only : author,version,rtimee implicit none integer, intent (out) :: ncid,nrec - integer, optional, intent (in) :: n1, n2, n3, ns, ncoarse, nq + integer, optional, intent (in) :: n1, n2, n3, ns, nq character (len=40), intent (in) :: fname character (len=12):: date='',time='' From 1482a76311edfe2d92d44e29d78bae7c93cedabf Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 13 Jul 2016 17:07:17 -0400 Subject: [PATCH 25/88] Put wctime check in subroutine in modstartup --- src/modglobal.f90 | 1 - src/modstartup.f90 | 25 ++++++++++++++++++++++--- src/program.f90 | 15 +++++---------- 3 files changed, 27 insertions(+), 14 deletions(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index b16e4d32..920fcfcd 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -170,7 +170,6 @@ module modglobal integer(kind=longint) :: btime !< * time of (re)start integer :: ntrun !< * number of timesteps since the start of the run integer(kind=longint) :: timeleft - real :: wctime=8640000. !< * The maximum wall clock time of a simulation (set to 100 days by default) logical :: ladaptive = .false. !< * adaptive timestepping on or off logical :: ltotruntime = .false. !< * Whether the runtime is counted since the last cold start (if true) or the last warm start (if false, default) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 7a2f9b66..fafeb386 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -41,6 +41,7 @@ module modstartup integer :: krand = huge(0), krandumin=1,krandumax=0 real :: randthl= 0.1,randqt=1e-5 ! * thl and qt amplitude of randomnization real :: randu = 0.5 + real :: wctime=8640000. !< * The maximum wall clock time of a simulation (set to 100 days by default) contains subroutine startup @@ -53,7 +54,7 @@ subroutine startup ! Thijs Heus 15/06/2007 | !-----------------------------------------------------------------| - use modglobal, only : initglobal,iexpnr, ltotruntime, runtime, dtmax, wctime, dtav_glob,timeav_glob,& + use modglobal, only : initglobal,iexpnr, ltotruntime, runtime, dtmax, dtav_glob,timeav_glob,& lwarmstart,startfile,trestart,& nsv,itot,jtot,kmax,xsize,ysize,xlat,xlon,xday,xtime,& lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,llstend,& @@ -244,11 +245,10 @@ subroutine startup ! Initialize MPI call initmpi + call testwctime ! Allocate and initialize core modules call initglobal -print *, runtime call initfields -print *, runtime call inittestbed !reads initial profiles from scm_in.nc, to be used in readinitfiles call initboundary @@ -1011,6 +1011,25 @@ subroutine writerestartfiles end subroutine writerestartfiles + subroutine testwctime + use modmpi, only : mpi_get_time + use modglobal, only : timeleft + implicit none + real, save :: tstart = -1., tend = -1. + + if (tstart < 0) then + call mpi_get_time(tstart) + else + call mpi_get_time(tstart) + if (tend-tstart>=wctime) then + write (*,*) wctime, "NO WALL CLOCK TIME LEFT" + timeleft=0 + end if + end if + + + end subroutine testwctime + subroutine exitmodules use modfields, only : exitfields use modglobal, only : exitglobal diff --git a/src/program.f90 b/src/program.f90 index 535ab546..f69a39d1 100644 --- a/src/program.f90 +++ b/src/program.f90 @@ -100,9 +100,8 @@ program DALES !Version 4.0.0alpha !!---------------------------------------------------------------- !! 0.0 USE STATEMENTS FOR CORE MODULES !!---------------------------------------------------------------- - use modglobal, only : rk3step,timeleft, wctime - use modmpi, only : mpi_get_time - use modstartup, only : startup, writerestartfiles,exitmodules + use modglobal, only : rk3step,timeleft + use modstartup, only : startup, writerestartfiles,testwctime,exitmodules use modtimedep, only : timedep use modboundary, only : boundary, grwdamp! JvdD ,tqaver use modthermodynamics, only : thermodynamics @@ -152,7 +151,6 @@ program DALES !Version 4.0.0alpha implicit none - real :: t0,t2 !---------------------------------------------------------------- ! 1 READ NAMELISTS,INITIALISE GRID, CONSTANTS AND FIELDS @@ -196,7 +194,7 @@ program DALES !Version 4.0.0alpha !------------------------------------------------------ ! 3.0 MAIN TIME LOOP !------------------------------------------------------ - call mpi_get_time(t0) + call testwctime do while (timeleft>0 .or. rk3step < 3) call tstep_update ! Calculate new timestep @@ -289,11 +287,8 @@ program DALES !Version 4.0.0alpha call budgetstat !call stressbudgetstat call heterostats - call mpi_get_time(t2) - if (t2-t0>=wctime) then - write (*,*) wctime, "NO WALL CLOCK TIME LEFT" - timeleft=0 - end if + + call testwctime call writerestartfiles end do From 89641b3ca7582fe29d6449c17c767cba1d9452c4 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 13 Jul 2016 17:16:50 -0400 Subject: [PATCH 26/88] Remove llstend switch; had become obsolecent somewhere before 4.2 --- src/modglobal.f90 | 1 - src/modstartup.f90 | 5 ++--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index 920fcfcd..c366a502 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -55,7 +55,6 @@ module modglobal character(50) :: startfile !< * name of the restart file logical :: llsadv = .false. !< switch for large scale forcings - logical :: llstend = .true. !< switch for large scale forcings !< Parameter kinds, for rrtmg radiation scheme integer, parameter :: kind_rb = selected_real_kind(12) ! 8 byte real diff --git a/src/modstartup.f90 b/src/modstartup.f90 index fafeb386..8fcf4694 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -57,7 +57,7 @@ subroutine startup use modglobal, only : initglobal,iexpnr, ltotruntime, runtime, dtmax, dtav_glob,timeav_glob,& lwarmstart,startfile,trestart,& nsv,itot,jtot,kmax,xsize,ysize,xlat,xlon,xday,xtime,& - lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,llstend,& + lmoist,lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,cu, cv,ifnamopt,fname_options,llsadv,& ibas_prf,lambda_crit,iadv_mom,iadv_tke,iadv_thl,iadv_qt,iadv_sv,courant,peclet,ladaptive,author,lnoclouds,lrigidlid,unudge use modforces, only : lforce_user use modsurfdata, only : z0,ustin,wtsurf,wqsurf,wsvsurf,ps,thls,isurf @@ -97,7 +97,7 @@ subroutine startup lcoriol,lpressgrad,igrw_damp,geodamptime,lmomsubs,ltimedep,ltimedepsv,irad,timerad,iradiation,rad_ls,rad_longw,rad_shortw,rad_smoke,useMcICA,& rka,dlwtop,dlwbot,sw0,gc,reff,isvsmoke,lforce_user,lcloudshading,lrigidlid,unudge namelist/DYNAMICS/ & - llsadv, llstend, lqlnr, lambda_crit, cu, cv, ibas_prf, iadv_mom, iadv_tke, iadv_thl, iadv_qt, iadv_sv, lnoclouds + llsadv, lqlnr, lambda_crit, cu, cv, ibas_prf, iadv_mom, iadv_tke, iadv_thl, iadv_qt, iadv_sv, lnoclouds ! get myid call MPI_INIT(mpierr) @@ -214,7 +214,6 @@ subroutine startup call MPI_BCAST(lcloudshading,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(llsadv ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) - call MPI_BCAST(llstend ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lqlnr ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(lambda_crit,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) call MPI_BCAST(cu ,1,MY_REAL ,0,MPI_COMM_WORLD,mpierr) From 512dc798b5428f68e92157d7a37dd0139e02fac1 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 13 Jul 2016 17:28:03 -0400 Subject: [PATCH 27/88] Remove Qnetav from ls_flux input --- src/modtimedep.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/modtimedep.f90 b/src/modtimedep.f90 index 694de711..ef1db244 100644 --- a/src/modtimedep.f90 +++ b/src/modtimedep.f90 @@ -207,8 +207,8 @@ subroutine inittimedep ierr = 0 do while (timeflux(t) < runtime) t=t+1 - read(ifinput,*, iostat = ierr) timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) - write(*,'(i8,7e12.4)') t,timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t),Qnetavt(t) + read(ifinput,*, iostat = ierr) timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t) + write(*,'(i8,6e12.4)') t,timeflux(t), wtsurft(t), wqsurft(t),thlst(t),qtst(t),pst(t) if (ierr < 0) then stop 'STOP: No time dependend data for end of run (surface fluxes)' end if From f58e9751f61071c82f7ce20db1ac4013c4b44be0 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Wed, 13 Jul 2016 18:58:17 -0400 Subject: [PATCH 28/88] A few more unused variables --- src/modcrosssection.f90 | 2 +- src/modlsmcrosssection.f90 | 2 +- src/modprojection.f90 | 2 +- src/modtimedep.f90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/modcrosssection.f90 b/src/modcrosssection.f90 index 6bf03cfe..a81f4c79 100644 --- a/src/modcrosssection.f90 +++ b/src/modcrosssection.f90 @@ -198,7 +198,7 @@ end subroutine initcrosssection !>Run crosssection. Mainly timekeeping subroutine crosssection use modglobal, only : rk3step,timee,dt_lim - use modstat_nc, only : lnetcdf, writestat_nc + use modstat_nc, only : writestat_nc implicit none diff --git a/src/modlsmcrosssection.f90 b/src/modlsmcrosssection.f90 index 62a460ff..e7d5e159 100644 --- a/src/modlsmcrosssection.f90 +++ b/src/modlsmcrosssection.f90 @@ -169,7 +169,7 @@ end subroutine initlsmcrosssection !>Run lsmcrosssection. Mainly timekeeping subroutine lsmcrosssection use modglobal, only : rk3step,timee,dt_lim - use modstat_nc, only : lnetcdf, writestat_nc + use modstat_nc, only : writestat_nc implicit none diff --git a/src/modprojection.f90 b/src/modprojection.f90 index db7e45fd..a60972df 100644 --- a/src/modprojection.f90 +++ b/src/modprojection.f90 @@ -67,7 +67,7 @@ module modprojection subroutine initprojection use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer,cmyid use modglobal,only :imax,jmax,ifnamopt,fname_options,dtmax,dtav_glob,ladaptive,kmax,dt_lim,tres,btime,cexpnr,zf - use modstat_nc, only : lnetcdf, open_nc,define_nc,ncinfo, writestat_dims_nc + use modstat_nc, only : open_nc,define_nc,ncinfo, writestat_dims_nc implicit none integer :: ierr diff --git a/src/modtimedep.f90 b/src/modtimedep.f90 index ef1db244..de589695 100644 --- a/src/modtimedep.f90 +++ b/src/modtimedep.f90 @@ -357,7 +357,7 @@ subroutine timedepz dpdxl,dpdyl use modglobal, only : rtimee,om23_gs,dzf,dzh,k1,kmax,llsadv - use modtestbed, only : ltestbed + use modmpi, only : myid implicit none From bb0652e4834b45adb7a793ff23123b9487720d25 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 14 Jul 2016 12:32:15 +0200 Subject: [PATCH 29/88] updated tags file for cleaned code --- tags | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/tags b/tags index 57f53761..b3c58a64 100644 --- a/tags +++ b/tags @@ -18,7 +18,6 @@ 5400 src/rrtmg_sw_setcoef.f90 /^ 5400 continue$/;" l subroutine:setcoef_sw file: 60 src/modchem.f90 /^60 continue$/;" l subroutine:twostep2 file: 600 src/modradfull.f90 /^600 format ('-----------------------------------------------------------', &$/;" l subroutine:init_ckd file: -600 src/modradfull.f90 /^600 format(\/'CLOUD_INIT WARNING: Extrapolating because data out of range', &$/;" l subroutine:interpolate file: 601 src/modradfull.f90 /^601 format (' -----------', &$/;" l subroutine:init_ckd file: 602 src/modradfull.f90 /^602 format ('----------- ', &$/;" l subroutine:init_ckd file: 604 src/modradfull.f90 /^604 format ('---------------------------------------- Finished band init ')$/;" l subroutine:init_ckd file: @@ -1348,7 +1347,6 @@ inr src/addon/modbulkmicrodata.f90 /^ integer :: inr /;" v module:modbulkmicrod inr src/modmicrodata.f90 /^ integer :: inr /;" v module:modmicrodata interfaceP src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: interfaceP,/;" v module:modraddata interfaceT src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: interfaceP, &$/;" v module:modraddata -interpolate src/modradfull.f90 /^ subroutine interpolate(/;" s module:modradfull intmeth src/addon/modparticles.f90 /^ integer :: intmeth /;" v module:modparticles intrpl src/modradfull.f90 /^ real function intrpl(/;" f module:modradfull ioverlap src/modraddata.f90 /^ integer :: ioverlap /;" v module:modraddata @@ -1741,7 +1739,6 @@ liquidRe src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: llimit src/modradfull.f90 /^ real :: llimit,/;" k type:band_properties llimit src/modradfull.f90 /^ elemental real function llimit(/;" f module:modradfull llsadv src/modglobal.f90 /^ logical :: llsadv /;" v module:modglobal -llstend src/modglobal.f90 /^ logical :: llstend /;" v module:modglobal lmason src/modsubgriddata.f90 /^ logical :: lmason /;" v module:modsubgriddata lmicrostat src/modbulkmicrostat.f90 /^ logical :: lmicrostat /;" v module:modbulkmicrostat lmicrostat src/modsimpleicestat.f90 /^ logical :: lmicrostat /;" v module:modsimpleicestat @@ -1815,6 +1812,7 @@ ltimedepsvz src/modtimedepsv.f90 /^ logical :: ltimedepsvz /;" v module:m ltimedepz src/modtimedep.f90 /^ logical :: ltimedepz /;" v module:modtimedep ltimestat src/modtimestat.f90 /^ logical :: ltimestat=/;" v module:modtimestat ltkeb src/modbudget.f90 /^ logical :: ltkeb /;" v module:modbudget +ltotruntime src/modglobal.f90 /^ logical :: ltotruntime /;" v module:modglobal lunudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,/;" v module:modnudge lvnudge src/modnudge.f90 /^ logical :: lnudge = .false.,lunudge,lvnudge,/;" v module:modnudge lwDownCS_slice src/modraddata.f90 /^ lwUpCS_slice, & ! Upwelling longwave rad, clear sky value (2D slice)$/;" v module:modraddata @@ -2251,7 +2249,6 @@ nsv src/modglobal.f90 /^ integer :: nsv /;" v module:modglobal nt src/modradfull.f90 /^ inte/;" k type:ckd_properties ntbl src/rrlw_tbl.f90 /^ integer(kind=im), parameter :: ntbl /;" v module:rrlw_tbl ntbl src/rrsw_tbl.f90 /^ integer(kind=im), parameter :: ntbl /;" v module:rrsw_tbl -ntimee src/modglobal.f90 /^ integer :: ntimee /;" v module:modglobal ntnudge src/modnudge.f90 /^ integer :: ntnudge /;" v module:modnudge ntnudge src/modtestbed.f90 /^ integer :: nknudge,ntnudge$/;" v module:modtestbed ntrun src/modglobal.f90 /^ integer :: ntrun /;" v module:modglobal @@ -3002,8 +2999,6 @@ swuca src/modraddata.f90 /^ real, allocatable :: swuca(/;" v module:modraddata swucaav src/modradstat.f90 /^ real, allocatable :: swucaav(/;" v module:modradstat swucamn src/modradstat.f90 /^ real, allocatable :: swucamn(/;" v module:modradstat swumn src/modradstat.f90 /^ real, allocatable :: swumn(/;" v module:modradstat -t0 src/program.f90 /^ real :: t0,/;" v program:DALES -t2 src/program.f90 /^ real :: t0,t2$/;" v program:DALES t_ref src/modchem.f90 /^ real t_ref,/;" v module:modchem tabs_slice src/modraddata.f90 /^ real(kind=kind_rb),allocatable,dimension(:,:) :: tabs_slice,/;" v module:modraddata tadv src/addon/modstress.f90 /^ real, allocatable, dimension (:,:,:) :: tadv /;" v module:modstress @@ -3121,6 +3116,7 @@ tendskin_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: Qnet_ tendskinid src/addon/modnetcdfmovie.f90 /^ integer :: Hid, LEid, G0id, tendskinid,/;" v module:modnetcdfmovie testbed_getinttime src/modtestbed.f90 /^ subroutine testbed_getinttime(/;" s module:modtestbed testbednudge src/modtestbed.f90 /^ subroutine testbednudge$/;" s module:modtestbed +testwctime src/modstartup.f90 /^ subroutine testwctime$/;" s module:modstartup tfn_tbl src/rrlw_tbl.f90 /^ real(kind=rb) , dimension(0:ntbl) :: tfn_tbl$/;" v module:rrlw_tbl tg_slice src/modraddata.f90 /^ real,allocatable,dimension(:) :: tg_slice /;" v module:modraddata th0av src/modgenstat.f90 /^ real, allocatable :: th0av(/;" v module:modgenstat @@ -3488,7 +3484,7 @@ wavgid src/modheterostats.f90 /^ integer :: uavgid, vavgid, wavgid,/;" v module wavl src/modquadrant.f90 /^ real, allocatable, dimension(:,:) :: uavl,vavl,wavl,/;" v module:modquadrant wco2Field src/modsurfdata.f90 /^ real, allocatable :: wco2Field /;" v module:modsurfdata wco2av src/modsurfdata.f90 /^ real :: wco2av /;" v module:modsurfdata -wctime src/modglobal.f90 /^ real :: wctime=/;" v module:modglobal +wctime src/modstartup.f90 /^ real :: wctime=/;" v module:modstartup we src/modtimestat.f90 /^ real :: zi,ziold=-1, we$/;" v module:modtimestat we_patch src/modtimestat.f90 /^ real,allocatable, dimension(:,:) :: zi_patch,ziold_patch,we_patch,/;" v module:modtimestat wfall_Nr src/addon/modbulkmicrodata.f90 /^ ,wfall_Nr /;" v module:modbulkmicrodata From 39a8e25eacaed64155045174bc42d4c495e8684f Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 14 Jul 2016 14:46:13 +0200 Subject: [PATCH 30/88] Removed loading of unused subroutine --- src/program.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/program.f90 b/src/program.f90 index f69a39d1..2047ae94 100644 --- a/src/program.f90 +++ b/src/program.f90 @@ -144,7 +144,7 @@ program DALES !Version 4.0.0alpha !use modtilt, only : inittilt, tiltedgravity, tiltedboundary, exittilt !use modparticles, only : initparticles, particles, exitparticles use modnudge, only : initnudge, nudge, exitnudge - use modtestbed, only : inittestbed, testbednudge, exittestbed + use modtestbed, only : testbednudge, exittestbed !use modprojection, only : initprojection, projection use modchem, only : initchem,twostep use modcanopy, only : initcanopy, canopy, exitcanopy From 57ad300ae1e6f7ce56f208bb64992bc5e8a5fc9e Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 14 Jul 2016 16:41:11 +0200 Subject: [PATCH 31/88] Cleaned RRTMG code --- src/modradrrtmg.f90 | 10 ++++------ src/rrtmg_lw_rad.f90 | 7 +++---- src/rrtmg_lw_rtrnmr.f90 | 6 +----- src/rrtmg_lw_taumol.f90 | 8 +------- src/rrtmg_sw_rad.f90 | 32 ++++++++++++------------------ src/rrtmg_sw_reftra.f90 | 2 +- src/rrtmg_sw_setcoef.f90 | 4 +--- src/rrtmg_sw_spcvrt.f90 | 42 ++++++++++------------------------------ 8 files changed, 33 insertions(+), 78 deletions(-) diff --git a/src/modradrrtmg.f90 b/src/modradrrtmg.f90 index 724c6908..575cbe63 100644 --- a/src/modradrrtmg.f90 +++ b/src/modradrrtmg.f90 @@ -23,8 +23,7 @@ subroutine radrrtmg integer :: npatch ! Sounding levels above domain integer :: i,j,k,ierr(3) logical :: sunUp - real(SHR_KIND_R4),save :: eccf, & ! eccentricity factor (1./earth-sun dist^2) - eccen, & ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) + real(SHR_KIND_R4),save :: eccen, & ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) obliq, & ! Earth's obliquity angle (deg) (-90 to +90) (typically 22-26) mvelp, & ! Earth's moving vernal equinox at perhelion (deg)(0 to 360.0) ! @@ -162,7 +161,7 @@ subroutine radrrtmg ! Loop over the slices in the model, in the y direction do j=2,j1 call setupSlicesFromProfiles & - ( j, npatch_start, npatch_end, & !input + ( j, npatch_start, & !input LWP_slice, IWP_slice, cloudFrac, liquidRe, iceRe ) !output if (rad_longw) then @@ -543,7 +542,7 @@ end subroutine readTraceProfs ! ==============================================================================; ! ==============================================================================; - subroutine setupSlicesFromProfiles(j,npatch_start,npatch_end, & + subroutine setupSlicesFromProfiles(j,npatch_start, & LWP_slice,IWP_slice,cloudFrac,liquidRe,iceRe) !=============================================================================! ! This subroutine sets up 2D (xz) slices of different variables: ! @@ -565,7 +564,7 @@ subroutine setupSlicesFromProfiles(j,npatch_start,npatch_end, & implicit none - integer,intent(in) :: j,npatch_start,npatch_end + integer,intent(in) :: j,npatch_start real(KIND=kind_rb),intent(out) :: LWP_slice(imax,krad1), & IWP_slice(imax,krad1), & cloudFrac(imax,krad1), & @@ -759,7 +758,6 @@ subroutine setupSW(sunUp) end if call shr_orb_decl( dayForSW ) ! Saves some orbital values to modraddata - !if (myid==0) write(*,*) 'eccf = ',eccf solarZenithAngleCos(:) = & zenith(xtime*3600 + rtimee, xday, xlat, xlon) ! Used function in modraddata ! solarZenithAngleCos(:) = 0.707106781 ! cos 45gr diff --git a/src/rrtmg_lw_rad.f90 b/src/rrtmg_lw_rad.f90 index a0350cfd..b16d0fbd 100644 --- a/src/rrtmg_lw_rad.f90 +++ b/src/rrtmg_lw_rad.f90 @@ -279,8 +279,7 @@ subroutine rrtmg_lw & integer(kind=im) :: iout ! output option flag (inactive) integer(kind=im) :: iaer ! aerosol option flag integer(kind=im) :: iplon ! column loop index - integer(kind=im) :: imca ! flag for mcica [0=off, 1=on] - integer(kind=im) :: i,k ! layer loop index + integer(kind=im) :: k ! layer loop index integer(kind=im) :: ig ! g-point loop index ! Atmosphere @@ -466,7 +465,7 @@ subroutine rrtmg_lw & ! each longwave spectral band. call taumol(nlayers, pavel, wx, coldry, & - laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + laytrop, jp, jt, jt1, & colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & colbrd, fac00, fac01, fac10, fac11, & rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & @@ -689,7 +688,7 @@ subroutine inatm (iplon, nlay, icld, iaer, & real(kind=rb), parameter :: amdc1 = 0.210852_rb ! Molecular weight of dry air / CFC11 real(kind=rb), parameter :: amdc2 = 0.239546_rb ! Molecular weight of dry air / CFC12 - integer(kind=im) :: isp, l, ix, n, imol, ib ! Loop indices + integer(kind=im) :: l, ix, n, imol, ib ! Loop indices real(kind=rb) :: amm, amttl, wvttl, wvsh, summol diff --git a/src/rrtmg_lw_rtrnmr.f90 b/src/rrtmg_lw_rtrnmr.f90 index 5528ad68..d7240e0a 100644 --- a/src/rrtmg_lw_rtrnmr.f90 +++ b/src/rrtmg_lw_rtrnmr.f90 @@ -105,14 +105,12 @@ subroutine rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, & ! ----- Local ----- ! Declarations for radiative transfer - real(kind=rb) :: abscld(nlayers,nbndlw) real(kind=rb) :: atot(nlayers) real(kind=rb) :: atrans(nlayers) real(kind=rb) :: bbugas(nlayers) real(kind=rb) :: bbutot(nlayers) real(kind=rb) :: clrurad(0:nlayers) real(kind=rb) :: clrdrad(0:nlayers) - real(kind=rb) :: efclfrac(nlayers,nbndlw) real(kind=rb) :: uflux(0:nlayers) real(kind=rb) :: dflux(0:nlayers) real(kind=rb) :: urad(0:nlayers) @@ -124,7 +122,7 @@ subroutine rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, & real(kind=rb) :: secdiff(nbndlw) ! secant of diffusivity angle real(kind=rb) :: a0(nbndlw),a1(nbndlw),a2(nbndlw)! diffusivity angle adjustment coefficients real(kind=rb) :: wtdiff, rec_6 - real(kind=rb) :: transcld, radld, radclrd, plfrac, blay, dplankup, dplankdn + real(kind=rb) :: radld, radclrd, plfrac, blay, dplankup, dplankdn real(kind=rb) :: odepth, odtot, odepth_rec, odtot_rec, gassrc, ttot real(kind=rb) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac real(kind=rb) :: rad0, reflect, radlu, radclru @@ -177,7 +175,6 @@ subroutine rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, & ! local ! atrans ! gaseous absorptivity -! abscld ! cloud absorptivity ! atot ! combined gaseous and cloud absorptivity ! odclr ! clear sky (gaseous) optical depth ! odcld ! cloud optical depth @@ -189,7 +186,6 @@ subroutine rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, & ! bbdtot ! gas and cloud planck function for downward rt ! bbutot ! gas and cloud planck function for upward calc. ! gassrc ! source radiance due to gas only -! efclfrac ! effective cloud fraction ! radlu ! spectrally summed upward radiance ! radclru ! spectrally summed clear sky upward radiance ! urad ! upward radiance by layer diff --git a/src/rrtmg_lw_taumol.f90 b/src/rrtmg_lw_taumol.f90 index c6959888..d3213f7c 100644 --- a/src/rrtmg_lw_taumol.f90 +++ b/src/rrtmg_lw_taumol.f90 @@ -30,7 +30,7 @@ module rrtmg_lw_taumol !---------------------------------------------------------------------------- subroutine taumol(nlayers, pavel, wx, coldry, & - laytrop, jp, jt, jt1, planklay, planklev, plankbnd, & + laytrop, jp, jt, jt1, & colh2o, colco2, colo3, coln2o, colco, colch4, colo2, & colbrd, fac00, fac01, fac10, fac11, & rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, & @@ -191,12 +191,6 @@ subroutine taumol(nlayers, pavel, wx, coldry, & ! Dimensions: (nlayers) integer(kind=im), intent(in) :: jt1(:) ! ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: planklay(:,:) ! - ! Dimensions: (nlayers,nbndlw) - real(kind=rb), intent(in) :: planklev(0:,:) ! - ! Dimensions: (nlayers,nbndlw) - real(kind=rb), intent(in) :: plankbnd(:) ! - ! Dimensions: (nbndlw) real(kind=rb), intent(in) :: colh2o(:) ! column amount (h2o) ! Dimensions: (nlayers) diff --git a/src/rrtmg_sw_rad.f90 b/src/rrtmg_sw_rad.f90 index 2574b28d..837cc134 100644 --- a/src/rrtmg_sw_rad.f90 +++ b/src/rrtmg_sw_rad.f90 @@ -305,14 +305,10 @@ subroutine rrtmg_sw & ! [0 = direct and diffuse fluxes are unscaled] ! [1 = direct and diffuse fluxes are scaled] ! (total downward fluxes are always delta scaled) - integer(kind=im) :: isccos ! instrumental cosine response flag (inactive) integer(kind=im) :: iplon ! column loop index integer(kind=im) :: i ! layer loop index ! jk integer(kind=im) :: ib ! band loop index ! jsw - integer(kind=im) :: ia, ig ! indices - integer(kind=im) :: k ! layer loop index - integer(kind=im) :: ims ! value for changing mcica permute seed - integer(kind=im) :: imca ! flag for mcica [0=off, 1=on] + integer(kind=im) :: ia ! indices real(kind=rb) :: zepsec, zepzen ! epsilon real(kind=rb) :: zdpgcp ! flux to heating conversion ratio @@ -368,7 +364,6 @@ subroutine rrtmg_sw & fac10(nzrad+2), fac11(nzrad+2) ! Atmosphere/clouds - cldprop - integer(kind=im) :: ncbands ! number of cloud spectral bands integer(kind=im) :: inflag ! flag for cloud property method integer(kind=im) :: iceflag ! flag for ice cloud properties integer(kind=im) :: liqflag ! flag for liquid cloud properties @@ -414,8 +409,6 @@ subroutine rrtmg_sw & real(kind=rb) :: znicddir(nzrad+3) ! temporary clear sky near-IR downward direct shortwave flux (w/m2) ! Optional output fields - real(kind=rb) :: swnflx(nzrad+3) ! Total sky shortwave net flux (W/m2) - real(kind=rb) :: swnflxc(nzrad+3) ! Clear sky shortwave net flux (W/m2) real(kind=rb) :: dirdflux(nzrad+3) ! Direct downward shortwave surface flux real(kind=rb) :: difdflux(nzrad+3) ! Diffuse downward shortwave surface flux real(kind=rb) :: uvdflx(nzrad+3) ! Total sky downward shortwave flux, UV/vis @@ -537,7 +530,7 @@ subroutine rrtmg_sw & call inatm_sw (iplon, nzrad+1, ioverlap, iaer, & layerP, interfaceP, layerT, interfaceT, tsfc, h2ovmr, & o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, & - real(eccf,rb), dyofyr, scon, inflgsw, iceflgsw, liqflgsw, & + real(eccf,rb), dyofyr, inflgsw, iceflgsw, liqflgsw, & cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, & reice, reliq, tauaer, ssaaer, asmaer, & nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, & @@ -567,7 +560,7 @@ subroutine rrtmg_sw & ! molecular absorption coefficients by interpolating data from stored ! reference atmospheres. - call setcoef_sw(nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, & + call setcoef_sw(nlayers, pavel, tavel, tz, tbound, coldry, wkl, & laytrop, layswtch, laylow, jp, jt, jt1, & co2mult, colch4, colco2, colh2o, colmol, coln2o, & colo2, colo3, fac00, fac01, fac10, fac11, & @@ -692,11 +685,11 @@ subroutine rrtmg_sw & call spcvrt_sw & (nlayers, istart, iend, icpr, idelm, iout, & - pavel, tavel, pz, tz, tbound, albdif, albdir, & + albdif, albdir, & cldfrac, ztauc, zasyc, zomgc, ztaucorig, & - ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, & - laytrop, layswtch, laylow, jp, jt, jt1, & - co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & + ztaua, zasya, zomga, cossza, adjflux, & + laytrop, jp, jt, jt1, & + colch4, colco2, colh2o, colmol, colo2, colo3, & fac00, fac01, fac10, fac11, & selffac, selffrac, indself, forfac, forfrac, indfor, & zbbfd, zbbfu, zbbcd, zbbcu, zuvfd, zuvcd, znifd, znicd, & @@ -785,7 +778,7 @@ end function earth_sun subroutine inatm_sw (iplon, nlay, icld, iaer, & play, plev, tlay, tlev, tsfc, h2ovmr, & o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, & - adjes, dyofyr, scon, inflgsw, iceflgsw, liqflgsw, & + adjes, dyofyr, inflgsw, iceflgsw, liqflgsw, & cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, & reice, reliq, tauaer, ssaaer, asmaer, & nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, & @@ -842,7 +835,6 @@ subroutine inatm_sw (iplon, nlay, icld, iaer, & integer(kind=im), intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun ! distance if adjflx not provided) real(kind=rb), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance - real(kind=rb), intent(in) :: scon ! Solar constant (W/m2) integer(kind=im), intent(in) :: inflgsw ! Flag for cloud optical properties integer(kind=im), intent(in) :: iceflgsw ! Flag for ice particle specification @@ -949,10 +941,10 @@ subroutine inatm_sw (iplon, nlay, icld, iaer, & real(kind=rb), parameter :: sbc = 5.67e-08_rb ! Stefan-Boltzmann constant (W/m2K4) - integer(kind=im) :: isp, l, ix, n, imol, ib ! Loop indices - real(kind=rb) :: amm, summol ! - real(kind=rb) :: adjflx ! flux adjustment for Earth/Sun distance -! real(kind=rb) :: earth_sun ! function for Earth/Sun distance adjustment + integer(kind=im) :: l, n, imol, ib ! Loop indices + real(kind=rb) :: amm ! + real(kind=rb) :: adjflx ! flux adjustment for Earth/Sun distance +! real(kind=rb) :: earth_sun ! function for Earth/Sun distance adjustment ! Add one to nlayers here to include extra model layer at top of atmosphere nlayers = nlay diff --git a/src/rrtmg_sw_reftra.f90 b/src/rrtmg_sw_reftra.f90 index 437c3f46..7008ac6a 100644 --- a/src/rrtmg_sw_reftra.f90 +++ b/src/rrtmg_sw_reftra.f90 @@ -104,7 +104,7 @@ subroutine reftra_sw(nlayers, lrtchk, pgg, prmuz, ptau, pw, & ! ------- Local ------- - integer(kind=im) :: jk, jl, kmodts + integer(kind=im) :: jk, kmodts integer(kind=im) :: itind real(kind=rb) :: tblind diff --git a/src/rrtmg_sw_setcoef.f90 b/src/rrtmg_sw_setcoef.f90 index 15cda3e6..161c05d1 100644 --- a/src/rrtmg_sw_setcoef.f90 +++ b/src/rrtmg_sw_setcoef.f90 @@ -28,7 +28,7 @@ module rrtmg_sw_setcoef contains !---------------------------------------------------------------------------- - subroutine setcoef_sw(nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, & + subroutine setcoef_sw(nlayers, pavel, tavel, tz, tbound, coldry, wkl, & laytrop, layswtch, laylow, jp, jt, jt1, & co2mult, colch4, colco2, colh2o, colmol, coln2o, & colo2, colo3, fac00, fac01, fac10, fac11, & @@ -52,8 +52,6 @@ subroutine setcoef_sw(nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, & ! Dimensions: (nlayers) real(kind=rb), intent(in) :: tavel(:) ! layer temperatures (K) ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: pz(0:) ! level (interface) pressures (hPa, mb) - ! Dimensions: (0:nlayers) real(kind=rb), intent(in) :: tz(0:) ! level (interface) temperatures (K) ! Dimensions: (0:nlayers) real(kind=rb), intent(in) :: tbound ! surface temperature (K) diff --git a/src/rrtmg_sw_spcvrt.f90 b/src/rrtmg_sw_spcvrt.f90 index 8bcd3458..f9cf8e78 100644 --- a/src/rrtmg_sw_spcvrt.f90 +++ b/src/rrtmg_sw_spcvrt.f90 @@ -34,11 +34,11 @@ module rrtmg_sw_spcvrt ! --------------------------------------------------------------------------- subroutine spcvrt_sw & (nlayers, istart, iend, icpr, idelm, iout, & - pavel, tavel, pz, tz, tbound, palbd, palbp, & + palbd, palbp, & pclfr, ptauc, pasyc, pomgc, ptaucorig, & - ptaua, pasya, pomga, prmu0, coldry, wkl, adjflux, & - laytrop, layswtch, laylow, jp, jt, jt1, & - co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & + ptaua, pasya, pomga, prmu0, adjflux, & + laytrop, jp, jt, jt1, & + colch4, colco2, colh2o, colmol, colo2, colo3, & fac00, fac01, fac10, fac11, & selffac, selffrac, indself, forfac, forfrac, indfor, & pbbfd, pbbfu, pbbcd, pbbcu, puvfd, puvcd, pnifd, pnicd, & @@ -85,8 +85,6 @@ subroutine spcvrt_sw & ! [1 = direct and diffuse fluxes are scaled] integer(kind=im), intent(in) :: iout integer(kind=im), intent(in) :: laytrop - integer(kind=im), intent(in) :: layswtch - integer(kind=im), intent(in) :: laylow integer(kind=im), intent(in) :: indfor(:) ! Dimensions: (nlayers) @@ -99,19 +97,6 @@ subroutine spcvrt_sw & integer(kind=im), intent(in) :: jt1(:) ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: pavel(:) ! layer pressure (hPa, mb) - ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: tavel(:) ! layer temperature (K) - ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: pz(0:) ! level (interface) pressure (hPa, mb) - ! Dimensions: (0:nlayers) - real(kind=rb), intent(in) :: tz(0:) ! level temperatures (hPa, mb) - ! Dimensions: (0:nlayers) - real(kind=rb), intent(in) :: tbound ! surface temperature (K) - real(kind=rb), intent(in) :: wkl(:,:) ! molecular amounts (mol/cm2) - ! Dimensions: (mxmol,nlayers) - real(kind=rb), intent(in) :: coldry(:) ! dry air column density (mol/cm2) - ! Dimensions: (nlayers) real(kind=rb), intent(in) :: colmol(:) ! Dimensions: (nlayers) real(kind=rb), intent(in) :: adjflux(:) ! Earth/Sun distance adjustment @@ -145,15 +130,10 @@ subroutine spcvrt_sw & ! Dimensions: (nlayers) real(kind=rb), intent(in) :: colch4(:) ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: co2mult(:) - ! Dimensions: (nlayers) real(kind=rb), intent(in) :: colo3(:) ! Dimensions: (nlayers) real(kind=rb), intent(in) :: colo2(:) ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: coln2o(:) - ! Dimensions: (nlayers) - real(kind=rb), intent(in) :: forfac(:) ! Dimensions: (nlayers) real(kind=rb), intent(in) :: forfrac(:) @@ -206,8 +186,8 @@ subroutine spcvrt_sw & logical :: lrtchkclr(nlayers),lrtchkcld(nlayers) integer(kind=im) :: klev - integer(kind=im) :: ib1, ib2, ibm, igt, ikl, ikp, ikx - integer(kind=im) :: iw, jb, jg, jl, jk + integer(kind=im) :: ib1, ib2, ibm, igt, ikl + integer(kind=im) :: iw, jb, jg, jk ! integer(kind=im), parameter :: nuv = ?? ! integer(kind=im), parameter :: nvs = ?? integer(kind=im) :: itind @@ -215,24 +195,22 @@ subroutine spcvrt_sw & real(kind=rb) :: tblind, ze1 real(kind=rb) :: zclear, zcloud real(kind=rb) :: zdbt(nlayers+1), zdbt_nodel(nlayers+1) - real(kind=rb) :: zgc(nlayers), zgcc(nlayers), zgco(nlayers) - real(kind=rb) :: zomc(nlayers), zomcc(nlayers), zomco(nlayers) + real(kind=rb) :: zgcc(nlayers), zgco(nlayers) + real(kind=rb) :: zomcc(nlayers), zomco(nlayers) real(kind=rb) :: zrdnd(nlayers+1), zrdndc(nlayers+1) real(kind=rb) :: zref(nlayers+1), zrefc(nlayers+1), zrefo(nlayers+1) real(kind=rb) :: zrefd(nlayers+1), zrefdc(nlayers+1), zrefdo(nlayers+1) real(kind=rb) :: zrup(nlayers+1), zrupd(nlayers+1) real(kind=rb) :: zrupc(nlayers+1), zrupdc(nlayers+1) - real(kind=rb) :: zs1(nlayers+1) real(kind=rb) :: ztauc(nlayers), ztauo(nlayers) - real(kind=rb) :: ztdn(nlayers+1), ztdnd(nlayers+1), ztdbt(nlayers+1) - real(kind=rb) :: ztoc(nlayers), ztor(nlayers) + real(kind=rb) :: ztdbt(nlayers+1) real(kind=rb) :: ztra(nlayers+1), ztrac(nlayers+1), ztrao(nlayers+1) real(kind=rb) :: ztrad(nlayers+1), ztradc(nlayers+1), ztrado(nlayers+1) real(kind=rb) :: zdbtc(nlayers+1), ztdbtc(nlayers+1) real(kind=rb) :: zincflx(ngptsw), zdbtc_nodel(nlayers+1) real(kind=rb) :: ztdbt_nodel(nlayers+1), ztdbtc_nodel(nlayers+1) - real(kind=rb) :: zdbtmc, zdbtmo, zf, zgw, zreflect + real(kind=rb) :: zdbtmc, zdbtmo, zf real(kind=rb) :: zwf, tauorig, repclc ! real(kind=rb) :: zincflux ! inactive From 3f38a46a9e6517e5b2f5c2aceaf40ad0dc964297 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 14 Jul 2016 10:16:59 -0400 Subject: [PATCH 32/88] Check on non-equidistant has to be an absolute value --- src/modglobal.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index c366a502..cc454f1e 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -421,7 +421,7 @@ subroutine initglobal leq=.true. dz = dzf(1) do k=1,k1 - if ((dzf(k)-dz)/dz>eps1) then + if (abs(dzf(k)-dz)/dz>eps1) then leq = .false. end if end do From 77421654e413f7abb513b1ba08e0bcfc155e1ad7 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 14 Jul 2016 10:18:17 -0400 Subject: [PATCH 33/88] WCTime: The second time call needs to be tend, not t start --- src/modstartup.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 8fcf4694..759f179d 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -1019,7 +1019,7 @@ subroutine testwctime if (tstart < 0) then call mpi_get_time(tstart) else - call mpi_get_time(tstart) + call mpi_get_time(tend) if (tend-tstart>=wctime) then write (*,*) wctime, "NO WALL CLOCK TIME LEFT" timeleft=0 From 9725f0d9bca2e72e0a55f437859c93198ae6d32e Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 14 Jul 2016 10:24:28 -0400 Subject: [PATCH 34/88] Initial values of wtsurf and wqsurf should be very negative, not just very small --- src/modsurfdata.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/modsurfdata.f90 b/src/modsurfdata.f90 index 64af284c..ab3e42f0 100644 --- a/src/modsurfdata.f90 +++ b/src/modsurfdata.f90 @@ -223,8 +223,8 @@ module modsurfdata ! prescribed surface fluxes real :: ustin = -1 !< Prescribed friction velocity [m/s] - real :: wtsurf = -1e-20 !< Prescribed kinematic temperature flux [K m/s] - real :: wqsurf = -1e-20 !< Prescribed kinematic moisture flux [kg/kg m/s] + real :: wtsurf = -1e20 !< Prescribed kinematic temperature flux [K m/s] + real :: wqsurf = -1e20 !< Prescribed kinematic moisture flux [kg/kg m/s] real :: wsvsurf(100) = 0 !< Prescribed surface scalar(n) flux [- m/s] ! Heterogeneous surfaces From 4284df17d033b032663656957a5b189b08ded931 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 14 Jul 2016 19:42:36 +0200 Subject: [PATCH 35/88] Reintroduce check for stability RADFULL --- src/modradfull.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/modradfull.f90 b/src/modradfull.f90 index 6644684c..c8e9a907 100644 --- a/src/modradfull.f90 +++ b/src/modradfull.f90 @@ -1073,6 +1073,8 @@ end subroutine adjust !> Subroutine qft: Delta 4-stream solver for fluxes !> subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) + use modglobal, only : eps1 + implicit none logical, intent (in) :: solar real, intent (in) :: ee, as, u0 @@ -1083,7 +1085,7 @@ subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) real, dimension (nv) :: t,w,w1,w2,w3,u0a,f0a,fk1,fk2 integer :: k, kk, ii, jj real :: x(4), fi(4), a4(4,4,nv), z4(4,nv), g4(4,nv) - real :: tkm1, fw3, fw4, y1, xy, xas, xee + real :: tkm1, fw3, fw4, y1, xy, xas, xee, tmp real, parameter :: fw1 = 0.6638960, fw2 = 2.4776962 call adjust(tt,ww,ww1,ww2,ww3,ww4,t,w,w1,w2,w3) @@ -1103,7 +1105,8 @@ subroutine qft (solar, ee, as, u0, bf, tt, ww, ww1, ww2, ww3, ww4, ffu, ffd) tkm1 = 0.0 do k = 1, nv f0a(k) = 2.0 * ( 1.0 - w(k) ) * bf(k) - u0a(k) = -(t(k)-tkm1) / ( alog( bf(k+1)/bf(k) )) + tmp = alog( bf(k+1)/bf(k) ) + u0a(k) = -(t(k)-tkm1) / sign(max(abs(tmp),eps1),tmp) u0a(k) = sign(max(abs(u0a(k)),1.e-8),u0a(k)) tkm1 = t(k) end do From 83cda5c5928cb137daac2886e46fff4156e09342 Mon Sep 17 00:00:00 2001 From: Thijs Heus Date: Thu, 14 Jul 2016 17:45:57 -0400 Subject: [PATCH 36/88] Split out deflate level from netcdf statements --- src/modstat_nc.f90 | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/src/modstat_nc.f90 b/src/modstat_nc.f90 index 1f647fc2..90a7430a 100644 --- a/src/modstat_nc.f90 +++ b/src/modstat_nc.f90 @@ -245,55 +245,57 @@ subroutine define_nc(ncID, nVar, sx) iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt,VarID) !2D Fields case ('t0tt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tt,VarID) case ('t0mt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0mt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0mt,VarID) case ('m0tt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_m0tt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_m0tt,VarID) case ('tt0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tt0t,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tt0t,VarID) case ('tm0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tm0t,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tm0t,VarID) case ('mt0t') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt0t,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mt0t,VarID) case ('0ttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttt,VarID) case ('0tmt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0tmt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0tmt,VarID) case ('0mtt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0mtt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0mtt,VarID) !3D Fields case ('tttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttt,VarID) case ('mttt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mttt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_mttt,VarID) case ('tmtt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tmtt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tmtt,VarID) case ('ttmt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_ttmt,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_ttmt,VarID) !Soil fields case ('tts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tts ,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tts ,VarID) case ('t0tts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tts,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_t0tts,VarID) case ('0ttts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttts,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttts,VarID) case ('tttts') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttts,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttts,VarID) !Quadrant analysis fields case('qt') - iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_qt ,VarID, deflate_level = 2) + iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_qt ,VarID) case default print *, 'ABORTING: Bad dimensional information ',sx(n,:) stop ! call appl_abort(0) + end select if (iret/=0) then write (*,*) 'nvar', nvar, sx(n,:) call nchandle_error(iret) end if + iret=nf90_def_var_deflate(ncid,varID, 0, 1, deflate_level = 2) iret=nf90_put_att(ncID,VarID,'longname',sx(n,2)) iret=nf90_put_att(ncID,VarID,'units',sx(n,3)) iret = nf90_put_att(ncid, VarID, '_FillValue',nc_fillvalue) From 82e2d114deb4b15b85a0d2c6ffb50c52c231a206 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Fri, 15 Jul 2016 11:30:32 +0200 Subject: [PATCH 37/88] Removed trailing blanks --- src/modstat_nc.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/modstat_nc.f90 b/src/modstat_nc.f90 index 90a7430a..dd488d20 100644 --- a/src/modstat_nc.f90 +++ b/src/modstat_nc.f90 @@ -280,7 +280,7 @@ subroutine define_nc(ncID, nVar, sx) iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_0ttts,VarID) case ('tttts') iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_tttts,VarID) - + !Quadrant analysis fields case('qt') iret=nf90_def_var(ncID,sx(n,1),NF90_FLOAT,dim_qt ,VarID) @@ -328,13 +328,13 @@ subroutine writestat_dims_nc(ncid, ncoarse) integer, intent(in) :: ncid integer, optional, intent(in) :: ncoarse integer :: i=0,iret,length,varid, nc - + if (present(ncoarse)) then nc = ncoarse else nc = 1 end if - + iret = nf90_inq_varid(ncid, 'xt', VarID) if (iret==0) iret=nf90_inquire_dimension(ncid, xtID, len=length) if (iret==0) iret = nf90_put_var(ncid, varID, (/(dx*(0.5+nc*i),i=0,length-1)/),(/1/)) From adade32ea4ac7bec90417c99641796a93fb90aaf Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Oct 2016 14:11:51 +0200 Subject: [PATCH 38/88] Add macros to custom doxygen latex header.tex, to work with doxygen 1.8.2 --- utils/doc/input/header.tex | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/utils/doc/input/header.tex b/utils/doc/input/header.tex index 08d0e3ee..1f3f0df1 100644 --- a/utils/doc/input/header.tex +++ b/utils/doc/input/header.tex @@ -46,6 +46,10 @@ \newcommand{\rese}{E} \newcommand{\iftwocol}[2]{\if\else #2\fi} \newcommand{\CFL}{\mr{CFL}} +\newcommand{\+}{\discretionary{\mbox{\scriptsize$\hookleftarrow$}}{}{}} +\newcommand{\clearemptydoublepage}{% + \newpage{\pagestyle{empty}\cleardoublepage}% +} \setcounter{tocdepth}{1} @@ -69,4 +73,4 @@ \chapter{General Introduction} % \includepdf[pages=-]{dales-article.pdf} % \includepdf[pages=-]{dales-manual.pdf} -% \includepdf[pages=-]{git_dales.pdf} \ No newline at end of file +% \includepdf[pages=-]{git_dales.pdf} From fc691c673a5de58735b97e59f9f11f2d4b89bbc8 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Jul 2017 14:59:17 +0200 Subject: [PATCH 39/88] Remove rhoputin from advec_2nd, advec_52, advec_62 --- src/advec_2nd.f90 | 217 +++++++++++++++++++------------------------- src/advec_52.f90 | 116 ++++++++++++----------- src/advec_62.f90 | 134 +++++++++++++++------------ src/advec_kappa.f90 | 76 ++++++++-------- 4 files changed, 271 insertions(+), 272 deletions(-) diff --git a/src/advec_2nd.f90 b/src/advec_2nd.f90 index 75b96192..de1be9be 100644 --- a/src/advec_2nd.f90 +++ b/src/advec_2nd.f90 @@ -38,98 +38,72 @@ subroutine advecc_2nd(putin,putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k,ip,im,jp,jm,kp,km - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax - km=k-1 - kp=k+1 do j=2,j1 - jm=j-1 - jp=j+1 do i=2,i1 - im=i-1 - ip=i+1 putout(i,j,k) = putout(i,j,k)- ( & ( & - u0(ip,j,k) * ( putin(ip,j,k) + putin(i,j,k) ) & - -u0(i ,j,k) * ( putin(im,j,k) + putin(i,j,k) ) & + u0(i+1,j,k) * ( putin(i+1,j,k) + putin(i,j,k) ) & + -u0(i ,j,k) * ( putin(i-1,j,k) + putin(i,j,k) ) & )* dxi5 & +( & - v0(i,jp,k) * ( putin(i,jp,k) + putin(i,j,k) ) & - -v0(i,j ,k) * ( putin(i,jm,k) + putin(i,j,k) ) & + v0(i,j+1,k) * ( putin(i,j+1,k) + putin(i,j,k) ) & + -v0(i,j ,k) * ( putin(i,j-1,k) + putin(i,j,k) ) & )* dyi5 ) end do end do end do - if (leq) then + if (leq) then ! equidistant grid do j=2,j1 - jm=j-1 - jp=j+1 do i=2,i1 - im=i-1 - ip=i+1 putout(i,j,1) = putout(i,j,1)- (1./rhobf(1))*( & - w0(i,j,2) * (rhoputin(i,j,2) + rhoputin(i,j,1) ) & + w0(i,j,2) * (rhobf(2) * putin(i,j,2) + rhobf(1) * putin(i,j,1) ) & ) * dzi5 end do end do do j=2,j1 - jm=j-1 - jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 + do k=2,kmax + do i=2,i1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & - w0(i,j,kp) * (rhoputin(i,j,kp)+rhoputin(i,j,k)) & - -w0(i,j,k) * (rhoputin(i,j,km)+rhoputin(i,j,k)) & + w0(i,j,k+1) * (rhobf(k+1) * putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) & + -w0(i,j,k) * (rhobf(k-1) * putin(i,j,k-1)+ rhobf(k) * putin(i,j,k)) & )*dzi5 end do end do end do - else + else ! non-equidistant grid do j=2,j1 - jm=j-1 - jp=j+1 do i=2,i1 - im=i-1 - ip=i+1 putout(i,j,1) = putout(i,j,1)- (1./rhobf(1))*( & - w0(i,j,2) * (rhoputin(i,j,2)*dzf(1) + rhoputin(i,j,1)*dzf(2) ) / (2.*dzh(2)) & + w0(i,j,2) * (rhobf(2) * putin(i,j,2) * dzf(1) + rhobf(1) * putin(i,j,1) * dzf(2) ) / (2.*dzh(2)) & ) / dzf(1) end do end do do j=2,j1 - jm=j-1 - jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 + do k=2,kmax + do i=2,i1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & - w0(i,j,kp) * (rhoputin(i,j,kp)*dzf(k) + rhoputin(i,j,k)*dzf(kp) ) / dzh(kp) & - -w0(i,j,k ) * (rhoputin(i,j,km)*dzf(k) + rhoputin(i,j,k)*dzf(km) ) / dzh(k) & + w0(i,j,k+1) * (rhobf(k+1) * putin(i,j,k+1) * dzf(k) + rhobf(k) * putin(i,j,k) * dzf(k+1) ) / dzh(k+1) & + -w0(i,j,k ) * (rhobf(k-1) * putin(i,j,k-1) * dzf(k) + rhobf(k) * putin(i,j,k) * dzf(k-1) ) / dzh(k) & )/ (2. * dzf(k)) end do end do @@ -149,17 +123,17 @@ subroutine advecu_2nd(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k,ip,im,jp,jm,kp,km - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax km=k-1 @@ -173,11 +147,11 @@ subroutine advecu_2nd(putin, putout) putout(i,j,k) = putout(i,j,k)- ( & ( & (putin(i,j,k)+putin(ip,j,k))*(u0(i,j,k)+u0(ip,j,k)) & - -(putin(i,j,k)+putin(im,j,k))*(u0(i,j,k)+u0(im,j,k)) & + -(putin(i,j,k)+putin(im,j,k))*(u0(i,j,k)+u0(im,j,k)) & )*dxiq & - +( & + +( & (putin(i,j,k)+putin(i,jp,k))*(v0(i,jp,k)+v0(im,jp ,k)) & - -(putin(i,j,k)+putin(i,jm,k))*(v0(i,j ,k)+v0(im,j ,k)) & + -(putin(i,j,k)+putin(i,jm,k))*(v0(i,j ,k)+v0(im,j ,k)) & )*dyiq ) end do @@ -193,7 +167,7 @@ subroutine advecu_2nd(putin, putout) im=i-1 ip=i+1 putout(i,j,1) = putout(i,j,1)-(1./rhobf(1))*( & - ( rhoputin(i,j,2) + rhoputin(i,j,1))*( w0(i,j,2)+ w0(im,j,2) ) & + ( rhobf(2) * putin(i,j,2) + rhobf(1) * putin(i,j,1))*( w0(i,j,2)+ w0(im,j,2) ) & ) *dziq end do end do @@ -201,16 +175,15 @@ subroutine advecu_2nd(putin, putout) do j=2,j1 jm=j-1 jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 - + do k=2,kmax + km=k-1 + kp=k+1 + do i=2,i1 + im=i-1 + ip=i+1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,kp) )*(w0(i,j,kp)+w0(im,j,kp)) & - -(rhoputin(i,j,k)+rhoputin(i,j,km) )*(w0(i,j,k )+w0(im,j,k )) & + (rhobf(k) * putin(i,j,k) + rhobf(kp) * putin(i,j,kp) )*(w0(i,j,kp)+w0(im,j,kp)) & + -(rhobf(k) * putin(i,j,k) + rhobf(km) * putin(i,j,km) )*(w0(i,j,k )+w0(im,j,k )) & )*dziq end do end do @@ -225,7 +198,7 @@ subroutine advecu_2nd(putin, putout) im=i-1 ip=i+1 putout(i,j,1) = putout(i,j,1)- (1./rhobf(1))*( & - ( rhoputin(i,j,2)*dzf(1) + rhoputin(i,j,1)*dzf(2) ) / dzh(2) & + ( rhobf(2) * putin(i,j,2)*dzf(1) + rhobf(1) * putin(i,j,1)*dzf(2) ) / dzh(2) & *( w0(i,j,2)+ w0(im,j,2) ))/ (4.*dzf(1)) end do end do @@ -233,16 +206,16 @@ subroutine advecu_2nd(putin, putout) do j=2,j1 jm=j-1 jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 + do k=2,kmax + km=k-1 + kp=k+1 + do i=2,i1 + im=i-1 + ip=i+1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & - ( rhoputin(i,j,kp)*dzf(k) + rhoputin(i,j,k)*dzf(kp) ) / dzh(kp) & + ( rhobf(kp) * putin(i,j,kp)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(kp) ) / dzh(kp) & *( w0(i,j,kp)+ w0(im,j,kp) ) & - -( rhoputin(i,j,k)*dzf(km) + rhoputin(i,j,km)*dzf(k) ) / dzh(k) & + -( rhobf(k) * putin(i,j,k)*dzf(km) + rhobf(km) * putin(i,j,km)*dzf(k) ) / dzh(k) & *( w0(i,j,k) + w0(im,j,k) ) & )/ (4.*dzf(k)) end do @@ -266,17 +239,17 @@ subroutine advecv_2nd(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v-field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k,ip,im,jp,jm,kp,km - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax km=k-1 @@ -310,7 +283,7 @@ subroutine advecv_2nd(putin, putout) im=i-1 ip=i+1 putout(i,j,1) = putout(i,j,1)- (1./rhobf(1))*( & - (w0(i,j,2)+w0(i,jm,2))*(rhoputin(i,j,2)+rhoputin(i,j,1)) & + (w0(i,j,2)+w0(i,jm,2))*(rhobf(2) * putin(i,j,2)+rhobf(1) * putin(i,j,1)) & )*dziq end do end do @@ -318,15 +291,15 @@ subroutine advecv_2nd(putin, putout) do j=2,j1 jm=j-1 jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 + do k=2,kmax + km=k-1 + kp=k+1 + do i=2,i1 + im=i-1 + ip=i+1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & - ( w0(i,j,kp)+w0(i,jm,kp))*(rhoputin(i,j,kp)+rhoputin(i,j,k)) & - -(w0(i,j,k) +w0(i,jm,k)) *(rhoputin(i,j,km)+rhoputin(i,j,k)) & + ( w0(i,j,kp)+w0(i,jm,kp))*(rhobf(kp) * putin(i,j,kp) + rhobf(k) * putin(i,j,k)) & + -(w0(i,j,k) +w0(i,jm,k)) *(rhobf(km) * putin(i,j,km) + rhobf(k) * putin(i,j,k)) & )*dziq end do end do @@ -341,7 +314,7 @@ subroutine advecv_2nd(putin, putout) ip=i+1 putout(i,j,1) = putout(i,j,1)- (1./rhobf(1))*( & (w0(i,j,2)+w0(i,jm,2)) & - *(rhoputin(i,j,2)*dzf(1)+rhoputin(i,j,1)*dzf(2) )/ dzh(2) & + *(rhobf(2) * putin(i,j,2)*dzf(1) + rhobf(1) * putin(i,j,1)*dzf(2) )/ dzh(2) & ) / (4. * dzf(1)) end do end do @@ -349,17 +322,17 @@ subroutine advecv_2nd(putin, putout) do j=2,j1 jm=j-1 jp=j+1 - do i=2,i1 - im=i-1 - ip=i+1 - do k=2,kmax - km=k-1 - kp=k+1 + do k=2,kmax + km=k-1 + kp=k+1 + do i=2,i1 + im=i-1 + ip=i+1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & (w0(i,j,kp)+w0(i,jm,kp)) & - *(rhoputin(i,j,kp)*dzf(k)+rhoputin(i,j,k)*dzf(kp) )/ dzh(kp) & + *(rhobf(k) * putin(i,j,kp)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(kp) )/ dzh(kp) & -(w0(i,j,k)+w0(i,jm,k)) & - *(rhoputin(i,j,km)*dzf(k)+rhoputin(i,j,k)*dzf(km)) / dzh(k) & + *(rhobf(km) * putin(i,j,km)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(km)) / dzh(k) & ) / (4. * dzf(k)) end do end do @@ -380,17 +353,17 @@ subroutine advecw_2nd(putin,putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w-field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k,ip,im,jp,jm,kp,km - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) +! end do +! end do +! end do if (leq) then @@ -417,8 +390,8 @@ subroutine advecw_2nd(putin,putout) )*dyiq & + & (1./rhobh(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,kp) )*(w0(i,j,k) + w0(i,j,kp)) & - -(rhoputin(i,j,k)+rhoputin(i,j,km) )*(w0(i,j,k) + w0(i,j,km)) & + (rhobh(k) * putin(i,j,k) + rhobh(kp) * putin(i,j,kp) )*(w0(i,j,k) + w0(i,j,kp)) & + -(rhobh(k) * putin(i,j,k) + rhobh(km) * putin(i,j,km) )*(w0(i,j,k) + w0(i,j,km)) & )*dziq & ) @@ -438,22 +411,22 @@ subroutine advecw_2nd(putin,putout) putout(i,j,k) = putout(i,j,k) - (1./rhobh(k))*( & ( & - ( rhoputin(ip,j,k) + rhoputin(i,j,k) ) & + ( rhobh(k) * putin(ip,j,k) + rhobh(k) * putin(i,j,k) ) & *( dzf(km)*u0(ip,j,k) + dzf(k)*u0(ip,j,km) ) & - -( rhoputin(i,j,k) + rhoputin(im,j,k) ) & + -( rhobh(k) * putin(i,j,k) + rhobh(k) * putin(im,j,k) ) & *( dzf(km)*u0(i,j,k)+dzf(k)*u0(i ,j,km) ) & )*dxiq / dzh(k) & + & ( & - ( rhoputin(i,jp,k) + rhoputin(i,j,k) ) & + ( rhobh(k) * putin(i,jp,k) + rhobh(k) * putin(i,j,k) ) & *( dzf(km)*v0(i,jp,k) + dzf(k)*v0(i,jp,km) ) & - -( rhoputin(i,j,k) + rhoputin(i,j-1,k) ) & + -( rhobh(k) * putin(i,j,k) + rhobh(k) * putin(i,j-1,k) ) & *( dzf(km)*v0(i,j,k) + dzf(k)*v0(i,j,km) ) & ) *dyiq / dzh(k) & + & ( & - ( rhoputin(i,j,k)+rhoputin(i,j,kp) ) * (w0(i,j,k) + w0(i,j,kp) ) & - -( rhoputin(i,j,k)+rhoputin(i,j,km) ) * (w0(i,j,k) + w0(i,j,km) ) & + ( rhobh(k) * putin(i,j,k) + rhobh(kp) * putin(i,j,kp) ) * (w0(i,j,k) + w0(i,j,kp) ) & + -( rhobh(k) * putin(i,j,k) + rhobh(km) * putin(i,j,km) ) * (w0(i,j,k) + w0(i,j,km) ) & ) / (4. *dzh(k) ) & ) diff --git a/src/advec_52.f90 b/src/advec_52.f90 index 8d6617e6..3bce8797 100644 --- a/src/advec_52.f90 +++ b/src/advec_52.f90 @@ -42,21 +42,27 @@ subroutine advecc_52(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real :: rhobfinvk + real :: inv2dzfk, rhobf_p, rhobf_m integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax + !rhobfinvk = 1./rhobf(k) + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) do j=2,j1 do i=2,i1 @@ -66,26 +72,26 @@ subroutine advecc_52(putin, putout) ( & u0(i+1,j,k)/60.& *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -sign(1.,u0(i+1,j,k))*u0(i+1,j,k)/60.& + -abs(u0(i+1,j,k))/60.& *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& -u0(i,j,k)/60.& *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - +sign(1.,u0(i,j,k))*u0(i,j,k)/60.& + +abs(u0(i,j,k))/60.& *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& )*dxi& +(& v0(i,j+1,k)/60.& *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,v0(i,j+1,k))*v0(i,j+1,k)/60.& + -abs(v0(i,j+1,k))/60.& *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& -v0(i,j,k)/60.& *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - +sign(1.,v0(i,j,k))*v0(i,j,k)/60.& + +abs(v0(i,j,k))/60.& *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k))) & )* dyi & - +(1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1) + rhoputin(i,j,k)) & - ) / ( 2. * dzf(k) ) & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + ) * inv2dzfk & ) else @@ -93,27 +99,27 @@ subroutine advecc_52(putin, putout) ( & u0(i+1,j,k)/60.& *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -sign(1.,u0(i+1,j,k))*u0(i+1,j,k)/60.& + -abs(u0(i+1,j,k))/60.& *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& -u0(i,j,k)/60.& *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - +sign(1.,u0(i,j,k))*u0(i,j,k)/60.& + +abs(u0(i,j,k))/60.& *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& )*dxi& +(& v0(i,j+1,k)/60.& *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,v0(i,j+1,k))*v0(i,j+1,k)/60.& + -abs(v0(i,j+1,k))/60.& *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& -v0(i,j,k)/60.& *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - +sign(1.,v0(i,j,k))*v0(i,j,k)/60.& + +abs(v0(i,j,k))/60.& *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi & - +(1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - -w0(i,j,k) * (rhoputin(i,j,k-1)+rhoputin(i,j,k)) & - ) / ( 2. * dzf(k) ) & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + -w0(i,j,k) * (rhobf_m * putin(i,j,k-1) + putin(i,j,k)) & + ) * inv2dzfk & ) end if @@ -133,19 +139,19 @@ subroutine advecu_52(putin,putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the u field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax do j=2,j1 @@ -175,7 +181,7 @@ subroutine advecu_52(putin,putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(k))*( & - ( rhoputin(i,j,k+1) + rhoputin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & + ( rhobf(k+1)*putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & ) / (4.*dzf(k)) & ) @@ -202,8 +208,8 @@ subroutine advecu_52(putin,putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & + (rhobf(k) * putin(i,j,k) + rhobf(k+1) * putin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & + -(rhobf(k) * putin(i,j,k) + rhobf(k-1) * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & ) / (4. * dzf(k)) & ) end if @@ -224,19 +230,19 @@ subroutine advecv_52(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do + !do k=1,k1 + ! do j=2-jh,j1+jh + ! do i=2-ih,i1+ih + ! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) + ! end do + ! end do + !end do do k=1,kmax do j=2,j1 @@ -266,7 +272,7 @@ subroutine advecv_52(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhoputin(i,j,k+1)+rhoputin(i,j,k)) & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf(k+1) * putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) & ) / (4. * dzf(k)) & ) @@ -293,8 +299,8 @@ subroutine advecv_52(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - -(w0(i,j,k) +w0(i,j-1,k)) *(rhoputin(i,j,k-1)+rhoputin(i,j,k)) & + (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf(k+1) * putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) & + -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf(k-1) * putin(i,j,k-1) + rhobf(k) * putin(i,j,k)) & ) / (4. * dzf(k)) & ) end if @@ -315,19 +321,19 @@ subroutine advecw_52(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) - end do - end do - end do + !do k=1,k1 + ! do j=2-jh,j1+jh + ! do i=2-ih,i1+ih + ! rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) + ! end do + ! end do + !end do do k=2,kmax do j=2,j1 @@ -354,8 +360,8 @@ subroutine advecw_52(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & + (1./rhobh(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1)) & + (rhobh(k) * putin(i,j,k) + rhobh(k+1) * putin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & + -(rhobh(k) * putin(i,j,k) + rhobh(k-1) * putin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1)) & )/ (4. * dzh(k)) & ) end do diff --git a/src/advec_62.f90 b/src/advec_62.f90 index 47cd0f6c..48df0543 100644 --- a/src/advec_62.f90 +++ b/src/advec_62.f90 @@ -38,21 +38,26 @@ subroutine advecc_62(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + real :: inv2dzfk, rhobf_p, rhobf_m integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + do j=2,j1 do i=2,i1 @@ -71,9 +76,9 @@ subroutine advecc_62(putin, putout) -v0(i,j,k)/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi & - + (1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1) + rhoputin(i,j,k)) & - ) /(2.*dzf(k)) & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + ) * inv2dzfk & ) else @@ -91,10 +96,10 @@ subroutine advecc_62(putin, putout) -v0(i,j,k)/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi & - + (1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - -w0(i,j,k) * (rhoputin(i,j,k-1)+rhoputin(i,j,k)) & - )/(2.*dzf(k)) & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + -w0(i,j,k) * (rhobf_m * putin(i,j,k-1) + putin(i,j,k)) & + ) * inv2dzfk & ) end if @@ -117,21 +122,26 @@ subroutine advecu_62(putin,putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the u field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + real :: inv4dzfk, rhobf_p, rhobf_m integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + do j=2,j1 do i=2,i1 @@ -150,9 +160,9 @@ subroutine advecu_62(putin,putout) -(v0(i,j,k)+v0(i-1,j,k))/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & - +(1./rhobf(k))*( & - (rhoputin(i,j,k+1) + rhoputin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & - )/(4.*dzf(k)) & + + ( & + (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & + ) * inv4dzfk & ) else @@ -170,10 +180,10 @@ subroutine advecu_62(putin,putout) -(v0(i,j,k)+v0(i-1,j,k))/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & - +(1./rhobf(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & - )/(4.*dzf(k)) & + + ( & + (putin(i,j,k) + rhobf_p * putin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & + -(putin(i,j,k) + rhobf_m * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & + ) * inv4dzfk & ) end if @@ -196,21 +206,26 @@ subroutine advecv_62(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + real :: inv4dzfk, rhobf_p, rhobf_m integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + do j=2,j1 do i=2,i1 @@ -229,9 +244,9 @@ subroutine advecv_62(putin, putout) -(v0(i,j,k)+v0(i,j-1,k))/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & - +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - ) /(4.*dzf(k)) & + +( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf_p * putin(i,j,k+1)+putin(i,j,k)) & + ) * inv4dzfk & ) else @@ -249,10 +264,10 @@ subroutine advecv_62(putin, putout) -(v0(i,j,k)+v0(i,j-1,k))/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & - +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhoputin(i,j,k+1)+rhoputin(i,j,k))& - -(w0(i,j,k) +w0(i,j-1,k)) *(rhoputin(i,j,k-1)+rhoputin(i,j,k))& - )/(4.*dzf(k)) & + + ( & + (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf_p * putin(i,j,k+1) + putin(i,j,k))& + -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf_m * putin(i,j,k-1) + putin(i,j,k))& + ) * inv4dzfk & ) end if @@ -275,21 +290,26 @@ subroutine advecw_62(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + real :: inv4dzhk, rhobh_p, rhobh_m integer :: i,j,k !if (leq) then - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) +! end do +! end do +! end do do k=2,kmax + inv4dzhk = 1./(4. * dzh(k)) + rhobh_p = rhobh(k+1)/rhobh(k) + rhobh_m = rhobh(k-1)/rhobh(k) + do j=2,j1 do i=2,i1 @@ -306,10 +326,10 @@ subroutine advecw_62(putin, putout) -(v0(i,j,k)+v0(i,j,k-1))/60. & *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & - + (1./rhobh(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1))*(w0(i,j,k) + w0(i,j,k-1)) & - )/(4.*dzh(k)) & + + ( & + (putin(i,j,k)+rhobh_p * putin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & + -(putin(i,j,k)+rhobh_m * putin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1)) & + )*inv4dzhk & ) end do end do diff --git a/src/advec_kappa.f90 b/src/advec_kappa.f90 index d2de83f6..5d624f05 100644 --- a/src/advec_kappa.f90 +++ b/src/advec_kappa.f90 @@ -42,19 +42,19 @@ subroutine advecc_kappa(putin,putout) real,external :: rlim real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin +! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real d1,d2,cf integer i,j,k - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=1,kmax do j=2,j1 @@ -98,13 +98,13 @@ subroutine advecc_kappa(putin,putout) do j=2,j1 do i=2,i1 if (w0(i,j,k)>0) then - d1 = rhoputin(i,j,k-1)-rhoputin(i,j,k-2) - d2 = rhoputin(i,j,k )-rhoputin(i,j,k-1) - cf = rhoputin(i,j,k-1) + d1 = rhobf(k-1) * putin(i,j,k-1) - rhobf(k-2) * putin(i,j,k-2) + d2 = rhobf(k) * putin(i,j,k ) - rhobf(k-1) * putin(i,j,k-1) + cf = rhobf(k-1) * putin(i,j,k-1) else - d1 = rhoputin(i,j,k )-rhoputin(i,j,k+1) - d2 = rhoputin(i,j,k-1)-rhoputin(i,j,k ) - cf = rhoputin(i,j,k ) + d1 = rhobf(k) * putin(i,j,k ) - rhobf(k+1) * putin(i,j,k+1) + d2 = rhobf(k-1) * putin(i,j,k-1) - rhobf(k) * putin(i,j,k ) + cf = rhobf(k) * putin(i,j,k ) end if cf = cf + rlim(d1,d2) putout(i,j,k-1) = putout(i,j,k-1) - (1./rhobf(k-1))*cf * w0(i,j,k) * dzi @@ -117,12 +117,12 @@ subroutine advecc_kappa(putin,putout) do i=2,i1 if (w0(i,j,2)>0) then d1 = 0 - d2 = rhoputin(i,j,1)-rhoputin(i,j,2) - cf = rhoputin(i,j,1) + d2 = rhobf(1) * putin(i,j,1) - rhobf(2) * putin(i,j,2) + cf = rhobf(1) * putin(i,j,1) else - d1 = rhoputin(i,j,2)-rhoputin(i,j,3) - d2 = rhoputin(i-1,j,1)-rhoputin(i,j,2) - cf = rhoputin(i,j,2) + d1 = rhobf(2) * putin(i,j,2) - rhobf(3) * putin(i,j,3) + d2 = rhobf(1) * putin(i-1,j,1) - rhobf(2) * putin(i,j,2) + cf = rhobf(2) * putin(i,j,2) end if cf = cf + rlim(d1,d2) putout(i,j,1) = putout(i,j,1) - (1./rhobf(1))*cf * w0(i,j,2) * dzi @@ -142,30 +142,30 @@ subroutine halflev_kappa(putin,putout) real,external :: rlim real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin + !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real d1,d2,cf integer i,j,k - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do +! do k=1,k1 +! do j=2-jh,j1+jh +! do i=2-ih,i1+ih +! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) +! end do +! end do +! end do do k=3,k1 do j=2,j1 do i=2,i1 if (w0(i,j,k)>=0) then - d1 = rhoputin(i,j,k-1)-rhoputin(i,j,k-2) - d2 = rhoputin(i,j,k )-rhoputin(i,j,k-1) - cf = rhoputin(i,j,k-1) + d1 = rhobf(k-1) * putin(i,j,k-1) - rhobf(k-2) * putin(i,j,k-2) + d2 = rhobf(k) * putin(i,j,k ) - rhobf(k-1) * putin(i,j,k-1) + cf = rhobf(k-1) * putin(i,j,k-1) else - d1 = rhoputin(i,j,k )-rhoputin(i,j,k+1) - d2 = rhoputin(i,j,k-1)-rhoputin(i,j,k ) - cf = rhoputin(i,j,k ) + d1 = rhobf(k) * putin(i,j,k ) - rhobf(k+1) * putin(i,j,k+1) + d2 = rhobf(k-1) * putin(i,j,k-1) - rhobf(k) * putin(i,j,k ) + cf = rhobf(k) * putin(i,j,k ) end if putout(i,j,k) = (1./rhobh(k))*(cf + rlim(d1,d2)) end do @@ -176,12 +176,12 @@ subroutine halflev_kappa(putin,putout) do i=2,i1 if (w0(i,j,2)>=0) then d1 = 0 - d2 = rhoputin(i,j,2)-rhoputin(i,j,1) - cf = rhoputin(i,j,1) + d2 = rhobf(2) * putin(i,j,2) - rhobf(1) * putin(i,j,1) + cf = rhobf(1) * putin(i,j,1) else - d1 = rhoputin(i,j,2)-rhoputin(i,j,3) - d2 = rhoputin(i,j,1)-rhoputin(i,j,2) - cf = rhoputin(i,j,2) + d1 = rhobf(2) * putin(i,j,2) - rhobf(3) * putin(i,j,3) + d2 = rhobf(1) * putin(i,j,1) - rhobf(2) * putin(i,j,2) + cf = rhobf(2) * putin(i,j,2) end if putout(i,j,2) = (1./rhobh(2))*(cf + rlim(d1,d2)) end do From 32b277786b20ce173ca6eb6218505335daec16af Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Jul 2017 15:01:56 +0200 Subject: [PATCH 40/88] allocate large arrays instead of storing on the stack --- src/modpois.f90 | 7 +++++-- src/modstartup.f90 | 6 +++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/modpois.f90 b/src/modpois.f90 index 2c692cc2..26405f5c 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -236,11 +236,13 @@ subroutine solmpj real :: a(kmax),b(kmax),c(kmax) ! allocate d in the same shape as p and xyrt - real :: d(2-ih:i1+ih,2-jh:j1+jh,kmax) + real, allocatable :: d(:,:,:) real z,ak,bk,bbk integer i, j, k + allocate(d(2-ih:i1+ih,2-jh:j1+jh,kmax)) + ! Forward FFT call fft2df(p,ih,jh) @@ -303,7 +305,8 @@ subroutine solmpj ! Backward FFT call fft2db(p,ih,jh) - return + deallocate(d) + return end subroutine solmpj !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tderive diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 759f179d..b7416459 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -383,13 +383,13 @@ subroutine readinitfiles integer i,j,k,n real, allocatable :: height(:), th0av(:) - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: thv0 + real, allocatable :: thv0(:,:,:) character(80) chmess allocate (height(k1)) allocate (th0av(k1)) - + allocate(thv0(2-ih:i1+ih,2-jh:j1+jh,k1)) if (.not. lwarmstart) then @@ -794,7 +794,7 @@ subroutine readinitfiles rtimee = real(timee)*tres itrestart = floor(trestart/tres) tnextrestart = btime + itrestart - deallocate (height,th0av) + deallocate (height,th0av,thv0) end subroutine readinitfiles From cd92f7351eaaa69e0a881646eb9cab393a8aea57 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Jul 2017 15:15:57 +0200 Subject: [PATCH 41/88] Obukhov length calculation: catch case Rib = 0 - set L=1e6. Can happen in the first step if the surface flux is 0 --- src/modsurface.f90 | 137 +++++++++++++++++++++++++-------------------- 1 file changed, 75 insertions(+), 62 deletions(-) diff --git a/src/modsurface.f90 b/src/modsurface.f90 index 7dc9dfb5..a646c00b 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -1107,7 +1107,7 @@ subroutine qtsurf end subroutine qtsurf -!> Calculates the Obuhkov length iteratively. +!> Calculates the Obukhov length iteratively. subroutine getobl use modglobal, only : zf, rv, rd, grav, i1, j1, i2, j2, cu, cv use modfields, only : thl0av, qt0av, u0, v0, thl0, qt0, u0av, v0av @@ -1146,35 +1146,42 @@ subroutine getobl Rib = grav / thvs * zf(1) * (thv - thvsl) / horv2 endif - iter = 0 - L = obl(i,j) + if (Rib == 0) then + ! Rib can be 0 if there is no surface flux + ! L is capped at 1e6 below, so use the same cap here + L = 1e6 + write(*,*) 'Obukhov length: Rib = 0 -> setting L=1e6' + else + iter = 0 + L = obl(i,j) + + if(Rib * L < 0. .or. abs(L) == 1e5) then + if(Rib > 0) L = 0.01 + if(Rib < 0) L = -0.01 + end if + + do while (.true.) + iter = iter + 1 + Lold = L + fx = Rib - zf(1) / L * (log(zf(1) / z0h(i,j)) - psih(zf(1) / L) + psih(z0h(i,j) / L)) /& + (log(zf(1) / z0m(i,j)) - psim(zf(1) / L) + psim(z0m(i,j) / L)) ** 2. + Lstart = L - 0.001*L + Lend = L + 0.001*L + fxdif = ( (- zf(1) / Lstart * (log(zf(1) / z0h(i,j)) - psih(zf(1) / Lstart) + psih(z0h(i,j) / Lstart)) /& + (log(zf(1) / z0m(i,j)) - psim(zf(1) / Lstart) + psim(z0m(i,j) / Lstart)) ** 2.) - (-zf(1) / Lend * & + (log(zf(1) / z0h(i,j)) - psih(zf(1) / Lend) + psih(z0h(i,j) / Lend)) / (log(zf(1) / z0m(i,j)) - psim(zf(1) / Lend)& + + psim(z0m(i,j) / Lend)) ** 2.) ) / (Lstart - Lend) + L = L - fx / fxdif + if(Rib * L < 0. .or. abs(L) == 1e5) then + if(Rib > 0) L = 0.01 + if(Rib < 0) L = -0.01 + end if + if(abs((L - Lold)/L) < 1e-4) exit + if(iter > 1000) stop 'Obukhov length calculation does not converge!' + end do - if(Rib * L < 0. .or. abs(L) == 1e5) then - if(Rib > 0) L = 0.01 - if(Rib < 0) L = -0.01 + if (abs(L)>1e6) L = sign(1.0e6,L) end if - - do while (.true.) - iter = iter + 1 - Lold = L - fx = Rib - zf(1) / L * (log(zf(1) / z0h(i,j)) - psih(zf(1) / L) + psih(z0h(i,j) / L)) /& - (log(zf(1) / z0m(i,j)) - psim(zf(1) / L) + psim(z0m(i,j) / L)) ** 2. - Lstart = L - 0.001*L - Lend = L + 0.001*L - fxdif = ( (- zf(1) / Lstart * (log(zf(1) / z0h(i,j)) - psih(zf(1) / Lstart) + psih(z0h(i,j) / Lstart)) /& - (log(zf(1) / z0m(i,j)) - psim(zf(1) / Lstart) + psim(z0m(i,j) / Lstart)) ** 2.) - (-zf(1) / Lend * & - (log(zf(1) / z0h(i,j)) - psih(zf(1) / Lend) + psih(z0h(i,j) / Lend)) / (log(zf(1) / z0m(i,j)) - psim(zf(1) / Lend)& - + psim(z0m(i,j) / Lend)) ** 2.) ) / (Lstart - Lend) - L = L - fx / fxdif - if(Rib * L < 0. .or. abs(L) == 1e5) then - if(Rib > 0) L = 0.01 - if(Rib < 0) L = -0.01 - end if - if(abs((L - Lold)/L) < 1e-4) exit - if(iter > 1000) stop 'Obukhov length calculation does not converge!' - end do - - if (abs(L)>1e6) L = sign(1.0e6,L) obl(i,j) = L end do @@ -1278,40 +1285,46 @@ subroutine getobl horv2 = max(horv2, 0.01) Rib = grav / thvs * zf(1) * (thv - thvs) / horv2 - - iter = 0 - L = oblav - - if(Rib * L < 0. .or. abs(L) == 1e5) then - if(Rib > 0) L = 0.01 - if(Rib < 0) L = -0.01 - end if - - do while (.true.) - iter = iter + 1 - Lold = L - fx = Rib - zf(1) / L * (log(zf(1) / z0hav) - psih(zf(1) / L) + psih(z0hav / L)) /& - (log(zf(1) / z0mav) - psim(zf(1) / L) + psim(z0mav / L)) ** 2. - Lstart = L - 0.001*L - Lend = L + 0.001*L - fxdif = ( (- zf(1) / Lstart * (log(zf(1) / z0hav) - psih(zf(1) / Lstart) + psih(z0hav / Lstart)) /& - (log(zf(1) / z0mav) - psim(zf(1) / Lstart) + psim(z0mav / Lstart)) ** 2.) - (-zf(1) / Lend * (log(zf(1) / z0hav) & - - psih(zf(1) / Lend) + psih(z0hav / Lend)) / (log(zf(1) / z0mav) - psim(zf(1) / Lend) & - + psim(z0mav / Lend)) ** 2.) ) / (Lstart - Lend) - L = L - fx / fxdif - if(Rib * L < 0. .or. abs(L) == 1e5) then - if(Rib > 0) L = 0.01 - if(Rib < 0) L = -0.01 - end if - if(abs((L - Lold)/L) < 1e-4) exit - if(iter > 1000) stop 'Obukhov length calculation does not converge!' - end do - - if (abs(L)>1e6) L = sign(1.0e6,L) - if(.not. lmostlocal) then - if(.not. lhetero) then - obl(:,:) = L - endif + if (Rib == 0) then + ! Rib can be 0 if there is no surface flux + ! L is capped at 1e6 below, so use the same cap here + L = 1e6 + write(*,*) 'Obukhov length: Rib = 0 -> setting L=1e6 (2nd point)' + else + iter = 0 + L = oblav + + if(Rib * L < 0. .or. abs(L) == 1e5) then + if(Rib > 0) L = 0.01 + if(Rib < 0) L = -0.01 + end if + + do while (.true.) + iter = iter + 1 + Lold = L + fx = Rib - zf(1) / L * (log(zf(1) / z0hav) - psih(zf(1) / L) + psih(z0hav / L)) /& + (log(zf(1) / z0mav) - psim(zf(1) / L) + psim(z0mav / L)) ** 2. + Lstart = L - 0.001*L + Lend = L + 0.001*L + fxdif = ( (- zf(1) / Lstart * (log(zf(1) / z0hav) - psih(zf(1) / Lstart) + psih(z0hav / Lstart)) /& + (log(zf(1) / z0mav) - psim(zf(1) / Lstart) + psim(z0mav / Lstart)) ** 2.) - (-zf(1) / Lend * (log(zf(1) / z0hav) & + - psih(zf(1) / Lend) + psih(z0hav / Lend)) / (log(zf(1) / z0mav) - psim(zf(1) / Lend) & + + psim(z0mav / Lend)) ** 2.) ) / (Lstart - Lend) + L = L - fx / fxdif + if(Rib * L < 0. .or. abs(L) == 1e5) then + if(Rib > 0) L = 0.01 + if(Rib < 0) L = -0.01 + end if + if(abs((L - Lold)/L) < 1e-4) exit + if(iter > 1000) stop 'Obukhov length calculation does not converge!' + end do + + if (abs(L)>1e6) L = sign(1.0e6,L) + if(.not. lmostlocal) then + if(.not. lhetero) then + obl(:,:) = L + endif + end if end if oblav = L From 49b0eae83ee97cd1c8d856dd2ad5ebd01d4bb890 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Thu, 16 Feb 2017 11:54:33 +0100 Subject: [PATCH 42/88] add comment about esatltab, esatitab --- src/modglobal.f90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index cc454f1e..bfc416f9 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -310,10 +310,17 @@ subroutine initglobal ! Global constants + + + ! esatltab(m) gives the saturation vapor pressure over water at T corresponding to m + ! esatitab(m) is the same over ice + ! http://www.radiativetransfer.org/misc/atmlabdoc/atmlab/h2o/thermodynamics/e_eq_water_mk.html + ! Murphy and Koop 2005 parameterization formula. do m=1,2000 ttab(m)=150.+0.2*m esatltab(m)=exp(54.842763-6763.22/ttab(m)-4.21*log(ttab(m))+0.000367*ttab(m)+& - tanh(0.0415*(ttab(m)-218.8))*(53.878-1331.22/ttab(m)-9.44523*log(ttab(m))+ 0.014025*ttab(m))) + tanh(0.0415*(ttab(m)-218.8))*(53.878-1331.22/ttab(m)-9.44523*log(ttab(m))+ 0.014025*ttab(m))) + esatitab(m)=exp(9.550426-5723.265/ttab(m)+3.53068*log(ttab(m))-0.00728332*ttab(m)) end do From a824fee11af17e90d91c188baffff5552601e56a Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Jul 2017 15:19:19 +0200 Subject: [PATCH 43/88] Add ECMWF build option. Cray fortran fix: avoid -1**real. Conflicts: CMakeLists.txt --- CMakeLists.txt | 5 +++++ src/modsurface.f90 | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d65f33e7..26e3332b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -31,6 +31,11 @@ elseif("$ENV{SYST}" STREQUAL "FEDORA") set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none -I /usr/lib64/gfortran/modules/mpich/" CACHE STRING "") set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3" CACHE STRING "") set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "ECMWF") + set(CMAKE_Fortran_COMPILER "ftn") + set(CMAKE_Fortran_FLAGS "-s real64" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-g -R b -K trap=fp" CACHE STRING "") else() set(CMAKE_Fortran_COMPILER "mpif90") set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none " CACHE STRING "") diff --git a/src/modsurface.f90 b/src/modsurface.f90 index a646c00b..c9eb5937 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -1382,7 +1382,9 @@ function E1(x) E1sum = 0.0 do k=1,99 - E1sum = E1sum + (-1.0) ** (k + 0.0) * x ** (k + 0.0) / ( (k + 0.0) * factorial(k) ) + !E1sum = E1sum + (-1.0) ** (k + 0.0) * x ** (k + 0.0) / ( (k + 0.0) * factorial(k) ) + E1sum = E1sum + (-1.0 * x) ** k / ( k * factorial(k) ) ! FJ changed this for compilation with cray fortran + end do E1 = -0.57721566490153286060 - log(x) - E1sum From 53a7d067f2462091f59dacfc24e3d6cfa70000a9 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 19 Jul 2017 16:12:58 +0200 Subject: [PATCH 44/88] tstep_integrate: vector math instead of do loops --- src/tstep.f90 | 55 ++++++++++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 31 deletions(-) diff --git a/src/tstep.f90 b/src/tstep.f90 index a34417f8..9d4c4a15 100644 --- a/src/tstep.f90 +++ b/src/tstep.f90 @@ -171,27 +171,30 @@ subroutine tstep_integrate rk3coef = rdt / (4. - dble(rk3step)) wp_store = wp - do k=1,kmax - do j=2,j1 - do i=2,i1 - - u0(i,j,k) = um(i,j,k) + rk3coef * up(i,j,k) - v0(i,j,k) = vm(i,j,k) + rk3coef * vp(i,j,k) - w0(i,j,k) = wm(i,j,k) + rk3coef * wp(i,j,k) - thl0(i,j,k) = thlm(i,j,k) + rk3coef * thlp(i,j,k) - qt0(i,j,k) = qtm(i,j,k) + rk3coef * qtp(i,j,k) - e120(i,j,k) = e12m(i,j,k) + rk3coef * e12p(i,j,k) - - e120(i,j,k) = max(e12min,e120(i,j,k)) - e12m(i,j,k) = max(e12min,e12m(i,j,k)) - - do n=1,nsv - sv0(i,j,k,n) = svm(i,j,k,n) + rk3coef * svp(i,j,k,n) - end do - - end do - end do - end do + if(rk3step /= 3) then + u0 = um + rk3coef * up + v0 = vm + rk3coef * vp + w0 = wm + rk3coef * wp + thl0 = thlm + rk3coef * thlp + qt0 = qtm + rk3coef * qtp + sv0 = svm + rk3coef * svp + e120 = max(e12min,e12m + rk3coef * e12p) + else ! step 3 - store result in both ..0 and ..m + um = um + rk3coef * up + u0 = um + vm = vm + rk3coef * vp + v0 = vm + wm = wm + rk3coef * wp + w0 = wm + thlm = thlm + rk3coef * thlp + thl0 = thlm + qtm = qtm + rk3coef * qtp + qt0 = qtm + svm = svm + rk3coef * svp + sv0 = svm + e12m = max(e12min,e12m + rk3coef * e12p) + e120 = e12m + end if up=0. vp=0. @@ -201,14 +204,4 @@ subroutine tstep_integrate svp=0. e12p=0. - if(rk3step == 3) then - um = u0 - vm = v0 - wm = w0 - thlm = thl0 - qtm = qt0 - e12m = e120 - svm = sv0 - end if - end subroutine tstep_integrate From 656372240ec7b96d1545406c97ef5c3fc6de3910 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Mon, 29 Jan 2018 14:14:04 +0100 Subject: [PATCH 45/88] Add alternative simpleice - imicro=6. Contains fixes and optimizations but less statistics. --- src/modmicrodata.f90 | 3 +- src/modmicrophysics.f90 | 25 +- src/modsimpleice2.f90 | 564 ++++++++++++++++++++++++++++++++++++++++ src/modstartup.f90 | 2 +- 4 files changed, 586 insertions(+), 8 deletions(-) create mode 100644 src/modsimpleice2.f90 diff --git a/src/modmicrodata.f90 b/src/modmicrodata.f90 index b1b01cdd..2a7b3a60 100644 --- a/src/modmicrodata.f90 +++ b/src/modmicrodata.f90 @@ -34,6 +34,7 @@ module modmicrodata integer, parameter :: imicro_bulk = 2 integer, parameter :: imicro_bin = 3 integer, parameter :: imicro_sice = 5 + integer, parameter :: imicro_sice2 = 6 integer, parameter :: imicro_user = 10 logical :: l_sb = .true. , &!< SB scheme (.true.) / KK00 scheme (.false.) (in namelist NAMMICROPHYSICS) l_sedc = .true. , & !< cloud droplet sedimentation flag (in namelist NAMMICROPHYSICS) @@ -233,5 +234,5 @@ module modmicrodata real,allocatable,dimension(:,:,:) :: ilratio,rsgratio,sgratio,lambdar,lambdas,lambdag ! Density-corrected A coefficients for terminal velocity real,allocatable,dimension(:) :: ccrz,ccsz,ccgz - + real,allocatable,dimension(:) :: ccrz2,ccsz2,ccgz2 end module modmicrodata diff --git a/src/modmicrophysics.f90 b/src/modmicrophysics.f90 index 26144731..d908c0fe 100644 --- a/src/modmicrophysics.f90 +++ b/src/modmicrophysics.f90 @@ -38,15 +38,17 @@ module modmicrophysics contains subroutine initmicrophysics use modmpi, only :myid,my_real,comm3d,mpi_integer,mpi_logical - use modglobal,only :ifnamopt,fname_options + use modglobal,only :ifnamopt,fname_options,nsv use modbulkmicro, only : initbulkmicro use modsimpleice, only : initsimpleice + use modsimpleice2, only : initsimpleice2 implicit none integer :: ierr namelist/NAMMICROPHYSICS/ & imicro,l_sb,l_rain,l_sedc,l_mur_cst,l_berry,l_graupel,l_warm,mur_cst, & ! OG - Nc_0, sig_g, sig_gr ! SdeR - + Nc_0, sig_g, sig_gr, & ! SdeR + courantp ! FJ + if(myid==0)then open(ifnamopt,file=fname_options,status='old',iostat=ierr) read (ifnamopt,NAMMICROPHYSICS,iostat=ierr) @@ -76,11 +78,16 @@ subroutine initmicrophysics case(imicro_none) case(imicro_drizzle) case(imicro_bulk) + if (nsv < 2) STOP "ERROR: Bulk microphysics requires nsv >=2" call initbulkmicro case(imicro_bin) ! call initbinmicro case(imicro_sice) - call initsimpleice + if (nsv < 2) STOP "ERROR: Simple ice microphysics requires nsv >=2" + call initsimpleice + case(imicro_sice2) + if (nsv < 2) STOP "ERROR: Simple ice microphysics requires nsv >=2" + call initsimpleice2 case(imicro_user) end select end subroutine initmicrophysics @@ -106,6 +113,7 @@ subroutine microsources use moduser, only : micro_user use modbulkmicro, only : bulkmicro use modsimpleice, only : simpleice + use modsimpleice2, only : simpleice2 ! use modbinmicro, only : binmicrosources implicit none @@ -118,7 +126,9 @@ subroutine microsources case(imicro_bin) ! call binmicrosources case(imicro_sice) - call simpleice + call simpleice + case(imicro_sice2) + call simpleice2 case(imicro_user) call micro_user end select @@ -128,6 +138,7 @@ end subroutine microsources subroutine exitmicrophysics use modbulkmicro, only : exitbulkmicro use modsimpleice, only : exitsimpleice + use modsimpleice2, only : exitsimpleice2 ! use modbinmicro, only : exitbinmicro implicit none @@ -140,7 +151,9 @@ subroutine exitmicrophysics ! call exitbinmicro case(imicro_user) case(imicro_sice) - call exitsimpleice + call exitsimpleice + case(imicro_sice2) + call exitsimpleice2 end select end subroutine exitmicrophysics diff --git a/src/modsimpleice2.f90 b/src/modsimpleice2.f90 new file mode 100644 index 00000000..f5f804ff --- /dev/null +++ b/src/modsimpleice2.f90 @@ -0,0 +1,564 @@ +!> \file modsimpleice.f90 + +!> +!! Ice microphysics. +!> +!! Calculates ice microphysics in a cheap scheme without prognostic nr +!! simpleice is called from *modmicrophysics* +!! \see Grabowski, 1998, JAS +!! and Khairoutdinov and Randall, 2006, JAS +!! \author Steef B\"oing, TU Delft +!! \par Revision list +! +! FJ: seems the ref should be Khairoutdinov and Randall, 2003, JAS +! +! http://dx.doi.org/10.1175/1520-0469(1998)055%3C3283:TCRMOL%3E2.0.CO;2 +! http://dx.doi.org/10.1175/JAS3810.1 +! http://dx.doi.org/10.1175/1520-0469(2003)060<0607:CRMOTA>2.0.CO;2 - 2003 +! +! This file is part of DALES. +! +! DALES is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 3 of the License, or +! (at your option) any later version. +! +! DALES is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +! Copyright 1993-2009 Delft University of Technology, Wageningen University, Utrecht University, KNMI +! + + +module modsimpleice2 + use modmicrodata + use modfields, only : rhobf + implicit none + real :: gamb1r + real :: gambd1r + real :: gamb1s + real :: gambd1s + real :: gamb1g + real :: gambd1g + real :: gam2dr + real :: gam2ds + real :: gam2dg + real :: gammaddr3 + real :: gammadds3 + real :: gammaddg3 + contains + +!> Initializes and allocates the arrays + subroutine initsimpleice2 + use modglobal, only : ih,i1,jh,j1,k1,lacz_gamma + implicit none + integer:: k + + + allocate (qr(2-ih:i1+ih,2-jh:j1+jh,k1) & ! qr (total precipitation!) converted from a scalar variable + ,qrp(2-ih:i1+ih,2-jh:j1+jh,k1) & ! qr tendency due to microphysics only, for statistics + ,nr(2-ih:i1+ih,2-jh:j1+jh,k1) & ! qr (total precipitation!) converted from a scalar variable + ,nrp(2-ih:i1+ih,2-jh:j1+jh,k1) & ! qr tendency due to microphysics only, for statistics + ,thlpmcr(2-ih:i1+ih,2-jh:j1+jh,k1) & ! thl tendency due to microphysics only, for statistics + ,qtpmcr(2-ih:i1+ih,2-jh:j1+jh,k1) & ! qt tendency due to microphysics only, for statistics + ,sed_qr(2-ih:i1+ih,2-jh:j1+jh,k1) & ! sedimentation rain droplets mixing ratio + ,qr_spl(2-ih:i1+ih,2-jh:j1+jh,k1) & ! time-splitting substep qr + ,ilratio(2-ih:i1+ih,2-jh:j1+jh,k1) & ! partition ratio cloud water vs cloud ice + ,rsgratio(2-ih:i1+ih,2-jh:j1+jh,k1) & ! partition ratio rain vs. snow/graupel + ,sgratio(2-ih:i1+ih,2-jh:j1+jh,k1) & ! partition ratio snow vs graupel + ,lambdar(2-ih:i1+ih,2-jh:j1+jh,k1) & ! slope parameter for rain + ,lambdas(2-ih:i1+ih,2-jh:j1+jh,k1) & ! slope parameter for snow + ,lambdag(2-ih:i1+ih,2-jh:j1+jh,k1)) ! slope parameter for graupel + + allocate (qrmask(2-ih:i1+ih,2-jh:j1+jh,k1) & ! mask for rain water + ,qcmask(2-ih:i1+ih,2-jh:j1+jh,k1)) ! mask for cloud water + + allocate(precep(2-ih:i1+ih,2-jh:j1+jh,k1)) ! precipitation for statistics + + allocate(ccrz(k1),ccsz(k1),ccgz(k1)) + allocate(ccrz2(k1),ccsz2(k1),ccgz2(k1)) + + gamb1r=lacz_gamma(bbr+1) + gambd1r=lacz_gamma(bbr+ddr+1) + gamb1s=lacz_gamma(bbs+1) + gambd1s=lacz_gamma(bbs+dds+1) + gamb1g=lacz_gamma(bbg+1) + gambd1g=lacz_gamma(bbg+ddg+1) + gam2dr=lacz_gamma(2.5+0.5*ddr) + gam2ds=lacz_gamma(2.5+0.5*dds) + gam2dg=lacz_gamma(2.5+0.5*ddg) + gammaddr3=lacz_gamma(3.+ddr) + gammadds3=lacz_gamma(3.+dds) + gammaddg3=lacz_gamma(3.+ddg) + + + ! Density corrected fall speed parameters, see Tomita 2008 + ! rhobf is constant in time + do k=1,k1 + ccrz(k)=ccr*(1.29/rhobf(k))**0.5 + ccsz(k)=ccs*(1.29/rhobf(k))**0.5 + ccgz(k)=ccg*(1.29/rhobf(k))**0.5 + + ! these coefficients are used in evapdep - tabulated because of sqrt + ccrz2(k) = gam2dr*.27*n0rr*sqrt(ccrz(k)/2.e-5) + ccsz2(k) = gam2ds*.39*n0rs*sqrt(ccsz(k)/2.e-5) ! NOTE: .27 here is suspect -> .39 + ccgz2(k) = gam2dg*.27*n0rg*sqrt(ccgz(k)/2.e-5) + end do + + nrp=0. ! not used in this scheme + nr=0. ! set to 0 here in case the statistics use them + + end subroutine initsimpleice2 + + +!> Cleaning up after the run + subroutine exitsimpleice2 + implicit none + deallocate(nr,nrp,qr,qrp,thlpmcr,qtpmcr,sed_qr,qr_spl,ilratio,rsgratio,sgratio,lambdar,lambdas,lambdag) + deallocate(qrmask,qcmask) + deallocate(precep) + deallocate(ccrz,ccsz,ccgz) + deallocate(ccrz2,ccsz2,ccgz2) + end subroutine exitsimpleice2 + + +!> Calculates the microphysical source term. + subroutine simpleice2 + use modglobal, only : i1,j1,k1,rdt,rk3step,timee,rlv,cp,tup,tdn,pi,tmelt,kmax,dzf,dzh + use modfields, only : sv0,svm,svp,qtp,thlp,qt0,ql0,exnf,rhof,tmp0,rhobf,qvsl,qvsi,esl + + use modsimpleicestat, only : simpleicetend + implicit none + integer:: i,j,k + real:: qrsmall, qrsum,qrtest + real :: qll,qli,ddisp,lwc,autl,tc,times,auti,aut ! autoconvert + real :: qrr,qrs,qrg, gaccrl,gaccsl,gaccgl,gaccri,gaccsi,gaccgi,accr,accs,accg,acc !accrete + real :: ssl,ssi,ventr,vents,ventg,thfun,evapdepr,evapdeps,evapdepg,devap !evapdep + real :: dt_spl,wfallmax,vtr,vts,vtg,vtf ! precipitation + real :: tmp_lambdar, tmp_lambdas, tmp_lambdag + integer :: jn + integer :: n_spl !< sedimentation time splitting loop + + real :: ilratio_,lambdar_,lambdas_,lambdag_, rsgratio_, sgratio_ ! local values instead of global arrays + logical :: qrmask_, qcmask_ + logical :: rain_present, snow_present, graupel_present ! logicals for presence of different forms of water in the current cell + logical :: any_qr, any_snow_graupel ! logicals for precense of any precipitation, and for presense of snow/graupel in the whole system + + delt = rdt/ (4. - dble(rk3step)) + + wfallmax = 9.9 ! cap for fall velocity + n_spl = ceiling(wfallmax*delt/(minval(dzf)*courantp)) ! number of sub-timesteps for precipitation + dt_spl = delt/real(n_spl) ! fixed time step for precipitation sub-stepping! + + ! sed_qr = 0. ! reset sedimentation fluxes + sed_qr(:,:,kmax+1) = 0 ! initialize ghost cells, other cells are initialized before use + + + ! Density corrected fall speed parameters, see Tomita 2008 + ! rhobf is constant in time + ! do k=1,k1 + ! ccrz(k)=ccr*(1.29/rhobf(k))**0.5 + ! ccsz(k)=ccs*(1.29/rhobf(k))**0.5 + ! ccgz(k)=ccg*(1.29/rhobf(k))**0.5 + ! end do + + ! used to check on negative qr and nr + qrsum=0. + qrsmall=0. + ! reset microphysics tendencies + qrp=0. + + !nrp=0. ! not used in this scheme + !nr=0. + + thlpmcr=0. + qtpmcr=0. + + any_qr = .false. + any_snow_graupel = .false. + qrmask_ = .false. ! needed if l_rain is false + + do k=kmax,1,-1 ! reverse order for upwind scheme at the end + do j=2,j1 + do i=2,i1 + rain_present = .false. + snow_present = .false. + graupel_present = .false. + + ! initialise qr + qr(i,j,k)= sv0(i,j,k,iqr) + ! initialise qc mask + if (ql0(i,j,k) > qcmin) then + qcmask_ = .true. + else + qcmask_ = .false. + end if + + ! initialise qr mask and check if we are not throwing away too much rain + if (l_rain) then + qrsum = qrsum+qr(i,j,k) + if (qr(i,j,k) <= qrmin) then + qrmask_ = .false. + if(qr(i,j,k)<0.) then + qrsmall = qrsmall-qr(i,j,k) + qr(i,j,k)=0. + end if + else + qrmask_=.true. ! this cell + any_qr = .true. ! whole system + endif + endif + + + ! logic + ! + ! qrmask: true if cell contains rain. qr > threshold + ! rsgratio, sgratio, lambda* calculated + ! + ! qcmask: true if cell contains cloud - condensed water - ql > threshold + ! ilratio, qll, qli calculated + ! + ! qr, qrp - rain, tendency + ! qtpmcr - qt tendency from microphysics + ! thlpmcr - thl tendency from microphysics + + + + !partitioning and determination of intercept parameter + + if(qrmask_.eqv..true.) then + if(l_warm) then !partitioning and determination of intercept parameter + rsgratio_=1. ! rain vs snow/graupel partitioning + rain_present = .true. + + sgratio_=0. ! snow versus graupel partitioning + lambdar_=(aar*n0rr*gamb1r/(rhof(k)*(qr(i,j,k))))**(1./(1.+bbr)) ! lambda rain + !lambdas_=lambdar_ ! lambda snow ! probably not right but they will not be used + !lambdag_=lambdar_ ! lambda graupel + elseif(l_graupel) then + rsgratio_=max(0.,min(1.,(tmp0(i,j,k)-tdnrsg)/(tuprsg-tdnrsg))) ! rain vs snow/graupel partitioning rsg = 1 if t > tuprsg + sgratio_=max(0.,min(1.,(tmp0(i,j,k)-tdnsg)/(tupsg-tdnsg))) ! snow versus graupel partitioning sg = 1 -> only graupel + if (rsgratio_ > 0) then ! sg = 0 -> only snow + rain_present = .true. + lambdar_=(aar*n0rr*gamb1r/(rhof(k)*(qr(i,j,k)*rsgratio_)))**(1./(1.+bbr)) ! lambda rain + endif + if (rsgratio_ < 1) then + any_snow_graupel = .true. ! whole system ! note: this may miss snow that appears during the precipitation substepping + if (sgratio_ > 0) then + graupel_present = .true. + lambdag_=(aag*n0rg*gamb1g/(rhof(k)*(qr(i,j,k)*(1.-rsgratio_)*sgratio_)))**(1./(1.+bbg)) ! graupel + endif + if (sgratio_ < 1) then + snow_present = .true. + lambdas_=(aas*n0rs*gamb1s/(rhof(k)*(qr(i,j,k)*(1.-rsgratio_)*(1.-sgratio_))))**(1./(1.+bbs)) ! snow + endif + endif + + ! no snow/graupel -> large lambda + else ! rain, snow but no graupel + rsgratio_=max(0.,min(1.,(tmp0(i,j,k)-tdnrsg)/(tuprsg-tdnrsg))) ! rain vs snow/graupel partitioning + sgratio_=0. + if (rsgratio_ > 0) then + rain_present = .true. + lambdar_=(aar*n0rr*gamb1r/(rhof(k)*(qr(i,j,k)*rsgratio_)))**(1./(1.+bbr)) ! lambda rain + endif + if (rsgratio_ < 1) then + snow_present = .true. + any_snow_graupel = .true. ! whole system + lambdas_=(aas*n0rs*gamb1s/(rhof(k)*(qr(i,j,k)*(1.-rsgratio_))))**(1./(1.+bbs)) ! lambda snow + endif + ! lambdag_=lambdas_ ! FJ: probably wrong - routines below don't always check sgratio + end if + endif + + + + ! Autoconvert + if (qcmask_.eqv..true.) then + if(l_warm) then + ilratio_=1. + else + ilratio_=max(0.,min(1.,(tmp0(i,j,k)-tdn)/(tup-tdn)))! cloud water vs cloud ice partitioning + endif + + ! ql partitioning - used here and in Accrete + qll=ql0(i,j,k)*ilratio_ + qli=ql0(i,j,k)-qll + + if(l_berry.eqv..true.) then ! Berry/Hsie autoconversion + ! ql partitioning + ! qll=ql0(i,j,k)*ilratio(i,j,k) + ! qli=ql0(i,j,k)-qll + + ddisp=0.146-5.964e-2*alog(Nc_0/2.e9) ! Relative dispersion coefficient for Berry autoconversion + lwc=1.e3*rhof(k)*qll ! Liquid water content in g/kg + autl=1./rhof(k)*1.67e-5*lwc*lwc/(5. + .0366*Nc_0/(1.e6*ddisp*(lwc+1.e-6))) + tc=tmp0(i,j,k)-tmelt ! Temperature wrt melting point + times=min(1.e3,(3.56*tc+106.7)*tc+1.e3) ! Time scale for ice autoconversion + auti=qli/times + aut = min(autl + auti,ql0(i,j,k)/delt) + qrp(i,j,k) = qrp(i,j,k)+aut + qtpmcr(i,j,k) = qtpmcr(i,j,k)-aut + thlpmcr(i,j,k) = thlpmcr(i,j,k)+(rlv/(cp*exnf(k)))*aut + else ! Lin/Kessler autoconversion as in Khairoutdinov and Randall, 2006 + + ! ql partitioning + ! qll=ql0(i,j,k)*ilratio(i,j,k) + ! qli=ql0(i,j,k)-qll + + autl=max(0.,timekessl*(qll-qll0)) + tc=tmp0(i,j,k)-tmelt + auti=max(0.,betakessi*exp(0.025*tc)*(qli-qli0)) + aut = min(autl + auti,ql0(i,j,k)/delt) + qrp(i,j,k) = qrp(i,j,k)+aut + qtpmcr(i,j,k) = qtpmcr(i,j,k)-aut + thlpmcr(i,j,k) = thlpmcr(i,j,k)+(rlv/(cp*exnf(k)))*aut + endif + + endif + + ! Accrete + + if (qrmask_.eqv..true.) then + if (qcmask_.eqv..true.) then ! apply mask + ! ql partitioning - calculated in Autoconvert + !qll=ql0(i,j,k)*ilratio(i,j,k) + !qli=ql0(i,j,k)-qll + + ! qr partitioning + qrr=qr(i,j,k)*rsgratio_ + qrs=qr(i,j,k)*(1.-rsgratio_)*(1.-sgratio_) + qrg=qr(i,j,k)*(1.-rsgratio_)*sgratio_ + ! collection of cloud water by rain etc. + + accr = 0 + accs = 0 + accg = 0 + if (rain_present) then + gaccrl=pi/4.*ccrz(k)*ceffrl*rhof(k)*qll*qrr*lambdar_**(bbr-2.-ddr)*gammaddr3/(aar*gamb1r) + gaccri=pi/4.*ccrz(k)*ceffri*rhof(k)*qli*qrr*lambdar_**(bbr-2.-ddr)*gammaddr3/(aar*gamb1r) + accr=(gaccrl+gaccri) !*qrr/(qrr+1.e-9) + endif + + if (snow_present) then + gaccsl=pi/4.*ccsz(k)*ceffsl*rhof(k)*qll*qrs*lambdas_**(bbs-2.-dds)*gammadds3/(aas*gamb1s) + gaccsi=pi/4.*ccsz(k)*ceffsi*rhof(k)*qli*qrs*lambdas_**(bbs-2.-dds)*gammadds3/(aas*gamb1s) + accs=(gaccsl+gaccsi) !*qrs/(qrs+1.e-9) ! why this division? makes accr small if qr* << 1e-9 + endif ! disable accretion if no snow present - now done with if. + + if (graupel_present) then + gaccgl=pi/4.*ccgz(k)*ceffgl*rhof(k)*qll*qrg*lambdag_**(bbg-2.-ddg)*gammaddg3/(aag*gamb1g) + gaccgi=pi/4.*ccgz(k)*ceffgi*rhof(k)*qli*qrg*lambdag_**(bbg-2.-ddg)*gammaddg3/(aag*gamb1g) + accg=(gaccgl+gaccgi) !*qrg/(qrg+1.e-9) + endif + + acc= min(accr+accs+accg,ql0(i,j,k)/delt) ! total growth by accretion + qrp(i,j,k) = qrp(i,j,k)+acc + qtpmcr(i,j,k) = qtpmcr(i,j,k)-acc + thlpmcr(i,j,k) = thlpmcr(i,j,k)+(rlv/(cp*exnf(k)))*acc + end if + end if + + ! evapdep + + if (qrmask_.eqv..true.) then + ! saturation ratios + ssl=(qt0(i,j,k)-ql0(i,j,k))/qvsl(i,j,k) + ssi=(qt0(i,j,k)-ql0(i,j,k))/qvsi(i,j,k) + !integration over ventilation factors and diameters, see e.g. seifert 2008 + evapdepr = 0 + evapdeps = 0 + evapdepg = 0 + thfun=1.e-7/(2.2*tmp0(i,j,k)/esl(i,j,k)+2.2e2/tmp0(i,j,k)) ! thermodynamic function + + + if (rain_present) then + !ventr=.78*n0rr/lambdar_**2 + gam2dr*.27*n0rr*sqrt(ccrz(k)/2.e-5)*lambdar_**(-2.5-0.5*ddr) + ventr=.78*n0rr/lambdar_**2 + ccrz2(k) * lambdar_**(-2.5-0.5*ddr) + evapdepr=(4.*pi/(betar*rhof(k)))*(ssl-1.)*ventr*thfun + endif + if (snow_present) then + !vents=.78*n0rs/lambdas_**2 + gam2ds*.27*n0rs*sqrt(ccsz(k)/2.e-5)*lambdas_**(-2.5-0.5*dds) + !vents=.78*n0rs/lambdas_**2 + ccsz2(k)*lambdas_**(-2.5-0.5*dds) + vents=.65*n0rs/lambdas_**2 + ccsz2(k)*lambdas_**(-2.5-0.5*dds) ! FJ corrected coefficient + evapdeps=(4.*pi/(betas*rhof(k)))*(ssi-1.)*vents*thfun + endif + if (graupel_present) then + !ventg=.78*n0rg/lambdag_**2 + gam2dg*.27*n0rg*sqrt(ccgz(k)/2.e-5)*lambdag_**(-2.5-0.5*ddg) + ventg=.78*n0rg/lambdag_**2 + ccgz2(k)*lambdag_**(-2.5-0.5*ddg) + evapdepg=(4.*pi/(betag*rhof(k)))*(ssi-1.)*ventg*thfun + endif + + ! total growth by deposition and evaporation + ! limit with qr and ql after accretion and autoconversion + devap= max(min(evapfactor*(evapdepr+evapdeps+evapdepg),ql0(i,j,k)/delt+qrp(i,j,k)),-qr(i,j,k)/delt-qrp(i,j,k)) + qrp(i,j,k) = qrp(i,j,k)+devap + qtpmcr(i,j,k) = qtpmcr(i,j,k)-devap + thlpmcr(i,j,k) = thlpmcr(i,j,k)+(rlv/(cp*exnf(k)))*devap + + ! Grabowski 1998 has different coefficients here for snow + ! also ccsz2 table needs to be updated + + end if + + + ! precipitate - part 1 + qr_spl(i,j,k) = qr(i,j,k) ! prepare for sub-timestepping precipitation + ! this is the first substep, using lambdas already calculated + if (qrmask_.eqv..true.) then + vtf = 0 + if (rain_present) then + vtr=ccrz(k)*(gambd1r/gamb1r)/(lambdar_**ddr) ! terminal velocity rain + vtf = vtf + rsgratio_*vtr + endif + if (snow_present) then + vts=ccsz(k)*(gambd1s/gamb1s)/(lambdas_**dds) ! terminal velocity snow + vtf = vtf + (1.-rsgratio_)*(1.-sgratio_)*vts + endif + if (graupel_present) then + vtg=ccgz(k)*(gambd1g/gamb1g)/(lambdag_**ddg) ! terminal velocity graupel + vtf = vtf + (1.-rsgratio_)*sgratio_*vtg + endif + ! vtf=rsgratio_*vtr+(1.-rsgratio_)*(1.-sgratio_)*vts+(1.-rsgratio_)*sgratio(i,j,k)*vtg ! weighted + vtf = min(wfallmax,vtf) + !write(*,*) 'vtf', vtf + + precep(i,j,k) = vtf*qr_spl(i,j,k) + sed_qr(i,j,k) = precep(i,j,k)*rhobf(k) ! convert to flux + else + precep(i,j,k) = 0. + sed_qr(i,j,k) = 0. + end if + + ! advect precipitation using upwind scheme + ! note this relies on loop order - k decreasing + + qr_spl(i,j,k) = qr_spl(i,j,k) + (sed_qr(i,j,k+1) - sed_qr(i,j,k))*dt_spl/(dzh(k+1)*rhobf(k)) + enddo + enddo + enddo + + + ! precipitate part 2 + +! write (*,*) 'any_qr:', any_qr +! write (*,*) 'any_snow_graupel:', any_snow_graupel +! write(*,*) 'n_spl', n_spl + + ! begin time splitting loop + IF (n_spl > 1 .and. any_qr) THEN + DO jn = 2 , n_spl + + ! reset fluxes at each step of loop + ! sed_qr = 0. ! not needed !? + + if (any_snow_graupel) then + do k=kmax,1,-1 + do j=2,j1 + do i=2,i1 + if (qr_spl(i,j,k) > qrmin) then + ! re-evaluate lambda and rsgratios + rsgratio_=max(0.,min(1.,(tmp0(i,j,k)-tdnrsg)/(tuprsg-tdnrsg))) ! rain vs snow/graupel partitioning rsg = 1 if t > tuprsg + sgratio_=max(0.,min(1.,(tmp0(i,j,k)-tdnsg) /(tupsg -tdnsg))) ! snow versus graupel partitioning sg = 1 -> only graupel + + !these ifs are here to avoid performing the power calculations unless they are going to be used + if (rsgratio_ > 0) then + tmp_lambdar=(aar*n0rr*gamb1r/(rhof(k)*(qr_spl(i,j,k)*rsgratio_)))**(1./(1.+bbr)) ! lambda rain + vtr=ccrz(k)*(gambd1r/gamb1r)/(tmp_lambdar**ddr) ! terminal velocity rain + else + vtr = 0 + end if + + if ( (1.-rsgratio_)*(1.-sgratio_) > 0 ) then + tmp_lambdas=(aas*n0rs*gamb1s/(rhof(k)*(qr_spl(i,j,k)*(1.-rsgratio_)*(1.-sgratio_))))**(1./(1.+bbs)) ! lambda snow + vts=ccsz(k)*(gambd1s/gamb1s)/(tmp_lambdas**dds) ! terminal velocity snow + else + vts = 0 + end if + + if ( (1.-rsgratio_)*sgratio_ > 0 ) then + tmp_lambdag=(aag*n0rg*gamb1g/(rhof(k)*(qr_spl(i,j,k)*(1.-rsgratio_)*sgratio_)))**(1./(1.+bbg)) ! lambda graupel + vtg=ccgz(k)*(gambd1g/gamb1g)/(tmp_lambdag**ddg) ! terminal velocity graupel + else + vtg = 0 + end if + + vtf=rsgratio_*vtr+(1.-rsgratio_)*(1.-sgratio_)*vts+(1.-rsgratio_)*sgratio_*vtg ! mass-weighted terminal velocity + vtf=min(wfallmax,vtf) + sed_qr(i,j,k) = vtf*qr_spl(i,j,k)*rhobf(k) + else + sed_qr(i,j,k) = 0. + endif + + ! update + ! note k must decrease in the loop + qr_spl(i,j,k) = qr_spl(i,j,k) + (sed_qr(i,j,k+1) - sed_qr(i,j,k))*dt_spl/(dzh(k+1)*rhobf(k)) + enddo + enddo + enddo + + else ! alternative loops when there is only rain + do k=kmax,1,-1 + do j=2,j1 + do i=2,i1 + if (qr_spl(i,j,k) > qrmin) then + !*rsgratio(i,j,k) removed from here, since it is 1 + tmp_lambdar=(aar*n0rr*gamb1r/(rhof(k)*(qr_spl(i,j,k))))**(1./(1.+bbr)) ! lambda rain + vtf=ccrz(k)*(gambd1r/gamb1r)/(tmp_lambdar**ddr) ! terminal velocity rain + + vtf=min(wfallmax,vtf) + sed_qr(i,j,k) = vtf*qr_spl(i,j,k)*rhobf(k) + else + sed_qr(i,j,k) = 0. + endif + + ! update + ! note k must decrease in the loop + qr_spl(i,j,k) = qr_spl(i,j,k) + (sed_qr(i,j,k+1) - sed_qr(i,j,k))*dt_spl/(dzh(k+1)*rhobf(k)) + enddo + enddo + enddo + endif + + ! end time splitting loop and if n>1 + ENDDO + ENDIF + + ! no thl and qt tendencies build in, implying no heat transfer between precipitation and air + + + if (qrsmall > 0.000001*qrsum) then + write(*,*)'amount of neg. qr thrown away is too high ',timee, ' sec', qrsmall, qrsum + end if + + do k=1,kmax !was k1 + do j=2,j1 + do i=2,i1 + qrp(i,j,k)= qrp(i,j,k) + (qr_spl(i,j,k) - qr(i,j,k))/delt + qrtest=svm(i,j,k,iqr)+(svp(i,j,k,iqr)+qrp(i,j,k))*delt + if (qrtest .lt. qrmin) then ! correction, after Jerome's implementation in Gales + qtp(i,j,k) = qtp(i,j,k) + qtpmcr(i,j,k) + svm(i,j,k,iqr)/delt + svp(i,j,k,iqr) + qrp(i,j,k) + thlp(i,j,k) = thlp(i,j,k) +thlpmcr(i,j,k) - (rlv/(cp*exnf(k)))*(svm(i,j,k,iqr)/delt + svp(i,j,k,iqr) + qrp(i,j,k)) + svp(i,j,k,iqr) = - svm(i,j,k,iqr)/delt + else + svp(i,j,k,iqr)=svp(i,j,k,iqr)+qrp(i,j,k) + thlp(i,j,k)=thlp(i,j,k)+thlpmcr(i,j,k) + qtp(i,j,k)=qtp(i,j,k)+qtpmcr(i,j,k) + ! adjust negative qr tendencies at the end of the time-step + end if + enddo + enddo + enddo + +! if (l_rain) then +! call simpleicetend !after corrections +! endif + end subroutine simpleice2 + + +end module modsimpleice2 diff --git a/src/modstartup.f90 b/src/modstartup.f90 index b7416459..496ae120 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -256,8 +256,8 @@ subroutine startup call initsurface call initsubgrid call initpois - call initmicrophysics call readinitfiles ! moved to obtain the correct btime for the timedependent forcings in case of a warmstart + call initmicrophysics call inittimedep !depends on modglobal,modfields, modmpi, modsurf, modradiation call checkinitvalues From e9257ef0c8faaa46fc025e7d89eb3faede4daf03 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Mon, 29 Jan 2018 14:23:01 +0100 Subject: [PATCH 46/88] adaptive time step: limit dt by ekh, not only ekm - ekh may be larger. --- src/tstep.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/tstep.f90 b/src/tstep.f90 index 9d4c4a15..8de66cf0 100644 --- a/src/tstep.f90 +++ b/src/tstep.f90 @@ -46,7 +46,7 @@ subroutine tstep_update use modglobal, only : i1,j1,rk3step,timee,rtimee,dtmax,dt,ntrun,courant,peclet,& kmax,dx,dy,dzh,dt_lim,ladaptive,timeleft,idtmax,rdt,tres,longint ,lwarmstart use modfields, only : um,vm,wm - use modsubgrid,only : ekm + use modsubgrid,only : ekm,ekh use modmpi, only : comm3d,mpierr,mpi_max,my_real implicit none @@ -79,7 +79,9 @@ subroutine tstep_update enddo courtotmax=sqrt(courtotmax) do k=1,kmax - peclettotl=max(peclettotl,maxval(ekm(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) + ! limit by the larger of ekh, ekm. ekh is generally larger. + peclettotl=max(peclettotl,maxval(ekm(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) + peclettotl=max(peclettotl,maxval(ekh(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) end do call MPI_ALLREDUCE(peclettotl,peclettot,1,MY_REAL,MPI_MAX,comm3d,mpierr) if ( pecletold>0) then @@ -116,7 +118,9 @@ subroutine tstep_update courtotmax=max(courtotmax,sqrt(courtot(k))) enddo do k=1,kmax - peclettotl=max(peclettotl,maxval(ekm(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) + ! limit by the larger of ekh, ekm. ekh is generally larger. + peclettotl=max(peclettotl,maxval(ekm(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) + peclettotl=max(peclettotl,maxval(ekh(2:i1,2:j1,k))*rdt/minval((/dzh(k),dx,dy/))**2) end do call MPI_ALLREDUCE(peclettotl,peclettot,1,MY_REAL,MPI_MAX,comm3d,mpierr) dt = min(timee,dt_lim,idtmax,floor(rdt/tres*courant/courtotmax,longint),floor(rdt/tres*peclet/peclettot,longint)) From 4098295e5539b319ad5ccf6d8f73fe2a93960dd3 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 26 Jan 2018 11:44:30 +0100 Subject: [PATCH 47/88] Surface scheme: define phim and phih as functions. Add cap on phi for zeta > 1 to prevent crashes in stable conditions --- src/modsurface.f90 | 91 ++++++++++++++++++++++++++-------------------- 1 file changed, 51 insertions(+), 40 deletions(-) diff --git a/src/modsurface.f90 b/src/modsurface.f90 index c9eb5937..60076fec 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -835,19 +835,9 @@ subroutine surface if(lCO2Ags) svflux(i,j,indCO2) = CO2flux(i,j) - if (obl(i,j) < 0.) then - phimzf = (1.-16.*zf(1)/obl(i,j))**(-0.25) - !phimzf = (1. + 3.6 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - phihzf = (1.-16.*zf(1)/obl(i,j))**(-0.50) - !phihzf = (1. + 7.9 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - elseif (obl(i,j) > 0.) then - phimzf = (1.+5.*zf(1)/obl(i,j)) - phihzf = (1.+5.*zf(1)/obl(i,j)) - else - phimzf = 1. - phihzf = 1. - endif - + phimzf = phim(zf(1)/obl(i,j)) + phihzf = phih(zf(1)/obl(i,j)) + dudz (i,j) = ustar(i,j) * phimzf / (fkar*zf(1))*(upcu/horv) dvdz (i,j) = ustar(i,j) * phimzf / (fkar*zf(1))*(vpcv/horv) dthldz(i,j) = - thlflux(i,j) / ustar(i,j) * phihzf / (fkar*zf(1)) @@ -878,19 +868,9 @@ subroutine surface svflux(i,j,n) = wsvsurf(n) enddo - if (obl(i,j) < 0.) then - phimzf = (1.-16.*zf(1)/obl(i,j))**(-0.25) - !phimzf = (1. + 3.6 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - phihzf = (1.-16.*zf(1)/obl(i,j))**(-0.50) - !phihzf = (1. + 7.9 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - elseif (obl(i,j) > 0.) then - phimzf = (1.+5.*zf(1)/obl(i,j)) - phihzf = (1.+5.*zf(1)/obl(i,j)) - else - phimzf = 1. - phihzf = 1. - endif - + phimzf = phim(zf(1)/obl(i,j)) + phihzf = phih(zf(1)/obl(i,j)) + upcu = 0.5 * (u0(i,j,1) + u0(i+1,j,1)) + cu vpcv = 0.5 * (v0(i,j,1) + v0(i,j+1,1)) + cv horv = sqrt(upcu ** 2. + vpcv ** 2.) @@ -973,20 +953,10 @@ subroutine surface svflux(i,j,n) = wsvsurf(n) enddo endif - - if (obl(i,j) < 0.) then - phimzf = (1.-16.*zf(1)/obl(i,j))**(-0.25) - !phimzf = (1. + 3.6 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - phihzf = (1.-16.*zf(1)/obl(i,j))**(-0.50) - !phihzf = (1. + 7.9 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) - elseif (obl(i,j) > 0.) then - phimzf = (1.+5.*zf(1)/obl(i,j)) - phihzf = (1.+5.*zf(1)/obl(i,j)) - else - phimzf = 1. - phihzf = 1. - endif - + + phimzf = phim(zf(1)/obl(i,j)) + phihzf = phih(zf(1)/obl(i,j)) + dudz (i,j) = ustar(i,j) * phimzf / (fkar*zf(1))*(upcu/horv) dvdz (i,j) = ustar(i,j) * phimzf / (fkar*zf(1))*(vpcv/horv) dthldz(i,j) = - thlflux(i,j) / ustar(i,j) * phihzf / (fkar*zf(1)) @@ -1373,6 +1343,47 @@ function psih(zeta) return end function psih + ! stability function Phi for momentum. + ! Many functional forms of Phi have been suggested, see e.g. Optis 2015 + ! Phi and Psi above are related by an integral and should in principle match, + ! currently they do not. + ! FJ 2018: For very stable situations, zeta > 1 add cap to phi - the linear expression is valid only for zeta < 1 + function phim(zeta) + implicit none + real :: phim + real, intent(in) :: zeta + + if (zeta < 0.) then ! unstable + phim = (1.-16.*zeta)**(-0.25) + !phimzf = (1. + 3.6 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) + elseif ( zeta < 1.) then ! 0 < zeta < 1, stable + phim = (1.+5.*zeta) + else + phim = 6 ! cap phi when z/L > 1 + endif + + return + end function phim + + ! stability function Phi for heat. + function phih(zeta) + implicit none + real :: phih + real, intent(in) :: zeta + + if (zeta < 0.) then ! unstable + phih = (1.-16.*zeta)**(-0.50) + !phihzf = (1. + 7.9 * (-zf(1)/obl(i,j))**(2./3.))**(-0.5) + elseif ( zeta < 1.) then ! 0 < zf(1) / obl < 1, stable + phih = (1.+5.*zeta) + else + phih = 6 ! cap phi when z/L > 1 + endif + + return + end function phih + + function E1(x) implicit none real :: E1 From 5ff12409968e32f7d862af904d9e2f30faeb4127 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Mon, 29 Jan 2018 15:08:35 +0100 Subject: [PATCH 48/88] test cases arm_brown, arm_unstable, bomex : correcting namelist entry SUBGRID to NAMSUBGRID --- cases/arm_brown/namoptions.001 | 8 +------- cases/arm_unstable/namoptions.001 | 8 +------- cases/bomex/namoptions.001 | 8 +------- 3 files changed, 3 insertions(+), 21 deletions(-) diff --git a/cases/arm_brown/namoptions.001 b/cases/arm_brown/namoptions.001 index 4fc30cec..d16ba4fb 100644 --- a/cases/arm_brown/namoptions.001 +++ b/cases/arm_brown/namoptions.001 @@ -54,14 +54,8 @@ iadv_thl = 2 iadv_qt = 2 iadv_sv = 2 / -&SUBGRID +&NAMSUBGRID ldelta = .false. -cm = 0.12 -cn = 0.76 -ch1 = 1. -ch2 = 2. -ce1 = 0.19 -ce2 = 0.51 / &NAMBUDGET lbudget = .true. diff --git a/cases/arm_unstable/namoptions.001 b/cases/arm_unstable/namoptions.001 index 4fc30cec..d16ba4fb 100644 --- a/cases/arm_unstable/namoptions.001 +++ b/cases/arm_unstable/namoptions.001 @@ -54,14 +54,8 @@ iadv_thl = 2 iadv_qt = 2 iadv_sv = 2 / -&SUBGRID +&NAMSUBGRID ldelta = .false. -cm = 0.12 -cn = 0.76 -ch1 = 1. -ch2 = 2. -ce1 = 0.19 -ce2 = 0.51 / &NAMBUDGET lbudget = .true. diff --git a/cases/bomex/namoptions.001 b/cases/bomex/namoptions.001 index f461e80e..7f78adbd 100644 --- a/cases/bomex/namoptions.001 +++ b/cases/bomex/namoptions.001 @@ -53,14 +53,8 @@ iadv_thl = 2 iadv_qt = 2 iadv_sv = 2 / -&SUBGRID +&NAMSUBGRID ldelta = .false. -cm = 0.12 -cn = 0.76 -ch1 = 1. -ch2 = 2. -ce1 = 0.19 -ce2 = 0.51 / &NAMBUDGET lbudget = .true. From 9cf1cd653604373cc1cd6a26d553ff60a6b6bcd6 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 31 Jan 2018 14:05:17 +0100 Subject: [PATCH 49/88] add tke field to the netCDF cross sections --- src/modcrosssection.f90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/modcrosssection.f90 b/src/modcrosssection.f90 index a81f4c79..b7f944f3 100644 --- a/src/modcrosssection.f90 +++ b/src/modcrosssection.f90 @@ -36,7 +36,7 @@ module modcrosssection PUBLIC :: initcrosssection, crosssection,exitcrosssection save !NetCDF variables - integer,parameter :: nvar = 11 + integer,parameter :: nvar = 12 integer :: ncid1 = 0 integer,allocatable :: ncid2(:) integer :: ncid3 = 1 @@ -140,6 +140,7 @@ subroutine initcrosssection call ncinfo(ncname1( 9,:),'qrxz','xz crosssection of the Rain water specific humidity','kg/kg','t0tt') call ncinfo(ncname1( 10,:),'nrxz','xz crosssection of the Number concentration','-','t0tt') call ncinfo(ncname1( 11,:),'cloudnrxz','xz crosssection of the cloud number','-','t0tt') + call ncinfo(ncname1( 12,:),'e120xz','xz crosssection of sqrt(turbulent kinetic energy)','m^2/s^2','t0tt') call open_nc(fname1, ncid1,nrec1,n1=imax,n3=kmax) if (nrec1 == 0) then call define_nc( ncid1, 1, tncname1) @@ -164,6 +165,7 @@ subroutine initcrosssection call ncinfo(ncname2( 9,:),'qrxy','xy crosssection of the Rain water specific humidity','kg/kg','tt0t') call ncinfo(ncname2(10,:),'nrxy','xy crosssection of the rain droplet number concentration','-','tt0t') call ncinfo(ncname2(11,:),'cloudnrxy','xy crosssection of the cloud number','-','tt0t') + call ncinfo(ncname2(12,:),'e120xy','xy crosssection of sqrt(turbulent kinetic energy)','m^2/s^2','tt0t') call open_nc(fname2, ncid2(cross),nrec2(cross),n1=imax,n2=jmax) if (nrec2(cross)==0) then call define_nc( ncid2(cross), 1, tncname2) @@ -185,6 +187,7 @@ subroutine initcrosssection call ncinfo(ncname3( 9,:),'qryz','yz crosssection of the Rain water specific humidity','kg/kg','0ttt') call ncinfo(ncname3(10,:),'nryz','yz crosssection of the Number concentration','-','0ttt') call ncinfo(ncname3(11,:),'cloudnryz','yz crosssection of the cloud number','-','0ttt') + call ncinfo(ncname3(12,:),'e120yz','yz crosssection of sqrt(turbulent kinetic energy)','m^2/s^2','0ttt') call open_nc(fname3, ncid3,nrec3,n2=jmax,n3=kmax) if (nrec3==0) then call define_nc( ncid3, 1, tncname3) @@ -221,7 +224,7 @@ end subroutine crosssection !> Do the xz crosssections and dump them to file subroutine wrtvert use modglobal, only : imax,i1,kmax,nsv,rlv,cp,rv,rd,cu,cv,cexpnr,ifoutput,rtimee - use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,exnf,thvf,cloudnr + use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,e120,exnf,thvf,cloudnr use modmpi, only : myid use modstat_nc, only : lnetcdf, writestat_nc implicit none @@ -304,6 +307,7 @@ subroutine wrtvert vars(:,:,10) = 0. end if vars(:,:,11) = cloudnr(2:i1,crossplane,1:kmax) + vars(:,:,12) = e120(2:i1,crossplane,1:kmax) call writestat_nc(ncid1,1,tncname1,(/rtimee/),nrec1,.true.) call writestat_nc(ncid1,nvar,ncname1(1:nvar,:),vars,nrec1,imax,kmax) deallocate(vars) @@ -315,7 +319,7 @@ end subroutine wrtvert !> Do the xy crosssections and dump them to file subroutine wrthorz use modglobal, only : imax,jmax,i1,j1,nsv,rlv,cp,rv,rd,cu,cv,cexpnr,ifoutput,rtimee - use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,exnf,thvf,cloudnr + use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,e120,exnf,thvf,cloudnr use modmpi, only : cmyid use modstat_nc, only : lnetcdf, writestat_nc use modmicrodata, only : iqr,inr @@ -408,6 +412,7 @@ subroutine wrthorz vars(:,:,10) = 0. end if vars(:,:,11) = cloudnr(2:i1,2:j1,crossheight(cross)) + vars(:,:,12) = e120(2:i1,2:j1,crossheight(cross)) call writestat_nc(ncid2(cross),1,tncname2,(/rtimee/),nrec2(cross),.true.) call writestat_nc(ncid2(cross),nvar,ncname2(1:nvar,:),vars,nrec2(cross),imax,jmax) deallocate(vars) @@ -420,7 +425,7 @@ end subroutine wrthorz subroutine wrtorth use modglobal, only : jmax,kmax,j1,nsv,rlv,cp,rv,rd,cu,cv,cexpnr,ifoutput,rtimee - use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,exnf,thvf,cloudnr + use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,e120,exnf,thvf,cloudnr use modmpi, only : cmyid use modstat_nc, only : lnetcdf, writestat_nc implicit none @@ -506,6 +511,7 @@ subroutine wrtorth vars(:,:,10) = 0. end if vars(:,:,11) = cloudnr(crossortho,2:j1,1:kmax) + vars(:,:,12) = e120(crossortho,2:j1,1:kmax) call writestat_nc(ncid3,1,tncname3,(/rtimee/),nrec3,.true.) call writestat_nc(ncid3,nvar,ncname3(1:nvar,:),vars,nrec3,jmax,kmax) deallocate(vars) From 0b93f851efb5ea42f059adbe96f130bd4f2e7f50 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 31 Jan 2018 14:15:41 +0100 Subject: [PATCH 50/88] Store vertical netCDF cross sections only in the first tile in x and y --- src/modcrosssection.f90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/modcrosssection.f90 b/src/modcrosssection.f90 index b7f944f3..ff34ec3b 100644 --- a/src/modcrosssection.f90 +++ b/src/modcrosssection.f90 @@ -67,7 +67,7 @@ module modcrosssection contains !> Initializing Crosssection. Read out the namelist, initializing the variables subroutine initcrosssection - use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer,cmyid + use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,mpi_integer,cmyid,myidx,myidy use modglobal,only :imax,jmax,ifnamopt,fname_options,dtmax,dtav_glob,ladaptive,j1,kmax,i1,dt_lim,cexpnr,tres,btime use modstat_nc,only : lnetcdf,open_nc, define_nc,ncinfo,writestat_dims_nc implicit none @@ -125,7 +125,7 @@ subroutine initcrosssection stop 'CROSSSECTION: dtav should be a integer multiple of dtmax' end if if (lnetcdf) then - if (myid==0) then + if (myidy==0) then fname1(9:16) = cmyid fname1(18:20) = cexpnr call ncinfo(tncname1(1,:),'time','Time','s','time') @@ -172,7 +172,8 @@ subroutine initcrosssection call writestat_dims_nc(ncid2(cross)) end if call define_nc( ncid2(cross), NVar, ncname2) - end do + end do + if (myidx==0) then fname3(9:16) = cmyid fname3(18:20) = cexpnr call ncinfo(tncname3(1,:),'time','Time','s','time') @@ -195,6 +196,7 @@ subroutine initcrosssection end if call define_nc( ncid3, NVar, ncname3) end if + end if end subroutine initcrosssection @@ -225,7 +227,7 @@ end subroutine crosssection subroutine wrtvert use modglobal, only : imax,i1,kmax,nsv,rlv,cp,rv,rd,cu,cv,cexpnr,ifoutput,rtimee use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,e120,exnf,thvf,cloudnr - use modmpi, only : myid + use modmpi, only : myidy use modstat_nc, only : lnetcdf, writestat_nc implicit none @@ -234,7 +236,7 @@ subroutine wrtvert real, allocatable :: thv0(:,:),vars(:,:,:),buoy(:,:) - if( myid /= 0 ) return + if( myidy /= 0 ) return allocate(thv0(2:i1,1:kmax),buoy(2:i1,1:kmax)) @@ -423,10 +425,11 @@ subroutine wrthorz end subroutine wrthorz + ! yz cross section subroutine wrtorth use modglobal, only : jmax,kmax,j1,nsv,rlv,cp,rv,rd,cu,cv,cexpnr,ifoutput,rtimee use modfields, only : um,vm,wm,thlm,qtm,svm,thl0,qt0,ql0,e120,exnf,thvf,cloudnr - use modmpi, only : cmyid + use modmpi, only : cmyid, myidx use modstat_nc, only : lnetcdf, writestat_nc implicit none @@ -437,6 +440,9 @@ subroutine wrtorth real, allocatable :: thv0(:,:),vars(:,:,:),buoy(:,:) + if( myidx /= 0 ) return + + allocate(thv0(1:j1,1:kmax),buoy(1:j1,1:kmax)) do j=1,j1 From 163731048499b92d522a106c5333bfe80ded2286 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 31 Jan 2018 14:43:25 +0100 Subject: [PATCH 51/88] expose more subgrid scheme parameters in namelist: ch1,ch2,cm,ce1,ce2. Add forgotten MPI_BCAST of courantp --- src/modmicrophysics.f90 | 1 + src/modsubgrid.f90 | 7 +++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/modmicrophysics.f90 b/src/modmicrophysics.f90 index d908c0fe..e89339dc 100644 --- a/src/modmicrophysics.f90 +++ b/src/modmicrophysics.f90 @@ -73,6 +73,7 @@ subroutine initmicrophysics call MPI_BCAST(Nc_0, 1, MY_REAL ,0,comm3d,ierr) call MPI_BCAST(sig_g, 1, MY_REAL ,0,comm3d,ierr) call MPI_BCAST(sig_gr, 1, MY_REAL ,0,comm3d,ierr) + call MPI_BCAST(courantp, 1, MY_REAL ,0,comm3d,ierr) select case (imicro) case(imicro_none) diff --git a/src/modsubgrid.f90 b/src/modsubgrid.f90 index 25eaeb88..63c0b4b9 100644 --- a/src/modsubgrid.f90 +++ b/src/modsubgrid.f90 @@ -106,7 +106,7 @@ subroutine subgridnamelist integer :: ierr namelist/NAMSUBGRID/ & - ldelta,lmason, cf,cn,Rigc,Prandtl,lsmagorinsky,cs,nmason,sgs_surface_fix + ldelta,lmason, cf,cn,Rigc,Prandtl,lsmagorinsky,cs,nmason,sgs_surface_fix,ch1,ch2,cm,ce1,ce2 if(myid==0)then open(ifnamopt,file=fname_options,status='old',iostat=ierr) @@ -130,7 +130,10 @@ subroutine subgridnamelist call MPI_BCAST(Rigc ,1,MY_REAL ,0,comm3d,mpierr) call MPI_BCAST(Prandtl ,1,MY_REAL ,0,comm3d,mpierr) call MPI_BCAST(sgs_surface_fix ,1,MPI_LOGICAL ,0,comm3d,mpierr) - + call MPI_BCAST(ch1 ,1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(ch2 ,1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(ce1 ,1,MY_REAL ,0,comm3d,mpierr) + call MPI_BCAST(ce2 ,1,MY_REAL ,0,comm3d,mpierr) end subroutine subgridnamelist From 5608af964a03a4df47df3d442ad287be90766c30 Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 13:19:51 +0100 Subject: [PATCH 52/88] 2leaf AGS implemented, as well as option to use it while lrelaxgc is active --- src/modAGScross.f90 | 61 ++++++++++++++++----- src/modsurface.f90 | 125 ++++++++++++++++++++++++++++++++++++++++---- src/modsurfdata.f90 | 15 ++++++ src/modtimestat.f90 | 13 +++-- 4 files changed, 186 insertions(+), 28 deletions(-) diff --git a/src/modAGScross.f90 b/src/modAGScross.f90 index 251d9850..35a63abc 100644 --- a/src/modAGScross.f90 +++ b/src/modAGScross.f90 @@ -36,11 +36,12 @@ module modAGScross PUBLIC :: initAGScross, AGScross,exitAGScross save !NetCDF variables - integer,parameter :: nvar = 31 + integer,parameter :: nvar = 35 !gc_CO2,PAR,Qnet,LE,H,G0 added, and swdir swdif conditionally integer :: ncidAGS = 123 integer :: nrecAGS = 0 + integer :: final_nvar = 0 character(80) :: fnameAGS = 'crossAGS.xxxxyxxx.xxx.nc' - character(80),dimension(nvar,4) :: ncnameAGS + character(80),allocatable,dimension(:,:) :: ncnameAGS !dimensions depend on number of variables character(80),dimension(1,4) :: tncnameAGS real :: dtav @@ -53,7 +54,9 @@ subroutine initAGScross use modmpi, only :myid,my_real,mpierr,comm3d,mpi_logical,cmyid use modglobal,only :imax,jmax,ifnamopt,fname_options,dtmax, dtav_glob,ladaptive,dt_lim,cexpnr,tres,btime use modstat_nc,only : open_nc, define_nc,ncinfo,writestat_dims_nc - use modsurfdata, only : lrsAgs, ksoilmax + use modsurfdata, only : lrsAgs, ksoilmax,lsplitleaf + use modraddata,only : irad_par,irad_rrtmg,iradiation + implicit none integer :: ierr @@ -89,6 +92,13 @@ subroutine initAGScross if (ksoilmax /= 4) stop 'ksoilmax is not equal to 4... this can give problems with AGScross.f90... update this file as well' fnameAGS(10:17) = cmyid fnameAGS(19:21) = cexpnr + + ! we set the final number of variables in the output: + final_nvar = nvar + if (iradiation == irad_par .or. iradiation == irad_rrtmg) final_nvar = final_nvar+2!swdir,swdif + if (lsplitleaf) final_nvar = final_nvar+2 !PARdir,PARdif + allocate(ncnameAGS(final_nvar,4)) + call ncinfo(tncnameAGS(1,:),'time ','Time','s','time') call ncinfo(ncnameAGS( 1,:),'An ', 'xy AGScross of An ','mg/m2/s','tt0t') call ncinfo(ncnameAGS( 2,:),'Resp ', 'xy AGScross of Resp ','mg/m2/s','tt0t') @@ -119,14 +129,27 @@ subroutine initAGScross call ncinfo(ncnameAGS(27,:),'lwd ', 'xy AGScross of LW down rad.','W/m2 ','tt0t') call ncinfo(ncnameAGS(28,:),'lwu ', 'xy AGScross of LW up rad. ','W/m2 ','tt0t') call ncinfo(ncnameAGS(29,:),'ci ', 'xy AGScross of int CO2 conc','mg/m3 ','tt0t') - call ncinfo(ncnameAGS(30,:),'swdir ', 'xy AGScross of SW dir rad. ','W/m2 ','tt0t') - call ncinfo(ncnameAGS(31,:),'swdif ', 'xy AGScross of SW diff rad.','W/m2 ','tt0t') + call ncinfo(ncnameAGS(30,:),'gc_CO2', 'xy AGScross of gc_CO2 ','mm/s? ','tt0t') + call ncinfo(ncnameAGS(31,:),'PAR ', 'xy AGScross of PAR ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(32,:),'Qnet ', 'xy AGScross of Qnet ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(33,:),'LE ', 'xy AGScross of LE ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(34,:),'H ', 'xy AGScross of H ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(35,:),'G0 ', 'xy AGScross of G0 ','W/m2 ','tt0t') + if (iradiation == irad_par .or. iradiation == irad_rrtmg) then + call ncinfo(ncnameAGS(36,:),'swdir ', 'xy AGScross of SW dir rad. ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(37,:),'swdif ', 'xy AGScross of SW diff rad.','W/m2 ','tt0t') + endif + if (lsplitleaf) then + call ncinfo(ncnameAGS(38,:),'PARdir', 'xy AGScross of direct PAR ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(39,:),'PARdif', 'xy AGScross of diffuse PAR ','W/m2 ','tt0t') + endif + call open_nc(fnameAGS, ncidAGS,nrecAGS,n1=imax,n2=jmax) if (nrecAGS == 0) then call define_nc( ncidAGS, 1, tncnameAGS) call writestat_dims_nc(ncidAGS) end if - call define_nc( ncidAGS, NVar, ncnameAGS) + call define_nc( ncidAGS, final_nvar, ncnameAGS) end subroutine initAGScross !>Run AGScross. Mainly timekeeping @@ -155,9 +178,10 @@ subroutine AGShorz use modglobal, only : imax,jmax,i1,j1,rtimee,dzf use modstat_nc, only : writestat_nc use modsurfdata, only : AnField, RespField, wco2Field,phiw,fstrField, rs, ra, rsco2Field, rsveg, rssoil, & - indCO2, tskin, tskinm, tsoil, thlflux, qtflux, tauField, ciField + indCO2, tskin, tskinm, tsoil, thlflux, qtflux, tauField, ciField, gcco2Field, & + PARField,Qnet,LE,H,G0,PARdirField,PARdifField,lsplitleaf use modfields, only : svm, rhof, ql0 - use modraddata,only : swd, swu, lwd, lwu,swdir,swdif + use modraddata,only : swd, swu, lwd, lwu,swdir,swdif,irad_par,iradiation,irad_rrtmg implicit none @@ -172,7 +196,7 @@ subroutine AGShorz enddo enddo - allocate(vars(1:imax,1:jmax,nvar)) + allocate(vars(1:imax,1:jmax,final_nvar)) vars=0. vars(:,:, 1) = AnField (2:i1,2:j1) vars(:,:, 2) = RespField (2:i1,2:j1) @@ -203,10 +227,22 @@ subroutine AGShorz vars(:,:,27) = lwd (2:i1,2:j1,1) vars(:,:,28) = lwu (2:i1,2:j1,1) vars(:,:,29) = ciField (2:i1,2:j1) - vars(:,:,30) = swdir (2:i1,2:j1,1) - vars(:,:,31) = swdif (2:i1,2:j1,1) + vars(:,:,30) = gcco2Field(2:i1,2:j1) + vars(:,:,31) = PARField (2:i1,2:j1) + vars(:,:,32) = Qnet (2:i1,2:j1) + vars(:,:,33) = LE (2:i1,2:j1) + vars(:,:,34) = H (2:i1,2:j1) + vars(:,:,35) = G0 (2:i1,2:j1) + if (iradiation == irad_par .or. iradiation == irad_rrtmg) then + vars(:,:,36) = swdir (2:i1,2:j1,1) + vars(:,:,37) = swdif (2:i1,2:j1,1) + endif + if (lsplitleaf) then + vars(:,:,38) = PARdirField(2:i1,2:j1) + vars(:,:,39) = PARdifField(2:i1,2:j1) + endif call writestat_nc(ncidAGS,1,tncnameAGS,(/rtimee/),nrecAGS,.true.) - call writestat_nc(ncidAGS,nvar,ncnameAGS(1:nvar,:),vars,nrecAGS,imax,jmax) + call writestat_nc(ncidAGS,final_nvar,ncnameAGS,vars,nrecAGS,imax,jmax) deallocate(vars) end subroutine AGShorz @@ -219,6 +255,7 @@ subroutine exitAGScross if(lAGScross) then call exitstat_nc(ncidAGS) + deallocate(ncnameAGS) end if end subroutine exitAGScross diff --git a/src/modsurface.f90 b/src/modsurface.f90 index 60076fec..4b281cb2 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -72,7 +72,7 @@ module modsurface subroutine initsurface use modglobal, only : i1, j1, i2, j2, itot, jtot, nsv, ifnamopt, fname_options, ifinput, cexpnr - use modraddata, only : iradiation,rad_shortw + use modraddata, only : iradiation,rad_shortw,,irad_par,irad_user,irad_rrtmg use modmpi, only : myid, comm3d, mpierr, my_real, mpi_logical, mpi_integer implicit none @@ -95,7 +95,9 @@ subroutine initsurface ! Delay plant response in Ags lrelaxgc, kgc, lrelaxci, kci, & ! Soil properties - phi, phifc, phiwp, R10 + phi, phifc, phiwp, R10, & + !2leaf AGS, sunlit/shaded + lsplitleaf ! 1 - Initialize soil @@ -163,7 +165,8 @@ subroutine initsurface call MPI_BCAST(phifc , 1, MY_REAL , 0, comm3d, mpierr) call MPI_BCAST(phiwp , 1, MY_REAL , 0, comm3d, mpierr) call MPI_BCAST(R10 , 1, MY_REAL , 0, comm3d, mpierr) - + call MPI_BCAST(lsplitleaf , 1, MPI_LOGICAL, 0, comm3d, mpierr) + call MPI_BCAST(land_use(1:mpatch,1:mpatch),mpatch*mpatch, MPI_INTEGER, 0, comm3d, mpierr) if(lCO2Ags .and. (.not. lrsAgs)) then @@ -171,6 +174,11 @@ subroutine initsurface if(myid==0) print *,"WARNING::: Since AGS does not run, lCO2Ags will be set to .false. as well." lCO2Ags = .false. endif + if(lsplitleaf .and. (.not. (rad_shortw .and. ((iradiation.eq.irad_par).or.(iradiation .eq. irad_user) .or. (iradiation .eq. irad_rrtmg))))) then + if(myid==0) stop "WARNING::: You set lsplitleaf to .true., but that needs direct and diffuse calculations. Make sure you enable rad_shortw" + if(myid==0) stop "WARNING::: Since there is no direct and diffuse radiation calculated in the atmopshere, we set lsplitleaf to .false." + lsplitleaf = .false. + endif if(lrsAgs) then if(planttype==4) then !C4 plants, so standard settings for C3 plants are replaced @@ -663,6 +671,7 @@ subroutine initsurface if (lrsAgs) then allocate(AnField (2:i1,2:j1)) + allocate(gcco2Field(2:i1,2:j1)) allocate(RespField (2:i1,2:j1)) allocate(wco2Field (2:i1,2:j1)) allocate(rsco2Field(2:i1,2:j1)) @@ -671,6 +680,11 @@ subroutine initsurface allocate(ci_old (2:i1,2:j1)) allocate(tauField (2:i1,2:j1)) allocate(ciField (2:i1,2:j1)) + allocate(PARField (2:i1,2:j1)) + if (lsplitleaf) then + allocate(PARdirField (2:i1,2:j1)) + allocate(PARdifField (2:i1,2:j1)) + endif endif return end subroutine initsurface @@ -1612,13 +1626,13 @@ end subroutine initlsm !> Calculates surface resistance, temperature and moisture using the Land Surface Model subroutine do_lsm - use modglobal, only : pref0,boltz,cp,rd,rhow,rlv,i1,j1,rdt,ijtot,rk3step,nsv + use modglobal, only : pref0,boltz,cp,rd,rhow,rlv,i1,j1,rdt,ijtot,rk3step,nsv,,xtime,rtimee,xday,xlat,xlon use modfields, only : ql0,qt0,thl0,rhof,presf,svm - use modraddata,only : iradiation,useMcICA,swd,swu,lwd,lwu + use modraddata,only : iradiation,useMcICA,swd,swu,lwd,lwu,irad_par,swdir,swdif,zenith use modmpi, only :comm3d,my_real,mpi_sum,mpierr,mpi_integer,myid real :: f1, f2, f3, f4 ! Correction functions for Jarvis-Stewart - integer :: i, j, k + integer :: i, j, k, itg integer :: patchx, patchy real :: rk3coef,thlsl @@ -1630,14 +1644,24 @@ subroutine do_lsm real :: CO2ags, CO2comp, gm, fmin0, fmin, esatsurf, Ds, D0, cfrac, co2abs, ci !Variables for AGS real :: Ammax, betaw, fstr, Am, Rdark, PAR, alphac, tempy, An, AGSa1, Dstar, gcco2 !Variables for AGS real :: rsAgs, rsCO2, fw, Resp, wco2 !Variables for AGS + real :: Ag, PARdir, PARdif !Variables for 2leaf AGS real :: MW_Air = 28.97 real :: MW_CO2 = 44 + + real :: sinbeta, kdrbl, kdf, kdr, ref, ref_dir + real :: iLAI, fSL + real :: PARdfU, PARdfD, PARdfT, PARdrU, PARdrD, PARdrT, dirPAR, difPAR + real :: HdfT, HdrT, dirH, Hshad, Hsun(nr_gauss), Fshad, Fsun, gshad, gsun + real :: Hleaf(nr_gauss+1), Fleaf(nr_gauss+1), gleaf(nr_gauss+1), Agl(nr_gauss+1) + real :: Fnet(nr_gauss), gnet(nr_gauss) + real :: minsinbeta = 1.e-10 real :: lthls_patch(xpatches,ypatches) integer :: Npatch(xpatches,ypatches), SNpatch(xpatches,ypatches) real :: local_wco2av real :: local_Anav + real :: local_gcco2av real :: local_Respav patchx = 0 @@ -1665,18 +1689,26 @@ subroutine do_lsm wco2av = 0.0 Anav = 0.0 + gcco2av = 0.0 Respav = 0.0 local_wco2av = 0.0 local_Anav = 0.0 + local_gcco2av= 0.0 local_Respav = 0.0 if (lrsAgs) then AnField = 0.0 + gcco2Field = 0.0 RespField = 0.0 wco2Field = 0.0 rsco2Field = 0.0 fstrField = 0.0 ciField = 0.0 + PARField = 0.0 + if (lsplitleaf) then + PARdirField= 0.0 + PARdifField= 0.0 + endif endif rk3coef = rdt / (4. - dble(rk3step)) @@ -1840,7 +1872,11 @@ subroutine do_lsm Rdark = (1.0/9) * Am !PAR = 0.40 * max(0.1,-swdav * cveg(i,j)) - PAR = 0.50 * max(0.1,-swdav) !Increase PAR to 50 SW + PAR = 0.50 * max(0.1,ab(swdav)) !Increase PAR to 50 SW + if (lsplitleaf) then + PARdir = 0.50 * max(0.1,abs(swdir(i,j,1))) + PARdif = 0.50 * max(0.1,abs(swdif(i,j,1))) + endif ! Calculate the light use efficiency alphac = alpha0 * (co2abs - CO2comp) / (co2abs + 2 * CO2comp) @@ -1853,19 +1889,76 @@ subroutine do_lsm AGSa1 = 1.0 / (1 - f0) Dstar = D0 / (AGSa1 * (f0 - fmin)) + if(lsplitleaf) then + sinbeta = max(zenith(xtime*3600 + rtimee,xday,xlat,xlon), minsinbeta) + kdrbl = 0.5 / sinbeta ! Direct radiation extinction coefficient for black leaves + kdf = kdfbl * sqrt(1.0-sigma) + kdr = kdrbl * sqrt(1.0-sigma) + ref = (1.0 - sqrt(1.0-sigma)) / (1.0 + sqrt(1.0-sigma)) ! Reflection coefficient + ref_dir = 2 * ref / (1.0 + 1.6 * sinbeta) + + do itg = 1, nr_gauss ! loop over the different LAI locations + iLAI = LAI(i,j) * LAI_g(itg) ! Integrated LAI between here and canopy top; Gaussian distributed + fSL = exp(-kdrbl * iLAI) ! Fraction of sun-lit leaves + + PARdfD = PARdif * (1.0-ref) * exp(-kdf * iLAI ) ! Total downward PAR due to diffuse radiation at canopy top + PARdrD = PARdir * (1.0-ref_dir) * exp(-kdr * iLAI ) ! Total downward PAR due to direct radiation at canopy top + PARdfU = PARdif * (1.0-ref) * exp(-kdf * LAI(i,j)) * albedo(i,j) * (1.0-ref) * exp(-kdf * (LAI(i,j)-iLAI)) ! Total upward (reflected) PAR that originates as diffuse radiation + PARdrU = PARdir * (1.0-ref_dir) * exp(-kdr * LAI(i,j)) * albedo(i,j) * (1.0-ref) * exp(-kdf * (LAI(i,j)-iLAI)) ! Total upward (reflected) PAR that originates as direct radiation + PARdfT = PARdfD + PARdfU ! Total PAR due to diffuse radiation at canopy top + PARdrT = PARdrD + PARdrU ! Total PAR due to direct radiation at canopy top + + dirPAR = (1.0-sigma) * PARdir * fSL ! Purely direct PAR (can only be downward) + difPAR = PARdfT + PARdrT - dirPAR ! Total diffuse radiation + + HdfT = kdf * PARdfD + kdf * PARdfU + HdrT = kdr * PARdrD + kdf * PARdrU + dirH = kdrbl * dirPAR + Hshad = HdfT + HdrT - dirH + + Hsun = Hshad + angle_g * (1.0-sigma) * kdrbl * PARdir / sum(angle_g * weight_g) + + Hleaf(1) = Hshad + Hleaf(2:(nr_gauss+1)) = Hsun + + Agl = fstr * (Am + Rdark) * (1 - exp(-alphac*Hleaf/(Am + Rdark))) + gleaf = gmin/nuco2q + Agl/(co2abs-ci) + !Fleaf = -(co2abs - ci) / (ra(i,j) + 1.0 / gleaf) + Fleaf = Agl - Rdark + + Fshad = Fleaf(1) + Fsun = sum(weight_g * Fleaf(2:(nr_gauss+1))) + gshad = gleaf(1) + gsun = sum(weight_g * gleaf(2:(nr_gauss+1))) + + Fnet(itg) = Fsun * fSL + Fshad * (1 - fSL) + gnet(itg) = gsun * fSL + gshad * (1 - fSL) + + end do !itg + + An = LAI(i,j) * sum(weight_g * Fnet) + gcco2 = LAI(i,j) * sum(weight_g * gnet) + + else !lsplitleaf + + ! Calculate upscaling from leaf to canopy: net flow CO2 into the plant (An) + tempy = alphac * Kx * PAR / (Am + Rdark) + An = (Am + Rdark) * (1 - 1.0 / (Kx * LAI(i,j)) * (E1(tempy * exp(-Kx*LAI(i,j))) - E1(tempy))) + gcco2 = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) + + endif !lsplitleaf + + if (lrelaxgc) then if (gc_old_set) then - gc_inf = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) + gc_inf = gcco2 gcco2 = gc_old(i,j) + min(kgc*rk3coef, 1.0) * (gc_inf - gc_old(i,j)) if (rk3step ==3) then gc_old(i,j) = gcco2 endif else - gcco2 = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) gc_old(i,j) = gcco2 endif - else - gcco2 = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) endif ! Calculate surface resistances for moisture and carbon dioxide @@ -1890,14 +1983,22 @@ subroutine do_lsm local_wco2av = local_wco2av + wco2 local_Anav = local_Anav + An + local_gcco2av= local_gcco2av + gcco2 local_Respav = local_Respav + Resp AnField (i,j) = An + gcco2Field(i,j) = gcco2 RespField (i,j) = Resp wco2Field (i,j) = wco2 rsco2Field(i,j) = rsCO2 fstrField (i,j) = fstr ciField (i,j) = ci + PARField (i,j) = PAR + if (lsplitleaf)then + PARdirField(i,j) = PARdir + PARdifField(i,j) = PARdif + endif + endif !lrsAgs ! 2.2 - Calculate soil resistance based on ECMWF method @@ -2073,9 +2174,11 @@ subroutine do_lsm call MPI_ALLREDUCE(local_wco2av, wco2av, 1, MY_REAL, MPI_SUM, comm3d,mpierr) call MPI_ALLREDUCE(local_Anav , Anav , 1, MY_REAL, MPI_SUM, comm3d,mpierr) + call MPI_ALLREDUCE(local_gcco2av , gcco2av , 1, MY_REAL, MPI_SUM, comm3d,mpierr) call MPI_ALLREDUCE(local_Respav, Respav, 1, MY_REAL, MPI_SUM, comm3d,mpierr) Anav = Anav/ijtot + gcco2av= gcco2av/ijtot wco2av = wco2av/ijtot Respav = Respav/ijtot diff --git a/src/modsurfdata.f90 b/src/modsurfdata.f90 index ab3e42f0..277eda05 100644 --- a/src/modsurfdata.f90 +++ b/src/modsurfdata.f90 @@ -138,14 +138,19 @@ module modsurfdata logical :: ci_old_set = .false.!< Only apply relaxing function after initial ci is calculated once real :: wco2av = 0.0 real :: Anav = 0.0 + real :: gcco2av = 0.0 real :: Respav = 0.0 real, allocatable :: wco2Field (:,:) real, allocatable :: AnField (:,:) + real, allocatable :: gcco2Field (:,:) real, allocatable :: rsco2Field (:,:) real, allocatable :: RespField (:,:) real, allocatable :: fstrField (:,:) real, allocatable :: tauField (:,:) real, allocatable :: ciField (:,:) + real, allocatable :: PARField (:,:) + real, allocatable :: PARdirField (:,:) + real, allocatable :: PARdifField (:,:) ! Date: Wed, 7 Mar 2018 14:20:05 +0100 Subject: [PATCH 53/88] Switches related to Delta Eddington and different radiative flux sign convention --- src/modchem.f90 | 5 +++-- src/modradiation.f90 | 24 ++++++++++++++---------- src/modradstat.f90 | 22 +++++++++++++++------- src/modsurface.f90 | 4 ++-- 4 files changed, 34 insertions(+), 21 deletions(-) diff --git a/src/modchem.f90 b/src/modchem.f90 index d8c16eeb..6cd75cf7 100644 --- a/src/modchem.f90 +++ b/src/modchem.f90 @@ -1792,6 +1792,7 @@ subroutine ratech use modfields, only : qt0, ql0 ,rhof use modmpi, only : myid, comm3d, mpierr, mpi_max, my_real, mpi_sum use modsurfdata,only: taufield, lrsAgs + use modraddata,only: iradiation, irad_par implicit none real sza @@ -1910,7 +1911,7 @@ subroutine ratech !for clouds the the max solar zenith angle is cutoff at 60 degrees coszenmax = min(60*pi/180,coszen) - if (lrsAgs) then + if (lrsAgs .and. (iradiation/=irad_par)) then !irad_par get tau with ql0 theshold tauField = 0.0 endif @@ -1937,7 +1938,7 @@ subroutine ratech !- Calculating transmission coefficient, cloud optical depth tau2 = (3./2.)*(qlint/(rhow*re)) - if (lrsAgs) then + if (lrsAgs .and. (iradiation/=irad_par)) then tauField(i,j) = tau2 endif diff --git a/src/modradiation.f90 b/src/modradiation.f90 index f37f261c..293fabc4 100644 --- a/src/modradiation.f90 +++ b/src/modradiation.f90 @@ -248,6 +248,7 @@ subroutine radpar use modglobal, only : i1,j1,kmax, k1,ih,jh,dzf,cp,xtime,rtimee,xday,xlat,xlon use modfields, only : ql0, sv0, rhof,exnf + use modsurfdata, only : tauField implicit none real, allocatable :: lwpt(:),lwpb(:) real, allocatable :: tau(:) @@ -324,16 +325,19 @@ subroutine radpar do i=2,i1 if (mu > 0.035) then !factor 0.035 needed for security - tauc = 0. ! tau cloud - do k = 1,kmax - tau(k) = 0. ! tau laagje dz - if(laero) then ! there are aerosols - tau(k) = sv0(i,j,k,iDE) - else ! there are clouds - if (ql0(i,j,k) > 1e-5) tau(k)=1.5*ql0(i,j,k)*rhof(k)*dzf(k)/reff/rho_l - end if - tauc=tauc+tau(k) - end do + tauc = 0. ! column-integrated tau cloud + if (laero .or. lcloudshading) then ! not sure if I have to define the use of lcldoushading before + do k = 1,kmax + tau(k) = 0. ! tau laagje dz + if(laero) then ! there are aerosols + tau(k) = sv0(i,j,k,iDE) + else if (lcloudshading) then ! there are clouds + if (ql0(i,j,k) > 1e-5) tau(k)=1.5*ql0(i,j,k)*rhof(k)*dzf(k)/reff/rho_l + end if + tauc=tauc+tau(k) + end do + endif + tauField(i,j) = tauc(i,j) call sunray(tau,tauc,i,j) end if diff --git a/src/modradstat.f90 b/src/modradstat.f90 index c912ecad..7be9625d 100644 --- a/src/modradstat.f90 +++ b/src/modradstat.f90 @@ -232,7 +232,7 @@ subroutine do_radstat use modmpi, only : slabsum use modglobal, only : kmax,ijtot,cp,dzf,i1,j1,k1,ih,jh use modfields, only : thlpcar,rhof,exnf - use modraddata, only : lwd,lwu,swd,swdir,swdif,swu,thlprad + use modraddata, only : lwd,lwu,swd,swdir,swdif,swu,thlprad,,irad_par,iradiation implicit none integer :: k @@ -255,10 +255,18 @@ subroutine do_radstat call slabsum(swdifav ,1,k1,swdif ,2-ih,i1+ih,2-jh,j1+jh,1,k1,2,i1,2,j1,1,k1) call slabsum(swuav ,1,k1,swu ,2-ih,i1+ih,2-jh,j1+jh,1,k1,2,i1,2,j1,1,k1) call slabsum(thltendav ,1,k1,thlprad ,2-ih,i1+ih,2-jh,j1+jh,1,k1,2,i1,2,j1,1,k1) - do k=1,kmax - thllwtendav(k) = -((lwdav(k+1) - lwuav(k+1)) - (lwdav(k) - lwuav(k)))/(rhof(k)*exnf(k)*cp*dzf(k)) - thlswtendav(k) = -((swdav(k+1) - swuav(k+1)) - (swdav(k) - swuav(k)))/(rhof(k)*exnf(k)*cp*dzf(k)) ! - end do + if (iradiation==irad_par) then !irad_par=Delta eddington keeps all fluxes(upwards and downwards) positive + do k=1,kmax + thllwtendav(k) = -((lwdav(k+1) - lwuav(k+1)) - (lwdav(k) - lwuav(k)))/(rhof(k)*exnf(k)*cp*dzf(k)) + thlswtendav(k) = -((swdav(k+1) - swuav(k+1)) - (swdav(k) - swuav(k)))/(rhof(k)*exnf(k)*cp*dzf(k)) ! + end do + else !upward fluxes positive, downwards negative + do k=1,kmax + thllwtendav(k) = (-lwdav(k+1) - lwuav(k+1) + lwdav(k) + lwuav(k))/(rhof(k)*exnf(k)* + thlswtendav(k) = (-swdav(k+1) - swuav(k+1) + swdav(k) + swuav(k))/(rhof(k)*exnf(k)* + end do + endif + ! ADD SLAB AVERAGES TO TIME MEAN @@ -346,7 +354,7 @@ subroutine writeradstat use modglobal, only : cexpnr,ifoutput,kmax,k1,zf,zh,rtimee use modstat_nc, only: lnetcdf, writestat_nc use modgenstat, only: ncid_prof=>ncid,nrec_prof=>nrec - use modraddata, only : iradiation + use modraddata, only : iradiation,irad_par,irad_rrtmg implicit none real,dimension(k1,nvar) :: vars integer nsecs, nhrs, nminut,k @@ -406,7 +414,7 @@ subroutine writeradstat end do close (ifoutput) - if(iradiation == 2) then + if(iradiation == irad_par .or. iradiation ==irad_rrtmg) then ! delta eddington or RRTMG) open (ifoutput,file='radsplitstat.'//cexpnr,position='append') write(ifoutput,'(//A,/A,F5.0,A,I4,A,I2,A,I2,A)') & '#--------------------------------------------------------' & diff --git a/src/modsurface.f90 b/src/modsurface.f90 index 4b281cb2..f3c247d1 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -1742,10 +1742,10 @@ subroutine do_lsm lwuav = sum(lwuavn(i,j,:)) / nradtime Qnet(i,j) = -(swdav + swuav + lwdav + lwuav) - elseif(iradiation == 2 .or. iradiation == 10) then ! Delta-eddington approach (2) .or. rad_user (10) + elseif(iradiation == irad_par .or. iradiation == 10) then ! Delta-eddington approach (2) .or. rad_user (10) swdav = -swd(i,j,1) Qnet(i,j) = (swd(i,j,1) - swu(i,j,1) + lwd(i,j,1) - lwu(i,j,1)) - else ! simple radiation scheme + else ! simple radiation scheme and RRTMG Qnet(i,j) = -(swd(i,j,1) + swu(i,j,1) + lwd(i,j,1) + lwu(i,j,1)) swdav = swd(i,j,1) end if From d9a19c09699963adebbb37d148c9782810d50290 Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 14:47:53 +0100 Subject: [PATCH 54/88] Get lwc, swdir and swdif from RRTMG in output, and if no LW, the lowest layer is caluclated as in sunray --- src/modraddata.f90 | 3 +++ src/modradiation.f90 | 4 +++- src/modradrrtmg.f90 | 22 ++++++++++++++++++---- src/rrtmg_sw_rad.f90 | 4 ++++ 4 files changed, 28 insertions(+), 5 deletions(-) diff --git a/src/modraddata.f90 b/src/modraddata.f90 index da5332ec..a0d2fdd0 100644 --- a/src/modraddata.f90 +++ b/src/modraddata.f90 @@ -108,6 +108,8 @@ module modraddata lwHRCS_slice, & ! Heating rate due to longwave rad,clear sky value (2D slice) swUp_slice, & ! Upwelling shortwave rad (2D slice) swDown_slice, & ! Downwelling shortwave rad (2D slice) + swDownDir_slice,& ! Downwelling shortwave direct rad (2D slice) + swDownDif_slice,& ! Downwelling shortwave diffuse rad (2D slice) swUpCS_slice, & ! Upwelling shortwave rad, clear sky value (2D slice) swDownCS_slice, & ! Downwelling shortwave rad, clear sky value(2D slice) swHR_slice, & ! Heating rate due to shortwave rad (2D slice) @@ -169,6 +171,7 @@ module modraddata real, allocatable :: swd(:,:,:) !< shortwave downward radiative flux real, allocatable :: swdir(:,:,:) !< Direct shortwave downward radiative flux real, allocatable :: swdif(:,:,:) !< Difuse shortwave downward radiative flux + real, allocatable :: lwc(:,:,:) !< Liquid water content calculated in rrtmg real, allocatable :: swu(:,:,:) !< shortwave upward radiative flux real, allocatable :: lwd(:,:,:) !< longwave downward radiative flux real, allocatable :: lwu(:,:,:) !< longwave upward radiative flux diff --git a/src/modradiation.f90 b/src/modradiation.f90 index 293fabc4..c1bd3b54 100644 --- a/src/modradiation.f90 +++ b/src/modradiation.f90 @@ -105,6 +105,7 @@ subroutine initradiation allocate(swdir (2-ih:i1+ih,2-jh:j1+jh,k1) ) allocate(swdif (2-ih:i1+ih,2-jh:j1+jh,k1) ) + allocate(lwc (2-ih:i1+ih,2-jh:j1+jh,k1) ) allocate(SW_up_TOA (2-ih:i1+ih,2-jh:j1+jh) ) allocate(SW_dn_TOA (2-ih:i1+ih,2-jh:j1+jh) ) @@ -130,6 +131,7 @@ subroutine initradiation swdir = 0. swdif = 0. + lwc = 0. SW_up_TOA=0;SW_dn_TOA=0;LW_up_TOA=0;LW_dn_TOA=0 SW_up_ca_TOA = 0. ;SW_dn_ca_TOA=0 ;LW_up_ca_TOA=0 ;LW_dn_ca_TOA=0 @@ -236,7 +238,7 @@ subroutine radiation !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine exitradiation implicit none - deallocate(thlprad,swd,swdir,swdif,swu,lwd,lwu,swdca,swuca,lwdca,lwuca) + deallocate(thlprad,swd,swdir,swdif,swu,lwd,lwu,swdca,swuca,lwdca,lwuca,lwc) deallocate(SW_up_TOA, SW_dn_TOA,LW_up_TOA,LW_dn_TOA, & SW_up_ca_TOA,SW_dn_ca_TOA,LW_up_ca_TOA,LW_dn_ca_TOA) diff --git a/src/modradrrtmg.f90 b/src/modradrrtmg.f90 index 575cbe63..301cc978 100644 --- a/src/modradrrtmg.f90 +++ b/src/modradrrtmg.f90 @@ -10,9 +10,10 @@ module modradrrtmg subroutine radrrtmg use modglobal, only : cp,rlv,dzf,& imax,jmax,kmax,i1,j1,k1,& - kind_rb,SHR_KIND_R4 + kind_rb,SHR_KIND_R4,boltz use modmpi, only : myid - use modfields, only : presh,presf,rhof,exnf + use modfields, only : presh,presf,rhof,exnf,thl0 + use modsurfdata , only : tskin use rrtmg_lw_init, only : rrtmg_lw_ini use rrtmg_lw_rad, only : rrtmg_lw use shr_orb_mod, only : shr_orb_params @@ -105,6 +106,8 @@ subroutine radrrtmg lwDownCS_slice (imax,krad2), & swUp_slice (imax,krad2), & swDown_slice (imax,krad2), & + swDownDir_slice(imax,krad2), & + swDownDif_slice(imax,krad2), & swUpCS_slice (imax,krad2), & swDownCS_slice (imax,krad2), & lwHR_slice (imax,krad2), & @@ -179,9 +182,20 @@ subroutine radrrtmg lwu(2:i1,j,1:k1) = lwUp_slice (1:imax,1:k1) lwd(2:i1,j,1:k1) = -lwDown_slice(1:imax,1:k1) + if (.not. rad_longw) then !we get LW at surface identically to how it is done in sunray subroutine XPB + do i=2,i1 + lwd(i,j,1) = -0.8 * boltz * thl0(i,j,1) ** 4. + lwu(i,j,1) = 1.0 * boltz * tskin(i,j) ** 4. + end do + end if + swu(2:i1,j,1:k1) = swUp_slice (1:imax,1:k1) swd(2:i1,j,1:k1) = -swDown_slice(1:imax,1:k1) + swdir(2:i1,j,1:k1) = -swDownDir_slice(1:imax,1:k1) + swdif(2:i1,j,1:k1) = -swDownDif_slice(1:imax,1:k1) + lwc (2:i1,j,1:k1) = LWP_slice (1:imax,1:k1) + lwuca(2:i1,j,1:k1) = lwUpCS_slice (1:imax,1:k1) lwdca(2:i1,j,1:k1) = -lwDownCS_slice(1:imax,1:k1) swuca(2:i1,j,1:k1) = swUpCS_slice (1:imax,1:k1) @@ -524,7 +538,7 @@ subroutine readTraceProfs ! original tracesini subroutine in rad_driver if(myid==0)then write(*,*) 'RRTMG rrtmg_lw.nc trace gas profile: number of levels=',np - write(*,*) 'gas traces vertical profiles (ppmv):' + write(*,*) 'gas traces vertical profiles (ppmv *10^-6):' write(*,*) 'p, hPa', (' ',traceGasNameOrder(m),m=1,nTraceGases) do k=1,krad1 write(*,*) tmppresf(k),o3(k),co2(k),ch4(k),n2o(k),o2(k), & @@ -600,7 +614,7 @@ subroutine setupSlicesFromProfiles(j,npatch_start, & do i=2,i1 im=i-1 do k=1,kmax - qv_slice (im,k) = qt0(i,j,k) - ql0(i,j,k) + qv_slice (im,k) = max(qt0(i,j,k) - ql0(i,j,k),1e-18) !avoid negative initial values XPB qcl_slice (im,k) = ql0(i,j,k) qci_slice (im,k) = 0. o3_slice (im,k) = o3snd(npatch_start) ! o3 constant below domain top (if usero3!) diff --git a/src/rrtmg_sw_rad.f90 b/src/rrtmg_sw_rad.f90 index 837cc134..331b2f36 100644 --- a/src/rrtmg_sw_rad.f90 +++ b/src/rrtmg_sw_rad.f90 @@ -409,6 +409,8 @@ subroutine rrtmg_sw & real(kind=rb) :: znicddir(nzrad+3) ! temporary clear sky near-IR downward direct shortwave flux (w/m2) ! Optional output fields + real(kind=rb) :: swnflx(nzrad+3) ! Total sky shortwave net flux (W/m2) + real(kind=rb) :: swnflxc(nzrad+3) ! Clear sky shortwave net flux (W/m2) real(kind=rb) :: dirdflux(nzrad+3) ! Direct downward shortwave surface flux real(kind=rb) :: difdflux(nzrad+3) ! Diffuse downward shortwave surface flux real(kind=rb) :: uvdflx(nzrad+3) ! Total sky downward shortwave flux, UV/vis @@ -715,6 +717,8 @@ subroutine rrtmg_sw & dirdflux(i) = zbbfddir(i) !difdflux(i) = swdflx(iplon,i) - dirdflux(i) difdflux(i) = swDown_slice(iplon,i) - dirdflux(i) + swDownDir_slice(iplon,i) = dirdflux(i) + swDownDif_slice(iplon,i) = difdflux(i) ! UV/visible direct/diffuse fluxes dirdnuv(i) = zuvfddir(i) difdnuv(i) = zuvfd(i) - dirdnuv(i) From 612f5f1851e96bc1f025db5ddfdc8473be9e79c6 Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 15:05:07 +0100 Subject: [PATCH 55/88] Output lwp given by RRTMG, if used --- src/modAGScross.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/modAGScross.f90 b/src/modAGScross.f90 index 35a63abc..ead758f2 100644 --- a/src/modAGScross.f90 +++ b/src/modAGScross.f90 @@ -192,7 +192,11 @@ subroutine AGShorz do i = 2,i1 do j = 2,j1 - lwp(i,j) = sum(ql0(i,j,1:kmax)*rhof(1:kmax)*dzf(1:kmax)) + if (iradiation == irad_rrtmg) then + lwp(i,j) = sum(lwc(i,j,1:kmax))*1.e-3 ! we get the already calculated lwc from RRTMG + else + lwp(i,j) = sum(ql0(i,j,1:kmax)*rhof(1:kmax)*dzf(1:kmax)) + end if enddo enddo From 167a2ab623976193a8aeb9b04d191f08f63f377a Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 15:20:23 +0100 Subject: [PATCH 56/88] Switch in randomnize subroutine to allow or not negative values --- src/modstartup.f90 | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 496ae120..6987033b 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -381,6 +381,7 @@ subroutine readinitfiles use modtestbed, only : ltestbed,tb_ps,tb_thl,tb_qt,tb_u,tb_v,tb_w,tb_ug,tb_vg,& tb_dqtdxls,tb_dqtdyls,tb_qtadv,tb_thladv integer i,j,k,n + logical negval !whether we want to allow negative values (RRMTG may crash)when randomnization XPB real, allocatable :: height(:), th0av(:) real, allocatable :: thv0(:,:,:) @@ -499,20 +500,25 @@ subroutine readinitfiles !--------------------------------------------------------------- krand = min(krand,kmax) + negval = .True. ! I set it by default false, allowing negative perturbations do k = 1,krand - call randomnize(qtm ,k,randqt ,irandom,ih,jh) - call randomnize(qt0 ,k,randqt ,irandom,ih,jh) - call randomnize(thlm,k,randthl,irandom,ih,jh) - call randomnize(thl0,k,randthl,irandom,ih,jh) + call randomnize(qtm ,k,randqt ,irandom,ih,jh,negval) + call randomnize(qt0 ,k,randqt ,irandom,ih,jh,negval) + end do + negval = .False. ! negative moisture is non physical + do + call randomnize(thlm,k,randthl,irandom,ih,jh,negval) + call randomnize(thl0,k,randthl,irandom,ih,jh,negval) end do + negval = .True. do k=krandumin,krandumax - call randomnize(um ,k,randu ,irandom,ih,jh) - call randomnize(u0 ,k,randu ,irandom,ih,jh) - call randomnize(vm ,k,randu ,irandom,ih,jh) - call randomnize(v0 ,k,randu ,irandom,ih,jh) - call randomnize(wm ,k,randu ,irandom,ih,jh) - call randomnize(w0 ,k,randu ,irandom,ih,jh) + call randomnize(um ,k,randu ,irandom,ih,jh,negval) + call randomnize(u0 ,k,randu ,irandom,ih,jh,negval) + call randomnize(vm ,k,randu ,irandom,ih,jh,negval) + call randomnize(v0 ,k,randu ,irandom,ih,jh,negval) + call randomnize(wm ,k,randu ,irandom,ih,jh,negval) + call randomnize(w0 ,k,randu ,irandom,ih,jh,negval) end do svprof = 0. @@ -1056,7 +1062,7 @@ subroutine exitmodules end subroutine exitmodules !---------------------------------------------------------------- - subroutine randomnize(field,klev,ampl,ir,ihl,jhl) + subroutine randomnize(field,klev,ampl,ir,ihl,jhl,negval) ! Adds (pseudo) random noise with given amplitude to the field at level k ! Use our own pseudo random function so results are reproducibly the same, ! independent of parallization. @@ -1070,6 +1076,7 @@ subroutine randomnize(field,klev,ampl,ir,ihl,jhl) real ran,ampl real field(2-ihl:i1+ihl,2-jhl:j1+jhl,k1) parameter (imm = 134456, ia = 8121, ic = 28411) + logical negval is = myidx * imax + 1 ie = is + imax - 1 @@ -1084,6 +1091,11 @@ subroutine randomnize(field,klev,ampl,ir,ihl,jhl) if (i >= is .and. i <= ie .and. & j >= js .and. j <= je) then field(i-is+2,j-js+2,klev) = field(i-is+2,j-js+2,klev) + (ran-0.5)*2.0*ampl + !we avoid non-physical negative values if negval=False XPB + if ((.not. negval) .and. field(i-is+2,j-js+2,klev)<0.0) then + field(i-is+2,j-js+2,klev) = 0.0 + endif + endif enddo enddo From 869c0975da74900ad2e68cf94d5c86c8c78f934a Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 15:28:36 +0100 Subject: [PATCH 57/88] Bug fix for in modmpi relevant when nprocy=0,nprocx=1, may be unnecesary now --- src/modmpi.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/modmpi.f90 b/src/modmpi.f90 index 592fb140..06c8f957 100644 --- a/src/modmpi.f90 +++ b/src/modmpi.f90 @@ -211,6 +211,7 @@ subroutine excj( a, sx, ex, sy, ey, sz,ez) enddo enddo else + ii = 0 !XPB added this line, otherwise crash if nprocy=0,nprocx=1 (may be unnecessary after commenting lines 217 and 263) do k=sz,ez do i=sx,ex ! ii = ii + 1 From 0286387a03d2a90bbe2d0a40e300a8cbdd2ee721 Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 7 Mar 2018 15:36:08 +0100 Subject: [PATCH 58/88] Few helpful additional comments --- src/modbulkmicro.f90 | 2 +- src/modfields.f90 | 2 +- src/modmicrodata.f90 | 2 +- src/modsampling.f90 | 6 +++--- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/modbulkmicro.f90 b/src/modbulkmicro.f90 index 1fd9672f..b5b83282 100644 --- a/src/modbulkmicro.f90 +++ b/src/modbulkmicro.f90 @@ -497,7 +497,7 @@ subroutine accretion end subroutine accretion -!> Sedimentation of cloud water +!> Sedimentation of cloud water ((Bretherton et al,GRL 2007)) !! !! The sedimentation of cloud droplets assumes a lognormal DSD in which the !! geometric std dev. is assumed to be fixed at 1.3. diff --git a/src/modfields.f90 b/src/modfields.f90 index 9a6bde47..d047d9e7 100644 --- a/src/modfields.f90 +++ b/src/modfields.f90 @@ -117,7 +117,7 @@ module modfields real, allocatable :: dvdyls(:) !< large scale y-gradient of v real, allocatable :: dvdtls(:) !< large scale tendency of v - real, allocatable :: wfls (:) !< large scale y-gradient of v + real, allocatable :: wfls (:) !< large scale vertical velocity real, allocatable :: ql0h(:,:,:) real, allocatable :: dthvdz(:,:,:)!< theta_v at half level diff --git a/src/modmicrodata.f90 b/src/modmicrodata.f90 index 2a7b3a60..39b0927b 100644 --- a/src/modmicrodata.f90 +++ b/src/modmicrodata.f90 @@ -42,7 +42,7 @@ module modmicrodata l_mur_cst = .false. ! false = no constant value of mur (mur=f(Dv)) (in namelist NAMMICROPHYSICS) real :: mur_cst = 5 & !< mur value if l_mur_cst=T (in namelist NAMMICROPHYSICS) - ,Nc_0 = 70e6 & !< initial cloud droplet number + ,Nc_0 = 70e6 & !< initial cloud droplet number (#/m3) ,sig_g = 1.34 & !< geom. std dev of cloud droplet DSD ,sig_gr = 1.5 !< geometric std dev of rain drop DSD diff --git a/src/modsampling.f90 b/src/modsampling.f90 index 8f6a7633..a51811a0 100644 --- a/src/modsampling.f90 +++ b/src/modsampling.f90 @@ -949,7 +949,7 @@ subroutine writesampling write (ifoutput,'(2A/2A)') & '#------------------------------------------------------' & ,'------------------------------' & - ,' LEV HGHT_F HGHT_H PRES COV_F COV_H W THL QT ' & + ,'# LEV HGHT_F HGHT_H PRES COV_F COV_H W THL QT ' & ,'QL THV P WW_RES_H WW_SUB_F' do k=1,kmax write(ifoutput,'(i5,2F8.0,F7.1,2F10.5,5F11.5,E14.5,2F14.5)') & @@ -980,7 +980,7 @@ subroutine writesampling write (ifoutput,'(2A/2A)') & '#------------------------------------------------------' & ,'------------------------------' & - ,' LEV HGHT PRES AW WTHL ' & + ,'# LEV HGHT PRES AW WTHL ' & ,'WQT WQL WTHV UW VW' do k=1,kmax write(ifoutput,'(i5,F8.0,F7.1,7E16.8)') & @@ -1008,7 +1008,7 @@ subroutine writesampling write (ifoutput,'(2A/3A)') & '#------------------------------------------------------' & ,'------------------------------' & - ,' LEV HGHT PRES COVER DWDTMN BUO DPDZMN DWWDZHMN DUWDXHMN ' & + ,'# LEV HGHT PRES COVER DWDTMN BUO DPDZMN DWWDZHMN DUWDXHMN ' & ,' DTAUDZHMN DTAUDXHMN CORIOLIS RESIDUAL WS_END SIG_END WADVHMN SUBPLUME ' & ,' NRTSAMPHAV ' do k=1,kmax From 1a7b0ca626ee8756cc1ac04aebaae8d3a968197b Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Mon, 12 Mar 2018 16:10:09 +0100 Subject: [PATCH 59/88] Bug fixes on Xabi's changes --- src/modAGScross.f90 | 24 +++++++++++++----------- src/modradiation.f90 | 2 +- src/modradrrtmg.f90 | 4 ++-- src/modradstat.f90 | 6 +++--- src/modstartup.f90 | 17 ++++++++--------- src/modsurface.f90 | 37 +++++++++++++++++-------------------- 6 files changed, 44 insertions(+), 46 deletions(-) diff --git a/src/modAGScross.f90 b/src/modAGScross.f90 index ead758f2..e2d6744a 100644 --- a/src/modAGScross.f90 +++ b/src/modAGScross.f90 @@ -95,8 +95,10 @@ subroutine initAGScross ! we set the final number of variables in the output: final_nvar = nvar - if (iradiation == irad_par .or. iradiation == irad_rrtmg) final_nvar = final_nvar+2!swdir,swdif - if (lsplitleaf) final_nvar = final_nvar+2 !PARdir,PARdif + if (iradiation == irad_par .or. iradiation == irad_rrtmg) then + final_nvar = final_nvar+2 !swdir,swdif + if (lsplitleaf) final_nvar = final_nvar+2 !PARdir,PARdif + endif allocate(ncnameAGS(final_nvar,4)) call ncinfo(tncnameAGS(1,:),'time ','Time','s','time') @@ -138,10 +140,10 @@ subroutine initAGScross if (iradiation == irad_par .or. iradiation == irad_rrtmg) then call ncinfo(ncnameAGS(36,:),'swdir ', 'xy AGScross of SW dir rad. ','W/m2 ','tt0t') call ncinfo(ncnameAGS(37,:),'swdif ', 'xy AGScross of SW diff rad.','W/m2 ','tt0t') - endif - if (lsplitleaf) then - call ncinfo(ncnameAGS(38,:),'PARdir', 'xy AGScross of direct PAR ','W/m2 ','tt0t') - call ncinfo(ncnameAGS(39,:),'PARdif', 'xy AGScross of diffuse PAR ','W/m2 ','tt0t') + if (lsplitleaf) then + call ncinfo(ncnameAGS(38,:),'PARdir', 'xy AGScross of direct PAR ','W/m2 ','tt0t') + call ncinfo(ncnameAGS(39,:),'PARdif', 'xy AGScross of diffuse PAR ','W/m2 ','tt0t') + endif endif call open_nc(fnameAGS, ncidAGS,nrecAGS,n1=imax,n2=jmax) @@ -181,7 +183,7 @@ subroutine AGShorz indCO2, tskin, tskinm, tsoil, thlflux, qtflux, tauField, ciField, gcco2Field, & PARField,Qnet,LE,H,G0,PARdirField,PARdifField,lsplitleaf use modfields, only : svm, rhof, ql0 - use modraddata,only : swd, swu, lwd, lwu,swdir,swdif,irad_par,iradiation,irad_rrtmg + use modraddata,only : swd, swu, lwd, lwu,swdir,swdif,irad_par,iradiation,irad_rrtmg,lwc implicit none @@ -240,10 +242,10 @@ subroutine AGShorz if (iradiation == irad_par .or. iradiation == irad_rrtmg) then vars(:,:,36) = swdir (2:i1,2:j1,1) vars(:,:,37) = swdif (2:i1,2:j1,1) - endif - if (lsplitleaf) then - vars(:,:,38) = PARdirField(2:i1,2:j1) - vars(:,:,39) = PARdifField(2:i1,2:j1) + if (lsplitleaf) then + vars(:,:,38) = PARdirField(2:i1,2:j1) + vars(:,:,39) = PARdifField(2:i1,2:j1) + endif endif call writestat_nc(ncidAGS,1,tncnameAGS,(/rtimee/),nrecAGS,.true.) call writestat_nc(ncidAGS,final_nvar,ncnameAGS,vars,nrecAGS,imax,jmax) diff --git a/src/modradiation.f90 b/src/modradiation.f90 index c1bd3b54..b61ea7fa 100644 --- a/src/modradiation.f90 +++ b/src/modradiation.f90 @@ -339,7 +339,7 @@ subroutine radpar tauc=tauc+tau(k) end do endif - tauField(i,j) = tauc(i,j) + tauField(i,j) = tauc call sunray(tau,tauc,i,j) end if diff --git a/src/modradrrtmg.f90 b/src/modradrrtmg.f90 index 301cc978..9187fd7f 100644 --- a/src/modradrrtmg.f90 +++ b/src/modradrrtmg.f90 @@ -182,7 +182,7 @@ subroutine radrrtmg lwu(2:i1,j,1:k1) = lwUp_slice (1:imax,1:k1) lwd(2:i1,j,1:k1) = -lwDown_slice(1:imax,1:k1) - if (.not. rad_longw) then !we get LW at surface identically to how it is done in sunray subroutine XPB + if (.not. rad_longw) then !we get LW at surface identically to how it is done in sunray subroutine do i=2,i1 lwd(i,j,1) = -0.8 * boltz * thl0(i,j,1) ** 4. lwu(i,j,1) = 1.0 * boltz * tskin(i,j) ** 4. @@ -614,7 +614,7 @@ subroutine setupSlicesFromProfiles(j,npatch_start, & do i=2,i1 im=i-1 do k=1,kmax - qv_slice (im,k) = max(qt0(i,j,k) - ql0(i,j,k),1e-18) !avoid negative initial values XPB + qv_slice (im,k) = max(qt0(i,j,k) - ql0(i,j,k),1e-18) !avoid RRTMG reading negative initial values qcl_slice (im,k) = ql0(i,j,k) qci_slice (im,k) = 0. o3_slice (im,k) = o3snd(npatch_start) ! o3 constant below domain top (if usero3!) diff --git a/src/modradstat.f90 b/src/modradstat.f90 index 7be9625d..d4d19719 100644 --- a/src/modradstat.f90 +++ b/src/modradstat.f90 @@ -232,7 +232,7 @@ subroutine do_radstat use modmpi, only : slabsum use modglobal, only : kmax,ijtot,cp,dzf,i1,j1,k1,ih,jh use modfields, only : thlpcar,rhof,exnf - use modraddata, only : lwd,lwu,swd,swdir,swdif,swu,thlprad,,irad_par,iradiation + use modraddata, only : lwd,lwu,swd,swdir,swdif,swu,thlprad,irad_par,iradiation implicit none integer :: k @@ -262,8 +262,8 @@ subroutine do_radstat end do else !upward fluxes positive, downwards negative do k=1,kmax - thllwtendav(k) = (-lwdav(k+1) - lwuav(k+1) + lwdav(k) + lwuav(k))/(rhof(k)*exnf(k)* - thlswtendav(k) = (-swdav(k+1) - swuav(k+1) + swdav(k) + swuav(k))/(rhof(k)*exnf(k)* + thllwtendav(k) = (-lwdav(k+1) - lwuav(k+1) + lwdav(k) + lwuav(k))/(rhof(k)*exnf(k)*cp*dzf(k)) + thlswtendav(k) = (-swdav(k+1) - swuav(k+1) + swdav(k) + swuav(k))/(rhof(k)*exnf(k)*cp*dzf(k)) end do endif diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 6987033b..eea0abc2 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -381,7 +381,7 @@ subroutine readinitfiles use modtestbed, only : ltestbed,tb_ps,tb_thl,tb_qt,tb_u,tb_v,tb_w,tb_ug,tb_vg,& tb_dqtdxls,tb_dqtdyls,tb_qtadv,tb_thladv integer i,j,k,n - logical negval !whether we want to allow negative values (RRMTG may crash)when randomnization XPB + logical negval !switch to allow or not negative values in randomnization real, allocatable :: height(:), th0av(:) real, allocatable :: thv0(:,:,:) @@ -500,18 +500,17 @@ subroutine readinitfiles !--------------------------------------------------------------- krand = min(krand,kmax) - negval = .True. ! I set it by default false, allowing negative perturbations + negval = .False. ! No negative perturbations for qt (negative moisture is non physical) do k = 1,krand call randomnize(qtm ,k,randqt ,irandom,ih,jh,negval) call randomnize(qt0 ,k,randqt ,irandom,ih,jh,negval) end do - negval = .False. ! negative moisture is non physical - do + negval = .True. ! negative perturbations allowed + do k = 1,krand call randomnize(thlm,k,randthl,irandom,ih,jh,negval) call randomnize(thl0,k,randthl,irandom,ih,jh,negval) end do - negval = .True. do k=krandumin,krandumax call randomnize(um ,k,randu ,irandom,ih,jh,negval) call randomnize(u0 ,k,randu ,irandom,ih,jh,negval) @@ -1090,10 +1089,10 @@ subroutine randomnize(field,klev,ampl,ir,ihl,jhl,negval) ran=real(ir)/real(imm) if (i >= is .and. i <= ie .and. & j >= js .and. j <= je) then - field(i-is+2,j-js+2,klev) = field(i-is+2,j-js+2,klev) + (ran-0.5)*2.0*ampl - !we avoid non-physical negative values if negval=False XPB - if ((.not. negval) .and. field(i-is+2,j-js+2,klev)<0.0) then - field(i-is+2,j-js+2,klev) = 0.0 + if (.not. negval) then ! Avoid non-physical negative values + field(i-is+2,j-js+2,klev) = field(i-is+2,j-js+2,klev) + (ran-0.5)*2.0*min(ampl,field(i-is+2,j-js+2,klev)) + else + field(i-is+2,j-js+2,klev) = field(i-is+2,j-js+2,klev) + (ran-0.5)*2.0*ampl endif endif diff --git a/src/modsurface.f90 b/src/modsurface.f90 index f3c247d1..a658fd30 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -72,7 +72,7 @@ module modsurface subroutine initsurface use modglobal, only : i1, j1, i2, j2, itot, jtot, nsv, ifnamopt, fname_options, ifinput, cexpnr - use modraddata, only : iradiation,rad_shortw,,irad_par,irad_user,irad_rrtmg + use modraddata, only : iradiation,rad_shortw,irad_par,irad_user,irad_rrtmg use modmpi, only : myid, comm3d, mpierr, my_real, mpi_logical, mpi_integer implicit none @@ -1626,9 +1626,9 @@ end subroutine initlsm !> Calculates surface resistance, temperature and moisture using the Land Surface Model subroutine do_lsm - use modglobal, only : pref0,boltz,cp,rd,rhow,rlv,i1,j1,rdt,ijtot,rk3step,nsv,,xtime,rtimee,xday,xlat,xlon + use modglobal, only : pref0,boltz,cp,rd,rhow,rlv,i1,j1,rdt,ijtot,rk3step,nsv,xtime,rtimee,xday,xlat,xlon use modfields, only : ql0,qt0,thl0,rhof,presf,svm - use modraddata,only : iradiation,useMcICA,swd,swu,lwd,lwu,irad_par,swdir,swdif,zenith + use modraddata,only : iradiation,useMcICA,swd,swu,lwd,lwu,irad_par,swdir,swdif,zenith use modmpi, only :comm3d,my_real,mpi_sum,mpierr,mpi_integer,myid real :: f1, f2, f3, f4 ! Correction functions for Jarvis-Stewart @@ -1872,7 +1872,7 @@ subroutine do_lsm Rdark = (1.0/9) * Am !PAR = 0.40 * max(0.1,-swdav * cveg(i,j)) - PAR = 0.50 * max(0.1,ab(swdav)) !Increase PAR to 50 SW + PAR = 0.50 * max(0.1,abs(swdav)) !Increase PAR to 50 SW if (lsplitleaf) then PARdir = 0.50 * max(0.1,abs(swdir(i,j,1))) PARdif = 0.50 * max(0.1,abs(swdif(i,j,1))) @@ -1881,14 +1881,6 @@ subroutine do_lsm ! Calculate the light use efficiency alphac = alpha0 * (co2abs - CO2comp) / (co2abs + 2 * CO2comp) - ! Calculate upscaling from leaf to canopy: net flow CO2 into the plant (An) - tempy = alphac * Kx * PAR / (Am + Rdark) - An = (Am + Rdark) * (1 - 1.0 / (Kx * LAI(i,j)) * (E1(tempy * exp(-Kx*LAI(i,j))) - E1(tempy))) - - ! Calculate upscaling from leaf to canopy: CO2 conductance at canopy level - AGSa1 = 1.0 / (1 - f0) - Dstar = D0 / (AGSa1 * (f0 - fmin)) - if(lsplitleaf) then sinbeta = max(zenith(xtime*3600 + rtimee,xday,xlat,xlon), minsinbeta) kdrbl = 0.5 / sinbeta ! Direct radiation extinction coefficient for black leaves @@ -1937,28 +1929,33 @@ subroutine do_lsm end do !itg An = LAI(i,j) * sum(weight_g * Fnet) - gcco2 = LAI(i,j) * sum(weight_g * gnet) + gc_inf = LAI(i,j) * sum(weight_g * gnet) else !lsplitleaf - - ! Calculate upscaling from leaf to canopy: net flow CO2 into the plant (An) - tempy = alphac * Kx * PAR / (Am + Rdark) - An = (Am + Rdark) * (1 - 1.0 / (Kx * LAI(i,j)) * (E1(tempy * exp(-Kx*LAI(i,j))) - E1(tempy))) - gcco2 = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) - + + ! Calculate upscaling from leaf to canopy: net flow CO2 into the plant (An) + AGSa1 = 1.0 / (1 - f0) + Dstar = D0 / (AGSa1 * (f0 - fmin)) + + tempy = alphac * Kx * PAR / (Am + Rdark) + An = (Am + Rdark) * (1 - 1.0 / (Kx * LAI(i,j)) * (E1(tempy * exp(-Kx*LAI(i,j))) - E1(tempy))) + gc_inf = LAI(i,j) * (gmin/nuco2q + AGSa1 * fstr * An / ((co2abs - CO2comp) * (1 + Ds / Dstar))) + endif !lsplitleaf if (lrelaxgc) then if (gc_old_set) then - gc_inf = gcco2 gcco2 = gc_old(i,j) + min(kgc*rk3coef, 1.0) * (gc_inf - gc_old(i,j)) if (rk3step ==3) then gc_old(i,j) = gcco2 endif else + gcco2 = gc_inf gc_old(i,j) = gcco2 endif + else + gcco2 = gc_inf endif ! Calculate surface resistances for moisture and carbon dioxide From cc291b46988e606ee402f437ae98b4c4e8a66c03 Mon Sep 17 00:00:00 2001 From: Arnold Moene Date: Mon, 23 Apr 2018 10:20:13 +0200 Subject: [PATCH 60/88] Fixed error in direction of comparison of 'z' relative to zero (orginal test cut-off the resulting computation if the z was larger than eps1 rather than if it was less than eps1). Furthermore, replaced the rather arbitrary eps1 lower limit by the intrinsic function epsilon() (which gives a machine-dependent small value). --- src/modpois.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modpois.f90 b/src/modpois.f90 index 26405f5c..4fd6326d 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -286,7 +286,7 @@ subroutine solmpj do i=2,i1 bbk = bk + rhobf(kmax)*xyrt(i,j) z = bbk-ak*d(i,j,kmax-1) - if(abs(z)epsilon(0.0)) then p(i,j,kmax) = (p(i,j,kmax)-ak*p(i,j,kmax-1))/z else p(i,j,kmax) =0. From d42805d0b4728ac76124b666f6507c68e039712a Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Wed, 16 May 2018 17:12:13 +0200 Subject: [PATCH 61/88] Poisson solver bug fix --- src/modpois.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/modpois.f90 b/src/modpois.f90 index 26405f5c..42312cb5 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -286,6 +286,7 @@ subroutine solmpj do i=2,i1 bbk = bk + rhobf(kmax)*xyrt(i,j) z = bbk-ak*d(i,j,kmax-1) + !if(abs(z)>epsilon(0.0)) then if(abs(z) Date: Tue, 29 May 2018 21:39:48 +0200 Subject: [PATCH 62/88] Revert to modpois.f90 of DALES 4.1 --- src/modpois.f90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/modpois.f90 b/src/modpois.f90 index 42312cb5..8c5f4dff 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -229,20 +229,18 @@ subroutine solmpj ! copy times all included use modfft2d, only : fft2df, fft2db - use modglobal, only : kmax,dzf,dzh,i1,j1,ih,jh,eps1 + use modglobal, only : kmax,dzf,dzh,i1,j1,ih,jh use modfields, only : rhobf, rhobh implicit none real :: a(kmax),b(kmax),c(kmax) ! allocate d in the same shape as p and xyrt - real, allocatable :: d(:,:,:) + real :: d(2-ih:i1+ih,2-jh:j1+jh,kmax) real z,ak,bk,bbk integer i, j, k - allocate(d(2-ih:i1+ih,2-jh:j1+jh,kmax)) - ! Forward FFT call fft2df(p,ih,jh) @@ -286,8 +284,7 @@ subroutine solmpj do i=2,i1 bbk = bk + rhobf(kmax)*xyrt(i,j) z = bbk-ak*d(i,j,kmax-1) - !if(abs(z)>epsilon(0.0)) then - if(abs(z) Date: Mon, 6 Aug 2018 13:05:05 +0200 Subject: [PATCH 63/88] Fix for #37 - momentum advection in advec_5th and advec_52 routines --- src/advec_52.f90 | 2 +- src/advec_5th.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/advec_52.f90 b/src/advec_52.f90 index 3bce8797..02b2ab3f 100644 --- a/src/advec_52.f90 +++ b/src/advec_52.f90 @@ -291,7 +291,7 @@ subroutine advecv_52(putin, putout) +(& (v0(i,j+1,k)+v0(i,j,k))/60.& *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j+1,k))/60.& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& -(v0(i,j,k)+v0(i,j-1,k))/60.& *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& diff --git a/src/advec_5th.f90 b/src/advec_5th.f90 index 6eca32a5..75a51df3 100644 --- a/src/advec_5th.f90 +++ b/src/advec_5th.f90 @@ -507,7 +507,7 @@ subroutine advecv_5th(putin, putout) +(& (v0(i,j+1,k)+v0(i,j,k))/60.& *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j+1,k))/60.& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& -(v0(i,j,k)+v0(i,j-1,k))/60.& *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& @@ -567,7 +567,7 @@ subroutine advecv_5th(putin, putout) +(& (v0(i,j+1,k)+v0(i,j,k))/60.& *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j+1,k))/60.& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& -(v0(i,j,k)+v0(i,j-1,k))/60.& *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& From ca1e991a970f08457f14ea9e70f397f1ae26e2f3 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 3 Aug 2018 14:05:10 +0200 Subject: [PATCH 64/88] fix typo in advecv_2nd - non-equidistant case --- src/advec_2nd.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/advec_2nd.f90 b/src/advec_2nd.f90 index de1be9be..c622311d 100644 --- a/src/advec_2nd.f90 +++ b/src/advec_2nd.f90 @@ -330,7 +330,7 @@ subroutine advecv_2nd(putin, putout) ip=i+1 putout(i,j,k) = putout(i,j,k)- (1./rhobf(k))*( & (w0(i,j,kp)+w0(i,jm,kp)) & - *(rhobf(k) * putin(i,j,kp)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(kp) )/ dzh(kp) & + *(rhobf(kp) * putin(i,j,kp)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(kp) )/ dzh(kp) & -(w0(i,j,k)+w0(i,jm,k)) & *(rhobf(km) * putin(i,j,km)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(km)) / dzh(k) & ) / (4. * dzf(k)) From b3d87987e45d9ac040ed4ecdc5d15833a66258bc Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 4 Jul 2017 16:38:41 +0200 Subject: [PATCH 65/88] add null advection option iadv_null=0 for scalar variables --- src/advection.f90 | 18 ++++++++++++++++-- src/modglobal.f90 | 1 + 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/advection.f90 b/src/advection.f90 index 5f8fc679..0246112d 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -28,7 +28,7 @@ subroutine advection use modglobal, only : lmoist, nsv, iadv_mom,iadv_tke,iadv_thl,iadv_qt,iadv_sv, & - iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid + iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid,iadv_null use modfields, only : u0,up,v0,vp,w0,wp,e120,e12p,thl0,thlp,qt0,qtp,sv0,svp use modsubgrid, only : lsmagorinsky use advec_hybrid, only : advecc_hybrid @@ -60,6 +60,9 @@ subroutine advection call advecu_5th(u0,up) call advecv_5th(v0,vp) call advecw_5th(w0,wp) + case(iadv_null) + ! null advection scheme + stop "Null advection scheme selected for iadv_mom - probably a bad idea." case default stop "Unknown advection scheme " end select @@ -80,6 +83,9 @@ subroutine advection call advecc_kappa(e120,e12p) case(iadv_hybrid) call advecc_hybrid(e120,e12p) + case(iadv_null) + ! null advection scheme + stop "Null advection scheme selected for iadv_tke - probably a bad idea." case default stop "Unknown advection scheme " end select @@ -102,6 +108,9 @@ subroutine advection call advecc_upw(thl0,thlp) case(iadv_hybrid) call advecc_hybrid(thl0,thlp) + case(iadv_null) + ! null advection scheme + stop "Null advection scheme selected for iadv_thl - probably a bad idea." case default stop "Unknown advection scheme " end select @@ -123,6 +132,9 @@ subroutine advection call advecc_upw(qt0,qtp) case(iadv_hybrid) call advecc_hybrid(qt0,qtp) + case(iadv_null) + ! null advection scheme + stop "Null advection scheme selected for iadv_qt - probably a bad idea." case default stop "Unknown advection scheme " end select @@ -144,7 +156,9 @@ subroutine advection case(iadv_upw) call advecc_upw(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_hybrid) - call advecc_hybrid(sv0(:,:,:,n),svp(:,:,:,n)) + call advecc_hybrid(sv0(:,:,:,n),svp(:,:,:,n)) + case(iadv_null) + ! null advection scheme - do nothing case default stop "Unknown advection scheme " end select diff --git a/src/modglobal.f90 b/src/modglobal.f90 index bfc416f9..e851a794 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -122,6 +122,7 @@ module modglobal !Advection scheme integer :: iadv_mom = 5, iadv_tke = -1, iadv_thl = -1,iadv_qt = -1,iadv_sv(100) = -1 + integer, parameter :: iadv_null = 0 integer, parameter :: iadv_upw = 1 integer, parameter :: iadv_cd2 = 2 integer, parameter :: iadv_5th = 5 From b8ce2d0df24be5ab84987b8a103ef6778d76ab11 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 3 Aug 2018 10:52:44 +0200 Subject: [PATCH 66/88] Stop with error message if advection is incompatible with non-equidistant grid --- src/advection.f90 | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/src/advection.f90 b/src/advection.f90 index 0246112d..1830aee7 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -28,7 +28,7 @@ subroutine advection use modglobal, only : lmoist, nsv, iadv_mom,iadv_tke,iadv_thl,iadv_qt,iadv_sv, & - iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid,iadv_null + iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid,iadv_null,leq use modfields, only : u0,up,v0,vp,w0,wp,e120,e12p,thl0,thlp,qt0,qtp,sv0,svp use modsubgrid, only : lsmagorinsky use advec_hybrid, only : advecc_hybrid @@ -41,22 +41,27 @@ subroutine advection call advecv_2nd(v0,vp) call advecw_2nd(w0,wp) case(iadv_5th) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecu_5th(u0,up) call advecv_5th(v0,vp) call advecw_5th(w0,wp) case(iadv_52) + if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecu_52(u0,up) call advecv_52(v0,vp) call advecw_52(w0,wp) case(iadv_cd6) + if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecu_6th(u0,up) call advecv_6th(v0,vp) call advecw_6th(w0,wp) case(iadv_62) + if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecu_62(u0,up) call advecv_62(v0,vp) call advecw_62(w0,wp) case(iadv_hybrid) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecu_5th(u0,up) call advecv_5th(v0,vp) call advecw_5th(w0,wp) @@ -72,16 +77,22 @@ subroutine advection case(iadv_cd2) call advecc_2nd(e120,e12p) case(iadv_5th) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(e120,e12p) case(iadv_52) + if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(e120,e12p) case(iadv_cd6) + if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(e120,e12p) case(iadv_62) + if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(e120,e12p) case(iadv_kappa) + if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." call advecc_kappa(e120,e12p) case(iadv_hybrid) + if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(e120,e12p) case(iadv_null) ! null advection scheme @@ -95,18 +106,25 @@ subroutine advection case(iadv_cd2) call advecc_2nd(thl0,thlp) case(iadv_5th) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(thl0,thlp) case(iadv_52) + if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(thl0,thlp) case(iadv_cd6) + if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(thl0,thlp) case(iadv_62) + if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(thl0,thlp) case(iadv_kappa) + if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." call advecc_kappa(thl0,thlp) case(iadv_upw) + if (.not. leq) stop "advec_upw does not support a non-uniform vertical grid." call advecc_upw(thl0,thlp) case(iadv_hybrid) + if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(thl0,thlp) case(iadv_null) ! null advection scheme @@ -119,18 +137,25 @@ subroutine advection case(iadv_cd2) call advecc_2nd(qt0,qtp) case(iadv_5th) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(qt0,qtp) case(iadv_52) + if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(qt0,qtp) case(iadv_cd6) + if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(qt0,qtp) case(iadv_62) + if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(qt0,qtp) case(iadv_kappa) + if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." call advecc_kappa(qt0,qtp) case(iadv_upw) + if (.not. leq) stop "advec_upw does not support a non-uniform vertical grid." call advecc_upw(qt0,qtp) case(iadv_hybrid) + if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(qt0,qtp) case(iadv_null) ! null advection scheme @@ -144,19 +169,26 @@ subroutine advection case(iadv_cd2) call advecc_2nd(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_5th) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_52) + if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_cd6) + if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_62) + if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_kappa) + if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." call advecc_kappa(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_upw) + if (.not. leq) stop "advec_upw does not support a non-uniform vertical grid." call advecc_upw(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_hybrid) - call advecc_hybrid(sv0(:,:,:,n),svp(:,:,:,n)) + if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." + call advecc_hybrid(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_null) ! null advection scheme - do nothing case default From e18eb56163ed3320fc173f6ccf0a086605e89939 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Mon, 26 Feb 2018 18:21:14 +0100 Subject: [PATCH 67/88] advec_52: if(k==1) out of k loop - much faster --- src/advec_52.f90 | 211 +++++++++++++++++++++++++---------------------- 1 file changed, 112 insertions(+), 99 deletions(-) diff --git a/src/advec_52.f90 b/src/advec_52.f90 index 02b2ab3f..bdf5ab0d 100644 --- a/src/advec_52.f90 +++ b/src/advec_52.f90 @@ -46,7 +46,7 @@ subroutine advecc_52(putin, putout) ! real :: rhobfinvk real :: inv2dzfk, rhobf_p, rhobf_m - integer :: i,j,k + integer :: i,j,k,jb !if (leq) then @@ -58,43 +58,53 @@ subroutine advecc_52(putin, putout) ! end do ! end do - do k=1,kmax + + + k = 1 + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -abs(u0(i+1,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -u0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +abs(u0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -abs(v0(i,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -v0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +abs(v0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k))) & + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + ) * inv2dzfk & + ) + end do + end do + + !do jb = 2,j1,16 + do k=2,kmax !rhobfinvk = 1./rhobf(k) inv2dzfk = 1./(2. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) - if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) - do j=2,j1 + rhobf_m = rhobf(k-1)/rhobf(k) + do j=2,j1 + !do j=jb,min(jb+16-1,j1) do i=2,i1 - if(k==1) then - - putout(i,j,k) = putout(i,j,k)- ( & - ( & - u0(i+1,j,k)/60.& - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -abs(u0(i+1,j,k))/60.& - *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& - -u0(i,j,k)/60.& - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - +abs(u0(i,j,k))/60.& - *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& - )*dxi& - +(& - v0(i,j+1,k)/60.& - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -abs(v0(i,j+1,k))/60.& - *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& - -v0(i,j,k)/60.& - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - +abs(v0(i,j,k))/60.& - *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k))) & - )* dyi & - + ( & - w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & - ) * inv2dzfk & - ) - - else putout(i,j,k) = putout(i,j,k)- ( & ( & u0(i+1,j,k)/60.& @@ -121,11 +131,12 @@ subroutine advecc_52(putin, putout) -w0(i,j,k) * (rhobf_m * putin(i,j,k-1) + putin(i,j,k)) & ) * inv2dzfk & ) - end if + end do end do - end do + end do +! end do end subroutine advecc_52 @@ -153,39 +164,42 @@ subroutine advecu_52(putin,putout) ! end do ! end do - do k=1,kmax + k = 1 + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + (& + (u0(i+1,j,k)+u0(i,j,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i,j,k)))*(u0(i+1,j,k)+u0(i,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i-1,j,k)))*(u0(i,j,k)+u0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5 & + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i-1,j+1,k)))*(v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i-1,j,k)))*(v0(i,j,k)+v0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + ( rhobf(k+1)*putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & + ) / (4.*dzf(k)) & + ) + end do + end do + + do k=2,kmax do j=2,j1 do i=2,i1 - if(k==1) then - - putout(i,j,k) = putout(i,j,k)- ( & - (& - (u0(i+1,j,k)+u0(i,j,k))/60.& - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -sign(1.,(u0(i+1,j,k)+u0(i,j,k)))*(u0(i+1,j,k)+u0(i,j,k))/60.& - *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& - -(u0(i,j,k)+u0(i-1,j,k))/60.& - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - +sign(1.,(u0(i,j,k)+u0(i-1,j,k)))*(u0(i,j,k)+u0(i-1,j,k))/60.& - *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& - )*dxi5 & - +(& - (v0(i,j+1,k)+v0(i-1,j+1,k))/60.& - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,(v0(i,j+1,k)+v0(i-1,j+1,k)))*(v0(i,j+1,k)+v0(i-1,j+1,k))/60.& - *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& - -(v0(i,j,k)+v0(i-1,j,k))/60.& - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - +sign(1.,(v0(i,j,k)+v0(i-1,j,k)))*(v0(i,j,k)+v0(i-1,j,k))/60.& - *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& - )* dyi5 & - +(1./rhobf(k))*( & - ( rhobf(k+1)*putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & - ) / (4.*dzf(k)) & - ) - - else putout(i,j,k) = putout(i,j,k)- ( & ( & (u0(i+1,j,k)+u0(i,j,k))/60.& @@ -212,7 +226,6 @@ subroutine advecu_52(putin,putout) -(rhobf(k) * putin(i,j,k) + rhobf(k-1) * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & ) / (4. * dzf(k)) & ) - end if end do end do @@ -244,39 +257,40 @@ subroutine advecv_52(putin, putout) ! end do !end do - do k=1,kmax - do j=2,j1 - do i=2,i1 - - if(k==1) then - + k = 1 + do j=2,j1 + do i=2,i1 putout(i,j,k) = putout(i,j,k)- ( & - ( & - (u0(i+1,j,k)+u0(i+1,j-1,k))/60.& - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -sign(1.,(u0(i+1,j,k)+u0(i+1,j-1,k)))*(u0(i+1,j,k)+u0(i+1,j-1,k))/60.& - *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& - -(u0(i,j,k)+u0(i,j-1,k))/60.& - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - +sign(1.,(u0(i,j,k)+u0(i,j-1,k)))*(u0(i,j,k)+u0(i,j-1,k))/60.& - *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& - )*dxi5& - +(& - (v0(i,j+1,k)+v0(i,j,k))/60.& - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& - *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& - -(v0(i,j,k)+v0(i,j-1,k))/60.& - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - +sign(1.,(v0(i,j,k)+v0(i,j-1,k)))*(v0(i,j,k)+v0(i,j-1,k))/60.& - *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& - )* dyi5 & - +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf(k+1) * putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) & - ) / (4. * dzf(k)) & - ) - - else + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i+1,j-1,k)))*(u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i,j-1,k)))*(u0(i,j,k)+u0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i,j-1,k)))*(v0(i,j,k)+v0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf(k+1) * putin(i,j,k+1) + rhobf(k) * putin(i,j,k)) & + ) / (4. * dzf(k)) & + ) + end do + end do + + do k=2,kmax + do j=2,j1 + do i=2,i1 putout(i,j,k) = putout(i,j,k)- ( & ( & (u0(i+1,j,k)+u0(i+1,j-1,k))/60.& @@ -303,7 +317,6 @@ subroutine advecv_52(putin, putout) -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf(k-1) * putin(i,j,k-1) + rhobf(k) * putin(i,j,k)) & ) / (4. * dzf(k)) & ) - end if end do end do From 7ca475f84fbc5af6fe32f90b679c9c978483ae1a Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 2 Mar 2018 11:58:21 +0100 Subject: [PATCH 68/88] advec_62: if k==1 out of loops, faster. --- src/advec_62.f90 | 169 ++++++++++++++++++++++++----------------------- 1 file changed, 88 insertions(+), 81 deletions(-) diff --git a/src/advec_62.f90 b/src/advec_62.f90 index 48df0543..7c744729 100644 --- a/src/advec_62.f90 +++ b/src/advec_62.f90 @@ -53,35 +53,40 @@ subroutine advecc_62(putin, putout) ! end do ! end do - do k=1,kmax + k = 1 + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + do j=2,j1 + do i=2,i1 + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -u0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -v0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & + ) * inv2dzfk & + ) + end do + end do + + + do k=2,kmax inv2dzfk = 1./(2. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) - if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) do j=2,j1 do i=2,i1 - if(k==1) then - - putout(i,j,k) = putout(i,j,k)- ( & - ( & - u0(i+1,j,k)/60. & - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -u0(i,j,k)/60. & - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - )*dxi& - +(& - v0(i,j+1,k)/60. & - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -v0(i,j,k)/60. & - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - )* dyi & - + ( & - w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) & - ) * inv2dzfk & - ) - - else putout(i,j,k) = putout(i,j,k)- ( & ( & @@ -101,14 +106,10 @@ subroutine advecc_62(putin, putout) -w0(i,j,k) * (rhobf_m * putin(i,j,k-1) + putin(i,j,k)) & ) * inv2dzfk & ) - end if end do end do end do - -! end if - end subroutine advecc_62 @@ -137,36 +138,42 @@ subroutine advecu_62(putin,putout) ! end do ! end do - do k=1,kmax + + k = 1 + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i,j,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + + ( & + (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & + ) * inv4dzfk & + ) + end do + end do + + + do k=2,kmax inv4dzfk = 1./(4. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) - if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) do j=2,j1 do i=2,i1 - if(k==1) then - - putout(i,j,k) = putout(i,j,k)- ( & - ( & - (u0(i+1,j,k)+u0(i,j,k))/60. & - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -(u0(i,j,k)+u0(i-1,j,k))/60. & - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - )*dxi5& - +(& - (v0(i,j+1,k)+v0(i-1,j+1,k))/60. & - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -(v0(i,j,k)+v0(i-1,j,k))/60. & - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - )* dyi5 & - + ( & - (rhobf_p * putin(i,j,k+1) + putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & - ) * inv4dzfk & - ) - - else - putout(i,j,k) = putout(i,j,k)- ( & (& (u0(i+1,j,k)+u0(i,j,k))/60. & @@ -185,7 +192,6 @@ subroutine advecu_62(putin,putout) -(putin(i,j,k) + rhobf_m * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & ) * inv4dzfk & ) - end if end do end do @@ -221,36 +227,41 @@ subroutine advecv_62(putin, putout) ! end do ! end do - do k=1,kmax + k = 1 + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + +( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf_p * putin(i,j,k+1)+putin(i,j,k)) & + ) * inv4dzfk & + ) + end do + end do + + do k=2,kmax inv4dzfk = 1./(4. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) - if (k > 1) rhobf_m = rhobf(k-1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) do j=2,j1 do i=2,i1 - - if(k==1) then - - putout(i,j,k) = putout(i,j,k)- ( & - ( & - (u0(i+1,j,k)+u0(i+1,j-1,k))/60. & - *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& - -(u0(i,j,k)+u0(i,j-1,k))/60. & - *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& - )*dxi5& - +(& - (v0(i,j+1,k)+v0(i,j,k))/60. & - *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& - -(v0(i,j,k)+v0(i,j-1,k))/60. & - *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& - )* dyi5 & - +( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf_p * putin(i,j,k+1)+putin(i,j,k)) & - ) * inv4dzfk & - ) - - else - + putout(i,j,k) = putout(i,j,k)- ( & ( & (u0(i+1,j,k)+u0(i+1,j-1,k))/60. & @@ -269,14 +280,10 @@ subroutine advecv_62(putin, putout) -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf_m * putin(i,j,k-1) + putin(i,j,k))& ) * inv4dzfk & ) - end if - end do end do end do -! end if - end subroutine advecv_62 From 4534fb8c638b27357e85e3350d0f91aac7e4497f Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 3 Aug 2018 14:24:08 +0200 Subject: [PATCH 69/88] add non-uniform grid support to advec_52, as in advec_2nd --- src/advec_52.f90 | 285 ++++++++++++++++++++++++++++++++++++---------- src/advection.f90 | 8 +- 2 files changed, 229 insertions(+), 64 deletions(-) diff --git a/src/advec_52.f90 b/src/advec_52.f90 index bdf5ab0d..77ab73c3 100644 --- a/src/advec_52.f90 +++ b/src/advec_52.f90 @@ -36,30 +36,18 @@ !> Advection at cell center subroutine advecc_52(putin, putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi,dyi,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi,dyi,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency -! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin -! real :: rhobfinvk real :: inv2dzfk, rhobf_p, rhobf_m - integer :: i,j,k,jb - - !if (leq) then - -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) -! end do -! end do -! end do - + integer :: i,j,k - + if (leq) then + k = 1 inv2dzfk = 1./(2. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) @@ -95,15 +83,12 @@ subroutine advecc_52(putin, putout) end do end do - !do jb = 2,j1,16 do k=2,kmax - !rhobfinvk = 1./rhobf(k) inv2dzfk = 1./(2. * dzf(k)) rhobf_p = rhobf(k+1)/rhobf(k) rhobf_m = rhobf(k-1)/rhobf(k) do j=2,j1 - !do j=jb,min(jb+16-1,j1) - do i=2,i1 + do i=2,i1 putout(i,j,k) = putout(i,j,k)- ( & ( & @@ -136,7 +121,81 @@ subroutine advecc_52(putin, putout) end do end do end do -! end do + + else ! non-equidistant grid + k = 1 + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -abs(u0(i+1,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -u0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +abs(u0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -abs(v0(i,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -v0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +abs(v0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k))) & + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) * dzf(k) + putin(i,j,k) * dzf(k+1) ) / dzh(k+1) & + ) * inv2dzfk & + ) + end do + end do + + do k=2,kmax + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -abs(u0(i+1,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -u0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +abs(u0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -abs(v0(i,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -v0(i,j,k)/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +abs(v0(i,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) * dzf(k) + putin(i,j,k) * dzf(k+1) ) / dzh(k+1) & + -w0(i,j,k ) * (rhobf_m * putin(i,j,k-1) * dzf(k) + putin(i,j,k) * dzf(k-1) ) / dzh(k) & + ) * inv2dzfk & + ) + end do + end do + end do + + end if end subroutine advecc_52 @@ -144,26 +203,16 @@ end subroutine advecc_52 !> Advection at the u point. subroutine advecu_52(putin,putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the u field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - !if (leq) then - -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) -! end do -! end do -! end do - +if (leq) then k = 1 do j=2,j1 do i=2,i1 @@ -223,13 +272,81 @@ subroutine advecu_52(putin,putout) )* dyi5 & +(1./rhobf(k))*( & (rhobf(k) * putin(i,j,k) + rhobf(k+1) * putin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & - -(rhobf(k) * putin(i,j,k) + rhobf(k-1) * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & + -(rhobf(k) * putin(i,j,k) + rhobf(k-1) * putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & ) / (4. * dzf(k)) & ) end do end do + end do + +else ! non-equidistant grid + k = 1 + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + (& + (u0(i+1,j,k)+u0(i,j,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i,j,k)))*(u0(i+1,j,k)+u0(i,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i-1,j,k)))*(u0(i,j,k)+u0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5 & + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i-1,j+1,k)))*(v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i-1,j,k)))*(v0(i,j,k)+v0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + ( rhobf(k+1) * putin(i,j,k+1)*dzf(k) + rhobf(k) * putin(i,j,k) *dzf(k+1) ) / dzh(k+1) *( w0(i,j,k+1)+ w0(i-1,j,k+1) ) & + ) / (4.*dzf(k)) & + ) + end do end do + + do k=2,kmax + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i,j,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i,j,k)))*(u0(i+1,j,k)+u0(i,j,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i-1,j,k)))*(u0(i,j,k)+u0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i-1,j+1,k)))*(v0(i,j+1,k)+v0(i-1,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i-1,j,k)))*(v0(i,j,k)+v0(i-1,j,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + ( rhobf(k+1) * putin(i,j,k+1)*dzf(k) + rhobf(k) * putin(i,j,k) *dzf(k+1) ) / dzh(k+1) *( w0(i,j,k+1)+ w0(i-1,j,k+1) ) & + -( rhobf(k) * putin(i,j,k) *dzf(k-1) + rhobf(k-1) * putin(i,j,k-1)*dzf(k) ) / dzh(k) *( w0(i,j,k) + w0(i-1,j,k) ) & + ) / (4. * dzf(k)) & + ) + end do + end do + end do +end if end subroutine advecu_52 @@ -237,25 +354,15 @@ end subroutine advecu_52 !> Advection at the v point. subroutine advecv_52(putin, putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin - integer :: i,j,k - !if (leq) then - - !do k=1,k1 - ! do j=2-jh,j1+jh - ! do i=2-ih,i1+ih - ! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - ! end do - ! end do - !end do + if (leq) then k = 1 do j=2,j1 @@ -321,6 +428,73 @@ subroutine advecv_52(putin, putout) end do end do end do +else ! non-equidistant grid + k = 1 + do j=2,j1 + do i=2,i1 + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i+1,j-1,k)))*(u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i,j-1,k)))*(u0(i,j,k)+u0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i,j-1,k)))*(v0(i,j,k)+v0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) * (rhobf(k+1) * putin(i,j,k+1)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(k+1)) / dzh(k+1) & + ) / (4. * dzf(k)) & + ) + end do + end do + + do k=2,kmax + do j=2,j1 + do i=2,i1 + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -sign(1.,(u0(i+1,j,k)+u0(i+1,j-1,k)))*(u0(i+1,j,k)+u0(i+1,j-1,k))/60.& + *(10.*(putin(i+1,j,k)-putin(i,j,k))-5.*(putin(i+2,j,k)-putin(i-1,j,k))+(putin(i+3,j,k)-putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + +sign(1.,(u0(i,j,k)+u0(i,j-1,k)))*(u0(i,j,k)+u0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i-1,j,k))-5.*(putin(i+1,j,k)-putin(i-2,j,k))+(putin(i+2,j,k)-putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60.& + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -sign(1.,(v0(i,j+1,k)+v0(i,j,k)))*(v0(i,j+1,k)+v0(i,j+1,k))/60.& + *(10.*(putin(i,j+1,k)-putin(i,j,k))-5.*(putin(i,j+2,k)-putin(i,j-1,k))+(putin(i,j+3,k)-putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60.& + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + +sign(1.,(v0(i,j,k)+v0(i,j-1,k)))*(v0(i,j,k)+v0(i,j-1,k))/60.& + *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& + )* dyi5 & + +(1./rhobf(k))*( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) * (rhobf(k+1) * putin(i,j,k+1)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(k+1)) / dzh(k+1) & + -(w0(i,j,k) + w0(i,j-1,k)) * (rhobf(k-1) * putin(i,j,k-1)*dzf(k) + rhobf(k) * putin(i,j,k)*dzf(k-1)) / dzh(k) & + ) / (4. * dzf(k)) & + ) + ! note advec_2nd had rhobf(k) instead of rhobf(k+1) on top row, which seems wrong + ! fixed here + end do + end do + end do +end if end subroutine advecv_52 @@ -328,26 +502,17 @@ end subroutine advecv_52 !> Advection at the w point. subroutine advecw_52(putin, putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzh + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzh,dzh,leq use modfields, only : u0, v0, w0,rhobh implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - - !if (leq) then - - !do k=1,k1 - ! do j=2-jh,j1+jh - ! do i=2-ih,i1+ih - ! rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) - ! end do - ! end do - !end do - + ! if (leq) then + ! FJ: judging from advec_2nd, equidistant and non-equidistant cases are similar + do k=2,kmax do j=2,j1 do i=2,i1 @@ -381,4 +546,6 @@ subroutine advecw_52(putin, putout) end do end do + + end subroutine advecw_52 diff --git a/src/advection.f90 b/src/advection.f90 index 1830aee7..e46aff13 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -35,6 +35,9 @@ subroutine advection implicit none integer :: n + ! leq = .false. ! for testing that the non-uniform advection routines agree with the uniform ones + ! when the grid is uniform + select case(iadv_mom) case(iadv_cd2) call advecu_2nd(u0,up) @@ -46,7 +49,6 @@ subroutine advection call advecv_5th(v0,vp) call advecw_5th(w0,wp) case(iadv_52) - if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecu_52(u0,up) call advecv_52(v0,vp) call advecw_52(w0,wp) @@ -80,7 +82,6 @@ subroutine advection if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(e120,e12p) case(iadv_52) - if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(e120,e12p) case(iadv_cd6) if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." @@ -109,7 +110,6 @@ subroutine advection if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(thl0,thlp) case(iadv_52) - if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(thl0,thlp) case(iadv_cd6) if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." @@ -140,7 +140,6 @@ subroutine advection if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(qt0,qtp) case(iadv_52) - if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(qt0,qtp) case(iadv_cd6) if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." @@ -172,7 +171,6 @@ subroutine advection if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." call advecc_5th(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_52) - if (.not. leq) stop "advec_52 does not support a non-uniform vertical grid." call advecc_52(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_cd6) if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." From bc9606e86b5ddb5a15f8e4c6d5d4f68dcf9b4c6d Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 3 Aug 2018 14:58:05 +0200 Subject: [PATCH 70/88] add non-uniform grid support to advec_62, as in advec_2nd --- src/advec_62.f90 | 232 ++++++++++++++++++++++++++++++++++++---------- src/advection.f90 | 5 - 2 files changed, 185 insertions(+), 52 deletions(-) diff --git a/src/advec_62.f90 b/src/advec_62.f90 index 7c744729..929c8073 100644 --- a/src/advec_62.f90 +++ b/src/advec_62.f90 @@ -31,27 +31,18 @@ !> Advection at cell center subroutine advecc_62(putin, putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi,dyi,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi,dyi,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency -! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real :: inv2dzfk, rhobf_p, rhobf_m integer :: i,j,k - !if (leq) then - -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) -! end do -! end do -! end do + if (leq) then k = 1 inv2dzfk = 1./(2. * dzf(k)) @@ -109,35 +100,84 @@ subroutine advecc_62(putin, putout) end do end do + end do +else ! non-equidistant grid + k = 1 + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + do j=2,j1 + do i=2,i1 + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -u0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -v0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) * dzf(k) + putin(i,j,k) * dzf(k+1) ) / dzh(k+1) & + ) * inv2dzfk & + ) + end do end do + + + do k=2,kmax + inv2dzfk = 1./(2. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + u0(i+1,j,k)/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -u0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi& + +(& + v0(i,j+1,k)/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -v0(i,j,k)/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi & + + ( & + w0(i,j,k+1) * (rhobf_p * putin(i,j,k+1) * dzf(k) + putin(i,j,k) * dzf(k+1) ) / dzh(k+1) & + -w0(i,j,k ) * (rhobf_m * putin(i,j,k-1) * dzf(k) + putin(i,j,k) * dzf(k-1) ) / dzh(k) & + ) * inv2dzfk & + ) + + end do + end do + end do + end if end subroutine advecc_62 !> Advection at the u point. subroutine advecu_62(putin,putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the u field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency -! real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real :: inv4dzfk, rhobf_p, rhobf_m integer :: i,j,k - !if (leq) then - -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) -! end do -! end do -! end do - + if (leq) then k = 1 inv4dzfk = 1./(4. * dzf(k)) @@ -196,8 +236,66 @@ subroutine advecu_62(putin,putout) end do end do end do + else ! non-equidistant grid + k = 1 + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i,j,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + + ( & + (putin(i,j,k) * dzf(k+1) + rhobf_p * putin(i,j,k+1)*dzf(k)) * (w0(i,j,k+1)+w0(i-1,j,k+1)) / dzh(k+1) & + ) * inv4dzfk & + ) + end do + end do + + + do k=2,kmax + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + (& + (u0(i+1,j,k)+u0(i,j,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i-1,j+1,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i-1,j,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + + ( & + (putin(i,j,k) * dzf(k+1) + rhobf_p * putin(i,j,k+1) *dzf(k)) * (w0(i,j,k+1)+w0(i-1,j,k+1)) / dzh(k+1) & + -(putin(i,j,k) * dzf(k-1) + rhobf_m * putin(i,j,k-1) *dzf(k)) * (w0(i,j,k )+w0(i-1,j,k )) / dzh(k) & + ) * inv4dzfk & + ) -! end if + end do + end do + end do + + end if end subroutine advecu_62 @@ -206,26 +304,17 @@ end subroutine advecu_62 !> Advection at the v point. subroutine advecv_62(putin, putout) - use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf + use modglobal, only : i1,ih,j1,jh,k1,kmax,dxi5,dyi5,dzf,dzh,leq use modfields, only : u0, v0, w0,rhobf implicit none real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real :: inv4dzfk, rhobf_p, rhobf_m integer :: i,j,k - !if (leq) then - -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) -! end do -! end do -! end do + if (leq) then k = 1 inv4dzfk = 1./(4. * dzf(k)) @@ -248,7 +337,7 @@ subroutine advecv_62(putin, putout) *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & +( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf_p * putin(i,j,k+1)+putin(i,j,k)) & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf_p * putin(i,j,k+1)+putin(i,j,k)) & ) * inv4dzfk & ) end do @@ -276,13 +365,71 @@ subroutine advecv_62(putin, putout) *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& )* dyi5 & + ( & - (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf_p * putin(i,j,k+1) + putin(i,j,k))& - -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf_m * putin(i,j,k-1) + putin(i,j,k))& + (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf_p * putin(i,j,k+1) + putin(i,j,k))& + -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf_m * putin(i,j,k-1) + putin(i,j,k))& ) * inv4dzfk & ) end do end do end do + else ! non-equidistant grid + k = 1 + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + +( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) * (rhobf_p * putin(i,j,k+1)*dzf(k) + putin(i,j,k)*dzf(k+1)) / dzh(k+1)& + ) * inv4dzfk & + ) + end do + end do + + do k=2,kmax + inv4dzfk = 1./(4. * dzf(k)) + rhobf_p = rhobf(k+1)/rhobf(k) + rhobf_m = rhobf(k-1)/rhobf(k) + + do j=2,j1 + do i=2,i1 + + putout(i,j,k) = putout(i,j,k)- ( & + ( & + (u0(i+1,j,k)+u0(i+1,j-1,k))/60. & + *(37.*(putin(i+1,j,k)+putin(i,j,k))-8.*(putin(i+2,j,k)+putin(i-1,j,k))+(putin(i+3,j,k)+putin(i-2,j,k)))& + -(u0(i,j,k)+u0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i-1,j,k))-8.*(putin(i+1,j,k)+putin(i-2,j,k))+(putin(i+2,j,k)+putin(i-3,j,k)))& + )*dxi5& + +(& + (v0(i,j+1,k)+v0(i,j,k))/60. & + *(37.*(putin(i,j+1,k)+putin(i,j,k))-8.*(putin(i,j+2,k)+putin(i,j-1,k))+(putin(i,j+3,k)+putin(i,j-2,k)))& + -(v0(i,j,k)+v0(i,j-1,k))/60. & + *(37.*(putin(i,j,k)+putin(i,j-1,k))-8.*(putin(i,j+1,k)+putin(i,j-2,k))+(putin(i,j+2,k)+putin(i,j-3,k)))& + )* dyi5 & + + ( & + (w0(i,j,k+1)+w0(i,j-1,k+1)) * (rhobf_p * putin(i,j,k+1) * dzf(k) + putin(i,j,k) * dzf(k+1)) / dzh(k+1)& + -(w0(i,j,k) +w0(i,j-1,k)) * (rhobf_m * putin(i,j,k-1) * dzf(k) + putin(i,j,k) * dzf(k-1)) / dzh(k) & + ) * inv4dzfk & + ) + end do + end do + end do +end if end subroutine advecv_62 @@ -297,21 +444,12 @@ subroutine advecw_62(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - !real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin real :: inv4dzhk, rhobh_p, rhobh_m integer :: i,j,k !if (leq) then -! do k=1,k1 -! do j=2-jh,j1+jh -! do i=2-ih,i1+ih -! rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) -! end do -! end do -! end do - do k=2,kmax inv4dzhk = 1./(4. * dzh(k)) rhobh_p = rhobh(k+1)/rhobh(k) diff --git a/src/advection.f90 b/src/advection.f90 index e46aff13..399b2cc0 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -58,7 +58,6 @@ subroutine advection call advecv_6th(v0,vp) call advecw_6th(w0,wp) case(iadv_62) - if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecu_62(u0,up) call advecv_62(v0,vp) call advecw_62(w0,wp) @@ -87,7 +86,6 @@ subroutine advection if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(e120,e12p) case(iadv_62) - if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(e120,e12p) case(iadv_kappa) if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." @@ -115,7 +113,6 @@ subroutine advection if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(thl0,thlp) case(iadv_62) - if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(thl0,thlp) case(iadv_kappa) if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." @@ -145,7 +142,6 @@ subroutine advection if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(qt0,qtp) case(iadv_62) - if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(qt0,qtp) case(iadv_kappa) if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." @@ -176,7 +172,6 @@ subroutine advection if (.not. leq) stop "advec_6th does not support a non-uniform vertical grid." call advecc_6th(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_62) - if (.not. leq) stop "advec_62 does not support a non-uniform vertical grid." call advecc_62(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_kappa) if (.not. leq) stop "advec_kappa does not support a non-uniform vertical grid." From 6b9a3e41b7c4a51a77cd72bee2acdf94a9fe14ba Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 31 Jul 2018 16:04:57 +0200 Subject: [PATCH 71/88] remove rhoputin from advec_5th --- src/advec_5th.f90 | 204 +++++++++++++++++++--------------------------- 1 file changed, 83 insertions(+), 121 deletions(-) diff --git a/src/advec_5th.f90 b/src/advec_5th.f90 index 75a51df3..4e861989 100644 --- a/src/advec_5th.f90 +++ b/src/advec_5th.f90 @@ -43,19 +43,9 @@ subroutine advecc_5th(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the cell centered field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - !if (leq) then - - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do do k=1,kmax do j=2,j1 @@ -85,7 +75,7 @@ subroutine advecc_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k))) & )* dyi & +(1./rhobf(1))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1) + rhoputin(i,j,k)) & + w0(i,j,k+1) * (rhobf(k+1)*putin(i,j,k+1) + rhobf(k)*putin(i,j,k)) & ) / ( 2. * dzf(k) ) & ) @@ -114,8 +104,8 @@ subroutine advecc_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi & +(1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - -w0(i,j,k) * (rhoputin(i,j,k-1)+rhoputin(i,j,k)) & + w0(i,j,k+1) * (rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k)) & + -w0(i,j,k) * (rhobf(k-1)*putin(i,j,k-1)+rhobf(k)*putin(i,j,k)) & ) / ( 2. * dzf(k) ) & ) @@ -145,12 +135,12 @@ subroutine advecc_5th(putin, putout) )* dyi & +(1/rhobf(k))*( & w0(i,j,k+1)/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,w0(i,j,k+1))*w0(i,j,k+1)/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& - -w0(i,j,k) * (rhoputin(i,j,k-1)+rhoputin(i,j,k))/2. & + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& + -w0(i,j,k) * (rhobf(k-1)*putin(i,j,k-1)+rhobf(k)*putin(i,j,k))/2. & ) / ( dzf(k) ) & ) elseif(k==kmax-2) then @@ -177,13 +167,13 @@ subroutine advecc_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi & +(1./rhobf(k))*( & - w0(i,j,k+1) * (rhoputin(i,j,k+1)+rhoputin(i,j,k))/2. & + w0(i,j,k+1) * (rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))/2. & -w0(i,j,k)/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,w0(i,j,k))*w0(i,j,k)/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / dzf(k) & ) else @@ -211,17 +201,17 @@ subroutine advecc_5th(putin, putout) )* dyi & +(1./rhobf(k))*( & w0(i,j,k+1)/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,w0(i,j,k+1))*w0(i,j,k+1)/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& -w0(i,j,k)/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,w0(i,j,k))*w0(i,j,k)/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / dzf(k) & ) @@ -244,18 +234,9 @@ subroutine advecu_5th(putin,putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the u field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do - !if (leq) then do k=1,kmax @@ -286,7 +267,7 @@ subroutine advecu_5th(putin,putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(1))*( & - ( rhoputin(i,j,k+1) + rhoputin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & + ( rhobf(k+1)*putin(i,j,k+1) + rhobf(k)*putin(i,j,k)) *(w0(i,j,k+1)+ w0(i-1,j,k+1)) & ) / (4.*dzf(k)) & ) @@ -314,8 +295,8 @@ subroutine advecu_5th(putin,putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & + (1./rhobf(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & + (rhobf(k)*putin(i,j,k)+rhobf(k+1)*putin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1)) & + -(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k )) & ) / (4. * dzf(k)) & ) @@ -344,12 +325,12 @@ subroutine advecu_5th(putin,putout) )* dyi5 & +(1/rhobf(k))*( & (w0(i,j,k+1)+w0(i-1,j,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k+1)+w0(i-1,j,k+1)))*(w0(i,j,k+1)+w0(i-1,j,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k ))/2. & + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& + -(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1) )*(w0(i,j,k )+w0(i-1,j,k ))/2. & ) / (2. * dzf(k)) & ) elseif(k==kmax-2) then @@ -375,13 +356,13 @@ subroutine advecu_5th(putin,putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )*dyi5& + (1./rhobf(k))*(& - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1))/2. & + (rhobf(k)*putin(i,j,k)+rhobf(k+1)*putin(i,j,k+1) )*(w0(i,j,k+1)+w0(i-1,j,k+1))/2. & -(w0(i,j,k)+w0(i-1,j,k))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i-1,j,k)))*(w0(i,j,k)+w0(i-1,j,k))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / (2. * dzf(k)) & ) @@ -410,17 +391,17 @@ subroutine advecu_5th(putin,putout) )*dyi5& + (1./rhobf(k))*(& (w0(i,j,k+1)+w0(i-1,j,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k+1)+w0(i-1,j,k+1)))*(w0(i,j,k+1)+w0(i-1,j,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& -(w0(i,j,k)+w0(i-1,j,k))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i-1,j,k)))*(w0(i,j,k)+w0(i-1,j,k))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / (2. * dzf(k)) & ) @@ -444,19 +425,10 @@ subroutine advecv_5th(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the v field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobf(k)*putin(i,j,k) - end do - end do - end do - !if (leq) then do k=1,kmax @@ -487,7 +459,7 @@ subroutine advecv_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(1))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhoputin(i,j,k+1)+rhoputin(i,j,k)) & + (w0(i,j,k+1)+w0(i,j-1,k+1)) *(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k)) & ) / (4. * dzf(k)) & ) @@ -515,8 +487,8 @@ subroutine advecv_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & +(1./rhobf(k))*( & - (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhoputin(i,j,k+1)+rhoputin(i,j,k)) & - -(w0(i,j,k) +w0(i,j-1,k)) *(rhoputin(i,j,k-1)+rhoputin(i,j,k)) & + (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k)) & + -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf(k-1)*putin(i,j,k-1)+rhobf(k)*putin(i,j,k)) & ) / (4. * dzf(k)) & ) elseif(k==kmax-2) then @@ -542,13 +514,13 @@ subroutine advecv_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )*dyi5& +(1./rhobf(k))*(& - (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhoputin(i,j,k+1)+rhoputin(i,j,k))/2. & + (w0(i,j,k+1)+w0(i,j-1,k+1))*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))/2. & -(w0(i,j,k)+w0(i,j-1,k))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i,j-1,k)))*(w0(i,j,k)+w0(i,j-1,k))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / (2. * dzf(k)) & ) elseif(k==3) then @@ -576,12 +548,12 @@ subroutine advecv_5th(putin, putout) )* dyi5 & +(1/rhobf(k))*( & (w0(i,j,k+1)+w0(i,j-1,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k+1)+w0(i,j-1,k+1)))*(w0(i,j,k+1)+w0(i,j-1,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& - -(w0(i,j,k) +w0(i,j-1,k)) *(rhoputin(i,j,k-1)+rhoputin(i,j,k))/2. & + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& + -(w0(i,j,k) +w0(i,j-1,k)) *(rhobf(k-1)*putin(i,j,k-1)+rhobf(k)*putin(i,j,k))/2. & ) / (2. * dzf(k)) & ) @@ -610,17 +582,17 @@ subroutine advecv_5th(putin, putout) )*dyi5& +(1./rhobf(k))*(& (w0(i,j,k+1)+w0(i,j-1,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k)*putin(i,j,k))-8.*(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)+rhobf(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k+1)+w0(i,j-1,k+1)))*(w0(i,j,k+1)+w0(i,j-1,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& + *(10.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k)*putin(i,j,k))-5.*(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-1)*putin(i,j,k-1))& + +(rhobf(k+3)*putin(i,j,k+3)-rhobf(k-2)*putin(i,j,k-2)))& -(w0(i,j,k)+w0(i,j-1,k))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobf(k)*putin(i,j,k)+rhobf(k-1)*putin(i,j,k-1))-8.*(rhobf(k+1)*putin(i,j,k+1)+rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)+rhobf(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i,j-1,k)))*(w0(i,j,k)+w0(i,j-1,k))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobf(k)*putin(i,j,k)-rhobf(k-1)*putin(i,j,k-1))-5.*(rhobf(k+1)*putin(i,j,k+1)-rhobf(k-2)*putin(i,j,k-2))& + +(rhobf(k+2)*putin(i,j,k+2)-rhobf(k-3)*putin(i,j,k-3)))& ) / (2. * dzf(k)) & ) @@ -643,19 +615,9 @@ subroutine advecw_5th(putin, putout) real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(in) :: putin !< Input: the w field real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1), intent(inout) :: putout !< Output: the tendency - real, dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhoputin integer :: i,j,k - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhoputin(i,j,k)=rhobh(k)*putin(i,j,k) - end do - end do - end do - - !if (leq) then do k=2,kmax do j=2,j1 @@ -684,8 +646,8 @@ subroutine advecw_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )* dyi5 & + (1./rhobh(k))*( & - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1)) & + (rhobh(k)*putin(i,j,k)+rhobh(k+1)*putin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1)) & + -(rhobh(k)*putin(i,j,k)+rhobh(k-1)*putin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1)) & )/ (4. * dzh(k)) & ) @@ -713,12 +675,12 @@ subroutine advecw_5th(putin, putout) )* dyi5 & + (1/rhobh(k))*( & (w0(i,j,k)+w0(i,j,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobh(k+1)*putin(i,j,k+1)+rhobh(k)*putin(i,j,k))-8.*(rhobh(k+2)*putin(i,j,k+2)+rhobh(k-1)*putin(i,j,k-1))& + +(rhobh(k+3)*putin(i,j,k+3)+rhobh(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k)+w0(i,j,k+1)))*(w0(i,j,k)+w0(i,j,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& - -(rhoputin(i,j,k)+rhoputin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1))/2. & + *(10.*(rhobh(k+1)*putin(i,j,k+1)-rhobh(k)*putin(i,j,k))-5.*(rhobh(k+2)*putin(i,j,k+2)-rhobh(k-1)*putin(i,j,k-1))& + +(rhobh(k+3)*putin(i,j,k+3)-rhobh(k-2)*putin(i,j,k-2)))& + -(rhobh(k)*putin(i,j,k)+rhobh(k-1)*putin(i,j,k-1) )*(w0(i,j,k) + w0(i,j,k-1))/2. & )/ (2. * dzh(k)) & ) elseif(k==kmax-2) then @@ -744,13 +706,13 @@ subroutine advecw_5th(putin, putout) *(10.*(putin(i,j,k)-putin(i,j-1,k))-5.*(putin(i,j+1,k)-putin(i,j-2,k))+(putin(i,j+2,k)-putin(i,j-3,k)))& )*dyi5& + (1./rhobh(k))*(& - (rhoputin(i,j,k)+rhoputin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1))/2. & + (rhobh(k)*putin(i,j,k)+rhobh(k+1)*putin(i,j,k+1) )*(w0(i,j,k) + w0(i,j,k+1))/2. & -(w0(i,j,k)+w0(i,j,k-1))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobh(k)*putin(i,j,k)+rhobh(k-1)*putin(i,j,k-1))-8.*(rhobh(k+1)*putin(i,j,k+1)+rhobh(k-2)*putin(i,j,k-2))& + +(rhobh(k+2)*putin(i,j,k+2)+rhobh(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i,j,k-1)))*(w0(i,j,k)+w0(i,j,k-1))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobh(k)*putin(i,j,k)-rhobh(k-1)*putin(i,j,k-1))-5.*(rhobh(k+1)*putin(i,j,k+1)-rhobh(k-2)*putin(i,j,k-2))& + +(rhobh(k+2)*putin(i,j,k+2)-rhobh(k-3)*putin(i,j,k-3)))& ) / (2. * dzh(k)) & ) else @@ -778,17 +740,17 @@ subroutine advecw_5th(putin, putout) )*dyi5& + (1./rhobh(k))*(& (w0(i,j,k)+w0(i,j,k+1))/60.& - *(37.*(rhoputin(i,j,k+1)+rhoputin(i,j,k))-8.*(rhoputin(i,j,k+2)+rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)+rhoputin(i,j,k-2)))& + *(37.*(rhobh(k+1)*putin(i,j,k+1)+rhobh(k)*putin(i,j,k))-8.*(rhobh(k+2)*putin(i,j,k+2)+rhobh(k-1)*putin(i,j,k-1))& + +(rhobh(k+3)*putin(i,j,k+3)+rhobh(k-2)*putin(i,j,k-2)))& -sign(1.,(w0(i,j,k)+w0(i,j,k+1)))*(w0(i,j,k)+w0(i,j,k+1))/60.& - *(10.*(rhoputin(i,j,k+1)-rhoputin(i,j,k))-5.*(rhoputin(i,j,k+2)-rhoputin(i,j,k-1))& - +(rhoputin(i,j,k+3)-rhoputin(i,j,k-2)))& + *(10.*(rhobh(k+1)*putin(i,j,k+1)-rhobh(k)*putin(i,j,k))-5.*(rhobh(k+2)*putin(i,j,k+2)-rhobh(k-1)*putin(i,j,k-1))& + +(rhobh(k+3)*putin(i,j,k+3)-rhobh(k-2)*putin(i,j,k-2)))& -(w0(i,j,k)+w0(i,j,k-1))/60.& - *(37.*(rhoputin(i,j,k)+rhoputin(i,j,k-1))-8.*(rhoputin(i,j,k+1)+rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)+rhoputin(i,j,k-3)))& + *(37.*(rhobh(k)*putin(i,j,k)+rhobh(k-1)*putin(i,j,k-1))-8.*(rhobh(k+1)*putin(i,j,k+1)+rhobh(k-2)*putin(i,j,k-2))& + +(rhobh(k+2)*putin(i,j,k+2)+rhobh(k-3)*putin(i,j,k-3)))& +sign(1.,(w0(i,j,k)+w0(i,j,k-1)))*(w0(i,j,k)+w0(i,j,k-1))/60.& - *(10.*(rhoputin(i,j,k)-rhoputin(i,j,k-1))-5.*(rhoputin(i,j,k+1)-rhoputin(i,j,k-2))& - +(rhoputin(i,j,k+2)-rhoputin(i,j,k-3)))& + *(10.*(rhobh(k)*putin(i,j,k)-rhobh(k-1)*putin(i,j,k-1))-5.*(rhobh(k+1)*putin(i,j,k+1)-rhobh(k-2)*putin(i,j,k-2))& + +(rhobh(k+2)*putin(i,j,k+2)-rhobh(k-3)*putin(i,j,k-3)))& ) / (2. * dzh(k)) & ) From 3434d3372c3066b80d8b84048efd2fd99fc34da3 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Thu, 16 Aug 2018 17:45:34 +0200 Subject: [PATCH 72/88] add SYST=gnu-fast to CMakelist, for -Ofast -march=native. Also ECMWF-intel for ifortran on a Cray system. --- CMakeLists.txt | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 26e3332b..b41586a4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -36,6 +36,16 @@ elseif("$ENV{SYST}" STREQUAL "ECMWF") set(CMAKE_Fortran_FLAGS "-s real64" CACHE STRING "") set(CMAKE_Fortran_FLAGS_RELEASE "-O3" CACHE STRING "") set(CMAKE_Fortran_FLAGS_DEBUG "-g -R b -K trap=fp" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "ECMWF-intel") + set(CMAKE_Fortran_COMPILER "ftn") + set(CMAKE_Fortran_FLAGS "-r8 -ftz -extend_source" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_RELEASE "-g -traceback -O3 -xHost" CACHE STRING "") + set(CMAKE_Fortran_FLAGS_DEBUG "-traceback -fpe1 -O0 -g -check all" CACHE STRING "") +elseif("$ENV{SYST}" STREQUAL "gnu-fast") + set(CMAKE_Fortran_COMPILER "mpif90") + set(CMAKE_Fortran_FLAGS "-finit-real=nan -W -Wall -fdefault-real-8 -ffree-line-length-none" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -Ofast -march=native -g -fbacktrace" CACHE STRING "") + set (CMAKE_Fortran_FLAGS_DEBUG "-fbounds-check -fbacktrace -fno-f2c -O0 -g -ffpe-trap=invalid,zero,overflow" CACHE STRING "") else() set(CMAKE_Fortran_COMPILER "mpif90") set(CMAKE_Fortran_FLAGS "-finit-real=nan -fdefault-real-8 -ffree-line-length-none " CACHE STRING "") From e5e029bc4627a072a31070bae29d594eb3622842 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 11 Sep 2018 13:51:27 +0200 Subject: [PATCH 73/88] Add faster alternative for the hybrid advection scheme, iadv=555 --- src/advec_hybrid_f.f90 | 526 +++++++++++++++++++++++++++++++++++++++++ src/advection.f90 | 17 +- src/modglobal.f90 | 7 + 3 files changed, 548 insertions(+), 2 deletions(-) create mode 100644 src/advec_hybrid_f.f90 diff --git a/src/advec_hybrid_f.f90 b/src/advec_hybrid_f.f90 new file mode 100644 index 00000000..43b5f50f --- /dev/null +++ b/src/advec_hybrid_f.f90 @@ -0,0 +1,526 @@ +!> \file advec_hybrid.f90 +! Does advection with the 5th order advection scheme that was already present in DALES, except +! around locations were discontinuities arise. There, the 5th order WENO scheme is used. +! Discontinuities should be preserved, while the damping of high wavenumber components of the flow, +! common in pure WENO solutions. +! The scheme is more or less equal to the scheme proposed by Hill and Pullin (2004) +! [https://doi.org/10.1016/j.jcp.2003.07.032] but using +! the fifth order advection scheme instead of their tuned one. +! +! JvdD (2011) +! +! This file is part of DALES. +! +! DALES is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 3 of the License, or +! (at your option) any later version. +! +! DALES is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +! Copyright 1993-2009 Delft University of Technology, Wageningen University, Utrecht University, KNMI +! +module advec_hybrid_f +implicit none +contains + +subroutine advecc_hybrid_f(pin, pout, phi_tilde_in) + use modglobal, only : ih,i1,jh,j1,kmax,k1,dxi,dyi,dzf,lambda_crit + use modfields, only : u0,v0,w0,rhobf + + implicit none + + real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(in) :: pin !< Input: the cell centered field (qt,thetal,sv etc) + real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(inout):: pout !< Output: the tendency for the input field (qtp,thetalp,svp etc) + real,optional,intent(in) :: phi_tilde_in !< Order of magnitude of the field, used in the smoothness criterion. Optional. + + real :: phi_tilde + logical :: lsmx,lsmy,lsmz ! smoothness flags + real,dimension(2:i1+1,2:j1+1,k1) :: pfacex,pfacey,pfacez ! face values, defined at the same interfaces as u0,v0 and w0 respectively + real,dimension(3) :: gam ! used for smoothness test + integer :: i,j,k + real :: eps_hybrid + real,dimension(-3:2) :: vin ! Subset of the field to be advected + real :: sgn ! 1 if velocity is positive, -1 if velocity is negative + real,parameter :: c1=13./12.,c2=1./4. ! Multiplication constants + integer,parameter :: pweno=1 ! Exponent used in WENO scheme + ! Values 1,2 or 3 should work + real,parameter :: epsWeno=1e-12 ! Small value set to keep from dividing by zero + real,dimension(3) :: wgtOpt=(/.1,.6,.3/) ! Optimal weights (see eg Hill and Pullin) + real,dimension(3) :: beta, & ! Smoothness measure + wgt, & ! Weighting factor + varFace ! Interpolated value at cell face + real :: wgtfac ! Normalization factor for the weights + + + ! phi_tilde is some kind of order-of-magnitude, used to calculate eps_hybrid + ! it's unclear to me if it's necessary for this scheme or just used to avoid dividing by 0 + ! but for now it's here, to give the same results as the original routine + ! If phi_tilde is passed as a function argument, use it, otherwise determine heuristically as in the original + ! e12 may be on either side of 1, + ! other fields like T, qt should always end up with the same phi_tilde. + if(.not. present(phi_tilde_in)) then + if (any(pin>=1.e5)) then ! probably number density + phi_tilde = 1.e3 + elseif (any(pin>=1.)) then ! probably (potential) temperature + phi_tilde = 1. + else ! probably qt + phi_tilde = 1.e-3 + end if + else + phi_tilde = phi_tilde_in + end if + eps_hybrid = 1.e-8*phi_tilde**2 + + do k=1,k1 + do j=2,j1+1 + do i=2,i1+1 + ! determine smoothness lsmx + if (u0(i,j,k).ge.0.) then + gam(:) = (pin(i-1:i+1,j,k)-pin(i-2:i,j,k))**2 + & + (pin(i-2:i,j,k)-pin(i-3:i-1,j,k))**2 + else + gam(:) = (pin(i:i+2,j,k)-pin(i-1:i+1,j,k))**2 + & + (pin(i-1:i+1,j,k)-pin(i-2:i,j,k))**2 + end if + !lsmx = maxval(gam)/(minval(gam)+eps_hybrid) < lambda_crit + lsmx = maxval(gam) < lambda_crit * (minval(gam)+eps_hybrid) + + ! determine smoothness lsmy + if (v0(i,j,k).ge.0.) then + gam(:) = (pin(i,j-1:j+1,k)-pin(i,j-2:j,k))**2 + & + (pin(i,j-2:j,k)-pin(i,j-3:j-1,k))**2 + else + gam(:) = (pin(i,j:j+2,k)-pin(i,j-1:j+1,k))**2 + & + (pin(i,j-1:j+1,k)-pin(i,j-2:j,k))**2 + end if + !lsmy = maxval(gam)/(minval(gam)+eps_hybrid) < lambda_crit + lsmy = maxval(gam) < lambda_crit * (minval(gam)+eps_hybrid) + + + ! advection in x + vin(-3:2) = pin(i-3:i+2,j,k) + if (lsmx) then ! field around this location is smooth -> use regular 5th order (upwind) + sgn = sign(1.0,u0(i,j,k)) ! set sgn, to account for different wind directions + pfacex(i,j,k) = (37.*(vin(0)+vin(-1))-8.*(vin(1)+vin(-2))+(vin(2)+vin(-3)) & + -sgn*(10.*(vin(0)-vin(-1))-5.*(vin(1)-vin(-2))+(vin(2)-vin(-3))))/60. + else ! field around this location is non-smooth -> use weno + if (u0(i,j,k) >= 0) then !Positive velocity at cell face + !compute smoothness indicators for each of the stencils + beta(1) = c1*(vin(-3)-2*vin(-2)+vin(-1))**2 + c2*(vin(-3)-4*vin(-2)+3*vin(-1))**2 + beta(2) = c1*(vin(-2)-2*vin(-1)+vin(0) )**2 + c2*(vin(-2)-vin(0))**2 + beta(3) = c1*(vin(-1)-2*vin(0) +vin(1) )**2 + c2*(3*vin(-1)-4*vin(0)+vin(1))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (2*vin(-3)- 7*vin(-2)+ 11*vin(-1))/6 + varFace(2) = (- vin(-2)+ 5*vin(-1)+ 2*vin(0) )/6 + varFace(3) = (2*vin(-1)+ 5*vin(0) - vin(1) )/6 + else !Negative velocity at cell face + !compute smoothness indicators for each of the stencils + !the following is found by mirroring the equations for positive velocity + beta(1) = c1*(vin(0) -2*vin(1) +vin(2))**2 + c2*(3*vin(0)-4*vin(1)+vin(2))**2 + beta(2) = c1*(vin(-1)-2*vin(0) +vin(1))**2 + c2*(vin(-1)-vin(1))**2 + beta(3) = c1*(vin(-2)-2*vin(-1)+vin(0))**2 + c2*(vin(-2)-4*vin(-1)+3*vin(0))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (11*vin(0) -7*vin(1) + 2*vin(2))/6 + varFace(2) = ( 2*vin(-1)+5*vin(0) - vin(1))/6 + varFace(3) = ( - vin(-2)+5*vin(-1)+ 2*vin(0))/6 + end if + + !compute weights + wgt = wgtOpt*(epsWeno+beta)**(-pweno) + wgtfac = sum(wgt)**(-1) + + ! compute interpolated value + pfacex(i,j,k) = sum(wgt(:)*varFace(:))*wgtfac + + end if + + ! advection in y + vin(-3:2) = pin(i,j-3:j+2,k) + if (lsmy) then ! field around this location is smooth -> use regular 5th order (upwind) + sgn = sign(1.0,v0(i,j,k)) ! set sgn, to account for different wind directions + pfacey(i,j,k) = (37.*(vin(0)+vin(-1))-8.*(vin(1)+vin(-2))+(vin(2)+vin(-3)) & + -sgn*(10.*(vin(0)-vin(-1))-5.*(vin(1)-vin(-2))+(vin(2)-vin(-3))))/60. + else ! field around this location is non-smooth -> use weno + if (v0(i,j,k) >= 0) then !Positive velocity at cell face + !compute smoothness indicators for each of the stencils + beta(1) = c1*(vin(-3)-2*vin(-2)+vin(-1))**2 + c2*(vin(-3)-4*vin(-2)+3*vin(-1))**2 + beta(2) = c1*(vin(-2)-2*vin(-1)+vin(0) )**2 + c2*(vin(-2)-vin(0))**2 + beta(3) = c1*(vin(-1)-2*vin(0) +vin(1) )**2 + c2*(3*vin(-1)-4*vin(0)+vin(1))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (2*vin(-3)- 7*vin(-2)+ 11*vin(-1))/6 + varFace(2) = (- vin(-2)+ 5*vin(-1)+ 2*vin(0) )/6 + varFace(3) = (2*vin(-1)+ 5*vin(0) - vin(1) )/6 + else !Negative velocity at cell face + !compute smoothness indicators for each of the stencils + !the following is found by mirroring the equations for positive velocity + beta(1) = c1*(vin(0) -2*vin(1) +vin(2))**2 + c2*(3*vin(0)-4*vin(1)+vin(2))**2 + beta(2) = c1*(vin(-1)-2*vin(0) +vin(1))**2 + c2*(vin(-1)-vin(1))**2 + beta(3) = c1*(vin(-2)-2*vin(-1)+vin(0))**2 + c2*(vin(-2)-4*vin(-1)+3*vin(0))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (11*vin(0) -7*vin(1) + 2*vin(2))/6 + varFace(2) = ( 2*vin(-1)+5*vin(0) - vin(1))/6 + varFace(3) = ( - vin(-2)+5*vin(-1)+ 2*vin(0))/6 + end if + !compute weights + wgt = wgtOpt*(epsWeno+beta)**(-pweno) + wgtfac = sum(wgt)**(-1) + + ! compute interpolated value + pfacey(i,j,k) = sum(wgt(:)*varFace(:))*wgtfac + end if + + ! advection in z + if (k < 4 .or. k >= kmax) then + ! special treatment of top and bottom layers + if (k == 1) then + pfacez(i,j,k) = 0 + else + pfacez(i,j,k) = ( rhobf(k)*pin(i,j,k) + rhobf(k-1)*pin(i,j,k-1) ) * .5 + end if + else + + ! determine smoothness lsmz + if (w0(i,j,k).ge.0.) then + gam(:) = (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + & + (pin(i,j,k-2:k)-pin(i,j,k-3:k-1))**2 + else + gam(:) = (pin(i,j,k:k+2)-pin(i,j,k-1:k+1))**2 + & + (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + end if + ! lsmz = maxval(gam)/(minval(gam)+eps_hybrid) < lambda_crit + lsmz = maxval(gam) < lambda_crit * (minval(gam)+eps_hybrid) + + + vin(-3:2) = pin(i,j,k-3:k+2) * rhobf(k-3:k+2) + if (lsmz) then ! field around this location is smooth -> use regular 5th order (upwind) + sgn = sign(1.0,w0(i,j,k)) ! set sgn, to account for different wind directions + pfacez(i,j,k) = (37.*(vin(0)+vin(-1))-8.*(vin(1)+vin(-2))+(vin(2)+vin(-3)) & + -sgn*(10.*(vin(0)-vin(-1))-5.*(vin(1)-vin(-2))+(vin(2)-vin(-3))))/60. + else ! field around this location is non-smooth -> use weno + if (w0(i,j,k) >= 0) then !Positive velocity at cell face + !compute smoothness indicators for each of the stencils + beta(1) = c1*(vin(-3)-2*vin(-2)+vin(-1))**2 + c2*(vin(-3)-4*vin(-2)+3*vin(-1))**2 + beta(2) = c1*(vin(-2)-2*vin(-1)+vin(0) )**2 + c2*(vin(-2)-vin(0))**2 + beta(3) = c1*(vin(-1)-2*vin(0) +vin(1) )**2 + c2*(3*vin(-1)-4*vin(0)+vin(1))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (2*vin(-3)- 7*vin(-2)+ 11*vin(-1))/6 + varFace(2) = (- vin(-2)+ 5*vin(-1)+ 2*vin(0) )/6 + varFace(3) = (2*vin(-1)+ 5*vin(0) - vin(1) )/6 + else !Negative velocity at cell face + !compute smoothness indicators for each of the stencils + !the following is found by mirroring the equations for positive velocity + beta(1) = c1*(vin(0) -2*vin(1) +vin(2))**2 + c2*(3*vin(0)-4*vin(1)+vin(2))**2 + beta(2) = c1*(vin(-1)-2*vin(0) +vin(1))**2 + c2*(vin(-1)-vin(1))**2 + beta(3) = c1*(vin(-2)-2*vin(-1)+vin(0))**2 + c2*(vin(-2)-4*vin(-1)+3*vin(0))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (11*vin(0) -7*vin(1) + 2*vin(2))/6 + varFace(2) = ( 2*vin(-1)+5*vin(0) - vin(1))/6 + varFace(3) = ( - vin(-2)+5*vin(-1)+ 2*vin(0))/6 + end if + !compute weights + wgt = wgtOpt*(epsWeno+beta)**(-pweno) + wgtfac = sum(wgt)**(-1) + + ! compute interpolated value + pfacez(i,j,k) = sum(wgt(:)*varFace(:))*wgtfac + end if + end if + + !kp2=k+2;km3=k-3 + !pfacex(i,j,k) = ip_hybrid(pin(im3:ip2,j,k),u0(i,j,k)>=0.,lsmx(i,j,k)) + !pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) + !pfacez(i,j,k) = ip_hybrid(rhopin(i,j,km3:kp2),w0(i,j,k)>=0.,lsmz(i,j,k)) + end do + end do + end do !Loop over k + + ! Calculate actual tendencies by multiplying matrices, accept in the vertical, since dzf(k) + ! does not have the appropriate dimensions. + do k=1,kmax + pout(2:i1,2:j1,k) = pout(2:i1,2:j1,k) - ( & + (u0(3:i1+1,2:j1,k)*pfacex(3:i1+1,2:j1,k) - & + u0(2:i1,2:j1,k)*pfacex(2:i1,2:j1,k) )*dxi & + +(v0(2:i1,3:j1+1,k)*pfacey(2:i1,3:j1+1,k) - & + v0(2:i1,2:j1,k)*pfacey(2:i1,2:j1,k) )*dyi & + +(1./rhobf(k))*(w0(2:i1,2:j1,k+1)*pfacez(2:i1,2:j1,k+1) - & + w0(2:i1,2:j1,k)*pfacez(2:i1,2:j1,k) )/dzf(k) & + ) + end do + +end subroutine advecc_hybrid_f + + + +subroutine advecc_hybrid(pin,pout) + use modglobal, only : ih,i1,jh,j1,kmax,k1 & + ,dxi,dyi,dzf,lambda_crit + use modfields, only : u0,v0,w0,rhobf + implicit none + + ! input and output variables + real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(in) :: pin !< Input: the cell centered field (qt,thetal,sv etc) + real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(inout):: pout !< Output: the tendency for the input field (qtp,thetalp,svp etc) + + real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhopin !< 3D density profile * input + + ! local variables + logical,dimension(2:i1+1,2:j1+1,k1) :: lsmx,lsmy,lsmz + real,dimension(2:i1+1,2:j1+1,k1) :: pfacex,pfacey,pfacez ! face values, defined at the same interfaces as u0,v0 and w0 respectively + integer :: i,j,k + integer :: kp2,km3 + integer :: jp2,jm3 + integer :: ip2,im3 + + ! Anelastic approx. + do k=1,k1 + do j=2-jh,j1+jh + do i=2-ih,i1+ih + rhopin(i,j,k)=rhobf(k)*pin(i,j,k) + end do + end do + end do + + ! Initialize face values + pfacex=0.;pfacey=0.;pfacez=0. + + ! calculate the smoothness indicator in all 3 directions and immediately check if it exceeds the critical value + ! note that the smoothness indicator is defined at cell [i]faces[/i]. + lsmx = smoothness(pin,1)=0.,lsmx(i,j,k)) + pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) + end do + ! Loop over last two height levels to do horizontal interpolation + do k=kmax,k1 + pfacex(i,j,k) = ip_hybrid(pin(im3:ip2,j,k),u0(i,j,k)>=0.,lsmx(i,j,k)) + pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) + end do + ! Loop over rest of levels, for horizontal and vertical faces + do k=4,kmax-1 + kp2=k+2;km3=k-3 + pfacex(i,j,k) = ip_hybrid(pin(im3:ip2,j,k),u0(i,j,k)>=0.,lsmx(i,j,k)) + pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) + pfacez(i,j,k) = ip_hybrid(rhopin(i,j,km3:kp2),w0(i,j,k)>=0.,lsmz(i,j,k)) + end do !Loop over k + end do !Loop over i + end do !Loop over j + + ! Calculate actual tendencies by multiplying matrices, accept in the vertical, since dzf(k) + ! does not have the appropriate dimensions. + do k=1,kmax + pout(2:i1,2:j1,k) = pout(2:i1,2:j1,k) - ( & + (u0(3:i1+1,2:j1,k)*pfacex(3:i1+1,2:j1,k) - & + u0(2:i1,2:j1,k)*pfacex(2:i1,2:j1,k) )*dxi & + +(v0(2:i1,3:j1+1,k)*pfacey(2:i1,3:j1+1,k) - & + v0(2:i1,2:j1,k)*pfacey(2:i1,2:j1,k) )*dyi & + +(1./rhobf(k))*(w0(2:i1,2:j1,k+1)*pfacez(2:i1,2:j1,k+1) - & + w0(2:i1,2:j1,k)*pfacez(2:i1,2:j1,k) )/dzf(k) & + ) + end do + +end subroutine advecc_hybrid + +!======================================================================================= +! Function that interpolates cell centered values of a variable to the appropriate cell face +! using a six point stencil. Fifth order accurate, because of the diffusive term included. +!======================================================================================= +!elemental function ip_5th(vp2,vp1,v,vm1,vm2,vm3,sgn) +! implicit none +! real :: ip_5th +! real,intent(in) :: vp2,vp1,v,vm1,vm2,vm3 +! real,intent(in) :: sgn +! +! ip_5th = (37.*(v+vm1)-8.*(vp1+vm2)+(vp2+vm3)-sgn*(10.*(v-vm1)-5.*(vp1-vm2)+(vp2-vm3)))/60. +! +!end function ip_5th + +!======================================================================================= +! This function checks whether fifth order advection should be used, or WENO method, based +! on the smoothness of different stencils +!======================================================================================= +function ip_hybrid(vin,lpos,lsmooth) + implicit none + real :: ip_hybrid + real,intent(in),dimension(-3:2) :: vin ! Subset of a variable + logical,intent(in) :: lpos ! Positive of negative velocity + logical,intent(in) :: lsmooth ! Locally smooth or non-smooth + + !local variables + real,parameter :: c1=13./12.,c2=1./4. ! Multiplication constants + real,dimension(3) :: wgtOpt=(/.1,.6,.3/) ! Optimal weights (see eg Hill and Pullin) + real,dimension(3) :: beta, & ! Smoothness measure + wgt, & ! Weighting factor + varFace ! Interpolated value at cell face + real :: wgtfac ! Normalization factor for the weights + integer,parameter :: pweno=1 ! Exponent used in WENO scheme + ! Values 1,2 or 3 should work + real,parameter :: epsWeno=1e-12 ! Small value set to keep from dividing by zero + integer :: sgn ! 1 if velocity is positive, -1 if velocity is negative + + sgn=-1 + + if (lsmooth) then ! field around this location is smooth -> use regular 5th order (upwind) + if (lpos) sgn=1 ! set sgn, to account for different wind directions + ip_hybrid = (37.*(vin(0)+vin(-1))-8.*(vin(1)+vin(-2))+(vin(2)+vin(-3)) & + -sgn*(10.*(vin(0)-vin(-1))-5.*(vin(1)-vin(-2))+(vin(2)-vin(-3))))/60. + else ! field around this location is non-smooth -> use weno + if (lpos) then !Positive velocity at cell face + !compute smoothness indicators for each of the stencils + beta(1) = c1*(vin(-3)-2*vin(-2)+vin(-1))**2 + c2*(vin(-3)-4*vin(-2)+3*vin(-1))**2 + beta(2) = c1*(vin(-2)-2*vin(-1)+vin(0) )**2 + c2*(vin(-2)-vin(0))**2 + beta(3) = c1*(vin(-1)-2*vin(0) +vin(1) )**2 + c2*(3*vin(-1)-4*vin(0)+vin(1))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (2*vin(-3)- 7*vin(-2)+ 11*vin(-1))/6 + varFace(2) = (- vin(-2)+ 5*vin(-1)+ 2*vin(0) )/6 + varFace(3) = (2*vin(-1)+ 5*vin(0) - vin(1) )/6 + else !Negative velocity at cell face + !compute smoothness indicators for each of the stencils + !the following is found by mirroring the equations for positive velocity + beta(1) = c1*(vin(0) -2*vin(1) +vin(2))**2 + c2*(3*vin(0)-4*vin(1)+vin(2))**2 + beta(2) = c1*(vin(-1)-2*vin(0) +vin(1))**2 + c2*(vin(-1)-vin(1))**2 + beta(3) = c1*(vin(-2)-2*vin(-1)+vin(0))**2 + c2*(vin(-2)-4*vin(-1)+3*vin(0))**2 + + !interpolated values of the variable at the cell faces using each of the stencils + varFace(1) = (11*vin(0) -7*vin(1) + 2*vin(2))/6 + varFace(2) = ( 2*vin(-1)+5*vin(0) - vin(1))/6 + varFace(3) = ( - vin(-2)+5*vin(-1)+ 2*vin(0))/6 + end if + + !compute weights + wgt = wgtOpt*(epsWeno+beta)**(-pweno) + wgtfac = sum(wgt)**(-1) + + ! compute interpolated value + ip_hybrid = sum(wgt(:)*varFace(:))*wgtfac + end if + +end function ip_hybrid + +!======================================================================================= +! Subroutine that calculates lambda, which is a so-called smoothness parameter, defined by +! Blossey and Durran (2008). Could also be calculated using method of Hill and Pullin, although +! that is more computationally demanding. +!======================================================================================= + +function smoothness(pin,dir) + use modglobal, only : kmax,ih,i1,jh,j1,k1 + use modfields, only : u0,v0,w0 + implicit none + real,intent(in),dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: pin + integer,intent(in) :: dir + real,dimension(2:i1+1,2:j1+1,k1) :: smoothness + real,dimension(3) :: gam=0. + real :: eps_hybrid,phi_tilde + integer :: i,j,k + integer :: ip2,ip1,im1,im2,im3 + integer :: jp2,jp1,jm1,jm2,jm3 + integer :: kp2,kp1,km1,km2,km3 + + smoothness(:,:,:)=0. + !eps_hybrid indicates the minimum in jumps in the scalar that are worthy of attention + !depends on specific scalar phi_tilde={1e-3 for qt, 1 for theta, 1e3 for N} + !(from email correspondence with Peter Blossey) + if (any(pin>=1.e5)) then ! probably number density + phi_tilde = 1.e3 + elseif (any(pin>=1.)) then ! probably (potential) temperature + phi_tilde = 1. + else ! probably qt + phi_tilde = 1.e-3 + end if + + ! Calculate 'small' value to keep from dividing by zero. Value is relative to a + ! representative value of the variable being advected (=phi_tilde where phi \in {qt,thl,sv,u,v,w,tke}) + eps_hybrid = 1.e-8*phi_tilde**2 + + select case (dir) + case (1) ! x-direction + do k=1,k1 + do j=2,j1+1 + do i=2,i1+1 + ip2=i+2;ip1=i+1;im1=i-1;im2=i-2;im3=i-3 + ! Calculate the smoothness for each stencil in an upwind configuration + if (u0(i,j,k).ge.0.) then + gam(:) = (pin(im1:ip1,j,k)-pin(im2:i,j,k))**2 + & + (pin(im2:i,j,k)-pin(im3:im1,j,k))**2 + else + gam(:) = (pin(i:ip2,j,k)-pin(im1:ip1,j,k))**2 + & + (pin(im1:ip1,j,k)-pin(im2:i,j,k))**2 + end if + smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) + end do + end do + end do + case (2) ! y-direction + do k=1,k1 + do j=2,j1+1 + jp2=j+2;jp1=j+1;jm1=j-1;jm2=j-2;jm3=j-3 + do i=2,i1+1 + ! Calculate the smoothness for each stencil in an upwind configuration + if (v0(i,j,k).ge.0.) then + gam(:) = (pin(i,jm1:jp1,k)-pin(i,jm2:j,k))**2 + & + (pin(i,jm2:j,k)-pin(i,jm3:jm1,k))**2 + else + gam(:) = (pin(i,j:jp2,k)-pin(i,jm1:jp1,k))**2 + & + (pin(i,jm1:jp1,k)-pin(i,jm2:j,k))**2 + end if + smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) + end do + end do + end do + case (3) ! z-direction + do k=4,kmax-2 ! Do not analyse bottom and top levels, because WENO cannot be used there anyway + kp2=k+2;kp1=k+1;km1=k-1;km2=k-2;km3=k-3 + do j=2,j1 + do i=2,i1 + ! Calculate the smoothness for each stencil in an upwind configuration + if (w0(i,j,k).ge.0.) then + gam(:) = (pin(i,j,km1:kp1)-pin(i,j,km2:k))**2 + & + (pin(i,j,km2:k)-pin(i,j,km3:km1))**2 + else + gam(:) = (pin(i,j,k:kp2)-pin(i,j,km1:kp1))**2 + & + (pin(i,j,km1:kp1)-pin(i,j,km2:k))**2 + end if + smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) + end do + end do + end do + case default + stop 'ERROR: incorrect direction selected' + end select +end function smoothness + +end module advec_hybrid_f diff --git a/src/advection.f90 b/src/advection.f90 index 399b2cc0..60fa378d 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -28,10 +28,11 @@ subroutine advection use modglobal, only : lmoist, nsv, iadv_mom,iadv_tke,iadv_thl,iadv_qt,iadv_sv, & - iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid,iadv_null,leq + iadv_cd2,iadv_5th,iadv_52,iadv_cd6,iadv_62,iadv_kappa,iadv_upw,iadv_hybrid,iadv_hybrid_f,iadv_null,leq use modfields, only : u0,up,v0,vp,w0,wp,e120,e12p,thl0,thlp,qt0,qtp,sv0,svp use modsubgrid, only : lsmagorinsky use advec_hybrid, only : advecc_hybrid + use advec_hybrid_f, only : advecc_hybrid_f implicit none integer :: n @@ -92,7 +93,10 @@ subroutine advection call advecc_kappa(e120,e12p) case(iadv_hybrid) if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." - call advecc_hybrid(e120,e12p) + call advecc_hybrid(e120,e12p) + case(iadv_hybrid_f) + if (.not. leq) stop "advec_hybrid_f does not support a non-uniform vertical grid." + call advecc_hybrid_f(e120,e12p) case(iadv_null) ! null advection scheme stop "Null advection scheme selected for iadv_tke - probably a bad idea." @@ -123,6 +127,9 @@ subroutine advection case(iadv_hybrid) if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(thl0,thlp) + case(iadv_hybrid_f) + if (.not. leq) stop "advec_hybrid_f does not support a non-uniform vertical grid." + call advecc_hybrid_f(thl0,thlp,1.0) case(iadv_null) ! null advection scheme stop "Null advection scheme selected for iadv_thl - probably a bad idea." @@ -152,6 +159,9 @@ subroutine advection case(iadv_hybrid) if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(qt0,qtp) + case(iadv_hybrid_f) + if (.not. leq) stop "advec_hybrid_f does not support a non-uniform vertical grid." + call advecc_hybrid_f(qt0,qtp,1e-3) case(iadv_null) ! null advection scheme stop "Null advection scheme selected for iadv_qt - probably a bad idea." @@ -182,6 +192,9 @@ subroutine advection case(iadv_hybrid) if (.not. leq) stop "advec_hybrid does not support a non-uniform vertical grid." call advecc_hybrid(sv0(:,:,:,n),svp(:,:,:,n)) + case(iadv_hybrid_f) + if (.not. leq) stop "advec_hybrid_f does not support a non-uniform vertical grid." + call advecc_hybrid_f(sv0(:,:,:,n),svp(:,:,:,n)) case(iadv_null) ! null advection scheme - do nothing case default diff --git a/src/modglobal.f90 b/src/modglobal.f90 index e851a794..b4ee2c7d 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -131,6 +131,7 @@ module modglobal integer, parameter :: iadv_52 = 52 integer, parameter :: iadv_kappa = 7 integer, parameter :: iadv_hybrid = 55 + integer, parameter :: iadv_hybrid_f = 555 real :: lambda_crit=100. !< maximum value for the smoothness. This controls if WENO or @@ -244,6 +245,8 @@ subroutine initglobal case(iadv_52) courant = 1. case(iadv_hybrid) + courant = 1. + case(iadv_hybrid_f) courant = 1. case default courant = 1. @@ -297,6 +300,10 @@ subroutine initglobal ih = 3 jh = 3 kh = 1 + elseif (any(advarr==iadv_hybrid_f).or.any(iadv_sv(1:nsv)==iadv_hybrid_f)) then + ih = 3 + jh = 3 + kh = 1 elseif (any(advarr==iadv_kappa).or.any(iadv_sv(1:nsv)==iadv_kappa)) then ih = 2 jh = 2 From 0c2cf5946339dc071abb65e0530e36fda855efc5 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 11 Sep 2018 14:14:42 +0200 Subject: [PATCH 74/88] dont exchange m-field halos - not needed --- src/modboundary.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/modboundary.f90 b/src/modboundary.f90 index 2f3581ad..81b157c8 100644 --- a/src/modboundary.f90 +++ b/src/modboundary.f90 @@ -100,12 +100,12 @@ subroutine cyclich call excjs( thl0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( qt0 , 2,i1,2,j1,1,k1,ih,jh) - call excjs( thlm , 2,i1,2,j1,1,k1,ih,jh) - call excjs( qtm , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( thlm , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( qtm , 2,i1,2,j1,1,k1,ih,jh) do n=1,nsv call excjs( sv0(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) - call excjs( svm(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( svm(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) enddo return @@ -121,11 +121,11 @@ subroutine cyclicm call excjs( u0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( v0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( w0 , 2,i1,2,j1,1,k1,ih,jh) - call excjs( um , 2,i1,2,j1,1,k1,ih,jh) - call excjs( vm , 2,i1,2,j1,1,k1,ih,jh) - call excjs( wm , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( um , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( vm , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( wm , 2,i1,2,j1,1,k1,ih,jh) call excjs( e120 , 2,i1,2,j1,1,k1,ih,jh) - call excjs( e12m , 2,i1,2,j1,1,k1,ih,jh) + !call excjs( e12m , 2,i1,2,j1,1,k1,ih,jh) return end subroutine cyclicm From 1950e32559a2eb297b6d84bf11a19e5ac26df35b Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 11 Sep 2018 14:25:47 +0200 Subject: [PATCH 75/88] modpois: allocate d instead of placing on stack --- src/modpois.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/modpois.f90 b/src/modpois.f90 index 8c5f4dff..f942133b 100644 --- a/src/modpois.f90 +++ b/src/modpois.f90 @@ -236,11 +236,12 @@ subroutine solmpj real :: a(kmax),b(kmax),c(kmax) ! allocate d in the same shape as p and xyrt - real :: d(2-ih:i1+ih,2-jh:j1+jh,kmax) - + real, allocatable :: d(:,:,:) + real z,ak,bk,bbk integer i, j, k - + allocate(d(2-ih:i1+ih,2-jh:j1+jh,kmax)) + ! Forward FFT call fft2df(p,ih,jh) @@ -303,6 +304,8 @@ subroutine solmpj ! Backward FFT call fft2db(p,ih,jh) + deallocate(d) + return end subroutine solmpj !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 5c712f37be7b306bcfab5342780baf9953f9514f Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 11 Sep 2018 14:33:37 +0200 Subject: [PATCH 76/88] modradfull.f90:coefft0() : rearrange to calculate exp only when needed --- src/modradfull.f90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/modradfull.f90 b/src/modradfull.f90 index c8e9a907..63e3ba53 100644 --- a/src/modradfull.f90 +++ b/src/modradfull.f90 @@ -698,19 +698,23 @@ subroutine coefft0( solar,t0,t1,u0,f0,aa,zz,a1,z1,fk1,fk2) fk1 = 4.7320545 fk2 = 1.2679491 - y = exp ( - ( t1 - t0 ) / (u0+epsilon(u0))) - fw = 0.5 * f0 - do i = 1, 4 - if ( solar ) then + if ( solar ) then + do i = 1, 4 z1(i) = 0.0 zz(i,1) = 0.0 zz(i,2) = 0.0 - else + end do + else + y = exp ( - ( t1 - t0 ) / (u0+epsilon(u0))) + fw = 0.5 * f0 + do i = 1, 4 jj = 5 - i z1(i) = fw / ( 1.0 + u(jj) / (u0+epsilon(u0)) ) zz(i,1) = z1(i) zz(i,2) = z1(i) * y - endif + end do + endif + do i = 1, 4 do j = 1, 4 a1(i,j) = 0.0 do k = 1, 2 From 8d6fd706dc7d2de4a44aacee2979c2fed514d443 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 12 Sep 2018 15:30:01 +0200 Subject: [PATCH 77/88] Alternative advec_hybrid : fix top boundary smoothness, cleanup --- src/advec_hybrid_f.f90 | 287 ++--------------------------------------- 1 file changed, 14 insertions(+), 273 deletions(-) diff --git a/src/advec_hybrid_f.f90 b/src/advec_hybrid_f.f90 index 43b5f50f..7f46b78f 100644 --- a/src/advec_hybrid_f.f90 +++ b/src/advec_hybrid_f.f90 @@ -189,19 +189,21 @@ subroutine advecc_hybrid_f(pin, pout, phi_tilde_in) pfacez(i,j,k) = ( rhobf(k)*pin(i,j,k) + rhobf(k-1)*pin(i,j,k-1) ) * .5 end if else - - ! determine smoothness lsmz - if (w0(i,j,k).ge.0.) then - gam(:) = (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + & - (pin(i,j,k-2:k)-pin(i,j,k-3:k-1))**2 - else - gam(:) = (pin(i,j,k:k+2)-pin(i,j,k-1:k+1))**2 + & - (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + + lsmz = .true. + if (k < kmax-1) then ! the original scheme considers k=kmax-1 fully smooth + ! determine smoothness lsmz + if (w0(i,j,k).ge.0.) then + gam(:) = (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + & + (pin(i,j,k-2:k)-pin(i,j,k-3:k-1))**2 + else + gam(:) = (pin(i,j,k:k+2)-pin(i,j,k-1:k+1))**2 + & + (pin(i,j,k-1:k+1)-pin(i,j,k-2:k))**2 + end if + ! lsmz = maxval(gam)/(minval(gam)+eps_hybrid) < lambda_crit + lsmz = maxval(gam) < lambda_crit * (minval(gam)+eps_hybrid) end if - ! lsmz = maxval(gam)/(minval(gam)+eps_hybrid) < lambda_crit - lsmz = maxval(gam) < lambda_crit * (minval(gam)+eps_hybrid) - - + vin(-3:2) = pin(i,j,k-3:k+2) * rhobf(k-3:k+2) if (lsmz) then ! field around this location is smooth -> use regular 5th order (upwind) sgn = sign(1.0,w0(i,j,k)) ! set sgn, to account for different wind directions @@ -259,268 +261,7 @@ subroutine advecc_hybrid_f(pin, pout, phi_tilde_in) w0(2:i1,2:j1,k)*pfacez(2:i1,2:j1,k) )/dzf(k) & ) end do - end subroutine advecc_hybrid_f - -subroutine advecc_hybrid(pin,pout) - use modglobal, only : ih,i1,jh,j1,kmax,k1 & - ,dxi,dyi,dzf,lambda_crit - use modfields, only : u0,v0,w0,rhobf - implicit none - - ! input and output variables - real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(in) :: pin !< Input: the cell centered field (qt,thetal,sv etc) - real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1),intent(inout):: pout !< Output: the tendency for the input field (qtp,thetalp,svp etc) - - real,dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: rhopin !< 3D density profile * input - - ! local variables - logical,dimension(2:i1+1,2:j1+1,k1) :: lsmx,lsmy,lsmz - real,dimension(2:i1+1,2:j1+1,k1) :: pfacex,pfacey,pfacez ! face values, defined at the same interfaces as u0,v0 and w0 respectively - integer :: i,j,k - integer :: kp2,km3 - integer :: jp2,jm3 - integer :: ip2,im3 - - ! Anelastic approx. - do k=1,k1 - do j=2-jh,j1+jh - do i=2-ih,i1+ih - rhopin(i,j,k)=rhobf(k)*pin(i,j,k) - end do - end do - end do - - ! Initialize face values - pfacex=0.;pfacey=0.;pfacez=0. - - ! calculate the smoothness indicator in all 3 directions and immediately check if it exceeds the critical value - ! note that the smoothness indicator is defined at cell [i]faces[/i]. - lsmx = smoothness(pin,1)=0.,lsmx(i,j,k)) - pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) - end do - ! Loop over last two height levels to do horizontal interpolation - do k=kmax,k1 - pfacex(i,j,k) = ip_hybrid(pin(im3:ip2,j,k),u0(i,j,k)>=0.,lsmx(i,j,k)) - pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) - end do - ! Loop over rest of levels, for horizontal and vertical faces - do k=4,kmax-1 - kp2=k+2;km3=k-3 - pfacex(i,j,k) = ip_hybrid(pin(im3:ip2,j,k),u0(i,j,k)>=0.,lsmx(i,j,k)) - pfacey(i,j,k) = ip_hybrid(pin(i,jm3:jp2,k),v0(i,j,k)>=0.,lsmy(i,j,k)) - pfacez(i,j,k) = ip_hybrid(rhopin(i,j,km3:kp2),w0(i,j,k)>=0.,lsmz(i,j,k)) - end do !Loop over k - end do !Loop over i - end do !Loop over j - - ! Calculate actual tendencies by multiplying matrices, accept in the vertical, since dzf(k) - ! does not have the appropriate dimensions. - do k=1,kmax - pout(2:i1,2:j1,k) = pout(2:i1,2:j1,k) - ( & - (u0(3:i1+1,2:j1,k)*pfacex(3:i1+1,2:j1,k) - & - u0(2:i1,2:j1,k)*pfacex(2:i1,2:j1,k) )*dxi & - +(v0(2:i1,3:j1+1,k)*pfacey(2:i1,3:j1+1,k) - & - v0(2:i1,2:j1,k)*pfacey(2:i1,2:j1,k) )*dyi & - +(1./rhobf(k))*(w0(2:i1,2:j1,k+1)*pfacez(2:i1,2:j1,k+1) - & - w0(2:i1,2:j1,k)*pfacez(2:i1,2:j1,k) )/dzf(k) & - ) - end do - -end subroutine advecc_hybrid - -!======================================================================================= -! Function that interpolates cell centered values of a variable to the appropriate cell face -! using a six point stencil. Fifth order accurate, because of the diffusive term included. -!======================================================================================= -!elemental function ip_5th(vp2,vp1,v,vm1,vm2,vm3,sgn) -! implicit none -! real :: ip_5th -! real,intent(in) :: vp2,vp1,v,vm1,vm2,vm3 -! real,intent(in) :: sgn -! -! ip_5th = (37.*(v+vm1)-8.*(vp1+vm2)+(vp2+vm3)-sgn*(10.*(v-vm1)-5.*(vp1-vm2)+(vp2-vm3)))/60. -! -!end function ip_5th - -!======================================================================================= -! This function checks whether fifth order advection should be used, or WENO method, based -! on the smoothness of different stencils -!======================================================================================= -function ip_hybrid(vin,lpos,lsmooth) - implicit none - real :: ip_hybrid - real,intent(in),dimension(-3:2) :: vin ! Subset of a variable - logical,intent(in) :: lpos ! Positive of negative velocity - logical,intent(in) :: lsmooth ! Locally smooth or non-smooth - - !local variables - real,parameter :: c1=13./12.,c2=1./4. ! Multiplication constants - real,dimension(3) :: wgtOpt=(/.1,.6,.3/) ! Optimal weights (see eg Hill and Pullin) - real,dimension(3) :: beta, & ! Smoothness measure - wgt, & ! Weighting factor - varFace ! Interpolated value at cell face - real :: wgtfac ! Normalization factor for the weights - integer,parameter :: pweno=1 ! Exponent used in WENO scheme - ! Values 1,2 or 3 should work - real,parameter :: epsWeno=1e-12 ! Small value set to keep from dividing by zero - integer :: sgn ! 1 if velocity is positive, -1 if velocity is negative - - sgn=-1 - - if (lsmooth) then ! field around this location is smooth -> use regular 5th order (upwind) - if (lpos) sgn=1 ! set sgn, to account for different wind directions - ip_hybrid = (37.*(vin(0)+vin(-1))-8.*(vin(1)+vin(-2))+(vin(2)+vin(-3)) & - -sgn*(10.*(vin(0)-vin(-1))-5.*(vin(1)-vin(-2))+(vin(2)-vin(-3))))/60. - else ! field around this location is non-smooth -> use weno - if (lpos) then !Positive velocity at cell face - !compute smoothness indicators for each of the stencils - beta(1) = c1*(vin(-3)-2*vin(-2)+vin(-1))**2 + c2*(vin(-3)-4*vin(-2)+3*vin(-1))**2 - beta(2) = c1*(vin(-2)-2*vin(-1)+vin(0) )**2 + c2*(vin(-2)-vin(0))**2 - beta(3) = c1*(vin(-1)-2*vin(0) +vin(1) )**2 + c2*(3*vin(-1)-4*vin(0)+vin(1))**2 - - !interpolated values of the variable at the cell faces using each of the stencils - varFace(1) = (2*vin(-3)- 7*vin(-2)+ 11*vin(-1))/6 - varFace(2) = (- vin(-2)+ 5*vin(-1)+ 2*vin(0) )/6 - varFace(3) = (2*vin(-1)+ 5*vin(0) - vin(1) )/6 - else !Negative velocity at cell face - !compute smoothness indicators for each of the stencils - !the following is found by mirroring the equations for positive velocity - beta(1) = c1*(vin(0) -2*vin(1) +vin(2))**2 + c2*(3*vin(0)-4*vin(1)+vin(2))**2 - beta(2) = c1*(vin(-1)-2*vin(0) +vin(1))**2 + c2*(vin(-1)-vin(1))**2 - beta(3) = c1*(vin(-2)-2*vin(-1)+vin(0))**2 + c2*(vin(-2)-4*vin(-1)+3*vin(0))**2 - - !interpolated values of the variable at the cell faces using each of the stencils - varFace(1) = (11*vin(0) -7*vin(1) + 2*vin(2))/6 - varFace(2) = ( 2*vin(-1)+5*vin(0) - vin(1))/6 - varFace(3) = ( - vin(-2)+5*vin(-1)+ 2*vin(0))/6 - end if - - !compute weights - wgt = wgtOpt*(epsWeno+beta)**(-pweno) - wgtfac = sum(wgt)**(-1) - - ! compute interpolated value - ip_hybrid = sum(wgt(:)*varFace(:))*wgtfac - end if - -end function ip_hybrid - -!======================================================================================= -! Subroutine that calculates lambda, which is a so-called smoothness parameter, defined by -! Blossey and Durran (2008). Could also be calculated using method of Hill and Pullin, although -! that is more computationally demanding. -!======================================================================================= - -function smoothness(pin,dir) - use modglobal, only : kmax,ih,i1,jh,j1,k1 - use modfields, only : u0,v0,w0 - implicit none - real,intent(in),dimension(2-ih:i1+ih,2-jh:j1+jh,k1) :: pin - integer,intent(in) :: dir - real,dimension(2:i1+1,2:j1+1,k1) :: smoothness - real,dimension(3) :: gam=0. - real :: eps_hybrid,phi_tilde - integer :: i,j,k - integer :: ip2,ip1,im1,im2,im3 - integer :: jp2,jp1,jm1,jm2,jm3 - integer :: kp2,kp1,km1,km2,km3 - - smoothness(:,:,:)=0. - !eps_hybrid indicates the minimum in jumps in the scalar that are worthy of attention - !depends on specific scalar phi_tilde={1e-3 for qt, 1 for theta, 1e3 for N} - !(from email correspondence with Peter Blossey) - if (any(pin>=1.e5)) then ! probably number density - phi_tilde = 1.e3 - elseif (any(pin>=1.)) then ! probably (potential) temperature - phi_tilde = 1. - else ! probably qt - phi_tilde = 1.e-3 - end if - - ! Calculate 'small' value to keep from dividing by zero. Value is relative to a - ! representative value of the variable being advected (=phi_tilde where phi \in {qt,thl,sv,u,v,w,tke}) - eps_hybrid = 1.e-8*phi_tilde**2 - - select case (dir) - case (1) ! x-direction - do k=1,k1 - do j=2,j1+1 - do i=2,i1+1 - ip2=i+2;ip1=i+1;im1=i-1;im2=i-2;im3=i-3 - ! Calculate the smoothness for each stencil in an upwind configuration - if (u0(i,j,k).ge.0.) then - gam(:) = (pin(im1:ip1,j,k)-pin(im2:i,j,k))**2 + & - (pin(im2:i,j,k)-pin(im3:im1,j,k))**2 - else - gam(:) = (pin(i:ip2,j,k)-pin(im1:ip1,j,k))**2 + & - (pin(im1:ip1,j,k)-pin(im2:i,j,k))**2 - end if - smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) - end do - end do - end do - case (2) ! y-direction - do k=1,k1 - do j=2,j1+1 - jp2=j+2;jp1=j+1;jm1=j-1;jm2=j-2;jm3=j-3 - do i=2,i1+1 - ! Calculate the smoothness for each stencil in an upwind configuration - if (v0(i,j,k).ge.0.) then - gam(:) = (pin(i,jm1:jp1,k)-pin(i,jm2:j,k))**2 + & - (pin(i,jm2:j,k)-pin(i,jm3:jm1,k))**2 - else - gam(:) = (pin(i,j:jp2,k)-pin(i,jm1:jp1,k))**2 + & - (pin(i,jm1:jp1,k)-pin(i,jm2:j,k))**2 - end if - smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) - end do - end do - end do - case (3) ! z-direction - do k=4,kmax-2 ! Do not analyse bottom and top levels, because WENO cannot be used there anyway - kp2=k+2;kp1=k+1;km1=k-1;km2=k-2;km3=k-3 - do j=2,j1 - do i=2,i1 - ! Calculate the smoothness for each stencil in an upwind configuration - if (w0(i,j,k).ge.0.) then - gam(:) = (pin(i,j,km1:kp1)-pin(i,j,km2:k))**2 + & - (pin(i,j,km2:k)-pin(i,j,km3:km1))**2 - else - gam(:) = (pin(i,j,k:kp2)-pin(i,j,km1:kp1))**2 + & - (pin(i,j,km1:kp1)-pin(i,j,km2:k))**2 - end if - smoothness(i,j,k) = maxval(gam)/(minval(gam)+eps_hybrid) - end do - end do - end do - case default - stop 'ERROR: incorrect direction selected' - end select -end function smoothness - end module advec_hybrid_f From 42897d84627e701c23b299ae1824002d6997e3b9 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Wed, 12 Sep 2018 15:30:35 +0200 Subject: [PATCH 78/88] Optimization of the subgrid scheme --- src/modglobal.f90 | 8 ++++--- src/modsubgrid.f90 | 52 ++++++++++++++++++++++++++++++---------------- 2 files changed, 39 insertions(+), 21 deletions(-) diff --git a/src/modglobal.f90 b/src/modglobal.f90 index b4ee2c7d..94929b94 100644 --- a/src/modglobal.f90 +++ b/src/modglobal.f90 @@ -213,6 +213,7 @@ module modglobal real :: xsize = -1 !< domain size in x-direction real :: ysize = -1 !< domain size in y-direction real, allocatable :: delta(:) !< (dx*dy*dz)**(1/3) + real, allocatable :: deltai(:) !< (dx*dy*dz)**(-1/3) logical :: leq = .true. !< switch for (non)-equidistant mode. logical :: lmomsubs = .false. !< switch to apply subsidence on the momentum or not @@ -377,7 +378,7 @@ subroutine initglobal allocate(dzh(k1)) allocate(zh(k1)) allocate(zf(k1)) - allocate(delta(k1)) + allocate(delta(k1),deltai(k1)) ijtot = real(itot*jtot) @@ -426,7 +427,8 @@ subroutine initglobal do k=1,k1 - delta(k) = (dx*dy*dzf(k))**(1./3.) + delta(k) = (dx*dy*dzf(k))**(1./3.) + deltai(k) = 1./delta(k) end do !-------------------------------------------------- @@ -477,7 +479,7 @@ subroutine initglobal end subroutine initglobal !> Clean up when leaving the run subroutine exitglobal - deallocate(dsv,dzf,dzh,zh,zf,delta) + deallocate(dsv,dzf,dzh,zh,zf,delta,deltai) end subroutine exitglobal FUNCTION LACZ_GAMMA(X) RESULT(fn_val) diff --git a/src/modsubgrid.f90 b/src/modsubgrid.f90 index 63c0b4b9..a5dabb85 100644 --- a/src/modsubgrid.f90 +++ b/src/modsubgrid.f90 @@ -200,7 +200,7 @@ subroutine closure ! | !-----------------------------------------------------------------| - use modglobal, only : i1,j1,kmax,k1,ih,jh,i2,j2,delta,ekmin,grav,zf,fkar, & + use modglobal, only : i1,j1,kmax,k1,ih,jh,i2,j2,delta,ekmin,grav,zf,fkar,deltai, & dxi,dyi,dzf,dzh use modfields, only : dthvdz,e120,u0,v0,w0,thvf use modsurfdata, only : dudz,dvdz,z0m @@ -286,6 +286,9 @@ subroutine closure ekm(i,j,k) = mlen ** 2. * sqrt(2. * strain2) ekh(i,j,k) = ekm(i,j,k) / Prandtl + + ekm(i,j,k) = max(ekm(i,j,k),ekmin) + ekh(i,j,k) = max(ekh(i,j,k),ekmin) end do end do end do @@ -300,26 +303,30 @@ subroutine closure if (lmason) zlt(i,j,k) = (1. / zlt(i,j,k) ** nmason + 1. / ( fkar * (zf(k) + z0m(i,j)))**nmason) ** (-1./nmason) ekm(i,j,k) = cm * zlt(i,j,k) * e120(i,j,k) ekh(i,j,k) = (ch1 + ch2) * ekm(i,j,k) + + ekm(i,j,k) = max(ekm(i,j,k),ekmin) + ekh(i,j,k) = max(ekh(i,j,k),ekmin) else - zlt(i,j,k) = min(delta(k),cn*e120(i,j,k)/sqrt(grav/thvf(k)*abs(dthvdz(i,j,k)))) + ! zlt(i,j,k) = min(delta(k),cn*e120(i,j,k)/sqrt(grav/thvf(k)*abs(dthvdz(i,j,k)))) + ! faster calculation: evaluate sqrt only if the second argument is actually smaller + zlt(i,j,k) = delta(k) + if ( grav*abs(dthvdz(i,j,k)) * delta(k)**2 > (cn*e120(i,j,k))**2 * thvf(k) ) then + zlt(i,j,k) = cn*e120(i,j,k)/sqrt(grav/thvf(k)*abs(dthvdz(i,j,k))) + end if + if (lmason) zlt(i,j,k) = (1. / zlt(i,j,k) ** nmason + 1. / ( fkar * (zf(k) + z0m(i,j)))**nmason) ** (-1./nmason) ekm(i,j,k) = cm * zlt(i,j,k) * e120(i,j,k) - ekh(i,j,k) = (ch1 + ch2 * zlt(i,j,k)/delta(k)) * ekm(i,j,k) + ekh(i,j,k) = (ch1 + ch2 * zlt(i,j,k)*deltai(k)) * ekm(i,j,k) + + ekm(i,j,k) = max(ekm(i,j,k),ekmin) + ekh(i,j,k) = max(ekh(i,j,k),ekmin) endif end do end do end do end if - do k=1,k1 - do j=2,j1 - do i=2,i1 - ekm(i,j,k) = max(ekm(i,j,k),ekmin) - ekh(i,j,k) = max(ekh(i,j,k),ekmin) - end do - end do - end do !************************************************************* ! Set cyclic boundary condition for K-closure factors. !************************************************************* @@ -360,7 +367,7 @@ subroutine sources ! | !-----------------------------------------------------------------| - use modglobal, only : i1,j1,kmax,delta,dx,dy,dxi,dyi,dzf,dzh,grav, cu, cv + use modglobal, only : i1,j1,kmax,delta,dx,dy,dxi,dyi,dzf,dzh,grav,cu,cv,deltai use modfields, only : u0,v0,w0,e120,e12p,dthvdz,thvf use modsurfdata, only : dudz,dvdz,ustar,thlflux use modsubgriddata, only: sgs_surface_fix @@ -415,9 +422,16 @@ subroutine sources (w0(i,jp,kp)-w0(i,j,kp)) / dy )**2 ) - sbshr(i,j,k) = ekm(i,j,k)*tdef2/ ( 2*e120(i,j,k)) - sbbuo(i,j,k) = -ekh(i,j,k)*grav/thvf(k)*dthvdz(i,j,k)/ ( 2*e120(i,j,k)) - sbdiss(i,j,k) = - (ce1 + ce2*zlt(i,j,k)/delta(k)) * e120(i,j,k)**2 /(2.*zlt(i,j,k)) +! sbshr(i,j,k) = ekm(i,j,k)*tdef2/ ( 2*e120(i,j,k)) +! sbbuo(i,j,k) = -ekh(i,j,k)*grav/thvf(k)*dthvdz(i,j,k)/ ( 2*e120(i,j,k)) +! sbdiss(i,j,k) = - (ce1 + ce2*zlt(i,j,k)/delta(k)) * e120(i,j,k)**2 /(2.*zlt(i,j,k)) + +! e12p(2:i1,2:j1,1) = e12p(2:i1,2:j1,1)+ & +! sbshr(2:i1,2:j1,1)+sbbuo(2:i1,2:j1,1)+sbdiss(2:i1,2:j1,1) + e12p(i,j,k) = e12p(i,j,k) & + + (ekm(i,j,k)*tdef2 - ekh(i,j,k)*grav/thvf(k)*dthvdz(i,j,k) ) / (2*e120(i,j,k)) & ! sbshr and sbbuo + - (ce1 + ce2*zlt(i,j,k)*deltai(k)) * e120(i,j,k)**2 /(2.*zlt(i,j,k)) ! sbdiss + end do end do end do @@ -495,12 +509,14 @@ subroutine sources else sbbuo(i,j,1) = -ekh(i,j,1)*grav/thvf(1)*dthvdz(i,j,1)/ ( 2*e120(i,j,1)) endif - sbdiss(i,j,1) = - (ce1 + ce2*zlt(i,j,1)/delta(1)) * e120(i,j,1)**2 /(2.*zlt(i,j,1)) + sbdiss(i,j,1) = - (ce1 + ce2*zlt(i,j,1)*deltai(1)) * e120(i,j,1)**2 /(2.*zlt(i,j,1)) end do end do - e12p(2:i1,2:j1,1:kmax) = e12p(2:i1,2:j1,1:kmax)+ & - sbshr(2:i1,2:j1,1:kmax)+sbbuo(2:i1,2:j1,1:kmax)+sbdiss(2:i1,2:j1,1:kmax) +! e12p(2:i1,2:j1,1:kmax) = e12p(2:i1,2:j1,1:kmax)+ & +! sbshr(2:i1,2:j1,1:kmax)+sbbuo(2:i1,2:j1,1:kmax)+sbdiss(2:i1,2:j1,1:kmax) + e12p(2:i1,2:j1,1) = e12p(2:i1,2:j1,1) + & + sbshr(2:i1,2:j1,1)+sbbuo(2:i1,2:j1,1)+sbdiss(2:i1,2:j1,1) return end subroutine sources From 2617a856fadc1954609a3c383539ac59a8f34db9 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 13 Sep 2018 20:30:53 +0200 Subject: [PATCH 79/88] cosmetic update --- src/advection.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/advection.f90 b/src/advection.f90 index 60fa378d..4eda0f19 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -68,7 +68,7 @@ subroutine advection call advecv_5th(v0,vp) call advecw_5th(w0,wp) case(iadv_null) - ! null advection scheme + ! null advection scheme stop "Null advection scheme selected for iadv_mom - probably a bad idea." case default stop "Unknown advection scheme " @@ -163,8 +163,8 @@ subroutine advection if (.not. leq) stop "advec_hybrid_f does not support a non-uniform vertical grid." call advecc_hybrid_f(qt0,qtp,1e-3) case(iadv_null) - ! null advection scheme - stop "Null advection scheme selected for iadv_qt - probably a bad idea." + ! null advection scheme + stop "Null advection scheme selected for iadv_qt - probably a bad idea." case default stop "Unknown advection scheme " end select From d75b3cfe7e9ec1a240da0da3c8605032763a3720 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Thu, 13 Sep 2018 21:00:10 +0200 Subject: [PATCH 80/88] Complete calls to alternate hybrid scheme (for u,v,w) --- src/advection.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/advection.f90 b/src/advection.f90 index 4eda0f19..4cd1ab27 100644 --- a/src/advection.f90 +++ b/src/advection.f90 @@ -67,6 +67,11 @@ subroutine advection call advecu_5th(u0,up) call advecv_5th(v0,vp) call advecw_5th(w0,wp) + case(iadv_hybrid_f) + if (.not. leq) stop "advec_5th does not support a non-uniform vertical grid." + call advecu_5th(u0,up) + call advecv_5th(v0,vp) + call advecw_5th(w0,wp) case(iadv_null) ! null advection scheme stop "Null advection scheme selected for iadv_mom - probably a bad idea." From 553dbc3150b108cd38088c66e6b31a0f706317ec Mon Sep 17 00:00:00 2001 From: Xabier Pedruzo Bagazgoitia Date: Thu, 13 Sep 2018 17:15:46 +0200 Subject: [PATCH 81/88] Possibility to run microphysics and a-gs simultaneously: first two columns of scalar.inp are qr and Nr, and third is CO2 --- src/modsurface.f90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/modsurface.f90 b/src/modsurface.f90 index a658fd30..6b89090b 100644 --- a/src/modsurface.f90 +++ b/src/modsurface.f90 @@ -1630,6 +1630,7 @@ subroutine do_lsm use modfields, only : ql0,qt0,thl0,rhof,presf,svm use modraddata,only : iradiation,useMcICA,swd,swu,lwd,lwu,irad_par,swdir,swdif,zenith use modmpi, only :comm3d,my_real,mpi_sum,mpierr,mpi_integer,myid + use modmicrodata, only : imicro,imicro_bulk real :: f1, f2, f3, f4 ! Correction functions for Jarvis-Stewart integer :: i, j, k, itg @@ -1811,13 +1812,20 @@ subroutine do_lsm else !CO2 present in chemistry indCO2 = CO2loc endif !Is CO2 present? - else !Chemistry is not on + else if (imicro==imicro_bulk) then !chemistry off and bulk_microphysics on + if (myid==0) then + print *,'WARNING ::: bulk microphysics and AGS are both ON' + print *,'WARNING ::: Scalar 1 and 2 are considered qr and Nr,respectively for microphysics scheme' + print *,'WARNING ::: Scalar 3 is considered CO2 for A-gs' + endif + indCO2 = 3 + else !Chemistry and bulk_micro are off if (myid == 0) then print *, 'WARNING ::: There is no CO2 defined due to the absence of a chemistry scheme' print *, 'WARNING ::: Scalar 1 is considered to be CO2 ' endif indCO2 = 1 - endif !Is chemistry on? + endif !Is chemistry or bulk_micro on? linags = .true. endif !linags From 9f8304d83fe48caa555085ab15689c5cfaa0c9fd Mon Sep 17 00:00:00 2001 From: julietbravo Date: Mon, 24 Sep 2018 08:59:23 +0000 Subject: [PATCH 82/88] Read/write ekh to/from the restart files, needed for first time step after warm start --- src/modstartup.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index eea0abc2..087ace72 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -814,7 +814,7 @@ subroutine readrestartfiles use modglobal, only : i1,i2,ih,j1,j2,jh,k1,dtheta,dqt,dsv,startfile,timee,& tres,ifinput,nsv,dt use modmpi, only : cmyid - use modsubgriddata, only : ekm + use modsubgriddata, only : ekm,ekh character(50) :: name @@ -841,6 +841,7 @@ subroutine readrestartfiles read(ifinput) (((e120 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) read(ifinput) (((dthvdz(i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) read(ifinput) (((ekm (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) + read(ifinput) (((ekh (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) read(ifinput) (((tmp0 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) read(ifinput) (((esl (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) read(ifinput) (((qvsl (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) @@ -907,7 +908,7 @@ subroutine writerestartfiles use modglobal, only : i1,i2,ih,j1,j2,jh,k1,dsv,itrestart,tnextrestart,dt_lim,rtimee,timee,tres,cexpnr,& rtimee,rk3step,ifoutput,nsv,timeleft,dtheta,dqt,dt use modmpi, only : cmyid,myid - use modsubgriddata, only : ekm + use modsubgriddata, only : ekm,ekh implicit none integer imin,ihour @@ -939,6 +940,7 @@ subroutine writerestartfiles write(ifoutput) (((e120 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) write(ifoutput) (((dthvdz(i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) write(ifoutput) (((ekm (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) + write(ifoutput) (((ekh (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) write(ifoutput) (((tmp0 (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) write(ifoutput) (((esl (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) write(ifoutput) (((qvsl (i,j,k),i=2-ih,i1+ih),j=2-jh,j1+jh),k=1,k1) From db0c242d141b2f6195243103371c4c118792eb15 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 28 Sep 2018 18:46:35 +0200 Subject: [PATCH 83/88] Make sgs_surface_fix false by default, remove from namelist. --- src/modsubgrid.f90 | 2 +- src/modsubgriddata.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/modsubgrid.f90 b/src/modsubgrid.f90 index a5dabb85..903a5da0 100644 --- a/src/modsubgrid.f90 +++ b/src/modsubgrid.f90 @@ -106,7 +106,7 @@ subroutine subgridnamelist integer :: ierr namelist/NAMSUBGRID/ & - ldelta,lmason, cf,cn,Rigc,Prandtl,lsmagorinsky,cs,nmason,sgs_surface_fix,ch1,ch2,cm,ce1,ce2 + ldelta,lmason, cf,cn,Rigc,Prandtl,lsmagorinsky,cs,nmason,ch1,ch2,cm,ce1,ce2 if(myid==0)then open(ifnamopt,file=fname_options,status='old',iostat=ierr) diff --git a/src/modsubgriddata.f90 b/src/modsubgriddata.f90 index dd018d74..81569c36 100644 --- a/src/modsubgriddata.f90 +++ b/src/modsubgriddata.f90 @@ -48,7 +48,7 @@ module modsubgriddata real :: nmason = 2. !< exponent in Mason correction function real :: alpha_kolm = 1.5 !< factor in Kolmogorov expression for spectral energy real :: beta_kolm = 1. !< factor in Kolmogorov relation for temperature spectrum - logical :: sgs_surface_fix = .true. !< which fix to apply to coupling of SGSTKE to surface + logical :: sgs_surface_fix = .false. !< which fix to apply to coupling of SGSTKE to surface real, allocatable :: ekm(:,:,:) !< k-coefficient for momentum From 8067376f9c6c187ad10810bb3fbc67659cbc3c66 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Fri, 28 Sep 2018 21:43:02 +0200 Subject: [PATCH 84/88] restart logic: if trestart=0, write restart file only at the end. If < 0, don't write a restart file. --- src/modstartup.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index 087ace72..bcd77e31 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -905,7 +905,7 @@ subroutine writerestartfiles obl,xpatches,ypatches,ps_patch,thls_patch,qts_patch,thvs_patch,oblpatch,lhetero,qskin use modraddata, only: iradiation, useMcICA use modfields, only : u0,v0,w0,thl0,qt0,ql0,ql0h,e120,dthvdz,presf,presh,sv0,tmp0,esl,qvsl,qvsi - use modglobal, only : i1,i2,ih,j1,j2,jh,k1,dsv,itrestart,tnextrestart,dt_lim,rtimee,timee,tres,cexpnr,& + use modglobal, only : i1,i2,ih,j1,j2,jh,k1,dsv,trestart,itrestart,tnextrestart,dt_lim,rtimee,timee,tres,cexpnr,& rtimee,rk3step,ifoutput,nsv,timeleft,dtheta,dqt,dt use modmpi, only : cmyid,myid use modsubgriddata, only : ekm,ekh @@ -919,7 +919,11 @@ subroutine writerestartfiles if (rk3Step/=3) return if (timee=tnextrestart .or. timeleft==0) then + + ! if trestart > 0, write a restartfile every trestart seconds and at the end + ! if trestart = 0, write restart files only at the end of the simulation + ! if trestart < 0, don't write any restart files + if ((timee>=tnextrestart .and. trestart > 0) .or. (timeleft==0 .and. trestart >= 0)) then tnextrestart = tnextrestart+itrestart ihour = floor(rtimee/3600) imin = floor((rtimee-ihour * 3600) /3600. * 60.) From 39f75a78e881575c0f4fccc0948bfc1df04c7795 Mon Sep 17 00:00:00 2001 From: Fredrik Jansson Date: Tue, 2 Oct 2018 12:21:05 +0200 Subject: [PATCH 85/88] Add kind=longint to floor and ceiling functions of time to prevent overflow. Rewrite of PR #39 by Inti Pelupessy for current branch. --- src/modstartup.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/modstartup.f90 b/src/modstartup.f90 index bcd77e31..1798beea 100644 --- a/src/modstartup.f90 +++ b/src/modstartup.f90 @@ -367,7 +367,7 @@ subroutine readinitfiles rtimee,timee,ntrun,btime,dt_lim,nsv,& zf,dzf,dzh,rv,rd,cp,rlv,pref0,om23_gs,& ijtot,cu,cv,e12min,dzh,cexpnr,ifinput,lwarmstart,ltotruntime,itrestart,& - trestart, ladaptive,llsadv,tnextrestart + trestart, ladaptive,llsadv,tnextrestart,longint use modsubgrid, only : ekm,ekh use modsurfdata, only : wsvsurf, & thls,tskin,tskinm,tsoil,tsoilm,phiw,phiwm,Wl,Wlm,thvs,qts,isurf,svs,obl,oblav,& @@ -791,13 +791,13 @@ subroutine readinitfiles if (.not.(ltotruntime)) then runtime = runtime + btime*tres end if - timeleft=ceiling((runtime)/tres-btime) + timeleft=ceiling((runtime)/tres-btime,longint) dt_lim = timeleft rdt = real(dt)*tres ntrun = 0 rtimee = real(timee)*tres - itrestart = floor(trestart/tres) + itrestart = floor(trestart/tres,longint) tnextrestart = btime + itrestart deallocate (height,th0av,thv0) From 26394c80153e27380d4fba06a04f4a621c83417c Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Sun, 10 Mar 2019 14:16:59 +0100 Subject: [PATCH 86/88] Revert "dont exchange m-field halos - not needed" This reverts commit 0c2cf5946339dc071abb65e0530e36fda855efc5. --- src/modboundary.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/modboundary.f90 b/src/modboundary.f90 index 81b157c8..2f3581ad 100644 --- a/src/modboundary.f90 +++ b/src/modboundary.f90 @@ -100,12 +100,12 @@ subroutine cyclich call excjs( thl0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( qt0 , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( thlm , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( qtm , 2,i1,2,j1,1,k1,ih,jh) + call excjs( thlm , 2,i1,2,j1,1,k1,ih,jh) + call excjs( qtm , 2,i1,2,j1,1,k1,ih,jh) do n=1,nsv call excjs( sv0(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( svm(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) + call excjs( svm(:,:,:,n) , 2,i1,2,j1,1,k1,ih,jh) enddo return @@ -121,11 +121,11 @@ subroutine cyclicm call excjs( u0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( v0 , 2,i1,2,j1,1,k1,ih,jh) call excjs( w0 , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( um , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( vm , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( wm , 2,i1,2,j1,1,k1,ih,jh) + call excjs( um , 2,i1,2,j1,1,k1,ih,jh) + call excjs( vm , 2,i1,2,j1,1,k1,ih,jh) + call excjs( wm , 2,i1,2,j1,1,k1,ih,jh) call excjs( e120 , 2,i1,2,j1,1,k1,ih,jh) - !call excjs( e12m , 2,i1,2,j1,1,k1,ih,jh) + call excjs( e12m , 2,i1,2,j1,1,k1,ih,jh) return end subroutine cyclicm From db8ee09d186eb135362105fb707d7153d359c8b2 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Sun, 2 Jun 2019 22:53:37 +0200 Subject: [PATCH 87/88] Cleaned description of Namelist options --- utils/doc/input/Namoptions.pdf | Bin 169306 -> 174530 bytes utils/doc/input/Namoptions.tex | 275 ++++++++++++++++++++------------- 2 files changed, 165 insertions(+), 110 deletions(-) diff --git a/utils/doc/input/Namoptions.pdf b/utils/doc/input/Namoptions.pdf index 41bd18ed86f39dc36b125313ed8686f81277ba97..014452dda9066341f062ff5a5b0b563666cf273d 100644 GIT binary patch delta 132976 zcmZtuW0)pUvn`62ZQHi(sxI3`mu=%M+qT(d+qP|6UH0jH-ZoI}9PF4Pw-E|a6X<`g^ISeioIN8<#7y)R~o z-k6|m7PH^J_4ow6MlM-l#2wQPf_)8_&$Ut2-aIeZV8klZ!vHo-SU}@0cA+ZM)5j`AJIZm*<0uy~wbqk+wQ~78t)46% z)MuD_dgN=C8{hD6By3RQ=T;ceNL43;PWFKC(vw+Mp)Jt6rLT(kTGBu z0;}tEbS7}+gxMFzrGvb+dOE4EE*m(SfxPOwYvi81S$bzTAYsi;;|x;pae&=#1P~It zo~5Q!=1>q#k`IN$Vt)E;_I2yQdZ%&a&(j1DMTWL=Id&$0fRPojVrm~VT7vQ?XOT=I zi)FP{KVG9{234~RW&X{xxfz4`UQ%lsjH35*2|E%=Lkoc@dWFlCtX+FUMPculj$w?V z@Mt(llGqY;M8Qfl`-?9A79b`QPX--e8Kpf|QPyF*AZ5PNWyPt*Xsyny+~_4BLWS)r zaQkRR&0T81m)8LN)9k4|H?yJYf@0%?!2CInvnjxFPUuIbnnnGTBtlj(t$^t;+9d>` zJ}^xpB4`d%uNc@<^-CZ6*hNM?fb)y0YMfn+zXq732za!PL&g*~Q7!$QI_`)qg>Wo%#R8 z6gxZX|JXSG6K5R%aF#R!g8ZvEUVjRG3>@e;7=+S)IOF&qXROTs>x=C_Fw4Q71pE)R zSyJ}6oM`^H@955W80pk6$7f3oNh40m-cC@F1R!Pba6`7XWs|eF-bYtiCK*yjo#T2iP5Fu?nlBNSwq)h;M-3`8X(;_2 zby@XRbo6t6eHcovkCInrxLJ#v@`pj|44Hkyxkj~ne1t41JSAZR>{ycgkCiZQl6uT> z*BYaZVTtq$S`s5wil;U7l^KyIxSr;wi~onRpv zn>3-EsEwE_e<e_!reNT0uW>~IrLXH;XYW8@i4bhwPaH6k|gFm$U4Pt^* zLJ>l)`d7vj&3$leTM6t!xMX+y>HuETITFP#=81Q*+b&pms< zC1hvtd|b#LFJldIUB@E1M~shP%XGRbM)v*}*rBj$ak9|$^;a_3gs+3X;iP*EO-QP| z@-6D;Po?*o=5=hQ+Vx##E zcmyf*1ZhDY{MV-v!@bZ7uEa%CtPbwmsK-OB0|v*MZ+l4z_uNiAINW)%nw-B^&W2ahw(H2Y_nPJ}?nBn;8Y@hM zeT{l>1Wbz06YHY@Ak1J1DoD0$;XAyRK5@CLo`LQLYT2U4#!%R3p>Unmd%_PW&XEhh zf|{n~Y(%=$3n)XYqvp{N-`Tj*(-T%e%{gNjz~C|hUAKMr^i9JA^zy50#sIOn_} zV;ruCCBlfK2JVXM9YOV|z6@k+?fRgXaS-X-LY74}@2RQ)7kuNMpteYgi~4-kkBK0g zDF=LF$lwQ)BeKifwJmC!^tKCSTP>;DF<|$zvF4J-54w&@CG~14tqf7Er`3)sL;ijo zGN-V+jSJ;Vb%shl&iVF8*N z68-Dho#*3#4ZAXd6Q7(QijwiIq)!AYRPZHFQg`3QaHfm=Zqo3xZ3|vo`29}qZFfK} z{xq_+#dBRK2gm6>Wq?P6mm4byo6Ui}f5pl=dWnYsiw$D5*<;m%Ih7VZct6 z$DQN2sPRUE0I)Ot+Y`{Pcg&6`Y&uS8v@g8m)T>ii5Pcn9pp$%zTIcE z(@6|7l_|3+(zw)}b8uu(-JSaC!zkDDnHDnCFRkz+-bCsrO_w*mu^5jUn;~cT{-Y+j z=%i6Vh72$p9PfH&V&^SP904vUXBy=fs`5mO#R?a6?!56~^-&)*GoJbBMm3G69-RqT ztRoBWuW83}$x7buRiI1d_vraa;MN?VP|C5dJVF@@$~*H8hSuhR?f0Mq*ZOy8{U6}b z7YN$_BnkHaW(0C87-n{+|K%KJrvIP$|4we0nK=HNDKup47ln{cx_W=d>66(%Gk@IG zLnkmv=UdWq5h28<0+BRHZG!&fX6TJN6&0&lGUQWDcoFa(-ur#Tbko)ppG5jyyY`p_ zv6{aggi`ky(v~KrwWhr#BI0Hm&6CioS?>6la;rK+v51#=LJ`I6Pbd1)i5CVR4Z1efx>nRd5HVz4+FeL>i7O_&MUYGtQ>y+viq*VEx0KWk zlT!;Sy~Y0ED%<_C)Qy)O=6e8hjgFefRPk|$0uWS3Wu_WtrXF>%a*$|tfP>o>hc0ky zfy)gGp_eQO6%INj!|1F?4EMr$t3x!BpTODu1eXO{qRv&JN)uT~><3Ey;%yLf$kAw{ zWPI<_hEtYTnS(yZ3>Lwufl4uGJMa%bi*{%rzs2W4S%G!|!|h5#KX|tjIhjC)+Oy2d?XP zkS5|QvEth1mERC3T^ETpLjt${TwEhJ15hL4kK$4-+UpB7GqUg3QuF#YF%GwFLV|!g zo&wmBg^MPE_Hk1r(gb@95krrjBl5vw2p3jq591MF`hf5@7oE#N4|kZz`|?(8@ycqcfRxw zlmBl*!@>H0z{||}A6X7FGuJ=xk^y4W#_e#K;ksuvrj%%C)IKCf8K^f%gyv1`q!26c zc_9wy zzCU(ih?}_NqD%#ZoO%e$Uxx2{NsnJ`w=-+rHKvcmIBwty;+B`|;2I0Ogn%M5_jN2j z@8B}Df&6t-eU1qHHm04)J(5NGlaJSutLq~q$QbWVGGjpk_rproXKWOBX>T`BMCo?0 z3UEH|S~?TDs8(GnZm#OEzLj-kq0eHW zWDfh1$~AEYIy4cBv7>d+IRLB_&6?dbxY0liejifkb$f_1)DbaM@V#)U$vQ?1)(@=i zI4NadM`9zebn>5SLMG5IV99Hc;lwY_5zma@&})0V%FxM|nLPtyOy_~1*Zy##q~AnvEK0wR_WBvIwW;_h=F;$@tO4j~9R4#S?BSP+ zAYUYy$^)4^by8FwBY&6+NXioH>tlk;G;7O;C-!3fsTvUBL7GiZIu06%gkTv{yQg`z zFHdT`?fkXrLKwuAV#Z|AtVDFqeIql76N(ZOtV-=jjONPc1H7E0Vb`)iA%_!1kb3T~ zpz>C)PZ2d!3R3e5u>kH5ekj6MWM*Cqq{i^P=F6B9fx5KxAVS_bEs1##a7f-8&-pf& zAWWAKnI_64wt(Yb<`xoF9FxwQAa>IDe|iwqQp#1qOO~nbs?h0u7h#5NF{r4TfGe}j z!;Ua2iqVv5KJSxfHv}$^<&vhYDApIMyO`RA?52uCGi;--MF7h0y;jA}YNYqwXQ38} zc7ZGz*ORfCdeOv^UTKpcD)?R;@R+@LVx|F^;gC}n7xSYWgBEtYnTD+jEDYiV9&a#U%MZjl;#k`9E@mndLwA2s6un2@)~@ee5L6029(Ly;+T| z5{7KPtl~|peyG3{e^^Jgrb>p3!yh@Tb|%Ohxa1g_-yY?FVHz%#!4c^gwgua2&Sif53c01@PaqC`ivN#=vHTBHGPD1$%wlHY{?9KE zE7O0k>sVJNX{!a<;Uonh-#N@(@6)9U&~!w!^E95?P~c2z@z)M-mlIiMs4HoJGbtADzsW2-KMyd zDSc(_XPox3{oaJ7t>)L#?nzCLeodQlOlr%?dBzXH5AP#At}*;zPl>gS>!*d|=PKdl z=$vvB27w@Of`}vS#go%;e*H<6U$bs=%s(k7)7@JA8^tROqFS}Oobj_nwZXzWV`B#h zKx2t}M%4Sm(dj3R58E#cde&-6PkUqF((Nj@i)=@#jn1ZOcstS@%Lc}JSH9nyN~_eX zOY_=!Q2GlC#YHOt2c?+yXOY}R)FQ<)8}<9f`Sac+0>Z!%p0lb(AuZ9bL(H?ouR%C>T$K&wuZfWR9W^&@JXolR9X3A5mLH>vqk#Ic!zC zf@#(Pe^Qraljgo`=2LJRfvibfmE48+a5yS4j;=kMox#f<|0;mM|1IX}gZDKx-mmL1 z+zqKtY$5rbfr&2%E4mLR&{n8<2@>zcPkhOQwNUb`lzD4VI+D||nQ{u2AhIDL8*UAQ zTp6GS5DCuqC{qfC2DPnTeJjSS$J2xcKI(t~nDr;p-Qe+5e}nXzCph58YpJhZKCwJs=U!mwB z6$w6J+M|7qGJ7VB@NK||pJ>4(AIS^}6}_7R@_7&IPHmvNqv<<@AcMkJ;@E4|B%q-f zlwbvLt`a6613*o3+DzNxP#a)k(h&IBx%A8ukbHcR2ROFI@I32dWckttF_A0y$NKkA z<`~V=dxWS1eKKBpu!ZFWJtXa;38+cV(M(9RdnOy^%L5%7CN|^KIAp2vVUKoWs2&sm zf2MNLlIQU60vF?XrFR^oL!JI!d=TOKMX5imr$eWf8AD*mZpD)~*;eRq;#DOa07p{< zp}F>^@h~PgH&%9UMMi|s~l~0AxG-_xRi~#?t&@1+YNs5WjBt?f>*4%8+ z9CKcpz$rL~Mq)H9G_h*Y4FJWh@%%#H*p(!ej9E)RL7ez~9b*^YWhAalOqA?qA%7QG z2Qf}SfzBkQjAeNK*YxFcQT_rRz&1C+V#;$CpOZ{-rWj{=D2v$fn?ZzAgyipaFHac` zIQYHsX9_bzdIXGAI#Tugq6pSGkB}zgz>ySdKtZ^Mrsz(5Vm0A5)3tH_(P_q9ZKJh4 zU%IJQHcP()NEizqR~Im#kB>M%LB#&}8ior^1nw)O{>im?M-Blv#7GeYfRrH}A9Eo( zFolTgi;A+aGZ9F^>tir{P(}68vpzDpx}I%qPCQR)ZL2*6@q}n0jrA^a(v>~I{sV+_ zzkh$QIeaNSV5^Pj@7=;;NMKEClruED_;m0+f3P#Jv7B|8m&b7PRrWi|+u%U(rPmXP zP$EwwkB)#qjVye@CTb850D?r8A)ZLKa>pz68_vUtL<#9mxVJMBg$*)G3~i`bEHGOn z`M|vuo%7DdDZk$}Cx{H5UIg8kgI+`!6GsN77bc|?z4qXB+PGOP9mLoy9L_A#7Fq>V zwq2FCZdfu4PN%mfW{+<0DF|UJRT&>gE7F?E&6RV;*h)McvTi&x98nB!V=Cj19^ zVb*FKebzyGfAu;SP_~q&{vlvfoUM3jYB_$|jUL!PoXCYu(=dnq{HOeG+G(?rrS-U? zQWpvtZ#71@7u}0!+RS%9saC(H@IWiVFJZ#Baw^tSVrSTmk`g3ueLPa-WZXx$iX6c| zihAF{L6llpJ0j1y6wD|o_D3gjP-S2W$yj>KFjfIN$!IePfWqQHs3+}_=Q=kFjsfYJ z3md(a25a&>R-@ZDN(O?E9Ty?gDodCPWfnV?4#jf%gNzzrU~v}#WLz-?G+gKs-7Uq^ zH?;$gP2_w-jJ@~od5t_i-p*@}2YYZp(Z40pe1E-yE-=w_msDE#3{Kpnii zLC&THCUWl->TfOb^eT>-JMlKf15qeqLmhZW%# z@@|Q6Janlw-2+Mf?o3vfnA@I$BHebSavyQ~-7#)>ZPc;g)yq5|fiK1>rr)wY!Q@WL zAk2OeFhu_O7jQ25Hg+7uFLkSP;nX%Rn67ThWU%;oy6`;^gD(LNJ<*O*a8 z(Cy#SqOA^jXB#y*j_fO%5sA9psmQQ#tI`)>dwe@!JMi#Nti0|deq2A`;-oHI24Kvj zOI$$+OtcaVESe-HJR{;CxneK%ca?#`(*;Y0pRO&r!FtTnj>r6s8}_+pe(vF)qy{`$ zECm~Qm2h4nU?Ex)-9k()&-d$tpFu0ugtRGo5L^US=Km{uWJ?kjM+ITy{;#q`k|#bH zz*+;cq4RHz{OP62GG-_Dk%h-Nv<=io265K#pPJ5&j@s7Z0-eC0fzzVN>1%tkO##n( z;!Vn|OL$lJ*8RizG_gx%vjx^>uC85Ar6zr4>CS!R z3NHj`)$y{%Q>=QK!=cu6C2bpnoGUaTVEMs|vXb@l0p>@y@7fvbxe()r=k4-jXZ)o9 z#ETX!Eyk&KD`KQiN3IC2E4fY_t9WnbYx?@bz}8@=i)VN1do+?=zsRJEMHpn`5o3~g z`ARd>ULo-7H5K}o<6louMi9*xU@=lO)~1fApcM8%bwp%fvt*YfghgU!eP{S2c)lIS zi{9+)ew$DHwnx$~(0UOY@&;uhfPIJ|Tsi_544IsIob?WpNH(8RI7yNy=X_zbI!JsMFX-5Y-PKiiyNXk!1Gfd|{nEK#1k#ukHEJ{rr+yN#mwbRMm6GAj72P!LK( zxLT4gh0Y*t6WHNxG>%1}O77N1ss*{FCN`s$3#nQxZpAT^wp0U#Xq3}N7$)lL30!q+ zb*{HFbYi@q1@1_H)xh8kKrxUu-Z7h6UkFFOI_9tk*qK?@F7Z31y^q~eQ~p}Ywl5Bg zd`{I1)i1!M41qq`H8JdI^puX01iSqKHo`PJ*C!aAf5 z;WY{y}Qzt}$+tDB-BD=zrAVW41lL&ObQv$h-VggIILKJ;tx!srCNI#YcQt=n( z85lxvNP1+DwZTI?36+=#*foibm>7U*_EEw{J$)cc?FNLNa%4QDoN}Z;_&C7|vis{bH6PaF)-^9^vNxFVnZRKJ zq023R5 z$FYrsu~r_(3tkbk9s!=>7x_#wNNVU^`$f%scqc?@1|b^>OQ_{xYXEv7O-JzZ3aMYo z8MA(#u#2Z{5YE~R`%Rv?#xCyAkhk|YtRXrV#UX-T;$EY)J~NLkn$Hn|E*Ub~851Ec zbwSZ1PPymBHPZOIl|VZhhQm+BwpSFvr&TNKUi;x8pGlm*n+HF4B+R@)I4i5osze zeH5iAFo4jpxggPk>XOMJP!uOzo#lz;tk}HO5m!vPXS2epTo(~%FVuY5_u6hZ8CyhXCPf83||pQRl8f5?=%@Hgk#Bhch= zX;`##Lw^q^>K263Etz}9qbYJ&@=>pPGSs7CgB3MDjT0HtiY(ldm=n z*smX;*Q;&ZL=h4<*|lC=L9Y28NS-Brt|%F~_lC!K({rF=qo77j zDcM5K*E;&zb-EEf zdE*aP-58M^;EDbb+qC&(Eg7T=+q%D35xUgK zZtxr37Z$#UyIU}vtr^!DqhJlU+T^N!Z0Esy(*VO0p&bG-b{Lg0H}nyAp*;NxgZB7U zE|RChNx67Qvb2?n3~0z1g!sB;_ZRVr zB`M3qWOJU;o=gDfy_uZX%@IxXaXmE>qy zD83H!O`H~&d`6#OZEh<;)R@ANXFKkG@&ug7G=CIsU(cVT-$@*QH|YcP+*0*}@l*Cf zcwNn*FqkNqwU&_d!?3XAJ8!8B{K`$NS>qc0O~}YI5ou@=(2OrpgQVFARh0|>#REzV zB>S%jvCc4!XBwrS+*ytzQxKC`tTBRxML@JdCC4tcnxgSF%EFjPSfC6ulAxg624Jl+ zaA@^x!x>{Vd0UXCX@38ikX=%(Q6wSFOw7^AkA(YRK#E9klwV^W4rK(=HT%YQZ;{;$j=g z$L=}n)xEaJx!F?_ly}ek2FWndY)(<%zmn#_ib`kyXduK7q#RmgHpbQi$!po#bD6i% zvX>}*m^^XLeU!Xr-9>}XPpshVhbc~9h@$ZQA6@*3OK^s133>mo-828UE`fh^9Lh0&4Q$Xoog#K?oA^_-`X3k~SDzSk^%D6NjcDQ^@QD z%7^;Eg?>TIfRNKob5X5a8!nnnCd>cYa{$Y0T*=WR&4J(r#Ec3ZG+J##@NOuovun*rh~a3W5dy#a!2|Y4hBikRrLQ3$G3r)M9ykgE7^oszfsGWhflTT&zOf! z72b~$LXHwjNa8IB>?1R7Z6JeunIOjfd+_(vgA6euyae4-^CU( zg))eyiG$rnWp$ufyX)ldsGj&WZ7R5Eoz4FbP0Y2tA@D0pd8fGSJ4}H`*l3`J=Q%SB z+M`K-r&cOS{3a}WZ??O1?DS%CUPE7#7<+0L`W{0899XcFtfnZy2j;rEoOMB5c2>vq z=J)9vRUR+oJrtL2-r-RpTP4(n5_MYMZAP(!-gC1a8AxIsnGb_bKU?}ynpH=`pdvW# zBB(q0RH}5;dKkT>Uw$4o^(i@j#oZNd>0htqNfIQ={e#xB{Kew-tWH?|o8xSY?2)K<}+s5|OFI>6W0@Mq}97w&hN zuf0t;pt=0V1hn4IbITcFfnlw`ARd1Uuo83!1Se~cV@gZ@iwV+uaG_x=+kX*4l?sH8 z#Rb09SAWd(C4=7&t(9b3^;`O=fu>IgroLpM7(Jr%rp>!X?+Fb|g*rCM($FTOaKBs! zj)K1bH;phTwNSz4N9{uE1I{&0nVlN2OhRY|3We^l3WnOV$H$yb)ANWj4#G)Tyi6yK zN|)D0pw~ey4T%m=KSf#=GnhuY;0>K7HbE;vBptCw-5cY%4Cg?ap&ke>2`eW%%m219 z{&&*q|BM1MbEMsi0+T1<(y0InJKOZ`ZhqgJ0qs&8oAB9N?d{huOLIgx89c z3AwJ&P>8j5=zh*c3BTBA!c=Fx%mKLR$Paa;mkAG(CXJvycA*vx5M{P|2~uGI)<|EQ z!h0#sr9UOQAg@gOeA)Ic z24ieT8g2~4hD+{zu$nD<)NUW+rbXjvc`L?5m=-XrxMj$qxD52|7)yE9+>S>!idP?% zi^$VwYz>)1$V0NMbuB;@AkE+~1-+RU=H7(i4*@c*sQ4ByE>oxwyf6jq3HrlxYl?H; zRc`XlA@FUQoIxhl<*lI#6WbsQqX)}RAn1jB%fmZC*=m@4PBG!{c&^uqmI~~#TP;7Y zZvfBi6lki5DJLC2>@b7!t^nBp2GRFMB)YV{AM}l`zvn^Sd<*Cm|8>CI%67vc9(4o2 zq0$5%*kf&o>W@d}dce~pyHUgNOx1TYbjZdP!~@IStIaYRr#=&Ey9+?NRa)4*XPG7X z8uG*%CztxP(-qLLE*yEu^5BT9__&{PB=ITpxH)?wf*e4pH?;hfPiFX=Q7WH{64^QY zuR0TJ6cu%Fh7=(AWFoQo6p0+44DyDShI`JV#xj?c%K<@YJb*QP0wG&i)ol;2FcI_x zrKAnonww{CLr>I5MPyY48eb)eIn@%~88tv}YAbOs0Y#=wDIhl46$V_9K`hMCM`CJS zN&zVBtz@2^m;ueFDxsd;EMgy22X#Lqz_JNUHFgxxdPb3kIb!o35KIjYPJy$XdB2@* z`CEQOvBuy@)=<8b4z;1aFMRA!w-JGn3>bi-!tBT9hHeR46E#vYny=FKM~nPNus&VF;mZxrK`j1HbRWqFcMN;FATc77SHm;=HVU8s zK?{vf^$BDKul}rHVAVr+|6#SqsLZ_MIYjxfMS528jE0<&!w%`uoW@0IVP~0IQ!tGR z?uMlxjNlzJ-uxACAVul`Vjou|0J$(?AEO8g;wB(XG%cKOj zj4qz0C=yM&%aT(>8_=Sugfji;x((ouEfp^iYl3pK-B{l~((wpCI^6@8?2#kkp?g2l zIR$z!Ih*sB;GfnkUwg~+hMkjEPBh2)Ow$VdwRsfbIFw_Hsae)Pz0@v`40heT$CV(b zE=Om*akFu#7ve&-T<$`DFF{VtExmjCT!G)xX<*W7+upTwR=e!-$a-|`vj_m3)I=17 zRor*&Npnbk{43n&#C-FT zEdv;V)%1w~y`25V1~Z~@WK%#_dBpW~n|oqH_??=>1l=^=n9BaX*&*5|cby~4chgA4 zyk}!9c%0j+BPxMow{?3vvXB{4%Ie2=p>)+P;~%k+@50D`KtArmw`~6_LeS<*%)DU} zx!mO5-m*m@%JC;-@Nmwn^i%n=gT9ySSh;VyZ0i|J#ky5A5IMFeFbO@?Sw&Xg+a~45q^W6&0+u07FB(psB}EnpUpx=g6M2nc9Yk1 z=Jaq!LLqixoowQcp9SeinA15rci%;hZgJqqb=MfYlvBmIcImZWiY5dFUeWbxplp4K z9NhulvLf$qL@gYmKMtVu7&rbSX!SwT?uKKo_@}6}n@EYPTmO05uV&#=yIE||lWy4W zYI57KsUgl?jlxHG0DM_01zkCg)Lri^#_Y29Pwol__6K3uQ4$|QT8HpS5C_u)xHDL- z!D)*kbM*NvsQ7adhWU!F3Vpse zHlo36{0+^{{zhH7gM~FyL0ddNK6ukkF{!Tt6bgA_ZH0We9BCHk1rX|pAcjtOR&)(j zs*j%N^C2m*8QFH9@b|=c_lOi|lVrUpxtuQVwO&psD;-E&cv30bHNc-OC;!?_CGR** z{W$1eyu(F(*F>7O>69V2pj8)IiNBXtV_&yR7(_7l*u8q{?nlJqv~qPcZ6^funIPXr z0%nZzb8!1mNtG}97JjwJKRIl317AePh`KGmD2>?Q{11?C`>Wtlju-BKPAYJ)5HV5y z_h3H@JL~@$Rp9uaNu&Rp8YTO-IE*_+u9peJZ>L2%3VZlewee*Mx1LvAbg z{WC@-detFU7xmiXsQ}+U@7s8ZqBnKMeHdU^{B{Y&4TZ>Enm8L&;M>(?~ z4P;uny_$(PE2k&nnZ1(mvcDFp?q)bK)Gy84fR<0sKW} z!20ywzvNSSk;Sgbf3mvPcu!!!v!e~%lG{rRu(JyEvELPl4wbaWhB5O2lue+9mjmT6 zz~iFj^^$gV0U*IU{DYozKCqmG6USQJFw%}hpHdqCuR$ORR%Yw_m%ihfvOlh<)9;D| zgo5{S(jGTd+i(CJ=$Ry1%1zMZ<`H{@Hkj#jyc;#HexQwrL|zpm7>rgNbqw5b(a=A? zIn$8QaMtO0q;52H-nCvLaA6y%x}gf^_h(pUCh)J6bpV`VvSv=4SY^E%SOkiFFEG)c zs#_>AsdA1o$vqTSpeR9%lt{S41O%o_F;i+Vi=M`k}OXN%7he#%{&r1R2SI2s=hrq+F8<|z?2`_sCsaWG} zz2X?FRDi6PO;+m2P?e48zNupn$zrSn+aXzK61`M!`Vm>-LW5Ui;Rgna&X6=boR&j& z5_3~CP$x4u1);J-dXZDBF8qL*=yn5AH=YXdtE#H|@SF@)LD)LeYE+3*Ud%jxOFC}| z2%qgXn(0Zb>}Cgu!P^O~H%}#SM?;S&Ftk+JzX0vYhyDiGRIFx*AtOkW-!3UC{SPq# z55L;j7c~u0-i`&)>d7Vuhh!unDaepb>L5yU{17P5gt2%F`kjPs|{hXXV7<0r+>+^5^Y$7FrK%nr)R0M8H4-YVMePL#FgLvF3DpGtK_+v{=gc`}UDkHbRR6TKTi{42k zyb|n5jy%P;6SHV?HjvA$E{km*Tj5aCN&-kbCrrUB)FxT$nz=qou_F`RcW?1JuD_$L z<7Y|e4$pTv2g7wSh^!FDNS!#!$N9MZ@4al~f*eOyf3Tw_JA`c6J?Lgad2u6+tBL5C z4|a9Zb_E~Ou(1ziu^I5T1u|k{Oy8)h` zltg;CiN-F)vP>iP2nw+W1&cj4{@RG;E=v7s;>uCY4lhfJglGq;$nR5;L_ZHyHSDW= zOo--Xvedo+71-U~lRn^V*(ZPOTeD}RAYHbgNy$Kvr!n5*cnVgJxf~hHKgLGHSD;)u zd<%!1OxM2|NT**r$F0#C_*o=t+RyrdT6he;i3L0lvGyh5zhq6y#`NZz}; z&1w|%GoKy`EyeV!S2=YAE3!*@SZEI0KSLmit&{%KNhdzG&{5Z+R6~X4E2*JkU2LkX zq4OpXKjzY#r%g<+lHtw7c>)bqeFM$qLC?O6I&@?jDpNk?>j1qDCGQShdG9ksZX(<3 z3~k*WJOP2JD^l92#XwBgj0b1~o0_F*0~;A;N$X1v_;KOZ7aYH@Ii(+2kmJGZro9|5 zaxX0H@l=mJ#$Ih`)EPQH#wE^;6sT?p1e=A|F=X(H}y><(7P3e!IsYb2DP?6Gb_!w zZg(T_k%8AdDTb)Sm<})%`h=DBJj!kU@;s_JM`#!DdqBT2=Gce(%)}J8LY#23D4AQU z0Vc)O!>CemKOz#ZfCU4Js}XukV>8#6jHrX5qpoel?M88+{UqS8p2It|)LkT}7CWt& zNt@PO>r#)LTt_|ef!xiCEq_e9&okmP8s;$TB%?{503fE-FIZM)a^( zQo{^3WA^K7Uz+l=u$_C@Qh&3DoD@QnYe`=WYqBs{=j*3`n;1h_bg-#g9(QuCyNR1V zETqVBs3X^+p%j3PcdkZ9I0Os_#|Hy}q=FUrj%g z3+og!#8I&$-Bpm2GUWKA1}_hOtve)kC+G|dOmcPe*$=Qq?YQ4bUd|YshCB3Gypc||ZB@t0%nh`Qy0;d7L6GD`HOi3c^6kXWTR)*G|sb+BZuGX#^>1)@kV?> zBAoqI`uq^4SfsBDqykB-T8L(C2&cFUM1e$&F4A%Hw>G=?k!s79j^(TrL9t~Rt=Xu? zh!tZ0sV(4*iN`R$eS39Lhr94s&B&n(Od9Lki6_;0A?bHftbwO?a4 zZ3AH%5AgVsflZNb!4J&+hmdL6A74JEf^^I&4C$^T5bnoh52Iy#?|b@KSrB@!kqT$t zaMuZpzdPTBXMtlek|Xr_OakpeMZZs4OHAc!?Uw=S4bCO)k#SX>;Bfjgt56WEixm^R z+E`+@`^fUE1bWr)g}`OsOA_#cB!T{2&DbwvS*!pjg#j-<1yaYE$IjvE6fYDj+-ye6 z;|`srBqXs8c+NyA5q;s9aiG;jjVzbljkOyL;zgj6p6S5`3Zi zGS6iT2s@1vwmr9l=ir@S0-xHEcjQ<3u3pjG=DE&>b?`^|KUv^Af!Mff1Vg8RnQIwH zO^J$}d^2;RF81yx`-j3{H3V4mjAP2@tup{PAs6QAhs}|i(0JmPyUy~8XxFK&BdD*8Wylo5_o$y-?6G3(Fu^C3=ySELHqI1a<|0!3ROHZ!}3M%VB$rYot> z8z68qq{b+dbSpt)+|8*^SbPU0EC_&m?a8|ar`gT;gc4I*P8JEPUcye=61&kxL3_Y{ zzH@_5;MLI}Y$0QXO-R9G67AdO2!>7ZOZ-aMCv-rL){i6dY6I~QX0Y}yvJW(8&B`L< z$z#hgA%>(^&J;B<6nkM=%oT6mqyr!nw{-BBI)dsY=VbO69<9gT$%cR)ewYt9_j$we!#<(ms`wep?q#UWaX0+d%HwnzlZV(%YKd z&fF`Zrgj?W7biq<>^+3&-ZR7y7v%;%-1sv-8)XLb|Mzc2g0Lvf;BiO_reJ?ex)nwbYM)M0U7YTlScc= zuTh@|_p$6ztMN#l7A2gdDvQs zI|M&OpI){wa4Jr^NsPVg1TVCRMj&yvZwz{(V+H6H;n4`fa7%yoy^-s@dBLbgA-Vg4 zVXYfDE&{TAF)){FMC+E;ms`}tbe#GixL;YesCMdg6*_63lfSo2x}yNf3KI5VR+;_e zkQY2o&;kpg1r;3nYzPFK3bL;v_NY8(XWmmg$zi;;8Yx5_Pq$ z$9JXkC1CC=Tn;#Y4yMH}HcB9pDs+iNXLzx6qs!{UYfYb-zJgLu=0gL&TMhV7cTTZ)ucnNDs`B@2ZU3(gl?7f_?Bt`*3KpoizU~Ka} zFZydy(2)OKIsF54Ks6Ke|51DRpOZ^$|BgZYZ+n6BUq#~o?@t5FoUH$B%8cTcHc8M{ zgn&4_R%DK=&D@+1Jo7-=&Nm8VGJks9aFESFeVKCs0Tt8Jzt+-lAj7os^6TZ&VE91AXkN5pNXJoD24a58L^soZvl!4x`V4S^1 z9^U{jSoXQ@?b^ls(=U(YYO*9+W0TRh3y}Hiq%U!7$<{3Tpoh%Mr^#vcYQUBa`KNkx z?JXx>Y}N9m`P$N`}sje^_Ng)P4v#!Glkb(N&|j>K}12lZuk53!R6JYoRMVxb_85H z%UWy?$gcHZ0dF85T812Z^vkAHX_3Z)vbM%G);?Sfd0qeQ+0p!?h1pC)fq zb(7(yUe=@nS=V-0TK>W=;R;4DsQ?vu6^HRbG3ze@oY9F|_ZpsOM|kRtKu>WV-ZhA@ zs-QSMxm%3Ej=TM$m3gS|e4xl~DxH=58<x$g_% zr92AugvBOSn6RAZP{%3+S;N^+yJg$j9Do3M6M?k0D{lzQyF13)`N(h*qw`%SoMJw? z{S6iguxZT^eNXZs9y*RZOM0m@H#nZ?;O`r`IbXC`FFIp(_=N3Tf|PkaWNIS)3R%Lk z5I??na~z5=fRjo&F4xcv8t*Jx4)NOOp=wH|>cd<&n>@%)lmV~o1n*AQma-Ep#3kyC#P0B`22i`ve zD6AP1ezYry0eW^#YZ3T)yeUGM zd(BEFuC_$SRk?u5W}i!?cFa#uTYKwt`==C<50voo*M%%T#o?K;<)DyWI|}mBg+W7; zP_|r7_i2qvA$yL%V?)@0U|@&&MDA$-SsxyvA^ku%?ufU0$C&W}@A^V_l+5$E-cR7o zKr8!vTyWcyG2JcYj}c!+wov~FF+0hWWDyMQMRr7PKb$3=%gQqrDiX7OZ5NfgLL;Io zBo>oUC&gR2g4(ECZ;V}ZTa{SYkryYU!Q2DcRH1Mxco*L#XjYTiEqCd6n4kcFu?c)& zt=M;ZV2xdS?p~dkN6o~r@Z&Xk8I$la76p7;-#&e zbhg-8l7fx6lL3-4`ZfSa0qXwx#*CWJy2=Y$G2$W)1dTYIFyI0x3aM)Z2$9PA0EIH2 zwzIX&^j8QbIQ&8}LSkT{r1|j@`tUx_P@3hzyM)xT8Fb>*+RNrb_BQ>r_NM zkrwphk2rAo-)vMOWbPT^;@1s%VwLN`N$g5n7Jn!gEKSp>@LaVBz>f;o|T~2 zxCEX<0JlU?!e?96AVeL2hv~}uy|?1;4XKv$?hJ6{&$NLl_1QCeO_4SO%|0E5|YunK4cub~2^0LjEdJ_IuU z{%!y@Azew<1F@FBgAI)9UTxDh*wd6Gma}~&46LRFjFk4)xQs{S}~!<>VQCnymNtBP!GrG zhfHIFOyg1>P{6Ne>tT46L?f>UjF1#AFG9i?A!d`;D!s<(+dgc=6(u4^+;?o3 zp;*}5XNXrGmvkzx4V<4Ost^v`ku;$|2Z-Uv$V}7yrN)wXFKvFGp?F4i-{;-j$^R&J zpP^Tq&XJ!(4mnbt&DI$-6jR}=cGppO4KL@Ix|v-Ix9TuWnQ|dv(=dBA__O{F?mV^T ztk+_NdR$<~$N>W9UWb)hoR947CT-Xm%9KW=2Glg{26|x{>)qGldW>mG_um*UfW)V< ziEr{_{gN9lLFNiv-f!*PcR%q_4p)J4GuFwR4pIK~Ns!{-Q`w3%>yv&el&f%hCM@t+ z|N07SK?gDdTsTz(=Yc2;14iGp1RcB@E)M<3N1t4N1~YbDrQsMc3el`i{7l#NGal9n zSVcPUIHBVAd&s{0XHbx)785{B;rIK8-1}iSSZOh8bz5}hQ?lrTMj>7F)l8gjT+b)% zb8_D+?X$Q4GQyH4xOB{W7~Q#MRr++FyUsg)wx;Ns#$^3}wa5d}6AaZKE2uiY^5o*rpT9?j{mRJ68Y#{h(J<>9P zf?hztg8D_c7Zk<@WrG9U-n0h#ruJ~2Y;^he{CDJ=1mLa{7k#l1q1hLMuZ)VfjIy+Ce@2HsC%5dvjRHBej8JmLqE zhgNt3sY7d9U{s!5`uhyjoVj~4e&G-Eh;wlxc;K9ihULuP<`n_HrlmYIq&(7jSlcj< zgzSNlRgwk%{5{6>iyk7+d=xyRH4mSS-#ry5rCTK5fq2mljHdo>mP z0^pm@;XGn*yYC0o0&5&9Gx#$vA+$d9uk)r|(HHzxFiSJw`TFiHNh2OINDHU}w%p#- z(i-!`)b5Jy_6?wvyBG_6rdJd3TJsEEXHGR!^BLhc&Ug%nS=u0Xl;;}E$VtBm2plUq2Lp%u2h91X~N_$YIRY-OBE=R^ubUFZVb2i!9FJ{|uJ#C)+k{1|D(^`a|l=l0qumC&KLnKtWD*PqJl+}JQmUj_h{<3&@ zS_?g|+yQ&tBfSvLP$wdiPUgb}GR`n*83trIz-ABt3|4s+qFzaVq7j!PB^CJSX%L3O z|6-hyP2>X5;aD&}aj=&`ZjU6NT4`_xaYb#z)_d^ZFY!m%OY*iB9GzF6$e-7IO`moc zV_HvN1#1W~ZXRpe9YUL4@+O~P_6D+qPV3>B<zZH3W!9?(Obb6`G zX5KwQJj06xzOP?^xcEnDooqS#YVDlhPch)+OL;*kRTKB-{~`5M*R{%tGu2)HS7Ycw zpQaO_GDnO4k7&X0OO{cgY8&ty#Q4GTr36z`MC?Vs)L_0v--k2fJOou?S|M%scl~qF z*Gq!Yjc~)rfMaRs^B@zZs;f%6uE2|mz-8DYa?I@lpz+ZwTks^+Hb!kbC_0ow+9oXz z46M&}4TDn@7PI+qt>qt}0u>7`5)N{XH!h<5E;$e`K+=SNxSz`~ zY^YZI@b+kOzNtA4?F`j71ND67*a3tjBdAYxeU-J;ol?d+`8*_2K*JJ8L1Q@qLI)4tpKr$X$RDC0`HiKW~?UX`Ch9O5G5E zJ4t)dnHvtTvc%d-paXC7(C0Ifne#6&^=(2r?LPEiQrXJ5nksg=iSE^u5hLysVK6H% z8LC}ZqHz~Q8dL?%3Z;aoVXCj}{Q-=(878mU+!%!q+w_X_pgC!7lzbw~85GYANO|{8 zmYBHtQKT%5rTsJVdOl_B9vof&P)0I zvD{4=eOuYU7<#&25Z`6NU;keh`@fF!e^_g5tV|sL$Ho3Hp5W)}f1>+I@)D3BoZM-| z#K6=5PIQEu=9wD-b?=PQbdU2j8xXbK!N8ypGCFZ|X@aF&AJe^9Mq5gSFNoK^?4omJ zMMF#7axx``^^S$jGt$$O_i6de@bC3s3i_kC@d;-tX;Bm$>f&PtCi z{>m2!17FSH7wn5(#wYtn3qS||-xu-MPw|;INE+jAbCyhi%hz#(@3AFeHvhIXy;}7p zEn+>#jfSc%D5Jd>J^a(o)n^0m^Y&(!-|gAm#k8R3#l>{qO(IG@?{QQ@4R@5zynQM zLJo(~_5}k#sY;v`R;FE)j>Hd7`~&a!9Dl(oyy!y%mqL=G9SI47<$h6YBf3 zU)RnnKO&uFSUM4}n$=AXoYx&ivMB_}Dy#!W)eF&8aI?eeuJ?@8#G`ff8goH8s0rLj(>r`e79_vEN8r1hLSM;Abbw%v3} z(yrL`DXGIta2YRYja2|T%OUUlZ{z;&1<$X_s>@ zO*)_c$@5|{-2kh;nD!&FB#9`|D!MV{F$L*lS&*aGWJ;~F&60b`>(XWj&BhI~U%u6K zgI`fqJHl8fSt|K!5oKEzp@!g^lG;Y6nUj)J<7(UYnY*E59Txyx(dQXq)642sQoVm~ zv{>d&9po72lHGr2SkfL*SJ?)6&;O%0Az)}V&+O&P_7#kHqsCn7xg$lvrz@a$kVK^G zH*r~GVEJ(a?`qVqD7=T;Zeu~L{X^-C*Ij?@;SttNSOxmAnDvIoKqUk^u)83MLwk;Z zkTLQBfX5a-s)Ye}kNvS+VLDcA@-Jq1V{KvJ$8T2bLvJu+MXfM@xc*&lJk!xvgFBHh z;2NB^VRqywu~Nx{=^`%BY*^N7vNaJweG*r72oKtyBRK3!=1+vA1AUaL1kY#i$UNQu z8w0m)=RwBZe{v@mM5k26;rXUtq}q7xD45 zf{h*oOwz0{;|2EJ&q~mn=VpoWdH-h~dOo&55K@nSk@Q6P{xT~n(C58$Z@$Z4Rhg2* zibigSS{@z{9^t-VUs4{JRJW0`hYbjxGxiz{a1sMs0Qpro2IoVsL(DwHdQ)D707TVv zMpme;$~p{gt8dcRsItBhUlnTAC)eec2NQclQK>rxMgez2Da5HY)`?N^cbGg)e@Z7- zZ}A`fN_3QIC;qK4NM@oZd^_3jAteF`6Q=!J#!p4ba$$y|n$R(Gd7XQWNDGPYb7@;t zv$f)cx|@26!s!a!1<@mN8sAlju?&EhE3A(vVq#0lLbn))iDR8jf4u(cCXdQMj4;`aVW?n z9T~I6d|!Qt64?nEpnD7;ZAe;H7K0m0bKxb81 z1w1)hBm>{9>qiy|YPwQOG#Z+`fx=OmtTB!$8nsrGs(L;pcOyAcFzr8_bu}3)-wpt{ zvrvV|Q1cZ7uNwO12|KRs$4n`@M^dI|BY1_lX8bsZDR+c*PT?VbG~~K|Et&P*pBTFd z;n}f1>b`V(2n1p`EOt=()t$V6TT5_Nh(Pz#!jzqL2DFv~d9yi18gRVycU3%k{o0bN zPT=p*vhgCaoQkZmDl@Rr$6v8P#dZMUzKK%vlCZ-wAInwdFzg(U$T^{axWp22c&vpNgPa4j4|{RZM_m3@SxHwMIiXUN+qG!=!V&i7r+2Fbo|=D zd<$mu1JkGnIFUT7auTazRBz&w;qQiORm7`GFa>j}88Q(Nc=UAcy~-qQ=}-Rme^x#2 zri>_%Z$`i~y-(^M{2*t^2D}Zht6=^iq-2-!P`O!w4HF8J!W0DuCS@CBMVVcG?fVbb z@oApYPZ<{BN2^D4w%BYO#?u1QP@6X)=Q+xR$qe;JiiN2&vm zk3x1sO&d^9fAOVU4bi#%=`lHBv0?=Q6uBP0At%;4NrK!ZPG>949GfFpwPsART1kZ% z#E0p5qJsP1PSaPuT7^8ntIi%%Fp4-Dhr-Uv9$g7|%-{s-(_kuMS@{CqXshD)mk_4> zEq3+3iAVA1<|g2k-`%PTk;eON>n-1j*ZZ0oKbr*{o_!+4P*1P^?U_e`N-<+V_I6rZ zlKc(138jBCsu`XGnM%_7#=M3$K8cQ!C@^e?cem2_?JIN@`d$4g@LJ(sck-UvZetgF zpcTXq^A9tCFL(2v-|hgg)lLzc6T2eR{x*+`GmwdAT~kK^nMs<-ht2pj4_>3oxEUeM z*sf8%;op>c9s&$2MOo9pjLf24X+h0-DJy#o9rv^Y_G@D5^JjBVaM3(`LtmNwn(&XF zhdG9ho8BbsCy0a93_bx0uv$o9)FmTM_oz4^IGiR*wTO6-Jm8tXO2(r^OTk}(Z{+C#w+ z^0Pt&)MTC9S^ru%v5&C>Rhock0B}X|y5f!>F`O%%HquNQxEwXEYS|z98JW|CM4P+v zu;tssA-DBHJVF7MJo)-Ka~*wdF&;OuO|g)(ah%NAi7|$8##n~y$;14<{f+;bfDPNU-avOBV@ zont!`jpv8n$FZ|~ikdo4f#G5SyQuCBkLt*HoJr0Qc#(hv!5S>r+;m$0V_@ttr!Cmo z6Hn^6l{udM-)RoPZ^A1l;k=*2{U`D?NA=HoJMve@!UMcze*zZ!jb=&3neOCYc8O!g zu^Mrj*g1JM(Va;q+i_qM*O?*VoADuJ5SW)Sp;9k=iHSoDcDE<65~gUs^|Z4TaK-Gs z#72??ItKw_FEjg4lgG%i=Ne3Ykq-2-WVu8uSR1lRqxI@GA`xqN>g5GTei`@~Dc6f8 zO#020tw6F%W$cC1=AAGOx$I5^aJrrRd(?bUL0%EbKFqsz6zg!iNV^IgBW34#Jw${5 zD$6(^vJaiM6~jz1XlmQ1X(&_&&4ixhD1Ze`R_+1m+Y&?jH0v$xZU90Ye*_|lnA_V8}GYAflD}t36Sb4h#q*l_oc?bu_ zG&hoe!jP=3Q@=4fA3%>aS6Z79pBdrPa8%l5ANLG)f^1UDi0Ms=Eak4hzZD}k24UL>hw$G zb=4GxlYQlrAJL9z`O<@4e3!uoP-d z2M0vgas3fY-%B0*m%;$w*i7ess{hFADt;x~xkwIbbkuEyf=X)*?7 zEzk_Z1+P|Ee`>zsoY@W7fuRaLC@V>WuK4KDCDzQS^;AZc)d5wR;&Lb!@_kjRX=n&g zwndq)*qfZX+(4M(txSCG;Ucd}fLIV%b+jerd;ZOYs(mXhqM)&r?sB z<&(ULH4#@VQ7VJI7JcTmKq+2(uuC>7$Mhy&;xjv%QdgU|L2z2XkYCY|rZHqe;{67$!_ykdv1Ys^SytrHvk0M16~ zR zWY#G&Ep&yCAK0SRdF>egd)z*r2mGW=fj!P0W;@0{J2S5;;wqGqHlH`65?vSYpqSt= zxsg0;vU(6sA9iGnxtLh~>gOG5{!=qBh#I7=bOqYmsbl8lKyd)qk4oJmxOyqg>?0o6 zgEbNO?BqEoQ90j^OlQP$)}xprmx!Jlx;IScjO)ZqfOOihS>V(&M=jw%8~9SHadS)E zBgxyLB*Lx|^YBspdu$#R1t}RI7eRhf+33pop-{gm=}hzSg}W8Om-qlNZMQ(p@WD#s z8zzRlswP%x`MZ`dfjLQUw8kli&jC2m2dz=HVEsTD0l5_x7B4Uh3O^1Si&wDGGS!h{ z2hIu=`kPX?!x9B^DH>?a>>nqv{gfUFYhbg*Mw)p*cz!jrYEZgx%@AH?|?b5{b>$OMY%lJSG&LRfzJ!8bfJy{;jck^A{Q8I%S%NO zpG=*&D#7)S%}n4Q=AJI*L%W4Ya;czOl}?UA)7?@- z@Ia{7(4k#A`%62f65!u{Yv&|2?Ud@oohnQS<{$oCPwhUJt9*{lE+mY}ecL z$$xp<^I5E6)Tq^%)YlI;jAvMGnW+m6bj+-|TzR_~8{ZyZ`aRafT)*q*@6iT$vlwWx zS+MieD=$4?Ir{RT%xp#%aUkeVnYfJWd(J$cioR5^H*oMo`O=7SG;rkhtJiSMEmf?U zy5Bg$;lXIO)^2^^F!X`zGPEb>iJhV zFk23Dj}0{}J&bMSVrjXqao7ZOwFLM-9^IZT^(@)BpVz+ZKc#u@EN{*%6IOS(c6`~m z&8E+v*9eD^*7Hx1ybtnHeSK&t?&gS&KmTx3I}l*g3y08+uHeDqD$C! zuNQW+9IXis7tH0edLfG16@;%b#%^JwKT^P2pI%g!3tv zZg3w5#g>VgW!)CBn~~H-fTnN6+g0Ew3JpqWOSF-8PW8t$c+~+;Aph{cn!x5CDI6ep z?6I+MAl#-G(q@^LVD1KB{LImawwGmlVGRP9W zI5UbBq^VAHdEvVbIAj7{;mDI%{Q+@HWCFYjmtNL&ka!!U$UYrnpzz^XNs`_%N@S*Y z(BM?;7(EA^NGiY|NTcPy3xW=>vqhhQPXy=5M>ep{i#Eg1Se&6b+oqYIH0!BD2#n3B zYZ$`$&CSrOJSEeG9nl;7L4@-_!8QcjS&I4cmVdh(zxdbM%M935f-G8Aqx!y$N+ZUE z4aeA*jA(UbV^N>L3EMnKhNrRG-3Lvh>1P(eyu)Gw1+4(&m#5;!f3duP+rcUCt}7e1 z0Sl}xnxnnGRx@5lXXW>l19e2qF}wL*pRV)-l$Z;iq5CAW-)tdVE}za$oS?zSeUwo9 zNsNK_Bs@sisQkS2Jb1NnZ0>if_K^}GMJT2EX2~u{SmMLImQW-v0eZ{Q{mY_fWqk0z z=yHJY=xYEmuKFsPzM}SOCz8s`eeU z|LC9ghuQoJlNz|L3gN-X)r=4>$v}DYE0h(atE0dvzq{eyFjrmP#lUHIDY3FaLxiA0 zP!{5p5RPc%^(-L&R$?^3`(=b^vC%l@mlEKdwHrzAU2$WLw9Z;MwX`nMi7imx1SCs9 z9O(3f>w%!ypM#6-dmwe;J6IHQxBqLj4bA<{4Gc(qX#?v!DY1i))r?KRt?lGQN>F%Y z4YELcK%X>5SiSt)w~secw^oK2U#N0i6j_vy1y|7GWWTvd)H=nRS2%vkHJl z6uX!^La1_+C&HWNAMrFav@;`_FoBwzP|0!#+)DLmw-N=}PVzw~u}t=%)K1eT@!a65 z`U~CNdJjZ3ht0D#*ACxlE>=o@7NWF2!Q4vTI`%1G7+(-}5W7 z_Tr>#vrx9OukzB83EIWvmj)IlpgrbPspf`{N}aKXn`s$TQkdcJ&0w1X?7quLHhyip(nG+_$@(* z9K8Wz!ehk$T-iPeBc?QU*U#Qx>fkKgnH4w)<^gPbZvq%zifKXn8U~!NrW;Z+BKd)M zDMu-A2)?~3({`XCcc@6R;m{@L9;id8grIERfWGKzS0Do-l^9KNMpOl}2SKjP)+fyT zL)K0-}bDxL;zJOxTQmGv(Mfn)c1skmU1p^z+LoQ%c!&9} z>Wiy5`jF3A=SZ!S>H&6k-1Vi%0!i*%*0#RV>&81jR^mmw$BskZ=SV!fvdTJE*{l}E z#XM2XNE+8z+XY-9%KRdktlx96Lsb^=!} z?eePyuJoGJ#Bs`>n2;2k{QP3UK;eHp}iB3K1s3;teqN1!cmjvL^p zUQMs^U$-BV1z^(29UOmBvCjWk!{*vwTJBTd&O|>*k1+;j4*NPCHh=n5^{G%ma6ZjU zRPt2$fTuwViPF{Lg2!5>%8K@U(?q|!K5jd*{bK;!w&_^7@!6YTl1hs=s1;e4t~xPg z!Dv3Pbc{6S_Pyw=!&Vh9hPlLN@RG6m*2PU;$5dwd1Hk?d*;TG6``gf!FQkKJ;Hvv- zwI4ZqygG%Wz8MArS6bZvcOsiWuI`4^Ps1M5*y6ph3Gckl?A3SlWSl(iYkn)x&8nmAQ0v1x+9ZqI zgn}FzJORl6RG3fC*N}6T+qAT__VhSfYaZC`H4~gr605EuLf$7^bt1VLvhWqS!u0jo z{GFR43;7#i$7qkG0TXugW)^+ma*i5nn6(hL)+rBhdzH4dkPU|Y(4k$ zQm>i1WC+WFJl`lB6b2-T=x{{f+Eir&jS2p`2av5H*pX>9FomxtX3QGd%n6ByN6% zY8t=(yL5^`Afze%tuO>dc?%cPsKzrMf6yvgEg%Rq{KcG+cW%P$>D3%oH8KM!w}O?9 zHwQ?;?jsYKg(6GD$V2PU_5^_ozx3^a5RwVbiRpmxj&>nS6uoPi?);$zD-haV3~Z#L4lqAfS$6rpMY67GJ+ zhcQ)u`L$)lHxFi|9MwTq1s^VV0j7WeB>*VG`BiJuE3@;-1kw)$y$SDM+02_Bg+w9? zccgO?2W#=shq+T}b1t)lLmcDw2=`Jwi(_Spo9_oKN=47nvI$KplRjnWhloOO10-mJ1mM4cIB&=}SwUIO zLpRhdBMw{y>%_VSv=h@)>KcV^7TuBks?o5JmRPGrNfYK*W9YDqG~eS%m_E8XGf1rK zW~OUjAMwH~6GFSBAnB*rrnFkZcrjpaBL%#PGP`G2S|O?xYs|D?~N#2E=LK7Z=N_zZ-6RHV-P#f&QCwsn0dTZpH7&(cn&TX z((D^$jvVWZaHW4|7eLPZ+gNc*6)kOGGV52$w1rto2U#COh)H+IoL*4~y#vtE){1H| zpscTpD>sSp;?HYm?sV|B?>x$}N}u$?j~-P$`cr*U?HoN*A#LR!4Xu7G#K`tnDYdxfesa{RCx%E@4n&E z(LFR~^1J+7`r1udwn>^ZC^gA2A zkpjX}`k7BjcC^OhR~#svm5aqjufhJZar_Z7Q8QLw*JdF05WvZh=vd#>ZX<-F&Q_{5 zsz%GVl&!l0_^Mtu$DT_bPc~~|XxG&cwV8p_ZDB?*JJFYgu5 zuqp9hmLg;n=sZ^<=byi2i^0?}IO!6+nh-(G?mf20gXg?g?47to|NAk<8}#rTVdM!i z7`i2yiewfjyz@2b9M$)l*|Z*O;lSyS`^5fw8F^jU9&DGT70QZk%5G60KT0 z#<sx;4$PP$RHV4*TwMRg*9c{Cqd--OUCn6AY@_8Oj!x&nLu9jTHw&vP7N>b?)gSVW!(VPc~>jQyih0dh0RD{BCi#e%csN|HL$u z660clcd3*sv=t#bX7`90!R$vs={uoV{i|Hw7Km1aAf5Lbtt@qc-^ctKZXFVmm5=8e(;?SUA8|;r$ttSH}_QQdbtVB^_pQNeacR)a>1n2ibB4_q_OH=DL?tYc5h8+YlkiM zOasnqn$tlLeR1I2`Nf-IIEwYQ>y_+h1S38r9Kg_o8xP!c50n-b_I5>OC_LlaqFgB^ zaK|Qqoq`YYyXgPYk3#a)t>qLR0@V$4QRk@f%$j)}mNxPL@ zD^Ml&(j3X?Sd&>s`A=jI{iqFdYHYQlL!E7$<+#o9aZTThV=@PxW@%nV4<>5H)OV1=p)y}6u;|CZ$arQcPc6cUQ z6!UK~#DO!4`(l-Ozs?jvjvHra0ke{lvD?<6_F6$x@oP0=G0E|CW`VGKI1O_qbGtgX z$I3tfLCIqYhb*}bmpmn>39>DHJ!Zb7J}UgONt0eH;wYUUekA0(W>RAOv0gz4@&VV%F{F+4jw zV02{$D%6!&F9vVVY z8>RoPL{6K2?BILj?gYL#r2!0aiFjw^t1=|CURk0W20?)4b1Q7~1Tk*Mx2N zTOQS*%AH$S-O4g`(6p_lUaubZ5gJvLngKwg3g8WD+V1=tI6&T=A=2({xaT(KvN zBd<4Zu~U&MFDKJf23d2=Wq{a{)FlLx(hoGg*aOfX5Sl1v3^x52Mu{U69w zX@{o|Yjxw=T?!Rbq(w1`vSlOHK) ztqqMcD?P?s$DSD#Z%{6!kKBR=sGrY92X2SJh6X8MdP9wSD>4hlQ9!|^;-XAWA++eI zZo$t>^#bj8fBQwTdYgSe7Jjd6iZMCB;H=3&z9IhoBSqy3dlv_Q6N-Q>@}UHdp-2SpSe zh*k9TQ2<9Ct_f?DA5K00BOANIWfD~seakN!PJLA|qX0&7%J|RgO(_;k@7$o)j+`m9 zs`VnFBhAdqzWkxIb7whTZ+JS6;5N$!BfEN{0b0^{uaIf}9F|cQjcaRIb_xX&w}PGZ zi5xoP{=B(SzJIsGldFamdITGQqr0R92Om3?_y}GlbYE2OB*Fkzuf4aJV|Nmh8i_vr z$=>m-2H?Az#dFEq+6OVrQ((`>In)Pr)PxWWEW_O@bzJIy&*d?gcqdB!xqUcm;Hr(JKr{mFR)NgBp)` z;w_Y~Y;!wYbc`CV{ln;#9!e}M(J`0}2YMprRs_EIyw(NG@6$*}HeDWzb|Q|JLPWhV zG7(6Mi+3AGz{qQP3iqap&p47*(}EBUI5p2#3i<15Spa=?;c7{HN5i;Og5hw*ii(O? z9m=1nMSg`bNm3dZOa=qc?M*J`kJBAYJ`!+xKq*Z|lSD-N^O6ZVn%H(ua7~2 zihhrNS>Mx#eiwyBY)89?iq&g3M~pmi$iwhZcW_#1 zJ?b6B0O3vI4Rl52O(hJtpx*Dr1Hl_nK2ug$n#70%o6tRN5X%9q*GTK0Y`C%A0^xF? zFrNqht>H~`aL0Aq@ws${zy=1VZ{VAdfQ-GHkPay7yT4T{fi<8A9lw{CLF+WWcvCy% zoY%mMzsq=DC@&wJ3~^o8_fsLcWuA0O%_K8#WcFEoBzU1Q1Y5kP1`(h*_*FV_bp`AN?l&=R%{p~h z!opU=88a5UCA1pBMB_4xn~gW_&bs4yAioNXy9rn9496unc`k6@f?lGF3`8fa1dZY# zjzegM*HAfvj!&lP zmGWKE|g?p;BdiYA; zTP1(3PZ~xI%o4GVN&pdvBk_xdCr+Ea3Xzb_2gL`zA^WkGKrGUI3sqU8`k;iJ+ zh^=ZqMxm7KwI<;vQz6n^^#QtCpV>Z^#ARjODc=lmR|RMtqR9mxh(Eh2)jt&G?e~2F zX6OLpb{hjK->dQ?WpKcCytsffyW@*#Vg)$g<;G~$P&%Vp??Aalyx)O1P>K3Py35u) zh+%Is8cq9|l`2dN?Vu5C`n(&AcU8IY7pZbF?Xln}p0+V#$KgNvOW#jG6VNdHkrLnm z`(P$IP6~0(u~-6=C5pZ#12P_tf8r03!VGFW!!BeSPE8B9*ADiWHM;>!|R0}Cl$E`qMU z-^zndv}sXQ%HHR6sRkwi?=m=wNwejtL~UP#L^4> z9wl93p)|9i4X=W0Oe)CGYKfO?rL2%7buXBAO(y>rd|*WzZ}3y>b@)f<)%qV5>Pra1 zX@Sn>y6uDR#`|ilk-}Sc2Oq-iYK6C&fw;0?)Sv5F0{O_;%mV&#aQ0RJOCdo0Wv?Y2 zUtVn{DjaO9q^u(NipsaH-%kIWP$-?`s#-+Z{996-`lAO|6C?Sxl>!Xh?-@1mu)HzkXBS!wfRw5L5t`X_hQKY+vrBq@jTlMgs5qZ|8>Zcj5HV_g1AnWI2mIgW zG7K{}JM~Wl^*`n^3n%CQM%b}1{lA^WS(tv?Pyzk}u={C9m!0&V>T$TmYX=G`pfMJs zA;hsK9ATqlBU{bi#?q-89(KpeWfghi3}eKWE5AXYf{Ip&S3lY--rw6Rqq5U zzJ~yW0_z)ZBGH%onz+sWo!)J`Und-2_cyCg)8M(pyIG~?^xFn}Yaz0)8qQ5k8tfu= z0LC8%-Bx7R7W;efY`e8?_q!b+0p3)lVzb5RVD+na*OzqiYUES++Ta2a=4(msB47>n zxHE|M9%*m#?$=O(4bPPM_h<+Rbqf(mT2o6jzpu=dOB#Fn=J{0euZaZ#47( zBj#LDW4ItzowP)q{$U+J8@tNCc|VMUK<{@g2yNY)U6`0@UH2*cr+IhD4X5i8Fh!fZ z+o3oYufcli;n_Q`V`c4W7`neUx=HCpxf`R=5kJwgOJiQLvMG8`ONzJcAJ|eCLrw2t zxMR7%GvxU^kb@5NUf<~P*RhXzHf`Ov40k9du$BbKjVxWubC{fKmFX|P)E3srPKRvW z&8I(>?TTt+;P7pclNB^*aN6xAV6#ia^>nkS>p}FW_1cfkwBhXiF0AnhwTISM8u#c_vUjp2aGYvCZRkD=)tIf0)q{XG+5;j0Wls}%+(Pt4KbaS=9e022ga~o7?U?5 zGa8qSWO+{&7H&~VQ$>wH@H6hRdzbib#}sWrz_{F8LQFgNUk57dt08-M*?Zjg#%8h z$0cNmkB(I+qIe?^(`R$lGED*>#-KWBf_kfp%+6;AH?Er7BSz}mz9dL)LLy&4*=omT z^EE`76)ot0DO{!;n%D5V4A%_<$ZsPpBZ~H21ysHP!4dBX)OL}eRqSe_FE+6wtYns_ za!c7o69Yo~WZyg-&~04K7TiTk`f$OITA1v%-wO}BrBuTpLYl=eJQ8thjWb(^lJmdV z`o`eQf_B^3wrv{|+mnfH+r}H)wkEc1V`AI3o!oq<&bjx;J^yysuG-brySnRH&+4@n zF-=AKZCEK%8fZBQrShSj!ld0+0A~i&_`M`BC)E1uJd4@4tt_dgr|Ru9D~&wp3Qrmt ztXE8>1Z0eFK=LOQ?+mI`JMpMT^}Nm!_jQ9I#!$1q4lLF!?+bt`ZL?p_#ma{3)rU-a ztSviVHJLI+t>VhBb;arh0c)wjp_%h4Ck`Rd(>(xz;FiWG8t~+%0@=49$A_8){tD#~ ziUvb;7Mw`2MS2~r&jCHVD$m#dBvg}@Nw1FobQP|&M5tU$rY~_&Qty=Tfpm-qoKk4U zU0WBOZ|t~>U;?OnfLdzBvLE~1yE&wSLq>|Su7|OkFYc zuy=SN7}x6#qfFxam@~QT`lI-c>{m}2FP^G74fjn_vAFPzY&E;&2nx$uhIq#zH1^{# zDhpe#V+WZYKkaMMdto#rdCOf*nP^08?c`*E-Ks$)8>j$<>OIKUtOz z@I73?1#JLS(0w)9rRo8bnYlJATif1A!{lNx)7ljpIVppsvpmx&@rv9{<%y+w6~{a# zgg%vxGxN?wD()mSB%hq)oZO)vxp8{}^5okB$uNc^)Ow1p-Bz5VI-Ov_@hd;yR1WMd zYo?^w(|=O2Ks1P48_2C!ewoSK!1)gm2R-k|=+c1q$^J*(ynQjWJj_1jm+bkJusIbv z({NfJG|^q~piz~KqTQt3!U;Qv$Q|Pq8pZH|b3#ImCkfk1YZL9Kft(ag50Y3ytrW7f8tH&^M?wr`sSwDMx$eSJqmM!Aqrlf- z=MLI$;pwC#NJDni^kcSL1tz!)lDmfyj7@-O2t$LD2`0HK1w%%nv1mQ6VNaC=Y` zgC<7PSDv+-VotMQc-9n7DE^yc$)R}0yk0f-Nzp;^J;I)owPpb-4F*UcAMlu(| zH{smp9gp_-#AqNFRU}DLWVKp>hdNvM-wsjEo*sQ;$u1Px%`mP^>0X znADq>BfTclFi9}i=kdamK)m;sCI{ha&~K=Q$-quW8;eYYyV@XcI+b?^>Lvht-Qvq} zP=;BK+s#V#BDPKSqJ?&?jcA5f;&u_7!nIaRdH#g)WplSvHJqcCi{6Xx0KM~O)Hmvcwm_+H`a7Jj+cN!wC_T3Y48C?DSJ z7krOFCfA7&lmy!*h$nQOm!GWTyShYm4RgVcR#_=|#VgdWs0N59(C$P9W*@RO_*&D5 zIJm_S?Q42fW=pZ7K7DAIx>3$|>Q87T;tHd~vbcqK*>Y$`Sztq}bj|!$$1p^CXhBi?OslyFMcaF^sV4hs*$E@Te6ZU8)tz zWxog|E-b=#@$n9!yz)m}c;P$?9|6%ktA?&PD5a+s7Na>1zEDsBp8BNI>o{Fm{{6J{ z)_QqTRMcFC)nYnGP86P$rS|c4G;QoLDvs`qd9O36RGW^)WqSA77ut$|eSNtHU|`AT zwh_>crmECIKcK9rZVCXoI^r@iIZ-c7XkPKaWD|ZoR@%ez^3G$*T$wGyU_KAJNBV`K zi}R|#w{loUOn3Ss?6uji$AxdJ$}H26>ggW2rog3OE6$|tqCo+{$XoY?SQ`aLaIWGUMs;3icVEV_SrmecBOjz$3IH>ixc`jO1K9MZ}R z_K7&Q^iYgFvJNBAx=-w5waC>l2p+4>zzhe6<4ZD~vOrV&hl}?3yCxtPlXs3L5@fm* zpL~g_0)0IKgFQCo_Gxls-D{p<@jkO!?`v3X^|Pp?sDIz7R`!kA)4yZtl9)A*Iu|7; zAgt{%=%4e~#9;tjCz0XO`%Z%(gzp2LBRHioVMC6b(c!_S&5pof%Dg=m=c#zrS)KtX z92q%xXf+Yh4ZZGQdX#G5P7G*)ALJ^*wJ(ISW#Kd@bmYl4nT0_+xs>D;yT3@t!B#Sp z6UJjC6@}ltijxkMluF6Lwh{YJS_H{xGFijHn2#fcX0`!Etx4HK)Ar>9hK0+uX?nK# z@#ZZ_&2NSToZOT{>OuP|`>V{uiZ?~h88p*o0@+H}O6w8f;jnY_db}x;p6sI%lI{Aw zsmc7@w43l}%LKMkb`j@SLri>b<0Gp^cHE@+pRC=IMTt%P{PRVu25hQ1XLC(meUfU1 zRrkczST%rS`VvOy(Z1IN&QbZYVy5pMqc6H3|6%ELciM3oGhc)nlp92JsjcW1!bV`b zULFpc>w^u~lTsI*e8Hzr; zM^58ul>3aB@tEgA-Pc|@OI*$eJVlu2>Q_y7NL=0*sKCT;!CbP!=skaGHrCv|NUy2! z)``BS1me!}`^U~M%2mSB-cP7v3>^fisMHOm;SF)p`BI7=x38(Mk1OC>$WLL6JTl2g zk^;a#f8(nuj;w()l#@Q{BuMNAsm0gXpCh_mPerBAsGWcweywI zTGQV_#g0mr$e#a;E9HD2Kr5hTUUgh9@jzK1*;Wk_|5}fR1qj;a`VI=tl?is}I4IBh z?#kkKNK72%p)B6I`rzuJVf$VZl&T6YkAn32))JPUlRoKCvg?_q(^@qOHwhm}sRdj( zIvdf^&X~Dqq_jjUmw;`9i3idKMD}sQ+@PgYS@#dtgB|jw=)f-{r;zt<(M_njiW+Ln zZ40HK6Pq#TTChX-YI6Uy&AKv+PGp_D6Kpa}Z%y=P7PO`tl6_L#Q(mm0r+-ey;fAQ? zBMrC%Xb0geNCq~Sb7wyJKi-_?Pk;|3c@t0xjN6A4j_;!k`- z1EYa?!+VXD7c=lR1q_am*Hrt5EzgaLH5QKA@5%8h*}fpR(;CauJDlkJlF3gkX7ov@ z8MPz%cxP{0hJ?mj#_HdUn%y#hyB#PMHCO9G%d-`7W?Wo-glvfrMFFu>TME zvoJCLH|}TU=H^UAvIj;_{CI}~VdD5tL@MCFljjrGv-aQdLd)QSIsK)*!;Dp=6e`v4 ziXH6_iE317hcx+A5oNylH{Ane97nN99Lkj$tjt368-UrmYdU5J*Xb=zQ+5Df*RP95 zOGabOsn;CFUTq#7`A=s{-`qWGTl@nUc)k|!%+6j<*88?aTC+`>sO^`(W`B%2`8w7< zT8*MNnkI7wLiqwAhHo}EO&Q&CclzH$uB&nDyg-%&zB_{`FlQcg zNWWa3mM1qGCjU;ZSN+j$9_M#u)P$E`s+zme@7K()!)&>>v)%l*egAqJ7&=-KXmNHr zC-`!Df9JV5{%TpT;c&aQBa{QU#x;xg|1rkDSZUs$;Y5FHE~&aAV_y-&LPSuL@J*iF z!djIkbw#{Ylg2K=f5O9sEvkDiIP64)_+`qQ!z;a+I?F(3h2y z;ZcG5gq3EIrD}gi29VVWg7&rx8(r~)MqnU+q&W3io-2L;^iDg5EneJV$p0eju*1Mb)^l} z#Jx5TrGQVcxBVS2YGJm70)BM)?p99qJ4{ey1fn(K-ua+W-}wR093*8)26^nLaNFI$A4~3&?#M z9B%1f*}(ly{B)0L%zc7zW9{eEp`0TE+m|PI?CTZ19qgih;l@Lh zBC5NZB3OzNz7QKtTHoOg4JE0So}*TcD^BNTqK!I+&<*Qu%;xpYx0(F{@%Wf3vjkE~ z@^5UguB0&X;S&L?##;)9n3Ak#LO%8y)me=6Ph3!WGAEmD4K@q&P z^LW78X2)WMr^-<9?07glqZJ_E5o5+3v2}uPwJdS|tywWJ_NM;UO**5aF#xp5+H?@i z1LjJzx!GQw(BGz$o{-8AakEA3p3F*R(v;6DNS&U+U2+5c`xU~I8R{LWdNk^{t_NK! z@N#=}y)S_E9|DuoE9yL*-r?W_b=y$joBc}|5n8&re3>v1jv9PgkeQCY29J(>J3U zF)^|+tjL;w%nAZO3y5Z)Qqk$JeR8rG{e1w6}@2SkrB zCDiP1!(kQqh(BZF4RSCqSIjDK<8iUua-Nm(fFJ&1C)fIiD2m)@(5|bSK{T367Vbe8 z1&`y^QPwsqiHtb1Z!hKY9|^;e0{v5TYd6%H#8y~j=%Fk9S$?PZT)#w(dzc|e#c*;Z zG!D@IjKkTG;MArn4m37seM=bBqzoq~4-%TFbORd`MB!$}$B46rS0ETuMM96W23G+7 zuZIgV1&|k=5ookRS1htwhX>irk)wqwu#cyEC}19yzro5&i;$vi-NszcyN@tO%^AA$ zvtrdN0a1%|sqeSyXdt>MY`AxCkbA*^xmV1SqLI#pq3 zV*ym1L-6q6nwc>v9@N?1C?!2xc z*`3+bri7_wq{Ca6pH<=fS)P9e;0gvHu_){pYtU6G!(1|;sKj#X^szGS-=VF>zn1jv zdG^S~@!tNl_Bl(yrUJM&;=Tc0>ZG>1N$~@jU^QJ2zp;ayMP;ILF(8RUMu}y>1r7&$ z`SURLOZEuS@%5z8NDCSw-<%b)(wUS?A`;M|QmaT|Qg)>A;ZP<2X|5*K5s4zr!Km66 zm0%rMx})Zs;U+f~q5$)$J%m*~}`CQDo397Y&CCM(yj2{xcy`i|U z8uA5WW3vd3Oo4XY>oFg9_*>&lK3I9bkZEXRdkWY1D5Ad)e!C<3q*`$XbZ?ZdQ4>`Y z>ndo#oTxZ^RQr$^;dlY8&QEGN)tm&xpn>(4m8@{|oQ6{N&&@%oOkD_6N57K7o*!3G zBQ6lB9G~nsrB^ud@8a zc}^e@^)jov!%xCNHHA=VSu&~iU7rnB?>MZE?1>($%I|z%?2D*{>P~KY+Q~#KQ9=(z_EMWa1A3z9LNFk3ugEBg zdggj4KhT;A)#U(W@i9jJwqVr`7YX)C9N>Kaq{5RJ!f@q~qNDVX4<7_ygt4~HEExGB zdwvZt8P@KX1&y}XUKIqzqm*eyMd4$9M^RX{UABx&4?H~v>Huy;KSB6|?TU2KrTLi1 zK|I&jvn)qh^?~MW99#(Pwe82I^*vtf3bfJLitmTQoK^+!QXzfVbwqojvd_Dm-$F8|E< z&T)|7DmMc*dm+ZyidX$IpgCIWuq|*$Eal!^*g5o*G4}35$D@%!0w_~=&IX|zGPl;YBm~%vJW>e|l~tGT1&eQIYhuML z)#VOB7viWt$&Y=`tc-y>XxFuRudJ_34?8DD!9oGLPnfFX>XiQ;$I!}tW%f+DYAUht zg6`AhCw#uK1iT&_dSMAbnTswOrU!%zu$Qc;=1QQ%ObQO^#4glB~+x@+YY9&0Mp zAF>9h3R|!*7Kf9nRg1F#e5sEsqfma@1QzFI5*GW|MRP@=1gz(^XPdbrG{SXL;zu5A zZKw?^f9rqRMmxo6eO|tpY&JeHrq+u^pE;eWCGOyH(i5#tG(lMQXY-8tilYO7YjC;) z-^z#Cc91%_xFIIWpaQZ^W@~PwWS*QpA!xvr*^T<+wS4Go53yzoK((f9SOT7ix!U%v!#xuqi$Kj7|a0tp&CZ?$Q;NjU|n;*Yngi?8%6KG>acFrL`jG zXx6pz8m+GgC?WaH!ZS}P-f?KrjnH~^S`SEq;XHko&PzzRPI6lw*w_mBND}Zyx^R6p z^8Zyri9j8FV(+<%38IIzWT6|WJId8r^pwmo$Y`k$$4Sm&Z6%#3xdy@V9-;t#2~$^S zQUlKt#b8#Osk)MNgEyEpHdLzNX$4Ef`;m8MOFKK*T;z)^dI9Ham6$#i0IH>rFp~P( zS&c7f4L%13>W$QXOG6nC#}Yvx^xZ&ID_0o@J##orXP`Jv%$^p-esMv^u;5ES6o*>W zr-~ak7teD}*$5*HFxXf?bl3rmI=VOZ{{0gISzAizMV|}-!S}Z6R*K7wVldbZwxUTo@dg|paVN^nKDu(!4RO;B$_gZ5t^P}##XO{_B0DY{YBI=_@H=N9J(uzxA4 zkZ-oJf;)A^^e>N#9N)6fD{_2cc~=||6j<@YTB<2M04KD|!X z_bG2-%KTw5{?vZ?f&^*;+_i!UP7V*5mNEL!B;CApMX8ND31}R9f9-8d*Vy}o$49+; z89T&EQxpDj5jIDhOhp{U%Agff{gtc_u7C{qjfuXza9U7+T}|}k&BI&}B43)9P!+tW zXhYnuEE`U830mHdJ}%1z^NyfSgXL`IG_j*fHN@@*Y6GvdKt7`hpn&h&=YU#k*Qe|F zBKB=Jw@(aK>PYM>v}Kv2t?$kC8ei3=8xB!hka;SW*DA zHU7ha|ITXhm_ke&G4RV@;pFiL6|IM-ttHdaB}H^4P+gXeQ5~r!BkbW<@xkCeh}$s0 zg`mS)n!5Q3CsP6F;ZJ&W*jP5(-1OW$-yR+LnTwQQ{czCyU`GlxJ zaVf43*I%wSME4}ykSA&x8Be}GT>u>KKV#G^)zrMIm2K$PH*1~>Y;lMWuJER`RlOia z*q1w&7j-YUl)a$0(f2#t&_m^ID%=?7DBUJ2yeHYAFl;t!?axH`AJGc+R8Vq;3Wrf6 zM*9*4`ntZ(0n=YyuOHU;lSh}Tmid;KAs`8BRR+zryRjDT^jcZz>u#JaSAebc?heoI zAJ{CQ)!g<-{)3&*f3WkF*}8xYe^1A!sqct1{V0sF zIR2rv&`-gg3@0yQgn(hpphO8y^^C{|u%ir9TNYI&bx@iIG~2eV@;NZ3BKY_c>$06uK0(09j|97*m)_&-S|;1a;_d~%f?Ls*)2B4GHY5xZ_Av=R^h zYV=N^J=Qlv^i^$KwUuEvxOzQ-9i0mu@{LTwofQ0m&SG|_lK5WpQQbB6L*%Upa_W4x zw|z$8@1++ukHqwWKYQV+xt+7RX0?1S6;3tzr}K?wCNXe`2N)*YgeC8eQp^p>)H?F! z7g&e(hTE>b5n>FO6B_LJU`8PF4mL2K4O?sOxV}5{{|n#FxL?&lyuIyUW*V~5=8w!4 zx#1Dn!o&Tq3JElzC~?rzH-YR$t&)7)5qRR$c@mI^N zutBf(n*%!nkQr%f{U*G+&xkZPlbeIfiyrTa2$z4)Lwa){Xe;6f8Ye*kz5@{Ey z5(;qjLsF^uvg|zdYev-FN7^EZ{g&VmT?8)BCRo-mUGUCOZ<$g zr2RcKK$sxjYwYTXRTfc2?KpCM*c#GnB%0GMR@Ptc)Bz<4=a`kIj49L=u_Rpt-A)_* zBugqoa28guK1;&BzH+&V76En#_+lAIASRU;`Ny84ic|pJ(pv;8UCL(qpMloZ6og#CmDHn~a&tCT< z2#GVSp;^M}GWlZg*cL|W&%7UGyP7{Irw`BJ>Y&K2vK#adoAnp(o6eA zbTFHB4z+9y=IJWgmSKxpE1UEVI+zqpPjH(cd!|u@hw(B0s~tM^WV5^yTdpMpoL7Gy^LZzwL&?TlD0n`#<8;f8yH$UTpX z1!V|>Ll{iLFo=2KYN&bw9XC=ZIORMEz&hd(e~#lpJ6z3u)e%O(MygL=X(lRIaDEDW zZuv`|h*aUtsJC6US94{T1PFC~5=NbyV$W{~5}4LZ4&o%Rf$WRx+R&DYnKaYFN~dUp zFQ5aKa5hASP?Gyu!AcYBMoyT?C*F%OAA?xfq5$<>NVLLvz)19bhKOdFe$&Vqko6i$ zTj@tD0W`-t&&L}aC6s+5RXIJesiyG6*hrs*Hhh}M#h25!1ve*AnK+Zq_1xzE^2DpS z6xG^M>m_DMeAPsDrCYtJzOkuZr>Le6uYjB`kC|-0=d3VB`2$zs-BA?=@JUSSG+HA{ zgq7iHi_xw{p>|x?mSl%1m@D%EOH`)Fi+y#$$c_i*T9*dY%P<%(KD^^tkPR=ohE|2P zb^g>=|IwCt^U^dz3>!Ah$`TdqP%^OTW7Py(;=S2JzhP}6zcE7M`B7TCAJe#><-S{e{vb5?oE#GA=cmRJ5lFUsSmz+s3@vtqP{EQs&=i1K z9ZDAf-Qvks5le@e_bQ2rfwE}*B3F#QEEH`8(H&+#Q;nh}^4VL0%5i5=p}6}}RCkh1 zsJt=<1d^2R%)%r?Zudt(-V}}J{>cZx>~v&Ijr66`d?I_x zSN{ROp}(*v@Gd*WKrdCi%!OVy;9H4wN+o}MM%KjKH@+wEG=$^V7o7Vx+Ih(`Yd9kZH<-sV>8N5MDDU&GBFKW>@JpDh_g_8 zEhHXp!d!y>Z*Ub53yHYG8ok!KS+|Rfn!bFiT5Fcp|AmGX@@t_pA;~Q5r%YsuVymL= zoK_HiqI=8MZ-iC1$dHnz#Y#8MN!ZLzmzD81^~;<%D}}EFDc={18rPnAGIuvJP2F0` z9EJ9r&_t-sPt zXLu>~?6qp_<8MI*2*^iTQ=yEAcM8g-J*j;syhbu7F!{E1XIQ3fm3#|T|ip1{eG5M%3FL9_NUG^5% z*T;)PV^aW-6j>EV^#liL_tzx_rzlI~uj@!CHTgs7h0%s)=4bBZkK}f}r zVxxCaG_esMayZ-!!*%$|wu<}#@vCem$@bCJa7&wwa7@DQu*4F7Htam=ZupX*e7Qu( zGCtvC+ybFKA!GC8MkOB<17hebUp?7m>x2Uvg$Mvzq~vK?F3IF|j^NQo?cpXWZ0#80 zQXo^Sh&8-5m=qAnonG#!y7+sCnjU#rP8mCm2P1trPb zCsDlxidw*83n6EPU@Bnj!{Z?oo`=CZ4#FzRcoSyrcS|VFd39<~8PLAfYj7v{_Qn}6 zYy|;gtwG_Zrib;*UJ4x%?)(eM=rd_mCK(QjC@!byZYn|W%2%dE}ocGy}Ab`VRGgYNRTp$eBxRV>g zE`M4K1Fpm}YExjUa4gLtP|2tV_cVpWJ^uiK&;4uS?$bEA2-iRJ1iscdj=kx|=)`nw zfx2FGzF%Wj#On-U4meB8B|@zPp9%cTuq8m@0(00k7)Bi-`UWD|)1v)R zKEFz9gWdOsMCs?iw}JgjrR9V;iq_CX(11C@+XGr+xDFHrVyrX(x@psV!XaMzWe4!@ zh@=_2Jq~G?CU6!;vHx8=VR`S7rBhlx{~3qSRXKww)s?*6iD`IXw+XuoZ{F03i2_}5 za|aV7)@AT$3pMfSGfvktPz>cUYa*pY=BQ|(1^&CBIpYuA-K^t~_zP6Ow91Pb+l@!` z(*Uf>-{J2S`5I5$d!cJ0%+t7r4MYG>*v&1b`&Y~^|0i`0VfkO3Q$edDNF0l3I1Wo5 zNKF93wb7Khj+4=?#Ak83Sr@T96C(Eg-JmHoo_r_i6r@>QDoLGX!pPUJL{v=M$_Ya+ z+lAya-@rXAb^^-uxhVpv5Uj6>K|IjN=e0*`lwQ(CSc46o0I=ctNN+00Z8$(5pT(LszL_I`J`cTF?NC?zweC1jK4pHth0**=UA~{U%&@@{i5@*oM;V=n*|A{X)sBUe` zL%2PMs?k=;R~6%Y>?}ohxOk;et|Q=YOHVl<0R?LqNML`h58`a8o#nQ|2i$yL?^HXK z*F-~DNFIncuO+IU`~`mq-8X=dSfqK4QLMLm?$r%H_;HtB(Q#ZBIK=1;wAXXBA!^2r zopytsCKP2g&C=31444K}*)06hUpV`wb)kP&MpewVW&sCyb5$SI+xEddxU_5bzd0p# z$ZnN)!O=V-Udp^EKV9e+;k#cDfUe8+H?>9EISD7J45Ws2s_*h67#{&8yk~xqjt14= zA(5zo#$dO$|8h>Q^*_%*bz9-cZ+uN%wk9fBOyFmfJULZhYR*HiwnCNXNPD#0gIEb; zud-TWoN`XR?xH^>LxcIq=7?|O$emlYJL2)NvaEDl{il&NU*UfJ>(Py0cQ&%ycjg2n z5r~nAvLql2UtE!C$kza%g~=j({spOy1u2>p4Fr=iN{VYzUxdV~hBcYZz@&Qnsd`Ij zN6$%n3*3on_BF$G{}nL@e{Tzy&%&7$D!Sszjq1wA%Il~_Cvirl{paDvBK+)lIh>d2 z&@gw@hAv7z%A=#K`MV@in!hff)Vwz{3};I+ytQpBwhGRjraPC9s6}%@n1dG+5`4GX zj^i5=w6(6~|3{U~|Ce56=j8q$3o91p#M^gN5a$1ItW^K8s+!v8I6mMXNmqvdAy^#` zktFJ?k}g-4+8t}1)UDKLRmdims`0sd_&14gt?gg2rjSw)%afWqSdAO}A-Zey^nEuX zq;0{!YCc~d7LWSWRBh~RISsuUUL8pHTh^aO=GE2_8E;_VbCrd_+Pd7EEo_sul+?Ch z+p4UTr~yq~?oF?zB~PwumxwsN+*GYZU|n8~0xO$ZFMGB%Zgx+mZqVDSwO-%?t~Iwm zb{xl)AIId{j_|2lSCjv_DDB}~_v(1Rzre z+UxnKBk^Q#+?Z*pQnuP@IA zGhp1aljcdoP_dx3r!nvpA-76}{=}7r8Ru$yhpYUvsA}HhwW4hx*h`vJ)7jwQX|R)` z1z55{)a?HkpukwIKllwM^8rM1>rfgZ=9Iqqd}9yXPY^&~Giy2BYnl3PE)4D|@!0t6 zLVj=s>u%_@POppeEhM#l=|Ucqbo*w77ZbQx;3{wp?`x}_^pa4h+rsH(L9e~c#{=UH z1L*35>@sJ!729y>NqD-l4y;@e9_(j*c z^mRznX-5CJL5{~e_%GKFKf)!?o=$+|*$Sh<6p(BW!(2DsyX`(M_)3Qs1>SQXT|DyDN~XNLr+1BiPW zF9E2Ya{*d%@@0p41wtx*x3aS>e#G!h{c}4lLDHu?@EaKZ$b#E*F8rwUH1r~Q=iMM5 zdFL$Xe%QM#V#_|YYR($Jo0`khx$0U1*IvgREdV%PH1=60dt0vNZvXPy)cJ^2e`9kB z3GRxO?lLPv*lII{^zV8uGf5aX130~co$|OcwIwj%o0=t|>J54(QV>WOoymfO=#7or ze|$Ajy??-aalCO6Nk*b@zFLxbq{HSWkzKy#O$9PLi}vtuk?Fp4%$xkuU6x2BH4RE- zBW%Nk!LH@8ch5~6w-rlh8(6JL7<*+r&NYMWHEZp*pzVp|b5ZPFl4Q;ofK6YK&PW~J zkezdk534xam`MXKomQL?g@v-5xvsjJuv4*JkmKE}?p24*eBMXURM5pw0UUTCdkQ{N z-RZZxN{rYBIjXY%tN*vBxYkc>XAs%xoRG0q6%$=A6TYA9F^wAZ z1q5W3b@IucDOL?`B6%kRpz|kO_87w}LHtz@>=zasnB+mSMCvzplrqp02*>cW{RmL= zu!f`+3Xz!P=C=OU5-(mWIh^%31?=7=3DO$HL)WEX8|30Gx7wyr`ad(gaTEqXd)vzd zrvn=!b$7&@UXwE!pXGTw_)|OcD{u<2_fCi83Ar46xqaRQA$eF2!1A?Bh1V!H%IA(r z>K9zAY;5I?!6qfzOH%qh*t6ki2=hp)E=hL3Osr%meV5ddMWak*gLX$v1`6a0k+(|2cB_aa7VWKIEbr!ggXRF4O`u8wXlPNNV5&r;i-2+{}boI(9t(uPI%es0q34jx|>y5m93eUsG~_-OQF1! z`_s3+?i9X3c8|=%0LzX=hKN$qt=H_kn!i$0m31FI@ZB735@d_kR>xwX_#T;nN4Y-~ z9xe#Xt>VI>2Q&3Kwm3oh2S6y6M}PHX{~1hJ0pa8fBN0sC zZ}H5tQarO(=sQbpoP!VzQxVl@%236Kvm;li0w%^`z*kHo3M+KjHs)7WTU7xv_+=YP z3^JW6ZBbOjoXnzqi;AN8nxHLz7|$gNy~-<5%VjKe2l&b^YHHokqi#T#GWpe(JRo?A zUNS3D>z{dDdVpcS_1PI)PjTe)vQ*GMjEFr3NA8(XTb!C2(Aqb`B|hIR_vPB1UzRo- zzx{H6!jzJu9Z3)CZAobqjAtP~V?*X))TtG*8X4d0x}(Z&)LD?Evyql4YKGs2ZJMs`5kQi|u&Zbo2uQZ;BU2ZY1u)=5__?mS^dA+4~8auJGw0V%%p^V3gV=W;s;H_P-Oh zvRjiPFf7iPjpQ1~~7E!nnMF;?w8nEJlZhu@VRyw>&J9|jl%jd3Mo2&KYHWA+5Fk662rWa*jslc=ks^NkcCi^m4 zxNxGeJy`b2ec0m~WUCD#Ybh*VCj>CQHEqw@7J8*2H#lH9b{3+H#*gZ*l+xF;CK4#c z5V`ABZ%C>o%<7xyVQeLrXPxb2YeL|l0(6?a-<`QO%)Pv!Hesz~PNvxSyBNb~eAu(i zX0oY22{xyNo|~n@XS!}OeqLU8EW4(ed!e2VCqYB@A7V1PRGgW`$XXDJW>z8*^G zQ(m!0Ir+R<^lk5@YNh~IUZ>3oBhM?0Jy19Dy45-gSwANlr$c>{Gt}3qwGMqtveP> z*9mCNy-(mS&We&KI5i8Y4C_*bE6SzB>$Z)=@SAZu3_ohGY(*Bz9{V(SsCbnYKgE`y zYbMUU1s{q+UBDID$N31VKPGIvPkw@nPPO(28>=|wUiw-!bgZt#m|O)MPPEKxq6nrg zB>-huylMfTjNKTg1z$^mxD-L+Ds5wH%O`W03U=H~N#{*2^;0I%_E_LqpR!-o9N-?m zR9!;9Y^KCc58GLnz*l4WV&;4VZCl@^?mRm_inEBVrSEMu21~Rci^v`rTs&t;ciEjd zOK5Z5j}^?ppvJHkNq7U!d5IfybXjL6(Y%gleB$N|R`@HV7{%_7!|(f~HpeXFsWjZV z$&!rczmN~H?TJg~jq7%Yf5ho!9%xF7OC!^1xF4O%wW}ryOkLNqgv3e(Jy&}!-kuZtj z_J3&7gI}lmq|@70N%#WqQ6~krlQ=ue4f#EJ8_}^A$yTOa{Gjj$b~zY)9MJ*zUpnI7HLI@{dhvMVQny2mdu*t(Bzio`g zCTYri`Sj`-s)zxzX!9&xzeHqnLP@(d<@&I@4RJ8`D)#lV6_RQwO89P7c3t9MBIMo^ zJNpwl86I}CW1*iG$P!(kJ!W_C-Y(gN9Z$G-?fYcyP9fc`@QJ%c8kezyXw@Y2rA6d93EP z5($>2V7`KA5hJt;dyW-q*MfMbK1kTC?PuCb^kS(3eAi{A}ZoX zxts6K^M1Zsfax>eDS!9MUk7a)!L%0iK>!RtD|&UHCzaXP7hi!{r-U+u&z000#)M!3 z@4Xz9r`^OCxfysf>}yYj^i!!e6># zwHq(2!qbyfpsIh-Img!tN$u^E_QbQVe}neqt_31l*Yr{=uyrWL@+yhMRRw_!Jc6kH z8GiQ~v_|^8PUe~@ISEU?w3sn~WlzT@+0ES*Kbx8f%l^%dny&5O!NY^m@+70XLt=yk zP(>&hezl@%$EFj;ayd>(#9)2+v?;tX4y()H9N=oSV!Nmq>&Dz{v@1<7z$9C%t1c4o zNZNFPkHs<7?3SuB$Mzdr$#Klzz%X;M*fGQ=EhEb&A_wiNNhu}^lfy&x^x?kW{}H5a zV`0I=Am`}~eQSbK#3;B0eHKd##wrIJfML3mjHXzq=`167{Zh*0CA1arw?8}(CNqpH zEZzL7P)kPOKV5ft=FkR3>(&6O{;_+pA{*E4(nh?W-v#F$Q5w(dAC!B(&`j}t?E|FS zgsii?FvVo{IWhSST#=fP`@f*l|I2l9uoM12SjzIhaGfmw#dT`cEQ})mPHOSkBHS5C zmo$3wouxs9jRcz&PT52~G)RU73Dx4Fn*heRJ6BqKep<=7U4cj1q{S5p~z%LQsM$=Y{1Z? zmkLZO+gjH?0QDw3Z8mOR6ed>mn_JtL9x_nJhVMweZEKg*cxtjXfX&Opr$<}HosL55 zch`}fL}tr(ULQvz-9zSOqO{DEnVb3dk9l%QKm)2hJq_9y5iIx1{fZcXy$HvBsga{|+)ee9Y& z^4QHkzY> zRRV#f0v4z81%&2uk%JtKX;D`pt&f<4%;OZd$Zv2fvcSNKn!pCk1(Q{htpq`@;zTU@ z^$cqQ2*hzFVA8Mer>7hK5rq%Tx=E3nQEfU>$mIWsXmj8GikrQfW8AQ4cw*1f7cFsM z3Rp9IeM~&r@m#amN(n-TtBn+`vGy-Mz2h?gtACBf@VI$F3Rvs)Lt;(u8t!nf6aHLv zSz|}&ddeYb`CiNat9Ul7x0gX>j|tHb^E(&?peJ6Ix@#`8t6IZ1C@aOMQ<{k9XHLGtuDQJJP2kgNWtw8Si-}-a0x5NZVMVG zs>LCLQnbcEK2C*w#Hof>ve0OWtkCZmS<&T3HP)ytsmzpDFS^Hjysy#42g{`t0+P)I z;F8I_hiT4VM{RY|CrsvFzb3Gvl}_(X&Mu`pK71-rw0aOgs;{md*XWr+7n&!I3uFYU zj0cC$G;RYg%6hW2(5TQTJA~}zi#<$IBM!8|ZV~Ubz>GE6(9=h8(5BC5MiCN-0)HU;VvFtYK8AfAPqtAvzB0(o2cxH$s)C+iObvqA@OVEcXbQ>}Zxu>5}sIdbB;BCyX zp)Z&)db~UfA0gvv-o^tK%P0Ly7jojM25{itw5*2$wXM?jweKmW$SqPstT^jgR;mxJ zfP8ZlDXnGRU3vh2FGdcULs~8%tjzGPF(?6iLi`jOlm`O~M95|BgRCU75+e>uWfTI% zFv%X&`YBN+K$En3w@IMLE2%{W2q1UoGs&{dm3={0YgOT1?k6eTQ9z)ck{K0mEWkU( z7hsO@N^R0cY3U%|wJcLjp1IZ*hISWgd1iuHPOxw2+LwSrvd2ASyt;ngYd!{fnifCjDbHHJfYExB{!^A#l8(msmQeL3y^k>FbWlgToTA!0uclVn>F zVXh}E0++9_Grt)&Am**UzRM+{q}=?@E%)H2r_Iq%0b(D_wPG*_u$Rz;lmZt==c3Rg zS5i6{?bYD35FX=-)29lMsq{(l#im&%{+4Wu`OZ*ElK5*urBW#OdhVaNBvW{H;n_oL z-BBXl6rcq*r3wW_ypcwO$Z*HZn`7o*WDHCU!t5jH?Av|7M>*HGmO~1xAa=;L2m?=r z33UW_7y<=hZ*2Gg;7`{llXBuM^~mbQrnSQ2-WR3kY2qC9-C&XaxmI3F)~I?{xTh65 zj-fS9s;pYNDq`XtG(H?*4=n>>rCVHG3%{`IxBGT(uSQP!M5RkTShp{lkTk8D09v(E zK4L4?l9QGlG?0+9 zLi}w?0^tfZM0jl2`t=>dg_Fs^ta_f=xy+?7KTacINweU(rW@=`;mYyWBwN~(mLl<| z=Z}*o2y0jn0NP+ge`fcU367wYLDNK^lk@!yFLW12;qU~E3A-;sZRRqwP-`T?<(x{> zF3#kQKK;hi1mNUOZ(}m%g->tbH3-KnH&{fW{$T7EpHzY(jF%?wkzp6-ky4MiVT~rR z4oc;lRp9$a2x%XOL4N$*0cH?$fwbFdl=nPo+wmh8z_4+SUE3=upCpx<<-WpCxk(-6 z&0Esuiru;26M8jF9I|W}^SyznjK-Rlfv0<?G$EQtUR-NLr_CieMaBZi~7$DNCAmF9T5%4B1l1j3>`5I z)(xEkzz5tjKRR7~JA17J1&Lzb!-wW}^<7!ufJ154;SMwiysqU>5QK5Ug?mZ)x6$l5 zP0=C7l1?QJ%#dutIa_ybHS^4>BX-)kwZZJIq*)}i&xNZ1(UQDp&34J95w(;~;nFIV za(FslGE};{XBK2PlID2cg0%t?8$%(wSrYdHAe#~932&f#7p0(;r9n(3SX?Mgy)AKw z-o9-to3000-EAZ~880xjvXU0v-az5h%QcgxZO`x*qKQXPK4p?Lz(#4(MrmlWr+&cU z=t$XkWdqgRIpM9&JBRGh-fmc_{7+t_ac#Yolp*m((T=&Ti~cKDKo}{2e@YKF`KDuDc3tc-8zAA*c`(wZ@}CRWd3hi-bht7Wo@M zo&sOT4edC0qKF0e91|5_(^L^}zw1p%H!+pZ5zG4rt;K5pmuMBOdEX28KKHi1d^K6O z0rkWFV=dtIs!7-v_wW}YCw(^89&T}mtb$@NI>pe_j4HB5clkuVcNM(aV!f|ojS40# zvDsYBUekcRo&RMx6E~-g+Z8kL9i2qF*;k48q=PBwZRTW6Q`I2NV^Mz<=Fh-vtoXg_ z!V$tboCEuDDhN^_W?9|09hxBK^lbm)stX-cZ$d!Vdu1R!x`1wqc*pX46ezx{wivpe zY&jXVcFBEq^hAbTsGT|kP}2%^ z(f**sWOq-)q)y58bf_?~8Z)btx%(vEi3Nl1xe{AjN9YM_qH-@7Hov(o{uj<#E>wYv zb}oQa09}9iXLq5Oh8B45gAzF`$%N6lgd~tDB8B?7f&uEx!CS3!PA&9$qloy~TZF!- zGU$B=R$g(wSx%sl+Pb8gj-4PO68s94NaAF0#Em7V68haVzn_&Zlln&1DF6B-q3x8m zX53{XbjK}!_-v>UY>SDQHvi5?>1Xi-Rtmst45~Eae;9sZ&&D#gCwx7vD3K#%{L|vc z-hSG@cmW?~)u>Kr5${WX?hc)g`+ZJmq;ZRN37r5O6ZI({FE)OtuHcd@>^HFd9g{2g z@W{BHudnk%3CO4}j2No^O|cIiR5sjOn^&#ODZnl5kvP=Unz*vcQeL>t+?#>NngcxF z&RL6Q_fIXjaTHvKsBiVAwl6$ZhV^TOa-6CZ<_Q#z*F3CwFCJ1h=-WB|)Gtd_I=UB= zVT7r9x67cP%4QdHvUaG&(YlpA=)OSXL9dQxjg>O&r_;gYIER?T$>nISC{VZ7M)a1O zNuy=Y8pn3?>a~Fy{uz{y(I^IEH3qD+c9SukyZ0J?Af)@0rDkKY_Fr7sh%BlpH;0$0 zI!Q-yDGoTvaLHp7W#pd8nSFLmN##6U)Mf-NZmI_aNo#1azO_bK548=q@CDWj%b?;6(y3FPLzXPB3fuYn%A#wU-G6{T8=Oe zb8T623}~^!yrZg)Ui`=44=m9|Y{?a-GD5{m&qsaqqg~NBHQMH&0l%%Z>nHS6stF7H zacYNY32i>$nfi!U{sZ2)T%62|Z2y-%WcgoCk&T7({~P@uO!uFD#AbFDE|$bBEJ-BY zR7r;HkidWPR26a#9Vv&EeTlx~6DMYCCY(Pllf#_xO0J3oHq=&(4OJ_s8B`p^uW!dA z1d1|OWD_I~oSdAzoSbZ4HdSovgnky~#@VyGcg`DozgzV+E@fVF@ak^-A&Rqabf3CL zg8j#q5L80djg6(i~39J6@Ka4cLjY?K_u!y41u^27{M!N(Xx~ z^-S>F(<8*W@CP;LmZX&Ms(q3mUeF$*S;(RrL#7U}u$E9ep0bARrSZW(Ik(v4RiQ z9&YAR&GX5(*Em9oGz3+?O7-O;_-zaTFM=-D#-g}6Fx zqN7q`R72t2H6>MxK&iS{hd5IIFFk#Uvi(E)+m+iyg?BJd zhS9eUpA@70{)w>I4ZW8su;{sFWogGoLk*#?tM1T&aobI4Px-|WyP`X;uiu@4T)&X- z*sv_nNS{#Sy-muY2?5OQyS*XMtB0ki*0!anIu}CqI%9?qHi@YA*Vlq!VXj6k17;w} z9%SZ9JL@k+l3WFIPX~#KSwr{yxyd)P1@&0OMIj6D3DRhmymOqB&kq&)IsI8ULp^uU z&gz(lay2bA_zwH+m5BCTUKJAnH5MENPl6WB@y*UEDL+YqtLG1+2iWQ*l;Ok$@Sq>0 z)Af?6Xw+%#X);W>bku1Afg4ecSz~aUzGPn#sDwOS{;&N0LVK@Pv+XmMcXPgm;I5t3 zsH!cyY2Gu?gxv8c&sAIS!N>Bf>$tODy#wv>uQG^yi9-8hM0o^;W2R#Oa$R_*+;Z`u zvR8iVqTkDyZ@BQ-!H+!>J!hEuR@fZZ2L>c_hV^Gx{T4}$57LQOxcU>X&-(DlrLLY_ zVw@9-C!~9P5~>Jw$e21HBaHn}R2Q^pFry!+rQKM%mwtjzzFaWTPjo)YGPzKx>3QIn$#5HW$ejYoAQt6*55(R<4KWP}p93eJi#59=8 zCn-tYwl6`kkOf3gjlRm#@DCIk&l(M%M;fo~FFmnYiFBE|wr^8EMq$EJFSebbKw>UC z`{OX9V=<8n>i3uz{aaX&Cw=j|)CG5QN!I6PFFLKNAJOdWkH9&Rxj1BPrpSZU7S~`< zO@vT`8`#v3W0Jl)PyhQIAeL(Bg9H)L8pdWZkKe(Er_6#ew*Xa^&)njfq=FobXAqV4 z+{Q{w!8AO#NK&p)@&s$BgD>)d5+R?EBTHf!N0D%1FeHF+QH%a|vI)N%uvS5CT?cQD zW}`a5vi8`9l~7&iIClL5+x|C0HFg201OYJ{%hP0~3?n``P*CjMhgL(E%6U-H5woNu z7GbzKe z>QI@i$hZZII3?!XN7)Qkj>>fwmE}m%f|qNT5G$-#75S0f=MCWpvNfFHq2mUAov4E= zL@sJtc*;@Pfr8p{YzwUej{Co}$X*Ngdo3*~v96L`;MbOxwNuLkqtDW5TceCEF&PRy zURsPe5x*K|q{&+_XM>U2Y;feJZ=FKdLuDXmgIUDnQey4zgZQ#HGsL_}S!pvN20>b; zlIOzFzzq45LP*H#1}O^V*zTR1K-Bb@pg5vg>eItJ0O?;ed`SZoQbXEMqM4M~;aEq> zk&m(#AXdaoRUjcD_BAUtmoE#?pOeZi%m+&zOGa0Wi`qW+JWQgs;>@0xvKsdJo9v{Cs1hS=iP5Pu`yQ^X*Ftn`3wcbW zo)RigdUj4or#Se!0~YPs+h9JGTa~|ZD`f^uKmk^EivrdUV1>2jQ&ehf-rS`sY&xDQ z2o)C#XVu2FY^9Df$G>}4FuFk&kMj@H{svh3Ad>I<%pBfT?a_?qX6Fw(OVW(JCn&4$QAkpV>HDjy@1aR%7Y-AHXZvc6f6K;cUy+$N>qDn}uiHoP&y^WoJ&gy> znyC#sAKUQ+wtrj(#{N@%Xj1E6xWlE>=~usQ(tpvT&mXckSq(z3LH2T`FeyTb?bY>5t<9E*lcO zA>;KbizYWn)!M3(z4=*(aVj@Ewd4Vi&l#Ee z+6oU@)7T$2+6CLi&@tLZs;_Y+b~N)WQpPf4WXtG^#qo)&l+le3bW7?eMcD*yYc-=E zubr^XKIWY?CAeLGR7AH_I_%B=WbffRDD8J%*22P5I^kA&w^F9GGT>py>;L`Oun)O` zS54)*o}Kc8v5m)cR{PsKG=wpB+)dFh5~|>sZBT@7k+OrL9LGK2sc)1fV8cm@w>?Sn zSrPL+yGEeF5pl?(GFkpn+zqop=0jC04G+zE7|tz|_Bepd*)@6IxP5ck%O6}b6O`}? zS~C?4J8&J8zpBA7`){KEIDO=P?95MhVW4XC5(QP_7*653SM2(!*4nwrgJ8veWHdJ$ zk06w6OKnj@M0g03Nehcb_bzdypn+63Q@2&*VfP@0t-NT7azhS()oTS<-+``dCp1oo zV+@-iH5jVPm|Pc3Q1Ieuz_X-fmI2W|kA*Tn#@AsL$qe{as|JZG^cgB6i<7^UsvBrI zdVmmK6;(2J&5tyb{Opd*N05K&b-#+6Mw}tPs)Wo?2}ctO9-hj6Fgf}VLrfUGU|Z3n zC(4F9E?DT#`Cy4lpPC5-UA2joB_Ealt`e&sZFk#hJ&WhGB;w0oY=5X1E&N@_5{d45 z{{nFk8sA&1cFsZy+3cbc55{Wt30p{P6H>+^g%X3ahJa27&j=2=?Zox_Yd3ZL1DQXO zsLjC#Msd>u0%cbn1$%TIX1?J;b-@3Xb9a@xI{rT7dj&$}_Td1qstAX+M(DGAyQ~Rw zj5Qs$&x&qbmn0+@S!xvUfoNMW5r)#ICY{A zb+)3J-;pNG`&NL_jMVLD*;OS6%6>sBgCsVP}lo*WHWuGl@^p8PPi zI=fWYVIMAugcGZO3BHwu(v7beeskGWn%1UNji3$PK{EK@&NzhKjz2K5n|!5>ajUmy z8@)`MkD;Zq94q#BtXT^6@3@w;iBbAQ&ejBb(sZp#lQ)6-a*~H&W(}tnHX6ydkc+Al ziI77(Wsl)HNfi!#vvcClQQGYIT+2K3z1+!lpHVgks9>U^c9DHR^96PX&^oDMLw9;5?MrbgdU2RqF;O#c10QFhd zUfT?vn*}iU)?zk}(Qm?o~f_KQtXFJT6OfRpVo1a7favGi#`@~G| z-ohZogJ{>iAgt#ZG}za37oFKz#Ag(xD^##7pFshszY(PZF_yS6It7__Ie@|qgJ`#( z;I{@LHuB}Fxr6};{PGOc;K*jDtrbg5fD`p$x{!GApIJ8tV!4n#KFF|jgJz85M72}i-B>GBD$Mt#4x*V5J4_!8g2 zQj?}clAE@#qryZJ`}PfQv{foQ>P9!MZPIL`Y(oo1yw?phN=(Lgu<+E)p(D)^TZ2 ze`>R;2Hfoe%j?naeV)eS8N?u4@d_JNvc6ZE;)T|YEAoK_+Ze^#jh)BVJ1f;<>IZij zNvyTzSN7=?0>8zuZFM|IG_v6e3!rp`fIo6Nf%D*&uC#BvG%!kSqBBtKpvP?+b_z1J z3{|Cw^u4{878az2z1ncOu*9RX$!$=8)_<<%)zARzHd#ocYVll3|McmZe?}D3{ihk) zuXPGzVu_8SVO__xKdc<_oqL3wnjF3(*;cC3;6854Z=2W2!pH$r6{D$P@c_JQ_zk-Y zs!7TpT^;=qp?sf}`UDE{cpqkbW0s`Q&5XlbI5PsT&LK$K4VU(g&<_u6C>>g(u#I|d~V$G;_$wNI}zlAzmG z7+3o={?xA!dGC1F_gTZUuL4H2OR%M*Xz6&%o#O;abYYe2wSzOhy$ZV|nSDsI?1QP* zqdMOQgL_Uv_e(gwS2Hx&#K4*~&oS@OQurvEyy{2&(2pL`srbHq^ErvTq!Y8W7-bU^ z(f^tC&FCBZ-5>V9Y>Gd>{pDu;O}x*hwOXb@IvSP zxhTXyVEu|_eAV5`{8!y={Mx$nS2&|bd1JvI4;FbOv9ep8-a7_A8ee^NK{`NP zzhnRHMfE;vgO&VHX!fCp*>ECp!q}Cs)61pKfTLm`vEXy3OTk{qV~&R?OwM!2{eaiMNULHLLXg{6Kc+Uu56Q2GmtrgV#Ih=Z%TJtH~y*k&({eZsoU) zO1i=ibFynaU8~kSIBu6)GJd>|x2b0VjmIgCIE`w&(h#eLTsY<0nC+^Dr#Pc&X_>^9 zR|nU_ZH|dHfa9`S-ThaxH%YW`W`RF^i{yp718)N;mw>CMW$9*eP zE`Eh?Pba{|PrZFXn>J!jTq>ZB9A^(Pc@C*K7qMR6Ta=z_37J*3et%1SO46PlRsCsJyO8>QEi2$BmwOdgm#F8vH5&bp43wu*KZMj-G|&Dt z@1lW?B(^2^6nih;rnjl(J1Ve6CQRM*fe9Tpv^m?{)MGgRG7@^0;wD+i;`L| z^+i=VlG%lpW~812vRd%`sG7^L@?jQip?)75P~$B#OCvR4I#UftbtIr>f$@<~U{5oi zAX&D8q5%3+A17zStXe3X^|T%E%>o1R4P(QYX&0>u#Gj)0nTY`1D}5*eYr1{ENT&j- zGMW~3%jl`6T}A1}!*FruhZ$YDc0^~DU1mS2CvMp^S}$p;}?C^V5|oR0Y->t{&G zl6|qGFj4vC|a0%$nSEO3Hu8c znWUdPrdLOChX&P?Uj}S=#U%%3K*J0?8`D4i0p_B*TR;wqU2yQRjNcx92}UoHbh7$z znET#04-eS3+H?EA7ZpFuiwQ{mlDHtAbr5~$0;LE@A*}<^vvy~M?SS^!9hNnv(L-|b+ zDeKYkrfWia=>LAwe$yyww65cFj(ri1Ty?G3$A{p^(?JtokI#ksB6EPD;&Nf@@fJ=@ zHC;s(kuE_?+0@?{k)8nbv9_Iy*d0-)3AFO8dGT9a-2Q z>hQ;gx=F2KE>JP4pq z_lh>Hm z%w1a1ts;q7D7`*mRwAL%HHs(Upjzbls7x#In2sI%B(X|pF@W=bF>XO->%tlfH2Xq0=^m>HU; zXI~dhHLImXQVQYlHvUV%cxTybdzs!~7WMC@^leA=)7c02J|0= za)BQ4Un8OTZWUTYwvOyM(3$uA>X^KrIqSJu>r~YS%hS_2bTI^}t6{Dij16HmaI#I# zN96^|P1=Bi1sWDgYs%J>4RCjy8qu`+jt&~~KnL40lH0*$`>##Dr!HD)senI6$;oJj zuAi?Y7?AwPb$IkR2z9_RA0vcz#L}d7+$<8eAi6O35HaBd3BoexHF6l@B{D#ZVdlZp z*=1h)>k2W7#266?W~iWx@nh8f3R?#wC7G6}o*Bs4vNs}t?>ak@{`peX=kMq?Ln*SM z@H2B9)W7!16h_g5@0SVkzQ;u(h3t^eNc*HQH2%2sV0{m)Sx7o?@RLRan(!wD*S zg$3&|HWui4KY0&c+Bn&Iy|C!%HgivD+TZur*zk9c__c|EEez%3&?ZFJ*|lN# z4)CWwr=k34FmvZY0>@iN`q$~V^OFC7QqJy3vLfpXO|pL1367OhdR*xLUHs=ZLLme- z7aGk#bl4V`zjBHqF4DsN<87FXm}y|@v+J_B?i6BAO46~A)NW<7}N`mihr zS)PesLOJLp+Uw==aKoLsTufw3Lsb`2D#2IE_ZdceX40 zPb~IrgcGlEvdx1i!gti~AMEqYD=%MCXEXk#G%WnqX-+-@(z2Hcg z%i*doAGRM`J!)jCXMLw#hbb|_0>=Jq)*oh72XDoiil~L>=JlW}$jmOb-b0k2r_G>q ztbG=3V4>R`l+R^v2&BX2fvA<*0p!o?RP}?2*M`34swmnYtX85P7qj=?gY9(2%Ar*~ zS&i9$PuKz=_(v)j|L9#)27rctV4lo=_Ijt>wj#}%9A>HNg8iq$AKp*W9=^N=A|91z ze~C8nW0owT*;7TQoCO-_-yT5jd+8~EGcM!n0b|p=cn03TTMW;h+$I9cGj_v3C8bSS zU*vfa4B@e`8pG$UX(&F`^ry!efZaz88(;S2FaI)!Y<8-%|31lHgG<*U|z8e!5J&l!-Qt0HM*YOZ=H!zm2NL+nDA#(AJj2IT9x zxb%<86EafV%B2}!Z+X6C{9q)Mbl~@(=vo;WVj}a!@}?CtIVj`l8_TY*jszG%z7-F4nH^2_T{i78?%oK^Uoc)lPq^4 zux8xMiBoJWpp-}4L8Nzn+3O%7QTl-qX zwaKqVbc+S3zW#2gHDb&vb+;0GQb#bpMh=dGnz`0lLT&mNN11v{X!fa*LPgOB#can@ z9u)UD{9oBrnaL{6TR=lRYES-5Ytre=BP2Br5+`}|=cyr4<};(@u^|usZxs(vb#$Zp zh0{v1*F6`JF@CNH)sREnxvmHaFY??hdD^d0WnhKsYr1e*0jkPdG=(p2PEJyXH{&}w z?-Eur+tkimf3wb;HY;`)IA;R}W-G%HOwT z6aU)iW#(i0w7&>sJL!%5-w2ZRe-I?=4-U5frN`O+hcy2`=yA5RYZ1`@AWD1uArz#u zHA1J+Z_6soXr>bHe&oYFspv8R7&>r4AdSw3qLHZ#Cql}#J6#EHTdHbZX{>aN?vzkF zf*=h%b9yQpYVQjg3w*EU6HuMzPfQ=5cRsF%5tyfSV;DNQm75iu8+t>ZIXTq=e7%^c zRR~`^IlosUoZhqcN)Hz>xU^U%6n;PRd~zy(*NXQN6Z{Pi6tO*RSVj>jLn0Ye! z_Q_hsEX8oL8xSwNBpf#;GS#bQ5#_@M?-5+ZC%hcse7Pi%TOI3n>-s3BaDy%fOPzOp z%&CUgQ+RxF&k1RGX2HiFP0!SQb3}{>`wb8KvJ-+rxJkxF8c>`S5d1dCS^QAUNd=W9 z+g*a8uMtY#DXFYrV)4a~yX~)#U(xuqbwl&T;Yy%r0Q)Ah{QpIdJ0szKU?hi>E6)xa zvV76wN@25IZpM|i=l!YP>8lN9%wUaaXkX2VN4D!3>6@An1W}3lg%UZN{1}xck2pI; z#H1$syaaT==!B&HfM%(`bTvIMCx)Q-P>%Xu0%wJUc! ziE*?C1BPM+%ijJU$dlb9C;WcMvpkURvGSH6c-gBh;_P_jgB{BkQ--1QRWqO-$ZTk( z8<*Y*84dk#CE^r}lWRZD*MD38?8@+>1rFz#8@vqy=jEXE`t5L9Q>6KyY$Nk5j@RmY zSTX6(!chsq3k$zL9hT^8)8kW#JVzo4E@MujS-k&|;SCy07>l=dT1z#6t;qb6%9lCOzgP&hRsWY681hi^O z#AWf&mzgy8g^0zYt-bokybwNZp61Q&&K*t6>h+d2GlayAadm!x6D%=;KYgsqfpXH; z65*`jbz@kA`s5BIDft-jp+(xCdJ*EhzHVq!%I3s7!pmflv1qHKZF+U=E%T2z}I7<-hke--)5wEAZD8=eg4KULkdWm_| z)SU}I+j`NJv=bSjtLKzZjGu)v57#LAUgPs@h?o{`@kQH%!)qca*ZJ#@ep}BFKcb=@ z0mr?%Kv|5eFrRf*s0j&>>{kJ|HFamYQz3pJk;F?j!ldBjqt0`27j2MWux(|)zwD&W zE<23HJmM7VQvJ=-3uk*k0Dy?1sv~U~29!IO^$p&!_B$pqps>HFMiA=xFzW8)|O%papX5mOpv zMwuT=k^&NAl0sY_b?z+1ZeMxT?{0a6t7`;t;1?!&?M<8w7W}@a25x-%6G66QM%F4R zfuM{Uu*ah%#m=dj0yM*X{Hl_Ts@ENkBw7U~r+jcDKU|v;5F`Rb_$J&L8%KLNs+m~} z30^hQvq5wWz|ALqhihc2^KZHVSMD7-Lee)j{e}O1xAm!Wa0v>*V(KGg?KVx zP4x>c)BieXAMWMf9`h!^!fT#XPI{-lI&>|5$1WtC5L+8Hjewpy39irih0fqSH$$!s zLAs(Ywk8pVv*C577G6jQ&Vhv?{OuQFbn&L77mfnhl$+WgG)nq&dsMJW>!k^U8^LmJ zGkwZt>u1}@VjzLD0}d1+$O>)EL@}Z;+Bl2D5j^K;O5(B!^#*%DzW0MqG}mxeqq1ff z`7vZ>BQAn#%Q%#>*G7z5d&wne$7eJZ9Am=gl>YC;T(+lU;8Ia#K4gvRjOIS2r=#eZ zjwMIPay%`4%(5V!88&I_V!L5S%?oVB81iz}kL+s?cA&v+*HOtD;OtcLyczk>k#F;V zZ=0=1pj_fu7iBqT?(Fl*wrMO`C16^c=j7vDl7BUm)nBfJNvf01iS8M2=lmf38G!vJ8O1NfTm;5P7Q_z&uVwlC0GC@wvpAqavJI3L4L0#(>m$5ht zMGZCG1@Mv_wW^c9pgSiB5CGY^We^!yWR}5H#S?KXfHDds03wcY3acNWs5`s7#FC9e zm20-D;eJilQX>shy3bxH#1C}Bl-j49c11=xdo%Weu*5U*214wap*In42<;=>)Rng5 z?M01#9~D!Wwi9jPvU{ZJ1SUYk!kQ~pmCjEqGELO%qmfhse)V*N zp2{qgR6@!b`rrw#S}9iDVT8WtGkP@074|Ul5sB_Izi_=)%Hs6^q$K7!N?NHiG_MwX_ke z4yXoftiH8*Vz{mTb?(<${;SeW7u&&V9Wh$u(bVOH79u?0uYunTnFcnso$n;bsjCWA z^5x*t(uGu6wn*}$6-Rtf*UkP^w$rqd8dVNdw(G6}OG{(y-_MrN-XQMf3b)Uc~Qn7JTF?sx&ibB~M3^wP$ zz#?BJCye7|Lt~1QxKedDe59q|)|}SPIqKxX0_tId8zCcOyX^`Y0+2DGU+qvLN4^Qp zlg;?0voKlv?fVb~j%{8bj-mg4m^zkY!!U*-7H*+?Ts{<$rqjiu7cAT(9*!e<0Cc9- zKzb|sO;WhX3H|D1T;rscTIR?vr!Q{P-u;F1iUnZM;GsG8`@wPOnk+817Z54yX&cEc z<84b$iotnKPFkoPZQP`28yG5S^x!LG6B+t-8w`bft>bkg3Q znAA!?_%Wz+I5ZOfr{**>5o6$FAoBN5xA+jX81zDQ_rM^Cj@qV)KTGnM%BT0vg(Tjn z;f4k6(O3`Jq9oYWRN_H%hAd92oA?<@*rWbX~VN`#hz$s&>G*3d8%?>~iS!y9L z3g{CojEaGh^PO{LN}4p*`iWFKe{i=OM4f0n7RR0OZg5kf8@M+H=pqAVIG5{Zq3Xc{ z++rAMGfK3FLlT^2>qnd^GQ0h9a?M$jz5|Q)EMj?Ksd(Ghg=^nbB#N0Dp;N5ce%=;{ z2S@&VkBj5Bowc}B9{DPkVUQ!Z&vcH^4S0JuDaLk)OqCkf|^N&M7T(L3Fbt z9wvxsA$M>@i#)yumFxj%&f$?zyprgI;EYh{vJ7vyn2%L?z6vVm$Kvx$mYLb6My_P{ zEc{lmYm?y1N@>G#DK2E|Y()HB(m{ZSepP0CU-fJ^hP%H zn&x>xNMrJUFt;O0@WdS!$b#p9J>OaMfJb$VIwjt z05DnY6hDPANi1Mz%pnB;i`I`e_Q02eRoVbD1!kszpE#19qYC~l>XaBN?YC-=v&Vez zjA@6w?LOhm19RVkW)^lyY2QNAIApOvucsA6WZ2!)taw8?unoc zxbOaNFviC6Kka2${}25mHqQSZ{SO#}{qJODHm?6|IWveTztYrl$X{$qsU~y(it>+~ zE>>B|h9+~AWKwAHVpJ#9RH`kp^4}L0137v`keWakk(MfQ(i$VlB*qm4HvlI#sMZ=< zLimgVayvCQJSzrXRwg1Vb1U_$Ira301QZM^E^~HaU@f?(cnxw5Dtjw^Dx0-+%DG7v zfkP(s&(-kCO_w#+Jl8|Me{Z(llstols+m*{`vVWreV%0F2Z!gsHrrQoXr3xtme=hd z@wqJ6m!881+v!d0{A*kYcCTmKoQ_dTx>jgCFg2i_u#d3QHqj?PthSVYgl{XtAb-OMxf=g8~0W~P|- zSNa`%@}k3=m_?Ibd{+M;ZOf<#S>@boS9L^K2?-7AxB;5?MvRyUkquMCGo*xf1uS_o z?MfbsiQVe8_~?C+e5jM16Z8rBHdG;15&SgYd@(1vb&d+OyGLD2%u1jJmn?eSvb?+a zyFfgB+YnPl5<&IZSOQRalJIRVP8p=Z5Vox7Mou=tI5H0%Kz1p3(GV+IsRh zdJOLl!WdTR4%t3X#Z0=bAY}Ph08C|{oD%)POaiJPrYZ42hah9OTeg2M=H7$TP%RF3 z%q*V{$Bp=ZU@!j!{#FYuJ3?> zO1GmWQ9DxLB&G)>Z>_tSV=61-3d}+LaF;qslKPovL5hL#h0>^NanL!zfv*4+jwA)- za8w6&vk$m3nd)<~KrNqI5~$;>$wNLU4DLX*6O3 zK@bficFxuT6VRb)MfE{8pxrVOl5MZN@`wVhUqr+sFCV&u7Z1%=KLEa5mv$whAt3CU zcv*lVsbBIPAs`--i!KMGP?~vUc*o|H8iz9JJ;$`B1f$QLJ4R)(0SU@N! ztBd)4Yj?+A1f(SxWi$kSmgKFbUN^jl_G<2Sb1(A~8@W8ulnCDtNEBLoK0SH+R%n91 zg|HfrpknnMg@v$Y^cN;-E`h~r9JgPv48m^|!7(t+vX#zZ%huN1gC-tuAJlI)+qWpN zQbNYUjrxt|an3E!#n+!HKg+MocwiERRGn){n#T7{z;R|aH zM*YHY8TXnx56pBJkhn?Vi>xCRF#1!OrS^%pN5yMdtUq+r8x=X0Q*C&ZdncpH0_2rt z?OUt);Pf3*O(Wr#4l%eW!+UsSM11^LcbDNCSXyuBG{Z+|&S#c0h4^>ltKluNm03Ni zcwdnq_eu*<(LQ;ap_`Cw)IrZYT;QMP6o@-4A^y|`NatJ)fF}~ky48jwS!BrrUW%^w zpE#ZI|7!<7p5zPqGAJ;PheRUfJ^MN&p&2P&R03|v_oshg-)jFU%|(I zgu+Cy;`qc^EJ#|W`Q9set;O!P;!;sZ?0)z&N;<8Ke=yfpIc5TZFg_GXnQ_%h;TpFM z`2Cp#S#rNg6+%6Pgnp7R*>ZyJ&=hl5$_IP!ZPQ9LCl(&XC_`cw)#kYwX?0iy9c?}d z1G`a}dNG&~-$sxRl=o~i`dx$ZX#z|khG%}&9+!(H3C*3`7XH4NsvcjW&`_kT7Wzp>sYZwcZ|MZxC8DUbj0O$^q~3ml5q7 z@?@(b!OuyVWv2fpVv4RT_aaZz=<*`(l@?Rq#p^8!XaCcWth3yczl5KM$e`c}s5&?$ zlirq-?qsOE2_G-yUYLAQKNa?gdY|EvZ(FIG-@pO^V7^O_sJZ?)tnT6F<&0acUL zf4<1u()wk#-P~VhEBSwzEo?=f1*EZ?krBPbHZ3+yX?P62PWUJfn)$tA6B`xi}_W|?Dq_VZ^&~uPC zLWQ5BXD$&GKd=6`rNW^D1C1IjI7mm^R3ERr~F5 z)%PUu&+BrG&}t9(5in-%&Quvn4;25@)QU4QVq+;_xipYWPuVv;79q}-B<){EXqRb&~@3Q2?F-rZ>Ov(p5k+>>Y+ze&l8 zzf-(GbzyguUFoZ$3h6y_(|pc zODkd?Nn01f22FV;>7OiJ2eI6CC0YG4DCAuj@0~7L z{ESRw90Y%l_xkK-I}iFMeSbPfOm;M;k!8ICuAR&KMXv~1Gv*VU9C$;Y?@I~K# z;C8yHN2$&?3E^DDmX2bji zk9oAqi+5;~6=z(OaXY1XY+4bVG1h5llnE~xVKTadU5NfNDb1k9n%g$yAZahKDt{?J zO49>9N1lNrtQ9gJCs%KSTjHfp+DyY|%O_{UBY5IBqE);E24ncf|7%&!YPQy>SdDk| z-tMM^_Wb1vwGTQ91jtZYGnC5iimSAcKkE)7KFUrox`D-sArV9~T_qOe)Dp)Om6$Mt zrB~x(3W6n0Qpy&~LvXnqa@C?Kgogru8ARY1L)K5E)F9O=65w0EZkMbmj0TN%MIAkOJ^Dzk{!s}G# z-s^Tmf8JPYcU)arBX1~Wn%J+GA=kr~F-D~asj6;C6~1)Qj1=)eH>M|g$eH*aE)(0F5^lv$9Ug0D~S znSKKy=e&mi_x^Z`+I3&C%YzgN2EWe<;#`Oz1gYE%j&G{m@XKKtbAYc)OMv&Q z^Ji6ks%9&{cgu-gk#(Mq35=dKz@R<2Xu(l_$x)Gz*|_5LRAV;Xt=;K4Z?k{E=X3pM zJ9ACkW^$Y7CkMxs^)0KPXMn)wPMo#n4OqtJkDV?Hz<`fihfl9VAAZ2BT(?PQ2KQ*C zepGNMxS@B8nvh?g&*Sa>W#W7ds~q}Mdu}19YdbDXq0`?Wu1ojR?*8Z+csV`-DOI&z z(;i5clqkvjcBJKQ@|urQY1&H*A*WLmjGmc`yQ*!D7&HUQj-6JUSq^0`1Djs6_uBLn zp+ait-<~oH7XWTCTOWEnA>$sG9Nmkrv=aDxIiYZLA~n7;FH?hAiTReZ;j4Xy7U`|t z=e-)!oXn2Hy=|}yG)s#ez?D=wecL%Vc2PFd;iC$#87#{Xc$}(iy<}lfIr(w-en1qH zM75p_0u#}(t7?n0ZFOrFqyjSPw_<1^e~Z8t2UWX2ttE4G0PBBb*Vgyv0$SP&iW4Sp zz5xhu&hH+^j@I6C&CBXPCB6^oT2Z9Q)BD$i_Jse@IuKjMYs|C*$bEkQ{Rs48qla-p z2Y*7;IHWjpu%shcQ?p)#etgV_7tNQVSX&ucEoF4W4AYZ+VJ&$i*HdAYm@yFYnN)^E z(bC2uQ5=f*r_{)uWVch_7V58R(iKKxX%+_fh#NT7R7rdbP{>r|eGE-ORYgNkC7}RF zQAkKkWDN9@dtDU(+eDYEzqwmN`dB?OHhy~HEz)n?lkLv?Xk0ms)fhj;NSSiIol=p; zzwQGFN1rUtyQl>*z*?f_E2DFUSqL~@qe9U)Qzu8$;%!wO-d#E_Tu(= zeI6=-izQ}e>u?l$0RHZ7;$a()1O@64<<_eZXke=_65iIb7BBlf!=kt3uUb3VdUhJAVtoLqx`5*96`C{GLx zwiP6QIX(0V|L-k;R+MDOrcV$&m1)))!{2MI&0V2G9oVQzyjmv-ff{15J1VSftjHZEHSJ^k^Q6I5-l+#02io&`9t2PZND0 z!$(#1AYr8W>~MkG#)dYqWvXM3D(ImKaFGoaPb`;3ASV*d4_v1;NZw zqRi%~f&sfob7V9StxAt6Mdu@ozgs|b$>Oas6y9}9_Ec_m#>@^k>Xyzl;yZ*wGP#xAB6J=&UvT%(p=5!YvF3dO zV${=|G~%i!3iK0P5_N>s#^ti6;*oTDy$W`x5Ch{sDx!ufY=D7l z89sF}A}}LEUU|3W@SULC#3t_Xr((RCm@QR1%QnjI1Yeo@9WoF8Ns@ez6E?#iJLocQH zQz0TPbrv{8JuavhYI>@JST#vXRkNx>kkfb ziFt?UB{Zgm4b-q$qJ5`$v;}Qr<-u!xlT5zD_TZ?PuZ|H0HIr_ojon&)Dal0)PMC#(ciZYL=*j?hbQ zt@^GV_vS?;)&B7T3Ka^F9t%68YYqqyPg>t@jO0fxUQfDtX}JX37MvEgtlOEV~ZaZ2|ytwPzC3 z61uS(P)Ih+&qHo$LT1^_7npGO$L})b5SzL=5L(O$IyJptVt^wSYjU*%Zo~j&?1?Q4 zf;F!#hgeA)F~?4c7Z2#@^a#wr*rhN=ufvz{#h|_H1Trlu(%Q1U%mU%R zi8qJD%A*#|X;(>%%MC@q0e~t;n(Kk&@B0u0G|mTbLdvryq6_z3V1KFje!+s(5n>i@ zc_WO5p| z#7~miSXLpp5DL(v4~MJH$kSsE8>*tAke5@;$fF~HOS|4SnGbW>0iw%&$oxqW>tBbt z>@k~>mGbKm+~_8@jIxKFr9Iqr<8eN4CIx0_mR-*aHdSIvM6PZOVeTEIlJTcLfrhyp zCM@GhG0&e^3I~U|5;j>boP}T3=)gusXR ziF99GpF4xDN!tGQNIY$J08-mcf2|u~!8f$Bhj6UA49^~%1srd?_rgGO*OtZ-iWZbd zvmwa_dh|Q8Uyno?^6ieG&V|i({xE<>;W9X`Qwd~gJrC%wUO%2@Iz8ES)^@XSQ`wZa z6~pp=FEWtraD!E6I3aQyb>^F+xg&G)NRd-|oORH!t}$V#bZ<$J6g-UAvZAw^%`OiEg@`LT)OjN$R?uGngZrXY=d2s5cx z^Sg`92w=vJzK1I^$9n(qABstiLd5P}BwWPGVVV=g1%P>ecSLjjH|oqtUH(Ga9|>F+d@#vN`c!uv{=K z(T-*(tcUN-8yY4gviP0{=mvxp_8;}WNP0BM(%$+yKe@=SLFO}Dc=8s}*HEF`!D%S@^G2p1n5wofNd%sETJm>ch||kBfK2K(wNp;mW=}tY zB!b_k5a<^?#mg{eJ@Mzhf;5fMy(CE3#XBtLN-H z&kR^PhJ6DvnE)Mk-9PEn6(|r=MC(hdLy<~j^}7W9TpG4GBl%~UXE|jxoBq0AtkX3N ziNn{GK{nl5jiI&JUzlHhKHVM95>by!myy-AYPD*c`nqAg1p2lA2`UsnOReR*$F(F? zcUpbgn&tmecpd?3k7pY(t7o!}ThP^+Er*$mE!=BN6vgXVgDK~iv4huQ>C;h{a`t+5 z?l3*p3~aTnAbdZkT05okJ=6D_M;KtzD@+6opYe>kfe)G0f#!~;H-QvRH~-=s?4KX? ze-xLmPs^Ltqt%ZEG3HhmSklhcbA#h$l4YJMjP!mlXbI2_nOm#B)77rC^*;Ki_R2R9 z;PZ0B_wl$}_y}1UM_AR%#bGgL3_mChF&){Q!emAfiya-=_@|Y_g=qw(hTuyTyES10 z|Dk)ndc-hv?Lf#0c0Wr?Xa7aQQWaKs7mzYylVj^?3=e6z^DZxhgQYnyG5t$sP_C?H zZy8PK`wSqiMK#EtyPvEzU9{m7BNW1_WlOMoLqn=#lc$CB&cyyg2l()~X?cI)m`q;? zY$2NE*l1yr)N)oBJr!dn-DO|0$S)q&47ptnNf?O6rC8=3$KA*Ja04FvJZxd*xuA^= z5HnV?Fdy(IXYF~lsC4LiI2u>;>huL&G1&aLkpLXiu?_UNx^EjTZp<7!9Cgxb@f`Pj zk|UG?ccL03&2uUKYovN)*}Q1eXL()I+ue6rjA;#6cHH|g{#ZC==$;`owjWSGNlMTu z?ASR-dFi60+0mzqS?-HGVT51gTCCHQHm)wfyHd|Q#K6Rq7>M8%MM>N2A7UVuVk)WE zhXsTu3T^zyMPHcWLaPs^5;#i|g@%1Dfp(GFKVkGw^a|Ia;~B6bqDD-dW_zdJj#E`XZ|I42tdx+qm`2eJ#Lm|?C<&piVH7dRTMzNtIqmLCp90JZ7 zqo{J6%c9}}1Un*fZG%g!UAk+BSluT#0AM~TA_z9#0*Y*^cU&Y!Av#Qg%J@tWbZb>Q zE>VmS@-^fQ^UepXN9K#WldgMLv8QF)ZUB`8z$WaqQTv2+%fZ4Yp%m%5>f-0L1%su) z%Sz2Ntt~{nb3NXT&Kx`Kf{D~U!=6w#8O$gv<9uUoga=`1b;Xr?1G%l?X_TmG9 z*UEfx29Dd7SbpG4Bk@z7@iV47`CFa}VYh^V9j9Chg8pp;@pjt)K5i}5Aq#)~!EOgb zxLaYfdnFSkhb(P8-WH_WI0JgL?e*Xk> z*Borh8FWp+PO|D*BAIK`$9w8XYGDQ3PN~i^Tivt%%lLxmeIjklHn7S?1xL(UC1)Y& zME)8OMa@b0N2?(#geG$fb|?%ttV2O^_d+oILILje%uzFI47r&g!k5wZZ(EI3Fbs)$mDLC3FDfnv?9PA>g>MbWe^LP=a)a96W{*8YB(7=$gqHIFI@(q~| z85D^GB5O>rg}@XSNa&F^ussQy>Vy2R@R&ML=qn(gf6R<#KSuVAK>h!THLsEo@1)<{`Kt~j(P7I+TYH`>o)vc2xaILQ>1dxhqhDByr;2P^SE&YD4 zo^ipvm&dv1()}8@{wmr?U+m~xXV>0A%%Kui+E7>4h8v)|AAY_LJv7Zc8mR!G8I*w68RTk zI=;0v$(#^CV~vAtQPRRov#?xxDiB%T$=PR*UNkX71sEq|(6W(;b3j(SuTGe^FUDX^ z@S3oZz8pp?50m+L*Mgf?T*~nuqcZ`C{cA+hJf&_Et@W$wYmu#p@12MLDifvGrnYF+%GM8~EUrFcU|Ay+Yc;$Dt%FS{au+wK|sjGgzZ=XFD^GIY{~ zU#};Z5pXR0JBU;0feI_vQ4M1BVN4U-(3imCR0%E`(&!bX7;6%^zBnA9HZTHGph9~fWL%trMj5A?V3|}>-Tf_d#%Aj; z@imaSoBHziE8v&nuhpxBu3+=oIzx#oRWi< zZ9tEa{8}!N={M^4m}xcS%Ol^|2Ts&)Bpj{1&H&F}(_Py=tnFQ1_4@0$(&69|wLB3O zu3yaHbg~>os2WB+ZpL)^LpqdRY|{QSYANDW-jEc^Y+-2llnUaeTcoZ?pVxZ*amfwo zGvZVsRG(j9hYmTBhSAKhYqYpJB5o}1Nk5b$ydY^Pu@8I3o6bJ8`Q3)Q@9$_^7@?Du zBYUNZG9FRMpd_6G0-$R~OPfRULw>4fOPE2waQlUL<_8$b`bscZ`O+*4nQ&cCClaHi z@r|y+jF1RUozZA1Bt)|-0-o>#Uxrbt@+;FYQuYq(ln|Wq#wN&M ze0ioA6MY_yx;L0Jaz8IV`SpsxFPgn6gNT<-5`_$NtSZ4Km!Yf=9s(pVd^^f4<|is9 zIHfl4u0;&z`F44GEE%=j0jBtcuBg1F+RsKE__y@oPWRbSk{d$=F}A6VhkDix%J9bE zQKJ-FM~nwo1!%$EShm*tTadSO^bZrPSC}1kQHs9FS!s3=-mOP8hf8nc?M+L>c3yn( z7P#T1Mw}swUNZ)0OWYm8A3(KxkHiEQzzT%HFL{^ooig? zOUvlOk^n7Ja?&zn(bAyxpDP0XU9f2n^p|GV1LQYLMK4y_VHz)nX3J-{8mWS+XBCM` zLjE66)t_OS1cIiZ!NdczYd|`n3(S2@r%#W+DX%gDqbWE#kQJFcbptC4cj^_(J3G|* z@7ritDmc%TE*t@qr`4ldW(xCfD?+7%`n4!CFYh;{us-+n&ypC4{nSYZ>Ah}S0l*C@ z$pULHo@d*BiynXaJPTJl8Q&d62SC^tm|)q8khO&nASh2vJ*|i>@x?+?87NFlY2-~r z=6}Uy%D0+-^QFdQ)cy_69o6p5Xs7USqQu?MJeh2(K57Hlt83Q-Wr(zo*K9de;ETx= zY}6t%Nzc|i`H1(C1#w|B`exT%_O|9bJQ+0;8Nq>MFQYd8sPQZ25e#2|MA!1Y@I5N= zF#=btV65%&*E?1t@n}P6m@JcLsp-TNKj9kmf^go1mlzmHhg?|RunRYcph&wrOb~(< z2(o15eLY}~KYCB)8tnX6R)q~Zbm`a_|HYHkHK@E}&M~)BqH^gc{EUf=wCruqwzsJs z5tdsg>R6PMmo~<~(C*!A^x8h`ntEBF-U-k@eQ|Int_ThGjTxzs-nTJ5kr{XNm4pTi z{>@rr4si@u%9b6fy0F(E@cxXP^NeJ((6Uz(0(DF3eI7^XYRqGyKiVCR^Wn08fjLrXI9| zoAR5acX5y$fYQ_H(d#|>nJrXyhgrv4PUuAP_&^zKF zzHh(7X|yt3y{A1(ZDi|PL^Ce{zX^aE4iJ=xouuw1ScHz$1QV_76v?M)4?&KHJkK>* zXE_v4;a_F<(XHJFWcmqNIME;PnRMB4oLD}ve0$}H>bmyglr;L+306A<5z`!;FkBZ| zM@MV^`Y@NGR`+XuBZSlW1@`}=w*S|0CdY5~|E0Fs{yVz-PlNv-C4Fqa|EJnc`Z>Uq zQ{8^z^vwOiYKD%;GO4TjsA%#ft|}%%QX)1q(bCRqwJ=D3^KEh9;yFnmK(9rp&|JB< zy^uSnb^zGkC;6L6$d`TaFAq4$8sgK&ptqGR`5L|s@5kY#XKvFXyJ*^{G8|a)jS&s1 zpU_*)s^NF{n(fZ}*Q?h>%oX+PPvgc!eP0H!XP;F0uLHA{rJX*-A^gwS+jq?WYWng5 z8|FKdVQ3keY^yAu*{|?_yrS5STLNO`MAI=zsS7cO@7DqfM4o8X@|N6!cRm@te#!T6 zoRS`IB!XTLo`8v#1ffNl>q8;Jx6+pBSK~&1F^dXh5S(?UdhP+pnNB7KYJL=9Tjsr%LRiMh!O!jNbX1R)Epvm*3mb=^j+d1s&!xdPFm{ zKJP4{@$^8h0)J)35X%sE3Vq@IlQ85#EBUMDgt$y7rhGCq8PU!8E+_{?tJ!z1#O+Q2IlxE;EVhR?Z>esX)jKZWdjDN_u#N0A zC)pAY;!aP&GLCfvsr%b=qM!Vs+?An59` zH6oSyl^?MYtKBJvgfvO3Uel!uy9SzzqL1dDxg^On?L;RH>a>RoY9*EK<9kJLD(`mU z64N3}!je2roIdntGr4*bH)qBkhN4$q7vKnt-yQ@kPFH$7xqn@n4%1tA9^TQwgReMQ z6HkRL7$2v<&oR|uHESp-0Rw8^4ec&Jcj|Luki29QZW&D3Oot!1KqZ4nKHy$#xTzQ1YfsE*3Sa=_ zsu&3*wUA9-40ps}94H>}4}vvGR+>0Y@b}D~)c6+@1#np+MIsJ!z8-U;Wm#3N1rGPwbS0GXqsi6XLWZts;0)q>=YG=TMTuQ?S^TsNjmo`s|dZ|9Q)^F5q?dkG(0GU8GKY`DGyRj!nVra-9S51S{*~&S zb`pKbjvqS;7aOM)8scVfiW=)ZjJ6nLG*EO*$Ps%kDr6toRtg)oeO@c=fp2E&!7uaH zrt{0cs(haP?sj)1jv7$ku+Uon&dXe*yhgKRcek6TVAfr{D)%oAUrQgSHu=~*KG{ep zXNo9=yzHKQDlUA&8Cem{x@itG+;wPpp{)DdNlMMdS8e>EdX^?(=B+A`rFNF)_wJvn zq9x9TJl9Sa%^4#~*nCK_n9W7cg{i{&HW#a*t-JK33Ka-^d_b4B^v(+ML&Vff*Lu{DdPwi)M#W3k=P*{%zUUwO`E+8MlCKw* zo?XS<<3B96Io%DrE-1DzCa0rDA*?h5WOHGxVV-$#S!N?7m8cpa-5`UGzj=!1_K0?R z3-XnK9c@c;s}*7`Xr;I{H6v~tRJA~VZ*%hPU^7Ts!2>@daxF96WSkfwJsz}Hsgd8! zo*_2&{6mwVF!L^LxXd^Zi3iP$K$Ii$Uhh!?VizX%Y5AQ3lwzSZQbCmp?5mY% zE~j-;JPdB%>zARixJ9`#bhxx(W6i|koni*F+y1TiEzq4}eV-?8wj9Be%~9Qt(Tf5f zY$0!ILw4Ti3?$*O`(?+i6@S%w+6Xe(ZU~*3Zf@sl&{hH*=II&UhPPC{&L{GFSgMo( z+6<19l54b-d*lN;2=+E6MB3WiDr7dKgPZr5^OwDHu+T?{Ks3TJB9gl^gg`c-wt-a8 zZR}mD?Z@uwcG0`;NoQZw^phhIp!>d8zw~eVI)_h=S{6J9$8gj}B!gc>|42bu2SOg9 zR5@%vk@f~uYkc5HMdUp8T^-%|K+j47f~r9;qx~vS-?qWb>&RR%G7p}IvC$|=&hPnh z#vI+IrxHLX1I&_@6PI|tCMr;P{R(JddB50O>N^%1(#dO{?nbbjn>nqmN0YGx5Q8}I zbbF&m=XjzAuRRIeOpE3nkecp!FQ)5cu@FG6#GmT`MPrJykJVM^{ej5s-=BSe3`a9s zTE|n!>=_T(D-s^&7Bm^@SnOi*nDGS}j+PW_{PDIE*!$1*!xOPpNw>>|M`P(V$#u3I zj;FXbT?aPGr4dYyAG@inBLx0n|y*Ex1XxUZ3QU5lOd4I*E-t!f%4%>qIL zjF%>7hi_`J(cOZyn|#JeDdQ_30gq9!W3wNV(79`N(a<&ll8cO`H+wb|(;pZ6P@2~I z{U`hlUfmJihUWpo94JlxaVZpcJV79bcVP!%1B@HR!Jd{kl{jo&3;85r?DM{;BMyP< zIu!cDBAK6S&(u@k5NDm`gwRRvqLMncYl<;3tlR0Xte2y9w2kiY051=)fuZJ(Q0FEs zwoESjN|%f6?uRu)oM6x}k->YY@Bu;{J>SXJ+{z)biAVnS;O7-M5E8844w7&qNq&U- zWwuHImFw><{$ejw4Z4Tg9*5LZ*sE>glcbVEx9%_^uq&cWba62@q8d~>N2?{!t{S>!dGkn|$2$pS8?mJL)qPBS8N=dLaq z7ZtkaMx6FyUwiO=l{r~}ikUjHR^V>=dT7+y0 zzF$L{9-GQU0|i9QQdG^5!_Io?xteZ;tCbo=z3M$Wxsd8L*Db3dXoh2)9FURlVl5^b zm)9oV?#$ zg!f{-j+7qt;S_6pikSWL4C)3SE;czg6RKB0~1dHm3MJyaIVf#8Y}0h=#te|TlNL*TRM z^v=-N1RyD<)gEB?!Omcki16h)TIs@atxMU%$@_q?d0{_+o8?ssR+=4LfCXi;zt{;B zSrk!PvM+dF)s;_2fVUZ^s65-PQ1lLI)KTJlx=xQa4Qg2c-tz!{GGd{gy1(m>B_s@7D~K`e1^h%GZ@ukH^dS;$4{G4q_oGp z*1)`-Z?cr)!tG`zy^4&8&0IDIk#1U}Jn3}86@8lkzEpgzd@cNbo>%kHG4FwV1E9%MY&rohhF2=5ud?b>EiWkDa$ z#woR_UP0Nd3vS%x{iT-_Y)WprLocHS6j=_oBNWR6s&HkA7VKtJv-?;YJ@@Ztk? zh;28XQdcFcb+dI`p+-xEdEVKf0Al=Tu)MmO%t+n*ss(pcAIr5$h*A%oCjG9n?o@VC z61Z}AA)zZnYt)?~{ex*r&;SnaE~(nAhQom&iFrRoj{Qsa2hXlTvU|<;LXmq(uL;fj z(|PjycD$|CbSXFM>nlkN+n?p($j@qtdHa7Yo4_?K%QXm`1EB%V>A{*_-2c*lhbEB6 z*C6MmswigEa-+teI|h)x_!t!Ps~&Qw8IYik`*F%7-LBpw(SZ*3-$mK_;d;5 zMf0b#k1Oeu4JLW^s2^Mn$If4i)j2e+xUU#zFr?VKT>Eoh9`t6;@&Pb+v)EuDG>mbI zM4^QjANbAvnN-x*N$>y8dMjGS`~L6EB(~rG@3zse-yCdd-#x(SF#lh|Fgw%#*gYDL z#T`e+Uu7roxr4mX_|>O$1=|I*?w_!S9e2RybMr#<$0-`<NqPzPgKzF-_P-hqQ ze|q10+Vos&7n<{os+%pawe>dvHD7CWF*fVdsgi42(m#|X?QN8Sc8i?B?2YNv0oP%b zd$-1v>CS1jzMaH|qy5l+N@JCK8b7DmF3DLR|G;)j=*L#RQf+mGw=J_|iO}a(qW@Xr z6>RH%fVcFZtLaS>LMeIR$^K$vSAYTeEEM3!gX(0paI-L31Fb<9=gaMcL`5c~6nZqY zUWq{ReA)CLXZ$M8%?3bY@-u0qp=xUO^r=#%gfU`pNgg@Tn(7C5doPq*%GiBcgOfcm zY6i@h)Sg!UV~bz&nrwP+>RAow{^~g88P$ZSlK>0A*kJLf^=uN9_6OCmZ@cf1cPR9P zC*1Wcfo=-3^#h{YvL?KlN6a1^I~s=gOi_CNK>s7wzYj-4=mUV2_Q99xzGJkO+~rK_ z*+BPz25jwNcH@X#z=CbA2av z{qJi)Ums-yX)w;PAa*TpL&)P{sFciJl3ctSd468r?)GACC%MK z!GmwxP<+t2ysrC=K(9s~+CH^v%;t8?$04&Nb|i(TDX3d@^g8P7qeZ&Ah094&qZRyl zpC_AUYg&%EHsshOvfk2ySI<_zS%w0+gKn^fs!MJ}jdZ4ME(n@2)Sg2(T^Xibd5xz# zSUP%VIwd_%Xe0l89_v+o8+V(W>nsb?d&BRaPQF+eb#Q^?KP-@+0f7aZ41jqA- zh)7c+2jf>bi@nMseuVJhYUc6S!4bbz3VBb=&Y;D))6VY#+4y5AU2v)u+8Y zqw%ogveh3C9nDCJ2E{pRjS*ZUm@d99ACU_qyUZ&VE7&*mcs&OaSDsl)KIHGo-Fxb% zsKjQh8qmZPU~bh$s$d|tk!zYA_#EeHOP3D0j zxIcw>?(E+C6{R=3FQK%h{1J$RZi5%`@cTD#e=!$(OuOm^ar@9h_a+0@3B=GP$S~;$ zEx#EnqjqAR`Von*%@>glZN)1DTB+#Fa?E~y(Jm#_(;R*MDcU>^4$J?XB|P{#Q~=3+ zOk{~n0R+5^ufNlRi<_$zJ!c|4&Ea$W(H6i_cUOd)uZhH;s-xE$?PK4A4F-%6rn<0> zEX`&F0WlOu;;6cnqT96>mO0P&V%(9><&vkgRuP5H;-xb<+)X1f_Hb4fK1~Xt$N98Z zKUPwDct=V5Gjd&M=19s9q;eBYG629FvlIr>1jss}L9{a+df=QnJK4jW=}`Fx9t3fKCG$W%awUf5`USWXPw z1%K+7?C&fYT=xYk)s*bN(yCWQNlHukQA)oFwl^93AV*%Y3BFPi+ zd2Ag-QrJQZ)1S`Iz<{!EP8u~0gd1Sd38Xk06mWo0phP4ZXy9$$r7Q9N`1AbG|t>f&}XKbwS@F z^w!~=&&1!3|BQ2r2keq{tI zdk1n-MG6`lLF_xID0g-Ts+e3p61yHQNQWR!pLtrw=b>8hqR>kURsy7vAVKkBQyt14 ztgN7LUCUVx@}#jZ8iR@tnF!-c;2u^CPB#t8TS~#1$8avci8Ue<fiq3Vdk4_;!LdbAq`kC`Um#4^s^ZXLcp+zr6y;ABuMW=7Fu}|nj-L+&{`}Fs_ z80lszFYff#SrNI&r${$No!<=!l0b=bv;{}S4}N2OmCP|k-viQ}D*rB2t(+{t37Rub z@6Ket8*!s6U_5jc4;VF6C-+a*N$|C<_Xv68Kh&EM``Am#^B|e1xna~QW;A}F7)`yV z5Uha{{bElsmdO{Hyf;N={49yc_e#ZuwJL=Dmqr|YM!6ewg+VL_^jOh~HwRjgMx2c- z96LsEdQ@#bNdTy69GL$tWPr1%Tk@*>1m={F-5>8VsUL zK}tb^x9QJJo^3Wo`?tksw|DA}RZTkE-!A%_qqKPuB|6M^g8Z``edXE*z$xILVh8~u zqd@wt$PW-J6u;du;y}F72YDl3)IU^1d`OG-Bzf2D-xRPRc-K4?TI%yx(-6<^j)AHj zy{o1+LZ}q;PEHFA5tZ77x~sH#7VsOta&EKdYpZWdrc&Z$I8Vcr>Q3umncF~5NbhjkXwK60V@=^jjS z=3}*n3p9RS9<7n4b>7r-I67HO-G(rI=$+x3(%6Z)W3$x;)drDef|vmkKDs=9Z$D8D zheV*~{2izCS^NY#hqvt<69ck0&{r3A09ehfb6Gyb6T(5DK?z zS}JZT|UuOat`*xhwG><3Qg32f$(pJ&SmF4j9ye)?}RazBbFI0=7m z*%-qyCc5vxj{+mm9HqZEmKHinopWYrP)Po8#U{f{<4%WjlRw z0a)_D9N)i$eK;JYiP$%P?h&%@MIgzuGgAYW^(&|#YR=Bx?G)$C@#g6j&>r-~U8K>- zIrYoR=KQsm5lYgP=+UXurC^hl{xofV^x|ezopQ>Up0q)XC*R127klNj1F((~G$Mg5 z0~ZeR5UXEtp~{o9q00XyNslOdW<5Q{rLy&$=AUw zq*nFx0G9KCwvd((ua9<03n)`%v#D#UEILrl*PMsHck&^{)rn0An+S!wix1${C%_o= z5g=fh(?2w%_AI+_5F}`5dEXfq{`WM;Iq0^Vi6nW5JTdKvr@s~$u+IuRv-k3PGQy#k z-tHN>hBs>~6M%o3>$`^EH4&cSz2ZTjDkXraL z*FjqF33KNji677JAG|~)os?vfW&aV0&6M@}yOK~M ziCyVrsQAK8==EA`IU1Lx*?twk+Sn17oxE8%`Pw&fk{H$AzN+|#qql4|VwRES?fO+z z)LkR*XM9T0ekVGZXuD8T;(x3JlLgHQRs|Tf5v}!7B{Q0Pb-Xbm_|`1`--?!<>Hk%< ztnAGH+aAIG{{sYO{|^WZ_#Xrvw|^UWK?i)JhVl7tpAzvw0M zH71u*kssH}OBa-32XJAsxCn5dvxrp$&|k;jpHFu8C$Qr!?1;Dx z-D_Rz3hu7w->*-0?=K+NyACDILkpL~jk3>FTQFNV!Y69h^DKat?zRn|X5*O6=INYk zk4AHcpk|+E;IAI5r-t`?lKcZbz%m$aST+>Oxdnt;E;q+h7(-OaXEeszP{f_UiT;Z+8v$`>L2$njg&XDi-@h) zwtQY4pFU1mP0aulvcwqW#_A&`5%kcu((3s{Ej;S*kin(XMxl&syQk#|HLdn{H2b_{ z#|rnfQv{@73(l2+fz>U|8np1h7A-}hr%in38Uebh!^E*I>*NO8ay9UI#P~#0q4_OJ zq7OCcf$6LNs>Kt}x0F4q&?7S(bT#tckb9D`$%n5dT>u{Q8u85qaAi1aFa;U~!4tss z;{!YgZnM->5HkD!V8EUb6%L;Jke#9m9Vm#hpn-c0xD{QK*+PB_BR zs!X1-nf~%V`L}lPOPpqgwgxMlT|v^w1WseOd&A-lc;@2`ZwNfD^V^iUnCy4r_uKCa zKg)$ID*((kt>b+Gr>o6Q@YCa5Dko;~su#0tJK0yHtRMmS}C#T}#MPILD+uqC=*)7Jovv%}qBA zFrZgDB2#^qUFxbMmMxrgs#WuKPd)Jmd3aneSIYTq>+Io8b_@kC_zDEs<5&DxhyD>L*+btAs8Bk2 zRH*Ly3eW_Q*O2b81^XtruADMJhFV#^5a!q;dIjGny8EVAKE;TA|Ilu0FSvU-K0D9% zy~43N8VJaK)9N^8od8hPZlj8v17_?yGVw{i4ce5VVb(YEs1yzF`L*RctG&& zVSim@-|f-*n;fA5{XQT%`NOvGw!}0do#k;FBe~|@?v1_Mxf>?j1#6PXzouLS@dI0Dobr$Oxb zq&yzrB~Yoj1~WUeF~k)^1maF%SRc4eN{ZI$$kEI+9~KpGst}pdj7jy|uqg&)g-b0} z))NV7`P=Gu--)8K#}M-r7jCZw_TxNPWn~P_IL`#4FSmTz%vE+#BqVL5a|2ESE9)jj$jmS9L!& zlSu+(P}c_?iuqY#$&c9e;{`?*3QR5_0R|Ema!u=cx*wMsP#~Rq>}(He7|@Oc*Ckt&HWh@(BL3g{TXbh@O1AfLQPEa-C#5khOaw z;HsYEE;KqOweVrZw#zTK!tFp;ibIXh@R^?4VZmk!3O6W*B(`ww%nw){(xc3rqzDH! z7O~7`)1BvoJ!zOXcpTBfllNPOHfFNosd_?7T02|zuLoNOC?}8a*^S@b;5YbLwnOAb zSHc0!T;;cNfJsMSC0`R51Cj4y>uA)!$slp5{v($1LpQw~iY~25OfYjT)DzLc!lTC^ z@=2OM44Z<(&0Mp`Jk!wN#%XTv| zdh8mnlYUaOLqh(LAw0=4e(^|QSyHkP2+|t&R{Q8stPZ|#A-Rj#yO`h`F=sbD zU{y4`-^^&-Z%9BBr;(gxSWTgp16Lw$sT80AgGHAB&ny$1PyxiJuxUucz$Cj|Nge$^ z#JzP~mCe>S?nQ%ix0H14AU54dNP~ccl!TO&sOSa+K~nNULP`)pLP8LbZln}Rr9qSy z6+x8WMd*$9?K#i$p7;Dd?;mWgSTnO`#dp@M*?VT061R!|>c!iNC&Y%$9(<(Jnh`E~ z)XL)QAmPmxkyukosF)mAW!rq&wcRKc`}K%K>@-ImwIKM}Ps8oGvxRH3YH8$ER5xwH zre}_jacw9x)CJStgjM-$$31#l}Jk`BuHr5v~+AD>p zvQc=sO1HP-NLO#Z&{i-L*?E^96dwn~FE%}KH7?tXQ23;|`1YF>%W9WoEk!)my$lLG z>d|>n z5CJx^c3>`1XQj>vG05l~Y<*J_S?{XiP%o#10)%ao*Ly1vc*p#fH ze6@sG{WsoMf3Zr+F?{y0E_zA4>P>*cp7%v!IuF0M$VVvJP1@9+;{Q(#RAfoA4P^4p^Xy72cSt+xvhK^ zx5b&Jp;QH`d|g+I_AAysYWtgFoZA*8c=uxcu#ywF*sd@+JiWWCOsJdP zGYbzG%wdS$2o2|OQ#3auDZVD0aC#he@wV`Dm5w=!YAM^X@0kqGrnClHBIWdLu1(9+ znSAXRdpdXp)l9;Ji;52x;*mWy%^l`Ic@lfG_ZDBpML_SuE0Q{NP7bI1v^+g6#`D3h zXi06nX}g+PHMKeXv!^d<6P!|>_ncWXp9#|NdhWwi+`Z=RE9N*geZ}OVU`htZd#5$V z4aJApWG6iN=txACX6O=<{oil+Jffw00gf0uw2$Vm(y(Lt-m`!}n%bhOKvnT3URclzsm7j{Xf zD`P6|f9b-Tu5n#)uPyYfrbD|hH0RqCwQGN0XmqAqOUVjKYP5SS1K=o#Gl@pe6Oj&Q zhHl?AbG)~Qcq~qPqn~i}Bw6jb9$rt!@88`ADhsTiFfQnuk&UAzzO7#6e|FvkyHVfH zG-)6NjdR7uA|UzM3rZp?f^a(un;!6Lw5RDi?=z*1W>!%5@K- zM%!n>ARnFR5^pnd)#T~a#d}T9i~I?V-h9e_MFX=B_nzx4wQwswb)mhR6q>q;^4t6GwsYdD1t$>g zmM6uS5ocC;V_x39oy7Y<{PHQ;Jb886`TlYYp3Vm14h22s(}@(NPI{Qz)MXrxso&s8 zMi*pm-;chdZeJ3U@GQ79$ht>d#-`?pJ!-^SBvBR49HwtJCsn`Mxh(W8LVMDFxjV~h zsMy(_vG0kQJ(mkwWWlJWV!D5|!==*p+KOxyIaAZT|HIfCRid*iQI0ih2J?D43teY# z1y>9z;kRHllBWqRjIq_D#%7r0r-I$c?&;_%y-G0T;9oEBpgMa|rjD6<{i=*7J8`1p zQ>QihnX(zuGA)cxw~9rhiq9m}`MDHfYT2hsX54QI-4OW%NBicremDcL&^lH^81Z%Y0DLgYK2dR`JM|f@K2wAFq3Mm#XHvG0qx=1t%i+F z;Ak{q+)aClNCWNi&Jp*AqrikT!sOoc6g47uo6=V$rJ!w?3kdE+D;l`#4VU#a)Q z=;ZlGBjd<-@8{U;cff07FRzV_B`z>sC@PouTs~{Xh;A0e<|7U)d!jw`x%adi%KT)s zZ)GXRjoerb50zXGoGa`wRzroywXqRrDT8|UjGW~95>SMT_bxy3uk4JZB|BZP;e&M= zvEUKEi{Ac_*P68H9^Er|PIWVPLZYYsou4mqYPCz0-dzlFtD;_7V*T|%f6FJtw+{|M zpAr%%S)|eWFJp?MaFFSJBgS$sKI^HI`9NLbewJ#G>HtNVo{-t_t~2U2pS?*bT>COt z{n1lWFJ7D1WVnmB?|zMG;woyVX!GApc&g6hdO<}|xZS{^*#0GX5Pe_<4{di5 zbYjvlQ6h=B-L#EU?l@kO!w!kY$nwUgeo1~;S`D=0a1$?U53cZzOxknJ2d>p+VI4{= zpBFApicXEWV2;h6Yn|DeUq^?;ula5JZOV!<_tgAh(*Nt2BNXbd9SFq#aLkeT{vO=N zws=ca0%*}{apP@NKCukZJeD4_F`D;u)-?3g3~g(=)JH#x7C}h>+a3p7W%kI68?lz@ zTi4u3S@1CK&X#tcCc#HC*R9_C{=5*VGl{!hgb!^;AoJW*`l~|e=lPYe$3o}aj0V%p zLu9p!he-NLutV4*PbU`j-7nnD@e;^0z9c{o?d^6BT~I9M%qQ04)BeEuaZXD6IFlRR zw3+k$hI<7oQB9Xy2Nyp3aET3%r}?kNmiD|&gx0tR7ivCrR$NUOe-n7Ym0qFw(c0#t zlXsz0McsvXDevD6W|Z2-G+V0w@ohQ1fTYhTy?Ekr@Jy+05g$wEW08u;0NLac6-2m>=6{Ax!rsxSt2ZQ_ymy+fzMiHVd zf5}U-7uPUdJA=HRXGQ8M5G;yDKx^EpI3+O0gkZr<(^VC$+wPe~tV5TqLx{-GkB! za3p+{V!ukyLl+EWl>+kbRmfGy7lQCdX~W6@G&-_EsvMa}1+VXWSl<>sPC}2w`BCS z1YUEN8JW4@Pb@X=@z8h6-F1^(rr~rdUlMuEHsRD)KDQ_D3y0~RZTp1tYCO7x4#>{V zK;1(BQ2nfMM<{zR-2F+W*1OH;X$=q8S1#7D=Ut1ZyMp=fv&BpEAGF`d>J;24xoV$W z+%&XMDmKmf_&LF-c`*D&A!k1sT)kk}_gS3cTLmaFP<=wJ+$xSk*A+V~Ns*Epnb*mf zC2nKOsY|YW_o~umfo3c%Dk@GL6SgPmuked1EYOI09>vBw@tYdmp9qYy&(l}=UqB^D zj2AL%VCFRV$qir|6Zcc@vj3O_LgiN$Zk<7`G<7u4niyH{!pi*Z&vx<6Iy1Bt%Hz2E zZHv+FjTF^kx^R>_IpEH*+0;0d>xECcn9!W<=6t)v_;C2FZ_?}wt?QNc1Y zn|$;@#umF(=`^;rQ8_}OS@-GnR8_gV6|RqQZnpcZ$B@ZkOBFN}t{3k4=blh}r&pv2DIxqX$>CG2#pfmMt37*uxe1D~fKMf2sM-{U0~UJ`4x(WYn{7cP6-e5%v?{WRzv zamQm9*Bv`o1~_+0|B`g#rYfT1Wh7~%d zJc3~U6O%TR{F^c>W|mb9FI>-V%ojwvZG-_9U0Q3jY@va3^lO|=)>;MC(#SJKq`q^x zZ)?$y%{3{{Jd4}-e)p;C^>-+&)Jxgie6_Q=Vb812q-B7ouq>EMtMB;I7*)yDwhrF7 zx3hgK+B&l24pmzE9^-bj)S6S2jt{ZIQK9udl0E3$$ISTnX*FzKHggs^$-yuDD}ij&Z@{TJXI!@1W>e zQxeqWm8K;2;frrnzqSC@4~9lrh;=TtiQhMg{>WIrxS7`27jW^hhXs}3O{FGeF2;+6 zwbs`OA-#s|<*zqB+`5&_?KXXtBpwVYpBzTUvUQ$XyF}lZdVc%yi7Qp8DZ1&%hUlQ)>{8>o0LOBL~}lg__Xx=;R$ ze3L`=8&Ax%^S4#h=VwvC>{-3s*`xt>?H5(TpE@G2{l>KK0OudHjFu4TSOc!CT7G^= zu2QX!m$nOS$C;KGz|=D@C#2!wu+mp+Uv#}RmeEs6T*(&3_?TyDUhVp(zo--F7%SxM zk!qAcf12+6`#)yZ z*s9*6TSyjS*?-7T70N#{Rh%3Tzwb0Ew|8OFdMW)So9ny9@@{t~zH+DUlPdwR_|Fnd zm^9^ImRnQ5$#Y?;#-;lMIF~Wp#R#64-jV_*NgVahMpEn(P;M6#;kjcG!@kHL- za?MTHLX{6-1`Kae^>3&;8nB~#CM9WSX?Vu1SkNz>BIV*49Igy(bzrNEYhhEf7MPmD zf*$H+iH%aec2E+Ai6qw)Iz32Gx)L4XE})u8W^>m|OQ$m7%+0wbBeosrEL(Bf3%Fhb zDU8uYTxk5VEUt?R*;m9u@}?qsSa_4a(J3jXB`F#tLHql7gONE_ez^vuU(b<>sT-@> zNu5B;N3`_dT*kx~=ec^Cj^u14!W5uppCE?0PP?Q#2Jn5Y6;N0e?FjMemL6kaK2-Bd=Zq$m= zfEI0T+bQ??oZ-taQm#6@J9}9k1)e+8Q=-IeCj7pw^yWqPo)?+fQtz&N*4H=|n;Ct5 z`|j$RewxK3EO`4HlM+I)#x5fFbyULYTlmKnmxNCIObW3Vat>;XUx^UOOHnQtnw(^` zskDvlbY>`Dokl9s- zZ9;d+w?X~Ql>mM}gM?st{m!=|lnvV4UDsZyaoIP&0Xc8kOnJm-gdkLE32#5)E?5r8 za&|)5D?fda^nH)g&L)_xq@jtR{h5=4^p$o)yGS1t)0JhBMEl1np^VfkpVS) z=Gm=gyBQttP_yUjK^ji<#=i4Gry{H|tIzDs4tyS{H}Gtgd;W=Jlk!_t<(*Z$B1>AU zxgB<04~rdr1C3%q@feN3!J$ZH;3J&3{1qC#elA*AzKm$zAD{OE@!H~J&Hg#2G)}In zYhS#=suSb5zU3qBn5y`s7}F_O%nd(QK5KpDjkWsWV^Z^Zsq-o>(+O0OrkO;zqF42F zjkuyl=G1~uUMnC{L%j%$xjf)QkSMuAUzG0NPN|t`Zd2+q9NIM#HS*(XN5g5)+fQ9G z@X*XX15Nr=J-RSM%!aJf^dygkVr>&6{X%WZPX{&*TIm}RDx_YrzRngir{XJcIsTgz z@4J8-NdsO2Z*m-}!(5*zo+pfBN+KHeXX5scBvHQB35!|9y7=Z+lww7}*f2vnaiBeh zkS0vMsJ3#U@Tt|Fytjm{*N$iy&W?p~4ciSgP25-AnYril4ONS0s-Hf;95Ai^TKn8k zkJl&xBR3~i!P{)1F#A){eFntQPS#_=s;^;%<*!Sa%jA(CSA2bM_-W)M8{=z8iJ2Q@ z<-X5)xsxQw%hO5-?c8#oEuSk~W5g_f>|A|QR*KH-(z#vxV#^!%md@F)^4NBYtX{=# zRzk}Sk1Qxo%Bhi!51o?SD)zsV@uTr=CIJ>O7t&3F<0eXghkHr^PlJA(rNW-LlU+oogx}5N-NT|jle>0RsTJQgJN&E7jT>5q&7M81 ztuDcR>0tY`{bXzre?)R1gBtJLLs@)kZx2y)hxC0J>?>F+N^OL7Oe-7f=rnEr9QXP4 zS7+jI756Nh!6t5{YO{Eu#AwCNV0Q132Wsm*QiS9+NY}-(<{Rd2+J< zTI|fZyBpC$-n8IGber9@9aW@8CV}V0-8+jV^6?KC(HXmzwz;yS8Nm-bMp+Ec4#?%o zCZ}&ST&qQ2k>&)KY{DEDs z&z+o@!^M)6=z)P_!Aq&xjo+}N8J_Er`(lbQi|yT6ngr?rFI_dJ-2Hu9!tz%6VR07) z(Wh7VoTk_rp%vGbK8wMQgb3B`d#TZtT_@BulC`&n1z)%YhYtjwbjnE%xi9z9;FQG6 zSBzO0($LWI@)cng+s}&`EP9Ej*Ca)~GLuCH=em?lGv8}mtAFW!q6|4f+7O?_HO#-z z>?f|kEx%_}o@7vNY}yle$+C9@{VBhdLTWADblKA8W_v6T0der7%b3a1J2Q=~J5<`T z*r>sA9jR@7`zJFCNoneLSZJ6(P4$AeWU@>zV^quZ8kSuRdY;O6mcV3&oQTo~t6eZc z$iq2cV|^)wJ-YYyC4beE7ubEh7Qn$Lz2i@5x6}BGZq5e>M_sUHs=cx`T!H@a%I6`2 z)&oILx7b8xHi{{FIO8RWFGQc7*B9u_o4t%Ooffsxn-XMT2ZwxyjI3JfC2!aKD69OO z_2`-bk7u*QO@m0X-pBkh`8aG`uO;&_Rote%Peochsr}$*By6PVq-rV{nE)@PQOyZT zTvaS*RX$Z}Lb!&B=d+F%2WNIhr>n(SJJ(s4s|84szODdxE^bAY@SkjsNX+s7P`jmg z)5b?1_i>-|2<~HT;D?yd&19PTl4@lIzKhP)H1+jGAD}}qw=0xGPe#jgv{)0iiNA(G z7?zQt{|xzL5YmsMCQU;8)#|(l6wtms_)^LS+D7Ecy^1AoW#>=(%T3{-PnYx?Z(p}C z3;#N69G0?v-JCaQ;OljZmamfoFO`IiQtP$T-?-WEXqo(w7Sity%AVpBHZ;30v_qzN z(S|4CG8Zeh=J57n9Dmmy3uvfx5eT@xWLnaCrB#H$(t_!6(3_4xF%pk$w)DHI8qL%-d-|=5peA5USNuVtIep;f76x_VSDOCf*)j;;PTTwKU?Y=gZTod)NKG+y0aH7qc6>&&BoM zo&SzS$h*Yoyq=RCGnA2F^KPcB?NYf6E+-LM0xSCdE|BJ;^|bC%Xi6)i$BkDy{ecgw zsQT8ndjmG+GG2v_UiW!p{j#%dM}2|CH18Zy24}`))*zOFk9ib>X#EUsfU&6;Zg>7d zT{`omW|DMl_Q1E8m&tKt6=lYOb@!>Cud3*$uA>ADXpO0FN7A#{zy4udVOgJ#cEsw_ zK%WT>dN85!A@bzs&D)A{opnyWu+G|?7wqGbrkV_SmgIL_$CA&^H=RL~lh~YS`4MYF zo|nXbb>-?CTzNmq42v&u6f87v%b%XG=r5)c@_L0>WnIl354f=x=Z6<%two4tFGYSx z^;K!?z;}+tf3;g0N@ioyLIw{uQdVS6;-W%7nRy?GSt`V)G=UR@HMSazMY@@pq1P}` zenkWH9Z8H)x3FexazZ}YcDNIeR8YL z)e`VLP-Ak)>?yX_<1@A{r8Sye#7sM1rLC0iYV!72hnVKoj7nR0}^x`G4yX~`y zrVo0D@O43c?6&g_=(+*2=3=gsjG? z>s&;oi1`~K%j=S61lo6*UNG3UzdCW@JDQ|^tMF-E%toI@g0Dbz#mD=XU|r#JHp&Z) zBdr~m&u`wZ_h*#+aVt-AW3uNGWx~VFF-~4ht9qL8Co88;I63%!Q;az>hg6YUpWpf+zBTmv z3gJ%Qs$5QVjigHc-ZQO5YdgB&WKy;4il?C`+zeqr)A+$1pqwBzXMHx30A)?0I3 z>dmfUuil9(ix=-D*SF~iV98>UaT{F1&Bny~dQo(58Z%{6mxML10cV1bmQcRT(${T- zYE9r97Re~_nngp}lakx^vYr}4y)mEdU0FD~pMJ&TXKDK2U&qXX`Vv&sPh5;!#BrYb zmH_=6mF;C!&aNm-qjj{%a7lH%OGXJ&2H{HY?`S5QQIT2I$J(FVFL;l39r>Z0dFS@t zM2)eeqxpHM`MC^2=g)rlQBAExg7n<6pm7+y^pXB5OEQz$7U?!oyAB~% z%I35AQCC1;rF&wE0JLKy2tDmi&Z6L$N7h6b@LZwhbo4NyZ5lm5c0IbUV7SL(c?qsJ zym(drq&o)=1o$5sB{Hq?Szzw@Jof~4w(o4wpImVH6i(On;({BNV8P{Jhh3g|tODo@ zUi+JaGYvG}Y~{IP{Hjk%-nltO|51ZoUnD07Z(iV;b7!htVn14yz=Mj;<#&D%Fm_yP zob3>FC8fbD9uGyI=P!f9a1>s#PYBptrHIh;e@;xUKF#SnBu`4eH>W3V%2tfy@GRqA zfiW1SCd4*jnKd5@v}EGcXZRMj9QQACRWwwJZj8na-8x^(;zkIZV+#P7GP3I(l}`owq(R=6x@a# zzOh#7C*4kN{K!F3o(gx3U0tAyu}vpdDNjd!==9V?JgJ(T4&McKQLGPjhU7Yza#R(l zBF#K!l%5K<@^V+@&s3xgJ?1|fMQsAA-_eLLEYjkk;NUkDgw9kv+b|N;^&(52TXbpn zA$O1!+MUk*BpQQ^+7Wdx)4X6ORKC91)2v<4bA=B#tMZma%& z6H7Y_6FPS#j~phyE=A@d2ijF%pgFw&BZZyFl>E&WVku8D|GrU zaEU#73&+=Y3SUQR?zTU%6uG0FKDGdG7b<;|6Z!(Kc!{3ObqYwQE{=lJ7=+a<#ao+7H)t~y;s z(|p?|)KnDW9?6-O=WT<2i1A2^Ze{YZvK?P^9dF}xA)i~zl^rm%dlm}BF5S)9-wA4| zy1%?_?*A6Vc1KU&5FW|)%;!Ps&r^Y5NKwR3U`K+0E5L>$f)Zg7M}oQzfCxxu3y>4; zN2q!PLMm>qUM!%y4?sySvj62%Jpvh-pG8FyT>*Cd!;)}w0qpL>rnfY zLW)p%J6A7H7SX?#7DfEAWinQn@L}=8wqe5iTpu(mB=73#=H+=F46p-Mga}~5hgHIa z_m{%-%#XEoaMaN;PGQ3T=%%&{?2ziH8QA`hMSp7sCVVIZnDG99s0X#Tzd0H7A9mC( z?4Vuf{*Yf7?10l_e87Z%RSHJu0(2m$D?ssgQIqMw;D;3*aRUEKdPg0G!H!ynAGCbD z1=t~ve<=k9|A$<4NcO)V{8O1QxENUC08rxn6cV_57K8rptZ6GC4|zXg3VB$?zDj>G zg*Xz=!O6eJ#SeuI2kn9HM*zluR7@grD9)pbMZipVfPxBka8mGb>w<|2|7IYpmjE4- zLt8j1DvAXCF9DPkhtfMH0#T8Flq5c6>8PX_IN$_OQi}fS6yz-X`^&+^V84}w+(BDa z>^DIieA)VUI}tmOvGlRS`$C)Gwfgr3K{c3w738N$iz_pXjA;Bq5SlF80sG;rY(Uw4j3@h zFFt=Yj5=uexRg+b6@$X101bH36`=j;8XN9_w%Bhd06&HTzaRyE1OR_&9{x8!->-<| z$c+zG4;Kb6LtsYnmuDVn2rj&jX2&?tAvqM@Q8^d_)VT~$;vD)uNL>C;o^^;4Omgr;95@DWaQN>gzhALE;)+9Bc+Ofx>q6A{((Jk5%_QJx?hx6uB@=bX1PJCS3F%t_eRJB9Hg!2r7>m_}@m&{d$j3?5Ink zzXpV3d>w3{c^q8fqT>JPptjg=_Hu}7$MFa*c4QZa@OGS0(L?k&#;DjI?BWQ$jyM%N zw2Qw0^`|F_|85tVR{@9We!%;2mX6RBWNG@FF81sDZ8(6V_J;!s zD)VFenr-1e@;wtl+m$zyK5vgPytFfvyU|02Xj= z|LRmYa2h-p2GQLMhu(JYU!fxaW>6^{Fu*lX);Ca4Rsu5vARSkRL+`92Au65-=p#K6 zP{Dv=op+G{6Rwt>uNMmv3I2!#=m7-S903S|wxIy?NrWJbKuE{R1By{W_DDbm91R6d z2_XdGKc7OS4!SL*<6-B+@-rwptna6*fvMIQ42cl{7YZSW_!k8ag(P%X@KBO}*%?wC z90&xMz>NrijsYQv{1pagG30Ys3N!lM8>ilaXN#UO--l~DkX&3=!M zHsaM2ffF2>$}zJ2j{SNsLU0I~LV6+yfy{Xn`@&fGjw27mx;t z?gFZyMa72O z!XaFTi;4+C;};Bt5)=omk^y>f=spx>;AQ|SWMT+GF$fMI4;6%*7Y1#DGZhEDvrLD= z@;HcqNK{x52I(3O5yFvRZ#ty^Q<+esXEOkNY&Z){1O;xy0}SBR45;2b=nVw|At(%m zCj5K-hkR*qIOsG7C^9hGr{*h=W>D5Dn;-35bLBSpX4OlK@D7E13Wu zHe3uYCx0FV}d1d4z|lNvFI|9!E+AdaA*MGOHk zCL(4|Af#mH=_TZ8XXE7vx!Oj_TQ5cIT z3U(-H8ih-x0yR9DspJPvj3m1Q{J5+nI`n@Kq)kFu{Pr zX{c_&{TpKNbuOSmelVB)y*i7B0F(S5D*FozVDNpM`mGdnuXmgPishmKN}^+r5Mtny zhd=;;-1kEo@P0XzeOP@6;DJ~30BQ6-)cv~(4`R!o1TZ9m0Q%c+69TJ0uqvbnLkdGA z2SX)vgAgZx{toG32odP!09yCoKs7;uH~OF|7&Hb#e}C)CK~(p%=|7+-00<@+Tu>N-=%3XhM4;-RiOLZ%T`@!qg$6WWZ#4uu z{>1<;H4+*%_E8-H#el+pagbIFaABYzM)ZH( zH2z1+_&JR{NFbqq6Xkx{zebS5q|#4<|9=?efe`o)7zRH`O8sp5P|aFp|4+qrki{nY zou&6>0F%ytV>mpH?VwIMG~Iwk8A>$#AbtH?n}1Ug?D&l0zpWywqY?ji6@gElLbFdO zoDifyz(fSa_MIAX+^Foei8h)MaX>Q1b;LwI5e638Iv(0 zVGzVXK_3!+I9)(M(KWQ5frN_+!oklKP{0r2n9xD|#)uF@LJ=`U3p<=QAW&kz(TZar zj)i-SNCXm!Bae}bK!G(>HH4j_V0tAKqh>sXKJYyOvR@G+F(X0*ny>7a56YCwWo1PKi}kWOLHWI`0OU}(q_gwprn)d2r~ z;0y&MOh|;F_<`1;Im`akP8^!H?PEI}x)%Y-YXI*5DVRP?)cz91f7{ysT`&zlh>U+V zeJqdga~KfW55IpB{BIECpRxTx|Dl<|&*1(zn*BRZJV<~1Z2Av@KKvm3{zdRFV1yN$6AS(#X066OQN1|h5 z`xEcKC2;;Xa{Z4cP=B!Qzj@g~`ump*|6l+I8S$S4|7%9&|JPH!;}SozhTmsXl$g*| zAB0syz6MSGMIot+K!KkKgnCde_8?ppfus*j$3q&RX!7S|mXmou0kKaFMV^AN1S@EGdLB|<@0q4-fz-QPP z4F56<@t3du6=Orf0j;_LN^JQv28L(B#wLIoTzds2X+j1dp!w7U@PUS1P=FBK2H=7X zuc1^@|1bat6PlrETZ$t<2wv)jvbWRC024G^1q?trM!FV25Bib{R4E0BZUHy}(Szre z4K2V102cHD)*wYYw4`vU1&T7yv_s1WIV}J~WoSEK2teTu*~ESV>m@*dM##u`dU@Dc zxe)lKnn#}{ZepPf+DZ*%kZVj&LOOrQJsGJhBsV=!!cD49GhvZ2L`$RivGIis^ZOmo zHRq-|>gU(wn%X3otiEU%_~X(RDiSr1<$ub&mam4RR2@#(ckV>3gB+~t0|+UP zmMD(1dSqx!gMcMuXa^z_ITYE%Ahg5;?}04$%xi!d0|7tmRN!ks2!QPHfK(J57y`UO z#eMreKMXDEpa&p}iysD7Ad^0zfEGSS0DX{09fJqw?4e(NAUSQ=Yw7Rvz zf}uiz5*9vYqQF(m+qzkOM=dQh5Tv!GNT^|G3g~ z3iu3wx;z*vXy~L!@ndqzxrT47KRom$Gb!~|{$T8V54OYyV-mxe6{bs4tlYfBc`U?) zR-6F&MLg164oQ4`(u;VWN%G2edIm}b-uZ@?J{#rxloT?#ju%V5U%39m?NqrFbnfET z-j8>A+8({5uT0mj4c8czv#LCo8yOj?T}H1`EU=%X)|i-J!`~t+tIR#m=)zB7QBv!= z6f(AlS9bd{zm^T2a2s_5ouQ1CO62p;yL>~ALg$O3uZxEa<#y%1U3mD2`Mi&23e0AK zS53*!!2QBqP4O$!O~DG2zSG%UO|RJ;-7}2E>CmBM!D?(x%GRU&(?&68xKEPfV+J;( zm6{Aw-bkB^6;WxK*9<6D8F5f6ZwKMO&A!nb_&vzA@h0071LRp+mOJFPrFYpr#f5&q zW!Fgl#4FJ~*kF-8UL|xlaDzoRHJv-~hOj;@YZw7ZqWXrtRfz#D?L2$po!wyg9bw~T z8tRok!RR&IGc9l{rFbk^l6LKNgH`fJn&=NSRE(??GgNQSNy@&-=I>B#E8-(+iw=%G zv71}pB9tuMGiwh|zwpF>o1(RI#M@6PiL9zSK9;+g)?l-Q(%uRdsnc+75{#3ID^ZLn&xnOwkmTXC#trK?ZgR=cmsC2jFT@rJ>_{$QBs{Ml5(m; zcQk0Zim`S3dCbW*;y$`Vr_1Yh8Ud%TlY-Y~&upw;Ft^omGU=E7+FUlZgq&-%>1Sq| z9Wim`WnkB&UT8Ls`~I9YkJe+#k-sb+*>`p;6DJ<^(KKv>5gg_5^KLZF0sLA*m^u6| zkMkgTSvc9DjhgTAy%X%@)1O<87>%h#OUDVlXCYazts>At;=hTfYs{Bsukm%u>3fFd0G#v3$24U&i6q?OW54U+!))X>Jc} z)8JYd@$Qa&P+$)r_vauD5xb2g!JF!Q?u+d^TmRNwD;Pe;%j`G=`zu zkKFlBU}xx@-5AQrcLgqZ)e;ECU#Uoy8T7&TBaCYG3HzYDFtwX=TgJw_?pfeWA=kC@ zP9$5=_3wtlxw()GZ*#AX>sR1@ln-Y2l6rUAuX&UxlDfP6Hg~}MxUQ6Hlg_z97oXkd zTMu_q`{F#{q-wO3}`Rl8|Kw-tHF## zfSNayvJh``eR7@Cv>`*SMBJ;tQqrOaR}MSgsjK$`-SsAkFL%$rUVA!p-7U`M`0?THaUmP@p1&!B z)ebDY=W0Y_ama;XbKD8c?D@0Rw^Qb;?~>G5CHC)_!8d`otF=02$zy)JfpUt>BIT; zw#;C97k^G>rH}FtBrK@pDm;kJiPv^vR_{nTyu+KVQqy%*d!qaC>s-*Bua`%X6*_iy zCTmzIn?u}U`YKcVi}{=;mD5$(j<3?^a6J)~?!MjTh*-qHcvN20C3^u~<_!^(b}yv} zrJ&aNE4cT^c_;+fS%c5&5p~J)aJRDv>A%Iw7$K`8sB_!?`jP8glpMycR%2ubew1#O=}o^w}m{axr=Ue7qONaQUWeW1F~d4}{3)xe$il*QOlPj*#?-;aB# zHX6EX+~h7&*Nrh_o~$XjMwNuopEtE-CM|l^MO}`ugdxb0ohUwSelS#4+obKwNcr1f z5yhv8!$SSsCnaH$>`E2)yl1inhEJ63gne)XCq4iSryFjWtTD_GEa-MjFZhWUmGW~H zcf3Cbow3^avLlq^ky#=u_FxUjyacfGJbd+hIp&qg#Ck(OT-tORlQ_9JMFkB#@}jD= z@U8D7S$u{%C*%^?-K;^UC4dDO2E(CJKo(fM1gKFOhOY?GT6xW!WIS7MEpg6B7C)yQ zBwPk$NLa7Fn3XFnW3&gq7sR}41WlF!PIS}7p!#cH@J|=rRJudgrERzMkC>TR*?w491qMn?1ZXtaZ#LHj+dm+T^@N_2B~`&m>DK35l)8N1T6E~ zoB;+2v1u{%l{}+VeeZ*pSuww7;&M!(xvL)Sow?X`v+;siA)(s<@q{MIezW=R3JLXf zdhb|1Qw2AJ;YCj(t>^9YcDkKvCYSx!(j7ifG?0Jgy@$qle!p{6J5aIuOKr3s0j;B6 zl@$M3nxZ?H(}VOLYNT8^r#^kaGmw$QSW@w~zPc%ClPWIvF{pgJi1!J*+RST#743z4Mw2k9g=4)_2S;{zd1eNul3P zH8VMr7735;iDT(src5;PS5}fOh@rj@;@GreLMK$St+?V$9`iTB3t40<4PHI8dohRP|2VT=p)uP^ z>}r^h_vs$CZc@_ihwf1xM0RZw83GRcPOndVCFi%!zZTYgHfe8)seHD!B4+@n?rWM0 z{g?{)$m4aP$vX++PaEHQDVea{`RzuxD|Osc%F2mL2m&(twch0l9@zKwe1xaT4C6S*UM2{ufyc#G=-opp5o`lg~`!gcY7qhI|A=5u}X6Fv}DB&YNA zhW4~Hsi*U%g8?d%I2fafcdjy4Se6Hw|?FqiQgl|oJ(_GiG08!>Cc#|*=~YqR>~J9YJB?&|$Q zJM!I7oVPo@yFT^F85ou&C!Hh5IZVsME)e;G3Q?0iL9^eA&&AWG@us{|$FNqULI+eO zmzrP2h1Z{w-h3T1F_PyYzp4`T_EfKj{#bgZ&A7`pmSjT@JuH^rq?2AMaQfcZstR@U z1ZLma#Ps)@HQph{=L8t;q;dEKDN7i@{Zi%a5@*9z2%LU2*Ngy3S98 z6fEAva@KDs#H!zBV0d_a)bL}Yy&t-pIrd>dPxF>Ir>pCo%t0N!YZ?8i=LypUd^9gB zT6tgP>sA*}9^>B?y>5|X2il3eJyWC`T%dfy(JR8~p~UG|_nhXaExI1@4_jjTiQi$M zh-C@KYs=>fjR}jR@Tp?3rekESr*E)gWG#`$&#w@9_S{dAge#Syo_1JsV^oID8o?OD zPLutG3|DLQNqa)abPQ6eeMa4_FlG)r0FR|7BDTIJWt5z`g!~0=_y_ZEyQZzuA2%DY z@;yJH`oG9Ddv+&B(&>+%%jfZWf!Uftt~e}k&c#|*%Djp&t}lqS*xC0b$oUCM(dWSmhoZ3+pgQ^!KdW%te(oOF+Z>m=5xI*2!AS{&F;u0WjJyQ)R%CpVYEE%V#gAHu}~g=7fdI`itV}LX+zwZ z9hly1CayHfP}w^{m3Vk7kXnaJC_0azlWNJVB=W10LGLp z5_2^GUPUPwNG5y&pY>K27QPJ9>sQ6l7WR%bVgaqtJo)@8m$aiS{p zgRho$7E=_vXEb|=b1w}CNBE0}AG#6NPN@V$BPFuYp;P)j>mxrxK9lo*>kJS(b=$-; zd;BB4hv}0C95~YUy>Ayqg*eqxXn2HihHRAV`kM;k=?LkE zKcOE~E~Dy~8cHzl612O|`1tFv?Ymv>Q9Eg&Q7a3Vz_93gmta)km!5RjQ-PU^$tlFO zll(c5IYd^f5O;(e!;%9*y~c>$Vq1`zUnI$8kV&&Y8qX!HgalR6xZY4 zT}30L;#2Q4l8WB!1zqpr+BXbL%GYT7FqzK=EnNQp*gB`+On`RX#zvo3C+m#qStA0(~M_uTXxg5pH7L z=dHa*bV$DOF8Sda*F{%CI`rhDjOH{@c%1VKz_7pZ-pSxZ+l0~TlCO{Y$?1_ukgzSp z2b|HAjZBcLJF9(#JP!1H7*x8_L+?R!eq%Z&+|NWL-3jBov z@^eP)#NX`2-7?cQEr0|E_KEqM40X+pK9XIKJr+0J2|k{`+z- zpg%-G@vR2nrXS^8J%0jvHSnQ-mo{}eC7Cl{^S!|>PC!S*cd_R7nNvgG^&Q-JQT1Db z1bC&$gk{Xs6765lUYh{9UmMhUG;Pq1ql^QWp8(II3U|ps-&kmqq4beEC2^palM=^w4d!^ z9-;SuOHpiu(%-K&(%*J(z2~hUUFwMxy^DG{uy^imWeb2_o9aKR4!N4H?)_Rr(f*`L zz0Zp|+)SOeHc<93Giz&OXecP?sR7~}ry5zSVR{dqIgONB!1%G5*{<4Dlmc%7*&6#1 z;*;Ld>rSWKh^UUF(6xnqp)kU>TJC$`uQ3ZP3q0ETas}9$E5Flfvzn|%1E%Q89-^|9 zYA6WDqvYyzF>~6F)fV!7P#XJWtiJJlDkZl_D$pUCUoZ-k$wz8j4B^{^5p#HdUkgck zsdTH#iU=nv*sb)h2y@$TYIn;6+Ok`liTqm{Z*Q*$-1EFYI?2*ATX-1A#3^JWf#(!9 z^Xwrc7EG3a!>=Oy%|oJqER1VQ$8#hdeAJ()%aZAM=V!QhBmC7uO09W-`sg$gWxuY@w6bx~o$IZ|W zWf~Qt{t%X%6*d57DQB^3r+NP{i{{WhW?S|*dL2Mr?DpVf`{=HG^(@9g76EfyNxI7I zmc*Ok)#5a4RoGSTKu0GMtrF`@5F?Srv>^C+#2~v2_Z(omuY#gPNDpf*_+pn<&Pdlr zIS_VEkd^=PF{D}xLhdJEx%PSMoTz0kr~bl^r;x^ES_f7yY|YOyW8U62XVm8C+xtvh zQ~F^@NAm#-&5j4w&@~YGOQROtL|>`LzV};ro0eHHz_9OdtmY~=_s==Vno1mr$sm5p z_ZI#;VL|Vm_Jbh3<3$xHT#{?%DAbZ}nJHwLK_6wpF8uHXJTd?fTcL)7DZcA-B5<+Z zRK-+27z9Yx{nb)ea)_m8tv#ZaM@7Yaio1GGEP{hOJPrz1xrYR%G%spj4d_9ySJuQYEtPg$JJX62_dEVFb9VOz- z%ON1sARFSP*TwS!wr=6vfcuM~=ACrqz6Ks}^IMmEB?MpcE}NOgsLXJacbLQ&SWehZ zRE9a~u3?L|Gxy4@f1n6kdlY2w2&{KGs$!X0qrD2jCffkWO+u4!9(w*#zD2VzcBc@H z#jM8HSwiE+MJ>usU_^yADCvVl`zV=D)Go&^K#mw>fcmh>HhXY1Hh?b6yaxDid9~G9 z!7JfC8$lm&9xtjr7(qLj?a-cNrMkPE+K+^OD=lQv8E(~uZTp4LzR%h4B&LWvp@Up% z{b+7H%n1XisE?*v=EGn&tA|glRZHMC?DCud`CdwH$=YJY_Y-NuTgPaZ=Etc)<#*Ve zqB>-u*KHZWzH*WX@6+C^gz(v*=3`k}&<(6Y+J9W`rsa8Wy6=4YtR#wa{u+md)0u95 z0{?p5U*Ama?5tK$T-*^$DVAQ%&1&zh5-~)6>3RpWdbdt{+7^vhZT65KIR!My7!bIV zki=AMr2nwG;Uff)b%Sq!ZM)=jt*mLgK|J_xt%wFRD<3xSP5Vp)w@z`m`#M$V78 zUFNpwcV@55H}YI{$E{cp+2NR2*Fkp7jZ4>2v#-iF@BaKeB_{I6%}%$~vb{+mg*YjZ zr3V98zATTWJGXkJadsFk+uN< ze&Py8-}Q)9ylac>7l2ND>hp;>?bP1dsrpBxT0y=xxJFb^C=DIM3t7KVkpGCsbxt9z zKMspX7Q7fPCM5G?gM#vBDL8Bk0GYOY?Ye!=ORI-8Nm&Fx1xV z2>1Q-#>ud$=-x)J8$>p*t%eBObMfaEuHD&WN?(PBZFmnQ_zgY5^xn&f&q_qV=5ohP zc%-9MYw1kT4wY*`>-pH?mOgE(*lX>*@h6&X;44wTqmG@NyV0ut`n9RG)%upMZ{a)e z(v-`(?-oPv4#*fTTsxH>2pibdv$MPe4oQBfK!jYn?>q|C9j*6#H!po+mm}gHklIGm zd#9uaa#3L6xLxOxFq~otxDo_Bb9bUK0e!)hn2bze1Lz+xYGC2GdJ*N0IYdw`Svm0| zxWcFHabMAf{5-8`eFE@;An?WPKXdQ`&9a3Z;0K9`;_?~|GglZn^bR20XX-D!_uErE z6nM+W12Lk*k`aAy*5-Cm6K`(3q(vLsdn%MokkI>xB=}ux>m$0upn-sQ4~Q>Y_-CNz z35>YU(Nl4>x$-&3G?jum5AE0O`q%FxypQG;@#)y1Q6Hmo*Ky0?OXTg%Z)SX7RJ3D! zk72s|UGO&-jfy`?+KKwu5I(|2kz7v8yoQ~I>u-+*rFUpar&4jJOeduZkS%uM;iG*I zy>6Y2zb3z6bI1-ZFj z3K^>)X6B|a`^0$u3M&PlsmmwElNwP_yrv5S$ZmBJh_8m zd5q=&IRC7x6++R1hr@eBdU;FptL7R~L-=Nf%09ZNmL zE$I9C)W21c*?8@?i@a&qpkUMh5X7Tfi9bP281V$fLkNFvaRN?{S&^;7nNwMS3<<4*BnqEu)Z`rIDazzgwN!wT7F_CbQCoilIICmW;~sv| zzKecZ{z=FS%WL9jv$Hk5XskwT1L2;J+~}TNPugV7O~#$GEE{SVd#S2|Gor2Du%xBO z?|a`F|K@PGr0eBBJ?t}UDGtS|az*|nd%q6`Igr^~)q6ktrawK~0f>hyQdE)ZkY(AH zE45k7WV4rx70H6?|Ek#qxCyZ6E&oP*Ue28n(ifMID^g7fxQB7L>Heu(-Vi!d$t-1t zO`&a6&B2-!LH4_W>%ILkpQVv$vV4YoUql<$gdL5>A5spa0xQVFhf*sexl~FzYBU-o zIXo-pZv+`)29fE_5||&m#I?D)A8L|zk%P*%(PMf?IE@LYu9yuRKmua`(LSocg3Loi zus*<^DcPYbz2rDw#UVIKAS#7GiN$K*OBNZ4mNSWtV4s-inU7*9y*YWW$Ziiw_1ib> zcj!1pF$Zn!WT`QX#@_E#o#h#;CzEWmhMB08r1dTcdjs&q#79dv?Y~D6t!v6>v38I(3KIh};fWQi~0>mcLV<0mo@K>K@w z}FD>4io44(~*VoZ`zS3CRmd=;2x8BF&wi(TiCb*A1^NxM< zo}cd0bU3?5Yav$cQo0C8R>*!BzN#ccXLMAkd`tfY0odcNc zAr6JikC<_(rFqgR#Z|#fGOtHiEIN44}*XNPGwHXN|hQ-6RJ!IK!%`N&BOj?v&ZHW?r#(3c`J7e-gCGzoQJA3WrwR~ zQKy|kFH{SzV85LOT3Z=Bl)s2Qo}eYNovqwJH%_aO(F_Ek4-}?k&K^gW^R49V73f0` z4@;KC#Kz!tpMQPWR7>DgXNG`i=C}RRB3JBV0BkW$%)VddgNQ#ZjR%-)--OGbO(y8JNWA~`@R-VYKkIshx0v*U z94IxytE)(7Y(eoRTo3Q|x9{JmpInJr!Lq|`!OV(%HD+Z3*x|L{XGPc#ch#lU6Qpx; z0N}mB-{FsfCWkbPYK>^?)zc|kaI=D{fk!5_Cg*jYD_+rqxj?E5?Fq~xW~i)i{t*6{ zb|ZKc`TBaTxPeUOSW}HS?kg!?LYz+13)fM9m(mAaA6mbl8+=N<<^cY(u)g*bGX+}vlE%BV(J0Bidm&R^Ey3bM0z%amyYS46kZfLujGvrGye zc{(@Mwq^wqN}N3JxAv~%ss>mV{(~IJGenIX%o;)SJPX&Kco#OO5(lX7WQHko(Y{5$Kg&7Xl&I0~Uf}IKD$;KmMwSYD?oEWcr5~Qg^+TbXe z(Co`X?`YvF`2Q$33`UDUA#-gJ4U)HS=JiQ1aeXD^8Ni%bO*zQCOez-^O-h)C?1@GR z3#x|noE?HGYCC9--y=6G!^Ah=2Cx_6kjTxJ2C6tE1~7ZL1C9&a*GRBNgS$^8=1+BM zhGH(NM0DR(Hna~ub(i;dY#ba#bVY2X9+6PM+1?)bqn2ig_7BK>Z`EA0{h|VX5xz$4 z$^&RW9=PO)G*@Hk%>gzuAepFq;1{ujARIEK#;o}Py|?icm=g`NRx z=4k?{{P{v*&?h68^fO1iyY>1#;GRYOoxIzd;MMa=$x~nge59rkE8{P{|cKc2! zlYDM-Qpd(2eHRti@N4ajiZ4uF*#5erL1NVUwW_vcsgC}RFxP5I)9T@j0`<;SJnd~x zrw$H~Rj;r=4%BvNRTF@AG|PUADb2ncOgtO_ZHqvqhI68n{cyMo@BryR8R!6k-thpR z4Xb?dCs~4UU~wWe0MwOs*I;@L&~$vcZg`57c&~pgQiq8;h3=1xF;-MXE}kuREc&B% zL4b)Hk?Or|fBO>>A(uD^QgcqH;K!$K@14_kzd3ukO&{HH`=dlcA_r>~=Z7>xKtg=G zw*2`ftc(wJ^>^OdOvu@nOzGM<_e&4<| zR~Xl?{z7edO5 zZl7ey-wL%3TG=pt3Ox>mwSkzQ6qz4tsu>{6e$OuT*9rfn(!%O^=PDG_2-itbui^Lc z6Ty~rAOu+;fQ_L(ye(|!`Q}YLY<~uFNW@aIbI(*}hCgtYz?ubFdcFoI?5J${clCf~ zO^~aCul#2@3ltM7F`cRMPBsDadLNrey3Z;)S~cQP1KdA56b&YJ{y+DY2ds&pE7ALo zk)n)J83KL5%>@=MpCH02>lkmO3wd6ED=D^Xtvxug(skskFKQ1rcE=A3)yI@y`JIa2As z_mb)_UP}WVZ;(j+sq0*53eVXY;?Lxe72&VZHK{hv4z@>N%~(EqgdW*C@2dhnD8#+< za-E?BsPIc-_Ei*SGSZMHRX&qq{%M61gy;uHAd&H!lnw@6;FX-B%xxXo>^UKt{9($2 zUqXhQpCvWQq#9q5kDYC@gOsheI=k(eU&0`(N^Z-*DoRsk6-SNE^oy8X7N^0R@{>On zEu`GZ!vdRQO(kK1oFrSJ4g$z+c6QLw*STW^5J-CjQ6SHAgH|B#9BGS^hoFX0ki9UK z;tvsz_L&4@5TgV}Mv9U{5G1n1lcx>yku)%Xh_5jk@I(O{2EeBYgPfb@Z2 z7#bUU^WAT&M(u)B8N=`-y4r95y7WWy5u&#?36S8!)u{nZlJ0+#J_(wz*g~ZZB*y>( ze2ni-lYw36{s9bmhHvlYDVLa)KEnFxg*s)5*(NX4Na0=og3n`@E-vMbo^iq$BtXy0`cb!ny@spW_lPdd) zF2OXo#0bQfKg7~#e)Uo$YCD7+hiL@#yXa-U)%t6XGFwsJqVXHw*V+N zMp>9FLP5V1=KV{n8i2WcAao6LDHwU+qW&K-xy8t;fR5U<@X#QX6gT)q|HHyHpNpg~ z8O({a_^S^@kg?4%A$luTG&3UrtV{>u#lRBq%KsRnHvuEUrTr?dBReMPkvCA}gM-|C zI}!M&v-OlPQB|YdIJwY#FYG){89y< zF<8#LidKx7wuX-0KjhE?VRyQGN)kx zD=~d`kzk6>6Q=qvaq}Egih92zO0peB1Fo&EMM;_1;kMa)T5L6XD}}WihK* zkEKU4N?UEX&Emjmgb=+InzERERFs8ryo0U#RzL0Vte~nl{A$twl@M4;A{!e{{rp^H zx|NBq;?h1hPai|ZJ;l|flw#TS5sF$R8@>=zOW!;zKb!oJY==9^hSOxzXnH;FA*wr=T^98Ean#KYq< z@vA&wdFC&$2ZNrGah3Sj7eDE6$8aecCL31!-(QxOKg2dRC0(A17B0Dw2Zi5=J^8#9 z2?d@Hgr~fUuYCUgK#nYE*i}_3ZkUB8elhWNPHJrK&s?8s+5vSmYc58B@EwLxC}*>6 z$BrEpx{cl;Y?jQ0@-_M?{8o-o9wm~rEdoUZn6!rsTP-3vmUhP^(lTR;Ql0)=aMc1e zTSr!;r`n1q-t*<8oN+lu)!l1Ig~hfUMbZs@_2R7Au;uVYbV|>)PhIls@b+(ne*{>4 z`z=o`h*uJeA9}hhjH+NJ;xPMSxb|tRz6cICWN7mHh??Z=@{8-F)?>s|Yi7g5(xeDm^iG6s%feN28t{j~>|M&LqxjK|d|EAk{MOxsNhfvkgqt-<}P z)z23Y2EtHP1@4ugUFEaZk~9cwF%ds6Ko=dcgSyrQ6cajo7a#|^EUzWS)gYOjaPkk5 zRQM<&WVGPQY^n!SxBRvlpNNp=sWp?9&!0$?{`Crx3c|tPIC>b8_W;`~UT}q=Bc*w^ zJ>*bldK=fvamghmkpLzf*BWaP5*JLVbg27y%-=y3Oa@LN$?O}+7qx3(Bq|R8<7@} zrQyO}Zd@hSw&S+=(jMPs{d45Nd1o{%*oyz;($&!x>j*g*6Ce~PUhriLxYsgLh;Qrz zfospk_hQpU8qnYF@y0$2)qnD9#TS4)9w;LzD58C>^sV)!Gw;DxNgtyCg?dGgp9*P$ zR;v*7LNBuc*@)IbUH3-X(XcujtJq2ArRiUl8VoS4oK* z^Z$fEP^Nr>>^>r>y}OUY{djTKy_V+YHtFt844k?=we`_>^Y(Z_>N2-Iv8hd6PJX~Z zjEHV?-=QdtdZ%<~R^mpJ@FXWc5I<`@61>oKl>F!{bA&e!C;J`+oZ@xS5w0Xmj zpqWx;@5xLxT?e|Isj2>c+|Y`_;rM zTvbj}bNmdpcU12m;ujI{6W7y3!UX8RAQ%&>vnvVP{$$(aeT8ic%0Y^YYmlf~waVCH zUJm#sXvWAJz+o^1^y7fh2foopx33S_!Ue%&gHsvZYwu0#ybfn)bL|xSA}**3Cny7f zIcEW1H8o#fBQ+?uVzTaYU*pVSQ81LGF2A}Ez^Ut+n8>{6!xE04e4?8g!S=TMj~(Cg z@>(<*q}J0GC0+eZCrUWu40xH-OV3g;8RH*hf$K*_slJc^%!e_H?*{d7Abc4;8pRZU z&r>HCw;Dv=T(d+_&O`&d?oo}_rXQJ3>URpnrDl0+Y}>}>4X4#Wk_4w7iB-9XueKPX z?&zIAH$tr2LpGmN=^a0aA;m>(5xugAL6d=YUoj4mfF-&_Jf8H^It}UNP5bt-fJLjj zA}Mtxd{sN(H!k<&*EbcH0uRVoOsY>*D95|hTX89^kNc@|cLvr|j8_Fr0@}NWFQ|UU zJO+^Q=UefSZ2pQKFbn6mG@_ut5w1J0`de+Q3h86V`4cS%^a%{*dVOOo>Ae{GbFVrc zKN7|Dt*YeUUnsL0FahE^iXK*Dz!mBZD`>kQMx`LYt1qmA59&v5@QO+shQrsBY?};+ z4DUN5KN8>vGK7f)?(y-}wQ+AI=VfU%}z zd&Z<(!FFS)uWLPxOtaYBJ8Ena^XRP58GRb_wnQ8Y+k!El_E}SdBmF6AJtNvJDM-MY zICdPck0u;=5`#3%I}Xo81(ABiC-kAcm~|{QQ6ejRS&EE*k2Z7W?a?uALh|LtfAkK z{#cw3MoqKZ2ytf3&_zlb@Gn^WzEJyhgFh^*)6PimSOo}hXhwLn}bHs_SmB@wYh&c>J$ zCvLsFe+D6Bp!gAG+;~64wvhe|g?46LpGCQMZIf@^A&Su!&Pun5^-AL3sKb5|;{q`N z8++Ns(zjc{asEEvtg)d@a3i%WaczYjTl`XmDWzdNmQ%7Heo@Hom{*v9t&P#s01%S5JUW>-&MJ7Ki=tl7Yq)!MFv=t43Y9H#_B$_ zeLxR!Y^P`A3+mQBxmu@c)tMP%w<}T69yBZ?iL-W>j`22FQ5J}KWzXuv+#86My&v+c zAI)($L%tv5=rc&|S4hQ(3H`S2mQ_m^BrI+^ZfA84=F(k9gN?`w{tsquaNTdf6$l_m zk*ojoi4aa;I_;;lkAqp{_$savBn`F^yLtv5ysY&u;-{S|OKXDV-Tj1t9)c1p;|_7g zB1V@+p1gaDt0q3!VA*i%R95fiwQHU|bdAJ_>D-wiqXJ#5iQOr|8&Ek|`qm7Shr!bj zn+PK*txlSu#sr)2qaPSLV;Bd(GSQ5dE3&}(oY!y!+&&Tnf}>y<1-OoW>GQ8Ekoyp? z<<~j@sZq9XcICF~iXV9oO9V9tuDLecuX1X}^I?*~;C1yy;VXmT7c#)lEvF;aT0Dd9 z_7wA)pYu|-NwXmZe)b?t;AF_bCLtzjS(B_xOzyG@!?b3Nj~2Zy>d^sKA|?=wexO4a zm;9Iv8U;MjT&U}mvZuE;56w{902BN`}&7E48pAClKxd(Pwh<@|g zy1V+k7~6gG*ZcdheusnCC&AT+9V-65%vLZX5V>MmBttUp5ZOFznyjM-&{qNCg+60@`Wz^d&b2M-Vc;Zies5dWT)YIJ>AWfR6E*g6gGlP2 z@ENWdTzSyfz7;}lXqQuExPutK+*Ud6^eLN&(|oH@&wc%pSf0UYXFX_CB6JOyRt3_i zJ2@$eefw9J^%^eXc~Rax#f1{^6rewZDa6(hLT;hINKkA3@n!u14$MGd`(Y4x<@EF( z&VIDruoc5k5yb=OZujLTPHa_u7y7Levxciit|XK$1*1x0xQ$X&aW0cqf4fG-+;K0ln0N1rYaA)lioRAK1{#azA7wc2}xc$Odx22wND?$*@XN z$x)`LmlFOi#b}()px;zbhRNh)@2F~&-C{p|gF>{OSNv}+>3>H56J=*+WB$KEPj+Ik zmb4EJFsWA7pJ2gY|I*0+$$xH>f)%7u$^M%jApgEK;wdtmduACj!!b0>lfw?suiK-&8l?I3ha)KL0HmiIJ2 z<+0CnI}yIET_3;+U-Lo#iiodly|;%9e>kKCYBw0+3F;3(?K3Q29Ev`M);`8PPxA11 zW)F2xAPSYsAq!^khd_sW?=;6%OI8d8rRSPcDBtq@{HB82nG64cIITG+-UFMb_BETb zMz<;pomuasQE9fr-2-IOJonexY9m8hYa>T#GqkT z;VyDZCc!m=;IU}hf*{XH#qF-aKDc3Cg101%?(8UdOGKNBR-E_pE#cD{YiyUxqm;Uc ztWScM&MORdpso~8LY#o0#dX|HL@Yu>tfg)~Z&>-ac&I^zf#xCcv2(zB_3F7w8!%^Dl%Y%+4wYJg z2@~QssATH3`3MQ2M!@dTItd|+_<%7CngF2+;H&3xJ{!un+#gY^+NVcDCysvl@A1*` zPta51iHUA@K=s9X;I*zuDsbiKRM6!VWRysgp@$rG25? zIopraL==Oe>w5}OA1PY8D5deJojXY!m_NSMg409(<5t1!zqFc@gM9qZ9IS24U#q2^ z+MNM)#p)Wo2$%<}hA;c?EW5G?70?~PqH6tk#(Yz$`WOYU0GGQmqo`tJSp>t>3p3Ow%ijSq#e5QuldS5VEND3~(}o&h>;lK(M0sml zowd`$uoEoi3@A`CP1wG3Y+G-#BI79c>x6FP#_;aKEC({zM48WxNkEMjb`&8Rgm(+l zttTN&`oMr?Dn2yXH)PGte367`Xza`1a#+>*K+2a|MKddq`ag+9Qu9dA@;?YlRO$g* zZ&{tQg+^1$?X>WnH03^b1pVzinu!!QIdl5m*o)z4?xai>ZN`Nas}WW?vRuSx${zD0 z$n`xuN@(t0*z3g{RdGIei5p}$&@MLH8ALkWpXy}l!>W5%pp9%TJlgs5EeDK5X+(XT z!75D{Zn07}O(I$v_J5wr6Sb+c$=g(nEY|Q~6`z_Lc1aZ8G{ zF7;ERhCRhgD(0%JZTNW3?78*Y=jTW+EtxJD;dJ>d{y*mtD_iTogNGP2jo$!F8oIY zO=SG;x#qo(po;iG4nT`I89CAa32f}Od^sfX3;EHjf-ophoy(9KSc~mLPE?)Wdpn#c zp56fR%uqZ?qFh?Q#X`GYwOncwJ+>%qoBVTk_Z&Q>00`V2v*&3x$V!f{h*n^-S?GW$ ziZ`QjwwlZ!0;5E;k??EZb+Wh4mq)xg9TQFgXr{;Q&> z0=j@^gY#Ee$AKY_JPFl zcAwsfpsdu-8Ssv*X#CN(g-Lv@?3d$v!wN;p$piMBNf)1q8$CYCa9mE8tWx3*C9}?Wn*bgh9i0c3s8}%9c8LMaJGKIbj+DQ(Y9E zQ)>HSy*;#QB>@NEWIGNSQ&_ff8620fWhYtsvztla@Dl9$*J$x8mG{FJ$-PzCq1)mgC9^YSU2=9K8P>|BZg2r*b3Ae7(xGJ97Pbqxaa< z9I1Sav868oEjD_}ssx9{rCr;kV76cIXHHP8!8eeK5^Cd)=*zJR?{_bJyx_sM2xgSP z?lTOgH3I7{10+d%1SlZ{Dd;q zsAl{;3u`i)hUQ8oO?$^tPlDqvLYo@<(NS`w*~;(;Q2>+)0&M6(vM9|8Qm4Rlr%~&w zy=$LKYa0*Got||_rph9`=2D^9PeAy@r*tyy5!Ml4+0S-^^uz@^iPE4Ooj4Cj{zAY0 z6EHxdxALw%ER?Y{ib*D{Cm|Wo_&TtrD6#+D6hKEY4l9d9eGnH8o+0QHx7R5M<9jzF zO>%U=%KP)sUX?CL;J}sx&ZWp){z#PxYB(KF|M`jyS-2^SHx%uu|$HDC{VDb!sThd)OGt%PB1OV7Kapr_*uiVcR1 zVpjY$D}suWKA29C6wX6uhu*;oM!+}kT@K3f($ZFfW*zUF-Q(AnkT>Pm?35ro{M#a| zTn}qy0(P&-y!kX$&-Hmeeh*i-#$P;&>$C?sAeFqq(NTyxbe_2jBBYVMJ)1$IAJV z!CQpPODMeO+V501lE~VxZ9){pn=_$#UQQ!F_euzvzwwXiSHwBLz|vfdIRTq6)fDIl zSkA>+F5_?j&8zRiZgcF#c=g*omA(uqA=u8$YJDu-+(F!E(TAyLH5h!h0 zt6tal=5f=xoSK+g*?$c)aGN&BN9LX9=H)%k&E`|M`u_6U{(kS-ezr7bwKSr`vUQWN zI66|Nr4$4($ncHJOynha#Oh0|_hz%#8SlKK9+O?*&i>}m6|ew)^)@nQZ)RtGvsmUCHO~}NuuCudaObxQ{dopgyNSh>oQiTHQ>(2q6=~I8ecDXStlDUrrul=o!s6oc-u^;7>_<2u5#O-{bmxX zyhPpxHg^X_-( zw}H=gYnJrOI*V*0nbMFPL2u;2-9Hxi#J>R;J5~_0rhN^siKx)lmkY&QUmxc9&BS4O z`sn1d2~o!c+a(!kGVH*0*EVmiAH~E=P9YZHFhy=t;ZJC#bgCB;NB=+`y8lUJBg1y5 z#w2Mo$;-g_ZC?33pn0E@!cTxL8irV$lfQ4L{RsZ33z5E!97br=P&B$S(D=r8a z(3_s0X6&iI6_62~CIO=-Ibqryp{5Jp_ACN7-gHc~6vVcV2J@?+b@Yz7@VvrGZ2iqC zNOY47F|+!s$;D=O5dOM8>=Yw5)^X_vNR5hU%#`(Ad=5&Z$sG zia=AOLLTn!Pv-vBMKlNJ(~#*E%1)4d7XdHCgB^F;f#U>vGFVUhSIsyShqr$K>G}E? z^tL&rGa3#)^x<4(R1__S*yC$rDNEmJ`vadBbGOsz;e;+F)Y{vd6uqL5psY2(RV2qc z4YGFGe*!F%conhRtyJ`+C{|#})Shs@X#J?cQ#w=Zo_k%MD0pfRg_cch$T1Fq0Qy5` z0JqzilfGE4Sf$POyhd8;`H${Qieex__t*W`bK>~XiSRwaWNy(Ur+!YX(SwWb;C`%Y zwm*`Uns&j4mOdm&*OK9Y|LhuIS$8R=v4mJtOY|fZ+4cGxZ{{PDiO=<5gTLuz$+|ST zNx8`^Imd&8IgPYwN(T^=re-#hl#^tZK(iXjh^HGT4$6b8dc%^oP9Te{1vZZ z1a9XUk!exb5ALs^?m~3H419I9{ANMV4rbl1Dp+&+8C9W!=45H%DI`h2e69gYB$Id1 zb$Su=W>SW9~3vIB@utwr0n$-_3!)=zN#DJZT$O->QU*Y?<1{m=Du$E)CL;Y5Mk+5hExj?hMot4+t+h|??3{|ZA>oe`5#9F z{!jm$9df5BPvs;%J@P*_?zkT|h2mHkz@J@Kc=Tn*2U1>=3~pPI+vFPsj=7!D?>Waq zUmk_*P;HbD<|gtb1`1d+9=-w?du(pCPZ&C!kpj3sRfgbu{2th^SMq8K2_^=R3#YlJ z!fU@Pht!>OiqgWxGejv-OVzqCdKjDYvh%&)er?asyaj zLdGOQv?h#pSUg;V4L2DA`F1qvP!Gc!Jo$#ypEccLBsPBmB*7ccFV7t5j1)*hNUv*8 z`1)V~NS|b%s$R1V@LAWv(>z-Qr2OLDfvkWSgh={30%*|MVxE4~tYJXn1M;fRmZ>il z{~`e-9#^TBPDxcwX*j)$ziD!ib_LanZ=D9rOHT(pxMk;T*OIE)$DPynPBCql6;nDQ z7OCoX?P3C8hqByi4%sBH057k8)^P?hwzBB4F>5E7!>Zy3uDMBh=A3tNr>B#dBshSQ zQMZs}aQXR#2E;I4{P$o|zSjjuZOnzIOLsT)4QcmUP8eow%G{}$JwZ%&?`j#(vo13Ta4k^zMY-iz0lI7`~@_NqN_UTsraHfB~O1p`o&_pjW(Pc z{KwHR)q+;9s|5LBf-h-024dOrB4eL?Tek2@hnDqQlj=ReL- zjp9B42XTP~AZVvaK5XC&%8jS5aOmr;Oqc{o`Q)a1!$Wl#vY>clVRUZW8D1_7oERS` zc4y}}H-LI+>j(6??(y53Kra#ZfE~$vtF~fBvqT}EqK+=4dcKWXsErP$G3ZY10b?5O zB~+8 zA;>Ira{8wWhU@VyNH6r#BGU$em+9DLFiU4CWt_D8~yqB(`DJ zO>H~^XurOinx#KAKI5NvKnO^&nE(DzbQ$U&Klh8n@_C@zVQE8@Xw%l{=j!%*o9l^ZYe^@xD`aoGEm8skt3Ni zVW~|2FseK6_RA`pm2fFU)CdDCLO-!t2+)Q{Box!sX+5y7pBk3vObqcb?L(E#UN-V% z=?!`|6&B&pL-`O>!%^e}sA!ju@<-dsQoHgL6a0hyZy?u9l_TS%C2ruz1}-3CBKhuI>S<`Nb{KPf2<^DE@S+7;W?1i3?t+D9H|< ztT$4zcj@ntYb)^<;lu%molGx);mGWn6$!ylCx7IcZbEM$k>k~sgFWx>tAz;8zP}5$ zjSv$WH`sPqbt@B|$t?f~HC2Nx)F=cO=~zOPqw^&T6dwm^X3dB)A8u1GgP7@e?>It} zZY50xIBUI@EwcGLU^<7Vqd8`~-OGL<5EAxjS>_%unh!W}Qf= zgy8()lVh%e%3WmW?Mt7c?>(j+$F>%W!!zeUSV?Ovu{?%vV4Oj%5m~x0Z9=%6f(IQ7 zx86hLnX)=){KkN#O$d{?S_N!w(6n_}zm3|*Kh&%z=MfQ{r%=txmJsT=<$Myo%)pO$ z+=cZ%q_*wz$M;8tl&I`*;`1s&U8F^)4}~~%Fq9eY#iU!wNtCekTur7tl=B|I^s{$JkXBaXdY?ySSxLMX;o) z-7Q<8CA&T6{=TIWTLMIk6#@}y1GvB1uHAOa?y?0D9}p!#!a@ylV@L#l1W7drk$^u! zA;LdZl#rO1G*~S^Oq4_rqo^U^XYPA%_nkR4_Vtf_Z+6bioS8Xu=A5^^-=Fqu8ov46 zJMNx+@YUxJ9$CNs;KB9lj~pC+{K+R*#EaJ*Ir{eNkJ>keUm2ere&b(XIc4O5Qy$y8 z=%L?T-gVbQ@4wNA?*7LY%&)GvZu8I2du@2{yC1l@@slM_f9z8~Jn6@m4*ch~S0{$H zJofj;XSTjS`pUKIPQQGv{LG)P{Mt72>)DmZ-s-w|?%S{b{u|FdY+wHBt;e2xFWhl(qinA3F z`x1_s-D5R}JQ2Bf!{@Ks)++#80->1j*!%>LTAr!j$-isjfAL2Ew54Uj)5tscubY`? zze>q>AT%V5@Z?X=&hsmF%d^7cJO@atC4S$~&auH1_N=;P!bH`3J4~11Dezr8aYt@6^!f_>h2~)kCTSJI!e;QCpxENQq9hIUInu?KEqb z)@Bs)xfzD4cbDlVB-ll{E;C??W?+}@-8VHkas#{&9^Yk7OI$vf0!!HvUH|&V z`q#&ahdd-bPIzMXWs~NNUf|L+Bal9zPJqx@=78O~adVmh34zpDTkRe<%T_jlG+SN} z=FB=C0bT%~QMoa5dS6uMWx&ScXL)$LOUfo&b#&Zxfw9nGVy&6@=XuJ%_H=5`fFZu! z@!(}yFV9YyQ@djMTuP4GuB7??&E2N2=|?bHwhQFiK9h7YKY=^08MEg5W7n~|woRH- zBLdI@0_~Vj0tQ5$MJZA`g9U842%R@!CDCf3hjt83fra2`_tI{&YM@4#?D$<01A3P+ zM$HZTK?f3RtJM=`iE*{LeQPI%#-=9aclFIxOHgZFWgs|VAs1YzTCrOEQ@58Rf4U9I=5 z>%OWSGt0zO31JhGt|Lq-xGvT*r)Hu8nZ>M+!xw|9m4a;MnJN+!sU%4^=+nHnvV{9i zZf3E_p|WC6e|62Y=>jHudjygogt!+-K>47j1_pvnGjIxO2UowDG~F8lt|Vn~Wijv+ zo;gjCwZga?FdpRBb=`LJ2><#6i^f{~DIb*P1OP9@;rw6FOA46CA*sJk6*D^}I9CB_;GtB)N`g z0inr;!9Rbs*7IYmc($uv=XrI{9&^??OY-1X7iGuglr&z zrofVrJKpTXk43$Y^Z}C~A8Igz4h1Ro7l+%{v|tlE0yfF5$Yx+x*0TpPNa7W+0qa8L z&jgdvvqL-ujA@-`bJMf|WxdN(ho)&S%4*Rh9l&3w&2m$^`)AB5lNZ(M8PnJNczSi^ zj9Jrue{aY8!!u^(qT;F7XUv{O{iCB}<*-e500=r74>&hg4p?3TLwP)sjO}pwaN(-i zS@Z0Pacp*Y`{iWMA61H+L*-EBm2#{A@$Y$=B^Wydf*0g@yAcZ(z7>I8)nT} zCnWW$3vV=A&C=3lv^cC-?EKbE=A$0r*_+H4@$|W0HfQpuH{c$U2=eOP+uI{Q9hog@ zC9ip!b;R7K*)oj;%G%>2;DRgZ(a-@>il*f}x4)r@1w~ZRGX9H`rU6%^jkdsOQ=sIv zV02_73b~^3_eyPAqcvmc2gAX!pm_R&*|z2f&yQt^Yd(sB_KanXXrmk0M=e%LVk>Z1 zzGAwQz=d%X8W;l)7K}|oW8zH0dH-#uzi}L8rGSt627r7R%m~E9Kv@#oz#B;-+oF;O zf=*2XXSJPpHet667;{0jSA&aCacV=wv>`#bSQK8U$w6mRwsx(AzBN#sreQK>kpLP7gGpdX_&Kdmy(;ML6XyN1yPOjx;gP|qSy!NCuthm znF@Hlyc!G9$})j$mRFlbNnmSMG#VDYS{ahd*4#OkzXHqz(zla_yc8tqPFh_ua=|Y3 z7%k0GkUDgK${3VzLiEQ%D+M{YQ=a446xKkTRf21)7-P;ing+mAK%;LDXo4lG$Clcw z&K81@+T=^;7fazdxvIgWU7(~$(xm#!?dGh8Er7xfh7|44wxj4QxFtd9D_vL=$|$TX zB|wE*M@hE?0_kgan*Md6x5_e*!oEc7c^7ATJw@=Z^+x1azd-;c(mJR(QeYqDH9uD- z8)PDP2<=k6knYaWG3&wLR)w@QC_3Cp1T_L$sbWRC;|os*9T};u(-_2D8*Dnx<#F|i zyD1St4p0VZztzMeddYysK`@}nNkWh1-Xx^Sd4<;ZYcYHpO-UJj_jm4Ty znrw|pS|4l_Bdey9QTW(#LT|-EEr>WVdP*1@<&g`=CTSzII???X?$6bl!B#G5lv_y& zu8x$^^oMeD=1(py+skcX@kikMX=8|bkh3(Ves{s_(v)(dl>nX^c(9~x_xKu;$87x` zv8II^WyYPD&nGk1TMls&XlsAQQpA+E&|4(-QlF9AA#zF45U5)x3$%E!8AoxMq}3(& znl%lCbNW_tO138DC6S{m0G)akbiH)+Vf|+t3LHmsn)PnA<+UEWxw7+&7Fv<34w#t~dV3Lp zL5nVDtWaPY)IoZsu+gHGZ?A|(s{=-{?v^+LHV?L*7t%azsk!9PC5YLT;nL=d5mg(h zUmT?rQJSydfXvmis_29+XN~!8wIz#5*FKC6ig(76i1nojrvL$p?VK@6IKKEalu&^c z4T0JVHsi7;NMHb{=T}|((u5+VH(5ss(77Nq?N*FQ%Xxv#Dk_R~F{3vllYFCHgKZ&P z#|4d#&xn#-7atKA6t3Kr;gT(qDn1QY+bljnFn)5x#DTqHs_Gz|gSiS?(M85q9W>Q*# zyY&;Z42qQF;w}mKVqHHlCapI%@&CO03+@|~)fO!DuyS$TuT}(#Q^6kh43uwI)I>yH zC#{aZE%~-Y)pP`Ax)p_1==Cl%-K;UYLVHkj1mP^>My4~JyIJn-)l8rTap$HhNX#+?HlSTm_Yb3ZX;7gQXm2j`lA3FT)>vA|$1&l*BK&DE6#Nl1#lauZ; zpmA}l78Pecs-KpZ#I3^l>5eFH-K4!1>9!50MPYehv!&Iq4&7%~@twfS_nFn#Zoc4x z#BPZ;Z=qr(7twwcTQ=L6jM!2-cae4HZ~DI+SNHH=5T<8_reDYEUwr$(C)v?pDzJ70=bM9Al?!UcP)v8@{uQAsc zQv-`I8x=5Q@X7(1YmPBmaNk-6QfDko# z2Q+55?wi_l6A5EE+ffDIqe7I5cqAsyA>igFG&h}&--kDcaxJ{T7;{priV+VVAD2_x zNWfv5xu4Iron9Xj2aaC7cdN(tL6g^Y-`RFyr7kgjz^q6zILA@)yyvpE@e4#fA!g~V zSswe#T+C$DW&7`3#8jBm`z9gefT&Zy&8FDy!9O4|Jvahx>A{V3@G zW?#!dYMnOwQPnB*L?kGyHYX@*=M@2W9dHzYRrFC<>9NlOaPMfE!F5Hk5?Qq>Kkf{U=Q?s(0k?OskiI=1WOM)bC%r z9;Z^-OAM?9)FHlFrw)I*H_NY6=Eu$k!2_B~>n>@pxwrKO*K=_#uoxcW&|HN!q+?!T^LXJ15vjy}PZKu7C7vg>zq?}5$$ z@=?RBwYPjIIc@SC1E#HU2;&su9q?mtyvyrqR&f&tbs|mK9R!Dnot+KF%--}LG_n6T ztl0ktR!P$!$l`hN`cvp*;6O%C5Q={{xVSo-8QJ}3EBC(;$;$liB@UMV0x1XUUyzam zvb0pUB#;7jpEXXElW3@22;;a6FVlw+s1VE52z0rm6If!IXYL*r`3v7S#G`*1D=X6( zv#ri>ZZB?IZ&R>YKo95M-z-lbZ^DWv?cQ+Q*0*mn0XV6@b+^f8VXFF37+g%?Wg~Yv z@~LIv6q^#;8>F2YU%5YH=X7c5<=-d)V(s;_k2H3GAdG9NN9%9Cf zi5I$qO;H|9%V}Z*Wpd~Bv{k=C&ar)Mtg@l2vBtAi+g(6tS4jr;nvb02%$HnRYU-0P{eZ?7j;Yo~rE(h!PVvtNfE_ ziqiy6(~`3Dc{VQOfR~~9^Aes-#(;kMByKHO;G>%pdgo+SE&t7cIz37*`gW7ih`1!>2~xa1*N=TkBF;`-aLL z3mi9^0-~E~oGmxdH6OiY09nDposVD*2jHJ&Jiy_Czs{%S@0o(wQ#zwh3>2 zqf@@}^vSP<#}3w7_)T+=Eu~AD9qTfgWykBeoq2G$3FWw~hN|YHY8g81r8|bL4$DV1 z%nzqLuhgu+9rtWO0J*QmFYyT_HbV?BLwmGx!cFr;-WNsn{NCy(E?w^p2Y57uL6doN zW@`@Mh?!~Ws>uvEMSAAOhX>6t{LHp`(V?DmCH?(F(M<$gomQ^>zTHc++(kq=1XXyJ^RCKa(>&5F&R0~CG}SBol@$dq5>cW_3wIkXHF zOf6LhD`s~`pfMP(*x+yLWqk-&gv;z6sW<`~k4X^-AmucKIEqnaZ;4GfL{vd~uZvjR zK2y}X2FUrD0H534{_?^-+k1QOh8BaB(d=rMy`tlsBM+ers=OK8_6x!os6zJ*-k;$s zF)fRw#J-%R@5i%Ah1||K=isIJG1Fcj(nRL!vkZq7nqdbO9^AwXFkPHrTYg~>=9Pbb zI_@%GY?52yhw)OAYfvkT!>UL6gqOFMrr%rc|B54n1#qKtDH5R2ewC?w`DqZ36Gqkx z0=_|`r`}=Tlev8g1QaFYOc&D?IAYc^D3dSZqe6bYOjWTsO!f{0%<|D4 zV(_Af%!K*pu$-!wTiDCbwApr_ECet(T#=4DfkOSoO=&8u(qPv$xJ zM5-E07fbs#o*n;+;_A=WPc{^q*=%n<)6wdt_Yx2LabD9U!;c~0je{gU0v3a^7hdnZSyVV@E0RZE?O4h-ihF> zE_UI6(FzCazc_@Mot@?1#KO$<@74d6Kg>*Q|3fXQvWmFONC7@iwYN@sP1LQjzauRU6D&=@N=TyeimKO!QtXW3j{Px+CC$P8NVJ|FYdBw=XB?rPZiB=>rT*n z+sxPMxEGfvFt^8}5n-q2xInbbrYE^CblE+SRa7!ZPy4X+%`e-qq0ch$iR~UDGDXfc zrFsDc*M)EGzNUu*CAKqqbp#^t)c9o4nM7o86>x20*a$itmXsgI=d0Mbcuvz0gk{** zv2`}BFSs1`uT6qp?@IUDI*xqWa{R94xcj(ybT`n-V`VHyy1QeX29CBAwk{GA9%>AC zJrutsqz*}`QaUnjlq7qTMOgbiS}f-?Qw;&!9UhbmC<**p+Bv_eBG+A!nF-TSsjgPU z;>M}b-zjaEuEde2GS|d!KT&fIOXP=)^fIu8cQHYpg!et#rzbWAx~v905ebIg^~FRZ zj(^l5OHf>M_mcRLEcnNIk>X9#kEXg;*deoLMi=&Sln0dD#+7}nGHsJG(ZifO^koB< zSeiPJC1vA?N{hv^8lU3}{fl43A}_)~&)8OeSm9wf@Zlz_R#k~=f6IcsG=o}J-UlVa zTGs?uMgtP>V={N6SbwrYclH0&J9K?)!zp@z01=>~LS%M*!Z^eu+1p$kPW}XT;TgdG zFQohhz+b39{Uc-8xVT`_>RW-)VE(0znVJ6q2N@vd$EN)f6O!Mo#?idQ+6%#Zf-G{L zOgM)FJ)&7_r(XHyWJ|z{kNHR%nVQ-%jh4kFb}p+6U(Zd-QulzttHD(#C#C-5W*CD0 zwqL1L3nQS?@7sO|y@OLG)KEmwzT>juz5h=?<=MN_?yvf1-N{o?wo4cZ39E~BaE%3C z!a{(#$2u0DPp~qK(cC4AV%89XF4m2iW5U_-gWreBle=?x&`7slVm)D8=iM^)J6s?{ zF@I-ZpbCSqB{1npN=UfbeJU(DWa%T)8V@5FlAzU5vkC2=`f(h+?Oz_YoZ=P0BH?bO zd$1g^8Hv*51IN{_=$m69A!1PQ34A_4-oyZD@XhLWBDuDDP^^JE{?>SyKt8ZQCV{bJ zy3GRQPe8wlb^@rdzEwT23|hrBArpu%u+$aEYvL#8n^%Uh)7l=V3N+e9CV>%2x@&)+ zyHIFCoyq`kQU7r>uYNB<2{af1#G1*N&({70vH?_(92yq4r)CjUrq{CgH6@Y68z|;YMEs-mb0<7VyMlM=f}Q zO|;Tz=d3#15qA>%~8B_vs1Y6{c!(*%vipyQY&h2B8Unv(G@9w; z>jGmR-rv0~MarBBgK;z+%+Ua;+<U!3^s${V142mR z)hD#}KKXs`+{2I#PdD&pz7`p(1z+3UaboP-W=VJhe$f>ClzIo?4Oo5`QtlnjfKC zWZRd(5${^OftAO3(nqUNJz9_n&XmtemiGG>A`vT_)o3!2Vr;DY=r)x|H2edT#fSCEpPGmZwwHOT7{MH zsJwORsJSLIfmOe2na{j9e_0<8oS+$`t=289ID9-91-$hqva4H7USK*7>rklqHQ3^k zr!-gf+zVR&=nbSTZ8myT1!Q%;dAA?PuxoE*mRfxIeB8{n+D5a(y{FdHFW(go-x&a^ z2t{S*wLL$;#9)T2%T_1RgGMqN-82`ABt&n@cBPVoD^O<8E;3E$Z>p!*|+LC1oULy&QN}zy^W(d zRkzvQS%s|jv@ejIU~iQo%n2TKP+{gSVBplhu_6onLHhQ+$+gvr{{yQ%z&+XaSa!B* z<4cfVn+5_mo&KHSnujoU3Dp-^-sevw%;SAvoHUN24#+O$O_M%wxrwf5_QkSPLU%#5eI32e=>a$z3C|pCXY?93GxpC?FgU z&|dS`!3c}q&vunqt zhHJuC0Z>SehInI01t$@AWJ^6^tE!U^|{yXJVOE$s;o$fxubD1O#4359TxyyCUnj1|mQpR}lF?<1pfTTRV14kr2PU@dewpC2-&S;%0aZe%{BP#lG$OK&5VwcJ!`wQmEG39s(A zL|Mb$C!~D0)3yZjs#h+7n!WF{Gaap5fXV>{1%{2EpR{9Rn-8Tg)QLzIm2%zZA)yf! zGRqFeU>15-A|pVTcd4vN2i-_{Z#$b^1yC1;An%$XP2KBY!BWp{$X5tE30;}4r)Ou^ z7OjYPHZ-mq`Jl|}Z+2%y@++4?!&KAb(cy+egDdY1G+H?717g5s012lwV z8ipdk&C9R{ z&|%!;H8)6DdV>tXrc-5P(rfJXh1%!?LY_Dmpj1dXN?wB+G<^zj$sE!X)S#e>@iS4o zh^mAe!lc3F644+uJGxGD02|WXfIx^1%@R3C{DveIF#L07yX-SzjVbX{2`RCjPmL3` z!aO4X=w6l)a8_kvXw(9BZ*3@2JxHhv@pL{b3MRBW7@IL%m4?Sc+!8;y= zRQjt?p@WFXhK|;pY1mDrW;VLnF6XA_D^Hfo6&;zkX|;URdfpeXJhZ66SazCf`!S&q zsQ{n8Z>Oi8besGIu;Z*c#FU90c~#PjSBL(Vp!OE;TZOmF=fmP~_qUp@(~azh%Xb#! zt(=A+60Ae8FL@P3BWBA@AvXKBvN)&Kl!atprRKhNG(qh7LGGt@a zV$}W~I!>Uo6p%Q&tK3oxb0lia=8Gg~uKD#vx0Om(+IKXuyL{@h!PHFVp<{+6YpG1^ zeaW)TpgPe_<8_Z08&ESWx`JcFr8KaqDfO{Hof+%l4j92|| zZmREviY6&5HeInrg?zOKGX^uRnHOSQfE7%lPyC}t{4iT8*WvS{jA?D8fNyB zsv7M`BwRJP?f$fXfM(1?WG5$I&wta<DhWXliX(fs^T)snHn9| zJ^*SJr@+3Xi}eLQFe9I)o(-b*PbFZZ3Lk$68k5|@!V4f9(xqVMX(q?k zb4o*`uXhrIn$GZ(f#M<9TdIdSI3Q%{<7EQ}I8{CI^oY$4f%iz6`RVy24QC*afW_y# z0x38s0(GySz?-f;kp;l%rUH2f>ro`(VUNJ9hV?}1oMeH|G$vhQR{*Bd^m*a`tRpSt ztihdKM?7sM$Rso9BEvT=^Id@`+;~SwElTu#F0Md>w#y~qZv$_udAb8-U?+T=eZxo; zbPmqL&*R$@XL;?=YI0dN(PdY$JKC zo6`<%#k7Gfr$eHo-2x^{NylxD+oB#VPj)5i!ymvcHi!VcAXy9o9w=C7c`AeohGB)c zBusq%tS;Rnu7{>0h8E1DUAt$ILx!xP(Qv8#cLwtOH>G1 z-1j75W(Yl#S+UL+Jk#|*nAaQ|DzOOr{aI-VC@M2{AiLb!z#-d+?}IcmI+HSR{eer8 zu<#gwJ(48x1R>JUiZL|llA`g9h;QVJyw%@S2L?|TtQfuvw&VxvF-toBGlp!ll#%n+!lgU^`kKR+uV-tAyB`^?hAmaIgWs#+E^eWEE`~YSz8M4FWHV`U z+5^4PYCag7}Q@m zAfyEBZ1Jx1t?4?195g6jr|`~Wc~)8_2d1H{Kn0;~wfDCBeOF#pX04uNZ2~qIrmtr2 zW`EV*42*uxwh-E0Z|@3lN#WU5CDTzVG*%xArA4}4S(-EzVT=d0?>S;dT(-lQRHwu= z6}-Xf7bgRpDvThu4D<0G3-)zkVZk~pb*b}mIkc4nZnykQbo+JdLS;!RHMnwH^0j~D znhAaDM@g`ZyZNG@Y^mjv_)Z2FaJ_Z~Vggsa0~H`gVry>?_fOymSB8ZHvC4Evhn?+l z*S3d_LlE3>JsK#?7;=2U=)NKE1ZonuplDIYw~7FmAmkwNz!NDdDcK#M^7VoANmm)I zCE-sd4#sMgdA1H2ox0wGkO+q%oj$l#Y7Mz6cYuZ+^{624NJRJ%5pikEgoxmxJjgyU z#5Cd-f8ma@+EB4xr%0)^Jyv|;jKc~BN)_`Z>>g~P478JW11$^WMl=)^AeqV2Th3v; zYOuoP*P@>?1kGcx;d$wTk9kf`qSVZX#9-w2KRv@e@*l zvxVmrf*RoieOK&@?(;>?6#N60Z-Pg1Uq3r{hCI;a(U$?qofatsb^H7H$Yb{h0Av{u z{`K4Ih3~n>3Q~RRsLvjyj!D=GhNbp_YV4QkUynm7;V-{2}*!7w!Y1$eypV&@n zPU}x4C%dSvSstWaUk>K;5ge>(Lq07m*^ntbYP*>678Nwojh^=s{cS+ZGEwxk)plQU zBmGz+Ncla^6EK9}kj%&+Yk{W(ckgAA8!_iK?~%M!}ybrmtI2J<(_#D zh6j6pA{{~_-sFNt+R!GE2O_2bf>vDfurBlcXA-OApcq+iJr*+Lr-Z_gXKz0oaD|xx zf9QmS1z?6$S${3em4bhySI`+^_bDb;GNgm6)?xTv1p{J<>|)Dv^AHG*jA< z6L@3MKWumWLnBq-2FRs{Urww?d=jb&D$AO8#$RBt0*x`-$b2JXh;W4YkPXW)Z`mb8 z8nlIOsf*wyrD+SQPQ`rAh3TNeD8zs+dv;Ot34oKcX*#2kvuQZTh)oj&RC9xrB?p z4d9Nxkl4z_ul1yAF7W=FUM}|#XUeKQc=6aPc7B^2uWPh(7R|mq3FGS&`wYMKmV2?& zc%2ev!HmJmj0SU|AAtpD(yJt?gT{@^?T1Vo5OGmC@Vy((0a&SPQtnKI615?~e0!6M9$WtW_>4R#q?0MGDy>_`6mOk{az z*@~84akJWyI$ge}G?x#6Fa2Y6B3<%3#i-Y}q!kZ2>{C->h|%9RLe9bN4A!6SaC1H* z=lv6;SJuMY#ECwAt!l^PoCm8QsY6P1W-(s>7)zPyv!mLzf5`L)?d3HQ)9f1W0U%6& zsfd{=^2u4vxD>(C9j7PPxkbY`O+sR#-`iBN`{9%OWJ5PrpUC7PJlh4tT~t3nnb#|# z%p~n6V0{%L>S z4VM+lfoqaEcyC1#{T94_GceHO0-)8|6ztCtf&?A-n91!zB(@+Cij&-UEI71el8b@) zu2>KfG)A|WG8=KKd_OKbHSIQ8A*ypV8B`cZ`wzX+BH2H zp#A9g!-Ti0N?-u1RZrCI`J9JARyq+hluV3d{ccg&4j3pF!UQ@3J1%3L5HMgyFfcju z+ZpPa)&w&5gG|?*0?kL@S>n0-Ys|wRkHG`Kj=2*4hMi~ZLOeh8r~Vsz zYjh>k&GCd2JBCUd$Q_!7Cx!BdqTbu5Pk`GzNN?J}&wV%h z{Hy`%LZ1ubu6%{t#akW7NxX&E=_1Ne(}fA>8r-i6^_XDXCPY;9F0(ta%eeaoe~f2Z zIQrW+@cjaz&-s3FoLU5GRc$SNk*93QbjZe&06n>$5fjdMeiMEZ^IZ98Dhwd>?Prj@ z0=+CC>qtG&r*tI!PC$%S&+8uQC5z!T?Q~>(hWnlXCY)eYEX`ID85Zcie@IK9(|Ro> z$52G)!5QW&OC)Et(^Vk!HBMJ{`GmUJPAV;SNGAULP90EZf$1!m*=EB}rHv^~gI2Ao zE}$~9^}pa8CqT50G&LcV-|$(ZT(=E2HOS{vje37|Y_HlE1E}ukWLxwobTV#iL;TVQ z2I$%=Ts*Ft>70qLDM0JDsk(+50-K;DiNo)^g$M38y~p1F4m)q=c;JGSl29pl%_~5W z7Eb-=ArWO7G9}rPuZ&uTYy-ZlK_lXg)3=3~5tYbiMCd6#=gZGmyZKe2{HM0)8?cpW zzG#0jR(LKTm)!31hwy>uN&Nldzyh;YlpJT}MvJh#` zHhh(&S4V;}3vASi35*PAaMd_kcZ>B*9738;y_~Juln|h`OV{@6 zqvvxGX`m1O?nD|5$|MO7E>_7qM;BoyskcP^{hVdF>dMJu@#P>#eLN|qlKYzX^Ucxb z81RSa=)4iAtW4nV9e>UWyae{Re~Xg2bV3P}3Bh)smN!mEBCNb_{&V6dh5b>s8YN;T z22e_}-QQngdnhcg%t4QfJ@KbQW4cyf z|GY_W`6@*O{{7Bh3X##wbW+Ov@dF@}MIXdTwajtE594?C>-trpG-2fMc2BFrTKcER z089>%B(tsDdi%<)e)k{LbTE(K*l^wK+>yR{cblZCONPut2ra`$;nTM3H-C%s{O_zd zCJh)L*z(NSXgyG9^-yTs?bKvYaxCt&vd)gRdt~DAX@Vn-(sKlS!>Vw8NSc64V2^H` z?6yJ1P1CCi-D^fg=ppM+n{OZ_o5y39GaeKIbjp~aX;Q6mFc-nIXJpro{e`dEwY!zx zbYD(hm7*J_WR_4yiIfwH>v3#PR9n9-f^B1xemW0t-krTmEgA3G&Mj(N_Tn$Y#j^WQ zWU^VueNFGu#$R)HMSNZN6;OaY=Z#t)59U;#7h}Z+;xDLxn@TpO?);dM0c7?Jv49tB z%r$u1;^?hGQJzMQQbuI=mFov24cRtXg+6b?TI+RYGS5xsAz&_VOh%}mQW~y4n%4vy z7YWdbsj-rlTd!=MK?P*>MOIo%neM#%`PJ&~kvQAjmC*w!6%z8s9tJ)Q2|O(Yh`L(*nvB+!b*go_p-vsO7;ENtzAt?fm+~ z@IeDTl7GU|XgsadC3674NBY|avE!1Ar?PHa zz}8?aZ+NU~sWf^6SBJiffw3L0s9!bLo5K)V`7rpp1nKfHQ8VvO;Z2L8)7vGbhx`12 zm6*{CfYjg?{@!{a#?VTEfvQ6A*}HPpx|W@YDYiEKNX+EUTIhhbUsATzIjKn26&~B| zySknC)KDcVTLCNsKqZ!3tO3%pb(u1ALNH3FPhS^*uDT>zN6K~7`?QOUN`j#^?%KFh z_;&>UAXInPCx@a=5FahnjG@)$wB+TyRYs0s2-S^?Yl?;edgZ<9;?f zZuV>|P6~9xG|TT=`5^9#&I4Z2sLo8>vHbfWOdqbpVo=3$x-0B!(uf-SM5W>jD_0jm zw(ngc{mWbP{Ohq!?L{Z(bQb}nHk z5yqyC;zyEfjxdJ%vg*aSD0L!E{?K}N$5=Q;CVjBoS)k&WY^HLmeR}sYALY5at}M_F zUMR<*3=u7R(@|Up*Y|Gk7WwpM9iD(n7t~>?@{=yqC3OzK6Hm?rGy{oUaE(Ctr}h?P zRJPpj8^BJ3vfEzl)XJ>w`n@RB4}%1eo1h058r_$1(nsP{+c4JnrvWtRaO-8C=oSpH z4JWH03^@>j80;CBxD%V^1#w0>GbqI%ec*9;->!|y-m^Q@s4TY~XAz6K&pYfQSqsUH zlo}2$OAA5{jOrr|GRz&3E}Go>Geb*Ens`dC0Kle^TE!nmbw#EU!5^AGmUj1Cxc)ku7tYo*7*)SNT^xT^b*!g2g3k z4#dE?7FDTI1vnG)L?7}R&nS3&PRsRRHSHOHybM09w0LpEwU@yM{)A2Z591*=|Fbr=sj>4f>15|{XJZUyoOsMTesSmt+2O#6OKqns zZAvREY%xQaeSAxa0)Zqg0UFJNgFc*}O8rHJsj@@h=?uJy*4#7Z098BDb>Q@fy&g*i+j8P+!xOc2x*ib3Xaw59?jEisO?yHN|VxtM~tlb@@A#t13Vs}GHSulQ? zJh;PG16?A+q3SCCckBa;d$-JXMU z3p>4s4!^_~=WaW1z*bQ}x^LZa--*Hi#Xzn;%0}o<6Ww1H8CRuZDMR~7582mazqBZ6Ffylt-d60c$(4K9txIPzG*AQwvjp zeCP!B918upptzKWiZ6Z!JCWIrouQJ5#f8flVQly}EB0D~8^_3S>+#87sIP z8I@-?6H;jzj{-L_Q3|I^H06ELY$okkObau)`4FltCK#J*Ht%Is7{IrDC+rlNn%#NH zu=csMwG=6U0H(n$GOSDpHfZxzP#>O1Nr?qc3!EqMBo+w;<_RDsL8m$WRu3F;oohIZ z*gp{Pr>KKS?wQiu&%dOj7&s9bjYW!jB&6L}>%EYk=i7bY@Mm>Y0x1Z>Km}!`w#U7L zx@$1)Wq^Z~;wPfM$(vgU`pa|-ZI;2|WT9#P$O!by0ti$;l{YcRn-{r)RPfoaz#|6E z9vd88iMs(E3e@HLh__SV!Z=(I2 zDLSou0T_ilV3x*n%A9rB_P2;Xo@utOd~!#${tatTJC^pHqkgcTn5415QTLWqJ}iw- zg?{k5k(p`!NSYo=6fCtn8*YK&6N9IrRyC-)=A&?t3Yh`z9=<;%x4JSR7FiIcWcUik zhs-p+j<&`;aFg6k0z+3Q3W3M^iL&3ytrH2w1E?Ov#cZC5pg?wF$LHL0#1V{cG_cXa zn3clDSy$A~)^d?=4!Abs^W7he?~dEc??FhXbl@yth>Ie+_NJ;XENrJFUFbpG(Ws4M?1qKB-d9Sw;@y!sGC}&i0%aH8-pV5ZdK|HzYTILda^{F$MD_Z)6+KQI_p}B*X7@eHJz8%qo(t9|x553p z`r~l9e4$Ib?S}v}UmdSUwhzO{%j#4NI%W>-nAM@3=jv8%)JD~FTt5*B9SHcpY<&RF z$IcI@7xdeFZ?OKpFRzlfCwHTpyS4&eU7yCTjsUfWYO5GynWMssJp#v*nV5@0iKay8 z!g#9<8uFrm`neUR!u9JO;GJ}~i9RA>6`6p#hC_#2+)}YVATQctWDrP%L`(Jyca0|; zYV7T8cC{8EsvRj6vtn}7%Cl>7D43#HV>b)yL6%I1#eIv2lG365RnCOsRiPvgdJ7gx zZ$OT{_m%&$UO}8Su+3fw`)Nzzi0yNg4YfaaCy>`?W4&oe3fwJ80(A0P4r@G3erFsm z8bsM=#r_J6);FNi2<)TJ-(nG&xX&&IwSuuPK~r83B!)9g}t z5tbQ@bd^w~i@Z7sIW{qdo;p!6woU|Xt&mx`*s;3O9!$|s5Dg-9v^J3Pygqg*F93Lr z5Dit`MQY|iy6CYe0=90diXLsqgO(u3QoO`*kLwT)&4V~P_=(nSivyEb`W}7es&$w0 z3Ow^@U*MUFqaazAJ3-t%2@nhYp#*H()*BDRHEA|wq)vQlq2!+vKj^xfSz4_?CTInd z{jTT!Gv(p=2q4NT(X?U@z)TItD_~i-xqwx#&0FQrspQ8B7iK~60-DNanoIazQ?+7` z=&C>Z2Uo{MDFcaNLu1cJjZqmmg)WdG<3PIUv)-{nu1S{&luOPQ?;RFxG%U%1n3=Ft zoiSUWE>bHz1eA6q^b^PvorMFOk1duSrVkm_HvBxzWCigEpsXBQNiAa<2p}G@{3_Li zVC*4XsrrYjbb{isyf4zfyG2lEGTS6 zgLGOv=^2%TLfp1tq9t*^%_mk#Hy>^(U67t510t;_qQ@rOm$TwZMC0SNI^ZdESKUHk zBY(u{Xe1kLx@ABbX_Gwt4!Fud6Cb3$GB-SS1}0O1yW=n}0ZU+*?8Y!DA)06Ojmz^Q zOxhlhMS$PD!%1jlX$0nG4W-Omyu-+MVc&@rvKZN#MdtmbM(VD<;yE-USCI>`*02&m zy7((0b>O&AYrhZs17JgIBt9$;K|`IB6t8rW$K zI0H-Xx7w|*$(}E={WKd!x|si~hd5otJ>(tALLjs>76HE6R;AHua9&7P?Ze?#Vr-=s-Pq^d+cPC5U>3$|0M1&%*30*Bw)8VScA*7F z+kc~E`%b}qoTCS*Nzb>|X(p01@bC@L`|xadYZgTW!!81yMZ@g7N5IHI1A~$dJV8|B z{!HkBCM}d~^vmx{)Dd7TRve215^fPstEubTA8=-~Q7nU+u38u%)=_gt zP89ugJ2O230O>JKNHDKomW_1Cd_rs{FJWkkIyo_8E(vmtLj!aGCk#YsJ^MKB3!NL;-l+0f5%JKY%oO~bb?8&;6JZiy-+tYo~YB%DvL zk!Y(s$<_8s=DeOs9gV!!%IN}$=?Hj9kT5GWYuKF7t+zsXc}qXINA?*5J*Iyg0`dr{ z++|Mv7v@J9i0E*Ef?7W;WpZ~SS*}HY9Kuw~ei7v_RWgytj*58)(qSa}A@uPb9VJIzaOm)r)^pFC? zGjHpdCb@HK+FeMLjO%Ar+9ETW2cY8--Sz-%{Z?L4=UZ(WFOVgxI?c?EBl}}EyCrkZ zmw;%q3(yin%KWVaTXXiExR;;NuLgeoL4LvjMv^L9&wfnPj;!CXx(CAue!xisC7Q#w zF7Y`lTC9KmOkzS0=}AUr#x%1&G)_4GsmqLTLQ(etesVq@F+?w!k7zD|^7?yFP_8`X zT!adg=<>$kD#C%32`HiFIAB>d*(A_A%~LwmGZ!`nT`j0NX2%m=J(vL~6H4}uUK+~) zOq9zn#RNQOn*G@H0L4846rs*HO)E_)2Dut2mb#g3GviGPbVpnc!}7 zTv!q3x$y}Ol^B5*Notn{Q*@e(+X40b0n!we1MHM~p}q`xv7U)1JQCn^zmi>m5?8Q?tETm}t_z3A0)IA&0cbzDXpQhcZy&2X7z=mzW zBACR=x3P!pcJdBI^SJJ=Uo_Rj@k`Y&I%{&_NLF1$Q0N2>C+Lsfi{bV4^%WWd@r4kV z0gNPE8KWBqAfbgU?KZPyfT8f9^OHi6YA$2cJFQYfwSsH7inI=odp$SfMxTwi+L)7M zqBz8KQZ`-eCOr2sXUz(X!er=QbQ3y)!#OscKvHcrGBy&2Bmj z<3hK>B4((qe6e5VPyo%`1Wlle!1PoIrRc{LWp*62y}--<*7}K!s9d{a-Ji}XR*nK% z$_zn)-y@Kn<#vhA`?Lapd>0C~wXSIRILJzME^Q?W@4I;D9$2{7tlgAU?(Uu+I^#1b z$20;B*BDHm+y*9Cwz%RK#!M;nm{wM>^UD>CIF9Fz-V3*+B;jK^8Fv9)*bkJPJXNC) z$Ye9=Uv5q|#S&o~5GS(Q?bpZj_Fgv_Z+*ZK)fjYg=Fo33prT*^Yg>`26J06(hSFbf zeaV4p?K}zk zT(+k{9Q&i;?GcRuuEO${3Q*S4W4Hv7zl}OtM^7A++WXMKNZ(R4Y5YK+faEY)d3)_H zZK1TBw?NLAy2>i2?IOidB};>emcnz`8*V%q20yXw+hNm6$qKgG zlLgnAm0nr^<3?Vtg?>}0@eza~X_vzFGMjWmkq36KwxhO?Rp=*s$CXD8K8mK$zgawt zdvr)s`^?+ACPI(&^jQkY2^_c`Ob8U!0DWkOnnbQ9d|P6uS$quUDXG>ExVmy94^<*x z-oE%w^w=hX?GEMoW3|;+P{$c+-`i{UK;sAm61W@ycRY+sezk6fPNZAnhHjEsBslMi zNq!;idjxK8&j`rWpV{w%eVl~zx-+R4}U)Y-fB2K6yhw1sM$kCg8DlbaHZv!e?q{bl zfF;)Ma2&3LWz9yA&yExpTe^Ie%^P_7-st8#% z>)o3ap0)avxma|TLuI5&^$#j z>N_`zm+2vyt0>w&oTRc8M88jkpxcoD(PoVB)_&-Vx8{(~8WcMKxH^|3=BJ6|4`zsO zZ~^k6t|}sTkv}jXw5hoaX5S^vS3fysPL%d027RoQFV$Oy&gC!^LHWAO;bVspHC& zQfWEQn6W#}NsiLxHN?4d8xi0UY`SL^qfdI_`YnT{|D7c~3ZadcVRYfjQ1cGzA1_+q z1^P?FxvRa|OJh+0G6NeHgx+1506gw7Q~_|KSDhM9$^qI!wAC+q^~gxTODb)__GU2; z3DD`n9p_z^pGopTa&fEfSt7*;%c#Y03V(}?$wY*(2cFs*PGg-#pC7F z^~|-aW3bscCoduUvL0dY`Sp2buDai-I{#M`fN)!P>s{iplCl-^c6V42bIL$(STN3B zoltOy7c2Wr_h#*U|54mCxtc7A*2Hx5^&D@1df3CJNBP3O@wbfIO#Ne8R`uzdK2&>8 zFfC`2kQ5q#1248}`NHCLZ1 z5b@jj?rbosmeF5ZnqIBcPc5Br!079cmvYgKO{;P2>k(~nu%sZmR4u=Vaf%y8`& z`tA3z?Dz7pm$dAInJb{_$G>hRcb9Te*Pr;58R!A%%aT8BeD7;LSa?;hSFkB3W5e~1 zwF*m&#D2Zu#4|35F<=RA3;#46x#h;61+RaY2TxS=dcg_>dNds z5CO6XZ`T>EAtj$zRO=4JFXanDjolA0A=L)P=8CE9DE6 zfA@y1j~f3-H6U>HP3Wu!uf%;QcMfN;>NFdm_uY*(9|c@~&$nz%tCZo<)Daf?r?JU9 z<&4RJDipg3HgAZ>AA_7i&iLF`MIj=j4W(;U${1Ls;-q77G9E;fH;dMOZ=Fo&D({y& zG^EBR?VZC0OCRRV|6}W$qQefpbz`fslg754G>vT=jcxp5G`4Nqw%NwEZQuUSTIbxm z*17L95A!g4_P6K5R%e>K)wSyl{=$I&Q z%~Hd$&01-eiS6SCai++bVw~l`I?Q{O2FUMxr0miJSeXVabSJ@^lk;6<(S(|<5aJi( zIt}_kL4DYDa<||USaV4TFpuH*<1kfU77{%6)trgm$KVM(p3W8oE?p+T`oCm}IYAQE znul*E%&t1DkeknHT|hkThaZ0?ue|_HFsYT!D;r)C9&pgx=&zgTu$>4#U|86$(ycGl z0rVcQ|YBAg?#M)ZFz2uJ}SEXQ^# zWMOouvIWPFKiSxwwAkaF?5c3fTTm1g7fL-H1KMD)D494Ru>@pn;jyHODe}`j;&PE< z&HjlnTuMB*B*-)B59vA~@u7AYJ=#b?Dja&qducl9p*14vd_ijAuC73=sCz9dU14i~ zA4h}HVarB?C!g&=L>Tj2Pn80Y-b`WR*&T#m??S`R+E>h#1B$7{1{k`M>D0X=3>A53 z*}s{d%mPvJ4Y8lNw4On#LMAEA>Y^l83KkN&Hopgo8#9w%QyHa$6W*m|fFb7{uq06b z*#;#zJ*PhIlU3ei@%;CxmGJUAm&Vuj6o$=WJq}hDre>mV%&3#d53L_~=jGFclgFji z>qjH$C;<5ha~Mj*>qjDb#oP-nh1)g=dkn{Td7MhT^HVtR%UWd^16vlvjUwY})SYsz z9#BnV$n=XJSMJkJ=+}9DVx^sbH)~f=+#d%Kv{V$bq&tF;5S?~Hu@G=m4*Sc?>_lk8 zKtc`8pq&#S!DMSQrY!=HjpsgT$lqB%S8#17kL)V#T}HNwa_b?bVD9+{GAJHy?aV8+ z{?)i4VNhHl2$t57L2zz`VRe$;Ma5c0&aVF!nxP-9NNfTy(AI%gB1L*_3e;NCy~C)f zJUjJT3b>&e6ww{As$ZA|ChcU!QTipZRKf)6&De2}l+FS@^K3VUsg@gYu*EPn zgvIlyY!7{XZ-gNw2krtO@lw`R$Eh zzv%`m%nK$E8p6gv%ak!FPqlLAiuyI^2aU6IUjHl&`&kMVqG=D)~PtIOccPR9rCsmbAP_8N&T@YB55%soLBb57V!tA|)~9wkV*k~V4n za@$2MjNizVr&*iwR-#;q@@pA1{O91od9IG=JAJiU8T@adR@h4TMC3{`aZ=;8w~{9O zQ38)7d>bI~wtw)Ia96G5o|%Ka5S8^sH{;VyVv@m~qf(D^IK7dVZDR(iG-ftUnPg)o zP?lf~#lV~fg>bq(+vL9^BiM#lMq~k!z$j?qQ%S_xsrl&GjcVfcpUo+HPtu6BSj0)^ z2i{66djIxAwt|$A^*TwYj`{T86o2;i($ZlAB$Q)5zQrGo`e4fQ;fw1-s$S#YJ!ut_ ze?FOy(2s0=CV7o-zbCzQcGE(ibp((N`}|0LpjDGO+UDpUuNc=JW;0X&PPx9_o}&BZ zK|?KcEQf2Z_Tc#W+1RwG^n`7yvrv(fFZUV$L@=nb-MJfTHP%s4Q@4qv=bdH+17c|a zoPZrHUZs%lm}g{FHt>=ec*^LJRt&ln#fPb=yH_~7)1tN)=hl(dY!+l28VIaq7P}ra zn2`{_en_58RNV9Gw{{kAds#S~|D4O!YTk|@lYAC3;H);0MBvf);+NvQBG6gTw69wD zUR|eX(~5In3(iqQHB}Mb2wY1x2}ELQb%ox< zDk$?m6N({sDeFYu7E7zq6zE*YAMoZylw3n_zBN~!k$4ocWFD5(=LS*9iczPL}X zB2CPLO+w396TA$O{$iqh|9KLK>*d?mqM?(o`PI;^nBL~y%R;O zA-9c9VDB`P25XPu>j>DykHLsCO|8ujyVkb;QA)@x8nv3?G{-Cx%RQHIhqLMJODW^w z1ToZX>ITuWx7iu?HL|zvVXT(`@G`#R8mJN;%wri}_(?N%b~&AFqT-&3x}Fs60pJW> z2-J`5_r{1^Z&Ob`c`sonDxZuS4;ehH z`oB+~4+cGf^HH>PVaGtPa~R&XoVJ`*K~y!7zS+#*l_S9|Pxrb(=3sju#}JNGpJ=GV&qBM4g`X6vyJDeMffJgESd)Ku(z#Uu@+9)mSrg$YRb zwH4}L&aVHh6vi%0-gm1z7~BOxfqrDqHW9*1+PN{MI`vP4ys0x}tqG zH@afQN6Qyn(dd<=MV3z+6QnW>jeg6fzwqt&&VKI&u0s(_L3qV*%O_USD`1Q z3aLlofjXhvOY>4Nk}v%H!HRkj1XrMee1kJ$wpxzoR!&g3CK;7gM%@%aD=zlWj*1ETulZ`cgU<@LO3K;R_5!-X1`w_L zzum-Wj}aX3n_3v02`}*FU;wKPyUnP&_AT4!QFZBPYXL9iAK;6fzO3c>|IW+j+_N&u zJ=6`g7cwkE87hV?SiU^!=uL2K7*r=Fa6Yjce0sx(f4jMTtZf;u$ISUdh+5vl}j8mVODltQ#B)-X{JpgCO^3VkCq_g(6Po-2}y* zw8Squ+Yn3!>xm}2GC-A*2^$p$Dc=qMoALoQD9(HIpl4*TLpMT%e#7|QR9cah4I}km z%10K;#hjT92vHXBz>?+$bD1-_#CfVESTvv9dn(M`G!>-~c7eu{`9wu1Fi^7ZlSthk zA%`y5UD{9PqIUgL>kdS03pe9TJW`}TthF>_DpE#o zMNQu=tsgMDV}VT2{@k48ruOP!bez`l3NMvGE=a!!_X4~k9Uc9xp1QK({|xDJp7#JrnVHyLz#r>`xt?a;MSRgdi* ze3v0Pt2Cbc0U;O0OuE<7^szD_LgTHycA|#?_RWp9lnpm@14?XTd4iAu(SM?b@e{uI z7;@wPgQWl4@QaO=>Hi{W&i_|`^$&ml$C-|qll{K{wRXb#AO^+QngHdM^3ViT(znx! zzp;fhQ1M)_5TnIP7~6(6HB(TG%X(|rpJLB_+$A+7?CsO#)WnGs9SsF)XJ>0})f=Ae zR+i0H*EwH4U$5s;F)9sS&Q4H*)7ja~UM@$#M$hI3_XsLNcbTm5^5y$ZT1V1_iME^W zfU6BHU^VS_v}8_n#tV)bS#Y5s(bnDy@ zYZSnQ>JE#w&6NY@ z76WLtPJVhGlRnuj6~8)Y7;uDHb2K)s6S!-$noVB5gE}v6(Q218Zh#4)lk{HlzznNy z)PC?{JVHdi3`i}P-GChp7(auwz~oJSf@iWlHsjHm0|v5BAku%B%;5Enu=>f)&>MAj zpOn^42}5ZZKc)zj;V6tfnbcr7M~i`tt(X>p3Zz-4Kg^pep@yXIMMo#bzhb}8(u@9a zCxFn+FD$BCEYX08lW2do zTDs5)D7C;3o26{sAIQ64?{rKrfwlNOy>_wG$CcCCs1yn(#Z0EZv@6l!?r&Rf>1(Zs z7^C(O8=QGNBU^s>asO$WMZc>M#f`R18zrkLYh%g^>Y$%-#LlYr7b_Pwg4zjAJcnP3 z&hXdSh4Z7+m^xxH0fT_YwoLH-2-ui1c5@OR?9&DLjG4PRnSB3y!v2cXEqb<<@NHq9 zHkn83w%R0B@B>aA;IF9|(G!37DceQhFVl_TqzbS9oYHB41a zZHNjVmO|zpqALy}Oim=ub+H_Tlu!e%DT*nqx)Eps7GY2Cz6J2U$n@fAPa2Yksb#w- zfMf1hZP?ewv6^ON6KtZ$2Up4U_j3J_E@}~#%YPz7-P3l+7TPkT2)6cttxAMDjX%E( z((pLOU;~lGRvV9MI7TAHfmQffwg_s@#YOaSqK=Y9jaF&FJ22Qbm9TtKMunHVH*Oq$ zrd{a3#Ct0S*B#IzQCE$PPOKn;M7@Y!xE8t{tQtycG>tlOO&?M&@gPQsbd@sLa7FW@&QHVhFEpBlWMFO&*;e=N_+`h zxz5gfqJms3B1>R_`Qr$8T8$z`VdmS~ngo6dmZoI&n#!!hkXE_|c~(Wubwrx*a{=j| zC*2sh3$ki0xclgphVKyPP_$`FBJ65y`}2P*7pN-I+aY}v9qwC51tknvZ!3ip3Y~7k z13{*LW&yqw3Vlt#4#6>I-4ST42`Xl*MzgytD)Vht{}^G2o%x5Cnygv>kdiuGqiK=3 zg{oN2rvZnLv{On#S-o9@Ql(z3i+YthxqL*N?EE1Wmfy`&OReAsCAgt#pWfYn@HEJ% zV}_9io1>6Q65PkKvJhbImqGm{oN1S_gWEuZ8w?Q2!&w)_^P8%QD(`$;jTb63He;AU zwybYl0K8@_y?ho);g@6z#NU2C3m(AUPIO%(pv4z7r9|y_ym%64vtKd50(#JMqQ93H z0*z!_7S$vkJ(Zdgyha(iOxQXhA0#>t89FPO_Hzev%GQ?@fVGwEs}c6FWlt7QYWDzp z6QGmw_=wqi-py=I&1i8fEIUM??YhUD-D}*W5Q(**0zQMj_)M|1+p^Hf0|7-Iq(}T=!$0Z7wHB_*d<=Y#7X- zeM-%(KP{3*`1A8BvRljqy-|jlBhGVb%+l5hSUYFOC7e0RZCO6KsD~hAeL|{@>H2 zP&4>M30pMM989TWpv~e6AXsQ(F;xEY*)XF*o)sryKi2UL}dq1^UHcqs7&BG8Q%Qx8ZAt_z3mVWd0PFI89V8QYGCK7nod5|Bb7Z7p87Q>ZCLEKAYm(J ziyU5Ej$c(cSf61unCymLKn{*eQ81pqzNmZf2oDP3$vp3O*i!JRY0JiJj$@@m+k5E7hX`*&icb;cNETd=3PRvWQv4)uVKiuU!}DhN@XM| zfH!u133;C_PAN_}2RQA}WTEyH)dQgf-h|AcUmoZF9!HiZZ5WOEEG^00>hd5QVowP6 z7|{akbR1X0Vi$}JRo5O!6oEVSvNrCDewE)`qHh#yA1Xtf>@-d;V6*$Xupy9z%dp@x zr)sBQ@WC!kg1vcacHl`;Jv~r$p)sAPo*E2Cg2x-E>m`0U0vQMfGfc40VR-D(2WwP( z)%D)@MIL8lW1@aVS{ay3p5G?$+=GP3W}}+#8Dn1{jRVK6<;^g&tA)+tac(HvuU_>o zi+NxU_!jrl0>RL7akPjAM9}ho^c2Gz#+^CTU!3o1& zRxk@Z3UDi4f&EpR`~H%enohGhrz2nZuX5>VbhB`&5B06kAqlth_uV=tM?M9m3?YGzp`sxc}Ie4J} z2f0t?!)eU)B%t0*bTJYRdk?a&@tw4IA&$^>A7%OoAhW~cqc3^R+^7F#?C2;b7sQyl zL6j_cs3s?EhEhZZ@2J9JEIUdN+A8ZLC!{UArvj?$sp*rJ@`%g#dBBpoN=9D9jxj@e297aftWtv_ zUA~tcKn($vt)#^d`Bq=`GsW?I&!1pX)yCsS+74|J+E8i_aX!XCFLAShpc*Gm+%L(V z<tEL2nY4crN)NKEp9PWtCLrIYfb6sBDM zq-epGO1XHH4(!|W*u9&a5pAr?<>cA@t|8lltCcSvHn+ z9*n({X|_dvM`_CkZ#jTaS~pZ-2M`o&XXaGKwU8uq#oT zvmEwDeD_1*?E_=lQF5OS8J`233w|+x{3Xx0t9Xzl8QRH-BzHp52x+Z3Zp_Sw1&^(G zTo{lb^b{8X7t?qcHL9ypv(w8V=CE@Wx57W@KU$or$#3KB14LTvA?E72U0-W;ABz2z ziAHsma?DuI!jSA>GLT)=G1LL_Fu2Eq2QsVBB^nA?gt`;%ssXobIP#CvNlSf`ccfG{ZEG>6^G)ugrYUk{ zjBrUJ3>6wM!B%S}mJ>=Tk9XJe*f)k{Pj+D%aIV11ZuTA43?#a}+tGVvT?z5*?TePt z#db5W4EP9=%^`F$xS3*_spSIw_)|QS!0FT87cr>g-Vd3S7P+B2)1(Bnr3h47a#1Wu z{~0O}%Y-|1f+=+Dj$ty23DtO|1y;lEq1B=;BI4&SirWdtdvZs@MPt~?s4)nxsgGU= zle>CCZZk)Gw8X`YCB#sffAsshdXqjz@V{neyNFbWDp$@&L$W6mlE|=#$Nx$|eB|Me z?2VQeyIO8PBgOGb{5uD5bcx1NrPP$)r$fzW>4#SJ@d-}cj?Sme7_>R6@OQK1m(q2z z1eB7|8Y`)IIt!~*i*xQ)9m%d?aOh&wY3wZcx0PMK5j7WdMpdLO&|`Rl)j3BH(! zVkk9Df)_-24b&-oqFq7#`QPgb^IcvY!3pE#vuiKrVK-!OENh+5?L5Kimy2=6|CmN+97Mb%SEN+5Aml1PA)h zsi!)mKPd`~c5|?By zN8K@R^YKm3_0!G6N>*sOzK+fGc1{D9d1N(1f6mBKM90x`Kp$h)8G&}DAopEMeXxn6 zVdOcNex`no574wv+jOpGRjqP_ukG8c6;XW^96KRyf8g0#_euCG*r_v2rdvX?|dU|JM3^no#x zZA0l9(L14c@ToODHJyjElOUME#P-7mlL7RCnmaOnV0@ae^X=;PhA-#>LSCRV5Rh8F zNE+`pc-HMVa0SU*l?wVe1&=9Q?6{2~1KS0*fMJZhaZSpOSw&Q@?VpCaAFaZVW-nYD zuZ~TZiqJSM_e@Fva6$n@g2U+>YG^tA-8c}uwe;jTrrFXjZ%L|8SUcSq$bBvN>*e2~ zEEuU4X$XY{bN`RcQIVZ$kJL9gm&9sKp&|k@bFJB~gn*f!T|!%=iL!m7>yS!D2wAEN z)YOfvv2GabnC1UT_RssC|3;`jEUn|w8kW5i3jZFSJpUjSOR+aogtXLJ(B23&Z67|0 z%BNjMP#bVM1s&nQ8WQo8Ut#c(8Q#lEg_e}(N`N&@0*m72n0mD=hg7OYJP_h)&}wQ8 zJ<;U^CGl;oPrSDm6AS?a+i2^RzmTgBNQG_ryG&jRAhT$zKY4>VE*dfVQt%dg5juP@ z?BI?@xs?0Kr@Iog;Wyb_XF4zsn{H`!1f5HUH(+0pY#)u4&I#UQOg8Md*9xXsd?UYu z#-vF7XUX#GreH6DE~h5|iW-;WJ{#iI$Uyy=mIG7}#JQ+ZKz_TR7Z1ln;knfSShUaT z7w>ib=KR~ATwF2h>*D+!SwD*Yo++O=c{L=D5?XHVR?vQ=z+g_yIuAH(gdyE%#>@jt zm~^M^f3O_v!}o)S@C9q72BSo7ruV1yVDb-5a)t5dgd&9H3%o)mxn422ptwe;;P+n= zLTLLNu7F&!Luk-xh-+I(DmpL>B+YZ_YZ8-GfWHNVGH~^CLbKMQ^He@B=@ zujpv(ASN|E&leIO1I_t!Ok~2N9{Nw>PG-w9?SQyZufw-zER#NgWZkc^f>pH)R!0~Uxo%Ga*tS= z2DdQkOrg}l3M_${{z@URh3ndESb3@5bQBvQzp5| zxpY4|%wKckca_e-)mh%5pRM9*PrsyAm88`|vc0H2pJ7LJCGVHfhMwf`)BL!TcQIlc z7kqIg(Ijpe)$tSKB`;O+H=?QC*1+XVwy+(D-%uY!`^mO{;|tCAbi zV>d){4xD=el(HASTLND#Iawm|Hs(}2{vLKx{t7XI+dN0}IAj!Nyay0w`-Y%GR_Ns? zK^%!bmk5>i;1Qv2@lFQy@6=n@sLIFvAy(~61@?XZ5D3I&sNyVD(<3`?`<8@svl7AimyswGzFJ)*T%18EB6ubBIs2aD{snBT&LRwZOnmZ9W2j8KKNQ{~iSJinxMGc?m#)$FpsT9Pp~OQxf8+K!ei zuX-pY4|fIP(QE68QqrXNYDU{y}!guj)v%H zH8@9%RZ8jo1*{U!gj%%-GuU5nj=nPm>V)uo^+0(;*laW;v9{87scDZb(qLDa zd_PU7EW8okI9F4$@SM(5Q@Ytd>Xh@HcJJ!fM)L>=AG99+>J@F)gPaq^tk{M@^8jlP z*Fqe!0dBLEbt{;~)#ujNyDLP^TdrtM1`%|Bf@aSz0PY*nMoLrYw8%nt|7A6`*yvkwjbB#91!y)re08j^lU|9+H((u#f+b2#u^CstO&X+e#fx$I7!A-&paM{oV=nTzUS zA82VkKoPgk$xduZ$CEXq8A*>c&r_ROwp6sOD{7eg`bJ?=JLy+bZJ#ylZrpJHVe}tM zh9KGIeJ{JVTG1qJ$>i8m)uB4@Zz2z({87*W2$U@&H}to0>2vbGmc z^nwUf=;~xX327)uPHed2H4ZXdr71^9+gR;HfTlti+{}@NvPY*8bt`)(UuF}QYe#q% z?p#{dK1s-2SScEtNm!HXc7!s}BIui($&@UnHxwdU9i z&%9&z^Z`|g_wvr(V-$#6Qub$_C&k`ihNT5Ma=|f z!Bf^Y1a@&B#yqqShEE?hwiNKP?JeKeX0WR2vQ@x-BvQ~nspm8ucB{RR89|sjnXTXy zZBE(jtv5t-7NQMr3Y-h%WpX*s2=O&}eFB2R_ zF85#7p@s$Jk76~h>YG7LTN*n-Ku}mI>PCu1CV0yM#bIL4Pk6ELLpuNC3i!DMT6ET| zHQ1gi-1L4aAKrB2LM5^2G?_#4%(E5FXVG87^P3dkBhoheb6=bdI~kL;qYH7jDnb&E z4Al8$iI;}!m6)Kl)cSc!vzf0S{?&nJEsg83wdB;mf#ouprMh^&qN^tY01nQ11J@$= z4D6z6#ZzFkW2L?KJ-O1Hf6S%SW zdnVixYmu>CQNZb_A@qq%%c*hH-^2kg-Olt4-&Xu z+Kmb~=%+uPR%K9HjDwyKKt&FSElDJ*)Y>oxn)|YF5Iv*HG-ZXNNTqT8Vk=1~*79?9 z`905k2J$xHFayeG{`h>GVx!gjNLjoSsDHi##U{U^s}giq)evE8W9lFIf{E8gI))VT z2lU1SrC3qT(j<`>_OQY}!6;@Gq4DNv8^y;vkh;M-;$LI8C4P^a>6om;eva+5u5tt5_6^tUpw`*QF@cy`~y#S zU8F0EI1=Gj5O@YO)3UWYv^Y3gu<#cGdYXUnwL7uRK1f_Huv)DVT#Tbi{(E!k0XJvk z*fV=t>bLGl2Gk_a*8YXrBHhgvNF9fsutX)CnC~--meWbZ#qoHp<)?|5HQ)69@PPy2 zK-fq@#%lAihZSQq?;La56FtX{3nkffMWaVtr1>NPmA*fhi^8wkvN?DBz9rfb$2Z-m z6{ahSQq=o3z$U7#nH`rl^NC4%j-au|ur)7hv&si?z~@6-!zT`_g1yz{)BGHRXJMR8 z1N_Rmt|^xKsa#+`{w>`dO$%-_6mK(a26;W>7hU@HRB}DHnbWSjGukE{_OtPpf+w4s zRn~A={)!AtuB)~-c!Y_LpEfwMe5X|2BizwIbEq>sVBh20Qrk2Lj)&=#zEbPyw2B0f ztY%-`P1x%lwQqNV@;p)u&5fsdKcpf?Eh=O1Pk6fEpKE1<*!4H<OJDOu8a6)q2dr!mXVc9#HOM`DR*JH%b=bhmXub&^V+5XNc#52CtkpCO?eo}Owv zdPQ7F_vbb-U2=CfXzwpP|5K^at4oh0jYg^{-~gXq%0ChnwZmu|-!aBmUd^22+^bR! z^wY*@cYjdSTVImNHVT6gyG6tqnw%oFp|Jx)zqU_D-uJ1%-IA_r7&Xgr@|joG{O}ru zEx~ui|AY2i^>he9iYBmapur_t+1C9pQ#|(XdXO)qsf);w1@~@}ZjYZDU$2vVh$?Ks zfPPeQ``2CP#nY14bAxQ|7zR^nuWLeJ?xP&i=)AtKlBr`kjhrDqH;O*v8Qt^D$)VAC zitK%tFWN zj4|dLQcdzOIjj0NoVy(kjIXTX<}Phg=h3xz+2{TXtyol^F%UB=)) zS)bK%zyuH@XFOOEh|+3z&}zRvm03P=v+g5=7Sas__-X#O#;j4T0Rgmu2&76n$fEtxy!aKuzzZP2x0XU`+cV%nuB!7u#!T8^@&6IkI`-3`QHn~z6F&ZfKMe=+lLySsFBxFVA7 zZha#E;B)^(`Qr0veBao;NjQkm12qLm3qzEIz@EZU4k+Ns`baA~o#fvy#6$#<+PCKH?vX74~DDwal+%UFb zF1U0}&WPgQrSqS{xOu5H;B8F8K*!uk9Vr#s17NuX`jlP7D zaQ4rM2S5pHiYNxL%AMWd;a_gNir|@Hj@9Q^Jv+x^02h?@MA*U>N)% zs8}M(jj4XsSnxWQUel2DY0pZvG1n}g-q$kxP>Dz--JfDNtx2a zI7AZ$)+wJ~zzFuqAt4$KD#m`ya)Q{kj9b4LTTC~>j5(Sm`@`R-DGFNu$L32JK z$)~h)%R%wrjNnfSB>Mv^V&m~gPuzNq-;*OO7q)RxrlmU9M%1;4G(tqmyFfMBv88nI z*BcFC2M#K*Ia|!36#H@VZfAQ%rv$KjBCkci>O*{D{;|W(>Iflh7m+T+ov4f)6RfRk zX2ZH7iOEqqwVpKonb)vtXP|_+CY|b0a03)NKOIn}jVGVF@A!e}SU+PKFC_jjrha*0 zSo9;WTv;knk;6PbqX{ztg1hpC%w1tD7)EIwcHGXbyGbSlLwgbfv4+P4cWLG7$iS}C zfn3r#*yObq6%7gRy*yC|7T5gVopmAxiFMZ-t?j}kPtXEMxLxCcI9Ph>SPm)HUqt8X zC?^7JZHO=@C3QfQSZlon-#S8Amx6U${}w(AQo4eQe)B=y zp9*4oQ_cc$0r@kD0A;`vEsj9@^Y`!x!!_s3M1HZ0bl)zZnjseQzyno4I_p?(!RMEp zHlf=Hu@snmJm<)mYnWXEm+OtT$jU2Z^1&3g=erf`Q;nb0 zrwA{l&9m|&6FnGPAu=JUwG#JziuOwl%W3 z)xl2FRMR}*tZX)_-J5%72LskA;ywBpR-46a>o?XZ^O~pIN{q3XzuiVj#GKbF>X>#N z32}5R4We583`cZArHVjX1Ew-vK{og2_DA__)@&WUSmAy;CeBC1O%Olp8HJJj;uL5% z$vMJN1?`ck5;C2Y%VFo9WDzlUwu)oTO<_E{j1Ub#bB(U_c1ASrfUWU$Of7S$q^Fpw zqQz0qAVa7+AE@71_yhu;3`UNinsMAdZ}d>wN{{|ZCa~jBeU~+~_E__pgnTc)blvKp za`jqh>2AaKMPxomKSDBdkI)tAs5nDQkGvMr*;Jc9# zG|CP9H0xu1DCDtp>JOdC=P1#Yw_%9NtY=ckd>3e2)p34Ho00($sG46 ziTtSIotdCcgR9y}7%bs}$-faqC{zdpOvMCBP=~o0#Fc-uGVh90Z|itLw5znI_Ihyv zQP90jU5g_D!LYmnCH^@Ug%2V$?Rv~7=5Z)$M2UN8oKSqsNnXgk-EZ@ z(n9F`^Qv8etp$waAM@|noUU)&ez@J>rzK~7c>L}sM4{0jo;(froV(H({%`^y1;-cs z_Y=1s-H3+t!qP{=WEJtsJ50Xe?#9K|!8>WD*-etv;DPMQ%2y(W2|F0Qvb)ImqH@2& zyv^{o-a3`*FZ{S8V51tC0QJF-j${)p%8%|<>z^O>zK=`Q^Oxe+#XX@sO30l>em;}6 z_m9*!bqWe%$VkNlXE-IWM2ix@l8rjJ0wVo_T0&ArZ6v>72V z*I;E*Gg|(Fr8<|PRtw>Ajc7-jCK!X|H?ea+q(yF=fh@0fwu>jaw9igRPXIT8r5OAz z=Lb{j%HN>gOp#V8rx6#;#HGt@IruIV6BjuJsS#S?VxjyiWz?Iz)d4&pAu`kUuSLKj zgkpjzzRI~$YKq)OwB(MvnJEp8=wjYpX;uICe&nNS+J1NruOR5fQnY5cP!IvuKmk9Z zksY~!*PoB$wI>9|W86c^iR}%Vh zk6-lRQ@_hKDQh#0KiBU}+N1{2vd#d#Nk*T@*BB0_T>1p9V2i+5+*_~levY3?q!(K3 zZw5BdvR{bGv2bvF;eS6@S+Pw^-dLtL84#NIZ`FZlyMa;tPDEu_#ml4Qi9hQ zP|C@k^5E`|6(9jI=wh*idL|5Y>`z0I>O#d&#BNv#YO^&Eo@^Br;?Nx>9=R9^`7+)aJG&WFA(8C*(UJsqF>8ohY)L?rOZL{U59s76tfhTNPXGHS0r zB_b3wB5p)^{MDIn{JWc>Nnem`Fh)P1KK^C&jMTxFDzqJ1x9HZZ+V1aKR{wETz*sh} zw0sU%I|s%r+ig02Ce> zUuh^BPLSeY&Q?*{rY?Lus?_;DW})ZRJL^{=9>uLB2IMJW=_YP`q>n8(&ZuLnKMc+q6d!yUtu2R{*Ki9c6VXT&;jLigb z?GX>F(#FydyqLqAa}Nrah3o|xQ?T#(>iz&}qSbK%K?n^WLuX7aVm~A17xZ3ZAIkp* zJly{ccvx9j{wMyMnft#pRsNq`Rql9BDj;F)Kf!f)S8aC^#Uj5pV+!MG)|8SGm!pX? z#=lPs*XWj!jL}w^@V-2pWMg@@f=I+-OGB%UYsG^=ZOJ@&Z#mD9)+|--S%rK_14KPK z8!vJV4+~RppPF5IH})=BpM1V;pYLE-+t<=ZX-8)f6RO^cH5lqvR;rYPue%4QfIeQ` zLWXSznwHz<-PF=r);V^9k_};hQpy@Z=vEX{22l%dSKH<#y7!Wf^`D81%#eFPBrI)wixjK6$MSm=U2vlGXQ zvZ{L|P}7)GYq&;oZ-}yagxp>fc~PL<#3^VDu>2tndsS-+k}JozMj=siBfq-M8Vu>bY;D>nKx>1i`ygTJIO*kG? zgGM1$pTG4o$xlhc0&j(4yu`C%L)^rJsfZCfbG*ysb^q{3+Wa08PO9AHNJR| z_Z+dx!GWo!w6?BP-Em+ia8u4;(zY32jNu$b0<_W`5%NWP>x@*|Q8T>mD(GIW?~gyp zPfM##c~v`uEKw5KCm-njxXX&T<>>(%lC3AoTxnY}rEkRFFpD;9K1H%0?=38NOuMG! z8_L9{2&$WQiqL^&9LWq4%^qO_A*mj?eiVH6QIU9LP^hC-JKqSbY;oCH4Co%&C?=hb zNzf{*5^jV*h^h@+UZ!Onvm~_Mho7+Ukt!NPt8MRW8LGXyjlW$)3B>mJiCk-8s+gpW ztYR8OPk!oQ0EGg1f*mhLHf18_4IDQkMfB#;&z>flTJ0Si)r5tm$E9Of{pF@Z>g}lO>hI=Bzh| z6O9_PdF{}^zU>XseKbmY&@9}LLn$K3b$>-voVgzP@qj)3h$|z@;r5Wb1-{eH`VbS* zwhox5z!BU?Zn7s8T?m5(?1l@o00c$bWMcgmTN?0l{Qt1^j=`Np-L`jZ+qP|XoQ`eV zcJdE99ox2T+fK)}ZRgGN-a6;ps(ZfeTAz09nzi;E>$m0@RY9Wg0nMkHT5w%F9H(2> z2|XS}L<8W^(H%6WP8nNsc#+2-HGeF5acXAWj6)|HWo@2)%T8vP0pJ0iVcnpsz@+23 z7R=hHT!^d&2>)mY$-bqIVj;@ZhLXoQ;<2*t`QMWMfWKWfK!36Z$B&6HN|DIgf2BxN z$$OPAwF64dgy{p$fe98-R0lkh5tu(Li9^w*C}OB4&U@6bf49wTF%8re;ZI z^O0zFsnGibMYN^y5C)?AB#*pkNLeTt3U#zjQWMC=^X^)ov8VD6NK*`<;Z&YOXs{j= z(q7Tc0%IF%#rgSj7V~t|ut;kigkC0o4OS~G)BzmTN6#eN`wMv}Tr}~I3veT7Q&Xb$ zVJ>}-Wh#wtjuH+X880m0_{T^?V#473R8H!!nk}&lcW^=o^Z`tHBPO%zY?XEDWbg&> z-x|ty*A!h?)b@^ z($cNW3cn5T=~{{GS#T|Id2MKw3}|!unn}+;03t*@h~AjCtBe&~MfhM|s_rqgIKlgg zdm$8A6+TbYb8>@OYC>dYO3$$WjZEV;$vD{|ns3WnL@?`dOw%=37-pt4UAK~UegJqV z2`N1^L#(W}(eUo-%Ydg34u`8!Jkx;qqEj#jT>Vp^Yo8}3qTu5^(-xj(^uADfwg;|z zlP0I~4{Cc&{>CwHE0oBlvpDUG&qT`L@E7)1J5`L`@sq0zTckPH#3eViJke=wg@#uo z?d*A}qx(f_0DZD#erSL!0@tP57Xz5xrVg-*}iRnHeb*&t{4CSS9T5OY10>8PaHQ|{3BW$7D2p!?Kj2z;bYdQ8;f{`5W+lh9X#rb4OfhLF z&PwrOFq>>;S@CpW2HC2=C;XJ3xiSIvo6%_z&S)7KrO_%WWCD7w_PGyI6s zZ8-(kC5Yp9ADNdu?3>|=kbsD>+&Wd+jR>R(a7g$fF-7v0qr8D`_?T`(8pyAf686p>eB1yxrih6u|=ujsx7 zAo=8;;mg#+7$JWBFN^^np)aVDn7fw54|ca!I>4Zt*jFb)0v74r2!KBrng~=B1o7D; zRtWjsXq_PjrBqCno+Kdfl?gV7jLAa1hwU^dR;WPe)y)*!;WxC+g`p-$81<3lj*kl| zN@=F;nG;dK_?i|-%+xIPIS#FXfkn8z2C)3-;v&duds2eXe0nB*?1W)9h9t~efe-^( zY!yBOG+C1_hUBhjEFiA#1&Q$1&o1&r#pR|sl8E?%)wKyl6W9*J!QA!1#=>^R#`Qt? zOneb}^Bv06CF^l(a7TetZFs3VDKT!%;15f-znu&=@wgqIdl6F%t=w1?%~VF0pk zri8;spkd}!>y2Q|C#dl;eowJAi~(1nHK@`JJ$Dg_1Xin5P@Uhs z^VU?HSPNY1xSEJHsJiZakk;s#E;z}(Z_n0?z}H@Xal~wj*KpOC>h8|n)0wu@zkhyh z4nut2-dZ;faensC>-Bl>Qa$4P8C9^Zu`Y%Wo0rHFKHA!J4Rm!Yc*$8Yc9Et<2T?J9 z6@DF&IvknqBmxv<>x$s;`rKhgIP7{S>-b0asoa<~AgP*19{sSJ>#$h{o_^x}G>}W^ zqbW6`qzD-$q&Tv<7it9l;XOCWvQ{3of~;go*O};xX@}d|)XUU$jU6#v_&6BDO~6_6 zjWBkdHu4e=kapRI)0=uwb!($}`#F_3f>J^hCvimwVgd%(W&6-p-Vb+%|48D=ob!tI z4-eZKk0jJWdqaFsLE{eehv9icc3)O)v2etHU!v=T1VCRNxypD)@-{wxU|0Joxv==7 zGGyTi=s_L+}-q#tk4A{ai+pS%K(;=2x^<45Rm;W?*A`y`Vg)nzp)P4ugxPr+=v2 z)qiw5=Fgreb0B0r=faF%_s}YC80XSCEajoDf?2n|Rkvh{38O>&fXgBjgbst16r*&_ zTpW;X-$*Z?odH>eHhnpwy|`6lJ>}5f!N)j}hyeJ6a;kd+;*FPQJTkzA zV+p#5Q--$hGr8VH%2C5d`=$sK|GRady1X>zc@Jr85q>Ul#2LGR`@34=NK;gftmY<3 zA+JxXm4J$RoP9pl_V^ne{0jfv-Ayr`xl2KDTo~CXE}v}#RdkxJ90n}-zDk)M z#5N`a=_MQGwt*}!9ZW8I_?NP%pX$w)TY?m7tiplvZ+UTA43XLMO+12x`RqNzd>odj zefUmXu0I6y=f6kj`BSGV9m}P7FpP)VZaTn}BWKvjehy_HVeV*h)KPst=1lacE5?mvJ%v=EWb$bqUq!sj?~dydVxOj|y~I%X&d^EP8=0lS7S?x=n+q8 ztKW@v>RK-3iFF>K&OqV7SwC5nNYnt2mcE~5GRi+U)L2A>yVLNRFo3OW3h0Ce#sBq& zKTSe%pnO9^SGpa2zM^zm)6$XjB%agt{9FfUai3Ml-V8 zp=0*`vuCE1DbO4zv^^B2!E?uhS9ZFkcI1!^mzJ3Yu z*03MDYK>x;cgQ^l(ClkL>b~s)PtXU7YZ@HEPs<2D4J#>gL}Szjif+azTs-7_G9mp5*<7X;x2gJP{))y0nYvuF1t@)4L zzb9ob^652dR~GyoQeOOH{9zrm6`4*5I@LOd#g616wRp>^Oo6mcHI-(7D5%8ge>6~#2N`{F4ntKUpvO_uM)khNV=OpOJJ0IZ$*I@EsN)!93RSK2Tew(4-vE*w-AXRnpauj!a;a zVH~6`FE(7Gr&Vv`ZxrOMEQcGu2@vT3G19SDL~C&cAcOU5zrh~#BCXTwgZu>OL?b?f zwx~KN{vFrIARbb59Fb9CFmOaWAMEZAsWM-o z*e4|K3=*8f-B#>1j)}hHf4VdwPE4IVuS6*J!JgHIv06EUJX2Yq!}QgITm$t1tOgUW zu56%*^E~=0lHZAu&tEI3;SY#FZExnhQa2{BqQSCEOvA|dqqh)s$}!L08iF{Pu1-<7 zu#+*sAvUcj2=JZY!brbQ#f3Wkx!s6>!*=^)W+z2T3jZQGc*ChPRV(z@h7F~Zw$<~9 zTTK^#M%2o>CQkm9D)c53kdi_NXlckh7Qj*kPV}#aQPdZ1Q+|pj&9*8BsxV-I<3B`> zi2WP0AfCO|Kq-)DN;Xl z)k73fzD)MCcv@E!m+QqqXg;sYJOVYxSym}<6!cHe|M$h^{+@4F?9wlTE*q(%DMm_a zUVft}^Hc~YV`R2g>pGYbBy}R$71tW&@MAJS7;xoUoYNXMhv2t$T~++m(F=Ng#Q_KM zy(Mfft#GXT4#dWMDIg>T!1-kv$YS%W-#-u>8ff6~miu?5zUMT_xw$jP*c-5}$>-sT zxQ2coDs4meU1glEo3Vo>eevg7tM=MVZjVg*b1_{X_R;s_jqE+(&kY&rxEaKAifCu* zSBw%F_q+V+$5%f-ULc08*Lz~xiAEL&^6^T9o&}2;qZe<#A}z@qKx*^vQ*QGWgm-M& za3lAQUq2q+rIeC!R&&y4`jL=>a2DnfP<9@*3ztz0L)P{>W3?f&)r?jx)M_O?6O_6C zPfV)X$~ZYEOuow%PeiQSxzzJka2fXR?uQE@)7Cx&lfN^PKF=}(Rd-!m-GZUz*6xwN#*$;IkJ^$biJ_Zh(Z@HznIi8!yh?#W(rTU(oOkkXfZVrPb08D z$ZSH~-gBfqXu1n~c&`s}YJilvvzq0TltATtpJnMVVIBxyTWO0_G_Lk_zz0}%9ue1r zHPV7PhkYT<08S&UJXCX^lYb&`F~$ES-x1#G2`|yXnkY5XNK*p&ZK{qUw31NDsF>1+ zQItz;vr)6kEI7H4E`EmdcHLz58levP49I9|C6tF+c1uAD3|;?|%4F!xEUk$-%D=-3 zY#aUKDE=|`OU}%MeUx%i65>tw!_n;nSq@VaR!MW)2=Ea%wb|K^Yd+DBdt7#N#F3Lk z*dGZsbFz1)Cd}n_T76^F5eTftqwScrw4-Z*+Ene{#)X<|DZlYJudAiaGJ}7CNxn3w zy(7n({ksm&+bk#?32X$dudwx2N;@vXT$y=!sUbNc$@juQsMaB=>BojlCW11k)}KME z^{2Aw0GW+TstEmsj!`Z}A>IVhjhW{2RzY^MTG8)D3C#otmI=v0e&+LPES61=^r?+L zSKU{5FB{T$B^jl$aTUy{MC%S^QD`h@@R~K(;X6dst~&?kE3waTamiHfygo*Gla*96 zSVs{C4yvZ5oi>G3CK_w$M$2El?DP{(kXO|vfE*_xrCnI?9c7V7RcCv+eBs2DKcV4H zM5k1f!VbUHt{u&`z|{+(Yl=~H=Xcc>YnWgdZ-llw6~QRUHQy%bse&HW;v6e0W$Tmu z!u(aW3GVqwiDRh+KyeW&L_M$-!ef}E}!WUuZOdAz&Zt}kB= zVb|=^t1})6!kSWg+LZamOVC}{Dg2kJfVcuZUfYoZ^;I=6H$AO!!42X(FZ<4!DFwf+ zM)S&F&6xz$+F&ISL)H;=cQ$CNSIT^eOu8g~5XHqm04sfaaPq#hNOB`GuRX7u+fBZ0%@??s8COpK_Kd`WFm|s6owrNdld2g@t z{D1sQ{&=f6#+)h%;DJ(&wekDz9K!`f)^VGw@+<$o77Z`* zy;aMSpi$>vg)q!57P%XrwpH7i8j6}-1>c&UR?h5@QABiD0O~fs9Nd?`lEMEMh|6G!S{92+KluTW0ePIt$XErOx0boR+lk#oO=yR?jtD{5jn4V)Im!R5^l5nj4@c{wjK1d?qXJP zh-PYn%h`oOYp-PVrG5gSn}6+LtyNT~L171QFgWz9V`3WdWmm{tQxME-9|GDNfK%HD z4!vgO6kH&#zE_JX`4{8Z0j!SEJq&6V65g2&`q;FI1@wI?k7AVd^z(IGUMc!*$SdN@ z40YFY8A|UP5sr*owUGcwy;shQ>80$yqmiqknI7MgWJ8C&!QD&MA7>|hNQzu?~TOIr- zL672?OmO7*X}y6uP~iHoW-ScgF!|r1}m)<*|4C1GKz+MW6k;W{gU7tJ_*GCG1c3FT;Cq*@(+}sZoVB<@k;lMA;aV zTD>LHE_r=xXGI|@tqVHkO=k66fsQNz!99l+h|@yT}3UzlIMcUI2(0c7hF=kOn^o$CtjuDD;GcUIo_Alg4c zW=(_hmqYhaJxO-p=-O3c6Dv=9i-4mMeCva1+b5avC9U?3^$XA6P{&5kP}QAQPiTJX zGM8IyKbm;`0^BDh@p6k3P5`^WO|V41dg{D-iXG~xn4C@LZC2L{V!j3kcqaeXE_m8l zUqsJ;244jkzS`Sd>)LueThPNN)Y_{3$r=_HnjyaCf}8qtP3^X}Hd;SF0Z*TcH8UKX zU)@C+xZArq8G=6W-y2_M?;TTB>+A0c;z0zz$D9f*n-}qHiu0#>X~ch9&AAvDBdAOG zu}=~3Y)I42HZuh$I+pjfR@W&&*wSfDH`UJCKhvsPJ=g!l_@a@0TnI2%_hwce#!J?I zW<#$lRl(%xbKkS%om_e20VL?5IXi0VLMTKfn>&IK4TdEPw}`ba!|3TUQ4PoQ`aZT=GIF2pin-J2k?{)_?0W{k1EJ z!<9+ZP{^U%b`{?djfdh@pF?=yw| z0qR5WwDn|1Yb0X4Sde=rk=z6)Bp*{)AS2`br6A;;y?dxwfbRs6gf&A)v2d7@Z!tb9 zZyvyMWwxM8%sa-_0MdkoJ)(a=kLDATuA;bMldgvh$v(T%x@Z|#OoJcwsWrokq@>dVCo8az=3{_hp)&P*EcXDcCZ8Bs5AYa9VH zmlL<$b7g`G$m}n-!5LHdvxWU1ybl8S5TqL!>&6IK0CJ5)^4$x&KfRpl3)Jm>5g?fz zd_%xqy5so+?MN7B*xfJyyb9>Ai#5B&QRrG=LLL2Zboc25#8r@*%Pcz)j_alJy#%mw zXTH30tiXjgk_=6MruSL0nNKIS?XjS1vZ5RCbn6d zn=u?Ipj9}G9s5s&TJT2yOWhWyh{eVAv`%CGyAEEpWFRZX#kpLLrp2Zu1-=Tl$U(*zQ-ycFb+kl(sAA z7fs1H@Fr|lZ#hQ*s?&b9Qb@$5t&#}a%ppb1sXU25*i&K#rKiESy56puY`yyXkD zpRmNmfp~L&YP^B=#_R|QGs$6s$rOtvmt(&(N|l})4O(WKInWXotgZy-*uu#WN3~SIL0IaQ4a3)iafFRKi7;>2^?bKcV-_OEu62$r$Pt^lM^(~K;McI1&2Bp6VCH@@Ly=4~U2|CBB3EpJ_ z@wA+x!I=T0;7urY#5j}Z=mS4As6hb*kY2Rt1LfC_rXr}8t}h&blsvmU`n^k$?1e3tpMFVR)n5 zhDIy~U%;YFmOAd;P|PcH<&r}8YoOS(e7K|F27ZA~#s<}^^NpiMOzNFQ05eZTG7yiS zdiS4Ms8>g;Tk?(w6dT}qH-SttX@zf5xyz-B_rHhgs5F})y@)^c>SR%xoq$P-Q!#x# zQAMT~a8nIN_5cGaYSfyk2^Z}z=j$RdG~KH8(hPQ6{L0i6=sNq0gs)6r7A-1Q&Zica zP+#{`Y6k^BrFI(^s~P}6dxgs7abq-z-nbinQf_4?dO&bW^K&A7{)eFUg68+l%J6&( z3jO`PAcIj#TBUkrQP@=3pt#OG3o|Mqk=w36XtuUzn1Vgopp_ECB)@cg7%-*8#h^Mz zUQ@_aWIm+#S2Ux5?`b40v(+I(m$La-yl4TCe=o1Nj~riiaS;bFsSo&O_(`Qa=yD6m z0K0*@%rvf(IAHoB5u=#7Y2VIU`qW^NRpfb{5$+=2_?dw-V7jvUg^p@uY z$VZydhyxPR3J?;20Mc)6VA2hG#c6)wLZEa?&RjFmsAyhrmiiH>xVNpQErk~N0 z6>MGfdL9v0kVD1$!lnaw4jJceIti*nyhr&RSU6wO>nT1U^Tyt&oB;v_TpF~ugH8iG z0?HjsDF!7ucXEh^aF$3-bA3n=QfGnu=xszd6N`*g<9hgn`krINrFJL8j4I%fv_hh5 zw7j4a*h@N81^l_)kBU>MFfp4qUHQTlYj2XWV4bqMV2bzci6c!oG>M;V-tdU{_lZNB z8|gYz>kts2l?LBQM4Q%Z*054+zEY0UjiY1(Sg8Xu0O>wE63M77%Y?tH7@ArA!kMg5 znkY#u>NG;U>v~lnEo>QXQp5Yj)CHMr3hY@7~dgU>NfTLAx zkjy4qPGpwq!>q118i>nr0n;&=ss9yfBW{pg)z29W?}-{x64AAfq9sojBhBj|O#U8F zHi?x7C%L*2y*&Q9LF6fdYrnR-MN2~JVAt>+plP|)n^U^k*aK={@dL9E35la?e;G^1 z&u`vdg4@x)CedpLUnsNopZreJDA=IW6|HP(vvnAV{p}~OHd+Z%O}VNl^aQ<@H@ITF zrDrpsltgM6PNV0_4j6)prX!2~YexNF$y$*7!csI#=y=*6jVs6XE;=8mZ}}5!JUf1V zi5ZG|3?>0(Hriu6UROcu#czX6RY7dsM@&k*ikgpitz@Iqhf^O!;HIqD0b{DB*Bt@L z^%Xwn&d1yOnBt#u2+}~O@|&?*5o6F=7@EQhWSrlpa^=USLJOG z+&4pk7v7gAwB5$8%NoO`tl1{XniiOFJ}OFHaq1c@%`&tUjdEn8h3}a(60k;+82&uO z-@31MyZ?Bt;Gma$7Ng9~vU%Y4I7pfFNqr~9VS}GDr~}aP*hSDdeCCGl+)w~KK@I8d z5Z4_|07DcvS>PkJw9`9)V7pAu5=SPjIj)d-O1pd?1%A>Gnrh=cJKW>Sz?3BIy zBK6Ufo7n7rYz<8{|8ND|>zfJ5G)4X|D(=5YCL1gJe@z#%F#j(gllcc^QUau6Hd@iA zohqFDgz!~?rH|y0g%KPtu-y%2BF%Y54P!-Oyd9BR_^-|!`Mw3N6?Ig#q*e1bq2WLe z&rlv8BnA8kw|{l%C!|+He>s2mwCnP}>BT=z*?|*QJkwg$RBr-m?3QC@>cB(vtwi8- zbM$N0v`@88+AX1Ut?8|XmjK5t6@;|SajIRbPA~PQv%Oe){F^qWkH`!g_8zV+$cx}Q z3B~Op-{tNewstemi6tbvwl#vU za<{#<7N?d{kZ$npj)Uut`q~$bN|1h3ToYUU8w9SxIM*TS@Ji1G=P)`PY(*OxS0Ynqaj}-^ukXNkIMi@8Mgt5hdT9Id8VoORO(kX6Mo)`V(Vkp2)9hY{1K~7!B+1OA=pxvZ@dULDh7Wg7 zu4#j|5#yaUkWgW@Wdm4DTx%>i@c}n2D4JSif%Y!vP}xgJ zn0M%QX{e&+Pjnd7*-TYJ4iEt5xU|oHkzQK{JUbZS#o9{_IpBl-Z?#?st-D*etca#@ zPN=S9%GJL5HvKcDi<~1&KNSKQ&1l=D69vsyj+P&&IM#)pGU#u+Dw!Z--jS!v1ISf-WeMwpdt`TA_p+u7iOL9|V43tC4T4a#4ZCmYaqmZ++}(=V7Z^` z@E6f={gp>79Iny_XRKLcpa1?m@^|4cOefF-Z`jJfTL8p014r27(OfzeyFSh84}VTi ziZ30$AHcDwY#i}gHKY^dwh{9RzJ=3+zks^DGbO~!^t7iVSZ}KFkydbt5!qJfoj~L7 z;76Sv9xw=npp==g+?K_t(CNTh@tKv}d`_QOro=w{LbJ4Cwe;Q8)84~RcacXl~;mt8_@s(ve{U5cbA&Y8#KoueE54B#o z$+dU!^t`IlyP{M><1}SJ3L3=+Q7!fzy#}FNEQthHn7HH6t?~;SBi?4>H(xW+R?mdM zB&d=Q4zZsfyV@VkgpEb$13nd8i!Icq4;ERL13w_ee=UxvInk;kgir+zNRO0{4XJNTpJmD_%JZ%jMS8m}OMIHKt(Cv&NoK_26d8Th!K zqX+kioBtunw|?g}^5ezF=)S(0sZKDqXM&L03i9oT@rYnfwxm1OUnzM+f@i>g9^I)W z0?aY3l4IxRw+`aBk9OkHTBrQXU4kBt=1#qRyq^8UGm1YWr8ynT|ZaBf02ArWkHUgTr+wy_>FqDt+_M zfojjbav}sdPG1Al{X9OLesiSF`Q?J(;J3g2YyjCwswYZq`0}E;YscWR+OQ$$B4B1E zgpzpgO1X|^%bb=*%mqBZj*BURP&Gi`$R#o0PZGBuA#XDJZahrOqida4_}LdM0@(e% z4Ndu5B|>6)-Ad|5o`zJid!I`0F)aka*Va#AXZ2S0KpIC*d7)Oh-&mvIPNtKZZ}|PM zo}4y@Lg`%t=cz0)K@r%yB2e2v^HtpjJ~9pkO%pyLbFRl zb@xbNc9V}Qu%mMuhh2!L6||VZ<~jtU)>UGVdbBok(aZV#G4tvFrv9z@Y(hApDbcEN zIZ-gT9+bXsYqmlz(PvCcCaTTFX_iyqM`(KwYsu9(4ojnF$ZH1eVrSP%15onDROgzc z_GJQmd3I|MUgu;1H>G0*Y5*=KX^w_}iZv_QEfEU2~}bTx*|{BiI1 zJ4L5t;-|RRV{dlZE^bh92N6W% zr7#IcnjV03wSFVch9x6{=SpNH_+e~4gBn-|@=k? zaY0Ed8-Wa?D*NJ0Z!${f5L^gvDh4W)!stWrsih8OgKo2nek|!ASWMYA=jFHz$G`J@o-@e5KQz4aByPsa_2(d>kk{PVy|bY%s}2b+L;2>+u&eeD!4l#^z48r> z3NLYFimFm$2B2Paj2pZr+ZN+z=WLc*kXb3VDYB-dWKy`Mxno+seXOQ{wpjI2A1XQ1 z{l~R|eA}KKukJB;k*+Rp9Fme$Qa6Z}T4-KTfYD5)H9Np}0h+uaKY@(jT)cXs62GCHOA01*wvrbG}c3aB=169xkB)V{;WRiECZ@+Y$>d|?5vGtuzXn)o z_fI(LKfnpWQwq`{kUg-XA2dDDxc0#RUwh=`f-jRzdgJ1u^OQRC2fh>%hw?AxGdX3HJza#skV!(;+KOO zpt(CJ0ECPg0K z0Tpv3b$Mz~-J_1Wq5YYgSo5S#nu+ic@QNcM3zp*Ul>%^vUb5@yiH>aT(vS;5IY>ck z$#h~iL%^OJYIdPbBDU0OaPs%}h_p`Y#J-4O&^}%XNk&IdJxBd+a^q7b%!aBkUG4#2+w-DE*e@xt>Kz8);2b;hSfhpWuYp+oxq^PVGW zPAWG6UEhQC8z0X(Ts$=Vs?pK$Y3Z{Q%yYrrcpqv^ruy`rZ#czT}aIg5JacZ{tawVNIp!_31Ysp0(%a==;9=uOXK+aP_6@eecXb zziqm=|3kq1_*=KOI{T5)rd^UX+Pl0uZ(HW8a*ZmQPO#SXbnUyh>Hu9EuJ51;^$p2a zS67Igq`}U09f<1H&yX<3=*k@_??D?~YlL7Q^wjHJo2*JhCzZ_SopJ{}~Y}lK!0`${s z<**Vbr`9uYTLd?|eF2{X1yfM~o71D=k(ZgN8T-DPbwWEp!|Tb@Q-oArAMWol>Ae3S zFq7i^NumEBFhv)l{~)kwC4d@L1L`|yr#EGlDD!}g(r_6BcM0+`72yvBBLZ zF3D0u`^)bv5lI_Mciu{dQoP$6d|9f7KG(w|#ri|RlmVGa|Dj;=u~e+m;hSAPCy-FE zCicY8vVUW3p2-Plt-&^ZkEmg>9PML89bXg$=*o2abbeE`ZEX&Rp@*l5E<5^g@`E1Z zngyz#Rq)7FZ4z)@CK5Yb5z7pkd)LHMfhR_bvZIy;$oLBhY``WKZ18V6mrM)xf+LkA z;2h6i0R$k;KKbn(HgIeHI6YqyRQW4$z97dd=SILiuvyW?dlN_rz;NQ8O;QQ2Ao~CT zy4-LK;Z2A6d$Hq79ykbxIiUdk-c)krD>GLWHYto=g?FDxd6KCiq#^;QD)?!pRN9@J zb9vKGY>O6FLeM3i(B$J$a5D51rbV`c=;n#UfG~){-XkmvYg8qjw4uUO@vOh77Qv$7 z@IDlTAUNk#!B$YBb*edt4ZBZnzY6(RmGQ|H9Qi z1nAa4T4Yc0wAjf#$~u)RKt*)geV+IJIsjz=MHYIvoVLsEx5j}tZWM&17;JRC_fJ9nS_C?j z3rgjpfi<`gNlZ=HbPaFPQ@sI|0Li`u0jv^%^>8~d;g2#$OA)rJL)8XXww z%fKIIsetvD%X6p$KD?fFRf;5#Nn)5X+h690Yf>Qg+7EI;cBiuUutKM)uxsL;KU;%i z5pN0Lgo8#L?Z0`tw)V+FiNPA10W|Ct z>4C^cB#o2ic5qr`WLUQSw~7|XT-;yyS!%o?t=IHBaH5)N1AnQ^oyLA9wiJrGnxPsP z5^(n3)5j=B5AH33kic^ST&6@lK~7;fV)CL_p-bO^^vsZAi53&UiMpWXMv=o)hBW`5yTKcVbOzPp^X17V1V1Wf`FumR`0 zAUPyXx8YVEa?g66?ni_EMUcaaA?{{j0m`-Dp78<-1{yaZ6bc(Z2nW0I10>CGYuSyW z#ZzpEB4r_zq9RoBNg;=ZOY!t+4CcN@Mje)9-lT=i+rS0>9SM$C7`4@bGI>W2!7A}M z^oW=1f)`&&kz(Z6dzB?oL$@FJGjO0+y%|}98r@@H;}^|(2A`0UNQ zYUQ&#AkRDlwv`&6BZyXN3ZPW@EhDSuG(k(N=rS>+Jl0+6g(YT z@b=3FE68|979KJMOUETESOM-)?9{G@c6>aPWjKefQx^QO>uh>FKWe%W>C!}Hn-**8 zxY}V_LmTlc5rn^?T9CZ{-yR&`OuAdF{y6KLs2ylzET;McVlD>59>BaOfv-Ln!Lff9 zj7h)ZrLVVuoV6=<|AL{1W>#eo5k{XHMilw(xP6IO&bs7q9AYxk8t`&K&h?XqfP7m> z);PXylh(=%4-+w+jMY{AW800n!1jW^<}nSU_iC{CF0@|-0e_kTeJ%-9SMMt7Pqk3H z>?8G9T@MjlRqz+(7a)CqEhctcSRxFi=PKfF8)1$_&hELOr11Nl!sU0!1a;*|B%vaF zWj)6+!q*d(Cfu0f=`TqF%KkRSI7*V|;H`snOKIleVk+RNab>iC;?(@pJLEeILo)$; z(tr-OKXip?{C==XeX^WH==4>B_MjO%e^Z zwH6cbAuTqeQ_qrr`$b3zUmR@?J1OO!V~{RD6q5aOVlFFBBCa%K#gv(p^$uo+wpW&C zXNMWK63v4mOavI)a!`vd7MeZYVR+8=yYa=C2rSei)aIMK9V3~+7xG1FCzO9oy7P}@ z?3)sHm;(67b+1dgv+r6?r#)()nieAmj4k+$&6|d~-Kl3BSF?>JhMYJVrlAQaJv#I$ z@Vn~yQ`XQ=CDz6>C)(%_^K^DsHk?-h;+BG5b4?|ZC;%vH6?U=XhtweBZvPJEk;>Bz z57%a6H6-D>SN@}u1ob1Pw*%I;i^o)Aw`cbT*EBSSe44b(f5y=Yb25pPx%mbS{^5Sk zZGqtsQ>L2D(chsslcbNms925lnqqJ?DtV?sX>hq{1!U~W1NHgO8+r^krzmh*p5Y`A z=*lknT>!jYa{*)0uq-4a*O%Sc?e~`7&Oq(QP1YbGXN``w;-oNB#?6r8O4i3m+_^*P z=RQf=yt+4D7#NFV&b$HHz4?=eyg~VFMqt4v@TwBK;taKT#~h8Ud@ZJ1xOXSmy~-&( zOU;E)e4bmB4v@cX#HV`kEg>BwdZEu+wD2z#$^ec=4!TSXu}v2?iKkf;X>+Of)#oDC z6N35D$v@+f&?-mw><~1WqeZxe`Rn#VG(4S$h4Ikzlu3<-++}P5DX}=!c(CPK#48%- zLD~-PMvB)WUC&z*bB9#Tpj+d-2t9Po2+18_f;0SaG55uTfa0kTu^E$82Lh%!jybg) zD?o+<5@R!-+yyh3YwfjLhT&D_f=tRLN?-=nk^Ar99Z;T`!$4oqq;F8^6!lQ6@8v)= z4F!*$qCzg>dSq(D)L-U{{)vMgsdVJvJCyTaF!Sa2yvgXywWS&!ky7H5a-Z{<`5%FG z!Ut{}6y%y|o3Xe_bO~`o>De``Wad+;*tc#=b|LYGEvb4 zMfv}PGZYMEOK&JtOlaHCP^wGdVe!{bx1!bC4>Hs^AP^3ieSm$64CQ;bjh=kB8Ihi# zhZF*2VAN;Imm!^d?r0Ciig0gQx~2Ccro8R%j=C~e_^>2Xbxaw5S+~A5>TtX1R05nW zK92hs)fbfH?R-qjIs~H1>3qFzYxfz52Yjx?*Vr@5+J2LaywT80ib-^2s<7m|7Ba99 zB2mg}IOQgH3?D;!ly2_os`RD2aJr6twjC)}N%=I#NaUSGEI8m^adwnDp^O*t!i#L-+iz8V$kXfTp5;Q zOr(EHsw%QHxSewHgRr2PpUIsH-8lU&y)-?;DR=<$APvErOs(Uk6{Uh5sffX-*%UloU&f>Y{Lf ze?DWDp4`uhj}qo-BM>$qm_NZuq2&IqzkDd!4XgONceHRf<_^{g?;G;Gc3^%UK-FODySG($+N%v0F795NwQmBnb2qd-U1)1M4(-bP z=>^~)Hvn;Azqg^jni+UsiLK7!Umv9bL(`JNu5(pN|qog3DT&o!7AXG3-fCFH~8mxhW|v$ z8fVO0*wcZdp%BcSdm8^gw%#eavS{rVja{*A+qRt*+o+1|tk|sBcEz@B+m)nZTQ~ch zw*PxhyZ3Fj`8fFX@pbS-k)d_VYtam;So@q>*-EFKx<$O1;vH&Awr;NI%hT z)}$~QLI(kLI*WQwST*zkU0m5)kx`Z83(+M*ti~=Vqsy3V1YlLRaQQzqGy2UIs$(k{ zckRe43Vze;uO(hrfR@7$O~_E>HfO2LM;sQ-Ll}sDo5NuqX0ZP%M)=$zCl7{whE>^i zOz@^*t+scFd>uLx3ivdi{=Zv(%qG9!SXut3=f}y#_CG+D^}m1r5Ah-^_y0=AmHGDA z!I(~e`a4Os3zxs0TJ*cZs;+8Kk=`;3{|~-ogAB%8y(Aga%Y$bPmrEjuOuUt@dIn$# zAE1+zQUw0AZ%q1U zXrMF-TB%2Gd#k%ghyVHMHzT1>tPr8!1B{=5Z|D2e{@B7{!yFu7ETtLP5J{7;qCCL1 zJGQ=Zp+d(y7OW1F;U)`9lX0c9u5IxnXdRTZEVX{B60@@yf}6hMlTgS}7D6rF9iT%} zyDy(H&Ag@8;ay~g?jvpv9XcOGu0E|R>K4km6I9rH_fN-gUMpqoJ-_F@q6LTE@%hm= z@E*~|Y0Ht)x$yWy%>EtNBKh=K_njHxL5Nac7^&Q($FimJ>*Dqt_5C4kIUQq~&0m5P z=6*F2#fsZHbA*8xJmaH%Xrvw62pJrkmTsCvvKx&4v)Ns1`a@Wb2?UWOsl8wGA1)*m zj+(*llPHgKP2sohxFH{aiR1>wv|FR=Gh6A;oz{9LBzeE5R2Br>-}MsBvyypT@L{PYB+PW5DxjbUz$6b?1PBi)8`+s-33~He&Wrb%~6TjN(`0 z+vdI()M;E3QWXG-hlHNOWV#GTtjbY?j-_$b+Xrxc7e9UQTW4hh(|oBOef|u49qYDd z&LPw;>9|nE59@#YafyYb2{6WC3g)1iYax!wYF+U`)HW zO|3OfGYUROj3q}&-om6Pfab{+pM>&_6Te@*qS!Z!D8si`A${fKlP3*#G%aR`@Mj^Z zZQnfA$wHwnYq8J68OX%~C+y^~66LYkAM9sqq}v9bfsP}KbapfN`9o`COK-d%>1QNB zc}e}0JhXtzm}{9wpGu3hm1k>3y^~LgwuTB4Y30#lPpgikj*x`1-f|+MZZWq?0-;es zPj2TFh07MH03&{!b0?YLHCt3|Q!gwshsiD(g3Zio6)-2tGjA~7E;Psa=gq>WJxMF2 zgWdrAGlvLZ8x|HT!&YXKY-i3MDP)Hoc>%!mKW3ZaG0H9}Zmg(GcfcrrS z9gDhdrF8GW0Q&e)1im_^-1^Ilrhk<|r>G-ia${M;%ocZmo-O?ZsSXQ-(4*R$uWvo{ zOl0T%=b2R`jz$NUJ-=^SP+)*av4U49hK~hgEzdr1j9pFEAHmdm>M|aJ_=`UH{AL)E zgW{7`4BvvMTFQiaM1JOt8a3-Ov+=Q?5!~Y>4ZSx*>J@pb1kF|QK6o49oT!>?D5?;{ ztM>w19!X6LL_7=8)z%3)U;cQ;`Q#Tiq3d9hwuyD^Ha@Ufb(gb6{51Hbl(IgKf>i|M zv~LWf38U+PX4Y`%Jr>xo*ng>r$=$Vx1)wI?6UB5zm}D=mu(|fAr792~@y62({j&n> z5&5XDN{S!R(k_|*d&Vo2hQ7v4{xRH<#05M{h1q!-Iw74^{*jMw+LhQHPV2rq+TbMS z4LZKz8402Q%~elH^TQNPlZy&IKC}@ijZZHOxT^^N4Pstv2e^{`7^sRh44K9KmEa`O z+)Px6YM!U0T;K%h@lDH3q6P=nh%Y3U>Dkl}II2X{OY+&wQoW3#Q$|-iz}-DhW45)q zErD}ca_o#v9l8aP^~N9|7O_^`Hs&QY7ltXpi{4a(qjFi+`VE5gNy8?tcUS=HNO3gX z^vDko4#(K+?~J#_`oEV4s-P>kGT%HYtYyq24E_u2L}|@FXWQ3)m{21fUEOI~jq1Mj zl|@8tR;Yoz52g=F^BT^9Mdb33_@cyy(&zI}iik6%!C?p;+}KM7UQ5x&?K<2>MzuXw zx8ENx9=1x*(=+%2Bt$}BdiLLrn#&P`FM%4zK9e;|NgP=4iz1sb^`|ybJFHm;8y$c5 zvs1%+>Yqq&EMX3r6(IByHZ8y1*f-gX&_?x#oeF9dcyn%ESMnj7ng30TvMj4UL;^y1 zh((QXxgIi(X4bYidoqJe8<%eE>L;=zT|Uz!6;&PP$-^Ex0L zYKh16-%@d4_T1(HLBhi!P>gmj0?m+4t+}r&gHM%uGSd?b%jLi5zc?*S{0jd0cvGz% z6(O1=_uJA-S2De*sjwcU@E3vVFkta#<@6w+hIVW)=QKZxU~|+W?mzX1xKgYb2&`gJ zoNu%WDLqvrO@$Y4U1$Rz{Jw)oenL`ATAQotdAlzZPhI@nc)zxQwJXwP_1;E5jJ#;o z)79MaW2iDj7pqO-PF#6TXsZhEaPsS;AY|5(4V= z5D1!);s8hK&D=k3fe35!KE&>pay;WmWV++9rrtiZ4)7wl*Pm|mg$0d?IKQ(UQP?Wh z9Z`ns+D39I6J&vG;m>`RnwS3wE`4T_`Iw8bWce49Z{hbCZ5dEQ1Rgx5uKAC{-_CBZ z$*WZq)(mqSK0eFG*JB^}v))|$)ecd1y;Q;6C#eXRiT7Q@szf7VGtZGxB_|ZtUyGk@f9mr>wTtuaM$d_FC~nOzs6?mxO|_*53eah@Wa5LvIUBO|NbThm#LT z>m847X76Wb%Dn;HFCF3cbsXXlVPQftOEq%RD zF(W!VmmdHNhY32a;Jik>E^xRIV=;VMDPk({?L-Retv1S42=(U6PIiacBb{|#%uImQUuzE0Zh%kd+0#-9^M2k9%P+}rJX++Dpt5OoWjWWPd;iLV4 z^r>`j&&0p&p1~^^Qa<{80@M1!t4p znj|U?6pDYZJTZRv(|>7t;Q?TI7YG#{z8}qA@#2H2Zx^t4)TY>tkx~>7Ju~;LE+Yg{uq?8) z2gQ>L`A2C=J81+1PMqha;CNzuByiV!lAO`tY)n^A5V2Lo;!tJyj`+WorD1L*GaG>{ zd^zuZnwX&iJ~t^bEQ|W9DHo|SMTVc}e59A+K3Qhx3wgGOm$6f11v_yD>vbupFSYfi zAuQaJGX&nFCbC7VC;ud=Q*iiFC8v#Prian-A@S$kAYnHw9q8n!}cd|Px+aysfbLMTCq##*8;;l^-QSKha_uwbPK z&Kgs*63+6des5Q`O6I;vVf|=Dz*3BiAwZ%gE8^4`R~S)`eF{etGAEyg_5`}Dk@8>q zt4FbDfm;4MxtuBrF#o<>GR@ia(5xN@gghJifXTY) z9auqY{n>WQ#^m3gFfulpS>0;`G|ARMS)yFO*g`Z)2Ji|orWA9a!asbVRO_sB>}ZD$ zPf7sF|7*9fl!QW=t7YIEqd{48_XDwlN_DSobk>6tuU3G~&qBOpOYANGH;nubie%;f zul|pNlMOD_VH_0wzfqU0Y;6AvH~u$>B2L7wmmd)vY3V7U7nF1(0AuyGNs{oKe{_9m zJ<^S$ik#@>q5QOihuo5z{15~M!J5acp`^X?wX(9~_%Nl>Meh1PS(j5s+o`{8Y7A|6 zbEhVLxGJ^m%^YN2e8Ag?>?vAD6mLXP;eF9=!O?zaTBg)p3{4#YGyf04pZDs21%El4 z?A~xs-|f!hDT7M`c5l#J3iFPYA3=1ciRtS|QxDQM9l#7=%dXL=(EZgm5@ zy`7udo@N-fHs7$n+P+?(uaEn}Hg;?Ty=p&9TxRn|0QF9@>>IxjO-uIE`pU2w%7^lU zSdOk;b{QYsLsqosy*9jBs$F@tR(xI_5B2mpl(xSgFi` zxf}+m@xJFN;vdLmyz;2!LC<3i#uUU^}C zB=ZU0rdIT@p1M5aud?GSx_wK|kz0ra7l39dOOct`gv|Pi0JO zvNNkR%rvs~#{M(JU4B~f6X!ELLqDnp-Ql z-r{DnrD&@GZ~<=#6G71k=eD%tul545zi@0IxR#%~*`edSKIQGKnsqTX8xGWsF&0Zgk*?tc_w z3d2FV;?QP3TJo@3nwW{f-ttLK6<*A}dcmhBlRwsUU_T#Ow@--G;D6lxLa*GS?};@~ zF#O`P@HMX{GsDW_n3bP ze(idg5dEx!a7f+j=CgOQ`2+ONE))$T$|SuoZQ!gA;HT^)RkDi-C_u&kPDTRMB#obe zKEsA2!me#)4*0jY^~4vPB`}Ef309yG&E{bIU2-GM^T>2Go!yS5IX10paz(yUDxHAE zo1Ck1HNloNEm|uKU_9he0BF!q=9yxwqQ5sv-JOshW&0#pLXF|aeY0+42Wiwm$jtj2 zyfcW&@?x$gbx{+@hkaM)PDAdYMp0bwB63jr$CZXR0Ek_q>UK_C);jJurjW2eaL0?r zU&TK>eI(D9@q5wY;H zm!%$CQzuQL;I?Nl;yyl$@5`0%9Ax6efA{4bA|x_!jN~*w!c%l=L%Mfv%kLtogj_Zm8(l6_hBJ=Kisld)FRzBV=d^~S%eReDNQ<>*8 zR2V_oEy~4;+bFt0VNX+UVaX871(IAK9>znr%a<>7us-)9#EXyYSo#C%ipkWnB?Mc`(ads*b~@X??1Z1%z#Kd+G;`H{C0tSx>m2A za;E^>D$uFP@7OwsY9_iWPz+~mnkFDDZQv4waUs5>4`}jE3kwO7n$!8gZ^B2w+n<0| z;d8b_=H(#kUD(IVsI99H{)!3bI0uye18wb`MqSW9G$Rl}8dkTpq4W9Mni!_{A)I%u7(X>0{s@^5>-9ySgQ9uPf=f-COID)?1`69TUQcg6P|>?n127& zWjHj;RPtiHGJ@Q^>b{F^A<3Xea<}V%ux8RK_-T?JdKs)ADc@%V&mek;j2f8h>9awc ztAo(%ouDJcyysbUkl!J%3+|)gQ9ZOV>XXS;t=vV+>2Ar9{GYXL@6)5;|N|H4Cg>g_h0PKSdPpZ zZk30}L#{E*N*UHlpYmUzs07|EU`O5XBW_YGT+L(46|-n)a3ggV|4WfERZE=U^4zm- z4&NdWN*idw(|?^~0sTz}0_~B-(l{FReo4EW!lVSgoE*jlV$IX7ii*F`h9~U+LpM3D zZDQPO$s(3>{nJSIn19)VH_*248P>ot`%No$glt!bnTJ46$%(KB-wBxOn!QAQi_#0b zFwb!FW_{y!Sme9}XZz4>@XneesHJ-g`Vh%N@W>TYBz7kM`k_FU=FAW_o)KE9Hkb?Q zKFqQS?U_w+{-Mmz`bElJ%@6_;8-lGUhn&@?MM)9v#5cpwNL!_8kWWQy5Wz>E{dsTp ztRyBi<0(3ltR44Hs}`sfrowWKsp8189h+y;w<%lpd~K$7Zdk|F`e@JI^FD&6ii5`Y zF+vi5881Nl4`Pvy&KTrWbP@?^?!3c^0BV|cioc(?^d8pFLg3A;L*;AKpwNUZA?4j_ zKCd-8GoM}Et_6@y{15A<50Mt5TVR}W zrJbvI0A?hxBt7tF_cK~u3@uQ+A-!&jA%lg>Kty#1nLHu0Go%YU#6>-UpghXN+!PDB zs1w@QC*&kCxB~Td*FZi)EPwp`u_XC4p4ze~L&5>HXP;%dZ63i%(6BZW|5^D5cp^0j zR%lxT78S2kwaq=OR4mTaKvU5caX6Tfxf0Vqfcai9Igo&&C_?E-R^l*Em*+>9fIpU8 zCGJ8F&&Gml4t-g`#gp9;Kwe^$F}eAg*xB)YoLbrlmIKW$j}v8i>p;q>d!3~pa>Yrg zbG=Z97SS|Y=c?Ejl=O^W_%UuPb6amoiPD`?XVg3q{a~5l?FJUazi8PWR(&xNJ@{pP z&T&u*Jf1kS`{tn?5ON~U34E7}R##TcxV=0jJPa;4CO7y!oDkE=8L1)?R_@TFUlvqW z`&j6CUVyO-h;g2Kizr`iSo-YlDRPmI{jsV03sJQKbd-t%eG+>Y9?>e-xAZ>m%@IX) zICo5!@K^SLE1%7S!y*AtyBrHU%jzW5O<9fHUOAaR_Jcj?Vv z1QiU;EI&%5;EZ5Jp+qU?E$2t{<7g(;^@FVGZEsq3vC38u8p+`Mk4%L~Hfx7)Ok#?@ zT#1eb2pW<@8-V%^2uzjlEI1XVEs{L6fZDTa(51AAV8!^jyz1E2DtdITFQ?M{*pLUI zEHJZAz(oYEB+fG40|(!uLlYxn2?DpD*4%;K|NlZ5Z@Hs1IjY9yJyy! zaR`Rm6rm8oFR8OWMk+klXDe}G^8Xs~5Iaj~+nCt4MV%$Yk zOo{a&qr`%`OH@o1pS+t9OLy#QKw#ZT{wOgwYNb2|B)yhr2h-46+S&K(j^A|At$D@ycB}-b zW2u;OYBEl#6~6e`w~MKcg!06Y7NOpL<>r%F&WMj#3x}3{I3^J4IT7Fji2Xw#@>d=`FlvOPAZF+9VUL+OW{S68 ziYC1`N@zmAW|)#m1l?H0Kvt3u$r5~MvJ+3?K&wjcIL++ZfN8I18bL>Hg5|;1cQVC4 zIdj$K!@tia&>XRfl^c^m`Xti8JTQMHk-s_><-3ga^(V}WNSjEWBIy1LsGF9>+`QX) z!}2Oud@b@ifsEvRYH>z?JU%J)_rSc$xy}8y(tiH%myg5 zEwW4BQNy?rG#W3e{?L~&qePAt)lZ5ilz7Z~6IWRe&xe=(GPyGx3Irqn|H67Uw*SI< z98;u>XHFhuL`kx2=!df2?h%4>-fJe!t<5k&B_&_c9XMjMXL8+sLh{RoEQY zE>~;RH+h}QMrIl2+JXE4%i5cCkRDbqU(}eIjyEctv-0@>$*^Cx9av`g9QsnK)^sPV zbn|uX2#j0G#JF=`x!FlPd$6=z4eU!EZi=m%$*Jxyv|&&%wVhZV29Ac_J*+*Pc0{gJ z{5p;CXTn4Lk%hK&{2-}Lv^%_^qsGKkX^G>#(qL~2{@o*th$(N3g1xKiP-y0} z{q^1E!Ro<+p-DOBam&ukG~aT=3Z9^)GXYcTW-Vwb8yacF-hNxZ`tsd$O2hr~V8n7~ zGX#iqSp{r*eeZjn1MY&P?^~~MPc=+-9TMMq+sxmKZb-_)yh*<`VotjVKj$|J) z^X~o_F4lkOg!=gt7Hs0OXTUzN2^ESOw>T?_+o9UVw5>en)iP-x!E8_sJQyGq`ICvE z9CxB(g_t^?Ka#VtG1iiO$Gs)jot=yVRC9+S#V(+PIcArZ3h1@%>V;9QvoJUE6Ep_7 zP10e3`DpX?d}3*hsHd{KT0r1L0!*IzoIv8+A!T-{3s(Xp@uP8g`hC(l%~LHt#(z2^ zMSTYZZLdz(=2R$t9;sJqgY{^`ut1)j8YfIeu9LB;^f|E1U^t9H6>i*YcjbrM zJ--vaOy@;6D)8xsDp~|Sp2y+Y-3YT9ZchrT-yy~EjObs^OtKbDB3+#^qId@Cku0DnT^q*Bk3rK6J?D%P&5`Do?W z(+?NkPjDXG&|+7IJAo*BL*QTy`2?D6p8uV{8NSY%K=OA6?Z9z=A*8Q)&>XoL9s3&M7C|<#kR&(Z!|-pb0gea`SkZ*8el9RkWv4YB365F~k?*+>N*Ar0H& z2-;W$x%n_#y;pL`3By3@TuxI{gg{-XzCL^?@(5>Ekd?{c4+4kggc&v@$Cx`UX<*{! z9&`FA!wu3T0{=x%HE)k#<=@))5C|Ve1M3h{yqR_SZ|iy=JYc#NP82Lx+b%?&h|%#K zm+~)(>IpXq!Rs{t!Xja5K*ohlVvzR4t!GryTacji1E5ZJ%=brIB&bwDYvk49ez_2n zA#OimAKg@dH>Vjz`ad}*q0;$s! zY0IBo05UWs-#jMn5ViE*`E3BXsOSp>h%_}JA#gMPYpRYD0rMldb(97EP42A=WkJR zN9}Zc!?ZZr!O^NAwMsZ9#HJ|?uvc8S;lfRBZlBi(W_2EtE7}S3T1>W9T>eNQ2MhC* zbl#1{@;8P4Y(!Mb8LM5F%&=IV+uB{9X=AUkgGTK|Bi!o`ma5;Pag9ztQ-?NoG}P^{ z3w9Fw<_wF3|8~MC3&Lg6MiV5YXnTMaw&XHYcTqN`X5!3j`opRtw!~Pl0P~&WBWF3m zX>`J=;(5(UXe;p&dOOq_KTeQm*BgkCJY3jDgVZdc07bkhcM*PifNUJ;gj4x%CYvRH zd7|2ge|qv3Xc$ZT-6zaeI%9khU!rt?_KAzsfEUji-b2#w%Squ#7fasqBEAEe>>|E# z&T*(M6h4v6q#t16&A3=O+ zrYTa$d7RAmG-)rvZbb2U98+g1`yO6i&kjDQ%b~wM#E6#!J5ngF>pWv_n~VeFz+lSXcE+{U*>p%ukIiG$23YdX;k=>i1xKwN6gNyr`<#pwNb_e_qU1lre!s492i?T-op9my>S}{M zrwt`4`xpzt4!w06jNEk+Jvz&z3F4(fGYgpBr4HPya{V0!0bX<$Iz#We8OO*tWKIqF z@_0De!xEnc|{=7}5R$BOFXr-0L3iRkk?#HG)n#bXgo#i!CaqThzzSw<0G_1{U3 zW-4r8|0S5&5;tu@Uno@Wb`IVUobkyL&aIo6qJLc){Z9c zhg<|pfYQm80(r@=cmIHf4?2-6+ZYFL0@Z&-8DMn5r;$qj zNWxtDcA$l*M`Fe!ceRcWRFC-!P`B)6mw^>)X)|A10d9$D_wb#$r*Q!r)15;h^~P>M z$Wd!u90q9i)Op)vEInXLLs(8$aRgQ~)V>B_PX2{TZEQ5Y1aDW(E0pPrTJ6A0ytDl1 z;k&1|qldNS4;E5PXPH^DuBVnB*6L|lwssPEmW4qQ5+0on&nZW)en7}s(%26-vu`=& z#AGf82fB+NLam7vl2(TKtzvOR;zxyg+%f?m^3ESGbD1k%NpGC6ynH7>EE zHr0s*s@sqh(sDaJZuYRo+F!!O55AL53^)^N=H)4jyGw%DXU^7g@3d4yV zU`gUQ(-;)R{SKPO?<0DCsFK>FGVCxW56XB?k!5D%J?0r13CjadV)UchMY$ZQqqo=N z5U+Zg?~qvmj|{1zHnUM3&WG+QHA4O|R)+N&vWAVV?jI?O`Fj@pV*g53WjEB7W=$mC zRF1=8&@h*|P@0Ku+un3>t*#*AiQM_gf#~NyU9t=y!9yjRYA>`YmSgaQ61|4NXZ{VxI#vC(FD9MHSN(_XCF!B>p@9y~ zl#JEjByS`iE|AkfGB`}I7J`!LUgIvjm4Q`-b(A~Hi#O0a_drNGGrZy_KK+av2OMQv zLAcJ|daV5zv2(BZGpJA0mQXZd{2tE3r(&a;++k2M>ddQL(}k91`PZoRu=e0Liq_n@c+LJUEw=m+w@6+uy~%`X61}Jksz61R&L2P5rIxPE zBTP=!&2V~01bzYtikGhLUiyEeY@2aDD#B|k23db|Bkz>$-^_YOjXH?U*VB-hIB zh5&|tf-spUA2f?;N;)0mG<%nd<0XIE+4JYa2-sx|`nYb!U7iYnmWawlN!6*|M=!ie zQ^1U;?o&f|5>s|sHNxPD6J~5+gE&ihOG zK?FF0Q6=qFZ$jD(HrRgO_p9O%&j;aG% z*IL)Fg3a_4Ttpvp6>Kca@85RHcn3Wdt!ir@69&M(%Fa6sow1#KfF0ZG=!Opgg7Ul^ z=UXif*A!fVTjlAEa6vB@SEK3B{7 zZp`LHUD+ucnKNTzMidF#29C7Ci0Gr9d10O}*8|)6l{Th4Z3G5cCo9>!h@FXsCpG#m z#z4xv~HjmCNPhx;ALg!QNYDfE4wdP>oD zF0PztxI&ot7_M?&znX)iu4;vqD<=MNGG|kLvU(sQWUmeQ|3SSx|3$rAY+V0CiDu_W zWcfr(G=ilB>S;TFE7nRzGyOtx0I2G8GrqmLh`s0m7Aerm@Uu2N^$jt&|^ z83!o%Q#{X%8uw;{s1esp)l` zkdMgnBU`@2sSY>F-HxI^ZNG4Aa0)XP8V`p%Pe$~>n7Ih@_h#QdXHoJD8^Nl-6}#Z9 z1ARfjzP8V^t2?5K(z{a$SA%amq|!|_kg>&#_37R)%0FmOnn!bfO)X!4y4za?D<1u- zel|S;1wK9Q-&uUlh01%%axPbxG#GJ{|1=XQYW=M&*~4`(zgRhExlWPS;-Xupp(yhI zIUvho?O^VYm#CqghN>kD%Pi{lj@!ab0d_RTM^lA7MUv6$5_)p9noUMgSSzgN29m@` zZcNcfDL*=`+z91^Ywd~slYWAE=P69dd(wXpXnf^b@E4(&Z`us;wW8-=#E!K~T$}|c z(?MHmog!VWn}BJ1;o`cNAI#Z<^O?X%6@o*8G?=E%a9Z6i;Z!0f7P!xD>*4fG^`6!p zF6S;fV(O5{OhByA9cq|?S8l=-5kotDvE4gLbu8G3G4t0ygYakG0>Y5QAFhHsh8v)S zz}^=4&e@;D1jN;^Q``a97$y1Ke*~G|i+j9{m_(k6CtJ~8@1QT`aXfAU`Owlp*T%E0 zQ5?%U#MqZS#6VClR;kIyTmPxyP)|@#SAw9IW`q^v!c+XgfKdUFb+Uk0V8&L~CUty( z$F7A?V>SXUv+4y?p7V#yD*%-e`Dx0V07NKzXs)iM&Al^!!DmG~5=Wiq3C-Zb?j{r_ z9?HAeCp?_vTjmwXYHT#I$I zhR8Z*#S04IfT&MFC`>2N10@Hy=wr^fAAk}!O9koqxdtHb;k1Kc2<%54cL>B82afTc z6}`Eel9Ik7yYn3 z`k1!dkw~XK_(%k}mw;q>jGFbXfCtEmV9>ba5>>uvPA_u%A4Chw2q1zDsyGXaT$A*O zZ=N7#VMNADR0S{O7kK`AFhpKT08afXcXAMeYC8+O|=xvf;Hd^9G z+(jP!2t{*{lNzXd;~vACZecd0^tj?A^$J-S{})tiJ#ccLsz-%O@quc@n8bM@GSsQW8bBwwzIMj246GP@ub8c z8f^%A?rcjCzq3h9l$T$TYs_LXWCR1N`sXlYRh4SRQ>P?T5F@h32QOfMfDTLP)*jRN83da!Eh*=x(W~-0IJmKk;gE7bmEn)#)o^qEK(gag=PG*wWTh4%EN?=D-atu za4AAvR5$a+bqU*m*AZsXVkvw*?g-(?o6_EF%0e3vt!}C|kZ>dk$~)m9JUU!!1o5v5 z4`gb8;bT54y?XuuV46M_nH~&j10D7 zJTDSabD7d@ z`#c3_Lb!A+>M4RUZM-forTdCC<@5cD7zY_}d|=+7f! z6uH<)$q3v~zm)S6fmurW`DiJWR6k~bmt*#+v|EcVT@aHv3knr3hu@><&r|nC0y?s^ zQo`w;q%VJ|X9yp|7dix)t}YpCB6I;aLYsQA)i%<-9lCSZVXRINOmnt4a?un|L2F${ zX_-_r#zQ;MO#b_a1nbyy44igFiL@F4xOv*)OhXdQN)lorup%*^KYT?Tc6?8-&>oYd zu%cfF{S$~uE}&5@F4U!*QwT6RIZZji32{=U&onXoWUE%jh8o%~Pgtaxv-zhxXj)C0 zZo@u0#PzqD44vVa*36Fsi_X?gyLK~FY6tOtuY=ugtRL<`f0#fiX5Zi>r}Z>rp*J%X z1?j^erN(w1`0w9=9=ElflaNPH=Zve1kBJOMt9(=T@X)RhJCy#&SA`J$)VL2=?JUI!f0Jw-2qS20tC-6tOgR1N^b>J-@qA zi)@bypdv{FjMie|Mw#Y5E=*RCg^(7<0bwyOY4}e@dr~NlY}JLQor+>+M$L*n&tXhP z&i7LK{;GRZQN+`P$z0zQ@nkV|V+!6n0ahQI+?*Glcx~Tk91C37Z$Hz8$2BhTxaz^a z(j%?tF0Qy4wTR}j{E}T-krf`Y;UT1@2)|JtqZ$^Y0KWuldROYjLD~2OJ$18ZN6y;6 zLkppTD7an0bzs=%14HN9Yl4i7yw?GL5{B=ti7=w)^UH4Dqys}QEoU*^?ItklH!^s) z1xe1{&b{yJvhD?(iv6I6SR(CA?Y;0_5_@?<)siqnLN<_RMwdd~X8Kvp19@0&e|sDbkYK5qI6!5qnk5TgMkNQ?#YuFVtapJ;3&U zNBGqlOgWQ(vZ45X_ID-|nkthjlS?w*08ULNQMG%L9sE`>lKHOq?mb z7B0D@3m_V~RT=x3qCJr3o`-iYx3(n#U04i(pmp=&?K4D!GAptz_cNq7mhGq4!2RXs z)_0M^EUETLOf4V{IFytd-JadD#-_&h#MjxG*U}h$j~D75Wep-n)ZC#;-VT(n_MSGQ zxn~Co-G}u2a!L8FbK-WBrSfok(H`ZWl5{!*c!F+T<&Fp8xLEU|#3>vGAG5v_4R-dV z{ikO5d`g@_pb-82>W{A{b7r?pXNPtkF*DnRs84qC{v-W*oN=^5f5r`(hVNudN_=LO z^(D09RFkzz&5Z%ugA%#F)NX&M*bv+KlMkG14Kt?dm%6&0Sk1r2Y%k{40#Ev+`-h~- zk>KXboIaO_)Wiwc_PB77i*+4Y7T*lZcZxTV9 za?apXwI)YuvEyZFw&eEm$0a5$Sw@YigN4N>;#IBFvrNr7%4-GGlPh8w#9=(vLa?vy zhvQ0I6%AJ9EywTE<`Lwzkgi7Xmjv(u1}x+o&Jxt9n9#waA^sRy?oR0Z0!@w#-f{T; z*2gHjp#!A5eZsO%3wa_{d?0l|Nn%8&o|Dzp!jEvoob%b&3UFRCbaO~QQMAx5&R>lS z%;qq^{fVzbt}a?H<{J&yc3O9@8|PhwO8h>tej>U^tp-opjlUx>kq2?E8xFLQze~+w z&h&C)hUX|`Q86UgT5iXp4rApCv|f;oRlYz1XLkuXn5zAx zGq}-;OLu2gx8d!k9{;{gjS*3rh@K1|l*k&pnyVU*niteBb<@4uigsX^A6s)_lv9wf zX|J41Gf1BnI_KfvR`WtZ6$N@a--snrLtZ3v#ENvxdU?*;mE7&+>HmA@uxf!@r+d?d zSr0jhgdogk-5Z8OSlH zA;gZqAf{MO*bp(S5=>HlNj)!_wme9q8GN}DyvR}EOjx*OWi9^&TNE@Xe2Isb!%H8j zp!Zdg*2dNEjee~&xgDd4phDWOyq9Pvo~9DcXE~1`{$X%uI&$SdLV2#UW=iIU!N>>Qab(REq92Wu)Jo|_QVBC8 znB{?3QhSOu2f{?T{a5b-20~Z+D%>dK@?N<}j(SPHW`J7#9|uvf3GzXK7Z`$#%{@9j z3miA{Juz>Q+m3%7uuN3cvk(`2^I87}LbqJRTU!{H2hLFAG1Q-FC{Ku1E{=5ReODI2 z1*@+?X@avZtDK%l{F;{;>*gwzwWKemU*g{9VAuH~pCqJ5d~3#pq>-Mv8)iB_u#4*R zDQ^vZIUv_N&-ofd@055}=GbqEfWi)DMqt|18Pu<{L{=Z_}9hc?`QwukzdPiFgK{XYJ)8RowzA!L{E%PToCj8pZ6 zI2?->IK^%c%>L=MP#j)c-{MJ0-1P4yT3pqbP?Bvz-7ekTaOrTD?PnACReOJsOhsMm zaD_6-1X@zq?_BGg%8;6h_C2}In08X560F?nLtkkSbhFw3ki2aYZPY=b`%-AEr$OOsmN&gSK$C6vhD|bMp zN{<+rZZw!1!5Nq$yA#=WR?Fljq9^R$WqE>C2uS+y5o>G;FaZ6~^U^GNcDUW{oTzD1 zC1V7p~QyrWcwi-`w?&gTA z!cpSc4aIphSmtq?lFSi@P(Hh@QY6-zmEN0nG{%$p(=Ux0BLiqI+hQSW)rJnQ@z~az zNX#k67DO#mP-(6vqgRqU9-Q8f9{(@&M12e!=l3-@8BBW`Q4%t*0DlGejcIBz$P(`)+Wh~y=7q{adjJ98& zu=bKqCg6{|&|b6i?t-X=Vi3wNELAYXdXo%n`2+pF`?3;ka>f@@6o67kWi^?lQypys zpa_xENX8b4dKgzo!gqoa0+Ua?gx|P13rRgk++VMxl)nC$G3|aBy{g^uDi`_N4r@qZ zO>8zV>G!A{!$QxY@Zi)i8X~B$;7dB_FzM&WTEF-ko-I=Sw3-cw9kg}EWOS6yfHIi! zAL2vUJHl%B;g|)1pm^T{toDo1Icwq>7_0`{%jly<-@3gBSnB1`&|sVG0I0)_uU!k_ zQGtWkSeG1#kZPW`4%aUUQLa838T_$9p79;;{_J9F-6qpM%q?p+5;jBeV-v1LgZ-hSUU4Sd_zWB zg`vZO--S$A$vy=E->`fm99QUyxE6hNSe4{a7y!nr0Rys-RnQncW<$$^@JShM#`X@@JJ?L`a- zAWb*+PgMZ5WTR~n#&MSMvn{bKU`$yYUZp>6sGve$N3X8QI#cg9Co~&qReqGrDcTL+ z;Y!JAE^(}-tpNA47CE`1Wk&tMD!fPas3#p^Bh%SDV!lSBNu6L4On1eD_H(9^LCi* z7u4^l?Vq_k4bMvL%)zOD#aQg$xTg&hSEczOpOwY%GchL! zby|peW1Yyb*O%z|f0+gXTmZQ|Q7l}P57ka^@O>hpRKAL}> z{vG0}6vR5)&Mj2~x7`=RMx=91dI%m9A3QS;@3Md-?DryvI`92$KRJlSb#gt)LU(F@ z3Qw6O%;hw;C#^5wT??u#h>spl2?f>)FB9+ty_u{`u8U1TE0FmI&`|Z1HISl)@nh^> z5M_x~AL)DaYkAOm>ulR<6IxEiA>I-|iPzvz4=h+wRqr~tt14+EhKHrR%5X!E&0?KG9b5LT})zk#N(Z29OqgzQk@BsAzr8B1& z6r{oS#JOQ&k*2f*fMwCN@#j}B?CxuN>j_rAdml)F;%IZaah53SFB|&mh_g*9I041# zxsY1~Cf$u;R5Y;{^kT_G=W<-viY0COtf+w}kASF@c96OPy^A6v%{T#z&lcmuE=0)P5!<9rVvxO{^TvxyvAM&DUb`s^LI1;K+;`}7nI#| zDeD1ZGItoIa?#$Gzz_-xvWM<(FaFtFEKmpr7nEi!=(-pR(84Synb8e%C6 zJR`#{7%twElp7%okyLF7?~+fG^M19`!I<>bVUwGt@#m<{|_ffPmN{YUQFIedR!DoeQ6Z%C?s?oN{e=yqI`l#C`5t^5EpVr4OkZnyB!=L z6d)S?-VdY*ZajQ^y-52&1}0jg`@RdRG9UW!{=Mz(2w0Nb-m|4EV+rU-TOs-964dRJ zEpGB|$N;pQs4WCk2}Aj!XFERB<}1y21KyFi;+e+3@eeUPGy2c}o7b}cH@twAljVOD zZ0zj+yTbo}DcIOK{;N$*H(|RC-C?2K`-(AhOgX5?yT8yX=r72!aPsCghQHL`hQ_sc z;Ce?}-kJVeZZv6S9DNDa((8d3AcHtDeE(zae*y$5YP$~9#=6npVf~7AoSt7*=P&Ow z5MLWTJ4}EdG96#%?r!e@3fwG`B>t8G-&RX|Q>~ecZ7f-?BV!$aQ}D{G#G`b>wJg%r z?$y5;GgO86_y(m;kJA_8jD4+pZN}g~a60II^rP-q_y|(l=NoaJ2Xg~=bBBS3hR`Ob z3scVvm|y+2WPCBwahN|2>x^F@uWf?gzCS&4gCnQ+r`H-bMUgM+z_K2;nWPwBSd&pL z>nxsx4mW)N96kVFI}tTAdEa&$r?Y$a1>FfZga4HW|Hzs<{P{Ml3uX3!=?9@Vo)Nvsu+o$ig;QNrZt{y^ z=^D4M^51=bv~4(%)F40hCul8XZ=tf{bfS&}hJSLQ0OYktSu+VcCzyFNM$!Wth|tNN zsl>rG+vn!5^JmxEwmcu_7?CUsF)R{jt`6O2;Y@rTUNG0s3FUEkdn|$C#87sP{4F3n z-k$w~qk&jnt5Aeqgh2B*dv-32&s+M|B&w02UWxg%CF z2Voe70ErsS1B)rYY0o){5T}q*i&wIpzjYg`aH6BNfXrLq>$2A!<6o+8(CkaWFhY$V zo@+%0@N(|2XUGmj`G|)(GVEJ1dZo->T)%qX2*HR$ zSW}FSARVPQyOzuDS5F(iS9&CXhsj$QG5@2VVyhGRm1LaTvqBgGO2BBlraNcLWkZx142*(rw%d0f-Yy z65gfwCm`&6F?h^&ICB4pA}*ujn_KSx;!*jees59W^Q|_|bwj9d)?m*;{4LFph*#!o zO%)HBI|E@@a5@QmWc#Hz=lw0i{#hnJQR^0k?Qi(rxq)lNPxNONvVKb=2o?u-G~-VN zb&ybjN7Os<4uXU9Fka-26CddV0{{s15 zF5>MHhvM#Mhpk0072HElRC}J)5myhYX(b~VQv_x5T}wtHnXU!V7G7($zXWU#>eM$o z?nOsd5(56M$OhNxn1uz$3FePlSKPw9&D-b5R6@Ldcv`T8-G{8$!HnCJv zYW~muF*tlR9H)&E#Je9nO}Mvk2+Mpsj+#se4W!;;;k3753Iug)rEnvO68E>;%@QF4 zI{_nA>LUKTrbcCej9;n({Gi7VHf`19b*yM7ARqV9c-%FOl|pAs+wtVsN`H{pX~wE| z$9AvA+jmWJ`US7#NEIeg8Q{~kKkNqm9F>-jdS(tBd#Tr{3*kP?bAsb;faoBT$K5V< z&Ax&S8SJN!=Wpoen#-p-ihIKS+pmug^LG!?9QL`cHv{=x8Yshr>uFEDYCbA#OUhut z4RS#u&6@xnmdklbY8AL~xCjwB9}ljM%DhLhE6dgqUS@wx!cedZHy|;%(9F0+LTNQ5 z=cg|+wW_DO>=%WJf?|M;7_K~RXc@;15gqnRvwIodvA6yN)83>Ev33={gR%z89)1~( z2-92=WHkxb^+PF(PVjAIZYk+}Waot?_Z<8QIQc*~d9Uu_=Vi^kt)G|P%TT*B(@9Qx zF%(OUl?qu%^fF><0KkX`25tjNr5nBGb{0*2tFUD-^+5H z$DVB(*B@`%&^ItURgqu7LP?w#e)VrgP_^RfVPFt9 zA%ZL@#1gJG+Une-Kl!=ks_H7#xsQ`72#vNoFnX>MKV{)gw^l&xU$?{0q97j)34#?? zQ9z#$#_yiO{GV~3>B{nd#;vma8J92b8d0Nu_C}1 z&?A{_6jjiv4G)2dF^I-ALOoI>4Xp~oiLpsij#kOaq64j(Jkc!wtb!Glr2mtOBXz&y z5m_)8(?awqgdNdbHz{Pky!8|mK*c(%c0$NK)i_BIpcXe{?N{-I+Z3B4KG_qn=8u(j z=D(9sBnzJ?p>my~*PV49C1ct2^2JdAn5CB&(-|0Zg*U)50=g>uxoNtc@~%H`ZMC}x z`MzdbuFg{FKR3-~H{$;|=xPFZHGEM%6H&4pIWYl$jYBd2;`X2vY`dw%37X;^IwyZ8 z<(V8=Z^^YGQ}?_aO- z#zgS0cvqKwL2v3}lwcRfyc%x3v~woek9s&xm;|5mP5;D@pBAip;~9<%to!@r#cV^p zeBF?3QZN?yk~UrR7w~r@cGi2h@}{r#1PD#riCN@n;kP4a#ZO;3ODN`qANeuCw~slE z#!ZjiNZd5O3LS@waB!kyK2@{ zV$Fy_`7CgxQQmtmSE1zDQ-g^BDK7?9WM&u0pf9CDFIAo53l35`Z%+4q%4nHp?FLK1 z4+F=8l}rC2(-6oOjgiT=!?M2x3@nPkhfVq^*Rav20g}V8%cjTM={wCUZa1%xaoeA+ zR%|Wws8x|X?LTKZz)c|mitXTX(v)~@9>A*6xbAILyQ#QqUCR&8YP%sQMP2S$?u^MJ z`;~Ah&T}`|%PDJyDo7Y1d`VhNW65rfTQF4R_oGJakbP?LXA_SBN2IbRd)w+z?1+Fq| z2HY}tF))dv7RoNuI&x^?&->+}z)&R*(fpW+2V2j!%*v=Vq_NpfWRrtWm-VFRYvEQg3`K-TEDeS5j;k+ z<&sNGCXcc zrQp7669rh8t^jD&pvRwSFt0MO3JU>TP8>4d%*O94TU(t*O7c5G1BOg|A}E z7k4K)7S-fco8y?94*gsKKHe^#Q=T@u*DoNuSKMq38g`CXFE$?-3_ZJ1*Hd}hyCJrd z4vYtLFW3frV;Kc^C(vx(K=Ovy$A}dG!A@tNhwF)$xMdObO@0r?8i@RDwXPt@wVq`7 zm&4{9$~A|8R`1V;3P{SeuTEpiwZ4IjIS2g+K~BLvKPQ)?)6*@$0z%Uy&4@K5{2mst z|5A~ouLipWbIcFw4av#Pdn^g3m zn|tHhv%1owOF{u6A-w*M%4ked!LuN}8?X>6fzVDq2qlm3QrFyk1lpqM=+PPu1t2Bt zPG8*PpTIJ2AY^`yXTvi^33ar^)^h62*YsW{zFV|*mj;Q8pLvy++01KSz#jU)rw_L{ z=W*W*Y$Wfc3;z!6Z8Mb>>ie{jdO;Kz9EK41#`8z5UDyNmcLAXSR)c6RZ}{;x`mhH+ z5GBUAqqv@;T?MmxWpH_&;o4ekxc0dED=`)~5RRU1nYwV{*ts7<&|z+Hr!E#dcebCgfh5ZV0Y6xaK25CH3PMa8NBhT znYvAUcVPg9{h&^jOxw{i+|%LCB^qEp6HdH6FYC|~CQ41yEa#=E<`eWvxS>bgz$^^j ztZ}u<+Kz^}&@DWV;wC$r^Snz@9U+21cw8J!dN5!d12C;C1n6@h+fW&KepK$g9&rlE zrxg5KUpL;=ys^JkrnErJqtM49sPU2O=er87>h}Pl>jMX~2xP07+Cz$yX+78}%;{MI~t)Dp9@tGN4_MD!&>#iX+0MGH&sq4k<2 zsg_QGllUsco{JVq8}l8M;Q2LcF8y;u9%yuH@;&FXZ6)w8I=+``h!Syap0^MDEdI}J z@i&0}tUk#IypU(8A?P&y(s0ayX0yyhTf!N#uk%dbMD2F&AXIA@H=Gi0iY##@Kd5UJ zdgQ5jR%-2zSf=0lU)bH*&@c{`RAKO69I2=@feq4bK<%VF`>N;Sj6W#8VyJ(D&wt;6 z3~<-zNUjLOk#-g}q!%;PvU=p-mZwqz+q(eqY63w5EcElM1ZIfyhKUYNiwYJywap%e z6~@R$tm>;k3F`>E!KT1O@wrSpZC^r-1nDGmuyeO;O#>#+n zRt~dI*##n&G&MmHjl~GdVk8Fr+_F3xQJYHBd(2a|%A&AskL4tmQQ+Q0^Q@KGkCN$G z6-oRAvsU6fCCShk&+>Sa7+~>I7k7ZWkqepV^SraMI%v<=<>nZjk^uf(`JD;OWCT=z z*t-#1?E-9SLKFX_Cy_)1f5Bk>A}O{0dH6SxZSV>~4~=E8mHp&M7e8rr_P6uekemI1&v8R3L8 zHO!kPVbYQ9RyE+LyDez3Sl-D>$=dFtJuev@^**4-k6*u!Ir|)_dpK-Quj{uKYuXKx zUWeMC)o2JVrnf%t5%5uvRzT)`BybsC##y-_j`c#5VeXfb+(d|VZEETtAv`6XRRl{J z=(**_Qm!K$%`cczBLwb9-5*%wPPAJBfYlgy1m|@_Qo9{n-R%=kOs8;1rfmVM(leykNa@@ zUDR7*15W~XuO`D8g5lPediPjzV%O@vdl(d^jo2Moi-=~!MQD?r>#1BSM{FXADPr(h zz8-3_^~5s{L@U$XMTm}qKOpGx!|*M6QIhli$i2{e%-mCtkg2fTW~}9pw2V=Hg`0f7 zC@z#JxD+Fu*nUN|IV2#xyc1T(gxgb8CpfB%;@N~ASi-kNH6D*tVS>(;!yxuL_u8zX z&!RGZs0VUI_^n^0yr)D(Upjkv*3WwQr!(z{r>w0M6M=m;dgr$)6h5uV~=xz}efjJk(0V7;hndQUsBb@&24H@-?yA7ilEV20Zf6Yo{e6n&ML~7B@Tt(pbumz+6yT zb{keY);TB4c3nEz<)l>~=Iy*144viuRsP~4s+R)9vHebw{_-?~(7(7UL5{&ft+14o zo{?3tlp>j>!Bs|?uF2)*K(EB5x$hu#Ks5!c=`PI#RtXsLzB~)|ROQ#Z+VImXVp|fP zK^jfaWUaa9E3$xE>aWRaU6wn5K3j%E-d*(2)%P4m}#1~#A|CTG*s(EBTR7o^V&q-r} zp14CmQ^M+v&rxM8$~j1tG4ux8$tw#BtuIX{eh2VO2-em+2_wJJ;Kp9qS}?NCXlFGi z7!B0nq``zGYJlq$?83k+lN^*Z+3_(yr*??yymF=Hg)TVeL%|)m_u@7slnE>tGQC7= zY1rtPHD(mrba@FUs)fKUx?&Iy5*Onx=7;%O;*+ACE{R|pI`b3LjcaulBklPl1ky3~ zCIu8G0e_<3Unvh))Aew)W-u139R$Hpi9^^zOVOV>5M7eerG%9T6a)9GCtpJ=yb$v- z;U7`Ym<&)2onFZlKYQf>Q4ei9B9}c7$y!J8rjn3m2h(XM=|-F9wYC-&JJi??Su|iG zn{NBRt#mqqN1j#x&jXlEW5t5AiOXI9))ll+!EMq8KM%Rj#uLImRMnKE(fA+q@(%1VdGk%>f7}?Hdgi3^)&`)zC<4xW z`)e9Gf~uq1hYEQPGB7a0em5m4v(q`lnP!K=}0gSLoYya`6752sD9Z@>GVsGLF`-W*`*D0#mU4nYuZP zoq&FOV5bk})uGWtzO{cJJ9yI!JERF4Et(~}Hb7U;Z#a;4lk2>ZsDSkur`-LU_z3^S zn{Pz>lWVT|jC4W}e*6;Bq%S7~OXVrE`L-==xmUPErMXyuVH?3W^P9fUQ!uTfWFpqh z@wLAW5F32{O>UV^FR0-+j40dwpGS%1u(_#yh@Px)vkujuQ&Se#(S$nqajndqz}V1} zPc1AGk|P^Gc_LEdD*(TcL>5xxt(Kq*)(F9A>s3PAsp3I{j#S;*4UjuB4&UyHFU7-f z(pEIGHi3z{W-JHpwCGIC-KlcYBCCeec7;)MmNV-OOr$Tdl|av^)ztyZHY;tl*C7}4 zn=rbW_TBp+-091PGh0-!0M>Ty+7FJl>?~v=60X1WHyuPV4dB=`ThN zFir&O*|%BQ!}=(64`x>Vh``4y5rTkpmD|4L8z{-?S=BG5d!dyTf8aF7A4u|IwR0V@oe6a-~@tBz1F zRjY1o%`2N93$UvG@rI!j!)@*>z)$+i)7O!Z;iXjQfv)ulq~PkL86^knDUe)dbYrZ% zkBlMrGGL;c;f}0z6d30=>J~qBXO)Ha7fcHSLjh=tszBSQGqvD`gV!kg(*g#GO+&xq?t&PI;(}}Xe(Ml%tt=am4o^Ugw zw&bC;0r+L_8#_^S%IO8wa$=gjw+zQmVjm(2#<_Bzn%bt#Q`ay?b6%6$Gj5XA_~R2f zOqk1aXZ1L5$>)ivtRmx?2{-Do6a?iZSMhP8%zWK1T^t58#f3!%Cf#h$47nh#>rRs} z?6oP?Svn`sUG@RS{1y6sufUw$l_5sTNVp1|0*KbuA|4~p3trU=Qd4rLO@yIp2B~7o zS|d6E?*OSH5;BeFCnkZp^ZIdi8%v1>;rq|p^*^z!7pi_O^>A8ymeIh^Ol@n*wv{GU z;i&A-k`okh+W8b}WV&WfN?X-oEA$a^biP&$tLkWCC*Uz8Rg#{acrG~XhU8tA4Za7w zm@zW7c%>{oZIH-1D023Sw|6(jwo>{~tKP3NBJSUFwj75HzxOTQY_TZ}~X7 ztqhx1v$`H{rF?_LlSdi+zjY9f|K1vAWBKtc{kiV=A1BivL<|$re~$jA3{sMmg^0jQW)1z7 zYS8(Em;@V?D7p8KlK}na{u`&y_|5Rm_w4d;v_0FNfUi67TmPTW;LeKto9mg)^=xDgz_2ym@yBy~%AC!Gnexh%Bpg1K~LT7VYl7q3Wtj)6#*3MMCyZ82H zLB~l6X$@X2m7r8OWuEd!-|7Omf`7B^RtQgSLoJ=ncz^h5wKY_;c_#%CwdLQqGBlgTS zm26z~Jvh~1rLw%=DAMXFKIk^Neo^RpaBH`;iq+G4mEuJBS9bPpYN!1MbKMNn0#p1= zi&!((TmA4kJj?zxoS4UIg`;bBhTF5V@_T3A+B=36+~zQjtA=8CXr7}+jhqZqYXnAJ zn*3M>K9ratWOc4~lBp69ou{4F(uLdzDnG_%^X)fIE6F6xXIcmVmFL@mZqZqI2Yw@q zJLNJmZcxr;Fpn=+(Y102A{8fo3!of3iS}sE*VAhe4d!+NXKfHt6>iYPhU80j(MIxs zd_#2YfhFn%t|n>{e>M zeCm}~x-jyxIhBI`k!{K&u#2^4^M50ZO8l&_SO0kgHcuLG>r(OO9{A6CiDI_< zhFEl6C|kudI0^>1cb_U;YA*zR8JdK^PePoBJ}*Xy7;^#p+QcGF6BnXHdbEE~lXXHv z$<=?m4|r0{F9r=Uf{q_4VkCom!}t66ozAs-jud1%z8~5h8mWnZZ z0P$lCzkUtjcdp`?bYk;IUUoH5Ro~>X)GdiiG0|c8k$E2gR-mm~-27Pcqwx(;w+6~J zRBwv3i_4eqcvNJ~%Ew>w!zoRxC22rg z_^^~>bpV9>URdU-P)pWHNn|*O6Kqh=%C*-Q6*fkY0^uB%FMIvA#aWeZwj`peDk~`y zRR|HtKV-X84;)8x!nrOxb_j5G{+Qd7OrJ6sY1l+9RM+q&<1T)k1Lbw?{TyT1%%c9s z9#)6>ggvS-@Q{bz8=(OHrzLS=jP{0E9)}pO1Pze<=s`sU8d;T@C{)q%Kr7P&`QRo+ zQ87VMN%vbn3Ch@8GZq;H5`MEQbU+Ar&^Af~08aIR`mY;zY+0L5xf4E#T#EO!dDx~& zz5xvRCYyXW)EqLM$Vbp9DqVX(0~1!B75&EkOWXi&JZaH@>*)j`&58#uOwxo%+~5P! z%>!Wc)FQ|GufQxTof`9&-v}GTg@2Q)H1CT}hMCh-cakxUm+k@ff_aE>Zk&p#Hxh_S zR?P(KLIS}Y%cyJXn;VT3p~*A$Jbi0;d|6$$ve98$vz;lu$9O~>^_VLH%3)qG%HR;H zHjVXo69rO-RE5yE)n&9d-)c-dZv3S?WfS0pm0^qN^@n*$2##~)T_Iub1y?T=5pz@} z;)B!0(tb(wW|;`}Vh_=k=nh#wgH8gmPJzWDsdngO(zuVMR8^NgzQ{}yVM6+XL?fSQ zXS`I1cdU#-17~-fX{sBYKVWTbj#8-U>C-j_M>si>ck9(qu?;$vY)CzP;)ucXdKPfU zz-fP@X~n!?7kYo=p+nR0hu`GMN%sQJ7!02F=&x{3q6V^#+;OAm6qE*+y_`e ztEn`JE3)Nr=g*2+4iN&$_U(<~w}Nm<{*mqm4M+%b@3-$*mUBy5T*p%g0%kY3=U^U| zhKzS1^ADgIAd_V=RA0M&2{k&Rm3h0ykl_HAN2Z%C+=i70#mwTGZz>;1}m2KyJJ2IVp1tZf~^$ry)eyRaa?9l6KtPyr`kK9|nxk-T#~TvMH7yFipSK7aud2FKUtpbDOsLX4$wF?N7cY zO#;S?OGdymOy?z?9i$6ED3%R+@;-+2rGJP!9@}+&X!%A+o9>`FIsQxNAXnA%rP)nN zdVHGihw<8d9%aoHArd^HJ_LfQdVeB=CG26|y_tiDHe^n?QBamv7XdIvzGC}TPY)RI zSq$IM>i>B&8}r9K;+`Fc%K2AOTN8|WMf+&Md{eISj%~OIkUB=u8hCgcn6>Zbsb^!< zGekECBAm@gnaAq&rC>iu$MZ!H>P9^MjOf88D(<^I&cOaLKwKdwbPlhehT=k#P=R9f zO$KZ@>#cNb?r*(;djKvYj0^%)ICxW)bf=*T#FjUTLZ8iY1{6uQyI~5=sfyav!GNx} z9A%=rZ#i3!R5r_WWgh3#7EcG_o}#9pJ#WiD3{RK_2SD-;Br(6ury~Ts@B7;>NqUfX zp7T^zba594s2QHMJ?(iLE?w#7X!lrb!D%oJt--6|ta1ytnE~yZ+Pd6@MFW|K3TmA7 zA7<@DrbTUm$eB@zq#s_s3fDF+@_{VKSNh;5`I@>LBp_6%KZHxolCb1sC>_b7?=6sur~ zmYuumc(>eZY1hR2UK$_RouK^FhLo9C!BrksQ->~vXtFzxlamQTS*_n1VhO$uPcG!K zoeR^^lhgxE&GI!5eFFtkX!{Lpu`iRcf;^VtuKLlH9TgiW=FlS+EJkn+pH&?OgAF&m#3tdGA@8|`7~2*;TA1kl!~67N>^i@T-; zzOQYfLWjY*2CHb6NBAgULIe&}2%33gjWeSeYV zRxD2RXan*(P7?k>2p8#`8Gq*{cJ>=++u@^);1Rjb9X)ucj6MSwQ~ah<7zCG+(0KTL z&gQ%cE85jeI?et&u5Md22;T~m-nk@0mJ?)aG1$qygb*d)^5I|JSug1mZcHqe}8QYFU!`kk-xNpHL*DXLc_rCtt+o1vH=7d@E7CL;T7nhr} zBbHnnY`};AzgXo*kT%~9(hbyGV6ND~_*RE1Cb1P>A&sY{iJcMtRd8Rn>ui+Sd0k8T ze|5fF;)e#A=N;DmWaVPrpIm-xHziPer7;)-uh5HegY6nC2f9@f9~6D@6(|K!yJ=zZ z=Xn6|g0#}cd@a=dypyic8_u|$GvwBL0f3W#S?59Ywuh(bs3)rcE}^Aoq?_D z2j_5aF||>y6VlzsqOzscyi+f{GdBJ>@Fcg;{5v zv?c#y7W!$uy$|tbiZ9pgs5BG)9DeKpej3LDlWyHY7pzVvtZ685>FX1m6gYgrTl$5<=4@h8-)PaED%+$!M?jz!GrmugykRq3!tLS$##p=m-FE z=?NiU09DVraf5HqIc!15_Hf+9+jZHplr2C%N6!^%xT1u|7Zzj!d?bRPTm>%l3Ng0QbKn0D zCBUh3cDPEZ(qki$+$zmMXpcrg}x@SfoQxh`9lI1L<2&@m2;ETHMst_PcZP$G@ zXASiqm$}MBJ+*7u^XaC>8Fh-s4&CJPHbvL+O{-}WCe*-DTF2JR;v1$9dElV1Bti*~ zoChS7*!XBh^~qYtzKKi8mIB<1DrDDC@d$lZx-a&x?JjPmIQh0Z*;g#`q#?#ku6zmS zL$MoWqVcDjw!tfUNEK%u4-G(i+E%eGW<|+rThD;-@)L&GlR~0HY)ER|XFgo6n=4D$ z?_4{-4MK`O|IF|$6ozU#*JBcrR~fyQ?0r-{F|z*C;?|DJrWJ4o68(0*S840^ZTW__ z`!k_kXO(-hAeozI(}FeV z#BUcy!j*WN`?C7qlp_^J1!u$#I6G&=O}|?Akgu>Eirk4;jafMSoMJPHSqQe3lzEQD z8Y07(^`x7^CiMPrm$~DC5H0Q_X-W8{&G4ZRHa?OMx9fE=A0Dk3B9RZU$3otHqa3AM z3s1pszP;oo<}+dRUEKo=%@;_&k?&7(#X_HtvkN&%*0Y{G{OBbayzx!7QHyBVn@GfL zvLuDly7`filyB%jnkHWmm_0QCvO;1)c!nNyh;0gHYf=djo%R;}-_B z`S_Vw$5JW-l*G0MDZw(iv+oLj_L0@8U%?g|#-%5diuTX~L5&s}JB3tDzL4#*i-l^LLWHKwR#9mpCBI9ysj4O))< zI8b_Z_&1$eNstDAAIB(`wXqv;D9rEAK)cWztkXFbH=#77h#g4bxa{A7U z|2bzCldF)(Z)f;|e4v)M`Tvx1{u@`y#>UR|e@Z!=|6SnupHdDBXG-H8MaI4~FeD&( z3(p10Z^AzQH<0M_M-ryd6hiU9tzBYB(r+8jRvj^0>6$dU&kr^Bj|pP#-`H*RT*1cI zHx1gq>TbUJs_RVVrr517viAXBXCv2_gPzI1>J4l63s$Dk-8I*~#zwCHF0ua5Xi`>D zWY;VeHFj#<=-q7Lifn7er`G>oc{~F?!`WSyICK&E?XcMz(j5gH+gu(o7`8e6T-PFJ zxb;#zTww({=I#&4zaDYEy&>f53NLCT{+(SB*38Xm?A006g&j7j-!$qj;CMAzrv*Wx zuEK=$zCA5m4wf*ky?WNyYao90me)W6#sC7Jr^Nrfo;LoLtehpR?!|i~%CrI6YSrbU zdLnT0ffZNv_Xs$O)8w?mWR^6jiAPQ&!rT6*pM6FibX5feE?plG*Z+eubxUmj56bjN zE_;=!*Zc4$DOtGzIgK7F8ZlXo+ZK8Qr^_2S9Av7*x;uTeN$xbq?VV!cDVfXfFHiLo zjG4=h3x#XZ*+mgxZKpzl@|}y0iPTGgRBEb&UF280T>DQ)yFfQsi2n{(=TH_zYEmV5 zww-Jl82;61Gej-$(O2oW3^d&j*vu z$`m*-7v_Re0A8i}WkCCKiRZ|5XQpXN#KJlxn8$%euy+&9yE`^Y6Aw7>QN`*87rL64blUE&$HM=kp zTnySg3N&^}T-rf#E!w(+6OQP-eBP|0M5~jE6-hN5WSbc9&V z!%PTV+CD5Z`pIA1A<6AI*jg$DnXAGt;0v<6oPRz2fWea}pMTqcJMUS-!r=0Rszs?1 z+a1aV$+he(*s#)hhVLn?T}b#u#>dEm?CCWK+m{gRD2mGnWCt4`^Bfy>lZEPzT=nEl z#yJMqyQ5X*N(XUBO?5}h$#%ruqi6HM`)1Uz1iT3#+mc-7K%4~Duju=oWlY{#fwR@~ z>xjsD>2PS(H=*lIa||x|86?8FNOCife7_94q2Ar#(olG@6 zR6X`Mgg5r8a=9p*$AMy!*Wx3BuRUp#9^nA4sBA<|gd}6CdLrVJXG`47cq#cyNG+hA z6cB~6kcumX`6~KPItAt?1MT$%;*BEyUm_t>Unz;Yrh!U+^-?s=zXanQlCs$~ zd%9%PeH_jBV$Zi~)Z z>>%ig06*omDsnEZcIeM?4i6EhPPdWY&No>$u%6Lis;DknMbU074BsqNX8%ou< z8g|ECN5OUs-!KO*u-^9=})umm1bEpaJxlKG&C8&{jAhJ^sYCZ`OvYnmnn z!7EFKTcjNsQV(a;;s^M9lw?th0UCJx5`{2XwY+n4c1?7D?@ zVz3l*OrMXrrNCg@f4HDdGPpLyfEUn4eBX9VTiW*b23RvFkhFMMCzN!8HXor zOdQKJnA?8J$dU=)!I(93orh2RTenv=<8iABUbJPg&Faf(G8(yyMt4C}ljYD}h(XMl zZk}AM91$`OnFFwxu-&)SJV&$5LnZ&(d`0#`^7;oha+R3VZT z2c9u);@rFK7Y0vdo_kq$+-vI`0du zn->rvCl#g;M#Qvr#*Jy(c9W*=ty}U9_clha2TLr6{P@ZfPtK!{=9s(V`|SORTvj_h z-BN#5&zVV>pqTq^dCKl~Q!xi4T5SEtZ+3 zZ`$}+OsKopeWb2s<}O>mXe+#0zf7ck@Bc11{=Js(KrsJ+%)1k{r?1&dW}A_K?)=*q z2g!D80Mx`G1Y6-5c{2{p$BER2lBW}cIm=f&b}{FIhZ8X%jU8^^voJmPi~!~hbq5f5 zKIu+1WG`?kBN6UNd*IC4k#{JM-QdNndNX(^Hv<FZiTi7vTw6tm zqb!QLi)^_VpVpb5mzZ*hS1R6%UC zNenVdGP(M72QD>cCoZ2-d(vYwYeK#-U+;PGgAB}Y%BX*^ClfCJJ;gD@trYJ7Z*X_U zKHzGSYs_WJ^f^n5ER6bIRJ;6Do5od;sj15Ddw^!*Ysp7kC98f7s|t!iVVf|zp+B$^ z$g3hITK3#c*_k7kfd*lpxfl>0L&w$JS`&D8l4@EV=v94Bd~1oWGAqgGZCt=>x2M+o3Jkp0zku(EGoL zd+&HE|Nnp7Wp5eTGla}@4#$ef-lJ@lk(HTEIA%p=#)T*&86h*0Y_c-TEQ&~W$SCo< z4l1wLtM~i;{d|7!@9q1C;~LNFv7V1{e?G7A)O*j^Oi@GGNYG)!rbBJp$9IbG?TN51 z6rgiAu&5oLRsE32Lx`BQu&T443`Loxd~Q+kWH|+edCf(A#|^8LK7Mbr{!y!nO!+QamZtG@mY6DrN!op z$C_-%()h5fow{##=1Fmb@Mz>V&-y7YYx%rHr^gE;k@$5%p7M$uceQ642{;l+dYD@= z_qz=o_)cf+zJ9C95rHF*lX3PE>Y}L`)F*@HfQ~ta7I_Yb{dD*U)mA7qk3ORZYaS+7 z2iU(;L{Sy`;2ZW!R)oot1mRZCkIq=17WKE|Vb3C*Ysvf!3WgC^k}E5hKE1nV+UVH) zQuE7d&5l(`n$zIk`Qo?zu&bA6OlxS>t8X;%yMH{ZJ*t>*>G8(MOzd05eH2zxz(DR7 z>yf4Q`$&pFPj(jV$D4&4P5^TjQ}QS09lEWCHb$+OO1WL9DE67}-Vr@|wvN66!KfQ> z2jVozReVxeiDZTqoAK8P>^){Pp`0mrazmQ1b65qe zsF|`0WMmtWQvSm`tfPu$s2P-^B3CEp3cj1?g08E9Io>yk7pd{Z)=YcT8`5~2Gktcd zx2pWq)zT^NSpY7=X|OfH7wwZms-HR@u4^=lUe``f|2{?k)T!N*l!|48+{@FWbH?5S zq+c!AD;^=A^kJ8I`kLvj2{Yw)T)n3Ww`Fgf=QAf~{9t3hiXSy?_DP!vh4*0Fs$$6= z^)31aQ#VRYbwz%+=^UBQ2bxxTx_0plyCRP+kMPU}V~YIQm{1mI58Hh@)q-3O_-?x&lC-8l>Xy8Yn3zSb$-x_*AxMO$h}wMBTpJfQ5gq zi_xWQH1z!8vHQyZ%BAy; z#>80RD#iORMJ?)19Ou`Po>MMN=g(2}dPftjkH6W+(D0TY`{%5ODE#PA6=AsWv00Bl ztj;5fUY&;nRcWl^{1!5@`@o^A1|(F~AJ;T@+&FpsaYugg@9tYt3qxZT>y zcV-?Zdb_)&B0@sO%F=Z|{A1RvGzcE^?2!zMetOeLq_9x_m@uHAE8)i6^#d zohPc&ukATX67)uVnXQ>|u~DC_jq-BpQAl;e2@PXQAdzDk=p)d+Qbn<8QT7r@>~Cz` zH!DKz+JANXdR0&AiGckmk%BK5p*FnII*GR0wliEfFXh&)H;o^hzkdBT`%q%L-1<$U z*7o}9D0?-EQM!0VPm6TnQ@N^T#BfqZ1AI93rj(h@lE)_gw!Wz`*GYDN!9?s**$Z#! zUlXskB`)#b#-^U*q-A5MZ)LZq?`td7gOWpKP-(zx0|r%Ks~($n1FcJ!T{q)(sAHfrdSU$%O> zTzxvy$mB`1?1lQO37a&{K%%hm>|zNg-=VWkI(TN^2KB{I&x3+yncg<|nG1irx=viZ z+Ewf_pXhb+O|4V^1vnJQ+rMM}K zX3P?-2HJ3)DVvwtbS1c&p(bP<&1wxX!9=%EjAPd`a1ENOAC5&K8U__VKAiZz^qvh% z1`x>+jkXxJc1Z(p7yDUIMf#IW(M;^9mwjMPjw_L9H6caEap4vq8@ zuV~KHl4VS5;f!8WC+7kv@8{sMM_FT{t_YuGsJm6xg2C&mGC}YOZK3O=1ZIK6t?(gf=HQ? zrcqT|ra@|9Rf;-o`2Mu~njYoMop**Q0uMJ(pHF31v{mKth^PAwSv{K%PR=p76gG|1 zD>l-_^W$+hQQ5h^(0bSK5xU2nv8hH>wTU32f`g?4lvqWFxuF$h z-)G|}hn=az$bV0%77Hhui^%?x4Me@Z;Y5|7AG$T6QeUVNOZuX@=0%xxWpA`Nia}gs z1I3f8fsHqPb*&dv9R|FueEGFyvep!L2NeOd9W|DyPbQWgv`L)(Cp zL3SHH5u8S#$5~7YJkCj9}EqXUeX$8+qc9Cc61$s!z-RZO*u;O8+l0MK_Cws*8;p5sF zy@9g*mx8@Rwg!sp*|p^7X(O(AGFC-baxqdp`n*SV=aZduV+3oPqR0J(rA>!m?R+?j z*I{W(X=!Tt?JGT;v+koyC}wNK^gET-tDauEu%u{R{p}?`WrF*aU(Z&yzN4+{owY!TPpyi8J$~DYbP=4_|hQ zPMo6NY~wWc*Lw!rKDfBavXdA6`ozrd-H}_rc~_Nw9q+A{NX<=)i}d%};$X>KBLwU( zSdEMVF5V>JG3xK=yu(5*Fc1;%KGl$_Wnn>qnpE%;bm3oZO=36c9avhYuOY_jo(uj; zyd+R{fQs(lNFRnGrnG;zzef2Wl)e3!8GnE;hUhNHTyz4QaZyvk1 z;)S(~i3m~T`KMXLgpVK!90vb&Uq%d#P{{xKj4fR30HT08P5>L~E}-Jc$5p(}_G6-l z_z5qMi!MHIQBv~<7w?{w(U^4Ft6Zz`0W{;IF)M|0(Bl<;ucUi8qC7v_lrHtm+OkPn z-RzGkyLY8`>f&frf!h%Akk|UsB9`Rz3&v2gi86*75q;ZD(OZ({X;$~P`wR!8C)X|$ zXUFyUJiWHOVm`tB5M>3rWETxZyo=-IB{8AN)w&+xa(Q0_6_t4nKLG!fcHR(a8~&SD zlijoD{LI{>=h?7Njx^lB31PF{Bw8VPKJ~)t!F#sx>32lc2W#dI zYeql3W$Vbj?1o?AWcxs!*qh$Nn9RQ!wQ{LDy`n(lzN@P?ZnSS*=(Lnz+uTsuEyfQP zQFm}7K5{Ij+KRN?kHDv`ZxQ&s*((`@w*gNndQ8|i(!9m$S#07aaokSD%sk~f;jXM zUad*n#%bCdj2lcG51TYr3qx3i_d0T1D&#Md^ts9+3}AvM<1fqC*2{O1W8Ib`@ne~e zjio;kLRYDAyPD5IWSji`P_}Wy$J{2&$Q!aQk^Mnr@H^@nh~VO(snufzXe(9 zi+r5;~y?AOMhR?C%;CJ1bw4ZBJ&nB!R81x4s)@Z(*g^PrD$>+D_?S6w z(9AHgMf>nq3*A2N7STb`MEPh2&QpE$u2QtG=2#q=QO--{QPkjzAhmVF@IZma1%l_T zu;(JoAQ$wt&RcibZ?$XNSxny8MJ1BEzVf(G&fM2cTsnv3RFU)yDvV+{Cm0d#DDYG4jvi2m;8hqbX^CQuqCv^uHD$l%luMD#WBF1e znpYz{XM>ftpZ(Qa7n8;kR!?TJfT#X(ns0)?y@*ob^qp6ZApA&=q7!wVp3NjE%YDci z8FDSGq4k;>%6s|Ezc>(%(~Q`aA#sYt!ZIUTsHYN2tH{jvA5{V;Jj{_6le zk@GbB!lMNwZJDP-2aKuSzOFShOR4iE&P6z?!GU9zxU-eD^-(|ka35vTP%RFW#72~Q?yGfP zQ2Z`xuOr?W|3r0l;?6tP@BFUB29Lm4%kj02#JYi)y7+@wJjkjm&p@nfK($Z29Deb(WYH@qhTtp4hMQ zCyW&SndptbopF+We&<_qA5|edua&~t!L89xJE+G>A-9TMJaK-~zV!8BN zWF&edeq3aj5d80~v}|C1VFLRH6PVB;d6>|lRbWEs#~O4AVM2$Bz=Y6N);-1-CWHnU ze_;&!2jfG#%fVoW)D8^~gZ(m&;E|3n*b#f!0sG@@V25nLplW~-JmCdU9y6g95`L)t z5n=c*k$&3;20v6C>gS_Ag~9*k9a>t#hXy$!BmB#xzvMeujTkb=!TQ60F$4Ti@?+$M z5&y71naE)$9x)IBVRryZe3g%7@7yYMs zltlmHAELjm`DK66fB1#yq3w>T4uv{8R*y-nZT%Oz2jK6o0*f7XHS7Q_L;ZUI8qxoc z{88*5e8v9ZPGbMytED7<=!r)r7yl*eFNMSp7$3Kk_&*4Xi~L<7Em849+x#Sa=pv92 zjyb&eVF>@W3|vU)FN8h>16ra-;d@93F7#W%U&#>uI~N`G9bD+I5*-pcE)o1NPy98j z!jF>5F^ORRl!)&r(vKv9{Yj!W^= zH^AYC@eeIPa*)&Dhl%7^@4yce6I!pIwtyr5X;k>}kcA_D_2}>3ftEP=TiS#p{#qI! zO|%sc-S0>d#IFwhr3m6c)8hgnekHA+0wVqz!DtI<9;LP;!ot7v?pGx2`UE0g#lDlzjN_V9mW1yxchWhz%|EK`MkLnRz?2yhSRw!~jAh3#n9i|@eMkK%wh=Tc%KocNb|DL0gTf00-E84>~J;4`2n)r9oR3_W=g5Bn@E07u2-!c4rk92Js#Mr$CuhfCMbQ z2QUL-AbAQjIyo}*Q7aM9FdYy82k!%PSa1P27?c3vo04=$toSs51rs53a1o}k2-uwl zsG;}i(g7w=E*+o(kYLyYKofw2uOUYKhh`8|v~zWHXFUY5tb*$1=$&6qcI22MLLhqv zz+;c@x}ymmT@fKdkpm0=cDn;t_;nsZC~^=rg1RCw!h;WX>;7(f5Z}L={*x3E{O|%& zETarK4gSak2*4j1z&U8F(U=J+fWeu7G+31ZK;Og3g0{|PLfXH`0r0`_EIO;01b%wg5V& zoDXefqqhdoTLO=vpG)Z7XOE%F=FnRTh0vBe`ousXpqK>xftQP*<9E=<=Zhe6G)2&s zM=^BbVG;BLJb``$(YsMk06Fk^F`z&W6B89c=UKQIOhA|wCN2&(J_P8{e#{6eJpmL* zq39G4g@6fM6efUxgHK8Taj*|fNT3wJ$3cn;2#bM|rO-js5yds_y%^KL1i zL@6X9APNyf2q6U^GzAS<1Q3VBZkIz8Z3Uj-lm#R~d3l_*U7$WU+rs4j>i zAkmWY06I*#82F_Ek_hbtWTKEV=n)4TT5nAhCI+4>1sEX5 z&QAd*Y`6dvoQE_jArFJR9G?P-6cd0!{Q?b!AUm=m#h`Gm1_VLIrvMTBPay|8fNlRu zSx~1MN-|xUQ1*%K07${kYA7YZkmx89I6QLU8K5S8FogU?wWo#h%Rj@@g3vzQ1mu(1(1i$0==LZ|m%w11NMohe`k zxawyE7(yHxDIR2cD6jlY5_G;7)P*6CP?LichTai|b`B67dItvW9F!Ai2M$q!KqXXm z&=m@vfnV8uO%;Qz5~TK`VCL)k>&gfNkVG7Jd{ zi2?l`srp-L=nV9<0Q3jGe-1FB{v_;QbMAk`c7G7>P$F!!e4xt>fClwPuRZ=bj{l|I z{x6a8BADI00~8<2n^a60b?2f9`KPra02XW1o)XDm@a^T3f9lo2q7^65eQBkwWe%@ zT0?+9nh6FM5Q3`5uXZAE0b$5MN9{nU9U3Gw0`k<*BQ6Jw5#ms3`puZ33E%<|4G<;> zYy$A1R)^vV3kwT~{U&rDYK1xgihr>5&tWR;VAA7fga2Lh|Mbp3WTrDmG5()DL>w%w z0i>7_;z$88sCXa|Fac4h8VSQi1z-@CLqfVigOZMBfSU%5$bL$EEJwtj^ZS45Jm{$x z)Sm?VWovPC&i^U-f8Ew-Q&Xdp>+wu`lq3pT{+v$_CwBg?iu9{4q0j>U&I#~?spFrl zkM-kEa~;kV{c7<4JJ&NF&c6JT2QAL;inG*u9014!0W_BX=k@R3M8FZ3-$m}21t64l z03l3YqN7+`R6rc^d^D&;M==sg9}u!5ehww|?I3^x?8}6PVh{u(V}P(EI?=$yganY# ze*^?((Yp}RM1tHMfEa{R%sT)nMyQd15EMi(2n?eU83GM{k2l1G!+zl?G6p!5M$owJ zXKP`&0F67wj0h+pq6gD35rlvU#0Y_ekS6@^mtevX zzqmlxh#pD*^BO4P(IEOK8#oFg_&ZGg~~z;KNud$)W7xl zZyO$UH2nM%T7cLduhRz;)W7WdCqe%gu*Ug+FuMKaBELNZ>i>T`fc%>Z&^<+Tp=E|a zb4loeh=hs_^kh0K90KyOUn? zC|CX8>%U)P{y(5SwDP~4^KX_on8g2gohf#FD&yaI-NBp(n$Q1is^Slw`NwcSxMlF~ z1f@8*_xh^^dU_W8^cr9i{DX&zA6M#cSrm-!0vLrMO@H^+d2=@_^fMrWa;nPu#wxsW z8oFW!w;SZG+$>$~T-=>q(PKd{a~_&Hq!|MEz=C&x5Ew8GP=h7!fHUYVT=4l2Ac~0) z2RDWQA?WNu<8#A+E@(Uk&BEslL%1$}3}C359R|JtfG}7*4b5?Pt6~y^!_&}2qxcxW z1{FAyu>(AZzPhS-4A29>oy(X^AnRLz5CxZ(c5`>NGIu2OPP-H%OWMRrCBKyx%plV^ z|H%A;=q1}oUx4tzO@$!sn$=Cr%C>6SyLgBPI}cfULdpr^O*ZBM0)_?m(AFn90JC`+ zsR*(C;8u+50@$)34Apb;pcs$df-^Impi za?qS8a`vTBi(#|8qCf%sK4Ea41wSKV&4JG%p=d_nGa0-W&*f|DFn^6P6A1Q6*w{pT*JG9(J$M`(^84mx}UB*Bb%sC%0}0^9&dH~|oWYLk$^kj(;)&}|q0SwIVW zxBAK}ux}O;sp}2&vpoy2P##Y09Ww!RFZ@6;`A@(V$RQv%f$ru^LgWtI1ZNJqH$z+l zP5)TW0bJ-Q-2+$2p92H|aNq-A0ZPmRi1<_{V$f$EIE^VRUIjJ41Hhtb=p5l9K#mD{ za)vA>7w)0AgQ|-_qJXoLm7trTyREC0m7u$qGtYthE800&A<(euZ%IWQWRt=ap@g1D zIp&bSA|~Yz&}0dK7UiSZG9%wI03(-xC?;$-7#x9taS?+8gA#)Z0|yfWz`({R!q^6` z0n4D|GVlbnT?LfEPs_k2Sh5OmU>B;WUIiE4LVZ>s3%Nek7a)h?;I7OubRdpEcQ_*` zv;@#r?SBDqF+oCFOztZF4d5#}xXj-`B^t6n1*p9VFhIWIun91ux&`izU-NZiTD z6Uzt|6ADeiR!(MDo zUT&lyY>Mv6wiE%}25Y z&z}n)IcG@CN3Lc=WS|@-ecmp#U67WHqIDblD=w$_Y5T<608oknsv+vR@$%Jpoi&S1Z*i!}pg zyN28Z4bI=xcC$tYQD=QluM<$Kg~4^wA}_r(;MgEbQViW`nfCZ{kzA*d-Q;!>?j5WL z#nNiDoP-n_o8mjF%fIjrNZ8CVppoX>q!Xq z7!>YdzQq#7b0nCcFXMmB?r>u}+Q+#bvHxxthiKA7c;`p!1?l8eQO9q^DT3W)?|$ev zE{eMmSWuLPC#zReu24FkxEJ2qa<7Hjg0M6(S=E945jk^M4E7^6*P7^e79`59-~VLlo=yG*gaEiQcyimAbixC|4+)S}-lJN@GWqYn4VQ z&razDpT5j)L4X&`w%y`wLG?jdomIIhJma?6l)@CJ1p(|PK35xsg$0kflJadZ{CW#- z3pKINZdr%*{a33*yjR35CHpr&a)UbiA0J+4f40?e`Wo(={ZlKb)+<*A>NW=F+WSAf zY>Cck+Z=y3PEuF9G;?cOzZSlkDF0n_>AO#HZG=IJfyvy%VaCh$F0m4Rjq)(j9r)hL zGy-zrIq?ta1YTFX0)E5}Uds(=^aV~BhCL74I_;D^BJ$0lX+Qja5+wHaX)#wPW<`9oK@qCn(?EZVQ-kVPbWAS2S zZ@5QV+C0m5h!iqPCbQJo+`5@z(H@jr+O0ouR`lI1dhOYEd!9BoQ|sK-H#qi*xU1wW zzOk#Vj=6n#fyt5Ew7FKrY0o*HsK=Eftd-U_)$1OHoK24Za7Lz|!{vfC_T$aS#ZKtu ziOYk5Tn-pt=he=fMSWoQY%+C;CJSjVCh}*we0J*D>y94G#5ZMfd#ATENa#s#ijK+k zcnQtmeR{y;ZIr)i|ClHWTNUH34C4eX#ay0C*`?9=^mrg?^;RnfzH*FaPo%o#RSsv} zf=$<)M@^*|RDtJ3T1~)$8l1rXFK4Q?C*HVz(;nwsg^5v*^Awg&jISdD(GsFY=Qo zl9LkVDs06+-MB0Ifk5BK+=aX>Teh?=Bd;(syL^f}qfTmCf-cI{$9V!dxu&^K{{0?B zv|+%!dPAdR&$kGV)9LRTJ`nVqa=wheGh`=Td)+opks%`-FV62oezXCOc9CiGNfham zwZLL&vN7={F(=)N#<~s(XQjp2#F^6>t&=}iSI>Rz;wFeT@V@*K=H`=MqC>E3JGQ~K z)A+WVpK-!P7eidN2|Ho! zT^B_GZqLvs!7C=xb-Nvj?6Da2IxZ-7*I-K>vzv^0)9K#jukU|<{hiTg0x-LWd%aTZ zHtCt?iM}}7W*oO$BIa7$BZe_w8V2MnY&h0rzduvWd5+2;Cr?=*X62pU3qo}q+l#Bu zi<$4$A~{(}M@X6~;&3~AT(7k}$mO%V;V`z`l*(q(wLoK=5SE^tPM$T^E%D_`5}tja zk-x%M8!&YbVBqWvFq+}(8nK(W9RuyRIr2@D*l=D;f@6CC zJC9A@i^aG>qlwjqp!oC;=}cl2V(}F;^upFkQbHj=MzVPIv@v87*`0O4)B6A`&6JTEB)IX!apS}@3GKA?Dvqm+u?_IqCJQyDXIvmi6t;cGR< ztS_w`NIF#$P83b&8==KIKAXOC2M8nV(-p>1(6CGQa>{;RhTzy`#VHQ#QgCSsAQWJe zjaRhqwiAMnRysdUV2vcXuP*c;YGs_RvcL}~b}ctnra-l$M>%RdVKL&<#`(?IpuIjU z3Ktagjsc1TVO4J?RIGoq$`;T0QChi=*wycS7FyYwt_o^%QS=Ld2<%=PJvu zWcHWDckt;`o2TfEt&eL zg{dpAVfYbH!}O$DXHIvcR!PUMPmB%NVqMwoL6SITcU^ooKUC<(g!gUR-zFj&Q!J@$ zao2>qT0=mc`n!rHNh>_}HA+1?{j2ZIj;Y`nQ8M0V3byvTtGFDd_zbjGbrNJBgYIV4 z8o!eDTpwJWwfut9Aj~vTYhU-N9yme9Db59Fd$Nzd<%J!2jjv*;)Nr zy-#{6ng;2wV5Y%tDQ$Pctn_LmJc|{)1%@Ip_y(eAv-B^eVNR8PG{`|+?U0I#Rf*Az zA-NQ)?47LQ^hzja*b@KD1s80v z4ZSV-_AREPrnyi4vkIi>%9z}&XoXDn)T-`!{QAHeoZGbSD^~1EyPAjvxW)S=N)fIK zqOw#v)c6}2BvPAHt?m)YmCP3NrTe1w5 zqj8@mc9r#Jn0xGy(i!KU@!Y?bBOzBbYZHO6K$MmY@&`lG#+YU{+e9aeUt| z>Atb|dVag^s|!KAQPL&M$c$>%C&uLuNbb?a>|h1bIgBJczLpr4&nfF?8=~56A2on- z)v9x_oI8(lCVy`k(W%A_y;1skEuvzekg%a1pR{VFo@mQBI635s!Rz7q?!`2<`=L`5 zo;?zbL#>3d-FS3o6g=rCl5aTFhb>p-Kew?@AwHKSTUCdsfA{2cUIWb{rpYuid}xux z5NjeccG|1_{r29%NlwMw&e@8)fg{=qDAwXf4h9oJ-OftAejX1+kp-r)&*Ln&o|nH( z*i@Pu@idWcBy}lQjO0+$FT;&7^Gt~yy)H!yE&>+wQqn|X z78~u9neC~#;MDy&0nhhwT$LEi-({05s$5sH_1w>4Jmq<>A3V967&Z7}@yyP9L>W43#4()L z^yXBcu!Lgeh4j0h)kR#11ZOTLEj$6F)4HPwRALpdE#FYKD7SVHNWLX0C6120Li}DR z`ou^E_M5TPx0mZOZ&CI{T?w{-wC(U95|t9&9(PCQdoot;#>lkl$5mze`}Ws!s)m%; zf@QE{tra^aM_)M*kQowC2ey7K_75nUV&3sF!+azDjnVeTgAdQFUNuJMFY&&il9&y$ z&<@XBNP3JcWr5znCXVk7Wqab_y~bUlnRpshseRE@d;R*S7FmtTtwzEBM|n!lUD)F?g8LZusPdL6|SML5C*ev{x|BOS#!ja5Yv?Gc+$V>zusH zJM_$q;mx_YmzDLS#*Yl8?5J*8XWDUN;xzEso_>pE<-%i1%x;E3aUNHJfWptVdXeku zt=+g`6ywIJ)Q}`r(%F?0)gSI%d4B_wkD8foFZjnkajEZ|$zw96crYtIMEgX-38u=? zMDknhTNnnNx7Ns&vAiFG3JK4bl`ve$-+W2CFE7ccG|Q|+I+`Y^tW2Gv^#-(Q zc`bI5zQi0wPu`fD`l0kk%si*zW;T{HKwMs@ScRGq`B-70qC)K3lUmj97@&R^DX42k zT-b4@t$n(A81;herQd#|T}ziL*0pD>GB4Em+pcNTywaChH!|?#d7j|oS~7JdK7D=q zD)_bb>Mfs2f-};4PfyNPjESOZ{PAy++Br$A22>^(FV2niES?wUk<5UV^bxIY1*dn^ z4HRXfECfr)3+E<$`29N+PxJGrMFX5XT8q%9JYTJ9yZXAyjBG!sB%0%|DsqrkjOr}(W@l9P3olk; zA~v7iZ7pJ$r`(YKcJCPz&JPlo#h1gZB<~rhHssQpYOSSqVg#5Tg|f{|LRrqban4SPg!{nQ#khXa}9=}jU#Z(wxL=@>d1QHWn&?m z8Ebhf?m$I>c6FZEg)*X<-6{D?o&kjJa)GdisA*ny19NTKnPg56DMjtT$B+DKLAS-r z=RLx4edr>>{JUkYUy@bxK;7EmrhQm<#SJscZ7Pw|wckEDHdq#)$dZj{y5}6_q?;=I zm75uH3^&WkEA_G_-zEDzkw|BLca+nQufsRn=U3)^pyN|6bjC0+ts`c#zGuNg{YumA(>-DGH&{QDl#DftP zhHln3iQf3ge^)|Q`;HblyQ-eS!|OiOGsG6D`$Mibl9e1(9G_cm@<%cyWP8TH z84vC9G5HSIO5(BXOZ$C#_Of0r*v{_p^m*N@We;g2gLZIXT63|IlZp#l@v;Wtx#%PE4|qj$XkX%+wZo0~qUtq!j{&>{#FPKD45~ zfT%7@l*rlKf3WOm+NOwW_`t5*w%QPc8_tQf?h+mZj^l8FoNggisQrmnae-Y8hk%4KP!B` zP=YCfCAGb#v$@M&lBR5$oxuKMizMxuE@2DGDpRAKxvmNOX%01KGV2e@!NJQ{Mj{j% zF1r5kU3sx*&ijt8Yx$hgMTJEp-k=5T@fAL|=Z;0?hOc((b1%Cm%2N*4WQoR^4XSJx zQ2MP_`7)hY2wrpi{)6n>U&g@W9n~nZxm;psRD~u3Me^l&qSlqeInmYq_~jql+*^_3XCNvy(PN zCdN*UiAf6TU&Dhb;)~;?$WA4Ek$FUJzil)^9Zr9?_KH!CfGU=XU+g3G9`*AJx0>lb z+I8rB%JX2oMMg;Era|Ai?6vk;(BK?#qswLt3QNmi&-r;egU93oMzQEvcZR0_{jiMQ zD|Q>*;nC?`X?D9LjgMSelD4|?HDIkkaHn~;+%32zqQyJc z%3e-zdq@&103()riZUJg09)+Y+}xtqlkp|~pHdtObqFPLpt1(z| zi=t)??C!C!agzuNtG%?jx8>Lw%%^dRg*!;MNWR+z9x_qBE&o7gHm7P$?iq}MVslYu z`g*Bvc*?ae+SCO^fpKI7kvm_<;%YEPc@cpz*7?-E*80fz#ysa@$&|=ws2zc8)69zv zyR)^a5zzlAVm}=J!L_FXFGxmLjdXg~8c-bFn1y&7H2gm*;)p)WLTkYZ2Riqic^Le` zn_^K}#=n!bF7%jKBY`)Ji2J4ZCVGf&Q5 zuDEq2VA*3bXlu}1jrv^+KMS|5)bJSD_NN$UFO%ivrxH?nA@SySPg~t^n%yfS^p|?S zzC5}7PI~KAlt8)H_oU=zoPjew9&f{M3!@&nT3*g*T=(9M+aPrz@*DJ6v#_@rCGW%X zwIstCQcUbxJG%}WpO6?I@%P;Yc{SO`D{oABF1h+Tm~SsDImnSeB`&=SE5=>TL^;STY$B%{`Gqk?l_MyI%)#sDlu@3m@%FOOq2{pB#{sB;~N<<}@J0F~vZo zS9)!v^Y~gTU|(a|iRYr|Jj zk94i1=#K3Dr)SlA`Fba^H!;Q=F27n!E96rw*D0rYJcrYn()r?%`lH<3x@t1*$p=Pv z@UK1(U@H5v%J)Q#dU4M*)$~OUv~r=~Br45a`#P;DwgJ87W`K9r4n?)1Y|r%8FW~FD=rqc~keLvv@&hdO(x!O?{}^d$}=D z0X7i{MUIGfSf1L>Z!hDDuZk$|Qbs>N=|X$`d%Cx1o%FchT=%x*V?3^`{&i5p*hH|V zs+Az-(b>;#cYj=N2r-_U{k9kEXtR99ajtGCOzEPZ+;fpIW^AQ=q8FD8iZ_>ypK+o( zQR!q0pdn@V{)vD=3(Fd;uH~@+7B#u?&53!+cVtd1&EW*mx$p5-_9JOG=DYKgL)#aK zP9cOyIpIGnniVu%@R+*lMDLq~f2s(n;Ztt(Rvv8tGx?dA*$Bv< zfWpG}7Vgn=&I$p3V)I&C^!G+?c%P_^QF>qh)P=<_ELyw8#!0Kwkh;=oy?g2+>QVU= zOa1aWo4Up;cP?!#+VaujKD}J!=lOPT_1zDa=6)Ks>pekU-DMck8Co`p1%!#5qhYcQ zG}w=BV|l&!QTe^H=nBiVGlH;`=#6C35U2TzW?eULCljYx3^}RZdJiucqrXSV{Ku0hu8I3nA;WSvn7Uw=^sdYIE#daf@$uyp7?VV| zBWO0#>$Kkx^#oCP1bB9ww8~zSIi2?=@snuA5}i87ZQ#CfgcmUn=3MdC_qVKgqc?8h za(oBomvX9>$@D$^MtH?M4Th(s!eg6j{o)--Wupea^74wI+C?O!p(ju2Wo^ouKf1bRwvn z;g0r(t(^VM6sB4?aEc0(gT8n3-RV^3&!?`CBmw422@^h!0K-QC(EX*B~ zZ3=LM$)c^|OIM9;Oi3oNhz62c3nS8Kp4q<{2QQt(6+2)E&}IBAuH;+D4uZU*KUx;?TT;1(A*mFZOR zIHeteeI^mxUhi&q3Aq;s*@(<~Air?4obX-8FgO(g!!pAGqa(wecerP*H+M#lYFsQR zu5VK#EujLnukrorD@&4z&OMvJ-iz#n@9n;ac0JW>#wdB=ohIBwteKTuwz|Zp+`A=vTXK{8g@Y~Ns_$QyV@cw zp+_ec^8t5~sVwY_J^l;&5c!+tcX5WUArL9baIQP$4@}6;AczJd2`|9~+7emy*)uT> z8?a-q!EV3w3Qkn9i%6(Q?#7o1uO2l@Qyz%jf#Evyzc;YlxU4@z14|K^KmC2VnieQiBcIVw!tsOs0FyFgF>$|yKqo!Yn5RrMa2 z@ycGtmD*qkajw-4#-cj(qiGMXko8+*&}VKeoI4XK5{Tw4uDsA7rmA|%k=E2gfzwXo zYI51*Yi*Hq@Mt=<6Z~?EP4Ip~ZZk>*{Q` z_~iE&D_#>Tk(5YZs@abpQ6HyhC@8b^T3hRD`J_*qZd=tfzw3ZqPnZ_BX&C-NEygI| zs{GQztPnvfSz|u+(Ao4>`F%Q1pUy8I2ECZgJqx_%UB8XL=4Zfq^kQRxc*WbpIP1(Q zU0#&c-tNv?pYYB*URRbd#gpV*TQXPfo`ijwH&jUTeB>8@o^4q1%tuv}UgY`Z7Zc9o zogQ5?7r-aur>+#=zQA#_rTxd<^OhIQ*F*}06w(x78pV-X2`}I7C^1vB&=e08Oic?T zX4FL1PCQdA!oQFy8}V8w%(z-eu2`R=tw5N5<5KZJJ3EEkR7Hf#Gvwvs2%UpQ9D_lJ+&ekyBDb7&ZX+_yrq?X7h8uKb4zU^#J7-b{j^1R)Tbuzowyg6$SXQla6 zZqM$CINm;^$v%8Wx3cMMCZSKYYIZb%irjjZQa+^~yPEPq-qb1PZfUvudAIRZh+}kY z74P$Atg%Y($m!h5djqp$x13g5t~pn)`dFuh+vZfm4EGZl+lK=09r|ae*wM-T4OW$X zqcI`kdsV_tM!QJoO06b_@VeBQv6Cvi@fXhP=iV$&?_=y_O6mG$m2Vcuxs#kdH@dv_3T(6hb*jPzO4; zCYd8j9Fs*i;ZK>?8?7yzQD&$nzfz+S*Ts_#I8Q0ooAk}gOW%wzF6ue(BWX--J+t6I zGG~|Az(m!9`$w=Bc^2s$q_cRC^b4NGQk_1p3v^zlarWF&a%S<@crAFJZI5~~_zG8T zoAOI{sV|F^H@R%2ca}%iu4~0S_RPE_ai9MCYcegGbBL`JY6F_#)2^r;@11SSixeK~ zMy=%rZ_mH21H0o*GZ?t4HQKM!JO?%1AK0dCPxjK?cT;|;_BGaxt{5@qj;vmOXj$+o zvCu2ej9aAP4v|~8IBN_p-Luir$azRu28MlFPTg2XT5x zPqkg-JRv{WQ#ORCXMdYxOEg#d zhn$jGMr~9>|9tDS7f;&A#W&5vDDvYbM-0xUQGVPM^=viqs8~LfJEbwg1)D3F^0An6 z3h3xz$=-~o7g@R0oN-}hfctxWihDq?aR5n6r_aR8ObB(FhBm9g_5~kKu-&*~pBGN* zlY3*XJ^id5uLBv<6?OE1ywRBXdq}9=o!g56qfVzwFTY>iOmVj#sk|gUN!am;V)R|tjAt_fikwNX{3m1x{PKUy2un! z?4H>4>QL-bY-^;lBU?Vh@7WR6C4Ij|^!mKvmYs8LC8d94#mJ_?5oVS%;xS8y12B*# zL9Jv=V_1Mr(AkS2xBbU1zCq-gt}kP$w5%6D-cYQ04YRzjRggoR z$Pt^0i$Tc55b(;fyY>?KWU%MhTlqvTRhTL~}Aw?j? z>w-Y;eJOL_QV&!?ElaDKiqE+PzjH)XVQe>hx!+}|FN@_?w z(V;AVIlDSd>s3LC@Y(yJY|z6F=Ul7MLV^``sh5Q*Tyo)=A5p~Fn|9)bR zwoJv#TiiucOPwDn1ki`ZNOfX!qPk=Gd{ScHU+`7GY}>IvGa{~kr>3+YQkwgGY(`JH zBdT9qeXfElB?l#XB=Y&kdER$+hU&1Rls-u@?G!yKe&p{d$4SXohwo#^eMBGE$oq(9 z#uVr2@oA~}SWX^Otzvs7205`Aue^4`J|~OkNQAPNkc%jZ?Hivx#TQBYGLGq^LJ-IO zK;HM;hhWd-)xCZgE<4RF9R9&!b4RB@H%MRahSEKj#m+~KkE`UTLh}|9rc{R!a`f8d z8f{)wiTA2Bb!m>CB3t{ejVUoETTLQnZwL!pS;D4$v+$_;Ui)!y-M!af^P+72oMLA7 zb8TJZmFw^TA+8Vk{&I&){;+$m}5W8c8MwKUC`mpbN7!i+-@Le$#C zt|u8=MmBMp?OsYj>BC-|laHIF{D<O z@ngEmsqbjUG}?>WhQ#$SOl4i z;qxjR3l!~F-&qpA{$^24j1;NY!{eOR`QM7btP zOkbW}Q<0>pO3d0$4A|98!HnJ>b#-n$br>@Q6I8ROv!@^N*n zF8#-}u#Bdd6kO-tC->YSD!UgX$Nb% zsSCUpQSg+EH;+4UsB4;nblm%%{i`))78)wOVLcTRsT9W;aQ-PDEE0mTtp?jhK zQoBdHh-s~96m1*%;y{Xy_}t8c(U2os5_T=!C4$@>MHC+ z`*s6Wo$N-cUl23a@$DfqrkN`KD#w@P%hA!!=hKaUxZaQ&&-egsW3FSVJG5>6P%1KK zDP8cRHB;pCmNJr;l5^BeqedpDjYaoZlI|EYrIl8OUor3;Q9A9tQ(z!#B*~b&duunm zPMCG;f%e3QLWyDE8R7)^yDMM|{OO52BW| z?D!6!cXt&(;a#{n$)V?_NA^Pbgnd+&R+~yJFA{xKnwj-*Y+I22IWI}Zo2Oj0ImhpE zpMek;rhL*|Sv{g}X^?o;JTz*FOSnw(LH%-ibk}}_?QuSANTfnosFVrh8&yGvk4V6c z5`~Y4Uv3(Wj$2zgy14Be#^iQv%@gIHztqQWa&P{{=$-jjyD1b`V&ynBl9<4sF zwz5=SIXygq38k@Jy7=_M>u=>z46Q1rHa7x|&sOL>Q%Qzj8hzJ%WQL-`TaI@3+Lw)e znqbC0haV>x+_V(>^8=dm*1gFk1TLSyltWuvCri5#aF)n|VyB?k2uB3(ORJ}y5UsPNX1|kHA`RpoVCG*xI+RQJZVjnA!BAjK^zr+ zvE@nMkEBF9sx_F9X!~c~%UoR-C8bgHHXQKk^GY-=J(PDSrL*R874>m98Othmnrq=< z+>ODXghL>UKGE8*tnRss)?*Y;e$RA+N3ssSR^Y2}FBYeBe5>sJN|sF_D8W%Ok@$Y) zyVH8J18n65M@-Ysl)by5xJ$fMM`!fKCC>24jcQJ&33@aCmOgvMOj}-FDf1;g$wVKE z@U0MiXXV7Uw@Q~dGWC~jEL>VeR4<-ivv=Do95ps`PT{5PeLH9!Glk5(o&WKxrR zKj`U;>AFPD_g+toje1?DSUPeqt(qBG{B-iIb} zVk*@ji9RTLJK&|d4QJN%{0dA4**^~sCtJ}u7sPJ9_WM|4@~tn4x-XXhj9CO_Wxahk z?VA*~?fkuwoTaITI1wW(ah5|~*F{6F^j1%f4 zOPky9aR)!wfWT<~&Xr87L!Tx}W|Zg-FD#+W1CNcmiPNK-c8*or7Q}GPpud?E#Fa@@ z2$$ZIa3k3$u>6o=ZY}=(*bwtfri?PYcSg7fTams%(P>EhfT1Pmq@~V9Q@O&H2bO9f zGPJTBtLeqPH(FV1?mSMM>cH@ERy7}uHp$?r&K_Xq=yXj@7a`Xt@rX5?bSk0NF=u1S zGE$~?IT86m;UdN0n3BaA>ij@{+nA%*6QpD+!yU2{S&A8h)jkg*eMafd#|Bxjy>z-7 zEc8}RkmESDL`R~MJ32(Oe{|a5nCp+(jMf`T7R&>_65)@>xu@!(;&%F&W5nW=FfvvZ zqMTHIw$cn$pV_*lW04KKLy8|Hq6}MtmrI4`7Bu!hy_;m!KO-56^YX`e)>#ezcX7iN>~yEZvT76yD3&jobVD^#x{g-816IjVUEGCN#<-dW}1R zBalvoevgmq`Y30JP(h1BX1woJ?*32zPe<=uj6?B(5)0f=-R1c6jg#YcJ1p* z=i0e13SMDOR}UCHraX#bf84AjEo{oK+oc6xIJfrpxKZa19=@TFYeg=}FmpR(VIf01 zT0J}Tq*d(p<_9C)6?E?6wg4u#N0-D16Hys>IY?jSN`x$gIQ2C>rvH`F%v2kt5La2@ zO{%1LTFQB&jm?0I-!{|(VyT2I8<>*vljW?HQCS6LYXYol5dx%z!yHP9a!+;~Zs$$Y z|6n2pfGj2LI5D*VJpTJT)y9X)GFP#`#??Drm07E;SzGf+o+jI6Cyc- zFpX$}S7n#lp_I8Hnj=pP7nH15j)hAx(azq;5ayNAcmVBnD~@|Tyk$S7k+N5(rA;2P zScgu&`fbtexRYPZK%fDJzeH|7F4CcGub|7ZyUzVMi|wfg??SS^h@y+?w6>n|+lU$$ zwAmPVUr$?rYWgNzwW*xu6Rt}0V;M0%+r7b``Ol~U^N%m({XTh%*^^aclya@wvJm@}}Xh?!_LJr=WOc+!LN zECd<4BXCxPt1xeJ)~nD_BW0bt37t7Bjp}>#|fly(b+#&k-c@U z#t!-72sFgzv~GUo@agoyhv~7wbyD$?3A&r$)1a>;%wn9JlO(2esLG+E_Sa1p%I@Ap zE-^jNiY|Jok`JeUJyVIf%A>NZ5@$3b=BGkN1M@wXviJSvuF~;cG1|JcTUQXZ0C3q# z3}ijeQLWO|rZs1~k9kU_W&3kql_#`9@41nXXZoECHO{%!O&a*cMAOz{Y2Lh@PvjZJ zHIWwyvhAa6t$T-+tK~02sn#tf`OUtz2%8Q-o~avhbDoP=$)CT0Ng=z#5I22FdwWc7 z{(0?)iM@VPX@q2$an z6a8p?aXDyfMDP0POiN6*&$AyRn+akex|u_L9=ElW9!E2A9pSeqkjc(gCcRs%LTqL4 zC8E3?Ec4zJf^BJEYV`a;f3^U#-q@z}_2_Ntabf+*+4t9Km(pu!;M^qZ@_SD*q$q70 zU2i1XzL27)H28eG^_zu75R2SvW{9@gqFfKDxv=v;`dfy3<4SX?OoccUja)Y$soP zscr(zqary!;)0h6*tkbhXKDi0s)bbx+V0J;>I2xjHShCvN zY9itLG=&vHDb{wOHTlB}!{QH0%FO9G)a8$=6rE^TzF1wqe#lQ1TYhWQ+#KL@E$2@{ z1WW8YKjck3Sf+GAb-&SXnXNaz-TGSJ{}h`Eji?Hm#$!fDS5@U|GzO!p)S27mH8HoV zkbvZ%HeIJiX*t7Vhdx&caFtt6lM}7XS4#NJdahx{0>A8w-Kct3(=e34m{8<)`O=dx zI}&?iR8LG#!iU)o(vBGck2K0M)=2UupDOy5989I;rWpTHhOzR2wGClVtx^hZW3*>p(xrEd&~4ldEm>m}CJ|_UWoo9omA)JN zd3`^i+F8?ktj6ZT$Bx${+dVH98G5Ml>Bp644jUG2X=|LyMKO4sbMedKNgHdQnbLl2 z=E3-;L5#?wL)_0N zv*|wD%yTzIRm90`b_8gpX1{%})qf0C z`ZZ5^-mv4Zg!$}PV!VI6&F6eD9Jp{jt{ct7|@Ot+k{bnecOY&?<6ho4)t*OMROj!_3*2O0S>fuI$}u zH9zZ+dJ|*vtVubKOS_~Z>0J}JLn+iHgMCg#Hpi_;UBfYJ(&{tjY{`eIVE330?CtY8 zL-OQ?oo9KlG4XX`AvdW`iK?D#;NRK)Iu;uG>gGfFtAQc#seYo4=Z8>(Y=ebumx-Ra zwo|3s&hRxqp>Leo)$Jwjxx`)h&+7TXCl@sDyeW~bl^|AIm35bL)hRO{juZ=~T4tgM z^X>og#Q{;9H{X{=d`8OWi0{y$B+(P@)fTmI(;B|itaBVTj_>W5=uQyjU-EtExNv$a z&2s^Dc*pkJrG>7aU)u#Yn&Q5pid~n1Jj(b=q*b>HheSiLmJ{Gxus^>OdJ_pL#MZ5V zcj8bG2V!iSJwzDGr~ui;@_ZxG!hmb*W&V2R6p(_^vobr<@nN#^8_o67%2cm~jj!Bw z0?`3l8qkEt6B(@SZ4oc+s&0!UKf0xK+Ul-^gGA__Ivx12;>uRreow5mSJ~wgWX^W~ zRu;x>og2HA{AS`=XXrHZr>Jao2ffAa`q}YRKcx?Tv`GU)_83%B=jEMka;dv?Ne?K5 zE)>=ppwyf9m8X;AH!0u@y{6ClEPuRAxVsLqRERBl?QlHFN-(4{CV5e5p*B&zoGfqL zAb;TIE$~I$z}h!l?g7Zq;kMH>me;Zt-@e;O)ONsf@{f7HVP}1kdg8LScU|(ci~EhO zA6JZoC*hTaabayaBUYRr|fROf|RIGmefKXEb^+n`bmw z%g(qs!BaX$Z}zgX@jIOBx>)8sH6hRMP|anN! zttXmeD|3Qa$rofoXp`;C72**(=`EitNf*xVvNu_44q2Ci53n`r`7^Na_KQcix!SNw zP{eX3C4OMKdwfBpV0S){BDrH`W;TL9m_@;*e@H40pq8Q&n=`*N=FA2K&8A*_y^o_VI7UdT59-_IW*PdwW{2w=6v;Ufhw3)<>>%&!Ckq26nsPLaBL15n~7cJ}#?yx(V+tdzP>X`TEKKCn7_zJ24x>REku&XZ3Om|IiB zR4WKU%024SPb(`zeGpEE`o0joE>s?-?&>>Y;=;_0Q1PusYsaI`8hLo> z26&DWbT4sa?YSi_hL5MnmtpVz3!k%`Dc7ldO;$b&>eT6VL>V*obzf3kR12rO8|}n! z56!?i4y6veBQ!sKi{VO%h`m0ixwsQAHYZyCp1bx%7e>w`aq-e@v9BXAUoP?8m#QbX z80+05417xOVI48lb0jHC1#gx4Y8Qs1-tjVBZZltb{7&Q|-^-$7%%8V9o>&UrBstoc)6lwMp;c=c{JnQB8 z>v>`H8y)p`^dd_hzvFu?)N8k)qZ=YBnC`+*bXI}?@Ykj{jF{KW3TiKoKMKOarU(*9k=IADOHO4 zjONXc!}{jbUOrY*Q2a{!y(H9hWACZrMa$0@v|j!*HXkF5y=v0^=;R%jGlDm#rl(_l z`3Hnmn1xtsm z-s&oqxabOV`F2YAUSS5G(uk;zx|8M(aYnhNReSg@#c}0Bs?ca|F~$Pz9{N|wt5zp@ zPICzNlHEBiqF#32E3el2t9$8Ug;intqNV&?un(IHH!5%VS>R$<-sPFDr?VkSA7m`l zFxo6ed^fHnC62Rk!UHeG+Dd-15TCG!k9b!y@K(ThnIS59s+D=YF3i;?QH1)!Yd#%u zMyHuHHD{-s^%2u+D)n-1*I+1dkI-<~abaP-db5(j^Qnxm^f#1b*DSGi^pS_BEAAgJ zAF(s8pdDg8Jj^jvF2jB;g0dmESv>Uf3<5)>b8E2R)S~I^-Ho{Zm#@B_$s(IxV)A#N z4)KdvyX=@DDL+&&D0ZtlWnfz`z9=M0^`vdk%AE~+siovl17@{TVQIORCoB6W)0Aq{ zE=7J4mS8scZj@8n-hWa>LZI;6T`4v9H_MS8(gNlQF2_Hntfeg7`EvVBA9Z6pwk|wp z3FAkHQp*fAODrkIKIAg8pD41Wi}AOEIntu&TJyR*QpE>+QJK203ob9zHS^!M>UCgS zJu_{9CAIpzeZp8*LkDKuQ@S)loj*H&3kLnm2_CYFFv7#3f(zn(wG>=U8lX_ zUta;=*Rn7DZuWvyLpXb9f9S=8$=A7!HB#&c%Cts*I;6hZ?k6dsBRAVbzWr0_XWLTO zb*;DhwIUM((~X%f`NfNV-a!k1o+8Ejpd@4o0bbNgsJ`QEZ;A}0s1_N_6yWirsr487mdiqyt!kUo^Nw*&z?D!;#oVm zA?h_2pw!txwNOT-BkuFA>&BZi<#5$lNhC&B9B#SQaeJ-rLd!GhS6BCud$IdWU;b%a z+MA}^LY`_b3VdgMvi+EF?`_|$jIL9I)+3~cC3oE$3tz2zm3C8Q_{LN^=C3eoLCiMx zWvjdkTU_sXTSd?I@0{tl3M)?)(~EqZm~_%*jl7mS`5#O}gg9>}r7o@LluTPh z7r?Y!$>WZ>yn0=mZ)U1mo@d(AK|E@FiUT7{<$udbzt{vyrkVA{I?x+Qcd{l&J{#iQ zdg4mV)9XRwql zI>$FhE$kW!*z(lAVXu$v=v^Rx+=fzxc-X)Ageg~{6v8YE%_+SJOX5wCttKsqOiU;~ z!5aA%3Mm=cPNE6z?!Z+861Ki{-PRC(DMqQJMldZjY<-I>=TS>gE#j?=9tvkLrGIl?}*sKi~tUTWK2 z%Y1$A=-5`-*}j-DfBqWwYu7E>Zg}-ch;5r4r(&=s38p2lk=^&^^)57;^QY7`7u;Ki z+Icco+@1}&Xdo33f1>Fs0@=Px)cE}Q>F=1#nS1WA`)HzbcJEu-n%BQhOSKBVGiDp* zzTi8_Jeg~VInVL9Zt1k6vEeXOkRAtSQ<=)=JLB>J|?U zEPainxDqMx@YdGG^YFX|l>K$Tybwof=Rq^HTgquEzsuI&W*U!w;X09wJ|7w)DIXH1 zN`C4GsbBb+E5B}zk-h*CE@{+;5Ml4bAsTfMUC0b0xF+Ujy-aTdd52X&0kWhmBprf1 z6HLT_eV_ti#V*)Gma+7T5DhG!1B3~a>XNx9S%yQ?49v9cxhFrCY;lN;0 zVy*j1WIP2Q4@oLd^jV(cB)*3GQ{8*CB&v@ENa`ty?$!pWRBpg(2fW659+fzh3@mmn z=v`K@oqN4F%stoMEj@aZ>UTcFY1esO{9+a9Vmftx-!H!s3tQgXkh*WRqY(SG z`Qo`J4?R4PkI3IAOxx`|JnO;#h`Y0OwNn3`&Vqo4*f&4$*&}%t$1@L0q!}+C)@?tA z>A2~9=()2)$r+LRW!3R6p|57DmwIGhXDQBFXg{xK^IQ6q6s(lL`Q-cM*$+E5E>)i^ zv(wZ?9;MlqNa`~ej~G8VemAXcssBdXDg||@^tk`E&?TxkWA@v2ZPV9Aij@hpq0S!mfef_qVB@2hAHb9-=CEWXk_w za%hQ!sbVFf+oe|HtlC`p@^Dyl>pqzZ%^k0In#IT6UE)t%Am12w7TUU-y7s;JOWC|o z7N$dHT}Ic-t0B4XjmZ_|1WGwQWh*!yZCf~nB715|m#b?tclhMH z2NBzQ6W_>U->?Ugv)xZzwISyGI7eB-x;LeQ`F4$FXN?X^rPUo%G*~syQtOL;W>0Q} z89sOSR7bk8dun83@yz2V4Mh_Ap(~m4BwI%E-m?ZoiWWTr-*Z+;ox;7{f<8DA=O{Ke z-`LZiR`srAs=un26y-ZVARv%VRkVH5%?~}X9wL`+b5hFklE9a5FI&FthZ%P=^%|bC z%)=PDjCi(yYrd<)1+~5@=jYASZHrs%Nc~}20?ivFR z$&YFe^}gJYY7Q2;F#7Hd&8fz6NhAJychQ-O=BvDyF48N?_SwEKq@p)_qvKMz`LLvo zhCc{%fA90tB){!GK|azwy4Im})T_hQ6;E3<;uw`?6tt*ziX+lfm2^LAzDBi9JXaOX zk7TqAvMfs5AI_cDhSBujQ=k`I5^(Ax79@SK^0cG==ssNbjucmB4U3NF@pzUQt*!7O z*T{|$PcO|YZkydw>esB-lB?giU{U+3p+%{^7;;a~ZpFg=3A2YE-$H6LKZ_KF1%93R zlts!HA#?KtEFO9}b?Nafk+I6Q-=JTqy~*$;+naN5nMl4xcOsX%$hrPB-#srM_FeZPGnOMQ_KiXE5+$?KIy)Lt z0b@ze3?Hl7E2~oQ>79NWCVSi!~$X?E^%ALq4!W3ic z89FAvUvl16sQNqaI%Nmj3QfrHW1WiBc}g7&CVag7=)72$@AWA5F7sRPl22M96JI6_ z?slMq$nK=Fs?@e`|>R4nJV*vXzw)C+xPtQpCTDf}d&bR{&>E9|+(GnJ$0ik?S?UJ*ELXgerbcYd$<~D2y^_Hg-^RqL$sZMUIh!L}F3MOp z^I8MHAX+s^RCPdQdm5fv<@%PT*>9kP%plHY>8Yk{zRy-k&GHow%$C!6S_k{xo}lXjtdA($T}oBS?Ws*c;TUqq@0 zwM?gm`n8oI_XM5pKGJ7kIkbPSC7%7(*u=(2t|UkB`nppYx#h>ZP5Q{&>oS8Ok6rbh zF`i?e5pFrQGfq)qBbO9qb3UloYy<>uD06JpaHSV!XUJ)UV;(2&mv*}Oey(wjy2*FP zs&0TvnatPXS`N3VoO|=(fPy=jZVcHoQlcC;i+y~~5qD5Ekxj$OalkvkRM5W+) zwetuPf%husomp@0C(DHVBUOjkS30e5feQ19=|1Xwq)ub&3QcX>hw90m@Qpds(%XlE z(hhAkS5p@|m#C1!YUvcFGTUv52b8nYS>kUh){9+Z5lH%MDQ+%evX`n2lUS3N;tXga zvP=o{t+FsF61LU7!_l8%xo5h#m6Wyc)^cDfLtCdN&)<)l+&VJmKuS%2G?>sqmx0&$P2wElA$`J=4ps_~%hsVl;+k zg+#Gg$3rWm=Yl3zMflix`G2mn{g}KmAAF~@|2Ut7V0HXUIUf`1~NY9gSrJRV;J_VgWoc8LZ zexChVD~(bap1p?=Ss%lE0@OWw)irpXuR+!x`s;H!9&YH?W8EOl6fPjX@tDYiud1)2 zT2{srzm<=yI?MI6A2Zm((i?TPFVk$Mw5!SQu4B!UvS6N*{<*8RyBX$=9CzyV z4pn$AZ^m(YCOP*pK*+Zyw#6!4_Es`(-hA|}de$&Mg!!!AQ(4_+57OioXQG7eTthcq zj0)oGbYA5PySnvvD)tdx)`Bgw85ut5L9dQhJI@TLeO9`(LH{MDfy!8GvWiA9D}(Nz z_0k{zSaT^JD_UXnqh6sMiJCnHJ4Y1O_gX2}T2JVuuU2{6ZL;A&YqK=;^s~{m^0HTR z&~q{t>0bm|rJ6FWGEFp2N18r(XgzAVc%&8M{^EV{b@q<cKSf&%_dBk)f&T zKa{!M)E}rZinWTH#+{f&S!E?ohaBI1qjYmOP^X zx92e&vQ<{$IUL+@_9dgSRnMuT{R*AkQ=T(3%tVrRua0qFv|ij*oGg>LQ+{C7N;mCK=N+`?a>A345 z&xVn*jrUn-ZpYQj$ftG8Pq(heJW_jixA#>&?=f-a7j4h)J)AquGq=1=@ub_m7UETF z`5A+0dCyCK-Cd9mrf0YCejWg*!@b>^gI;Ve^KyJezrLzHA|@t~^6J$^ZSleJV-C); z>hGLqawYza8##GbhTxs82( z5~5kB<_qB_!K&Q^7iR`sgj9hCF)AUD<5;~waAj*{97K{-n#T&jOu&+Q;6-NfO3mB`uBq$@q&P0|)?e>t{c1feCvbp-%*LEqw-pLc@tNS!`o$%6#g2`~T?0G9<9 zJi}#?0C2`Dz{3OJGP~J3Ui3fj^s^c68dE%e1XNN6;3)v$uD|(RJ^nX-8Cd{$fPez* z53j!(T=4(j_yNX(G(dv_C{2H{`(6Cs*r8}ifbJp#P+Weq|I{A>up_V$aS#Elax{d7 z0^pzFD6&|?NC+?0PZn7~kj1T#fV-QEZy@fkpBKyGO&1Iw3dO;c{TYp~y`!7Gzniz$ z|Iz}WO-TanpaDSP-y=fe*nio^FZn1y0Qimnt`i*hw+xmy3JlQE-_t(m*WZjG5D5qX z<^?M+q5lhI@!$v%Xf(Ju9VQI`vwzF;^6~X{2*x%4d4)M1I|4wlA<+mV3dF2wDM*$6t0R7z&| zg~|WU3+ojQAp=)7|GSC+fda>YCmaFH8r%+ft3T}h|D)>)-N7#R1 ztNuM)0DK4#yiouhF$%&40QGPU@ZBIZmg(W^XYbGnr$Yd~`4TtYCt)=?0Q>$I z2libu#2tg6!l~%ji$@j#!ZMFD&o3Gpgi8Qqf_w3J{h~?B0`L=1jr>i6qGi!ILpn$U zpW6We;cptKazI=>NP}X~ND#>Ih-f4N2lxDUV<;Lai%V&L)4-CVVFYbaI25G=e7Lp% zDFmN}M1!gm^LK}U5sgc32WcpvH3AyA2>&1r3ng2r$h{>Z_` zXaIahKttjXyYcu?gf@dl<3jLH{r_uRpcM{8{qM%oP@q>r8USb{;DdumkKYyn>SKJG zEJzUl(kO7h0U=22^pJTa02ntpfLJR)GtY(R3YR;-~ds; zi~m1I14f5KCB(h{)ek}zI3$)Y4I+d?a5?Z66h^2zX;}om-lb(=(g5Y{U|Wz~r13?; zV87PqZ}CvrPq<%PW6Zx}0z@1D7w+|k21SD`jMpJ}TNbyCIlu?hj&Jn<_Z=iyJU%o4 zsyR65pKgo90nZ=o5C(@5XdDK5Jje%xfU<;u2FLFY@X6w8yT4@s8WN5MKy!FR6b`QQ zAPrR8cr%d((HWQH@%V6XQ}{GEzE(k7kePq;VXadj+!!4EFJ4z@G(lHzX&F2{fvpOR zzzP7k5)RDyV1IA~e*6M$WpTix;02(I|D**d9EC$K#%qiwNC8lUG~ogPs5pYQz;Ov_ zh=VeK5dZ*f00@OI7=eNk(!f~)J|DnoB+!g33{-P?69K@ngfs*chfH^H#sJchkcPxT z)8g@=@$(x{3lu>R=K%aSAq@t~?VtU5{!u@0I3$7706cU;CxoHV1d$5~!@*r093T>) zD&f(v7qTHoOo7MZ(k31^NOJ@4uqzE+aCK_S%H&NP!|77{6&LN7h(-`B3=|wO;>!Ssb10ZF zp%DBW1adzZAeJ2qFd%SXt9a@~;a9IGSJ3_KqNjo}2_C6Fu$>Orvjggy^SNj&X>iO3$TEN~tr1At!fR1S{eWC=1n@L+J1 za8O&o0Pxly_$rj3d;x-SM;Qm&;$*<^y#)#ko^U3>{qY6}N?5Ro#p@854mhR86M~W< z5DZTL|4jH_Zvp+m@V7yLCWAj?V4weH?tk4BbcnwsAi*Kw1lj_d`h$Z$3DhM`81K+< z_#c1%PY41@Fk?7c8l0Dcyz4}`THrJCc=Ey6K~06HAkYPV?t+5DSo|$M7$y>qEzJa* z7J_mZ1ZRBr0NMo3a8MMW;ZGkI*b(@#0?=f^S>?fXM1xbqUqk=TWpLvp2$>*5;rlP> z5J^zl02+Q>3-p5~Fcw_KI}qV;E(6YA@RbXMpa}Mzz_aiT2-p<(E)@Rk5J0 z1|f?d(Lv`3{F)uij9{+{DrZ^z!V2_w?3kgX;!pxW{=1tQSWks729W-va0P zSVoqqDPwPMf1W@f0{7TZ+soOT2P8}$V=5_aH6AMkRdt-zs-iVO z43~kcsj7pAzG^Zk4YWE4IdEyjiT^)`H5Ir5*3aMG*FVVD$(afiOei>-N0$ & Maximum timestep that is used by the model & s\\ + wctime & 8640000. & $x \in \mathbb{R}, \quad x>0$ & Maximum wall clock time of a simulation & s\\ runtime & 300 & $x \in \mathbb{R}, \quad x>0$ & Total simulation (or: run) time & s\\ + ltotruntime & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & If true, the runtime is counted since the last cold start instead of the last warm start & -\\ lwarmstart& .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Flag for a ``cold'' or a ``warm'' start & -\\ startfile & - & $x = \text{initd\#\#h\#\#mxxx.\#\#\#}$ & Basis for the name of the restartfiles & -\\ trestart & 3600 & $x \in \mathbb{R}, \quad x>0$ & Each $trestart$ seconds, a restart file is written to disk & s\\ @@ -353,11 +358,16 @@ \subsection{Namelist NAMSUBGRID}\label{par:subgrid} lsmagorinsky & .false.& $x\in\{\text{.false.},\text{.true.}\}$ & Switch for smagorinsky subgrid scheme & -\\ cs & -1 & $x \in \mathbb{R}, \quad x>0$ & Smagorinsky constant & -\\ nmason & 2 & $x \in \mathbb{R}, \quad x>0$ & Exponent in Mason correction function & -\\ - sgs\_surface\_fix & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to apply a fix to the coupling of SFS TKE to the surface (experimental) & - \\ +% sgs\_surface\_fix & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to apply a fix to the coupling of SFS TKE to the surface (experimental) & - \\ + ch1 & 1.0 & $x \in \mathbb{R}, \quad x>0$ & Subfilter scale parameter & -\\ + ch2 & 2.0 & $x \in \mathbb{R}, \quad x>0$ & Subfilter scale parameter & -\\ + cm & 0.12 & $x \in \mathbb{R}, \quad x>0$ & Subfilter scale parameter & -\\ + ce1 & 0.19 & $x \in \mathbb{R}, \quad x>0$ & Subfilter scale parameter & -\\ + ce2 & 0.51 & $x \in \mathbb{R}, \quad x>0$ & Subfilter scale parameter & -\\ \end{supertabular} \end{center} -\newpage +%\newpage \section{Extra modules}\label{par:extramod} \subsection{Namelist NAMAGScross}\label{par:agscross} @@ -415,6 +425,7 @@ \subsection{Namelist NAMBUDGET}\label{par:budget} \end{supertabular} \end{center} +\newpage \subsection{Namelist NAMBULKMICROSTAT}\label{par:bulkmicrostat} \begin{center} @@ -458,8 +469,8 @@ \subsection{Namelist NAMCANOPY}\label{par:canopy} } \tabletail{ &&&&\\\hline - \multicolumn{5}{c}{}\\ - \multicolumn{5}{r}{\small \it Continued on next page}\\ +% \multicolumn{5}{c}{}\\ +% \multicolumn{5}{r}{\small \it Continued on next page}\\ } \tablelasttail{ &&&&\\\hline @@ -486,6 +497,7 @@ \subsection{Namelist NAMCANOPY}\label{par:canopy} \end{supertabular} \end{center} +\newpage \subsection{Namelist NAMCAPE}\label{par:cape} \begin{center} @@ -513,7 +525,7 @@ \subsection{Namelist NAMCAPE}\label{par:cape} \end{supertabular} \end{center} -\newpage +%\newpage \subsection{Namelist NAMCHECKSIM}\label{par:checksim} \begin{center} @@ -582,7 +594,7 @@ \subsection{Namelist NAMCHEM}\label{par:chem} \end{supertabular} \end{center} -\newpage +%\newpage \subsection{Namelist NAMCLOUDFIELD}\label{par:cloudfield} \begin{center} @@ -643,6 +655,7 @@ \subsection{Namelist NAMCROSSSECTION}\label{par:crosssection} \end{supertabular} \end{center} +\newpage \subsection{Namelist NAMDE}\label{par:deltaeddington} \begin{center} @@ -674,7 +687,7 @@ \subsection{Namelist NAMDE}\label{par:deltaeddington} \end{supertabular} \end{center} -\newpage +%\newpage \subsection{Namelist NAMFIELDDUMP}\label{par:fielddump} \begin{center} @@ -703,6 +716,9 @@ \subsection{Namelist NAMFIELDDUMP}\label{par:fielddump} ldiracc & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to dump into binary direct access files instead of Fortran unformatted files & -\\ klow & 1 & $x \in \mathbb{N}, \quad 1 \le x \le \text{khigh}$ & Lowest level of the 3d-field output & -\\ khigh & $kmax$ & $x \in \mathbb{N}, \quad \text{klow} \le x \le \text{kmax}$ & Highest level of the 3d-field output & -\\ + ncoarse & 1 & $x \in \mathbb{N}, \quad x \geq 1 $ & Factor by which to reduce (sample) the 3d-field to be written (in each horizontal direction) & -\\ + tmin & 0.0 & $x \in \mathbb{R}, \quad x \geq 0$ & Start time of field dump; not active yet & s \\ + tmax & $10^8$ & $x \in \mathbb{R}, \quad x \geq 0$ & End time of field dump; not active yet & s \\ \end{supertabular} \end{center} @@ -761,7 +777,7 @@ \subsection{Namelist NAMHETEROSTATS}\label{par:namheterostats} \end{supertabular} \end{center} -\newpage +%\newpage \subsection{Namelist NAMLSMCROSSSECTION}\label{par:lsmcrosssection} \begin{center} \tablefirsthead{ @@ -859,6 +875,7 @@ \subsection{Namelist NAMMICROPHYSICS}\label{par:microphysics} Nc\_0 & 70e6 & $x \in \mathbb{R}, \quad x \ge 0$ & Initial number of cloud droplets & -\\ sig\_g & 1.34 & $x \in \mathbb{R}, \quad x \ge 0$ & Geometric standard deviation of the cloud droplet drop size distribution & -\\ sig\_gr & 1.5 & $x \in \mathbb{R}, \quad x \ge 0$ & Geometric standard deviation of the rain droplet drop size distribution & -\\ + courantp & 1.0 & $x \in \mathbb{R}, \quad x>0$ & CFLmax-criterion for precipitation & -\\ \end{supertabular} \end{center} @@ -917,73 +934,10 @@ \subsection{Namelist NAMNUDGE}\label{par:nudge} \end{supertabular} \end{center} -\newpage -\subsection{Namelist NAMPARTICLES}\label{par:particles} -\begin{center} - \tablefirsthead{ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tablehead{ - \multicolumn{5}{l}{\small \it Continued from previous page}\\ - \multicolumn{5}{c}{}\\ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tabletail{ - &&&&\\\hline - \multicolumn{5}{c}{}\\ - \multicolumn{5}{r}{\small \it Continued on next page}\\ - } - \tablelasttail{ - &&&&\\\hline - } -\begin{supertabular}{|l|p{1.6cm}|p{4cm}|p{6cm}|l|} - lpartic & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to enable/disable this routine & -\\ - lpartsgs & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for subgrid diffusion & -\\ - &&&&\\ - \multirow{3}{*}{intmeth} & \multirow{3}{*}{3} & \multirow{3}{*}{$x\in\{0,3\}$} & Flag for time integration scheme & \multirow{3}{*}{-}\\ - & & & 0 = particles stand still & \\ - & & & 3 = Adams-Bashfort second order scheme &\\ - &&&&\\ - lstat & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for particle statistics & -\\ - dtav & 60 & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ - timeav & 3600 & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ - ldump & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for dump of particle field & -\\ - timedump & 3600 & $x \in \mathbb{R}, \quad x>0$ & Time interval for particle field dump & s\\ - npartdump & 10 & $x \in \mathbb{N}, \quad 0 \leq x \leq 10$ & Number of variables written at $timedump$, in order: $x$, $y$, $z$, $u$, $v$, $w$, $\theta_l$, $\theta_v$, $q_t$, $q_l$ & -\\ -\end{supertabular} -\end{center} +%\newpage + %\newpage -\subsection{Namelist NAMprojection}\label{par:projection} -Old version of modcrosssection (Paragraph \ref{par:crosssection}). Usage of modprojection is not advised. -\begin{center} - \tablefirsthead{ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tablehead{ - \multicolumn{5}{l}{\small \it Continued from previous page}\\ - \multicolumn{5}{c}{}\\ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tabletail{ - &&&&\\\hline - \multicolumn{5}{c}{}\\ - \multicolumn{5}{r}{\small \it Continued on next page}\\ - } - \tablelasttail{ - &&&&\\\hline - } -\begin{supertabular}{|l|p{1.6cm}|p{4cm}|p{6cm}|l|} - lproject & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to activate dumping of projections of the field & -\\ - dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ - projectheight & 2 & $x \in \mathbb{N}^*, \quad x \le \text{kmax}$ & Height of the xy-projection & -\\ -% projectplane & 2 & $x \in \mathbb{N}^*, \quad x \le \frac{\text{jtot}}{N_{\text{processors}}}$ & Position of the xz-plane on every processor & -\\ -\end{supertabular} -\end{center} \subsection{Namelist NAMquadrant}\label{par:quadrant} @@ -1127,7 +1081,6 @@ \subsection{Namelist NAMRADSTAT}\label{par:radstat} \end{supertabular} \end{center} -%\newpage \subsection{Namelist NAMSAMPLING}\label{par:sampling} \begin{center} \tablefirsthead{ @@ -1160,6 +1113,7 @@ \subsection{Namelist NAMSAMPLING}\label{par:sampling} \end{supertabular} \end{center} +\newpage \subsection{Namelist NAMSIMPLEICESTAT}\label{par:simpleicestat} \begin{center} \tablefirsthead{ @@ -1215,33 +1169,8 @@ \subsection{Namelist NAMSTATTEND}\label{par:stattend} \end{supertabular} \end{center} -\newpage -\subsection{Namelist NAMSTRESS}\label{par:stress} -\begin{center} - \tablefirsthead{ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tablehead{ - \multicolumn{5}{l}{\small \it Continued from previous page}\\ - \multicolumn{5}{c}{}\\ - \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ - \hline &&&&\\ - } - \tabletail{ - &&&&\\\hline - \multicolumn{5}{c}{}\\ - \multicolumn{5}{r}{\small \it Continued on next page}\\ - } - \tablelasttail{ - &&&&\\\hline - } -\begin{supertabular}{|l|p{2cm}|p{4cm}|p{6cm}|l|} - lstress & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for turbulent stress budget & -\\ - dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ - timeav & timeav\_glob & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ -\end{supertabular} -\end{center} +%\newpage + %\newpage \subsection{Namelist NAMSURFACE}\label{par:surface} @@ -1312,13 +1241,14 @@ \subsection{Namelist NAMSURFACE}\label{par:surface} phifc & 0.323 & $x \in \mathbb{R}, \quad x > 0$ & volumetric moisture at field capacity & - \\ phiwp & 0.171 & $x \in \mathbb{R}, \quad x > 0$ & volumetric moisture at wilting point & - \\ R10 & 0.23 & $x \in \mathbb{R}, \quad x > 0$ & Respiration at 10 $^{\circ}$C & mg m$^{-2}$ s$^{-1}$ \\ + lsplitleaf & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to split $\text{A-}\text{g}_\text{s}$ calculations over different parts of the leaf & - \\ \end{supertabular} \end{center} %\newpage -\subsection{Namelist NAMTILT}\label{par:tilt} +\subsection{Namelist NAMTESTBED}\label{par:testbed} \begin{center} \tablefirsthead{ \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ @@ -1339,14 +1269,15 @@ \subsection{Namelist NAMTILT}\label{par:tilt} &&&&\\\hline } \begin{supertabular}{|l|p{2cm}|p{4cm}|p{6cm}|l|} - ltilted & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for a tilted boundary layer & -\\ - alfa & 0 & $x \in \mathbb{R}, \quad - \frac{\pi}{2} \le x \le \frac{\pi}{2}$ & Tilt angle & rad\\ - lstat & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for statistics & -\\ - dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ - timeav & timeav\_glob & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ + ltestbed & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for testbed functionality & -\\ + ltb\_nudge & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for testbed nudging & -\\ + tb\_taunudge & 10800. & $x \in \mathbb{R}, \quad x > 0$ & Nudging timescale & s\\ \end{supertabular} \end{center} +\newpage + + \subsection{Namelist NAMTIMESTAT}\label{par:timestat} \begin{center} \tablefirsthead{ @@ -1386,6 +1317,130 @@ \subsection{Namelist NAMTIMESTAT}\label{par:timestat} \end{supertabular} \end{center} +\section{Addon modules}\label{par:addonmod} + +\subsection{Namelist NAMPARTICLES}\label{par:particles} +\begin{center} + \tablefirsthead{ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tablehead{ + \multicolumn{5}{l}{\small \it Continued from previous page}\\ + \multicolumn{5}{c}{}\\ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tabletail{ + &&&&\\\hline + \multicolumn{5}{c}{}\\ + \multicolumn{5}{r}{\small \it Continued on next page}\\ + } + \tablelasttail{ + &&&&\\\hline + } +\begin{supertabular}{|l|p{1.6cm}|p{4cm}|p{6cm}|l|} + lpartic & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to enable/disable this routine & -\\ + lpartsgs & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for subgrid diffusion & -\\ + &&&&\\ + \multirow{3}{*}{intmeth} & \multirow{3}{*}{3} & \multirow{3}{*}{$x\in\{0,3\}$} & Flag for time integration scheme & \multirow{3}{*}{-}\\ + & & & 0 = particles stand still & \\ + & & & 3 = Adams-Bashfort second order scheme &\\ + &&&&\\ + lstat & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for particle statistics & -\\ + dtav & 60 & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ + timeav & 3600 & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ + ldump & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for dump of particle field & -\\ + timedump & 3600 & $x \in \mathbb{R}, \quad x>0$ & Time interval for particle field dump & s\\ + npartdump & 10 & $x \in \mathbb{N}, \quad 0 \leq x \leq 10$ & Number of variables written at $timedump$, in order: $x$, $y$, $z$, $u$, $v$, $w$, $\theta_l$, $\theta_v$, $q_t$, $q_l$ & -\\ +\end{supertabular} +\end{center} + +\subsection{Namelist NAMprojection}\label{par:projection} +Old version of modcrosssection (Paragraph \ref{par:crosssection}). Usage of modprojection is not advised. +\begin{center} + \tablefirsthead{ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tablehead{ + \multicolumn{5}{l}{\small \it Continued from previous page}\\ + \multicolumn{5}{c}{}\\ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tabletail{ + &&&&\\\hline + \multicolumn{5}{c}{}\\ + \multicolumn{5}{r}{\small \it Continued on next page}\\ + } + \tablelasttail{ + &&&&\\\hline + } +\begin{supertabular}{|l|p{1.6cm}|p{4cm}|p{6cm}|l|} + lproject & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch to activate dumping of projections of the field & -\\ + dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ + projectheight & 2 & $x \in \mathbb{N}^*, \quad x \le \text{kmax}$ & Height of the xy-projection & -\\ +% projectplane & 2 & $x \in \mathbb{N}^*, \quad x \le \frac{\text{jtot}}{N_{\text{processors}}}$ & Position of the xz-plane on every processor & -\\ +\end{supertabular} +\end{center} + +\subsection{Namelist NAMSTRESS}\label{par:stress} +\begin{center} + \tablefirsthead{ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tablehead{ + \multicolumn{5}{l}{\small \it Continued from previous page}\\ + \multicolumn{5}{c}{}\\ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tabletail{ + &&&&\\\hline + \multicolumn{5}{c}{}\\ + \multicolumn{5}{r}{\small \it Continued on next page}\\ + } + \tablelasttail{ + &&&&\\\hline + } +\begin{supertabular}{|l|p{2cm}|p{4cm}|p{6cm}|l|} + lstress & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for turbulent stress budget & -\\ + dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ + timeav & timeav\_glob & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ +\end{supertabular} +\end{center} + +\subsection{Namelist NAMTILT}\label{par:tilt} +\begin{center} + \tablefirsthead{ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tablehead{ + \multicolumn{5}{l}{\small \it Continued from previous page}\\ + \multicolumn{5}{c}{}\\ + \multicolumn{1}{c}{Option} & \multicolumn{1}{c}{Default} & \multicolumn{1}{c}{Possible values} & \multicolumn{1}{c}{Description} & \multicolumn{1}{c}{Unit}\\ + \hline &&&&\\ + } + \tabletail{ + &&&&\\\hline + \multicolumn{5}{c}{}\\ + \multicolumn{5}{r}{\small \it Continued on next page}\\ + } + \tablelasttail{ + &&&&\\\hline + } +\begin{supertabular}{|l|p{2cm}|p{4cm}|p{6cm}|l|} + ltilted & .false. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for a tilted boundary layer & -\\ + alfa & 0 & $x \in \mathbb{R}, \quad - \frac{\pi}{2} \le x \le \frac{\pi}{2}$ & Tilt angle & rad\\ + lstat & .true. & $x\in\{\text{.false.},\text{.true.}\}$ & Switch for statistics & -\\ + dtav & dtav\_glob & $x = n \cdot \text{dtmax}, \quad n \in \mathbb{N}^*$ & Time interval for sampling of statistics & s\\ + timeav & timeav\_glob & $x = n \cdot \text{dtav}, \quad n \in \mathbb{N}^*$ & Time interval for writing statistics & s\\ +\end{supertabular} +\end{center} + \bibliographystyle{plainnat} \bibliography{literaturenam} From d4c6301504dabfb256da9ccc27f5b0ca24776cc9 Mon Sep 17 00:00:00 2001 From: Huug Ouwersloot Date: Sun, 2 Jun 2019 22:54:48 +0200 Subject: [PATCH 88/88] With correct DALES version mentioned now --- utils/doc/input/Namoptions.pdf | Bin 174530 -> 174530 bytes utils/doc/input/Namoptions.tex | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/doc/input/Namoptions.pdf b/utils/doc/input/Namoptions.pdf index 014452dda9066341f062ff5a5b0b563666cf273d..69027315d708288f85a0da6bdb1f685db2fd38c3 100644 GIT binary patch delta 421 zcmX?fnd{JHt_>e~nX(Kvf974tsC6LYtIyQ@CjB|p-iI>6zrL|*v6jiZ5O;u8-*;xw zEa7X5H~wauzkeI+73JoA{O$Yr8Mp7_XIfLGVwjj@nrLonple~CVxntkm};qO00g?G zX+~*=h9*e{#%Zb3`?{D85T~-Jo5_pC#LCEY`hjjHa|r8qH&YjJx>xovxvLT5B6a=g z+TBdbM47rhwwEc4iP;3`rfvO9@*u|c8~se(lJUj{u7*Yyrlw}D1|~*sCI+s?M#hGw vE|#W_u9g<2mde~nN}HY{>;0OQOkhYEOZ~|zJhnUoQq?xZhkHBu3(2_HKX_*lhjk0 zei8l0-bvT|W7-gXMX7lofBQau#_jv~nbuUPq@<);CK;Hd=~|el80#7urdsM60D*3z zxpA^dYMP;Wl7->)zAmN%#HlRmX7XY&vNAEAexRGl9K!nD&D2Gl?v*`E?rOxiNL_!r zb~lqUQKoK>?PUsMVm1Q0X