Документ взят из кэша поисковой машины. Адрес оригинального документа : http://cryst.geol.msu.ru/odss/manual_r.pdf
Дата изменения: Mon Jan 14 11:28:46 2008
Дата индексирования: Mon Oct 1 19:38:16 2012
Кодировка:

ODSS (Ordered-Disordered-Solid-Solution) Ver.1. - relax

..,..,.. urusov@geol.msu.ru

© © .., .., .. , 2007.

1. 2. 3. 4. 5.

3 4 5 9 12

1.
, , . , , , « » . ( P1). .

1 ) ; ) ( ).

(i=1) 1-j R1-j R'1-j R1-j - R' (,
1-j

1)

1 =

j =1, n

( R1- j - R1' - j ) 2 / n , n ( ,

, . 1 ( 18 1). , , . (site compliance) cs, (Dollase, 1980). ( ) ( ) . , Fe-O Mg-O 0,058 е, , Fe-O MgO:Fe 0,03 е , 52% , .. cs = 52%. , .. FeO:Mg, Mg-O 0,058 е , Fe-O, 0,03 е , .. cs FeO 52%.

[Dollase W.A. Phys. Chem. Minerals 1980, V6, 295-304]

2.
input, . ( ), GULP ( ). output.

input. ( 4*4*1 192 288 , - 96 Cr 96 Al, BINAR. GULP).
19.40838 19.40838 13.2866 90.0 90.0 120. - a,b,c,alpha,beta,gamma 19.407069 19.408045 13.298317 90.01302 89.99442 120.00543 a,b,c,alpha,beta,gamma ------------------------------------------------------3.5 - , 2.2 - 3 - - Cr - Al - O - 1.99055 - 1- ( Cr-O ) 1.91175 - 2- ( Al-O ) ------------------------------------------------------0 - ( GULPa) (0 - , 1 - ) 0 - ( GULPa) (0 - , 1 - ) 0 - ( GULPa) (0 - , 1 - ) 0 - ( GULPa) (0 - , 1 - ) 0 - ( GULPa) (0 - , 1 - ) 1 - (0 - , 1 - ) 1 - W(i) (0 - , 1 - ) 1 - W(i) (0 - , 1 - ) 1 - W(i) (0 - , 1 - ) 1 - ------------------------------------------------------480 - - ( ) 1 Cr1 0.000000 0.000000 0.352200 2 Cr2 0.000000 0.000000 0.647800 3 Al3 0.000000 0.000000 0.147800 4 Al4 0.000000 0.000000 0.852200 5 Al11 0.083325 0.166675 0.018900 ********************************** ********************************** 479 O479 0.916675 0.756800 0.083300 480 O480 0.993200 0.909850 0.083300 1 Cr1 0.000000 0.000000 0.352200 2 Cr2 0.000886 0.000732 0.648659 3 Al3 0.000077 0.999545 0.147911 4 Al4 0.000805 0.998969 0.852098 5 Al11 0.084142 0.164744 0.018168 ********************************** ********************************** 479 O479 0.915000 0.757170 0.080479 480 O480 0.991268 0.909384 0.084423

3.
output. : - - - - W(i) , , - output .
W : no. - W 1 Cr463 0.00075 28.34 % 2 Cr41 0.00076 16.60 % 3 Cr64 0.00079 28.71 % 4 Cr191 0.00080 20.49 % 5 Cr101 0.00087 22.19 % 6 Cr221 0.00096 26.54 % 7 Cr52 0.00107 15.87 % 8 Cr202 0.00107 23.78 % 9 Cr371 0.00116 27.79 % ***************** ****************** Cr : W 0.00196 0.00063 ***************** ****************** Al : W 0.00191 0.00074 ***************** ****************** O : W 0.00380 0.00600

4.

w (Cr Al)
0,012 0,010 0,008 0,006 0,004 0,002 0,000 0 12 24 36 48 60 72 84 96

(%) r Al
60 50 40 30 20 10 0 0 12 24 36 48 60 72 84 96

0,045 0,040 0,035 0,030 0,025 0,020 0,015 0,010 0,005 0,000 0 36 72 108 144 180 216 252 288

w ()

0, 005

0, 004

0, 003

0, 002

0, 001

0 2, 2 2, 7 3, 2 3,7 4,2 4,7 5, 2 5,7 6,2 6,7 7,2 7, 7

5. RELAX
module commonmod parameter (n_max = 1000, nmax_in_sphere = 100,max_atomov = 10) parameter (PI180=3.141592653/180.) character text character(2) atom_name character(6) name_atoms character(6) name_XYZ character(6) name_sort(n_max) integer N_atoms,num_W,num_atom_name integer IP(n_max) integer print_coord,print_coordg,print_coord_sphera,print_wi_all,print_wi_vozr,print_wi_name integer print_coord_atom,print_coord_atom_g,print_coordg_modif,print_statistica real a,b,c,alpha,beta,gamma,ag,bg,cg,alphag,betag,gammag,Radius,Radius_okrugenija real X0,Y0,Z0,X_NEW,Y_NEW,Z_NEW real W(n_max),CC(n_max) real XYZ,XYZ_NEW real rast_in_sphere(n_max,nmax_in_sphere),rast_in_sphere_new(n_max,nmax_in_sphere) real statistika(n_max) real D_kation_anion common / name /atom_name(max_atomov),name_atoms(n_max),name_XYZ(27*n_max) common / N_atoms /N_atoms,num_atom_name common / abc /a,b,c,alpha,beta,gamma,ag,bg,cg,alphag,betag,gammag,Radius,Radius_okrugenija common / coord /X0(n_max),Y0(n_max),Z0(n_max),X_NEW(n_max),Y_NEW(n_max),Z_NEW(n_max) common / coord2 /XYZ(27*n_max,3),XYZ_NEW(27*n_max,3) common / print_all /print_coord,print_coordg,print_coord_sphera,print_wi_all,print_wi_vozr,print_wi_name & ,print_coord_atom,print_coord_atom_g,print_coordg_modif,print_statistica common / D / D_kation_anion(max_atomov) end module commonmod

! ! ! ! ! ! ! ! !

n_max = 1000 - . - nmax_in_sphere = 100 - . - Radius - X0,Y0,Z0 - GULPa name_atoms(n_max) - name_XYZ(27*n_max) - atom_name(10) - X_NEW,Y_NEW,Z_NEW - GULPa XYZ - GULPa

! XYZ_NEW - GULPa

!**************************************************************************** program main call open_read call razmnojenie call relax call close_stop end subroutine razmnojenie use commonmod m=0 do L=1,N_atoms do i=-1,1 do j=-1,1 do k=-1,1 m=m+1 XYZ(m,1) = X0(L) + i*1. XYZ(m,2) = Y0(L) + j*1. XYZ(m,3) = Z0(L) + k*1. XYZ_NEW(m,1) = X_NEW(L) + i*1. XYZ_NEW(m,2) = Y_NEW(L) + j*1. XYZ_NEW(m,3) = Z_NEW(L) + k*1. name_XYZ(m) = name_atoms(L) end do end do end do end do if(print_coord == 1)then write(2,'(//"------------- ( GULPa) --")//') m=0 do L=1,N_atoms do i=-1,1 do j=-1,1 do k=-1,1 m=m+1 write(2,'(5x,i8,3x,a6,3x,3(f8.5,2x))')m,name_XYZ(m),XYZ(m,1),XYZ(m,2),XYZ(m,3) end do

------------------

end end end end

do do do if

if(print_coordg == 1)then write(2,'(//"------------- ( GULPa) -------------------")//') m=0 do L=1,N_atoms do i=-1,1 do j=-1,1 do k=-1,1 m=m+1 write(2,'(5x,i8,3x,a6,3x,3(f8.5,2x))')m,name_XYZ(m),XYZ_NEW(m,1),XYZ_NEW(m,2),XYZ_N EW(m,3) end do end do end do end do end if return end subroutine relax use commonmod Radius_2 = Radius*Radius a2=a*a b2=b*b c2=c*c ab=2*a*b*cos(gamma*PI180) ac=2*a*c*cos(beta*PI180) bc=2*b*c*cos(alpha*PI180) a2g=ag*ag b2g=bg*bg c2g=cg*cg abg=2*ag*bg*cos(gammag*PI180) acg=2*ag*cg*cos(betag*PI180) bcg=2*bg*cg*cos(alphag*PI180) ! ******************************************************** ! delta_D = 1./(D_kation_anion(1) - D_kation_anion(2)) if(print_coord_sphera == 1)&

write(2,'(//"------------- do i=1,N_atoms s = 0. s_okrug = 0. n_okrug = 0 num_W = 0 IP(i) = i

--------------------")//')

if(print_coord_sphera == 1)& write(2,'(//"--------------------------------------------------------------------------------------")/') if(print_coord_sphera == 1)& write(2,'(/5x,"no.,,. - ",5x,i4,3x,a6,3x,3(f8.5,2x)//)//')& i,name_atoms(i),X0(i),Y0(i),Z0(i) if(print_coord_sphera == 1)& write(2,'(/" .")/') if(print_coord_sphera == 1)& write(2,'(/" no.,,.( ), , delta .")/') do j=1,27*N_atoms p = XYZ(j,1) - X0(i) q = XYZ(j,2) - Y0(i) r = XYZ(j,3) - Z0(i) if(abs(p) < 0.0001 .and. abs(q) < 0.0001 .and. abs(r) < 0.0001)cycle pp=p*p qq=q*q rr=r*r rast_in_sphere_2 = pp*a2+qq*b2+rr*c2+p*q*ab+p*r*ac+q*r*bc if(rast_in_sphere_2 > Radius_2)cycle ! ! write(2,'(5x,"X0,Y0,Z0=",2x,3(f8.5,2x))')X0(i),Y0(i),Z0(i) write(2,'(5x,"XYZ=",2x,3(f8.5,2x))')(XYZ(j,l),l=1,3) sqrt_rast_in_sphere = sqrt(rast_in_sphere_2)

p = XYZ_NEW(j,1) - X_NEW(i) q = XYZ_NEW(j,2) - Y_NEW(i) r = XYZ_NEW(j,3) - Z_NEW(i) pp=p*p qq=q*q rr=r*r sqrt_rast_in_sphere_new = sqrt(pp*a2g+qq*b2g+rr*c2g+p*q*abg+p*r*acg+q*r*bcg) delta = abs( sqrt_rast_in_sphere - sqrt_rast_in_sphere_new )

if( sqrt_rast_in_sphere <= Radius_okrugenija)then s_okrug = s_okrug + sqrt_rast_in_sphere_new n_okrug = n_okrug + 1 end if if(print_coord_sphera == 1)& write(2,'(5x,i8,3x,a6,3x,3(f8.5,2x),5x,f8.3,5x,e14.4)')& j,name_XYZ(j),(XYZ_new(j,l),l=1,3), sqrt_rast_in_sphere_new,delta ! write(2,'(5x,"X_NEW,Y_NEW,Z_NEW=",2x,3(f8.5,2x))')X_NEW(i),Y_NEW(i),Z_NEW(i ) ! write(2,'(5x,"XYZ_NEW=",2x,3(f8.5,2x))')(XYZ_NEW(j,l),l=1,3) delta = delta*delta num_W = num_W + 1 s = s + delta end do ! j W(i) = s/num_W s_okrug = s_okrug / n_okrug if(name_atoms(i)(1:2)==atom_name(1))CC(i) = 100*abs((s_okrug D_kation_anion(1))*delta_D) if(name_atoms(i)(1:2)==atom_name(2))CC(i) = 100*abs((s_okrug D_kation_anion(2))*delta_D) ! if(name_atoms(j)(1:1)==atom_name(num_atom_name))C(i) = 100*abs((s_okrug D_kation_anion(1))*delta_D) end do ! i if(print_wi_all == 1)then write(2,'(///2x," no. - W "/)') do i=1,N_atoms write(2,'(1x,i5,7x,a6,10x,f10.5,5x,f6.2," %")')i,name_atoms(i),W(i),CC(i) end do end if

call SORTIROVKA(W,N_atoms,IP) if(print_wi_vozr == 1)then write(2,'(///2x," W"/)') write(2,'(/2x," no. - W "/)') do i=1,N_atoms j = IP(i)

write(2,'(1x,i5,7x,a6,10x,f10.5,5x,f6.2," %")')i,name_atoms(j),W(i),CC(j) end do end if if(print_wi_name == 1)then write(2,'(///2x," W :"/)') write(2,'(/2x," no. - W end if

"/)')

do k=1,num_atom_name-1 L=0 if(print_wi_name == 1)write(2,'(/)') do i=1,N_atoms j = IP(i) if(name_atoms(j)(1:2)==atom_name(k))then L=L+1 statistika(L) = W(i) if(print_wi_name == 1)write(2,'(1x,i5,7x,a6,10x,f10.5,5x,f6.2," %")')L,name_atoms(j),W(i),CC(j) end if end do if(print_statistica == 1)then s = 0. do is = 1,L s = s + statistika(is) end do s = s/L sigma = 0. do is = 1,L sigma = sigma + (s - statistika(is))**2 end do sigma = sqrt(sigma/(L-1)) write(2,'(//)') write(2,'(2x," ",1x,a6," : "," W - ",f10.5,3x," ",f10.5)')atom_name(k),s,sigma write(2,'(/)') end if end do if(print_wi_name == 1)write(2,'(/)') L=0 do i=1,N_atoms j = IP(i) if(name_atoms(j)(1:1)==atom_name(num_atom_name))then L=L+1 statistika(L) = W(i) if(print_wi_name == 1)write(2,'(1x,i5,7x,a6,10x,f10.5,5x,f5.2," %")')L,name_atoms(j),W(i),CC(j)

end if end do if(print_statistica == 1)then s = 0. do is = 1,L s = s + statistika(is) end do s = s/L sigma = 0. do is = 1,L sigma = sigma + (s - statistika(is))**2 end do sigma = sqrt(sigma/(L-1)) write(2,'(//)') write(2,'(2x," ",1x,a6," : "," W - ",f10.5,3x," ",f10.5)')atom_name(k),s,sigma write(2,'(/)') end if

return end SUBROUTINE SORTIROVKA(A,N,IP) DIMENSION A(1),IP(1),IU(21),IL(21) INTEGER N,IP,IU,IL,LA,I,M,J,K,IJ,IT,L,ITT REAL A,R1,R2,R3,R4,T,TT,R DATA R1/3.75E-01/,R2/5.898437E-01/,R3/3.90625E-02/,R4/2.1875E-01/ LA=N M=1 I=1 J=LA R=R1 1 IF(I.EQ.J) GO TO 9 IF(R.GT.R2) GO TO 2 R=R+R3 GO TO 3 2 R=R-R4 3 K=I IJ=I+(J-I)*IFIX(R) T=A(IJ) IT=IP(IJ) IF(A(I).LE.T) GO TO 4 A(IJ)=A(I) A(I)=T T=A(IJ) IP(IJ)=IP(I) IP(I)=IT IT=IP(IJ)

4 L=J IF(A(J).GE.T) GO TO 6 A(IJ)=A(J) A(J)=T T=A(IJ) IP(IJ)=IP(J) IP(J)=IT IT=IP(IJ) IF(A(I).LE.T) GO TO 6 A(IJ)=A(I) A(I)=T T=A(IJ) IP(IJ)=IP(I) IP(I)=IT IT=IP(IJ) GO TO 6 5 TT=A(L) A(L)=A(K) A(K)=TT ITT=IP(L) IP(L)=IP(K) IP(K)=ITT 6 L=L-1 IF(A(L).GT.T) GO TO 6 7 K=K+1 IF(A(K).LT.T) GO TO 7 IF(K.LE.L) GO TO 5 IF(L-I.LE.J-K) GO TO 8 IL(M)=I IU(M)=L I=K M=M+1 GO TO 10 8 IL(M)=K IU(M)=J J=L M=M+1 GO TO 10 9 M=M-1 IF(M.EQ.0) GO TO 13 I=IL(M) J=IU(M) 10 IF(J-I.GE.1) GO TO 3 IF(I.EQ.1) GO TO 1 I=I-1 11 I=I+1 IF(I.EQ.J) GO TO 9 T=A(I+1) IT=IP(I+1) IF(A(I).LE.T) GO TO 11 K=I 12 A(K+1)=A(K)

IP(K+1)=IP(K) K=K-1 IF(T.LT.A(K)) GO TO 12 A(K+1)=T IP(K+1)=IT GO TO 11 13 RETURN END

! ******************************************************** subroutine open_read use commonmod open(1,file='input.txt') open(2,file='output.txt') read(1,*)a,b,c,alpha,beta,gamma,text read(1,*)ag,bg,cg,alphag,betag,gammag,text read(1,*)text read(1,*)Radius,text read(1,*)Radius_okrugenija,text read(1,*)num_atom_name,text do i=1,num_atom_name read(1,*)atom_name(i),text end do do i=1,num_atom_name - 1 read(1,*)D_kation_anion(i),text end do read(1,*)text read(1,*)print_coord_atom,text read(1,*)print_coord_atom_g,text read(1,*)print_coordg_modif,text read(1,*)print_coord,text read(1,*)print_coordg,text read(1,*)print_coord_sphera,text read(1,*)print_wi_all,text read(1,*)print_wi_vozr,text read(1,*)print_wi_name,text read(1,*)print_statistica,text read(1,*)text read(1,*)N_atoms,text do i=1,N_atoms

!

!

read(1,*)k,name_atoms(i),X0(i),Y0(i),Z0(i) write(2,'(5x,i4,2x,3(f13.10,2x))')i,X0(i),Y0(i),Z0(i) end do do i=1,N_atoms read(1,*)k,name_atoms(i),X_NEW(i),Y_NEW(i),Z_NEW(i) write(2,'(5x,i4,2x,3(f13.10,2x))')i,X(i),Y(i),Z(i) end do if(print_coord_atom == 1)then write(2,'(//"----------- ---------------------")/') do i=1,N_atoms write(2,'(5x,i4,3x,a6,3x,3(f8.5,2x))')i,name_atoms(i),X0(i),Y0(i),Z0(i) end do end if if(print_coord_atom_g == 1)then write(2,'(//"----------- GULP ---------------------

")/') do i=1,N_atoms write(2,'(5x,i4,3x,a6,3x,3(f8.5,2x))')i,name_atoms(i),X_NEW(i),Y_NEW(i),Z_NEW(i) end do end if ! ( GULP ) do i=1,N_atoms if(abs(X0(i)-X_NEW(i)) > 0.5)X_NEW(i) = X_NEW(i) - 1. if(abs(Y0(i)-Y_NEW(i)) > 0.5)Y_NEW(i) = Y_NEW(i) - 1. if(abs(Z0(i)-Z_NEW(i)) > 0.5)Z_NEW(i) = Z_NEW(i) - 1. end do if(print_coordg_modif == 1)then write(2,'(//"--------------")/') do i=1,N_atoms write(2,'(5x,i4,3x,a6,3x,3(f8.5,2x))')i,name_atoms(i),X_NEW(i),Y_NEW(i),Z_NEW(i) end do end if return end ( GULP ) -----------------

subroutine close_stop close(1) close(2) stop return end