| 1 | subroutine res_index(skew,mynorder,myn1,myn2,indexa,mynres) |
|---|
| 2 | use resindexfi |
|---|
| 3 | implicit none |
|---|
| 4 | logical skew |
|---|
| 5 | integer mynorder,myn1,myn2,indexa(mnres,4),mynres |
|---|
| 6 | integer i,j,n1,n2,n3,n4 |
|---|
| 7 | !--------------------------------------------------------------------- |
|---|
| 8 | do i=1,mnres |
|---|
| 9 | do j=1,4 |
|---|
| 10 | indexa(i,j)=0 |
|---|
| 11 | enddo |
|---|
| 12 | enddo |
|---|
| 13 | if(mynorder.le.0.or.mynorder.gt.mymorder) then |
|---|
| 14 | print*," Routine res_index cannot fill index array!" |
|---|
| 15 | print*," mynorder variable out of range (1 -- ",mymorder,")" |
|---|
| 16 | return |
|---|
| 17 | endif |
|---|
| 18 | n1=mynorder |
|---|
| 19 | n2=0 |
|---|
| 20 | n3=0 |
|---|
| 21 | n4=0 |
|---|
| 22 | mynres=0 |
|---|
| 23 | call myindex(skew,mynres,myn1,myn2,n1,n2,n3,n4,indexa) |
|---|
| 24 | if(mynres.gt.mnres) goto 999 |
|---|
| 25 | 1 n1=n1-1 |
|---|
| 26 | if(n1.lt.0) return |
|---|
| 27 | n2=mynorder-n1 |
|---|
| 28 | if(n2.gt.n1) then |
|---|
| 29 | n2=n1 |
|---|
| 30 | elseif(n2.eq.n1.and.n1+n2.eq.mynorder) then |
|---|
| 31 | n2=n2-1 |
|---|
| 32 | else |
|---|
| 33 | call myindex(skew,mynres,myn1,myn2,n1,n2,n3,n4,indexa) |
|---|
| 34 | if(mynres.gt.mnres) goto 999 |
|---|
| 35 | n2=n2-1 |
|---|
| 36 | endif |
|---|
| 37 | 2 continue |
|---|
| 38 | n3=mynorder-n1-n2 |
|---|
| 39 | n4=0 |
|---|
| 40 | call myindex(skew,mynres,myn1,myn2,n1,n2,n3,n4,indexa) |
|---|
| 41 | if(mynres.gt.mnres) goto 999 |
|---|
| 42 | if(n3.gt.0) then |
|---|
| 43 | 3 n3=n3-1 |
|---|
| 44 | n4=n4+1 |
|---|
| 45 | if((n1.eq.0.or.n1.eq.n2).and.(n3.le.n4)) then |
|---|
| 46 | if(n2.eq.0) then |
|---|
| 47 | n3=0 |
|---|
| 48 | n4=0 |
|---|
| 49 | goto 1 |
|---|
| 50 | else |
|---|
| 51 | n2=n2-1 |
|---|
| 52 | goto 2 |
|---|
| 53 | endif |
|---|
| 54 | endif |
|---|
| 55 | call myindex(skew,mynres,myn1,myn2,n1,n2,n3,n4,indexa) |
|---|
| 56 | if(mynres.gt.mnres) goto 999 |
|---|
| 57 | if(n3.gt.0) then |
|---|
| 58 | goto 3 |
|---|
| 59 | else if(n2.eq.0) then |
|---|
| 60 | n3=0 |
|---|
| 61 | n4=0 |
|---|
| 62 | goto 1 |
|---|
| 63 | else |
|---|
| 64 | n2=n2-1 |
|---|
| 65 | goto 2 |
|---|
| 66 | endif |
|---|
| 67 | endif |
|---|
| 68 | 999 continue |
|---|
| 69 | return |
|---|
| 70 | end subroutine res_index |
|---|
| 71 | |
|---|
| 72 | subroutine myindex(skew,mynres,myn1,myn2,n1,n2,n3,n4,indexa) |
|---|
| 73 | use resindexfi |
|---|
| 74 | implicit none |
|---|
| 75 | logical odd |
|---|
| 76 | logical skew |
|---|
| 77 | integer mynres,myn1,myn2,n1,n2,n3,n4,indexa(mnres,4) |
|---|
| 78 | integer no,nd1,nd2 |
|---|
| 79 | odd=.false. |
|---|
| 80 | no=n1+n2+n3+n4 |
|---|
| 81 | if(mod(no,2).ne.0) odd=.true. |
|---|
| 82 | nd1=n1-n2 |
|---|
| 83 | nd2=n3-n4 |
|---|
| 84 | if(.not.skew) then |
|---|
| 85 | if(odd.and.(nd1.eq.0.or.mod(nd1,2).eq.0)) return |
|---|
| 86 | if(.not.odd.and.mod(nd1,2).ne.0) return |
|---|
| 87 | else |
|---|
| 88 | if(odd.and.mod(nd1,2).ne.0) return |
|---|
| 89 | if(.not.odd.and.(nd1.eq.0.or.mod(nd1,2).eq.0)) return |
|---|
| 90 | endif |
|---|
| 91 | if((myn1.eq.0.and.myn2.eq.0).or.((myn1.eq.nd1).and.(myn2.eq.nd2))) then |
|---|
| 92 | mynres=mynres+1 |
|---|
| 93 | if(mynres.gt.mnres) then |
|---|
| 94 | print*," Maximum number: ",mnres," of resonance too small" |
|---|
| 95 | return |
|---|
| 96 | endif |
|---|
| 97 | indexa(mynres,1)=n1 |
|---|
| 98 | indexa(mynres,2)=n2 |
|---|
| 99 | indexa(mynres,3)=n3 |
|---|
| 100 | indexa(mynres,4)=n4 |
|---|
| 101 | endif |
|---|
| 102 | return |
|---|
| 103 | end subroutine myindex |
|---|
![(please configure the [header_logo] section in trac.ini)](/PSPA/chrome/site/pspa.gif)
