Home
last modified time | relevance | path

Searched refs:nsmax (Results 1 – 25 of 195) sorted by relevance

12345678

/dports/science/siesta/siesta-4.1.5/Src/
H A Dold_atmfuncs.f24 integer, save, public :: nsmax
99 call re_alloc( qtb, 1, maxos, 1, nsmax,
114 call re_alloc( chargesave, 1, nsmax,
170 call re_alloc( lmxkbsave, 1, nsmax,
181 call re_alloc( nsemicsave, 0, lmaxd, 1, nsmax,
202 call re_alloc( nkblsave, 0, lmaxd, 1, nsmax,
206 allocate(label_save(nsmax))
210 allocate(basistype_save(nsmax))
214 call re_alloc( semicsave, 1, nsmax,
260 do is=1,nsmax
[all …]
/dports/science/nwchem/nwchem-7b21660b82ebd85ef659f6fba7e1e73433b0bd0a/src/selci/
H A Deirerj.F12 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
44 ib = indbar(i) + (nsmax-ns)
45 irb = indbar(ir) + (nsmax-ns)
47 jb = indbar(j) + (nsmax-ns)
70 ib = indbar(i) + (nsmax-ns)
71 irb = indbar(ir) + (nsmax-ns)
73 jb = indbar(j) + (nsmax-ns)
96 ib = indbar(i) + (nsmax-ns-2)
99 jb = indbar(j) + (nsmax-ns-2)
122 ib = indbar(i) + (nsmax-ns-2)
[all …]
H A Dcouple.c17 #define nsmax 14 macro
147 static void MakeBranchingDiagram(int bd[nsmax+3][nsmax+3], in MakeBranchingDiagram()
218 static void MakeSpinFunctions(int bd[nsmax+3][nsmax+3], in MakeSpinFunctions()
312 double p[nsmax][nfmax+1], double g[nsmax][nfmax+1]) in MakeAxialDistances()
377 static void MakePerm(int bd[nsmax+3][nsmax+3], int ns, int f[nsmax+1][nfmax+1], in MakePerm()
449 double pp[nsmax][nfmax+1], double g[nsmax][nfmax+1], in RightMultiply()
476 double pp[nsmax][nfmax+1], double g[nsmax][nfmax+1], in LeftMultiply()
602 static int bd[nsmax+3][nsmax+3], rbd[nsmax+3][nsmax+3]; in SELCI_COUPLE()
603 static int d[nsmax][nfmax+1], f[nsmax+1][nfmax+1]; in SELCI_COUPLE()
606 static double p[nsmax][nfmax+1], g[nsmax][nfmax+1], *u, *uu, *temp, *ttemp; in SELCI_COUPLE()
[all …]
H A Deijkj.F13 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
38 ib = indbar(i) + (nsmax-ns)
39 kb = indbar(k) + (nsmax-ns)
41 jb = indbar(j) + (nsmax-ns)
62 ib = indbar(i) + (nsmax-ns-2)
63 kb = indbar(k) + (nsmax-ns-2)
65 jb = indbar(j) + (nsmax-ns-2)
89 ib = indbar(i) + (nsmax-ns-2)
90 kb = indbar(k) + (nsmax-ns-4)
92 jb = indbar(j) + (nsmax-ns-4)
H A Drdhwmt.f3 subroutine selci_rdhwmt(iflwmt,mmulti, nsmax, nf, nfmax, nfmax2) argument
10 read (iflwmt,*) mmulti, nsmax
11 read (iflwmt,*) (nf(i),i=mod(nsmax,2),nsmax,2)
12 nfmax = nf(nsmax)
13 nfmax2 = nf(nsmax-2)
H A Dloadw.F3 subroutine selci_loadw(iflwmt, w1, w2, nfmax, nfmax2, nsmax) argument
8 dimension w1(nfmax,nfmax,nsmax), w2(nfmax2,nfmax,nsmax-1)
13 & (((w1(iu,iv,i),iu=1,nfmax),iv=1,nfmax),i=nsmax,1,-1)
14 if (nfmax2*nfmax*(nsmax-1).gt.0) then
16 & (((w2(iu,iv,i),iu=1,nfmax2),iv=1,nfmax),i=1,nsmax-1)
H A Deijil.F13 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
35 ib = indbar(i) + (nsmax-ns-2)
49 lb = indbar(l) + (nsmax-ns-2)
50 jb = indbar(j) + (nsmax-ns-2)
66 lb = indbar(l) + (nsmax-ns-2)
67 jb = indbar(j) + (nsmax-ns)
84 lb = indbar(l) + (nsmax-ns-2)
85 jb = indbar(j) + (nsmax-ns)
H A Dinicij.F12 dimension w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
25 do 5 ns = nsmax,0,-2
28 ns4eij = min(ns,nsmax-2)
32 write(6,*) ' nsmax, nseij, ns4eij ',nsmax, nseij, ns4eij
39 nsdiff = nsmax - ns
74 nsdiff = nsmax - (ns+2)
/dports/science/nwchem-data/nwchem-7.0.2-release/src/selci/
H A Deirerj.F12 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
44 ib = indbar(i) + (nsmax-ns)
45 irb = indbar(ir) + (nsmax-ns)
47 jb = indbar(j) + (nsmax-ns)
70 ib = indbar(i) + (nsmax-ns)
71 irb = indbar(ir) + (nsmax-ns)
73 jb = indbar(j) + (nsmax-ns)
96 ib = indbar(i) + (nsmax-ns-2)
99 jb = indbar(j) + (nsmax-ns-2)
122 ib = indbar(i) + (nsmax-ns-2)
[all …]
H A Dcouple.c17 #define nsmax 14 macro
147 static void MakeBranchingDiagram(int bd[nsmax+3][nsmax+3], in MakeBranchingDiagram()
218 static void MakeSpinFunctions(int bd[nsmax+3][nsmax+3], in MakeSpinFunctions()
312 double p[nsmax][nfmax+1], double g[nsmax][nfmax+1]) in MakeAxialDistances()
377 static void MakePerm(int bd[nsmax+3][nsmax+3], int ns, int f[nsmax+1][nfmax+1], in MakePerm()
449 double pp[nsmax][nfmax+1], double g[nsmax][nfmax+1], in RightMultiply()
476 double pp[nsmax][nfmax+1], double g[nsmax][nfmax+1], in LeftMultiply()
602 static int bd[nsmax+3][nsmax+3], rbd[nsmax+3][nsmax+3]; in SELCI_COUPLE()
603 static int d[nsmax][nfmax+1], f[nsmax+1][nfmax+1]; in SELCI_COUPLE()
606 static double p[nsmax][nfmax+1], g[nsmax][nfmax+1], *u, *uu, *temp, *ttemp; in SELCI_COUPLE()
[all …]
H A Deijkj.F13 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
38 ib = indbar(i) + (nsmax-ns)
39 kb = indbar(k) + (nsmax-ns)
41 jb = indbar(j) + (nsmax-ns)
62 ib = indbar(i) + (nsmax-ns-2)
63 kb = indbar(k) + (nsmax-ns-2)
65 jb = indbar(j) + (nsmax-ns-2)
89 ib = indbar(i) + (nsmax-ns-2)
90 kb = indbar(k) + (nsmax-ns-4)
92 jb = indbar(j) + (nsmax-ns-4)
H A Drdhwmt.f3 subroutine selci_rdhwmt(iflwmt,mmulti, nsmax, nf, nfmax, nfmax2) argument
10 read (iflwmt,*) mmulti, nsmax
11 read (iflwmt,*) (nf(i),i=mod(nsmax,2),nsmax,2)
12 nfmax = nf(nsmax)
13 nfmax2 = nf(nsmax-2)
H A Dloadw.F3 subroutine selci_loadw(iflwmt, w1, w2, nfmax, nfmax2, nsmax) argument
8 dimension w1(nfmax,nfmax,nsmax), w2(nfmax2,nfmax,nsmax-1)
13 & (((w1(iu,iv,i),iu=1,nfmax),iv=1,nfmax),i=nsmax,1,-1)
14 if (nfmax2*nfmax*(nsmax-1).gt.0) then
16 & (((w2(iu,iv,i),iu=1,nfmax2),iv=1,nfmax),i=1,nsmax-1)
H A Deijil.F13 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
35 ib = indbar(i) + (nsmax-ns-2)
49 lb = indbar(l) + (nsmax-ns-2)
50 jb = indbar(j) + (nsmax-ns-2)
66 lb = indbar(l) + (nsmax-ns-2)
67 jb = indbar(j) + (nsmax-ns)
84 lb = indbar(l) + (nsmax-ns-2)
85 jb = indbar(j) + (nsmax-ns)
H A Dinicij.F12 dimension w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
25 do 5 ns = nsmax,0,-2
28 ns4eij = min(ns,nsmax-2)
32 write(6,*) ' nsmax, nseij, ns4eij ',nsmax, nseij, ns4eij
39 nsdiff = nsmax - ns
74 nsdiff = nsmax - (ns+2)
/dports/science/healpix/Healpix_3.50/src/f90/smoothing/
H A Dsmo_sub_inc.f9071 integer(I4B) :: nsmax, nlmax, nmmax variable
214 WRITE(chline1,"(a,i5)") " The map has Nside = ",nsmax
226 npixtot = nside2npix(nsmax)
293 print*,'nside (plm file, map) = ',plm_nside,nsmax
348 w8name = get_healpix_weight_file(nsmax, won)
400 ALLOCATE(w8ring_TQU(1:2*nsmax,1:n_pols),stat = status)
403 ALLOCATE(dw8(1:2*nsmax,1:n_pols),stat = status)
465 n_rings = 2 * nsmax
508 call convert_nest2ring (nsmax, map_TQU)
561 call alm2map(nsmax,nlmax,nmmax,alm_TGC,map_TQU)
[all …]
/dports/science/healpix/Healpix_3.50/src/f90/mod/
H A Dalm_map_template.F9085 real(KMAP), intent(OUT), dimension(0:(12_i8b*nsmax)*nsmax-1) :: map
115 real(KMAP), intent(OUT), dimension(0:(12_i8b*nsmax)*nsmax-1) :: map
156 npix = (12_I8B*nsmax)*nsmax ! total number of pixels on the sphere
361 alm(1:2,0:nlmax,0:nmmax),map(0:12*nsmax*nsmax-1,1:2), zbounds_in)
374 npix = (12_I8B*nsmax)*nsmax ! total number of pixels on the sphere
587 real(KMAP), intent(OUT), dimension(0:(12_i8b*nsmax)*nsmax-1) :: map
612 npix = (12_I8B*nsmax)*nsmax ! total number of pixels on the sphere
835 npix = (12_I8B*nsmax)*nsmax ! total number of pixels on the sphere
1066 npix = (12_I8B*nsmax)*nsmax ! total number of pixels on the sphere
2345 real(KMAP), intent(IN), dimension(0:(12_i8b*nsmax)*nsmax-1) :: map
[all …]
/dports/science/nwchem/nwchem-7b21660b82ebd85ef659f6fba7e1e73433b0bd0a/src/mrpt/fci/
H A Dfciparam.fh10 c nsmax = maximum number of open shell electrons in the FCI space
11 c nsmax1 = nsmax+1
12 c nsmax2 = nsmax/2+1
14 c ndetmx = no. of determinants for nsmax open shells
15 c ncsfmx = no. of CSF for nsmax open shells
17 c . be of dimension sum(ns=0,nsmax) 3*(ns+1)*ndets(ns)
19 integer nav, nactmx, nelmax, nsmax, nsmax1, nsmax2,
26 parameter (nsmax = 14) ! 14 requires about 1.6 MB for eaj
27 parameter (nsmax1 = nsmax+1)
28 parameter (nsmax2 = nsmax/2+1)
/dports/science/nwchem-data/nwchem-7.0.2-release/src/mrpt/fci/
H A Dfciparam.fh10 c nsmax = maximum number of open shell electrons in the FCI space
11 c nsmax1 = nsmax+1
12 c nsmax2 = nsmax/2+1
14 c ndetmx = no. of determinants for nsmax open shells
15 c ncsfmx = no. of CSF for nsmax open shells
17 c . be of dimension sum(ns=0,nsmax) 3*(ns+1)*ndets(ns)
19 integer nav, nactmx, nelmax, nsmax, nsmax1, nsmax2,
26 parameter (nsmax = 14) ! 14 requires about 1.6 MB for eaj
27 parameter (nsmax1 = nsmax+1)
28 parameter (nsmax2 = nsmax/2+1)
/dports/science/madness/madness-ebb3fd7/src/apps/moldft/fci/
H A Dfciparam.fh10 c nsmax = maximum number of open shell electrons in the FCI space
11 c nsmax1 = nsmax+1
12 c nsmax2 = nsmax/2+1
14 c ndetmx = no. of determinants for nsmax open shells
15 c ncsfmx = no. of CSF for nsmax open shells
17 c . be of dimension sum(ns=0,nsmax) 3*(ns+1)*ndets(ns)
19 integer nav, nactmx, nelmax, nsmax, nsmax1, nsmax2,
26 parameter (nsmax = 14) ! 14 requires about 1.6 MB for eaj
27 parameter (nsmax1 = nsmax+1)
28 parameter (nsmax2 = nsmax/2+1)
/dports/science/healpix/Healpix_3.50/src/f90/plmgen/
H A Dplmgen.f9055 INTEGER(I4B) :: nsmax, nlmax, nmmax variable
119 nsmax = parse_int(handle, 'nsmax', default=32, descr=description)
120 if (nside2npix(nsmax) < 0) then
127 WRITE(chline,"(a,i5,a)") "We recommend: (0 <= l <= l_max <= ",3*nsmax-1,")"
132 nlmax = parse_int(handle, 'nlmax', default=2*nsmax, descr=description)
147 n_plm_8 = (nmmax+1_i8b)*(2*nlmax-nmmax+2_i8b)*nsmax
148 n_plm = (nmmax+1 )*(2*nlmax-nmmax+2 )*nsmax
173 call plm_gen(nsmax, nlmax, nmmax, plm)
179 call add_card(header,'NSIDE' ,nsmax, 'Resolution parameter for HEALPIX')
228 call write_plm(plm, n_plm_8, nd, header, nlheader, outfile, nsmax, nlmax)
[all …]
/dports/science/healpix/Healpix_3.50/src/f90/anafast/
H A Dana_sub_inc.f9073 integer(I4B) :: nsmax, nlmax, nmmax, nsmax2 variable
206 print*,nsmax,nsmax2
213 WRITE(chline1,"(a,i5)") " The map has Nside = ",nsmax
225 npixtot = nside2npix(nsmax)
347 w8name = get_healpix_weight_file(nsmax, won)
429 ALLOCATE(dw8(1:2*nsmax,1:n_pols),stat = status)
467 call convert_nest2ring (nsmax, map_TQU)
471 call convert_nest2ring (nsmax, map_TQU2)
495 if (nside_mask == nsmax) then
522 nside_mask = nsmax ; npix_mask = npixtot
[all …]
/dports/science/healpix/Healpix_3.50/src/f90/synfast/
H A Dsyn_sub_inc.f9074 integer(I4B) :: nsmax, nlmax, nmmax variable
170 if (nside2npix(nsmax) < 0) then
186 npixtot = nside2npix(nsmax)
233 windowname = get_healpix_pixel_window_file(nsmax)
319 print*,'nside (plm file, map) = ',plm_nside,nsmax
325 n_plm = (nmmax + 1_i8b)*(2*nlmax + 2_i8b - nmmax)*nsmax
400 call create_alm(nsmax, nlmax, nmmax, polar_cl, &
545 call alm2map(nsmax,nlmax,nmmax,alm_TGC,map_TQU(:,1), &
550 call alm2map(nsmax,nlmax,nmmax,alm_TGC,map_TQU, &
555 call alm2map(nsmax,nlmax,nmmax,alm_TGC,map_TQU,plm=plm)
[all …]
/dports/science/nwchem-data/nwchem-7.0.2-release/src/drdy/
H A DdrdyP.fh13 Integer natoms,n3tm,n3tmp,nbardm,nsmax,fu6,fu30
17 Parameter (nsmax=100)
26 Integer ifrgrd(n3tm,nsmax),ifrgrp(n3tm,4),ifrsp(n3tm)
39 Double Precision sgrid(nsmax),vgrid(nsmax),xgrid(n3tm,nsmax),
40 * dxgrid(n3tm,nsmax),hgrid(nbardm,nsmax),freqg(n3tm,nsmax),
48 Double Precision vrsp,vpsp,vspspsv,vzerosp,vspc,vgrdsp(nsmax)
/dports/science/nwchem/nwchem-7b21660b82ebd85ef659f6fba7e1e73433b0bd0a/src/drdy/
H A DdrdyP.fh13 Integer natoms,n3tm,n3tmp,nbardm,nsmax,fu6,fu30
17 Parameter (nsmax=100)
26 Integer ifrgrd(n3tm,nsmax),ifrgrp(n3tm,4),ifrsp(n3tm)
39 Double Precision sgrid(nsmax),vgrid(nsmax),xgrid(n3tm,nsmax),
40 * dxgrid(n3tm,nsmax),hgrid(nbardm,nsmax),freqg(n3tm,nsmax),
48 Double Precision vrsp,vpsp,vspspsv,vzerosp,vspc,vgrdsp(nsmax)

12345678