Commit 845d9051 authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

introduced direct plot misit modes

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 820
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent f63e449b
c this is <gremlin.f>
c------------------------------------------------------------------------------
c $Id: gremlin.f,v 1.12 2002-05-03 19:52:15 forbrig Exp $
c $Id: gremlin.f,v 1.13 2002-05-06 13:17:05 forbrig Exp $
c
c 05/12/97 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -79,6 +79,7 @@ c mod_showparcor
c 02/06/00 V4.12 added mweight condition in res_opt
c 19/04/02 V4.13 support square error ense-test by command swense
c 03/05/02 V4.13b only test selected parameters in resolution analysis
c 06/05/02 V4.13c allow for sqr and rms scaling in sense and ense
c
c==============================================================================
c
......@@ -490,7 +491,14 @@ c
elseif (arg(1:6).eq.'sense ') then
read(arg(7:80), *, err=98, end=98) ival,ival2,rval,rval2
if (inv_mat()) then
call pg_sresmod(ival, ival2, rval, rval2)
call pg_sresmod(ival, ival2, rval, rval2, .true.)
else
print *,'calculation of partial derivatives failed'
endif
elseif (arg(1:6).eq.'ssense ') then
read(arg(7:80), *, err=98, end=98) ival,ival2,rval,rval2
if (inv_mat()) then
call pg_sresmod(ival, ival2, rval, rval2, .false.)
else
print *,'calculation of partial derivatives failed'
endif
......@@ -508,11 +516,19 @@ c
else
print *,'calculation of partial derivatives failed'
endif
elseif (arg(1:5).eq.'sqense ') then
read(arg(6:80), *, err=98, end=98) ival,ival2,rval,rval2
if (inv_mat()) then
call pgpage
call pg_resmod(ival, ival2, rval, rval2,.false.)
else
print *,'calculation of partial derivatives failed'
endif
elseif (arg(1:5).eq.'ense ') then
read(arg(6:80), *, err=98, end=98) ival,ival2,rval,rval2
if (inv_mat()) then
call pgpage
call pg_resmod(ival, ival2, rval, rval2)
call pg_resmod(ival, ival2, rval, rval2,.true.)
else
print *,'calculation of partial derivatives failed'
endif
......
c this is <gremlin_help.f>
c------------------------------------------------------------------------------
c $Id: gremlin_help.f,v 1.3 2002-04-19 15:20:34 forbrig Exp $
c $Id: gremlin_help.f,v 1.4 2002-05-06 13:17:05 forbrig Exp $
c
c 25/03/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -13,6 +13,7 @@ c 04/03/99 V1.2 file/mtt explanation
c 24/05/00 V1.3 - introduced reso option wgpd
c - introduced reso option wense
c 19/04/02 V1.4 introduced command swense
c 06/05/02 V1.5 introduced sqense and ssense
c
c==============================================================================
c
......@@ -116,6 +117,12 @@ c
print *,' ''err'' is the allowed increase of the'
print *,' square error relative to the misfit'
print *,' of the reference synthetics'
print *,' ssense f,t,nu,err'
print *,' just like ''sense'' but in misfit,'
print *,' not in rms mode'
print *,' sqense f,t,nu,err'
print *,' just like ''ense'' but in misfit,'
print *,' not in rms mode'
call gremhelp_subtit('tests')
print *,' orth calculate scalar products and normalized scalar'
print *,' products of vectors of partial derivatives'
......
......@@ -16,6 +16,7 @@ c - pg_clw
c - reduced colour index
c - changed pgs_par calling convention
c 22/01/99 V1.5 - changed calling convention for pgs_par
c 06/05/02 V1.6 changed brace type for physical units
c
subroutine pg_mod(imod)
c
......@@ -101,7 +102,7 @@ c
call pgswin(parmin, parmax, maxdepth, mindepth)
if (.not.(takemem)) then
call pgsch(pg_lch)
call pglab('velocity [km/s]','depth [m]',' ')
call pglab('velocity (km/s)','depth (m)',' ')
call pgsch(pg_ch)
endif
c
......@@ -184,7 +185,7 @@ c
if (.not.(takemem)) then
call pgbox('BCNTS',0.,0,'BCTS',0.,0)
call pgsch(pg_lch)
call pglab('density [g/cm\\u3\\d]',' ',' ')
call pglab('density (g/cm\\u3\\d)',' ',' ')
call pgsch(pg_ch)
endif
c
......
c this is <pg_resmod.f>
c------------------------------------------------------------------------------
cS
c $Id: pg_resmod.f,v 1.3 2002-04-16 18:04:13 forbrig Exp $
c $Id: pg_resmod.f,v 1.4 2002-05-06 13:17:07 forbrig Exp $
c
c 08/04/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -14,8 +14,9 @@ c 09/11/98 V1.2 include title
c 22/01/99 V1.3 support title switching
c 02/06/00 V1.4 updated res_opt calling convention
c 16/04/02 V1.5 now calls res_optrms
c 06/05/02 V1.6 allow for rms and sqr mode
c
subroutine pg_resmod(mimin, mimax, nu, finalrms)
subroutine pg_resmod(mimin, mimax, nu, finalrms, dormstest)
c
c call res_optrms for given partial derivatives and precalculated
c matrices for model parameters mimin to mimax and plot resulting
......@@ -26,6 +27,7 @@ c finalrms: rms error increase to find parameter changes for
c
integer mimin,mimax
real nu, finalrms
logical dormstest
c
include 'glq_dim.inc'
include 'glq_model.inc'
......@@ -37,6 +39,7 @@ cE
integer mi, i
character*132 title
real x2ref, dat_x2
logical result
c
if (verb_subaction) print *,'ENTER pg_resmod(',mimin,',',mimax,
& nu,',',finalrms,')'
......@@ -73,7 +76,12 @@ c
do mi=mimin,mimax
if (verb_topstrategy) print *,'NOTICE (pg_resmod): ',
& 'going for parameter ',mi
if (res_optrms(mi, nu, finalrms, x2ref)) then
if (dormstest) then
result=res_optrms(mi, nu, finalrms,x2ref)
else
result=res_optsqr(mi, nu, finalrms,x2ref)
endif
if (result) then
call mod_parcor
call mod_chop(mb_work)
call pg_mod(-mb_work)
......
c this is <pg_resmod.f>
c------------------------------------------------------------------------------
cS
c $Id: pg_sresmod.f,v 1.3 2002-04-16 18:04:13 forbrig Exp $
c $Id: pg_sresmod.f,v 1.4 2002-05-06 13:17:07 forbrig Exp $
c
c 20/04/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -13,8 +13,9 @@ c 20/04/98 V1.0 Thomas Forbriger
c 22/01/99 V1.1 introduced title switiching
c 02/06/00 V1.2 updated res_opt calling convention
c 16/04/02 V1.3 now calls res_optrms
c 06/05/02 V1.4 allow for rms and sqr mode
c
subroutine pg_sresmod(mimin, mimax, nu, finalrms)
subroutine pg_sresmod(mimin, mimax, nu, finalrms, dormstest)
c
c call res_optrms for given partial derivatives and precalculated
c matrices for model parameters mimin to mimax and plot resulting
......@@ -25,6 +26,7 @@ c finalrms: rms error increase to find parameter changes for
c
integer mimin,mimax
real nu, finalrms
logical dormstest
c
include 'glq_dim.inc'
include 'glq_model.inc'
......@@ -79,7 +81,12 @@ c plot pure model
call pg_mod(mb_ref)
if (verb_topstrategy) print *,'NOTICE (pg_sresmod): ',
& 'going for parameter ',mi
if (res_optrms(mi, nu, finalrms, x2ref)) then
if (dormstest) then
result=res_optrms(mi, nu, finalrms,x2ref)
else
result=res_optsqr(mi, nu, finalrms,x2ref)
endif
if (result) then
call mod_parcor
call mod_chop(mb_work)
call pg_mod(-mb_work)
......
......@@ -10,6 +10,7 @@ c
c REVISIONS and CHANGES
c 24/03/98 V1.0 Thomas Forbriger
c 20/01/99 V1.1 - added title switching and character height
c 06/05/02 V1.2 changed brace type for physical units
c
c
subroutine pg_tapgreen(ivp, di, dotaper)
......@@ -131,9 +132,9 @@ c plot box
c
call pgsch(pg_lch)
if (pg_plottitle) then
call pglabel('frequency [Hz]','phase-slowness [s/km]',title)
call pglabel('frequency (Hz)','phase-slowness (s/km)',title)
else
call pglabel('frequency [Hz]','phase-slowness [s/km]',' ')
call pglabel('frequency (Hz)','phase-slowness (s/km)',' ')
endif
call pgsch(pg_ch)
c
......
......@@ -11,6 +11,7 @@ c 24/03/98 V1.0 Thomas Forbriger
c 24/08/98 V1.1 corrected string synthetics
c 20/01/99 V1.2 added some plot options
c 05/03/99 V1.3 consider asphalt section when plotting synthetics
c 06/05/02 V1.4 changed brace type for physical units
c
subroutine pg_tt(ivp, ref)
c
......@@ -95,9 +96,9 @@ c
call pgbox('BCNTS',0.,0,'BCNTS',0.,0)
call pgsch(pg_lch)
if (pg_plottitle) then
call pglabel('offset [m]','time [ms]',title)
call pglabel('offset (m)','time (ms)',title)
else
call pglabel('offset [m]','time [ms]',' ')
call pglabel('offset (m)','time (ms)',' ')
endif
call pgsch(pg_ch)
call pgswin(xmin,xmax,tmin,tmax)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment