subroutine getwgt (ngfine,ngcoar) c c ***************************************************************** c c this subroutine gets the coarse group weighting c for each fine group c c input: c ngfine i number of groups in fine group structure, c i.e., number of groups in initial set c ngcoar i number of groups in coarse group structure, c i.e., number of groups in final set c c output: c ngf1 i first fine group to be used in collapse c ngf2 i last fine group to be used in collapse c nfng i(*) coarse group number corresponding to given c fine group c wgt r(*) weighting for each fine group for the c corresponding coarse group c c temporary: c wgt175 r(175) flux using vitamin-j weight for 175 groups c c ***************************************************************** c integer ngfine,ngcoar c include 'limit.h' include 'collap.h' integer itemp,jtemp,ktemp,ltemp real sum real flux(ngmax) c c 175 group vitamin-j weighting real wgt175(175), w175a(75),w175b(75),w175c(25) equivalence (wgt175( 1), w175a(1)), (wgt175(76),w175b(1)), 1 (wgt175(151), w175c(1)) data w175a / 8.924E-3, 1.257E-2, 2.211E-3, 2.211E-3, 2.211E-3, 1 2.212E-3, 2.211E-3, 2.211E-3, 2.211E-3, 2.211E-3, 2 2.211E-3, 2.211E-3, 2.211E-3, 2.211E-3, 2.211E-3, 3 2.212E-3, 2.211E-3, 2.211E-3, 2.211E-3, 2.211E-3, 4 2.211E-3, 2.211E-3, 3.139E-3, 5.786E-3, 1.024E-2, 5 1.814E-2, 3.210E-2, 5.684E-2, 9.729E-2, 1.399E-1, 6 1.963E-1, 2.754E-1, 3.864E-1, 5.421E-1, 7.605E-1, 7 1.037E+0, 4.649E-1, 4.895E-1, 2.543E-1, 2.609E-1, 8 5.427E-1, 5.712E-1, 6.014E-1, 9.623E-1, 1.779E+0, 9 2.023E+0, 2.291E+0, 1.490E+0, 1.041E+0, 2.785E+0, x 3.065E+0, 1.645E+0, 1.026E+0, 3.485E-1, 3.518E-1, 1 7.133E-1, 5.153E-1, 7.982E-1, 1.683E+0, 1.184E+0, 2 2.898E+0, 2.192E+0, 2.258E+0, 1.368E+0, 3.231E+0, 3 1.239E+0, 1.865E+0, 7.019E-1, 9.046E-1, 2.398E+0, 4 2.427E+0, 9.799E-1, 9.826E-1, 9.895E-1, 9.938E-1/ data w175b / 9.973E-1, 1.004E+0, 1.007E+0, 1.011E+0, 9.965E-1, 1 9.829E-1, 9.670E-1, 9.521E-1, 9.380E-1, 9.234E-1, 2 9.094E-1, 8.957E-1, 1.750E+0, 8.551E-1, 4.225E-1, 3 1.523E-1, 7.325E-2, 1.935E-1, 1.646E+0, 1.596E+0, 4 7.797E-1, 7.678E-1, 1.501E+0, 1.455E+0, 7.111E-1, 5 7.000E-1, 6.894E-1, 6.790E-1, 6.686E-1, 6.551E-1, 6 6.385E-1, 6.227E-1, 6.070E-1, 5.917E-1, 5.770E-1, 7 5.624E-1, 6.380E-1, 4.450E-1, 1.029E+0, 4.953E-1, 8 4.835E-1, 4.702E-1, 4.597E-1, 4.469E-1, 4.366E-1, 9 4.254E-1, 4.145E-1, 4.040E-1, 3.941E-1, 3.844E-1, x 3.747E-1, 3.651E-1, 3.559E-1, 2.323E-1, 1.148E-1, 1 5.691E-2, 5.706E-2, 2.245E-1, 3.298E-1, 3.216E-1, 2 3.135E-1, 3.011E-1, 2.848E-1, 2.691E-1, 4.953E-1, 3 4.428E-1, 3.959E-1, 1.820E-1, 1.666E-1, 1.476E-1, 4 1.307E-1, 1.158E-1, 1.025E-1, 9.083E-2, 5.470E-2/ data w175c / 2.574E-2, 7.126E-2, 6.311E-2, 5.590E-2, 4.951E-2, 1 4.386E-2, 3.884E-2, 3.440E-2, 3.047E-2, 2.458E-2, 2 1.789E-2, 1.301E-2, 9.492E-3, 3.725E-3, 3.191E-3, 3 2.121E-2, 4.841E-2, 8.349E-2, 6.358E-2, 2.152E-2, 4 5.205E-3, 8.204E-4, 2.687E-4, 2.035E-4, 4.785E-4/ c c check on size of arrays if (ngfine .gt. ngmax) go to 931 c c if (no collapsing desired) return if (ngfine .eq. ngcoar) return c c read coarse group structure c fine group number(i), coarse group number(i), weight(r) do 10 itemp = 1,ngfine 10 read (5,501) jtemp, nfng(itemp),flux(itemp) c c check that coarse group numbers are in increasing order if ((nfng(1) .lt. 0) .or. (nfng(1) .gt. 1)) go to 932 do 20 itemp = 2,ngfine if ((nfng(itemp) .lt. nfng(itemp-1)) .or. 1 (nfng(itemp) .gt. nfng(itemp-1)+1)) go to 933 20 continue c c if weight(i) is zero, c use Vitamin-J values if number of fine groups is 175 c otherwise, print error message and stop do 30 itemp = 1,ngfine if (flux(itemp) .eq. 0.) then if (ngfine .eq. 175) then flux(itemp) = wgt175(itemp) else go to 934 endif endif 30 continue c c find initial group do 40 itemp = 1,ngfine 40 if (nfng(itemp) .eq. 1) go to 41 go to 935 41 ngf1 = itemp c c find final group do 50 itemp = ngfine,ngf1,-1 if (nfng(itemp) .le. ngcoar) go to 51 50 continue itemp = ngf1 51 ngf2 = itemp if (nfng(ngf2) .lt. ngcoar) go to 936 c c calculate absolute weightings do 61 itemp = 1,ngf1-1 61 wgt(itemp) = 0.0 do 62 itemp = ngf2+1,ngfine 62 wgt(itemp) = 0.0 ktemp = 1 itemp = ngf1 65 jtemp = itemp sum = 0. 70 sum = sum + flux(jtemp) jtemp = jtemp+1 if (jtemp .gt. ngf2) go to 71 if (nfng(jtemp) .eq. ktemp) go to 70 71 jtemp = jtemp-1 do 72 ltemp=itemp,jtemp 72 wgt(ltemp) = flux(ltemp)/sum ktemp = ktemp+1 itemp = jtemp+1 if (itemp .le. ngf2) go to 65 80 continue c c return return c c error stops 931 write (6,631) ngfine,ngmax 631 format (' PROGRAMMING ERROR, too many fine groups = ',i5, 1 ' max = ',i5) stop 31 932 write (6,632) nfng(1) 632 format (' INPUT ERROR, first coarse group must be 0 or 1, not ', 1 i5) stop 32 933 write (6,633) itemp,nfng(itemp-1),nfng(itemp) 633 format (' INPUT ERROR, for fine group = ',i5,' coarse groups' 1 ' must be differ by at most 1' / 10x,'values are =',2i5) stop 33 934 write (6,634) itemp,ngfine,175 634 format (' INPUT ERROR, for fine group = ',i5,' weight = 0.' / 1 ' However, number of groups =',i5, 2 ' does not equal',i5) stop 34 935 write (6,635) 635 format (' INPUT ERROR, no coarse group is nonzero') stop 35 936 write (6,636) 636 format (' INPUT ERROR, not all coarse group defined') stop 36 c 501 format (2i5,f10.0) end