NLSL: gconvl.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

gconvl.f90
Go to the documentation of this file.
1 c Version 1.3.2
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine GCONVL
5 c =========================
6 c
7 c Convolute given real-valued spectrum with a Gaussian lineshape
8 c having a specified derivative peak-to-peak linewidth.
9 c
10 c NOTE: this differs from EPRLL version, which transforms a
11 c complex-valued spectrum.
12 c
13 c----------------------------------------------------------------------
14 subroutine gconvl( spectr,wline,dfld,nfld,nft )
15 c
16 use nlsdim
17 use ftwork
18 use pidef
19 c
20 implicit none
21 c
22 integer nfld,nft
23 double precision spectr(nfld),wline,dfld
24 c
25 integer i,k,no2
26 double precision df,f,g,gib,gnorm
27 c
28 double precision EIGHT,EPS,ONE,TWO,THIRD,ZERO
29 parameter( eight=8.0d0,one=1.0d0,two=2.0d0,zero=0.0d0,
30 # eps=1.0d-6,third=0.33333333333333d0 )
31 c
32 c######################################################################
33 c
34 if (wline.lt.eps) return
35 c
36 c -----------------------------------------------
37 c Store calculation in tmpdat, zero-pad, and FFT
38 c -----------------------------------------------
39 do i=1,nfld
40 tmpdat(i)=spectr(i)
41 end do
42 c
43 do i=nfld+1,nft
44 tmpdat(i)=zero
45 end do
46 c
47 no2=nft/2
48 call realft( tmpdat,no2,+1 )
49 c
50 c ------------------------------------------------------------
51 c Convolute with Gaussian function by multiplying in
52 c with a Gaussian in Fourier space.
53 c
54 c NOTE: REALFT returns only the positive frequencies
55 c since FT of a real function is symmetric. Also, the
56 c first and last elements of the FT array are real-valued
57 c and returned as the real and imaginary parts of tmpdat(1)
58 c ------------------------------------------------------------
59 df=two*pi/(nft*dfld)
60 gnorm=one/dfloat(no2)
61 tmpdat(1)=tmpdat(1)*gnorm
62 tmpdat(2)=tmpdat(2)*gnorm*dexp(-(no2*df*wline)**2/eight)
63 f=df
64 do i=3,nft,2
65 g=gnorm*dexp( -(f*wline)**2/eight )
66 tmpdat(i)=tmpdat(i)*g
67 tmpdat(i+1)=tmpdat(i+1)*g
68 f=f+df
69 end do
70 c
71 c ------------------------------------------------------------
72 c Back-transfor to obtain convoluted spectrum and restore in
73 c spectr array
74 c ------------------------------------------------------------
75 call realft( tmpdat,no2,-1 )
76 c
77 do i=1,nfld
78 spectr(i)=tmpdat(i)
79 end do
80 c
81 return
82 end
ftwork::tmpdat
double precision, dimension(mxpt), save tmpdat
Definition: ftwork.f90:26
realft
subroutine realft(data, n, isign)
Definition: ftfuns.f90:48
ftwork
Definition: ftwork.f90:22
nlsdim
Definition: nlsdim.f90:36
pidef::pi
double precision, parameter pi
Definition: pidef.f90:15
gconvl
subroutine gconvl(spectr, wline, dfld, nfld, nft)
Definition: gconvl.f90:15
pidef
Definition: pidef.f90:12