[cig-commits] commit: change source code to directory src/

Mercurial hg at geodynamics.org
Sat Apr 7 17:03:47 PDT 2012


changeset:   74:e7295294f654
user:        Sylvain Barbot <sbarbot at caltech.edu>
date:        Sun Apr 01 14:02:51 2012 -0700
files:       .hgignore ctfft.f elastic3d.f90 examples/tutorials/run1-pbs.sh examples/tutorials/run1.sh examples/tutorials/run2.sh examples/tutorials/run3.sh examples/tutorials/run4.sh export.f90 fourier.f90 friction3d.f90 getdata.f getopt_m.f90 green.f90 include.f90 input.f90 kernel1.inc kernel11.inc kernel14.inc kernel14bis.inc kernel7.inc mkl_dfti.f90 proj.c relax.f90 src/ctfft.f src/elastic3d.f90 src/export.f90 src/fourier.f90 src/friction3d.f90 src/getdata.f src/getopt_m.f90 src/green.f90 src/include.f90 src/input.f90 src/kernel1.inc src/kernel11.inc src/kernel14.inc src/kernel14bis.inc src/kernel7.inc src/mkl_dfti.f90 src/proj.c src/relax.f90 src/types.f90 src/viscoelastic3d.f90 src/writegrd3.4.c src/writegrd4.2.c src/writevtk.c types.f90 viscoelastic3d.f90 writegrd3.4.c writegrd4.2.c writevtk.c wscript
description:
change source code to directory src/


diff -r 405d8f4fa05f -r e7295294f654 .hgignore
--- a/.hgignore	Thu Mar 29 15:55:33 2012 -0700
+++ b/.hgignore	Sun Apr 01 14:02:51 2012 -0700
@@ -1,6 +1,6 @@ syntax: glob
 syntax: glob
 
-relax
+.waf-1.6.8-*
 *~
 *.o
 *.mod
@@ -12,10 +12,10 @@ examples/.gmtcommands4
 examples/.gmtcommands4
 examples/.gmtdefaults4
 examples/.DS_Store
-examples/output1
-examples/output2
-examples/output3
-examples/output4
+examples/tutorials/output1
+examples/tutorials/output2
+examples/tutorials/output3
+examples/tutorials/output4
 examples/mojave/coulomb
 latex/relax.aux
 latex/relax.blg
diff -r 405d8f4fa05f -r e7295294f654 ctfft.f
--- a/ctfft.f	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,618 +0,0 @@
-      subroutine ctfft (data,n,ndim,isign,iform,work,nwork)             fft   1
-c     cooley-tukey fast fourier transform in usasi basic fortran.       fft   2
-c     multi-dimensional transform, dimensions of arbitrary size,        fft   3
-c     complex or real data.  n points can be transformed in time        fft   4
-c     proportional to n*log(n), whereas other methods take n**2 time.   fft   5
-c     furthermore, less error is built up.  written by norman brenner   fft   6
-c     of mit lincoln laboratory, june 1968.                             fft   7
-c                                                                       fft   8
-c     dimension data(n(1),n(2),...),transform(n(1),n(2),...),n(ndim)    fft   9
-c     transform(k1,k2,...) = sum(data(j1,j2,...)*exp(isign*2*pi*sqrt(-1)fft  10
-c     *((j1-1)*(k1-1)/n(1)+(j2-1)*(k2-1)/n(2)+...))), summed for all    fft  11
-c     j1 and k1 from 1 to n(1), j2 and k2 from 1 to n(2), etc. for all  fft  12
-c     ndim subscripts.  ndim must be positive and each n(idim) may be   fft  13
-c     any integer.  isign is +1 or -1.  let ntot = n(1)*n(2)...         fft  14
-c     ...*n(ndim).  then a -1 transform followed by a +1 one            fft  15
-c     (or vice versa) returns ntot times the original data.             fft  16
-c     iform = 1, 0 or -1, as data is complex, real or the               fft  17
-c     first half of a complex array.  transform values are              fft  18
-c     returned to array data.  they are complex, real or                fft  19
-c     the first half of a complex array, as iform = 1, -1 or 0.         fft  20
-c     the transform of a real array (iform = 0) dimensioned n(1) by n(2)fft  21
-c     by ... will be returned in the same array, now considered to      fft  22
-c     be complex of dimensions n(1)/2+1 by n(2) by ....  note that if   fft  23
-c     iform = 0 or -1, n(1) must be even, and enough room must be       fft  24
-c     reserved.  the missing values may be obtained by complex conju-   fft  25
-c     gation.  the reverse transformation, of a half complex array      fft  26
-c     dimensioned n(1)/2+1 by n(2) by ..., is accomplished setting iformfft  27
-c     to -1.  in the n array, n(1) must be the true n(1), not n(1)/2+1. fft  28
-c     the transform will be real and returned to the input array.       fft  29
-c     work is a one-dimensional complex array used for working storage. fft  30
-c     its length, nwork, need never be larger than the largest n(idim)  fft  31
-c     and frequently may be much smaller.  fourt computes the minimum   fft  32
-c     length working storage required and checks that nwork is at least fft  33
-c     as long.  this minimum length is ccomputed as shown below.        fft  34
-c                                                                       fft  35
-c     for example--                                                     fft  36
-c     dimension data(1960),work(10)                                     fft  37
-c     complex data,work                                                 fft  38
-c     call fourt(data,1960,1,-1,+1,work,10)                             fft  39
-c                                                                       fft  40
-c     the multi-dimensional transform is broken down into one-dimen-    fft  41
-c     sional transforms of length n(idim).  these are further broken    fft  42
-c     down into transforms of length ifact(if), where these are the     fft  43
-c     prime factors of n(idim).  for example, n(1) = 1960, ifact(if) =  fft  44
-c     2, 2, 2, 5, 7 and 7.  the running time is proportional to ntot *  fft  45
-c     sum(ifact(if)), though factors of two and three will run espe-    fft  46
-c     cially fast.  naive transform programs will run in time ntot**2.  fft  47
-c     arrays whose size ntot is prime will run much slower than those   fft  48
-c     with composite ntot.  for example, ntot = n(1) = 1951 (a prime),  fft  49
-c     running time will be 1951*1951, while for ntot = 1960, it will    fft  50
-c     be 1960*(2+2+2+5+7+7), a speedup of eighty times.  naive calcul-  fft  51
-c     ation will run both in the slower time.  if an array is of        fft  52
-c     inconvenient length, simply add zeroes to pad it out.  the resultsfft  53
-c     will be interpolated according to the new length (see below).     fft  54
-c                                                                       fft  55
-c     a fourier transform of length ifact(if) requires a work array     fft  56
-c     of that length.  therefore, nwork must be as big as the largest   fft  57
-c     prime factor.  further, work is needed for digit reversal--       fft  58
-c     each n(idim) (but n(1)/2 if iform = 0 or -1) is factored symmetri-fft  59
-c     cally, and nwork must be as big as the center factor.  (to factor fft  60
-c     symmetrically, separate pairs of identical factors to the flanks, fft  61
-c     combining all leftovers in the center.)  for example, n(1) = 1960 fft  62
-c     =2*2*2*5*7*7=2*7*10*7*2, so nwork must at least max(7,10) = 10.   fft  63
-c                                                                       fft  64
-c     an upper bound for the rms relative error is given by gentleman   fft  65
-c     and sande (3)-- 3 * 2**(-b) * sum(f**1.5), where 2**(-b) is the   fft  66
-c     smallest bit in the floating point fraction and the sum is over   fft  67
-c     the prime factors of ntot.                                        fft  68
-c                                                                       fft  69
-c     if the input data are a time series, with index j representing    fft  70
-c     a time (j-1)*deltat, then the corresponding index k in the        fft  71
-c     transform represents the frequency (k-1)*2*pi/(n*deltat), which   fft  72
-c     by periodicity, is the same as frequency -(n-k+1)*2*pi/(n*deltat).fft  73
-c     this is true for n = each n(idim) independently.                  fft  74
-c                                                                       fft  75
-c     references--                                                      fft  76
-c     1.  cooley, j.w. and tukey, j.w., an algorithm for the machine    fft  77
-c     calculation of complex fourier series.  math. comp., 19, 90,      fft  78
-c     (april 1967), 297-301.                                            fft  79
-c     2.  rader, c., et al., what is the fast fourier transform, ieee   fft  80
-c     transactions on audio and electroacoustics, au-15, 2 (june 1967). fft  81
-c     (special issue on the fast fourier transform and its applications)fft  82
-c     3.  gentleman, w.m. and sande, g., fast fourier transforms--      fft  83
-c     for fun and profit.  1966 fall joint comp. conf., spartan books,  fft  84
-c     washington, 1966.                                                 fft  85
-c     4.  goertzel, g., an algorithm for the evaluation of finite       fft  86
-c     trigonometric series.  am. math. mo., 65, (1958), 34-35.          fft  87
-c     5.  singleton, r.c., a method for computing the fast fourier      fft  88
-c     transform with auxiliary memory and limited high-speed storage.   fft  89
-c     in (2).                                                           fft  90
-      dimension data(*), n(1), work(*), ifsym(32), ifcnt(10), ifact(32) fft  91
-      if (iform) 10,10,40                                               fft  92
- 10   if (n(1)-2*(n(1)/2)) 20,40,20                                     fft  93
- 20   continue
-c20   write (6,30) iform,(n(idim),idim=1,ndim)                          fft  94
-c30   format ('error in fourt.  iform = ',i2,'(real or half-complex)'
-c    $' but n(1) is not even./14h dimensions = ',20i5)                  fft  96
-      return                                                            fft  97
- 40   ntot=1                                                            fft  98
-      do 50 idim=1,ndim                                                 fft  99
- 50   ntot=ntot*n(idim)                                                 fft 100
-      nrem=ntot                                                         fft 101
-      if (iform) 60,70,70                                               fft 102
- 60   nrem=1                                                            fft 103
-      ntot=(ntot/n(1))*(n(1)/2+1)                                       fft 104
-c     loop over all dimensions.                                         fft 105
- 70   do 230 jdim=1,ndim                                                fft 106
-      if (iform) 80,90,90                                               fft 107
- 80   idim=ndim+1-jdim                                                  fft 108
-      go to 100                                                         fft 109
- 90   idim=jdim                                                         fft 110
-      nrem=nrem/n(idim)                                                 fft 111
- 100  ncurr=n(idim)                                                     fft 112
-      if (idim-1) 110,110,140                                           fft 113
- 110  if (iform) 120,130,140                                            fft 114
- 120  call fixrl (data,n(1),nrem,isign,iform)                           fft 115
-      ntot=(ntot/(n(1)/2+1))*n(1)                                       fft 116
- 130  ncurr=ncurr/2                                                     fft 117
- 140  if (ncurr-1) 190,190,150                                          fft 118
-c     factor n(idim), the length of this dimension.                     fft 119
- 150  call factr (ncurr,ifact,nfact)                                    fft 120
-      ifmax=ifact(nfact)                                                fft 121
-c     arrange the factors symmetrically for simpler digit reversal.     fft 122
-      call smfac (ifact,nfact,isym,ifsym,nfsym,icent,ifcnt,nfcnt)       fft 123
-      ifmax=max0(ifmax,icent)                                           fft 124
-      if (ifmax-nwork) 180,180,160                                      fft 125
-  160 continue
-c 160 write (6,170) nwork,idim,ncurr,icent,(ifact(if),if=1,nfact)       fft 126
-c 170 format (26h0error in fourt.  nwork = ,i4,20h is too small for n(, fft 127
-c    $i1,4h) = ,i5,17h, whose center = ,i4,31h, and whose prime factors fft 128
-c    $are--/(1x,20i5))                                                  fft 129
-      return                                                            fft 130
- 180  nprev=ntot/(n(idim)*nrem)                                         fft 131
-c     digit reverse on symmetric factors, for example 2*7*6*7*2.        fft 132
-      call symrv (data,nprev,ncurr,nrem,ifsym,nfsym)                    fft 133
-c     digit reverse the asymmetric center, for example, on 6 = 2*3.     fft 134
-      call asmrv (data,nprev*isym,icent,isym*nrem,ifcnt,nfcnt,work)     fft 135
-c     fourier transform on each factor, for example, on 2,7,2,3,7 and 2.fft 136
-      call cool (data,nprev,ncurr,nrem,isign,ifact,work)                fft 137
- 190  if (iform) 200,210,230                                            fft 138
- 200  nrem=nrem*n(idim)                                                 fft 139
-      go to 230                                                         fft 140
- 210  if (idim-1) 220,220,230                                           fft 141
- 220  call fixrl (data,n(1),nrem,isign,iform)                           fft 142
-      ntot=ntot/n(1)*(n(1)/2+1)                                         fft 143
- 230  continue                                                          fft 144
-      return                                                            fft 145
-      end                                                               fft 146-
-      subroutine asmrv (data,nprev,n,nrem,ifact,nfact,work)             asm   1
-c     shuffle the data array by reversing the digits of one index.      asm   2
-c     the operation is the same as in symrv, except that the factors    asm   3
-c     need not be symmetrically arranged, i.e., generally ifact(if) not=asm   4
-c     ifact(nfact+1-if).  consequently, a work array of length n is     asm   5
-c     needed.                                                           asm   6
-      dimension data(*), work(*), ifact(1)                              asm   7
-      if (nfact-1) 60,60,10                                             asm   8
- 10   ip0=2                                                             asm   9
-      ip1=ip0*nprev                                                     asm  10
-      ip4=ip1*n                                                         asm  11
-      ip5=ip4*nrem                                                      asm  12
-      do 50 i1=1,ip1,ip0                                                asm  13
-      do 50 i5=i1,ip5,ip4                                               asm  14
-      iwork=1                                                           asm  15
-      i4rev=i5                                                          asm  16
-      i4max=i5+ip4-ip1                                                  asm  17
-      do 40 i4=i5,i4max,ip1                                             asm  18
-      work(iwork)=data(i4rev)                                           asm  19
-      work(iwork+1)=data(i4rev+1)                                       asm  20
-      ip3=ip4                                                           asm  21
-      do 30 if=1,nfact                                                  asm  22
-      ip2=ip3/ifact(if)                                                 asm  23
-      i4rev=i4rev+ip2                                                   asm  24
-      if (i4rev-ip3-i5) 40,20,20                                        asm  25
- 20   i4rev=i4rev-ip3                                                   asm  26
- 30   ip3=ip2                                                           asm  27
- 40   iwork=iwork+ip0                                                   asm  28
-      iwork=1                                                           asm  29
-      do 50 i4=i5,i4max,ip1                                             asm  30
-      data(i4)=work(iwork)                                              asm  31
-      data(i4+1)=work(iwork+1)                                          asm  32
- 50   iwork=iwork+ip0                                                   asm  33
- 60   return                                                            asm  34
-      end                                                               asm  35-
-      subroutine cool (data,nprev,n,nrem,isign,ifact,work)              coo   1
-c     fourier transform of length n.  in place cooley-tukey method,     coo   2
-c     digit-reversed to normal order, sande-tukey factoring (2).        coo   3
-c     dimension data(nprev,n,nrem)                                      coo   4
-c     complex data                                                      coo   5
-c     data(i1,j2,i3) = sum(data(i1,i2,i3)*exp(isign*2*pi*i*((i2-1)*     coo   6
-c     (j2-1)/n))), summed over i2 = 1 to n for all i1 from 1 to nprev,  coo   7
-c     j2 from 1 to n and i3 from 1 to nrem.  the factors of n are given coo   8
-c     in any order in array ifact.  factors of two are done in pairs    coo   9
-c     as much as possible (fourier transform of length four), factors ofcoo  10
-c     three are done separately, and all factors five or higher         coo  11
-c     are done by goertzel's algorithm (4).                             coo  12
-      dimension data(*), work(*), ifact(1)                              coo  13
-      twopi=6.283185307*float(isign)                                    coo  14
-      ip0=2                                                             coo  15
-      ip1=ip0*nprev                                                     coo  16
-      ip4=ip1*n                                                         coo  17
-      ip5=ip4*nrem                                                      coo  18
-      if=0                                                              coo  19
-      ip2=ip1                                                           coo  20
- 10   if (ip2-ip4) 20,240,240                                           coo  21
- 20   if=if+1                                                           coo  22
-      ifcur=ifact(if)                                                   coo  23
-      if (ifcur-2) 60,30,60                                             coo  24
- 30   if (4*ip2-ip4) 40,40,60                                           coo  25
- 40   if (ifact(if+1)-2) 60,50,60                                       coo  26
- 50   if=if+1                                                           coo  27
-      ifcur=4                                                           coo  28
- 60   ip3=ip2*ifcur                                                     coo  29
-      theta=twopi/float(ifcur)                                          coo  30
-      sinth=sin(theta/2.)                                               coo  31
-      rootr=-2.*sinth*sinth                                             coo  32
-c     cos(theta)-1, for accuracy.                                       coo  33
-      rooti=sin(theta)                                                  coo  34
-      theta=twopi/float(ip3/ip1)                                        coo  35
-      sinth=sin(theta/2.)                                               coo  36
-      wstpr=-2.*sinth*sinth                                             coo  37
-      wstpi=sin(theta)                                                  coo  38
-      wr=1.                                                             coo  39
-      wi=0.                                                             coo  40
-      do 230 i2=1,ip2,ip1                                               coo  41
-      if (ifcur-4) 70,70,210                                            coo  42
- 70   if ((i2-1)*(ifcur-2)) 240,90,80                                   coo  43
- 80   w2r=wr*wr-wi*wi                                                   coo  44
-      w2i=2.*wr*wi                                                      coo  45
-      w3r=w2r*wr-w2i*wi                                                 coo  46
-      w3i=w2r*wi+w2i*wr                                                 coo  47
- 90   i1max=i2+ip1-ip0                                                  coo  48
-      do 200 i1=i2,i1max,ip0                                            coo  49
-      do 200 i5=i1,ip5,ip3                                              coo  50
-      j0=i5                                                             coo  51
-      j1=j0+ip2                                                         coo  52
-      j2=j1+ip2                                                         coo  53
-      j3=j2+ip2                                                         coo  54
-      if (i2-1) 140,140,100                                             coo  55
- 100  if (ifcur-3) 130,120,110                                          coo  56
-c     apply the phase shift factors                                     coo  57
- 110  tempr=data(j3)                                                    coo  58
-      data(j3)=w3r*tempr-w3i*data(j3+1)                                 coo  59
-      data(j3+1)=w3r*data(j3+1)+w3i*tempr                               coo  60
-      tempr=data(j2)                                                    coo  61
-      data(j2)=wr*tempr-wi*data(j2+1)                                   coo  62
-      data(j2+1)=wr*data(j2+1)+wi*tempr                                 coo  63
-      tempr=data(j1)                                                    coo  64
-      data(j1)=w2r*tempr-w2i*data(j1+1)                                 coo  65
-      data(j1+1)=w2r*data(j1+1)+w2i*tempr                               coo  66
-      go to 140                                                         coo  67
- 120  tempr=data(j2)                                                    coo  68
-      data(j2)=w2r*tempr-w2i*data(j2+1)                                 coo  69
-      data(j2+1)=w2r*data(j2+1)+w2i*tempr                               coo  70
- 130  tempr=data(j1)                                                    coo  71
-      data(j1)=wr*tempr-wi*data(j1+1)                                   coo  72
-      data(j1+1)=wr*data(j1+1)+wi*tempr                                 coo  73
- 140  if (ifcur-3) 150,160,170                                          coo  74
-c     do a fourier transform of length two                              coo  75
- 150  tempr=data(j1)                                                    coo  76
-      tempi=data(j1+1)                                                  coo  77
-      data(j1)=data(j0)-tempr                                           coo  78
-      data(j1+1)=data(j0+1)-tempi                                       coo  79
-      data(j0)=data(j0)+tempr                                           coo  80
-      data(j0+1)=data(j0+1)+tempi                                       coo  81
-      go to 200                                                         coo  82
-c     do a fourier transform of length three                            coo  83
- 160  sumr=data(j1)+data(j2)                                            coo  84
-      sumi=data(j1+1)+data(j2+1)                                        coo  85
-      tempr=data(j0)-.5*sumr                                            coo  86
-      tempi=data(j0+1)-.5*sumi                                          coo  87
-      data(j0)=data(j0)+sumr                                            coo  88
-      data(j0+1)=data(j0+1)+sumi                                        coo  89
-      difr=rooti*(data(j2+1)-data(j1+1))                                coo  90
-      difi=rooti*(data(j1)-data(j2))                                    coo  91
-      data(j1)=tempr+difr                                               coo  92
-      data(j1+1)=tempi+difi                                             coo  93
-      data(j2)=tempr-difr                                               coo  94
-      data(j2+1)=tempi-difi                                             coo  95
-      go to 200                                                         coo  96
-c     do a fourier transform of length four (from bit reversed order)   coo  97
- 170  t0r=data(j0)+data(j1)                                             coo  98
-      t0i=data(j0+1)+data(j1+1)                                         coo  99
-      t1r=data(j0)-data(j1)                                             coo 100
-      t1i=data(j0+1)-data(j1+1)                                         coo 101
-      t2r=data(j2)+data(j3)                                             coo 102
-      t2i=data(j2+1)+data(j3+1)                                         coo 103
-      t3r=data(j2)-data(j3)                                             coo 104
-      t3i=data(j2+1)-data(j3+1)                                         coo 105
-      data(j0)=t0r+t2r                                                  coo 106
-      data(j0+1)=t0i+t2i                                                coo 107
-      data(j2)=t0r-t2r                                                  coo 108
-      data(j2+1)=t0i-t2i                                                coo 109
-      if (isign) 180,180,190                                            coo 110
- 180  t3r=-t3r                                                          coo 111
-      t3i=-t3i                                                          coo 112
- 190  data(j1)=t1r-t3i                                                  coo 113
-      data(j1+1)=t1i+t3r                                                coo 114
-      data(j3)=t1r+t3i                                                  coo 115
-      data(j3+1)=t1i-t3r                                                coo 116
- 200  continue                                                          coo 117
-      go to 220                                                         coo 118
-c     do a fourier transform of length five or more                     coo 119
- 210  call goert (data(i2),nprev,ip2/ip1,ifcur,ip5/ip3,work,wr,wi,rootr,coo 120
-     $rooti)                                                            coo 121
- 220  tempr=wr                                                          coo 122
-      wr=wstpr*tempr-wstpi*wi+tempr                                     coo 123
- 230  wi=wstpr*wi+wstpi*tempr+wi                                        coo 124
-      ip2=ip3                                                           coo 125
-      go to 10                                                          coo 126
- 240  return                                                            coo 127
-      end                                                               coo 128-
-      subroutine factr (n,ifact,nfact)                                  fac   1
-c     factor n into its prime factors, nfact in number.  for example,   fac   2
-c     for n = 1960, nfact = 6 and ifact(if) = 2, 2, 2, 5, 7 and 7.      fac   3
-      dimension ifact(1)                                                fac   4
-      if=0                                                              fac   5
-      npart=n                                                           fac   6
-      do 50 id=1,n,2                                                    fac   7
-      idiv=id                                                           fac   8
-      if (id-1) 10,10,20                                                fac   9
- 10   idiv=2                                                            fac  10
- 20   iquot=npart/idiv                                                  fac  11
-      if (npart-idiv*iquot) 40,30,40                                    fac  12
- 30   if=if+1                                                           fac  13
-      ifact(if)=idiv                                                    fac  14
-      npart=iquot                                                       fac  15
-      go to 20                                                          fac  16
- 40   if (iquot-idiv) 60,60,50                                          fac  17
- 50   continue                                                          fac  18
- 60   if (npart-1) 80,80,70                                             fac  19
- 70   if=if+1                                                           fac  20
-      ifact(if)=npart                                                   fac  21
- 80   nfact=if                                                          fac  22
-      return                                                            fac  23
-      end                                                               fac  24-
-      subroutine fixrl (data,n,nrem,isign,iform)                        fix   1
-c     for iform = 0, convert the transform of a doubled-up real array,  fix   2
-c     considered complex, into its true transform.  supply only the     fix   3
-c     first half of the complex transform, as the second half has       fix   4
-c     conjugate symmetry.  for iform = -1, convert the first half       fix   5
-c     of the true transform into the transform of a doubled-up real     fix   6
-c     array.  n must be even.                                           fix   7
-c     using complex notation and subscripts starting at zero, the       fix   8
-c     transformation is--                                               fix   9
-c     dimension data(n,nrem)                                            fix  10
-c     zstp = exp(isign*2*pi*i/n)                                        fix  11
-c     do 10 i2=0,nrem-1                                                 fix  12
-c     data(0,i2) = conj(data(0,i2))*(1+i)                               fix  13
-c     do 10 i1=1,n/4                                                    fix  14
-c     z = (1+(2*iform+1)*i*zstp**i1)/2                                  fix  15
-c     i1cnj = n/2-i1                                                    fix  16
-c     dif = data(i1,i2)-conj(data(i1cnj,i2))                            fix  17
-c     temp = z*dif                                                      fix  18
-c     data(i1,i2) = (data(i1,i2)-temp)*(1-iform)                        fix  19
-c 10  data(i1cnj,i2) = (data(i1cnj,i2)+conj(temp))*(1-iform)            fix  20
-c     if i1=i1cnj, the calculation for that value collapses into        fix  21
-c     a simple conjugation of data(i1,i2).                              fix  22
-      dimension data(*)                                                 fix  23
-      twopi=6.283185307*float(isign)                                    fix  24
-      ip0=2                                                             fix  25
-      ip1=ip0*(n/2)                                                     fix  26
-      ip2=ip1*nrem                                                      fix  27
-      if (iform) 10,70,70                                               fix  28
-c     pack the real input values (two per column)                       fix  29
- 10   j1=ip1+1                                                          fix  30
-      data(2)=data(j1)                                                  fix  31
-      if (nrem-1) 70,70,20                                              fix  32
- 20   j1=j1+ip0                                                         fix  33
-      i2min=ip1+1                                                       fix  34
-      do 60 i2=i2min,ip2,ip1                                            fix  35
-      data(i2)=data(j1)                                                 fix  36
-      j1=j1+ip0                                                         fix  37
-      if (n-2) 50,50,30                                                 fix  38
- 30   i1min=i2+ip0                                                      fix  39
-      i1max=i2+ip1-ip0                                                  fix  40
-      do 40 i1=i1min,i1max,ip0                                          fix  41
-      data(i1)=data(j1)                                                 fix  42
-      data(i1+1)=data(j1+1)                                             fix  43
- 40   j1=j1+ip0                                                         fix  44
- 50   data(i2+1)=data(j1)                                               fix  45
- 60   j1=j1+ip0                                                         fix  46
- 70   do 80 i2=1,ip2,ip1                                                fix  47
-      tempr=data(i2)                                                    fix  48
-      data(i2)=data(i2)+data(i2+1)                                      fix  49
- 80   data(i2+1)=tempr-data(i2+1)                                       fix  50
-      if (n-2) 200,200,90                                               fix  51
- 90   theta=twopi/float(n)                                              fix  52
-      sinth=sin(theta/2.)                                               fix  53
-      zstpr=-2.*sinth*sinth                                             fix  54
-      zstpi=sin(theta)                                                  fix  55
-      zr=(1.-zstpi)/2.                                                  fix  56
-      zi=(1.+zstpr)/2.                                                  fix  57
-      if (iform) 100,110,110                                            fix  58
- 100  zr=1.-zr                                                          fix  59
-      zi=-zi                                                            fix  60
- 110  i1min=ip0+1                                                       fix  61
-      i1max=ip0*(n/4)+1                                                 fix  62
-      do 190 i1=i1min,i1max,ip0                                         fix  63
-      do 180 i2=i1,ip2,ip1                                              fix  64
-      i2cnj=ip0*(n/2+1)-2*i1+i2                                         fix  65
-      if (i2-i2cnj) 150,120,120                                         fix  66
- 120  if (isign*(2*iform+1)) 130,140,140                                fix  67
- 130  data(i2+1)=-data(i2+1)                                            fix  68
- 140  if (iform) 170,180,180                                            fix  69
- 150  difr=data(i2)-data(i2cnj)                                         fix  70
-      difi=data(i2+1)+data(i2cnj+1)                                     fix  71
-      tempr=difr*zr-difi*zi                                             fix  72
-      tempi=difr*zi+difi*zr                                             fix  73
-      data(i2)=data(i2)-tempr                                           fix  74
-      data(i2+1)=data(i2+1)-tempi                                       fix  75
-      data(i2cnj)=data(i2cnj)+tempr                                     fix  76
-      data(i2cnj+1)=data(i2cnj+1)-tempi                                 fix  77
-      if (iform) 160,180,180                                            fix  78
- 160  data(i2cnj)=data(i2cnj)+data(i2cnj)                               fix  79
-      data(i2cnj+1)=data(i2cnj+1)+data(i2cnj+1)                         fix  80
- 170  data(i2)=data(i2)+data(i2)                                        fix  81
-      data(i2+1)=data(i2+1)+data(i2+1)                                  fix  82
- 180  continue                                                          fix  83
-      tempr=zr-.5                                                       fix  84
-      zr=zstpr*tempr-zstpi*zi+zr                                        fix  85
- 190  zi=zstpr*zi+zstpi*tempr+zi                                        fix  86
-c     recursion saves time, at a slight loss in accuracy.  if available,fix  87
-c     use double precision to compute zr and zi.                        fix  88
- 200  if (iform) 270,210,210                                            fix  89
-c     unpack the real transform values (two per column)                 fix  90
- 210  i2=ip2+1                                                          fix  91
-      i1=i2                                                             fix  92
-      j1=ip0*(n/2+1)*nrem+1                                             fix  93
-      go to 250                                                         fix  94
- 220  data(j1)=data(i1)                                                 fix  95
-      data(j1+1)=data(i1+1)                                             fix  96
-      i1=i1-ip0                                                         fix  97
-      j1=j1-ip0                                                         fix  98
- 230  if (i2-i1) 220,240,240                                            fix  99
- 240  data(j1)=data(i1)                                                 fix 100
-      data(j1+1)=0.                                                     fix 101
- 250  i2=i2-ip1                                                         fix 102
-      j1=j1-ip0                                                         fix 103
-      data(j1)=data(i2+1)                                               fix 104
-      data(j1+1)=0.                                                     fix 105
-      i1=i1-ip0                                                         fix 106
-      j1=j1-ip0                                                         fix 107
-      if (i2-1) 260,260,230                                             fix 108
- 260  data(2)=0.                                                        fix 109
- 270  return                                                            fix 110
-      end                                                               fix 111-
-      subroutine goert(data,nprev,iprod,ifact,irem,work,wminr,wmini,    goe   1
-     $ rootr,rooti)                                                     goe   2
-c     phase-shifted fourier transform of length ifact by the goertzel   goe   3
-c     algorithm (4).  ifact must be odd and at least 5.  further speed  goe   4
-c     is gained by computing two transform values at the same time.     goe   5
-c     dimension data(nprev,iprod,ifact,irem)                            goe   6
-c     data(i1,1,j3,i5) = sum(data(i1,1,i3,i5) * w**(i3-1)), summed      goe   7
-c     over i3 = 1 to ifact for all i1 from 1 to nprev, j3 from 1 to     goe   8
-c     ifact and i5 from 1 to irem.                                      goe   9
-c     w = wmin * exp(isign*2*pi*i*(j3-1)/ifact).                        goe  10
-      dimension data(*), work(*)                                        goe  11
-      ip0=2                                                             goe  12
-      ip1=ip0*nprev                                                     goe  13
-      ip2=ip1*iprod                                                     goe  14
-      ip3=ip2*ifact                                                     goe  15
-      ip5=ip3*irem                                                      goe  16
-      if (wmini) 10,40,10                                               goe  17
-c     apply the phase shift factors                                     goe  18
- 10   wr=wminr                                                          goe  19
-      wi=wmini                                                          goe  20
-      i3min=1+ip2                                                       goe  21
-      do 30 i3=i3min,ip3,ip2                                            goe  22
-      i1max=i3+ip1-ip0                                                  goe  23
-      do 20 i1=i3,i1max,ip0                                             goe  24
-      do 20 i5=i1,ip5,ip3                                               goe  25
-      tempr=data(i5)                                                    goe  26
-      data(i5)=wr*tempr-wi*data(i5+1)                                   goe  27
- 20   data(i5+1)=wr*data(i5+1)+wi*tempr                                 goe  28
-      tempr=wr                                                          goe  29
-      wr=wminr*tempr-wmini*wi                                           goe  30
- 30   wi=wminr*wi+wmini*tempr                                           goe  31
- 40   do 90 i1=1,ip1,ip0                                                goe  32
-      do 90 i5=i1,ip5,ip3                                               goe  33
-c     straight summation for the first term                             goe  34
-      sumr=0.                                                           goe  35
-      sumi=0.                                                           goe  36
-      i3max=i5+ip3-ip2                                                  goe  37
-      do 50 i3=i5,i3max,ip2                                             goe  38
-      sumr=sumr+data(i3)                                                goe  39
- 50   sumi=sumi+data(i3+1)                                              goe  40
-      work(1)=sumr                                                      goe  41
-      work(2)=sumi                                                      goe  42
-      wr=rootr+1.                                                       goe  43
-      wi=rooti                                                          goe  44
-      iwmin=1+ip0                                                       goe  45
-      iwmax=ip0*((ifact+1)/2)-1                                         goe  46
-      do 80 iwork=iwmin,iwmax,ip0                                       goe  47
-      twowr=wr+wr                                                       goe  48
-      i3=i3max                                                          goe  49
-      oldsr=0.                                                          goe  50
-      oldsi=0.                                                          goe  51
-      sumr=data(i3)                                                     goe  52
-      sumi=data(i3+1)                                                   goe  53
-      i3=i3-ip2                                                         goe  54
- 60   tempr=sumr                                                        goe  55
-      tempi=sumi                                                        goe  56
-      sumr=twowr*sumr-oldsr+data(i3)                                    goe  57
-      sumi=twowr*sumi-oldsi+data(i3+1)                                  goe  58
-      oldsr=tempr                                                       goe  59
-      oldsi=tempi                                                       goe  60
-      i3=i3-ip2                                                         goe  61
-      if (i3-i5) 70,70,60                                               goe  62
-c     in a fourier transform the w corresponding to the point at k      goe  63
-c     is the conjugate of that at ifact-k (that is, exp(twopi*i*        goe  64
-c     k/ifact) = conj(exp(twopi*i*(ifact-k)/ifact))).  since the        goe  65
-c     main loop of goertzels algorithm is indifferent to the imaginary  goe  66
-c     part of w, it need be supplied only at the end.                   goe  67
- 70   tempr=-wi*sumi                                                    goe  68
-      tempi=wi*sumr                                                     goe  69
-      sumr=wr*sumr-oldsr+data(i3)                                       goe  70
-      sumi=wr*sumi-oldsi+data(i3+1)                                     goe  71
-      work(iwork)=sumr+tempr                                            goe  72
-      work(iwork+1)=sumi+tempi                                          goe  73
-      iwcnj=ip0*(ifact+1)-iwork                                         goe  74
-      work(iwcnj)=sumr-tempr                                            goe  75
-      work(iwcnj+1)=sumi-tempi                                          goe  76
-c     singleton's recursion, for accuracy and speed (5).                goe  77
-      tempr=wr                                                          goe  78
-      wr=wr*rootr-wi*rooti+wr                                           goe  79
- 80   wi=tempr*rooti+wi*rootr+wi                                        goe  80
-      iwork=1                                                           goe  81
-      do 90 i3=i5,i3max,ip2                                             goe  82
-      data(i3)=work(iwork)                                              goe  83
-      data(i3+1)=work(iwork+1)                                          goe  84
- 90   iwork=iwork+ip0                                                   goe  85
-      return                                                            goe  86
-      end                                                               goe  87-
-      subroutine smfac (ifact,nfact,isym,ifsym,nfsym,icent,ifcnt,nfcnt) smf   1
-c     rearrange the prime factors of n into a square and a non-         smf   2
-c     square.  n = isym*icent*isym, where icent is square-free.         smf   3
-c     isym = ifsym(1)*...*ifsym(nfsym), each a prime factor.            smf   4
-c     icent = ifcnt(1)*...*ifcnt(nfcnt), each a prime factor.           smf   5
-c     for example, n = 1960 = 14*10*14.  then isym = 14, icent = 10,    smf   6
-c     nfsym = 2, nfcnt = 2, nfact = 6, ifsym(ifs) = 2, 7, ifcnt(ifc) =  smf   7
-c     2, 5 and ifact(if) = 2, 7, 2, 5, 7, 2.                            smf   8
-      dimension ifsym(1), ifcnt(1), ifact(1)                            smf   9
-      isym=1                                                            smf  10
-      icent=1                                                           smf  11
-      ifs=0                                                             smf  12
-      ifc=0                                                             smf  13
-      if=1                                                              smf  14
- 10   if (if-nfact) 20,40,50                                            smf  15
- 20   if (ifact(if)-ifact(if+1)) 40,30,40                               smf  16
- 30   ifs=ifs+1                                                         smf  17
-      ifsym(ifs)=ifact(if)                                              smf  18
-      isym=ifact(if)*isym                                               smf  19
-      if=if+2                                                           smf  20
-      go to 10                                                          smf  21
- 40   ifc=ifc+1                                                         smf  22
-      ifcnt(ifc)=ifact(if)                                              smf  23
-      icent=ifact(if)*icent                                             smf  24
-      if=if+1                                                           smf  25
-      go to 10                                                          smf  26
- 50   nfsym=ifs                                                         smf  27
-      nfcnt=ifc                                                         smf  28
-      nfsm2=2*nfsym                                                     smf  29
-      nfact=2*nfsym+nfcnt                                               smf  30
-      if (nfcnt) 80,80,60                                               smf  31
- 60   nfsm2=nfsm2+1                                                     smf  32
-      ifsym(nfsym+1)=icent                                              smf  33
-      do 70 ifc=1,nfcnt                                                 smf  34
-      if=nfsym+ifc                                                      smf  35
- 70   ifact(if)=ifcnt(ifc)                                              smf  36
- 80   if (nfsym) 110,110,90                                             smf  37
- 90   do 100 ifs=1,nfsym                                                smf  38
-      ifscj=nfsm2+1-ifs                                                 smf  39
-      ifsym(ifscj)=ifsym(ifs)                                           smf  40
-      ifact(ifs)=ifsym(ifs)                                             smf  41
-      ifcnj=nfact+1-ifs                                                 smf  42
- 100  ifact(ifcnj)=ifsym(ifs)                                           smf  43
- 110  nfsym=nfsm2                                                       smf  44
-      return                                                            smf  45
-      end                                                               smf  46-
-      subroutine symrv (data,nprev,n,nrem,ifact,nfact)                  sym   1
-c     shuffle the data array by reversing the digits of one index.      sym   2
-c     dimension data(nprev,n,nrem)                                      sym   3
-c     replace data(i1,i2,i3) by data(i1,i2rev,i3) for all i1 from 1 to  sym   4
-c     nprev, i2 from 1 to n and i3 from 1 to nrem.  i2rev-1 is the      sym   5
-c     integer whose digit representation in the multi-radix notation    sym   6
-c     of factors ifact(if) is the reverse of the representation of i2-1.sym   7
-c     for example, if all ifact(if) = 2, i2-1 = 11001, i2rev-1 = 10011. sym   8
-c     the factors must be symmetrically arranged, i.e., ifact(if) =     sym   9
-c     ifact(nfact+1-if).                                                sym  10
-      dimension data(*), ifact(1)                                       sym  11
-      if (nfact-1) 80,80,10                                             sym  12
- 10   ip0=2                                                             sym  13
-      ip1=ip0*nprev                                                     sym  14
-      ip4=ip1*n                                                         sym  15
-      ip5=ip4*nrem                                                      sym  16
-      i4rev=1                                                           sym  17
-      do 70 i4=1,ip4,ip1                                                sym  18
-      if (i4-i4rev) 20,40,40                                            sym  19
- 20   i1max=i4+ip1-ip0                                                  sym  20
-      do 30 i1=i4,i1max,ip0                                             sym  21
-      do 30 i5=i1,ip5,ip4                                               sym  22
-      i5rev=i4rev+i5-i4                                                 sym  23
-      tempr=data(i5)
-      tempi=data(i5+1)                                                  sym  25
-      data(i5)=data(i5rev)                                              sym  26
-      data(i5+1)=data(i5rev+1)                                          sym  27
-      data(i5rev)=tempr                                                 sym  28
- 30   data(i5rev+1)=tempi                                               sym  29
- 40   ip3=ip4                                                           sym  30
-      do 60 if=1,nfact                                                  sym  31
-      ip2=ip3/ifact(if)                                                 sym  32
-      i4rev=i4rev+ip2                                                   sym  33
-      if (i4rev-ip3) 70,70,50                                           sym  34
- 50   i4rev=i4rev-ip3                                                   sym  35
- 60   ip3=ip2                                                           sym  36
- 70   continue                                                          sym  37
- 80   return                                                            sym  38
-      end                                                               sym  39-
diff -r 405d8f4fa05f -r e7295294f654 elastic3d.f90
--- a/elastic3d.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,3421 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-MODULE elastic3d
-
-  USE types
-  USE fourier
-
-  IMPLICIT NONE
-
-#include "include.f90"
-
-  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
-  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
-  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
-  REAL*8, PRIVATE, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
-    
-  INTERFACE OPERATOR (.times.)
-     MODULE PROCEDURE tensorscalarprod
-  END INTERFACE
-
-  INTERFACE OPERATOR (.minus.)
-     MODULE PROCEDURE tensordiff
-  END INTERFACE
-
-  INTERFACE OPERATOR (.plus.)
-     MODULE PROCEDURE tensorplus
-  END INTERFACE
-
-  INTERFACE OPERATOR (.sdyad.)
-     MODULE PROCEDURE tensorsymmetricdyadprod
-  END INTERFACE
-
-  INTERFACE OPERATOR (.tdot.)
-     MODULE PROCEDURE tensorvectordotprod
-  END INTERFACE
-
-CONTAINS
-
-  !------------------------------------------------------------
-  !> function SIGN
-  !! returns the sign of the input -1 for negtive, 0 for zero
-  !! and +1 for positive arguments.
-  !------------------------------------------------------------
-  REAL*8 FUNCTION sign(x)
-    REAL*8, INTENT(IN) :: x
-
-    IF (x .gt. 0._8) THEN
-       sign=1._8
-    ELSE
-       IF (x .lt. 0._8) THEN
-          sign=-1._8
-       ELSE
-          sign=0._8
-       END IF
-    END IF
-  END FUNCTION sign
-
-  !------------------------------------------------------------
-  !> function fix
-  !! returns the closest integer scalar
-  !
-  ! sylvain barbot (08/25/07) - original form
-  !------------------------------------------------------------
-  INTEGER FUNCTION fix(number)
-    REAL*8, INTENT(IN) :: number
-
-    INTEGER :: c,f
-    f=FLOOR(number)
-    c=CEILING(number)
-
-    IF ((number-f) .gt. 0.5_8) THEN
-       fix=c
-    ELSE
-       fix=f
-    END IF
-
-  END FUNCTION fix
-
-  !------------------------------------------------------------
-  !> function SINH
-  !! computes the hyperbolic sine
-  !------------------------------------------------------------
-  REAL*8 FUNCTION sinh(x)
-    REAL*8, INTENT(IN) :: x
-
-    IF (abs(x) .GT. 85._8) THEN
-       sinh=sign(x)*exp(85._8)/2._8
-    ELSE
-       sinh=(exp(x)-exp(-x))/2._8
-    END IF
-  END FUNCTION sinh
-
-  !------------------------------------------------------------
-  !> function ASINH
-  !! computes the inverse hyperbolic sine
-  !------------------------------------------------------------
-  REAL*8 FUNCTION asinh(x)
-    REAL*8, INTENT(IN) :: x
-    asinh=log(x+sqrt(x*x+1))
-  END FUNCTION asinh
-
-  !-----------------------------------------------------------------
-  !> subroutine Neighbor
-  !! computes the indices of neighbor samples (l points away)
-  !! bracketing the current samples location i1,i2,i3 and
-  !! assuming periodic boundary condition.
-  !!
-  !!           i1m < i1 < i1p
-  !!           i2m < i2 < i2p
-  !!           i3m < i3 < i3p
-  !-----------------------------------------------------------------
-  SUBROUTINE neighbor(i1,i2,i3,sx1,sx2,sx3,l,i1m,i1p,i2m,i2p,i3m,i3p)
-    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3,l
-    INTEGER, INTENT(OUT) :: i1m,i1p,i2m,i2p,i3m,i3p
-
-    i1m=mod(sx1+i1-1-l,sx1)+1
-    i1p=mod(i1-1+l,sx1)+1
-    i2m=mod(sx2+i2-1-l,sx2)+1
-    i2p=mod(i2-1+l,sx2)+1
-    i3m=mod(sx3+i3-1-l,sx3)+1
-    i3p=mod(i3-1+l,sx3)+1
-
-  END SUBROUTINE neighbor
-
-  !---------------------------------------------------------------
-  !> subroutine IsotropicStressStrain
-  !! computes in place the isotropic stress tensor from a given
-  !! strain tensor using Hooke's law stress-strain relationship.
-  !
-  ! sylvain barbot (10/14/07) - original form
-  !---------------------------------------------------------------
-  SUBROUTINE isotropicstressstrain(t,lambda,mu)
-    TYPE(TENSOR), INTENT(INOUT) :: t
-    REAL*8, INTENT(IN) :: lambda, mu
-
-    REAL*8 :: epskk
-
-    epskk=tensortrace(t)
-
-    t = REAL(2._8*mu) .times. t
-    t%s11=t%s11+lambda*epskk
-    t%s22=t%s22+lambda*epskk
-    t%s33=t%s33+lambda*epskk
-
-  END SUBROUTINE isotropicstressstrain
-
-  !------------------------------------------------------------
-  !> function TensorDiff
-  !! computes the difference between two tensors: t=t1-t2
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  TYPE(TENSOR) FUNCTION tensordiff(t1,t2)
-    TYPE(TENSOR), INTENT(IN) :: t1,t2
-
-    tensordiff=TENSOR(t1%s11-t2%s11, & ! 11
-                      t1%s12-t2%s12, & ! 12
-                      t1%s13-t2%s13, & ! 13
-                      t1%s22-t2%s22, & ! 22
-                      t1%s23-t2%s23, & ! 23
-                      t1%s33-t2%s33)   ! 33
-
-  END FUNCTION tensordiff
-
-  !------------------------------------------------------------
-  !> function TensorPlus
-  !! computes the sum of two tensors: t=t1-t2
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  TYPE(TENSOR) FUNCTION tensorplus(t1,t2)
-    TYPE(TENSOR), INTENT(IN) :: t1,t2
-
-    tensorplus=TENSOR(t1%s11+t2%s11, & ! 11
-                      t1%s12+t2%s12, & ! 12
-                      t1%s13+t2%s13, & ! 13
-                      t1%s22+t2%s22, & ! 22
-                      t1%s23+t2%s23, & ! 23
-                      t1%s33+t2%s33)   ! 33
-
-  END FUNCTION tensorplus
-
-  !------------------------------------------------------------
-  !> function TensorScalarProd
-  !! multiplies a tensor with a scalar
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  TYPE(TENSOR) FUNCTION tensorscalarprod(scalar,t)
-    TYPE(TENSOR), INTENT(IN) :: t
-    REAL*4, INTENT(IN) :: scalar
-
-    tensorscalarprod=TENSOR(scalar*t%s11, & ! 11
-                            scalar*t%s12, & ! 12
-                            scalar*t%s13, & ! 13
-                            scalar*t%s22, & ! 22
-                            scalar*t%s23, & ! 23
-                            scalar*t%s33)   ! 33
-
-  END FUNCTION tensorscalarprod
-
-  !------------------------------------------------------------
-  !> function TensorSymmetricDyadProd
-  !! computes the dyadic product of two vectors to obtain a
-  !! symmetric second order tensor
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  TYPE(TENSOR) FUNCTION tensorsymmetricdyadprod(a,b)
-    REAL*8, DIMENSION(3), INTENT(IN) :: a,b
-
-    tensorsymmetricdyadprod=TENSOR( &
-          a(1)*b(1),                 & ! 11
-         (a(1)*b(2)+a(2)*b(1))/2._8, & ! 12
-         (a(1)*b(3)+a(3)*b(1))/2._8, & ! 13
-          a(2)*b(2),                 & ! 22
-         (a(2)*b(3)+a(3)*b(2))/2._8, & ! 23
-          a(3)*b(3)                  & ! 33
-          )
-
-  END FUNCTION tensorsymmetricdyadprod
-
-  !------------------------------------------------------------
-  !> function TensorVectorDotProd
-  !! compute the dot product T.v where T is a second-order
-  !! tensor and v is a vector.
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  FUNCTION tensorvectordotprod(t,v)
-    TYPE(TENSOR), INTENT(IN) :: t
-    REAL*8, DIMENSION(3), INTENT(IN) :: v
-    REAL*8, DIMENSION(3) :: tensorvectordotprod
-
-    tensorvectordotprod= &
-         (/ t%s11*v(1)+t%s12*v(2)+t%s13*v(3), &
-            t%s12*v(1)+t%s22*v(2)+t%s23*v(3), &
-            t%s13*v(1)+t%s23*v(2)+t%s33*v(3) /)
-
-  END FUNCTION tensorvectordotprod
-
-  !------------------------------------------------------------
-  !> function TensorVectorDotProd
-  !! compute the dot product T.v where T is a second-order
-  !! tensor and v is a vector.
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  FUNCTION tensordeviatoric(t)
-    TYPE(TENSOR), INTENT(IN) :: t
-    TYPE(TENSOR) :: tensordeviatoric
-
-    REAL*4 :: diag
-
-    diag=REAL(tensortrace(t)/3._8)
-    
-    tensordeviatoric%s11=t%s11-diag
-    tensordeviatoric%s12=t%s12
-    tensordeviatoric%s13=t%s13
-    tensordeviatoric%s22=t%s22-diag
-    tensordeviatoric%s23=t%s23
-    tensordeviatoric%s33=t%s33-diag
-
-  END FUNCTION tensordeviatoric
-
-  !------------------------------------------------------------
-  !> function TensorTrace
-  !! computes the trace of a second order tensor
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensortrace(t)
-    TYPE(TENSOR), INTENT(IN) :: t
-
-    tensortrace=t%s11+t%s22+t%s33
-
-  END FUNCTION tensortrace
-
-  !------------------------------------------------------------
-  !> function TensorNorm
-  !! computes the Frobenius norm of a second order tensor
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensornorm(t)
-    TYPE(TENSOR), INTENT(IN) :: t
-
-    tensornorm=SQRT(( &
-         t%s11**2+2._8*t%s12**2+2._8*t%s13**2+ &
-         t%s22**2+2._8*t%s23**2+ &
-         t%s33**2)/2._8)
-
-  END FUNCTION tensornorm
-
-  !------------------------------------------------------------
-  !> function TensorDecomposition
-  !! writes a tensor t as the product of a norm and a direction
-  !!
-  !!         t = gamma * R
-  !!
-  !! where gamma is a scalar, the norm of t, and R is a unitary
-  !! tensor. t is assumed to be a deviatoric tensor.
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  SUBROUTINE tensordecomposition(t,gamma,R)
-    TYPE(TENSOR), INTENT(IN) :: t
-    TYPE(TENSOR), INTENT(OUT) :: R
-    REAL*8, INTENT(OUT) :: gamma
-    
-    gamma=tensornorm(t)
-
-    R%s11=t%s11/gamma
-    R%s12=t%s12/gamma
-    R%s13=t%s13/gamma
-    R%s22=t%s22/gamma
-    R%s23=t%s23/gamma
-    R%s33=t%s33/gamma
-
-  END SUBROUTINE tensordecomposition
-
-
-  !------------------------------------------------------------
-  !> function TensorForbeniusNorm
-  !! computes the Frobenius norm of a second order tensor
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensorfrobeniusnorm(t)
-    TYPE(TENSOR), INTENT(IN) :: t
-
-    tensorfrobeniusnorm=SQRT( &
-         t%s11**2+2._8*t%s12**2+2._8*t%s13**2+ &
-         t%s22**2+2._8*t%s23**2+ &
-         t%s33**2)
-
-  END FUNCTION tensorfrobeniusnorm
-
-  !------------------------------------------------------------
-  !> function VectorFieldNormMax
-  !! computes the maximum value of the norm of a vector field
-  !------------------------------------------------------------
-  SUBROUTINE vectorfieldnormmax(v1,v2,v3,sx1,sx2,sx3,maximum,location)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: v1,v2,v3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v1,v2,v3
-#endif
-    REAL*8, INTENT(OUT) :: maximum
-    INTEGER, INTENT(OUT), DIMENSION(3) :: location
-    
-    INTEGER :: i1,i2,i3
-    REAL*8 :: norm
-
-    maximum=-1._8
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1
-             norm=SQRT(v1(i1,i2,i3)**2+v2(i1,i2,i3)**2+v3(i1,i2,i3)**2)
-             IF (norm .GT. maximum) THEN
-                maximum=norm
-                location=(/ i1,i2,i3 /)
-             END IF
-          END DO
-       END DO
-    END DO
-    
-  END SUBROUTINE vectorfieldnormmax
-
-  !------------------------------------------------------------
-  !> function TensorMean
-  !! computesthe mean of the norm of a tensor field
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensormean(t)
-    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
-    
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    sx1=SIZE(t,1)
-    sx2=SIZE(t,2)
-    sx3=SIZE(t,3)
-
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1
-             tensormean=tensormean+tensornorm(t(i1,i2,i3))
-          END DO
-       END DO
-    END DO
-    tensormean=tensormean/DBLE(sx1*sx2*sx3)
-    
-  END FUNCTION tensormean
-
-  !------------------------------------------------------------
-  !> function TensorAmplitude
-  !! computes the integral of the norm of a tensor field
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensoramplitude(t,dx1,dx2,dx3)
-    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    sx1=SIZE(t,1)
-    sx2=SIZE(t,2)
-    sx3=SIZE(t,3)
-
-    tensoramplitude=0._8
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1
-             tensoramplitude=tensoramplitude &
-                  +tensornorm(t(i1,i2,i3))
-          END DO
-       END DO
-    END DO
-    tensoramplitude=tensoramplitude*DBLE(dx1*dx2*dx3)
-
-  END FUNCTION tensoramplitude
-
-  !------------------------------------------------------------
-  !> function TensorMeanTrace
-  !! computesthe mean of the norm of a tensor field
-  !------------------------------------------------------------
-  REAL*8 FUNCTION tensormeantrace(t)
-    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
-    
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    sx1=SIZE(t,1)
-    sx2=SIZE(t,2)
-    sx3=SIZE(t,3)
-
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1
-             tensormeantrace= &
-                  tensormeantrace+tensortrace(t(i1,i2,i3))
-          END DO
-       END DO
-    END DO
-    tensormeantrace=tensormeantrace/DBLE(sx1*sx2*sx3)
-    
-  END FUNCTION tensormeantrace
-
-  !------------------------------------------------------------
-  !> sinc function
-  !! computes sin(pi*x)/(pi*x)
-  !
-  ! sylvain barbot (04-14-07) - original form
-  !------------------------------------------------------------
-  FUNCTION sinc(x)
-    REAL*8 :: sinc
-    REAL*8, INTENT(IN) :: x
-    IF (x /= 0) THEN
-       sinc=sin(pi*x)/(pi*x)
-    ELSE
-       sinc=1._8
-    END IF
-  END FUNCTION sinc
-  
-  !-------------------------------------------------------------------------
-  !> function gauss computes the normalized gaussian function
-  !
-  ! Sylvain Barbot (06-29-07)
-  !-------------------------------------------------------------------------
-  FUNCTION gauss(x,sigma)
-    REAL*8 :: gauss
-    REAL*8, INTENT(IN) :: x,sigma
-    
-    gauss=exp(-0.5_8*(x/sigma)**2)/sqrt(pi2)/sigma
-  END FUNCTION gauss
-  
-  !-------------------------------------------------------------------------
-  !> function gaussp computes the normalized gaussian derivative
-  !
-  ! Sylvain Barbot (06-29-07)
-  !-------------------------------------------------------------------------
-  FUNCTION gaussp(x,sigma)
-    REAL*8 :: gaussp
-    REAL*8, INTENT(IN) :: x,sigma
-    
-    gaussp=-x*exp(-0.5_8*(x/sigma)**2)/sqrt(pi2)/sigma**3
-  END FUNCTION gaussp
-
-  !-------------------------------------------------------------------------
-  !> function omega computes raised-cosine taper in the space domain
-  !
-  ! Sylvain Barbot (06-29-07)
-  !-------------------------------------------------------------------------
-  FUNCTION omega(x,beta)
-    REAL*8 :: omega
-    REAL*8, INTENT(IN) :: x,beta
-    
-    IF (abs(x) .le. (1._8-2._8*beta)/(1._8-beta)/2._8) THEN
-       omega=1._8
-    ELSE
-       IF (abs(x) .lt. 1._8/(1-beta)/2._8) THEN
-          omega=cos(pi*((1._8-beta)*abs(x)-0.5_8+beta)/2._8/beta)**2
-       ELSE
-          omega=0._8
-       END IF
-    END IF
-  END FUNCTION omega
-
-  !-------------------------------------------------------------------------
-  !> function omegap computes raised-cosine taper derivative 
-  !! in the space domain
-  !
-  ! Sylvain Barbot (06-29-07)
-  !-------------------------------------------------------------------------
-  FUNCTION omegap(x,beta)
-    REAL*8 :: omegap
-    REAL*8, INTENT(IN) :: x,beta
-    
-    omegap=0
-    IF (abs(x) .gt. (1._8-2._8*beta)/(1._8-beta)/2._8) THEN
-       IF (abs(x) .lt. 1._8/(1-beta)/2._8) THEN
-          omegap=-DSIGN(1._8,x)*pi*(1._8-beta)/2._8/beta* &
-               sin(pi*((1._8-beta)*abs(x)-0.5_8+beta)/beta)
-       END IF
-    END IF
-  END FUNCTION omegap
-  
-  !-------------------------------------------------------------------------
-  !> tapered step function (raised-cosine) of unit area in the Fourier domain
-  !!
-  !! INPUT
-  !! @param k        wavenumber
-  !! @param beta     roll-off parameter 0<beta<0.5
-  !!                 no smoothing for beta close to 0
-  !!                 string smoothing for beta close to 0.5
-  !
-  ! sylvain barbot (04-14-07) - original form
-  !-------------------------------------------------------------------------
-  FUNCTION omegak(k,beta)
-    REAL*8 :: omegak
-    REAL*8, INTENT(IN) :: k, beta
-    REAL*8 :: gamma,denom,om1,om2
-    
-    gamma=(1._8-beta)
-    denom=(gamma-(4._8*beta**2._8/gamma)*k**2._8)*2._8
-    om1=sinc(k/gamma)
-    om2=(1._8-2._8*beta)*sinc(((1._8-2._8*beta)/gamma)*k)
-    omegak=(om1+om2)/denom
-
-  END FUNCTION omegak
-
-  !----------------------------------------------------------------
-  !> subroutine TensorStructure
-  !! constructs a vertically-stratified tensor field.
-  !! The structure is defined by its interfaces: changes can be
-  !! gradual or discontinuous.
-  !
-  ! sylvain barbot (10/25/08) - original form
-  !----------------------------------------------------------------
-  SUBROUTINE tensorstructure(vstruct,layers,dx3)
-    TYPE(TENSOR_LAYER_STRUCT), INTENT(IN), DIMENSION(:) :: layers
-    TYPE(TENSOR_LAYER_STRUCT), INTENT(OUT), DIMENSION(:) :: vstruct
-    REAL*8, INTENT(IN) :: dx3
-
-    INTEGER :: nv,k,i3s,i3e=1,i3,sx3
-    REAL*8 :: z,z0,z1
-    TYPE(TENSOR) :: t0,t1,t
-         
-    nv =SIZE(layers,1)
-    sx3=SIZE(vstruct,1)
-
-    IF (0 .ge. nv) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("invalid tensor structure. exiting.")')
-       STOP 1
-    END IF
-
-    ! initialization
-    vstruct(:)%z=0      ! depth is not used
-    vstruct(:)%t=tensor(0._4,0._4,0._4,0._4,0._4,0._4) ! default
-
-    z0=fix(layers(1)%z/dx3)*dx3
-    DO k=1,nv
-       ! project model on multiples of sampling size 'dx3'
-       ! to avoid aliasing problems
-       z1=fix(layers(k)%z/dx3)*dx3
-
-       IF (z1 .lt. z0) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,'("invalid mechanical structure.")')
-          WRITE (0,'("depths must be increasing. exiting.")')
-          STOP 1
-       END IF
-
-       IF (z1 .eq. z0) THEN
-          ! discontinuous interface in the elastic structure
-          z0=z1
-          
-          t1=layers(k)%t
-          
-          i3e=fix(z1/dx3+1)
-       ELSE
-          ! interpolate linearly between current and previous value
-
-          t1=layers(k)%t
-
-          i3s=fix(z0/dx3)+1
-          i3e=MIN(fix(z1/dx3+1),sx3)
-          DO i3=i3s,i3e
-             z=(i3-1._8)*dx3
-
-             t=REAL(1._8/(z1-z0)) .times. &
-                  ((REAL(z-z0) .times. t1) .plus. (REAL(z1-z) .times. t0))
-             
-             vstruct(i3)%t=t
- 
-         END DO
-       END IF
-
-       z0=z1
-       t0=t1
-
-    END DO
-
-    ! downward-continue the last layer
-    IF (fix(z1/dx3) .lt. sx3-1) THEN
-       vstruct(i3e:sx3)%t=t1
-    END IF
-
-  END SUBROUTINE tensorstructure
-
-
-  !----------------------------------------------------------------
-  !> subroutine ViscoElasticStructure
-  !! constructs a vertically-stratified viscoelastic structure.
-  !! The structure is defined by its interfaces: changes can be
-  !! gradual or discontinuous.
-  !!
-  !! EXAMPLE INPUTS:
-  !!
-  !! 1- elastic plate over linear viscous half-space
-  !!    1
-  !!    1 1.0 1.0 1.0
-  !!
-  !! 2- elastic plate over powerlaw viscous half-space (n=3)
-  !!    1
-  !!    1 1.0 1.0 3.0
-  !!
-  !! 3- elastic plate over viscous half-space with depth-dependent
-  !!    viscosity
-  !!    2
-  !!    1 01.0 1.0 1.0
-  !!    2 10.0 6.0 1.0
-  !!
-  !!    in this last example, the grid does not have to reach down
-  !!    to x3=10.
-  !!
-  !! \author sylvain barbot (08/07/07) - original form
-  !----------------------------------------------------------------
-  SUBROUTINE viscoelasticstructure(vstruct,layers,dx3)
-    TYPE(LAYER_STRUCT), INTENT(IN), DIMENSION(:) :: layers
-    TYPE(LAYER_STRUCT), INTENT(OUT), DIMENSION(:) :: vstruct
-    REAL*8, INTENT(IN) :: dx3
-
-    INTEGER :: nv,k,i3s,i3e=1,i3,sx3
-    REAL*8 :: z,z0,z1, &
-         power,power0,power1, &
-         gamma,gamma0,gamma1, &
-         friction,friction0,friction1, &
-         cohesion,cohesion0,cohesion1
-         
-
-    nv =SIZE(layers,1)
-    sx3=SIZE(vstruct,1)
-
-    IF (0 .ge. nv) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("invalid elastic structure. exiting.")')
-       STOP 1
-    END IF
-
-    ! initialization
-    vstruct(:)%z=0      ! depth is not used
-    vstruct(:)%gammadot0=0 ! default is inviscid
-    vstruct(:)%friction=0.6  ! default is friction=0.6
-    vstruct(:)%cohesion=0  ! default is no cohesion
-    vstruct(:)%stressexponent=layers(1)%stressexponent  ! default
-
-    z0=fix(layers(1)%z/dx3)*dx3
-    DO k=1,nv
-       ! project model on multiples of sampling size 'dx3'
-       ! to avoid aliasing problems
-       z1=fix(layers(k)%z/dx3)*dx3
-
-       IF (z1 .lt. z0) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,'("invalid mechanical structure. exiting.")')
-          STOP 1
-       END IF
-
-       IF (z1 .eq. z0) THEN
-          ! discontinuous interface in the elastic structure
-          z0=z1
-          gamma1=layers(k)%gammadot0
-          power1 =layers(k)%stressexponent
-          friction1=layers(k)%friction
-          cohesion1=layers(k)%cohesion
-          
-          i3e=fix(z1/dx3+1)
-       ELSE
-          ! interpolate between current and previous value
-          gamma1=layers(k)%gammadot0
-          power1 =layers(k)%stressexponent
-          friction1=layers(k)%friction
-          cohesion1=layers(k)%cohesion
-
-          i3s=fix(z0/dx3)+1
-          i3e=MIN(fix(z1/dx3+1),sx3)
-          DO i3=i3s,i3e
-             z=(i3-1._8)*dx3
-             gamma=((z-z0)*gamma1+(z1-z)*gamma0)/(z1-z0)
-             power=((z-z0)*power1+(z1-z)*power0)/(z1-z0)
-             friction=((z-z0)*friction1+(z1-z)*friction0)/(z1-z0)
-             cohesion=((z-z0)*cohesion1+(z1-z)*cohesion0)/(z1-z0)
-
-             vstruct(i3)%gammadot0=gamma
-             vstruct(i3)%stressexponent =power
-             vstruct(i3)%friction=friction
-             vstruct(i3)%cohesion=cohesion
-          END DO
-       END IF
-
-       z0=z1
-       gamma0=gamma1
-       power0=power1
-       friction0=friction1
-       cohesion0=cohesion1
-
-    END DO
-
-    ! downward-continue the last layer
-    IF (fix(z1/dx3) .lt. sx3-1) THEN
-       vstruct(i3e:sx3)%gammadot0=REAL(gamma1)
-       vstruct(i3e:sx3)%stressexponent =REAL(power1)
-       vstruct(i3e:sx3)%friction=REAL(friction1)
-       vstruct(i3e:sx3)%cohesion=REAL(cohesion1)
-    END IF
-
-  END SUBROUTINE viscoelasticstructure
-
-
-  !------------------------------------------------------------------
-  !> function OptimalFilter
-  !! load predefined Finite Impulse Response (FIR) filters of various
-  !! lengths and select the most appropriate ones based on the
-  !! computational grid size. result is filter kernels always smaller
-  !! than available computational length.
-  !! this is useful in the special cases of infinite faults where
-  !! deformation is essentially two-dimensional, despite the actual
-  !! three-dimensional computation. in the direction of symmetry,
-  !! no strain occurs and high accuracy derivative estimates are not
-  !! needed.
-  !
-  ! Sylvain Barbot (03/05/08) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
-    REAL*8, DIMENSION(16), INTENT(OUT) :: ker1,ker2,ker3
-    INTEGER, INTENT(OUT) :: len1,len2,len3
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-
-    ! load FIR differentiator filter
-    ! variables 'fir1', 'fir7', 'fir14'
-    INCLUDE 'kernel1.inc'
-    INCLUDE 'kernel7.inc'
-    INCLUDE 'kernel14bis.inc'
-
-    ! choose best differentiator kernels
-    SELECT CASE(sx1)
-    CASE (2:4)
-       ! use centered finite difference
-       len1=1
-       ker1(1)=fir1(1)
-    CASE (5:14)
-       len1=7
-       ker1(1:len1)=fir7(1:len1)
-    CASE (15:)
-       len1=1
-       ker1(1:len1)=fir1(1:len1)
-    CASE DEFAULT
-       WRITE_DEBUG_INFO
-       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
-       STOP 2
-    END SELECT
-
-    ! choose best differentiator kernels
-    SELECT CASE(sx2)
-    CASE (2:4)
-       ! use centered finite difference
-       len2=1
-       ker2(1)=fir1(1)
-    CASE (5:14)
-       len2=7
-       ker2(1:len2)=fir7(1:len2)
-    CASE (15:)
-       len2=1
-       ker2(1:len2)=fir1(1:len2)
-    CASE DEFAULT
-       WRITE_DEBUG_INFO
-       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
-       STOP 2
-    END SELECT
-
-    ! choose best differentiator kernels
-    SELECT CASE(sx3)
-    CASE (5:14)
-       len3=7
-       ker3(1:len3)=fir7(1:len3)
-    CASE (15:)
-       len3=1
-       ker3(1:len3)=fir1(1:len3)
-    CASE DEFAULT
-       WRITE_DEBUG_INFO
-       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
-       STOP 2
-    END SELECT
-
-  END SUBROUTINE optimalfilter
-
-  !-----------------------------------------------------------------
-  !> subroutine StressUpdate
-  !! computes the 3-d stress tensor sigma_ij' from the current
-  !! deformation field. Strain is the second order tensor
-  !!
-  !!  \f[ \epsilon_{ij} = \frac{1}{2} ( u_{i,j} + u_{j,i} ) \f]
-  !!
-  !! The displacement derivatives are approximated numerically by the
-  !! application of a differentiator space-domain finite impulse
-  !! response filter. Coefficients of the filter can be obtained with
-  !! the MATLAB command line
-  !!
-  !!\verbatim
-  !! firpm(14, ...
-  !!    [0 7.0e-1 8.000000e-1 8.500000e-1 9.000000e-1 1.0e+0],...
-  !!    [0 7.0e-1 5.459372e-1 3.825260e-1 2.433534e-1 0.0e+0]*pi,...
-  !!    'differentiator');
-  !!\endverbatim
-  !!
-  !! The kernel is odd and antisymmetric and only half the numbers
-  !! are stored in this code. Kernels of different sizes are readilly
-  !! available in the 'kernelX.inc' files. Stress tensor field is
-  !! obtained by application of Hooke's law
-  !!
-  !!  \f[ \sigma' = - C' : E \f]
-  !!
-  !! or in indicial notation
-  !!
-  !!
-  !!  \f[ \sigma_{ij}' = -\lambda'*\delta_{ij}*\epsilon_{kk} - 2*\mu'*\epsilon_{ij}\f]
-  !!
-  !! where C' is the heterogeneous elastic moduli tensor and lambda'
-  !! and mu' are the inhomogeneous lame parameters
-  !!
-  !!  \f[ C' = C(x) - C_0 \f]
-  !!
-  !! For isotropic materials
-  !!
-  !!  \f[ \mu'(x) = \mu(x) - \mu_0 \f]
-  !!  \f[ \lambda'(x) = \lambda(x) - \lambda_0 \f]
-  !!
-  !! Optionally, the surface traction sigma_i3 can be sampled.
-  !!
-  !! \author sylvain barbot (10/10/07) - original form
-  !!                                   - optional sample of normal stress
-  !!                        (02/12/09) - OpemMP parallel implementation
-  !-----------------------------------------------------------------
-  SUBROUTINE stressupdate(v1,v2,v3,lambda,mu,dx1,dx2,dx3,sx1,sx2,sx3,sig)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,lambda,mu
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: v1,v2,v3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v1,v2,v3
-#endif
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
-
-    TYPE(TENSOR) :: t
-    INTEGER :: i1,i2,i3,i3p,i3m,len1,len2,len3
-    REAL*8 :: px3
-    REAL*8, DIMENSION(16) :: ker1,ker2,ker3
-
-    ! load FIR differentiator filter
-    CALL optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
-    ker1=ker1/dx1; ker2=ker2/dx2; ker3=ker3/dx3;
-
-    ! no periodicity in the 3rd direction
-    ! use a simple finite difference scheme
-    DO i3=1,sx3
-
-       IF ((i3 .gt. len3) .and. (i3 .lt. (sx3-len3+1))) &
-            CYCLE
-
-       IF (i3 .eq. 1) THEN
-          ! right-centered finite difference
-          px3=dx3; i3p=2; i3m=1
-       ELSE
-          IF (i3 .eq. sx3) THEN
-             ! left-centered finite difference
-             px3=dx3; i3p=sx3; i3m=sx3-1
-          ELSE
-             ! centered finite difference
-             px3=dx3*2._8; i3m=i3-1; i3p=i3+1
-          END IF
-       END IF
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL localstrain_ani(t,i3m,i3p,px3)
-             CALL isotropicstressstrain(t,lambda,mu)
-             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. t
-          END DO
-       END DO
-    END DO
-
-    ! intermediate depth treated isotropically
-!$omp parallel do private(i1,i2,t)
-    DO i3=len3+1,sx3-len3
-       DO i2=1,sx2
-          DO i1=1,sx1
-             ! Finite Impulse Response filter
-             !CALL localstrain_fir(t)
-             CALL localstrain_fir2(t,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,v1,v2,v3,sx1,sx2,sx3)
-             CALL isotropicstressstrain(t,lambda,mu)
-             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. t
-          END DO
-       END DO
-    END DO
-!$omp end parallel do
-
-  CONTAINS
-
-    !---------------------------------------------------------------
-    !> LocalStrain_FIR2
-    !! implements a finite impulse response filter (FIR) to estimate
-    !! derivatives and strain components. the compatibility with the
-    !! OpenMP parallel execution requires that all variable be 
-    !! tractable from the calling routine.
-    !!
-    !! \author sylvain barbot (10/10/07) - original form
-    !                (03/05/08) - implements 3 filters
-    !                (02/12/09) - compatibility with OpenMP (scope)
-    !---------------------------------------------------------------
-    SUBROUTINE localstrain_fir2(e,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,v1,v2,v3,sx1,sx2,sx3)
-      TYPE(TENSOR), INTENT(OUT) :: e
-      INTEGER, INTENT(IN) :: len1,len2,len3,i1,i2,i3,sx1,sx2,sx3
-      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
-      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
-      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
-      REAL*4, INTENT(IN), DIMENSION(:,:,:) :: v1,v2,v3
-
-      INTEGER :: l,i1m,i2m,i3m,i1p,i2p,i3p
-
-      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
-
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-
-         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
-         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
-         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
-      END DO
-
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-
-         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
-         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
-         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
-      END DO
-
-      DO l=1,len3
-         ! neighbor samples in semi-infinite solid
-         i3m=i3-l
-         i3p=i3+l
-         
-         e%s13=e%s13+(v1(i1,i2,i3p)-v1(i1,i2,i3m))*ker3(l)
-         e%s23=e%s23+(v2(i1,i2,i3p)-v2(i1,i2,i3m))*ker3(l)
-         e%s33=e%s33+(v3(i1,i2,i3p)-v3(i1,i2,i3m))*ker3(l)
-      END DO
-      
-      e%s12=e%s12/2._8
-      e%s13=e%s13/2._8
-      e%s23=e%s23/2._8
-      
-    END SUBROUTINE localstrain_fir2
-
-    !---------------------------------------------------------------
-    !> LocalStrain_FIR
-    !! implements a finite impulse response filter (FIR) to estimate
-    !! derivatives and strain components.
-    !!
-    !! \author sylvain barbot (10/10/07) - original form
-    !!                        (03/05/08) - implements 3 filters
-    !---------------------------------------------------------------
-    SUBROUTINE localstrain_fir(e)
-      TYPE(TENSOR), INTENT(OUT) :: e
-
-      INTEGER :: l,i1m,i2m,i3m,i1p,i2p,i3p
-
-      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
-
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-
-         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
-         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
-         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
-      END DO
-
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-
-         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
-         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
-         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
-      END DO
-
-      DO l=1,len3
-         ! neighbor samples in semi-infinite solid
-         i3m=i3-l
-         i3p=i3+l
-
-         e%s13=e%s13+(v1(i1,i2,i3p)-v1(i1,i2,i3m))*ker3(l)
-         e%s23=e%s23+(v2(i1,i2,i3p)-v2(i1,i2,i3m))*ker3(l)
-         e%s33=e%s33+(v3(i1,i2,i3p)-v3(i1,i2,i3m))*ker3(l)
-      END DO
-
-      e%s12=e%s12/2._8
-      e%s13=e%s13/2._8
-      e%s23=e%s23/2._8
-
-    END SUBROUTINE localstrain_fir
-
-    !---------------------------------------------------------------
-    !> LocalStrain_ANI
-    !! implements a different finite impulse response filter (FIR)
-    !! in each direction (ANIsotropy) to estimate derivatives and
-    !! strain components.
-    !
-    ! sylvain barbot (10/10/07) - original form
-    !                (03/05/09) - implements 3 filters
-    !---------------------------------------------------------------
-    SUBROUTINE localstrain_ani(e,i3m,i3p,px3)
-      TYPE(TENSOR), INTENT(OUT) :: e
-      INTEGER, INTENT(IN) :: i3m, i3p
-      REAL*8, INTENT(IN) :: px3
-
-      INTEGER :: l,i1m,i2m,i1p,i2p,foo,dum
-
-      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
-
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-
-         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
-         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
-         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
-      END DO
-
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-
-         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
-         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
-         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
-      END DO
-
-      ! finite difference in the 3rd direction
-      e%s13=e%s13 + (v1(i1,i2,i3p)-v1(i1,i2,i3m))/px3
-      e%s23=e%s23 + (v2(i1,i2,i3p)-v2(i1,i2,i3m))/px3
-      e%s33=(v3(i1,i2,i3p)-v3(i1,i2,i3m))/px3
-
-      e%s12=e%s12/2._8
-      e%s13=e%s13/2._8
-      e%s23=e%s23/2._8
-
-    END SUBROUTINE localstrain_ani
-
-  END SUBROUTINE stressupdate
-
-  !-----------------------------------------------------------------
-  !> subroutine EquivalentBodyForce
-  !! computes and updates the equivalent body-force
-  !!
-  !!         f = - div.( C : E^i )
-  !!
-  !! and the equivalent surface traction
-  !!
-  !!         t = n . C : E^i
-  !!
-  !! with n = (0,0,-1). In indicial notations
-  !!
-  !!         f_i = - (C_ijkl E^i_kl),j
-  !!
-  !! and
-  !!
-  !!         t_1 = n_j C_ijkl E^i_kl
-  !!
-  !! where f is the equivalent body-force, t is the equivalent surface
-  !! traction, C is the elastic moduli tensor and E^i is the moment
-  !! density tensor tensor.
-  !!
-  !! Divergence is computed with a mixed numerical scheme including
-  !! centered finite-difference (in the vertical direction) and
-  !! finite impulse response differentiator filter for derivatives
-  !! estimates. see function 'stress' for further explanations.
-  !!
-  !! \author sylvain barbot (07/09/07) - original form
-  !!                        (10/09/07) - upgrade the finite difference scheme
-  !!                                     to a finite impulse response filter
-  !!                        (02/12/09) - OpenMP parallel implementation
-  !-----------------------------------------------------------------
-  SUBROUTINE equivalentbodyforce(sig,dx1,dx2,dx3,sx1,sx2,sx3, &
-                                 c1,c2,c3,t1,t2,t3,mask)
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(INOUT), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-    REAL*4, INTENT(INOUT), DIMENSION(sx1+2,sx2) :: t1,t2,t3
-#else
-    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2) :: t1,t2,t3
-#endif
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    REAL*4, INTENT(IN), DIMENSION(sx3), OPTIONAL :: mask
-
-    INTEGER :: i1,i2,i3,i3m,i3p,len1,len2,len3
-    REAL*8 :: f1,f2,f3,px3
-    REAL*8, DIMENSION(16) :: ker1,ker2,ker3
-
-    CALL optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
-    ker1=ker1/dx1; ker2=ker2/dx2; ker3=ker3/dx3
-
-    ! equivalent surface traction
-    DO i2=1,sx2
-       DO i1=1,sx1
-          t1(i1,i2)=t1(i1,i2)+sig(i1,i2,1)%s13
-          t2(i1,i2)=t2(i1,i2)+sig(i1,i2,1)%s23
-          t3(i1,i2)=t3(i1,i2)+sig(i1,i2,1)%s33
-       END DO
-    END DO
-
-    ! no periodicity in the 3rd direction
-    ! use a simple finite difference scheme in the 3rd direction
-!$omp parallel 
-!$omp do private(i1,i2,f1,f2,f3,px3,i3m,i3p)
-    DO i3=1,sx3
-
-       IF ((i3 .gt. len3) .and. (i3 .lt. (sx3-len3+1))) &
-            CYCLE
-
-       IF (PRESENT(mask)) THEN
-          IF (mask(i3) .EQ. 0) THEN
-             CYCLE
-          END IF
-       END IF
-
-       IF (i3 .eq. 1) THEN
-          ! right-centered finite difference
-          px3=dx3; i3p=2; i3m=1
-       ELSE
-          IF (i3 .eq. sx3) THEN
-             ! left-centered finite difference
-             px3=dx3; i3p=sx3; i3m=sx3-1
-          ELSE
-             ! centered finite difference
-             px3=dx3*2._8; i3m=i3-1; i3p=i3+1
-          END IF
-       END IF
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL localdivergence_ani(f1,f2,f3,i3m,i3p,px3, &
-                       i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
-
-             c1(i1,i2,i3)=c1(i1,i2,i3)-REAL(f1)
-             c2(i1,i2,i3)=c2(i1,i2,i3)-REAL(f2)
-             c3(i1,i2,i3)=c3(i1,i2,i3)-REAL(f3)
-
-          END DO
-       END DO
-    END DO
-!$omp end do nowait
-
-    ! intermediate depth treated isotropically
-!$omp do private(i1,i2,f1,f2,f3)
-    DO i3=len3+1,sx3-len3
-       
-       IF (PRESENT(mask)) THEN
-          IF (mask(i3) .EQ. 0) THEN
-             CYCLE
-          END IF
-       END IF
-       
-       DO i2=1,sx2
-          DO i1=1,sx1
-             ! Finite Impulse Response filter
-             !CALL localdivergence_fir(f1,f2,f3)
-             CALL localdivergence_fir2(f1,f2,f3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
-
-             c1(i1,i2,i3)=c1(i1,i2,i3)-REAL(f1)
-             c2(i1,i2,i3)=c2(i1,i2,i3)-REAL(f2)
-             c3(i1,i2,i3)=c3(i1,i2,i3)-REAL(f3)
-          END DO
-       END DO
-    END DO
-!$omp end do
-!$omp end parallel
-
-  CONTAINS
-
-    !---------------------------------------------------------------
-    ! LocalDivergence_FIR
-    ! implements a finite impulse response filter (FIR) to estimate
-    ! the divergence of second-order tensor.
-    !
-    ! ATTENTION - calls to this routine can cause memory leak.
-    !
-    ! sylvain barbot (10/10/07) - original form
-    !                (03/05/08) - implements 3 filters
-    !                (02/11/09) - compatibility with OpenMP
-    !---------------------------------------------------------------
-    SUBROUTINE localdivergence_fir2(f1,f2,f3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
-      REAL*8, INTENT(OUT) :: f1,f2,f3
-      INTEGER, INTENT(IN) :: len1,len2,len3,i1,i2,i3,sx1,sx2,sx3
-      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
-      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
-      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
-      TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: sig
-
-      INTEGER :: l,i1m,i1p,i2m,i2p,i3m,i3p
-
-      f1=0._8; f2=0._8; f3=0._8
-      
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-         
-         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
-         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
-         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
-      END DO
-      
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-         
-         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
-         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
-         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
-      END DO
-      
-      DO l=1,len3
-         ! neighbor samples in semi-infinite solid
-         i3m=i3-l
-         i3p=i3+l
-         
-         f1=f1+(sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13)*ker3(l)
-         f2=f2+(sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23)*ker3(l)
-         f3=f3+(sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33)*ker3(l)
-      END DO
-      
-    END SUBROUTINE localdivergence_fir2
-
-    !---------------------------------------------------------------
-    ! LocalDivergence_FIR
-    ! implements a finite impulse response filter (FIR) to estimate
-    ! the divergence of second-order tensor.
-    !
-    ! ATTENTION - calls to this routine can cause memory leak.
-    !
-    ! sylvain barbot (10/10/07) - original form
-    !                (03/05/08) - implements 3 filters
-    !---------------------------------------------------------------
-    SUBROUTINE localdivergence_fir(f1,f2,f3)
-      REAL*8, INTENT(OUT) :: f1,f2,f3
-
-      INTEGER :: l,i1m,i1p,i2m,i2p,i3m,i3p
-
-      f1=0._8; f2=0._8; f3=0._8
-
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-
-         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
-         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
-         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
-      END DO
-
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-
-         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
-         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
-         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
-      END DO
-
-      DO l=1,len3
-         ! neighbor samples in semi-infinite solid
-         i3m=i3-l
-         i3p=i3+l
-
-         f1=f1+(sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13)*ker3(l)
-         f2=f2+(sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23)*ker3(l)
-         f3=f3+(sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33)*ker3(l)
-      END DO
-
-    END SUBROUTINE localdivergence_fir
-
-    !---------------------------------------------------------------
-    ! LocalDivergence_ANI
-    ! implements a finite impulse response filter (FIR) in the
-    ! horizontal direction and a finite-difference scheme in the
-    ! vertical direction to estimate the divergence of second-order
-    ! tensor.
-    ! Finite difference scheme is left-centered, right-centered or
-    ! symmetric, depending on input positions (i3m,i3p) and spacing
-    ! (px3).
-    !
-    ! sylvain barbot (10/10/07) - original form
-    !                (03/05/08) - implements 3 filters
-    !                (02/12/09) - compatibility with OpenMP
-    !---------------------------------------------------------------
-    SUBROUTINE localdivergence_ani(f1,f2,f3,i3m,i3p,px3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
-      REAL*8, INTENT(OUT) :: f1,f2,f3
-      INTEGER, INTENT(IN) :: i3m,i3p,i1,i2,i3,len1,len2,len3,sx1,sx2,sx3
-      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
-      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
-      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
-      REAL*8, INTENT(IN) :: px3
-      TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: sig
-
-      INTEGER :: l,i1m,i1p,i2m,i2p,foo,dum
-
-      f1=0._8; f2=0._8; f3=0._8
-
-      ! differentiator filter in the horizontal direction
-      DO l=1,len1
-         ! neighbor samples with periodic boundary conditions
-         i1m=mod(sx1+i1-1-l,sx1)+1
-         i1p=mod(i1-1+l,sx1)+1
-
-         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
-         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
-         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
-      END DO
-
-      DO l=1,len2
-         ! neighbor samples with periodic boundary conditions
-         i2m=mod(sx2+i2-1-l,sx2)+1
-         i2p=mod(i2-1+l,sx2)+1
-
-         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
-         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
-         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
-      END DO
-
-      ! finite difference in the 3-direction
-      f1=f1+( sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13 )/px3
-      f2=f2+( sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23 )/px3
-      f3=f3+( sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33 )/px3
-
-    END SUBROUTINE localdivergence_ani
-
-    !-------------------------------------------------------------------
-    ! subroutine LocalDivergence_CFD
-    ! estimate the divergence of the stress tensor by means of simple
-    ! finite difference schemes. In the horizontal direction, numerical
-    ! scheme is always centered finite difference. because of the
-    ! surface and bottom boundary condition, scheme in the vertical
-    ! direction changes from right-centered at the top, to center in the
-    ! middle, to left-centered finite difference at the bottom.
-    !-------------------------------------------------------------------
-    SUBROUTINE localdivergence_cfd(f1,f2,f3,i3m,i3p,px3)
-      REAL*8, INTENT(OUT) :: f1,f2,f3
-      REAL*8, INTENT(IN) :: px3
-      INTEGER, INTENT(IN) :: i3m, i3p
-
-      INTEGER :: i1m,i1p,i2m,i2p
-
-      ! neighbor samples
-      i1m=mod(sx1+i1-2,sx1)+1
-      i1p=mod(i1,sx1)+1
-      i2m=mod(sx2+i2-2,sx2)+1
-      i2p=mod(i2,sx2)+1
-
-      f1= ( sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11 )/dx1/2._8 &
-         +( sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12 )/dx2/2._8 &
-         +( sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13 )/px3
-      f2= ( sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12 )/dx1/2._8 &
-         +( sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22 )/dx2/2._8 &
-         +( sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23 )/px3
-      f3= ( sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13 )/dx1/2._8 &
-         +( sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23 )/dx2/2._8 &
-         +( sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33 )/px3
-
-    END SUBROUTINE localdivergence_cfd
-
-  END SUBROUTINE equivalentbodyforce
-
-
-  !---------------------------------------------------------------------
-  !> function SourceSpectrum
-  !! computes the equivalent body-forces for a buried dislocation,
-  !! with strike-slip and dip-slip components,
-  !! slip s, width W, length L in a rigidity mu
-  !!
-  !! \author sylvain barbot (06-25-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE sourcespectrum(mu,s,x,y,d, &
-       L,W,strike,dip,rake,beta,dx1,dx2,dx3,f1,f2,f3)
-    REAL*8, INTENT(IN) :: mu,s,x,y,d,L,W,strike,dip,rake,&
-         beta,dx1,dx2,dx3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
-
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8 :: k1,k2,k3,k1s,k2s,k3s,k1i,k3i, &
-         cstrike,sstrike,cdip,sdip,cr,sr,k2r
-    COMPLEX*8 :: cbuf1,cbuf2,cbuf3,source,image,&
-         shift,scale,aperture,up,down
-    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
-
-    sx1=SIZE(f2,1)-2
-    sx2=SIZE(f2,2)
-    sx3=SIZE(f2,3)
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-    scale=i*mu*s*L*W
-
-    DO i3=1,sx3
-       CALL wavenumber3(i3,sx3,dx3,k3)
-       down=exp(-i*k3*(L/2._8+d))
-       up=conjg(down)
-       DO i2=1,sx2
-          CALL wavenumber2(i2,sx2,dx2,k2)
-          DO i1=1,sx1/2+1
-             CALL wavenumber1(i1,sx1,dx1,k1)
-
-             !rotate the wavenumbers
-             k2r= cstrike*k1-sstrike*k2
-             k1s= cdip*k2r-sdip*k3
-             k2s= sstrike*k1+cstrike*k2
-             k3s= sdip*k2r+cdip*k3
-             k1i= cdip*k2r+sdip*k3
-             k3i=-sdip*k2r+cdip*k3
-             
-             !integrate at depth and along strike with raised cosine taper
-             !and shift sources to x,y,z coordinate
-             shift=exp(-i*(x*k1+y*k2))
-             aperture=scale*omegak(W*k2s,beta)
-             source=omegak(L*k3s,beta)*aperture*shift*down
-             image =omegak(L*k3i,beta)*aperture*shift*up
-
-             !convolve source and image with a 1-D gaussian
-             source=source*exp(-(pi*dx1*k1s)**2)
-             image = image*exp(-(pi*dx1*k1i)**2)
-             
-             cbuf1= cdip*cstrike*( &
-                  -(cr*k2s+sr*k3s)*source-(cr*k2s-sr*k3i)*image) &
-                  +cr*sstrike*(-k1s*source-k1i*image) &
-                  -sr*sdip*cstrike*(-k1s*source-k1i*image)
-             !change -sr*sdip back to +sr*sdip above and below
-             cbuf2=-cdip*sstrike*( &
-                  -(cr*k2s+sr*k3s)*source-(cr*k2s-sr*k3i)*image) &
-                  +cr*cstrike*(-k1s*source-k1i*image) &
-                  -sr*sdip*sstrike*(-k1s*source-k1i*image)
-             !change -sdip back to +sdip here
-             cbuf3=-sdip*((-sr*k3s-cr*k2s)*source &
-                  +(-sr*k3i+cr*k2s)*image) &
-                  +sr*cdip*(-k1s*source+k1i*image)
-
-             f1(2*i1-1:2*i1,i2,i3)=&
-                  f1(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf1),AIMAG(cbuf1)/)
-             f2(2*i1-1:2*i1,i2,i3)=&
-                  f2(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf2),AIMAG(cbuf2)/)
-             f3(2*i1-1:2*i1,i2,i3)=&
-                  f3(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf3),AIMAG(cbuf3)/)
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE sourcespectrum
-
-
-  !---------------------------------------------------------------------
-  !> function SourceSpectrumHalfSpace
-  !! computes the equivalent body-forces for a buried dislocation,
-  !! with strike-slip and dip-slip components,
-  !! slip s, width W, length L in a rigidity mu; sources are not imaged
-  !!
-  !! \author sylvain barbot (06-25-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE sourcespectrumhalfspace(mu,s,x,y,d, &
-       L,W,strike,dip,rake,beta,dx1,dx2,dx3,f1,f2,f3)
-    REAL*8, INTENT(IN) :: mu,s,x,y,d,L,W,strike,dip,rake,&
-         beta,dx1,dx2,dx3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
-
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8 :: k1,k2,k3,k1s,k2s,k3s, &
-         cstrike,sstrike,cdip,sdip,cr,sr,k2r
-    COMPLEX*8 :: cbuf1,cbuf2,cbuf3,source,&
-         shift,scale,aperture,down
-    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
-
-    sx1=SIZE(f2,1)-2
-    sx2=SIZE(f2,2)
-    sx3=SIZE(f2,3)
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-    scale=i*mu*s*L*W
-
-    DO i3=1,sx3
-       CALL wavenumber3(i3,sx3,dx3,k3)
-       down=exp(-i*k3*(L/2._8+d))
-       DO i2=1,sx2
-          CALL wavenumber2(i2,sx2,dx2,k2)
-          DO i1=1,sx1/2+1
-             CALL wavenumber1(i1,sx1,dx1,k1)
-             !rotate the wavenumbers
-             k2r= cstrike*k1-sstrike*k2
-             k1s= cdip*k2r-sdip*k3
-             k2s= sstrike*k1+cstrike*k2
-             k3s= sdip*k2r+cdip*k3
-             
-             !convolve source and image with a 1-D gaussian
-             !integrate at depth and along strike with raised cosine taper
-             !and shift sources to x,y,z coordinate
-             shift=exp(-i*(x*k1+y*k2))
-             aperture=scale*omegak(W*k2s,beta)*exp(-(pi*dx1*k1s)**2)
-             source=(omegak(L*k3s,beta)*aperture)*shift*down
-
-             cbuf1= cdip*cstrike*( &
-                  -(cr*k2s+sr*k3s)*source) &
-                  +cr*sstrike*(-k1s*source) &
-                  -sr*sdip*cstrike*(-k1s*source)
-             cbuf2=-cdip*sstrike*( &
-                  -(cr*k2s+sr*k3s)*source) &
-                  +cr*cstrike*(-k1s*source) &
-                  -sr*sdip*sstrike*(-k1s*source)
-             cbuf3=-sdip*((-sr*k3s-cr*k2s)*source) &
-                  +sr*cdip*(-k1s*source)
-
-             f1(2*i1-1:2*i1,i2,i3)=&
-                  f1(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf1),AIMAG(cbuf1)/)
-             f2(2*i1-1:2*i1,i2,i3)=&
-                  f2(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf2),AIMAG(cbuf2)/)
-             f3(2*i1-1:2*i1,i2,i3)=&
-                  f3(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf3),AIMAG(cbuf3)/)
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE sourcespectrumhalfspace
-
-  !---------------------------------------------------------------------
-  !> function Source computes the equivalent body-forces
-  !! in the space domain for a buried dislocation with strike-slip
-  !! and dip-slip components, slip s, width W, length L in a rigidity mu
-  !!
-  !! Default (strike=0, dip=0, rake=0) is a vertical left-lateral
-  !! strike-slip fault along the x2 axis. Default fault slip is
-  !! represented with the double-couple equivalent body forces:
-  !!
-  !!\verbatim
-  !!
-  !!                   x1
-  !!                   |
-  !!                   |   ^  f2
-  !!                   |   |<-----
-  !!                   +---+------+---- x2
-  !!                        ----->|
-  !!                              v  f1
-  !!
-  !!\endverbatim
-  !!
-  !! \author sylvain barbot (06-29-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE source(mu,s,x,y,z,L,W,strike,dip,rake, &
-       beta,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3,t1,t2,t3)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: mu,s,x,y,z,L,W,strike,dip,rake, &
-         beta,dx1,dx2,dx3
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: t1,t2,t3
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-    REAL*4, DIMENSION(sx1,sx2), INTENT(INOUT) :: t1,t2,t3
-#endif
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,cr,sr,x2r, &
-         sourc,image,scale,temp1,temp2,temp3, &
-         dblcp,cplei,dipcs,dipci,xr,yr,zr,Wp,Lp
-    REAL(8), DIMENSION(3) :: n,b
-    TYPE(TENSOR) :: m
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-    scale=-mu*s
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-    
-    ! equivalent surface traction
-    i3=1
-    DO i2=1,sx2
-       DO i1=1,sx1
-          CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                                  dx1,dx2,dx3,x1,x2,x3)
-
-          IF ((ABS(x1-x).GT.MAX(Lp,Wp)).OR.(ABS(x2-y).GT.MAX(Lp,Wp))) CYCLE
-
-          x2r= cstrike*x1-sstrike*x2
-          x1s= cdip*x2r-sdip*x3
-          x1i= cdip*x2r+sdip*x3
-          IF ((ABS(x1s-xr).GT.7.01*dx1).AND.(ABS(x1i-xr).GT.7.01*dx1)) CYCLE
-          x2s= sstrike*x1+cstrike*x2
-          x3s= sdip*x2r+cdip*x3
-          x3i=-sdip*x2r+cdip*x3
-
-          ! integrate at depth and along strike with raised cosine taper
-          ! and shift sources to x,y,z coordinate
-          temp1=gauss(x1s-xr,dx1)
-          temp2=omega((x2s-yr)/W,beta)
-          temp3=omega((x3s-zr)/L,beta)
-          sourc=temp1*temp2*temp3
-
-          ! add image
-          temp1=gauss(x1i-xr,dx1)
-          temp3=omega((x3i+zr)/L,beta)
-          sourc=sourc+temp1*temp2*temp3
-
-          ! surface normal vector components
-          n(1)=+cdip*cstrike*sourc
-          n(2)=-cdip*sstrike*sourc
-          n(3)=-sdip*sourc
-
-          ! burger vector (strike-slip)
-          b(1)=sstrike*cr
-          b(2)=cstrike*cr
-
-          ! burger vector (dip-slip)
-          b(1)=b(1)+cstrike*sdip*sr
-          b(2)=b(2)-sstrike*sdip*sr
-          b(3)=    +cdip*sr
-
-          ! principal stress (symmetric deviatoric second-order tensor)
-          m=n .sdyad. (mu*s*b)
-
-          ! surface tractions
-          t1(i1,i2)=t1(i1,i2)+m%s13
-          t2(i1,i2)=t2(i1,i2)+m%s23
-          t3(i1,i2)=t3(i1,i2)+m%s33
-             
-       END DO
-    END DO
-
-    ! equivalent body-force density
-!$omp parallel do private(i1,i2,x1,x2,x3,x2r,x1s,x1i,x2s,x3s,x3i,temp1,temp2,temp3), &
-!$omp private(sourc,dblcp,dipcs,image,cplei,dipci)
-    DO i3=1,sx3/2
-       CALL shiftedcoordinates(1,1,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-             IF ((ABS(x1-x) .GT. MAX(Wp,Lp)) .OR.  (abs(x2-y) .GT. MAX(Wp,Lp))) CYCLE
-
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((ABS(x1s-xr) .GT. 7.01_8*dx1) .AND. (ABS(x1i-xr) .GT. 7.01_8*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-             
-             !integrate at depth and along strike with raised cosine taper
-             !and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             sourc=scale  *gaussp(x1s-xr,dx1) &
-                          *temp2 &
-                          *temp3
-             dblcp=scale/W*temp1 &
-                          *omegap((x2s-yr)/W,beta) &
-                          *temp3
-             dipcs=scale/L*temp1 &
-                          *temp2 &
-                          *omegap((x3s-zr)/L,beta)
-
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             image=scale  *gaussp(x1i-xr,dx1) &
-                          *temp2 &
-                          *temp3
-             cplei=scale/W*temp1 &
-                          *omegap((x2s-yr)/W,beta) &
-                          *temp3
-             dipci=scale/L*temp1 &
-                          *temp2 &
-                          *omegap((x3i+zr)/L,beta)
-
-             ! strike-slip component
-
-             IF (2.01_8*DEG2RAD .GT. dip) THEN
-                ! use method of images for subvertical faults
-                f1(i1,i2,i3)=f1(i1,i2,i3) &
-                     +cr*sstrike*(sourc+image) &
-                       +cr*cdip*cstrike*(dblcp+cplei)
-                f2(i1,i2,i3)=f2(i1,i2,i3) &
-                     +cr*cstrike*(sourc+image) &
-                     -cr*cdip*sstrike*(dblcp+cplei)
-                f3(i1,i2,i3)=f3(i1,i2,i3) &
-                     -cr*sdip*(dblcp-cplei)
-             ELSE
-                ! dipping faults do not use method of image
-                f1(i1,i2,i3)=f1(i1,i2,i3) &
-                     +cr*sstrike*(sourc) &
-                     +cr*cdip*cstrike*(dblcp)
-                f2(i1,i2,i3)=f2(i1,i2,i3) &
-                     +cr*cstrike*(sourc) &
-                     -cr*cdip*sstrike*(dblcp)
-                 f3(i1,i2,i3)=f3(i1,i2,i3) &
-                     -cr*sdip*(dblcp)
-             END IF
-
-             ! dip-slip component
-
-             f1(i1,i2,i3)=f1(i1,i2,i3) &
-                  +cdip*sr*cstrike*dipcs &
-                  +sdip*sr*cstrike*sourc
-             f2(i1,i2,i3)=f2(i1,i2,i3) &
-                  -cdip*sr*sstrike*dipcs &
-                  -sdip*sr*sstrike*sourc
-             f3(i1,i2,i3)=f3(i1,i2,i3) &
-                  +cdip*sr*sourc &
-                  -sdip*sr*dipcs
-
-          END DO
-       END DO
-    END DO
-!$omp end parallel do
-
-  END SUBROUTINE source
-
-  !---------------------------------------------------------------------
-  !> function TensileSource
-  !! computes the equivalent body-forces in the space domain for a buried
-  !! tensile crack with opening s, width W, length L and Lame parameters
-  !! lambda, mu.
-  !!
-  !! Default (strike=0, dip=0) is a vertical opening along the x2 axis.
-  !! Default fault opening is represented with the double-couple
-  !! equivalent body forces:
-  !!
-  !!\verbatim
-  !!
-  !!           x1           f1
-  !!           |         ^^^^^^^
-  !!           |         |||||||
-  !!           | -f2 <--+-------+--> f2
-  !!           |         |||||||
-  !!           |         vvvvvvv
-  !!           |           -f1
-  !!           |
-  !!           +----------------------------- x2
-  !!
-  !!\endverbatim
-  !!
-  !! The eigenstrain/potency tensor for a point source is
-  !!
-  !!\verbatim
-  !!
-  !!         | 1 0 0 |
-  !!   E^i = | 0 0 0 |
-  !!         | 0 0 0 |
-  !!
-  !!\endverbatim
-  !!
-  !! and the corresponding moment density for a point source is
-  !!
-  !!\verbatim
-  !!
-  !!                 | lambda+2*mu    0      0   |
-  !!   m = C : E^i = |      0      lambda    0   |
-  !!                 |      0         0   lambda |
-  !!
-  !!\endverbatim
-  !!
-  !! Moment density is integrated along the planar surface
-  !!
-  !!   \f[ box(x2) \delta(x1) box(x3) \f]
-  !!
-  !! where box(x) and delta(x) are the boxcar and the dirac delta
-  !! functions, respectively. We use a tapered boxcar, omega_beta(x) and
-  !! approximate the delta function by a small gaussian function.
-  !! Finally, the equivalent body force is the divergence of the moment
-  !! density tensor
-  !!
-  !!   \f[ f_i = - ( m_{ij} )_{,j} \f]
-  !!
-  !! derivatives are performed analytically on the gaussian and
-  !! omega_beta functions.
-  !!
-  !! \author sylvain barbot (05-09-08) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE tensilesource(lambda,mu,s,x,y,z,L,W,strike,dip, &
-       beta,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: lambda,mu,s,x,y,z,L,W,strike,dip,&
-         beta,dx1,dx2,dx3
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-#endif
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,x2r,&
-         sourc,image,scale1,scale2,temp1,temp2,temp3, &
-         dblcp,cplei,dipcs,dipci,xr,yr,zr,Wp,Lp
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-    scale1=-s*(lambda+2._8*mu)
-    scale2=-s*lambda
-
-    DO i3=1,sx3
-       CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
-
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-
-             !integrate at depth and along strike with raised cosine taper
-             !and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             sourc=scale1  *gaussp(x1s-xr,dx1) &
-                           *temp2 &
-                           *temp3
-             dblcp=scale2/W*temp1 &
-                           *omegap((x2s-yr)/W,beta) &
-                           *temp3
-             dipcs=scale2/L*temp1 &
-                           *temp2 &
-                           *omegap((x3s-zr)/L,beta)
-
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             image=scale1  *gaussp(x1i-xr,dx1) &
-                           *temp2 &
-                           *temp3
-             cplei=scale2/W*temp1 &
-                           *omegap((x2s-yr)/W,beta) &
-                           *temp3
-             dipci=scale2/L*temp1 &
-                           *temp2 &
-                           *omegap((x3i+zr)/L,beta)
-
-             ! force moments in original coordinate system
-
-             f1(i1,i2,i3)=f1(i1,i2,i3) &
-                  +cstrike*cdip*(sourc+image) &
-                  +sstrike*(dblcp+cplei) &
-                  +cstrike*sdip*(dipcs+dipci)
-             f2(i1,i2,i3)=f2(i1,i2,i3) &
-                  -sstrike*cdip*(sourc+image) &
-                  +cstrike*(dblcp+cplei) &
-                  -sstrike*sdip*(dipcs+dipci)
-             f3(i1,i2,i3)=f3(i1,i2,i3) &
-                  -sdip*(sourc-image) &
-                  +cdip*(dipcs-dipci)
-
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE tensilesource
-
-  !---------------------------------------------------------------------
-  !! function MogiSource 
-  !! computes the equivalent body-forces in the space domain for a buried 
-  !! dilatation point source.
-  !!
-  !! The point-source opening o with at position xs in the half space is
-  !! associated with eigenstrain
-  !!
-  !!      \f[ E^i = o \frac{1}{3} I \delta(x-x_s) \f]
-  !!
-  !! where I is the diagonal tensor and delta is the Dirac delta function
-  !! (or in index notation E^i_{ij} = o delta_{ij} / 3 delta(xs) ) and 
-  !! with the moment density
-  !!
-  !!      \f[ m = C : E^i = K o I \delta(x-x_s) \f]
-  !!
-  !! The equivalent body-force density is
-  !!
-  !!      \f[ f = - \nabla \cdot m = K o \nabla \delta(x-x_s) \f]
-  !!
-  !! where nabla is the gradient operator. Default source opening is 
-  !! represented with the isotropic equivalent body-force density:
-  !!
-  !!\verbatim
-  !!
-  !!                   x1
-  !!                   |      f1
-  !!                   |      ^
-  !!                   |  f2  |  f2
-  !!                   +---<--+-->---- x2
-  !!                          |
-  !!                          v  f1
-  !!
-  !!                   x3
-  !!                   |      f3
-  !!                   |      ^
-  !!                   |  f2  |  f2
-  !!                   +---<--+-->---- x2
-  !!                          |
-  !!                          v  f3
-  !!
-  !!\endverbatim
-  !!
-  !! \author sylvain barbot (03-24-09) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE mogisource(lambda,mu,o,xs,ys,zs,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: lambda,mu,o,xs,ys,zs,dx1,dx2,dx3
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
-#endif
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,source1,source2,source3, &
-         image1,image2,image3,scale,temp1,temp2,temp3,Wp,Lp
-
-    scale=-(lambda+2._8*mu/3._8)*o ! -kappa*o
-
-    ! effective dimensions
-    Wp=6._8*MAX(dx1,dx2,dx3)
-    Lp=6._8*MAX(dx1,dx2,dx3)
-
-    DO i3=1,sx3
-       CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-       IF ((abs(x3-zs).gt.Lp) .and. (abs(x3+zs).gt.Lp)) CYCLE
-       
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-             IF ((abs(x1-xs).gt.Wp) .or.  (abs(x2-ys).gt.Wp)) CYCLE
-
-             temp1=gauss(x1-xs,dx1)
-             temp2=gauss(x2-ys,dx2)
-             temp3=gauss(x3-zs,dx3)
-
-             source1=scale*gaussp(x1-xs,dx1)*temp2*temp3
-             source2=scale*temp1*gaussp(x2-ys,dx2)*temp3
-             source3=scale*temp1*temp2*gaussp(x3-zs,dx3)
-
-             temp3=gauss(x3+zs,dx3)
-
-             image1=scale*gaussp(x1-xs,dx1)*temp2*temp3
-             image2=scale*temp1*gaussp(x2-ys,dx2)*temp3
-             image3=scale*temp1*temp2*gaussp(x3+zs,dx3)
-
-             ! equivalent body-force density
-             f1(i1,i2,i3)=f1(i1,i2,i3)+(source1+image1)
-             f2(i1,i2,i3)=f2(i1,i2,i3)+(source2+image2)
-             f3(i1,i2,i3)=f3(i1,i2,i3)+(source3-image3)
-
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE mogisource
-
-  !---------------------------------------------------------------------
-  !> subroutine Traction 
-  !! assigns the traction vector at the surface.
-  !!
-  !! \author sylvain barbot (07-19-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE traction(mu,e,sx1,sx2,dx1,dx2,t,Dt,t3,rate)
-    TYPE(EVENT_STRUC), INTENT(IN) :: e
-    INTEGER, INTENT(IN) :: sx1,sx2
-    REAL*8, INTENT(IN) :: mu,dx1,dx2,t,Dt
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: t3
-#else
-    REAL*4, DIMENSION(sx1,sx2), INTENT(INOUT) :: t3
-#endif
-    LOGICAL, INTENT(IN), OPTIONAL :: rate
-
-    INTEGER :: i,i1,i2,i3
-    LOGICAL :: israte
-    REAL*8 :: period,phi,amp,L,W,Lp,Wp,x1,x2,x3,x,y,beta
-
-    REAL*8, PARAMETER :: pi=3.141592653589793115997963468544185161_8
-
-    IF (PRESENT(rate)) THEN
-       israte=rate
-    ELSE
-       israte=.FALSE.
-    END IF
-
-    ! loop over traction sources
-    DO i=1,e%nl
-
-       x=e%l(i)%x
-       y=e%l(i)%y
-
-       L=e%l(i)%length
-       W=e%l(i)%width
-
-       beta=e%l(i)%beta
-
-       ! effective tapered dimensions
-       Lp=L*(1._8+2._8*beta)/2._8
-       Wp=W*(1._8+2._8*beta)/2._8
-
-       i3=1
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,1, &
-                                     dx1,dx2,1.d8,x1,x2,x3)
-
-             IF ((ABS(x1-x).GT.MAX(Lp,Wp)).OR.(ABS(x2-y).GT.MAX(Lp,Wp))) CYCLE
-
-             amp=omega((x1-x)/L,beta)* &
-                 omega((x2-y)/W,beta)* &
-                 mu*e%l(i)%slip
-
-             IF (israte) THEN
-                ! surface tractions rate
-                period=e%l(i)%period
-                phi=e%l(i)%phase
-
-                t3(i1,i2)=t3(i1,i2)-amp*(sin(2*pi*(t+Dt)/period+phi)-sin(2*pi*t/period+phi))
-             ELSE
-                IF (e%l(i)%period .LE. 0) THEN
-                   ! surface tractions
-                   t3(i1,i2)=t3(i1,i2)-amp
-                END IF
-             END IF
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE traction
-
-  !---------------------------------------------------------------------
-  !! function MomentDensityShear
-  !! computes the inelastic irreversible moment density in the space
-  !! domain corresponding to a buried dislocation with strike-slip and
-  !! dip-slip components (pure shear). A fault along a surface of normal
-  !! n_i with a burger vector s_i, is associated with the eigenstrain
-  !!
-  !!   E^i_ij = 1/2 ( n_i s_j + s_i n_j )
-  !!
-  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
-  !! corresponding moment density tensor is
-  !!
-  !!   m_ij = C_ijkl E^i_kl
-  !!
-  !! where C = C(x) is a function of space. Equivalent body forces
-  !! representing the set of dislocations can be obtained by evaluating
-  !! the divergence of the moment density tensor
-  !!
-  !!   f_i = - ( m_ji ),j
-  !!
-  !! using the function "EquivalentBodyForce" in this module.
-  !!
-  !! The default dislocation extends in the x2 direction, with a normal
-  !! in the x1 direction. Using the following angular convention,
-  !!
-  !!\verbatim
-  !!
-  !!           x1            !           x1
-  !!   n  theta |            !   n   phi  |
-  !!     \  ____|            !     \  ____|
-  !!       \    |            !       \    |
-  !!         \  |            !         \  |
-  !!      -----\+------ x2   !      -----\+------ x3
-  !!        (x3 down)        !         (x2 up)
-  !!
-  !!\endverbatim
-  !!
-  !! where theta is the strike and phi is the dip (internal convention),
-  !! and introducting the rotation matrices
-  !!
-  !!\verbatim
-  !!
-  !!        |  cos(theta)   sin(theta)    0 |
-  !!   R1 = | -sin(theta)   cos(theta)    0 |
-  !!        |      0             0        1 |
-  !!
-  !!        |  cos(phi)     0     sin(phi)  |
-  !!   R2 = |     0         1        0      |
-  !!        | -sin(phi)     0     cos(phi)  |
-  !!
-  !!\endverbatim
-  !!
-  !! a normal vector n of arbitrary orientation and the corresponding
-  !! strike-slip and dip-slip vector, s and d respectively, are
-  !!
-  !!\verbatim
-  !!
-  !!             | 1 |             | 0 |             | 0 |
-  !!   n = R1 R2 | 0 |,  s = R1 R2 | 1 |,  d = R1 R2 | 0 |
-  !!             | 0 |             | 0 |             | 1 |
-  !!
-  !!\endverbatim
-  !!
-  !! vector n, s and d are orthogonal and the corresponding moment
-  !! density second order tensor is deviatoric. The method of images is
-  !! used to avoid tapering of the fault at the surface.
-  !!
-  !! \author sylvain barbot (03-02-08) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE momentdensityshear(mu,slip,x,y,z,L,W,strike,dip,rake, &
-       beta,sx1,sx2,sx3,dx1,dx2,dx3,sig)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: mu,slip,x,y,z,L,W,strike,dip,rake,&
-         beta,dx1,dx2,dx3
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
-
-    INTEGER :: i1,i2,i3
-    REAL*4 :: rmu
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
-         aperture,temp1,temp2,temp3,xr,yr,zr,Wp,Lp,dum
-    REAL*8, DIMENSION(3) :: n,s
-    TYPE(TENSOR) :: Ei
-
-    rmu=2._4*REAL(mu,4)
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-
-    DO i3=1,sx3
-       x3=DBLE(i3-1)*dx3
-       IF (abs(x3-z) .gt. Lp) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-
-             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
-
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-
-             ! integrate at depth and along strike with raised cosine taper
-             ! and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             aperture=temp1*temp2*temp3
-
-             ! add image
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             aperture=aperture+temp1*temp2*temp3
-
-             ! surface normal vector components
-             n(1)=+cdip*cstrike*aperture
-             n(2)=-cdip*sstrike*aperture
-             n(3)=-sdip*aperture
-
-             ! strike-slip component
-             s(1)=sstrike*cr
-             s(2)=cstrike*cr
-
-             ! dip-slip component
-             s(1)=s(1)+cstrike*sdip*sr
-             s(2)=s(2)-sstrike*sdip*sr
-             s(3)=    +cdip*sr
-
-             ! eigenstrain (symmetric deviatoric second-order tensor)
-             Ei=n .sdyad. (slip*s)
-
-             ! moment density (pure shear)
-             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. (rmu .times. Ei)
-             
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE momentdensityshear
-
-  !---------------------------------------------------------------------
-  !> function MomentDensityTensile
-  !! computes the inelastic irreversible moment density in the space
-  !! domain corresponding to a buried dislocation with opening (open
-  !! crack). A fault along a surface of normal n_i with a burger vector
-  !! s_i, is associated with the eigenstrain
-  !!
-  !!   \f[ E^i_{ij} = \frac{1}{2} ( n_i s_j + s_i n_j ) \f]
-  !!
-  !! The eigenstrain/potency tensor for a point source opening crack is
-  !!
-  !!\verbatim
-  !!
-  !!         | 1 0 0 |
-  !!   E^i = | 0 0 0 |
-  !!         | 0 0 0 |
-  !!
-  !!\endverbatim
-  !!
-  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
-  !! corresponding moment density tensor is
-  !!
-  !!   \f[ m_{ij} = C_{ijkl} E^i_{kl} = \lambda E^i_{kk} \delta_{ij} + 2 \mu E^i_{ij} \f]
-  !!
-  !! where C = C(x) is a function of space. (We use isotropic elastic
-  !! solid, and heterogeneous elastic moduli tensor simplifies to
-  !! mu=mu(x) and lambda = lambda(x).) The moment density for a point
-  !! source opening crack is
-  !!
-  !!\verbatim
-  !!
-  !!          | lambda+2*mu    0      0   |
-  !!   m(x) = |      0      lambda    0   |
-  !!          |      0         0   lambda |
-  !!
-  !!\endverbatim
-  !!
-  !! Moment density m(x) is integrated along the planar surface
-  !!
-  !!   box(x2) delta (x1) box(x3)
-  !!
-  !! where box(x) and delta(x) are the boxcar and the dirac delta
-  !! functions, respectively. Equivalent body forces representing the
-  !! set of dislocations can be obtained by evaluating the divergence
-  !! of the moment density tensor
-  !!
-  !!   \f[ f_i = - ( m_{ji} ),j \f]
-  !!
-  !! The corresponding equivalent surface traction is simply
-  !!
-  !!   \f[ t_i = m_{ij} n_j \f]
-  !!
-  !! Both equivalent body forces and equivalent surface traction are
-  !! computed using the function "EquivalentBodyForce" in this module.
-  !!
-  !! The default dislocation extends in the x2 direction, with a normal
-  !! in the x1 direction. Using the following angular convention,
-  !!
-  !!\verbatim
-  !!
-  !!           x1            !           x1
-  !!   n  theta |            !   n   phi  |
-  !!     \  ____|            !     \  ____|
-  !!       \    |            !       \    |
-  !!         \  |            !         \  |
-  !!      -----\+------ x2   !      -----\+------ x3
-  !!        (x3 down)        !         (x2 up)
-  !!
-  !!\endverbatim
-  !!
-  !! where theta is the strike and phi is the dip, in internal
-  !! convention. (Internal angular convention does not correspond to
-  !! usual angular convention of geology and conversion between the two
-  !! standard is necessary.) Introducting the rotation matrices,
-  !!
-  !!\verbatim
-  !!
-  !!        |  cos(theta)   sin(theta)    0 |
-  !!   R1 = | -sin(theta)   cos(theta)    0 |
-  !!        |      0             0        1 |
-  !!
-  !!        |  cos(phi)     0     sin(phi)  |
-  !!   R2 = |     0         1        0      |
-  !!        | -sin(phi)     0     cos(phi)  |
-  !!
-  !!\endverbatim
-  !!
-  !! a normal vector n of arbitrary orientation and the corresponding
-  !! slip vector s are
-  !!
-  !!\verbatim
-  !!
-  !!             | 1 |                 | 1 |
-  !!   n = R1 R2 | 0 |,  s = n = R1 R2 | 0 |
-  !!             | 0 |                 | 0 |
-  !!
-  !!\endverbatim
-  !!
-  !! The method of images is used to avoid tapering of the fault at
-  !! the surface.
-  !!
-  !! \author sylvain barbot (03-02-08) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE momentdensitytensile(lambda,mu,slip,x,y,z,L,W,strike,dip,rake, &
-       beta,sx1,sx2,sx3,dx1,dx2,dx3,sig)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: lambda,mu,slip,x,y,z,L,W,strike,dip,rake,&
-         beta,dx1,dx2,dx3
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
-         aperture,temp1,temp2,temp3,xr,yr,zr,Wp,Lp,dum
-    REAL*8, DIMENSION(3) :: n
-    TYPE(TENSOR) :: Ei
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-
-    DO i3=1,sx3
-       x3=DBLE(i3-1)*dx3
-       IF (abs(x3-z) .gt. Lp) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-
-             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
-
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-
-             ! integrate at depth and along strike with raised cosine taper
-             ! and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             aperture=temp1*temp2*temp3
-
-             ! add image
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             aperture=aperture+temp1*temp2*temp3
-
-             ! surface normal vector components
-             n(1)=+cdip*cstrike*aperture
-             n(2)=-cdip*sstrike*aperture
-             n(3)=-sdip*aperture
-
-             ! eigenstrain (symmetric second-order tensor)
-             Ei=n .sdyad. (slip*n)
-
-             ! moment density (isotropic Hooke's law)
-             CALL isotropicstressstrain(Ei,lambda,mu)
-             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. Ei
-             
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE momentdensitytensile
-
-  !---------------------------------------------------------------------
-  !! function MomentDensityMogi
-  !! computes the inelastic irreversible moment density in the space
-  !! domain corresponding to a buried Mogi source. 
-  !! The Mogi source is associated with the eigenstrain
-  !!
-  !!   \f[ E^i_{ij} = o \frac{1}{3} \delta_{ij} \f]
-  !!
-  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
-  !! corresponding moment density tensor is
-  !!
-  !!   \f[ m_{ij} = C_{ijkl} E^i_{kl} \f]
-  !!
-  !! where C = C(x) is a function of space. Equivalent body forces
-  !! representing the set of dislocations can be obtained by evaluating
-  !! the divergence of the moment density tensor
-  !!
-  !!   \f[ f_i = - ( m_{ji} ),j \f]
-  !!
-  !! using the function "EquivalentBodyForce" in this module.
-  !!
-  !! \author sylvain barbot (03-24-09) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE momentdensitymogi(lambda,mu,o,xs,ys,zs,sx1,sx2,sx3,dx1,dx2,dx3,sig)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: lambda,mu,o,xs,ys,zs,dx1,dx2,dx3
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,Wp,Lp,dum,kappa,gamma,gammai
-    TYPE(TENSOR) :: m
-
-    kappa=lambda+2._8/3._8*mu
-
-    ! effective tapered dimensions
-    Wp=6._8*MAX(dx1,dx2,dx3)
-    Lp=6._8*MAX(dx1,dx2,dx3)
-
-    DO i3=1,sx3
-       x3=DBLE(i3-1)*dx3
-       IF (abs(x3-zs) .gt. Lp) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-
-             IF ((abs(x1-xs).gt.Wp) .or.  (abs(x2-ys).gt.Wp)) CYCLE
-
-             ! amplitude of eigenstrain
-             gamma =o*gauss(x1-xs,dx1)*gauss(x2-ys,dx2)*gauss(x3-zs,dx3)
-
-             ! add image
-             gammai=o*gauss(x1-xs,dx1)*gauss(x2-ys,dx2)*gauss(x3+zs,dx3)
-
-             ! amplitude of moment density
-             gamma=kappa*gamma
-             gammai=kappa*gammai
-
-             ! eigenstrain (diagonal second-order tensor)
-             m=TENSOR(gamma,0,0,gamma,0,gamma)
-
-             ! moment density (pure shear)
-             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. m
-             
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE momentdensitymogi
-
-  !---------------------------------------------------------------------
-  !> function Plane
-  !! computes the three components, n1, n2 and n3, of the normal vector
-  !! corresponding to a rectangular surface of finite size. The plane
-  !! is defined by its orientation (strike and dip) and dimension.
-  !!
-  !!\verbatim
-  !!
-  !!              W
-  !!       +-------------+
-  !!       |             |
-  !!     L |      +      | - - - > along strike direction
-  !!       |   (x,y,z)   |
-  !!       +-------------|
-  !!              |
-  !!              v
-  !!      down-dip direction
-  !!
-  !!\endverbatim
-  !!
-  !! in the default orientation, for which strike=0 and dip=0, the plane
-  !! is vertical along the x2 axis, such as n2(x) = n3(x) = 0 for all x.
-  !! internal angular conventions are as follows:
-  !!
-  !!\verbatim
-  !!
-  !!             n   x1                          n   x1
-  !!              \   |                           \   |
-  !!               \  |                            \  |
-  !!   90 - strike  \ |                  90 - dip   \ |
-  !!               ( \|                            ( \|
-  !!        ----------+------ x2            ----------+------ x3
-  !!              (x3 down)                       (x2 up)
-  !!
-  !!\endverbatim
-  !!
-  !! edges of the rectangle are tapered.
-  !!
-  !! \author sylvain barbot (09-15-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE plane(x,y,z,L,W,strike,dip, &
-       beta,sx1,sx2,sx3,dx1,dx2,dx3,n1,n2,n3)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: n1,n2,n3
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: n1,n2,n3
-#endif
-
-    INTEGER :: i1,i2,i3
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,x2r,&
-         temp1,temp2,temp3,sourc,image,xr,yr,zr,Wp,Lp,dum
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-
-    DO i3=1,sx3
-       x3=DBLE(i3-1)*dx3
-       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
-
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-
-             !integrate at depth and along strike with raised cosine taper
-             !and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             sourc=temp1*temp2*temp3
-
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             image=temp1*temp2*temp3
-
-             ! surface normal vector components
-             n1(i1,i2,i3)=n1(i1,i2,i3)+cdip*cstrike*(sourc+image)
-             n2(i1,i2,i3)=n2(i1,i2,i3)-cdip*sstrike*(sourc+image)
-             n3(i1,i2,i3)=n3(i1,i2,i3)-sdip*(sourc+image)
-             
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE plane
-
-  !---------------------------------------------------------------------
-  !> function MonitorStressField
-  !! samples a stress field along a specified planar surface.
-  !!
-  !! \author sylvain barbot (10-16-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE monitorstressfield(x,y,z,L,W,strike,dip,beta, &
-       sx1,sx2,sx3,dx1,dx2,dx3,sig,patch)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: patch
-
-    INTEGER :: px2,px3,j2,j3,status
-    REAL*8 :: x1,x2,x3,xr,yr,zr,Wp,Lp, &
-         cstrike,sstrike,cdip,sdip
-    TYPE(TENSOR) :: lsig
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta) ! horizontal dimension for vertical fault
-    Lp=L*(1._8+2._8*beta) ! depth for a vertical fault
-
-    px3=fix(Lp/dx3)
-    px2=fix(Wp/dx2)
-
-    ALLOCATE(patch(px2+1,px3+1),STAT=status)
-    IF (status>0) STOP "could not allocate the slip patches for export"
-
-    DO j3=1,px3+1
-       DO j2=1,px2+1
-
-          CALL ref2local(x,y,z,xr,yr,zr)
-          
-          ! no translation in out of plane direction
-          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
-          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
-          
-          CALL local2ref(xr,yr,zr,x1,x2,x3)
-          
-          ! discard out-of-bound locations
-          IF (  (x1 .gt. DBLE(sx1/2-1)*dx1) .or. (x1 .lt. -DBLE(sx1/2)*dx1) &
-           .or. (x2 .gt. DBLE(sx2/2-1)*dx2) .or. (x2 .lt. -DBLE(sx2/2)*dx2) &
-           .or. (x3 .gt. DBLE(sx3-1)*dx3) .or. (x3 .lt. 0._8)  ) THEN
-             lsig=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
-          ELSE
-             CALL sampletensor(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,sig,lsig)
-          END IF
-
-          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr,0._8,0._8,0._8,lsig)
-
-       END DO
-    END DO
-
-  CONTAINS
-
-    !--------------------------------------------------------------
-    !> subroutine sample
-    !! interpolates the value of a discretized 3-dimensional field
-    !! at a subpixel location. method consists in correlating the
-    !! 3D field with a delta function filter. the delta function is
-    !! approximated with a narrow normalized gaussian.
-    !!
-    !! \author sylvain barbot (10-17-07) - original form
-    !--------------------------------------------------------------
-    SUBROUTINE sampletensor(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,sig,lsig)
-      INTEGER, INTENT(IN) :: sx1,sx2,sx3
-      REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
-      TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-      TYPE(TENSOR), INTENT(OUT) :: lsig
-    
-      INTEGER :: i1,i2,i3,i,j,k,l1,l2,l3,i1p,i2p,i3p
-      INTEGER, PARAMETER :: RANGE=2
-      REAL*8 :: sum,weight,x,y,z
-      REAL*8, PARAMETER :: EPS=1e-2
-
-      sum=0._8
-      lsig=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
-
-      ! closest sample
-      CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i,j,k)
-      ! rounded coordinates of closest sample
-      CALL shiftedcoordinates(i,j,k,sx1,sx2,2*sx3,dx1,dx2,dx3,x,y,z)
-
-      ! no interpolation for node points
-      IF ( (abs(x-x1) .lt. EPS*dx1) .and. &
-           (abs(y-x2) .lt. EPS*dx2) .and. &
-           (abs(z-x3) .lt. EPS*dx3) ) THEN
-         lsig=sig(i,j,k)
-         RETURN
-      END IF
-
-      DO l3=-RANGE,+RANGE
-         ! no periodicity in the 3-direction
-         IF ((k+l3 .le. 0) .or. (k+l3 .gt. sx3)) CYCLE
-
-         IF (l3 .ge. 0) THEN
-            i3p=mod(k-1+l3,sx3)+1
-         ELSE
-            i3p=mod(sx3+k-1+l3,sx3)+1
-         END IF
-
-         DO l2=-RANGE,+RANGE
-            IF (l2 .ge. 0) THEN
-               i2p=mod(j-1+l2,sx2)+1
-            ELSE
-               i2p=mod(sx2+j-1+l2,sx2)+1
-            END IF
-
-            DO l1=-RANGE,+RANGE
-               IF (l1 .ge. 0) THEN
-                  i1p=mod(i-1+l1,sx1)+1
-               ELSE
-                  i1p=mod(sx1+i-1+l1,sx1)+1
-               END IF
-
-               weight=sinc(((x+l1*dx1)-x1)/dx1)*dx1 &
-                     *sinc(((y+l2*dx2)-x2)/dx2)*dx2 &
-                     *sinc(((z+l3*dx3)-x3)/dx3)*dx3
-
-               !weight=gauss((x+l1*dx1)-x1,dx1)*dx1 &
-               !      *gauss((y+l2*dx2)-x2,dx2)*dx2 &
-               !      *gauss((z+l3*dx3)-x3,dx3)*dx3
-
-               lsig=lsig.plus.(REAL(weight).times.sig(i1p,i2p,i3p))
-               sum  =sum  +weight
-
-            END DO
-         END DO
-      END DO
-      IF (sum .gt. 1e-6) lsig=REAL(1._8/sum).times.lsig
-
-    END SUBROUTINE sampletensor
-
-    !-----------------------------------------------
-    ! subroutine ref2local
-    ! convert reference Cartesian coordinates into
-    ! the rotated, local fault coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
-      REAL*8, INTENT(IN) :: x,y,z
-      REAL*8, INTENT(OUT) :: xp,yp,zp
-
-      REAL*8 :: x2
-
-      x2 = cstrike*x  -sstrike*y
-      xp = cdip   *x2 -sdip   *z
-      yp = sstrike*x  +cstrike*y
-      zp = sdip   *x2 +cdip   *z
-
-    END SUBROUTINE ref2local
-
-    !-----------------------------------------------
-    ! subroutine local2ref
-    ! converts a set of coordinates from the rotated
-    ! fault-aligned coordinate system into the
-    ! reference, Cartesian coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
-      REAL*8, INTENT(IN) :: xp,yp,zp
-      REAL*8, INTENT(OUT) :: x,y,z
-
-      REAL*8 :: x2p
-
-      x2p=  cdip*xp+sdip*zp
-      x  =  cstrike*x2p+sstrike*yp
-      y  = -sstrike*x2p+cstrike*yp
-      z  = -sdip*xp    +cdip*zp
-
-    END SUBROUTINE local2ref
-
-  END SUBROUTINE monitorstressfield
-
-  !---------------------------------------------------------------------
-  !> function MonitorField
-  !! samples a scalar field along a specified planar surface.
-  !!
-  !! \author sylvain barbot (10-16-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE monitorfield(x,y,z,L,W,strike,dip,beta, &
-       sx1,sx2,sx3,dx1,dx2,dx3,slip,patch)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(IN) :: slip
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(IN) :: slip
-#endif
-    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: patch
-
-    INTEGER :: px2,px3,j2,j3,status
-    REAL*8 :: x1,x2,x3,xr,yr,zr,Wp,Lp, &
-         cstrike,sstrike,cdip,sdip,value
-    TYPE(TENSOR) :: sig0
-
-    sig0=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta) ! horizontal dimension for vertical fault
-    Lp=L*(1._8+2._8*beta) ! depth for a vertical fault
-
-    px3=fix(Lp/dx3)
-    px2=fix(Wp/dx2)
-
-    ALLOCATE(patch(px2+1,px3+1),STAT=status)
-    IF (status>0) STOP "could not allocate the slip patches for export"
-
-    DO j3=1,px3+1
-       DO j2=1,px2+1
-
-          CALL ref2local(x,y,z,xr,yr,zr)
-          
-          ! no translation in out of plane direction
-          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
-          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
-          
-          CALL local2ref(xr,yr,zr,x1,x2,x3)
-          
-          ! discard out-of-bound locations
-          IF (  (x1 .gt. DBLE(sx1/2-1)*dx1) .or. (x1 .lt. -DBLE(sx1/2)*dx1) &
-           .or. (x2 .gt. DBLE(sx2/2-1)*dx2) .or. (x2 .lt. -DBLE(sx2/2)*dx2) &
-           .or. (x3 .gt. DBLE(sx3-1)*dx3) .or. (x3 .lt. 0._8)  ) THEN
-             value=0._8
-          ELSE
-             CALL sample(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,slip,value)
-          END IF
-
-          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr,value,0._8,0._8,sig0)
-
-       END DO
-    END DO
-
-  CONTAINS
-
-    !--------------------------------------------------------------
-    !> subroutine sample
-    !! interpolates the value of a discretized 3-dimensional field
-    !! at a subpixel location. method consists in correlating the
-    !! 3D field with a delta function filter. the delta function is
-    !! approximated with a narrow normalized gaussian.
-    !!
-    !! \author sylvain barbot (10-17-07) - original form
-    !--------------------------------------------------------------
-    SUBROUTINE sample(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,field,value)
-      INTEGER, INTENT(IN) :: sx1,sx2,sx3
-      REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
-      REAL*8, INTENT(OUT) :: value
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(IN) :: field
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(IN) :: field
-#endif
-    
-      INTEGER :: i1,i2,i3,i,j,k,l1,l2,l3,i1p,i2p,i3p
-      INTEGER, PARAMETER :: RANGE=2
-      REAL*8 :: sum,weight,x,y,z
-      REAL*8, PARAMETER :: EPS=1e-2
-
-      sum=0._8
-      value=0._8
-
-      ! closest sample
-      CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i,j,k)
-      ! rounded coordinates of closest sample
-      CALL shiftedcoordinates(i,j,k,sx1,sx2,2*sx3,dx1,dx2,dx3,x,y,z)
-
-      ! no interpolation for node points
-      IF ( (abs(x-x1) .lt. EPS*dx1) .and. &
-           (abs(y-x2) .lt. EPS*dx2) .and. &
-           (abs(z-x3) .lt. EPS*dx3) ) THEN
-         value=field(i,j,k)
-         RETURN
-      END IF
-
-      DO l3=-RANGE,+RANGE
-         ! no periodicity in the 3-direction
-         IF ((k+l3 .le. 0) .or. (k+l3 .gt. sx3)) CYCLE
-
-         IF (l3 .ge. 0) THEN
-            i3p=mod(k-1+l3,sx3)+1
-         ELSE
-            i3p=mod(sx3+k-1+l3,sx3)+1
-         END IF
-
-         DO l2=-RANGE,+RANGE
-            IF (l2 .ge. 0) THEN
-               i2p=mod(j-1+l2,sx2)+1
-            ELSE
-               i2p=mod(sx2+j-1+l2,sx2)+1
-            END IF
-
-            DO l1=-RANGE,+RANGE
-               IF (l1 .ge. 0) THEN
-                  i1p=mod(i-1+l1,sx1)+1
-               ELSE
-                  i1p=mod(sx1+i-1+l1,sx1)+1
-               END IF
-
-               weight=sinc(((x+l1*dx1)-x1)/dx1)*dx1 &
-                     *sinc(((y+l2*dx2)-x2)/dx2)*dx2 &
-                     *sinc(((z+l3*dx3)-x3)/dx3)*dx3
-
-               !weight=gauss((x+l1*dx1)-x1,dx1)*dx1 &
-               !      *gauss((y+l2*dx2)-x2,dx2)*dx2 &
-               !      *gauss((z+l3*dx3)-x3,dx3)*dx3
-
-               value=value+weight*field(i1p,i2p,i3p)
-               sum  =sum  +weight
-
-            END DO
-         END DO
-      END DO
-      IF (sum .gt. 1e-6) value=value/sum
-
-    END SUBROUTINE sample
-
-    !-----------------------------------------------
-    ! subroutine ref2local
-    ! convert reference Cartesian coordinates into
-    ! the rotated, local fault coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
-      REAL*8, INTENT(IN) :: x,y,z
-      REAL*8, INTENT(OUT) :: xp,yp,zp
-
-      REAL*8 :: x2
-
-      x2 = cstrike*x  -sstrike*y
-      xp = cdip   *x2 -sdip   *z
-      yp = sstrike*x  +cstrike*y
-      zp = sdip   *x2 +cdip   *z
-
-    END SUBROUTINE ref2local
-
-    !-----------------------------------------------
-    ! subroutine local2ref
-    ! converts a set of coordinates from the rotated
-    ! fault-aligned coordinate system into the
-    ! reference, Cartesian coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
-      REAL*8, INTENT(IN) :: xp,yp,zp
-      REAL*8, INTENT(OUT) :: x,y,z
-
-      REAL*8 :: x2p
-
-      x2p=  cdip*xp+sdip*zp
-      x  =  cstrike*x2p+sstrike*yp
-      y  = -sstrike*x2p+cstrike*yp
-      z  = -sdip*xp    +cdip*zp
-
-    END SUBROUTINE local2ref
-
-  END SUBROUTINE monitorfield
-
-  !-----------------------------------------------------------------
-  ! subroutine FieldAdd
-  ! computes in place the sum of two scalar fields
-  !
-  !   u = c1 * u + c2 * v
-  !
-  ! the function is useful to add fields of different sizes.
-  !
-  ! sylvain barbot (07/27/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE fieldadd(u,v,sx1,sx2,sx3,c1,c2)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: u
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
-    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
-
-    IF (PRESENT(c1)) THEN
-       IF (PRESENT(c2)) THEN
-          u=c1*u+c2*v
-       ELSE
-          u=c1*u+v
-       END IF
-    ELSE
-       IF (PRESENT(c2)) THEN
-          u=u+c2*v
-       ELSE
-          u=u+v
-       END IF
-    END IF
-
-  END SUBROUTINE fieldadd
-
-  !-----------------------------------------------------------------
-  ! subroutine FieldRep
-  !
-  !   u = c1 * v
-  !
-  ! the function is useful to add fields of different sizes.
-  !
-  ! sylvain barbot (07/27/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE fieldrep(u,v,sx1,sx2,sx3,c1)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: u
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
-    REAL*4, INTENT(IN), OPTIONAL :: c1
-
-    IF (PRESENT(c1)) THEN
-       u=u+c1*v
-    ELSE
-       u=v
-    END IF
-    
-  END SUBROUTINE fieldrep
-
-  !-----------------------------------------------------------------
-  ! subroutine SliveAdd
-  ! computes in place the sum of two scalar fields
-  !
-  !   u = c1 * u + c2 * v
-  !
-  ! the function is useful to add fields of different sizes.
-  !
-  ! sylvain barbot (10/24/08) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE sliceadd(u,v,sx1,sx2,sx3,index,c1,c2)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,index
-    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2) :: u
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
-    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
-
-    IF (PRESENT(c1)) THEN
-       IF (PRESENT(c2)) THEN
-          u=c1*u+c2*v(:,:,index)
-       ELSE
-          u=c1*u+v(:,:,index)
-       END IF
-    ELSE
-       IF (PRESENT(c2)) THEN
-          u=u+c2*v(:,:,index)
-       ELSE
-          u=u+v(:,:,index)
-       END IF
-    END IF
-
-  END SUBROUTINE sliceadd
-
-  !-----------------------------------------------------------------
-  !> subroutine TensorFieldAdd
-  !! computes the linear combination of two tensor fields
-  !!
-  !!     t1 = c1 * t1 + c2 * t2
-  !!
-  !! where t1 and t2 are two tensor fields and c1 and c2 are scalars.
-  !! only tensor field t1 is modified.
-  !
-  ! sylvain barbot (07/27/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE tensorfieldadd(t1,t2,sx1,sx2,sx3,c1,c2)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: t1
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: t2
-    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
-
-    INTEGER :: i1,i2,i3
-
-    IF (PRESENT(c1)) THEN
-       IF (PRESENT(c2)) THEN
-          IF (0._4 .eq. c1) THEN
-             IF (0._4 .eq. c2) THEN
-                DO 05 i3=1,sx3; DO 05 i2=1,sx2; DO 05 i1=1,sx1
-                   t1(i1,i2,i3)=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
-05                 CONTINUE
-             ELSE
-                DO 10 i3=1,sx3; DO 10 i2=1,sx2; DO 10 i1=1,sx1
-                   t1(i1,i2,i3)=c2 .times. t2(i1,i2,i3)
-10                 CONTINUE
-                END IF
-          ELSE
-             DO 20 i3=1,sx3; DO 20 i2=1,sx2; DO 20 i1=1,sx1
-                t1(i1,i2,i3)=(c1 .times. t1(i1,i2,i3)) .plus. &
-                             (c2 .times. t2(i1,i2,i3))
-20           CONTINUE
-          END IF
-       ELSE
-          DO 30 i3=1,sx3; DO 30 i2=1,sx2; DO 30 i1=1,sx1
-             t1(i1,i2,i3)=(c1 .times. t1(i1,i2,i3)) .plus. t2(i1,i2,i3)
-30           CONTINUE
-       END IF
-    ELSE
-       IF (PRESENT(c2)) THEN
-          DO 40 i3=1,sx3; DO 40 i2=1,sx2; DO 40 i1=1,sx1
-             t1(i1,i2,i3)=t1(i1,i2,i3) .plus. (c2 .times. t2(i1,i2,i3))
-40        CONTINUE
-       ELSE
-          DO 50 i3=1,sx3; DO 50 i2=1,sx2; DO 50 i1=1,sx1
-             t1(i1,i2,i3)=t2(i1,i2,i3) .plus. t2(i1,i2,i3)
-50        CONTINUE
-       END IF
-    END IF
-
-  END SUBROUTINE tensorfieldadd
-
-
-  !-----------------------------------------------------------------
-  ! subroutine TensorIntegrate
-  ! computes a numercial integration with numerical viscosity
-  !
-  !    T^(n+1)_i = (T^n_(i-1)+T^n_(i+1))/2 + dt * S^n_i
-  !
-  ! instead of
-  !
-  !    T^(n+1)_i = T^n_i + dt * S^n_i
-  !
-  ! implementation is just generalized for a 3-dimensional field.
-  !
-  ! sylvain barbot (07/27/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE tensorintegrate(T,S,sx1,sx2,sx3,dt)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: T
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: S
-    REAL*8, INTENT(IN) :: dt
-
-    INTEGER :: i1,i2,i3,i1m,i2m,i3m,i1p,i2p,i3p
-
-    DO i3=1,sx3
-       i3m=mod(sx3+i3-2,sx3)+1
-       i3p=mod(i3,sx3)+1
-       DO i2=1,sx2
-          i2m=mod(sx2+i2-2,sx2)+1
-          i2p=mod(i2,sx2)+1
-          DO i1=1,sx1
-             i1m=mod(sx1+i1-2,sx1)+1
-             i1p=mod(i1,sx1)+1
-             
-             T(i1,i2,i3)=( &
-                  (1._4/6._4) .times. (T(i1m,i2,i3) .plus. T(i1p,i2,i3) &
-                  .plus. T(i1,i2m,i3) .plus. T(i1,i2p,i3) &
-                  .plus. T(i1,i2,i3m) .plus. T(i1,i2,i3p))) &
-                  .plus. &
-                  (REAL(dt) .times. S(i1,i2,i3))
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE tensorintegrate
-
-  !---------------------------------------------------------------------
-  !> subroutine coordinates computes the xi coordinates from the
-  !! array index and sampling interval
-  !---------------------------------------------------------------------
-  SUBROUTINE coordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    REAL*8, INTENT(OUT) :: x1,x2,x3
-    
-    x1=DBLE(i1-sx1/2-1)*dx1
-    x2=DBLE(i2-sx2/2-1)*dx2
-    x3=DBLE(i3-sx3/2-1)*dx3
-  END SUBROUTINE coordinates
-
-  !---------------------------------------------------------------------
-  !> subroutine ShiftedCoordinates
-  !! computes the xi coordinates from the array index and sampling
-  !! interval assuming data is order like fftshift.
-  !!
-  !! \author sylvain barbot (07/31/07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
-    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    REAL*8, INTENT(OUT) :: x1,x2,x3
-
-    IF (i1 .LE. sx1/2) THEN
-       x1=DBLE(i1-1)*dx1
-    ELSE
-       x1=DBLE(i1-sx1-1)*dx1
-    END IF
-    IF (i2 .LE. sx2/2) THEN
-       x2=DBLE(i2-1)*dx2
-    ELSE
-       x2=DBLE(i2-sx2-1)*dx2
-    END IF
-    IF (i3 .LE. sx3/2) THEN
-       x3=DBLE(i3-1)*dx3
-    ELSE
-       x3=DBLE(i3-sx3-1)*dx3
-    END IF
-
-  END SUBROUTINE shiftedcoordinates
-
-  !----------------------------------------------------------------------
-  !> subroutine ShiftedIndex
-  !! returns the integer index corresponding to the specified coordinates
-  !! assuming the data are ordered following fftshift. input coordinates
-  !! are assumed bounded -sx/2 <= x <= sx/2-1. out of bound input
-  !! purposefully triggers a fatal error. in the x3 direction, coordinates
-  !! are assumed bounded by 0 <= x3 <= (sx3-1)*dx3
-  !!
-  !! CALLED BY:
-  !!   monitorfield/sample
-  !!
-  !! \author sylvain barbot (07/31/07) - original form
-  !----------------------------------------------------------------------
-  SUBROUTINE shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-    REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    INTEGER, INTENT(OUT) :: i1,i2,i3
-
-    IF (x1 .gt.  DBLE(sx1/2-1)*dx1) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("x1=",ES9.2E2,"; boundary at x1=",ES9.2E2)') x1, DBLE(sx1/2)*dx1
-       STOP "ShiftedIndex:invalid x1 coordinates (x1 too large)"
-    END IF
-    IF (x1 .lt. -DBLE(sx1/2)*dx1  ) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("x1=",ES9.2E2,"; boundary at x1=",ES9.2E2)') x1, -DBLE(sx1/2)*dx1
-       STOP "ShiftedIndex:coordinates out of range (-x1 too large)"
-    END IF
-    IF (x2 .gt.  DBLE(sx2/2-1)*dx2) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("x2=",ES9.2E2,"; boundary at x2=",ES9.2E2)') x2, DBLE(sx2/2)*dx2
-       STOP "ShiftedIndex:invalid x2 coordinates (x2 too large)"
-    END IF
-    IF (x2 .lt. -DBLE(sx2/2)*dx2  ) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("x2=",ES9.2E2,"; boundary at x2=",ES9.2E2)') x2, -DBLE(sx2/2)*dx2
-       STOP "ShiftedIndex:coordinates out of range (-x2 too large)"
-    END IF
-    IF (x3 .gt.  DBLE(sx3-1)*dx3) THEN
-       WRITE_DEBUG_INFO
-       STOP "ShiftedIndex:invalid x3 coordinates (x3 too large)"
-    END IF
-    IF (x3 .lt.  0              )   THEN
-       WRITE (0,'("x3=",ES9.2E2)') x3
-       STOP "ShiftedIndex:coordinates out of range (x3 negative)"
-    END IF
-
-    i1=MOD(sx1+fix(x1/dx1),sx1)+1
-    i2=MOD(sx2+fix(x2/dx2),sx2)+1
-    i3=fix(x3/dx3)+1
-
-  END SUBROUTINE shiftedindex
-
-  !-----------------------------------------------------------------
-  ! subroutine ExportSlice
-  ! computes the value of a scalar field at a horizontal plane.
-  ! the field if shifted such as the (0,0) coordinate is in the 
-  ! middle of the array at (sx1/2+1,sx2/2+1).
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE exportslice(field,odepth,dx1,dx2,dx3,s)
-    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: field
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,odepth
-    REAL*4, INTENT(OUT), DIMENSION(:,:) :: s
-    
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8 :: k3
-    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
-    COMPLEX*8 :: sum,exp3
-    REAL*4 :: exp1,exp2
-  
-    sx1=SIZE(field,1)-2
-    sx2=SIZE(field,2)
-    sx3=SIZE(field,3)
-    
-    s=0
-    DO i3=1,sx3
-       CALL wavenumber3(i3,sx3,dx3,k3)
-       exp3=exp(i*k3*odepth)
-       DO i2=1,sx2
-          DO i1=1,sx1/2+1
-             sum=CMPLX(field(2*i1-1,i2,i3),field(2*i1,i2,i3))*exp3
-             s(2*i1-1:2*i1,i2)=s(2*i1-1:2*i1,i2)+(/REAL(sum),AIMAG(sum)/)
-          END DO
-       END DO
-    END DO
-    s=s/(sx3*dx3)
-    
-    !fftshift
-    DO i2=1,sx2
-       IF (i2 < sx2/2+1) THEN
-          exp2= (i2-1._4)
-       ELSE
-          exp2=-(sx2-i2+1._4)
-       END IF
-       DO i1=1,sx1/2+1
-          exp1=i1-1._4
-          sum=CMPLX(s(2*i1-1,i2),s(2*i1,i2))*((-1._4)**(exp1+exp2))
-          s(2*i1-1:2*i1,i2)=(/REAL(sum),AIMAG(sum)/)
-       END DO
-    END DO
-    CALL fft2(s,sx1,sx2,dx1,dx2,FFT_INVERSE)
-    
-  END SUBROUTINE exportslice
-
-  !-----------------------------------------------------------------
-  !> subroutine ExportSpatial
-  !! transfer a horizontal layer from array 'data' to smaller array
-  !! 'p' and shift center position so that coordinates (0,0) are in
-  !! center of array 'p'. optional parameter 'doflip' generates
-  !! output compatible with grd binary format.
-  !
-  ! sylvain barbot (07/09/07) - original form
-  !                (03/19/08) - compatibility with grd output
-  !-----------------------------------------------------------------
-  SUBROUTINE exportspatial(data,sx1,sx2,p,doflip)
-    INTEGER, INTENT(IN) :: sx1,sx2
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2) :: data
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
-#endif
-    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p
-    LOGICAL, INTENT(IN), OPTIONAL :: doflip
-
-    INTEGER :: i1,i2,i1s,i2s
-    LOGICAL :: flip
-
-    IF (PRESENT(doflip)) THEN
-       flip=doflip
-    ELSE
-       flip=.false.
-    END IF
-
-    DO i2=1,sx2
-       IF (i2 .LE. sx2/2) THEN
-          i2s=sx2/2+i2
-       ELSE
-          i2s=i2-sx2/2
-       END IF
-       DO i1=1,sx1
-          IF (i1 .LE. sx1/2) THEN
-             i1s=sx1/2+i1
-          ELSE
-             i1s=i1-sx1/2
-          END IF
-
-          IF (flip) THEN
-             p(i2s,sx1-i1s+1)=data(i1,i2)
-          ELSE
-             p(i1s,i2s)=data(i1,i2)
-          END IF
-
-       END DO
-    END DO
-
-  END SUBROUTINE exportspatial
-
-END MODULE elastic3d
diff -r 405d8f4fa05f -r e7295294f654 examples/tutorials/run1-pbs.sh
--- a/examples/tutorials/run1-pbs.sh	Thu Mar 29 15:55:33 2012 -0700
+++ b/examples/tutorials/run1-pbs.sh	Sun Apr 01 14:02:51 2012 -0700
@@ -25,7 +25,7 @@ fi
 #   qsub ./run1-pbs.sh
 #
 
-mpiexec -n 8 relax <<EOF
+mpiexec -n 8 ../../build/relax <<EOF
 # use '#' character to include comments in your input file
 # grid size (sx1,sx2,sx3)
 256 256 256
diff -r 405d8f4fa05f -r e7295294f654 examples/tutorials/run1.sh
--- a/examples/tutorials/run1.sh	Thu Mar 29 15:55:33 2012 -0700
+++ b/examples/tutorials/run1.sh	Sun Apr 01 14:02:51 2012 -0700
@@ -66,4 +66,4 @@ if [ ! -e $WDIR ]; then
 	mkdir $WDIR
 fi
 
-OMP_NUM_THREADS=4 ../relax $* < run1.input | tee $WDIR/in.param
+OMP_NUM_THREADS=4 ../../build/relax $* < run1.input | tee $WDIR/in.param
diff -r 405d8f4fa05f -r e7295294f654 examples/tutorials/run2.sh
--- a/examples/tutorials/run2.sh	Thu Mar 29 15:55:33 2012 -0700
+++ b/examples/tutorials/run2.sh	Sun Apr 01 14:02:51 2012 -0700
@@ -23,4 +23,4 @@ if [ ! -e $WDIR ]; then
 	mkdir $WDIR
 fi
 
-OMP_NUM_THREADS=2 time ../relax --no-proj-output $* < run2.input | tee $WDIR/in.param
+OMP_NUM_THREADS=2 time ../../build/relax --no-proj-output $* < run2.input | tee $WDIR/in.param
diff -r 405d8f4fa05f -r e7295294f654 examples/tutorials/run3.sh
--- a/examples/tutorials/run3.sh	Thu Mar 29 15:55:33 2012 -0700
+++ b/examples/tutorials/run3.sh	Sun Apr 01 14:02:51 2012 -0700
@@ -86,4 +86,4 @@ if [ ! -e $WDIR ]; then
 	mkdir $WDIR
 fi
 
-time ../relax --no-proj-output --no-stress-output $* < run3.input | tee $WDIR/in.param
+time ../../build/relax --no-proj-output --no-stress-output $* < run3.input | tee $WDIR/in.param
diff -r 405d8f4fa05f -r e7295294f654 examples/tutorials/run4.sh
--- a/examples/tutorials/run4.sh	Thu Mar 29 15:55:33 2012 -0700
+++ b/examples/tutorials/run4.sh	Sun Apr 01 14:02:51 2012 -0700
@@ -43,4 +43,4 @@ if [ ! -e $WDIR ]; then
 	mkdir $WDIR
 fi
 
-time ../relax --no-stress-output --no-proj-output $* < run4.input | tee $WDIR/in.param
+time ../../build/relax --no-stress-output --no-proj-output $* < run4.input | tee $WDIR/in.param
diff -r 405d8f4fa05f -r e7295294f654 export.f90
--- a/export.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,2480 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-#include "include.f90"
-
-MODULE export
-
-  USE elastic3d
-  USE viscoelastic3d
-  USE friction3d
-
-  IMPLICIT NONE
-
-  PRIVATE xyzwrite
-  PRIVATE geoxyzwrite
-
-CONTAINS
-
-  !-------------------------------------------------------------------
-  ! routine ReportTime
-  ! writes the times of exports
-  !
-  ! sylvain barbot (04/29/09) - original form
-  !-------------------------------------------------------------------
-  SUBROUTINE reporttime(i,t,repfile)
-    INTEGER, INTENT(IN) :: i
-    CHARACTER(80), INTENT(IN) :: repfile
-    REAL*8, INTENT(IN) :: t
-
-    INTEGER :: iostatus
-
-    IF (0 .eq. i) THEN
-       OPEN (UNIT=15,FILE=repfile,IOSTAT=iostatus,FORM="FORMATTED")
-    ELSE
-       OPEN (UNIT=15,FILE=repfile,POSITION="APPEND",&
-            IOSTAT=iostatus,FORM="FORMATTED")
-    END IF
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', repfile
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'(ES11.3E2)') t
-
-    CLOSE(15)
-
-  END SUBROUTINE reporttime
-
-  SUBROUTINE report(i,t,file1,file2,file3,sx1,sx2,repfile)
-    INTEGER, INTENT(IN) :: i,sx1,sx2
-    CHARACTER(80), INTENT(IN) :: file1,file2,file3,repfile
-    REAL*8, INTENT(IN) :: t
-
-    INTEGER :: iostatus, ind1,ind2,ind3
-
-    IF (0 .eq. i) THEN
-       OPEN (UNIT=15,FILE=repfile,IOSTAT=iostatus,FORM="FORMATTED")
-    ELSE
-       OPEN (UNIT=15,FILE=repfile,POSITION="APPEND",&
-            IOSTAT=iostatus,FORM="FORMATTED")
-    END IF
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', repfile
-       STOP "could not open file for export"
-    END IF
-
-    ind1=INDEX(file1," ")
-    ind2=INDEX(file2," ")
-    ind3=INDEX(file3," ")
-    WRITE (15,'(I3.3,2I6," ",f13.4," ",a," ",a," ",a)') i,sx1,sx2,t,&
-         file1(1:ind1-1),file2(1:ind2-1),file3(1:ind3-1)
-
-    CLOSE(15)
-
-  END SUBROUTINE report
-
-  SUBROUTINE export2d(data,sx1,sx2,filename)
-    INTEGER, INTENT(IN) :: sx1,sx2
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
-    CHARACTER(80), INTENT(IN) :: filename
-
-    INTEGER :: iostatus,i1,i2
-    CHARACTER(15) :: form
-    CHARACTER(5) :: digit
-
-    WRITE (digit,'(I5.5)') sx1
-    form="("//digit//"ES11.3E2)"
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,form) ((data(i1,i2), i1=1,sx1), i2=1,sx2)
-    CLOSE(15)
-
-  END SUBROUTINE export2d
-
-  !------------------------------------------------------------------
-  ! subroutine geoxyzwrite
-  !
-  ! sylvain barbot (22/05/10) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE geoxyzwrite(x,y,z,sx1,sx2,filename)
-    INTEGER, INTENT(IN) :: sx1,sx2
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: z
-    REAL*8, INTENT(IN), DIMENSION(sx1,sx2) :: x,y
-    CHARACTER(80), INTENT(IN) :: filename
-
-    INTEGER :: iostatus,i1,i2
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) STOP "could not open file for proj export"
-
-    DO i2=1,sx2
-       DO i1=1,sx1
-          WRITE (15,'(ES15.8E1,ES15.8E1,ES11.3E2)'), &
-                 x(i1,i2),y(i1,i2),z(i1,i2)
-       END DO
-    END DO
-    CLOSE(15)
-
-  END SUBROUTINE geoxyzwrite
-
-  !------------------------------------------------------------------
-  ! subroutine xyzwrite
-  !
-  ! sylvain barbot (06/10/09) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE xyzwrite(data,sx1,sx2,dx1,dx2,filename)
-    INTEGER, INTENT(IN) :: sx1,sx2
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
-    CHARACTER(80), INTENT(IN) :: filename
-    REAL*8 :: dx1,dx2
-
-    INTEGER :: iostatus,i1,i2
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) STOP "could not open file for export"
-
-    DO i2=1,sx2
-       DO i1=1,sx1
-          !x1=(mod(sx1/2+i1-1,sx1)-sx1/2)*dx1
-          !x2=(mod(sx2/2+i2-1,sx2)-sx2/2)*dx2
-          WRITE (15,'(ES11.3E2,ES11.3E2,ES11.3E2)'), &
-                DBLE(i2-1-sx2/2)*dx2,DBLE(i1-1-sx1/2)*dx1,data(i1,i2)
-       END DO
-    END DO
-    CLOSE(15)
-
-  END SUBROUTINE xyzwrite
-
-#ifdef PROJ
-  !------------------------------------------------------------------
-  !> subroutine ExportStressPROJ
-  !! export a map view of stress with coordinates in 
-  !! longitude/latitude. Text format output is the GMT-compatible
-  !! .xyz file format where data in each file is organized as follows
-  !!
-  !! longitude latitude s11 
-  !! longitude latitude s12
-  !! longitude latitude s13
-  !! longitude latitude s22
-  !! longitude latitude s23
-  !! longitude latitude s33
-  !!
-  !! this is an interface to exportproj.
-  !!
-  !! \author sylvain barbot (05/22/10) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportstressproj(sig,sx1,sx2,sx3,dx1,dx2,dx3,oz, &
-                              x0,y0,lon0,lat0,zone,scale,wdir,index)
-    INTEGER, INTENT(IN) :: index,sx1,sx2,sx3,zone
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3,x0,y0,lon0,lat0,scale
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
-    INTEGER :: iostatus,i,j,k,l
-
-    ALLOCATE(t1(sx1+2,sx2),t2(sx1+2,sx2),t3(sx1+2,sx2),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for grid export"
-
-    k=fix(oz/dx3)+1
-    DO j=1,sx2
-       DO i=1,sx1
-#ifdef ALIGN_DATA
-          l=(j-1)*(sx1+2)+i
-#else
-          l=(j-1)*sx1+i
-#endif
-          t1(l,1)=sig(i,j,k)%s11
-          t2(l,1)=sig(i,j,k)%s12
-          t3(l,1)=sig(i,j,k)%s13
-       END DO
-    END DO
-
-    CALL exportproj(t1,t2,t3,sx1,sx2,1,dx1,dx2,dx3,0._8, &
-                  x0,y0,lon0,lat0,zone,scale,wdir,index,convention=4)
-
-    DO j=1,sx2
-       DO i=1,sx1
-#ifdef ALIGN_DATA
-          l=(j-1)*(sx1+2)+i
-#else
-          l=(j-1)*sx1+i
-#endif
-          t1(l,1)=sig(i,j,k)%s22
-          t2(l,1)=sig(i,j,k)%s23
-          t3(l,1)=sig(i,j,k)%s33
-       END DO
-    END DO
-
-    CALL exportproj(t1,t2,t3,sx1,sx2,1,dx1,dx2,dx3,0._8, &
-                  x0,y0,lon0,lat0,zone,scale,wdir,index,convention=5)
-
-    DEALLOCATE(t1,t2,t3)
-
-  END SUBROUTINE exportstressproj
-
-  !------------------------------------------------------------------
-  !> subroutine ExportPROJ
-  !! export a map view of displacements with coordinates in 
-  !! longitude/latitude. Text format output is the GMT-compatible
-  !! .xyz file format where data in each file is organized as follows
-  !!
-  !! longitude latitude u1, 
-  !! longitude latitude u2 and 
-  !! longitude latitude -u3
-  !!
-  !! for index-geo-north.xyz, 
-  !!     index-geo-east.xyz and 
-  !!     index-geo-up.xyz, respectively.
-  !!
-  !! \author sylvain barbot (05/22/10) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportproj(c1,c2,c3,sx1,sx2,sx3,dx1,dx2,dx3,oz, &
-                        x0,y0,lon0,lat0,zone,scale,wdir,i,convention)
-    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3,zone
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-#endif
-    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3,x0,y0,lon0,lat0,scale
-    CHARACTER(80), INTENT(IN) :: wdir
-    INTEGER, INTENT(IN), OPTIONAL :: convention
-
-    INTEGER :: iostatus,i1,i2,pos,conv
-    CHARACTER(3) :: digit
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
-    REAL*8, DIMENSION(:,:), ALLOCATABLE :: x,y
-    CHARACTER(80) :: file1,file2,file3
-    REAL*8 :: lon1,lat1
-
-    IF (PRESENT(convention)) THEN
-       conv=convention
-    ELSE
-       conv=1
-    END IF
-
-    lon1=lon0
-    lat1=lat0
-
-    ALLOCATE(t1(sx1,sx2),t2(sx1,sx2),t3(sx1,sx2), &
-             x(sx1,sx2),y(sx1,sx2),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for export"
-
-    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,t1)
-    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,t2)
-    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,t3)
-    t3=-t3
-
-    ! grid coordinates (x=easting, y=northing)
-    DO i2=1,sx2
-       DO i1=1,sx1
-          y(i1,i2)=(i1-sx1/2)*(dx1*scale)+x0
-          x(i1,i2)=(i2-sx2/2)*(dx2*scale)+y0
-       END DO
-    END DO
-    CALL proj(x,y,sx1*sx2,lon1,lat1,zone)
-
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-    SELECT CASE(conv)
-    CASE (1) ! cumulative displacement
-       file1=wdir(1:pos-1) // "/" // digit // "-geo-north.xyz"
-       file2=wdir(1:pos-1) // "/" // digit // "-geo-east.xyz"
-       file3=wdir(1:pos-1) // "/" // digit // "-geo-up.xyz"
-    CASE (2) ! postseismic displacement
-       file1=wdir(1:pos-1) // "/" // digit // "-relax-geo-north.xyz"
-       file2=wdir(1:pos-1) // "/" // digit // "-relax-geo-east.xyz"
-       file3=wdir(1:pos-1) // "/" // digit // "-relax-geo-up.xyz"
-    CASE (3) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-north.xyz"
-       file2=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-east.xyz"
-       file3=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-up.xyz"
-    CASE (4) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-geo-s11.xyz"
-       file2=wdir(1:pos-1) // "/" // digit // "-geo-s12.xyz"
-       file3=wdir(1:pos-1) // "/" // digit // "-geo-s13.xyz"
-    CASE (5) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-geo-s22.xyz"
-       file2=wdir(1:pos-1) // "/" // digit // "-geo-s23.xyz"
-       file3=wdir(1:pos-1) // "/" // digit // "-geo-s33.xyz"
-    END SELECT
-    
-    CALL geoxyzwrite(x,y,t1,sx1,sx2,file1)
-    CALL geoxyzwrite(x,y,t2,sx1,sx2,file2)
-    CALL geoxyzwrite(x,y,t3,sx1,sx2,file3)
-
-    DEALLOCATE(t1,t2,t3)
-
-  END SUBROUTINE exportproj
-#endif
-
-#ifdef XYZ
-  !------------------------------------------------------------------
-  !> subroutine ExportXYZ
-  !! export a map view of surface displacement into the GMT-compatible
-  !! .xyz file format where data in each file is organized as follows
-  !!
-  !! x1 x2 u1, x1 x2 u2 and x1 x2 -u3
-  !!
-  !! for index-north.xyz, index-east.xyz and index-up.xyz, 
-  !! respectively.
-  !!
-  !! \author sylvain barbot (06/10/09) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportxyz(c1,c2,c3,sx1,sx2,sx3,oz,dx1,dx2,dx3,i,wdir)
-    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-#endif
-    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    INTEGER :: iostatus,pos
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
-    CHARACTER(80) :: file1,file2,file3
-    CHARACTER(3) :: digit
-
-    ALLOCATE(temp1(sx1,sx2),temp2(sx1,sx2),temp3(sx1,sx2),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for export"
-
-    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1)
-    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2)
-    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3)
-    temp3=-temp3
-
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-    file1=wdir(1:pos-1) // "/" // digit // "-north.xyz"
-    file2=wdir(1:pos-1) // "/" // digit // "-east.xyz"
-    file3=wdir(1:pos-1) // "/" // digit // "-up.xyz"
-
-    CALL xyzwrite(temp1,sx1,sx2,dx1,dx2,file1)
-    CALL xyzwrite(temp2,sx1,sx2,dx1,dx2,file2)
-    CALL xyzwrite(temp3,sx1,sx2,dx1,dx2,file3)
-
-    DEALLOCATE(temp1,temp2,temp3)
-
-  END SUBROUTINE exportxyz
-#endif
-
-#ifdef TXT
-  !------------------------------------------------------------------
-  ! subroutine ExportTXT
-  ! exports a horizontal slice of uniform depth into specified text
-  ! files and adds filenames in the report file.
-  ! if i is set to 0, the report file is reinitiated.
-  ! input data c1,c2,c3 are in the space domain.
-  !------------------------------------------------------------------
-  SUBROUTINE exporttxt(c1,c2,c3,sx1,sx2,sx3,oz,dx3,i,time,wdir,reportfilename)
-    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-#endif
-    REAL*8, INTENT(IN) :: oz,dx3,time
-    CHARACTER(80), INTENT(IN) :: wdir,reportfilename
-
-    INTEGER :: iostatus,pos
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
-    CHARACTER(3) :: digit
-    CHARACTER(80) :: file1,file2,file3
-    
-    ALLOCATE(temp1(sx1,sx2),temp2(sx1,sx2),temp3(sx1,sx2),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for export"
-
-    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1)
-    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2)
-    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3)
-
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-    file1=wdir(1:pos-1) // "/" // digit // "-u1.txt"
-    file2=wdir(1:pos-1) // "/" // digit // "-u2.txt"
-    file3=wdir(1:pos-1) // "/" // digit // "-u3.txt"
-    
-    CALL export2d(temp1,sx1,sx2,file1)
-    CALL export2d(temp2,sx1,sx2,file2)
-    CALL export2d(temp3,sx1,sx2,file3)
-    
-    file1=digit // "-u1.txt "
-    file2=digit // "-u2.txt "
-    file3=digit // "-u3.txt "
-    CALL report(i,time,file1,file2,file3,sx1,sx2,reportfilename)
-
-    DEALLOCATE(temp1,temp2,temp3)
-
-  END SUBROUTINE exporttxt
-#endif
-
-  !------------------------------------------------------------------
-  !> subroutine exportpoints
-  !! sample a vector field at a series of points for export.
-  !! each location is attributed a file in which the time evolution
-  !! of the vector value is listed in the format:
-  !!
-  !!                t_0 u(t_0) v(t_0) w(t_0)
-  !!                t_1 u(t_1) v(t_1) w(t_1)
-  !!                ...
-  !!
-  !! \author sylvain barbot (11/10/07) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportpoints(c1,c2,c3,sig,sx1,sx2,sx3,dx1,dx2,dx3, &
-       opts,ptsname,time,wdir,isnew,x0,y0,rot)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-#endif
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(VECTOR_STRUCT), INTENT(IN), DIMENSION(:) :: opts
-    CHARACTER(LEN=4), INTENT(IN), DIMENSION(:) :: ptsname
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,time,x0,y0,rot
-    CHARACTER(80), INTENT(IN) :: wdir
-    LOGICAL, INTENT(IN) :: isnew
-
-    INTEGER :: i1,i2,i3,n,k
-    REAL*8 :: u1,u2,u3,v1,v2,v3,x1,x2,x3,y1,y2,y3
-    TYPE(TENSOR) :: lsig
-    INTEGER :: i,iostatus
-    CHARACTER(80) :: file1,file2
-
-    i=INDEX(wdir," ")
-    n=SIZE(ptsname)
-
-    DO k=1,n
-       file1=wdir(1:i-1) // "/" // ptsname(k) // ".txt"
-       file2=wdir(1:i-1) // "/" // ptsname(k) // ".c.txt"
-
-       IF (isnew) THEN
-          OPEN (UNIT=15,FILE=file1,IOSTAT=iostatus,FORM="FORMATTED")
-          WRITE (15,'("#         t         u1         u2         u3        ", &
-                      "s11        s12        s13        s22        s23        s33")')
-          OPEN (UNIT=16,FILE=file2,IOSTAT=iostatus,FORM="FORMATTED")
-       ELSE
-          OPEN (UNIT=15,FILE=file1,POSITION="APPEND",&
-               IOSTAT=iostatus,FORM="FORMATTED")
-          OPEN (UNIT=16,FILE=file2,POSITION="APPEND",&
-               IOSTAT=iostatus,FORM="FORMATTED")
-       END IF
-       IF (iostatus>0) STOP "could not open point file for writing"
-
-       x1=opts(k)%v1
-       x2=opts(k)%v2
-       x3=opts(k)%v3
-
-       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-
-       u1=c1(i1,i2,i3)
-       u2=c2(i1,i2,i3)
-       u3=c3(i1,i2,i3)
-       lsig=sig(i1,i2,i3)
-
-       ! change from computational reference frame to user reference system
-       y1=x1;v1=u1
-       y2=x2;v2=u2
-       y3=x3;v3=u3
-
-       CALL rotation(y1,y2,-rot)
-       y1=y1+x0
-       y2=y2+y0
-       CALL rotation(v1,v2,-rot)
-
-       x1=x1+x0
-       x2=x2+y0
-
-       WRITE (15,'(13ES11.3E2)') time,v1,v2,v3, &
-                                 lsig%s11,lsig%s12,lsig%s13, &
-                                 lsig%s22,lsig%s23,lsig%s33
-       WRITE (16,'(7ES11.3E2)') x1,x2,x3,time,u1,u2,u3
-
-       CLOSE(15)
-       CLOSE(16)
-    END DO
-
-  CONTAINS
-
-    !------------------------------------------------------------------
-    ! subroutine Rotation
-    ! rotates a point coordinate into the computational reference
-    ! system.
-    ! 
-    ! sylvain barbot (04/16/09) - original form
-    !------------------------------------------------------------------
-    SUBROUTINE rotation(x,y,rot)
-      REAL*8, INTENT(INOUT) :: x,y
-      REAL*8, INTENT(IN) :: rot
-
-      REAL*8 :: alpha,xx,yy
-      REAL*8, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
-
-
-      alpha=rot*DEG2RAD
-      xx=x
-      yy=y
-
-      x=+xx*cos(alpha)+yy*sin(alpha)
-      y=-xx*sin(alpha)+yy*cos(alpha)
-
-    END SUBROUTINE rotation
-
-  END SUBROUTINE exportpoints
-
-  !---------------------------------------------------------------------
-  !> subroutine exportoptsdat
-  !! export the coordinates and name of the observation points (often
-  !! coordinates of GPS instruments or such) for display with GMT in the
-  !! ASCII format. The file contains a list of x1,x2,x3 coordinates and
-  !! a 4-character name string.
-  !!
-  !! input variables
-  !! @param n          - number of observation points
-  !! @param opts       - coordinates of observation points
-  !! @param ptsname    - name of obs. points
-  !! @param filename   - output file (example: wdir/opts.xy)
-  !!
-  !! \author sylvain barbot (08/10/11) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE exportoptsdat(n,opts,ptsname,filename)
-    INTEGER, INTENT(IN) :: n
-    TYPE(VECTOR_STRUCT), DIMENSION(n) :: opts
-    CHARACTER(LEN=4), DIMENSION(n) :: ptsname
-    CHARACTER(80) :: filename
-
-    INTEGER :: k,iostatus
-
-    IF (n.LE.0) RETURN
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) STOP "could not open .xy file to export observation points"
-    DO k=1,n
-       WRITE (15,'(3ES11.4E1,X,a)') opts(k)%v1,opts(k)%v2,opts(k)%v3,ptsname(k)
-    END DO
-    CLOSE(15)
-    
-  END SUBROUTINE exportoptsdat
-    
-  !---------------------------------------------------------------------
-  !> subroutine exportPlaneStress
-  !! samples the value of an input tensor field at the location of 
-  !! defined plane (position, strike, dip, length and width).
-  !!
-  !! input variables
-  !! @param sig        - sampled tensor array
-  !! @param nop        - number of observation planes
-  !! @param op         - structure of observation planes (position, orientation)
-  !! @param x0, y0 - origin position of coordinate system
-  !! @param dx1,2,3    - sampling size
-  !! @param sx1,2,3    - size of the scalar field
-  !! @param wdir       - output directory for writing
-  !! @param i          - loop index to suffix file names
-  !!
-  !! creates files 
-  !!
-  !!    wdir/index.s00001.estrain.txt with TXT_EXPORTEIGENSTRAIN option
-  !!
-  !!    wdir/index.s00001.estrain.grd with GRD_EXPORTEIGENSTRAIN option
-  !! 
-  !! \author sylvain barbot (01/01/07) - original form
-  !                         (02/25/10) - output in TXT and GRD formats
-  !---------------------------------------------------------------------
-  SUBROUTINE exportplanestress(sig,nop,op,x0,y0,dx1,dx2,dx3,sx1,sx2,sx3,wdir,i)
-    INTEGER, INTENT(IN) :: nop,sx1,sx2,sx3,i
-    TYPE(PLANE_STRUCT), INTENT(IN), DIMENSION(nop) :: op
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    INTEGER :: k,ns1,ns2
-    TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: slippatch
-    CHARACTER(3) :: sdigit
-    CHARACTER(3) :: digit
-#ifdef TXT_EXPORTEIGENSTRAIN
-    INTEGER :: iostatus,i1,i2
-    CHARACTER(80) :: outfiletxt
-#endif
-!#_indef GRD_EXPORTEIGENSTRAIN
-    CHARACTER(80) :: fn11,fn12,fn13,fn22,fn23,fn33
-    INTEGER :: j,iostat,j1,j2
-    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp11,temp12,temp13, &
-                                           temp22,temp23,temp33
-    REAL*8 :: rland=9998.,rdum=9999.
-    REAL*8 :: xmin,ymin
-    CHARACTER(80) :: title="monitor tensor field "
-!#_endif
-
-    IF (nop .le. 0) RETURN
-
-    WRITE (digit,'(I3.3)') i
-
-    DO k=1,nop
-       CALL monitorstressfield(op(k)%x,op(k)%y,op(k)%z, &
-            op(k)%width,op(k)%length,op(k)%strike,op(k)%dip, &
-            0._8,sx1,sx2,sx3,dx1,dx2,dx3,sig,slippatch)
-
-       IF (.NOT. ALLOCATED(slippatch)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,'("could not monitor slip")')
-          STOP 2
-       END IF
-
-       ns1=SIZE(slippatch,1)
-       ns2=SIZE(slippatch,2)
-          
-       slippatch(:,:)%x1=slippatch(:,:)%x1+x0
-       slippatch(:,:)%x2=slippatch(:,:)%x2+y0
-
-       WRITE (sdigit,'(I3.3)') k
-
-!#_ifdef GRD_EXPORTEIGENSTRAIN
-       fn11=trim(wdir)//"/"//digit//".op"//sdigit//"-s11.grd"
-       fn12=trim(wdir)//"/"//digit//".op"//sdigit//"-s12.grd"
-       fn13=trim(wdir)//"/"//digit//".op"//sdigit//"-s13.grd"
-       fn22=trim(wdir)//"/"//digit//".op"//sdigit//"-s22.grd"
-       fn23=trim(wdir)//"/"//digit//".op"//sdigit//"-s23.grd"
-       fn33=trim(wdir)//"/"//digit//".op"//sdigit//"-s33.grd"
-
-       ! convert to c standard
-       j=INDEX(fn11," ")
-       fn11(j:j)=char(0)
-       fn12(j:j)=char(0)
-       fn13(j:j)=char(0)
-       fn22(j:j)=char(0)
-       fn23(j:j)=char(0)
-       fn33(j:j)=char(0)
-
-       ALLOCATE(temp11(ns1,ns2),temp12(ns1,ns2),temp13(ns1,ns2), &
-                temp22(ns1,ns2),temp23(ns1,ns2),temp33(ns1,ns2),STAT=iostat)
-       IF (iostatus>0) STOP "could not allocate temporary array for GRD slip export."
-
-       DO j2=1,ns2
-          DO j1=1,ns1
-             temp11(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s11
-             temp12(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s12
-             temp13(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s13
-             temp22(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s22
-             temp23(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s23
-             temp33(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s33
-          END DO
-       END DO
-
-       ! xmin is the lowest coordinates (positive eastward in GMT)
-       xmin= MINVAL(slippatch(:,:)%lx)
-       ! ymin is the lowest coordinates (positive northward in GMT)
-       ymin=-MAXVAL(slippatch(:,:)%lz)
-
-       ! call the c function "writegrd_"
-       CALL writegrd(temp11,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn11)
-       CALL writegrd(temp12,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn12)
-       CALL writegrd(temp13,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn13)
-       CALL writegrd(temp22,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn22)
-       CALL writegrd(temp23,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn23)
-       CALL writegrd(temp33,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn33)
-
-       DEALLOCATE(temp11,temp12,temp13,temp22,temp23,temp33)
-
-!#_endif
-
-       DEALLOCATE(slippatch)
-    END DO
-
-END SUBROUTINE exportplanestress
-
-  !---------------------------------------------------------------------
-  !> subroutine exportEigenstrain
-  !! samples the value of an input scalar field at the location of 
-  !! defined plane (position, strike, dip, length and width).
-  !!
-  !! input variables
-  !! @param field      - sampled scalar array
-  !! @param nop        - number of observation planes
-  !! @param op         - structure of observation planes (position, orientation)
-  !! @param x0, y0 - origin position of coordinate system
-  !! @param dx1,2,3    - sampling size
-  !! @param sx1,2,3    - size of the scalar field
-  !! @param wdir       - output directory for writing
-  !! @param i          - loop index to suffix file names
-  !!
-  !! creates files 
-  !!
-  !!    wdir/index.s00001.estrain.txt with TXT_EXPORTEIGENSTRAIN option
-  !!
-  !!    wdir/index.s00001.estrain.grd with GRD_EXPORTEIGENSTRAIN option
-  !! 
-  !! \author sylvain barbot (01/01/07) - original form
-  !                         (02/25/10) - output in TXT and GRD formats
-  !---------------------------------------------------------------------
-  SUBROUTINE exporteigenstrain(field,nop,op,x0,y0,dx1,dx2,dx3,sx1,sx2,sx3,wdir,i)
-    INTEGER, INTENT(IN) :: nop,sx1,sx2,sx3,i
-    TYPE(PLANE_STRUCT), INTENT(IN), DIMENSION(nop) :: op
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: field
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: field
-#endif
-    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    INTEGER :: k,ns1,ns2,pos
-    TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: slippatch
-    CHARACTER(5) :: sdigit
-    CHARACTER(3) :: digit
-#ifdef TXT_EXPORTEIGENSTRAIN
-    INTEGER :: iostatus,i1,i2
-    CHARACTER(80) :: outfiletxt
-#endif
-!#_indef GRD_EXPORTEIGENSTRAIN
-    CHARACTER(80) :: outfilegrd
-    INTEGER :: j,iostat,j1,j2
-    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp
-    REAL*8 :: rland=9998.,rdum=9999.
-    REAL*8 :: xmin,ymin
-    CHARACTER(80) :: title="monitor field "
-!#_endif
-
-    IF (nop .le. 0) RETURN
-
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-
-    DO k=1,nop
-       CALL monitorfield(op(k)%x,op(k)%y,op(k)%z, &
-            op(k)%width,op(k)%length,op(k)%strike,op(k)%dip, &
-            0._8,sx1,sx2,sx3,dx1,dx2,dx3,field,slippatch)
-
-       IF (.NOT. ALLOCATED(slippatch)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,'("could not monitor slip")')
-          STOP 2
-       END IF
-
-       ns1=SIZE(slippatch,1)
-       ns2=SIZE(slippatch,2)
-          
-       slippatch(:,:)%x1=slippatch(:,:)%x1+x0
-       slippatch(:,:)%x2=slippatch(:,:)%x2+y0
-
-       WRITE (sdigit,'(I5.5)') k
-#ifdef TXT_EXPORTEIGENSTRAIN
-       outfiletxt=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".estrain.txt"
-       
-       OPEN (UNIT=15,FILE=outfiletxt,IOSTAT=iostatus,FORM="FORMATTED")
-       IF (iostatus>0) STOP "could not open file for export"
-          
-       WRITE (15,'(6ES11.3E2)') ((slippatch(i1,i2), i1=1,ns1), i2=1,ns2)
-          
-       CLOSE(15)
-#endif
-
-!#_ifdef GRD_EXPORTEIGENSTRAIN
-       outfilegrd=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".estrain.grd"
-
-       ! convert to c standard
-       j=INDEX(outfilegrd," ")
-       outfilegrd(j:j)=char(0)
-
-       ALLOCATE(temp(ns1,ns2),STAT=iostat)
-       IF (iostatus>0) STOP "could not allocate temporary array for GRD slip export."
-
-       DO j2=1,ns2
-          DO j1=1,ns1
-             temp(ns1+1-j1,j2)=slippatch(j1,j2)%slip
-          END DO
-       END DO
-
-       ! xmin is the lowest coordinates (positive eastward in GMT)
-       xmin= MINVAL(slippatch(:,:)%lx)
-       ! ymin is the lowest coordinates (positive northward in GMT)
-       ymin=-MAXVAL(slippatch(:,:)%lz)
-
-       ! call the c function "writegrd_"
-       CALL writegrd(temp,ns1,ns2,ymin,xmin,dx3,dx2, &
-                     rland,rdum,title,outfilegrd)
-
-       DEALLOCATE(temp)
-
-!#_endif
-
-       DEALLOCATE(slippatch)
-    END DO
-
-END SUBROUTINE exporteigenstrain
-
-  !---------------------------------------------------------------------
-  !> subroutine exportCreep
-  !! evaluates the value of creep velocity at the location of 
-  !! defined plane (position, strike, dip, length and width).
-  !!
-  !! input variables
-  !! @param np         - number of frictional planes
-  !! @param n          - array of frictional planes (position, orientation)
-  !! @param structure  - array of depth-dependent frictional properties
-  !! @param x0, y0     - origin position of coordinate system
-  !! @param dx1,2,3    - sampling size
-  !! @param sx1,2,3    - size of the stress tensor field
-  !! @param beta       - smoothing factor controlling the extent of planes
-  !! @param wdir       - output directory for writing
-  !! @param i          - loop index to suffix file names
-  !!
-  !! creates files 
-  !!
-  !!    wdir/index.s00001.creep.txt 
-  !!
-  !! containing
-  !!
-  !!    x,y,z,x',y',sqrt(vx'^2+vy'^2),vx',vy'
-  !!
-  !! with TXT_EXPORTCREEP option and
-  !!
-  !!    wdir/index.s00001.creep-north.grd 
-  !!    wdir/index.s00001.creep-east.grd 
-  !!    wdir/index.s00001.creep-up.grd 
-  !!
-  !! with GRD_EXPORTCREEP option where the suffix -north stands for
-  !! dip slip, -east for strike slip and -up for amplitude of slip.
-  !!
-  !! file wdir/index.s00001.creep.txt is subsampled by a factor "skip"
-  !! compared to the grd files.
-  !! 
-  !! \author sylvain barbot (01/01/07) - original form
-  !!                        (02/25/10) - output in TXT and GRD formats
-  !---------------------------------------------------------------------
-#define TXT_EXPORTCREEP
-  SUBROUTINE exportcreep(np,n,beta,sig,structure, &
-                         sx1,sx2,sx3,dx1,dx2,dx3,x0,y0,wdir,i)
-    INTEGER, INTENT(IN) :: np,sx1,sx2,sx3,i
-    TYPE(PLANE_STRUCT), INTENT(IN), DIMENSION(np) :: n
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
-    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3,beta
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    INTEGER :: k,ns1,ns2,pos
-    TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: slippatch
-    CHARACTER(5) :: sdigit
-    CHARACTER(3) :: digit
-#ifdef TXT_EXPORTCREEP
-    CHARACTER(80) :: outfile
-    INTEGER :: skip=3
-#endif
-#ifdef GRD_EXPORTCREEP
-    INTEGER :: j,iostatus,i1,i2
-    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp1,temp2,temp3
-    REAL*8 :: rland=9998.,rdum=9999.
-    REAL*8 :: xmin,ymin
-    CHARACTER(80) :: title="monitor field "
-    CHARACTER(80) :: file1,file2,file3
-#endif
-
-    IF (np .le. 0) RETURN
-
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-
-    DO k=1,np
-       CALL monitorfriction(n(k)%x,n(k)%y,n(k)%z, &
-            n(k)%width,n(k)%length,n(k)%strike,n(k)%dip,n(k)%rake,beta, &
-            sx1,sx2,sx3,dx1,dx2,dx3,sig,structure,slippatch)
-
-       ns1=SIZE(slippatch,1)
-       ns2=SIZE(slippatch,2)
-          
-       slippatch(:,:)%x1=slippatch(:,:)%x1+x0
-       slippatch(:,:)%x2=slippatch(:,:)%x2+y0
-
-       WRITE (sdigit,'(I5.5)') k
-#ifdef TXT_EXPORTCREEP
-       outfile=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep.txt"
-       
-       OPEN (UNIT=15,FILE=outfile,IOSTAT=iostatus,FORM="FORMATTED")
-       IF (iostatus>0) STOP "could not open file for export"
-          
-       WRITE (15,'("#        x1         x2         x3          yr        yz", &
-                   "       slip strike-slip  dip-slip")')
-       WRITE (15,'(8ES11.3E2)') ((slippatch(i1,i2), i1=1,ns1,skip), i2=1,ns2,skip)
-          
-       CLOSE(15)
-#endif
-
-#ifdef GRD_EXPORTCREEP
-       file1=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-north.grd"
-       file2=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-east.grd"
-       file3=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-up.grd"
-
-       ! convert to c standard
-       j=INDEX(file1," ")
-       file1(j:j)=char(0)
-       j=INDEX(file2," ")
-       file2(j:j)=char(0)
-       j=INDEX(file3," ")
-       file3(j:j)=char(0)
-
-       ALLOCATE(temp1(ns1,ns2),temp2(ns1,ns2),temp3(ns1,ns2),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate temporary arrays for GRD slip export."
-
-       DO i2=1,ns2
-          DO i1=1,ns1
-             temp1(ns1+1-i1,i2)=slippatch(i1,i2)%ds
-             temp2(ns1+1-i1,i2)=slippatch(i1,i2)%ss
-             temp3(ns1+1-i1,i2)=slippatch(i1,i2)%slip
-          END DO
-       END DO
-
-       ! xmin is the lowest coordinates (positive eastward in GMT)
-       xmin= MINVAL(slippatch(:,:)%lx)
-       ! ymin is the lowest coordinates (positive northward in GMT)
-       ymin=-MAXVAL(slippatch(:,:)%lz)
-
-       ! call the c function "writegrd_"
-       CALL writegrd(temp1,ns1,ns2,ymin,xmin,dx3,dx2, &
-                     rland,rdum,title,file1)
-       CALL writegrd(temp2,ns1,ns2,ymin,xmin,dx3,dx2, &
-                     rland,rdum,title,file2)
-       CALL writegrd(temp3,ns1,ns2,ymin,xmin,dx3,dx2, &
-                     rland,rdum,title,file3)
-
-       DEALLOCATE(temp1,temp2,temp3)
-
-#endif
-
-       DEALLOCATE(slippatch)
-    END DO
-
-END SUBROUTINE exportcreep
-
-#ifdef GRD
-  !------------------------------------------------------------------
-  !> subroutine ExportStressGRD
-  !! writes the 6 components of deformation in map view in the GMT
-  !! (Generic Mapping Tools) GRD binary format. This is an interface
-  !! to exportgrd.
-  !!
-  !! \author sylvain barbot 03/19/08 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportstressgrd(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
-                             oz,origx,origy,wdir,index)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,index
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,origx,origy,oz
-    CHARACTER(80), INTENT(IN) :: wdir
-
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
-    INTEGER :: iostatus,i,j,k,l
-
-    ALLOCATE(t1(sx1+2,sx2),t2(sx1+2,sx2),t3(sx1+2,sx2),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for grid export"
-
-    k=fix(oz/dx3)+1
-    DO j=1,sx2
-       DO i=1,sx1
-#ifdef ALIGN_DATA
-          l=(j-1)*(sx1+2)+i
-#else
-          l=(j-1)*sx1+i
-#endif
-          t1(l,1)=sig(i,j,k)%s11
-          t2(l,1)=sig(i,j,k)%s12
-          t3(l,1)=sig(i,j,k)%s13
-       END DO
-    END DO
-
-    CALL exportgrd(t1,t2,t3,sx1,sx2,1, &
-         dx1,dx2,dx3,0._8,origx,origy,wdir,index,convention=4)
-
-    DO j=1,sx2
-       DO i=1,sx1
-#ifdef ALIGN_DATA
-          l=(j-1)*(sx1+2)+i
-#else
-          l=(j-1)*sx1+i
-#endif
-          t1(l,1)=sig(i,j,k)%s22
-          t2(l,1)=sig(i,j,k)%s23
-          t3(l,1)=sig(i,j,k)%s33
-       END DO
-    END DO
-
-    CALL exportgrd(t1,t2,t3,sx1,sx2,1, &
-         dx1,dx2,dx3,0._8,origx,origy,wdir,index,convention=5)
-
-    DEALLOCATE(t1,t2,t3)
-
-  END SUBROUTINE exportstressgrd
-
-
-  !------------------------------------------------------------------
-  !> subroutine ExportGRD
-  !! writes the 3 components of deformation in map view in the GMT
-  !! (Generic Mapping Tools) GRD binary format.
-  !!
-  !! \author sylvain barbot 03/19/08 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportgrd(c1,c2,c3,sx1,sx2,sx3,dx1,dx2,dx3,oz,origx,origy,&
-       wdir,i,convention)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,i
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
-#endif
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,origx,origy,oz
-    CHARACTER(80), INTENT(IN) :: wdir
-    INTEGER, INTENT(IN), OPTIONAL :: convention
-
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
-    REAL*8 :: rland=9998.,rdum=9999.
-    INTEGER :: iostatus,k,pos,conv
-    REAL*8 :: xmin,ymin
-    CHARACTER(80) :: file1,file2,file3
-    CHARACTER(3) :: digit
-
-    IF (PRESENT(convention)) THEN
-       conv=convention
-    ELSE
-       conv=1
-    END IF
-
-    ALLOCATE(temp1(sx2,sx1),temp2(sx2,sx1),temp3(sx2,sx1),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate memory for grid export"
-
-    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1,doflip=.true.)
-    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2,doflip=.true.)
-    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3,doflip=.true.)
-
-    ! positive up
-    temp3=-temp3
-    
-    pos=INDEX(wdir," ")
-    WRITE (digit,'(I3.3)') i
-    
-    SELECT CASE(conv)
-    CASE (1) ! cumulative displacement
-       file1=wdir(1:pos-1) // "/" // digit // "-north.grd"
-       file2=wdir(1:pos-1) // "/" // digit // "-east.grd"
-       file3=wdir(1:pos-1) // "/" // digit // "-up.grd"
-    CASE (2) ! postseismic displacement
-       file1=wdir(1:pos-1) // "/" // digit // "-relax-north.grd"
-       file2=wdir(1:pos-1) // "/" // digit // "-relax-east.grd"
-       file3=wdir(1:pos-1) // "/" // digit // "-relax-up.grd"
-    CASE (3) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-eqbf-north.grd"
-       file2=wdir(1:pos-1) // "/" // digit // "-eqbf-east.grd"
-       file3=wdir(1:pos-1) // "/" // digit // "-eqbf-up.grd"
-    CASE (4) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-s11.grd"
-       file2=wdir(1:pos-1) // "/" // digit // "-s12.grd"
-       file3=wdir(1:pos-1) // "/" // digit // "-s13.grd"
-    CASE (5) ! equivalent body forces
-       file1=wdir(1:pos-1) // "/" // digit // "-s22.grd"
-       file2=wdir(1:pos-1) // "/" // digit // "-s23.grd"
-       file3=wdir(1:pos-1) // "/" // digit // "-s33.grd"
-    END SELECT
-    
-    ! convert to c standard
-    k=INDEX(file1," ")
-    file1(k:k)=char(0)
-    k=INDEX(file2," ")
-    file2(k:k)=char(0)
-    k=INDEX(file3," ")
-    file3(k:k)=char(0)
-
-    ! xmin is the lowest coordinates (positive eastward)
-    xmin=origy-sx2/2*dx2
-    ! ymin is the lowest coordinates (positive northward)
-    ymin=origx-sx1/2*dx1
-
-    ! call the c function "writegrd_"
-    CALL writegrd(temp1,sx2,sx1,ymin,xmin,dx1,dx2, &
-         rland,rdum,file1,file1)
-    CALL writegrd(temp2,sx2,sx1,ymin,xmin,dx1,dx2, &
-         rland,rdum,file2,file2)
-    CALL writegrd(temp3,sx2,sx1,ymin,xmin,dx1,dx2, &
-         rland,rdum,file3,file3)
-
-    DEALLOCATE(temp1,temp2,temp3)
-
-  END SUBROUTINE exportgrd
-#endif
-
-#ifdef VTK
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_Grid
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! the dimension of the computational grid
-  !!
-  !! \author sylvain barbot 06/24/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_grid(sx1,sx2,sx3,dx1,dx2,dx3,cgfilename)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    CHARACTER(80), INTENT(IN) :: cgfilename
-
-    INTEGER :: iostatus
-    CHARACTER :: q
-
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=cgfilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', cgfilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <PolyData>")')
-    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"6",a,">")'),q,q,q,q
-    WRITE (15,'("      <Points>")')
-    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                            " Name=",a,"Comp. Grid",a, &
-                            " NumberOfComponents=",a,"3",a, &
-                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-    WRITE (15,'(24ES9.2E1)') &
-                 -sx1*dx1/2, -sx2*dx2/2, sx3*dx3/2, &
-                 +sx1*dx1/2, -sx2*dx2/2, sx3*dx3/2, &
-                 +sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &   
-                 -sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &
-                 -sx1*dx1/2, -sx2*dx2/2, 0.0, &
-                 +sx1*dx1/2, -sx2*dx2/2, 0.0, &
-                 +sx1*dx1/2, +sx2*dx2/2, 0.0, &
-                 -sx1*dx1/2, +sx2*dx2/2, 0.0
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Points>")')
-    WRITE (15,'("      <Polys>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                             " Name=",a,"connectivity",a, &
-                             " format=",a,"ascii",a, &
-                             " RangeMin=",a,"0",a, &
-                             " RangeMax=",a,"7",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("0 1 2 3 4 5 6 7 2 3 7 6 0 3 7 4 0 1 5 4 1 2 6 5")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                                  " Name=",a,"offsets",a, &
-                                  " format=",a,"ascii",a, &
-                                  " RangeMin=",a,"4",a, &
-                                  " RangeMax=",a,"24",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("          4 8 12 16 20 24")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Polys>")')
-    WRITE (15,'("    </Piece>")')
-    WRITE (15,'("  </PolyData>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_grid
-
-  !------------------------------------------------------------------
-  !> subroutine ExportXY_RFaults
-  !! creates a .xy file (in the GMT closed-polygon format) containing
-  !! the rectangular faults. Each fault segemnt is described by a
-  !! closed polygon (rectangle) associated with a slip amplitude.
-  !! use pxzy with the -Cpalette.cpt -L -M options to color rectangles 
-  !! by slip.
-  !!
-  !! \author sylvain barbot 03/05/11 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportxy_rfaults(e,x0,y0,rffilename)
-    TYPE(EVENT_STRUC), INTENT(IN) :: e
-    REAL*8, INTENT(IN) :: x0, y0
-    CHARACTER(80), INTENT(IN) :: rffilename
-
-    INTEGER :: iostatus,k
-    CHARACTER :: q
-
-    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W,slip
-         
-    REAL*8, DIMENSION(3) :: s,d
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', rffilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("> # east, north")')
-    DO k=1,e%ns
-
-       ! fault slip
-       slip=e%s(k)%slip
-
-       ! fault orientation
-       strike=e%s(k)%strike
-       dip=e%s(k)%dip
-
-       ! fault center position
-       x1=e%s(k)%x+x0
-       x2=e%s(k)%y+y0
-       x3=e%s(k)%z
-
-       ! fault dimension
-       W=e%s(k)%width
-       L=e%s(k)%length
-
-       cstrike=cos(strike)
-       sstrike=sin(strike)
-       cdip=cos(dip)
-       sdip=sin(dip)
- 
-       ! strike-slip unit direction
-       s(1)=sstrike
-       s(2)=cstrike
-       s(3)=0._8
-
-       ! dip-slip unit direction
-       d(1)=+cstrike*sdip
-       d(2)=-sstrike*sdip
-       d(3)=+cdip
-
-       ! fault edge coordinates - export east (x2) and north (x1)
-       WRITE (15,'("> -Z",3ES11.2)') ABS(slip)
-       WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2, x1-d(1)*W/2-s(1)*L/2
-       WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2, x1-d(1)*W/2+s(1)*L/2
-       WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2, x1+d(1)*W/2+s(1)*L/2
-       WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2, x1+d(1)*W/2-s(1)*L/2
-
-    END DO
-
-    CLOSE(15)
-
-  END SUBROUTINE exportxy_rfaults
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_RFaults
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! the rectangular faults. The faults are characterized with a set
-  !! of subsegments (rectangles) each associated with a slip vector. 
-  !!
-  !! \author sylvain barbot 06/24/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_rfaults(e,rffilename)
-    TYPE(EVENT_STRUC), INTENT(IN) :: e
-    CHARACTER(80), INTENT(IN) :: rffilename
-
-    INTEGER :: iostatus,k
-    CHARACTER :: q
-
-    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W,slip
-         
-    REAL*8, DIMENSION(3) :: s,d
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', rffilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <PolyData>")')
-
-    DO k=1,e%ns
-
-       ! fault slip
-       slip=e%s(k)%slip
-
-       ! fault orientation
-       strike=e%s(k)%strike
-       dip=e%s(k)%dip
-
-       ! fault center position
-       x1=e%s(k)%x
-       x2=e%s(k)%y
-       x3=e%s(k)%z
-
-       ! fault dimension
-       W=e%s(k)%width
-       L=e%s(k)%length
-
-       cstrike=cos(strike)
-       sstrike=sin(strike)
-       cdip=cos(dip)
-       sdip=sin(dip)
- 
-       ! strike-slip unit direction
-       s(1)=sstrike
-       s(2)=cstrike
-       s(3)=0._8
-
-       ! dip-slip unit direction
-       d(1)=+cstrike*sdip
-       d(2)=-sstrike*sdip
-       d(3)=+cdip
-
-       WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
-       WRITE (15,'("      <Points>")')
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                            " Name=",a,"Fault Patch",a, &
-                            " NumberOfComponents=",a,"3",a, &
-                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-
-       ! fault edge coordinates
-       WRITE (15,'(12ES11.2)') &
-                     x1-d(1)*W/2-s(1)*L/2,x2-d(2)*W/2-s(2)*L/2,x3-d(3)*W/2-s(3)*L/2, &
-                     x1-d(1)*W/2+s(1)*L/2,x2-d(2)*W/2+s(2)*L/2,x3-d(3)*W/2+s(3)*L/2, &
-                     x1+d(1)*W/2+s(1)*L/2,x2+d(2)*W/2+s(2)*L/2,x3+d(3)*W/2+s(3)*L/2, &
-                     x1+d(1)*W/2-s(1)*L/2,x2+d(2)*W/2-s(2)*L/2,x3+d(3)*W/2-s(3)*L/2
-
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("      </Points>")')
-       WRITE (15,'("      <Polys>")')
-       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                             " Name=",a,"connectivity",a, &
-                             " format=",a,"ascii",a, &
-                             " RangeMin=",a,"0",a, &
-                             " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
-       WRITE (15,'("0 1 2 3")')
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                                  " Name=",a,"offsets",a, &
-                                  " format=",a,"ascii",a, &
-                                  " RangeMin=",a,"4",a, &
-                                  " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
-       WRITE (15,'("          4")')
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("      </Polys>")')
-
-       WRITE (15,'("      <CellData Normals=",a,"slip",a,">")'), q,q
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"slip",a, &
-                                " NumberOfComponents=",a,"3",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-
-
-       WRITE (15,'(3ES11.2)'), (s(1)+d(1))*slip,(s(2)+d(2))*slip,(s(3)+s(3))*slip
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("      </CellData>")')
-
-       WRITE (15,'("    </Piece>")')
-
-    END DO
-
-    WRITE (15,'("  </PolyData>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_rfaults
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_RFaults_Stress_Init
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! the rectangular faults. The faults are characterized with a set
-  !! of subsegments (rectangles) each associated with stress values. 
-  !!
-  !! \author sylvain barbot 06/06/11 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE export_rfaults_stress_init(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
-                                           nsop,sop)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
-
-    INTEGER :: k,i1,i2,i3
-    REAL*8 :: x1,x2,x3
-    ! local value of stress
-    TYPE(TENSOR) :: lsig
-
-    DO k=1,nsop
-       ! fault center position
-       x1=sop(k)%x
-       x2=sop(k)%y
-       x3=sop(k)%z
-
-       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-       lsig=sig(i1,i2,i3)
-
-       sop(k)%sig0%s11=lsig%s11
-       sop(k)%sig0%s12=lsig%s12
-       sop(k)%sig0%s13=lsig%s13
-       sop(k)%sig0%s22=lsig%s22
-       sop(k)%sig0%s23=lsig%s23
-       sop(k)%sig0%s33=lsig%s33
-
-    END DO
-
-  END SUBROUTINE export_rfaults_stress_init
-
-  !------------------------------------------------------------------
-  !> subroutine ExportGMT_RFaults_Stress
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! the rectangular faults. The faults are characterized with a set
-  !! of subsegments (rectangles) each associated with stress values. 
-  !!
-  !! \author sylvain barbot 06/06/11 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportgmt_rfaults_stress(sx1,sx2,sx3,dx1,dx2,dx3, &
-                          nsop,sop,rffilename,convention,sig)
-    USE elastic3d
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
-    CHARACTER(80), INTENT(IN) :: rffilename
-    INTEGER, INTENT(IN), OPTIONAL :: convention
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3), OPTIONAL :: sig
-
-    INTEGER :: iostatus,k,i1,i2,i3,conv
-    CHARACTER :: q
-    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
-    ! segment normal vector, strike direction, dip direction
-    REAL*8, DIMENSION(3) :: n,s,d
-    ! local value of stress
-    TYPE(TENSOR) :: lsig
-    ! stress components
-    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
-    ! friction coefficient
-    REAL*8 :: friction
-    ! traction components
-    REAL*8, DIMENSION(3) :: t,ts
-
-    IF (0.GE.nsop) RETURN
-
-    ! double-quote character
-    q=char(34)
-
-    IF (PRESENT(convention)) THEN
-       conv=convention
-    ELSE
-       conv=0
-    END IF
-
-    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', rffilename
-       STOP "could not open file for export"
-    END IF
-
-    DO k=1,nsop
-       ! friction coefficient
-       friction=sop(k)%friction
-
-       ! fault orientation
-       strike=sop(k)%strike
-       dip=sop(k)%dip
-
-       ! fault center position
-       x1=sop(k)%x
-       x2=sop(k)%y
-       x3=sop(k)%z
-
-       IF (PRESENT(sig)) THEN
-
-          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-          lsig=sig(i1,i2,i3)
-
-          IF (1.EQ.conv) THEN
-             lsig%s11=lsig%s11-sop(k)%sig0%s11
-             lsig%s12=lsig%s12-sop(k)%sig0%s12
-             lsig%s13=lsig%s13-sop(k)%sig0%s13
-             lsig%s22=lsig%s22-sop(k)%sig0%s22
-             lsig%s23=lsig%s23-sop(k)%sig0%s23
-             lsig%s33=lsig%s33-sop(k)%sig0%s33
-          END IF
-       ELSE
-          lsig=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
-       END IF
-
-       ! fault dimension
-       W=sop(k)%width
-       L=sop(k)%length
-
-       cstrike=cos(strike)
-       sstrike=sin(strike)
-       cdip=cos(dip)
-       sdip=sin(dip)
- 
-       ! surface normal vector components
-       n(1)=+cdip*cstrike
-       n(2)=-cdip*sstrike
-       n(3)=-sdip
-
-       ! strike-slip unit direction
-       s(1)=sstrike
-       s(2)=cstrike
-       s(3)=0._8
-
-       ! dip-slip unit direction
-       d(1)=+cstrike*sdip
-       d(2)=-sstrike*sdip
-       d(3)=+cdip
-
-       ! traction vector
-       t=lsig .tdot. n
-
-       ! signed normal component
-       taun=SUM(t*n)
-
-       ! shear traction
-       ts=t-taun*n
-
-       ! absolute value of shear component
-       taus=SQRT(SUM(ts*ts))
-
-       ! strike-direction shear component
-       taustrike=SUM(ts*s)
-
-       ! dip-direction shear component
-       taudip=SUM(ts*d)
-
-       ! Coulomb stress 
-       taucoulomb=taus+friction*taun
-
-       WRITE (15,'("> -Z",5ES11.2)') taus, taun, taucoulomb, taustrike, taudip
-       WRITE (15,'(3ES11.2)') x1-d(1)*W/2-s(1)*L/2, x2-d(2)*W/2-s(2)*L/2
-       WRITE (15,'(3ES11.2)') x1-d(1)*W/2+s(1)*L/2, x2-d(2)*W/2+s(2)*L/2
-       WRITE (15,'(3ES11.2)') x1+d(1)*W/2+s(1)*L/2, x2+d(2)*W/2+s(2)*L/2
-       WRITE (15,'(3ES11.2)') x1+d(1)*W/2-s(1)*L/2, x2+d(2)*W/2-s(2)*L/2
-
-    END DO
-
-    CLOSE(15)
-
-  END SUBROUTINE exportgmt_rfaults_stress
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_RFaults_Stress
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! the rectangular faults. The faults are characterized with a set
-  !! of subsegments (rectangles) each associated with stress values. 
-  !!
-  !! \author sylvain barbot 06/06/11 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_rfaults_stress(sx1,sx2,sx3,dx1,dx2,dx3, &
-                          nsop,sop,rffilename,convention,sig)
-    USE elastic3d
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
-    CHARACTER(80), INTENT(IN) :: rffilename
-    INTEGER, INTENT(IN), OPTIONAL :: convention
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3), OPTIONAL :: sig
-
-    INTEGER :: iostatus,k,i1,i2,i3,conv
-    CHARACTER :: q
-    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
-    ! segment normal vector, strike direction, dip direction
-    REAL*8, DIMENSION(3) :: n,s,d
-    ! local value of stress
-    TYPE(TENSOR) :: lsig
-    ! stress components
-    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
-    ! friction coefficient
-    REAL*8 :: friction
-    ! traction components
-    REAL*8, DIMENSION(3) :: t,ts
-
-    IF (0.GE.nsop) RETURN
-
-    ! double-quote character
-    q=char(34)
-
-    IF (PRESENT(convention)) THEN
-       conv=convention
-    ELSE
-       conv=0
-    END IF
-
-    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', rffilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <PolyData>")')
-
-    DO k=1,nsop
-       ! friction coefficient
-       friction=sop(k)%friction
-
-       ! fault orientation
-       strike=sop(k)%strike
-       dip=sop(k)%dip
-
-       ! fault center position
-       x1=sop(k)%x
-       x2=sop(k)%y
-       x3=sop(k)%z
-
-       IF (PRESENT(sig)) THEN
-
-          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-          lsig=sig(i1,i2,i3)
-
-          IF (1.EQ.conv) THEN
-             lsig%s11=lsig%s11-sop(k)%sig0%s11
-             lsig%s12=lsig%s12-sop(k)%sig0%s12
-             lsig%s13=lsig%s13-sop(k)%sig0%s13
-             lsig%s22=lsig%s22-sop(k)%sig0%s22
-             lsig%s23=lsig%s23-sop(k)%sig0%s23
-             lsig%s33=lsig%s33-sop(k)%sig0%s33
-          END IF
-       ELSE
-          lsig=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
-       END IF
-
-       ! fault dimension
-       W=sop(k)%width
-       L=sop(k)%length
-
-       cstrike=cos(strike)
-       sstrike=sin(strike)
-       cdip=cos(dip)
-       sdip=sin(dip)
- 
-       ! surface normal vector components
-       n(1)=+cdip*cstrike
-       n(2)=-cdip*sstrike
-       n(3)=-sdip
-
-       ! strike-slip unit direction
-       s(1)=sstrike
-       s(2)=cstrike
-       s(3)=0._8
-
-       ! dip-slip unit direction
-       d(1)=+cstrike*sdip
-       d(2)=-sstrike*sdip
-       d(3)=+cdip
-
-       ! traction vector
-       t=lsig .tdot. n
-
-       ! signed normal component
-       taun=SUM(t*n)
-
-       ! shear traction
-       ts=t-taun*n
-
-       ! absolute value of shear component
-       taus=SQRT(SUM(ts*ts))
-
-       ! strike-direction shear component
-       taustrike=SUM(ts*s)
-
-       ! dip-direction shear component
-       taudip=SUM(ts*d)
-
-       ! Coulomb stress 
-       taucoulomb=taus+friction*taun
-
-       WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
-       WRITE (15,'("      <Points>")')
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                            " Name=",a,"Fault Patch",a, &
-                            " NumberOfComponents=",a,"3",a, &
-                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-       ! fault edge coordinates
-       WRITE (15,'(12ES11.2)') &
-                     x1-d(1)*W/2-s(1)*L/2, x2-d(2)*W/2-s(2)*L/2, x3-d(3)*W/2-s(3)*L/2, &
-                     x1-d(1)*W/2+s(1)*L/2, x2-d(2)*W/2+s(2)*L/2, x3-d(3)*W/2+s(3)*L/2, &
-                     x1+d(1)*W/2+s(1)*L/2, x2+d(2)*W/2+s(2)*L/2, x3+d(3)*W/2+s(3)*L/2, &
-                     x1+d(1)*W/2-s(1)*L/2, x2+d(2)*W/2-s(2)*L/2, x3+d(3)*W/2-s(3)*L/2
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("      </Points>")')
-       WRITE (15,'("      <Polys>")')
-       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                             " Name=",a,"connectivity",a, &
-                             " format=",a,"ascii",a, &
-                             " RangeMin=",a,"0",a, &
-                             " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
-       WRITE (15,'("0 1 2 3")')
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                                  " Name=",a,"offsets",a, &
-                                  " format=",a,"ascii",a, &
-                                  " RangeMin=",a,"4",a, &
-                                  " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
-       WRITE (15,'("          4")')
-       WRITE (15,'("        </DataArray>")')
-       WRITE (15,'("      </Polys>")')
-
-       WRITE (15,'("      <CellData Normals=",a,"stress",a,">")'), q,q
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"stress tensor",a, &
-                                " NumberOfComponents=",a,"6",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(6ES11.2)'), lsig%s11,lsig%s12,lsig%s13,lsig%s22,lsig%s23,lsig%s33
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"shear stress",a, &
-                                " NumberOfComponents=",a,"1",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(ES11.2)'), taus
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"normal stress",a, &
-                                " NumberOfComponents=",a,"1",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(ES11.2)'), taun
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"Coulomb stress",a, &
-                                " NumberOfComponents=",a,"1",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(ES11.2)'), taucoulomb
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"stress in strike direction",a, &
-                                " NumberOfComponents=",a,"1",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(ES11.2)'), taustrike
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                           	" Name=",a,"stress in dip direction",a, &
-                                " NumberOfComponents=",a,"1",a, &
-                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
-       WRITE (15,'(ES11.2)'), taudip
-       WRITE (15,'("        </DataArray>")')
-
-       WRITE (15,'("      </CellData>")')
-
-       WRITE (15,'("    </Piece>")')
-
-    END DO
-
-    WRITE (15,'("  </PolyData>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_rfaults_stress
-
-  !--------------------------------------------------------------------------------
-  !> subroutine ExportCoulombStress
-  !! sample the stress tensor, shear and normal stress and Coulomb
-  !! stress at a series of locations.
-  !!
-  !! each fault patch is attributed to a file in which the time 
-  !! evolution is listed in the following format:
-  !!
-  !! #t     s11     s12     s13     s22     s23     s33     taus     taud     tau     taun     Coulomb
-  !! t0 s11(t0) s12(t0) s13(t0) s22(t0) s23(t0) s33(t0) taus(t0) taud(t0) tau(t0) taun(t0) Coulomb(t0)
-  !! t1 s11(t1) s12(t1) s13(t1) s22(t1) s23(t1) s33(t1) taus(t1) taud(t1) tau(t1) taun(t1) Coulomb(t0)
-  !!    ...
-  !!
-  !! where sij(t0) is the component ij of the stress tensor at time t0, taus is
-  !! the component of shear in the strike direction, taud is the component of shear
-  !! in the fault dip direction, tau^2=taus^2+taud^2, taun is the fault normal
-  !! stress and Coulomb(t0) is the Coulomb stress tau+mu*taun. 
-  !!
-  !! \author sylvain barbot (10/05/11) - original form
-  !--------------------------------------------------------------------------------
-  SUBROUTINE exportcoulombstress(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
-                          nsop,sop,time,wdir,isnew)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,time
-    CHARACTER(80), INTENT(IN) :: wdir
-    LOGICAL, INTENT(IN) :: isnew
-
-    INTEGER :: iostatus,k,i1,i2,i3
-    CHARACTER :: q
-    CHARACTER(4) :: digit4
-    CHARACTER(80) :: file
-    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
-    ! segment normal vector, strike direction, dip direction
-    REAL*8, DIMENSION(3) :: n,s,d
-    ! local value of stress
-    TYPE(TENSOR) :: lsig
-    ! stress components
-    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
-    ! friction coefficient
-    REAL*8 :: friction
-    ! traction components
-    REAL*8, DIMENSION(3) :: t,ts
-
-    IF (0.GE.nsop) RETURN
-
-    ! double-quote character
-    q=char(34)
-
-    DO k=1,nsop
-       WRITE (digit4,'(I4.4)') k
-       file=trim(wdir)//"/cfaults-sigma-"//digit4//".txt"
-
-       ! fault center position
-       x1=sop(k)%x
-       x2=sop(k)%y
-       x3=sop(k)%z
-
-       IF (isnew) THEN
-          OPEN (UNIT=15,FILE=file,IOSTAT=iostatus,FORM="FORMATTED")
-          WRITE (15,'("# center position (north, east, down): ",3ES9.2)') x1,x2,x3
-          WRITE (15,'("#         t        s11        s12        s13        ", &
-          "s22        s23        s33       taus       taud        tau       taun    Coulomb")')
-       ELSE
-          OPEN (UNIT=15,FILE=file,POSITION="APPEND",&
-               IOSTAT=iostatus,FORM="FORMATTED")
-       END IF
-       IF (iostatus>0) STOP "could not open point file for writing"
-
-       ! friction coefficient
-       friction=sop(k)%friction
-
-       ! fault orientation
-       strike=sop(k)%strike
-       dip=sop(k)%dip
-
-       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-       lsig=sig(i1,i2,i3)
-
-       ! fault dimension
-       W=sop(k)%width
-       L=sop(k)%length
-
-       cstrike=cos(strike)
-       sstrike=sin(strike)
-       cdip=cos(dip)
-       sdip=sin(dip)
- 
-       ! surface normal vector components
-       n(1)=+cdip*cstrike
-       n(2)=-cdip*sstrike
-       n(3)=-sdip
-
-       ! strike-slip unit direction
-       s(1)=sstrike
-       s(2)=cstrike
-       s(3)=0._8
-
-       ! dip-slip unit direction
-       d(1)=+cstrike*sdip
-       d(2)=-sstrike*sdip
-       d(3)=+cdip
-
-       ! traction vector
-       t=lsig .tdot. n
-
-       ! signed normal component
-       taun=SUM(t*n)
-
-       ! shear traction
-       ts=t-taun*n
-
-       ! absolute value of shear component
-       taus=SQRT(SUM(ts*ts))
-
-       ! strike-direction shear component
-       taustrike=SUM(ts*s)
-
-       ! dip-direction shear component
-       taudip=SUM(ts*d)
-
-       ! Coulomb stress 
-       taucoulomb=taus+friction*taun
-
-       WRITE (15,'(12ES11.3E2)') time, &
-                                 lsig%s11,lsig%s12,lsig%s13, &
-                                 lsig%s22,lsig%s23,lsig%s33, &
-                                 taustrike,taudip,taus,taun,taucoulomb
-       CLOSE(15)
-    END DO
-
-  END SUBROUTINE exportcoulombstress
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_Rectangle
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! a rectangle.
-  !!
-  !! \author sylvain barbot 06/24/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_rectangle(x1,x2,x3,L,W,strike,dip,filename)
-    REAL*8 :: x1,x2,x3,L,W,strike,dip
-    CHARACTER(80), INTENT(IN) :: filename
-
-    INTEGER :: iostatus
-    CHARACTER :: q
-
-    REAL*8 :: cstrike,sstrike,cdip,sdip
-    REAL*8, DIMENSION(3) :: s,d
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', filename
-       STOP "could not open file for export in ExportVTK_Rectangle"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <PolyData>")')
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
- 
-    ! strike-slip unit direction
-    s(1)=sstrike
-    s(2)=cstrike
-    s(3)=0._8
-
-    ! dip-slip unit direction
-    d(1)=+cstrike*sdip
-    d(2)=-sstrike*sdip
-    d(3)=+cdip
-
-    WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
-    WRITE (15,'("      <Points>")')
-    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                         " Name=",a,"Fault Patch",a, &
-                         " NumberOfComponents=",a,"3",a, &
-                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-
-    ! fault edge coordinates
-    WRITE (15,'(12ES11.2)') &
-                  x1-d(1)*W/2-s(1)*L/2,x2-d(2)*W/2-s(2)*L/2,x3-d(3)*W/2-s(3)*L/2, &
-                  x1-d(1)*W/2+s(1)*L/2,x2-d(2)*W/2+s(2)*L/2,x3-d(3)*W/2+s(3)*L/2, &
-                  x1+d(1)*W/2+s(1)*L/2,x2+d(2)*W/2+s(2)*L/2,x3+d(3)*W/2+s(3)*L/2, &
-                  x1+d(1)*W/2-s(1)*L/2,x2+d(2)*W/2-s(2)*L/2,x3+d(3)*W/2-s(3)*L/2
-
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Points>")')
-    WRITE (15,'("      <Polys>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                          " Name=",a,"connectivity",a, &
-                          " format=",a,"ascii",a, &
-                          " RangeMin=",a,"0",a, &
-                          " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("0 1 2 3")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                               " Name=",a,"offsets",a, &
-                               " format=",a,"ascii",a, &
-                               " RangeMin=",a,"4",a, &
-                               " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("          4")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Polys>")')
-
-    WRITE (15,'("    </Piece>")')
-
-    WRITE (15,'("  </PolyData>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_rectangle
-
-  !------------------------------------------------------------------
-  !> subroutine ExportXY_Brick
-  !! creates a .xy file containing a brick (3d rectangle, cuboid).
-  !!
-  !! \author sylvain barbot 11/29/11 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportxy_brick(x1,x2,x3,L,W,T,strike,dip,filename)
-    REAL*8 :: x1,x2,x3,L,W,T,strike,dip
-    CHARACTER(80), INTENT(IN) :: filename
-
-    INTEGER :: iostatus
-
-    REAL*8 :: cstrike,sstrike,cdip,sdip
-    REAL*8, DIMENSION(3) :: s,d,n
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', filename
-       STOP "could not open file for export in ExportXY_Brick"
-    END IF
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
- 
-    ! strike-slip unit direction
-    s(1)=sstrike
-    s(2)=cstrike
-    s(3)=0._8
-
-    ! dip-slip unit direction
-    d(1)=+cstrike*sdip
-    d(2)=-sstrike*sdip
-    d(3)=+cdip
-
-    ! surface normal vector components
-    n(1)=+cdip*cstrike
-    n(2)=-cdip*sstrike
-    n(3)=-sdip
-
-    ! fault edge coordinates
-    WRITE (15,'(">")')
-    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x1-d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
-    WRITE (15,'(">")')
-    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x1+d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0
-    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
-
-    CLOSE(15)
-
-  END SUBROUTINE exportxy_brick
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_Brick
-  !! creates a .vtp file (in the VTK PolyData XML format) containing
-  !! a brick (3d rectangle, cuboid).
-  !!
-  !! \author sylvain barbot 06/24/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_brick(x1,x2,x3,L,W,T,strike,dip,filename)
-    REAL*8 :: x1,x2,x3,L,W,T,strike,dip
-    CHARACTER(80), INTENT(IN) :: filename
-
-    INTEGER :: iostatus
-    CHARACTER :: q
-
-    REAL*8 :: cstrike,sstrike,cdip,sdip
-    REAL*8, DIMENSION(3) :: s,d,n
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', filename
-       STOP "could not open file for export in ExportVTK_Brick"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <PolyData>")')
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
- 
-    ! strike-slip unit direction
-    s(1)=sstrike
-    s(2)=cstrike
-    s(3)=0._8
-
-    ! dip-slip unit direction
-    d(1)=+cstrike*sdip
-    d(2)=-sstrike*sdip
-    d(3)=+cdip
-
-    ! surface normal vector components
-    n(1)=+cdip*cstrike
-    n(2)=-cdip*sstrike
-    n(3)=-sdip
-
-    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
-    WRITE (15,'("      <Points>")')
-    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                         " Name=",a,"Weak Zone",a, &
-                         " NumberOfComponents=",a,"3",a, &
-                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-
-    ! fault edge coordinates
-    WRITE (15,'(24ES11.2)') &
-                  x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
-                  x1-d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x2-d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x2+d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x2+d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
-                  x1-d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x2-d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
-                  x1-d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x2-d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
-                  x1+d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x2+d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
-
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Points>")')
-    WRITE (15,'("      <Polys>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                          " Name=",a,"connectivity",a, &
-                          " format=",a,"ascii",a, &
-                          " RangeMin=",a,"0",a, &
-                          " RangeMax=",a,"6",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("7 4 5 6 7 4 3 2 7 2 1 6")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                               " Name=",a,"offsets",a, &
-                               " format=",a,"ascii",a, &
-                               " RangeMin=",a,"12",a, &
-                               " RangeMax=",a,"12",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("          12")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Polys>")')
-    WRITE (15,'("    </Piece>")')
-
-    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
-    WRITE (15,'("      <Points>")')
-    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
-                         " Name=",a,"Weak Zone",a, &
-                         " NumberOfComponents=",a,"3",a, &
-                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
-
-    ! fault edge coordinates
-    WRITE (15,'(24ES11.2)') &
-                  x1-d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
-                  x1-d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
-                  x1+d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
-                  x1-d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
-                  x1-d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
-                  x1+d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
-
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Points>")')
-    WRITE (15,'("      <Polys>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                          " Name=",a,"connectivity",a, &
-                          " format=",a,"ascii",a, &
-                          " RangeMin=",a,"0",a, &
-                          " RangeMax=",a,"7",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("0 1 2 3 0 5 4 3 0 1 6 5")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
-                               " Name=",a,"offsets",a, &
-                               " format=",a,"ascii",a, &
-                               " RangeMin=",a,"12",a, &
-                               " RangeMax=",a,"12",a,">")'), q,q,q,q,q,q,q,q,q,q
-    WRITE (15,'("          12")')
-    WRITE (15,'("        </DataArray>")')
-    WRITE (15,'("      </Polys>")')
-    WRITE (15,'("    </Piece>")')
-    WRITE (15,'("  </PolyData>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_brick
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_Vectors
-  !! creates a .vtr file (in the VTK Rectilinear XML format) 
-  !! containing a vector field.
-  !!
-  !! \author sylvain barbot 06/25/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_vectors(u1,u2,u3,sx1,sx2,sx3,dx1,dx2,dx3,j1,j2,j3,vcfilename)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,j1,j2,j3
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: u1,u2,u3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
-#endif
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    CHARACTER(80), INTENT(IN) :: vcfilename
-
-    INTEGER :: iostatus,idum,i1,i2,i3
-    CHARACTER :: q
-    INTEGER :: k1,k2,k3
-    REAL*8 :: x1,x2,x3
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=vcfilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', vcfilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"0.1",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"RectilinearGrid",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <RectilinearGrid WholeExtent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,sx3/j3,q
-    WRITE (15,'("  <Piece Extent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,sx3/j3,q
-    WRITE (15,'("    <PointData Scalars=",a,"Vector Field",a,">")') q,q
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"X Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write first component values
-    DO k3=0,sx3-1,j3
-       x3=REAL(k3,8)
-       DO k2=-sx2/2,sx2/2-1,j2
-          x2=REAL(k2,8)
-          DO k1=-sx1/2,sx1/2-1,j1
-             x1=REAL(k1,8)
-
-             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-             WRITE (15,'(ES12.2)') u1(i1,i2,k3+1)
-          END DO
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Y Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write second component values
-    DO k3=0,sx3-1,j3
-       x3=REAL(k3,8)
-       DO k2=-sx2/2,sx2/2-1,j2
-          x2=REAL(k2,8)
-          DO k1=-sx1/2,sx1/2-1,j1
-             x1=REAL(k1,8)
-
-             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-             WRITE (15,'(ES12.2)') u2(i1,i2,k3+1)
-
-          END DO
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Z Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write third component values
-    DO k3=0,sx3-1,j3
-       x3=REAL(k3,8)
-       DO k2=-sx2/2,sx2/2-1,j2
-          x2=REAL(k2,8)
-          DO k1=-sx1/2,sx1/2-1,j1
-             x1=REAL(k1,8)
-
-             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-             WRITE (15,'(ES12.2)') u3(i1,i2,k3+1)
-
-          END DO
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("  </PointData>")')
-
-    WRITE (15,'("  <Coordinates>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 1",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx1/2*dx1,q,q,(sx1/2-1)*dx1,q
-    DO k1=-sx1/2,sx1/2-1,j1
-       x1=REAL(k1,8)
-       WRITE (15,'(ES12.2)') x1*dx1
-    END DO
-    WRITE (15,'("    </DataArray>")')
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 2",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx2/2*dx2,q,q,(sx2/2-1)*dx2,q
-    DO k2=-sx2/2,sx2/2-1,j2
-       x2=REAL(k2,8)
-       WRITE (15,'(ES12.2)') x2*dx2
-    END DO
-    WRITE (15,'("    </DataArray>")')
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 3",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,0,q,q,(sx3-1)*dx3,q
-    DO k3=0,sx3-1,j3
-       x3=REAL(k3,8)
-       WRITE (15,'(ES12.2)') x3*dx3
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("  </Coordinates>")')
-    WRITE (15,'("</Piece>")')
-    WRITE (15,'("</RectilinearGrid>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_vectors
-
-  !------------------------------------------------------------------
-  !> subroutine ExportVTK_Vectors_Slice
-  !! creates a .vtr file (in the VTK Rectilinear XML format) 
-  !! containing a vector field.
-  !!
-  !! \author sylvain barbot 06/25/09 - original form
-  !------------------------------------------------------------------
-  SUBROUTINE exportvtk_vectors_slice(u1,u2,u3,sx1,sx2,sx3,dx1,dx2,dx3,oz,j1,j2,vcfilename)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,j1,j2
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: u1,u2,u3
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
-#endif
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,oz
-    CHARACTER(80), INTENT(IN) :: vcfilename
-
-    INTEGER :: iostatus,idum,i1,i2
-    CHARACTER :: q
-    INTEGER :: k1,k2,k3
-    REAL*8 :: x1,x2,x3
-
-    ! double-quote character
-    q=char(34)
-
-    OPEN (UNIT=15,FILE=vcfilename,IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       PRINT '(a)', vcfilename
-       STOP "could not open file for export"
-    END IF
-
-    WRITE (15,'("<?xml version=",a,"0.1",a,"?>")') q,q
-    WRITE (15,'("<VTKFile type=",a,"RectilinearGrid",a," version=",a,"0.1",a,">")') q,q,q,q
-    WRITE (15,'("  <RectilinearGrid WholeExtent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,1,q
-    WRITE (15,'("  <Piece Extent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,1,q
-    WRITE (15,'("    <PointData Scalars=",a,"Vector Field",a,">")') q,q
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"X Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write first component values
-    x3=oz/dx3
-    DO k2=-sx2/2,sx2/2-1,j2
-       x2=REAL(k2,8)
-       DO k1=-sx1/2,sx1/2-1,j1
-          x1=REAL(k1,8)
-
-          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-          WRITE (15,'(ES12.2)') u1(i1,i2,k3+1)
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Y Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write second component values
-    x3=oz/dx3
-    DO k2=-sx2/2,sx2/2-1,j2
-       x2=REAL(k2,8)
-       DO k1=-sx1/2,sx1/2-1,j1
-          x1=REAL(k1,8)
-
-          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-          WRITE (15,'(ES12.2)') u2(i1,i2,k3+1)
-
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Z Velocity",a, &
-                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
-
-    ! write third component values
-    x3=oz/dx3
-    DO k2=-sx2/2,sx2/2-1,j2
-       x2=REAL(k2,8)
-       DO k1=-sx1/2,sx1/2-1,j1
-          x1=REAL(k1,8)
-
-          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
-          WRITE (15,'(ES12.2)') u3(i1,i2,k3+1)
-
-       END DO
-    END DO
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("  </PointData>")')
-
-    WRITE (15,'("  <Coordinates>")')
-
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 1",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx1/2*dx1,q,q,(sx1/2-1)*dx1,q
-    DO k1=-sx1/2,sx1/2-1,j1
-       x1=REAL(k1,8)
-       WRITE (15,'(ES12.2)') x1*dx1
-    END DO
-    WRITE (15,'("    </DataArray>")')
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 2",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx2/2*dx1,q,q,(sx2/2-1)*dx2,q
-    DO k2=-sx2/2,sx2/2-1,j2
-       x2=REAL(k2,8)
-       WRITE (15,'(ES12.2)') x2*dx2
-    END DO
-    WRITE (15,'("    </DataArray>")')
-    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
-                        " Name=",a,"Array 3",a, &
-                        " format=",a,"ascii",a, &
-                        " RangeMin=",a,ES12.2,a, &
-                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,oz,q,q,oz,q
-    WRITE (15,'(2ES12.2)') oz
-    WRITE (15,'("    </DataArray>")')
-
-    WRITE (15,'("  </Coordinates>")')
-    WRITE (15,'("</Piece>")')
-    WRITE (15,'("</RectilinearGrid>")')
-    WRITE (15,'("</VTKFile>")')
-
-    CLOSE(15)
-
-  END SUBROUTINE exportvtk_vectors_slice
-#endif
-
-END MODULE export
diff -r 405d8f4fa05f -r e7295294f654 fourier.f90
--- a/fourier.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,631 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-#include "include.f90"
-
-MODULE fourier
-
-#ifdef IMKL_FFT
-  USE MKL_DFTI
-#endif
-
-  IMPLICIT NONE
-
-  PUBLIC
-
-#ifdef FFTW3
-  INCLUDE 'fftw3.f'
-#endif
-
-  INTEGER, PARAMETER :: FFT_FORWARD=-1,FFT_INVERSE=1
-
-CONTAINS
-
-  !---------------------------------------------------------------------
-  !> subroutine wavenumbers 
-  !! computes the values of the wavenumbers
-  !! in the sequential order required when using subroutine FOURT
-  !! to perform forward and backward inverse transforms.
-  !!
-  !! INPUT
-  !! @param i1 running index in the discrete Fourier domain array
-  !! @param i2 running index in the discrete Fourier domain array
-  !! @param i3 running index in the discrete Fourier domain array
-  !! @param sx1 number of elements in the x1-direction
-  !! @param sx2 number of elements in the x2-direction
-  !! @param sx3 number of elements in the x3-direction
-  !! @param dx1 sampling interval in the x1-direction
-  !! @param dx2 sampling interval in the x2-direction
-  !! @param dx3 sampling interval in the x3-direction
-  !!
-  !! OUTPUT
-  !! @param k1 wavenumber in the x1 direction
-  !! @param k2 wavenumber in the x2 direction
-  !! @param k3 wavenumber in the x3 direction
-  !!
-  !! \author sylvain barbot (04-14-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
-    INTEGER, INTENT(IN) :: i1, i2, i3, sx1, sx2, sx3
-    REAL*8, INTENT(IN) :: dx1, dx2, dx3
-    REAL*8, INTENT(OUT) :: k1, k2, k3
-    
-    IF (i3 < sx3/2+1) THEN
-       k3= (DBLE(i3)-1._8)/(sx3*dx3)
-    ELSE
-       k3=-(DBLE(sx3-i3)+1._8)/(sx3*dx3)
-    END IF
-    IF (i2 < sx2/2+1) THEN
-       k2= (DBLE(i2)-1._8)/(sx2*dx2)
-    ELSE
-       k2=-(DBLE(sx2-i2)+1._8)/(sx2*dx2)
-    END IF
-    k1=(DBLE(i1)-1._8)/(sx1*dx1)
-    
-  END SUBROUTINE wavenumbers
-
-  SUBROUTINE wavenumber1(i1,sx1,dx1,k1)
-    INTEGER, INTENT(IN) :: i1,sx1
-    REAL*8, INTENT(IN) :: dx1
-    REAL*8, INTENT(OUT) :: k1
-
-    k1=(DBLE(i1)-1._8)/(sx1*dx1)
-  END SUBROUTINE wavenumber1
-
-  SUBROUTINE wavenumber2(i2,sx2,dx2,k2)
-    INTEGER, INTENT(IN) :: i2,sx2
-    REAL*8, INTENT(IN) :: dx2
-    REAL*8, INTENT(OUT) :: k2
-    
-    IF (i2 < sx2/2+1) THEN
-       k2= (DBLE(i2)-1._8)/(sx2*dx2)
-    ELSE
-       k2=-(DBLE(sx2-i2)+1._8)/(sx2*dx2)
-    END IF
-  END SUBROUTINE wavenumber2
-
-  SUBROUTINE wavenumber3(i3,sx3,dx3,k3)
-    INTEGER, INTENT(IN) :: i3,sx3
-    REAL*8, INTENT(IN) :: dx3
-    REAL*8, INTENT(OUT) :: k3
-    
-    IF (i3 < sx3/2+1) THEN
-       k3= (DBLE(i3)-1._8)/(sx3*dx3)
-    ELSE
-       k3=-(DBLE(sx3-i3)+1._8)/(sx3*dx3)
-    END IF
-  END SUBROUTINE wavenumber3
-
-  !---------------------------------------------------------------------
-  ! subroutine FFTshift_TF applies the transfer function 
-  ! in the Fourier domain corresponding to shifting the space 
-  ! domain array by sx1*dx1/2 in the 1-direction and sx3*dx3/2 
-  ! in the 3-direction.
-  !
-  ! fftshift_tf follows the data storage convention in
-  ! agreement with DFT subroutine FOURT
-  !
-  ! sylvain barbot (05-01-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE fftshift_tf(spec)
-    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: spec
-    
-    INTEGER :: sx1, sx2, sx3, i1, i2, i3
-    REAL*4 :: exp1, exp2, exp3
-    
-    sx1=SIZE(spec, 1)-2
-    sx2=SIZE(spec, 2)
-    sx3=SIZE(spec, 3)
-    
-    DO i3=1,sx3
-       IF (i3 < sx3/2+1) THEN
-          exp3=-(DBLE(i3)-1._8)
-       ELSE
-          exp3= (DBLE(sx3-i3)+1._8)
-       END IF
-       DO i2=1,sx2
-          IF (i2 < sx2/2+1) THEN
-             exp2=-(DBLE(i2)-1._8)
-          ELSE
-             exp2= (DBLE(sx2-i2)+1._8)
-          END IF
-          DO i1=1,sx1/2+1
-             exp1=(DBLE(i1)-1._8)
-             spec(2*i1-1:2*i1,i2,i3) = &
-                  spec(2*i1-1:2*i1,i2,i3)*((-1._4)**(exp1+exp2+exp3))
-          END DO
-       END DO
-    END DO
-  END SUBROUTINE fftshift_tf
-
-  !----------------------------------------------------------------------
-  !> subroutine FFT3 performs normalized forward and
-  !! inverse fourier transforms of real 3d data
-  !
-  !! USES
-  !! ctfft (Brenner, 1968) by default
-  !! fftw3 (Frigo & Jonhson) with preproc FFTW3 flag
-  !! scfft (SGI library) with preproc SGI_FFT flag
-  !! ctfft (Cooley-Tuckey) by default (slowest FFT)
-  !!
-  !! for real array the fourier transform returns a sx1/2+1 complex array
-  !! and the enough space must be reserved
-  !----------------------------------------------------------------------
-#ifdef FFTW3
-  !--------------------------------------------------------
-  ! implementation of FFTW3
-  ! must be linked with -lfftw3f (single-threaded version)
-  !
-  ! sylvain barbot (09-28-08) - original form
-  !--------------------------------------------------------
-  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-
-    INTEGER*8 :: plan
-
-    IF (FFT_FORWARD == direction) THEN
-      CALL sfftw_plan_dft_r2c_3d(plan,sx1,sx2,sx3, &
-           data(1,1,1),data(1,1,1),FFTW_ESTIMATE)
-    ELSE
-      CALL sfftw_plan_dft_c2r_3d(plan,sx1,sx2,sx3, &
-           data(1,1,1),data(1,1,1),FFTW_ESTIMATE)
-    END IF
-
-    CALL sfftw_execute(plan)
-    CALL sfftw_destroy_plan(plan)
-
-   IF (FFT_INVERSE == direction) THEN
-     data=data/(sx1*dx1*sx2*dx2*sx3*dx3)
-   ELSE
-     data=data*(dx1*dx2*dx3)
-   END IF
-
-  END SUBROUTINE fft3
-#else
-#ifdef SGI_FFT
-  !--------------------------------------------------------------------
-  ! implementation of SGI SCFFT
-  ! must be linked with -L/usr/lib -lscs or -L/usr/lib -lscs_mp for
-  ! multithread version expect up x8 performance increase compared to
-  ! ctfft implementation. check out the SGI documentation at:
-  !
-  ! http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=linux&
-  !      db=man&fname=/usr/share/catman/man3/ccfft.3s.html&srch=ccfft
-  !
-  ! sylvain barbot (09-28-08) - original form
-  !--------------------------------------------------------------------
-  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
-    INTEGER, INTENT(IN) :: direction,sx1,sx2,sx3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-
-    INTEGER, PARAMETER :: NF=256, NFR=256
-
-    REAL*4, DIMENSION(sx1+NFR+(2*sx2+NF)+(2*sx3+NF)) :: table
-    REAL*4, DIMENSION(sx1+4*sx3) :: work
-    INTEGER, DIMENSION(2) :: isys
-    REAL*4 :: scale
-
-    isys(1)=1
-
-    IF (FFT_FORWARD == direction) THEN
-      scale=dx1*dx2*dx3
-      ! initialize the sin/cos table
-      CALL SCFFT3D(+0,sx1,sx2,sx3,scale,data(1,1,1),sx1+2,sx2, &
-                   data(1,1,1),sx1/2+1,sx2,table,work,isys)
-      CALL SCFFT3D(-1,sx1,sx2,sx3,scale,data(1,1,1),sx1+2,sx2, &
-                   data(1,1,1),sx1/2+1,sx2,table,work,isys)
-    ELSE
-      scale=1._4/(sx1*dx1*sx2*dx2*sx3*dx3)
-      ! initialize the sin/cos table
-      CALL CSFFT3D(+0,sx1,sx2,sx3,scale,data(1,1,1),sx1/2+1,sx2, &
-                   data(1,1,1),sx1+2,sx2,table,work,isys)
-      CALL CSFFT3D(+1,sx1,sx2,sx3,scale,data(1,1,1),sx1/2+1,sx2, &
-                   data(1,1,1),sx1+2,sx2,table,work,isys)
-    END IF
-
-  END SUBROUTINE fft3
-#else
-#ifdef IMKL_FFT
-  !-------------------------------------------------------------------------
-  ! implementation IMKL_FFT (Intel Math Kernel Library)
-  ! for information and example calculations with the
-  ! mkl FFT, see:
-  !
-  ! http://www.intel.com/software/products/mkl/docs/webhelp/appendices/ ...
-  !                      mkl_appC_DFT.html#appC-exC-25
-  !
-  ! and a thread (Fortran 3-D FFT real-to-complex ...)
-  ! on the intel forum
-  !
-  ! http://software.intel.com/en-us/forums/intel-math-kernel-library/
-  !
-  ! sylvain barbot (04-30-10) - original form
-  !-------------------------------------------------------------------------
-  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
-    REAL*4, DIMENSION(0:*), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
-
-    INTEGER :: iret,size(3),rstrides(4),cstrides(4)
-    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-    REAL*4 :: scale
-
-    rstrides=(/ 0,1,(sx1/2+1)*2,(sx1/2+1)*2*sx2 /)
-    cstrides=(/ 0,1,sx1/2+1,(sx1/2+1)*sx2 /)
-    size=(/ sx1,sx2,sx3 /)
-
-    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_REAL,3,size)
-    iret=DftiSetValue(desc,DFTI_CONJUGATE_EVEN_STORAGE,DFTI_COMPLEX_COMPLEX)
-
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-    IF (FFT_FORWARD == direction) THEN
-       scale=dx1*dx2*dx3
-       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
-       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,rstrides);
-       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,cstrides);
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeForward(desc,data)
-    ELSE
-       scale=1._4/(sx1*dx1*sx2*dx2*sx3*dx3)
-       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
-       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,cstrides);
-       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,rstrides);
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeBackward(desc,data)
-    END IF
-    iret=DftiFreeDescriptor(desc)
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-  END SUBROUTINE fft3
-#else
-  !------------------------------------------------------
-  ! implementation of ctfft (N. Brenner, 1968)
-  ! must be linked with ctfft.o
-  !------------------------------------------------------
-  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
-
-    INTEGER :: dim(3)
-    INTEGER :: FOURT_DS ! data storage
-    INTEGER, PARAMETER :: FOURT_NW = 128 ! extra work space size
-    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
-
-    dim=(/ sx1,sx2,sx3 /)
-
-    IF (FFT_FORWARD == direction) THEN
-       FOURT_DS=0
-    ELSE
-       FOURT_DS=-1
-    END IF
-    CALL ctfft(data,dim,3,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
-
-    IF (FFT_INVERSE == direction) THEN
-       data=data/(sx1*dx1*sx2*dx2*sx3*dx3)
-    ELSE
-       data=data*(dx1*dx2*dx3)
-    END IF
-
-  END SUBROUTINE fft3
-#endif
-#endif
-#endif
-  !----------------------------------------------------------------------
-  !> subroutine FFT2 performs normalized forward and
-  !! inverse fourier transforms of real 2d data
-  !!
-  !! USES subroutine FOURT
-  !! ctfft(data,n,ndim,isign,iform,work,nwork)
-  !! or
-  !! fftw3
-  !!
-  !! for real array the fourier transform returns a sx1/2+1 complex array
-  !! and the enough space must be reserved
-  !----------------------------------------------------------------------
-#ifdef FFTW3
-  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
-    INTEGER, INTENT(IN) :: sx1,sx2,direction
-    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2
-
-    INTEGER*8 :: plan
-
-    IF (FFT_FORWARD == direction) THEN
-      CALL sfftw_plan_dft_r2c_2d(plan,sx1,sx2, &
-           data(1,1),data(1,1),FFTW_ESTIMATE)
-    ELSE
-      CALL sfftw_plan_dft_c2r_2d(plan,sx1,sx2, &
-           data(1,1),data(1,1),FFTW_ESTIMATE)
-    END IF
-
-    CALL sfftw_execute(plan)
-    CALL sfftw_destroy_plan(plan)
-
-    IF (FFT_INVERSE == direction) THEN
-      data=data/(sx1*dx1*sx2*dx2)
-    ELSE
-      data=data*(dx1*dx2)
-    END IF
-
-  END SUBROUTINE fft2
-#else
-#ifdef SGI_FFT
-  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
-    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2
-    INTEGER, INTENT(IN) :: sx1,sx2,direction
-
-    INTEGER, PARAMETER :: NF=256, NFR=256
-
-    REAL*4, DIMENSION(sx1+NFR+2*sx2+NF) :: table
-    REAL*4, DIMENSION(sx1+4*sx2) :: work
-    INTEGER, DIMENSION(2) :: isys
-    REAL*4 :: scale
-
-    isys(1)=1
-
-    IF (FFT_FORWARD == direction) THEN
-       scale=dx1*dx2
-       ! initialize the sin/cos table
-       CALL SCFFT2D(+0,sx1,sx2,scale,data(1,1),sx1+2, &
-                    data(1,1),sx1/2+1,table,work,isys)
-       CALL SCFFT2D(-1,sx1,sx2,scale,data(1,1),sx1+2, &
-                    data(1,1),sx1/2+1,table,work,isys)
-    ELSE
-       scale=1._4/(sx1*dx1*sx2*dx2)
-       ! initialize the sin/cos table
-       CALL CSFFT2D(+0,sx1,sx2,scale,data(1,1),sx1/2+1, &
-                    data(1,1),sx1+2,table,work,isys)
-       CALL CSFFT2D(+1,sx1,sx2,scale,data(1,1),sx1/2+1, &
-                    data(1,1),sx1+2,table,work,isys)
-    END IF
-
-  END SUBROUTINE fft2
-#else
-#ifdef IMKL_FFT
-  !------------------------------------------------------
-  ! implementation IMKL_FFT (Intel Math Kernel Library)
-  ! for information and example calculations with the
-  ! mkl FFT, see:
-  !
-  ! http://www.intel.com/software/products/mkl/ ...
-  !                      docs/webhelp/appendices/ ...
-  !                      mkl_appC_DFT.html#appC-exC-25
-  !
-  ! sylvain barbot (04-30-10) - original form
-  !------------------------------------------------------
-  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
-    REAL*4, DIMENSION(0:*), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2
-    INTEGER, INTENT(IN) :: sx1,sx2,direction
-
-    INTEGER :: iret,size(2),rstrides(3),cstrides(3)
-    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-    REAL*4 :: scale
-
-    rstrides=(/ 0,1,sx1+2 /)
-    cstrides=(/ 0,1,sx1/2+1 /)
-    size=(/ sx1,sx2 /)
-
-    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_REAL,2,size);
-    iret=DftiSetValue(desc,DFTI_CONJUGATE_EVEN_STORAGE,DFTI_COMPLEX_COMPLEX)
-
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-    IF (FFT_FORWARD == direction) THEN
-       scale=dx1*dx2
-       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
-       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,rstrides);
-       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,cstrides);
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeForward(desc,data)
-    ELSE
-       scale=1._4/(sx1*dx1*sx2*dx2)
-       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
-       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,cstrides);
-       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,rstrides);
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeBackward(desc,data)
-    END IF
-    iret=DftiFreeDescriptor(desc)
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-  END SUBROUTINE fft2
-#else
-  !------------------------------------------------------
-  ! Couley-Tuckey implementation of the Fourier 
-  ! transform with built-in FFT code (ctfft.f).
-  !------------------------------------------------------
-  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
-    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx1,dx2
-    INTEGER, INTENT(IN) :: sx1,sx2,direction
-
-    INTEGER :: dim(2)
-    INTEGER :: FOURT_DS ! data storage
-    INTEGER, PARAMETER :: FOURT_NW = 64 ! extra work space size
-    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
-
-    dim=(/ sx1,sx2 /)
-
-    IF (FFT_FORWARD == direction) THEN
-       FOURT_DS=0
-    ELSE
-       FOURT_DS=-1
-    END IF
-    CALL ctfft(data,dim,2,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
-
-    IF (FFT_INVERSE == direction) THEN
-       data=data/(sx1*dx1*sx2*dx2)
-    ELSE
-       data=data*(dx1*dx2)
-    END IF
-
-  END SUBROUTINE fft2
-#endif
-#endif
-#endif
-
-  !-----------------------------------------------------------------
-  !> subroutine FFT1
-  !! performs a one dimensional complex to complex Fourier
-  !! transform
-  !!
-  !! uses complex DFT ctfft (N. Brenner, 1968) by default
-  !! or CCFFT (SGI library) with compile flag SGI_FFT
-  !!
-  !! \author sylvain barbot (05-02-07) - original form
-  !-----------------------------------------------------------------
-#ifdef SGI_FFT
-  !------------------------------------------------------
-  ! implementation CCFFT
-  !
-  ! sylvain barbot (09-28-08) - original form
-  !------------------------------------------------------
-  SUBROUTINE fft1(data,sx,dx,direction)
-    INTEGER, INTENT(IN) :: sx,direction
-    COMPLEX(KIND=4), DIMENSION(:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx
-
-    INTEGER, PARAMETER :: NF=256
-
-    REAL*4, DIMENSION(2*sx+NF) :: table
-    REAL*4, DIMENSION(2*sx) :: work
-    INTEGER, DIMENSION(2) :: isys
-    REAL*4 :: scale
-
-    isys(1)=1
-
-    IF (FFT_FORWARD == direction) THEN
-       scale=dx
-       ! initialize the sin/cos table
-       CALL CCFFT(+0,sx,scale,data,data,table,work,isys)
-       CALL CCFFT(-1,sx,scale,data,data,table,work,isys)
-    ELSE
-       scale=1._4/(sx*dx)
-       ! initialize the sin/cos table
-       CALL CCFFT(+0,sx,scale,data,data,table,work,isys)
-       CALL CCFFT(+1,sx,scale,data,data,table,work,isys)
-    END IF
-
-  END SUBROUTINE fft1
-#else
-#ifdef IMKL_FFT
-  !------------------------------------------------------
-  ! implementation IMKL_FFT (Intel Math Kernel Library)
-  ! evaluates a complex-to-complex Fourier transform
-  !
-  ! sylvain barbot (04-30-10) - original form
-  !------------------------------------------------------
-  SUBROUTINE fft1(data,sx,dx,direction)
-    INTEGER, INTENT(IN) :: sx,direction
-    COMPLEX(KIND=4), DIMENSION(0:*), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx
-
-    INTEGER :: iret
-    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-
-    REAL*4 :: scale
-
-    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_COMPLEX,1,sx)
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-    IF (FFT_FORWARD == direction) THEN
-       scale=dx
-       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeForward(desc,data)
-    ELSE
-       scale=1._4/(sx*dx)
-       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
-       iret=DftiCommitDescriptor(desc)
-       iret=DftiComputeBackward(desc,data)
-    END IF
-    iret=DftiFreeDescriptor(desc)
-    IF(iret.NE.0) THEN
-       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,*) DftiErrorMessage(iret)
-          STOP 1
-       END IF
-    END IF
-
-  END SUBROUTINE fft1
-#else
-  !----------------------------------------------------
-  ! implementation ctfft
-  !
-  ! sylvain barbot (05-02-07) - original form
-  !----------------------------------------------------
-  SUBROUTINE fft1(data,sx,dx,direction)
-    COMPLEX(KIND=4),DIMENSION(:), INTENT(INOUT) :: data
-    REAL*8, INTENT(IN) :: dx
-    INTEGER, INTENT(IN) :: sx,direction
-
-    INTEGER, PARAMETER :: FOURT_NW = 32 ! extra work space size
-    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
-    INTEGER :: FOURT_DS = 1
-
-    CALL ctfft(data,sx,1,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
-    IF (FFT_INVERSE == direction) THEN
-       data=data/(sx*dx)
-    ELSE
-       data=data*dx
-    END IF
-
-  END SUBROUTINE fft1
-#endif
-#endif
-
-END MODULE fourier
diff -r 405d8f4fa05f -r e7295294f654 friction3d.f90
--- a/friction3d.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,554 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-MODULE friction3d
-
-  USE elastic3d
-
-  IMPLICIT NONE
-
-#include "include.f90"
-
-  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
-  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
-  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
-
-CONTAINS
-
-  !-----------------------------------------------------------------
-  !> subroutine FrictionPlaneExpEigenStress
-  !!
-  !! *** this function is deprecated ***
-  !
-  ! compute the eigen-stress (forcing moment) to be relaxed by
-  ! rate-dependent inelastic deformation in the case of a frictional
-  ! surface:
-  !
-  !       sigma^i = C:F:sigma
-  !
-  ! where C is the elastic moduli tensor, F is the heterogeneous
-  ! fluidity moduli tensor and sigma is the instantaneous stress
-  ! tensor. for a frictional surface, the eigenstrain-rate is given
-  ! by
-  !
-  !       epsilon^i^dot = F:sigma = gamma^dot R
-  !
-  ! where gamma^dot is the slip rate (a scalar) and R is the
-  ! deviatoric, symmetric, and unitary, tensor:
-  !
-  !       R_ij = 1/2 ( t_i n_j + t_j n_i ) / sqrt( t_j t_j )
-  !
-  ! where the shear traction t_i is the projection of the traction
-  ! vector on the plane surface. the strain amplitude is given by
-  !
-  !       gamma^dot = vo sinh( taus / (t_c )
-  !
-  ! where taus is the effective shear on the fault plane,
-  !
-  !       taus = tau + mu*sigma
-  !
-  ! where tau is the shear and sigma the normal stress. tau and sigma
-  ! assumed to be the co-seismic change only, not the absolute
-  ! stress. vo is a reference slip velocity, and t_c, the critical
-  ! stress, corresponds to (a-b)*sigma in the framework of rate-and-
-  ! state friction. the effective viscosity eta* and the fluidity
-  !
-  !       eta* = tau / gamma^dot
-  !       fluidity = 1 / eta*
-  !
-  ! are used to compute the optimal time-step.
-  !
-  ! sylvain barbot (07/24/07) - original form
-  !                (07/24/07) - deprecated (see frictioneigenstress)
-  !-----------------------------------------------------------------
-  SUBROUTINE frictionplaneeigenstress(sig,mu,structure, &
-       n1,n2,n3,sx1,sx2,sx3,dx1,dx2,dx3,moment,maxwelltime,gamma,dt)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3
-    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: moment
-    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: n1,n2,n3
-    REAL*4, INTENT(OUT), DIMENSION(sx1+2,sx2,sx3), OPTIONAL :: gamma
-#else
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: n1,n2,n3
-    REAL*4, INTENT(OUT), DIMENSION(sx1,sx2,sx3), OPTIONAL :: gamma
-#endif
-    REAL*8, INTENT(IN), OPTIONAL :: dt
-
-    INTEGER :: i1,i2,i3
-    TYPE(TENSOR) :: s
-    REAL*8, DIMENSION(3) :: t,ts,n
-    REAL*8 :: vo,taue,tauc,taun,taus,gammadot,impulse, &
-         friction,tau,scaling,cohesion
-
-    ! delta function scaling
-    scaling=sqrt(pi2)*dx1
-
-    DO i3=1,sx3
-       
-       vo=structure(i3)%gammadot0
-       tauc=structure(i3)%stressexponent
-       friction=structure(i3)%friction
-       cohesion=structure(i3)%cohesion
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             n=(/ DBLE(n1(i1,i2,i3)),DBLE(n2(i1,i2,i3)),DBLE(n3(i1,i2,i3))/)
-             impulse=sqrt(sum(n*n))
-
-             IF (impulse .LE. 0.01_8/dx1) CYCLE
-
-             ! discrete delta function impulse
-             n=n/impulse
-             
-             ! traction = sigma . n
-             s=sig(i1,i2,i3)
-             t=s .tdot. n
-
-             ! signed normal component
-             taun=SUM(t*n)
-
-             ! absolute value of shear component
-             ts=t-taun*n
-             taus=SQRT(SUM(ts*ts))
-             
-             ! effective shear stress on fault plane
-             tau=taus+friction*taun
-
-             ! warning for wrong input
-             IF ((tau/tauc) .gt. 20) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("------------------------------------------")')
-                WRITE (0,'("wrong value of (a-b)sigma gives rise to")')
-                WRITE (0,'("(a-b)sigma=",3ES11.3E2)') tauc
-                WRITE (0,'("tau=",3ES11.3E2)') tau
-                WRITE (0,'("taus=",3ES11.3E2)') taus
-                WRITE (0,'("taun=",3ES11.3E2)') taun
-                WRITE (0,'("tau/((a-b)sigma)=",3ES11.3E2)') tau/tauc
-                WRITE (0,'("------------------------------------------")')
-                STOP 5
-             END IF
-
-             ! effective stress
-             taue=tau-cohesion
-
-             ! yield surface test
-             IF ((0._8 .GE. taus) .OR. (taue .LE. 1e-8)) CYCLE
-
-             ! shear traction direction
-             ts=ts/taus
-
-             ! deviatoric strain rate
-             gammadot=vo*2*sinh(taue/tauc)
-
-             IF (PRESENT(maxwelltime)) &
-                  maxwelltime=MIN(maxwelltime,taue/mu/gammadot)
-
-             ! provide the strain-rate on request
-             IF (PRESENT(gamma)) THEN
-                gamma(i1,i2,i3)=gamma(i1,i2,i3)+gammadot*impulse*scaling*dt
-             END IF
-
-             ! deviatoric strain
-             moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
-                  (ts .sdyad. ((2._8*mu*impulse*gammadot)*n))
-
-          END DO
-       END DO
-    END DO
-
-  END SUBROUTINE frictionplaneeigenstress
-
-  !-----------------------------------------------------------------
-  !> subroutine FrictionEigenStress
-  !! compute the eigen-stress (forcing moment) to be relaxed by
-  !! rate-dependent inelastic deformation in the case of a frictional
-  !! surface:
-  !!
-  !!        sigma^i = C:F:sigma
-  !!
-  !! where C is the elastic moduli tensor, F is the heterogeneous
-  !! fluidity moduli tensor and sigma is the instantaneous stress
-  !! tensor. for a frictional surface, the eigenstrain-rate is given
-  !! by
-  !!
-  !!        epsilon^i^dot = F:sigma = gamma^dot R
-  !!
-  !! where gamma^dot is the slip rate (a scalar) and R is the
-  !! deviatoric, symmetric, and unitary, tensor:
-  !!
-  !!        R_ij = 1/2 ( t_i n_j + t_j n_i ) / sqrt( t_j t_j )
-  !!
-  !! where the shear traction t_i is the projection of the traction
-  !! vector on the plane surface. the strain amplitude is given by
-  !!
-  !!        gamma^dot = H( t_j r_j ) 2 vo sinh( taus / (t_c )
-  !!
-  !! where taus is the effective shear on the fault plane,
-  !!
-  !!        taus = tau + mu*sigma
-  !!
-  !! where tau is the shear and sigma the normal stress. tau and sigma
-  !! assumed to be the co-seismic change only, not the absolute
-  !! stress. vo is a reference slip velocity, and t_c, the critical
-  !! stress, corresponds to (a-b)*sigma in the framework of rate-and-
-  !! state friction. the effective viscosity eta* and the fluidity
-  !!
-  !!        eta* = tau / gamma^dot
-  !!        fluidity = 1 / eta*
-  !!
-  !! are used to compute the optimal time-step. H( x ) is the 
-  !! Heaviside function and r_i is the rake vector. I impose
-  !! gamma^dot to be zero is t_j r_j < 0. This constraint is
-  !! enforced to ensure that no back slip occurs on faults.
-  !!
-  !! \author sylvain barbot (07/24/07) - original form
-  !!                        (02/28/11) - add constraints on the direction
-  !!                                     of afterslip
-  !-----------------------------------------------------------------
-  SUBROUTINE frictioneigenstress(x,y,z,L,W,strike,dip,rake,beta, &
-       sig,mu,structure,sx1,sx2,sx3,dx1,dx2,dx3,moment,maxwelltime,vel)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3,x,y,z,L,W,strike,dip,rake,beta
-    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: moment
-    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
-#ifdef ALIGN_DATA
-    REAL*4, INTENT(OUT), DIMENSION(sx1+2,sx2,sx3), OPTIONAL :: vel
-#else
-    REAL*4, INTENT(OUT), DIMENSION(sx1,sx2,sx3), OPTIONAL :: vel
-#endif
-
-    INTEGER :: i1,i2,i3
-    TYPE(TENSOR) :: s
-    REAL*8, DIMENSION(3) :: t,ts,n,r
-    REAL*8 :: vo,tauc,taun,taus,gammadot,impulse, &
-         friction,tau,scaling,cohesion
-    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
-         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
-         temp1,temp2,temp3,sourc,image,xr,yr,zr,Wp,Lp,dum
-    REAL*4 :: tm
-
-    IF (PRESENT(maxwelltime)) THEN
-       tm=maxwelltime
-    ELSE
-       tm=1e30
-    END IF
-    
-    ! delta function scaling
-    scaling=sqrt(pi2)*dx1
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-    
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta)/2._8
-    Lp=L*(1._8+2._8*beta)/2._8
-    
-    ! rotate centre coordinates of source and images
-    x2r= cstrike*x  -sstrike*y
-    xr = cdip   *x2r-sdip   *z
-    yr = sstrike*x  +cstrike*y
-    zr = sdip   *x2r+cdip   *z
-    
-    ! surface normal vector components
-    n(1)=+cdip*cstrike
-    n(2)=-cdip*sstrike
-    n(3)=-sdip
-             
-    ! rake vector component
-    r(1)=sstrike*cr+cstrike*sdip*sr
-    r(2)=cstrike*cr-sstrike*sdip*sr
-    r(3)=cdip*sr
-
-    DO i3=1,sx3
-       x3=DBLE(i3-1)*dx3
-       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
-
-       vo=structure(i3)%gammadot0
-       tauc=structure(i3)%stressexponent
-       friction=structure(i3)%friction
-       cohesion=structure(i3)%cohesion
-       
-       DO i2=1,sx2
-          DO i1=1,sx1
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-             IF ((ABS(x1-x).gt.MAX(Wp,Lp)) .OR.  (ABS(x2-y).gt.MAX(Wp,Lp))) CYCLE
-             
-             x2r= cstrike*x1-sstrike*x2
-             x1s= cdip*x2r-sdip*x3
-             x1i= cdip*x2r+sdip*x3
-             IF ((ABS(x1s-xr).GT.7.01_8*dx1).AND.(ABS(x1i-xr).GT.7.01_8*dx1)) CYCLE
-             x2s= sstrike*x1+cstrike*x2
-             x3s= sdip*x2r+cdip*x3
-             x3i=-sdip*x2r+cdip*x3
-
-             ! integrate at depth and along strike with raised cosine taper
-             ! and shift sources to x,y,z coordinate
-             temp1=gauss(x1s-xr,dx1)
-             temp2=omega((x2s-yr)/W,beta)
-             temp3=omega((x3s-zr)/L,beta)
-             sourc=temp1*temp2*temp3
-
-             temp1=gauss(x1i-xr,dx1)
-             temp3=omega((x3i+zr)/L,beta)
-             image=temp1*temp2*temp3
-
-             impulse=sourc+image
-
-             ! traction = sigma . n
-             s=sig(i1,i2,i3)
-             t=s .tdot. n
-
-             ! signed normal component
-             taun=SUM(t*n)
-
-             ! absolute value of shear component
-             ts=t-taun*n
-             taus=SQRT(SUM(ts*ts))
-
-             ! effective shear stress on fault plane
-             tau=MAX(0.d0,taus+friction*taun-cohesion)
-
-             ! rake direction test only if | rake | < 3*Pi
-             IF (SUM(ts*r).LT.0.d0 .AND. ABS(rake).LT.pi2*1.5d0) CYCLE
-
-             ! warning for wrong input
-             IF ((tau/tauc) .gt. 20) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("------------------------------------------")')
-                WRITE (0,'("wrong value of (a-b)sigma gives rise to")')
-                WRITE (0,'("(a - b) * sigma       = ",ES11.3E2)') tauc
-                WRITE (0,'("tau                   = ",ES11.3E2)') tau
-                WRITE (0,'("tau_s                 = ",ES11.3E2)') taus
-                WRITE (0,'("tau_n                 = ",ES11.3E2)') taun
-                WRITE (0,'("tau / ((a - b) sigma) = ",ES11.3E2)') tau/tauc
-                WRITE (0,'("------------------------------------------")')
-                STOP 5
-             END IF
-
-             ! shear traction direction
-             ts=ts/taus
-
-             ! deviatoric strain rate
-             gammadot=vo*2._8*sinh(tau/tauc)
-
-             tm=MIN(tm,tau/mu/gammadot*(MIN(L,W)/sqrt(dx1*dx3)))
-
-             ! provide the strain-rate on request
-             IF (PRESENT(vel)) THEN
-                vel(i1,i2,i3)=vel(i1,i2,i3)+gammadot*impulse*scaling
-             END IF
-
-             ! deviatoric strain
-             moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
-                  (ts .sdyad. ((2._8*mu*impulse*gammadot)*n))
-
-          END DO
-       END DO
-    END DO
-
-    IF (PRESENT(maxwelltime)) maxwelltime=MIN(tm,maxwelltime)
-
-  END SUBROUTINE frictioneigenstress
-
-  !---------------------------------------------------------------------
-  !> function MonitorFriction
-  !! samples a scalar field along a specified planar surface.
-  !!
-  !! input:
-  !! @param x,y,z       coordinates of the creeping segment
-  !! @param L           dimension of segment in the depth direction
-  !! @param W           dimension of segment in the strike direction
-  !! @param beta        smoothing factor
-  !! @param sx1,2,3     dimension of the stress tensor array
-  !! @param dx1,2,3     sampling size
-  !! @param sig         stress tensor array
-  !! @param structure   frictional properties as a function of depth
-  !!
-  !! output:
-  !! @param patch       list of strike- and dip-slip as a function of position
-  !!                    on the fault.     
-  !! 
-  !! \author sylvain barbot (10-16-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE monitorfriction(x,y,z,L,W,strike,dip,rake,beta, &
-       sx1,sx2,sx3,dx1,dx2,dx3,sig,structure,patch)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,rake,dip,beta,dx1,dx2,dx3
-    TYPE(TENSOR), DIMENSION(sx1,sx2,sx3), INTENT(IN) :: sig
-    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: patch
-    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
-
-    INTEGER :: i1,i2,i3,px2,px3,j2,j3,status
-    REAL*8 :: cstrike,sstrike,cdip,sdip,cr,sr
-    REAL*8 :: vo,tauc,taun,taus, &
-         friction,tau,cohesion
-    REAL*8 :: x1,x2,x3,xr,yr,zr,Wp,Lp
-    TYPE(TENSOR) :: s
-    REAL*8, DIMENSION(3) :: t,ts,n,sv,dv,r
-
-    cstrike=cos(strike)
-    sstrike=sin(strike)
-    cdip=cos(dip)
-    sdip=sin(dip)
-    cr=cos(rake)
-    sr=sin(rake)
-
-    ! strike direction vector
-    sv=(/ sstrike, cstrike, 0._8 /)
-
-    ! dip direction vector
-    dv=(/ -cstrike*sdip, +sstrike*sdip, -cdip /)
-
-    ! effective tapered dimensions
-    Wp=W*(1._8+2._8*beta) ! horizontal dimension for vertical fault
-    Lp=L*(1._8+2._8*beta) ! depth for a vertical fault
-
-    ! number of samples in the dip and strike direction
-    px3=fix(L/dx3)
-    px2=fix(W/dx2)
-
-    ! allocate array of measurements
-    ALLOCATE(patch(px2+1,px3+1),STAT=status)
-    IF (status>0) STOP "could not allocate the slip patches for export"
-
-    ! surface normal vector components
-    n(1)=+cdip*cstrike
-    n(2)=-cdip*sstrike
-    n(3)=-sdip
-             
-    ! rake vector component
-    r(1)=sstrike*cr+cstrike*sdip*sr
-    r(2)=cstrike*cr-sstrike*sdip*sr
-    r(3)=cdip*sr
-
-    ! loop in the dip direction
-    DO j3=1,px3+1
-       ! loop in the strike direction
-       DO j2=1,px2+1
-
-          CALL ref2local(x,y,z,xr,yr,zr)
-          
-          ! no translation in out of plane direction
-          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
-          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
-          
-          CALL local2ref(xr,yr,zr,x1,x2,x3)
-
-          ! initialize zero slip velocity
-          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr,0._8,0._8,0._8,s)
-
-          ! discard out-of-bound locations
-          IF (  (x1 .GT. DBLE(sx1/2-1)*dx1) .OR. (x1 .LT. -DBLE(sx1/2)*dx1) &
-           .OR. (x2 .GT. DBLE(sx2/2-1)*dx2) .OR. (x2 .LT. -DBLE(sx2/2)*dx2) &
-           .OR. (x3 .GT. DBLE(sx3-1)*dx3) .OR. (x3 .LT. 0._8)  ) CYCLE
-
-          ! evaluates instantaneous creep velocity
-          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
-
-          ! retrieve friction parameters
-          vo=structure(i3)%gammadot0
-          tauc=structure(i3)%stressexponent
-          friction=structure(i3)%friction
-          cohesion=structure(i3)%cohesion
-       
-          ! traction = sigma . n
-          s=sig(i1,i2,i3)
-          t=s .tdot. n
-
-          ! signed normal component
-          taun=SUM(t*n)
-
-          ! absolute value of shear component
-          ts=t-taun*n
-          taus=SQRT(SUM(ts*ts))
-             
-          ! effective shear stress on fault plane
-          tau=MAX(0.d0,taus+friction*taun-cohesion)
-
-          ! rake direction test only if | rake | < 3*Pi
-          IF (SUM(ts*r).LT.0.d0 .AND. ABS(rake).LT.pi2*1.5d0) CYCLE
-
-          ! creep rate
-          patch(j2,j3)%slip=vo*2._8*sinh(tau/tauc)
-
-          ! shear traction direction
-          ts=ts/taus
-
-          ! strike-direction creep rate
-          patch(j2,j3)%ss=patch(j2,j3)%slip*SUM(ts*sv)
-
-          ! dip-direction creep rate
-          patch(j2,j3)%ds=patch(j2,j3)%slip*SUM(ts*dv)
-
-       END DO
-    END DO
-
-  CONTAINS
-
-    !-----------------------------------------------
-    ! subroutine ref2local
-    ! convert reference Cartesian coordinates into
-    ! the rotated, local fault coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
-      REAL*8, INTENT(IN) :: x,y,z
-      REAL*8, INTENT(OUT) :: xp,yp,zp
-
-      REAL*8 :: x2
-
-      x2 = cstrike*x  -sstrike*y
-      xp = cdip   *x2 -sdip   *z
-      yp = sstrike*x  +cstrike*y
-      zp = sdip   *x2 +cdip   *z
-
-    END SUBROUTINE ref2local
-
-    !-----------------------------------------------
-    ! subroutine local2ref
-    ! converts a set of coordinates from the rotated
-    ! fault-aligned coordinate system into the
-    ! reference, Cartesian coordinates system.
-    !-----------------------------------------------
-    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
-      REAL*8, INTENT(IN) :: xp,yp,zp
-      REAL*8, INTENT(OUT) :: x,y,z
-
-      REAL*8 :: x2p
-
-      x2p=  cdip*xp+sdip*zp
-      x  =  cstrike*x2p+sstrike*yp
-      y  = -sstrike*x2p+cstrike*yp
-      z  = -sdip*xp    +cdip*zp
-
-    END SUBROUTINE local2ref
-
-  END SUBROUTINE monitorfriction
-
-END MODULE friction3d
diff -r 405d8f4fa05f -r e7295294f654 getdata.f
--- a/getdata.f	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,30 +0,0 @@
-	subroutine getdata(unit,line)
-	implicit none
-c
-c	First implemented in Potsdam, Feb, 1999
-c	Last modified: Potsdam, Nov, 2001, by R. Wang
-c
-	integer unit
-	character line*180,char*1
-c
-	integer i
-c
-c	this subroutine reads over all comment lines starting with "#".
-c
-	char='#'
-100	continue
-	if(char.eq.'#')then
-	  read(unit,'(a)')line
-	  i=1
-	  char=line(1:1)
-200	  continue
-	  if(char.eq.' ')then
-	    i=i+1
-	    char=line(i:i)
-	    goto 200
-	  endif
-	  goto 100
-	endif
-c
-	return
-	end
diff -r 405d8f4fa05f -r e7295294f654 getopt_m.f90
--- a/getopt_m.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,233 +0,0 @@
-! ------------------------------------------------------------
-! Copyright 2008 by Mark Gates
-!
-! This program is free software; you can redistribute or modify it under
-! the terms of the GNU general public license (GPL), version 2 or later.
-!
-! This program is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of
-! merchantability or fitness for a particular purpose.
-!
-! If you wish to incorporate this into non-GPL software, please contact
-! me regarding licensing terms.
-!
-! ------------------------------------------------------------
-! Fortran 95 getopt() and getopt_long(), similar to those in standard C library.
-!
-! ch = getopt( optstring, [longopts] )
-! Returns next option character from command line arguments.
-! If an option is not recognized, it returns '?'.
-! If no options are left, it returns a null character, char(0).
-!
-! optstring contains characters that are recognized as options.
-! If a character is followed by a colon, then it takes a required argument.
-! For example, "x" recognizes "-x", while "x:" recognizes "-x arg" or "-xarg".
-!
-! optopt is set to the option character, even if it isn't recognized.
-! optarg is set to the option's argument.
-! optind has the index of the next argument to process. Initially optind=1.
-! Errors are printed by default. Set opterr=.false. to suppress them.
-!
-! Grouped options are allowed, so "-abc" is the same as "-a -b -c".
-!
-! If longopts is present, it is an array of type(option_s), where each entry
-! describes one long option.
-!
-!    type option_s
-!        character(len=80) :: name
-!        logical           :: has_arg
-!        character         :: val
-!    end type
-!
-! The name field is the option name, without the leading -- double dash.
-! Set the has_arg field to true if it requires an argument, false if not.
-! The val field is returned. Typically this is set to the corresponding short
-! option, so short and long options can be processed together. (But there
-! is no requirement that every long option has a short option, or vice-versa.)
-!
-! -----
-! EXAMPLE
-! program test
-!     use getopt_m
-!     implicit none
-!     character:: ch
-!     type(option_s):: opts(2)
-!     opts(1) = option_s( "alpha", .false., 'a' )
-!     opts(2) = option_s( "beta",  .true.,  'b' )
-!     do
-!         select case( getopt( "ab:c", opts ))
-!             case( char(0))
-!                 exit
-!             case( 'a' )
-!                 print *, 'option alpha/a'
-!             case( 'b' )
-!                 print *, 'option beta/b=', optarg
-!             case( '?' )
-!                 print *, 'unknown option ', optopt
-!                 stop
-!             case default
-!                 print *, 'unhandled option ', optopt, ' (this is a bug)'
-!         end select
-!     end do
-! end program test
-!
-! Differences from C version:
-! - when options are finished, C version returns -1 instead of char(0),
-!   and thus stupidly requires an int instead of a char.
-! - does not support optreset
-! - does not support "--" as last argument
-! - if no argument, optarg is blank, not NULL
-! - argc and argv are implicit
-!
-! Differences for long options:
-! - optional argument to getopt(), rather than separate function getopt_long()
-! - has_arg is logical, and does not support optional_argument
-! - does not support flag field (and thus always returns val)
-! - does not support longindex
-! - does not support "--opt=value" syntax, only "--opt value"
-! - knows the length of longopts, so does not need an empty last record
-
-module getopt_m
-	implicit none
-	character(len=80):: optarg
-	character:: optopt
-	integer:: optind=1
-	logical:: opterr=.true.
-	
-	type option_s
-		character(len=80) :: name
-		logical           :: has_arg
-		character         :: val
-	end type
-	
-	! grpind is index of next option within group; always >= 2
-	integer, private:: grpind=2
-
-contains
-
-! ----------------------------------------
-! Return str(i:j) if 1 <= i <= j <= len(str),
-! else return empty string.
-! This is needed because Fortran standard allows but doesn't *require* short-circuited
-! logical AND and OR operators. So this sometimes fails:
-!     if ( i < len(str) .and. str(i+1:i+1) == ':' ) then
-! but this works:
-!     if ( substr(str, i+1, i+1) == ':' ) then
-
-character function substr( str, i, j )
-	! arguments
-	character(len=*), intent(in):: str
-	integer, intent(in):: i, j
-	
-	if ( 1 <= i .and. i <= j .and. j <= len(str)) then
-		substr = str(i:j)
-	else
-		substr = ''
-	endif
-end function substr
-
-
-! ----------------------------------------
-character function getopt( optstring, longopts )
-	! arguments
-	character(len=*), intent(in):: optstring
-	type(option_s),   intent(in), optional:: longopts(:)
-	
-	! local variables
-	character(len=80):: arg
-	
-	optarg = ''
-	if ( optind > iargc()) then
-		getopt = char(0)
-	endif
-	
-	call getarg( optind, arg )
-	if ( present( longopts ) .and. arg(1:2) == '--' ) then
-		getopt = process_long( longopts, arg )
-	elseif ( arg(1:1) == '-' ) then
-		getopt = process_short( optstring, arg )
-	else
-		getopt = char(0)
-	endif
-end function getopt
-
-
-! ----------------------------------------
-character function process_long( longopts, arg )
-	! arguments
-	type(option_s),   intent(in):: longopts(:)
-	character(len=*), intent(in):: arg
-	
-	! local variables
-	integer:: i
-	
-	! search for matching long option
-	optind = optind + 1
-	do i = 1, size(longopts)
-		if ( arg(3:) == longopts(i)%name ) then
-			optopt = longopts(i)%val
-			process_long = optopt
-			if ( longopts(i)%has_arg ) then
-				if ( optind <= iargc()) then
-					call getarg( optind, optarg )
-					optind = optind + 1
-				elseif ( opterr ) then
-					 WRITE (0,'(a,a,a)')  "error: option '", trim(arg), "' requires an argument"
-				endif
-			endif
-			return
-		endif
-	end do
-	! else not found
-	process_long = '?'
-	if ( opterr ) then
-		WRITE (0,'(a,a,a)'), "error: unrecognized option '", trim(arg), "'"
-	endif
-end function process_long
-
-
-! ----------------------------------------
-character function process_short( optstring, arg )
-	! arguments
-	character(len=*), intent(in):: optstring, arg
-	
-	! local variables
-	integer:: i, arglen
-	
-	arglen = len( trim( arg ))
-	optopt = arg(grpind:grpind)
-	process_short = optopt
-	
-	i = index( optstring, optopt )
-	if ( i == 0 ) then
-		! unrecognized option
-		process_short = '?'
-		if ( opterr ) then
-			print '(a,a,a)', "Error: unrecognized option '-", optopt, "'"
-		endif
-	endif
-	if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then
-		! required argument
-		optind = optind + 1
-		if ( arglen > grpind ) then
-			! -xarg, return remainder of arg
-			optarg = arg(grpind+1:arglen)
-		elseif ( optind <= iargc()) then
-			! -x arg, return next arg
-			call getarg( optind, optarg )
-			optind = optind + 1
-		elseif ( opterr ) then
-			WRITE (0,'(a,a,a)') "error: option '-", optopt, "' requires an argument"
-		endif
-		grpind = 2
-	elseif ( arglen > grpind ) then
-		! no argument (or unrecognized), go to next option in argument (-xyz)
-		grpind = grpind + 1
-	else
-		! no argument (or unrecognized), go to next argument
-		grpind = 2
-		optind = optind + 1
-	endif
-end function process_short
-
-end module getopt_m
diff -r 405d8f4fa05f -r e7295294f654 green.f90
--- a/green.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,953 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-MODULE green
-
-  USE fourier
-
-  IMPLICIT NONE
-
-#include "include.f90"
-
-  PUBLIC
-  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
-  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
-  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
-    
-  INTEGER, PARAMETER :: GRN_IMAGE=1,GRN_HS=0
-
-CONTAINS
-
-  !------------------------------------------------------------------------
-  !> Subroutine ElasticResponse
-  !! apply the 2d elastic (half-space) transfert function
-  !! to the set of body forces.
-  !!
-  !! INPUT:
-  !! @param mu          shear modulus
-  !! @param f1,2,3      equivalent body-forces in the Fourier domain
-  !! @param dx1,2,3     sampling size
-  !!
-  !! \author sylvain barbot (04/14/07) - original form
-  !!                        (02/06/09) - parallel implementation with MPI and OpenMP
-  !!                        (01/06/11) - remove implementation with MPI
-  !------------------------------------------------------------------------
-  SUBROUTINE elasticresponse(lambda,mu,f1,f2,f3,dx1,dx2,dx3)
-    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
-    
-    REAL*8 :: k1,k2,k3,denom,r2,ratio1,ratio2
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3,ubound3
-    COMPLEX(kind=8) :: buf1,buf2,buf3,c1,c2,c3
-    
-    sx1=SIZE(f2,1)-2
-    sx2=SIZE(f2,2)
-    sx3=SIZE(f2,3)
-    
-    ratio1=(lambda+mu)/(lambda+2._8*mu)/mu/(pi2**2._8)
-    ratio2=mu/(lambda+mu)
-    
-    ubound3=sx3
-
-    ! serial computation
-!$omp parallel do private(i1,i2,k1,k2,k3,r2,denom,c1,c2,c3,buf1,buf2,buf3)
-    DO i3=1,ubound3
-       CALL wavenumber3(i3,sx3,dx3,k3)
-       DO i2=1,sx2
-          CALL wavenumber2(i2,sx2,dx2,k2)
-          DO i1=1,sx1/2+1
-             CALL wavenumber1(i1,sx1,dx1,k1)
-             
-             r2=k1**2._8+k2**2._8+k3**2._8
-             denom=ratio1/r2**2
-             
-             c1=CMPLX(f1(2*i1-1,i2,i3),f1(2*i1,i2,i3),8)
-             c2=CMPLX(f2(2*i1-1,i2,i3),f2(2*i1,i2,i3),8)
-             c3=CMPLX(f3(2*i1-1,i2,i3),f3(2*i1,i2,i3),8)
-             
-             buf1=((k2**2._8+k3**2._8+ratio2*r2)*c1-k1*(k2*c2+k3*c3))*denom
-             buf2=((k1**2._8+k3**2._8+ratio2*r2)*c2-k2*(k1*c1+k3*c3))*denom
-             buf3=((k1**2._8+k2**2._8+ratio2*r2)*c3-k3*(k1*c1+k2*c2))*denom
-             
-             f1(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf1),AIMAG(buf1) /))
-             f2(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf2),AIMAG(buf2) /))
-             f3(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf3),AIMAG(buf3) /))
-          END DO
-       END DO
-    END DO
-!$omp end parallel do
-
-    ! zero wavenumber, no net body-force
-    f1(1:2,1,1)=(/ 0._4, 0._4 /)
-    f2(1:2,1,1)=(/ 0._4, 0._4 /)
-    f3(1:2,1,1)=(/ 0._4, 0._4 /)
-
-  END SUBROUTINE elasticresponse
-
-  !---------------------------------------------------------------------
-  !> subroutine SurfaceNormalTraction
-  !! computes the two-dimensional field of surface normal stress
-  !! expressed in the Fourier domain.
-  !! The surface (x3=0) solution is obtained by integrating over the
-  !! wavenumbers in 3-direction in the Fourier domain.
-  !!
-  !! \author sylvain barbot (05-01-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE surfacenormaltraction(lambda, mu, u1, u2, u3, dx1, dx2, dx3, p)
-    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1, u2, u3
-    REAL*8, INTENT(IN) :: lambda, mu, dx1, dx2, dx3
-    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p
-    
-    INTEGER :: i1, i2, i3, sx1, sx2, sx3
-    REAL*8 :: k1, k2, k3, modulus
-    COMPLEX*8, PARAMETER :: i = CMPLX(0._8,pi2)
-    COMPLEX*8 :: sum, c1, c2, c3
-    
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-    
-    modulus=lambda+2*mu
-    
-    p=0
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1/2+1
-             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
-             
-             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3))
-             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3))
-             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3))
-             
-             sum=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))
-             
-             p(2*i1-1,i2)=p(2*i1-1,i2)+REAL( REAL(sum))
-             p(2*i1  ,i2)=p(2*i1  ,i2)+REAL(AIMAG(sum))
-          END DO
-       END DO
-    END DO
-    p=p/(sx3*dx3)
-    
-  END SUBROUTINE surfacenormaltraction
-
-  !---------------------------------------------------------------------
-  !> subroutine Boussinesq3D
-  !! computes the deformation field in the 3-dimensional grid
-  !! due to a normal stress at the surface. Apply the Fourier domain
-  !! solution of Steketee [1958].
-  !---------------------------------------------------------------------
-  SUBROUTINE boussinesq3d(p,lambda,mu,u1,u2,u3,dx1,dx2,dx3)
-    REAL*4, DIMENSION(:,:), INTENT(IN) :: p
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1, u2, u3
-    REAL*8, INTENT(IN) :: lambda, mu, dx1, dx2, dx3
-
-    INTEGER :: i1, i2, i3, sx1, sx2, sx3, status
-    REAL*8 :: k1, k2, k3, x3, alpha
-    COMPLEX, ALLOCATABLE, DIMENSION(:) :: b1, b2, b3
-    COMPLEX :: load
-
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-    
-    ALLOCATE(b1(sx3),b2(sx3),b3(sx3),STAT=status)
-    IF (0/=status) STOP "could not allocate arrays for Boussinesq3D"
-    
-    alpha=(lambda+mu)/(lambda+2*mu)
-
-    DO i2=1,sx2
-       DO i1=1,sx1/2+1
-          CALL wavenumbers(i1,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
-          load=CMPLX(p(2*i1-1,i2),p(2*i1,i2))
-          DO i3=1,sx3
-             IF (i3<=sx3/2) THEN
-                x3=DBLE(i3-1)*dx3
-             ELSE
-                x3=ABS(DBLE(i3-sx3-1)*dx3)
-             END IF
-             CALL steketeesolution(load,alpha,b1(i3),b2(i3),b3(i3),k1,k2,x3)
-          END DO
-          
-          ! transforms the Steketee solution into a full 3-dimensional
-          ! Fourier transform by 1d transforming in the 3-direction
-          CALL fft1(b1,sx3,dx3,FFT_FORWARD)
-          CALL fft1(b2,sx3,dx3,FFT_FORWARD)
-          CALL fft1(b3,sx3,dx3,FFT_FORWARD)
-          
-          ! add the Boussinesq contribution to the deformation field
-          DO i3=1,sx3
-             u1(2*i1-1:2*i1,i2,i3)=u1(2*i1-1:2*i1,i2,i3)+ &
-                  (/REAL(b1(i3)),AIMAG(b1(i3))/)
-             u2(2*i1-1:2*i1,i2,i3)=u2(2*i1-1:2*i1,i2,i3)+ &
-                  (/REAL(b2(i3)),AIMAG(b2(i3))/)
-             u3(2*i1-1:2*i1,i2,i3)=u3(2*i1-1:2*i1,i2,i3)+ &
-                  (/REAL(b3(i3)),AIMAG(b3(i3))/)
-          END DO
-       END DO
-    END DO
-
-    DEALLOCATE(b1,b2,b3)
-    
-    CONTAINS
-      !-----------------------------------------------------------------
-      !> subroutine SteketeeSolution
-      !! computes the spectrum (two-dimensional Fourier transform)
-      !! of the 3 components of the deformation field u1, u2, u3
-      !! at wavenumbers k1, k2 and position x3. This is the analytical
-      !! solution of [J. A. Steketee, On Volterra's dislocations in a
-      !! semi-infinite elastic medium, Canadian Journal of Physics, 1958]
-      !!
-      !! \author sylvain barbot (05-02-07) - original form
-      !-----------------------------------------------------------------
-      SUBROUTINE steketeesolution(p,alpha,u1,u2,u3,k1,k2,x3)
-        COMPLEX, INTENT(INOUT) :: u1, u2, u3
-        REAL*8, INTENT(IN) :: alpha, k1, k2, x3
-        COMPLEX, INTENT(IN) :: p
-        
-        REAL*8 :: beta, depthdecay
-        COMPLEX, PARAMETER :: i=CMPLX(0,1)
-        COMPLEX :: b
-        
-        beta=pi2*sqrt(k1**2._8+k2**2._8)
-        depthdecay=exp(-beta*abs(x3))
-        
-        IF (0==k1 .AND. 0==k2) THEN
-           u1=CMPLX(0.,0.)
-           u2=CMPLX(0.,0.)
-           u3=CMPLX(0.,0.)
-        ELSE
-           b=p/(2._8*mu*alpha*beta**3._8)
-           u1=i*alpha*pi2*beta*b*(1._8-1._8/alpha+beta*x3)*depthdecay
-           u2=u1
-           u1=u1*k1
-           u2=u2*k2
-           u3=-p/(2*mu*beta)*(1._8/alpha+beta*x3)*depthdecay
-        END IF
-        
-      END SUBROUTINE steketeesolution
-
-  END SUBROUTINE boussinesq3d
-
-  !---------------------------------------------------------------------
-  !> subroutine SurfaceTraction
-  !! computes the two-dimensional field of surface normal stress
-  !! expressed in the Fourier domain.
-  !! The surface (x3=0) solution is obtained by integrating over the
-  !! wavenumbers in 3-direction in the Fourier domain.
-  !!
-  !! \author sylvain barbot (07-07-07) - original form
-  !                         (02-09-09) - parallelized with mpi and openmp
-  !---------------------------------------------------------------------
-  SUBROUTINE surfacetraction(lambda,mu,u1,u2,u3,dx1,dx2,dx3,p1,p2,p3)
-    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1,u2,u3
-    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
-    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p1,p2,p3
-
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8 :: k1,k2,k3,modulus
-    COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2,8)
-    COMPLEX(KIND=8) :: sum1,sum2,sum3,c1,c2,c3
-
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-
-    modulus=lambda+2._8*mu
-
-    p1=0
-    p2=0
-    p3=0
-
-!$omp parallel do private(i1,i2,k1,k2,k3,c1,c2,c3,sum1,sum2,sum3), &
-!$omp reduction(+:p1,p2,p3)
-    DO i3=1,sx3
-       DO i2=1,sx2
-          DO i1=1,sx1/2+1
-             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
-
-             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3),8)
-             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3),8)
-             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3),8)
-
-             sum1=i*mu*(k3*c1+k1*c3)
-             sum2=i*mu*(k3*c2+k2*c3)
-             sum3=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))
-
-             p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2) &
-                  +(/REAL(REAL(sum1)),REAL(AIMAG(sum1))/)
-             p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2) &
-                  +(/REAL(REAL(sum2)),REAL(AIMAG(sum2))/)
-             p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2) &
-                  +(/REAL(REAL(sum3)),REAL(AIMAG(sum3))/)
-
-          END DO
-       END DO
-    END DO
-!$omp end parallel do
-
-    p1=p1/(sx3*dx3)
-    p2=p2/(sx3*dx3)
-    p3=p3/(sx3*dx3)
-
-  END SUBROUTINE surfacetraction
-
-  !---------------------------------------------------------------------
-  !> subroutine SurfaceTractionCowling
-  !! computes the two-dimensional field of the resulting traction 
-  !! expressed in the Fourier domain in the presence of gravity.
-  !!
-  !! The surface solution (x3=0) is obtained from the Fourier domain 
-  !! array by integrating over the wavenumbers in 3-direction.
-  !!
-  !! The effective traction at x3=0 is 
-  !!
-  !!     t_1 = sigma_13
-  !!     t_2 = sigma_23
-  !!     t_3 = sigma_33 - r g u3
-  !!         = sigma_33 - 2 mu alpha gamma u3
-  !!
-  !! \author sylvain barbot (07-07-07) - original form
-  !---------------------------------------------------------------------
-  SUBROUTINE surfacetractioncowling(lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3, &
-       p1,p2,p3)
-    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1,u2,u3
-    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
-    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p1,p2,p3
-    
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3
-    REAL*8 :: k1,k2,k3,modulus,alpha,grav
-    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
-    COMPLEX*8 :: sum1,sum2,sum3,c1,c2,c3
-    
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-    
-    modulus=lambda+2._8*mu
-    alpha=(lambda+mu)/(lambda+2._8*mu)
-    grav=2._8*mu*alpha*gamma
-    
-    p1=0
-    p2=0
-    p3=0
-
-!$omp parallel do private(i1,i3,k1,k2,k3,c1,c2,c3,sum1,sum2,sum3)
-!!!$omp reduction(+:p1,p2,p3)
-    DO i2=1,sx2
-       DO i3=1,sx3
-          DO i1=1,sx1/2+1
-             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
-             
-             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3))
-             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3))
-             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3))
-
-             sum1=i*mu*(k3*c1+k1*c3)
-             sum2=i*mu*(k3*c2+k2*c3)
-             sum3=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))-grav*c3
-             
-             p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2)+(/REAL(sum1),AIMAG(sum1)/)
-             p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2)+(/REAL(sum2),AIMAG(sum2)/)
-             p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2)+(/REAL(sum3),AIMAG(sum3)/)
-          END DO
-       END DO
-    END DO
-!$omp end parallel do
-
-    p1=p1/(sx3*dx3)
-    p2=p2/(sx3*dx3)
-    p3=p3/(sx3*dx3)
-    
-  END SUBROUTINE surfacetractioncowling
-
-  !---------------------------------------------------------------------
-  !> subroutine Cerruti3D
-  !! computes the deformation field in the 3-dimensional grid
-  !! due to an arbitrary surface traction.
-  !!
-  !! \author sylvain barbot (07/07/07) - original form
-  !                (02/01/09) - parallelized with MPI and OpenMP
-  !                (01/06/11) - remove parallelized version with MPI
-  !---------------------------------------------------------------------
-  SUBROUTINE cerruti3d(p1,p2,p3,lambda,mu,u1,u2,u3,dx1,dx2,dx3)
-    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
-    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
-
-    INTEGER :: i1,i2,i3,ib,sx1,sx2,sx3,iostatus,buffersize
-    REAL*8 :: k1,k2,k3,x3,alpha
-    COMPLEX(KIND=4) :: t1,t2,t3
-    INTEGER, PARAMETER :: stride=64
-    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:,:) :: b1,b2,b3
-
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-
-    alpha=(lambda+mu)/(lambda+2*mu)
-
-    ! serial programmation implementation
-!$omp parallel private(b1,b2,b3,iostatus)
-
-    ALLOCATE(b1(sx3,stride),b2(sx3,stride),b3(sx3,stride),STAT=iostatus)
-    IF (0/=iostatus) STOP "could not allocate arrays for Cerruti3D"
-
-!$omp do private(i1,i3,ib,k1,k2,k3,t1,t2,t3,x3,buffersize)
-    DO i2=1,sx2
-       DO i1=1,sx1/2+1,stride
-
-          ! buffer results
-          IF (i1+stride-1 .GT. sx1/2+1) THEN
-             buffersize=sx1/2+1-i1+1
-          ELSE
-             buffersize=stride
-          END IF
-
-          DO ib=0,buffersize-1
-
-             CALL wavenumbers(i1+ib,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
-             t1=CMPLX(p1(2*(i1+ib)-1,i2),p1(2*(i1+ib),i2),4)
-             t2=CMPLX(p2(2*(i1+ib)-1,i2),p2(2*(i1+ib),i2),4)
-             t3=CMPLX(p3(2*(i1+ib)-1,i2),p3(2*(i1+ib),i2),4)
-
-             DO i3=1,sx3
-                IF (i3<=sx3/2) THEN
-                   x3=DBLE(i3-1)*dx3
-                ELSE
-                   x3=ABS(DBLE(i3-sx3-1)*dx3)
-                END IF
-                CALL cerrutisolution(mu,t1,t2,t3,alpha,b1(i3,ib+1),b2(i3,ib+1),b3(i3,ib+1),k1,k2,x3)
-             END DO
-
-             ! transforms the Cerruti solution into a full 3-dimensional
-             ! Fourier transform by 1d transforming in the 3-direction
-             CALL fft1(b1(:,ib+1),sx3,dx3,FFT_FORWARD)
-             CALL fft1(b2(:,ib+1),sx3,dx3,FFT_FORWARD)
-             CALL fft1(b3(:,ib+1),sx3,dx3,FFT_FORWARD)
-
-          END DO
-
-          ! update solution displacement
-          DO i3=1,sx3
-             DO ib=0,buffersize-1
-                u1(2*(i1+ib)-1,i2,i3)=u1(2*(i1+ib)-1,i2,i3)+REAL( REAL(b1(i3,ib+1)))
-                u1(2*(i1+ib)  ,i2,i3)=u1(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b1(i3,ib+1)))
-                u2(2*(i1+ib)-1,i2,i3)=u2(2*(i1+ib)-1,i2,i3)+REAL( REAL(b2(i3,ib+1)))
-                u2(2*(i1+ib)  ,i2,i3)=u2(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b2(i3,ib+1)))
-                u3(2*(i1+ib)-1,i2,i3)=u3(2*(i1+ib)-1,i2,i3)+REAL( REAL(b3(i3,ib+1)))
-                u3(2*(i1+ib)  ,i2,i3)=u3(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b3(i3,ib+1)))
-             END DO
-          END DO
-
-       END DO
-    END DO
-
-    DEALLOCATE(b1,b2,b3)
-!$omp end parallel
-
-    CONTAINS
-      !-----------------------------------------------------------------
-      !> subroutine CerrutiSolution
-      !! computes the general solution for the deformation field in an
-      !! elastic half-space due to an arbitrary surface traction.
-      !! the 3 components u1, u2, u3 of the deformation field are
-      !! expressed in the horizontal Fourier at depth x3.
-      !! this combines the solution to the Boussinesq's and the Cerruti's
-      !! problem in a half-space.
-      !!
-      !! \author sylvain barbot (07-07-07) - original form
-      !-----------------------------------------------------------------
-      SUBROUTINE cerrutisolution(mu,p1,p2,p3,alpha,u1,u2,u3,k1,k2,x3)
-        COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
-        REAL*8, INTENT(IN) :: mu,alpha,k1,k2,x3
-        COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
-
-        REAL*8 :: beta, depthdecay
-        COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2,8)
-        REAL*8  :: temp
-        COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
-
-        beta=pi2*sqrt(k1**2+k2**2)
-        depthdecay=exp(-beta*abs(x3))
-
-        IF (0==k1 .AND. 0==k2) THEN
-           u1=CMPLX(0._4,0._4,4)
-           u2=CMPLX(0._4,0._4,4)
-           u3=CMPLX(0._4,0._4,4)
-        ELSE
-           temp=1._8/(2._8*mu*beta**3)*depthdecay
-           b1=temp*p1
-           b2=temp*p2
-           b3=temp*p3
-
-           ! b3 contribution
-           tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
-           v1=tmp*k1
-           v2=tmp*k2
-           v3=-beta**2*b3*(1._8/alpha+beta*x3)
-
-           ! b1 contribution
-           temp=pi2**2*(2._8-1._8/alpha+beta*x3)
-           v1=v1+b1*(-2._8*beta**2+k1**2*temp)
-           v2=v2+b1*k1*k2*temp
-           v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)
-
-           ! b2 contribution & switch to single-precision
-           u1=v1+b2*k1*k2*temp
-           u2=v2+b2*(-2._8*beta**2+k2**2*temp)
-           u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)
-        END IF
-
-      END SUBROUTINE cerrutisolution
-  END SUBROUTINE cerruti3d
-
-  !---------------------------------------------------------------------
-  !> subroutine CerrutiCowling
-  !! computes the deformation field in the 3-dimensional grid
-  !! due to an arbitrary surface traction.
-  !!
-  !! \author sylvain barbot - (07/07/07) - original form
-  !!                          (21/11/08) - gravity effect
-  !!                          (02/01/09) - parallelized with MPI and OpenMP
-  !!                          (01/06/11) - remove parallelized version with MPI
-  !---------------------------------------------------------------------
-  SUBROUTINE cerruticowling(p1,p2,p3,lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3)
-    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
-    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
-
-    INTEGER :: i1,i2,i3,ib,sx1,sx2,sx3,iostatus,buffersize
-    REAL*8 :: k1,k2,k3,x3,alpha
-    COMPLEX(KIND=4) :: t1,t2,t3
-    INTEGER, PARAMETER :: stride=64
-    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:,:) :: b1,b2,b3
-
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-
-    alpha=(lambda+mu)/(lambda+2*mu)
-
-    ! serial programmation implementation
-!$omp parallel private(b1,b2,b3,iostatus)
-
-    ALLOCATE(b1(sx3,stride),b2(sx3,stride),b3(sx3,stride),STAT=iostatus)
-    IF (0/=iostatus) STOP "could not allocate arrays for Cerruti3D"
-
-!$omp do private(i1,i3,ib,k1,k2,k3,t1,t2,t3,x3,buffersize)
-    DO i2=1,sx2
-       DO i1=1,sx1/2+1,stride
-
-          ! buffer results
-          IF (i1+stride-1 .GT. sx1/2+1) THEN
-             buffersize=sx1/2+1-i1+1
-          ELSE
-             buffersize=stride
-          END IF
-
-          DO ib=0,buffersize-1
-
-             CALL wavenumbers(i1+ib,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
-             t1=CMPLX(p1(2*(i1+ib)-1,i2),p1(2*(i1+ib),i2),4)
-             t2=CMPLX(p2(2*(i1+ib)-1,i2),p2(2*(i1+ib),i2),4)
-             t3=CMPLX(p3(2*(i1+ib)-1,i2),p3(2*(i1+ib),i2),4)
-
-             DO i3=1,sx3
-                IF (i3<=sx3/2) THEN
-                   x3=DBLE(i3-1)*dx3
-                ELSE
-                   x3=ABS(DBLE(i3-sx3-1)*dx3)
-                END IF
-                CALL cerrutisolcowling(mu,t1,t2,t3,alpha,gamma, &
-                     b1(i3,ib+1),b2(i3,ib+1),b3(i3,ib+1),k1,k2,x3,DBLE(sx3/2)*dx3)
-             END DO
-
-             ! transforms the Cerruti solution into a full 3-dimensional
-             ! Fourier transform by 1d transforming in the 3-direction
-             CALL fft1(b1(:,ib+1),sx3,dx3,FFT_FORWARD)
-             CALL fft1(b2(:,ib+1),sx3,dx3,FFT_FORWARD)
-             CALL fft1(b3(:,ib+1),sx3,dx3,FFT_FORWARD)
-
-          END DO
-
-          ! update solution displacement
-          DO i3=1,sx3
-             DO ib=0,buffersize-1
-                u1(2*(i1+ib)-1,i2,i3)=u1(2*(i1+ib)-1,i2,i3)+REAL( REAL(b1(i3,ib+1)))
-                u1(2*(i1+ib)  ,i2,i3)=u1(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b1(i3,ib+1)))
-                u2(2*(i1+ib)-1,i2,i3)=u2(2*(i1+ib)-1,i2,i3)+REAL( REAL(b2(i3,ib+1)))
-                u2(2*(i1+ib)  ,i2,i3)=u2(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b2(i3,ib+1)))
-                u3(2*(i1+ib)-1,i2,i3)=u3(2*(i1+ib)-1,i2,i3)+REAL( REAL(b3(i3,ib+1)))
-                u3(2*(i1+ib)  ,i2,i3)=u3(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b3(i3,ib+1)))
-             END DO
-          END DO
-
-       END DO
-    END DO
-
-    DEALLOCATE(b1,b2,b3)
-!$omp end parallel
-
-    CONTAINS
-
-      !-----------------------------------------------------------------
-      !> subroutine CerrutiSolCowling
-      !! computes the general solution for the deformation field in an
-      !! elastic half-space due to an arbitrary surface traction in the
-      !! presence of gravity.
-      !!
-      !! The 3 components u1, u2 and u3 of the deformation field are 
-      !! expressed in the horizontal Fourier at depth x3. 
-      !!
-      !! Combines the solution to the Boussinesq's and the Cerruti's 
-      !! problem in a half-space with buoyancy boundary conditions.
-      !
-      ! sylvain barbot (07-07-07) - original form
-      !                (08-30-10) - account for net surface traction
-      !-----------------------------------------------------------------
-      SUBROUTINE cerrutisolcowling(mu,p1,p2,p3,alpha,gamma,u1,u2,u3,k1,k2,x3,L)
-        COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
-        REAL*8, INTENT(IN) :: mu,alpha,gamma,k1,k2,x3,L
-        COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
-        
-        REAL*8 :: beta, depthdecay, h
-        COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2)
-        REAL*8  :: temp
-        COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
-        
-        beta=pi2*sqrt(k1**2+k2**2)
-        depthdecay=exp(-beta*abs(x3))
-        h=gamma/beta
-        
-        IF (0==k1 .AND. 0==k2) THEN
-           ! the 1/3 ratio is ad hoc
-           u1=CMPLX(REAL(+p1/mu*(x3-L)/3.d0),0._4)
-           u2=CMPLX(REAL(+p2/mu*(x3-L)/3.d0),0._4)
-           u3=CMPLX(REAL(+p3/mu*(x3-L)*(alpha-1.d0)/(1.d0+2.d0*L*alpha*gamma*(1.d0-alpha))/3.d0),0._4)
-           !u1=CMPLX(0._4,0._4)
-           !u2=CMPLX(0._4,0._4)
-           !u3=CMPLX(0._4,0._4)
-        ELSE
-           temp=1._8/(2._8*mu*beta**3)*depthdecay
-           b1=temp*p1
-           b2=temp*p2
-           b3=temp*p3/(1+h)
-           
-           ! b3 contribution
-           tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
-           v1=tmp*k1
-           v2=tmp*k2
-           v3=-beta**2*b3*(1._8/alpha+beta*x3)
-           
-           ! b1 contribution
-           temp=pi2**2*(2._8-1._8/alpha+beta*x3)/(1+h)
-           v1=v1+b1*(-2._8*beta**2+k1**2*temp)
-           v2=v2+b1*k1*k2*temp
-           v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
-           
-           ! b2 contribution & switch to single-precision
-           u1=v1+b2*k1*k2*temp
-           u2=v2+b2*(-2._8*beta**2+k2**2*temp)
-           u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
-        END IF
-
-      END SUBROUTINE cerrutisolcowling
-
-  END SUBROUTINE cerruticowling
-
-  !---------------------------------------------------------------------
-  !> subroutine CerrutiCowlingSerial
-  !! computes the deformation field in the 3-dimensional grid
-  !! due to an arbitrary surface traction. No parallel version.
-  !
-  ! sylvain barbot - 07/07/07 - original form
-  !                  21/11/08 - gravity effect
-  !---------------------------------------------------------------------
-  SUBROUTINE cerruticowlingserial(p1,p2,p3,lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3)
-    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
-    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
-
-    INTEGER :: i1,i2,i3,sx1,sx2,sx3,status
-    REAL*8 :: k1,k2,k3,x3,alpha
-    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:) :: b1,b2,b3
-    COMPLEX(KIND=4) :: t1,t2,t3
-
-    sx1=SIZE(u1,1)-2
-    sx2=SIZE(u1,2)
-    sx3=SIZE(u1,3)
-    
-    ALLOCATE(b1(sx3),b2(sx3),b3(sx3),STAT=status)
-    IF (0/=status) STOP "could not allocate arrays for Cerruti3D"
-    
-    alpha=(lambda+mu)/(lambda+2*mu)
-
-    DO i2=1,sx2
-       DO i1=1,sx1/2+1
-          CALL wavenumbers(i1,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
-          t1=CMPLX(p1(2*i1-1,i2),p1(2*i1,i2))
-          t2=CMPLX(p2(2*i1-1,i2),p2(2*i1,i2))
-          t3=CMPLX(p3(2*i1-1,i2),p3(2*i1,i2))
-          DO i3=1,sx3
-             IF (i3<=sx3/2) THEN
-                x3=DBLE(i3-1)*dx3
-             ELSE
-                x3=ABS(DBLE(i3-sx3-1)*dx3)
-             END IF
-             CALL cerrutisolcowling(t1,t2,t3,alpha,gamma, &
-                  b1(i3),b2(i3),b3(i3),k1,k2,x3)
-          END DO
-          
-          ! transforms the Cerruti solution into a full 3-dimensional
-          ! Fourier transform by 1d transforming in the 3-direction
-          CALL fft1(b1,sx3,dx3,FFT_FORWARD)
-          CALL fft1(b2,sx3,dx3,FFT_FORWARD)
-          CALL fft1(b3,sx3,dx3,FFT_FORWARD)
-          
-          ! add the Cerruti's contribution to the deformation field
-          DO i3=1,sx3
-             u1(2*i1-1,i2,i3)=u1(2*i1-1,i2,i3)+REAL( REAL(b1(i3)))
-             u1(2*i1  ,i2,i3)=u1(2*i1  ,i2,i3)+REAL(AIMAG(b1(i3)))
-             u2(2*i1-1,i2,i3)=u2(2*i1-1,i2,i3)+REAL( REAL(b2(i3)))
-             u2(2*i1  ,i2,i3)=u2(2*i1  ,i2,i3)+REAL(AIMAG(b2(i3)))
-             u3(2*i1-1,i2,i3)=u3(2*i1-1,i2,i3)+REAL( REAL(b3(i3)))
-             u3(2*i1  ,i2,i3)=u3(2*i1  ,i2,i3)+REAL(AIMAG(b3(i3)))
-          END DO
-       END DO
-    END DO
-    
-  CONTAINS
-    !-----------------------------------------------------------------
-    !> subroutine CerrutiSolCowling
-    !! computes the general solution for the deformation field in an
-    !! elastic half-space due to an arbitrary surface traction in the
-    !! presence of gravity.
-    !!
-    !! The 3 components u1, u2 and u3 of the deformation field are 
-    !! expressed in the horizontal Fourier at depth x3. 
-    !!
-    !! Combines the solution to the Boussinesq's and the Cerruti's 
-    !! problem in a half-space with buoyancy boundary conditions.
-    !
-    ! sylvain barbot (07-07-07) - original form
-    !-----------------------------------------------------------------
-    SUBROUTINE cerrutisolcowling(p1,p2,p3,alpha,gamma,u1,u2,u3,k1,k2,x3)
-      COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
-      REAL*8, INTENT(IN) :: alpha,gamma,k1,k2,x3
-      COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
-        
-      REAL*8 :: beta, depthdecay, h
-      COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2)
-      REAL*8  :: temp
-      COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
-      
-      beta=pi2*sqrt(k1**2+k2**2)
-      depthdecay=exp(-beta*abs(x3))
-      h=gamma/beta
-      
-      IF (0==k1 .AND. 0==k2) THEN
-         u1=CMPLX(0._4,0._4)
-         u2=CMPLX(0._4,0._4)
-         u3=CMPLX(0._4,0._4)
-      ELSE
-         temp=1._8/(2._8*mu*beta**3)*depthdecay
-         b1=temp*p1
-         b2=temp*p2
-         b3=temp*p3/(1+h)
-           
-         ! b3 contribution
-         tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
-         v1=tmp*k1
-         v2=tmp*k2
-         v3=-beta**2*b3*(1._8/alpha+beta*x3)
-           
-         ! b1 contribution
-         temp=pi2**2*(2._8-1._8/alpha+beta*x3)/(1+h)
-         v1=v1+b1*(-2._8*beta**2+k1**2*temp)
-         v2=v2+b1*k1*k2*temp
-         v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
-           
-         ! b2 contribution & switch to single-precision
-         u1=v1+b2*k1*k2*temp
-         u2=v2+b2*(-2._8*beta**2+k2**2*temp)
-         u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
-      END IF
-
-    END SUBROUTINE cerrutisolcowling
-
-  END SUBROUTINE cerruticowlingserial
-
-  !------------------------------------------------------------------
-  !> subroutine GreenFunction
-  !! computes (inplace) the displacement components due to a set of
-  !! 3-D body-forces by application of the semi-analytic Green's
-  !! function. The solution satisfies quasi-static Navier's equation
-  !! including vanishing of normal traction at the surface.
-  !!
-  !! The surface traction can be made to vanish by application of
-  !!   1) method of images + boussinesq problem (grn_method=GRN_IMAGE)
-  !!   2) boussinesq's and cerruti's problems (grn_method=GRN_HS)
-  !! in the first case, the body-forces are supposed by have been
-  !! imaged appropriately.
-  !
-  ! sylvain barbot (07/07/07) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE greenfunction(c1,c2,c3,t1,t2,t3,dx1,dx2,dx3,lambda,mu,grn_method)
-    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: c1,c2,c3
-    REAL*4, INTENT(INOUT), DIMENSION(:,:) :: t1,t2,t3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    REAL*8, INTENT(IN) :: lambda,mu
-    INTEGER, INTENT(IN) :: grn_method
-  
-    INTEGER :: sx1,sx2,sx3,status
-
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: p1,p2,p3
-
-    sx1=SIZE(c1,1)-2
-    sx2=SIZE(c1,2)
-    sx3=SIZE(c1,3)
-
-    ALLOCATE(p1(sx1+2,sx2),p2(sx1+2,sx2),p3(sx1+2,sx2),STAT=status)
-    IF (status > 0) THEN
-       WRITE_DEBUG_INFO
-       WRITE(0,'("could not allocate memory for green function")')
-       STOP 1
-    ELSE
-       p1=0;p2=0;p3=0;
-    END IF
-
-    ! forward Fourier transform equivalent body-force
-    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_FORWARD)
-    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_FORWARD)
-    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_FORWARD)
-   
-    ! solve for displacement field
-    CALL elasticresponse(lambda,mu,c1,c2,c3,dx1,dx2,dx3)
-    IF (GRN_IMAGE .eq. grn_method) THEN
-       CALL surfacenormaltraction(lambda,mu,c1,c2,c3,dx1,dx2,dx3,p3)
-       p3=t3-p3
-       CALL boussinesq3d(p3,lambda,mu,c1,c2,c3,dx1,dx2,dx3)
-    ELSE
-       CALL surfacetraction(lambda,mu,c1,c2,c3,dx1,dx2,dx3,p1,p2,p3)
-       p1=t1-p1
-       p2=t2-p2
-       p3=t3-p3
-       CALL cerruti3d(p1,p2,p3,lambda,mu,c1,c2,c3,dx1,dx2,dx3)
-    END IF
-
-    ! inverse Fourier transform solution displacement components
-    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_INVERSE)
-    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_INVERSE)
-    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_INVERSE)
-
-    DEALLOCATE(p1,p2,p3)
-    
-  END SUBROUTINE greenfunction
-
-  !------------------------------------------------------------------
-  !> subroutine GreensFunctionCowling
-  !! computes (inplace) the displacement components due to a set of
-  !! 3-D body-forces by application of the semi-analytic Green's
-  !! function. The solution satisfies quasi-static Navier's equation
-  !! with buoyancy boundary condition to simulate the effect of 
-  !! gravity (the Cowling approximation).
-  !!
-  !! the importance of gravity depends upon the density contrast rho 
-  !! at the surface, the acceleration of gravity g and the value of 
-  !! shear modulus mu in the crust. effect on the displacement field
-  !! is governed by the gradient
-  !!
-  !!            gamma = (1 - nu) rho g / mu
-  !!                  = rho g / (2 mu alpha)
-  !! 
-  !! where nu is the Poisson's ratio. For a Poisson's solid with 
-  !! nu = 1/4, with a density contrast rho = 3200 kg/m^3 and a shear
-  !! modulus mu = 30 GPa, we have gamma = 0.8e-6 /m.
-  !!
-  !! INPUT:
-  !!   @param c1,c2,c3    is a set of body forces
-  !!   @param dx1,dx2,dx3 are the sampling size
-  !!   @param lambda,mu   are the Lame elastic parameters
-  !!   @param gamma       is the gravity coefficient
-  !
-  ! sylvain barbot (07/07/07) - original function greenfunction
-  !                (11/21/08) - effect of gravity
-  !------------------------------------------------------------------
-  SUBROUTINE greenfunctioncowling(c1,c2,c3,t1,t2,t3,dx1,dx2,dx3, &
-                                  lambda,mu,gamma)
-    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: c1,c2,c3
-    REAL*4, INTENT(INOUT), DIMENSION(:,:) :: t1,t2,t3
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3
-    REAL*8, INTENT(IN) :: lambda,mu,gamma
-  
-    INTEGER :: sx1,sx2,sx3,status
-
-    REAL*4, DIMENSION(:,:), ALLOCATABLE :: p1,p2,p3
-
-    sx1=SIZE(c1,1)-2
-    sx2=SIZE(c1,2)
-    sx3=SIZE(c1,3)
-
-    ALLOCATE(p1(sx1+2,sx2),p2(sx1+2,sx2),p3(sx1+2,sx2),STAT=status)
-    IF (status > 0) THEN
-       WRITE_DEBUG_INFO
-       WRITE(0,'("could not allocate memory for green function")')
-       STOP 1
-    ELSE
-       p1=0;p2=0;p3=0;
-    END IF
-
-    ! forward Fourier transform equivalent body-force
-    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
-    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_FORWARD)
-    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_FORWARD)
-    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_FORWARD)
-   
-    ! solve for displacement field
-    CALL elasticresponse(lambda,mu,c1,c2,c3,dx1,dx2,dx3)
-
-    CALL surfacetractioncowling(lambda,mu,gamma, &
-         c1,c2,c3,dx1,dx2,dx3,p1,p2,p3)
-    p1=t1-p1
-    p2=t2-p2
-    p3=t3-p3
-    CALL cerruticowling(p1,p2,p3,lambda,mu,gamma, &
-         c1,c2,c3,dx1,dx2,dx3)
-    
-    ! inverse Fourier transform solution displacement components
-    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
-    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_INVERSE)
-    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_INVERSE)
-    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_INVERSE)
-
-    DEALLOCATE(p1,p2,p3)
-    
-  END SUBROUTINE greenfunctioncowling
-
-END MODULE green
diff -r 405d8f4fa05f -r e7295294f654 include.f90
--- a/include.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-#include "config.h"
-
-! implement SGI Fast Fourier Transforms library
-!#define SGI_FFT 1
-
-! export data to GMT XYZ text format
-!#define XYZ 1
-
-! export data to GMT GRD binary format
-#define GRD 1
-
-! export equivalent body forces in GRD format
-!#define GRD_EQBF 1
-
-! export amplitude of scalar fields 
-! along a plane in GRD binary format
-#define GRD_EXPORTEIGENSTRAIN 1
-
-! export creep velocity along a frictional 
-! plane in GRD binary format
-#define GRD_EXPORTCREEP 1
-
-! export data to the TXT format
-!#define TXT 1
-
-! export data to longitude/latitude format
-#define PROJ 1
-
-! export amplitude of scalar fields along 
-! an observation plane in text format
-#define TXT_EXPORTEIGENSTRAIN 1
-
-! export creep velocity along a frictional 
-! plane in text format
-!#define TXT_EXPORTCREEP 1
-
-! export data to VTK format (for visualization in Paraview)
-#define VTK 1
-!#define VTK_EQBF 1
-
-#define WRITE_DEBUG_INFO WRITE (0,'("error at line ",I5.5," of source file ",a)') __LINE__,__FILE__
-
-
-#ifdef IMKL_FFT
-#define WRITE_MKL_DEBUG_INFO(i) IF(i.NE.0)THEN;IF(.NOT.DftiErrorClass(i,DFTI_NO_ERROR))THEN;WRITE_DEBUG_INFO;WRITE (0,*) DftiErrorMessage(i);STOP 1;END IF;END IF
-#endif
-
-! adjust data alignment for the Fourier transform
-#ifdef FFTW3
-#define ALIGN_DATA 1
-#else
-#ifdef SGI_FFT
-#define ALIGN_DATA 1
-#else
-#ifdef IMKL_FFT
-#define ALIGN_DATA 1
-#endif
-#endif
-#endif
diff -r 405d8f4fa05f -r e7295294f654 input.f90
--- a/input.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1368 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-#include "include.f90"
-
-MODULE input
-
-  IMPLICIT NONE
-
-  REAL*8, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
-
-CONTAINS
-
-  !---------------------------------------------------------------------
-  !> subroutine init
-  !! reads simulation parameters from the standard input and initialize
-  !! model parameters.
-  !!
-  !! INPUT:
-  !! @param unit - the unit number used to read input data
-  !!
-  !! OUTPUT:
-  !! @param in
-  !---------------------------------------------------------------------
-  SUBROUTINE init(in,unit)
-    USE types
-    USE export
-    USE getopt_m
-
-    TYPE(SIMULATION_STRUC), INTENT(OUT) :: in
-    INTEGER, OPTIONAL, INTENT(INOUT) :: unit
-
-    CHARACTER :: ch
-    CHARACTER(180) :: dataline
-    CHARACTER(80) :: rffilename,filename
-#ifdef VTK
-    CHARACTER(3) :: digit
-    CHARACTER(4) :: digit4
-#endif
-    INTEGER :: iunit
-!$  INTEGER :: omp_get_num_procs,omp_get_max_threads
-    REAL*8 :: dummy,dum1,dum2
-    REAL*8 :: minlength,minwidth
-    TYPE(OPTION_S) :: opts(12)
-
-    INTEGER :: k,iostatus,i,e
-
-    ! default is standard input
-    IF (.NOT. PRESENT(unit)) THEN
-       iunit=5
-    ELSE
-       iunit=unit
-    END IF
-
-    ! parse the command line for options
-    opts( 1)=OPTION_S("no-proj-output",.FALSE.,CHAR(20))
-    opts( 2)=OPTION_S("no-relax-output",.FALSE.,CHAR(21))
-    opts( 3)=OPTION_S("no-txt-output",.FALSE.,CHAR(22))
-    opts( 4)=OPTION_S("no-vtk-output",.FALSE.,CHAR(23))
-    opts( 5)=OPTION_S("no-grd-output",.FALSE.,CHAR(24))
-    opts( 6)=OPTION_S("no-xyz-output",.FALSE.,CHAR(25))
-    opts( 7)=OPTION_S("no-stress-output",.FALSE.,CHAR(26))
-    opts( 8)=OPTION_S("with-stress-output",.FALSE.,CHAR(27))
-    opts( 9)=OPTION_S("with-vtk-output",.FALSE.,CHAR(28))
-    opts(10)=OPTION_S("with-vtk-relax-output",.FALSE.,CHAR(29))
-    opts(11)=OPTION_S("dry-run",.FALSE.,CHAR(30))
-    opts(12)=OPTION_S("help",.FALSE.,'h')
-
-    DO
-       ch=getopt("h",opts)
-       SELECT CASE(ch)
-       CASE(CHAR(0))
-          EXIT
-       CASE(CHAR(20))
-          ! option no-proj-output
-          in%isoutputproj=.FALSE.
-       CASE(CHAR(21))
-          ! option no-relax-output
-          in%isoutputrelax=.FALSE.
-       CASE(CHAR(22))
-          ! option no-txt-output
-          in%isoutputtxt=.FALSE.
-       CASE(CHAR(23))
-          ! option no-vtk-output
-          in%isoutputvtk=.FALSE.
-       CASE(CHAR(24))
-          ! option no-grd-output
-          in%isoutputgrd=.FALSE.
-       CASE(CHAR(25))
-          ! option no-xyz-output
-          in%isoutputxyz=.FALSE.
-       CASE(CHAR(26))
-          ! option stress output
-          in%isoutputstress=.FALSE.
-       CASE(CHAR(27))
-          ! option dry-run
-          in%isoutputstress=.TRUE.
-       CASE(CHAR(28))
-          ! option with-output-vtk
-          in%isoutputvtk=.TRUE.
-       CASE(CHAR(29))
-          ! option with-output-vtk-relax
-          in%isoutputvtkrelax=.TRUE.
-       CASE(CHAR(30))
-          ! option dry-run
-          in%isdryrun=.TRUE.
-       CASE('h')
-          ! option help
-          in%ishelp=.TRUE.
-       CASE('?')
-          WRITE_DEBUG_INFO
-          in%ishelp=.TRUE.
-          EXIT
-       CASE DEFAULT
-          WRITE (0,'("unhandled option ", a, " (this is a bug")') optopt
-          WRITE_DEBUG_INFO
-          STOP 3
-       END SELECT
-    END DO
-
-    IF (in%ishelp) THEN
-       PRINT '("usage:")'
-       PRINT '("relax [-h] [--dry-run] [--help] [--no-grd-output] [--no-proj-output]")' 
-       PRINT '("      [--no-relax-output] [--no-stress-output] [--no-txt-output]")'
-       PRINT '("      [--no-vtk-output] [--no-xyz-output]")'
-       PRINT '("")'
-       PRINT '("options:")'
-       PRINT '("   -h                      prints this message and aborts calculation")'
-       PRINT '("   --dry-run               abort calculation, only output geometry")'
-       PRINT '("   --help                  prints this message and aborts calculation")'
-       PRINT '("   --no-grd-output         cancel output in GMT grd binary format")'
-       PRINT '("   --no-proj-output        cancel output in geographic projection")'
-       PRINT '("   --no-relax-output       cancel output of the postseismic contribution")'
-       PRINT '("   --no-stress-output      cancel output of stress tensor in any format")'
-       PRINT '("   --no-txt-output         cancel output in text format")'
-       PRINT '("   --no-vtk-output         cancel output in Paraview VTK format")'
-       PRINT '("   --no-xyz-output         cancel output in GMT xyz format")'
-       PRINT '("   --with-stress-output    export stress tensor")'
-       PRINT '("   --with-vtk-output       export output in Paraview VTK format")'
-       PRINT '("   --with-vtk-relax-output export relaxation to VTK format")'
-       PRINT '("")'
-       PRINT '("description:")'
-       PRINT '("   Evaluates the deformation due to fault slip, surface loading")'
-       PRINT '("   or inflation and the time series of postseismic relaxation")'
-       PRINT '("   that follows due to fault creep or viscoelastic flow.")'
-       RETURN
-    END IF
-    PRINT 2000
-    PRINT '(" RELAX: nonlinear postseismic relaxation with Fourier-domain Green''s function")'
-#ifdef FFTW3
-#ifdef FFTW3_THREADS
-    PRINT '("     * FFTW3 (multi-threaded) implementation of the FFT")'
-#else
-    PRINT '("     * FFTW3 implementation of the FFT")'
-#endif
-#else
-#ifdef SGI_FFT
-    PRINT '("     * SGI_FFT implementation of the FFT")'
-#else
-#ifdef IMKL_FFT
-    PRINT '("     * Intel MKL implementation of the FFT")'
-#else
-    PRINT '("     * fourt implementation of the FFT")'
-#endif
-#endif
-#endif
-!$  PRINT '("     * parallel OpenMP implementation with ",I3.3,"/",I3.3," threads")', &
-!$                  omp_get_max_threads(),omp_get_num_procs()
-#ifdef PROJ
-    IF (in%isoutputproj) THEN
-       PRINT '("     * export to longitude/latitude text format")'
-    ELSE
-       PRINT '("     * export to longitude/latitude text format cancelled (--",a,")")', trim(opts(1)%name)
-    END IF
-#endif
-#ifdef TXT
-    IF (in%isoutputtxt) THEN
-       PRINT '("     * export to TXT format")'
-    ELSE
-       PRINT '("     * export to TXT format cancelled                     (--",a,")")', trim(opts(3)%name)
-    END IF
-#ifdef GRD
-    IF (in%isoutputgrd) THEN
-       PRINT '("     * export to GRD format")'
-    ELSE
-       PRINT '("     * export to GRD format cancelled                     (--",a,")")', trim(opts(5)%name)
-    END IF
-#endif
-#ifdef XYZ
-    IF (in%isoutputxyz) THEN
-       PRINT '("     * export to XYZ format")'
-    ELSE
-       PRINT '("     * export to XYZ format cancelled                     (--",a,")")', trim(opts(6)%name)
-    END IF
-#endif
-#endif
-#ifdef VTK
-    IF (in%isoutputvtk) THEN
-       PRINT '("     * export to VTK format")'
-    ELSE
-       PRINT '("     * export to VTK format cancelled                     (--",a,")")', trim(opts(4)%name)
-    END IF
-    IF (in%isoutputvtkrelax) THEN
-       PRINT '("     * export relaxation component to VTK format   (--",a,")")', trim(opts(10)%name)
-    END IF
-#endif
-    PRINT 2000
-
-    PRINT '(a)', "grid dimension (sx1,sx2,sx3)"
-    CALL getdata(iunit,dataline)
-    READ (dataline,*) in%sx1,in%sx2,in%sx3
-    PRINT '(3I5)', in%sx1,in%sx2,in%sx3
-
-    PRINT '(a)', "sampling (dx1,dx2,dx3), smoothing (beta, nyquist)"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%dx1,in%dx2,in%dx3,in%beta,in%nyquist
-    PRINT '(5ES9.2E1)', in%dx1,in%dx2,in%dx3,in%beta,in%nyquist
-
-    PRINT '(a)', "origin position (x0,y0) and rotation"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%x0,in%y0,in%rot
-    PRINT '(3ES9.2E1)', in%x0,in%y0,in%rot
-
-#ifdef PROJ
-    IF (in%isoutputproj) THEN
-       PRINT '(a)', "geographic origin (longitude, latitude, UTM zone, unit)"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%lon0,in%lat0,in%zone,in%umult
-       PRINT '(2ES9.2E1,I3.2,ES9.2E1)',in%lon0,in%lat0,in%zone,in%umult
-       IF (in%zone.GT.60 .OR. in%zone.LT.1) THEN
-          WRITE_DEBUG_INFO
-          WRITE (0,'("invalid UTM zone ",I3," (1<=zone<=60. exiting.)")') in%zone
-          STOP 1
-       END IF
-    END IF
-#endif
-
-    PRINT '(a)', "observation depth (displacement and stress)"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%oz,in%ozs
-    PRINT '(2ES9.2E1)', in%oz,in%ozs
-
-    PRINT '(a)', "output directory"
-    CALL getdata(iunit,dataline)
-    READ (dataline,'(a)') in%wdir
-
-    in%reporttimefilename=trim(in%wdir)//"/time.txt"
-    in%reportfilename=trim(in%wdir)//"/report.txt"
-#ifdef TXT
-    PRINT '(" ",a," (report: ",a,")")', trim(in%wdir),trim(in%reportfilename)
-#else
-    PRINT '(" ",a," (time report: ",a,")")', trim(in%wdir),trim(in%reporttimefilename)
-#endif
-
-    ! test write permissions on output directory
-    OPEN (UNIT=14,FILE=in%reportfilename,POSITION="APPEND",&
-            IOSTAT=iostatus,FORM="FORMATTED")
-    IF (iostatus>0) THEN
-       WRITE_DEBUG_INFO
-       WRITE (0,'("unable to access ",a)') trim(in%reporttimefilename)
-       STOP 1
-    END IF
-    CLOSE(14)
-    ! end test
-
-#ifdef VTK
-    filename=trim(in%wdir)//"/cgrid.vtp"
-    CALL exportvtk_grid(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3,filename)
-#endif
-
-    PRINT '(a)', "lambda, mu, gamma (gamma = (1 - nu) rho g / mu)"
-    CALL getdata(iunit,dataline)
-    READ (dataline,*) in%lambda,in%mu,in%gam
-    PRINT '(3ES10.2E2)',in%lambda,in%mu,in%gam
-
-    PRINT '(a)', "time interval, (positive time step) or (negative skip, scaling)"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%interval, in%odt
-
-    IF (in%odt .LT. 0.) THEN
-       READ  (dataline,*) dum1, dum2, in%tscale
-       in%skip=ceiling(-in%odt)
-       PRINT '(ES9.2E1," (output every ",I3.3," steps, dt scaled by ",ES7.2E1,")")', &
-             in%interval,in%skip,in%tscale
-    ELSE
-       PRINT '(ES9.2E1," (output every ",ES9.2E1," time unit)")', in%interval,in%odt
-    END IF
-
-    
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !           O B S E R V A T I O N          P L A N E S 
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of observation planes"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%nop
-    PRINT '(I5)', in%nop
-    IF (in%nop .gt. 0) THEN
-       ALLOCATE(in%op(in%nop),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the observation plane list"
-       PRINT 2000
-       PRINT 2100
-       PRINT 2000
-       DO k=1,in%nop
-          CALL getdata(iunit,dataline)
-          READ  (dataline,*) i,in%op(k)%x,in%op(k)%y,in%op(k)%z,&
-               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip
-
-          PRINT '(I3.3," ",5ES9.2E1,2f7.1)', &
-               k,in%op(k)%x,in%op(k)%y,in%op(k)%z, &
-               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip
-
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,*) "error in input file: plane index misfit", k,"<>",i
-             WRITE (0,*) in%op(k)
-             STOP 1
-          END IF
-
-          ! comply to Wang's convention
-          CALL wangconvention(dummy,in%op(k)%x,in%op(k)%y,in%op(k)%z,&
-               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip, &
-               dummy,in%x0,in%y0,in%rot)
-
-       END DO
-    END IF
-
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !         O B S E R V A T I O N       P O I N T S
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of observation points"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%npts
-    PRINT '(I5)', in%npts
-    IF (in%npts .gt. 0) THEN
-       ALLOCATE(in%opts(in%npts),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the observation point list"
-       ALLOCATE(in%ptsname(in%npts),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the list of point name"
-
-       PRINT 2000
-       PRINT 2300
-       PRINT 2000
-       DO k=1,in%npts
-          CALL getdata(iunit,dataline)
-          READ (dataline,*) i,in%ptsname(k),in%opts(k)%v1,in%opts(k)%v2,in%opts(k)%v3
-
-          PRINT '(I3.3," ",A4,3ES9.2E1)', i,in%ptsname(k), &
-               in%opts(k)%v1,in%opts(k)%v2,in%opts(k)%v3
-
-          ! shift and rotate coordinates
-          in%opts(k)%v1=in%opts(k)%v1-in%x0
-          in%opts(k)%v2=in%opts(k)%v2-in%y0
-          CALL rotation(in%opts(k)%v1,in%opts(k)%v2,in%rot)
-
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: points index misfit")')
-             STOP 1
-          END IF
-       END DO
-
-       ! export the lits of observation points for display
-       filename=trim(in%wdir)//"/opts.dat"
-       CALL exportoptsdat(in%npts,in%opts,in%ptsname,filename)
-
-    END IF
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !   C O U L O M B      O B S E R V A T I O N      S E G M E N T S
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of stress observation segments"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%nsop
-    PRINT '(I5)', in%nsop
-    IF (in%nsop .gt. 0) THEN
-       ALLOCATE(in%sop(in%nsop),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the segment list"
-       PRINT 2000
-       PRINT '(a)',"no.        xs       ys       zs  length   width strike   dip friction"
-       PRINT 2000
-       DO k=1,in%nsop
-          CALL getdata(iunit,dataline)
-          READ (dataline,*) i, &
-               in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
-               in%sop(k)%length,in%sop(k)%width, &
-               in%sop(k)%strike,in%sop(k)%dip,in%sop(k)%friction
-          in%sop(k)%sig0=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
-
-          PRINT '(I4.4,3ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
-               in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
-               in%sop(k)%length,in%sop(k)%width, &
-               in%sop(k)%strike,in%sop(k)%dip, &
-               in%sop(k)%friction
-             
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("invalid segment definition ")')
-             WRITE (0,'("error in input file: source index misfit")')
-             STOP 1
-          END IF
-          IF (MAX(in%sop(k)%length,in%sop(k)%width) .LE. 0._8) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: length and width must be positive.")')
-             STOP 1
-          END IF
-
-          ! comply to Wang's convention
-          CALL wangconvention(dummy, &
-                     in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
-                     in%sop(k)%length,in%sop(k)%width, &
-                     in%sop(k)%strike,in%sop(k)%dip, &
-                     dummy, &
-                     in%x0,in%y0,in%rot)
-       END DO
-
-       ! export patches to vtk/vtp
-       filename=trim(in%wdir)//"/rfaults-dsigma-0000.vtp"
-       CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                     in%nsop,in%sop,filename,convention=1)
-
-    END IF
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !                     P R E S T R E S S
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of prestress interfaces"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%nps
-    PRINT '(I5)', in%nps
-
-    IF (in%nps .GT. 0) THEN
-       ALLOCATE(in%stresslayer(in%nps),in%stressstruc(in%sx3/2),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the stress layer structure"
-       
-       PRINT 2000
-       PRINT '(a)', "no.    depth  sigma11  sigma12  sigma13  sigma22  sigma23  sigma33"
-       PRINT 2000
-       DO k=1,in%nps
-          CALL getdata(iunit,dataline)
-          READ  (dataline,*) i,in%stresslayer(k)%z, &
-               in%stresslayer(k)%t%s11, in%stresslayer(k)%t%s12, &
-               in%stresslayer(k)%t%s13, in%stresslayer(k)%t%s22, &
-               in%stresslayer(k)%t%s23, in%stresslayer(k)%t%s33
-          
-          PRINT '(I3.3,7ES9.2E1)', i, &
-               in%stresslayer(k)%z, &
-               in%stresslayer(k)%t%s11, in%stresslayer(k)%t%s12, &
-               in%stresslayer(k)%t%s13, in%stresslayer(k)%t%s22, &
-               in%stresslayer(k)%t%s23, in%stresslayer(k)%t%s33
-          
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: index misfit")')
-             STOP 1
-          END IF
-       END DO
-    END IF
-
-
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !  L I N E A R    V I S C O U S    I N T E R F A C E
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of linear viscous interfaces"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%nv
-    PRINT '(I5)', in%nv
-    
-    IF (in%nv .GT. 0) THEN
-       ALLOCATE(in%linearlayer(in%nv),in%linearstruc(in%sx3/2),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the layer structure"
-       
-       PRINT 2000
-       PRINT '(a)', "no.     depth    gamma0  cohesion"
-       PRINT 2000
-       DO k=1,in%nv
-          CALL getdata(iunit,dataline)
-          READ  (dataline,*) i,in%linearlayer(k)%z, &
-               in%linearlayer(k)%gammadot0, in%linearlayer(k)%cohesion
-
-          in%linearlayer(k)%stressexponent=1
-
-          PRINT '(I3.3,3ES10.2E2)', i, &
-               in%linearlayer(k)%z, &
-               in%linearlayer(k)%gammadot0, &
-               in%linearlayer(k)%cohesion
-          
-          ! check positive strain rates
-          IF (in%linearlayer(k)%gammadot0 .LT. 0) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: strain rates must be positive")')
-             STOP 1
-          END IF
-
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: index misfit")')
-             STOP 1
-          END IF
-#ifdef VTK
-          ! export the viscous layer in VTK format
-          WRITE (digit,'(I3.3)') k
-
-          rffilename=trim(in%wdir)//"/linearlayer-"//digit//".vtp"
-          CALL exportvtk_rectangle(0.d0,0.d0,in%linearlayer(k)%z, &
-                                   DBLE(in%sx1)*in%dx1,DBLE(in%sx2)*in%dx2, &
-                                   0._8,1.5708d0,rffilename)
-#endif
-       END DO
-
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !                 L I N E A R   W E A K   Z O N E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of linear weak zones"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%nlwz
-       PRINT '(I5)', in%nlwz
-       IF (in%nlwz .GT. 0) THEN
-          ALLOCATE(in%linearweakzone(in%nlwz),in%linearweakzonec(in%nlwz),STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the linear weak zones"
-          PRINT 2000
-          PRINT '(a)', "no. dgammadot0     x1       x2       x3  length   width thickn. strike   dip"
-          PRINT 2000
-          DO k=1,in%nlwz
-             CALL getdata(iunit,dataline)
-             READ  (dataline,*) i, &
-                  in%linearweakzone(k)%dgammadot0, &
-                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z,&
-                  in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
-                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip
-          
-             in%linearweakzonec(k)=in%linearweakzone(k)
-             
-             PRINT '(I3.3,4ES9.2E1,3ES8.2E1,f7.1,f6.1)',k,&
-                  in%linearweakzone(k)%dgammadot0, &
-                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
-                  in%linearweakzone(k)%length,in%linearweakzone(k)%width, &
-                  in%linearweakzone(k)%thickness, &
-                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip
-             
-             IF (i .ne. k) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("error in input file: source index misfit")')
-                STOP 1
-             END IF
-             ! comply to Wang's convention
-             CALL wangconvention( &
-                  dummy, & 
-                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
-                  in%linearweakzone(k)%length,in%linearweakzone(k)%width, &
-                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip, &
-                  dummy,in%x0,in%y0,in%rot)
-
-                  WRITE (digit,'(I3.3)') k
-
-#ifdef VTK
-                  ! export the ductile zone in VTK format
-                  rffilename=trim(in%wdir)//"/weakzone-"//digit//".vtp"
-                  CALL exportvtk_brick(in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
-                                       in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
-                                       in%linearweakzone(k)%strike,in%linearweakzone(k)%dip,rffilename)
-#endif
-                  ! export the ductile zone in GMT .xy format
-                  rffilename=trim(in%wdir)//"/weakzone-"//digit//".xy"
-                  CALL exportxy_brick(in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
-                                      in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
-                                      in%linearweakzone(k)%strike,in%linearweakzone(k)%dip,rffilename)
-          END DO
-       END IF
-    END IF ! end linear viscous
-       
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !  N O N L I N E A R    V I S C O U S    I N T E R F A C E
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of nonlinear viscous interfaces"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%npl
-    PRINT '(I5)', in%npl
-
-    IF (in%npl .GT. 0) THEN
-       ALLOCATE(in%nonlinearlayer(in%npl),in%nonlinearstruc(in%sx3/2),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the layer structure"
-       
-       PRINT 2000
-       PRINT '(a)', "no.     depth    gamma0     power  cohesion"
-       PRINT 2000
-       DO k=1,in%npl
-          CALL getdata(iunit,dataline)
-
-          READ  (dataline,*) i,in%nonlinearlayer(k)%z, &
-               in%nonlinearlayer(k)%gammadot0, &
-               in%nonlinearlayer(k)%stressexponent, &
-               in%nonlinearlayer(k)%cohesion
-
-          PRINT '(I3.3,4ES10.2E2)', i, &
-               in%nonlinearlayer(k)%z, &
-               in%nonlinearlayer(k)%gammadot0, &
-               in%nonlinearlayer(k)%stressexponent, &
-               in%nonlinearlayer(k)%cohesion
-          
-          ! check positive strain rates
-          IF (in%nonlinearlayer(k)%gammadot0 .LT. 0) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: strain rates must be positive")')
-             STOP 1
-          END IF
-
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: index misfit")')
-             STOP 1
-          END IF
-
-#ifdef VTK
-          WRITE (digit,'(I3.3)') k
-
-          ! export the viscous layer in VTK format
-          rffilename=trim(in%wdir)//"/nonlinearlayer-"//digit//".vtp"
-          CALL exportvtk_rectangle(0.d0,0.d0,in%nonlinearlayer(k)%z, &
-                                   DBLE(in%sx1)*in%dx1,DBLE(in%sx2)*in%dx2, &
-                                   0._8,1.57d0,rffilename)
-#endif
-       END DO
-
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !           N O N L I N E A R   W E A K   Z O N E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of nonlinear weak zones"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%nnlwz
-       PRINT '(I5)', in%nnlwz
-       IF (in%nnlwz .GT. 0) THEN
-          ALLOCATE(in%nonlinearweakzone(in%nnlwz),in%nonlinearweakzonec(in%nnlwz),STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the nonlinear weak zones"
-          PRINT 2000
-          PRINT '(a)', "no. dgammadot0     x1       x2       x3  length   width thickn. strike   dip"
-          PRINT 2000
-          DO k=1,in%nnlwz
-             CALL getdata(iunit,dataline)
-             READ  (dataline,*) i, &
-                  in%nonlinearweakzone(k)%dgammadot0, &
-                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z,&
-                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width,in%nonlinearweakzone(k)%thickness, &
-                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip
-          
-             in%nonlinearweakzonec(k)=in%nonlinearweakzone(k)
-             
-             PRINT '(I3.3,4ES9.2E1,3ES8.2E1,f7.1,f6.1)',k,&
-                  in%nonlinearweakzone(k)%dgammadot0, &
-                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z, &
-                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width, &
-                  in%nonlinearweakzone(k)%thickness, &
-                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip
-             
-             IF (i .ne. k) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("error in input file: source index misfit")')
-                STOP 1
-             END IF
-             ! comply to Wang's convention
-             CALL wangconvention( &
-                  dummy, & 
-                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z, &
-                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width, &
-                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip, &
-                  dummy,in%x0,in%y0,in%rot)
-
-                  WRITE (digit,'(I3.3)') k
-
-#ifdef VTK
-                  ! export the ductile zone in VTK format
-                  rffilename=trim(in%wdir)//"/weakzone-nl-"//digit//".vtp"
-                  CALL exportvtk_brick(in%nonlinearweakzone(k)%x, &
-                                       in%nonlinearweakzone(k)%y, &
-                                       in%nonlinearweakzone(k)%z, &
-                                       in%nonlinearweakzone(k)%length, &
-                                       in%nonlinearweakzone(k)%width, &
-                                       in%nonlinearweakzone(k)%thickness, &
-                                       in%nonlinearweakzone(k)%strike, &
-                                       in%nonlinearweakzone(k)%dip,rffilename)
-#endif
-                  ! export the ductile zone in GMT .xy format
-                  rffilename=trim(in%wdir)//"/weakzone-nl-"//digit//".xy"
-                  CALL exportxy_brick(in%nonlinearweakzone(k)%x, &
-                                       in%nonlinearweakzone(k)%y, &
-                                       in%nonlinearweakzone(k)%z, &
-                                       in%nonlinearweakzone(k)%length, &
-                                       in%nonlinearweakzone(k)%width, &
-                                       in%nonlinearweakzone(k)%thickness, &
-                                       in%nonlinearweakzone(k)%strike, &
-                                       in%nonlinearweakzone(k)%dip,rffilename)
-          END DO
-       END IF
-    END IF ! end nonlinear viscous
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !                 F A U L T    C R E E P
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of fault creep interfaces"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%nfc
-    PRINT '(I5)', in%nfc
-
-    IF (in%nfc .GT. 0) THEN
-       ALLOCATE(in%faultcreeplayer(in%nfc),in%faultcreepstruc(in%sx3/2),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the layer structure"
-
-       PRINT 2000
-       PRINT '(a)', "no.    depth   gamma0 (a-b)sig friction cohesion"
-       PRINT 2000
-       DO k=1,in%nfc
-          CALL getdata(iunit,dataline)
-          READ  (dataline,*) i,in%faultcreeplayer(k)%z, &
-               in%faultcreeplayer(k)%gammadot0, &
-               in%faultcreeplayer(k)%stressexponent, &
-               in%faultcreeplayer(k)%friction, &
-               in%faultcreeplayer(k)%cohesion
-
-          PRINT '(I3.3,5ES9.2E1)', i, &
-               in%faultcreeplayer(k)%z, &
-               in%faultcreeplayer(k)%gammadot0, &
-               in%faultcreeplayer(k)%stressexponent, &
-               in%faultcreeplayer(k)%friction, &
-               in%faultcreeplayer(k)%cohesion
-
-          ! check positive strain rates
-          IF (in%faultcreeplayer(k)%gammadot0 .LT. 0) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: slip rates must be positive")')
-             STOP 1
-          END IF
-
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: index misfit")')
-             STOP 1
-          END IF
-
-       END DO
-
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !             A F T E R S L I P       P L A N E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of afterslip planes"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%np
-       PRINT '(I5)', in%np
-       
-       IF (in%np .gt. 0) THEN
-          ALLOCATE(in%n(in%np),STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the plane list"
-       
-          PRINT 2000
-          PRINT 2500
-          PRINT 2000
-          
-          DO k=1,in%np
-             CALL getdata(iunit,dataline)
-             READ (dataline,*) i, &
-                  in%n(k)%x,in%n(k)%y,in%n(k)%z,&
-                  in%n(k)%length,in%n(k)%width, &
-                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake
-             
-             PRINT '(I3.3," ",5ES9.2E1,3f7.1)',i, &
-                  in%n(k)%x,in%n(k)%y,in%n(k)%z, &
-                  in%n(k)%length,in%n(k)%width, &
-                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake
-
-             IF (i .ne. k) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("error in input file: plane index misfit")')
-                STOP 1
-             END IF
-
-             ! modify rake for consistency with slip model
-             IF (in%n(k)%rake .GE. 0.d0) THEN
-                in%n(k)%rake=in%n(k)%rake-180.d0
-             ELSE             
-                in%n(k)%rake=in%n(k)%rake+180.d0
-             END IF
-
-             ! comply to Wang's convention
-             CALL wangconvention(dummy,in%n(k)%x,in%n(k)%y,in%n(k)%z,&
-                  in%n(k)%length,in%n(k)%width, &
-                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake, &
-                  in%x0,in%y0,in%rot)
-
-#ifdef VTK
-             ! export the afterslip segment in VTK format
-             WRITE (digit4,'(I4.4)') k
-
-             rffilename=trim(in%wdir)//"/aplane-"//digit4//".vtp"
-             CALL exportvtk_rectangle(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
-                                      in%n(k)%length,in%n(k)%width, &
-                                      in%n(k)%strike,in%n(k)%dip,rffilename)
-#endif
-
-          END DO
-       END IF
-       
-    END IF
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !     I N T E R - S E I S M I C    L O A D I N G
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    minlength=in%sx1*in%dx1+in%sx2*in%dx2
-    minwidth=in%sx3*in%dx3
-    
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !        S H E A R     S O U R C E S   R A T E
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of inter-seismic strike-slip segments"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%inter%ns
-    PRINT '(I5)', in%inter%ns
-    IF (in%inter%ns .GT. 0) THEN
-       ALLOCATE(in%inter%s(in%inter%ns),in%inter%sc(in%inter%ns),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the source list"
-       PRINT 2000
-       PRINT '(a)',"no.  slip/time  xs ys zs  length width  strike dip rake"
-       PRINT 2000
-       DO k=1,in%inter%ns
-          CALL getdata(iunit,dataline)
-          READ (dataline,*) i,in%inter%s(k)%slip, &
-               in%inter%s(k)%x,in%inter%s(k)%y,in%inter%s(k)%z, &
-               in%inter%s(k)%length,in%inter%s(k)%width, &
-               in%inter%s(k)%strike,in%inter%s(k)%dip,in%inter%s(k)%rake
-
-          ! copy the input format for display
-          in%inter%sc(k)=in%inter%s(k)
-             
-          PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
-               in%inter%sc(k)%slip,&
-               in%inter%sc(k)%x,in%inter%sc(k)%y,in%inter%sc(k)%z, &
-               in%inter%sc(k)%length,in%inter%sc(k)%width, &
-               in%inter%sc(k)%strike,in%inter%sc(k)%dip, &
-               in%inter%sc(k)%rake
-          
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: source index misfit")')
-             STOP 1
-          END IF
-          IF (MAX(in%inter%s(k)%length,in%inter%s(k)%width) .LE. 0._8) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: lengths must be positive.")')
-             STOP 1
-          END IF
-          IF (in%inter%s(k)%length .lt. minlength) THEN
-             minlength=in%inter%s(k)%length
-          END IF
-          IF (in%inter%s(k)%width  .lt. minwidth ) THEN
-             minwidth =in%inter%s(k)%width
-          END IF
-          
-          ! smooth out the slip distribution
-          CALL antialiasingfilter(in%inter%s(k)%slip, &
-                      in%inter%s(k)%length,in%inter%s(k)%width, &
-                      in%dx1,in%dx2,in%dx3,in%nyquist)
-
-          ! comply to Wang's convention
-          CALL wangconvention(in%inter%s(k)%slip, &
-               in%inter%s(k)%x,in%inter%s(k)%y,in%inter%s(k)%z, &
-               in%inter%s(k)%length,in%inter%s(k)%width, &
-               in%inter%s(k)%strike,in%inter%s(k)%dip, &
-               in%inter%s(k)%rake, &
-               in%x0,in%y0,in%rot)
-
-       END DO
-       PRINT 2000
-    END IF
-    
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !       T E N S I L E   S O U R C E S   R A T E
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of inter-seismic tensile segments"
-    CALL getdata(iunit,dataline)
-    READ  (dataline,*) in%inter%nt
-    PRINT '(I5)', in%inter%nt
-    IF (in%inter%nt .GT. 0) THEN
-       ALLOCATE(in%inter%ts(in%inter%nt),in%inter%tsc(in%inter%nt),STAT=iostatus)
-       IF (iostatus>0) STOP "could not allocate the tensile source list"
-       PRINT 2000
-       PRINT '(a)',"no.  opening       xs       ys       ", &
-                   "zs  length   width strike   dip"
-       PRINT 2000
-       DO k=1,in%inter%nt
-          CALL getdata(iunit,dataline)
-          READ  (dataline,*) i,in%inter%ts(k)%slip, &
-               in%inter%ts(k)%x,in%inter%ts(k)%y,in%inter%ts(k)%z, &
-               in%inter%ts(k)%length,in%inter%ts(k)%width, &
-               in%inter%ts(k)%strike,in%inter%ts(k)%dip
-          ! copy the input format for display
-          in%inter%tsc(k)=in%inter%ts(k)
-          
-          PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1)', i, &
-               in%inter%tsc(k)%slip,&
-               in%inter%tsc(k)%x,in%inter%tsc(k)%y,in%inter%tsc(k)%z, &
-               in%inter%tsc(k)%length,in%inter%tsc(k)%width, &
-               in%inter%tsc(k)%strike,in%inter%tsc(k)%dip
-          
-          IF (i .ne. k) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: tensile source index misfit")')
-             STOP 1
-          END IF
-          IF (MAX(in%inter%ts(k)%length,in%inter%ts(k)%width) .LE. 0._8) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'("error in input file: lengths must be positive.")')
-             STOP 1
-          END IF
-          IF (in%inter%ts(k)%length .lt. minlength) THEN
-             minlength=in%inter%ts(k)%length
-          END IF
-          IF (in%inter%ts(k)%width  .lt. minwidth) THEN
-             minwidth =in%inter%ts(k)%width
-          END IF
-          
-          ! smooth out the slip distribution
-          CALL antialiasingfilter(in%inter%ts(k)%slip, &
-                           in%inter%ts(k)%length,in%inter%ts(k)%width, &
-                           in%dx1,in%dx2,in%dx3,in%nyquist)
-
-          ! comply to Wang's convention
-          CALL wangconvention(in%inter%ts(k)%slip, &
-               in%inter%ts(k)%x,in%inter%ts(k)%y,in%inter%ts(k)%z, &
-               in%inter%ts(k)%length,in%inter%ts(k)%width, &
-               in%inter%ts(k)%strike,in%inter%ts(k)%dip,dummy, &
-               in%x0,in%y0,in%rot)
-
-       END DO
-       PRINT 2000
-    END IF
-       
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    !       C 0 - S E I S M I C     E V E N T S
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-    PRINT '(a)', "number of events"
-    CALL getdata(iunit,dataline)
-    READ (dataline,*) in%ne
-    PRINT '(I5)', in%ne
-    IF (in%ne .GT. 0) ALLOCATE(in%events(in%ne),STAT=iostatus)
-    IF (iostatus>0) STOP "could not allocate the event list"
-    
-    DO e=1,in%ne
-       IF (1 .NE. e) THEN
-          PRINT '("time of next coseismic event")'
-          CALL getdata(iunit,dataline)
-          READ (dataline,*) in%events(e)%time
-          
-          IF (0 .EQ. in%skip) THEN
-             ! change event time to multiples of output time step
-             in%events(e)%time=int(in%events(e)%time/in%odt)*in%odt
-          END IF
-
-          PRINT '(ES9.2E1," (multiple of ",ES9.2E1,")")', &
-               in%events(e)%time,in%odt
-
-          IF (in%events(e)%time .LE. in%events(e-1)%time) THEN
-             WRITE_DEBUG_INFO
-             WRITE (0,'(a,a)') "input file error. ", &
-                  "coseismic source time must increase. interrupting."
-             STOP 1
-          END IF
-       ELSE
-          in%events(1)%time=0._8
-          in%events(1)%i=0
-       END IF
-
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !           S H E A R     S O U R C E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of coseismic strike-slip segments"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%events(e)%ns
-       PRINT '(I5)', in%events(e)%ns
-       IF (in%events(e)%ns .GT. 0) THEN
-          ALLOCATE(in%events(e)%s(in%events(e)%ns),in%events(e)%sc(in%events(e)%ns), &
-               STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the source list"
-          PRINT 2000
-          PRINT '(a)',"no.     slip       xs       ys       zs  length   width strike   dip   rake"
-          PRINT 2000
-          DO k=1,in%events(e)%ns
-             CALL getdata(iunit,dataline)
-             READ (dataline,*,IOSTAT=iostatus) i,in%events(e)%s(k)%slip, &
-                  in%events(e)%s(k)%x,in%events(e)%s(k)%y,in%events(e)%s(k)%z, &
-                  in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
-                  in%events(e)%s(k)%strike,in%events(e)%s(k)%dip,in%events(e)%s(k)%rake, &
-                  in%events(e)%s(k)%beta
-
-             SELECT CASE(iostatus)
-             CASE (1:)
-                WRITE_DEBUG_INFO
-                WRITE (0,'("invalid shear source definition at line")')
-                WRITE (0,'(a)') dataline
-                STOP 1
-             CASE (0)
-                IF (in%events(e)%s(k)%beta.GT.0.5d8) STOP "invalid smoothing parameter (beta)."
-             CASE (:-1)
-                ! use default value for smoothing
-                in%events(e)%s(k)%beta=in%beta
-             END SELECT
-
-             ! copy the input format for display
-             in%events(e)%sc(k)=in%events(e)%s(k)
-             
-             IF (iostatus.NE.0) THEN
-                PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
-                     in%events(e)%sc(k)%slip,&
-                     in%events(e)%sc(k)%x,in%events(e)%sc(k)%y,in%events(e)%sc(k)%z, &
-                     in%events(e)%sc(k)%length,in%events(e)%sc(k)%width, &
-                     in%events(e)%sc(k)%strike,in%events(e)%sc(k)%dip, &
-                     in%events(e)%sc(k)%rake
-             ELSE
-                ! print the smoothing value for this patch
-                PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1,f6.1)',i, &
-                     in%events(e)%sc(k)%slip,&
-                     in%events(e)%sc(k)%x,in%events(e)%sc(k)%y,in%events(e)%sc(k)%z, &
-                     in%events(e)%sc(k)%length,in%events(e)%sc(k)%width, &
-                     in%events(e)%sc(k)%strike,in%events(e)%sc(k)%dip, &
-                     in%events(e)%sc(k)%rake,in%events(e)%sc(k)%beta
-             END IF
-             
-             IF (i .ne. k) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("invalid shear source definition ")')
-                WRITE (0,'("error in input file: source index misfit")')
-                STOP 1
-             END IF
-             IF (MAX(in%events(e)%s(k)%length,in%events(e)%s(k)%width) .LE. 0._8) THEN
-                WRITE_DEBUG_INFO
-                WRITE (0,'("error in input file: lengths must be positive.")')
-                STOP 1
-             END IF
-             IF (in%events(e)%s(k)%length .lt. minlength) THEN
-                minlength=in%events(e)%s(k)%length
-             END IF
-             IF (in%events(e)%s(k)%width  .lt. minwidth ) THEN
-                minwidth =in%events(e)%s(k)%width
-             END IF
-             
-             ! smooth out the slip distribution
-             CALL antialiasingfilter(in%events(e)%s(k)%slip, &
-                              in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
-                              in%dx1,in%dx2,in%dx3,in%nyquist)
-
-             ! comply to Wang's convention
-             CALL wangconvention(in%events(e)%s(k)%slip, &
-                  in%events(e)%s(k)%x,in%events(e)%s(k)%y,in%events(e)%s(k)%z, &
-                  in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
-                  in%events(e)%s(k)%strike,in%events(e)%s(k)%dip, &
-                  in%events(e)%s(k)%rake, &
-                  in%x0,in%y0,in%rot)
-
-          END DO
-
-#ifdef VTK
-          ! export the fault segments in VTK format for the current event
-          WRITE (digit,'(I3.3)') e
-
-          rffilename=trim(in%wdir)//"/rfaults-"//digit//".vtp"
-          CALL exportvtk_rfaults(in%events(e),rffilename)
-#endif
-          rffilename=trim(in%wdir)//"/rfaults-"//digit//".xy"
-          CALL exportxy_rfaults(in%events(e),in%x0,in%y0,rffilename)
-
-          PRINT 2000
-       END IF
-       
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !          T E N S I L E      S O U R C E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of coseismic tensile segments"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%events(e)%nt
-       PRINT '(I5)', in%events(e)%nt
-       IF (in%events(e)%nt .GT. 0) THEN
-          ALLOCATE(in%events(e)%ts(in%events(e)%nt),in%events(e)%tsc(in%events(e)%nt), &
-               STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the tensile source list"
-          PRINT 2000
-          PRINT '(a)',"no. opening xs ys zs  length width  strike dip"
-          PRINT 2000
-          DO k=1,in%events(e)%nt
-
-             CALL getdata(iunit,dataline)
-             READ  (dataline,*) i,in%events(e)%ts(k)%slip, &
-                  in%events(e)%ts(k)%x,in%events(e)%ts(k)%y,in%events(e)%ts(k)%z, &
-                  in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
-                  in%events(e)%ts(k)%strike,in%events(e)%ts(k)%dip
-             ! copy the input format for display
-             in%events(e)%tsc(k)=in%events(e)%ts(k)
-             
-             PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1)',k, &
-                  in%events(e)%tsc(k)%slip,&
-                  in%events(e)%tsc(k)%x,in%events(e)%tsc(k)%y,in%events(e)%tsc(k)%z, &
-                  in%events(e)%tsc(k)%length,in%events(e)%tsc(k)%width, &
-                  in%events(e)%tsc(k)%strike,in%events(e)%tsc(k)%dip
-             
-             IF (i .ne. k) THEN
-                PRINT *, "error in input file: source index misfit"
-                STOP 1
-             END IF
-             IF (in%events(e)%ts(k)%length .lt. minlength) THEN
-                minlength=in%events(e)%ts(k)%length
-             END IF
-             IF (in%events(e)%ts(k)%width  .lt. minwidth) THEN
-                minwidth =in%events(e)%ts(k)%width
-             END IF
-             
-             ! smooth out the slip distribution
-             CALL antialiasingfilter(in%events(e)%ts(k)%slip, &
-                              in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
-                              in%dx1,in%dx2,in%dx3,in%nyquist)
-
-             ! comply to Wang's convention
-             CALL wangconvention(in%events(e)%ts(k)%slip, &
-                  in%events(e)%ts(k)%x,in%events(e)%ts(k)%y,in%events(e)%ts(k)%z, &
-                  in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
-                  in%events(e)%ts(k)%strike,in%events(e)%ts(k)%dip,dummy, &
-                  in%x0,in%y0,in%rot)
-
-          END DO
-          PRINT 2000
-       END IF
-       
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !                M O G I      S O U R C E S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of coseismic dilatation point sources"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%events(e)%nm
-       PRINT '(I5)', in%events(e)%nm
-       IF (in%events(e)%nm .GT. 0) THEN
-          ALLOCATE(in%events(e)%m(in%events(e)%nm),in%events(e)%mc(in%events(e)%nm), &
-               STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the tensile source list"
-          PRINT 2000
-          PRINT '(a)',"no. strain (positive for extension) xs ys zs"
-          PRINT 2000
-          DO k=1,in%events(e)%nm
-             CALL getdata(iunit,dataline)
-             READ  (dataline,*) i,in%events(e)%m(k)%slip, &
-                  in%events(e)%m(k)%x,in%events(e)%m(k)%y,in%events(e)%m(k)%z
-             ! copy the input format for display
-             in%events(e)%mc(k)=in%events(e)%m(k)
-             
-             PRINT '(I3.3,4ES9.2E1)',k, &
-                  in%events(e)%mc(k)%slip,&
-                  in%events(e)%mc(k)%x,in%events(e)%mc(k)%y,in%events(e)%mc(k)%z
-             
-             IF (i .ne. k) THEN
-                PRINT *, "error in input file: source index misfit"
-                STOP 1
-             END IF
-             
-             ! rotate the source in the computational reference frame
-             CALL rotation(in%events(e)%m(k)%x,in%events(e)%m(k)%y,in%rot)
-          END DO
-          PRINT 2000
-       END IF
-
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       !             S U R F A C E   L O A D S
-       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
-       PRINT '(a)', "number of surface loads"
-       CALL getdata(iunit,dataline)
-       READ  (dataline,*) in%events(e)%nl
-       PRINT '(I5)', in%events(e)%nl
-       IF (in%events(e)%nl .GT. 0) THEN
-          ALLOCATE(in%events(e)%l(in%events(e)%nl),in%events(e)%lc(in%events(e)%nl), &
-               STAT=iostatus)
-          IF (iostatus>0) STOP "could not allocate the load list"
-          PRINT 2000
-          PRINT '(a)',"t3 in units of force/surface/rigidity, positive down"
-          PRINT '(a)',"T>0 for t3 sin(2pi/T+phi), T<=0 for t3 H(t)"
-          PRINT '(a)',"no.       xs       ys   length    width       t3        T      phi"
-          PRINT 2000
-          DO k=1,in%events(e)%nl
-             CALL getdata(iunit,dataline)
-             READ  (dataline,*,IOSTAT=iostatus) i, &
-                  in%events(e)%l(k)%x,in%events(e)%l(k)%y, &
-                  in%events(e)%l(k)%length,in%events(e)%l(k)%width, &
-                  in%events(e)%l(k)%slip, &
-                  in%events(e)%l(k)%period,in%events(e)%l(k)%phase, &
-                  in%events(e)%l(k)%beta
-             
-             SELECT CASE(iostatus)
-             CASE (1:)
-                WRITE_DEBUG_INFO
-                WRITE (0,'("invalid surface load definition at line")')
-                WRITE (0,'(a)') dataline
-                STOP 1
-             CASE (0)
-                IF (in%events(e)%l(k)%beta.GT.0.5d8) STOP "invalid smoothing parameter beta."
-             CASE (:-1)
-                ! use default value for smoothing
-                in%events(e)%l(k)%beta=in%beta
-             END SELECT
-
-             ! copy the input format for display
-             in%events(e)%lc(k)=in%events(e)%l(k)
-
-             IF (iostatus.EQ.0) THEN
-                PRINT '(I3.3,9ES9.2E1)',k, &
-                     in%events(e)%lc(k)%x,in%events(e)%lc(k)%y, &
-                     in%events(e)%lc(k)%length,in%events(e)%lc(k)%width, &
-                     in%events(e)%lc(k)%slip, &
-                     in%events(e)%lc(k)%period,in%events(e)%lc(k)%phase, &
-                     in%events(e)%lc(k)%beta
-             ELSE
-                PRINT '(I3.3,8ES9.2E1)',k, &
-                     in%events(e)%lc(k)%x,in%events(e)%lc(k)%y, &
-                     in%events(e)%lc(k)%length,in%events(e)%lc(k)%width, &
-                     in%events(e)%lc(k)%slip, &
-                     in%events(e)%lc(k)%period,in%events(e)%lc(k)%phase
-             END IF
-
-             IF (i .NE. k) THEN
-                PRINT *, "error in input file: source index misfit"
-                STOP 1
-             END IF
-             
-             ! rotate the source in the computational reference frame
-             CALL rotation(in%events(e)%l(k)%x,in%events(e)%l(k)%y,in%rot)
-          END DO
-          PRINT 2000
-       END IF
-       
-    END DO
-
-    ! test the presence of dislocations for coseismic calculation
-    IF ((in%events(1)%nt .EQ. 0) .AND. &
-        (in%events(1)%ns .EQ. 0) .AND. &
-        (in%events(1)%nm .EQ. 0) .AND. &
-        (in%events(1)%nl .EQ. 0) .AND. &
-        (in%interval .LE. 0._8)) THEN
-
-       WRITE_DEBUG_INFO
-       WRITE (0,'("**** error **** ")')
-       WRITE (0,'("no input dislocations or dilatation point sources")')
-       WRITE (0,'("or surface tractions for first event . exiting.")')
-       STOP 1
-    END IF
-
-    ! maximum recommended sampling size
-    PRINT '(a,2ES8.2E1)', &
-         "max sampling size (hor.,vert.):", minlength/2.5_8,minwidth/2.5_8
-
-    PRINT 2000
-
-2000 FORMAT ("----------------------------------------------------------------------------")
-2100 FORMAT ("no.        x1       x2       x3   length    width strike    dip")
-2200 FORMAT ("no. slip        x1         x2         x3    length   width strike  dip  rake")
-2300 FORMAT ("no. name       x1       x2       x3 (name is a 4-character string)")
-2400 FORMAT ("no. strain       x1       x2       x3 (positive for extension)")
-2500 FORMAT ("no.        x1       x2       x3   length    width strike    dip   rake")
-
-  END SUBROUTINE init
-
-  !------------------------------------------------------------------
-  !> subroutine WangConvention
-  !! converts a fault slip model from a geologic description including
-  !! fault length, width, strike, dip and rake into a description
-  !! compatible with internal convention of the program.
-  !!
-  !! Internal convention describes a fault patch by the location of
-  !! its center, instead of an upper corner and its orientation by
-  !! the deviation from the vertical, instead of the angle from the
-  !! horizontal and by the angle from the x2 axis (East-West)
-  !------------------------------------------------------------------
-  SUBROUTINE wangconvention(slip,x,y,z,length,width,strike,dip,rake,x0,y0,rot)
-    REAL*8, INTENT(OUT) :: slip, x,y,z,strike,dip,rake
-    REAL*8, INTENT(IN) :: length,width,x0,y0,rot
-
-    slip=-slip
-    strike=-90._8-strike
-    dip   = 90._8-dip
-
-    strike=strike*DEG2RAD
-    dip=dip*DEG2RAD
-    rake=rake*DEG2RAD
-
-    x=x-x0-length/2._8*sin(strike)+width /2._8*sin(dip)*cos(strike)
-    y=y-y0-length/2._8*cos(strike)-width /2._8*sin(dip)*sin(strike)
-    z=z+width /2._8*cos(dip)
-
-    CALL rotation(x,y,rot)
-
-    strike=strike+rot*DEG2RAD
-
-  END SUBROUTINE wangconvention
-  
-  !------------------------------------------------------------------
-  !> subroutine Rotation
-  !! rotates a point coordinate into the computational reference
-  !! system.
-  !! 
-  !! \author sylvain barbot (04/16/09) - original form
-  !------------------------------------------------------------------
-  SUBROUTINE rotation(x,y,rot)
-    REAL*8, INTENT(INOUT) :: x,y
-    REAL*8, INTENT(IN) :: rot
-
-    REAL*8 :: alpha,xx,yy
-
-    alpha=rot*DEG2RAD
-    xx=x
-    yy=y
-
-    x=+xx*cos(alpha)+yy*sin(alpha)
-    y=-xx*sin(alpha)+yy*cos(alpha)
-
-  END SUBROUTINE rotation
-
-  !-------------------------------------------------------------------
-  !> subroutine AntiAliasingFilter
-  !! smoothes a slip distribution model to avoid aliasing of
-  !! the source geometry. Aliasing occurs is a slip patch has 
-  !! dimensions (width or length) smaller than the grid sampling.
-  !!
-  !! if a patch length is smaller than a critical size L=dx*nyquist, it 
-  !! is increased to L and the slip (or opening) is scaled accordingly
-  !! so that the moment M = s*L*W is conserved.
-  !!
-  !! \author sylvain barbot (12/08/09) - original form
-  !-------------------------------------------------------------------
-  SUBROUTINE antialiasingfilter(slip,length,width,dx1,dx2,dx3,nyquist)
-    REAL*8, INTENT(INOUT) :: slip,length,width
-    REAL*8, INTENT(IN) :: dx1,dx2,dx3,nyquist
-
-    REAL*8 :: dx
-
-    ! minimum slip patch dimension
-    dx=MIN(dx1,dx2,dx3)*nyquist
-
-    ! update length
-    IF (length .LT. dx) THEN
-       slip=slip*length/dx
-       length=dx
-    END IF
-    ! update width
-    IF (width .LT. dx) THEN
-       slip=slip*width/dx
-       width=dx
-    END IF
-
-  END SUBROUTINE antialiasingfilter
-
-END MODULE input
diff -r 405d8f4fa05f -r e7295294f654 kernel1.inc
--- a/kernel1.inc	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-    ! centered finite difference scheme
-    REAL*8, PARAMETER, DIMENSION(1) :: &
-         fir1= (/ 5.000e-01 /) ! filter kernel
diff -r 405d8f4fa05f -r e7295294f654 kernel11.inc
--- a/kernel11.inc	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-    REAL*8, PARAMETER, DIMENSION(11) :: &
-        fir11=(/ 9.137025467466382e-01, &
-                -3.444134215167435e-01, &
-                +1.372354550142238e-01, &
-                -4.472371911116056e-02, &
-                +9.983584006653466e-03, &
-                -4.203347378221815e-03, &
-                +8.867064453003781e-03, &
-                -1.331685333641829e-02, &
-                +1.339297753637801e-02, &
-                -9.762756789626834e-03, &
-                +3.560973264270618e-03 /)
diff -r 405d8f4fa05f -r e7295294f654 kernel14.inc
--- a/kernel14.inc	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-    REAL*8, PARAMETER, DIMENSION(14) :: &
-        fir14=(/ 9.487587545326932e-01, &
-                -4.040368216139801e-01, &
-                 2.042931326579159e-01, &
-                -1.022548584863014e-01, &
-                 4.783260352969341e-02, &
-                -2.180739012077366e-02, &
-                 1.283800669716571e-02, &
-                -1.276100476817563e-02, &
-                 1.558222334928575e-02, &
-                -1.758387786545944e-02, &
-                 1.707389141666987e-02, &
-                -1.420560243259215e-02, &
-                 1.081740233347091e-02, &
-                -4.501057368601819e-03/)
diff -r 405d8f4fa05f -r e7295294f654 kernel14bis.inc
--- a/kernel14bis.inc	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,16 +0,0 @@
-
-    REAL*8, PARAMETER, DIMENSION(14) :: &
-        fir14=(/ 9.739464097198434e-01, &
-	        -4.492955962260918e-01, &
-                 2.606661503992121e-01, &
-                -1.590778397098753e-01, &
-                 9.524605395168785e-02, &
-                -5.279001022321913e-02, &
-                 2.452656124714124e-02, &
-                -6.434920307760272e-03, &
-                -4.122947453390886e-03, &
-                 9.245789328795669e-03, &
-                -1.060146500976655e-02, &
-                 9.786847569837574e-03, &
-                -9.114943973080788e-03, &
-                 4.398360884720647e-03 /)
\ No newline at end of file
diff -r 405d8f4fa05f -r e7295294f654 kernel7.inc
--- a/kernel7.inc	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-    REAL*8, PARAMETER, DIMENSION(7) :: &
-         fir7=(/ 8.77856e-01, &
-                -2.81913e-01, &
-                +6.22696e-02, &
-                +2.82441e-02, &
-                -5.09029e-02, &
-                +4.20471e-02, &
-                -1.59409e-02 /) ! filter kernel
-!0.97125_8*
\ No newline at end of file
diff -r 405d8f4fa05f -r e7295294f654 mkl_dfti.f90
--- a/mkl_dfti.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,862 +0,0 @@
-!*****************************************************************************
-!                            INTEL CONFIDENTIAL
-! Copyright(C) 2002-2010 Intel Corporation. All Rights Reserved.
-! The source code contained  or  described herein and all documents related to
-! the source code ("Material") are owned by Intel Corporation or its suppliers
-! or licensors.  Title to the  Material remains with  Intel Corporation or its
-! suppliers and licensors. The Material contains trade secrets and proprietary
-! and  confidential  information of  Intel or its suppliers and licensors. The
-! Material  is  protected  by  worldwide  copyright  and trade secret laws and
-! treaty  provisions. No part of the Material may be used, copied, reproduced,
-! modified, published, uploaded, posted, transmitted, distributed or disclosed
-! in any way without Intel's prior express written permission.
-! No license  under any  patent, copyright, trade secret or other intellectual
-! property right is granted to or conferred upon you by disclosure or delivery
-! of the Materials,  either expressly, by implication, inducement, estoppel or
-! otherwise.  Any  license  under  such  intellectual property  rights must be
-! express and approved by Intel in writing.
-!
-!*****************************************************************************
-! Content:
-!    Intel(R) Math Kernel Library (MKL)
-!    Discrete Fourier Transform Interface (DFTI)
-!*****************************************************************************
-
-MODULE MKL_DFT_TYPE
-
-  TYPE, PUBLIC :: DFTI_DESCRIPTOR
-     PRIVATE
-     INTEGER :: dontuse
-     ! Structure of this type is not used in Fortran code
-     ! the pointer to this type is used only
-  END TYPE DFTI_DESCRIPTOR
-
-  !======================================================================
-  ! These real type kind parameters are not for direct use
-  !======================================================================
-
-  INTEGER, PARAMETER :: DFTI_SPKP = SELECTED_REAL_KIND(6,37)
-  INTEGER, PARAMETER :: DFTI_DPKP = SELECTED_REAL_KIND(15,307)
-
-  !======================================================================
-  ! Descriptor configuration parameters [default values in brackets]
-  !======================================================================
-
-  ! Domain for forward transform. No default value
-  INTEGER, PARAMETER :: DFTI_FORWARD_DOMAIN = 0
-
-  ! Dimensionality, or rank. No default value
-  INTEGER, PARAMETER :: DFTI_DIMENSION = 1
-
-  ! Length(s) of transform. No default value
-  INTEGER, PARAMETER :: DFTI_LENGTHS = 2
-
-  ! Floating point precision. No default value
-  INTEGER, PARAMETER :: DFTI_PRECISION = 3
-
-  ! Scale factor for forward transform [1.0]
-  INTEGER, PARAMETER :: DFTI_FORWARD_SCALE = 4
-
-  ! Scale factor for backward transform [1.0]
-  INTEGER, PARAMETER :: DFTI_BACKWARD_SCALE = 5
-
-  ! Exponent sign for forward transform [DFTI_NEGATIVE]
-  ! INTEGER, PARAMETER :: DFTI_FORWARD_SIGN = 6 ! NOT IMPLEMENTED
-
-  ! Number of data sets to be transformed [1]
-  INTEGER, PARAMETER :: DFTI_NUMBER_OF_TRANSFORMS = 7
-
-  ! Storage of finite complex-valued sequences in complex domain
-  ! [DFTI_COMPLEX_COMPLEX]
-  INTEGER, PARAMETER :: DFTI_COMPLEX_STORAGE = 8
-
-  ! Storage of finite real-valued sequences in real domain
-  ! [DFTI_REAL_REAL]
-  INTEGER, PARAMETER :: DFTI_REAL_STORAGE = 9
-
-  ! Storage of finite complex-valued sequences in conjugate-even
-  ! domain [DFTI_COMPLEX_REAL]
-  INTEGER, PARAMETER :: DFTI_CONJUGATE_EVEN_STORAGE = 10
-
-  ! Placement of result [DFTI_INPLACE]
-  INTEGER, PARAMETER :: DFTI_PLACEMENT = 11
-
-  ! Generalized strides for input data layout
-  ! [tigth, col-major for Fortran]
-  INTEGER, PARAMETER :: DFTI_INPUT_STRIDES = 12
-
-  ! Generalized strides for output data layout
-  ! [tigth, col-major for Fortran]
-  INTEGER, PARAMETER :: DFTI_OUTPUT_STRIDES = 13
-
-  ! Distance between first input elements for multiple transforms [0]
-  INTEGER, PARAMETER :: DFTI_INPUT_DISTANCE = 14
-
-  ! Distance between first output elements for multiple transforms [0]
-  INTEGER, PARAMETER :: DFTI_OUTPUT_DISTANCE = 15
-
-  ! Effort spent in initialization [DFTI_MEDIUM]
-  ! INTEGER, PARAMETER :: DFTI_INITIALIZATION_EFFORT = 16 ! NOT IMPLEMENTED
-
-  ! Use of workspace during computation [DFTI_ALLOW]
-  ! INTEGER, PARAMETER :: DFTI_WORKSPACE = 17 ! NOT IMPLEMENTED
-
-  ! Ordering of the result [DFTI_ORDERED]
-  INTEGER, PARAMETER :: DFTI_ORDERING = 18
-
-  ! Possible transposition of result [DFTI_NONE]
-  INTEGER, PARAMETER :: DFTI_TRANSPOSE = 19
-
-  ! User-settable descriptor name [""]
-  INTEGER, PARAMETER :: DFTI_DESCRIPTOR_NAME = 20
-
-  ! Packing format for DFTI_COMPLEX_REAL storage of finite
-  ! conjugate-even sequences [DFTI_CCS_FORMAT]
-  INTEGER, PARAMETER :: DFTI_PACKED_FORMAT = 21
-
-  ! Commit status of the descriptor. Read-only parameter
-  INTEGER, PARAMETER :: DFTI_COMMIT_STATUS = 22
-
-  ! Version string for this DFTI implementation. Read-only parameter
-  INTEGER, PARAMETER :: DFTI_VERSION = 23
-
-  ! Ordering of the forward transform. Read-only parameter
-  ! INTEGER, PARAMETER :: DFTI_FORWARD_ORDERING = 24 ! NOT IMPLEMENTED
-
-  ! Ordering of the backward transform. Read-only parameter
-  ! INTEGER, PARAMETER :: DFTI_BACKWARD_ORDERING = 25 ! NOT IMPLEMENTED
-
-  ! Number of user threads that share the descriptor [1]
-  INTEGER, PARAMETER :: DFTI_NUMBER_OF_USER_THREADS = 26
-
-  !======================================================================
-  ! Values of the descriptor configuration parameters
-  !======================================================================
-
-  ! DFTI_COMMIT_STATUS
-  INTEGER, PARAMETER :: DFTI_COMMITTED = 30
-  INTEGER, PARAMETER :: DFTI_UNCOMMITTED = 31
-
-  ! DFTI_FORWARD_DOMAIN
-  INTEGER, PARAMETER :: DFTI_COMPLEX = 32
-  INTEGER, PARAMETER :: DFTI_REAL = 33
-  ! INTEGER, PARAMETER :: DFTI_CONJUGATE_EVEN = 34 ! NOT IMPLEMENTED
-
-  ! DFTI_PRECISION
-  INTEGER, PARAMETER :: DFTI_SINGLE = 35
-  INTEGER, PARAMETER :: DFTI_DOUBLE = 36
-
-  ! DFTI_PRECISION for reduced size of statically linked application.
-  ! Recommended use: modify statement 'USE MKL_DFTI' in your program,
-  ! so that it reads as either of:
-  ! USE MKL_DFTI, FORGET=>DFTI_SINGLE, DFTI_SINGLE=>DFTI_SINGLE_R
-  ! USE MKL_DFTI, FORGET=>DFTI_DOUBLE, DFTI_DOUBLE=>DFTI_DOUBLE_R
-  ! where word 'FORGET' can be any name not used in the program.
-  REAL(DFTI_SPKP), PARAMETER :: DFTI_SINGLE_R = 35
-  REAL(DFTI_DPKP), PARAMETER :: DFTI_DOUBLE_R = 36
-
-  ! DFTI_FORWARD_SIGN
-  ! INTEGER, PARAMETER :: DFTI_NEGATIVE = 37 ! NOT IMPLEMENTED
-  ! INTEGER, PARAMETER :: DFTI_POSITIVE = 38 ! NOT IMPLEMENTED
-
-  ! DFTI_COMPLEX_STORAGE and DFTI_CONJUGATE_EVEN_STORAGE
-  INTEGER, PARAMETER :: DFTI_COMPLEX_COMPLEX = 39
-  INTEGER, PARAMETER :: DFTI_COMPLEX_REAL = 40
-
-  ! DFTI_REAL_STORAGE
-  INTEGER, PARAMETER :: DFTI_REAL_COMPLEX = 41
-  INTEGER, PARAMETER :: DFTI_REAL_REAL = 42
-
-  ! DFTI_PLACEMENT
-  INTEGER, PARAMETER :: DFTI_INPLACE = 43 ! Result overwrites input
-  INTEGER, PARAMETER :: DFTI_NOT_INPLACE  = 44 ! Have another place for result
-
-  ! DFTI_INITIALIZATION_EFFORT
-  ! INTEGER, PARAMETER :: DFTI_LOW = 45 ! NOT IMPLEMENTED
-  ! INTEGER, PARAMETER :: DFTI_MEDIUM = 46 ! NOT IMPLEMENTED
-  ! INTEGER, PARAMETER :: DFTI_HIGH = 47 ! NOT IMPLEMENTED
-
-  ! DFTI_ORDERING
-  INTEGER, PARAMETER :: DFTI_ORDERED = 48
-  INTEGER, PARAMETER :: DFTI_BACKWARD_SCRAMBLED = 49
-  ! INTEGER, PARAMETER :: DFTI_FORWARD_SCRAMBLED  = 50 ! NOT IMPLEMENTED
-
-  ! Allow/avoid certain usages
-  INTEGER, PARAMETER :: DFTI_ALLOW = 51 ! Allow transposition or workspace
-  ! INTEGER, PARAMETER :: DFTI_AVOID = 52 ! NOT IMPLEMENTED
-  INTEGER, PARAMETER :: DFTI_NONE = 53
-
-  ! DFTI_PACKED_FORMAT
-  ! (for storing congugate-even finite sequence in real array)
-  INTEGER, PARAMETER :: DFTI_CCS_FORMAT = 54  ! Complex conjugate-symmetric
-  INTEGER, PARAMETER :: DFTI_PACK_FORMAT = 55 ! Pack format for real DFT
-  INTEGER, PARAMETER :: DFTI_PERM_FORMAT = 56 ! Perm format for real DFT
-  INTEGER, PARAMETER :: DFTI_CCE_FORMAT = 57  ! Complex conjugate-even
-
-  !======================================================================
-  ! Error classes
-  !======================================================================
-  INTEGER, PARAMETER :: DFTI_NO_ERROR = 0
-  INTEGER, PARAMETER :: DFTI_MEMORY_ERROR = 1
-  INTEGER, PARAMETER :: DFTI_INVALID_CONFIGURATION = 2
-  INTEGER, PARAMETER :: DFTI_INCONSISTENT_CONFIGURATION = 3
-  INTEGER, PARAMETER :: DFTI_MULTITHREADED_ERROR = 4
-  INTEGER, PARAMETER :: DFTI_BAD_DESCRIPTOR = 5
-  INTEGER, PARAMETER :: DFTI_UNIMPLEMENTED = 6
-  INTEGER, PARAMETER :: DFTI_MKL_INTERNAL_ERROR = 7
-  INTEGER, PARAMETER :: DFTI_NUMBER_OF_THREADS_ERROR = 8
-  INTEGER, PARAMETER :: DFTI_1D_LENGTH_EXCEEDS_INT32 = 9
-
-  ! Maximum length of error string
-  INTEGER, PARAMETER :: DFTI_MAX_MESSAGE_LENGTH = 80
-
-  ! Maximum length of user-settable descriptor name
-  INTEGER, PARAMETER :: DFTI_MAX_NAME_LENGTH = 10
-
-  ! Maximum length of MKL version string
-  INTEGER, PARAMETER :: DFTI_VERSION_LENGTH = 198
-
-  ! (deprecated parameter)
-  INTEGER, PARAMETER :: DFTI_ERROR_CLASS = 60
-
-END MODULE MKL_DFT_TYPE
-
-MODULE MKL_DFTI
-
-  USE MKL_DFT_TYPE
-
-  INTERFACE DftiCreateDescriptor
-
-     FUNCTION dfti_create_descriptor_1d(desc, precision, domain, dim, length)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_1d
-       !MS$ATTRIBUTES REFERENCE :: precision
-       !MS$ATTRIBUTES REFERENCE :: domain
-       !MS$ATTRIBUTES REFERENCE :: dim
-       !MS$ATTRIBUTES REFERENCE :: length
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_create_descriptor_1d
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       INTEGER, INTENT(IN) :: precision
-       INTEGER, INTENT(IN) :: domain
-       INTEGER, INTENT(IN) :: dim, length
-     END FUNCTION dfti_create_descriptor_1d
-
-     FUNCTION dfti_create_descriptor_highd(desc, precision, domain, dim,length)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_highd
-       !MS$ATTRIBUTES REFERENCE :: precision
-       !MS$ATTRIBUTES REFERENCE :: domain
-       !MS$ATTRIBUTES REFERENCE :: dim
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_create_descriptor_highd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       INTEGER, INTENT(IN) :: precision
-       INTEGER, INTENT(IN) :: domain
-       INTEGER, INTENT(IN) :: dim
-       INTEGER, INTENT(IN), DIMENSION(*) :: length
-     END FUNCTION dfti_create_descriptor_highd
-
-     FUNCTION dfti_create_descriptor_s_1d(desc, s, dom, one, dim)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_s_1d
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: s
-       !MS$ATTRIBUTES REFERENCE :: dom
-       !MS$ATTRIBUTES REFERENCE :: one
-       !MS$ATTRIBUTES REFERENCE :: dim
-       INTEGER dfti_create_descriptor_s_1d
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN) :: s
-       INTEGER, INTENT(IN) :: dom
-       INTEGER, INTENT(IN) :: one
-       INTEGER, INTENT(IN) :: dim
-     END FUNCTION dfti_create_descriptor_s_1d
-
-     FUNCTION dfti_create_descriptor_s_md(desc, s, dom, many, dims)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_s_md
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: s
-       !MS$ATTRIBUTES REFERENCE :: dom
-       !MS$ATTRIBUTES REFERENCE :: many
-       !MS$ATTRIBUTES REFERENCE :: dims
-       INTEGER dfti_create_descriptor_s_md
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN) :: s
-       INTEGER, INTENT(IN) :: dom
-       INTEGER, INTENT(IN) :: many
-       INTEGER, INTENT(IN), DIMENSION(*) :: dims
-     END FUNCTION dfti_create_descriptor_s_md
-
-     FUNCTION dfti_create_descriptor_d_1d(desc, d, dom, one, dim)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_d_1d
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: d
-       !MS$ATTRIBUTES REFERENCE :: dom
-       !MS$ATTRIBUTES REFERENCE :: one
-       !MS$ATTRIBUTES REFERENCE :: dim
-       INTEGER dfti_create_descriptor_d_1d
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN) :: d
-       INTEGER, INTENT(IN) :: dom
-       INTEGER, INTENT(IN) :: one
-       INTEGER, INTENT(IN) :: dim
-     END FUNCTION dfti_create_descriptor_d_1d
-
-     FUNCTION dfti_create_descriptor_d_md(desc, d, dom, many, dims)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_create_descriptor_d_md
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: d
-       !MS$ATTRIBUTES REFERENCE :: dom
-       !MS$ATTRIBUTES REFERENCE :: many
-       !MS$ATTRIBUTES REFERENCE :: dims
-       INTEGER dfti_create_descriptor_d_md
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN) :: d
-       INTEGER, INTENT(IN) :: dom
-       INTEGER, INTENT(IN) :: many
-       INTEGER, INTENT(IN), DIMENSION(*) :: dims
-     END FUNCTION dfti_create_descriptor_d_md
-
-  END INTERFACE
-
-  INTERFACE DftiCopyDescriptor
-
-     FUNCTION dfti_copy_descriptor_external(desc, new_desc)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_copy_descriptor_external
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: new_desc
-       INTEGER dfti_copy_descriptor_external
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       TYPE(DFTI_DESCRIPTOR), POINTER :: new_desc
-     END FUNCTION dfti_copy_descriptor_external
-
-  END INTERFACE
-
-  INTERFACE DftiCommitDescriptor
-
-     FUNCTION dfti_commit_descriptor_external(desc)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_commit_descriptor_external
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_commit_descriptor_external
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_commit_descriptor_external
-
-  END INTERFACE
-
-  INTERFACE DftiSetValue
-
-     FUNCTION dfti_set_value_intval(desc, OptName, IntVal)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_set_value_intval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: IntVal
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_set_value_intval
-       INTEGER, INTENT(IN) :: OptName
-       INTEGER, INTENT(IN) :: IntVal
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_set_value_intval
-
-     FUNCTION dfti_set_value_sglval(desc, OptName, sglval)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_set_value_sglval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: sglval
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_set_value_sglval
-       INTEGER, INTENT(IN) :: OptName
-       REAL(DFTI_SPKP), INTENT(IN) :: sglval
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_set_value_sglval
-
-     FUNCTION dfti_set_value_dblval(desc, OptName, DblVal)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_set_value_dblval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: DblVal
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_set_value_dblval
-       INTEGER, INTENT(IN) :: OptName
-       REAL(DFTI_DPKP), INTENT(IN) :: DblVal
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_set_value_dblval
-
-     FUNCTION dfti_set_value_intvec(desc, OptName, IntVec)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_set_value_intvec
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: IntVec
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_set_value_intvec
-       INTEGER, INTENT(IN) :: OptName
-       INTEGER, INTENT(IN), DIMENSION(*) :: IntVec
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_set_value_intvec
-
-     FUNCTION dfti_set_value_chars(desc, OptName, Chars)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_set_value_chars
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: dfti_set_value_chars
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_set_value_chars
-       INTEGER, INTENT(IN) :: OptName
-       CHARACTER(*), INTENT(IN) :: Chars
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_set_value_chars
-
-  END INTERFACE
-
-  INTERFACE DftiGetValue
-
-     FUNCTION dfti_get_value_intval(desc, OptName, IntVal)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_get_value_intval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: IntVal
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_get_value_intval
-       INTEGER, INTENT(IN) :: OptName
-       INTEGER, INTENT(OUT) :: IntVal
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_get_value_intval
-
-     FUNCTION dfti_get_value_sglval(desc, OptName, sglval)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_get_value_sglval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: sglval
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_get_value_sglval
-       INTEGER, INTENT(IN) :: OptName
-       REAL(DFTI_SPKP), INTENT(OUT) :: sglval
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_get_value_sglval
-
-     FUNCTION dfti_get_value_dblval(desc, OptName, DblVal)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_get_value_dblval
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: DblVal
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_get_value_dblval
-       INTEGER, INTENT(IN) :: OptName
-       REAL(DFTI_DPKP), INTENT(OUT) :: DblVal
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_get_value_dblval
-
-     FUNCTION dfti_get_value_intvec(desc, OptName, IntVec)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_get_value_intvec
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: IntVec
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_get_value_intvec
-       INTEGER, INTENT(IN) :: OptName
-       INTEGER, INTENT(OUT), DIMENSION(*) :: IntVec
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_get_value_intvec
-
-     FUNCTION dfti_get_value_chars(desc, OptName, Chars)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_get_value_chars
-       !MS$ATTRIBUTES REFERENCE :: OptName
-       !MS$ATTRIBUTES REFERENCE :: dfti_get_value_chars
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_get_value_chars
-       INTEGER, INTENT(IN) :: OptName
-       CHARACTER(*), INTENT(OUT) :: Chars
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_get_value_chars
-
-  END INTERFACE
-
-  INTERFACE DftiComputeForward
-
-     FUNCTION dfti_compute_forward_s(desc,sSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_s
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcDst
-       INTEGER dfti_compute_forward_s
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: sSrcDst
-     END FUNCTION dfti_compute_forward_s
-
-     FUNCTION dfti_compute_forward_c(desc,cSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_c
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrcDst
-       INTEGER dfti_compute_forward_c
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: cSrcDst
-     END FUNCTION dfti_compute_forward_c
-
-     FUNCTION dfti_compute_forward_ss(desc,sSrcDstRe,sSrcDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_ss
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcDstRe
-       !MS$ATTRIBUTES REFERENCE :: sSrcDstIm
-       INTEGER dfti_compute_forward_ss
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstRe
-       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstIm
-     END FUNCTION dfti_compute_forward_ss
-
-     FUNCTION dfti_compute_forward_sc(desc,sSrc,cDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_sc
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrc
-       !MS$ATTRIBUTES REFERENCE :: cDst
-       INTEGER dfti_compute_forward_sc
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrc
-       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
-     END FUNCTION dfti_compute_forward_sc
-
-     FUNCTION dfti_compute_forward_cs(desc,cSrc,sDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_cs
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrc
-       !MS$ATTRIBUTES REFERENCE :: sDst
-       INTEGER dfti_compute_forward_cs
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDst
-     END FUNCTION dfti_compute_forward_cs
-
-     FUNCTION dfti_compute_forward_cc(desc,cSrc,cDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_cc
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrc
-       !MS$ATTRIBUTES REFERENCE :: cDst
-       INTEGER dfti_compute_forward_cc
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
-       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
-     END FUNCTION dfti_compute_forward_cc
-
-     FUNCTION dfti_compute_forward_ssss(desc,sSrcRe,sSrcIm,sDstRe,sDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_ssss
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcRe
-       !MS$ATTRIBUTES REFERENCE :: sSrcIm
-       !MS$ATTRIBUTES REFERENCE :: sDstRe
-       !MS$ATTRIBUTES REFERENCE :: sDstIm
-       INTEGER dfti_compute_forward_ssss
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcRe
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcIm
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstRe
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstIm
-     END FUNCTION dfti_compute_forward_ssss
-
-     FUNCTION dfti_compute_forward_d(desc,dSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_d
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcDst
-       INTEGER dfti_compute_forward_d
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: dSrcDst
-     END FUNCTION dfti_compute_forward_d
-
-     FUNCTION dfti_compute_forward_z(desc,zSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_z
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrcDst
-       INTEGER dfti_compute_forward_z
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: zSrcDst
-     END FUNCTION dfti_compute_forward_z
-
-     FUNCTION dfti_compute_forward_dd(desc,dSrcDstRe,dSrcDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_dd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcDstRe
-       !MS$ATTRIBUTES REFERENCE :: dSrcDstIm
-       INTEGER dfti_compute_forward_dd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstRe
-       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstIm
-     END FUNCTION dfti_compute_forward_dd
-
-     FUNCTION dfti_compute_forward_dz(desc,dSrc,zDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_dz
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrc
-       !MS$ATTRIBUTES REFERENCE :: zDst
-       INTEGER dfti_compute_forward_dz
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrc
-       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
-     END FUNCTION dfti_compute_forward_dz
-
-     FUNCTION dfti_compute_forward_zd(desc,zSrc,dDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_zd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrc
-       !MS$ATTRIBUTES REFERENCE :: dDst
-       INTEGER dfti_compute_forward_zd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDst
-     END FUNCTION dfti_compute_forward_zd
-
-     FUNCTION dfti_compute_forward_zz(desc,zSrc,zDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_zz
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrc
-       !MS$ATTRIBUTES REFERENCE :: zDst
-       INTEGER dfti_compute_forward_zz
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
-       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
-     END FUNCTION dfti_compute_forward_zz
-
-     FUNCTION dfti_compute_forward_dddd(desc,dSrcRe,dSrcIm,dDstRe,dDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_forward_dddd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcRe
-       !MS$ATTRIBUTES REFERENCE :: dSrcIm
-       !MS$ATTRIBUTES REFERENCE :: dDstRe
-       !MS$ATTRIBUTES REFERENCE :: dDstIm
-       INTEGER dfti_compute_forward_dddd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcRe
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcIm
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstRe
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstIm
-     END FUNCTION dfti_compute_forward_dddd
-
-  END INTERFACE DftiComputeForward
-
-  INTERFACE DftiComputeBackward
-
-     FUNCTION dfti_compute_backward_s(desc,sSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_s
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcDst
-       INTEGER dfti_compute_backward_s
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: sSrcDst
-     END FUNCTION dfti_compute_backward_s
-
-     FUNCTION dfti_compute_backward_c(desc,cSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_c
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrcDst
-       INTEGER dfti_compute_backward_c
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: cSrcDst
-     END FUNCTION dfti_compute_backward_c
-
-     FUNCTION dfti_compute_backward_ss(desc,sSrcDstRe,sSrcDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_ss
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcDstRe
-       !MS$ATTRIBUTES REFERENCE :: sSrcDstIm
-       INTEGER dfti_compute_backward_ss
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstRe
-       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstIm
-     END FUNCTION dfti_compute_backward_ss
-
-     FUNCTION dfti_compute_backward_sc(desc,sSrc,cDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_sc
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrc
-       !MS$ATTRIBUTES REFERENCE :: cDst
-       INTEGER dfti_compute_backward_sc
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrc
-       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
-     END FUNCTION dfti_compute_backward_sc
-
-     FUNCTION dfti_compute_backward_cs(desc,cSrc,sDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_cs
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrc
-       !MS$ATTRIBUTES REFERENCE :: sDst
-       INTEGER dfti_compute_backward_cs
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDst
-     END FUNCTION dfti_compute_backward_cs
-
-     FUNCTION dfti_compute_backward_cc(desc,cSrc,cDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_cc
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: cSrc
-       !MS$ATTRIBUTES REFERENCE :: cDst
-       INTEGER dfti_compute_backward_cc
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
-       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
-     END FUNCTION dfti_compute_backward_cc
-
-     FUNCTION dfti_compute_backward_ssss(desc,sSrcRe,sSrcIm,sDstRe,sDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_ssss
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: sSrcRe
-       !MS$ATTRIBUTES REFERENCE :: sSrcIm
-       !MS$ATTRIBUTES REFERENCE :: sDstRe
-       !MS$ATTRIBUTES REFERENCE :: sDstIm
-       INTEGER dfti_compute_backward_ssss
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcRe
-       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcIm
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstRe
-       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstIm
-     END FUNCTION dfti_compute_backward_ssss
-
-     FUNCTION dfti_compute_backward_d(desc,dSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_d
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcDst
-       INTEGER dfti_compute_backward_d
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: dSrcDst
-     END FUNCTION dfti_compute_backward_d
-
-     FUNCTION dfti_compute_backward_z(desc,zSrcDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_z
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrcDst
-       INTEGER dfti_compute_backward_z
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: zSrcDst
-     END FUNCTION dfti_compute_backward_z
-
-     FUNCTION dfti_compute_backward_dd(desc,dSrcDstRe,dSrcDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_dd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcDstRe
-       !MS$ATTRIBUTES REFERENCE :: dSrcDstIm
-       INTEGER dfti_compute_backward_dd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstRe
-       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstIm
-     END FUNCTION dfti_compute_backward_dd
-
-     FUNCTION dfti_compute_backward_dz(desc,dSrc,zDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_dz
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrc
-       !MS$ATTRIBUTES REFERENCE :: zDst
-       INTEGER dfti_compute_backward_dz
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrc
-       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
-     END FUNCTION dfti_compute_backward_dz
-
-     FUNCTION dfti_compute_backward_zd(desc,zSrc,dDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_zd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrc
-       !MS$ATTRIBUTES REFERENCE :: dDst
-       INTEGER dfti_compute_backward_zd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDst
-     END FUNCTION dfti_compute_backward_zd
-
-     FUNCTION dfti_compute_backward_zz(desc,zSrc,zDst)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_zz
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: zSrc
-       !MS$ATTRIBUTES REFERENCE :: zDst
-       INTEGER dfti_compute_backward_zz
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
-       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
-     END FUNCTION dfti_compute_backward_zz
-
-     FUNCTION dfti_compute_backward_dddd(desc,dSrcRe,dSrcIm,dDstRe,dDstIm)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_compute_backward_dddd
-       !MS$ATTRIBUTES REFERENCE :: desc
-       !MS$ATTRIBUTES REFERENCE :: dSrcRe
-       !MS$ATTRIBUTES REFERENCE :: dSrcIm
-       !MS$ATTRIBUTES REFERENCE :: dDstRe
-       !MS$ATTRIBUTES REFERENCE :: dDstIm
-       INTEGER dfti_compute_backward_dddd
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcRe
-       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcIm
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstRe
-       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstIm
-     END FUNCTION dfti_compute_backward_dddd
-
-  END INTERFACE DftiComputeBackward
-
-  INTERFACE DftiFreeDescriptor
-
-     FUNCTION dfti_free_descriptor_external(desc)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_free_descriptor_external
-       !MS$ATTRIBUTES REFERENCE :: desc
-       INTEGER dfti_free_descriptor_external
-       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
-     END FUNCTION dfti_free_descriptor_external
-
-  END INTERFACE
-
-  INTERFACE DftiErrorClass
-
-     FUNCTION dfti_error_class_external(Status, ErrorClass)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_error_class_external
-       !MS$ATTRIBUTES REFERENCE :: Status
-       !MS$ATTRIBUTES REFERENCE :: ErrorClass
-       LOGICAL dfti_error_class_external
-       INTEGER, INTENT(IN) :: Status
-       INTEGER, INTENT(IN) :: ErrorClass
-     END FUNCTION dfti_error_class_external
-
-  END INTERFACE
-
-  INTERFACE DftiErrorMessage
-
-     FUNCTION dfti_error_message_external(Status)
-       USE MKL_DFT_TYPE
-       !DEC$ATTRIBUTES C :: dfti_error_message_external
-       !MS$ATTRIBUTES REFERENCE :: Status
-       CHARACTER(LEN=DFTI_MAX_MESSAGE_LENGTH) :: dfti_error_message_external
-       INTEGER, INTENT(IN) :: Status
-     END FUNCTION dfti_error_message_external
-
-  END INTERFACE
-
-END MODULE MKL_DFTI
diff -r 405d8f4fa05f -r e7295294f654 proj.c
--- a/proj.c	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,64 +0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-#include <proj_api.h>
-#include <string.h>
-
-/*
- * proj routine to convert arrays of UTM coordinates
- * to longitude/latitude using the PROJ.4 library
- *
- * to do: check the output in the south hemisphere
- *
- * sylvain barbot (22/05/10) - original form
- */
-
-void proj_(double *x, double *y, int * n, 
-           double * lon0, double * lat0, int * zone) {
-
-  projPJ pj_utm, pj_latlong;
-  int p, i;
-  char zonestr[3];
-  char cmd_utm[100], cmd_latlong[100];
-  char * to;
-
-  // convert integer zone to string zone
-  i=sprintf(zonestr, "%d", (*zone));
-
-  // construct conversion command (+proj=utm +zone=11)
-  to = stpcpy(cmd_utm,"+proj=utm +zone=");
-  to = stpcpy(to,zonestr);
-  //printf("%s\n",cmd_utm);
-
-  // construct conversion command (+proj=latlong +zone=11)
-  to = stpcpy(cmd_latlong,"+proj=latlong +zone=");
-  to = stpcpy(to,zonestr);
-  //printf("%s\n",cmd_latlong);
-
-  if (!(pj_utm = pj_init_plus(cmd_utm)) ){
-    printf("error initializing input projection driver. exiting.");
-    exit(1);
-  }
-  if (!(pj_latlong = pj_init_plus(cmd_latlong)) ){
-    printf("error initializing output projection driver. exiting.");
-    exit(1);
-  }
-
-  // convert to radians
-  (*lon0)*=DEG_TO_RAD;
-  (*lat0)*=DEG_TO_RAD;
-
-  p = pj_transform(pj_latlong, pj_utm, 1, 1, lon0, lat0, NULL);
-
-  // add UTM coordinates of the origin
-  for (i=0;i<(*n);i++){
-    x[i]+=(*lon0);
-    y[i]+=(*lat0);
-  }
-  p = pj_transform(pj_utm, pj_latlong, (*n), 1, x, y, NULL);
-
-  // convert longitude and latitude to degrees
-  for (i=0;i<(*n);i++){
-    x[i]*=RAD_TO_DEG;
-    y[i]*=RAD_TO_DEG;
-  }
-}
diff -r 405d8f4fa05f -r e7295294f654 relax.f90
--- a/relax.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1121 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007-2012, Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-  !-----------------------------------------------------------------------
-  !> \mainpage 
-  !! program relax
-  !! <hr>
-  !! PURPOSE:
-  !!   The program RELAX computes nonlinear time-dependent viscoelastic
-  !!   deformation with powerlaw rheology and rate-strengthening friction 
-  !!   in a cubic, periodic grid due to coseismic stress changes, initial
-  !!   stress, surface loads, and/or moving faults.
-  !! 
-  !! ONLINE DOCUMENTATION:
-  !!   generate html documentation from the source directory with the 
-  !!   doxygen (http://www.stack.nl/~dimitri/doxygen/index.html) 
-  !!   program with command:
-  !!
-  !!     doxygen .doxygen
-  !!
-  !! DESCRIPTION:
-  !!   Computation is done semi-analytically inside a cartesian grid.
-  !!   The grid is defined by its size sx1*sx2*sx3 and the sampling
-  !!   intervals dx1, dx2 and dx3. rule of thumb is to allow for at least
-  !!   five samples per fault length or width, and to have the tip of any 
-  !!   fault at least 10 fault widths away from any edge of the 
-  !!   computational grid.
-  !!
-  !!   Coseismic stress changes and initial coseismic deformation results
-  !!   from the presence of dislocations in the brittle layer. Fault
-  !!   geometry is prescribed following Okada or Wang's convention, with the
-  !!   usual slip, strike, dip and rake and is converted to a double-couple
-  !!   equivalent body-force analytically. Current implementation allows 
-  !!   shear fault (strike slip and dip slip), dykes, Mogi source, and
-  !!   surface traction. Faults and dykes can be of arbitrary orientation 
-  !!   in the half space.
-  !!
-  !! <hr>
-  !!
-  !! METHOD:
-  !!   The current implementation is organized to integrate stress/strain-
-  !!   rate constitutive laws (rheologies) of the form
-  !! \f[
-  !!       \dot{\epsilon} = f(\sigma)
-  !! \f]
-  !!   as opposed to epsilon^dot = f(sigma,epsilon) wich would include work-
-  !!   hardening (or weakening). The time-stepping implements a second-order
-  !!   Runge-Kutta numerical integration scheme with a variable time-step.
-  !!   The Runge-Kutta method integrating the ODE y'=f(x,y) can be summarized
-  !!   as follows:
-  !! \f[
-  !!          y_(n+1) = y_n + k_2
-  !!              k_1 = h * f(x_n, y_n)
-  !!              k_2 = h * f(x_n + h, y_n + k_1)
-  !! \f]
-  !!   where h is the time-step and n is the time-index. The elastic response
-  !!   in the computational grid is obtained using elastic Greens functions.
-  !!   The Greens functions are applied in the Fourier domain. Strain,
-  !!   stress and body-forces are obtained by application of a finite impulse
-  !!   response (FIR) differentiator filter in the space domain.
-  !!
-  !! <hr>
-  !!
-  !! INPUT:
-  !!   Static dislocation sources are discretized into a series of planar
-  !!   segments. Slip patches are defined in terms of position, orientation,
-  !!   and slip, as illustrated in the following figure:
-  !!\verbatim
-  !!                 N (x1)
-  !!                /
-  !!               /| Strike
-  !!   x1,x2,x3 ->@------------------------      (x2)
-  !!              |\        p .            \ W
-  !!              :-\      i .              \ i
-  !!              |  \    l .                \ d
-  !!              :90 \  S .                  \ t
-  !!              |-Dip\  .                    \ h
-  !!              :     \. | Rake               \
-  !!              |      -------------------------
-  !!              :             L e n g t h
-  !!              Z (x3)
-  !!\endverbatim
-  !!   Dislocations are converted to double-couple equivalent body-force
-  !!   analytically. Solution displacement is obtained by application of
-  !!   the Greens functions in the Fourier domain.
-  !!
-  !!   For friction faults where slip rates are evaluated from stress and
-  !!   a constitutive law, the rake corresponds to the orientation of slip. 
-  !!   That is, if r_i is the rake vector and v_i is the instantaneous 
-  !!   velocity vector, then r_j v_j >= 0. 
-  !!
-  !! <hr>
-  !!
-  !! OUTPUT:
-  !!   The vector-valued deformation is computed everywhere in a cartesian
-  !!   grid. The vector field is sampled 1) along a horizontal surface at a
-  !!   specified depth and 2) at specific points. Format is always North (x1), 
-  !!   East (x2) and Down (x3) components, following the right-handed reference 
-  !!   system convention. North corresponds to x1-direction, East to the 
-  !!   x2-direction and down to the x3-direction. The Generic Mapping Tool 
-  !!   output files are labeled explicitely ???-north.grd, ???-east.grd and 
-  !!   ???-up.grd (or say, ???-geo-up.grd for outputs in geographic 
-  !!   coordinates), where ??? stands for an output index: 001, 002, ...
-  !!
-  !!   The amplitude of the inelastic (irreversible) deformation is also
-  !!   tracked and can be output along a plane of arbitrary orientation.
-  !!   The inelastic deformation includes the initial, constrained, slip on
-  !!   fault surfaces, the time-dependent slip on frictional surfaces and
-  !!   the cumulative amplitude of bulk strain in viscoelastic regions.
-  !!   Slip is provided as a function of local coordinates along strike and 
-  !!   dip as well as a function of the Cartesian coordinates for three-
-  !!   dimensional display.
-  !!
-  !!   Time integration uses adaptive time steps to ensure accuracy but
-  !!   results can be output either 1) at specified uniform time intervals 
-  !!   or 2) at the same intervals as computed. In the later case, output 
-  !!   intervals is chosen internally depending on instantaneous relaxation 
-  !!   rates.
-  !!
-  !! <hr>
-  !!
-  !! TECHNICAL ASPECTS:
-  !!   Most of the computational burden comes from 1) applying the elastic
-  !!   Green function and 2) computing the current strain from a displacement
-  !!   field. The convolution of body forces with the Green function is 
-  !!   performed in the Fourier domain and the efficiency of the computation
-  !!   depends essentially upon a choice of the discrete Fourier transform.
-  !!   Current implementation is compatible with the Couley-Tuckey, the
-  !!   Fast Fourier transform of the West (FFTW), the SGI FFT and the intel
-  !!   FFT from the intel MKL library. Among these choices, the MKL FFT is
-  !!   the most efficient. The FFTW, SGI FFT and MKL FFT can all be ran
-  !!   in parallel on shared-memory computers.
-  !!
-  !!   Strain is computed using a Finite Impulse Response differentiator
-  !!   filter in the space domain. Use of FIR filter give rise to very
-  !!   accurate derivatives but is computationally expensive. The filter
-  !!   kernels are provided in the kernel???.inc files. Use of a compact
-  !!   kernel may accelerate computation significantly.
-  !!
-  !!   Compilation options are defined in the include.f90 file and specify
-  !!   for instance the choice of DFT and the kind of output provided.
-  !!
-  !! MODIFICATIONS:
-  !! \author Sylvain Barbot 
-  !! (07-06-07) - original form                                    <br>
-  !! (08-28-08) - FFTW/SGI_FFT support, FIR derivatives,
-  !!              Runge-Kutta integration, tensile cracks,
-  !!              GMT output, comments in input file               <br>
-  !! (10-24-08) - interseismic loading, postseismic signal
-  !!              output in separate files                         <br>
-  !! (12-08-09) - slip distribution smoothing                      <br>
-  !! (05-05-10) - lateral variations in viscous properties
-  !!              Intel MKL implementation of the FFT              <br>
-  !! (06-04-10) - output in geographic coordinates
-  !!              and output components of stress tensor           <br>
-  !! (07-19-10) - includes surface tractions initial condition
-  !!              output geometry in VTK format for Paraview       <br>
-  !! (02-28-11) - add constraints on the broad direction of 
-  !!              afterslip, export faults to GMT xy format
-  !!              and allow scaling of computed time steps.        <br>
-  !! (04-26-11) - include command-line arguments
-  !! (11-04-11) - compatible with gfortran                         <br>
-  !!
-  !! \todo 
-  !!   - homogenize VTK output so that geometry of events match event index
-  !!   - evaluate Green's function, stress and body forces in GPU
-  !!   - write the code for MPI multi-thread
-  !!   - fix the vtk export to grid for anisotropic sampling
-  !!   - export position of observation points to long/lat in opts-geo.dat
-  !!   - check the projected output on the south hemisphere
-  !!   - check the fully-relaxed afterslip for uniform stress change
-  !!   - include topography of parameter interface
-  !!   - export afterslip output in VTK
-  !------------------------------------------------------------------------
-PROGRAM relax
-
-  USE types
-  USE input
-  USE green
-  USE elastic3d
-  USE viscoelastic3d
-  USE friction3d
-  USE export
-
-#include "include.f90"
-  
-  IMPLICIT NONE
-  
-  INTEGER, PARAMETER :: ITERATION_MAX = 9900
-  REAL*8, PARAMETER :: STEP_MAX = 1e7
-
-  INTEGER :: i,k,e,oi,iostatus,mech(3)
-#ifdef FFTW3_THREADS
-  INTEGER :: iret
-!$  INTEGER :: omp_get_max_threads
-#endif
-  REAL*8 :: maxwell(3)
-  TYPE(SIMULATION_STRUC) :: in
-#ifdef VTK
-  CHARACTER(80) :: filename,title,name
-  CHARACTER(3) :: digit
-#endif
-  CHARACTER(4) :: digit4
-  REAL*8 :: t,Dt,tm
-  
-  ! arrays
-  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: v1,v2,v3,u1,u2,u3,gamma
-  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: u1r,u2r,u3r
-  REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
-  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: inter1,inter2,inter3
-  TYPE(TENSOR), DIMENSION(:,:,:), ALLOCATABLE :: tau,sig,moment
-  
-#ifdef FFTW3_THREADS
-  CALL sfftw_init_threads(iret)
-#ifdef _OPENMP
-  CALL sfftw_plan_with_nthreads(omp_get_max_threads())
-#else
-  CALL sfftw_plan_with_nthreads(4)
-#endif
-#endif
-
-  ! read input parameters
-  CALL init(in)
-
-  ! abort calculation after help message
-  ! or for dry runs
-  IF (in%isdryrun) THEN
-     PRINT '("dry run: abort calculation")'
-  END IF
-  IF (in%isdryrun .OR. in%ishelp) THEN
-     ! exit program
-     GOTO 100
-  END IF
-
-  ! allocate memory
-  ALLOCATE (v1(in%sx1+2,in%sx2,in%sx3),v2(in%sx1+2,in%sx2,in%sx3),v3(in%sx1+2,in%sx2,in%sx3), &
-            u1(in%sx1+2,in%sx2,in%sx3/2),u2(in%sx1+2,in%sx2,in%sx3/2),u3(in%sx1+2,in%sx2,in%sx3/2), &
-            tau(in%sx1,in%sx2,in%sx3/2),sig(in%sx1,in%sx2,in%sx3/2),gamma(in%sx1+2,in%sx2,in%sx3/2), &
-            t1(in%sx1+2,in%sx2),t2(in%sx1+2,in%sx2),t3(in%sx1+2,in%sx2), &
-            STAT=iostatus)
-  IF (iostatus>0) STOP "could not allocate memory"
-#ifdef VTK
-  IF (in%isoutputvtkrelax) THEN
-     ALLOCATE(u1r(in%sx1+2,in%sx2,in%sx3/2),u2r(in%sx1+2,in%sx2,in%sx3/2), &
-              u3r(in%sx1+2,in%sx2,in%sx3/2),STAT=iostatus)
-     IF (iostatus>0) STOP "could not allocate memory for VTK relax output"
-     u1r=0
-     u2r=0
-     u3r=0
-  END IF
-#endif
-
-  IF (in%isoutputrelax) THEN
-     ALLOCATE(inter1(in%sx1+2,in%sx2,2),inter2(in%sx1+2,in%sx2,2),inter3(in%sx1+2,in%sx2,2),STAT=iostatus)
-     IF (iostatus>0) STOP "could not allocate memory for postseismic displacement"
-  END IF
-
-  v1=0;v2=0;v3=0;u1=0;u2=0;u3=0;gamma=0;t1=0;t2=0;t3=0
-  CALL tensorfieldadd(tau,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)
-
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  ! -     construct pre-stress structure
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  IF (ALLOCATED(in%stresslayer)) THEN
-     CALL tensorstructure(in%stressstruc,in%stresslayer,in%dx3)
-     DEALLOCATE(in%stresslayer)
-     
-     DO k=1,in%sx3/2
-        tau(:,:,k)=(-1._4) .times. in%stressstruc(k)%t
-     END DO
-     DEALLOCATE(in%stressstruc)
-  END IF
-
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  ! -     construct linear viscoelastic structure
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  IF (ALLOCATED(in%linearlayer)) THEN
-     CALL viscoelasticstructure(in%linearstruc,in%linearlayer,in%dx3)
-     DEALLOCATE(in%linearlayer)
-  END IF
-
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  ! -   construct nonlinear viscoelastic structure
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  IF (ALLOCATED(in%nonlinearlayer)) THEN
-     CALL viscoelasticstructure(in%nonlinearstruc,in%nonlinearlayer,in%dx3)
-     DEALLOCATE(in%nonlinearlayer)
-  END IF
-
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  ! -   construct nonlinear fault creep structure (rate-strenghtening)
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  IF (ALLOCATED(in%faultcreeplayer)) THEN
-     CALL viscoelasticstructure(in%faultcreepstruc,in%faultcreeplayer,in%dx3)
-     DEALLOCATE(in%faultcreeplayer)
-  END IF
-
-  ! first event
-  e=1
-  ! first output
-  oi=1;
-  ! initial condition
-  t=0
-
-  ! sources
-  CALL dislocations(in%events(e),in%lambda,in%mu,in%beta,in%sx1,in%sx2,in%sx3, &
-                    in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau)
-  CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,0.d0,t3)
-  
-  PRINT '("coseismic event ",I3.3)', e
-  PRINT 0990
-
-  ! export the amplitude of eigenstrain
-  CALL exporteigenstrain(gamma,in%nop,in%op,in%x0,in%y0, &
-                         in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,0)
-  
-  ! export equivalent body forces
-  IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
-#ifdef GRD_EQBF
-     IF (in%isoutputgrd) THEN
-        CALL exportgrd(v1,v2,v3,in%sx1,in%sx2,in%sx3/2, &
-                       in%dx1,in%dx2,in%dx3,0.7_8,in%x0,in%y0,in%wdir,0,convention=3)
-     END IF
-#endif
-  END IF
-
-  ! test the presence of dislocations for coseismic calculation
-  IF ((in%events(e)%nt .NE. 0) .OR. &
-      (in%events(e)%ns .NE. 0) .OR. &
-      (in%events(e)%nm .NE. 0) .OR. &
-      (in%events(e)%nl .NE. 0)) THEN
-
-     ! apply the 3d elastic transfer function
-     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3, &
-                               in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
-  END IF
-  
-  ! transfer solution
-  CALL fieldrep(u1,v1,in%sx1+2,in%sx2,in%sx3/2)
-  CALL fieldrep(u2,v2,in%sx1+2,in%sx2,in%sx3/2)
-  CALL fieldrep(u3,v3,in%sx1+2,in%sx2,in%sx3/2)
-
-  ! evaluate stress
-  CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=-1._4)
-  CALL stressupdate(u1,u2,u3,in%lambda,in%mu, &
-                    in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
-
-  ! export displacements
-#ifdef TXT
-  IF (in%isoutputtxt) THEN
-     CALL exporttxt(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx3,0,0._8,in%wdir,in%reportfilename)
-  END IF
-#endif
-#ifdef XYZ
-  IF (in%isoutputxyz) THEN
-     CALL exportxyz(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx1,in%dx2,in%dx3,0,in%wdir)
-  END IF
-#endif
-#ifdef GRD
-  IF (in%isoutputgrd) THEN
-     CALL exportgrd(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0,in%wdir,0)
-     IF (in%isoutputrelax) THEN
-        CALL exportgrd(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
-                       in%dx1,in%dx2,in%dx3,0._8,in%x0,in%y0,in%wdir,0,convention=2)
-     END IF
-  END IF
-#endif
-#ifdef PROJ
-  IF (in%isoutputproj) THEN
-     CALL exportproj(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz, &
-                     in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,0)
-  END IF
-#endif
-#ifdef VTK
-  IF (in%isoutputvtk) THEN
-     !filename=trim(in%wdir)//"/disp-000.vtr"
-     !CALL exportvtk_vectors(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
-     filename=trim(in%wdir)//"/disp-000.vtk"//char(0)
-     title="coseismic displacement vector field"//char(0)
-     name="displacement"//char(0)
-     CALL exportvtk_vectors_legacy(u1,u2,u3,in%sx1,in%sx2,in%sx3/8,in%dx1,in%dx2,in%dx3, &
-                                   4,4,8,filename,title,name)
-     !CALL exportvtk_vectors_slice(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
-  END IF
-  IF (in%isoutputvtkrelax) THEN
-     filename=trim(in%wdir)//"/disp-relax-000.vtk"//char(0)
-     title="postseismic displacement vector field"//char(0)
-     name="displacement"//char(0)
-     CALL exportvtk_vectors_legacy(u1r,u2r,u3r,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
-                                   4,4,8,filename,title,name)
-  END IF
-#endif
-  IF (ALLOCATED(in%ptsname)) THEN
-     CALL exportpoints(u1,u2,u3,sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-          in%opts,in%ptsname,0._8,in%wdir,.true.,in%x0,in%y0,in%rot)
-  END IF
-
-  ! export initial stress
-#ifdef GRD
-  CALL exportplanestress(sig,in%nop,in%op,in%x0,in%y0,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,oi)
-  IF (in%isoutputgrd .AND. in%isoutputstress) THEN
-     CALL exportstressgrd(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                          in%ozs,in%x0,in%y0,in%wdir,0)
-  END IF
-#endif
-#ifdef PROJ
-  IF (in%isoutputproj .AND. in%isoutputstress) THEN
-      CALL exportstressproj(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%ozs, &
-                            in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,0)
-  END IF
-#endif
-  ! initialize stress conditions
-  CALL export_rfaults_stress_init(sig,in%sx1,in%sx2,in%sx3, &
-                                     in%dx1,in%dx2,in%dx3,in%nsop,in%sop)
-  WRITE (digit4,'(I4.4)') 0
-#ifdef VTK
-  IF (in%isoutputvtk .AND. in%isoutputstress) THEN
-     filename=trim(in%wdir)//"/sigma-"//digit4//".vtk"//char(0)
-     title="stress tensor field"//char(0)
-     name="stress"//char(0)
-     CALL exportvtk_tensors_legacy(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                                   4,4,8,filename,title,name)
-  END IF
-  ! coseismic stress change on predefined planes for 3-D visualization w/ Paraview
-  filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".vtp"
-  CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                in%nsop,in%sop,filename,sig=sig)
-  ! postseismic stress change on predefined planes (zero by definition)
-  filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".vtp"
-  CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                in%nsop,in%sop,filename)
-#endif
-  ! coseismic stress change on predefined planes for gmt
-  filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".xy"
-  CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                in%nsop,in%sop,filename,sig=sig)
-  ! postseismic stress change on predefined planes for gmt (zero by definition)
-  filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".xy"
-  CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                in%nsop,in%sop,filename)
-  ! time series of stress in ASCII format
-  CALL exportcoulombstress(sig,in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                    in%nsop,in%sop,0._8,in%wdir,.TRUE.)
-  CALL reporttime(0,0._8,in%reporttimefilename)
-
-  PRINT 1101,0,0._8,0._8,0._8,0._8,0._8,in%interval,0._8,tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
-  IF (in%interval .LE. 0) THEN
-     GOTO 100 ! no time integration
-  END IF
-
-  ALLOCATE(moment(in%sx1,in%sx2,in%sx3/2),STAT=iostatus)
-  IF (iostatus>0) STOP "could not allocate the mechanical structure"
-
-  !CALL tensorfieldadd(sig,sig,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)
-  CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)  
-
-  DO i=1,ITERATION_MAX
-     IF (t .GE. in%interval) GOTO 100 ! proper exit
-     
-     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-     ! predictor
-     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-     ! initialize large time step
-     tm=STEP_MAX;
-     maxwell(:)=STEP_MAX;
-     
-     ! active mechanism flag
-     mech(:)=0
-
-     ! initialize no forcing term in tensor space
-     CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,0._4,0._4)
-
-     ! power density from three mechanisms (linear and power-law viscosity 
-     ! and fault creep)
-     ! 1- linear viscosity
-     IF (ALLOCATED(in%linearstruc)) THEN
-        CALL viscouseigenstress(in%mu,in%linearstruc,in%linearweakzone,in%nlwz, &
-             sig,in%sx1,in%sx2,in%sx3/2, &
-             in%dx1,in%dx2,in%dx3,moment,0.01_8,MAXWELLTIME=maxwell(1))
-        mech(1)=1
-     END IF
-     
-     ! 2- powerlaw viscosity
-     IF (ALLOCATED(in%nonlinearstruc)) THEN
-        CALL viscouseigenstress(in%mu,in%nonlinearstruc,in%nonlinearweakzone,in%nnlwz, &
-             sig,in%sx1,in%sx2,in%sx3/2, &
-             in%dx1,in%dx2,in%dx3,moment,0.01_8,MAXWELLTIME=maxwell(2))
-        mech(2)=1
-     END IF
-     
-     ! 3- nonlinear fault creep with rate-strengthening friction
-     IF (ALLOCATED(in%faultcreepstruc)) THEN
-        DO k=1,in%np
-           CALL frictioneigenstress(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
-                in%n(k)%width,in%n(k)%length, &
-                in%n(k)%strike,in%n(k)%dip,in%n(k)%rake,in%beta, &
-                sig,in%mu,in%faultcreepstruc, &
-                in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                moment,maxwelltime=maxwell(3))
-        END DO
-        mech(3)=1
-     END IF
-
-#ifdef VTK
-     IF (in%isoutputvtk .AND. in%isoutputstress) THEN
-        WRITE (digit,'(I3.3)') oi-1
-        filename=trim(in%wdir)//"/power-"//digit//".vtk"//char(0)
-        title="stress rate tensor field"//char(0)
-        name="power"//char(0)
-        CALL exportvtk_tensors_legacy(moment,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                                      4,4,8,filename,title,name)
-     END IF
-#endif
-
-     ! identify the required time step
-     tm=1._8/(REAL(mech(1))/maxwell(1)+ &
-              REAL(mech(2))/maxwell(2)+ &
-              REAL(mech(3))/maxwell(3))
-     ! force finite time step
-     tm=MIN(tm,STEP_MAX)
-
-     ! modify
-     IF ((in%inter%ns .GT. 0) .OR. (in%inter%nt .GT. 0)) THEN
-        IF (tm .EQ. STEP_MAX) THEN
-           ! no relaxation occurs, pick a small integration time
-           tm=in%interval/20._8
-        END IF
-     END IF
-     
-     ! choose an integration time step
-     CALL integrationstep(tm,Dt,t,oi,in%odt,in%skip,in%tscale,in%events,e,in%ne)
-
-     CALL tensorfieldadd(sig,moment,in%sx1,in%sx2,in%sx3/2,c1=0.0_4,c2=1._4)
-     
-     v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
-     CALL equivalentbodyforce(sig,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,v1,v2,v3,t1,t2,t3)
-
-     ! add time-dependent surface loads
-     CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,Dt/2.d8,t3,rate=.TRUE.)
-
-     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3,in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
-     
-     ! v1,v2,v3 contain the predictor displacement
-     CALL fieldadd(v1,u1,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
-     CALL fieldadd(v2,u2,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
-     CALL fieldadd(v3,u3,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
-     CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=-REAL(Dt/2),c2=-1._4)
-
-     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-     ! corrector
-     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-     CALL stressupdate(v1,v2,v3,in%lambda,in%mu, &
-                       in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
-
-     ! reinitialize moment density tensor
-     CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,0._4,0._4)
-     
-     IF (ALLOCATED(in%linearstruc)) THEN
-        ! linear viscosity
-        v1=0
-        CALL viscouseigenstress(in%mu,in%linearstruc,in%linearweakzone,in%nlwz,sig, &
-             in%sx1,in%sx2,in%sx3/2, &
-             in%dx1,in%dx2,in%dx3,moment,0.01_8,GAMMA=v1)
-        
-        ! update slip history
-        CALL fieldadd(gamma,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
-     END IF
-     
-     IF (ALLOCATED(in%nonlinearstruc)) THEN
-        ! powerlaw viscosity
-        v1=0
-        CALL viscouseigenstress(in%mu,in%nonlinearstruc,in%nonlinearweakzone,in%nnlwz,sig, &
-             in%sx1,in%sx2,in%sx3/2, &
-             in%dx1,in%dx2,in%dx3,moment,0.01_8,GAMMA=v1)
-        
-        ! update slip history
-        CALL fieldadd(gamma,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
-     END IF
-     
-     ! nonlinear fault creep with rate-strengthening friction
-     IF (ALLOCATED(in%faultcreepstruc)) THEN
-
-        ! use v1 as placeholders for the afterslip planes
-        DO k=1,in%np
-           ! one may use optional arguments ...,VEL=v1) to convert
-           ! fault slip to eigenstrain (scalar)
-           CALL frictioneigenstress(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
-                in%n(k)%width,in%n(k)%length, &
-                in%n(k)%strike,in%n(k)%dip,in%n(k)%rake,in%beta, &
-                sig,in%mu,in%faultcreepstruc,in%sx1,in%sx2,in%sx3/2, &
-                in%dx1,in%dx2,in%dx3,moment)
-        END DO
-
-        ! export strike and dip creep velocity
-        IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
-           CALL exportcreep(in%np,in%n,in%beta,sig,in%faultcreepstruc, &
-                            in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%x0,in%y0,in%wdir,oi)
-        END IF
-
-     END IF
-
-     ! interseismic loading
-     IF ((in%inter%ns .GT. 0) .OR. (in%inter%nt .GT. 0)) THEN
-        ! vectors v1,v2,v3 are not affected.
-        CALL dislocations(in%inter,in%lambda,in%mu,in%beta,in%sx1,in%sx2,in%sx3, &
-             in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau,eigenstress=moment)
-     END IF
-     
-     v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
-     CALL equivalentbodyforce(moment,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,v1,v2,v3,t1,t2,t3)
-
-     ! add time-dependent surface loads
-     CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,Dt,t3,rate=.true.)
-
-     ! export equivalent body forces
-     IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
-#ifdef VTK_EQBF
-        IF (in%isoutputvtk) THEN
-           WRITE (digit,'(I3.3)') oi
-           !filename=trim(in%wdir)//"/eqbf-"//digit//".vtr"
-           !CALL exportvtk_vectors(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
-           filename=trim(in%wdir)//"/eqbf-"//digit//".vtk"//char(0)
-           title="instantaneous equivalent body-force rate vector field"//char(0)
-           name="body-force-rate"//char(0)
-           CALL exportvtk_vectors_legacy(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
-                                         4,4,8,filename,title,name)
-        END IF
-#endif
-#ifdef GRD_EQBF
-        IF (in%isoutputgrd) THEN
-           CALL exportgrd(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                          in%oz,in%x0,in%y0,in%wdir,oi,convention=3)
-        END IF
-#endif
-     END IF
-
-     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3,in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
-
-     ! update deformation field
-     CALL fieldadd(u1,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
-     CALL fieldadd(u2,v2,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
-     CALL fieldadd(u3,v3,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
-     CALL tensorfieldadd(tau,moment,in%sx1,in%sx2,in%sx3/2,c2=REAL(Dt))
-     
-     ! keep track of the viscoelastic contribution alone
-     IF (in%isoutputrelax) THEN
-        CALL sliceadd(inter1(:,:,1),v1,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
-        CALL sliceadd(inter2(:,:,1),v2,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
-        CALL sliceadd(inter3(:,:,1),v3,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
-     END IF
-
-#ifdef VTK
-     IF (in%isoutputvtkrelax) THEN
-        u1r=u1r+Dt*v1
-        u2r=u2r+Dt*v2
-        u3r=u3r+Dt*v3 
-     END IF
-#endif
-
-     ! time increment
-     t=t+Dt
-     
-     ! next event
-     IF (e .LT. in%ne) THEN
-        IF (abs(t-in%events(e+1)%time) .LT. 1e-6) THEN
-           e=e+1
-           in%events(e)%i=i
-
-           PRINT '("coseismic event ",I3.3)', e
-           PRINT 0990
-
-           v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
-           CALL dislocations(in%events(e),in%lambda,in%mu, &
-                in%beta,in%sx1,in%sx2,in%sx3, &
-                in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau)
-           CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,0.d0,t3)
-
-           ! apply the 3d elastic transfert function
-           CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3, &
-                in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
-           
-           ! transfer solution
-           CALL fieldadd(u1,v1,in%sx1+2,in%sx2,in%sx3/2)
-           CALL fieldadd(u2,v2,in%sx1+2,in%sx2,in%sx3/2)
-           CALL fieldadd(u3,v3,in%sx1+2,in%sx2,in%sx3/2)
-
-        END IF
-     END IF
-
-     CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=-1._4)
-     CALL stressupdate(u1,u2,u3,in%lambda,in%mu, &
-                       in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
-
-     ! points are exported at all time steps
-     IF (ALLOCATED(in%ptsname)) THEN
-        CALL exportpoints(u1,u2,u3,sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-             in%opts,in%ptsname,t,in%wdir,.FALSE.,in%x0,in%y0,in%rot)
-     END IF
-
-     ! output only at discrete intervals (skip=0, odt>0),
-     ! or every "skip" computational steps (skip>0, odt<0),
-     ! or anytime a coseismic event occurs
-     IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
-        
-        CALL reporttime(1,t,in%reporttimefilename)
-
-        ! export
-#ifdef TXT
-        IF (in%isoutputtxt) THEN
-           CALL exporttxt(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx3,oi,t,in%wdir,in%reportfilename)
-        END IF
-#endif  
-#ifdef XYZ
-        IF (in%isoutputxyz) THEN
-           CALL exportxyz(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx1,in%dx2,in%dx3,i,in%wdir)
-           IF (in%isoutputrelax) THEN
-              !CALL exportxyz(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2,0.0_8,in%dx1,in%dx2,in%dx3,i,in%wdir)
-           END IF
-        END IF
-#endif
-        CALL exporteigenstrain(gamma,in%nop,in%op,in%x0,in%y0,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,oi)
-#ifdef GRD
-        IF (in%isoutputgrd) THEN
-           IF (in%isoutputrelax) THEN
-              CALL exportgrd(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
-                             in%dx1,in%dx2,in%dx3,0._8,in%x0,in%y0,in%wdir,oi,convention=2)
-           END IF
-           CALL exportgrd(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0,in%wdir,oi)
-        END IF
-#endif
-#ifdef PROJ
-        IF (in%isoutputproj) THEN
-           IF (in%isoutputrelax) THEN
-              CALL exportproj(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
-                              in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0, &
-                              in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi,convention=2)
-           END IF
-           CALL exportproj(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0, &
-                           in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi)
-        END IF
-#endif
-#ifdef VTK
-        IF (in%isoutputvtk) THEN
-           WRITE (digit,'(I3.3)') oi
-           ! export total displacement in VTK XML format
-           !filename=trim(in%wdir)//"/disp-"//digit//".vtr"
-           !CALL exportvtk_vectors(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
-           filename=trim(in%wdir)//"/disp-"//digit//".vtk"//char(0)
-           title="cumulative displacement vector field"//char(0)
-           name="displacement"//char(0)
-           CALL exportvtk_vectors_legacy(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
-                                         4,4,8,filename,title,name)
-           !CALL exportvtk_vectors_slice(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
-
-           ! export instantaneous velocity in VTK XML format
-           !filename=trim(in%wdir)//"/vel-"//digit//".vtr"
-           !CALL exportvtk_vectors(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
-           filename=trim(in%wdir)//"/vel-"//digit//".vtk"//char(0)
-           title="instantaneous velocity vector field"//char(0)
-           name="velocity"//char(0)
-           CALL exportvtk_vectors_legacy(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                                         8,8,16,filename,title,name)
-           !CALL exportvtk_vectors_slice(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
-        END IF
-        IF (in%isoutputvtkrelax) THEN
-           WRITE (digit,'(I3.3)') oi
-           filename=trim(in%wdir)//"/disp-relax-"//digit//".vtk"//char(0)
-           title="postseismic displacement vector field"//char(0)
-           name="displacement"//char(0)
-           CALL exportvtk_vectors_legacy(u1r,u2r,u3r,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
-                                         4,4,8,filename,title,name)
-        END IF
-#endif
-
-        ! export stress
-#ifdef GRD
-        IF (in%isoutputgrd .AND. in%isoutputstress) THEN
-           CALL exportstressgrd(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                                in%ozs,in%x0,in%y0,in%wdir,oi)
-        END IF
-#endif
-#ifdef PROJ
-        IF (in%isoutputproj .AND. in%isoutputstress) THEN
-           CALL exportstressproj(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%ozs, &
-                                 in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi)
-        END IF
-#endif
-        WRITE (digit4,'(I4.4)') oi
-#ifdef VTK
-        IF (in%isoutputvtk .AND. in%isoutputstress) THEN
-           filename=trim(in%wdir)//"/sigma-"//digit4//".vtk"//char(0)
-           title="stress tensor field"//char(0)
-           name="stress"//char(0)
-           CALL exportvtk_tensors_legacy(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
-                                         4,4,8,filename,title,name)
-        END IF
-        filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".vtp"
-        CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                      in%nsop,in%sop,filename,sig=sig)
-        filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".vtp"
-        CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                      in%nsop,in%sop,filename,convention=1,sig=sig)
-#endif
-        ! total stress on predefined planes for gmt
-        filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".xy"
-        CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                      in%nsop,in%sop,filename,sig=sig)
-        ! postseismic stress change on predefined planes for gm
-        filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".xy"
-        CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                                      in%nsop,in%sop,filename,convention=1,sig=sig)
-        ! time series of stress in ASCII format
-        CALL exportcoulombstress(sig,in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
-                          in%nsop,in%sop,t,in%wdir,.FALSE.)
-
-        PRINT 1101,i,Dt,maxwell,t,in%interval, &
-             tensoramplitude(moment,in%dx1,in%dx2,in%dx3), &
-             tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
-
-        ! update output counter
-        oi=oi+1
-     ELSE
-        PRINT 1100,i,Dt,maxwell,t,in%interval, &
-             tensoramplitude(moment,in%dx1,in%dx2,in%dx3), &
-             tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
-     END IF
-
-  END DO
-
-100 CONTINUE
-
-  DO i=1,in%ne
-     IF (ALLOCATED(in%events(i)%s))  DEALLOCATE(in%events(i)%s,in%events(i)%sc)
-     IF (ALLOCATED(in%events(i)%ts)) DEALLOCATE(in%events(i)%ts,in%events(i)%tsc)
-  END DO
-  IF (ALLOCATED(in%events)) DEALLOCATE(in%events)
-
-  ! free memory
-  IF (ALLOCATED(gamma)) DEALLOCATE(gamma)
-  IF (ALLOCATED(in%opts)) DEALLOCATE(in%opts)
-  IF (ALLOCATED(in%ptsname)) DEALLOCATE(in%ptsname)
-  IF (ALLOCATED(in%op)) DEALLOCATE(in%op)
-  IF (ALLOCATED(in%sop)) DEALLOCATE(in%sop)
-  IF (ALLOCATED(in%n)) DEALLOCATE(in%n)
-  IF (ALLOCATED(in%stressstruc)) DEALLOCATE(in%stressstruc)
-  IF (ALLOCATED(in%stresslayer)) DEALLOCATE(in%stresslayer)
-  IF (ALLOCATED(in%linearstruc)) DEALLOCATE(in%linearstruc)
-  IF (ALLOCATED(in%linearlayer)) DEALLOCATE(in%linearlayer)
-  IF (ALLOCATED(in%linearweakzone)) DEALLOCATE(in%linearweakzone)
-  IF (ALLOCATED(in%nonlinearstruc)) DEALLOCATE(in%nonlinearstruc)
-  IF (ALLOCATED(in%nonlinearlayer)) DEALLOCATE(in%nonlinearlayer)
-  IF (ALLOCATED(in%nonlinearweakzone)) DEALLOCATE(in%nonlinearweakzone)
-  IF (ALLOCATED(in%faultcreepstruc)) DEALLOCATE(in%faultcreepstruc)
-  IF (ALLOCATED(in%faultcreeplayer)) DEALLOCATE(in%faultcreeplayer)
-  IF (ALLOCATED(sig)) DEALLOCATE(sig)
-  IF (ALLOCATED(tau)) DEALLOCATE(tau)
-  IF (ALLOCATED(moment)) DEALLOCATE(moment)
-  IF (ALLOCATED(in%stresslayer)) DEALLOCATE(in%stresslayer)
-  IF (ALLOCATED(in%linearlayer)) DEALLOCATE(in%linearlayer)
-  IF (ALLOCATED(in%nonlinearlayer)) DEALLOCATE(in%nonlinearlayer)
-  IF (ALLOCATED(in%faultcreeplayer)) DEALLOCATE(in%faultcreeplayer)
-  IF (ALLOCATED(v1)) DEALLOCATE(v1,v2,v3,t1,t2,t3)
-  IF (ALLOCATED(u1)) DEALLOCATE(u1,u2,u3)
-  IF (ALLOCATED(inter1)) DEALLOCATE(inter1,inter2,inter3)
-
-
-#ifdef FFTW3_THREADS
-  CALL sfftw_cleanup_threads()
-#endif
-
-0990 FORMAT (" I  |   Dt   | tm(ve) | tm(pl) | tm(as) |     t/tmax     | power  |  C:E^i | ")
-1000 FORMAT (I3.3,"*",ES9.2E2,"                            ",ES9.2E2,"/",ES7.2E1)
-1100 FORMAT (I3.3," ",ES9.2E2,3ES9.2E2,ES9.2E2,"/",ES7.2E1,2ES9.2E2)
-1101 FORMAT (I3.3,"*",ES9.2E2,3ES9.2E2,ES9.2E2,"/",ES7.2E1,2ES9.2E2)
-1200 FORMAT ("----------------------------------------------------------------------------")
-
-CONTAINS
-
-  !--------------------------------------------------------------------
-  !> subroutine dislocations
-  !! assigns equivalent body forces or moment density to simulate
-  !! shear dislocations and fault opening. add the corresponding moment
-  !! density in the cumulative relaxed moment so that fault slip does
-  !! not reverse in the postseismic time.
-  !--------------------------------------------------------------------
-  SUBROUTINE dislocations(event,lambda,mu,beta,sx1,sx2,sx3,dx1,dx2,dx3, &
-                          v1,v2,v3,t1,t2,t3,tau,factor,eigenstress)
-    TYPE(EVENT_STRUC), INTENT(IN) :: event
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: lambda,mu,beta,dx1,dx2,dx3
-    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: v1,v2,v3
-    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: t1,t2,t3
-    TYPE(TENSOR), DIMENSION(:,:,:), INTENT(INOUT) :: tau
-    REAL*8, INTENT(IN), OPTIONAL :: factor
-    TYPE(TENSOR), DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: eigenstress
-    
-    INTEGER :: i
-    REAL*8 :: slip_factor
-    
-    IF (PRESENT(factor)) THEN
-       slip_factor=factor
-    ELSE
-       slip_factor=1._8
-    END IF
-    
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    ! -             load shear dislocations
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    IF (.NOT. (PRESENT(eigenstress))) THEN
-       ! forcing term in equivalent body force
-       DO i=1,event%ns
-          ! adding sources in the space domain
-          CALL source(mu,slip_factor*event%s(i)%slip, &
-               event%s(i)%x,event%s(i)%y,event%s(i)%z, &
-               event%s(i)%width,event%s(i)%length, &
-               event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
-               event%s(i)%beta,sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3,t1,t2,t3)
-       END DO
-    ELSE
-       ! forcing term in moment density
-       DO i=1,event%ns
-          CALL momentdensityshear(mu,slip_factor*event%s(i)%slip, &
-               event%s(i)%x,event%s(i)%y,event%s(i)%z, &
-               event%s(i)%width,event%s(i)%length, &
-               event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
-               event%s(i)%beta,sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
-       END DO
-    END IF
-
-    DO i=1,event%ns
-       ! remove corresponding eigenmoment
-       CALL momentdensityshear(mu,slip_factor*event%s(i)%slip, &
-            event%s(i)%x,event%s(i)%y,event%s(i)%z, &
-            event%s(i)%width,event%s(i)%length, &
-            event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
-            event%s(i)%beta,sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
-    END DO
-    
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    ! -             load tensile cracks
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    IF (.NOT. (PRESENT(eigenstress))) THEN
-       ! forcing term in equivalent body force
-       DO i=1,event%nt
-          ! adding sources in the space domain
-          CALL tensilesource(lambda,mu,slip_factor*event%ts(i)%slip, &
-               event%ts(i)%x,event%ts(i)%y,event%ts(i)%z, &
-               event%ts(i)%width,event%ts(i)%length, &
-               event%ts(i)%strike,event%ts(i)%dip, &
-               beta,sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3)
-       END DO
-    ELSE
-       ! forcing term in moment density
-       DO i=1,event%nt
-          CALL momentdensitytensile(lambda,mu,slip_factor*event%ts(i)%slip, &
-               event%ts(i)%x,event%ts(i)%y,event%ts(i)%z,&
-               event%ts(i)%width,event%ts(i)%length, &
-               event%ts(i)%strike,event%ts(i)%dip,event%ts(i)%rake, &
-               beta,sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
-       END DO
-    END IF
-
-    DO i=1,event%nt
-       ! removing corresponding eigenmoment
-       CALL momentdensitytensile(lambda,mu,slip_factor*event%ts(i)%slip, &
-            event%ts(i)%x,event%ts(i)%y,event%ts(i)%z,&
-            event%ts(i)%width,event%ts(i)%length, &
-            event%ts(i)%strike,event%ts(i)%dip,event%ts(i)%rake, &
-            beta,sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
-    END DO
-
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    ! -             load point dilatation sources
-    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    IF (.NOT. (PRESENT(eigenstress))) THEN
-       ! forcing term in equivalent body force
-       DO i=1,event%nm
-          ! adding sources in the space domain
-          CALL mogisource(lambda,mu,slip_factor*event%m(i)%slip, &
-               event%m(i)%x,event%m(i)%y,event%m(i)%z, &
-               sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3)
-       END DO
-    ELSE
-       ! forcing term in moment density
-       DO i=1,event%nm
-          CALL momentdensitymogi(lambda,mu,slip_factor*event%m(i)%slip, &
-               event%m(i)%x,event%m(i)%y,event%m(i)%z, &
-               sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
-       END DO
-    END IF
-
-    DO i=1,event%nm
-       ! remove corresponding eigenmoment
-       CALL momentdensitymogi(lambda,mu,slip_factor*event%m(i)%slip, &
-            event%m(i)%x,event%m(i)%y,event%m(i)%z, &
-            sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
-    END DO
-    
-  END SUBROUTINE dislocations
-
-  !--------------------------------------------------------------------
-  !> function IsOutput
-  !! checks if output should be written based on user choices: if output
-  !! time interval (odt) is positive, output is written only if time
-  !! is an integer of odt. If odt is negative output is written at times
-  !! corresponding to internally chosen time steps.
-  !!
-  !! @return IsOutput is true only at discrete intervals (skip=0,odt>0),
-  !! or at every "skip" computational steps (skip>0,odt<0),
-  !! or anytime a coseismic event occurs
-  !
-  ! Sylvain Barbot (07/06/09) - original form
-  !--------------------------------------------------------------------
-  LOGICAL FUNCTION isoutput(skip,t,i,odt,oi,etime)
-    INTEGER, INTENT(IN) :: skip,i,oi
-    REAL*8, INTENT(IN) :: t,odt,etime
-
-    IF (((0 .EQ. skip) .AND. (abs(t-oi*odt) .LT. 1e-6*odt)) .OR. &
-        ((0 .LT. skip) .AND. (MOD(i-1,skip) .EQ. 0)) .OR. &
-         (abs(t-etime) .LT. 1e-6)) THEN
-       isoutput=.TRUE.
-    ELSE
-       isoutput=.FALSE.
-    END IF
-
-  END FUNCTION isoutput
-
-  !--------------------------------------------------------------------
-  !> subroutine IntegrationStep
-  !! find the time-integration forward step for the predictor-corrector
-  !! scheme.
-  !!
-  !! input file line
-  !!
-  !!    time interval, (positive dt step) or (negative skip and scaling)
-  !!
-  !! can be filled by either 1)
-  !!
-  !!   T, dt
-  !!
-  !! where T is the time interval of the simulation and dt is the
-  !! output time step, or 2)
-  !!
-  !!   T, -n, t_s
-  !!
-  !! where n indicates the number of computational steps before 
-  !! outputing results, t_s is a scaling applied to internally
-  !! computed time step.
-  !!
-  !! for case 1), an optimal time step is evaluated internally to
-  !! ensure stability (t_m/10) of time integration. The actual
-  !! time step Dt is chosen as
-  !!
-  !!    Dt = min( t_m/10, ((t%odt)+1)*odt-t )
-  !!
-  !! where t is the current time in the simulation. regardless of 
-  !! time step Dt, results are output if t is a multiple of dt.
-  !!
-  !! for case 2), the time step is chosen internally based on an 
-  !! estimate of the relaxation time (t_m/10). Results are output
-  !! every n steps. The actual time step is chosen as
-  !!
-  !!    Dt = min( t_m/10*t_s, t(next event)-t )
-  !!
-  !! where index is the number of computational steps after a coseismic
-  !! event and t(next event) is the time of the next coseismic event.
-  !!
-  !! \author sylvain barbot (01/01/08) - original form 
-  !--------------------------------------------------------------------
-  SUBROUTINE integrationstep(tm,Dt,t,oi,odt,skip,tscale,events,e,ne)
-    REAL*8, INTENT(INOUT) :: tm,Dt,odt
-    REAL*8, INTENT(IN) :: t,tscale
-    INTEGER, INTENT(IN) :: oi,e,ne,skip
-    TYPE(EVENT_STRUC), INTENT(IN), DIMENSION(:) :: events
-
-    ! output at optimal computational intervals
-    Dt=tm/10._8
-
-    ! reduce time in case something happens in [ t, t+Dt ]
-    IF (0 .EQ. skip) THEN
-       ! reduce time step so that t+Dt is time at next 
-       ! user-required output time
-       IF ((t+Dt) .GE. (dble(oi)*odt)-Dt*0.04d0) THEN
-          ! pick a smaller time step to reach :
-          ! integers of odt
-          Dt=dble(oi)*odt-t
-       END IF
-    ELSE
-       ! scale the estimate of optimal time step
-       Dt=Dt*tscale
-
-       ! reduce time step so that t+Dt is time to next event
-       IF (e .LT. ne) THEN
-          IF ((t+Dt-events(e+1)%time) .GE. 0._8) THEN
-             ! pick a smaller time step to reach 
-             ! next event time
-             Dt=events(e+1)%time-t
-          END IF
-       END IF
-    END IF
-
-  END SUBROUTINE integrationstep
-
-END PROGRAM relax
diff -r 405d8f4fa05f -r e7295294f654 src/ctfft.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ctfft.f	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,618 @@
+      subroutine ctfft (data,n,ndim,isign,iform,work,nwork)             fft   1
+c     cooley-tukey fast fourier transform in usasi basic fortran.       fft   2
+c     multi-dimensional transform, dimensions of arbitrary size,        fft   3
+c     complex or real data.  n points can be transformed in time        fft   4
+c     proportional to n*log(n), whereas other methods take n**2 time.   fft   5
+c     furthermore, less error is built up.  written by norman brenner   fft   6
+c     of mit lincoln laboratory, june 1968.                             fft   7
+c                                                                       fft   8
+c     dimension data(n(1),n(2),...),transform(n(1),n(2),...),n(ndim)    fft   9
+c     transform(k1,k2,...) = sum(data(j1,j2,...)*exp(isign*2*pi*sqrt(-1)fft  10
+c     *((j1-1)*(k1-1)/n(1)+(j2-1)*(k2-1)/n(2)+...))), summed for all    fft  11
+c     j1 and k1 from 1 to n(1), j2 and k2 from 1 to n(2), etc. for all  fft  12
+c     ndim subscripts.  ndim must be positive and each n(idim) may be   fft  13
+c     any integer.  isign is +1 or -1.  let ntot = n(1)*n(2)...         fft  14
+c     ...*n(ndim).  then a -1 transform followed by a +1 one            fft  15
+c     (or vice versa) returns ntot times the original data.             fft  16
+c     iform = 1, 0 or -1, as data is complex, real or the               fft  17
+c     first half of a complex array.  transform values are              fft  18
+c     returned to array data.  they are complex, real or                fft  19
+c     the first half of a complex array, as iform = 1, -1 or 0.         fft  20
+c     the transform of a real array (iform = 0) dimensioned n(1) by n(2)fft  21
+c     by ... will be returned in the same array, now considered to      fft  22
+c     be complex of dimensions n(1)/2+1 by n(2) by ....  note that if   fft  23
+c     iform = 0 or -1, n(1) must be even, and enough room must be       fft  24
+c     reserved.  the missing values may be obtained by complex conju-   fft  25
+c     gation.  the reverse transformation, of a half complex array      fft  26
+c     dimensioned n(1)/2+1 by n(2) by ..., is accomplished setting iformfft  27
+c     to -1.  in the n array, n(1) must be the true n(1), not n(1)/2+1. fft  28
+c     the transform will be real and returned to the input array.       fft  29
+c     work is a one-dimensional complex array used for working storage. fft  30
+c     its length, nwork, need never be larger than the largest n(idim)  fft  31
+c     and frequently may be much smaller.  fourt computes the minimum   fft  32
+c     length working storage required and checks that nwork is at least fft  33
+c     as long.  this minimum length is ccomputed as shown below.        fft  34
+c                                                                       fft  35
+c     for example--                                                     fft  36
+c     dimension data(1960),work(10)                                     fft  37
+c     complex data,work                                                 fft  38
+c     call fourt(data,1960,1,-1,+1,work,10)                             fft  39
+c                                                                       fft  40
+c     the multi-dimensional transform is broken down into one-dimen-    fft  41
+c     sional transforms of length n(idim).  these are further broken    fft  42
+c     down into transforms of length ifact(if), where these are the     fft  43
+c     prime factors of n(idim).  for example, n(1) = 1960, ifact(if) =  fft  44
+c     2, 2, 2, 5, 7 and 7.  the running time is proportional to ntot *  fft  45
+c     sum(ifact(if)), though factors of two and three will run espe-    fft  46
+c     cially fast.  naive transform programs will run in time ntot**2.  fft  47
+c     arrays whose size ntot is prime will run much slower than those   fft  48
+c     with composite ntot.  for example, ntot = n(1) = 1951 (a prime),  fft  49
+c     running time will be 1951*1951, while for ntot = 1960, it will    fft  50
+c     be 1960*(2+2+2+5+7+7), a speedup of eighty times.  naive calcul-  fft  51
+c     ation will run both in the slower time.  if an array is of        fft  52
+c     inconvenient length, simply add zeroes to pad it out.  the resultsfft  53
+c     will be interpolated according to the new length (see below).     fft  54
+c                                                                       fft  55
+c     a fourier transform of length ifact(if) requires a work array     fft  56
+c     of that length.  therefore, nwork must be as big as the largest   fft  57
+c     prime factor.  further, work is needed for digit reversal--       fft  58
+c     each n(idim) (but n(1)/2 if iform = 0 or -1) is factored symmetri-fft  59
+c     cally, and nwork must be as big as the center factor.  (to factor fft  60
+c     symmetrically, separate pairs of identical factors to the flanks, fft  61
+c     combining all leftovers in the center.)  for example, n(1) = 1960 fft  62
+c     =2*2*2*5*7*7=2*7*10*7*2, so nwork must at least max(7,10) = 10.   fft  63
+c                                                                       fft  64
+c     an upper bound for the rms relative error is given by gentleman   fft  65
+c     and sande (3)-- 3 * 2**(-b) * sum(f**1.5), where 2**(-b) is the   fft  66
+c     smallest bit in the floating point fraction and the sum is over   fft  67
+c     the prime factors of ntot.                                        fft  68
+c                                                                       fft  69
+c     if the input data are a time series, with index j representing    fft  70
+c     a time (j-1)*deltat, then the corresponding index k in the        fft  71
+c     transform represents the frequency (k-1)*2*pi/(n*deltat), which   fft  72
+c     by periodicity, is the same as frequency -(n-k+1)*2*pi/(n*deltat).fft  73
+c     this is true for n = each n(idim) independently.                  fft  74
+c                                                                       fft  75
+c     references--                                                      fft  76
+c     1.  cooley, j.w. and tukey, j.w., an algorithm for the machine    fft  77
+c     calculation of complex fourier series.  math. comp., 19, 90,      fft  78
+c     (april 1967), 297-301.                                            fft  79
+c     2.  rader, c., et al., what is the fast fourier transform, ieee   fft  80
+c     transactions on audio and electroacoustics, au-15, 2 (june 1967). fft  81
+c     (special issue on the fast fourier transform and its applications)fft  82
+c     3.  gentleman, w.m. and sande, g., fast fourier transforms--      fft  83
+c     for fun and profit.  1966 fall joint comp. conf., spartan books,  fft  84
+c     washington, 1966.                                                 fft  85
+c     4.  goertzel, g., an algorithm for the evaluation of finite       fft  86
+c     trigonometric series.  am. math. mo., 65, (1958), 34-35.          fft  87
+c     5.  singleton, r.c., a method for computing the fast fourier      fft  88
+c     transform with auxiliary memory and limited high-speed storage.   fft  89
+c     in (2).                                                           fft  90
+      dimension data(*), n(1), work(*), ifsym(32), ifcnt(10), ifact(32) fft  91
+      if (iform) 10,10,40                                               fft  92
+ 10   if (n(1)-2*(n(1)/2)) 20,40,20                                     fft  93
+ 20   continue
+c20   write (6,30) iform,(n(idim),idim=1,ndim)                          fft  94
+c30   format ('error in fourt.  iform = ',i2,'(real or half-complex)'
+c    $' but n(1) is not even./14h dimensions = ',20i5)                  fft  96
+      return                                                            fft  97
+ 40   ntot=1                                                            fft  98
+      do 50 idim=1,ndim                                                 fft  99
+ 50   ntot=ntot*n(idim)                                                 fft 100
+      nrem=ntot                                                         fft 101
+      if (iform) 60,70,70                                               fft 102
+ 60   nrem=1                                                            fft 103
+      ntot=(ntot/n(1))*(n(1)/2+1)                                       fft 104
+c     loop over all dimensions.                                         fft 105
+ 70   do 230 jdim=1,ndim                                                fft 106
+      if (iform) 80,90,90                                               fft 107
+ 80   idim=ndim+1-jdim                                                  fft 108
+      go to 100                                                         fft 109
+ 90   idim=jdim                                                         fft 110
+      nrem=nrem/n(idim)                                                 fft 111
+ 100  ncurr=n(idim)                                                     fft 112
+      if (idim-1) 110,110,140                                           fft 113
+ 110  if (iform) 120,130,140                                            fft 114
+ 120  call fixrl (data,n(1),nrem,isign,iform)                           fft 115
+      ntot=(ntot/(n(1)/2+1))*n(1)                                       fft 116
+ 130  ncurr=ncurr/2                                                     fft 117
+ 140  if (ncurr-1) 190,190,150                                          fft 118
+c     factor n(idim), the length of this dimension.                     fft 119
+ 150  call factr (ncurr,ifact,nfact)                                    fft 120
+      ifmax=ifact(nfact)                                                fft 121
+c     arrange the factors symmetrically for simpler digit reversal.     fft 122
+      call smfac (ifact,nfact,isym,ifsym,nfsym,icent,ifcnt,nfcnt)       fft 123
+      ifmax=max0(ifmax,icent)                                           fft 124
+      if (ifmax-nwork) 180,180,160                                      fft 125
+  160 continue
+c 160 write (6,170) nwork,idim,ncurr,icent,(ifact(if),if=1,nfact)       fft 126
+c 170 format (26h0error in fourt.  nwork = ,i4,20h is too small for n(, fft 127
+c    $i1,4h) = ,i5,17h, whose center = ,i4,31h, and whose prime factors fft 128
+c    $are--/(1x,20i5))                                                  fft 129
+      return                                                            fft 130
+ 180  nprev=ntot/(n(idim)*nrem)                                         fft 131
+c     digit reverse on symmetric factors, for example 2*7*6*7*2.        fft 132
+      call symrv (data,nprev,ncurr,nrem,ifsym,nfsym)                    fft 133
+c     digit reverse the asymmetric center, for example, on 6 = 2*3.     fft 134
+      call asmrv (data,nprev*isym,icent,isym*nrem,ifcnt,nfcnt,work)     fft 135
+c     fourier transform on each factor, for example, on 2,7,2,3,7 and 2.fft 136
+      call cool (data,nprev,ncurr,nrem,isign,ifact,work)                fft 137
+ 190  if (iform) 200,210,230                                            fft 138
+ 200  nrem=nrem*n(idim)                                                 fft 139
+      go to 230                                                         fft 140
+ 210  if (idim-1) 220,220,230                                           fft 141
+ 220  call fixrl (data,n(1),nrem,isign,iform)                           fft 142
+      ntot=ntot/n(1)*(n(1)/2+1)                                         fft 143
+ 230  continue                                                          fft 144
+      return                                                            fft 145
+      end                                                               fft 146-
+      subroutine asmrv (data,nprev,n,nrem,ifact,nfact,work)             asm   1
+c     shuffle the data array by reversing the digits of one index.      asm   2
+c     the operation is the same as in symrv, except that the factors    asm   3
+c     need not be symmetrically arranged, i.e., generally ifact(if) not=asm   4
+c     ifact(nfact+1-if).  consequently, a work array of length n is     asm   5
+c     needed.                                                           asm   6
+      dimension data(*), work(*), ifact(1)                              asm   7
+      if (nfact-1) 60,60,10                                             asm   8
+ 10   ip0=2                                                             asm   9
+      ip1=ip0*nprev                                                     asm  10
+      ip4=ip1*n                                                         asm  11
+      ip5=ip4*nrem                                                      asm  12
+      do 50 i1=1,ip1,ip0                                                asm  13
+      do 50 i5=i1,ip5,ip4                                               asm  14
+      iwork=1                                                           asm  15
+      i4rev=i5                                                          asm  16
+      i4max=i5+ip4-ip1                                                  asm  17
+      do 40 i4=i5,i4max,ip1                                             asm  18
+      work(iwork)=data(i4rev)                                           asm  19
+      work(iwork+1)=data(i4rev+1)                                       asm  20
+      ip3=ip4                                                           asm  21
+      do 30 if=1,nfact                                                  asm  22
+      ip2=ip3/ifact(if)                                                 asm  23
+      i4rev=i4rev+ip2                                                   asm  24
+      if (i4rev-ip3-i5) 40,20,20                                        asm  25
+ 20   i4rev=i4rev-ip3                                                   asm  26
+ 30   ip3=ip2                                                           asm  27
+ 40   iwork=iwork+ip0                                                   asm  28
+      iwork=1                                                           asm  29
+      do 50 i4=i5,i4max,ip1                                             asm  30
+      data(i4)=work(iwork)                                              asm  31
+      data(i4+1)=work(iwork+1)                                          asm  32
+ 50   iwork=iwork+ip0                                                   asm  33
+ 60   return                                                            asm  34
+      end                                                               asm  35-
+      subroutine cool (data,nprev,n,nrem,isign,ifact,work)              coo   1
+c     fourier transform of length n.  in place cooley-tukey method,     coo   2
+c     digit-reversed to normal order, sande-tukey factoring (2).        coo   3
+c     dimension data(nprev,n,nrem)                                      coo   4
+c     complex data                                                      coo   5
+c     data(i1,j2,i3) = sum(data(i1,i2,i3)*exp(isign*2*pi*i*((i2-1)*     coo   6
+c     (j2-1)/n))), summed over i2 = 1 to n for all i1 from 1 to nprev,  coo   7
+c     j2 from 1 to n and i3 from 1 to nrem.  the factors of n are given coo   8
+c     in any order in array ifact.  factors of two are done in pairs    coo   9
+c     as much as possible (fourier transform of length four), factors ofcoo  10
+c     three are done separately, and all factors five or higher         coo  11
+c     are done by goertzel's algorithm (4).                             coo  12
+      dimension data(*), work(*), ifact(1)                              coo  13
+      twopi=6.283185307*float(isign)                                    coo  14
+      ip0=2                                                             coo  15
+      ip1=ip0*nprev                                                     coo  16
+      ip4=ip1*n                                                         coo  17
+      ip5=ip4*nrem                                                      coo  18
+      if=0                                                              coo  19
+      ip2=ip1                                                           coo  20
+ 10   if (ip2-ip4) 20,240,240                                           coo  21
+ 20   if=if+1                                                           coo  22
+      ifcur=ifact(if)                                                   coo  23
+      if (ifcur-2) 60,30,60                                             coo  24
+ 30   if (4*ip2-ip4) 40,40,60                                           coo  25
+ 40   if (ifact(if+1)-2) 60,50,60                                       coo  26
+ 50   if=if+1                                                           coo  27
+      ifcur=4                                                           coo  28
+ 60   ip3=ip2*ifcur                                                     coo  29
+      theta=twopi/float(ifcur)                                          coo  30
+      sinth=sin(theta/2.)                                               coo  31
+      rootr=-2.*sinth*sinth                                             coo  32
+c     cos(theta)-1, for accuracy.                                       coo  33
+      rooti=sin(theta)                                                  coo  34
+      theta=twopi/float(ip3/ip1)                                        coo  35
+      sinth=sin(theta/2.)                                               coo  36
+      wstpr=-2.*sinth*sinth                                             coo  37
+      wstpi=sin(theta)                                                  coo  38
+      wr=1.                                                             coo  39
+      wi=0.                                                             coo  40
+      do 230 i2=1,ip2,ip1                                               coo  41
+      if (ifcur-4) 70,70,210                                            coo  42
+ 70   if ((i2-1)*(ifcur-2)) 240,90,80                                   coo  43
+ 80   w2r=wr*wr-wi*wi                                                   coo  44
+      w2i=2.*wr*wi                                                      coo  45
+      w3r=w2r*wr-w2i*wi                                                 coo  46
+      w3i=w2r*wi+w2i*wr                                                 coo  47
+ 90   i1max=i2+ip1-ip0                                                  coo  48
+      do 200 i1=i2,i1max,ip0                                            coo  49
+      do 200 i5=i1,ip5,ip3                                              coo  50
+      j0=i5                                                             coo  51
+      j1=j0+ip2                                                         coo  52
+      j2=j1+ip2                                                         coo  53
+      j3=j2+ip2                                                         coo  54
+      if (i2-1) 140,140,100                                             coo  55
+ 100  if (ifcur-3) 130,120,110                                          coo  56
+c     apply the phase shift factors                                     coo  57
+ 110  tempr=data(j3)                                                    coo  58
+      data(j3)=w3r*tempr-w3i*data(j3+1)                                 coo  59
+      data(j3+1)=w3r*data(j3+1)+w3i*tempr                               coo  60
+      tempr=data(j2)                                                    coo  61
+      data(j2)=wr*tempr-wi*data(j2+1)                                   coo  62
+      data(j2+1)=wr*data(j2+1)+wi*tempr                                 coo  63
+      tempr=data(j1)                                                    coo  64
+      data(j1)=w2r*tempr-w2i*data(j1+1)                                 coo  65
+      data(j1+1)=w2r*data(j1+1)+w2i*tempr                               coo  66
+      go to 140                                                         coo  67
+ 120  tempr=data(j2)                                                    coo  68
+      data(j2)=w2r*tempr-w2i*data(j2+1)                                 coo  69
+      data(j2+1)=w2r*data(j2+1)+w2i*tempr                               coo  70
+ 130  tempr=data(j1)                                                    coo  71
+      data(j1)=wr*tempr-wi*data(j1+1)                                   coo  72
+      data(j1+1)=wr*data(j1+1)+wi*tempr                                 coo  73
+ 140  if (ifcur-3) 150,160,170                                          coo  74
+c     do a fourier transform of length two                              coo  75
+ 150  tempr=data(j1)                                                    coo  76
+      tempi=data(j1+1)                                                  coo  77
+      data(j1)=data(j0)-tempr                                           coo  78
+      data(j1+1)=data(j0+1)-tempi                                       coo  79
+      data(j0)=data(j0)+tempr                                           coo  80
+      data(j0+1)=data(j0+1)+tempi                                       coo  81
+      go to 200                                                         coo  82
+c     do a fourier transform of length three                            coo  83
+ 160  sumr=data(j1)+data(j2)                                            coo  84
+      sumi=data(j1+1)+data(j2+1)                                        coo  85
+      tempr=data(j0)-.5*sumr                                            coo  86
+      tempi=data(j0+1)-.5*sumi                                          coo  87
+      data(j0)=data(j0)+sumr                                            coo  88
+      data(j0+1)=data(j0+1)+sumi                                        coo  89
+      difr=rooti*(data(j2+1)-data(j1+1))                                coo  90
+      difi=rooti*(data(j1)-data(j2))                                    coo  91
+      data(j1)=tempr+difr                                               coo  92
+      data(j1+1)=tempi+difi                                             coo  93
+      data(j2)=tempr-difr                                               coo  94
+      data(j2+1)=tempi-difi                                             coo  95
+      go to 200                                                         coo  96
+c     do a fourier transform of length four (from bit reversed order)   coo  97
+ 170  t0r=data(j0)+data(j1)                                             coo  98
+      t0i=data(j0+1)+data(j1+1)                                         coo  99
+      t1r=data(j0)-data(j1)                                             coo 100
+      t1i=data(j0+1)-data(j1+1)                                         coo 101
+      t2r=data(j2)+data(j3)                                             coo 102
+      t2i=data(j2+1)+data(j3+1)                                         coo 103
+      t3r=data(j2)-data(j3)                                             coo 104
+      t3i=data(j2+1)-data(j3+1)                                         coo 105
+      data(j0)=t0r+t2r                                                  coo 106
+      data(j0+1)=t0i+t2i                                                coo 107
+      data(j2)=t0r-t2r                                                  coo 108
+      data(j2+1)=t0i-t2i                                                coo 109
+      if (isign) 180,180,190                                            coo 110
+ 180  t3r=-t3r                                                          coo 111
+      t3i=-t3i                                                          coo 112
+ 190  data(j1)=t1r-t3i                                                  coo 113
+      data(j1+1)=t1i+t3r                                                coo 114
+      data(j3)=t1r+t3i                                                  coo 115
+      data(j3+1)=t1i-t3r                                                coo 116
+ 200  continue                                                          coo 117
+      go to 220                                                         coo 118
+c     do a fourier transform of length five or more                     coo 119
+ 210  call goert (data(i2),nprev,ip2/ip1,ifcur,ip5/ip3,work,wr,wi,rootr,coo 120
+     $rooti)                                                            coo 121
+ 220  tempr=wr                                                          coo 122
+      wr=wstpr*tempr-wstpi*wi+tempr                                     coo 123
+ 230  wi=wstpr*wi+wstpi*tempr+wi                                        coo 124
+      ip2=ip3                                                           coo 125
+      go to 10                                                          coo 126
+ 240  return                                                            coo 127
+      end                                                               coo 128-
+      subroutine factr (n,ifact,nfact)                                  fac   1
+c     factor n into its prime factors, nfact in number.  for example,   fac   2
+c     for n = 1960, nfact = 6 and ifact(if) = 2, 2, 2, 5, 7 and 7.      fac   3
+      dimension ifact(1)                                                fac   4
+      if=0                                                              fac   5
+      npart=n                                                           fac   6
+      do 50 id=1,n,2                                                    fac   7
+      idiv=id                                                           fac   8
+      if (id-1) 10,10,20                                                fac   9
+ 10   idiv=2                                                            fac  10
+ 20   iquot=npart/idiv                                                  fac  11
+      if (npart-idiv*iquot) 40,30,40                                    fac  12
+ 30   if=if+1                                                           fac  13
+      ifact(if)=idiv                                                    fac  14
+      npart=iquot                                                       fac  15
+      go to 20                                                          fac  16
+ 40   if (iquot-idiv) 60,60,50                                          fac  17
+ 50   continue                                                          fac  18
+ 60   if (npart-1) 80,80,70                                             fac  19
+ 70   if=if+1                                                           fac  20
+      ifact(if)=npart                                                   fac  21
+ 80   nfact=if                                                          fac  22
+      return                                                            fac  23
+      end                                                               fac  24-
+      subroutine fixrl (data,n,nrem,isign,iform)                        fix   1
+c     for iform = 0, convert the transform of a doubled-up real array,  fix   2
+c     considered complex, into its true transform.  supply only the     fix   3
+c     first half of the complex transform, as the second half has       fix   4
+c     conjugate symmetry.  for iform = -1, convert the first half       fix   5
+c     of the true transform into the transform of a doubled-up real     fix   6
+c     array.  n must be even.                                           fix   7
+c     using complex notation and subscripts starting at zero, the       fix   8
+c     transformation is--                                               fix   9
+c     dimension data(n,nrem)                                            fix  10
+c     zstp = exp(isign*2*pi*i/n)                                        fix  11
+c     do 10 i2=0,nrem-1                                                 fix  12
+c     data(0,i2) = conj(data(0,i2))*(1+i)                               fix  13
+c     do 10 i1=1,n/4                                                    fix  14
+c     z = (1+(2*iform+1)*i*zstp**i1)/2                                  fix  15
+c     i1cnj = n/2-i1                                                    fix  16
+c     dif = data(i1,i2)-conj(data(i1cnj,i2))                            fix  17
+c     temp = z*dif                                                      fix  18
+c     data(i1,i2) = (data(i1,i2)-temp)*(1-iform)                        fix  19
+c 10  data(i1cnj,i2) = (data(i1cnj,i2)+conj(temp))*(1-iform)            fix  20
+c     if i1=i1cnj, the calculation for that value collapses into        fix  21
+c     a simple conjugation of data(i1,i2).                              fix  22
+      dimension data(*)                                                 fix  23
+      twopi=6.283185307*float(isign)                                    fix  24
+      ip0=2                                                             fix  25
+      ip1=ip0*(n/2)                                                     fix  26
+      ip2=ip1*nrem                                                      fix  27
+      if (iform) 10,70,70                                               fix  28
+c     pack the real input values (two per column)                       fix  29
+ 10   j1=ip1+1                                                          fix  30
+      data(2)=data(j1)                                                  fix  31
+      if (nrem-1) 70,70,20                                              fix  32
+ 20   j1=j1+ip0                                                         fix  33
+      i2min=ip1+1                                                       fix  34
+      do 60 i2=i2min,ip2,ip1                                            fix  35
+      data(i2)=data(j1)                                                 fix  36
+      j1=j1+ip0                                                         fix  37
+      if (n-2) 50,50,30                                                 fix  38
+ 30   i1min=i2+ip0                                                      fix  39
+      i1max=i2+ip1-ip0                                                  fix  40
+      do 40 i1=i1min,i1max,ip0                                          fix  41
+      data(i1)=data(j1)                                                 fix  42
+      data(i1+1)=data(j1+1)                                             fix  43
+ 40   j1=j1+ip0                                                         fix  44
+ 50   data(i2+1)=data(j1)                                               fix  45
+ 60   j1=j1+ip0                                                         fix  46
+ 70   do 80 i2=1,ip2,ip1                                                fix  47
+      tempr=data(i2)                                                    fix  48
+      data(i2)=data(i2)+data(i2+1)                                      fix  49
+ 80   data(i2+1)=tempr-data(i2+1)                                       fix  50
+      if (n-2) 200,200,90                                               fix  51
+ 90   theta=twopi/float(n)                                              fix  52
+      sinth=sin(theta/2.)                                               fix  53
+      zstpr=-2.*sinth*sinth                                             fix  54
+      zstpi=sin(theta)                                                  fix  55
+      zr=(1.-zstpi)/2.                                                  fix  56
+      zi=(1.+zstpr)/2.                                                  fix  57
+      if (iform) 100,110,110                                            fix  58
+ 100  zr=1.-zr                                                          fix  59
+      zi=-zi                                                            fix  60
+ 110  i1min=ip0+1                                                       fix  61
+      i1max=ip0*(n/4)+1                                                 fix  62
+      do 190 i1=i1min,i1max,ip0                                         fix  63
+      do 180 i2=i1,ip2,ip1                                              fix  64
+      i2cnj=ip0*(n/2+1)-2*i1+i2                                         fix  65
+      if (i2-i2cnj) 150,120,120                                         fix  66
+ 120  if (isign*(2*iform+1)) 130,140,140                                fix  67
+ 130  data(i2+1)=-data(i2+1)                                            fix  68
+ 140  if (iform) 170,180,180                                            fix  69
+ 150  difr=data(i2)-data(i2cnj)                                         fix  70
+      difi=data(i2+1)+data(i2cnj+1)                                     fix  71
+      tempr=difr*zr-difi*zi                                             fix  72
+      tempi=difr*zi+difi*zr                                             fix  73
+      data(i2)=data(i2)-tempr                                           fix  74
+      data(i2+1)=data(i2+1)-tempi                                       fix  75
+      data(i2cnj)=data(i2cnj)+tempr                                     fix  76
+      data(i2cnj+1)=data(i2cnj+1)-tempi                                 fix  77
+      if (iform) 160,180,180                                            fix  78
+ 160  data(i2cnj)=data(i2cnj)+data(i2cnj)                               fix  79
+      data(i2cnj+1)=data(i2cnj+1)+data(i2cnj+1)                         fix  80
+ 170  data(i2)=data(i2)+data(i2)                                        fix  81
+      data(i2+1)=data(i2+1)+data(i2+1)                                  fix  82
+ 180  continue                                                          fix  83
+      tempr=zr-.5                                                       fix  84
+      zr=zstpr*tempr-zstpi*zi+zr                                        fix  85
+ 190  zi=zstpr*zi+zstpi*tempr+zi                                        fix  86
+c     recursion saves time, at a slight loss in accuracy.  if available,fix  87
+c     use double precision to compute zr and zi.                        fix  88
+ 200  if (iform) 270,210,210                                            fix  89
+c     unpack the real transform values (two per column)                 fix  90
+ 210  i2=ip2+1                                                          fix  91
+      i1=i2                                                             fix  92
+      j1=ip0*(n/2+1)*nrem+1                                             fix  93
+      go to 250                                                         fix  94
+ 220  data(j1)=data(i1)                                                 fix  95
+      data(j1+1)=data(i1+1)                                             fix  96
+      i1=i1-ip0                                                         fix  97
+      j1=j1-ip0                                                         fix  98
+ 230  if (i2-i1) 220,240,240                                            fix  99
+ 240  data(j1)=data(i1)                                                 fix 100
+      data(j1+1)=0.                                                     fix 101
+ 250  i2=i2-ip1                                                         fix 102
+      j1=j1-ip0                                                         fix 103
+      data(j1)=data(i2+1)                                               fix 104
+      data(j1+1)=0.                                                     fix 105
+      i1=i1-ip0                                                         fix 106
+      j1=j1-ip0                                                         fix 107
+      if (i2-1) 260,260,230                                             fix 108
+ 260  data(2)=0.                                                        fix 109
+ 270  return                                                            fix 110
+      end                                                               fix 111-
+      subroutine goert(data,nprev,iprod,ifact,irem,work,wminr,wmini,    goe   1
+     $ rootr,rooti)                                                     goe   2
+c     phase-shifted fourier transform of length ifact by the goertzel   goe   3
+c     algorithm (4).  ifact must be odd and at least 5.  further speed  goe   4
+c     is gained by computing two transform values at the same time.     goe   5
+c     dimension data(nprev,iprod,ifact,irem)                            goe   6
+c     data(i1,1,j3,i5) = sum(data(i1,1,i3,i5) * w**(i3-1)), summed      goe   7
+c     over i3 = 1 to ifact for all i1 from 1 to nprev, j3 from 1 to     goe   8
+c     ifact and i5 from 1 to irem.                                      goe   9
+c     w = wmin * exp(isign*2*pi*i*(j3-1)/ifact).                        goe  10
+      dimension data(*), work(*)                                        goe  11
+      ip0=2                                                             goe  12
+      ip1=ip0*nprev                                                     goe  13
+      ip2=ip1*iprod                                                     goe  14
+      ip3=ip2*ifact                                                     goe  15
+      ip5=ip3*irem                                                      goe  16
+      if (wmini) 10,40,10                                               goe  17
+c     apply the phase shift factors                                     goe  18
+ 10   wr=wminr                                                          goe  19
+      wi=wmini                                                          goe  20
+      i3min=1+ip2                                                       goe  21
+      do 30 i3=i3min,ip3,ip2                                            goe  22
+      i1max=i3+ip1-ip0                                                  goe  23
+      do 20 i1=i3,i1max,ip0                                             goe  24
+      do 20 i5=i1,ip5,ip3                                               goe  25
+      tempr=data(i5)                                                    goe  26
+      data(i5)=wr*tempr-wi*data(i5+1)                                   goe  27
+ 20   data(i5+1)=wr*data(i5+1)+wi*tempr                                 goe  28
+      tempr=wr                                                          goe  29
+      wr=wminr*tempr-wmini*wi                                           goe  30
+ 30   wi=wminr*wi+wmini*tempr                                           goe  31
+ 40   do 90 i1=1,ip1,ip0                                                goe  32
+      do 90 i5=i1,ip5,ip3                                               goe  33
+c     straight summation for the first term                             goe  34
+      sumr=0.                                                           goe  35
+      sumi=0.                                                           goe  36
+      i3max=i5+ip3-ip2                                                  goe  37
+      do 50 i3=i5,i3max,ip2                                             goe  38
+      sumr=sumr+data(i3)                                                goe  39
+ 50   sumi=sumi+data(i3+1)                                              goe  40
+      work(1)=sumr                                                      goe  41
+      work(2)=sumi                                                      goe  42
+      wr=rootr+1.                                                       goe  43
+      wi=rooti                                                          goe  44
+      iwmin=1+ip0                                                       goe  45
+      iwmax=ip0*((ifact+1)/2)-1                                         goe  46
+      do 80 iwork=iwmin,iwmax,ip0                                       goe  47
+      twowr=wr+wr                                                       goe  48
+      i3=i3max                                                          goe  49
+      oldsr=0.                                                          goe  50
+      oldsi=0.                                                          goe  51
+      sumr=data(i3)                                                     goe  52
+      sumi=data(i3+1)                                                   goe  53
+      i3=i3-ip2                                                         goe  54
+ 60   tempr=sumr                                                        goe  55
+      tempi=sumi                                                        goe  56
+      sumr=twowr*sumr-oldsr+data(i3)                                    goe  57
+      sumi=twowr*sumi-oldsi+data(i3+1)                                  goe  58
+      oldsr=tempr                                                       goe  59
+      oldsi=tempi                                                       goe  60
+      i3=i3-ip2                                                         goe  61
+      if (i3-i5) 70,70,60                                               goe  62
+c     in a fourier transform the w corresponding to the point at k      goe  63
+c     is the conjugate of that at ifact-k (that is, exp(twopi*i*        goe  64
+c     k/ifact) = conj(exp(twopi*i*(ifact-k)/ifact))).  since the        goe  65
+c     main loop of goertzels algorithm is indifferent to the imaginary  goe  66
+c     part of w, it need be supplied only at the end.                   goe  67
+ 70   tempr=-wi*sumi                                                    goe  68
+      tempi=wi*sumr                                                     goe  69
+      sumr=wr*sumr-oldsr+data(i3)                                       goe  70
+      sumi=wr*sumi-oldsi+data(i3+1)                                     goe  71
+      work(iwork)=sumr+tempr                                            goe  72
+      work(iwork+1)=sumi+tempi                                          goe  73
+      iwcnj=ip0*(ifact+1)-iwork                                         goe  74
+      work(iwcnj)=sumr-tempr                                            goe  75
+      work(iwcnj+1)=sumi-tempi                                          goe  76
+c     singleton's recursion, for accuracy and speed (5).                goe  77
+      tempr=wr                                                          goe  78
+      wr=wr*rootr-wi*rooti+wr                                           goe  79
+ 80   wi=tempr*rooti+wi*rootr+wi                                        goe  80
+      iwork=1                                                           goe  81
+      do 90 i3=i5,i3max,ip2                                             goe  82
+      data(i3)=work(iwork)                                              goe  83
+      data(i3+1)=work(iwork+1)                                          goe  84
+ 90   iwork=iwork+ip0                                                   goe  85
+      return                                                            goe  86
+      end                                                               goe  87-
+      subroutine smfac (ifact,nfact,isym,ifsym,nfsym,icent,ifcnt,nfcnt) smf   1
+c     rearrange the prime factors of n into a square and a non-         smf   2
+c     square.  n = isym*icent*isym, where icent is square-free.         smf   3
+c     isym = ifsym(1)*...*ifsym(nfsym), each a prime factor.            smf   4
+c     icent = ifcnt(1)*...*ifcnt(nfcnt), each a prime factor.           smf   5
+c     for example, n = 1960 = 14*10*14.  then isym = 14, icent = 10,    smf   6
+c     nfsym = 2, nfcnt = 2, nfact = 6, ifsym(ifs) = 2, 7, ifcnt(ifc) =  smf   7
+c     2, 5 and ifact(if) = 2, 7, 2, 5, 7, 2.                            smf   8
+      dimension ifsym(1), ifcnt(1), ifact(1)                            smf   9
+      isym=1                                                            smf  10
+      icent=1                                                           smf  11
+      ifs=0                                                             smf  12
+      ifc=0                                                             smf  13
+      if=1                                                              smf  14
+ 10   if (if-nfact) 20,40,50                                            smf  15
+ 20   if (ifact(if)-ifact(if+1)) 40,30,40                               smf  16
+ 30   ifs=ifs+1                                                         smf  17
+      ifsym(ifs)=ifact(if)                                              smf  18
+      isym=ifact(if)*isym                                               smf  19
+      if=if+2                                                           smf  20
+      go to 10                                                          smf  21
+ 40   ifc=ifc+1                                                         smf  22
+      ifcnt(ifc)=ifact(if)                                              smf  23
+      icent=ifact(if)*icent                                             smf  24
+      if=if+1                                                           smf  25
+      go to 10                                                          smf  26
+ 50   nfsym=ifs                                                         smf  27
+      nfcnt=ifc                                                         smf  28
+      nfsm2=2*nfsym                                                     smf  29
+      nfact=2*nfsym+nfcnt                                               smf  30
+      if (nfcnt) 80,80,60                                               smf  31
+ 60   nfsm2=nfsm2+1                                                     smf  32
+      ifsym(nfsym+1)=icent                                              smf  33
+      do 70 ifc=1,nfcnt                                                 smf  34
+      if=nfsym+ifc                                                      smf  35
+ 70   ifact(if)=ifcnt(ifc)                                              smf  36
+ 80   if (nfsym) 110,110,90                                             smf  37
+ 90   do 100 ifs=1,nfsym                                                smf  38
+      ifscj=nfsm2+1-ifs                                                 smf  39
+      ifsym(ifscj)=ifsym(ifs)                                           smf  40
+      ifact(ifs)=ifsym(ifs)                                             smf  41
+      ifcnj=nfact+1-ifs                                                 smf  42
+ 100  ifact(ifcnj)=ifsym(ifs)                                           smf  43
+ 110  nfsym=nfsm2                                                       smf  44
+      return                                                            smf  45
+      end                                                               smf  46-
+      subroutine symrv (data,nprev,n,nrem,ifact,nfact)                  sym   1
+c     shuffle the data array by reversing the digits of one index.      sym   2
+c     dimension data(nprev,n,nrem)                                      sym   3
+c     replace data(i1,i2,i3) by data(i1,i2rev,i3) for all i1 from 1 to  sym   4
+c     nprev, i2 from 1 to n and i3 from 1 to nrem.  i2rev-1 is the      sym   5
+c     integer whose digit representation in the multi-radix notation    sym   6
+c     of factors ifact(if) is the reverse of the representation of i2-1.sym   7
+c     for example, if all ifact(if) = 2, i2-1 = 11001, i2rev-1 = 10011. sym   8
+c     the factors must be symmetrically arranged, i.e., ifact(if) =     sym   9
+c     ifact(nfact+1-if).                                                sym  10
+      dimension data(*), ifact(1)                                       sym  11
+      if (nfact-1) 80,80,10                                             sym  12
+ 10   ip0=2                                                             sym  13
+      ip1=ip0*nprev                                                     sym  14
+      ip4=ip1*n                                                         sym  15
+      ip5=ip4*nrem                                                      sym  16
+      i4rev=1                                                           sym  17
+      do 70 i4=1,ip4,ip1                                                sym  18
+      if (i4-i4rev) 20,40,40                                            sym  19
+ 20   i1max=i4+ip1-ip0                                                  sym  20
+      do 30 i1=i4,i1max,ip0                                             sym  21
+      do 30 i5=i1,ip5,ip4                                               sym  22
+      i5rev=i4rev+i5-i4                                                 sym  23
+      tempr=data(i5)
+      tempi=data(i5+1)                                                  sym  25
+      data(i5)=data(i5rev)                                              sym  26
+      data(i5+1)=data(i5rev+1)                                          sym  27
+      data(i5rev)=tempr                                                 sym  28
+ 30   data(i5rev+1)=tempi                                               sym  29
+ 40   ip3=ip4                                                           sym  30
+      do 60 if=1,nfact                                                  sym  31
+      ip2=ip3/ifact(if)                                                 sym  32
+      i4rev=i4rev+ip2                                                   sym  33
+      if (i4rev-ip3) 70,70,50                                           sym  34
+ 50   i4rev=i4rev-ip3                                                   sym  35
+ 60   ip3=ip2                                                           sym  36
+ 70   continue                                                          sym  37
+ 80   return                                                            sym  38
+      end                                                               sym  39-
diff -r 405d8f4fa05f -r e7295294f654 src/elastic3d.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/elastic3d.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,3423 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+MODULE elastic3d
+
+  USE types
+  USE fourier
+
+  IMPLICIT NONE
+
+#include "include.f90"
+
+  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
+  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
+  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
+  REAL*8, PRIVATE, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
+    
+  INTERFACE OPERATOR (.times.)
+     MODULE PROCEDURE tensorscalarprod
+  END INTERFACE
+
+  INTERFACE OPERATOR (.minus.)
+     MODULE PROCEDURE tensordiff
+  END INTERFACE
+
+  INTERFACE OPERATOR (.plus.)
+     MODULE PROCEDURE tensorplus
+  END INTERFACE
+
+  INTERFACE OPERATOR (.sdyad.)
+     MODULE PROCEDURE tensorsymmetricdyadprod
+  END INTERFACE
+
+  INTERFACE OPERATOR (.tdot.)
+     MODULE PROCEDURE tensorvectordotprod
+  END INTERFACE
+
+CONTAINS
+
+  !------------------------------------------------------------
+  !> function SIGN
+  !! returns the sign of the input -1 for negtive, 0 for zero
+  !! and +1 for positive arguments.
+  !------------------------------------------------------------
+  REAL*8 FUNCTION sign(x)
+    REAL*8, INTENT(IN) :: x
+
+    IF (x .gt. 0._8) THEN
+       sign=1._8
+    ELSE
+       IF (x .lt. 0._8) THEN
+          sign=-1._8
+       ELSE
+          sign=0._8
+       END IF
+    END IF
+  END FUNCTION sign
+
+  !------------------------------------------------------------
+  !> function fix
+  !! returns the closest integer scalar
+  !
+  ! sylvain barbot (08/25/07) - original form
+  !------------------------------------------------------------
+  INTEGER FUNCTION fix(number)
+    REAL*8, INTENT(IN) :: number
+
+    INTEGER :: c,f
+    f=FLOOR(number)
+    c=CEILING(number)
+
+    IF ((number-f) .gt. 0.5_8) THEN
+       fix=c
+    ELSE
+       fix=f
+    END IF
+
+  END FUNCTION fix
+
+  !------------------------------------------------------------
+  !> function SINH
+  !! computes the hyperbolic sine
+  !------------------------------------------------------------
+  REAL*8 FUNCTION sinh(x)
+    REAL*8, INTENT(IN) :: x
+
+    IF (abs(x) .GT. 85._8) THEN
+       sinh=sign(x)*exp(85._8)/2._8
+    ELSE
+       sinh=(exp(x)-exp(-x))/2._8
+    END IF
+  END FUNCTION sinh
+
+  !------------------------------------------------------------
+  !> function ASINH
+  !! computes the inverse hyperbolic sine
+  !------------------------------------------------------------
+  REAL*8 FUNCTION asinh(x)
+    REAL*8, INTENT(IN) :: x
+    asinh=log(x+sqrt(x*x+1))
+  END FUNCTION asinh
+
+  !-----------------------------------------------------------------
+  !> subroutine Neighbor
+  !! computes the indices of neighbor samples (l points away)
+  !! bracketing the current samples location i1,i2,i3 and
+  !! assuming periodic boundary condition.
+  !!
+  !!           i1m < i1 < i1p
+  !!           i2m < i2 < i2p
+  !!           i3m < i3 < i3p
+  !-----------------------------------------------------------------
+  SUBROUTINE neighbor(i1,i2,i3,sx1,sx2,sx3,l,i1m,i1p,i2m,i2p,i3m,i3p)
+    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3,l
+    INTEGER, INTENT(OUT) :: i1m,i1p,i2m,i2p,i3m,i3p
+
+    i1m=mod(sx1+i1-1-l,sx1)+1
+    i1p=mod(i1-1+l,sx1)+1
+    i2m=mod(sx2+i2-1-l,sx2)+1
+    i2p=mod(i2-1+l,sx2)+1
+    i3m=mod(sx3+i3-1-l,sx3)+1
+    i3p=mod(i3-1+l,sx3)+1
+
+  END SUBROUTINE neighbor
+
+  !---------------------------------------------------------------
+  !> subroutine IsotropicStressStrain
+  !! computes in place the isotropic stress tensor from a given
+  !! strain tensor using Hooke's law stress-strain relationship.
+  !
+  ! sylvain barbot (10/14/07) - original form
+  !---------------------------------------------------------------
+  SUBROUTINE isotropicstressstrain(t,lambda,mu)
+    TYPE(TENSOR), INTENT(INOUT) :: t
+    REAL*8, INTENT(IN) :: lambda, mu
+
+    REAL*8 :: epskk
+
+    epskk=tensortrace(t)
+
+    t = REAL(2._8*mu) .times. t
+    t%s11=t%s11+lambda*epskk
+    t%s22=t%s22+lambda*epskk
+    t%s33=t%s33+lambda*epskk
+
+  END SUBROUTINE isotropicstressstrain
+
+  !------------------------------------------------------------
+  !> function TensorDiff
+  !! computes the difference between two tensors: t=t1-t2
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  TYPE(TENSOR) FUNCTION tensordiff(t1,t2)
+    TYPE(TENSOR), INTENT(IN) :: t1,t2
+
+    tensordiff=TENSOR(t1%s11-t2%s11, & ! 11
+                      t1%s12-t2%s12, & ! 12
+                      t1%s13-t2%s13, & ! 13
+                      t1%s22-t2%s22, & ! 22
+                      t1%s23-t2%s23, & ! 23
+                      t1%s33-t2%s33)   ! 33
+
+  END FUNCTION tensordiff
+
+  !------------------------------------------------------------
+  !> function TensorPlus
+  !! computes the sum of two tensors: t=t1-t2
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  TYPE(TENSOR) FUNCTION tensorplus(t1,t2)
+    TYPE(TENSOR), INTENT(IN) :: t1,t2
+
+    tensorplus=TENSOR(t1%s11+t2%s11, & ! 11
+                      t1%s12+t2%s12, & ! 12
+                      t1%s13+t2%s13, & ! 13
+                      t1%s22+t2%s22, & ! 22
+                      t1%s23+t2%s23, & ! 23
+                      t1%s33+t2%s33)   ! 33
+
+  END FUNCTION tensorplus
+
+  !------------------------------------------------------------
+  !> function TensorScalarProd
+  !! multiplies a tensor with a scalar
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  TYPE(TENSOR) FUNCTION tensorscalarprod(scalar,t)
+    TYPE(TENSOR), INTENT(IN) :: t
+    REAL*4, INTENT(IN) :: scalar
+
+    tensorscalarprod=TENSOR(scalar*t%s11, & ! 11
+                            scalar*t%s12, & ! 12
+                            scalar*t%s13, & ! 13
+                            scalar*t%s22, & ! 22
+                            scalar*t%s23, & ! 23
+                            scalar*t%s33)   ! 33
+
+  END FUNCTION tensorscalarprod
+
+  !------------------------------------------------------------
+  !> function TensorSymmetricDyadProd
+  !! computes the dyadic product of two vectors to obtain a
+  !! symmetric second order tensor
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  TYPE(TENSOR) FUNCTION tensorsymmetricdyadprod(a,b)
+    REAL*8, DIMENSION(3), INTENT(IN) :: a,b
+
+    tensorsymmetricdyadprod=TENSOR( &
+          a(1)*b(1),                 & ! 11
+         (a(1)*b(2)+a(2)*b(1))/2._8, & ! 12
+         (a(1)*b(3)+a(3)*b(1))/2._8, & ! 13
+          a(2)*b(2),                 & ! 22
+         (a(2)*b(3)+a(3)*b(2))/2._8, & ! 23
+          a(3)*b(3)                  & ! 33
+          )
+
+  END FUNCTION tensorsymmetricdyadprod
+
+  !------------------------------------------------------------
+  !> function TensorVectorDotProd
+  !! compute the dot product T.v where T is a second-order
+  !! tensor and v is a vector.
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  FUNCTION tensorvectordotprod(t,v)
+    TYPE(TENSOR), INTENT(IN) :: t
+    REAL*8, DIMENSION(3), INTENT(IN) :: v
+    REAL*8, DIMENSION(3) :: tensorvectordotprod
+
+    tensorvectordotprod= &
+         (/ t%s11*v(1)+t%s12*v(2)+t%s13*v(3), &
+            t%s12*v(1)+t%s22*v(2)+t%s23*v(3), &
+            t%s13*v(1)+t%s23*v(2)+t%s33*v(3) /)
+
+  END FUNCTION tensorvectordotprod
+
+  !------------------------------------------------------------
+  !> function TensorVectorDotProd
+  !! compute the dot product T.v where T is a second-order
+  !! tensor and v is a vector.
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  FUNCTION tensordeviatoric(t)
+    TYPE(TENSOR), INTENT(IN) :: t
+    TYPE(TENSOR) :: tensordeviatoric
+
+    REAL*4 :: diag
+
+    diag=REAL(tensortrace(t)/3._8)
+    
+    tensordeviatoric%s11=t%s11-diag
+    tensordeviatoric%s12=t%s12
+    tensordeviatoric%s13=t%s13
+    tensordeviatoric%s22=t%s22-diag
+    tensordeviatoric%s23=t%s23
+    tensordeviatoric%s33=t%s33-diag
+
+  END FUNCTION tensordeviatoric
+
+  !------------------------------------------------------------
+  !> function TensorTrace
+  !! computes the trace of a second order tensor
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensortrace(t)
+    TYPE(TENSOR), INTENT(IN) :: t
+
+    tensortrace=t%s11+t%s22+t%s33
+
+  END FUNCTION tensortrace
+
+  !------------------------------------------------------------
+  !> function TensorNorm
+  !! computes the Frobenius norm of a second order tensor
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensornorm(t)
+    TYPE(TENSOR), INTENT(IN) :: t
+
+    tensornorm=SQRT(( &
+         t%s11**2+2._8*t%s12**2+2._8*t%s13**2+ &
+         t%s22**2+2._8*t%s23**2+ &
+         t%s33**2)/2._8)
+
+  END FUNCTION tensornorm
+
+  !------------------------------------------------------------
+  !> function TensorDecomposition
+  !! writes a tensor t as the product of a norm and a direction
+  !!
+  !!         t = gamma * R
+  !!
+  !! where gamma is a scalar, the norm of t, and R is a unitary
+  !! tensor. t is assumed to be a deviatoric tensor.
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  SUBROUTINE tensordecomposition(t,gamma,R)
+    TYPE(TENSOR), INTENT(IN) :: t
+    TYPE(TENSOR), INTENT(OUT) :: R
+    REAL*8, INTENT(OUT) :: gamma
+    
+    gamma=tensornorm(t)
+
+    R%s11=t%s11/gamma
+    R%s12=t%s12/gamma
+    R%s13=t%s13/gamma
+    R%s22=t%s22/gamma
+    R%s23=t%s23/gamma
+    R%s33=t%s33/gamma
+
+  END SUBROUTINE tensordecomposition
+
+
+  !------------------------------------------------------------
+  !> function TensorForbeniusNorm
+  !! computes the Frobenius norm of a second order tensor
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensorfrobeniusnorm(t)
+    TYPE(TENSOR), INTENT(IN) :: t
+
+    tensorfrobeniusnorm=SQRT( &
+         t%s11**2+2._8*t%s12**2+2._8*t%s13**2+ &
+         t%s22**2+2._8*t%s23**2+ &
+         t%s33**2)
+
+  END FUNCTION tensorfrobeniusnorm
+
+  !------------------------------------------------------------
+  !> function VectorFieldNormMax
+  !! computes the maximum value of the norm of a vector field
+  !------------------------------------------------------------
+  SUBROUTINE vectorfieldnormmax(v1,v2,v3,sx1,sx2,sx3,maximum,location)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: v1,v2,v3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v1,v2,v3
+#endif
+    REAL*8, INTENT(OUT) :: maximum
+    INTEGER, INTENT(OUT), DIMENSION(3) :: location
+    
+    INTEGER :: i1,i2,i3
+    REAL*8 :: norm
+
+    maximum=-1._8
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1
+             norm=SQRT(v1(i1,i2,i3)**2+v2(i1,i2,i3)**2+v3(i1,i2,i3)**2)
+             IF (norm .GT. maximum) THEN
+                maximum=norm
+                location=(/ i1,i2,i3 /)
+             END IF
+          END DO
+       END DO
+    END DO
+    
+  END SUBROUTINE vectorfieldnormmax
+
+  !------------------------------------------------------------
+  !> function TensorMean
+  !! computesthe mean of the norm of a tensor field
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensormean(t)
+    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
+    
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    sx1=SIZE(t,1)
+    sx2=SIZE(t,2)
+    sx3=SIZE(t,3)
+
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1
+             tensormean=tensormean+tensornorm(t(i1,i2,i3))
+          END DO
+       END DO
+    END DO
+    tensormean=tensormean/DBLE(sx1*sx2*sx3)
+    
+  END FUNCTION tensormean
+
+  !------------------------------------------------------------
+  !> function TensorAmplitude
+  !! computes the integral of the norm of a tensor field
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensoramplitude(t,dx1,dx2,dx3)
+    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    sx1=SIZE(t,1)
+    sx2=SIZE(t,2)
+    sx3=SIZE(t,3)
+
+    tensoramplitude=0._8
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1
+             tensoramplitude=tensoramplitude &
+                  +tensornorm(t(i1,i2,i3))
+          END DO
+       END DO
+    END DO
+    tensoramplitude=tensoramplitude*DBLE(dx1*dx2*dx3)
+
+  END FUNCTION tensoramplitude
+
+  !------------------------------------------------------------
+  !> function TensorMeanTrace
+  !! computesthe mean of the norm of a tensor field
+  !------------------------------------------------------------
+  REAL*8 FUNCTION tensormeantrace(t)
+    TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: t
+    
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    sx1=SIZE(t,1)
+    sx2=SIZE(t,2)
+    sx3=SIZE(t,3)
+
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1
+             tensormeantrace= &
+                  tensormeantrace+tensortrace(t(i1,i2,i3))
+          END DO
+       END DO
+    END DO
+    tensormeantrace=tensormeantrace/DBLE(sx1*sx2*sx3)
+    
+  END FUNCTION tensormeantrace
+
+  !------------------------------------------------------------
+  !> sinc function
+  !! computes sin(pi*x)/(pi*x)
+  !
+  ! sylvain barbot (04-14-07) - original form
+  !------------------------------------------------------------
+  FUNCTION sinc(x)
+    REAL*8 :: sinc
+    REAL*8, INTENT(IN) :: x
+    IF (x /= 0) THEN
+       sinc=sin(pi*x)/(pi*x)
+    ELSE
+       sinc=1._8
+    END IF
+  END FUNCTION sinc
+  
+  !-------------------------------------------------------------------------
+  !> function gauss computes the normalized gaussian function
+  !
+  ! Sylvain Barbot (06-29-07)
+  !-------------------------------------------------------------------------
+  FUNCTION gauss(x,sigma)
+    REAL*8 :: gauss
+    REAL*8, INTENT(IN) :: x,sigma
+    
+    gauss=exp(-0.5_8*(x/sigma)**2)/sqrt(pi2)/sigma
+  END FUNCTION gauss
+  
+  !-------------------------------------------------------------------------
+  !> function gaussp computes the normalized gaussian derivative
+  !
+  ! Sylvain Barbot (06-29-07)
+  !-------------------------------------------------------------------------
+  FUNCTION gaussp(x,sigma)
+    REAL*8 :: gaussp
+    REAL*8, INTENT(IN) :: x,sigma
+    
+    gaussp=-x*exp(-0.5_8*(x/sigma)**2)/sqrt(pi2)/sigma**3
+  END FUNCTION gaussp
+
+  !-------------------------------------------------------------------------
+  !> function omega computes raised-cosine taper in the space domain
+  !
+  ! Sylvain Barbot (06-29-07)
+  !-------------------------------------------------------------------------
+  FUNCTION omega(x,beta)
+    REAL*8 :: omega
+    REAL*8, INTENT(IN) :: x,beta
+    
+    IF (abs(x) .le. (1._8-2._8*beta)/(1._8-beta)/2._8) THEN
+       omega=1._8
+    ELSE
+       IF (abs(x) .lt. 1._8/(1-beta)/2._8) THEN
+          omega=cos(pi*((1._8-beta)*abs(x)-0.5_8+beta)/2._8/beta)**2
+       ELSE
+          omega=0._8
+       END IF
+    END IF
+  END FUNCTION omega
+
+  !-------------------------------------------------------------------------
+  !> function omegap computes raised-cosine taper derivative 
+  !! in the space domain
+  !
+  ! Sylvain Barbot (06-29-07)
+  !-------------------------------------------------------------------------
+  FUNCTION omegap(x,beta)
+    REAL*8 :: omegap
+    REAL*8, INTENT(IN) :: x,beta
+    
+    omegap=0
+    IF (abs(x) .gt. (1._8-2._8*beta)/(1._8-beta)/2._8) THEN
+       IF (abs(x) .lt. 1._8/(1-beta)/2._8) THEN
+          omegap=-DSIGN(1._8,x)*pi*(1._8-beta)/2._8/beta* &
+               sin(pi*((1._8-beta)*abs(x)-0.5_8+beta)/beta)
+       END IF
+    END IF
+  END FUNCTION omegap
+  
+  !-------------------------------------------------------------------------
+  !> tapered step function (raised-cosine) of unit area in the Fourier domain
+  !!
+  !! INPUT
+  !! @param k        wavenumber
+  !! @param beta     roll-off parameter 0<beta<0.5
+  !!                 no smoothing for beta close to 0
+  !!                 string smoothing for beta close to 0.5
+  !
+  ! sylvain barbot (04-14-07) - original form
+  !-------------------------------------------------------------------------
+  FUNCTION omegak(k,beta)
+    REAL*8 :: omegak
+    REAL*8, INTENT(IN) :: k, beta
+    REAL*8 :: gamma,denom,om1,om2
+    
+    gamma=(1._8-beta)
+    denom=(gamma-(4._8*beta**2._8/gamma)*k**2._8)*2._8
+    om1=sinc(k/gamma)
+    om2=(1._8-2._8*beta)*sinc(((1._8-2._8*beta)/gamma)*k)
+    omegak=(om1+om2)/denom
+
+  END FUNCTION omegak
+
+  !----------------------------------------------------------------
+  !> subroutine TensorStructure
+  !! constructs a vertically-stratified tensor field.
+  !! The structure is defined by its interfaces: changes can be
+  !! gradual or discontinuous.
+  !
+  ! sylvain barbot (10/25/08) - original form
+  !----------------------------------------------------------------
+  SUBROUTINE tensorstructure(vstruct,layers,dx3)
+    TYPE(TENSOR_LAYER_STRUCT), INTENT(IN), DIMENSION(:) :: layers
+    TYPE(TENSOR_LAYER_STRUCT), INTENT(OUT), DIMENSION(:) :: vstruct
+    REAL*8, INTENT(IN) :: dx3
+
+    INTEGER :: nv,k,i3s,i3e=1,i3,sx3
+    REAL*8 :: z,z0,z1
+    TYPE(TENSOR) :: t0,t1,t
+         
+    nv =SIZE(layers,1)
+    sx3=SIZE(vstruct,1)
+
+    IF (0 .ge. nv) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("invalid tensor structure. exiting.")')
+       STOP 1
+    END IF
+
+    ! initialization
+    vstruct(:)%z=0      ! depth is not used
+    vstruct(:)%t=tensor(0._4,0._4,0._4,0._4,0._4,0._4) ! default
+
+    z0=fix(layers(1)%z/dx3)*dx3
+    DO k=1,nv
+       ! project model on multiples of sampling size 'dx3'
+       ! to avoid aliasing problems
+       z1=fix(layers(k)%z/dx3)*dx3
+
+       IF (z1 .lt. z0) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,'("invalid mechanical structure.")')
+          WRITE (0,'("depths must be increasing. exiting.")')
+          STOP 1
+       END IF
+
+       IF (z1 .eq. z0) THEN
+          ! discontinuous interface in the elastic structure
+          z0=z1
+          
+          t1=layers(k)%t
+          
+          i3e=fix(z1/dx3+1)
+       ELSE
+          ! interpolate linearly between current and previous value
+
+          t1=layers(k)%t
+
+          i3s=fix(z0/dx3)+1
+          i3e=MIN(fix(z1/dx3+1),sx3)
+          DO i3=i3s,i3e
+             z=(i3-1._8)*dx3
+
+             t=REAL(1._8/(z1-z0)) .times. &
+                  ((REAL(z-z0) .times. t1) .plus. (REAL(z1-z) .times. t0))
+             
+             vstruct(i3)%t=t
+ 
+         END DO
+       END IF
+
+       z0=z1
+       t0=t1
+
+    END DO
+
+    ! downward-continue the last layer
+    IF (fix(z1/dx3) .lt. sx3-1) THEN
+       vstruct(i3e:sx3)%t=t1
+    END IF
+
+  END SUBROUTINE tensorstructure
+
+
+  !----------------------------------------------------------------
+  !> subroutine ViscoElasticStructure
+  !! constructs a vertically-stratified viscoelastic structure.
+  !! The structure is defined by its interfaces: changes can be
+  !! gradual or discontinuous.
+  !!
+  !! EXAMPLE INPUTS:
+  !!
+  !! 1- elastic plate over linear viscous half-space
+  !!    1
+  !!    1 1.0 1.0 1.0
+  !!
+  !! 2- elastic plate over powerlaw viscous half-space (n=3)
+  !!    1
+  !!    1 1.0 1.0 3.0
+  !!
+  !! 3- elastic plate over viscous half-space with depth-dependent
+  !!    viscosity
+  !!    2
+  !!    1 01.0 1.0 1.0
+  !!    2 10.0 6.0 1.0
+  !!
+  !!    in this last example, the grid does not have to reach down
+  !!    to x3=10.
+  !!
+  !! \author sylvain barbot (08/07/07) - original form
+  !----------------------------------------------------------------
+  SUBROUTINE viscoelasticstructure(vstruct,layers,dx3)
+    TYPE(LAYER_STRUCT), INTENT(IN), DIMENSION(:) :: layers
+    TYPE(LAYER_STRUCT), INTENT(OUT), DIMENSION(:) :: vstruct
+    REAL*8, INTENT(IN) :: dx3
+
+    INTEGER :: nv,k,i3s,i3e=1,i3,sx3
+    REAL*8 :: z,z0,z1, &
+         power,power0,power1, &
+         gamma,gamma0,gamma1, &
+         friction,friction0,friction1, &
+         cohesion,cohesion0,cohesion1
+         
+
+    nv =SIZE(layers,1)
+    sx3=SIZE(vstruct,1)
+
+    IF (0 .ge. nv) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("invalid elastic structure. exiting.")')
+       STOP 1
+    END IF
+
+    ! initialization
+    vstruct(:)%z=0      ! depth is not used
+    vstruct(:)%gammadot0=0 ! default is inviscid
+    vstruct(:)%friction=0.6  ! default is friction=0.6
+    vstruct(:)%cohesion=0  ! default is no cohesion
+    vstruct(:)%stressexponent=layers(1)%stressexponent  ! default
+
+    z0=fix(layers(1)%z/dx3)*dx3
+    DO k=1,nv
+       ! project model on multiples of sampling size 'dx3'
+       ! to avoid aliasing problems
+       z1=fix(layers(k)%z/dx3)*dx3
+
+       IF (z1 .lt. z0) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,'("invalid mechanical structure. exiting.")')
+          STOP 1
+       END IF
+
+       IF (z1 .eq. z0) THEN
+          ! discontinuous interface in the elastic structure
+          z0=z1
+          gamma1=layers(k)%gammadot0
+          power1 =layers(k)%stressexponent
+          friction1=layers(k)%friction
+          cohesion1=layers(k)%cohesion
+          
+          i3e=fix(z1/dx3+1)
+       ELSE
+          ! interpolate between current and previous value
+          gamma1=layers(k)%gammadot0
+          power1 =layers(k)%stressexponent
+          friction1=layers(k)%friction
+          cohesion1=layers(k)%cohesion
+
+          i3s=fix(z0/dx3)+1
+          i3e=MIN(fix(z1/dx3+1),sx3)
+          DO i3=i3s,i3e
+             z=(i3-1._8)*dx3
+             gamma=((z-z0)*gamma1+(z1-z)*gamma0)/(z1-z0)
+             power=((z-z0)*power1+(z1-z)*power0)/(z1-z0)
+             friction=((z-z0)*friction1+(z1-z)*friction0)/(z1-z0)
+             cohesion=((z-z0)*cohesion1+(z1-z)*cohesion0)/(z1-z0)
+
+             vstruct(i3)%gammadot0=gamma
+             vstruct(i3)%stressexponent =power
+             vstruct(i3)%friction=friction
+             vstruct(i3)%cohesion=cohesion
+          END DO
+       END IF
+
+       z0=z1
+       gamma0=gamma1
+       power0=power1
+       friction0=friction1
+       cohesion0=cohesion1
+
+    END DO
+
+    ! downward-continue the last layer
+    IF (fix(z1/dx3) .lt. sx3-1) THEN
+       vstruct(i3e:sx3)%gammadot0=REAL(gamma1)
+       vstruct(i3e:sx3)%stressexponent =REAL(power1)
+       vstruct(i3e:sx3)%friction=REAL(friction1)
+       vstruct(i3e:sx3)%cohesion=REAL(cohesion1)
+    END IF
+
+  END SUBROUTINE viscoelasticstructure
+
+
+  !------------------------------------------------------------------
+  !> function OptimalFilter
+  !! load predefined Finite Impulse Response (FIR) filters of various
+  !! lengths and select the most appropriate ones based on the
+  !! computational grid size. result is filter kernels always smaller
+  !! than available computational length.
+  !! this is useful in the special cases of infinite faults where
+  !! deformation is essentially two-dimensional, despite the actual
+  !! three-dimensional computation. in the direction of symmetry,
+  !! no strain occurs and high accuracy derivative estimates are not
+  !! needed.
+  !
+  ! Sylvain Barbot (03/05/08) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
+    REAL*8, DIMENSION(16), INTENT(OUT) :: ker1,ker2,ker3
+    INTEGER, INTENT(OUT) :: len1,len2,len3
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+
+    ! load FIR differentiator filter
+    ! variables 'fir1', 'fir7', 'fir14'
+    INCLUDE 'kernel1.inc'
+    INCLUDE 'kernel7.inc'
+    INCLUDE 'kernel14bis.inc'
+
+    ! choose best differentiator kernels
+    SELECT CASE(sx1)
+    CASE (2:4)
+       ! use centered finite difference
+       len1=1
+       ker1(1)=fir1(1)
+    CASE (5:14)
+       len1=7
+       ker1(1:len1)=fir7(1:len1)
+    CASE (15:)
+       len1=1
+       ker1(1:len1)=fir1(1:len1)
+    CASE DEFAULT
+       WRITE_DEBUG_INFO
+       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
+       STOP 2
+    END SELECT
+
+    ! choose best differentiator kernels
+    SELECT CASE(sx2)
+    CASE (2:4)
+       ! use centered finite difference
+       len2=1
+       ker2(1)=fir1(1)
+    CASE (5:14)
+       len2=7
+       ker2(1:len2)=fir7(1:len2)
+    CASE (15:)
+       len2=1
+       ker2(1:len2)=fir1(1:len2)
+    CASE DEFAULT
+       WRITE_DEBUG_INFO
+       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
+       STOP 2
+    END SELECT
+
+    ! choose best differentiator kernels
+    SELECT CASE(sx3)
+    CASE (5:14)
+       len3=7
+       ker3(1:len3)=fir7(1:len3)
+    CASE (15:)
+       len3=1
+       ker3(1:len3)=fir1(1:len3)
+    CASE DEFAULT
+       WRITE_DEBUG_INFO
+       WRITE (0,'("optimalfilter: invalid dimension. exiting.")')
+       STOP 2
+    END SELECT
+
+  END SUBROUTINE optimalfilter
+
+  !-----------------------------------------------------------------
+  !> subroutine StressUpdate
+  !! computes the 3-d stress tensor sigma_ij' from the current
+  !! deformation field. Strain is the second order tensor
+  !!
+  !!  \f[ \epsilon_{ij} = \frac{1}{2} ( u_{i,j} + u_{j,i} ) \f]
+  !!
+  !! The displacement derivatives are approximated numerically by the
+  !! application of a differentiator space-domain finite impulse
+  !! response filter. Coefficients of the filter can be obtained with
+  !! the MATLAB command line
+  !!
+  !!\verbatim
+  !! firpm(14, ...
+  !!    [0 7.0e-1 8.000000e-1 8.500000e-1 9.000000e-1 1.0e+0],...
+  !!    [0 7.0e-1 5.459372e-1 3.825260e-1 2.433534e-1 0.0e+0]*pi,...
+  !!    'differentiator');
+  !!\endverbatim
+  !!
+  !! The kernel is odd and antisymmetric and only half the numbers
+  !! are stored in this code. Kernels of different sizes are readilly
+  !! available in the 'kernelX.inc' files. Stress tensor field is
+  !! obtained by application of Hooke's law
+  !!
+  !!  \f[ \sigma' = - C' : E \f]
+  !!
+  !! or in indicial notation
+  !!
+  !!
+  !!  \f[ \sigma_{ij}' = -\lambda'*\delta_{ij}*\epsilon_{kk} - 2*\mu'*\epsilon_{ij}\f]
+  !!
+  !! where C' is the heterogeneous elastic moduli tensor and lambda'
+  !! and mu' are the inhomogeneous lame parameters
+  !!
+  !!  \f[ C' = C(x) - C_0 \f]
+  !!
+  !! For isotropic materials
+  !!
+  !!  \f[ \mu'(x) = \mu(x) - \mu_0 \f]
+  !!  \f[ \lambda'(x) = \lambda(x) - \lambda_0 \f]
+  !!
+  !! Optionally, the surface traction sigma_i3 can be sampled.
+  !!
+  !! \author sylvain barbot (10/10/07) - original form
+  !!                                   - optional sample of normal stress
+  !!                        (02/12/09) - OpemMP parallel implementation
+  !-----------------------------------------------------------------
+  SUBROUTINE stressupdate(v1,v2,v3,lambda,mu,dx1,dx2,dx3,sx1,sx2,sx3,sig)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,lambda,mu
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: v1,v2,v3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v1,v2,v3
+#endif
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
+
+    TYPE(TENSOR) :: t
+    INTEGER :: i1,i2,i3,i3p,i3m,len1,len2,len3
+    REAL*8 :: px3
+    REAL*8, DIMENSION(16) :: ker1,ker2,ker3
+
+    ! load FIR differentiator filter
+    CALL optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
+    ker1=ker1/dx1; ker2=ker2/dx2; ker3=ker3/dx3;
+
+    ! no periodicity in the 3rd direction
+    ! use a simple finite difference scheme
+    DO i3=1,sx3
+
+       IF ((i3 .gt. len3) .and. (i3 .lt. (sx3-len3+1))) &
+            CYCLE
+
+       IF (i3 .eq. 1) THEN
+          ! right-centered finite difference
+          px3=dx3; i3p=2; i3m=1
+       ELSE
+          IF (i3 .eq. sx3) THEN
+             ! left-centered finite difference
+             px3=dx3; i3p=sx3; i3m=sx3-1
+          ELSE
+             ! centered finite difference
+             px3=dx3*2._8; i3m=i3-1; i3p=i3+1
+          END IF
+       END IF
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL localstrain_ani(t,i3m,i3p,px3)
+             CALL isotropicstressstrain(t,lambda,mu)
+             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. t
+          END DO
+       END DO
+    END DO
+
+    ! intermediate depth treated isotropically
+!$omp parallel do private(i1,i2,t)
+    DO i3=len3+1,sx3-len3
+       DO i2=1,sx2
+          DO i1=1,sx1
+             ! Finite Impulse Response filter
+             !CALL localstrain_fir(t)
+             CALL localstrain_fir2(t,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,v1,v2,v3,sx1,sx2,sx3)
+             CALL isotropicstressstrain(t,lambda,mu)
+             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. t
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+  CONTAINS
+
+    !---------------------------------------------------------------
+    !> LocalStrain_FIR2
+    !! implements a finite impulse response filter (FIR) to estimate
+    !! derivatives and strain components. the compatibility with the
+    !! OpenMP parallel execution requires that all variable be 
+    !! tractable from the calling routine.
+    !!
+    !! \author sylvain barbot (10/10/07) - original form
+    !                (03/05/08) - implements 3 filters
+    !                (02/12/09) - compatibility with OpenMP (scope)
+    !---------------------------------------------------------------
+    SUBROUTINE localstrain_fir2(e,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,v1,v2,v3,sx1,sx2,sx3)
+      TYPE(TENSOR), INTENT(OUT) :: e
+      INTEGER, INTENT(IN) :: len1,len2,len3,i1,i2,i3,sx1,sx2,sx3
+      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
+      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
+      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
+      REAL*4, INTENT(IN), DIMENSION(:,:,:) :: v1,v2,v3
+
+      INTEGER :: l,i1m,i2m,i3m,i1p,i2p,i3p
+
+      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
+
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+
+         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
+         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
+         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
+      END DO
+
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+
+         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
+         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
+         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
+      END DO
+
+      DO l=1,len3
+         ! neighbor samples in semi-infinite solid
+         i3m=i3-l
+         i3p=i3+l
+         
+         e%s13=e%s13+(v1(i1,i2,i3p)-v1(i1,i2,i3m))*ker3(l)
+         e%s23=e%s23+(v2(i1,i2,i3p)-v2(i1,i2,i3m))*ker3(l)
+         e%s33=e%s33+(v3(i1,i2,i3p)-v3(i1,i2,i3m))*ker3(l)
+      END DO
+      
+      e%s12=e%s12/2._8
+      e%s13=e%s13/2._8
+      e%s23=e%s23/2._8
+      
+    END SUBROUTINE localstrain_fir2
+
+    !---------------------------------------------------------------
+    !> LocalStrain_FIR
+    !! implements a finite impulse response filter (FIR) to estimate
+    !! derivatives and strain components.
+    !!
+    !! \author sylvain barbot (10/10/07) - original form
+    !!                        (03/05/08) - implements 3 filters
+    !---------------------------------------------------------------
+    SUBROUTINE localstrain_fir(e)
+      TYPE(TENSOR), INTENT(OUT) :: e
+
+      INTEGER :: l,i1m,i2m,i3m,i1p,i2p,i3p
+
+      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
+
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+
+         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
+         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
+         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
+      END DO
+
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+
+         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
+         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
+         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
+      END DO
+
+      DO l=1,len3
+         ! neighbor samples in semi-infinite solid
+         i3m=i3-l
+         i3p=i3+l
+
+         e%s13=e%s13+(v1(i1,i2,i3p)-v1(i1,i2,i3m))*ker3(l)
+         e%s23=e%s23+(v2(i1,i2,i3p)-v2(i1,i2,i3m))*ker3(l)
+         e%s33=e%s33+(v3(i1,i2,i3p)-v3(i1,i2,i3m))*ker3(l)
+      END DO
+
+      e%s12=e%s12/2._8
+      e%s13=e%s13/2._8
+      e%s23=e%s23/2._8
+
+    END SUBROUTINE localstrain_fir
+
+    !---------------------------------------------------------------
+    !> LocalStrain_ANI
+    !! implements a different finite impulse response filter (FIR)
+    !! in each direction (ANIsotropy) to estimate derivatives and
+    !! strain components.
+    !
+    ! sylvain barbot (10/10/07) - original form
+    !                (03/05/09) - implements 3 filters
+    !---------------------------------------------------------------
+    SUBROUTINE localstrain_ani(e,i3m,i3p,px3)
+      TYPE(TENSOR), INTENT(OUT) :: e
+      INTEGER, INTENT(IN) :: i3m, i3p
+      REAL*8, INTENT(IN) :: px3
+
+      INTEGER :: l,i1m,i2m,i1p,i2p,foo,dum
+
+      e=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
+
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+
+         e%s11=e%s11+(v1(i1p,i2,i3)-v1(i1m,i2,i3))*ker1(l)
+         e%s12=e%s12+(v2(i1p,i2,i3)-v2(i1m,i2,i3))*ker1(l)
+         e%s13=e%s13+(v3(i1p,i2,i3)-v3(i1m,i2,i3))*ker1(l)
+      END DO
+
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+
+         e%s12=e%s12+(v1(i1,i2p,i3)-v1(i1,i2m,i3))*ker2(l)
+         e%s22=e%s22+(v2(i1,i2p,i3)-v2(i1,i2m,i3))*ker2(l)
+         e%s23=e%s23+(v3(i1,i2p,i3)-v3(i1,i2m,i3))*ker2(l)
+      END DO
+
+      ! finite difference in the 3rd direction
+      e%s13=e%s13 + (v1(i1,i2,i3p)-v1(i1,i2,i3m))/px3
+      e%s23=e%s23 + (v2(i1,i2,i3p)-v2(i1,i2,i3m))/px3
+      e%s33=(v3(i1,i2,i3p)-v3(i1,i2,i3m))/px3
+
+      e%s12=e%s12/2._8
+      e%s13=e%s13/2._8
+      e%s23=e%s23/2._8
+
+    END SUBROUTINE localstrain_ani
+
+  END SUBROUTINE stressupdate
+
+  !-----------------------------------------------------------------
+  !> subroutine EquivalentBodyForce
+  !! computes and updates the equivalent body-force
+  !!
+  !!         f = - div.( C : E^i )
+  !!
+  !! and the equivalent surface traction
+  !!
+  !!         t = n . C : E^i
+  !!
+  !! with n = (0,0,-1). In indicial notations
+  !!
+  !!         f_i = - (C_ijkl E^i_kl),j
+  !!
+  !! and
+  !!
+  !!         t_1 = n_j C_ijkl E^i_kl
+  !!
+  !! where f is the equivalent body-force, t is the equivalent surface
+  !! traction, C is the elastic moduli tensor and E^i is the moment
+  !! density tensor tensor.
+  !!
+  !! Divergence is computed with a mixed numerical scheme including
+  !! centered finite-difference (in the vertical direction) and
+  !! finite impulse response differentiator filter for derivatives
+  !! estimates. see function 'stress' for further explanations.
+  !!
+  !! \author sylvain barbot (07/09/07) - original form
+  !!                        (10/09/07) - upgrade the finite difference scheme
+  !!                                     to a finite impulse response filter
+  !!                        (02/12/09) - OpenMP parallel implementation
+  !-----------------------------------------------------------------
+  SUBROUTINE equivalentbodyforce(sig,dx1,dx2,dx3,sx1,sx2,sx3, &
+                                 c1,c2,c3,t1,t2,t3,mask)
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(INOUT), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+    REAL*4, INTENT(INOUT), DIMENSION(sx1+2,sx2) :: t1,t2,t3
+#else
+    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2) :: t1,t2,t3
+#endif
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    REAL*4, INTENT(IN), DIMENSION(sx3), OPTIONAL :: mask
+
+    INTEGER :: i1,i2,i3,i3m,i3p,len1,len2,len3
+    REAL*8 :: f1,f2,f3,px3
+    REAL*8, DIMENSION(16) :: ker1,ker2,ker3
+
+    CALL optimalfilter(ker1,ker2,ker3,len1,len2,len3,sx1,sx2,sx3)
+    ker1=ker1/dx1; ker2=ker2/dx2; ker3=ker3/dx3
+
+    ! equivalent surface traction
+    DO i2=1,sx2
+       DO i1=1,sx1
+          t1(i1,i2)=t1(i1,i2)+sig(i1,i2,1)%s13
+          t2(i1,i2)=t2(i1,i2)+sig(i1,i2,1)%s23
+          t3(i1,i2)=t3(i1,i2)+sig(i1,i2,1)%s33
+       END DO
+    END DO
+
+    ! no periodicity in the 3rd direction
+    ! use a simple finite difference scheme in the 3rd direction
+!$omp parallel 
+!$omp do private(i1,i2,f1,f2,f3,px3,i3m,i3p)
+    DO i3=1,sx3
+
+       IF ((i3 .gt. len3) .and. (i3 .lt. (sx3-len3+1))) &
+            CYCLE
+
+       IF (PRESENT(mask)) THEN
+          IF (mask(i3) .EQ. 0) THEN
+             CYCLE
+          END IF
+       END IF
+
+       IF (i3 .eq. 1) THEN
+          ! right-centered finite difference
+          px3=dx3; i3p=2; i3m=1
+       ELSE
+          IF (i3 .eq. sx3) THEN
+             ! left-centered finite difference
+             px3=dx3; i3p=sx3; i3m=sx3-1
+          ELSE
+             ! centered finite difference
+             px3=dx3*2._8; i3m=i3-1; i3p=i3+1
+          END IF
+       END IF
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL localdivergence_ani(f1,f2,f3,i3m,i3p,px3, &
+                       i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
+
+             c1(i1,i2,i3)=c1(i1,i2,i3)-REAL(f1)
+             c2(i1,i2,i3)=c2(i1,i2,i3)-REAL(f2)
+             c3(i1,i2,i3)=c3(i1,i2,i3)-REAL(f3)
+
+          END DO
+       END DO
+    END DO
+!$omp end do nowait
+
+    ! intermediate depth treated isotropically
+!$omp do private(i1,i2,f1,f2,f3)
+    DO i3=len3+1,sx3-len3
+       
+       IF (PRESENT(mask)) THEN
+          IF (mask(i3) .EQ. 0) THEN
+             CYCLE
+          END IF
+       END IF
+       
+       DO i2=1,sx2
+          DO i1=1,sx1
+             ! Finite Impulse Response filter
+             !CALL localdivergence_fir(f1,f2,f3)
+             CALL localdivergence_fir2(f1,f2,f3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
+
+             c1(i1,i2,i3)=c1(i1,i2,i3)-REAL(f1)
+             c2(i1,i2,i3)=c2(i1,i2,i3)-REAL(f2)
+             c3(i1,i2,i3)=c3(i1,i2,i3)-REAL(f3)
+          END DO
+       END DO
+    END DO
+!$omp end do
+!$omp end parallel
+
+  CONTAINS
+
+    !---------------------------------------------------------------
+    ! LocalDivergence_FIR
+    ! implements a finite impulse response filter (FIR) to estimate
+    ! the divergence of second-order tensor.
+    !
+    ! ATTENTION - calls to this routine can cause memory leak.
+    !
+    ! sylvain barbot (10/10/07) - original form
+    !                (03/05/08) - implements 3 filters
+    !                (02/11/09) - compatibility with OpenMP
+    !---------------------------------------------------------------
+    SUBROUTINE localdivergence_fir2(f1,f2,f3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
+      REAL*8, INTENT(OUT) :: f1,f2,f3
+      INTEGER, INTENT(IN) :: len1,len2,len3,i1,i2,i3,sx1,sx2,sx3
+      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
+      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
+      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
+      TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: sig
+
+      INTEGER :: l,i1m,i1p,i2m,i2p,i3m,i3p
+
+      f1=0._8; f2=0._8; f3=0._8
+      
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+         
+         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
+         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
+         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
+      END DO
+      
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+         
+         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
+         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
+         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
+      END DO
+      
+      DO l=1,len3
+         ! neighbor samples in semi-infinite solid
+         i3m=i3-l
+         i3p=i3+l
+         
+         f1=f1+(sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13)*ker3(l)
+         f2=f2+(sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23)*ker3(l)
+         f3=f3+(sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33)*ker3(l)
+      END DO
+      
+    END SUBROUTINE localdivergence_fir2
+
+    !---------------------------------------------------------------
+    ! LocalDivergence_FIR
+    ! implements a finite impulse response filter (FIR) to estimate
+    ! the divergence of second-order tensor.
+    !
+    ! ATTENTION - calls to this routine can cause memory leak.
+    !
+    ! sylvain barbot (10/10/07) - original form
+    !                (03/05/08) - implements 3 filters
+    !---------------------------------------------------------------
+    SUBROUTINE localdivergence_fir(f1,f2,f3)
+      REAL*8, INTENT(OUT) :: f1,f2,f3
+
+      INTEGER :: l,i1m,i1p,i2m,i2p,i3m,i3p
+
+      f1=0._8; f2=0._8; f3=0._8
+
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+
+         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
+         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
+         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
+      END DO
+
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+
+         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
+         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
+         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
+      END DO
+
+      DO l=1,len3
+         ! neighbor samples in semi-infinite solid
+         i3m=i3-l
+         i3p=i3+l
+
+         f1=f1+(sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13)*ker3(l)
+         f2=f2+(sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23)*ker3(l)
+         f3=f3+(sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33)*ker3(l)
+      END DO
+
+    END SUBROUTINE localdivergence_fir
+
+    !---------------------------------------------------------------
+    ! LocalDivergence_ANI
+    ! implements a finite impulse response filter (FIR) in the
+    ! horizontal direction and a finite-difference scheme in the
+    ! vertical direction to estimate the divergence of second-order
+    ! tensor.
+    ! Finite difference scheme is left-centered, right-centered or
+    ! symmetric, depending on input positions (i3m,i3p) and spacing
+    ! (px3).
+    !
+    ! sylvain barbot (10/10/07) - original form
+    !                (03/05/08) - implements 3 filters
+    !                (02/12/09) - compatibility with OpenMP
+    !---------------------------------------------------------------
+    SUBROUTINE localdivergence_ani(f1,f2,f3,i3m,i3p,px3,i1,i2,i3,ker1,ker2,ker3,len1,len2,len3,sig,sx1,sx2,sx3)
+      REAL*8, INTENT(OUT) :: f1,f2,f3
+      INTEGER, INTENT(IN) :: i3m,i3p,i1,i2,i3,len1,len2,len3,sx1,sx2,sx3
+      REAL*8, INTENT(IN), DIMENSION(len1) :: ker1
+      REAL*8, INTENT(IN), DIMENSION(len2) :: ker2
+      REAL*8, INTENT(IN), DIMENSION(len3) :: ker3
+      REAL*8, INTENT(IN) :: px3
+      TYPE(TENSOR), INTENT(IN), DIMENSION(:,:,:) :: sig
+
+      INTEGER :: l,i1m,i1p,i2m,i2p,foo,dum
+
+      f1=0._8; f2=0._8; f3=0._8
+
+      ! differentiator filter in the horizontal direction
+      DO l=1,len1
+         ! neighbor samples with periodic boundary conditions
+         i1m=mod(sx1+i1-1-l,sx1)+1
+         i1p=mod(i1-1+l,sx1)+1
+
+         f1=f1+(sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11)*ker1(l)
+         f2=f2+(sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12)*ker1(l)
+         f3=f3+(sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13)*ker1(l)
+      END DO
+
+      DO l=1,len2
+         ! neighbor samples with periodic boundary conditions
+         i2m=mod(sx2+i2-1-l,sx2)+1
+         i2p=mod(i2-1+l,sx2)+1
+
+         f1=f1+(sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12)*ker2(l)
+         f2=f2+(sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22)*ker2(l)
+         f3=f3+(sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23)*ker2(l)
+      END DO
+
+      ! finite difference in the 3-direction
+      f1=f1+( sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13 )/px3
+      f2=f2+( sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23 )/px3
+      f3=f3+( sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33 )/px3
+
+    END SUBROUTINE localdivergence_ani
+
+    !-------------------------------------------------------------------
+    ! subroutine LocalDivergence_CFD
+    ! estimate the divergence of the stress tensor by means of simple
+    ! finite difference schemes. In the horizontal direction, numerical
+    ! scheme is always centered finite difference. because of the
+    ! surface and bottom boundary condition, scheme in the vertical
+    ! direction changes from right-centered at the top, to center in the
+    ! middle, to left-centered finite difference at the bottom.
+    !-------------------------------------------------------------------
+    SUBROUTINE localdivergence_cfd(f1,f2,f3,i3m,i3p,px3)
+      REAL*8, INTENT(OUT) :: f1,f2,f3
+      REAL*8, INTENT(IN) :: px3
+      INTEGER, INTENT(IN) :: i3m, i3p
+
+      INTEGER :: i1m,i1p,i2m,i2p
+
+      ! neighbor samples
+      i1m=mod(sx1+i1-2,sx1)+1
+      i1p=mod(i1,sx1)+1
+      i2m=mod(sx2+i2-2,sx2)+1
+      i2p=mod(i2,sx2)+1
+
+      f1= ( sig(i1p,i2,i3)%s11-sig(i1m,i2,i3)%s11 )/dx1/2._8 &
+         +( sig(i1,i2p,i3)%s12-sig(i1,i2m,i3)%s12 )/dx2/2._8 &
+         +( sig(i1,i2,i3p)%s13-sig(i1,i2,i3m)%s13 )/px3
+      f2= ( sig(i1p,i2,i3)%s12-sig(i1m,i2,i3)%s12 )/dx1/2._8 &
+         +( sig(i1,i2p,i3)%s22-sig(i1,i2m,i3)%s22 )/dx2/2._8 &
+         +( sig(i1,i2,i3p)%s23-sig(i1,i2,i3m)%s23 )/px3
+      f3= ( sig(i1p,i2,i3)%s13-sig(i1m,i2,i3)%s13 )/dx1/2._8 &
+         +( sig(i1,i2p,i3)%s23-sig(i1,i2m,i3)%s23 )/dx2/2._8 &
+         +( sig(i1,i2,i3p)%s33-sig(i1,i2,i3m)%s33 )/px3
+
+    END SUBROUTINE localdivergence_cfd
+
+  END SUBROUTINE equivalentbodyforce
+
+
+  !---------------------------------------------------------------------
+  !> function SourceSpectrum
+  !! computes the equivalent body-forces for a buried dislocation,
+  !! with strike-slip and dip-slip components,
+  !! slip s, width W, length L in a rigidity mu
+  !!
+  !! \author sylvain barbot (06-25-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE sourcespectrum(mu,s,x,y,d, &
+       L,W,strike,dip,rake,beta,dx1,dx2,dx3,f1,f2,f3)
+    REAL*8, INTENT(IN) :: mu,s,x,y,d,L,W,strike,dip,rake,&
+         beta,dx1,dx2,dx3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
+
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8 :: k1,k2,k3,k1s,k2s,k3s,k1i,k3i, &
+         cstrike,sstrike,cdip,sdip,cr,sr,k2r
+    COMPLEX*8 :: cbuf1,cbuf2,cbuf3,source,image,&
+         shift,scale,aperture,up,down
+    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
+
+    sx1=SIZE(f2,1)-2
+    sx2=SIZE(f2,2)
+    sx3=SIZE(f2,3)
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+    scale=i*mu*s*L*W
+
+    DO i3=1,sx3
+       CALL wavenumber3(i3,sx3,dx3,k3)
+       down=exp(-i*k3*(L/2._8+d))
+       up=conjg(down)
+       DO i2=1,sx2
+          CALL wavenumber2(i2,sx2,dx2,k2)
+          DO i1=1,sx1/2+1
+             CALL wavenumber1(i1,sx1,dx1,k1)
+
+             !rotate the wavenumbers
+             k2r= cstrike*k1-sstrike*k2
+             k1s= cdip*k2r-sdip*k3
+             k2s= sstrike*k1+cstrike*k2
+             k3s= sdip*k2r+cdip*k3
+             k1i= cdip*k2r+sdip*k3
+             k3i=-sdip*k2r+cdip*k3
+             
+             !integrate at depth and along strike with raised cosine taper
+             !and shift sources to x,y,z coordinate
+             shift=exp(-i*(x*k1+y*k2))
+             aperture=scale*omegak(W*k2s,beta)
+             source=omegak(L*k3s,beta)*aperture*shift*down
+             image =omegak(L*k3i,beta)*aperture*shift*up
+
+             !convolve source and image with a 1-D gaussian
+             source=source*exp(-(pi*dx1*k1s)**2)
+             image = image*exp(-(pi*dx1*k1i)**2)
+             
+             cbuf1= cdip*cstrike*( &
+                  -(cr*k2s+sr*k3s)*source-(cr*k2s-sr*k3i)*image) &
+                  +cr*sstrike*(-k1s*source-k1i*image) &
+                  -sr*sdip*cstrike*(-k1s*source-k1i*image)
+             !change -sr*sdip back to +sr*sdip above and below
+             cbuf2=-cdip*sstrike*( &
+                  -(cr*k2s+sr*k3s)*source-(cr*k2s-sr*k3i)*image) &
+                  +cr*cstrike*(-k1s*source-k1i*image) &
+                  -sr*sdip*sstrike*(-k1s*source-k1i*image)
+             !change -sdip back to +sdip here
+             cbuf3=-sdip*((-sr*k3s-cr*k2s)*source &
+                  +(-sr*k3i+cr*k2s)*image) &
+                  +sr*cdip*(-k1s*source+k1i*image)
+
+             f1(2*i1-1:2*i1,i2,i3)=&
+                  f1(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf1),AIMAG(cbuf1)/)
+             f2(2*i1-1:2*i1,i2,i3)=&
+                  f2(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf2),AIMAG(cbuf2)/)
+             f3(2*i1-1:2*i1,i2,i3)=&
+                  f3(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf3),AIMAG(cbuf3)/)
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE sourcespectrum
+
+
+  !---------------------------------------------------------------------
+  !> function SourceSpectrumHalfSpace
+  !! computes the equivalent body-forces for a buried dislocation,
+  !! with strike-slip and dip-slip components,
+  !! slip s, width W, length L in a rigidity mu; sources are not imaged
+  !!
+  !! \author sylvain barbot (06-25-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE sourcespectrumhalfspace(mu,s,x,y,d, &
+       L,W,strike,dip,rake,beta,dx1,dx2,dx3,f1,f2,f3)
+    REAL*8, INTENT(IN) :: mu,s,x,y,d,L,W,strike,dip,rake,&
+         beta,dx1,dx2,dx3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
+
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8 :: k1,k2,k3,k1s,k2s,k3s, &
+         cstrike,sstrike,cdip,sdip,cr,sr,k2r
+    COMPLEX*8 :: cbuf1,cbuf2,cbuf3,source,&
+         shift,scale,aperture,down
+    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
+
+    sx1=SIZE(f2,1)-2
+    sx2=SIZE(f2,2)
+    sx3=SIZE(f2,3)
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+    scale=i*mu*s*L*W
+
+    DO i3=1,sx3
+       CALL wavenumber3(i3,sx3,dx3,k3)
+       down=exp(-i*k3*(L/2._8+d))
+       DO i2=1,sx2
+          CALL wavenumber2(i2,sx2,dx2,k2)
+          DO i1=1,sx1/2+1
+             CALL wavenumber1(i1,sx1,dx1,k1)
+             !rotate the wavenumbers
+             k2r= cstrike*k1-sstrike*k2
+             k1s= cdip*k2r-sdip*k3
+             k2s= sstrike*k1+cstrike*k2
+             k3s= sdip*k2r+cdip*k3
+             
+             !convolve source and image with a 1-D gaussian
+             !integrate at depth and along strike with raised cosine taper
+             !and shift sources to x,y,z coordinate
+             shift=exp(-i*(x*k1+y*k2))
+             aperture=scale*omegak(W*k2s,beta)*exp(-(pi*dx1*k1s)**2)
+             source=(omegak(L*k3s,beta)*aperture)*shift*down
+
+             cbuf1= cdip*cstrike*( &
+                  -(cr*k2s+sr*k3s)*source) &
+                  +cr*sstrike*(-k1s*source) &
+                  -sr*sdip*cstrike*(-k1s*source)
+             cbuf2=-cdip*sstrike*( &
+                  -(cr*k2s+sr*k3s)*source) &
+                  +cr*cstrike*(-k1s*source) &
+                  -sr*sdip*sstrike*(-k1s*source)
+             cbuf3=-sdip*((-sr*k3s-cr*k2s)*source) &
+                  +sr*cdip*(-k1s*source)
+
+             f1(2*i1-1:2*i1,i2,i3)=&
+                  f1(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf1),AIMAG(cbuf1)/)
+             f2(2*i1-1:2*i1,i2,i3)=&
+                  f2(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf2),AIMAG(cbuf2)/)
+             f3(2*i1-1:2*i1,i2,i3)=&
+                  f3(2*i1-1:2*i1,i2,i3)+(/REAL(cbuf3),AIMAG(cbuf3)/)
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE sourcespectrumhalfspace
+
+  !---------------------------------------------------------------------
+  !> function Source computes the equivalent body-forces
+  !! in the space domain for a buried dislocation with strike-slip
+  !! and dip-slip components, slip s, width W, length L in a rigidity mu
+  !!
+  !! Default (strike=0, dip=0, rake=0) is a vertical left-lateral
+  !! strike-slip fault along the x2 axis. Default fault slip is
+  !! represented with the double-couple equivalent body forces:
+  !!
+  !!\verbatim
+  !!
+  !!                   x1
+  !!                   |
+  !!                   |   ^  f2
+  !!                   |   |<-----
+  !!                   +---+------+---- x2
+  !!                        ----->|
+  !!                              v  f1
+  !!
+  !!\endverbatim
+  !!
+  !! \author sylvain barbot (06-29-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE source(mu,s,x,y,z,L,W,strike,dip,rake, &
+       beta,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3,t1,t2,t3)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: mu,s,x,y,z,L,W,strike,dip,rake, &
+         beta,dx1,dx2,dx3
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: t1,t2,t3
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+    REAL*4, DIMENSION(sx1,sx2), INTENT(INOUT) :: t1,t2,t3
+#endif
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,cr,sr,x2r, &
+         sourc,image,scale,temp1,temp2,temp3, &
+         dblcp,cplei,dipcs,dipci,xr,yr,zr,Wp,Lp
+    REAL(8), DIMENSION(3) :: n,b
+    TYPE(TENSOR) :: m
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+    scale=-mu*s
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+    
+    ! equivalent surface traction
+    i3=1
+    DO i2=1,sx2
+       DO i1=1,sx1
+          CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                                  dx1,dx2,dx3,x1,x2,x3)
+
+          IF ((ABS(x1-x).GT.MAX(Lp,Wp)).OR.(ABS(x2-y).GT.MAX(Lp,Wp))) CYCLE
+
+          x2r= cstrike*x1-sstrike*x2
+          x1s= cdip*x2r-sdip*x3
+          x1i= cdip*x2r+sdip*x3
+          IF ((ABS(x1s-xr).GT.7.01*dx1).AND.(ABS(x1i-xr).GT.7.01*dx1)) CYCLE
+          x2s= sstrike*x1+cstrike*x2
+          x3s= sdip*x2r+cdip*x3
+          x3i=-sdip*x2r+cdip*x3
+
+          ! integrate at depth and along strike with raised cosine taper
+          ! and shift sources to x,y,z coordinate
+          temp1=gauss(x1s-xr,dx1)
+          temp2=omega((x2s-yr)/W,beta)
+          temp3=omega((x3s-zr)/L,beta)
+          sourc=temp1*temp2*temp3
+
+          ! add image
+          temp1=gauss(x1i-xr,dx1)
+          temp3=omega((x3i+zr)/L,beta)
+          sourc=sourc+temp1*temp2*temp3
+
+          ! surface normal vector components
+          n(1)=+cdip*cstrike*sourc
+          n(2)=-cdip*sstrike*sourc
+          n(3)=-sdip*sourc
+
+          ! burger vector (strike-slip)
+          b(1)=sstrike*cr
+          b(2)=cstrike*cr
+
+          ! burger vector (dip-slip)
+          b(1)=b(1)+cstrike*sdip*sr
+          b(2)=b(2)-sstrike*sdip*sr
+          b(3)=    +cdip*sr
+
+          ! principal stress (symmetric deviatoric second-order tensor)
+          m=n .sdyad. (mu*s*b)
+
+          ! surface tractions
+          t1(i1,i2)=t1(i1,i2)+m%s13
+          t2(i1,i2)=t2(i1,i2)+m%s23
+          t3(i1,i2)=t3(i1,i2)+m%s33
+             
+       END DO
+    END DO
+
+    ! equivalent body-force density
+!$omp parallel do private(i1,i2,x1,x2,x3,x2r,x1s,x1i,x2s,x3s,x3i,temp1,temp2,temp3), &
+!$omp private(sourc,dblcp,dipcs,image,cplei,dipci)
+    DO i3=1,sx3/2
+       CALL shiftedcoordinates(1,1,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+             IF ((ABS(x1-x) .GT. MAX(Wp,Lp)) .OR.  (abs(x2-y) .GT. MAX(Wp,Lp))) CYCLE
+
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((ABS(x1s-xr) .GT. 7.01_8*dx1) .AND. (ABS(x1i-xr) .GT. 7.01_8*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+             
+             !integrate at depth and along strike with raised cosine taper
+             !and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             sourc=scale  *gaussp(x1s-xr,dx1) &
+                          *temp2 &
+                          *temp3
+             dblcp=scale/W*temp1 &
+                          *omegap((x2s-yr)/W,beta) &
+                          *temp3
+             dipcs=scale/L*temp1 &
+                          *temp2 &
+                          *omegap((x3s-zr)/L,beta)
+
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             image=scale  *gaussp(x1i-xr,dx1) &
+                          *temp2 &
+                          *temp3
+             cplei=scale/W*temp1 &
+                          *omegap((x2s-yr)/W,beta) &
+                          *temp3
+             dipci=scale/L*temp1 &
+                          *temp2 &
+                          *omegap((x3i+zr)/L,beta)
+
+             ! strike-slip component
+
+             IF (2.01_8*DEG2RAD .GT. dip) THEN
+                ! use method of images for subvertical faults
+                f1(i1,i2,i3)=f1(i1,i2,i3) &
+                     +cr*sstrike*(sourc+image) &
+                       +cr*cdip*cstrike*(dblcp+cplei)
+                f2(i1,i2,i3)=f2(i1,i2,i3) &
+                     +cr*cstrike*(sourc+image) &
+                     -cr*cdip*sstrike*(dblcp+cplei)
+                f3(i1,i2,i3)=f3(i1,i2,i3) &
+                     -cr*sdip*(dblcp-cplei)
+             ELSE
+                ! dipping faults do not use method of image
+                f1(i1,i2,i3)=f1(i1,i2,i3) &
+                     +cr*sstrike*(sourc) &
+                     +cr*cdip*cstrike*(dblcp)
+                f2(i1,i2,i3)=f2(i1,i2,i3) &
+                     +cr*cstrike*(sourc) &
+                     -cr*cdip*sstrike*(dblcp)
+                 f3(i1,i2,i3)=f3(i1,i2,i3) &
+                     -cr*sdip*(dblcp)
+             END IF
+
+             ! dip-slip component
+
+             f1(i1,i2,i3)=f1(i1,i2,i3) &
+                  +cdip*sr*cstrike*dipcs &
+                  +sdip*sr*cstrike*sourc
+             f2(i1,i2,i3)=f2(i1,i2,i3) &
+                  -cdip*sr*sstrike*dipcs &
+                  -sdip*sr*sstrike*sourc
+             f3(i1,i2,i3)=f3(i1,i2,i3) &
+                  +cdip*sr*sourc &
+                  -sdip*sr*dipcs
+
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+  END SUBROUTINE source
+
+  !---------------------------------------------------------------------
+  !> function TensileSource
+  !! computes the equivalent body-forces in the space domain for a buried
+  !! tensile crack with opening s, width W, length L and Lame parameters
+  !! lambda, mu.
+  !!
+  !! Default (strike=0, dip=0) is a vertical opening along the x2 axis.
+  !! Default fault opening is represented with the double-couple
+  !! equivalent body forces:
+  !!
+  !!\verbatim
+  !!
+  !!           x1           f1
+  !!           |         ^^^^^^^
+  !!           |         |||||||
+  !!           | -f2 <--+-------+--> f2
+  !!           |         |||||||
+  !!           |         vvvvvvv
+  !!           |           -f1
+  !!           |
+  !!           +----------------------------- x2
+  !!
+  !!\endverbatim
+  !!
+  !! The eigenstrain/potency tensor for a point source is
+  !!
+  !!\verbatim
+  !!
+  !!         | 1 0 0 |
+  !!   E^i = | 0 0 0 |
+  !!         | 0 0 0 |
+  !!
+  !!\endverbatim
+  !!
+  !! and the corresponding moment density for a point source is
+  !!
+  !!\verbatim
+  !!
+  !!                 | lambda+2*mu    0      0   |
+  !!   m = C : E^i = |      0      lambda    0   |
+  !!                 |      0         0   lambda |
+  !!
+  !!\endverbatim
+  !!
+  !! Moment density is integrated along the planar surface
+  !!
+  !!   \f[ box(x2) \delta(x1) box(x3) \f]
+  !!
+  !! where box(x) and delta(x) are the boxcar and the dirac delta
+  !! functions, respectively. We use a tapered boxcar, omega_beta(x) and
+  !! approximate the delta function by a small gaussian function.
+  !! Finally, the equivalent body force is the divergence of the moment
+  !! density tensor
+  !!
+  !!   \f[ f_i = - ( m_{ij} )_{,j} \f]
+  !!
+  !! derivatives are performed analytically on the gaussian and
+  !! omega_beta functions.
+  !!
+  !! \author sylvain barbot (05-09-08) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE tensilesource(lambda,mu,s,x,y,z,L,W,strike,dip, &
+       beta,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: lambda,mu,s,x,y,z,L,W,strike,dip,&
+         beta,dx1,dx2,dx3
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+#endif
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,x2r,&
+         sourc,image,scale1,scale2,temp1,temp2,temp3, &
+         dblcp,cplei,dipcs,dipci,xr,yr,zr,Wp,Lp
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+    scale1=-s*(lambda+2._8*mu)
+    scale2=-s*lambda
+
+    DO i3=1,sx3
+       CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
+
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+
+             !integrate at depth and along strike with raised cosine taper
+             !and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             sourc=scale1  *gaussp(x1s-xr,dx1) &
+                           *temp2 &
+                           *temp3
+             dblcp=scale2/W*temp1 &
+                           *omegap((x2s-yr)/W,beta) &
+                           *temp3
+             dipcs=scale2/L*temp1 &
+                           *temp2 &
+                           *omegap((x3s-zr)/L,beta)
+
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             image=scale1  *gaussp(x1i-xr,dx1) &
+                           *temp2 &
+                           *temp3
+             cplei=scale2/W*temp1 &
+                           *omegap((x2s-yr)/W,beta) &
+                           *temp3
+             dipci=scale2/L*temp1 &
+                           *temp2 &
+                           *omegap((x3i+zr)/L,beta)
+
+             ! force moments in original coordinate system
+
+             f1(i1,i2,i3)=f1(i1,i2,i3) &
+                  +cstrike*cdip*(sourc+image) &
+                  +sstrike*(dblcp+cplei) &
+                  +cstrike*sdip*(dipcs+dipci)
+             f2(i1,i2,i3)=f2(i1,i2,i3) &
+                  -sstrike*cdip*(sourc+image) &
+                  +cstrike*(dblcp+cplei) &
+                  -sstrike*sdip*(dipcs+dipci)
+             f3(i1,i2,i3)=f3(i1,i2,i3) &
+                  -sdip*(sourc-image) &
+                  +cdip*(dipcs-dipci)
+
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE tensilesource
+
+  !---------------------------------------------------------------------
+  !! function MogiSource 
+  !! computes the equivalent body-forces in the space domain for a buried 
+  !! dilatation point source.
+  !!
+  !! The point-source opening o with at position xs in the half space is
+  !! associated with eigenstrain
+  !!
+  !!      \f[ E^i = o \frac{1}{3} I \delta(x-x_s) \f]
+  !!
+  !! where I is the diagonal tensor and delta is the Dirac delta function
+  !! (or in index notation E^i_{ij} = o delta_{ij} / 3 delta(xs) ) and 
+  !! with the moment density
+  !!
+  !!      \f[ m = C : E^i = K o I \delta(x-x_s) \f]
+  !!
+  !! The equivalent body-force density is
+  !!
+  !!      \f[ f = - \nabla \cdot m = K o \nabla \delta(x-x_s) \f]
+  !!
+  !! where nabla is the gradient operator. Default source opening is 
+  !! represented with the isotropic equivalent body-force density:
+  !!
+  !!\verbatim
+  !!
+  !!                   x1
+  !!                   |      f1
+  !!                   |      ^
+  !!                   |  f2  |  f2
+  !!                   +---<--+-->---- x2
+  !!                          |
+  !!                          v  f1
+  !!
+  !!                   x3
+  !!                   |      f3
+  !!                   |      ^
+  !!                   |  f2  |  f2
+  !!                   +---<--+-->---- x2
+  !!                          |
+  !!                          v  f3
+  !!
+  !!\endverbatim
+  !!
+  !! \author sylvain barbot (03-24-09) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE mogisource(lambda,mu,o,xs,ys,zs,sx1,sx2,sx3,dx1,dx2,dx3,f1,f2,f3)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: lambda,mu,o,xs,ys,zs,dx1,dx2,dx3
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: f1,f2,f3
+#endif
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,source1,source2,source3, &
+         image1,image2,image3,scale,temp1,temp2,temp3,Wp,Lp
+
+    scale=-(lambda+2._8*mu/3._8)*o ! -kappa*o
+
+    ! effective dimensions
+    Wp=6._8*MAX(dx1,dx2,dx3)
+    Lp=6._8*MAX(dx1,dx2,dx3)
+
+    DO i3=1,sx3
+       CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+       IF ((abs(x3-zs).gt.Lp) .and. (abs(x3+zs).gt.Lp)) CYCLE
+       
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+             IF ((abs(x1-xs).gt.Wp) .or.  (abs(x2-ys).gt.Wp)) CYCLE
+
+             temp1=gauss(x1-xs,dx1)
+             temp2=gauss(x2-ys,dx2)
+             temp3=gauss(x3-zs,dx3)
+
+             source1=scale*gaussp(x1-xs,dx1)*temp2*temp3
+             source2=scale*temp1*gaussp(x2-ys,dx2)*temp3
+             source3=scale*temp1*temp2*gaussp(x3-zs,dx3)
+
+             temp3=gauss(x3+zs,dx3)
+
+             image1=scale*gaussp(x1-xs,dx1)*temp2*temp3
+             image2=scale*temp1*gaussp(x2-ys,dx2)*temp3
+             image3=scale*temp1*temp2*gaussp(x3+zs,dx3)
+
+             ! equivalent body-force density
+             f1(i1,i2,i3)=f1(i1,i2,i3)+(source1+image1)
+             f2(i1,i2,i3)=f2(i1,i2,i3)+(source2+image2)
+             f3(i1,i2,i3)=f3(i1,i2,i3)+(source3-image3)
+
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE mogisource
+
+  !---------------------------------------------------------------------
+  !> subroutine Traction 
+  !! assigns the traction vector at the surface.
+  !!
+  !! \author sylvain barbot (07-19-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE traction(mu,e,sx1,sx2,dx1,dx2,t,Dt,t3,rate)
+    TYPE(EVENT_STRUC), INTENT(IN) :: e
+    INTEGER, INTENT(IN) :: sx1,sx2
+    REAL*8, INTENT(IN) :: mu,dx1,dx2,t,Dt
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: t3
+#else
+    REAL*4, DIMENSION(sx1,sx2), INTENT(INOUT) :: t3
+#endif
+    LOGICAL, INTENT(IN), OPTIONAL :: rate
+
+    INTEGER :: i,i1,i2,i3
+    LOGICAL :: israte
+    REAL*8 :: period,phi,amp,L,W,Lp,Wp,x1,x2,x3,x,y,beta
+
+    REAL*8, PARAMETER :: pi=3.141592653589793115997963468544185161_8
+
+    IF (PRESENT(rate)) THEN
+       israte=rate
+    ELSE
+       israte=.FALSE.
+    END IF
+
+    ! loop over traction sources
+    DO i=1,e%nl
+
+       x=e%l(i)%x
+       y=e%l(i)%y
+
+       L=e%l(i)%length
+       W=e%l(i)%width
+
+       beta=e%l(i)%beta
+
+       ! effective tapered dimensions
+       Lp=L*(1._8+2._8*beta)/2._8
+       Wp=W*(1._8+2._8*beta)/2._8
+
+       i3=1
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,1, &
+                                     dx1,dx2,1.d8,x1,x2,x3)
+
+             IF ((ABS(x1-x).GT.MAX(Lp,Wp)).OR.(ABS(x2-y).GT.MAX(Lp,Wp))) CYCLE
+
+             amp=omega((x1-x)/L,beta)* &
+                 omega((x2-y)/W,beta)* &
+                 mu*e%l(i)%slip
+
+             IF (israte) THEN
+                ! surface tractions rate
+                period=e%l(i)%period
+                phi=e%l(i)%phase
+
+                t3(i1,i2)=t3(i1,i2)-amp*(sin(2*pi*(t+Dt)/period+phi)-sin(2*pi*t/period+phi))
+             ELSE
+                IF (e%l(i)%period .LE. 0) THEN
+                   ! surface tractions
+                   t3(i1,i2)=t3(i1,i2)-amp
+                END IF
+             END IF
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE traction
+
+  !---------------------------------------------------------------------
+  !! function MomentDensityShear
+  !! computes the inelastic irreversible moment density in the space
+  !! domain corresponding to a buried dislocation with strike-slip and
+  !! dip-slip components (pure shear). A fault along a surface of normal
+  !! n_i with a burger vector s_i, is associated with the eigenstrain
+  !!
+  !!   E^i_ij = 1/2 ( n_i s_j + s_i n_j )
+  !!
+  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
+  !! corresponding moment density tensor is
+  !!
+  !!   m_ij = C_ijkl E^i_kl
+  !!
+  !! where C = C(x) is a function of space. Equivalent body forces
+  !! representing the set of dislocations can be obtained by evaluating
+  !! the divergence of the moment density tensor
+  !!
+  !!   f_i = - ( m_ji ),j
+  !!
+  !! using the function "EquivalentBodyForce" in this module.
+  !!
+  !! The default dislocation extends in the x2 direction, with a normal
+  !! in the x1 direction. Using the following angular convention,
+  !!
+  !!\verbatim
+  !!
+  !!           x1            !           x1
+  !!   n  theta |            !   n   phi  |
+  !!     \  ____|            !     \  ____|
+  !!       \    |            !       \    |
+  !!         \  |            !         \  |
+  !!      -----\+------ x2   !      -----\+------ x3
+  !!        (x3 down)        !         (x2 up)
+  !!
+  !!\endverbatim
+  !!
+  !! where theta is the strike and phi is the dip (internal convention),
+  !! and introducting the rotation matrices
+  !!
+  !!\verbatim
+  !!
+  !!        |  cos(theta)   sin(theta)    0 |
+  !!   R1 = | -sin(theta)   cos(theta)    0 |
+  !!        |      0             0        1 |
+  !!
+  !!        |  cos(phi)     0     sin(phi)  |
+  !!   R2 = |     0         1        0      |
+  !!        | -sin(phi)     0     cos(phi)  |
+  !!
+  !!\endverbatim
+  !!
+  !! a normal vector n of arbitrary orientation and the corresponding
+  !! strike-slip and dip-slip vector, s and d respectively, are
+  !!
+  !!\verbatim
+  !!
+  !!             | 1 |             | 0 |             | 0 |
+  !!   n = R1 R2 | 0 |,  s = R1 R2 | 1 |,  d = R1 R2 | 0 |
+  !!             | 0 |             | 0 |             | 1 |
+  !!
+  !!\endverbatim
+  !!
+  !! vector n, s and d are orthogonal and the corresponding moment
+  !! density second order tensor is deviatoric. The method of images is
+  !! used to avoid tapering of the fault at the surface.
+  !!
+  !! \author sylvain barbot (03-02-08) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE momentdensityshear(mu,slip,x,y,z,L,W,strike,dip,rake, &
+       beta,sx1,sx2,sx3,dx1,dx2,dx3,sig)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: mu,slip,x,y,z,L,W,strike,dip,rake,&
+         beta,dx1,dx2,dx3
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
+
+    INTEGER :: i1,i2,i3
+    REAL*4 :: rmu
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
+         aperture,temp1,temp2,temp3,xr,yr,zr,Wp,Lp,dum
+    REAL*8, DIMENSION(3) :: n,s
+    TYPE(TENSOR) :: Ei
+
+    rmu=2._4*REAL(mu,4)
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+
+    DO i3=1,sx3
+       x3=DBLE(i3-1)*dx3
+       IF (abs(x3-z) .gt. Lp) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+
+             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
+
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+
+             ! integrate at depth and along strike with raised cosine taper
+             ! and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             aperture=temp1*temp2*temp3
+
+             ! add image
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             aperture=aperture+temp1*temp2*temp3
+
+             ! surface normal vector components
+             n(1)=+cdip*cstrike*aperture
+             n(2)=-cdip*sstrike*aperture
+             n(3)=-sdip*aperture
+
+             ! strike-slip component
+             s(1)=sstrike*cr
+             s(2)=cstrike*cr
+
+             ! dip-slip component
+             s(1)=s(1)+cstrike*sdip*sr
+             s(2)=s(2)-sstrike*sdip*sr
+             s(3)=    +cdip*sr
+
+             ! eigenstrain (symmetric deviatoric second-order tensor)
+             Ei=n .sdyad. (slip*s)
+
+             ! moment density (pure shear)
+             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. (rmu .times. Ei)
+             
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE momentdensityshear
+
+  !---------------------------------------------------------------------
+  !> function MomentDensityTensile
+  !! computes the inelastic irreversible moment density in the space
+  !! domain corresponding to a buried dislocation with opening (open
+  !! crack). A fault along a surface of normal n_i with a burger vector
+  !! s_i, is associated with the eigenstrain
+  !!
+  !!   \f[ E^i_{ij} = \frac{1}{2} ( n_i s_j + s_i n_j ) \f]
+  !!
+  !! The eigenstrain/potency tensor for a point source opening crack is
+  !!
+  !!\verbatim
+  !!
+  !!         | 1 0 0 |
+  !!   E^i = | 0 0 0 |
+  !!         | 0 0 0 |
+  !!
+  !!\endverbatim
+  !!
+  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
+  !! corresponding moment density tensor is
+  !!
+  !!   \f[ m_{ij} = C_{ijkl} E^i_{kl} = \lambda E^i_{kk} \delta_{ij} + 2 \mu E^i_{ij} \f]
+  !!
+  !! where C = C(x) is a function of space. (We use isotropic elastic
+  !! solid, and heterogeneous elastic moduli tensor simplifies to
+  !! mu=mu(x) and lambda = lambda(x).) The moment density for a point
+  !! source opening crack is
+  !!
+  !!\verbatim
+  !!
+  !!          | lambda+2*mu    0      0   |
+  !!   m(x) = |      0      lambda    0   |
+  !!          |      0         0   lambda |
+  !!
+  !!\endverbatim
+  !!
+  !! Moment density m(x) is integrated along the planar surface
+  !!
+  !!   box(x2) delta (x1) box(x3)
+  !!
+  !! where box(x) and delta(x) are the boxcar and the dirac delta
+  !! functions, respectively. Equivalent body forces representing the
+  !! set of dislocations can be obtained by evaluating the divergence
+  !! of the moment density tensor
+  !!
+  !!   \f[ f_i = - ( m_{ji} ),j \f]
+  !!
+  !! The corresponding equivalent surface traction is simply
+  !!
+  !!   \f[ t_i = m_{ij} n_j \f]
+  !!
+  !! Both equivalent body forces and equivalent surface traction are
+  !! computed using the function "EquivalentBodyForce" in this module.
+  !!
+  !! The default dislocation extends in the x2 direction, with a normal
+  !! in the x1 direction. Using the following angular convention,
+  !!
+  !!\verbatim
+  !!
+  !!           x1            !           x1
+  !!   n  theta |            !   n   phi  |
+  !!     \  ____|            !     \  ____|
+  !!       \    |            !       \    |
+  !!         \  |            !         \  |
+  !!      -----\+------ x2   !      -----\+------ x3
+  !!        (x3 down)        !         (x2 up)
+  !!
+  !!\endverbatim
+  !!
+  !! where theta is the strike and phi is the dip, in internal
+  !! convention. (Internal angular convention does not correspond to
+  !! usual angular convention of geology and conversion between the two
+  !! standard is necessary.) Introducting the rotation matrices,
+  !!
+  !!\verbatim
+  !!
+  !!        |  cos(theta)   sin(theta)    0 |
+  !!   R1 = | -sin(theta)   cos(theta)    0 |
+  !!        |      0             0        1 |
+  !!
+  !!        |  cos(phi)     0     sin(phi)  |
+  !!   R2 = |     0         1        0      |
+  !!        | -sin(phi)     0     cos(phi)  |
+  !!
+  !!\endverbatim
+  !!
+  !! a normal vector n of arbitrary orientation and the corresponding
+  !! slip vector s are
+  !!
+  !!\verbatim
+  !!
+  !!             | 1 |                 | 1 |
+  !!   n = R1 R2 | 0 |,  s = n = R1 R2 | 0 |
+  !!             | 0 |                 | 0 |
+  !!
+  !!\endverbatim
+  !!
+  !! The method of images is used to avoid tapering of the fault at
+  !! the surface.
+  !!
+  !! \author sylvain barbot (03-02-08) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE momentdensitytensile(lambda,mu,slip,x,y,z,L,W,strike,dip,rake, &
+       beta,sx1,sx2,sx3,dx1,dx2,dx3,sig)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: lambda,mu,slip,x,y,z,L,W,strike,dip,rake,&
+         beta,dx1,dx2,dx3
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
+         aperture,temp1,temp2,temp3,xr,yr,zr,Wp,Lp,dum
+    REAL*8, DIMENSION(3) :: n
+    TYPE(TENSOR) :: Ei
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+
+    DO i3=1,sx3
+       x3=DBLE(i3-1)*dx3
+       IF (abs(x3-z) .gt. Lp) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+
+             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
+
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+
+             ! integrate at depth and along strike with raised cosine taper
+             ! and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             aperture=temp1*temp2*temp3
+
+             ! add image
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             aperture=aperture+temp1*temp2*temp3
+
+             ! surface normal vector components
+             n(1)=+cdip*cstrike*aperture
+             n(2)=-cdip*sstrike*aperture
+             n(3)=-sdip*aperture
+
+             ! eigenstrain (symmetric second-order tensor)
+             Ei=n .sdyad. (slip*n)
+
+             ! moment density (isotropic Hooke's law)
+             CALL isotropicstressstrain(Ei,lambda,mu)
+             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. Ei
+             
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE momentdensitytensile
+
+  !---------------------------------------------------------------------
+  !! function MomentDensityMogi
+  !! computes the inelastic irreversible moment density in the space
+  !! domain corresponding to a buried Mogi source. 
+  !! The Mogi source is associated with the eigenstrain
+  !!
+  !!   \f[ E^i_{ij} = o \frac{1}{3} \delta_{ij} \f]
+  !!
+  !! In a heterogeneous medium of elastic moduli tensor C_ijkl, the
+  !! corresponding moment density tensor is
+  !!
+  !!   \f[ m_{ij} = C_{ijkl} E^i_{kl} \f]
+  !!
+  !! where C = C(x) is a function of space. Equivalent body forces
+  !! representing the set of dislocations can be obtained by evaluating
+  !! the divergence of the moment density tensor
+  !!
+  !!   \f[ f_i = - ( m_{ji} ),j \f]
+  !!
+  !! using the function "EquivalentBodyForce" in this module.
+  !!
+  !! \author sylvain barbot (03-24-09) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE momentdensitymogi(lambda,mu,o,xs,ys,zs,sx1,sx2,sx3,dx1,dx2,dx3,sig)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: lambda,mu,o,xs,ys,zs,dx1,dx2,dx3
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: sig
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,Wp,Lp,dum,kappa,gamma,gammai
+    TYPE(TENSOR) :: m
+
+    kappa=lambda+2._8/3._8*mu
+
+    ! effective tapered dimensions
+    Wp=6._8*MAX(dx1,dx2,dx3)
+    Lp=6._8*MAX(dx1,dx2,dx3)
+
+    DO i3=1,sx3
+       x3=DBLE(i3-1)*dx3
+       IF (abs(x3-zs) .gt. Lp) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+
+             IF ((abs(x1-xs).gt.Wp) .or.  (abs(x2-ys).gt.Wp)) CYCLE
+
+             ! amplitude of eigenstrain
+             gamma =o*gauss(x1-xs,dx1)*gauss(x2-ys,dx2)*gauss(x3-zs,dx3)
+
+             ! add image
+             gammai=o*gauss(x1-xs,dx1)*gauss(x2-ys,dx2)*gauss(x3+zs,dx3)
+
+             ! amplitude of moment density
+             gamma=kappa*gamma
+             gammai=kappa*gammai
+
+             ! eigenstrain (diagonal second-order tensor)
+             m=TENSOR(gamma,0,0,gamma,0,gamma)
+
+             ! moment density (pure shear)
+             sig(i1,i2,i3)=sig(i1,i2,i3) .plus. m
+             
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE momentdensitymogi
+
+  !---------------------------------------------------------------------
+  !> function Plane
+  !! computes the three components, n1, n2 and n3, of the normal vector
+  !! corresponding to a rectangular surface of finite size. The plane
+  !! is defined by its orientation (strike and dip) and dimension.
+  !!
+  !!\verbatim
+  !!
+  !!              W
+  !!       +-------------+
+  !!       |             |
+  !!     L |      +      | - - - > along strike direction
+  !!       |   (x,y,z)   |
+  !!       +-------------|
+  !!              |
+  !!              v
+  !!      down-dip direction
+  !!
+  !!\endverbatim
+  !!
+  !! in the default orientation, for which strike=0 and dip=0, the plane
+  !! is vertical along the x2 axis, such as n2(x) = n3(x) = 0 for all x.
+  !! internal angular conventions are as follows:
+  !!
+  !!\verbatim
+  !!
+  !!             n   x1                          n   x1
+  !!              \   |                           \   |
+  !!               \  |                            \  |
+  !!   90 - strike  \ |                  90 - dip   \ |
+  !!               ( \|                            ( \|
+  !!        ----------+------ x2            ----------+------ x3
+  !!              (x3 down)                       (x2 up)
+  !!
+  !!\endverbatim
+  !!
+  !! edges of the rectangle are tapered.
+  !!
+  !! \author sylvain barbot (09-15-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE plane(x,y,z,L,W,strike,dip, &
+       beta,sx1,sx2,sx3,dx1,dx2,dx3,n1,n2,n3)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: n1,n2,n3
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(INOUT) :: n1,n2,n3
+#endif
+
+    INTEGER :: i1,i2,i3
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,x2r,&
+         temp1,temp2,temp3,sourc,image,xr,yr,zr,Wp,Lp,dum
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+
+    DO i3=1,sx3
+       x3=DBLE(i3-1)*dx3
+       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+             IF ((abs(x1-x).gt.Wp) .or.  (abs(x2-y).gt.Wp)) CYCLE
+
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((abs(x1s-xr).gt.7.01*dx1).and.(abs(x1i-xr).gt.7.01*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+
+             !integrate at depth and along strike with raised cosine taper
+             !and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             sourc=temp1*temp2*temp3
+
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             image=temp1*temp2*temp3
+
+             ! surface normal vector components
+             n1(i1,i2,i3)=n1(i1,i2,i3)+cdip*cstrike*(sourc+image)
+             n2(i1,i2,i3)=n2(i1,i2,i3)-cdip*sstrike*(sourc+image)
+             n3(i1,i2,i3)=n3(i1,i2,i3)-sdip*(sourc+image)
+             
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE plane
+
+  !---------------------------------------------------------------------
+  !> function MonitorStressField
+  !! samples a stress field along a specified planar surface.
+  !!
+  !! \author sylvain barbot (10-16-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE monitorstressfield(x,y,z,L,W,strike,dip,beta, &
+       sx1,sx2,sx3,dx1,dx2,dx3,sig,patch)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: patch
+
+    INTEGER :: px2,px3,j2,j3,status
+    REAL*8 :: x1,x2,x3,xr,yr,zr,Wp,Lp, &
+         cstrike,sstrike,cdip,sdip
+    TYPE(TENSOR) :: lsig
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta) ! horizontal dimension for vertical fault
+    Lp=L*(1._8+2._8*beta) ! depth for a vertical fault
+
+    px3=fix(Lp/dx3)
+    px2=fix(Wp/dx2)
+
+    ALLOCATE(patch(px2+1,px3+1),STAT=status)
+    IF (status>0) STOP "could not allocate the slip patches for export"
+
+    DO j3=1,px3+1
+       DO j2=1,px2+1
+
+          CALL ref2local(x,y,z,xr,yr,zr)
+          
+          ! no translation in out of plane direction
+          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
+          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
+          
+          CALL local2ref(xr,yr,zr,x1,x2,x3)
+          
+          ! discard out-of-bound locations
+          IF (  (x1 .gt. DBLE(sx1/2-1)*dx1) .or. (x1 .lt. -DBLE(sx1/2)*dx1) &
+           .or. (x2 .gt. DBLE(sx2/2-1)*dx2) .or. (x2 .lt. -DBLE(sx2/2)*dx2) &
+           .or. (x3 .gt. DBLE(sx3-1)*dx3) .or. (x3 .lt. 0._8)  ) THEN
+             lsig=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
+          ELSE
+             CALL sampletensor(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,sig,lsig)
+          END IF
+
+          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr, &
+                                        0._8,0._8,0._8,0._8,0._8,0._8,0._8,lsig)
+
+       END DO
+    END DO
+
+  CONTAINS
+
+    !--------------------------------------------------------------
+    !> subroutine sample
+    !! interpolates the value of a discretized 3-dimensional field
+    !! at a subpixel location. method consists in correlating the
+    !! 3D field with a delta function filter. the delta function is
+    !! approximated with a narrow normalized gaussian.
+    !!
+    !! \author sylvain barbot (10-17-07) - original form
+    !--------------------------------------------------------------
+    SUBROUTINE sampletensor(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,sig,lsig)
+      INTEGER, INTENT(IN) :: sx1,sx2,sx3
+      REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
+      TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+      TYPE(TENSOR), INTENT(OUT) :: lsig
+    
+      INTEGER :: i1,i2,i3,i,j,k,l1,l2,l3,i1p,i2p,i3p
+      INTEGER, PARAMETER :: RANGE=2
+      REAL*8 :: sum,weight,x,y,z
+      REAL*8, PARAMETER :: EPS=1e-2
+
+      sum=0._8
+      lsig=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
+
+      ! closest sample
+      CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i,j,k)
+      ! rounded coordinates of closest sample
+      CALL shiftedcoordinates(i,j,k,sx1,sx2,2*sx3,dx1,dx2,dx3,x,y,z)
+
+      ! no interpolation for node points
+      IF ( (abs(x-x1) .lt. EPS*dx1) .and. &
+           (abs(y-x2) .lt. EPS*dx2) .and. &
+           (abs(z-x3) .lt. EPS*dx3) ) THEN
+         lsig=sig(i,j,k)
+         RETURN
+      END IF
+
+      DO l3=-RANGE,+RANGE
+         ! no periodicity in the 3-direction
+         IF ((k+l3 .le. 0) .or. (k+l3 .gt. sx3)) CYCLE
+
+         IF (l3 .ge. 0) THEN
+            i3p=mod(k-1+l3,sx3)+1
+         ELSE
+            i3p=mod(sx3+k-1+l3,sx3)+1
+         END IF
+
+         DO l2=-RANGE,+RANGE
+            IF (l2 .ge. 0) THEN
+               i2p=mod(j-1+l2,sx2)+1
+            ELSE
+               i2p=mod(sx2+j-1+l2,sx2)+1
+            END IF
+
+            DO l1=-RANGE,+RANGE
+               IF (l1 .ge. 0) THEN
+                  i1p=mod(i-1+l1,sx1)+1
+               ELSE
+                  i1p=mod(sx1+i-1+l1,sx1)+1
+               END IF
+
+               weight=sinc(((x+l1*dx1)-x1)/dx1)*dx1 &
+                     *sinc(((y+l2*dx2)-x2)/dx2)*dx2 &
+                     *sinc(((z+l3*dx3)-x3)/dx3)*dx3
+
+               !weight=gauss((x+l1*dx1)-x1,dx1)*dx1 &
+               !      *gauss((y+l2*dx2)-x2,dx2)*dx2 &
+               !      *gauss((z+l3*dx3)-x3,dx3)*dx3
+
+               lsig=lsig.plus.(REAL(weight).times.sig(i1p,i2p,i3p))
+               sum  =sum  +weight
+
+            END DO
+         END DO
+      END DO
+      IF (sum .gt. 1e-6) lsig=REAL(1._8/sum).times.lsig
+
+    END SUBROUTINE sampletensor
+
+    !-----------------------------------------------
+    ! subroutine ref2local
+    ! convert reference Cartesian coordinates into
+    ! the rotated, local fault coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
+      REAL*8, INTENT(IN) :: x,y,z
+      REAL*8, INTENT(OUT) :: xp,yp,zp
+
+      REAL*8 :: x2
+
+      x2 = cstrike*x  -sstrike*y
+      xp = cdip   *x2 -sdip   *z
+      yp = sstrike*x  +cstrike*y
+      zp = sdip   *x2 +cdip   *z
+
+    END SUBROUTINE ref2local
+
+    !-----------------------------------------------
+    ! subroutine local2ref
+    ! converts a set of coordinates from the rotated
+    ! fault-aligned coordinate system into the
+    ! reference, Cartesian coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
+      REAL*8, INTENT(IN) :: xp,yp,zp
+      REAL*8, INTENT(OUT) :: x,y,z
+
+      REAL*8 :: x2p
+
+      x2p=  cdip*xp+sdip*zp
+      x  =  cstrike*x2p+sstrike*yp
+      y  = -sstrike*x2p+cstrike*yp
+      z  = -sdip*xp    +cdip*zp
+
+    END SUBROUTINE local2ref
+
+  END SUBROUTINE monitorstressfield
+
+  !---------------------------------------------------------------------
+  !> function MonitorField
+  !! samples a scalar field along a specified planar surface.
+  !!
+  !! \author sylvain barbot (10-16-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE monitorfield(x,y,z,L,W,strike,dip,beta, &
+       sx1,sx2,sx3,dx1,dx2,dx3,slip,patch)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,dip,beta,dx1,dx2,dx3
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(IN) :: slip
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(IN) :: slip
+#endif
+    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: patch
+
+    INTEGER :: px2,px3,j2,j3,status
+    REAL*8 :: x1,x2,x3,xr,yr,zr,Wp,Lp, &
+         cstrike,sstrike,cdip,sdip,value
+    TYPE(TENSOR) :: sig0
+
+    sig0=TENSOR(0._8,0._8,0._8,0._8,0._8,0._8)
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta) ! horizontal dimension for vertical fault
+    Lp=L*(1._8+2._8*beta) ! depth for a vertical fault
+
+    px3=fix(Lp/dx3)
+    px2=fix(Wp/dx2)
+
+    ALLOCATE(patch(px2+1,px3+1),STAT=status)
+    IF (status>0) STOP "could not allocate the slip patches for export"
+
+    DO j3=1,px3+1
+       DO j2=1,px2+1
+
+          CALL ref2local(x,y,z,xr,yr,zr)
+          
+          ! no translation in out of plane direction
+          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
+          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
+          
+          CALL local2ref(xr,yr,zr,x1,x2,x3)
+          
+          ! discard out-of-bound locations
+          IF (  (x1 .gt. DBLE(sx1/2-1)*dx1) .or. (x1 .lt. -DBLE(sx1/2)*dx1) &
+           .or. (x2 .gt. DBLE(sx2/2-1)*dx2) .or. (x2 .lt. -DBLE(sx2/2)*dx2) &
+           .or. (x3 .gt. DBLE(sx3-1)*dx3) .or. (x3 .lt. 0._8)  ) THEN
+             value=0._8
+          ELSE
+             CALL sample(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,slip,value)
+          END IF
+
+          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr,value,0._8,0._8, &
+                                        0._8,0._8,0._8,0._8,sig0)
+
+       END DO
+    END DO
+
+  CONTAINS
+
+    !--------------------------------------------------------------
+    !> subroutine sample
+    !! interpolates the value of a discretized 3-dimensional field
+    !! at a subpixel location. method consists in correlating the
+    !! 3D field with a delta function filter. the delta function is
+    !! approximated with a narrow normalized gaussian.
+    !!
+    !! \author sylvain barbot (10-17-07) - original form
+    !--------------------------------------------------------------
+    SUBROUTINE sample(x1,x2,x3,dx1,dx2,dx3,sx1,sx2,sx3,field,value)
+      INTEGER, INTENT(IN) :: sx1,sx2,sx3
+      REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
+      REAL*8, INTENT(OUT) :: value
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(IN) :: field
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(IN) :: field
+#endif
+    
+      INTEGER :: i1,i2,i3,i,j,k,l1,l2,l3,i1p,i2p,i3p
+      INTEGER, PARAMETER :: RANGE=2
+      REAL*8 :: sum,weight,x,y,z
+      REAL*8, PARAMETER :: EPS=1e-2
+
+      sum=0._8
+      value=0._8
+
+      ! closest sample
+      CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i,j,k)
+      ! rounded coordinates of closest sample
+      CALL shiftedcoordinates(i,j,k,sx1,sx2,2*sx3,dx1,dx2,dx3,x,y,z)
+
+      ! no interpolation for node points
+      IF ( (abs(x-x1) .lt. EPS*dx1) .and. &
+           (abs(y-x2) .lt. EPS*dx2) .and. &
+           (abs(z-x3) .lt. EPS*dx3) ) THEN
+         value=field(i,j,k)
+         RETURN
+      END IF
+
+      DO l3=-RANGE,+RANGE
+         ! no periodicity in the 3-direction
+         IF ((k+l3 .le. 0) .or. (k+l3 .gt. sx3)) CYCLE
+
+         IF (l3 .ge. 0) THEN
+            i3p=mod(k-1+l3,sx3)+1
+         ELSE
+            i3p=mod(sx3+k-1+l3,sx3)+1
+         END IF
+
+         DO l2=-RANGE,+RANGE
+            IF (l2 .ge. 0) THEN
+               i2p=mod(j-1+l2,sx2)+1
+            ELSE
+               i2p=mod(sx2+j-1+l2,sx2)+1
+            END IF
+
+            DO l1=-RANGE,+RANGE
+               IF (l1 .ge. 0) THEN
+                  i1p=mod(i-1+l1,sx1)+1
+               ELSE
+                  i1p=mod(sx1+i-1+l1,sx1)+1
+               END IF
+
+               weight=sinc(((x+l1*dx1)-x1)/dx1)*dx1 &
+                     *sinc(((y+l2*dx2)-x2)/dx2)*dx2 &
+                     *sinc(((z+l3*dx3)-x3)/dx3)*dx3
+
+               !weight=gauss((x+l1*dx1)-x1,dx1)*dx1 &
+               !      *gauss((y+l2*dx2)-x2,dx2)*dx2 &
+               !      *gauss((z+l3*dx3)-x3,dx3)*dx3
+
+               value=value+weight*field(i1p,i2p,i3p)
+               sum  =sum  +weight
+
+            END DO
+         END DO
+      END DO
+      IF (sum .gt. 1e-6) value=value/sum
+
+    END SUBROUTINE sample
+
+    !-----------------------------------------------
+    ! subroutine ref2local
+    ! convert reference Cartesian coordinates into
+    ! the rotated, local fault coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
+      REAL*8, INTENT(IN) :: x,y,z
+      REAL*8, INTENT(OUT) :: xp,yp,zp
+
+      REAL*8 :: x2
+
+      x2 = cstrike*x  -sstrike*y
+      xp = cdip   *x2 -sdip   *z
+      yp = sstrike*x  +cstrike*y
+      zp = sdip   *x2 +cdip   *z
+
+    END SUBROUTINE ref2local
+
+    !-----------------------------------------------
+    ! subroutine local2ref
+    ! converts a set of coordinates from the rotated
+    ! fault-aligned coordinate system into the
+    ! reference, Cartesian coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
+      REAL*8, INTENT(IN) :: xp,yp,zp
+      REAL*8, INTENT(OUT) :: x,y,z
+
+      REAL*8 :: x2p
+
+      x2p=  cdip*xp+sdip*zp
+      x  =  cstrike*x2p+sstrike*yp
+      y  = -sstrike*x2p+cstrike*yp
+      z  = -sdip*xp    +cdip*zp
+
+    END SUBROUTINE local2ref
+
+  END SUBROUTINE monitorfield
+
+  !-----------------------------------------------------------------
+  ! subroutine FieldAdd
+  ! computes in place the sum of two scalar fields
+  !
+  !   u = c1 * u + c2 * v
+  !
+  ! the function is useful to add fields of different sizes.
+  !
+  ! sylvain barbot (07/27/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE fieldadd(u,v,sx1,sx2,sx3,c1,c2)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: u
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
+    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
+
+    IF (PRESENT(c1)) THEN
+       IF (PRESENT(c2)) THEN
+          u=c1*u+c2*v
+       ELSE
+          u=c1*u+v
+       END IF
+    ELSE
+       IF (PRESENT(c2)) THEN
+          u=u+c2*v
+       ELSE
+          u=u+v
+       END IF
+    END IF
+
+  END SUBROUTINE fieldadd
+
+  !-----------------------------------------------------------------
+  ! subroutine FieldRep
+  !
+  !   u = c1 * v
+  !
+  ! the function is useful to add fields of different sizes.
+  !
+  ! sylvain barbot (07/27/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE fieldrep(u,v,sx1,sx2,sx3,c1)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: u
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
+    REAL*4, INTENT(IN), OPTIONAL :: c1
+
+    IF (PRESENT(c1)) THEN
+       u=u+c1*v
+    ELSE
+       u=v
+    END IF
+    
+  END SUBROUTINE fieldrep
+
+  !-----------------------------------------------------------------
+  ! subroutine SliveAdd
+  ! computes in place the sum of two scalar fields
+  !
+  !   u = c1 * u + c2 * v
+  !
+  ! the function is useful to add fields of different sizes.
+  !
+  ! sylvain barbot (10/24/08) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE sliceadd(u,v,sx1,sx2,sx3,index,c1,c2)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,index
+    REAL*4, INTENT(INOUT), DIMENSION(sx1,sx2) :: u
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: v
+    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
+
+    IF (PRESENT(c1)) THEN
+       IF (PRESENT(c2)) THEN
+          u=c1*u+c2*v(:,:,index)
+       ELSE
+          u=c1*u+v(:,:,index)
+       END IF
+    ELSE
+       IF (PRESENT(c2)) THEN
+          u=u+c2*v(:,:,index)
+       ELSE
+          u=u+v(:,:,index)
+       END IF
+    END IF
+
+  END SUBROUTINE sliceadd
+
+  !-----------------------------------------------------------------
+  !> subroutine TensorFieldAdd
+  !! computes the linear combination of two tensor fields
+  !!
+  !!     t1 = c1 * t1 + c2 * t2
+  !!
+  !! where t1 and t2 are two tensor fields and c1 and c2 are scalars.
+  !! only tensor field t1 is modified.
+  !
+  ! sylvain barbot (07/27/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE tensorfieldadd(t1,t2,sx1,sx2,sx3,c1,c2)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: t1
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: t2
+    REAL*4, INTENT(IN), OPTIONAL :: c1,c2
+
+    INTEGER :: i1,i2,i3
+
+    IF (PRESENT(c1)) THEN
+       IF (PRESENT(c2)) THEN
+          IF (0._4 .eq. c1) THEN
+             IF (0._4 .eq. c2) THEN
+                DO 05 i3=1,sx3; DO 05 i2=1,sx2; DO 05 i1=1,sx1
+                   t1(i1,i2,i3)=TENSOR(0._4,0._4,0._4,0._4,0._4,0._4)
+05                 CONTINUE
+             ELSE
+                DO 10 i3=1,sx3; DO 10 i2=1,sx2; DO 10 i1=1,sx1
+                   t1(i1,i2,i3)=c2 .times. t2(i1,i2,i3)
+10                 CONTINUE
+                END IF
+          ELSE
+             DO 20 i3=1,sx3; DO 20 i2=1,sx2; DO 20 i1=1,sx1
+                t1(i1,i2,i3)=(c1 .times. t1(i1,i2,i3)) .plus. &
+                             (c2 .times. t2(i1,i2,i3))
+20           CONTINUE
+          END IF
+       ELSE
+          DO 30 i3=1,sx3; DO 30 i2=1,sx2; DO 30 i1=1,sx1
+             t1(i1,i2,i3)=(c1 .times. t1(i1,i2,i3)) .plus. t2(i1,i2,i3)
+30           CONTINUE
+       END IF
+    ELSE
+       IF (PRESENT(c2)) THEN
+          DO 40 i3=1,sx3; DO 40 i2=1,sx2; DO 40 i1=1,sx1
+             t1(i1,i2,i3)=t1(i1,i2,i3) .plus. (c2 .times. t2(i1,i2,i3))
+40        CONTINUE
+       ELSE
+          DO 50 i3=1,sx3; DO 50 i2=1,sx2; DO 50 i1=1,sx1
+             t1(i1,i2,i3)=t2(i1,i2,i3) .plus. t2(i1,i2,i3)
+50        CONTINUE
+       END IF
+    END IF
+
+  END SUBROUTINE tensorfieldadd
+
+
+  !-----------------------------------------------------------------
+  ! subroutine TensorIntegrate
+  ! computes a numercial integration with numerical viscosity
+  !
+  !    T^(n+1)_i = (T^n_(i-1)+T^n_(i+1))/2 + dt * S^n_i
+  !
+  ! instead of
+  !
+  !    T^(n+1)_i = T^n_i + dt * S^n_i
+  !
+  ! implementation is just generalized for a 3-dimensional field.
+  !
+  ! sylvain barbot (07/27/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE tensorintegrate(T,S,sx1,sx2,sx3,dt)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: T
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: S
+    REAL*8, INTENT(IN) :: dt
+
+    INTEGER :: i1,i2,i3,i1m,i2m,i3m,i1p,i2p,i3p
+
+    DO i3=1,sx3
+       i3m=mod(sx3+i3-2,sx3)+1
+       i3p=mod(i3,sx3)+1
+       DO i2=1,sx2
+          i2m=mod(sx2+i2-2,sx2)+1
+          i2p=mod(i2,sx2)+1
+          DO i1=1,sx1
+             i1m=mod(sx1+i1-2,sx1)+1
+             i1p=mod(i1,sx1)+1
+             
+             T(i1,i2,i3)=( &
+                  (1._4/6._4) .times. (T(i1m,i2,i3) .plus. T(i1p,i2,i3) &
+                  .plus. T(i1,i2m,i3) .plus. T(i1,i2p,i3) &
+                  .plus. T(i1,i2,i3m) .plus. T(i1,i2,i3p))) &
+                  .plus. &
+                  (REAL(dt) .times. S(i1,i2,i3))
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE tensorintegrate
+
+  !---------------------------------------------------------------------
+  !> subroutine coordinates computes the xi coordinates from the
+  !! array index and sampling interval
+  !---------------------------------------------------------------------
+  SUBROUTINE coordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    REAL*8, INTENT(OUT) :: x1,x2,x3
+    
+    x1=DBLE(i1-sx1/2-1)*dx1
+    x2=DBLE(i2-sx2/2-1)*dx2
+    x3=DBLE(i3-sx3/2-1)*dx3
+  END SUBROUTINE coordinates
+
+  !---------------------------------------------------------------------
+  !> subroutine ShiftedCoordinates
+  !! computes the xi coordinates from the array index and sampling
+  !! interval assuming data is order like fftshift.
+  !!
+  !! \author sylvain barbot (07/31/07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,x1,x2,x3)
+    INTEGER, INTENT(IN) :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    REAL*8, INTENT(OUT) :: x1,x2,x3
+
+    IF (i1 .LE. sx1/2) THEN
+       x1=DBLE(i1-1)*dx1
+    ELSE
+       x1=DBLE(i1-sx1-1)*dx1
+    END IF
+    IF (i2 .LE. sx2/2) THEN
+       x2=DBLE(i2-1)*dx2
+    ELSE
+       x2=DBLE(i2-sx2-1)*dx2
+    END IF
+    IF (i3 .LE. sx3/2) THEN
+       x3=DBLE(i3-1)*dx3
+    ELSE
+       x3=DBLE(i3-sx3-1)*dx3
+    END IF
+
+  END SUBROUTINE shiftedcoordinates
+
+  !----------------------------------------------------------------------
+  !> subroutine ShiftedIndex
+  !! returns the integer index corresponding to the specified coordinates
+  !! assuming the data are ordered following fftshift. input coordinates
+  !! are assumed bounded -sx/2 <= x <= sx/2-1. out of bound input
+  !! purposefully triggers a fatal error. in the x3 direction, coordinates
+  !! are assumed bounded by 0 <= x3 <= (sx3-1)*dx3
+  !!
+  !! CALLED BY:
+  !!   monitorfield/sample
+  !!
+  !! \author sylvain barbot (07/31/07) - original form
+  !----------------------------------------------------------------------
+  SUBROUTINE shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+    REAL*8, INTENT(IN) :: x1,x2,x3,dx1,dx2,dx3
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    INTEGER, INTENT(OUT) :: i1,i2,i3
+
+    IF (x1 .gt.  DBLE(sx1/2-1)*dx1) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("x1=",ES9.2E2,"; boundary at x1=",ES9.2E2)') x1, DBLE(sx1/2)*dx1
+       STOP "ShiftedIndex:invalid x1 coordinates (x1 too large)"
+    END IF
+    IF (x1 .lt. -DBLE(sx1/2)*dx1  ) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("x1=",ES9.2E2,"; boundary at x1=",ES9.2E2)') x1, -DBLE(sx1/2)*dx1
+       STOP "ShiftedIndex:coordinates out of range (-x1 too large)"
+    END IF
+    IF (x2 .gt.  DBLE(sx2/2-1)*dx2) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("x2=",ES9.2E2,"; boundary at x2=",ES9.2E2)') x2, DBLE(sx2/2)*dx2
+       STOP "ShiftedIndex:invalid x2 coordinates (x2 too large)"
+    END IF
+    IF (x2 .lt. -DBLE(sx2/2)*dx2  ) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("x2=",ES9.2E2,"; boundary at x2=",ES9.2E2)') x2, -DBLE(sx2/2)*dx2
+       STOP "ShiftedIndex:coordinates out of range (-x2 too large)"
+    END IF
+    IF (x3 .gt.  DBLE(sx3-1)*dx3) THEN
+       WRITE_DEBUG_INFO
+       STOP "ShiftedIndex:invalid x3 coordinates (x3 too large)"
+    END IF
+    IF (x3 .lt.  0              )   THEN
+       WRITE (0,'("x3=",ES9.2E2)') x3
+       STOP "ShiftedIndex:coordinates out of range (x3 negative)"
+    END IF
+
+    i1=MOD(sx1+fix(x1/dx1),sx1)+1
+    i2=MOD(sx2+fix(x2/dx2),sx2)+1
+    i3=fix(x3/dx3)+1
+
+  END SUBROUTINE shiftedindex
+
+  !-----------------------------------------------------------------
+  ! subroutine ExportSlice
+  ! computes the value of a scalar field at a horizontal plane.
+  ! the field if shifted such as the (0,0) coordinate is in the 
+  ! middle of the array at (sx1/2+1,sx2/2+1).
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE exportslice(field,odepth,dx1,dx2,dx3,s)
+    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: field
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,odepth
+    REAL*4, INTENT(OUT), DIMENSION(:,:) :: s
+    
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8 :: k3
+    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
+    COMPLEX*8 :: sum,exp3
+    REAL*4 :: exp1,exp2
+  
+    sx1=SIZE(field,1)-2
+    sx2=SIZE(field,2)
+    sx3=SIZE(field,3)
+    
+    s=0
+    DO i3=1,sx3
+       CALL wavenumber3(i3,sx3,dx3,k3)
+       exp3=exp(i*k3*odepth)
+       DO i2=1,sx2
+          DO i1=1,sx1/2+1
+             sum=CMPLX(field(2*i1-1,i2,i3),field(2*i1,i2,i3))*exp3
+             s(2*i1-1:2*i1,i2)=s(2*i1-1:2*i1,i2)+(/REAL(sum),AIMAG(sum)/)
+          END DO
+       END DO
+    END DO
+    s=s/(sx3*dx3)
+    
+    !fftshift
+    DO i2=1,sx2
+       IF (i2 < sx2/2+1) THEN
+          exp2= (i2-1._4)
+       ELSE
+          exp2=-(sx2-i2+1._4)
+       END IF
+       DO i1=1,sx1/2+1
+          exp1=i1-1._4
+          sum=CMPLX(s(2*i1-1,i2),s(2*i1,i2))*((-1._4)**(exp1+exp2))
+          s(2*i1-1:2*i1,i2)=(/REAL(sum),AIMAG(sum)/)
+       END DO
+    END DO
+    CALL fft2(s,sx1,sx2,dx1,dx2,FFT_INVERSE)
+    
+  END SUBROUTINE exportslice
+
+  !-----------------------------------------------------------------
+  !> subroutine ExportSpatial
+  !! transfer a horizontal layer from array 'data' to smaller array
+  !! 'p' and shift center position so that coordinates (0,0) are in
+  !! center of array 'p'. optional parameter 'doflip' generates
+  !! output compatible with grd binary format.
+  !
+  ! sylvain barbot (07/09/07) - original form
+  !                (03/19/08) - compatibility with grd output
+  !-----------------------------------------------------------------
+  SUBROUTINE exportspatial(data,sx1,sx2,p,doflip)
+    INTEGER, INTENT(IN) :: sx1,sx2
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2) :: data
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
+#endif
+    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p
+    LOGICAL, INTENT(IN), OPTIONAL :: doflip
+
+    INTEGER :: i1,i2,i1s,i2s
+    LOGICAL :: flip
+
+    IF (PRESENT(doflip)) THEN
+       flip=doflip
+    ELSE
+       flip=.false.
+    END IF
+
+    DO i2=1,sx2
+       IF (i2 .LE. sx2/2) THEN
+          i2s=sx2/2+i2
+       ELSE
+          i2s=i2-sx2/2
+       END IF
+       DO i1=1,sx1
+          IF (i1 .LE. sx1/2) THEN
+             i1s=sx1/2+i1
+          ELSE
+             i1s=i1-sx1/2
+          END IF
+
+          IF (flip) THEN
+             p(i2s,sx1-i1s+1)=data(i1,i2)
+          ELSE
+             p(i1s,i2s)=data(i1,i2)
+          END IF
+
+       END DO
+    END DO
+
+  END SUBROUTINE exportspatial
+
+END MODULE elastic3d
diff -r 405d8f4fa05f -r e7295294f654 src/export.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/export.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,2478 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+#include "include.f90"
+
+MODULE export
+
+  USE elastic3d
+  USE viscoelastic3d
+  USE friction3d
+
+  IMPLICIT NONE
+
+  PRIVATE xyzwrite
+  PRIVATE geoxyzwrite
+
+CONTAINS
+
+  !-------------------------------------------------------------------
+  ! routine ReportTime
+  ! writes the times of exports
+  !
+  ! sylvain barbot (04/29/09) - original form
+  !-------------------------------------------------------------------
+  SUBROUTINE reporttime(i,t,repfile)
+    INTEGER, INTENT(IN) :: i
+    CHARACTER(80), INTENT(IN) :: repfile
+    REAL*8, INTENT(IN) :: t
+
+    INTEGER :: iostatus
+
+    IF (0 .eq. i) THEN
+       OPEN (UNIT=15,FILE=repfile,IOSTAT=iostatus,FORM="FORMATTED")
+    ELSE
+       OPEN (UNIT=15,FILE=repfile,POSITION="APPEND",&
+            IOSTAT=iostatus,FORM="FORMATTED")
+    END IF
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', repfile
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'(ES11.3E2)') t
+
+    CLOSE(15)
+
+  END SUBROUTINE reporttime
+
+  SUBROUTINE report(i,t,file1,file2,file3,sx1,sx2,repfile)
+    INTEGER, INTENT(IN) :: i,sx1,sx2
+    CHARACTER(80), INTENT(IN) :: file1,file2,file3,repfile
+    REAL*8, INTENT(IN) :: t
+
+    INTEGER :: iostatus, ind1,ind2,ind3
+
+    IF (0 .eq. i) THEN
+       OPEN (UNIT=15,FILE=repfile,IOSTAT=iostatus,FORM="FORMATTED")
+    ELSE
+       OPEN (UNIT=15,FILE=repfile,POSITION="APPEND",&
+            IOSTAT=iostatus,FORM="FORMATTED")
+    END IF
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', repfile
+       STOP "could not open file for export"
+    END IF
+
+    ind1=INDEX(file1," ")
+    ind2=INDEX(file2," ")
+    ind3=INDEX(file3," ")
+    WRITE (15,'(I3.3,2I6," ",f13.4," ",a," ",a," ",a)') i,sx1,sx2,t,&
+         file1(1:ind1-1),file2(1:ind2-1),file3(1:ind3-1)
+
+    CLOSE(15)
+
+  END SUBROUTINE report
+
+  SUBROUTINE export2d(data,sx1,sx2,filename)
+    INTEGER, INTENT(IN) :: sx1,sx2
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
+    CHARACTER(80), INTENT(IN) :: filename
+
+    INTEGER :: iostatus,i1,i2
+    CHARACTER(15) :: form
+    CHARACTER(5) :: digit
+
+    WRITE (digit,'(I5.5)') sx1
+    form="("//digit//"ES11.3E2)"
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,form) ((data(i1,i2), i1=1,sx1), i2=1,sx2)
+    CLOSE(15)
+
+  END SUBROUTINE export2d
+
+  !------------------------------------------------------------------
+  ! subroutine geoxyzwrite
+  !
+  ! sylvain barbot (22/05/10) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE geoxyzwrite(x,y,z,sx1,sx2,filename)
+    INTEGER, INTENT(IN) :: sx1,sx2
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: z
+    REAL*8, INTENT(IN), DIMENSION(sx1,sx2) :: x,y
+    CHARACTER(80), INTENT(IN) :: filename
+
+    INTEGER :: iostatus,i1,i2
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) STOP "could not open file for proj export"
+
+    DO i2=1,sx2
+       DO i1=1,sx1
+          WRITE (15,'(ES15.8E1,ES15.8E1,ES11.3E2)'), &
+                 x(i1,i2),y(i1,i2),z(i1,i2)
+       END DO
+    END DO
+    CLOSE(15)
+
+  END SUBROUTINE geoxyzwrite
+
+  !------------------------------------------------------------------
+  ! subroutine xyzwrite
+  !
+  ! sylvain barbot (06/10/09) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE xyzwrite(data,sx1,sx2,dx1,dx2,filename)
+    INTEGER, INTENT(IN) :: sx1,sx2
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2) :: data
+    CHARACTER(80), INTENT(IN) :: filename
+    REAL*8 :: dx1,dx2
+
+    INTEGER :: iostatus,i1,i2
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) STOP "could not open file for export"
+
+    DO i2=1,sx2
+       DO i1=1,sx1
+          !x1=(mod(sx1/2+i1-1,sx1)-sx1/2)*dx1
+          !x2=(mod(sx2/2+i2-1,sx2)-sx2/2)*dx2
+          WRITE (15,'(ES11.3E2,ES11.3E2,ES11.3E2)'), &
+                DBLE(i2-1-sx2/2)*dx2,DBLE(i1-1-sx1/2)*dx1,data(i1,i2)
+       END DO
+    END DO
+    CLOSE(15)
+
+  END SUBROUTINE xyzwrite
+
+#ifdef PROJ
+  !------------------------------------------------------------------
+  !> subroutine ExportStressPROJ
+  !! export a map view of stress with coordinates in 
+  !! longitude/latitude. Text format output is the GMT-compatible
+  !! .xyz file format where data in each file is organized as follows
+  !!
+  !! longitude latitude s11 
+  !! longitude latitude s12
+  !! longitude latitude s13
+  !! longitude latitude s22
+  !! longitude latitude s23
+  !! longitude latitude s33
+  !!
+  !! this is an interface to exportproj.
+  !!
+  !! \author sylvain barbot (05/22/10) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportstressproj(sig,sx1,sx2,sx3,dx1,dx2,dx3,oz, &
+                              x0,y0,lon0,lat0,zone,scale,wdir,index)
+    INTEGER, INTENT(IN) :: index,sx1,sx2,sx3,zone
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3,x0,y0,lon0,lat0,scale
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
+    INTEGER :: iostatus,i,j,k,l
+
+    ALLOCATE(t1(sx1+2,sx2),t2(sx1+2,sx2),t3(sx1+2,sx2),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for grid export"
+
+    k=fix(oz/dx3)+1
+    DO j=1,sx2
+       DO i=1,sx1
+#ifdef ALIGN_DATA
+          l=(j-1)*(sx1+2)+i
+#else
+          l=(j-1)*sx1+i
+#endif
+          t1(l,1)=sig(i,j,k)%s11
+          t2(l,1)=sig(i,j,k)%s12
+          t3(l,1)=sig(i,j,k)%s13
+       END DO
+    END DO
+
+    CALL exportproj(t1,t2,t3,sx1,sx2,1,dx1,dx2,dx3,0._8, &
+                  x0,y0,lon0,lat0,zone,scale,wdir,index,convention=4)
+
+    DO j=1,sx2
+       DO i=1,sx1
+#ifdef ALIGN_DATA
+          l=(j-1)*(sx1+2)+i
+#else
+          l=(j-1)*sx1+i
+#endif
+          t1(l,1)=sig(i,j,k)%s22
+          t2(l,1)=sig(i,j,k)%s23
+          t3(l,1)=sig(i,j,k)%s33
+       END DO
+    END DO
+
+    CALL exportproj(t1,t2,t3,sx1,sx2,1,dx1,dx2,dx3,0._8, &
+                  x0,y0,lon0,lat0,zone,scale,wdir,index,convention=5)
+
+    DEALLOCATE(t1,t2,t3)
+
+  END SUBROUTINE exportstressproj
+
+  !------------------------------------------------------------------
+  !> subroutine ExportPROJ
+  !! export a map view of displacements with coordinates in 
+  !! longitude/latitude. Text format output is the GMT-compatible
+  !! .xyz file format where data in each file is organized as follows
+  !!
+  !! longitude latitude u1, 
+  !! longitude latitude u2 and 
+  !! longitude latitude -u3
+  !!
+  !! for index-geo-north.xyz, 
+  !!     index-geo-east.xyz and 
+  !!     index-geo-up.xyz, respectively.
+  !!
+  !! \author sylvain barbot (05/22/10) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportproj(c1,c2,c3,sx1,sx2,sx3,dx1,dx2,dx3,oz, &
+                        x0,y0,lon0,lat0,zone,scale,wdir,i,convention)
+    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3,zone
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+#endif
+    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3,x0,y0,lon0,lat0,scale
+    CHARACTER(80), INTENT(IN) :: wdir
+    INTEGER, INTENT(IN), OPTIONAL :: convention
+
+    INTEGER :: iostatus,i1,i2,pos,conv
+    CHARACTER(3) :: digit
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: x,y
+    CHARACTER(80) :: file1,file2,file3
+    REAL*8 :: lon1,lat1
+
+    IF (PRESENT(convention)) THEN
+       conv=convention
+    ELSE
+       conv=1
+    END IF
+
+    lon1=lon0
+    lat1=lat0
+
+    ALLOCATE(t1(sx1,sx2),t2(sx1,sx2),t3(sx1,sx2), &
+             x(sx1,sx2),y(sx1,sx2),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for export"
+
+    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,t1)
+    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,t2)
+    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,t3)
+    t3=-t3
+
+    ! grid coordinates (x=easting, y=northing)
+    DO i2=1,sx2
+       DO i1=1,sx1
+          y(i1,i2)=(i1-sx1/2)*(dx1*scale)+x0
+          x(i1,i2)=(i2-sx2/2)*(dx2*scale)+y0
+       END DO
+    END DO
+    CALL proj(x,y,sx1*sx2,lon1,lat1,zone)
+
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+    SELECT CASE(conv)
+    CASE (1) ! cumulative displacement
+       file1=wdir(1:pos-1) // "/" // digit // "-geo-north.xyz"
+       file2=wdir(1:pos-1) // "/" // digit // "-geo-east.xyz"
+       file3=wdir(1:pos-1) // "/" // digit // "-geo-up.xyz"
+    CASE (2) ! postseismic displacement
+       file1=wdir(1:pos-1) // "/" // digit // "-relax-geo-north.xyz"
+       file2=wdir(1:pos-1) // "/" // digit // "-relax-geo-east.xyz"
+       file3=wdir(1:pos-1) // "/" // digit // "-relax-geo-up.xyz"
+    CASE (3) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-north.xyz"
+       file2=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-east.xyz"
+       file3=wdir(1:pos-1) // "/" // digit // "-eqbf-geo-up.xyz"
+    CASE (4) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-geo-s11.xyz"
+       file2=wdir(1:pos-1) // "/" // digit // "-geo-s12.xyz"
+       file3=wdir(1:pos-1) // "/" // digit // "-geo-s13.xyz"
+    CASE (5) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-geo-s22.xyz"
+       file2=wdir(1:pos-1) // "/" // digit // "-geo-s23.xyz"
+       file3=wdir(1:pos-1) // "/" // digit // "-geo-s33.xyz"
+    END SELECT
+    
+    CALL geoxyzwrite(x,y,t1,sx1,sx2,file1)
+    CALL geoxyzwrite(x,y,t2,sx1,sx2,file2)
+    CALL geoxyzwrite(x,y,t3,sx1,sx2,file3)
+
+    DEALLOCATE(t1,t2,t3)
+
+  END SUBROUTINE exportproj
+#endif
+
+#ifdef XYZ
+  !------------------------------------------------------------------
+  !> subroutine ExportXYZ
+  !! export a map view of surface displacement into the GMT-compatible
+  !! .xyz file format where data in each file is organized as follows
+  !!
+  !! x1 x2 u1, x1 x2 u2 and x1 x2 -u3
+  !!
+  !! for index-north.xyz, index-east.xyz and index-up.xyz, 
+  !! respectively.
+  !!
+  !! \author sylvain barbot (06/10/09) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportxyz(c1,c2,c3,sx1,sx2,sx3,oz,dx1,dx2,dx3,i,wdir)
+    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+#endif
+    REAL*8, INTENT(IN) :: oz,dx1,dx2,dx3
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    INTEGER :: iostatus,pos
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
+    CHARACTER(80) :: file1,file2,file3
+    CHARACTER(3) :: digit
+
+    ALLOCATE(temp1(sx1,sx2),temp2(sx1,sx2),temp3(sx1,sx2),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for export"
+
+    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1)
+    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2)
+    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3)
+    temp3=-temp3
+
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+    file1=wdir(1:pos-1) // "/" // digit // "-north.xyz"
+    file2=wdir(1:pos-1) // "/" // digit // "-east.xyz"
+    file3=wdir(1:pos-1) // "/" // digit // "-up.xyz"
+
+    CALL xyzwrite(temp1,sx1,sx2,dx1,dx2,file1)
+    CALL xyzwrite(temp2,sx1,sx2,dx1,dx2,file2)
+    CALL xyzwrite(temp3,sx1,sx2,dx1,dx2,file3)
+
+    DEALLOCATE(temp1,temp2,temp3)
+
+  END SUBROUTINE exportxyz
+#endif
+
+#ifdef TXT
+  !------------------------------------------------------------------
+  ! subroutine ExportTXT
+  ! exports a horizontal slice of uniform depth into specified text
+  ! files and adds filenames in the report file.
+  ! if i is set to 0, the report file is reinitiated.
+  ! input data c1,c2,c3 are in the space domain.
+  !------------------------------------------------------------------
+  SUBROUTINE exporttxt(c1,c2,c3,sx1,sx2,sx3,oz,dx3,i,time,wdir,reportfilename)
+    INTEGER, INTENT(IN) :: i,sx1,sx2,sx3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+#endif
+    REAL*8, INTENT(IN) :: oz,dx3,time
+    CHARACTER(80), INTENT(IN) :: wdir,reportfilename
+
+    INTEGER :: iostatus,pos
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
+    CHARACTER(3) :: digit
+    CHARACTER(80) :: file1,file2,file3
+    
+    ALLOCATE(temp1(sx1,sx2),temp2(sx1,sx2),temp3(sx1,sx2),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for export"
+
+    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1)
+    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2)
+    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3)
+
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+    file1=wdir(1:pos-1) // "/" // digit // "-u1.txt"
+    file2=wdir(1:pos-1) // "/" // digit // "-u2.txt"
+    file3=wdir(1:pos-1) // "/" // digit // "-u3.txt"
+    
+    CALL export2d(temp1,sx1,sx2,file1)
+    CALL export2d(temp2,sx1,sx2,file2)
+    CALL export2d(temp3,sx1,sx2,file3)
+    
+    file1=digit // "-u1.txt "
+    file2=digit // "-u2.txt "
+    file3=digit // "-u3.txt "
+    CALL report(i,time,file1,file2,file3,sx1,sx2,reportfilename)
+
+    DEALLOCATE(temp1,temp2,temp3)
+
+  END SUBROUTINE exporttxt
+#endif
+
+  !------------------------------------------------------------------
+  !> subroutine exportpoints
+  !! sample a vector field at a series of points for export.
+  !! each location is attributed a file in which the time evolution
+  !! of the vector value is listed in the format:
+  !!
+  !!                t_0 u(t_0) v(t_0) w(t_0)
+  !!                t_1 u(t_1) v(t_1) w(t_1)
+  !!                ...
+  !!
+  !! \author sylvain barbot (11/10/07) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportpoints(c1,c2,c3,sig,sx1,sx2,sx3,dx1,dx2,dx3, &
+       opts,ptsname,time,wdir,isnew,x0,y0,rot)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+#endif
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(VECTOR_STRUCT), INTENT(IN), DIMENSION(:) :: opts
+    CHARACTER(LEN=4), INTENT(IN), DIMENSION(:) :: ptsname
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,time,x0,y0,rot
+    CHARACTER(80), INTENT(IN) :: wdir
+    LOGICAL, INTENT(IN) :: isnew
+
+    INTEGER :: i1,i2,i3,n,k
+    REAL*8 :: u1,u2,u3,v1,v2,v3,x1,x2,x3,y1,y2,y3
+    TYPE(TENSOR) :: lsig
+    INTEGER :: i,iostatus
+    CHARACTER(80) :: file1,file2
+
+    i=INDEX(wdir," ")
+    n=SIZE(ptsname)
+
+    DO k=1,n
+       file1=wdir(1:i-1) // "/" // ptsname(k) // ".txt"
+       file2=wdir(1:i-1) // "/" // ptsname(k) // ".c.txt"
+
+       IF (isnew) THEN
+          OPEN (UNIT=15,FILE=file1,IOSTAT=iostatus,FORM="FORMATTED")
+          WRITE (15,'("#         t         u1         u2         u3        ", &
+                      "s11        s12        s13        s22        s23        s33")')
+          OPEN (UNIT=16,FILE=file2,IOSTAT=iostatus,FORM="FORMATTED")
+       ELSE
+          OPEN (UNIT=15,FILE=file1,POSITION="APPEND",&
+               IOSTAT=iostatus,FORM="FORMATTED")
+          OPEN (UNIT=16,FILE=file2,POSITION="APPEND",&
+               IOSTAT=iostatus,FORM="FORMATTED")
+       END IF
+       IF (iostatus>0) STOP "could not open point file for writing"
+
+       x1=opts(k)%v1
+       x2=opts(k)%v2
+       x3=opts(k)%v3
+
+       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+
+       u1=c1(i1,i2,i3)
+       u2=c2(i1,i2,i3)
+       u3=c3(i1,i2,i3)
+       lsig=sig(i1,i2,i3)
+
+       ! change from computational reference frame to user reference system
+       y1=x1;v1=u1
+       y2=x2;v2=u2
+       y3=x3;v3=u3
+
+       CALL rotation(y1,y2,-rot)
+       y1=y1+x0
+       y2=y2+y0
+       CALL rotation(v1,v2,-rot)
+
+       x1=x1+x0
+       x2=x2+y0
+
+       WRITE (15,'(13ES11.3E2)') time,v1,v2,v3, &
+                                 lsig%s11,lsig%s12,lsig%s13, &
+                                 lsig%s22,lsig%s23,lsig%s33
+       WRITE (16,'(7ES11.3E2)') x1,x2,x3,time,u1,u2,u3
+
+       CLOSE(15)
+       CLOSE(16)
+    END DO
+
+  CONTAINS
+
+    !------------------------------------------------------------------
+    ! subroutine Rotation
+    ! rotates a point coordinate into the computational reference
+    ! system.
+    ! 
+    ! sylvain barbot (04/16/09) - original form
+    !------------------------------------------------------------------
+    SUBROUTINE rotation(x,y,rot)
+      REAL*8, INTENT(INOUT) :: x,y
+      REAL*8, INTENT(IN) :: rot
+
+      REAL*8 :: alpha,xx,yy
+      REAL*8, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
+
+
+      alpha=rot*DEG2RAD
+      xx=x
+      yy=y
+
+      x=+xx*cos(alpha)+yy*sin(alpha)
+      y=-xx*sin(alpha)+yy*cos(alpha)
+
+    END SUBROUTINE rotation
+
+  END SUBROUTINE exportpoints
+
+  !---------------------------------------------------------------------
+  !> subroutine exportoptsdat
+  !! export the coordinates and name of the observation points (often
+  !! coordinates of GPS instruments or such) for display with GMT in the
+  !! ASCII format. The file contains a list of x1,x2,x3 coordinates and
+  !! a 4-character name string.
+  !!
+  !! input variables
+  !! @param n          - number of observation points
+  !! @param opts       - coordinates of observation points
+  !! @param ptsname    - name of obs. points
+  !! @param filename   - output file (example: wdir/opts.xy)
+  !!
+  !! \author sylvain barbot (08/10/11) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE exportoptsdat(n,opts,ptsname,filename)
+    INTEGER, INTENT(IN) :: n
+    TYPE(VECTOR_STRUCT), DIMENSION(n) :: opts
+    CHARACTER(LEN=4), DIMENSION(n) :: ptsname
+    CHARACTER(80) :: filename
+
+    INTEGER :: k,iostatus
+
+    IF (n.LE.0) RETURN
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) STOP "could not open .xy file to export observation points"
+    DO k=1,n
+       WRITE (15,'(3ES11.4E1,X,a)') opts(k)%v1,opts(k)%v2,opts(k)%v3,ptsname(k)
+    END DO
+    CLOSE(15)
+    
+  END SUBROUTINE exportoptsdat
+    
+  !---------------------------------------------------------------------
+  !> subroutine exportPlaneStress
+  !! samples the value of an input tensor field at the location of 
+  !! defined plane (position, strike, dip, length and width).
+  !!
+  !! input variables
+  !! @param sig        - sampled tensor array
+  !! @param nop        - number of observation planes
+  !! @param op         - structure of observation planes (position, orientation)
+  !! @param x0, y0 - origin position of coordinate system
+  !! @param dx1,2,3    - sampling size
+  !! @param sx1,2,3    - size of the scalar field
+  !! @param wdir       - output directory for writing
+  !! @param i          - loop index to suffix file names
+  !!
+  !! creates files 
+  !!
+  !!    wdir/index.s00001.estrain.txt with TXT_EXPORTEIGENSTRAIN option
+  !!
+  !!    wdir/index.s00001.estrain.grd with GRD_EXPORTEIGENSTRAIN option
+  !! 
+  !! \author sylvain barbot (01/01/07) - original form
+  !                         (02/25/10) - output in TXT and GRD formats
+  !---------------------------------------------------------------------
+  SUBROUTINE exportplanestress(sig,nop,op,x0,y0,dx1,dx2,dx3,sx1,sx2,sx3,wdir,i)
+    INTEGER, INTENT(IN) :: nop,sx1,sx2,sx3,i
+    TYPE(PLANE_STRUCT), INTENT(IN), DIMENSION(nop) :: op
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    INTEGER :: k,ns1,ns2
+    TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: slippatch
+    CHARACTER(3) :: sdigit
+    CHARACTER(3) :: digit
+#ifdef TXT_EXPORTEIGENSTRAIN
+    INTEGER :: iostatus,i1,i2
+    CHARACTER(80) :: outfiletxt
+#endif
+!#_indef GRD_EXPORTEIGENSTRAIN
+    CHARACTER(80) :: fn11,fn12,fn13,fn22,fn23,fn33
+    INTEGER :: j,iostat,j1,j2
+    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp11,temp12,temp13, &
+                                           temp22,temp23,temp33
+    REAL*8 :: rland=9998.,rdum=9999.
+    REAL*8 :: xmin,ymin
+    CHARACTER(80) :: title="monitor tensor field "
+!#_endif
+
+    IF (nop .le. 0) RETURN
+
+    WRITE (digit,'(I3.3)') i
+
+    DO k=1,nop
+       CALL monitorstressfield(op(k)%x,op(k)%y,op(k)%z, &
+            op(k)%width,op(k)%length,op(k)%strike,op(k)%dip, &
+            0._8,sx1,sx2,sx3,dx1,dx2,dx3,sig,slippatch)
+
+       IF (.NOT. ALLOCATED(slippatch)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,'("could not monitor slip")')
+          STOP 2
+       END IF
+
+       ns1=SIZE(slippatch,1)
+       ns2=SIZE(slippatch,2)
+          
+       slippatch(:,:)%x1=slippatch(:,:)%x1+x0
+       slippatch(:,:)%x2=slippatch(:,:)%x2+y0
+
+       WRITE (sdigit,'(I3.3)') k
+
+!#_ifdef GRD_EXPORTEIGENSTRAIN
+       fn11=trim(wdir)//"/"//digit//".op"//sdigit//"-s11.grd"
+       fn12=trim(wdir)//"/"//digit//".op"//sdigit//"-s12.grd"
+       fn13=trim(wdir)//"/"//digit//".op"//sdigit//"-s13.grd"
+       fn22=trim(wdir)//"/"//digit//".op"//sdigit//"-s22.grd"
+       fn23=trim(wdir)//"/"//digit//".op"//sdigit//"-s23.grd"
+       fn33=trim(wdir)//"/"//digit//".op"//sdigit//"-s33.grd"
+
+       ! convert to c standard
+       j=INDEX(fn11," ")
+       fn11(j:j)=char(0)
+       fn12(j:j)=char(0)
+       fn13(j:j)=char(0)
+       fn22(j:j)=char(0)
+       fn23(j:j)=char(0)
+       fn33(j:j)=char(0)
+
+       ALLOCATE(temp11(ns1,ns2),temp12(ns1,ns2),temp13(ns1,ns2), &
+                temp22(ns1,ns2),temp23(ns1,ns2),temp33(ns1,ns2),STAT=iostat)
+       IF (iostatus>0) STOP "could not allocate temporary array for GRD slip export."
+
+       DO j2=1,ns2
+          DO j1=1,ns1
+             temp11(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s11
+             temp12(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s12
+             temp13(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s13
+             temp22(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s22
+             temp23(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s23
+             temp33(ns1+1-j1,j2)=slippatch(j1,j2)%sig%s33
+          END DO
+       END DO
+
+       ! xmin is the lowest coordinates (positive eastward in GMT)
+       xmin= MINVAL(slippatch(:,:)%lx)
+       ! ymin is the lowest coordinates (positive northward in GMT)
+       ymin=-MAXVAL(slippatch(:,:)%lz)
+
+       ! call the c function "writegrd_"
+       CALL writegrd(temp11,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn11)
+       CALL writegrd(temp12,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn12)
+       CALL writegrd(temp13,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn13)
+       CALL writegrd(temp22,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn22)
+       CALL writegrd(temp23,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn23)
+       CALL writegrd(temp33,ns1,ns2,ymin,xmin,dx3,dx2,rland,rdum,title,fn33)
+
+       DEALLOCATE(temp11,temp12,temp13,temp22,temp23,temp33)
+
+!#_endif
+
+       DEALLOCATE(slippatch)
+    END DO
+
+END SUBROUTINE exportplanestress
+
+  !---------------------------------------------------------------------
+  !> subroutine exportEigenstrain
+  !! samples the value of an input scalar field at the location of 
+  !! defined plane (position, strike, dip, length and width).
+  !!
+  !! input variables
+  !! @param field      - sampled scalar array
+  !! @param nop        - number of observation planes
+  !! @param op         - structure of observation planes (position, orientation)
+  !! @param x0, y0 - origin position of coordinate system
+  !! @param dx1,2,3    - sampling size
+  !! @param sx1,2,3    - size of the scalar field
+  !! @param wdir       - output directory for writing
+  !! @param i          - loop index to suffix file names
+  !!
+  !! creates files 
+  !!
+  !!    wdir/index.s00001.estrain.txt with TXT_EXPORTEIGENSTRAIN option
+  !!
+  !!    wdir/index.s00001.estrain.grd with GRD_EXPORTEIGENSTRAIN option
+  !! 
+  !! \author sylvain barbot (01/01/07) - original form
+  !                         (02/25/10) - output in TXT and GRD formats
+  !---------------------------------------------------------------------
+  SUBROUTINE exporteigenstrain(field,nop,op,x0,y0,dx1,dx2,dx3,sx1,sx2,sx3,wdir,i)
+    INTEGER, INTENT(IN) :: nop,sx1,sx2,sx3,i
+    TYPE(PLANE_STRUCT), INTENT(IN), DIMENSION(nop) :: op
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: field
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: field
+#endif
+    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    INTEGER :: k,ns1,ns2,pos
+    TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: slippatch
+    CHARACTER(5) :: sdigit
+    CHARACTER(3) :: digit
+#ifdef TXT_EXPORTEIGENSTRAIN
+    INTEGER :: iostatus,i1,i2
+    CHARACTER(80) :: outfiletxt
+#endif
+!#_indef GRD_EXPORTEIGENSTRAIN
+    CHARACTER(80) :: outfilegrd
+    INTEGER :: j,iostat,j1,j2
+    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp
+    REAL*8 :: rland=9998.,rdum=9999.
+    REAL*8 :: xmin,ymin
+    CHARACTER(80) :: title="monitor field "
+!#_endif
+
+    IF (nop .le. 0) RETURN
+
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+
+    DO k=1,nop
+       CALL monitorfield(op(k)%x,op(k)%y,op(k)%z, &
+            op(k)%width,op(k)%length,op(k)%strike,op(k)%dip, &
+            0._8,sx1,sx2,sx3,dx1,dx2,dx3,field,slippatch)
+
+       IF (.NOT. ALLOCATED(slippatch)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,'("could not monitor slip")')
+          STOP 2
+       END IF
+
+       ns1=SIZE(slippatch,1)
+       ns2=SIZE(slippatch,2)
+          
+       slippatch(:,:)%x1=slippatch(:,:)%x1+x0
+       slippatch(:,:)%x2=slippatch(:,:)%x2+y0
+
+       WRITE (sdigit,'(I5.5)') k
+#ifdef TXT_EXPORTEIGENSTRAIN
+       outfiletxt=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".estrain.txt"
+       
+       OPEN (UNIT=15,FILE=outfiletxt,IOSTAT=iostatus,FORM="FORMATTED")
+       IF (iostatus>0) STOP "could not open file for export"
+          
+       WRITE (15,'(6ES11.3E2)') ((slippatch(i1,i2), i1=1,ns1), i2=1,ns2)
+          
+       CLOSE(15)
+#endif
+
+!#_ifdef GRD_EXPORTEIGENSTRAIN
+       outfilegrd=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".estrain.grd"
+
+       ! convert to c standard
+       j=INDEX(outfilegrd," ")
+       outfilegrd(j:j)=char(0)
+
+       ALLOCATE(temp(ns1,ns2),STAT=iostat)
+       IF (iostatus>0) STOP "could not allocate temporary array for GRD slip export."
+
+       DO j2=1,ns2
+          DO j1=1,ns1
+             temp(ns1+1-j1,j2)=slippatch(j1,j2)%slip
+          END DO
+       END DO
+
+       ! xmin is the lowest coordinates (positive eastward in GMT)
+       xmin= MINVAL(slippatch(:,:)%lx)
+       ! ymin is the lowest coordinates (positive northward in GMT)
+       ymin=-MAXVAL(slippatch(:,:)%lz)
+
+       ! call the c function "writegrd_"
+       CALL writegrd(temp,ns1,ns2,ymin,xmin,dx3,dx2, &
+                     rland,rdum,title,outfilegrd)
+
+       DEALLOCATE(temp)
+
+!#_endif
+
+       DEALLOCATE(slippatch)
+    END DO
+
+END SUBROUTINE exporteigenstrain
+
+  !---------------------------------------------------------------------
+  !> subroutine exportCreep
+  !! evaluates the value of creep velocity at the location of 
+  !! defined plane (position, strike, dip, length and width).
+  !!
+  !! input variables
+  !! @param np         - number of frictional planes
+  !! @param n          - array of frictional planes (position, orientation)
+  !! @param structure  - array of depth-dependent frictional properties
+  !! @param x0, y0     - origin position of coordinate system
+  !! @param dx1,2,3    - sampling size
+  !! @param sx1,2,3    - size of the stress tensor field
+  !! @param beta       - smoothing factor controlling the extent of planes
+  !! @param wdir       - output directory for writing
+  !! @param i          - loop index to suffix file names
+  !!
+  !! creates files 
+  !!
+  !!    wdir/index.s00001.creep.txt 
+  !!
+  !! containing
+  !!
+  !!    x,y,z,x',y',sqrt(vx'^2+vy'^2),vx',vy'
+  !!
+  !! with TXT_EXPORTCREEP option and
+  !!
+  !!    wdir/index.s00001.creep-north.grd 
+  !!    wdir/index.s00001.creep-east.grd 
+  !!    wdir/index.s00001.creep-up.grd 
+  !!
+  !! with GRD_EXPORTCREEP option where the suffix -north stands for
+  !! dip slip, -east for strike slip and -up for amplitude of slip.
+  !!
+  !! file wdir/index.s00001.creep.txt is subsampled by a factor "skip"
+  !! compared to the grd files.
+  !! 
+  !! \author sylvain barbot (01/01/07) - original form
+  !!                        (02/25/10) - output in TXT and GRD formats
+  !---------------------------------------------------------------------
+#define TXT_EXPORTCREEP
+  SUBROUTINE exportcreep(np,n,beta,sig,structure, &
+                         sx1,sx2,sx3,dx1,dx2,dx3,x0,y0,wdir,i)
+    INTEGER, INTENT(IN) :: np,sx1,sx2,sx3,i
+    TYPE(PLANE_STRUCT), INTENT(INOUT), DIMENSION(np) :: n
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
+    REAL*8, INTENT(IN) :: x0,y0,dx1,dx2,dx3,beta
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    INTEGER :: k,ns1,ns2,pos
+    CHARACTER(5) :: sdigit
+    CHARACTER(3) :: digit
+#ifdef TXT_EXPORTCREEP
+    CHARACTER(80) :: outfile
+    INTEGER :: skip=3
+#endif
+#ifdef GRD_EXPORTCREEP
+    INTEGER :: j,iostatus,i1,i2
+    REAL*4, ALLOCATABLE, DIMENSION(:,:) :: temp1,temp2,temp3
+    REAL*8 :: rland=9998.,rdum=9999.
+    REAL*8 :: xmin,ymin
+    CHARACTER(80) :: title="monitor field "
+    CHARACTER(80) :: file1,file2,file3
+#endif
+
+    IF (np .le. 0) RETURN
+
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+
+    DO k=1,np
+       CALL monitorfriction(n(k)%x,n(k)%y,n(k)%z, &
+            n(k)%width,n(k)%length,n(k)%strike,n(k)%dip,n(k)%rake,beta, &
+            sx1,sx2,sx3,dx1,dx2,dx3,sig,structure,n(k)%patch)
+
+       ns1=SIZE(n(k)%patch,1)
+       ns2=SIZE(n(k)%patch,2)
+          
+       !patch(:,:)%x1=patch(:,:)%x1+x0
+       !patch(:,:)%x2=patch(:,:)%x2+y0
+
+       WRITE (sdigit,'(I5.5)') k
+#ifdef TXT_EXPORTCREEP
+       outfile=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep.txt"
+       
+       OPEN (UNIT=15,FILE=outfile,IOSTAT=iostatus,FORM="FORMATTED")
+       IF (iostatus>0) STOP "could not open file for export"
+          
+       WRITE (15,'("#        x1         x2         x3          yr        yz", &
+                   "       slip strike-slip  dip-slip")')
+       WRITE (15,'(8ES11.3E2)') ((n(k)%patch(i1,i2), i1=1,ns1,skip), i2=1,ns2,skip)
+          
+       CLOSE(15)
+#endif
+
+#ifdef GRD_EXPORTCREEP
+       file1=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-north.grd"
+       file2=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-east.grd"
+       file3=wdir(1:pos-1)//"/"//digit//".s"//sdigit//".creep-up.grd"
+
+       ! convert to c standard
+       j=INDEX(file1," ")
+       file1(j:j)=char(0)
+       j=INDEX(file2," ")
+       file2(j:j)=char(0)
+       j=INDEX(file3," ")
+       file3(j:j)=char(0)
+
+       ALLOCATE(temp1(ns1,ns2),temp2(ns1,ns2),temp3(ns1,ns2),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate temporary arrays for GRD slip export."
+
+       DO i2=1,ns2
+          DO i1=1,ns1
+             temp1(ns1+1-i1,i2)=n(k)%patch(i1,i2)%ds
+             temp2(ns1+1-i1,i2)=n(k)%patch(i1,i2)%ss
+             temp3(ns1+1-i1,i2)=n(k)%patch(i1,i2)%slip
+          END DO
+       END DO
+
+       ! xmin is the lowest coordinates (positive eastward in GMT)
+       xmin= MINVAL(n(k)%patch(:,:)%lx)
+       ! ymin is the lowest coordinates (positive northward in GMT)
+       ymin=-MAXVAL(n(k)%patch(:,:)%lz)
+
+       ! call the c function "writegrd_"
+       CALL writegrd(temp1,ns1,ns2,ymin,xmin,dx3,dx2, &
+                     rland,rdum,title,file1)
+       CALL writegrd(temp2,ns1,ns2,ymin,xmin,dx3,dx2, &
+                     rland,rdum,title,file2)
+       CALL writegrd(temp3,ns1,ns2,ymin,xmin,dx3,dx2, &
+                     rland,rdum,title,file3)
+
+       DEALLOCATE(temp1,temp2,temp3)
+
+#endif
+
+    END DO
+
+END SUBROUTINE exportcreep
+
+#ifdef GRD
+  !------------------------------------------------------------------
+  !> subroutine ExportStressGRD
+  !! writes the 6 components of deformation in map view in the GMT
+  !! (Generic Mapping Tools) GRD binary format. This is an interface
+  !! to exportgrd.
+  !!
+  !! \author sylvain barbot 03/19/08 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportstressgrd(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
+                             oz,origx,origy,wdir,index)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,index
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,origx,origy,oz
+    CHARACTER(80), INTENT(IN) :: wdir
+
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
+    INTEGER :: iostatus,i,j,k,l
+
+    ALLOCATE(t1(sx1+2,sx2),t2(sx1+2,sx2),t3(sx1+2,sx2),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for grid export"
+
+    k=fix(oz/dx3)+1
+    DO j=1,sx2
+       DO i=1,sx1
+#ifdef ALIGN_DATA
+          l=(j-1)*(sx1+2)+i
+#else
+          l=(j-1)*sx1+i
+#endif
+          t1(l,1)=sig(i,j,k)%s11
+          t2(l,1)=sig(i,j,k)%s12
+          t3(l,1)=sig(i,j,k)%s13
+       END DO
+    END DO
+
+    CALL exportgrd(t1,t2,t3,sx1,sx2,1, &
+         dx1,dx2,dx3,0._8,origx,origy,wdir,index,convention=4)
+
+    DO j=1,sx2
+       DO i=1,sx1
+#ifdef ALIGN_DATA
+          l=(j-1)*(sx1+2)+i
+#else
+          l=(j-1)*sx1+i
+#endif
+          t1(l,1)=sig(i,j,k)%s22
+          t2(l,1)=sig(i,j,k)%s23
+          t3(l,1)=sig(i,j,k)%s33
+       END DO
+    END DO
+
+    CALL exportgrd(t1,t2,t3,sx1,sx2,1, &
+         dx1,dx2,dx3,0._8,origx,origy,wdir,index,convention=5)
+
+    DEALLOCATE(t1,t2,t3)
+
+  END SUBROUTINE exportstressgrd
+
+
+  !------------------------------------------------------------------
+  !> subroutine ExportGRD
+  !! writes the 3 components of deformation in map view in the GMT
+  !! (Generic Mapping Tools) GRD binary format.
+  !!
+  !! \author sylvain barbot 03/19/08 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportgrd(c1,c2,c3,sx1,sx2,sx3,dx1,dx2,dx3,oz,origx,origy,&
+       wdir,i,convention)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,i
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: c1,c2,c3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: c1,c2,c3
+#endif
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,origx,origy,oz
+    CHARACTER(80), INTENT(IN) :: wdir
+    INTEGER, INTENT(IN), OPTIONAL :: convention
+
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: temp1,temp2,temp3
+    REAL*8 :: rland=9998.,rdum=9999.
+    INTEGER :: iostatus,k,pos,conv
+    REAL*8 :: xmin,ymin
+    CHARACTER(80) :: file1,file2,file3
+    CHARACTER(3) :: digit
+
+    IF (PRESENT(convention)) THEN
+       conv=convention
+    ELSE
+       conv=1
+    END IF
+
+    ALLOCATE(temp1(sx2,sx1),temp2(sx2,sx1),temp3(sx2,sx1),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate memory for grid export"
+
+    CALL exportspatial(c1(:,:,int(oz/dx3)+1),sx1,sx2,temp1,doflip=.true.)
+    CALL exportspatial(c2(:,:,int(oz/dx3)+1),sx1,sx2,temp2,doflip=.true.)
+    CALL exportspatial(c3(:,:,int(oz/dx3)+1),sx1,sx2,temp3,doflip=.true.)
+
+    ! positive up
+    temp3=-temp3
+    
+    pos=INDEX(wdir," ")
+    WRITE (digit,'(I3.3)') i
+    
+    SELECT CASE(conv)
+    CASE (1) ! cumulative displacement
+       file1=wdir(1:pos-1) // "/" // digit // "-north.grd"
+       file2=wdir(1:pos-1) // "/" // digit // "-east.grd"
+       file3=wdir(1:pos-1) // "/" // digit // "-up.grd"
+    CASE (2) ! postseismic displacement
+       file1=wdir(1:pos-1) // "/" // digit // "-relax-north.grd"
+       file2=wdir(1:pos-1) // "/" // digit // "-relax-east.grd"
+       file3=wdir(1:pos-1) // "/" // digit // "-relax-up.grd"
+    CASE (3) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-eqbf-north.grd"
+       file2=wdir(1:pos-1) // "/" // digit // "-eqbf-east.grd"
+       file3=wdir(1:pos-1) // "/" // digit // "-eqbf-up.grd"
+    CASE (4) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-s11.grd"
+       file2=wdir(1:pos-1) // "/" // digit // "-s12.grd"
+       file3=wdir(1:pos-1) // "/" // digit // "-s13.grd"
+    CASE (5) ! equivalent body forces
+       file1=wdir(1:pos-1) // "/" // digit // "-s22.grd"
+       file2=wdir(1:pos-1) // "/" // digit // "-s23.grd"
+       file3=wdir(1:pos-1) // "/" // digit // "-s33.grd"
+    END SELECT
+    
+    ! convert to c standard
+    k=INDEX(file1," ")
+    file1(k:k)=char(0)
+    k=INDEX(file2," ")
+    file2(k:k)=char(0)
+    k=INDEX(file3," ")
+    file3(k:k)=char(0)
+
+    ! xmin is the lowest coordinates (positive eastward)
+    xmin=origy-sx2/2*dx2
+    ! ymin is the lowest coordinates (positive northward)
+    ymin=origx-sx1/2*dx1
+
+    ! call the c function "writegrd_"
+    CALL writegrd(temp1,sx2,sx1,ymin,xmin,dx1,dx2, &
+         rland,rdum,file1,file1)
+    CALL writegrd(temp2,sx2,sx1,ymin,xmin,dx1,dx2, &
+         rland,rdum,file2,file2)
+    CALL writegrd(temp3,sx2,sx1,ymin,xmin,dx1,dx2, &
+         rland,rdum,file3,file3)
+
+    DEALLOCATE(temp1,temp2,temp3)
+
+  END SUBROUTINE exportgrd
+#endif
+
+#ifdef VTK
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_Grid
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! the dimension of the computational grid
+  !!
+  !! \author sylvain barbot 06/24/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_grid(sx1,sx2,sx3,dx1,dx2,dx3,cgfilename)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    CHARACTER(80), INTENT(IN) :: cgfilename
+
+    INTEGER :: iostatus
+    CHARACTER :: q
+
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=cgfilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', cgfilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <PolyData>")')
+    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"6",a,">")'),q,q,q,q
+    WRITE (15,'("      <Points>")')
+    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                            " Name=",a,"Comp. Grid",a, &
+                            " NumberOfComponents=",a,"3",a, &
+                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+    WRITE (15,'(24ES9.2E1)') &
+                 -sx1*dx1/2, -sx2*dx2/2, sx3*dx3/2, &
+                 +sx1*dx1/2, -sx2*dx2/2, sx3*dx3/2, &
+                 +sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &   
+                 -sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &
+                 -sx1*dx1/2, -sx2*dx2/2, 0.0, &
+                 +sx1*dx1/2, -sx2*dx2/2, 0.0, &
+                 +sx1*dx1/2, +sx2*dx2/2, 0.0, &
+                 -sx1*dx1/2, +sx2*dx2/2, 0.0
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Points>")')
+    WRITE (15,'("      <Polys>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                             " Name=",a,"connectivity",a, &
+                             " format=",a,"ascii",a, &
+                             " RangeMin=",a,"0",a, &
+                             " RangeMax=",a,"7",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("0 1 2 3 4 5 6 7 2 3 7 6 0 3 7 4 0 1 5 4 1 2 6 5")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                                  " Name=",a,"offsets",a, &
+                                  " format=",a,"ascii",a, &
+                                  " RangeMin=",a,"4",a, &
+                                  " RangeMax=",a,"24",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("          4 8 12 16 20 24")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Polys>")')
+    WRITE (15,'("    </Piece>")')
+    WRITE (15,'("  </PolyData>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_grid
+
+  !------------------------------------------------------------------
+  !> subroutine ExportXY_RFaults
+  !! creates a .xy file (in the GMT closed-polygon format) containing
+  !! the rectangular faults. Each fault segemnt is described by a
+  !! closed polygon (rectangle) associated with a slip amplitude.
+  !! use pxzy with the -Cpalette.cpt -L -M options to color rectangles 
+  !! by slip.
+  !!
+  !! \author sylvain barbot 03/05/11 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportxy_rfaults(e,x0,y0,rffilename)
+    TYPE(EVENT_STRUC), INTENT(IN) :: e
+    REAL*8, INTENT(IN) :: x0, y0
+    CHARACTER(80), INTENT(IN) :: rffilename
+
+    INTEGER :: iostatus,k
+    CHARACTER :: q
+
+    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W,slip
+         
+    REAL*8, DIMENSION(3) :: s,d
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', rffilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("> # east, north")')
+    DO k=1,e%ns
+
+       ! fault slip
+       slip=e%s(k)%slip
+
+       ! fault orientation
+       strike=e%s(k)%strike
+       dip=e%s(k)%dip
+
+       ! fault center position
+       x1=e%s(k)%x+x0
+       x2=e%s(k)%y+y0
+       x3=e%s(k)%z
+
+       ! fault dimension
+       W=e%s(k)%width
+       L=e%s(k)%length
+
+       cstrike=cos(strike)
+       sstrike=sin(strike)
+       cdip=cos(dip)
+       sdip=sin(dip)
+ 
+       ! strike-slip unit direction
+       s(1)=sstrike
+       s(2)=cstrike
+       s(3)=0._8
+
+       ! dip-slip unit direction
+       d(1)=+cstrike*sdip
+       d(2)=-sstrike*sdip
+       d(3)=+cdip
+
+       ! fault edge coordinates - export east (x2) and north (x1)
+       WRITE (15,'("> -Z",3ES11.2)') ABS(slip)
+       WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2, x1-d(1)*W/2-s(1)*L/2
+       WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2, x1-d(1)*W/2+s(1)*L/2
+       WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2, x1+d(1)*W/2+s(1)*L/2
+       WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2, x1+d(1)*W/2-s(1)*L/2
+
+    END DO
+
+    CLOSE(15)
+
+  END SUBROUTINE exportxy_rfaults
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_RFaults
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! the rectangular faults. The faults are characterized with a set
+  !! of subsegments (rectangles) each associated with a slip vector. 
+  !!
+  !! \author sylvain barbot 06/24/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_rfaults(e,rffilename)
+    TYPE(EVENT_STRUC), INTENT(IN) :: e
+    CHARACTER(80), INTENT(IN) :: rffilename
+
+    INTEGER :: iostatus,k
+    CHARACTER :: q
+
+    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W,slip
+         
+    REAL*8, DIMENSION(3) :: s,d
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', rffilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <PolyData>")')
+
+    DO k=1,e%ns
+
+       ! fault slip
+       slip=e%s(k)%slip
+
+       ! fault orientation
+       strike=e%s(k)%strike
+       dip=e%s(k)%dip
+
+       ! fault center position
+       x1=e%s(k)%x
+       x2=e%s(k)%y
+       x3=e%s(k)%z
+
+       ! fault dimension
+       W=e%s(k)%width
+       L=e%s(k)%length
+
+       cstrike=cos(strike)
+       sstrike=sin(strike)
+       cdip=cos(dip)
+       sdip=sin(dip)
+ 
+       ! strike-slip unit direction
+       s(1)=sstrike
+       s(2)=cstrike
+       s(3)=0._8
+
+       ! dip-slip unit direction
+       d(1)=+cstrike*sdip
+       d(2)=-sstrike*sdip
+       d(3)=+cdip
+
+       WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
+       WRITE (15,'("      <Points>")')
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                            " Name=",a,"Fault Patch",a, &
+                            " NumberOfComponents=",a,"3",a, &
+                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+
+       ! fault edge coordinates
+       WRITE (15,'(12ES11.2)') &
+                     x1-d(1)*W/2-s(1)*L/2,x2-d(2)*W/2-s(2)*L/2,x3-d(3)*W/2-s(3)*L/2, &
+                     x1-d(1)*W/2+s(1)*L/2,x2-d(2)*W/2+s(2)*L/2,x3-d(3)*W/2+s(3)*L/2, &
+                     x1+d(1)*W/2+s(1)*L/2,x2+d(2)*W/2+s(2)*L/2,x3+d(3)*W/2+s(3)*L/2, &
+                     x1+d(1)*W/2-s(1)*L/2,x2+d(2)*W/2-s(2)*L/2,x3+d(3)*W/2-s(3)*L/2
+
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("      </Points>")')
+       WRITE (15,'("      <Polys>")')
+       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                             " Name=",a,"connectivity",a, &
+                             " format=",a,"ascii",a, &
+                             " RangeMin=",a,"0",a, &
+                             " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
+       WRITE (15,'("0 1 2 3")')
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                                  " Name=",a,"offsets",a, &
+                                  " format=",a,"ascii",a, &
+                                  " RangeMin=",a,"4",a, &
+                                  " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
+       WRITE (15,'("          4")')
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("      </Polys>")')
+
+       WRITE (15,'("      <CellData Normals=",a,"slip",a,">")'), q,q
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"slip",a, &
+                                " NumberOfComponents=",a,"3",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+
+
+       WRITE (15,'(3ES11.2)'), (s(1)+d(1))*slip,(s(2)+d(2))*slip,(s(3)+s(3))*slip
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("      </CellData>")')
+
+       WRITE (15,'("    </Piece>")')
+
+    END DO
+
+    WRITE (15,'("  </PolyData>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_rfaults
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_RFaults_Stress_Init
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! the rectangular faults. The faults are characterized with a set
+  !! of subsegments (rectangles) each associated with stress values. 
+  !!
+  !! \author sylvain barbot 06/06/11 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE export_rfaults_stress_init(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
+                                           nsop,sop)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
+
+    INTEGER :: k,i1,i2,i3
+    REAL*8 :: x1,x2,x3
+    ! local value of stress
+    TYPE(TENSOR) :: lsig
+
+    DO k=1,nsop
+       ! fault center position
+       x1=sop(k)%x
+       x2=sop(k)%y
+       x3=sop(k)%z
+
+       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+       lsig=sig(i1,i2,i3)
+
+       sop(k)%sig0%s11=lsig%s11
+       sop(k)%sig0%s12=lsig%s12
+       sop(k)%sig0%s13=lsig%s13
+       sop(k)%sig0%s22=lsig%s22
+       sop(k)%sig0%s23=lsig%s23
+       sop(k)%sig0%s33=lsig%s33
+
+    END DO
+
+  END SUBROUTINE export_rfaults_stress_init
+
+  !------------------------------------------------------------------
+  !> subroutine ExportGMT_RFaults_Stress
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! the rectangular faults. The faults are characterized with a set
+  !! of subsegments (rectangles) each associated with stress values. 
+  !!
+  !! \author sylvain barbot 06/06/11 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportgmt_rfaults_stress(sx1,sx2,sx3,dx1,dx2,dx3, &
+                          nsop,sop,rffilename,convention,sig)
+    USE elastic3d
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
+    CHARACTER(80), INTENT(IN) :: rffilename
+    INTEGER, INTENT(IN), OPTIONAL :: convention
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3), OPTIONAL :: sig
+
+    INTEGER :: iostatus,k,i1,i2,i3,conv
+    CHARACTER :: q
+    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
+    ! segment normal vector, strike direction, dip direction
+    REAL*8, DIMENSION(3) :: n,s,d
+    ! local value of stress
+    TYPE(TENSOR) :: lsig
+    ! stress components
+    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
+    ! friction coefficient
+    REAL*8 :: friction
+    ! traction components
+    REAL*8, DIMENSION(3) :: t,ts
+
+    IF (0.GE.nsop) RETURN
+
+    ! double-quote character
+    q=char(34)
+
+    IF (PRESENT(convention)) THEN
+       conv=convention
+    ELSE
+       conv=0
+    END IF
+
+    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', rffilename
+       STOP "could not open file for export"
+    END IF
+
+    DO k=1,nsop
+       ! friction coefficient
+       friction=sop(k)%friction
+
+       ! fault orientation
+       strike=sop(k)%strike
+       dip=sop(k)%dip
+
+       ! fault center position
+       x1=sop(k)%x
+       x2=sop(k)%y
+       x3=sop(k)%z
+
+       IF (PRESENT(sig)) THEN
+
+          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+          lsig=sig(i1,i2,i3)
+
+          IF (1.EQ.conv) THEN
+             lsig%s11=lsig%s11-sop(k)%sig0%s11
+             lsig%s12=lsig%s12-sop(k)%sig0%s12
+             lsig%s13=lsig%s13-sop(k)%sig0%s13
+             lsig%s22=lsig%s22-sop(k)%sig0%s22
+             lsig%s23=lsig%s23-sop(k)%sig0%s23
+             lsig%s33=lsig%s33-sop(k)%sig0%s33
+          END IF
+       ELSE
+          lsig=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
+       END IF
+
+       ! fault dimension
+       W=sop(k)%width
+       L=sop(k)%length
+
+       cstrike=cos(strike)
+       sstrike=sin(strike)
+       cdip=cos(dip)
+       sdip=sin(dip)
+ 
+       ! surface normal vector components
+       n(1)=+cdip*cstrike
+       n(2)=-cdip*sstrike
+       n(3)=-sdip
+
+       ! strike-slip unit direction
+       s(1)=sstrike
+       s(2)=cstrike
+       s(3)=0._8
+
+       ! dip-slip unit direction
+       d(1)=+cstrike*sdip
+       d(2)=-sstrike*sdip
+       d(3)=+cdip
+
+       ! traction vector
+       t=lsig .tdot. n
+
+       ! signed normal component
+       taun=SUM(t*n)
+
+       ! shear traction
+       ts=t-taun*n
+
+       ! absolute value of shear component
+       taus=SQRT(SUM(ts*ts))
+
+       ! strike-direction shear component
+       taustrike=SUM(ts*s)
+
+       ! dip-direction shear component
+       taudip=SUM(ts*d)
+
+       ! Coulomb stress 
+       taucoulomb=taus+friction*taun
+
+       WRITE (15,'("> -Z",5ES11.2)') taus, taun, taucoulomb, taustrike, taudip
+       WRITE (15,'(3ES11.2)') x1-d(1)*W/2-s(1)*L/2, x2-d(2)*W/2-s(2)*L/2
+       WRITE (15,'(3ES11.2)') x1-d(1)*W/2+s(1)*L/2, x2-d(2)*W/2+s(2)*L/2
+       WRITE (15,'(3ES11.2)') x1+d(1)*W/2+s(1)*L/2, x2+d(2)*W/2+s(2)*L/2
+       WRITE (15,'(3ES11.2)') x1+d(1)*W/2-s(1)*L/2, x2+d(2)*W/2-s(2)*L/2
+
+    END DO
+
+    CLOSE(15)
+
+  END SUBROUTINE exportgmt_rfaults_stress
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_RFaults_Stress
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! the rectangular faults. The faults are characterized with a set
+  !! of subsegments (rectangles) each associated with stress values. 
+  !!
+  !! \author sylvain barbot 06/06/11 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_rfaults_stress(sx1,sx2,sx3,dx1,dx2,dx3, &
+                          nsop,sop,rffilename,convention,sig)
+    USE elastic3d
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
+    CHARACTER(80), INTENT(IN) :: rffilename
+    INTEGER, INTENT(IN), OPTIONAL :: convention
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3), OPTIONAL :: sig
+
+    INTEGER :: iostatus,k,i1,i2,i3,conv
+    CHARACTER :: q
+    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
+    ! segment normal vector, strike direction, dip direction
+    REAL*8, DIMENSION(3) :: n,s,d
+    ! local value of stress
+    TYPE(TENSOR) :: lsig
+    ! stress components
+    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
+    ! friction coefficient
+    REAL*8 :: friction
+    ! traction components
+    REAL*8, DIMENSION(3) :: t,ts
+
+    IF (0.GE.nsop) RETURN
+
+    ! double-quote character
+    q=char(34)
+
+    IF (PRESENT(convention)) THEN
+       conv=convention
+    ELSE
+       conv=0
+    END IF
+
+    OPEN (UNIT=15,FILE=rffilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', rffilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <PolyData>")')
+
+    DO k=1,nsop
+       ! friction coefficient
+       friction=sop(k)%friction
+
+       ! fault orientation
+       strike=sop(k)%strike
+       dip=sop(k)%dip
+
+       ! fault center position
+       x1=sop(k)%x
+       x2=sop(k)%y
+       x3=sop(k)%z
+
+       IF (PRESENT(sig)) THEN
+
+          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+          lsig=sig(i1,i2,i3)
+
+          IF (1.EQ.conv) THEN
+             lsig%s11=lsig%s11-sop(k)%sig0%s11
+             lsig%s12=lsig%s12-sop(k)%sig0%s12
+             lsig%s13=lsig%s13-sop(k)%sig0%s13
+             lsig%s22=lsig%s22-sop(k)%sig0%s22
+             lsig%s23=lsig%s23-sop(k)%sig0%s23
+             lsig%s33=lsig%s33-sop(k)%sig0%s33
+          END IF
+       ELSE
+          lsig=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
+       END IF
+
+       ! fault dimension
+       W=sop(k)%width
+       L=sop(k)%length
+
+       cstrike=cos(strike)
+       sstrike=sin(strike)
+       cdip=cos(dip)
+       sdip=sin(dip)
+ 
+       ! surface normal vector components
+       n(1)=+cdip*cstrike
+       n(2)=-cdip*sstrike
+       n(3)=-sdip
+
+       ! strike-slip unit direction
+       s(1)=sstrike
+       s(2)=cstrike
+       s(3)=0._8
+
+       ! dip-slip unit direction
+       d(1)=+cstrike*sdip
+       d(2)=-sstrike*sdip
+       d(3)=+cdip
+
+       ! traction vector
+       t=lsig .tdot. n
+
+       ! signed normal component
+       taun=SUM(t*n)
+
+       ! shear traction
+       ts=t-taun*n
+
+       ! absolute value of shear component
+       taus=SQRT(SUM(ts*ts))
+
+       ! strike-direction shear component
+       taustrike=SUM(ts*s)
+
+       ! dip-direction shear component
+       taudip=SUM(ts*d)
+
+       ! Coulomb stress 
+       taucoulomb=taus+friction*taun
+
+       WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
+       WRITE (15,'("      <Points>")')
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                            " Name=",a,"Fault Patch",a, &
+                            " NumberOfComponents=",a,"3",a, &
+                            " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+       ! fault edge coordinates
+       WRITE (15,'(12ES11.2)') &
+                     x1-d(1)*W/2-s(1)*L/2, x2-d(2)*W/2-s(2)*L/2, x3-d(3)*W/2-s(3)*L/2, &
+                     x1-d(1)*W/2+s(1)*L/2, x2-d(2)*W/2+s(2)*L/2, x3-d(3)*W/2+s(3)*L/2, &
+                     x1+d(1)*W/2+s(1)*L/2, x2+d(2)*W/2+s(2)*L/2, x3+d(3)*W/2+s(3)*L/2, &
+                     x1+d(1)*W/2-s(1)*L/2, x2+d(2)*W/2-s(2)*L/2, x3+d(3)*W/2-s(3)*L/2
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("      </Points>")')
+       WRITE (15,'("      <Polys>")')
+       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                             " Name=",a,"connectivity",a, &
+                             " format=",a,"ascii",a, &
+                             " RangeMin=",a,"0",a, &
+                             " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
+       WRITE (15,'("0 1 2 3")')
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                                  " Name=",a,"offsets",a, &
+                                  " format=",a,"ascii",a, &
+                                  " RangeMin=",a,"4",a, &
+                                  " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
+       WRITE (15,'("          4")')
+       WRITE (15,'("        </DataArray>")')
+       WRITE (15,'("      </Polys>")')
+
+       WRITE (15,'("      <CellData Normals=",a,"stress",a,">")'), q,q
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"stress tensor",a, &
+                                " NumberOfComponents=",a,"6",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(6ES11.2)'), lsig%s11,lsig%s12,lsig%s13,lsig%s22,lsig%s23,lsig%s33
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"shear stress",a, &
+                                " NumberOfComponents=",a,"1",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(ES11.2)'), taus
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"normal stress",a, &
+                                " NumberOfComponents=",a,"1",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(ES11.2)'), taun
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"Coulomb stress",a, &
+                                " NumberOfComponents=",a,"1",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(ES11.2)'), taucoulomb
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"stress in strike direction",a, &
+                                " NumberOfComponents=",a,"1",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(ES11.2)'), taustrike
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                           	" Name=",a,"stress in dip direction",a, &
+                                " NumberOfComponents=",a,"1",a, &
+                                " format=",a,"ascii",a,">")'), q,q,q,q,q,q,q,q
+       WRITE (15,'(ES11.2)'), taudip
+       WRITE (15,'("        </DataArray>")')
+
+       WRITE (15,'("      </CellData>")')
+
+       WRITE (15,'("    </Piece>")')
+
+    END DO
+
+    WRITE (15,'("  </PolyData>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_rfaults_stress
+
+  !--------------------------------------------------------------------------------
+  !> subroutine ExportCoulombStress
+  !! sample the stress tensor, shear and normal stress and Coulomb
+  !! stress at a series of locations.
+  !!
+  !! each fault patch is attributed to a file in which the time 
+  !! evolution is listed in the following format:
+  !!
+  !! #t     s11     s12     s13     s22     s23     s33     taus     taud     tau     taun     Coulomb
+  !! t0 s11(t0) s12(t0) s13(t0) s22(t0) s23(t0) s33(t0) taus(t0) taud(t0) tau(t0) taun(t0) Coulomb(t0)
+  !! t1 s11(t1) s12(t1) s13(t1) s22(t1) s23(t1) s33(t1) taus(t1) taud(t1) tau(t1) taun(t1) Coulomb(t0)
+  !!    ...
+  !!
+  !! where sij(t0) is the component ij of the stress tensor at time t0, taus is
+  !! the component of shear in the strike direction, taud is the component of shear
+  !! in the fault dip direction, tau^2=taus^2+taud^2, taun is the fault normal
+  !! stress and Coulomb(t0) is the Coulomb stress tau+mu*taun. 
+  !!
+  !! \author sylvain barbot (10/05/11) - original form
+  !--------------------------------------------------------------------------------
+  SUBROUTINE exportcoulombstress(sig,sx1,sx2,sx3,dx1,dx2,dx3, &
+                          nsop,sop,time,wdir,isnew)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,nsop
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(SEGMENT_STRUCT), INTENT(INOUT), DIMENSION(nsop) :: sop
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,time
+    CHARACTER(80), INTENT(IN) :: wdir
+    LOGICAL, INTENT(IN) :: isnew
+
+    INTEGER :: iostatus,k,i1,i2,i3
+    CHARACTER :: q
+    CHARACTER(4) :: digit4
+    CHARACTER(80) :: file
+    REAL*8 :: strike,dip,x1,x2,x3,cstrike,sstrike,cdip,sdip,L,W
+    ! segment normal vector, strike direction, dip direction
+    REAL*8, DIMENSION(3) :: n,s,d
+    ! local value of stress
+    TYPE(TENSOR) :: lsig
+    ! stress components
+    REAL*8 :: taun,taus,taustrike,taudip,taucoulomb
+    ! friction coefficient
+    REAL*8 :: friction
+    ! traction components
+    REAL*8, DIMENSION(3) :: t,ts
+
+    IF (0.GE.nsop) RETURN
+
+    ! double-quote character
+    q=char(34)
+
+    DO k=1,nsop
+       WRITE (digit4,'(I4.4)') k
+       file=trim(wdir)//"/cfaults-sigma-"//digit4//".txt"
+
+       ! fault center position
+       x1=sop(k)%x
+       x2=sop(k)%y
+       x3=sop(k)%z
+
+       IF (isnew) THEN
+          OPEN (UNIT=15,FILE=file,IOSTAT=iostatus,FORM="FORMATTED")
+          WRITE (15,'("# center position (north, east, down): ",3ES9.2)') x1,x2,x3
+          WRITE (15,'("#         t        s11        s12        s13        ", &
+          "s22        s23        s33       taus       taud        tau       taun    Coulomb")')
+       ELSE
+          OPEN (UNIT=15,FILE=file,POSITION="APPEND",&
+               IOSTAT=iostatus,FORM="FORMATTED")
+       END IF
+       IF (iostatus>0) STOP "could not open point file for writing"
+
+       ! friction coefficient
+       friction=sop(k)%friction
+
+       ! fault orientation
+       strike=sop(k)%strike
+       dip=sop(k)%dip
+
+       CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+       lsig=sig(i1,i2,i3)
+
+       ! fault dimension
+       W=sop(k)%width
+       L=sop(k)%length
+
+       cstrike=cos(strike)
+       sstrike=sin(strike)
+       cdip=cos(dip)
+       sdip=sin(dip)
+ 
+       ! surface normal vector components
+       n(1)=+cdip*cstrike
+       n(2)=-cdip*sstrike
+       n(3)=-sdip
+
+       ! strike-slip unit direction
+       s(1)=sstrike
+       s(2)=cstrike
+       s(3)=0._8
+
+       ! dip-slip unit direction
+       d(1)=+cstrike*sdip
+       d(2)=-sstrike*sdip
+       d(3)=+cdip
+
+       ! traction vector
+       t=lsig .tdot. n
+
+       ! signed normal component
+       taun=SUM(t*n)
+
+       ! shear traction
+       ts=t-taun*n
+
+       ! absolute value of shear component
+       taus=SQRT(SUM(ts*ts))
+
+       ! strike-direction shear component
+       taustrike=SUM(ts*s)
+
+       ! dip-direction shear component
+       taudip=SUM(ts*d)
+
+       ! Coulomb stress 
+       taucoulomb=taus+friction*taun
+
+       WRITE (15,'(12ES11.3E2)') time, &
+                                 lsig%s11,lsig%s12,lsig%s13, &
+                                 lsig%s22,lsig%s23,lsig%s33, &
+                                 taustrike,taudip,taus,taun,taucoulomb
+       CLOSE(15)
+    END DO
+
+  END SUBROUTINE exportcoulombstress
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_Rectangle
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! a rectangle.
+  !!
+  !! \author sylvain barbot 06/24/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_rectangle(x1,x2,x3,L,W,strike,dip,filename)
+    REAL*8 :: x1,x2,x3,L,W,strike,dip
+    CHARACTER(80), INTENT(IN) :: filename
+
+    INTEGER :: iostatus
+    CHARACTER :: q
+
+    REAL*8 :: cstrike,sstrike,cdip,sdip
+    REAL*8, DIMENSION(3) :: s,d
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', filename
+       STOP "could not open file for export in ExportVTK_Rectangle"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <PolyData>")')
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+ 
+    ! strike-slip unit direction
+    s(1)=sstrike
+    s(2)=cstrike
+    s(3)=0._8
+
+    ! dip-slip unit direction
+    d(1)=+cstrike*sdip
+    d(2)=-sstrike*sdip
+    d(3)=+cdip
+
+    WRITE (15,'("    <Piece NumberOfPoints=",a,"4",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
+    WRITE (15,'("      <Points>")')
+    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                         " Name=",a,"Fault Patch",a, &
+                         " NumberOfComponents=",a,"3",a, &
+                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+
+    ! fault edge coordinates
+    WRITE (15,'(12ES11.2)') &
+                  x1-d(1)*W/2-s(1)*L/2,x2-d(2)*W/2-s(2)*L/2,x3-d(3)*W/2-s(3)*L/2, &
+                  x1-d(1)*W/2+s(1)*L/2,x2-d(2)*W/2+s(2)*L/2,x3-d(3)*W/2+s(3)*L/2, &
+                  x1+d(1)*W/2+s(1)*L/2,x2+d(2)*W/2+s(2)*L/2,x3+d(3)*W/2+s(3)*L/2, &
+                  x1+d(1)*W/2-s(1)*L/2,x2+d(2)*W/2-s(2)*L/2,x3+d(3)*W/2-s(3)*L/2
+
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Points>")')
+    WRITE (15,'("      <Polys>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                          " Name=",a,"connectivity",a, &
+                          " format=",a,"ascii",a, &
+                          " RangeMin=",a,"0",a, &
+                          " RangeMax=",a,"3",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("0 1 2 3")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                               " Name=",a,"offsets",a, &
+                               " format=",a,"ascii",a, &
+                               " RangeMin=",a,"4",a, &
+                               " RangeMax=",a,"4",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("          4")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Polys>")')
+
+    WRITE (15,'("    </Piece>")')
+
+    WRITE (15,'("  </PolyData>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_rectangle
+
+  !------------------------------------------------------------------
+  !> subroutine ExportXY_Brick
+  !! creates a .xy file containing a brick (3d rectangle, cuboid).
+  !!
+  !! \author sylvain barbot 11/29/11 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportxy_brick(x1,x2,x3,L,W,T,strike,dip,filename)
+    REAL*8 :: x1,x2,x3,L,W,T,strike,dip
+    CHARACTER(80), INTENT(IN) :: filename
+
+    INTEGER :: iostatus
+
+    REAL*8 :: cstrike,sstrike,cdip,sdip
+    REAL*8, DIMENSION(3) :: s,d,n
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', filename
+       STOP "could not open file for export in ExportXY_Brick"
+    END IF
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+ 
+    ! strike-slip unit direction
+    s(1)=sstrike
+    s(2)=cstrike
+    s(3)=0._8
+
+    ! dip-slip unit direction
+    d(1)=+cstrike*sdip
+    d(2)=-sstrike*sdip
+    d(3)=+cdip
+
+    ! surface normal vector components
+    n(1)=+cdip*cstrike
+    n(2)=-cdip*sstrike
+    n(3)=-sdip
+
+    ! fault edge coordinates
+    WRITE (15,'(">")')
+    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2-d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x1-d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
+    WRITE (15,'(">")')
+    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2+d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x1+d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0
+    WRITE (15,'(3ES11.2)') x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0
+
+    CLOSE(15)
+
+  END SUBROUTINE exportxy_brick
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_Brick
+  !! creates a .vtp file (in the VTK PolyData XML format) containing
+  !! a brick (3d rectangle, cuboid).
+  !!
+  !! \author sylvain barbot 06/24/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_brick(x1,x2,x3,L,W,T,strike,dip,filename)
+    REAL*8 :: x1,x2,x3,L,W,T,strike,dip
+    CHARACTER(80), INTENT(IN) :: filename
+
+    INTEGER :: iostatus
+    CHARACTER :: q
+
+    REAL*8 :: cstrike,sstrike,cdip,sdip
+    REAL*8, DIMENSION(3) :: s,d,n
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=filename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', filename
+       STOP "could not open file for export in ExportVTK_Brick"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"1.0",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"PolyData",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <PolyData>")')
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+ 
+    ! strike-slip unit direction
+    s(1)=sstrike
+    s(2)=cstrike
+    s(3)=0._8
+
+    ! dip-slip unit direction
+    d(1)=+cstrike*sdip
+    d(2)=-sstrike*sdip
+    d(3)=+cdip
+
+    ! surface normal vector components
+    n(1)=+cdip*cstrike
+    n(2)=-cdip*sstrike
+    n(3)=-sdip
+
+    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
+    WRITE (15,'("      <Points>")')
+    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                         " Name=",a,"Weak Zone",a, &
+                         " NumberOfComponents=",a,"3",a, &
+                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+
+    ! fault edge coordinates
+    WRITE (15,'(24ES11.2)') &
+                  x1-d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x2-d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+                  x1-d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x2-d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2+s(1)*L/2-n(1)*T/2.d0, x2+d(2)*W/2+s(2)*L/2-n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2-s(1)*L/2-n(1)*T/2.d0, x2+d(2)*W/2-s(2)*L/2-n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x2+d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+                  x1-d(1)*W/2-s(1)*L/2+n(1)*T/2.d0, x2-d(2)*W/2-s(2)*L/2+n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+                  x1-d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x2-d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
+                  x1+d(1)*W/2+s(1)*L/2+n(1)*T/2.d0, x2+d(2)*W/2+s(2)*L/2+n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
+
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Points>")')
+    WRITE (15,'("      <Polys>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                          " Name=",a,"connectivity",a, &
+                          " format=",a,"ascii",a, &
+                          " RangeMin=",a,"0",a, &
+                          " RangeMax=",a,"6",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("7 4 5 6 7 4 3 2 7 2 1 6")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                               " Name=",a,"offsets",a, &
+                               " format=",a,"ascii",a, &
+                               " RangeMin=",a,"12",a, &
+                               " RangeMax=",a,"12",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("          12")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Polys>")')
+    WRITE (15,'("    </Piece>")')
+
+    WRITE (15,'("    <Piece NumberOfPoints=",a,"8",a," NumberOfPolys=",a,"1",a,">")'),q,q,q,q
+    WRITE (15,'("      <Points>")')
+    WRITE (15,'("        <DataArray type=",a,"Float32",a, &
+                         " Name=",a,"Weak Zone",a, &
+                         " NumberOfComponents=",a,"3",a, &
+                         " format=",a,"ascii",a,">")'),q,q,q,q,q,q,q,q
+
+    ! fault edge coordinates
+    WRITE (15,'(24ES11.2)') &
+                  x1-d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+                  x1-d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+                  x1+d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+                  x1-d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+                  x1-d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
+                  x1+d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
+
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Points>")')
+    WRITE (15,'("      <Polys>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                          " Name=",a,"connectivity",a, &
+                          " format=",a,"ascii",a, &
+                          " RangeMin=",a,"0",a, &
+                          " RangeMax=",a,"7",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("0 1 2 3 0 5 4 3 0 1 6 5")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("        <DataArray type=",a,"Int32",a, &
+                               " Name=",a,"offsets",a, &
+                               " format=",a,"ascii",a, &
+                               " RangeMin=",a,"12",a, &
+                               " RangeMax=",a,"12",a,">")'), q,q,q,q,q,q,q,q,q,q
+    WRITE (15,'("          12")')
+    WRITE (15,'("        </DataArray>")')
+    WRITE (15,'("      </Polys>")')
+    WRITE (15,'("    </Piece>")')
+    WRITE (15,'("  </PolyData>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_brick
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_Vectors
+  !! creates a .vtr file (in the VTK Rectilinear XML format) 
+  !! containing a vector field.
+  !!
+  !! \author sylvain barbot 06/25/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_vectors(u1,u2,u3,sx1,sx2,sx3,dx1,dx2,dx3,j1,j2,j3,vcfilename)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,j1,j2,j3
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: u1,u2,u3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
+#endif
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    CHARACTER(80), INTENT(IN) :: vcfilename
+
+    INTEGER :: iostatus,idum,i1,i2,i3
+    CHARACTER :: q
+    INTEGER :: k1,k2,k3
+    REAL*8 :: x1,x2,x3
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=vcfilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', vcfilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"0.1",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"RectilinearGrid",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <RectilinearGrid WholeExtent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,sx3/j3,q
+    WRITE (15,'("  <Piece Extent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,sx3/j3,q
+    WRITE (15,'("    <PointData Scalars=",a,"Vector Field",a,">")') q,q
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"X Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write first component values
+    DO k3=0,sx3-1,j3
+       x3=REAL(k3,8)
+       DO k2=-sx2/2,sx2/2-1,j2
+          x2=REAL(k2,8)
+          DO k1=-sx1/2,sx1/2-1,j1
+             x1=REAL(k1,8)
+
+             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+             WRITE (15,'(ES12.2)') u1(i1,i2,k3+1)
+          END DO
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Y Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write second component values
+    DO k3=0,sx3-1,j3
+       x3=REAL(k3,8)
+       DO k2=-sx2/2,sx2/2-1,j2
+          x2=REAL(k2,8)
+          DO k1=-sx1/2,sx1/2-1,j1
+             x1=REAL(k1,8)
+
+             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+             WRITE (15,'(ES12.2)') u2(i1,i2,k3+1)
+
+          END DO
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Z Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write third component values
+    DO k3=0,sx3-1,j3
+       x3=REAL(k3,8)
+       DO k2=-sx2/2,sx2/2-1,j2
+          x2=REAL(k2,8)
+          DO k1=-sx1/2,sx1/2-1,j1
+             x1=REAL(k1,8)
+
+             CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+             WRITE (15,'(ES12.2)') u3(i1,i2,k3+1)
+
+          END DO
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("  </PointData>")')
+
+    WRITE (15,'("  <Coordinates>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 1",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx1/2*dx1,q,q,(sx1/2-1)*dx1,q
+    DO k1=-sx1/2,sx1/2-1,j1
+       x1=REAL(k1,8)
+       WRITE (15,'(ES12.2)') x1*dx1
+    END DO
+    WRITE (15,'("    </DataArray>")')
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 2",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx2/2*dx2,q,q,(sx2/2-1)*dx2,q
+    DO k2=-sx2/2,sx2/2-1,j2
+       x2=REAL(k2,8)
+       WRITE (15,'(ES12.2)') x2*dx2
+    END DO
+    WRITE (15,'("    </DataArray>")')
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 3",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,0,q,q,(sx3-1)*dx3,q
+    DO k3=0,sx3-1,j3
+       x3=REAL(k3,8)
+       WRITE (15,'(ES12.2)') x3*dx3
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("  </Coordinates>")')
+    WRITE (15,'("</Piece>")')
+    WRITE (15,'("</RectilinearGrid>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_vectors
+
+  !------------------------------------------------------------------
+  !> subroutine ExportVTK_Vectors_Slice
+  !! creates a .vtr file (in the VTK Rectilinear XML format) 
+  !! containing a vector field.
+  !!
+  !! \author sylvain barbot 06/25/09 - original form
+  !------------------------------------------------------------------
+  SUBROUTINE exportvtk_vectors_slice(u1,u2,u3,sx1,sx2,sx3,dx1,dx2,dx3,oz,j1,j2,vcfilename)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,j1,j2
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: u1,u2,u3
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
+#endif
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,oz
+    CHARACTER(80), INTENT(IN) :: vcfilename
+
+    INTEGER :: iostatus,idum,i1,i2
+    CHARACTER :: q
+    INTEGER :: k1,k2,k3
+    REAL*8 :: x1,x2,x3
+
+    ! double-quote character
+    q=char(34)
+
+    OPEN (UNIT=15,FILE=vcfilename,IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       PRINT '(a)', vcfilename
+       STOP "could not open file for export"
+    END IF
+
+    WRITE (15,'("<?xml version=",a,"0.1",a,"?>")') q,q
+    WRITE (15,'("<VTKFile type=",a,"RectilinearGrid",a," version=",a,"0.1",a,">")') q,q,q,q
+    WRITE (15,'("  <RectilinearGrid WholeExtent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,1,q
+    WRITE (15,'("  <Piece Extent=",a,6I5.4,a,">")') q,1,sx1/j1,1,sx2/j2,1,1,q
+    WRITE (15,'("    <PointData Scalars=",a,"Vector Field",a,">")') q,q
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"X Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write first component values
+    x3=oz/dx3
+    DO k2=-sx2/2,sx2/2-1,j2
+       x2=REAL(k2,8)
+       DO k1=-sx1/2,sx1/2-1,j1
+          x1=REAL(k1,8)
+
+          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+          WRITE (15,'(ES12.2)') u1(i1,i2,k3+1)
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Y Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write second component values
+    x3=oz/dx3
+    DO k2=-sx2/2,sx2/2-1,j2
+       x2=REAL(k2,8)
+       DO k1=-sx1/2,sx1/2-1,j1
+          x1=REAL(k1,8)
+
+          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+          WRITE (15,'(ES12.2)') u2(i1,i2,k3+1)
+
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Z Velocity",a, &
+                        " format=",a,"ascii",a,">")') q,q,q,q,q,q
+
+    ! write third component values
+    x3=oz/dx3
+    DO k2=-sx2/2,sx2/2-1,j2
+       x2=REAL(k2,8)
+       DO k1=-sx1/2,sx1/2-1,j1
+          x1=REAL(k1,8)
+
+          CALL shiftedindex(x1,x2,1._8,sx1,sx2,sx3,1._8,1._8,1._8,i1,i2,idum)
+          WRITE (15,'(ES12.2)') u3(i1,i2,k3+1)
+
+       END DO
+    END DO
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("  </PointData>")')
+
+    WRITE (15,'("  <Coordinates>")')
+
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 1",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx1/2*dx1,q,q,(sx1/2-1)*dx1,q
+    DO k1=-sx1/2,sx1/2-1,j1
+       x1=REAL(k1,8)
+       WRITE (15,'(ES12.2)') x1*dx1
+    END DO
+    WRITE (15,'("    </DataArray>")')
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 2",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,-sx2/2*dx1,q,q,(sx2/2-1)*dx2,q
+    DO k2=-sx2/2,sx2/2-1,j2
+       x2=REAL(k2,8)
+       WRITE (15,'(ES12.2)') x2*dx2
+    END DO
+    WRITE (15,'("    </DataArray>")')
+    WRITE (15,'("    <DataArray type=",a,"Float32",a, &
+                        " Name=",a,"Array 3",a, &
+                        " format=",a,"ascii",a, &
+                        " RangeMin=",a,ES12.2,a, &
+                        " RangeMax=",a,ES12.2,a,">")') q,q,q,q,q,q,q,oz,q,q,oz,q
+    WRITE (15,'(2ES12.2)') oz
+    WRITE (15,'("    </DataArray>")')
+
+    WRITE (15,'("  </Coordinates>")')
+    WRITE (15,'("</Piece>")')
+    WRITE (15,'("</RectilinearGrid>")')
+    WRITE (15,'("</VTKFile>")')
+
+    CLOSE(15)
+
+  END SUBROUTINE exportvtk_vectors_slice
+#endif
+
+END MODULE export
diff -r 405d8f4fa05f -r e7295294f654 src/fourier.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/fourier.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,631 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+#include "include.f90"
+
+MODULE fourier
+
+#ifdef IMKL_FFT
+  USE MKL_DFTI
+#endif
+
+  IMPLICIT NONE
+
+  PUBLIC
+
+#ifdef FFTW3
+  INCLUDE 'fftw3.f'
+#endif
+
+  INTEGER, PARAMETER :: FFT_FORWARD=-1,FFT_INVERSE=1
+
+CONTAINS
+
+  !---------------------------------------------------------------------
+  !> subroutine wavenumbers 
+  !! computes the values of the wavenumbers
+  !! in the sequential order required when using subroutine FOURT
+  !! to perform forward and backward inverse transforms.
+  !!
+  !! INPUT
+  !! @param i1 running index in the discrete Fourier domain array
+  !! @param i2 running index in the discrete Fourier domain array
+  !! @param i3 running index in the discrete Fourier domain array
+  !! @param sx1 number of elements in the x1-direction
+  !! @param sx2 number of elements in the x2-direction
+  !! @param sx3 number of elements in the x3-direction
+  !! @param dx1 sampling interval in the x1-direction
+  !! @param dx2 sampling interval in the x2-direction
+  !! @param dx3 sampling interval in the x3-direction
+  !!
+  !! OUTPUT
+  !! @param k1 wavenumber in the x1 direction
+  !! @param k2 wavenumber in the x2 direction
+  !! @param k3 wavenumber in the x3 direction
+  !!
+  !! \author sylvain barbot (04-14-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
+    INTEGER, INTENT(IN) :: i1, i2, i3, sx1, sx2, sx3
+    REAL*8, INTENT(IN) :: dx1, dx2, dx3
+    REAL*8, INTENT(OUT) :: k1, k2, k3
+    
+    IF (i3 < sx3/2+1) THEN
+       k3= (DBLE(i3)-1._8)/(sx3*dx3)
+    ELSE
+       k3=-(DBLE(sx3-i3)+1._8)/(sx3*dx3)
+    END IF
+    IF (i2 < sx2/2+1) THEN
+       k2= (DBLE(i2)-1._8)/(sx2*dx2)
+    ELSE
+       k2=-(DBLE(sx2-i2)+1._8)/(sx2*dx2)
+    END IF
+    k1=(DBLE(i1)-1._8)/(sx1*dx1)
+    
+  END SUBROUTINE wavenumbers
+
+  SUBROUTINE wavenumber1(i1,sx1,dx1,k1)
+    INTEGER, INTENT(IN) :: i1,sx1
+    REAL*8, INTENT(IN) :: dx1
+    REAL*8, INTENT(OUT) :: k1
+
+    k1=(DBLE(i1)-1._8)/(sx1*dx1)
+  END SUBROUTINE wavenumber1
+
+  SUBROUTINE wavenumber2(i2,sx2,dx2,k2)
+    INTEGER, INTENT(IN) :: i2,sx2
+    REAL*8, INTENT(IN) :: dx2
+    REAL*8, INTENT(OUT) :: k2
+    
+    IF (i2 < sx2/2+1) THEN
+       k2= (DBLE(i2)-1._8)/(sx2*dx2)
+    ELSE
+       k2=-(DBLE(sx2-i2)+1._8)/(sx2*dx2)
+    END IF
+  END SUBROUTINE wavenumber2
+
+  SUBROUTINE wavenumber3(i3,sx3,dx3,k3)
+    INTEGER, INTENT(IN) :: i3,sx3
+    REAL*8, INTENT(IN) :: dx3
+    REAL*8, INTENT(OUT) :: k3
+    
+    IF (i3 < sx3/2+1) THEN
+       k3= (DBLE(i3)-1._8)/(sx3*dx3)
+    ELSE
+       k3=-(DBLE(sx3-i3)+1._8)/(sx3*dx3)
+    END IF
+  END SUBROUTINE wavenumber3
+
+  !---------------------------------------------------------------------
+  ! subroutine FFTshift_TF applies the transfer function 
+  ! in the Fourier domain corresponding to shifting the space 
+  ! domain array by sx1*dx1/2 in the 1-direction and sx3*dx3/2 
+  ! in the 3-direction.
+  !
+  ! fftshift_tf follows the data storage convention in
+  ! agreement with DFT subroutine FOURT
+  !
+  ! sylvain barbot (05-01-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE fftshift_tf(spec)
+    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: spec
+    
+    INTEGER :: sx1, sx2, sx3, i1, i2, i3
+    REAL*4 :: exp1, exp2, exp3
+    
+    sx1=SIZE(spec, 1)-2
+    sx2=SIZE(spec, 2)
+    sx3=SIZE(spec, 3)
+    
+    DO i3=1,sx3
+       IF (i3 < sx3/2+1) THEN
+          exp3=-(DBLE(i3)-1._8)
+       ELSE
+          exp3= (DBLE(sx3-i3)+1._8)
+       END IF
+       DO i2=1,sx2
+          IF (i2 < sx2/2+1) THEN
+             exp2=-(DBLE(i2)-1._8)
+          ELSE
+             exp2= (DBLE(sx2-i2)+1._8)
+          END IF
+          DO i1=1,sx1/2+1
+             exp1=(DBLE(i1)-1._8)
+             spec(2*i1-1:2*i1,i2,i3) = &
+                  spec(2*i1-1:2*i1,i2,i3)*((-1._4)**(exp1+exp2+exp3))
+          END DO
+       END DO
+    END DO
+  END SUBROUTINE fftshift_tf
+
+  !----------------------------------------------------------------------
+  !> subroutine FFT3 performs normalized forward and
+  !! inverse fourier transforms of real 3d data
+  !
+  !! USES
+  !! ctfft (Brenner, 1968) by default
+  !! fftw3 (Frigo & Jonhson) with preproc FFTW3 flag
+  !! scfft (SGI library) with preproc SGI_FFT flag
+  !! ctfft (Cooley-Tuckey) by default (slowest FFT)
+  !!
+  !! for real array the fourier transform returns a sx1/2+1 complex array
+  !! and the enough space must be reserved
+  !----------------------------------------------------------------------
+#ifdef FFTW3
+  !--------------------------------------------------------
+  ! implementation of FFTW3
+  ! must be linked with -lfftw3f (single-threaded version)
+  !
+  ! sylvain barbot (09-28-08) - original form
+  !--------------------------------------------------------
+  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+
+    INTEGER*8 :: plan
+
+    IF (FFT_FORWARD == direction) THEN
+      CALL sfftw_plan_dft_r2c_3d(plan,sx1,sx2,sx3, &
+           data(1,1,1),data(1,1,1),FFTW_ESTIMATE)
+    ELSE
+      CALL sfftw_plan_dft_c2r_3d(plan,sx1,sx2,sx3, &
+           data(1,1,1),data(1,1,1),FFTW_ESTIMATE)
+    END IF
+
+    CALL sfftw_execute(plan)
+    CALL sfftw_destroy_plan(plan)
+
+   IF (FFT_INVERSE == direction) THEN
+     data=data/(sx1*dx1*sx2*dx2*sx3*dx3)
+   ELSE
+     data=data*(dx1*dx2*dx3)
+   END IF
+
+  END SUBROUTINE fft3
+#else
+#ifdef SGI_FFT
+  !--------------------------------------------------------------------
+  ! implementation of SGI SCFFT
+  ! must be linked with -L/usr/lib -lscs or -L/usr/lib -lscs_mp for
+  ! multithread version expect up x8 performance increase compared to
+  ! ctfft implementation. check out the SGI documentation at:
+  !
+  ! http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=linux&
+  !      db=man&fname=/usr/share/catman/man3/ccfft.3s.html&srch=ccfft
+  !
+  ! sylvain barbot (09-28-08) - original form
+  !--------------------------------------------------------------------
+  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
+    INTEGER, INTENT(IN) :: direction,sx1,sx2,sx3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+
+    INTEGER, PARAMETER :: NF=256, NFR=256
+
+    REAL*4, DIMENSION(sx1+NFR+(2*sx2+NF)+(2*sx3+NF)) :: table
+    REAL*4, DIMENSION(sx1+4*sx3) :: work
+    INTEGER, DIMENSION(2) :: isys
+    REAL*4 :: scale
+
+    isys(1)=1
+
+    IF (FFT_FORWARD == direction) THEN
+      scale=dx1*dx2*dx3
+      ! initialize the sin/cos table
+      CALL SCFFT3D(+0,sx1,sx2,sx3,scale,data(1,1,1),sx1+2,sx2, &
+                   data(1,1,1),sx1/2+1,sx2,table,work,isys)
+      CALL SCFFT3D(-1,sx1,sx2,sx3,scale,data(1,1,1),sx1+2,sx2, &
+                   data(1,1,1),sx1/2+1,sx2,table,work,isys)
+    ELSE
+      scale=1._4/(sx1*dx1*sx2*dx2*sx3*dx3)
+      ! initialize the sin/cos table
+      CALL CSFFT3D(+0,sx1,sx2,sx3,scale,data(1,1,1),sx1/2+1,sx2, &
+                   data(1,1,1),sx1+2,sx2,table,work,isys)
+      CALL CSFFT3D(+1,sx1,sx2,sx3,scale,data(1,1,1),sx1/2+1,sx2, &
+                   data(1,1,1),sx1+2,sx2,table,work,isys)
+    END IF
+
+  END SUBROUTINE fft3
+#else
+#ifdef IMKL_FFT
+  !-------------------------------------------------------------------------
+  ! implementation IMKL_FFT (Intel Math Kernel Library)
+  ! for information and example calculations with the
+  ! mkl FFT, see:
+  !
+  ! http://www.intel.com/software/products/mkl/docs/webhelp/appendices/ ...
+  !                      mkl_appC_DFT.html#appC-exC-25
+  !
+  ! and a thread (Fortran 3-D FFT real-to-complex ...)
+  ! on the intel forum
+  !
+  ! http://software.intel.com/en-us/forums/intel-math-kernel-library/
+  !
+  ! sylvain barbot (04-30-10) - original form
+  !-------------------------------------------------------------------------
+  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
+    REAL*4, DIMENSION(0:*), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
+
+    INTEGER :: iret,size(3),rstrides(4),cstrides(4)
+    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+    REAL*4 :: scale
+
+    rstrides=(/ 0,1,(sx1/2+1)*2,(sx1/2+1)*2*sx2 /)
+    cstrides=(/ 0,1,sx1/2+1,(sx1/2+1)*sx2 /)
+    size=(/ sx1,sx2,sx3 /)
+
+    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_REAL,3,size)
+    iret=DftiSetValue(desc,DFTI_CONJUGATE_EVEN_STORAGE,DFTI_COMPLEX_COMPLEX)
+
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+    IF (FFT_FORWARD == direction) THEN
+       scale=dx1*dx2*dx3
+       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
+       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,rstrides);
+       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,cstrides);
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeForward(desc,data)
+    ELSE
+       scale=1._4/(sx1*dx1*sx2*dx2*sx3*dx3)
+       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
+       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,cstrides);
+       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,rstrides);
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeBackward(desc,data)
+    END IF
+    iret=DftiFreeDescriptor(desc)
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+  END SUBROUTINE fft3
+#else
+  !------------------------------------------------------
+  ! implementation of ctfft (N. Brenner, 1968)
+  ! must be linked with ctfft.o
+  !------------------------------------------------------
+  SUBROUTINE fft3(data,sx1,sx2,sx3,dx1,dx2,dx3,direction)
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3,direction
+
+    INTEGER :: dim(3)
+    INTEGER :: FOURT_DS ! data storage
+    INTEGER, PARAMETER :: FOURT_NW = 128 ! extra work space size
+    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
+
+    dim=(/ sx1,sx2,sx3 /)
+
+    IF (FFT_FORWARD == direction) THEN
+       FOURT_DS=0
+    ELSE
+       FOURT_DS=-1
+    END IF
+    CALL ctfft(data,dim,3,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
+
+    IF (FFT_INVERSE == direction) THEN
+       data=data/(sx1*dx1*sx2*dx2*sx3*dx3)
+    ELSE
+       data=data*(dx1*dx2*dx3)
+    END IF
+
+  END SUBROUTINE fft3
+#endif
+#endif
+#endif
+  !----------------------------------------------------------------------
+  !> subroutine FFT2 performs normalized forward and
+  !! inverse fourier transforms of real 2d data
+  !!
+  !! USES subroutine FOURT
+  !! ctfft(data,n,ndim,isign,iform,work,nwork)
+  !! or
+  !! fftw3
+  !!
+  !! for real array the fourier transform returns a sx1/2+1 complex array
+  !! and the enough space must be reserved
+  !----------------------------------------------------------------------
+#ifdef FFTW3
+  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
+    INTEGER, INTENT(IN) :: sx1,sx2,direction
+    REAL*4, DIMENSION(sx1+2,sx2), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2
+
+    INTEGER*8 :: plan
+
+    IF (FFT_FORWARD == direction) THEN
+      CALL sfftw_plan_dft_r2c_2d(plan,sx1,sx2, &
+           data(1,1),data(1,1),FFTW_ESTIMATE)
+    ELSE
+      CALL sfftw_plan_dft_c2r_2d(plan,sx1,sx2, &
+           data(1,1),data(1,1),FFTW_ESTIMATE)
+    END IF
+
+    CALL sfftw_execute(plan)
+    CALL sfftw_destroy_plan(plan)
+
+    IF (FFT_INVERSE == direction) THEN
+      data=data/(sx1*dx1*sx2*dx2)
+    ELSE
+      data=data*(dx1*dx2)
+    END IF
+
+  END SUBROUTINE fft2
+#else
+#ifdef SGI_FFT
+  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
+    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2
+    INTEGER, INTENT(IN) :: sx1,sx2,direction
+
+    INTEGER, PARAMETER :: NF=256, NFR=256
+
+    REAL*4, DIMENSION(sx1+NFR+2*sx2+NF) :: table
+    REAL*4, DIMENSION(sx1+4*sx2) :: work
+    INTEGER, DIMENSION(2) :: isys
+    REAL*4 :: scale
+
+    isys(1)=1
+
+    IF (FFT_FORWARD == direction) THEN
+       scale=dx1*dx2
+       ! initialize the sin/cos table
+       CALL SCFFT2D(+0,sx1,sx2,scale,data(1,1),sx1+2, &
+                    data(1,1),sx1/2+1,table,work,isys)
+       CALL SCFFT2D(-1,sx1,sx2,scale,data(1,1),sx1+2, &
+                    data(1,1),sx1/2+1,table,work,isys)
+    ELSE
+       scale=1._4/(sx1*dx1*sx2*dx2)
+       ! initialize the sin/cos table
+       CALL CSFFT2D(+0,sx1,sx2,scale,data(1,1),sx1/2+1, &
+                    data(1,1),sx1+2,table,work,isys)
+       CALL CSFFT2D(+1,sx1,sx2,scale,data(1,1),sx1/2+1, &
+                    data(1,1),sx1+2,table,work,isys)
+    END IF
+
+  END SUBROUTINE fft2
+#else
+#ifdef IMKL_FFT
+  !------------------------------------------------------
+  ! implementation IMKL_FFT (Intel Math Kernel Library)
+  ! for information and example calculations with the
+  ! mkl FFT, see:
+  !
+  ! http://www.intel.com/software/products/mkl/ ...
+  !                      docs/webhelp/appendices/ ...
+  !                      mkl_appC_DFT.html#appC-exC-25
+  !
+  ! sylvain barbot (04-30-10) - original form
+  !------------------------------------------------------
+  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
+    REAL*4, DIMENSION(0:*), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2
+    INTEGER, INTENT(IN) :: sx1,sx2,direction
+
+    INTEGER :: iret,size(2),rstrides(3),cstrides(3)
+    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+    REAL*4 :: scale
+
+    rstrides=(/ 0,1,sx1+2 /)
+    cstrides=(/ 0,1,sx1/2+1 /)
+    size=(/ sx1,sx2 /)
+
+    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_REAL,2,size);
+    iret=DftiSetValue(desc,DFTI_CONJUGATE_EVEN_STORAGE,DFTI_COMPLEX_COMPLEX)
+
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+    IF (FFT_FORWARD == direction) THEN
+       scale=dx1*dx2
+       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
+       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,rstrides);
+       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,cstrides);
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeForward(desc,data)
+    ELSE
+       scale=1._4/(sx1*dx1*sx2*dx2)
+       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
+       iret=DftiSetValue(desc,DFTI_INPUT_STRIDES,cstrides);
+       iret=DftiSetValue(desc,DFTI_OUTPUT_STRIDES,rstrides);
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeBackward(desc,data)
+    END IF
+    iret=DftiFreeDescriptor(desc)
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+  END SUBROUTINE fft2
+#else
+  !------------------------------------------------------
+  ! Couley-Tuckey implementation of the Fourier 
+  ! transform with built-in FFT code (ctfft.f).
+  !------------------------------------------------------
+  SUBROUTINE fft2(data,sx1,sx2,dx1,dx2,direction)
+    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx1,dx2
+    INTEGER, INTENT(IN) :: sx1,sx2,direction
+
+    INTEGER :: dim(2)
+    INTEGER :: FOURT_DS ! data storage
+    INTEGER, PARAMETER :: FOURT_NW = 64 ! extra work space size
+    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
+
+    dim=(/ sx1,sx2 /)
+
+    IF (FFT_FORWARD == direction) THEN
+       FOURT_DS=0
+    ELSE
+       FOURT_DS=-1
+    END IF
+    CALL ctfft(data,dim,2,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
+
+    IF (FFT_INVERSE == direction) THEN
+       data=data/(sx1*dx1*sx2*dx2)
+    ELSE
+       data=data*(dx1*dx2)
+    END IF
+
+  END SUBROUTINE fft2
+#endif
+#endif
+#endif
+
+  !-----------------------------------------------------------------
+  !> subroutine FFT1
+  !! performs a one dimensional complex to complex Fourier
+  !! transform
+  !!
+  !! uses complex DFT ctfft (N. Brenner, 1968) by default
+  !! or CCFFT (SGI library) with compile flag SGI_FFT
+  !!
+  !! \author sylvain barbot (05-02-07) - original form
+  !-----------------------------------------------------------------
+#ifdef SGI_FFT
+  !------------------------------------------------------
+  ! implementation CCFFT
+  !
+  ! sylvain barbot (09-28-08) - original form
+  !------------------------------------------------------
+  SUBROUTINE fft1(data,sx,dx,direction)
+    INTEGER, INTENT(IN) :: sx,direction
+    COMPLEX(KIND=4), DIMENSION(:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx
+
+    INTEGER, PARAMETER :: NF=256
+
+    REAL*4, DIMENSION(2*sx+NF) :: table
+    REAL*4, DIMENSION(2*sx) :: work
+    INTEGER, DIMENSION(2) :: isys
+    REAL*4 :: scale
+
+    isys(1)=1
+
+    IF (FFT_FORWARD == direction) THEN
+       scale=dx
+       ! initialize the sin/cos table
+       CALL CCFFT(+0,sx,scale,data,data,table,work,isys)
+       CALL CCFFT(-1,sx,scale,data,data,table,work,isys)
+    ELSE
+       scale=1._4/(sx*dx)
+       ! initialize the sin/cos table
+       CALL CCFFT(+0,sx,scale,data,data,table,work,isys)
+       CALL CCFFT(+1,sx,scale,data,data,table,work,isys)
+    END IF
+
+  END SUBROUTINE fft1
+#else
+#ifdef IMKL_FFT
+  !------------------------------------------------------
+  ! implementation IMKL_FFT (Intel Math Kernel Library)
+  ! evaluates a complex-to-complex Fourier transform
+  !
+  ! sylvain barbot (04-30-10) - original form
+  !------------------------------------------------------
+  SUBROUTINE fft1(data,sx,dx,direction)
+    INTEGER, INTENT(IN) :: sx,direction
+    COMPLEX(KIND=4), DIMENSION(0:*), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx
+
+    INTEGER :: iret
+    TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+
+    REAL*4 :: scale
+
+    iret=DftiCreateDescriptor(desc,DFTI_SINGLE,DFTI_COMPLEX,1,sx)
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+    IF (FFT_FORWARD == direction) THEN
+       scale=dx
+       iret=DftiSetValue(desc,DFTI_FORWARD_SCALE,scale)
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeForward(desc,data)
+    ELSE
+       scale=1._4/(sx*dx)
+       iret=DftiSetValue(desc,DFTI_BACKWARD_SCALE,scale)
+       iret=DftiCommitDescriptor(desc)
+       iret=DftiComputeBackward(desc,data)
+    END IF
+    iret=DftiFreeDescriptor(desc)
+    IF(iret.NE.0) THEN
+       IF(.NOT.DftiErrorClass(iret,DFTI_NO_ERROR)) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,*) DftiErrorMessage(iret)
+          STOP 1
+       END IF
+    END IF
+
+  END SUBROUTINE fft1
+#else
+  !----------------------------------------------------
+  ! implementation ctfft
+  !
+  ! sylvain barbot (05-02-07) - original form
+  !----------------------------------------------------
+  SUBROUTINE fft1(data,sx,dx,direction)
+    COMPLEX(KIND=4),DIMENSION(:), INTENT(INOUT) :: data
+    REAL*8, INTENT(IN) :: dx
+    INTEGER, INTENT(IN) :: sx,direction
+
+    INTEGER, PARAMETER :: FOURT_NW = 32 ! extra work space size
+    REAL*4, DIMENSION(FOURT_NW) :: FOURT_WORK ! extra work space
+    INTEGER :: FOURT_DS = 1
+
+    CALL ctfft(data,sx,1,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
+    IF (FFT_INVERSE == direction) THEN
+       data=data/(sx*dx)
+    ELSE
+       data=data*dx
+    END IF
+
+  END SUBROUTINE fft1
+#endif
+#endif
+
+END MODULE fourier
diff -r 405d8f4fa05f -r e7295294f654 src/friction3d.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/friction3d.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,553 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+MODULE friction3d
+
+  USE elastic3d
+
+  IMPLICIT NONE
+
+#include "include.f90"
+
+  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
+  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
+  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
+
+CONTAINS
+
+  !-----------------------------------------------------------------
+  !> subroutine FrictionPlaneExpEigenStress
+  !!
+  !! *** this function is deprecated ***
+  !
+  ! compute the eigen-stress (forcing moment) to be relaxed by
+  ! rate-dependent inelastic deformation in the case of a frictional
+  ! surface:
+  !
+  !       sigma^i = C:F:sigma
+  !
+  ! where C is the elastic moduli tensor, F is the heterogeneous
+  ! fluidity moduli tensor and sigma is the instantaneous stress
+  ! tensor. for a frictional surface, the eigenstrain-rate is given
+  ! by
+  !
+  !       epsilon^i^dot = F:sigma = gamma^dot R
+  !
+  ! where gamma^dot is the slip rate (a scalar) and R is the
+  ! deviatoric, symmetric, and unitary, tensor:
+  !
+  !       R_ij = 1/2 ( t_i n_j + t_j n_i ) / sqrt( t_j t_j )
+  !
+  ! where the shear traction t_i is the projection of the traction
+  ! vector on the plane surface. the strain amplitude is given by
+  !
+  !       gamma^dot = vo sinh( taus / (t_c )
+  !
+  ! where taus is the effective shear on the fault plane,
+  !
+  !       taus = tau + mu*sigma
+  !
+  ! where tau is the shear and sigma the normal stress. tau and sigma
+  ! assumed to be the co-seismic change only, not the absolute
+  ! stress. vo is a reference slip velocity, and t_c, the critical
+  ! stress, corresponds to (a-b)*sigma in the framework of rate-and-
+  ! state friction. the effective viscosity eta* and the fluidity
+  !
+  !       eta* = tau / gamma^dot
+  !       fluidity = 1 / eta*
+  !
+  ! are used to compute the optimal time-step.
+  !
+  ! sylvain barbot (07/24/07) - original form
+  !                (07/24/07) - deprecated (see frictioneigenstress)
+  !-----------------------------------------------------------------
+  SUBROUTINE frictionplaneeigenstress(sig,mu,structure, &
+       n1,n2,n3,sx1,sx2,sx3,dx1,dx2,dx3,moment,maxwelltime,gamma,dt)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3
+    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: moment
+    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(IN), DIMENSION(sx1+2,sx2,sx3) :: n1,n2,n3
+    REAL*4, INTENT(OUT), DIMENSION(sx1+2,sx2,sx3), OPTIONAL :: gamma
+#else
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: n1,n2,n3
+    REAL*4, INTENT(OUT), DIMENSION(sx1,sx2,sx3), OPTIONAL :: gamma
+#endif
+    REAL*8, INTENT(IN), OPTIONAL :: dt
+
+    INTEGER :: i1,i2,i3
+    TYPE(TENSOR) :: s
+    REAL*8, DIMENSION(3) :: t,ts,n
+    REAL*8 :: vo,taue,tauc,taun,taus,gammadot,impulse, &
+         friction,tau,scaling,cohesion
+
+    ! delta function scaling
+    scaling=sqrt(pi2)*dx1
+
+    DO i3=1,sx3
+       
+       vo=structure(i3)%gammadot0
+       tauc=structure(i3)%stressexponent
+       friction=structure(i3)%friction
+       cohesion=structure(i3)%cohesion
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             n=(/ DBLE(n1(i1,i2,i3)),DBLE(n2(i1,i2,i3)),DBLE(n3(i1,i2,i3))/)
+             impulse=sqrt(sum(n*n))
+
+             IF (impulse .LE. 0.01_8/dx1) CYCLE
+
+             ! discrete delta function impulse
+             n=n/impulse
+             
+             ! traction = sigma . n
+             s=sig(i1,i2,i3)
+             t=s .tdot. n
+
+             ! signed normal component
+             taun=SUM(t*n)
+
+             ! absolute value of shear component
+             ts=t-taun*n
+             taus=SQRT(SUM(ts*ts))
+             
+             ! effective shear stress on fault plane
+             tau=taus+friction*taun
+
+             ! warning for wrong input
+             IF ((tau/tauc) .gt. 20) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("------------------------------------------")')
+                WRITE (0,'("wrong value of (a-b)sigma gives rise to")')
+                WRITE (0,'("(a-b)sigma=",3ES11.3E2)') tauc
+                WRITE (0,'("tau=",3ES11.3E2)') tau
+                WRITE (0,'("taus=",3ES11.3E2)') taus
+                WRITE (0,'("taun=",3ES11.3E2)') taun
+                WRITE (0,'("tau/((a-b)sigma)=",3ES11.3E2)') tau/tauc
+                WRITE (0,'("------------------------------------------")')
+                STOP 5
+             END IF
+
+             ! effective stress
+             taue=tau-cohesion
+
+             ! yield surface test
+             IF ((0._8 .GE. taus) .OR. (taue .LE. 1e-8)) CYCLE
+
+             ! shear traction direction
+             ts=ts/taus
+
+             ! deviatoric strain rate
+             gammadot=vo*2*sinh(taue/tauc)
+
+             IF (PRESENT(maxwelltime)) &
+                  maxwelltime=MIN(maxwelltime,taue/mu/gammadot)
+
+             ! provide the strain-rate on request
+             IF (PRESENT(gamma)) THEN
+                gamma(i1,i2,i3)=gamma(i1,i2,i3)+gammadot*impulse*scaling*dt
+             END IF
+
+             ! deviatoric strain
+             moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
+                  (ts .sdyad. ((2._8*mu*impulse*gammadot)*n))
+
+          END DO
+       END DO
+    END DO
+
+  END SUBROUTINE frictionplaneeigenstress
+
+  !-----------------------------------------------------------------
+  !> subroutine FrictionEigenStress
+  !! compute the eigen-stress (forcing moment) to be relaxed by
+  !! rate-dependent inelastic deformation in the case of a frictional
+  !! surface:
+  !!
+  !!        sigma^i = C:F:sigma
+  !!
+  !! where C is the elastic moduli tensor, F is the heterogeneous
+  !! fluidity moduli tensor and sigma is the instantaneous stress
+  !! tensor. for a frictional surface, the eigenstrain-rate is given
+  !! by
+  !!
+  !!        epsilon^i^dot = F:sigma = gamma^dot R
+  !!
+  !! where gamma^dot is the slip rate (a scalar) and R is the
+  !! deviatoric, symmetric, and unitary, tensor:
+  !!
+  !!        R_ij = 1/2 ( t_i n_j + t_j n_i ) / sqrt( t_j t_j )
+  !!
+  !! where the shear traction t_i is the projection of the traction
+  !! vector on the plane surface. the strain amplitude is given by
+  !!
+  !!        gamma^dot = H( t_j r_j ) 2 vo sinh( taus / (t_c )
+  !!
+  !! where taus is the effective shear on the fault plane,
+  !!
+  !!        taus = tau + mu*sigma
+  !!
+  !! where tau is the shear and sigma the normal stress. tau and sigma
+  !! assumed to be the co-seismic change only, not the absolute
+  !! stress. vo is a reference slip velocity, and t_c, the critical
+  !! stress, corresponds to (a-b)*sigma in the framework of rate-and-
+  !! state friction. the effective viscosity eta* and the fluidity
+  !!
+  !!        eta* = tau / gamma^dot
+  !!        fluidity = 1 / eta*
+  !!
+  !! are used to compute the optimal time-step. H( x ) is the 
+  !! Heaviside function and r_i is the rake vector. I impose
+  !! gamma^dot to be zero is t_j r_j < 0. This constraint is
+  !! enforced to ensure that no back slip occurs on faults.
+  !!
+  !! \author sylvain barbot (07/24/07) - original form
+  !!                        (02/28/11) - add constraints on the direction
+  !!                                     of afterslip
+  !-----------------------------------------------------------------
+  SUBROUTINE frictioneigenstress(x,y,z,L,W,strike,dip,rake,beta, &
+       sig,mu,structure,sx1,sx2,sx3,dx1,dx2,dx3,moment,maxwelltime,vel)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3,x,y,z,L,W,strike,dip,rake,beta
+    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(TENSOR), INTENT(INOUT), DIMENSION(sx1,sx2,sx3) :: moment
+    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
+#ifdef ALIGN_DATA
+    REAL*4, INTENT(OUT), DIMENSION(sx1+2,sx2,sx3), OPTIONAL :: vel
+#else
+    REAL*4, INTENT(OUT), DIMENSION(sx1,sx2,sx3), OPTIONAL :: vel
+#endif
+
+    INTEGER :: i1,i2,i3
+    TYPE(TENSOR) :: s
+    REAL*8, DIMENSION(3) :: t,ts,n,r
+    REAL*8 :: vo,tauc,taun,taus,gammadot,impulse, &
+         friction,tau,scaling,cohesion
+    REAL*8 :: x1,x2,x3,x1s,x2s,x3s,x1i,x3i, &
+         cstrike,sstrike,cdip,sdip,cr,sr,x2r,&
+         temp1,temp2,temp3,sourc,image,xr,yr,zr,Wp,Lp,dum
+    REAL*4 :: tm
+
+    IF (PRESENT(maxwelltime)) THEN
+       tm=maxwelltime
+    ELSE
+       tm=1e30
+    END IF
+    
+    ! delta function scaling
+    scaling=sqrt(pi2)*dx1
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+    
+    ! effective tapered dimensions
+    Wp=W*(1._8+2._8*beta)/2._8
+    Lp=L*(1._8+2._8*beta)/2._8
+    
+    ! rotate centre coordinates of source and images
+    x2r= cstrike*x  -sstrike*y
+    xr = cdip   *x2r-sdip   *z
+    yr = sstrike*x  +cstrike*y
+    zr = sdip   *x2r+cdip   *z
+    
+    ! surface normal vector components
+    n(1)=+cdip*cstrike
+    n(2)=-cdip*sstrike
+    n(3)=-sdip
+             
+    ! rake vector component
+    r(1)=sstrike*cr+cstrike*sdip*sr
+    r(2)=cstrike*cr-sstrike*sdip*sr
+    r(3)=cdip*sr
+
+    DO i3=1,sx3
+       x3=DBLE(i3-1)*dx3
+       IF ((abs(x3-z).gt.Lp) .and. (abs(x3+z).gt.Lp)) CYCLE
+
+       vo=structure(i3)%gammadot0
+       tauc=structure(i3)%stressexponent
+       friction=structure(i3)%friction
+       cohesion=structure(i3)%cohesion
+       
+       DO i2=1,sx2
+          DO i1=1,sx1
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+             IF ((ABS(x1-x).gt.MAX(Wp,Lp)) .OR.  (ABS(x2-y).gt.MAX(Wp,Lp))) CYCLE
+             
+             x2r= cstrike*x1-sstrike*x2
+             x1s= cdip*x2r-sdip*x3
+             x1i= cdip*x2r+sdip*x3
+             IF ((ABS(x1s-xr).GT.7.01_8*dx1).AND.(ABS(x1i-xr).GT.7.01_8*dx1)) CYCLE
+             x2s= sstrike*x1+cstrike*x2
+             x3s= sdip*x2r+cdip*x3
+             x3i=-sdip*x2r+cdip*x3
+
+             ! integrate at depth and along strike with raised cosine taper
+             ! and shift sources to x,y,z coordinate
+             temp1=gauss(x1s-xr,dx1)
+             temp2=omega((x2s-yr)/W,beta)
+             temp3=omega((x3s-zr)/L,beta)
+             sourc=temp1*temp2*temp3
+
+             temp1=gauss(x1i-xr,dx1)
+             temp3=omega((x3i+zr)/L,beta)
+             image=temp1*temp2*temp3
+
+             impulse=sourc+image
+
+             ! traction = sigma . n
+             s=sig(i1,i2,i3)
+             t=s .tdot. n
+
+             ! signed normal component
+             taun=SUM(t*n)
+
+             ! absolute value of shear component
+             ts=t-taun*n
+             taus=SQRT(SUM(ts*ts))
+
+             ! effective shear stress on fault plane
+             tau=MAX(0.d0,taus+friction*taun-cohesion)
+
+             ! rake direction test only if | rake | < 3*Pi
+             IF (SUM(ts*r).LT.0.d0 .AND. ABS(rake).LT.pi2*1.5d0) CYCLE
+
+             ! warning for wrong input
+             IF ((tau/tauc) .gt. 20) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("------------------------------------------")')
+                WRITE (0,'("wrong value of (a-b)sigma gives rise to")')
+                WRITE (0,'("(a - b) * sigma       = ",ES11.3E2)') tauc
+                WRITE (0,'("tau                   = ",ES11.3E2)') tau
+                WRITE (0,'("tau_s                 = ",ES11.3E2)') taus
+                WRITE (0,'("tau_n                 = ",ES11.3E2)') taun
+                WRITE (0,'("tau / ((a - b) sigma) = ",ES11.3E2)') tau/tauc
+                WRITE (0,'("------------------------------------------")')
+                STOP 5
+             END IF
+
+             ! shear traction direction
+             ts=ts/taus
+
+             ! deviatoric strain rate
+             gammadot=vo*2._8*sinh(tau/tauc)
+
+             tm=MIN(tm,tau/mu/gammadot*(MIN(L,W)/sqrt(dx1*dx3)))
+
+             ! provide the strain-rate on request
+             IF (PRESENT(vel)) THEN
+                vel(i1,i2,i3)=vel(i1,i2,i3)+gammadot*impulse*scaling
+             END IF
+
+             ! deviatoric strain
+             moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
+                  (ts .sdyad. ((2._8*mu*impulse*gammadot)*n))
+
+          END DO
+       END DO
+    END DO
+
+    IF (PRESENT(maxwelltime)) maxwelltime=MIN(tm,maxwelltime)
+
+  END SUBROUTINE frictioneigenstress
+
+  !---------------------------------------------------------------------
+  !> function MonitorFriction
+  !! samples a scalar field along a specified planar surface.
+  !!
+  !! input:
+  !! @param x,y,z       coordinates of the creeping segment
+  !! @param L           dimension of segment in the depth direction
+  !! @param W           dimension of segment in the strike direction
+  !! @param beta        smoothing factor
+  !! @param sx1,2,3     dimension of the stress tensor array
+  !! @param dx1,2,3     sampling size
+  !! @param sig         stress tensor array
+  !! @param structure   frictional properties as a function of depth
+  !!
+  !! output:
+  !! @param patch       list of strike- and dip-slip as a function of position
+  !!                    on the fault.     
+  !! 
+  !! \author sylvain barbot (10-16-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE monitorfriction(x,y,z,L,W,strike,dip,rake,beta, &
+       sx1,sx2,sx3,dx1,dx2,dx3,sig,structure,patch)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: x,y,z,L,W,strike,rake,dip,beta,dx1,dx2,dx3
+    TYPE(TENSOR), DIMENSION(sx1,sx2,sx3), INTENT(IN) :: sig
+    TYPE(SLIPPATCH_STRUCT), ALLOCATABLE, DIMENSION(:,:), INTENT(INOUT) :: patch
+    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
+
+    INTEGER :: i1,i2,i3,px2,px3,j2,j3,status
+    REAL*8 :: cstrike,sstrike,cdip,sdip,cr,sr
+    REAL*8 :: vo,tauc,taun,taus, &
+         friction,tau,cohesion
+    REAL*8 :: x1,x2,x3,xr,yr,zr
+    TYPE(TENSOR) :: s
+    REAL*8, DIMENSION(3) :: t,ts,n,sv,dv,r
+
+    cstrike=cos(strike)
+    sstrike=sin(strike)
+    cdip=cos(dip)
+    sdip=sin(dip)
+    cr=cos(rake)
+    sr=sin(rake)
+
+    ! strike direction vector
+    sv=(/ sstrike, cstrike, 0._8 /)
+
+    ! dip direction vector
+    dv=(/ -cstrike*sdip, +sstrike*sdip, -cdip /)
+
+    ! number of samples in the dip and strike direction
+    px2=SIZE(patch,1)
+    px3=SIZE(patch,2)
+
+    ! surface normal vector components
+    n(1)=+cdip*cstrike
+    n(2)=-cdip*sstrike
+    n(3)=-sdip
+             
+    ! rake vector component
+    r(1)=sstrike*cr+cstrike*sdip*sr
+    r(2)=cstrike*cr-sstrike*sdip*sr
+    r(3)=cdip*sr
+
+    ! loop in the dip direction
+    DO j3=1,px3
+       ! loop in the strike direction
+       DO j2=1,px2
+
+          CALL ref2local(x,y,z,xr,yr,zr)
+          
+          ! no translation in out of plane direction
+          yr=REAL(yr)+REAL((DBLE(j2)-DBLE(px2)/2._8-1._8)*dx2)
+          zr=REAL(zr)+REAL((DBLE(j3)-DBLE(px3)/2._8-1._8)*dx3)
+          
+          CALL local2ref(xr,yr,zr,x1,x2,x3)
+
+          ! initialize zero slip velocity
+          patch(j2,j3)=SLIPPATCH_STRUCT(x1,x2,x3,yr,zr,0._8,0._8,0._8, &
+                                        0._8,0._8,0._8,0._8,s)
+
+          ! discard out-of-bound locations
+          IF (  (x1 .GT. DBLE(sx1/2-1)*dx1) .OR. (x1 .LT. -DBLE(sx1/2)*dx1) &
+           .OR. (x2 .GT. DBLE(sx2/2-1)*dx2) .OR. (x2 .LT. -DBLE(sx2/2)*dx2) &
+           .OR. (x3 .GT. DBLE(sx3-1)*dx3) .OR. (x3 .LT. 0._8)  ) CYCLE
+
+          ! evaluates instantaneous creep velocity
+          CALL shiftedindex(x1,x2,x3,sx1,sx2,sx3,dx1,dx2,dx3,i1,i2,i3)
+
+          ! retrieve friction parameters
+          vo=structure(i3)%gammadot0
+          tauc=structure(i3)%stressexponent
+          friction=structure(i3)%friction
+          cohesion=structure(i3)%cohesion
+       
+          ! traction = sigma . n
+          s=sig(i1,i2,i3)
+          t=s .tdot. n
+
+          ! signed normal component
+          taun=SUM(t*n)
+
+          ! absolute value of shear component
+          ts=t-taun*n
+          taus=SQRT(SUM(ts*ts))
+             
+          ! effective shear stress on fault plane
+          tau=MAX(0.d0,taus+friction*taun-cohesion)
+
+          ! rake direction test only if | rake | < 3*Pi
+          IF (SUM(ts*r).LT.0.d0 .AND. ABS(rake).LT.pi2*1.5d0) CYCLE
+
+          ! shear stress
+          patch(j2,j3)%taus=taus
+
+          ! creep rate
+          patch(j2,j3)%slip=vo*2._8*sinh(tau/tauc)
+          patch(j2,j3)%v=vo*2._8*sinh(tau/tauc)
+
+          ! shear traction direction
+          ts=ts/taus
+
+          ! strike-direction creep rate
+          patch(j2,j3)%ss=patch(j2,j3)%slip*SUM(ts*sv)
+          patch(j2,j3)%vss=patch(j2,j3)%v*SUM(ts*sv)
+
+          ! dip-direction creep rate
+          patch(j2,j3)%ds=patch(j2,j3)%slip*SUM(ts*dv)
+          patch(j2,j3)%vds=patch(j2,j3)%v*SUM(ts*dv)
+
+       END DO
+    END DO
+
+  CONTAINS
+
+    !-----------------------------------------------
+    ! subroutine ref2local
+    ! convert reference Cartesian coordinates into
+    ! the rotated, local fault coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE ref2local(x,y,z,xp,yp,zp)
+      REAL*8, INTENT(IN) :: x,y,z
+      REAL*8, INTENT(OUT) :: xp,yp,zp
+
+      REAL*8 :: x2
+
+      x2 = cstrike*x  -sstrike*y
+      xp = cdip   *x2 -sdip   *z
+      yp = sstrike*x  +cstrike*y
+      zp = sdip   *x2 +cdip   *z
+
+    END SUBROUTINE ref2local
+
+    !-----------------------------------------------
+    ! subroutine local2ref
+    ! converts a set of coordinates from the rotated
+    ! fault-aligned coordinate system into the
+    ! reference, Cartesian coordinates system.
+    !-----------------------------------------------
+    SUBROUTINE local2ref(xp,yp,zp,x,y,z)
+      REAL*8, INTENT(IN) :: xp,yp,zp
+      REAL*8, INTENT(OUT) :: x,y,z
+
+      REAL*8 :: x2p
+
+      x2p=  cdip*xp+sdip*zp
+      x  =  cstrike*x2p+sstrike*yp
+      y  = -sstrike*x2p+cstrike*yp
+      z  = -sdip*xp    +cdip*zp
+
+    END SUBROUTINE local2ref
+
+  END SUBROUTINE monitorfriction
+
+END MODULE friction3d
diff -r 405d8f4fa05f -r e7295294f654 src/getdata.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/getdata.f	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,30 @@
+	subroutine getdata(unit,line)
+	implicit none
+c
+c	First implemented in Potsdam, Feb, 1999
+c	Last modified: Potsdam, Nov, 2001, by R. Wang
+c
+	integer unit
+	character line*180,char*1
+c
+	integer i
+c
+c	this subroutine reads over all comment lines starting with "#".
+c
+	char='#'
+100	continue
+	if(char.eq.'#')then
+	  read(unit,'(a)')line
+	  i=1
+	  char=line(1:1)
+200	  continue
+	  if(char.eq.' ')then
+	    i=i+1
+	    char=line(i:i)
+	    goto 200
+	  endif
+	  goto 100
+	endif
+c
+	return
+	end
diff -r 405d8f4fa05f -r e7295294f654 src/getopt_m.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/getopt_m.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,233 @@
+! ------------------------------------------------------------
+! Copyright 2008 by Mark Gates
+!
+! This program is free software; you can redistribute or modify it under
+! the terms of the GNU general public license (GPL), version 2 or later.
+!
+! This program is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of
+! merchantability or fitness for a particular purpose.
+!
+! If you wish to incorporate this into non-GPL software, please contact
+! me regarding licensing terms.
+!
+! ------------------------------------------------------------
+! Fortran 95 getopt() and getopt_long(), similar to those in standard C library.
+!
+! ch = getopt( optstring, [longopts] )
+! Returns next option character from command line arguments.
+! If an option is not recognized, it returns '?'.
+! If no options are left, it returns a null character, char(0).
+!
+! optstring contains characters that are recognized as options.
+! If a character is followed by a colon, then it takes a required argument.
+! For example, "x" recognizes "-x", while "x:" recognizes "-x arg" or "-xarg".
+!
+! optopt is set to the option character, even if it isn't recognized.
+! optarg is set to the option's argument.
+! optind has the index of the next argument to process. Initially optind=1.
+! Errors are printed by default. Set opterr=.false. to suppress them.
+!
+! Grouped options are allowed, so "-abc" is the same as "-a -b -c".
+!
+! If longopts is present, it is an array of type(option_s), where each entry
+! describes one long option.
+!
+!    type option_s
+!        character(len=80) :: name
+!        logical           :: has_arg
+!        character         :: val
+!    end type
+!
+! The name field is the option name, without the leading -- double dash.
+! Set the has_arg field to true if it requires an argument, false if not.
+! The val field is returned. Typically this is set to the corresponding short
+! option, so short and long options can be processed together. (But there
+! is no requirement that every long option has a short option, or vice-versa.)
+!
+! -----
+! EXAMPLE
+! program test
+!     use getopt_m
+!     implicit none
+!     character:: ch
+!     type(option_s):: opts(2)
+!     opts(1) = option_s( "alpha", .false., 'a' )
+!     opts(2) = option_s( "beta",  .true.,  'b' )
+!     do
+!         select case( getopt( "ab:c", opts ))
+!             case( char(0))
+!                 exit
+!             case( 'a' )
+!                 print *, 'option alpha/a'
+!             case( 'b' )
+!                 print *, 'option beta/b=', optarg
+!             case( '?' )
+!                 print *, 'unknown option ', optopt
+!                 stop
+!             case default
+!                 print *, 'unhandled option ', optopt, ' (this is a bug)'
+!         end select
+!     end do
+! end program test
+!
+! Differences from C version:
+! - when options are finished, C version returns -1 instead of char(0),
+!   and thus stupidly requires an int instead of a char.
+! - does not support optreset
+! - does not support "--" as last argument
+! - if no argument, optarg is blank, not NULL
+! - argc and argv are implicit
+!
+! Differences for long options:
+! - optional argument to getopt(), rather than separate function getopt_long()
+! - has_arg is logical, and does not support optional_argument
+! - does not support flag field (and thus always returns val)
+! - does not support longindex
+! - does not support "--opt=value" syntax, only "--opt value"
+! - knows the length of longopts, so does not need an empty last record
+
+module getopt_m
+	implicit none
+	character(len=80):: optarg
+	character:: optopt
+	integer:: optind=1
+	logical:: opterr=.true.
+	
+	type option_s
+		character(len=80) :: name
+		logical           :: has_arg
+		character         :: val
+	end type
+	
+	! grpind is index of next option within group; always >= 2
+	integer, private:: grpind=2
+
+contains
+
+! ----------------------------------------
+! Return str(i:j) if 1 <= i <= j <= len(str),
+! else return empty string.
+! This is needed because Fortran standard allows but doesn't *require* short-circuited
+! logical AND and OR operators. So this sometimes fails:
+!     if ( i < len(str) .and. str(i+1:i+1) == ':' ) then
+! but this works:
+!     if ( substr(str, i+1, i+1) == ':' ) then
+
+character function substr( str, i, j )
+	! arguments
+	character(len=*), intent(in):: str
+	integer, intent(in):: i, j
+	
+	if ( 1 <= i .and. i <= j .and. j <= len(str)) then
+		substr = str(i:j)
+	else
+		substr = ''
+	endif
+end function substr
+
+
+! ----------------------------------------
+character function getopt( optstring, longopts )
+	! arguments
+	character(len=*), intent(in):: optstring
+	type(option_s),   intent(in), optional:: longopts(:)
+	
+	! local variables
+	character(len=80):: arg
+	
+	optarg = ''
+	if ( optind > iargc()) then
+		getopt = char(0)
+	endif
+	
+	call getarg( optind, arg )
+	if ( present( longopts ) .and. arg(1:2) == '--' ) then
+		getopt = process_long( longopts, arg )
+	elseif ( arg(1:1) == '-' ) then
+		getopt = process_short( optstring, arg )
+	else
+		getopt = char(0)
+	endif
+end function getopt
+
+
+! ----------------------------------------
+character function process_long( longopts, arg )
+	! arguments
+	type(option_s),   intent(in):: longopts(:)
+	character(len=*), intent(in):: arg
+	
+	! local variables
+	integer:: i
+	
+	! search for matching long option
+	optind = optind + 1
+	do i = 1, size(longopts)
+		if ( arg(3:) == longopts(i)%name ) then
+			optopt = longopts(i)%val
+			process_long = optopt
+			if ( longopts(i)%has_arg ) then
+				if ( optind <= iargc()) then
+					call getarg( optind, optarg )
+					optind = optind + 1
+				elseif ( opterr ) then
+					 WRITE (0,'(a,a,a)')  "error: option '", trim(arg), "' requires an argument"
+				endif
+			endif
+			return
+		endif
+	end do
+	! else not found
+	process_long = '?'
+	if ( opterr ) then
+		WRITE (0,'(a,a,a)'), "error: unrecognized option '", trim(arg), "'"
+	endif
+end function process_long
+
+
+! ----------------------------------------
+character function process_short( optstring, arg )
+	! arguments
+	character(len=*), intent(in):: optstring, arg
+	
+	! local variables
+	integer:: i, arglen
+	
+	arglen = len( trim( arg ))
+	optopt = arg(grpind:grpind)
+	process_short = optopt
+	
+	i = index( optstring, optopt )
+	if ( i == 0 ) then
+		! unrecognized option
+		process_short = '?'
+		if ( opterr ) then
+			print '(a,a,a)', "Error: unrecognized option '-", optopt, "'"
+		endif
+	endif
+	if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then
+		! required argument
+		optind = optind + 1
+		if ( arglen > grpind ) then
+			! -xarg, return remainder of arg
+			optarg = arg(grpind+1:arglen)
+		elseif ( optind <= iargc()) then
+			! -x arg, return next arg
+			call getarg( optind, optarg )
+			optind = optind + 1
+		elseif ( opterr ) then
+			WRITE (0,'(a,a,a)') "error: option '-", optopt, "' requires an argument"
+		endif
+		grpind = 2
+	elseif ( arglen > grpind ) then
+		! no argument (or unrecognized), go to next option in argument (-xyz)
+		grpind = grpind + 1
+	else
+		! no argument (or unrecognized), go to next argument
+		grpind = 2
+		optind = optind + 1
+	endif
+end function process_short
+
+end module getopt_m
diff -r 405d8f4fa05f -r e7295294f654 src/green.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/green.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,953 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+MODULE green
+
+  USE fourier
+
+  IMPLICIT NONE
+
+#include "include.f90"
+
+  PUBLIC
+  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
+  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
+  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
+    
+  INTEGER, PARAMETER :: GRN_IMAGE=1,GRN_HS=0
+
+CONTAINS
+
+  !------------------------------------------------------------------------
+  !> Subroutine ElasticResponse
+  !! apply the 2d elastic (half-space) transfert function
+  !! to the set of body forces.
+  !!
+  !! INPUT:
+  !! @param mu          shear modulus
+  !! @param f1,2,3      equivalent body-forces in the Fourier domain
+  !! @param dx1,2,3     sampling size
+  !!
+  !! \author sylvain barbot (04/14/07) - original form
+  !!                        (02/06/09) - parallel implementation with MPI and OpenMP
+  !!                        (01/06/11) - remove implementation with MPI
+  !------------------------------------------------------------------------
+  SUBROUTINE elasticresponse(lambda,mu,f1,f2,f3,dx1,dx2,dx3)
+    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: f1,f2,f3
+    
+    REAL*8 :: k1,k2,k3,denom,r2,ratio1,ratio2
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3,ubound3
+    COMPLEX(kind=8) :: buf1,buf2,buf3,c1,c2,c3
+    
+    sx1=SIZE(f2,1)-2
+    sx2=SIZE(f2,2)
+    sx3=SIZE(f2,3)
+    
+    ratio1=(lambda+mu)/(lambda+2._8*mu)/mu/(pi2**2._8)
+    ratio2=mu/(lambda+mu)
+    
+    ubound3=sx3
+
+    ! serial computation
+!$omp parallel do private(i1,i2,k1,k2,k3,r2,denom,c1,c2,c3,buf1,buf2,buf3)
+    DO i3=1,ubound3
+       CALL wavenumber3(i3,sx3,dx3,k3)
+       DO i2=1,sx2
+          CALL wavenumber2(i2,sx2,dx2,k2)
+          DO i1=1,sx1/2+1
+             CALL wavenumber1(i1,sx1,dx1,k1)
+             
+             r2=k1**2._8+k2**2._8+k3**2._8
+             denom=ratio1/r2**2
+             
+             c1=CMPLX(f1(2*i1-1,i2,i3),f1(2*i1,i2,i3),8)
+             c2=CMPLX(f2(2*i1-1,i2,i3),f2(2*i1,i2,i3),8)
+             c3=CMPLX(f3(2*i1-1,i2,i3),f3(2*i1,i2,i3),8)
+             
+             buf1=((k2**2._8+k3**2._8+ratio2*r2)*c1-k1*(k2*c2+k3*c3))*denom
+             buf2=((k1**2._8+k3**2._8+ratio2*r2)*c2-k2*(k1*c1+k3*c3))*denom
+             buf3=((k1**2._8+k2**2._8+ratio2*r2)*c3-k3*(k1*c1+k2*c2))*denom
+             
+             f1(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf1),AIMAG(buf1) /))
+             f2(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf2),AIMAG(buf2) /))
+             f3(2*i1-1:2*i1,i2,i3)=REAL((/ REAL(buf3),AIMAG(buf3) /))
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+    ! zero wavenumber, no net body-force
+    f1(1:2,1,1)=(/ 0._4, 0._4 /)
+    f2(1:2,1,1)=(/ 0._4, 0._4 /)
+    f3(1:2,1,1)=(/ 0._4, 0._4 /)
+
+  END SUBROUTINE elasticresponse
+
+  !---------------------------------------------------------------------
+  !> subroutine SurfaceNormalTraction
+  !! computes the two-dimensional field of surface normal stress
+  !! expressed in the Fourier domain.
+  !! The surface (x3=0) solution is obtained by integrating over the
+  !! wavenumbers in 3-direction in the Fourier domain.
+  !!
+  !! \author sylvain barbot (05-01-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE surfacenormaltraction(lambda, mu, u1, u2, u3, dx1, dx2, dx3, p)
+    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1, u2, u3
+    REAL*8, INTENT(IN) :: lambda, mu, dx1, dx2, dx3
+    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p
+    
+    INTEGER :: i1, i2, i3, sx1, sx2, sx3
+    REAL*8 :: k1, k2, k3, modulus
+    COMPLEX*8, PARAMETER :: i = CMPLX(0._8,pi2)
+    COMPLEX*8 :: sum, c1, c2, c3
+    
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+    
+    modulus=lambda+2*mu
+    
+    p=0
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1/2+1
+             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
+             
+             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3))
+             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3))
+             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3))
+             
+             sum=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))
+             
+             p(2*i1-1,i2)=p(2*i1-1,i2)+REAL( REAL(sum))
+             p(2*i1  ,i2)=p(2*i1  ,i2)+REAL(AIMAG(sum))
+          END DO
+       END DO
+    END DO
+    p=p/(sx3*dx3)
+    
+  END SUBROUTINE surfacenormaltraction
+
+  !---------------------------------------------------------------------
+  !> subroutine Boussinesq3D
+  !! computes the deformation field in the 3-dimensional grid
+  !! due to a normal stress at the surface. Apply the Fourier domain
+  !! solution of Steketee [1958].
+  !---------------------------------------------------------------------
+  SUBROUTINE boussinesq3d(p,lambda,mu,u1,u2,u3,dx1,dx2,dx3)
+    REAL*4, DIMENSION(:,:), INTENT(IN) :: p
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1, u2, u3
+    REAL*8, INTENT(IN) :: lambda, mu, dx1, dx2, dx3
+
+    INTEGER :: i1, i2, i3, sx1, sx2, sx3, status
+    REAL*8 :: k1, k2, k3, x3, alpha
+    COMPLEX, ALLOCATABLE, DIMENSION(:) :: b1, b2, b3
+    COMPLEX :: load
+
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+    
+    ALLOCATE(b1(sx3),b2(sx3),b3(sx3),STAT=status)
+    IF (0/=status) STOP "could not allocate arrays for Boussinesq3D"
+    
+    alpha=(lambda+mu)/(lambda+2*mu)
+
+    DO i2=1,sx2
+       DO i1=1,sx1/2+1
+          CALL wavenumbers(i1,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
+          load=CMPLX(p(2*i1-1,i2),p(2*i1,i2))
+          DO i3=1,sx3
+             IF (i3<=sx3/2) THEN
+                x3=DBLE(i3-1)*dx3
+             ELSE
+                x3=ABS(DBLE(i3-sx3-1)*dx3)
+             END IF
+             CALL steketeesolution(load,alpha,b1(i3),b2(i3),b3(i3),k1,k2,x3)
+          END DO
+          
+          ! transforms the Steketee solution into a full 3-dimensional
+          ! Fourier transform by 1d transforming in the 3-direction
+          CALL fft1(b1,sx3,dx3,FFT_FORWARD)
+          CALL fft1(b2,sx3,dx3,FFT_FORWARD)
+          CALL fft1(b3,sx3,dx3,FFT_FORWARD)
+          
+          ! add the Boussinesq contribution to the deformation field
+          DO i3=1,sx3
+             u1(2*i1-1:2*i1,i2,i3)=u1(2*i1-1:2*i1,i2,i3)+ &
+                  (/REAL(b1(i3)),AIMAG(b1(i3))/)
+             u2(2*i1-1:2*i1,i2,i3)=u2(2*i1-1:2*i1,i2,i3)+ &
+                  (/REAL(b2(i3)),AIMAG(b2(i3))/)
+             u3(2*i1-1:2*i1,i2,i3)=u3(2*i1-1:2*i1,i2,i3)+ &
+                  (/REAL(b3(i3)),AIMAG(b3(i3))/)
+          END DO
+       END DO
+    END DO
+
+    DEALLOCATE(b1,b2,b3)
+    
+    CONTAINS
+      !-----------------------------------------------------------------
+      !> subroutine SteketeeSolution
+      !! computes the spectrum (two-dimensional Fourier transform)
+      !! of the 3 components of the deformation field u1, u2, u3
+      !! at wavenumbers k1, k2 and position x3. This is the analytical
+      !! solution of [J. A. Steketee, On Volterra's dislocations in a
+      !! semi-infinite elastic medium, Canadian Journal of Physics, 1958]
+      !!
+      !! \author sylvain barbot (05-02-07) - original form
+      !-----------------------------------------------------------------
+      SUBROUTINE steketeesolution(p,alpha,u1,u2,u3,k1,k2,x3)
+        COMPLEX, INTENT(INOUT) :: u1, u2, u3
+        REAL*8, INTENT(IN) :: alpha, k1, k2, x3
+        COMPLEX, INTENT(IN) :: p
+        
+        REAL*8 :: beta, depthdecay
+        COMPLEX, PARAMETER :: i=CMPLX(0,1)
+        COMPLEX :: b
+        
+        beta=pi2*sqrt(k1**2._8+k2**2._8)
+        depthdecay=exp(-beta*abs(x3))
+        
+        IF (0==k1 .AND. 0==k2) THEN
+           u1=CMPLX(0.,0.)
+           u2=CMPLX(0.,0.)
+           u3=CMPLX(0.,0.)
+        ELSE
+           b=p/(2._8*mu*alpha*beta**3._8)
+           u1=i*alpha*pi2*beta*b*(1._8-1._8/alpha+beta*x3)*depthdecay
+           u2=u1
+           u1=u1*k1
+           u2=u2*k2
+           u3=-p/(2*mu*beta)*(1._8/alpha+beta*x3)*depthdecay
+        END IF
+        
+      END SUBROUTINE steketeesolution
+
+  END SUBROUTINE boussinesq3d
+
+  !---------------------------------------------------------------------
+  !> subroutine SurfaceTraction
+  !! computes the two-dimensional field of surface normal stress
+  !! expressed in the Fourier domain.
+  !! The surface (x3=0) solution is obtained by integrating over the
+  !! wavenumbers in 3-direction in the Fourier domain.
+  !!
+  !! \author sylvain barbot (07-07-07) - original form
+  !                         (02-09-09) - parallelized with mpi and openmp
+  !---------------------------------------------------------------------
+  SUBROUTINE surfacetraction(lambda,mu,u1,u2,u3,dx1,dx2,dx3,p1,p2,p3)
+    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1,u2,u3
+    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
+    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p1,p2,p3
+
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8 :: k1,k2,k3,modulus
+    COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2,8)
+    COMPLEX(KIND=8) :: sum1,sum2,sum3,c1,c2,c3
+
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+
+    modulus=lambda+2._8*mu
+
+    p1=0
+    p2=0
+    p3=0
+
+!$omp parallel do private(i1,i2,k1,k2,k3,c1,c2,c3,sum1,sum2,sum3), &
+!$omp reduction(+:p1,p2,p3)
+    DO i3=1,sx3
+       DO i2=1,sx2
+          DO i1=1,sx1/2+1
+             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
+
+             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3),8)
+             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3),8)
+             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3),8)
+
+             sum1=i*mu*(k3*c1+k1*c3)
+             sum2=i*mu*(k3*c2+k2*c3)
+             sum3=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))
+
+             p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2) &
+                  +(/REAL(REAL(sum1)),REAL(AIMAG(sum1))/)
+             p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2) &
+                  +(/REAL(REAL(sum2)),REAL(AIMAG(sum2))/)
+             p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2) &
+                  +(/REAL(REAL(sum3)),REAL(AIMAG(sum3))/)
+
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+    p1=p1/(sx3*dx3)
+    p2=p2/(sx3*dx3)
+    p3=p3/(sx3*dx3)
+
+  END SUBROUTINE surfacetraction
+
+  !---------------------------------------------------------------------
+  !> subroutine SurfaceTractionCowling
+  !! computes the two-dimensional field of the resulting traction 
+  !! expressed in the Fourier domain in the presence of gravity.
+  !!
+  !! The surface solution (x3=0) is obtained from the Fourier domain 
+  !! array by integrating over the wavenumbers in 3-direction.
+  !!
+  !! The effective traction at x3=0 is 
+  !!
+  !!     t_1 = sigma_13
+  !!     t_2 = sigma_23
+  !!     t_3 = sigma_33 - r g u3
+  !!         = sigma_33 - 2 mu alpha gamma u3
+  !!
+  !! \author sylvain barbot (07-07-07) - original form
+  !---------------------------------------------------------------------
+  SUBROUTINE surfacetractioncowling(lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3, &
+       p1,p2,p3)
+    REAL*4, INTENT(IN), DIMENSION(:,:,:) :: u1,u2,u3
+    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
+    REAL*4, INTENT(OUT), DIMENSION(:,:) :: p1,p2,p3
+    
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3
+    REAL*8 :: k1,k2,k3,modulus,alpha,grav
+    COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
+    COMPLEX*8 :: sum1,sum2,sum3,c1,c2,c3
+    
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+    
+    modulus=lambda+2._8*mu
+    alpha=(lambda+mu)/(lambda+2._8*mu)
+    grav=2._8*mu*alpha*gamma
+    
+    p1=0
+    p2=0
+    p3=0
+
+!$omp parallel do private(i1,i3,k1,k2,k3,c1,c2,c3,sum1,sum2,sum3)
+!!!$omp reduction(+:p1,p2,p3)
+    DO i2=1,sx2
+       DO i3=1,sx3
+          DO i1=1,sx1/2+1
+             CALL wavenumbers(i1,i2,i3,sx1,sx2,sx3,dx1,dx2,dx3,k1,k2,k3)
+             
+             c1=CMPLX(u1(2*i1-1,i2,i3),u1(2*i1,i2,i3))
+             c2=CMPLX(u2(2*i1-1,i2,i3),u2(2*i1,i2,i3))
+             c3=CMPLX(u3(2*i1-1,i2,i3),u3(2*i1,i2,i3))
+
+             sum1=i*mu*(k3*c1+k1*c3)
+             sum2=i*mu*(k3*c2+k2*c3)
+             sum3=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))-grav*c3
+             
+             p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2)+(/REAL(sum1),AIMAG(sum1)/)
+             p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2)+(/REAL(sum2),AIMAG(sum2)/)
+             p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2)+(/REAL(sum3),AIMAG(sum3)/)
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+    p1=p1/(sx3*dx3)
+    p2=p2/(sx3*dx3)
+    p3=p3/(sx3*dx3)
+    
+  END SUBROUTINE surfacetractioncowling
+
+  !---------------------------------------------------------------------
+  !> subroutine Cerruti3D
+  !! computes the deformation field in the 3-dimensional grid
+  !! due to an arbitrary surface traction.
+  !!
+  !! \author sylvain barbot (07/07/07) - original form
+  !                (02/01/09) - parallelized with MPI and OpenMP
+  !                (01/06/11) - remove parallelized version with MPI
+  !---------------------------------------------------------------------
+  SUBROUTINE cerruti3d(p1,p2,p3,lambda,mu,u1,u2,u3,dx1,dx2,dx3)
+    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
+    REAL*8, INTENT(IN) :: lambda,mu,dx1,dx2,dx3
+
+    INTEGER :: i1,i2,i3,ib,sx1,sx2,sx3,iostatus,buffersize
+    REAL*8 :: k1,k2,k3,x3,alpha
+    COMPLEX(KIND=4) :: t1,t2,t3
+    INTEGER, PARAMETER :: stride=64
+    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:,:) :: b1,b2,b3
+
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+
+    alpha=(lambda+mu)/(lambda+2*mu)
+
+    ! serial programmation implementation
+!$omp parallel private(b1,b2,b3,iostatus)
+
+    ALLOCATE(b1(sx3,stride),b2(sx3,stride),b3(sx3,stride),STAT=iostatus)
+    IF (0/=iostatus) STOP "could not allocate arrays for Cerruti3D"
+
+!$omp do private(i1,i3,ib,k1,k2,k3,t1,t2,t3,x3,buffersize)
+    DO i2=1,sx2
+       DO i1=1,sx1/2+1,stride
+
+          ! buffer results
+          IF (i1+stride-1 .GT. sx1/2+1) THEN
+             buffersize=sx1/2+1-i1+1
+          ELSE
+             buffersize=stride
+          END IF
+
+          DO ib=0,buffersize-1
+
+             CALL wavenumbers(i1+ib,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
+             t1=CMPLX(p1(2*(i1+ib)-1,i2),p1(2*(i1+ib),i2),4)
+             t2=CMPLX(p2(2*(i1+ib)-1,i2),p2(2*(i1+ib),i2),4)
+             t3=CMPLX(p3(2*(i1+ib)-1,i2),p3(2*(i1+ib),i2),4)
+
+             DO i3=1,sx3
+                IF (i3<=sx3/2) THEN
+                   x3=DBLE(i3-1)*dx3
+                ELSE
+                   x3=ABS(DBLE(i3-sx3-1)*dx3)
+                END IF
+                CALL cerrutisolution(mu,t1,t2,t3,alpha,b1(i3,ib+1),b2(i3,ib+1),b3(i3,ib+1),k1,k2,x3)
+             END DO
+
+             ! transforms the Cerruti solution into a full 3-dimensional
+             ! Fourier transform by 1d transforming in the 3-direction
+             CALL fft1(b1(:,ib+1),sx3,dx3,FFT_FORWARD)
+             CALL fft1(b2(:,ib+1),sx3,dx3,FFT_FORWARD)
+             CALL fft1(b3(:,ib+1),sx3,dx3,FFT_FORWARD)
+
+          END DO
+
+          ! update solution displacement
+          DO i3=1,sx3
+             DO ib=0,buffersize-1
+                u1(2*(i1+ib)-1,i2,i3)=u1(2*(i1+ib)-1,i2,i3)+REAL( REAL(b1(i3,ib+1)))
+                u1(2*(i1+ib)  ,i2,i3)=u1(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b1(i3,ib+1)))
+                u2(2*(i1+ib)-1,i2,i3)=u2(2*(i1+ib)-1,i2,i3)+REAL( REAL(b2(i3,ib+1)))
+                u2(2*(i1+ib)  ,i2,i3)=u2(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b2(i3,ib+1)))
+                u3(2*(i1+ib)-1,i2,i3)=u3(2*(i1+ib)-1,i2,i3)+REAL( REAL(b3(i3,ib+1)))
+                u3(2*(i1+ib)  ,i2,i3)=u3(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b3(i3,ib+1)))
+             END DO
+          END DO
+
+       END DO
+    END DO
+
+    DEALLOCATE(b1,b2,b3)
+!$omp end parallel
+
+    CONTAINS
+      !-----------------------------------------------------------------
+      !> subroutine CerrutiSolution
+      !! computes the general solution for the deformation field in an
+      !! elastic half-space due to an arbitrary surface traction.
+      !! the 3 components u1, u2, u3 of the deformation field are
+      !! expressed in the horizontal Fourier at depth x3.
+      !! this combines the solution to the Boussinesq's and the Cerruti's
+      !! problem in a half-space.
+      !!
+      !! \author sylvain barbot (07-07-07) - original form
+      !-----------------------------------------------------------------
+      SUBROUTINE cerrutisolution(mu,p1,p2,p3,alpha,u1,u2,u3,k1,k2,x3)
+        COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
+        REAL*8, INTENT(IN) :: mu,alpha,k1,k2,x3
+        COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
+
+        REAL*8 :: beta, depthdecay
+        COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2,8)
+        REAL*8  :: temp
+        COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
+
+        beta=pi2*sqrt(k1**2+k2**2)
+        depthdecay=exp(-beta*abs(x3))
+
+        IF (0==k1 .AND. 0==k2) THEN
+           u1=CMPLX(0._4,0._4,4)
+           u2=CMPLX(0._4,0._4,4)
+           u3=CMPLX(0._4,0._4,4)
+        ELSE
+           temp=1._8/(2._8*mu*beta**3)*depthdecay
+           b1=temp*p1
+           b2=temp*p2
+           b3=temp*p3
+
+           ! b3 contribution
+           tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
+           v1=tmp*k1
+           v2=tmp*k2
+           v3=-beta**2*b3*(1._8/alpha+beta*x3)
+
+           ! b1 contribution
+           temp=pi2**2*(2._8-1._8/alpha+beta*x3)
+           v1=v1+b1*(-2._8*beta**2+k1**2*temp)
+           v2=v2+b1*k1*k2*temp
+           v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)
+
+           ! b2 contribution & switch to single-precision
+           u1=v1+b2*k1*k2*temp
+           u2=v2+b2*(-2._8*beta**2+k2**2*temp)
+           u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)
+        END IF
+
+      END SUBROUTINE cerrutisolution
+  END SUBROUTINE cerruti3d
+
+  !---------------------------------------------------------------------
+  !> subroutine CerrutiCowling
+  !! computes the deformation field in the 3-dimensional grid
+  !! due to an arbitrary surface traction.
+  !!
+  !! \author sylvain barbot - (07/07/07) - original form
+  !!                          (21/11/08) - gravity effect
+  !!                          (02/01/09) - parallelized with MPI and OpenMP
+  !!                          (01/06/11) - remove parallelized version with MPI
+  !---------------------------------------------------------------------
+  SUBROUTINE cerruticowling(p1,p2,p3,lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3)
+    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
+    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
+
+    INTEGER :: i1,i2,i3,ib,sx1,sx2,sx3,iostatus,buffersize
+    REAL*8 :: k1,k2,k3,x3,alpha
+    COMPLEX(KIND=4) :: t1,t2,t3
+    INTEGER, PARAMETER :: stride=64
+    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:,:) :: b1,b2,b3
+
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+
+    alpha=(lambda+mu)/(lambda+2*mu)
+
+    ! serial programmation implementation
+!$omp parallel private(b1,b2,b3,iostatus)
+
+    ALLOCATE(b1(sx3,stride),b2(sx3,stride),b3(sx3,stride),STAT=iostatus)
+    IF (0/=iostatus) STOP "could not allocate arrays for Cerruti3D"
+
+!$omp do private(i1,i3,ib,k1,k2,k3,t1,t2,t3,x3,buffersize)
+    DO i2=1,sx2
+       DO i1=1,sx1/2+1,stride
+
+          ! buffer results
+          IF (i1+stride-1 .GT. sx1/2+1) THEN
+             buffersize=sx1/2+1-i1+1
+          ELSE
+             buffersize=stride
+          END IF
+
+          DO ib=0,buffersize-1
+
+             CALL wavenumbers(i1+ib,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
+             t1=CMPLX(p1(2*(i1+ib)-1,i2),p1(2*(i1+ib),i2),4)
+             t2=CMPLX(p2(2*(i1+ib)-1,i2),p2(2*(i1+ib),i2),4)
+             t3=CMPLX(p3(2*(i1+ib)-1,i2),p3(2*(i1+ib),i2),4)
+
+             DO i3=1,sx3
+                IF (i3<=sx3/2) THEN
+                   x3=DBLE(i3-1)*dx3
+                ELSE
+                   x3=ABS(DBLE(i3-sx3-1)*dx3)
+                END IF
+                CALL cerrutisolcowling(mu,t1,t2,t3,alpha,gamma, &
+                     b1(i3,ib+1),b2(i3,ib+1),b3(i3,ib+1),k1,k2,x3,DBLE(sx3/2)*dx3)
+             END DO
+
+             ! transforms the Cerruti solution into a full 3-dimensional
+             ! Fourier transform by 1d transforming in the 3-direction
+             CALL fft1(b1(:,ib+1),sx3,dx3,FFT_FORWARD)
+             CALL fft1(b2(:,ib+1),sx3,dx3,FFT_FORWARD)
+             CALL fft1(b3(:,ib+1),sx3,dx3,FFT_FORWARD)
+
+          END DO
+
+          ! update solution displacement
+          DO i3=1,sx3
+             DO ib=0,buffersize-1
+                u1(2*(i1+ib)-1,i2,i3)=u1(2*(i1+ib)-1,i2,i3)+REAL( REAL(b1(i3,ib+1)))
+                u1(2*(i1+ib)  ,i2,i3)=u1(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b1(i3,ib+1)))
+                u2(2*(i1+ib)-1,i2,i3)=u2(2*(i1+ib)-1,i2,i3)+REAL( REAL(b2(i3,ib+1)))
+                u2(2*(i1+ib)  ,i2,i3)=u2(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b2(i3,ib+1)))
+                u3(2*(i1+ib)-1,i2,i3)=u3(2*(i1+ib)-1,i2,i3)+REAL( REAL(b3(i3,ib+1)))
+                u3(2*(i1+ib)  ,i2,i3)=u3(2*(i1+ib)  ,i2,i3)+REAL(AIMAG(b3(i3,ib+1)))
+             END DO
+          END DO
+
+       END DO
+    END DO
+
+    DEALLOCATE(b1,b2,b3)
+!$omp end parallel
+
+    CONTAINS
+
+      !-----------------------------------------------------------------
+      !> subroutine CerrutiSolCowling
+      !! computes the general solution for the deformation field in an
+      !! elastic half-space due to an arbitrary surface traction in the
+      !! presence of gravity.
+      !!
+      !! The 3 components u1, u2 and u3 of the deformation field are 
+      !! expressed in the horizontal Fourier at depth x3. 
+      !!
+      !! Combines the solution to the Boussinesq's and the Cerruti's 
+      !! problem in a half-space with buoyancy boundary conditions.
+      !
+      ! sylvain barbot (07-07-07) - original form
+      !                (08-30-10) - account for net surface traction
+      !-----------------------------------------------------------------
+      SUBROUTINE cerrutisolcowling(mu,p1,p2,p3,alpha,gamma,u1,u2,u3,k1,k2,x3,L)
+        COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
+        REAL*8, INTENT(IN) :: mu,alpha,gamma,k1,k2,x3,L
+        COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
+        
+        REAL*8 :: beta, depthdecay, h
+        COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2)
+        REAL*8  :: temp
+        COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
+        
+        beta=pi2*sqrt(k1**2+k2**2)
+        depthdecay=exp(-beta*abs(x3))
+        h=gamma/beta
+        
+        IF (0==k1 .AND. 0==k2) THEN
+           ! the 1/3 ratio is ad hoc
+           u1=CMPLX(REAL(+p1/mu*(x3-L)/3.d0),0._4)
+           u2=CMPLX(REAL(+p2/mu*(x3-L)/3.d0),0._4)
+           u3=CMPLX(REAL(+p3/mu*(x3-L)*(alpha-1.d0)/(1.d0+2.d0*L*alpha*gamma*(1.d0-alpha))/3.d0),0._4)
+           !u1=CMPLX(0._4,0._4)
+           !u2=CMPLX(0._4,0._4)
+           !u3=CMPLX(0._4,0._4)
+        ELSE
+           temp=1._8/(2._8*mu*beta**3)*depthdecay
+           b1=temp*p1
+           b2=temp*p2
+           b3=temp*p3/(1+h)
+           
+           ! b3 contribution
+           tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
+           v1=tmp*k1
+           v2=tmp*k2
+           v3=-beta**2*b3*(1._8/alpha+beta*x3)
+           
+           ! b1 contribution
+           temp=pi2**2*(2._8-1._8/alpha+beta*x3)/(1+h)
+           v1=v1+b1*(-2._8*beta**2+k1**2*temp)
+           v2=v2+b1*k1*k2*temp
+           v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+           
+           ! b2 contribution & switch to single-precision
+           u1=v1+b2*k1*k2*temp
+           u2=v2+b2*(-2._8*beta**2+k2**2*temp)
+           u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+        END IF
+
+      END SUBROUTINE cerrutisolcowling
+
+  END SUBROUTINE cerruticowling
+
+  !---------------------------------------------------------------------
+  !> subroutine CerrutiCowlingSerial
+  !! computes the deformation field in the 3-dimensional grid
+  !! due to an arbitrary surface traction. No parallel version.
+  !
+  ! sylvain barbot - 07/07/07 - original form
+  !                  21/11/08 - gravity effect
+  !---------------------------------------------------------------------
+  SUBROUTINE cerruticowlingserial(p1,p2,p3,lambda,mu,gamma,u1,u2,u3,dx1,dx2,dx3)
+    REAL*4, DIMENSION(:,:), INTENT(IN) :: p1,p2,p3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: u1,u2,u3
+    REAL*8, INTENT(IN) :: lambda,mu,gamma,dx1,dx2,dx3
+
+    INTEGER :: i1,i2,i3,sx1,sx2,sx3,status
+    REAL*8 :: k1,k2,k3,x3,alpha
+    COMPLEX(KIND=4), ALLOCATABLE, DIMENSION(:) :: b1,b2,b3
+    COMPLEX(KIND=4) :: t1,t2,t3
+
+    sx1=SIZE(u1,1)-2
+    sx2=SIZE(u1,2)
+    sx3=SIZE(u1,3)
+    
+    ALLOCATE(b1(sx3),b2(sx3),b3(sx3),STAT=status)
+    IF (0/=status) STOP "could not allocate arrays for Cerruti3D"
+    
+    alpha=(lambda+mu)/(lambda+2*mu)
+
+    DO i2=1,sx2
+       DO i1=1,sx1/2+1
+          CALL wavenumbers(i1,i2,1,sx1,sx2,1,dx1,dx2,1._8,k1,k2,k3)
+          t1=CMPLX(p1(2*i1-1,i2),p1(2*i1,i2))
+          t2=CMPLX(p2(2*i1-1,i2),p2(2*i1,i2))
+          t3=CMPLX(p3(2*i1-1,i2),p3(2*i1,i2))
+          DO i3=1,sx3
+             IF (i3<=sx3/2) THEN
+                x3=DBLE(i3-1)*dx3
+             ELSE
+                x3=ABS(DBLE(i3-sx3-1)*dx3)
+             END IF
+             CALL cerrutisolcowling(t1,t2,t3,alpha,gamma, &
+                  b1(i3),b2(i3),b3(i3),k1,k2,x3)
+          END DO
+          
+          ! transforms the Cerruti solution into a full 3-dimensional
+          ! Fourier transform by 1d transforming in the 3-direction
+          CALL fft1(b1,sx3,dx3,FFT_FORWARD)
+          CALL fft1(b2,sx3,dx3,FFT_FORWARD)
+          CALL fft1(b3,sx3,dx3,FFT_FORWARD)
+          
+          ! add the Cerruti's contribution to the deformation field
+          DO i3=1,sx3
+             u1(2*i1-1,i2,i3)=u1(2*i1-1,i2,i3)+REAL( REAL(b1(i3)))
+             u1(2*i1  ,i2,i3)=u1(2*i1  ,i2,i3)+REAL(AIMAG(b1(i3)))
+             u2(2*i1-1,i2,i3)=u2(2*i1-1,i2,i3)+REAL( REAL(b2(i3)))
+             u2(2*i1  ,i2,i3)=u2(2*i1  ,i2,i3)+REAL(AIMAG(b2(i3)))
+             u3(2*i1-1,i2,i3)=u3(2*i1-1,i2,i3)+REAL( REAL(b3(i3)))
+             u3(2*i1  ,i2,i3)=u3(2*i1  ,i2,i3)+REAL(AIMAG(b3(i3)))
+          END DO
+       END DO
+    END DO
+    
+  CONTAINS
+    !-----------------------------------------------------------------
+    !> subroutine CerrutiSolCowling
+    !! computes the general solution for the deformation field in an
+    !! elastic half-space due to an arbitrary surface traction in the
+    !! presence of gravity.
+    !!
+    !! The 3 components u1, u2 and u3 of the deformation field are 
+    !! expressed in the horizontal Fourier at depth x3. 
+    !!
+    !! Combines the solution to the Boussinesq's and the Cerruti's 
+    !! problem in a half-space with buoyancy boundary conditions.
+    !
+    ! sylvain barbot (07-07-07) - original form
+    !-----------------------------------------------------------------
+    SUBROUTINE cerrutisolcowling(p1,p2,p3,alpha,gamma,u1,u2,u3,k1,k2,x3)
+      COMPLEX(KIND=4), INTENT(INOUT) :: u1,u2,u3
+      REAL*8, INTENT(IN) :: alpha,gamma,k1,k2,x3
+      COMPLEX(KIND=4), INTENT(IN) :: p1,p2,p3
+        
+      REAL*8 :: beta, depthdecay, h
+      COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2)
+      REAL*8  :: temp
+      COMPLEX(KIND=8) :: b1,b2,b3,tmp,v1,v2,v3
+      
+      beta=pi2*sqrt(k1**2+k2**2)
+      depthdecay=exp(-beta*abs(x3))
+      h=gamma/beta
+      
+      IF (0==k1 .AND. 0==k2) THEN
+         u1=CMPLX(0._4,0._4)
+         u2=CMPLX(0._4,0._4)
+         u3=CMPLX(0._4,0._4)
+      ELSE
+         temp=1._8/(2._8*mu*beta**3)*depthdecay
+         b1=temp*p1
+         b2=temp*p2
+         b3=temp*p3/(1+h)
+           
+         ! b3 contribution
+         tmp=i*b3*(beta*(1._8-1._8/alpha+beta*x3))
+         v1=tmp*k1
+         v2=tmp*k2
+         v3=-beta**2*b3*(1._8/alpha+beta*x3)
+           
+         ! b1 contribution
+         temp=pi2**2*(2._8-1._8/alpha+beta*x3)/(1+h)
+         v1=v1+b1*(-2._8*beta**2+k1**2*temp)
+         v2=v2+b1*k1*k2*temp
+         v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+           
+         ! b2 contribution & switch to single-precision
+         u1=v1+b2*k1*k2*temp
+         u2=v2+b2*(-2._8*beta**2+k2**2*temp)
+         u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+      END IF
+
+    END SUBROUTINE cerrutisolcowling
+
+  END SUBROUTINE cerruticowlingserial
+
+  !------------------------------------------------------------------
+  !> subroutine GreenFunction
+  !! computes (inplace) the displacement components due to a set of
+  !! 3-D body-forces by application of the semi-analytic Green's
+  !! function. The solution satisfies quasi-static Navier's equation
+  !! including vanishing of normal traction at the surface.
+  !!
+  !! The surface traction can be made to vanish by application of
+  !!   1) method of images + boussinesq problem (grn_method=GRN_IMAGE)
+  !!   2) boussinesq's and cerruti's problems (grn_method=GRN_HS)
+  !! in the first case, the body-forces are supposed by have been
+  !! imaged appropriately.
+  !
+  ! sylvain barbot (07/07/07) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE greenfunction(c1,c2,c3,t1,t2,t3,dx1,dx2,dx3,lambda,mu,grn_method)
+    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: c1,c2,c3
+    REAL*4, INTENT(INOUT), DIMENSION(:,:) :: t1,t2,t3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    REAL*8, INTENT(IN) :: lambda,mu
+    INTEGER, INTENT(IN) :: grn_method
+  
+    INTEGER :: sx1,sx2,sx3,status
+
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: p1,p2,p3
+
+    sx1=SIZE(c1,1)-2
+    sx2=SIZE(c1,2)
+    sx3=SIZE(c1,3)
+
+    ALLOCATE(p1(sx1+2,sx2),p2(sx1+2,sx2),p3(sx1+2,sx2),STAT=status)
+    IF (status > 0) THEN
+       WRITE_DEBUG_INFO
+       WRITE(0,'("could not allocate memory for green function")')
+       STOP 1
+    ELSE
+       p1=0;p2=0;p3=0;
+    END IF
+
+    ! forward Fourier transform equivalent body-force
+    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_FORWARD)
+    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_FORWARD)
+    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_FORWARD)
+   
+    ! solve for displacement field
+    CALL elasticresponse(lambda,mu,c1,c2,c3,dx1,dx2,dx3)
+    IF (GRN_IMAGE .eq. grn_method) THEN
+       CALL surfacenormaltraction(lambda,mu,c1,c2,c3,dx1,dx2,dx3,p3)
+       p3=t3-p3
+       CALL boussinesq3d(p3,lambda,mu,c1,c2,c3,dx1,dx2,dx3)
+    ELSE
+       CALL surfacetraction(lambda,mu,c1,c2,c3,dx1,dx2,dx3,p1,p2,p3)
+       p1=t1-p1
+       p2=t2-p2
+       p3=t3-p3
+       CALL cerruti3d(p1,p2,p3,lambda,mu,c1,c2,c3,dx1,dx2,dx3)
+    END IF
+
+    ! inverse Fourier transform solution displacement components
+    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_INVERSE)
+    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_INVERSE)
+    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_INVERSE)
+
+    DEALLOCATE(p1,p2,p3)
+    
+  END SUBROUTINE greenfunction
+
+  !------------------------------------------------------------------
+  !> subroutine GreensFunctionCowling
+  !! computes (inplace) the displacement components due to a set of
+  !! 3-D body-forces by application of the semi-analytic Green's
+  !! function. The solution satisfies quasi-static Navier's equation
+  !! with buoyancy boundary condition to simulate the effect of 
+  !! gravity (the Cowling approximation).
+  !!
+  !! the importance of gravity depends upon the density contrast rho 
+  !! at the surface, the acceleration of gravity g and the value of 
+  !! shear modulus mu in the crust. effect on the displacement field
+  !! is governed by the gradient
+  !!
+  !!            gamma = (1 - nu) rho g / mu
+  !!                  = rho g / (2 mu alpha)
+  !! 
+  !! where nu is the Poisson's ratio. For a Poisson's solid with 
+  !! nu = 1/4, with a density contrast rho = 3200 kg/m^3 and a shear
+  !! modulus mu = 30 GPa, we have gamma = 0.8e-6 /m.
+  !!
+  !! INPUT:
+  !!   @param c1,c2,c3    is a set of body forces
+  !!   @param dx1,dx2,dx3 are the sampling size
+  !!   @param lambda,mu   are the Lame elastic parameters
+  !!   @param gamma       is the gravity coefficient
+  !
+  ! sylvain barbot (07/07/07) - original function greenfunction
+  !                (11/21/08) - effect of gravity
+  !------------------------------------------------------------------
+  SUBROUTINE greenfunctioncowling(c1,c2,c3,t1,t2,t3,dx1,dx2,dx3, &
+                                  lambda,mu,gamma)
+    REAL*4, INTENT(INOUT), DIMENSION(:,:,:) :: c1,c2,c3
+    REAL*4, INTENT(INOUT), DIMENSION(:,:) :: t1,t2,t3
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3
+    REAL*8, INTENT(IN) :: lambda,mu,gamma
+  
+    INTEGER :: sx1,sx2,sx3,status
+
+    REAL*4, DIMENSION(:,:), ALLOCATABLE :: p1,p2,p3
+
+    sx1=SIZE(c1,1)-2
+    sx2=SIZE(c1,2)
+    sx3=SIZE(c1,3)
+
+    ALLOCATE(p1(sx1+2,sx2),p2(sx1+2,sx2),p3(sx1+2,sx2),STAT=status)
+    IF (status > 0) THEN
+       WRITE_DEBUG_INFO
+       WRITE(0,'("could not allocate memory for green function")')
+       STOP 1
+    ELSE
+       p1=0;p2=0;p3=0;
+    END IF
+
+    ! forward Fourier transform equivalent body-force
+    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_FORWARD)
+    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_FORWARD)
+    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_FORWARD)
+    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_FORWARD)
+   
+    ! solve for displacement field
+    CALL elasticresponse(lambda,mu,c1,c2,c3,dx1,dx2,dx3)
+
+    CALL surfacetractioncowling(lambda,mu,gamma, &
+         c1,c2,c3,dx1,dx2,dx3,p1,p2,p3)
+    p1=t1-p1
+    p2=t2-p2
+    p3=t3-p3
+    CALL cerruticowling(p1,p2,p3,lambda,mu,gamma, &
+         c1,c2,c3,dx1,dx2,dx3)
+    
+    ! inverse Fourier transform solution displacement components
+    CALL fft3(c1,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft3(c2,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft3(c3,sx1,sx2,sx3,dx1,dx2,dx3,FFT_INVERSE)
+    CALL fft2(t1,sx1,sx2,dx1,dx2,FFT_INVERSE)
+    CALL fft2(t2,sx1,sx2,dx1,dx2,FFT_INVERSE)
+    CALL fft2(t3,sx1,sx2,dx1,dx2,FFT_INVERSE)
+
+    DEALLOCATE(p1,p2,p3)
+    
+  END SUBROUTINE greenfunctioncowling
+
+END MODULE green
diff -r 405d8f4fa05f -r e7295294f654 src/include.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/include.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,59 @@
+#include "config.h"
+
+! implement SGI Fast Fourier Transforms library
+!#define SGI_FFT 1
+
+! export data to GMT XYZ text format
+!#define XYZ 1
+
+! export data to GMT GRD binary format
+#define GRD 1
+
+! export equivalent body forces in GRD format
+!#define GRD_EQBF 1
+
+! export amplitude of scalar fields 
+! along a plane in GRD binary format
+#define GRD_EXPORTEIGENSTRAIN 1
+
+! export creep velocity along a frictional 
+! plane in GRD binary format
+#define GRD_EXPORTCREEP 1
+
+! export data to the TXT format
+!#define TXT 1
+
+! export data to longitude/latitude format
+#define PROJ 1
+
+! export amplitude of scalar fields along 
+! an observation plane in text format
+#define TXT_EXPORTEIGENSTRAIN 1
+
+! export creep velocity along a frictional 
+! plane in text format
+!#define TXT_EXPORTCREEP 1
+
+! export data to VTK format (for visualization in Paraview)
+#define VTK 1
+!#define VTK_EQBF 1
+
+#define WRITE_DEBUG_INFO WRITE (0,'("error at line ",I5.5," of source file ",a)') __LINE__,__FILE__
+
+
+#ifdef IMKL_FFT
+#define WRITE_MKL_DEBUG_INFO(i) IF(i.NE.0)THEN;IF(.NOT.DftiErrorClass(i,DFTI_NO_ERROR))THEN;WRITE_DEBUG_INFO;WRITE (0,*) DftiErrorMessage(i);STOP 1;END IF;END IF
+#endif
+
+! adjust data alignment for the Fourier transform
+#ifdef FFTW3
+#define ALIGN_DATA 1
+#else
+#ifdef SGI_FFT
+#define ALIGN_DATA 1
+#else
+#ifdef IMKL_FFT
+#define ALIGN_DATA 1
+#endif
+#endif
+#endif
diff -r 405d8f4fa05f -r e7295294f654 src/input.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/input.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,1374 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+#include "include.f90"
+
+MODULE input
+
+  IMPLICIT NONE
+
+  REAL*8, PARAMETER :: DEG2RAD = 0.01745329251994329547437168059786927_8
+
+CONTAINS
+
+  !---------------------------------------------------------------------
+  !> subroutine init
+  !! reads simulation parameters from the standard input and initialize
+  !! model parameters.
+  !!
+  !! INPUT:
+  !! @param unit - the unit number used to read input data
+  !!
+  !! OUTPUT:
+  !! @param in
+  !---------------------------------------------------------------------
+  SUBROUTINE init(in,unit)
+    USE types
+    USE export
+    USE getopt_m
+
+    TYPE(SIMULATION_STRUC), INTENT(OUT) :: in
+    INTEGER, OPTIONAL, INTENT(INOUT) :: unit
+
+    CHARACTER :: ch
+    CHARACTER(180) :: dataline
+    CHARACTER(80) :: rffilename,filename
+#ifdef VTK
+    CHARACTER(3) :: digit
+    CHARACTER(4) :: digit4
+#endif
+    INTEGER :: iunit
+!$  INTEGER :: omp_get_num_procs,omp_get_max_threads
+    REAL*8 :: dummy,dum1,dum2
+    REAL*8 :: minlength,minwidth
+    TYPE(OPTION_S) :: opts(12)
+
+    INTEGER :: k,iostatus,i,e
+
+    ! default is standard input
+    IF (.NOT. PRESENT(unit)) THEN
+       iunit=5
+    ELSE
+       iunit=unit
+    END IF
+
+    ! parse the command line for options
+    opts( 1)=OPTION_S("no-proj-output",.FALSE.,CHAR(20))
+    opts( 2)=OPTION_S("no-relax-output",.FALSE.,CHAR(21))
+    opts( 3)=OPTION_S("no-txt-output",.FALSE.,CHAR(22))
+    opts( 4)=OPTION_S("no-vtk-output",.FALSE.,CHAR(23))
+    opts( 5)=OPTION_S("no-grd-output",.FALSE.,CHAR(24))
+    opts( 6)=OPTION_S("no-xyz-output",.FALSE.,CHAR(25))
+    opts( 7)=OPTION_S("no-stress-output",.FALSE.,CHAR(26))
+    opts( 8)=OPTION_S("with-stress-output",.FALSE.,CHAR(27))
+    opts( 9)=OPTION_S("with-vtk-output",.FALSE.,CHAR(28))
+    opts(10)=OPTION_S("with-vtk-relax-output",.FALSE.,CHAR(29))
+    opts(11)=OPTION_S("dry-run",.FALSE.,CHAR(30))
+    opts(12)=OPTION_S("help",.FALSE.,'h')
+
+    DO
+       ch=getopt("h",opts)
+       SELECT CASE(ch)
+       CASE(CHAR(0))
+          EXIT
+       CASE(CHAR(20))
+          ! option no-proj-output
+          in%isoutputproj=.FALSE.
+       CASE(CHAR(21))
+          ! option no-relax-output
+          in%isoutputrelax=.FALSE.
+       CASE(CHAR(22))
+          ! option no-txt-output
+          in%isoutputtxt=.FALSE.
+       CASE(CHAR(23))
+          ! option no-vtk-output
+          in%isoutputvtk=.FALSE.
+       CASE(CHAR(24))
+          ! option no-grd-output
+          in%isoutputgrd=.FALSE.
+       CASE(CHAR(25))
+          ! option no-xyz-output
+          in%isoutputxyz=.FALSE.
+       CASE(CHAR(26))
+          ! option stress output
+          in%isoutputstress=.FALSE.
+       CASE(CHAR(27))
+          ! option dry-run
+          in%isoutputstress=.TRUE.
+       CASE(CHAR(28))
+          ! option with-output-vtk
+          in%isoutputvtk=.TRUE.
+       CASE(CHAR(29))
+          ! option with-output-vtk-relax
+          in%isoutputvtkrelax=.TRUE.
+       CASE(CHAR(30))
+          ! option dry-run
+          in%isdryrun=.TRUE.
+       CASE('h')
+          ! option help
+          in%ishelp=.TRUE.
+       CASE('?')
+          WRITE_DEBUG_INFO
+          in%ishelp=.TRUE.
+          EXIT
+       CASE DEFAULT
+          WRITE (0,'("unhandled option ", a, " (this is a bug")') optopt
+          WRITE_DEBUG_INFO
+          STOP 3
+       END SELECT
+    END DO
+
+    IF (in%ishelp) THEN
+       PRINT '("usage:")'
+       PRINT '("relax [-h] [--dry-run] [--help] [--no-grd-output] [--no-proj-output]")' 
+       PRINT '("      [--no-relax-output] [--no-stress-output] [--no-txt-output]")'
+       PRINT '("      [--no-vtk-output] [--no-xyz-output]")'
+       PRINT '("")'
+       PRINT '("options:")'
+       PRINT '("   -h                      prints this message and aborts calculation")'
+       PRINT '("   --dry-run               abort calculation, only output geometry")'
+       PRINT '("   --help                  prints this message and aborts calculation")'
+       PRINT '("   --no-grd-output         cancel output in GMT grd binary format")'
+       PRINT '("   --no-proj-output        cancel output in geographic projection")'
+       PRINT '("   --no-relax-output       cancel output of the postseismic contribution")'
+       PRINT '("   --no-stress-output      cancel output of stress tensor in any format")'
+       PRINT '("   --no-txt-output         cancel output in text format")'
+       PRINT '("   --no-vtk-output         cancel output in Paraview VTK format")'
+       PRINT '("   --no-xyz-output         cancel output in GMT xyz format")'
+       PRINT '("   --with-stress-output    export stress tensor")'
+       PRINT '("   --with-vtk-output       export output in Paraview VTK format")'
+       PRINT '("   --with-vtk-relax-output export relaxation to VTK format")'
+       PRINT '("")'
+       PRINT '("description:")'
+       PRINT '("   Evaluates the deformation due to fault slip, surface loading")'
+       PRINT '("   or inflation and the time series of postseismic relaxation")'
+       PRINT '("   that follows due to fault creep or viscoelastic flow.")'
+       RETURN
+    END IF
+    PRINT 2000
+    PRINT '(" RELAX: nonlinear postseismic relaxation with Fourier-domain Green''s function")'
+#ifdef FFTW3
+#ifdef FFTW3_THREADS
+    PRINT '("     * FFTW3 (multi-threaded) implementation of the FFT")'
+#else
+    PRINT '("     * FFTW3 implementation of the FFT")'
+#endif
+#else
+#ifdef SGI_FFT
+    PRINT '("     * SGI_FFT implementation of the FFT")'
+#else
+#ifdef IMKL_FFT
+    PRINT '("     * Intel MKL implementation of the FFT")'
+#else
+    PRINT '("     * fourt implementation of the FFT")'
+#endif
+#endif
+#endif
+!$  PRINT '("     * parallel OpenMP implementation with ",I3.3,"/",I3.3," threads")', &
+!$                  omp_get_max_threads(),omp_get_num_procs()
+#ifdef PROJ
+    IF (in%isoutputproj) THEN
+       PRINT '("     * export to longitude/latitude text format")'
+    ELSE
+       PRINT '("     * export to longitude/latitude text format cancelled (--",a,")")', trim(opts(1)%name)
+    END IF
+#endif
+#ifdef TXT
+    IF (in%isoutputtxt) THEN
+       PRINT '("     * export to TXT format")'
+    ELSE
+       PRINT '("     * export to TXT format cancelled                     (--",a,")")', trim(opts(3)%name)
+    END IF
+#ifdef GRD
+    IF (in%isoutputgrd) THEN
+       PRINT '("     * export to GRD format")'
+    ELSE
+       PRINT '("     * export to GRD format cancelled                     (--",a,")")', trim(opts(5)%name)
+    END IF
+#endif
+#ifdef XYZ
+    IF (in%isoutputxyz) THEN
+       PRINT '("     * export to XYZ format")'
+    ELSE
+       PRINT '("     * export to XYZ format cancelled                     (--",a,")")', trim(opts(6)%name)
+    END IF
+#endif
+#endif
+#ifdef VTK
+    IF (in%isoutputvtk) THEN
+       PRINT '("     * export to VTK format")'
+    ELSE
+       PRINT '("     * export to VTK format cancelled                     (--",a,")")', trim(opts(4)%name)
+    END IF
+    IF (in%isoutputvtkrelax) THEN
+       PRINT '("     * export relaxation component to VTK format   (--",a,")")', trim(opts(10)%name)
+    END IF
+#endif
+    PRINT 2000
+
+    PRINT '(a)', "grid dimension (sx1,sx2,sx3)"
+    CALL getdata(iunit,dataline)
+    READ (dataline,*) in%sx1,in%sx2,in%sx3
+    PRINT '(3I5)', in%sx1,in%sx2,in%sx3
+
+    PRINT '(a)', "sampling (dx1,dx2,dx3), smoothing (beta, nyquist)"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%dx1,in%dx2,in%dx3,in%beta,in%nyquist
+    PRINT '(5ES9.2E1)', in%dx1,in%dx2,in%dx3,in%beta,in%nyquist
+
+    PRINT '(a)', "origin position (x0,y0) and rotation"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%x0,in%y0,in%rot
+    PRINT '(3ES9.2E1)', in%x0,in%y0,in%rot
+
+#ifdef PROJ
+    IF (in%isoutputproj) THEN
+       PRINT '(a)', "geographic origin (longitude, latitude, UTM zone, unit)"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%lon0,in%lat0,in%zone,in%umult
+       PRINT '(2ES9.2E1,I3.2,ES9.2E1)',in%lon0,in%lat0,in%zone,in%umult
+       IF (in%zone.GT.60 .OR. in%zone.LT.1) THEN
+          WRITE_DEBUG_INFO
+          WRITE (0,'("invalid UTM zone ",I3," (1<=zone<=60. exiting.)")') in%zone
+          STOP 1
+       END IF
+    END IF
+#endif
+
+    PRINT '(a)', "observation depth (displacement and stress)"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%oz,in%ozs
+    PRINT '(2ES9.2E1)', in%oz,in%ozs
+
+    PRINT '(a)', "output directory"
+    CALL getdata(iunit,dataline)
+    READ (dataline,'(a)') in%wdir
+
+    in%reporttimefilename=trim(in%wdir)//"/time.txt"
+    in%reportfilename=trim(in%wdir)//"/report.txt"
+#ifdef TXT
+    PRINT '(" ",a," (report: ",a,")")', trim(in%wdir),trim(in%reportfilename)
+#else
+    PRINT '(" ",a," (time report: ",a,")")', trim(in%wdir),trim(in%reporttimefilename)
+#endif
+
+    ! test write permissions on output directory
+    OPEN (UNIT=14,FILE=in%reportfilename,POSITION="APPEND",&
+            IOSTAT=iostatus,FORM="FORMATTED")
+    IF (iostatus>0) THEN
+       WRITE_DEBUG_INFO
+       WRITE (0,'("unable to access ",a)') trim(in%reporttimefilename)
+       STOP 1
+    END IF
+    CLOSE(14)
+    ! end test
+
+#ifdef VTK
+    filename=trim(in%wdir)//"/cgrid.vtp"
+    CALL exportvtk_grid(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3,filename)
+#endif
+
+    PRINT '(a)', "lambda, mu, gamma (gamma = (1 - nu) rho g / mu)"
+    CALL getdata(iunit,dataline)
+    READ (dataline,*) in%lambda,in%mu,in%gam
+    PRINT '(3ES10.2E2)',in%lambda,in%mu,in%gam
+
+    PRINT '(a)', "time interval, (positive time step) or (negative skip, scaling)"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%interval, in%odt
+
+    IF (in%odt .LT. 0.) THEN
+       READ  (dataline,*) dum1, dum2, in%tscale
+       in%skip=ceiling(-in%odt)
+       PRINT '(ES9.2E1," (output every ",I3.3," steps, dt scaled by ",ES7.2E1,")")', &
+             in%interval,in%skip,in%tscale
+    ELSE
+       PRINT '(ES9.2E1," (output every ",ES9.2E1," time unit)")', in%interval,in%odt
+    END IF
+
+    
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !           O B S E R V A T I O N          P L A N E S 
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of observation planes"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%nop
+    PRINT '(I5)', in%nop
+    IF (in%nop .gt. 0) THEN
+       ALLOCATE(in%op(in%nop),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the observation plane list"
+       PRINT 2000
+       PRINT 2100
+       PRINT 2000
+       DO k=1,in%nop
+          CALL getdata(iunit,dataline)
+          READ  (dataline,*) i,in%op(k)%x,in%op(k)%y,in%op(k)%z,&
+               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip
+
+          PRINT '(I3.3," ",5ES9.2E1,2f7.1)', &
+               k,in%op(k)%x,in%op(k)%y,in%op(k)%z, &
+               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip
+
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,*) "error in input file: plane index misfit", k,"<>",i
+             STOP 1
+          END IF
+
+          ! comply to Wang's convention
+          CALL wangconvention(dummy,in%op(k)%x,in%op(k)%y,in%op(k)%z,&
+               in%op(k)%length,in%op(k)%width,in%op(k)%strike,in%op(k)%dip, &
+               dummy,in%x0,in%y0,in%rot)
+
+       END DO
+    END IF
+
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !         O B S E R V A T I O N       P O I N T S
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of observation points"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%npts
+    PRINT '(I5)', in%npts
+    IF (in%npts .gt. 0) THEN
+       ALLOCATE(in%opts(in%npts),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the observation point list"
+       ALLOCATE(in%ptsname(in%npts),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the list of point name"
+
+       PRINT 2000
+       PRINT 2300
+       PRINT 2000
+       DO k=1,in%npts
+          CALL getdata(iunit,dataline)
+          READ (dataline,*) i,in%ptsname(k),in%opts(k)%v1,in%opts(k)%v2,in%opts(k)%v3
+
+          PRINT '(I3.3," ",A4,3ES9.2E1)', i,in%ptsname(k), &
+               in%opts(k)%v1,in%opts(k)%v2,in%opts(k)%v3
+
+          ! shift and rotate coordinates
+          in%opts(k)%v1=in%opts(k)%v1-in%x0
+          in%opts(k)%v2=in%opts(k)%v2-in%y0
+          CALL rotation(in%opts(k)%v1,in%opts(k)%v2,in%rot)
+
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: points index misfit")')
+             STOP 1
+          END IF
+       END DO
+
+       ! export the lits of observation points for display
+       filename=trim(in%wdir)//"/opts.dat"
+       CALL exportoptsdat(in%npts,in%opts,in%ptsname,filename)
+
+    END IF
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !   C O U L O M B      O B S E R V A T I O N      S E G M E N T S
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of stress observation segments"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%nsop
+    PRINT '(I5)', in%nsop
+    IF (in%nsop .gt. 0) THEN
+       ALLOCATE(in%sop(in%nsop),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the segment list"
+       PRINT 2000
+       PRINT '(a)',"no.        xs       ys       zs  length   width strike   dip friction"
+       PRINT 2000
+       DO k=1,in%nsop
+          CALL getdata(iunit,dataline)
+          READ (dataline,*) i, &
+               in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
+               in%sop(k)%length,in%sop(k)%width, &
+               in%sop(k)%strike,in%sop(k)%dip,in%sop(k)%friction
+          in%sop(k)%sig0=TENSOR(0.d0,0.d0,0.d0,0.d0,0.d0,0.d0)
+
+          PRINT '(I4.4,3ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
+               in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
+               in%sop(k)%length,in%sop(k)%width, &
+               in%sop(k)%strike,in%sop(k)%dip, &
+               in%sop(k)%friction
+             
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("invalid segment definition ")')
+             WRITE (0,'("error in input file: source index misfit")')
+             STOP 1
+          END IF
+          IF (MAX(in%sop(k)%length,in%sop(k)%width) .LE. 0._8) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: length and width must be positive.")')
+             STOP 1
+          END IF
+
+          ! comply to Wang's convention
+          CALL wangconvention(dummy, &
+                     in%sop(k)%x,in%sop(k)%y,in%sop(k)%z, &
+                     in%sop(k)%length,in%sop(k)%width, &
+                     in%sop(k)%strike,in%sop(k)%dip, &
+                     dummy, &
+                     in%x0,in%y0,in%rot)
+       END DO
+
+       ! export patches to vtk/vtp
+       filename=trim(in%wdir)//"/rfaults-dsigma-0000.vtp"
+       CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                     in%nsop,in%sop,filename,convention=1)
+
+    END IF
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !                     P R E S T R E S S
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of prestress interfaces"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%nps
+    PRINT '(I5)', in%nps
+
+    IF (in%nps .GT. 0) THEN
+       ALLOCATE(in%stresslayer(in%nps),in%stressstruc(in%sx3/2),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the stress layer structure"
+       
+       PRINT 2000
+       PRINT '(a)', "no.    depth  sigma11  sigma12  sigma13  sigma22  sigma23  sigma33"
+       PRINT 2000
+       DO k=1,in%nps
+          CALL getdata(iunit,dataline)
+          READ  (dataline,*) i,in%stresslayer(k)%z, &
+               in%stresslayer(k)%t%s11, in%stresslayer(k)%t%s12, &
+               in%stresslayer(k)%t%s13, in%stresslayer(k)%t%s22, &
+               in%stresslayer(k)%t%s23, in%stresslayer(k)%t%s33
+          
+          PRINT '(I3.3,7ES9.2E1)', i, &
+               in%stresslayer(k)%z, &
+               in%stresslayer(k)%t%s11, in%stresslayer(k)%t%s12, &
+               in%stresslayer(k)%t%s13, in%stresslayer(k)%t%s22, &
+               in%stresslayer(k)%t%s23, in%stresslayer(k)%t%s33
+          
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: index misfit")')
+             STOP 1
+          END IF
+       END DO
+    END IF
+
+
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !  L I N E A R    V I S C O U S    I N T E R F A C E
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of linear viscous interfaces"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%nv
+    PRINT '(I5)', in%nv
+    
+    IF (in%nv .GT. 0) THEN
+       ALLOCATE(in%linearlayer(in%nv),in%linearstruc(in%sx3/2),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the layer structure"
+       
+       PRINT 2000
+       PRINT '(a)', "no.     depth    gamma0  cohesion"
+       PRINT 2000
+       DO k=1,in%nv
+          CALL getdata(iunit,dataline)
+          READ  (dataline,*) i,in%linearlayer(k)%z, &
+               in%linearlayer(k)%gammadot0, in%linearlayer(k)%cohesion
+
+          in%linearlayer(k)%stressexponent=1
+
+          PRINT '(I3.3,3ES10.2E2)', i, &
+               in%linearlayer(k)%z, &
+               in%linearlayer(k)%gammadot0, &
+               in%linearlayer(k)%cohesion
+          
+          ! check positive strain rates
+          IF (in%linearlayer(k)%gammadot0 .LT. 0) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: strain rates must be positive")')
+             STOP 1
+          END IF
+
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: index misfit")')
+             STOP 1
+          END IF
+#ifdef VTK
+          ! export the viscous layer in VTK format
+          WRITE (digit,'(I3.3)') k
+
+          rffilename=trim(in%wdir)//"/linearlayer-"//digit//".vtp"
+          CALL exportvtk_rectangle(0.d0,0.d0,in%linearlayer(k)%z, &
+                                   DBLE(in%sx1)*in%dx1,DBLE(in%sx2)*in%dx2, &
+                                   0._8,1.5708d0,rffilename)
+#endif
+       END DO
+
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !                 L I N E A R   W E A K   Z O N E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of linear weak zones"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%nlwz
+       PRINT '(I5)', in%nlwz
+       IF (in%nlwz .GT. 0) THEN
+          ALLOCATE(in%linearweakzone(in%nlwz),in%linearweakzonec(in%nlwz),STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the linear weak zones"
+          PRINT 2000
+          PRINT '(a)', "no. dgammadot0     x1       x2       x3  length   width thickn. strike   dip"
+          PRINT 2000
+          DO k=1,in%nlwz
+             CALL getdata(iunit,dataline)
+             READ  (dataline,*) i, &
+                  in%linearweakzone(k)%dgammadot0, &
+                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z,&
+                  in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
+                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip
+          
+             in%linearweakzonec(k)=in%linearweakzone(k)
+             
+             PRINT '(I3.3,4ES9.2E1,3ES8.2E1,f7.1,f6.1)',k,&
+                  in%linearweakzone(k)%dgammadot0, &
+                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
+                  in%linearweakzone(k)%length,in%linearweakzone(k)%width, &
+                  in%linearweakzone(k)%thickness, &
+                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip
+             
+             IF (i .ne. k) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("error in input file: source index misfit")')
+                STOP 1
+             END IF
+             ! comply to Wang's convention
+             CALL wangconvention( &
+                  dummy, & 
+                  in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
+                  in%linearweakzone(k)%length,in%linearweakzone(k)%width, &
+                  in%linearweakzone(k)%strike,in%linearweakzone(k)%dip, &
+                  dummy,in%x0,in%y0,in%rot)
+
+                  WRITE (digit,'(I3.3)') k
+
+#ifdef VTK
+                  ! export the ductile zone in VTK format
+                  rffilename=trim(in%wdir)//"/weakzone-"//digit//".vtp"
+                  CALL exportvtk_brick(in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
+                                       in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
+                                       in%linearweakzone(k)%strike,in%linearweakzone(k)%dip,rffilename)
+#endif
+                  ! export the ductile zone in GMT .xy format
+                  rffilename=trim(in%wdir)//"/weakzone-"//digit//".xy"
+                  CALL exportxy_brick(in%linearweakzone(k)%x,in%linearweakzone(k)%y,in%linearweakzone(k)%z, &
+                                      in%linearweakzone(k)%length,in%linearweakzone(k)%width,in%linearweakzone(k)%thickness, &
+                                      in%linearweakzone(k)%strike,in%linearweakzone(k)%dip,rffilename)
+          END DO
+       END IF
+    END IF ! end linear viscous
+       
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !  N O N L I N E A R    V I S C O U S    I N T E R F A C E
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of nonlinear viscous interfaces"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%npl
+    PRINT '(I5)', in%npl
+
+    IF (in%npl .GT. 0) THEN
+       ALLOCATE(in%nonlinearlayer(in%npl),in%nonlinearstruc(in%sx3/2),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the layer structure"
+       
+       PRINT 2000
+       PRINT '(a)', "no.     depth    gamma0     power  cohesion"
+       PRINT 2000
+       DO k=1,in%npl
+          CALL getdata(iunit,dataline)
+
+          READ  (dataline,*) i,in%nonlinearlayer(k)%z, &
+               in%nonlinearlayer(k)%gammadot0, &
+               in%nonlinearlayer(k)%stressexponent, &
+               in%nonlinearlayer(k)%cohesion
+
+          PRINT '(I3.3,4ES10.2E2)', i, &
+               in%nonlinearlayer(k)%z, &
+               in%nonlinearlayer(k)%gammadot0, &
+               in%nonlinearlayer(k)%stressexponent, &
+               in%nonlinearlayer(k)%cohesion
+          
+          ! check positive strain rates
+          IF (in%nonlinearlayer(k)%gammadot0 .LT. 0) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: strain rates must be positive")')
+             STOP 1
+          END IF
+
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: index misfit")')
+             STOP 1
+          END IF
+
+#ifdef VTK
+          WRITE (digit,'(I3.3)') k
+
+          ! export the viscous layer in VTK format
+          rffilename=trim(in%wdir)//"/nonlinearlayer-"//digit//".vtp"
+          CALL exportvtk_rectangle(0.d0,0.d0,in%nonlinearlayer(k)%z, &
+                                   DBLE(in%sx1)*in%dx1,DBLE(in%sx2)*in%dx2, &
+                                   0._8,1.57d0,rffilename)
+#endif
+       END DO
+
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !           N O N L I N E A R   W E A K   Z O N E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of nonlinear weak zones"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%nnlwz
+       PRINT '(I5)', in%nnlwz
+       IF (in%nnlwz .GT. 0) THEN
+          ALLOCATE(in%nonlinearweakzone(in%nnlwz),in%nonlinearweakzonec(in%nnlwz),STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the nonlinear weak zones"
+          PRINT 2000
+          PRINT '(a)', "no. dgammadot0     x1       x2       x3  length   width thickn. strike   dip"
+          PRINT 2000
+          DO k=1,in%nnlwz
+             CALL getdata(iunit,dataline)
+             READ  (dataline,*) i, &
+                  in%nonlinearweakzone(k)%dgammadot0, &
+                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z,&
+                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width,in%nonlinearweakzone(k)%thickness, &
+                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip
+          
+             in%nonlinearweakzonec(k)=in%nonlinearweakzone(k)
+             
+             PRINT '(I3.3,4ES9.2E1,3ES8.2E1,f7.1,f6.1)',k,&
+                  in%nonlinearweakzone(k)%dgammadot0, &
+                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z, &
+                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width, &
+                  in%nonlinearweakzone(k)%thickness, &
+                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip
+             
+             IF (i .ne. k) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("error in input file: source index misfit")')
+                STOP 1
+             END IF
+             ! comply to Wang's convention
+             CALL wangconvention( &
+                  dummy, & 
+                  in%nonlinearweakzone(k)%x,in%nonlinearweakzone(k)%y,in%nonlinearweakzone(k)%z, &
+                  in%nonlinearweakzone(k)%length,in%nonlinearweakzone(k)%width, &
+                  in%nonlinearweakzone(k)%strike,in%nonlinearweakzone(k)%dip, &
+                  dummy,in%x0,in%y0,in%rot)
+
+                  WRITE (digit,'(I3.3)') k
+
+#ifdef VTK
+                  ! export the ductile zone in VTK format
+                  rffilename=trim(in%wdir)//"/weakzone-nl-"//digit//".vtp"
+                  CALL exportvtk_brick(in%nonlinearweakzone(k)%x, &
+                                       in%nonlinearweakzone(k)%y, &
+                                       in%nonlinearweakzone(k)%z, &
+                                       in%nonlinearweakzone(k)%length, &
+                                       in%nonlinearweakzone(k)%width, &
+                                       in%nonlinearweakzone(k)%thickness, &
+                                       in%nonlinearweakzone(k)%strike, &
+                                       in%nonlinearweakzone(k)%dip,rffilename)
+#endif
+                  ! export the ductile zone in GMT .xy format
+                  rffilename=trim(in%wdir)//"/weakzone-nl-"//digit//".xy"
+                  CALL exportxy_brick(in%nonlinearweakzone(k)%x, &
+                                       in%nonlinearweakzone(k)%y, &
+                                       in%nonlinearweakzone(k)%z, &
+                                       in%nonlinearweakzone(k)%length, &
+                                       in%nonlinearweakzone(k)%width, &
+                                       in%nonlinearweakzone(k)%thickness, &
+                                       in%nonlinearweakzone(k)%strike, &
+                                       in%nonlinearweakzone(k)%dip,rffilename)
+          END DO
+       END IF
+    END IF ! end nonlinear viscous
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !                 F A U L T    C R E E P
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of fault creep interfaces"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%nfc
+    PRINT '(I5)', in%nfc
+
+    IF (in%nfc .GT. 0) THEN
+       ALLOCATE(in%faultcreeplayer(in%nfc),in%faultcreepstruc(in%sx3/2),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the layer structure"
+
+       PRINT 2000
+       PRINT '(a)', "no.    depth   gamma0 (a-b)sig friction cohesion"
+       PRINT 2000
+       DO k=1,in%nfc
+          CALL getdata(iunit,dataline)
+          READ  (dataline,*) i,in%faultcreeplayer(k)%z, &
+               in%faultcreeplayer(k)%gammadot0, &
+               in%faultcreeplayer(k)%stressexponent, &
+               in%faultcreeplayer(k)%friction, &
+               in%faultcreeplayer(k)%cohesion
+
+          PRINT '(I3.3,5ES9.2E1)', i, &
+               in%faultcreeplayer(k)%z, &
+               in%faultcreeplayer(k)%gammadot0, &
+               in%faultcreeplayer(k)%stressexponent, &
+               in%faultcreeplayer(k)%friction, &
+               in%faultcreeplayer(k)%cohesion
+
+          ! check positive strain rates
+          IF (in%faultcreeplayer(k)%gammadot0 .LT. 0) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: slip rates must be positive")')
+             STOP 1
+          END IF
+
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: index misfit")')
+             STOP 1
+          END IF
+
+       END DO
+
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !             A F T E R S L I P       P L A N E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of afterslip planes"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%np
+       PRINT '(I5)', in%np
+       
+       IF (in%np .gt. 0) THEN
+          ALLOCATE(in%n(in%np),STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the plane list"
+       
+          PRINT 2000
+          PRINT 2500
+          PRINT 2000
+          
+          DO k=1,in%np
+             CALL getdata(iunit,dataline)
+             READ (dataline,*) i, &
+                  in%n(k)%x,in%n(k)%y,in%n(k)%z,&
+                  in%n(k)%length,in%n(k)%width, &
+                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake
+             
+             PRINT '(I3.3," ",5ES9.2E1,3f7.1)',i, &
+                  in%n(k)%x,in%n(k)%y,in%n(k)%z, &
+                  in%n(k)%length,in%n(k)%width, &
+                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake
+
+             IF (i .ne. k) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("error in input file: plane index misfit")')
+                STOP 1
+             END IF
+
+             ! modify rake for consistency with slip model
+             IF (in%n(k)%rake .GE. 0.d0) THEN
+                in%n(k)%rake=in%n(k)%rake-180.d0
+             ELSE             
+                in%n(k)%rake=in%n(k)%rake+180.d0
+             END IF
+
+             ! comply to Wang's convention
+             CALL wangconvention(dummy,in%n(k)%x,in%n(k)%y,in%n(k)%z,&
+                  in%n(k)%length,in%n(k)%width, &
+                  in%n(k)%strike,in%n(k)%dip,in%n(k)%rake, &
+                  in%x0,in%y0,in%rot)
+
+             ! number of patches in each direction
+             in%n(k)%px2=FIX(in%n(k)%length/in%dx2)
+             in%n(k)%px3=FIX(in%n(k)%width/in%dx3)
+
+             ALLOCATE(in%n(k)%patch(in%n(k)%px2,in%n(k)%px3),STAT=iostatus)
+             IF (iostatus>0) STOP "could not allocate the fault patches"
+
+#ifdef VTK
+             ! export the afterslip segment in VTK format
+             WRITE (digit4,'(I4.4)') k
+
+             rffilename=trim(in%wdir)//"/aplane-"//digit4//".vtp"
+             CALL exportvtk_rectangle(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
+                                      in%n(k)%length,in%n(k)%width, &
+                                      in%n(k)%strike,in%n(k)%dip,rffilename)
+#endif
+
+          END DO
+       END IF
+       
+    END IF
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !     I N T E R - S E I S M I C    L O A D I N G
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    minlength=in%sx1*in%dx1+in%sx2*in%dx2
+    minwidth=in%sx3*in%dx3
+    
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !        S H E A R     S O U R C E S   R A T E
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of inter-seismic strike-slip segments"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%inter%ns
+    PRINT '(I5)', in%inter%ns
+    IF (in%inter%ns .GT. 0) THEN
+       ALLOCATE(in%inter%s(in%inter%ns),in%inter%sc(in%inter%ns),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the source list"
+       PRINT 2000
+       PRINT '(a)',"no.  slip/time  xs ys zs  length width  strike dip rake"
+       PRINT 2000
+       DO k=1,in%inter%ns
+          CALL getdata(iunit,dataline)
+          READ (dataline,*) i,in%inter%s(k)%slip, &
+               in%inter%s(k)%x,in%inter%s(k)%y,in%inter%s(k)%z, &
+               in%inter%s(k)%length,in%inter%s(k)%width, &
+               in%inter%s(k)%strike,in%inter%s(k)%dip,in%inter%s(k)%rake
+
+          ! copy the input format for display
+          in%inter%sc(k)=in%inter%s(k)
+             
+          PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
+               in%inter%sc(k)%slip,&
+               in%inter%sc(k)%x,in%inter%sc(k)%y,in%inter%sc(k)%z, &
+               in%inter%sc(k)%length,in%inter%sc(k)%width, &
+               in%inter%sc(k)%strike,in%inter%sc(k)%dip, &
+               in%inter%sc(k)%rake
+          
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: source index misfit")')
+             STOP 1
+          END IF
+          IF (MAX(in%inter%s(k)%length,in%inter%s(k)%width) .LE. 0._8) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: lengths must be positive.")')
+             STOP 1
+          END IF
+          IF (in%inter%s(k)%length .lt. minlength) THEN
+             minlength=in%inter%s(k)%length
+          END IF
+          IF (in%inter%s(k)%width  .lt. minwidth ) THEN
+             minwidth =in%inter%s(k)%width
+          END IF
+          
+          ! smooth out the slip distribution
+          CALL antialiasingfilter(in%inter%s(k)%slip, &
+                      in%inter%s(k)%length,in%inter%s(k)%width, &
+                      in%dx1,in%dx2,in%dx3,in%nyquist)
+
+          ! comply to Wang's convention
+          CALL wangconvention(in%inter%s(k)%slip, &
+               in%inter%s(k)%x,in%inter%s(k)%y,in%inter%s(k)%z, &
+               in%inter%s(k)%length,in%inter%s(k)%width, &
+               in%inter%s(k)%strike,in%inter%s(k)%dip, &
+               in%inter%s(k)%rake, &
+               in%x0,in%y0,in%rot)
+
+       END DO
+       PRINT 2000
+    END IF
+    
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !       T E N S I L E   S O U R C E S   R A T E
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of inter-seismic tensile segments"
+    CALL getdata(iunit,dataline)
+    READ  (dataline,*) in%inter%nt
+    PRINT '(I5)', in%inter%nt
+    IF (in%inter%nt .GT. 0) THEN
+       ALLOCATE(in%inter%ts(in%inter%nt),in%inter%tsc(in%inter%nt),STAT=iostatus)
+       IF (iostatus>0) STOP "could not allocate the tensile source list"
+       PRINT 2000
+       PRINT '(a)',"no.  opening       xs       ys       ", &
+                   "zs  length   width strike   dip"
+       PRINT 2000
+       DO k=1,in%inter%nt
+          CALL getdata(iunit,dataline)
+          READ  (dataline,*) i,in%inter%ts(k)%slip, &
+               in%inter%ts(k)%x,in%inter%ts(k)%y,in%inter%ts(k)%z, &
+               in%inter%ts(k)%length,in%inter%ts(k)%width, &
+               in%inter%ts(k)%strike,in%inter%ts(k)%dip
+          ! copy the input format for display
+          in%inter%tsc(k)=in%inter%ts(k)
+          
+          PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1)', i, &
+               in%inter%tsc(k)%slip,&
+               in%inter%tsc(k)%x,in%inter%tsc(k)%y,in%inter%tsc(k)%z, &
+               in%inter%tsc(k)%length,in%inter%tsc(k)%width, &
+               in%inter%tsc(k)%strike,in%inter%tsc(k)%dip
+          
+          IF (i .ne. k) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: tensile source index misfit")')
+             STOP 1
+          END IF
+          IF (MAX(in%inter%ts(k)%length,in%inter%ts(k)%width) .LE. 0._8) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'("error in input file: lengths must be positive.")')
+             STOP 1
+          END IF
+          IF (in%inter%ts(k)%length .lt. minlength) THEN
+             minlength=in%inter%ts(k)%length
+          END IF
+          IF (in%inter%ts(k)%width  .lt. minwidth) THEN
+             minwidth =in%inter%ts(k)%width
+          END IF
+          
+          ! smooth out the slip distribution
+          CALL antialiasingfilter(in%inter%ts(k)%slip, &
+                           in%inter%ts(k)%length,in%inter%ts(k)%width, &
+                           in%dx1,in%dx2,in%dx3,in%nyquist)
+
+          ! comply to Wang's convention
+          CALL wangconvention(in%inter%ts(k)%slip, &
+               in%inter%ts(k)%x,in%inter%ts(k)%y,in%inter%ts(k)%z, &
+               in%inter%ts(k)%length,in%inter%ts(k)%width, &
+               in%inter%ts(k)%strike,in%inter%ts(k)%dip,dummy, &
+               in%x0,in%y0,in%rot)
+
+       END DO
+       PRINT 2000
+    END IF
+       
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    !       C 0 - S E I S M I C     E V E N T S
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+    PRINT '(a)', "number of events"
+    CALL getdata(iunit,dataline)
+    READ (dataline,*) in%ne
+    PRINT '(I5)', in%ne
+    IF (in%ne .GT. 0) ALLOCATE(in%events(in%ne),STAT=iostatus)
+    IF (iostatus>0) STOP "could not allocate the event list"
+    
+    DO e=1,in%ne
+       IF (1 .NE. e) THEN
+          PRINT '("time of next coseismic event")'
+          CALL getdata(iunit,dataline)
+          READ (dataline,*) in%events(e)%time
+          
+          IF (0 .EQ. in%skip) THEN
+             ! change event time to multiples of output time step
+             in%events(e)%time=int(in%events(e)%time/in%odt)*in%odt
+          END IF
+
+          PRINT '(ES9.2E1," (multiple of ",ES9.2E1,")")', &
+               in%events(e)%time,in%odt
+
+          IF (in%events(e)%time .LE. in%events(e-1)%time) THEN
+             WRITE_DEBUG_INFO
+             WRITE (0,'(a,a)') "input file error. ", &
+                  "coseismic source time must increase. interrupting."
+             STOP 1
+          END IF
+       ELSE
+          in%events(1)%time=0._8
+          in%events(1)%i=0
+       END IF
+
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !           S H E A R     S O U R C E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of coseismic strike-slip segments"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%events(e)%ns
+       PRINT '(I5)', in%events(e)%ns
+       IF (in%events(e)%ns .GT. 0) THEN
+          ALLOCATE(in%events(e)%s(in%events(e)%ns),in%events(e)%sc(in%events(e)%ns), &
+               STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the source list"
+          PRINT 2000
+          PRINT '(a)',"no.     slip       xs       ys       zs  length   width strike   dip   rake"
+          PRINT 2000
+          DO k=1,in%events(e)%ns
+             CALL getdata(iunit,dataline)
+             READ (dataline,*,IOSTAT=iostatus) i,in%events(e)%s(k)%slip, &
+                  in%events(e)%s(k)%x,in%events(e)%s(k)%y,in%events(e)%s(k)%z, &
+                  in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
+                  in%events(e)%s(k)%strike,in%events(e)%s(k)%dip,in%events(e)%s(k)%rake, &
+                  in%events(e)%s(k)%beta
+
+             SELECT CASE(iostatus)
+             CASE (1:)
+                WRITE_DEBUG_INFO
+                WRITE (0,'("invalid shear source definition at line")')
+                WRITE (0,'(a)') dataline
+                STOP 1
+             CASE (0)
+                IF (in%events(e)%s(k)%beta.GT.0.5d8) STOP "invalid smoothing parameter (beta)."
+             CASE (:-1)
+                ! use default value for smoothing
+                in%events(e)%s(k)%beta=in%beta
+             END SELECT
+
+             ! copy the input format for display
+             in%events(e)%sc(k)=in%events(e)%s(k)
+             
+             IF (iostatus.NE.0) THEN
+                PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1)',i, &
+                     in%events(e)%sc(k)%slip,&
+                     in%events(e)%sc(k)%x,in%events(e)%sc(k)%y,in%events(e)%sc(k)%z, &
+                     in%events(e)%sc(k)%length,in%events(e)%sc(k)%width, &
+                     in%events(e)%sc(k)%strike,in%events(e)%sc(k)%dip, &
+                     in%events(e)%sc(k)%rake
+             ELSE
+                ! print the smoothing value for this patch
+                PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1,f7.1,f6.1)',i, &
+                     in%events(e)%sc(k)%slip,&
+                     in%events(e)%sc(k)%x,in%events(e)%sc(k)%y,in%events(e)%sc(k)%z, &
+                     in%events(e)%sc(k)%length,in%events(e)%sc(k)%width, &
+                     in%events(e)%sc(k)%strike,in%events(e)%sc(k)%dip, &
+                     in%events(e)%sc(k)%rake,in%events(e)%sc(k)%beta
+             END IF
+             
+             IF (i .ne. k) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("invalid shear source definition ")')
+                WRITE (0,'("error in input file: source index misfit")')
+                STOP 1
+             END IF
+             IF (MAX(in%events(e)%s(k)%length,in%events(e)%s(k)%width) .LE. 0._8) THEN
+                WRITE_DEBUG_INFO
+                WRITE (0,'("error in input file: lengths must be positive.")')
+                STOP 1
+             END IF
+             IF (in%events(e)%s(k)%length .lt. minlength) THEN
+                minlength=in%events(e)%s(k)%length
+             END IF
+             IF (in%events(e)%s(k)%width  .lt. minwidth ) THEN
+                minwidth =in%events(e)%s(k)%width
+             END IF
+             
+             ! smooth out the slip distribution
+             CALL antialiasingfilter(in%events(e)%s(k)%slip, &
+                              in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
+                              in%dx1,in%dx2,in%dx3,in%nyquist)
+
+             ! comply to Wang's convention
+             CALL wangconvention(in%events(e)%s(k)%slip, &
+                  in%events(e)%s(k)%x,in%events(e)%s(k)%y,in%events(e)%s(k)%z, &
+                  in%events(e)%s(k)%length,in%events(e)%s(k)%width, &
+                  in%events(e)%s(k)%strike,in%events(e)%s(k)%dip, &
+                  in%events(e)%s(k)%rake, &
+                  in%x0,in%y0,in%rot)
+
+          END DO
+
+#ifdef VTK
+          ! export the fault segments in VTK format for the current event
+          WRITE (digit,'(I3.3)') e
+
+          rffilename=trim(in%wdir)//"/rfaults-"//digit//".vtp"
+          CALL exportvtk_rfaults(in%events(e),rffilename)
+#endif
+          rffilename=trim(in%wdir)//"/rfaults-"//digit//".xy"
+          CALL exportxy_rfaults(in%events(e),in%x0,in%y0,rffilename)
+
+          PRINT 2000
+       END IF
+       
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !          T E N S I L E      S O U R C E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of coseismic tensile segments"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%events(e)%nt
+       PRINT '(I5)', in%events(e)%nt
+       IF (in%events(e)%nt .GT. 0) THEN
+          ALLOCATE(in%events(e)%ts(in%events(e)%nt),in%events(e)%tsc(in%events(e)%nt), &
+               STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the tensile source list"
+          PRINT 2000
+          PRINT '(a)',"no. opening xs ys zs  length width  strike dip"
+          PRINT 2000
+          DO k=1,in%events(e)%nt
+
+             CALL getdata(iunit,dataline)
+             READ  (dataline,*) i,in%events(e)%ts(k)%slip, &
+                  in%events(e)%ts(k)%x,in%events(e)%ts(k)%y,in%events(e)%ts(k)%z, &
+                  in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
+                  in%events(e)%ts(k)%strike,in%events(e)%ts(k)%dip
+             ! copy the input format for display
+             in%events(e)%tsc(k)=in%events(e)%ts(k)
+             
+             PRINT '(I3.3,4ES9.2E1,2ES8.2E1,f7.1,f6.1)',k, &
+                  in%events(e)%tsc(k)%slip,&
+                  in%events(e)%tsc(k)%x,in%events(e)%tsc(k)%y,in%events(e)%tsc(k)%z, &
+                  in%events(e)%tsc(k)%length,in%events(e)%tsc(k)%width, &
+                  in%events(e)%tsc(k)%strike,in%events(e)%tsc(k)%dip
+             
+             IF (i .ne. k) THEN
+                PRINT *, "error in input file: source index misfit"
+                STOP 1
+             END IF
+             IF (in%events(e)%ts(k)%length .lt. minlength) THEN
+                minlength=in%events(e)%ts(k)%length
+             END IF
+             IF (in%events(e)%ts(k)%width  .lt. minwidth) THEN
+                minwidth =in%events(e)%ts(k)%width
+             END IF
+             
+             ! smooth out the slip distribution
+             CALL antialiasingfilter(in%events(e)%ts(k)%slip, &
+                              in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
+                              in%dx1,in%dx2,in%dx3,in%nyquist)
+
+             ! comply to Wang's convention
+             CALL wangconvention(in%events(e)%ts(k)%slip, &
+                  in%events(e)%ts(k)%x,in%events(e)%ts(k)%y,in%events(e)%ts(k)%z, &
+                  in%events(e)%ts(k)%length,in%events(e)%ts(k)%width, &
+                  in%events(e)%ts(k)%strike,in%events(e)%ts(k)%dip,dummy, &
+                  in%x0,in%y0,in%rot)
+
+          END DO
+          PRINT 2000
+       END IF
+       
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !                M O G I      S O U R C E S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of coseismic dilatation point sources"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%events(e)%nm
+       PRINT '(I5)', in%events(e)%nm
+       IF (in%events(e)%nm .GT. 0) THEN
+          ALLOCATE(in%events(e)%m(in%events(e)%nm),in%events(e)%mc(in%events(e)%nm), &
+               STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the tensile source list"
+          PRINT 2000
+          PRINT '(a)',"no. strain (positive for extension) xs ys zs"
+          PRINT 2000
+          DO k=1,in%events(e)%nm
+             CALL getdata(iunit,dataline)
+             READ  (dataline,*) i,in%events(e)%m(k)%slip, &
+                  in%events(e)%m(k)%x,in%events(e)%m(k)%y,in%events(e)%m(k)%z
+             ! copy the input format for display
+             in%events(e)%mc(k)=in%events(e)%m(k)
+             
+             PRINT '(I3.3,4ES9.2E1)',k, &
+                  in%events(e)%mc(k)%slip,&
+                  in%events(e)%mc(k)%x,in%events(e)%mc(k)%y,in%events(e)%mc(k)%z
+             
+             IF (i .ne. k) THEN
+                PRINT *, "error in input file: source index misfit"
+                STOP 1
+             END IF
+             
+             ! rotate the source in the computational reference frame
+             CALL rotation(in%events(e)%m(k)%x,in%events(e)%m(k)%y,in%rot)
+          END DO
+          PRINT 2000
+       END IF
+
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       !             S U R F A C E   L O A D S
+       ! - - - - - - - - - - - - - - - - - - - - - - - - - -
+       PRINT '(a)', "number of surface loads"
+       CALL getdata(iunit,dataline)
+       READ  (dataline,*) in%events(e)%nl
+       PRINT '(I5)', in%events(e)%nl
+       IF (in%events(e)%nl .GT. 0) THEN
+          ALLOCATE(in%events(e)%l(in%events(e)%nl),in%events(e)%lc(in%events(e)%nl), &
+               STAT=iostatus)
+          IF (iostatus>0) STOP "could not allocate the load list"
+          PRINT 2000
+          PRINT '(a)',"t3 in units of force/surface/rigidity, positive down"
+          PRINT '(a)',"T>0 for t3 sin(2pi/T+phi), T<=0 for t3 H(t)"
+          PRINT '(a)',"no.       xs       ys   length    width       t3        T      phi"
+          PRINT 2000
+          DO k=1,in%events(e)%nl
+             CALL getdata(iunit,dataline)
+             READ  (dataline,*,IOSTAT=iostatus) i, &
+                  in%events(e)%l(k)%x,in%events(e)%l(k)%y, &
+                  in%events(e)%l(k)%length,in%events(e)%l(k)%width, &
+                  in%events(e)%l(k)%slip, &
+                  in%events(e)%l(k)%period,in%events(e)%l(k)%phase, &
+                  in%events(e)%l(k)%beta
+             
+             SELECT CASE(iostatus)
+             CASE (1:)
+                WRITE_DEBUG_INFO
+                WRITE (0,'("invalid surface load definition at line")')
+                WRITE (0,'(a)') dataline
+                STOP 1
+             CASE (0)
+                IF (in%events(e)%l(k)%beta.GT.0.5d8) STOP "invalid smoothing parameter beta."
+             CASE (:-1)
+                ! use default value for smoothing
+                in%events(e)%l(k)%beta=in%beta
+             END SELECT
+
+             ! copy the input format for display
+             in%events(e)%lc(k)=in%events(e)%l(k)
+
+             IF (iostatus.EQ.0) THEN
+                PRINT '(I3.3,9ES9.2E1)',k, &
+                     in%events(e)%lc(k)%x,in%events(e)%lc(k)%y, &
+                     in%events(e)%lc(k)%length,in%events(e)%lc(k)%width, &
+                     in%events(e)%lc(k)%slip, &
+                     in%events(e)%lc(k)%period,in%events(e)%lc(k)%phase, &
+                     in%events(e)%lc(k)%beta
+             ELSE
+                PRINT '(I3.3,8ES9.2E1)',k, &
+                     in%events(e)%lc(k)%x,in%events(e)%lc(k)%y, &
+                     in%events(e)%lc(k)%length,in%events(e)%lc(k)%width, &
+                     in%events(e)%lc(k)%slip, &
+                     in%events(e)%lc(k)%period,in%events(e)%lc(k)%phase
+             END IF
+
+             IF (i .NE. k) THEN
+                PRINT *, "error in input file: source index misfit"
+                STOP 1
+             END IF
+             
+             ! rotate the source in the computational reference frame
+             CALL rotation(in%events(e)%l(k)%x,in%events(e)%l(k)%y,in%rot)
+          END DO
+          PRINT 2000
+       END IF
+       
+    END DO
+
+    ! test the presence of dislocations for coseismic calculation
+    IF ((in%events(1)%nt .EQ. 0) .AND. &
+        (in%events(1)%ns .EQ. 0) .AND. &
+        (in%events(1)%nm .EQ. 0) .AND. &
+        (in%events(1)%nl .EQ. 0) .AND. &
+        (in%interval .LE. 0._8)) THEN
+
+       WRITE_DEBUG_INFO
+       WRITE (0,'("**** error **** ")')
+       WRITE (0,'("no input dislocations or dilatation point sources")')
+       WRITE (0,'("or surface tractions for first event . exiting.")')
+       STOP 1
+    END IF
+
+    ! maximum recommended sampling size
+    PRINT '(a,2ES8.2E1)', &
+         "max sampling size (hor.,vert.):", minlength/2.5_8,minwidth/2.5_8
+
+    PRINT 2000
+
+2000 FORMAT ("----------------------------------------------------------------------------")
+2100 FORMAT ("no.        x1       x2       x3   length    width strike    dip")
+2200 FORMAT ("no. slip        x1         x2         x3    length   width strike  dip  rake")
+2300 FORMAT ("no. name       x1       x2       x3 (name is a 4-character string)")
+2400 FORMAT ("no. strain       x1       x2       x3 (positive for extension)")
+2500 FORMAT ("no.        x1       x2       x3   length    width strike    dip   rake")
+
+  END SUBROUTINE init
+
+  !------------------------------------------------------------------
+  !> subroutine WangConvention
+  !! converts a fault slip model from a geologic description including
+  !! fault length, width, strike, dip and rake into a description
+  !! compatible with internal convention of the program.
+  !!
+  !! Internal convention describes a fault patch by the location of
+  !! its center, instead of an upper corner and its orientation by
+  !! the deviation from the vertical, instead of the angle from the
+  !! horizontal and by the angle from the x2 axis (East-West)
+  !------------------------------------------------------------------
+  SUBROUTINE wangconvention(slip,x,y,z,length,width,strike,dip,rake,x0,y0,rot)
+    REAL*8, INTENT(OUT) :: slip, x,y,z,strike,dip,rake
+    REAL*8, INTENT(IN) :: length,width,x0,y0,rot
+
+    slip=-slip
+    strike=-90._8-strike
+    dip   = 90._8-dip
+
+    strike=strike*DEG2RAD
+    dip=dip*DEG2RAD
+    rake=rake*DEG2RAD
+
+    x=x-x0-length/2._8*sin(strike)+width /2._8*sin(dip)*cos(strike)
+    y=y-y0-length/2._8*cos(strike)-width /2._8*sin(dip)*sin(strike)
+    z=z+width /2._8*cos(dip)
+
+    CALL rotation(x,y,rot)
+
+    strike=strike+rot*DEG2RAD
+
+  END SUBROUTINE wangconvention
+  
+  !------------------------------------------------------------------
+  !> subroutine Rotation
+  !! rotates a point coordinate into the computational reference
+  !! system.
+  !! 
+  !! \author sylvain barbot (04/16/09) - original form
+  !------------------------------------------------------------------
+  SUBROUTINE rotation(x,y,rot)
+    REAL*8, INTENT(INOUT) :: x,y
+    REAL*8, INTENT(IN) :: rot
+
+    REAL*8 :: alpha,xx,yy
+
+    alpha=rot*DEG2RAD
+    xx=x
+    yy=y
+
+    x=+xx*cos(alpha)+yy*sin(alpha)
+    y=-xx*sin(alpha)+yy*cos(alpha)
+
+  END SUBROUTINE rotation
+
+  !-------------------------------------------------------------------
+  !> subroutine AntiAliasingFilter
+  !! smoothes a slip distribution model to avoid aliasing of
+  !! the source geometry. Aliasing occurs is a slip patch has 
+  !! dimensions (width or length) smaller than the grid sampling.
+  !!
+  !! if a patch length is smaller than a critical size L=dx*nyquist, it 
+  !! is increased to L and the slip (or opening) is scaled accordingly
+  !! so that the moment M = s*L*W is conserved.
+  !!
+  !! \author sylvain barbot (12/08/09) - original form
+  !-------------------------------------------------------------------
+  SUBROUTINE antialiasingfilter(slip,length,width,dx1,dx2,dx3,nyquist)
+    REAL*8, INTENT(INOUT) :: slip,length,width
+    REAL*8, INTENT(IN) :: dx1,dx2,dx3,nyquist
+
+    REAL*8 :: dx
+
+    ! minimum slip patch dimension
+    dx=MIN(dx1,dx2,dx3)*nyquist
+
+    ! update length
+    IF (length .LT. dx) THEN
+       slip=slip*length/dx
+       length=dx
+    END IF
+    ! update width
+    IF (width .LT. dx) THEN
+       slip=slip*width/dx
+       width=dx
+    END IF
+
+  END SUBROUTINE antialiasingfilter
+
+END MODULE input
diff -r 405d8f4fa05f -r e7295294f654 src/kernel1.inc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kernel1.inc	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,3 @@
+    ! centered finite difference scheme
+    REAL*8, PARAMETER, DIMENSION(1) :: &
+         fir1= (/ 5.000e-01 /) ! filter kernel
diff -r 405d8f4fa05f -r e7295294f654 src/kernel11.inc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kernel11.inc	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,12 @@
+    REAL*8, PARAMETER, DIMENSION(11) :: &
+        fir11=(/ 9.137025467466382e-01, &
+                -3.444134215167435e-01, &
+                +1.372354550142238e-01, &
+                -4.472371911116056e-02, &
+                +9.983584006653466e-03, &
+                -4.203347378221815e-03, &
+                +8.867064453003781e-03, &
+                -1.331685333641829e-02, &
+                +1.339297753637801e-02, &
+                -9.762756789626834e-03, &
+                +3.560973264270618e-03 /)
diff -r 405d8f4fa05f -r e7295294f654 src/kernel14.inc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kernel14.inc	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,15 @@
+    REAL*8, PARAMETER, DIMENSION(14) :: &
+        fir14=(/ 9.487587545326932e-01, &
+                -4.040368216139801e-01, &
+                 2.042931326579159e-01, &
+                -1.022548584863014e-01, &
+                 4.783260352969341e-02, &
+                -2.180739012077366e-02, &
+                 1.283800669716571e-02, &
+                -1.276100476817563e-02, &
+                 1.558222334928575e-02, &
+                -1.758387786545944e-02, &
+                 1.707389141666987e-02, &
+                -1.420560243259215e-02, &
+                 1.081740233347091e-02, &
+                -4.501057368601819e-03/)
diff -r 405d8f4fa05f -r e7295294f654 src/kernel14bis.inc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kernel14bis.inc	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,16 @@
+
+    REAL*8, PARAMETER, DIMENSION(14) :: &
+        fir14=(/ 9.739464097198434e-01, &
+	        -4.492955962260918e-01, &
+                 2.606661503992121e-01, &
+                -1.590778397098753e-01, &
+                 9.524605395168785e-02, &
+                -5.279001022321913e-02, &
+                 2.452656124714124e-02, &
+                -6.434920307760272e-03, &
+                -4.122947453390886e-03, &
+                 9.245789328795669e-03, &
+                -1.060146500976655e-02, &
+                 9.786847569837574e-03, &
+                -9.114943973080788e-03, &
+                 4.398360884720647e-03 /)
\ No newline at end of file
diff -r 405d8f4fa05f -r e7295294f654 src/kernel7.inc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kernel7.inc	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,9 @@
+    REAL*8, PARAMETER, DIMENSION(7) :: &
+         fir7=(/ 8.77856e-01, &
+                -2.81913e-01, &
+                +6.22696e-02, &
+                +2.82441e-02, &
+                -5.09029e-02, &
+                +4.20471e-02, &
+                -1.59409e-02 /) ! filter kernel
+!0.97125_8*
\ No newline at end of file
diff -r 405d8f4fa05f -r e7295294f654 src/mkl_dfti.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/mkl_dfti.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,862 @@
+!*****************************************************************************
+!                            INTEL CONFIDENTIAL
+! Copyright(C) 2002-2010 Intel Corporation. All Rights Reserved.
+! The source code contained  or  described herein and all documents related to
+! the source code ("Material") are owned by Intel Corporation or its suppliers
+! or licensors.  Title to the  Material remains with  Intel Corporation or its
+! suppliers and licensors. The Material contains trade secrets and proprietary
+! and  confidential  information of  Intel or its suppliers and licensors. The
+! Material  is  protected  by  worldwide  copyright  and trade secret laws and
+! treaty  provisions. No part of the Material may be used, copied, reproduced,
+! modified, published, uploaded, posted, transmitted, distributed or disclosed
+! in any way without Intel's prior express written permission.
+! No license  under any  patent, copyright, trade secret or other intellectual
+! property right is granted to or conferred upon you by disclosure or delivery
+! of the Materials,  either expressly, by implication, inducement, estoppel or
+! otherwise.  Any  license  under  such  intellectual property  rights must be
+! express and approved by Intel in writing.
+!
+!*****************************************************************************
+! Content:
+!    Intel(R) Math Kernel Library (MKL)
+!    Discrete Fourier Transform Interface (DFTI)
+!*****************************************************************************
+
+MODULE MKL_DFT_TYPE
+
+  TYPE, PUBLIC :: DFTI_DESCRIPTOR
+     PRIVATE
+     INTEGER :: dontuse
+     ! Structure of this type is not used in Fortran code
+     ! the pointer to this type is used only
+  END TYPE DFTI_DESCRIPTOR
+
+  !======================================================================
+  ! These real type kind parameters are not for direct use
+  !======================================================================
+
+  INTEGER, PARAMETER :: DFTI_SPKP = SELECTED_REAL_KIND(6,37)
+  INTEGER, PARAMETER :: DFTI_DPKP = SELECTED_REAL_KIND(15,307)
+
+  !======================================================================
+  ! Descriptor configuration parameters [default values in brackets]
+  !======================================================================
+
+  ! Domain for forward transform. No default value
+  INTEGER, PARAMETER :: DFTI_FORWARD_DOMAIN = 0
+
+  ! Dimensionality, or rank. No default value
+  INTEGER, PARAMETER :: DFTI_DIMENSION = 1
+
+  ! Length(s) of transform. No default value
+  INTEGER, PARAMETER :: DFTI_LENGTHS = 2
+
+  ! Floating point precision. No default value
+  INTEGER, PARAMETER :: DFTI_PRECISION = 3
+
+  ! Scale factor for forward transform [1.0]
+  INTEGER, PARAMETER :: DFTI_FORWARD_SCALE = 4
+
+  ! Scale factor for backward transform [1.0]
+  INTEGER, PARAMETER :: DFTI_BACKWARD_SCALE = 5
+
+  ! Exponent sign for forward transform [DFTI_NEGATIVE]
+  ! INTEGER, PARAMETER :: DFTI_FORWARD_SIGN = 6 ! NOT IMPLEMENTED
+
+  ! Number of data sets to be transformed [1]
+  INTEGER, PARAMETER :: DFTI_NUMBER_OF_TRANSFORMS = 7
+
+  ! Storage of finite complex-valued sequences in complex domain
+  ! [DFTI_COMPLEX_COMPLEX]
+  INTEGER, PARAMETER :: DFTI_COMPLEX_STORAGE = 8
+
+  ! Storage of finite real-valued sequences in real domain
+  ! [DFTI_REAL_REAL]
+  INTEGER, PARAMETER :: DFTI_REAL_STORAGE = 9
+
+  ! Storage of finite complex-valued sequences in conjugate-even
+  ! domain [DFTI_COMPLEX_REAL]
+  INTEGER, PARAMETER :: DFTI_CONJUGATE_EVEN_STORAGE = 10
+
+  ! Placement of result [DFTI_INPLACE]
+  INTEGER, PARAMETER :: DFTI_PLACEMENT = 11
+
+  ! Generalized strides for input data layout
+  ! [tigth, col-major for Fortran]
+  INTEGER, PARAMETER :: DFTI_INPUT_STRIDES = 12
+
+  ! Generalized strides for output data layout
+  ! [tigth, col-major for Fortran]
+  INTEGER, PARAMETER :: DFTI_OUTPUT_STRIDES = 13
+
+  ! Distance between first input elements for multiple transforms [0]
+  INTEGER, PARAMETER :: DFTI_INPUT_DISTANCE = 14
+
+  ! Distance between first output elements for multiple transforms [0]
+  INTEGER, PARAMETER :: DFTI_OUTPUT_DISTANCE = 15
+
+  ! Effort spent in initialization [DFTI_MEDIUM]
+  ! INTEGER, PARAMETER :: DFTI_INITIALIZATION_EFFORT = 16 ! NOT IMPLEMENTED
+
+  ! Use of workspace during computation [DFTI_ALLOW]
+  ! INTEGER, PARAMETER :: DFTI_WORKSPACE = 17 ! NOT IMPLEMENTED
+
+  ! Ordering of the result [DFTI_ORDERED]
+  INTEGER, PARAMETER :: DFTI_ORDERING = 18
+
+  ! Possible transposition of result [DFTI_NONE]
+  INTEGER, PARAMETER :: DFTI_TRANSPOSE = 19
+
+  ! User-settable descriptor name [""]
+  INTEGER, PARAMETER :: DFTI_DESCRIPTOR_NAME = 20
+
+  ! Packing format for DFTI_COMPLEX_REAL storage of finite
+  ! conjugate-even sequences [DFTI_CCS_FORMAT]
+  INTEGER, PARAMETER :: DFTI_PACKED_FORMAT = 21
+
+  ! Commit status of the descriptor. Read-only parameter
+  INTEGER, PARAMETER :: DFTI_COMMIT_STATUS = 22
+
+  ! Version string for this DFTI implementation. Read-only parameter
+  INTEGER, PARAMETER :: DFTI_VERSION = 23
+
+  ! Ordering of the forward transform. Read-only parameter
+  ! INTEGER, PARAMETER :: DFTI_FORWARD_ORDERING = 24 ! NOT IMPLEMENTED
+
+  ! Ordering of the backward transform. Read-only parameter
+  ! INTEGER, PARAMETER :: DFTI_BACKWARD_ORDERING = 25 ! NOT IMPLEMENTED
+
+  ! Number of user threads that share the descriptor [1]
+  INTEGER, PARAMETER :: DFTI_NUMBER_OF_USER_THREADS = 26
+
+  !======================================================================
+  ! Values of the descriptor configuration parameters
+  !======================================================================
+
+  ! DFTI_COMMIT_STATUS
+  INTEGER, PARAMETER :: DFTI_COMMITTED = 30
+  INTEGER, PARAMETER :: DFTI_UNCOMMITTED = 31
+
+  ! DFTI_FORWARD_DOMAIN
+  INTEGER, PARAMETER :: DFTI_COMPLEX = 32
+  INTEGER, PARAMETER :: DFTI_REAL = 33
+  ! INTEGER, PARAMETER :: DFTI_CONJUGATE_EVEN = 34 ! NOT IMPLEMENTED
+
+  ! DFTI_PRECISION
+  INTEGER, PARAMETER :: DFTI_SINGLE = 35
+  INTEGER, PARAMETER :: DFTI_DOUBLE = 36
+
+  ! DFTI_PRECISION for reduced size of statically linked application.
+  ! Recommended use: modify statement 'USE MKL_DFTI' in your program,
+  ! so that it reads as either of:
+  ! USE MKL_DFTI, FORGET=>DFTI_SINGLE, DFTI_SINGLE=>DFTI_SINGLE_R
+  ! USE MKL_DFTI, FORGET=>DFTI_DOUBLE, DFTI_DOUBLE=>DFTI_DOUBLE_R
+  ! where word 'FORGET' can be any name not used in the program.
+  REAL(DFTI_SPKP), PARAMETER :: DFTI_SINGLE_R = 35
+  REAL(DFTI_DPKP), PARAMETER :: DFTI_DOUBLE_R = 36
+
+  ! DFTI_FORWARD_SIGN
+  ! INTEGER, PARAMETER :: DFTI_NEGATIVE = 37 ! NOT IMPLEMENTED
+  ! INTEGER, PARAMETER :: DFTI_POSITIVE = 38 ! NOT IMPLEMENTED
+
+  ! DFTI_COMPLEX_STORAGE and DFTI_CONJUGATE_EVEN_STORAGE
+  INTEGER, PARAMETER :: DFTI_COMPLEX_COMPLEX = 39
+  INTEGER, PARAMETER :: DFTI_COMPLEX_REAL = 40
+
+  ! DFTI_REAL_STORAGE
+  INTEGER, PARAMETER :: DFTI_REAL_COMPLEX = 41
+  INTEGER, PARAMETER :: DFTI_REAL_REAL = 42
+
+  ! DFTI_PLACEMENT
+  INTEGER, PARAMETER :: DFTI_INPLACE = 43 ! Result overwrites input
+  INTEGER, PARAMETER :: DFTI_NOT_INPLACE  = 44 ! Have another place for result
+
+  ! DFTI_INITIALIZATION_EFFORT
+  ! INTEGER, PARAMETER :: DFTI_LOW = 45 ! NOT IMPLEMENTED
+  ! INTEGER, PARAMETER :: DFTI_MEDIUM = 46 ! NOT IMPLEMENTED
+  ! INTEGER, PARAMETER :: DFTI_HIGH = 47 ! NOT IMPLEMENTED
+
+  ! DFTI_ORDERING
+  INTEGER, PARAMETER :: DFTI_ORDERED = 48
+  INTEGER, PARAMETER :: DFTI_BACKWARD_SCRAMBLED = 49
+  ! INTEGER, PARAMETER :: DFTI_FORWARD_SCRAMBLED  = 50 ! NOT IMPLEMENTED
+
+  ! Allow/avoid certain usages
+  INTEGER, PARAMETER :: DFTI_ALLOW = 51 ! Allow transposition or workspace
+  ! INTEGER, PARAMETER :: DFTI_AVOID = 52 ! NOT IMPLEMENTED
+  INTEGER, PARAMETER :: DFTI_NONE = 53
+
+  ! DFTI_PACKED_FORMAT
+  ! (for storing congugate-even finite sequence in real array)
+  INTEGER, PARAMETER :: DFTI_CCS_FORMAT = 54  ! Complex conjugate-symmetric
+  INTEGER, PARAMETER :: DFTI_PACK_FORMAT = 55 ! Pack format for real DFT
+  INTEGER, PARAMETER :: DFTI_PERM_FORMAT = 56 ! Perm format for real DFT
+  INTEGER, PARAMETER :: DFTI_CCE_FORMAT = 57  ! Complex conjugate-even
+
+  !======================================================================
+  ! Error classes
+  !======================================================================
+  INTEGER, PARAMETER :: DFTI_NO_ERROR = 0
+  INTEGER, PARAMETER :: DFTI_MEMORY_ERROR = 1
+  INTEGER, PARAMETER :: DFTI_INVALID_CONFIGURATION = 2
+  INTEGER, PARAMETER :: DFTI_INCONSISTENT_CONFIGURATION = 3
+  INTEGER, PARAMETER :: DFTI_MULTITHREADED_ERROR = 4
+  INTEGER, PARAMETER :: DFTI_BAD_DESCRIPTOR = 5
+  INTEGER, PARAMETER :: DFTI_UNIMPLEMENTED = 6
+  INTEGER, PARAMETER :: DFTI_MKL_INTERNAL_ERROR = 7
+  INTEGER, PARAMETER :: DFTI_NUMBER_OF_THREADS_ERROR = 8
+  INTEGER, PARAMETER :: DFTI_1D_LENGTH_EXCEEDS_INT32 = 9
+
+  ! Maximum length of error string
+  INTEGER, PARAMETER :: DFTI_MAX_MESSAGE_LENGTH = 80
+
+  ! Maximum length of user-settable descriptor name
+  INTEGER, PARAMETER :: DFTI_MAX_NAME_LENGTH = 10
+
+  ! Maximum length of MKL version string
+  INTEGER, PARAMETER :: DFTI_VERSION_LENGTH = 198
+
+  ! (deprecated parameter)
+  INTEGER, PARAMETER :: DFTI_ERROR_CLASS = 60
+
+END MODULE MKL_DFT_TYPE
+
+MODULE MKL_DFTI
+
+  USE MKL_DFT_TYPE
+
+  INTERFACE DftiCreateDescriptor
+
+     FUNCTION dfti_create_descriptor_1d(desc, precision, domain, dim, length)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_1d
+       !MS$ATTRIBUTES REFERENCE :: precision
+       !MS$ATTRIBUTES REFERENCE :: domain
+       !MS$ATTRIBUTES REFERENCE :: dim
+       !MS$ATTRIBUTES REFERENCE :: length
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_create_descriptor_1d
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       INTEGER, INTENT(IN) :: precision
+       INTEGER, INTENT(IN) :: domain
+       INTEGER, INTENT(IN) :: dim, length
+     END FUNCTION dfti_create_descriptor_1d
+
+     FUNCTION dfti_create_descriptor_highd(desc, precision, domain, dim,length)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_highd
+       !MS$ATTRIBUTES REFERENCE :: precision
+       !MS$ATTRIBUTES REFERENCE :: domain
+       !MS$ATTRIBUTES REFERENCE :: dim
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_create_descriptor_highd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       INTEGER, INTENT(IN) :: precision
+       INTEGER, INTENT(IN) :: domain
+       INTEGER, INTENT(IN) :: dim
+       INTEGER, INTENT(IN), DIMENSION(*) :: length
+     END FUNCTION dfti_create_descriptor_highd
+
+     FUNCTION dfti_create_descriptor_s_1d(desc, s, dom, one, dim)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_s_1d
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: s
+       !MS$ATTRIBUTES REFERENCE :: dom
+       !MS$ATTRIBUTES REFERENCE :: one
+       !MS$ATTRIBUTES REFERENCE :: dim
+       INTEGER dfti_create_descriptor_s_1d
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN) :: s
+       INTEGER, INTENT(IN) :: dom
+       INTEGER, INTENT(IN) :: one
+       INTEGER, INTENT(IN) :: dim
+     END FUNCTION dfti_create_descriptor_s_1d
+
+     FUNCTION dfti_create_descriptor_s_md(desc, s, dom, many, dims)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_s_md
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: s
+       !MS$ATTRIBUTES REFERENCE :: dom
+       !MS$ATTRIBUTES REFERENCE :: many
+       !MS$ATTRIBUTES REFERENCE :: dims
+       INTEGER dfti_create_descriptor_s_md
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN) :: s
+       INTEGER, INTENT(IN) :: dom
+       INTEGER, INTENT(IN) :: many
+       INTEGER, INTENT(IN), DIMENSION(*) :: dims
+     END FUNCTION dfti_create_descriptor_s_md
+
+     FUNCTION dfti_create_descriptor_d_1d(desc, d, dom, one, dim)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_d_1d
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: d
+       !MS$ATTRIBUTES REFERENCE :: dom
+       !MS$ATTRIBUTES REFERENCE :: one
+       !MS$ATTRIBUTES REFERENCE :: dim
+       INTEGER dfti_create_descriptor_d_1d
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN) :: d
+       INTEGER, INTENT(IN) :: dom
+       INTEGER, INTENT(IN) :: one
+       INTEGER, INTENT(IN) :: dim
+     END FUNCTION dfti_create_descriptor_d_1d
+
+     FUNCTION dfti_create_descriptor_d_md(desc, d, dom, many, dims)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_create_descriptor_d_md
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: d
+       !MS$ATTRIBUTES REFERENCE :: dom
+       !MS$ATTRIBUTES REFERENCE :: many
+       !MS$ATTRIBUTES REFERENCE :: dims
+       INTEGER dfti_create_descriptor_d_md
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN) :: d
+       INTEGER, INTENT(IN) :: dom
+       INTEGER, INTENT(IN) :: many
+       INTEGER, INTENT(IN), DIMENSION(*) :: dims
+     END FUNCTION dfti_create_descriptor_d_md
+
+  END INTERFACE
+
+  INTERFACE DftiCopyDescriptor
+
+     FUNCTION dfti_copy_descriptor_external(desc, new_desc)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_copy_descriptor_external
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: new_desc
+       INTEGER dfti_copy_descriptor_external
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       TYPE(DFTI_DESCRIPTOR), POINTER :: new_desc
+     END FUNCTION dfti_copy_descriptor_external
+
+  END INTERFACE
+
+  INTERFACE DftiCommitDescriptor
+
+     FUNCTION dfti_commit_descriptor_external(desc)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_commit_descriptor_external
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_commit_descriptor_external
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_commit_descriptor_external
+
+  END INTERFACE
+
+  INTERFACE DftiSetValue
+
+     FUNCTION dfti_set_value_intval(desc, OptName, IntVal)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_set_value_intval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: IntVal
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_set_value_intval
+       INTEGER, INTENT(IN) :: OptName
+       INTEGER, INTENT(IN) :: IntVal
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_set_value_intval
+
+     FUNCTION dfti_set_value_sglval(desc, OptName, sglval)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_set_value_sglval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: sglval
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_set_value_sglval
+       INTEGER, INTENT(IN) :: OptName
+       REAL(DFTI_SPKP), INTENT(IN) :: sglval
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_set_value_sglval
+
+     FUNCTION dfti_set_value_dblval(desc, OptName, DblVal)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_set_value_dblval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: DblVal
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_set_value_dblval
+       INTEGER, INTENT(IN) :: OptName
+       REAL(DFTI_DPKP), INTENT(IN) :: DblVal
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_set_value_dblval
+
+     FUNCTION dfti_set_value_intvec(desc, OptName, IntVec)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_set_value_intvec
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: IntVec
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_set_value_intvec
+       INTEGER, INTENT(IN) :: OptName
+       INTEGER, INTENT(IN), DIMENSION(*) :: IntVec
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_set_value_intvec
+
+     FUNCTION dfti_set_value_chars(desc, OptName, Chars)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_set_value_chars
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: dfti_set_value_chars
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_set_value_chars
+       INTEGER, INTENT(IN) :: OptName
+       CHARACTER(*), INTENT(IN) :: Chars
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_set_value_chars
+
+  END INTERFACE
+
+  INTERFACE DftiGetValue
+
+     FUNCTION dfti_get_value_intval(desc, OptName, IntVal)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_get_value_intval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: IntVal
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_get_value_intval
+       INTEGER, INTENT(IN) :: OptName
+       INTEGER, INTENT(OUT) :: IntVal
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_get_value_intval
+
+     FUNCTION dfti_get_value_sglval(desc, OptName, sglval)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_get_value_sglval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: sglval
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_get_value_sglval
+       INTEGER, INTENT(IN) :: OptName
+       REAL(DFTI_SPKP), INTENT(OUT) :: sglval
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_get_value_sglval
+
+     FUNCTION dfti_get_value_dblval(desc, OptName, DblVal)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_get_value_dblval
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: DblVal
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_get_value_dblval
+       INTEGER, INTENT(IN) :: OptName
+       REAL(DFTI_DPKP), INTENT(OUT) :: DblVal
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_get_value_dblval
+
+     FUNCTION dfti_get_value_intvec(desc, OptName, IntVec)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_get_value_intvec
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: IntVec
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_get_value_intvec
+       INTEGER, INTENT(IN) :: OptName
+       INTEGER, INTENT(OUT), DIMENSION(*) :: IntVec
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_get_value_intvec
+
+     FUNCTION dfti_get_value_chars(desc, OptName, Chars)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_get_value_chars
+       !MS$ATTRIBUTES REFERENCE :: OptName
+       !MS$ATTRIBUTES REFERENCE :: dfti_get_value_chars
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_get_value_chars
+       INTEGER, INTENT(IN) :: OptName
+       CHARACTER(*), INTENT(OUT) :: Chars
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_get_value_chars
+
+  END INTERFACE
+
+  INTERFACE DftiComputeForward
+
+     FUNCTION dfti_compute_forward_s(desc,sSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_s
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcDst
+       INTEGER dfti_compute_forward_s
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: sSrcDst
+     END FUNCTION dfti_compute_forward_s
+
+     FUNCTION dfti_compute_forward_c(desc,cSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_c
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrcDst
+       INTEGER dfti_compute_forward_c
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: cSrcDst
+     END FUNCTION dfti_compute_forward_c
+
+     FUNCTION dfti_compute_forward_ss(desc,sSrcDstRe,sSrcDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_ss
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcDstRe
+       !MS$ATTRIBUTES REFERENCE :: sSrcDstIm
+       INTEGER dfti_compute_forward_ss
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstRe
+       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstIm
+     END FUNCTION dfti_compute_forward_ss
+
+     FUNCTION dfti_compute_forward_sc(desc,sSrc,cDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_sc
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrc
+       !MS$ATTRIBUTES REFERENCE :: cDst
+       INTEGER dfti_compute_forward_sc
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrc
+       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
+     END FUNCTION dfti_compute_forward_sc
+
+     FUNCTION dfti_compute_forward_cs(desc,cSrc,sDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_cs
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrc
+       !MS$ATTRIBUTES REFERENCE :: sDst
+       INTEGER dfti_compute_forward_cs
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDst
+     END FUNCTION dfti_compute_forward_cs
+
+     FUNCTION dfti_compute_forward_cc(desc,cSrc,cDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_cc
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrc
+       !MS$ATTRIBUTES REFERENCE :: cDst
+       INTEGER dfti_compute_forward_cc
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
+       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
+     END FUNCTION dfti_compute_forward_cc
+
+     FUNCTION dfti_compute_forward_ssss(desc,sSrcRe,sSrcIm,sDstRe,sDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_ssss
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcRe
+       !MS$ATTRIBUTES REFERENCE :: sSrcIm
+       !MS$ATTRIBUTES REFERENCE :: sDstRe
+       !MS$ATTRIBUTES REFERENCE :: sDstIm
+       INTEGER dfti_compute_forward_ssss
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcRe
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcIm
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstRe
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstIm
+     END FUNCTION dfti_compute_forward_ssss
+
+     FUNCTION dfti_compute_forward_d(desc,dSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_d
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcDst
+       INTEGER dfti_compute_forward_d
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: dSrcDst
+     END FUNCTION dfti_compute_forward_d
+
+     FUNCTION dfti_compute_forward_z(desc,zSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_z
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrcDst
+       INTEGER dfti_compute_forward_z
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: zSrcDst
+     END FUNCTION dfti_compute_forward_z
+
+     FUNCTION dfti_compute_forward_dd(desc,dSrcDstRe,dSrcDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_dd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcDstRe
+       !MS$ATTRIBUTES REFERENCE :: dSrcDstIm
+       INTEGER dfti_compute_forward_dd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstRe
+       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstIm
+     END FUNCTION dfti_compute_forward_dd
+
+     FUNCTION dfti_compute_forward_dz(desc,dSrc,zDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_dz
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrc
+       !MS$ATTRIBUTES REFERENCE :: zDst
+       INTEGER dfti_compute_forward_dz
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrc
+       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
+     END FUNCTION dfti_compute_forward_dz
+
+     FUNCTION dfti_compute_forward_zd(desc,zSrc,dDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_zd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrc
+       !MS$ATTRIBUTES REFERENCE :: dDst
+       INTEGER dfti_compute_forward_zd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDst
+     END FUNCTION dfti_compute_forward_zd
+
+     FUNCTION dfti_compute_forward_zz(desc,zSrc,zDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_zz
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrc
+       !MS$ATTRIBUTES REFERENCE :: zDst
+       INTEGER dfti_compute_forward_zz
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
+       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
+     END FUNCTION dfti_compute_forward_zz
+
+     FUNCTION dfti_compute_forward_dddd(desc,dSrcRe,dSrcIm,dDstRe,dDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_forward_dddd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcRe
+       !MS$ATTRIBUTES REFERENCE :: dSrcIm
+       !MS$ATTRIBUTES REFERENCE :: dDstRe
+       !MS$ATTRIBUTES REFERENCE :: dDstIm
+       INTEGER dfti_compute_forward_dddd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcRe
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcIm
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstRe
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstIm
+     END FUNCTION dfti_compute_forward_dddd
+
+  END INTERFACE DftiComputeForward
+
+  INTERFACE DftiComputeBackward
+
+     FUNCTION dfti_compute_backward_s(desc,sSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_s
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcDst
+       INTEGER dfti_compute_backward_s
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: sSrcDst
+     END FUNCTION dfti_compute_backward_s
+
+     FUNCTION dfti_compute_backward_c(desc,cSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_c
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrcDst
+       INTEGER dfti_compute_backward_c
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(INOUT), DIMENSION(*) :: cSrcDst
+     END FUNCTION dfti_compute_backward_c
+
+     FUNCTION dfti_compute_backward_ss(desc,sSrcDstRe,sSrcDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_ss
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcDstRe
+       !MS$ATTRIBUTES REFERENCE :: sSrcDstIm
+       INTEGER dfti_compute_backward_ss
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstRe
+       REAL(DFTI_SPKP), DIMENSION(*) :: sSrcDstIm
+     END FUNCTION dfti_compute_backward_ss
+
+     FUNCTION dfti_compute_backward_sc(desc,sSrc,cDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_sc
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrc
+       !MS$ATTRIBUTES REFERENCE :: cDst
+       INTEGER dfti_compute_backward_sc
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrc
+       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
+     END FUNCTION dfti_compute_backward_sc
+
+     FUNCTION dfti_compute_backward_cs(desc,cSrc,sDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_cs
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrc
+       !MS$ATTRIBUTES REFERENCE :: sDst
+       INTEGER dfti_compute_backward_cs
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDst
+     END FUNCTION dfti_compute_backward_cs
+
+     FUNCTION dfti_compute_backward_cc(desc,cSrc,cDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_cc
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: cSrc
+       !MS$ATTRIBUTES REFERENCE :: cDst
+       INTEGER dfti_compute_backward_cc
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: cSrc
+       COMPLEX(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: cDst
+     END FUNCTION dfti_compute_backward_cc
+
+     FUNCTION dfti_compute_backward_ssss(desc,sSrcRe,sSrcIm,sDstRe,sDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_ssss
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: sSrcRe
+       !MS$ATTRIBUTES REFERENCE :: sSrcIm
+       !MS$ATTRIBUTES REFERENCE :: sDstRe
+       !MS$ATTRIBUTES REFERENCE :: sDstIm
+       INTEGER dfti_compute_backward_ssss
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcRe
+       REAL(DFTI_SPKP), INTENT(IN), DIMENSION(*) :: sSrcIm
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstRe
+       REAL(DFTI_SPKP), INTENT(OUT), DIMENSION(*) :: sDstIm
+     END FUNCTION dfti_compute_backward_ssss
+
+     FUNCTION dfti_compute_backward_d(desc,dSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_d
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcDst
+       INTEGER dfti_compute_backward_d
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: dSrcDst
+     END FUNCTION dfti_compute_backward_d
+
+     FUNCTION dfti_compute_backward_z(desc,zSrcDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_z
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrcDst
+       INTEGER dfti_compute_backward_z
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(INOUT), DIMENSION(*) :: zSrcDst
+     END FUNCTION dfti_compute_backward_z
+
+     FUNCTION dfti_compute_backward_dd(desc,dSrcDstRe,dSrcDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_dd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcDstRe
+       !MS$ATTRIBUTES REFERENCE :: dSrcDstIm
+       INTEGER dfti_compute_backward_dd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstRe
+       REAL(DFTI_DPKP), DIMENSION(*) :: dSrcDstIm
+     END FUNCTION dfti_compute_backward_dd
+
+     FUNCTION dfti_compute_backward_dz(desc,dSrc,zDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_dz
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrc
+       !MS$ATTRIBUTES REFERENCE :: zDst
+       INTEGER dfti_compute_backward_dz
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrc
+       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
+     END FUNCTION dfti_compute_backward_dz
+
+     FUNCTION dfti_compute_backward_zd(desc,zSrc,dDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_zd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrc
+       !MS$ATTRIBUTES REFERENCE :: dDst
+       INTEGER dfti_compute_backward_zd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDst
+     END FUNCTION dfti_compute_backward_zd
+
+     FUNCTION dfti_compute_backward_zz(desc,zSrc,zDst)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_zz
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: zSrc
+       !MS$ATTRIBUTES REFERENCE :: zDst
+       INTEGER dfti_compute_backward_zz
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       COMPLEX(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: zSrc
+       COMPLEX(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: zDst
+     END FUNCTION dfti_compute_backward_zz
+
+     FUNCTION dfti_compute_backward_dddd(desc,dSrcRe,dSrcIm,dDstRe,dDstIm)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_compute_backward_dddd
+       !MS$ATTRIBUTES REFERENCE :: desc
+       !MS$ATTRIBUTES REFERENCE :: dSrcRe
+       !MS$ATTRIBUTES REFERENCE :: dSrcIm
+       !MS$ATTRIBUTES REFERENCE :: dDstRe
+       !MS$ATTRIBUTES REFERENCE :: dDstIm
+       INTEGER dfti_compute_backward_dddd
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcRe
+       REAL(DFTI_DPKP), INTENT(IN), DIMENSION(*) :: dSrcIm
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstRe
+       REAL(DFTI_DPKP), INTENT(OUT), DIMENSION(*) :: dDstIm
+     END FUNCTION dfti_compute_backward_dddd
+
+  END INTERFACE DftiComputeBackward
+
+  INTERFACE DftiFreeDescriptor
+
+     FUNCTION dfti_free_descriptor_external(desc)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_free_descriptor_external
+       !MS$ATTRIBUTES REFERENCE :: desc
+       INTEGER dfti_free_descriptor_external
+       TYPE(DFTI_DESCRIPTOR), POINTER :: desc
+     END FUNCTION dfti_free_descriptor_external
+
+  END INTERFACE
+
+  INTERFACE DftiErrorClass
+
+     FUNCTION dfti_error_class_external(Status, ErrorClass)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_error_class_external
+       !MS$ATTRIBUTES REFERENCE :: Status
+       !MS$ATTRIBUTES REFERENCE :: ErrorClass
+       LOGICAL dfti_error_class_external
+       INTEGER, INTENT(IN) :: Status
+       INTEGER, INTENT(IN) :: ErrorClass
+     END FUNCTION dfti_error_class_external
+
+  END INTERFACE
+
+  INTERFACE DftiErrorMessage
+
+     FUNCTION dfti_error_message_external(Status)
+       USE MKL_DFT_TYPE
+       !DEC$ATTRIBUTES C :: dfti_error_message_external
+       !MS$ATTRIBUTES REFERENCE :: Status
+       CHARACTER(LEN=DFTI_MAX_MESSAGE_LENGTH) :: dfti_error_message_external
+       INTEGER, INTENT(IN) :: Status
+     END FUNCTION dfti_error_message_external
+
+  END INTERFACE
+
+END MODULE MKL_DFTI
diff -r 405d8f4fa05f -r e7295294f654 src/proj.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/proj.c	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,64 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <proj_api.h>
+#include <string.h>
+
+/*
+ * proj routine to convert arrays of UTM coordinates
+ * to longitude/latitude using the PROJ.4 library
+ *
+ * to do: check the output in the south hemisphere
+ *
+ * sylvain barbot (22/05/10) - original form
+ */
+
+void proj_(double *x, double *y, int * n, 
+           double * lon0, double * lat0, int * zone) {
+
+  projPJ pj_utm, pj_latlong;
+  int p, i;
+  char zonestr[3];
+  char cmd_utm[100], cmd_latlong[100];
+  char * to;
+
+  // convert integer zone to string zone
+  i=sprintf(zonestr, "%d", (*zone));
+
+  // construct conversion command (+proj=utm +zone=11)
+  to = stpcpy(cmd_utm,"+proj=utm +zone=");
+  to = stpcpy(to,zonestr);
+  //printf("%s\n",cmd_utm);
+
+  // construct conversion command (+proj=latlong +zone=11)
+  to = stpcpy(cmd_latlong,"+proj=latlong +zone=");
+  to = stpcpy(to,zonestr);
+  //printf("%s\n",cmd_latlong);
+
+  if (!(pj_utm = pj_init_plus(cmd_utm)) ){
+    printf("error initializing input projection driver. exiting.");
+    exit(1);
+  }
+  if (!(pj_latlong = pj_init_plus(cmd_latlong)) ){
+    printf("error initializing output projection driver. exiting.");
+    exit(1);
+  }
+
+  // convert to radians
+  (*lon0)*=DEG_TO_RAD;
+  (*lat0)*=DEG_TO_RAD;
+
+  p = pj_transform(pj_latlong, pj_utm, 1, 1, lon0, lat0, NULL);
+
+  // add UTM coordinates of the origin
+  for (i=0;i<(*n);i++){
+    x[i]+=(*lon0);
+    y[i]+=(*lat0);
+  }
+  p = pj_transform(pj_utm, pj_latlong, (*n), 1, x, y, NULL);
+
+  // convert longitude and latitude to degrees
+  for (i=0;i<(*n);i++){
+    x[i]*=RAD_TO_DEG;
+    y[i]*=RAD_TO_DEG;
+  }
+}
diff -r 405d8f4fa05f -r e7295294f654 src/relax.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/relax.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,1121 @@
+!-----------------------------------------------------------------------
+! Copyright 2007-2012, Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+  !-----------------------------------------------------------------------
+  !> \mainpage 
+  !! program relax
+  !! <hr>
+  !! PURPOSE:
+  !!   The program RELAX computes nonlinear time-dependent viscoelastic
+  !!   deformation with powerlaw rheology and rate-strengthening friction 
+  !!   in a cubic, periodic grid due to coseismic stress changes, initial
+  !!   stress, surface loads, and/or moving faults.
+  !! 
+  !! ONLINE DOCUMENTATION:
+  !!   generate html documentation from the source directory with the 
+  !!   doxygen (http://www.stack.nl/~dimitri/doxygen/index.html) 
+  !!   program with command:
+  !!
+  !!     doxygen .doxygen
+  !!
+  !! DESCRIPTION:
+  !!   Computation is done semi-analytically inside a cartesian grid.
+  !!   The grid is defined by its size sx1*sx2*sx3 and the sampling
+  !!   intervals dx1, dx2 and dx3. rule of thumb is to allow for at least
+  !!   five samples per fault length or width, and to have the tip of any 
+  !!   fault at least 10 fault widths away from any edge of the 
+  !!   computational grid.
+  !!
+  !!   Coseismic stress changes and initial coseismic deformation results
+  !!   from the presence of dislocations in the brittle layer. Fault
+  !!   geometry is prescribed following Okada or Wang's convention, with the
+  !!   usual slip, strike, dip and rake and is converted to a double-couple
+  !!   equivalent body-force analytically. Current implementation allows 
+  !!   shear fault (strike slip and dip slip), dykes, Mogi source, and
+  !!   surface traction. Faults and dykes can be of arbitrary orientation 
+  !!   in the half space.
+  !!
+  !! <hr>
+  !!
+  !! METHOD:
+  !!   The current implementation is organized to integrate stress/strain-
+  !!   rate constitutive laws (rheologies) of the form
+  !! \f[
+  !!       \dot{\epsilon} = f(\sigma)
+  !! \f]
+  !!   as opposed to epsilon^dot = f(sigma,epsilon) wich would include work-
+  !!   hardening (or weakening). The time-stepping implements a second-order
+  !!   Runge-Kutta numerical integration scheme with a variable time-step.
+  !!   The Runge-Kutta method integrating the ODE y'=f(x,y) can be summarized
+  !!   as follows:
+  !! \f[
+  !!          y_(n+1) = y_n + k_2
+  !!              k_1 = h * f(x_n, y_n)
+  !!              k_2 = h * f(x_n + h, y_n + k_1)
+  !! \f]
+  !!   where h is the time-step and n is the time-index. The elastic response
+  !!   in the computational grid is obtained using elastic Greens functions.
+  !!   The Greens functions are applied in the Fourier domain. Strain,
+  !!   stress and body-forces are obtained by application of a finite impulse
+  !!   response (FIR) differentiator filter in the space domain.
+  !!
+  !! <hr>
+  !!
+  !! INPUT:
+  !!   Static dislocation sources are discretized into a series of planar
+  !!   segments. Slip patches are defined in terms of position, orientation,
+  !!   and slip, as illustrated in the following figure:
+  !!\verbatim
+  !!                 N (x1)
+  !!                /
+  !!               /| Strike
+  !!   x1,x2,x3 ->@------------------------      (x2)
+  !!              |\        p .            \ W
+  !!              :-\      i .              \ i
+  !!              |  \    l .                \ d
+  !!              :90 \  S .                  \ t
+  !!              |-Dip\  .                    \ h
+  !!              :     \. | Rake               \
+  !!              |      -------------------------
+  !!              :             L e n g t h
+  !!              Z (x3)
+  !!\endverbatim
+  !!   Dislocations are converted to double-couple equivalent body-force
+  !!   analytically. Solution displacement is obtained by application of
+  !!   the Greens functions in the Fourier domain.
+  !!
+  !!   For friction faults where slip rates are evaluated from stress and
+  !!   a constitutive law, the rake corresponds to the orientation of slip. 
+  !!   That is, if r_i is the rake vector and v_i is the instantaneous 
+  !!   velocity vector, then r_j v_j >= 0. 
+  !!
+  !! <hr>
+  !!
+  !! OUTPUT:
+  !!   The vector-valued deformation is computed everywhere in a cartesian
+  !!   grid. The vector field is sampled 1) along a horizontal surface at a
+  !!   specified depth and 2) at specific points. Format is always North (x1), 
+  !!   East (x2) and Down (x3) components, following the right-handed reference 
+  !!   system convention. North corresponds to x1-direction, East to the 
+  !!   x2-direction and down to the x3-direction. The Generic Mapping Tool 
+  !!   output files are labeled explicitely ???-north.grd, ???-east.grd and 
+  !!   ???-up.grd (or say, ???-geo-up.grd for outputs in geographic 
+  !!   coordinates), where ??? stands for an output index: 001, 002, ...
+  !!
+  !!   The amplitude of the inelastic (irreversible) deformation is also
+  !!   tracked and can be output along a plane of arbitrary orientation.
+  !!   The inelastic deformation includes the initial, constrained, slip on
+  !!   fault surfaces, the time-dependent slip on frictional surfaces and
+  !!   the cumulative amplitude of bulk strain in viscoelastic regions.
+  !!   Slip is provided as a function of local coordinates along strike and 
+  !!   dip as well as a function of the Cartesian coordinates for three-
+  !!   dimensional display.
+  !!
+  !!   Time integration uses adaptive time steps to ensure accuracy but
+  !!   results can be output either 1) at specified uniform time intervals 
+  !!   or 2) at the same intervals as computed. In the later case, output 
+  !!   intervals is chosen internally depending on instantaneous relaxation 
+  !!   rates.
+  !!
+  !! <hr>
+  !!
+  !! TECHNICAL ASPECTS:
+  !!   Most of the computational burden comes from 1) applying the elastic
+  !!   Green function and 2) computing the current strain from a displacement
+  !!   field. The convolution of body forces with the Green function is 
+  !!   performed in the Fourier domain and the efficiency of the computation
+  !!   depends essentially upon a choice of the discrete Fourier transform.
+  !!   Current implementation is compatible with the Couley-Tuckey, the
+  !!   Fast Fourier transform of the West (FFTW), the SGI FFT and the intel
+  !!   FFT from the intel MKL library. Among these choices, the MKL FFT is
+  !!   the most efficient. The FFTW, SGI FFT and MKL FFT can all be ran
+  !!   in parallel on shared-memory computers.
+  !!
+  !!   Strain is computed using a Finite Impulse Response differentiator
+  !!   filter in the space domain. Use of FIR filter give rise to very
+  !!   accurate derivatives but is computationally expensive. The filter
+  !!   kernels are provided in the kernel???.inc files. Use of a compact
+  !!   kernel may accelerate computation significantly.
+  !!
+  !!   Compilation options are defined in the include.f90 file and specify
+  !!   for instance the choice of DFT and the kind of output provided.
+  !!
+  !! MODIFICATIONS:
+  !! \author Sylvain Barbot 
+  !! (07-06-07) - original form                                    <br>
+  !! (08-28-08) - FFTW/SGI_FFT support, FIR derivatives,
+  !!              Runge-Kutta integration, tensile cracks,
+  !!              GMT output, comments in input file               <br>
+  !! (10-24-08) - interseismic loading, postseismic signal
+  !!              output in separate files                         <br>
+  !! (12-08-09) - slip distribution smoothing                      <br>
+  !! (05-05-10) - lateral variations in viscous properties
+  !!              Intel MKL implementation of the FFT              <br>
+  !! (06-04-10) - output in geographic coordinates
+  !!              and output components of stress tensor           <br>
+  !! (07-19-10) - includes surface tractions initial condition
+  !!              output geometry in VTK format for Paraview       <br>
+  !! (02-28-11) - add constraints on the broad direction of 
+  !!              afterslip, export faults to GMT xy format
+  !!              and allow scaling of computed time steps.        <br>
+  !! (04-26-11) - include command-line arguments
+  !! (11-04-11) - compatible with gfortran                         <br>
+  !!
+  !! \todo 
+  !!   - homogenize VTK output so that geometry of events match event index
+  !!   - evaluate Green's function, stress and body forces in GPU
+  !!   - write the code for MPI multi-thread
+  !!   - fix the vtk export to grid for anisotropic sampling
+  !!   - export position of observation points to long/lat in opts-geo.dat
+  !!   - check the projected output on the south hemisphere
+  !!   - check the fully-relaxed afterslip for uniform stress change
+  !!   - include topography of parameter interface
+  !!   - export afterslip output in VTK
+  !------------------------------------------------------------------------
+PROGRAM relax
+
+  USE types
+  USE input
+  USE green
+  USE elastic3d
+  USE viscoelastic3d
+  USE friction3d
+  USE export
+
+#include "include.f90"
+  
+  IMPLICIT NONE
+  
+  INTEGER, PARAMETER :: ITERATION_MAX = 9900
+  REAL*8, PARAMETER :: STEP_MAX = 1e7
+
+  INTEGER :: i,k,e,oi,iostatus,mech(3)
+#ifdef FFTW3_THREADS
+  INTEGER :: iret
+!$  INTEGER :: omp_get_max_threads
+#endif
+  REAL*8 :: maxwell(3)
+  TYPE(SIMULATION_STRUC) :: in
+#ifdef VTK
+  CHARACTER(80) :: filename,title,name
+  CHARACTER(3) :: digit
+#endif
+  CHARACTER(4) :: digit4
+  REAL*8 :: t,Dt,tm
+  
+  ! arrays
+  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: v1,v2,v3,u1,u2,u3,gamma
+  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: u1r,u2r,u3r
+  REAL*4, DIMENSION(:,:), ALLOCATABLE :: t1,t2,t3
+  REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: inter1,inter2,inter3
+  TYPE(TENSOR), DIMENSION(:,:,:), ALLOCATABLE :: tau,sig,moment
+  
+#ifdef FFTW3_THREADS
+  CALL sfftw_init_threads(iret)
+#ifdef _OPENMP
+  CALL sfftw_plan_with_nthreads(omp_get_max_threads())
+#else
+  CALL sfftw_plan_with_nthreads(4)
+#endif
+#endif
+
+  ! read input parameters
+  CALL init(in)
+
+  ! abort calculation after help message
+  ! or for dry runs
+  IF (in%isdryrun) THEN
+     PRINT '("dry run: abort calculation")'
+  END IF
+  IF (in%isdryrun .OR. in%ishelp) THEN
+     ! exit program
+     GOTO 100
+  END IF
+
+  ! allocate memory
+  ALLOCATE (v1(in%sx1+2,in%sx2,in%sx3),v2(in%sx1+2,in%sx2,in%sx3),v3(in%sx1+2,in%sx2,in%sx3), &
+            u1(in%sx1+2,in%sx2,in%sx3/2),u2(in%sx1+2,in%sx2,in%sx3/2),u3(in%sx1+2,in%sx2,in%sx3/2), &
+            tau(in%sx1,in%sx2,in%sx3/2),sig(in%sx1,in%sx2,in%sx3/2),gamma(in%sx1+2,in%sx2,in%sx3/2), &
+            t1(in%sx1+2,in%sx2),t2(in%sx1+2,in%sx2),t3(in%sx1+2,in%sx2), &
+            STAT=iostatus)
+  IF (iostatus>0) STOP "could not allocate memory"
+#ifdef VTK
+  IF (in%isoutputvtkrelax) THEN
+     ALLOCATE(u1r(in%sx1+2,in%sx2,in%sx3/2),u2r(in%sx1+2,in%sx2,in%sx3/2), &
+              u3r(in%sx1+2,in%sx2,in%sx3/2),STAT=iostatus)
+     IF (iostatus>0) STOP "could not allocate memory for VTK relax output"
+     u1r=0
+     u2r=0
+     u3r=0
+  END IF
+#endif
+
+  IF (in%isoutputrelax) THEN
+     ALLOCATE(inter1(in%sx1+2,in%sx2,2),inter2(in%sx1+2,in%sx2,2),inter3(in%sx1+2,in%sx2,2),STAT=iostatus)
+     IF (iostatus>0) STOP "could not allocate memory for postseismic displacement"
+  END IF
+
+  v1=0;v2=0;v3=0;u1=0;u2=0;u3=0;gamma=0;t1=0;t2=0;t3=0
+  CALL tensorfieldadd(tau,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  ! -     construct pre-stress structure
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  IF (ALLOCATED(in%stresslayer)) THEN
+     CALL tensorstructure(in%stressstruc,in%stresslayer,in%dx3)
+     DEALLOCATE(in%stresslayer)
+     
+     DO k=1,in%sx3/2
+        tau(:,:,k)=(-1._4) .times. in%stressstruc(k)%t
+     END DO
+     DEALLOCATE(in%stressstruc)
+  END IF
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  ! -     construct linear viscoelastic structure
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  IF (ALLOCATED(in%linearlayer)) THEN
+     CALL viscoelasticstructure(in%linearstruc,in%linearlayer,in%dx3)
+     DEALLOCATE(in%linearlayer)
+  END IF
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  ! -   construct nonlinear viscoelastic structure
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  IF (ALLOCATED(in%nonlinearlayer)) THEN
+     CALL viscoelasticstructure(in%nonlinearstruc,in%nonlinearlayer,in%dx3)
+     DEALLOCATE(in%nonlinearlayer)
+  END IF
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  ! -   construct nonlinear fault creep structure (rate-strenghtening)
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  IF (ALLOCATED(in%faultcreeplayer)) THEN
+     CALL viscoelasticstructure(in%faultcreepstruc,in%faultcreeplayer,in%dx3)
+     DEALLOCATE(in%faultcreeplayer)
+  END IF
+
+  ! first event
+  e=1
+  ! first output
+  oi=1;
+  ! initial condition
+  t=0
+
+  ! sources
+  CALL dislocations(in%events(e),in%lambda,in%mu,in%beta,in%sx1,in%sx2,in%sx3, &
+                    in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau)
+  CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,0.d0,t3)
+  
+  PRINT '("coseismic event ",I3.3)', e
+  PRINT 0990
+
+  ! export the amplitude of eigenstrain
+  CALL exporteigenstrain(gamma,in%nop,in%op,in%x0,in%y0, &
+                         in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,0)
+  
+  ! export equivalent body forces
+  IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
+#ifdef GRD_EQBF
+     IF (in%isoutputgrd) THEN
+        CALL exportgrd(v1,v2,v3,in%sx1,in%sx2,in%sx3/2, &
+                       in%dx1,in%dx2,in%dx3,0.7_8,in%x0,in%y0,in%wdir,0,convention=3)
+     END IF
+#endif
+  END IF
+
+  ! test the presence of dislocations for coseismic calculation
+  IF ((in%events(e)%nt .NE. 0) .OR. &
+      (in%events(e)%ns .NE. 0) .OR. &
+      (in%events(e)%nm .NE. 0) .OR. &
+      (in%events(e)%nl .NE. 0)) THEN
+
+     ! apply the 3d elastic transfer function
+     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3, &
+                               in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
+  END IF
+  
+  ! transfer solution
+  CALL fieldrep(u1,v1,in%sx1+2,in%sx2,in%sx3/2)
+  CALL fieldrep(u2,v2,in%sx1+2,in%sx2,in%sx3/2)
+  CALL fieldrep(u3,v3,in%sx1+2,in%sx2,in%sx3/2)
+
+  ! evaluate stress
+  CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=-1._4)
+  CALL stressupdate(u1,u2,u3,in%lambda,in%mu, &
+                    in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
+
+  ! export displacements
+#ifdef TXT
+  IF (in%isoutputtxt) THEN
+     CALL exporttxt(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx3,0,0._8,in%wdir,in%reportfilename)
+  END IF
+#endif
+#ifdef XYZ
+  IF (in%isoutputxyz) THEN
+     CALL exportxyz(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx1,in%dx2,in%dx3,0,in%wdir)
+  END IF
+#endif
+#ifdef GRD
+  IF (in%isoutputgrd) THEN
+     CALL exportgrd(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0,in%wdir,0)
+     IF (in%isoutputrelax) THEN
+        CALL exportgrd(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
+                       in%dx1,in%dx2,in%dx3,0._8,in%x0,in%y0,in%wdir,0,convention=2)
+     END IF
+  END IF
+#endif
+#ifdef PROJ
+  IF (in%isoutputproj) THEN
+     CALL exportproj(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz, &
+                     in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,0)
+  END IF
+#endif
+#ifdef VTK
+  IF (in%isoutputvtk) THEN
+     !filename=trim(in%wdir)//"/disp-000.vtr"
+     !CALL exportvtk_vectors(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
+     filename=trim(in%wdir)//"/disp-000.vtk"//char(0)
+     title="coseismic displacement vector field"//char(0)
+     name="displacement"//char(0)
+     CALL exportvtk_vectors_legacy(u1,u2,u3,in%sx1,in%sx2,in%sx3/8,in%dx1,in%dx2,in%dx3, &
+                                   4,4,8,filename,title,name)
+     !CALL exportvtk_vectors_slice(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
+  END IF
+  IF (in%isoutputvtkrelax) THEN
+     filename=trim(in%wdir)//"/disp-relax-000.vtk"//char(0)
+     title="postseismic displacement vector field"//char(0)
+     name="displacement"//char(0)
+     CALL exportvtk_vectors_legacy(u1r,u2r,u3r,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
+                                   4,4,8,filename,title,name)
+  END IF
+#endif
+  IF (ALLOCATED(in%ptsname)) THEN
+     CALL exportpoints(u1,u2,u3,sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+          in%opts,in%ptsname,0._8,in%wdir,.true.,in%x0,in%y0,in%rot)
+  END IF
+
+  ! export initial stress
+#ifdef GRD
+  CALL exportplanestress(sig,in%nop,in%op,in%x0,in%y0,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,oi)
+  IF (in%isoutputgrd .AND. in%isoutputstress) THEN
+     CALL exportstressgrd(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                          in%ozs,in%x0,in%y0,in%wdir,0)
+  END IF
+#endif
+#ifdef PROJ
+  IF (in%isoutputproj .AND. in%isoutputstress) THEN
+      CALL exportstressproj(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%ozs, &
+                            in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,0)
+  END IF
+#endif
+  ! initialize stress conditions
+  CALL export_rfaults_stress_init(sig,in%sx1,in%sx2,in%sx3, &
+                                     in%dx1,in%dx2,in%dx3,in%nsop,in%sop)
+  WRITE (digit4,'(I4.4)') 0
+#ifdef VTK
+  IF (in%isoutputvtk .AND. in%isoutputstress) THEN
+     filename=trim(in%wdir)//"/sigma-"//digit4//".vtk"//char(0)
+     title="stress tensor field"//char(0)
+     name="stress"//char(0)
+     CALL exportvtk_tensors_legacy(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                                   4,4,8,filename,title,name)
+  END IF
+  ! coseismic stress change on predefined planes for 3-D visualization w/ Paraview
+  filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".vtp"
+  CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                in%nsop,in%sop,filename,sig=sig)
+  ! postseismic stress change on predefined planes (zero by definition)
+  filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".vtp"
+  CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                in%nsop,in%sop,filename)
+#endif
+  ! coseismic stress change on predefined planes for gmt
+  filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".xy"
+  CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                in%nsop,in%sop,filename,sig=sig)
+  ! postseismic stress change on predefined planes for gmt (zero by definition)
+  filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".xy"
+  CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                in%nsop,in%sop,filename)
+  ! time series of stress in ASCII format
+  CALL exportcoulombstress(sig,in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                    in%nsop,in%sop,0._8,in%wdir,.TRUE.)
+  CALL reporttime(0,0._8,in%reporttimefilename)
+
+  PRINT 1101,0,0._8,0._8,0._8,0._8,0._8,in%interval,0._8,tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
+  IF (in%interval .LE. 0) THEN
+     GOTO 100 ! no time integration
+  END IF
+
+  ALLOCATE(moment(in%sx1,in%sx2,in%sx3/2),STAT=iostatus)
+  IF (iostatus>0) STOP "could not allocate the mechanical structure"
+
+  !CALL tensorfieldadd(sig,sig,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)
+  CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=0._4)  
+
+  DO i=1,ITERATION_MAX
+     IF (t .GE. in%interval) GOTO 100 ! proper exit
+     
+     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+     ! predictor
+     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+     ! initialize large time step
+     tm=STEP_MAX;
+     maxwell(:)=STEP_MAX;
+     
+     ! active mechanism flag
+     mech(:)=0
+
+     ! initialize no forcing term in tensor space
+     CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,0._4,0._4)
+
+     ! power density from three mechanisms (linear and power-law viscosity 
+     ! and fault creep)
+     ! 1- linear viscosity
+     IF (ALLOCATED(in%linearstruc)) THEN
+        CALL viscouseigenstress(in%mu,in%linearstruc,in%linearweakzone,in%nlwz, &
+             sig,in%sx1,in%sx2,in%sx3/2, &
+             in%dx1,in%dx2,in%dx3,moment,0.01_8,MAXWELLTIME=maxwell(1))
+        mech(1)=1
+     END IF
+     
+     ! 2- powerlaw viscosity
+     IF (ALLOCATED(in%nonlinearstruc)) THEN
+        CALL viscouseigenstress(in%mu,in%nonlinearstruc,in%nonlinearweakzone,in%nnlwz, &
+             sig,in%sx1,in%sx2,in%sx3/2, &
+             in%dx1,in%dx2,in%dx3,moment,0.01_8,MAXWELLTIME=maxwell(2))
+        mech(2)=1
+     END IF
+     
+     ! 3- nonlinear fault creep with rate-strengthening friction
+     IF (ALLOCATED(in%faultcreepstruc)) THEN
+        DO k=1,in%np
+           CALL frictioneigenstress(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
+                in%n(k)%width,in%n(k)%length, &
+                in%n(k)%strike,in%n(k)%dip,in%n(k)%rake,in%beta, &
+                sig,in%mu,in%faultcreepstruc, &
+                in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                moment,maxwelltime=maxwell(3))
+        END DO
+        mech(3)=1
+     END IF
+
+#ifdef VTK
+     IF (in%isoutputvtk .AND. in%isoutputstress) THEN
+        WRITE (digit,'(I3.3)') oi-1
+        filename=trim(in%wdir)//"/power-"//digit//".vtk"//char(0)
+        title="stress rate tensor field"//char(0)
+        name="power"//char(0)
+        CALL exportvtk_tensors_legacy(moment,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                                      4,4,8,filename,title,name)
+     END IF
+#endif
+
+     ! identify the required time step
+     tm=1._8/(REAL(mech(1))/maxwell(1)+ &
+              REAL(mech(2))/maxwell(2)+ &
+              REAL(mech(3))/maxwell(3))
+     ! force finite time step
+     tm=MIN(tm,STEP_MAX)
+
+     ! modify
+     IF ((in%inter%ns .GT. 0) .OR. (in%inter%nt .GT. 0)) THEN
+        IF (tm .EQ. STEP_MAX) THEN
+           ! no relaxation occurs, pick a small integration time
+           tm=in%interval/20._8
+        END IF
+     END IF
+     
+     ! choose an integration time step
+     CALL integrationstep(tm,Dt,t,oi,in%odt,in%skip,in%tscale,in%events,e,in%ne)
+
+     CALL tensorfieldadd(sig,moment,in%sx1,in%sx2,in%sx3/2,c1=0.0_4,c2=1._4)
+     
+     v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
+     CALL equivalentbodyforce(sig,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,v1,v2,v3,t1,t2,t3)
+
+     ! add time-dependent surface loads
+     CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,Dt/2.d8,t3,rate=.TRUE.)
+
+     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3,in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
+     
+     ! v1,v2,v3 contain the predictor displacement
+     CALL fieldadd(v1,u1,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
+     CALL fieldadd(v2,u2,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
+     CALL fieldadd(v3,u3,in%sx1+2,in%sx2,in%sx3/2,c1=REAL(Dt/2))
+     CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=-REAL(Dt/2),c2=-1._4)
+
+     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+     ! corrector
+     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+     CALL stressupdate(v1,v2,v3,in%lambda,in%mu, &
+                       in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
+
+     ! reinitialize moment density tensor
+     CALL tensorfieldadd(moment,moment,in%sx1,in%sx2,in%sx3/2,0._4,0._4)
+     
+     IF (ALLOCATED(in%linearstruc)) THEN
+        ! linear viscosity
+        v1=0
+        CALL viscouseigenstress(in%mu,in%linearstruc,in%linearweakzone,in%nlwz,sig, &
+             in%sx1,in%sx2,in%sx3/2, &
+             in%dx1,in%dx2,in%dx3,moment,0.01_8,GAMMA=v1)
+        
+        ! update slip history
+        CALL fieldadd(gamma,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
+     END IF
+     
+     IF (ALLOCATED(in%nonlinearstruc)) THEN
+        ! powerlaw viscosity
+        v1=0
+        CALL viscouseigenstress(in%mu,in%nonlinearstruc,in%nonlinearweakzone,in%nnlwz,sig, &
+             in%sx1,in%sx2,in%sx3/2, &
+             in%dx1,in%dx2,in%dx3,moment,0.01_8,GAMMA=v1)
+        
+        ! update slip history
+        CALL fieldadd(gamma,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
+     END IF
+     
+     ! nonlinear fault creep with rate-strengthening friction
+     IF (ALLOCATED(in%faultcreepstruc)) THEN
+
+        ! use v1 as placeholders for the afterslip planes
+        DO k=1,in%np
+           ! one may use optional arguments ...,VEL=v1) to convert
+           ! fault slip to eigenstrain (scalar)
+           CALL frictioneigenstress(in%n(k)%x,in%n(k)%y,in%n(k)%z, &
+                in%n(k)%width,in%n(k)%length, &
+                in%n(k)%strike,in%n(k)%dip,in%n(k)%rake,in%beta, &
+                sig,in%mu,in%faultcreepstruc,in%sx1,in%sx2,in%sx3/2, &
+                in%dx1,in%dx2,in%dx3,moment)
+        END DO
+
+        ! export strike and dip creep velocity
+        IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
+           CALL exportcreep(in%np,in%n,in%beta,sig,in%faultcreepstruc, &
+                            in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%x0,in%y0,in%wdir,oi)
+        END IF
+
+     END IF
+
+     ! interseismic loading
+     IF ((in%inter%ns .GT. 0) .OR. (in%inter%nt .GT. 0)) THEN
+        ! vectors v1,v2,v3 are not affected.
+        CALL dislocations(in%inter,in%lambda,in%mu,in%beta,in%sx1,in%sx2,in%sx3, &
+             in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau,eigenstress=moment)
+     END IF
+     
+     v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
+     CALL equivalentbodyforce(moment,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,v1,v2,v3,t1,t2,t3)
+
+     ! add time-dependent surface loads
+     CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,Dt,t3,rate=.true.)
+
+     ! export equivalent body forces
+     IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
+#ifdef VTK_EQBF
+        IF (in%isoutputvtk) THEN
+           WRITE (digit,'(I3.3)') oi
+           !filename=trim(in%wdir)//"/eqbf-"//digit//".vtr"
+           !CALL exportvtk_vectors(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
+           filename=trim(in%wdir)//"/eqbf-"//digit//".vtk"//char(0)
+           title="instantaneous equivalent body-force rate vector field"//char(0)
+           name="body-force-rate"//char(0)
+           CALL exportvtk_vectors_legacy(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
+                                         4,4,8,filename,title,name)
+        END IF
+#endif
+#ifdef GRD_EQBF
+        IF (in%isoutputgrd) THEN
+           CALL exportgrd(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                          in%oz,in%x0,in%y0,in%wdir,oi,convention=3)
+        END IF
+#endif
+     END IF
+
+     CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3,in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
+
+     ! update deformation field
+     CALL fieldadd(u1,v1,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
+     CALL fieldadd(u2,v2,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
+     CALL fieldadd(u3,v3,in%sx1+2,in%sx2,in%sx3/2,c2=REAL(Dt))
+     CALL tensorfieldadd(tau,moment,in%sx1,in%sx2,in%sx3/2,c2=REAL(Dt))
+     
+     ! keep track of the viscoelastic contribution alone
+     IF (in%isoutputrelax) THEN
+        CALL sliceadd(inter1(:,:,1),v1,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
+        CALL sliceadd(inter2(:,:,1),v2,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
+        CALL sliceadd(inter3(:,:,1),v3,in%sx1+2,in%sx2,in%sx3,int(in%oz/in%dx3)+1,c2=REAL(Dt))
+     END IF
+
+#ifdef VTK
+     IF (in%isoutputvtkrelax) THEN
+        u1r=u1r+Dt*v1
+        u2r=u2r+Dt*v2
+        u3r=u3r+Dt*v3 
+     END IF
+#endif
+
+     ! time increment
+     t=t+Dt
+     
+     ! next event
+     IF (e .LT. in%ne) THEN
+        IF (abs(t-in%events(e+1)%time) .LT. 1e-6) THEN
+           e=e+1
+           in%events(e)%i=i
+
+           PRINT '("coseismic event ",I3.3)', e
+           PRINT 0990
+
+           v1=0;v2=0;v3=0;t1=0;t2=0;t3=0;
+           CALL dislocations(in%events(e),in%lambda,in%mu, &
+                in%beta,in%sx1,in%sx2,in%sx3, &
+                in%dx1,in%dx2,in%dx3,v1,v2,v3,t1,t2,t3,tau)
+           CALL traction(in%mu,in%events(e),in%sx1,in%sx2,in%dx1,in%dx2,t,0.d0,t3)
+
+           ! apply the 3d elastic transfert function
+           CALL greenfunctioncowling(v1,v2,v3,t1,t2,t3, &
+                in%dx1,in%dx2,in%dx3,in%lambda,in%mu,in%gam)
+           
+           ! transfer solution
+           CALL fieldadd(u1,v1,in%sx1+2,in%sx2,in%sx3/2)
+           CALL fieldadd(u2,v2,in%sx1+2,in%sx2,in%sx3/2)
+           CALL fieldadd(u3,v3,in%sx1+2,in%sx2,in%sx3/2)
+
+        END IF
+     END IF
+
+     CALL tensorfieldadd(sig,tau,in%sx1,in%sx2,in%sx3/2,c1=0._4,c2=-1._4)
+     CALL stressupdate(u1,u2,u3,in%lambda,in%mu, &
+                       in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,sig)
+
+     ! points are exported at all time steps
+     IF (ALLOCATED(in%ptsname)) THEN
+        CALL exportpoints(u1,u2,u3,sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+             in%opts,in%ptsname,t,in%wdir,.FALSE.,in%x0,in%y0,in%rot)
+     END IF
+
+     ! output only at discrete intervals (skip=0, odt>0),
+     ! or every "skip" computational steps (skip>0, odt<0),
+     ! or anytime a coseismic event occurs
+     IF (isoutput(in%skip,t,i,in%odt,oi,in%events(e)%time)) THEN
+        
+        CALL reporttime(1,t,in%reporttimefilename)
+
+        ! export
+#ifdef TXT
+        IF (in%isoutputtxt) THEN
+           CALL exporttxt(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx3,oi,t,in%wdir,in%reportfilename)
+        END IF
+#endif  
+#ifdef XYZ
+        IF (in%isoutputxyz) THEN
+           CALL exportxyz(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%oz,in%dx1,in%dx2,in%dx3,i,in%wdir)
+           IF (in%isoutputrelax) THEN
+              !CALL exportxyz(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2,0.0_8,in%dx1,in%dx2,in%dx3,i,in%wdir)
+           END IF
+        END IF
+#endif
+        CALL exporteigenstrain(gamma,in%nop,in%op,in%x0,in%y0,in%dx1,in%dx2,in%dx3,in%sx1,in%sx2,in%sx3/2,in%wdir,oi)
+#ifdef GRD
+        IF (in%isoutputgrd) THEN
+           IF (in%isoutputrelax) THEN
+              CALL exportgrd(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
+                             in%dx1,in%dx2,in%dx3,0._8,in%x0,in%y0,in%wdir,oi,convention=2)
+           END IF
+           CALL exportgrd(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0,in%wdir,oi)
+        END IF
+#endif
+#ifdef PROJ
+        IF (in%isoutputproj) THEN
+           IF (in%isoutputrelax) THEN
+              CALL exportproj(inter1,inter2,inter3,in%sx1,in%sx2,in%sx3/2, &
+                              in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0, &
+                              in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi,convention=2)
+           END IF
+           CALL exportproj(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,in%x0,in%y0, &
+                           in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi)
+        END IF
+#endif
+#ifdef VTK
+        IF (in%isoutputvtk) THEN
+           WRITE (digit,'(I3.3)') oi
+           ! export total displacement in VTK XML format
+           !filename=trim(in%wdir)//"/disp-"//digit//".vtr"
+           !CALL exportvtk_vectors(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
+           filename=trim(in%wdir)//"/disp-"//digit//".vtk"//char(0)
+           title="cumulative displacement vector field"//char(0)
+           name="displacement"//char(0)
+           CALL exportvtk_vectors_legacy(u1,u2,u3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
+                                         4,4,8,filename,title,name)
+           !CALL exportvtk_vectors_slice(u1,u2,u3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
+
+           ! export instantaneous velocity in VTK XML format
+           !filename=trim(in%wdir)//"/vel-"//digit//".vtr"
+           !CALL exportvtk_vectors(v1,v2,v3,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3,8,8,8,filename)
+           filename=trim(in%wdir)//"/vel-"//digit//".vtk"//char(0)
+           title="instantaneous velocity vector field"//char(0)
+           name="velocity"//char(0)
+           CALL exportvtk_vectors_legacy(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                                         8,8,16,filename,title,name)
+           !CALL exportvtk_vectors_slice(v1,v2,v3,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%oz,8,8,filename)
+        END IF
+        IF (in%isoutputvtkrelax) THEN
+           WRITE (digit,'(I3.3)') oi
+           filename=trim(in%wdir)//"/disp-relax-"//digit//".vtk"//char(0)
+           title="postseismic displacement vector field"//char(0)
+           name="displacement"//char(0)
+           CALL exportvtk_vectors_legacy(u1r,u2r,u3r,in%sx1,in%sx2,in%sx3/4,in%dx1,in%dx2,in%dx3, &
+                                         4,4,8,filename,title,name)
+        END IF
+#endif
+
+        ! export stress
+#ifdef GRD
+        IF (in%isoutputgrd .AND. in%isoutputstress) THEN
+           CALL exportstressgrd(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                                in%ozs,in%x0,in%y0,in%wdir,oi)
+        END IF
+#endif
+#ifdef PROJ
+        IF (in%isoutputproj .AND. in%isoutputstress) THEN
+           CALL exportstressproj(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3,in%ozs, &
+                                 in%x0,in%y0,in%lon0,in%lat0,in%zone,in%umult,in%wdir,oi)
+        END IF
+#endif
+        WRITE (digit4,'(I4.4)') oi
+#ifdef VTK
+        IF (in%isoutputvtk .AND. in%isoutputstress) THEN
+           filename=trim(in%wdir)//"/sigma-"//digit4//".vtk"//char(0)
+           title="stress tensor field"//char(0)
+           name="stress"//char(0)
+           CALL exportvtk_tensors_legacy(sig,in%sx1,in%sx2,in%sx3/2,in%dx1,in%dx2,in%dx3, &
+                                         4,4,8,filename,title,name)
+        END IF
+        filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".vtp"
+        CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                      in%nsop,in%sop,filename,sig=sig)
+        filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".vtp"
+        CALL exportvtk_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                      in%nsop,in%sop,filename,convention=1,sig=sig)
+#endif
+        ! total stress on predefined planes for gmt
+        filename=trim(in%wdir)//"/rfaults-sigma-"//digit4//".xy"
+        CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                      in%nsop,in%sop,filename,sig=sig)
+        ! postseismic stress change on predefined planes for gm
+        filename=trim(in%wdir)//"/rfaults-dsigma-"//digit4//".xy"
+        CALL exportgmt_rfaults_stress(in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                                      in%nsop,in%sop,filename,convention=1,sig=sig)
+        ! time series of stress in ASCII format
+        CALL exportcoulombstress(sig,in%sx1,in%sx2,in%sx3,in%dx1,in%dx2,in%dx3, &
+                          in%nsop,in%sop,t,in%wdir,.FALSE.)
+
+        PRINT 1101,i,Dt,maxwell,t,in%interval, &
+             tensoramplitude(moment,in%dx1,in%dx2,in%dx3), &
+             tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
+
+        ! update output counter
+        oi=oi+1
+     ELSE
+        PRINT 1100,i,Dt,maxwell,t,in%interval, &
+             tensoramplitude(moment,in%dx1,in%dx2,in%dx3), &
+             tensoramplitude(tau,in%dx1,in%dx2,in%dx3)
+     END IF
+
+  END DO
+
+100 CONTINUE
+
+  DO i=1,in%ne
+     IF (ALLOCATED(in%events(i)%s))  DEALLOCATE(in%events(i)%s,in%events(i)%sc)
+     IF (ALLOCATED(in%events(i)%ts)) DEALLOCATE(in%events(i)%ts,in%events(i)%tsc)
+  END DO
+  IF (ALLOCATED(in%events)) DEALLOCATE(in%events)
+
+  ! free memory
+  IF (ALLOCATED(gamma)) DEALLOCATE(gamma)
+  IF (ALLOCATED(in%opts)) DEALLOCATE(in%opts)
+  IF (ALLOCATED(in%ptsname)) DEALLOCATE(in%ptsname)
+  IF (ALLOCATED(in%op)) DEALLOCATE(in%op)
+  IF (ALLOCATED(in%sop)) DEALLOCATE(in%sop)
+  IF (ALLOCATED(in%n)) DEALLOCATE(in%n)
+  IF (ALLOCATED(in%stressstruc)) DEALLOCATE(in%stressstruc)
+  IF (ALLOCATED(in%stresslayer)) DEALLOCATE(in%stresslayer)
+  IF (ALLOCATED(in%linearstruc)) DEALLOCATE(in%linearstruc)
+  IF (ALLOCATED(in%linearlayer)) DEALLOCATE(in%linearlayer)
+  IF (ALLOCATED(in%linearweakzone)) DEALLOCATE(in%linearweakzone)
+  IF (ALLOCATED(in%nonlinearstruc)) DEALLOCATE(in%nonlinearstruc)
+  IF (ALLOCATED(in%nonlinearlayer)) DEALLOCATE(in%nonlinearlayer)
+  IF (ALLOCATED(in%nonlinearweakzone)) DEALLOCATE(in%nonlinearweakzone)
+  IF (ALLOCATED(in%faultcreepstruc)) DEALLOCATE(in%faultcreepstruc)
+  IF (ALLOCATED(in%faultcreeplayer)) DEALLOCATE(in%faultcreeplayer)
+  IF (ALLOCATED(sig)) DEALLOCATE(sig)
+  IF (ALLOCATED(tau)) DEALLOCATE(tau)
+  IF (ALLOCATED(moment)) DEALLOCATE(moment)
+  IF (ALLOCATED(in%stresslayer)) DEALLOCATE(in%stresslayer)
+  IF (ALLOCATED(in%linearlayer)) DEALLOCATE(in%linearlayer)
+  IF (ALLOCATED(in%nonlinearlayer)) DEALLOCATE(in%nonlinearlayer)
+  IF (ALLOCATED(in%faultcreeplayer)) DEALLOCATE(in%faultcreeplayer)
+  IF (ALLOCATED(v1)) DEALLOCATE(v1,v2,v3,t1,t2,t3)
+  IF (ALLOCATED(u1)) DEALLOCATE(u1,u2,u3)
+  IF (ALLOCATED(inter1)) DEALLOCATE(inter1,inter2,inter3)
+
+
+#ifdef FFTW3_THREADS
+  CALL sfftw_cleanup_threads()
+#endif
+
+0990 FORMAT (" I  |   Dt   | tm(ve) | tm(pl) | tm(as) |     t/tmax     | power  |  C:E^i | ")
+1000 FORMAT (I3.3,"*",ES9.2E2,"                            ",ES9.2E2,"/",ES7.2E1)
+1100 FORMAT (I3.3," ",ES9.2E2,3ES9.2E2,ES9.2E2,"/",ES7.2E1,2ES9.2E2)
+1101 FORMAT (I3.3,"*",ES9.2E2,3ES9.2E2,ES9.2E2,"/",ES7.2E1,2ES9.2E2)
+1200 FORMAT ("----------------------------------------------------------------------------")
+
+CONTAINS
+
+  !--------------------------------------------------------------------
+  !> subroutine dislocations
+  !! assigns equivalent body forces or moment density to simulate
+  !! shear dislocations and fault opening. add the corresponding moment
+  !! density in the cumulative relaxed moment so that fault slip does
+  !! not reverse in the postseismic time.
+  !--------------------------------------------------------------------
+  SUBROUTINE dislocations(event,lambda,mu,beta,sx1,sx2,sx3,dx1,dx2,dx3, &
+                          v1,v2,v3,t1,t2,t3,tau,factor,eigenstress)
+    TYPE(EVENT_STRUC), INTENT(IN) :: event
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: lambda,mu,beta,dx1,dx2,dx3
+    REAL*4, DIMENSION(:,:,:), INTENT(INOUT) :: v1,v2,v3
+    REAL*4, DIMENSION(:,:), INTENT(INOUT) :: t1,t2,t3
+    TYPE(TENSOR), DIMENSION(:,:,:), INTENT(INOUT) :: tau
+    REAL*8, INTENT(IN), OPTIONAL :: factor
+    TYPE(TENSOR), DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: eigenstress
+    
+    INTEGER :: i
+    REAL*8 :: slip_factor
+    
+    IF (PRESENT(factor)) THEN
+       slip_factor=factor
+    ELSE
+       slip_factor=1._8
+    END IF
+    
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    ! -             load shear dislocations
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    IF (.NOT. (PRESENT(eigenstress))) THEN
+       ! forcing term in equivalent body force
+       DO i=1,event%ns
+          ! adding sources in the space domain
+          CALL source(mu,slip_factor*event%s(i)%slip, &
+               event%s(i)%x,event%s(i)%y,event%s(i)%z, &
+               event%s(i)%width,event%s(i)%length, &
+               event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
+               event%s(i)%beta,sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3,t1,t2,t3)
+       END DO
+    ELSE
+       ! forcing term in moment density
+       DO i=1,event%ns
+          CALL momentdensityshear(mu,slip_factor*event%s(i)%slip, &
+               event%s(i)%x,event%s(i)%y,event%s(i)%z, &
+               event%s(i)%width,event%s(i)%length, &
+               event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
+               event%s(i)%beta,sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
+       END DO
+    END IF
+
+    DO i=1,event%ns
+       ! remove corresponding eigenmoment
+       CALL momentdensityshear(mu,slip_factor*event%s(i)%slip, &
+            event%s(i)%x,event%s(i)%y,event%s(i)%z, &
+            event%s(i)%width,event%s(i)%length, &
+            event%s(i)%strike,event%s(i)%dip,event%s(i)%rake, &
+            event%s(i)%beta,sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
+    END DO
+    
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    ! -             load tensile cracks
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    IF (.NOT. (PRESENT(eigenstress))) THEN
+       ! forcing term in equivalent body force
+       DO i=1,event%nt
+          ! adding sources in the space domain
+          CALL tensilesource(lambda,mu,slip_factor*event%ts(i)%slip, &
+               event%ts(i)%x,event%ts(i)%y,event%ts(i)%z, &
+               event%ts(i)%width,event%ts(i)%length, &
+               event%ts(i)%strike,event%ts(i)%dip, &
+               beta,sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3)
+       END DO
+    ELSE
+       ! forcing term in moment density
+       DO i=1,event%nt
+          CALL momentdensitytensile(lambda,mu,slip_factor*event%ts(i)%slip, &
+               event%ts(i)%x,event%ts(i)%y,event%ts(i)%z,&
+               event%ts(i)%width,event%ts(i)%length, &
+               event%ts(i)%strike,event%ts(i)%dip,event%ts(i)%rake, &
+               beta,sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
+       END DO
+    END IF
+
+    DO i=1,event%nt
+       ! removing corresponding eigenmoment
+       CALL momentdensitytensile(lambda,mu,slip_factor*event%ts(i)%slip, &
+            event%ts(i)%x,event%ts(i)%y,event%ts(i)%z,&
+            event%ts(i)%width,event%ts(i)%length, &
+            event%ts(i)%strike,event%ts(i)%dip,event%ts(i)%rake, &
+            beta,sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
+    END DO
+
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    ! -             load point dilatation sources
+    ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    IF (.NOT. (PRESENT(eigenstress))) THEN
+       ! forcing term in equivalent body force
+       DO i=1,event%nm
+          ! adding sources in the space domain
+          CALL mogisource(lambda,mu,slip_factor*event%m(i)%slip, &
+               event%m(i)%x,event%m(i)%y,event%m(i)%z, &
+               sx1,sx2,sx3,dx1,dx2,dx3,v1,v2,v3)
+       END DO
+    ELSE
+       ! forcing term in moment density
+       DO i=1,event%nm
+          CALL momentdensitymogi(lambda,mu,slip_factor*event%m(i)%slip, &
+               event%m(i)%x,event%m(i)%y,event%m(i)%z, &
+               sx1,sx2,sx3/2,dx1,dx2,dx3,eigenstress)
+       END DO
+    END IF
+
+    DO i=1,event%nm
+       ! remove corresponding eigenmoment
+       CALL momentdensitymogi(lambda,mu,slip_factor*event%m(i)%slip, &
+            event%m(i)%x,event%m(i)%y,event%m(i)%z, &
+            sx1,sx2,sx3/2,dx1,dx2,dx3,tau)
+    END DO
+    
+  END SUBROUTINE dislocations
+
+  !--------------------------------------------------------------------
+  !> function IsOutput
+  !! checks if output should be written based on user choices: if output
+  !! time interval (odt) is positive, output is written only if time
+  !! is an integer of odt. If odt is negative output is written at times
+  !! corresponding to internally chosen time steps.
+  !!
+  !! @return IsOutput is true only at discrete intervals (skip=0,odt>0),
+  !! or at every "skip" computational steps (skip>0,odt<0),
+  !! or anytime a coseismic event occurs
+  !
+  ! Sylvain Barbot (07/06/09) - original form
+  !--------------------------------------------------------------------
+  LOGICAL FUNCTION isoutput(skip,t,i,odt,oi,etime)
+    INTEGER, INTENT(IN) :: skip,i,oi
+    REAL*8, INTENT(IN) :: t,odt,etime
+
+    IF (((0 .EQ. skip) .AND. (abs(t-oi*odt) .LT. 1e-6*odt)) .OR. &
+        ((0 .LT. skip) .AND. (MOD(i-1,skip) .EQ. 0)) .OR. &
+         (abs(t-etime) .LT. 1e-6)) THEN
+       isoutput=.TRUE.
+    ELSE
+       isoutput=.FALSE.
+    END IF
+
+  END FUNCTION isoutput
+
+  !--------------------------------------------------------------------
+  !> subroutine IntegrationStep
+  !! find the time-integration forward step for the predictor-corrector
+  !! scheme.
+  !!
+  !! input file line
+  !!
+  !!    time interval, (positive dt step) or (negative skip and scaling)
+  !!
+  !! can be filled by either 1)
+  !!
+  !!   T, dt
+  !!
+  !! where T is the time interval of the simulation and dt is the
+  !! output time step, or 2)
+  !!
+  !!   T, -n, t_s
+  !!
+  !! where n indicates the number of computational steps before 
+  !! outputing results, t_s is a scaling applied to internally
+  !! computed time step.
+  !!
+  !! for case 1), an optimal time step is evaluated internally to
+  !! ensure stability (t_m/10) of time integration. The actual
+  !! time step Dt is chosen as
+  !!
+  !!    Dt = min( t_m/10, ((t%odt)+1)*odt-t )
+  !!
+  !! where t is the current time in the simulation. regardless of 
+  !! time step Dt, results are output if t is a multiple of dt.
+  !!
+  !! for case 2), the time step is chosen internally based on an 
+  !! estimate of the relaxation time (t_m/10). Results are output
+  !! every n steps. The actual time step is chosen as
+  !!
+  !!    Dt = min( t_m/10*t_s, t(next event)-t )
+  !!
+  !! where index is the number of computational steps after a coseismic
+  !! event and t(next event) is the time of the next coseismic event.
+  !!
+  !! \author sylvain barbot (01/01/08) - original form 
+  !--------------------------------------------------------------------
+  SUBROUTINE integrationstep(tm,Dt,t,oi,odt,skip,tscale,events,e,ne)
+    REAL*8, INTENT(INOUT) :: tm,Dt,odt
+    REAL*8, INTENT(IN) :: t,tscale
+    INTEGER, INTENT(IN) :: oi,e,ne,skip
+    TYPE(EVENT_STRUC), INTENT(IN), DIMENSION(:) :: events
+
+    ! output at optimal computational intervals
+    Dt=tm/10._8
+
+    ! reduce time in case something happens in [ t, t+Dt ]
+    IF (0 .EQ. skip) THEN
+       ! reduce time step so that t+Dt is time at next 
+       ! user-required output time
+       IF ((t+Dt) .GE. (dble(oi)*odt)-Dt*0.04d0) THEN
+          ! pick a smaller time step to reach :
+          ! integers of odt
+          Dt=dble(oi)*odt-t
+       END IF
+    ELSE
+       ! scale the estimate of optimal time step
+       Dt=Dt*tscale
+
+       ! reduce time step so that t+Dt is time to next event
+       IF (e .LT. ne) THEN
+          IF ((t+Dt-events(e+1)%time) .GE. 0._8) THEN
+             ! pick a smaller time step to reach 
+             ! next event time
+             Dt=events(e+1)%time-t
+          END IF
+       END IF
+    END IF
+
+  END SUBROUTINE integrationstep
+
+END PROGRAM relax
diff -r 405d8f4fa05f -r e7295294f654 src/types.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/types.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,217 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+#include "include.f90"
+
+MODULE types
+
+  TYPE SOURCE_STRUCT
+     SEQUENCE
+     REAL*8 :: slip,x,y,z,width,length,strike,dip,rake,period,phase,beta
+  END TYPE SOURCE_STRUCT
+
+  TYPE LAYER_STRUCT
+     SEQUENCE
+     REAL*8 :: z,gammadot0,stressexponent,cohesion,friction
+  END TYPE LAYER_STRUCT
+
+  TYPE WEAK_STRUCT
+     SEQUENCE
+     REAL*8 :: dgammadot0,x,y,z,width,length,thickness,strike,dip
+  END TYPE WEAK_STRUCT
+
+  TYPE VECTOR_STRUCT
+     SEQUENCE
+     REAL*8 :: v1,v2,v3
+  END TYPE VECTOR_STRUCT
+
+  TYPE TENSOR
+     SEQUENCE
+     REAL*4 :: s11,s12,s13,s22,s23,s33
+  END TYPE TENSOR
+
+  TYPE TENSOR_LAYER_STRUCT
+     SEQUENCE
+     REAL*4 :: z,dum
+     TYPE(TENSOR) :: t
+  END TYPE TENSOR_LAYER_STRUCT
+
+  TYPE SEGMENT_STRUCT
+     SEQUENCE
+     REAL*8 :: x,y,z,width,length,strike,dip,friction
+     TYPE(TENSOR) :: sig0
+  END TYPE SEGMENT_STRUCT
+
+  TYPE SLIPPATCH_STRUCT
+     SEQUENCE
+     ! absolute position
+     REAL*8 :: x1,x2,x3
+     ! relative position (strike and dip directions)
+     REAL*8 :: lx,lz
+     ! cumulative slip (total, strike and dip slip)
+     REAL*8 :: slip,ss,ds
+     ! instantaneous velocity
+     REAL*8 :: v,vss,vds
+     ! shear stress
+     REAL*8 :: taus
+     ! stress tensor
+     TYPE(TENSOR) :: sig
+  END TYPE SLIPPATCH_STRUCT
+
+  TYPE PLANE_STRUCT
+     SEQUENCE
+     REAL*8 :: x,y,z,width,length,strike,dip,rake
+     INTEGER :: px2,px3
+     TYPE(SLIPPATCH_STRUCT), DIMENSION(:,:), ALLOCATABLE :: patch
+  END TYPE PLANE_STRUCT
+
+  TYPE EVENT_STRUC
+     REAL*8 :: time
+     INTEGER*4 :: i,ns,nt,nm,nl
+     TYPE(SOURCE_STRUCT), DIMENSION(:), ALLOCATABLE :: s,sc,ts,tsc,m,mc,l,lc
+  END TYPE EVENT_STRUC
+  
+  TYPE, PUBLIC :: SIMULATION_STRUC
+     ! grid dimension
+     INTEGER :: sx1,sx2,sx3
+
+     ! sampling
+     REAL*8 :: dx1,dx2,dx3
+
+     ! smoothing factor
+     REAL*8 :: beta
+
+     ! filter parameter for slip models
+     REAL*8 :: nyquist
+
+     ! center coordinates and rotation
+     REAL*8 :: x0,y0,rot
+
+#ifdef PROJ
+     ! geographic coordinates of center, UTM zone, length unit
+     REAL*8 :: lon0,lat0,umult
+     INTEGER :: zone
+#endif
+
+     ! observation depths
+     REAL*8 :: oz,ozs
+
+     ! output directory
+     CHARACTER(80) :: wdir
+
+     ! filenames
+     CHARACTER(80) :: reportfilename,reporttimefilename
+
+     ! elastic moduli and gravity parameter
+     REAL*8 :: lambda,mu,gam
+
+     ! time step parameters
+     REAL*8 :: interval
+     REAL*8 :: odt,tscale
+     INTEGER :: skip=0
+
+     ! number of observation planes
+     INTEGER :: nop
+
+     ! observation planes
+     TYPE(PLANE_STRUCT), DIMENSION(:), ALLOCATABLE :: op
+
+     ! number of stress observation planes
+     INTEGER :: nsop
+
+     ! stress observation planes
+     TYPE(SEGMENT_STRUCT), DIMENSION(:), ALLOCATABLE :: sop
+
+     ! number of observation points
+     INTEGER :: npts
+
+     ! observation points
+     TYPE(VECTOR_STRUCT), DIMENSION(:), ALLOCATABLE :: opts
+
+     ! observation points name
+     CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: ptsname
+
+     ! number of prestress interfaces
+     INTEGER :: nps
+
+     ! stress layers and stress structure
+     TYPE(TENSOR_LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: stresslayer,stressstruc
+
+     ! number of linear viscous interfaces
+     INTEGER :: nv
+
+     ! linear viscous layers and structure
+     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: linearlayer,linearstruc
+
+     ! number of linear weak zones
+     INTEGER :: nlwz
+
+     ! linear weak zones
+     TYPE(WEAK_STRUCT), DIMENSION(:), ALLOCATABLE :: linearweakzone,linearweakzonec
+
+     ! number of nonlinear viscous interfaces
+     INTEGER :: npl
+
+     ! nonlinear viscous layers and structure
+     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: nonlinearlayer,nonlinearstruc
+
+     ! number of nonlinear weak zones
+     INTEGER :: nnlwz
+
+     ! nonlinear viscous layers and structure
+     TYPE(WEAK_STRUCT), DIMENSION(:), ALLOCATABLE :: nonlinearweakzone,nonlinearweakzonec
+
+     ! number of fault creep interfaces
+     INTEGER :: nfc
+
+     ! fault creep interfaces
+     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: faultcreeplayer,faultcreepstruc
+
+     ! number of afterslip planes
+     INTEGER :: np
+
+     ! afterslip planes
+     TYPE(PLANE_STRUCT), DIMENSION(:), ALLOCATABLE :: n
+
+     ! interseismic event
+     TYPE(EVENT_STRUC) :: inter
+
+     ! number of coseismic events
+     INTEGER :: ne
+
+     ! coseismic events
+     TYPE(EVENT_STRUC), DIMENSION(:), ALLOCATABLE :: events
+
+     ! overrides output to formats
+     LOGICAL :: isoutputproj=.TRUE.
+     LOGICAL :: isoutputrelax=.TRUE.
+     LOGICAL :: isoutputtxt=.TRUE.
+     LOGICAL :: isoutputvtk=.TRUE.
+     LOGICAL :: isoutputvtkrelax=.FALSE.
+     LOGICAL :: isoutputgrd=.TRUE.
+     LOGICAL :: isoutputxyz=.TRUE.
+     LOGICAL :: isoutputstress=.TRUE.
+
+     ! other options
+     LOGICAL :: isdryrun=.FALSE.
+     LOGICAL :: ishelp=.FALSE.
+
+  END TYPE SIMULATION_STRUC
+
+END MODULE types
diff -r 405d8f4fa05f -r e7295294f654 src/viscoelastic3d.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/viscoelastic3d.f90	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,288 @@
+!-----------------------------------------------------------------------
+! Copyright 2007, 2008, 2009 Sylvain Barbot
+!
+! This file is part of RELAX
+!
+! RELAX is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! RELAX is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
+!-----------------------------------------------------------------------
+
+MODULE viscoelastic3d
+
+  USE elastic3d
+
+  IMPLICIT NONE
+
+#include "include.f90"
+
+  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
+  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
+  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
+    
+CONTAINS
+
+  !-----------------------------------------------------------------
+  !> subroutine ViscoElasticDeviatoricStress
+  !! computes the instantaneous deviatoric stress tensor sigma_ij'
+  !!
+  !!  sigma_ij' = 2*mu*(-delta_ij epsilon_kk/3 + epsilon_ij) - tau_ij 
+  !!
+  !! such as
+  !! 
+  !!  sigma_kk'= 0
+  !!
+  !! where tau_ij is a second-order deviatoric symmetric tensor 
+  !! that integrates the history of the relaxed stress. strain is
+  !! estimated using a centered finite difference derivative.
+  !!
+  !! \author sylvain barbot (07/07/07) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE viscoelasticdeviatoricstress(mu,u1,u2,u3,tau,&
+       dx1,dx2,dx3,sx1,sx2,sx3,sig)
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3
+    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
+    TYPE(TENSOR), INTENT(IN),  DIMENSION(:,:,:) :: tau
+    TYPE(TENSOR), INTENT(OUT), DIMENSION(:,:,:) :: sig
+    
+    TYPE(TENSOR) :: s
+    INTEGER :: i1,i2,i3,i1p,i2p,i3p,i1m,i2m,i3m
+    REAL*8 :: epskk,px1,px2,px3
+
+    px1=dx1*2._8
+    px2=dx2*2._8
+    px3=dx3*2._8
+    
+    ! space domain with finite difference scheme
+    DO i3=1,sx3
+       ! wrap around neighbor
+       i3m=mod(sx3+i3-2,sx3)+1
+       i3p=mod(i3,sx3)+1
+       DO i2=1,sx2
+          i2m=mod(sx2+i2-2,sx2)+1
+          i2p=mod(i2,sx2)+1
+          
+          DO i1=1,sx1
+             i1m=mod(sx1+i1-2,sx1)+1
+             i1p=mod(i1,sx1)+1
+             
+             ! trace component
+             epskk=((u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1+&
+                    (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2+&
+                    (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3)/3._8
+             
+             s%s11=2._8*mu*( (u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1-epskk )
+             s%s12=     mu*( (u1(i1,i2p,i3)-u1(i1,i2m,i3))/px2+ &
+                             (u2(i1p,i2,i3)-u2(i1m,i2,i3))/px1)
+             s%s13=     mu*( (u1(i1,i2,i3p)-u1(i1,i2,i3m))/px3+ &
+                             (u3(i1p,i2,i3)-u3(i1m,i2,i3))/px1)
+             s%s22=2._8*mu*( (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2-epskk )
+             s%s23=     mu*( (u2(i1,i2,i3p)-u2(i1,i2,i3m))/px3+ &
+                             (u3(i1,i2p,i3)-u3(i1,i2m,i3))/px2)
+             s%s33=2._8*mu*( (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3-epskk )
+             
+             sig(i1,i2,i3)= s .minus. tau(i1,i2,i3)
+             
+          END DO
+       END DO
+    END DO
+    
+    ! no normal traction at the boundary
+    sig(:,:,1)%s13=0
+    sig(:,:,1)%s23=0
+    sig(:,:,1)%s33=0
+    sig(:,:,sx3)%s13=0
+    sig(:,:,sx3)%s23=0
+    sig(:,:,sx3)%s33=0
+
+  END SUBROUTINE viscoelasticdeviatoricstress
+
+  !-----------------------------------------------------------------
+  !> subroutine ViscousEigenstress
+  !! computes the moment density rate due to a layered viscoelastic
+  !! structure with powerlaw creep
+  !!
+  !!     d Ei / dt = C:F:sigma'
+  !!
+  !! where C is the elastic moduli tensor, F is the heterogeneous
+  !! fluidity tensor and sigma' is the instantaneous deviatoric 
+  !! stress. F is stress dependent (powerlaw creep.)
+  !!
+  !! \author sylvain barbot (08/30/08) - original form
+  !-----------------------------------------------------------------
+  SUBROUTINE viscouseigenstress(mu,structure,ductilezones,nz,sig,sx1,sx2,sx3, &
+       dx1,dx2,dx3,moment,beta,maxwelltime,gamma)
+    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3,beta
+    INTEGER, INTENT(IN) :: nz
+    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
+    TYPE(WEAK_STRUCT), DIMENSION(nz), INTENT(IN) :: ductilezones
+    INTEGER, INTENT(IN) :: sx1,sx2,sx3
+    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
+    TYPE(TENSOR), INTENT(OUT), DIMENSION(sx1,sx2,sx3) :: moment
+    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
+#ifdef ALIGN_DATA
+    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(OUT), OPTIONAL :: gamma
+#else
+    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(OUT), OPTIONAL :: gamma
+#endif
+
+    INTEGER :: i1,i2,i3
+    TYPE(TENSOR) :: s,R
+    TYPE(TENSOR), PARAMETER :: zero = tensor(0._4,0._4,0._4,0._4,0._4,0._4)
+    REAL*8 :: gammadot,tau,tauc,gammadot0,power,cohesion,x1,x2,x3,dg0,dum
+    REAL*4 :: tm
+    
+    IF (SIZE(structure,1) .NE. sx3) RETURN
+
+    IF (PRESENT(maxwelltime)) THEN
+       tm=REAL(maxwelltime)
+    ELSE
+       tm=1e30
+    END IF
+
+!$omp parallel do private(i1,i2,gammadot0,power,cohesion,s,tau,R,tauc,gammadot,dg0,x1,x2,x3,dum), &
+!$omp reduction(MIN:tm)
+    DO i3=1,sx3
+       power=structure(i3)%stressexponent
+       cohesion=structure(i3)%cohesion
+       x3=DBLE(i3-1)*dx3
+
+       IF (power .LT. 0.999999_8) THEN 
+          WRITE_DEBUG_INFO
+          WRITE (0,'("power=",ES9.2E1)') power
+          WRITE (0,'("invalid power exponent. interrupting.")')
+          STOP 1
+       END IF
+
+       DO i2=1,sx2
+          DO i1=1,sx1
+             ! local coordinates
+             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
+                  dx1,dx2,dx3,x1,x2,dum)
+
+             ! depth-dependent fluidity structure             
+             gammadot0=structure(i3)%gammadot0
+
+             ! perturbation from isolated viscous zones
+             dg0=dgammadot0(ductilezones,nz,x1,x2,x3,beta)
+
+             ! local fluidity structure
+             gammadot0=gammadot0+dg0
+
+             IF (1.0d-20 .GT. gammadot0) CYCLE
+
+             ! local deviatoric stress
+             s=tensordeviatoric(sig(i1,i2,i3))
+             
+             ! s = tau * R
+             CALL tensordecomposition(s,tau,R)
+
+             ! effective stress
+             tauc=tau-cohesion
+
+             ! cohesion test
+             IF (tauc .LE. 1.0d-20) CYCLE
+
+             ! powerlaw viscosity
+             gammadot=gammadot0*(tauc/mu)**power
+
+             ! update moment density forcing
+             moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
+                  (REAL(2._8*mu*gammadot) .times. R)
+
+             tm=MIN(tm,tauc/mu/gammadot)
+
+             IF (PRESENT(gamma)) &
+                  gamma(i1,i2,i3)=gammadot
+             
+          END DO
+       END DO
+    END DO
+!$omp end parallel do
+
+    IF (PRESENT(maxwelltime)) maxwelltime=MIN(tm,maxwelltime)
+
+  CONTAINS
+
+    !---------------------------------------------------------
+    !> function dgammadot0
+    !! evaluates the change of fluidity at position x1,x2,x3
+    !! due to the presence of weak ductile zones. the extent
+    !! and magnitude of ductile zones is tapered (beta).
+    !!
+    !! \author sylvain barbot (3/29/10) - original form
+    !---------------------------------------------------------
+    REAL*8 FUNCTION dgammadot0(zones,n,x1,x2,x3,beta)
+       INTEGER, INTENT(IN) :: n
+       TYPE(WEAK_STRUCT), INTENT(IN), DIMENSION(nz) :: zones
+       REAL*8, INTENT(IN) :: x1,x2,x3,beta
+
+       REAL*8 :: dg,x,y,z,L,W,D,strike,dip,LM
+       REAL*8 :: cstrike,sstrike,cdip,sdip, &
+                 xr,yr,zr,x2r,Wp,Lp,Dp,x1s,x2s,x3s
+       INTEGER :: i
+
+       ! default is no change in fluidity
+       dgammadot0=0._8
+
+       DO i=1,n
+          ! retrieve weak zone geometry
+          dg=zones(i)%dgammadot0
+
+          x=zones(i)%x
+          y=zones(i)%y
+          z=zones(i)%z
+          W=zones(i)%length
+          L=zones(i)%width
+          D=zones(i)%thickness
+          strike=zones(i)%strike
+          dip=zones(i)%dip
+
+          ! effective tapered dimensions
+          Wp=W*(1._8+2._8*beta)/2._8
+          Lp=L*(1._8+2._8*beta)/2._8
+          Dp=D*(1._8+2._8*beta)/2._8
+          LM=MAX(Wp,Lp,Dp)
+
+          ! check distance from weak zone
+          IF ((ABS(x3-z).GT.LM) .OR. &
+              (ABS(x1-x).GT.LM) .OR. &
+              (ABS(x2-y).GT.LM)) CYCLE
+
+          ! evaluate contribution from weak zone
+          cstrike=cos(strike)
+          sstrike=sin(strike)
+          cdip=cos(dip)
+          sdip=sin(dip)
+
+          ! rotate centre coordinates of weak zone
+          x2r= cstrike*x  -sstrike*y
+          xr = cdip   *x2r-sdip   *z
+          yr = sstrike*x  +cstrike*y
+          zr = sdip   *x2r+cdip   *z
+
+          x2r= cstrike*x1 -sstrike*x2
+          x1s= cdip   *x2r-sdip   *x3
+          x2s= sstrike*x1 +cstrike*x2
+          x3s= sdip   *x2r+cdip   *x3
+
+          dgammadot0=dgammadot0+omega((x1s-xr)/D,beta) &
+                               *omega((x2s-yr)/W,beta) &
+                               *omega((x3s-zr)/L,beta)*dg
+       END DO
+
+    END FUNCTION dgammadot0
+
+  END SUBROUTINE viscouseigenstress
+
+END MODULE viscoelastic3d
diff -r 405d8f4fa05f -r e7295294f654 src/writegrd3.4.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/writegrd3.4.c	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,87 @@
+# include <gmt.h>
+
+/* Fortran callable routine to write a grd file in pixel registration */
+/* June 23, 1995 - David Sandwell */
+/* Revised for GMT3.4 December 28, 2002 - David Sandwell */
+/* Modified for node registration - March 19, 2008 - Sylvain Barbot */
+
+void writegrd(rdat,nx,ny,rlt0,rln0,dlt,dln,rland,rdum,title,fileout)
+
+  float *rdat;            /* real array for output */
+  int *nx;                /* number of x points */
+  int *ny;                /* number of y points */
+  double *rlt0;            /* starting latitude */
+  double *rln0;            /* starting longitude */
+  double *dlt;             /* latitude spacing */
+  double *dln;             /* longitude spacing */
+  double *rland;            /* land value */
+  double *rdum;            /* dummy value */
+  char  *title;           /* title */
+  char  *fileout;         /* filename of output file */
+  
+  {
+   int i;
+   double xmin, xmax, xinc, ymin, ymax, yinc, zmin, zmax;
+   int update = FALSE;
+   struct GRD_HEADER grd;
+   int argc = 0;
+   char **argv = NULL;
+
+/* Initialize with default values */
+ 
+   GMT_grdio_init(); 
+   GMT_make_dnan(GMT_d_NaN);
+   GMT_make_fnan(GMT_f_NaN);
+   
+   GMT_grd_init(&grd, argc, argv, update);
+
+/* Calculate header parameters */
+   xmax = *rln0 + ((*nx)-1) * *dln;
+   xmin = *rln0;
+   if(xmax < xmin) {
+     xmin = xmax;
+     xmax = *rln0;
+     }
+   xinc = fabs((double)*dln);
+
+   ymax = *rlt0 + ((*ny)-1) * *dlt;
+   ymin = *rlt0;
+   if(ymax < ymin) {
+     ymin = ymax;
+     ymax = *rlt0;
+     }
+   yinc = fabs((double)*dlt);
+
+
+/*  calculate zmin and zmax and zinc and set dummy values to NaN. */
+
+   zmin = fabs((double)*rdum);
+   zmax = -fabs((double)*rdum);
+
+   for (i = 0; i < *nx * *ny; i++) {
+     if((rdat[i] == *rdum) || (rdat[i] == *rland)) rdat[i] = GMT_f_NaN;
+     else {
+        if(rdat[i] < zmin) zmin = rdat[i];
+        if(rdat[i] > zmax) zmax = rdat[i];
+     }
+   }
+
+/* update the header using values passed */
+
+   strncpy(grd.title,title,80); 
+   grd.nx = *nx;
+   grd.ny = *ny;
+   grd.node_offset = FALSE;
+   grd.x_min = xmin;
+   grd.x_max = xmax;
+   grd.x_inc = xinc;
+   grd.y_min = ymin;
+   grd.y_max = ymax;
+   grd.y_inc = yinc;
+   grd.z_min = zmin;
+   grd.z_max = zmax;
+
+/*  write the file */
+   GMT_write_grd(fileout, &grd, rdat, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE );
+   
+  }
diff -r 405d8f4fa05f -r e7295294f654 src/writegrd4.2.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/writegrd4.2.c	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,100 @@
+/************************************************************************
+* writegrd routine to write a grd file in pixel registration            *
+************************************************************************/
+/************************************************************************
+* Creator: David T. Sandwell    Scripps Institution of Oceanography    *
+* Date   : 06/23/95             Copyright, David T. Sandwell           *
+************************************************************************/
+/************************************************************************
+* Modification history:                                                 *
+*   Revised for GMT3.4 December 28, 2002 - David Sandwell               *
+*   Revised for GMT4.2 May 10, 2007 - David Sandwell                    *
+*   Modified for pixel registration April 18, 2008 - Sylvain Barbot     *
+************************************************************************/
+
+# include <math.h>
+# include <gmt.h>
+
+void writegrd_(rdat,nx,ny,rlt0,rln0,dlt,dln,rland,rdum,title,fileout)
+
+  float *rdat;            /* real array for output */
+  int *nx;                /* number of x points */
+  int *ny;                /* number of y points */
+  double *rlt0;            /* starting latitude */
+  double *rln0;            /* starting longitude */
+  double *dlt;             /* latitude spacing */
+  double *dln;             /* longitude spacing */
+  double *rland;           /* land value */
+  double *rdum;            /* dummy value */
+  char  *title;           /* title */
+  char  *fileout;         /* filename of output file */
+  
+  {
+   int i;
+   double xmin, xmax, xinc, ymin, ymax, yinc, zmin, zmax;
+   struct GRD_HEADER grd;
+   int argc2 = 1;
+   char *argv2[2] = {"writegrd",0};
+
+/* Initialize with default values */
+ 
+   GMT_begin (argc2,argv2);
+   GMT_grd_init(&grd, argc2, argv2, FALSE);
+
+/* Calculate header parameters */
+
+   xmax = *rln0 + ((*nx)-1) * *dln;
+   xmin = *rln0;
+   if(xmax < xmin) {
+     xmin = xmax;
+     xmax = *rln0;
+     }
+   xinc = fabs((double)*dln);
+   ymax = *rlt0 + ((*ny)-1) * *dlt;
+   ymin = *rlt0;
+   if(ymax < ymin) {
+     ymin = ymax;
+     ymax = *rlt0;
+     }
+   yinc = fabs((double)*dlt);
+
+/*  calculate zmin and zmax and zinc and set dummy values to NaN. */
+
+   zmin = +fabs((double)*rdum);
+   zmax = -fabs((double)*rdum);
+
+   for (i = 0; i < *nx * *ny; i++) {
+     if((rdat[i] == *rdum) || (rdat[i] == *rland)) rdat[i] = GMT_f_NaN;
+     else {
+        if(rdat[i] < zmin) zmin = rdat[i];
+        if(rdat[i] > zmax) zmax = rdat[i];
+     }
+   }
+
+/* update the header using values passed */
+
+   strncpy(grd.title,title,GRD_TITLE_LEN); 
+   grd.nx = *nx;
+   grd.ny = *ny;
+   grd.node_offset = FALSE;
+   grd.x_min = xmin;
+   grd.x_max = xmax;
+   grd.x_inc = xinc;
+   grd.y_min = ymin;
+   grd.y_max = ymax;
+   grd.y_inc = yinc;
+   grd.z_min = zmin;
+   grd.z_max = zmax;
+
+/* grd.type = 10;
+   grd.z_id = 15;
+   grd.ncid = 15;*/
+
+/*  write the file */
+
+   GMT_write_grd(fileout, &grd, rdat, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE);
+
+/*   GMT_end (argc2,argv2); */
+
+  }
+
diff -r 405d8f4fa05f -r e7295294f654 src/writevtk.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/writevtk.c	Sun Apr 01 14:02:51 2012 -0700
@@ -0,0 +1,226 @@
+/*************************************************************
+*  export vectors and tensors in big-endian mixed ascii/binary
+*  vtk format for Paraview.
+*
+*  sylvain barbot 10/27/11 - original form
+*************************************************************/
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "config.h"
+
+// check data alignment
+#ifdef FFTW3
+#define ALIGN_DATA 1
+#else
+#ifdef SGI_FFT
+#define ALIGN_DATA 1
+#else
+#ifdef IMKL_FFT
+#define ALIGN_DATA 1
+#endif
+#endif
+#endif
+
+int fix(int n){
+  if(n<0) return n-1;return n+1;
+}
+
+float swap(float d){ 
+	float a; 
+	unsigned char *dst = (unsigned char *)&a; 
+	unsigned char *src = (unsigned char *)&d; 
+	dst[0] = src[3];
+	dst[1] = src[2];
+	dst[2] = src[1];
+	dst[3] = src[0]; 
+	return a; 
+} 
+
+// test endianness of the machine
+unsigned char isbigendian(){
+
+  typedef union{
+        int i;
+        char c[4];
+  } u;
+  u temp;
+
+  temp.i = 0x12345678;
+  
+  switch(temp.c[0]) {
+     case 0x12:
+        return 1u; // big endian
+     case 0x78:
+        return 0u; // little endian
+     default:
+        fprintf(stderr,"invalid result for endianness test.\n");
+        fprintf(stderr,"temp %x %x %x %x.\n",temp.c[0],temp.c[1],temp.c[2],temp.c[3]);
+        fprintf(stderr,"temp %x \n",temp.c[0]);
+        return 2u;
+  }
+}
+
+/*************************************************************
+*  subroutine ExportVTK_Vectors_Legacy
+*  creates a .vtk file in the VTK Legacy binary format with 
+*  structured points containing a vector field.
+*
+*  sylvain barbot 10/27/11 - original form
+*************************************************************/
+void exportvtk_vectors_legacy_(u1,u2,u3,sx1,sx2,sx3,dx1,dx2,dx3,j1,j2,j3,filename,title,name)
+  float *u1, *u2, *u3;    /* data array for output */
+  int *sx1, *sx2, *sx3;   /* number of points      */
+  double*dx1, *dx2, *dx3; /* sampling distance     */ 
+  int *j1, *j2, *j3;      /* subsampling rate      */
+  char *filename;         /* output file name      */
+  char *title;            /* output file name      */
+  char *name;             /* output file name      */
+{
+
+  FILE * funit;
+  float buffer[3];
+  int i1,i2,k1,k2,k3,index;
+  unsigned char endian;
+
+  funit=fopen(filename,"wb");
+  if (NULL==funit){
+     fprintf(stderr,"could not open file %s for vtk output\n",filename);
+     fprintf(stderr,"exiting.\n");
+     return;
+  }
+
+  // find endianness
+  endian=isbigendian();
+
+  // writing header of file
+  fprintf(funit,"# vtk DataFile Version 3.0\n");
+  fprintf(funit,"%s\n",title);
+  fprintf(funit,"BINARY\n");
+  fprintf(funit,"DATASET STRUCTURED_POINTS\n");
+
+  // structured points grid
+  fprintf(funit,"DIMENSIONS %i %i %i\n",(*sx1)/(*j1),(*sx2)/(*j2),(*sx3)/(*j3)); 
+  fprintf(funit,"ORIGIN %f %f %f\n",-(*dx1)*((*sx1)/2),-(*dx2)*((*sx2)/2),0.0); 
+  fprintf(funit,"SPACING %f %f %f\n",(*dx1)*(*j1),(*dx2)*(*j2),(*dx3)*(*j3)); 
+
+  // data header for this grid
+  fprintf(funit,"POINT_DATA %i\n",((*sx1)/(*j1))*((*sx2)/(*j2))*((*sx3)/(*j3)));
+
+  // data array
+  fprintf(funit,"VECTORS %s float\n",name);
+
+  // data values
+  for (k3=0; k3<(*sx3); k3=k3+(*j3)){
+     for (k2=-(*sx2)/2; k2<(*sx2)/2; k2=k2+(*j2)){
+        i2=((*sx2)+fix(k2)) % (*sx2);
+
+        for (k1=-(*sx1)/2; k1<(*sx1)/2; k1+=(*j1)){
+           i1=((*sx1)+fix(k1)) % (*sx1);
+
+#ifdef ALIGN_DATA
+           index=i1+(i2+k3*(*sx2))*((*sx1)+2);
+#else
+           index=i1+(i2+k3*(*sx2))*(*sx1);
+#endif
+
+           // convert to big endian if necessary
+           buffer[0]=(1u==endian)?u1[index]:swap(u1[index]);
+           buffer[1]=(1u==endian)?u2[index]:swap(u2[index]);
+           buffer[2]=(1u==endian)?u3[index]:swap(u3[index]);
+
+           fwrite(buffer,12,1,funit);
+        }
+     }
+  }
+
+  // close binary file
+  fclose(funit);
+
+}
+
+
+/*************************************************************
+*  subroutine ExportVTK_tensors_Legacy
+*  creates a .vtk file in the VTK Legacy binary format with 
+*  structured points containing a vector field.
+*
+*  sylvain barbot 10/28/11 - original form
+*************************************************************/
+void exportvtk_tensors_legacy_(sig,sx1,sx2,sx3,dx1,dx2,dx3,j1,j2,j3,filename,title,name)
+  float *sig;             /* data array for tensor output */
+  int *sx1, *sx2, *sx3;   /* number of points             */
+  double*dx1, *dx2, *dx3; /* sampling distance            */ 
+  int *j1, *j2, *j3;      /* subsampling rate             */
+  char *filename;         /* output file name             */
+  char *title;            /* output file name             */
+  char *name;             /* output file name             */
+{
+
+  FILE * funit;
+  float buffer[9];
+  int i1,i2,k1,k2,k3,index;
+  unsigned char endian;
+#define DOF 6
+
+  funit=fopen(filename,"wb");
+  if (NULL==funit){
+     fprintf(stderr,"could not open file %s for vtk output\n",filename);
+     fprintf(stderr,"exiting.\n");
+     return;
+  }
+
+  // find endianness
+  endian=isbigendian();
+
+  // writing header of file
+  fprintf(funit,"# vtk DataFile Version 3.0\n");
+  fprintf(funit,"%s\n",title);
+  fprintf(funit,"BINARY\n");
+  fprintf(funit,"DATASET STRUCTURED_POINTS\n");
+
+  // structured points grid
+  fprintf(funit,"DIMENSIONS %i %i %i\n",(*sx1)/(*j1),(*sx2)/(*j2),(*sx3)/(*j3)); 
+  fprintf(funit,"ORIGIN %f %f %f\n",-(*dx1)*((*sx1)/2),-(*dx2)*((*sx2)/2),0.0); 
+  fprintf(funit,"SPACING %f %f %f\n",(*dx1)*(*j1),(*dx2)*(*j2),(*dx3)*(*j3)); 
+
+  // data header for this grid
+  fprintf(funit,"POINT_DATA %i\n",((*sx1)/(*j1))*((*sx2)/(*j2))*((*sx3)/(*j3)));
+
+  // data array
+  fprintf(funit,"TENSORS %s float\n",name);
+
+  // data values
+  for (k3=0; k3<(*sx3); k3=k3+(*j3)){
+     for (k2=-(*sx2)/2; k2<(*sx2)/2; k2=k2+(*j2)){
+        i2=((*sx2)+fix(k2)) % (*sx2);
+
+        for (k1=-(*sx1)/2; k1<(*sx1)/2; k1+=(*j1)){
+           i1=((*sx1)+fix(k1)) % (*sx1);
+
+           // index of first stress component
+           index=(i1+(i2+k3*(*sx2))*(*sx1))*DOF;
+
+           // convert to big endian if necessary
+           buffer[0]=(1u==endian)?sig[index+0]:swap(sig[index+0]);
+           buffer[1]=(1u==endian)?sig[index+1]:swap(sig[index+1]);
+           buffer[2]=(1u==endian)?sig[index+2]:swap(sig[index+2]);
+           buffer[3]=(1u==endian)?sig[index+1]:swap(sig[index+1]);
+           buffer[4]=(1u==endian)?sig[index+3]:swap(sig[index+3]);
+           buffer[5]=(1u==endian)?sig[index+4]:swap(sig[index+4]);
+           buffer[6]=(1u==endian)?sig[index+2]:swap(sig[index+2]);
+           buffer[7]=(1u==endian)?sig[index+4]:swap(sig[index+4]);
+           buffer[8]=(1u==endian)?sig[index+5]:swap(sig[index+5]);
+
+           // write buffer to disk
+           fwrite(buffer,36,1,funit);
+        }
+     }
+  }
+
+  // close binary file
+  fclose(funit);
+
+}
+
diff -r 405d8f4fa05f -r e7295294f654 types.f90
--- a/types.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,205 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-#include "include.f90"
-
-MODULE types
-
-  TYPE SOURCE_STRUCT
-     SEQUENCE
-     REAL*8 :: slip,x,y,z,width,length,strike,dip,rake,period,phase,beta
-  END TYPE SOURCE_STRUCT
-
-  TYPE PLANE_STRUCT
-     SEQUENCE
-     REAL*8 :: x,y,z,width,length,strike,dip,rake
-  END TYPE PLANE_STRUCT
-
-  TYPE LAYER_STRUCT
-     SEQUENCE
-     REAL*8 :: z,gammadot0,stressexponent,cohesion,friction
-  END TYPE LAYER_STRUCT
-
-  TYPE WEAK_STRUCT
-     SEQUENCE
-     REAL*8 :: dgammadot0,x,y,z,width,length,thickness,strike,dip
-  END TYPE WEAK_STRUCT
-
-  TYPE VECTOR_STRUCT
-     SEQUENCE
-     REAL*8 :: v1,v2,v3
-  END TYPE VECTOR_STRUCT
-
-  TYPE TENSOR
-     SEQUENCE
-     REAL*4 :: s11,s12,s13,s22,s23,s33
-  END TYPE TENSOR
-
-  TYPE TENSOR_LAYER_STRUCT
-     SEQUENCE
-     REAL*4 :: z,dum
-     TYPE(TENSOR) :: t
-  END TYPE TENSOR_LAYER_STRUCT
-
-  TYPE SEGMENT_STRUCT
-     SEQUENCE
-     REAL*8 :: x,y,z,width,length,strike,dip,friction
-     TYPE(TENSOR) :: sig0
-  END TYPE SEGMENT_STRUCT
-
-  TYPE SLIPPATCH_STRUCT
-     SEQUENCE
-     REAL*8 :: x1,x2,x3,lx,lz,slip,ss,ds
-     TYPE(TENSOR) :: sig
-  END TYPE SLIPPATCH_STRUCT
-
-  TYPE EVENT_STRUC
-     REAL*8 :: time
-     INTEGER*4 :: i,ns,nt,nm,nl
-     TYPE(SOURCE_STRUCT), DIMENSION(:), ALLOCATABLE :: s,sc,ts,tsc,m,mc,l,lc
-  END TYPE EVENT_STRUC
-  
-  TYPE, PUBLIC :: SIMULATION_STRUC
-     ! grid dimension
-     INTEGER :: sx1,sx2,sx3
-
-     ! sampling
-     REAL*8 :: dx1,dx2,dx3
-
-     ! smoothing factor
-     REAL*8 :: beta
-
-     ! filter parameter for slip models
-     REAL*8 :: nyquist
-
-     ! center coordinates and rotation
-     REAL*8 :: x0,y0,rot
-
-#ifdef PROJ
-     ! geographic coordinates of center, UTM zone, length unit
-     REAL*8 :: lon0,lat0,umult
-     INTEGER :: zone
-#endif
-
-     ! observation depths
-     REAL*8 :: oz,ozs
-
-     ! output directory
-     CHARACTER(80) :: wdir
-
-     ! filenames
-     CHARACTER(80) :: reportfilename,reporttimefilename
-
-     ! elastic moduli and gravity parameter
-     REAL*8 :: lambda,mu,gam
-
-     ! time step parameters
-     REAL*8 :: interval
-     REAL*8 :: odt,tscale
-     INTEGER :: skip=0
-
-     ! number of observation planes
-     INTEGER :: nop
-
-     ! observation planes
-     TYPE(PLANE_STRUCT), DIMENSION(:), ALLOCATABLE :: op
-
-     ! number of stress observation planes
-     INTEGER :: nsop
-
-     ! stress observation planes
-     TYPE(SEGMENT_STRUCT), DIMENSION(:), ALLOCATABLE :: sop
-
-     ! number of observation points
-     INTEGER :: npts
-
-     ! observation points
-     TYPE(VECTOR_STRUCT), DIMENSION(:), ALLOCATABLE :: opts
-
-     ! observation points name
-     CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: ptsname
-
-     ! number of prestress interfaces
-     INTEGER :: nps
-
-     ! stress layers and stress structure
-     TYPE(TENSOR_LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: stresslayer,stressstruc
-
-     ! number of linear viscous interfaces
-     INTEGER :: nv
-
-     ! linear viscous layers and structure
-     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: linearlayer,linearstruc
-
-     ! number of linear weak zones
-     INTEGER :: nlwz
-
-     ! linear weak zones
-     TYPE(WEAK_STRUCT), DIMENSION(:), ALLOCATABLE :: linearweakzone,linearweakzonec
-
-     ! number of nonlinear viscous interfaces
-     INTEGER :: npl
-
-     ! nonlinear viscous layers and structure
-     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: nonlinearlayer,nonlinearstruc
-
-     ! number of nonlinear weak zones
-     INTEGER :: nnlwz
-
-     ! nonlinear viscous layers and structure
-     TYPE(WEAK_STRUCT), DIMENSION(:), ALLOCATABLE :: nonlinearweakzone,nonlinearweakzonec
-
-     ! number of fault creep interfaces
-     INTEGER :: nfc
-
-     ! fault creep interfaces
-     TYPE(LAYER_STRUCT), DIMENSION(:), ALLOCATABLE :: faultcreeplayer,faultcreepstruc
-
-     ! number of afterslip planes
-     INTEGER :: np
-
-     ! afterslip planes
-     TYPE(PLANE_STRUCT), DIMENSION(:), ALLOCATABLE :: n
-
-     ! interseismic event
-     TYPE(EVENT_STRUC) :: inter
-
-     ! number of coseismic events
-     INTEGER :: ne
-
-     ! coseismic events
-     TYPE(EVENT_STRUC), DIMENSION(:), ALLOCATABLE :: events
-
-     ! overrides output to formats
-     LOGICAL :: isoutputproj=.TRUE.
-     LOGICAL :: isoutputrelax=.TRUE.
-     LOGICAL :: isoutputtxt=.TRUE.
-     LOGICAL :: isoutputvtk=.TRUE.
-     LOGICAL :: isoutputvtkrelax=.FALSE.
-     LOGICAL :: isoutputgrd=.TRUE.
-     LOGICAL :: isoutputxyz=.TRUE.
-     LOGICAL :: isoutputstress=.TRUE.
-
-     ! other options
-     LOGICAL :: isdryrun=.FALSE.
-     LOGICAL :: ishelp=.FALSE.
-
-  END TYPE SIMULATION_STRUC
-
-END MODULE types
diff -r 405d8f4fa05f -r e7295294f654 viscoelastic3d.f90
--- a/viscoelastic3d.f90	Thu Mar 29 15:55:33 2012 -0700
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,288 +0,0 @@
-!-----------------------------------------------------------------------
-! Copyright 2007, 2008, 2009 Sylvain Barbot
-!
-! This file is part of RELAX
-!
-! RELAX is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! RELAX is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with RELAX.  If not, see <http://www.gnu.org/licenses/>.
-!-----------------------------------------------------------------------
-
-MODULE viscoelastic3d
-
-  USE elastic3d
-
-  IMPLICIT NONE
-
-#include "include.f90"
-
-  REAL*8, PRIVATE, PARAMETER :: pi   = 3.141592653589793115997963468544185161_8
-  REAL*8, PRIVATE, PARAMETER :: pi2  = 6.28318530717958623199592693708837032318_8
-  REAL*8, PRIVATE, PARAMETER :: pid2 = 1.57079632679489655799898173427209258079_8
-    
-CONTAINS
-
-  !-----------------------------------------------------------------
-  !> subroutine ViscoElasticDeviatoricStress
-  !! computes the instantaneous deviatoric stress tensor sigma_ij'
-  !!
-  !!  sigma_ij' = 2*mu*(-delta_ij epsilon_kk/3 + epsilon_ij) - tau_ij 
-  !!
-  !! such as
-  !! 
-  !!  sigma_kk'= 0
-  !!
-  !! where tau_ij is a second-order deviatoric symmetric tensor 
-  !! that integrates the history of the relaxed stress. strain is
-  !! estimated using a centered finite difference derivative.
-  !!
-  !! \author sylvain barbot (07/07/07) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE viscoelasticdeviatoricstress(mu,u1,u2,u3,tau,&
-       dx1,dx2,dx3,sx1,sx2,sx3,sig)
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3
-    REAL*4, INTENT(IN), DIMENSION(sx1,sx2,sx3) :: u1,u2,u3
-    TYPE(TENSOR), INTENT(IN),  DIMENSION(:,:,:) :: tau
-    TYPE(TENSOR), INTENT(OUT), DIMENSION(:,:,:) :: sig
-    
-    TYPE(TENSOR) :: s
-    INTEGER :: i1,i2,i3,i1p,i2p,i3p,i1m,i2m,i3m
-    REAL*8 :: epskk,px1,px2,px3
-
-    px1=dx1*2._8
-    px2=dx2*2._8
-    px3=dx3*2._8
-    
-    ! space domain with finite difference scheme
-    DO i3=1,sx3
-       ! wrap around neighbor
-       i3m=mod(sx3+i3-2,sx3)+1
-       i3p=mod(i3,sx3)+1
-       DO i2=1,sx2
-          i2m=mod(sx2+i2-2,sx2)+1
-          i2p=mod(i2,sx2)+1
-          
-          DO i1=1,sx1
-             i1m=mod(sx1+i1-2,sx1)+1
-             i1p=mod(i1,sx1)+1
-             
-             ! trace component
-             epskk=((u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1+&
-                    (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2+&
-                    (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3)/3._8
-             
-             s%s11=2._8*mu*( (u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1-epskk )
-             s%s12=     mu*( (u1(i1,i2p,i3)-u1(i1,i2m,i3))/px2+ &
-                             (u2(i1p,i2,i3)-u2(i1m,i2,i3))/px1)
-             s%s13=     mu*( (u1(i1,i2,i3p)-u1(i1,i2,i3m))/px3+ &
-                             (u3(i1p,i2,i3)-u3(i1m,i2,i3))/px1)
-             s%s22=2._8*mu*( (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2-epskk )
-             s%s23=     mu*( (u2(i1,i2,i3p)-u2(i1,i2,i3m))/px3+ &
-                             (u3(i1,i2p,i3)-u3(i1,i2m,i3))/px2)
-             s%s33=2._8*mu*( (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3-epskk )
-             
-             sig(i1,i2,i3)= s .minus. tau(i1,i2,i3)
-             
-          END DO
-       END DO
-    END DO
-    
-    ! no normal traction at the boundary
-    sig(:,:,1)%s13=0
-    sig(:,:,1)%s23=0
-    sig(:,:,1)%s33=0
-    sig(:,:,sx3)%s13=0
-    sig(:,:,sx3)%s23=0
-    sig(:,:,sx3)%s33=0
-
-  END SUBROUTINE viscoelasticdeviatoricstress
-
-  !-----------------------------------------------------------------
-  !> subroutine ViscousEigenstress
-  !! computes the moment density rate due to a layered viscoelastic
-  !! structure with powerlaw creep
-  !!
-  !!     d Ei / dt = C:F:sigma'
-  !!
-  !! where C is the elastic moduli tensor, F is the heterogeneous
-  !! fluidity tensor and sigma' is the instantaneous deviatoric 
-  !! stress. F is stress dependent (powerlaw creep.)
-  !!
-  !! \author sylvain barbot (08/30/08) - original form
-  !-----------------------------------------------------------------
-  SUBROUTINE viscouseigenstress(mu,structure,ductilezones,nz,sig,sx1,sx2,sx3, &
-       dx1,dx2,dx3,moment,beta,maxwelltime,gamma)
-    REAL*8, INTENT(IN) :: mu,dx1,dx2,dx3,beta
-    INTEGER, INTENT(IN) :: nz
-    TYPE(LAYER_STRUCT), DIMENSION(:), INTENT(IN) :: structure
-    TYPE(WEAK_STRUCT), DIMENSION(nz), INTENT(IN) :: ductilezones
-    INTEGER, INTENT(IN) :: sx1,sx2,sx3
-    TYPE(TENSOR), INTENT(IN), DIMENSION(sx1,sx2,sx3) :: sig
-    TYPE(TENSOR), INTENT(OUT), DIMENSION(sx1,sx2,sx3) :: moment
-    REAL*8, OPTIONAL, INTENT(INOUT) :: maxwelltime
-#ifdef ALIGN_DATA
-    REAL*4, DIMENSION(sx1+2,sx2,sx3), INTENT(OUT), OPTIONAL :: gamma
-#else
-    REAL*4, DIMENSION(sx1,sx2,sx3), INTENT(OUT), OPTIONAL :: gamma
-#endif
-
-    INTEGER :: i1,i2,i3
-    TYPE(TENSOR) :: s,R
-    TYPE(TENSOR), PARAMETER :: zero = tensor(0._4,0._4,0._4,0._4,0._4,0._4)
-    REAL*8 :: gammadot,tau,tauc,gammadot0,power,cohesion,x1,x2,x3,dg0,dum
-    REAL*4 :: tm
-    
-    IF (SIZE(structure,1) .NE. sx3) RETURN
-
-    IF (PRESENT(maxwelltime)) THEN
-       tm=REAL(maxwelltime)
-    ELSE
-       tm=1e30
-    END IF
-
-!$omp parallel do private(i1,i2,gammadot0,power,cohesion,s,tau,R,tauc,gammadot,dg0,x1,x2,x3,dum), &
-!$omp reduction(MIN:tm)
-    DO i3=1,sx3
-       power=structure(i3)%stressexponent
-       cohesion=structure(i3)%cohesion
-       x3=DBLE(i3-1)*dx3
-
-       IF (power .LT. 0.999999_8) THEN 
-          WRITE_DEBUG_INFO
-          WRITE (0,'("power=",ES9.2E1)') power
-          WRITE (0,'("invalid power exponent. interrupting.")')
-          STOP 1
-       END IF
-
-       DO i2=1,sx2
-          DO i1=1,sx1
-             ! local coordinates
-             CALL shiftedcoordinates(i1,i2,i3,sx1,sx2,sx3, &
-                  dx1,dx2,dx3,x1,x2,dum)
-
-             ! depth-dependent fluidity structure             
-             gammadot0=structure(i3)%gammadot0
-
-             ! perturbation from isolated vi