integer*4 cw_orb_add,cw_coul_add,cw_exch_add,cw_suppl_add, & cw_sctch_add,cw_sor_add c_mpi include 'mpif.h' c_mpi include 'commons8.inc' 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. call MPI_INIT(ierror) call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr ) c read input data and echo input parameters c open input/output files if (myid.eq.0) call rinputd(iform,ni,mu,no,nons) 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 ni8=ni+8 mu8=mu+8 ngrid=ni*mu ngrid8 = ni8*mu8 length1 = no*ngrid length2 = no*ngrid if (iform.eq.1.or.iform.eq.3) then length3=( no*(no+1)/2+nons*(nons+1)/2 )*ngrid elseif (iform.eq.0.or.iform.eq.2) then length3 = (no+nons)*ngrid endif c if HFS or OED method of calculation is chosen set length3 to if (imethod.eq.2.or.imethod.eq.3) then length3 = ngrid endif c only momen uses 10 working arrays of length nigrid8 at most c see appropriate changes in iniaddr length4 = 14*ngrid length5 = 10*ngrid8 length6 = 2*ngrid8+4*ni*(mu+16)+2*maxgrids*(ni+mu) lexchrecl = ni*mu*8 c dynamic allocation of memory acccording to the current case call fmalloc (cw_orb_add, 8*length1) call fmalloc (cw_coul_add, 8*length2) call fmalloc (cw_exch_add, 8*length3) call fmalloc (cw_suppl_add,8*length4) call fmalloc (cw_sctch_add,8*length5) call fmalloc (cw_sor_add, 4*length6) c zeroise arrays call zeroarray (%val(cw_orb_add),%val(cw_coul_add), & %val(cw_exch_add),%val(cw_suppl_add), & %val(cw_sctch_add),%val(cw_sor_add)) 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 call inisuppl (%val(cw_suppl_add),%val(cw_sor_add)) 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 (%val(cw_orb_add),%val(cw_coul_add), & %val(cw_exch_add),%val(cw_suppl_add), & %val(cw_sctch_add)) 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 (%val(cw_sor_add),%val(cw_orb_add), & %val(cw_coul_add),%val(cw_exch_add), & %val(cw_suppl_add),%val(cw_sctch_add)) call MPI_FINALIZE(ierror)