(*    Burkhard Luy and Steffen J. Glaser,
        Analytical Polarization and Coherence Transfer Functions for Three Dipolar Coupled Spins 1/2
        Journal of Magnetic Resonance 142, 280-287 (2000).

        A Hamiltonian of the form H=2 pi D (2 I1zI2z - I1xI2x - I1yI2y) is assumed (expanded to 3 spins, of course).
        The dipolar couplings between spins 1 and 2 is called j12p (for historical reasons) etc.. The coupling constants
        have to be defined right after the Clear command below.
        The variable transfer12 will give the polarization transfer function for I1z -> I2z under the above mentioned Hamiltonian.
        transfer12x will be the coherence transfer function I1x -> I2x, which is equivalent to the coherence transfer function
        I1y -> I2y. Correspondingly transfer13x or transfer11 corresponds to I1x -> I3x and I1z -> I1z, respectively.
        Transfer functions to zero quantum operators should be clear from the name given (e.g. transfer11y2z corresponds
        to the coherence transfer function I1z -> I1yI2z).

        Please cite the above mentioned reference whenever you use this program for scientific work.

	SPECIAL CASE WITH D12=D13=D23 =j12p !!!

                *)


       Clear[j12p,j13p,j23p,x1,x2,x3,y1,y2,y3,z1,z2,z3,v1,v2,v3,w1,w2,w3,
       n1,n2,n3,c1,c3,lamb1,lamb2,lamb3,delta12,delta13,delta23,
       h, phi,s,p]
       
       
       (* j12p=-10 *)
       
	d12=3*Pi*j12;
       
       transfer11=10/18 + 8/18 * Cos[d12 t]
       transfer12=(8*Sin[(d12*t)/2]^2)/18;
       transfer13=(8*Sin[(d12*t)/2]^2)/18;


       transfer11x2y=1/3 * Sin[(d12*t)]
       transfer11x3y=1/3 * Sin[(d12*t)]
       transfer12x3y=0


       transfer112323=(-4*Sin[(d12*t)/2]^2)/18;
       transfer121313=(2*Sin[(d12*t)/2]^2)/18;
       transfer131212=(2*Sin[(d12*t)/2]^2)/18;
Plot[transfer11, {t,0,0.3}]
Plot[transfer12, {t,0,0.3}]
Plot[transfer13, {t,0,0.3}]
Plot[transfer11x2y, {t,0,0.3}]
Plot[transfer11x3y, {t,0,0.3}]
Plot[transfer12x3y, {t,0,0.3}]
Plot[transfer112323, {t,0,0.3}]
Plot[transfer121313, {t,0,0.3}]
Plot[transfer131212, {t,0,0.3}]