subroutine select(xx,tt,vv,epsilon,kk,nc) implicit none include 'dimenfile' include 'crate' include 'comcsolve' include 'comlink' include 'cdeuter' integer*4 i, k, kk, nc, maxk, i1,i2,i3,i4,i5,i6 real*8 xx(ndim,kdm),tt(2,kdm),dd(2,kdm),vv(2,kdm) real*8 rlmax,epsilon,ysig, yysig, y3sig character*5 blank data blank/' '/ c-------------------------------------------------------------------- c.. get abundaces (mole fractions) do k = 1, ndim-1 y(k) = xx(k,kk) x(k) = xx(k,kk)*dble( nn(k) + nz(k) ) enddo y(ndim) = 0.0d0 do k = 1, ndim-1 y(ndim) = y(ndim) + xx(k,kk)*dble(nz(k) ) enddo if( vv(nc,kk) .gt. 0.0d0 )then dd(nc,kk) = 1.0d0/vv(nc,kk) else write(*,*)'select: specific volume ',vv(nc,kk),nc,kk stop endif if( tt(nc,kk) .gt. tburnlo*1.0d9 )then c.. get flows for reaction links do k = k1deck(1),k2deck(1) i1 = nrr(1,k) rlink(k) = y(i1)*sig(k) enddo do k = k1deck(2),k2deck(2) i1 = nrr(1,k) ysig = y(i1)*sig(k) rlink(k) = ysig enddo do k = k1deck(3),k2deck(3) i1 = nrr(1,k) ysig = y(i1)*sig(k) rlink(k) = ysig enddo do k = k1deck(4),k2deck(4) i1 = nrr(1,k) i2 = nrr(2,k) yysig = y(i1)*y(i2)*sig(k) rlink(k) = yysig enddo do k = k1deck(5),k2deck(5) i1 = nrr(1,k) i2 = nrr(2,k) yysig = y(i1)*y(i2)*sig(k) rlink(k) = yysig enddo do k = k1deck(6),k2deck(6) i1 = nrr(1,k) i2 = nrr(2,k) yysig = y(i1)*y(i2)*sig(k) rlink(k) = yysig enddo do k = k1deck(7),k2deck(7) i1 = nrr(1,k) i2 = nrr(2,k) yysig = y(i1)*y(i2)*sig(k) rlink(k) = yysig enddo do k = k1deck(8),k2deck(8) i1 = nrr(1,k) ccccccccccccccccccccccccccccccccccccccccccccccccccccc c if( i5 .eq. 0 )then y3sig = y(i1)**3*sig(k)/3.0d0 rlink(k) = y3sig c else c y3sig = y(i1)**3*sig(k)/3.0d0 c rlink(k) = y3sig c endif enddo c.. fastest reaction link rlmax = 0.0d0 do k = 1, ireac if( rlink(k) .gt. rlmax )then rlmax = rlink(k) maxk = k endif enddo write(*,'(a15,2a8,a12)')'fastest rate','index','deck', 1 'reaction' write(*,'(1pe15.3,2i8,6a5)')rlmax,maxk,ideck(maxk), 1 (rname(i,maxk),i=1,6) write(*,'(/2(a15,1pe11.3),a15,i5/)')'T(K)',tt(nc,kk), 1 'rho(g/cc)',dd(nc,kk),'zone',kk c.. edited list of rates write(*,'(a4,a2,a10,12x,a8,22x,a6, 1 6(a7,2x))') 'i ','dk','flow','reaction','source','sig', 2 'y1','y2' do k = 1, ireac in(k) = 0 ldot(k) = 1 if( rlink(k) .gt. epsilon*rlmax )then if( ideck(k) .eq. 1 )then i1 = nrr(1,k) i2 = nrr(2,k) rlink(k) = y(i1)*sig(k) ldot(k) = 4 in(k) = ideck(k) x1(1,k) = nn(i1) y1(1,k) = nz(i1) x1(2,k) = nn(i2) y1(2,k) = nz(i2) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p6e9.2)') 1 k,ideck(k),rlink(k),blank, 1 xid(i1), " --> ", xid(i2),blank,blank,blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1) elseif( ideck(k) .eq. 2 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) rlink(k) = y(i1)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i1) y1(1,k) = nz(i1) x1(2,k) = nn(i3) y1(2,k) = nz(i3) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,ideck(k),rlink(k),blank, 1 xid(i1), " --> ", xid(i2), xid(i3),blank, 1 blank,rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1) elseif( ideck(k) .eq. 3 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) i4 = nrr(4,k) rlink(k) = y(i1)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i1) y1(1,k) = nz(i1) x1(2,k) = nn(i4) y1(2,k) = nz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,ideck(k),rlink(k),blank, 1 xid(i1), " --> ", xid(i2), xid(i3), xid(i4), 1 blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1) elseif( ideck(k) .eq. 4 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) rlink(k) = y(i1)*y(i2)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i2) y1(1,k) = nz(i2) x1(2,k) = nn(i3) y1(2,k) = nz(i3) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) if( rlkh(k).eq.' ec' .or. rlkh(k).eq.'bet+')then ldot(k) = 4 endif write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), " --> ", xid(i3), 1 blank,blank,blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2) elseif( ideck(k) .eq. 5 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) i4 = nrr(4,k) rlink(k) = y(i1)*y(i2)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i2) y1(1,k) = nz(i2) x1(2,k) = nn(i4) y1(2,k) = nz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x)a4,2a1, 1 1p5e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), " --> ", xid(i3),xid(i4), 1 blank,blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2) elseif( ideck(k) .eq. 6 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) i4 = nrr(4,k) i5 = nrr(5,k) rlink(k) = y(i1)*y(i2)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i2) y1(1,k) = nz(i2) x1(2,k) = nn(i5) y1(2,k) = nz(i5) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p5e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), " --> ", xid(i3),xid(i4), 1 xid(i5),blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2) elseif( ideck(k) .eq. 7 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) i4 = nrr(4,k) i5 = nrr(5,k) i6 = nrr(6,k) rlink(k) = y(i1)*y(i2)*sig(k) in(k) = ideck(k) x1(1,k) = nn(i2) y1(1,k) = nz(i2) x1(2,k) = nn(i6) y1(2,k) = nz(i6) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), " --> ", xid(i3),xid(i4), 1 xid(i5),xid(i6), 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2) elseif( ideck(k) .eq. 8 )then i1 = nrr(1,k) i2 = nrr(2,k) i3 = nrr(3,k) i4 = nrr(4,k) i5 = nrr(5,k) if( i5 .eq. 0 )then rlink(k) = y(i1)**3*sig(k)/3.0d0 in(k) = ideck(k) x1(1,k) = nn(i3) y1(1,k) = nz(i3) x1(2,k) = nn(i4) y1(2,k) = nz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p5e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), xid(i3), " --> ",xid(i4), 1 blank,blank,rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2),y(i3) else rlink(k) = y(i1)**3*sig(k)/3.0d0 in(k) = ideck(k) x1(1,k) = nn(i3) y1(1,k) = nz(i3) x1(2,k) = nn(i5) y1(2,k) = nz(i5) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p6e9.2)') 1 k,ideck(k),rlink(k), 1 xid(i1), xid(i2), xid(i3), " --> ",xid(i4), 1 xid(i5),blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),y(i1),y(i2),y(i3) endif else stop'select' endif endif enddo write(*,*)' nucleon fractions' do k = 1, ndim/5*5, 5 write(*,'(5(a5,1pe11.3))')xid(k),x(k),xid(k+1),x(k+1), 1 xid(k+2),x(k+2),xid(k+3),x(k+3),xid(k+4),x(k+4) enddo do k = ndim/5*5+1,ndim if( k .ne. ndim )then write(*,'(5(a5,1pe11.3))')xid(k),x(k) else write(*,'(5(a5,1pe11.3))')xid(k),y(k) endif enddo else c.. get flows for reaction links do k = l1deck(1),l2deck(1) i1 = lonrr(1,k) rlink(k) = ylo(i1)*sig(k) enddo do k = l1deck(2),l2deck(2) i1 = lonrr(1,k) ysig = ylo(i1)*sig(k) rlink(k) = ysig enddo do k = l1deck(3),l2deck(3) i1 = lonrr(1,k) ysig = ylo(i1)*sig(k) rlink(k) = ysig enddo do k = l1deck(4),l2deck(4) i1 = lonrr(1,k) i2 = lonrr(2,k) yysig = ylo(i1)*ylo(i2)*sig(k) rlink(k) = yysig enddo do k = l1deck(5),l2deck(5) i1 = lonrr(1,k) i2 = lonrr(2,k) yysig = ylo(i1)*ylo(i2)*sig(k) rlink(k) = yysig enddo do k = l1deck(6),l2deck(6) i1 = lonrr(1,k) i2 = lonrr(2,k) yysig = ylo(i1)*ylo(i2)*sig(k) rlink(k) = yysig enddo do k = l1deck(7),l2deck(7) i1 = lonrr(1,k) i2 = lonrr(2,k) yysig = ylo(i1)*ylo(i2)*sig(k) rlink(k) = yysig enddo do k = l1deck(8),l2deck(8) i1 = lonrr(1,k) ccccccccccccccccccccccccccccccccccccccccccccccccccccc c if( i5 .eq. 0 )then y3sig = ylo(i1)**3*sig(k)/3.0d0 rlink(k) = y3sig c else c y3sig = ylo(i1)**3*sig(k)/3.0d0 c rlink(k) = y3sig c endif enddo c.. fastest reaction link rlmax = 0.0d0 do k = 1, l2deck(8) if( rlink(k) .gt. rlmax )then rlmax = rlink(k) maxk = k endif enddo write(*,'(a15,a8,a12)')'fastest rate','index','reaction' write(*,'(1pe15.3,2i8,6a5)')rlmax,maxk,lodeck(maxk), 1 (rname(i,lorr(maxk)),i=1,6) write(*,'(/2(a15,1pe11.3),a15,i5/)')'T(K)',tt(nc,kk), 1 'rho(g/cc)',dd(nc,kk),'zone',kk c.. edited list of rates write(*,'(a4,a2,a10,12x,a8,22x,a6, 1 6(a7,2x))') 'i ','dk','flow','reaction','source','sig', 2 'y1','y2' do k = 1, l2deck(8) in(k) = 0 ldot(k) = 1 if( rlink(k) .gt. epsilon*rlmax )then if( lodeck(k) .eq. 1 )then i1 = lonrr(1,k) i2 = lonrr(2,k) rlink(k) = ylo(i1)*sig(k) ldot(k) = 4 in(k) = lodeck(k) x1(1,k) = lon(i1) y1(1,k) = loz(i1) x1(2,k) = lon(i2) y1(2,k) = loz(i2) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p6e9.2)') 1 k,lodeck(k),rlink(k),blank, 1 xidlo(i1), " --> ", xidlo(i2),blank,blank, 1 blank,rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1) elseif( lodeck(k) .eq. 2 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) rlink(k) = ylo(i1)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i1) y1(1,k) = loz(i1) x1(2,k) = lon(i3) y1(2,k) = loz(i3) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,lodeck(k),rlink(k),blank, 1 xidlo(i1), " --> ", xidlo(i2), xidlo(i3), 1 blank,blank,rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1) elseif( lodeck(k) .eq. 3 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) i4 = lonrr(4,k) rlink(k) = ylo(i1)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i1) y1(1,k) = loz(i1) x1(2,k) = lon(i4) y1(2,k) = loz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,lodeck(k),rlink(k),blank, 1 xidlo(i1), " --> ", xidlo(i2), xidlo(i3), 1 xidlo(i4),blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1) elseif( lodeck(k) .eq. 4 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) rlink(k) = ylo(i1)*ylo(i2)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i2) y1(1,k) = loz(i2) x1(2,k) = lon(i3) y1(2,k) = loz(i3) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) if( rlkh(k).eq.' ec' .or. rlkh(k).eq.'bet+')then ldot(k) = 4 endif write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), " --> ", xidlo(i3), 1 blank,blank,blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2) elseif( lodeck(k) .eq. 5 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) i4 = lonrr(4,k) rlink(k) = ylo(i1)*ylo(i2)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i2) y1(1,k) = loz(i2) x1(2,k) = lon(i4) y1(2,k) = loz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x)a4,2a1, 1 1p5e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), " --> ", xidlo(i3), 1 xidlo(i4),blank,blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2) elseif( lodeck(k) .eq. 6 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) i4 = lonrr(4,k) i5 = lonrr(5,k) rlink(k) = ylo(i1)*ylo(i2)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i2) y1(1,k) = loz(i2) x1(2,k) = lon(i5) y1(2,k) = loz(i5) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p5e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), " --> ", xidlo(i3), 1 xidlo(i4),xidlo(i5),blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2) elseif( lodeck(k) .eq. 7 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) i4 = lonrr(4,k) i5 = lonrr(5,k) i6 = lonrr(6,k) rlink(k) = ylo(i1)*ylo(i2)*sig(k) in(k) = lodeck(k) x1(1,k) = lon(i2) y1(1,k) = loz(i2) x1(2,k) = lon(i6) y1(2,k) = loz(i6) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p7e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), " --> ", xidlo(i3), 1 xidlo(i4),xidlo(i5),xidlo(i6), 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2) elseif( lodeck(k) .eq. 8 )then i1 = lonrr(1,k) i2 = lonrr(2,k) i3 = lonrr(3,k) i4 = lonrr(4,k) i5 = lonrr(5,k) if( i5 .eq. 0 )then rlink(k) = ylo(i1)**3*sig(k)/3.0d0 in(k) = lodeck(k) x1(1,k) = lon(i3) y1(1,k) = loz(i3) x1(2,k) = lon(i4) y1(2,k) = loz(i4) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p5e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), xidlo(i3), " --> ", 1 xidlo(i4), 1 blank,blank,rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2),ylo(i3) else rlink(k) = ylo(i1)**3*sig(k)/3.0d0 in(k) = lodeck(k) x1(1,k) = lon(i3) y1(1,k) = loz(i3) x1(2,k) = lon(i5) y1(2,k) = loz(i5) ltyp(k) = 10 + log10( rlink(k)/rlmax ) ltyp(k) = max0(ltyp(k),0) write(*,'(i4,i2,1pe10.2,7(a5,1x),a4,2a1, 1 1p6e9.2)') 1 k,lodeck(k),rlink(k), 1 xidlo(i1), xidlo(i2), xidlo(i3), " --> ", 1 xidlo(i4),xidlo(i5),blank, 1 rlkh(k),rnr(k),rvw(k), 1 sig(k),ylo(i1),ylo(i2),ylo(i3) endif else stop'select' endif endif enddo write(*,*)' nucleon fractions' do k = 1, ndim/5*5, 5 write(*,'(5(a5,1pe11.3))')xid(k),x(k), 1 xid(k+1),x(k+1), 1 xid(k+2),x(k+2),xid(k+3),x(k+3), 1 xid(k+4),x(k+4) enddo do k = ndim/5*5+1,ndim if( k .ne. ndim )then write(*,'(5(a5,1pe11.3))')xid(k),x(k) else write(*,'(5(a5,1pe11.3))')xid(k),y(k) endif enddo endif end