API tools faq
paste
Guest User

Untitled

a guest
Jul 2nd, 2018
73
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Fortran 11.25 KB | None | 0 0
raw download clone embed print report
  1. C -------------------------- gen2p -------------------------------------
  2. C keywords from file all.p2
  3. C ----------------------------------------------------------------------
  4.       subroutine p2init
  5.       implicit double precision (a-h,o-z)
  6.       include 'inc/p2_dim.inc'
  7.       include 'inc/p2.inc'
  8.       call p2ini0
  9.       call p2inid
  10.       sfile='all.p2'
  11.       nkey=49
  12.       keys(1)='znuc'
  13.       keylen(1)=4
  14.       nargs(1)=0
  15.       fmts(1)='*'
  16.       keys(2)='lcao'
  17.       keylen(2)=4
  18.       nargs(2)=4
  19.       fmts(2)='iiia'
  20.       keys(3)='geometry'
  21.       keylen(3)=8
  22.       nargs(3)=0
  23.       fmts(3)='*'
  24.       keys(4)='exponents'
  25.       keylen(4)=9
  26.       nargs(4)=1
  27.       fmts(4)='i'
  28.       keys(5)='determinants'
  29.       keylen(5)=12
  30.       nargs(5)=2
  31.       fmts(5)='ii'
  32.       keys(6)='multideterminants'
  33.       keylen(6)=17
  34.       nargs(6)=1
  35.       fmts(6)='i'
  36.       keys(7)='jastrow_parameter'
  37.       keylen(7)=17
  38.       nargs(7)=1
  39.       fmts(7)='i'
  40.       keys(8)='basis'
  41.       keylen(8)=5
  42.       nargs(8)=1
  43.       fmts(8)='i'
  44.       keys(9)='qmc_bf_info'
  45.       keylen(9)=11
  46.       nargs(9)=1
  47.       fmts(9)='i'
  48.       keys(10)='lattice'
  49.       keylen(10)=7
  50.       nargs(10)=0
  51.       fmts(10)='*'
  52.       keys(11)='forces_displace'
  53.       keylen(11)=15
  54.       nargs(11)=0
  55.       fmts(11)='*'
  56.       keys(12)='csf'
  57.       keylen(12)=3
  58.       nargs(12)=3
  59.       fmts(12)='iia'
  60.       keys(13)='csfmap'
  61.       keylen(13)=6
  62.       nargs(13)=1
  63.       fmts(13)='a'
  64.       keys(14)='jasderiv'
  65.       keylen(14)=8
  66.       nargs(14)=0
  67.       fmts(14)='*'
  68.       keys(15)='sym_labels'
  69.       keylen(15)=10
  70.       nargs(15)=3
  71.       fmts(15)='iia'
  72.       keys(16)='optorb_mixvirt'
  73.       keylen(16)=14
  74.       nargs(16)=3
  75.       fmts(16)='iia'
  76.       keys(17)='energies'
  77.       keylen(17)=8
  78.       nargs(17)=2
  79.       fmts(17)='ia'
  80.       keys(18)='eigenvalues'
  81.       keylen(18)=11
  82.       nargs(18)=2
  83.       fmts(18)='ia'
  84.       keys(19)='dmatrix'
  85.       keylen(19)=7
  86.       nargs(19)=3
  87.       fmts(19)='iia'
  88.       keys(20)='cavity_spheres'
  89.       keylen(20)=14
  90.       nargs(20)=1
  91.       fmts(20)='i'
  92.       keys(21)='gradients_cartesian'
  93.       keylen(21)=19
  94.       nargs(21)=0
  95.       fmts(21)='*'
  96.       keys(22)='gradients_zmatrix'
  97.       keylen(22)=17
  98.       nargs(22)=0
  99.       fmts(22)='*'
  100.       keys(23)='modify_zmatrix'
  101.       keylen(23)=14
  102.       nargs(23)=0
  103.       fmts(23)='*'
  104.       keys(24)='hessian_zmatrix'
  105.       keylen(24)=15
  106.       nargs(24)=0
  107.       fmts(24)='*'
  108.       keys(25)='zmatrix_connectionmatrix'
  109.       keylen(25)=24
  110.       nargs(25)=0
  111.       fmts(25)='*'
  112.       keys(26)='efield'
  113.       keylen(26)=6
  114.       nargs(26)=3
  115.       fmts(26)='iia'
  116.       keys(27)='quit'
  117.       keylen(27)=4
  118.       nargs(27)=0
  119.       fmts(27)='*'
  120.       keys(28)='fit_input'
  121.       keylen(28)=9
  122.       nargs(28)=0
  123.       fmts(28)='*'
  124.       keys(29)='array'
  125.       keylen(29)=5
  126.       nargs(29)=2
  127.       fmts(29)='ai'
  128.       keys(30)='vector'
  129.       keylen(30)=6
  130.       nargs(30)=2
  131.       fmts(30)='ai'
  132.       keys(31)='table'
  133.       keylen(31)=5
  134.       nargs(31)=2
  135.       fmts(31)='ai'
  136.       keys(32)='printmacros'
  137.       keylen(32)=11
  138.       nargs(32)=1
  139.       fmts(32)='a'
  140.       keys(33)='savemacros'
  141.       keylen(33)=10
  142.       nargs(33)=1
  143.       fmts(33)='a'
  144.       keys(34)='skipto'
  145.       keylen(34)=6
  146.       nargs(34)=2
  147.       fmts(34)='ai'
  148.       keys(35)='gotol'
  149.       keylen(35)=5
  150.       nargs(35)=1
  151.       fmts(35)='i'
  152.       keys(36)='loop'
  153.       keylen(36)=4
  154.       nargs(36)=4
  155.       fmts(36)='aiii'
  156.       keys(37)='end'
  157.       keylen(37)=3
  158.       nargs(37)=0
  159.       fmts(37)='*'
  160.       keys(38)='?'
  161.       keylen(38)=1
  162.       nargs(38)=0
  163.       fmts(38)='*'
  164.       keys(39)='??'
  165.       keylen(39)=2
  166.       nargs(39)=0
  167.       fmts(39)='*'
  168.       keys(40)='load'
  169.       keylen(40)=4
  170.       nargs(40)=1
  171.       fmts(40)='a'
  172.       keys(41)='fop'
  173.       keylen(41)=3
  174.       nargs(41)=5
  175.       fmts(41)='aadad'
  176.       keys(42)='@@'
  177.       keylen(42)=2
  178.       nargs(42)=5
  179.       fmts(42)='aadad'
  180.       keys(43)='iop'
  181.       keylen(43)=3
  182.       nargs(43)=5
  183.       fmts(43)='aaiai'
  184.       keys(44)='@'
  185.       keylen(44)=1
  186.       nargs(44)=5
  187.       fmts(44)='aaiai'
  188.       keys(45)='info'
  189.       keylen(45)=4
  190.       nargs(45)=2
  191.       fmts(45)='ii'
  192.       keys(46)='finfo'
  193.       keylen(46)=5
  194.       nargs(46)=1
  195.       fmts(46)='i'
  196.       keys(47)='rewind'
  197.       keylen(47)=6
  198.       nargs(47)=1
  199.       fmts(47)='a'
  200.       keys(48)='autorewind'
  201.       keylen(48)=10
  202.       nargs(48)=2
  203.       fmts(48)='ai'
  204.       keys(49)='open_file'
  205.       keylen(49)=9
  206.       nargs(49)=3
  207.       fmts(49)='aaa'
  208.       end
  209.       subroutine p2inid
  210.       implicit double precision (a-h,o-z)
  211.       include 'inc/p2_dim.inc'
  212.       include 'inc/p2.inc'
  213.       include 'inc/p2defv.inc'
  214.       do i=1,MXKEY
  215.        ideflt(i)=0
  216.        do j=1,MXIDL
  217.         idefpp(j,i)=0
  218.        enddo
  219.       enddo
  220.       ideflt(2)=3
  221.       idefpp(3,2)=1
  222.       idefvv(1)=1
  223.       idefpp(4,2)=1
  224.       adefvv(1)='<input>'
  225.       ideflt(4)=1
  226.       idefpp(1,4)=2
  227.       idefvv(2)=1
  228.       ideflt(5)=2
  229.       idefpp(2,5)=3
  230.       idefvv(3)=1
  231.       ideflt(7)=1
  232.       idefpp(1,7)=4
  233.       idefvv(4)=1
  234.       ideflt(12)=2
  235.       idefpp(2,12)=5
  236.       idefvv(5)=1
  237.       idefpp(3,12)=2
  238.       adefvv(2)='<input>'
  239.       ideflt(13)=1
  240.       idefpp(1,13)=3
  241.       adefvv(3)='<input>'
  242.       ideflt(15)=3
  243.       idefpp(3,15)=4
  244.       adefvv(4)='<input>'
  245.       ideflt(16)=3
  246.       idefpp(3,16)=5
  247.       adefvv(5)='<input>'
  248.       ideflt(17)=2
  249.       idefpp(2,17)=6
  250.       adefvv(6)='<input>'
  251.       ideflt(18)=2
  252.       idefpp(2,18)=7
  253.       adefvv(7)='<input>'
  254.       ideflt(19)=3
  255.       idefpp(3,19)=8
  256.       adefvv(8)='<input>'
  257.       ideflt(26)=3
  258.       idefpp(3,26)=9
  259.       adefvv(9)='<input>'
  260.       ideflt(29)=2
  261.       idefpp(2,29)=6
  262.       idefvv(6)=1
  263.       ideflt(30)=2
  264.       idefpp(2,30)=7
  265.       idefvv(7)=1
  266.       ideflt(31)=2
  267.       idefpp(2,31)=8
  268.       idefvv(8)=1
  269.       ideflt(32)=1
  270.       idefpp(1,32)=10
  271.       adefvv(10)='stdout'
  272.       ideflt(33)=1
  273.       idefpp(1,33)=11
  274.       adefvv(11)='stdout'
  275.       ideflt(34)=2
  276.       idefpp(2,34)=9
  277.       idefvv(9)=1
  278.       ideflt(36)=4
  279.       idefpp(4,36)=10
  280.       idefvv(10)=1
  281.       ideflt(41)=5
  282.       idefpp(5,41)=1
  283.       ddefvv(1)=0
  284.       ideflt(42)=5
  285.       idefpp(5,42)=2
  286.       ddefvv(2)=0
  287.       ideflt(43)=3
  288.       idefpp(3,43)=11
  289.       idefvv(11)=0
  290.       idefpp(4,43)=12
  291.       adefvv(12)='x'
  292.       idefpp(5,43)=12
  293.       idefvv(12)=0
  294.       ideflt(44)=3
  295.       idefpp(3,44)=13
  296.       idefvv(13)=0
  297.       idefpp(4,44)=13
  298.       adefvv(13)='x'
  299.       idefpp(5,44)=14
  300.       idefvv(14)=0
  301.       ideflt(45)=2
  302.       idefpp(2,45)=15
  303.       idefvv(15)=-1
  304.       ideflt(46)=1
  305.       idefpp(1,46)=16
  306.       idefvv(16)=0
  307.       ideflt(48)=1
  308.       idefpp(1,48)=14
  309.       adefvv(14)='on'
  310.       idefpp(2,48)=17
  311.       idefvv(17)=0
  312.       ideflt(49)=2
  313.       idefpp(2,49)=15
  314.       adefvv(15)='f'
  315.       idefpp(3,49)=16
  316.       adefvv(16)='app'
  317.       ip2dfl=1
  318.       end
  319.       subroutine p2call(ikw,itmp,ftmp,is1,is2,lne,iend,MXF,iu)
  320.       implicit double precision (a-h,o-z)
  321.       include 'inc/p2etc.inc'
  322.       dimension itmp(MXF)
  323.       dimension ftmp(MXF)
  324.       character lne*(*)
  325.       dimension is1(MXF)
  326.       dimension is2(MXF)
  327.       iend=0
  328.       goto(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23
  329.      $    ,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43
  330.      $    ,44,45,46,47,48,49) ikw
  331.       call fatal('p2call: bad keyword-ID')
  332.  1    continue
  333.        call read_znuc(iu)
  334.       goto 9999
  335.  2    continue
  336.        call read_lcao(itmp(1),itmp(2),itmp(3),lne(is1(1):is2(1)))
  337.       goto 9999
  338.  3    continue
  339.        call read_geometry(iu)
  340.       goto 9999
  341.  4    continue
  342.        call read_exponents(iu,itmp(1))
  343.       goto 9999
  344.  5    continue
  345.        call read_determinants(iu,itmp(1),itmp(2))
  346.       goto 9999
  347.  6    continue
  348.        call read_multideterminants(iu,itmp(1))
  349.       goto 9999
  350.  7    continue
  351.        call read_jastrow_parameter(iu,itmp(1))
  352.       goto 9999
  353.  8    continue
  354.        call read_bas_num_info(iu,itmp(1))
  355.       goto 9999
  356.  9    continue
  357.        call read_bas_num_info(iu,itmp(1))
  358.       goto 9999
  359.  10   continue
  360.        call read_lattice(iu)
  361.       goto 9999
  362.  11   continue
  363.        call read_forces(iu)
  364.       goto 9999
  365.  12   continue
  366.        call read_csf(itmp(1),itmp(2),lne(is1(1):is2(1)))
  367.       goto 9999
  368.  13   continue
  369.        call read_csfmap(lne(is1(1):is2(1)))
  370.       goto 9999
  371.  14   continue
  372.        call read_jasderiv(iu)
  373.       goto 9999
  374.  15   continue
  375.        call read_sym(itmp(1),itmp(2),lne(is1(1):is2(1)))
  376.       goto 9999
  377.  16   continue
  378.        call read_optorb_mixvirt(itmp(1),itmp(2),lne(is1(1):is2(1)))
  379.       goto 9999
  380.  17   continue
  381.        call read_energies(itmp(1),lne(is1(1):is2(1)))
  382.       goto 9999
  383.  18   continue
  384.        call read_energies(itmp(1),lne(is1(1):is2(1)))
  385.       goto 9999
  386.  19   continue
  387.        call read_dmatrix(itmp(1),itmp(2),lne(is1(1):is2(1)))
  388.       goto 9999
  389.  20   continue
  390.        call read_cavity_spheres(iu,itmp(1))
  391.       goto 9999
  392.  21   continue
  393.        call read_gradnts_cart(iu)
  394.       goto 9999
  395.  22   continue
  396.        call read_gradnts_zmat(iu)
  397.       goto 9999
  398.  23   continue
  399.        call read_modify_zmat(iu)
  400.       goto 9999
  401.  24   continue
  402.        call read_hessian_zmat(iu)
  403.       goto 9999
  404.  25   continue
  405.        call read_zmat_conn(iu)
  406.       goto 9999
  407.  26   continue
  408.        call read_efield(itmp(1),itmp(2),lne(is1(1):is2(1)))
  409.       goto 9999
  410.  27   continue
  411.        iend=1
  412.       goto 9999
  413.  28   continue
  414.        iend=1
  415.       goto 9999
  416.  29   continue
  417.        call p2arry(iu,lne(is1(1):is2(1)),0,itmp(1))
  418.       goto 9999
  419.  30   continue
  420.        call p2arry(iu,lne(is1(1):is2(1)),1,itmp(1))
  421.       goto 9999
  422.  31   continue
  423.        call p2arry(iu,lne(is1(1):is2(1)),2,itmp(1))
  424.       goto 9999
  425.  32   continue
  426.        call p2vin(lne(is1(1):is2(1)),0)
  427.       goto 9999
  428.  33   continue
  429.        call p2vin(lne(is1(1):is2(1)),1)
  430.       goto 9999
  431.  34   continue
  432.        call skipto(lne(is1(1):is2(1)),itmp(1))
  433.       goto 9999
  434.  35   continue
  435.        call gotol(itmp(1))
  436.       goto 9999
  437.  36   continue
  438.        call loop(lne(is1(1):is2(1)),itmp(1),itmp(2),itmp(3))
  439.       goto 9999
  440.  37   continue
  441.        call ectrl
  442.       goto 9999
  443.  38   continue
  444.        call cmdlst(3)
  445.       goto 9999
  446.  39   continue
  447.        call cmdlst(0)
  448.       goto 9999
  449.  40   continue
  450.        call ldcmdf(lne(is1(1):is2(1)))
  451.       goto 9999
  452.  41   continue
  453.        call p2fop(lne(is1(1):is2(1)),lne(is1(2):is2(2)),ftmp(1),lne(is
  454.      $    1(3):is2(3)),ftmp(2))
  455.       goto 9999
  456.  42   continue
  457.        call p2fop(lne(is1(1):is2(1)),lne(is1(2):is2(2)),ftmp(1),lne(is
  458.      $    1(3):is2(3)),ftmp(2))
  459.       goto 9999
  460.  43   continue
  461.        call p2iop(lne(is1(1):is2(1)),lne(is1(2):is2(2)),itmp(1),lne(is
  462.      $    1(3):is2(3)),itmp(2))
  463.       goto 9999
  464.  44   continue
  465.        call p2iop(lne(is1(1):is2(1)),lne(is1(2):is2(2)),itmp(1),lne(is
  466.      $    1(3):is2(3)),itmp(2))
  467.       goto 9999
  468.  45   continue
  469.        call infox(itmp(1),itmp(2))
  470.       goto 9999
  471.  46   continue
  472.        call finfo(itmp(1))
  473.       goto 9999
  474.  47   continue
  475.        call rwf(lne(is1(1):is2(1)))
  476.       goto 9999
  477.  48   continue
  478.        call arwnd(lne(is1(1):is2(1)),itmp(1))
  479.       goto 9999
  480.  49   continue
  481.        call fn_open(lne(is1(1):is2(1)),lne(is1(2):is2(2)),lne(is1(3):i
  482.      $    s2(3)))
  483.       goto 9999
  484.  9999 continue
  485.       end
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!