integer*4 cw_sor c_mpi include 'mpif.h' c_mpi include 'commons8.inc' c IMPORTANT! c The number of subgrids and the maximum grid size are c determined by the user before the executable of the program is made. c no and nons denote the number of all the orbitals and number c of non sigma type orbitals, respectively. ni and mu correspond to c the number of grid points in ni and mu variables. c Set these numbers in the parameter line below and relink the program. c Remember that 1<=no<=60, 31<=ni<=maxnip and 31<=mu<=maxmup and c maxnip and maxmup have to be smaller or equal then their corresponding c variables MAXMNI and MAXMU which are used during the instalation c process (see prep_src). c c Set also the maximun number of subgrids. maxgridsp has to be less c or equal MAXGRIDS variable defined during the installation process c (see prep_src) c BF parameter (ni=169,mu=193,nop=6,nons=1,ngrid=ni*mu) c TlF c parameter (ni=169,mu=193,nop=31,nons=14,ngrid=ni*mu) c c if iform=1 or 3 set length3p to c parameter (length3p=( nop*(nop+1)/2+nons*(nons+1)/2 )*ngrid) c c if iform=0 or 2 set length3p to c cw_exch has to contain at most (nop+nons) functions c c parameter (length3p= (nop+nons)*ngrid) c c if HFS or OED method of calculation is chosen set length3p to parameter (length3p= ngrid) c Upon changing any of the above parameters this routine MUST be c recompiled and the program relinked parameter (ni8=ni+8,mu8=mu+8,ngrid8=ni8*mu8) parameter (length1p=nop*ngrid,length2p=nop*ngrid) parameter (length4p=14*ngrid,length5p=10*ngrid8) parameter (maxgridsp=3) parameter (length6p=2*ngrid8+4*ni*(mu+16)+2*maxgridsp*(ni+mu)) parameter (lexchreclp=ni*mu*8) dimension cw_orb (length1p), & cw_coul (length2p), & cw_exch (length3p), & cw_suppl(length4p), & cw_sctch(length5p), & cw_sor (length6p) call MPI_INIT(ierror) call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr ) no=nop lexchrecl=lexchreclp length1=length1p length2=length2p length3=length3p length4=length4p length5=length5p length6=length6p c zeroise array call zeroarray (cw_orb,cw_coul,cw_exch,cw_suppl, & cw_sctch,cw_sor) c read input data and echo input parameters c open input/output files if (myid.eq.0) then call rinputd(idummy1,idummy2,idummy3,idummy4,idummy5) endif c initialize arrays within common blocks, c initialize arrays of variable length and check input data c prepare an environment for poisson's equation solving routines c prepare arrays determining ordering of mesh points c !!! other processes should wait here until 0 has finished reading input data call MPI_BARRIER( MPI_COMM_WORLD,ierr ) c if (myid.eq.0) then call MPI_BCAST(iform, 1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(ni, 1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(mu, 1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(no, 1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(nons, 1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/gridi/ ngrids,nni,nmu(10),ngsize(10),mxnmu,mxsize, c & ibmu(10),iemu(10),ioffs(10) call MPI_BCAST(ngrids, 54,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/hydini/ eza1(60),eza2(60),co1(60),co2(60) call MPI_BCAST(eza1, 240,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common /inputd1/ z1atmass,z2atmass,ini,iform,idump, c & iinterp,imethod,ienterm,inoterm,ifix(60), c & itail,ifermi,iplot,header(80),datetime call MPI_BCAST(z1atmass,2,MPI_DOUBLE_PRECISION, & 0,MPI_COMM_WORLD,ierr) call MPI_BCAST(ini,70,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(header,160,MPI_BYTE,0,MPI_COMM_WORLD,ierr) c common/inputd2/ r,r2,z1,z2,rinf,rgrid(10),cutorb,cutcoul,cutexch call MPI_BCAST(r, 18,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common/orbit/ nn(60),ll(60),mm(60),iocc(60) call MPI_BCAST(nn, 240,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/orbiti/ mgx(9,60),lock(60),ige(60),ihomo(60),orbsym(60) call MPI_BCAST(mgx, 720,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(orbsym, 480,MPI_BYTE,0,MPI_COMM_WORLD,ierr) c common/orbitr/ area(60),qxm(60),occ(60),sign(61) call MPI_BCAST(area, 241,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common/scfi/ maxscf,nobckup,islat,ihomon,ibreak,iortho,icanon call MPI_BCAST(maxscf, 7,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/scfr/ facmul,exlorb,exlcoul,exlexp,alphaf,sltthr,diver, c & demax(60),trelax,tortho,trayl,tmomen,sflagra, c & sflagrat(60,60),dampf(60) call MPI_BCAST(facmul, 3732,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common/sori/ maxsor1,maxsor2,maxsor(60),ipoiss,iorder(10), c & impole,itouch(60),iprtlev call MPI_BCAST(maxsor1, 135,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/sorr/ ovforb(10),ovfcoul(10),ovfexch(10),sweep5 call MPI_BCAST(ovforb, 31,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common/config/ norb,nel,nexch call MPI_BCAST(norb, 3,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/debug/ idbg(600),incrni,incrmu call MPI_BCAST(idbg, 602,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/dimes/ homolevl,maxgrids,maxmu,maxni,maxorb,maxfock, c & lexchrecl call MPI_BCAST(homolevl, 7,MPI_DOUBLE_PRECISION,0, & MPI_COMM_WORLD,ierr) c common/compatab/ isum,no,io,ir,ilc(1830),iorn(60),gut(60), c & bond(60),spin(240) call MPI_BCAST(isum, 1894,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(gut, 2880,MPI_BYTE,0,MPI_COMM_WORLD,ierr) c common /address4/i1ng(60),i2ng(60),i3ng(1830),i4ng(20),i5ng(20) call MPI_BCAST(i1ng, 120,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c endif call inisuppl (cw_suppl,cw_sor) c common /address1/ i1b(60),i2b(60),i3b(1830),i4b(20),i5b(20), c & i6b(5) call MPI_BCAST(i1b, 1995,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common /address2/ i1e(60),i2e(60),i3e(1830),i4e(20),i5e(20) call MPI_BCAST(i1e, 1990,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common /address3/ i1si(60),i2si(60),i3si(1830),i4si(20),i5si(20) call MPI_BCAST(i1si, 1990,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common /address4/ i1ng(60),i2ng(60),i3ng(1830),i4ng(20),i5ng(20) call MPI_BCAST(i1ng, 1990,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common /address5/ i1mu(60),i2mu(60),i3mu(1830) call MPI_BCAST(i1mu, 1950,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common /address6/ i3btv(60,60),i3xind(60,60),i3xpair(60,60), c & iwexch(1860),i3brec(60,60),i3xk(60,60),i3xrec1(1860), c & i3xrec2(1860),i3nexcp(60),i3breck(60,60),nexchp call MPI_BCAST(i1mu, 27241,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c common/iaddress7/ i3orb1(1860),i3orb2(1860) call MPI_BCAST(i1mu, 3720,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BARRIER( MPI_COMM_WORLD,ierr ) c print out data defining the case if (myid.eq.0) call printall c initialize orbitals, Coulomb and exchange potentials if (myid.eq.0) then call inifun (cw_orb,cw_coul,cw_exch,cw_suppl,cw_sctch) endif call MPI_BARRIER( MPI_COMM_WORLD,ierr ) c common /inputd1/ z1atmass,z2atmass,ini,iform,idump, c & iinterp,imethod,ienterm,inoterm,ifix(60), c & itail,ifermi,iplot,header(80),datetime call MPI_BCAST(ini,70,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) call MPI_BCAST(header,160,MPI_BYTE,0,MPI_COMM_WORLD,ierr) c perform scf call scf (cw_sor,cw_orb,cw_coul,cw_exch,cw_suppl,cw_sctch) call MPI_FINALIZE(ierror)