1      subroutine xc_xmn12l(tol_rho, fac,lfac,nlfac,
2     r     rho, delrho, tau,
3     &     amat, cmat, mmat, nq, ipol, ex,
4     &     qwght, ldew, func)
5      implicit none
6#include "errquit.fh"
7#include "dft2drv.fh"
8c
9      double precision fac, Ex
10      integer nq, ipol
11      logical lfac, nlfac,ldew,   uselc
12      double precision func(*)  ! value of the functional [output]
13      double precision rho(nq,ipol*(ipol+1)/2)
14      double precision delrho(nq,3,ipol)
15      double precision tau(nq,ipol)
16      double precision qwght(nq)
17      double precision Amat(nq,ipol), Cmat(nq,*),mmat(nq,*)
18      double precision tol_rho
19      external  xc_xmn12l_os
20      call xc_os2cs_mgga(xc_xmn12l_os,
21     &     tol_rho, fac,lfac,nlfac, rho, delrho, tau,
22     &     amat, cmat, mmat,
23     n     nq, ipol, ex,
24     &     qwght, ldew, func)
25      return
26      end
27      subroutine xc_xmn12l_os(tol_rho, fac,lfac,nlfac,
28     r     rho, delrho, tau,
29     &     amat, cmat, mmat,
30     n     nq,  ex,
31     &                     qwght, ldew, func, fact_cs)
32      implicit none
33#include "errquit.fh"
34#include "dft2drv.fh"
35c
36c wrapper for n12 open-shell
37      double precision fac, Ex
38      double precision fact_cs
39      integer nq
40      logical lfac, nlfac,ldew,   uselc
41      double precision func(*)  ! value of the functional [output]
42      double precision rho(nq)
43      double precision delrho(nq,3), tau(nq)
44      double precision qwght(nq)
45      double precision Amat(nq), Cmat(nq), mmat(nq)
46      double precision tol_rho
47
48      call xc_xmn12(tol_rho, fac,lfac,nlfac,
49     r     rho, delrho, tau,
50     &     amat, cmat, mmat,
51     N     nq,  ex,   qwght, ldew, func,
52     I      1    ,fact_cs)
53      return
54      end
55      subroutine xc_xmn12sx(tol_rho, fac,lfac,nlfac,
56     r     rho, delrho, tau,
57     &     amat, cmat, mmat, nq, ipol, ex,
58     &     qwght, ldew, func)
59      implicit none
60#include "errquit.fh"
61#include "dft2drv.fh"
62c
63      double precision fac, Ex
64      integer nq, ipol
65      logical lfac, nlfac,ldew,   uselc
66      double precision func(*)  ! value of the functional [output]
67      double precision rho(nq,ipol*(ipol+1)/2)
68      double precision delrho(nq,3,ipol)
69      double precision tau(nq,ipol)
70      double precision qwght(nq)
71      double precision Amat(nq,ipol), Cmat(nq,*),mmat(nq,*)
72      double precision tol_rho
73      external  xc_xmn12sx_os
74      call xc_os2cs_mgga(xc_xmn12sx_os,
75     &     tol_rho, fac,lfac,nlfac, rho, delrho, tau,
76     &     amat, cmat, mmat,
77     n     nq, ipol, ex,
78     &     qwght, ldew, func)
79      return
80      end
81      subroutine xc_xmn12sx_os(tol_rho, fac,lfac,nlfac,
82     r     rho, delrho, tau,
83     &     amat, cmat, mmat,
84     n     nq,  ex,
85     &                     qwght, ldew, func, fact_cs)
86      implicit none
87#include "errquit.fh"
88#include "dft2drv.fh"
89c
90c wrapper for n12 open-shell
91      double precision fac, Ex
92      double precision fact_cs
93      integer nq
94      logical lfac, nlfac,ldew,   uselc
95      double precision func(*)  ! value of the functional [output]
96      double precision rho(nq)
97      double precision delrho(nq,3), tau(nq)
98      double precision qwght(nq)
99      double precision Amat(nq), Cmat(nq), mmat(nq)
100      double precision tol_rho
101
102      call xc_xmn12(tol_rho, fac,lfac,nlfac,
103     r     rho, delrho, tau,
104     &     amat, cmat, mmat,
105     N     nq,  ex,   qwght, ldew, func,
106     I      2    ,fact_cs)
107      return
108      end
109      Subroutine xc_xmn12(tol_rho, fac,lfac,nlfac,
110     R     rho, delrho, tau,
111     &     Amat, Cmat, mmat,
112     n     nq,  Ex,
113     &     qwght, ldew, func,
114     I     ijzy, fact_cs)
115cSubroutine MN12x(F,D1F,RA,RB,D1RA,D1RB,TA,TB,NGrid,ijzy)
116**************************************************************
117*                                                            *
118*  xc_xmn12 evaluates the exchange part of MN12-L and MN12-SX   *
119*        functionals on the grid.                            *
120*                                                            *
121*  OUTPUT:                                                   *
122*     F   - Functional values                                *
123*     D1F - First derivatives with respect to RA, RB, GA, GB *
124*              TA, TB                                        *
125*                                                            *
126*  INPUT:                                                    *
127*       ijzy - 1 MN12-L                                      *
128*       ijzy - 2 MN12-SX                                     *
129*                                                            *
130*     RA,B   - Spin densities                                *
131*     D1RA,B - Spin density gradients                        *
132*     TA,B   - Spin kinetic energy densities                 *
133*     NGrid  - number of grids                               *
134*                                                            *
135*  RP (09/12)                                                *
136*                                                            *
137**************************************************************
138
139c
140      implicit none
141c
142#include "errquit.fh"
143c
144      double precision fac, Ex
145      double precision fact_cs
146      integer nq
147      logical lfac, nlfac,ldew,   uselc
148      double precision func(*)  ! value of the functional [output]
149      double precision qwght(nq)
150#if 0
151      double precision rho(nq,ipol*(ipol+1)/2)
152      double precision delrho(nq,3,ipol)
153      double precision tau(nq,ipol)
154      double precision Amat(nq,ipol), Cmat(nq,*), Mmat(nq,*)
155#else
156      double precision rho(nq)
157      double precision delrho(nq,3)
158      double precision tau(nq)
159      double precision Amat(nq), Cmat(nq), Mmat(nq)
160#endif
161      double precision tol_rho, pi
162c
163c     kinetic energy density   or  tau
164c
165      double precision tau_in
166c
167c      functional derivatives
168c
169      double precision dWdT, dTdR, dTdTau
170c
171c     Intermediate derivative results, etc.
172c
173      integer n, ijzy
174c
175      double precision Ax, s, s2
176c
177      double precision F1o3,F2o3,F3o5,F4o3,F5o3,F48,F81
178      double precision f10o3,f12,f24,f28,f28o9,f3o2,f6,
179     f     f7o3,f8o3
180      double precision Fx1, Fx2
181c
182      double precision cc000,cc001,cc002,cc003,cc004,cc005
183      double precision cc010,cc011,cc012,cc013,cc014
184      double precision cc020,cc021,cc022,cc023
185      double precision cc030,cc031,cc032
186      double precision cc100,cc101,cc102,cc103,cc104
187      double precision cc110,cc111,cc112,cc113
188      double precision cc120,cc121,cc122
189      double precision cc200,cc201,cc202,cc203
190      double precision cc210,cc211,cc212
191      double precision cc300,cc301,cc302
192      double precision rho43, rho13, rhoo, rho53
193      double precision gamx2, gamx
194      double precision TauUEG, Tsig, Wsig
195      double precision px,u,g,ome
196      double precision sg,s3,us
197      double precision dFMN12dFT, dFMN12dFU, dFMN12dFV, dFMN12dG,
198     d     dFMN12dR, dFMN12dT
199      double precision dFTdR, dFTdTau, dFVdR
200      double precision e,er,sr,ft,fmn12,fu,fv
201#if 0
202      INTEGER NGrid
203      Integer dRA, dRB, dTA, dTB, dGA, dGB, dGC
204      REAL*8  F(NGrid),D1F(NGrid,7),RA(NGrid),RB(NGrid),
205     $        D1RA(NGrid,3),D1RB(NGrid,3),TA(NGrid),TB(NGrid)
206#endif
207      double precision One, Two, Three, Four, Five, Six, Seven, Eight,
208     c     nine
209      Save One,Two,Three,Four,Five,Six,Seven,Eight,Nine
210      Data One/1.0d0/,Two/2.0d0/,Three/3.0d0/,Four/4.0d0/,Five/5.0d0/,
211     $     Six/6.0d0/,Seven/7.0d0/,Eight/8.0d0/,Nine/9.0d0/
212c
213c      if(ipol.eq.1) call errquit(' not reaaaady ',0,0)
214c
215        G   = 0.004d+0
216        ome = 2.5d+0
217        CC000 = 0d0
218        CC001 = 0d0
219        CC002 = 0d0
220        CC003 = 0d0
221        CC004 = 0d0
222        CC005 = 0d0
223        CC010 = 0d0
224        CC011 = 0d0
225        CC012 = 0d0
226        CC013 = 0d0
227        CC014 = 0d0
228        CC020 = 0d0
229        CC021 = 0d0
230        CC022 = 0d0
231        CC023 = 0d0
232        CC030 = 0d0
233        CC031 = 0d0
234        CC032 = 0d0
235        CC100 = 0d0
236        CC101 = 0d0
237        CC102 = 0d0
238        CC103 = 0d0
239        CC104 = 0d0
240        CC110 = 0d0
241        CC111 = 0d0
242        CC112 = 0d0
243        CC113 = 0d0
244        CC120 = 0d0
245        CC121 = 0d0
246        CC122 = 0d0
247        CC200 = 0d0
248        CC201 = 0d0
249        CC202 = 0d0
250        CC203 = 0d0
251        CC210 = 0d0
252        CC211 = 0d0
253        CC212 = 0d0
254        CC300 = 0d0
255        CC301 = 0d0
256        CC302 = 0d0
257      If (ijzy.eq.1) then
258c
259c       MN12-L
260c
261        CC000 =  6.735981D-01
262        CC001 = -2.270598D+00
263        CC002 = -2.613712D+00
264        CC003 =  3.993609D+00
265        CC004 =  4.635575D+00
266        CC005 =  1.250676D+00
267        CC010 =  8.444920D-01
268        CC011 = -1.301173D+01
269        CC012 = -1.777730D+01
270        CC013 = -4.627211D+00
271        CC014 =  5.976605D+00
272        CC020 =  1.142897D+00
273        CC021 = -2.040226D+01
274        CC022 = -2.382843D+01
275        CC023 =  7.119109D+00
276        CC030 = -2.335726D+01
277        CC031 = -1.622633D+01
278        CC032 =  1.482732D+01
279        CC100 =  1.449285D+00
280        CC101 =  1.020598D+01
281        CC102 =  4.407450D+00
282        CC103 = -2.008193D+01
283        CC104 = -1.253561D+01
284        CC110 = -5.435031D+00
285        CC111 =  1.656736D+01
286        CC112 =  2.000229D+01
287        CC113 = -2.513105D+00
288        CC120 =  9.658436D+00
289        CC121 = -3.825281D+00
290        CC122 = -2.500000D+01
291        CC200 = -2.070080D+00
292        CC201 = -9.951913D+00
293        CC202 =  8.731211D-01
294        CC203 =  2.210891D+01
295        CC210 =  8.822633D+00
296        CC211 =  2.499949D+01
297        CC212 =  2.500000D+01
298        CC300 =  6.851693D-01
299        CC301 = -7.406948D-02
300        CC302 = -6.788000D-01
301      Else If (ijzy.eq.2) then
302c
303c       MN12-SX
304c
305        CC000 =  5.226556D-01
306        CC001 = -2.681208D-01
307        CC002 = -4.670705D+00
308        CC003 =  3.067320D+00
309        CC004 =  4.095370D+00
310        CC005 =  2.653023D+00
311        CC010 =  5.165969D-01
312        CC011 = -2.035442D+01
313        CC012 = -9.946472D+00
314        CC013 =  2.938637D+00
315        CC014 =  1.131100D+01
316        CC020 =  4.752452D+00
317        CC021 = -3.061331D+00
318        CC022 = -2.523173D+01
319        CC023 =  1.710903D+01
320        CC030 = -2.357480D+01
321        CC031 = -2.727754D+01
322        CC032 =  1.603291D+01
323        CC100 =  1.842503D+00
324        CC101 =  1.927120D+00
325        CC102 =  1.107987D+01
326        CC103 = -1.182087D+01
327        CC104 = -1.117768D+01
328        CC110 = -5.821000D+00
329        CC111 =  2.266545D+01
330        CC112 =  8.246708D+00
331        CC113 = -4.778364D+00
332        CC120 =  5.329122D-01
333        CC121 = -6.666755D+00
334        CC122 =  1.671429D+00
335        CC200 = -3.311409D+00
336        CC201 =  3.415913D-01
337        CC202 = -6.413076D+00
338        CC203 =  1.038584D+01
339        CC210 =  9.026277D+00
340        CC211 =  1.929689D+01
341        CC212 =  2.669232D+01
342        CC300 =  1.517278D+00
343        CC301 = -3.442503D+00
344        CC302 =  1.100161D+00
345      else
346         call errquit(' xc_xmn12: ijzy not valid ',ijzy,0)
347      End If
348c      Tol_Rho = 1.0d-8
349      F12   = Two * Six
350      F24   = Four * Six
351      F28   = Four * Seven
352      F2o3  = Two / Three
353      F3o2  = Three / Two
354      F1o3  = One / Three
355      F4o3  = Four / Three
356      F7o3  = Seven / Three
357      F8o3  = Eight / Three
358      F10o3 = F2o3 * Five
359      F28o9 = F28 / Nine
360      PI    = Four * ATan(One)
361C
362C     Local Spin Density factor.
363C
364      Ax = -F3o2*(F4o3*PI)**(-F1o3)
365      Do 10 n = 1, nq
366c
367c alpha component
368c
369        If(rho(n).gt.tol_rho.and.tau(n).gt.tol_rho) then
370          F3o5 = Three/Five
371          F6   = Six
372          F5o3 = Five/Three
373          pX    = rho(n)
374          Gamx2 = delrho(n,1)*delrho(n,1) +
375     y         delrho(n,2)*delrho(n,2)  +
376     z         delrho(n,3)*delrho(n,3)
377c          GamX2 = D1RA(i)
378          S2    = GamX2*pX**(-F8o3)
379          U     = G*S2/(One+G*S2)
380          E = Ax*pX**F4o3
381c          tau_in    = tau(n)*2D0
382          tau_in    = tau(n)
383          TauUEG =F3o5*((F6*PI*PI)**F2o3)*(pX**F5o3)
384          Tsig =TauUEG/tau_in
385          Wsig =(Tsig - One)/(Tsig + One)
386c
387          FU = U
388          FV = ome*pX**F1o3/(One+ome*pX**F1o3)
389          FT = Wsig
390c
391          FMN12 = CC000 + FT*CC001 + FT**2*CC002 + FT**3*CC003 +
392     $     FT**4*CC004 + FT**5*CC005 +
393     $    FU*CC010 + FT*FU*CC011 + FT**2*FU*CC012 + FT**3*FU*CC013 +
394     $     FT**4*FU*CC014 + FU**2*CC020 +
395     $    FT*FU**2*CC021 + FT**2*FU**2*CC022 + FT**3*FU**2*CC023 +
396     $     FU**3*CC030 + FT*FU**3*CC031 +
397     $    FT**2*FU**3*CC032 + FV*CC100 + FV*FT*CC101 +
398     $     FV*FT**2*CC102 + FV*FT**3*CC103 +
399     $    FV*FT**4*CC104 + FV*FU*CC110 + FV*FT*FU*CC111 +
400     $     FV*FT**2*FU*CC112 + FV*FT**3*FU*CC113 +
401     $    FV*FU**2*CC120 + FV*FT*FU**2*CC121 + FV*FT**2*FU**2*CC122 +
402     $     FV**2*CC200 + FV**2*FT*CC201 +
403     $    FV**2*FT**2*CC202 + FV**2*FT**3*CC203 + FV**2*FU*CC210 +
404     $     FV**2*FT*FU*CC211 +
405     $    FV**2*FT**2*FU*CC212 + FV**3*CC300 + FV**3*FT*CC301 +
406     $     FV**3*FT**2*CC302
407c
408c          F(i) = F(i) + E*FMN12
409          Ex = Ex + E*FMN12*qwght(n)*fact_cs
410          if(ldew) func(n)=func(n) + E*FMN12*fact_cs
411
412c
413c          If(MaxDrF.ge.1) then
414          If(.true.) then
415            ER = F4o3*E/pX
416            S    = Sqrt(S2)
417            GamX = Sqrt(GamX2)
418            SR   = -F4o3*S/pX
419            SG   = S/GamX
420            US   = Two*G*S/((One+G*S*S)**2)
421c
422            dFVdR =  (ome/(Three*pX**F2o3))
423     $                *(One+ome*pX**F1o3)**(-Two)
424c
425            dWdT = Two/((One + Tsig)**2)
426            dTdR = ((F6*PI*PI)**F2o3)*(pX**F2o3)/tau_in
427            dTdTau = -TauUEG/tau_in**2
428c
429            dFTdR = dWdT*dTdR
430            dFTdTau=dWdT*dTdTau
431c
432          dFMN12dFV = CC100 + FT*CC101 + FT**2*CC102 + FT**3*CC103 +
433     $     FT**4*CC104 + FU*CC110 +
434     $    FT*FU*CC111 + FT**2*FU*CC112 + FT**3*FU*CC113 +
435     $     FU**2*CC120 + FT*FU**2*CC121 +
436     $    FT**2*FU**2*CC122 + Two*FV*CC200 + Two*FV*FT*CC201 +
437     $     Two*FV*FT**2*CC202 + Two*FV*FT**3*CC203 +
438     $    Two*FV*FU*CC210 + Two*FV*FT*FU*CC211+Two*FV*FT**2*FU*CC212+
439     $     Three*FV**2*CC300 + Three*FV**2*FT*CC301 +
440     $    Three*FV**2*FT**2*CC302
441c
442          dFMN12dFU = CC010 + FT*CC011 + FT**2*CC012 + FT**3*CC013 +
443     $     FT**4*CC014 + Two*FU*CC020 +
444     $    Two*FT*FU*CC021 + Two*FT**2*FU*CC022 + Two*FT**3*FU*CC023 +
445     $     Three*FU**2*CC030 + Three*FT*FU**2*CC031 +
446     $    Three*FT**2*FU**2*CC032 + FV*CC110 + FV*FT*CC111 +
447     $     FV*FT**2*CC112 + FV*FT**3*CC113 +
448     $    Two*FV*FU*CC120 + Two*FV*FT*FU*CC121+Two*FV*FT**2*FU*CC122+
449     $     FV**2*CC210 + FV**2*FT*CC211 +
450     $    FV**2*FT**2*CC212
451c
452          dFMN12dFT = CC001 + Two*FT*CC002 + Three*FT**2*CC003 +
453     $     Four*FT**3*CC004 + Five*FT**4*CC005 + FU*CC011 +
454     $    Two*FT*FU*CC012 + Three*FT**2*FU*CC013+Four*FT**3*FU*CC014+
455     $     FU**2*CC021 + Two*FT*FU**2*CC022 +
456     $    Three*FT**2*FU**2*CC023 + FU**3*CC031 + Two*FT*FU**3*CC032 +
457     $     FV*CC101 + Two*FV*FT*CC102 +
458     $    Three*FV*FT**2*CC103 + Four*FV*FT**3*CC104 + FV*FU*CC111 +
459     $     Two*FV*FT*FU*CC112 + Three*FV*FT**2*FU*CC113 +
460     $    FV*FU**2*CC121 + Two*FV*FT*FU**2*CC122 + FV**2*CC201 +
461     $     Two*FV**2*FT*CC202 +
462     $    Three*FV**2*FT**2*CC203 + FV**2*FU*CC211 +
463     $     Two*FV**2*FT*FU*CC212 + FV**3*CC301 + Two*FV**3*FT*CC302
464c
465        dFMN12dR = dFMN12dFV*dFVdR+dFMN12dFU*US*SR+dFMN12dFT*dFTdR
466        dFMN12dG = dFMN12dFU*US*SG
467        dFMN12dT = dFMN12dFT*dFTdTau
468c
469#if 0
470            Amat(n,1) = Amat(n,1) + ER*FMN12
471     $                      + E*dFMN12dR
472            Cmat(n,1)=  Cmat(n,1) + E*dFMN12dG/(Two*GamX)
473            Mmat(n,1)=  Mmat(n,1) + E*dFMN12dT
474#else
475            Amat(n) = Amat(n) + ER*FMN12
476     $                      + E*dFMN12dR
477            Cmat(n)=  Cmat(n) + E*dFMN12dG/(Two*GamX)
478            Mmat(n)=  Mmat(n) + E*dFMN12dT
479#endif
480            endIf
481         endIf
482#if 0
483c
484c beta component
485c
486        If(rho(n,3).gt.tol_rho.and.tau(n,2).gt.tol_rho) then
487          F3o5 = Three/Five
488          F6   = Six
489          F5o3 = Five/Three
490c          pX    = RB(i)
491c          GamX2 = D1RB(i)
492          pX    = rho(n,3)
493          Gamx2 = delrho(n,1,2)*delrho(n,1,2) +
494     y         delrho(n,2,2)*delrho(n,2,2)  +
495     z         delrho(n,3,2)*delrho(n,3,2)
496          S2    = GamX2*pX**(-F8o3)
497          U     = G*S2/(One+G*S2)
498          E = Ax*pX**F4o3
499          tau_in    = tau(n,2)*2d0
500          TauUEG =F3o5*((F6*PI*PI)**F2o3)*(pX**F5o3)
501          Tsig =TauUEG/tau_in
502          Wsig =(Tsig - One)/(Tsig + One)
503c
504          FU = U
505          FV = ome*pX**F1o3/(One+ome*pX**F1o3)
506          FT = Wsig
507c
508          FMN12 = CC000 + FT*CC001 + FT**2*CC002 + FT**3*CC003 +
509     $     FT**4*CC004 + FT**5*CC005 +
510     $    FU*CC010 + FT*FU*CC011 + FT**2*FU*CC012 + FT**3*FU*CC013 +
511     $     FT**4*FU*CC014 + FU**2*CC020 +
512     $    FT*FU**2*CC021 + FT**2*FU**2*CC022 + FT**3*FU**2*CC023 +
513     $     FU**3*CC030 + FT*FU**3*CC031 +
514     $    FT**2*FU**3*CC032 + FV*CC100 + FV*FT*CC101 +
515     $     FV*FT**2*CC102 + FV*FT**3*CC103 +
516     $    FV*FT**4*CC104 + FV*FU*CC110 + FV*FT*FU*CC111 +
517     $     FV*FT**2*FU*CC112 + FV*FT**3*FU*CC113 +
518     $    FV*FU**2*CC120 + FV*FT*FU**2*CC121 + FV*FT**2*FU**2*CC122 +
519     $     FV**2*CC200 + FV**2*FT*CC201 +
520     $    FV**2*FT**2*CC202 + FV**2*FT**3*CC203 + FV**2*FU*CC210 +
521     $     FV**2*FT*FU*CC211 +
522     $    FV**2*FT**2*FU*CC212 + FV**3*CC300 + FV**3*FT*CC301 +
523     $     FV**3*FT**2*CC302
524c
525c          F(i) = F(i) + E*FMN12
526          Ex = Ex + E*FMN12*qwght(n)
527          if(ldew) func(n)=func(n) + E*FMN12
528c
529c          If(MaxDrF.ge.1) then
530          If(.true.) then
531            ER = F4o3*E/pX
532            S    = Sqrt(S2)
533            GamX = Sqrt(GamX2)
534            SR   = -F4o3*S/pX
535            SG   = S/GamX
536            US   = Two*G*S/((One+G*S*S)**2)
537c
538            dFVdR =  (ome/(Three*pX**F2o3))
539     $                *(One+ome*pX**F1o3)**(-Two)
540c
541            dWdT = Two/((One + Tsig)**2)
542            dTdR = ((F6*PI*PI)**F2o3)*(pX**F2o3)/tau_in
543            dTdTau = -TauUEG/tau_in**2
544c
545            dFTdR = dWdT*dTdR
546            dFTdTau=dWdT*dTdTau
547c
548          dFMN12dFV = CC100 + FT*CC101 + FT**2*CC102 + FT**3*CC103 +
549     $     FT**4*CC104 + FU*CC110 +
550     $    FT*FU*CC111 + FT**2*FU*CC112 + FT**3*FU*CC113 +
551     $     FU**2*CC120 + FT*FU**2*CC121 +
552     $    FT**2*FU**2*CC122 + Two*FV*CC200 + Two*FV*FT*CC201 +
553     $     Two*FV*FT**2*CC202 + Two*FV*FT**3*CC203 +
554     $    Two*FV*FU*CC210 + Two*FV*FT*FU*CC211+Two*FV*FT**2*FU*CC212+
555     $     Three*FV**2*CC300 + Three*FV**2*FT*CC301 +
556     $    Three*FV**2*FT**2*CC302
557c
558          dFMN12dFU = CC010 + FT*CC011 + FT**2*CC012 + FT**3*CC013 +
559     $     FT**4*CC014 + Two*FU*CC020 +
560     $    Two*FT*FU*CC021 + Two*FT**2*FU*CC022 + Two*FT**3*FU*CC023 +
561     $     Three*FU**2*CC030 + Three*FT*FU**2*CC031 +
562     $    Three*FT**2*FU**2*CC032 + FV*CC110 + FV*FT*CC111 +
563     $     FV*FT**2*CC112 + FV*FT**3*CC113 +
564     $    Two*FV*FU*CC120 + Two*FV*FT*FU*CC121+Two*FV*FT**2*FU*CC122+
565     $     FV**2*CC210 + FV**2*FT*CC211 +
566     $    FV**2*FT**2*CC212
567c
568          dFMN12dFT = CC001 + Two*FT*CC002 + Three*FT**2*CC003 +
569     $     Four*FT**3*CC004 + Five*FT**4*CC005 + FU*CC011 +
570     $    Two*FT*FU*CC012 + Three*FT**2*FU*CC013+Four*FT**3*FU*CC014+
571     $     FU**2*CC021 + Two*FT*FU**2*CC022 +
572     $    Three*FT**2*FU**2*CC023 + FU**3*CC031 + Two*FT*FU**3*CC032 +
573     $     FV*CC101 + Two*FV*FT*CC102 +
574     $    Three*FV*FT**2*CC103 + Four*FV*FT**3*CC104 + FV*FU*CC111 +
575     $     Two*FV*FT*FU*CC112 + Three*FV*FT**2*FU*CC113 +
576     $    FV*FU**2*CC121 + Two*FV*FT*FU**2*CC122 + FV**2*CC201 +
577     $     Two*FV**2*FT*CC202 +
578     $    Three*FV**2*FT**2*CC203 + FV**2*FU*CC211 +
579     $     Two*FV**2*FT*FU*CC212 + FV**3*CC301 + Two*FV**3*FT*CC302
580c
581        dFMN12dR = dFMN12dFV*dFVdR+dFMN12dFU*US*SR+dFMN12dFT*dFTdR
582        dFMN12dG = dFMN12dFU*US*SG
583        dFMN12dT = dFMN12dFT*dFTdTau
584c
585            Amat(n,2) = Amat(n,2)   + ER*FMN12 +
586     $                       E*dFMN12dR
587            Cmat(n,3)=  Cmat(n,3)   + E*dFMN12dG/(Two*GamX)
588            Mmat(n,2)=  Mmat(n,2)   + E*dFMN12dT
589            endIf
590         endIf
591#endif
592 10    Continue
593
594      Return
595      End
596      Subroutine xc_xmn12_d2()
597      call errquit(' not coded ',0,0)
598      return
599      end
600