├── !LinSlipInv.inputoutputfiles.docx ├── LICENSE ├── README.md ├── examples ├── LAquila-realdata │ ├── 3D_GFs_topo_3D_GPS │ │ ├── NEZsor.dat │ │ ├── NEZsor.mu │ │ ├── NEZsor.mu.gp │ │ └── sources.dat │ ├── SlipInvSVD.in │ ├── convert2srcmod.py │ ├── crustal.dat │ ├── data │ │ ├── ANT_.txt │ │ ├── AQG_.txt │ │ ├── AQU_.txt │ │ ├── CADO.10hz.nev │ │ ├── CLN_.txt │ │ ├── FMG_.txt │ │ ├── GSA_.txt │ │ ├── MTR_.txt │ │ ├── ROIO.10hz.nev │ │ ├── filters.for │ │ ├── processseis.f90 │ │ ├── processseis.in │ │ └── processseis.sh │ ├── input.dat │ ├── results.NNLS │ │ ├── SlipInv-seisplot_1DGFs.ps │ │ ├── SlipInv-seisplot_3DGFs.ps │ │ ├── mtilde2anime_3DGFs.ps │ │ ├── slipratesonfault_1DGFs.ps │ │ └── slipratesonfault_3DGFs.ps │ ├── stainfo.dat │ ├── stations.in │ └── stations.txt ├── README.md └── SIV1a │ ├── Description_inv1_updated.pdf │ ├── SlipInvSVD.in │ ├── crustal.dat │ ├── input.dat │ ├── results.NNLS │ ├── SlipInv-seisplot.ps │ ├── mtilde2anime.ps │ └── slipratesonfault.ps │ ├── rvseise.dat │ ├── rvseisn.dat │ ├── rvseisz.dat │ ├── stainfo.dat │ └── stations.dat ├── papers ├── 2010JB007814.pdf ├── JGRB50953.pdf └── README.md ├── src-dwn ├── README.md ├── calculate.sh ├── cnv_nez.for ├── dimen1.inc ├── dimen2.inc ├── firststep.sh ├── gr_nez.for ├── param.inc ├── prepare.f90 ├── resort.f90 └── sources.gp ├── src-graphics ├── README.md ├── SlipInv-seisplot.f90 ├── SlipInv-seisplot.sh ├── mtilde2anime.f90 ├── mtilde2anime.sh ├── slipratesonfault.f90 └── slipratesonfault.sh ├── src-stations ├── README.md ├── stations.f90 └── stations.sh └── src ├── CreateGandD.f90 ├── OutputModel.f90 ├── README.md ├── SlipInvNNLS.f90 ├── SlipInvSVD1.f90 ├── SlipInvSVD2.f90 ├── compile.SlipInvNNLS.sh ├── compile.SlipInvSVD.sh ├── dc3dmodif.f ├── filters.for ├── init.f90 ├── nnls.f90 ├── nnlsmkl.c ├── nnlsmkl.h └── nr.for /!LinSlipInv.inputoutputfiles.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/!LinSlipInv.inputoutputfiles.docx -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | #LinSlipInv 2 | ----------- 3 | 4 | Linear multi time-window earthquake slip inversion with *k*-2 smoothing 5 | 6 | Suite of codes for linear slip inversions and resolution analysis. 7 | 8 | ####Capabilities of the codes: 9 | - Inversion of provided data for a given (possibly segmented) fault geometry 10 | - Resolution analysis by means of synthetic tests with prescribed target rupture model or slip-rate pulse model 11 | - Inversion in-depth analysis by means of spectral analysis of the forward matrix **G** 12 | - Can take advantage of Intel MKL library and/or CULA (GPU) for faster performance 13 | - Plotting the results 14 | 15 | ####Possible data types for inversions: 16 | - Seismic waveforms including processed HR-GPS 17 | - Static GPS vectors 18 | 19 | ####Implemented regularizations of the inversion: 20 | - Truncated SVD 21 | - Spatial *k*-2 prior covariance function 22 | - Positivity constraint on the slip rate functions 23 | 24 | ####Included codes for evaluation of Green's functions: 25 | - Axitra (full-wavefield in 1D layered media) 26 | - Okada (static displacements in homogeneous halfspace) 27 | 28 | ------------ 29 | 30 | ###Content of directories: 31 | - `src` - Inversion codes 32 | - `src-stations` - Converts stations locations from lat,long to X,Y (X points towards north, Y towards east) 33 | - `src-dwn` - Axitra code for Green's function calculations 34 | - `src-graphics` - Codes for generating graphics (requires Gnuplot) 35 | - `examples` - Several examples for testing the code 36 | - `papers` - Papers related to the inversion codes, explaining basics of the SVD and NNLS approaches, resolution analysis, etc. 37 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/3D_GFs_topo_3D_GPS/NEZsor.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/examples/LAquila-realdata/3D_GFs_topo_3D_GPS/NEZsor.dat -------------------------------------------------------------------------------- /examples/LAquila-realdata/3D_GFs_topo_3D_GPS/NEZsor.mu: -------------------------------------------------------------------------------- 1 | 0.31454E+11 0.32233E+11 0.33227E+11 0.34417E+11 0.35576E+11 0.36136E+11 0.35711E+11 0.35367E+11 0.35071E+11 0.34867E+11 0.34756E+11 0.34437E+11 0.33155E+11 0.32020E+11 0.31054E+11 0.30247E+11 0.29588E+11 0.29060E+11 0.28717E+11 0.28946E+11 2 | 0.30393E+11 0.31582E+11 0.33028E+11 0.34422E+11 0.35867E+11 0.37325E+11 0.37290E+11 0.36795E+11 0.36395E+11 0.36090E+11 0.35815E+11 0.34777E+11 0.33549E+11 0.32515E+11 0.31589E+11 0.30769E+11 0.30051E+11 0.29442E+11 0.29168E+11 0.29547E+11 3 | 0.28697E+11 0.30274E+11 0.31965E+11 0.33592E+11 0.35311E+11 0.37160E+11 0.38172E+11 0.37502E+11 0.36931E+11 0.36473E+11 0.35837E+11 0.35048E+11 0.34194E+11 0.33366E+11 0.32587E+11 0.31814E+11 0.31047E+11 0.30424E+11 0.30209E+11 0.30074E+11 4 | 0.27724E+11 0.29344E+11 0.31012E+11 0.32645E+11 0.34249E+11 0.35882E+11 0.37260E+11 0.37139E+11 0.36526E+11 0.36105E+11 0.35676E+11 0.35162E+11 0.34496E+11 0.33745E+11 0.33148E+11 0.32557E+11 0.32079E+11 0.31867E+11 0.31624E+11 0.31312E+11 5 | 0.29057E+11 0.30072E+11 0.31382E+11 0.32514E+11 0.33447E+11 0.34164E+11 0.34654E+11 0.34719E+11 0.34588E+11 0.34830E+11 0.34655E+11 0.34061E+11 0.33062E+11 0.31723E+11 0.31039E+11 0.31176E+11 0.31782E+11 0.32413E+11 0.32742E+11 0.32762E+11 6 | 0.31568E+11 0.32104E+11 0.32908E+11 0.33403E+11 0.33542E+11 0.33321E+11 0.32758E+11 0.32096E+11 0.33045E+11 0.33733E+11 0.33700E+11 0.32957E+11 0.31526E+11 0.29475E+11 0.27445E+11 0.28460E+11 0.30294E+11 0.31804E+11 0.32893E+11 0.33344E+11 7 | 0.33639E+11 0.34251E+11 0.34689E+11 0.34719E+11 0.34342E+11 0.33565E+11 0.32412E+11 0.32129E+11 0.32727E+11 0.33494E+11 0.33473E+11 0.32624E+11 0.30998E+11 0.28685E+11 0.26348E+11 0.27153E+11 0.29624E+11 0.31678E+11 0.33194E+11 0.34150E+11 8 | 0.35109E+11 0.35825E+11 0.36284E+11 0.36066E+11 0.35427E+11 0.34417E+11 0.33466E+11 0.32993E+11 0.32870E+11 0.33204E+11 0.33134E+11 0.32315E+11 0.30791E+11 0.28777E+11 0.27528E+11 0.27229E+11 0.29586E+11 0.31983E+11 0.34001E+11 0.35577E+11 9 | 0.35629E+11 0.36422E+11 0.37133E+11 0.36989E+11 0.36262E+11 0.35150E+11 0.34142E+11 0.33274E+11 0.32534E+11 0.32101E+11 0.32028E+11 0.31398E+11 0.30211E+11 0.29150E+11 0.28512E+11 0.28094E+11 0.29086E+11 0.31564E+11 0.33763E+11 0.35755E+11 10 | 0.33728E+11 0.34608E+11 0.35555E+11 0.36171E+11 0.35504E+11 0.34176E+11 0.33005E+11 0.31980E+11 0.31108E+11 0.30406E+11 0.30278E+11 0.30233E+11 0.29844E+11 0.29448E+11 0.28998E+11 0.28494E+11 0.28085E+11 0.29450E+11 0.31049E+11 0.32527E+11 11 | 0.31405E+11 0.32415E+11 0.33548E+11 0.35007E+11 0.34179E+11 0.32643E+11 0.31356E+11 0.30300E+11 0.29455E+11 0.28807E+11 0.28465E+11 0.28901E+11 0.29093E+11 0.28997E+11 0.28620E+11 0.27973E+11 0.27102E+11 0.26689E+11 0.27534E+11 0.28562E+11 12 | 0.28315E+11 0.29024E+11 0.30061E+11 0.30437E+11 0.30169E+11 0.29228E+11 0.28296E+11 0.27610E+11 0.26996E+11 0.26474E+11 0.26082E+11 0.26289E+11 0.26837E+11 0.26970E+11 0.26682E+11 0.25988E+11 0.24908E+11 0.23584E+11 0.24025E+11 0.25169E+11 13 | 0.24411E+11 0.24391E+11 0.24265E+11 0.24052E+11 0.24009E+11 0.24081E+11 0.24053E+11 0.23894E+11 0.23608E+11 0.23214E+11 0.22846E+11 0.22649E+11 0.23126E+11 0.23404E+11 0.23249E+11 0.22669E+11 0.21687E+11 0.20656E+11 0.20685E+11 0.21753E+11 14 | 0.21079E+11 0.20422E+11 0.19825E+11 0.19546E+11 0.19511E+11 0.19809E+11 0.20277E+11 0.20525E+11 0.20477E+11 0.20212E+11 0.19909E+11 0.19548E+11 0.19569E+11 0.19958E+11 0.19935E+11 0.19495E+11 0.18822E+11 0.18436E+11 0.18132E+11 0.18634E+11 15 | 0.18501E+11 0.17766E+11 0.17287E+11 0.17058E+11 0.17064E+11 0.17324E+11 0.17838E+11 0.18170E+11 0.18117E+11 0.17860E+11 0.17575E+11 0.17264E+11 0.17024E+11 0.17303E+11 0.17530E+11 0.17514E+11 0.17540E+11 0.17567E+11 0.17388E+11 0.17253E+11 16 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/3D_GFs_topo_3D_GPS/NEZsor.mu.gp: -------------------------------------------------------------------------------- 1 | DL=1. 2 | DW=1. 3 | 4 | set palette defined ( 0 "white", 2 "skyblue", 3 "light-green", 6 "yellow", 10 "light-red" ) 5 | set xlabel 'Along strike (km)' 6 | set ylabel 'Up-dip (km)' 7 | set cblabel 'Mu (Pa)' 8 | 9 | plot 'NEZsor.mu' matrix u ($1*DL+DL/2.):($2*DW+DW/2.):3 w image 10 | 11 | pause -1 12 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/3D_GFs_topo_3D_GPS/sources.dat: -------------------------------------------------------------------------------- 1 | 000001 0.27671E+01 -0.52587E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 2 | 000002 0.20011E+01 -0.46160E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 3 | 000003 0.12350E+01 -0.39732E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 4 | 000004 0.46900E+00 -0.33304E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 5 | 000005 -0.29705E+00 -0.26876E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 6 | 000006 -0.10631E+01 -0.20448E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 7 | 000007 -0.18291E+01 -0.14020E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 8 | 000008 -0.25952E+01 -0.75923E+00 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 9 | 000009 -0.33612E+01 -0.11644E+00 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 10 | 000010 -0.41273E+01 0.52634E+00 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 11 | 000011 -0.48933E+01 0.11691E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 12 | 000012 -0.56594E+01 0.18119E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 13 | 000013 -0.64254E+01 0.24547E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 14 | 000014 -0.71914E+01 0.30975E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 15 | 000015 -0.79575E+01 0.37403E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 16 | 000016 -0.87235E+01 0.43831E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 17 | 000017 -0.94896E+01 0.50259E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 18 | 000018 -0.10256E+02 0.56686E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 19 | 000019 -0.11022E+02 0.63114E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 20 | 000020 -0.11788E+02 0.69542E+01 0.11481E+02 0.14000E+03 0.50000E+02 -0.90000E+02 21 | 000021 0.31803E+01 -0.47663E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 22 | 000022 0.24143E+01 -0.41236E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 23 | 000023 0.16482E+01 -0.34808E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 24 | 000024 0.88217E+00 -0.28380E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 25 | 000025 0.11613E+00 -0.21952E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 26 | 000026 -0.64992E+00 -0.15524E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 27 | 000027 -0.14160E+01 -0.90962E+00 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 28 | 000028 -0.21820E+01 -0.26683E+00 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 29 | 000029 -0.29481E+01 0.37596E+00 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 30 | 000030 -0.37141E+01 0.10187E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 31 | 000031 -0.44801E+01 0.16615E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 32 | 000032 -0.52462E+01 0.23043E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 33 | 000033 -0.60122E+01 0.29471E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 34 | 000034 -0.67783E+01 0.35899E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 35 | 000035 -0.75443E+01 0.42327E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 36 | 000036 -0.83104E+01 0.48755E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 37 | 000037 -0.90764E+01 0.55183E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 38 | 000038 -0.98425E+01 0.61610E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 39 | 000039 -0.10608E+02 0.68038E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 40 | 000040 -0.11375E+02 0.74466E+01 0.10715E+02 0.14000E+03 0.50000E+02 -0.90000E+02 41 | 000041 0.35935E+01 -0.42739E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 42 | 000042 0.28274E+01 -0.36312E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 43 | 000043 0.20614E+01 -0.29884E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 44 | 000044 0.12953E+01 -0.23456E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 45 | 000045 0.52930E+00 -0.17028E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 46 | 000046 -0.23674E+00 -0.10600E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 47 | 000047 -0.10028E+01 -0.41721E+00 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 48 | 000048 -0.17688E+01 0.22558E+00 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 49 | 000049 -0.25349E+01 0.86836E+00 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 50 | 000050 -0.33009E+01 0.15112E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 51 | 000051 -0.40670E+01 0.21539E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 52 | 000052 -0.48330E+01 0.27967E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 53 | 000053 -0.55991E+01 0.34395E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 54 | 000054 -0.63651E+01 0.40823E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 55 | 000055 -0.71311E+01 0.47251E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 56 | 000056 -0.78972E+01 0.53679E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 57 | 000057 -0.86632E+01 0.60107E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 58 | 000058 -0.94293E+01 0.66535E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 59 | 000059 -0.10195E+02 0.72962E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 60 | 000060 -0.10961E+02 0.79390E+01 0.99491E+01 0.14000E+03 0.50000E+02 -0.90000E+02 61 | 000061 0.40067E+01 -0.37815E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 62 | 000062 0.32406E+01 -0.31387E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 63 | 000063 0.24746E+01 -0.24960E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 64 | 000064 0.17085E+01 -0.18532E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 65 | 000065 0.94248E+00 -0.12104E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 66 | 000066 0.17643E+00 -0.56760E+00 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 67 | 000067 -0.58961E+00 0.75192E-01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 68 | 000068 -0.13557E+01 0.71798E+00 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 69 | 000069 -0.21217E+01 0.13608E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 70 | 000070 -0.28877E+01 0.20036E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 71 | 000071 -0.36538E+01 0.26463E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 72 | 000072 -0.44198E+01 0.32891E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 73 | 000073 -0.51859E+01 0.39319E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 74 | 000074 -0.59519E+01 0.45747E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 75 | 000075 -0.67180E+01 0.52175E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 76 | 000076 -0.74840E+01 0.58603E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 77 | 000077 -0.82501E+01 0.65031E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 78 | 000078 -0.90161E+01 0.71459E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 79 | 000079 -0.97821E+01 0.77886E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 80 | 000080 -0.10548E+02 0.84314E+01 0.91830E+01 0.14000E+03 0.50000E+02 -0.90000E+02 81 | 000081 0.44198E+01 -0.32891E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 82 | 000082 0.36538E+01 -0.26463E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 83 | 000083 0.28877E+01 -0.20036E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 84 | 000084 0.21217E+01 -0.13608E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 85 | 000085 0.13557E+01 -0.71798E+00 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 86 | 000086 0.58961E+00 -0.75192E-01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 87 | 000087 -0.17643E+00 0.56760E+00 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 88 | 000088 -0.94248E+00 0.12104E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 89 | 000089 -0.17085E+01 0.18532E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 90 | 000090 -0.24746E+01 0.24960E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 91 | 000091 -0.32406E+01 0.31387E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 92 | 000092 -0.40067E+01 0.37815E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 93 | 000093 -0.47727E+01 0.44243E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 94 | 000094 -0.55387E+01 0.50671E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 95 | 000095 -0.63048E+01 0.57099E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 96 | 000096 -0.70708E+01 0.63527E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 97 | 000097 -0.78369E+01 0.69955E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 98 | 000098 -0.86029E+01 0.76383E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 99 | 000099 -0.93690E+01 0.82810E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 100 | 000100 -0.10135E+02 0.89238E+01 0.84170E+01 0.14000E+03 0.50000E+02 -0.90000E+02 101 | 000101 0.48330E+01 -0.27967E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 102 | 000102 0.40670E+01 -0.21539E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 103 | 000103 0.33009E+01 -0.15112E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 104 | 000104 0.25349E+01 -0.86836E+00 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 105 | 000105 0.17688E+01 -0.22558E+00 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 106 | 000106 0.10028E+01 0.41721E+00 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 107 | 000107 0.23674E+00 0.10600E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 108 | 000108 -0.52930E+00 0.17028E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 109 | 000109 -0.12953E+01 0.23456E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 110 | 000110 -0.20614E+01 0.29884E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 111 | 000111 -0.28274E+01 0.36312E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 112 | 000112 -0.35935E+01 0.42739E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 113 | 000113 -0.43595E+01 0.49167E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 114 | 000114 -0.51256E+01 0.55595E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 115 | 000115 -0.58916E+01 0.62023E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 116 | 000116 -0.66577E+01 0.68451E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 117 | 000117 -0.74237E+01 0.74879E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 118 | 000118 -0.81897E+01 0.81307E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 119 | 000119 -0.89558E+01 0.87735E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 120 | 000120 -0.97218E+01 0.94162E+01 0.76509E+01 0.14000E+03 0.50000E+02 -0.90000E+02 121 | 000121 0.52462E+01 -0.23043E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 122 | 000122 0.44801E+01 -0.16615E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 123 | 000123 0.37141E+01 -0.10187E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 124 | 000124 0.29481E+01 -0.37596E+00 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 125 | 000125 0.21820E+01 0.26683E+00 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 126 | 000126 0.14160E+01 0.90962E+00 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 127 | 000127 0.64992E+00 0.15524E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 128 | 000128 -0.11613E+00 0.21952E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 129 | 000129 -0.88217E+00 0.28380E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 130 | 000130 -0.16482E+01 0.34808E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 131 | 000131 -0.24143E+01 0.41236E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 132 | 000132 -0.31803E+01 0.47663E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 133 | 000133 -0.39463E+01 0.54091E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 134 | 000134 -0.47124E+01 0.60519E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 135 | 000135 -0.54784E+01 0.66947E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 136 | 000136 -0.62445E+01 0.73375E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 137 | 000137 -0.70105E+01 0.79803E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 138 | 000138 -0.77766E+01 0.86231E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 139 | 000139 -0.85426E+01 0.92659E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 140 | 000140 -0.93087E+01 0.99086E+01 0.68849E+01 0.14000E+03 0.50000E+02 -0.90000E+02 141 | 000141 0.56594E+01 -0.18119E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 142 | 000142 0.48933E+01 -0.11691E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 143 | 000143 0.41273E+01 -0.52634E+00 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 144 | 000144 0.33612E+01 0.11644E+00 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 145 | 000145 0.25952E+01 0.75923E+00 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 146 | 000146 0.18291E+01 0.14020E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 147 | 000147 0.10631E+01 0.20448E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 148 | 000148 0.29705E+00 0.26876E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 149 | 000149 -0.46900E+00 0.33304E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 150 | 000150 -0.12350E+01 0.39732E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 151 | 000151 -0.20011E+01 0.46160E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 152 | 000152 -0.27671E+01 0.52587E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 153 | 000153 -0.35332E+01 0.59015E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 154 | 000154 -0.42992E+01 0.65443E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 155 | 000155 -0.50653E+01 0.71871E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 156 | 000156 -0.58313E+01 0.78299E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 157 | 000157 -0.65974E+01 0.84727E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 158 | 000158 -0.73634E+01 0.91155E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 159 | 000159 -0.81294E+01 0.97583E+01 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 160 | 000160 -0.88955E+01 0.10401E+02 0.61188E+01 0.14000E+03 0.50000E+02 -0.90000E+02 161 | 000161 0.60725E+01 -0.13195E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 162 | 000162 0.53065E+01 -0.67673E+00 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 163 | 000163 0.45404E+01 -0.33939E-01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 164 | 000164 0.37744E+01 0.60885E+00 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 165 | 000165 0.30084E+01 0.12516E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 166 | 000166 0.22423E+01 0.18944E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 167 | 000167 0.14763E+01 0.25372E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 168 | 000168 0.71023E+00 0.31800E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 169 | 000169 -0.55819E-01 0.38228E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 170 | 000170 -0.82186E+00 0.44656E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 171 | 000171 -0.15879E+01 0.51084E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 172 | 000172 -0.23540E+01 0.57511E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 173 | 000173 -0.31200E+01 0.63939E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 174 | 000174 -0.38860E+01 0.70367E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 175 | 000175 -0.46521E+01 0.76795E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 176 | 000176 -0.54181E+01 0.83223E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 177 | 000177 -0.61842E+01 0.89651E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 178 | 000178 -0.69502E+01 0.96079E+01 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 179 | 000179 -0.77163E+01 0.10251E+02 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 180 | 000180 -0.84823E+01 0.10893E+02 0.53528E+01 0.14000E+03 0.50000E+02 -0.90000E+02 181 | 000181 0.64857E+01 -0.82711E+00 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 182 | 000182 0.57197E+01 -0.18432E+00 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 183 | 000183 0.49536E+01 0.45846E+00 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 184 | 000184 0.41876E+01 0.11013E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 185 | 000185 0.34215E+01 0.17440E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 186 | 000186 0.26555E+01 0.23868E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 187 | 000187 0.18894E+01 0.30296E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 188 | 000188 0.11234E+01 0.36724E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 189 | 000189 0.35736E+00 0.43152E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 190 | 000190 -0.40869E+00 0.49580E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 191 | 000191 -0.11747E+01 0.56008E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 192 | 000192 -0.19408E+01 0.62436E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 193 | 000193 -0.27068E+01 0.68863E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 194 | 000194 -0.34729E+01 0.75291E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 195 | 000195 -0.42389E+01 0.81719E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 196 | 000196 -0.50050E+01 0.88147E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 197 | 000197 -0.57710E+01 0.94575E+01 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 198 | 000198 -0.65370E+01 0.10100E+02 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 199 | 000199 -0.73031E+01 0.10743E+02 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 200 | 000200 -0.80691E+01 0.11386E+02 0.45868E+01 0.14000E+03 0.50000E+02 -0.90000E+02 201 | 000201 0.68989E+01 -0.33471E+00 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 202 | 000202 0.61328E+01 0.30808E+00 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 203 | 000203 0.53668E+01 0.95087E+00 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 204 | 000204 0.46008E+01 0.15937E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 205 | 000205 0.38347E+01 0.22364E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 206 | 000206 0.30687E+01 0.28792E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 207 | 000207 0.23026E+01 0.35220E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 208 | 000208 0.15366E+01 0.41648E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 209 | 000209 0.77053E+00 0.48076E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 210 | 000210 0.44880E-02 0.54504E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 211 | 000211 -0.76156E+00 0.60932E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 212 | 000212 -0.15276E+01 0.67360E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 213 | 000213 -0.22936E+01 0.73787E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 214 | 000214 -0.30597E+01 0.80215E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 215 | 000215 -0.38257E+01 0.86643E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 216 | 000216 -0.45918E+01 0.93071E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 217 | 000217 -0.53578E+01 0.99499E+01 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 218 | 000218 -0.61239E+01 0.10593E+02 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 219 | 000219 -0.68899E+01 0.11235E+02 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 220 | 000220 -0.76560E+01 0.11878E+02 0.38207E+01 0.14000E+03 0.50000E+02 -0.90000E+02 221 | 000221 0.73121E+01 0.15770E+00 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 222 | 000222 0.65460E+01 0.80048E+00 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 223 | 000223 0.57800E+01 0.14433E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 224 | 000224 0.50139E+01 0.20861E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 225 | 000225 0.42479E+01 0.27288E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 226 | 000226 0.34818E+01 0.33716E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 227 | 000227 0.27158E+01 0.40144E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 228 | 000228 0.19498E+01 0.46572E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 229 | 000229 0.11837E+01 0.53000E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 230 | 000230 0.41766E+00 0.59428E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 231 | 000231 -0.34838E+00 0.65856E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 232 | 000232 -0.11144E+01 0.72284E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 233 | 000233 -0.18805E+01 0.78711E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 234 | 000234 -0.26465E+01 0.85139E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 235 | 000235 -0.34126E+01 0.91567E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 236 | 000236 -0.41786E+01 0.97995E+01 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 237 | 000237 -0.49446E+01 0.10442E+02 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 238 | 000238 -0.57107E+01 0.11085E+02 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 239 | 000239 -0.64767E+01 0.11728E+02 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 240 | 000240 -0.72428E+01 0.12371E+02 0.30547E+01 0.14000E+03 0.50000E+02 -0.90000E+02 241 | 000241 0.77252E+01 0.65010E+00 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 242 | 000242 0.69592E+01 0.12929E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 243 | 000243 0.61932E+01 0.19357E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 244 | 000244 0.54271E+01 0.25785E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 245 | 000245 0.46611E+01 0.32213E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 246 | 000246 0.38950E+01 0.38640E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 247 | 000247 0.31290E+01 0.45068E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 248 | 000248 0.23629E+01 0.51496E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 249 | 000249 0.15969E+01 0.57924E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 250 | 000250 0.83084E+00 0.64352E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 251 | 000251 0.64796E-01 0.70780E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 252 | 000252 -0.70125E+00 0.77208E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 253 | 000253 -0.14673E+01 0.83636E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 254 | 000254 -0.22333E+01 0.90063E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 255 | 000255 -0.29994E+01 0.96491E+01 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 256 | 000256 -0.37654E+01 0.10292E+02 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 257 | 000257 -0.45315E+01 0.10935E+02 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 258 | 000258 -0.52975E+01 0.11577E+02 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 259 | 000259 -0.60636E+01 0.12220E+02 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 260 | 000260 -0.68296E+01 0.12863E+02 0.22886E+01 0.14000E+03 0.50000E+02 -0.90000E+02 261 | 000261 0.81384E+01 0.11425E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 262 | 000262 0.73724E+01 0.17853E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 263 | 000263 0.66063E+01 0.24281E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 264 | 000264 0.58403E+01 0.30709E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 265 | 000265 0.50742E+01 0.37137E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 266 | 000266 0.43082E+01 0.43564E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 267 | 000267 0.35421E+01 0.49992E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 268 | 000268 0.27761E+01 0.56420E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 269 | 000269 0.20101E+01 0.62848E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 270 | 000270 0.12440E+01 0.69276E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 271 | 000271 0.47797E+00 0.75704E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 272 | 000272 -0.28807E+00 0.82132E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 273 | 000273 -0.10541E+01 0.88560E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 274 | 000274 -0.18202E+01 0.94987E+01 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 275 | 000275 -0.25862E+01 0.10142E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 276 | 000276 -0.33523E+01 0.10784E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 277 | 000277 -0.41183E+01 0.11427E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 278 | 000278 -0.48843E+01 0.12070E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 279 | 000279 -0.56504E+01 0.12713E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 280 | 000280 -0.64164E+01 0.13355E+02 0.15226E+01 0.14000E+03 0.50000E+02 -0.90000E+02 281 | 000281 0.85516E+01 0.16349E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 282 | 000282 0.77855E+01 0.22777E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 283 | 000283 0.70195E+01 0.29205E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 284 | 000284 0.62535E+01 0.35633E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 285 | 000285 0.54874E+01 0.42061E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 286 | 000286 0.47214E+01 0.48488E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 287 | 000287 0.39553E+01 0.54916E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 288 | 000288 0.31893E+01 0.61344E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 289 | 000289 0.24232E+01 0.67772E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 290 | 000290 0.16572E+01 0.74200E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 291 | 000291 0.89115E+00 0.80628E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 292 | 000292 0.12510E+00 0.87056E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 293 | 000293 -0.64094E+00 0.93484E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 294 | 000294 -0.14070E+01 0.99911E+01 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 295 | 000295 -0.21730E+01 0.10634E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 296 | 000296 -0.29391E+01 0.11277E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 297 | 000297 -0.37051E+01 0.11920E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 298 | 000298 -0.44712E+01 0.12562E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 299 | 000299 -0.52372E+01 0.13205E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 300 | 000300 -0.60033E+01 0.13848E+02 0.75653E+00 0.14000E+03 0.50000E+02 -0.90000E+02 301 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/SlipInvSVD.in: -------------------------------------------------------------------------------- 1 | Data (1 = synthetic data, 0 = read from files, -1 = custom target model from a file) 2 | 0 3 | Std.dev for slip rate (0 = no smoothing), Std.dev for GF's, GPS weight, M0 constraint weight, Weight of additional constraint 4 | 1.d0 0.1 .1d0 1.d0 0.d0 5 | Station component weights (1=no distance distance-dependent weights, 2=distance-dependent approximated CD) 6 | 1 7 | Choice of use of eigenvectors (see further) 8 | 1 9 | 1: single minimum singular value, 2: defined min and max number of eigenvectors to be considered 10 | 10. 11 | Additional temporal shift (in sec) 12 | 1. 13 | Compact SVD (0=NO, 1=YES - then it is not possible to use ANNLS) 14 | 1 15 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/convert2srcmod.py: -------------------------------------------------------------------------------- 1 | from numpy import log10,sin,rad2deg,deg2rad,arctan2,sqrt,loadtxt 2 | import pyproj 3 | 4 | NAME="2009 L'Aquila" 5 | DATE='04/06/2009' 6 | REF='Gallovic et al. (2015)' 7 | EventTAG='s2009LAquilaGALLOVIC' 8 | origlat=42.339 9 | origlon=13.381 10 | 11 | out=open('srcmod.fsp', 'w') 12 | out.write('% ---------------------------------- FINITE-SOURCE RUPTURE MODEL --------------------------------\n') 13 | out.write('% \n') 14 | out.write('% Event: '+NAME+' '+DATE+' ['+REF+']\n') 15 | out.write('% EventTAG: '+EventTAG+'\n') 16 | out.write('% \n') 17 | 18 | # Read input.dat 19 | inputdat=open('input.dat','r') 20 | dum=inputdat.readline() 21 | dum=inputdat.readline() 22 | dum=inputdat.readline() 23 | T, TS=inputdat.readline().split()[0:2] 24 | T,TS=float(T),float(TS) 25 | dum=inputdat.readline() 26 | dum,NSeg=inputdat.readline().split() 27 | NSeg=int(NSeg) 28 | dum=inputdat.readline() 29 | NRseis,NRgps=inputdat.readline().split() 30 | dum=inputdat.readline() 31 | NLW=inputdat.readline().split() 32 | NL=[int(x) for x in NLW[0::2]] 33 | NW=[int(x) for x in NLW[1::2]] 34 | dum=inputdat.readline() 35 | M0=inputdat.readline().strip() 36 | Mw=log10(float(M0))/1.5-6.07 37 | dum=inputdat.readline() 38 | SDR=inputdat.readline().split() 39 | strike=[float(x) for x in SDR[0::3]] 40 | dip=[float(x) for x in SDR[1::3]] 41 | rake=[float(x) for x in SDR[2::3]] 42 | dum=inputdat.readline() 43 | hypodepth=[float(x)/1.e3 for x in inputdat.readline().split()] 44 | dum=inputdat.readline() 45 | lengwidt=inputdat.readline().split() 46 | leng=[float(x)/1.e3 for x in lengwidt[0::2]] 47 | widt=[float(x)/1.e3 for x in lengwidt[1::2]] 48 | Dx=[leng[i]/float(NL[i]) for i in range(NSeg)] 49 | Dz=[widt[i]/float(NW[i]) for i in range(NSeg)] 50 | dum=inputdat.readline() 51 | epicLW=inputdat.readline().split() 52 | epicL=[float(x)/1.e3 for x in epicLW[0::2]] 53 | epicW=[float(x)/1.e3 for x in epicLW[1::2]] 54 | Htop=[hypodepth[i]-sin(deg2rad(dip[i]))*(widt[i]-epicW[i]) for i in range(NSeg)] 55 | dum=inputdat.readline() 56 | np=int(inputdat.readline()) 57 | dt=T/float(np) 58 | Ssvd=int(TS/dt+1.) 59 | dum=inputdat.readline() 60 | dum=inputdat.readline() 61 | dum=inputdat.readline() 62 | dum=inputdat.readline() 63 | f1,f2=inputdat.readline().split() 64 | 65 | seg=0 #so far saving only the first segment!!!! 66 | out.write('% Loc : LAT = '+str(origlat)+'\t LON = '+str(origlon)+'\t DEP = '+str(hypodepth[seg])+' km\n') 67 | out.write('% Size : LEN = '+str(leng[seg])+' km\t WID = '+str(widt[seg])+' km\t Mw = '+str(Mw)+'\t Mo = '+M0+' Nm\n') 68 | out.write('% Mech : STRK = '+str(strike[seg])+' \t DIP = '+str(dip[seg])+' \t RAKE = '+str(rake[seg])+' \t Htop = '+str(Htop[seg])+' km\n') 69 | out.write('% Rupt : HypX = '+str(epicL[seg])+' km\t HypZ = '+str(epicW[seg])+' km\t avTr = -99.0 s\t avVr = -99.0 km/s') 70 | 71 | out.writelines(""" 72 | % 73 | % ---------------------------------- inversion-related parameters -------------------------------- 74 | % 75 | """) 76 | 77 | out.write('% Invs : Nx = '+str(NL[seg])+' \t Nz = '+str(NW[seg])+'\t Fmin = '+f1+' Hz\t Fmax = '+f2+' Hz\n') 78 | out.write('% Invs : Dx = '+str(Dx[seg])+' km\t Dz = '+str(Dz[seg])+' km\n') 79 | out.write('% Invs : Ntw = '+str(Ssvd)+' \t Nsg = '+str(NSeg)+'\t \t \t (# of time-windows,# of fault segments)\n') 80 | out.write('% Invs : LEN = '+str(dt)+' s \t SHF = '+str(dt)+' s\t \t \t (time-window length and time-shift)\n') 81 | out.write('% SVF : delta \t \t \t \t \t (type of slip-velocity function used)\n') 82 | out.write('% \n') 83 | out.write('% Data : \tSGM \tTELE \tTRIL \tLEVEL \tGPS \tINSAR \tSURF \tOTHER \tOther\n') 84 | out.write('% Data : \t'+NRseis+' \t0 \t0 \t0 \t'+NRgps+' \t0 \t0 \t0 \t0\n') 85 | out.write('% PHImx: 999 0 0 0 0 0 0 0 0\n') 86 | out.write('% Rmin : 999.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0\n') 87 | 88 | out.writelines("""% 89 | % -------------------------------------------------------------------------------------------------- 90 | % 91 | % VELOCITY-DENSITY STRUCTURE 92 | """) 93 | crustal=open('crustal.dat','r') 94 | dum=crustal.readline() 95 | dum=crustal.readline() 96 | Nlay=int(crustal.readline()) 97 | out.write('% No. of layers = '+str(Nlay)+' \n') 98 | out.write('% \n') 99 | out.write('%\tDEPTH\tP-VEL\tS-VEL\tDENS\tQp\tQs\n') 100 | out.write('% [km] [km/s] [km/s] [g/cm^3]\n') 101 | dum=crustal.readline() 102 | dum=crustal.readline() 103 | for i in range(Nlay): 104 | out.write('% '+crustal.readline()) 105 | 106 | out.writelines("""% 107 | % -------------------------------------------------------------------------------------------------- 108 | % % 11-Mar-2016 Frantisek Gallovic (gallovic@karel.troja.mff.cuni.cz) 109 | % -------------------------------------------------------------------------------------------------- 110 | % 111 | % SOURCE MODEL PARAMETERS 112 | """) 113 | out.write('% \tNsbfs = '+str(NL[seg]*NW[seg])+' subfaults\n') 114 | out.writelines("""% 115 | % X,Y,Z coordinates in km; SLIP in m 116 | % if applicable: RAKE in deg, RISE in s, TRUP in s, slip in each TW in m 117 | % 118 | % Coordinates are given for top-center of each subfault or segment: |'| 119 | % Origin of local coordinate system at epicenter: X (EW) = 0, Y (NS) = 0 120 | % LAT LON X==EW Y==NS Z SLIP """) 121 | for i in range(Ssvd): 122 | out.write(' TW'+str(i+1)+' rakeTW'+str(i+1)) 123 | out.write('\n% -------------------------------------------------------------------------------------------------- \n') 124 | sources=loadtxt('sources.dat') 125 | mtilde=loadtxt('mtilde.dat') 126 | g=pyproj.Geod(ellps='WGS84') 127 | #staN=12.25 128 | #staE=-0.5 129 | dist=sqrt(sources[:,1]**2+sources[:,2]**2)*1.e3 130 | az=rad2deg(arctan2(sources[:,2],sources[:,1])) 131 | for i in range(NL[seg]*NW[seg]): 132 | (sublon, sublat, backaz) = g.fwd(origlon,origlat,az[i],dist[i]) 133 | sr=mtilde[i*Ssvd:(i+1)*Ssvd]*dt 134 | dum=[sublat,sublon,sources[i,2],sources[i,1],sources[i,3],sr.sum()] 135 | for j in range(Ssvd): dum.append(sr[j]);dum.append(rake[seg]) 136 | out.write(' '.join(format(x, "8.4f") for x in dum)+'\n') 137 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/crustal.dat: -------------------------------------------------------------------------------- 1 | Crustal model (free format) AQA bez hornich vrstvicek 2 | number of layers 3 | 6 4 | Parameters of the layers 5 | depth of layer top(km) Vp(km/s) Vs(km/s) Rho(g/cm**3) Qp Qs 6 | 0.000 3.00 1.700 2.500 200. 100. 7 | 1.000 4.83 2.600 2.840 400. 200. 8 | 2.000 5.76 3.100 2.940 400. 200. 9 | 5.000 6.51 3.500 3.150 400. 200. 10 | 27.000 7.00 3.800 3.260 600. 300. 11 | 42.000 7.800 4.200 3.500 800. 400. 12 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/data/CADO.10hz.nev: -------------------------------------------------------------------------------- 1 | 0 0 0 0 2 | 0.100000023841858 0.19 -0.0099999999999999 0.149999999999999 3 | 0.199999988079071 0.17 0 0.0199999999999996 4 | 0.300000011920929 0.2 -0.0499999999999999 0.449999999999999 5 | 0.399999976158142 0.12 -0.0399999999999999 0.22 6 | 0.5 0.25 -0.0399999999999999 0.29 7 | 0.600000023841858 0.0900000000000003 -0.0099999999999999 0.33 8 | 0.699999988079071 0.29 -0.0099999999999999 0.41 9 | 0.800000011920929 0.18 -0.0199999999999999 0.42 10 | 0.899999976158142 0.17 -0.1 0.13 11 | 1 0.0900000000000003 -0.0399999999999999 0.199999999999999 12 | 1.10000002384186 0.04 -0.15 0.55 13 | 1.19999998807907 -0.0499999999999998 -0.08 0.49 14 | 1.30000001192093 -0.12 -0.0199999999999999 0.64 15 | 1.39999997615814 0.04 -0.0099999999999999 0.279999999999999 16 | 1.5 0.0699999999999998 -0.12 0.46 17 | 1.60000002384186 0.02 -0.0099999999999999 0.47 18 | 1.69999998807907 0.36 -0.1 0.58 19 | 1.80000001192093 -0.0499999999999998 0.04 0.39 20 | 1.89999997615814 0.19 0.0600000000000001 0.13 21 | 2 0.31 0.01 0.54 22 | 2.10000002384186 0.0800000000000001 0.3 0.42 23 | 2.19999998807907 -0.00999999999999979 0.17 0.359999999999999 24 | 2.30000001192093 0 0.3 0.739999999999999 25 | 2.39999997615814 0.0100000000000002 0.19 0.87 26 | 2.5 -0.0499999999999998 0.27 0.63 27 | 2.60000002384186 -0.04 0.19 0.67 28 | 2.69999998807907 -0.1 0.32 0.859999999999999 29 | 2.80000001192093 -0.19 0.24 0.59 30 | 2.89999997615814 -0.15 0.28 1.02 31 | 3 -0.26 0.38 0.84 32 | 3.10000002384186 -0.26 0.24 1.15 33 | 3.19999998807907 -0.32 0.25 0.85 34 | 3.30000001192093 -0.19 0.26 1 35 | 3.39999997615814 -0.41 0.37 0.819999999999999 36 | 3.5 -0.35 0.22 1.14 37 | 3.60000002384186 -0.19 0.24 0.949999999999999 38 | 3.69999998807907 -0.55 0.22 0.5 39 | 3.80000001192093 -0.18 0.17 1.2 40 | 3.89999997615814 -0.67 0.14 0.6 41 | 4 -0.3 0.19 1.26 42 | 4.10000002384186 -0.47 0.18 0.92 43 | 4.19999998807907 -0.41 0.23 1.11 44 | 4.30000001192093 -0.41 0.1 1 45 | 4.39999997615814 -0.59 0.16 1.02 46 | 4.5 -0.44 0.15 1.1 47 | 4.60000002384186 -0.5 0.25 0.8 48 | 4.69999998807907 -0.55 0.0800000000000001 1.15 49 | 4.80000001192093 -0.47 0.03 1 50 | 4.89999997615814 -0.68 0.05 0.68 51 | 5 -0.63 0.11 1.29 52 | 5.10000002384186 -0.81 0.03 0.75 53 | 5.19999998807907 -0.52 0.1 1.16 54 | 5.30000001192093 -0.49 0.11 0.89 55 | 5.39999997615814 -0.49 0.17 1.05 56 | 5.5 -0.69 0.21 1.12 57 | 5.60000002384186 -0.58 0.24 0.69 58 | 5.69999998807907 -0.67 0.21 0.859999999999999 59 | 5.80000001192093 -0.48 0.37 0.85 60 | 5.89999997615814 -0.49 0.31 1.06 61 | 6 -0.67 0.31 0.739999999999999 62 | 6.10000002384186 -0.63 0.23 1.05 63 | 6.19999998807907 -0.63 0.12 1.15 64 | 6.30000001192093 -0.66 0.26 1.06 65 | 6.39999997615814 -0.69 0.21 0.85 66 | 6.5 -0.55 0.4 0.97 67 | 6.60000002384186 -0.62 0.26 1.11 68 | 6.69999998807907 -0.35 0.21 0.98 69 | 6.80000001192093 -0.64 0.01 0.859999999999999 70 | 6.89999997615814 -0.57 0.03 0.98 71 | 7 -0.37 0 0.76 72 | 7.10000002384186 -0.47 -0.07 0.71 73 | 7.19999998807907 -0.56 -0.0599999999999999 0.47 74 | 7.30000001192093 -0.56 -0.0399999999999999 0.67 75 | 7.39999997615814 -0.59 0.03 0.56 76 | 7.5 -0.54 0 0.369999999999999 77 | 7.60000002384186 -0.65 0.01 0.24 78 | 7.69999998807907 -0.71 -0.17 0.54 79 | 7.80000001192093 -0.43 -0.0399999999999999 0.449999999999999 80 | 7.89999997615814 -0.45 -0.0299999999999999 0.819999999999999 81 | 8 -0.63 0.01 0.55 82 | 8.10000002384186 -0.39 -0.0299999999999999 0.739999999999999 83 | 8.19999998807907 -0.56 0 0.76 84 | 8.30000001192093 -0.4 0.11 0.609999999999999 85 | 8.39999997615814 -0.36 -0.0399999999999999 0.48 86 | 8.5 -0.34 -0.0299999999999999 0.48 87 | 8.60000002384186 -0.3 0 0.27 88 | 8.69999998807907 -0.3 0.0600000000000001 0.46 89 | 8.80000001192093 -0.5 -0.0399999999999999 0.47 90 | 8.89999997615814 -0.17 0.0800000000000001 0.319999999999999 91 | 9 -0.47 -0.21 0.399999999999999 92 | 9.10000002384186 -0.54 -0.22 0.59 93 | 9.19999998807907 -0.4 -0.28 0.48 94 | 9.30000001192093 -0.49 -0.27 0.24 95 | 9.39999997615814 -0.41 -0.41 0.26 96 | 9.5 -0.39 -0.57 0.00999999999999979 97 | 9.60000002384186 -0.27 -0.59 0.12 98 | 9.69999998807907 -0.24 -0.79 0.19 99 | 9.80000001192093 -0.31 -0.93 -0.140000000000001 100 | 9.89999997615814 -0.32 -1.1 -0.16 101 | 10 -0.14 -1.25 0.00999999999999979 102 | 10.1000000238419 0.0300000000000002 -1.49 -0.12 103 | 10.1999999880791 -0.02 -1.89 -0.42 104 | 10.3000000119209 0.22 -2.28 -0.640000000000001 105 | 10.3999999761581 0.27 -2.23 -0.33 106 | 10.5 0.41 -2.33 -0.31 107 | 10.6000000238419 0.84 -2.47 -0.62 108 | 10.6999999880791 1.52 -2.74 -0.74 109 | 10.8000000119209 1.92 -3.34 -1.07 110 | 10.8999999761581 2.77 -4.31 -1.26 111 | 11 2.93 -4.6 -1.93 112 | 11.1000000238419 3.09 -4.83 -2.22 113 | 11.1999999880791 3.76 -4.9 -2.96 114 | 11.3000000119209 5.29 -3.26 -3.78 115 | 11.3999999761581 7.74 -1.16 -4.59 116 | 11.5 9.65 -0.7 -4.69 117 | 11.6000000238419 11.89 -0.95 -5.5 118 | 11.6999999880791 12.4 -1.56 -6.66 119 | 11.8000000119209 10.48 -2.32 -7.47 120 | 11.8999999761581 7.89 -3.65 -9.37 121 | 12 6.57 -2.82 -10.61 122 | 12.1000000238419 6.22 -3.39 -10.7 123 | 12.1999999880791 6.72 -5.77 -11.31 124 | 12.3000000119209 5.36 -7.95 -11.11 125 | 12.3999999761581 3.97 -10.84 -10.34 126 | 12.5 3.96 -14.8 -10.08 127 | 12.6000000238419 3.56 -14.86 -9.62 128 | 12.6999999880791 3 -11.33 -10.17 129 | 12.8000000119209 3.31 -9.34 -10.65 130 | 12.8999999761581 3.55 -7.1 -11.4 131 | 13 4.38 -5.62 -11.29 132 | 13.1000000238419 5.2 -6.69 -10.26 133 | 13.1999999880791 5.85 -10.3 -11.8 134 | 13.3000000119209 3.28 -12.65 -13.15 135 | 13.3999999761581 1.19 -15.11 -13.77 136 | 13.5 1.61 -14.7 -13.35 137 | 13.6000000238419 5.23 -12.21 -14.85 138 | 13.6999999880791 7.23 -10.02 -14.92 139 | 13.8000000119209 6.71 -9.22 -14.97 140 | 13.8999999761581 5.63 -10.42 -15.93 141 | 14 5.09 -12.96 -16.45 142 | 14.1000000238419 5.83 -12.7 -15.59 143 | 14.1999999880791 6.71 -10.57 -16.39 144 | 14.3000000119209 3.58 -11.75 -15.95 145 | 14.3999999761581 3.46 -10.05 -16.12 146 | 14.5 4.16 -6.23 -17.09 147 | 14.6000000238419 7.07 1.66 -17.5 148 | 14.6999999880791 11.63 6.39 -17.66 149 | 14.8000000119209 14.25 10.8 -15.83 150 | 14.8999999761581 15.95 11.77 -13.75 151 | 15 15.38 10.02 -12.37 152 | 15.1000000238419 10.95 4.15 -13.47 153 | 15.1999999880791 4.81 -4.34 -14.2 154 | 15.3000000119209 -0.44 -13.85 -13.36 155 | 15.3999999761581 -3.68 -19.74 -12.81 156 | 15.5 -6.63 -24.61 -11.49 157 | 15.6000000238419 -5.58 -23.82 -12.19 158 | 15.6999999880791 -1.15 -13.15 -13.28 159 | 15.8000000119209 3.53 -6.9 -14 160 | 15.8999999761581 5.57 -2.55 -14.2 161 | 16 11.95 6.17 -14.34 162 | 16.1000000238419 12.47 7.07 -13.37 163 | 16.1999999880791 11.44 4.66 -13.77 164 | 16.3000000119209 8.59 0.0600000000000001 -14 165 | 16.3999999761581 6.49 -5.83 -14.32 166 | 16.5 2.62 -12.04 -14.41 167 | 16.6000000238419 -0.12 -16.53 -12.76 168 | 16.6999999880791 1.59 -14.79 -13.25 169 | 16.8000000119209 4.75 -10.23 -13.18 170 | 16.8999999761581 2.69 -13.47 -12.59 171 | 17 1.81 -13.14 -12.98 172 | 17.1000000238419 6.11 -6.68 -12.79 173 | 17.1999999880791 5.55 -4.72 -12.34 174 | 17.3000000119209 5.74 -2.16 -12.79 175 | 17.3999999761581 5.78 -0.17 -11.83 176 | 17.5 5.21 -0.75 -12.44 177 | 17.6000000238419 4.47 -3.23 -13.8 178 | 17.6999999880791 2.92 -7.6 -13.54 179 | 17.8000000119209 1.44 -10.25 -13.13 180 | 17.8999999761581 0.42 -12.49 -13.44 181 | 18 -0.0899999999999999 -13 -13.14 182 | 18.1000000238419 1.78 -9.72 -12.84 183 | 18.1999999880791 4.32 -8.05 -12.94 184 | 18.3000000119209 3.49 -7.82 -14.42 185 | 18.3999999761581 5.58 -5.77 -13.92 186 | 18.5 4.66 -6.82 -14.18 187 | 18.6000000238419 4.69 -6.94 -14.09 188 | 18.6999999880791 4.72 -7.26 -14.83 189 | 18.8000000119209 5.02 -6.41 -14.56 190 | 18.8999999761581 4.95 -6.08 -14.88 191 | 19 4.94 -6.07 -14.24 192 | 19.1000000238419 4.57 -6.45 -14.59 193 | 19.1999999880791 4.5 -6.85 -13.71 194 | 19.3000000119209 4.37 -7.71 -13.78 195 | 19.3999999761581 4.02 -8.54 -13.5 196 | 19.5 3.32 -9.19 -13.75 197 | 19.6000000238419 3.07 -9.54 -14.03 198 | 19.6999999880791 3.31 -9.75 -13.86 199 | 19.8000000119209 3.14 -9.42 -13.72 200 | 19.8999999761581 3.7 -8.47 -14.21 201 | 20 4.62 -7.72 -13.83 202 | 20.1000000238419 5.48 -6.74 -14.15 203 | 20.1999999880791 5.49 -6.27 -14.07 204 | 20.3000000119209 5.65 -6.09 -14.1 205 | 20.3999999761581 5.32 -5.89 -14.04 206 | 20.5 5.51 -5.76 -13.43 207 | 20.6000000238419 4.66 -5.86 -13.66 208 | 20.6999999880791 4.48 -6.31 -13.67 209 | 20.8000000119209 3.29 -7.27 -14.2 210 | 20.8999999761581 3.55 -7.93 -13.85 211 | 21 2.9 -8.39 -14.22 212 | 21.1000000238419 3.24 -7.99 -13.85 213 | 21.1999999880791 3.73 -7.93 -14.23 214 | 21.3000000119209 4.18 -7.42 -13.92 215 | 21.3999999761581 4.57 -7.25 -14.19 216 | 21.5 4.44 -7.23 -14.32 217 | 21.6000000238419 4.83 -7.26 -13.91 218 | 21.6999999880791 4.61 -7.52 -13.89 219 | 21.8000000119209 4.72 -7.79 -13.56 220 | 21.8999999761581 4.62 -7.75 -14.31 221 | 22 4.3 -7.77 -14.1 222 | 22.1000000238419 4.22 -7.63 -14.04 223 | 22.1999999880791 4.21 -6.97 -14.11 224 | 22.3000000119209 4.29 -6.73 -14.06 225 | 22.3999999761581 4.71 -6.1 -13.72 226 | 22.5 5.08 -6.34 -14.11 227 | 22.6000000238419 5.26 -6.21 -14.13 228 | 22.6999999880791 5.4 -6.41 -13.84 229 | 22.8000000119209 5.4 -6.94 -14.2 230 | 22.8999999761581 5.53 -7.32 -14.02 231 | 23 5.52 -7.38 -13.97 232 | 23.1000000238419 5.59 -7.51 -14.16 233 | 23.1999999880791 4.96 -7.54 -14.12 234 | 23.3000000119209 4.8 -7.88 -14.57 235 | 23.3999999761581 4.2 -7.83 -14.14 236 | 23.5 4.06 -7.68 -14.72 237 | 23.6000000238419 4.35 -7.34 -14.45 238 | 23.6999999880791 5.05 -6.8 -14.6 239 | 23.8000000119209 4.88 -6.4 -14.64 240 | 23.8999999761581 4.94 -6.37 -14.26 241 | 24 4.95 -6.05 -14.7 242 | 24.1000000238419 4.92 -6.22 -14.91 243 | 24.1999999880791 4.51 -6.57 -15.25 244 | 24.3000000119209 4.51 -6.87 -15.2 245 | 24.3999999761581 4.21 -7.22 -14.93 246 | 24.5 4.29 -6.98 -14.9 247 | 24.6000000238419 4.11 -7.1 -14.7 248 | 24.6999999880791 4.35 -7.2 -14.79 249 | 24.8000000119209 4.29 -6.98 -14.63 250 | 24.8999999761581 4.25 -7.18 -14.43 251 | 25 4.23 -6.87 -14.46 252 | 25.1000000238419 4.25 -7.32 -14.59 253 | 25.1999999880791 4.17 -7.33 -14.42 254 | 25.3000000119209 4.21 -7.71 -14.14 255 | 25.3999999761581 4.06 -7.54 -14.66 256 | 25.5 4.41 -7.32 -14.53 257 | 25.6000000238419 4.51 -7.04 -14.75 258 | 25.6999999880791 4.77 -7.01 -14.65 259 | 25.8000000119209 4.92 -6.83 -14.69 260 | 25.8999999761581 4.78 -7.17 -14.87 261 | 26 4.46 -7.4 -15.25 262 | 26.1000000238419 4.04 -7.76 -14.87 263 | 26.1999999880791 4.25 -7.91 -14.87 264 | 26.3000000119209 4.33 -7.62 -15.23 265 | 26.3999999761581 4.33 -7.19 -15.44 266 | 26.5 4.62 -6.65 -15.39 267 | 26.6000000238419 4.58 -6.38 -15.07 268 | 26.6999999880791 4.54 -6.7 -14.45 269 | 26.8000000119209 4.26 -6.47 -14.92 270 | 26.8999999761581 4.09 -6.77 -14.64 271 | 27 3.85 -6.82 -14.65 272 | 27.1000000238419 3.47 -6.84 -14.41 273 | 27.1999999880791 3.29 -6.72 -14.84 274 | 27.3000000119209 3.88 -6.85 -14.74 275 | 27.3999999761581 3.65 -6.91 -14.8 276 | 27.5 4.1 -6.83 -14.89 277 | 27.6000000238419 4.31 -6.66 -14.8 278 | 27.6999999880791 4.19 -6.89 -14.87 279 | 27.8000000119209 4.27 -7.32 -14.82 280 | 27.8999999761581 3.98 -7.6 -14.57 281 | 28 4.27 -7.64 -14.49 282 | 28.1000000238419 3.58 -7.38 -14.51 283 | 28.1999999880791 3.7 -7.04 -14.4 284 | 28.3000000119209 3.65 -6.85 -14.53 285 | 28.3999999761581 3.75 -6.68 -14.42 286 | 28.5 3.94 -6.76 -14.69 287 | 28.6000000238419 3.98 -6.75 -14.33 288 | 28.6999999880791 3.81 -7.17 -14.22 289 | 28.8000000119209 3.66 -7.4 -14.21 290 | 28.8999999761581 3.6 -7.8 -14.1 291 | 29 3.64 -7.94 -14.31 292 | 29.1000000238419 3.61 -7.93 -14.24 293 | 29.1999999880791 3.94 -7.98 -14.21 294 | 29.3000000119209 4.23 -7.86 -14.01 295 | 29.3999999761581 4.27 -7.59 -13.7 296 | 29.5 4.4 -7.3 -14.13 297 | 29.6000000238419 4.02 -7.18 -14.08 298 | 29.6999999880791 4.38 -7.05 -14.15 299 | 29.8000000119209 4.41 -7.05 -13.9 300 | 29.8999999761581 4.21 -7.1 -14.18 301 | 30 4.33 -7.28 -14.71 302 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/data/ROIO.10hz.nev: -------------------------------------------------------------------------------- 1 | 0 0 0 0 2 | 0.100000023841858 -0.02 0.03 -0.0700000000000003 3 | 0.199999988079071 0.22 -0.0599999999999999 0.19 4 | 0.300000011920929 0.38 0.17 -0.04 5 | 0.399999976158142 0 -0.14 -0.00999999999999979 6 | 0.5 -0.0999999999999999 -0.0199999999999999 -0.00999999999999979 7 | 0.600000023841858 0.14 -0.0499999999999999 -0.13 8 | 0.699999988079071 -0.16 -0.0499999999999999 -0.0499999999999998 9 | 0.800000011920929 0.04 -0.16 -0.14 10 | 0.899999976158142 -0.0900000000000001 0.12 -0.0499999999999998 11 | 1 -0.0800000000000001 -0.14 -0.23 12 | 1.10000002384186 0.03 -0.14 0.19 13 | 1.19999998807907 0.17 -0.22 0.32 14 | 1.30000001192093 0.16 -0.0599999999999999 -0.0700000000000003 15 | 1.39999997615814 -0.05 -0.0599999999999999 -0.61 16 | 1.5 -0.0900000000000001 -0.12 -0.38 17 | 1.60000002384186 -0.0900000000000001 0.01 -0.47 18 | 1.69999998807907 0.14 -0.22 -0.0800000000000001 19 | 1.80000001192093 0.0900000000000001 -0.16 -0.350000000000001 20 | 1.89999997615814 -0.04 -0.15 -0.34 21 | 2 -0.31 -0.11 -0.59 22 | 2.10000002384186 -0.38 -0.08 -0.66 23 | 2.19999998807907 -0.56 -0.35 -0.840000000000001 24 | 2.30000001192093 -0.32 -0.32 -0.0999999999999996 25 | 2.39999997615814 -0.39 -0.26 -0.2 26 | 2.5 -0.52 -0.25 -0.27 27 | 2.60000002384186 -0.35 -0.3 -0.04 28 | 2.69999998807907 -0.44 -0.34 -0.12 29 | 2.80000001192093 -0.32 -0.37 -0.26 30 | 2.89999997615814 -0.37 -0.3 -0.0300000000000002 31 | 3 -0.46 -0.33 -0.0700000000000003 32 | 3.10000002384186 -0.0700000000000001 -0.24 -0.17 33 | 3.19999998807907 -0.49 -0.36 -0.31 34 | 3.30000001192093 -0.55 -0.24 -0.39 35 | 3.39999997615814 -0.33 -0.26 -0.25 36 | 3.5 -0.22 -0.14 -0.37 37 | 3.60000002384186 -0.27 -0.15 -0.37 38 | 3.69999998807907 -0.52 -0.37 -0.45 39 | 3.80000001192093 -0.17 -0.22 -0.0899999999999999 40 | 3.89999997615814 -0.22 -0.3 0.0199999999999996 41 | 4 -0.13 -0.17 -0.38 42 | 4.10000002384186 -0.52 -0.0599999999999999 -0.600000000000001 43 | 4.19999998807907 -0.53 -0.13 -0.46 44 | 4.30000001192093 -0.29 -0.23 -0.44 45 | 4.39999997615814 -0.34 -0.11 -0.22 46 | 4.5 -0.34 -0.1 -0.66 47 | 4.60000002384186 -0.39 -0.0599999999999999 -0.39 48 | 4.69999998807907 -0.36 -0.2 -0.34 49 | 4.80000001192093 -0.39 -0.15 -0.0499999999999998 50 | 4.89999997615814 -0.37 -0.07 -0.44 51 | 5 -0.45 -0.13 0.0700000000000003 52 | 5.10000002384186 -0.5 0.01 -0.46 53 | 5.19999998807907 -0.52 -0.0499999999999999 -0.69 54 | 5.30000001192093 -0.29 -0.0399999999999999 -0.25 55 | 5.39999997615814 -0.18 0.14 0.0999999999999996 56 | 5.5 -0.39 -0.0599999999999999 -0.22 57 | 5.60000002384186 -0.29 0.15 0.0300000000000002 58 | 5.69999998807907 -0.0900000000000001 0.01 -0.0999999999999996 59 | 5.80000001192093 -0.18 -0.0599999999999999 -0.17 60 | 5.89999997615814 -0.24 0.0600000000000001 -0.21 61 | 6 -0.3 0.02 -0.2 62 | 6.10000002384186 -0.12 -0.09 -0.12 63 | 6.19999998807907 -0.02 -0.0299999999999999 0.14 64 | 6.30000001192093 0.05 -0.08 0.16 65 | 6.39999997615814 -0.17 -0.0599999999999999 -0.00999999999999979 66 | 6.5 0.0700000000000001 -0.14 0.36 67 | 6.60000002384186 -0.18 -0.0399999999999999 0.0800000000000001 68 | 6.69999998807907 -0.34 -0.0499999999999999 0.66 69 | 6.80000001192093 0.0700000000000001 -0.11 0.76 70 | 6.89999997615814 0.03 0.04 0.52 71 | 7 -0.15 0.05 -0.0300000000000002 72 | 7.10000002384186 0.0700000000000001 -0.18 0.49 73 | 7.19999998807907 0.0799999999999998 0.03 0.17 74 | 7.30000001192093 -0.0600000000000001 0 0.12 75 | 7.39999997615814 0.53 -0.15 0.75 76 | 7.5 0.0900000000000001 -0.15 0.12 77 | 7.60000002384186 0.13 0.13 0.12 78 | 7.69999998807907 0.44 -0.11 0.72 79 | 7.80000001192093 0.12 -0.09 0.16 80 | 7.89999997615814 0.15 -0.0399999999999999 0.34 81 | 8 0.0799999999999998 -0.22 0.0599999999999996 82 | 8.10000002384186 0.15 -0.09 0.2 83 | 8.19999998807907 0.37 -0.0299999999999999 -0.350000000000001 84 | 8.30000001192093 0.31 0.14 -1.08 85 | 8.39999997615814 0.93 0.27 -0.96 86 | 8.5 1.37 0.15 -0.98 87 | 8.60000002384186 1.87 0.54 -1.81 88 | 8.69999998807907 2.44 0.76 -2.11 89 | 8.80000001192093 2.73 0.99 -2.72 90 | 8.89999997615814 3.54 1.44 -3.41 91 | 9 4.3 1.93 -3.41 92 | 9.10000002384186 5.4 2.47 -3.83 93 | 9.19999998807907 6.61 2.89 -3.5 94 | 9.30000001192093 7.52 3.38 -3.96 95 | 9.39999997615814 7.46 3.02 -3.87 96 | 9.5 6.28 1.6 -3.66 97 | 9.60000002384186 5.17 0.65 -3.48 98 | 9.69999998807907 5.48 1.74 -3.44 99 | 9.80000001192093 6.64 4.12 -3.32 100 | 9.89999997615814 4.2 1.73 -3.3 101 | 10 3.31 0.15 -5.09 102 | 10.1000000238419 2.68 -2.06 -5.21 103 | 10.1999999880791 1.2 -5.27 -5.08 104 | 10.3000000119209 0.81 -7.83 -4.78 105 | 10.3999999761581 0.89 -8.04 -4.59 106 | 10.5 1.02 -6.58 -4.91 107 | 10.6000000238419 -0.26 -4.17 -5.07 108 | 10.6999999880791 -0.4 -1.84 -5.44 109 | 10.8000000119209 -0.9 -1.5 -4.87 110 | 10.8999999761581 -1.25 -2.29 -4.64 111 | 11 -0.74 -3.1 -4.58 112 | 11.1000000238419 -0.52 -3.81 -4.86 113 | 11.1999999880791 1.12 -3.46 -5.17 114 | 11.3000000119209 2.68 -1.97 -5.29 115 | 11.3999999761581 1.05 -3.5 -5.58 116 | 11.5 0.8 -3.8 -5.86 117 | 11.6000000238419 1.02 -3.83 -6.68 118 | 11.6999999880791 0.19 -3.58 -7.2 119 | 11.8000000119209 -0.2 -2.46 -7.39 120 | 11.8999999761581 -1.12 -1.39 -7.86 121 | 12 -1.42 -0.67 -7.92 122 | 12.1000000238419 -2.52 -0.11 -8.83 123 | 12.1999999880791 -2.77 0.26 -9.46 124 | 12.3000000119209 -2.39 -0.25 -9.47 125 | 12.3999999761581 -2.05 -1.31 -10.37 126 | 12.5 -1.03 -0.92 -11.01 127 | 12.6000000238419 0.18 0.28 -10.8 128 | 12.6999999880791 0.14 1.59 -11.89 129 | 12.8000000119209 0.15 3.05 -12.06 130 | 12.8999999761581 -1.48 3.64 -13.22 131 | 13 -2.08 2.45 -13.51 132 | 13.1000000238419 -1.86 0.5 -13.77 133 | 13.1999999880791 -2.09 -0.19 -13.44 134 | 13.3000000119209 -3.5 -0.52 -13.4 135 | 13.3999999761581 -3.51 0.03 -13.14 136 | 13.5 -4.03 2.72 -13.62 137 | 13.6000000238419 -4.38 7.05 -13.95 138 | 13.6999999880791 -5.3 8.23 -13.64 139 | 13.8000000119209 -4.35 7.52 -13.54 140 | 13.8999999761581 -2.02 5.85 -13.3 141 | 14 0.2 3.6 -12.56 142 | 14.1000000238419 1.83 1.98 -12.36 143 | 14.1999999880791 1.82 0.43 -12.03 144 | 14.3000000119209 1.75 -0.27 -11.75 145 | 14.3999999761581 1.08 -0.1 -10.93 146 | 14.5 -0.28 0.95 -11.08 147 | 14.6000000238419 -1.31 1.77 -11.17 148 | 14.6999999880791 -1.98 2.62 -11.97 149 | 14.8000000119209 -2.9 3.79 -11.94 150 | 14.8999999761581 -4.32 4.36 -12.24 151 | 15 -4.56 3.68 -11.99 152 | 15.1000000238419 -3.45 2.05 -12.24 153 | 15.1999999880791 -1.69 -0.17 -11.97 154 | 15.3000000119209 0.26 -1.39 -11.54 155 | 15.3999999761581 0.42 -2.04 -11.25 156 | 15.5 -1.58 -1.18 -11.89 157 | 15.6000000238419 -2.81 1.15 -11.75 158 | 15.6999999880791 -5.17 3.27 -11.66 159 | 15.8000000119209 -5.69 4.13 -10.57 160 | 15.8999999761581 -4.38 2.34 -11.07 161 | 16 -1.48 -0.28 -10.35 162 | 16.1000000238419 1.94 -2.04 -9.5 163 | 16.1999999880791 2.38 -2.97 -9.27 164 | 16.3000000119209 1.69 -2.35 -9.71 165 | 16.3999999761581 -0.15 -0.97 -9.99 166 | 16.5 -2.73 0.31 -10.44 167 | 16.6000000238419 -3.9 1.85 -10.4 168 | 16.6999999880791 -3.32 2.6 -10.75 169 | 16.8000000119209 -2.67 1.74 -11.02 170 | 16.8999999761581 -2.12 0.52 -11.06 171 | 17 -1.38 -0.39 -11.18 172 | 17.1000000238419 -0.6 -1.22 -11.01 173 | 17.1999999880791 -0.26 -1.6 -11.22 174 | 17.3000000119209 -0.37 -1.54 -10.64 175 | 17.3999999761581 -1.19 -0.52 -11.44 176 | 17.5 -2.36 0.99 -11.38 177 | 17.6000000238419 -3.8 2.38 -11.58 178 | 17.6999999880791 -4.33 2.95 -11.45 179 | 17.8000000119209 -3.89 2.47 -11.12 180 | 17.8999999761581 -2.53 1.29 -11.11 181 | 18 -0.52 -0.01 -10.1 182 | 18.1000000238419 0.94 -1.2 -10.03 183 | 18.1999999880791 1.81 -1.79 -9.9 184 | 18.3000000119209 1.24 -1.32 -9.79 185 | 18.3999999761581 0.39 -0.22 -9.98 186 | 18.5 -0.96 1 -9.7 187 | 18.6000000238419 -1.97 1.64 -9.85 188 | 18.6999999880791 -2.09 1.8 -9.48 189 | 18.8000000119209 -1.8 1.14 -9.91 190 | 18.8999999761581 -0.71 0.32 -9.72 191 | 19 -0.2 -0.38 -9.53 192 | 19.1000000238419 0.11 -0.59 -9.42 193 | 19.1999999880791 -0.88 -0.44 -9.59 194 | 19.3000000119209 -1.53 0.43 -10.39 195 | 19.3999999761581 -1.92 0.64 -9.68 196 | 19.5 -1.98 0.36 -10.2 197 | 19.6000000238419 -1.36 0.03 -9.81 198 | 19.6999999880791 -1.21 -0.18 -10.21 199 | 19.8000000119209 -0.96 -0.22 -9.82 200 | 19.8999999761581 -0.97 0.14 -9.97 201 | 20 -1.18 0.3 -9.84 202 | 20.1000000238419 -1.07 0.58 -10.19 203 | 20.1999999880791 -1.06 0.27 -9.75 204 | 20.3000000119209 -1.13 0.34 -10.2 205 | 20.3999999761581 -1.77 0.33 -10.6 206 | 20.5 -1.54 0.47 -10.36 207 | 20.6000000238419 -1.24 0.49 -10.3 208 | 20.6999999880791 -0.96 0.53 -10.42 209 | 20.8000000119209 -0.74 0.54 -9.94 210 | 20.8999999761581 -0.53 0.55 -9.7 211 | 21 -0.74 0.71 -10.17 212 | 21.1000000238419 -0.54 0.75 -10.18 213 | 21.1999999880791 -0.73 0.93 -10.02 214 | 21.3000000119209 -0.63 0.73 -10.75 215 | 21.3999999761581 -0.34 0.35 -10.45 216 | 21.5 -0.62 -0.01 -10.65 217 | 21.6000000238419 -0.6 0.04 -10.46 218 | 21.6999999880791 -0.95 0.05 -10.69 219 | 21.8000000119209 -0.73 -0.1 -9.78 220 | 21.8999999761581 -0.73 -0.1 -10.81 221 | 22 -0.56 0.18 -10.45 222 | 22.1000000238419 -0.16 0.42 -10.72 223 | 22.1999999880791 -0.24 0.54 -10.86 224 | 22.3000000119209 -0.52 0.82 -11.01 225 | 22.3999999761581 -0.54 1 -11.06 226 | 22.5 -0.81 1.09 -11.06 227 | 22.6000000238419 -1.04 1.45 -10.88 228 | 22.6999999880791 -1.51 1.26 -11.09 229 | 22.8000000119209 -1.43 0.84 -11.02 230 | 22.8999999761581 -1.39 0.66 -11.09 231 | 23 -1.37 0.56 -11 232 | 23.1000000238419 -1.37 0.79 -10.89 233 | 23.1999999880791 -1.09 0.88 -10.88 234 | 23.3000000119209 -1.21 0.74 -11.15 235 | 23.3999999761581 -0.97 0.85 -11.18 236 | 23.5 -0.85 0.84 -11.03 237 | 23.6000000238419 -0.7 1.15 -10.86 238 | 23.6999999880791 -0.33 1.15 -11.12 239 | 23.8000000119209 -0.19 1.16 -10.81 240 | 23.8999999761581 0.33 1.11 -11.06 241 | 24 0.45 0.78 -11.02 242 | 24.1000000238419 0.71 1.05 -11.25 243 | 24.1999999880791 0.43 1.05 -11.22 244 | 24.3000000119209 0.16 1.21 -11.58 245 | 24.3999999761581 -0.0600000000000001 1.04 -11.06 246 | 24.5 0.0799999999999998 1.03 -11.39 247 | 24.6000000238419 0.0999999999999999 1.19 -11.33 248 | 24.6999999880791 -0.31 1.11 -11.09 249 | 24.8000000119209 -0.12 1 -11.02 250 | 24.8999999761581 -0.47 0.84 -10.88 251 | 25 -0.51 0.67 -11.15 252 | 25.1000000238419 -0.78 0.73 -11.24 253 | 25.1999999880791 -1.12 0.7 -11.12 254 | 25.3000000119209 -0.95 0.86 -10.89 255 | 25.3999999761581 -0.42 1.06 -11.19 256 | 25.5 -0.76 0.95 -11.07 257 | 25.6000000238419 -0.78 1.06 -10.94 258 | 25.6999999880791 -0.9 1.23 -11.02 259 | 25.8000000119209 -0.94 1.52 -10.5 260 | 25.8999999761581 -0.96 1.5 -10.76 261 | 26 -0.79 1.5 -10.47 262 | 26.1000000238419 -0.73 1.26 -10.49 263 | 26.1999999880791 -0.72 1.31 -10.5 264 | 26.3000000119209 -0.58 1.39 -10.52 265 | 26.3999999761581 -1.11 1.26 -10.67 266 | 26.5 -1.11 1.09 -10.74 267 | 26.6000000238419 -1.11 1.1 -10.64 268 | 26.6999999880791 -0.63 0.97 -10.53 269 | 26.8000000119209 -0.73 0.8 -10.84 270 | 26.8999999761581 -0.87 0.85 -10.82 271 | 27 -1.1 1.04 -10.7 272 | 27.1000000238419 -1.14 1.09 -10.46 273 | 27.1999999880791 -0.93 0.99 -10.6 274 | 27.3000000119209 -0.99 0.96 -10.25 275 | 27.3999999761581 -0.93 1.03 -10.6 276 | 27.5 -0.93 0.99 -10.25 277 | 27.6000000238419 -0.86 1 -10.33 278 | 27.6999999880791 -1.12 1.06 -10.46 279 | 27.8000000119209 -1.02 1.08 -10.42 280 | 27.8999999761581 -0.87 1.08 -10.58 281 | 28 -0.86 1.31 -10.21 282 | 28.1000000238419 -0.59 1.2 -10.4 283 | 28.1999999880791 -0.73 1.06 -10.53 284 | 28.3000000119209 -0.78 0.86 -10.31 285 | 28.3999999761581 -0.73 0.87 -10.1 286 | 28.5 -0.95 1.16 -10.45 287 | 28.6000000238419 -1.18 1.28 -10.13 288 | 28.6999999880791 -1.06 1.27 -10.19 289 | 28.8000000119209 -1.03 1.22 -10.15 290 | 28.8999999761581 -0.96 1.18 -10.35 291 | 29 -0.79 0.83 -10.11 292 | 29.1000000238419 -0.57 0.72 -10.38 293 | 29.1999999880791 -0.55 0.64 -10.29 294 | 29.3000000119209 -0.8 0.85 -10.37 295 | 29.3999999761581 -0.75 0.96 -10.21 296 | 29.5 -1.01 1.23 -10.33 297 | 29.6000000238419 -1.34 1.23 -10.45 298 | 29.6999999880791 -1.11 1.24 -10.36 299 | 29.8000000119209 -1 1.29 -10.42 300 | 29.8999999761581 -0.84 1.08 -10.65 301 | 30 -0.93 0.97 -10.43 302 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/data/processseis.f90: -------------------------------------------------------------------------------- 1 | ! CONVERTS DATA TO SEISMOGRAM FORMAT USED IN LinSlipInv 2 | ! AUTHOR: Frantisek Gallovic 3 | 4 | IMPLICIT NONE 5 | REAL,PARAMETER:: PI=3.1415926535 6 | INTEGER originY,originMONTH,originD,originH,originM,STA,FILTERS,NN,NNout 7 | REAL originS,DTout 8 | character*4 staname 9 | character*20 filename 10 | INTEGER staY,staMONTH,staD,staH,staM 11 | real staS,staLAT,staLON,dt,artftimeshift 12 | integer Istart,FLT,INTEGRATE,detrend 13 | real,dimension(:),allocatable:: f1,f2 14 | real,dimension(:),allocatable:: seisn,seise,seisz,tt 15 | real,dimension(:,:),allocatable:: seisnout,seiseout,seiszout 16 | real dum,dumN,dumE,dumZ,UNDER,divide 17 | integer i,j,k,jstart,id,sampl 18 | REAL aN,bN,aE,bE,aZ,bZ 19 | 20 | open(100,FILE="processseis.in") 21 | read(100,*) 22 | read(100,*)originY,originMONTH,originD,originH,originM,originS 23 | read(100,*) 24 | read(100,*)STA 25 | read(100,*) 26 | read(100,*)DTout,NNout,artftimeshift 27 | allocate(seisnout(NNout,STA),seiseout(NNout,STA),seiszout(NNout,STA)) 28 | read(100,*) 29 | read(100,*)FILTERS 30 | allocate(f1(FILTERS),f2(FILTERS)) 31 | do i=1,FILTERS 32 | read(100,*)f1(i),f2(i) 33 | enddo 34 | read(100,*) 35 | read(100,*) 36 | read(100,*) 37 | 38 | open(101,FILE='stations.txt') 39 | do i=1,STA 40 | read(100,*)staLAT,staLON,staY,staMONTH,staD,staH,staM,staS,dt,divide,detrend,FLT,INTEGRATE,filename 41 | Istart=int(((staD-originD)*86400.+(staH-originH)*3600.+(staM-originM)*60.+staS-originS+artftimeshift)/dt) 42 | write(staname,'(A4)')filename 43 | write(*,*)trim(staname),Istart 44 | write(101,*)staLAT,staLON,staname 45 | UNDER=dtout/dt !undersampling 46 | NN=int(UNDER*NNout)+1 47 | allocate(seisn(NN),seise(NN),seisz(NN),tt(NN)) 48 | seisn=0. 49 | seise=0. 50 | seisz=0. 51 | do k=1,NN 52 | tt(k)=dt*(k-1) 53 | enddo 54 | open(201,FILE=trim(filename)) 55 | j=Istart 56 | if(j>0)then 57 | jstart=j 58 | else 59 | jstart=0 60 | endif 61 | 10 read(201,*,END=11)dum,dumN,dumE,dumZ 62 | j=j+1 63 | if(j>0)then 64 | seisn(j)=dumN/divide 65 | seise(j)=dumE/divide 66 | seisz(j)=dumZ/divide 67 | endif 68 | if(j0.)then 94 | CALL XAPIIR(seisn(:), NN, 'BU', 0.0, 0.0, 4,'BP', f1(FLT), f2(FLT), dt, 1, NN) 95 | CALL XAPIIR(seise(:), NN, 'BU', 0.0, 0.0, 4,'BP', f1(FLT), f2(FLT), dt, 1, NN) 96 | CALL XAPIIR(seisz(:), NN, 'BU', 0.0, 0.0, 4,'BP', f1(FLT), f2(FLT), dt, 1, NN) 97 | else 98 | CALL XAPIIR(seisn(:), NN, 'BU', 0.0, 0.0, 4,'LP', f1(FLT), f2(FLT), dt, 1, NN) 99 | CALL XAPIIR(seise(:), NN, 'BU', 0.0, 0.0, 4,'LP', f1(FLT), f2(FLT), dt, 1, NN) 100 | CALL XAPIIR(seisz(:), NN, 'BU', 0.0, 0.0, 4,'LP', f1(FLT), f2(FLT), dt, 1, NN) 101 | endif 102 | 103 | if(INTEGRATE>0)then 104 | do k=2,NN !time integration 105 | seisn(k)=seisn(k)+seisn(k-1) 106 | seise(k)=seise(k)+seise(k-1) 107 | seisz(k)=seisz(k)+seisz(k-1) 108 | enddo 109 | seisn(:)=seisn(:)*dt 110 | seise(:)=seise(:)*dt 111 | seisz(:)=seisz(:)*dt 112 | endif 113 | if(INTEGRATE>1)then 114 | do k=2,NN !time integration 115 | seisn(k)=seisn(k)+seisn(k-1) 116 | seise(k)=seise(k)+seise(k-1) 117 | seisz(k)=seisz(k)+seisz(k-1) 118 | enddo 119 | seisn(:)=seisn(:)*dt 120 | seise(:)=seise(:)*dt 121 | seisz(:)=seisz(:)*dt 122 | endif 123 | 124 | do j=1,NNout !undersampling 125 | seisnout(j,i)=seisn(int(real(j-1)*UNDER)+1) 126 | seiseout(j,i)=seise(int(real(j-1)*UNDER)+1) 127 | seiszout(j,i)=seisz(int(real(j-1)*UNDER)+1) 128 | enddo 129 | deallocate(seisn,seise,seisz,tt) 130 | 131 | enddo 132 | close(100) 133 | close(101) 134 | 135 | open(101,FILE='rvseisn.dat') 136 | open(102,FILE='rvseise.dat') 137 | open(103,FILE='rvseisz.dat') 138 | do i=1,NNout 139 | write(101,'(100E13.5)')dtout*(i-1),seisnout(i,:) 140 | write(102,'(100E13.5)')dtout*(i-1),seiseout(i,:) 141 | write(103,'(100E13.5)')dtout*(i-1),seiszout(i,:) 142 | enddo 143 | close(101) 144 | close(102) 145 | close(103) 146 | 147 | END 148 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/data/processseis.in: -------------------------------------------------------------------------------- 1 | #COMMON ORIGIN (DATE, TIME) 2 | 2009 04 06 01. 32. 39. 3 | #STATIONS 4 | 9 5 | #OUT_DT OUT_SAMPLES ARTIFICIAL_TIMESHIFT 6 | 0.4 512 30. 7 | #FILTERS (NUMBER OF FILTERS, PARAMETERS) 8 | 2 9 | 0.05 0.5 10 | 0.00 0.5 11 | -------------------------------------------------------------------------------------------------- 12 | LAT LONG DATE_BEGIN TIME_BEGIN DT DIVIDE DETREND FILTER INTEGRATE FILENAME 13 | -------------------------------------------------------------------------------------------------- 14 | 42.373474 13.337026 2009 04 06 01 32 12.0 0.005 100. 1 1 2 AQG_.txt 15 | 42.353880 13.401930 2009 04 06 01 32 39.0 0.010 100. 1 1 2 AQU_.txt 16 | 42.420685 13.519362 2009 04 06 01 32 29.0 0.005 100. 1 1 2 GSA_.txt 17 | 42.524025 13.244783 2009 04 06 01 32 31.0 0.005 100. 1 1 2 MTR_.txt 18 | 42.418175 13.078653 2009 04 06 01 32 16.0 0.005 100. 1 1 2 ANT_.txt 19 | 42.268024 13.117216 2009 04 06 01 32 15.0 0.005 100. 1 1 2 FMG_.txt 20 | 42.085182 13.520725 2009 04 06 01 32 18.0 0.005 100. 1 1 2 CLN_.txt 21 | 42.327 13.386 2009 04 06 01 32 35.0 0.100 100. 0 2 0 ROIO.10hz.nev 22 | 42.293 13.483 2009 04 06 01 32 35.0 0.100 100. 0 2 0 CADO.10hz.nev 23 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/data/processseis.sh: -------------------------------------------------------------------------------- 1 | ifort -oprocessseis processseis.f90 filters.for 2 | ./processseis 3 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/input.dat: -------------------------------------------------------------------------------- 1 | No. of computed frequencies (should be larger than half of the temporal discretization) 2 | 135 3 | Length of seismograms, slip rate time window, start and end time for waveform comparison (sec) 4 | 102.4 10. 30. 55. 5 | Artificial time shift (sec), number of segments 6 | 30. 1 7 | Number of receivers (waveforms, static GPS) 8 | 9 0 9 | Spatial discretization along strike and dip 10 | 20 15 11 | Scalar seismic moment (Nm) 12 | 2.4e18 13 | Strike Dip Rake (degrees) 14 | 140. 50. -90. 15 | Depth of fault reference point (m) 16 | 8800. 17 | Length and width of the fault (m) 18 | 20000. 15000. 19 | Position of reference point on the fault (m) 20 | 6000. 4000. 21 | Number of samples in the time domain 22 | 256 23 | Rupture velocity (m/s) - used only if generating synthetic forward model 24 | 3000 25 | Number of filter ranges, followed by corner frequencies 26 | 2 27 | 0.05 0.50 28 | 0.00 0.50 29 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/stainfo.dat: -------------------------------------------------------------------------------- 1 | 1 1 1 1. 1. 1. 1 AQG 2 | 1 1 1 1. 1. 1. 1 AQU 3 | 1 1 1 1. 1. 1. 1 GSA 4 | 1 1 1 3. 3. 3. 1 MTR 5 | 1 1 1 3. 3. 3. 1 ANT 6 | 1 1 1 3. 3. 3. 1 FMG 7 | 1 1 1 3. 3. 3. 1 CLN 8 | 1 1 1 .3 .3 .3 2 ROIO GPSgram 9 | 1 1 1 .3 .3 .3 2 CADO GPSgram 10 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/stations.in: -------------------------------------------------------------------------------- 1 | #Lat, Long of the reference point (corresponds to the reference point in the input.dat file) 2 | 42.339 13.381 3 | -------------------------------------------------------------------------------- /examples/LAquila-realdata/stations.txt: -------------------------------------------------------------------------------- 1 | 42.37347 13.33703 AQG 2 | 42.35388 13.40193 AQU 3 | 42.42068 13.51936 GSA 4 | 42.52402 13.24478 MTR 5 | 42.41817 13.07865 ANT 6 | 42.26802 13.11722 FMG 7 | 42.08518 13.52073 CLN 8 | 42.32700 13.38600 ROIO 9 | 42.29300 13.48300 CADO 10 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/examples/README.md -------------------------------------------------------------------------------- /examples/SIV1a/Description_inv1_updated.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/examples/SIV1a/Description_inv1_updated.pdf -------------------------------------------------------------------------------- /examples/SIV1a/SlipInvSVD.in: -------------------------------------------------------------------------------- 1 | Data (1 = synthetic data, 0 = read from files, -1 = custom target model from a file) 2 | 0 3 | Std.dev for slip rate (0 = no smoothing), Std.dev for GF's, GPS weight, M0 constraint weight, Weight of additional constraint 4 | 1.d0 0.01 .1d0 1.d0 0.d0 5 | Station component weights (1=no distance distance-dependent weights, 2=distance-dependent approximated CD) 6 | 1 7 | Choice of use of eigenvectors (see further) 8 | 1 9 | 1: single minimum singular value, 2: defined min and max number of eigenvectors to be considered 10 | 100. 11 | Additional temporal shift (in sec) 12 | 0. 13 | Compact SVD (0=NO, 1=YES - then it is not possible to use ANNLS) 14 | 1 15 | -------------------------------------------------------------------------------- /examples/SIV1a/crustal.dat: -------------------------------------------------------------------------------- 1 | Crustal model (free format) 2 | number of layers, not more than 7: modified from MN2 by removing 500m top 3 | 6 4 | Parameters of the layers 5 | depth of layer top(km) Vp(km/s) Vs(km/s) Rho(g/cm**3) Qp Qs 6 | 0.0 4.80 2.600 2.300 1000 1000 7 | 0.3 4.80 2.600 2.300 1000 1000 8 | 2.0 5.50 3.100 2.500 1000 1000 9 | 4.8 6.20 3.600 2.700 1000 1000 10 | 18.0 6.80 3.800 2.800 1000 1000 11 | 24.0 8.00 4.620 3.200 1000 1000 12 | **************** not more than 7 layers ! ****************************** 13 | -------------------------------------------------------------------------------- /examples/SIV1a/input.dat: -------------------------------------------------------------------------------- 1 | No. of computed frequencies (should be larger than half of the temporal discretization) 2 | 130 3 | Length of seismograms, slip rate time window, start and end time for waveform comparison (sec) 4 | 102.4 10. 30. 70. 5 | Artificial time shift (sec), number of segments 6 | 30. 1 7 | Number of recievers (waveforms, static GPS) 8 | 56 0 9 | Spatial discretization along strike and dip for each segment 10 | 35 20 11 | Scalar seismic moment (Nm) 12 | 1.06e19 13 | Strike Dip Rake (degrees) for each segment 14 | 90. 80. 180. 15 | Depth of fault reference point (m) for each segment 16 | 10. 17 | Length and width of the fault (m) for each segment 18 | 35000. 20000. 19 | Position of reference point on the fault (m) for each segment 20 | 17500. 20000. 21 | Number of samples in the time domain 22 | 256 23 | Rupture velocity (m/s) - used only if generating synthetic forward model 24 | 3000 25 | Number of filter ranges, followed by corner frequencies 26 | 1 27 | 0.05 .5 28 | -------------------------------------------------------------------------------- /examples/SIV1a/stainfo.dat: -------------------------------------------------------------------------------- 1 | 1 1 1 1. 1. 1. 1 I01 2 | 1 1 1 1. 1. 1. 1 I02 3 | 1 1 1 1. 1. 1. 1 I03 4 | 1 1 1 1. 1. 1. 1 I04 5 | 1 1 1 1. 1. 1. 1 I05 6 | 1 1 1 1. 1. 1. 1 I06 7 | 1 1 1 1. 1. 1. 1 I07 8 | 1 1 1 1. 1. 1. 1 I08 9 | 1 1 1 1. 1. 1. 1 I09 10 | 1 1 1 1. 1. 1. 1 I10 11 | 1 1 1 1. 1. 1. 1 I11 12 | 1 1 1 1. 1. 1. 1 I12 13 | 1 1 1 1. 1. 1. 1 I13 14 | 1 1 1 1. 1. 1. 1 I14 15 | 1 1 1 1. 1. 1. 1 I15 16 | 1 1 1 1. 1. 1. 1 I16 17 | 1 1 1 1. 1. 1. 1 I17 18 | 1 1 1 1. 1. 1. 1 I18 19 | 1 1 1 1. 1. 1. 1 I19 20 | 1 1 1 1. 1. 1. 1 I20 21 | 1 1 1 1. 1. 1. 1 I21 22 | 1 1 1 1. 1. 1. 1 I22 23 | 1 1 1 1. 1. 1. 1 I23 24 | 1 1 1 1. 1. 1. 1 I24 25 | 1 1 1 1. 1. 1. 1 I25 26 | 1 1 1 1. 1. 1. 1 I26 27 | 1 1 1 1. 1. 1. 1 I27 28 | 1 1 1 1. 1. 1. 1 I28 29 | 1 1 1 1. 1. 1. 1 I29 30 | 1 1 1 1. 1. 1. 1 I30 31 | 1 1 1 1. 1. 1. 1 I31 32 | 1 1 1 1. 1. 1. 1 I32 33 | 1 1 1 1. 1. 1. 1 I33 34 | 1 1 1 1. 1. 1. 1 I34 35 | 1 1 1 1. 1. 1. 1 I35 36 | 1 1 1 1. 1. 1. 1 I36 37 | 1 1 1 1. 1. 1. 1 I37 38 | 1 1 1 1. 1. 1. 1 I38 39 | 1 1 1 1. 1. 1. 1 I39 40 | 1 1 1 1. 1. 1. 1 I40 41 | 0 0 0 1. 1. 1. 1 P41 42 | 0 0 0 1. 1. 1. 1 P42 43 | 0 0 0 1. 1. 1. 1 P43 44 | 0 0 0 1. 1. 1. 1 P44 45 | 0 0 0 1. 1. 1. 1 P45 46 | 0 0 0 1. 1. 1. 1 P46 47 | 0 0 0 1. 1. 1. 1 P47 48 | 0 0 0 1. 1. 1. 1 P48 49 | 0 0 0 1. 1. 1. 1 P49 50 | 0 0 0 1. 1. 1. 1 P50 51 | 0 0 0 1. 1. 1. 1 P51 52 | 0 0 0 1. 1. 1. 1 P52 53 | 0 0 0 1. 1. 1. 1 P53 54 | 0 0 0 1. 1. 1. 1 P54 55 | 0 0 0 1. 1. 1. 1 P55 56 | 0 0 0 1. 1. 1. 1 P56 57 | -------------------------------------------------------------------------------- /examples/SIV1a/stations.dat: -------------------------------------------------------------------------------- 1 | 35.00000 10.00000 0. I01 2 | 30.50000 -32.50000 0. I02 3 | 20.00000 0.0000000E+00 0. I03 4 | 20.00000 -15.00000 0. I04 5 | 17.50000 25.00000 0. I05 6 | 10.00000 32.00000 0. I06 7 | 10.00000 10.00000 0. I07 8 | 8.500000 20.00000 0. I08 9 | 8.500000 -20.00000 0. I09 10 | 5.000000 -23.50000 0. I10 11 | 3.000000 10.00000 0. I11 12 | 3.000000 0.0000000E+00 0. I12 13 | 3.000000 -5.000000 0. I13 14 | 2.500000 17.50000 0. I14 15 | 3.000000 35.00000 0. I15 16 | 5.000000 -45.00000 0. I16 17 | 1.000000 -20.00000 0. I17 18 | 1.000000 10.00000 0. I18 19 | 1.000000 -5.000000 0. I19 20 | 1.000000 -15.00000 0. I20 21 | -1.000000 25.00000 0. I21 22 | -3.000000 -35.00000 0. I22 23 | -1.000000 -25.00000 0. I23 24 | -1.000000 15.00000 0. I24 25 | -1.000000 5.000000 0. I25 26 | -1.000000 0.0000000E+00 0. I26 27 | -1.000000 -10.00000 0. I27 28 | -3.000000 10.00000 0. I28 29 | -3.000000 0.0000000E+00 0. I29 30 | -3.000000 -10.00000 0. I30 31 | -8.500000 -20.00000 0. I31 32 | -10.00000 32.50000 0. I32 33 | -10.00000 10.00000 0. I33 34 | -10.00000 -10.00000 0. I34 35 | -17.50000 -25.00000 0. I35 36 | -17.50000 40.00000 0. I36 37 | -20.00000 15.00000 0. I37 38 | -20.00000 0.0000000E+00 0. I38 39 | -30.50000 32.50000 0. I39 40 | -35.00000 10.00000 0. I40 41 | 35 -10 0. P01 42 | 17.5 -40 0. P02 43 | 20 15 0. P03 44 | 10 -10 0. P04 45 | 2.5 -17.5 0. P05 46 | 3 -35 0. P06 47 | 1 15 0. P07 48 | 1 -10 0. P08 49 | -5 45 0. P09 50 | -1 -5 0. P10 51 | -3 5 0. P11 52 | -5 -23.5 0. P12 53 | -17.5 25 0. P13 54 | -17.5 -40 0. P14 55 | -20 -15 0. P15 56 | -30.5 -32.5 0. P16 57 | -------------------------------------------------------------------------------- /papers/2010JB007814.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/papers/2010JB007814.pdf -------------------------------------------------------------------------------- /papers/JGRB50953.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/papers/JGRB50953.pdf -------------------------------------------------------------------------------- /papers/README.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/papers/README.md -------------------------------------------------------------------------------- /src-dwn/README.md: -------------------------------------------------------------------------------- 1 | #Axitra 2 | ------- 3 | 4 | Code based on discrete wavenumber method providing full-wavefield Green's functions in 1D layered media 5 | (Kennett and Kerry, 1979; Bouchon, 1981; Coutant, 1989). 6 | 7 | The code was originally written by O. Coutant. 8 | Additional modifications have been made by J. Zahradník, J. Burjánek and F. Gallovič. 9 | 10 | ###How to use the code 11 | 12 | AXITRA consists of four codes. The best approach is to use batch files `firststep.sh` and `calculate.sh`. 13 | The first file compiles all the codes and runs code `prepare.f90` for preparation of the AXITRA calculations, 14 | in particular it prepares list of elementary sources covering the rupture in regular grid. 15 | Then, a parallel loop using `xargs` is to be started by `calculate.sh`. 16 | The number of processors can be set in the batch file. 17 | For each elementary source the codes `gr_nez.for` and `cnv_nez.for` are run automatically. 18 | Intermediate results including Green’s functions (GFs) for the individual elementary 19 | sources are stored in the dat directory. Finally, the Green’s functions are resorted 20 | by `resort.f90` into the `NEZsor.dat` file. Note that the order of the GFs is such 21 | that the outer loop is over stations. Thus if more crustal models are to be considered, 22 | the `NEZsor.dat` files for the individual subsets of stations and then simply appended one after each other. 23 | 24 | ###References: 25 | - Kennett, B. L. N., and N. J. Kerry (1979). Seismic waves in a stratified half 26 | space, Geophys. J. Roy. Astron. Soc. 57, 557–583. 27 | - Bouchon, M. (1981). A simple method to calculate Green’s functions for 28 | elastic layered media, Bull. Seismol. Soc. Am. 71, 959–971. 29 | - Coutant, O. (1989). Program of Numerical Simulation AXITRA, Research 30 | Report, Lab. de Geophys. Interne et Tectonophys., Grenoble, France 31 | -------------------------------------------------------------------------------- /src-dwn/calculate.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | processors=6 #Number of parallel calculations (generally number of cores) 4 | 5 | cat sources.dat | xargs -P$processors -n7 ./gr_nez 6 | cat sources.dat | xargs -P$processors -n7 ./cnv_nez 7 | ./resort 8 | 9 | echo "Done!" 10 | -------------------------------------------------------------------------------- /src-dwn/dimen1.inc: -------------------------------------------------------------------------------- 1 | c @(#) dimension1.F AXITRA 4.12 12/7/93 4 2 | c***************************************************************************** 3 | c* * 4 | c* DIMENSION1 * 5 | c* * 6 | c* Declaration de variables generales : * 7 | c* constantes, parametres du modele * 8 | c* * 9 | c***************************************************************************** 10 | 11 | 12 | integer ncr,irc,nzr,nzrr,izrr,nr,nc,ns,nrs, 13 | 1 ncs,isc,nzs,nzss,izss,irs 14 | 15 | complex*16 ai,omega,omega2,a1 16 | real*8 cosr,sinr,pi,pi2,hc,kr,kr2,rr,uconv, 17 | 1 xlnf,xs,ys,zs,xr,yr,zr,vp,vs,vp2,vs2, 18 | 2 rho,qp,qs 19 | 20 | logical ttconv 21 | 22 | common /dim1a/ ai,pi,pi2,omega,omega2,a1,kr,kr2,uconv,xlnf, 23 | & ttconv 24 | common /dim1b/ xr(nrp),yr(nrp),zr(nrp),cosr(nrp,nsp),sinr(nrp,nsp) 25 | common /dim1c/ xs(nsp),ys(nsp),zs(nsp) 26 | common /dim1d/ rr(nrsp),nc,nr,ns,irs(nrp,nsp),nrs 27 | common /dim1e/ hc(ncp),vp(ncp),vs(ncp),vp2(ncp),vs2(ncp), 28 | & rho(ncp),qp(ncp),qs(ncp) 29 | common /dim1f/ ncr,irc(ncp),nzr(ncp),nzrr(nrp,ncp), 30 | & izrr(nrp,nrp,ncp) 31 | common /dim1g/ ncs,isc(ncp),nzs(ncp),nzss(nsp,ncp), 32 | & izss(nsp,nsp,ncp) 33 | -------------------------------------------------------------------------------- /src-dwn/dimen2.inc: -------------------------------------------------------------------------------- 1 | c @(#) dimension2.F AXITRA 4.12 12/7/93 4 2 | c***************************************************************************** 3 | c* * 4 | c* DIMENSION2 * 5 | c* * 6 | c* Declaration de variables utilisees dans le calcul par boucle en kr * 7 | c* externe (routines reflect0 a reflect6) * 8 | c* * 9 | c***************************************************************************** 10 | 11 | 12 | real*8 fj1,k0,k1,k2,k3,k4,k5 13 | complex*16 me1,me2,nt,mt,ntsh,mtsh,fdo, 14 | 1 fup,fdosh,fupsh,su1,sd1,su2,sd2,su3,sd3,su4,sd4, 15 | 2 su1sh,sd1sh,su2sh,sd2sh,u,ru,rd,tu,td,rdsh,rush, 16 | 3 tush,tdsh 17 | 18 | common /dim2a/ cka(ncp),ckb(ncp),cka2(ncp),ckb2(ncp), 19 | & cnu(ncp),cgam(ncp),c2(ncp),cff(nsp) 20 | common /dim2b/ fj1(nrsp),k0(nrsp),k1(nrsp),k2(nrsp), 21 | & k3(nrsp),k4(nrsp),k5(nrsp) 22 | common /dim2c/ rd(ncp,2,2),ru(ncp,2,2),td(ncp,2,2), 23 | & tu(ncp,2,2),rdsh(ncp),rush(ncp), 24 | & tdsh(ncp),tush(ncp),me1(ncp),me2(ncp) 25 | common /dim2d/ nt(ncp,2,2),mt(ncp,2,2),ntsh(ncp),mtsh(ncp) 26 | common /dim2e/ fdo(ncp,2,2),fup(ncp,2,2),fupsh(ncp),fdosh(ncp) 27 | common /dim2f/ su1(nsp,2),sd1(nsp,2),su2(nsp,2),sd2(nsp,2), 28 | & su3(nsp,2),sd3(nsp,2),su4(nsp,2),sd4(nsp,2), 29 | & su1sh(nsp),sd1sh(nsp),su2sh(nsp),sd2sh(nsp) 30 | common /dim2g/ u(nrp,nsp,11) -------------------------------------------------------------------------------- /src-dwn/firststep.sh: -------------------------------------------------------------------------------- 1 | ifort -O -autodouble -ocnv_nez cnv_nez.for 2 | ifort -O -autodouble -ogr_nez gr_nez.for 3 | ifort -O -oprepare prepare.f90 4 | ifort -O -oresort resort.f90 5 | 6 | ./prepare 7 | rm -fr dat 8 | mkdir dat 9 | -------------------------------------------------------------------------------- /src-dwn/param.inc: -------------------------------------------------------------------------------- 1 | c @(#) parameter.F AXITRA 4.11 12/7/93 4 2 | c********************************************************************** 3 | c* * 4 | c* PARAMETER * 5 | c* * 6 | c* nsp: nbre max source 7 | c* nrp: nbre max stat 8 | c* ncp: nbre max couche 9 | c* ikmin: nbre min d'iterations 10 | c* nkmax: (si fct de Bessel stockees) dimension tab fct Bessel 11 | c********************************************************************** 12 | 13 | implicit real*8 (a-b,d-h,o-z) 14 | implicit complex*16 (c) 15 | 16 | integer in1,in2,in3,out,out2 17 | parameter (in1=10,in2=11,in3=12,out=13,out2=14) 18 | 19 | integer nsp,nrp,ncp,nrsp,ikmin 20 | parameter (nsp=1,nrp=150,ncp=10,nrsp=nrp*nsp,ikmin=100) 21 | real*8 explim 22 | parameter (explim=-600.) 23 | 24 | integer nkmax 25 | parameter (nkmax=20000) -------------------------------------------------------------------------------- /src-dwn/prepare.f90: -------------------------------------------------------------------------------- 1 | program PREPARE 2 | 3 | implicit none 4 | 5 | real, parameter :: pi=3.141592654 6 | real df,aw1,t0 7 | complex rseis,ui,freq 8 | real,allocatable,dimension(:):: strike,dip,rake,leng,widt,hhypo 9 | real,allocatable:: hypo(:,:),offsets(:,:) 10 | real gleng,gwidt 11 | real TM(3,3),ITM(3,3) 12 | real NEZhypo(3),hypo2(3),xi(3),sour(3) 13 | real dx1,dx2 14 | real,allocatable:: x1a(:),x2a(:) 15 | integer,allocatable:: ng1(:),ng2(:) 16 | integer NSeg,np 17 | integer i,j,k,kk 18 | interface 19 | function Transf(NEZ,smer) 20 | logical smer 21 | real Transf(3) 22 | real NEZ(3) 23 | end function Transf 24 | end interface 25 | common /transform/ TM,NEZhypo,ITM,hypo2 26 | integer nc,nfreq,nr,ns,ikmax 27 | real Stat(2) 28 | real tl,aw,xl,uconv,fref 29 | namelist /input/ nc,nfreq,tl,aw,nr,ns,xl,ikmax,uconv,fref 30 | CHARACTER*6 filename 31 | 32 | open(1,file='input.dat') 33 | 34 | read(1,*) 35 | read(1,*) nfreq 36 | read(1,*) 37 | read(1,*) tl 38 | read(1,*) 39 | read(1,*) t0,NSeg 40 | allocate(ng1(NSeg),ng2(NSeg),strike(NSeg),dip(NSeg),rake(NSeg),hhypo(NSeg),leng(NSeg),widt(NSeg),hypo(3,NSeg)) 41 | allocate(offsets(2,NSeg)) 42 | read(1,*) 43 | read(1,*) nr 44 | read(1,*) 45 | read(1,*) (ng2(kk),ng1(kk),kk=1,NSeg) 46 | read(1,*) 47 | read(1,*) 48 | read(1,*) 49 | read(1,*) (strike(kk),dip(kk),rake(kk),kk=1,NSeg) 50 | read(1,*) 51 | read(1,*) (hhypo(kk),kk=1,NSeg) 52 | read(1,*) 53 | read(1,*) (leng(kk),widt(kk),kk=1,NSeg) 54 | read(1,*) 55 | read(1,*) (hypo(2,kk),hypo(1,kk),kk=1,NSeg) !WARNING! IN PREVIOUS VERSION THE ORDER WAS hypo(1),hypo(2)! 56 | read(1,*) 57 | read(1,*) np 58 | close(1) 59 | 60 | offsets=0. 61 | if(NSeg>1)then 62 | open(1,file='prepare.offsets') 63 | read(1,*) 64 | do kk=2,NSeg 65 | read(1,*)offsets(:,kk) 66 | enddo 67 | close(1) 68 | endif 69 | 70 | open(1,file='sources.dat') 71 | open(2,file='fault.dat') 72 | k=0 73 | do kk=1,NSeg 74 | 75 | hypo(3,kk)=0. 76 | 77 | allocate(x1a(ng1(kk)),x2a(ng2(kk))) 78 | 79 | NEZhypo(1)=offsets(1,kk) 80 | NEZhypo(2)=offsets(2,kk) 81 | NEZhypo(3)=-hhypo(kk) 82 | hypo2=hypo(:,kk) 83 | 84 | TM(1,1)=sind(strike(kk))*cosd(dip(kk)) 85 | TM(1,2)=-cosd(strike(kk))*cosd(dip(kk)) 86 | TM(1,3)=sind(dip(kk)) 87 | TM(2,1)=cosd(strike(kk)) 88 | TM(2,2)=sind(strike(kk)) 89 | TM(2,3)=0. 90 | TM(3,1)=-sind(strike(kk))*sind(dip(kk)) 91 | TM(3,2)=cosd(strike(kk))*sind(dip(kk)) 92 | TM(3,3)=cosd(dip(kk)) 93 | ITM=transpose(TM) 94 | 95 | dx1=widt(kk)/float(ng1(kk)) 96 | dx2=leng(kk)/float(ng2(kk)) 97 | 98 | do i=1,ng1(kk) 99 | x1a(i)=(float(i)-.5)*dx1 100 | enddo 101 | do i=1,ng2(kk) 102 | x2a(i)=(float(i)-.5)*dx2 103 | enddo 104 | 105 | do i=1,ng1(kk) 106 | do j=1,ng2(kk) 107 | xi(1)=x1a(i) 108 | xi(2)=x2a(j) 109 | xi(3)=0. 110 | k=k+1 111 | if(k<10)then 112 | write(filename,'(A5,I1)')'00000',k 113 | elseif(k<100)then 114 | write(filename,'(A4,I2)')'0000',k 115 | elseif(k<1000)then 116 | write(filename,'(A3,I3)')'000',k 117 | elseif(k<10000)then 118 | write(filename,'(A2,I4)')'00',k 119 | elseif(k<100000)then 120 | write(filename,'(A1,I5)')'0',k 121 | else 122 | write(filename,'(I6)')k 123 | endif 124 | sour=Transf(xi,.FALSE.) 125 | sour(3)=-sour(3) 126 | sour=sour/1000. 127 | write(1,'(A6,6E13.5)') filename,sour,strike(kk),dip(kk),rake(kk) 128 | enddo 129 | enddo 130 | deallocate(x1a,x2a) 131 | 132 | xi=0. 133 | write(2,*) Transf(xi,.FALSE.)/1000. 134 | xi(1)=widt(kk) 135 | xi(2)=0. 136 | xi(3)=0. 137 | write(2,*) Transf(xi,.FALSE.)/1000. 138 | xi(1)=widt(kk) 139 | xi(2)=leng(kk) 140 | xi(3)=0. 141 | write(2,*) Transf(xi,.FALSE.)/1000. 142 | xi(1)=0. 143 | xi(2)=leng(kk) 144 | xi(3)=0. 145 | write(2,*) Transf(xi,.FALSE.)/1000. 146 | xi=0. 147 | write(2,*) Transf(xi,.FALSE.)/1000. 148 | write(2,*) 149 | enddo 150 | close(1) 151 | close(2) 152 | 153 | open(2,file='GRDAT.HED') 154 | aw=1.;ns=1;xl=3000000.;ikmax=200000;uconv=1.E-12;fref=1. !Axitra values that does not have to be generally changed 155 | nc=0; !set up formal value that are actualy not used by Axitra (they are readed from elsewhere) 156 | write(2,input) 157 | close(2) 158 | 159 | ui=cmplx(0.,1.) 160 | df=1./tl 161 | aw1=-aw/(2.*tl) 162 | open(1,file='dirac.dat') 163 | do i=1,nfreq 164 | freq=cmplx(df*(i-1),aw1) 165 | rseis=exp(-ui*2.*pi*t0*freq) 166 | write(1,*) real(rseis),imag(rseis) 167 | enddo 168 | do i=nfreq+1,np 169 | rseis=0. 170 | write(1,*) real(rseis),imag(rseis) 171 | enddo 172 | close(1) 173 | 174 | end 175 | 176 | function Transf(NEZ,smer) 177 | implicit none 178 | logical smer 179 | real Transf(3) 180 | real NEZhypo(3),hypo2(3) 181 | real TM(3,3),ITM(3,3) 182 | real NEZ(3) 183 | common /transform/ TM,NEZhypo,ITM,hypo2 184 | 185 | if (smer) then 186 | Transf=matmul(TM,(NEZ-NEZhypo))+hypo2 187 | else 188 | Transf=matmul(ITM,(NEZ-hypo2))+NEZhypo 189 | endif 190 | end function 191 | -------------------------------------------------------------------------------- /src-dwn/resort.f90: -------------------------------------------------------------------------------- 1 | program Resort 2 | 3 | implicit none 4 | 5 | integer i,k,kk 6 | integer np,nr,rec,dum1,dum2,nfmax,pom,NSeg,gntot 7 | integer,allocatable:: gn1(:),gn2(:) 8 | real dat(7),T,dum 9 | CHARACTER*6 filename 10 | 11 | open(3,form='unformatted',file='NEZsor.dat') 12 | open(5,file='input.dat') 13 | 14 | read(5,*) 15 | read(5,*) nfmax 16 | read(5,*) 17 | read(5,*) T 18 | read(5,*) 19 | read(5,*) dum, NSeg 20 | allocate(gn1(NSeg),gn2(NSeg)) 21 | read(5,*) 22 | read(5,*) nr 23 | read(5,*) 24 | read(5,*) (gn2(kk),gn1(kk),kk=1,NSeg) 25 | do i=1,13 26 | read(5,*) 27 | enddo 28 | read(5,*) np 29 | 30 | gntot=sum(gn1(:)*gn2(:)) 31 | do i=1,gntot 32 | if(i<10)then 33 | write(filename,'(A5,I1)')'00000',i 34 | elseif(i<100)then 35 | write(filename,'(A4,I2)')'0000',i 36 | elseif(i<1000)then 37 | write(filename,'(A3,I3)')'000',i 38 | elseif(i<10000)then 39 | write(filename,'(A2,I4)')'00',i 40 | elseif(i<100000)then 41 | write(filename,'(A1,I5)')'0',i 42 | else 43 | write(filename,'(I6)')i 44 | endif 45 | open(100+i,FILE='dat/'//filename//'.nez') 46 | enddo 47 | 48 | write(*,*) nfmax,nr,NSeg 49 | do kk=1,NSeg 50 | do rec=1,nr 51 | write(*,*) rec 52 | write(3) rec 53 | do i=sum(gn1(1:kk-1)*gn2(1:kk-1))+1,sum(gn1(1:kk)*gn2(1:kk)) 54 | read(100+i,*) 55 | write(3) i 56 | do k=1,nfmax 57 | read(100+i,*) dat(1:7) 58 | write(3) dat(2:7) 59 | enddo 60 | enddo 61 | enddo 62 | enddo 63 | 64 | end 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /src-dwn/sources.gp: -------------------------------------------------------------------------------- 1 | set term x11 2 | set size ratio -1 3 | plot 'sources.dat' u 3:2 w p,'fault.dat' u 2:1 w l,'stations.dat' u 2:1 w p 4 | pause 35 5 | -------------------------------------------------------------------------------- /src-graphics/README.md: -------------------------------------------------------------------------------- 1 | #Graphical output 2 | ----------------- 3 | 4 | Fortran 90 codes that prepare Gnuplot scripts and its input files for plotting rupture models and seismograms. 5 | 6 | ####List of codes: 7 | - `mtilde2anime.f90`: Plots the inverted rupture evolution in terms of snapshots. 8 | - `slipratesonfault.f90`: Plots slip rate functions along the fault. 9 | - `SlipInv-seisplot.f90`: Plots seismogram comparison. 10 | 11 | Notes: 12 | - Each of the codes is supplemented by its own script that compiles the code, executes it and calles `gnuplot` for plotting. 13 | - Only input files used for the inversion codes are need (no additional ones are required). 14 | -------------------------------------------------------------------------------- /src-graphics/SlipInv-seisplot.f90: -------------------------------------------------------------------------------- 1 | ! Plot of seismogram comparison 2 | ! ----------------------------- 3 | ! AUTHOR: Frantisek Gallovic 4 | 5 | IMPLICIT NONE 6 | REAL*8, PARAMETER:: margin=0.05d0 !relative margin size 7 | REAL*8,ALLOCATABLE,DIMENSION(:,:):: rseisn,rseise,rseisz,sseisn,sseise,sseisz 8 | REAL*8,ALLOCATABLE,DIMENSION(:):: stepa,maxampl 9 | INTEGER,ALLOCATABLE,DIMENSION(:,:):: stainfo 10 | CHARACTER*4,ALLOCATABLE,DIMENSION(:):: staname 11 | REAL*8 TW,DT,T1,T2 12 | INTEGER NS,FFT,NT,NTFROM 13 | REAL*8 startx,starty,stept,dum 14 | REAL*8 maxampln,maxample,maxamplz 15 | INTEGER i,j,k,m 16 | 17 | open(100,FILE='input.dat') 18 | read(100,*) 19 | read(100,*) 20 | read(100,*) 21 | read(100,*)TW,dum,T1,T2 22 | read(100,*) 23 | read(100,*) 24 | read(100,*) 25 | read(100,*)NS 26 | do i=1,13 27 | read(100,*) 28 | enddo 29 | read(100,*)FFT 30 | close(100) 31 | DT=TW/dble(FFT) 32 | NT=floor((T2-T1)/DT+1) 33 | NTfrom=floor(T1/DT+1) 34 | write(*,*)NT 35 | 36 | allocate(rseisn(FFT,NS),rseise(FFT,NS),rseisz(FFT,NS),sseisn(FFT,NS),sseise(FFT,NS),sseisz(FFT,NS)) 37 | allocate(stepa(NS),maxampl(NS),staname(NS),stainfo(3,NS)) 38 | 39 | ! open(100,FILE='stations.dat') 40 | ! do k=1,NS 41 | ! read(100,*)dum,dum,dum,staname(k) 42 | ! enddo 43 | ! close(100) 44 | open(100,FILE='stainfo.dat') 45 | do k=1,NS 46 | read(100,*)stainfo(1:3,k),dum,dum,dum,dum,staname(k) 47 | enddo 48 | close(100) 49 | 50 | ! In typical applications rvseis[nez].dat should contain the same seismogram as in rvseisnez.dat 51 | ! open(101,FILE='rvseisn.dat') 52 | ! open(102,FILE='rvseise.dat') 53 | ! open(103,FILE='rvseisz.dat') 54 | ! do k=1,FFT 55 | ! read(101,*)dum,rseisn(k,1:NS) 56 | ! read(102,*)dum,rseise(k,1:NS) 57 | ! read(103,*)dum,rseisz(k,1:NS) 58 | ! enddo 59 | ! close(101) 60 | ! close(102) 61 | ! close(103) 62 | 63 | open(105,FILE='rvseisnez.dat') 64 | sseisn=0.d0;sseise=0.d0;sseisz=0.d0 65 | do k=int(T1/DT)+1,int(T2/DT)+1 66 | read(105,'(E13.5)',ADVANCE='NO')dum 67 | do i=1,NS 68 | if(stainfo(1,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseisn(k,i) 69 | if(stainfo(2,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseise(k,i) 70 | if(stainfo(3,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseisz(k,i) 71 | enddo 72 | read(105,*) 73 | enddo 74 | close(105) 75 | 76 | stept=1./dble(3)*(1.d0-margin)/(NT-1) 77 | do k=1,NS 78 | maxampln=maxval(abs(sseisn(NTfrom:NT+NTfrom,k))) 79 | maxample=maxval(abs(sseise(NTfrom:NT+NTfrom,k))) 80 | maxamplz=maxval(abs(sseisz(NTfrom:NT+NTfrom,k))) 81 | maxampl(k)=max(maxampln,max(maxample,maxamplz)) 82 | stepa(k)=.5d0/dble(NS)*(1.d0-margin)/maxampl(k) 83 | enddo 84 | 85 | open(205,FILE='SlipInv-seisplot.dat') 86 | !do j=1,NS 87 | ! starty=((NS-j+1)+margin/2.d0)/dble(NS+1) 88 | ! startx=((1-1)+margin/2.d0)/3.d0 89 | ! do k=NTfrom,NT+NTfrom-1 90 | ! write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*rseisn(k,j) 91 | ! enddo 92 | ! write(205,*) 93 | ! startx=((2-1)+margin/2.d0)/3.d0 94 | ! do k=NTfrom,NT+NTfrom-1 95 | ! write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*rseise(k,j) 96 | ! enddo 97 | ! write(205,*) 98 | ! startx=((3-1)+margin/2.d0)/3.d0 99 | ! do k=NTfrom,NT+NTfrom-1 100 | ! write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*rseisz(k,j) 101 | ! enddo 102 | ! write(205,*) 103 | !enddo 104 | !write(205,*) 105 | !write(205,*) 106 | 107 | do j=1,NS 108 | starty=((NS-j+1)+margin/2.d0)/dble(NS+1) 109 | if(stainfo(1,j)==1)then 110 | startx=((1-1)+margin/2.d0)/3.d0 111 | do k=NTfrom,NT+NTfrom-1 112 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseisn(k,j) 113 | enddo 114 | write(205,*) 115 | endif 116 | if(stainfo(2,j)==1)then 117 | startx=((2-1)+margin/2.d0)/3.d0 118 | do k=NTfrom,NT+NTfrom-1 119 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseise(k,j) 120 | enddo 121 | write(205,*) 122 | endif 123 | if(stainfo(3,j)==1)then 124 | startx=((3-1)+margin/2.d0)/3.d0 125 | do k=NTfrom,NT+NTfrom-1 126 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseisz(k,j) 127 | enddo 128 | write(205,*) 129 | endif 130 | enddo 131 | 132 | open(105,FILE='svseisnez.dat') 133 | sseisn=0.d0;sseise=0.d0;sseisz=0.d0 134 | do k=int(T1/DT)+1,int(T2/DT)+1 135 | read(105,'(E13.5)',ADVANCE='NO')dum 136 | do i=1,NS 137 | if(stainfo(1,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseisn(k,i) 138 | if(stainfo(2,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseise(k,i) 139 | if(stainfo(3,i)==1)read(105,'(E13.5)',ADVANCE='NO')sseisz(k,i) 140 | enddo 141 | read(105,*) 142 | enddo 143 | close(105) 144 | write(205,*) 145 | write(205,*) 146 | do j=1,NS 147 | starty=((NS-j+1)+margin/2.d0)/dble(NS+1) 148 | if(stainfo(1,j)==1)then 149 | startx=((1-1)+margin/2.d0)/3.d0 150 | do k=NTfrom,NT+NTfrom-1 151 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseisn(k,j) 152 | enddo 153 | write(205,*) 154 | endif 155 | if(stainfo(2,j)==1)then 156 | startx=((2-1)+margin/2.d0)/3.d0 157 | do k=NTfrom,NT+NTfrom-1 158 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseise(k,j) 159 | enddo 160 | write(205,*) 161 | endif 162 | if(stainfo(3,j)==1)then 163 | startx=((3-1)+margin/2.d0)/3.d0 164 | do k=NTfrom,NT+NTfrom-1 165 | write(205,'(3E13.5)')startx+stept*(k-NTfrom),starty+stepa(j)*sseisz(k,j) 166 | enddo 167 | write(205,*) 168 | endif 169 | enddo 170 | close(205) 171 | 172 | open(201,FILE='SlipInv-seisplot.gp') 173 | write(201,*)'set term postscript portrait color solid enh' 174 | write(201,*)'set output "SlipInv-seisplot.ps"' 175 | write(201,*)'set xrange [0:1]' 176 | write(201,*)'set yrange [0:1]' 177 | write(201,*)'unset xtics' 178 | write(201,*)'unset ytics' 179 | write(201,*)'set border 0' 180 | 181 | do j=1,NS 182 | write(201,'(A11,F5.2,A23,G,A6)')'set label "',real(maxampl(j))*100.,'" at graph 1.09, graph ',((NS-j+1)+margin/2.d0)/dble(NS+1),' right' 183 | write(201,*)'set label "'//staname(j)//'" at graph -0.01, graph ',((NS-j+1)+margin/2.d0)/dble(NS+1),' right' 184 | enddo 185 | write(201,*)'set label "N-S" at .15,1' 186 | write(201,*)'set label "E-W" at .48,1' 187 | write(201,*)'set label "Z" at .86,1' 188 | 189 | write(201,*)'plot "SlipInv-seisplot.dat" u 1:2 index 0 notitle w l lt -1 lw 1,\' 190 | write(201,*)'"SlipInv-seisplot.dat" u 1:2 index 1 notitle w l lt 1 lw 2' 191 | 192 | END 193 | -------------------------------------------------------------------------------- /src-graphics/SlipInv-seisplot.sh: -------------------------------------------------------------------------------- 1 | ifort -oSlipInv-seisplot SlipInv-seisplot.f90 2 | ./SlipInv-seisplot 3 | gnuplot SlipInv-seisplot.gp 4 | -------------------------------------------------------------------------------- /src-graphics/mtilde2anime.f90: -------------------------------------------------------------------------------- 1 | IMPLICIT NONE 2 | 3 | INTEGER,PARAMETER:: NM=1 !Column number in the input file (mtilde.dat) to plot 4 | REAL*8, PARAMETER:: sizex=0.48d0,sizey=0.24d0 5 | REAL*8,ALLOCATABLE,DIMENSION(:):: L,W 6 | REAL*8 tw,tw0 7 | INTEGER,ALLOCATABLE,DIMENSION(:):: NL,NW 8 | INTEGER NT,NS 9 | REAL*8 dum,maxik,minik 10 | REAL*8,ALLOCATABLE:: mtilde(:,:,:) 11 | REAL*8 DL,DW,DT 12 | INTEGER i,j,k,kk,m,tfrom,tto,NTP,NSeg 13 | 14 | open(10,FILE='input.dat') 15 | read(10,*) 16 | read(10,*) 17 | read(10,*) 18 | read(10,*)tw,tw0 19 | read(10,*) 20 | read(10,*)dum,NSeg 21 | allocate(NL(NSeg),NW(NSeg),L(NSeg),W(NSeg)) 22 | read(10,*) 23 | read(10,*) 24 | read(10,*) 25 | read(10,*)(NL(kk),NW(kk),kk=1,NSeg) 26 | read(10,*) 27 | read(10,*) 28 | read(10,*) 29 | read(10,*) 30 | read(10,*) 31 | read(10,*) 32 | read(10,*) 33 | read(10,*)(L(kk),W(kk),kk=1,NSeg) 34 | read(10,*) 35 | read(10,*) 36 | read(10,*) 37 | read(10,*)NTP 38 | close(10) 39 | 40 | DT=tw/dble(NTP) 41 | NT=int(tw0/DT+1.d0) 42 | NS=int(tw0) !Number of slides equals the slip rate time window 43 | open(101,FILE='mtilde.dat');write(*,*)'Converting mtilde.dat' 44 | ! open(101,FILE='inputtf.dat');write(*,*)'Converting inputtf.dat' 45 | ! open(101,FILE='GTd.dat');write(*,*)'Converting GTd.dat' 46 | ! open(101,FILE='eigenvectors.dat');write(*,*)'Converting eigenvectors.dat' 47 | 48 | open(202,FILE='mtilde2anime.dat') 49 | open(201,FILE='mtilde2anime.gp') 50 | do kk=1,NSeg 51 | allocate(mtilde(NT,NL(kk),NW(kk))) 52 | L(kk)=L(kk)/1.d3 53 | W(kk)=W(kk)/1.d3 54 | DL=L(kk)/dble(NL(kk)) 55 | DW=W(kk)/dble(NW(kk)) 56 | 57 | do k=1,NW(kk) 58 | do j=1,NL(kk) 59 | do i=1,NT 60 | read(101,*)(dum,m=1,NM) 61 | mtilde(i,j,k)=dum 62 | enddo 63 | enddo 64 | enddo 65 | 66 | maxik=0.d0;minik=0.d0 67 | do i=1,NS 68 | do j=1,NW(kk) 69 | tfrom=int(dble((i-1)*NT)/dble(NS)+1) 70 | ! tto=int(dble((i)*NT)/dble(NS)) 71 | tto=tfrom+1 72 | write(202,'(1000E13.5)')(sum(Mtilde(tfrom:tto,k,j))/dble(tto-tfrom+1),k=1,NL(kk)),sum(Mtilde(tfrom:tto,NL(kk),j))/dble(tto-tfrom+1) 73 | enddo 74 | write(202,'(1000E13.5)')(sum(Mtilde(tfrom:tto,k,NW(kk)))/dble(tto-tfrom+1),k=1,NL(kk)),sum(Mtilde(tfrom:tto,NL(kk),NW(kk)))/dble(tto-tfrom+1) 75 | write(202,*);write(202,*) 76 | dum=maxval(sum(Mtilde(tfrom:tto,1:NL(kk),1:NW(kk)),dim=1))/dble(tto-tfrom+1) 77 | if(dum>maxik)maxik=dum 78 | dum=minval(sum(Mtilde(tfrom:tto,1:NL(kk),1:NW(kk)),dim=1))/dble(tto-tfrom+1) 79 | if(dumwaterlevel)then 63 | mtilde(i,j,k)=dum 64 | else 65 | mtilde(i,j,k)=0.d0 66 | endif 67 | if(i==1)then 68 | cumulmtilde(1)=mtilde(1,j,k) 69 | else 70 | cumulmtilde(i)=cumulmtilde(i-1)+mtilde(i,j,k) 71 | endif 72 | ! read(102,*)(CM(i,j,k),m=1,NM) 73 | enddo 74 | do i=1,NT 75 | if(cumulmtilde(i)0.)waterlevel=0. 96 | stept=L(kk)/dble(NL(kk)+1)*(1.d0-margin)/(NT-1) 97 | stepa=W(kk)/dble(NW(kk)+1)*(1.d0-margin)/(maxampl-waterlevel) 98 | 99 | do i=1,NL(kk) 100 | startx=((i-1)+margin/2.d0)*L(kk)/dble(NL(kk)) 101 | do j=1,NW(kk) 102 | starty=((j-1)+margin/2.d0)*W(kk)/dble(NW(kk)) 103 | do k=1,NT 104 | write(205,'(3E13.5)')startx+stept*(k-1),starty+stepa*(mtilde(k,i,j)-waterlevel) 105 | ! write(206,'(3E13.5)')startx+stept*(k-1),starty+stepa*(CM(k,i,j)-waterlevel) 106 | enddo 107 | write(205,*) 108 | ! write(206,*) 109 | enddo 110 | enddo 111 | write(205,'(3E13.5)')0.d0,0.d0 112 | ! write(206,'(3E13.5)')0.d0,0.d0 113 | write(205,*) 114 | write(205,*) 115 | 116 | !grid 117 | do i=1,NL(kk)+1 118 | write(215,*)dble(i-1)*L(kk)/dble(NL(kk)),0.d0 119 | write(215,*)dble(i-1)*L(kk)/dble(NL(kk)),W(kk) 120 | write(215,*) 121 | enddo 122 | do i=1,NW(kk)+1 123 | write(215,*)0.d0,dble(i-1)*W(kk)/dble(NW(kk)) 124 | write(215,*)L(kk),dble(i-1)*W(kk)/dble(NW(kk)) 125 | write(215,*) 126 | enddo 127 | write(215,*) 128 | write(215,*) 129 | 130 | write(211,*)'set term postscript landscape color solid enh 16' 131 | write(211,'(A28,I1,A4)')'set output "slipratesonfault',kk,'.ps"' 132 | write(211,*)'set pm3d map corners2color c1' 133 | write(211,*)'set size ratio -1' 134 | write(211,'(80A)')'set palette defined ( 0 "white", 2 "skyblue", 3 "light-green", 6 "yellow", 10 "light-red" )' 135 | write(211,*)'DL=',DL 136 | write(211,*)'DW=',DW 137 | write(211,*)'set xrange [',-L(kk)/float(NL(kk))/2.,':',L(kk)+L(kk)/float(NL(kk))/2.,']' 138 | write(211,*)'set yrange [',-W(kk)/float(NW(kk))/2.,':',W(kk)+W(kk)/float(NW(kk))/2.,']' 139 | write(211,*)'set xlabel "Along strike (km)' 140 | write(211,*)'set ylabel "Up-dip (km)"' 141 | write(211,*)'set cblabel "Slip (m)"' 142 | write(211,*)'set xtics 5 scale 0.5 out' 143 | write(211,*)'set ytics 5 scale 0.5 out' 144 | write(211,*)'set mxtics 5' 145 | write(211,*)'set mytics 5' 146 | 147 | write(211,*)'set colorbox' 148 | ! write(211,*)'set cbrange [0:.8]' 149 | 150 | write(211,*)'splot "mtildeslip2D.dat" matrix u ($1*DL):($2*DW):3 index \' 151 | write(211,*)(NM-1)*NSeg+kk-1,' notitle w pm3d, \' 152 | ! write(211,*)'"slipratesonfault.plot2.dat" u 1:2:(0) index ',kk-1,' notitle w l lt 2 lw 2, \' 153 | write(211,*)'"slipratesonfault.plot1.dat" u 1:2:(0) index \' 154 | write(211,*)kk-1,' notitle w l lt -1 lw 1, \' 155 | write(211,*)'"slipratesonfault.grid.dat" u 1:2:(0) index \' 156 | write(211,*)kk-1,' notitle w l lt 0 lw 1,\' 157 | write(211,*)'"epic.dat" u 1:2:(0) index ',kk-1,' notitle w p pt 3 lc 3 ps 2.' 158 | 159 | deallocate(mtilde,CM,cumulmtilde,rupttime,risetime,peaktime) 160 | enddo 161 | close(101) 162 | ! close(102) 163 | close(205) 164 | close(206) 165 | close(215) 166 | close(211) 167 | close(292) 168 | 169 | END 170 | -------------------------------------------------------------------------------- /src-graphics/slipratesonfault.sh: -------------------------------------------------------------------------------- 1 | ifort -oslipratesonfault slipratesonfault.f90 2 | ./slipratesonfault 3 | gnuplot slipratesonfault.plot.gp 4 | -------------------------------------------------------------------------------- /src-stations/README.md: -------------------------------------------------------------------------------- 1 | #Code for converting the station locations 2 | ------------------------------------------ 3 | 4 | Fortran 90 code that converts location of stations from lat, long to X, Y (X points towards north, Y towards east). 5 | 6 | The source code `stations.f90` can be compiled and executed by script `stations.sh`. 7 | -------------------------------------------------------------------------------- /src-stations/stations.f90: -------------------------------------------------------------------------------- 1 | ! Converts stations locations from lat,long to X,Y (X points towards north, Y towards east) 2 | ! -------- 3 | ! AUTHOR: Frantisek Gallovic 4 | ! -------- 5 | 6 | IMPLICIT NONE 7 | REAL*8,PARAMETER:: PI=3.1415926535d0 8 | REAL*8 x,y,lat,long 9 | REAL*8 reflat,reflong 10 | 11 | OPEN(110,FILE='stations.in') !reference point (corresponds to the reference point in the input.dat file) 12 | read(110,*) 13 | read(110,*)reflat,reflong 14 | CLOSE(110) 15 | 16 | OPEN(110,FILE='stations.txt') !INPUT 17 | OPEN(111,FILE='stations.dat') !OUTPUT 18 | 19 | 10 read(110,*,END=12)lat,long 20 | CALL POISTA(lat,long,reflat,reflong,x,y) 21 | write(111,*)x,y,0. !Station co-ordinates x(N>0,km),y(E>0,km),z(km) 22 | goto 10 23 | 12 continue 24 | END 25 | 26 | 27 | 28 | 29 | SUBROUTINE POISTA(lat,long,lat0,long0,x,y) 30 | IMPLICIT NONE 31 | REAL*8 x,y,lat,long,lat0,long0,azi,dist 32 | REAL*8 glat,glong,geocn,fltdis,fltazi 33 | azi=FLTAZI(lat0,long0,lat,long) 34 | dist=FLTDIS(lat0,long0,lat,long) 35 | x=dist*cos(azi*0.017453292519943296d0) 36 | y=dist*sin(azi*0.017453292519943296d0) 37 | END 38 | 39 | FUNCTION FLTAZI(ELAT,ELON,SLAT,SLON) 40 | ! Returns azimut between 2 geodetic points 41 | REAL*8 ELAT,ELON,SLAT,SLON,AZ,DIST 42 | REAL*8 GELAT,GELON,GSLAT,GSLON,GEOCN,FLTAZI 43 | GELAT=GEOCN(ELAT) 44 | GELON=ELON 45 | GSLAT=GEOCN(SLAT) 46 | GSLON=SLON 47 | CALL AZDIST(GELAT,GELON,GSLAT,GSLON,AZ,DIST) 48 | FLTAZI=AZ 49 | RETURN 50 | END 51 | 52 | FUNCTION FLTDIS(RLAT1,RLON1,RLAT2,RLON2) 53 | ! Returns the distance in kilometers of 2 geodetic points 54 | REAL*8 GEOCN,GELAT,ELON,GSLAT,SLON,AZ,DIST,FLTDIS 55 | REAL*8 RLAT1,RLON1,RLAT2,RLON2 56 | GSLAT=GEOCN(RLAT1) 57 | SLON=RLON1 58 | GELAT=GEOCN(RLAT2) 59 | ELON=RLON2 60 | CALL AZDIST(GELAT,ELON,GSLAT,SLON,AZ,DIST) 61 | FLTDIS=111.1*DIST 62 | RETURN 63 | END 64 | 65 | 66 | 67 | !------------------------------------------------------------------------------ 68 | SUBROUTINE AZDIST(ELAT,ELON,SLAT,SLON,AZ,DIST) 69 | ! Returns the epicentral distance in degrees and the azimut (on the ellipsoid) 70 | REAL*8 PI,RTOD,DTOR 71 | REAL*8 ELAT,ELON,SLAT,SLON,AZ,DIST 72 | REAL*8 SLA,SLO,ELA,ELO,SLAC,SLAS,SLOC,SLOS,ELAC,ELAS,ELOC,ELOS,AS,BS,CS,DS,ES,GS,HS,SK,AE,BE,CE,DE,EE,GE,HE,EK,CDIST,SDIST,CSDIST,CAZ,SAZ 73 | DATA PI/3.1415927D0/,RTOD/57.29578D0/,DTOR/0.0174533D0/ 74 | 75 | ELAT=ELAT+1.0E-5 76 | ELON=ELON+1.0E-5 77 | SLA=SLAT*DTOR 78 | SLO=SLON*DTOR 79 | ELA=ELAT*DTOR 80 | ELO=ELON*DTOR 81 | 82 | SLAC=DCOS(SLA) 83 | SLAS=DSIN(SLA) 84 | SLOC=DCOS(SLO) 85 | SLOS=DSIN(SLO) 86 | 87 | ELAC=DCOS(ELA) 88 | ELAS=DSIN(ELA) 89 | ELOC=DCOS(ELO) 90 | ELOS=DSIN(ELO) 91 | 92 | AS=SLAC*SLOC 93 | BS=SLAC*SLOS 94 | CS=SLAS 95 | DS=SLOS 96 | ES=-SLOC 97 | GS=SLAS*SLOC 98 | HS=SLAS*SLOS 99 | SK=-SLAC 100 | 101 | AE=ELAC*ELOC 102 | BE=ELAC*ELOS 103 | CE=ELAS 104 | DE=ELOS 105 | EE=-ELOC 106 | GE=ELAS*ELOC 107 | HE=ELAS*ELOS 108 | EK=-ELAC 109 | 110 | CDIST=AE*AS+BE*BS+CE*CS 111 | SDIST=DSQRT(1.0-CDIST*CDIST) 112 | DIST=RTOD*DATAN2(SDIST,CDIST) 113 | CSDIST=1./SDIST 114 | SAZ=-(AS*DE+BS*EE)*CSDIST 115 | CAZ=-(AS*GE+BS*HE+CS*EK)*CSDIST 116 | 117 | AZ=DATAN2(SAZ,CAZ) 118 | IF(AZ.LT.0.0)AZ=AZ+2.*PI 119 | AZ=AZ*RTOD 120 | 121 | RETURN 122 | END 123 | !------------------------------------------------------------------------------ 124 | !Converts geodetic latitude to geocentric 125 | FUNCTION GEOCN(ALAT) 126 | REAL*8 RTOD,DTOR,ALAT,GCON,GEOCN 127 | DATA RTOD/57.29578D0/,DTOR/0.0174533D0/ 128 | GCON=0.9932315D0 129 | GEOCN=RTOD*ATAN(GCON*(SIN(ALAT*DTOR)/COS(ALAT*DTOR))) 130 | RETURN 131 | END 132 | !------------------------------------------------------------------------------ 133 | !Converts geocentric latitude to geodetic 134 | FUNCTION CNGEO(ALAT) 135 | REAL*8 RTOD,DTOR,ALAT,GCON,CNGEO 136 | DATA RTOD/57.29578D0/,DTOR/0.0174533D0/ 137 | GCON=0.9932315D0 138 | CNGEO=atan(tan(ALAT/RTOD)/GCON)/DTOR 139 | RETURN 140 | END 141 | 142 | -------------------------------------------------------------------------------- /src-stations/stations.sh: -------------------------------------------------------------------------------- 1 | ifort -ostations stations.f90 2 | ./stations 3 | -------------------------------------------------------------------------------- /src/CreateGandD.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/src/CreateGandD.f90 -------------------------------------------------------------------------------- /src/OutputModel.f90: -------------------------------------------------------------------------------- 1 | ! AUTHOR: Frantisek Gallovic 2 | 3 | SUBROUTINE OutputModel() 4 | USE SISVDmodule 5 | IMPLICIT NONE 6 | REAL*8,ALLOCATABLE:: varred(:),Mtilde(:,:,:),VRgps(:) 7 | REAL*8 M0tilde 8 | INTEGER i,j,k,kk,SegShift 9 | integer,dimension(8) :: date 10 | REAL*4 stalocGPS(2) 11 | 12 | allocate(varred(lambdanum),VRgps(lambdanum)) 13 | 14 | open(201,FILE='mtilde.dat') 15 | do j=1,Msvd 16 | write(201,'(1000E13.5)')(M(j,i),i=1,lambdanum) 17 | enddo 18 | close(201) 19 | 20 | if(NRseis>0)then 21 | do i=1,NSTAcomp 22 | if(abs(smoothkoef)>0.d0)then 23 | D((i-1)*nT+1:i*nT)=D((i-1)*nT+1:i*nT)*normdat(i)*sum(1.d0/normdat)/sum(staweight(:,:)*dble(stainfo(:,:)))*smoothkoefGF 24 | Dout((i-1)*nT+1:i*nT,:)=Dout((i-1)*nT+1:i*nT,:)*normdat(i)*sum(1.d0/normdat)/sum(staweight(:,:)*dble(stainfo(:,:)))*smoothkoefGF 25 | else 26 | D((i-1)*nT+1:i*nT)=D((i-1)*nT+1:i*nT)*normdat(i) 27 | Dout((i-1)*nT+1:i*nT,:)=Dout((i-1)*nT+1:i*nT,:)*normdat(i) 28 | endif 29 | enddo 30 | open(296,FILE='rvseisnez.dat') 31 | do i=1,nT 32 | write(296,'(1000E13.5)')dt*(iT1-1+i-1),(D((j-1)*nT+i),j=1,NSTAcomp) 33 | enddo 34 | close(296) 35 | 36 | open(484,FILE='varred.dat') 37 | open(297,FILE='svseisnez.dat') 38 | do k=1,lambdanum 39 | varred(k)=1.d0-sum((D(1:Nseis)-Dout(1:Nseis,k))**2)/sum(D(1:Nseis)**2) 40 | write(484,'(I5,3E13.5)')lambdafrom+k-1,maxw/W(lambdafrom+k-1),smoothkoef,varred(k) 41 | do i=1,nT 42 | write(297,'(1000E13.5)')dt*(iT1-1+i-1),(Dout((j-1)*nT+i,k),j=1,NSTAcomp) 43 | enddo 44 | write(297,*);write(297,*) 45 | enddo 46 | 47 | write(*,*)' (variance reduction: ',varred(1),')' 48 | 49 | endif 50 | 51 | if(smoothkoef>0.d0)write(*,*)' (RMS of covariance constraint ',sqrt(sum(Dout(Nseis+Ngps+2:Nseis+Ngps+1+Nsmooth,1)**2)/dble(Nsmooth))/abs(smoothkoef),')' 52 | 53 | 54 | open(296,FILE='mtildeslip2D.dat') 55 | open(201,FILE='mtilde1d.dat') 56 | open(202,FILE='mtilde.gnuplot.dat') 57 | open(295,FILE='mtildemomentrate.dat') 58 | 59 | M0tilde=0.d0 60 | do k=1,lambdanum 61 | do kk=1,NSeg 62 | allocate(Mtilde(Ssvd,NL(kk),NW(kk))) 63 | SegShift=sum(NW(1:kk-1)*NL(1:kk-1))*Ssvd 64 | Mtilde=RESHAPE(M(SegShift+1:SegShift+NW(kk)*NL(kk)*Ssvd,k),(/Ssvd, NL(kk), NW(kk)/)) 65 | do i=1,Ssvd 66 | write(201,'(1000E13.5)')(sum(Mtilde(i,j,1:NW(kk)))*dW(kk),j=1,NL(kk)) 67 | enddo 68 | write(201,*);write(201,*) 69 | if(k==1)then 70 | do i=1,Ssvd 71 | M0tilde=M0tilde+sum(Mtilde(i,1:NL(kk),1:NW(kk))*mu(1:NL(kk),1:NW(kk),kk))*elem(kk)*dt 72 | enddo 73 | endif 74 | do i=1,Ssvd 75 | do j=1,NW(kk) 76 | write(202,'(1000E13.5)')Mtilde(i,1:NL(kk),j) 77 | enddo 78 | write(202,*);write(202,*) 79 | enddo 80 | do j=1,NW(kk) 81 | write(296,'(1000E13.5)')(sum(Mtilde(1:Ssvd,i,j))*dt,i=1,NL(kk)),sum(Mtilde(1:Ssvd,NL(kk),j))*dt 82 | enddo 83 | write(296,'(1000E13.5)')(sum(Mtilde(1:Ssvd,i,NW(kk)))*dt,i=1,NL(kk)),sum(Mtilde(1:Ssvd,NL(kk),NW(kk)))*dt 84 | write(296,*);write(296,*) 85 | do j=1,Ssvd !Moment rate of individual segments 86 | write(295,'(1000E13.5)')dt*(j-1),sum(Mtilde(j,1:NL(kk),1:NW(kk))*mu(1:NL(kk),1:NW(kk),kk))*dL(kk)*dW(kk) 87 | enddo 88 | write(295,*);write(295,*) 89 | deallocate(Mtilde) 90 | enddo 91 | enddo 92 | write(*,*)' (scalar moment ',M0tilde,')' 93 | write(*,*)' (scalar moment discrepancy ',Mfix/M0tilde*100.d0,'%)' 94 | 95 | if(NRgps>0)then 96 | open(232,FILE='stations-GPS.dat',action='read') 97 | open(292,file='stations-GPS-data.dat') 98 | do i=1,NRgps 99 | read(232,*)stalocGPS(1:2) 100 | D(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3)=D(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3)*sigmaGPS(1:3,i) 101 | write(292,'(5E13.5)')stalocGPS(1:2),D(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3) 102 | enddo 103 | close(232) 104 | close(292) 105 | open(485,FILE='varredGPS.dat') 106 | open(298,FILE='mtildeslip2D-sGPS.out') 107 | do k=1,lambdanum 108 | open(232,FILE='stations-GPS.dat',action='read') 109 | do i=1,NRgps 110 | read(232,*)stalocGPS(1:2) 111 | Dout(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3,k)=Dout(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3,k)*sigmaGPS(1:3,i) 112 | write(298,'(5E13.5)')stalocGPS(1:2),Dout(Nseis+(i-1)*3+1:Nseis+(i-1)*3+3,k) 113 | enddo 114 | write(298,*);write(298,*) 115 | close(232) 116 | VRgps(k)=1.d0-sum((D(Nseis+1:Nseis+Ngps)-Dout(Nseis+1:Nseis+Ngps,k))**2)/sum(D(Nseis+1:Nseis+Ngps)**2) 117 | write(485,'(I5,6E13.5)')lambdafrom+k-1,maxw/W(lambdafrom+k-1),smoothkoef,VRgps(k),M0tilde,relatweightGPS,smoothaspectratio 118 | enddo 119 | endif 120 | 121 | 122 | open(299,FILE='srcmod.dat') 123 | call date_and_time(VALUES=date) 124 | do kk=1,NSeg 125 | write(299,'(A)')'# -----------------------------------------------------------------------------------------------------------' 126 | write(299,'(A)')'# SIV Inversion Exercise : xx' 127 | write(299,'(A,I2,A,I2,A,I4)')'# Date : ',date(3),'.',date(2),'.',date(1) 128 | write(299,'(A)')'# Modeler : F. Gallovic' 129 | write(299,'(A)')'# Inversion Method : Linear multi time-window with k^-2 smoothing' 130 | write(299,'(A)')'# Ground-motion code : Axitra' 131 | write(299,'(A,F8.3,A,E13.5)')'# SourcePar1 Mw-Mo [Nm] :',2./3.*log10(M0tilde)-6.0333,',',M0tilde 132 | write(299,'(A,F8.3,A,F8.3)')'# SourcePar2 L-W [km] :',leng(kk)/1000.,',',widt(kk)/1000. 133 | write(299,'(A,F8.3,A,F8.3)')'# SourcePar3 Strike-Dip [degrees] :',strike(kk),',',dip(kk) 134 | write(299,'(A)')'# Hypocenter X-Y-Z [km] : 0, 0,', -hypodepth(kk)/1000. 135 | write(299,'(A,E13.5)')'# Depth2Top Z2top [km] :',-minval(sourZgps(:,:,kk))/1000.+dW(kk)/2./1000. 136 | write(299,'(A,I,A,I)')'# NumPoints Nx-Nz :',NL(kk),',',NW(kk) 137 | write(299,'(A,I,A,F8.3)')'# NumTimeWn Nt-Dt :',Ssvd,',',DT 138 | write(299,'(A)')'# ElemSTF : iso-tri ' 139 | write(299,'(A)')'# ------------------------------------------------------------------------------------------------------------' 140 | write(299,'(A)')'# X Y Z TotalSlip Rake RupTime SlipTW SlipTW ...' 141 | write(299,'(A)')'# km km km m deg s m m ...' 142 | write(299,'(A)')'# ------------------------------------------------------------------------------------------------------------' 143 | allocate(Mtilde(Ssvd,NL(kk),NW(kk))) 144 | SegShift=sum(NW(1:kk-1)*NL(1:kk-1))*Ssvd 145 | Mtilde(:,:,:)=RESHAPE(M(SegShift+1:SegShift+NW(kk)*NL(kk)*Ssvd,1),(/Ssvd, NL(kk), NW(kk)/)) 146 | do i=1,NL(kk) 147 | do j=1,NW(kk) 148 | write(299,'(1000E13.5)')sourEgps(i,j,kk)/1000.,sourNgps(i,j,kk)/1000.,-sourZgps(i,j,kk)/1000.,sum(Mtilde(1:Ssvd,i,j))*dt,rakeGPS(i,j,kk),T0,sum(Mtilde(1:Ssvd,i,j))*dt 149 | enddo 150 | enddo 151 | deallocate(Mtilde) 152 | enddo 153 | 154 | END 155 | -------------------------------------------------------------------------------- /src/README.md: -------------------------------------------------------------------------------- 1 | #Inversion codes 2 | ---------------- 3 | 4 | Each of the inversion codes consists of several source files. Some of the source files are shared. 5 | 6 | ####Linear multi time-window earthquake slip inversion with *k*^-2 smoothing and positivity constraint (NNLS). 7 | - The code can be compiled by the following scripts `compile.SlipInvNNLS.sh`. 8 | 9 | ####Eigenanalysis and Truncated SVD solution of the linear multi time-window earthquake slip inversion 10 | - `SlipInvSVD1`: Applies SVD to the linear multi time-window earthquake slip inversion, providing singular values and vectors. Compile using script `compile.SlipInvSVD1.sh`. 11 | - `SlipInvSVD2`: Uses the singular values and vectors calculated by `SlipInvSVD1` to solve the slip inversion. Compile using script `compile.SlipInvSVD2.sh` 12 | 13 | Notes: 14 | - Input files are shared by all the codes. 15 | - The use of MKL is higly recommended. SVD is several orders faster than that from the Numerical recipes. 16 | 17 | Credits: 18 | - Intel MKL library for utlimate performance in linear algebra (SVD, matrix operations). 19 | - Nonnegative Least Square (NNLS) code originally developed by Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory (and published in the book "SOLVING LEAST SQUARES PROBLEMS", Prentice-Hall, 1974, translated to Fortran 90 by Alan Miller (February 1997). 20 | - Modified NNLS subroutine by Luo and Duraiswami (2011) taking advantage of OpenMP and the Intel MKL library. 21 | - Subroutine XAPIIR (IIR filter design and implementation) by Dave Harris (1990). 22 | - Subroutines Numerical recipes (FFT, SVD). 23 | - CULA subroutine for SVD on GPU. 24 | 25 | -------------------------------------------------------------------------------- /src/SlipInvNNLS.f90: -------------------------------------------------------------------------------- 1 | ! AUTHOR: Frantisek Gallovic 2 | 3 | PROGRAM SlipInvNNLS 4 | USE SISVDmodule 5 | #ifdef NNLSMKL 6 | USE iso_c_binding 7 | #endif 8 | IMPLICIT NONE 9 | REAL*8 rnorm 10 | REAL*8,ALLOCATABLE:: work(:) 11 | INTEGER,ALLOCATABLE:: iwork(:) 12 | INTEGER dumi,i 13 | 14 | #ifdef NNLSMKL 15 | ! --- INTEROPERABLE VARIABLES 16 | INTEGER,PARAMETER :: DP = c_double ! ifdef USE_DOUBLE: c_double, otherwise: c_float 17 | INTEGER(c_int) :: method = 1 ! 0-1 18 | INTEGER(c_int) :: Nnnls ! equations 19 | INTEGER(c_int) :: Mnnls ! unknowns 20 | INTEGER(c_int) :: NSYS = 1 ! pocet soustav 21 | INTEGER(c_int) :: isTransposed = 0 ! matrix transpose 22 | REAL(DP) :: TOL_TERMINATION = 1d-6 ! tolerance 23 | INTEGER(c_int) :: MKLThreads = 6 ! MKL threads 24 | INTEGER(c_int) :: OMPThreads = 1 ! OpenMP threads 25 | INTEGER(c_int) :: MAX_ITER_LS,MAX_ITER_NNLS 26 | ! --- INTERFACES TO C FUNCTIONS 27 | INTERFACE 28 | 29 | SUBROUTINE nnlsOMPSysMKL(A,b,x,isTransposed,maxNNLSIters,maxLSIters,nSys,m,n,MKLT,OMPT,TOL_TERMINATION) BIND(C,NAME='nnlsOMPSysMKL') 30 | IMPORT c_int,DP 31 | REAL(DP) :: A(*),b(*),x(*) 32 | INTEGER(c_int),VALUE :: isTransposed,maxNNLSIters,maxLSIters,nSys,m,n,MKLT,OMPT 33 | REAL(DP),VALUE :: TOL_TERMINATION 34 | END SUBROUTINE 35 | 36 | SUBROUTINE nnlsOMPSysMKLUpdates(A,b,x,isTransposed,maxNNLSIters,maxLSIters,nSys,m,n,MKLT,OMPT,TOL_TERMINATION) BIND(C,NAME='nnlsOMPSysMKLUpdates') 37 | IMPORT c_int,DP 38 | REAL(DP) :: A(*),b(*),x(*) 39 | INTEGER(c_int),VALUE :: isTransposed,maxNNLSIters,maxLSIters,nSys,m,n,MKLT,OMPT 40 | REAL(DP),VALUE :: TOL_TERMINATION 41 | END SUBROUTINE 42 | 43 | END INTERFACE 44 | #endif 45 | 46 | 47 | CALL Init() 48 | allocate(G(Nsvd,Msvd),D(Nsvd),W(Msvd)) 49 | if(NRseis>0)allocate(normdat(NSTAcomp)) 50 | if(NRgps>0)allocate(sigmaGPS(3,NRgps)) 51 | lambdanum=1 52 | allocate(Dout(Nsvd,lambdanum),M(Msvd,lambdanum)) 53 | CALL CreateGandD() 54 | 55 | write(*,*)'Saving matrix G and vector D to G.dat ...' 56 | open(111,form='unformatted',FILE='G.dat') 57 | do i=1,Msvd 58 | write(111)G(1:Nsvd,i) 59 | enddo 60 | write(111)D 61 | close(111) 62 | 63 | write(*,*)'Calculating m_tilde using NNLS ...' 64 | write(*,*)' (matrix ',Nsvd,'x',Msvd,')' 65 | 66 | #ifdef NNLSMKL 67 | 68 | Nnnls=Nsvd 69 | Mnnls=Msvd 70 | MAX_ITER_LS=(Mnnls+Nnnls)*2 71 | MAX_ITER_NNLS=MAX_ITER_LS 72 | call nnlsOMPSysMKLUpdates(G,D,M(:,1),isTransposed,MAX_ITER_NNLS,MAX_ITER_LS,NSYS,Nnnls,Mnnls,MKLThreads,OMPThreads,TOL_TERMINATION) 73 | 74 | #else 75 | 76 | allocate(work(Msvd),iwork(Msvd)) 77 | CALL NNLS (G,Nsvd,Msvd,D,M(:,1),rnorm,work,iwork,dumi) 78 | deallocate(work,iwork) 79 | 80 | #endif 81 | 82 | open(111,form='unformatted',FILE='G.dat') 83 | do i=1,Msvd 84 | read(111)G(1:Nsvd,i) 85 | enddo 86 | read(111)D 87 | close(111) 88 | Dout=matmul(G,M) 89 | 90 | maxw=-1.d0;W=1.d0;lambdafrom=1 !ONLY FORMAL definitions 91 | 92 | CALL OutputModel() 93 | 94 | END 95 | -------------------------------------------------------------------------------- /src/SlipInvSVD1.f90: -------------------------------------------------------------------------------- 1 | ! Singular Value Decomposition applied to the linear slip inversion problem 2 | ! AUTHOR: Frantisek Gallovic 3 | 4 | ! WARNING: USE CULA ONLY IN COMBINATION WITH MKL ! 5 | 6 | PROGRAM SlipInvSVD1 7 | USE SISVDmodule 8 | #ifdef CULA 9 | USE cula_status 10 | USE cula_lapack 11 | #endif 12 | IMPLICIT NONE 13 | REAL*8,ALLOCATABLE:: GTd(:),work(:),GTdvec(:,:,:),eigvec(:,:,:) 14 | INTEGER lwork,info 15 | INTEGER i,j,k,kk,SegShift 16 | #ifdef CULA 17 | REAL*4,ALLOCATABLE:: culaG(:,:),culaW(:),culaVT(:,:) 18 | #endif 19 | 20 | CALL Init() 21 | allocate(G(Nsvd,Msvd),D(Nsvd),W(Msvd)) 22 | if(NRseis>0)allocate(normdat(NSTAcomp)) 23 | if(NRgps>0)allocate(sigmaGPS(3,NRgps)) 24 | #ifdef MKL 25 | allocate(VT(minMNsvd,Msvd)) 26 | #else 27 | allocate(V(Msvd,Msvd)) 28 | #endif 29 | CALL CreateGandD() 30 | 31 | write(*,*)' (saving matrix G and vector D to G.dat ...)' 32 | open(111,form='unformatted',FILE='G.dat') 33 | do i=1,Msvd 34 | write(111)G(1:Nsvd,i) 35 | enddo 36 | write(111)D 37 | close(111) 38 | 39 | write(*,*)'Calculating vector GTd ...' 40 | allocate(GTd(Msvd)) 41 | open(198,FILE='GTd1d.dat') 42 | open(199,FILE='GTd.dat') 43 | #ifdef MKL 44 | call dgemv('T',Nsvd,Msvd,1.d0,G ,Nsvd,D,1,0.d0,GTd,1) 45 | #else 46 | GTd=matmul(D,G) 47 | #endif 48 | write(*,*)' (saving)' 49 | do kk=1,NSeg 50 | allocate(GTdvec(Ssvd,NL(kk),NW(kk))) 51 | SegShift=sum(NW(1:kk-1)*NL(1:kk-1))*Ssvd 52 | GTdvec=RESHAPE(GTd(SegShift+1:SegShift+NW(kk)*NL(kk)*Ssvd),(/Ssvd, NL(kk), NW(kk)/)) 53 | write(199,'(1E13.5)')GTdvec 54 | write(199,*);write(199,*) 55 | do i=1,Ssvd 56 | write(198,'(1000E13.5)')(sum(GTdvec(i,j,1:NW(kk))),j=1,NL(kk)) 57 | enddo 58 | write(198,*);write(198,*) 59 | deallocate(GTdvec) 60 | enddo 61 | close(198) 62 | close(199) 63 | deallocate(GTd) 64 | 65 | write(*,*)'Decomposition of matrix',Nsvd,'x',Msvd,'...' 66 | #ifndef MKL 67 | write(*,*)' (using Numerical Recepies)' 68 | CALL svdcmp(G,Nsvd,Msvd,Nsvd,Msvd,W,V) ! Warning: G became U 69 | goto 233 70 | #endif 71 | #ifdef CULA 72 | write(*,*)' (using GPU...)' 73 | allocate(culaG(Nsvd,Msvd),culaW(Msvd),culaVT(minMNsvd,Msvd)) 74 | culaG=G 75 | info = cula_initialize() 76 | if(info.ne.0)stop 77 | write(*,*) ' (...CULA initiated)' 78 | if(minSVDchoice==1)then ! Warning: G became U 79 | info = cula_sgesvd('O','S',Nsvd,Msvd,culaG,Nsvd,culaW,culaG,Nsvd,culaVT,minMNsvd) 80 | else 81 | info = cula_sgesvd('O','A',Nsvd,Msvd,culaG,Nsvd,culaW,culaG,Nsvd,culaVT,minMNsvd) 82 | endif 83 | if(info.ne.0)then 84 | CALL cula_check_status(info) 85 | stop 86 | endif 87 | write(*,*) ' (CULA finished)' 88 | call cula_shutdown() 89 | 90 | do i=1,Msvd !Assuming that the singular vectors are sorted descendently 91 | if(culaW(i)<1.e-10)exit ! CULA WORKS IN REAL*4 AND THUS HAS PROBLEMS WITH VERY SMALL SINGULAR VALUES 92 | enddo 93 | culaW(i:Msvd)=0. 94 | 95 | G=culaG 96 | W=culaW 97 | VT=culaVT 98 | deallocate(culaG,culaW,culaVT) 99 | goto 233 100 | #endif 101 | #ifdef MKL 102 | write(*,*)' (using MKL)' 103 | allocate(work(1)) 104 | lwork=-1 105 | if(minSVDchoice==1)then 106 | CALL dgesvd('O','S',Nsvd,Msvd,G,Nsvd,W,G,Nsvd,VT,minMNsvd,work,lwork,info) 107 | else 108 | CALL dgesvd('O','A',Nsvd,Msvd,G,Nsvd,W,G,Nsvd,VT,minMNsvd,work,lwork,info) 109 | endif 110 | lwork=int(work(1)) 111 | deallocate(work) 112 | allocate(work(lwork)) 113 | if(minSVDchoice==1)then ! Warning: G became U 114 | CALL dgesvd('O','S',Nsvd,Msvd,G,Nsvd,W,G,Nsvd,VT,minMNsvd,work,lwork,info) 115 | else 116 | CALL dgesvd('O','A',Nsvd,Msvd,G,Nsvd,W,G,Nsvd,VT,minMNsvd,work,lwork,info) 117 | endif 118 | if(info.ne.0)stop 119 | deallocate(work) 120 | #endif 121 | 122 | 233 write(*,*)'Done. Saving ...' 123 | 124 | write(*,*)' (singular values)' 125 | open(198,FILE='singularvalues.dat');write(198,'(1E12.5)')W(:);close(198) 126 | 127 | write(*,*)' (SVD.dat)' 128 | open(111,form='unformatted',FILE='SVD.dat') 129 | write(111)D 130 | if(NRseis>0)write(111)normdat 131 | if(NRgps>0)then 132 | write(111)normdatGPS 133 | write(111)sigmaGPS 134 | endif 135 | write(111)W 136 | #ifdef MKL 137 | do i=1,minMNsvd 138 | write(111)VT(i,1:Msvd) ! MKL SVD returns VT instead of V 139 | enddo 140 | #else 141 | do i=1,minMNsvd 142 | write(111)V(1:Msvd,i) 143 | enddo 144 | #endif 145 | i=0;write(111)i 146 | write(111)G 147 | i=0;write(111)i 148 | close(111) 149 | 150 | END 151 | 152 | -------------------------------------------------------------------------------- /src/SlipInvSVD2.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fgallovic/LinSlipInv/0577593c2031a7f3be97657dd44f8f74abd3ea33/src/SlipInvSVD2.f90 -------------------------------------------------------------------------------- /src/compile.SlipInvNNLS.sh: -------------------------------------------------------------------------------- 1 | #Compile with MKL NNLS 2 | icc -O -c -openmp nnlsmkl.c 3 | ifort -O -fpp -openmp -mkl -DMKL -DNNLSMKL -oSlipInvNNLS SlipInvNNLS.f90 CreateGandD.f90 filters.for init.f90 dc3dmodif.f nr.for nnlsmkl.o OutputModel.f90 4 | 5 | #Compile with classical NNLS 6 | #ifort -O -fpp -openmp -mkl -DMKL -oSlipInvNNLS SlipInvNNLS.f90 CreateGandD.f90 filters.for init.f90 dc3dmodif.f nr.for nnls.f90 OutputModel.f90 7 | 8 | #Compile without MKL support 9 | #ifort -O -fpp -openmp -oSlipInvNNLS SlipInvNNLS.f90 CreateGandD.f90 filters.for init.f90 dc3dmodif.f nr.for nnls.f90 OutputModel.f90 10 | -------------------------------------------------------------------------------- /src/compile.SlipInvSVD.sh: -------------------------------------------------------------------------------- 1 | #SlipInvSVD1 2 | #----------- 3 | #Compile with MKL and CUDA (GPU) 4 | #ifort -fpp -mkl -DMKL -DCULA $CULA_INC_PATH/cula_status.f90 $CULA_INC_PATH/cula_lapack.f90 -oSlipInvSVD1CULA SlipInvSVD1.f90 CreateGandD.f90 filters.for dc3dmodif.f init.f90 nr.for $linkCULA 5 | 6 | #Compile with MKL 7 | #ifort -O -fpp -mkl -DMKL -oSlipInvSVD1 SlipInvSVD1.f90 CreateGandD.f90 filters.for init.f90 dc3dmodif.f nr.for 8 | ifort -O -fpp -mkl -DMKL -oSlipInvSVD2 SlipInvSVD2.f90 init.f90 OutputModel.f90 9 | 10 | #Compile without MKL support 11 | ifort -O -fpp -oSlipInvSVD1 SlipInvSVD1.f90 CreateGandD.f90 filters.for init.f90 dc3dmodif.f nr.for 12 | #ifort -O -fpp -oSlipInvSVD2 SlipInvSVD2.f90 init.f90 OutputModel.f90 13 | 14 | 15 | #SlipInvSVD2 16 | #----------- 17 | #Compile with MKL 18 | 19 | #Compile without MKL support 20 | -------------------------------------------------------------------------------- /src/init.f90: -------------------------------------------------------------------------------- 1 | ! Truncated SVD solution of the Linear slip inversion problem 2 | ! Requires as an input the output from SlipInvSVD1 3 | ! AUTHOR: Frantisek Gallovic 4 | 5 | MODULE SISVDmodule 6 | REAL*8,PARAMETER:: PI=3.1415926535d0 7 | INTEGER Msvd,Nsvd !Msvd - number of model parameters, Nsvd - number of data 8 | INTEGER Nsmooth,Ssvd,NSTAcomp,Nseis,Ngps,Nslip 9 | INTEGER nfmax,NRseis,NRgps,np,NSeg 10 | REAL*8 T,TS,T1,T2,T0,artifDT,Mfix,vr 11 | INTEGER iT1,iT2,nT,iT0 12 | REAL*8,ALLOCATABLE,DIMENSION(:):: fc1,fc2 13 | INTEGER,ALLOCATABLE,DIMENSION(:):: fcsta 14 | INTEGER nfc 15 | REAL*8 dt,df 16 | REAL*8 smoothkoef,smoothkoefGF,relatweightGPS,lambdalim,maxw,smoothaspectratio 17 | REAL*8 norminput,normdatGPS 18 | CHARACTER*256 inputtffile 19 | INTEGER syntdata,syntdatai,syntdataj,compweights,fixM0weight,slipweight 20 | INTEGER eigsumchoice,lambdafrom,lambdato,lambdanum 21 | INTEGER minMNsvd,minSVDchoice 22 | REAL*8,ALLOCATABLE:: staweight(:,:),R(:) 23 | INTEGER,ALLOCATABLE:: stainfo(:,:),NL(:),NW(:) 24 | REAL*8,ALLOCATABLE,DIMENSION(:):: hypodepth,leng,widt,epicW,epicL,dL,dW,elem,strike,dip 25 | REAL*8,ALLOCATABLE:: G(:,:) 26 | REAL*8,ALLOCATABLE,DIMENSION(:,:,:):: mu,lambda 27 | REAL*8,ALLOCATABLE:: D(:),normdat(:) 28 | REAL*8,ALLOCATABLE:: V(:,:),VT(:,:),U(:,:),W(:) 29 | REAL*8,ALLOCATABLE:: Dout(:,:),M(:,:) 30 | REAL*4,ALLOCATABLE,DIMENSION(:,:,:):: sourNgps,sourEgps,sourZgps,strikeGPS,dipGPS,rakeGPS 31 | REAL*4,ALLOCATABLE:: sigmaGPS(:,:) 32 | END MODULE 33 | 34 | SUBROUTINE Init() 35 | USE SISVDmodule 36 | IMPLICIT NONE 37 | INTEGER ndepth 38 | REAL*8 dum,staN,staE 39 | REAL*8,ALLOCATABLE:: depth(:),vp(:),vs(:),rho(:) 40 | INTEGER i,j,k 41 | 42 | write(*,*)'Reading parameters...' 43 | 44 | open(10,file='input.dat',action='read') 45 | read(10,*) 46 | read(10,*) nfmax 47 | read(10,*) 48 | read(10,*) T,TS,T1,T2 49 | read(10,*) 50 | read(10,*) artifDT,NSeg 51 | allocate(NL(NSeg),NW(NSeg),hypodepth(NSeg),leng(NSeg),widt(NSeg),epicW(NSeg),epicL(NSeg),strike(NSeg),dip(NSeg)) 52 | read(10,*) 53 | read(10,*) NRseis,NRgps 54 | read(10,*) 55 | read(10,*) (NL(i),NW(i),i=1,NSeg) 56 | read(10,*) 57 | read(10,*) Mfix 58 | read(10,*) 59 | read(10,*) (strike(i),dip(i),dum,i=1,NSeg) 60 | read(10,*) 61 | read(10,*) (hypodepth(i),i=1,NSeg) 62 | read(10,*) 63 | read(10,*) (leng(i),widt(i),i=1,NSeg) 64 | read(10,*) 65 | write(*,*) ' (Warning! Assumig order epicL, epicW in input.dat!)' 66 | read(10,*) (epicL(i),epicW(i),i=1,NSeg) 67 | read(10,*) 68 | read(10,*) np 69 | read(10,*) 70 | read(10,*) vr 71 | read(10,*) 72 | read(10,*) nfc !number of frequency bands 73 | allocate(fc1(nfc),fc2(nfc)) 74 | do i=1,nfc 75 | read(10,*) fc1(i),fc2(i) 76 | enddo 77 | close(10) 78 | allocate(dL(NSeg),dW(NSeg),elem(NSeg)) 79 | dL(:)=leng(:)/dble(NL(:)) 80 | dW(:)=widt(:)/dble(NW(:)) 81 | elem(:)=dL(:)*dW(:) 82 | 83 | if(NRseis>0)then 84 | dt=T/float(np) 85 | df=1./T 86 | iT1=T1/dt+1 87 | iT2=T2/dt+1 88 | nT=iT2-iT1+1 89 | open(10,file='stainfo.dat',action='read') 90 | allocate(stainfo(3,NRseis),staweight(3,NRseis),fcsta(NRseis)) 91 | do i=1,NRseis 92 | read(10,*)stainfo(:,i),staweight(:,i),fcsta(i) 93 | enddo 94 | close(10) 95 | endif 96 | 97 | open(10,file='SlipInvSVD.in',action='read') 98 | read(10,*) 99 | read(10,*)syntdata 100 | if(syntdata==1 )read(10,*)syntdatai,syntdataj 101 | if(syntdata==-1)read(10,*)inputtffile 102 | read(10,*) 103 | read(10,*)smoothkoef,smoothkoefGF,relatweightGPS,fixM0weight,slipweight,smoothaspectratio 104 | read(10,*) 105 | read(10,*)compweights 106 | read(10,*) 107 | read(10,*)eigsumchoice 108 | read(10,*) 109 | if(eigsumchoice==1)then 110 | read(10,*)lambdalim 111 | lambdanum=1 112 | else 113 | read(10,*)lambdafrom,lambdato 114 | lambdanum=lambdato-lambdafrom+1 115 | endif 116 | if(abs(smoothkoef)>0.d0)lambdanum=1 117 | read(10,*) 118 | read(10,*)T0 119 | iT0=T0/dt 120 | read(10,*) 121 | read(10,*)minSVDchoice 122 | close(10) 123 | 124 | if(NRseis>0)then 125 | Ssvd=int(TS/dt+1.d0) !number of time samples of the slip velocity model 126 | if(iT1-iT0-Ssvd<0.or.iT2-iT0>np)then 127 | write(*,*)'Error! Time window out of range, check input.dat...' 128 | stop 129 | endif 130 | else 131 | dt=1.d0 132 | df=1.d0 133 | np=0 134 | Ssvd=1 !Just slip value 135 | endif 136 | 137 | ! Evaluating mu 138 | allocate(mu(maxval(NL),maxval(NW),NSeg),lambda(maxval(NL),maxval(NW),NSeg)) 139 | open(10,FILE='crustal.dat',ACTION='READ',STATUS='OLD',ERR=181) 140 | write(*,*)' (Using mu values from file crustal.dat)' 141 | read(10,*) 142 | read(10,*) 143 | read(10,*)ndepth 144 | allocate(depth(ndepth),vp(ndepth),vs(ndepth),rho(ndepth)) 145 | read(10,*) 146 | read(10,*) 147 | do i=1,ndepth 148 | read(10,*)depth(i),vp(i),vs(i),rho(i) 149 | enddo 150 | close(10) 151 | do k=1,NSeg 152 | do i=1,NW(k) 153 | dum=(hypodepth(k)+(epicW(k)-dW(k)*(dble(i)-.5d0))*sin(dip(k)/180.d0*PI))/1000.d0 154 | if(dum>depth(ndepth))then 155 | mu(1:NL(k),i,k)=rho(ndepth)*vs(ndepth)**2*1.d9 156 | lambda(1:NL(k),i,k)=rho(ndepth)*vp(ndepth)**2*1.d9-2*mu(1:NL(k),i,k) 157 | else 158 | do j=1,ndepth 159 | if(dum1)then 204 | allocate(R(NRseis)) 205 | open(10,FILE='stations.dat') 206 | do i=1,NRseis 207 | read(10,*)staN,staE 208 | R(i)=minval(sqrt((sourNgps(1:NL(1),1:NW(1),1)-staN*1.e3)**2+(sourEgps(1:NL(1),1:NW(1),1)-staE*1.e3)**2)) 209 | enddo 210 | close(10) 211 | endif 212 | 213 | !Applying distance dependent weigths (ABSOLETE, SUBSTITUTED BY CD in CreateGandD.f90) 214 | ! if(compweights==2)then 215 | ! write(*,*)' (Applying distance-dependent weigths from segment 1)' 216 | ! open(11,FILE='stainfo.out') 217 | ! do i=1,NRseis 218 | ! dum=max(R(i),leng(1)/4.)/(leng(1)/4.) 219 | ! staweight(:,i)=staweight(:,i)*dum 220 | ! write(11,*)staN,staE,dum 221 | ! enddo 222 | ! close(11) 223 | ! endif 224 | 225 | ! Main allocations 226 | 227 | Msvd=sum(NW(:)*NL(:))*Ssvd !number of model parameters 228 | if(smoothkoef<0.d0)then !smoothing by means of first differences 229 | Nsmooth=sum(NL(:)*NW(:))*(Ssvd-1)+Ssvd*sum((NL(:)-1)*NW(:))+Ssvd*sum(NL(:)*(NW(:)-1)) 230 | elseif(smoothkoef>0.d0)then !smoothing by means of a covariance function 231 | Nsmooth=Msvd 232 | else !no smoothing 233 | Nsmooth=0 234 | endif 235 | 236 | Ngps=NRgps*3 237 | if(NRseis>0)then 238 | NSTAcomp=sum(stainfo(:,:)) 239 | Nseis=nT*NSTAcomp 240 | else 241 | NSTAcomp=0 242 | Nseis=0 243 | endif 244 | 245 | if(slipweight>0.d0)then 246 | Nslip=Msvd 247 | else 248 | Nslip=0 249 | endif 250 | 251 | Nsvd=Nseis+Ngps+1+Nsmooth+Nslip 252 | 253 | if(minSVDchoice==1)then 254 | minMNsvd=min(Msvd,Nsvd) 255 | else 256 | minMNsvd=Msvd 257 | endif 258 | 259 | END 260 | -------------------------------------------------------------------------------- /src/nnls.f90: -------------------------------------------------------------------------------- 1 | MODULE precision 2 | IMPLICIT NONE 3 | INTEGER, PARAMETER :: dp = 8 !SELECTED_REAL_KIND(15, 60) 4 | END MODULE precision 5 | 6 | ! SUBROUTINE nnls(a, m, n, b, x, rnorm, w, indx, mode) 7 | ! 8 | ! Algorithm NNLS: NONNEGATIVE LEAST SQUARES 9 | ! 10 | ! The original version of this code was developed by 11 | ! Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory 12 | ! 1973 JUN 15, and published in the book 13 | ! "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. 14 | ! Revised FEB 1995 to accompany reprinting of the book by SIAM. 15 | ! 16 | ! This translation into Fortran 90 by Alan Miller, February 1997 17 | ! Latest revision - 15 April 1997 18 | 19 | ! N.B. The following call arguments have been removed: 20 | ! mda, zz 21 | ! 22 | ! GIVEN AN M BY N MATRIX, A, AND AN M-VECTOR, B, COMPUTE AN 23 | ! N-VECTOR, X, THAT SOLVES THE LEAST SQUARES PROBLEM 24 | ! 25 | ! A * X = B SUBJECT TO X >= 0 26 | ! ------------------------------------------------------------------ 27 | ! Subroutine Arguments 28 | ! 29 | ! A(), M, N ON ENTRY, A() CONTAINS THE M BY N MATRIX, A. 30 | ! ON EXIT, A() CONTAINS THE PRODUCT MATRIX, Q*A , WHERE Q IS AN 31 | ! M x M ORTHOGONAL MATRIX GENERATED IMPLICITLY BY THIS SUBROUTINE. 32 | ! B() ON ENTRY B() CONTAINS THE M-VECTOR, B. ON EXIT B() CONTAINS Q*B. 33 | ! X() ON ENTRY X() NEED NOT BE INITIALIZED. 34 | ! ON EXIT X() WILL CONTAIN THE SOLUTION VECTOR. 35 | ! RNORM ON EXIT RNORM CONTAINS THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR. 36 | ! W() AN N-ARRAY OF WORKING SPACE. ON EXIT W() WILL CONTAIN THE DUAL 37 | ! SOLUTION VECTOR. W WILL SATISFY W(I) = 0. FOR ALL I IN SET P 38 | ! AND W(I) <= 0. FOR ALL I IN SET Z 39 | ! INDX() AN INTEGER WORKING ARRAY OF LENGTH AT LEAST N. 40 | ! ON EXIT THE CONTENTS OF THIS ARRAY DEFINE THE SETS P AND Z 41 | ! AS FOLLOWS.. 42 | ! INDX(1) THRU INDX(NSETP) = SET P. 43 | ! INDX(IZ1) THRU INDX(IZ2) = SET Z. 44 | ! IZ1 = NSETP + 1 = NPP1 45 | ! IZ2 = N 46 | ! MODE THIS IS A SUCCESS-FAILURE FLAG WITH THE FOLLOWING MEANINGS. 47 | ! 1 THE SOLUTION HAS BEEN COMPUTED SUCCESSFULLY. 48 | ! 2 THE DIMENSIONS OF THE PROBLEM ARE BAD. 49 | ! EITHER M <= 0 OR N <= 0. 50 | ! 3 ITERATION COUNT EXCEEDED. MORE THAN 3*N ITERATIONS. 51 | ! 52 | ! ------------------------------------------------------------------ 53 | SUBROUTINE nnls (a, m, n, b, x, rnorm, w, indx, mode) 54 | ! ------------------------------------------------------------------ 55 | USE precision 56 | IMPLICIT NONE 57 | INTEGER, INTENT(IN) :: m, n 58 | INTEGER, INTENT(OUT) :: indx(n), mode 59 | REAL (dp), INTENT(IN OUT) :: a(m,n), b(m) 60 | REAL (dp), INTENT(OUT) :: x(n), rnorm, w(n) 61 | 62 | INTERFACE 63 | SUBROUTINE g1(a, b, cterm, sterm, sig) 64 | USE precision 65 | IMPLICIT NONE 66 | REAL (dp), INTENT(IN) :: a, b 67 | REAL (dp), INTENT(OUT) :: cterm, sterm, sig 68 | END SUBROUTINE g1 69 | 70 | SUBROUTINE h12(mode, lpivot, l1, m, u, up, c, ice, icv, ncv) 71 | USE precision 72 | IMPLICIT NONE 73 | INTEGER, INTENT(IN) :: mode, lpivot, l1, m, ice, icv, & 74 | ncv 75 | REAL (dp), DIMENSION(:), INTENT(IN OUT) :: u, c 76 | REAL (dp), INTENT(IN OUT) :: up 77 | END SUBROUTINE h12 78 | END INTERFACE 79 | 80 | ! Local variables 81 | 82 | INTEGER :: i, ii, ip, iter, itmax, iz, iz1, iz2, izmax, & 83 | j, jj, jz, l, mda, npp1, nsetp 84 | REAL (dp), DIMENSION(m) :: zz 85 | REAL (dp), DIMENSION(n) :: tempn 86 | REAL (dp), DIMENSION(1) :: dummy 87 | REAL (dp) :: alpha, asave, cc, factor = 0.01_dp, sm, & 88 | ss, t, temp, two = 2.0_dp, unorm, up, wmax, & 89 | zero = 0.0_dp, ztest 90 | ! ------------------------------------------------------------------ 91 | mode = 1 92 | IF (m <= 0 .OR. n <= 0) THEN 93 | mode = 2 94 | RETURN 95 | END IF 96 | iter = 0 97 | itmax = 3*n 98 | 99 | itmax=10*n 100 | 101 | ! INITIALIZE THE ARRAYS indx() AND X(). 102 | 103 | x(1:n)=zero 104 | DO i = 1,n 105 | indx(i) = i 106 | END DO 107 | 108 | iz2 = n 109 | iz1 = 1 110 | nsetp = 0 111 | npp1 = 1 112 | ! ****** MAIN LOOP BEGINS HERE ****** 113 | ! QUIT IF ALL COEFFICIENTS ARE ALREADY IN THE SOLUTION. 114 | ! OR IF M COLS OF A HAVE BEEN TRIANGULARIZED. 115 | 116 | 30 IF (iz1 > iz2 .OR. nsetp >= m) GO TO 350 117 | 118 | ! COMPUTE COMPONENTS OF THE DUAL (NEGATIVE GRADIENT) VECTOR W(). 119 | 120 | !$OMP parallel do private(iz,j) DEFAULT(SHARED) 121 | DO iz = iz1,iz2 122 | j = indx(iz) 123 | w(j) = DOT_PRODUCT(a(npp1:m,j), b(npp1:m)) 124 | END DO 125 | !$OMP end parallel do 126 | 127 | ! FIND LARGEST POSITIVE W(J). 128 | 60 wmax = zero 129 | DO iz = iz1,iz2 130 | j = indx(iz) 131 | IF (w(j) > wmax) THEN 132 | wmax = w(j) 133 | izmax = iz 134 | END IF 135 | END DO 136 | 137 | ! IF WMAX <= 0. GO TO TERMINATION. 138 | ! THIS INDICATES SATISFACTION OF THE KUHN-TUCKER CONDITIONS. 139 | 140 | IF (wmax <= zero) GO TO 350 141 | iz = izmax 142 | j = indx(iz) 143 | 144 | ! THE SIGN OF W(J) IS OK FOR J TO BE MOVED TO SET P. 145 | ! BEGIN THE TRANSFORMATION AND CHECK NEW DIAGONAL ELEMENT TO AVOID 146 | ! NEAR LINEAR DEPENDENCE. 147 | 148 | asave = a(npp1,j) 149 | CALL h12 (1, npp1, npp1+1, m, a(:,j), up, dummy, 1, 1, 0) 150 | unorm = zero 151 | IF (nsetp /= 0) THEN 152 | unorm = SUM( a(1:nsetp,j)**2 ) 153 | END IF 154 | unorm = SQRT(unorm) 155 | IF (unorm + ABS(a(npp1,j))*factor - unorm > zero) THEN 156 | 157 | ! COL J IS SUFFICIENTLY INDEPENDENT. COPY B INTO ZZ, UPDATE ZZ 158 | ! AND SOLVE FOR ZTEST ( = PROPOSED NEW VALUE FOR X(J) ). 159 | 160 | zz(1:m) = b(1:m) 161 | CALL h12 (2, npp1, npp1+1, m, a(:,j), up, zz, 1, 1, 1) 162 | ztest = zz(npp1)/a(npp1,j) 163 | 164 | ! SEE IF ZTEST IS POSITIVE 165 | 166 | IF (ztest > zero) GO TO 140 167 | END IF 168 | 169 | ! REJECT J AS A CANDIDATE TO BE MOVED FROM SET Z TO SET P. 170 | ! RESTORE A(NPP1,J), SET W(J) = 0., AND LOOP BACK TO TEST DUAL 171 | ! COEFFS AGAIN. 172 | 173 | a(npp1,j) = asave 174 | w(j) = zero 175 | GO TO 60 176 | 177 | ! THE INDEX J = indx(IZ) HAS BEEN SELECTED TO BE MOVED FROM 178 | ! SET Z TO SET P. UPDATE B, UPDATE INDICES, APPLY HOUSEHOLDER 179 | ! TRANSFORMATIONS TO COLS IN NEW SET Z, ZERO SUBDIAGONAL ELTS IN 180 | ! COL J, SET W(J) = 0. 181 | 182 | 140 b(1:m) = zz(1:m) 183 | 184 | indx(iz) = indx(iz1) 185 | indx(iz1) = j 186 | iz1 = iz1+1 187 | nsetp = npp1 188 | npp1 = npp1+1 189 | 190 | mda = SIZE(a,1) 191 | IF (iz1 <= iz2) THEN 192 | !$O M P parallel do private(jz,jj) DEFAULT(SHARED) 193 | DO jz = iz1,iz2 194 | jj = indx(jz) 195 | CALL h12 (2, nsetp, npp1, m, a(:,j), up, a(:,jj), 1, mda, 1) 196 | END DO 197 | !$O M P end parallel do 198 | END IF 199 | 200 | IF (nsetp /= m) THEN 201 | a(npp1:m,j) = zero 202 | END IF 203 | 204 | w(j) = zero 205 | ! SOLVE THE TRIANGULAR SYSTEM. 206 | ! STORE THE SOLUTION TEMPORARILY IN ZZ(). 207 | CALL solve_triangular(zz) 208 | 209 | ! ****** SECONDARY LOOP BEGINS HERE ****** 210 | 211 | ! ITERATION COUNTER. 212 | 213 | 210 iter = iter+1 214 | IF (iter > itmax) THEN 215 | mode = 3 216 | WRITE (*,'(/a)') ' NNLS quitting on iteration count.' 217 | GO TO 350 218 | END IF 219 | 220 | ! SEE IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE. 221 | ! IF NOT COMPUTE ALPHA. 222 | 223 | alpha = two 224 | DO ip = 1,nsetp 225 | l = indx(ip) 226 | IF (zz(ip) <= zero) THEN 227 | t = -x(l)/(zz(ip)-x(l)) 228 | IF (alpha > t) THEN 229 | alpha = t 230 | jj = ip 231 | END IF 232 | END IF 233 | END DO 234 | 235 | ! IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE THEN ALPHA WILL 236 | ! STILL = 2. IF SO EXIT FROM SECONDARY LOOP TO MAIN LOOP. 237 | 238 | IF (alpha == two) GO TO 330 239 | 240 | ! OTHERWISE USE ALPHA WHICH WILL BE BETWEEN 0. AND 1. TO 241 | ! INTERPOLATE BETWEEN THE OLD X AND THE NEW ZZ. 242 | 243 | !$OMP parallel do private(ip,l) DEFAULT(SHARED) 244 | DO ip = 1,nsetp 245 | l = indx(ip) 246 | x(l) = x(l) + alpha*(zz(ip)-x(l)) 247 | END DO 248 | !$OMP end parallel do 249 | 250 | ! MODIFY A AND B AND THE INDEX ARRAYS TO MOVE COEFFICIENT I 251 | ! FROM SET P TO SET Z. 252 | 253 | i = indx(jj) 254 | 260 x(i) = zero 255 | 256 | IF (jj /= nsetp) THEN 257 | jj = jj+1 258 | DO j = jj,nsetp 259 | ii = indx(j) 260 | indx(j-1) = ii 261 | CALL g1 (a(j-1,ii), a(j,ii), cc, ss, a(j-1,ii)) 262 | a(j,ii) = zero 263 | tempn(1:n) = a(j-1,1:n) 264 | ! Apply procedure G2 (CC,SS,A(J-1,L),A(J,L)) 265 | IF(ii>1)then 266 | a(j-1,1:ii-1) = cc*tempn(1:ii-1) + ss*a(j,1:ii-1) 267 | a(j,1:ii-1) = -ss*tempn(1:ii-1) + cc*a(j,1:ii-1) 268 | ENDIF 269 | IF(ii ABS(b)) THEN 372 | xr = b / a 373 | yr = SQRT(one + xr**2) 374 | cterm = SIGN(one/yr, a) 375 | sterm = cterm * xr 376 | sig = ABS(a) * yr 377 | RETURN 378 | END IF 379 | 380 | IF (b /= zero) THEN 381 | xr = a / b 382 | yr = SQRT(one + xr**2) 383 | sterm = SIGN(one/yr, b) 384 | cterm = sterm * xr 385 | sig = ABS(b) * yr 386 | RETURN 387 | END IF 388 | 389 | ! SIG = ZERO 390 | cterm = zero 391 | sterm = one 392 | RETURN 393 | END SUBROUTINE g1 394 | 395 | 396 | 397 | ! SUBROUTINE h12 (mode, lpivot, l1, m, u, up, c, ice, icv, ncv) 398 | 399 | ! CONSTRUCTION AND/OR APPLICATION OF A SINGLE 400 | ! HOUSEHOLDER TRANSFORMATION.. Q = I + U*(U**T)/B 401 | 402 | ! The original version of this code was developed by 403 | ! Charles L. Lawson and Richard J. Hanson at Jet Propulsion Laboratory 404 | ! 1973 JUN 12, and published in the book 405 | ! "SOLVING LEAST SQUARES PROBLEMS", Prentice-HalL, 1974. 406 | ! Revised FEB 1995 to accompany reprinting of the book by SIAM. 407 | ! ------------------------------------------------------------------ 408 | ! Subroutine Arguments 409 | 410 | ! MODE = 1 OR 2 Selects Algorithm H1 to construct and apply a 411 | ! Householder transformation, or Algorithm H2 to apply a 412 | ! previously constructed transformation. 413 | ! LPIVOT IS THE INDEX OF THE PIVOT ELEMENT. 414 | ! L1,M IF L1 <= M THE TRANSFORMATION WILL BE CONSTRUCTED TO 415 | ! ZERO ELEMENTS INDEXED FROM L1 THROUGH M. IF L1 GT. M 416 | ! THE SUBROUTINE DOES AN IDENTITY TRANSFORMATION. 417 | ! U(),IUE,UP On entry with MODE = 1, U() contains the pivot 418 | ! vector. IUE is the storage increment between elements. 419 | ! On exit when MODE = 1, U() and UP contain quantities 420 | ! defining the vector U of the Householder transformation. 421 | ! on entry with MODE = 2, U() and UP should contain 422 | ! quantities previously computed with MODE = 1. These will 423 | ! not be modified during the entry with MODE = 2. 424 | ! C() ON ENTRY with MODE = 1 or 2, C() CONTAINS A MATRIX WHICH 425 | ! WILL BE REGARDED AS A SET OF VECTORS TO WHICH THE 426 | ! HOUSEHOLDER TRANSFORMATION IS TO BE APPLIED. 427 | ! ON EXIT C() CONTAINS THE SET OF TRANSFORMED VECTORS. 428 | ! ICE STORAGE INCREMENT BETWEEN ELEMENTS OF VECTORS IN C(). 429 | ! ICV STORAGE INCREMENT BETWEEN VECTORS IN C(). 430 | ! NCV NUMBER OF VECTORS IN C() TO BE TRANSFORMED. IF NCV <= 0 431 | ! NO OPERATIONS WILL BE DONE ON C(). 432 | ! ------------------------------------------------------------------ 433 | SUBROUTINE h12(mode, lpivot, l1, m, u, up, c, ice, icv, ncv) 434 | ! ------------------------------------------------------------------ 435 | 436 | USE precision 437 | IMPLICIT NONE 438 | INTEGER, INTENT(IN) :: mode, lpivot, l1, m, ice, icv, ncv 439 | REAL (dp), DIMENSION(:), INTENT(IN OUT) :: u, c 440 | REAL (dp), INTENT(IN OUT) :: up 441 | 442 | ! Local variables 443 | INTEGER :: i, i2, i3, i4, incr, j 444 | REAL (dp) :: b, cl, clinv, one = 1.0D0, sm 445 | ! ------------------------------------------------------------------ 446 | IF (0 >= lpivot .OR. lpivot >= l1 .OR. l1 > m) RETURN 447 | cl = ABS(u(lpivot)) 448 | IF (mode /= 2) THEN 449 | ! ****** CONSTRUCT THE TRANSFORMATION. ****** 450 | DO j = l1, m 451 | cl = MAX(ABS(u(j)),cl) 452 | END DO 453 | IF (cl <= 0) RETURN 454 | clinv = one / cl 455 | sm = (u(lpivot)*clinv) ** 2 + SUM( (u(l1:m)*clinv)**2 ) 456 | cl = cl * SQRT(sm) 457 | IF (u(lpivot) > 0) THEN 458 | cl = -cl 459 | END IF 460 | up = u(lpivot) - cl 461 | u(lpivot) = cl 462 | ELSE 463 | ! ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** 464 | 465 | IF (cl <= 0) RETURN 466 | END IF 467 | IF (ncv <= 0) RETURN 468 | 469 | b = up * u(lpivot) 470 | ! B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. 471 | 472 | IF (b < 0) THEN 473 | b = one / b 474 | i2 = 1 - icv + ice * (lpivot-1) 475 | incr = ice * (l1-lpivot) 476 | DO j = 1, ncv 477 | i2 = i2 + icv 478 | i3 = i2 + incr 479 | i4 = i3 480 | sm = c(i2) * up 481 | DO i = l1, m 482 | sm = sm + c(i3) * u(i) 483 | i3 = i3 + ice 484 | END DO 485 | IF (sm /= 0) THEN 486 | sm = sm * b 487 | c(i2) = c(i2) + sm * up 488 | DO i = l1, m 489 | c(i4) = c(i4) + sm * u(i) 490 | i4 = i4 + ice 491 | END DO 492 | END IF 493 | END DO ! j = 1, ncv 494 | END IF 495 | 496 | RETURN 497 | END SUBROUTINE h12 498 | 499 | 500 | !================ A sample test program ===================== 501 | 502 | !PROGRAM test_nnls 503 | ! Fit a mixture of exponentials by NNLS. 504 | ! The fitting of a sum of exponentials: 505 | 506 | ! Y = Sum A(i).exp(-b(i).t) 507 | 508 | ! to a set of values of Y is very ill-conditioned problem in non-linear 509 | ! least squares. The parameters to be fitted are the amplitudes A(i) 510 | ! and the b(i)'s. Often the number of terms is unknown. Sometimes the 511 | ! discrete A(i)'s are replaced by a continuous function and the sum replaced 512 | ! with an integral. 513 | 514 | ! A common practice is to fit the sum with the b(i)'s held fixed and 515 | ! then constrain the amplitudes A(i) to be positive. That is done in 516 | ! this example. We will fit: 517 | 518 | ! Y = Sum A(i).exp(-t/t0(i)) 519 | 520 | ! where the t0(i)'s increase by a factor of sqrt(2) from 2.0 to 1024. 521 | ! The `data' will be generated with 3 exponential terms: 522 | 523 | ! Y = 100 * ( exp(-t/5) + exp(-t/50) + exp(-t/500) ) + noise 524 | 525 | ! The times (t) will be 10, 20, ..., 1000. 526 | 527 | ! The nearest fitted t0'2 to each of these t0's are: 528 | ! 5 between 4 and 5.66 529 | ! 50 between 32 and 45.3 530 | ! 500 between 362.0 and 512 531 | 532 | ! Test example added 29 June 1998 533 | 534 | !USE precision 535 | !IMPLICIT NONE 536 | 537 | !REAL (dp) :: x(100,19), y(100), t0(19), arg, arglimit, noise(100), t, rnorm, & 538 | ! b(19), w(19) 539 | !INTEGER :: i, indx(19), j, mode 540 | 541 | !INTERFACE 542 | ! SUBROUTINE nnls (a, m, n, b, x, rnorm, w, indx, mode) 543 | ! USE precision 544 | ! IMPLICIT NONE 545 | ! INTEGER, INTENT(IN) :: m, n 546 | ! INTEGER, INTENT(OUT) :: indx(:), mode 547 | ! REAL (dp), INTENT(IN OUT) :: a(:,:), b(:) 548 | ! REAL (dp), INTENT(OUT) :: x(:), rnorm, w(:) 549 | ! END SUBROUTINE nnls 550 | !END INTERFACE 551 | 552 | !t0(1) = 2.0 553 | !t0(2) = t0(1) * SQRT(2.0_dp) 554 | !DO i = 3, 19 555 | ! t0(i) = 2.0_dp * t0(i-2) 556 | !END DO 557 | 558 | ! Calculate the X-matrix, avoiding underflow 559 | 560 | !arglimit = LOG( 2.0_dp * TINY(1.0_dp) ) 561 | !DO j = 1, 19 562 | ! DO i = 1, 100 563 | ! arg = -10._dp * i / t0(j) 564 | ! IF (arg > arglimit) THEN 565 | ! x(i,j) = EXP(arg) 566 | ! ELSE 567 | ! x(i:100,j) = 0.0_dp 568 | ! EXIT 569 | ! END IF 570 | ! END DO 571 | !END DO 572 | 573 | ! Generate Y's with uniformly-distributed noise. 574 | 575 | !CALL RANDOM_NUMBER( noise ) 576 | !DO i = 1, 100 577 | ! t = 10._dp * i 578 | ! y(i) = 100._dp * ( exp(-t/5._dp) + exp(-t/50._dp) + exp(-t/500._dp) ) + & 579 | ! noise(i) - 0.5_dp 580 | !END DO 581 | 582 | ! Now call NNLS to do the fitting. 583 | 584 | !CALL nnls (x, 100, 19, y, b, rnorm, w, indx, mode) 585 | 586 | !SELECT CASE (mode) 587 | ! CASE (1) 588 | ! DO i = 1, 19 589 | ! IF (b(i) > 0.0_dp) THEN 590 | ! WRITE(*, '(a, f9.1, a, f9.1)') & 591 | ! ' Time constant: ', t0(i), ' Fitted amplitude = ', b(i) 592 | ! END IF 593 | ! END DO 594 | ! WRITE(*, '(a, 19i3)') ' Array INDX =', indx 595 | ! WRITE(*, '(a/ (" ", 10f8.0))') ' Alternate solution:', w 596 | ! WRITE(*, '(a, f9.2)') ' rnorm = ', rnorm 597 | ! CASE (2) 598 | ! WRITE(*, *) 'Error in input argument 2 or 3' 599 | ! CASE (3) 600 | ! WRITE(*, *) 'Failed to converge' 601 | !END SELECT 602 | 603 | !STOP 604 | !END PROGRAM test_nnls 605 | -------------------------------------------------------------------------------- /src/nnlsmkl.c: -------------------------------------------------------------------------------- 1 | ///////////////////////////////////// 2 | //lsqnoneg, solve for Ax=b, where x >= 0 3 | //OpenMP + MKL 4 | //Yuancheng Luo, 2/2011 5 | //////////////////////////////////// 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include "omp.h" 12 | #include "mkl.h" 13 | //#include "mex.h" 14 | #include "nnlsmkl.h" 15 | 16 | void loadData(REAL **A, REAL **b, REAL **x, int nSys, int m, int n, char *fileNameA, char*fileNameB){ 17 | //m rows, n cols, use fortran column-major ordering 18 | *A = (REAL*) malloc(sizeof(REAL) * nSys * m * n ); //A[nSys][m][n] 19 | *x = (REAL*) malloc(sizeof(REAL) *nSys * n); //x[nSys][n] 20 | *b = (REAL*) malloc(sizeof(REAL) *nSys * m); //b[nSys][m] 21 | 22 | //Grab b from file 23 | FILE *fi = fopen(fileNameB, "rb"); 24 | fread(*b, 1, sizeof(REAL) * m * nSys, fi); 25 | fclose(fi); 26 | 27 | //Grab A from file 28 | fi = fopen(fileNameA, "rb"); 29 | fread(*A, 1, sizeof(REAL) * m * n * nSys, fi); 30 | fclose(fi); 31 | 32 | }//End of genRandomData 33 | 34 | //OMP/MKL systems, no update/downdate 35 | void nnlsOMPSysMKL(REAL *A, REAL *b, REAL *x, int isTransposed, int maxNNLSIters, int maxLSIters, int nSys, int m, int n, int MKLT, int OMPT, REAL TOL_TERMINATION){ 36 | 37 | char transaN = 'N', transaT = 'T'; 38 | REAL alpha = 1.0f, negAlpha = -1.0f, beta = 0.0f; 39 | int idx = 1, idy = 1; 40 | 41 | REAL *f = (REAL*)malloc(sizeof(REAL) * OMPT * m); 42 | REAL *g = (REAL*)malloc(sizeof(REAL) * OMPT * n); //g[OMPT][n] 43 | int *z = (int*)malloc(sizeof(int) * OMPT * n); //z[OMPT][n] 44 | int *zRemoved = (int*)malloc(sizeof(int) * OMPT* n); 45 | 46 | int *kIdx = (int*)malloc(sizeof(int) * OMPT * n); 47 | 48 | int maxmn = MAX(m, n); 49 | REAL *Apt = (REAL*)malloc(sizeof(REAL) * OMPT * n * m); 50 | REAL *xp = (REAL*)malloc(sizeof(REAL) * OMPT * maxmn ); 51 | REAL *tx = (REAL*) malloc(sizeof(REAL) * OMPT * n); 52 | 53 | int NB = 1; 54 | int lwork = (MAX(m, n) * (2 + NB)); 55 | REAL *work = (REAL*) malloc(sizeof(REAL) *OMPT * lwork); 56 | int info; 57 | 58 | int s; 59 | int i, j, k; 60 | 61 | //Set number of threads 62 | mkl_set_num_threads(MKLT); 63 | omp_set_num_threads(OMPT); 64 | 65 | double startT, endT; 66 | startT = omp_get_wtime(); 67 | 68 | //Set initial solution to 0 69 | memset(x, 0, sizeof(REAL) * nSys * n); 70 | 71 | #pragma omp parallel private(s, i, j, k, info) 72 | { 73 | int tid = omp_get_thread_num(); 74 | int nnlsIter, lsIter; 75 | 76 | #pragma omp for 77 | for(s = 0; s < nSys; ++s){ 78 | //Initials 79 | nnlsIter = lsIter = 0; 80 | int kCols = 0; 81 | //Set active-set to all variables 82 | for(i = 0; i < n; ++i) 83 | z[M2(tid, i, n)] = 1; 84 | 85 | do{ 86 | //printf("nnlsIter %d, lsIter %d\n", nnlsIter, lsIter); 87 | ////Compute negative gradient of f=1/2|Ax-b|^2 w.r.t. x and store into g=A'(b-Ax) 88 | 89 | #ifndef USE_DOUBLE 90 | if(isTransposed){ 91 | //Compute f=-Ax, treat as A transpose for fortran call 92 | SGEMV(&transaT, &n, &m, &negAlpha, &A[M3(s, 0, 0, m, n)], &n, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 93 | //Compute f=b-Ax 94 | SAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 95 | //Compute g=A'f, treat as A transpose for fortran call 96 | SGEMV(&transaN, &n, &m, &alpha, &A[M3(s, 0, 0, m, n)], &n, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 97 | }else{ 98 | //Compute f=-Ax 99 | SGEMV(&transaN, &m, &n, &negAlpha, &A[M3(s, 0, 0, n, m)], &m, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 100 | //Compute f=b-Ax 101 | SAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 102 | //Compute g=A'f 103 | SGEMV(&transaT, &m, &n, &alpha, &A[M3(s, 0, 0, n, m)], &m, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 104 | } 105 | #else 106 | if(isTransposed){ 107 | //Compute f=-Ax, treat as A transpose for fortran call 108 | DGEMV(&transaT, &n, &m, &negAlpha, &A[M3(s, 0, 0, m, n)], &n, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 109 | //Compute f=b-Ax 110 | DAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 111 | //Compute g=A'f, treat as A transpose for fortran call 112 | DGEMV(&transaN, &n, &m, &alpha, &A[M3(s, 0, 0, m, n)], &n, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 113 | }else{ 114 | //Compute f=-Ax 115 | DGEMV(&transaN, &m, &n, &negAlpha, &A[M3(s, 0, 0, n, m)], &m, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 116 | //Compute f=b-Ax 117 | DAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 118 | //Compute g=A'f 119 | DGEMV(&transaT, &m, &n, &alpha, &A[M3(s, 0, 0, n, m)], &m, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 120 | } 121 | #endif 122 | //Check for termination condition by finding a variable in z, s.t. max(g)>0 and remove from z 123 | int vmax = -1; 124 | REAL maxg = TOL_TERMINATION; 125 | for(i = 0; i < n; ++i){ 126 | if(z[M2(tid, i, n)] && g[M2(tid, i, n)] > maxg){ 127 | maxg = g[M2(tid, i, n)]; 128 | vmax = i; 129 | } 130 | } 131 | //All gradients are non-positive so terminate 132 | if(vmax == -1) 133 | break; 134 | 135 | //Remove vmax from z 136 | z[M2(tid, vmax, n)] = 0; 137 | int colAdd = 1; 138 | 139 | //Solve uncontrained linear least squares subproblem 140 | do{ 141 | ++lsIter; 142 | 143 | if(colAdd){ 144 | //Build unconstrained system 145 | for(i = 0; i < kCols; ++i){ 146 | int kdx = kIdx[M2(tid, i, n)]; 147 | if(isTransposed){ 148 | for(j = 0; j < m; ++j) 149 | Apt[M3(tid, i, j, n, m)] = A[M3(s, j, kdx, m, n)]; 150 | }else{ 151 | memcpy(&Apt[M3(tid, i, 0, n, m)], &A[M3(s, kdx, 0, n, m)], sizeof(REAL) * m); 152 | } 153 | } 154 | //Add new column 155 | if(isTransposed){ 156 | for(j = 0; j < m; ++j) 157 | Apt[M3(tid, kCols, j, n, m)] = A[M3(s, j, vmax, m, n)]; 158 | }else{ 159 | memcpy(&Apt[M3(tid, kCols, 0, n, m)], &A[M3(s, vmax, 0, n, m)], sizeof(REAL) * m); 160 | } 161 | kIdx[M2(tid, kCols, n)] = vmax; 162 | kCols++; 163 | 164 | }else{ 165 | //Shift sK (column list in set P) list left by one 166 | for(i = kCols - 1; i >= 0; --i){ 167 | int kdx = kIdx[M2(tid, i, n)]; 168 | //Deleted column 169 | if(zRemoved[M2(tid, kdx, n)]){ 170 | for(j = i + 1; j < kCols; ++j) 171 | kIdx[M2(tid, j-1, n)] = kIdx[M2(tid, j, n)]; 172 | --kCols; 173 | } 174 | } 175 | //Build unconstrained system 176 | for(i = 0; i < kCols; ++i){ 177 | int kdx = kIdx[M2(tid, i, n)]; 178 | if(isTransposed){ 179 | for(j = 0; j < m; ++j) 180 | Apt[M3(tid, i, j, n, m)] = A[M3(s, j, kdx, m, n)]; 181 | }else{ 182 | memcpy(&Apt[M3(tid, i, 0, n, m)], &A[M3(s, kdx, 0, n, m)], sizeof(REAL) * m); 183 | } 184 | } 185 | } 186 | //Solve unconstrained system 187 | int one = 1; 188 | memcpy(&xp[M2(tid, 0, maxmn)], &b[M2(s, 0, m)], sizeof(REAL) * m); 189 | #ifndef USE_DOUBLE 190 | SGELS(&transaN, &m, &kCols, &one, &Apt[M3(tid, 0, 0, n, m)], &m, &xp[M2(tid, 0, maxmn)], &m, &work[M2(tid, 0, lwork)], &lwork, &info); 191 | #else 192 | DGELS(&transaN, &m, &kCols, &one, &Apt[M3(tid, 0, 0, n, m)], &m, &xp[M2(tid, 0, maxmn)], &m, &work[M2(tid, 0, lwork)], &lwork, &info); 193 | #endif 194 | //Load solution xp int tx 195 | // REAL minTx = HUGE; 196 | REAL minTx = FLT_MAX; 197 | memset(&tx[M2(tid, 0, n)], 0, sizeof(REAL) * n); 198 | for(i = kCols - 1; i >= 0; --i){ 199 | int kdx = kIdx[M2(tid, i, n)]; 200 | tx[M2(tid, kdx, n)] = xp[M2(tid, i, maxmn)]; 201 | minTx = MIN(tx[M2(tid, kdx, n)], minTx); 202 | } 203 | 204 | if(minTx > 0){ 205 | //Accept solution, update x 206 | //printf("Accept\n"); 207 | memcpy(&x[M2(s, 0, n)], &tx[M2(tid, 0, n)], sizeof(REAL) * n); 208 | break; 209 | }else{ 210 | //Reject solution, update subproblem 211 | //Find index q in set P for negative z such that x/(x-z) is minimized 212 | //printf("Reject\n"); 213 | // REAL minAlpha = HUGE; 214 | REAL minAlpha = FLT_MAX; 215 | for(i = 0; i < kCols; ++i){ 216 | int kdx = kIdx[M2(tid, i, n)]; 217 | if(tx[M2(tid, kdx, n)] <= 0) 218 | minAlpha = MIN(minAlpha, x[M2(s, kdx, n)] / (x[M2(s, kdx, n)] - tx[M2(tid, kdx, n)]) ); 219 | } 220 | for(i = 0; i < n; ++i) 221 | tx[M2(tid, i, n)] -= x[M2(s, i, n)]; 222 | 223 | #ifndef USE_DOUBLE 224 | SAXPY(&n, &minAlpha, &tx[M2(tid, 0, n)], &idx, &x[M2(s, 0, n)], &idy); 225 | #else 226 | DAXPY(&n, &minAlpha, &tx[M2(tid, 0, n)], &idx, &x[M2(s, 0, n)], &idy); 227 | #endif 228 | memset(&zRemoved[M2(tid, 0, n)], 0, sizeof(int) * n); 229 | //Move from set P to set Z all elements whose corresponding X is 0 (guaranteed to have one element) 230 | for(i = 0; i < kCols; ++i){ 231 | int kdx = kIdx[M2(tid, i, n)]; 232 | zRemoved[M2(tid, kdx, n)] = z[M2(tid, kdx, n)] = fabs(x[M2(s, kdx, n)]) <= TOL_TERMINATION; 233 | } 234 | 235 | colAdd = 0; 236 | } 237 | 238 | }while(lsIter < maxLSIters); 239 | 240 | if(lsIter >= maxLSIters) 241 | break; 242 | 243 | ++nnlsIter; 244 | }while(nnlsIter < maxNNLSIters); 245 | 246 | printf("nSys %d, nnlsIter %d, lsIter %d\n", s, nnlsIter, lsIter); 247 | } 248 | } 249 | 250 | endT = omp_get_wtime(); 251 | printf("Elapsed time %f\n", endT - startT); 252 | 253 | free(work); 254 | free(Apt); 255 | free(xp); 256 | free(tx); 257 | free(kIdx); 258 | free(zRemoved); 259 | free(z); 260 | free(f); 261 | free(g); 262 | }//End of nnlsOMPSysMKL 263 | 264 | //OMP systems, MKL updates 265 | void nnlsOMPSysMKLUpdates(REAL *A, REAL *b, REAL *x, int isTransposed, int maxNNLSIters, int maxLSIters, int nSys, int m, int n, int MKLT, int OMPT, REAL TOL_TERMINATION){ 266 | 267 | char transaN = 'N', transaT = 'T'; 268 | REAL alpha = 1.0f, negAlpha = -1.0f, beta = 0.0f; 269 | int idx = 1, idy = 1; 270 | 271 | REAL *f = (REAL*)malloc(sizeof(REAL) * OMPT * m); 272 | REAL *g = (REAL*)malloc(sizeof(REAL) * OMPT * n); //g[OMPT][n] 273 | int *z = (int*)malloc(sizeof(int) * OMPT * n); //z[OMPT][n] 274 | int *zRemoved = (int*)malloc(sizeof(int) * OMPT* n); 275 | 276 | REAL *newCol = (REAL*)malloc(sizeof(REAL) * OMPT * m); 277 | REAL *oldCol = (REAL*)malloc(sizeof(REAL) * OMPT * m); 278 | 279 | int *kIdx = (int*)malloc(sizeof(int) * OMPT * n); 280 | 281 | REAL *Qt = (REAL*) malloc(sizeof(REAL) * OMPT * n * m); 282 | REAL *R = (REAL*) malloc(sizeof(REAL) * OMPT * n * n ); 283 | REAL *Qtb = (REAL*) malloc(sizeof(REAL) * OMPT * n); 284 | 285 | REAL *tx = (REAL*) malloc(sizeof(REAL) * OMPT * n); 286 | 287 | int s; 288 | int i, j, k; 289 | 290 | //Set number of threads 291 | mkl_set_num_threads(MKLT); 292 | omp_set_num_threads(OMPT); 293 | 294 | double startT, endT; 295 | startT = omp_get_wtime(); 296 | 297 | //Set initial solution to 0 298 | memset(x, 0, sizeof(REAL) * nSys * n); 299 | 300 | #pragma omp parallel private(s, i, j, k) 301 | { 302 | int tid = omp_get_thread_num(); 303 | int nnlsIter, lsIter; 304 | 305 | #pragma omp for 306 | for(s = 0; s < nSys; ++s){ 307 | //Initials 308 | nnlsIter = lsIter = 0; 309 | int kCols = 0; 310 | //Set active-set to all variables 311 | for(i = 0; i < n; ++i) 312 | z[M2(tid, i, n)] = 1; 313 | 314 | do{ 315 | //printf("nnlsIter %d, lsIter %d\n", nnlsIter, lsIter); 316 | ////Compute negative gradient of f=1/2|Ax-b|^2 w.r.t. x and store into g=A'(b-Ax) 317 | #ifndef USE_DOUBLE 318 | if(isTransposed){ 319 | //Compute f=-Ax, treat as A transpose for fortran call 320 | SGEMV(&transaT, &n, &m, &negAlpha, &A[M3(s, 0, 0, m, n)], &n, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 321 | //Compute f=b-Ax 322 | SAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 323 | //Compute g=A'f, treat as A transpose for fortran call 324 | SGEMV(&transaN, &n, &m, &alpha, &A[M3(s, 0, 0, m, n)], &n, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 325 | }else{ 326 | //Compute f=-Ax 327 | SGEMV(&transaN, &m, &n, &negAlpha, &A[M3(s, 0, 0, n, m)], &m, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 328 | //Compute f=b-Ax 329 | SAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 330 | //Compute g=A'f 331 | SGEMV(&transaT, &m, &n, &alpha, &A[M3(s, 0, 0, n, m)], &m, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 332 | } 333 | #else 334 | if(isTransposed){ 335 | //Compute f=-Ax, treat as A transpose for fortran call 336 | DGEMV(&transaT, &n, &m, &negAlpha, &A[M3(s, 0, 0, m, n)], &n, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 337 | //Compute f=b-Ax 338 | DAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 339 | //Compute g=A'f, treat as A transpose for fortran call 340 | DGEMV(&transaN, &n, &m, &alpha, &A[M3(s, 0, 0, m, n)], &n, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 341 | }else{ 342 | //Compute f=-Ax 343 | DGEMV(&transaN, &m, &n, &negAlpha, &A[M3(s, 0, 0, n, m)], &m, &x[M2(s, 0, n)], &idx, &beta, &f[M2(tid, 0, m)], &idy); 344 | //Compute f=b-Ax 345 | DAXPY(&m, &alpha, &b[M2(s, 0, m)], &idx, &f[M2(tid, 0, m)], &idy); 346 | //Compute g=A'f 347 | DGEMV(&transaT, &m, &n, &alpha, &A[M3(s, 0, 0, n, m)], &m, &f[M2(tid, 0, m)], &idx, &beta, &g[M2(tid, 0, n)], &idy); 348 | } 349 | #endif 350 | //Check for termination condition by finding a variable in z, s.t. max(g)>0 and remove from z 351 | int vmax = -1; 352 | REAL maxg = TOL_TERMINATION; 353 | for(i = 0; i < n; ++i){ 354 | if(z[M2(tid, i, n)] && g[M2(tid, i, n)] > maxg){ 355 | maxg = g[M2(tid, i, n)]; 356 | vmax = i; 357 | } 358 | } 359 | //All gradients are non-positive so terminate 360 | if(vmax == -1) 361 | break; 362 | 363 | //Remove vmax from z 364 | z[M2(tid, vmax, n)] = 0; 365 | int colAdd = 1; 366 | 367 | //Solve uncontrained linear least squares subproblem 368 | do{ 369 | ++lsIter; 370 | 371 | if(colAdd){ 372 | //printf("Column update\n"); 373 | ////Modified Gram-Schmidt update 374 | //load old col 375 | if(isTransposed){ 376 | for(i = 0 ; i < m; ++i) 377 | newCol[M2(tid, i, m)] = A[M3(s, i, vmax, m, n)]; 378 | }else{ 379 | memcpy(&newCol[M2(tid, 0, m)], &A[M3(s, vmax, 0, n, m)], sizeof(REAL) * m); 380 | } 381 | memcpy(&oldCol[M2(tid, 0, m)], &newCol[M2(tid, 0, m)], sizeof(REAL) * m); 382 | 383 | //Orthogonalize newCol with all previous kCols columns in Q 384 | for(i = 0; i < kCols ;++i){ 385 | int kdx = kIdx[M2(tid, i, n)]; 386 | #ifndef USE_DOUBLE 387 | REAL sc = -SDOT(&m, &Qt[M3(tid, kdx, 0, n, m)], &idx, &newCol[M2(tid, 0, m)], &idy); 388 | SAXPY(&m, &sc, &Qt[M3(tid, kdx, 0, n, m)], &idx, &newCol[M2(tid, 0, m)], &idy); 389 | //Update R 390 | R[M3(tid, kdx, vmax, n, n)] = SDOT(&m, &Qt[M3(tid, kdx, 0, n, m)], &idx, &oldCol[M2(tid, 0, m)], &idy); 391 | #else 392 | REAL sc = -DDOT(&m, &Qt[M3(tid, kdx, 0, n, m)], &idx, &newCol[M2(tid, 0, m)], &idy); 393 | DAXPY(&m, &sc, &Qt[M3(tid, kdx, 0, n, m)], &idx, &newCol[M2(tid, 0, m)], &idy); 394 | //Update R 395 | R[M3(tid, kdx, vmax, n, n)] = DDOT(&m, &Qt[M3(tid, kdx, 0, n, m)], &idx, &oldCol[M2(tid, 0, m)], &idy); 396 | #endif 397 | } 398 | 399 | //REAL norm2 = sqrtf( SDOT(&m, newCol, &idx, newCol, &idy)); 400 | #ifndef USE_DOUBLE 401 | REAL norm2 = SNRM2(&m, &newCol[M2(tid, 0, m)], &idx); 402 | #else 403 | REAL norm2 = DNRM2(&m, &newCol[M2(tid, 0, m)], &idx); 404 | #endif 405 | R[M3(tid, vmax, vmax, n, n)] = norm2; 406 | 407 | norm2 = 1.0f / norm2; 408 | #ifndef USE_DOUBLE 409 | SSCAL(&m, &norm2, &newCol[M2(tid, 0, m)], &idx); 410 | #else 411 | DSCAL(&m, &norm2, &newCol[M2(tid, 0, m)], &idx); 412 | #endif 413 | memcpy(&Qt[M3(tid, vmax, 0, n, m)], &newCol[M2(tid, 0, m)], sizeof(REAL) * m); 414 | #ifndef USE_DOUBLE 415 | Qtb[M2(tid, vmax, n)] = SDOT(&m, &newCol[M2(tid, 0, m)], &idx, &b[M2(s, 0, m)], &idy); 416 | #else 417 | Qtb[M2(tid, vmax, n)] = DDOT(&m, &newCol[M2(tid, 0, m)], &idx, &b[M2(s, 0, m)], &idy); 418 | #endif 419 | //Append vmax to kIdx 420 | kIdx[M2(tid, kCols, n)] = vmax; 421 | kCols++; 422 | 423 | }else{ 424 | //printf("Column Downdate\n"); 425 | //Given's Rotations downdate 426 | 427 | //Rebuild kIdx list 428 | for(i = kCols - 1; i >= 0; --i){ 429 | int kdx = kIdx[M2(tid, i, n)]; 430 | 431 | //Deleted column 432 | if(zRemoved[M2(tid, kdx, n)]){ 433 | for(j = i + 1; j < kCols; ++j){ 434 | int jdx = kIdx[M2(tid, j, n)]; 435 | 436 | REAL gx = R[M3(tid, kdx, jdx, n, n)]; 437 | REAL ax = R[M3(tid, jdx, jdx, n, n)]; 438 | 439 | //Compute c,s,-s,c coefficients for row/col jdx and row/col kdx 440 | REAL givenc, givens; 441 | //SROTG(&ax, &gx, &givenc, &givens); //Not accurate, use below 442 | if(ax == 0 && gx == 0){ 443 | givenc = 0; 444 | givens = 0; 445 | }else if(ax == 0){ 446 | givenc = 0; 447 | givens = 1; 448 | }else if(gx == 0){ 449 | givenc = 1; 450 | givens = 0; 451 | }else if(fabs(gx) > fabs(ax)){ 452 | REAL r = -ax / gx; 453 | givens = 1 / sqrt(1 + r * r); 454 | givenc = -givens * r; 455 | }else{ 456 | REAL r = -gx / ax; 457 | givenc = 1 / sqrt(1 + r * r); 458 | givens = -givenc * r; 459 | } 460 | 461 | #ifndef USE_DOUBLE 462 | //Update R 463 | SROT(&n, &R[M3(tid, jdx, 0, n, n)], &idx, &R[M3(tid, kdx, 0, n, n)], &idy, &givenc, &givens); 464 | 465 | //Update Qt 466 | SROT(&m, &Qt[M3(tid, jdx, 0, n, m)], &idx, &Qt[M3(tid, kdx, 0, n, m)], &idy, &givenc, &givens); 467 | 468 | //Update Qtb 469 | int one = 1; 470 | SROT(&one, &Qtb[M2(tid, jdx, n)], &idx, &Qtb[M2(tid, kdx, n)], &idy, &givenc, &givens); 471 | #else 472 | //Update R 473 | DROT(&n, &R[M3(tid, jdx, 0, n, n)], &idx, &R[M3(tid, kdx, 0, n, n)], &idy, &givenc, &givens); 474 | 475 | //Update Qt 476 | DROT(&m, &Qt[M3(tid, jdx, 0, n, m)], &idx, &Qt[M3(tid, kdx, 0, n, m)], &idy, &givenc, &givens); 477 | 478 | //Update Qtb 479 | int one = 1; 480 | DROT(&one, &Qtb[M2(tid, jdx, n)], &idx, &Qtb[M2(tid, kdx, n)], &idy, &givenc, &givens); 481 | #endif 482 | } 483 | 484 | //Shift sK (column list in set P) list left by one 485 | for(j = i + 1; j < kCols; ++j) 486 | kIdx[M2(tid, j-1, n)] = kIdx[M2(tid, j, n)]; 487 | 488 | --kCols; 489 | } 490 | } 491 | } 492 | 493 | //Compute solution tx 494 | // REAL minTx = HUGE; 495 | REAL minTx = FLT_MAX; 496 | memset(&tx[M2(tid, 0, n)], 0, sizeof(REAL) * n); 497 | for(i = kCols - 1; i >= 0; --i){ 498 | int kdx = kIdx[M2(tid, i, n)]; 499 | //Compute tx via backsubstitution 500 | REAL coeff = R[M3(tid, kdx, kdx, n, n)]; 501 | REAL pSum = 0; 502 | for(j = 0; j < kCols; ++j){ 503 | int jdx = kIdx[M2(tid, j, n)]; 504 | pSum += (kdx != jdx) * R[M3(tid, kdx, jdx, n, n)] * tx[M2(tid, jdx, n)]; 505 | } 506 | tx[M2(tid, kdx, n)] = (Qtb[M2(tid, kdx, n)] - pSum) / coeff; 507 | minTx = MIN(tx[M2(tid, kdx, n)], minTx); 508 | } 509 | 510 | if(minTx > 0){ 511 | //Accept solution, update x 512 | //printf("Accept\n"); 513 | memcpy(&x[M2(s, 0, n)], &tx[M2(tid, 0, n)], sizeof(REAL) * n); 514 | break; 515 | }else{ 516 | //Reject solution, update subproblem 517 | //Find index q in set P for negative z such that x/(x-z) is minimized 518 | //printf("Reject\n"); 519 | // REAL minAlpha = HUGE; 520 | REAL minAlpha = FLT_MAX; 521 | for(i = 0; i < kCols; ++i){ 522 | int kdx = kIdx[M2(tid, i, n)]; 523 | if(tx[M2(tid, kdx, n)] <= 0) 524 | minAlpha = MIN(minAlpha, x[M2(s, kdx, n)] / (x[M2(s, kdx, n)] - tx[M2(tid, kdx, n)]) ); 525 | } 526 | for(i = 0; i < n; ++i) 527 | tx[M2(tid, i, n)] -= x[M2(s, i, n)]; 528 | 529 | #ifndef USE_DOUBLE 530 | SAXPY(&n, &minAlpha, &tx[M2(tid, 0, n)], &idx, &x[M2(s, 0, n)], &idy); 531 | #else 532 | DAXPY(&n, &minAlpha, &tx[M2(tid, 0, n)], &idx, &x[M2(s, 0, n)], &idy); 533 | #endif 534 | memset(&zRemoved[M2(tid, 0, n)], 0, sizeof(int) * n); 535 | //Move from set P to set Z all elements whose corresponding X is 0 (guaranteed to have one element) 536 | for(i = 0; i < kCols; ++i){ 537 | int kdx = kIdx[M2(tid, i, n)]; 538 | zRemoved[M2(tid, kdx, n)] = z[M2(tid, kdx, n)] = fabs(x[M2(s, kdx, n)]) <= TOL_TERMINATION; 539 | } 540 | 541 | colAdd = 0; 542 | } 543 | 544 | }while(lsIter < maxLSIters); 545 | 546 | if(lsIter >= maxLSIters) 547 | break; 548 | 549 | ++nnlsIter; 550 | }while(nnlsIter < maxNNLSIters); 551 | 552 | printf("nSys %d, nnlsIter %d, lsIter %d\n", s, nnlsIter, lsIter); 553 | } 554 | } 555 | 556 | endT = omp_get_wtime(); 557 | printf("Elapsed time %f\n", endT - startT); 558 | 559 | free(tx); 560 | free(Qtb); 561 | free(R); 562 | free(Qt); 563 | free(kIdx); 564 | free(newCol); 565 | free(oldCol); 566 | free(zRemoved); 567 | free(z); 568 | free(f); 569 | free(g); 570 | }//End of nnlsOMPSysMKLUpdates 571 | 572 | void writeOutput(REAL *A, REAL *b, REAL *x, int nSys, int m, int n, char* fileName){ 573 | //Write x in binary 574 | FILE *f_cpu = fopen(fileName, "wb"); 575 | fwrite(x, 1, sizeof(REAL) * nSys * n, f_cpu); 576 | fclose(f_cpu); 577 | 578 | //Write x, Ax, and b in txt format 579 | //Compute error ||Ax-b||2 580 | 581 | f_cpu = fopen("cpu_result.txt","w"); 582 | int s, i, j, k; 583 | 584 | for(s = 0; s < nSys; ++s){ 585 | fprintf(f_cpu, "\nnSys %d Ax\n", s); 586 | REAL norm2 = 0; 587 | for(i = 0; i < m; ++i){ 588 | REAL temp = 0; 589 | for(j = 0; j < n; ++j) 590 | temp += A[M3(s, i, j, m, n)] * x[M2(s, j, n) ]; 591 | fprintf(f_cpu, "%f ", temp); 592 | temp -= b[M2(s, i, m)]; 593 | norm2 += temp * temp; 594 | } 595 | norm2 = sqrt(norm2); 596 | printf("nSys %d, norm %f\n", s, norm2); 597 | fprintf(f_cpu, "\nnorm %f", norm2); 598 | 599 | fprintf(f_cpu, "\n\nb\n"); 600 | for(i = 0; i < m; ++i) 601 | fprintf(f_cpu, "%f ", b[M2(s, i, m) ]); 602 | fprintf(f_cpu, "\n"); 603 | 604 | fprintf(f_cpu, "\n\nx\n"); 605 | for(i = 0; i < n; ++i) 606 | fprintf(f_cpu, "%f ", x[M2(s, i, n) ]); 607 | fprintf(f_cpu, "\n"); 608 | 609 | } 610 | fclose(f_cpu); 611 | } //end of writeOutput 612 | 613 | /* 614 | int main(int argc, char *argv[]){ 615 | int method = 0; 616 | int M = 512; //Equations 617 | int N = 512; //Unknowns 618 | int NSYS = 256; //1-256 619 | int isTransposed = 0; 620 | REAL TOL_TERMINATION = 1e-6; 621 | int MKLThreads = 1, OMPThreads = 1; 622 | REAL *A = NULL, *b = NULL, *x = NULL; 623 | if(argc < 9){ 624 | printf("Expect: method, nSys, isTransposed, mEquations, nUnknowns, tol, MKLThreads, OMPThreads\n"); 625 | }else{ 626 | method = atoi(argv[1]); 627 | NSYS = atoi(argv[2]); 628 | isTransposed = atoi(argv[3]); 629 | M = atoi(argv[4]); 630 | N = atoi(argv[5]); 631 | TOL_TERMINATION = atof(argv[6]); 632 | MKLThreads = atoi(argv[7]); 633 | OMPThreads = atoi(argv[8]); 634 | 635 | srand(2011); 636 | loadData(&A, &b, &x, NSYS, M, N, "sysA.bin", "sysB.bin"); 637 | 638 | if(method == 0) 639 | nnlsOMPSysMKL(A, b, x, 0, MAX_ITER_NNLS(M, N), MAX_ITER_LS(M, N), NSYS, M, N, MKLThreads, OMPThreads, TOL_TERMINATION); 640 | else 641 | nnlsOMPSysMKLUpdates(A, b, x, isTransposed, MAX_ITER_NNLS(M, N), MAX_ITER_LS(M, N), NSYS, M, N, MKLThreads, OMPThreads, TOL_TERMINATION); 642 | 643 | writeOutput(A, b, x, NSYS, M, N, "sysX.bin"); 644 | 645 | if(A) free(A); 646 | if(b) free(b); 647 | if(x) free(x); 648 | } 649 | return 0; 650 | }//End of main 651 | */ 652 | 653 | /* 654 | //For mex calls 655 | void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { 656 | // printf("in mex function\n"); 657 | if(nrhs != 10 || nlhs != 1) 658 | mexErrMsgTxt("Expect: x = NNLS(method, A, b, nSys, isTransposed, mEquations, nUnknowns, tol, MKLThreads, OMPThreads)\n"); 659 | #ifndef USE_DOUBLE 660 | else if(!mxIsSingle(prhs[1]) || !mxIsSingle(prhs[2]) ) 661 | mexErrMsgTxt("A, b must be single precision\n"); 662 | #else 663 | else if(!mxIsDouble(prhs[1]) || !mxIsDouble(prhs[2]) ) 664 | mexErrMsgTxt("A, b must be double precision\n"); 665 | #endif 666 | else{ 667 | int method = mxGetScalar(prhs[0]); 668 | REAL *A = (REAL*)mxGetData(prhs[1]); 669 | REAL *b = (REAL*)mxGetData(prhs[2]); 670 | int NSYS = mxGetScalar(prhs[3]); 671 | int isTransposed = mxGetScalar(prhs[4]); //!0 => A transposed in memory, 0 => A not transposed in memory 672 | int M = mxGetScalar(prhs[5]); //Number of equations 673 | int N = mxGetScalar(prhs[6]); //Number of unknowns 674 | REAL TOL_TERMINATION = mxGetScalar(prhs[7]); //Tolerance for termination (0) 675 | int MKLT = mxGetScalar(prhs[8]); //Number of MKL threads 676 | int OMPT = mxGetScalar(prhs[9]); //Number of OMP threads 677 | 678 | #ifndef USE_DOUBLE 679 | plhs[0] = mxCreateNumericMatrix(N, NSYS, mxSINGLE_CLASS, mxREAL); 680 | #else 681 | plhs[0] = mxCreateNumericMatrix(N, NSYS, mxDOUBLE_CLASS, mxREAL); 682 | #endif 683 | REAL *x = (REAL*)mxGetPr(plhs[0]); 684 | 685 | //Naive (no update/downdates) 686 | if(method == 0) 687 | nnlsOMPSysMKL(A, b, x, isTransposed, MAX_ITER_NNLS(M, N), MAX_ITER_LS(M, N), NSYS, M, N, MKLT, OMPT, TOL_TERMINATION); //Naive implementation, no update/downdate, MKL, OMP per system 688 | else 689 | nnlsOMPSysMKLUpdates(A, b, x, isTransposed, MAX_ITER_NNLS(M, N), MAX_ITER_LS(M, N), NSYS, M, N, MKLT, OMPT, TOL_TERMINATION); //OMP per system, MKL update/downdate 690 | } 691 | 692 | }//end of mexFunction 693 | */ -------------------------------------------------------------------------------- /src/nnlsmkl.h: -------------------------------------------------------------------------------- 1 | #ifndef HEADERS_H 2 | #define HEADERS_H 3 | 4 | //Comment out for single precision 5 | #define USE_DOUBLE 6 | 7 | #ifdef USE_DOUBLE 8 | #define REAL double 9 | #else 10 | #define REAL float 11 | #endif 12 | 13 | //NNLS Constants 14 | #define MAX_ITER_LS(m, n) (((m)+(n))*2) 15 | #define MAX_ITER_NNLS(m, n) MAX_ITER_LS(m, n) 16 | 17 | //Utility macros 18 | #define MIN(a, b)((a)>(b)?(b):(a)) 19 | #define MAX(a, b)((a)>(b)?(a):(b)) 20 | #define SIGN(a)((a)>0?1:-1) 21 | 22 | //Index macros 23 | #define M2(i, j, jl) ((i) * (jl) + (j)) 24 | #define M3(i, j, k, jl, kl) ((i) * ((jl) * (kl)) + (j) * (kl) + (k) ) 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /src/nr.for: -------------------------------------------------------------------------------- 1 | SUBROUTINE svdcmp(a,m,n,mp,np,w,v) 2 | INTEGER m,mp,n,np 3 | DOUBLE PRECISION a(mp,np),v(np,np),w(np) 4 | INTEGER i,its,j,jj,k,l,nm 5 | DOUBLE PRECISION anorm,c,f,g,h,s,scale,x,y,z,rv1(np),pythag 6 | g=0.0d0 7 | scale=0.0d0 8 | anorm=0.0d0 9 | do 25 i=1,n 10 | l=i+1 11 | rv1(i)=scale*g 12 | g=0.0d0 13 | s=0.0d0 14 | scale=0.0d0 15 | if(i.le.m)then 16 | do 11 k=i,m 17 | scale=scale+abs(a(k,i)) 18 | 11 continue 19 | if(scale.ne.0.0d0)then 20 | do 12 k=i,m 21 | a(k,i)=a(k,i)/scale 22 | s=s+a(k,i)*a(k,i) 23 | 12 continue 24 | f=a(i,i) 25 | g=-sign(sqrt(s),f) 26 | h=f*g-s 27 | a(i,i)=f-g 28 | do 15 j=l,n 29 | s=0.0d0 30 | do 13 k=i,m 31 | s=s+a(k,i)*a(k,j) 32 | 13 continue 33 | f=s/h 34 | do 14 k=i,m 35 | a(k,j)=a(k,j)+f*a(k,i) 36 | 14 continue 37 | 15 continue 38 | do 16 k=i,m 39 | a(k,i)=scale*a(k,i) 40 | 16 continue 41 | endif 42 | endif 43 | w(i)=scale *g 44 | g=0.0d0 45 | s=0.0d0 46 | scale=0.0d0 47 | if((i.le.m).and.(i.ne.n))then 48 | do 17 k=l,n 49 | scale=scale+abs(a(i,k)) 50 | 17 continue 51 | if(scale.ne.0.0d0)then 52 | do 18 k=l,n 53 | a(i,k)=a(i,k)/scale 54 | s=s+a(i,k)*a(i,k) 55 | 18 continue 56 | f=a(i,l) 57 | g=-sign(sqrt(s),f) 58 | h=f*g-s 59 | a(i,l)=f-g 60 | do 19 k=l,n 61 | rv1(k)=a(i,k)/h 62 | 19 continue 63 | do 23 j=l,m 64 | s=0.0d0 65 | do 21 k=l,n 66 | s=s+a(j,k)*a(i,k) 67 | 21 continue 68 | do 22 k=l,n 69 | a(j,k)=a(j,k)+s*rv1(k) 70 | 22 continue 71 | 23 continue 72 | do 24 k=l,n 73 | a(i,k)=scale*a(i,k) 74 | 24 continue 75 | endif 76 | endif 77 | anorm=max(anorm,(abs(w(i))+abs(rv1(i)))) 78 | 25 continue 79 | do 32 i=n,1,-1 80 | if(i.lt.n)then 81 | if(g.ne.0.0d0)then 82 | do 26 j=l,n 83 | v(j,i)=(a(i,j)/a(i,l))/g 84 | 26 continue 85 | do 29 j=l,n 86 | s=0.0d0 87 | do 27 k=l,n 88 | s=s+a(i,k)*v(k,j) 89 | 27 continue 90 | do 28 k=l,n 91 | v(k,j)=v(k,j)+s*v(k,i) 92 | 28 continue 93 | 29 continue 94 | endif 95 | do 31 j=l,n 96 | v(i,j)=0.0d0 97 | v(j,i)=0.0d0 98 | 31 continue 99 | endif 100 | v(i,i)=1.0d0 101 | g=rv1(i) 102 | l=i 103 | 32 continue 104 | do 39 i=min(m,n),1,-1 105 | l=i+1 106 | g=w(i) 107 | do 33 j=l,n 108 | a(i,j)=0.0d0 109 | 33 continue 110 | if(g.ne.0.0d0)then 111 | g=1.0d0/g 112 | do 36 j=l,n 113 | s=0.0d0 114 | do 34 k=l,m 115 | s=s+a(k,i)*a(k,j) 116 | 34 continue 117 | f=(s/a(i,i))*g 118 | do 35 k=i,m 119 | a(k,j)=a(k,j)+f*a(k,i) 120 | 35 continue 121 | 36 continue 122 | do 37 j=i,m 123 | a(j,i)=a(j,i)*g 124 | 37 continue 125 | else 126 | do 38 j= i,m 127 | a(j,i)=0.0d0 128 | 38 continue 129 | endif 130 | a(i,i)=a(i,i)+1.0d0 131 | 39 continue 132 | do 49 k=n,1,-1 133 | do 48 its=1,30 134 | do 41 l=k,1,-1 135 | nm=l-1 136 | if((abs(rv1(l))+anorm).eq.anorm) goto 2 137 | if((abs(w(nm))+anorm).eq.anorm) goto 1 138 | 41 continue 139 | 1 c=0.0d0 140 | s=1.0d0 141 | do 43 i=l,k 142 | f=s*rv1(i) 143 | rv1(i)=c*rv1(i) 144 | if((abs(f)+anorm).eq.anorm) goto 2 145 | g=w(i) 146 | h=pythag(f,g) 147 | w(i)=h 148 | h=1.0d0/h 149 | c= (g*h) 150 | s=-(f*h) 151 | do 42 j=1,m 152 | y=a(j,nm) 153 | z=a(j,i) 154 | a(j,nm)=(y*c)+(z*s) 155 | a(j,i)=-(y*s)+(z*c) 156 | 42 continue 157 | 43 continue 158 | 2 z=w(k) 159 | if(l.eq.k)then 160 | if(z.lt.0.0d0)then 161 | w(k)=-z 162 | do 44 j=1,n 163 | v(j,k)=-v(j,k) 164 | 44 continue 165 | endif 166 | goto 3 167 | endif 168 | if(its.eq.100) pause 'no convergence in svdcmp' 169 | x=w(l) 170 | nm=k-1 171 | y=w(nm) 172 | g=rv1(nm) 173 | h=rv1(k) 174 | f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0d0*h*y) 175 | g=pythag(f,1.0d0) 176 | f=((x-z)*(x+z)+h*((y/(f+sign(g,f)))-h))/x 177 | c=1.0d0 178 | s=1.0d0 179 | do 47 j=l,nm 180 | i=j+1 181 | g=rv1(i) 182 | y=w(i) 183 | h=s*g 184 | g=c*g 185 | z=pythag(f,h) 186 | rv1(j)=z 187 | c=f/z 188 | s=h/z 189 | f= (x*c)+(g*s) 190 | g=-(x*s)+(g*c) 191 | h=y*s 192 | y=y*c 193 | do 45 jj=1,n 194 | x=v(jj,j) 195 | z=v(jj,i) 196 | v(jj,j)= (x*c)+(z*s) 197 | v(jj,i)=-(x*s)+(z*c) 198 | 45 continue 199 | z=pythag(f,h) 200 | w(j)=z 201 | if(z.ne.0.0d0)then 202 | z=1.0d0/z 203 | c=f*z 204 | s=h*z 205 | endif 206 | f= (c*g)+(s*y) 207 | x=-(s*g)+(c*y) 208 | do 46 jj=1,m 209 | y=a(jj,j) 210 | z=a(jj,i) 211 | a(jj,j)= (y*c)+(z*s) 212 | a(jj,i)=-(y*s)+(z*c) 213 | 46 continue 214 | 47 continue 215 | rv1(l)=0.0d0 216 | rv1(k)=f 217 | w(k)=x 218 | 48 continue 219 | 3 continue 220 | 49 continue 221 | return 222 | END 223 | 224 | FUNCTION pythag(a,b) 225 | DOUBLE PRECISION a,b,pythag 226 | DOUBLE PRECISION absa,absb 227 | absa=abs(a) 228 | absb=abs(b) 229 | if(absa.gt.absb)then 230 | pythag=absa*sqrt(1.d0+(absb/absa)**2) 231 | else 232 | if(absb.eq.0.d0)then 233 | pythag=0.d0 234 | else 235 | pythag=absb*sqrt(1.d0+(absa/absb)**2) 236 | endif 237 | endif 238 | return 239 | END 240 | 241 | SUBROUTINE four1(data,nn,isign) 242 | INTEGER isign,nn 243 | DOUBLE PRECISION data(2*nn) 244 | INTEGER i,istep,j,m,mmax,n 245 | DOUBLE PRECISION tempi,tempr 246 | DOUBLE PRECISION theta,wi,wpi,wpr,wr,wtemp 247 | n=2*nn 248 | j=1 249 | do 11 i=1,n,2 250 | if(j.gt.i)then 251 | tempr=data(j) 252 | tempi=data(j+1) 253 | data(j)=data(i) 254 | data(j+1)=data(i+1) 255 | data(i)=tempr 256 | data(i+1)=tempi 257 | endif 258 | m=n/2 259 | 1 if ((m.ge.2).and.(j.gt.m)) then 260 | j=j-m 261 | m=m/2 262 | goto 1 263 | endif 264 | j=j+m 265 | 11 continue 266 | mmax=2 267 | 2 if (n.gt.mmax) then 268 | istep=2*mmax 269 | theta=6.28318530717959d0/(isign*mmax) 270 | wpr=-2.d0*sin(0.5d0*theta)**2 271 | wpi=sin(theta) 272 | wr=1.d0 273 | wi=0.d0 274 | do 13 m=1,mmax,2 275 | do 12 i=m,n,istep 276 | j=i+mmax 277 | tempr=dble(wr)*data(j)-dble(wi)*data(j+1) 278 | tempi=dble(wr)*data(j+1)+dble(wi)*data(j) 279 | data(j)=data(i)-tempr 280 | data(j+1)=data(i+1)-tempi 281 | data(i)=data(i)+tempr 282 | data(i+1)=data(i+1)+tempi 283 | 12 continue 284 | wtemp=wr 285 | wr=wr*wpr-wi*wpi+wr 286 | wi=wi*wpr+wtemp*wpi+wi 287 | 13 continue 288 | mmax=istep 289 | goto 2 290 | endif 291 | return 292 | END 293 | 294 | 295 | SUBROUTINE fourn(data,nn,ndim,isign) 296 | INTEGER isign,ndim,nn(ndim) 297 | DOUBLE PRECISION data(*) 298 | INTEGER i1,i2,i2rev,i3,i3rev,ibit,idim,ifp1,ifp2,ip1,ip2,ip3,k1, 299 | *k2,n,nprev,nrem,ntot 300 | DOUBLE PRECISION tempi,tempr 301 | DOUBLE PRECISION theta,wi,wpi,wpr,wr,wtemp 302 | ntot=1 303 | do 11 idim=1,ndim 304 | ntot=ntot*nn(idim) 305 | 11 continue 306 | nprev=1 307 | do 18 idim=1,ndim 308 | n=nn(idim) 309 | nrem=ntot/(n*nprev) 310 | ip1=2*nprev 311 | ip2=ip1*n 312 | ip3=ip2*nrem 313 | i2rev=1 314 | do 14 i2=1,ip2,ip1 315 | if(i2.lt.i2rev)then 316 | do 13 i1=i2,i2+ip1-2,2 317 | do 12 i3=i1,ip3,ip2 318 | i3rev=i2rev+i3-i2 319 | tempr=data(i3) 320 | tempi=data(i3+1) 321 | data(i3)=data(i3rev) 322 | data(i3+1)=data(i3rev+1) 323 | data(i3rev)=tempr 324 | data(i3rev+1)=tempi 325 | 12 continue 326 | 13 continue 327 | endif 328 | ibit=ip2/2 329 | 1 if ((ibit.ge.ip1).and.(i2rev.gt.ibit)) then 330 | i2rev=i2rev-ibit 331 | ibit=ibit/2 332 | goto 1 333 | endif 334 | i2rev=i2rev+ibit 335 | 14 continue 336 | ifp1=ip1 337 | 2 if(ifp1.lt.ip2)then 338 | ifp2=2*ifp1 339 | theta=isign*6.28318530717959d0/(ifp2/ip1) 340 | wpr=-2.d0*sin(0.5d0*theta)**2 341 | wpi=sin(theta) 342 | wr=1.d0 343 | wi=0.d0 344 | do 17 i3=1,ifp1,ip1 345 | do 16 i1=i3,i3+ip1-2,2 346 | do 15 i2=i1,ip3,ifp2 347 | k1=i2 348 | k2=k1+ifp1 349 | tempr=dble(wr)*data(k2)-dble(wi)*data(k2+1) 350 | tempi=dble(wr)*data(k2+1)+dble(wi)*data(k2) 351 | data(k2)=data(k1)-tempr 352 | data(k2+1)=data(k1+1)-tempi 353 | data(k1)=data(k1)+tempr 354 | data(k1+1)=data(k1+1)+tempi 355 | 15 continue 356 | 16 continue 357 | wtemp=wr 358 | wr=wr*wpr-wi*wpi+wr 359 | wi=wi*wpr+wtemp*wpi+wi 360 | 17 continue 361 | ifp1=ifp2 362 | goto 2 363 | endif 364 | nprev=n*nprev 365 | 18 continue 366 | return 367 | END 368 | 369 | --------------------------------------------------------------------------------