1C> \ingroup selci 2C> @{ 3 subroutine selci_stool(iconf,ept,ept_mp,enew,ptnorm,ptnorm_mp, 4 & nroot,irange,nrange,iwpt, 5 & noconfi,ioconf,nintpo,nconmx,ncold) 6* 7* $Id$ 8* 9 implicit real*8 (a-h,o-z), integer(i-n) 10#include "errquit.fh" 11c 12c collect info from the other processes for restart 13c 14 dimension ioconf(nintpo,nconmx),irange(nrange), 15 & ept(nroot),enew(nroot),ptnorm(nroot), 16 & ept_mp(nroot),ptnorm_mp(nroot) 17c 18c spare arrays needed 19c 20 dimension eptn(50), enewn(50), ptnormn(50), irangen(21) 21 dimension eptn_mp(50), ptnormn_mp(50) 22 integer pmap(0:1023) ! 1024 max process count 23c 24c irest = unit for restart tape 'selci.r.?' 25c ? is 1 or 2 26c istde = standard error 27c istdo = standard output 28c 29 parameter(irest = 69) 30 parameter(istde=0,istdo=6) 31#include "cselcifiles.fh" 32#include "global.fh" 33 integer icall 34 data icall/0/ 35c 36 its = mtime() 37 if (nroot.gt.50) call errquit('STOOL: hard dimension fail', 38 $ nroot, INPUT_ERR) 39 me = ga_nodeid() 40 master = 0 41 if (ga_nnodes() .gt. 1024) call errquit('ptidy: too many procs', 42 $ 0, INPUT_ERR) 43 call ga_list_nodeid(pmap, ga_nnodes()) ! Map to msg passing layer 44* write(6,*) ga_nodeid(),' processor map ', 45* $ (pmap(i),i=0,ga_nnodes()-1) 46 node0 = pmap(0) 47c 48c check existence of file 49c The following two lines are to take care of compiler warnings. 50c 51 ifile = 1 52 idfile = 2 53 54 if (me.eq.master) then 55 icall = icall + 1 56 ifile = 1 57 idfile = 2 58 if(mod(icall,2).eq.0) then 59 ifile = 2 60 idfile = 1 61 endif 62 endif 63c 64c do not update vector length 65c if a crash occurs then node 0 (master) will 66c hold all results of previous work. 67c 68 noconf = noconfi 69 isync = 1 70 if (me.ne.master) then 71 call snd(21, (noconf-ncold), mitob(1), node0, isync) 72 call snd(22, ioconf(1,ncold+1),mitob(nintpo*(noconf-ncold)), 73 & node0,isync) 74 call snd(23, ept, mdtob(nroot), node0, isync) 75 call snd(24, enew, mdtob(nroot), node0, isync) 76 call snd(25, ptnorm, mdtob(nroot), node0, isync) 77 call snd(26, irange, mitob(21), node0, isync) 78 call snd(27, ept_mp, mdtob(nroot), node0, isync) 79 call snd(28, ptnorm_mp, mdtob(nroot), node0, isync) 80 call dfill(nroot,0.0d0,ept,1) 81 call dfill(nroot,0.0d0,ept_mp,1) 82 call dfill(nroot,0.0d0,enew,1) 83 call dfill(nroot,0.0d0,ptnorm,1) 84 call dfill(nroot,0.0d0,ptnorm_mp,1) 85 call ifill(21,0,irange,1) 86 else 87 ipt = noconf+1 88 do iislave=1,ga_nnodes()-1 89 islave = pmap(iislave) 90 call rcv(21, new, mitob(1), len, islave, node, isync) 91 noconf = noconf + new 92 if (noconf.le.nconmx) then 93 call rcv(22, ioconf(1,ipt), mitob(nintpo*new), len, 94 $ islave, node, isync) 95 ipt = ipt + new 96 else 97 call errquit(' stool: noconf exceeded nconmx ', 98 & noconf, INPUT_ERR) 99 endif 100 call rcv(23, eptn, mdtob(nroot), len, islave, node, 101 & isync) 102 call rcv(24, enewn, mdtob(nroot), len, islave, node, 103 & isync) 104 call rcv(25, ptnormn, mdtob(nroot), len, islave, node, 105 & isync) 106 call rcv(26, irangen, mitob(nrange), len, islave, node, 107 & isync) 108 call rcv(27, eptn_mp, mdtob(nroot), len, islave, node, 109 & isync) 110 call rcv(28, ptnormn_mp, mdtob(nroot), len, islave, node, 111 & isync) 112 do i = 1,nroot 113 ept(i) = ept(i) + eptn(i) 114 ept_mp(i) = ept_mp(i) + eptn_mp(i) 115 enew(i) = enew(i) + enewn(i) 116 ptnorm(i) = ptnorm(i) + ptnormn(i) 117 ptnorm_mp(i) = ptnorm_mp(i) + ptnormn_mp(i) 118 enddo 119 do i = 1,nrange 120 irange(i) = irange(i) + irangen(i) 121 enddo 122 enddo 123 open(unit=irest,file=names(ifile),access='sequential', 124 & form='unformatted',status='unknown', 125 & err=90911) 126 close(unit=irest,status='delete') 127 open(unit=irest,file=names(ifile),access='sequential', 128 & form='unformatted',status='unknown', 129 & err=90911) 130 rewind irest 131c 132 write(irest)iconf,ncold,nroot,nrange,noconf,nintpo,nconmx, 133 $ iwpt 134 write(irest)(irange(ii),ii=1,nrange) 135 write(irest)(ept(ii),ii=1,nroot) 136 write(irest)(ept_mp(ii),ii=1,nroot) 137 write(irest)(enew(ii),ii=1,nroot) 138 write(irest)(ptnorm(ii),ii=1,nroot) 139 write(irest)(ptnorm_mp(ii),ii=1,nroot) 140 nloop = noconf 141 do jj = 1,nloop 142 write(irest)(ioconf(ii,jj),ii=1,nintpo) 143 enddo 144 write(istdo,'(a,i6,a,i6)') 145 & ' checkpointed at iconf = ',iconf,' of ',ncold 146c 147c close restart tape 148c 149 close(unit=irest,status='keep') 150 if(me.eq.0)call util_flush(istdo) 151c 152c delete other restart tape 153c 154 open(unit=irest,file=names(idfile),access='sequential', 155 & form='unformatted',status='unknown', 156 & err=90912) 157 close(unit=irest,status='delete') 158 itf = mtime() 159 endif 160c 161 call ga_sync() 162c 163 return 164c 16590911 call errquit('stool: error opening restart file',0, DISK_ERR) 16690912 call errquit('stool: error opening restart file',0, DISK_ERR) 167c 168 end 169C> @} 170