From 4f2f7cbce5c0b31d34f316238ca912ca5737c566 Mon Sep 17 00:00:00 2001 From: Hongjian Fang Date: Sun, 7 Aug 2016 20:05:49 +0200 Subject: [PATCH] add model uncertainty estimation add model uncertainty estimation with random models, also indent all the code to make them a little bit easy to read bug fix about shift when output the velocity model --- example/DSurfTomo.in | 4 +- src/CalSurfG.f90 | 5086 +++++++++++++++++++++--------------------- src/DSurfTomo | Bin 290488 -> 303016 bytes src/aprod.f90 | 76 +- src/delsph.f90 | 46 +- src/gaussian.f90 | 60 +- src/main.f90 | 1251 ++++++----- 7 files changed, 3316 insertions(+), 3207 deletions(-) diff --git a/example/DSurfTomo.in b/example/DSurfTomo.in index dd6984c..9bb20c2 100644 --- a/example/DSurfTomo.in +++ b/example/DSurfTomo.in @@ -5,7 +5,7 @@ surfdataTB.dat c: data file 18 18 9 c: nx ny nz (grid number in lat lon and depth direction) 25.2 121.35 c: goxd gozd (upper left point,[lat,lon]) 0.015 0.017 c: dvxd dvzd (grid interval in lat and lon direction) -449 c: nsrc*maxf +25i c: nsrc*maxf 4.0 0.0 c: weight damp 3 c: nsublayer (numbers of sublayers for each grid interval:grid --> layer) 0.5 2.8 c: minimum velocity, maximum velocity @@ -19,3 +19,5 @@ surfdataTB.dat c: data file 0 c: synthetic flag(0:real data,1:synthetic) 0.02 c: noiselevel 2.5 c: threshold +1 c: modest (1: estimate model variation, 0: no estimation) +30 c: number of random models diff --git a/src/CalSurfG.f90 b/src/CalSurfG.f90 index bac58a7..d0eb234 100644 --- a/src/CalSurfG.f90 +++ b/src/CalSurfG.f90 @@ -1,142 +1,142 @@ - subroutine depthkernel(nx,ny,nz,vel,pvRc,sen_vsRc,sen_vpRc,sen_rhoRc, & - iwave,igr,kmaxRc,tRc,depz,minthk) - use omp_lib - implicit none - - integer nx,ny,nz - real vel(nx,ny,nz) - real*8 sen_vpRc(ny*nx,kmaxRc,nz),sen_vsRc(ny*nx,kmaxRc,nz),sen_rhoRc(ny*nx,kmaxRc,nz) +subroutine depthkernel(nx,ny,nz,vel,pvRc,sen_vsRc,sen_vpRc,sen_rhoRc, & + iwave,igr,kmaxRc,tRc,depz,minthk) + use omp_lib + implicit none - integer iwave,igr - real minthk - real depz(nz) - integer kmaxRc - real*8 tRc(kmaxRc) - real*8 pvRc(nx*ny,kmaxRc) + integer nx,ny,nz + real vel(nx,ny,nz) + real*8 sen_vpRc(ny*nx,kmaxRc,nz),sen_vsRc(ny*nx,kmaxRc,nz),sen_rhoRc(ny*nx,kmaxRc,nz) + + integer iwave,igr + real minthk + real depz(nz) + integer kmaxRc + real*8 tRc(kmaxRc) + real*8 pvRc(nx*ny,kmaxRc) - real vpz(nz),vsz(nz),rhoz(nz) - real*8 dlncg_dlnvs(kmaxRc,nz),dlncg_dlnvp(kmaxRc,nz),dlncg_dlnrho(kmaxRc,nz) - integer mmax,iflsph,mode,rmax - integer ii,jj,k,i,nn,kk - integer,parameter::NL=200 - integer,parameter::NP=60 - real*8 cg1(NP),cg2(NP),cga,cgRc(NP) - real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) - real depm(NL),vpm(NL),vsm(NL),rhom(NL),thkm(NL) - real dlnVs,dlnVp,dlnrho + real vpz(nz),vsz(nz),rhoz(nz) + real*8 dlncg_dlnvs(kmaxRc,nz),dlncg_dlnvp(kmaxRc,nz),dlncg_dlnrho(kmaxRc,nz) + integer mmax,iflsph,mode,rmax + integer ii,jj,k,i,nn,kk + integer,parameter::NL=200 + integer,parameter::NP=60 + real*8 cg1(NP),cg2(NP),cga,cgRc(NP) + real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) + real depm(NL),vpm(NL),vsm(NL),rhom(NL),thkm(NL) + real dlnVs,dlnVp,dlnrho - mmax=nz - iflsph=1 - mode=1 - dlnVs=0.01 - dlnVp=0.01 - dlnrho=0.01 + mmax=nz + iflsph=1 + mode=1 + dlnVs=0.01 + dlnVp=0.01 + dlnrho=0.01 - !print*,'depth kernel begin...' -!$omp parallel & -!$omp default(private) & -!$omp shared(depz,nx,ny,nz,minthk,dlnvs,dlnvp,dlnrho,kmaxRc,mmax,vel) & -!$omp shared(sen_vpRc,sen_vsRc,sen_rhoRc,tRc,pvRc,iflsph,iwave,mode,igr) -!$omp do - do jj=1,ny - do ii=1,nx - vsz(1:nz)=vel(ii,jj,1:nz) - ! some other emperical relationship maybe better, - do k=1,nz + !print*,'depth kernel begin...' + !$omp parallel & + !$omp default(private) & + !$omp shared(depz,nx,ny,nz,minthk,dlnvs,dlnvp,dlnrho,kmaxRc,mmax,vel) & + !$omp shared(sen_vpRc,sen_vsRc,sen_rhoRc,tRc,pvRc,iflsph,iwave,mode,igr) + !$omp do + do jj=1,ny + do ii=1,nx + vsz(1:nz)=vel(ii,jj,1:nz) + ! some other emperical relationship maybe better, + do k=1,nz vpz(k)=0.9409 + 2.0947*vsz(k) - 0.8206*vsz(k)**2+ & - 0.2683*vsz(k)**3 - 0.0251*vsz(k)**4 - rhoz(k)=1.6612*vpz(k) - 0.4721*vpz(k)**2 + & - 0.0671*vpz(k)**3 - 0.0043*vpz(k)**4 + & - 0.000106*vpz(k)**5 - enddo - - call refineGrid2LayerMdl(minthk,mmax,depz,vpz,vsz,rhoz,rmax,rdep,& + 0.2683*vsz(k)**3 - 0.0251*vsz(k)**4 + rhoz(k)=1.6612*vpz(k) - 0.4721*vpz(k)**2 + & + 0.0671*vpz(k)**3 - 0.0043*vpz(k)**4 + & + 0.000106*vpz(k)**5 + enddo + + call refineGrid2LayerMdl(minthk,mmax,depz,vpz,vsz,rhoz,rmax,rdep,& rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,igr,kmaxRc,& + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,igr,kmaxRc,& tRc,cgRc) - pvRc((jj-1)*nx+ii,1:kmaxRc)=cgRc(1:kmaxRc) - !print*,cgRc(1:kmaxRc) - do kk=1,mmax-1 - depm(kk)=depz(kk) - vsm(kk) = vsz(kk) - vpm(kk) = vpz(kk) - thkm(kk) = depz(kk+1)-depz(kk) - rhom(kk) = rhoz(kk) - enddo - !!half space - depm(mmax) = depz(mmax) - vsm(mmax) = vsz(mmax) - vpm(mmax) = vpz(mmax) - rhom(mmax) = rhoz(mmax) - thkm(mmax) = 0.0 - !! calculate sensitivity kernel - do i = 1, mmax - vsm(i) = vsz(i) - 0.5*dlnVs*vsz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg1) - - vsm(i) = vsz(i) + 0.5*dlnVs*vsz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg2) - vsm(i) = vsz(i) - - do nn = 1,kmaxRc -! cga = 0.5*(cg1(nn)+cg2(nn)) - dlncg_dlnvs(nn,i) = (cg2(nn)-cg1(nn))/(dlnVs*vsz(i)) - enddo - - - vpm(i) = vpz(i) - 0.5*dlnVp*vpz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg1) - - vpm(i) = vpz(i) + 0.5*dlnVp*vpz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg2) - vpm(i) = vpz(i) - - do nn = 1,kmaxRc -! cga = 0.5*(cg1(nn)+cg2(nn)) - dlncg_dlnvp(nn,i) = (cg2(nn)-cg1(nn))/(dlnVp*vpz(i)) - enddo - rhom(i) = rhoz(i) - 0.5*dlnrho*rhoz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg1) - - rhom(i) = rhoz(i) + 0.5*dlnrho*rhoz(i) - call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& - rmax,rdep,rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& - igr,kmaxRc,tRc,cg2) - rhom(i) = rhoz(i) - - do nn = 1,kmaxRc -! cga = 0.5*(cg1(nn)+cg2(nn)) - dlncg_dlnrho(nn,i) = (cg2(nn)-cg1(nn))/(dlnrho*rhoz(i)) - enddo - enddo - sen_vsRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnvs(1:kmaxRc,1:mmax) - sen_vpRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnvp(1:kmaxRc,1:mmax) - sen_rhoRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnrho(1:kmaxRc,1:mmax) - ! print*,dlncg_dlnvp(1:kmaxRc,5) - enddo - enddo -!$omp end do -!$omp end parallel - end subroutine depthkernel + pvRc((jj-1)*nx+ii,1:kmaxRc)=cgRc(1:kmaxRc) + !print*,cgRc(1:kmaxRc) + do kk=1,mmax-1 + depm(kk)=depz(kk) + vsm(kk) = vsz(kk) + vpm(kk) = vpz(kk) + thkm(kk) = depz(kk+1)-depz(kk) + rhom(kk) = rhoz(kk) + enddo + !!half space + depm(mmax) = depz(mmax) + vsm(mmax) = vsz(mmax) + vpm(mmax) = vpz(mmax) + rhom(mmax) = rhoz(mmax) + thkm(mmax) = 0.0 + !! calculate sensitivity kernel + do i = 1, mmax + vsm(i) = vsz(i) - 0.5*dlnVs*vsz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg1) + + vsm(i) = vsz(i) + 0.5*dlnVs*vsz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg2) + vsm(i) = vsz(i) + + do nn = 1,kmaxRc + ! cga = 0.5*(cg1(nn)+cg2(nn)) + dlncg_dlnvs(nn,i) = (cg2(nn)-cg1(nn))/(dlnVs*vsz(i)) + enddo + + + vpm(i) = vpz(i) - 0.5*dlnVp*vpz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg1) + + vpm(i) = vpz(i) + 0.5*dlnVp*vpz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg2) + vpm(i) = vpz(i) + + do nn = 1,kmaxRc + ! cga = 0.5*(cg1(nn)+cg2(nn)) + dlncg_dlnvp(nn,i) = (cg2(nn)-cg1(nn))/(dlnVp*vpz(i)) + enddo + rhom(i) = rhoz(i) - 0.5*dlnrho*rhoz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg1) + + rhom(i) = rhoz(i) + 0.5*dlnrho*rhoz(i) + call refineGrid2LayerMdl(minthk,mmax,depm,vpm,vsm,rhom,& + rmax,rdep,rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,& + igr,kmaxRc,tRc,cg2) + rhom(i) = rhoz(i) + + do nn = 1,kmaxRc + ! cga = 0.5*(cg1(nn)+cg2(nn)) + dlncg_dlnrho(nn,i) = (cg2(nn)-cg1(nn))/(dlnrho*rhoz(i)) + enddo + enddo + sen_vsRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnvs(1:kmaxRc,1:mmax) + sen_vpRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnvp(1:kmaxRc,1:mmax) + sen_rhoRc((jj-1)*nx+ii,1:kmaxRc,1:mmax)=dlncg_dlnrho(1:kmaxRc,1:mmax) + ! print*,dlncg_dlnvp(1:kmaxRc,5) + enddo + enddo + !$omp end do + !$omp end parallel +end subroutine depthkernel !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -149,71 +149,71 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MODULE globalp -IMPLICIT NONE -INTEGER, PARAMETER :: i10=SELECTED_REAL_KIND(6) -INTEGER :: checkstat -INTEGER, SAVE :: nvx,nvz,nnx,nnz,fom,gdx,gdz -INTEGER, SAVE :: vnl,vnr,vnt,vnb,nrnx,nrnz,sgdl,rbint -INTEGER, SAVE :: nnxr,nnzr,asgr -INTEGER, DIMENSION (:,:), ALLOCATABLE :: nsts,nstsr,srs -REAL(KIND=i10), SAVE :: gox,goz,dnx,dnz,dvx,dvz,snb,earth -REAL(KIND=i10), SAVE :: goxd,gozd,dvxd,dvzd,dnxd,dnzd -REAL(KIND=i10), SAVE :: drnx,drnz,gorx,gorz -REAL(KIND=i10), SAVE :: dnxr,dnzr,goxr,gozr -REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE, SAVE :: velv,veln,velnb -REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE, SAVE :: ttn,ttnr -!REAL(KIND=i10), DIMENSION (:), ALLOCATABLE, SAVE :: rcx,rcz -REAL(KIND=i10), PARAMETER :: pi=3.1415926535898 -!!!-------------------------------------------------------------- -!! modified by Hongjian Fang @ USTC -! real,dimension(:),allocatable,save::rw -! integer,dimension(:),allocatable,save::iw,col -! real,dimension(:,:,:),allocatable::vpf,vsf -! real,dimension(:),allocatable,save::obst,cbst,wt,dtres -!! integer,dimension(:),allocatable,save::cbst_stat -! real,dimension(:,:,:),allocatable,save::sen_vs,sen_vp,sen_rho -!!! real,dimension(:,:,:),allocatable,save::sen_vsRc,sen_vpRc,sen_rhoRc -!!! real,dimension(:,:,:),allocatable,save::sen_vsRg,sen_vpRg,sen_rhoRg -!!! real,dimension(:,:,:),allocatable,save::sen_vsLc,sen_vpLc,sen_rhoLc -!!! real,dimension(:,:,:),allocatable,save::sen_vsLg,sen_vpLg,sen_rhoLg -!!! integer,save:: count1,count2 -! integer*8,save:: nar -! integer,save:: iter,maxiter -!!!-------------------------------------------------------------- -! -! nvx,nvz = B-spline vertex values -! dvx,dvz = B-spline vertex separation -! velv(i,j) = velocity values at control points -! nnx,nnz = Number of nodes of grid in x and z -! nnxr,nnzr = Number of nodes of refined grid in x and z -! gox,goz = Origin of grid (theta,phi) -! goxr, gozr = Origin of refined grid (theta,phi) -! dnx,dnz = Node separation of grid in x and z -! dnxr,dnzr = Node separation of refined grid in x and z -! veln(i,j) = velocity values on a refined grid of nodes -! velnb(i,j) = Backup of veln required for source grid refinement -! ttn(i,j) = traveltime field on the refined grid of nodes -! ttnr(i,j) = ttn for refined grid -! nsts(i,j) = node status (-1=far,0=alive,>0=close) -! nstsr(i,j) = nsts for refined grid -! checkstat = check status of memory allocation -! fom = use first-order(0) or mixed-order(1) scheme -! snb = Maximum size of narrow band as fraction of nnx*nnz -! nrc = number of receivers -! rcx(i),rcz(i) = (x,z) coordinates of receivers -! earth = radius of Earth (in km) -! goxd,gozd = gox,goz in degrees -! dvxd,dvzd = dvx,dvz in degrees -! dnzd,dnzd = dnx,dnz in degrees -! gdx,gdz = grid dicing in x and z -! vnl,vnr,vnb,vnt = Bounds of refined grid -! nrnx,nrnz = Number of nodes in x and z for refined grid -! gorx,gorz = Grid origin of refined grid -! sgdl = Source grid dicing level -! rbint = Ray-boundary intersection (0=no, 1=yes). -! asgr = Apply source grid refinement (0=no,1=yes) -! srs = Source-receiver status (0=no path, 1=path exists) -! + IMPLICIT NONE + INTEGER, PARAMETER :: i10=SELECTED_REAL_KIND(6) + INTEGER :: checkstat + INTEGER, SAVE :: nvx,nvz,nnx,nnz,fom,gdx,gdz + INTEGER, SAVE :: vnl,vnr,vnt,vnb,nrnx,nrnz,sgdl,rbint + INTEGER, SAVE :: nnxr,nnzr,asgr + INTEGER, DIMENSION (:,:), ALLOCATABLE :: nsts,nstsr,srs + REAL(KIND=i10), SAVE :: gox,goz,dnx,dnz,dvx,dvz,snb,earth + REAL(KIND=i10), SAVE :: goxd,gozd,dvxd,dvzd,dnxd,dnzd + REAL(KIND=i10), SAVE :: drnx,drnz,gorx,gorz + REAL(KIND=i10), SAVE :: dnxr,dnzr,goxr,gozr + REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE, SAVE :: velv,veln,velnb + REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE, SAVE :: ttn,ttnr + !REAL(KIND=i10), DIMENSION (:), ALLOCATABLE, SAVE :: rcx,rcz + REAL(KIND=i10), PARAMETER :: pi=3.1415926535898 + !!!-------------------------------------------------------------- + !! modified by Hongjian Fang @ USTC + ! real,dimension(:),allocatable,save::rw + ! integer,dimension(:),allocatable,save::iw,col + ! real,dimension(:,:,:),allocatable::vpf,vsf + ! real,dimension(:),allocatable,save::obst,cbst,wt,dtres + !! integer,dimension(:),allocatable,save::cbst_stat + ! real,dimension(:,:,:),allocatable,save::sen_vs,sen_vp,sen_rho + !!! real,dimension(:,:,:),allocatable,save::sen_vsRc,sen_vpRc,sen_rhoRc + !!! real,dimension(:,:,:),allocatable,save::sen_vsRg,sen_vpRg,sen_rhoRg + !!! real,dimension(:,:,:),allocatable,save::sen_vsLc,sen_vpLc,sen_rhoLc + !!! real,dimension(:,:,:),allocatable,save::sen_vsLg,sen_vpLg,sen_rhoLg + !!! integer,save:: count1,count2 + ! integer*8,save:: nar + ! integer,save:: iter,maxiter + !!!-------------------------------------------------------------- + ! + ! nvx,nvz = B-spline vertex values + ! dvx,dvz = B-spline vertex separation + ! velv(i,j) = velocity values at control points + ! nnx,nnz = Number of nodes of grid in x and z + ! nnxr,nnzr = Number of nodes of refined grid in x and z + ! gox,goz = Origin of grid (theta,phi) + ! goxr, gozr = Origin of refined grid (theta,phi) + ! dnx,dnz = Node separation of grid in x and z + ! dnxr,dnzr = Node separation of refined grid in x and z + ! veln(i,j) = velocity values on a refined grid of nodes + ! velnb(i,j) = Backup of veln required for source grid refinement + ! ttn(i,j) = traveltime field on the refined grid of nodes + ! ttnr(i,j) = ttn for refined grid + ! nsts(i,j) = node status (-1=far,0=alive,>0=close) + ! nstsr(i,j) = nsts for refined grid + ! checkstat = check status of memory allocation + ! fom = use first-order(0) or mixed-order(1) scheme + ! snb = Maximum size of narrow band as fraction of nnx*nnz + ! nrc = number of receivers + ! rcx(i),rcz(i) = (x,z) coordinates of receivers + ! earth = radius of Earth (in km) + ! goxd,gozd = gox,goz in degrees + ! dvxd,dvzd = dvx,dvz in degrees + ! dnzd,dnzd = dnx,dnz in degrees + ! gdx,gdz = grid dicing in x and z + ! vnl,vnr,vnb,vnt = Bounds of refined grid + ! nrnx,nrnz = Number of nodes in x and z for refined grid + ! gorx,gorz = Grid origin of refined grid + ! sgdl = Source grid dicing level + ! rbint = Ray-boundary intersection (0=no, 1=yes). + ! asgr = Apply source grid refinement (0=no,1=yes) + ! srs = Source-receiver status (0=no path, 1=path exists) + ! END MODULE globalp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -232,663 +232,663 @@ END MODULE globalp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MODULE traveltime -USE globalp -IMPLICIT NONE -INTEGER ntr -TYPE backpointer - INTEGER(KIND=2) :: px,pz -END TYPE backpointer -TYPE(backpointer), DIMENSION (:), ALLOCATABLE :: btg -! -! btg = backpointer to relate grid nodes to binary tree entries -! px = grid-point in x -! pz = grid-point in z -! ntr = number of entries in binary tree -! + USE globalp + IMPLICIT NONE + INTEGER ntr + TYPE backpointer + INTEGER(KIND=2) :: px,pz + END TYPE backpointer + TYPE(backpointer), DIMENSION (:), ALLOCATABLE :: btg + ! + ! btg = backpointer to relate grid nodes to binary tree entries + ! px = grid-point in x + ! pz = grid-point in z + ! ntr = number of entries in binary tree + ! CONTAINS -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine is passed the location of a source, and from -! this point the first-arrival traveltime field through the -! velocity grid is determined. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE travel(scx,scz,urg) -IMPLICIT NONE -INTEGER :: isx,isz,sw,i,j,ix,iz,urg,swrg -REAL(KIND=i10) :: scx,scz,vsrc,dsx,dsz,ds -REAL(KIND=i10), DIMENSION (2,2) :: vss -! isx,isz = grid cell indices (i,j,k) which contains source -! scx,scz = (r,x,y) location of source -! sw = a switch (0=off,1=on) -! ix,iz = j,k position of "close" point with minimum traveltime -! maxbt = maximum size of narrow band binary tree -! rd2,rd3 = substitution variables -! vsrc = velocity at source -! vss = velocity at nodes surrounding source -! dsx, dsz = distance from source to cell boundary in x and z -! ds = distance from source to nearby node -! urg = use refined grid (0=no,1=yes,2=previously used) -! swrg = switch to end refined source grid computation -! -! The first step is to find out where the source resides -! in the grid of nodes. The cell in which it resides is -! identified by the "north-west" node of the cell. If the -! source lies on the edge or corner (a node) of the cell, then -! this scheme still applies. -! -isx=INT((scx-gox)/dnx)+1 -isz=INT((scz-goz)/dnz)+1 -sw=0 -IF(isx.lt.1.or.isx.gt.nnx)sw=1 -IF(isz.lt.1.or.isz.gt.nnz)sw=1 -IF(sw.eq.1)then - scx=90.0-scx*180.0/pi - scz=scz*180.0/pi - WRITE(6,*)"Source lies outside bounds of model (lat,long)= ",scx,scz - WRITE(6,*)"TERMINATING PROGRAM!!!" - STOP -ENDIF -IF(isx.eq.nnx)isx=isx-1 -IF(isz.eq.nnz)isz=isz-1 -! -! Set all values of nsts to -1 if beginning from a source -! point. -! -IF(urg.NE.2)nsts=-1 -! -! set initial size of binary tree to zero -! -ntr=0 -IF(urg.EQ.2)THEN -! -! In this case, source grid refinement has been applied, so -! the initial narrow band will come from resampling the -! refined grid. -! - DO i=1,nnx - DO j=1,nnz - IF(nsts(j,i).GT.0)THEN + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine is passed the location of a source, and from + ! this point the first-arrival traveltime field through the + ! velocity grid is determined. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE travel(scx,scz,urg) + IMPLICIT NONE + INTEGER :: isx,isz,sw,i,j,ix,iz,urg,swrg + REAL(KIND=i10) :: scx,scz,vsrc,dsx,dsz,ds + REAL(KIND=i10), DIMENSION (2,2) :: vss + ! isx,isz = grid cell indices (i,j,k) which contains source + ! scx,scz = (r,x,y) location of source + ! sw = a switch (0=off,1=on) + ! ix,iz = j,k position of "close" point with minimum traveltime + ! maxbt = maximum size of narrow band binary tree + ! rd2,rd3 = substitution variables + ! vsrc = velocity at source + ! vss = velocity at nodes surrounding source + ! dsx, dsz = distance from source to cell boundary in x and z + ! ds = distance from source to nearby node + ! urg = use refined grid (0=no,1=yes,2=previously used) + ! swrg = switch to end refined source grid computation + ! + ! The first step is to find out where the source resides + ! in the grid of nodes. The cell in which it resides is + ! identified by the "north-west" node of the cell. If the + ! source lies on the edge or corner (a node) of the cell, then + ! this scheme still applies. + ! + isx=INT((scx-gox)/dnx)+1 + isz=INT((scz-goz)/dnz)+1 + sw=0 + IF(isx.lt.1.or.isx.gt.nnx)sw=1 + IF(isz.lt.1.or.isz.gt.nnz)sw=1 + IF(sw.eq.1)then + scx=90.0-scx*180.0/pi + scz=scz*180.0/pi + WRITE(6,*)"Source lies outside bounds of model (lat,long)= ",scx,scz + WRITE(6,*)"TERMINATING PROGRAM!!!" + STOP + ENDIF + IF(isx.eq.nnx)isx=isx-1 + IF(isz.eq.nnz)isz=isz-1 + ! + ! Set all values of nsts to -1 if beginning from a source + ! point. + ! + IF(urg.NE.2)nsts=-1 + ! + ! set initial size of binary tree to zero + ! + ntr=0 + IF(urg.EQ.2)THEN + ! + ! In this case, source grid refinement has been applied, so + ! the initial narrow band will come from resampling the + ! refined grid. + ! + DO i=1,nnx + DO j=1,nnz + IF(nsts(j,i).GT.0)THEN CALL addtree(j,i) - ENDIF + ENDIF + ENDDO ENDDO - ENDDO -ELSE -! -! In general, the source point need not lie on a grid point. -! Bi-linear interpolation is used to find velocity at the -! source point. -! - nsts=-1 - DO i=1,2 - DO j=1,2 - vss(i,j)=veln(isz-1+j,isx-1+i) + ELSE + ! + ! In general, the source point need not lie on a grid point. + ! Bi-linear interpolation is used to find velocity at the + ! source point. + ! + nsts=-1 + DO i=1,2 + DO j=1,2 + vss(i,j)=veln(isz-1+j,isx-1+i) + ENDDO ENDDO - ENDDO - dsx=(scx-gox)-(isx-1)*dnx - dsz=(scz-goz)-(isz-1)*dnz - CALL bilinear(vss,dsx,dsz,vsrc) -! -! Now find the traveltime at the four surrounding grid points. This -! is calculated approximately by assuming the traveltime from the -! source point to each node is equal to the the distance between -! the two points divided by the average velocity of the points -! - DO i=1,2 - DO j=1,2 - ds=SQRT((dsx-(i-1)*dnx)**2+(dsz-(j-1)*dnz)**2) - ttn(isz-1+j,isx-1+i)=2.0*ds/(vss(i,j)+vsrc) - CALL addtree(isz-1+j,isx-1+i) + dsx=(scx-gox)-(isx-1)*dnx + dsz=(scz-goz)-(isz-1)*dnz + CALL bilinear(vss,dsx,dsz,vsrc) + ! + ! Now find the traveltime at the four surrounding grid points. This + ! is calculated approximately by assuming the traveltime from the + ! source point to each node is equal to the the distance between + ! the two points divided by the average velocity of the points + ! + DO i=1,2 + DO j=1,2 + ds=SQRT((dsx-(i-1)*dnx)**2+(dsz-(j-1)*dnz)**2) + ttn(isz-1+j,isx-1+i)=2.0*ds/(vss(i,j)+vsrc) + CALL addtree(isz-1+j,isx-1+i) + ENDDO ENDDO - ENDDO -ENDIF -! -! Now calculate the first-arrival traveltimes at the -! remaining grid points. This is done via a loop which -! repeats the procedure of finding the first-arrival -! of all "close" points, adding it to the set of "alive" -! points and updating the points surrounding the new "alive" -! point. The process ceases when the binary tree is empty, -! in which case all grid points are "alive". -! -DO WHILE(ntr.gt.0) -! -! First, check whether source grid refinement is -! being applied; if so, then there is a special -! exit condition. -! -IF(urg.EQ.1)THEN - ix=btg(1)%px - iz=btg(1)%pz - swrg=0 - IF(ix.EQ.1)THEN - IF(vnl.NE.1)swrg=1 - ENDIF - IF(ix.EQ.nnx)THEN - IF(vnr.NE.nnx)swrg=1 - ENDIF - IF(iz.EQ.1)THEN - IF(vnt.NE.1)swrg=1 - ENDIF - IF(iz.EQ.nnz)THEN - IF(vnb.NE.nnz)swrg=1 - ENDIF - IF(swrg.EQ.1)THEN + ENDIF + ! + ! Now calculate the first-arrival traveltimes at the + ! remaining grid points. This is done via a loop which + ! repeats the procedure of finding the first-arrival + ! of all "close" points, adding it to the set of "alive" + ! points and updating the points surrounding the new "alive" + ! point. The process ceases when the binary tree is empty, + ! in which case all grid points are "alive". + ! + DO WHILE(ntr.gt.0) + ! + ! First, check whether source grid refinement is + ! being applied; if so, then there is a special + ! exit condition. + ! + IF(urg.EQ.1)THEN + ix=btg(1)%px + iz=btg(1)%pz + swrg=0 + IF(ix.EQ.1)THEN + IF(vnl.NE.1)swrg=1 + ENDIF + IF(ix.EQ.nnx)THEN + IF(vnr.NE.nnx)swrg=1 + ENDIF + IF(iz.EQ.1)THEN + IF(vnt.NE.1)swrg=1 + ENDIF + IF(iz.EQ.nnz)THEN + IF(vnb.NE.nnz)swrg=1 + ENDIF + IF(swrg.EQ.1)THEN + nsts(iz,ix)=0 + EXIT + ENDIF + ENDIF + ! + ! Set the "close" point with minimum traveltime + ! to "alive" + ! + ix=btg(1)%px + iz=btg(1)%pz nsts(iz,ix)=0 - EXIT - ENDIF -ENDIF -! -! Set the "close" point with minimum traveltime -! to "alive" -! - ix=btg(1)%px - iz=btg(1)%pz - nsts(iz,ix)=0 -! -! Update the binary tree by removing the root and -! sweeping down the tree. -! - CALL downtree -! -! Now update or find values of up to four grid points -! that surround the new "alive" point. -! -! Test points that vary in x -! - DO i=ix-1,ix+1,2 - IF(i.ge.1.and.i.le.nnx)THEN - IF(nsts(iz,i).eq.-1)THEN -! -! This option occurs when a far point is added to the list -! of "close" points -! + ! + ! Update the binary tree by removing the root and + ! sweeping down the tree. + ! + CALL downtree + ! + ! Now update or find values of up to four grid points + ! that surround the new "alive" point. + ! + ! Test points that vary in x + ! + DO i=ix-1,ix+1,2 + IF(i.ge.1.and.i.le.nnx)THEN + IF(nsts(iz,i).eq.-1)THEN + ! + ! This option occurs when a far point is added to the list + ! of "close" points + ! IF(fom.eq.0)THEN - CALL fouds1(iz,i) + CALL fouds1(iz,i) ELSE - CALL fouds2(iz,i) + CALL fouds2(iz,i) ENDIF CALL addtree(iz,i) - ELSE IF(nsts(iz,i).gt.0)THEN -! -! This happens when a "close" point is updated -! + ELSE IF(nsts(iz,i).gt.0)THEN + ! + ! This happens when a "close" point is updated + ! IF(fom.eq.0)THEN - CALL fouds1(iz,i) + CALL fouds1(iz,i) ELSE - CALL fouds2(iz,i) + CALL fouds2(iz,i) ENDIF CALL updtree(iz,i) - ENDIF - ENDIF - ENDDO -! -! Test points that vary in z -! - DO i=iz-1,iz+1,2 - IF(i.ge.1.and.i.le.nnz)THEN - IF(nsts(i,ix).eq.-1)THEN -! -! This option occurs when a far point is added to the list -! of "close" points -! + ENDIF + ENDIF + ENDDO + ! + ! Test points that vary in z + ! + DO i=iz-1,iz+1,2 + IF(i.ge.1.and.i.le.nnz)THEN + IF(nsts(i,ix).eq.-1)THEN + ! + ! This option occurs when a far point is added to the list + ! of "close" points + ! IF(fom.eq.0)THEN - CALL fouds1(i,ix) + CALL fouds1(i,ix) ELSE - CALL fouds2(i,ix) + CALL fouds2(i,ix) ENDIF CALL addtree(i,ix) - ELSE IF(nsts(i,ix).gt.0)THEN -! -! This happens when a "close" point is updated -! + ELSE IF(nsts(i,ix).gt.0)THEN + ! + ! This happens when a "close" point is updated + ! IF(fom.eq.0)THEN - CALL fouds1(i,ix) + CALL fouds1(i,ix) ELSE - CALL fouds2(i,ix) + CALL fouds2(i,ix) ENDIF CALL updtree(i,ix) - ENDIF - ENDIF - ENDDO -ENDDO -END SUBROUTINE travel + ENDIF + ENDIF + ENDDO + ENDDO + END SUBROUTINE travel -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine calculates a trial first-arrival traveltime -! at a given node from surrounding nodes using the -! First-Order Upwind Difference Scheme (FOUDS) of -! Sethian and Popovici (1999). -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE fouds1(iz,ix) -IMPLICIT NONE -INTEGER :: j,k,ix,iz,tsw1,swsol -REAL(KIND=i10) :: trav,travm,slown,tdsh,tref -REAL(KIND=i10) :: a,b,c,u,v,em,ri,risti -REAL(KIND=i10) :: rd1 -! -! ix = NS position of node coordinate for determination -! iz = EW vertical position of node coordinate for determination -! trav = traveltime calculated for trial node -! travm = minimum traveltime calculated for trial node -! slown = slowness at (iz,ix) -! tsw1 = traveltime switch (0=first time,1=previously) -! a,b,c,u,v,em = Convenience variables for solving quadratic -! tdsh = local traveltime from neighbouring node -! tref = reference traveltime at neighbouring node -! ri = Radial distance -! risti = ri*sin(theta) at point (iz,ix) -! rd1 = dummy variable -! swsol = switch for solution (0=no solution, 1=solution) -! -! Inspect each of the four quadrants for the minimum time -! solution. -! -tsw1=0 -slown=1.0/veln(iz,ix) -ri=earth -risti=ri*sin(gox+(ix-1)*dnx) -DO j=ix-1,ix+1,2 - DO k=iz-1,iz+1,2 - IF(j.GE.1.AND.j.LE.nnx)THEN - IF(k.GE.1.AND.k.LE.nnz)THEN -! -! There are seven solution options in -! each quadrant. -! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine calculates a trial first-arrival traveltime + ! at a given node from surrounding nodes using the + ! First-Order Upwind Difference Scheme (FOUDS) of + ! Sethian and Popovici (1999). + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE fouds1(iz,ix) + IMPLICIT NONE + INTEGER :: j,k,ix,iz,tsw1,swsol + REAL(KIND=i10) :: trav,travm,slown,tdsh,tref + REAL(KIND=i10) :: a,b,c,u,v,em,ri,risti + REAL(KIND=i10) :: rd1 + ! + ! ix = NS position of node coordinate for determination + ! iz = EW vertical position of node coordinate for determination + ! trav = traveltime calculated for trial node + ! travm = minimum traveltime calculated for trial node + ! slown = slowness at (iz,ix) + ! tsw1 = traveltime switch (0=first time,1=previously) + ! a,b,c,u,v,em = Convenience variables for solving quadratic + ! tdsh = local traveltime from neighbouring node + ! tref = reference traveltime at neighbouring node + ! ri = Radial distance + ! risti = ri*sin(theta) at point (iz,ix) + ! rd1 = dummy variable + ! swsol = switch for solution (0=no solution, 1=solution) + ! + ! Inspect each of the four quadrants for the minimum time + ! solution. + ! + tsw1=0 + slown=1.0/veln(iz,ix) + ri=earth + risti=ri*sin(gox+(ix-1)*dnx) + DO j=ix-1,ix+1,2 + DO k=iz-1,iz+1,2 + IF(j.GE.1.AND.j.LE.nnx)THEN + IF(k.GE.1.AND.k.LE.nnz)THEN + ! + ! There are seven solution options in + ! each quadrant. + ! swsol=0 IF(nsts(iz,j).EQ.0)THEN - swsol=1 - IF(nsts(k,ix).EQ.0)THEN - u=ri*dnx - v=risti*dnz - em=ttn(k,ix)-ttn(iz,j) - a=u**2+v**2 - b=-2.0*u**2*em - c=u**2*(em**2-v**2*slown**2) - tref=ttn(iz,j) - ELSE - a=1.0 - b=0.0 - c=-slown**2*ri**2*dnx**2 - tref=ttn(iz,j) - ENDIF + swsol=1 + IF(nsts(k,ix).EQ.0)THEN + u=ri*dnx + v=risti*dnz + em=ttn(k,ix)-ttn(iz,j) + a=u**2+v**2 + b=-2.0*u**2*em + c=u**2*(em**2-v**2*slown**2) + tref=ttn(iz,j) + ELSE + a=1.0 + b=0.0 + c=-slown**2*ri**2*dnx**2 + tref=ttn(iz,j) + ENDIF ELSE IF(nsts(k,ix).EQ.0)THEN - swsol=1 - a=1.0 - b=0.0 - c=-(slown*risti*dnz)**2 - tref=ttn(k,ix) + swsol=1 + a=1.0 + b=0.0 + c=-(slown*risti*dnz)**2 + tref=ttn(k,ix) ENDIF -! -! Now find the solution of the quadratic equation -! + ! + ! Now find the solution of the quadratic equation + ! IF(swsol.EQ.1)THEN - rd1=b**2-4.0*a*c - IF(rd1.LT.0.0)rd1=0.0 - tdsh=(-b+sqrt(rd1))/(2.0*a) - trav=tref+tdsh - IF(tsw1.EQ.1)THEN - travm=MIN(trav,travm) - ELSE - travm=trav - tsw1=1 - ENDIF + rd1=b**2-4.0*a*c + IF(rd1.LT.0.0)rd1=0.0 + tdsh=(-b+sqrt(rd1))/(2.0*a) + trav=tref+tdsh + IF(tsw1.EQ.1)THEN + travm=MIN(trav,travm) + ELSE + travm=trav + tsw1=1 + ENDIF ENDIF - ENDIF - ENDIF - ENDDO -ENDDO -ttn(iz,ix)=travm -END SUBROUTINE fouds1 + ENDIF + ENDIF + ENDDO + ENDDO + ttn(iz,ix)=travm + END SUBROUTINE fouds1 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine calculates a trial first-arrival traveltime -! at a given node from surrounding nodes using the -! Mixed-Order (2nd) Upwind Difference Scheme (FOUDS) of -! Popovici and Sethian (2002). -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE fouds2(iz,ix) -IMPLICIT NONE -INTEGER :: j,k,j2,k2,ix,iz,tsw1 -INTEGER :: swj,swk,swsol -REAL(KIND=i10) :: trav,travm,slown,tdsh,tref,tdiv -REAL(KIND=i10) :: a,b,c,u,v,em,ri,risti,rd1 -! -! ix = NS position of node coordinate for determination -! iz = EW vertical position of node coordinate for determination -! trav = traveltime calculated for trial node -! travm = minimum traveltime calculated for trial node -! slown = slowness at (iz,ix) -! tsw1 = traveltime switch (0=first time,1=previously) -! a,b,c,u,v,em = Convenience variables for solving quadratic -! tdsh = local traveltime from neighbouring node -! tref = reference traveltime at neighbouring node -! ri = Radial distance -! risti = ri*sin(theta) at point (iz,ix) -! swj,swk = switches for second order operators -! tdiv = term to divide tref by depending on operator order -! swsol = switch for solution (0=no solution, 1=solution) -! -! Inspect each of the four quadrants for the minimum time -! solution. -! -tsw1=0 -slown=1.0/veln(iz,ix) -ri=earth -risti=ri*sin(gox+(ix-1)*dnx) -DO j=ix-1,ix+1,2 - IF(j.GE.1.AND.j.LE.nnx)THEN - swj=-1 - IF(j.eq.ix-1)THEN - j2=j-1 - IF(j2.GE.1)THEN + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine calculates a trial first-arrival traveltime + ! at a given node from surrounding nodes using the + ! Mixed-Order (2nd) Upwind Difference Scheme (FOUDS) of + ! Popovici and Sethian (2002). + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE fouds2(iz,ix) + IMPLICIT NONE + INTEGER :: j,k,j2,k2,ix,iz,tsw1 + INTEGER :: swj,swk,swsol + REAL(KIND=i10) :: trav,travm,slown,tdsh,tref,tdiv + REAL(KIND=i10) :: a,b,c,u,v,em,ri,risti,rd1 + ! + ! ix = NS position of node coordinate for determination + ! iz = EW vertical position of node coordinate for determination + ! trav = traveltime calculated for trial node + ! travm = minimum traveltime calculated for trial node + ! slown = slowness at (iz,ix) + ! tsw1 = traveltime switch (0=first time,1=previously) + ! a,b,c,u,v,em = Convenience variables for solving quadratic + ! tdsh = local traveltime from neighbouring node + ! tref = reference traveltime at neighbouring node + ! ri = Radial distance + ! risti = ri*sin(theta) at point (iz,ix) + ! swj,swk = switches for second order operators + ! tdiv = term to divide tref by depending on operator order + ! swsol = switch for solution (0=no solution, 1=solution) + ! + ! Inspect each of the four quadrants for the minimum time + ! solution. + ! + tsw1=0 + slown=1.0/veln(iz,ix) + ri=earth + risti=ri*sin(gox+(ix-1)*dnx) + DO j=ix-1,ix+1,2 + IF(j.GE.1.AND.j.LE.nnx)THEN + swj=-1 + IF(j.eq.ix-1)THEN + j2=j-1 + IF(j2.GE.1)THEN IF(nsts(iz,j2).EQ.0)swj=0 - ENDIF - ELSE - j2=j+1 - IF(j2.LE.nnx)THEN + ENDIF + ELSE + j2=j+1 + IF(j2.LE.nnx)THEN IF(nsts(iz,j2).EQ.0)swj=0 - ENDIF - ENDIF - IF(nsts(iz,j).EQ.0.AND.swj.EQ.0)THEN - swj=-1 - IF(ttn(iz,j).GT.ttn(iz,j2))THEN + ENDIF + ENDIF + IF(nsts(iz,j).EQ.0.AND.swj.EQ.0)THEN + swj=-1 + IF(ttn(iz,j).GT.ttn(iz,j2))THEN swj=0 - ENDIF - ELSE - swj=-1 - ENDIF - DO k=iz-1,iz+1,2 - IF(k.GE.1.AND.k.LE.nnz)THEN + ENDIF + ELSE + swj=-1 + ENDIF + DO k=iz-1,iz+1,2 + IF(k.GE.1.AND.k.LE.nnz)THEN swk=-1 IF(k.eq.iz-1)THEN - k2=k-1 - IF(k2.GE.1)THEN - IF(nsts(k2,ix).EQ.0)swk=0 - ENDIF + k2=k-1 + IF(k2.GE.1)THEN + IF(nsts(k2,ix).EQ.0)swk=0 + ENDIF ELSE - k2=k+1 - IF(k2.LE.nnz)THEN - IF(nsts(k2,ix).EQ.0)swk=0 - ENDIF + k2=k+1 + IF(k2.LE.nnz)THEN + IF(nsts(k2,ix).EQ.0)swk=0 + ENDIF ENDIF IF(nsts(k,ix).EQ.0.AND.swk.EQ.0)THEN - swk=-1 - IF(ttn(k,ix).GT.ttn(k2,ix))THEN - swk=0 - ENDIF + swk=-1 + IF(ttn(k,ix).GT.ttn(k2,ix))THEN + swk=0 + ENDIF ELSE - swk=-1 + swk=-1 ENDIF -! -! There are 8 solution options in -! each quadrant. -! + ! + ! There are 8 solution options in + ! each quadrant. + ! swsol=0 IF(swj.EQ.0)THEN - swsol=1 - IF(swk.EQ.0)THEN - u=2.0*ri*dnx - v=2.0*risti*dnz - em=4.0*ttn(iz,j)-ttn(iz,j2)-4.0*ttn(k,ix) - em=em+ttn(k2,ix) - a=v**2+u**2 - b=2.0*em*u**2 - c=u**2*(em**2-slown**2*v**2) - tref=4.0*ttn(iz,j)-ttn(iz,j2) - tdiv=3.0 - ELSE IF(nsts(k,ix).EQ.0)THEN - u=risti*dnz - v=2.0*ri*dnx - em=3.0*ttn(k,ix)-4.0*ttn(iz,j)+ttn(iz,j2) - a=v**2+9.0*u**2 - b=6.0*em*u**2 - c=u**2*(em**2-slown**2*v**2) - tref=ttn(k,ix) - tdiv=1.0 - ELSE - u=2.0*ri*dnx - a=1.0 - b=0.0 - c=-u**2*slown**2 - tref=4.0*ttn(iz,j)-ttn(iz,j2) - tdiv=3.0 - ENDIF + swsol=1 + IF(swk.EQ.0)THEN + u=2.0*ri*dnx + v=2.0*risti*dnz + em=4.0*ttn(iz,j)-ttn(iz,j2)-4.0*ttn(k,ix) + em=em+ttn(k2,ix) + a=v**2+u**2 + b=2.0*em*u**2 + c=u**2*(em**2-slown**2*v**2) + tref=4.0*ttn(iz,j)-ttn(iz,j2) + tdiv=3.0 + ELSE IF(nsts(k,ix).EQ.0)THEN + u=risti*dnz + v=2.0*ri*dnx + em=3.0*ttn(k,ix)-4.0*ttn(iz,j)+ttn(iz,j2) + a=v**2+9.0*u**2 + b=6.0*em*u**2 + c=u**2*(em**2-slown**2*v**2) + tref=ttn(k,ix) + tdiv=1.0 + ELSE + u=2.0*ri*dnx + a=1.0 + b=0.0 + c=-u**2*slown**2 + tref=4.0*ttn(iz,j)-ttn(iz,j2) + tdiv=3.0 + ENDIF ELSE IF(nsts(iz,j).EQ.0)THEN - swsol=1 - IF(swk.EQ.0)THEN - u=ri*dnx - v=2.0*risti*dnz - em=3.0*ttn(iz,j)-4.0*ttn(k,ix)+ttn(k2,ix) - a=v**2+9.0*u**2 - b=6.0*em*u**2 - c=u**2*(em**2-v**2*slown**2) - tref=ttn(iz,j) - tdiv=1.0 - ELSE IF(nsts(k,ix).EQ.0)THEN - u=ri*dnx - v=risti*dnz - em=ttn(k,ix)-ttn(iz,j) - a=u**2+v**2 - b=-2.0*u**2*em - c=u**2*(em**2-v**2*slown**2) - tref=ttn(iz,j) - tdiv=1.0 - ELSE - a=1.0 - b=0.0 - c=-slown**2*ri**2*dnx**2 - tref=ttn(iz,j) - tdiv=1.0 - ENDIF + swsol=1 + IF(swk.EQ.0)THEN + u=ri*dnx + v=2.0*risti*dnz + em=3.0*ttn(iz,j)-4.0*ttn(k,ix)+ttn(k2,ix) + a=v**2+9.0*u**2 + b=6.0*em*u**2 + c=u**2*(em**2-v**2*slown**2) + tref=ttn(iz,j) + tdiv=1.0 + ELSE IF(nsts(k,ix).EQ.0)THEN + u=ri*dnx + v=risti*dnz + em=ttn(k,ix)-ttn(iz,j) + a=u**2+v**2 + b=-2.0*u**2*em + c=u**2*(em**2-v**2*slown**2) + tref=ttn(iz,j) + tdiv=1.0 + ELSE + a=1.0 + b=0.0 + c=-slown**2*ri**2*dnx**2 + tref=ttn(iz,j) + tdiv=1.0 + ENDIF ELSE - IF(swk.EQ.0)THEN - swsol=1 - u=2.0*risti*dnz - a=1.0 - b=0.0 - c=-u**2*slown**2 - tref=4.0*ttn(k,ix)-ttn(k2,ix) - tdiv=3.0 - ELSE IF(nsts(k,ix).EQ.0)THEN - swsol=1 - a=1.0 - b=0.0 - c=-slown**2*risti**2*dnz**2 - tref=ttn(k,ix) - tdiv=1.0 - ENDIF + IF(swk.EQ.0)THEN + swsol=1 + u=2.0*risti*dnz + a=1.0 + b=0.0 + c=-u**2*slown**2 + tref=4.0*ttn(k,ix)-ttn(k2,ix) + tdiv=3.0 + ELSE IF(nsts(k,ix).EQ.0)THEN + swsol=1 + a=1.0 + b=0.0 + c=-slown**2*risti**2*dnz**2 + tref=ttn(k,ix) + tdiv=1.0 + ENDIF ENDIF -! -! Now find the solution of the quadratic equation -! + ! + ! Now find the solution of the quadratic equation + ! IF(swsol.EQ.1)THEN - rd1=b**2-4.0*a*c - IF(rd1.LT.0.0)rd1=0.0 - tdsh=(-b+sqrt(rd1))/(2.0*a) - trav=(tref+tdsh)/tdiv - IF(tsw1.EQ.1)THEN - travm=MIN(trav,travm) - ELSE - travm=trav - tsw1=1 - ENDIF + rd1=b**2-4.0*a*c + IF(rd1.LT.0.0)rd1=0.0 + tdsh=(-b+sqrt(rd1))/(2.0*a) + trav=(tref+tdsh)/tdiv + IF(tsw1.EQ.1)THEN + travm=MIN(trav,travm) + ELSE + travm=trav + tsw1=1 + ENDIF ENDIF - ENDIF - ENDDO - ENDIF -ENDDO -ttn(iz,ix)=travm -END SUBROUTINE fouds2 + ENDIF + ENDDO + ENDIF + ENDDO + ttn(iz,ix)=travm + END SUBROUTINE fouds2 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine adds a value to the binary tree by -! placing a value at the bottom and pushing it up -! to its correct position. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE addtree(iz,ix) -IMPLICIT NONE -INTEGER :: ix,iz,tpp,tpc -TYPE(backpointer) :: exch -! -! ix,iz = grid position of new addition to tree -! tpp = tree position of parent -! tpc = tree position of child -! exch = dummy to exchange btg values -! -! First, increase the size of the tree by one. -! -ntr=ntr+1 -! -! Put new value at base of tree -! -nsts(iz,ix)=ntr -btg(ntr)%px=ix -btg(ntr)%pz=iz -! -! Now filter the new value up to its correct position -! -tpc=ntr -tpp=tpc/2 -DO WHILE(tpp.gt.0) - IF(ttn(iz,ix).lt.ttn(btg(tpp)%pz,btg(tpp)%px))THEN - nsts(iz,ix)=tpp - nsts(btg(tpp)%pz,btg(tpp)%px)=tpc - exch=btg(tpc) - btg(tpc)=btg(tpp) - btg(tpp)=exch - tpc=tpp - tpp=tpc/2 - ELSE - tpp=0 - ENDIF -ENDDO -END SUBROUTINE addtree + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine adds a value to the binary tree by + ! placing a value at the bottom and pushing it up + ! to its correct position. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE addtree(iz,ix) + IMPLICIT NONE + INTEGER :: ix,iz,tpp,tpc + TYPE(backpointer) :: exch + ! + ! ix,iz = grid position of new addition to tree + ! tpp = tree position of parent + ! tpc = tree position of child + ! exch = dummy to exchange btg values + ! + ! First, increase the size of the tree by one. + ! + ntr=ntr+1 + ! + ! Put new value at base of tree + ! + nsts(iz,ix)=ntr + btg(ntr)%px=ix + btg(ntr)%pz=iz + ! + ! Now filter the new value up to its correct position + ! + tpc=ntr + tpp=tpc/2 + DO WHILE(tpp.gt.0) + IF(ttn(iz,ix).lt.ttn(btg(tpp)%pz,btg(tpp)%px))THEN + nsts(iz,ix)=tpp + nsts(btg(tpp)%pz,btg(tpp)%px)=tpc + exch=btg(tpc) + btg(tpc)=btg(tpp) + btg(tpp)=exch + tpc=tpp + tpp=tpc/2 + ELSE + tpp=0 + ENDIF + ENDDO + END SUBROUTINE addtree -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine updates the binary tree after the root -! value has been used. The root is replaced by the value -! at the bottom of the tree, which is then filtered down -! to its correct position. This ensures that the tree remains -! balanced. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE downtree -IMPLICIT NONE -INTEGER :: tpp,tpc -REAL(KIND=i10) :: rd1,rd2 -TYPE(backpointer) :: exch -! -! tpp = tree position of parent -! tpc = tree position of child -! exch = dummy to exchange btg values -! rd1,rd2 = substitution variables -! -! Replace root of tree with its last value -! -IF(ntr.EQ.1)THEN - ntr=ntr-1 - RETURN -ENDIF -nsts(btg(ntr)%pz,btg(ntr)%px)=1 -btg(1)=btg(ntr) -! -! Reduce size of tree by one -! -ntr=ntr-1 -! -! Now filter new root down to its correct position -! -tpp=1 -tpc=2*tpp -DO WHILE(tpc.lt.ntr) -! -! Check which of the two children is smallest - use the smallest -! - rd1=ttn(btg(tpc)%pz,btg(tpc)%px) - rd2=ttn(btg(tpc+1)%pz,btg(tpc+1)%px) - IF(rd1.gt.rd2)THEN - tpc=tpc+1 - ENDIF -! -! Check whether the child is smaller than the parent; if so, then swap, -! if not, then we are done -! - rd1=ttn(btg(tpc)%pz,btg(tpc)%px) - rd2=ttn(btg(tpp)%pz,btg(tpp)%px) - IF(rd1.lt.rd2)THEN - nsts(btg(tpp)%pz,btg(tpp)%px)=tpc - nsts(btg(tpc)%pz,btg(tpc)%px)=tpp - exch=btg(tpc) - btg(tpc)=btg(tpp) - btg(tpp)=exch - tpp=tpc - tpc=2*tpp - ELSE - tpc=ntr+1 - ENDIF -ENDDO -! -! If ntr is an even number, then we still have one more test to do -! -IF(tpc.eq.ntr)THEN - rd1=ttn(btg(tpc)%pz,btg(tpc)%px) - rd2=ttn(btg(tpp)%pz,btg(tpp)%px) - IF(rd1.lt.rd2)THEN - nsts(btg(tpp)%pz,btg(tpp)%px)=tpc - nsts(btg(tpc)%pz,btg(tpc)%px)=tpp - exch=btg(tpc) - btg(tpc)=btg(tpp) - btg(tpp)=exch - ENDIF -ENDIF -END SUBROUTINE downtree + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine updates the binary tree after the root + ! value has been used. The root is replaced by the value + ! at the bottom of the tree, which is then filtered down + ! to its correct position. This ensures that the tree remains + ! balanced. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE downtree + IMPLICIT NONE + INTEGER :: tpp,tpc + REAL(KIND=i10) :: rd1,rd2 + TYPE(backpointer) :: exch + ! + ! tpp = tree position of parent + ! tpc = tree position of child + ! exch = dummy to exchange btg values + ! rd1,rd2 = substitution variables + ! + ! Replace root of tree with its last value + ! + IF(ntr.EQ.1)THEN + ntr=ntr-1 + RETURN + ENDIF + nsts(btg(ntr)%pz,btg(ntr)%px)=1 + btg(1)=btg(ntr) + ! + ! Reduce size of tree by one + ! + ntr=ntr-1 + ! + ! Now filter new root down to its correct position + ! + tpp=1 + tpc=2*tpp + DO WHILE(tpc.lt.ntr) + ! + ! Check which of the two children is smallest - use the smallest + ! + rd1=ttn(btg(tpc)%pz,btg(tpc)%px) + rd2=ttn(btg(tpc+1)%pz,btg(tpc+1)%px) + IF(rd1.gt.rd2)THEN + tpc=tpc+1 + ENDIF + ! + ! Check whether the child is smaller than the parent; if so, then swap, + ! if not, then we are done + ! + rd1=ttn(btg(tpc)%pz,btg(tpc)%px) + rd2=ttn(btg(tpp)%pz,btg(tpp)%px) + IF(rd1.lt.rd2)THEN + nsts(btg(tpp)%pz,btg(tpp)%px)=tpc + nsts(btg(tpc)%pz,btg(tpc)%px)=tpp + exch=btg(tpc) + btg(tpc)=btg(tpp) + btg(tpp)=exch + tpp=tpc + tpc=2*tpp + ELSE + tpc=ntr+1 + ENDIF + ENDDO + ! + ! If ntr is an even number, then we still have one more test to do + ! + IF(tpc.eq.ntr)THEN + rd1=ttn(btg(tpc)%pz,btg(tpc)%px) + rd2=ttn(btg(tpp)%pz,btg(tpp)%px) + IF(rd1.lt.rd2)THEN + nsts(btg(tpp)%pz,btg(tpp)%px)=tpc + nsts(btg(tpc)%pz,btg(tpc)%px)=tpp + exch=btg(tpc) + btg(tpc)=btg(tpp) + btg(tpp)=exch + ENDIF + ENDIF + END SUBROUTINE downtree -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TYPE: SUBROUTINE -! CODE: FORTRAN 90 -! This subroutine updates a value on the binary tree. The FMM -! should only produce updated values that are less than their -! prior values. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE updtree(iz,ix) -IMPLICIT NONE -INTEGER :: ix,iz,tpp,tpc -TYPE(backpointer) :: exch -! -! ix,iz = grid position of new addition to tree -! tpp = tree position of parent -! tpc = tree position of child -! exch = dummy to exchange btg values -! -! Filter the updated value to its correct position -! -tpc=nsts(iz,ix) -tpp=tpc/2 -DO WHILE(tpp.gt.0) - IF(ttn(iz,ix).lt.ttn(btg(tpp)%pz,btg(tpp)%px))THEN - nsts(iz,ix)=tpp - nsts(btg(tpp)%pz,btg(tpp)%px)=tpc - exch=btg(tpc) - btg(tpc)=btg(tpp) - btg(tpp)=exch - tpc=tpp - tpp=tpc/2 - ELSE - tpp=0 - ENDIF -ENDDO -END SUBROUTINE updtree + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TYPE: SUBROUTINE + ! CODE: FORTRAN 90 + ! This subroutine updates a value on the binary tree. The FMM + ! should only produce updated values that are less than their + ! prior values. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE updtree(iz,ix) + IMPLICIT NONE + INTEGER :: ix,iz,tpp,tpc + TYPE(backpointer) :: exch + ! + ! ix,iz = grid position of new addition to tree + ! tpp = tree position of parent + ! tpc = tree position of child + ! exch = dummy to exchange btg values + ! + ! Filter the updated value to its correct position + ! + tpc=nsts(iz,ix) + tpp=tpc/2 + DO WHILE(tpp.gt.0) + IF(ttn(iz,ix).lt.ttn(btg(tpp)%pz,btg(tpp)%px))THEN + nsts(iz,ix)=tpp + nsts(btg(tpp)%pz,btg(tpp)%px)=tpc + exch=btg(tpc) + btg(tpc)=btg(tpp) + btg(tpp)=exch + tpc=tpp + tpp=tpc/2 + ELSE + tpp=0 + ENDIF + ENDDO + END SUBROUTINE updtree END MODULE traveltime @@ -907,563 +907,563 @@ END MODULE traveltime !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !PROGRAM tomo_surf subroutine CalSurfG(nx,ny,nz,nparpi,vels,iw,rw,col,dsurf, & - goxdf,gozdf,dvxdf,dvzdf,kmaxRc,kmaxRg,kmaxLc,kmaxLg, & - tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk, & - scxf,sczf,rcxf,rczf,nrc1,nsrcsurf1,kmax,nsrcsurf,nrcf, & - nar,writepath) -USE globalp -USE traveltime -IMPLICIT NONE -!CHARACTER (LEN=30) ::grid,frechet -!CHARACTER (LEN=40) :: sources,receivers,otimes -!CHARACTER (LEN=30) :: travelt,rtravel,wrays,cdum -INTEGER :: i,j,k,l,nsrc,tnr,urg -INTEGER :: sgs,isx,isz,sw,idm1,idm2,nnxb,nnzb -INTEGER :: ogx,ogz,grdfx,grdfz,maxbt -REAL(KIND=i10) :: x,z,goxb,gozb,dnxb,dnzb -!REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE :: scxf,sczf -!REAL(KIND=i10), DIMENSION (:,:,:), ALLOCATABLE :: rcxf,rczf -! -! sources = File containing source locations -! receivers = File containing receiver locations -! grid = File containing grid of velocity vertices for -! resampling on a finer grid with cubic B-splines -! frechet = output file containing matrix of frechet derivatives -! travelt = File name for storage of traveltime field -! wttf = Write traveltimes to file? (0=no,>0=source id) -! fom = Use first-order(0) or mixed-order(1) scheme -! nsrc = number of sources -! scx,scz = source location in r,x,z -! scx,scz = source location in r,x,z -! x,z = temporary variables for source location -! fsrt = find source-receiver traveltimes? (0=no,1=yes) -! rtravel = output file for source-receiver traveltimes -! cdum = dummy character variable ! wrgf = write ray geometries to file? (<0=all,0=no,>0=source id.) -! wrays = file containing raypath geometries -! cfd = calculate Frechet derivatives? (0=no, 1=yes) -! tnr = total number of receivers -! sgs = Extent of refined source grid -! isx,isz = cell containing source -! nnxb,nnzb = Backup for nnz,nnx -! goxb,gozb = Backup for gox,goz -! dnxb,dnzb = Backup for dnx,dnz -! ogx,ogz = Location of refined grid origin -! gridfx,grdfz = Number of refined nodes per cell -! urg = use refined grid (0=no,1=yes,2=previously used) -! maxbt = maximum size of narrow band binary tree -! otimes = file containing source-receiver association information -!c----------------------------------------------------------------- -! variables defined by Hongjian Fang - integer nx,ny,nz - integer kmax,nsrcsurf,nrcf - real vels(nx,ny,nz) - real rw(*) - integer iw(*),col(*) - real dsurf(*) - real goxdf,gozdf,dvxdf,dvzdf - integer kmaxRc,kmaxRg,kmaxLc,kmaxLg - real*8 tRc(*),tRg(*),tLc(*),tLg(*) - integer wavetype(nsrcsurf,kmax) - integer periods(nsrcsurf,kmax),nrc1(nsrcsurf,kmax),nsrcsurf1(kmax) - integer igrt(nsrcsurf,kmax) - real scxf(nsrcsurf,kmax),sczf(nsrcsurf,kmax),rcxf(nrcf,nsrcsurf,kmax),rczf(nrcf,nsrcsurf,kmax) - integer nar - real minthk - integer nparpi + goxdf,gozdf,dvxdf,dvzdf,kmaxRc,kmaxRg,kmaxLc,kmaxLg, & + tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk, & + scxf,sczf,rcxf,rczf,nrc1,nsrcsurf1,kmax,nsrcsurf,nrcf, & + nar,writepath) + USE globalp + USE traveltime + IMPLICIT NONE + !CHARACTER (LEN=30) ::grid,frechet + !CHARACTER (LEN=40) :: sources,receivers,otimes + !CHARACTER (LEN=30) :: travelt,rtravel,wrays,cdum + INTEGER :: i,j,k,l,nsrc,tnr,urg + INTEGER :: sgs,isx,isz,sw,idm1,idm2,nnxb,nnzb + INTEGER :: ogx,ogz,grdfx,grdfz,maxbt + REAL(KIND=i10) :: x,z,goxb,gozb,dnxb,dnzb + !REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE :: scxf,sczf + !REAL(KIND=i10), DIMENSION (:,:,:), ALLOCATABLE :: rcxf,rczf + ! + ! sources = File containing source locations + ! receivers = File containing receiver locations + ! grid = File containing grid of velocity vertices for + ! resampling on a finer grid with cubic B-splines + ! frechet = output file containing matrix of frechet derivatives + ! travelt = File name for storage of traveltime field + ! wttf = Write traveltimes to file? (0=no,>0=source id) + ! fom = Use first-order(0) or mixed-order(1) scheme + ! nsrc = number of sources + ! scx,scz = source location in r,x,z + ! scx,scz = source location in r,x,z + ! x,z = temporary variables for source location + ! fsrt = find source-receiver traveltimes? (0=no,1=yes) + ! rtravel = output file for source-receiver traveltimes + ! cdum = dummy character variable ! wrgf = write ray geometries to file? (<0=all,0=no,>0=source id.) + ! wrays = file containing raypath geometries + ! cfd = calculate Frechet derivatives? (0=no, 1=yes) + ! tnr = total number of receivers + ! sgs = Extent of refined source grid + ! isx,isz = cell containing source + ! nnxb,nnzb = Backup for nnz,nnx + ! goxb,gozb = Backup for gox,goz + ! dnxb,dnzb = Backup for dnx,dnz + ! ogx,ogz = Location of refined grid origin + ! gridfx,grdfz = Number of refined nodes per cell + ! urg = use refined grid (0=no,1=yes,2=previously used) + ! maxbt = maximum size of narrow band binary tree + ! otimes = file containing source-receiver association information + !c----------------------------------------------------------------- + ! variables defined by Hongjian Fang + integer nx,ny,nz + integer kmax,nsrcsurf,nrcf + real vels(nx,ny,nz) + real rw(*) + integer iw(*),col(*) + real dsurf(*) + real goxdf,gozdf,dvxdf,dvzdf + integer kmaxRc,kmaxRg,kmaxLc,kmaxLg + real*8 tRc(*),tRg(*),tLc(*),tLg(*) + integer wavetype(nsrcsurf,kmax) + integer periods(nsrcsurf,kmax),nrc1(nsrcsurf,kmax),nsrcsurf1(kmax) + integer igrt(nsrcsurf,kmax) + real scxf(nsrcsurf,kmax),sczf(nsrcsurf,kmax),rcxf(nrcf,nsrcsurf,kmax),rczf(nrcf,nsrcsurf,kmax) + integer nar + real minthk + integer nparpi - real vpz(nz),vsz(nz),rhoz(nz),depz(nz) - real*8 pvRc(nx*ny,kmaxRc),pvRg(nx*ny,kmaxRg),pvLc(nx*ny,kmaxLc),pvLg(nx*ny,kmaxLg) - real*8 sen_vsRc(nx*ny,kmaxRc,nz),sen_vpRc(nx*ny,kmaxRc,nz) - real*8 sen_rhoRc(nx*ny,kmaxRc,nz) - real*8 sen_vsRg(nx*ny,kmaxRg,nz),sen_vpRg(nx*ny,kmaxRg,nz) - real*8 sen_rhoRg(nx*ny,kmaxRg,nz) - real*8 sen_vsLc(nx*ny,kmaxLc,nz),sen_vpLc(nx*ny,kmaxLc,nz) - real*8 sen_rhoLc(nx*ny,kmaxLc,nz) - real*8 sen_vsLg(nx*ny,kmaxLg,nz),sen_vpLg(nx*ny,kmaxLg,nz) - real*8 sen_rhoLg(nx*ny,kmaxLg,nz) - real*8 sen_vs(nx*ny,kmax,nz),sen_vp(nx*ny,kmax,nz) - real*8 sen_rho(nx*ny,kmax,nz) - real coe_rho(nz-1),coe_a(nz-1) - real*8 velf(ny*nx) - integer kmax1,kmax2,kmax3,count1 - integer igr - integer iwave - integer knumi,srcnum - real,dimension(:,:),allocatable:: fdm - real row(nparpi) - real vpft(nz-1) - real cbst1 - integer ii,jj,kk,nn,istep - integer level,maxlevel,maxleveld,HorizonType,VerticalType,PorS - real,parameter::ftol=1e-4 - integer writepath -gdx=5 -gdz=5 -asgr=1 -sgdl=8 -sgs=8 -earth=6371.0 -fom=1 -snb=0.5 -goxd=goxdf -gozd=gozdf -dvxd=dvxdf -dvzd=dvzdf -nvx=nx-2 -nvz=ny-2 -ALLOCATE(velv(0:nvz+1,0:nvx+1), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL velv' -ENDIF -! -! Convert from degrees to radians -! -dvx=dvxd*pi/180.0 -dvz=dvzd*pi/180.0 -gox=(90.0-goxd)*pi/180.0 -goz=gozd*pi/180.0 -! -! Compute corresponding values for propagation grid. -! -nnx=(nvx-1)*gdx+1 -nnz=(nvz-1)*gdz+1 -dnx=dvx/gdx -dnz=dvz/gdz -dnxd=dvxd/gdx -dnzd=dvzd/gdz -ALLOCATE(veln(nnz,nnx), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL veln' -ENDIF + real vpz(nz),vsz(nz),rhoz(nz),depz(nz) + real*8 pvRc(nx*ny,kmaxRc),pvRg(nx*ny,kmaxRg),pvLc(nx*ny,kmaxLc),pvLg(nx*ny,kmaxLg) + real*8 sen_vsRc(nx*ny,kmaxRc,nz),sen_vpRc(nx*ny,kmaxRc,nz) + real*8 sen_rhoRc(nx*ny,kmaxRc,nz) + real*8 sen_vsRg(nx*ny,kmaxRg,nz),sen_vpRg(nx*ny,kmaxRg,nz) + real*8 sen_rhoRg(nx*ny,kmaxRg,nz) + real*8 sen_vsLc(nx*ny,kmaxLc,nz),sen_vpLc(nx*ny,kmaxLc,nz) + real*8 sen_rhoLc(nx*ny,kmaxLc,nz) + real*8 sen_vsLg(nx*ny,kmaxLg,nz),sen_vpLg(nx*ny,kmaxLg,nz) + real*8 sen_rhoLg(nx*ny,kmaxLg,nz) + real*8 sen_vs(nx*ny,kmax,nz),sen_vp(nx*ny,kmax,nz) + real*8 sen_rho(nx*ny,kmax,nz) + real coe_rho(nz-1),coe_a(nz-1) + real*8 velf(ny*nx) + integer kmax1,kmax2,kmax3,count1 + integer igr + integer iwave + integer knumi,srcnum + real,dimension(:,:),allocatable:: fdm + real row(nparpi) + real vpft(nz-1) + real cbst1 + integer ii,jj,kk,nn,istep + integer level,maxlevel,maxleveld,HorizonType,VerticalType,PorS + real,parameter::ftol=1e-4 + integer writepath + gdx=5 + gdz=5 + asgr=1 + sgdl=8 + sgs=8 + earth=6371.0 + fom=1 + snb=0.5 + goxd=goxdf + gozd=gozdf + dvxd=dvxdf + dvzd=dvzdf + nvx=nx-2 + nvz=ny-2 + ALLOCATE(velv(0:nvz+1,0:nvx+1), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL velv' + ENDIF + ! + ! Convert from degrees to radians + ! + dvx=dvxd*pi/180.0 + dvz=dvzd*pi/180.0 + gox=(90.0-goxd)*pi/180.0 + goz=gozd*pi/180.0 + ! + ! Compute corresponding values for propagation grid. + ! + nnx=(nvx-1)*gdx+1 + nnz=(nvz-1)*gdz+1 + dnx=dvx/gdx + dnz=dvz/gdz + dnxd=dvxd/gdx + dnzd=dvzd/gdz + ALLOCATE(veln(nnz,nnx), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL veln' + ENDIF -! -! Call a subroutine which reads in the velocity grid -! -!CALL gridder(grid) -! -! Read in all source coordinates. -! -! -! Now work out, source by source, the first-arrival traveltime -! field plus source-receiver traveltimes -! and ray paths if required. First, allocate memory to the -! traveltime field array -! -ALLOCATE(ttn(nnz,nnx), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: PROGRAM fmmin2d: REAL ttn' -ENDIF - rbint=0 -! -! Allocate memory for node status and binary trees -! -ALLOCATE(nsts(nnz,nnx)) -maxbt=NINT(snb*nnx*nnz) -ALLOCATE(btg(maxbt)) + ! + ! Call a subroutine which reads in the velocity grid + ! + !CALL gridder(grid) + ! + ! Read in all source coordinates. + ! + ! + ! Now work out, source by source, the first-arrival traveltime + ! field plus source-receiver traveltimes + ! and ray paths if required. First, allocate memory to the + ! traveltime field array + ! + ALLOCATE(ttn(nnz,nnx), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: PROGRAM fmmin2d: REAL ttn' + ENDIF + rbint=0 + ! + ! Allocate memory for node status and binary trees + ! + ALLOCATE(nsts(nnz,nnx)) + maxbt=NINT(snb*nnx*nnz) + ALLOCATE(btg(maxbt)) -allocate(fdm(0:nvz+1,0:nvx+1)) + allocate(fdm(0:nvz+1,0:nvx+1)) - if(kmaxRc.gt.0) then - iwave=2 - igr=0 - call depthkernel(nx,ny,nz,vels,pvRc,sen_vsRc,sen_vpRc, & - sen_rhoRc,iwave,igr,kmaxRc,tRc,depz,minthk) - endif + if(kmaxRc.gt.0) then + iwave=2 + igr=0 + call depthkernel(nx,ny,nz,vels,pvRc,sen_vsRc,sen_vpRc, & + sen_rhoRc,iwave,igr,kmaxRc,tRc,depz,minthk) + endif - if(kmaxRg.gt.0) then - iwave=2 - igr=1 - call depthkernel(nx,ny,nz,vels,pvRg,sen_vsRg,sen_vpRg, & - sen_rhoRg,iwave,igr,kmaxRg,tRg,depz,minthk) - endif + if(kmaxRg.gt.0) then + iwave=2 + igr=1 + call depthkernel(nx,ny,nz,vels,pvRg,sen_vsRg,sen_vpRg, & + sen_rhoRg,iwave,igr,kmaxRg,tRg,depz,minthk) + endif - if(kmaxLc.gt.0) then - iwave=1 - igr=0 - call depthkernel(nx,ny,nz,vels,pvLc,sen_vsLc,sen_vpLc, & - sen_rhoLc,iwave,igr,kmaxLc,tLc,depz,minthk) - endif + if(kmaxLc.gt.0) then + iwave=1 + igr=0 + call depthkernel(nx,ny,nz,vels,pvLc,sen_vsLc,sen_vpLc, & + sen_rhoLc,iwave,igr,kmaxLc,tLc,depz,minthk) + endif - if(kmaxLg.gt.0) then - iwave=1 - igr=1 - call depthkernel(nx,ny,nz,vels,pvLg,sen_vsLg,sen_vpLg, & - sen_rhoLg,iwave,igr,kmaxLg,tLg,depz,minthk) - endif - -nar=0 -count1=0 + if(kmaxLg.gt.0) then + iwave=1 + igr=1 + call depthkernel(nx,ny,nz,vels,pvLg,sen_vsLg,sen_vpLg, & + sen_rhoLg,iwave,igr,kmaxLg,tLg,depz,minthk) + endif -sen_vs=0 -sen_vp=0 -sen_rho=0 -kmax1=kmaxRc -kmax2=kmaxRc+kmaxRg -kmax3=kmaxRc+kmaxRg+kmaxLc -do knumi=1,kmax -do srcnum=1,nsrcsurf1(knumi) - if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==0) then + nar=0 + count1=0 + + sen_vs=0 + sen_vp=0 + sen_rho=0 + kmax1=kmaxRc + kmax2=kmaxRc+kmaxRg + kmax3=kmaxRc+kmaxRg+kmaxLc + do knumi=1,kmax + do srcnum=1,nsrcsurf1(knumi) + if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==0) then velf(1:nx*ny)=pvRc(1:nx*ny,periods(srcnum,knumi)) sen_vs(:,1:kmax1,:)=sen_vsRc(:,1:kmaxRc,:)!(:,nt(istep),:) sen_vp(:,1:kmax1,:)=sen_vpRc(:,1:kmaxRc,:)!(:,nt(istep),:) sen_rho(:,1:kmax1,:)=sen_rhoRc(:,1:kmaxRc,:)!(:,nt(istep),:) - endif - if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==1) then + endif + if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==1) then velf(1:nx*ny)=pvRg(1:nx*ny,periods(srcnum,knumi)) sen_vs(:,kmax1+1:kmax2,:)=sen_vsRg(:,1:kmaxRg,:)!(:,nt,:) sen_vp(:,kmax1+1:kmax2,:)=sen_vpRg(:,1:kmaxRg,:)!(:,nt,:) sen_rho(:,kmax1+1:kmax2,:)=sen_rhoRg(:,1:kmaxRg,:)!(:,nt,:) - endif - if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==0) then + endif + if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==0) then velf(1:nx*ny)=pvLc(1:nx*ny,periods(srcnum,knumi)) sen_vs(:,kmax2+1:kmax3,:)=sen_vsLc(:,1:kmaxLc,:)!(:,nt,:) sen_vp(:,kmax2+1:kmax3,:)=sen_vpLc(:,1:kmaxLc,:)!(:,nt,:) sen_rho(:,kmax2+1:kmax3,:)=sen_rhoLc(:,1:kmaxLc,:)!(:,nt,:) - endif - if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==1) then + endif + if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==1) then velf(1:nx*ny)=pvLg(1:nx*ny,periods(srcnum,knumi)) sen_vs(:,kmax3+1:kmax,:)=sen_vsLg(:,1:kmaxLg,:)!(:,nt,:) sen_vp(:,kmax3+1:kmax,:)=sen_vpLg(:,1:kmaxLg,:)!(:,nt,:) sen_rho(:,kmax3+1:kmax,:)=sen_rhoLg(:,1:kmaxLg,:)!(:,nt,:) - endif + endif -call gridder(velf) - x=scxf(srcnum,knumi) - z=sczf(srcnum,knumi) -! -! Begin by computing refined source grid if required -! - urg=0 - IF(asgr.EQ.1)THEN -! -! Back up coarse velocity grid to a holding matrix -! - ALLOCATE(velnb(nnz,nnx)) - ! MODIFIEDY BY HONGJIAN FANG @ USTC 2014/04/17 - velnb(1:nnz,1:nnx)=veln(1:nnz,1:nnx) - nnxb=nnx - nnzb=nnz - dnxb=dnx - dnzb=dnz - goxb=gox - gozb=goz -! -! Identify nearest neighbouring node to source -! - isx=INT((x-gox)/dnx)+1 - isz=INT((z-goz)/dnz)+1 - sw=0 - IF(isx.lt.1.or.isx.gt.nnx)sw=1 - IF(isz.lt.1.or.isz.gt.nnz)sw=1 - IF(sw.eq.1)then - x=90.0-x*180.0/pi - z=z*180.0/pi - WRITE(6,*)"Source lies outside bounds of model (lat,long)= ",x,z - WRITE(6,*)"TERMINATING PROGRAM!!!" - STOP - ENDIF - IF(isx.eq.nnx)isx=isx-1 - IF(isz.eq.nnz)isz=isz-1 -! -! Now find rectangular box that extends outward from the nearest source node -! to "sgs" nodes away. -! - vnl=isx-sgs - IF(vnl.lt.1)vnl=1 - vnr=isx+sgs - IF(vnr.gt.nnx)vnr=nnx - vnt=isz-sgs - IF(vnt.lt.1)vnt=1 - vnb=isz+sgs - IF(vnb.gt.nnz)vnb=nnz - nrnx=(vnr-vnl)*sgdl+1 - nrnz=(vnb-vnt)*sgdl+1 - drnx=dvx/REAL(gdx*sgdl) - drnz=dvz/REAL(gdz*sgdl) - gorx=gox+dnx*(vnl-1) - gorz=goz+dnz*(vnt-1) - nnx=nrnx - nnz=nrnz - dnx=drnx - dnz=drnz - gox=gorx - goz=gorz -! -! Reallocate velocity and traveltime arrays if nnx>nnxb or -! nnznnxb or + ! nnz 0)THEN - WRITE(6,*)'Error with DEALLOCATE: PROGRAM fmmin2d: velnb' - ENDIF -ENDIF -enddo -enddo -deallocate(fdm) -deallocate(velv,veln,ttn,nsts,btg) + IF(rbint.EQ.1)THEN + WRITE(6,*)'Note that at least one two-point ray path' + WRITE(6,*)'tracked along the boundary of the model.' + WRITE(6,*)'This class of path is unlikely to be' + WRITE(6,*)'a true path, and it is STRONGLY RECOMMENDED' + WRITE(6,*)'that you adjust the dimensions of your grid' + WRITE(6,*)'to prevent this from occurring.' + ENDIF + IF(asgr.EQ.1)THEN + DEALLOCATE (velnb, STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with DEALLOCATE: PROGRAM fmmin2d: velnb' + ENDIF + ENDIF + enddo + enddo + deallocate(fdm) + deallocate(velv,veln,ttn,nsts,btg) END subroutine SUBROUTINE gridder(pv) -!subroutine gridder(pv) -!subroutine gridder() -USE globalp -IMPLICIT NONE -INTEGER :: i,j,l,m,i1,j1,conx,conz,stx,stz -REAL(KIND=i10) :: u,sumi,sumj -REAL(KIND=i10), DIMENSION(:,:), ALLOCATABLE :: ui,vi -!CHARACTER (LEN=30) :: grid -! -! u = independent parameter for b-spline -! ui,vi = bspline basis functions -! conx,conz = variables for edge of B-spline grid -! stx,stz = counters for veln grid points -! sumi,sumj = summation variables for computing b-spline -! -!C--------------------------------------------------------------- -double precision pv(*) -!integer count1 -!C--------------------------------------------------------------- -! Open the grid file and read in the velocity grid. -! -!OPEN(UNIT=10,FILE=grid,STATUS='old') -!READ(10,*)nvx,nvz -!READ(10,*)goxd,gozd -!READ(10,*)dvxd,dvzd -!count1=0 -DO i=0,nvz+1 - DO j=0,nvx+1 -! count1=count1+1 -! READ(10,*)velv(i,j) -! velv(i,j)=real(pv(count1)) - velv(i,j)=real(pv(i*(nvx+2)+j+1)) - ENDDO -ENDDO -!CLOSE(10) -! -! Convert from degrees to radians -! -! -! Now dice up the grid -! -ALLOCATE(ui(gdx+1,4), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: Subroutine gridder: REAL ui' -ENDIF -DO i=1,gdx+1 - u=gdx - u=(i-1)/u - ui(i,1)=(1.0-u)**3/6.0 - ui(i,2)=(4.0-6.0*u**2+3.0*u**3)/6.0 - ui(i,3)=(1.0+3.0*u+3.0*u**2-3.0*u**3)/6.0 - ui(i,4)=u**3/6.0 -ENDDO -ALLOCATE(vi(gdz+1,4), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: Subroutine gridder: REAL vi' -ENDIF -DO i=1,gdz+1 - u=gdz - u=(i-1)/u - vi(i,1)=(1.0-u)**3/6.0 - vi(i,2)=(4.0-6.0*u**2+3.0*u**3)/6.0 - vi(i,3)=(1.0+3.0*u+3.0*u**2-3.0*u**3)/6.0 - vi(i,4)=u**3/6.0 -ENDDO -DO i=1,nvz-1 - conz=gdz - IF(i==nvz-1)conz=gdz+1 - DO j=1,nvx-1 + !subroutine gridder(pv) + !subroutine gridder() + USE globalp + IMPLICIT NONE + INTEGER :: i,j,l,m,i1,j1,conx,conz,stx,stz + REAL(KIND=i10) :: u,sumi,sumj + REAL(KIND=i10), DIMENSION(:,:), ALLOCATABLE :: ui,vi + !CHARACTER (LEN=30) :: grid + ! + ! u = independent parameter for b-spline + ! ui,vi = bspline basis functions + ! conx,conz = variables for edge of B-spline grid + ! stx,stz = counters for veln grid points + ! sumi,sumj = summation variables for computing b-spline + ! + !C--------------------------------------------------------------- + double precision pv(*) + !integer count1 + !C--------------------------------------------------------------- + ! Open the grid file and read in the velocity grid. + ! + !OPEN(UNIT=10,FILE=grid,STATUS='old') + !READ(10,*)nvx,nvz + !READ(10,*)goxd,gozd + !READ(10,*)dvxd,dvzd + !count1=0 + DO i=0,nvz+1 + DO j=0,nvx+1 + ! count1=count1+1 + ! READ(10,*)velv(i,j) + ! velv(i,j)=real(pv(count1)) + velv(i,j)=real(pv(i*(nvx+2)+j+1)) + ENDDO + ENDDO + !CLOSE(10) + ! + ! Convert from degrees to radians + ! + ! + ! Now dice up the grid + ! + ALLOCATE(ui(gdx+1,4), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: Subroutine gridder: REAL ui' + ENDIF + DO i=1,gdx+1 + u=gdx + u=(i-1)/u + ui(i,1)=(1.0-u)**3/6.0 + ui(i,2)=(4.0-6.0*u**2+3.0*u**3)/6.0 + ui(i,3)=(1.0+3.0*u+3.0*u**2-3.0*u**3)/6.0 + ui(i,4)=u**3/6.0 + ENDDO + ALLOCATE(vi(gdz+1,4), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: Subroutine gridder: REAL vi' + ENDIF + DO i=1,gdz+1 + u=gdz + u=(i-1)/u + vi(i,1)=(1.0-u)**3/6.0 + vi(i,2)=(4.0-6.0*u**2+3.0*u**3)/6.0 + vi(i,3)=(1.0+3.0*u+3.0*u**2-3.0*u**3)/6.0 + vi(i,4)=u**3/6.0 + ENDDO + DO i=1,nvz-1 + conz=gdz + IF(i==nvz-1)conz=gdz+1 + DO j=1,nvx-1 conx=gdx IF(j==nvx-1)conx=gdx+1 DO l=1,conz - stz=gdz*(i-1)+l - DO m=1,conx - stx=gdx*(j-1)+m - sumi=0.0 - DO i1=1,4 - sumj=0.0 - DO j1=1,4 - sumj=sumj+ui(m,j1)*velv(i-2+i1,j-2+j1) - ENDDO - sumi=sumi+vi(l,i1)*sumj + stz=gdz*(i-1)+l + DO m=1,conx + stx=gdx*(j-1)+m + sumi=0.0 + DO i1=1,4 + sumj=0.0 + DO j1=1,4 + sumj=sumj+ui(m,j1)*velv(i-2+i1,j-2+j1) ENDDO - veln(stz,stx)=sumi - ENDDO + sumi=sumi+vi(l,i1)*sumj + ENDDO + veln(stz,stx)=sumi + ENDDO ENDDO - ENDDO -ENDDO -DEALLOCATE(ui,vi, STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE gridder: REAL ui,vi' -ENDIF + ENDDO + ENDDO + DEALLOCATE(ui,vi, STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE gridder: REAL ui,vi' + ENDIF END SUBROUTINE gridder @@ -1474,24 +1474,24 @@ END SUBROUTINE gridder ! modified to deal with source grid refinement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE bsplrefine -USE globalp -INTEGER :: i,j,k,l,i1,j1,st1,st2,nrzr,nrxr -INTEGER :: origx,origz,conx,conz,idm1,idm2 -REAL(KIND=i10) :: u,v -REAL(KIND=i10), DIMENSION (4) :: sum -REAL(KIND=i10), DIMENSION(gdx*sgdl+1,gdz*sgdl+1,4) :: ui,vi -! -! nrxr,nrzr = grid refinement level for source grid in x,z -! origx,origz = local origin of refined source grid -! -! Begin by calculating the values of the basis functions -! -nrxr=gdx*sgdl -nrzr=gdz*sgdl -DO i=1,nrzr+1 - v=nrzr - v=(i-1)/v - DO j=1,nrxr+1 + USE globalp + INTEGER :: i,j,k,l,i1,j1,st1,st2,nrzr,nrxr + INTEGER :: origx,origz,conx,conz,idm1,idm2 + REAL(KIND=i10) :: u,v + REAL(KIND=i10), DIMENSION (4) :: sum + REAL(KIND=i10), DIMENSION(gdx*sgdl+1,gdz*sgdl+1,4) :: ui,vi + ! + ! nrxr,nrzr = grid refinement level for source grid in x,z + ! origx,origz = local origin of refined source grid + ! + ! Begin by calculating the values of the basis functions + ! + nrxr=gdx*sgdl + nrzr=gdz*sgdl + DO i=1,nrzr+1 + v=nrzr + v=(i-1)/v + DO j=1,nrxr+1 u=nrxr u=(j-1)/u ui(j,i,1)=(1.0-u)**3/6.0 @@ -1502,43 +1502,43 @@ DO i=1,nrzr+1 vi(j,i,2)=(4.0-6.0*v**2+3.0*v**3)/6.0 vi(j,i,3)=(1.0+3.0*v+3.0*v**2-3.0*v**3)/6.0 vi(j,i,4)=v**3/6.0 - ENDDO -ENDDO -! -! Calculate the velocity values. -! -origx=(vnl-1)*sgdl+1 -origz=(vnt-1)*sgdl+1 -DO i=1,nvz-1 - conz=nrzr - IF(i==nvz-1)conz=nrzr+1 - DO j=1,nvx-1 + ENDDO + ENDDO + ! + ! Calculate the velocity values. + ! + origx=(vnl-1)*sgdl+1 + origz=(vnt-1)*sgdl+1 + DO i=1,nvz-1 + conz=nrzr + IF(i==nvz-1)conz=nrzr+1 + DO j=1,nvx-1 conx=nrxr IF(j==nvx-1)conx=nrxr+1 DO k=1,conz - st1=gdz*(i-1)+(k-1)/sgdl+1 - IF(st1.LT.vnt.OR.st1.GT.vnb)CYCLE - st1=nrzr*(i-1)+k - DO l=1,conx - st2=gdx*(j-1)+(l-1)/sgdl+1 - IF(st2.LT.vnl.OR.st2.GT.vnr)CYCLE - st2=nrxr*(j-1)+l - DO i1=1,4 - sum(i1)=0.0 - DO j1=1,4 - sum(i1)=sum(i1)+ui(l,k,j1)*velv(i-2+i1,j-2+j1) - ENDDO - sum(i1)=vi(l,k,i1)*sum(i1) + st1=gdz*(i-1)+(k-1)/sgdl+1 + IF(st1.LT.vnt.OR.st1.GT.vnb)CYCLE + st1=nrzr*(i-1)+k + DO l=1,conx + st2=gdx*(j-1)+(l-1)/sgdl+1 + IF(st2.LT.vnl.OR.st2.GT.vnr)CYCLE + st2=nrxr*(j-1)+l + DO i1=1,4 + sum(i1)=0.0 + DO j1=1,4 + sum(i1)=sum(i1)+ui(l,k,j1)*velv(i-2+i1,j-2+j1) ENDDO - idm1=st1-origz+1 - idm2=st2-origx+1 - IF(idm1.LT.1.OR.idm1.GT.nnz)CYCLE - IF(idm2.LT.1.OR.idm2.GT.nnx)CYCLE - veln(idm1,idm2)=sum(1)+sum(2)+sum(3)+sum(4) - ENDDO + sum(i1)=vi(l,k,i1)*sum(i1) + ENDDO + idm1=st1-origz+1 + idm2=st2-origx+1 + IF(idm1.LT.1.OR.idm1.GT.nnz)CYCLE + IF(idm2.LT.1.OR.idm2.GT.nnx)CYCLE + veln(idm1,idm2)=sum(1)+sum(2)+sum(3)+sum(4) + ENDDO ENDDO - ENDDO -ENDDO + ENDDO + ENDDO END SUBROUTINE bsplrefine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! TYPE: SUBROUTINE @@ -1548,128 +1548,128 @@ END SUBROUTINE bsplrefine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !SUBROUTINE srtimes(scx,scz,rcx1,rcz1,cbst1) SUBROUTINE srtimes(scx,scz,rcx1,rcz1,cbst1) -USE globalp -IMPLICIT NONE -INTEGER :: i,k,l,irx,irz,sw,isx,isz,csid -INTEGER, PARAMETER :: noray=0,yesray=1 -INTEGER, PARAMETER :: i5=SELECTED_REAL_KIND(6) -REAL(KIND=i5) :: trr -REAL(KIND=i5), PARAMETER :: norayt=0.0 -REAL(KIND=i10) :: drx,drz,produ,scx,scz -REAL(KIND=i10) :: rcx1,rcz1,cbst1 -REAL(KIND=i10) :: sred,dpl,rd1,vels,velr -REAL(KIND=i10), DIMENSION (2,2) :: vss -!!------------------------------------------------------ -! modified by Hongjian Fang @ USTC - integer no_p,nsrc - real dist -! real cbst(*) !note that the type difference(kind=i5 vs real) -! integer cbst_stat(*) -!!------------------------------------------------------ -! -! irx,irz = Coordinates of cell containing receiver -! trr = traveltime value at receiver -! produ = dummy multiplier -! drx,drz = receiver distance from (i,j,k) grid node -! scx,scz = source coordinates -! isx,isz = source cell location -! sred = Distance from source to receiver -! dpl = Minimum path length in source neighbourhood. -! vels,velr = velocity at source and receiver -! vss = velocity at four grid points about source or receiver. -! csid = current source ID -! noray = switch to indicate no ray present -! norayt = default value given to null ray -! yesray = switch to indicate that ray is present -! -! Determine source-receiver traveltimes one at a time. -! -!0605DO i=1,nrc -!0605 IF(srs(i,csid).EQ.0)THEN -!0605! WRITE(10,*)noray,norayt -!0605 CYCLE -!0605 ENDIF -! -! The first step is to locate the receiver in the grid. -! - irx=INT((rcx1-gox)/dnx)+1 - irz=INT((rcz1-goz)/dnz)+1 - sw=0 - IF(irx.lt.1.or.irx.gt.nnx)sw=1 - IF(irz.lt.1.or.irz.gt.nnz)sw=1 - IF(sw.eq.1)then - rcx1=90.0-rcx1*180.0/pi - rcz1=rcz1*180.0/pi - WRITE(6,*)"Receiver lies outside model (lat,long)= ",rcx1,rcz1 - WRITE(6,*)"TERMINATING PROGRAM!!!!" - STOP - ENDIF - IF(irx.eq.nnx)irx=irx-1 - IF(irz.eq.nnz)irz=irz-1 -! -! Location of receiver successfully found within the grid. Now approximate -! traveltime at receiver using bilinear interpolation from four -! surrounding grid points. Note that bilinear interpolation is a poor -! approximation when traveltime gradient varies significantly across a cell, -! particularly near the source. Thus, we use an improved approximation in this -! case. First, locate current source cell. -! - isx=INT((scx-gox)/dnx)+1 - isz=INT((scz-goz)/dnz)+1 - dpl=dnx*earth - rd1=dnz*earth*SIN(gox) - IF(rd1.LT.dpl)dpl=rd1 - rd1=dnz*earth*SIN(gox+(nnx-1)*dnx) - IF(rd1.LT.dpl)dpl=rd1 - sred=((scx-rcx1)*earth)**2 - sred=sred+((scz-rcz1)*earth*SIN(rcx1))**2 - sred=SQRT(sred) - IF(sred.LT.dpl)sw=1 - IF(isx.EQ.irx)THEN - IF(isz.EQ.irz)sw=1 - ENDIF - IF(sw.EQ.1)THEN -! -! Compute velocity at source and receiver -! - DO k=1,2 - DO l=1,2 - vss(k,l)=veln(isz-1+l,isx-1+k) - ENDDO + USE globalp + IMPLICIT NONE + INTEGER :: i,k,l,irx,irz,sw,isx,isz,csid + INTEGER, PARAMETER :: noray=0,yesray=1 + INTEGER, PARAMETER :: i5=SELECTED_REAL_KIND(6) + REAL(KIND=i5) :: trr + REAL(KIND=i5), PARAMETER :: norayt=0.0 + REAL(KIND=i10) :: drx,drz,produ,scx,scz + REAL(KIND=i10) :: rcx1,rcz1,cbst1 + REAL(KIND=i10) :: sred,dpl,rd1,vels,velr + REAL(KIND=i10), DIMENSION (2,2) :: vss + !!------------------------------------------------------ + ! modified by Hongjian Fang @ USTC + integer no_p,nsrc + real dist + ! real cbst(*) !note that the type difference(kind=i5 vs real) + ! integer cbst_stat(*) + !!------------------------------------------------------ + ! + ! irx,irz = Coordinates of cell containing receiver + ! trr = traveltime value at receiver + ! produ = dummy multiplier + ! drx,drz = receiver distance from (i,j,k) grid node + ! scx,scz = source coordinates + ! isx,isz = source cell location + ! sred = Distance from source to receiver + ! dpl = Minimum path length in source neighbourhood. + ! vels,velr = velocity at source and receiver + ! vss = velocity at four grid points about source or receiver. + ! csid = current source ID + ! noray = switch to indicate no ray present + ! norayt = default value given to null ray + ! yesray = switch to indicate that ray is present + ! + ! Determine source-receiver traveltimes one at a time. + ! + !0605DO i=1,nrc + !0605 IF(srs(i,csid).EQ.0)THEN + !0605! WRITE(10,*)noray,norayt + !0605 CYCLE + !0605 ENDIF + ! + ! The first step is to locate the receiver in the grid. + ! + irx=INT((rcx1-gox)/dnx)+1 + irz=INT((rcz1-goz)/dnz)+1 + sw=0 + IF(irx.lt.1.or.irx.gt.nnx)sw=1 + IF(irz.lt.1.or.irz.gt.nnz)sw=1 + IF(sw.eq.1)then + rcx1=90.0-rcx1*180.0/pi + rcz1=rcz1*180.0/pi + WRITE(6,*)"Receiver lies outside model (lat,long)= ",rcx1,rcz1 + WRITE(6,*)"TERMINATING PROGRAM!!!!" + STOP + ENDIF + IF(irx.eq.nnx)irx=irx-1 + IF(irz.eq.nnz)irz=irz-1 + ! + ! Location of receiver successfully found within the grid. Now approximate + ! traveltime at receiver using bilinear interpolation from four + ! surrounding grid points. Note that bilinear interpolation is a poor + ! approximation when traveltime gradient varies significantly across a cell, + ! particularly near the source. Thus, we use an improved approximation in this + ! case. First, locate current source cell. + ! + isx=INT((scx-gox)/dnx)+1 + isz=INT((scz-goz)/dnz)+1 + dpl=dnx*earth + rd1=dnz*earth*SIN(gox) + IF(rd1.LT.dpl)dpl=rd1 + rd1=dnz*earth*SIN(gox+(nnx-1)*dnx) + IF(rd1.LT.dpl)dpl=rd1 + sred=((scx-rcx1)*earth)**2 + sred=sred+((scz-rcz1)*earth*SIN(rcx1))**2 + sred=SQRT(sred) + IF(sred.LT.dpl)sw=1 + IF(isx.EQ.irx)THEN + IF(isz.EQ.irz)sw=1 + ENDIF + IF(sw.EQ.1)THEN + ! + ! Compute velocity at source and receiver + ! + DO k=1,2 + DO l=1,2 + vss(k,l)=veln(isz-1+l,isx-1+k) ENDDO - drx=(scx-gox)-(isx-1)*dnx - drz=(scz-goz)-(isz-1)*dnz - CALL bilinear(vss,drx,drz,vels) - DO k=1,2 - DO l=1,2 - vss(k,l)=veln(irz-1+l,irx-1+k) - ENDDO + ENDDO + drx=(scx-gox)-(isx-1)*dnx + drz=(scz-goz)-(isz-1)*dnz + CALL bilinear(vss,drx,drz,vels) + DO k=1,2 + DO l=1,2 + vss(k,l)=veln(irz-1+l,irx-1+k) ENDDO - drx=(rcx1-gox)-(irx-1)*dnx - drz=(rcz1-goz)-(irz-1)*dnz - CALL bilinear(vss,drx,drz,velr) - trr=2.0*sred/(vels+velr) - ELSE - drx=(rcx1-gox)-(irx-1)*dnx - drz=(rcz1-goz)-(irz-1)*dnz - trr=0.0 - DO k=1,2 - DO l=1,2 - produ=(1.0-ABS(((l-1)*dnz-drz)/dnz))*(1.0-ABS(((k-1)*dnx-drx)/dnx)) - trr=trr+ttn(irz-1+l,irx-1+k)*produ - ENDDO + ENDDO + drx=(rcx1-gox)-(irx-1)*dnx + drz=(rcz1-goz)-(irz-1)*dnz + CALL bilinear(vss,drx,drz,velr) + trr=2.0*sred/(vels+velr) + ELSE + drx=(rcx1-gox)-(irx-1)*dnx + drz=(rcz1-goz)-(irz-1)*dnz + trr=0.0 + DO k=1,2 + DO l=1,2 + produ=(1.0-ABS(((l-1)*dnz-drz)/dnz))*(1.0-ABS(((k-1)*dnx-drx)/dnx)) + trr=trr+ttn(irz-1+l,irx-1+k)*produ ENDDO - ENDIF -! WRITE(10,*)yesray,trr -!!----------------------------------------------------------------- -! modified bu Hongjian Fang @ USTC -! count2=count2+1 -! cbst((no_p-1)*nsrc*nrc+(csid-1)*nrc+i)=trr - cbst1=trr -! call delsph(scx,scz,rcx(i),rcz(i),dist) -! travel_path(count2)=dist -!cbst_stat((no_p-1)*nsrc*nrc+(csid-1)*nrc+i)=yesray -!0605ENDDO + ENDDO + ENDIF + ! WRITE(10,*)yesray,trr + !!----------------------------------------------------------------- + ! modified bu Hongjian Fang @ USTC + ! count2=count2+1 + ! cbst((no_p-1)*nsrc*nrc+(csid-1)*nrc+i)=trr + cbst1=trr + ! call delsph(scx,scz,rcx(i),rcz(i),dist) + ! travel_path(count2)=dist + !cbst_stat((no_p-1)*nsrc*nrc+(csid-1)*nrc+i)=yesray + !0605ENDDO END SUBROUTINE srtimes @@ -1683,553 +1683,553 @@ END SUBROUTINE srtimes !SUBROUTINE rpaths(wrgf,csid,cfd,scx,scz) !SUBROUTINE rpaths() SUBROUTINE rpaths(scx,scz,fdm,surfrcx,surfrcz,writepath) -USE globalp -IMPLICIT NONE -INTEGER, PARAMETER :: i5=SELECTED_REAL_KIND(5,10) -INTEGER, PARAMETER :: nopath=0 -INTEGER :: i,j,k,l,m,n,ipx,ipz,ipxr,ipzr,nrp,sw -!fang!INTEGER :: wrgf,cfd,csid,ipxo,ipzo,isx,isz -INTEGER :: ipxo,ipzo,isx,isz -INTEGER :: ivx,ivz,ivxo,ivzo,nhp,maxrp -INTEGER :: ivxt,ivzt,ipxt,ipzt,isum,igref -INTEGER, DIMENSION (4) :: chp -REAL(KIND=i5) :: rayx,rayz -REAL(KIND=i10) :: dpl,rd1,rd2,xi,zi,vel,velo -REAL(KIND=i10) :: v,w,rigz,rigx,dinc,scx,scz -REAL(KIND=i10) :: dtx,dtz,drx,drz,produ,sred -REAL(KIND=i10), DIMENSION (:), ALLOCATABLE :: rgx,rgz -!fang!REAL(KIND=i5), DIMENSION (:,:), ALLOCATABLE :: fdm -REAL(KIND=i10), DIMENSION (4) :: vrat,vi,wi,vio,wio -!fang!------------------------------------------------ -real fdm(0:nvz+1,0:nvx+1) -REAL(KIND=i10) surfrcx,surfrcz -integer writepath -!fang!------------------------------------------------ -! -! ipx,ipz = Coordinates of cell containing current point -! ipxr,ipzr = Same as ipx,apz except for refined grid -! ipxo,ipzo = Coordinates of previous point -! rgx,rgz = (x,z) coordinates of ray geometry -! ivx,ivz = Coordinates of B-spline vertex containing current point -! ivxo,ivzo = Coordinates of previous point -! maxrp = maximum number of ray points -! nrp = number of points to describe ray -! dpl = incremental path length of ray -! xi,zi = edge of model coordinates -! dtx,dtz = components of gradT -! wrgf = Write out raypaths? (<0=all,0=no,>0=souce id) -! cfd = calculate Frechet derivatives? (0=no,1=yes) -! csid = current source id -! fdm = Frechet derivative matrix -! nhp = Number of ray segment-B-spline cell hit points -! vrat = length ratio of ray sub-segment -! chp = pointer to incremental change in x or z cell -! drx,drz = distance from reference node of cell -! produ = variable for trilinear interpolation -! vel = velocity at current point -! velo = velocity at previous point -! v,w = local variables of x,z -! vi,wi = B-spline basis functions at current point -! vio,wio = vi,wi for previous point -! ivxt,ivzt = temporary ivr,ivx,ivz values -! rigx,rigz = end point of sub-segment of ray path -! ipxt,ipzt = temporary ipx,ipz values -! dinc = path length of ray sub-segment -! rayr,rayx,rayz = ray path coordinates in single precision -! isx,isz = current source cell location -! scx,scz = current source coordinates -! sred = source to ray endpoint distance -! igref = ray endpoint lies in refined grid? (0=no,1=yes) -! nopath = switch to indicate that no path is present -! -! Allocate memory to arrays for storing ray path geometry -! -maxrp=nnx*nnz -ALLOCATE(rgx(maxrp+1), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL rgx' -ENDIF -ALLOCATE(rgz(maxrp+1), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL rgz' -ENDIF -! -! Allocate memory to partial derivative array -! -!fang!IF(cfd.EQ.1)THEN -!fang! ALLOCATE(fdm(0:nvz+1,0:nvx+1), STAT=checkstat) -!fang! IF(checkstat > 0)THEN -!fang! WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL fdm' -!fang! ENDIF -!fang!ENDIF -! -! Locate current source cell -! -IF(asgr.EQ.1)THEN - isx=INT((scx-goxr)/dnxr)+1 - isz=INT((scz-gozr)/dnzr)+1 -ELSE - isx=INT((scx-gox)/dnx)+1 - isz=INT((scz-goz)/dnz)+1 -ENDIF -! -! Set ray incremental path length equal to half width -! of cell -! + USE globalp + IMPLICIT NONE + INTEGER, PARAMETER :: i5=SELECTED_REAL_KIND(5,10) + INTEGER, PARAMETER :: nopath=0 + INTEGER :: i,j,k,l,m,n,ipx,ipz,ipxr,ipzr,nrp,sw + !fang!INTEGER :: wrgf,cfd,csid,ipxo,ipzo,isx,isz + INTEGER :: ipxo,ipzo,isx,isz + INTEGER :: ivx,ivz,ivxo,ivzo,nhp,maxrp + INTEGER :: ivxt,ivzt,ipxt,ipzt,isum,igref + INTEGER, DIMENSION (4) :: chp + REAL(KIND=i5) :: rayx,rayz + REAL(KIND=i10) :: dpl,rd1,rd2,xi,zi,vel,velo + REAL(KIND=i10) :: v,w,rigz,rigx,dinc,scx,scz + REAL(KIND=i10) :: dtx,dtz,drx,drz,produ,sred + REAL(KIND=i10), DIMENSION (:), ALLOCATABLE :: rgx,rgz + !fang!REAL(KIND=i5), DIMENSION (:,:), ALLOCATABLE :: fdm + REAL(KIND=i10), DIMENSION (4) :: vrat,vi,wi,vio,wio + !fang!------------------------------------------------ + real fdm(0:nvz+1,0:nvx+1) + REAL(KIND=i10) surfrcx,surfrcz + integer writepath + !fang!------------------------------------------------ + ! + ! ipx,ipz = Coordinates of cell containing current point + ! ipxr,ipzr = Same as ipx,apz except for refined grid + ! ipxo,ipzo = Coordinates of previous point + ! rgx,rgz = (x,z) coordinates of ray geometry + ! ivx,ivz = Coordinates of B-spline vertex containing current point + ! ivxo,ivzo = Coordinates of previous point + ! maxrp = maximum number of ray points + ! nrp = number of points to describe ray + ! dpl = incremental path length of ray + ! xi,zi = edge of model coordinates + ! dtx,dtz = components of gradT + ! wrgf = Write out raypaths? (<0=all,0=no,>0=souce id) + ! cfd = calculate Frechet derivatives? (0=no,1=yes) + ! csid = current source id + ! fdm = Frechet derivative matrix + ! nhp = Number of ray segment-B-spline cell hit points + ! vrat = length ratio of ray sub-segment + ! chp = pointer to incremental change in x or z cell + ! drx,drz = distance from reference node of cell + ! produ = variable for trilinear interpolation + ! vel = velocity at current point + ! velo = velocity at previous point + ! v,w = local variables of x,z + ! vi,wi = B-spline basis functions at current point + ! vio,wio = vi,wi for previous point + ! ivxt,ivzt = temporary ivr,ivx,ivz values + ! rigx,rigz = end point of sub-segment of ray path + ! ipxt,ipzt = temporary ipx,ipz values + ! dinc = path length of ray sub-segment + ! rayr,rayx,rayz = ray path coordinates in single precision + ! isx,isz = current source cell location + ! scx,scz = current source coordinates + ! sred = source to ray endpoint distance + ! igref = ray endpoint lies in refined grid? (0=no,1=yes) + ! nopath = switch to indicate that no path is present + ! + ! Allocate memory to arrays for storing ray path geometry + ! + maxrp=nnx*nnz + ALLOCATE(rgx(maxrp+1), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL rgx' + ENDIF + ALLOCATE(rgz(maxrp+1), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL rgz' + ENDIF + ! + ! Allocate memory to partial derivative array + ! + !fang!IF(cfd.EQ.1)THEN + !fang! ALLOCATE(fdm(0:nvz+1,0:nvx+1), STAT=checkstat) + !fang! IF(checkstat > 0)THEN + !fang! WRITE(6,*)'Error with ALLOCATE: SUBROUTINE rpaths: REAL fdm' + !fang! ENDIF + !fang!ENDIF + ! + ! Locate current source cell + ! + IF(asgr.EQ.1)THEN + isx=INT((scx-goxr)/dnxr)+1 + isz=INT((scz-gozr)/dnzr)+1 + ELSE + isx=INT((scx-gox)/dnx)+1 + isz=INT((scz-goz)/dnz)+1 + ENDIF + ! + ! Set ray incremental path length equal to half width + ! of cell + ! dpl=dnx*earth rd1=dnz*earth*SIN(gox) IF(rd1.LT.dpl)dpl=rd1 rd1=dnz*earth*SIN(gox+(nnx-1)*dnx) IF(rd1.LT.dpl)dpl=rd1 dpl=0.5*dpl -! -! Loop through all the receivers -! -!fang!DO i=1,nrc -! -! If path does not exist, then cycle the loop -! -fdm=0 -!fang! IF(cfd.EQ.1)THEN -!fang! fdm=0.0 -!fang! ENDIF -!fang! IF(srs(i,csid).EQ.0)THEN -!fang! IF(wrgf.EQ.csid.OR.wrgf.LT.0)THEN -!fang! WRITE(40)nopath -!fang! ENDIF -!fang! IF(cfd.EQ.1)THEN -!fang! WRITE(50)nopath -!fang! ENDIF -!fang! CYCLE -!fang! ENDIF -! -! The first step is to locate the receiver in the grid. -! - ipx=INT((surfrcx-gox)/dnx)+1 - ipz=INT((surfrcz-goz)/dnz)+1 - sw=0 - IF(ipx.lt.1.or.ipx.ge.nnx)sw=1 - IF(ipz.lt.1.or.ipz.ge.nnz)sw=1 - IF(sw.eq.1)then - surfrcx=90.0-surfrcx*180.0/pi - surfrcz=surfrcz*180.0/pi - WRITE(6,*)"rpath Receiver lies outside model (lat,long)= ",surfrcx,surfrcz - WRITE(6,*)"TERMINATING PROGRAM!!!" - STOP - ENDIF - IF(ipx.eq.nnx)ipx=ipx-1 - IF(ipz.eq.nnz)ipz=ipz-1 -! -! First point of the ray path is the receiver -! - rgx(1)=surfrcx - rgz(1)=surfrcz -! -! Test to see if receiver is in source neighbourhood -! - sred=((scx-rgx(1))*earth)**2 - sred=sred+((scz-rgz(1))*earth*SIN(rgx(1)))**2 - sred=SQRT(sred) - IF(sred.LT.2.0*dpl)THEN - rgx(2)=scx - rgz(2)=scz - nrp=2 - sw=1 - ENDIF -! -! If required, see if receiver lies within refined grid -! - IF(asgr.EQ.1)THEN - ipxr=INT((surfrcx-goxr)/dnxr)+1 - ipzr=INT((surfrcz-gozr)/dnzr)+1 + ! + ! Loop through all the receivers + ! + !fang!DO i=1,nrc + ! + ! If path does not exist, then cycle the loop + ! + fdm=0 + !fang! IF(cfd.EQ.1)THEN + !fang! fdm=0.0 + !fang! ENDIF + !fang! IF(srs(i,csid).EQ.0)THEN + !fang! IF(wrgf.EQ.csid.OR.wrgf.LT.0)THEN + !fang! WRITE(40)nopath + !fang! ENDIF + !fang! IF(cfd.EQ.1)THEN + !fang! WRITE(50)nopath + !fang! ENDIF + !fang! CYCLE + !fang! ENDIF + ! + ! The first step is to locate the receiver in the grid. + ! + ipx=INT((surfrcx-gox)/dnx)+1 + ipz=INT((surfrcz-goz)/dnz)+1 + sw=0 + IF(ipx.lt.1.or.ipx.ge.nnx)sw=1 + IF(ipz.lt.1.or.ipz.ge.nnz)sw=1 + IF(sw.eq.1)then + surfrcx=90.0-surfrcx*180.0/pi + surfrcz=surfrcz*180.0/pi + WRITE(6,*)"rpath Receiver lies outside model (lat,long)= ",surfrcx,surfrcz + WRITE(6,*)"TERMINATING PROGRAM!!!" + STOP + ENDIF + IF(ipx.eq.nnx)ipx=ipx-1 + IF(ipz.eq.nnz)ipz=ipz-1 + ! + ! First point of the ray path is the receiver + ! + rgx(1)=surfrcx + rgz(1)=surfrcz + ! + ! Test to see if receiver is in source neighbourhood + ! + sred=((scx-rgx(1))*earth)**2 + sred=sred+((scz-rgz(1))*earth*SIN(rgx(1)))**2 + sred=SQRT(sred) + IF(sred.LT.2.0*dpl)THEN + rgx(2)=scx + rgz(2)=scz + nrp=2 + sw=1 + ENDIF + ! + ! If required, see if receiver lies within refined grid + ! + IF(asgr.EQ.1)THEN + ipxr=INT((surfrcx-goxr)/dnxr)+1 + ipzr=INT((surfrcz-gozr)/dnzr)+1 + igref=1 + IF(ipxr.LT.1.OR.ipxr.GE.nnxr)igref=0 + IF(ipzr.LT.1.OR.ipzr.GE.nnzr)igref=0 + IF(igref.EQ.1)THEN + IF(nstsr(ipzr,ipxr).NE.0.OR.nstsr(ipzr+1,ipxr).NE.0)igref=0 + IF(nstsr(ipzr,ipxr+1).NE.0.OR.nstsr(ipzr+1,ipxr+1).NE.0)igref=0 + ENDIF + ELSE + igref=0 + ENDIF + ! + ! Due to the method for calculating traveltime gradient, if the + ! the ray end point lies in the source cell, then we are also done. + ! + IF(sw.EQ.0)THEN + IF(asgr.EQ.1)THEN + IF(igref.EQ.1)THEN + IF(ipxr.EQ.isx)THEN + IF(ipzr.EQ.isz)THEN + rgx(2)=scx + rgz(2)=scz + nrp=2 + sw=1 + ENDIF + ENDIF + ENDIF + ELSE + IF(ipx.EQ.isx)THEN + IF(ipz.EQ.isz)THEN + rgx(2)=scx + rgz(2)=scz + nrp=2 + sw=1 + ENDIF + ENDIF + ENDIF + ENDIF + ! + ! Now trace ray from receiver to "source" + ! + DO j=1,maxrp + IF(sw.EQ.1)EXIT + ! + ! Calculate traveltime gradient vector for current cell using + ! a first-order or second-order scheme. + ! + IF(igref.EQ.1)THEN + ! + ! In this case, we are in the refined grid. + ! + ! First order scheme applied here. + ! + dtx=ttnr(ipzr,ipxr+1)-ttnr(ipzr,ipxr) + dtx=dtx+ttnr(ipzr+1,ipxr+1)-ttnr(ipzr+1,ipxr) + dtx=dtx/(2.0*earth*dnxr) + dtz=ttnr(ipzr+1,ipxr)-ttnr(ipzr,ipxr) + dtz=dtz+ttnr(ipzr+1,ipxr+1)-ttnr(ipzr,ipxr+1) + dtz=dtz/(2.0*earth*SIN(rgx(j))*dnzr) + ELSE + ! + ! Here, we are in the coarse grid. + ! + ! First order scheme applied here. + ! + dtx=ttn(ipz,ipx+1)-ttn(ipz,ipx) + dtx=dtx+ttn(ipz+1,ipx+1)-ttn(ipz+1,ipx) + dtx=dtx/(2.0*earth*dnx) + dtz=ttn(ipz+1,ipx)-ttn(ipz,ipx) + dtz=dtz+ttn(ipz+1,ipx+1)-ttn(ipz,ipx+1) + dtz=dtz/(2.0*earth*SIN(rgx(j))*dnz) + ENDIF + ! + ! Calculate the next ray path point + ! + rd1=SQRT(dtx**2+dtz**2) + rgx(j+1)=rgx(j)-dpl*dtx/(earth*rd1) + rgz(j+1)=rgz(j)-dpl*dtz/(earth*SIN(rgx(j))*rd1) + ! + ! Determine which cell the new ray endpoint + ! lies in. + ! + ipxo=ipx + ipzo=ipz + IF(asgr.EQ.1)THEN + ! + ! Here, we test to see whether the ray endpoint lies + ! within a cell of the refined grid + ! + ipxr=INT((rgx(j+1)-goxr)/dnxr)+1 + ipzr=INT((rgz(j+1)-gozr)/dnzr)+1 igref=1 IF(ipxr.LT.1.OR.ipxr.GE.nnxr)igref=0 IF(ipzr.LT.1.OR.ipzr.GE.nnzr)igref=0 IF(igref.EQ.1)THEN - IF(nstsr(ipzr,ipxr).NE.0.OR.nstsr(ipzr+1,ipxr).NE.0)igref=0 - IF(nstsr(ipzr,ipxr+1).NE.0.OR.nstsr(ipzr+1,ipxr+1).NE.0)igref=0 + IF(nstsr(ipzr,ipxr).NE.0.OR.nstsr(ipzr+1,ipxr).NE.0)igref=0 + IF(nstsr(ipzr,ipxr+1).NE.0.OR.nstsr(ipzr+1,ipxr+1).NE.0)igref=0 ENDIF - ELSE + ipx=INT((rgx(j+1)-gox)/dnx)+1 + ipz=INT((rgz(j+1)-goz)/dnz)+1 + ELSE + ipx=INT((rgx(j+1)-gox)/dnx)+1 + ipz=INT((rgz(j+1)-goz)/dnz)+1 igref=0 - ENDIF -! -! Due to the method for calculating traveltime gradient, if the -! the ray end point lies in the source cell, then we are also done. -! - IF(sw.EQ.0)THEN + ENDIF + ! + ! Test the proximity of the source to the ray end point. + ! If it is less than dpl then we are done + ! + sred=((scx-rgx(j+1))*earth)**2 + sred=sred+((scz-rgz(j+1))*earth*SIN(rgx(j+1)))**2 + sred=SQRT(sred) + sw=0 + IF(sred.LT.2.0*dpl)THEN + rgx(j+2)=scx + rgz(j+2)=scz + nrp=j+2 + sw=1 + !fang! IF(cfd.NE.1)EXIT + ENDIF + ! + ! Due to the method for calculating traveltime gradient, if the + ! the ray end point lies in the source cell, then we are also done. + ! + IF(sw.EQ.0)THEN IF(asgr.EQ.1)THEN - IF(igref.EQ.1)THEN - IF(ipxr.EQ.isx)THEN - IF(ipzr.EQ.isz)THEN - rgx(2)=scx - rgz(2)=scz - nrp=2 - sw=1 - ENDIF + IF(igref.EQ.1)THEN + IF(ipxr.EQ.isx)THEN + IF(ipzr.EQ.isz)THEN + rgx(j+2)=scx + rgz(j+2)=scz + nrp=j+2 + sw=1 + !fang! IF(cfd.NE.1)EXIT ENDIF - ENDIF + ENDIF + ENDIF ELSE - IF(ipx.EQ.isx)THEN - IF(ipz.EQ.isz)THEN - rgx(2)=scx - rgz(2)=scz - nrp=2 - sw=1 - ENDIF - ENDIF + IF(ipx.EQ.isx)THEN + IF(ipz.EQ.isz)THEN + rgx(j+2)=scx + rgz(j+2)=scz + nrp=j+2 + sw=1 + !fang! IF(cfd.NE.1)EXIT + ENDIF + ENDIF ENDIF - ENDIF -! -! Now trace ray from receiver to "source" -! - DO j=1,maxrp - IF(sw.EQ.1)EXIT -! -! Calculate traveltime gradient vector for current cell using -! a first-order or second-order scheme. -! - IF(igref.EQ.1)THEN -! -! In this case, we are in the refined grid. -! -! First order scheme applied here. -! - dtx=ttnr(ipzr,ipxr+1)-ttnr(ipzr,ipxr) - dtx=dtx+ttnr(ipzr+1,ipxr+1)-ttnr(ipzr+1,ipxr) - dtx=dtx/(2.0*earth*dnxr) - dtz=ttnr(ipzr+1,ipxr)-ttnr(ipzr,ipxr) - dtz=dtz+ttnr(ipzr+1,ipxr+1)-ttnr(ipzr,ipxr+1) - dtz=dtz/(2.0*earth*SIN(rgx(j))*dnzr) + ENDIF + ! + ! Test whether ray path segment extends beyond + ! box boundaries + ! + IF(ipx.LT.1)THEN + rgx(j+1)=gox + ipx=1 + rbint=1 + ENDIF + IF(ipx.GE.nnx)THEN + rgx(j+1)=gox+(nnx-1)*dnx + ipx=nnx-1 + rbint=1 + ENDIF + IF(ipz.LT.1)THEN + rgz(j+1)=goz + ipz=1 + rbint=1 + ENDIF + IF(ipz.GE.nnz)THEN + rgz(j+1)=goz+(nnz-1)*dnz + ipz=nnz-1 + rbint=1 + ENDIF + ! + ! Calculate the Frechet derivatives if required. + ! + !fang! IF(cfd.EQ.1)THEN + ! + ! First determine which B-spline cell the refined cells + ! containing the ray path segment lies in. If they lie + ! in more than one, then we need to divide the problem + ! into separate parts (up to three). + ! + ivx=INT((ipx-1)/gdx)+1 + ivz=INT((ipz-1)/gdz)+1 + ivxo=INT((ipxo-1)/gdx)+1 + ivzo=INT((ipzo-1)/gdz)+1 + ! + ! Calculate up to two hit points between straight + ! ray segment and cell faces. + ! + nhp=0 + IF(ivx.NE.ivxo)THEN + nhp=nhp+1 + IF(ivx.GT.ivxo)THEN + xi=gox+(ivx-1)*dvx ELSE -! -! Here, we are in the coarse grid. -! -! First order scheme applied here. -! - dtx=ttn(ipz,ipx+1)-ttn(ipz,ipx) - dtx=dtx+ttn(ipz+1,ipx+1)-ttn(ipz+1,ipx) - dtx=dtx/(2.0*earth*dnx) - dtz=ttn(ipz+1,ipx)-ttn(ipz,ipx) - dtz=dtz+ttn(ipz+1,ipx+1)-ttn(ipz,ipx+1) - dtz=dtz/(2.0*earth*SIN(rgx(j))*dnz) + xi=gox+ivx*dvx ENDIF -! -! Calculate the next ray path point -! - rd1=SQRT(dtx**2+dtz**2) - rgx(j+1)=rgx(j)-dpl*dtx/(earth*rd1) - rgz(j+1)=rgz(j)-dpl*dtz/(earth*SIN(rgx(j))*rd1) -! -! Determine which cell the new ray endpoint -! lies in. -! - ipxo=ipx - ipzo=ipz - IF(asgr.EQ.1)THEN -! -! Here, we test to see whether the ray endpoint lies -! within a cell of the refined grid -! - ipxr=INT((rgx(j+1)-goxr)/dnxr)+1 - ipzr=INT((rgz(j+1)-gozr)/dnzr)+1 - igref=1 - IF(ipxr.LT.1.OR.ipxr.GE.nnxr)igref=0 - IF(ipzr.LT.1.OR.ipzr.GE.nnzr)igref=0 - IF(igref.EQ.1)THEN - IF(nstsr(ipzr,ipxr).NE.0.OR.nstsr(ipzr+1,ipxr).NE.0)igref=0 - IF(nstsr(ipzr,ipxr+1).NE.0.OR.nstsr(ipzr+1,ipxr+1).NE.0)igref=0 - ENDIF - ipx=INT((rgx(j+1)-gox)/dnx)+1 - ipz=INT((rgz(j+1)-goz)/dnz)+1 + vrat(nhp)=(xi-rgx(j))/(rgx(j+1)-rgx(j)) + chp(nhp)=1 + ENDIF + IF(ivz.NE.ivzo)THEN + nhp=nhp+1 + IF(ivz.GT.ivzo)THEN + zi=goz+(ivz-1)*dvz ELSE - ipx=INT((rgx(j+1)-gox)/dnx)+1 - ipz=INT((rgz(j+1)-goz)/dnz)+1 - igref=0 + zi=goz+ivz*dvz ENDIF -! -! Test the proximity of the source to the ray end point. -! If it is less than dpl then we are done -! - sred=((scx-rgx(j+1))*earth)**2 - sred=sred+((scz-rgz(j+1))*earth*SIN(rgx(j+1)))**2 - sred=SQRT(sred) - sw=0 - IF(sred.LT.2.0*dpl)THEN - rgx(j+2)=scx - rgz(j+2)=scz - nrp=j+2 - sw=1 -!fang! IF(cfd.NE.1)EXIT + rd1=(zi-rgz(j))/(rgz(j+1)-rgz(j)) + IF(nhp.EQ.1)THEN + vrat(nhp)=rd1 + chp(nhp)=2 + ELSE + IF(rd1.GE.vrat(nhp-1))THEN + vrat(nhp)=rd1 + chp(nhp)=2 + ELSE + vrat(nhp)=vrat(nhp-1) + chp(nhp)=chp(nhp-1) + vrat(nhp-1)=rd1 + chp(nhp-1)=2 + ENDIF ENDIF -! -! Due to the method for calculating traveltime gradient, if the -! the ray end point lies in the source cell, then we are also done. -! - IF(sw.EQ.0)THEN - IF(asgr.EQ.1)THEN - IF(igref.EQ.1)THEN - IF(ipxr.EQ.isx)THEN - IF(ipzr.EQ.isz)THEN - rgx(j+2)=scx - rgz(j+2)=scz - nrp=j+2 - sw=1 - !fang! IF(cfd.NE.1)EXIT - ENDIF - ENDIF - ENDIF - ELSE - IF(ipx.EQ.isx)THEN - IF(ipz.EQ.isz)THEN - rgx(j+2)=scx - rgz(j+2)=scz - nrp=j+2 - sw=1 - !fang! IF(cfd.NE.1)EXIT - ENDIF - ENDIF - ENDIF - ENDIF -! -! Test whether ray path segment extends beyond -! box boundaries -! - IF(ipx.LT.1)THEN - rgx(j+1)=gox - ipx=1 - rbint=1 - ENDIF - IF(ipx.GE.nnx)THEN - rgx(j+1)=gox+(nnx-1)*dnx - ipx=nnx-1 - rbint=1 - ENDIF - IF(ipz.LT.1)THEN - rgz(j+1)=goz - ipz=1 - rbint=1 - ENDIF - IF(ipz.GE.nnz)THEN - rgz(j+1)=goz+(nnz-1)*dnz - ipz=nnz-1 - rbint=1 - ENDIF -! -! Calculate the Frechet derivatives if required. -! - !fang! IF(cfd.EQ.1)THEN -! -! First determine which B-spline cell the refined cells -! containing the ray path segment lies in. If they lie -! in more than one, then we need to divide the problem -! into separate parts (up to three). -! - ivx=INT((ipx-1)/gdx)+1 - ivz=INT((ipz-1)/gdz)+1 - ivxo=INT((ipxo-1)/gdx)+1 - ivzo=INT((ipzo-1)/gdz)+1 -! -! Calculate up to two hit points between straight -! ray segment and cell faces. -! - nhp=0 - IF(ivx.NE.ivxo)THEN - nhp=nhp+1 - IF(ivx.GT.ivxo)THEN - xi=gox+(ivx-1)*dvx - ELSE - xi=gox+ivx*dvx - ENDIF - vrat(nhp)=(xi-rgx(j))/(rgx(j+1)-rgx(j)) - chp(nhp)=1 - ENDIF - IF(ivz.NE.ivzo)THEN - nhp=nhp+1 - IF(ivz.GT.ivzo)THEN - zi=goz+(ivz-1)*dvz - ELSE - zi=goz+ivz*dvz - ENDIF - rd1=(zi-rgz(j))/(rgz(j+1)-rgz(j)) - IF(nhp.EQ.1)THEN - vrat(nhp)=rd1 - chp(nhp)=2 - ELSE - IF(rd1.GE.vrat(nhp-1))THEN - vrat(nhp)=rd1 - chp(nhp)=2 - ELSE - vrat(nhp)=vrat(nhp-1) - chp(nhp)=chp(nhp-1) - vrat(nhp-1)=rd1 - chp(nhp-1)=2 - ENDIF - ENDIF - ENDIF - nhp=nhp+1 - vrat(nhp)=1.0 - chp(nhp)=0 -! -! Calculate the velocity, v and w values of the -! first point -! - drx=(rgx(j)-gox)-(ipxo-1)*dnx - drz=(rgz(j)-goz)-(ipzo-1)*dnz - vel=0.0 - DO l=1,2 - DO m=1,2 - produ=(1.0-ABS(((m-1)*dnz-drz)/dnz)) - produ=produ*(1.0-ABS(((l-1)*dnx-drx)/dnx)) - IF(ipzo-1+m.LE.nnz.AND.ipxo-1+l.LE.nnx)THEN - vel=vel+veln(ipzo-1+m,ipxo-1+l)*produ - ENDIF - ENDDO - ENDDO - drx=(rgx(j)-gox)-(ivxo-1)*dvx - drz=(rgz(j)-goz)-(ivzo-1)*dvz - v=drx/dvx - w=drz/dvz -! -! Calculate the 12 basis values at the point -! - vi(1)=(1.0-v)**3/6.0 - vi(2)=(4.0-6.0*v**2+3.0*v**3)/6.0 - vi(3)=(1.0+3.0*v+3.0*v**2-3.0*v**3)/6.0 - vi(4)=v**3/6.0 - wi(1)=(1.0-w)**3/6.0 - wi(2)=(4.0-6.0*w**2+3.0*w**3)/6.0 - wi(3)=(1.0+3.0*w+3.0*w**2-3.0*w**3)/6.0 - wi(4)=w**3/6.0 - ivxt=ivxo - ivzt=ivzo -! -! Now loop through the one or more sub-segments of the -! ray path segment and calculate partial derivatives -! - DO k=1,nhp - velo=vel - vio=vi - wio=wi - IF(k.GT.1)THEN - IF(chp(k-1).EQ.1)THEN - ivxt=ivx - ELSE IF(chp(k-1).EQ.2)THEN - ivzt=ivz - ENDIF - ENDIF -! -! Calculate the velocity, v and w values of the -! new point -! - rigz=rgz(j)+vrat(k)*(rgz(j+1)-rgz(j)) - rigx=rgx(j)+vrat(k)*(rgx(j+1)-rgx(j)) - ipxt=INT((rigx-gox)/dnx)+1 - ipzt=INT((rigz-goz)/dnz)+1 - drx=(rigx-gox)-(ipxt-1)*dnx - drz=(rigz-goz)-(ipzt-1)*dnz - vel=0.0 - DO m=1,2 - DO n=1,2 - produ=(1.0-ABS(((n-1)*dnz-drz)/dnz)) - produ=produ*(1.0-ABS(((m-1)*dnx-drx)/dnx)) - IF(ipzt-1+n.LE.nnz.AND.ipxt-1+m.LE.nnx)THEN - vel=vel+veln(ipzt-1+n,ipxt-1+m)*produ - ENDIF - ENDDO - ENDDO - drx=(rigx-gox)-(ivxt-1)*dvx - drz=(rigz-goz)-(ivzt-1)*dvz - v=drx/dvx - w=drz/dvz -! -! Calculate the 8 basis values at the new point -! - vi(1)=(1.0-v)**3/6.0 - vi(2)=(4.0-6.0*v**2+3.0*v**3)/6.0 - vi(3)=(1.0+3.0*v+3.0*v**2-3.0*v**3)/6.0 - vi(4)=v**3/6.0 - wi(1)=(1.0-w)**3/6.0 - wi(2)=(4.0-6.0*w**2+3.0*w**3)/6.0 - wi(3)=(1.0+3.0*w+3.0*w**2-3.0*w**3)/6.0 - wi(4)=w**3/6.0 -! -! Calculate the incremental path length -! - IF(k.EQ.1)THEN - dinc=vrat(k)*dpl - ELSE - dinc=(vrat(k)-vrat(k-1))*dpl - ENDIF -! -! Now compute the 16 contributions to the partial -! derivatives. -! - DO l=1,4 - DO m=1,4 - rd1=vi(m)*wi(l)/vel**2 - rd2=vio(m)*wio(l)/velo**2 - rd1=-(rd1+rd2)*dinc/2.0 - !fang! rd1=vi(m)*wi(l) - !fang! rd2=vio(m)*wio(l) - !fang! rd1=(rd1+rd2)*dinc/2.0 - rd2=fdm(ivzt-2+l,ivxt-2+m) - fdm(ivzt-2+l,ivxt-2+m)=rd1+rd2 - ENDDO - ENDDO - ENDDO - !fang! ENDIF -!fang! IF(j.EQ.maxrp.AND.sw.EQ.0)THEN -!fang! WRITE(6,*)'Error with ray path detected!!!' -!fang! WRITE(6,*)'Source id: ',csid -!fang! WRITE(6,*)'Receiver id: ',i -!fang! ENDIF - ENDDO -! -! Write ray paths to output file -! -!fang! IF(wrgf.EQ.csid.OR.wrgf.LT.0)THEN - if(writepath == 1) then - WRITE(40,*)'#',nrp - DO j=1,nrp - rayx=(pi/2-rgx(j))*180.0/pi - rayz=rgz(j)*180.0/pi - WRITE(40,*)rayx,rayz + ENDIF + nhp=nhp+1 + vrat(nhp)=1.0 + chp(nhp)=0 + ! + ! Calculate the velocity, v and w values of the + ! first point + ! + drx=(rgx(j)-gox)-(ipxo-1)*dnx + drz=(rgz(j)-goz)-(ipzo-1)*dnz + vel=0.0 + DO l=1,2 + DO m=1,2 + produ=(1.0-ABS(((m-1)*dnz-drz)/dnz)) + produ=produ*(1.0-ABS(((l-1)*dnx-drx)/dnx)) + IF(ipzo-1+m.LE.nnz.AND.ipxo-1+l.LE.nnx)THEN + vel=vel+veln(ipzo-1+m,ipxo-1+l)*produ + ENDIF ENDDO + ENDDO + drx=(rgx(j)-gox)-(ivxo-1)*dvx + drz=(rgz(j)-goz)-(ivzo-1)*dvz + v=drx/dvx + w=drz/dvz + ! + ! Calculate the 12 basis values at the point + ! + vi(1)=(1.0-v)**3/6.0 + vi(2)=(4.0-6.0*v**2+3.0*v**3)/6.0 + vi(3)=(1.0+3.0*v+3.0*v**2-3.0*v**3)/6.0 + vi(4)=v**3/6.0 + wi(1)=(1.0-w)**3/6.0 + wi(2)=(4.0-6.0*w**2+3.0*w**3)/6.0 + wi(3)=(1.0+3.0*w+3.0*w**2-3.0*w**3)/6.0 + wi(4)=w**3/6.0 + ivxt=ivxo + ivzt=ivzo + ! + ! Now loop through the one or more sub-segments of the + ! ray path segment and calculate partial derivatives + ! + DO k=1,nhp + velo=vel + vio=vi + wio=wi + IF(k.GT.1)THEN + IF(chp(k-1).EQ.1)THEN + ivxt=ivx + ELSE IF(chp(k-1).EQ.2)THEN + ivzt=ivz + ENDIF + ENDIF + ! + ! Calculate the velocity, v and w values of the + ! new point + ! + rigz=rgz(j)+vrat(k)*(rgz(j+1)-rgz(j)) + rigx=rgx(j)+vrat(k)*(rgx(j+1)-rgx(j)) + ipxt=INT((rigx-gox)/dnx)+1 + ipzt=INT((rigz-goz)/dnz)+1 + drx=(rigx-gox)-(ipxt-1)*dnx + drz=(rigz-goz)-(ipzt-1)*dnz + vel=0.0 + DO m=1,2 + DO n=1,2 + produ=(1.0-ABS(((n-1)*dnz-drz)/dnz)) + produ=produ*(1.0-ABS(((m-1)*dnx-drx)/dnx)) + IF(ipzt-1+n.LE.nnz.AND.ipxt-1+m.LE.nnx)THEN + vel=vel+veln(ipzt-1+n,ipxt-1+m)*produ + ENDIF + ENDDO + ENDDO + drx=(rigx-gox)-(ivxt-1)*dvx + drz=(rigz-goz)-(ivzt-1)*dvz + v=drx/dvx + w=drz/dvz + ! + ! Calculate the 8 basis values at the new point + ! + vi(1)=(1.0-v)**3/6.0 + vi(2)=(4.0-6.0*v**2+3.0*v**3)/6.0 + vi(3)=(1.0+3.0*v+3.0*v**2-3.0*v**3)/6.0 + vi(4)=v**3/6.0 + wi(1)=(1.0-w)**3/6.0 + wi(2)=(4.0-6.0*w**2+3.0*w**3)/6.0 + wi(3)=(1.0+3.0*w+3.0*w**2-3.0*w**3)/6.0 + wi(4)=w**3/6.0 + ! + ! Calculate the incremental path length + ! + IF(k.EQ.1)THEN + dinc=vrat(k)*dpl + ELSE + dinc=(vrat(k)-vrat(k-1))*dpl + ENDIF + ! + ! Now compute the 16 contributions to the partial + ! derivatives. + ! + DO l=1,4 + DO m=1,4 + rd1=vi(m)*wi(l)/vel**2 + rd2=vio(m)*wio(l)/velo**2 + rd1=-(rd1+rd2)*dinc/2.0 + !fang! rd1=vi(m)*wi(l) + !fang! rd2=vio(m)*wio(l) + !fang! rd1=(rd1+rd2)*dinc/2.0 + rd2=fdm(ivzt-2+l,ivxt-2+m) + fdm(ivzt-2+l,ivxt-2+m)=rd1+rd2 + ENDDO + ENDDO + ENDDO + !fang! ENDIF + !fang! IF(j.EQ.maxrp.AND.sw.EQ.0)THEN + !fang! WRITE(6,*)'Error with ray path detected!!!' + !fang! WRITE(6,*)'Source id: ',csid + !fang! WRITE(6,*)'Receiver id: ',i + !fang! ENDIF + ENDDO + ! + ! Write ray paths to output file + ! + !fang! IF(wrgf.EQ.csid.OR.wrgf.LT.0)THEN + if(writepath == 1) then + WRITE(40,*)'#',nrp + DO j=1,nrp + rayx=(pi/2-rgx(j))*180.0/pi + rayz=rgz(j)*180.0/pi + WRITE(40,*)rayx,rayz + ENDDO endif -!fang! ENDIF -! -! Write partial derivatives to output file -! -!fang! IF(cfd.EQ.1)THEN -!fang!! -!fang!! Determine the number of non-zero elements. -!fang!! -!fang! isum=0 -!fang! DO j=0,nvz+1 -!fang! DO k=0,nvx+1 -!fang! IF(ABS(fdm(j,k)).GE.ftol)isum=isum+1 -!fang! ENDDO -!fang! ENDDO -!fang! WRITE(50)isum -!fang! isum=0 -!fang! DO j=0,nvz+1 -!fang! DO k=0,nvx+1 -!fang! isum=isum+1 -!fang! IF(ABS(fdm(j,k)).GE.ftol)WRITE(50)isum,fdm(j,k) -!fang! ENDDO -!fang! ENDDO -!fang! ENDIF -!fang!ENDDO -!fang!IF(cfd.EQ.1)THEN -!fang! DEALLOCATE(fdm, STAT=checkstat) -!fang! IF(checkstat > 0)THEN -!fang! WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE rpaths: fdm' -!fang! ENDIF -!fang!ENDIF -DEALLOCATE(rgx,rgz, STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE rpaths: rgx,rgz' -ENDIF + !fang! ENDIF + ! + ! Write partial derivatives to output file + ! + !fang! IF(cfd.EQ.1)THEN + !fang!! + !fang!! Determine the number of non-zero elements. + !fang!! + !fang! isum=0 + !fang! DO j=0,nvz+1 + !fang! DO k=0,nvx+1 + !fang! IF(ABS(fdm(j,k)).GE.ftol)isum=isum+1 + !fang! ENDDO + !fang! ENDDO + !fang! WRITE(50)isum + !fang! isum=0 + !fang! DO j=0,nvz+1 + !fang! DO k=0,nvx+1 + !fang! isum=isum+1 + !fang! IF(ABS(fdm(j,k)).GE.ftol)WRITE(50)isum,fdm(j,k) + !fang! ENDDO + !fang! ENDDO + !fang! ENDIF + !fang!ENDDO + !fang!IF(cfd.EQ.1)THEN + !fang! DEALLOCATE(fdm, STAT=checkstat) + !fang! IF(checkstat > 0)THEN + !fang! WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE rpaths: fdm' + !fang! ENDIF + !fang!ENDIF + DEALLOCATE(rgx,rgz, STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with DEALLOCATE: SUBROUTINE rpaths: rgx,rgz' + ENDIF END SUBROUTINE rpaths !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2241,564 +2241,564 @@ END SUBROUTINE rpaths ! the internal point by using bilinear interpolation. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE bilinear(nv,dsx,dsz,biv) -USE globalp -IMPLICIT NONE -INTEGER :: i,j -REAL(KIND=i10) :: dsx,dsz,biv -REAL(KIND=i10), DIMENSION(2,2) :: nv -REAL(KIND=i10) :: produ -! -! nv = four node vertex values -! dsx,dsz = distance between internal point and top left node -! dnx,dnz = width and height of node rectangle -! biv = value at internal point calculated by bilinear interpolation -! produ = product variable -! -biv=0.0 -DO i=1,2 - DO j=1,2 + USE globalp + IMPLICIT NONE + INTEGER :: i,j + REAL(KIND=i10) :: dsx,dsz,biv + REAL(KIND=i10), DIMENSION(2,2) :: nv + REAL(KIND=i10) :: produ + ! + ! nv = four node vertex values + ! dsx,dsz = distance between internal point and top left node + ! dnx,dnz = width and height of node rectangle + ! biv = value at internal point calculated by bilinear interpolation + ! produ = product variable + ! + biv=0.0 + DO i=1,2 + DO j=1,2 produ=(1.0-ABS(((i-1)*dnx-dsx)/dnx))*(1.0-ABS(((j-1)*dnz-dsz)/dnz)) biv=biv+nv(i,j)*produ - ENDDO -ENDDO + ENDDO + ENDDO END SUBROUTINE bilinear - subroutine refineGrid2LayerMdl(minthk0,mmax,dep,vp,vs,rho,& - rmax,rdep,rvp,rvs,rrho,rthk) -!!--------------------------------------------------------------------c -!!refine grid based model to layerd based model -!!INPUT: minthk: is the minimum thickness of the refined layered model -!! mmax: number of depth grid points in the model -!! dep, vp, vs, rho: the depth-grid model parameters -!! rmax: number of layers in the fined layered model -!! rdep, rvp, rvs, rrho, rthk: the refined layered velocity model -!! - implicit none - integer NL - parameter (NL=200) - integer mmax,rmax - real minthk0 - real minthk - real dep(*),vp(*),vs(*),rho(*) - real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) - integer nsublay(NL) - real thk,newthk,initdep - integer i,j,k,ngrid +subroutine refineGrid2LayerMdl(minthk0,mmax,dep,vp,vs,rho,& + rmax,rdep,rvp,rvs,rrho,rthk) + !!--------------------------------------------------------------------c + !!refine grid based model to layerd based model + !!INPUT: minthk: is the minimum thickness of the refined layered model + !! mmax: number of depth grid points in the model + !! dep, vp, vs, rho: the depth-grid model parameters + !! rmax: number of layers in the fined layered model + !! rdep, rvp, rvs, rrho, rthk: the refined layered velocity model + !! + implicit none + integer NL + parameter (NL=200) + integer mmax,rmax + real minthk0 + real minthk + real dep(*),vp(*),vs(*),rho(*) + real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) + integer nsublay(NL) + real thk,newthk,initdep + integer i,j,k,ngrid - k = 0 - initdep = 0.0 - do i = 1, mmax-1 - thk = dep(i+1)-dep(i) - minthk = thk/minthk0 - nsublay(i) = int((thk+1.0e-4)/minthk) + 1 - ngrid = nsublay(i)+1 - newthk = thk/nsublay(i) - do j = 1, nsublay(i) - k = k + 1 - rthk(k) = newthk - rdep(k) = initdep + rthk(k) - initdep = rdep(k) - rvp(k) = vp(i)+(2*j-1)*(vp(i+1)-vp(i))/(2*nsublay(i)) - rvs(k) = vs(i)+(2*j-1)*(vs(i+1)-vs(i))/(2*nsublay(i)) - rrho(k) = rho(i)+(2*j-1)*(rho(i+1)-rho(i))/(2*nsublay(i)) - enddo - enddo -!! half space model - k = k + 1 - rthk(k) = 0.0 - rvp(k) = vp(mmax) - rvs(k) = vs(mmax) - rrho(k) = rho(mmax) - rdep(k) = dep(mmax) - - rmax = k - -!! do i = 1, mmax -!! write(*,*) dep(i),vp(i),vs(i),rho(i) -!! enddo -!! print *, '---------------------------------' -!! do i = 1, rmax -!! write(*,*) rdep(i),rthk(i),rvp(i),rvs(i),rrho(i) -!! enddo - - return - end -subroutine synthetic(nx,ny,nz,nparpi,vels,obst, & - goxdf,gozdf,dvxdf,dvzdf,kmaxRc,kmaxRg,kmaxLc,kmaxLg, & - tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk, & - scxf,sczf,rcxf,rczf,nrc1,nsrcsurf1,kmax,nsrcsurf,nrcf,noiselevel) - -USE globalp -USE traveltime -IMPLICIT NONE -!CHARACTER (LEN=30) ::grid,frechet -!CHARACTER (LEN=40) :: sources,receivers,otimes -!CHARACTER (LEN=30) :: travelt,rtravel,wrays,cdum -INTEGER :: i,j,k,l,nsrc,tnr,urg -INTEGER :: sgs,isx,isz,sw,idm1,idm2,nnxb,nnzb -INTEGER :: ogx,ogz,grdfx,grdfz,maxbt -REAL(KIND=i10) :: x,z,goxb,gozb,dnxb,dnzb -!REAL(KIND=i10), DIMENSION (:,:), ALLOCATABLE :: scxf,sczf -!REAL(KIND=i10), DIMENSION (:,:,:), ALLOCATABLE :: rcxf,rczf -! -! sources = File containing source locations -! receivers = File containing receiver locations -! grid = File containing grid of velocity vertices for -! resampling on a finer grid with cubic B-splines -! frechet = output file containing matrix of frechet derivatives -! travelt = File name for storage of traveltime field -! wttf = Write traveltimes to file? (0=no,>0=source id) -! fom = Use first-order(0) or mixed-order(1) scheme -! nsrc = number of sources -! scx,scz = source location in r,x,z -! scx,scz = source location in r,x,z -! x,z = temporary variables for source location -! fsrt = find source-receiver traveltimes? (0=no,1=yes) -! rtravel = output file for source-receiver traveltimes -! cdum = dummy character variable ! wrgf = write ray geometries to file? (<0=all,0=no,>0=source id.) -! wrays = file containing raypath geometries -! cfd = calculate Frechet derivatives? (0=no, 1=yes) -! tnr = total number of receivers -! sgs = Extent of refined source grid -! isx,isz = cell containing source -! nnxb,nnzb = Backup for nnz,nnx -! goxb,gozb = Backup for gox,goz -! dnxb,dnzb = Backup for dnx,dnz -! ogx,ogz = Location of refined grid origin -! gridfx,grdfz = Number of refined nodes per cell -! urg = use refined grid (0=no,1=yes,2=previously used) -! maxbt = maximum size of narrow band binary tree -! otimes = file containing source-receiver association information -!c----------------------------------------------------------------- -! variables defined by Hongjian Fang - integer nx,ny,nz - integer kmax,nsrcsurf,nrcf - real vels(nx,ny,nz) - real obst(*) - real goxdf,gozdf,dvxdf,dvzdf - integer kmaxRc,kmaxRg,kmaxLc,kmaxLg - real*8 tRc(*),tRg(*),tLc(*),tLg(*) - integer wavetype(nsrcsurf,kmax) - integer periods(nsrcsurf,kmax),nrc1(nsrcsurf,kmax),nsrcsurf1(kmax) - integer igrt(nsrcsurf,kmax) - real scxf(nsrcsurf,kmax),sczf(nsrcsurf,kmax),rcxf(nrcf,nsrcsurf,kmax),rczf(nrcf,nsrcsurf,kmax) - real minthk - integer nparpi - - - real vpz(nz),vsz(nz),rhoz(nz),depz(nz) - real*8 pvRc(nx*ny,kmaxRc),pvRg(nx*ny,kmaxRg),pvLc(nx*ny,kmaxLc),pvLg(nx*ny,kmaxLg) - real*8 velf(ny*nx) - integer kmax1,kmax2,kmax3,count1 - integer igr - integer iwave - integer knumi,srcnum - real cbst1 - real noiselevel - real gaussian - external gaussian - integer ii,jj,kk,nn,istep -gdx=5 -gdz=5 -asgr=1 -sgdl=8 -sgs=8 -earth=6371.0 -fom=1 -snb=0.5 -goxd=goxdf -gozd=gozdf -dvxd=dvxdf -dvzd=dvzdf -nvx=nx-2 -nvz=ny-2 -ALLOCATE(velv(0:nvz+1,0:nvx+1), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL velv' -ENDIF -! -! Convert from degrees to radians -! -dvx=dvxd*pi/180.0 -dvz=dvzd*pi/180.0 -gox=(90.0-goxd)*pi/180.0 -goz=gozd*pi/180.0 -! -! Compute corresponding values for propagation grid. -! -nnx=(nvx-1)*gdx+1 -nnz=(nvz-1)*gdz+1 -dnx=dvx/gdx -dnz=dvz/gdz -dnxd=dvxd/gdx -dnzd=dvzd/gdz -ALLOCATE(veln(nnz,nnx), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL veln' -ENDIF - -! -! Call a subroutine which reads in the velocity grid -! -!CALL gridder(grid) -! -! Read in all source coordinates. -! -! -! Now work out, source by source, the first-arrival traveltime -! field plus source-receiver traveltimes -! and ray paths if required. First, allocate memory to the -! traveltime field array -! -ALLOCATE(ttn(nnz,nnx), STAT=checkstat) -IF(checkstat > 0)THEN - WRITE(6,*)'Error with ALLOCATE: PROGRAM fmmin2d: REAL ttn' -ENDIF - rbint=0 -! -! Allocate memory for node status and binary trees -! -ALLOCATE(nsts(nnz,nnx)) -maxbt=NINT(snb*nnx*nnz) -ALLOCATE(btg(maxbt)) - -!allocate(fdm(0:nvz+1,0:nvx+1)) - - if(kmaxRc.gt.0) then - iwave=2 - igr=0 - call caldespersion(nx,ny,nz,vels,pvRc, & - iwave,igr,kmaxRc,tRc,depz,minthk) - endif - - if(kmaxRg.gt.0) then - iwave=2 - igr=1 - call caldespersion(nx,ny,nz,vels,pvRg, & - iwave,igr,kmaxRg,tRg,depz,minthk) - endif - - if(kmaxLc.gt.0) then - iwave=1 - igr=0 - call caldespersion(nx,ny,nz,vels,pvLc, & - iwave,igr,kmaxLc,tLc,depz,minthk) - endif - - if(kmaxLg.gt.0) then - iwave=1 - igr=1 - call caldespersion(nx,ny,nz,vels,pvLg, & - iwave,igr,kmaxLg,tLg,depz,minthk) - endif - -!nar=0 -count1=0 - -!sen_vs=0 -!sen_vp=0 -!sen_rho=0 -kmax1=kmaxRc -kmax2=kmaxRc+kmaxRg -kmax3=kmaxRc+kmaxRg+kmaxLc -do knumi=1,kmax -do srcnum=1,nsrcsurf1(knumi) - if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==0) then - velf(1:nx*ny)=pvRc(1:nx*ny,periods(srcnum,knumi)) -! sen_vs(:,1:kmax1,:)=sen_vsRc(:,1:kmaxRc,:)!(:,nt(istep),:) -! sen_vp(:,1:kmax1,:)=sen_vpRc(:,1:kmaxRc,:)!(:,nt(istep),:) -! sen_rho(:,1:kmax1,:)=sen_rhoRc(:,1:kmaxRc,:)!(:,nt(istep),:) - endif - if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==1) then - velf(1:nx*ny)=pvRg(1:nx*ny,periods(srcnum,knumi)) -! sen_vs(:,kmax1+1:kmax2,:)=sen_vsRg(:,1:kmaxRg,:)!(:,nt,:) -! sen_vp(:,kmax1+1:kmax2,:)=sen_vpRg(:,1:kmaxRg,:)!(:,nt,:) -! sen_rho(:,kmax1+1:kmax2,:)=sen_rhoRg(:,1:kmaxRg,:)!(:,nt,:) - endif - if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==0) then - velf(1:nx*ny)=pvLc(1:nx*ny,periods(srcnum,knumi)) -! sen_vs(:,kmax2+1:kmax3,:)=sen_vsLc(:,1:kmaxLc,:)!(:,nt,:) -! sen_vp(:,kmax2+1:kmax3,:)=sen_vpLc(:,1:kmaxLc,:)!(:,nt,:) -! sen_rho(:,kmax2+1:kmax3,:)=sen_rhoLc(:,1:kmaxLc,:)!(:,nt,:) - endif - if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==1) then - velf(1:nx*ny)=pvLg(1:nx*ny,periods(srcnum,knumi)) -! sen_vs(:,kmax3+1:kmax,:)=sen_vsLg(:,1:kmaxLg,:)!(:,nt,:) -! sen_vp(:,kmax3+1:kmax,:)=sen_vpLg(:,1:kmaxLg,:)!(:,nt,:) -! sen_rho(:,kmax3+1:kmax,:)=sen_rhoLg(:,1:kmaxLg,:)!(:,nt,:) - endif - -call gridder(velf) - x=scxf(srcnum,knumi) - z=sczf(srcnum,knumi) -! -! Begin by computing refined source grid if required -! - urg=0 - IF(asgr.EQ.1)THEN -! -! Back up coarse velocity grid to a holding matrix -! - ALLOCATE(velnb(nnz,nnx)) -! MODIFIEDY BY HONGJIAN FANG @ USTC 2014/04/17 - velnb(1:nnz,1:nnx)=veln(1:nnz,1:nnx) - nnxb=nnx - nnzb=nnz - dnxb=dnx - dnzb=dnz - goxb=gox - gozb=goz -! -! Identify nearest neighbouring node to source -! - isx=INT((x-gox)/dnx)+1 - isz=INT((z-goz)/dnz)+1 - sw=0 - IF(isx.lt.1.or.isx.gt.nnx)sw=1 - IF(isz.lt.1.or.isz.gt.nnz)sw=1 - IF(sw.eq.1)then - x=90.0-x*180.0/pi - z=z*180.0/pi - WRITE(6,*)"Source lies outside bounds of model (lat,long)= ",x,z - WRITE(6,*)"TERMINATING PROGRAM!!!" - STOP - ENDIF - IF(isx.eq.nnx)isx=isx-1 - IF(isz.eq.nnz)isz=isz-1 -! -! Now find rectangular box that extends outward from the nearest source node -! to "sgs" nodes away. -! - vnl=isx-sgs - IF(vnl.lt.1)vnl=1 - vnr=isx+sgs - IF(vnr.gt.nnx)vnr=nnx - vnt=isz-sgs - IF(vnt.lt.1)vnt=1 - vnb=isz+sgs - IF(vnb.gt.nnz)vnb=nnz - nrnx=(vnr-vnl)*sgdl+1 - nrnz=(vnb-vnt)*sgdl+1 - drnx=dvx/REAL(gdx*sgdl) - drnz=dvz/REAL(gdz*sgdl) - gorx=gox+dnx*(vnl-1) - gorz=goz+dnz*(vnt-1) - nnx=nrnx - nnz=nrnz - dnx=drnx - dnz=drnz - gox=gorx - goz=gorz -! -! Reallocate velocity and traveltime arrays if nnx>nnxb or -! nnz0=source id) + ! fom = Use first-order(0) or mixed-order(1) scheme + ! nsrc = number of sources + ! scx,scz = source location in r,x,z + ! scx,scz = source location in r,x,z + ! x,z = temporary variables for source location + ! fsrt = find source-receiver traveltimes? (0=no,1=yes) + ! rtravel = output file for source-receiver traveltimes + ! cdum = dummy character variable ! wrgf = write ray geometries to file? (<0=all,0=no,>0=source id.) + ! wrays = file containing raypath geometries + ! cfd = calculate Frechet derivatives? (0=no, 1=yes) + ! tnr = total number of receivers + ! sgs = Extent of refined source grid + ! isx,isz = cell containing source + ! nnxb,nnzb = Backup for nnz,nnx + ! goxb,gozb = Backup for gox,goz + ! dnxb,dnzb = Backup for dnx,dnz + ! ogx,ogz = Location of refined grid origin + ! gridfx,grdfz = Number of refined nodes per cell + ! urg = use refined grid (0=no,1=yes,2=previously used) + ! maxbt = maximum size of narrow band binary tree + ! otimes = file containing source-receiver association information + !c----------------------------------------------------------------- + ! variables defined by Hongjian Fang + integer nx,ny,nz + integer kmax,nsrcsurf,nrcf + real vels(nx,ny,nz) + real obst(*) + real goxdf,gozdf,dvxdf,dvzdf + integer kmaxRc,kmaxRg,kmaxLc,kmaxLg + real*8 tRc(*),tRg(*),tLc(*),tLg(*) + integer wavetype(nsrcsurf,kmax) + integer periods(nsrcsurf,kmax),nrc1(nsrcsurf,kmax),nsrcsurf1(kmax) + integer igrt(nsrcsurf,kmax) + real scxf(nsrcsurf,kmax),sczf(nsrcsurf,kmax),rcxf(nrcf,nsrcsurf,kmax),rczf(nrcf,nsrcsurf,kmax) + real minthk + integer nparpi + + + real vpz(nz),vsz(nz),rhoz(nz),depz(nz) + real*8 pvRc(nx*ny,kmaxRc),pvRg(nx*ny,kmaxRg),pvLc(nx*ny,kmaxLc),pvLg(nx*ny,kmaxLg) + real*8 velf(ny*nx) + integer kmax1,kmax2,kmax3,count1 + integer igr + integer iwave + integer knumi,srcnum + real cbst1 + real noiselevel + real gaussian + external gaussian + integer ii,jj,kk,nn,istep + gdx=5 + gdz=5 + asgr=1 + sgdl=8 + sgs=8 + earth=6371.0 + fom=1 + snb=0.5 + goxd=goxdf + gozd=gozdf + dvxd=dvxdf + dvzd=dvzdf + nvx=nx-2 + nvz=ny-2 + ALLOCATE(velv(0:nvz+1,0:nvx+1), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL velv' + ENDIF + ! + ! Convert from degrees to radians + ! + dvx=dvxd*pi/180.0 + dvz=dvzd*pi/180.0 + gox=(90.0-goxd)*pi/180.0 + goz=gozd*pi/180.0 + ! + ! Compute corresponding values for propagation grid. + ! + nnx=(nvx-1)*gdx+1 + nnz=(nvz-1)*gdz+1 + dnx=dvx/gdx + dnz=dvz/gdz + dnxd=dvxd/gdx + dnzd=dvzd/gdz + ALLOCATE(veln(nnz,nnx), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: SUBROUTINE gridder: REAL veln' + ENDIF + + ! + ! Call a subroutine which reads in the velocity grid + ! + !CALL gridder(grid) + ! + ! Read in all source coordinates. + ! + ! + ! Now work out, source by source, the first-arrival traveltime + ! field plus source-receiver traveltimes + ! and ray paths if required. First, allocate memory to the + ! traveltime field array + ! + ALLOCATE(ttn(nnz,nnx), STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with ALLOCATE: PROGRAM fmmin2d: REAL ttn' + ENDIF + rbint=0 + ! + ! Allocate memory for node status and binary trees + ! + ALLOCATE(nsts(nnz,nnx)) + maxbt=NINT(snb*nnx*nnz) + ALLOCATE(btg(maxbt)) + + !allocate(fdm(0:nvz+1,0:nvx+1)) + + if(kmaxRc.gt.0) then + iwave=2 + igr=0 + call caldespersion(nx,ny,nz,vels,pvRc, & + iwave,igr,kmaxRc,tRc,depz,minthk) + endif + + if(kmaxRg.gt.0) then + iwave=2 + igr=1 + call caldespersion(nx,ny,nz,vels,pvRg, & + iwave,igr,kmaxRg,tRg,depz,minthk) + endif + + if(kmaxLc.gt.0) then + iwave=1 + igr=0 + call caldespersion(nx,ny,nz,vels,pvLc, & + iwave,igr,kmaxLc,tLc,depz,minthk) + endif + + if(kmaxLg.gt.0) then + iwave=1 + igr=1 + call caldespersion(nx,ny,nz,vels,pvLg, & + iwave,igr,kmaxLg,tLg,depz,minthk) + endif + + !nar=0 + count1=0 + + !sen_vs=0 + !sen_vp=0 + !sen_rho=0 + kmax1=kmaxRc + kmax2=kmaxRc+kmaxRg + kmax3=kmaxRc+kmaxRg+kmaxLc + do knumi=1,kmax + do srcnum=1,nsrcsurf1(knumi) + if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==0) then + velf(1:nx*ny)=pvRc(1:nx*ny,periods(srcnum,knumi)) + ! sen_vs(:,1:kmax1,:)=sen_vsRc(:,1:kmaxRc,:)!(:,nt(istep),:) + ! sen_vp(:,1:kmax1,:)=sen_vpRc(:,1:kmaxRc,:)!(:,nt(istep),:) + ! sen_rho(:,1:kmax1,:)=sen_rhoRc(:,1:kmaxRc,:)!(:,nt(istep),:) + endif + if(wavetype(srcnum,knumi)==2.and.igrt(srcnum,knumi)==1) then + velf(1:nx*ny)=pvRg(1:nx*ny,periods(srcnum,knumi)) + ! sen_vs(:,kmax1+1:kmax2,:)=sen_vsRg(:,1:kmaxRg,:)!(:,nt,:) + ! sen_vp(:,kmax1+1:kmax2,:)=sen_vpRg(:,1:kmaxRg,:)!(:,nt,:) + ! sen_rho(:,kmax1+1:kmax2,:)=sen_rhoRg(:,1:kmaxRg,:)!(:,nt,:) + endif + if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==0) then + velf(1:nx*ny)=pvLc(1:nx*ny,periods(srcnum,knumi)) + ! sen_vs(:,kmax2+1:kmax3,:)=sen_vsLc(:,1:kmaxLc,:)!(:,nt,:) + ! sen_vp(:,kmax2+1:kmax3,:)=sen_vpLc(:,1:kmaxLc,:)!(:,nt,:) + ! sen_rho(:,kmax2+1:kmax3,:)=sen_rhoLc(:,1:kmaxLc,:)!(:,nt,:) + endif + if(wavetype(srcnum,knumi)==1.and.igrt(srcnum,knumi)==1) then + velf(1:nx*ny)=pvLg(1:nx*ny,periods(srcnum,knumi)) + ! sen_vs(:,kmax3+1:kmax,:)=sen_vsLg(:,1:kmaxLg,:)!(:,nt,:) + ! sen_vp(:,kmax3+1:kmax,:)=sen_vpLg(:,1:kmaxLg,:)!(:,nt,:) + ! sen_rho(:,kmax3+1:kmax,:)=sen_rhoLg(:,1:kmaxLg,:)!(:,nt,:) + endif + + call gridder(velf) + x=scxf(srcnum,knumi) + z=sczf(srcnum,knumi) + ! + ! Begin by computing refined source grid if required + ! + urg=0 + IF(asgr.EQ.1)THEN + ! + ! Back up coarse velocity grid to a holding matrix + ! + ALLOCATE(velnb(nnz,nnx)) + ! MODIFIEDY BY HONGJIAN FANG @ USTC 2014/04/17 + velnb(1:nnz,1:nnx)=veln(1:nnz,1:nnx) + nnxb=nnx + nnzb=nnz + dnxb=dnx + dnzb=dnz + goxb=gox + gozb=goz + ! + ! Identify nearest neighbouring node to source + ! + isx=INT((x-gox)/dnx)+1 + isz=INT((z-goz)/dnz)+1 + sw=0 + IF(isx.lt.1.or.isx.gt.nnx)sw=1 + IF(isz.lt.1.or.isz.gt.nnz)sw=1 + IF(sw.eq.1)then + x=90.0-x*180.0/pi + z=z*180.0/pi + WRITE(6,*)"Source lies outside bounds of model (lat,long)= ",x,z + WRITE(6,*)"TERMINATING PROGRAM!!!" + STOP + ENDIF + IF(isx.eq.nnx)isx=isx-1 + IF(isz.eq.nnz)isz=isz-1 + ! + ! Now find rectangular box that extends outward from the nearest source node + ! to "sgs" nodes away. + ! + vnl=isx-sgs + IF(vnl.lt.1)vnl=1 + vnr=isx+sgs + IF(vnr.gt.nnx)vnr=nnx + vnt=isz-sgs + IF(vnt.lt.1)vnt=1 + vnb=isz+sgs + IF(vnb.gt.nnz)vnb=nnz + nrnx=(vnr-vnl)*sgdl+1 + nrnz=(vnb-vnt)*sgdl+1 + drnx=dvx/REAL(gdx*sgdl) + drnz=dvz/REAL(gdz*sgdl) + gorx=gox+dnx*(vnl-1) + gorz=goz+dnz*(vnt-1) + nnx=nrnx + nnz=nrnz + dnx=drnx + dnz=drnz + gox=gorx + goz=gorz + ! + ! Reallocate velocity and traveltime arrays if nnx>nnxb or + ! nnz 0)THEN - WRITE(6,*)'Error with DEALLOCATE: PROGRAM fmmin2d: velnb' - ENDIF -ENDIF -enddo -enddo -!deallocate(fdm) -deallocate(velv,veln,ttn,nsts,btg) -END subroutine -subroutine caldespersion(nx,ny,nz,vel,pvRc, & - iwave,igr,kmaxRc,tRc,depz,minthk) - use omp_lib - implicit none - - integer nx,ny,nz - real vel(nx,ny,nz) + IF(rbint.EQ.1)THEN + WRITE(6,*)'Note that at least one two-point ray path' + WRITE(6,*)'tracked along the boundary of the model.' + WRITE(6,*)'This class of path is unlikely to be' + WRITE(6,*)'a true path, and it is STRONGLY RECOMMENDED' + WRITE(6,*)'that you adjust the dimensions of your grid' + WRITE(6,*)'to prevent this from occurring.' + ENDIF + IF(asgr.EQ.1)THEN + DEALLOCATE (velnb, STAT=checkstat) + IF(checkstat > 0)THEN + WRITE(6,*)'Error with DEALLOCATE: PROGRAM fmmin2d: velnb' + ENDIF + ENDIF + enddo + enddo + !deallocate(fdm) + deallocate(velv,veln,ttn,nsts,btg) + END subroutine + subroutine caldespersion(nx,ny,nz,vel,pvRc, & + iwave,igr,kmaxRc,tRc,depz,minthk) + use omp_lib + implicit none - integer iwave,igr - real minthk - real depz(nz) - integer kmaxRc - real*8 tRc(kmaxRc) - real*8 pvRc(nx*ny,kmaxRc) + integer nx,ny,nz + real vel(nx,ny,nz) + + integer iwave,igr + real minthk + real depz(nz) + integer kmaxRc + real*8 tRc(kmaxRc) + real*8 pvRc(nx*ny,kmaxRc) - real vpz(nz),vsz(nz),rhoz(nz) - integer mmax,iflsph,mode,rmax - integer ii,jj,k,i,nn,kk - integer,parameter::NL=200 - integer,parameter::NP=60 - real*8 cg1(NP),cg2(NP),cga,cgRc(NP) - real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) - real depm(NL),vpm(NL),vsm(NL),rhom(NL),thkm(NL) - real dlnVs,dlnVp,dlnrho + real vpz(nz),vsz(nz),rhoz(nz) + integer mmax,iflsph,mode,rmax + integer ii,jj,k,i,nn,kk + integer,parameter::NL=200 + integer,parameter::NP=60 + real*8 cg1(NP),cg2(NP),cga,cgRc(NP) + real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL) + real depm(NL),vpm(NL),vsm(NL),rhom(NL),thkm(NL) + real dlnVs,dlnVp,dlnrho - mmax=nz - iflsph=1 - mode=1 - dlnVs=0.01 - dlnVp=0.01 - dlnrho=0.01 + mmax=nz + iflsph=1 + mode=1 + dlnVs=0.01 + dlnVp=0.01 + dlnrho=0.01 -!$omp parallel & -!$omp default(private) & -!$omp shared(depz,nx,ny,nz,minthk,kmaxRc,mmax,vel) & -!$omp shared(tRc,pvRc,iflsph,iwave,mode,igr) -!$omp do - do jj=1,ny - do ii=1,nx - vsz(1:nz)=vel(ii,jj,1:nz) + !$omp parallel & + !$omp default(private) & + !$omp shared(depz,nx,ny,nz,minthk,kmaxRc,mmax,vel) & + !$omp shared(tRc,pvRc,iflsph,iwave,mode,igr) + !$omp do + do jj=1,ny + do ii=1,nx + vsz(1:nz)=vel(ii,jj,1:nz) ! some other emperical relationship maybe better, - do k=1,nz - vpz(k)=0.9409 + 2.0947*vsz(k) - 0.8206*vsz(k)**2+ & - 0.2683*vsz(k)**3 - 0.0251*vsz(k)**4 - rhoz(k)=1.6612*vpz(k) - 0.4721*vpz(k)**2 + & - 0.0671*vpz(k)**3 - 0.0043*vpz(k)**4 + & - 0.000106*vpz(k)**5 + do k=1,nz + vpz(k)=0.9409 + 2.0947*vsz(k) - 0.8206*vsz(k)**2+ & + 0.2683*vsz(k)**3 - 0.0251*vsz(k)**4 + rhoz(k)=1.6612*vpz(k) - 0.4721*vpz(k)**2 + & + 0.0671*vpz(k)**3 - 0.0043*vpz(k)**4 + & + 0.000106*vpz(k)**5 enddo - - call refineGrid2LayerMdl(minthk,mmax,depz,vpz,vsz,rhoz,rmax,rdep,& - rvp,rvs,rrho,rthk) - call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,igr,kmaxRc,& - tRc,cgRc) + + call refineGrid2LayerMdl(minthk,mmax,depz,vpz,vsz,rhoz,rmax,rdep,& + rvp,rvs,rrho,rthk) + call surfdisp96(rthk,rvp,rvs,rrho,rmax,iflsph,iwave,mode,igr,kmaxRc,& + tRc,cgRc) pvRc((jj-1)*nx+ii,1:kmaxRc)=cgRc(1:kmaxRc) - enddo - enddo -!$omp end do -!$omp end parallel - end subroutine + enddo + enddo + !$omp end do + !$omp end parallel + end subroutine diff --git a/src/DSurfTomo b/src/DSurfTomo index 7de6096f5ce334682582201b6561896a8c3aad3e..c798babb86ab53b882f639f735627c7086a454b8 100755 GIT binary patch delta 102269 zcmce^Q4>TG5jC(rSf8M%9UcNcAS#mk{hq3xM*#KSKW;usSDka} zyz11ux~J}wu8Utia#pnKB%decZ_<79{&3{5?jDa9;4v?z3vyWZ`#wMG$c5|D1=>#+ zShy~By7#Oj*J$vuEP=l@>tc5Syy-1P{gno9dMmcUdsg?RcNF;B35uHe^w{q7qhmwU z{N3vZ`$R-@w!$*sA(o$cTx?caPWM@*3OlBc!ZM#O*iC82&=L`qrI4OUvBT2O_G_pM z^dPTnQdAxAI4$MnJHn12%#XdCJ|JzzO|h-%7o_Fg9Q&j1Pu`nj_sYK? z;@?|iCuf{@Or_Q%M@jG?&%edJV)thBx*WMoA#n9i4)Rk#I5+I`EY9$F(f}qt zZ>G<4Kc3AG_&ggsc|3uv=_!huo~U=3Twm z*j==C-j5emg-)+^Vv{=LrY&5zY+i@)-V=x23rdvhkN@ePg~;=70RDILvtFED>^rW@ zvay{$_vQZM`E-wI7kz<;Q}-Ox1$&Wxi7v~p2j&f87Cg7?x+6?q?!12s^+$L(<}*Uw z3+V)P12LyQ6Z`N;^YFFD_&nbkStmYsjBnW~-Olr-PwC-{-Ijey+C@(oc}3cFuKNhd(r*J z=NL;8RD+#I7R63GzB=vbMX{HUzx;$(9|MD#Q~hJj=+^u_&Qi%v^ba=e?%^z7?93Ae zrQdXfFLuKTr=%Z`{DKpT(l;Bv*rz8Hray}3vAy~oHouDxUg>fZvLkxkns($rVyk++ zls5X&*qu2AX*rL^mgk(&b@##)F`qAtwdR=V^AGpM&gorn>~czl_PMCt$Oa=a@^lY4 zX8f~@FLrHxyW&%3u3$bbUUm<;hek$u_O9k za(vUH=^kj32i<2wn z-RVqAEw_~At`w@}{<&ZmFM72Gwk88ZZfPro0I>^hX7LuOuSo-t%O6e(aDn~;m#Ubwlf+EiScoxs>hz4@}6jZ+U(1YTkl~U6{?LYvm_n&;! z5D+JM=&{2g?85o6t|tx}I|pggyT<9J`F{N{bqM=6L0L0WUxBc1bVdMa&I}-IUC3ZS zN+Vk;GDFd?odJ^B!^~di1ky%!u;5Oo>-^Y1Pwai%H)J|}b>?9n&t+E>UtWAg@s-6_ zy#@tKABk-~v1fX(j=uZ*@8x}pkPZxi>K04w}?aq71;Sxz!pod)J61Lpwf7GvFJBNCmvND0Ox z@C=rZ@{Bij?)lE>I>;YOKk2F?K9n#h>WfHr=03D+(n({}(|e}*V*fq4U;1}m-?Dut zpWsd3;PJ(dA9zgq3m)IH!hxT7kA8oDI{K@wVShF{Ya_S87@6@JK(XQl*~^Mgy~Ufp zG0nH^#nXzq6wm!ZQ;xy7gDx)YAB%)BI>T}i0}%*{#k!rEHXvMI1J{>!E-NVd*_SqB zd+hY#=cV1Ub=lvBclD-~wJfVSry#9I!}fGfVMDaZDBZhvYqY7MwbysXrCpxd9{Z@| zwyqyeqv5JAL2pph5-UHqAbY_bbb6vQ*y*ggBevw+e%9j}kqGJ88j=XnHIHv-LOuDo6_SnetDvn>hH4#Qsbb>i^qdd&Mp^k4`K5Dt4VY;IO`5(Q{c{&fXGx#GI7&#Fw$I!K2g0wZu*i zmZc5<66BYreX%9>LGYBcA9__ zVFj0Z+r)Yrow4)F*dw74Y5(0!9hMzddVR*RFW#JRbV=k5BfOTp?2I!%j@4dNa@b#P zQ2oHz8)BbcbbHz-AH^=ccv8hK=l> zX8$#I{m6o}Oa2=B$H>2=eLFGMVbqYc=O@O_8FgA(cw($#)PT~+O~UFMaC9!a9_g9Y z{-wgJ;6tEfY(9p_vw#et$8az<=4^i^ID*XrnsCO!HCm-KIvmD2 zS)x(EpG#RoJPCbHP((LUo$c2qEK5*)uP6%0X6?1HvqoQ*mi|%f;nBwhwtmRqx-{U= zK`4d%e*7Eo4@5NKU*~8@6hIyT8Lzse*#a9RM1!1fuZ{gQ`i!*6*Tzm8(>v{=YhxFU z$xHk5yRqU_y$DVYK35=vw6a@qc6=)vmR9% ze?gnx`9G=N{Su@66bUoZW7l{0N=Psh6KZT;3 z$*5pAN$jG(vD7t!Y6(Tx=3B(w%0RV?#u66-PJ|FE1)(*N=MZ_C6#N!)1XY8!0#q(h z*+kg|e=8r`m4fRNLH5u@ z(dJz|oL)fA;$QK|Q5Tz4+sC4MyKH(Vw*T@II&UnO)`9Wv?ebXe6^|eGEda#7@NR75 z75Qm%-i;l80Q%*KE}53LfWPeqVk^OtlFy5E8M z^^pzJI-2FH%!W;AX4O>C7?B$=OktYwD%-AUl(agBLlyv>gXbCHdx$PasFPJLMC~E- zVV&48ktp+eER`~a0Sb*lJpnVg4S!BCM2E_u#0pV|bDGf1iT=F6%yItQl1N+72!5bu z`#_cDw}tFM50Ekx-9vDe^B@?AHm^_aR2tc1MD}9(i-JbY!$_D>r^?!7m<>*vxp!mL zru0BzYq4=&V{uhm2cxzMgLEL;TGi@pEFn{m5&jsUs@Al|65olE#}pj-^v06R5t7FY z0(oC!N#`3SkBJ5H8I2`bvn9`Qzp*6yC1hSQ4aN5P`-=NFG_<5uHF%4weoPD4**3^Lw_b1BBOky_=7v4__2Z3Ow~RM#Jmu>D zr2{hQQ~b04_y96SuVF~v_*zxH*Q{EV1@LP8{|P`%~q`f?0VZb%f7@L4ZMuV_>;G|@Pnzx+GQtJtwA(2 zrWF_NjgGWEQ#)4Gk041&v@r;(5%$oRx#TdTA%72NH#}g@L<-9>dViB)CA@DIHkih_ z4QADk8OA-i7;4RE)67wxfcJ9~l~5c#$_Rf3=*&?*1xhQ9Ug9&t4FbzluynvOjqqav z>#Sftz&ab@h`_R5K}eD(fLV}e8R3Tj2u9xsMSlwRZ!r6>3fi~tGaGi&DtPUuw2X?!1Iv2sW|F;!L-ly1`8Xf=2$aFMm#2b2$h0`dyAvlcTepcm>GKBQ{vrR z67Bo~CnR|$LND)2F=r6iWfy^%RBJS&`wrK=c z5uuux+qPhOMQ_s{WJxs15N$^Gm_}fiGvO*!65DSu`Z^0{N!vsslZ`T1)z((gD})x9 zIl|7CxMT5*b(b^U{k!oRceBFXPux<$6`jd+HPY7jQ;l9>2*X5e zG-jSNfrt+V)3;}KL2qg=@#kRMNfr`(+8Mpy=AgFI)C*abCbkS%fL78V{1FStttuHp z68{lOZrrLv(()tS2U+J2qFKh_Pynof3cy8vV3OoM{}wDu2qO0>iY2*Ysn?D>nUjU{ zzsu;7jA!5y#hgX|28`u$*J@QN9xTWRa+aYWN;v;k3~oqaFclQPQT`T`TfzM`y2~y| zg8@!d^SlC2Ohht{O<_9ix0&`LQw}+b>8I}_``fAcra z&_c1AdmJ7zqt*T~!g-0Gp@I?!8p~B?EKrPF3M@lf>qi)pR1fOPiqBOu~cxi_0-9nWN=#f@B%}W<@S&7;4ud&*zy+lqW?Lw}NSj7Pa9` zW!Uc#<#9g44n(q~wlV3JhuzwawUeP3%r;?Z$HxWg1N%AmAX!jLD+NEEL zW)B`*Gb`EdURuV-2*eaMR#V0l$_QwZO{pZrk0su(b@=cSspZG6PWH~619h+}0ZZ0l zz7(wXBd(KlfbXmQWfZVl@GJezF5ZmpH=`^4V}PXbi-70z&qCL|Z;AqQMSq( zPkRM=O2OIw5F8Cg!6>FYv;9qAuU)dnDbO>oL;=B^WXUIK^WLwi+el01+=q zx#fNwo>(r|oz8ZF&i1c{WeLH}$%5Yi35~OqU^7MVyx$gFtVIlr+lDb|w!c1E#&|8G zr;_m{rdSE%9{z0^pN^zcmizM{!wn**t1w&c_a_7Qfs%XV&T~?v``=PT&Hrst6I^B}ZT{&2>UD*NZgQOvQCQCR+)wENIX5K&ERirdMYB zePD`$I;xhYL4G`}z5oq1|EJJ)zad4&Bfly`M%7!ST*1j}Fk+toa`K95o>wTI$ENUH zh&f3-Ryo5%NybA`504(ujba|tX+Md$46xL?e??JeQUvzb*$>1kzK@pw=|!}^`@@)2 zf>t+`N0a3r*j7Z!LMd2q=j%yEy#N>`-m93Nm%{WPNsfZVp(yw(Hd*bAI-M+G1pAt} z5m#v-`5LT>Fn_^8 zF!4E(@A8S7`{^3|XR1owlT2T5f!PIEgR@)1e=`&DCF7zuSQ>kSMLRkCR|B|cE)i@CP4n< z;LPzW7wS;yGCZLXXZchb$)q&|bskPte*Tm2YQ|I%tU<)S|6fV0bh%2!B3|x2l%p>H zRpqT&DGV0>HiHLHFlm4RhN`@rO1-9;&QVN9rZB}UJyDZ( zMi2#9u@jUChS&k!nI%yuHF`E#BBnUcaU;l?sDUY++GwprH>E_gnh|QxJd>ovAq;!3 zG;Wy1rvGF;EZYVk1LIXZ;jXDEOrK3+3gk^F@LQH847-LL+xKa+70{B2Q`}rjD=|bV z(W+*1+OnldN*uznUqY~~2k2l44BLf$52u^v`89CReNhTe>)%OCf&Bm_+F5q+PED$; zmMmczC(&^mmTDlU&2iwv8aOu@cy~yzNiHC^JS?L#m!dU;5lHsX*P)xI4qXg3nPl6= zd7gxkdTN*jPDXeOI#;N@Ud;&2@+HDUJM4ud+YWS?tnsW>=VQy;l{_t2<#Q7F)^ z77u87O4@NK=&T!&?1S@MAH=3l>TO;5NUD`1ehYBm`RGL{Rlh2UDX`s9;&)ZOh^q!m zv~g{_8{a)7zBgl?lWgSOpiMP$uu|v;%)g+YHuAM3eE@1#^}~U6emXbR$Q3jayu?W0 zXyk<{My^g`N+VI?cNr<-s=@M5MwYfW6144%R0{o|W@_5VHA(s$Xr#pVHzhPA?B9p* zbUS+;--{7j&SBsivQVw-NQn3*A-ee56Va{1#z>05=HC`LO$+oK*q|yYa31jV@a0+_ z=`2osGlAtFg>PYFqLCWb@)+VI`GmnPdSGR`=ap`tcTN<8LZBR39LMye^5Hu9|`eE>RGUoa2ll8uDQ&Qid{NX4_bG{wlblbF)T=YOY> z!%@x|2$qL3(!efYijkmgXJoN55_2u+r;Yp_O|wSIh5d(Wnoj~RW8Fj&BH(e)?(N%q zS)VZ*kx*uXG{Q&VAPzSFtY$n6WwO+Yyqn~h1HCPgynUFM&q7IK9eE#etZTylY_eB2 zfkmoUssVvgqm)uwnfHEG8Hw*dqg+zecU_LEp9C1IKA?Dd&mWuY>i3hFLgM6Q5d6F2 zd;8hRw!872C-J=;d+*6ceg)c8Bj*A_Bh@ra8~H(!J_mYS0`AW!muw_db|wKPMk=1( z5h+G)OkzqSpZlFgin#4(9ooo;aF&r`Bxu_i2?&kk)GHp}A13K@ppg<*7f89~{w+yk zoiiCgT6v~o>fyvK!S$ox=K5n1wF&!&9XOzEM8rD1wSW(VE@PpZCh4mA_yGPBJe7a} z&BcVM{g4z~?ypP|;H(3XYTu=}o}a??lLNROz%)=4^Ip@1>D=1yA#I~ zN$1BQ$ds$&4X)a7?_X|hs5QX^&Wg}83fJgvbMJcYFjfM}$-skPfY$^TtTJBMVARYw z+!K3iT2E^*-4s#XCkT!3h?5i(+K-EJ6g?}6F9eo1k?mXnxlZG?k+oz{Ef+_$&?)3q zGpJ9p$bQV#n})f{G@ga4$aMm*h$UYOdx91!eR_~bxS(&6KIJRL!)COBdMzY}xV^G0 zS_}~GpS79g&Cu(E2(Ccj1ZbpxLaf<3rcYkQv1T3bN8ryg9}4bmH46i{e)dSc@j`tF zH)ir;hgarU6U@EMq5jRdox4Ef%z%|-YP_?R(4|87IxK3y)f-j{ zZn2r=1gwECSHWIDa-)tBY>d>0%IjlWEq^R)dX7~V+}m6VQ}zrq7OaWj>QcZz1y&6+ zUf2U`I=yW~_Vsw z6w^*0%ijcOl0wvH7QLnP!6Xv;+(HfF`utz2K0>YZDP9R?o}dxH8E>QW?V0gfnq-9U z>rLs^QUm!r@InVw3B@k1I^)WRT|!Lh!N3T21ugDDi|%oSjo?iF0tR-em{ONhuKRX8Vy98|C~rZocUa!Q78dZEv6bPR z;*vz+F-G`a7FMF$OT{f#L=x1igrC{IM1|HFv122>&;Fty9s`?zHo~>2D6K_F{vKC{ zK=fNz4d_tbUvH*MHLStT*R_Ui9mE0sw+j6*vd#x>s*)iCwQEr{=4u? zN&c4n9T;Tlk>+1xz~6(<5C=vK;Xv&|wlEJxV1JIjqn2@snqUFVvyc5Cp;BDoaRkZ% zoZR_`BzNDj+ZrG3a5VubGp5#}1jRjVzpR`zIwN(lW&CFB5vq0B=e2RWbu zloTAGD~Ca$aS$A`=ld%VC+?y;6#X<5y&QLdYk@TFYCm7Dbdm9kBR8Lsei^Xnw34vS z737DBP&Yoyaa|R+r^CX%O4W!Lm+aw5l;LgGOrSHae~LF9-}uhBTp>a;A$-oxv(kDR zzzzWxuK|SpANxFWjI-0aTUTcE6d3qy0Uwb-6_Kdc5TG0d$=Lp+F0TN1DTTI*7Tev@ zDsg4TYN18pT`oo?0HFY*X7SzF{s8@1;Gz#FJ}`lXzeevY9*N)B#__*fFfL)I9`OQePO zT4C0FscdmOFWJFMXsli5%UgNqi*~_6P-WcnFSZ{vO%i=)8Cl(@0TOK}Y~@5kRhy3} zHgqP85(j;{@XbUPb62t{5jJR`grPk*Nt@;yfS|1Qca{XuDuD*qLqXicm21BzZ5&>g4s$V^Y@eu73L8J`P0GyrY2 z+Rq!1ob7MShVRN7)GI=Ww@i>v{=bx^;Bf;n<OD*l1DE@mz?5kzJY>|2#?gd1SA3tm_I~>0_ zU4=Du@O`s=vvtB6Ws}`K5S{uze9=F^@7LQ9M(8by|O20hoYSjE18u?IGFQ z*u_XkWr#bl4Iooc03AHW4X27M&8f=2FzDD||R9wz25$+c>Zo6Fj#r34?Ikxy7 zqS_vDB3*kXTNbV1AJc+i8a|)G5;?>~+T0S2;^--{SMEPMc0}dz))dz>+<%~JHi4Y3 zksS!QXN?iL1Rr@|mv8}|YBOc>w3OY4#*^Z4xe&!G#?oN6URY9w2l-Aw1jU_$l^$Xi z5G&ytG!g*lmj<(Z7yW|ELJY{uIP+tG!$F8UEb+Dhq&O?HU^ms~A5EU35*UyKM4+1Y zGK&=+B|tuzL%!lIj1+gak}JC?lP|#&9#g~zw8!=R;&v|vGb4QA9Ws#6W(e4#O{VUV zdH@^%jG7!onaj#TF$loxmUkz3%@ST66fYKjnTo@g>>R*myYOv*i;SRyaSiWi6&tfx z4iDN;)>5EebFzQYRp%sY zVbn~QxikWSF#wg=k>P3%!{ zSjDoZ0^H%9R!S+vR)JC5C?E`lRXe=uh?r%v%&OP%M)0^9zHLY0VpLdNmR1)5SNnp6 z-&FK1E!=BV|Af%jAtx8{%OF1PNx2BPuNUF~9DA5mG}-i$Ip!Ui<`9@{M0#*`3skO` ziqXHs=9=DW$*SWulxk zwIIr^=nEiY##?aQT0+0c6hGM!4bDo4UoFXQ*rE%E(V>YR2BkZVKO4HUY`=b;1 z(rdi^Vt;}`>U<6`Bv{TWB+%_|K|8}9!B0IUrh1~M1;4p?@DIuD#3LzVYG-7On)N4g z*1{d6oYLqwCYW&kix6GnuLLQkgHUoIbw>a)DrEo$EDyyA!@!32$4z?xhiM?k3Kxds z1R<2_vpdTi(L@IY;`wSHXV9?5fw$H@>catGPhIyL?FyBM+=pbPf^SCDEf&bmZ zC-gj;K(@v~fCF4GP+nkx2|7PiGZ@1>td<5hE!#vpre*j_1712Wb2`GYM05D|OgoZj z+L$k|CTu-kAuXEgQH5!(Dm=k?6L@%t^?-doI^PIqj-);r8!_?2$EQ#y4AficS18AB zUq?VCI3mfePXg|fo(Q;J0HPH7_L27?-o68jU$C+ok;t#VunpUO5P}D-#AAwjaQ2kI zao|C2F?h9A_@^Mreg%&S3Nb@H=y?F=BF;#if@3@YSf}{TwbXNI$|F~mr+-1J_0kW` zTR-SBkdTr+V=mYfk0t<8ibsXmgCoTqlpH*zM`z`sD(0dHwlhxj&yobTTJUt98j?o0 z*OO@aY7fd_@>6ql?7x5SYnj|eafDs9e<39C^AKj?Pe$!me+7AAvr+vT5~0GiMr}VN zu;UfDZ=bAH$7CQ|jQlK>znppQl?j3yYYKvu@K_h65?uoi?!&hyyrDwt^T{zC5idcw ztgb`RiGF;Dtiqr5GW3#`S1(Uj(dDwO`q17V|D8TSg%Q$Nlh=z{{E89x>=%)9~i&@aC5|Lq~X; zL-2AwtFm_V^@x~8u=3y&fT6-)jM{8Kq|%<2O0zV7Ey&1iGDddk9TBClX{aQrgmJ2} z*to}wQ3y?u3XyNimB{CBXz92~9zTC78_{!^t8a;ZE{}h0mPc3h`05kMUAU{wBF)lo zk=@Yp>~0yd>M$Qnj1pB4@f$tC%RQ2Y9=l-Oz32)43m8Y9f8mMVWn2o+aDpdiN*S-9 zgmi_fx0!?onvL7>c(URh4-IzC5td1>ze5ftkU_mjN60#5TKWm{+^^n=>W>UJ^J?Z{ zRUt1&852FFXo|9HffH!Juv|65SG^2Bpi#7f)k|d%*?+fbXXn-BAZbQF`0mM;B2u6R zOtud~SsO^lCjPUB6>wLrm@z11z(2vIV$Y`10smk(F-#J6#wlv*3uf$t9YBA>^QRvT z&tqLjSECO;5<%`*CV+H(PdvG}4zb(8a;FtOZOK=`@h{f+j+PQW_OyI}iboiXRgX`0 zNiKbdJQi=4NA5OxJn@}8R4oLtzR3oe5n$*L?Q85E%BS~kXZZKuSkTT zEG>Q8bm}z=BKgPkT$S{kcSwanlF zc~{StHJpcn;fy5aV`BM>j!sh|jy<%9Si@sS^+{-aFz$oEJvQl|+5M7&Uc$QN6J8C4 z+{z@m6Jj?mI@;$pl=C`G`=^-4gN3pi=5 z0>lFZ(m7)Duf6}+w)odF4#7_30fn%Hl~QraA)3-<*>W-gm<#NJj8ODjetDz7k0lVk z_)>@2yYu0ZNFR(fWVZYHS z#2{Bs%-AWM%vSXTVC)m_#1lI=M&!eCnukpt@xlzWb%^SlBntMQ{oAr~DJus&z#OtZ zV|zMF%Q_NIOo?b>9i>p*1SS%@65Im{tA55(Dm*GPNHl5n4T>{=TZPBFLItcZvwa^Y5^cF$k*s2{;hVU4<} zP|3la)3=zKzJ;0Rj6)C>FD57urW`X|oFq8qAR~N0tgv-*C09$crT5sD*%-JBa}6pC zBvzx`?Vq-l7QRC$Uv7jsIN1>MAg;>^Q{f}bK}l&=HNZ?+LY)gcL;eXgnv01LCZe_b zN6@yB)AxyS?;|G@)ujYuqrUncLhS4Z!FIT^sXBJw6Gxpm%hjF(Cv-?Tj0=o~7wDM@x`jG3-|mRD^<{k_a(QRT6LQB>X5`B#?;HYqL-t zI8o4KdIb|Wp#dYU1-AR#Qh@NoFYXfTA%>luapN)aX<~QtNdzqde|-!l+uwSX#--VC zu@d|ji|SC6#5mw~AwVs0Q7WO8afTd$Gr*)3-G;l+k}f=g9ollyQm^*+IwLiZHpGEv z1IV@C&s|s|qfVw?t}*jy%pup4RN8qN<*XH5kW>rGTPXg&!fd(B{Ns||2auBP#}g}I z*+akq8o20{OnhzoZYIPc=Ig-~pE%fUsZgH)ZJh6~jQ6$T)J^b;g=pu-m((HwayrOF z^lfYmWWioE9Y|5c|AhS@+sQDw-M)rvPIMn1~EvqEIE!v2ExZLQjfbP_)_9Al;m%2OYGpwv( z0_tHdJYbA&f+h8;HB|feK@`qFv%0Jb;}Qlora@8?eH*Q3R~p=hzv3vjUf6L&n*cVE zz<(a&*+zh~731$gi~BkNR1na#ccVg2L5{0)Pyc4%(B+^bsb@q~B1tvCDN=74H9tTN zm_V7)Rgf}6OF@5~i(ZN)qfOqmFt2~J_Z{QeHQ+H&favl1H!A>_`q5T5m#IWhH4sk% zLkOf9C_wD zrWF2cRIflHSpL3g4}1U&pg!(`o8GO#C{CDh9R?uqrV-w6OACJ~jvi@LUxgyl*cjjD zOlzb+3k^UG5Ul_SP7=d0=B?NVxoNK4wox3G)JB<6{RVPiPY2?2oJYw$H3)~GK=dM? zQ9T`aGaYS3STfl835&(h1}(P4S8U&q9xAuK#249(ntb8BNJf66`e$sA!9K9bG^*Di zLzl3AN(;XnZVx<*TSPRjIC>-G+zA3g6lZh+6op~F>v@?_-sdWxPqMi3KVM94Uj(e^ zMV%o7IW%3?YiQ;o;qCoFJcfyjQEdUuxksu57||I_;;JCycEqLWI6KWdOwHC6fs(TvMSCGBxFG?fzoawWc z?LeM4T8yIE^bv|WQuNzl6oy8K?~?}6uLRL#8v{%ATx^Y3e@0w&C(&K_WGg;biffFy z(cL)kT~+lHE*V+-#$NqIgSb_$8p$*tp2eLU*+A+>3miQG&2AVpjYFRej7e+ zT(Imme91YRzJfNbJQVxxpDk}ZiD6$2dmJ^@K*0W)0|F4TkB@Gg5dn59{XM`AWP@eg zy>l3dln9`gb=8TttUz871K$pVh7&NeJZd70Jr`X!% zJ*`jaNbUVQ*D|&!4?2I|S$!Y0Xty8JpYcAKOI>Qnga@M`H&z}eB{br!4->6Xw}S@R zGGsx)GtVrjj-;I1fEYxRrwSQA5mC3@lXItb53#Mnrr(=DBVn+V?o>Kme3 z(p5pVReGmrfmIn$vFsO)@6n|C{}Oi4VgEXn!%dJ_^Owh--z-_csho2&IB_Xevd`6u zwS&k9!MiDJHo9yS7;CJJvD&Y?tIJ=)>nQL_eBNoV(}7yzh@Hk8=db5uQA{iEq>&Y6t#fwR4_PaSQj6VWR@T8Qa}G^-Ay&_iR!S^oc!%`kC?>$f&WZ~CHDiy#rb$Vd6Kmd zXq-bu3gJgMU;^4WuDYPl*>w>G0F(=m@xUth1khGeKY+_#lQGDvqhf*wlP3H&kQ`M= z#6Dq{aKLNH^2AY2?3ubh9!3#tGMhZHZ|nM6EGplv3GzzSDzmW32=~jUXr-KUBsIls zK?qT9A-SV#pk6#D!SD3ou!>wzLv?~&A~O;0DD>b41ZPh84+K;FIb4x6F{92NvFOu+ zc>9AB3)-~{1pIom7c0D`khdPh_fY4JfI|umB>4=Ii%{cDF0g^7g31|?@K+#x_ zO^-ISe=Cc#Q>K>U81HU2lYvvr=vo$L4;bXVw%xo?3;_FJmovNUP_!X76rW5S^}~dk-~6UHmd5r^CZQ}uwOK#3hGRD+;p5pI@s-YyU7X!QJO;Aj zOnhZrUGpq+8*W)fY{QBpt>=6yd=X|c;%$;d*K<3UM&Atfe~o9oq3C=W(SlXme0UEc z0s`11saj2!DZpF$M;i~y9ZkIE`k<_VR#jXUtopI@t)oKGdfAl0=j0P#lZTl> zeoY?xe&NyR@L0t@en?)F54g&!MAvhDMq~%BSFb=2d0I}A4sy1{T^$E=th@OUay_#G zE8lcsGty zC`G(9ikX(a{Q&@DxMeH0r@7v4BDJ0IMF;hRQW$nGB?K)`57#$h9mp()YY;wugUa%i zWAqaoy)(g2b+TiTqq2GgVH!z}AiQDaasKhMoGV|B=#UE(Qhhboio$AQQ>?Dm@jaao zuB*#DN%el1sv>T=*&#()%|=ZJ7G*od6GnrE3(H*S*$oCIdj8AhhLJW(YgdUPu69T| zovEC<`OWzz6{Z`d55;AkETeYw83b{Xf&QC)sZqT|gL133s+&|GQ2niGUxzC`Q*p(o zd(sUbT&k*S#0{VAyy5c|E>xkso&w0n8=HShYj?wEDj*a(Mc?pIO#%0gsvIv`fcPQO zg&iiEOBSyA;NL{`htP_I&Jtg{w|rVT$%!9CU6oYhZq>DO&SyWSc`h++Oz2PnxLL4? z{UoMZtPkFraPypeUWn`T`Sk#nfiE5l!K*FSGQW>C3!y@Qf>){s0~x@j;E2a8^;n$p z$Uz_hSEe2lQXbg0BThf^5|rEu9|qpsAEqd*)@RE$28S~QH2^E+nuqh}XW-)Lt2aT< zmJuKF-G#k49e2KKO~Wn%?qY{7#$p-kq`;7=SkFfKAzK>#5^T4F3wlsYGCcUL1ne0Q zU_|mhYHKTv{(vZ~khz$9;AfpduN^W9Wdd?LgswOqnxJ|x0kP2BoLaz;b;|Js)0`Bh zgMO9gaBy-?)I8-g-C#O^OowQu2A&xIwm@?)n6JjP%~jC|pWlbojNuTI)60nEM!&Br};t4o6bTQSy&3GY1JIAi>jw&a;SbqP3 zu}w;hBxl1 zMQu{0FspGP3Wd49f`IsY7o`$_$m-}O=u&K-3qAJpYhlm=s|&Cb{X~IQ6x2K7^#a)E za$4t#rLj^{p`fFJK#0#pk&V0@s31UPx+sHLhZBqY})~-7UrgyC5J6;*v0>GTPlMrNwr@--dxn z+C$_-va&O7-A`eb+Yw%p6kTph1B;}V=3McewA!xn)TG71b(?hh&DuKd+tQK@+o2t~^&s*=LE`5cQR+oOAnjCY=wLu28amjy zPBY3;e9AN*W}OQ(E=%D!526faozpcpYZBOfflh^fnB?@-MRHY#I*nu28K-e$6z+75W7aV>&QUyn0*roO*0Ba^WV1r9(nw~VER8EuOz+h= zW}WYM(qimHK>eK{rusR~rvi=d$M9AhMJ*(^RlvbTeC^dUttY*e#aq@W?>kJ9A@6bK zE3(W4Sr33g^*H{O7$McIifSMHshMRes`;9VS*J` z;@mj#>r^e>Q5NUDx8p{aY@~I;bQ>FKHzDtw|Bc{=y13n#umP7x+-VATkBfUx;r>Qk zH-)QqaWA#vmN5!e61jJWFul)3{#_M}5cd&r?N!82_jaF)t!`28Mn!ES?>wzIUGCy8 zR=7VAcb~%jLF24~GZoT9b6LCcf_o9pYLgAJW z*IVJ{xVT1zyNrnMCf`Cf48K;$jMSBXR2$Zm5g9P2uv1 zdtTx8XK8_#DcpC+I}a&by^A}0kBoms&l7p4Lf+*f`>KMs5qC9l*qNAumY*0X$D`fo zL8lUJNe?<0R4^%a@FFQE(+k;Wl;aWu+Zgr%GMRBC6ZWH&h26r{7)pP_oRIX~;c)sw zT>L#0yI}3rP@xboj@e!C#30Fz9s;?zg9Nqzz#Rvp=0_Q4a8;FhfN~c#z=Vi&(n$rQ zAK(idt@zByJ7(09AG_H|TI^cx-H6TGX8hXZ^8kQ)xx6=m-?=mGK$d*8E31y;LPlU0 zepOGsRt&9|0*314`_1Mq9B$(GEAfRV^$W?gYO!#0_jU1(0rElo#u0v|FM=dwSMX&h zObnUv;?3J#GR@HIM?yq!+B)9gT8}r%;#^wn@#RaHNHol3z12C5n1E-QGzaD1| zCSRmAn{eEU2fpR@EVeZDMvZ>Omb>DZgVNO%$J16iLHgf?NI08YQ~)r;YNH(47ca%R z2}}_A*hrE0&6+e(E1y784YkXH%qEQ_5jPxEUVSpebYIoM&h#wOS=`16VuRcsWFzk> zwR?7A&CNhse!(?=54Uz*%ctImUDy-2eq0EGVDzVA6%R0sx>!Z|8@3(K%~aq0vTo_@ zt~XSot8bQiW#ZduAM%73pTy_JD%erpwwG{s&TFP)o7GImwhKY`z!lt^bCZU%E;#mR$-ow)!u)`!VkR`7NXNcg)_tw4srZ4;hY-1%mOP){3K0?%dv zViA|+I+Y2Ae3M}07m{&_$i=ElaiH(vLKF(u*c1e)p7D1_dV+|`iwSv^M+F({4d zYmqB0{M@J>hQxR07+IYkhmF<#ypHI9w)??YhZaLd(!%w&%OLj^z)X9&{1&F(P}%7` z4|%Rbu3951Wk*>bB#WP`a zBa`U7NG*;6*g=@-*hO+X12#)gm_ktqic&0@(eu{>5Q@H48pXA#j8`$mOjvx2G%RIK zJIj^f@c-&BU}Zn}8^y3Zf0$N&NEq14S9jQ)%_#2f?qi(V7vZEOEAT+8#LHkeUYIaW z&Df37H?M`LdUP4EwvESGWMEW#6)A2VOUa>*Jj~FUV+NQ zJOS^nE%H}FPow%h@Pyix(1m{tWw{REp8PnX^i*YoqLY@RAZR%(IqfakwJJ7FZWIP! zI9oH6;^EZd=v6EQLiriQapcfPO-f+3TS6tU&7~43Fv~?zgy^CmKoK(SIq6EsmLtD( zMIwXEe6Cy8QiY*OT#@-MP9^XPprS^xg)WK-=TDy_)C$MxI}(ck;xVC7{VuADT|I+d zbRbHO2fyPDyoLMXJxXCS-f|wtLpeL6Gumn*aAzZA@J&XyDPj_E(D3y*hi^uto{Gv+ z(VI2~(c2p^WSt*2v8`r2r>2fz!0nv}lA45RTN!Pm6NhOa;cjy`u+!q$og(S(Haj!H z5~guT=2^=^KKbbzH9lj14)0{be2^sej{|G+El#666F=utd9pAZ(YqsQ9M!au;GL9Coc02-I~hP9+%jFxYAN zRCcW~>SO;EUK3fV+tw>lQaS+lHP(8U)jFkf*uUC^DAc9ce^(%gX>xJoBm3400@OMe zr4p`Amp~^*g}ZHSeK-mEv=&kw=h2*nEsR8>$2G z$JV`ov8`juZNjiQxe34aF?GpUB<14!-;W$vkj~NtIYn@uKtV`a;YS9>I2S|9R~5{O z;o0)`R*cDL+by_*iIaTjEyl_~DxQ44jiQTqBJT`fN!wZ^(UlV59Q;DjuOzA^^lkyE zFhR^^%o~Z?z_;)?sLH5(8_4yj9FkEPXRHVpj;MUzya6_>293v4$-DU~!=)HGSQb8s znH7>Tx!NDl<@mhyI3Z?IG$D&bagNO^v5s6yzDDE-AR&gD<5S&jEl0KDjs#`G4rwcH z#6Izn_|W-3Jj+lE1M@FpaA7VAY5-KfS%%YN^j$z;u1~o+HJ~4(ygnp9?*hxTe;>yEs=apI+7+7Cw;-n6*`I3GNeqgULmc+wY7;7X4Poo;s zVd<4|vk`--AQs|jRKJLS;cdQS57G7DAeCTt#D*#1bJQd%B(;M&H6?+uT0!9MG8d&1 zUGc_0*Pix>wnBUn{SMwvuroMeO*9^hDx@}^N=Qy_19w^fV;`|xRKnc6QwY^ZAHW=^ z^8jAQf$Wixtvf;l1#A@P7*``EoFBoceTZD{QjmeHx)cN~$7+L19?2j8&Fg}lGl1+a&Kgp)TleJ9~zymgA)?<*SQFHG5IW60A`a!

YJq3Et45LV%$D4y+-0ORf)y!wnjnX_9~@?5x@`wWZmRBIVxj7Wdhidsh1?3d`_ z5L*2%lNQGOg-n2tOnU9kv+_5fuaUI_z9m7NZt6xY-_d9A=o$DFS1pz3>g&3#(QVQd zIq_bj-fEeH<&)vMNhCVvbg~Y!CJdUsQE|VUs<|=|p z5-iXRxB&s~SKu5=M4wCKbdB^VFBj>d#XiM+~ z3ZF&%Q^2#=Vick13a}Krcyq?7A<{0eH{nsbJWhUJS4kP`r+TpaieMnitpB=zA_S(agY_7Z`XGmRDB5 zZU!FXs65hRk>($goPp~k=b0G_YQ^uUeEBZzPQIf;h}==xj4854A7VkM&Q zrq#%+OTds??c$LZJJ4i}R2Fb@n?>J$Vb^5TJPfCo*cJZ$FT)Fns+LOrqBdKgT9v$G z)Lspe#H!>cy7honN#%dxQCwPQI2g4CN`wj*>Fun|=&`wrHG#P5Wz0dRJa>8|T?}NK zUWeP7PJu;UsI1)^q_UpDoH0>ZXC+k@YV!YriFiYmF^X9ANJbjJ?P}QCAv`hA5P(xH&IE&!@E<`?OqKr2?V+rP#sLDK4a8YUqj6d&phJbWp^P1Dt zEC%~IYud#E9L0)P6Y6+W%y+#R4+;eV^+FdF4~j)DM4=EA3IgKAE=ncbS_wfRv`kv6 z-DD+}p`xG!2RoINWvGe>%o5|lvfLFA4;BT1q&gQxHnIv;5TI7ND3t)jl3;z|oz!Tt zcX2v^Z^?YcDwFq6iu&)y_;Z{Ps>2<2{W2oJB1Q!B>KsR(*`XgoXNU0tb=b1uZ8gDA zBeMEX#^GP93fduY|yAAR&zOBQw!g*BVDasvo`zrhr;-_moL)D#alq-BS z@mCXX7cBlVVN%5|$ajJYk(-3LoCWeVL#pp8bTQVPP^cI2T{WIIy9!k)fo+%$IJ@6c z2GK{ZLT@VkXT+~39v|uJktDd0h?jr}$}KQnYUI}krPEe}2eNsAA?k1mpCrd?bKHq$ zQ?Fwk0G*4Y9hu9?u!6hkl|W#Qt(2XBa8v&iU1H(jV_xC*?lCTr$zam;8k z8pX6Kh3R<*Dnl1&BhUmq&J6O*MT*;Jh>D%V!E^zEoVn{-T8RN)ZzLRUyME z#7}++#V@0bKWd&wD4uUxm`7^gpP$6B<@=4&0P8pnO-%G^cW^T3%zqP5Y}Mk5X+b}1 z^vnG4Yv7!_1fvdl-IyE)3dC$9@qZ!SE_ecKRVnnGMQEvl4&-*Q+7&9AM|gq2Gje6F z>wd*yfwWH*B8Y=-!&Hx)G>_^E<6)Bo4~Vtj$IvBSa71^(6(#QF2K>2rfmp5uVq*0F z@y)~CYoT@g&BMuXVq#Ic*ZD88>diwAB^o7f9@goCIe;6rZ8Qth1^3NEYboY6m>}pk z50|SP`ff>Ja8?lZw=PO00FfK1#bD3lfP=k`xH5%zy~{v>ITOi{b3L$H?c!9zW&Y(G zsK@9x+MK=4d&s-*C)!B2e?L*W0^E0$sj*v=k0#ZmuCGc}b(pJL9;vV)WbD46c+mF~ zJ8}!tF5)4e^GOra8O<`OqnNpv078ly8_=f!d390zt(Xd}KvL|0M#T;$rYxz0hfUR4 z0PZahKE?iPBIdew#7V#fzJUt$Yu9fB8-I&h+{~8|7N{z1FCTz|3)alhieKm+Ed#finWpMe-uH^Po!!eytcbmBdU|m|gTJ3dAWVx|H!<=7L_$ zqWT>|hV9m&h$*MUrBfp_^dBbr7d*)sid{4ynQ0G~Sm_92Zr(wcJ7Eck?@A`#_PVwz z6kVnC)Wl^Zw(O##ze>{g6_+}$hpF^J%kh{@8$L`luJ4-hDMCGopf z%ZZKpq7hg;1E6w(5>#Yu21F*QIj9EokC>B60zK1G^y<#D;D9|aPH~Ou`=OmZvJ*cu zk_9T<^x(x8yx1$>MN(VfQwPz|X3#fchZ7IawoQaEIuaZ2YM?J#VX=*cAmb%4@;p=; zZ9xyQ1cGlovg(g}e?(@v&LCNbq{s7M0LkyE8~#U<5B?#!NGDBODG1QQI7lfA(Be2~ zx!)QLxq!{5c>I~zQsD+S+Fmvu-0vnzHp1x-NmRHHDkPBAZh~b6A_?r8t44v-To=JT z2cZZsf%X>`UkZpK6A6^YV9Xb{2E%teEuvSQqmD;+P_?}hJA*Vmeey_jof!xw3>dJ4 zUFT114lp5U+EOlA&1J|zJ=T*R z9h!sZwySyYk%Oo(YG)$Py-fWbTc28*xclOn?n*_$uMGPY#6p~Pc5x~Z-x$BSt#D1n zD0grE&IcGpy6w(K*DCF!4z0||g1U(K)6T??#?u^U2mzp`W{CO|a9ktQ_mcYa1|Z9u z^WWexto29(Z{Lxv$I8S<$Rfw{Q~I!qplJd*9T0{MDu;h4sJGjAR%&-tZ?m}>Oum}Bf)Wr55uystf#j1NJ>-8PGtpWDF|5g0BTza#ZFgZd%CnL zfystSfHucPL5|W$L4YDewxq4XW_>S#oI~~^`4*L&))HXaOJw#VYWY+7C99R|qErGK z8j2XA2D&IFoH2C1opBlFjS{Zvi-75@CmpZAE-T=90m|~cKvtZHTKH>{4qhbN?GS-A zED9L#j(x+5P7Gg6wX-9No2eo`BL@DM~Qao zWP;rx)Oq$*h{HvCEpFc+hv%T@-r9=4?N8p>WX2)`M$ko z5IfAJAOkrO8fHlfxPXgO30KKHuwngde_871iKgW6$V{yt?->Ww511Y#Jca}6%m&95 zKDK{Zp6+#45ReGZ6{o`;^8lmx8M5snkfjA+^*iEHxZ31e)cqr#!p+Bc~=s+CT8FxHJV5(hrQZkQ*yZ zIJNENBX-JM3NnyLQxKp=x+qD=byG3z&Ht#Xz6VeA1Od!(6TUW5eeGqlK!3@T8r?5q zkNO~y23dFk1{{+<0r_?w%rBu7j5!vk6f(x6Gsu|A2*%jw5plR+=*QaMy~=POFBsxz z0X%tR%BNgqSjrl6uQD*h(=M{zHW)lZcX6D;=Wlf}KJ`roCb3@&pRg2YRYJz4LUkMB z&R0_6!EKd~u29;?l}}On-mJLN0Z|&~RuClun82+_wiUS*X)RaUV}YfWJ`HsE-m2&| z&Mn3SjV86e5y_;es!wyLHHrX&532JwFRA){5>M3cHJJ0Fe%%jicTKHeKYp0=cUACk z_}RG#ER!mDH$vH&KryJ`xQn1&#v_cI&(P`m0ZCS zbum751v4prWFhg6l;%;m>on`&6}-Bxo%ShOS0tj+t>8%_3K7HvD)>JLa;e~zO8JA= zZ$$_6f1+506vK`>$aMuXnG%btf(bro1$Twcs8Q#w7Y}i^m}+7cXe4j|MVoMquR)Fr%kiBbY{I!WZ8J;w zRo%bgMmmoG841Di@6e^Q%Cnb-qRo*ve0Y1{h}cKpA7{m1lb(%pWL}TwhJ{hP203mR z$*EB7T;yAQY*`lJw|3x# zRA3S!X1V2OZUnuI{Wqsc6H+bNJx(Ir zpf+QskZz%-qjv2Xe#^ntE;@sBQ$Pp&f!dv@v^#=C7caMx)x#cFlGNvwt#9B2))|nZ z9k$z&=n9l}VbZ0iXqU=wl+x~O(tWgy+I{|#e0wN`+YBZ3SW>+JszW)ihoXBAr=U)a zraPEVHp#eNG>dfOMQVyq_}&-lwVUF0J*kR+Me1Y9hJK_wM$@SpOZ7=#ZZg?Le`h@H zeopTnwXd#ea2)G@3aQqCN_GK-idIYf*#*6o0oTAG@g1;7l8ED5Qw4ug$`vJ3P6lPd zg{c+t0XS3sE?QHn38h)^rcP1~kA6$6d5Ux=YC7fXRED>4eqa}kC*3dq)-{ago5Ji# zWlu4QHvT&){@S;-KPtj~^v+UnqZtSD^$IxyDteK0Ge9R^#LvB|4L9w@Ph|Knx&u<< zUc3y%mP?&*T?tKHB`oKI zrCMdtK<$=dVy*%xh40fYWn2l(cZD1<6(#d^DnU$-HA^o>XV?Yz$}T`rBOcCJg~xY4 zNMILy03eBqo+S1hUAm5gmfqm}JEl&+pNxmomw3Bi1JZHF6=h;q)aj&4R{D4dN6yYqm?bF5X) zu?uKHg=Wj5a!_F4A%Hr%2PW56V>h@ z@;HrLoaE>3s*7d+?)>}=WTGAxs=|K(ObQne`ROw{{&^JP`gw*b-9&;{bm^t4^m}gU zr-*!1Bb$;6|EvlR#ioHXUE}LjVG}SB-HXU^Kw<~ZS_+rRSA5Etn3j+0OifXB@Zktw zb@zSw|HIgu$JccH|Knz^YYEql<%%r?2?>JWmXu3EkPvI5s4W^4weM@MCBf~@6>1qR zYNz(Ku3bcleQWL1*49bw`_A|InmH$;pZDYU_~nnxndkHMdd+LrGc#w-x%99D&t48e zwSrQWn$DB>>6<0GLICv%{ghvINJ3#KDZE;%mx1atr(jDuvLu}j4qVY$sg1Mo20MmS z_Y&!`PsR1ehW0fv%XBr>!5z(k8MpD5xHD@>Ixjn_UaJqbN~g+@es{^!^C{Thi=9j9 zQURo{HPuyR0pRQ)T9PE6QCq7F(s*)KLd`v~7NqUp)v~-k+5V+61xwq%?Qp4?pq#O3 z!N(_OcyO*BUgb~)+!hZCwPS0jys|twE3I}~{fS&J$xol0jaO~`9px)U=YK(ZhVhlC zaa6{AYBl{0eeihiTa65-mB0xSXaNDVf)>N%?-H4Y!#0<-HZPtcblik=flwmgp8 zC9wlsg7QbYkbVq*jYr@Wu(_?hSq&V$;6j$BD(4q?5JOXA?J@~?>}4RViW(NQg9M^XQf%Xd~u3iYqlTGP_Y<2ZysJEb^-s;Q`HME&|HHHNCi<9JMo{q!l-RZ%;L zauS8yQI|Ew&)hO6PRE~^HE3NRp!ydbn)cZ3Dw}Djj4K-@aX`JtMXASvXMdmD&)Zc6~~fRr%{e`C9}E^-p7LwxJc! z;b><=9?1UpK0b(TFacm_qd>lzk&IsrqMybg(QI^>I~Ah3fQiM%jU>vXpv}z)2+_ zH-(H@!K1^HuSEQM;^|NzPQDhw0+xP+Hdi!Wr49CseIJF@SkgTF23ZUaK*i$dX*Nhi znK}kmHNJs01(~)cwRb`W+ajIh%-DF2RYs2EpA2NZM@d{^>5X~{ zzzCp?kRIdghg_%AntTut3O`4P#al-do;t5$ol50`D~QlFd24Oh#cJj?wrVM3#0*>f=L=-TwcdTRKkPPxF<$ zLV8MTeEG#YDkf)q#s^9-b8&teF*?9Wd9bD|Ar7N;KvPdtkg<=8LczJ*aj<6mD6Tb$ zz5+z`k+lk(*2JaKnmQc%-CSxjs!gf;g1(p>eh5{by8L4^moFyJrig5-i&fjD)+yuX z@C#5V72;)Mp8)=2Ys9P_b+&<~3K)O=$#f5xCILDA>9=rA4Fd1zme`1R`dvoU<^WvB z;^!ZVcp83CKjk|FtMmV!pUWj*37yPXCm+5#A$!;ekDT}ppDNq}91W^N7T2<6s|W$ZEs*1o;Qz1P!7}hsYoyYrmV|d((VB5a z>vN>y8TuY;5j^TfPrcI`-~Pq#p&)Keo&bL_=Sd$&}*G0v#?5rNMh`eUjgf}YUZD(ecm`@QuQ?|!e zUx%-sz_)hG`Dpm*L5g25EcWDp`Op2l*>kdLj8C$OTDe#QwqA_M#WWsKNc70fn(~5$ z#OB=WHeX!OJI{x$X1r5=5tEnw!L9kdr7WzRnRm(KZCrrW%Fmm<_Kq*h<}lV+6boWC zSOL)@2p*jgDM73ebBl99tR1T+s+42ZoR^mvcT)5*hYe+>@i8b>k39_6+YcG#{RVQH zHrfzYx80usLaPO79V3p!jT!YLMOGtnJxKY*<}aeh-@Sm^Le4og9&x=KE5g@2_r5O2 z=5j8cdPNA^o|E6b>unvz+A{v;U$MFxbFe^>QH>4ar~mbKs?JKW0udQ>$h&f%!1!VL zV9Z`5!#lMGTf_LE+oH~Atge02ZH`p1O&5*!2?=$fP3}W_!G!`PM{O5e$3S2FH^2Bt ztpAKvD6#(^QpGd!UnC71832WMCqC=fd~8}Ce>smeO~@e8orK)e~WcB zS##D+ysOCqoc(9W^4WkuYu5YIvb*(zO0ERcP};X#Hs)9I`LCA*s*>H@uDOuvpF`uX$(HWjXRWUv-e~uX4ij z$u_ulJn#fr?iQ<)>+6O7JB9SAA#2zM6%G7pb zd6|&nEA_$c;Z8DMJ|a;-t4`bLKG@ zpMr@AO7#$m+?*XZc0)3##S!ndFPN8=JBXVNHj#tYVKR%o>nQrvtFQVWx=wNas}6a0 zwPDjZD<+z?V_&d?Vo^Ibj#vCulx@!@@ut6t)$LgT5BW_TZ_iG!6fy5BwvKN~6R{oG zOFrU`Xw;E?#Y@}~i#xK~+`Ug+>xgRk!uz%(Gcjjqe_34p5NO{<=@q`?uu)*k6@8oN z*#ApUR`f%nL;o*5rJpn&PINxdC~h;Lk7Zh~6r$SG29oMPROW~fM9d}c{LZW&<2QB- zOFa9QKiw@x#j`Pd*lzF3c=X>I7EH-eWT9pi+V9a412?!Hk=F0-gK#|DDFqS}uj3X< zMSW|hcjDKqg2`t;${f{YYq8Di?as>Zg4HptMpdcZ>BrX2<_cTAcfY~d$p79f!h5qg zE;f5pdeb24UhLifEj!Kllnr8bU-l1QxZe9+KUN&fI`7>6j5EG>tynOCwc!Wi#q$BI zO3?T)+^*^VqRxgFS%vHgV07U8TZFiy4vZH~20}EHL~CV=KE>QwYoLqzDN+A;@iRoL zU91XG`XL%+^#X}L07h2#BZSq%U1StfhlhBg5H1D`Wo3erNG~W;ZyxE*)%E%-y`f!1 zqe1W{j6^GDiVh&r#=2;6C0e?R_=!ZXR)HuT)K=a!CebIr$eVP8@aA}DaUY`9TqIg4 zQ#2QeF3?2>E76hYtkBdQcPPj0q*p#u@2_8=*HqUlrSyV2i`j$W&5gDmv zd2hWtC`1r>u@g zD#!m0g`O=_uL|kC0Y=`OL7k_mS=SgEBqFFSG zk;Yb0d>E_J?PsF!I7?6WPs}m3K~j55;N7ea_R>KuD;TGP7qWu&0Fv7|C26*F5bKaq zi^G_7W^tk&rF0Egv}cQ43L2btQwM!<_s;~6105|xG{XH5|`WH2P%#9UJA zDh3Q^h4OdPH3F1Ixv#`5XawD?0F5%486Hm>FM*NqV+c`sXWEO5;jB0xv`pj}ff?Bl zQGEoP5MCWDetx7(~5x~fgSS8xJo#+KomQVaRlC@#4#eC;ok}#_l#R*U*w!+oJqWZVMAo6UfiGgH+x7`X zFCaP*G_t-E*HTK($Q^BH>$JC`!iX|%`Hr%bU`xfEBs(8>ymP^0Y}-{=WEt`wBqfc4 zxC2>`g+VG~YEGI=COi%YmC5VCEF5j!3{YeYk$-}uBMPZ7mw8vSzmJvbFHjiTE|T!r zC!$V1y8DiF7c1r>G31WS<1J#QD8`9vxonb*OwZX*QP1GRM{`w3DGtoE%)iLCkzYo( ziHvK5xw70}aGS>;M-xh@OPdT4G2!X>u?yNkahnGMN1X6zYYMgw2&^N8YZBNpCj21I zV@up=t|X=LmCC5VcGi?USad=9!7+|CEZzeh6Br!p4xM(C8Y@0)8S4(}i0f##Er|k` zREviKoyl%yU4J&#ZK*B=LgPrs?cZI>(XI~tkWdtU2F-2WN5br8Gxj)I?)EnbOvvFON z#l4oSdmP_M#n;-yQZm|~Q2efxD-FeAlz^n{nI%B(d}yIcfGAlX9!CwSsOF9IjB()JaR#(Khka9c)&X=k)?6IeXnRg znT3>0gJ7(uj&BQ3jcqa3y*cRD&XV_G&Kd1?tV!2B(h2|5 zn(~>92X!Ofm4=a`8ZmB5*);E+$?R+9e9;sPK9bZ7h3&7_XK@7Sogx(jt7axVYiC>B zL@GTYQY)g!%(ib+Lfk=^1!SdS9cM!kr@2Eiw0?lItiVpP&Yumc{;u!JW;oU zPl2f?B&Ag%O^EzPC-F9*B4@@(_dE30E~x$m!d&l)5)G74`(5V5}8J%#~z7vWPXcKN^6}8o!6L5 zrNyGdp-V{-?FU7*C&%dbguwibYi*RCO7zDUZtNt3CvQY|&}sa_iv1lDh9VwOVUy4C zg6KLr?F+hJG`-TT*YqV~OBuF}f$WOP`)(pRkskYaK$%H9MiZkImdttNBG&avx>}p? zQwkq0@kbIbOZYa0`!$y7>)G}JgRyizacFGq3>PLel9}5~isN)L-XPB^ayF3(I@!~x zxNKCa9>+)`8|mZ#gRCe?r=ugWAv#O#^iF1>)q-+&qJ4B4Hxx%40HfBmh9K|Rl*92L zYi1#9!!_-cPNGTJ2a&IOY3C!en{AYTVbNY=9KO%7@!+BtU1Cxk0X}YMM~=eQr8o6 z)F9lYYf%+7MN%?T#fa%o41JVY_2i$GvGdgF;w1ITs4uD#q_c~taG8$Nex0)Ef(UMO zjwQ10wUUyvw~>^(dAdj^2jTFXd^iMK(ue-U+%1Uv)U^N30o~?7+i>p2)00IftDQJ{7`^DFvdKK_0`sEsoA3vB$W%)~74z zSB=59(Q)Hxjd%~2PpsS4Q!?_NW{F}uypL1ZEaseFAMzf@mnb~#mM>k~i(#8e7GxxW zClt6Fa>gAXgz&9|(}Y)5vTi3IQFDpXYvoyl6qELf68W99=a?m{@)3Rjh~_i#kit-t zpetf3q@Iih$Q?6BZc=QdlK}>~Q@MT@mb4I^q#0(xNZtQc#9)V9I@1!&Mwtw2#}@feN1gL zkwtV8g{h`~XHhQ5Uq2$>%y_ir7EF(i{lmt=-os&6;2!tnDLJOi&O- z;mLf|fQ+_MoS4BvzH0U>b&%uu;Bh&c5m_4Q@sx|$qKZwZ2dDs`SbU)!Ppgwx0|k^* zO5qbq*0PYIPx{-AZ9xLo_2#D(n#>2bh*mRM5ckhEIWTyXTtGtw7C@NW94-Q%Qf7=lNDgJhIO9=Ex)PQ6sr4Q6w-d=! zTp+zt5ZZf+H~B|akn;l*yo=_tbG*p-i71aKY$9(MBMT<#7kq~iU(XWLS2CM->Cdc% znGYQ0eYS+1G(}BWtSUU^Hr|RsRko9HRPA0BZ>h&q1mdb{ZGfn19Tb|(`4)R~{lcp7 zLc53S>2A|6LT?WcO;@o>{N7;i$W?5viM1BCb!?V1EfAU>$E}KJc&Seq(xvYu>G$PM ziabc<5}m|ERShXG%Sz3aL{8F4-1rpvts;|&?4^_VB$y(bE3=J3w%1}mCaTyBrCNbh ztNb_7L`7PNEb!k%UzCv^J*)uonV7Ji4RP*K@>Y@`@)+5}D`N!VSB8<%U^$vrAo;e6 zd`~7686Zguk)IO@`OLhh=qZJO^w-JEymLkV4iZ0J4i@JEs10S@$B!S=_YA7Si*hIf zBw!pF@HqM+A*{-^laClWloHwwSEUy%b#fC()K+d}C)#x)i@pmhR{I%wHjB&dCC<8l zCW4B~tCO>J^K`$d1(M4DqX)OkBatD7h~dGa09kZLh-{n1xJwx~S_;nn>4{X!B2>cg zprTIN4D;~78-Tm=Cm!U0l=kGlDg$aDU~&3Md5}RKoC9f;L9YLL@Bk821{<>o&4n^q zah%b~nTB~-c7CSVk7cly5*cKO7#=LZW(-VBBeG2vHH%O&!vm(1 z1r77`U9DeX`jaxaQVxkcy7!+lD5*TyOXMFqNt5wm|5YDK5}OPOBLmk;$_%t4au!Iv z2%YxyOnp5EpFxDmaKJ|?M;Tzo6r?#6h;OMUK~3o~tbdY+M?pxZvXs!Levs-7s2= zn7ukf$*nA|JCco7d4KUjOxvX^XJ*{F2(Cio3?;olXESqN zN0Gl0IYFAX-zY|=@ykzmwGbJRy?Yk%Un{=V|KNubUmrZWI+emUe3<$}Mv3bW57Jwj2DL_HVdx8d2;GzASL=v>Ap(q=_{Nz_hIRL;~%IsyNr zlhh!I9}NkkryeBd@%bJi$4K(idRR{8zs8;xWvHVR$a1HOREb|AvflsD?xpx@WWCgX zm9s0-MkG#@Q9kD>Z=R98n>eqZrBw1ON+y*KO5V1R&tAYk$!7#9FCz($y^b0^WR<0& zUuqtOU%|Cr+>T!eA1d*J_P8v>G$J~QVmp|BElUcDf%d^QJg&xM*sRA>_EVg85G-e= zV!rHp9vyzdnmkKMrB4<8cd(Mx)`OzOI}Y@kN8>um(;XitwDcsHJ;Yo+`*^voDTJ0n zv;FK%V`H5W`2c$yk=Vo4>Ry$tFw{btxZ@lK5ex!bB4rgdK~b`S<|CCngwr0I+=#ZX zA|5YQ6bAM1inP`Okd*(9*R5rg&lQQhppyaE_);G1RvzRdcBjtL zExeOq^l2e5i*$x=;lJn6b99NA$;42Ol(~K&kqJRmA0sgU>i`(JY68yR<0CWBlBl)f$RSq3?}zU&YT2gXKOU?n29Cq{;5LVSC*B=mPL?Xh9>&3wjki@8c-TFJl-!Z{cgn+fMv@7zdk!TX}tsup#CGi-%)?cUxv4zyVda zdHHZL?IbJg`~koYjA?kx`rvRB?$Tp$&JV+EEw?#=WYt&9-R9;hG82;63hFt65>vmV zh-gAWM5@u*-DcYe5ps$Z@0}g^i;E!gf^eJP4U?%a zBq_J~mTse+ieAy9@hZAjkM>m2<$830iuTu|MO3us2(j)Io5^1f7g48KJwAPyH|aDR znv+!!Z!WMhHF6%2Rd*pfxryQN6{>CtA{ZX)9+p%y#PF<6_A?i*wQ{1>MOMW51Ro~V zr)0iJOY+tn;GZ6ndhY+hKQM#;gLuqLPf-b>@Y~Teq8-}LE152>P8Sk|*SIOUWl}sj zkaBN4&$|7dwIYFqWG_hg!oJMlQdk(o}D%yj4$2(kQ>PF)dxiLJ4A zQ6#qQO#ml~r_%f?t>7w9; zq=wVYmsv<$*Ke^?`tpM{S=Ep&rVrw&tYH|o6CKeY<)=E__M*V4cxboMF0V1sz+|B` zu5tgZfFRP-pXM;-`-t*ausS*Pt!Q+G{mRGo7VoaG*rHDkAmd4?)cjK6sx|R2j$5aj zTlN-TUuB<{-%wRf2ZB-~^t=59DnL)($u!d#?vSLddX#tnRW^n5kZ(k@>nxTn5kFmL zVf^nN;`ntIS+Q=Yt~?I=vaueTMERO6pDWAZFw)eMJrI~}cZ4_m1{=?vqY{u`jmdX` zvLQw5)Im6C;5PRFPTi8elC_OW*6rV=8)elJkAV6qz9|pfZ5{(jMC4k}Z7u_r%BdF0 zsib}#f$M)EMOmlDNqtI2_sO3H)BDCN3E{Yo{+V!`G?Myi7=n(bM`bf{o44!HY48H< zCOtYwMMvw=sw%x9dbAdzc#WwBJ~c0YT-V3g<{s0{oAwubVs7ZAO-qmCv9WwPFJQb05q5l~KqVWq>RVihU{aG0FV-*&5Pb-P5D0k4UuY|aZ^Mbve ziuAj9Q1{zcoLT@5Nc^g_?MnL;X{Repn~N~x8@%sC(-%xa)V=WRLz(%hC?%}{B$~Od zHgmm^2N{$=pxTz~O9EveAYU+UMo**;8;iWgF-oQh$$Z#CMHfqZlt-wm+lMGJl*pSp z8DWqM6zNOk0fD`jAnQ&h`=3of+j;-7mg*snP)t7+XD7Z@+edqlPtLHAkNul+UDK+fcdcEgEvuYdmx|PXgxkgg0=SE zzaFy9ETGc{)M?VaA=vGCfG;nQLA>~eHa!G85b0V!;eE_XvsiKQF&oKORrba`VTH2i z`-3u!cZ85Njj#3&d%=8JbUA>Trzaiph-p_>lAL`hG1LI1hkp{YUonrhtU7VTtn{9E z$?T@wFP1Z$b^1+v=FR(-r7~V4P@H(jn((`2y~WQ1i=Rm#s z(fq*ur#0O?EPX9YrQ>`#QKp%ybZgDkb^D(Lc|~!0nk9@hs}q;1INjF^Mw%~9fLofy zroOPb_LEF=8_`LMmhNH?zB~Mo{*EEC7f87-Kta5`Br~)W{z`$txWI44NQX%~)^&++ zJLLq0-;FX9l0`q4%G5j~fp1A57X)J6Npr}yD@}|k#eJNW_e%p#1lnH{B!3FJ#(?CW zRZDqt5IILeRw~$Ckb{p8A(!Q2Tw7F6y+=j#laip~Gdw-3T47;Stu{K7ZU z>M>eJ#Zw6zbbpmm>OGo+XxC$vwtmdrJ{v_Si^`wMvY6-;z>7Ld;u>DRK>cY?$4jp- zP{|m|vJ78=h0qxiItd{ZQFN9f@Ys7QfsG`vPFbOxWy$-Os&uYV(#guiA($xk$yDj4 za%Lw9^%U09ytuOoO^!W|xzu+el-@6@c8m(Z6ImrQoMcL<)U(01QLZag$D-wc_HLZ? zexWpxWs+u6l^jQvd=WCJJYO>5)LYR!TAa`uX-GRgWeKOwxw9Fe-ES-h3`>KjxL@l%~v4?O2FsgmEs`f-8ODoIN zUk$pWkd~<*X&f}Fj#{NmKzb=F__?aTDpY@RU&`&#q>+NE>3P)%mP+pL_U# zuzwZlI-nI056beMeC0dQJ`lIN9PhRU@kmxP{S6YHn98xJ@ZXDTT3qa;5Vu(KRs}dV zsnEVog`un7ct@1uZyDe4$~!EWpXY3mXkL+5w{HGTZ@Xz!$+yL{ioBTf@g5x(;mZkkdxG&{0ML_m>pC{#zE|87a9P^w1SE#qXh0G@A(5pU$BCcQI>iUGm|f-Fl9+mffvyt3&+8hT%BU+W=$N{h~}GH@TPhw z|Dy7pA(>o+HPO?MxTa92Kgi&mG@;oi``ZE7d+c7Q6P+e!%m7(Vf>do<*;QZ zf1&C+6RC4~A#Y?g-i@(ez00ffAXcD#Klq0e84+3wT&0`O77$l!@X0ub_D1Y6a$l4K9Vjd$ zPS|zUH0Q65FCi7SAk=C+xT$%ON<;b*MLV`>s)SqmtZ9ty=F9-XjD?R>c{LrIhl>IF(U zb6*n|M;i0M63s#2mDO>`1O4GmhC*b*Z8k%~Cz{{0-1|j#@4Bne?FNhNF?ok!!mZ$P*`^1S@ewUwnC3ZFAt@!9y!rGj_;vG*4pBB73Pdeir z*n+z`FO=qe--@T0_{nV|r466P9oxL6zvOX@-`*;Qx8>J(j;-Ey?RW&^zisjU)Sj4r zo5jPg@L|q5o4f}*@a(yHqxIfn-S`p{U$ojguqQ9g_)k~G%w9Z#x4SCN_2Pqh!KI>U zZ~ikMyhPmTjjq__iom{CXMXdt_~l!^n&)0D+VtV;c>6`d+?ThB=#9q{)Z_JDw2^i$ z+~$t-(1Lo=B#P^$iV6q>9vgn%n*0TD^sW+D#7}*BaKYD?A@6#KQanUgZp-$|;%s03 zh~K;*4)x<2TO~I3=Ry47d2yjXAH(yW7hewG(cA~q=mER}|NfjfHh?$blg^1E19_9W z|6=uIotKIa({9D%^|z>}+LjZ9d1zybHeWPZcjoOEkzB&_SbEQG54s9k#JY=O;Xq!v zz%WoT^hh&7b|G`Wi{j8gUcPuU;8_{~a$As$xGmW)dVL1*43?{QUmAD3zl%46dENSb zD`RRvTQ9Vz#v@m1788Nd;<+utXgqt10G%zP(2fruGT$-6vVLbDxiR#+7(Im7^}iST ziJjzCuw&BgoEPUH!i)70g@^LMYJEr)O&(=RN#-Qc3Bc&B+8V&+o2axYFp@xok)qE~ z-ibH(SsWdT;;gw$ycmkRh3_&^Y#6V{&-NA_hVf$DyHpGx#%u7gOU2q@ykzyu6_rie zN6WOCtC9liWCfp)BobOL-Vft}me!+4#<70_9K*eII8U`c8>!!;Yhc2njTG;PbFW_& zfcid2fV{aE#{5HDEsl-g#n?D;djzkF1#^*+X!ZF-`;oko^V(R_P{(s`4TtdcV0~t_ zgKkms{#$#5O#KR+(DwabdJWXz+$^FOgGLD+mVV$}yGtM{Aqi~3PgYb9Q2M0PQD7{& z*IyB{4IS(lI$n*DI&q4sE_Kex99;vW)ghdoYRU(W_M^(d--s%0Q0jqagrZgwm4hhk zP>q0xFKJTadL>WrIp&Q9n^9i69)N4(06Sjs#V-f~-%gF=V}anUY0B|#Dz8odm!40y zJ&s{S&mgPVKk}9BOBUySMOPu(IYjcxr*j}=9?w#`UlHT6KZ2O?V0AY#qt#b6+Vu*R}EGHAWNAnl8f2P_^2`aCPMC#>rR7$9qL2gq` z?^2pi+L3$8jTMA1Rrm~v%QOFu6vC4gULCmcR#b~otT|5XDPnb7J@cQFbQc2YtpRD- zK9#iai;zS`8I*dVprWF(6BQzwkKsk~t%LKBc2XX)mlH$Apa)%{Ss2zP$OdgQj^X9~ z;_)MU=wle0QZYFgN8R6JZq`lQ8iOuf{AXbu%S-TA^F`=b-m+mx5Qd1#BqN82af@K5 z9$|Q`7X^TKIv!|^KgRLm#{;b<;uJm!q_oZb5=7cqUd8#VjN0qN#18r~1`;_+7{Ubz z!=8tI(B>(j7jWCC{etKPTC~FZOI$W_$D0wrs}fG_%=p@zXD}t|*hJaoV+QWEXo`R?4MIPAz20g3+!^+@4d`J07O(gR%NZ6+QWYqLxyTs@(}kFs`+= zgj1!du6K-hkHbRL4@zYquJKy6I;-^z9%`c$kspMS&#Q!gt#B8vjplWL@FpVE$v+Ey z)n3{zKt+-hqRm{lDEHCEa(24nA5+m_A>`!coi+vSA!u_MGK=v^W%zs5hL#XDhbT09 zobRGi>JKf$feyrvkgAVmYT$E%mwmP_ksUx1)6(!`p|V_h1jELS*7}dYJQ{%m)@bSQne$))tTAIRNp^&6MwFq2G z;K!G5WGA3+x)Jw-!Kp4bk__Uro`!g&r$*)IgoE;R=UfWjyhluQ^H|<@k2vk-g?N=c;{A`juz2U@ z7S8vGyvh8qb9!Ms9E-=pv2=6Q9n_RC#Y=fjdjWWv-(EWQV@GuKMI8^aQRxuXTvF=n zQ5mAz66LWkZ%PsvyDp+JPX@P5qXtDgGQ9R zd>rSvP59G7QvMcjV-P$^_!Wgu%p&h4{5Qh!bxPk@Pq)C1>WA!mR5sp_$D+1HB>Ip1 zZHQa)#X$KgkR>}xVqz_3O?*QoIq?;Cm}jHk@9RV*Wj7Ky7Vo-ih`C*%f55J`TggnH`n zlrJfcB)bq`vQ?$PZ7EFwd+jbXed6m6)};D4?;7PczwuHv{1fdG-=|<*Gt4V;O@lM< zwn}Fb;sU!t_1m2)`D9IHE{s#X6xSDEa}*RTMNZ(QOp3#qQUsW64^jNEc!L7= zIIA;m+b$%E$ISRWTXAF>uU`BG;<7?!q4A<7_97nk97VThtEjUT+qBlibhPQ(W*Z1= z;u>5}e2to&PN41OuLPzM_?}slmb^v7cUwAB!t~t$v>tNgOFf=)7lMeFlW{D%$TH$3 z^?1r+ierb$Mu5ru4_Za8XqE=I{@5;dOvnB3GbD(F@B!x!8J+O2wmAeyq_yGmjE0DY zJ)h_(P9hQ3SqC%91JMpMi0(!Qt!>Le-X_&1-BA2P$Eg!ZrJ?TZhkByH+kKI;#~uh= z_ND{^0~DAZfwS`xZBA$&h4zkshCZSAjPNH`Y2s$Rk9bMKFDra;eSO&`EnWEr%s$0L ze8Qv=vqCY=k%n}$KE{MHWGqDy_mPOSVf`$LiW}yh5QdgTZI{-uZ;ZJ7O|1vo9mEM= zfee@tYd#VGjF_W}*-@8Dn<^4Bg?>bAR>W7C1P&AtK3Czd4f~Mo^jl>u4A?m4OL5EwYRJH5p&$>IC9PdFUP3niNgIdwc#CT*Zc;#JnKS3U8jp^en#dQc-pZZ^7#> z6+@Qr1fH}+TwKE2@*ztEzB8)f$U^aDytw7N%CO;aqhOq3mnx*8aq_Wc(83L8PM02FWX2N?I&?{ z8E;pL)ⅅ?3pNr5Hyh^zyGHPE56FdBrMJ-+zt$|SX#xOBq1s_tN zM;N)RrX-8MK$`tUu3vb2%Nq}W2|HZdv1BfFrhQ5G ztW(e77+w;Np9W1PEGZq)sPMn7DSL2%33FhSJ9Ow=adkB>+bMYgGU^UGfIwzK9S8gl zQF==mt(4}xlO-#sylAxMaWX2u4^$P=@rcHTU)SfzwX7*E<*Nwht_wt`HM~oy;K2hIeIog<~x*Tk{GWMz^>s1N(9Wc=6yo0(|!2 zLyRjGpG?4ackIg~;jehh@VQ>G7TdlY=XmpO;EBAD5I=0-KNm0bqu%Z5#vB{|$eMBl zzcLE@rXNMqjl8(+;2b2tUSj5*N$s2?MsMVy_L zkTs<%#WBzMngElnIt6Y^;2hC=GjCLA&J0Y&YvRU^E|n&Tt{(y&q)TBX@X{-m7;nJecE|I&G|l;am)edt9Ug%o-$OQ1BL*AJFjOW zkkd|_@>sqF{dx8eLfe9wUeFKvv~wDX=+n;CDsxE$QT``UT%UHflpvC9uY{uYcuJUF z0`&+m*?cK*TNnlZXWDsrI#Bv`RIkntW z{G*M^QLwQZHekDT7Q8UwGZg-~m_Ft)0>4vWUjw|0Txq>TzHPh+|1w1cZ$qoPIyLM1 zp(!WubNJutQVPoqE58vKroaFLTu)#L1>QngeavZJVz^?) zf5Lo0jCNbj8O*ceQSctW|2fMa9xpcUz%0K_IdORhX89%Jh0jjR@|!|e9T1lDiYDD) zuPb3_GRU0V5AO9bF6R~P5vO^DjY5xkT98<{6SMsD|H!K7mH^j{{os3qL3AHNIj`8G zghG&Meb>^_iDuBf6~4&tBi@kk)(Uq)-e^;ygn$0gj*fSA*oY`23CAm38&d-_jA}j# zzmWxBRv7r>zopl$a4p+mDjB(|z+*NYTutC1@A_SQDGSc{3mUYErcSuOI8PrniimZ6 z&`yFuNO-iCCPwe!<%-Y!h_%zEevHIx`KK_q>kW3?Z&LN~}b-pb27 zR?BsyT_*An3MA7q6Zum|qBD_WqJ0`K!&Z97q#=!xBd^jVo<1Cf=kOaag2uW|#^QZL z=;3^sxN(5D=lrUubC5S@n}quyZ^6D6mk;tN<}U)$aRxvWZPKw>mn=4>^Jc8B_>j)& zTeMXU@#^f7NI+0@`6WstG4KLxQZlq>7K?MiQ^op2+|M}-wA@oBZX9}XwCkkSm2|N8 z00=A8Y+5T4LQ6y(cM2?^{$sODAuA}N$=K;%Rky!VV1+Ya-98gs_7Y`Ce*0xyzo zK8`3%;5lziT;;;mlSq7WDcw8<(QHN18>XB4jTL#1@M1;Zk0HTq^|0Y+t_GF_O|H;4 zV?@0p+|TDv&_ul+BjS(X361Yq@!b*b&ojn|`A7I1=Q&cRw_}S~lZp?7YPqdcHO^%hvx-J^A5a$w#ZxX-UY zfP*PZ1GD2ApxF;RLYuXPD1MArQ8)j`7ODlSW~BWnKTE zVbVQ_2jMIGP;0+5Fc<7ZSbshkb_NCIKV_8gIgVX#)?9=h=ixqOpoL$*4%*X93^>jM z_~_B%hvR&>^NW#~`?^9SWMB_NK-$w)XdA0SiyoTsQDxl07YzMR0pI@v^Zq!ad^aE| zYP$i}#G#Ok!LD$+c?G~?vX0E#a7k|kr<)g#va1GyYkFQtrH9L<#wAK0m$5F#R0Pp3 zOBV#`=4T_s?i1YK88#a7)}$|n{KuOn@P^XYt2+17oZhnhP>4VGm4woolR5s~1v&KAw8xH|O?6?#Ql`1zgRV=GlAY7)RS_#~TymXm&;4)f* zOK~Or#fuK3MgCK~VD9Wl6ymc+i_lX%(04Q>VqNxbGH}>Oi>{}5eLmxiINjA``#L{) zXiZ|W1kV^9=C#)QjN#71VN`fiNg&<)0Fe;#ApzwQ`VKL7XifYF^%nx&lhYqBw+<5} zPGkLWW2k6eS-zf|k9!-Q<6q?9rM?wEUBOYXgx=!z z72bfC>n$o>@5*scjYhzG&0cp8E)GdMCr*7#akxfo^FmNfpl}VP=tCW z>l>G@&<4cf1XZmeKGC$bo6-`M2R*lCdT+7pPhQ=>4tPbfLw=_^J1u22QbfB#PXgcuuH{QVO9H+q^ zb{Exd@Ib$V*fdLeZk>8LmVT%D1vM>~eQkHq7i9CfAVXfGL@A^X37GHUN~VwtV>Ss} z*Pq4@TSvOix^3IRMdDYVaGnX{#$d!;=3e+OMJ%GbxORhA=A*j{>rD(Zy}FCAo7kx< z*Fbn<^#4`D< z#D7J60%j`PC7y1+hlv~gq1{+x4vCCg{FHMdh7@&+A@^{gE?yq?tko>xY^*ED0W3Cw zW)4c8-T3AqdAhAgDl(JU>QSyR*?_AD9(#=H;gC8AxkDQWY z4U;bGP9fpkx?HTw@)*3~WUR}__6BkI^H+lS>K{JA8NbW$XE}7NiHV){p)C?)8_lxX z!JGi)qkBTx1~fC%6ZuM8&;Y~%57lAWJfl@JF>76@TU+{qlX$Gre4=xS4!3!}LJ3N_ zrLGM3BD;yPw|N6LOzgYO%SN@^X?Xc3Y*`b>bdpY7MTADYW*G6(&DRj4l8AMMUdJVn z13H4sRb51|#*aGZ#6!fI6w^l<+)MIN^f5g-6REUAqS$D{u+krr*2HEV(Maf{vgzjD z0931>kx0c!AA{{gQ1rTYEx=82O>hz(r#rqv1hxnR)iOSh;iA20ycnCod-0&ILd)O* z&KhXCXq_>x1CW0Kd23>u4uCL=qr@Hop(=3OOLdaA9s;0b!nde_)D?6o+kCO3)Lw;%^gZ3YS6+(A|MI3~TBCOHKm+Nm=}a`bRy{yT_b@#p zFAB$tr~mS`v2(rBS-E9s{u2&a6L+W5Goub5diz!5QQZdf@qg* zu_W2iQav@o-urH1Bl)J0sI;r;6o4q7|ES&!N^H~Rv&f>ccS zQ&ITVsZWCO{gr)g^XGuEs~(V@>I6iveHS*7>DZ;5&sc*)DQ*o8I)Fg_ga9@?_F04d zDQ*q6osfaW4*{K*$6jt?;5Zm^J;a+1^2-P!{wa^oa|}Dru0z&f$M2!uqfhxv#^3pg zuFsL%#EN3nbACHddIj`idfRYz1<~gPA7X2%0Q@G=bsyXoKv}{oc%QxC0ohB|EQd;m z7xh$VYm5+%9RX%(TFzVjEx*X}lnB%<-YF~m-t+HmDP<)9i`{6XAd4f)dbhsE5#vIg z1C+3Td;P)|7a+DW(*^!rDKU+ks_<5&y!*ImOm?6C#bx4_;l;g;bDFaALcbQ#bvNi2 zw$(*Mm)xeC{HUL3-~-*C{k%hbOgT*1cNAjTW|X!UEQ-XF19xFDL2mdD1uQc^t&mt{ zF&*H?3yOjHpt!K0cX2+`@f@}Td67d;%MY|b%0821gMP>>5^bike0pB7(q=lykLM8s z3zJSB@8ZIyJ~?>vN5a?N)R#N63#Y&7r0q`}_C;l%!mrnSj|#`~!F=?sNGNG4TlJST zG#u9h45P_`<8l)R_tZsaOA_=Xlc*TWfVX06NmB@qc`I&|G=;ZFp7_ZIi5o+Jwip(W{iHN}GH#YM=W7`o>mCpf37yg1%Mq3>Ual zW;db9CCZ;Ro#^lYe;2Os#i56?>*Jo^3-KnN8n}65of2{)8WTus z)I+>Lj4>!EL_8{OYHAxt+MW>@2aFT=_IttJR%J{cUb#M=P{)Rk2@Jrq7rLgQ$ZZZ( zSNJW2F|bQ(-~eP~Q#p}0$kfa7`>E{$T7)oG33XCIp!(IcEpKU$oHVNj#lVzBtHW3&E)l#z#?d8P$?;+Xi?G~iyxwH zb7*Oj--Vwdu1^hMrh5C|?f4$u6eiphxV8kQk`A_E4oO{moMbI+5YTAGsTRx&0!9CF zrl8M9NYcJY2DU*;^bSgc(s?NjIIJ`)8V^8F7Zc z7$0IP=er#+#n%#T7XHE;V)8FCM56i4BXstdWWVwkcSB623e4Bh=?F3Mn(h9=zk;cV z^BaX56Z`z;-Ugs1_W8}t3_wln^P967z+JT{FyAVH(RXS`yeNQr-BXff+bwS;Zrf`} z;`#0jKxmvZ5l}O32dRY;GQa95B`hRJ6e`#JUcaW6Z{Vm<^PeQ@sgZ;-qNfNeNX%1b z0+=W=?6z6Rrl*o2kfWsVt!Vm#Unu4Mr=n>!YrP-q9f&=Z_RW0};7&{Ph5=Y6$yD8r z50ac27>$~Q>?uTXdu7sdOabM`(5Y2b1$oO~+zK_t*dAh>bv^bBc!|YLO3-H7iaJ|F zL{>H(V&Pt&DyGtm`H4zZP3ze=;tB;`Z*rKaDr1wpyQ|^70M=IAtqypFm{$YA3lVEK z%?TaQmprgXVnY-2ik}LSxBJvI!EI>(6p!$;%fN27dGmi}>cQAiF`}mF2|F+P)PkY% zqC_}?;o?}h>85j7PqOD|Yk@slk*vdGQmv~3>*oWA{V{N|bcr8Ce5B&bSS9ZVu}uCm z;!7)jg0JLXWaVF5z%#`!&PyMxOgFcMT&96NByi&!@(Mqbj3E;O!*E|w0{RyU_8C0Y zhw<5hH98oa6%;!73oK+xPSC-HNdF_+S4Zb$6>X=3a$nL&seumCCT6D5$~s8fota=! z9i%0qv`;1f~JVG1d7xH}TU zOs*x>Z`g;7zh_WKS)E%9c9_=jiWX6}uBox5QEp~@Q)T;NF}$v+iZfd`+;XcyiFTQB zEczyzO<`bklm0h>W|JE*c+z;d3!&Tgvy5S@g7!Dvp|eulXS2{&WOWw!uT};nR8BWNM>)0@nDOkV74bQgBOdss-NfP)4)5QkI~<@K z-j2BTCpeVlMkY5(BdsyVqZ2YR(&#%k9{Xf8$N25=Rc6!?@*5P^Nn`fDqwrgBnau6| zU}h47+&+{|O?|tyGYFK;0^)}#%{Q`a08XIXcj+kNV@-ucl}4tV`G!$0JdUjb(oSGMN;K;I}1g-#-;*J zA4PpZR5nn}TGbF+$QO)1bL!IPwXZsog>H+ngT~N%X6jx*_(xC;%DWd*vFLP+TmQhD# z;#Z=MfYM9mlI)7>UDEG4MB>YS(WY=`-OWa;ry&ntE8hpMGbws(&o}8@cEwqUtFO3< zJ9JJkrDgQEsAv9g;(0ecCzh< zzf>*tAuu?&kEnH!|D;9lpuPqRN0rb#5^{950`b0ysiqAd z*TVj%L@OncMiN#?P`<{YY>cl5sMlbcsxe|7No9PgQW__=H8oi*7k`z0twNxsiw#Xp zwi;dqO(AF*q{*gU7Fmj-sFM1cq?}*MqA2qi)sIZpCafK4dhFLW>Mdd&IIV%`5^E}H z`3fN9CK80L2SE9%D5xDl_u7d5jZ8MNFxHgQZdOEPBKEiWPbtwjD1WQSW50@97;NSs zxw+y>EDAV9Rl{|v^r5=yh))`hzmm9*Qq;cqpAv6W0UslYFi8CG!sw)=mXlN--HtvE zex@iVQGdnBG8v5;N5jG)OgP*Rm4dU9hZR-Cpy-{pFBG*7l+it=U@$UHWYz$!P0vD> zm83f8~7zY$bgeA(O- z*881;CJ}V&3(C9v2{mP6n;MFG5qVIO$?`NF>ipSq%AXqjN)x|a=dV+b!msva;TiFh z#G~e>f|dZnJ&qe&0QC_0TL7B2OhWqzY9zu48i4g1q!tl`FLe->Sts!x-5J?Qi>m&g zMr41T#746slNU=jmVxZ3wbohe{i@--=0wR(AyvC1hfp1zZ-{r$LejB&lX3ABCMs@6 z<(CkoMOPr2ueOau@mK{Q{iU0$zYxxrrqX=sG_j(!scbpzdMh-U5O8Wr+~Op(o&%%V z;1LQv=7!V6otCC5LCGWKF#!<6Ww6j84gL~D^~V5aDY6A*2#iD*SBwi98-+hh3J4i@=% z^rULVe;iqNY~4UzZJ!noA<-w#0e1;Ee+74V4*l`LgA2_l}CnykW3y9PWgGrutY?0 z$i-)7^rd}N4(O+$rUp)EX`xN#P-v#0_7BZ3ZTkHG-nG_I&{5H*{DrG^;K}IE@}fM%BhX=;=dP zRNa$=RU18k(Wm~uKBd@=VN{u}M_j{%eJd12(I0`-r9MTx-^<(7dD~l@$D@Cy120x$ zQQHu=*qLw9xv?nv3j)IgXz2kbV+xKD96b{}8WPRawFFMTb`d(Jphi^wYm2Bn5=K}< zSJx2N1iv8h?h3CFxbYTx3a<-o6n!6R1;1Gd^SaG2LRWWy$`!;_a^nhOnZ*BqPK6O& zE%0k~vm{j82->WmNq}%qa_@C9ACbCMdrWSA?qt#OG_+RNS5)^41TVJkS&0P@hHrK} z!-8J?7z38T-j>)7xUc&jv)9P?92d4&VrvOIBrys@)Jv1te8T=IF`EmElh`!E@Qu=E zn15)^4iR2g8ZT1F9B1ZG?Bz&Mu7pN{)Q#njPQoR}W7tKJ#z0bq2vvlKRQ@g%~t1&;58yDn7Zp?60%9YZE@q8%)~-($kX^Mj?6mM^4HM>6Uu{45h+f-qA@tgTlKIu)w+q&mvCPi6tV-;=6a z)ZK4A2^e*=G5V^di53%Xs!?Ss;m(S?lUb126vR7BWdm{7KZ(d@zLLl+eqt)?;yZ3M z`M|F$4k^m~Pqi`s2LE#^>l8fsh9=gcVQmaJWQ(3TG^;l5T-U@>G%VG*!K0sJ0sdX@ zN)0b z{@^-4_Z%y6mH@{za9BUY)_5)2_K`w?=ZbS+;gjzJ1F^iU+OR_rfH)s4L(3*7_`rG= zSg~BK1oQam5TMHiaVE~8)}mUq(GEO)s*NqzxbXrDjJSupsv)oZY;r9{ zqubXZKHIA4fy`B4_|$lG&a!O_ZmMt zjXmWI6?!~0Iw4zhF}@)IK!z8D+`B3|pp#V^`i+&;OHpG0WS_+$5hAf-!d=X@?;9o* z$kQSUDqn}en54r<&_c+RXh19KF+S4@wF2W!XlXK>rr0yUt87kvz-B2Hv%}NLxWJ%w z+0{lh0;JEFsvqg00!?R+@fm({^efTs*C6>U9xq}$?uzZVx~}(QyXu4spZsuGU}0KY zctSLCZQ7WmFVTb>T)4ujhOG#^+BgB0A{1-X{62xC)~JyUwqT>e!R~RfG85H?zlyio zSb9bCq=3EECr0c1T!A8tBvzN3M{S>#;pk~pv?qmP$@MF!~Amb7TC+V}`c%%YL+O0X0V z;;sS<&ATp5wNdzE#i&HqRyR+*$gL^t5%YmszAS}}HP5T%-=?swPW_^2|G5FE**HsY zJ}wla#VU*1S_IwtvcA|<$*UJ%w&Dc zKb_-m&SZh+bLaTSGua4p@j2cs9W>+|k4tA={4bxy0+!7ptMKv}B_ zgZFcXPf+8S#Ju)NYLuPjAEvY2=1%8%b_Q$f{Lq3t(()PX=*DjpNPe5Xlv+xEwebry z)UD{}c!;+lQkRM;SLEFt+XMAiE_H$N9ayTI3N`U$O)FL`CkZGpHh|>%j~2iAgm27n zBa=-rZ#~bgnFyv@o>t^qo~7{ZlP|_U6-+)f;;>7yY(FC!UIY!bfW z16L6JGC0&7`YoTB&C;C<#E1%q#!xiulYikc3Obg)SrDBK4Lm*zLPtX=4uTQH14i&( z?FDZ{z#(o13qzu)nAR=;~6;%f5jrs5vSF|7)zq%lDjsC!R0pQ}-z$~Y;Zq?&h{!!~vN z_vh$+pZsb5v}9ts6gqY!;oRr^yE!bao$_07=*(X)vyI4aT{+Y={u%29!3z$yOyJQm)0 zcu&B1dm&jBT9ylA<7y4X7*cwQ_nFVy1w1XZ4s=1GB}ee|i)DpglTUH$eAeA#fT-+M zUQ@ArK3i{oBgl85(TjAn&=_HO3tk*47Ekb40Z~iG zbz!G3Pe?1w=X=dnR`J+~!%B}O0C=l6+3XCa8x24gg-B}<3%zy;eu9G*Z&=pza(mgt|KNT($d{kIU+^UXr9L7(!Ph0JfzV^pcoD;|XI+^5GC)MC$A z3FFwpjlp#k5CYpReJoNwDrF0Ad{WWP$rhX2l^wai#dOlxPNK2m2>bwwMyWR!;C(n{#L?|0LPuf9-*x^roxUsm`OYlUKyLj z7rx3qax!uvuIG*e_sLIgkN(7KmEw|4#3p@(b`L-;uBYhm!eUd1CV0Ve;7YK=(f4@} zfxM}Z#W>yg?SlZ_drF5Dz3WI*;58Ej?{`8g;?&D`zsBZ2?TK(@5H$qn&%}sGYpUH* z@4u*CwQ&eUhCwF|`P+0*Q#&RK2ScPdPO6Q!tN6=UklNt`1!0VLfJMMXg7|Hy;^j-& zLZ^3ttJR6fy-$8tJGF9JEu40T|B*oGOiwQ_YpG<2$UDL)=sgxNw4orR6-U5Cu^YBD z-qURKoVgU^!__o;0s+ETx9I$SxZ@!sTB_|WV=ky^Q(pIs>#7WU&bQ+ z{PyB7b*=FE8mnBZjoKG+1q@CK1FS851r(YZo$^`l`Piyt<`^VsBI_xf?Q_xP4#*4*nZW=qt9ikb2JNHJEG?7+y^ zXhB6+92a%RXf(tV?De39Mj|TF5Kc2Vg?{lu!d)Xhs=zuDU7@21?R{&P+JDyorAodo zbM*wnxb3o71`Dhz$yv!B^YVt3itFX4`8KG+jpSQut{tFw-^D1n3O`0B~>FR5 z#k&Qz%i*VPf~wV2DpxzM$A|^TcB^GuRMStofv`nEfF4XdzsJfNFLV%54dU6Fs%rz7T_}REk9KL^?qLQ zvZ`A-F!-l3paa9THK(M5(}cgK@M3|>9B!9c+ClgXg_ktKP1H(J^eVzfDZCUo0_fuk zfL@fyRcRhuHQn|5H6 z2rKeylSX}xZT^#n{-Wp~X8{{1UE;UM&kAg%tQSE(yC|QoIX^>UZ3$xnqi^QorA*L^ z?*Ecnt9OHUbU*!sXrT+)OUUOy5WXuZ-KD#q3EJs~b1>ajxxjS;M2ue$SfV^qTZ>#C zhY+%`QCop7qz56%K(Ib?>2)!AH8NFgI%_4|-X@bFRJq9S+vx%uTV%OPXRe~?GX#c6 zuwH^#awD;Qgn0mqqh-Y6>qVc4yp4?(b)To4V!q@JHo)s+GzxeAq}s$!zrh|29VAuX zXG4|VOdM3P>i2<$Jt3?Q6Eu!@U(W`5b+idpbQV;eJYzkks}?2;RXb8$<^$hk0jZOv zsv#4q{W!B@lfF(-o0~+ZDlDj>5Z;#9au+sAVl4?<42-6^0&!Y>Fjv((Nz~3H&q)T) zT+jTyRwN4DXwpTC0K8JAsw=7R%TI4IzdoJE39HvII@aCR!9RGckRwJ+F_u{FwE_O6 zEbsLocMKmH~*cZk#lknT0!0N37E(IeQT(WJ7es$--sh;)Nx)t*68_XkG3 zI`NH#BERw%R9Xgk3m-qv1okI?X#?x&^rx9BIr&wBflchre-ge2*V32;^*To9V>vU1 z-EbZvhs}e{8cppK!4~PCguIEJ;$L2(ofCx30)}tr_;p!;i!I#ZLu435q4H|6K;zxs zVnJc`LnsLP#?G4HWx^h}r;?dw9DPY$9TiK&*!~jFeTxk@XT8KfdW&^_`XoB9(JM_( z;E1aG0lLveJH>LR``_5PqLlem0lh;#6wlSP zk3GQGVI0DWDZIZFF~8zG?0)E8$nbYG?Ow=8QH~bnlcJ0jQ{1kiYt!c+Q{tE^+S@cZ|4F;w}-lmbiPwEhDbI3EU#$@D2^FelBrO z5tm6EeSy6`nK;_v>!%V|N?bf~mBfuC?mOb1xaS0`;drc%AZ1tLLWvtqTxa4kh-*V! z32~mpeMFo_+-2f^#nSIo`T}144dQwccZs;c#GN7T8R9-8jz+fn!^F{0<*eUJ>>H#k zC$5aRcZu6Y+gI<+-%lSmgtTr6?) zF1Y%k#0}~}Y$UNy5!Z*f=ZFg?j$W5s9{^6{Z*5{dDyD5>z1)l(n=M)6Tkf)f&4)Mw z)6+6-fdj((^YDFGliu<-7Q+91h((wOMDUeWthIYaLRw~@l&CPiW;07N_wCP3RrtO@ zcz+8&aFh+;aa&jqb0pr32dz0gl2?7qIQ>{0&rz08M~?}4j+1cs5~Fr`g2RQ@6B&NqC7Kn9S?nx8pQOqR7(aA}eLp+rhLU~@{h z!#J#pdGK*N6ldyBp>;I(50|m%2U%xiLd4be;C&7l ztxN-iL+bC2tRMDF;VOJ9Ns+>FfY}nxR~|&iqhk8T(idyolk{Hr9>x zkC3}67+Ht)$H9XB4dB21&iZuD$V$#}Bsh8mhK8gkKZgIF_dB*f`U!@jV?&xrLq7c= zz6gz@3?0~-8VcYY{$MTKlpAik$a?TEK486secBA(wSt0>-4nq2Bd>IPx=@7J!6z#* z$MK-i0lep7OhES^Ab0L*hnW`%V&n6autHcw^6iIN2znJ6Z^N%2W^K*=BRM;Q)diqo zM_6~FBG8#fSaTBQ9$~>mHymN%L{A-Ifqe8CbjSzWnTPl6oRkNFMDjLAS+FTe?$5DD znHTt}M_C}qOOlA7wjIT{sRr;_+YrQpz1UCb0I&G>QMNyvU%Sh?RakywEBreRpO9-$ znV6N4)h8`8G})Gtkelx4`NF`^gr0bS#cO@_rz^r*>6c8+?FsX;6CA01vT_|2(QWi6 zO}xNQAKfY5o;AaskP(=YmYJ55YRd`C$xTYK<>aK~rl-&2r~LFbyv|R55$9_9pg(Ns zfwL3rX$g+Btjs`Ljw3BYvWd1C7&`m(5q6om8HqM~U{(tKiArz`yPTAHfp*)h+%&r_ z!C{UTN*Ycy z5B|BSo!-s;T<_Cb3x>QISXn1oX~J&4s+&H{Ss9?;9*io-0(9KjYTh-9 zo>8<`(KKmMB`PXqlqritd)w>0PN5#}utm^o*jliq{%56{0_8TFtkI>I0l_ zv_dr4d^#o4j_^O*e4+opviT2fy;J7z|KW}hqc(pI?q+F2#fIG9P^VI0mv?ovYfA-f zw95+_9W5w!c|l7Q#V#-8GDVy0^3>11G7v2o^h@kLHMuyB`N{73<7TW}@a&;4HP`1IOEQT_R=?)>)iRJUitxZnMcJx9sxCv zZeNkuNBD|r6BltCvr$58z4+L#U>xfsTev) zKWcI|oMd8#@pnaa+#}G)>aD21qCtv2s%U>jV-$T-(TR#qQJDpG zHeC_qkc%nYG)`~N`;XIo`SNt#y%Th)4_6?2TP7K2^Z0SPziBQJ{1|Pz-i*IFP7g2$ zTf*NSr*|!_#W;;o4Zc6*x5PBrRymkGLGrv}2ZGP12RkPln}Sskf%TSBtP$z48ff*#<^Gq;XG zG7~Z*Qp5(5m}HxqO+v8{vT(5op@akllqy~TWhA87Z8owhCm}s+2JyQUFRUtsV9(0U zOcwGnk~0#V=|~e9;~kWcZ5c_~^GH0SM06yHwIpU|%@I}WNWgZusy2|Ela?vKyF!>{ z7uE6@ArJ_{$7IFIelM#wHCdaJkZsROwmP*p%`>!j%(&!oSh45a-}kiBW?bu8wKL{S z?K^X7LVAi-dyD006)aKvMo&se*Z$J&+IoZT&$XWn&76^n?AVfW9X4w!a*Te+v1$iR zbcLohOUlZghx(@EEQeLwXv);yGv&aCRden)*|a=!x+B4^-7zz*vKOxBYH`*y+cP4p zSnxM9!KxK80MP)7hv0HAJtxDCi_zS4n>Fs~;Z_p0KTO!|alMF(U#Zn@vKi@Fi3#c1 z!btngfZI5@P0z_rwQAg)?MR(zvu8SO2;!WfYo$j`xPr|41Y?z+keic}hNDP3VYWGP zvS9H6BZ`XKnLRBT8)wz-;4-Y{6jiGElFIT^IIWno>={W`?WWl_J1rgcHZj1L0I+^m z?KKu|)mAgB_IGF-uIi{%>HLQQ((oabrAMi(sTSoYRF?ltWy3v880gulHoMKL{m5{8 zk(`#39o65eU1xUMVkG)=V_v2s)#gY;>sPTkmH3@2T`OLNX%DyD>|_V+p4;@~tT~y2 z-K8fa3#C*0NKeVi#UW9p%M@x~8L-iQF%lg!v}#X;bxOE8M`hkEI5bCSpX%Y-DN4Yf z0y~cDFmq0Jy4{A$egt__Pow8LwErBZV6M2)#w>G(RkAH7+h)(f$Yj;l8aXYoH8ZT* zMY7sSI3G7tZ{yr=(5(@+>kxp3z3!-9y3K=}eCvs__8yga?>8sSXH*uSrLrO48)fO= zeNZm>0q6YYv$X@wa_!_YPUQ!90JFi+0wO>Xw{*eYi8FjHcQv8HcQlgYNl(;&=3L; z>KCezF>qU7@LTj6A>j}CplsBLhpUPgPo~>%#YgkQ- z%DJ_y#x0NKwWw|2x1ZIAV<6Eq-hZmT&KaLAmu84tEDT!l-OS=TD+m_!PNT3mDboZ4 z$$8tPoIo-T;>ssHyhh1UN-kD% ztWznLDTS3}^m}c0c~~MbLZ%6Rs5SZ}Ngq7Lh*1r`tMKA260dT}m!*7G$?*rI{0qql zaEWTq>49qkYEVPx5eZUqX_>6>gplR4cEaOb_BI*d6eX8$mi3dA9P^8;pY4(ZB%Y__ zmOlyEiPeTOfEYjNaJ7=B2S|CHk^_^Z{Em{tu1bg7m7M*YY;doV8~RH5(Ea*S{#3~^ z<48vTpH_;>&a#2CN-hqR@+BqLq)HhVsUlF8lk^wAMa(Sq9PzV`z2vL6i-b5~wGPx3;{Y~W0n#h+P z$h7^McISaY$iBD^gtz++do__qHj$?`k!LlL7dMgLxG!T#H+{C=S4g>vf199pasJdq z-3(WjjpORnM2>7Ck8dK=dauUyi<`)F<=O~$;yURe1ulvnmYd^wRig@8FDYYGlAnks za%2;EP!oCBLvmj%ym&~VX-_wiCpM9%@@JEfxS37VIZfo3qw;;=hoGC+j^zUjw@Y{{{G8 zhW{e`FUS81{L@YFO8ny!!}lfW&;M_nb^2dA;~_SEuG@g{K79v-_p8`w(_c4QHocGL z{b%ZzS~R+^POI=t*ZY~ga~^t1g0D*Ie%yb&-h#iLfu}BbGU8b=D?=ZJm&E-yXz@i` delta 93411 zcmbS!3tUvy_Wzs#jC>t5O-)VG(eMo^1{np0IoPOVYE)`;v95Kk>}F+U9ttQY7%;~i zD=RB2yZI|i4Kpn?-&vvdu(z3Y4{G@;rI-G{-?jId2ioKQ`IKj$^4V z2Hx8?~3`$e(2EwEelU|xeS0e&W#gf;i(Vpx}at1({TdrrWsP74xVFN&~l6h zHzx=F#ylOo58w&UDC%t*JmHz(HsgZU8P6)P`#MF<`?%o2xHiG_-JaIjP2xpG&1nkD z`$oaE#P-3N?&Q|4P71p-Sz&n}C)l0tcJxG4C23@KuyNdl9u0MXF5D}h6jdW!dIxWe z>*Wwm)aE8NAUp+xeS@pwdb+3P1oy-ZcP9@Do)*xQSq)B2`-l#VB$Ak8SkpXHRalP*G$w( z6O{AuKmSAyu21m)Kmv9uas+7XjDd&$rVxBIoqCHE%}Y}C4Ec{J;_xU;7{u;im|FB$HN z`-AtVWON>RKXmx_d;PhdM6bWpvja6|XDMKwf4zOq{lT3n$!1c7EW?hwKWKKZaNk`P ze7yVEGrN>QLisdLq1V4B?TFnCr!K>%O?)@E*P6?!o=^9$9fY zxW3sVGtR*Emmb|3|F)NoHrx7rT(C#a+ugU91fTBty8Dg$g5!FnyG!p2&hFK(#pwHD z)LeXDa7Qn1+;4Sp!7jbi&xog1n4f~$E!$?6jXK8#i3tf%{O{f)(%veLbNT$o?Nzt} zTv3W!m^^Vqsiy;T##MZw!wvNQy>Y=qy(hKmOzQF}p8OT8Ve)4e2mjs2Gq9UROa)AE zb}J2;9EP|7ac;bUrJ~3F-U@E*b6VpamNMs2EBHg7F&*2M#JONeDr}z(YoaWfvnMWi zP2Y5D&-6IgisoX(e&mlA@v?sbjMjOzb^GlfHN>%Zzr8D#FNu6>gleg0F2sdd*J)sV zG;p!QZTXNPf%I*Az+Os9_|q1ahS?v`?5RlVF!0|FyW*Zr?u&(Rif3w=%BLZd!;td; z0gL_HJ#ns_@>9@4I&Qo-9HBW9p_Nk8Kn+8LUPE>l2{0FF>py_HFkB%hJwjKa#L}*CsZ0xvmj&iI_G--dyY7YA3Tb%?XRjSKEfOUu4_ znzoaTE|9+IJJ@Lf<||+1nePN2IG_Iq`&PhN!`TuVD!XP{@X~WmvkC-(I&i{G+(nu? zHB6nR$&#bVI%r@@H1OBEVHJ~HtXk@6g;cb^1CWB3;+j`9+I5|||HxspMSoB5n{%#i z-UB%d_in|-cHg}uzh7Zo+_ar>!6gH_#a*^DZpr5Z&NSlA`6@2>`?>AnPX8)yNxO_M zjMf9bV2{r)6ky0f_g3mDM8Ui~ z;VTEx3pt>ed%dS=b4A|Ukk{_LC9U&*jd$CdgDr;-ac|$alarYG877BU&lE4I1Y28pwu;O3B-h%=q(@R$?zwlPfcGJTzAy0^R4+rjTf``x40FS%vRXGXux zV}!H9Q_O@xH<}GSp&CYR59(IIrQUY3o-R)qu{LNG40ZRbp$$v+6#OgUj8jIDT=mz3 z%Ql&%n<*=h5LywudHmqUTSlm+x_LzK&GC1-vsMH%ub$kYADIGK({QmL8y@E}JJABN z<-8tTcl8zS4kLoeh27l;hX*eyOn0vs9=xycAMP>3gWnYnbhjHG>~c+Cw>>O4>YARz zJ{&2cE}*D&K9tKVJc~tEdXLNE)VO>-3id)EedsJ~jEiWm&t4impbjC${l4IqYuZ_N z00ZN^1YJ#uf%G3KX_JicX;kD@;9)4g&WVv=+7Q!6o3IejoaJblf=hofUu6D>i`_&U zLK2w`tO%2p0&hY0yQJHF3A!zReS`#t>_a$3SwB*&0Y#L*Zy^*wme2MiLL$Wc0D%3t zCTd_&OXcNNxY&1r#8;l{NujQRu82K1K?~%(MP*~63>P^%%ZE@MXv|% zE^41U^mQiJ6}g^dq>|6$!N0klUdSf=Yu^oF0!RfQp_4<}N?`qks6R9YKP~F#{$yy- zoN$)=wV}atCZxJoyc(P^AuBm^s1`6mi1BYhjWAE7z^==Kt0$aojs(%(Dj^tU4<5SY z=!8~o>!9+fA1%%tBGo$_AfNwd32b}9&rC!g&75m*T2T+--__qU{9;D z_gzfbFFya*6qKH$^t^+My;V?kKL6%4i@5cYKUs^3dkr{ILaZ>tYDf(d`G_zcf*wJA ziM9gNRHCL66-a-FAjgu9k{))ELKRYrzfRnW1IE4taHLoI&b(;9>L9^Ri&b>HQuH2C zrz=!A5b3Yb`9RhyME*ROI>Js5SExBeeF+qz>bSL6i5zn`ac=_`b~h#9cXm(y z{aV1ye=NY^w+CU$!8H_P6iC1E71UBaV3fHHSGfE_jLcg^rlsQBz$!=RYziG37Me$) z3$)PbO6ceqq5uACL$fvi1-ROKt(-VlS&dnlkj+Xi^~^`ruHe#=(LcZr)W2Su&K&Bl z1~nYn#hx-8oZ={*oQIMN{!E1v6y&&;9ZmxPMf_w?Apc4|i!dLez6=2D2caVuVh9`z z(@LA)32Y$YrWmCqT81R2R*GS}1+4V?D?DCE@*;;1pl)FRlSbQ;k0K=GGRE=t&>L#j!ra?+m*N7(O|NXJ5w!i$pc(v!kSg+!>svU#} zn!SNeHWI%FqBN=JuG~s9#nI9#VLlZrPj$*u~d^RjU};2;3dIq5YUEvWkbIh8y@^?8(Ioq zg=c<@0z|&TlR^3Y1;5g>z`=X{$Gm=Pr6(I$DsH6>sLf&!S}(yY0bo=vJK=IMV79a! zRre=U&n)4a?dgEfgE7y)&Fi1-seyF8()h@J79>=4qf(JSB+iP`QSsM0`U>MxPhnK` z+GDk1ZgfTzZ;V!)sTKcpzWBBS(*fn1Mdt#4t+-kkXM0>R&MlAD@exSq+$^Qzwy+MW zsQd#J7(v3F)+k|I>WPnb?p_VV=9&}7{q`iSDn+Sk5~GS+jf^}y*FUJLJp&nrrJe(b ze?)2%Ep@wKTfZh#7$*T{{h}%XMm(k)QRahFdays5_7GNT2f`4A^Iao(BI67_Zv}*ZMy(LW5C4(N^vT zBSRiFltj;RB14I2yBiX9llYFCS@!c(QNC3Af$*w)mexN?>F*h%e|D7q6YE&CoGyIn zbuUEu)J@BDDVZN%6x045juHx|7J~EdJGC%V`M|y=?8EyS$Sx)fTmc}xo<^h%}k9%j^Y1An|kLzS)g2CUL)$U9%-qpg^;G z7gC6_$?IR_;p_^gO~qvbNm1t9hkq!t%h1J!#$%#nccMn*6X$Yo0iYly_4#Ji1Wbk< zR9Vdmwm%wa=GEHG!R0uCu>SNs!urd(s;)l36|=Y(F|7hMEMUue1iT!+#0A)#4H!_I zuF+-`lW1pT1u+PB_AN?Op%TUTQ`VzVvNU5cKq%5zVZ21!lBWbD$Jp}NU-LHsU(_6b z=Ckmxy`_czG(a5OqUJx^sK@_WXf^m&35hLKqSOF*F?*cxjAA?aFX;eQgvzd~)Tg`YjVEkeD=SK-eJud?XYqkI= z7*>eO$@?>@m}TiI-8j#263G5s139+|12+K3$oPp2Botm4)BijbWdyXI%(F|t80FdN z^z14vG+ha8sy$PVJsl+z8o$8oC&n@4|DSmFMSta4Os5u4J!oAqo!Wj-(z92{5lEP! z=2AM3o{2J|fn%J(OAv1bV^pU$7KYj-TIe_>lruQ!&_WkP35CXs8hZ9eeVS-XphWmk zoF831$r?H%8rVbwIZ+N*=TY-+Ea_2%W^d2KH$uUyHKm#HyEsn*hFOC!e5`fQgezX4i}uC#$1`(n)aq zEhk0Yk=}po}oqA{UR&3yiTXfD*2*2bNW=*L48?9y#tVl!Hs z+EJUz(9kM2O8#*q?An(j;q}u=QYPI2{V+@Ojvqgc@U2jj7Ip{Z*2b*@GZTk1YI=!F zF+eDWHwhl4aUuT?c&G<)bx|D)AHeCh)0`={bdad@&KUFI&F&=zT zljnOMLz`#?7;Ef@9wKvHe@pJQ(6^$5LSt)i{H-=2>gGTs`h4xB)9@L=s7|k0!vWqh zD_&?2fd?TdHUfi`we2uPf$`ednkZudY7qEAz}oTPi;lpfi~wK~f$kCkYn_@FX`!p5 zgfar)_*)SWb#ox{e~o~}IZov@u{rP{1T~0&vbJ4}v2RBidtwBn%cxJGmw()Xo40^q zhT|g=N)rygRNl$Di2BN;4Y1wfnZR$-1}rr_VjEy%*HPQ>*M^LNe8h%KQ9~kSM`cIs zkl3#y}%Y@JVX41)HNRII*%N|JHVkbqhw? z9{?t9;R?gcQe)hDCrT*Yn)5f^5_MxBGUC>vaShx8wt-v9giqAmL)X^3Q5Kx&mgMmA zt~7nAXE}1m>Duj20Hj|}2{NJ7ijn%>UrQ|#M)VsPEF7tNz^Fx5+GScnj#A)>k^lY) z@=tuM5+{sHJ-#RfcB+=T&m-0GzM7)wSk#^%6@b{GWFGhsbG=`$`91^@H)T%p&`pQb zh0t+~f+^tUyfjX&%z)=GbvYye!oC|9Hd0V;!39ati_<4Pz7nW!t=F-Wna$LJS1#U_`3_p!euj?ww5rltb@>O-OD&vBrFDn^`$6 zIOd@*1_o2Wk)2kxj2(0fc0MU5P(er~wR-+~h4f0A~)W1jN67Y}6xe z-lHF}I2A>+@*lKnlUaEstukN6BRx{A-swipIYF+syEtaycrDpVz0oOwBpiiYm`_ff z3*jtW2w;OOEFhiA!sQfJ`C~`e5KjB=cvs^!y=#KgXP;rsP7Y^d2B}LgIZLUD%KsWl zY^ZrLfDJUyV6c?tnJAi-<6|`Ehc!ziggQfoB4;I}x$?|hJQv+y8;(u6o{47ZP07?= zAvKWpJ&w83ln%i!AMR)Ur&HMYwh&;J{(w}*5izknY_OTP2W=KUqls=5SKehYnMGx7 zKA9`0b%>7BO}vvhiM2xApx(yWJt77qiUGf~o@t*n5Oj8;&*_lR9pWAavi(T!WxlMe z<&|v(^^~^;eO2k_V}jq$>723XOzmN=r_e0@;#6?s5eT>?66VVlqKQ{&X+^8q1amzF z!6BjK3r0nly=G|{nU(5>TD?VUn7_H6seW7Q?>Q#8Fm#snQ^#3*69%Up zaSX`yA98G9yI5`Jq2n#}Yy^w9Xqz<0O%Fu99ki&;7gdcl)Z zves}musSMW%$1(`g7_A9c|~izneajYKLWs`&M7?fobN>f6a$`TzPuIx zAN5+s2Cwmp*EmFU1{Kr*4I`V*F)Mz#M2Ti+VODe*0ZEX%Snkq!2cBdf4$*i6D?J%7 zlZvu^Xd&~EKi)VDlTtTy1=|JYEUvVj2Ld0>SeR;P`vZs;?X# zrV;52y#r@U_i)%`{Vx?#+$1hHFf1b9zX6pGw4(b zN-%}Hj6-tw|I-Q&v|&SA>bV1vl>?w`LkU(}1!e6yYXmz{16e0w;90}G;o zt28h_8n_TZYMhKK9`TT&!R8o_LFFscCBjL_KY-Dg+~pjo-h$Hc@r zFIZz%t>s=xvpxB|B3%-B6;n1NQcNrg*$Ai~9aYtB(ivfH0ssbP|D=0=W3E^j9c^Sl-Pro$ z$DL;p+>nKHlu=f5+aMI_7KZ4gy0O2r<;CC!=fdb6XfnBRD`i#5D;aYA)4(dkBI#MlzLVo6E!bp7hX8xikh87W^8qL z9XWm+ZOa+HF${Bd(ax}BNai@qKRr5gA#5)>4Xv=klfocifw1B<1hiV<9LU2OJLKg+oEW@neKzbxECJzO4F@dVr-DQ53>c&%qt> z`VI9gVt*59y_R}dz*K5Js=}A-FJz-h4x@9=vGUAq2wow76I9dC!He^khik{QV z+sI|%lsH|F95<~UEx;08i#JAuvWZQ}VhvKDw`i$U0qb`n#HH2v*I;>`_mQ_~GpEg% zW=%=)7Oj+e!D89W+pxE%!z4M1Wwn`yO#(C|hpw|i2(`{OG-42N-#{#17##j=A7f$g z9_$$mPOCB2dD(9D=E0F1>=n=;wqe;lc%mlfRIIH3(_E$P)3`c&2Nj@+S#1w$q2q^n z^^_~=CsRys5!g&rfS6_655OJ)&YT>e3@4>khSmebWyyN%crf0xW$d1EHMc;xo3LT; z)sAOQ1a*+uW|P1T`4R?+4%!Bt;UC+{LRExSrJl292oTm1Sa#fD+JKN@>;Np7`|O3m z$AV|VQr@af2_IP5OCow@60o!*WyiTsk#p(+v+V3oU;fAdB6US!Q~J*$dCGsKAAtAG7jBiPyJo$S?aD zwFoC1$-moq5y|;x>8C_%>(Gy}F=621{FUYcFK$&WScIVkkphC-jFP$e^40{NrJR9!6L(gf!_7J5-( zVPU(QHn4C^MA!~7uv~;yXiqoB>3#%z8!5s0FSN1z4JEiE5(>nedmuqaOq|hSi;2|v z4W+DX3a1bynXCj7jMHUWiMGTc?;OaLsPiQZEOP6oDPp}u=7O4!D?lxSB5DprE?MOv z#-PT8(JtoZXX_f5e{5$jb9&v}_!%!*%gVK4w3uYLYqgjFRG zhAQKb&VV6FIWh1C`p;ybESLQTw1uCKJkKcI7_A?BUNjjQV8bcc!X7gjAQ8Ke*OD5y zH*ORL1XOr206bnLT{pIzCqtoh-)OGQz$F6WJ;Dz@yuyIjE;*b`W+@TVzfwq`feBkN z`++%#5(6hwQYhdq3_uKcG3cTLzW7wcZIKKhW#3P~hoPvas7#+H*{oVK2t}?{v3foL zuvxKf5c3bZ+m?K9sHcBicP4sE*13Iw2{YpNwz;m4V~~1Yyf!{B^M@&2hGiZ#E8a&- z*2(rA!!`x#!-13oVch_s#3XMCT=p82T^{f84usEU*%_E&S>6&xlcq{2VN5dVCUfFk zOe@RYJSGo3*I`Z&iN-+INo+Jg921RMiEI-Iff&B?8}RW6A=T(GN&}k;#uZ%vggP{^ zvOCehW&lPX|Dl9t#t6-d5(6~R{A&!6X`8~W7HeN7sNFj8UBHMp3iHJQ*CNH_~Z@NEgy37c(ERBiy&pxHLULegb7g|HRal_wh#?vXo?a2){S z7b=b<@Rim}k1zG)LkTYQ5|;vXVNj!R!4cbgTQiV8fX#e-~ZcdZL7n9)=|7@Yb_7ps8l@tqRyKhvUcoJc)#|bAfEO`QT*@;Ex>r`IWeyDoIerny*F- z`v9E{_j7vuTW`QB0PNVPFr|EAZGi@$&mEA$6*v%});cIv0K|(p*3E-z>^5PWNbuP0 zNpaj$1rYXfAS~eX4i&f16d+O^M5=|7{aBoa_jlk@$iW-^ix5==Gg%N=<0=Y>$Z$xd zK+>0f!@z=J`+Ku=EILH*z(tZdX4OB>McQnDDD=e_=4I|TE7AdxN_)vtwWj22MP|xI zb5ygOe~D2Q9*@$b3T7YWvH5_3;RP*@22pO^c-*ILtLyN!T#|OmF6JWM)zm%lja*jl zl1n#r`SnZOS=;KqJcR4Ex~mS#I24DOU1S`(9kSW?oP1P9;AYrn`(gqGWo{3nc6Y2X#b^CulV6^c##P^wgdrBC+l`CAf8It4j_b zHSN2#x)E|cre15g5;xows(cS?5_!L+Y9Jfl3P^F`(I-H7dTW-pe+zyy`-7>=+V%VS zP252>+c*DMo)|7;^j5%JPqtH-9K2>(TPy~P3BVucPpM8JLkfX}shDy_qWTHR{yeHh zE<_dkK{~3L$XxqYz!=qGxbkUe2lgjeoM6DPTy?{~lFD7m+Wfw5BriwmcB4{J|2L}3 zSwG0#`tRj(@jkh%IxLsT>e5t%n;c>~`uY-P!zu-{ zL%7zxi{xWalfyw(D`y?3OJg*C^~V}9_DK4jFT$;`#+KCR(;B-`J#OGNPol4VO=5K!46*xo%LZBCVsHXR-s5Hc_{m$NLbN$-%Fx z+XU~dZrbU8ZC&UVqHKw6X>|o!yo;=HsB1>?^;Ln+ztf3i;e2_YO5Lire4`Zupe_L>Y3B6)W z;F9T&On`pL^)@sCPrtPZn{I{)XKND-Tp8Fx$I-jd%AsWgCRmXsobo4Hw31hUg_2HT zB@aN!7<&zXbaWoB*ts#wp6{)aF&l)gx)SQbEXamsiIh0|xv0go6KOY05z-Fn*L^kg^YY_w=r7H+#E&TYHprn9VOK`%< zmKOWAy@?xg@52m*Hr5zio^k_v`X2i9KB1WIkq*1<;t`}YYx@sWF{ZDi^p>oKXGnXx z%2fs3OvW`YbG2C!=tE~l75^sQT#Gwz<}YT|g(&zkFReAJPA4ePY7WE>QeJo+ujnZ( z%EW^}c;It9V8I-v_Wko6pfH&Q!CUgquv!fI%`CeC9We}I<)KbFE9W1IKk6d=+XRr~ zUm)kWJeLJYDXNrz5f^LR0FQ+-{z)7uQS6$*!I(bXK3Gt>)*R(Wfnyu_@EIoz3Q~YC z3WACv#O$Lq-hQgcqjJ$eA}?m?SOtU?-G(@UUnvK_A_jzBX}i#AM3!myGxxArfH@I7 za8_v|q!9A;!y0)Sq^Ek^j~gUjLhJ;w7>Y=Y2d)kTsEH0r6|`0Mg-4OuQH#EP6VVNf zIEron8vwLYZwMT7WWz&^xvIpKYX@cQ?&M5xt^9=rm-_gajEkb&9M7PK1e; z;426i7CNXxN5morvXCnq(WpS6UhLph0g$m^Gb?kjpbiW@h9_@>)9?gyk|)u>0h@Kn z{sXyifgKxm^?2wAL4?SpX0I0E!9K=tcy3<45gu?~7PeM+mMay_mS2yzcL)1FaykL{ zI}_B%y&bslFUQZFoVmF3Zv=QJK*X3YZvc27VuMR9AUIrt(kLkKZ#=p~p}9G*93-yp zwZM(VU0zWQGolbhm_t=%7M9q*!5p-H>h!OHmWe3fKNtG!Wb|9)WarE7%D>Ur3^%*i z8tW5l*|>u$nh4^JxZsZNfCGShem$dPnkO0YW$y$emFEO3 zBW+u*zrQCJy+65pMH{$EnY{)*F6}mF^VI99wQ1XsjXPm0aXxH1(YLfCr`GaWbw0{a zQcG9Rd*E)Ee_gI0+YNx^8aw=Jxb-yy;<&P@0nop-WVM0khm-wVQK$56Xdu2AeKu-l zKIn4&pMXGiYjFZECot+X1DG0M@UU$mF5qGS6lS&@J^+YOa6rpJRfomCe&@=PXZZYN zVi`7kgdcYBSrgNU?(f8XZst6dN2MbH9UPc$3@bW5jE8vl_vP5|JI-04kXQ7PFVNv( zFu)@mboLpa=Hc6Pux%zlfJ`RgraDHP@UhsK*#GdO(3;SigMWbXU? z^W?-AhGVP6Me&0J54Zr)~o3l&Yxig$Y{6|8Gt`GSaw zj|cMrAasDh(Giv}lAFSdgkeRW4J-Q$I!HEfp7z4cJMkjPtSCn8c(8)mGAwhub#cIR zf#c0!|390WRp&Cgpiq8X*C?!KSkZ38h}woEnU#BEBDG8+^#$B$1s%9yq!ynnQb}f2 z28mUqELTp+`ctA*979@(L#@n8J0?^wg(KD0te7Bf%=0jvPmEM6v#O1Fp=zU~CQ|o! zC|Fh_3ff{y(Fg6HvnZ8GRpJDzyMtM==R7P7RO1>}_B~rDE8On|+jBtqG8f5)pjj~q zcYJ=4QnCRrt7C5oeanX2#d?;u-Ux3MN{8Y<5Ex?&PTPdTcgg;PIfdrz)g`~+P)sq_ zLX*+9D^V?IHjvXFT+7_Z!b(Fo*Rb`JL17SOkRm^ zsGyP$KU;U{B8>iO6vPOMj+x^C`)OW*;OsNJQ_pUC9{?arl;L+aqJ}|=D)=xXyKIxc zxmlUTSjs1Biw=4NV-R*94vq%Sua<8bz?RIV7`L!2G%F7G4rXoaVEu$FcA`IhGnZqm z2iUysCpRCI1hSgq*{@yny-cYls~HvsMQ-B0S? zY{`KbMa~cl0JZxbfzD{rrAM-?I!*A3N>vawTsq0nOUNM5MYj1#5-z3V-oQ89~fm^tbgIdGq z;(w7v{8((DA#vtotHN#tIwbRfxZu~DPqR2tj^6HHiBv>4kudoRZd=1Y1)wtuBisEd z&|4gcLSadyARw-BP^th3XX|xC4!|&cbQ!HwZDz=W{fqw8J4kZb_wB(lq%%rjLsO`} z3XaSIjGGygaAmVx4m6%`y@8z-XA>iB8y_PVAZG|UK>WjN5D@_LnMe<3)SSBJHp~cc zV3b6F*Nc#?_?JT*S=fQtlF5tIgKEGFf<3mJ*O)R`E%`?9rY&785uuKA;h51HEOpJ& ze6dCuXSbxKemvLIe6-kyeuQ#3F`ps#cxpyG>S&?dFOs2{FHj|MLt`pT!G9o_=4s1? z%tqeeu_ih(6fniKdDT;OIzcsg{@;B@Eyy0A!IL3?IiLx5%Jrak_1A9lasI-Pmc*A_?CmrHn}Ym^Y9!m$(M_;?+sZuxLaE|4JuSY^|JZ6qp?89z>hMD9Qg4Xt;=4tTSkNw zRI-fwlg-K-#8@>0(xbkGo`ntFhjZ96sghm_{X+^Wlp7>+rlS}XX5}fu&Lcx;oG8OI z3~n$p;|Hhbr%!oNE@|7yA8lJ3+BTbeD;5`>mBce@s=LNK1B-<=1Y!E&^y(D}0>N>j zl0D9uEZE3y&>Oe`XNIOVJTru2S|uBBW@sPJ41H%-G==~@6_AfeeejLjWyKyEx*s5^ zUP>+Dxgp7YDzyzvM2i78%bKv?#Mz-lpz&{{{?Yl7j!nZkI&>x{N8y81GI!F|EwPdA zJvKOdce!0-yn#~roG1=9>|n2mNf>LAXEB_6&QmYNDe<%#efj|x_9w^j%MJK{DsBr< z6}T{aaY+ILF2(AI##{laGdO@QRx~rAj5O*pH|Ek-@n@?Gw>&_pFU&;T>5HcH0vLTB zgDQCr15amgl?go0fUOiE_RS&0{@%4a;X+-HPkCJbD3(>W8{x>sbNjL+tVMFL*vcJv zzQ-)vn}MFk|1C102GX!#IRIPHIbuCPfLYe!v*X8y`F}!sJ|S~6=W$X8&^axRj~JZ& zR-K=veRQ_&Zf-4Ut=Sd zLOTJ;$qp>X2IrYgS>p+|nhL=%HmdWadxj%-Z%uuf3f$(Tm7_tD%d7K zHzyeEE%>M1)Wt$R8%AFm?nLroX<#QCLG)KB36ZDt6VbIeDE+h^=JO+z(?GI<9ghmx zzRTd=M8N3XAPU5{YhwI4SNy?7kaT@$N0VV1dpKH*qV#D<7;SJipmZ%86!xcIh5I(N zH|gG{nw6hXA`-#|sqWs;yDh|>FMvq{6k7#Z!Qd;O}vm#+C&V=HzWl_Qa_}j2Kxbu~VG%O1w8P6f-aMX7IgJ zU351vFkF{t|G=(5GDOu|A$)|ka1@eaqF^8R5}`(CfY|cvBL=ex{GAIt0a$?ifdLCV zvtrEyDPUc#mV#XqEc=FLXn(MMRe}M|aJEQf8vsrNl z=^^w0?!1{zJ!aJ%R!!9wJ+xVKrC&|vcod9z>Erc zl!TW{kxl5mim9gTA>c4(MUJH6G-?W$k{D8^nq|YtiuaPgi_WDB!?_em7zm4MHukgF zQU>4r7``0g)9p{UH(H??5nPvD4o2t0`RE4^j6kD)3^49POTlM2XY;6 zI#b7d#rIe=pXD0zr;I6NoTwO!q8VM@C_ZFQD>O(QMe0RQ#hIAhTd}6Zu;xWr!*8yW zNr!$AiuO;R!bv=%D8%}p0zEWm=7sic6o-L=n>0XNE(mpNUm>_@cni)f?W{Sx_Ce`e{+ARtEyPe#m>$Hg(U>YQdX`T#w zyN0F$nxvtr_9}s@mm7ij3~iq}GN|8vN+T1Ml4mrMw|1EpHxXPn2?9U3XWy(j+A0ow z4N=7L*1k;RQWXwQRRzae`&^AHRJcue5GhFB+wHZgY^ai7&_l?x?F0?Y2lOATI6(95 z{hz3cs8KQNEr^vK-rCzWu0SdI2^adxTf180yb8BU=KnzQ-hNCYcPOD{nvu7*rE!ZD zZkWdL)-KYxWF@q<#_`r3A~-=l`KMXh6uC+pms4D8Adwq85IEQL z4zf22_rTv(hth>xdq3u(p!z&Qm8hsb$9EDai?{YBMO7Q2s#iu{kt$S{d?nC+Mv;9$ zGP9CDe@C@RN+7?gL4mx*1d%_K6Zvtxx`|+wC7eIrQ}+_Kmht%af?w69YWmqf0~yFV z2lsa9W0qUH99$FPtU%UJzW{l+Las$w_SW{-3u85LS1a5T4sN@`O(gCjg`4K!suj*h z+}R2@&cQvVaH+&KQMgW)gR~T~6_NWt5=)Q6KryCB;kM!4-mY+OJGdbV_Zo543ip76 z>#1;e5%-wF6*)Ll;j95fS_V+KPlZcyaGxn$N8&C~xVHcjg)AW1zQV=s zt8gwSYR@R#k96WR;xL)8(Go1@MAlW@P!42`A@ku6NYDyf@9Fcf%%JeBEFwN7B9MNR zQ=FpO*YnX@fJy)g--TEu$b`*6s?n9hZ!+5q1|z+{aAZhif58{P#}_P2Trli#-rWq+ zoDmF`>A@%mQ2SmbdUA~DvtmV;=0@hQ-2R*lk&y8hYmk$D#vg9koh1a(YY;+Y4Z_F3 zCtriK0LcoDWAGngY71xW-?ytt!^gN{((sa+n87ecr?d3`Iy^KwTN(Yw%a98hjwz6Z zA)gC!XZeBMl@IW|HN5;#AGe0YnPA}d?Lu6K;kZk91wzt%KBFRbqo$g{E7u;86<)jt zgxrb25fEpkGeA^=0wm5v7|$3OME&wwWLmsw8^Vc=%R+FQRX%X|G8d?A_lh&gkLRNW#8n*VL1{2d zFI6zd#t{_yXV{Q;uRWcj_(M$DD4=TEsOg=qnzLiG>(#-L>;gq0>WLMNqO22>!ucu{ zWN(GU^6(=nE|J2Eqf*ZlXW`&$Bu{y;-cTScA*MRG@S13v15qffi4+9H#STgp0O6wC ze*R?Ixhj(NPpQKcS^vy%Kog_@dlUo$D;$(!!y6+C0@O?gr3#Mr9-=*J{WG#VDL$g$#*~shbmAIP>*s@;gl$FAPR+)P!JH0bx^9{RLWe~gJwxbohXR` zi}B@M$y70-5X>=aWt9&wRC0w&<%y2`aH=Q>P?H=K#mG`wL4caoO84tmZK?9b|_j9GVKx7xnxJvPzSXB^T)-7Wwz^0dUgJyPLv9o%|_%OGw5 zaZpe%HLM<64!~LnymwOW>6S33-wlN_%uOKFP!iJ}iMJ_<-6`?gcfs9o68JWC>_j%g z_Cl;ZMbu*`*sp;cGs*eT@0yZBZkG4&Y!C%{$G|7@P8yYElL4!iGWE;Qiy$Ivo;Nwo3N277(7*U*`Euh zLQZDm(*q*6mrT8~yl6D`N{ydLy{KZqgt;e?)|12r($B|D_~%lyS`byH`Pz!TO71dc z?m?P+t;R1$sGWE`jENHby#W_{u*NS2-mz|F*`@SIqSe^Ls=- zw~;-$A3yS|-tQ<^S+fBbyPS*>RH{sbvnJtUPbLZnu(#n7Sx+3qEn;z*AhVig;IsTV z?|_dK#tNcvc$S3*Y@gjg|00D;Ag*aF+oekXf2jZ9h8WWZDAd1+`Y0CFUZEZ$>Wx@b zw$f!yqqFm4ab=3_SF)AGqHa*Aw~4wT7G*LXfvhrI>=Ci3A33`UWDO&#KTsG*I=vw8 z=vlS6vH}-JRp1jUcfMloG@>NnYg7g91x#AQ8Y1h~E98zS<`$~9`DqC z8j*{LwD{B>mAMp+5OSeNMwvj?{cNHSg2Y$u;gYgnm_UY|K-RSYU?i}wqZs_CGv?u9 z*b^w&mjW0bK+ndjsBcv(Hy1`VKpR$A2+Jy3lMD`oWg+NPXRwXZ(wps|^sGlo^7}gF z?fj@Vny&D75&wn8&jsG;aKlGTgkRTLLUufSfW z9`Ul)qHN!x;IrQcI+FgM;TGwCrM6*XRE?aYs&g`H>^$J{F6SdU94_wU;d6~?HMuzM zBIgA$C~y*hU$$W9-URf(>;5r{=n0waWSvf;@7AioBs=3;6kQ)hw-wJr?Kd?YdvtLr z*KdWje#h=GkX1p#IhxQV)?uKG68N5s^jSklcN6H)^`B^+nu}$1CQ)9Db-QAOJ!C0g zzrd4B`>YuAVzuTe>*kW~=eL!+%DPyAY0A3GNVgSqaPvg#CMczSKxEmAw6v22??)xA z4zmEeG)8Nzbt^e?2eKBBZmeiMNlf-DVHSzbb(C5ssWM9uo<~Ac6RIkU)p{;kAhf>1 z@#(*7^dKrDaa489($z|$H6Y3@?|_d0KoHxyOLh_h>Bl(U2C}9hAh|g1&OEf|M2K|+ z(HMG1!W$;M5rh<$9LcJ1QY}+~X~gOntm%|1pQ=2tbk5(1UIP~3i%TxMqb59A{f^d_ zlJ2L~e^9?Ol-A2hR12brby}-d+V&lee^`)^aG@qVS)^;x?m_o1gIEkY22u4e5=0r* zS8|vRWIY5~;n0kV&_-goSGmB)+-QF~+C4R8xN4FSO$7W7McgS`>hT(7f$EiD0Zj&N zPi5sturh4HcF@xO6h)GRm9q5G520YchOhaM@fqBN?aR7@sCk-?bpWr50Q2fu!iN}{ z?P(gHOu2f}xkW{QPfP5vz%xo=vFS$?){lw~TQ{J_YT$~<3#8wthzCX!H`XE>x;=ol z1+oso`>^0I--=SN7%*W`@!1qjXe|RJ1EgY@H59>f9R2bWIPx&?I84Mb$E?6Nv0Q;s zr}90T-6-PJ$WB~vvQ%E?n=N0fnbx1;IO*Mh4|?F@+PjkwMp9lwlyPkqhxI_#n--d< zeGYWIjyC6dWSGAW3z$*}y}4z{c}IW7O@+QeaVCm50Gx~BMig!QkK#&!N^zPl^572* z1a@i|q>KfqI1F0qu@a#du!&TUKQFd-^-*?;=Y}FtIHrzuB>+;$b|5rJAoH98c?BW` zob9niDE31f9)4CuDEN__e2o7%dJ)4!h{KIpBo7E>a2&#lw+6!OSpzVYDA`wxp`5PA z-8Kpf!UQB`WI^~}X02X$!Z~jC6@wK;E(o!$;j#~`5(aCT!|L__u z-t^o&Z3Omiax2vvq&0ZbDqA@gspJ(>1>%kjAba0o%2065aw?RZ*{=G?_UQKQI9TXx z`jE6nh@f?{)+$>=YaKO83tsY65NO#56dr)JhiSEzMbqw8rfqR}wglhYbcRKFVqdMm zxh+Kd79)9|?}Iu1Sx{_0z7lam{m@`(@sUJttc)Isi+vu*#A_<&=^DPQC@0IsngD(r zE0F*w`9ND?i8^^jGHm(|$3j)W?xvy!+vg671$!CvAvbo&9LhOAzYjJ#xd9}9qC_-Y7>Eb#YmLMllG+8{F(m-Wg{h#f_iiAD864OKTePBYkM*9D{%gUS&8)8(i`bD z6ENJ`HwbS+PK;gO$J+HDFu)uu+8zXlIox3HTGF{C)xl(~?l!9HOc>Kaj@cZwdua9h zR!CUhmdTqFmIJZsFHq_|R#Z4n|6}#DAyR*UjNZ1R`UQkhJ&w4*YgBx~w-Rh@ld`@g z>bso^Qw3C^91todFCxpGW(wTb3j#--DDYuNAZt$q+Kxa~a0I400+qaZlot<}(_*nr zIj%b*jt9oYh=lFx!NbEX5dVD;s9Re2tyt{6Iciw2FKuWU)c)vDP=F+`f&f+Tpj5%J zG4Q%dj}f>cGrMsjX@%eWI2c<&clA7BXPb#|VtNb$)IPdAoC-J;bJT7F6;avQ55k0o zxUHat`h}Q<`TUlXABSSqw>VM#$+J_`-%0h6?EJh3)cGSO$s0cp;hyR*Q|fz&`lHSd zM$2)C$X4RBkkFv9o;*86{jb$f-vx0{m0wKtO&s;%?8HZorCyxsFi63jcFlGp**>JG zn54$=6~p!pDI#3wlIuypqB5<%TU4e!cDBki58rG)A<_DI*b7Og$%4JFp?+8!?@&+z zGA(%Th3#=dOBzxN=o!^LuSun@#vBT_$P(_t*2mWAU2FicJs{3doFt`~X!a~fjQSeD z5HQKE7zxWug$CS>h!C85+-1doOq3qUL~jLSwI4rY3>tKbl}*2ce#Z zVeHz69hvZK@exg^r0IbdTpiWgxpP=5gx(mYABow2xMIxO}lTYROQcVuA-~5Jhm!#T1+w2Wj3lA zB-~%eM`6Qt32H#YyW`6t62tdwq^&$G#@l{U6W9v>|9so8koH8Lr5?2xKt<$rzhQ7M zdT6?zSoOAF>j+BT_WPHhoVWcx7P;ZK{U%AqC+WBSCaXJ4p`?IuMnTXF@y?_64BWE^!tqY~Vw4-a?e`Sw2mNki zH8IuoT1kI(zXwo*nXFX+9{Z7W2s0#fti50Rn+Jto71s&!nBwqO9OY^#y3uQ1d~2eE!VH7 zjlaBtm_CvP%x)rs#xGGBiTEcB=<+v5 zjX|ghdpJZ!jT&)aw#O3&sf=_&z!NoSbZjtabkIKWdaKtv(29&0A4P(<3C$7lnx=wh z?d=&(i5jbJA5KGugNgfB@b;D_J|Sf&fxi%vij?h<* zILi0F{8uUC5s^q47LYP`AX+ggV@;3bOzCdug(tbH@Kc4k0q-%vdVz(UWN-oGzi?v?ekX!&X7I-ua7|R-`HlDR69biQ2<3xv z_5pcChtaX(KG15h&(9xFtXyM+j<+`2TR4iuhaP4{2c|ZTA{~&s;ke_7#mDMqMKb<9 zJP2<9E*C@k(@fmvuHbYA-wt)m76jjcP!OQbcTiHm2TCXcl}b+;?f!({-U!l&iKxhR z_*ftzoxj}_UT^5#(~Wl4Coq(sU0{Nm6))m0+NNGgK!t||vrn_6_Hiz=#_v?n}MZw^M0<`@r(;~lX$;eFH+ z{p9m?@$0q!h@oscqBqgHs%|IjVv4JTf0b4u{Z+!3@(v?$TfC0j+nKCkEsisI&qEa7 zfaKu~e2wHWQlhSSNDEESEPYVKs#bN+{Dyhd5?kG<=I1eP+lO9|0h>J~`>eXFaS~hi zVI24BJin?uq)E=1i8B=cKR5H?`Ku5>1@yql!;x6zK*10ym<2rFjX@~wl_>k-CV7(d zyD>Lr{G_Pn2888D=mb4DYsbOMybWRPSeXz4Nt~#Yu7aH#|E8A}1=Ta6)7b+cD zPRZ{UUNAeb9uW#8)NpDRPM20N%&`i{Z_x1nexf|IFq|kQ^=@{mX65bB61eRcb`7xW z4V(9lkAF_SIV0MwP0q?Hih|ZLm>H`|K1#!;nvSwKy2trb&U{7=)-`Fkf zNPz0mv3be?0w+)dV~(L?{}{hekZitO8yM9BKMJ!A+pyMyh~9PRM$}^ks|MA4??zPf z%g?jQTd#RXJ>E#~vPn|lHQd`l;=+9y*H?k`AQn&Hok!kVg*SbN%)14hRZ93(3SJNe zpG5dYT3!M2FPxMm*usavz9i_P3Gxvgr}JE*6q>}xX?&sJl|jEM{QeEVfAbt=rF)|k ze@ys0fV0PAt4!ig4p@nDHkZ!LV1fdaoQwCx@Y2_Ad=vE~?}S}0z4}H?T!8Nip%Kgg zEsv^i2ry>tP<$b;yP@;BLL&f>8Ld$z`_eiF~jA*#Q^KTiA<;sfco z$W&i7g0~1CtNA9X)EOPH^73$Cz=s~SR=l3-( zG>p)+zQ#~@w^r2~`x?EB#`P`ZT!+l0tOG4W$5M@MjW_E1nwFtHX%K(LY1LEGjB^b4 zbuB^*&oM4Co(b(c2d|7LCxt%hXIz4BfrPsBH~#Cs&#Z2mZoFu?vzmooA7Fgo-ruyk z>Rh8+g8RZ#s;kd8GFrHMAE`b#%$RE!149pvF!~#fLT`MWs zO=wY}aY6d5Z`{y=8KoBk04P+!zIzh+Qd)Tgm#=VRJxQQQ_;^>S(=|qq4$tf&D>hRW z3K}vNE4qY-c7?75g?rqt&_mZ4MQ+!w(2;A5GaK*tnjA@4wO@zM{D(2zCqg` zouIxiaAL~jy_%>CLeJb`WVo-{68ho}V@Vq>;be*mZ#o{wz>90wkKd_&eyR~jXg_hi zB*R98JYmYA2xZs4>#IjhH>!vC=(`_^l zt-8;+%vcd>QDPLk+rJtLmKgWDd)9>7mm10LQ)@z5rN(|_0b`*1U#mhR9zeAWsh;$J5ocJd{w3i$hKqe|uCDMEo1B0RKt99w zJ8-ctJ`vqUp^J$=`$TkGC43WwCjyOdKOD|e#`OJ8xV3+{NKku;3ik-hi20zpncuj{ zaIbznbkBpvzuX_Z9@_JuG0i>Z_3DY`Xutix$5uZUhrPd5*YqzILKG&D*X5Yge*hw@ zRv}7DcjBlu0A1g%u0C90^oVQx3>F)xuGW2*R-Zl7=J;?Zk#;;b7 zorS*9z3%1E3$u+;?mJ$tK0ceB=-p3N_nTvEHQW;yg&NH@zH=A9SpCCXqrKt&*MF*; zJZiWN_meM#%*Tw;?$P5y*F9$R?Rs|_M!{6XRSmWE&%(WOz&NyCiz|k2V_awjNzW!} zMws*ilAfzcTPV{18yjjq&**#3b`0_>_#Hnbbva4D0gO^t;R>l&jCCdj2e9bP4DEc< z=-kyJU)M0-H1btxzUviV!r0JjP|>v~Nh8B|K1l~^($1CcV*4l zB>gX7v}QG~ux8vCEwX$zP04L zQ1i7@e9Nv3HF^Tpe1=(7l#g>sx)(57vkq5SbIp~ZD@pnQN%69rwq_DZLz?s!McVAj z&`Tgaryogq$XEF|grpZ~(vFJsb@WdW!*i73U-brG>oA{5zWspFnoYREnrp8Jjd{}O zJG`8viDA;(XF&RxkSz7=1XwS~_uI2bh`iReyiCG>14fxXVMwqGLfav;b#szNWL`(o zGed3W8=YD-)*L%}i4{`{LPO?*<5Ap3as2W$IQ|nV2WrABqWBV|iou&iT_@c5MrE{t z<22BY26{DcM>Mb>fHd0>WWwW@ht7P;=sV)=o-sybP}6q6ya9Yc2hG$m(EdmRlcIsE z0i@6pK_+y%JTwnNTMx#q!-y_v%~KFMI<)gCqg9In&2fg}cx_B5;c4W@=RLsDIqdK? z{?Pbmj5AMtw7Uo&FgjHB4D1+-+ZAVq?P$Wu&m_QT$Hj_t*Qn4ZAT<(0 zr!Fu?8$X1uUSPB{o(SE!z$j|Aco@ZH-I))*`cT~hqmTQZd7*aC8snRd0}QAqh#D6v zebyM*>|LLL-W&l?>(G{Gja2u%$3n-RHEu>vb<=akC@8_DYsh}iIL*362{>aUs6Xj? z!bq}N3EO@t&?|`MpzLgKG=mB#A5Kk=6L~&!BMbk?m_A;i`w~4JXjIxIC<~QLAK$%{ z`yvw*YV~j}T~JG?aHzsuO*xS_8Rp^^%ZT0z`Km@zHEg+CA(McNo|ASU6*dHMv48YL z;jk`AcPZp2MD75RPc3R7Ef4HBto9Pm3`(!1&KonCpq5IpWBz#N4Ma zCd#reAsEqTO;o5dC=XASvfiR8!-1I@{>!;MXH3rMoKd4OSC-Xpc>-T9@D*La&E)L7 z%nfG6FxlNm_!@BB6Ye#uIx65IAwHMD{JhNdX2mRlTM6@oT7I+_A24l#T@7z}!qor{ zeg?JpS3FUfx!w8jCi{CHiiXKFb_bK{`ASs!5h>%n*a zYP%CC%G2WkAr>EzY?cq%Ts_w-Da z@pln*1yOj6l z^%BQ+gRI06f<)s8f~}-%n-FYB-1kk~b>CI2Bf)mFqOL*fuBxJL>lTW*>b`I4cvaQa zy36nL%)D=;{eAOCX6EyG=9y>CcV^z1cefCkOOP({xm^3_+1PK1{XJBqcbz)4dk=O2 z(I|gH0PXp>q?%`^(j~Q#D6x}boFT|1trdLKG)2S+a@qb?UJ#lZ$gc}g#jh&S4W zX5+pnirYaVUdKlw;%oi)5+e9sr1=EJi$XL@Kv4Fq5+HNZG5*k=0a2npypDY$s?5d~ zN|PHT-v7%Z784SqMIz-XlcNka)@1)~APo{F05a=4)*eUGU3}(hrKCM*H$-9%Thn^r z-Y6QZRfO?VxuQpnm*6GrgC%;jBf_!o*vo%kt%NmSuoq~|W9luPt?32u>`wI9djoV@ zcQ?g{HSz7b#F(env>Q;8=y9|X;-aGsw5D&6V0{8T_M*ZG$+wqx{aI<}?36)hcx5~iE~Ayq@M&w5y^Iy!#t*Gi z$`-Fedw1TN0gb%Xwj@}0=cMnyrtQJh&FOIz-^l~kE5TK7ld_n1*0e6bk;D~*6JxGf z(?1d6@H51__hO`2LX5{UV~4NZdZnx4n(PGQbxgwmst3vS+3k8HEH`c%6aGFJK=#g7 zg(SR=iA3HqNPN{yR_?O8g6u)$euH$P5rrTnF|H;OvyvFE-8B-b1ZpL8wnU2pG@7U5 z1)}L=4L!l;<(hRekxN8&F~|Uu43p$eBIBjT{6eF+tmpWZ@Ct;xU*k-m>;)@ioUX*> z2M63#H&s%csOLe5hN2jV><@><=K1bEbwFM;$X+1ZWFs{qcM$2dpM)}z-ydO-zT73z z3h|_BZz6rS){!oXL{F2{eM+6au?S`u#Tja(;uP<>3AgW;7LFylg+T`c_ab2k;9gc` z#GXv_Ck7n=`dvI8?`BQ+A-1ro+pNsKQgafKZwrYWC{EP@9r<)TV?+8DwXZ>@LYNM0PO9 zUS`EjlVolpV-0ekNp2UU%kc*pRN7#voqm;7XwgXaZ=!P;G#)69+W^d3A6X0JJ)1PR zGsw(r9ol%NLzgj?QSKBE6vNhQwv$5leotCB7=vZGtA=1b}*%@MxS*7%6 zoFMN}%$5d;MruEYNTT4WTk18lnKP6a@!G>fR4FsLM7MEWPA1o%NX<;nB*)3*nh>eu z6%kU}gbbLSmfDDZLgFn%#$>B_MLl5);m9@m>nRu6W`7`)xs4e8(Nz-yhrQS?-s;!YTAG2fFA7>Hb3IMy%cA1PRxE%d~~8O zawk9r*0e=pN@y=Bz~?ll z!i;dB0BwP!!(+d*nH5Um0I_ z=6LYzMYxAMPol?mK``Q(X4$B0^mW~)%u-yDpF`g3xQjy9uLh9c{u3ZknI{Q6D8VFv zW@Fk)_*%kg!YhYsL(c-DW)Wr7N~%MM34JSw94YiU!r{kP!SRFRG@p4~Q&e*YBO<0k z@(TT0Y293k7;BKBCfPueqlqkSkTkbvoGnr6g9$9JH=YC?|knT&S z;s^s8nSKTw8lg$$megRPwi1OAoaX10jQx8Uk9aMJ{7#TG4ffi*Q6yt{nL?z?jEPU9 zi$DL#V>u8_bNLTYvwpgw0T%G?J3t! z@xA>;DahEevA+BVlyfY&3!3G#cx)oi94QJW{>QiUmT4MS&L}ot;31`v#+nTGbw8#Y zSL0uPXH@V#98f`39u#4GWp%dD5Y!1+UrbmthJ z$RmCE_A}Tk`*nct{u$+4RjJEUFDSEIO-mxC*D)jl4R6~s1?l4TxbbMPKMWOQOCskR zBqpkINSPwZ7$V0RBp!T{d{aWiEJkFqK}MLHH`ip$^B*(6HhSF;iOQ&7N_HDqz3hJz z4V2`3BJ=$>(aAE=aYR1iPcJG%T@9uDLW26^b_V+4Gm>)ScVckBLiERNWk5EOBU9flR>)l*SL{_H_p_C?*EA&g`jW9V9ILW48xFs zapD3s@DIeXD%TGof+>_Bg}ja%2Du6(WalC~PWQ2F@!eRl+PgwrcT17sLd129%=U+% z5O@u<_1+|4rfW>V%F1G@Ma7gLczR$OVo!nowyk!yxkL5!nWjtS6U@f0@WrAkC_uC*o(-lh?5o64X9cXA_E)LO7yh zkkbtH^t?F;%~bv$EEqwF^fyIJ3!O?lz}T0k3=WI=^&LaPuNX?Pvm4bp0= zhXwUQTxKIT%3wAn^6*bt2Gl?(u6=DWQHEa<(a26Loxv#oj^E+dhZ*@ViQ7IZbp zsit~pb{&A~f0coQ66tG-m=;u$7K9SnD4X)2|61^KX;}v4vI+ep)4;8EgS43H>BBvB z{%b*BNa+u7k&)U#RvG+URFpv@B99p)O~!NnH@Zd=t4s+q0|R7qy%flFkVX-@?5(om zi-(`raR4Gzi+w&wIo1O+ry$p$iTL_P64aC?0Q*-dj;C}YgoJr|Rd%!1(vAc?RdoM{ z_;3PZpDjY#u@*jwc2XG()*%mZ!PIQrNKG_@)iUl!6!%xbql=oPQ<6_;h+At!mW|4O z2l`2Y;|!5Ah{UJL0ODevXkd;VM0{na#57K(_griWIYtoK(I7)j@*7FEB{I$+X)YQC zTqG7t%*O^pdk)L7w<4G_#8?D_&DgBurbvx9F%apGA5ix3q&1T(ElC<`_0tAP$^Bv~ z{fU^Z21Cikn9MX{7J|XVf+kw{!R@KdY084;#arK0y15piCmRVluAoKh1%)2tD>lXe zd0JXKOvqrOG;ID^Xs>j;#EqJG?w!Im?A%zLfaPIaXi#=0bZx_ z7&G@A`4M-G5dql*-PL#aIG1icbC=Joq zlTp-rep4xGFD#%Et!qN=5~e)B7Rsv0yw*LXOiVtZDZuteGaS{759^F1$%K$<9dMj0 z;&*GrEh&Em2{-h%pASp!VBhA~DSYugC9dpr!1NL@Ho;qA74X-SU>|-{5wC^LV#yO( z1PP*e9!&D()s=#|lvTXMBV~;1L>|Ci$4Ts3>Csn3E8LlzV&eI82*ef;c>aV)ssKsL z0no94qG*KEj+@+(_*80}NYw9FgtqI@CPt)>0s)={2w`(&lgA|^d_@tq$p~xA2t5c~ zCc$z5VUSSNkZ`ZS9Zw68L2@JExfS>@iC@Zw&nCQs)Kd$7p=2urbmtX(DGU8>=SK$m zJ)u=elvX>)epRGp>VE`V^+E<23bIf(@@pbrU6wJk-bGfB*?UN8uNY+3>yd@X6TSUA zLF{gW&06$LkWp32>=J_vHOnnTl6NU)YF47ih*@?=iTNTcMSN+^WY!bYgc#cDbjb<( zF@I#!>li@XC&YOj8{ju{PF1287r4Ehsc1S0=gyYINhlFzJCc}3m&{T$mbmK?5qh`h z2YJdML$M7eEl85=0%A8AEIrU4no3iM`PN|Qfu3wKeTW%P4CP3wdzVWj_AyaC%*2rT zX8_DxU4jCao{*K8@n9bf7?L)MS|KYvgM1|Qz6=0qB@*8@%ck-K;_5FhnmNb$I|!QT zZ6NXzkzRYJoU%QKXF$Un(zX{wwx00<0-$aXwVZ$YOeq%hbRQ*=UdU3yES= zMx_6<49r9T`$89>jP{ghyhQM%5nLpLON`)J8T{4=(lI3ncQb;Gk*YI?M@t>d=e|~o z_UVQcUR;FId>}kp2btg^lJaQHhR6h4%V44r>@0&JMzEI*7BYeZW$?O@V6Y5c7|e^m zQD(9}gZaic%I8cOMF68?w4|>3QKgEV zNk?HYdMMwcvS8Q5w}>g{Ujax<^pS-O{GSJf%A)^+cM*S#cuZ4IPzj;%ThrXBHJXoG zq)YRWMMQZW{*>H8A&#G}Ln7wOtr2gOCL~aq^tlWHDlJps-fObK5kPz=;&EUjE1gTo z5zIw8qDH-r#Q^kZz9I)(Wql+`?BTyx{PZ#S@-R!RnrMO^0!wA0QR4=V4lB(UM%&(r z1it`}!qVR#;J<0CoaK>(D^oNab*|zpTI0HX_iM>U~k09v| zDRxoaz^Qm>>vEa!W1fMz!Z+~a@jDMroOb|CVR#SDbFvT?-Ggt=$u_a8-FUxTEV1yt z{je!DgPLvzOtq#Q!rALgZEZJxDi{0o<3*8THW0q3rtz@9Km~}OI;AN>yBI;*3dZ`X z`m-sFxx4V4dGKSHoaf2QqF9|S+>w{Xm9JRNh&&FPw25AtLj`D0>{4@KC~4r$5eCdQ zzou_RUN)Y&F5$^9?`j!84?cA;P91o(1Hh?Un!l2QJRa{zS+$&iL;V!rEJ8Ls+7(D5 zAQpZeZ8}&gr)ZSZRKp(&e_P?lB{SrT`jiOnak>ywmb}(mKsdW&d@mZujyjPpISL_8 zYa?iM{IW)n#t5*bjNlv@d|;$kS*CZ}2u35=z#Cr;A8N<1f4Wohh}8_D|IyJ`#mb&( zb?QA9O=k*r%=9%r1=r+Gp)-65)O)q_~LD-3#IAWlnclCkY%H@1Q(_I8Qsv*6zEDK6QH^HB0p*qyc=ypG~1 zCEWpuB=^-M_Zz%EGnX+NrNBSfiPDQffIh}hIf-6R9Wq7gU6eAHNaoc>D!N44i#beV znLP*X-{6a@L|!q-Sd*+I$wfr&=B0vJxK)E+41)0ldU(rV77=s}pH~xuWb?4jf*eC+ zBA*q^N=MCv5*ml7Un48T*eD^d{p-6~(eNXAAj=YoqnE)f#QGeY3IbdP^Yx?LR+xn) z=Y?N@g9)6wL8uw~Up1?dqCQ%ZD?X6Yv}r_k667kn0D=bdq^YbRG?bZt^6v_>N+ES1 zuuasHxKCCeCtmdy6bWZZD{;Lrt59?(1yPhV)4760wy^6Btk&22DivXQl%hS?Q)_!9 zUgYR)KLjH5BwzEQY=aWoWG(76_2E!#{XEi#B0y(dBhaRYVml&J@5(<8VI`GVo)E&m zWM7x_?F(UnIX>z}dBTMuIQrY4e0NK-0L8iaj`HCsrQ(Pb~X2d9~2yX+Na<5jV{A76c!lDKZ{`X+0hcduOnE3V#msvmN=2) zr5iqmT)h6VjWj%#A%;imFGaAR_W74%ZxlADm`|&~zR;Lo9^c?7W>wfDf8WF^Y(8U+ zbNWizSs{f*YraoEVapi%hWTzr6Y{0vdlkdxGRwSkBL73+=(YI5nz)YDTF&QgVj`x$ z^xdz?%4kY$9#D&wtnkZ8A${}|YqZtizKJY~}9No%KQN+hm zY7ZRJRR>URDK&v0=&FN=2c=XTLC{4~HzmXff?XuFNJ4uIyXrz}tAs@1Kv!Kzjg*im z9O$Zxk~sK_$aWkYDldw7Q$ma&lvh1cFQGkq0Zrpg>XCX0O&|zmPf{Z#6h{zrkyQSD zLj5g6mlIMaq|{=9pv%dMyY3tiQXMHn-BaNAc>S)3+gk-uAfmtSMeXYek_(VriNgl> z196d((=Us7OHmLaULWG}gZocw8Z49C07rK{ohZ`GkZ~K&GvdBK0`i>Xj5Jr7_WVNJ zHpv;b_Ja8$&B??q$fna+*Swf3vgst+C23(UHst??9U^W%B9lRibpZ_K_I#L z%xbS8$v`5DO3l3{lcd=W^WZX?Qh@RrtCaZX7ODuSXFCn)UhbSrc}!} zXSZZUTobk%m_pc=;bfzI)(&LSeN)KZMD+)|~v69Rg$al43v4!(sYm}C>tC zSe;_&W=$Dhm*$&+fxLff)~w?7p;=t4HN{(pxRnJlCB+}+fdjMD26(h@3-U*;St<5$ zL0+&8tI47Y@+NIq9Gh2w&uqi$l6$2MbFk_Kc+s}3F76<8ZOhuRpR&Li8g zX6*5GKA|1!srk!5= z_cv_RCM3U2jJa-2>xXin(}f@L&pNZx1;yzwH?E!7+z`TAf7D05p`F=&MM?F2+LisI zD3g8B-B<&r)bOSBVC5B-l!LG9iR^xqgFo)c+U9wuGQYXl3VW*Z=Do0xPf>l>da-Cl zt;N`k#^2d|75lKI%+(HCE$B%2$#{S46g0PA#%PZ>02{+9OYvr;?+ z=!S{Ml2^ooTwlb)u7zsq5n=4yJMsG9IkrzI0uE|fwvpfCSScV}Mi7Zq;EnrX%kFii zZ(l!FO=0^E@YnrWTlLCYg|`~OYN&VNnKgjLs*T{eFo4w&p3s4;N^C{!Gl_Qy;G9-*cdEEI2qVy};VM0#3`j5gt9n8Xt?E-;Itm7a?f4JL_ z0tBTw3=*RTvxk;3%MjJ;IEF;^ethTww&j6XR;woUCg)7WD8jGBHnHm`r}XM_?B6$Bdc|e z2hV0J*{cP7|7`X%OIW~%an>UC(m7G9W>;EA+ZP_~C{WRrCQ;ZZRaC%C;E6Hkt!d4G zql=}T<9X(=h=P4c-u)P*7)?HprR+IgXAXP9YMtiMbD54Ck0s}^a8~9Ncg|y@S>KcV zz&z$;eK0TomX%|_pWrpW#bWR72|fkxXZ24|lgPj)(l+CT`&-mg4NFDBytF$-J21Ma zJFV;)B$xa=k#4^2LRUeHD1L?qe8&nExO-Z`kxsnUOcq^8y9QIfV;>jY2|QZ^KyD`j zfz3lt`$m1o?koOBdeh(&bc}zofPGf0XGP2pDpPV|WnPS$#Ry=uf^Gsg>!;T42X1@+ zKI_&I*7gmA9{wwT06ii1BLAhQ?+?)P0vPEz$?Gm;pRu2M@kt9=Sd|_miYAXTrH{+p zLxa?Z1EYJk)qsoJs~^PZ%LFf<6zs+;g)e4O6nI8=ak6N05JL|gwvZ% z@zT-Wj7fZp+I&}Wc;`jmDj5OPe)2RC(&NgicO>d(Y{1+j+OLoIJ&F9;H6DHfQUSH zCwrO`9M+w3wN&J`Ql#-|$ z$MxY#L!9B0L=6xk^M}z6^fm<2Jpy^Ct~j)zz}FD=Dy=W^F_ zR*YSp%jYj=jq8*S#}HAGWW*5Bc|P=1B@7pRQ4hG~fl=W@7*|0a>E#h7_hA^Nt-b5S ztNh3+xz>oFy%bbzqfeNV$Zo>m&V?KGJnFqZTMA8vy=Lt%rCP2f@%IA>m&NEIyd2@w z&dkq`g+Ky@P?svwA|g2kqbcF7GG6f00b55?DscU2X(882aB?-Xp$Xz#61bgHxzQW7 zJy3QEIuT{Jq^e0uRN59W`f|dl(qz|bPrTPLpQtn$MFE71*5b&TBbA7ul2{DCna_TN zx0iTffy;w$EeMb2^H;D>BHb;8?j@9U1)@pr-zfJ^b4^=P@)L-^Ir}H}v1?fi5u+g? zt4oQ}GuMDcBvqBD=|rK;dc(tA*5FMEI@(g%yEPeo$jIe1Y3$B1kJl9+z?aIAICf%3=Aiegv+eFY>2M-45b1a%-W=ArR=bUXm#TL5%%gm|YrzxV(F zZiAJ=9busTcJrupteq0dz3W&}7QK!Cw2oC#PH=oGJM8n)J1EtVFgSRt`aU5!6SK(Y zuqYw<9Oi0&!RH-?AAs3|spD=0U||N?n~clP_G{aHvFlj^V=sK%vyn|=$v$3i6I)Pg z2&z^tK=2$C*LZNa4#rrzf)Lkus>?90$syfp6`jck#QkR+svxn_Tluq1ERkK^!s9lx zK(=rT$M47$;{7%=3md$JkKW7wNdF1bxlz6_|bZznh@o+e*#<#T^G@q=7K=`{X|kL>j_Hq6cQ-M@C6Zj8?2EZ>S_EzEZ5|Jw-dPbOqxi@kt_V zt3qLqR$4fgz%BfTYb?BhT?+r{GwNxY_%4NoUa*RbR`g3xNM^GUPG3)HTi4iD18}Og zvE(Qx&}#eoINOS;Y@rQ2dMm5#TDD&C8+{#7LrEn0ggDT6LKE6-1koCCC54km)5j_- zH#QT91>#sKbioLxx1=zVJWhaWTSSh>@(nr4Yfs=e6JNi#rq;p%*m#eI%kU`HyG}QM zy%o!vbL;rXZ7`<8I$=z5^RRA+dU+G2MCU7I=1v>o^j~CnDTR%#j5!jTBSenjmL`Q^ zOgaIotur|uOA~UGr`e71*oq-hylQrOhVoChv#LdVA}lIo7U~u?Q3>Iw=P0_0>-ef0 z*s8UrWTLWbXv5ZGNJv=)|HRj**>4E6wHDxB0^i{SyG!4q;d?B{s5a?C0)axO<$w`R z{{w>HXNxehN}3U#YJ}65P#C*ZsRXE6OE~^cWiQN%-^k1D!1HkS8il^(JAzIYcfh|I znj1)*wa)YVbr6htKGE?NiNsoG9k`DlEP1aVQXsk$9khn62N-K=4T>9yf9PyS9aI|f z!QQ$%8hoVyq>Nt~1unYTvu*&3NU)Uyhv@}+jZjUZudxC`e--!v!XH|Niox0Np9w!J z@hYDit2Pm%FEQICbKw~Bwx8K9wuvaU1o4srRd!C0M-phVe68Vr{*ej(e@3)Vg z`>6Lodf3&YpSTI>H_+E)KMPf&m;PuxDx)!Al7t^!;Jf8Ju;G;v>m|Wn4C6==YqWhmC$6Yfl&g-H}vCAo#jEj6BW8h1SIgWY3 zSBrgL9i{j2%NOt&zp_Sb!2*8!SC-7~%;yQmSSxmBK3{SSn@q9XbDR~md?Yq793`5e zIx6xF$62Ww__!<0;2vX%p})s=QbNqBgyiSew4c!l5@P;xEpx{FJ^DC?hs_W)j|c4~ zX>3rPU=g-zq(CnI98-WpMxV)(PO#P`E~D7dNhVY$3Hm-Bo$(ll?m_jiZ6M!w0^4&# z2lAXJS<^aO-eBDx0TQA}?$@D6;viv0Z=^NXi4WmFDV%{Yxf96sYBN6J^G~u$W#UE9 z?uLqOK~kgM+z_n@SMXo71eM?N9i#Cgi!nV?tAiA34nm7tlpH%H?(% zMR~xVpJwH)HGqp@tto-)c;z$fy8;)INROPor<4N@Q_i4XRW7H)rMR39&zeos;ri^G z*)$Wb9NkM9n>XrE4Tn0LI@6xiht{d*a1<{UM^MA>;i+d$%|tLh=8iRe7d)6ShsAp$ z&(7jW=UC|uZ|5STo^bm-BNOsS;GaP0+A>-x&3VPEZnv27qS0!P!QzoXY-I$WkcyZa z#vD1?n%-F4M$k^q<-eX|ol1;*j^;J-fRd;@Op5ty%x%oKoQT#2(Qs;PCU0<_by58I z>hr90^+aR>-6Bai_Cj!Q_n;med^4D!NZxX9mM_-@?E12t)A{I2 zEQJmIhO^6TLD7^MMz^O2b7IUBYx-e)E*|=a%;4KEv!b?7AdslM#LPR3DnElixXdCy z&LQHq&Ty)hlhX|~wC(z=Hhyg4pSMosAoQ%6&Og6`A?b&yyyjI_uT@Dz!q&W)=UhZ% zhDafTXxg<=hVMd|IT3eD=rTc=Po#IDFy=X@2vBWH$?;fbPUn}dvbupUy_kwu$AcYR zDn*~EKXs3;7K?Zzv(pltPp?c8)MqJU(We{ z5@E~%=gaUCBb+|Wm;=rQ0CW0~Bc`3Lzu|?hqdz}S2})FvS+5~m1jc@Y-#zdUI)|0`i_foMakVa_+SRt;OMhhMsZceHQ5 zHs)A0w36V59j&3=0feO=-dELm0qJ48COUp4siB)-;J9?8LNmho81)byX@t}9H7*J} zMHn-}UNRhOgwtzN7&F4^1gM%nIm%uQmG*op%?OL)wuAkX;y}&w({nMuq9xM$mV|2@*D(~mtZdw ze1wUdUPyx9+CFGFPxw2$wLw9(Lji81G8LsVi%JRP{ue~!RZ3Fa}uJp>Mv;NJkvrNVf^TN94MOtZ2Py@`mG5$vXx z<^-0P;MzbVz0V0OB*7sc@`LRBgE_ta_MRw%{QqKpBjy$u3~<`0_9!-Q(Eps}w`ZPAT5t4rcj&?fIxXnB~_&TzN=X%qz-uhQ1brp~)a~Vmr9Qhp?DeBq2=m3M;u@ zEwmI5xQki-$-Bb9_)e$_b36DZVG!L8SIjH6NTIFBw6SaHc!T3CrZ39 zO3rLkI|;A$L63oVaV#UEm>?W(G5eQOgINWE=aBfIY`C59Kkf*tZx%3Wp)myX^Ac=t zf;9-->nm}OeXm4Zy^R>OiAGQJXy=Rb^p&I7ME86B7cg)Mcj}w@1D%yAn*IT6txxz6 z=&TR(Rk+XUsV(o^@WavC_jI)Oz3zXLl;dJv*3sJMpb2T6h1@of##zWI194^{8T`;6 ztdug}_s1VdqjNA#N#Qm8T8yBH?&FELa)@|zsB7S-u5<*Kv7!NS~Skr%W z;u@~d86uQzH14e6yEVX_?iacya5@SB4Ree{9^<#B67$Ja7LnE)e9tphP&vxaK4ayS z#k2onLHXSzM4MG{6KU)&K9WcL#X_sS9HIE(nJ#J|I8%$nTL@^NSr`a^_@2e#M+!2v zD+u}pXV%Hoj*Z}>|6)Z7cO(SA7J~goZ94oUsJbKDjo@pLUY^eg0@Zc|Kk*md&kP*F z|NIM=MiNGF%inB{t1d;S`?0~+)S^S+P0iR%3Z2$EFZFBZ$s%w-oo=ltWUVQG560(! z@bf>;Osx=rB9PuDOrHZJkknChw`PM^Tx!KZAbS7;zzW0JB7`%wo5PXE5R%Q*p2IJq zWop|EZ>APEoX0(9q2+=aU{&{!mW{@5qOQS@^R@rp{83l!O?}E@fbCg*?s?9tu-*0f z?&o+V#q0A2&#_D0u|5xb!74`F#YzNU^?6h$^&!N=i;8G%z7O-y>4y#L1qY%|p`b$a zp?uT}Y2@3%?i}z9fO)c)>#10~||u$ws&~48hdb9l1z2_HW=&>?hK- zU6roIaJ54STT>SfLvFJd@U1hL_BS`nH*^>Z3B4!OnlcQM3D^|IYkq)K#wfiAcT{aN--@`yEJ$M5lAiOAjcoW@@cOac^%W*iFT8kk(@)ZklEd~c`nhpJrHJ`y6 zO5dpNuOMbkiG&mqrTy^a$eDvtr@M@r>Iq(0mZ|lHS0-%h2QNw(=2HA5Yr@|!qcgm) z&mqJjg{@76A6~bmD7=~4V(6y7Os$~db0$Yt7|fr)VwKw0rB-20&0Fd}CMTa308$Hw zgf(Rb$_=-PGH_oICR0%r2A&6zAyN)rrvL-t6ZU3m%5XmZH7l6A+aO`0Hk{9Y&B6j6 zz@|jE{fuxN%ZBljuURcN`4o>!Q*B+xLm1{Lq6ANw9p<&(@sw#!XGmC6rjkIW)(L^K zWJ5B_C9)qvo=84Wq}Ln)!;-iU-ZF!D+8Zn%;s)|VZ`eSkr|;9ZEJ4MO#iYDvE@j26 z9O@eO>gc9TYO|co)t%?br8Z!{bmOgZskPapZv4Ak>RMK!J8$T(7IM|xFN{i{b)ohK z+jZ8I-aW|}{H6%X8*}bV?J;0cm&vQ-MWsybAs}Iy$5Iy?l&Hl=Ku{(baIm!!15k_$ zbU_1`%n_v5KJ-*-oQem!wuR&}wJNkjXk?Lg5QWzrxq(=mo{Aot$B9`x)~2XB#Pe8` z?%bAJtr~I#5~MNpxhb;46gkw5cZUc|>Bi^fR@0R+yj&i&Y+NLExavfq@-b2z%tf;m zT!N=B-U88bfE2)O1Mp#OD*)X9=5_JS%%kR0SmVxoNnSN9s7z-CCRwLmPNW}Gd_fJ% zZMSshS3x#>g9%94*KX|rx%43cEeYa6p+81!61J{6i638#bD#Ct3WJNoFTml18b*!N zh~w4{;lB{Eyy(OmfTjsdd=cPFyFqU?*P5qK4K#*%5;det#|$ zh3M9{BZTxqib9V_w*u0IAt_&tO@-`o-CtM>ipvVWzR5ktJdo2QMO}8VJUo;T`#pR&}nc(@xWf#UQOI>7D4) z3GL}#SU3lgh$K%)eQ5}i74)N=ViJ<6xlM&14C`+|by6=IMj_!Z4KUGd=?brDWTHEd z?F)oqPxFraaDY0&)qIC(Pa$e0DJdO|fh`Ur8%?oVLtQRVG`5i?;_hFjmIDx#2aV%o z`wdc?sogOW7R|&dn~COZOa0k$6`a5m&F16u=ST9Z9|fM4ku!|QFmGK){xH8BfU!ia}$;Z>D^~5|Rbell2%Yw@&r8O(hkQ?1 zX-#R-?n7c-fKU~9?5niOu?K;{&Y{0> zZ1*YKcw*pBY$6|9TVI6 zoN`rWKMM~Q!Z~wc9p?2lFQ)#ZxZ15j?P{x&@F>W@Y(E2qZ=L!q0t4_Kk2Vi5w$$k- zL+Q^NVgIfi*@+($AmgkNkrcK@gfD|5eoz3r9eb=1Ar!Vo*nSp{PZc5lV zM07vKO$YI11b(8p+Bxqk2)GYgBODvb`f8L=XDaMrAU_$3+;;nz{~oH|%ex%Myu@|G z;br)hlIl=fWeMOHif-h=V*$4$EQQPXx|dQza}*CMg-VANC8TTn7%mJu49rr#ly7Mn z^`esZZ3#o;krI4zg!;8@fCQki8;umCv2_Vw8JwABfu9wV!XYt+$5yQvFH=Fiz&aM4 z9jR7gQAK@Gk?QCic^U)lkH&jF1u?2m% ztEoBF9P$CArNF; zL29jb@rwy+r564oX#WatTC%oDf(_B96O3(=NATc5nL|a3lfNQ7(NPy|0k7H5R>iAz z$GVatuoy3BCps#W;vMR%iz*EWr!K55f`f_QV&O!NB8TRF=*cY&e`omng!2jw)QI4W zFz{vn#5b2{J2s^RR(^P&wl|FTZJ_oDI!vrvt05dq1#&QT599Y6sIk#+O4AVYJkcHU z3O;;r=&|Vec;sJ1xW2az3ncO-@Z^YFdB zLuuchMAgeGEu>m}<(qhC_#2X_w^}O7h~6Lsk(jsU1TY)P>#>ay0u@Yw;lX@d3-t_h7V))g zsjgI-`mo%AST~Y(Ygb`39<(%V7>HGpNY&#QAjp|vPShl1sRHnH9VAf90L7QlsTEcR z*({hhYpo{O8W%)0JoOHIiM367_y*dCvKQp*TB`?@NZ+V7YDq=O%fD-@u2I_Y#CC92 z`rfuvD=W$t34EDH`lwU&y*wlN>?Z<%F~kJe8FpWQ*XKY^dfzZOgxLlg5+ns zBGp?+a6Jv@nc8x2qI7A&GMIR~JnWr+Eb56JlBXYmDpq-#ta5 z1#;2XD>JoB$YlxaB7w6)06z_nArk_3F=3Db#uo}UnLO2p`PqU+1{jeY^cdie(2ylL z+yECL{SRmt1D%syG|>RXo}`&lbpxag%q*p)43M@uvp|ahPRS0w>;VZp5XLEf_79@J z8E8OurN<1AwqLW9ZsjL>sDZBU4GvozAGmY_?3EoHWq^L!wRAVYE!n}w1{gsFZ)UfK z0fuG=%Y1I2`03yeqWKLlAUpWBJ0y@_|LovBzNDvGHh3p-n8-Dz`i**j|IQ5RD0y@6 z-+HP)vu|_p8NJkcmLF8b{H996LVmB8TFLb~8IRm5h(tTgUVEc!Xf}DeiJ*QP90n6a zqVcd8T#xM?6XPJh36&FMO$o!UZF3X%lv3x^{(aEJ3rItLG$?TerlzPrLf-3c3%J9MHpQL7|ks5 z!NmhI7h*+aWNN?t~OB`jq==sPr*_w27$Dl@9%zX~B2>H8WO>FWj; zA5`yz=sWtWMb!H6TlnQggrW}J&o>8$_D9?>pg~1!P8U}|-gI6G|UjT=)%#S%9c1h!` z3BNj%@891`-?{PHd-m}2>%0}V$~S|B_aMTLLYY1FOZ+fg7IQuW%v55K+s9;*@#%wx zAW&}U#P^pmABeI6IGA$ZraeC~TrI>G4peh})Pr*2b<`uGVm883LlVV^z+snxYKT3* zgr05!bP)?++Pk2_5Jpjzb*4V#wcnSSJxp>qKQl-z>}m!-lKGw>j}es)A!X&qep4!6 z4@d9)KP7fciD@KJ4-#3Q3v=(ycGJ3~lNtTf04I*8W z4VFH{xEzStdfq@t??WW2P2hC4NnECwLsTO(o_YJ?u+&-uvU(K}&pv=4<4ja(;1Jb= z%y_61KH0A;1msKT%hU{Cx1j{>)w3effdxkfQP)8shvt=xqmzVb%ZS=XvE)Mk61}^& ze=f->MB>AKL(~{oMRZ-k>7zu%!qkOZQ$(+A5|+|}J1V(J4DX^g5z` zg#5o+^fu~i(6C(!rIFA?-f<|J^Vzu~UJrsg81bh3t2w_}BqWNFM2-I`aZyUVMuF&s z$=0k<%W)T&**I$T1plg)g zG>+hyfVd)JuSMgK*YO)wRDI4zs--OC2egr(qWr)}HLA};2@NOcYBSJK(b`nultWP) zA~OV;CQjm^&Qq6C{^aPFpZG-ve}j4ye!?#s|Agvw9Pjd_TF|m~i7??LL7n+{f|CiLh2iW@TCrd=8PB6AcFk(O@b;*s0l$gxH3vD=vp*RNJSBp(G-4Ur!&kM zNuAm-_YZ0-OAV4fmRT?xd7Q{e28la#r$i@RA^ZP&B6}Mo_L(JFOp>!ew$~F47F)k^ zIL~wmi$+q^N`f3pb#%TC?w^&-#O}@gizhHq@i-Pdg&-}u@S6!3Wk?inRRGdorZ(dV ze>6%h$%=b<&=|FJ8U0cdG?}vCh;HHK*UEYS@l`X?|l;2^nP?V^Xb zBGIq^Et*cE^9<3UQZ&`WS3)%86A5oCL5jWhFG#emAsWhGj8==Y!X7Gua98{zKR5P74hZ>7mMfPXJ_U6@b$paWVR5q!Nczz|r6RKaY^@+J;AfX;d(WiLNUF;AaEi z=v^C<-!^EK@!UQ)KycUBgR3jKva8S#MPuG3$zO;pCrEn`lq9$h676V5dfg{QGI}2H z^wSp+3GNdj^248m=1(Am^K<&|N&n%0m3$$CKP-3+pMu5dy6n~$r&PR-M-bP4fDo!W zFCf#1^Q6W!Vv^(^05i;R_yqsE{)MDYWTU<_sK%hMCV4+gypCwS(yx-t{xBMu@JrW7 zO^+1OZ2|C$+_jNh9^!DT!=;w$vj&jhdiNLcmO#CJ5ihS%-nmRJNph2j+bKCRL&S@c zTp!{VORj~<*(BGHINT;3rv^u4tP#oNUkj)+iDMQMfmV(J>Mp5I;OKSucjGYSD6v{d z2M|<3KviC?6438I1A5hfs>k@gYxZv%osmNON$3o>jK?NmEBH|^bD&XQW5hd%gfXN4 zu&B5t(;GrUUqgr<&Saf&(ZD`I^390vBY0c~Hzz8x>)n${S0<5qA{`vN->S4lTNiCk z6xuIRC?5%x7JAae1t^rlg#}2~7|Mr2Ojn8b+A9kjKSPx!zR^!=9Lky+=DX`B4x-^BpzzU%g*}IynOZA^ z{1L)Aox6N>s#+v?d={Ty>jFRI6dYH&%ddkC$SaWi+Q*V%Gn$mQ71SIQ!Yi0ub-ZKV z#k(CB@9?NeYB0-tmp7QC&T;vJ$6Mga)nHrpb5hId3IMyH_wGO-#R>s&wk%V-1)vD* z{BQ>C1`zs#^i6ohS+zNM6@CQ)V0Yk{XV6x|PkF=`win)lB3h<48Gic9)GT-Su*qs@ zmEX2P(ZolJc@B-1uW{BjnY1Bu1RQ>XT%1XxbpSA%Z!6E7tlHVQt^D0&HG;L>$|I)W zY>sU!?>9w_D0<{KTL0g6zBqv$@bFm(Sr_a<#PDNV_*w|CAGh#JQ`B;KnuDU_XG6E} zkKF2~Z0T)Y->o)uO}Rxlj<+0@DVm=A;iJIByTdz4fsozOwXKw{#c(x_ur)QjiYVCK zq7dlF-`d&&Ksh}nqf&A}AR&1l3g}OSsh~l<{|)0a9Zz#>mfJw+X$6U^kT6Q~@CWa8 z!;6>0C*Vb##c(pUk6{4)CG5GwP=fR}JHZLuK=KpXIOF5utHSz4JI0wR`Z77c4p)FagSOgkPZeT(prPS zOR&Ya`9B`D7B=!@)6_y;S|BE@{Qfh@rDi*~Rwa&r3|LVO64sQ3B!F5Cpc8AET6utY z0ZqCq!wVk_j*NmANFfu+)ZSe8`H)Nww(T-MK20spieKh$r{QSY#Y;Tl8}(<`(94Kw zO>I{lF|+sYZ)ym@DGpgQh7c}rM+2g{3_gpUsX2j(I>e#19MY0HfXI?WeEx|%kSb?D zcn#r!7f7^;xGiNb`^5;2y+lsM4Jk)I@VMtluX18jPa*$rFCm`Wa+VzYstRbd+xM6F zn(27g-taO%I335%%3kLGOvkVlbeRXuK={-po;X7tUHDoI#8q5ccjBLaQp~+E7!?Av z#TWR^8ER2B@&bQ1Lk%ui>VnaCY1^3uvDId7f7!=nUsL=&=lJ4TYLQZ2V$Q}*+^68A8ODG(3P*m9|8(eJjivWF zesva(nI)a$mf1LFR^uG6G#kgu9-rmI$xS`Wcg|Kz1jnDn`IS|oRH3CJLTG;>Q_u48 z=as%KT}Hv zLe+|TZj4|z1gT2JD_4~JNQ42`F=4mXkPt-f1(^IKO$S!&4kFyzM{tG(JH-z`;kFDP zHb-sEil67l=fIfl^06Y1^1OzmHARenhB1Eu5#27?p8vE+_$d%d0cUy0g+)2e3*w|f zBqrOhoe~M32115~!Z7lSY`C?32HXp_v1#XckGX1MsdFd+d75X{8ED6!{tKWw_)12# zFvKr(j-Q#UE^F{Hl@#?#d{acb3zKm9y)tbdqhsQFC?07F;wR$fmOs5*j+F)Dw*Lmv zIyeI7c07R(ao3;b`{t>AT?5643WeHwM6{+{twcsA(yao=4N~O}KLm$*Lj*d(Ch~)Z z@fNr6YfGRIi$PEL3V84)?D)AwQo)77)(bdG7gDAv0@acahNw;qV^67`BY4|F&(AF6sCSd)6oP9@?%TX@G4*a zipq<6jnK;CnTw$ZmlSMHP7LzX?D6e3{3Rd4wPTUM-V* zIbrw)#u4AU@73>E`Ih?-Jti#76WJO*YIYv&Q|YU0O-~WEk`G%&+Qox>|8liw@VIa& zz~GjoJW7c9L)=&m#U<@uc>IrQIoIY)VVe&QemvtBGEJLD7@adlx?_c3^c4Fj_;CW_ z2K8%CNW3A1_xTpxkZO!fR5NfK0kE__K$_&L#T^J^8h{Qb3+OLJHbw6OfO@{8}Xw$Y(?;0KhucmY)hj)Amq7bPJ1>%Qc*B zsEXWRJi09$+kQCISwbP(Bm*lWoQc>bsF3nRc_J$q5*QJ*Xv2>tq7@@4Z@yGN{Nd2X z9i-~?R-;236G+NqYaj%&4sFC|@b#|r@9HWXLSl~LyWnJMU+g4B@X}`4 z=A!84uP_vVKSzo)wFVH&;@1;@QS#5X3w|ZUviP5g-wGZp2Qg!Yg2RxbKfFmi8kLcl z%>P`gZg;(aqBu~UxGk4q1-|WsRK%l~N32&zHF{SBK{2U}g_Jer3yg?# zq}m?`fjde~RpCf8=)qz9Fb_7F01I<4L{5`-f$)5f`Je`H`Y7<$svhsy$tFs0}8zzlcfcF;iQ7)gm9&|Eab z0PT%WBsvY8z*|c^B}@vm;UOE<+<}v%h9QOq7+Z4(|8yfJ;>G!xjcW0DjfzT?O)m6W z99}6TlFW&Km}rY>w?9I{EO%sXcwy3?NL?V9Wcc{?jp`mHCttit-J~?;tv0LolwSOE zpBil&wh`UbJmGT=hg>tYwi|hxPhIWW07|sRdj-&%;%o?EKX;Q*KLZ^73H~?YOG2H;)(cOL+rj*vR%zv*CKQy=&#Ddkn6}wpN6&K|os-I7iaWV1FbwvZ=|=1WQkYK_+1A zU}()vAPo{YRq`8*u=EFL*p)w#m)N0Js=PPgUv@R}z^+rk$gWjz@vV#H*zt=x(QR-zHE|u=eslt5J6!s6 z;{!ExhT?4Msl?=`)|8$9*V~oHM^$9&>U%3mCqR%T7$P7d(IA3JNFZTE10n>40mm6Z zp3-#E9TG^o+wKN}Ged{47?wy_3x~ykjw0hg#$hHr2QVx`bcBhhBp^#z!~_CF$a5kO zhxeVTYJ{GD-tYbK`uFQP=R4o2Q_HQcd;8Yy>O<(x?D#6sm?B5DAGNpyeU0+hJ1({+Wx%Rl*^+9s&uU)OmwQDA}`@w?6rx>#+EVy8CYXMx3D_g^M zkzHjb8f!;lGbQuE1nevD2Q}F=jM2IJQFTh?VqL?_I@cgkUuF6dqzle4ShV;J_H0|+ ztvBYpd0XL6U*Tzp)4UtlDt^7k%m{3pK-IV*Z+rIhq7I$gD9>>S|JfbnJw*N!H(OwT zd@5zaDkW`CHxdL^DNhiE5@Pl5<5S0{k?)YYSCH=`O`=X}@yk12l79;jyGgSdLH1+C zZXj|#NUXI4AGz=jk{Ra`HC5-s#-XwSsp}P)L*y7D@q|(y1pVBOo+()m0#!|x`P$jHAj!lTHVfg4D{JtG`M{dXh=f}HcQz$D2ZWWS9h@)SsFzb9DJ zjjA#Rk$WV$ME=MRkr%v3m7+RhqpGtWIBe7o^uY+W#;!VWFY$9UUnY6ghePS;ln&WM zyj}Ba?%TB9m z9hu{aKX0Wz!+vsVo%ePF=+dWjNSy2exai@b)|nrdeI6K+N&(*1ERLjNYg1*`SR!8o zi9b6Ct}go(^`je9zRZW~CY`MzMP@rg+&JP&V|Wf7bF_JXAIW{?0+*sf;*ZIXOYQ*` zvlkWDRmTjj`K?kh!-@Mb0x@WiBi?V3M;`wDRN6Vs&_9UY7i6{&^9dMKKiDaMRpCw( zwKW3g;7nZi1<6MgxsS-@ca+sJ7%_>M!aK^UKn_`pdx@C@2G2(>x+E8`20C@q|DGV5 zex6)@Mwv@v@?MtQv!$uq6j@E={fa!M$kNmmihG|p6Wkbjj9AVhYEkp+bQyRw^(od% zJ~jun+lE4M(5+;8Qw%#`KAO;9nf_4#Q%<=2P>t3P$$gO~y|)wftXO@(9NeyLmNfOt zhlz`m2e4e_vP)A0nNEo<2hF(Lk;+s*4W>$*+0mo}*}A!XAC~Ujs0wQpH#^9+R~#cQ z0FIWqdg8SD(^^&c$ujpOiu`hzICa2`Z5OafTN>F0$qKZapiCXegnxcIXvXy4I!1cU zoC?zw4*jRw3fZs)_bR`)Gx)$v_F;3@#`(9kCHv8bGelRVRi(hLn zvB`ndMEsv|Esa&scGYw~Rx4u|*voK@2A`jrl}6>f249pj0{un-QvXb|8}?2oZW=iJ zIw!^~#KjiA;scsd($ubbCKD?@F?%J>dV(rJzt~yXdx`YN*HfiT3fnT1yy@CWF=4A_ zif=wKha1n&6n#H6dyGAZgLlVvChz|mrPjhmzu2M2oo@eP=eRb`yVLkF8F9*gO_E`2 zhKMzv;sR)tgsD4UMgA_B^vLB!?K%KbZfue$oravjT#A!QJ@wy_#-#`3NAC@3L}#>t zg3kC7vrxl6xImu(Q^W729+MNCo%%i~x#4s$*9H_h7DG(-XnRE_5J}u9{2xha>X}LU zbR-Yk*Hb`dfy9lLcQ-M1=_EbypNR7IfKdzN3%^6QWMpedza8blyP~Y3DBY+G{CK-D zfXgvVCyop9QG&q~^)Mn~w!&COV1<9=;?p@0MN#h<|IO41n6A1cr?j?QV$!DI*{{gbe*sTvpE|NG5TZ-Ka z#Yygj;x1Fq;{(OY^ec02leJ-}bWSbzGxkv=^ah-ba1z{k^A_^X4eYn>yA{8EJ!7}x z|0>fRGW}4dJ7v0Crd2ZCE7SclJs{I+nSLtM&t!U7rZqA>BGWHrdQ_%$GCeNS6YFtS zxD|g&f_j;rmFanzUXW>nOfSl`Nv2n1+APy+GHsFR_cCpj=?$6QlNgGXCTTJSW!$|AeiPSVwA0n+kG$tOaF(0nH@(=Toh_(gxJXimm z^hESN6HT>dwy3#^p9&=w&m>NWplbe(H9`9BWCEqsUCf=sa@;gEd*T;T{|dYA@N0lvKr~s(i#@Fwvlf zSVk>Km1De9m^;hoXJTC~7K&5#(TKffwj=QHHLSuy%Kmr>Mv;0IV{f*kb&blenH_0V zB6KHl@S53$!0BsPU5AvT{Qm1;eu0eb@@C#XSRj9S-Rw1@8WNt^|iO$38vZ-{x78G%B(DY2E|#6yof7nzu$685hL|WB3Ro z_NurshPw>wbusnlJjd{~h$BDeFBrKuDjylkXIqSfRIz0oi1LA=<8yqqQI{^ZJjZi7 zK8{JT8{#z##@>r~ef*|~8_(m!XTRWm0u{0Ru_qXd-Vw_q;1gY?Wwn+yTGnYo^n}FdiMC|FqbFn! z{GWOPS1{4KEB-%vB1Jc}9l9baI*nVzv8lX|72oez8-6xY93RUE2A)LosTX8xF&=`w zASK2_uot96FGzXEc#s(5K}w7VDND4(c#s(5LCTQvfKKSdJE&T+-jFY0@aFzn9C?91 zVWicHj^p|3M&@a;X*}@eGnHq@^9>eb!jGc(MLy6N7a=};5e}Yc@ytZN!6=Fr7bo)F zMn?O}E&l;&)c2^II*A{(7@6^6*kt~5BQrrPpNt$O{VIFe`2~xS_^gP^=Ch6Rv0_m+ zf5*t3D3Tq(X*ThJ1CIEA>0wSt>k4ti$qyKbzZbvDfh^o1vZnB@M(c;7V=nm2DzPaS z1=KZ)Yq|LJvKBEo5B8!=@o64^$VhlrTqE2%Q4~*wEOCpD(;yS(h)vT_)yxHzS@~3< zs;-sKxcC9fvdPwf|1DFlrOei{M9bw`uG8`zEi1JAP|N*V9@er>%d=WGY5BdD>}^$E zl#&6~SsQw2nV@B|mXB*WLd$VlPSnz&rAx~~EsM2WqUCBW%eCAhCBD6E*M{9%R%>}g z%M)5&(6U*}8(MN)UE->kMQa(WWiKrsC0V)b74D8+kzwt&x`=a2KM_{Mmy65mc)Rd2 z=1uF6A_$78R$^ED>;X#X&JeR(cPHc0S_S7vJt0;1&0V#6cL_>uAm2g|k( z@_5}28(U~hVM~n}cCU@?He77Kk!#P-v9bB4kF7Ve*e;%J&u8bjmlcQ6R~Gh#_--DL z3D|6GE3P*13eR?XX4%+ci^J`=u`-K`t+M!#$;RHZI9Zb=-*5M_lZMIaJL0K^qV9|t z-U9q$`fbZJyNz8ZA|6CVAKZM(_Z4_?*)l!fX&W19_htShaoO*5g7SCPp*y4H9Y>@X-==pi8|~FhE?0X~A9L`R&&)kQPzIU*~4w=>+{f@~YBHJmf@@{wb)$pfsu6z5+v z#l|ihNjCNaHov)La8|T}BUjBKN{h}?TJasF_19$jUzAq;E{s_E4;${ub$XpP_IDE( zevUk!Cw-ueeQtWGtv(z3OV})zKiBEcL+OXmkeWYH&hlMhxPpk7?s52O+^ymc_e_^m z*K)f<88`AA_jC;Sce(03_O~#&uw!9a{weH_QK;5U8EQc|0+y{0M-uQLZyeOp2TPQ92iqfhdC@r7g z25Ax2|2PX&?2m?MEyh{9%?$Q-xQ`tR_hw=CVE+tvu^+>yuxk-H?gG|gMTPyj?1t6B ziXyXfo!QfTeoUboqwKyZUiNO3-|u2|Q4B+WTevfy{TU_s*`9DOI~bnN4uxm2FTy#y ziE>c%TuSFr8ek<5%yeb3OW{)-`Ru!Jua8|u$1aghWink!K70mS9^rMd%@HoPJHqGp zvFj-ARkkjokZp?KY>jkXN3O7b0P7A|%cb>gZLNm&WCT7q?DGg#3p%h_^6yLD%g}pG zuvSRpc4>68n-LCn%F4`F*&=Hpd(Y}+)j(b*&=u>g>@6#2J7k8PGOeO)p#KVbrCMkq&ROx z7P76-9Bfl0+Z@U9t6}QhCh~@{GLr3ru~`~hr14dD2zkDMwRLWQd~a&=Ihc#1sP4^? z4)%Q{y9uA7dGcV%v;-;9OQRfYRTNuGhe;A;GF>UtH8Nc%(<-FQn89{Mp~~^<0_4PzyS)lQyXa2gYXWG*J`|7%QC|FUY?-~d`I&==PG_r5aYoF%70wr`V|UaCyWXe z>hj_uaZx}8mTgg=>s}fs&KA!s`8CARpJ4I23eHvG! zDg1YhYp~fO@kcbS@2Cnm9`x_5@L7$UUsCw8#26nLm>4L)_u8TAYlRtRKUslaDIBTs zWXvq&e-B}d_{2@>yI2>^*AG_w{XvY4s>uIgjoEdDhY+TfkHmhe2S#XznhDBbtj3;I zihoh#@=1!PwRNf>!;_FCyc%aNXo)dyshT!)@aFrOkoZla44l%c}-d(T0A$U{> zE(pO3L+~F$@cz4TfSpqYOeX4eDFlBPg8vzUZ-!t)eaLRdvxeYycj0XOyz(vs?xTj_ z-XZwW5S*g$?V&U(1ivhnt>E_$%@4`u4Z(#WI1qxf#h8`c*42()%EJ3Kyi4%L8bA9D z-oF(KSMi6tFNC@X@5Oj8!Mhai*YU 0) stop 'error allocating RP' - read(10,*)(tRc(i),i=1,kmaxRc) - write(*,*)'Rayleigh wave phase velocity used,periods:(s)' - write(*,'(50f6.2)')(tRc(i),i=1,kmaxRc) - write(66,*)'Rayleigh wave phase velocity used,periods:(s)' - write(66,'(50f6.2)')(tRc(i),i=1,kmaxRc) - endif - read(10,*)kmaxRg - if(kmaxRg.gt.0)then - allocate(tRg(kmaxRg), stat=checkstat) - if (checkstat > 0) stop 'error allocating RP' - read(10,*)(tRg(i),i=1,kmaxRg) - write(*,*)'Rayleigh wave group velocity used,periods:(s)' - write(*,'(50f6.2)')(tRg(i),i=1,kmaxRg) - write(66,*)'Rayleigh wave group velocity used,periods:(s)' - write(66,'(50f6.2)')(tRg(i),i=1,kmaxRg) - endif - read(10,*)kmaxLc - if(kmaxLc.gt.0)then - allocate(tLc(kmaxLc), stat=checkstat) - if (checkstat > 0) stop 'error allocating RP' - read(10,*)(tLc(i),i=1,kmaxLc) - write(*,*)'Love wave phase velocity used,periods:(s)' - write(*,'(50f6.2)')(tLc(i),i=1,kmaxLc) - write(66,*)'Love wave phase velocity used,periods:(s)' - write(66,'(50f6.2)')(tLc(i),i=1,kmaxLc) - endif - read(10,*)kmaxLg - if(kmaxLg.gt.0)then - allocate(tLg(kmaxLg), stat=checkstat) - if (checkstat > 0) stop 'error allocating RP' - read(10,*)(tLg(i),i=1,kmaxLg) - write(*,*)'Love wave group velocity used,periods:(s)' - write(*,'(50f6.2)')(tLg(i),i=1,kmaxLg) - write(66,*)'Love wave group velocity used,periods:(s)' - write(66,'(50f6.2)')(tLg(i),i=1,kmaxLg) - endif - read(10,*)ifsyn - read(10,*)noiselevel - read(10,*) threshold0 - close(10) - nrc=nsrc - kmax=kmaxRc+kmaxRg+kmaxLc+kmaxLg + ! READ INPUT FILE + if (iargc() < 1) then + write(*,*) 'input file [DSurfTomo.in(default)]:' + read(*,'(a)') inputfile + if (len_trim(inputfile) <=1 ) then + inputfile = 'DSurfTomo.in' + else + inputfile = inputfile(1:len_trim(inputfile)) + endif + else + call getarg(1,inputfile) + endif + inquire(file = inputfile, exist = ex) + if (.not. ex) stop 'unable to open the inputfile' -! READ MEASUREMENTS - open(unit=87,file=datafile,status='old') - allocate(scxf(nsrc,kmax),sczf(nsrc,kmax),& - rcxf(nrc,nsrc,kmax),rczf(nrc,nsrc,kmax),stat=checkstat) - if(checkstat > 0)then - write(6,*)'error with allocate' - endif - allocate(periods(nsrc,kmax),wavetype(nsrc,kmax),& - nrc1(nsrc,kmax),nsrc1(kmax),& - igrt(nsrc,kmax),stat=checkstat) - if(checkstat > 0)then - write(6,*)'error with allocate' - endif - allocate(obst(nrc*nsrc*kmax),dist(nrc*nsrc*kmax),& - stat=checkstat) - allocate(pvall(nrc*nsrc*kmax),depRp(nrc*nsrc*kmax),& - pvRp(nrc*nsrc*kmax),stat=checkstat) - IF(checkstat > 0)THEN - write(6,*)'error with allocate' - ENDIF - istep=0 - istep2=0 - dall=0 - knumo=12345 - knum=0 - istep1=0 - do - read(87,'(a)',iostat=err) line - if(err.eq.0) then - if(line(1:1).eq.'#') then - read(line,*) str1,sta1_lat,sta1_lon,period,wavetp,veltp - if(wavetp.eq.2.and.veltp.eq.0) knum=period - if(wavetp.eq.2.and.veltp.eq.1) knum=kmaxRc+period - if(wavetp.eq.1.and.veltp.eq.0) knum=kmaxRg+kmaxRc+period - if(wavetp.eq.1.and.veltp.eq.1) knum=kmaxLc+kmaxRg+& - kmaxRc+period - if(knum.ne.knumo) then - istep=0 - istep2=istep2+1 - endif - istep=istep+1 - istep1=0 - sta1_lat=(90.0-sta1_lat)*pi/180.0 - sta1_lon=sta1_lon*pi/180.0 - scxf(istep,knum)=sta1_lat - sczf(istep,knum)=sta1_lon - periods(istep,knum)=period - wavetype(istep,knum)=wavetp - igrt(istep,knum)=veltp - nsrc1(knum)=istep - knumo=knum - else - read(line,*) sta2_lat,sta2_lon,velvalue - istep1=istep1+1 - dall=dall+1 - sta2_lat=(90.0-sta2_lat)*pi/180.0 - sta2_lon=sta2_lon*pi/180.0 - rcxf(istep1,istep,knum)=sta2_lat - rczf(istep1,istep,knum)=sta2_lon - call delsph(sta1_lat,sta1_lon,sta2_lat,sta2_lon,dist1) - dist(dall)=dist1 - obst(dall)=dist1/velvalue - pvall(dall)=velvalue - nrc1(istep,knum)=istep1 - endif - else - exit - endif - enddo - close(87) - allocate(depz(nz), stat=checkstat) - maxnar = spfra*dall*nx*ny*nz!sparsity fraction - maxvp = (nx-2)*(ny-2)*(nz-1) - allocate(dv(maxvp), stat=checkstat) - allocate(norm(maxvp), stat=checkstat) - allocate(vsf(nx,ny,nz), stat=checkstat) - allocate(vsftrue(nx,ny,nz), stat=checkstat) - - allocate(rw(maxnar), stat=checkstat) - if(checkstat > 0)then - write(6,*)'error with allocate: real rw' - endif - allocate(iw(2*maxnar+1), stat=checkstat) - if(checkstat > 0)then - write(6,*)'error with allocate: integer iw' - endif - allocate(col(maxnar), stat=checkstat) - if(checkstat > 0)then - write(6,*)'error with allocate: integer iw' - endif - allocate(cbst(dall+maxvp),dsyn(dall),datweight(dall),wt(dall+maxvp),dtres(dall+maxvp),& - stat=checkstat) + open(10,file=inputfile,status='old') + read(10,'(a30)')dummy + read(10,'(a30)')dummy + read(10,'(a30)')dummy + read(10,*)datafile + read(10,*) nx,ny,nz + read(10,*) goxd,gozd + read(10,*) dvxd,dvzd + read(10,*) nsrc + read(10,*) weight0,damp + read(10,*) minthk + read(10,*) Minvel,Maxvel + read(10,*) maxiter + read(10,*) spfra + read(10,*) kmaxRc + write(*,*) 'model origin:latitude,longitue' + write(*,'(2f10.4)') goxd,gozd + write(*,*) 'grid spacing:latitude,longitue' + write(*,'(2f10.4)') dvxd,dvzd + write(*,*) 'model dimension:nx,ny,nz' + write(*,'(3i5)') nx,ny,nz + write(logfile,'(a,a)')trim(inputfile),'.log' + open(66,file=logfile) + write(66,*) + write(66,*),' S U R F T O M O' + write(66,*),'PLEASE contact Hongjain Fang & + (fanghj@mail.ustc.edu.cn) if you find any bug' + write(66,*) + write(66,*) 'model origin:latitude,longitue' + write(66,'(2f10.4)') goxd,gozd + write(66,*) 'grid spacing:latitude,longitue' + write(66,'(2f10.4)') dvxd,dvzd + write(66,*) 'model dimension:nx,ny,nz' + write(66,'(3i5)') nx,ny,nz + if(kmaxRc.gt.0)then + allocate(tRc(kmaxRc),& + stat=checkstat) + if (checkstat > 0) stop 'error allocating RP' + read(10,*)(tRc(i),i=1,kmaxRc) + write(*,*)'Rayleigh wave phase velocity used,periods:(s)' + write(*,'(50f6.2)')(tRc(i),i=1,kmaxRc) + write(66,*)'Rayleigh wave phase velocity used,periods:(s)' + write(66,'(50f6.2)')(tRc(i),i=1,kmaxRc) + endif + read(10,*)kmaxRg + if(kmaxRg.gt.0)then + allocate(tRg(kmaxRg), stat=checkstat) + if (checkstat > 0) stop 'error allocating RP' + read(10,*)(tRg(i),i=1,kmaxRg) + write(*,*)'Rayleigh wave group velocity used,periods:(s)' + write(*,'(50f6.2)')(tRg(i),i=1,kmaxRg) + write(66,*)'Rayleigh wave group velocity used,periods:(s)' + write(66,'(50f6.2)')(tRg(i),i=1,kmaxRg) + endif + read(10,*)kmaxLc + if(kmaxLc.gt.0)then + allocate(tLc(kmaxLc), stat=checkstat) + if (checkstat > 0) stop 'error allocating RP' + read(10,*)(tLc(i),i=1,kmaxLc) + write(*,*)'Love wave phase velocity used,periods:(s)' + write(*,'(50f6.2)')(tLc(i),i=1,kmaxLc) + write(66,*)'Love wave phase velocity used,periods:(s)' + write(66,'(50f6.2)')(tLc(i),i=1,kmaxLc) + endif + read(10,*)kmaxLg + if(kmaxLg.gt.0)then + allocate(tLg(kmaxLg), stat=checkstat) + if (checkstat > 0) stop 'error allocating RP' + read(10,*)(tLg(i),i=1,kmaxLg) + write(*,*)'Love wave group velocity used,periods:(s)' + write(*,'(50f6.2)')(tLg(i),i=1,kmaxLg) + write(66,*)'Love wave group velocity used,periods:(s)' + write(66,'(50f6.2)')(tLg(i),i=1,kmaxLg) + endif + read(10,*)ifsyn + read(10,*)noiselevel + read(10,*) threshold0 + read(10,*) modest + read(10,*) numrand + close(10) + nrc=nsrc + kmax=kmaxRc+kmaxRg+kmaxLc+kmaxLg -! MEASUREMENTS STATISTICS AND READ INITIAL MODEL - write(*,'(a,i7)') 'Number of all measurements',dall + ! READ MEASUREMENTS + open(unit=87,file=datafile,status='old') + allocate(scxf(nsrc,kmax),sczf(nsrc,kmax),& + rcxf(nrc,nsrc,kmax),rczf(nrc,nsrc,kmax),stat=checkstat) + if(checkstat > 0)then + write(6,*)'error with allocate' + endif + allocate(periods(nsrc,kmax),wavetype(nsrc,kmax),& + nrc1(nsrc,kmax),nsrc1(kmax),& + igrt(nsrc,kmax),stat=checkstat) + if(checkstat > 0)then + write(6,*)'error with allocate' + endif + allocate(obst(nrc*nsrc*kmax),dist(nrc*nsrc*kmax),& + stat=checkstat) + allocate(pvall(nrc*nsrc*kmax),depRp(nrc*nsrc*kmax),& + pvRp(nrc*nsrc*kmax),stat=checkstat) + IF(checkstat > 0)THEN + write(6,*)'error with allocate' + ENDIF + istep=0 + istep2=0 + dall=0 + knumo=12345 + knum=0 + istep1=0 + do + read(87,'(a)',iostat=err) line + if(err.eq.0) then + if(line(1:1).eq.'#') then + read(line,*) str1,sta1_lat,sta1_lon,period,wavetp,veltp + if(wavetp.eq.2.and.veltp.eq.0) knum=period + if(wavetp.eq.2.and.veltp.eq.1) knum=kmaxRc+period + if(wavetp.eq.1.and.veltp.eq.0) knum=kmaxRg+kmaxRc+period + if(wavetp.eq.1.and.veltp.eq.1) knum=kmaxLc+kmaxRg+& + kmaxRc+period + if(knum.ne.knumo) then + istep=0 + istep2=istep2+1 + endif + istep=istep+1 + istep1=0 + sta1_lat=(90.0-sta1_lat)*pi/180.0 + sta1_lon=sta1_lon*pi/180.0 + scxf(istep,knum)=sta1_lat + sczf(istep,knum)=sta1_lon + periods(istep,knum)=period + wavetype(istep,knum)=wavetp + igrt(istep,knum)=veltp + nsrc1(knum)=istep + knumo=knum + else + read(line,*) sta2_lat,sta2_lon,velvalue + istep1=istep1+1 + dall=dall+1 + sta2_lat=(90.0-sta2_lat)*pi/180.0 + sta2_lon=sta2_lon*pi/180.0 + rcxf(istep1,istep,knum)=sta2_lat + rczf(istep1,istep,knum)=sta2_lon + call delsph(sta1_lat,sta1_lon,sta2_lat,sta2_lon,dist1) + dist(dall)=dist1 + obst(dall)=dist1/velvalue + pvall(dall)=velvalue + nrc1(istep,knum)=istep1 + endif + else + exit + endif + enddo + close(87) + allocate(depz(nz), stat=checkstat) + maxnar = spfra*dall*nx*ny*nz!sparsity fraction + maxvp = (nx-2)*(ny-2)*(nz-1) + allocate(dv(maxvp), stat=checkstat) + allocate(norm(maxvp), stat=checkstat) + allocate(vsf(nx,ny,nz), stat=checkstat) + allocate(vsftrue(nx,ny,nz), stat=checkstat) + ! FOR MODEL VARIATION + !------------------------------------------------ + allocate(modstat(numrand,maxvp)) + allocate(modsig(maxvp)) - open(10,file='MOD',status='old') - read(10,*) (depz(i),i=1,nz) - do k = 1,nz - do j = 1,ny - read(10,*)(vsf(i,j,k),i=1,nx) - enddo - enddo - close(10) - write(*,*) 'grid points in depth direction:(km)' - write(*,'(50f6.2)') depz + allocate(rw(maxnar), stat=checkstat) + if(checkstat > 0)then + write(6,*)'error with allocate: real rw' + endif + allocate(iw(2*maxnar+1), stat=checkstat) + if(checkstat > 0)then + write(6,*)'error with allocate: integer iw' + endif + allocate(col(maxnar), stat=checkstat) + if(checkstat > 0)then + write(6,*)'error with allocate: integer iw' + endif + allocate(cbst(dall+maxvp),dsyn(dall),datweight(dall),wt(dall+maxvp),dtres(dall+maxvp),& + stat=checkstat) + + ! MEASUREMENTS STATISTICS AND READ INITIAL MODEL + write(*,'(a,i7)') 'Number of all measurements',dall + + open(10,file='MOD',status='old') + read(10,*) (depz(i),i=1,nz) + do k = 1,nz + do j = 1,ny + read(10,*)(vsf(i,j,k),i=1,nx) + enddo + enddo + close(10) + write(*,*) 'grid points in depth direction:(km)' + write(*,'(50f6.2)') depz -! CHECKERBOARD TEST - if (ifsyn == 1) then - write(*,*) 'Checkerboard Resolution Test Begin' - vsftrue = vsf + ! CHECKERBOARD TEST + if (ifsyn == 1) then + write(*,*) 'Checkerboard Resolution Test Begin' + vsftrue = vsf - open(11,file='MOD.true',status='old') - do k = 1,nz - do j = 1,ny - read(11,*) (vsftrue(i,j,k),i=1,nx) - enddo - enddo - close(11) + open(11,file='MOD.true',status='old') + do k = 1,nz + do j = 1,ny + read(11,*) (vsftrue(i,j,k),i=1,nx) + enddo + enddo + close(11) - call synthetic(nx,ny,nz,maxvp,vsftrue,obst,& - goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,& - tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,& - scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,& - nsrc,nrc,noiselevel) - endif + call synthetic(nx,ny,nz,maxvp,vsftrue,obst,& + goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,& + tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,& + scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,& + nsrc,nrc,noiselevel) + endif -! ITERATE UNTILL CONVERGE - writepath = 0 - do iter = 1,maxiter - iw = 0 - rw = 0.0 - col = 0 + ! ITERATE UNTILL CONVERGE + writepath = 0 + do iter = 1,maxiter + iw = 0 + rw = 0.0 + col = 0 -! COMPUTE SENSITIVITY MATRIX - if (iter == maxiter) then - writepath = 1 - open(40,file='raypath.out') - endif - write(*,*) 'computing sensitivity matrix...' - call CalSurfG(nx,ny,nz,maxvp,vsf,iw,rw,col,dsyn,& - goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,& - tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,& - scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,& - nsrc,nrc,nar,writepath) + ! COMPUTE SENSITIVITY MATRIX + if (iter == maxiter) then + writepath = 1 + open(40,file='raypath.out') + endif + write(*,*) 'computing sensitivity matrix...' + call CalSurfG(nx,ny,nz,maxvp,vsf,iw,rw,col,dsyn,& + goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,& + tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,& + scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,& + nsrc,nrc,nar,writepath) - do i = 1,dall - cbst(i) = obst(i) - dsyn(i) - enddo + do i = 1,dall + cbst(i) = obst(i) - dsyn(i) + enddo - threshold = threshold0+(maxiter/2-iter)/3*0.5 - do i = 1,dall - datweight(i) = 1.0 - if(abs(cbst(i)) > threshold) then - datweight(i) = exp(-(abs(cbst(i))-threshold)) - endif - cbst(i) = cbst(i)*datweight(i) - enddo + threshold = threshold0+(maxiter/2-iter)/3*0.5 + do i = 1,dall + datweight(i) = 1.0 + if(abs(cbst(i)) > threshold) then + datweight(i) = exp(-(abs(cbst(i))-threshold)) + endif + cbst(i) = cbst(i)*datweight(i) + enddo - do i = 1,nar - rw(i) = rw(i)*datweight(iw(1+i)) - enddo - - norm=0 - do i=1,nar - norm(col(i))=norm(col(i))+abs(rw(i)) - enddo - averdws=0 - maxnorm=0 - do i=1,maxvp - averdws = averdws+norm(i) - if(norm(i)>maxnorm) maxnorm=norm(i) - enddo - averdws=averdws/maxvp - write(66,*)'Maximum and Average DWS values:',maxnorm,averdws - write(66,*)'Threshold is:',threshold - -! WRITE OUT RESIDUAL FOR THE FIRST AND LAST ITERATION - if(iter.eq.1) then - open(88,file='residualFirst.dat') - do i=1,dall - write(88,*) dist(i),dsyn(i),obst(i), & - dsyn(i)*datweight(i),obst(i)*datweight(i),datweight(i) - enddo - close(88) - endif - if(iter.eq.maxiter) then - open(88,file='residualLast.dat') - do i=1,dall - write(88,*) dist(i),dsyn(i),obst(i), & - dsyn(i)*datweight(i),obst(i)*datweight(i),datweight(i) - enddo - close(88) - endif - - -! ADDING REGULARIZATION TERM - weight=dnrm2(dall,cbst,1)**2/dall*weight0 - nar_tmp=nar - nars=0 + do i = 1,nar + rw(i) = rw(i)*datweight(iw(1+i)) + enddo - count3=0 - nvz=ny-2 - nvx=nx-2 - do k=1,nz-1 - do j=1,nvz - do i=1,nvx - if(i==1.or.i==nvx.or.j==1.or.j==nvz.or.k==1.or.k==nz-1)then - count3=count3+1 - col(nar+1)=(k-1)*nvz*nvx+(j-1)*nvx+i - rw(nar+1)=2.0*weight - iw(1+nar+1)=dall+count3 - cbst(dall+count3)=0 - nar=nar+1 - else - count3=count3+1 - col(nar+1)=(k-1)*nvz*nvx+(j-1)*nvx+i - rw(nar+1)=6.0*weight - iw(1+nar+1)=dall+count3 - rw(nar+2)=-1.0*weight - iw(1+nar+2)=dall+count3 - col(nar+2)=(k-1)*nvz*nvx+(j-1)*nvx+i-1 - rw(nar+3)=-1.0*weight - iw(1+nar+3)=dall+count3 - col(nar+3)=(k-1)*nvz*nvx+(j-1)*nvx+i+1 - rw(nar+4)=-1.0*weight - iw(1+nar+4)=dall+count3 - col(nar+4)=(k-1)*nvz*nvx+(j-2)*nvx+i - rw(nar+5)=-1.0*weight - iw(1+nar+5)=dall+count3 - col(nar+5)=(k-1)*nvz*nvx+j*nvx+i - rw(nar+6)=-1.0*weight - iw(1+nar+6)=dall+count3 - col(nar+6)=(k-2)*nvz*nvx+(j-1)*nvx+i - rw(nar+7)=-1.0*weight - iw(1+nar+7)=dall+count3 - col(nar+7)=k*nvz*nvx+(j-1)*nvx+i - cbst(dall+count3)=0 - nar=nar+7 - endif - enddo - enddo - enddo - m = dall + count3 - n = maxvp - - iw(1)=nar - do i=1,nar - iw(1+nar+i)=col(i) - enddo - if (nar > maxnar) stop 'increase sparsity fraction(spfra)' + norm=0 + do i=1,nar + norm(col(i))=norm(col(i))+abs(rw(i)) + enddo + averdws=0 + maxnorm=0 + do i=1,maxvp + averdws = averdws+norm(i) + if(norm(i)>maxnorm) maxnorm=norm(i) + enddo + averdws=averdws/maxvp + write(66,*)'Maximum and Average DWS values:',maxnorm,averdws + write(66,*)'Threshold is:',threshold -! CALLING IRLS TO SOLVE THE PROBLEM - - leniw = 2*nar+1 - lenrw = nar - dv = 0 - atol = 1e-3 - btol = 1e-3 - conlim = 1200 - itnlim = 1000 - istop = 0 - anorm = 0.0 - acond = 0.0 - arnorm = 0.0 - xnorm = 0.0 - localSize = n/4 - - call LSMR(m, n, leniw, lenrw,iw,rw,cbst, damp,& - atol, btol, conlim, itnlim, localSize, nout,& - dv, istop, itn, anorm, acond, rnorm, arnorm, xnorm) - if(istop==3) print*,'istop = 3, large condition number' + ! WRITE OUT RESIDUAL FOR THE FIRST AND LAST ITERATION + if(iter.eq.1) then + open(88,file='residualFirst.dat') + do i=1,dall + write(88,*) dist(i),dsyn(i),obst(i), & + dsyn(i)*datweight(i),obst(i)*datweight(i),datweight(i) + enddo + close(88) + endif + if(iter.eq.maxiter) then + open(88,file='residualLast.dat') + do i=1,dall + write(88,*) dist(i),dsyn(i),obst(i), & + dsyn(i)*datweight(i),obst(i)*datweight(i),datweight(i) + enddo + close(88) + endif - mean = sum(cbst(1:dall))/dall - std_devs = sqrt(sum(cbst(1:dall)**2)/dall - mean**2) - write(*,'(i2,a)'),iter,'th iteration...' - write(*,'(a,f7.3)'),'weight is:',weight - write(*,'(a,f8.1,a,f8.2,a,f8.3)'),'mean,std_devs and rms of & - residual: ',mean*1000,'ms ',1000*std_devs,'ms ',& - dnrm2(dall,cbst,1)/sqrt(real(dall)) - write(66,'(i2,a)'),iter,'th iteration...' - write(66,'(a,f7.3)'),'weight is:',weight - write(66,'(a,f8.1,a,f8.2,a,f8.3)'),'mean,std_devs and rms of & - residual: ',mean*1000,'ms ',1000*std_devs,'ms ',& - dnrm2(dall,cbst,1)/sqrt(real(dall)) + ! ADDING REGULARIZATION TERM + weight=dnrm2(dall,cbst,1)**2/dall*weight0 + nar_tmp=nar + nars=0 - write(*,'(a,2f7.4)'),'min and max velocity variation ',& - minval(dv),maxval(dv) - write(66,'(a,2f7.4)'),'min and max velocity variation ',& - minval(dv),maxval(dv) + count3=0 + nvz=ny-2 + nvx=nx-2 + do k=1,nz-1 + do j=1,nvz + do i=1,nvx + if(i==1.or.i==nvx.or.j==1.or.j==nvz.or.k==1.or.k==nz-1)then + count3=count3+1 + col(nar+1)=(k-1)*nvz*nvx+(j-1)*nvx+i + rw(nar+1)=2.0*weight + iw(1+nar+1)=dall+count3 + cbst(dall+count3)=0 + nar=nar+1 + else + count3=count3+1 + col(nar+1)=(k-1)*nvz*nvx+(j-1)*nvx+i + rw(nar+1)=6.0*weight + iw(1+nar+1)=dall+count3 + rw(nar+2)=-1.0*weight + iw(1+nar+2)=dall+count3 + col(nar+2)=(k-1)*nvz*nvx+(j-1)*nvx+i-1 + rw(nar+3)=-1.0*weight + iw(1+nar+3)=dall+count3 + col(nar+3)=(k-1)*nvz*nvx+(j-1)*nvx+i+1 + rw(nar+4)=-1.0*weight + iw(1+nar+4)=dall+count3 + col(nar+4)=(k-1)*nvz*nvx+(j-2)*nvx+i + rw(nar+5)=-1.0*weight + iw(1+nar+5)=dall+count3 + col(nar+5)=(k-1)*nvz*nvx+j*nvx+i + rw(nar+6)=-1.0*weight + iw(1+nar+6)=dall+count3 + col(nar+6)=(k-2)*nvz*nvx+(j-1)*nvx+i + rw(nar+7)=-1.0*weight + iw(1+nar+7)=dall+count3 + col(nar+7)=k*nvz*nvx+(j-1)*nvx+i + cbst(dall+count3)=0 + nar=nar+7 + endif + enddo + enddo + enddo + m = dall + count3 + n = maxvp - do k=1,nz-1 - do j=1,ny-2 + iw(1)=nar + do i=1,nar + iw(1+nar+i)=col(i) + enddo + if (nar > maxnar) stop 'increase sparsity fraction(spfra)' + + ! CALLING IRLS TO SOLVE THE PROBLEM + + leniw = 2*nar+1 + lenrw = nar + dv = 0 + atol = 1e-3 + btol = 1e-3 + conlim = 1200 + itnlim = 1000 + istop = 0 + anorm = 0.0 + acond = 0.0 + arnorm = 0.0 + xnorm = 0.0 + localSize = n/4 + + call LSMR(m, n, leniw, lenrw,iw,rw,cbst, damp,& + atol, btol, conlim, itnlim, localSize, nout,& + dv, istop, itn, anorm, acond, rnorm, arnorm, xnorm) + if(istop==3) print*,'istop = 3, large condition number' + + + do i =1,dall + cbst(i)=cbst(i)/datweight(i) + enddo + + mean = sum(cbst(1:dall))/dall + std_devs = sqrt(sum(cbst(1:dall)**2)/dall - mean**2) + write(*,'(i2,a)'),iter,'th iteration...' + write(*,'(a,f7.3)'),'weight is:',weight + write(*,'(a,f8.1,a,f8.2,a,f8.3)'),'mean,std_devs and rms of & + residual: ',mean*1000,'ms ',1000*std_devs,'ms ',& + dnrm2(dall,cbst,1)/sqrt(real(dall)) + write(66,'(i2,a)'),iter,'th iteration...' + write(66,'(a,f7.3)'),'weight is:',weight + write(66,'(a,f8.1,a,f8.2,a,f8.3)'),'mean,std_devs and rms of & + residual: ',mean*1000,'ms ',1000*std_devs,'ms ',& + dnrm2(dall,cbst,1)/sqrt(real(dall)) + + write(*,'(a,2f7.4)'),'min and max velocity variation ',& + minval(dv),maxval(dv) + write(66,'(a,2f7.4)'),'min and max velocity variation ',& + minval(dv),maxval(dv) + + do k=1,nz-1 + do j=1,ny-2 do i=1,nx-2 - if(dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i).ge.0.500) then - dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i)=0.500 - endif - if(dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i).le.-0.500) then - dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i)=-0.500 - endif - vsf(i+1,j+1,k)=vsf(i+1,j+1,k)+dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i) - if(vsf(i+1,j+1,k).lt.Minvel) vsf(i+1,j+1,k)=Minvel - if(vsf(i+1,j+1,k).gt.Maxvel) vsf(i+1,j+1,k)=Maxvel + if(dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i).ge.0.500) then + dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i)=0.500 + endif + if(dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i).le.-0.500) then + dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i)=-0.500 + endif + vsf(i+1,j+1,k)=vsf(i+1,j+1,k)+dv((k-1)*(nx-2)*(ny-2)+(j-1)*(nx-2)+i) + if(vsf(i+1,j+1,k).lt.Minvel) vsf(i+1,j+1,k)=Minvel + if(vsf(i+1,j+1,k).gt.Maxvel) vsf(i+1,j+1,k)=Maxvel enddo - enddo - enddo - write(34,*)',OUTPUT S VELOCITY AT ITERATION',iter - do k=1,nz - do j=1,ny + enddo + enddo + write(34,*)'OUTPUT S VELOCITY AT ITERATION',iter + do k=1,nz + do j=1,ny write(34,'(100f7.3)') (vsf(i,j,k),i=1,nx) - enddo - enddo - write(34,*)',OUTPUT DWS AT ITERATION',iter - do k=1,nz-1 - do j=2,ny-1 + enddo + enddo + write(34,*)',OUTPUT DWS AT ITERATION',iter + do k=1,nz-1 + do j=2,ny-1 write(34,'(100f8.1)') (norm((k-1)*(ny-2)*(nx-2)+(j-2)*(nx-2)+i-1),i=2,nx-1) - enddo - enddo + enddo + enddo - enddo !end iteration + enddo !end iteration -! OUTPUT THE VELOCITY MODEL - - write(*,*),'Program finishes successfully' - write(66,*),'Program finishes successfully' + ! OUTPUT THE VELOCITY MODEL - if(ifsyn == 1) then - open(65,file='Vs_model.real') - write(outsyn,'(a,a)') trim(inputfile),'Syn.dat' - open(63,file=outsyn) - do k=1,nz-1 - do j=1,ny-2 + write(*,*),'Program finishes successfully' + write(66,*),'Program finishes successfully' + + if(ifsyn == 1) then + open(65,file='Vs_model.real') + write(outsyn,'(a,a)') trim(inputfile),'Syn.dat' + open(63,file=outsyn) + do k=1,nz-1 + do j=1,ny-2 do i=1,nx-2 - write(65,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsftrue(i,j,k) - write(63,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i,j,k) + write(65,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsftrue(i+1,j+1,k) + write(63,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i+1,j+1,k) enddo - enddo - enddo - close(65) - close(63) - write(*,*),'Output True velocity model & - to Vs_model.real' - write(*,*),'Output inverted shear velocity model & - to ',outsyn - write(66,*),'Output True velocity model & - to Vs_model.real' - write(66,*),'Output inverted shear velocity model & - to ',outsyn - else - write(outmodel,'(a,a)') trim(inputfile),'Measure.dat' - open(64,file=outmodel) - do k=1,nz-1 - do j=1,ny-2 + enddo + enddo + close(65) + close(63) + write(*,*),'Output True velocity model & + to Vs_model.real' + write(*,*),'Output inverted shear velocity model & + to ',outsyn + write(66,*),'Output True velocity model & + to Vs_model.real' + write(66,*),'Output inverted shear velocity model & + to ',outsyn + else + write(outmodel,'(a,a)') trim(inputfile),'Measure.dat' + open(64,file=outmodel) + do k=1,nz-1 + do j=1,ny-2 do i=1,nx-2 - write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i,j,k) + write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i+1,j+1,k) enddo - enddo - enddo - close(64) - write(*,*),'Output inverted shear velocity model & - to ',outmodel - write(66,*),'Output inverted shear velocity model & - to ',outmodel - endif + enddo + enddo + close(64) + write(*,*),'Output inverted shear velocity model & + to ',outmodel + write(66,*),'Output inverted shear velocity model & + to ',outmodel + endif - close(34) - close(40) - close(nout) !close lsmr.txt - close(66) !close surf_tomo.log - deallocate(obst) - deallocate(dsyn) - deallocate(dist) - deallocate(depz) - deallocate(scxf,sczf) - deallocate(rcxf,rczf) - deallocate(wavetype,igrt,nrc1) - deallocate(nsrc1,periods) - deallocate(rw) - deallocate(iw,col) - deallocate(cbst,wt,dtres,datweight) - deallocate(dv) - deallocate(norm) - deallocate(vsf) - deallocate(vsftrue) - if(kmaxRc.gt.0) then - deallocate(tRc) - endif - if(kmaxRg.gt.0) then - deallocate(tRg) - endif - if(kmaxLc.gt.0) then - deallocate(tLc) - endif - if(kmaxLg.gt.0) then - deallocate(tLg) - endif + close(34) + close(40) + close(nout) !close lsmr.txt + close(66) !close surf_tomo.log - end program +! USE RANDOM MODEL TO OBTAIN THE MODEL VARIATION + !modest = 1 + if (modest ==1) then + + write(*,*) 'model variation estimation begin...' + do iter = 1,numrand + call init_random_seed() + vsftrue=vsf + DO K=1,NZ-1 + DO J=2,NY-1 + DO I=2,NX-1 + idx = (k-1)*(ny-2)*(nx-2)+(j-2)*(nx-2)+i-1 + dv(idx) = 0.1/EXP(2*NORM(idx)/maxnorm)*gaussian() + VSFTRUE(I,J,K) = VSF(I,J,K)+dv(idx) + ENDDO + ENDDO + ENDDO + write(*,*),'maximum and minimum velocity variation',maxval(dv),minval(dv) + + call synthetic(nx,ny,nz,maxvp,vsftrue,dsyn,& + goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,& + tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,& + scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,& + nsrc,nrc,0.0) + + do i = 1,dall + cbst(i) = obst(i) - dsyn(i) + enddo + + write(*,*), dnrm2(dall,cbst,1)/sqrt(real(dall)), 1.05*std_devs + if (dnrm2(dall,cbst,1)/sqrt(real(dall)) < 1.05*std_devs) then + counte = counte + 1 + modstat(counte,:) = dv + endif + + enddo ! iteration for random models + + write(*,*),'number of of models satisfy requirements',counte + modsig = 1.0 + if (counte>0) then + do i=1,maxvp + !statis + !mean = sum(cbst(1:dall))/dall + !std_devs = sqrt(sum(cbst(1:dall)**2)/dall - mean**2) + mean = sum(modstat(1:counte,i))/counte + stdvs = sqrt(sum(modstat(1:counte,i)**2)/counte-mean**2) + modsig(i) = stdvs + enddo + endif + + write(*,*),'write model variation to "model_variation.dat"' + open (64,file='model_variation.dat') + do k=1,nz-1 + do j=1,ny-2 + do i=1,nx-2 + idx = (k-1)*(ny-2)*(nx-2)+(j-1)*(nx-2)+i + write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),modsig(idx) + enddo + enddo + enddo + close(64) + write(*,*) 'finishing model variation estimation' + endif + + + + deallocate(obst) + deallocate(dsyn) + deallocate(dist) + deallocate(depz) + deallocate(scxf,sczf) + deallocate(rcxf,rczf) + deallocate(wavetype,igrt,nrc1) + deallocate(nsrc1,periods) + deallocate(rw) + deallocate(iw,col) + deallocate(cbst,wt,dtres,datweight) + deallocate(dv) + deallocate(norm) + deallocate(vsf) + deallocate(vsftrue) + if(kmaxRc.gt.0) then + deallocate(tRc) + endif + if(kmaxRg.gt.0) then + deallocate(tRg) + endif + if(kmaxLc.gt.0) then + deallocate(tLc) + endif + if(kmaxLg.gt.0) then + deallocate(tLg) + endif + +end program + + + +!----------------------------------------------------------------------- +! Generate seed for random number generator of fortran +! Note: only need to be called once inside one program +!----------------------------------------------------------------------- +subroutine init_random_seed() + integer :: i,n,clock + integer,dimension(:),allocatable :: seed + call random_seed(size=n) + allocate(seed(n)) + call system_clock(count=clock) + seed=clock+37*(/(i-1,i=1,n)/) + call random_seed(PUT=seed) + deallocate(seed) +end subroutine