[cig-commits] r16191 - in seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate: . PLOTTING matlab matlab/matlab_scripts src
carltape at geodynamics.org
carltape at geodynamics.org
Thu Jan 28 09:37:39 PST 2010
Author: carltape
Date: 2010-01-28 09:37:35 -0800 (Thu, 28 Jan 2010)
New Revision: 16191
Added:
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/axes_expand.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/colors.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/cpt2cmap.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/curvature.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/diff_files.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/fontsize.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/gcvfctn.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/genfit.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/griddataXB.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/linefit.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ocv_carl.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_min_4.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_shift.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ridge_carl.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/theoryHyp.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cell2gll.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cg.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gll2cell.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gnorm_sq.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_m_gll2cell.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_splitm.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_grad.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_src.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_str.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wysiwyg.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_run.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m
Removed:
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/axes_expand.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/colors.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/cpt2cmap.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/curvature.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/fontsize.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/gcvfctn.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/genfit.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/griddataXB.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/linefit.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ocv_carl.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_min_4.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_shift.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ridge_carl.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/theoryHyp.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_test.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wysiwyg.m
Modified:
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/PLOTTING/plot_surf_model_all.pl
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/README
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex00.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex01.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex02.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex03.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex04.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex05.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex06.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex07.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex08.f90
seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_sub.f90
Log:
Added matlab scripts to perform conjugate gradient optimization separate from the f90 wave propagation code. Numerous matlab functions were moved into a sub-directory.
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/PLOTTING/plot_surf_model_all.pl
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/PLOTTING/plot_surf_model_all.pl 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/PLOTTING/plot_surf_model_all.pl 2010-01-28 17:37:35 UTC (rev 16191)
@@ -330,18 +330,18 @@
$psfile2 = "$name2.ps";
$jpgfile2 = "$name2.jpg";
-# write plotting scripts
-$wid = $wid2;
-$J1 = "-JM${wid}i"; # in lat-lon
-$origin = "-X1 -Y7.25";
-$Dlen = 1.5; $Dx = $wid/2; $Dy = -0.35;
-$Dscale1 = "-D$Dx/$Dy/$Dlen/0.15h";
-$Bscale1 = sprintf("-B%2.2e:\" Perturbation from %3.3f km s\@+-1\@+ \": -E10p",$ptick,$beta0/1000);
-$Bscale2 = sprintf("-B%2.2e:\" Perturbation from $stmodp \": -E10p",$ptick);
-$Bscale3 = sprintf("-B%2.2e:\" Perturbation from mtar\": -E10p",$ptick);
-$xlab = $wid/2;
-$ylab = -0.02*$wid;
-$olab = "-Xa$xlab -Ya$ylab";
+ # write plotting scripts
+ $wid = $wid2;
+ $J1 = "-JM${wid}i"; # in lat-lon
+ $origin = "-X1 -Y7.25";
+ $Dlen = 1.5; $Dx = $wid/2; $Dy = -0.35;
+ $Dscale1 = "-D$Dx/$Dy/$Dlen/0.15h";
+ $Bscale1 = sprintf("-B%2.2e:\" Perturbation from %3.3f km s\@+-1\@+ \": -E10p",$ptick,$beta0/1000);
+ $Bscale2 = sprintf("-B%2.2e:\" Perturbation from $stmodp \": -E10p",$ptick);
+ $Bscale3 = sprintf("-B%2.2e:\" Perturbation from mtar\": -E10p",$ptick);
+ $xlab = $wid/2;
+ $ylab = -0.02*$wid;
+ $olab = "-Xa$xlab -Ya$ylab";
# nine subplots
@files0 = ("$dir1p/${mfile_syn}","$dir1p/${mfile_syn}","$dir1p/${mfile_syn}",
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/README
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/README 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/README 2010-01-28 17:37:35 UTC (rev 16191)
@@ -98,8 +98,8 @@
Examine ofile for details.
The misfit values are given in these files:
OUTPUT/run_0000/chi.dat 100.1837219688
- OUTPUT/run_0001/chi.dat 75.2856269798
- OUTPUT/run_0002/chi.dat 31.8072588982
+ OUTPUT/run_0001/chi.dat 75.2034179848
+ OUTPUT/run_0002/chi.dat 31.7804791149
------------------
EXAMPLE 1 (run_0100)
@@ -139,8 +139,8 @@
EXAMPLE 3 (run_0300)
Make the following modifications to src/wave2d_constants.f90
IRUNZ = 200 --> IRUNZ = 300
- PERT_STRUCT_BETA = 1 --> PERT_STRUCT_BETA = 1
- INV_STRUCT_BETA = 1 --> INV_STRUCT_BETA = 1
+ PERT_STRUCT_BETA = 0 --> PERT_STRUCT_BETA = 1
+ INV_STRUCT_BETA = 0 --> INV_STRUCT_BETA = 1
Then compile and execute:
make clean ; make wave2d ; wave2d
Follow steps from Example 1 to make figures.
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/axes_expand.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/axes_expand.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/axes_expand.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,50 +0,0 @@
-%
-% function ax1 = axes_expand(ax0,fac)
-% CARL TAPE, 16-Aug-2005
-% printed xxx
-%
-% This function inputs an axes box and outputs a new axes box,
-% expanded by the factor 'fac' in all 2,4,6 dimensions.
-%
-% EXAMPLE:
-% ax0 = [-121 -114]; ax1 = axes_expand(ax0,2)
-% ax0 = [-121 -114 31 37]; ax1 = axes_expand(ax0,2)
-% ax0 = [-121 -114 31 37]; ax1 = axes_expand(ax0,0.30)
-%
-% calls xxx
-% called by xxx
-%
-
-function ax1 = axes_expand(ax0,fac)
-
-% 1D, 2D, 3D
-ndim = length(ax0)/2;
-ax1 = zeros(1,ndim*2);
-
-% return original axes if new axes are non-sensical
-
-xmin = ax0(1);
-xmax = ax0(2);
-dx = xmax-xmin;
-ax1(1) = xmin - dx*(fac-1);
-ax1(2) = xmax + dx*(fac-1);
-if ax1(2) <= ax1(1), ax1 = ax0; end
-
-if ndim >= 2
- ymin = ax0(3);
- ymax = ax0(4);
- dy = ymax-ymin;
- ax1(3) = ymin - dy*(fac-1);
- ax1(4) = ymax + dy*(fac-1);
- if ax1(4) <= ax1(3), ax1 = ax0; end
-end
-if ndim == 3
- zmin = ax0(3);
- zmax = ax0(4);
- dz = zmax-zmin;
- ax1(5) = zmin - dz*(fac-1);
- ax1(6) = zmax + dz*(fac-1);
- if ax1(6) <= ax1(5), ax1 = ax0; end
-end
-
-%===================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/colors.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/colors.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/colors.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,53 +0,0 @@
-%
-% colors.m
-% Carl Tape 01-Dec-2002
-% printed xxx
-%
-% This gets the color-mapping matrices.
-%
-% calls cpt2cmap.m
-% called by trigridN.m, plotcmapsN.m, raysAGU.m, xxx
-%
-
-% blue = (0,0,1)
-% red = (1,0,0)
-% green = (0,1,0)
-% yellow = (0,1,1)
-% white = (1,1,1)
-% white = (0,0,0)
-
-numc = 65;
-white = ones(numc, 3); % white (no good for contour plots)
-bw = gray(numc); % black-to-white
-wb = -gray(numc) + 1; % white-to-black
-nw = ceil(numc/2);
-inc = 1/(nw-1);
-br = [[ones(nw,1) [0:inc:1]' [0:inc:1]']; [[1-inc:-inc:0]' [1-inc:-inc:0]' ones(nw-1,1)]];
- % blue-to-red (top-to-bottom), with white in the middle
-br = [[ones(nw,1) [0:inc:1]' [0:inc:1]']; [[1-inc:-inc:0]' [1-inc:-inc:0]' ones(nw-1,1)]];
- % blue-to-red (top-to-bottom), with white in the middle
-for uy = 1:numc,
- rb(uy,:) = br(numc+1-uy, :);
-end
-
-% blue = (1,0,0)
-% red = (0,0,1)
-% green = (0,1,0)
-% yellow = (0,1,1)
-% white = (1,1,1)
-
-% values from GMT 'seis' color palette
-seis = [170 0 0; 206 0 0; 243 0 0; 255 24 0; 255 60 0; 255 97 0;
-255 133 0; 255 170 0; 255 206 0; 255 243 0; 255 255 0; 255 255 0;
-231 255 4; 161 255 17; 90 255 30; 51 249 64; 13 242 99; 0 194 152;
-0 125 214; 0 68 248; 0 34 226];
-
-% values for color palette used in TW phase velocity maps
-ana = [202 80 0; 255 90 0; 255 110 0; 255 130 0; 255 150 0; 255 170 0; 255 190 0; ...
- 255 205 0; 190 190 240; 170 170 240; 150 150 240; 130 130 240; 100 100 240; ...
- 70 70 240; 30 30 220; 30 30 140];
-
-br = cpt2cmap(ana);
-seis = cpt2cmap(seis);
-
-%=========================================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/cpt2cmap.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/cpt2cmap.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/cpt2cmap.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,28 +0,0 @@
-%
-% function outmat = cpt2cmap(inmat)
-% Carl Tape, 14-March-2005
-% printed xxx
-%
-% This function inputs a 3 column matrix of colors (RGB)
-% and outputs a matrix suitable for Matlab plots.
-%
-% calls xxx
-% called by xxx
-%
-
-function outmat = cpt2cmap(inmat)
-
-numc = 65;
-len = length(inmat);
-temp = inmat/max(max(inmat)); % normalize to 0-1 range
-rv = temp(:,1);
-gv = temp(:,2);
-bv = temp(:,3);
-
-% I don't know a better way to do this -- this interpolates to numc points.
-numc = 65;
-outmat = [ interp1(linspace(1,numc,len), rv', [1:numc])' ...
- interp1(linspace(1,numc,len), gv', [1:numc])' ...
- interp1(linspace(1,numc,len), bv', [1:numc])'];
-
-%==================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/curvature.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/curvature.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/curvature.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,25 +0,0 @@
-%
-% function [i0,kap] = curvature(x,y)
-% CARL TAPE, 25-July-2005
-%
-% This function compute the curvature of a 1-D function
-% and returns the computed curvature, as well as the
-% point of maximum POSITIVE curvature.
-%
-% This was written for quantifying L-curves.
-%
-% calls xxx
-% called by spline_wang_D.m, test_del2.m
-%
-
-function [i0,kap] = curvature(x,y)
-
-f1 = gradient(y,x);
-f2 = gradient(f1,x);
-kap = f2 ./ (1 + f1.^2).^(3/2); % see Mathworld
-
-%[kap0,i0] = max(abs(kap));
-[kap0,i0] = max(kap);
-
-%============================================================
-
\ No newline at end of file
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/fontsize.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/fontsize.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/fontsize.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,24 +0,0 @@
-%
-% function function fontsize(fs,h)
-% Juliette Artru, 15-Sept-2004
-% printed xxxx
-%
-% This changes the font on an entire figure.
-%
-% fs: font size
-% h: handle graphics (optional)
-%
-
-function fontsize(fs,h);
-
-if(nargin<2);h=gcf;end
-hc=get(gcf,'child');
-hall=hc;
-for k=1:length(hc);
- if(strcmp(get(hc(k),'Type'),'axes'))
- hall=[hall; get(hc(k),'XLabel') ; get(hc(k),'YLabel') ; get(hc(k),'Title')];
- end
-end
-set(hall,'fontsize',fs);
-
-
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/gcvfctn.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/gcvfctn.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/gcvfctn.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,47 +0,0 @@
-%
-% function G = gcvfctn(h, s2, fc, rss0, dof0)
-% Carl Tape (Tapio Schneider, ACM 118)
-% 09-Nov-2004
-%
-% GCVFCTN Evaluate generalized cross-validation function.
-%
-% gcvfctn(h, s2, fc, rss0, dof0) is the value of the GCV function
-% for ridge regression with regularization parameter h.
-%
-% INPUT:
-% h regularization parameter
-% s2 squared singular value of the design matrix
-% fc coefficients fc = U(:, 1:q)'*g
-% rss0 the residual sum of squares of the (non-regularized)
-% least squares estimate
-% dofo0 the number of residual degrees of freedom of
-% the (non-regularized) least squares estimate
-%
-% U matrix of left singular vectors
-% g vector of response variables
-% q the smaller of the numbers of rows and columns of
-% the design matrix, q = min(n,p)
-%
-% Auxiliary function for GCV.
-%
-% Adapted from GCVFUN in Per-Christian Hansen's Regularization Toolbox.
-%
-% See Schneider (2001) for details.
-%
-% calls xxx
-% called by gcv.m
-%
-
-function G = gcvfctn(h, s2, fc, rss0, dof0)
-
-% SIMILAR TO filter factor for Tikhonov regularization:
-% 1 - f = F, where F are the filter factors
-f = h^2 ./ (s2 + h^2);
-
-RSS = norm(f.*fc)^2 + rss0;
-T2 = (dof0 + sum(f))^2;
-
-G = RSS / T2;
-
-%=============================================================
-
\ No newline at end of file
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/genfit.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/genfit.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/genfit.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,77 +0,0 @@
-%
-% function [m1, e1] = genfit(theory, m0, jogs, data, param)
-% Carl Tape, 23-Sep-2002
-% printed 23-Sep-2002
-%
-% Program by John Woodhouse, Dept. Earth Sciences, University of Oxford.
-% Non-linear least squares algorithm to fit data
-% to a model using the theory function 'theory'.
-%
-% original Oxford location = /home/owl_data2/john/matlab/genfit.m
-%
-% theory = a function that generates a column
-% of predicted data given a model m and
-% having the call: d = theory(m, param).
-% m0 = starting model
-% jogs = a column of perturbations to the
-% model that genfit will use to estimate the
-% partial derivatives of theory with respect to
-% the model parameters. A zero value in jogs
-% indicates that the corresponding model parameter
-% is to be held fixed.
-% data = vector of data
-% param = an array of parameters associated with the data,
-% having the same number of rows as data
-%
-% m1 = the updated model.
-% e1 = an estimate of the uncertainties (standard errors)
-% of the updated model.
-%
-% calls theory.m (e.g., theoryHyp.m)
-% called by testgenfitA.m, testgenfitB.m, testgenfitC.m
-%
-
-function [m1, e1] = genfit(theory, m0, jogs, data, param)
-
-numd = length(data); % number of data points
-numm = length(m0); % number of model parameters
-
-resid = data - feval(theory, m0, param);
-r0 = resid' * resid;
-rms_residual = sqrt(r0/numd);
-
-%disp(' ');
-%disp(' data theory resid');
-%disp([data feval(theory, m0, param) resid]);
-
-% vary each model parameter in turn, to calculate partial derivatives
-a = zeros(numd, numm);
-
-% predicted data from model m0
-f0 = feval(theory, m0, param);
-
-% Calculate partial derivatives of 'theory' with respect
-% to each model parameter, storing the results in matrix a.
-for i=1:numm
- xx = m0;
- dx = jogs(i);
- if dx ~= 0, % check for non-vanishing dx
- xx(i) = xx(i) + dx; % new model
- a(:, i) = (feval(theory, xx, param) - f0) ./ dx;
- else
- a(:, i) = zeros(numd, 1);
- end
-end
-
-% Use the 'pseudo-inverse' pinv(a'*a), rather than the
-% true inverse inv(a'*a), because a'a may have zero rows and columns.
-c1 = pinv(a' * a);
-m1 = m0 + c1*(a' * resid); % updated model
-
-c1 = c1 * rms_residual^2;
-e1 = zeros(numm, 1);
-for i = 1:numm,
- e1(i) = sqrt(c1(i, i)); % formal standard errors in model parameters
-end
-
-%==========================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/griddataXB.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/griddataXB.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/griddataXB.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,41 +0,0 @@
-%
-% function [X,Y,Z] = griddataXB(xvec,yvec,zvec,npts,stype)
-% Carl Tape, 09-July-2004
-% printed xxx
-%
-% Copied from griddataX.m on 08-May-2004
-% Converts irregular points to regular points, for mesh plotting.
-%
-% INPUT:
-% xvec,yvec = map coordinates of irregular points
-% zvec = function values at (xi,yi)
-% npts = number of points in horizontal interpolation
-% stype = type of interpolation
-%
-% 'linear' - Triangle-based linear interpolation (default).
-% 'cubic' - Triangle-based cubic interpolation.
-% 'nearest' - Nearest neighbor interpolation.
-% 'v4' - MATLAB 4 griddata method.
-%
-% OUTPUT:
-% X,Y = interpolated mesh
-% Z = interpolated function
-%
-% calls xxx
-% called by c164E.m, GPS_A.m, omsplotsF.m
-%
-
-function [X,Y,Z] = griddataXB(xvec, yvec, zvec, npts, stype)
-
-% construct mesh with UNIFORM spacing in x and y directions
-xlin = linspace(min(xvec), max(xvec), npts);
-dx = xlin(2) - xlin(1);
-ylin = [min(yvec) : dx : max(yvec)+dx];
-[X,Y] = meshgrid(xlin,ylin);
-
-%zvec = zvec(:)'; % row vector
-
-% determine interpolated function using xvec,yvec input
-Z = griddata(xvec, yvec, zvec, X, Y, stype);
-
-%==================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/linefit.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/linefit.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/linefit.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,61 +0,0 @@
-%
-% function [xf,yf,mf,bf,rms] = linefit(x, y)
-% CARL TAPE, 16-June-2005
-% printed xxx
-%
-% This function fits data to a line.
-% Note: With t points, rms = 0.
-% EXAMPLE is shown below.
-%
-% calls xxx
-% called by c101D.m, c163E.m, c111C.m
-%
-
-function [xf,yf,mf,bf,rms] = linefit(x,y)
-
-% column vectors
-x = x(:); y = y(:);
-
-% remove NaN or inf
-igood = find( ~isnan(x) .* ~isinf(x) .* ~isnan(y) .* ~isinf(y) == 1 );
-x = x(igood);
-y = y(igood);
-
-% sample xpts
-xf = linspace(min(x), max(x), 100)';
-
-% least-squares fitting
-P = polyfit(x,y,1);
-yf = polyval(P,xf);
-
-mf = P(1);
-bf = P(2);
-res = polyval(P,x) - y;
-rms = sqrt( (res' * res) / length(res) );
-
-if 0==1
- % EXAMPLE (c101D.m)
- Srvec = [28.8 48.8 62.3 66.6 72.5 78.6];
- SrRatio = [0.7151 0.7130 0.7123 0.7112 0.7113 0.7111];
- [xf,yf,mf,bf,rms] = linefit(SrRatio, 1./Srvec);
- figure; plot(xf,yf,'r--',SrRatio,1./Srvec,'b.');
- xlabel('^{87}Sr / ^{86}Sr');
- ylabel('1/[Sr] (1/ppb)');
-end
-
-%-----------------------------------------------------------
-% older version which requires OPTIMIZATION toolbox
-
-% % initial guess based on the first and last points in data
-% mg = (y(end) - y(1)) / (x(end) - x(1));
-% bg = y(1) - mg*x(1);
-%
-% ydata = mg*x + bg;
-% fun = inline('x(1)*xdata + x(2)', 'x', 'xdata');
-% F = lsqcurvefit(fun, [x(1) x(end)], x, y);
-%
-% mf = F(1);
-% bf = F(2);
-% yf = mf*xf + bf;
-
-%===============================================================
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/axes_expand.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/axes_expand.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/axes_expand.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/axes_expand.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,50 @@
+%
+% function ax1 = axes_expand(ax0,fac)
+% CARL TAPE, 16-Aug-2005
+% printed xxx
+%
+% This function inputs an axes box and outputs a new axes box,
+% expanded by the factor 'fac' in all 2,4,6 dimensions.
+%
+% EXAMPLE:
+% ax0 = [-121 -114]; ax1 = axes_expand(ax0,2)
+% ax0 = [-121 -114 31 37]; ax1 = axes_expand(ax0,2)
+% ax0 = [-121 -114 31 37]; ax1 = axes_expand(ax0,0.30)
+%
+% calls xxx
+% called by xxx
+%
+
+function ax1 = axes_expand(ax0,fac)
+
+% 1D, 2D, 3D
+ndim = length(ax0)/2;
+ax1 = zeros(1,ndim*2);
+
+% return original axes if new axes are non-sensical
+
+xmin = ax0(1);
+xmax = ax0(2);
+dx = xmax-xmin;
+ax1(1) = xmin - dx*(fac-1);
+ax1(2) = xmax + dx*(fac-1);
+if ax1(2) <= ax1(1), ax1 = ax0; end
+
+if ndim >= 2
+ ymin = ax0(3);
+ ymax = ax0(4);
+ dy = ymax-ymin;
+ ax1(3) = ymin - dy*(fac-1);
+ ax1(4) = ymax + dy*(fac-1);
+ if ax1(4) <= ax1(3), ax1 = ax0; end
+end
+if ndim == 3
+ zmin = ax0(3);
+ zmax = ax0(4);
+ dz = zmax-zmin;
+ ax1(5) = zmin - dz*(fac-1);
+ ax1(6) = zmax + dz*(fac-1);
+ if ax1(6) <= ax1(5), ax1 = ax0; end
+end
+
+%===================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/axes_expand.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/colors.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/colors.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/colors.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/colors.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,53 @@
+%
+% colors.m
+% Carl Tape 01-Dec-2002
+% printed xxx
+%
+% This gets the color-mapping matrices.
+%
+% calls cpt2cmap.m
+% called by trigridN.m, plotcmapsN.m, raysAGU.m, xxx
+%
+
+% blue = (0,0,1)
+% red = (1,0,0)
+% green = (0,1,0)
+% yellow = (0,1,1)
+% white = (1,1,1)
+% white = (0,0,0)
+
+numc = 65;
+white = ones(numc, 3); % white (no good for contour plots)
+bw = gray(numc); % black-to-white
+wb = -gray(numc) + 1; % white-to-black
+nw = ceil(numc/2);
+inc = 1/(nw-1);
+br = [[ones(nw,1) [0:inc:1]' [0:inc:1]']; [[1-inc:-inc:0]' [1-inc:-inc:0]' ones(nw-1,1)]];
+ % blue-to-red (top-to-bottom), with white in the middle
+br = [[ones(nw,1) [0:inc:1]' [0:inc:1]']; [[1-inc:-inc:0]' [1-inc:-inc:0]' ones(nw-1,1)]];
+ % blue-to-red (top-to-bottom), with white in the middle
+for uy = 1:numc,
+ rb(uy,:) = br(numc+1-uy, :);
+end
+
+% blue = (1,0,0)
+% red = (0,0,1)
+% green = (0,1,0)
+% yellow = (0,1,1)
+% white = (1,1,1)
+
+% values from GMT 'seis' color palette
+seis = [170 0 0; 206 0 0; 243 0 0; 255 24 0; 255 60 0; 255 97 0;
+255 133 0; 255 170 0; 255 206 0; 255 243 0; 255 255 0; 255 255 0;
+231 255 4; 161 255 17; 90 255 30; 51 249 64; 13 242 99; 0 194 152;
+0 125 214; 0 68 248; 0 34 226];
+
+% values for color palette used in TW phase velocity maps
+ana = [202 80 0; 255 90 0; 255 110 0; 255 130 0; 255 150 0; 255 170 0; 255 190 0; ...
+ 255 205 0; 190 190 240; 170 170 240; 150 150 240; 130 130 240; 100 100 240; ...
+ 70 70 240; 30 30 220; 30 30 140];
+
+br = cpt2cmap(ana);
+seis = cpt2cmap(seis);
+
+%=========================================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/colors.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/cpt2cmap.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/cpt2cmap.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/cpt2cmap.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/cpt2cmap.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,28 @@
+%
+% function outmat = cpt2cmap(inmat)
+% Carl Tape, 14-March-2005
+% printed xxx
+%
+% This function inputs a 3 column matrix of colors (RGB)
+% and outputs a matrix suitable for Matlab plots.
+%
+% calls xxx
+% called by xxx
+%
+
+function outmat = cpt2cmap(inmat)
+
+numc = 65;
+len = length(inmat);
+temp = inmat/max(max(inmat)); % normalize to 0-1 range
+rv = temp(:,1);
+gv = temp(:,2);
+bv = temp(:,3);
+
+% I don't know a better way to do this -- this interpolates to numc points.
+numc = 65;
+outmat = [ interp1(linspace(1,numc,len), rv', [1:numc])' ...
+ interp1(linspace(1,numc,len), gv', [1:numc])' ...
+ interp1(linspace(1,numc,len), bv', [1:numc])'];
+
+%==================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/cpt2cmap.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/curvature.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/curvature.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/curvature.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/curvature.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,25 @@
+%
+% function [i0,kap] = curvature(x,y)
+% CARL TAPE, 25-July-2005
+%
+% This function compute the curvature of a 1-D function
+% and returns the computed curvature, as well as the
+% point of maximum POSITIVE curvature.
+%
+% This was written for quantifying L-curves.
+%
+% calls xxx
+% called by spline_wang_D.m, test_del2.m
+%
+
+function [i0,kap] = curvature(x,y)
+
+f1 = gradient(y,x);
+f2 = gradient(f1,x);
+kap = f2 ./ (1 + f1.^2).^(3/2); % see Mathworld
+
+%[kap0,i0] = max(abs(kap));
+[kap0,i0] = max(kap);
+
+%============================================================
+
\ No newline at end of file
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/curvature.m
___________________________________________________________________
Name: svn:mergeinfo
+
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/diff_files.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/diff_files.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/diff_files.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,43 @@
+%
+% function diff_files(file1,file2)
+% Carl Tape, 25-Jan-2010
+%
+% This function reads in two files of numeric data, computes the norms of each column,
+% then compares.
+%
+% calls xxx
+% called by xxx
+%
+
+function diff_files(file1,file2)
+
+d1 = load(file1); [nr1,nc1] = size(d1);
+d2 = load(file2); [nr2,nc2] = size(d2);
+
+if nr1 ~= nr2
+ disp(sprintf('file 1 has %i rows',nr1));
+ disp(sprintf('file 2 has %i rows',nr2));
+ error('number of rows does not match');
+end
+if nc1 ~= nc2
+ disp(sprintf('file 1 has %i columns',nc1));
+ disp(sprintf('file 2 has %i columns',nc2));
+ error('number of columns does not match');
+end
+
+format long
+
+for ii=1:nc1
+ disp(sprintf('column %2i%16.8e%16.8e%16.8e',...
+ ii,norm(d1(:,ii)), norm(d2(:,ii)), norm( d1(:,ii) - d2(:,ii) ) / norm(d1(:,ii)) ))
+end
+
+if 0==1
+ bdir = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_OUTPUT/';
+ file1 = [bdir 'run_1500/READ_IN_CGF90_CDIAG/model_m0001/src_syn_m0001.dat'];
+ file2 = [bdir 'run_1500/READ_IN/model_m0001/src_syn_m0001.dat'];
+ diff_files(file1,file2)
+
+end
+
+%=========================================================
\ No newline at end of file
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/fontsize.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/fontsize.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/fontsize.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/fontsize.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,24 @@
+%
+% function function fontsize(fs,h)
+% Juliette Artru, 15-Sept-2004
+% printed xxxx
+%
+% This changes the font on an entire figure.
+%
+% fs: font size
+% h: handle graphics (optional)
+%
+
+function fontsize(fs,h);
+
+if(nargin<2);h=gcf;end
+hc=get(gcf,'child');
+hall=hc;
+for k=1:length(hc);
+ if(strcmp(get(hc(k),'Type'),'axes'))
+ hall=[hall; get(hc(k),'XLabel') ; get(hc(k),'YLabel') ; get(hc(k),'Title')];
+ end
+end
+set(hall,'fontsize',fs);
+
+
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/fontsize.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/gcvfctn.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/gcvfctn.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/gcvfctn.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/gcvfctn.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,47 @@
+%
+% function G = gcvfctn(h, s2, fc, rss0, dof0)
+% Carl Tape (Tapio Schneider, ACM 118)
+% 09-Nov-2004
+%
+% GCVFCTN Evaluate generalized cross-validation function.
+%
+% gcvfctn(h, s2, fc, rss0, dof0) is the value of the GCV function
+% for ridge regression with regularization parameter h.
+%
+% INPUT:
+% h regularization parameter
+% s2 squared singular value of the design matrix
+% fc coefficients fc = U(:, 1:q)'*g
+% rss0 the residual sum of squares of the (non-regularized)
+% least squares estimate
+% dofo0 the number of residual degrees of freedom of
+% the (non-regularized) least squares estimate
+%
+% U matrix of left singular vectors
+% g vector of response variables
+% q the smaller of the numbers of rows and columns of
+% the design matrix, q = min(n,p)
+%
+% Auxiliary function for GCV.
+%
+% Adapted from GCVFUN in Per-Christian Hansen's Regularization Toolbox.
+%
+% See Schneider (2001) for details.
+%
+% calls xxx
+% called by gcv.m
+%
+
+function G = gcvfctn(h, s2, fc, rss0, dof0)
+
+% SIMILAR TO filter factor for Tikhonov regularization:
+% 1 - f = F, where F are the filter factors
+f = h^2 ./ (s2 + h^2);
+
+RSS = norm(f.*fc)^2 + rss0;
+T2 = (dof0 + sum(f))^2;
+
+G = RSS / T2;
+
+%=============================================================
+
\ No newline at end of file
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/gcvfctn.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/genfit.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/genfit.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/genfit.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/genfit.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,77 @@
+%
+% function [m1, e1] = genfit(theory, m0, jogs, data, param)
+% Carl Tape, 23-Sep-2002
+% printed 23-Sep-2002
+%
+% Program by John Woodhouse, Dept. Earth Sciences, University of Oxford.
+% Non-linear least squares algorithm to fit data
+% to a model using the theory function 'theory'.
+%
+% original Oxford location = /home/owl_data2/john/matlab/genfit.m
+%
+% theory = a function that generates a column
+% of predicted data given a model m and
+% having the call: d = theory(m, param).
+% m0 = starting model
+% jogs = a column of perturbations to the
+% model that genfit will use to estimate the
+% partial derivatives of theory with respect to
+% the model parameters. A zero value in jogs
+% indicates that the corresponding model parameter
+% is to be held fixed.
+% data = vector of data
+% param = an array of parameters associated with the data,
+% having the same number of rows as data
+%
+% m1 = the updated model.
+% e1 = an estimate of the uncertainties (standard errors)
+% of the updated model.
+%
+% calls theory.m (e.g., theoryHyp.m)
+% called by testgenfitA.m, testgenfitB.m, testgenfitC.m
+%
+
+function [m1, e1] = genfit(theory, m0, jogs, data, param)
+
+numd = length(data); % number of data points
+numm = length(m0); % number of model parameters
+
+resid = data - feval(theory, m0, param);
+r0 = resid' * resid;
+rms_residual = sqrt(r0/numd);
+
+%disp(' ');
+%disp(' data theory resid');
+%disp([data feval(theory, m0, param) resid]);
+
+% vary each model parameter in turn, to calculate partial derivatives
+a = zeros(numd, numm);
+
+% predicted data from model m0
+f0 = feval(theory, m0, param);
+
+% Calculate partial derivatives of 'theory' with respect
+% to each model parameter, storing the results in matrix a.
+for i=1:numm
+ xx = m0;
+ dx = jogs(i);
+ if dx ~= 0, % check for non-vanishing dx
+ xx(i) = xx(i) + dx; % new model
+ a(:, i) = (feval(theory, xx, param) - f0) ./ dx;
+ else
+ a(:, i) = zeros(numd, 1);
+ end
+end
+
+% Use the 'pseudo-inverse' pinv(a'*a), rather than the
+% true inverse inv(a'*a), because a'a may have zero rows and columns.
+c1 = pinv(a' * a);
+m1 = m0 + c1*(a' * resid); % updated model
+
+c1 = c1 * rms_residual^2;
+e1 = zeros(numm, 1);
+for i = 1:numm,
+ e1(i) = sqrt(c1(i, i)); % formal standard errors in model parameters
+end
+
+%==========================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/genfit.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/griddataXB.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/griddataXB.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/griddataXB.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/griddataXB.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,41 @@
+%
+% function [X,Y,Z] = griddataXB(xvec,yvec,zvec,npts,stype)
+% Carl Tape, 09-July-2004
+% printed xxx
+%
+% Copied from griddataX.m on 08-May-2004
+% Converts irregular points to regular points, for mesh plotting.
+%
+% INPUT:
+% xvec,yvec = map coordinates of irregular points
+% zvec = function values at (xi,yi)
+% npts = number of points in horizontal interpolation
+% stype = type of interpolation
+%
+% 'linear' - Triangle-based linear interpolation (default).
+% 'cubic' - Triangle-based cubic interpolation.
+% 'nearest' - Nearest neighbor interpolation.
+% 'v4' - MATLAB 4 griddata method.
+%
+% OUTPUT:
+% X,Y = interpolated mesh
+% Z = interpolated function
+%
+% calls xxx
+% called by c164E.m, GPS_A.m, omsplotsF.m
+%
+
+function [X,Y,Z] = griddataXB(xvec, yvec, zvec, npts, stype)
+
+% construct mesh with UNIFORM spacing in x and y directions
+xlin = linspace(min(xvec), max(xvec), npts);
+dx = xlin(2) - xlin(1);
+ylin = [min(yvec) : dx : max(yvec)+dx];
+[X,Y] = meshgrid(xlin,ylin);
+
+%zvec = zvec(:)'; % row vector
+
+% determine interpolated function using xvec,yvec input
+Z = griddata(xvec, yvec, zvec, X, Y, stype);
+
+%==================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/griddataXB.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/linefit.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/linefit.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/linefit.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/linefit.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,61 @@
+%
+% function [xf,yf,mf,bf,rms] = linefit(x, y)
+% CARL TAPE, 16-June-2005
+% printed xxx
+%
+% This function fits data to a line.
+% Note: With t points, rms = 0.
+% EXAMPLE is shown below.
+%
+% calls xxx
+% called by c101D.m, c163E.m, c111C.m
+%
+
+function [xf,yf,mf,bf,rms] = linefit(x,y)
+
+% column vectors
+x = x(:); y = y(:);
+
+% remove NaN or inf
+igood = find( ~isnan(x) .* ~isinf(x) .* ~isnan(y) .* ~isinf(y) == 1 );
+x = x(igood);
+y = y(igood);
+
+% sample xpts
+xf = linspace(min(x), max(x), 100)';
+
+% least-squares fitting
+P = polyfit(x,y,1);
+yf = polyval(P,xf);
+
+mf = P(1);
+bf = P(2);
+res = polyval(P,x) - y;
+rms = sqrt( (res' * res) / length(res) );
+
+if 0==1
+ % EXAMPLE (c101D.m)
+ Srvec = [28.8 48.8 62.3 66.6 72.5 78.6];
+ SrRatio = [0.7151 0.7130 0.7123 0.7112 0.7113 0.7111];
+ [xf,yf,mf,bf,rms] = linefit(SrRatio, 1./Srvec);
+ figure; plot(xf,yf,'r--',SrRatio,1./Srvec,'b.');
+ xlabel('^{87}Sr / ^{86}Sr');
+ ylabel('1/[Sr] (1/ppb)');
+end
+
+%-----------------------------------------------------------
+% older version which requires OPTIMIZATION toolbox
+
+% % initial guess based on the first and last points in data
+% mg = (y(end) - y(1)) / (x(end) - x(1));
+% bg = y(1) - mg*x(1);
+%
+% ydata = mg*x + bg;
+% fun = inline('x(1)*xdata + x(2)', 'x', 'xdata');
+% F = lsqcurvefit(fun, [x(1) x(end)], x, y);
+%
+% mf = F(1);
+% bf = F(2);
+% yf = mf*xf + bf;
+
+%===============================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/linefit.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ocv_carl.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ocv_carl.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ocv_carl.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ocv_carl.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,87 @@
+%
+% function rss_vec = ocv_carl(g, A, lamvec)
+% Carl Tape, 30-March-2006
+%
+% Copied from gcv_carl.m on 27-March-2006.
+%
+% Returns the ordinary cross-validation (OCV) function corresponding to a
+% set of input regularization (or damping) parameters.
+%
+% TWO ALGORITHMS ARE SHOWN:
+% (1) Brute force, which involves ndata inversions per lambda
+% (2) Elegant formalisum, which involves one inversion per lambda
+% --> See Latex notes
+% /home/carltape/classes/acm118/2006_handouts/hw3/hw3sol_2006_prob3.pdf
+%
+% Using some GPS data, I checked that these approaches are identical.
+%
+% calls xxx
+% called by ridge_carl.m
+%
+
+function rss_vec = ocv_carl(d, A, lamvec)
+
+% Size of inputs
+[ndata, nparm] = size(A);
+numlam = length(lamvec);
+
+if (min(lamvec) < 0)
+ error('Impossible regularization parameter lambda.')
+end
+
+rss_vec = zeros(numlam,1);
+
+% loop over regularization parameters
+for ii=1:numlam
+ lam = lamvec(ii);
+ disp([' ii = ' num2str(ii) '/' num2str(numlam) ', lam = ' num2str(lam)]);
+
+ if 1==1
+ H = A*inv(A'*A + lam^2*eye(nparm))*A';
+ dhat = H*d;
+
+ % OCV residual
+ res = (d - dhat) ./ (1 - diag(H));
+
+ % sum the residuals
+ rss_vec(ii) = sum(res.^2);
+
+ else
+ % loop over datapoints
+ for jj=1:ndata
+ %disp([' jj = ' num2str(jj) '/' num2str(ndata) ]);
+
+ % indices for which you compute the model parameters
+ switch jj
+ case 1, einds = [2:ndata];
+ case ndata, einds = [1:ndata-1];
+ otherwise, einds = [1:jj-1 jj+1:ndata];
+ end
+
+ % indices to estimate the RSS
+ oinds = jj;
+
+ % reduced matrices
+ X = A(einds,:);
+ g = d(einds);
+
+ % note: regularization matrix is identity matrix
+ f_h = inv(X'*X + lam^2*eye(nparm))*X'*g;
+
+ % estimate the model at the datapoints NOT used
+ res = A(oinds,:) * f_h - d(oinds);
+
+ % sum the residuals
+ rss_vec(ii) = rss_vec(ii) + sum(res.^2);
+ end
+ end
+
+end
+
+rss_vec = rss_vec / ndata; % normalization
+
+figure; loglog(lamvec, rss_vec, '.'); grid on;
+xlabel(' Regularization parameter, log (\lambda)');
+ylabel(' RSS at datapoints NOT used in computing model');
+
+%======================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ocv_carl.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_min_4.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_min_4.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_min_4.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_min_4.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,123 @@
+%
+% function xmin = quad_min_4(P,x0)
+% Carl Tape, 11-Jan-2006
+% printed xxx
+%
+% This function inputs two (x,y) points and one slope, and returns a
+% quadratic fitting polynomial, along with the (analytical) minimum value.
+%
+% calls quad_shift.m
+% called by model_optimize.m
+%
+
+function [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,opts,stlabs)
+
+ifig = opts(1); % =1 to plot figure
+isub = opts(2); % =1 to plot as a subfigure; =0 to plot as a full figure
+
+if length([x1 x2 y1 y2 g1]) ~= 5, error('check input dimensions'); end
+
+a = ((y2 - y1) - g1*(x2 - x1)) / (x2^2 - x1^2);
+b = g1;
+c = y1 - a*x1^2 - b*x1;
+%c = y2 - a*x2^2 - b*x2;
+
+% ax^2 + bx + c
+P1 = [a b c]';
+
+% a(x-b)^2 + c
+[P2,qvert,stit] = quad_shift(P1,1);
+xmin = qvert(1);
+
+if ifig==1
+ if isub==1
+ specs = [1 6 12 10]; fac = 0.1;
+ else
+ figure;
+ specs = [2 14 18 12]; fac = 0.05;
+ end
+
+ % step COULD be negative (source inversion)
+ temp = sort([x1 x2]);
+ x1plot = temp(1);
+ x2plot = temp(2);
+ if x1 ~= x1plot
+ iflip = 1;
+ stlabs = [stlabs(1:2) fliplr(stlabs(3:5))]
+ end
+
+ axpoly = axes_expand([x1plot x2plot 0 max([y1 y2])],1.2);
+ axpoly(3) = 0;
+ dy = axpoly(4) - axpoly(3);
+ dx = axpoly(2) - axpoly(1);
+ ylab = axpoly(3) - fac*dy;
+
+ ymin = polyval(P1,xmin); % quadratic function evaluation
+
+ % base level for test-model parabola
+ K = 0.5;
+ %K = 0.0; % no model norm term or data errors
+
+ % initial guess is based on a quadratic fit
+ %aquad = g1^2/(4*y1);
+ aquad = -g1^2/(4*(K - y1));
+ Pquad = [aquad g1 y1]';
+
+ % x-points for smooth curves
+ n = 100; xpts = linspace(axpoly(1),axpoly(2),n);
+
+ % curves through (x1,y1)
+ g1_line = polyval([g1 y1-g1*x1],xpts);
+ g1_test = polyval(Pquad,xpts);
+ g1_quad = polyval(P1,xpts);
+
+ hold on;
+
+ % plot curves
+ plot(xpts,g1_quad,'b','linewidth',specs(1));
+ plot(xpts,g1_test,'b--');
+ plot(xpts,g1_line,'r--');
+
+ % plot black lines
+ plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+ plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+ plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
+
+ % plot markers
+ plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+ plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+ %plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
+
+ axis(axpoly);
+ xlabel(stlabs{1},'fontsize',specs(3));
+ ylabel(stlabs{2},'fontsize',specs(3));
+ if isub==0
+ title({stit{1},stit{2}},'fontsize',specs(3))
+ grid on;
+ else
+ set(gca,'xtick',[x1plot x2plot],'xticklabel',{[],[]});
+ %set(gca,'xtick',[x1plot xmin x2plot]),'xticklabel',{'0',[],[]};
+ end
+ text(x1plot,ylab,stlabs{3},'fontsize',specs(4));
+ text(xmin,ylab,stlabs{4},'fontsize',specs(4));
+ text(x2plot,ylab,stlabs{5},'fontsize',specs(4));
+ orient tall, wysiwyg
+end
+
+if 0==1
+ x1 = 0
+ x2 = randomint(1,5,1)
+ y1 = randomint(1,5,1)
+ y2 = randomint(1,5,1)
+ g1 = randomint(-5,-1,1)
+
+ opts = [1 0];
+ stk = num2str(0);
+ stlabs = {'\lambda',['\chi^{' stk '} ( \lambda )'],'0',['\lambda_{' stk '}'],['\lambda_{' stk 't}']};
+
+ [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,opts,stlabs);
+ set(gca,'xtick',[-10:10],'ytick',[-10:10]);
+ axis equal;
+end
+
+%=========================================================
\ No newline at end of file
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_min_4.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_shift.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_shift.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_shift.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_shift.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,66 @@
+%
+% function [Pout,qvert,stit] = quad_shift(Pin,opts)
+% Carl Tape, 11-Jan-2006
+% printed xxx
+%
+% This function adjusts parabola (i.e., quadratic polynomial) coefficients
+% between two representations, and also returns the vertex.
+%
+% See also cubic_shift.m
+%
+% calls xxx
+% called by test_poly.m
+%
+
+function [Pout,qvert,stit] = quad_shift(Pin,opts)
+
+iopt = opts(1);
+stx = '%.3f';
+
+P = Pin(:);
+a = Pin(1);
+b = Pin(2);
+c = Pin(3);
+
+% adjust the polynomial coefficients
+if iopt == 1
+ % ax^2 + bx + c --> a(x-b)^2 + c
+ Pout(1) = a;
+ Pout(2) = -b/(2*a);
+ Pout(3) = c - b^2/(4*a);
+
+ qvert = [Pout(2) Pout(3)];
+
+ stit1 = ['y = ' num2str(sprintf(stx, a)) ' x^2 + ' ...
+ num2str(sprintf(stx, b)) ' x + ' ...
+ num2str(sprintf(stx, c)) ];
+ stit2 = ['y = ' num2str(sprintf(stx, Pout(1))) ' (x - ' ...
+ num2str(sprintf(stx, Pout(2))) ')^2 + ' ...
+ num2str(sprintf(stx, Pout(3))) ];
+
+else
+ % a(x-b)^2 + c --> ax^2 + bx + c
+ if a==0
+ Pout(1) = 0;
+ Pout(2) = 0;
+ Pout(3) = c;
+ qvert = [NaN NaN];
+ else
+ Pout(1) = a;
+ Pout(2) = -2*a*b;
+ Pout(3) = a*b^2 + c;
+ qvert = [b c];
+ end
+
+ stit1 = ['y = ' num2str(sprintf(stx, Pout(1))) ' x^2 + ' ...
+ num2str(sprintf(stx, Pout(2))) ' x + ' ...
+ num2str(sprintf(stx, Pout(3))) ];
+ stit2 = ['y = ' num2str(sprintf(stx, a)) ' (x - ' ...
+ num2str(sprintf(stx, b)) ')^2 + ' ...
+ num2str(sprintf(stx, c)) ];
+end
+
+Pout = Pout(:);
+stit = {stit1,stit2};
+
+%=========================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/quad_shift.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ridge_carl.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ridge_carl.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ridge_carl.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ridge_carl.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,227 @@
+%
+% function
+% Carl Tape (Tapio Schneider, ACM 118)
+% 06-Nov-2006
+%
+% This function inputs a design matrix, a data vector, and a vector of
+% regularization parameters, and it returns three different curves that may
+% be used to select the best parameter:
+% (1) L-curve and curvature
+% (2) generalized cross-validation curve (GCV)
+% (3) ordinary cross-validation (OCV), also known as 'leave-one-out' CV
+%
+% It is best to input a large number of regularization parameters, so that
+% the min and max of the respective functions can be easily obtained.
+%
+% This program is copied in part from ridge_tapio.m
+%
+% NOTE THE PLOTTING OPTIONS.
+%
+%-------------------------------------------------
+% RIDGE Ridge regression estimates.
+%
+% Given a vector g, a design matrix X, and
+% a regularization parameter h,
+%
+% [m, rss, mss, dof] = ridge_tapio(g, X, h)
+%
+% returns the ridge regression estimate of the vector f in the
+% linear regression model
+%
+% g = X*f + noise.
+%
+% Also returned are the residual sum of squares rss, the sum of
+% squares mss of the elements of the ridge regression estimate
+% m (the squared norm of m), and the effective number of
+% residual degrees of freedom dof.
+%
+% If h is a vector of regularization parameters, the i-th column
+% m(:,i) is the ridge regression estimate for the regularization
+% parameter h(i); the i-th elements of rss and mss are the
+% associated residual sum of squares and estimate sum of squares.
+%
+% If no regularization parameter h is given, generalized
+% cross-validation is used to determine the regularization
+% parameter. The chosen regularization parameter h and the value of
+% the GCV function are then returned as the fifth and sixth
+% output arguments
+%
+% [m, rss, mss, dof, h, G] = ridge_tapio(g, X);
+%
+% Adapted from various routines in Per Christian Hansen's
+% Regularization Toolbox.
+%
+% calls gcvfctn.m, curvature.m
+% called by xxx
+%
+
+function [m, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dvec, X, hvec)
+
+% Size of inputs
+[n, p] = size(X);
+q = min(n, p);
+nh = length(hvec);
+if (min(hvec) < 0)
+ error('Impossible regularization parameter h.')
+end
+
+% Initialize outputs
+m = zeros(p, nh);
+rss = zeros(nh, 1);
+mss = zeros(nh, 1);
+dof = zeros(nh, 1);
+
+% Compute SVD of X
+[U, S, V] = svd(X, 0);
+s = diag(S); % vector of singular values
+s2 = s.^2;
+
+% Coefficients in expansion of solution in terms of right singular vectors
+fc = U(:, 1:q)'*dvec;
+zeta = s .* fc;
+
+% Treat each regularization parameter separately
+for j = 1:nh
+ m(:, j) = V(:, 1:q) * (zeta ./ (s2 + hvec(j)^2));
+ mss(j) = sum(m(:, j).^2);
+ rss(j) = hvec(j)^4 * sum(fc.^2 ./ (s2 + hvec(j)^2).^2);
+ dof(j) = n - sum(s2./(s2 + hvec(j)^2));
+end
+
+% In overdetermined case, add rss of least-squares problem
+if (n > p)
+ rss = rss + sum((dvec - U(:, 1:q)*fc).^2);
+end
+
+%-----------------------
+% determine the Lcurve pick (max curvature)
+
+x1 = log10(rss);
+y1 = log10(mss);
+
+% % smooth curvature interpolation to get h_L
+% num = 1000;
+% xsmooth = linspace(x1(1),x1(end),1000);
+% ysmooth = interp1(x1,y1,xsmooth,'cubic');
+% [i0,kap_smooth] = curvature(xsmooth,ysmooth);
+% rss_L = 10^xsmooth(i0);
+% mss_L = 10^ysmooth(i0);
+% h_L = 10^interp1(x1,log10(hvec),xsmooth(i0),'cubic');
+
+% curvature, based on input h values alone
+[iL,kap] = curvature(x1,y1);
+%h_L = hvec(iL);
+%rss_L = 10^x1(iL);
+%mss_L = 10^y1(iL);
+
+%-----------------------
+% obtain GCV `best' solution and GCV curve
+
+% GCV minimum -- 'exact' in the sense a minimization method is used
+% [hmin, Gmin] = gcv_tapio(U, s, dvec, 'ridge');
+
+% GCV minimum -- 'crude' in the sense that we coarsely sample the function
+dof0 = n-q;
+rss0 = sum((dvec - U(:, 1:q)*fc).^2);
+Gvec = zeros(nh,1);
+for j = 1:nh
+ Gvec(j) = gcvfctn(hvec(j), s2, fc, rss0, dof0);
+end
+[Gmin,iGCV] = min(Gvec);
+%hmin = hvec(iGCV);
+
+% GCV best model and L-curve point for h_GCV (= hmin)
+%mod_min = inv(X'*X + hmin^2*eye(p))*X'*dvec;
+%res = X*mod_min - dvec;
+%rss_min = sum(res.^2);
+%mss_min = sum(mod_min.^2);
+
+% compute G for the Lcurve pick
+%G_L = gcvfctn(h_L, s2, fc, rss0, dof0);
+
+%-----------------------
+% ordinary (leave-one-out) cross-validation
+
+Fvec = ocv_carl(dvec, X, hvec);
+[Fmin,iOCV] = min(Fvec);
+
+%======================================================
+% PLOTTING
+
+lamL = hvec(iL); GL = Gvec(iL); rssL = rss(iL); mssL = mss(iL); kapL = kap(iL); FL = Fvec(iL);
+lamF = hvec(iOCV); GF = Gvec(iOCV); rssF = rss(iOCV); mssF = mss(iOCV); kapF = kap(iOCV); FF = Fvec(iOCV);
+lamG = hvec(iGCV); GG = Gvec(iGCV); rssG = rss(iGCV); mssG = mss(iGCV); kapG = kap(iGCV); FG = Fvec(iGCV);
+
+x1 = log10(rss);
+y1 = log10(mss);
+x2 = log10(hvec);
+y2 = kap;
+x3 = log10(hvec);
+y3 = log10(Fvec);
+x4 = log10(hvec);
+y4 = log10(Gvec);
+
+stx1 = ' Misfit norm, log10 RSS';
+sty1 = ' Model norm, log10 MSS';
+stx2 = ' Regularization parameter, log10 \lambda';
+sty2 = ' Curvature of L-curve, \kappa(\lambda)';
+stx3 = stx2;
+sty3 = ' OCV function, log10 F(\lambda)';
+stx4 = stx2;
+sty4 = ' GCV function, log10 G(\lambda)';
+
+%stfm = '%.4f';
+stfm = '%.2e';
+stlam_L = [' \lambda-L = ' num2str(sprintf(stfm, lamL))];
+stlam_ocv = [' \lambda-OCV = ' num2str(sprintf(stfm, lamF))];
+stlam_gcv = [' \lambda-GCV = ' num2str(sprintf(stfm, lamG))];
+
+%------------------------
+figure; nr=2; nc=2;
+msize = 8;
+nlab = 10; ilabs = round(linspace(1,nh,nlab));
+
+subplot(nr,nc,1); hold on;
+plot(x1,y1,'.');
+plot(log10(rssL),log10(mssL),'ko','markersize',8,'MarkerFaceColor','r');
+plot(log10(rssG),log10(mssG),'kV','markersize',8,'MarkerFaceColor','g');
+plot(log10(rssF),log10(mssF),'k^','markersize',8,'MarkerFaceColor','c');
+axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
+axy = axis; dx = axy(2)-axy(1);
+for kk=1:nlab
+ ii = ilabs(kk);
+ text(x1(ii)+dx*0.02,y1(ii),[num2str(sprintf(stfm, hvec(ii)))],'fontsize',8,'color','b');
+end
+legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv);
+xlabel(stx1); ylabel(sty1); grid on;
+
+subplot(nr,nc,2); hold on;
+plot(x2,y2,'.');
+plot(log10(lamL),kapL,'ko','markersize',8,'MarkerFaceColor','r');
+plot(log10(lamG),kapG,'kV','markersize',8,'MarkerFaceColor','g');
+plot(log10(lamF),kapF,'k^','markersize',8,'MarkerFaceColor','c');
+axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
+legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northwest');
+xlabel(stx2); ylabel(sty2); grid on;
+
+subplot(nr,nc,3); hold on;
+plot(x3,y3,'.');
+plot(log10(lamL),log10(FL),'ko','markersize',8,'MarkerFaceColor','r');
+plot(log10(lamG),log10(FG),'kV','markersize',8,'MarkerFaceColor','g');
+plot(log10(lamF),log10(FF),'k^','markersize',8,'MarkerFaceColor','c');
+axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
+legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northeast');
+xlabel(stx3); ylabel(sty3); grid on;
+
+subplot(nr,nc,4); hold on;
+plot(x4,y4,'.');
+plot(log10(lamL),log10(GL),'ko','markersize',8,'MarkerFaceColor','r');
+plot(log10(lamG),log10(GG),'kV','markersize',8,'MarkerFaceColor','g');
+plot(log10(lamF),log10(GF),'k^','markersize',8,'MarkerFaceColor','c');
+axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
+legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northwest');
+xlabel(stx4); ylabel(sty4); grid on;
+
+orient tall, wysiwyg, fontsize(9)
+
+%======================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/ridge_carl.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/theoryHyp.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/theoryHyp.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/theoryHyp.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/theoryHyp.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,37 @@
+%
+% function y = theoryHyp(m, param)
+% CARL TAPE, 15-Nov-2003
+% printed xxx
+%
+% Output is a set of y-data based on four
+% parameters that describe the hyperbola.
+%
+% hyperbola: Ax + Bxy + Cy + D = 0
+%
+% Note that this is a LINEAR problem, Ax = b :
+%
+% | x x*y y 1 | | A | | 0 |
+% | : : : : | | B | = | : |
+% | : : : : | | C | | : |
+% | : : : : | | D | | : |
+% | : : : : | | : |
+%
+%
+% See /matlab/scicomp/getellipse.m
+%
+% calls xxx
+% called by c101D.m, testgenfitC.m, model_optimize2.m
+%
+
+function y = theoryHyp(m, param)
+
+% input parameters (x-coordinates of data)
+x = param(:);
+
+% model parameters that we solve for
+A = m(1); B = m(2); C = m(3); D = m(4);
+
+% hyperbola: Ax + Bxy + Cy + D = 0
+y = (-A*x - D) ./ (B*x + C);
+
+%================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/theoryHyp.m
___________________________________________________________________
Name: svn:mergeinfo
+
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cell2gll.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cell2gll.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cell2gll.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,26 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+% This function simply interpolates a function on a regular mesh (X,Y,F)
+% onto a set of irregular points (xg,yg) to obtain fg.
+%
+% It is similar to wave2d_gll2cell.m, though NOT the opposite operation.
+%
+% calls xxx
+% called by xxx
+%
+
+function fg = wave2d_cell2gll(xg,yg,xc,yc,fc,nxc,nyc)
+%function fg = wave2d_cell2gll(xg,yg,X,Y,F)
+
+% reshape xc, yc, fc into matrices
+% NOTE: this assumes that they were ORIGINALLY made using meshgrid
+X = reshape(xc,nyc,nxc);
+Y = reshape(yc,nyc,nxc);
+F = reshape(fc,nyc,nxc);
+fg = interp2(X,Y,F,xg,yg,'cubic');
+
+%fg = interp2(X,Y,F,xg,yg,'cubic');
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cg.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cg.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_cg.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,75 @@
+%
+% function
+% Carl Tape, 21-Jan-2010
+%
+% This emulates the CG algorithm in wave2d.f90, but assumes a full
+% covariance matrix instead of a diagonal covariance matrix.
+%
+% calls xxx
+% called by xxx
+%
+
+function [m,pk] = wave2d_cg(m0,gk,C,chi_k_val,mu_val,istep,imaketest,gfile,chitfile)
+
+disp('------CG ALGORITHM---------');
+
+nmod = length(m0);
+mt = zeros(nmod,1);
+mk = zeros(nmod,1);
+
+if istep <= 1
+ beta_val = 0.0;
+ p0 = zeros(nmod,1);
+else
+ % load p0 and g0, the PREVIOUS gradient vectors (pk and gk)
+ if ~exist(gfile,'file'), error('gfile does not exist'); end
+ [g0,p0] = textread(gfile,'%f%f');
+
+ beta_val = ( (gk - g0)' * C * gk ) / ( g0' * C * g0 );
+ if isinf(beta_val), error('beta_val is infinity'); end
+end
+pk = -C * gk + beta_val * p0;
+lam_t_val = 2.0*(mu_val - chi_k_val) / sum( gk .* pk ); % gk is hat, pk is non-hat
+
+if imaketest==1
+ % test model
+ mt = m0 + lam_t_val*pk;
+
+else
+ % load chi for test model
+ if ~exist(chitfile,'file'), error('chitfile does not exist'); end
+ chi_t_val = load(chitfile);
+
+ % a quadratic fit requires at least 5 values
+ xx1 = 0.0;
+ xx2 = lam_t_val;
+ yy1 = chi_k_val;
+ yy2 = chi_t_val;
+ g1 = sum(gk .* pk);
+ %g1 = sum(g0 .* pk);
+
+ % coefficients of the quadratic polynomial (ax^2 + bx + c)
+ Pa = ((yy2 - yy1) - g1*(xx2 - xx1)) / (xx2^2 - xx1^2);
+ Pb = g1;
+ %Pc = yy1 - Pa*xx1^2 - Pb*xx1;
+
+ % get the analytical minimum (the vertex)
+ if (Pa ~= 0.0)
+ xmin = -Pb / (2.0*Pa);
+ else
+ error('check the quadratic input polynomial');
+ end
+
+ % compute updated model
+ lam_0_val = xmin;
+ mk = m0 + lam_0_val * pk;
+end
+
+% assign output model
+if imaketest == 1
+ m = mt;
+else
+ m = mk;
+end
+
+%=============================================================
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gll2cell.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gll2cell.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gll2cell.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,38 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+% Given an input grid (xg,yg) for which a function is defined, this
+% function returns the index of the nearest (xg,yg) point to each input
+% (x,y) point. This provides a quick vector for nearest neighbor
+% interpolation, which is of course crude.
+%
+% calls xxx
+% called by xxx
+%
+
+function [inds, dmins] = wave2d_gll2cell(xg,yg,xc,yc)
+
+nc = length(xc); % number of input points (regular mesh)
+ng = length(xg); % number of GLL gridpoints (iregugular mesh)
+
+% loop over input points
+inds = zeros(nc,1);
+dmin = zeros(nc,1);
+for ii=1:nc
+ dtemp = sqrt( (xc(ii)-xg).^2 + (yc(ii)-yg).^2 );
+ [dmin,imin] = min( dtemp );
+ inds(ii) = imin(1);
+ dmins(ii) = dmin(1);
+end
+
+iplot = 0;
+if iplot==1
+ figure; plot(xc,yc,'k.',xg(inds),yg(inds),'ro');
+ legend('cell center','closest GLL point');
+ axis equal, xlabel('x'); ylabel('y');
+ figure; plot(dmins,'k.'); axis tight;
+ xlabel('Cell index'); ylabel('Distance between cell and GLL, meters');
+end
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gnorm_sq.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gnorm_sq.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_gnorm_sq.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,40 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+%
+%
+% calls xxx
+% called by xxx
+%
+
+function norm_parts = wave2d_gnorm_sq(g,C,m_inds)
+
+g = g(:);
+[a,b] = size(C);
+if a==1, error('check dimension of C'); end
+if b==1, icdiag = 1; end
+
+npar = length(m_inds);
+
+%stfmt = repmat('%16.4e',1,npar);
+
+disp('norm of parts:');
+norm_parts = zeros(npar,1);
+for ii=1:npar
+ inds = m_inds(ii,1):m_inds(ii,2);
+ if icdiag == 1
+ norm_parts(ii) = sum( g(inds).^2 .* C(inds) );
+ else
+ norm_parts(ii) = g(inds)' * C(inds,inds) * g(inds);
+ end
+ disp(sprintf('%4i%16.4e',ii,norm_parts(ii)));
+end
+
+if 1==1
+ disp(sprintf(' 1%16.4e',sum(norm_parts(1))));
+ disp(sprintf(' 2-4%16.4e',sum(norm_parts(2:4))));
+ disp(sprintf(' 1-4%16.4e',sum(norm_parts(1:4))));
+end
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_m_gll2cell.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_m_gll2cell.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_m_gll2cell.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,34 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+%
+%
+% calls xxx
+% called by xxx
+%
+
+function m_out = wave2d_m_gll2cell(m_in,xg,yg,xc,yc,nxc,nyc,nmod_src,iopt)
+
+nc = length(xc); % regular mesh of cells
+ng = length(xg); % irregular mesh GLL points
+
+if iopt==1 % gll2cell
+ nmod_out = nc+nmod_src;
+ if length(m_in) ~= ng+nmod_src, error('check dimensions of input'); end
+
+ m_out = zeros(nmod_out,1);
+ iGLL = wave2d_gll2cell(xg,yg,xc,yc);
+ m_out(1:nc) = m_in(iGLL);
+ m_out(nc+1:nmod_out) = m_in(ng+1:ng+nmod_src);
+
+else % cell2gll
+ nmod_out = ng+nmod_src;
+ if length(m_in) ~= nc+nmod_src, error('check dimensions of input'); end
+
+ m_out = zeros(nmod_out,1);
+ m_out(1:ng) = wave2d_cell2gll(xg,yg,xc,yc,m_in(1:nc),nxc,nyc);
+ m_out(ng+1:nmod_out) = m_in(nc+1:nc+nmod_src);
+end
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_splitm.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_splitm.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_splitm.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,26 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+% This function splits a wave2d.f90 model vector into constituent parts.
+%
+% calls xxx
+% called by xxx
+%
+
+function [m_str, m_ts, m_xs, m_ys] = wave2d_splitm(m,m_inds)
+
+if length(m) ~= m_inds(4,2), error('incompatible indexing'); end
+
+m_str = m(m_inds(1,1):m_inds(1,2));
+m_ts = m(m_inds(2,1):m_inds(2,2));
+m_xs = m(m_inds(3,1):m_inds(3,2));
+m_ys = m(m_inds(4,1):m_inds(4,2));
+
+% ensure that the output are columns
+m_str = m_str(:);
+m_ts = m_ts(:);
+m_xs = m_xs(:);
+m_ys = m_ys(:);
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_grad.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_grad.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_grad.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,19 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+%
+%
+% calls xxx
+% called by xxx
+%
+
+function wave2d_write_grad(filename,gk,pk)
+
+fid = fopen(filename,'w');
+for ii = 1:length(gk)
+ fprintf(fid,'%20.10e%20.10e\n',gk(ii), pk(ii) );
+end
+fclose(fid);
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_src.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_src.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_src.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,29 @@
+%
+% function
+% Carl Tape, 25-Jan-2010
+%
+%
+%
+% calls xxx
+% called by xxx
+%
+
+function wave2d_write_src(filename,xs0,ys0,ts,xs,ys,ts_res,xs_res,ys_res)
+
+% ! sources for synthetics
+% write(20,'(8e20.10)') xtemp, ztemp, &
+% m_src_syn_vec(itemp1), m_src_syn_vec(itemp2), m_src_syn_vec(itemp3), &
+% (m_src_syn_vec(itemp1) - m_src_dat_vec(itemp1)), &
+% (m_src_syn_vec(itemp2) - m_src_dat_vec(itemp2)), &
+% m_src_syn_vec(itemp3) - m_src_dat_vec(itemp3)
+
+fid = fopen(filename,'w');
+for ii = 1:length(xs0)
+ fprintf(fid,'%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e\n',...
+ xs0(ii), ys0(ii),...
+ ts(ii), xs(ii), ys(ii),...
+ ts_res(ii), xs_res(ii), ys_res(ii) );
+end
+fclose(fid);
+
+%=========================================================
\ No newline at end of file
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_str.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_str.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wave2d_write_str.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,25 @@
+%
+% function wave2d_write_str(filename,x,y,kappa,mu,rho,B)
+% Carl Tape, 25-Jan-2010
+%
+% This function writes out a structural model that can be read in by
+% wave2d.f90.
+%
+% calls xxx
+% called by xxx
+%
+
+function wave2d_write_str(filename,x,y,kappa,mu,rho,B)
+
+% ! CURRENT MODEL (synthetics)
+% write(19,'(6e20.10)') x_plot(iglob), z_plot(iglob), &
+% kappa_syn(i,j,ispec), mu_syn(i,j,ispec), rho_syn(i,j,ispec), &
+% log( beta_syn(i,j,ispec) / beta0 )
+fid = fopen(filename,'w');
+for ii = 1:length(x)
+ fprintf(fid,'%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e\n',...
+ x(ii), y(ii), kappa(ii), mu(ii), rho(ii), B(ii) );
+end
+fclose(fid);
+
+%=========================================================
\ No newline at end of file
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wysiwyg.m (from rev 16129, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wysiwyg.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wysiwyg.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wysiwyg.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,17 @@
+function wysiwyg
+%WYSIWYG -- this function is called with no args and merely
+% changes the size of the figure on the screen to equal
+% the size of the figure that would be printed,
+% according to the papersize attribute. Use this function
+% to give a more accurate picture of what will be
+% printed.
+% Dan(K) Braithwaite, Dept. of Hydrology U.of.A 11/93
+
+unis = get(gcf,'units');
+ppos = get(gcf,'paperposition');
+set(gcf,'units',get(gcf,'paperunits'));
+pos = get(gcf,'position');
+pos(3:4) = ppos(3:4);
+set(gcf,'position',pos);
+set(gcf,'units',unis);
+
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/matlab_scripts/wysiwyg.m
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ocv_carl.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ocv_carl.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ocv_carl.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,87 +0,0 @@
-%
-% function rss_vec = ocv_carl(g, A, lamvec)
-% Carl Tape, 30-March-2006
-%
-% Copied from gcv_carl.m on 27-March-2006.
-%
-% Returns the ordinary cross-validation (OCV) function corresponding to a
-% set of input regularization (or damping) parameters.
-%
-% TWO ALGORITHMS ARE SHOWN:
-% (1) Brute force, which involves ndata inversions per lambda
-% (2) Elegant formalisum, which involves one inversion per lambda
-% --> See Latex notes
-% /home/carltape/classes/acm118/2006_handouts/hw3/hw3sol_2006_prob3.pdf
-%
-% Using some GPS data, I checked that these approaches are identical.
-%
-% calls xxx
-% called by ridge_carl.m
-%
-
-function rss_vec = ocv_carl(d, A, lamvec)
-
-% Size of inputs
-[ndata, nparm] = size(A);
-numlam = length(lamvec);
-
-if (min(lamvec) < 0)
- error('Impossible regularization parameter lambda.')
-end
-
-rss_vec = zeros(numlam,1);
-
-% loop over regularization parameters
-for ii=1:numlam
- lam = lamvec(ii);
- disp([' ii = ' num2str(ii) '/' num2str(numlam) ', lam = ' num2str(lam)]);
-
- if 1==1
- H = A*inv(A'*A + lam^2*eye(nparm))*A';
- dhat = H*d;
-
- % OCV residual
- res = (d - dhat) ./ (1 - diag(H));
-
- % sum the residuals
- rss_vec(ii) = sum(res.^2);
-
- else
- % loop over datapoints
- for jj=1:ndata
- %disp([' jj = ' num2str(jj) '/' num2str(ndata) ]);
-
- % indices for which you compute the model parameters
- switch jj
- case 1, einds = [2:ndata];
- case ndata, einds = [1:ndata-1];
- otherwise, einds = [1:jj-1 jj+1:ndata];
- end
-
- % indices to estimate the RSS
- oinds = jj;
-
- % reduced matrices
- X = A(einds,:);
- g = d(einds);
-
- % note: regularization matrix is identity matrix
- f_h = inv(X'*X + lam^2*eye(nparm))*X'*g;
-
- % estimate the model at the datapoints NOT used
- res = A(oinds,:) * f_h - d(oinds);
-
- % sum the residuals
- rss_vec(ii) = rss_vec(ii) + sum(res.^2);
- end
- end
-
-end
-
-rss_vec = rss_vec / ndata; % normalization
-
-figure; loglog(lamvec, rss_vec, '.'); grid on;
-xlabel(' Regularization parameter, log (\lambda)');
-ylabel(' RSS at datapoints NOT used in computing model');
-
-%======================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_min_4.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_min_4.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_min_4.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,123 +0,0 @@
-%
-% function xmin = quad_min_4(P,x0)
-% Carl Tape, 11-Jan-2006
-% printed xxx
-%
-% This function inputs two (x,y) points and one slope, and returns a
-% quadratic fitting polynomial, along with the (analytical) minimum value.
-%
-% calls quad_shift.m
-% called by model_optimize.m
-%
-
-function [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,opts,stlabs)
-
-ifig = opts(1); % =1 to plot figure
-isub = opts(2); % =1 to plot as a subfigure; =0 to plot as a full figure
-
-if length([x1 x2 y1 y2 g1]) ~= 5, error('check input dimensions'); end
-
-a = ((y2 - y1) - g1*(x2 - x1)) / (x2^2 - x1^2);
-b = g1;
-c = y1 - a*x1^2 - b*x1;
-%c = y2 - a*x2^2 - b*x2;
-
-% ax^2 + bx + c
-P1 = [a b c]';
-
-% a(x-b)^2 + c
-[P2,qvert,stit] = quad_shift(P1,1);
-xmin = qvert(1);
-
-if ifig==1
- if isub==1
- specs = [1 6 12 10]; fac = 0.1;
- else
- figure;
- specs = [2 14 18 12]; fac = 0.05;
- end
-
- % step COULD be negative (source inversion)
- temp = sort([x1 x2]);
- x1plot = temp(1);
- x2plot = temp(2);
- if x1 ~= x1plot
- iflip = 1;
- stlabs = [stlabs(1:2) fliplr(stlabs(3:5))]
- end
-
- axpoly = axes_expand([x1plot x2plot 0 max([y1 y2])],1.2);
- axpoly(3) = 0;
- dy = axpoly(4) - axpoly(3);
- dx = axpoly(2) - axpoly(1);
- ylab = axpoly(3) - fac*dy;
-
- ymin = polyval(P1,xmin); % quadratic function evaluation
-
- % base level for test-model parabola
- K = 0.5;
- %K = 0.0; % no model norm term or data errors
-
- % initial guess is based on a quadratic fit
- %aquad = g1^2/(4*y1);
- aquad = -g1^2/(4*(K - y1));
- Pquad = [aquad g1 y1]';
-
- % x-points for smooth curves
- n = 100; xpts = linspace(axpoly(1),axpoly(2),n);
-
- % curves through (x1,y1)
- g1_line = polyval([g1 y1-g1*x1],xpts);
- g1_test = polyval(Pquad,xpts);
- g1_quad = polyval(P1,xpts);
-
- hold on;
-
- % plot curves
- plot(xpts,g1_quad,'b','linewidth',specs(1));
- plot(xpts,g1_test,'b--');
- plot(xpts,g1_line,'r--');
-
- % plot black lines
- plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
- plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
- plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
-
- % plot markers
- plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
- plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
- %plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
-
- axis(axpoly);
- xlabel(stlabs{1},'fontsize',specs(3));
- ylabel(stlabs{2},'fontsize',specs(3));
- if isub==0
- title({stit{1},stit{2}},'fontsize',specs(3))
- grid on;
- else
- set(gca,'xtick',[x1plot x2plot],'xticklabel',{[],[]});
- %set(gca,'xtick',[x1plot xmin x2plot]),'xticklabel',{'0',[],[]};
- end
- text(x1plot,ylab,stlabs{3},'fontsize',specs(4));
- text(xmin,ylab,stlabs{4},'fontsize',specs(4));
- text(x2plot,ylab,stlabs{5},'fontsize',specs(4));
- orient tall, wysiwyg
-end
-
-if 0==1
- x1 = 0
- x2 = randomint(1,5,1)
- y1 = randomint(1,5,1)
- y2 = randomint(1,5,1)
- g1 = randomint(-5,-1,1)
-
- opts = [1 0];
- stk = num2str(0);
- stlabs = {'\lambda',['\chi^{' stk '} ( \lambda )'],'0',['\lambda_{' stk '}'],['\lambda_{' stk 't}']};
-
- [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,opts,stlabs);
- set(gca,'xtick',[-10:10],'ytick',[-10:10]);
- axis equal;
-end
-
-%=========================================================
\ No newline at end of file
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_shift.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_shift.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/quad_shift.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,66 +0,0 @@
-%
-% function [Pout,qvert,stit] = quad_shift(Pin,opts)
-% Carl Tape, 11-Jan-2006
-% printed xxx
-%
-% This function adjusts parabola (i.e., quadratic polynomial) coefficients
-% between two representations, and also returns the vertex.
-%
-% See also cubic_shift.m
-%
-% calls xxx
-% called by test_poly.m
-%
-
-function [Pout,qvert,stit] = quad_shift(Pin,opts)
-
-iopt = opts(1);
-stx = '%.3f';
-
-P = Pin(:);
-a = Pin(1);
-b = Pin(2);
-c = Pin(3);
-
-% adjust the polynomial coefficients
-if iopt == 1
- % ax^2 + bx + c --> a(x-b)^2 + c
- Pout(1) = a;
- Pout(2) = -b/(2*a);
- Pout(3) = c - b^2/(4*a);
-
- qvert = [Pout(2) Pout(3)];
-
- stit1 = ['y = ' num2str(sprintf(stx, a)) ' x^2 + ' ...
- num2str(sprintf(stx, b)) ' x + ' ...
- num2str(sprintf(stx, c)) ];
- stit2 = ['y = ' num2str(sprintf(stx, Pout(1))) ' (x - ' ...
- num2str(sprintf(stx, Pout(2))) ')^2 + ' ...
- num2str(sprintf(stx, Pout(3))) ];
-
-else
- % a(x-b)^2 + c --> ax^2 + bx + c
- if a==0
- Pout(1) = 0;
- Pout(2) = 0;
- Pout(3) = c;
- qvert = [NaN NaN];
- else
- Pout(1) = a;
- Pout(2) = -2*a*b;
- Pout(3) = a*b^2 + c;
- qvert = [b c];
- end
-
- stit1 = ['y = ' num2str(sprintf(stx, Pout(1))) ' x^2 + ' ...
- num2str(sprintf(stx, Pout(2))) ' x + ' ...
- num2str(sprintf(stx, Pout(3))) ];
- stit2 = ['y = ' num2str(sprintf(stx, a)) ' (x - ' ...
- num2str(sprintf(stx, b)) ')^2 + ' ...
- num2str(sprintf(stx, c)) ];
-end
-
-Pout = Pout(:);
-stit = {stit1,stit2};
-
-%=========================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ridge_carl.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ridge_carl.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/ridge_carl.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,227 +0,0 @@
-%
-% function
-% Carl Tape (Tapio Schneider, ACM 118)
-% 06-Nov-2006
-%
-% This function inputs a design matrix, a data vector, and a vector of
-% regularization parameters, and it returns three different curves that may
-% be used to select the best parameter:
-% (1) L-curve and curvature
-% (2) generalized cross-validation curve (GCV)
-% (3) ordinary cross-validation (OCV), also known as 'leave-one-out' CV
-%
-% It is best to input a large number of regularization parameters, so that
-% the min and max of the respective functions can be easily obtained.
-%
-% This program is copied in part from ridge_tapio.m
-%
-% NOTE THE PLOTTING OPTIONS.
-%
-%-------------------------------------------------
-% RIDGE Ridge regression estimates.
-%
-% Given a vector g, a design matrix X, and
-% a regularization parameter h,
-%
-% [m, rss, mss, dof] = ridge_tapio(g, X, h)
-%
-% returns the ridge regression estimate of the vector f in the
-% linear regression model
-%
-% g = X*f + noise.
-%
-% Also returned are the residual sum of squares rss, the sum of
-% squares mss of the elements of the ridge regression estimate
-% m (the squared norm of m), and the effective number of
-% residual degrees of freedom dof.
-%
-% If h is a vector of regularization parameters, the i-th column
-% m(:,i) is the ridge regression estimate for the regularization
-% parameter h(i); the i-th elements of rss and mss are the
-% associated residual sum of squares and estimate sum of squares.
-%
-% If no regularization parameter h is given, generalized
-% cross-validation is used to determine the regularization
-% parameter. The chosen regularization parameter h and the value of
-% the GCV function are then returned as the fifth and sixth
-% output arguments
-%
-% [m, rss, mss, dof, h, G] = ridge_tapio(g, X);
-%
-% Adapted from various routines in Per Christian Hansen's
-% Regularization Toolbox.
-%
-% calls gcvfctn.m, curvature.m
-% called by xxx
-%
-
-function [m, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dvec, X, hvec)
-
-% Size of inputs
-[n, p] = size(X);
-q = min(n, p);
-nh = length(hvec);
-if (min(hvec) < 0)
- error('Impossible regularization parameter h.')
-end
-
-% Initialize outputs
-m = zeros(p, nh);
-rss = zeros(nh, 1);
-mss = zeros(nh, 1);
-dof = zeros(nh, 1);
-
-% Compute SVD of X
-[U, S, V] = svd(X, 0);
-s = diag(S); % vector of singular values
-s2 = s.^2;
-
-% Coefficients in expansion of solution in terms of right singular vectors
-fc = U(:, 1:q)'*dvec;
-zeta = s .* fc;
-
-% Treat each regularization parameter separately
-for j = 1:nh
- m(:, j) = V(:, 1:q) * (zeta ./ (s2 + hvec(j)^2));
- mss(j) = sum(m(:, j).^2);
- rss(j) = hvec(j)^4 * sum(fc.^2 ./ (s2 + hvec(j)^2).^2);
- dof(j) = n - sum(s2./(s2 + hvec(j)^2));
-end
-
-% In overdetermined case, add rss of least-squares problem
-if (n > p)
- rss = rss + sum((dvec - U(:, 1:q)*fc).^2);
-end
-
-%-----------------------
-% determine the Lcurve pick (max curvature)
-
-x1 = log10(rss);
-y1 = log10(mss);
-
-% % smooth curvature interpolation to get h_L
-% num = 1000;
-% xsmooth = linspace(x1(1),x1(end),1000);
-% ysmooth = interp1(x1,y1,xsmooth,'cubic');
-% [i0,kap_smooth] = curvature(xsmooth,ysmooth);
-% rss_L = 10^xsmooth(i0);
-% mss_L = 10^ysmooth(i0);
-% h_L = 10^interp1(x1,log10(hvec),xsmooth(i0),'cubic');
-
-% curvature, based on input h values alone
-[iL,kap] = curvature(x1,y1);
-%h_L = hvec(iL);
-%rss_L = 10^x1(iL);
-%mss_L = 10^y1(iL);
-
-%-----------------------
-% obtain GCV `best' solution and GCV curve
-
-% GCV minimum -- 'exact' in the sense a minimization method is used
-% [hmin, Gmin] = gcv_tapio(U, s, dvec, 'ridge');
-
-% GCV minimum -- 'crude' in the sense that we coarsely sample the function
-dof0 = n-q;
-rss0 = sum((dvec - U(:, 1:q)*fc).^2);
-Gvec = zeros(nh,1);
-for j = 1:nh
- Gvec(j) = gcvfctn(hvec(j), s2, fc, rss0, dof0);
-end
-[Gmin,iGCV] = min(Gvec);
-%hmin = hvec(iGCV);
-
-% GCV best model and L-curve point for h_GCV (= hmin)
-%mod_min = inv(X'*X + hmin^2*eye(p))*X'*dvec;
-%res = X*mod_min - dvec;
-%rss_min = sum(res.^2);
-%mss_min = sum(mod_min.^2);
-
-% compute G for the Lcurve pick
-%G_L = gcvfctn(h_L, s2, fc, rss0, dof0);
-
-%-----------------------
-% ordinary (leave-one-out) cross-validation
-
-Fvec = ocv_carl(dvec, X, hvec);
-[Fmin,iOCV] = min(Fvec);
-
-%======================================================
-% PLOTTING
-
-lamL = hvec(iL); GL = Gvec(iL); rssL = rss(iL); mssL = mss(iL); kapL = kap(iL); FL = Fvec(iL);
-lamF = hvec(iOCV); GF = Gvec(iOCV); rssF = rss(iOCV); mssF = mss(iOCV); kapF = kap(iOCV); FF = Fvec(iOCV);
-lamG = hvec(iGCV); GG = Gvec(iGCV); rssG = rss(iGCV); mssG = mss(iGCV); kapG = kap(iGCV); FG = Fvec(iGCV);
-
-x1 = log10(rss);
-y1 = log10(mss);
-x2 = log10(hvec);
-y2 = kap;
-x3 = log10(hvec);
-y3 = log10(Fvec);
-x4 = log10(hvec);
-y4 = log10(Gvec);
-
-stx1 = ' Misfit norm, log10 RSS';
-sty1 = ' Model norm, log10 MSS';
-stx2 = ' Regularization parameter, log10 \lambda';
-sty2 = ' Curvature of L-curve, \kappa(\lambda)';
-stx3 = stx2;
-sty3 = ' OCV function, log10 F(\lambda)';
-stx4 = stx2;
-sty4 = ' GCV function, log10 G(\lambda)';
-
-%stfm = '%.4f';
-stfm = '%.2e';
-stlam_L = [' \lambda-L = ' num2str(sprintf(stfm, lamL))];
-stlam_ocv = [' \lambda-OCV = ' num2str(sprintf(stfm, lamF))];
-stlam_gcv = [' \lambda-GCV = ' num2str(sprintf(stfm, lamG))];
-
-%------------------------
-figure; nr=2; nc=2;
-msize = 8;
-nlab = 10; ilabs = round(linspace(1,nh,nlab));
-
-subplot(nr,nc,1); hold on;
-plot(x1,y1,'.');
-plot(log10(rssL),log10(mssL),'ko','markersize',8,'MarkerFaceColor','r');
-plot(log10(rssG),log10(mssG),'kV','markersize',8,'MarkerFaceColor','g');
-plot(log10(rssF),log10(mssF),'k^','markersize',8,'MarkerFaceColor','c');
-axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
-axy = axis; dx = axy(2)-axy(1);
-for kk=1:nlab
- ii = ilabs(kk);
- text(x1(ii)+dx*0.02,y1(ii),[num2str(sprintf(stfm, hvec(ii)))],'fontsize',8,'color','b');
-end
-legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv);
-xlabel(stx1); ylabel(sty1); grid on;
-
-subplot(nr,nc,2); hold on;
-plot(x2,y2,'.');
-plot(log10(lamL),kapL,'ko','markersize',8,'MarkerFaceColor','r');
-plot(log10(lamG),kapG,'kV','markersize',8,'MarkerFaceColor','g');
-plot(log10(lamF),kapF,'k^','markersize',8,'MarkerFaceColor','c');
-axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
-legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northwest');
-xlabel(stx2); ylabel(sty2); grid on;
-
-subplot(nr,nc,3); hold on;
-plot(x3,y3,'.');
-plot(log10(lamL),log10(FL),'ko','markersize',8,'MarkerFaceColor','r');
-plot(log10(lamG),log10(FG),'kV','markersize',8,'MarkerFaceColor','g');
-plot(log10(lamF),log10(FF),'k^','markersize',8,'MarkerFaceColor','c');
-axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
-legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northeast');
-xlabel(stx3); ylabel(sty3); grid on;
-
-subplot(nr,nc,4); hold on;
-plot(x4,y4,'.');
-plot(log10(lamL),log10(GL),'ko','markersize',8,'MarkerFaceColor','r');
-plot(log10(lamG),log10(GG),'kV','markersize',8,'MarkerFaceColor','g');
-plot(log10(lamF),log10(GF),'k^','markersize',8,'MarkerFaceColor','c');
-axis tight; ax1 = axis; axis(axes_expand(ax1,1.1));
-legend(' \lambda',stlam_L,stlam_gcv,stlam_ocv,'location','northwest');
-xlabel(stx4); ylabel(sty4); grid on;
-
-orient tall, wysiwyg, fontsize(9)
-
-%======================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/theoryHyp.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/theoryHyp.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/theoryHyp.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,37 +0,0 @@
-%
-% function y = theoryHyp(m, param)
-% CARL TAPE, 15-Nov-2003
-% printed xxx
-%
-% Output is a set of y-data based on four
-% parameters that describe the hyperbola.
-%
-% hyperbola: Ax + Bxy + Cy + D = 0
-%
-% Note that this is a LINEAR problem, Ax = b :
-%
-% | x x*y y 1 | | A | | 0 |
-% | : : : : | | B | = | : |
-% | : : : : | | C | | : |
-% | : : : : | | D | | : |
-% | : : : : | | : |
-%
-%
-% See /matlab/scicomp/getellipse.m
-%
-% calls xxx
-% called by c101D.m, testgenfitC.m, model_optimize2.m
-%
-
-function y = theoryHyp(m, param)
-
-% input parameters (x-coordinates of data)
-x = param(:);
-
-% model parameters that we solve for
-A = m(1); B = m(2); C = m(3); D = m(4);
-
-% hyperbola: Ax + Bxy + Cy + D = 0
-y = (-A*x - D) ./ (B*x + C);
-
-%================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,431 +0,0 @@
-%
-% wave2d_cg_figs.m
-% CARL TAPE, 21-Nov-2008
-% printed xxx
-%
-% This program is called following wave2d_cg_poly.m.
-%
-% calls xxx
-% called by xxx
-%
-
-%irun0 = 140;
-
-stfm = '%4.4i';
-
-% axes limits
-n1 = 0;
-n2 = 8;
-n2 = 17;
-%ax_chi = [n1-1 n2 10^0 axpoly(4)];
-%ax_chi = [n1-1 n2 10.^[0 4]];
-ax_chi = [n1-1 n2 10.^[-1 3] ];
-ax_var = [n1-1 n2 0 100];
-
-%n2 = 4; ax_chi = [n1-1 n2 10^-2 10^3];
-
-% dir0 from wave2d_cg_poly.m
-dir1 = [dir0 '/PLOTTING/DATA_FILES/'];
-if ~exist(dir1), error([dir1 ' does not exist']); end
-
-%==================================================================
-
-ww = ['poly_run' num2str(sprintf(stfm,irun0))];
-if 1==1
- save(ww,'ax_chi','ax_var','its','chis','its_smooth','chifit_smooth',...
- 'x_var_fit','var_red1_fit','x_var','var_red1',...
- 'axpoly','xpts','g1_line','g1_quad_test','g1_cube_fit','g2_line','g1_quad_fit',...
- 'x1','y1','x2','y2','xmin','ymin','chi');
- %break
-else
- load(ww);
-end
-
-specs = [1 6 12 10];
-xticks = [n1:n2];
-
-if 1==1
- % write curves to file
- ww = ['poly_curve_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(xpts)
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
- xpts(ii),g1_line(ii),g2_line(ii),g1_quad_test(ii),g1_cube_fit(ii),g1_quad_fit(ii) );
- end
- fclose(fid);
-
- % write points to file
- ww = ['poly_points_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- xptsQ = [x1 x2 x2 xmin xmin xmin 0];
- yptsQ = [y1 0 y2 0 ymin chi chi];
- for ii=1:length(xptsQ)
- fprintf(fid,'%16.7e %16.7e \n',xptsQ(ii),yptsQ(ii) );
- end
- fclose(fid);
-
- % write chi fit to file
- ww = ['chi_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(chis)
- fprintf(fid,'%16.7e %16.7e \n',its(ii),chis(ii) );
- end
- fclose(fid);
-
- % write chi fit to file
- ww = ['chi_curve_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(chifit_smooth)
- fprintf(fid,'%16.7e %16.7e \n',its_smooth(ii),chifit_smooth(ii) );
- end
- fclose(fid);
-
- % write var fit to file
- ww = ['var_fit_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(var_red1_fit)
- fprintf(fid,'%16.7e %16.7e \n',x_var_fit(ii),var_red1_fit(ii) );
- end
- fclose(fid);
-
- % write var to file
- ww = ['var_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(var_red1)
- fprintf(fid,'%16.7e %16.7e \n',x_var(ii),var_red1(ii) );
- end
- fclose(fid);
-
- % write axes to file
- ww = ['axes_' num2str(sprintf(stfm, irun0)) '.dat'];
- fid = fopen([dir1 ww],'w');
- fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',axpoly(1),axpoly(2),axpoly(3),axpoly(4));
- fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',ax_chi(1),ax_chi(2),ax_chi(3),ax_chi(4));
- fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',ax_var(1),ax_var(2),ax_var(3),ax_var(4));
- fclose(fid);
-end
-
-figure; nr=5; nc=4;
-subplot(nr,nc,1); hold on;
-
-subplot(nr,nc,2); hold on;
-
-subplot(nr,nc,3); hold on;
-
-subplot(nr,nc,4); hold on; axis(axpoly);
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
-
-subplot(nr,nc,5); hold on;
-
-subplot(nr,nc,6); hold on; axis(axpoly);
-plot(xpts,g1_line,'r--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
-
-subplot(nr,nc,7); hold on; axis(axpoly);
-plot(xpts,g1_line,'r--');
-plot(xpts,g1_quad_test,'b--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
-plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
-
-subplot(nr,nc,8); hold on;
-
-subplot(nr,nc,9); hold on;
-
-subplot(nr,nc,10); hold on; axis(axpoly);
-plot(xpts,g1_line,'r--');
-plot(xpts,g1_quad_test,'b--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
-plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
-plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
-plot(x2,y2,'ko','markersize',specs(2),'MarkerFaceColor','b');
-
-subplot(nr,nc,11); hold on;
-
-subplot(nr,nc,12); hold on; axis(axpoly);
-plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
-plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
-plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
-
-subplot(nr,nc,13); hold on; axis(axpoly);
-plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
-plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
-plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
-plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
-plot(xmin,ymin,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
-
-subplot(nr,nc,14); hold on;
-
-subplot(nr,nc,15); hold on;
-
-subplot(nr,nc,16); hold on; axis(axpoly);
-plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
-plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
-plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
-plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
-plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
-plot([xmin xmin axpoly(1)],[0 chi chi],'k');
-plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
-plot(xmin,ymin,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
-plot(xmin,chi,'ko','markersize',specs(2),'MarkerFaceColor','b');
-
-
-subplot(nr,nc,17); hold on; axis(axpoly);
-plot([x1 x1 axpoly(1)],[0 ymin ymin],'k');
-plot(x1,ymin,'ko','markersize',specs(2),'MarkerFaceColor','b');
-
-%subplot(nr,nc,18); hold on;
-
-subplot(nr,nc,19);
-semilogy(its_smooth,chifit_smooth,'r--',its(1:2),chis(1:2),'bo',...
- 'linewidth',specs(1),'markersize',specs(2),'MarkerFaceColor','b');
-set(gca,'xtick',xticks,'ytick',[10 100 1000 2000 6000])
-xlabel(' model number (iteration)'); ylabel(' \chi(m)');
-axis(ax_chi);
-
-subplot(nr,nc,20); hold on; axis(ax_var);
-plot(x_var_fit,var_red1_fit,'r--','markersize',specs(2),'linewidth',specs(1));
-plot(x_var(1),var_red1(1),'bo','markersize',specs(2),'MarkerFaceColor','b');
-set(gca,'xtick',xticks,'ytick',[0:20:100]);
-xlabel(' model number (iteration)');
-ylabel(' variance reduction');
-
-fontsize(8); orient tall, wysiwyg
-
-%======================================================================
-
-break
-
-irun0_vec = [400:20:500];
-gam_vec = [15:15:90]';
-nrun = length(irun0_vec);
-
-niter = 8;
-
-nr=5; nc=2;
-m1 = counter(1,5,1,2);
-for k = 0:niter
- jj = m1(k+1);
- if mod(jj,5)==1, fontsize(7), orient tall, wysiwyg, figure; end
- disp([k jj jj*2-1 jj*2]);
-
- % load the chi values for this irun0 sequence
- stfm = '%3.3i';
- dir1 = '/home/carltape/wave2d/2d_adjoint/OUTPUT/';
- chi_vec = zeros(nrun,1);
- for ii=1:nrun
- irun = irun0_vec(ii) + k*2;
- stf = [dir1 'run_' num2str(sprintf(stfm,irun)) '/'];
- ww = 'summed_chi_all';
- load([stf ww '.dat']);
- chi = eval(ww);
- chi_vec(ii) = chi;
- irun_vec(ii) = irun;
- end
-
- subplot(nr,nc,jj*2-1); hold on;
- plot(1./gam_vec,chi_vec,'b.-','markersize',24);
-
- alims = axis;
- dy = alims(4) - alims(3);
- dx = alims(2) - alims(1);
-
- for ii=1:nrun
- irun = irun0_vec(ii) + k*2;
- text(1/gam_vec(ii),chi_vec(ii)+0.05*dy,...
- [ num2str(sprintf('%.1f', gam_vec(ii))) ' km (' num2str(irun) ')'],'fontsize',6);
- %text(1/gam_vec(ii),chi_vec(ii)+0.05*dy,[num2str(sprintf('%.1f', gam_vec(ii))) ' km'],'fontsize',6);
- %text(1/gam_vec(ii),chi_vec(ii)-0.05*dy,['(irun = ' num2str(irun_vec(ii)) ')'],'fontsize',6);
- end
- grid on;
- %xlabel(' roughness, 1 / \gamma (\gamma determines Gaussian width for smoothing)');
- %ylabel(' misfit for m8');
- ylabel(['chi-vs-(1/\gamma) for model m' num2str(k)]);
-
- subplot(nr,nc,jj*2); hold on;
- plot(gam_vec,chi_vec,'b.-','markersize',24);
- for ii=1:nrun
- irun = irun0_vec(ii) + k*2;
- text(gam_vec(ii),chi_vec(ii)+0.05*dy,...
- [ num2str(sprintf('%.1f', gam_vec(ii))) ' km (' num2str(irun) ')'],'fontsize',6);
- %text(gam_vec(ii),chi_vec(ii)+0.05*dy,[num2str(sprintf('%.1f', gam_vec(ii))) ' km'],'fontsize',6);
- %text(gam_vec(ii),chi_vec(ii)-0.05*dy,['(irun = ' num2str(irun) ')'],'fontsize',6);
- end
- grid on;
- %xlabel(' smoothing, \sigma (\sigma determines Gaussian width for smoothing)');
- %ylabel(' misfit for m8');
- ylabel(['chi-vs-\gamma for model m' num2str(k)]);
-end
-fontsize(7), orient tall, wysiwyg
-
-%---------------
-
-figure; hold on;
-
-stc = {'r','y','g','b','m','k'};
-
-dir1 = '/home/carltape/wave2d/2d_adjoint/gji_paper/figures/';
-for ii=1:nrun
- irun0 = irun0_vec(ii);
-
- % fitting curve
- ww = ['chi_curve_' num2str(sprintf(stfm, irun0)) ];
- load([dir1 ww '.dat']); temp = eval(ww);
- its_smooth = temp(:,1);
- chi_smooth = temp(:,2);
-
- %ww = ['chi_' num2str(sprintf(stfm, irun0)) ];
- %load([dir1 ww '.dat']); temp = eval(ww);
- %its = temp(:,1);
- %chis = temp(:,2);
-
- plot(its_smooth,log10(chi_smooth),stc{ii});
- %plot(its,log10(chis),[stc{ii} '.'],'markersize',16);
-end
-grid on; xlabel(' iteration'); ylabel(' log10(chi)');
-legend(['\gamma = ' num2str(gam_vec(1))],['\gamma = ' num2str(gam_vec(2))],['\gamma = ' num2str(gam_vec(3))],...
- ['\gamma = ' num2str(gam_vec(4))],['\gamma = ' num2str(gam_vec(5))],['\gamma = ' num2str(gam_vec(6))]);
-for ii=1:nrun
- irun0 = irun0_vec(ii);
- ww = ['chi_' num2str(sprintf(stfm, irun0)) ];
- load([dir1 ww '.dat']); temp = eval(ww);
- its = temp(:,1);
- chis = temp(:,2);
- plot(its,log10(chis),[stc{ii} '.'],'markersize',16);
-end
-
-
-if 0==1
- dir1 = '/home/store2/carltape/OUTPUT/run_001/';
- dir2 = [dir1 'event_001/'];
-
- % load source time function
- ww = 'stffor_00001_1'; load([dir2 ww]); temp = eval(ww);
- ti = temp(:,1); f = temp(:,2);
-
- % load data, synthetics, adjoint source
- ww = 'dat_00001_1'; load([dir2 ww]); temp = eval(ww); s_dat = temp(:,2);
- ww = 'syn_00001_1'; load([dir2 ww]); temp = eval(ww); s_syn = temp(:,2);
- ww = 'stfadj_00001_1'; load([dir2 ww]); temp = eval(ww); f_adj = temp(:,2);
-
- % compute velocity
- sv_dat = gradient(s_dat,ti);
- sv_syn = gradient(s_syn,ti);
-
- % specify cut time for time series
- tall = [ti f s_dat s_syn sv_dat sv_syn f_adj];
- tmax = 175;
- ikeep = find(ti <= tmax);
- tall = tall(ikeep,:);
- ti = tall(:,1);
- tall(:,7) = flipud(tall(:,7));
-
- % axes limits
- pwr_vec = [8 -4 -4 4];
- cmx_vec = [4 5 2 2];
- for ii=1:length(pwr_vec), max_vec(ii) = cmx_vec(ii) * 10^pwr_vec(ii); end
- ax_mat = [0 tmax -max_vec(1) max_vec(1)
- 0 tmax -max_vec(2) max_vec(2)
- 0 tmax -max_vec(3) max_vec(3)
- 0 tmax -max_vec(4) max_vec(4) ];
-
- % plot
- figure; nr=4; nc=1;
- subplot(nr,nc,1); plot(ti,tall(:,2),'b'); axis(ax_mat(1,:)); ylabel(' source time function');
- subplot(nr,nc,2); plot(ti,tall(:,4),'r--',ti,tall(:,3),'b'); axis(ax_mat(2,:)); ylabel(' displacement (data, syn)');
- subplot(nr,nc,3); plot(ti,tall(:,6),'r--',ti,tall(:,5),'b'); axis(ax_mat(3,:)); ylabel(' velocity (data, syn)');
- subplot(nr,nc,4); plot(ti,tall(:,7),'b'); axis(ax_mat(4,:)); ylabel(' tt xcorr adjoint source');
- fontsize(8); orient tall, wysiwyg
-
- % write the data to a file
- ww = ['time_series.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(ti)
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
- tall(ii,1),tall(ii,2),tall(ii,3),tall(ii,4),tall(ii,5),tall(ii,6),tall(ii,7));
- end
- fclose(fid);
-
- % write the axes info to file
- ww = ['time_series_axes.dat'];
- fid = fopen([dir1 ww],'w');
- fprintf(fid,'%16i%16i%16i%16i\n',pwr_vec(1),pwr_vec(2),pwr_vec(3),pwr_vec(4));
- fprintf(fid,'%16i%16i%16i%16i\n',cmx_vec(1),cmx_vec(2),cmx_vec(3),cmx_vec(4));
- for ii=1:length(ax_mat)
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',...
- ax_mat(ii,1),ax_mat(ii,2),ax_mat(ii,3),ax_mat(ii,4));
- end
- fclose(fid);
-end
-
-if 0==1
- dir1 = '/home/store2/carltape/OUTPUT/run_002/'; % note run 002
- dir2 = [dir1 'event_001/'];
-
- % load source time function, synthetics, adjoint source
- ww = 'stffor_00001_1'; load([dir2 ww]); temp = eval(ww); ti = temp(:,1); f = temp(:,2);
- ww = 'syn_00001_1'; load([dir2 ww]); temp = eval(ww); s_syn = temp(:,2);
- ww = 'stfadj_00001_1'; load([dir2 ww]); temp = eval(ww); f_adj = temp(:,2);
-
- % compute velocity
- sv_syn = gradient(s_syn,ti);
-
- % specify cut time for time series
- tall = zeros(length(ti),7);
- tall(:,1) = ti;
- tall(:,2) = f;
- tall(:,4) = s_syn;
- tall(:,6) = sv_syn;
- tall(:,7) = f_adj;
- tmax = 175;
- ikeep = find(ti <= tmax);
- tall = tall(ikeep,:);
- ti = tall(:,1);
- tall(:,7) = flipud(tall(:,7));
-
- % axes limits
- pwr_vec = [8 -4 -4 3];
- cmx_vec = [4 5 1.8 2];
- for ii=1:length(pwr_vec), max_vec(ii) = cmx_vec(ii) * 10^pwr_vec(ii); end
- ax_mat = [0 tmax -max_vec(1) max_vec(1)
- 0 tmax -max_vec(2) max_vec(2)
- 0 tmax -max_vec(3) max_vec(3)
- 0 tmax -max_vec(4) max_vec(4) ];
-
- % plot
- figure; nr=4; nc=1;
- subplot(nr,nc,1); plot(ti,tall(:,2),'b'); axis(ax_mat(1,:)); ylabel(' source time function');
- subplot(nr,nc,2); plot(ti,tall(:,4),'r--'); axis(ax_mat(2,:)); ylabel(' displacement (syn)');
- subplot(nr,nc,3); plot(ti,tall(:,6),'r--'); axis(ax_mat(3,:)); ylabel(' velocity (syn)');
- subplot(nr,nc,4); plot(ti,tall(:,7),'b'); axis(ax_mat(4,:)); ylabel(' tt xcorr adjoint source');
- fontsize(8); orient tall, wysiwyg
-
- % write the data to a file
- ww = ['time_series.dat'];
- fid = fopen([dir1 ww],'w');
- for ii=1:length(ti)
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
- tall(ii,1),tall(ii,2),tall(ii,3),tall(ii,4),tall(ii,5),tall(ii,6),tall(ii,7));
- end
- fclose(fid);
-
- % write the axes info to file
- ww = ['time_series_axes.dat'];
- fid = fopen([dir1 ww],'w');
- fprintf(fid,'%16i%16i%16i%16i\n',pwr_vec(1),pwr_vec(2),pwr_vec(3),pwr_vec(4));
- fprintf(fid,'%16i%16i%16i%16i\n',cmx_vec(1),cmx_vec(2),cmx_vec(3),cmx_vec(4));
- for ii=1:length(ax_mat)
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',...
- ax_mat(ii,1),ax_mat(ii,2),ax_mat(ii,3),ax_mat(ii,4));
- end
- fclose(fid);
-end
-
-%===============================================
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,431 @@
+%
+% wave2d_cg_figs.m
+% CARL TAPE, 21-Nov-2008
+% printed xxx
+%
+% This program is called following wave2d_cg_poly.m.
+%
+% calls xxx
+% called by xxx
+%
+
+%irun0 = 140;
+
+stfm = '%4.4i';
+
+% axes limits
+n1 = 0;
+n2 = 8;
+n2 = 17;
+%ax_chi = [n1-1 n2 10^0 axpoly(4)];
+%ax_chi = [n1-1 n2 10.^[0 4]];
+ax_chi = [n1-1 n2 10.^[-1 3] ];
+ax_var = [n1-1 n2 0 100];
+
+%n2 = 4; ax_chi = [n1-1 n2 10^-2 10^3];
+
+% dir0 from wave2d_cg_poly.m
+dir1 = [dir0 '/PLOTTING/DATA_FILES/'];
+if ~exist(dir1), error([dir1 ' does not exist']); end
+
+%==================================================================
+
+ww = ['poly_run' num2str(sprintf(stfm,irun0))];
+if 1==1
+ save(ww,'ax_chi','ax_var','its','chis','its_smooth','chifit_smooth',...
+ 'x_var_fit','var_red1_fit','x_var','var_red1',...
+ 'axpoly','xpts','g1_line','g1_quad_test','g1_cube_fit','g2_line','g1_quad_fit',...
+ 'x1','y1','x2','y2','xmin','ymin','chi');
+ %break
+else
+ load(ww);
+end
+
+specs = [1 6 12 10];
+xticks = [n1:n2];
+
+if 1==1
+ % write curves to file
+ ww = ['poly_curve_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(xpts)
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
+ xpts(ii),g1_line(ii),g2_line(ii),g1_quad_test(ii),g1_cube_fit(ii),g1_quad_fit(ii) );
+ end
+ fclose(fid);
+
+ % write points to file
+ ww = ['poly_points_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ xptsQ = [x1 x2 x2 xmin xmin xmin 0];
+ yptsQ = [y1 0 y2 0 ymin chi chi];
+ for ii=1:length(xptsQ)
+ fprintf(fid,'%16.7e %16.7e \n',xptsQ(ii),yptsQ(ii) );
+ end
+ fclose(fid);
+
+ % write chi fit to file
+ ww = ['chi_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(chis)
+ fprintf(fid,'%16.7e %16.7e \n',its(ii),chis(ii) );
+ end
+ fclose(fid);
+
+ % write chi fit to file
+ ww = ['chi_curve_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(chifit_smooth)
+ fprintf(fid,'%16.7e %16.7e \n',its_smooth(ii),chifit_smooth(ii) );
+ end
+ fclose(fid);
+
+ % write var fit to file
+ ww = ['var_fit_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(var_red1_fit)
+ fprintf(fid,'%16.7e %16.7e \n',x_var_fit(ii),var_red1_fit(ii) );
+ end
+ fclose(fid);
+
+ % write var to file
+ ww = ['var_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(var_red1)
+ fprintf(fid,'%16.7e %16.7e \n',x_var(ii),var_red1(ii) );
+ end
+ fclose(fid);
+
+ % write axes to file
+ ww = ['axes_' num2str(sprintf(stfm, irun0)) '.dat'];
+ fid = fopen([dir1 ww],'w');
+ fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',axpoly(1),axpoly(2),axpoly(3),axpoly(4));
+ fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',ax_chi(1),ax_chi(2),ax_chi(3),ax_chi(4));
+ fprintf(fid,'%16.7e %16.7e %16.7e %16.7e \n',ax_var(1),ax_var(2),ax_var(3),ax_var(4));
+ fclose(fid);
+end
+
+figure; nr=5; nc=4;
+subplot(nr,nc,1); hold on;
+
+subplot(nr,nc,2); hold on;
+
+subplot(nr,nc,3); hold on;
+
+subplot(nr,nc,4); hold on; axis(axpoly);
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
+
+subplot(nr,nc,5); hold on;
+
+subplot(nr,nc,6); hold on; axis(axpoly);
+plot(xpts,g1_line,'r--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
+
+subplot(nr,nc,7); hold on; axis(axpoly);
+plot(xpts,g1_line,'r--');
+plot(xpts,g1_quad_test,'b--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
+plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+
+subplot(nr,nc,8); hold on;
+
+subplot(nr,nc,9); hold on;
+
+subplot(nr,nc,10); hold on; axis(axpoly);
+plot(xpts,g1_line,'r--');
+plot(xpts,g1_quad_test,'b--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+plot(x1,y1,'ko','markersize',specs(2),'MarkerFaceColor','b');
+plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+plot(x2,y2,'ko','markersize',specs(2),'MarkerFaceColor','b');
+
+subplot(nr,nc,11); hold on;
+
+subplot(nr,nc,12); hold on; axis(axpoly);
+plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+plot(x2,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+
+subplot(nr,nc,13); hold on; axis(axpoly);
+plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
+plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
+plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+plot(xmin,ymin,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+
+subplot(nr,nc,14); hold on;
+
+subplot(nr,nc,15); hold on;
+
+subplot(nr,nc,16); hold on; axis(axpoly);
+plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
+plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
+plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
+plot([xmin xmin axpoly(1)],[0 chi chi],'k');
+plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+plot(xmin,ymin,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+plot(xmin,chi,'ko','markersize',specs(2),'MarkerFaceColor','b');
+
+
+subplot(nr,nc,17); hold on; axis(axpoly);
+plot([x1 x1 axpoly(1)],[0 ymin ymin],'k');
+plot(x1,ymin,'ko','markersize',specs(2),'MarkerFaceColor','b');
+
+%subplot(nr,nc,18); hold on;
+
+subplot(nr,nc,19);
+semilogy(its_smooth,chifit_smooth,'r--',its(1:2),chis(1:2),'bo',...
+ 'linewidth',specs(1),'markersize',specs(2),'MarkerFaceColor','b');
+set(gca,'xtick',xticks,'ytick',[10 100 1000 2000 6000])
+xlabel(' model number (iteration)'); ylabel(' \chi(m)');
+axis(ax_chi);
+
+subplot(nr,nc,20); hold on; axis(ax_var);
+plot(x_var_fit,var_red1_fit,'r--','markersize',specs(2),'linewidth',specs(1));
+plot(x_var(1),var_red1(1),'bo','markersize',specs(2),'MarkerFaceColor','b');
+set(gca,'xtick',xticks,'ytick',[0:20:100]);
+xlabel(' model number (iteration)');
+ylabel(' variance reduction');
+
+fontsize(8); orient tall, wysiwyg
+
+%======================================================================
+
+break
+
+irun0_vec = [400:20:500];
+gam_vec = [15:15:90]';
+nrun = length(irun0_vec);
+
+niter = 8;
+
+nr=5; nc=2;
+m1 = counter(1,5,1,2);
+for k = 0:niter
+ jj = m1(k+1);
+ if mod(jj,5)==1, fontsize(7), orient tall, wysiwyg, figure; end
+ disp([k jj jj*2-1 jj*2]);
+
+ % load the chi values for this irun0 sequence
+ stfm = '%3.3i';
+ dir1 = '/home/carltape/wave2d/2d_adjoint/OUTPUT/';
+ chi_vec = zeros(nrun,1);
+ for ii=1:nrun
+ irun = irun0_vec(ii) + k*2;
+ stf = [dir1 'run_' num2str(sprintf(stfm,irun)) '/'];
+ ww = 'summed_chi_all';
+ load([stf ww '.dat']);
+ chi = eval(ww);
+ chi_vec(ii) = chi;
+ irun_vec(ii) = irun;
+ end
+
+ subplot(nr,nc,jj*2-1); hold on;
+ plot(1./gam_vec,chi_vec,'b.-','markersize',24);
+
+ alims = axis;
+ dy = alims(4) - alims(3);
+ dx = alims(2) - alims(1);
+
+ for ii=1:nrun
+ irun = irun0_vec(ii) + k*2;
+ text(1/gam_vec(ii),chi_vec(ii)+0.05*dy,...
+ [ num2str(sprintf('%.1f', gam_vec(ii))) ' km (' num2str(irun) ')'],'fontsize',6);
+ %text(1/gam_vec(ii),chi_vec(ii)+0.05*dy,[num2str(sprintf('%.1f', gam_vec(ii))) ' km'],'fontsize',6);
+ %text(1/gam_vec(ii),chi_vec(ii)-0.05*dy,['(irun = ' num2str(irun_vec(ii)) ')'],'fontsize',6);
+ end
+ grid on;
+ %xlabel(' roughness, 1 / \gamma (\gamma determines Gaussian width for smoothing)');
+ %ylabel(' misfit for m8');
+ ylabel(['chi-vs-(1/\gamma) for model m' num2str(k)]);
+
+ subplot(nr,nc,jj*2); hold on;
+ plot(gam_vec,chi_vec,'b.-','markersize',24);
+ for ii=1:nrun
+ irun = irun0_vec(ii) + k*2;
+ text(gam_vec(ii),chi_vec(ii)+0.05*dy,...
+ [ num2str(sprintf('%.1f', gam_vec(ii))) ' km (' num2str(irun) ')'],'fontsize',6);
+ %text(gam_vec(ii),chi_vec(ii)+0.05*dy,[num2str(sprintf('%.1f', gam_vec(ii))) ' km'],'fontsize',6);
+ %text(gam_vec(ii),chi_vec(ii)-0.05*dy,['(irun = ' num2str(irun) ')'],'fontsize',6);
+ end
+ grid on;
+ %xlabel(' smoothing, \sigma (\sigma determines Gaussian width for smoothing)');
+ %ylabel(' misfit for m8');
+ ylabel(['chi-vs-\gamma for model m' num2str(k)]);
+end
+fontsize(7), orient tall, wysiwyg
+
+%---------------
+
+figure; hold on;
+
+stc = {'r','y','g','b','m','k'};
+
+dir1 = '/home/carltape/wave2d/2d_adjoint/gji_paper/figures/';
+for ii=1:nrun
+ irun0 = irun0_vec(ii);
+
+ % fitting curve
+ ww = ['chi_curve_' num2str(sprintf(stfm, irun0)) ];
+ load([dir1 ww '.dat']); temp = eval(ww);
+ its_smooth = temp(:,1);
+ chi_smooth = temp(:,2);
+
+ %ww = ['chi_' num2str(sprintf(stfm, irun0)) ];
+ %load([dir1 ww '.dat']); temp = eval(ww);
+ %its = temp(:,1);
+ %chis = temp(:,2);
+
+ plot(its_smooth,log10(chi_smooth),stc{ii});
+ %plot(its,log10(chis),[stc{ii} '.'],'markersize',16);
+end
+grid on; xlabel(' iteration'); ylabel(' log10(chi)');
+legend(['\gamma = ' num2str(gam_vec(1))],['\gamma = ' num2str(gam_vec(2))],['\gamma = ' num2str(gam_vec(3))],...
+ ['\gamma = ' num2str(gam_vec(4))],['\gamma = ' num2str(gam_vec(5))],['\gamma = ' num2str(gam_vec(6))]);
+for ii=1:nrun
+ irun0 = irun0_vec(ii);
+ ww = ['chi_' num2str(sprintf(stfm, irun0)) ];
+ load([dir1 ww '.dat']); temp = eval(ww);
+ its = temp(:,1);
+ chis = temp(:,2);
+ plot(its,log10(chis),[stc{ii} '.'],'markersize',16);
+end
+
+
+if 0==1
+ dir1 = '/home/store2/carltape/OUTPUT/run_001/';
+ dir2 = [dir1 'event_001/'];
+
+ % load source time function
+ ww = 'stffor_00001_1'; load([dir2 ww]); temp = eval(ww);
+ ti = temp(:,1); f = temp(:,2);
+
+ % load data, synthetics, adjoint source
+ ww = 'dat_00001_1'; load([dir2 ww]); temp = eval(ww); s_dat = temp(:,2);
+ ww = 'syn_00001_1'; load([dir2 ww]); temp = eval(ww); s_syn = temp(:,2);
+ ww = 'stfadj_00001_1'; load([dir2 ww]); temp = eval(ww); f_adj = temp(:,2);
+
+ % compute velocity
+ sv_dat = gradient(s_dat,ti);
+ sv_syn = gradient(s_syn,ti);
+
+ % specify cut time for time series
+ tall = [ti f s_dat s_syn sv_dat sv_syn f_adj];
+ tmax = 175;
+ ikeep = find(ti <= tmax);
+ tall = tall(ikeep,:);
+ ti = tall(:,1);
+ tall(:,7) = flipud(tall(:,7));
+
+ % axes limits
+ pwr_vec = [8 -4 -4 4];
+ cmx_vec = [4 5 2 2];
+ for ii=1:length(pwr_vec), max_vec(ii) = cmx_vec(ii) * 10^pwr_vec(ii); end
+ ax_mat = [0 tmax -max_vec(1) max_vec(1)
+ 0 tmax -max_vec(2) max_vec(2)
+ 0 tmax -max_vec(3) max_vec(3)
+ 0 tmax -max_vec(4) max_vec(4) ];
+
+ % plot
+ figure; nr=4; nc=1;
+ subplot(nr,nc,1); plot(ti,tall(:,2),'b'); axis(ax_mat(1,:)); ylabel(' source time function');
+ subplot(nr,nc,2); plot(ti,tall(:,4),'r--',ti,tall(:,3),'b'); axis(ax_mat(2,:)); ylabel(' displacement (data, syn)');
+ subplot(nr,nc,3); plot(ti,tall(:,6),'r--',ti,tall(:,5),'b'); axis(ax_mat(3,:)); ylabel(' velocity (data, syn)');
+ subplot(nr,nc,4); plot(ti,tall(:,7),'b'); axis(ax_mat(4,:)); ylabel(' tt xcorr adjoint source');
+ fontsize(8); orient tall, wysiwyg
+
+ % write the data to a file
+ ww = ['time_series.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(ti)
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
+ tall(ii,1),tall(ii,2),tall(ii,3),tall(ii,4),tall(ii,5),tall(ii,6),tall(ii,7));
+ end
+ fclose(fid);
+
+ % write the axes info to file
+ ww = ['time_series_axes.dat'];
+ fid = fopen([dir1 ww],'w');
+ fprintf(fid,'%16i%16i%16i%16i\n',pwr_vec(1),pwr_vec(2),pwr_vec(3),pwr_vec(4));
+ fprintf(fid,'%16i%16i%16i%16i\n',cmx_vec(1),cmx_vec(2),cmx_vec(3),cmx_vec(4));
+ for ii=1:length(ax_mat)
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',...
+ ax_mat(ii,1),ax_mat(ii,2),ax_mat(ii,3),ax_mat(ii,4));
+ end
+ fclose(fid);
+end
+
+if 0==1
+ dir1 = '/home/store2/carltape/OUTPUT/run_002/'; % note run 002
+ dir2 = [dir1 'event_001/'];
+
+ % load source time function, synthetics, adjoint source
+ ww = 'stffor_00001_1'; load([dir2 ww]); temp = eval(ww); ti = temp(:,1); f = temp(:,2);
+ ww = 'syn_00001_1'; load([dir2 ww]); temp = eval(ww); s_syn = temp(:,2);
+ ww = 'stfadj_00001_1'; load([dir2 ww]); temp = eval(ww); f_adj = temp(:,2);
+
+ % compute velocity
+ sv_syn = gradient(s_syn,ti);
+
+ % specify cut time for time series
+ tall = zeros(length(ti),7);
+ tall(:,1) = ti;
+ tall(:,2) = f;
+ tall(:,4) = s_syn;
+ tall(:,6) = sv_syn;
+ tall(:,7) = f_adj;
+ tmax = 175;
+ ikeep = find(ti <= tmax);
+ tall = tall(ikeep,:);
+ ti = tall(:,1);
+ tall(:,7) = flipud(tall(:,7));
+
+ % axes limits
+ pwr_vec = [8 -4 -4 3];
+ cmx_vec = [4 5 1.8 2];
+ for ii=1:length(pwr_vec), max_vec(ii) = cmx_vec(ii) * 10^pwr_vec(ii); end
+ ax_mat = [0 tmax -max_vec(1) max_vec(1)
+ 0 tmax -max_vec(2) max_vec(2)
+ 0 tmax -max_vec(3) max_vec(3)
+ 0 tmax -max_vec(4) max_vec(4) ];
+
+ % plot
+ figure; nr=4; nc=1;
+ subplot(nr,nc,1); plot(ti,tall(:,2),'b'); axis(ax_mat(1,:)); ylabel(' source time function');
+ subplot(nr,nc,2); plot(ti,tall(:,4),'r--'); axis(ax_mat(2,:)); ylabel(' displacement (syn)');
+ subplot(nr,nc,3); plot(ti,tall(:,6),'r--'); axis(ax_mat(3,:)); ylabel(' velocity (syn)');
+ subplot(nr,nc,4); plot(ti,tall(:,7),'b'); axis(ax_mat(4,:)); ylabel(' tt xcorr adjoint source');
+ fontsize(8); orient tall, wysiwyg
+
+ % write the data to a file
+ ww = ['time_series.dat'];
+ fid = fopen([dir1 ww],'w');
+ for ii=1:length(ti)
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
+ tall(ii,1),tall(ii,2),tall(ii,3),tall(ii,4),tall(ii,5),tall(ii,6),tall(ii,7));
+ end
+ fclose(fid);
+
+ % write the axes info to file
+ ww = ['time_series_axes.dat'];
+ fid = fopen([dir1 ww],'w');
+ fprintf(fid,'%16i%16i%16i%16i\n',pwr_vec(1),pwr_vec(2),pwr_vec(3),pwr_vec(4));
+ fprintf(fid,'%16i%16i%16i%16i\n',cmx_vec(1),cmx_vec(2),cmx_vec(3),cmx_vec(4));
+ for ii=1:length(ax_mat)
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',...
+ ax_mat(ii,1),ax_mat(ii,2),ax_mat(ii,3),ax_mat(ii,4));
+ end
+ fclose(fid);
+end
+
+%===============================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_figs.m
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,563 +0,0 @@
-%
-% wave2d_cg_poly.m
-% CARL TAPE, 21-Nov-2008
-% printed xxx
-%
-% This program takes the output from wave2d.f90 and plots the polynomials
-% used in the line-search conjugate gradient algorithm within the code.
-%
-% For GMT plotting, we execute wave2d_cg_figs.m after this program.
-%
-% calls
-% get_model_vec.m
-% cubic_min_4.m
-% genfit.m
-% theoryHyp.m
-% quad_shift.m
-% linefit.m
-% axes_expand.m, fontsize.m, colors.m, wysiwyg.m
-% called by xxx
-%
-
-format long
-format compact
-close all
-clear
-
-colors;
-npts = 100;
-stfm = '%4.4i';
-
-%---------------------------------------------------------
-% USER INPUT
-
-% base directory
-dir0 = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_work/';
-if ~exist(dir0), error([dir0 ' does not exist']); end
-
-parms = [100 0 3]; % structure inversion: 1 source, Nfac=3
-%parms = [200 0 3]; % source inversion (xs,ys,ts): single source
-%parms = [300 0 3]; % joint inversion: 1 source, Nfac=3
-%parms = [400 0 3]; % joint inversion: 5 sources, Nfac=3
-%parms = [500 0 3]; % joint inversion: 25 sources, Nfac=3
-%parms = [600 0 3]; % structure inversion: 25 sources, Nfac=2
-
-%---------------------------------------------------------
-
-irun0 = parms(1); % irun for m0
-%niter = parms(2); % number of iterations
-icubic = parms(2); % cubic (=1) or quadratic (=0) fitting
-ifit = parms(3); % function to fit chi(m): order of polynomial
-
-% bottom level for test parabola (=0 if no model norm term or data errors)
-chi_data_stop = 0.5;
-
-%---------------------------------------------------------
-
-odir = 'OUTPUT/';
-strun0 = ['irun0 = ' num2str(irun0) ];
-
-% determine the number of iterations
-k = 0;
-while k < 50
- irun = irun0 + k;
- chifile = [dir0 odir 'run_' sprintf(stfm,irun) '/chi.dat'];
- iexist = exist(chifile);
- if iexist == 2
- chi = load(chifile);
- chis_all(k+1) = chi;
- else
- break
- end
- k = k + 1;
-end
-istop = k - 1;
-niter = ceil(istop/2);
-
-% default is that the final model IS a test model
-ifinal_test = 0;
-irun_vec = [irun0+1 : 2 : irun0+2*niter];
-
-% if the simulation converged on a test model, then tack on a repeated
-% misfit value
-if mod(istop,2)==1
- chis_all(istop+2) = chis_all(istop+1);
- ifinal_test = 1;
-end
-
-chis = chis_all([1 : 2 : 2*niter+1])';
-chits = chis_all([2 : 2 : 2*niter])';
-
-% irun_vec = [irun0+1:2:irun0+2*niter];
-%
-% chis = zeros(niter+1,1);
-% chits = zeros(niter,1);
-%
-% % load initial chi value
-% stf = [dir0 odir 'run_' sprintf(stfm,irun0) '/'];
-% ww = 'summed_chi_all';
-% load([stf ww '.dat']); chi = eval(ww); chis(1) = chi;
-%
-% % load the remaining chi values
-% for ii=1:niter
-% irun = irun_vec(ii);
-%
-% stft = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
-% stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
-% chit = load([stft 'summed_chi_all.dat']);
-% chi = load([stf 'summed_chi_all.dat']);
-% chis(ii+1) = chi;
-% chits(ii) = chit;
-% end
-
-%disp(' chis chis_test');
-%disp([chis chits]);
-disp('chis :'); disp([chis]);
-disp('chis_test :'); disp([chits]);
-
-figure;
-nc=3; nr=max( ceil(niter/nc), 2);
-%nr=2; nc=2;
-stniter = ['niter = ' num2str(niter) ];
-stirun = [strun0 '; ' stniter];
-
-for ii=1:niter
- disp('----------------')
- irun = irun_vec(ii);
- stk = num2str(ii-1);
-
- % load polynomial values
- % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
- subplot(nr,nc,ii);
- stlabs = {'\nu',['S^{' stk '} ( \nu )'],'0',['\nu_{' stk '}'],['\nu_{' stk 't}']};
- %if or(ifinal_test==0, ii < niter)
- %if or(ifinal_test==1, ii < niter)
- if icubic == 1
- ww = 'cubic_poly';
- stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
- load([stf ww '.dat']); temp = eval(ww)';
-
- x1 = temp(1); x2 = temp(2);
- y1 = temp(3); y2 = temp(4);
- g1 = temp(5); g2 = temp(6);
- else
- ww = 'quad_poly';
- stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
- load([stf ww '.dat']); temp = eval(ww)';
-
- x1 = temp(1); x2 = temp(2);
- y1 = temp(3); y2 = temp(4);
- g1 = temp(5);
- end
-
- if icubic == 1
- [lam0,P1] = cubic_min_4(x1,x2,y1,y2,g1,g2,[1 1],stlabs);
-
- % check the Fortran output
- temp(7:10) ./ P1 - 1
- temp(11)/lam0 - 1
- else
- [lam0,P1] = quad_min_4(x1,x2,y1,y2,g1,[1 1],stlabs);
-
- % check the Fortran output
- temp(6:8) ./ P1 - 1
- temp(9)/lam0 - 1
- end
- %end
-
- % load actual chi-value computed from the next run
- % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
- %ww = 'summed_chi_all';
- %stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
- %load([stf ww '.dat']);
- %chi = eval(ww);
- %chis(ii+1) = chi;
-
- %if ii < niter
- chi = chis(ii+1);
- msize = 6;
- axi = xlim;
- plot([lam0 lam0 axi(1)],[0 chi chi],'k');
- plot(lam0,chi,'bo','markersize',msize,'MarkerFaceColor','b');
- if(lam0 > axi(2)), axis tight; end
- %end
-
-end
-title(stirun);
-disp(' chis:'); disp(chis);
-
-if 0==1
- % figure for paper (irun0 = 20, 100)
- %save('chis','chis_quad','chis_cubic','nchi');
- load('chis');
- its = [0:nchi-1]';
-
- hess_ray = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0023/summed_chi_all.dat');
- hess_ker = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0022/summed_chi_all.dat');
-
- figure; ax1 = [-1 nchi 10^-1 10^4];
- semilogy(its,chis_quad,'r.',its,chis_cubic,'b.',...
- its,hess_ray*ones(nchi,1),'g',its,hess_ker*ones(nchi,1),'k',...
- 'markersize',18,'linewidth',2);
- legend(' fit with quadratic',' fit with cubic',' hessian ray',' hessian kernel');
- axis(ax1); grid on;
- xlabel(' model number (iteration)'); ylabel(' chi(m)');
- orient tall, wysiwyg
-
- %-------------------------
-
- % write information to file for GMT plotting
- dir = [dir0 'gji_paper/figures/'];
- ww = 'chi_cubic_quad.dat';
- fid = fopen([dir ww],'w');
- for ii=1:nchi
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
- its(ii),chis_quad(ii),chis_cubic(ii),hess_ray,hess_ker);
- end
- fclose(fid);
-
- % write information to file for GMT plotting
- ww = 'chi_cubic_quad_axes.dat';
- fid = fopen([dir ww],'w');
- fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',ax1(1),ax1(2),ax1(3),ax1(4));
-end
-
-if 0==1
- % 26-July-2006, comparison of convergence curves (irun0 = 4000, 4050, 4100)
- % save('chis2','chis_tt','chis_amp','chis_wav','nchi');
- %
- % 26-Oct-2006, comparison of convergence curves
- % save('chis3','chis_wav','chis_tt_xcor','chis_lnA_xcor','chis_tt_mtm','nchi');
- load('chis3');
- its = [0:nchi-1]';
-
- chis_wav = chis_wav / chis_wav(1);
- chis_tt_xcor = chis_tt_xcor / chis_tt_xcor(1);
- chis_lnA_xcor = chis_lnA_xcor / chis_lnA_xcor(1);
- chis_tt_mtm = chis_tt_mtm / chis_tt_mtm(1);
-
- %hess_ray = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0023/summed_chi_all.dat');
- %hess_ker = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0022/summed_chi_all.dat');
-
- figure; ax1 = [-1 nchi 10^-3 10^0];
- %semilogy(its,chis_tt_xcor,'r.',its,chis_lnA_xcor,'b.',its,chis_wav,'k.','markersize',18);
- %legend(' tt-xcorr (4000)',' amplitude (4050)',' waveform (4100)');
- semilogy(its,chis_wav,'k.',its,chis_tt_xcor,'r.',its,chis_lnA_xcor,'b.',its,chis_tt_mtm,'r+','markersize',18);
- legend(' waveform (4300)',' tt-xcorr (4350)',' amplitude (4400)');
- axis(ax1); grid on;
- xlabel(' model number (iteration)'); ylabel(' chi(m)');
- orient tall, wysiwyg
-end
-
-%---------------------------------------
-% plot misfit as a function of iteration
-
-nchi = length(chis);
-its = [0:nchi-1]';
-
-% x-y data to fit
-x = its;
-y = log10(chis);
-
-% threshold points to remove Inf or NaN
-igood = ~sum([isnan(y) isinf(y)],2);
-x = x(igood);
-y = y(igood);
-its = its(igood);
-chis = chis(igood);
-nchi = length(chis);
-
-% choose type of fit to log(chi) data: line(1), parabola(2), hyperbola(3)
-%ifit = 1;
-stlabs = {'line','parabola','hyperbola'};
-
-ifac1 = 0;
-ifac2 = 3; % number of extra iterations to extrapolate
-its_smooth = linspace(0-ifac1,nchi-1+ifac2,100);
-sfm = '%.4e';
-if ifit==1
- % fit to line for log10(chi)-its space
- %[xf,yf,mf,bf,rms] = linefit(its(2:end), log10(chis(2:end)));
- [xf,yf,mf,bf,rms] = linefit(x,y);
- yfit = mf*x + bf;
- yfit_smooth = mf * its_smooth + bf;
-
- stit1 = [' y = ( -' num2str(sprintf(sfm,mf)) ' x + ' num2str(sprintf(sfm,bf)) ')'];
- stit2 = ' ';
-
-elseif ifit==2
- % fit to parabola for log10(chi)-its space
- [xf,yf,P,rms,stit] = parabolafit(x,y);
- yfit = P(1)*x.^2 + P(2)*x + P(3);
- yfit_smooth = P(1)*its_smooth.^2 + P(2)*its_smooth + P(3);
-
-elseif ifit==3
- % initial guesses based on a line
- [xf,yf,mf,bf,rms] = linefit(x,y);
- m0 = [-mf 0 1 -bf]';
- y0 = theoryHyp(m0, x);
- figure; hold on; plot(x,y,'.',x,y0,'ro');
-
- % perturbations
- jogvec = [1e-8 * ones(4,1)]';
-
- disp(' ');
- disp('Model: A,B,C,D in equation Ax + Bxy + Cy + D = 0');
- disp(' ---> y = (-Ax - D) / (Bx + C)');
- mz = m0; itmx = 5;
- for ii=1:itmx
- [mz e1] = genfit('theoryHyp', mz, jogvec, y, [x]);
- mz
- yest = theoryHyp(mz,x);
- res = y - yest; rms = sqrt( (res' * res) / length(res) );
- stRMS = [' RMS = ' num2str(sprintf('%.4e', rms)) ';'];
- end
- disp('Best-fit hyperbola:');
- mz
- a = mz(1); b = mz(2); c = mz(3); d = mz(4);
- stit1 = [' y = ( -' num2str(sprintf(sfm,a)) ' x - ' num2str(sprintf(sfm,d)) ') / (' ...
- num2str(sprintf(sfm,b)) ' x + ' num2str(sprintf(sfm,c)) ')'];
- stit2 = [' y = ' num2str(sprintf(sfm,a)) ' x + ' num2str(sprintf(sfm,b)) ' xy + ' ...
- num2str(sprintf(sfm,c)) ' y + ' num2str(sprintf(sfm,d)) ' = 0'];
- disp(stRMS);
-
- yfit = theoryHyp(mz,x);
- yfit_smooth = theoryHyp(mz,its_smooth);
- plot(its_smooth, yfit_smooth, 'r--');
- legend(' data',' initial guess line',' hyperbola fit');
-end
-chifit = 10.^yfit;
-chifit_smooth = 10.^yfit_smooth;
-
-%------------------------------
-
-figure; nr=2; nc=2;
-msize = 24; lsize = 2;
-xlims = [-1 its_smooth(end)];
-xticks = [round(its_smooth(1)):round(its_smooth(end))];
-stit = {[' fitting a ' stlabs{ifit} ' to log10(chi)-vs-iteration data'],stit1,stit2};
-
-stx = ' k, model number (iteration)';
-
-subplot(nr,nc,1); hold on;
-plot(its_smooth,chifit_smooth,'r--','linewidth',lsize);
-plot(its,chis,'.','markersize',msize);
-xlim(xlims); grid on; set(gca,'xtick',xticks);
-xlabel(stx);
-ylabel(' S (m)','fontsize',18);
-title(stirun);
-
-subplot(nr,nc,2);
-if 1==1
- plot(its_smooth,log10(chifit_smooth),'r--',its,log10(chis),'.','markersize',msize,'linewidth',lsize);
- ylabel(' log10 [ S (m) ]','fontsize',18);
- %set(gca,'ytick',[-10:10]);
-else
- semilogy(its_smooth,chifit_smooth,'r--',its,chis,'.','markersize',msize,'linewidth',lsize);
- ylabel(' S (m)','fontsize',18);
- set(gca,'ytick',10.^[-10:10]);
-end
-grid on; xlim(xlims); set(gca,'xtick',xticks);
-xlabel(stx); title(stit);
-
-% variance reduction
-chi_before = chis(1:nchi-1);
-chi_after = chis(2:nchi);
-var_red1 = 100 * ( 1 - ( (chi_after-chi_data_stop).^2 ./ (chi_before-chi_data_stop).^2 ) );
-var_red2 = 100 * ( 1 - ( (chi_after-chi_data_stop).^2 ./ (chi_before-chi_data_stop).^2 ) );
-
-disp(' '); disp('VARIANCE REDUCTION');
-disp([its(2:end) chi_before chi_after var_red1]);
-
-% var red corresponding to best-fitting chi-vs-its curve
-its2 = xticks;
-chifit2 = interp1(its_smooth,chifit_smooth,its2);
-var_red1_fit = 100 * ( 1 - ( chifit2(2:end).^2 ./ chifit2(1:end-1).^2 ) );
-
-x_var = its(2:end);
-x_var_fit = its2(2:end);
-
-subplot(nr,nc,3); hold on;
-plot(x_var_fit,var_red1_fit,'r.--','markersize',msize,'linewidth',lsize);
-plot(x_var,var_red1,'b.-','markersize',msize,'linewidth',lsize);
-axis([xlims 0 100]); grid on; set(gca,'xtick',xticks);
-xlabel(stx);
-ylabel(' variance reduction');
-title(' variance reduction between successive models');
-
-% subplot(nr,nc,4); plot(its(2:end),var_red2,'.-');
-% xlim(xlims); grid on; set(gca,'xtick',its);
-% xlabel(stx);
-% ylabel(' variance reduction');
-
-lchi_smooth = log10(chifit_smooth);
-converge_fit = abs( gradient( lchi_smooth, its_smooth) );
-converge_its = 0.5+its(1:end-1);
-converge_pts = abs( diff(log10(chis)) );
-
-subplot(nr,nc,4);
-%semilogy(its_smooth,-gradient(chifit_smooth, its_smooth),'r--','linewidth',lsize);
-plot(its_smooth,converge_fit,'r--',converge_its,converge_pts,'.','markersize',msize,'linewidth',lsize);
-axis([xlims 0 0.7]); grid on; set(gca,'xtick',xticks);
-xlabel(stx);
-ylabel(' order of convergence rate, | \Delta log10(S) / \Delta k |');
-
-fontsize(9), orient tall, wysiwyg
-
-%-----------------------------
-% This generates the initial polynomial, in order to have the values
-% of the fitting curves to write to file in gji_figs.m for GMT plotting.
-
-% specify number of iterations to plot; load initial chi
-niter = 1;
-stirun = [' irun0 = ' num2str(irun0) '; niter = ' num2str(niter) ];
-stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun0)) '/'];
-ww = 'chi';
-load([stf ww '.dat']); chi = eval(ww); chis(1) = chi;
-
-%figure; %nr=3; nc=3;
-for ii=1:niter
- irun = irun_vec(ii);
- stk = num2str(ii-1);
- stlabs = {'\nu',['S^{' stk '} ( \nu )'],'0',['\nu_{' stk '}'],['\nu_{' stk 't}']};
-
- if icubic == 1
- ww = 'cubic_poly';
- stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
- load([stf ww '.dat']); temp = eval(ww)';
- x1 = temp(1); x2 = temp(2);
- y1 = temp(3); y2 = temp(4);
- g1 = temp(5); g2 = temp(6);
- else
- ww = 'quad_poly';
- stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
- load([stf ww '.dat']); temp = eval(ww)';
- x1 = temp(1); x2 = temp(2);
- y1 = temp(3); y2 = temp(4);
- g1 = temp(5);
- end
-
- if 0==1 % call functions for plotting
- if icubic == 1
- [xmin,P1] = cubic_min_4(x1,x2,y1,y2,g1,g2,[1 0],stlabs);
- else
- [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,[1 0],stlabs);
- end
-
- else % call functions as scripts
-
- % quadratic polynomial for computing test-model nu
- aquad = g1^2/(4*y1);
- Pquad_test = [aquad g1 y1]';
- n = 100;
-
- % quadratic interpolation (only used to get chi if icubic = 1)
- a = ((y2 - y1) - g1*(x2 - x1)) / (x2^2 - x1^2);
- b = g1;
- c = y1 - a*x1^2 - b*x1;
- Pquad = [a b c]';
- [Pquad2,qvert,stit] = quad_shift(Pquad,1);
-
- if icubic == 1 % copied from cubic_min_4.m on 2-14-06
-
- a = ( -2*(y2-y1) + (g1+g2)*(x2-x1) ) / (x2 - x1)^3;
- b = ( 3*(y2-y1) - (2*g1 + g2)*(x2 - x1) ) / (x2 - x1)^2;
- c = g1;
- d = y1;
- P2 = [a b c d]';
- Pcubic = cubic_shift(P2,x1,0);
- xmin = cubic_min(Pcubic,x1);
-
- figure; hold on;
- specs = [2 14 18 12]; fac = 0.05;
- axpoly = axes_expand([x1 x2 0 max([y1 y2])],1.2);
- axpoly(3) = 0;
- dy = axpoly(4) - axpoly(3);
- dx = axpoly(2) - axpoly(1);
- ylab = axpoly(3) - fac*dy;
- ymin = polyval(Pcubic,xmin);
-
- xpts = linspace(axpoly(1),axpoly(2),n);
- g1_line = polyval([g1 y1-g1*x1],xpts);
- g2_line = polyval([g2 y2-g2*x2],xpts);
- g1_quad_test = polyval(Pquad_test,xpts);
- g1_quad_fit = polyval(Pquad,xpts);
- g1_cube_fit = polyval(Pcubic,xpts);
-
- plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
- plot(xpts,g1_quad_fit,'r--','linewidth',specs(1));
- plot(xpts,g1_quad_test,'b--');
- plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
-
- plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
- plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
- plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
-
- plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
- plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
- plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
-
- axis(axpoly);
- xlabel(stlabs{1},'fontsize',specs(3));
- ylabel(stlabs{2},'fontsize',specs(3));
- grid on;
- text(xmin,ylab,stlabs{4},'fontsize',specs(4));
- text(x2,ylab,stlabs{5},'fontsize',specs(4));
- orient tall, wysiwyg
-
- else % copied from quad_min_4.m on 2-14-06
-
- xmin = qvert(1);
-
- figure; hold on;
- specs = [2 14 18 12]; fac = 0.05;
- axpoly = axes_expand([x1 x2 0 max([y1 y2])],1.2);
- axpoly(3) = 0;
- dy = axpoly(4) - axpoly(3);
- dx = axpoly(2) - axpoly(1);
- ylab = axpoly(3) - fac*dy;
- ymin = polyval(Pquad,xmin);
-
- xpts = linspace(axpoly(1),axpoly(2),n);
- g1_line = polyval([g1 y1-g1*x1],xpts);
- g2_line = zeros(n,1);
- g1_quad_test = polyval(Pquad_test,xpts);
- g1_quad_fit = polyval(Pquad,xpts);
- g1_cube_fit = zeros(n,1);
-
- plot(xpts,g1_quad_fit,'b','linewidth',specs(1));
- plot(xpts,g1_quad_test,'b--','linewidth',specs(1));
- plot(xpts,g1_line,'r--','linewidth',specs(1));
-
- plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
- plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
- plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
- plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
- plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
- plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
- axis(axpoly);
- xlabel(stlabs{1},'fontsize',specs(3));
- ylabel(stlabs{2},'fontsize',specs(3));
- title({stit{1},stit{2}},'fontsize',specs(3))
- grid on;
- text(xmin,ylab,stlabs{4},'fontsize',specs(4));
- text(x2,ylab,stlabs{5},'fontsize',specs(4));
- orient tall, wysiwyg
- end
- end
-
- % load actual chi-value computed from the next run
- % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
- ww = 'chi';
- stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
- load([stf ww '.dat']);
- chi = eval(ww);
-
- msize = 14;
- axi = xlim; plot([xmin xmin axi(1)],[0 chi chi],'k');
- plot(xmin,chi,'bo','markersize',msize,'MarkerFaceColor','b');
-end
-title(stirun);
-orient tall, wysiwyg
-
-%=============================================================
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,566 @@
+%
+% wave2d_cg_poly.m
+% CARL TAPE, 21-Nov-2008
+% printed xxx
+%
+% This program takes the output from wave2d.f90 and plots the polynomials
+% used in the line-search conjugate gradient algorithm within the code.
+%
+% For GMT plotting, we execute wave2d_cg_figs.m after this program.
+%
+% calls
+% get_model_vec.m
+% cubic_min_4.m
+% genfit.m
+% theoryHyp.m
+% quad_shift.m
+% linefit.m
+% axes_expand.m, fontsize.m, colors.m, wysiwyg.m
+% called by xxx
+%
+
+format long
+format compact
+close all
+clear
+
+% add path to additional matlab scripts
+path(path,[pwd '/matlab_scripts']);
+
+colors;
+npts = 100;
+stfm = '%4.4i';
+
+%---------------------------------------------------------
+% USER INPUT
+
+% base directory
+dir0 = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_work/';
+if ~exist(dir0), error([dir0 ' does not exist']); end
+
+parms = [100 0 3]; % structure inversion: 1 source, Nfac=3
+%parms = [200 0 3]; % source inversion (xs,ys,ts): single source
+%parms = [300 0 3]; % joint inversion: 1 source, Nfac=3
+%parms = [400 0 3]; % joint inversion: 5 sources, Nfac=3
+%parms = [500 0 3]; % joint inversion: 25 sources, Nfac=3
+%parms = [600 0 3]; % structure inversion: 25 sources, Nfac=2
+
+%---------------------------------------------------------
+
+irun0 = parms(1); % irun for m0
+%niter = parms(2); % number of iterations
+icubic = parms(2); % cubic (=1) or quadratic (=0) fitting
+ifit = parms(3); % function to fit chi(m): order of polynomial
+
+% bottom level for test parabola (=0 if no model norm term or data errors)
+chi_data_stop = 0.5;
+
+%---------------------------------------------------------
+
+odir = 'OUTPUT/';
+strun0 = ['irun0 = ' num2str(irun0) ];
+
+% determine the number of iterations
+k = 0;
+while k < 50
+ irun = irun0 + k;
+ chifile = [dir0 odir 'run_' sprintf(stfm,irun) '/chi.dat'];
+ iexist = exist(chifile);
+ if iexist == 2
+ chi = load(chifile);
+ chis_all(k+1) = chi;
+ else
+ break
+ end
+ k = k + 1;
+end
+istop = k - 1;
+niter = ceil(istop/2);
+
+% default is that the final model IS a test model
+ifinal_test = 0;
+irun_vec = [irun0+1 : 2 : irun0+2*niter];
+
+% if the simulation converged on a test model, then tack on a repeated
+% misfit value
+if mod(istop,2)==1
+ chis_all(istop+2) = chis_all(istop+1);
+ ifinal_test = 1;
+end
+
+chis = chis_all([1 : 2 : 2*niter+1])';
+chits = chis_all([2 : 2 : 2*niter])';
+
+% irun_vec = [irun0+1:2:irun0+2*niter];
+%
+% chis = zeros(niter+1,1);
+% chits = zeros(niter,1);
+%
+% % load initial chi value
+% stf = [dir0 odir 'run_' sprintf(stfm,irun0) '/'];
+% ww = 'summed_chi_all';
+% load([stf ww '.dat']); chi = eval(ww); chis(1) = chi;
+%
+% % load the remaining chi values
+% for ii=1:niter
+% irun = irun_vec(ii);
+%
+% stft = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
+% stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
+% chit = load([stft 'summed_chi_all.dat']);
+% chi = load([stf 'summed_chi_all.dat']);
+% chis(ii+1) = chi;
+% chits(ii) = chit;
+% end
+
+%disp(' chis chis_test');
+%disp([chis chits]);
+disp('chis :'); disp([chis]);
+disp('chis_test :'); disp([chits]);
+
+figure;
+nc=3; nr=max( ceil(niter/nc), 2);
+%nr=2; nc=2;
+stniter = ['niter = ' num2str(niter) ];
+stirun = [strun0 '; ' stniter];
+
+for ii=1:niter
+ disp('----------------')
+ irun = irun_vec(ii);
+ stk = num2str(ii-1);
+
+ % load polynomial values
+ % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
+ subplot(nr,nc,ii);
+ stlabs = {'\nu',['S^{' stk '} ( \nu )'],'0',['\nu_{' stk '}'],['\nu_{' stk 't}']};
+ %if or(ifinal_test==0, ii < niter)
+ %if or(ifinal_test==1, ii < niter)
+ if icubic == 1
+ ww = 'cubic_poly';
+ stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
+ load([stf ww '.dat']); temp = eval(ww)';
+
+ x1 = temp(1); x2 = temp(2);
+ y1 = temp(3); y2 = temp(4);
+ g1 = temp(5); g2 = temp(6);
+ else
+ ww = 'quad_poly';
+ stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
+ load([stf ww '.dat']); temp = eval(ww)';
+
+ x1 = temp(1); x2 = temp(2);
+ y1 = temp(3); y2 = temp(4);
+ g1 = temp(5);
+ end
+
+ if icubic == 1
+ [lam0,P1] = cubic_min_4(x1,x2,y1,y2,g1,g2,[1 1],stlabs);
+
+ % check the Fortran output
+ temp(7:10) ./ P1 - 1
+ temp(11)/lam0 - 1
+ else
+ [lam0,P1] = quad_min_4(x1,x2,y1,y2,g1,[1 1],stlabs);
+
+ % check the Fortran output
+ temp(6:8) ./ P1 - 1
+ temp(9)/lam0 - 1
+ end
+ %end
+
+ % load actual chi-value computed from the next run
+ % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
+ %ww = 'summed_chi_all';
+ %stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
+ %load([stf ww '.dat']);
+ %chi = eval(ww);
+ %chis(ii+1) = chi;
+
+ %if ii < niter
+ chi = chis(ii+1);
+ msize = 6;
+ axi = xlim;
+ plot([lam0 lam0 axi(1)],[0 chi chi],'k');
+ plot(lam0,chi,'bo','markersize',msize,'MarkerFaceColor','b');
+ if(lam0 > axi(2)), axis tight; end
+ %end
+
+end
+title(stirun);
+disp(' chis:'); disp(chis);
+
+if 0==1
+ % figure for paper (irun0 = 20, 100)
+ %save('chis','chis_quad','chis_cubic','nchi');
+ load('chis');
+ its = [0:nchi-1]';
+
+ hess_ray = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0023/summed_chi_all.dat');
+ hess_ker = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0022/summed_chi_all.dat');
+
+ figure; ax1 = [-1 nchi 10^-1 10^4];
+ semilogy(its,chis_quad,'r.',its,chis_cubic,'b.',...
+ its,hess_ray*ones(nchi,1),'g',its,hess_ker*ones(nchi,1),'k',...
+ 'markersize',18,'linewidth',2);
+ legend(' fit with quadratic',' fit with cubic',' hessian ray',' hessian kernel');
+ axis(ax1); grid on;
+ xlabel(' model number (iteration)'); ylabel(' chi(m)');
+ orient tall, wysiwyg
+
+ %-------------------------
+
+ % write information to file for GMT plotting
+ dir = [dir0 'gji_paper/figures/'];
+ ww = 'chi_cubic_quad.dat';
+ fid = fopen([dir ww],'w');
+ for ii=1:nchi
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e%16.7e\n',...
+ its(ii),chis_quad(ii),chis_cubic(ii),hess_ray,hess_ker);
+ end
+ fclose(fid);
+
+ % write information to file for GMT plotting
+ ww = 'chi_cubic_quad_axes.dat';
+ fid = fopen([dir ww],'w');
+ fprintf(fid,'%16.7e%16.7e%16.7e%16.7e\n',ax1(1),ax1(2),ax1(3),ax1(4));
+end
+
+if 0==1
+ % 26-July-2006, comparison of convergence curves (irun0 = 4000, 4050, 4100)
+ % save('chis2','chis_tt','chis_amp','chis_wav','nchi');
+ %
+ % 26-Oct-2006, comparison of convergence curves
+ % save('chis3','chis_wav','chis_tt_xcor','chis_lnA_xcor','chis_tt_mtm','nchi');
+ load('chis3');
+ its = [0:nchi-1]';
+
+ chis_wav = chis_wav / chis_wav(1);
+ chis_tt_xcor = chis_tt_xcor / chis_tt_xcor(1);
+ chis_lnA_xcor = chis_lnA_xcor / chis_lnA_xcor(1);
+ chis_tt_mtm = chis_tt_mtm / chis_tt_mtm(1);
+
+ %hess_ray = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0023/summed_chi_all.dat');
+ %hess_ker = load('/home/carltape/wave2d/2d_adjoint_banana/OUTPUT_banana/run_0022/summed_chi_all.dat');
+
+ figure; ax1 = [-1 nchi 10^-3 10^0];
+ %semilogy(its,chis_tt_xcor,'r.',its,chis_lnA_xcor,'b.',its,chis_wav,'k.','markersize',18);
+ %legend(' tt-xcorr (4000)',' amplitude (4050)',' waveform (4100)');
+ semilogy(its,chis_wav,'k.',its,chis_tt_xcor,'r.',its,chis_lnA_xcor,'b.',its,chis_tt_mtm,'r+','markersize',18);
+ legend(' waveform (4300)',' tt-xcorr (4350)',' amplitude (4400)');
+ axis(ax1); grid on;
+ xlabel(' model number (iteration)'); ylabel(' chi(m)');
+ orient tall, wysiwyg
+end
+
+%---------------------------------------
+% plot misfit as a function of iteration
+
+nchi = length(chis);
+its = [0:nchi-1]';
+
+% x-y data to fit
+x = its;
+y = log10(chis);
+
+% threshold points to remove Inf or NaN
+igood = ~sum([isnan(y) isinf(y)],2);
+x = x(igood);
+y = y(igood);
+its = its(igood);
+chis = chis(igood);
+nchi = length(chis);
+
+% choose type of fit to log(chi) data: line(1), parabola(2), hyperbola(3)
+%ifit = 1;
+stlabs = {'line','parabola','hyperbola'};
+
+ifac1 = 0;
+ifac2 = 3; % number of extra iterations to extrapolate
+its_smooth = linspace(0-ifac1,nchi-1+ifac2,100);
+sfm = '%.4e';
+if ifit==1
+ % fit to line for log10(chi)-its space
+ %[xf,yf,mf,bf,rms] = linefit(its(2:end), log10(chis(2:end)));
+ [xf,yf,mf,bf,rms] = linefit(x,y);
+ yfit = mf*x + bf;
+ yfit_smooth = mf * its_smooth + bf;
+
+ stit1 = [' y = ( -' num2str(sprintf(sfm,mf)) ' x + ' num2str(sprintf(sfm,bf)) ')'];
+ stit2 = ' ';
+
+elseif ifit==2
+ % fit to parabola for log10(chi)-its space
+ [xf,yf,P,rms,stit] = parabolafit(x,y);
+ yfit = P(1)*x.^2 + P(2)*x + P(3);
+ yfit_smooth = P(1)*its_smooth.^2 + P(2)*its_smooth + P(3);
+
+elseif ifit==3
+ % initial guesses based on a line
+ [xf,yf,mf,bf,rms] = linefit(x,y);
+ m0 = [-mf 0 1 -bf]';
+ y0 = theoryHyp(m0, x);
+ figure; hold on; plot(x,y,'.',x,y0,'ro');
+
+ % perturbations
+ jogvec = [1e-8 * ones(4,1)]';
+
+ disp(' ');
+ disp('Model: A,B,C,D in equation Ax + Bxy + Cy + D = 0');
+ disp(' ---> y = (-Ax - D) / (Bx + C)');
+ mz = m0; itmx = 5;
+ for ii=1:itmx
+ [mz e1] = genfit('theoryHyp', mz, jogvec, y, [x]);
+ mz
+ yest = theoryHyp(mz,x);
+ res = y - yest; rms = sqrt( (res' * res) / length(res) );
+ stRMS = [' RMS = ' num2str(sprintf('%.4e', rms)) ';'];
+ end
+ disp('Best-fit hyperbola:');
+ mz
+ a = mz(1); b = mz(2); c = mz(3); d = mz(4);
+ stit1 = [' y = ( -' num2str(sprintf(sfm,a)) ' x - ' num2str(sprintf(sfm,d)) ') / (' ...
+ num2str(sprintf(sfm,b)) ' x + ' num2str(sprintf(sfm,c)) ')'];
+ stit2 = [' y = ' num2str(sprintf(sfm,a)) ' x + ' num2str(sprintf(sfm,b)) ' xy + ' ...
+ num2str(sprintf(sfm,c)) ' y + ' num2str(sprintf(sfm,d)) ' = 0'];
+ disp(stRMS);
+
+ yfit = theoryHyp(mz,x);
+ yfit_smooth = theoryHyp(mz,its_smooth);
+ plot(its_smooth, yfit_smooth, 'r--');
+ legend(' data',' initial guess line',' hyperbola fit');
+end
+chifit = 10.^yfit;
+chifit_smooth = 10.^yfit_smooth;
+
+%------------------------------
+
+figure; nr=2; nc=2;
+msize = 24; lsize = 2;
+xlims = [-1 its_smooth(end)];
+xticks = [round(its_smooth(1)):round(its_smooth(end))];
+stit = {[' fitting a ' stlabs{ifit} ' to log10(chi)-vs-iteration data'],stit1,stit2};
+
+stx = ' k, model number (iteration)';
+
+subplot(nr,nc,1); hold on;
+plot(its_smooth,chifit_smooth,'r--','linewidth',lsize);
+plot(its,chis,'.','markersize',msize);
+xlim(xlims); grid on; set(gca,'xtick',xticks);
+xlabel(stx);
+ylabel(' S (m)','fontsize',18);
+title(stirun);
+
+subplot(nr,nc,2);
+if 1==1
+ plot(its_smooth,log10(chifit_smooth),'r--',its,log10(chis),'.','markersize',msize,'linewidth',lsize);
+ ylabel(' log10 [ S (m) ]','fontsize',18);
+ %set(gca,'ytick',[-10:10]);
+else
+ semilogy(its_smooth,chifit_smooth,'r--',its,chis,'.','markersize',msize,'linewidth',lsize);
+ ylabel(' S (m)','fontsize',18);
+ set(gca,'ytick',10.^[-10:10]);
+end
+grid on; xlim(xlims); set(gca,'xtick',xticks);
+xlabel(stx); title(stit);
+
+% variance reduction
+chi_before = chis(1:nchi-1);
+chi_after = chis(2:nchi);
+var_red1 = 100 * ( 1 - ( (chi_after-chi_data_stop).^2 ./ (chi_before-chi_data_stop).^2 ) );
+var_red2 = 100 * ( 1 - ( (chi_after-chi_data_stop).^2 ./ (chi_before-chi_data_stop).^2 ) );
+
+disp(' '); disp('VARIANCE REDUCTION');
+disp([its(2:end) chi_before chi_after var_red1]);
+
+% var red corresponding to best-fitting chi-vs-its curve
+its2 = xticks;
+chifit2 = interp1(its_smooth,chifit_smooth,its2);
+var_red1_fit = 100 * ( 1 - ( chifit2(2:end).^2 ./ chifit2(1:end-1).^2 ) );
+
+x_var = its(2:end);
+x_var_fit = its2(2:end);
+
+subplot(nr,nc,3); hold on;
+plot(x_var_fit,var_red1_fit,'r.--','markersize',msize,'linewidth',lsize);
+plot(x_var,var_red1,'b.-','markersize',msize,'linewidth',lsize);
+axis([xlims 0 100]); grid on; set(gca,'xtick',xticks);
+xlabel(stx);
+ylabel(' variance reduction');
+title(' variance reduction between successive models');
+
+% subplot(nr,nc,4); plot(its(2:end),var_red2,'.-');
+% xlim(xlims); grid on; set(gca,'xtick',its);
+% xlabel(stx);
+% ylabel(' variance reduction');
+
+lchi_smooth = log10(chifit_smooth);
+converge_fit = abs( gradient( lchi_smooth, its_smooth) );
+converge_its = 0.5+its(1:end-1);
+converge_pts = abs( diff(log10(chis)) );
+
+subplot(nr,nc,4);
+%semilogy(its_smooth,-gradient(chifit_smooth, its_smooth),'r--','linewidth',lsize);
+plot(its_smooth,converge_fit,'r--',converge_its,converge_pts,'.','markersize',msize,'linewidth',lsize);
+axis([xlims 0 0.7]); grid on; set(gca,'xtick',xticks);
+xlabel(stx);
+ylabel(' order of convergence rate, | \Delta log10(S) / \Delta k |');
+
+fontsize(9), orient tall, wysiwyg
+
+%-----------------------------
+% This generates the initial polynomial, in order to have the values
+% of the fitting curves to write to file in gji_figs.m for GMT plotting.
+
+% specify number of iterations to plot; load initial chi
+niter = 1;
+stirun = [' irun0 = ' num2str(irun0) '; niter = ' num2str(niter) ];
+stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun0)) '/'];
+ww = 'chi';
+load([stf ww '.dat']); chi = eval(ww); chis(1) = chi;
+
+%figure; %nr=3; nc=3;
+for ii=1:niter
+ irun = irun_vec(ii);
+ stk = num2str(ii-1);
+ stlabs = {'\nu',['S^{' stk '} ( \nu )'],'0',['\nu_{' stk '}'],['\nu_{' stk 't}']};
+
+ if icubic == 1
+ ww = 'cubic_poly';
+ stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
+ load([stf ww '.dat']); temp = eval(ww)';
+ x1 = temp(1); x2 = temp(2);
+ y1 = temp(3); y2 = temp(4);
+ g1 = temp(5); g2 = temp(6);
+ else
+ ww = 'quad_poly';
+ stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun)) '/'];
+ load([stf ww '.dat']); temp = eval(ww)';
+ x1 = temp(1); x2 = temp(2);
+ y1 = temp(3); y2 = temp(4);
+ g1 = temp(5);
+ end
+
+ if 0==1 % call functions for plotting
+ if icubic == 1
+ [xmin,P1] = cubic_min_4(x1,x2,y1,y2,g1,g2,[1 0],stlabs);
+ else
+ [xmin,P1] = quad_min_4(x1,x2,y1,y2,g1,[1 0],stlabs);
+ end
+
+ else % call functions as scripts
+
+ % quadratic polynomial for computing test-model nu
+ aquad = g1^2/(4*y1);
+ Pquad_test = [aquad g1 y1]';
+ n = 100;
+
+ % quadratic interpolation (only used to get chi if icubic = 1)
+ a = ((y2 - y1) - g1*(x2 - x1)) / (x2^2 - x1^2);
+ b = g1;
+ c = y1 - a*x1^2 - b*x1;
+ Pquad = [a b c]';
+ [Pquad2,qvert,stit] = quad_shift(Pquad,1);
+
+ if icubic == 1 % copied from cubic_min_4.m on 2-14-06
+
+ a = ( -2*(y2-y1) + (g1+g2)*(x2-x1) ) / (x2 - x1)^3;
+ b = ( 3*(y2-y1) - (2*g1 + g2)*(x2 - x1) ) / (x2 - x1)^2;
+ c = g1;
+ d = y1;
+ P2 = [a b c d]';
+ Pcubic = cubic_shift(P2,x1,0);
+ xmin = cubic_min(Pcubic,x1);
+
+ figure; hold on;
+ specs = [2 14 18 12]; fac = 0.05;
+ axpoly = axes_expand([x1 x2 0 max([y1 y2])],1.2);
+ axpoly(3) = 0;
+ dy = axpoly(4) - axpoly(3);
+ dx = axpoly(2) - axpoly(1);
+ ylab = axpoly(3) - fac*dy;
+ ymin = polyval(Pcubic,xmin);
+
+ xpts = linspace(axpoly(1),axpoly(2),n);
+ g1_line = polyval([g1 y1-g1*x1],xpts);
+ g2_line = polyval([g2 y2-g2*x2],xpts);
+ g1_quad_test = polyval(Pquad_test,xpts);
+ g1_quad_fit = polyval(Pquad,xpts);
+ g1_cube_fit = polyval(Pcubic,xpts);
+
+ plot(xpts,g1_cube_fit,'b','linewidth',specs(1));
+ plot(xpts,g1_quad_fit,'r--','linewidth',specs(1));
+ plot(xpts,g1_quad_test,'b--');
+ plot(xpts,g1_line,'r--',xpts,g2_line,'r--');
+
+ plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+ plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+ plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
+
+ plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+ plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+ plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
+
+ axis(axpoly);
+ xlabel(stlabs{1},'fontsize',specs(3));
+ ylabel(stlabs{2},'fontsize',specs(3));
+ grid on;
+ text(xmin,ylab,stlabs{4},'fontsize',specs(4));
+ text(x2,ylab,stlabs{5},'fontsize',specs(4));
+ orient tall, wysiwyg
+
+ else % copied from quad_min_4.m on 2-14-06
+
+ xmin = qvert(1);
+
+ figure; hold on;
+ specs = [2 14 18 12]; fac = 0.05;
+ axpoly = axes_expand([x1 x2 0 max([y1 y2])],1.2);
+ axpoly(3) = 0;
+ dy = axpoly(4) - axpoly(3);
+ dx = axpoly(2) - axpoly(1);
+ ylab = axpoly(3) - fac*dy;
+ ymin = polyval(Pquad,xmin);
+
+ xpts = linspace(axpoly(1),axpoly(2),n);
+ g1_line = polyval([g1 y1-g1*x1],xpts);
+ g2_line = zeros(n,1);
+ g1_quad_test = polyval(Pquad_test,xpts);
+ g1_quad_fit = polyval(Pquad,xpts);
+ g1_cube_fit = zeros(n,1);
+
+ plot(xpts,g1_quad_fit,'b','linewidth',specs(1));
+ plot(xpts,g1_quad_test,'b--','linewidth',specs(1));
+ plot(xpts,g1_line,'r--','linewidth',specs(1));
+
+ plot([x1 x1 axpoly(1)],[0 y1 y1],'k');
+ plot([x2 x2 axpoly(1)],[0 y2 y2],'k');
+ plot([xmin xmin axpoly(1)],[0 ymin ymin],'k--');
+ plot([x1 x2],[y1 y2],'ko','markersize',specs(2),'MarkerFaceColor','b');
+ plot(xmin,ymin,'bo',x2,0,'bo',xmin,0,'bo','markersize',specs(2),'MarkerFaceColor','w');
+ plot(0.5*x2,0,'go','markersize',specs(2),'MarkerFaceColor','w'); % linear projection
+ axis(axpoly);
+ xlabel(stlabs{1},'fontsize',specs(3));
+ ylabel(stlabs{2},'fontsize',specs(3));
+ title({stit{1},stit{2}},'fontsize',specs(3))
+ grid on;
+ text(xmin,ylab,stlabs{4},'fontsize',specs(4));
+ text(x2,ylab,stlabs{5},'fontsize',specs(4));
+ orient tall, wysiwyg
+ end
+ end
+
+ % load actual chi-value computed from the next run
+ % wave2d: xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
+ ww = 'chi';
+ stf = [dir0 odir 'run_' num2str(sprintf(stfm,irun+1)) '/'];
+ load([stf ww '.dat']);
+ chi = eval(ww);
+
+ msize = 14;
+ axi = xlim; plot([xmin xmin axi(1)],[0 chi chi],'k');
+ plot(xmin,chi,'bo','markersize',msize,'MarkerFaceColor','b');
+end
+title(stirun);
+orient tall, wysiwyg
+
+%=============================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_poly.m
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_run.m (from rev 16168, seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_test.m)
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_run.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_run.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,740 @@
+%
+% wave2d_cg_run.m
+% Carl Tape, 21-Jan-2010
+%
+% This program computes an updated model using a conjugate gradient
+% algorithm. This is essentially a TEST PROGRAM in anticipation of
+% performing the inversion in Matlab OUTSIDE of wave2d.f90.
+%
+% calls xxx
+% called by xxx
+%
+
+format long
+format compact
+close all
+clear
+
+% add path to additional matlab scripts
+path(path,[pwd '/matlab_scripts']);
+
+colors;
+stfm = '%4.4i';
+stpars = {'B = ln(beta/beta0)','Ts = ts = ts0','Xs = xs - xs0','Ys = ys - ys0'};
+npts = 100;
+
+%---------------------------------------------------------
+% USER INPUT
+
+% base directory
+%dirbase = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/';
+dirbase = '/home/carltape/ADJOINT_TOMO/iterate_adj/';
+if ~exist(dirbase,'dir'), error(['dirbase ' dirbase ' does not exist']); end
+
+% directory with Matlab parameterization for full covariance matrix
+dirrand = [dirbase '/SEM2D_iterate_INPUT/random_fields/model_001/'];
+if ~exist(dirrand,'dir'), error(['dirrand ' dirrand ' does not exist']); end
+
+% KEY
+parms = [1500 5];
+%parms = [1500 4];
+
+% icg = 1: emulate wave2d.f90 algorithm
+% icg = 2: emulate wave2d.f90 algorithm, but use 32 x 32 cells
+% icg = 3: CG algorithm with full covariance matrix and 32 x 32 cells
+icg = 1;
+iwrite = 1;
+iplotmod = 1;
+iplotker = 0;
+sticg = sprintf('%2.2i',icg);
+
+%---------------------------------------------------------
+
+irun0 = parms(1);
+istep = parms(2);
+imaketest = ~mod(istep,2);
+
+if imaketest==1
+ im0 = istep;
+ imt = istep + 1;
+else
+ im0 = istep - 1;
+ imt = istep;
+end
+imk = im0+2;
+imp = im0-2;
+disp(sprintf(' im0 = %i, imt = %i, imk = %i, imaketest = %i',im0,imt,imk,imaketest));
+
+% base run directory
+stirun0 = sprintf(stfm,irun0);
+dir0 = [dirbase 'SEM2D_iterate_OUTPUT/run_' stirun0 '/'];
+if ~exist(dir0,'dir'), error(['dir0 ' dir0 ' does not exist']); end
+
+% model directories
+dirR = [dir0 'READ_IN/'];
+if ~exist(dirR,'dir'), mkdir(dirR); end
+stimp = sprintf(stfm,imp); stim0 = sprintf(stfm,im0);
+stimt = sprintf(stfm,imt); stimk = sprintf(stfm,imk);
+dirmp = [dirR 'model_m' stimp '/'];
+dirm0 = [dirR 'model_m' stim0 '/'];
+dirmt = [dirR 'model_m' stimt '/'];
+dirmk = [dirR 'model_m' stimk '/'];
+
+% for the first step, read from the base run directory
+if istep <= 1, dirm0 = dir0; end
+if istep <= 3, dirmp = dir0; end
+if ~exist(dirm0,'dir'), error(['dirm0 ' dirm0 ' does not exist']); end
+
+% assign the input and output directories
+if imaketest==1
+ imo = imt;
+ idir1 = dirm0;
+ idir2 = dirmp;
+ odir = dirmt;
+
+else
+ imo = imk;
+ idir1 = dirm0;
+ idir2 = dirmp; % directory for previous gradient
+ odir = dirmk;
+ if ~exist(dirmt,'dir'), error(['dirmt ' dirmt ' does not exist']); end
+end
+stimo = sprintf(stfm,imo);
+if ~exist(idir1,'dir'), error(['idir1 ' idir1 ' does not exist']); end
+if ~exist(idir2,'dir'), error(['idir2 ' idir2 ' does not exist']); end
+
+if iwrite==1
+ if ~exist(odir,'dir'), mkdir(odir); disp(['making ' odir]); end
+end
+
+%---------------------------------------------------------
+% load files
+
+% read parameter file
+[stnames,stvals] = textread([idir1 'wave2d_constants.dat'],'%s%f');
+for ii=1:length(stnames), eval([stnames{ii} ' = stvals(' num2str(ii) ')']); end
+
+% constants for model covariance
+[stnames,stvals] = textread([idir1 'scaling_values_covm.dat'],'%s%f');
+for ii=1:length(stnames), eval([stnames{ii} ' = stvals(' num2str(ii) ')']); end
+% fac_str = stvals(1);
+% fac_ts = stvals(2);
+% fac_xs = stvals(3);
+% fac_ys = stvals(4);
+% fac_total = stvals(5);
+% ugrad_str = stvals(6);
+% ugrad_ts = stvals(7);
+% ugrad_xs = stvals(8);
+% ugrad_ys = stvals(9);
+% dnparm_src_run = stvals(10);
+% coverage_str = stvals(11);
+% coverage_src = stvals(12);
+% cov_imetric_fac_str = stvals(13);
+% cov_imetric_fac_ts = stvals(14);
+% cov_imetric_fac_xs = stvals(15);
+% cov_imetric_fac_ys = stvals(16);
+
+% constants for data covariance
+[stnames,stvals] = textread([idir1 'scaling_values_covd.dat'],'%s%f');
+ievent_min = stvals(1);
+ievent_max = stvals(2);
+nevent_run = stvals(3);
+nrec = stvals(4); % number of stations
+ncomp = stvals(5); % number of components
+nmeas_run = stvals(6); % number of measurements
+sigma_DT = stvals(7); % std errors added to DT measurements
+
+nparm_src_inv = sum([INV_SOURCE_T 2*INV_SOURCE_X ]) * nevent_run;
+
+% event indices
+einds = [ievent_min:ievent_max];
+
+% % double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
+% % double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
+% % double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+% rho0 = 2.60e3;
+% kap0 = 5.20e10;
+% mu0 = 2.66e10;
+% beta0 = sqrt( mu0/rho0 )
+% bulk0 = sqrt( kap0 /rho0 )
+
+% indexing
+m_inds = load([idir1 'm_inds.dat']);
+nmod = m_inds(4,2);
+nlocal = m_inds(1,2);
+indB = m_inds(1,1):m_inds(1,2);
+indT = m_inds(2,1):m_inds(2,2);
+indX = m_inds(3,1):m_inds(3,2);
+indY = m_inds(4,1):m_inds(4,2);
+indTXY = m_inds(2,1):m_inds(4,2);
+nmod_str = nlocal;
+nmod_src = nmod - nmod_str;
+
+% local mesh
+% write(15,'(6i8,4e18.8)') k, ispec, i, j, iglob, valence(iglob), &
+% x(iglob), z(iglob), da_local(i,j,ispec), da_global(iglob)
+[i1,i2,i3,i4,i5,i6,xg,yg,da_local_vec,d10] = textread([idir1 'local_mesh.dat'],'%f%f%f%f%f%f%f%f%f%f');
+xmin = min(xg); xmax = max(xg);
+ymin = min(yg); ymax = max(yg);
+Atot = (xmax-xmin)*(ymax-ymin);
+% check
+sum(da_local_vec), (xmax-xmin)*(ymax-ymin)
+
+% to match notation for full covariance matrix
+Avec = sqrt( da_local_vec/Atot );
+sum(Avec.^2) % check
+
+% plotting mesh
+xp = linspace(xmin,xmax,npts);
+yp = linspace(ymin,ymax,npts);
+[Xp,Yp] = meshgrid(xp,yp);
+
+% load current model
+%[m_str_lon,m_str_lat,m_str_kappa,m_str_mu,m_str_rho,m_str_B] = ...
+% textread([idir1 'structure_syn.dat'],'%f%f%f%f%f%f%f');
+
+% INITIAL model vector (m00)
+%write(88,'(2e24.12)') m0_vec(i), m0(i)
+[m0_vec_initial, m0_initial] = textread([dir0 'initial_model_vector.dat'],'%f%f');
+
+% CURRENT model vector
+%write(19,'(4e16.6)') m0(i), mt(i), m0_vec(i), mt_vec(i)
+[m0, mt0, m0_vec, mt_vec0] = textread([idir1 'cg_model_vectors.dat'],'%f%f%f%f');
+%[m0_B, m0_T, m0_X, m0_Y] = wave2d_splitm(m0,m_inds);
+%[m0_vec_B, m0_vec_T, m0_vec_X, m0_vec_Y] = wave2d_splitm(m0_vec,m_inds);
+
+% load kernels
+kernels_all = zeros(nlocal,nevent_run);
+for ii=1:nevent_run
+ ievent = einds(ii)
+ dirK = [idir1 'event_' sprintf('%3.3i',ievent) '/'];
+ %kernel = load([dirK 'kernel_basis']); Kbeta = kernel(:,7);
+ kernel = load([dirK 'kernel_basis_smooth']); Kbeta = kernel(:,3);
+ kernels_all(:,ii) = Kbeta;
+
+ if iplotker==1
+ Zp = griddata(xg,yg,Kbeta,Xp,Yp,'nearest');
+ figure; imagesc(Zp); set(gca,'ydir','normal');
+ caxis([-1 1]*max(abs(Kbeta))*0.8);
+ end
+end
+summed_ker = sum(kernels_all,2);
+
+% source gradient
+source_gradient = load([idir1 'source_gradient.dat']);
+
+% data covariance
+% nmeas_run = nevent_run * nrec * NCOMP
+% double precision, parameter :: SIGMA_DT = 0.10
+%cov_data(:) = SIGMA_DT * SIGMA_DT * nmeas_run
+covd_diag = load([idir1 'cov_data_diagonal.dat']);
+covd_const = sigma_DT^2 * nmeas_run;
+% check
+min(covd_diag), max(covd_diag), covd_const
+
+% data vector
+% chi_data(ievent,irec,icomp,1) = (tshift_xc_pert )**2 / cov_data(imeasure)
+% write(19,'(3i8,1e20.10)') ievent, irec, icomp, chi_data(ievent,irec,icomp,1)
+chi_data_all = load([idir1 'chi_data_all.dat']);
+chi_data_vec = chi_data_all(:,4);
+chi_data_stop = load([idir1 'chi_data_stop.dat']);
+
+% measurement vector
+%measure_vec(imeasure,1) = tshift_xc_pert
+%measure_vec(imeasure,2) = tshift_xc
+%measure_vec(imeasure,3) = dlnA_pert
+%measure_vec(imeasure,4) = dlnA
+%measure_vec(imeasure,5) = 0.5 * DT*sum( adj_syn(:,icomp,irec)**2 )
+meas_all = load([idir1 'measure_vec.dat']);
+DTvec = meas_all(:,1);
+data_norm = sum(DTvec.^2 / covd_const);
+% check
+data_norm0 = load([idir1 'data_norm.dat']);
+model_norm0 = load([idir1 'model_norm.dat']);
+chi0 = load([idir1 'chi.dat'])
+data_norm0, data_norm, sum(chi_data_vec)
+
+% sigma values
+% write(19,'(2e20.10)') sigma_beta, m_scale_str(1)
+% write(19,'(2e20.10)') sigma_ts, m_scale_src(1)
+% write(19,'(2e20.10)') sigma_xs, m_scale_src(2)
+% write(19,'(2e20.10)') sigma_zs, m_scale_src(3)
+sigma_all = load([idir1 'sigma_values.dat']);
+sigma_beta = sigma_all(1,1);
+sigma_ts = sigma_all(2,1);
+sigma_xs = sigma_all(3,1);
+sigma_zs = sigma_all(4,1);
+
+% reference values
+[alpha0, beta0, rho0, bulk0, kappa0, mu0] = ...
+ textread([idir1 'reference_values.dat'],'%f%f%f%f%f%f');
+
+%========================================================================
+% ONE STEP OF A CONJUGATE GRADIENT ALGORITHM
+
+% files for CG algorithm
+gfilemp = ['cg' sticg '_grad_m' stimp '.dat'];
+gfilem0 = ['cg' sticg '_grad_m' stim0 '.dat'];
+chitfile = [dirmt 'chi.dat'];
+%---------------------------------------------------------
+% icg = 1 ==> emulate CG variables in wave2d.f90
+if icg==1
+
+ if 0==1
+ cov_model = zeros(nmod,1);
+ cov_model(indB) = sigma_beta^2 ./ da_local_vec * Atot * coverage_str;
+ cov_model(indT) = sigma_ts^2 * dnparm_src_run * coverage_src;
+ cov_model(indX) = sigma_xs^2 * dnparm_src_run * coverage_src;
+ cov_model(indY) = sigma_zs^2 * dnparm_src_run * coverage_src;
+
+ cov_imetric = zeros(nmod,1);
+ cov_imetric(indB) = cov_model(indB) * (fac_str / ugrad_str) * fac_total;
+ cov_imetric(indT) = cov_model(indT) * (fac_ts / ugrad_ts) * fac_total;
+ cov_imetric(indX) = cov_model(indX) * (fac_xs / ugrad_xs) * fac_total;
+ cov_imetric(indY) = cov_model(indY) * (fac_ys / ugrad_ys) * fac_total;
+ else
+ cov_model = zeros(nmod,1);
+ cov_model(indB) = sigma_beta^2;
+ cov_model(indT) = sigma_ts^2;
+ cov_model(indX) = sigma_xs^2;
+ cov_model(indY) = sigma_zs^2;
+
+ cov_weight = zeros(nmod,1);
+ %cov_weight(indB) = (fac_str / ugrad_str) * fac_total ./ da_local_vec * Atot * coverage_str;
+ cov_weight(indB) = (fac_str / ugrad_str) * fac_total * coverage_str ./ Avec.^2;
+ cov_weight(indT) = (fac_ts / ugrad_ts) * fac_total * dnparm_src_run * coverage_src;
+ cov_weight(indX) = (fac_xs / ugrad_xs) * fac_total * dnparm_src_run * coverage_src;
+ cov_weight(indY) = (fac_ys / ugrad_ys) * fac_total * dnparm_src_run * coverage_src;
+
+ cov_imetric = zeros(nmod,1);
+ cov_imetric(indB) = cov_model(indB) .* cov_weight(indB);
+ cov_imetric(indT) = cov_model(indT) .* cov_weight(indT);
+ cov_imetric(indX) = cov_model(indX) .* cov_weight(indX);
+ cov_imetric(indY) = cov_model(indY) .* cov_weight(indY);
+ end
+
+ % cov_model -- TO CHECK
+ %write(19,'(4e20.10)') cov_imetric(i), icov_metric(i), cov_model(i), icov_model(i)
+ cov_model_all = load([idir1 'cov_model_diagonal.dat']);
+ cov_imetric0 = cov_model_all(:,1);
+ % check
+ for ii=1:4
+ inds = m_inds(ii,1):m_inds(ii,2);
+ disp('------');
+ disp(sprintf('%.3e %.3e %.3e %.3e',...
+ norm(cov_imetric0(inds)), norm(cov_imetric(inds)),...
+ norm(cov_imetric0(inds)-cov_imetric(inds)),...
+ norm(cov_imetric0(inds)-cov_imetric(inds)) / norm(cov_imetric0(inds))))
+ end
+
+ % gradient
+ %gradient_model(:) = m0(:) / cov_imetric(:)
+ gradient_tot = zeros(nmod,1);
+ gradient_model = m0 ./ cov_imetric;
+ gradient_data = zeros(nmod,1);
+ gradient_data(indB) = summed_ker .* da_local_vec;
+ gradient_data(indTXY) = source_gradient;
+ gradient_tot = gradient_data + gradient_model;
+
+ % check actual norms
+ % --> gradient_norm_all.dat, gradient_norm_data_all.dat, gradient_norm_model all.dat
+ wave2d_gnorm_sq(gradient_tot,cov_imetric,m_inds);
+ wave2d_gnorm_sq(gradient_data,cov_imetric,m_inds);
+ wave2d_gnorm_sq(gradient_model,cov_imetric,m_inds);
+
+ % gradient -- TO CHECK
+ %write(19,'(3e20.10)') gradient(i), gradient_data(i), gradient_model(i)
+ [gradient_tot0,gradient_data0,gradient_model0] = textread([idir1 'gradient_vec.dat'],'%f%f%f');
+ % check
+ for ii=1:4
+ inds = m_inds(ii,1):m_inds(ii,2);
+ disp(sprintf('%20s %.3e %.3e %.3e %.3e',stpars{ii},...
+ norm(gradient_tot0(inds)), norm(gradient_tot(inds)),...
+ norm(gradient_tot0(inds)-gradient_tot(inds)),...
+ norm(gradient_tot0(inds)-gradient_tot(inds)) / norm(gradient_tot0(inds)) ))
+ figure; nr=3; nc=1;
+ subplot(nr,nc,1); plot( gradient_tot0(inds), '.'); title(stpars{ii});
+ subplot(nr,nc,2); plot( gradient_tot(inds), '.')
+ subplot(nr,nc,3); plot( gradient_tot0(inds), gradient_tot(inds), '.')
+ end
+
+ % check chi model values
+ model_norm_parts = zeros(4,1);
+ model_norm_parts(1) = sum( m0(indB).^2 ./ cov_imetric(indB) );
+ model_norm_parts(2) = sum( m0(indT).^2 ./ cov_imetric(indT) );
+ model_norm_parts(3) = sum( m0(indX).^2 ./ cov_imetric(indX) );
+ model_norm_parts(4) = sum( m0(indY).^2 ./ cov_imetric(indY) );
+ model_norm = sum( m0.^2 ./ cov_imetric );
+ % check
+ model_norm0, model_norm, sum(model_norm_parts)
+
+ % check chi model values
+ chi_k_val = 0.5*(data_norm + model_norm)
+
+ %---------------------------------------------------------
+ % emulate CG algorithm in wave2d.f90 -- THIS ASSUMES A DIAGONAL COVARIANCE MATRIX
+
+ disp('------CG ALGORITHM---------');
+
+ gk = gradient_tot;
+ mt = zeros(nmod,1);
+ if istep <= 1
+ beta_val = 0.0;
+ p0 = zeros(nmod,1);
+ else
+ % step for search direction
+ % requires current gradient gk AND previous gradient g0
+
+ % load p0 and g0, the PREVIOUS gradient vectors (pk and gk)
+ % write(19,'(4e16.6)') g0(i), gk(i), p0(i), pk(i)
+ %[~,g0,~,p0] = textread([idir2 'cg_grad_vectors.dat'],'%f%f%f%f');
+ [g0,p0] = textread([idir2 gfilemp],'%f%f');
+
+ beta_val = sum((gk - g0) .* (cov_imetric .*gk) ) / sum(g0 .* (cov_imetric.*g0) );
+ if isinf(beta_val), error('beta_val is infinity'); end
+ end
+ % search direction vector
+ pk = -cov_imetric .* gk + beta_val * p0;
+ % step for test model
+ mu_val = chi_data_stop;
+ lam_t_val = 2.0*(mu_val - chi_k_val) / sum( gk .* pk );
+
+ % % check
+ % if 0==1
+ % norm(p0), norm(g0), norm(pk)
+ % vals = [mu_val lam_t_val beta_val chi_k_val];
+ % %write(19,'(4e16.8)') mu_val, lam_t_val, beta_val, chi_k_val
+ % vals0 = load([dirbase 'SEM2D_iterate_OUTPUT/run_1204/cg_test_vals.dat']);
+ % for ii=1:length(vals), vals0(ii), vals(ii), end
+ % end
+
+ if imaketest==1
+ % test model
+ mt = m0 + lam_t_val*pk;
+
+ mt_vec = zeros(nmod,1);
+ if (INV_STRUCT_BETA == 0)
+ mt_vec(1:nlocal) = m0_vec_initial(1:nlocal);
+ else
+ mt_vec(1:nlocal) = beta0 * exp( mt(1:nlocal) );
+ end
+
+ if and(INV_SOURCE_T == 0, INV_SOURCE_X == 0)
+ mt_vec(nlocal+1 : nmod) = m0_vec_initial(nlocal+1 : nmod);
+ else
+ mt_vec(nlocal+1 : nmod) = mt(nlocal+1 : nmod) + m0_vec_initial(nlocal+1 : nmod);
+ end
+
+ else
+ % load chi for test model
+ chi_t_val = load(chitfile);
+
+ % a quadratic fit requires at least 5 values
+ xx1 = 0.0
+ xx2 = lam_t_val
+ yy1 = chi_k_val
+ yy2 = chi_t_val
+ g1 = sum(gk .* pk)
+ %g1 = sum(g0 .* pk);
+
+ % coefficients of the quadratic polynomial (ax^2 + bx + c)
+ Pa = ((yy2 - yy1) - g1*(xx2 - xx1)) / (xx2^2 - xx1^2)
+ Pb = g1
+ Pc = yy1 - Pa*xx1^2 - Pb*xx1
+
+ % get the analytical minimum (the vertex)
+ if (Pa ~= 0.0)
+ xmin = -Pb / (2.0*Pa)
+ else
+ error('check the quadratic input polynomial');
+ end
+
+ % check
+ %vals = load([dirbase 'SEM2D_iterate_OUTPUT/run_1201/quad_poly.dat']);
+ %for ii=1:length(vals), vals(ii), end
+
+ % compute updated model
+ lam_0_val = xmin;
+ mk = m0 + lam_0_val * pk;
+
+ % STRUCTURE PARAMETERS
+ if (INV_STRUCT_BETA == 0)
+ mk_vec(1:nlocal) = m0_vec_initial(1:nlocal); % initial structure
+ else
+ mk_vec(1:nlocal) = beta0 * exp( mk(1:nlocal) );
+ end
+
+ % SOURCE PARAMETERS
+ if and(INV_SOURCE_T == 0, INV_SOURCE_X == 0)
+ mk_vec(nlocal+1 : nmod) = m0_vec_initial(nlocal+1 : nmod); % initial source
+ else
+ mk_vec(nlocal+1 : nmod) = mk(nlocal+1 : nmod) + m0_vec_initial(nlocal+1 : nmod);
+ end
+
+ end
+
+%---------------------------------------------------------
+% icg = 1 ==> text
+elseif icg == 2
+ % load Matlab parameterization of the fields (gaussian_2D.m)
+ load([dirrand 'matlab_vars']);
+
+ % number of structure parameters
+ ncell = nx*ny;
+
+ % plotting mesh
+ Xp = reshape(x,ny,nx);
+ Yp = reshape(y,ny,nx);
+
+ % compute the GLL gridpoint (local) closest to each nx x ny cell;
+ % this will give a quick mapping from kernels to cells
+ [iGLL, dGLL] = wave2d_gll2cell(xg,yg,x,y);
+
+ % indexing for cell-based model
+ m_indsi = m_inds - nlocal + ncell; m_indsi(1,1) = 1;
+ indBi = m_indsi(1,1):m_indsi(1,2);
+ indTi = m_indsi(2,1):m_indsi(2,2);
+ indXi = m_indsi(3,1):m_indsi(3,2);
+ indYi = m_indsi(4,1):m_indsi(4,2);
+ indTXYi = m_indsi(2,1):m_indsi(4,2);
+
+ % vector associated with parameterization
+ Atot = nx*ny*dx^2; % NOTE: does not equal xran*yran
+ dA = Atot/n;
+ dAvec = ones(n,1)*dA;
+ Avec = sqrt( dAvec/Atot );
+ n*dA - Atot, sum(Avec.^2) % check
+
+ if 1==1
+ % plot full covariance matrix
+ figure; imagesc(C);
+ title('prior model covariance matrix');
+ axis equal, axis tight, colorbar
+
+ % plot ordering of cells for the first tenth of the point
+ gcut = round(length(x)/10);
+ figure; hold on;
+ plot(x(1:gcut),y(1:gcut),'.');
+ for ii=1:gcut, text(x(ii),y(ii),num2str(ii),'fontsize',4); end
+ end
+
+ %--------------------------------------
+ % covariance matrix
+
+ % modified covariance matrix
+ %Cmod = diag(1./Avec) * C * diag(1./Avec);
+
+ % full covariance matrix
+ nmodi = ncell + nmod_src;
+ Cfull = zeros(nmodi,nmodi);
+ Cfull(indBi, indBi) = C;
+ Cfull(indTi, indTi) = diag(sigma_ts^2 * ones(length(indTi),1) );
+ Cfull(indXi, indXi) = diag(sigma_xs^2 * ones(length(indXi),1) );
+ Cfull(indYi, indYi) = diag(sigma_zs^2 * ones(length(indYi),1) );
+ %figure; spy(Cfull);
+
+ cov_weight_vec = zeros(nmodi,1);
+ cov_weight_vec(indBi) = (fac_str / ugrad_str) * fac_total * coverage_str ./ Avec.^2;
+ cov_weight_vec(indTi) = (fac_ts / ugrad_ts) * fac_total * dnparm_src_run * coverage_src;
+ cov_weight_vec(indXi) = (fac_xs / ugrad_xs) * fac_total * dnparm_src_run * coverage_src;
+ cov_weight_vec(indYi) = (fac_ys / ugrad_ys) * fac_total * dnparm_src_run * coverage_src;
+
+ Cmod = diag(sqrt(cov_weight_vec)) * Cfull * diag(sqrt(cov_weight_vec));
+ Cmoddiag = diag(diag(Cmod));
+
+ % equivalent representations
+ %cdiagmod = diag( diag(sqrt(cov_weight_vec)) * diag(diag(Cfull)) * diag(sqrt(cov_weight_vec)) );
+ %cmoddiag = diag(Cmod);
+
+ % approximate C-inverse by using diagonal only
+ cinv = 1./diag(Cmod);
+
+ %--------------------------------------
+ % model
+
+ m0i = wave2d_m_gll2cell(m0,xg,yg,x,y,nx,ny,nmod_src,1);
+ m0i_vec = wave2d_m_gll2cell(m0_vec,xg,yg,x,y,nx,ny,nmod_src,1);
+ m0i_initial = wave2d_m_gll2cell(m0_initial,xg,yg,x,y,nx,ny,nmod_src,1);
+ m0i_vec_initial = wave2d_m_gll2cell(m0_vec_initial,xg,yg,x,y,nx,ny,nmod_src,1);
+ %m0i = zeros(nmodi,1);
+ %m0i(1:ncell) = m0(iGLL);
+ %m0i(indTXYi) = m0(indTXY);
+
+ %--------------------------------------
+ % gradient
+
+ % interpolate kernels onto cells
+ kernels_alli = zeros(ncell,nevent_run);
+ for ii=1:nevent_run
+ kernels_alli(:,ii) = kernels_all(iGLL,ii);
+
+ if iplotker==1
+ Zp = reshape( kernels_alli(:,ii), ny, nx);
+ %Zp = griddata(xg,yg,,Xp,Yp,'nearest');
+ figure; imagesc(Zp); set(gca,'ydir','normal');
+ caxis([-1 1]*max(abs(Kbeta))*0.8);
+ end
+ end
+ summed_keri = sum(kernels_alli,2);
+
+ gradienti_data = zeros(nmodi,1);
+ gradienti_model = zeros(nmodi,1);
+ gradienti_tot = zeros(nmodi,1);
+ gradienti_data(indBi) = summed_keri .* dAvec;
+ gradienti_data(indTXYi) = source_gradient;
+ gradienti_model = cinv .* m0i;
+ gradienti_tot = gradienti_data + gradienti_model;
+
+ % gradient -- TO CHECK
+ % NOTE: due to the new discretization of the kernels, we expect the
+ % norm of the structure gradient to be slightly different from before
+ wave2d_gnorm_sq(gradienti_tot,diag(Cmod),m_indsi);
+ wave2d_gnorm_sq(gradienti_data,diag(Cmod),m_indsi);
+ wave2d_gnorm_sq(gradienti_model,diag(Cmod),m_indsi);
+
+ % check parts of model norm
+ model_norm_partsi = wave2d_gnorm_sq(m0i,1./diag(Cmod),m_indsi);
+ model_normi = sum(model_norm_partsi);
+ % check
+ model_norm0, model_normi
+
+ % check chi model values
+ chi0 = load([idir1 'chi.dat'])
+ chi_k_val = 0.5*(data_norm + model_normi)
+
+ %---------------------------------------------------------
+ % emulate CG algorithm in wave2d.f90 -- THIS ASSUMES A FULL COVARIANCE MATRIX
+
+ % compute new model vector (mt or mk)
+ gfile = [idir2 gfilemp];
+ mu_val = chi_data_stop;
+ gk = gradienti_tot;
+ [M,pk] = wave2d_cg(m0i,gk,Cmoddiag,chi_k_val,mu_val,istep,imaketest,gfile,chitfile);
+
+ % convert model vector entries to physical values -- also ensure that
+ % entries are unchanged if you are not inverting for them
+ if imaketest==1
+ mti = M;
+ mti_vec = zeros(nmodi,1);
+ % STRUCTURE PARAMETERS
+ if (INV_STRUCT_BETA == 0)
+ mti_vec(1:ncell) = m0_vec_initial(1:ncell);
+ else
+ mti_vec(1:ncell) = beta0 * exp( mti(1:ncell) );
+ end
+ % SOURCE PARAMETERS
+ if and(INV_SOURCE_T == 0, INV_SOURCE_X == 0)
+ mti_vec(ncell+1 : nmodi) = m0i_vec_initial(ncell+1 : nmodi);
+ else
+ mti_vec(ncell+1 : nmodi) = mti(ncell+1 : nmodi) + m0i_vec_initial(ncell+1 : nmodi);
+ end
+
+ else
+ mki = M;
+ mki_vec = zeros(nmodi,1);
+ % STRUCTURE PARAMETERS
+ if (INV_STRUCT_BETA == 0)
+ mki_vec(1:ncell) = m0_vec_initial(1:ncell); % initial structure
+ else
+ mki_vec(1:ncell) = beta0 * exp( mki(1:ncell) );
+ end
+ % SOURCE PARAMETERS
+ if and(INV_SOURCE_T == 0, INV_SOURCE_X == 0)
+ mki_vec(ncell+1 : nmodi) = m0i_vec_initial(ncell+1 : nmodi); % initial source
+ else
+ mki_vec(ncell+1 : nmodi) = mki(ncell+1 : nmodi) + m0i_vec_initial(ncell+1 : nmodi);
+ end
+
+ end
+
+
+else
+ error('invalid icg value');
+
+end
+
+%========================================================================
+% WRITE NEW MODEL TO FILE
+
+% write current gradient and search direction to file
+if iwrite==1
+ wave2d_write_grad([idir1 gfilem0],gk,pk); % note idir1
+end
+
+if icg==1
+ if imaketest==1, M_vec = mt_vec; M = mt; else M_vec = mk_vec; M = mk; end
+ M0 = m0; M0_vec = m0_vec;
+ x0 = xg; y0 = yg;
+else
+ if imaketest==1, M_vec = mti_vec; M = mti; else M_vec = mki_vec; M = mki; end
+ M0 = m0i; M0_vec = m0i_vec;
+ m_inds = m_indsi;
+ x0 = x; y0 = y;
+end
+
+% initial model
+[m0_B, m0_ts, m0_xs, m0_ys] = wave2d_splitm(M0,m_inds);
+[m0_vec_B, m0_vec_ts, m0_vec_xs, m0_vec_ys] = wave2d_splitm(M0_vec,m_inds);
+% new model (test or update)
+[m_B, m_ts, m_xs, m_ys] = wave2d_splitm(M,m_inds);
+[m_vec_B, m_vec_ts, m_vec_xs, m_vec_ys] = wave2d_splitm(M_vec,m_inds);
+
+if iplotmod==1
+ % change w.r.t. previous model
+ Zp = griddata(x0,y0,log(m_vec_B ./ m0_vec_B),Xp,Yp,'nearest');
+ figure; imagesc(Zp); set(gca,'ydir','normal');
+ colormap(seis); caxis([-1 1]*0.1); colorbar;
+end
+
+if iwrite==1
+ % interpolate onto SEM mesh
+ if icg ~= 1
+ m_B = wave2d_cell2gll(xg,yg,x,y,m_B,nx,ny);
+ end
+
+ % write structure model -- ONLY MU CHANGES (only m_B appears)
+ m_str_beta_new = beta0 * exp( m_B );
+ m_str_rho_new = rho0*ones(nlocal,1);
+ m_str_kappa_new = kappa0*ones(nlocal,1);
+ m_str_mu_new = m_str_rho_new .* m_str_beta_new.^2;
+ wave2d_write_str([odir 'structure_syn_m' stimo '.dat'],xg,yg,...
+ m_str_kappa_new,m_str_mu_new,m_str_rho_new,m_B);
+
+ % check
+ %mcheck = mt_vec0(indB);
+ %norm(mcheck), norm(m_str_beta_new), norm(mcheck - m_str_beta_new)/norm(m_str_beta_new)
+
+ % read sources for data
+ [m_src_lon,m_src_lat,m_src_ts_dat,m_src_xs_dat,m_src_ys_dat,m_src_ts_d,m_src_xs_d,m_src_ys_d] ...
+ = textread([idir1 'src_dat.dat'],'%f%f%f%f%f%f%f%f');
+
+ m_src_ts_d_new = m_vec_ts - m_src_ts_dat;
+ m_src_xs_d_new = m_vec_xs - m_src_xs_dat;
+ m_src_ys_d_new = m_vec_ys - m_src_ys_dat;
+ wave2d_write_src([odir 'src_syn_m' stimo '.dat'], m_src_lon, m_src_lat,...
+ m_vec_ts, m_vec_xs, m_vec_ys, m_src_ts_d_new, m_src_xs_d_new, m_src_ys_d_new);
+
+% % check all
+% if icg==1
+% mcheck = mt_vec0;
+% for ii=1:4
+% inds = m_inds(ii,1):m_inds(ii,2);
+% disp('------');
+% disp(sprintf('%.3e %.3e %.3e %.3e',...
+% norm(mcheck(inds)), norm(M_vec(inds)),...
+% norm(mcheck(inds) - M_vec(inds))/norm(mcheck(inds)) ));
+% end
+% end
+
+end
+
+break
+
+%---------------------------------------------------------
+% compute CG update using a diagonal covariance matrix with interpolated cells for model parameters
+
+
+
+%/home/carltape/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_INPUT/random_fields/model_001/
+
+%=============================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_run.m
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_test.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_test.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_cg_test.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,265 +0,0 @@
-%
-% wave2d_cg_test.m
-% Carl Tape, 21-Jan-2010
-%
-% This program computes an updated model using a conjugate gradient
-% algorithm. This is essentially a test program in anticipation of
-% performing the inversion in Matlab OUTSIDE of wave2d.f90.
-%
-% calls xxx
-% called by xxx
-%
-
-format long
-format compact
-close all
-clear
-
-colors;
-npts = 100;
-stfm = '%4.4i';
-
-icheck = 1;
-
-stpars = {'C = ln(c/c0)','B = ln(beta/beta0)','Ts = ts = ts0','Xs = xs - xs0','Ys = ys - ys0'};
-
-%---------------------------------------------------------
-% USER INPUT
-
-% base directory
-dir0 = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/';
-if ~exist(dir0), error([dir0 ' does not exist']); end
-
-icheck = 1;
-
-parms = [850 5 5];
-irun0 = parms(1);
-ieventmin = parms(2);
-ieventmax = parms(3);
-
-nevent_run = ieventmax - ieventmin + 1;
-einds = [ieventmin:ieventmax];
-stirun0 = sprintf(stfm,irun0);
-dir1 = [dir0 'SEM2D_iterate_OUTPUT/run_' stirun0 '/'];
-if ~exist(dir1), error([dir1 ' does not exist']); end
-
-%---------------------------------------------------------
-% load files
-
-% misc constants
-fac_str = 1.0;
-fac_ts = 1.0;
-fac_xs = 1.0;
-fac_ys = 1.0;
-fac_total = 1.0;
-ugrad_str = 1.0;
-ugrad_ts = 1.0;
-ugrad_xs = 1.0;
-ugrad_ys = 1.0;
-
-coverage_str = 0.666 / 0.962;
-coverage_src = 0.946 / 1.018;
-sigma_DT = 0.1;
-nrec = 132;
-ncomp = 1;
-nmeas_run = nevent_run*nrec*ncomp;
-nparm_src_run = nevent_run;
-
-% % double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
-% % double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
-% % double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
-% rho0 = 2.60e3;
-% kap0 = 5.20e10;
-% mu0 = 2.66e10;
-% beta0 = sqrt( mu0/rho0 )
-% bulk0 = sqrt( kap0 /rho0 )
-
-% indexing
-m_inds = load([dir1 'm_inds.dat']);
-nparm = m_inds(5,2);
-ngrid = m_inds(1,2);
-indC = m_inds(1,1):m_inds(1,2);
-indB = m_inds(2,1):m_inds(2,2);
-indT = m_inds(3,1):m_inds(3,2);
-indX = m_inds(4,1):m_inds(4,2);
-indY = m_inds(5,1):m_inds(5,2);
-indTXY = m_inds(3,1):m_inds(5,2);
-
-% local mesh
-% write(15,'(6i8,4e18.8)') k, ispec, i, j, iglob, valence(iglob), &
-% x(iglob), z(iglob), da_local(i,j,ispec), da_global(iglob)
-[i1,i2,i3,i4,i5,i6,xg,yg,da_local_vec,d10] = textread([dir1 'local_mesh.dat'],'%f%f%f%f%f%f%f%f%f%f');
-xmin = min(xg); xmax = max(xg);
-ymin = min(yg); ymax = max(yg);
-Atot = (xmax-xmin)*(ymax-ymin);
-% check
-sum(da_local_vec), (xmax-xmin)*(ymax-ymin)
-
-% plotting mesh
-xp = linspace(xmin,xmax,npts);
-yp = linspace(ymin,ymax,npts);
-[Xp,Yp] = meshgrid(xp,yp);
-
-% load current model
-mtemp = load([dir1 'structure_syn.dat']);
-m_str_lon = mtemp(:,1);
-m_str_lat = mtemp(:,2);
-m_str_kappa = mtemp(:,3);
-m_str_mu = mtemp(:,4);
-m_str_rho = mtemp(:,5);
-m_str_C = mtemp(:,6);
-m_str_B = mtemp(:,7);
-
-% model vector
-%write(88,'(2e24.12)') m0_vec(i), m0(i)
-[m0_vec, m0] = textread([dir1 'initial_model_vector.dat'],'%f%f');
-m0_C = m0(indC);
-m0_B = m0(indB);
-m0_T = m0(indT);
-m0_X = m0(indX);
-m0_Y = m0(indY);
-
-% load kernels
-kernels_all = zeros(ngrid,nevent_run);
-iplotker = 0;
-for ii=1:nevent_run
- ievent = einds(ii)
- dirK = [dir1 'event_' sprintf('%3.3i',ievent) '/']
- kernel = load([dirK 'kernel_basis']); Kbeta = kernel(:,7);
- %kernel = load([dirK 'kernel_basis_smooth']); Kbeta = kernel(:,3);
- kernels_all(:,ii) = Kbeta;
-
- if iplotker==1
- Zp = griddata(xg,yg,Kbeta,Xp,Yp,'nearest');
- figure; imagesc(Zp); set(gca,'ydir','normal');
- caxis([-1 1]*max(abs(Kbeta))*0.8);
- end
-end
-summed_ker = sum(kernels_all,2);
-
-% data covariance
-% nmeas_run = nevent_run * nrec * NCOMP
-% double precision, parameter :: SIGMA_DT = 0.10
-%cov_data(:) = SIGMA_DT * SIGMA_DT * nmeas_run
-covd_diag = load([dir1 'cov_data_diagonal.dat']);
-covd_const = sigma_DT^2 * nmeas_run;
-% check
-min(covd_diag), max(covd_diag), covd_const
-
-% data vector
-% chi_data(ievent,irec,icomp,1) = (tshift_xc_pert )**2 / cov_data(imeasure)
-% write(19,'(3i8,1e20.10)') ievent, irec, icomp, chi_data(ievent,irec,icomp,1)
-chi_all = load([dir1 'chi_all.dat']);
-chi_vec = chi_all(:,4);
-
-% measurement vector
-%measure_vec(imeasure,1) = tshift_xc_pert
-%measure_vec(imeasure,2) = tshift_xc
-%measure_vec(imeasure,3) = dlnA_pert
-%measure_vec(imeasure,4) = dlnA
-%measure_vec(imeasure,5) = 0.5 * DT*sum( adj_syn(:,icomp,irec)**2 )
-meas_all = load([dir1 'measure_vec.dat']);
-DTvec = meas_all(:,1);
-% check
-sum(DTvec.^2 / covd_const), sum(chi_vec)
-
-% sigma values
-% write(19,'(2e20.10)') sigma_bulk, m_scale_str(1)
-% write(19,'(2e20.10)') sigma_beta, m_scale_str(2)
-% write(19,'(2e20.10)') sigma_ts, m_scale_src(1)
-% write(19,'(2e20.10)') sigma_xs, m_scale_src(2)
-% write(19,'(2e20.10)') sigma_zs, m_scale_src(3)
-sigma_all = load([dir1 'sigma_values.dat']);
-sigma_bulk = sigma_all(1,1);
-sigma_beta = sigma_all(2,1);
-sigma_ts = sigma_all(3,1);
-sigma_xs = sigma_all(4,1);
-sigma_zs = sigma_all(5,1);
-
-%---------------------------------------------------------
-% emulate CG variables in wave2d.f90
-
-% ! structure part
-% cov_model(m_inds(1,1):m_inds(1,2)) = ( sigma_bulk )**2 / da_local_vec(:) * AREA * coverage_str
-% cov_model(m_inds(2,1):m_inds(2,2)) = ( sigma_beta )**2 / da_local_vec(:) * AREA * coverage_str
-%
-% ! source part
-% cov_model(m_inds(3,1):m_inds(3,2)) = sigma_ts**2 * dnparm_src_run * coverage_src
-% cov_model(m_inds(4,1):m_inds(4,2)) = sigma_xs**2 * dnparm_src_run * coverage_src
-% cov_model(m_inds(5,1):m_inds(5,2)) = sigma_zs**2 * dnparm_src_run * coverage_src
-%
-% ! incorporate relative weighting to make the final metric
-% ! STRUCTURE: (fac_str / ugrad_str) * ugrad_str --> fac_str
-% cov_imetric(m_inds(1,1):m_inds(1,2)) = cov_model(m_inds(1,1):m_inds(1,2)) * (fac_str / ugrad_str) * fac_total
-% cov_imetric(m_inds(2,1):m_inds(2,2)) = cov_model(m_inds(2,1):m_inds(2,2)) * (fac_str / ugrad_str) * fac_total
-% cov_imetric(m_inds(3,1):m_inds(3,2)) = cov_model(m_inds(3,1):m_inds(3,2)) * (fac_ts / ugrad_ts) * fac_total
-% cov_imetric(m_inds(4,1):m_inds(4,2)) = cov_model(m_inds(4,1):m_inds(4,2)) * (fac_xs / ugrad_xs) * fac_total
-% cov_imetric(m_inds(5,1):m_inds(5,2)) = cov_model(m_inds(5,1):m_inds(5,2)) * (fac_ys / ugrad_ys) * fac_total
-
-cov_model = zeros(nparm,1);
-cov_model(indC) = ( sigma_bulk )^2 ./ da_local_vec * Atot * coverage_str;
-cov_model(indB) = ( sigma_beta )^2 ./ da_local_vec * Atot * coverage_str;
-cov_model(indT) = sigma_ts^2 * nparm_src_run * coverage_src;
-cov_model(indX) = sigma_xs^2 * nparm_src_run * coverage_src;
-cov_model(indY) = sigma_zs^2 * nparm_src_run * coverage_src;
-
-cov_imetric = zeros(nparm,1);
-cov_imetric(indC) = cov_model(indC) * (fac_str / ugrad_str) * fac_total;
-cov_imetric(indB) = cov_model(indB) * (fac_str / ugrad_str) * fac_total;
-cov_imetric(indT) = cov_model(indT) * (fac_ts / ugrad_ts) * fac_total;
-cov_imetric(indX) = cov_model(indX) * (fac_xs / ugrad_xs) * fac_total;
-cov_imetric(indY) = cov_model(indY) * (fac_ys / ugrad_ys) * fac_total;
-
-% cov_model -- TO CHECK
-%write(19,'(4e20.10)') cov_imetric(i), icov_metric(i), cov_model(i), icov_model(i)
-cov_model_all = load([dir1 'cov_model_diagonal.dat']);
-cov_imetric0 = cov_model_all(:,1);
-% check
-for ii=1:5
- inds = m_inds(ii,1):m_inds(ii,2);
- disp('------');
- disp(sprintf('%.3e %.3e %.3e %.3e',...
- norm(cov_imetric0(inds)), norm(cov_imetric(inds)),...
- norm(cov_imetric0(inds)-cov_imetric(inds)),...
- norm(cov_imetric0(inds)-cov_imetric(inds)) / norm(cov_imetric0(inds))))
-end
-
-% gradient
-%gradient_model(:) = m0(:) / cov_imetric(:)
-gradient = zeros(nparm,1);
-source_gradient = load([dir1 'source_gradient.dat']);
-gradient_model = m0 ./ cov_imetric;
-gradient_data = zeros(nparm,1);
-gradient_data(indC) = 0;
-gradient_data(indB) = summed_ker .* da_local_vec; % NOTE: summed_ker is NOT smoothed
-gradient_data(m_inds(3,1):m_inds(5,2)) = source_gradient;
-gradient = gradient_data + gradient_model;
-
-% gradient -- TO CHECK
-%write(19,'(3e20.10)') gradient(i), gradient_data(i), gradient_model(i)
-[gradient0,gradient_data0,gradient_model0] = textread([dir1 'gradient_vec.dat'],'%f%f%f');
-gradient0(indsTXY) = 0; % no source inversion
-% check
-for ii=1:5
- inds = m_inds(ii,1):m_inds(ii,2);
- disp('------');
- disp(sprintf('%.3e %.3e %.3e %.3e',...
- norm(gradient0(inds)), norm(gradient(inds)),...
- norm(gradient0(inds)-gradient(inds)),...
- norm(gradient0(inds)-gradient(inds)) / norm(gradient0(inds)) ))
- figure; nr=3; nc=1;
- subplot(nr,nc,1); plot( gradient0(inds), '.'); title(stpars{ii});
- subplot(nr,nc,2); plot( gradient(inds), '.')
- subplot(nr,nc,3); plot( gradient0(inds), gradient(inds), '.')
-end
-
-break
-
-%---------------------------------------------------------
-% emulate CG algorithm in wave2d.f90
-
-
-
-%/home/carltape/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_INPUT/random_fields/model_001/
-
-%=============================================================
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,1041 +0,0 @@
-%
-% wave2d_subspace.m
-% CARL TAPE, 16-Nov-2008
-% printed xxx
-%
-% This program implements the subspace method inversion notes developed by
-% Jeroen Tromp, Malcolm Sambridge, and Carl Tape.
-%
-% calls xxx
-% called by xxx
-%
-
-clc, clear, close all
-format short, format compact
-%warning off
-
-colors;
-
-ax1 = [-121 -114 31 37];
-stfm = '%4.4i';
-
-%----------------------------------------------
-% USER INPUT
-
-dir_run = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_OUTPUT/';
-
-inew = 0; % subspace AND parameter class inversions
-
-%----------------------------------------------
-
-if 0==1
- temp = load('/net/denali/scratch1/carltape/OUTPUT/run_7000/structure_dat.dat');
- %temp = load('/net/denali/scratch1/carltape/OUTPUT/run_7000/HESSIAN/structure_dat.dat');
- lon = temp(:,1); lat = temp(:,2); beta = temp(:,7);
-
- [X,Y,Z] = griddataXB(lon,lat,beta,100,'nearest');
- figure; cmax = 0.1; hold on;
- pcolor(X,Y,Z); shading interp;
- caxis([-1 1]*cmax); colormap(seis);
-end
-
-% check the relative dimensions of all the matrices we need
-if 0==1
- S = 5; % number of sources
- Cstr = 1; % number of structure parameter classes
- Csrc = 2; % number of source parameter classes
- C = Cstr + Csrc;
- Mstr1 = 20; % number of structure parameters
- Msrc1 = 1; % number of source parameters in class 1 (origin time)
- Msrc2 = 2; % number of source parameters in class 2 (xy, ys)
- Mstr = Mstr1;
- Msrc = S*(Msrc1 + Msrc2);
- M = Mstr + Msrc; % number of rows in P
- N = C*S; % number of columns in P
-
- P = zeros(M,N);
- P(1:Mstr1,1:S) = rand(Mstr1,S);
- for s = 1:S
- P(Mstr1+s,S+s) = rand;
- P(Mstr1+S+s,2*S+s) = rand;
- P(Mstr1+2*S+s,2*S+s) = rand;
- end
-
- % fill G
- G = zeros(S,M);
- Gstr = rand(S,Mstr);
- Gsrc = zeros(S,Msrc);
- if 1==1
- Gsrc = repmat(diag(rand(S,1)),1,Msrc1+Msrc2);
- else
- itemp = (Msrc1 + Msrc2)*[1:S]';
- indmat2 = [ [1 ; 1+itemp(1:end-1)] itemp ];
- for isrc = 1:S
- inds = indmat2(isrc,1) : indmat2(isrc,2);
- %Gsrc(isrc,inds) = -ws(isrc) * grad_src(inds);
- Gsrc(isrc,inds) = rand(1,length(inds));
- end
- end
- G = [Gstr Gsrc];
-
- Cm = diag(rand(M,1));
- Cmi = P'*Cm*P;
- GG = G*Cm*P;
-
- d = zeros(S,1);
- Hnew = GG'*GG + Cmi;
- dnew = GG'*d;
- mu = Hnew*dnew;
- whos d Hnew dnew mu
-
- figure; nr=3; nc=4; msize=3;
- subplot(nr,nc,2); spy(G,msize); title(sprintf('G is %i by %i',size(G)));
- subplot(nr,nc,3); spy(G',msize); title(sprintf('G^T is %i by %i',size(G')));
- subplot(nr,nc,4); spy(G*G',msize); title(sprintf('G G^T is %i by %i',size(G*G')));
-
- subplot(nr,nc,5); spy(P',msize); title(sprintf('P^T is %i by %i',size(P')));
- subplot(nr,nc,6); spy(Cm,msize); title(sprintf('Cm is %i by %i',size(Cm)));
- subplot(nr,nc,7); spy(P,msize); title(sprintf('P is %i by %i',size(P)));
- subplot(nr,nc,8); spy(Cmi,msize); title(sprintf('P^T Cm P is %i by %i',size(Cmi)));
-
- subplot(nr,nc,9); spy(G,msize); title(sprintf('G is %i by %i',size(G)));
- subplot(nr,nc,10); spy(Cm,msize); title(sprintf('Cm is %i by %i',size(Cm)));
- subplot(nr,nc,11); spy(P,msize); title(sprintf('P is %i by %i',size(P)));
- subplot(nr,nc,12); spy(GG,msize); title(sprintf('G Cm P is %i by %i',size(GG)));
- orient tall, wysiwyg
-
- break
-end
-
-%---------------------------------------------
-
-if 0==1
- nk = 100;
- kvec = 10.^linspace(-4,4,nk);
-
- figure; nr=2; nc=1;
- for jj=1:2
- switch jj
- case 1, ndata = 5; nparm = 10;
- case 2, ndata = 10; nparm = 5;
- end
- Cm = diag(rand(nparm,1));
- G = rand(ndata,nparm);
- d = rand(ndata,1);
-
- norm_dm = zeros(nk,1);
- for kk = 1:nk
- C = Cm * kvec(kk);
- norm_dm(kk) = norm( C * G' * inv(G*C*G') * d );
- end
- subplot(nr,nc,jj);
- semilogx(kvec, norm_dm, '.');
- end
-end
-
-%----------------------------------------------
-
-irun0 = input(' Enter irun0 : ');
-iread = input(' Enter 1 to read in new event kernels (0 otherwise) : ');
-hmod = input(' Enter next model number (hmod) : ');
-INV_STRUCT = input(' Enter 1 to invert for STRUCTURE : ');
-INV_SOURCE = input(' Enter 1 to invert for SOURCE : ');
-iwrite = input(' Enter 1 to write out files : ');
-if iwrite==1
- COMPUTE_KERNELS = input(' Enter 1 to compute the event kernels for this model : ');
-end
-if INV_STRUCT==1
- ifigure = input(' Enter 1 to plot figures : ');
-else
- ifigure = 0;
-end
-
-%iwrite = 0;
-%ifigure = 1;
-%hmod = 1; % 1, 2, 3, ...
-%irun0 = 7150; % 6080, 6180, 7000, 7050
-
-NLOCAL = 40000; % assume 1 source parameter only for now (beta)
-NPARM_SOURCE = 3;
-NPARM_STRUCT = 2;
-
-nsrc = 25;
-nrec = 132;
-nmeas = nsrc * nrec;
-
-nmod_str = NLOCAL;
-nmod_src = nsrc * NPARM_SOURCE;
-nmod = nmod_str + nmod_src;
-
-%SIGMA_DT = 0.20;
-%sval_cut = SIGMA_DT * sqrt(nmeas);
-sval_cut = 5;
-
-%----------------
-
-sth = sprintf('%2.2i',hmod);
-
-dir0 = [dir_run 'run_' sprintf(stfm,irun0) '/'];
-dir2 = [dir0 'HESSIAN/model_m' sth '/'];
-dir2lab = ['run-' sprintf(stfm,irun0) ', HESSIAN -- toward model m' sth ];
-
-if hmod == 1
- dir1 = dir0;
-else
- dir1 = [dir0 'HESSIAN/model_m' sprintf('%2.2i',hmod-1) '/'];
-end
-
-% indexing for measurements
-itemp = [nrec:nrec:nmeas]';
-indmat1 = [ [1 ; 1+itemp(1:end-1)] itemp ];
-itemp = NPARM_SOURCE*[1:25]';
-indmat2 = [ [1 ; 1+itemp(1:end-1)] itemp ];
-
-% indexing for model vector
-m_inds = load([dir1 'm_inds.dat']);
-inds_C = [m_inds(1,1) : m_inds(1,2)];
-inds_B = [m_inds(2,1) : m_inds(2,2)];
-inds_ts = [m_inds(3,1) : m_inds(3,2)];
-inds_xs = [m_inds(4,1) : m_inds(4,2)];
-inds_ys = [m_inds(5,1) : m_inds(5,2)];
-inds_src = [m_inds(3,1) : m_inds(5,2)];
-
-% load the source parameters
-src_syn = load([dir1 'src_syn.dat']);
-slon = src_syn(:,1);
-slat = src_syn(:,2);
-src_ts = src_syn(:,3);
-src_xs = src_syn(:,4);
-src_ys = src_syn(:,5);
-
-% load the source parameters
-src_dat = load([dir1 'src_dat.dat']);
-src_ts_dat = src_dat(:,3);
-src_xs_dat = src_dat(:,4);
-src_ys_dat = src_dat(:,5);
-
-% load the receivers
-rec_lonlat = load([dir1 'recs_lonlat.dat']);
-rlon = rec_lonlat(:,1);
-rlat = rec_lonlat(:,2);
-
-% load the data covariance matrix
-cov_data = load([dir1 'cov_data_diagonal.dat']);
-
-% load all the measurements and partition into matrix
-meas_all = load([dir1 'measure_vec.dat']);
-dT_all = meas_all(:,1); % WITH ERRORS ADDED
-dT_all_norm = dT_all.^2 ./ cov_data;
-
-% load the covariance matrix
-% --> cov_imetric(NLOCAL+1 : nmod_str) = ( sigma_beta )**2 / da_local_vec(:) * AREA
-%cov_model = load('/net/denali/scratch1/carltape/OUTPUT_2/run_9100/cov_imetric_diagonal.dat');
-cov_model_all = load([dir1 'cov_model_diagonal.dat']);
-cov_model = cov_model_all(:,1);
-cov_alpha = cov_model(inds_C)';
-cov_beta = cov_model(inds_B)';
-cov_src = cov_model(inds_src)';
-clear cov_model_all
-
-% load the reference values
-% alpha0, beta0, rho0, bulk0, kappa0, mu0
-vall = load([dir1 'reference_values.dat']);
-alpha0 = vall(1);
-beta0 = vall(2);
-rho0 = vall(3);
-bulk0 = vall(4);
-kappa0 = vall(5);
-mu0 = vall(6);
-
-% load the model vector
-mtemp = load([dir1 'cg_model_vectors.dat']);
-m_all = mtemp(:,1);
-%m_bulk = mtemp(NLOCAL+1 : 2*NLOCAL, 1)';
-%m_beta = mtemp(NLOCAL+1 : 2*NLOCAL, 1)';
-m_src = mtemp(inds_src)';
-
-% load the structure files
-mtemp = load([dir1 'structure_syn.dat']);
-m_str_lon = mtemp(:,1);
-m_str_lat = mtemp(:,2);
-m_str_kappa = mtemp(:,3);
-m_str_mu = mtemp(:,4);
-m_str_rho = mtemp(:,5);
-m_str_C = mtemp(:,6);
-m_str_B = mtemp(:,7);
-
-% load the structure files
-mtemp = load([dir1 'structure_dat.dat']);
-m_dat_str_lon = mtemp(:,1);
-m_dat_str_lat = mtemp(:,2);
-m_dat_str_kappa = mtemp(:,3);
-m_dat_str_mu = mtemp(:,4);
-m_dat_str_rho = mtemp(:,5);
-m_dat_str_C = mtemp(:,6);
-m_dat_str_B = mtemp(:,7);
-
-% load source files (synthetics and data)
-[m_src_lon,m_src_lat,m_src_ts,m_src_xs,m_src_ys,m_src_ts_d,m_src_xs_d,m_src_ys_d] ...
- = textread([dir1 'src_syn.dat'],'%f%f%f%f%f%f%f%f');
-[junk1,junk2,m_src_ts_dat,m_src_xs_dat,m_src_ys_dat,junk3,junk4,junk5] ...
- = textread([dir1 'src_dat.dat'],'%f%f%f%f%f%f%f%f');
-
-% load the gradient
-gtemp = load([dir1 'gradient_vec.dat']);
-gradient = gtemp(:,1);
-grad_bulk = gradient(inds_C)';
-grad_beta = gradient(inds_B)';
-grad_src = gradient(inds_src)';
-disp(' check norms of structure and source GRADIENTS :');
-norm_grad_str = dot( grad_beta, cov_beta.*grad_beta )
-norm_grad_src = dot( grad_src, cov_src.*grad_src )
-disp(' gradient balance for the CG inversion :');
-norm_grad_src / norm_grad_str
-
-% load the source gradient and partition into matrix
-%grad_src = load([dir1 'source_gradient.dat']);
-% grad_src_mat = zeros(nsrc,NPARM_SOURCE);
-% for isrc = 1:nsrc
-% grad_src_mat(isrc,:) = grad_src(indmat2(isrc,1) : indmat2(isrc,2));
-% end
-
-% check the misfit function value
-chi = load([dir1 'chi.dat']);
-chi_data_norm = load([dir1 'chi_data_norm.dat']);
-chi_model_norm = load([dir1 'chi_model_norm.dat']);
-
-disp(' '); disp(' CHECKING VARIOUS NORMS:');
-disp(' model norm:');
-chi_model_norm, sum( m_all.^2 ./ cov_model )
-disp(' data norm:');
-chi_data_norm, sum(dT_all_norm)
-disp(' misfit function value:');
-chi, 0.5*( sum( dT_all_norm ) + sum( m_all.^2 ./ cov_model ))
-
-%====================================================
-
-% partition DATA vector of traveltime measurements into a matrix,
-% since in this case we know that there are the same number of picks for each event
-dT_mat = zeros(nsrc,nrec);
-dT_norm_mat = zeros(nsrc,nrec);
-for isrc = 1:nsrc
- inds = [indmat1(isrc,1) : indmat1(isrc,2)];
- dT_mat(isrc,:) = dT_all(inds);
- dT_norm_mat(isrc,:) = dT_all_norm(inds);
-end
-
-% compute the new data vector
-dnorm = sum( dT_norm_mat, 2);
-if any(dnorm==0), error(' For at least one source, there is perfect fit.'); end
-
-% compute the weights (SIGN OR NOT?)
-%ws = zeros(nsrc,1);
-%ws = 1 ./ sqrt( sum( dT_norm_mat, 2) );
-%if sum(isinf(ws)) > 0, error(' For at least one source, there is perfect fit.'); end
-% compute the new data vector
-%dnorm = 1 ./ ws;
-
-% check
-sum(sum(dT_norm_mat)), sum(dT_all_norm), sum( dnorm )
-
-if INV_STRUCT == 1
-
- % load the jacobian for constructing the "event gradient" from the event kernel
- lmesh_all = load([dir1 'local_mesh.dat']);
- Ai = lmesh_all(:,9)';
-
- % load the event kernels
- %iread = 1;
- efile = 'wave2d_kernel';
- if iread==1
- % THE SPECIFICATION FOR SMOOTHED KERNELS IS DONE IN WAVE2D.F90
- % EITHER WAY, YOU LOAD THE FILES kernel_basis_smooth, WHICH MAY OR
- % MAY NOT BE SMOOTHED.
- ismooth = input(' Enter 1 to read smoothed event kernels (0 otherwise) : ');
- disp('reading in the event kernels...');
- Kall = zeros(nsrc,NLOCAL);
- for isrc = 1:nsrc
- isrc
- dirK = [dir1 'event_' sprintf('%3.3i',isrc) '/'];
- if ismooth == 1
- kernel = load([dirK 'kernel_basis_smooth']); Kbeta = kernel(:,3)';
- else
- kernel = load([dirK 'kernel_basis']); Kbeta = kernel(:,7)';
- end
- lon = kernel(:,1);
- lat = kernel(:,2);
- Kall(isrc,:) = Kbeta;
- end
- save(efile,'Kall','lon','lat');
- %break
- else
- load(efile);
- end
-
- % construct G (plot event kernels too)
- %nsrc = 5;
- Gstr = zeros(nsrc,NLOCAL);
- for isrc = 1:nsrc
- Kbeta = Kall(isrc,:);
- %Gstr(isrc,:) = -ws(isrc) * Kbeta .* Ai; % SIGN OR NOT?
- Gstr(isrc,:) = -Kbeta .* Ai;
-
- if 0==1
- [X,Y,Z] = griddataXB(lon,lat,Kbeta,100,'nearest');
- figure; cmax = 1e-7; hold on;
- pcolor(X,Y,Z); shading interp;
- caxis([-1 1]*cmax); colormap(seis);
- plot(rlon,rlat,'k.','markersize',16)
- for irec = 1:nrec
- text(rlon(irec),rlat(irec),sprintf('%6.1f',dT_mat(isrc,irec)),'fontsize',12);
- end
- plot(slon(isrc),slat(isrc),'p','markersize',24,...
- 'markerfacecolor','w','markeredgecolor','k','linewidth',2);
- end
- end
-
- % Hessian for structure parameters (from event kernels)
- disp('constructing the Hessian...');
- Hstr = zeros(nsrc,nsrc);
- for ii = 1:nsrc
- for jj = 1:nsrc
- Hstr(ii,jj) = dot(Gstr(ii,:), cov_beta.*Gstr(jj,:));
- end
- end
-
-else
- Hstr = zeros(nsrc,nsrc);
-end
-
-% Hessian and projected gradient for source parameters
-Hsrc = zeros(nsrc,nsrc);
-%Hsrc_vec = zeros(nsrc,1);
-if INV_SOURCE == 1
-
- Gsrc = zeros(nsrc,nmod_src);
- Gsrc = [diag(gradient(inds_ts)) diag(gradient(inds_xs)) diag(gradient(inds_ys))];
- %for isrc = 1:nsrc
- % inds = indmat2(isrc,1) : indmat2(isrc,2);
- % %Gsrc(isrc,inds) = -ws(isrc) * grad_src(inds);
- % Gsrc(isrc,inds) = grad_src(inds);
- %end
- Hsrc = Gsrc * diag(cov_src) * transpose(Gsrc);
-
- %for isrc = 1:nsrc
- % inds = indmat2(isrc,1) : indmat2(isrc,2);
- % Hsrc_vec(isrc) = ws(isrc)^2 * dot(grad_src(inds), cov_src(inds).*grad_src(inds) );
- %end
- %Hsrc = diag(Hsrc_vec);
-end
-
-% overall Hessian
-H = Hstr + Hsrc + eye(nsrc,nsrc);
-
-% construct projection matrix (and assign gradient)
-if INV_STRUCT == 1
- G = Gstr;
- Pstr = Gstr';
- P = Pstr;
-end
-if INV_SOURCE == 1
- G = Gsrc;
- Psrc = zeros(nmod_src,nsrc*2); % 2: origin time and location
- Psrc(1:nsrc,1:nsrc) = Gsrc(1:nsrc,1:nsrc);
- Psrc(nsrc+1:2*nsrc,nsrc+1:2*nsrc) = Gsrc(1:nsrc,nsrc+1:2*nsrc);
- Psrc(2*nsrc+1:3*nsrc,nsrc+1:2*nsrc) = Gsrc(1:nsrc,2*nsrc+1:3*nsrc);
- P = Psrc;
-end
-if and(INV_STRUCT == 1, INV_SOURCE == 1)
- G = [Gstr Gsrc];
- P = zeros(nmod,3*nsrc);
- P(1:nmod_str,1:nsrc) = Pstr;
- P(nmod_str+1:nmod,nsrc+1:3*nsrc) = Psrc;
-end
-
-% construct matrices for joint inversions
-if inew == 1
- GG = zeros(nsrc,NCLASS*nsrc);
- CmP = P; for ii=1:nmod, CmP(ii,:) = P(ii,:) * cov_model(nmod_str+ii); end;
- GG = G * CmP;
- Cmi = P' * CmP;
-
- figure; nr=3; nc=1;
- subplot(nr,nc,1); spy(P(nmod_str-100:nmod_str,:),3); title('bottom 100 rows of P');
- subplot(nr,nc,2); spy(GG,3); title('GG = G Cm P');
- subplot(nr,nc,3); spy(Cmi,3); title('Cmi = P^T Cm P');
- orient tall, wysiwyg
-end
-
-disp(' Hessian diagonal contributions from structure and source:');
-disp(' structure source total source/structure');
-disp([diag(Hstr) diag(Hsrc) diag(H) diag(Hsrc)./diag(Hstr) ]);
-disp(' gradient balance for the Hessian (subspace) inversion (mean of last column) :');
-disp(mean( diag(Hsrc)./diag(Hstr) ))
-
-disp(' properties of Hessian (min, median, mean(abs), max, std):');
-stH = sprintf('min %.2e, median %.2e, mean(abs) %.2e, max %.2e, std %.2e',...
- min(H(:)), median(H(:)), mean(abs(H(:))), max(H(:)), std(H(:)));
-disp(stH);
-
-if ~and(INV_STRUCT==1, INV_SOURCE==1)
- figure; pcolor(H); shading flat;
- xlabel('Row index'); ylabel('Column index');
- title({'Hessian (symmetric matrix)',stH});
- map = colormap('gray'); colormap(flipud(map));
- colorbar; axis equal; axis tight;
-else
- figure; nr=3; nc=1;
- subplot(nr,nc,1); pcolor(H); shading flat;
- xlabel('Row index'); ylabel('Column index');
- title({'Hessian (symmetric matrix)',stH});
- map = colormap('gray'); colormap(flipud(map));
- colorbar; axis equal; axis tight;
-
- subplot(nr,nc,2); pcolor(Hstr); shading flat;
- xlabel('Row index'); ylabel('Column index');
- title('Hessian for structure (symmetric matrix)');
- map = colormap('gray'); colormap(flipud(map));
- colorbar; axis equal; axis tight;
-
- subplot(nr,nc,3); pcolor(Hsrc); shading flat;
- xlabel('Row index'); ylabel('Column index');
- title('Hessian for source (diagonal matrix)');
- map = colormap('gray'); colormap(flipud(map));
- colorbar; axis equal; axis tight;
- orient tall, wysiwyg
-end
-
-if INV_SOURCE == 1
- figure; nr=2; nc=1;
- subplot(nr,nc,1); spy(Gsrc); title('Gsrc');
- subplot(nr,nc,2); spy(Gsrc*Gsrc'); title('Gsrc * Gsrc^T');
-end
-
-% set of pmax TSVD values to try
-iyes = 0;
-while iyes == 0
- iyes = input(' Enter 1 if this balance looks okay : ');
-end
-
-% check the balance of the gradients -- SAME AS CHECKING THE HESSIAN DIAGONAL
-if 0 == 1
- cov_beta0 = cov_beta;
- cov_src0 = cov_src;
-
- kvec = linspace(0.2,6,100);
- for k = 1:length(kvec)
- fac = kvec(k);
- cov_beta = cov_beta0 * fac;
-
- for ii = 1:nsrc
- norm_grad_str(ii) = sum( Gstr(ii,:).^2 .* cov_beta );
- norm_grad_src(ii) = sum( Gsrc(ii,:).^2 .* cov_src );
- norm_grad_tot(ii) = norm_grad_str(ii) + norm_grad_src(ii);
- end
- %disp(' Norms of the gradients and constituent parts:');
- %disp(' structure source total source/structure');
- %disp([norm_grad_str' norm_grad_src' norm_grad_tot' norm_grad_src'./norm_grad_str']);
- %disp(' mean of the last column :');
- disp([fac mean( norm_grad_src'./norm_grad_str' )]);
- end
-
-end
-
-%------------------------------------------------------------------------
-
-% truncated singular value decomposition
-TSVD = 0;
-if TSVD == 1
-
- % analyze the singular values of H
- [U,S,V] = svd(H);
- s = diag(S);
-
- if 0==1
- % analyze the singular values of H
- % (See also tsvd.m)
- [U,S,V] = svd(H);
- s = diag(S);
- p = sum( s > sval_cut ); % KEY: singular value truncation index
- sp = s(1:p);
- Sp = diag(sp);
- Up = U(:,1:p);
- Vp = V(:,1:p);
- whos U S V
- whos Up Sp Vp
- Hp = Up*Sp*Vp';
- Hinv = Vp*inv(Sp)*Up';
- mu = Hinv * dnorm;
-
- if 0==1
- Ncheck = zeros(nsrc,1);
- for p = 1:nsrc
- sp = s(1:p);
- Sp = diag(sp);
- Up = U(:,1:p);
- Vp = V(:,1:p);
- Hp = Up*Sp*Vp';
-
- Hinv = Vp*inv(Sp)*Up';
- mu = Hinv * dnorm;
- dm_str = transpose(Gstr) * mu .* cov_beta'; % order?
- m_str_B_new = m_str_B + dm_str;
- Ncheck(p) = sum( (dnorm - Gstr*dm_str).^2 ); % matches rss from tsvd.m
- end
- end
-
- % check the norms and the norms of the inverse
- norm(H), norm( U*S*V' ), norm(Hp)
- norm(inv(H)), norm( Vp*inv(Sp)*Up' ), norm(inv(Hp))
-
- figure; hold on; plot(H(:),'b.'); plot(Hp(:),'ro');
- end
-
- %H = H / 0.5; % 9550
-
- pinds = [1:nsrc]';
- [mu_all,rss,f_r_ss] = tsvd(dnorm,H,pinds); % KEY: TSVD
-
- % norms of mu vectors
- mu_norm = zeros(nsrc,1);
- for ip = 1:nsrc
- mu_norm(ip) = norm(mu_all(:,ip));
- end
-
- figure; nr=2; nc=2;
- xlab1 = 'p, singular value index';
- xlab2 = 'p, singular value truncation index';
- ylab1 = 'singular value';
- ylab2 = 'misfit : dot[ d - H*mu(p), d - H*mu(p) ]';
-
- subplot(nr,nc,1); plot(pinds,s,'.','markersize',20);
- grid on; xlabel(xlab1); ylabel(ylab1); title(dir2lab);
- subplot(nr,nc,2); semilogy(pinds,s,'.','markersize',20);
- grid on; xlabel(xlab1); ylabel(ylab1);
- subplot(nr,nc,3); plot(pinds,rss,'.','markersize',20);
- grid on; xlabel(xlab2); ylabel(ylab2);
- subplot(nr,nc,4); semilogy(pinds,rss,'.','markersize',20);
- grid on; xlabel(xlab2); ylabel(ylab2);
- orient tall, wysiwyg
-
- figure; nr=2; nc=2;
- ylab3 = 'norm of mu vector';
-
- subplot(nr,nc,1); semilogy(pinds,s,'.','markersize',20);
- grid on; xlabel(xlab1); ylabel(ylab1);
- subplot(nr,nc,2); semilogy(pinds,rss,'.','markersize',20);
- grid on; xlabel(xlab2); ylabel(ylab2);
- subplot(nr,nc,3); plot(pinds,mu_all,'.');
- grid on; xlabel('source index'); ylabel('elements of mu vectors');
- subplot(nr,nc,4); semilogy(pinds,mu_norm,'.','markersize',20);
- grid on; xlabel(xlab2); ylabel(ylab3);
- orient tall, wysiwyg
-else
- Hinv = inv(H);
- mu = Hinv * dnorm;
-end
-
-%------------------------------------------------------------------------
-
-% set of pmax TSVD values to try (if TSVD = 1)
-if TSVD == 1
- iyes = 0;
- while iyes == 0
- disp(' Enter truncation values for TSVD:');
- pmin = input(' Enter pmin : ');
- pmax = input(' Enter pmax : ');
- pinc = input(' Enter pinc : ');
- pmax_vec = [pmin : pinc : pmax]
- iyes = input(' Enter 1 if this is what you want (0 otherwise) : ');
- end
-else
- pmax_vec = 1;
-end
-nump = length(pmax_vec);
-
-source_error_norm_mat = zeros(nump,5);
-source_error_norm_mat(:,1) = pmax_vec';
-
-if inew == 1
- Hnew = GG'*GG + Cmi;
- dnew = GG'*dnorm;
-end
-
-for ip = 1:nump
-
- % OPTIONS FOR INVERTING HESSIAN:
- % (1) truncated singular value decomposition
- % (2) cross-validation
- if TSVD == 1
- pmax = pmax_vec(ip);
- disp(sprintf('%i out of %i : pmax = %i',ip,nump,pmax));
-
- %[mu_all,rss,f_r_ss] = tsvd(dnorm,H,pinds); % KEY: TSVD
- mu = mu_all(:,pmax); % KEY vector
-
- stp = sprintf('pmax = %i',pmax);
- if 0 == 1
- figure; nr=2; nc=2;
- subplot(nr,nc,1);
- plot(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab1); ylabel(ylab1); title({dir2lab,stp});
- subplot(nr,nc,2);
- semilogy(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab1); ylabel(ylab1); title(stp);
- subplot(nr,nc,3);
- plot(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab2); ylabel(ylab2); title(stp);
- subplot(nr,nc,4);
- semilogy(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab2); ylabel(ylab2); title(stp);
- orient tall, wysiwyg
- end
-
- else
- if inew == 1
- midlampwr = log10(trace(Hnew))/2;
- else
- midlampwr = log10(trace(H))/2;
- end
-
- % regularization choices
- %minlampwr = -3; maxlampwr = 3;
- minlampwr = midlampwr - 2; maxlampwr = midlampwr + 2;
- numlam = 100;
- lampwr = linspace(minlampwr,maxlampwr,numlam);
- lamvec = 10.^lampwr;
-
- if inew == 1
- [f_h, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dnew,Hnew,lamvec);
- else
- [f_h, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dnorm,H,lamvec);
- end
-
- ipick = input(' Enter 0 for GCV, 1 for OCV, 2 for L-curve : ');
- switch ipick
- case 0, lam = lamvec(iGCV);
- case 1, lam = lamvec(iOCV);
- case 2, lam = lamvec(iL);
- end
-
- % KEY vector
- if inew == 1
- mu = inv(Hnew'*Hnew + lam^2*eye(3*nsrc,3*nsrc))*Hnew'*dnew;
- else
- mu = inv(H'*H + lam^2*eye(nsrc,nsrc))*H'*dnorm;
- end
-
- stp = sprintf('lambda = %.3f',lam);
-
- %Hinv = inv(H);
- %mu = Hinv * dnorm;
- end
-
- % testing H + I
- %Hinv = inv(H);
- %mu = Hinv * dnorm;
-
- % KEY: solve for the STRUCTURE model update
- dm_str = zeros(nmod_str,1);
- if INV_STRUCT == 1
- if inew == 1
- dm_str = cov_beta' .* (Pstr * mu(1:nsrc));
- else
- dm_str = cov_beta' .* (transpose(Gstr) * mu);
- end
- end
- %disp(' norm of structure update:');
- %sum( dm_str .* dm_str ./ cov_beta' )
-
- % KEY: solve for the SOURCE model update (ts1, ts2, ..., xs1, xs2, ..., ys1, ys2, ...)
- dm_src = zeros(nmod_src,1);
- if INV_SOURCE == 1
- %mtemp = repmat(mu',3,1); mu_expand = mtemp(:);
- %wtemp = repmat(ws',3,1); ws_expand = wtemp(:);
- %dm_src = -cov_src' .* grad_src' .* ws_expand .* mu_expand; % SIGN OR NOT?
-
- if inew == 1
- dm_src = cov_src' .* (Psrc * mu(nsrc+1:end));
- else
- dm_src = cov_src' .* (transpose(Gsrc) * mu);
- end
- end
- %disp(' norm of source update:');
- %sum( dm_src .* dm_src ./ cov_src' )
-
- %-------------------
-
- % source parameter updates
- if INV_SOURCE == 1
-
- %for ii = 1:nsrc
- % i0 = (ii-1)*3;
- % m_src_xs_new(ii) = m_src_xs(ii) + dm_src(i0+1);
- % m_src_ys_new(ii) = m_src_ys(ii) + dm_src(i0+2);
- % m_src_ts_new(ii) = m_src_ts(ii) + dm_src(i0+3);
- %end
-
- m_src_ts_new = m_src_ts + dm_src(inds_ts - m_inds(2,2));
- m_src_xs_new = m_src_xs + dm_src(inds_xs - m_inds(2,2));
- m_src_ys_new = m_src_ys + dm_src(inds_ys - m_inds(2,2));
-
- m_src_ts_d_new = m_src_ts_new - m_src_ts_dat;
- m_src_xs_d_new = m_src_xs_new - m_src_xs_dat;
- m_src_ys_d_new = m_src_ys_new - m_src_ys_dat;
-
-% idisplay = 0; % display information on source parameters
-% if idisplay == 1
-% disp(' '); disp('Source parameter updates:');
-% for ii = 1:nsrc
-% i0 = (ii-1)*3;
-% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
-% ii,dm_src(i0+1),dm_src(i0+2),dm_src(i0+3) ));
-% end
-% disp(' '); disp('Current parameter errors:');
-% for ii = 1:nsrc
-% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
-% ii, m_src_xs_d(ii), m_src_ys_d(ii),m_src_ts_d(ii)));
-% end
-% disp(' '); disp('New source parameter errors:');
-% for ii = 1:nsrc
-% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
-% ii, m_src_xs_d_new(ii), m_src_ys_d_new(ii),m_src_ts_d_new(ii)));
-% end
-% end
- else
- m_src_ts_d_new = m_src_ts_d;
- m_src_xs_d_new = m_src_xs_d;
- m_src_ys_d_new = m_src_ys_d;
-
- m_src_ts_new = m_src_ts;
- m_src_xs_new = m_src_xs;
- m_src_ys_new = m_src_ys;
- end
-
- % compute norms of errors in new source parameters
- %norm_ts = sum(m_src_ts_d_new.^2 ./ cov_src(3:3:nsrc*3)');
- %norm_xs = sum(m_src_xs_d_new.^2 ./ cov_src(1:3:nsrc*3)');
- %norm_ys = sum(m_src_ys_d_new.^2 ./ cov_src(2:3:nsrc*3)');
- norm_ts = sum(m_src_ts_d_new.^2 ./ cov_model(inds_ts));
- norm_xs = sum(m_src_xs_d_new.^2 ./ cov_model(inds_xs));
- norm_ys = sum(m_src_ys_d_new.^2 ./ cov_model(inds_ys));
- source_error_norm_mat(ip,[2:5]) = [norm_xs norm_ys norm_ts sum([norm_xs norm_ys norm_ts])];
-
- % structure parameter updates
- if INV_STRUCT == 1
- m_str_B_new = m_str_B + dm_str; % updated B
- m_str_C_new = m_str_C;
- else
- m_str_B_new = m_str_B;
- m_str_C_new = m_str_C;
- end
-
- % convert to beta, c, kappa, mu, rho
- m_str_beta_new = beta0 * exp( m_str_B_new );
- m_str_bulk_new = bulk0 * exp( m_str_C_new );
- m_str_rho_new = m_str_rho;
- m_str_kappa_new = m_str_rho_new .* m_str_bulk_new.^2;
- m_str_mu_new = m_str_rho_new .* m_str_beta_new.^2;
-
- %disp(' norm of new structure model:');
- %sum( m_str_B_new .* m_str_B_new ./ cov_beta' )
-
- % plot structure model update and new model
- if and(INV_STRUCT == 1, ifigure == 1)
- tlabs = {{dir2lab,'data'},'m00',['dm (' stp ')'],['m01 (' stp ')']};
- cmax = 0.1;
- figure; nr=3; nc=2;
- for kk = 1:4
- switch kk
- case 1, mplot = m_dat_str_B;
- case 2, mplot = m_str_B;
- case 3, mplot = dm_str;
- case 4, mplot = m_str_B_new;
- end
- [X,Y,Z] = griddataXB(lon,lat,mplot,100,'nearest');
-
- subplot(nr,nc,kk); hold on;
- pcolor(X,Y,Z); shading interp;
- caxis([-1 1]*cmax); colormap(seis); axis equal, axis tight
- plot(rlon,rlat,'k.','markersize',16);
- plot(slon,slat,'p','markersize',18,'markeredgecolor','k','linewidth',2);
- title(tlabs{kk});
- end
-
- % TSVD plots
- if TSVD == 1
- subplot(nr,nc,5);
- semilogy(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab1); ylabel(ylab1); title(stp);
- subplot(nr,nc,6);
- semilogy(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
- grid on; xlabel(xlab2); ylabel(ylab2); title(stp);
- end
-
- orient tall, wysiwyg
- end
-
- % write EVERY pmax updated model to file
- if iwrite == 1
-
- if COMPUTE_KERNELS
- dir3 = dir2;
- else
- % make directory
- pdir = ['run_p' sprintf('%2.2i',ip)];
- dir3 = [dir2 pdir '/'];
- mkdir(dir2,pdir)
- end
-
- % save pertinent Matlab variables
- save([dir3 'wave2d_subspace_matlab_h' sth],...
- 'dnorm','H','Hsrc','Hstr',...
- 'mu','INV_SOURCE','INV_STRUCT');
-
- % ! CURRENT MODEL (synthetics)
- % write(19,'(7e20.10)') x_plot(iglob), z_plot(iglob), &
- % kappa_syn(i,j,ispec), mu_syn(i,j,ispec), rho_syn(i,j,ispec), &
- % log( bulk_syn(i,j,ispec) / bulk0 ), log( beta_syn(i,j,ispec) / beta0 )
- fid = fopen([dir3 'structure_syn_h' sth '.dat'],'w');
- for ii = 1:length(m_str_lon)
- fprintf(fid,'%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e\n',...
- m_str_lon(ii), m_str_lat(ii),...
- m_str_kappa_new(ii), m_str_mu_new(ii), m_str_rho_new(ii),...
- m_str_C_new(ii), m_str_B_new(ii) );
- end
- fclose(fid);
-
- % ! sources for synthetics
- % write(20,'(8e20.10)') xtemp, ztemp, &
- % m_src_syn_vec(itemp1), m_src_syn_vec(itemp2), m_src_syn_vec(itemp3), &
- % (m_src_syn_vec(itemp1) - m_src_dat_vec(itemp1)), &
- % (m_src_syn_vec(itemp2) - m_src_dat_vec(itemp2)), &
- % m_src_syn_vec(itemp3) - m_src_dat_vec(itemp3)
- fid = fopen([dir3 'src_syn_h' sth '.dat'],'w');
- for ii = 1:length(m_src_lon)
- fprintf(fid,'%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e%20.10e\n',...
- m_src_lon(ii), m_src_lat(ii),...
- m_src_ts_new(ii), m_src_xs_new(ii), m_src_ys_new(ii),...
- m_src_ts_d_new(ii), m_src_xs_d_new(ii), m_src_ys_d_new(ii) );
- end
- fclose(fid);
-
- % write out pmax
- if TSVD == 1
- fid = fopen([dir3 'pmax_h' sth '.dat'],'w');
- fprintf(fid,'%i\n',pmax);
- fclose(fid);
- else
- fid = fopen([dir3 'lambda_h' sth '.dat'],'w');
- fprintf(fid,'%16.8e\n',lam);
- fclose(fid);
- end
-
- % write out the balance of the gradient norms
- fid = fopen([dir3 'norm_gradient_h' sth '.dat'],'w');
- fprintf(fid,'Balance of the gradients for each event\n');
- fprintf(fid,'%16s%16s%16s%16s\n','STR','SRC','TOTAL','SRC/STR');
- for ii = 1:nsrc
- fprintf(fid,'%16.4f%16.4f%16.4f%16.4f\n',...
- Hstr(ii,ii), Hsrc(ii,ii), H(ii,ii), Hsrc(ii,ii)/Hstr(ii,ii) );
- end
- fprintf(fid,'%48s%16.4f\n','MEAN -->',mean( diag(Hsrc)./diag(Hstr)) );
- fclose(fid);
-
- end
-
-end % ip
-
-% norm in intial source errors
-%norm_xs = sum(m_src_xs_d.^2 ./ cov_src(1:3:nsrc*3)');
-%norm_ys = sum(m_src_ys_d.^2 ./ cov_src(2:3:nsrc*3)');
-%norm_ts = sum(m_src_ts_d.^2 ./ cov_src(3:3:nsrc*3)');
-norm_ts = sum(m_src_ts_d.^2 ./ cov_model(inds_ts));
-norm_xs = sum(m_src_xs_d.^2 ./ cov_model(inds_xs));
-norm_ys = sum(m_src_ys_d.^2 ./ cov_model(inds_ys));
-source_error_norm_old = [0 norm_xs norm_ys norm_ts sum([norm_xs norm_ys norm_ts])];
-
-disp(' ');
-disp(' NORMS of the errors in the old source vectors (xs, ys, ts) :');
-disp(source_error_norm_old);
-disp(' NORMS of the errors in the new source vectors (xs, ys, ts) :');
-disp(' pmax xs ys ts total');
-disp(source_error_norm_mat);
-
-% save pertinent Matlab variables
-if iwrite == 1
- if COMPUTE_KERNELS
- ofile = [dir2 'wave2d_subspace_matlab_pmax'];
- else
- ofile = [dir2 'wave2d_subspace_matlab_all'];
- end
-
- if TSVD == 0
- save(ofile,'dnorm','lamvec','lam',...
- 'f_h','rss','mss','Gvec','Fvec','dof','kap','iL','iGCV','iOCV',...
- 'source_error_norm_mat','source_error_norm_old',...
- 'INV_SOURCE','INV_STRUCT');
- else
- save(ofile,'dnorm','U','S','V','pinds','mu_all','rss','f_r_ss',...
- 'source_error_norm_mat','source_error_norm_old',...
- 'INV_SOURCE','INV_STRUCT');
- end
-end
-
-%------------------------------------------------
-% extra code for plotting misfit values
-
-if 0==1
- clear
-
- run0 = 6550; close all
- for h = 1:4
-
- strun0 = num2str(run0);
- sth = sprintf('%2.2i',h);
- idir = ['/net/denali/scratch1/carltape/OUTPUT/run_' strun0 '/HESSIAN/model_m' sth '/'];
- load([idir 'wave2d_subspace_matlab_all']);
-
- clear chi_data_norm chi_model_norm chi_total pmax_vec
- for ii = 1:25
- dir1 = [ idir 'run_p' sprintf('%2.2i',ii) '/'];
- chi_file = [dir1 'chi_data_norm.dat'];
- if exist(chi_file)
- chi_data_norm(ii) = load(chi_file);
- chi_model_norm(ii) = load([dir1 'chi_model_norm.dat']);
- chi_total(ii) = load([dir1 'chi.dat']);
- %chi_total(ii) = load([dir1 'summed_chi_all.dat']);
- pmax_vec(ii) = load([dir1 'pmax_h' sth '.dat']);
- end
- end
-
- %disp(' '); disp(' pmax 2*S(m(pmax)) S-data S-model');
- %disp([pinds 2*chi_total' chi_data_norm' chi_model_norm']);
-
- % semilogy plots or not?
- figure; nr=2; nc=2;
- xlab1 = 'p, singular value index';
- xlab2 = 'p, singular value truncation index';
- ylab1 = 'singular value';
- ylab2 = 'misfit : dot[ d - G*dm(p), d - G*dm(p) ]';
-
- subplot(nr,nc,1); semilogy(pinds, diag(S),'.','markersize',22); grid on;
- xlabel(xlab1); ylabel(ylab1);
- subplot(nr,nc,3); semilogy(pinds, rss,'.','markersize',22); grid on;
- xlabel(xlab2); ylabel(ylab2);
-
- subplot(nr,nc,2);
- plot( pmax_vec,2*chi_total,'r.',pmax_vec,chi_data_norm,'b.','markersize',22);
- grid on; legend('2 S(m(pmax))','chi-data-norm');
- xlabel(xlab2); title(['RUN ' strun0 ' - H' sth]);
- subplot(nr,nc,4);
- plot( pmax_vec,chi_model_norm,'g.','markersize',22);
- grid on; legend('chi-model-norm','location','northeast');
- xlabel(xlab2); title(['RUN ' strun0 ' - H' sth]);
-
- orient tall, wysiwyg
- end
-
-end
-
-%======================================================================
Added: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m (rev 0)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -0,0 +1,1034 @@
+%
+% wave2d_subspace.m
+% CARL TAPE, 26-Jan-2010
+%
+% This program implements the subspace method inversion notes developed by
+% Jeroen Tromp, Malcolm Sambridge, and Carl Tape.
+%
+% calls xxx
+% called by xxx
+%
+
+clc, clear, close all
+format short, format compact
+%warning off
+
+% add path to additional matlab scripts
+path(path,[pwd '/matlab_scripts']);
+
+colors;
+
+ax1 = [-121 -114 31 37];
+stfm = '%4.4i';
+
+%----------------------------------------------
+% USER INPUT
+
+dir_run = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_OUTPUT/';
+
+TSVD = 0; % truncated singular value decomposition
+
+inew = 0; % subspace AND parameter class inversions
+
+%----------------------------------------------
+
+if 0==1
+ temp = load('/net/denali/scratch1/carltape/OUTPUT/run_7000/structure_dat.dat');
+ %temp = load('/net/denali/scratch1/carltape/OUTPUT/run_7000/READ_IN/structure_dat.dat');
+ lon = temp(:,1); lat = temp(:,2); beta = temp(:,7);
+
+ [X,Y,Z] = griddataXB(lon,lat,beta,100,'nearest');
+ figure; cmax = 0.1; hold on;
+ pcolor(X,Y,Z); shading interp;
+ caxis([-1 1]*cmax); colormap(seis);
+end
+
+% check the relative dimensions of all the matrices we need
+if 0==1
+ S = 5; % number of sources
+ Cstr = 1; % number of structure parameter classes
+ Csrc = 2; % number of source parameter classes
+ C = Cstr + Csrc;
+ Mstr1 = 20; % number of structure parameters
+ Msrc1 = 1; % number of source parameters in class 1 (origin time)
+ Msrc2 = 2; % number of source parameters in class 2 (xy, ys)
+ Mstr = Mstr1;
+ Msrc = S*(Msrc1 + Msrc2);
+ M = Mstr + Msrc; % number of rows in P
+ N = C*S; % number of columns in P
+
+ P = zeros(M,N);
+ P(1:Mstr1,1:S) = rand(Mstr1,S);
+ for s = 1:S
+ P(Mstr1+s,S+s) = rand;
+ P(Mstr1+S+s,2*S+s) = rand;
+ P(Mstr1+2*S+s,2*S+s) = rand;
+ end
+
+ % fill G
+ G = zeros(S,M);
+ Gstr = rand(S,Mstr);
+ Gsrc = zeros(S,Msrc);
+ if 1==1
+ Gsrc = repmat(diag(rand(S,1)),1,Msrc1+Msrc2);
+ else
+ itemp = (Msrc1 + Msrc2)*[1:S]';
+ indmat2 = [ [1 ; 1+itemp(1:end-1)] itemp ];
+ for isrc = 1:S
+ inds = indmat2(isrc,1) : indmat2(isrc,2);
+ %Gsrc(isrc,inds) = -ws(isrc) * grad_src(inds);
+ Gsrc(isrc,inds) = rand(1,length(inds));
+ end
+ end
+ G = [Gstr Gsrc];
+
+ Cm = diag(rand(M,1));
+ Cmi = P'*Cm*P;
+ GG = G*Cm*P;
+
+ d = zeros(S,1);
+ Hnew = GG'*GG + Cmi;
+ dnew = GG'*d;
+ mu = Hnew*dnew;
+ whos d Hnew dnew mu
+
+ figure; nr=3; nc=4; msize=3;
+ subplot(nr,nc,2); spy(G,msize); title(sprintf('G is %i by %i',size(G)));
+ subplot(nr,nc,3); spy(G',msize); title(sprintf('G^T is %i by %i',size(G')));
+ subplot(nr,nc,4); spy(G*G',msize); title(sprintf('G G^T is %i by %i',size(G*G')));
+
+ subplot(nr,nc,5); spy(P',msize); title(sprintf('P^T is %i by %i',size(P')));
+ subplot(nr,nc,6); spy(Cm,msize); title(sprintf('Cm is %i by %i',size(Cm)));
+ subplot(nr,nc,7); spy(P,msize); title(sprintf('P is %i by %i',size(P)));
+ subplot(nr,nc,8); spy(Cmi,msize); title(sprintf('P^T Cm P is %i by %i',size(Cmi)));
+
+ subplot(nr,nc,9); spy(G,msize); title(sprintf('G is %i by %i',size(G)));
+ subplot(nr,nc,10); spy(Cm,msize); title(sprintf('Cm is %i by %i',size(Cm)));
+ subplot(nr,nc,11); spy(P,msize); title(sprintf('P is %i by %i',size(P)));
+ subplot(nr,nc,12); spy(GG,msize); title(sprintf('G Cm P is %i by %i',size(GG)));
+ orient tall, wysiwyg
+
+ break
+end
+
+%---------------------------------------------
+
+if 0==1
+ nk = 100;
+ kvec = 10.^linspace(-4,4,nk);
+
+ figure; nr=2; nc=1;
+ for jj=1:2
+ switch jj
+ case 1, ndata = 5; nparm = 10;
+ case 2, ndata = 10; nparm = 5;
+ end
+ Cm = diag(rand(nparm,1));
+ G = rand(ndata,nparm);
+ d = rand(ndata,1);
+
+ norm_dm = zeros(nk,1);
+ for kk = 1:nk
+ C = Cm * kvec(kk);
+ norm_dm(kk) = norm( C * G' * inv(G*C*G') * d );
+ end
+ subplot(nr,nc,jj);
+ semilogx(kvec, norm_dm, '.');
+ end
+end
+
+%----------------------------------------------
+
+irun0 = input(' Enter irun0 : ');
+iread = input(' Enter 1 to read in new event kernels (0 otherwise) : ');
+hmod = input(' Enter next model number (hmod) : ');
+INV_STRUCT = input(' Enter 1 to invert for STRUCTURE : ');
+INV_SOURCE = input(' Enter 1 to invert for SOURCE : ');
+iwrite = input(' Enter 1 to write out files : ');
+if iwrite==1
+ COMPUTE_KERNELS = input(' Enter 1 to compute the event kernels for this model : ');
+end
+if INV_STRUCT==1
+ ifigure = input(' Enter 1 to plot figures : ');
+else
+ ifigure = 0;
+end
+
+%iwrite = 0;
+%ifigure = 1;
+%hmod = 1; % 1, 2, 3, ...
+%irun0 = 7150; % 6080, 6180, 7000, 7050
+
+NLOCAL = 40000; % assume 1 source parameter only for now (beta)
+NPARM_SOURCE = 3;
+NPARM_STRUCT = 1;
+
+nsrc = 25;
+nrec = 132;
+nmeas = nsrc * nrec;
+
+nmod_str = NLOCAL;
+nmod_src = nsrc * NPARM_SOURCE;
+nmod = nmod_str + nmod_src;
+
+%SIGMA_DT = 0.20;
+%sval_cut = SIGMA_DT * sqrt(nmeas);
+sval_cut = 5;
+
+%----------------
+
+stm = sprintf(stfmt,hmod);
+
+% directories
+dir0 = [dir_run 'run_' sprintf(stfm,irun0) '/'];
+if ~exist(dir0), error([dir0 ' does not exist']); end
+dir0r = [dir0 'READ_IN/'];
+if ~exist(dir0r), mkdir(dir0r); end
+dir2 = [dir0r 'model_m' stm '/'];
+if ~exist(dir2), mkdir(dir2); end
+dir2lab = ['run-' sprintf(stfm,irun0) ', READ-IN -- toward model m' stm ];
+
+if hmod == 1
+ dir1 = dir0;
+else
+ dir1 = [dir0 'READ_IN/model_m' sprintf(stfmt,hmod-1) '/'];
+end
+
+% indexing for measurements
+itemp = [nrec:nrec:nmeas]';
+indmat1 = [ [1 ; 1+itemp(1:end-1)] itemp ];
+itemp = NPARM_SOURCE*[1:25]';
+indmat2 = [ [1 ; 1+itemp(1:end-1)] itemp ];
+
+% indexing for model vector
+m_inds = load([dir1 'm_inds.dat']);
+inds_B = [m_inds(1,1) : m_inds(1,2)];
+inds_ts = [m_inds(2,1) : m_inds(2,2)];
+inds_xs = [m_inds(3,1) : m_inds(3,2)];
+inds_ys = [m_inds(4,1) : m_inds(4,2)];
+inds_src = [m_inds(2,1) : m_inds(4,2)];
+
+% load the source parameters
+src_syn = load([dir1 'src_syn.dat']);
+slon = src_syn(:,1);
+slat = src_syn(:,2);
+src_ts = src_syn(:,3);
+src_xs = src_syn(:,4);
+src_ys = src_syn(:,5);
+
+% load the source parameters
+src_dat = load([dir1 'src_dat.dat']);
+src_ts_dat = src_dat(:,3);
+src_xs_dat = src_dat(:,4);
+src_ys_dat = src_dat(:,5);
+
+% load the receivers
+rec_lonlat = load([dir1 'recs_lonlat.dat']);
+rlon = rec_lonlat(:,1);
+rlat = rec_lonlat(:,2);
+
+% load the data covariance matrix
+cov_data = load([dir1 'cov_data_diagonal.dat']);
+
+% load all the measurements and partition into matrix
+meas_all = load([dir1 'measure_vec.dat']);
+dT_all = meas_all(:,1); % WITH ERRORS ADDED
+dT_all_norm = dT_all.^2 ./ cov_data;
+
+% load the covariance matrix
+% --> cov_imetric(NLOCAL+1 : nmod_str) = ( sigma_beta )**2 / da_local_vec(:) * AREA
+%cov_model = load('/net/denali/scratch1/carltape/OUTPUT_2/run_9100/cov_imetric_diagonal.dat');
+cov_model_all = load([dir1 'cov_model_diagonal.dat']);
+cov_model = cov_model_all(:,1);
+cov_beta = cov_model(inds_B)';
+cov_src = cov_model(inds_src)';
+clear cov_model_all
+
+% load the reference values
+% alpha0, beta0, rho0, bulk0, kappa0, mu0
+vall = load([dir1 'reference_values.dat']);
+alpha0 = vall(1);
+beta0 = vall(2);
+rho0 = vall(3);
+bulk0 = vall(4);
+kappa0 = vall(5);
+mu0 = vall(6);
+
+% load the model vector
+mtemp = load([dir1 'cg_model_vectors.dat']);
+m_all = mtemp(:,1);
+m_src = mtemp(inds_src)';
+
+% load the structure files
+mtemp = load([dir1 'structure_syn.dat']);
+m_str_lon = mtemp(:,1);
+m_str_lat = mtemp(:,2);
+m_str_kappa = mtemp(:,3);
+m_str_mu = mtemp(:,4);
+m_str_rho = mtemp(:,5);
+m_str_B = mtemp(:,6);
+
+% load the structure files
+mtemp = load([dir1 'structure_dat.dat']);
+m_dat_str_lon = mtemp(:,1);
+m_dat_str_lat = mtemp(:,2);
+m_dat_str_kappa = mtemp(:,3);
+m_dat_str_mu = mtemp(:,4);
+m_dat_str_rho = mtemp(:,5);
+m_dat_str_B = mtemp(:,6);
+
+% load source files (synthetics and data)
+[m_src_lon,m_src_lat,m_src_ts,m_src_xs,m_src_ys,m_src_ts_d,m_src_xs_d,m_src_ys_d] ...
+ = textread([dir1 'src_syn.dat'],'%f%f%f%f%f%f%f%f');
+[junk1,junk2,m_src_ts_dat,m_src_xs_dat,m_src_ys_dat,junk3,junk4,junk5] ...
+ = textread([dir1 'src_dat.dat'],'%f%f%f%f%f%f%f%f');
+
+% load the gradient
+gtemp = load([dir1 'gradient_vec.dat']);
+gradient = gtemp(:,1);
+grad_beta = gradient(inds_B)';
+grad_src = gradient(inds_src)';
+disp(' check norms of structure and source GRADIENTS :');
+norm_grad_str = dot( grad_beta, cov_beta.*grad_beta )
+norm_grad_src = dot( grad_src, cov_src.*grad_src )
+disp(' gradient balance for the CG inversion :');
+norm_grad_src / norm_grad_str
+
+% load the source gradient and partition into matrix
+%grad_src = load([dir1 'source_gradient.dat']);
+% grad_src_mat = zeros(nsrc,NPARM_SOURCE);
+% for isrc = 1:nsrc
+% grad_src_mat(isrc,:) = grad_src(indmat2(isrc,1) : indmat2(isrc,2));
+% end
+
+% check the misfit function value
+chi = load([dir1 'chi.dat']);
+data_norm = load([dir1 'data_norm.dat']);
+model_norm = load([dir1 'model_norm.dat']);
+
+disp(' '); disp(' CHECKING VARIOUS NORMS:');
+disp(' model norm:');
+model_norm, sum( m_all.^2 ./ cov_model )
+disp(' data norm:');
+data_norm, sum(dT_all_norm)
+disp(' misfit function value:');
+chi, 0.5*( sum( dT_all_norm ) + sum( m_all.^2 ./ cov_model ))
+
+%====================================================
+
+% partition DATA vector of traveltime measurements into a matrix,
+% since in this case we know that there are the same number of picks for each event
+dT_mat = zeros(nsrc,nrec);
+dT_norm_mat = zeros(nsrc,nrec);
+for isrc = 1:nsrc
+ inds = [indmat1(isrc,1) : indmat1(isrc,2)];
+ dT_mat(isrc,:) = dT_all(inds);
+ dT_norm_mat(isrc,:) = dT_all_norm(inds);
+end
+
+% compute the new data vector
+dnorm = sum( dT_norm_mat, 2);
+if any(dnorm==0), error(' For at least one source, there is perfect fit.'); end
+
+% compute the weights (SIGN OR NOT?)
+%ws = zeros(nsrc,1);
+%ws = 1 ./ sqrt( sum( dT_norm_mat, 2) );
+%if sum(isinf(ws)) > 0, error(' For at least one source, there is perfect fit.'); end
+% compute the new data vector
+%dnorm = 1 ./ ws;
+
+% check
+sum(sum(dT_norm_mat)), sum(dT_all_norm), sum( dnorm )
+
+if INV_STRUCT == 1
+
+ % load the jacobian for constructing the "event gradient" from the event kernel
+ lmesh_all = load([dir1 'local_mesh.dat']);
+ Ai = lmesh_all(:,9)';
+
+ % load the event kernels
+ %iread = 1;
+ efile = 'wave2d_kernel';
+ if iread==1
+ % THE SPECIFICATION FOR SMOOTHED KERNELS IS DONE IN WAVE2D.F90
+ % EITHER WAY, YOU LOAD THE FILES kernel_basis_smooth, WHICH MAY OR
+ % MAY NOT BE SMOOTHED.
+ ismooth = input(' Enter 1 to read smoothed event kernels (0 otherwise) : ');
+ disp('reading in the event kernels...');
+ Kall = zeros(nsrc,NLOCAL);
+ for isrc = 1:nsrc
+ isrc
+ dirK = [dir1 'event_' sprintf(stfmt,isrc) '/'];
+ if ismooth == 1
+ kernel = load([dirK 'kernel_basis_smooth']); Kbeta = kernel(:,3)';
+ else
+ kernel = load([dirK 'kernel_basis']); Kbeta = kernel(:,7)';
+ end
+ lon = kernel(:,1);
+ lat = kernel(:,2);
+ Kall(isrc,:) = Kbeta;
+ end
+ save(efile,'Kall','lon','lat');
+ %break
+ else
+ load(efile);
+ end
+
+ % construct G (plot event kernels too)
+ %nsrc = 5;
+ Gstr = zeros(nsrc,NLOCAL);
+ for isrc = 1:nsrc
+ Kbeta = Kall(isrc,:);
+ %Gstr(isrc,:) = -ws(isrc) * Kbeta .* Ai; % SIGN OR NOT?
+ Gstr(isrc,:) = -Kbeta .* Ai;
+
+ if 0==1
+ [X,Y,Z] = griddataXB(lon,lat,Kbeta,100,'nearest');
+ figure; cmax = 1e-7; hold on;
+ pcolor(X,Y,Z); shading interp;
+ caxis([-1 1]*cmax); colormap(seis);
+ plot(rlon,rlat,'k.','markersize',16)
+ for irec = 1:nrec
+ text(rlon(irec),rlat(irec),sprintf('%6.1f',dT_mat(isrc,irec)),'fontsize',12);
+ end
+ plot(slon(isrc),slat(isrc),'p','markersize',24,...
+ 'markerfacecolor','w','markeredgecolor','k','linewidth',2);
+ end
+ end
+
+ % Hessian for structure parameters (from event kernels)
+ disp('constructing the Hessian...');
+ Hstr = zeros(nsrc,nsrc);
+ for ii = 1:nsrc
+ for jj = 1:nsrc
+ Hstr(ii,jj) = dot(Gstr(ii,:), cov_beta.*Gstr(jj,:));
+ end
+ end
+
+else
+ Hstr = zeros(nsrc,nsrc);
+end
+
+% Hessian and projected gradient for source parameters
+Hsrc = zeros(nsrc,nsrc);
+%Hsrc_vec = zeros(nsrc,1);
+if INV_SOURCE == 1
+
+ Gsrc = zeros(nsrc,nmod_src);
+ Gsrc = [diag(gradient(inds_ts)) diag(gradient(inds_xs)) diag(gradient(inds_ys))];
+ %for isrc = 1:nsrc
+ % inds = indmat2(isrc,1) : indmat2(isrc,2);
+ % %Gsrc(isrc,inds) = -ws(isrc) * grad_src(inds);
+ % Gsrc(isrc,inds) = grad_src(inds);
+ %end
+ Hsrc = Gsrc * diag(cov_src) * transpose(Gsrc);
+
+ %for isrc = 1:nsrc
+ % inds = indmat2(isrc,1) : indmat2(isrc,2);
+ % Hsrc_vec(isrc) = ws(isrc)^2 * dot(grad_src(inds), cov_src(inds).*grad_src(inds) );
+ %end
+ %Hsrc = diag(Hsrc_vec);
+end
+
+% overall Hessian
+H = Hstr + Hsrc + eye(nsrc,nsrc);
+
+% construct projection matrix (and assign gradient)
+if INV_STRUCT == 1
+ G = Gstr;
+ Pstr = Gstr';
+ P = Pstr;
+end
+if INV_SOURCE == 1
+ G = Gsrc;
+ Psrc = zeros(nmod_src,nsrc*2); % 2: origin time and location
+ Psrc(1:nsrc,1:nsrc) = Gsrc(1:nsrc,1:nsrc);
+ Psrc(nsrc+1:2*nsrc,nsrc+1:2*nsrc) = Gsrc(1:nsrc,nsrc+1:2*nsrc);
+ Psrc(2*nsrc+1:3*nsrc,nsrc+1:2*nsrc) = Gsrc(1:nsrc,2*nsrc+1:3*nsrc);
+ P = Psrc;
+end
+if and(INV_STRUCT == 1, INV_SOURCE == 1)
+ G = [Gstr Gsrc];
+ P = zeros(nmod,3*nsrc);
+ P(1:nmod_str,1:nsrc) = Pstr;
+ P(nmod_str+1:nmod,nsrc+1:3*nsrc) = Psrc;
+end
+
+% construct matrices for joint inversions
+if inew == 1
+ GG = zeros(nsrc,NCLASS*nsrc);
+ CmP = P; for ii=1:nmod, CmP(ii,:) = P(ii,:) * cov_model(nmod_str+ii); end;
+ GG = G * CmP;
+ Cmi = P' * CmP;
+
+ figure; nr=3; nc=1;
+ subplot(nr,nc,1); spy(P(nmod_str-100:nmod_str,:),3); title('bottom 100 rows of P');
+ subplot(nr,nc,2); spy(GG,3); title('GG = G Cm P');
+ subplot(nr,nc,3); spy(Cmi,3); title('Cmi = P^T Cm P');
+ orient tall, wysiwyg
+end
+
+disp(' Hessian diagonal contributions from structure and source:');
+disp(' structure source total source/structure');
+pmat = [diag(Hstr) diag(Hsrc) diag(H) diag(Hsrc)./diag(Hstr) ];
+for ii=1:nsrc
+ disp(sprintf('%10.2e %10.2e %10.2e %8.2f',pmat(ii,:)))
+end
+%disp([diag(Hstr) diag(Hsrc) diag(H) diag(Hsrc)./diag(Hstr) ]);
+disp(' gradient balance for the Hessian (subspace) inversion (mean of last column) :');
+disp(mean( diag(Hsrc)./diag(Hstr) ))
+
+disp(' properties of Hessian (min, median, mean(abs), max, std):');
+stH = sprintf('min %.2e, median %.2e, mean(abs) %.2e, max %.2e, std %.2e',...
+ min(H(:)), median(H(:)), mean(abs(H(:))), max(H(:)), std(H(:)));
+disp(stH);
+
+if ~and(INV_STRUCT==1, INV_SOURCE==1)
+ figure;
+ %pcolor(H); shading flat; xlabel('Row index'); ylabel('Column index');
+ imagesc(H); ylabel('Row index'); xlabel('Column index');
+ title({'Hessian (symmetric matrix)',stH});
+ map = colormap('gray'); colormap(flipud(map));
+ colorbar; axis equal; axis tight;
+else
+ figure; nr=3; nc=1;
+ subplot(nr,nc,1);
+ %pcolor(H); shading flat; xlabel('Row index'); ylabel('Column index');
+ imagesc(H); ylabel('Row index'); xlabel('Column index');
+ title({'Hessian (symmetric matrix)',stH});
+ map = colormap('gray'); colormap(flipud(map));
+ colorbar; axis equal; axis tight;
+
+ subplot(nr,nc,2);
+ %pcolor(Hstr); shading flat; xlabel('Row index'); ylabel('Column index');
+ imagesc(Hstr); ylabel('Row index'); xlabel('Column index');
+ title('Hessian for structure (symmetric matrix)');
+ map = colormap('gray'); colormap(flipud(map));
+ colorbar; axis equal; axis tight;
+
+ subplot(nr,nc,3);
+ %pcolor(Hsrc); shading flat; xlabel('Row index'); ylabel('Column index');
+ imagesc(Hsrc); ylabel('Row index'); xlabel('Column index');
+ title('Hessian for source (diagonal matrix)');
+ map = colormap('gray'); colormap(flipud(map));
+ colorbar; axis equal; axis tight;
+ orient tall, wysiwyg
+end
+
+if INV_SOURCE == 1
+ figure; nr=2; nc=1;
+ subplot(nr,nc,1); spy(Gsrc); title('Gsrc');
+ subplot(nr,nc,2); spy(Gsrc*Gsrc'); title('Gsrc * Gsrc^T');
+end
+
+% set of pmax TSVD values to try
+iyes = 0;
+while iyes == 0
+ iyes = input(' Enter 1 if this balance looks okay : ');
+end
+
+% check the balance of the gradients -- SAME AS CHECKING THE HESSIAN DIAGONAL
+if 0 == 1
+ cov_beta0 = cov_beta;
+ cov_src0 = cov_src;
+
+ kvec = linspace(0.2,6,100);
+ for k = 1:length(kvec)
+ fac = kvec(k);
+ cov_beta = cov_beta0 * fac;
+
+ for ii = 1:nsrc
+ norm_grad_str(ii) = sum( Gstr(ii,:).^2 .* cov_beta );
+ norm_grad_src(ii) = sum( Gsrc(ii,:).^2 .* cov_src );
+ norm_grad_tot(ii) = norm_grad_str(ii) + norm_grad_src(ii);
+ end
+ %disp(' Norms of the gradients and constituent parts:');
+ %disp(' structure source total source/structure');
+ %disp([norm_grad_str' norm_grad_src' norm_grad_tot' norm_grad_src'./norm_grad_str']);
+ %disp(' mean of the last column :');
+ disp([fac mean( norm_grad_src'./norm_grad_str' )]);
+ end
+
+end
+
+%------------------------------------------------------------------------
+
+% truncated singular value decomposition
+if TSVD == 1
+
+ % analyze the singular values of H
+ [U,S,V] = svd(H);
+ s = diag(S);
+
+ if 0==1
+ % analyze the singular values of H
+ % (See also tsvd.m)
+ [U,S,V] = svd(H);
+ s = diag(S);
+ p = sum( s > sval_cut ); % KEY: singular value truncation index
+ sp = s(1:p);
+ Sp = diag(sp);
+ Up = U(:,1:p);
+ Vp = V(:,1:p);
+ whos U S V
+ whos Up Sp Vp
+ Hp = Up*Sp*Vp';
+ Hinv = Vp*inv(Sp)*Up';
+ mu = Hinv * dnorm;
+
+ if 0==1
+ Ncheck = zeros(nsrc,1);
+ for p = 1:nsrc
+ sp = s(1:p);
+ Sp = diag(sp);
+ Up = U(:,1:p);
+ Vp = V(:,1:p);
+ Hp = Up*Sp*Vp';
+
+ Hinv = Vp*inv(Sp)*Up';
+ mu = Hinv * dnorm;
+ dm_str = transpose(Gstr) * mu .* cov_beta'; % order?
+ m_str_B_new = m_str_B + dm_str;
+ Ncheck(p) = sum( (dnorm - Gstr*dm_str).^2 ); % matches rss from tsvd.m
+ end
+ end
+
+ % check the norms and the norms of the inverse
+ norm(H), norm( U*S*V' ), norm(Hp)
+ norm(inv(H)), norm( Vp*inv(Sp)*Up' ), norm(inv(Hp))
+
+ figure; hold on; plot(H(:),'b.'); plot(Hp(:),'ro');
+ end
+
+ %H = H / 0.5; % 9550
+
+ pinds = [1:nsrc]';
+ [mu_all,rss,f_r_ss] = tsvd(dnorm,H,pinds); % KEY: TSVD
+
+ % norms of mu vectors
+ mu_norm = zeros(nsrc,1);
+ for ip = 1:nsrc
+ mu_norm(ip) = norm(mu_all(:,ip));
+ end
+
+ figure; nr=2; nc=2;
+ xlab1 = 'p, singular value index';
+ xlab2 = 'p, singular value truncation index';
+ ylab1 = 'singular value';
+ ylab2 = 'misfit : dot[ d - H*mu(p), d - H*mu(p) ]';
+
+ subplot(nr,nc,1); plot(pinds,s,'.','markersize',20);
+ grid on; xlabel(xlab1); ylabel(ylab1); title(dir2lab);
+ subplot(nr,nc,2); semilogy(pinds,s,'.','markersize',20);
+ grid on; xlabel(xlab1); ylabel(ylab1);
+ subplot(nr,nc,3); plot(pinds,rss,'.','markersize',20);
+ grid on; xlabel(xlab2); ylabel(ylab2);
+ subplot(nr,nc,4); semilogy(pinds,rss,'.','markersize',20);
+ grid on; xlabel(xlab2); ylabel(ylab2);
+ orient tall, wysiwyg
+
+ figure; nr=2; nc=2;
+ ylab3 = 'norm of mu vector';
+
+ subplot(nr,nc,1); semilogy(pinds,s,'.','markersize',20);
+ grid on; xlabel(xlab1); ylabel(ylab1);
+ subplot(nr,nc,2); semilogy(pinds,rss,'.','markersize',20);
+ grid on; xlabel(xlab2); ylabel(ylab2);
+ subplot(nr,nc,3); plot(pinds,mu_all,'.');
+ grid on; xlabel('source index'); ylabel('elements of mu vectors');
+ subplot(nr,nc,4); semilogy(pinds,mu_norm,'.','markersize',20);
+ grid on; xlabel(xlab2); ylabel(ylab3);
+ orient tall, wysiwyg
+else
+ Hinv = inv(H);
+ mu = Hinv * dnorm;
+end
+
+%------------------------------------------------------------------------
+
+% set of pmax TSVD values to try (if TSVD = 1)
+if TSVD == 1
+ iyes = 0;
+ while iyes == 0
+ disp(' Enter truncation values for TSVD:');
+ pmin = input(' Enter pmin (1): ');
+ pmax = input([' Enter pmax (' num2str(nsrc) '): ']);
+ pinc = input(' Enter pinc (1): ');
+ pmax_vec = [pmin : pinc : pmax]
+ iyes = input(' Enter 1 if this is what you want (0 otherwise) : ');
+ end
+else
+ pmax_vec = 1;
+end
+nump = length(pmax_vec);
+
+source_error_norm_mat = zeros(nump,5);
+source_error_norm_mat(:,1) = pmax_vec';
+
+if inew == 1
+ Hnew = GG'*GG + Cmi;
+ dnew = GG'*dnorm;
+end
+
+% KEY LOOP OVER DIFFERENT MODELS (EACH OBTAINED FROM THE SAME EVENT KERNELS)
+for ip = 1:nump
+ stip = sprintf(stfmt,ip);
+
+ % OPTIONS FOR INVERTING HESSIAN:
+ % (1) truncated singular value decomposition
+ % (2) cross-validation
+ if TSVD == 1
+ pmax = pmax_vec(ip);
+ disp(sprintf('%i out of %i : pmax = %i',ip,nump,pmax));
+
+ %[mu_all,rss,f_r_ss] = tsvd(dnorm,H,pinds); % KEY: TSVD
+ mu = mu_all(:,pmax); % KEY vector
+
+ stplab = sprintf('pmax = %i',pmax);
+ if 0 == 1
+ figure; nr=2; nc=2;
+ subplot(nr,nc,1);
+ plot(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab1); ylabel(ylab1); title({dir2lab,stplab});
+ subplot(nr,nc,2);
+ semilogy(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab1); ylabel(ylab1); title(stplab);
+ subplot(nr,nc,3);
+ plot(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab2); ylabel(ylab2); title(stplab);
+ subplot(nr,nc,4);
+ semilogy(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab2); ylabel(ylab2); title(stplab);
+ orient tall, wysiwyg
+ end
+
+ else
+ if inew == 1
+ midlampwr = log10(trace(Hnew))/2;
+ else
+ midlampwr = log10(trace(H))/2;
+ end
+
+ % regularization choices
+ %minlampwr = -3; maxlampwr = 3;
+ minlampwr = midlampwr - 2; maxlampwr = midlampwr + 2;
+ numlam = 100;
+ lampwr = linspace(minlampwr,maxlampwr,numlam);
+ lamvec = 10.^lampwr;
+
+ if inew == 1
+ [f_p, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dnew,Hnew,lamvec);
+ else
+ [f_p, rss, mss, Gvec, Fvec, dof, kap, iL, iGCV, iOCV] = ridge_carl(dnorm,H,lamvec);
+ end
+
+ ipick = input(' Enter 0 for GCV, 1 for OCV, 2 for L-curve : ');
+ switch ipick
+ case 0, lam = lamvec(iGCV);
+ case 1, lam = lamvec(iOCV);
+ case 2, lam = lamvec(iL);
+ end
+
+ % KEY vector
+ if inew == 1
+ mu = inv(Hnew'*Hnew + lam^2*eye(3*nsrc,3*nsrc))*Hnew'*dnew;
+ else
+ mu = inv(H'*H + lam^2*eye(nsrc,nsrc))*H'*dnorm;
+ end
+
+ stplab = sprintf('lambda = %.3f',lam);
+
+ %Hinv = inv(H);
+ %mu = Hinv * dnorm;
+ end
+
+ % testing H + I
+ %Hinv = inv(H);
+ %mu = Hinv * dnorm;
+
+ % KEY: solve for the STRUCTURE model update
+ dm_str = zeros(nmod_str,1);
+ if INV_STRUCT == 1
+ if inew == 1
+ dm_str = cov_beta' .* (Pstr * mu(1:nsrc));
+ else
+ dm_str = cov_beta' .* (transpose(Gstr) * mu);
+ end
+ end
+ %disp(' norm of structure update:');
+ %sum( dm_str .* dm_str ./ cov_beta' )
+
+ % KEY: solve for the SOURCE model update (ts1, ts2, ..., xs1, xs2, ..., ys1, ys2, ...)
+ dm_src = zeros(nmod_src,1);
+ if INV_SOURCE == 1
+ %mtemp = repmat(mu',3,1); mu_expand = mtemp(:);
+ %wtemp = repmat(ws',3,1); ws_expand = wtemp(:);
+ %dm_src = -cov_src' .* grad_src' .* ws_expand .* mu_expand; % SIGN OR NOT?
+
+ if inew == 1
+ dm_src = cov_src' .* (Psrc * mu(nsrc+1:end));
+ else
+ dm_src = cov_src' .* (transpose(Gsrc) * mu);
+ end
+ end
+ %disp(' norm of source update:');
+ %sum( dm_src .* dm_src ./ cov_src' )
+
+ %-------------------
+
+ % source parameter updates
+ if INV_SOURCE == 1
+
+ %for ii = 1:nsrc
+ % i0 = (ii-1)*3;
+ % m_src_xs_new(ii) = m_src_xs(ii) + dm_src(i0+1);
+ % m_src_ys_new(ii) = m_src_ys(ii) + dm_src(i0+2);
+ % m_src_ts_new(ii) = m_src_ts(ii) + dm_src(i0+3);
+ %end
+
+ m_src_ts_new = m_src_ts + dm_src(inds_ts - nmod_str);
+ m_src_xs_new = m_src_xs + dm_src(inds_xs - nmod_str);
+ m_src_ys_new = m_src_ys + dm_src(inds_ys - nmod_str);
+
+ m_src_ts_d_new = m_src_ts_new - m_src_ts_dat;
+ m_src_xs_d_new = m_src_xs_new - m_src_xs_dat;
+ m_src_ys_d_new = m_src_ys_new - m_src_ys_dat;
+
+% idisplay = 0; % display information on source parameters
+% if idisplay == 1
+% disp(' '); disp('Source parameter updates:');
+% for ii = 1:nsrc
+% i0 = (ii-1)*3;
+% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
+% ii,dm_src(i0+1),dm_src(i0+2),dm_src(i0+3) ));
+% end
+% disp(' '); disp('Current parameter errors:');
+% for ii = 1:nsrc
+% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
+% ii, m_src_xs_d(ii), m_src_ys_d(ii),m_src_ts_d(ii)));
+% end
+% disp(' '); disp('New source parameter errors:');
+% for ii = 1:nsrc
+% disp(sprintf(' Event %2i : (xs = %7.1f m, ys = %7.1f m, ts = %5.2f s )',...
+% ii, m_src_xs_d_new(ii), m_src_ys_d_new(ii),m_src_ts_d_new(ii)));
+% end
+% end
+ else
+ m_src_ts_d_new = m_src_ts_d;
+ m_src_xs_d_new = m_src_xs_d;
+ m_src_ys_d_new = m_src_ys_d;
+
+ m_src_ts_new = m_src_ts;
+ m_src_xs_new = m_src_xs;
+ m_src_ys_new = m_src_ys;
+ end
+
+ % compute norms of errors in new source parameters
+ %norm_ts = sum(m_src_ts_d_new.^2 ./ cov_src(3:3:nsrc*3)');
+ %norm_xs = sum(m_src_xs_d_new.^2 ./ cov_src(1:3:nsrc*3)');
+ %norm_ys = sum(m_src_ys_d_new.^2 ./ cov_src(2:3:nsrc*3)');
+ norm_ts = sum(m_src_ts_d_new.^2 ./ cov_model(inds_ts));
+ norm_xs = sum(m_src_xs_d_new.^2 ./ cov_model(inds_xs));
+ norm_ys = sum(m_src_ys_d_new.^2 ./ cov_model(inds_ys));
+ source_error_norm_mat(ip,[2:5]) = [norm_xs norm_ys norm_ts sum([norm_xs norm_ys norm_ts])];
+
+ % structure parameter updates
+ if INV_STRUCT == 1
+ m_str_B_new = m_str_B + dm_str; % updated B
+ else
+ m_str_B_new = m_str_B;
+ end
+
+ % convert to beta, c, kappa, mu, rho
+ m_str_beta_new = beta0 * exp( m_str_B_new );
+ m_str_rho_new = m_str_rho;
+ m_str_kappa_new = m_str_kappa;
+ m_str_mu_new = m_str_rho_new .* m_str_beta_new.^2;
+
+ %disp(' norm of new structure model:');
+ %sum( m_str_B_new .* m_str_B_new ./ cov_beta' )
+
+ % plot structure model update and new model
+ if and(INV_STRUCT == 1, ifigure == 1)
+ tlabs = {{dir2lab,'data'},'m00',['dm (' stplab ')'],['m01 (' stplab ')']};
+ cmax = 0.1;
+ figure; nr=3; nc=2;
+ for kk = 1:4
+ switch kk
+ case 1, mplot = m_dat_str_B;
+ case 2, mplot = m_str_B;
+ case 3, mplot = dm_str;
+ case 4, mplot = m_str_B_new;
+ end
+ [X,Y,Z] = griddataXB(lon,lat,mplot,100,'nearest');
+
+ subplot(nr,nc,kk); hold on;
+ pcolor(X,Y,Z); shading interp;
+ caxis([-1 1]*cmax); colormap(seis); axis equal, axis tight
+ plot(rlon,rlat,'k.','markersize',16);
+ plot(slon,slat,'p','markersize',18,'markeredgecolor','k','linewidth',2);
+ title(tlabs{kk});
+ end
+
+ % TSVD plots
+ if TSVD == 1
+ subplot(nr,nc,5);
+ semilogy(pinds,s,'.',pinds(pmax),s(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab1); ylabel(ylab1); title(stplab);
+ subplot(nr,nc,6);
+ semilogy(pinds,rss,'.',pinds(pmax),rss(pmax),'pr','markersize',20,'linewidth',2);
+ grid on; xlabel(xlab2); ylabel(ylab2); title(stplab);
+ end
+
+ orient tall, wysiwyg
+ end
+
+ % write EVERY pmax updated model to file
+ % NOTE: if you only want one model, then it will have index 001
+ if iwrite == 1
+
+ % KEY: the directories differ, depending on whether you are writing
+ % out a single model or a set of models
+ if COMPUTE_KERNELS
+ dir3 = dir2;
+ else
+ % make directory
+ pdir = ['run_p' stip];
+ dir3 = [dir2 pdir '/'];
+ mkdir(dir3)
+ end
+
+ % save pertinent Matlab variables
+ save([dir3 'wave2d_subspace_matlab_m' stm],...
+ 'dnorm','H','Hsrc','Hstr',...
+ 'mu','INV_SOURCE','INV_STRUCT');
+
+ % write structure model
+ wave2d_write_str([dir3 'structure_syn_m' stm '.dat'],m_str_lon,m_str_lat,...
+ m_str_kappa_new,m_str_mu_new,m_str_rho_new,m_str_B_new);
+
+ % write source model
+ wave2d_write_src([dir3 'src_syn_m' stm '.dat'],m_src_lon,m_src_lat,...
+ m_src_ts_new,m_src_xs_new,m_src_ys_new,m_src_ts_d_new,m_src_xs_d_new,m_src_ys_d_new);
+
+ % write out pmax
+ if TSVD == 1
+ fid = fopen([dir3 'pmax_m' stm '.dat'],'w');
+ fprintf(fid,'%i\n',pmax);
+ fclose(fid);
+ else
+ fid = fopen([dir3 'lambda_m' stm '.dat'],'w');
+ fprintf(fid,'%16.8e\n',lam);
+ fclose(fid);
+ end
+
+ % write out the balance of the gradient norms
+ fid = fopen([dir3 'norm_gradient_m' stm '.dat'],'w');
+ fprintf(fid,'Balance of the gradients for each event\n');
+ fprintf(fid,'%16s%16s%16s%16s\n','STR','SRC','TOTAL','SRC/STR');
+ for ii = 1:nsrc
+ fprintf(fid,'%16.6e%16.6e%16.6e%16.4f\n',...
+ Hstr(ii,ii), Hsrc(ii,ii), H(ii,ii), Hsrc(ii,ii)/Hstr(ii,ii) );
+ end
+ fprintf(fid,'%48s%16.4f\n','MEAN -->',mean( diag(Hsrc)./diag(Hstr)) );
+ fclose(fid);
+
+ end
+
+end % LOOP OVER ip
+
+% norm in intial source errors
+%norm_xs = sum(m_src_xs_d.^2 ./ cov_src(1:3:nsrc*3)');
+%norm_ys = sum(m_src_ys_d.^2 ./ cov_src(2:3:nsrc*3)');
+%norm_ts = sum(m_src_ts_d.^2 ./ cov_src(3:3:nsrc*3)');
+norm_ts = sum(m_src_ts_d.^2 ./ cov_model(inds_ts));
+norm_xs = sum(m_src_xs_d.^2 ./ cov_model(inds_xs));
+norm_ys = sum(m_src_ys_d.^2 ./ cov_model(inds_ys));
+source_error_norm_old = [0 norm_xs norm_ys norm_ts sum([norm_xs norm_ys norm_ts])];
+
+disp(' ');
+disp(' NORMS of the errors in the old source vectors (xs, ys, ts) :');
+disp(source_error_norm_old);
+disp(' NORMS of the errors in the new source vectors (xs, ys, ts) :');
+disp(' pmax xs ys ts total');
+disp(source_error_norm_mat);
+
+% save pertinent Matlab variables
+if iwrite == 1
+ if COMPUTE_KERNELS
+ ofile = [dir2 'wave2d_subspace_matlab_pmax'];
+ else
+ ofile = [dir2 'wave2d_subspace_matlab_all'];
+ end
+
+ if TSVD == 0
+ save(ofile,'dnorm','lamvec','lam',...
+ 'f_p','rss','mss','Gvec','Fvec','dof','kap','iL','iGCV','iOCV',...
+ 'source_error_norm_mat','source_error_norm_old',...
+ 'INV_SOURCE','INV_STRUCT');
+ else
+ save(ofile,'dnorm','U','S','V','pinds','mu_all','rss','f_r_ss',...
+ 'source_error_norm_mat','source_error_norm_old',...
+ 'INV_SOURCE','INV_STRUCT');
+ end
+end
+
+%------------------------------------------------
+% extra code for plotting misfit values
+
+if 0==1
+ clear
+
+ run0 = 6550; close all
+ for h = 1:4
+
+ strun0 = num2str(run0);
+ stm = sprintf(stfmt,h);
+ dir_run = '/data1/cig/seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate_OUTPUT/';
+ idir = [dir_run 'run_' strun0 '/READ_IN/model_m' stm '/'];
+ load([idir 'wave2d_subspace_matlab_all']);
+
+ clear data_norm model_norm chi_total pmax_vec
+ for ii = 1:25
+ stp = sprintf(stfmt,ii);
+ dir1 = [ idir 'run_p' stp '/'];
+ chi_file = [dir1 'data_norm.dat'];
+ if exist(chi_file)
+ data_norm(ii) = load(chi_file);
+ model_norm(ii) = load([dir1 'model_norm.dat']);
+ chi_total(ii) = load([dir1 'chi.dat']);
+ %chi_total(ii) = load([dir1 'summed_chi_all.dat']);
+ pmax_vec(ii) = load([dir1 'pmax_m' stm '.dat']);
+ end
+ end
+
+ %disp(' '); disp(' pmax 2*S(m(pmax)) S-data S-model');
+ %disp([pinds 2*chi_total' data_norm' model_norm']);
+
+ % semilogy plots or not?
+ figure; nr=2; nc=2;
+ xlab1 = 'p, singular value index';
+ xlab2 = 'p, singular value truncation index';
+ ylab1 = 'singular value';
+ ylab2 = 'misfit : dot[ d - G*dm(p), d - G*dm(p) ]';
+
+ subplot(nr,nc,1); semilogy(pinds, diag(S),'.','markersize',22); grid on;
+ xlabel(xlab1); ylabel(ylab1);
+ subplot(nr,nc,3); semilogy(pinds, rss,'.','markersize',22); grid on;
+ xlabel(xlab2); ylabel(ylab2);
+
+ subplot(nr,nc,2);
+ plot( pmax_vec,2*chi_total,'r.',pmax_vec,data_norm,'b.','markersize',22);
+ grid on; legend('2 S(m(pmax))','chi-data-norm');
+ xlabel(xlab2); title(['RUN ' strun0 ' - H' stm]);
+ subplot(nr,nc,4);
+ plot( pmax_vec,model_norm,'g.','markersize',22);
+ grid on; legend('chi-model-norm','location','northeast');
+ xlabel(xlab2); title(['RUN ' strun0 ' - H' stm]);
+
+ orient tall, wysiwyg
+ end
+
+end
+
+%======================================================================
Property changes on: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wave2d_subspace.m
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wysiwyg.m
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wysiwyg.m 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/matlab/wysiwyg.m 2010-01-28 17:37:35 UTC (rev 16191)
@@ -1,17 +0,0 @@
-function wysiwyg
-%WYSIWYG -- this function is called with no args and merely
-% changes the size of the figure on the screen to equal
-% the size of the figure that would be printed,
-% according to the papersize attribute. Use this function
-% to give a more accurate picture of what will be
-% printed.
-% Dan(K) Braithwaite, Dept. of Hydrology U.of.A 11/93
-
-unis = get(gcf,'units');
-ppos = get(gcf,'paperposition');
-set(gcf,'units',get(gcf,'paperunits'));
-pos = get(gcf,'position');
-pos(3:4) = ppos(3:4);
-set(gcf,'position',pos);
-set(gcf,'units',unis);
-
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -204,11 +204,11 @@
!--------------------------------------
! stop program if there are certain unallowed paramter combinations
- if(HESSIAN) then
- print *, 'For Hessian runs...'
+ if(READ_IN) then
+ print *, 'For READ_IN runs...'
if(NITERATION /= 0) stop 'NITERATION = 0'
if(ISRC_SPACE /= 6) stop 'ISRC_SPACE = 6'
- hmod = 1 ! iteration number for Hessian-based models
+ hmod = 1 ! iteration number for read-in models
endif
if( IKER/=0 .and. IKER/=1 .and. IKER/=2 ) stop 'IKER must = 0,1,2'
@@ -389,7 +389,7 @@
! if you are not computing kernels, loop over 25 TSVD models to read in
qmax = 25
- if(COMPUTE_KERNELS) qmax = 1
+ if(COMPUTE_KERNELS .or. (READ_IN .and. READ_SINGLE) ) qmax = 1
!============================================
! LOOP 1: different tomographic runs
@@ -399,22 +399,24 @@
! KEY COMMAND: scalelength of checker for velocity models (1,2,3)
Nfac = 3 ! use Nfac=3 for one-source examples
- if(HESSIAN) then
+ if(READ_IN) then
irun0 = IRUNZ
else
irun0 = IRUNZ + 20*(iq-1) ! increment is 20
endif
! name the reference output directory for the optimization run
- if(HESSIAN) then
- ! Hessian-based inversions
- if(COMPUTE_KERNELS) then
- write(out_dir2,'(a,i4.4,a,i2.2,a)') trim(out_dir3)//'run_',irun0,'/HESSIAN/model_m',hmod,'/'
+ if(READ_IN) then
+
+ ! inversion steps done in Matlab
+ if(READ_SINGLE) then
+ write(out_dir2,'(a,i4.4,a,i4.4,a)') trim(out_dir3)//'run_',irun0,'/READ_IN/model_m',hmod,'/'
else
- write(out_dir2,'(a,i4.4,a,i2.2,a,i2.2,a)') trim(out_dir3)//'run_',irun0,'/HESSIAN/model_m',hmod,'/run_p',iq,'/'
+ write(out_dir2,'(a,i4.4,a,i4.4,a,i4.4,a)') trim(out_dir3)//'run_',irun0,'/READ_IN/model_m',hmod,'/run_p',iq,'/'
endif
+
else
- ! gradient-based inversion
+ ! conjugate-gradient-based inversion done in wave2d.f90
write(out_dir2,'(a,i4.4,a)') trim(out_dir3)//'run_',irun0,'/'
command1 = 'mkdir ' // trim(out_dir2)
call system(command1)
@@ -440,8 +442,12 @@
command1 = 'cp ' // 'src/wave2d.f90 ' // trim(out_dir2)
call system(command1)
- call write_parameters(trim(out_dir2)//'parameters1.log')
+ ! parameters for plotting scripts
+ call write_parameters_plot(trim(out_dir2)//'parameters1.log')
+ ! all parameters
+ call write_parameters(trim(out_dir2)//'wave2d_constants.dat')
+
!--------------------------------------
! mesher
@@ -813,16 +819,16 @@
iref = 0
call set_model_property(iref)
- ! if HESSIAN option, then READ in the structure file (local level)
+ ! if READ_IN option, then READ in the structure file (local level)
! NOTE: Assume that the mesh and scaling values are IDENTICAL
! to what was used in the base directory for the CG algorithm.
- if (HESSIAN .and. INV_STRUCT_BETA == 1) then
+ if (READ_IN .and. INV_STRUCT_BETA == 1) then
kappa_syn = 0.0 ; mu_syn = 0.0 ; rho_syn = 0.0
alpha_syn = 0.0 ; beta_syn = 0.0 ; bulk_syn = 0.0
! read in structure model for synthetics
- write(filename2,'(a,i2.2,a)') trim(out_dir2)//'structure_syn_h',hmod,'.dat'
+ write(filename2,'(a,i4.4,a)') trim(out_dir2)//'structure_syn_m',hmod,'.dat'
open(unit=19,file=filename2,status='unknown')
do ispec = 1,NSPEC
do j = 1,NGLLZ
@@ -1061,7 +1067,7 @@
endif
! write events for SYNTHETICS to file
- if( .not. HESSIAN ) then
+ if( .not. READ_IN ) then
open(19,file=trim(out_dir2)//'events_syn_xz.dat',status='unknown')
do ievent = 1,nevent
write(19,'(3f20.10,1i12)') x_eve_syn(ievent), z_eve_syn(ievent), otime_syn(ievent), ievent
@@ -1208,7 +1214,7 @@
endif ! PERT_SOURCE
! write events for data to file
- if( .not. HESSIAN ) then
+ if( .not. READ_IN ) then
open(19,file=trim(out_dir2)//'events_dat_xz.dat',status='unknown')
do ievent = 1,nevent
write(19,'(3f20.10,1i12)') x_eve_dat(ievent), z_eve_dat(ievent), otime_dat(ievent), ievent
@@ -1670,7 +1676,7 @@
!m0_prior(:) = m0(:)
m0_vec_initial(:) = m0_vec(:)
- if( .not. HESSIAN ) then
+ if( .not. READ_IN ) then
open(88,file=trim(out_dir2)//'initial_model_vector.dat',status='unknown')
do i = 1,nmod
write(88,'(2e24.12)') m0_vec(i), m0(i)
@@ -1700,7 +1706,7 @@
m_src_syn(:) = m_src_syn_vec(:) - m_src_syn_vec_initial(:)
! write out initial source vector
- if( .not. HESSIAN ) then
+ if( .not. READ_IN ) then
open(88,file=trim(out_dir2)//'initial_source.dat',status='unknown')
do i = 1,nmod_src
!write(88,'(5e24.12)') m_scale_src_all(i), m_src_syn_vec_initial(i), m_src_syn_initial(i), m_src_dat_vec(i), m_src_dat(i)
@@ -1754,7 +1760,7 @@
!!$ ! This will control the relative weight of each set of parameters.
!!$ ! NOTE : We approximate our checkerboard-generated structure values by a Gaussian distribution.
!!$ if( INV_SOURCE == 1 .and. INV_STRUCT_BETA == 1) then
-!!$ if( HESSIAN ) then
+!!$ if( READ_IN ) then
!!$ joint_str_src_grad_ratio = 1.0
!!$ else
!!$ ! see also scale_struct_gji (F^2)
@@ -1810,14 +1816,21 @@
!ugrad_str = 0.2070999127d6 ; ugrad_ts = 0.3507740673d4 ; ugrad_xs = 0.1940368586d4 ; ugrad_ys = 0.2142118702d4 ! Nfac = 3, 25 events
!ugrad_str = 0.4247330856d6 ; ugrad_ts = 0.5896527525d4 ; ugrad_xs = 0.2643538184d4 ; ugrad_ys = 0.3342815391d4 ! Nfac = 3, 5 events
- !ugrad_str = 0.1205146534d6 ; ugrad_ts = 0.2926409454d3 ; ugrad_xs = 0.9695606936d3 ; ugrad_ys = 0.7224889563d3 ! Nfac = 3, 1 event
+ ugrad_str = 0.1205146534d6 ; ugrad_ts = 0.2926409454d3 ; ugrad_xs = 0.9695606936d3 ; ugrad_ys = 0.7224889563d3 ! Nfac = 3, 1 event
!ugrad_str = ; ugrad_ts = ; ugrad_xs = ; ugrad_ys = ! Gaussians
- ugrad_str = 0.8251756295d5 ; ugrad_ts = 0.4212723180d3 ; ugrad_xs = 0.5753336089d2 ; ugrad_ys = 0.4077345971d2 ! Gaussians, 1 event
+ !ugrad_str = 0.8251756295d5 ; ugrad_ts = 0.4212723180d3 ; ugrad_xs = 0.5753336089d2 ; ugrad_ys = 0.4077345971d2 ! Gaussians, 1 event
!ugrad_str = 0.3812017066d6 ; ugrad_ts = 0.2140202263d4 ; ugrad_xs = 0.2970951189d4 ; ugrad_ys = 0.4102594535d4 ! Gaussians, 5 events
!ugrad_str = 0.1907942047d6 ; ugrad_ts = 0.1687351289d4 ; ugrad_xs = 0.2308837150d4 ; ugrad_ys = 0.2986802305d4 ! Gaussians, 25 events
+ !ugrad_str = 0.1191920326d6 ; ugrad_ts = 0.4533353832d3 ; ugrad_xs = 0.6191223030d2 ; ugrad_ys = 0.4387672586d2 ! Gaussians, 1 event
+ !ugrad_str = 0.3812017066d6 ; ugrad_ts = 0.2140202263d4 ; ugrad_xs = 0.2970951189d4 ; ugrad_ys = 0.4102594535d4 ! Gaussians, 5 events
+ !ugrad_str = 0.1907942047d6 ; ugrad_ts = 0.1687351289d4 ; ugrad_xs = 0.2308837150d4 ; ugrad_ys = 0.2986802305d4 ! Gaussians, 25 events
+
+ ! ad hoc: choose balance among the four parts of the gradient
fac_str = 1.0/2.0 ; fac_ts = 1.0/6.0 ; fac_xs = 1.0/6.0 ; fac_ys = 1.0/6.0
+ !fac_str = 1.0/4.0 ; fac_ts = 1.0/4.0 ; fac_xs = 1.0/4.0 ; fac_ys = 1.0/4.0
+ !fac_str = 0.7 ; fac_ts = 0.1 ; fac_xs = 0.1 ; fac_ys = 0.1
fac_total = (ugrad_str/fac_str) + (ugrad_ts/fac_ts) + (ugrad_xs/fac_xs) + (ugrad_ys/fac_ys)
endif
@@ -1836,13 +1849,13 @@
! The means adjusting the weights of the respective parts, based on the
! perfectly recovered model (i.e., no data errors added, no model norm term).
! Thus, the norm of the target model will then be somewhat GREATER than 1.0.
- coverage_str = 0.666 / 0.962
- coverage_src = 0.946 / 1.018
+ !coverage_str = 0.666 / 0.962
+ !coverage_src = 0.946 / 1.018
! If the initial and target models are from a Gaussian distribution,
! then this factor is not needed.
- !coverage_str = 1.0
- !coverage_src = 1.0
+ coverage_str = 1.0
+ coverage_src = 1.0
! structure part
cov_model(m_inds(1,1):m_inds(1,2)) = ( sigma_beta )**2 / da_local_vec(:) * AREA * coverage_str
@@ -1871,7 +1884,9 @@
call local2mvec(temp_local1, nmod_src, m_src_dat, nmod, mtarget)
! possible stopping criteria based on the target model
- chi_model_stop = 0.5 * model_target_norm
+ ! NOTE: THIS IS NOT USED
+ !chi_model_stop = 0.5 * model_target_norm
+ chi_model_stop = 0.0
! possible stopping criteria based on fitting the data
chi_data_stop = 0.0
@@ -1886,6 +1901,25 @@
write(19,'(2e20.10)') sigma_zs, m_scale_src(3)
close(19)
+ open(unit=19,file=trim(out_dir2)//'scaling_values_covm.dat',status='unknown')
+ write(19,*) 'fac_str', fac_str
+ write(19,*) 'fac_ts', fac_ts
+ write(19,*) 'fac_xs', fac_xs
+ write(19,*) 'fac_ys', fac_ys
+ write(19,*) 'fac_total', fac_total
+ write(19,*) 'ugrad_str', ugrad_str
+ write(19,*) 'ugrad_ts', ugrad_ts
+ write(19,*) 'ugrad_xs', ugrad_xs
+ write(19,*) 'ugrad_ys', ugrad_ys
+ write(19,*) 'dnparm_src_run', dnparm_src_run
+ write(19,*) 'coverage_str', coverage_str
+ write(19,*) 'coverage_src', coverage_src
+ write(19,*) 'cov_imetric_fac_str', (fac_str / ugrad_str) * fac_total
+ write(19,*) 'cov_imetric_fac_ts', (fac_ts / ugrad_ts) * fac_total
+ write(19,*) 'cov_imetric_fac_xs', (fac_xs / ugrad_xs) * fac_total
+ write(19,*) 'cov_imetric_fac_ys', (fac_ys / ugrad_ys) * fac_total
+ close(19)
+
open(unit=19,file=trim(out_dir2)//'scaling_values.dat',status='unknown')
write(19,*) 'GJI_PAPER = ', GJI_PAPER
write(19,*) 'IRUNZ = ', IRUNZ
@@ -1970,6 +2004,18 @@
cov_data(:) = SIGMA_DLNA * SIGMA_DLNA * nmeas_run
endif
+ if(IKER==1) then
+ open(unit=19,file=trim(out_dir2)//'scaling_values_covd.dat',status='unknown')
+ write(19,*) 'ievent_min', ievent_min
+ write(19,*) 'ievent_max', ievent_max
+ write(19,*) 'nevent_run', nevent_run
+ write(19,*) 'nrec', nrec
+ write(19,*) 'NCOMP', NCOMP
+ write(19,*) 'nmeas_run', nmeas_run
+ write(19,*) 'SIGMA_DT', SIGMA_DT
+ close(19)
+ endif
+
! write data covariance matrix diagonal to file
open(unit=19,file=trim(out_dir2)//'cov_data_diagonal.dat',status='unknown')
write(19,'(1e20.10)') (cov_data(i), i = 1,nmeas)
@@ -2025,7 +2071,7 @@
if(INV_SOURCE_X==1) print *, ' inverting for source locations'
print *,'=============================================================='
- if (HESSIAN) then
+ if (READ_IN) then
out_dir1 = trim(out_dir2) ! no iteration
else
write(out_dir1,'(a,i4.4,a)') trim(out_dir3)//'run_',irun,'/'
@@ -2048,7 +2094,7 @@
endif
! for CG algorithm, update kappa_syn and mu_syn
- if( .not. HESSIAN) then
+ if( .not. READ_IN) then
!kappa_syn = rho_syn * bulk_syn * bulk_syn
mu_syn = rho_syn * beta_syn * beta_syn
endif
@@ -2056,9 +2102,9 @@
! read in the sources from another file
! NOTE: FOR NOW, WE DO NOT LOAD THE DATA SOURCES -- THEY SHOULD BE IDENTICAL.
! (In the future, we might want to modify this to read in ANY data sources.)
- if( HESSIAN .and. (INV_SOURCE_T == 1 .and. INV_SOURCE_X == 1)) then
+ if( READ_IN .and. (INV_SOURCE_T == 1 .and. INV_SOURCE_X == 1)) then
- write(filename,'(a,i2.2,a)') trim(out_dir2)//'src_syn_h',hmod,'.dat'
+ write(filename,'(a,i4.4,a)') trim(out_dir2)//'src_syn_m',hmod,'.dat'
open(unit=18,file=filename,status='unknown')
m_src_syn_vec(:) = m_src_dat_vec(:) ! initialize to no perturbation
do i = 1,nevent
@@ -2081,16 +2127,11 @@
endif
-!!$ ! option to smooth the model update
-!!$ if( istep > 0 .and. ISMOOTH_MODEL_UPDATE == 1) then
-!!$
-!!$
-!!$ endif
-
! compute model norm term in the misfit function
- ! NOTE: The initial (prior) model is always all ZEROS (B,C,Ts,Xs,Ys);
- ! hence, we replace (m0 - mprior) --> m0 and (mt - mprior) --> mt .
- ! NOTE THAT THE FACTOR OF 0.5 IS NOT INCLUDED HERE
+ ! NOTE 1: The prior model is always all ZEROS (B,Ts,Xs,Ys);
+ ! hence, we replace (m0 - mprior) --> m0 and (mt - mprior) --> mt .
+ ! NOTE 2: The initial model is NOT necessarily the prior model .
+ ! NOTE 3: THE FACTOR OF 0.5 IS NOT INCLUDED HERE
if(itest==0) then ! reference model (current model)
call compute_norm_sq(ievent_min, ievent_max, nevent, index_source, nmod, m0, cov_imetric, &
model_norm, model_norm_struct, model_norm_source, model_norm_parts)
@@ -3013,7 +3054,7 @@
gradient_data_all(ievent,3) = source_gradient(itemp2)**2 * cov_model(itemp2+nmod_str)
gradient_data_all(ievent,4) = source_gradient(itemp3)**2 * cov_model(itemp3+nmod_str)
- ! write the gradient parts for each event to file
+ ! write the gradient parts FOR EACH EVENT to file
open(unit=18,file=trim(out_dir)//'gradient_data_unbalanced.dat',status='unknown')
write(18,'(4e20.10)') gradient_data_all(ievent,1), gradient_data_all(ievent,2), &
gradient_data_all(ievent,3), gradient_data_all(ievent,4)
@@ -3067,15 +3108,16 @@
chi_val = 0.5 * data_norm
endif
- ! VARIANCE REDUCTION -- note that chi_data_stop is removed
- ! NOTE: if the new chi is larger than the previous chi, then VR < 0.
+ ! VARIANCE REDUCTION
+ ! NOTE 1: if the new chi (chi_val) is larger than the previous chi (chi_k_val), then VR < 0.
+ ! NOTE 2: consider whether chi_data_stop should be removed
if(istep >= 2) then
- var_red_val = 100.0 * ( 1.0 - ( (chi_val - chi_data_stop)**2 / (chi_k_val - chi_data_stop)**2 ) )
+ !var_red_val = 100.0 * ( 1.0 - ( (chi_val - chi_data_stop)**2 / (chi_k_val - chi_data_stop)**2 ) )
+ !var_red_val = -log( abs(chi_val - chi_data_stop) / abs(chi_k_val - chi_data_stop) )
+ var_red_val = log( chi_k_val / chi_val )
open(19,file=trim(out_dir1)//'variance_reduction.dat',status='unknown')
- do ievent = 1,nevent
- write(19,'(1f20.10)') var_red_val
- enddo
+ write(19,'(1f20.10)') var_red_val, VAR_RED_MIN
close(19)
endif
@@ -3162,8 +3204,9 @@
write(19,'(1e20.10)') (source_gradient(i), i = 1,nmod_src)
close(19)
- ! gradient for each event
- open(unit=18,file=trim(out_dir)//'gradient_data_all_unbalanced.dat',status='unknown')
+ ! norm of parts of unbalanced gradient for all events
+ ! NOTE: within each event directory there is also gradient_data_unbalanced.dat
+ open(unit=18,file=trim(out_dir1)//'gradient_data_all_unbalanced.dat',status='unknown')
do i = 1,nevent
write(18,'(4e20.10)') gradient_data_all(i,1), gradient_data_all(i,2), &
gradient_data_all(i,3), gradient_data_all(i,4)
@@ -3343,11 +3386,21 @@
! update the current search direction p0 (p0 and pk are NON-hat)
if(istep == 0) then
beta_val = 0.0
+ p0(:) = 0.0 ! initialize
else
beta_val = sum((gk(:) - g0(:)) * (cov_imetric(:)*gk(:)) ) / sum(g0(:) * (cov_imetric(:)*g0(:)) )
endif
pk(:) = -cov_imetric(:) * gk(:) + beta_val * p0(:)
+ ! write gradient vectors (before re-assigning g0 and gk)
+ if(1==1) then
+ open(unit=19,file=trim(out_dir1)//'cg_grad_vectors.dat',status='unknown')
+ do i = 1,nmod
+ write(19,'(4e16.6)') g0(i), gk(i), p0(i), pk(i)
+ enddo
+ close(19)
+ endif
+
! KEY: test value for line-search to get test model
! You must be careful to define the metric for the dot product operation.
! Here, we use a diagonal covariance matrix; for a full covariance matrix,
@@ -3409,6 +3462,11 @@
g0(:) = gk(:) ! gradient
p0(:) = pk(:) ! search direction vector
+ ! write scalars to file
+ open(unit=19,file=trim(out_dir1)//'cg_test_vals.dat',status='unknown')
+ write(19,'(4e16.8)') mu_val, lam_t_val, beta_val, chi_k_val
+ close(19)
+
elseif(itest==1) then ! if present kernel is for a test model
chi_t_val = chi_val
@@ -3451,7 +3509,7 @@
! write cubic function parameters to file
open(unit=19,file=trim(out_dir1)//'cubic_poly.dat',status='unknown')
- write(19,'(11e16.6)') xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
+ write(19,'(11e16.8)') xx1,xx2,yy1,yy2,g1,g2,Pa,Pb,Pc,Pd,xmin
close(19)
else
@@ -3474,7 +3532,7 @@
! write quadratic function parameters to file
open(unit=19,file=trim(out_dir1)//'quad_poly.dat',status='unknown')
- write(19,'(9e16.6)') xx1,xx2,yy1,yy2,g1,Pa,Pb,Pc,xmin
+ write(19,'(9e16.8)') xx1,xx2,yy1,yy2,g1,Pa,Pb,Pc,xmin
close(19)
endif ! POLY_ORDER == 3
@@ -3529,13 +3587,6 @@
enddo
close(19)
endif
- if(1==1) then
- open(unit=19,file=trim(out_dir1)//'cg_grad_vectors.dat',status='unknown')
- do i = 1,nmod
- write(19,'(5e16.6)') g0(i), gt(i), gk(i), p0(i), pk(i)
- enddo
- close(19)
- endif
! FUTURE WORK: if the structure or source parameters are unrealistic,
! then we should exit the program before the NEXT wave simulation.
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -5,7 +5,7 @@
! Several lines need to be commented/uncommented to go from one to the other.
! index of the reference directory for the simulation output
- integer, parameter :: IRUNZ = 700
+ integer, parameter :: IRUNZ = 0
!========================
! GRID, TIME-STEP, AND SOURCE PARAMETERS
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
- integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ integer, parameter :: NITERATION = 1
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -201,12 +202,12 @@
! what to perturb, what to invert
! (For the inverse tests, we only allow perturbations in beta.)
integer, parameter :: PERT_STRUCT_BETA = 1
- integer, parameter :: PERT_SOURCE_T = 1
- integer, parameter :: PERT_SOURCE_X = 1
+ integer, parameter :: PERT_SOURCE_T = 0
+ integer, parameter :: PERT_SOURCE_X = 0
integer, parameter :: INV_STRUCT_BETA = 1
- integer, parameter :: INV_SOURCE_T = 1
- integer, parameter :: INV_SOURCE_X = 1
+ integer, parameter :: INV_SOURCE_T = 0
+ integer, parameter :: INV_SOURCE_X = 0
! whether to include the model norm term in the misfit function, which acts like damping
logical, parameter :: INCLUDE_MODEL_NORM = .true.
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex00.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex00.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex00.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 1
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex01.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex01.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex01.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex02.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex02.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex02.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex03.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex03.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex03.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex04.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex04.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex04.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex05.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex05.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex05.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex06.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex06.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex06.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
- integer, parameter :: NITERATION = 0
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ integer, parameter :: NITERATION = 16
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -201,12 +202,12 @@
! what to perturb, what to invert
! (For the inverse tests, we only allow perturbations in beta.)
integer, parameter :: PERT_STRUCT_BETA = 1
- integer, parameter :: PERT_SOURCE_T = 1
- integer, parameter :: PERT_SOURCE_X = 1
+ integer, parameter :: PERT_SOURCE_T = 0
+ integer, parameter :: PERT_SOURCE_X = 0
integer, parameter :: INV_STRUCT_BETA = 1
- integer, parameter :: INV_SOURCE_T = 1
- integer, parameter :: INV_SOURCE_X = 1
+ integer, parameter :: INV_SOURCE_T = 0
+ integer, parameter :: INV_SOURCE_X = 0
! whether to include the model norm term in the misfit function, which acts like damping
logical, parameter :: INCLUDE_MODEL_NORM = .true.
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex07.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex07.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex07.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 0
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
- integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ integer, parameter :: NITERATION = 0
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -201,12 +202,12 @@
! what to perturb, what to invert
! (For the inverse tests, we only allow perturbations in beta.)
integer, parameter :: PERT_STRUCT_BETA = 1
- integer, parameter :: PERT_SOURCE_T = 1
- integer, parameter :: PERT_SOURCE_X = 1
+ integer, parameter :: PERT_SOURCE_T = 0
+ integer, parameter :: PERT_SOURCE_X = 0
integer, parameter :: INV_STRUCT_BETA = 1
- integer, parameter :: INV_SOURCE_T = 1
- integer, parameter :: INV_SOURCE_X = 1
+ integer, parameter :: INV_SOURCE_T = 0
+ integer, parameter :: INV_SOURCE_X = 0
! whether to include the model norm term in the misfit function, which acts like damping
logical, parameter :: INCLUDE_MODEL_NORM = .true.
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex08.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex08.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_constants_ex08.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -19,8 +19,8 @@
integer, parameter :: NSTEP = NFRAME*NSAVE
! time step in seconds
- !double precision, parameter :: DT = 2.0e-2 ! body waves
- double precision, parameter :: DT = 6.0e-2 ! membrane surface waves
+ !double precision, parameter :: DT = 2.0d-2 ! body waves
+ double precision, parameter :: DT = 6.0d-2 ! membrane surface waves
! temporal properties of source (source time function)
integer, parameter :: ISRC_TIME = 1 ! type (1)
@@ -63,25 +63,25 @@
! STATION_COAST_BUFFER : exclude stations within this distance from edge of coast
integer, parameter :: IREC_SPACE = 2 ! see wave2d.f90
integer, parameter :: NMESH_REC = 17
- double precision, parameter :: SOURCE_GRID_BUFFER = 4.0e3 ! m
- double precision, parameter :: STATION_GRID_BUFFER = 15.0e3 ! m
- double precision, parameter :: STATION_COAST_BUFFER = 0.0e3 ! m
+ double precision, parameter :: SOURCE_GRID_BUFFER = 4.0d3 ! m
+ double precision, parameter :: STATION_GRID_BUFFER = 15.0d3 ! m
+ double precision, parameter :: STATION_COAST_BUFFER = 0.0d3 ! m
! lower right corner for membrane surface waves plotting grid
- double precision, parameter :: LAT_MIN = 32.0
- double precision, parameter :: LON_MIN = -120.0
+ double precision, parameter :: LAT_MIN = 32.0d0
+ double precision, parameter :: LON_MIN = -120.0d0
integer, parameter :: UTM_PROJECTION_ZONE = 11 ! southern California
! mesh specifications: membrane surface waves
- double precision, parameter :: LENGTH = 480.0e3 ! m
- double precision, parameter :: HEIGHT = 480.0e3 ! m
+ double precision, parameter :: LENGTH = 480.0d3 ! m
+ double precision, parameter :: HEIGHT = 480.0d3 ! m
double precision, parameter :: AREA = LENGTH*HEIGHT
integer, parameter :: NEX = 40
integer, parameter :: NEZ = 40
!!$
!!$! mesh specifications: body waves
-!!$ double precision, parameter :: LENGTH = 200.0e3 ! m ! 400 for 1D body waves
-!!$ double precision, parameter :: HEIGHT = 80.0e3 ! m
+!!$ double precision, parameter :: LENGTH = 200.0d3 ! m ! 400 for 1D body waves
+!!$ double precision, parameter :: HEIGHT = 80.0d3 ! m
!!$ integer, parameter :: NEX = 80 ! 160
!!$ integer, parameter :: NEZ = 32 ! 32
@@ -91,10 +91,10 @@
! model perturbations for HOMOGENEOUS model (or perturbation)
! scaling from beta to alpha
! value is from Masters et al. (2000), "The relative behavior of shear velocity..."
- double precision, parameter :: R_BETA_OVER_ALPHA = 1.3
- double precision, parameter :: PBETA = 10.0
+ double precision, parameter :: R_BETA_OVER_ALPHA = 1.3d0
+ double precision, parameter :: PBETA = 10.0d0
double precision, parameter :: PALPHA = PBETA / R_BETA_OVER_ALPHA
- double precision, parameter :: PRHO = 0.0
+ double precision, parameter :: PRHO = 0.0d0
! reference model and target model choice
integer, parameter :: IMODEL_SYN = 3
@@ -168,27 +168,28 @@
!--------------------------------------
! INVERSION PARAMETERS
- ! whether you want to compute kernels, or simply the misfit function
+ ! whether you want to compute kernels or simply the misfit function
logical, parameter :: COMPUTE_KERNELS = .true.
- ! whether to use the data subspace method, which has a Hessian
- logical, parameter :: HESSIAN = .false.
+ ! whether to read in models generated from outside wave2d.f90
+ logical, parameter :: READ_IN = .false.
+ logical, parameter :: READ_SINGLE = .false. ! read single or multiple files
! stopping criteria
! NITERATION : number of iterations
- ! VAR_RED_MIN : minimum variance reduction (in percent)
+ ! VAR_RED_MIN : minimum variance reduction
! SIGMA_FAC : stop if a model value exceeds SIGMA_FAC * sigma_m
! CONV_STOP : stop when the misfit value is this fraction of the INITIAL misfit value
integer, parameter :: NITERATION = 16
- double precision, parameter :: VAR_RED_MIN = 8.0
- !double precision, parameter :: SIGMA_FAC = 2.0
- !double precision, parameter :: CONV_STOP = 1.0e-4
+ double precision, parameter :: VAR_RED_MIN = 0.05d0
+ !double precision, parameter :: SIGMA_FAC = 2.0d0
+ !double precision, parameter :: CONV_STOP = 1.0d-4
! Gaussian errors containted in input file
! see wave2d_sigmas.m and INPUT/sigma_0p1_pert.dat
- double precision, parameter :: SIGMA_DT = 0.10
- double precision, parameter :: SIGMA_DLNA = 1.0
- double precision, parameter :: SIGMA_WAVEFORM = 1.0
+ double precision, parameter :: SIGMA_DT = 0.10d0
+ double precision, parameter :: SIGMA_DLNA = 1.0d0
+ double precision, parameter :: SIGMA_WAVEFORM = 1.0d0
logical, parameter :: ADD_DATA_ERRORS = .true.
! order of interpolating polynomial in conjugate gradient algorithm
@@ -227,15 +228,15 @@
integer, parameter :: STRUCTURE_PARAMETER_TYPE = 2
! homogeneous background model (S.I. units)
- double precision, parameter :: DENSITY = 2.60e3 ! kg/m^3
- double precision, parameter :: INCOMPRESSIBILITY = 4.50e10 ! Pa
- double precision, parameter :: RIGIDITY = 3.185e10 ! Pa
- ! double precision, parameter :: INCOMPRESSIBILITY = 5.20e10 ! Pa
- ! double precision, parameter :: RIGIDITY = 2.66e10 ! Pa
+ double precision, parameter :: DENSITY = 2.60d3 ! kg/m^3
+ double precision, parameter :: INCOMPRESSIBILITY = 4.50d10 ! Pa
+ double precision, parameter :: RIGIDITY = 3.185d10 ! Pa
+ ! double precision, parameter :: INCOMPRESSIBILITY = 5.20d10 ! Pa
+ ! double precision, parameter :: RIGIDITY = 2.66d10 ! Pa
! compute additional parameters
double precision, parameter :: PWAVESPEED = &
- sqrt( (INCOMPRESSIBILITY + (4.0/3.0)*RIGIDITY)/DENSITY )
+ sqrt( (INCOMPRESSIBILITY + (4.0d0/3.0d0)*RIGIDITY)/DENSITY )
double precision, parameter :: SWAVESPEED = sqrt( RIGIDITY/DENSITY )
double precision, parameter :: BWAVESPEED = sqrt( INCOMPRESSIBILITY/DENSITY )
@@ -294,20 +295,20 @@
integer, parameter :: NUM_ITER = 1
! very large and very small values
- double precision, parameter :: HUGEVAL = 1.0e30, TINYVAL = 1.0e-9
+ double precision, parameter :: HUGEVAL = 1.0d30, TINYVAL = 1.0d-9
! for the Gauss-Lobatto-Legendre points and weights
- double precision, parameter :: GAUSSALPHA = 0.0,GAUSSBETA = 0.0
+ double precision, parameter :: GAUSSALPHA = 0.0d0,GAUSSBETA = 0.0d0
!
! CONSTANTS
!
- double precision, parameter :: PI = 3.141592653589793
- double precision, parameter :: FOUR_THIRDS = 4.0 / 3.0
- double precision, parameter :: ONE_THIRD = 1.0 / 3.0
- double precision, parameter :: ONEOVERTWO = 0.5
- double precision, parameter :: DEG = 180.0/PI
- ! double precision, parameter :: EPS = 1.0e-35
+ double precision, parameter :: PI = 3.141592653589793d0
+ double precision, parameter :: FOUR_THIRDS = 4.0d0 / 3.0d0
+ double precision, parameter :: ONE_THIRD = 1.0d0 / 3.0d0
+ double precision, parameter :: ONEOVERTWO = 0.5d0
+ double precision, parameter :: DEG = 180.0d0/PI
+ ! double precision, parameter :: EPS = 1.0d-35
!!$! parameter for FFTW
!!$ integer, parameter :: NOUT = NSTEP/2 + 1
Modified: seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_sub.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_sub.f90 2010-01-28 10:51:00 UTC (rev 16190)
+++ seismo/3D/ADJOINT_TOMO/iterate_adj/SEM2D_iterate/src/wave2d_sub.f90 2010-01-28 17:37:35 UTC (rev 16191)
@@ -9,13 +9,13 @@
!-----------------------------------------------------
- subroutine write_parameters(filename)
+ subroutine write_parameters_plot(filename)
character(len=*),intent(in) :: filename
- print *, 'writing out parameters'
+ print *, 'writing out parameters to ' // trim(filename)
- open(unit=12, file=filename, status='unknown')
+ open(unit=12, file=trim(filename), status='unknown')
write(12,'(3i10)') 0,NSTEP,NSAVE
write(12,'(3i10)') FOR_X, FOR_Y, FOR_Z
@@ -23,6 +23,159 @@
write(12,'(1f16.8)') hdur
close(12)
+ end subroutine write_parameters_plot
+
+ !-----------------------------------------------------
+
+ subroutine write_parameters(filename)
+
+ character(len=*),intent(in) :: filename
+
+ print *, 'writing out parameters to ' // trim(filename)
+
+ open(unit=12, file=trim(filename), status='unknown')
+
+ write(12,*) 'IRUNZ',IRUNZ
+ write(12,*) 'NFRAME',NFRAME
+ write(12,*) 'NSAVE',NSAVE
+ write(12,*) 'NSTEP',NSTEP
+ write(12,*) 'DT',DT
+ write(12,*) 'ISRC_TIME',ISRC_TIME
+ write(12,*) 'hdur',hdur
+ write(12,*) 'tshift',tshift
+ if(SRC_TAPER) write(12,*) 'SRC_TAPER 1'
+ if(.not. SRC_TAPER) write(12,*) 'SRC_TAPER 0'
+ write(12,*) 'FNORM',FNORM
+ write(12,*) 'FOR_X',FOR_X
+ write(12,*) 'FOR_Y',FOR_Y
+ write(12,*) 'FOR_Z',FOR_Z
+ write(12,*) 'REV_X',REV_X
+ write(12,*) 'REV_Y',REV_Y
+ write(12,*) 'REV_Z',REV_Z
+ write(12,*) 'ISRC_SPACE',ISRC_SPACE
+ write(12,*) 'IREC_SPACE',IREC_SPACE
+ write(12,*) 'NMESH_REC',NMESH_REC
+ write(12,*) 'SOURCE_GRID_BUFFER',SOURCE_GRID_BUFFER
+ write(12,*) 'STATION_GRID_BUFFER',STATION_GRID_BUFFER
+ write(12,*) 'STATION_COAST_BUFFER',STATION_COAST_BUFFER
+ write(12,*) 'LAT_MIN',LAT_MIN
+ write(12,*) 'LON_MIN',LON_MIN
+ write(12,*) 'UTM_PROJECTION_ZONE',UTM_PROJECTION_ZONE
+ write(12,*) 'LENGTH',LENGTH
+ write(12,*) 'HEIGHT ',HEIGHT
+ write(12,*) 'AREA',AREA
+ write(12,*) 'NEX',NEX
+ write(12,*) 'NEZ',NEZ
+ write(12,*) 'R_BETA_OVER_ALPHA',R_BETA_OVER_ALPHA
+ write(12,*) 'PBETA',PBETA
+ write(12,*) 'PALPHA',PALPHA
+ write(12,*) 'PRHO',PRHO
+ write(12,*) 'IMODEL_SYN',IMODEL_SYN
+ write(12,*) 'IMODEL_DAT',IMODEL_DAT
+ write(12,*) 'ISMOOTH_EVENT_KERNEL',ISMOOTH_EVENT_KERNEL
+ write(12,*) 'ISMOOTH_MISFIT_KERNEL',ISMOOTH_MISFIT_KERNEL
+ write(12,*) 'ISMOOTH_INITIAL_MODEL',ISMOOTH_INITIAL_MODEL
+ write(12,*) 'ISMOOTH_MODEL_UPDATE',ISMOOTH_MODEL_UPDATE
+ write(12,*) 'SIGMA_SMOOTH_KERNEL',SIGMA_SMOOTH_KERNEL
+ write(12,*) 'SIGMA_SMOOTH_MODEL',SIGMA_SMOOTH_MODEL
+ write(12,*) 'GAMMA_SMOOTH_KERNEL',GAMMA_SMOOTH_KERNEL
+ write(12,*) 'GAMMA_SMOOTH_MODEL',GAMMA_SMOOTH_MODEL
+ if(HIGH_RES_SMOOTHING) write(12,*) 'HIGH_RES_SMOOTHING 1'
+ if(.not. HIGH_RES_SMOOTHING) write(12,*) 'HIGH_RES_SMOOTHING 0'
+ if(EXAMPLE_GAUSSIAN) write(12,*) 'EXAMPLE_GAUSSIAN 1'
+ if(.not. EXAMPLE_GAUSSIAN) write(12,*) 'EXAMPLE_GAUSSIAN 0'
+ write(12,*) 'IKER',IKER
+ write(12,*) 'IAMP_VEL',IAMP_VEL
+ write(12,*) 'ISURFACE',ISURFACE
+ write(12,*) 'NCOMP',NCOMP
+ write(12,*) 'NABSORB',NABSORB
+ if(WRITE_STF_F) write(12,*) 'WRITE_STF_F 1'
+ if(.not. WRITE_STF_F) write(12,*) 'WRITE_STF_F 0'
+ if(WRITE_SEISMO_F) write(12,*) 'WRITE_SEISMO_F 1'
+ if(.not. WRITE_SEISMO_F) write(12,*) 'WRITE_SEISMO_F 0'
+ if(WRITE_SEISMO_RECONSTRUCT) write(12,*) 'WRITE_SEISMO_RECONSTRUCT 1'
+ if(.not. WRITE_SEISMO_RECONSTRUCT) write(12,*) 'WRITE_SEISMO_RECONSTRUCT 0'
+ if(WRITE_STF_A) write(12,*) 'WRITE_STF_A 1'
+ if(.not. WRITE_STF_A) write(12,*) 'WRITE_STF_A 0'
+ if(WRITE_SEISMO_A) write(12,*) 'WRITE_SEISMO_A 1'
+ if(.not. WRITE_SEISMO_A) write(12,*) 'WRITE_SEISMO_A 0'
+ if (WRITE_KERNELS) write(12,*) 'WRITE_KERNELS 1'
+ if (.not. WRITE_KERNELS) write(12,*) 'WRITE_KERNELS 0'
+ if (WRITE_KERNEL_SNAPSHOTS) write(12,*) 'WRITE_KERNEL_SNAPSHOTS 1'
+ if (.not. WRITE_KERNEL_SNAPSHOTS) write(12,*) 'WRITE_KERNEL_SNAPSHOTS 0'
+ if(WRITE_WAVFIELD_SNAPSHOTS) write(12,*) 'WRITE_WAVFIELD_SNAPSHOTS 1'
+ if(.not. WRITE_WAVFIELD_SNAPSHOTS) write(12,*) 'WRITE_WAVFIELD_SNAPSHOTS 0'
+ if(COMPUTE_KERNELS) write(12,*) 'COMPUTE_KERNELS 1'
+ if(.not. COMPUTE_KERNELS) write(12,*) 'COMPUTE_KERNELS 0'
+ if(READ_IN) write(12,*) 'READ_IN 1'
+ if(.not. READ_IN) write(12,*) 'READ_IN 0'
+ if(READ_SINGLE) write(12,*) 'READ_SINGLE 1'
+ if(.not. READ_SINGLE) write(12,*) 'READ_SINGLE 0'
+ write(12,*) 'NITERATION',NITERATION
+ write(12,*) 'VAR_RED_MIN',VAR_RED_MIN
+ write(12,*) 'SIGMA_DT',SIGMA_DT
+ write(12,*) 'SIGMA_DLNA',SIGMA_DLNA
+ write(12,*) 'SIGMA_WAVEFORM',SIGMA_WAVEFORM
+ if(ADD_DATA_ERRORS) write(12,*) 'ADD_DATA_ERRORS 1'
+ if(.not. ADD_DATA_ERRORS) write(12,*) 'ADD_DATA_ERRORS 0'
+ write(12,*) 'POLY_ORDER',POLY_ORDER
+ write(12,*) 'PERT_STRUCT_BETA',PERT_STRUCT_BETA
+ write(12,*) 'PERT_SOURCE_T',PERT_SOURCE_T
+ write(12,*) 'PERT_SOURCE_X',PERT_SOURCE_X
+ write(12,*) 'INV_STRUCT_BETA',INV_STRUCT_BETA
+ write(12,*) 'INV_SOURCE_T',INV_SOURCE_T
+ write(12,*) 'INV_SOURCE_X',INV_SOURCE_X
+ if(INCLUDE_MODEL_NORM) write(12,*) 'INCLUDE_MODEL_NORM 1'
+ if(.not. INCLUDE_MODEL_NORM) write(12,*) 'INCLUDE_MODEL_NORM 0'
+ if(ISOURCE_LOG) write(12,*) 'ISOURCE_LOG 1'
+ if(.not. ISOURCE_LOG) write(12,*) 'ISOURCE_LOG 0'
+ write(12,*) 'NVAR_STRUCT',NVAR_STRUCT
+ write(12,*) 'NVAR_SOURCE',NVAR_SOURCE
+ write(12,*) 'NVAR',NVAR
+ write(12,*) 'STRUCTURE_PARAMETER_TYPE',STRUCTURE_PARAMETER_TYPE
+ write(12,*) 'DENSITY',DENSITY
+ write(12,*) 'INCOMPRESSIBILITY',INCOMPRESSIBILITY
+ write(12,*) 'RIGIDITY',RIGIDITY
+ write(12,*) 'PWAVESPEED',PWAVESPEED
+ write(12,*) 'SWAVESPEED',SWAVESPEED
+ write(12,*) 'BWAVESPEED',BWAVESPEED
+ write(12,*) 'HWIN1',HWIN1
+ write(12,*) 'HWIN2',HWIN2
+ if(SUPPRESS_UTM_PROJECTION) write(12,*) 'SUPPRESS_UTM_PROJECTION 1'
+ if(.not. SUPPRESS_UTM_PROJECTION) write(12,*) 'SUPPRESS_UTM_PROJECTION 0'
+ write(12,*) 'ILONGLAT2UTM',ILONGLAT2UTM
+ write(12,*) 'IUTM2LONGLAT',IUTM2LONGLAT
+ write(12,*) 'ILONLAT2MESH',ILONLAT2MESH
+ write(12,*) 'IMESH2LONLAT',IMESH2LONLAT
+ write(12,*) 'MAX_SR_FAKE',MAX_SR_FAKE
+ write(12,*) 'MAX_EVENT',MAX_EVENT
+ write(12,*) 'MAX_SR',MAX_SR
+ write(12,*) 'MAX_PHASE',MAX_PHASE
+ write(12,*) 'MAX_COMP',MAX_COMP
+ write(12,*) 'NELE',NELE
+ write(12,*) 'NSPEC',NSPEC
+ write(12,*) 'NGLLX',NGLLX
+ write(12,*) 'NGLLZ',NGLLZ
+ write(12,*) 'NGLL',NGLL
+ write(12,*) 'NGLLSQUARE',NGLLSQUARE
+ write(12,*) 'NGLOB',NGLOB
+ write(12,*) 'NLOCAL',NLOCAL
+ write(12,*) 'NSPEC_CORNER',NSPEC_CORNER
+ write(12,*) 'NGNOD',NGNOD
+ write(12,*) 'NGNOD2D',NGNOD2D
+ write(12,*) 'NUM_ITER',NUM_ITER
+ write(12,*) 'HUGEVAL',HUGEVAL
+ write(12,*) 'TINYVAL',TINYVAL
+ write(12,*) 'GAUSSALPHA',GAUSSALPHA
+ write(12,*) 'GAUSSBETA',GAUSSBETA
+ write(12,*) 'PI',PI
+ write(12,*) 'FOUR_THIRDS',FOUR_THIRDS
+ write(12,*) 'ONE_THIRD',ONE_THIRD
+ write(12,*) 'ONEOVERTWO',ONEOVERTWO
+ write(12,*) 'DEG',DEG
+ write(12,*) 'NDIM',NDIM
+ close(12)
+
end subroutine write_parameters
!-----------------------------------------------------
@@ -43,7 +196,7 @@
print *, ' nsrc = ', 1
! all chi_data values
- open(19,file=trim(dir)//'chi_all.dat',status='unknown')
+ open(19,file=trim(dir)//'chi_data_all.dat',status='unknown')
do ievent = 1,nevent
do irec = 1,nrec
do icomp = 1,NCOMP
@@ -88,11 +241,11 @@
write(19,'(1f20.10)') chi_data_stop
close(19)
- open(19,file=trim(dir)//'chi_model_norm.dat',status='unknown')
+ open(19,file=trim(dir)//'model_norm.dat',status='unknown')
write(19,'(1f20.10)') model_norm
close(19)
- open(19,file=trim(dir)//'chi_data_norm.dat',status='unknown')
+ open(19,file=trim(dir)//'data_norm.dat',status='unknown')
write(19,'(1f20.10)') data_norm
close(19)
@@ -965,7 +1118,8 @@
!----------------------------------------------------
- subroutine compute_norm_sq(ievent_min, ievent_max, nevent, index_source, nmod, mvec, cov_model, &
+ subroutine compute_norm_sq(ievent_min, ievent_max, nevent, &
+ index_source, nmod, mvec, cov_model, &
norm_total, norm_struct, norm_source, norm_parts)
! This computes the norm-squared of a model vector using the model covariance.
More information about the CIG-COMMITS
mailing list