c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c cc sftype routine ccc c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine sftype( rho , tem , tf , fityp , gamma , nn ) implicit real*8 (a-h,o-z) real*8 mue integer fityp common /nika2/ a , z , ic dimension tem(nn), rho(nn), tf(nn) , fityp(nn), gamma(nn) c mue = a/z do 100 i = 1, ic if ( a .eq. 4.d0) & then c --- For He -------- tflim = 1.d-2*tf(i) else tflim = 3.d-1*tf(i) endif c ------------------- if (tem(i) .gt. tflim) & then c ------ Weakly Degenerate ---------- fityp( i ) = 1 else t8 = tem( i )/1.d8 rho6 = rho( i )*mue/1.d6 gamma( i ) & = 2.275d-1*Z**2.d0/t8*( rho6/a )**( 1.d0/3.d0 ) c if( gamma( i ) .lt. 180.d0 ) & then c ------ Liquid Metal State --------- fityp( i ) = 2 else c ------ Crystalline Lattice Stale --------- fityp( i ) = 3 endif endif ttl = tem( i )/tflim c write (77,78) gamma( i ) ,ttl ,fityp( i ) c78 format(3x,'gamma, fityp = ',1p2d12.3,i4) 100 continue return end