Skip to content

Commit

Permalink
v 1.6.5
Browse files Browse the repository at this point in the history
  • Loading branch information
shahramyalameha committed Jun 8, 2021
1 parent 1b25c70 commit e6842c6
Show file tree
Hide file tree
Showing 11 changed files with 221 additions and 91 deletions.
81 changes: 81 additions & 0 deletions soc/Eatools_2Dadv.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,81 @@
!```````````````````````````````````````````````````````````````````````````````````````````
! Copyright (c) 2018 Shahram Yalameha <[email protected]> , <[email protected]>, `
! Please report bugs or suggestions to: [email protected] `
! `
!```````````````````````````````````````````````````````````````````````````````````````````
! SUBROUTINE: fOR 2D MATERIAL , CALCULATED shear modulus.

SUBROUTINE adv_2D(phi,phi_pro,l,pro,method,Max_pro, Min_pro)
implicit none
CHARACTER(len=5) :: pro
CHARACTER(len=3) :: method ! 1 = o 2 = r 3 = q
DOUBLE PRECISION :: Max_pro, Min_pro, phi, val_pro, sai_G, r_G, o_G, G0, G,G_inver, E_inver, poi_inver
DOUBLE PRECISION, DIMENSION(201) :: phi_pro,pro_max_phi
DOUBLE PRECISION, DIMENSION(3,3) :: C,S
Integer :: n,i,j,l
n=3

OPEN(58,FILE="Cij-2D.dat",STATUS='OLD',ACTION='READ')
DO i=1,n
READ(58,*) (C(i,j),j=1,n)
ENDDO
close(58)
n=3
OPEN(51,FILE="Sij-2D.dat",STATUS='OLD',ACTION='READ')
DO i=1,n
READ(51,*) (S(i,j),j=1,n)
ENDDO
close(51)

IF(method == 'adv' .and. pro == "shear" ) THEN
G_inver = S(1,1) * ( COS(phi)*COS(phi)*SIN(phi)*SIN(phi) ) +&
S(1,2) *-2.D0*( COS(phi)*SIN(phi)*SIN(phi)*COS(phi) ) +&
S(2,2) * ( SIN(phi)*SIN(phi)*COS(phi)*COS(phi) ) +&
S(1,3) * ( SIN(phi)*SIN(phi)*COS(phi)*SIN(phi) - SIN(phi)*COS(phi)*COS(phi)*COS(phi) )+&
S(2,3) * ( COS(phi)*COS(phi)*COS(phi)*SIN(phi) - SIN(phi)*COS(phi)*SIN(phi)*SIN(phi) )+&
S(3,3) * ( COS(phi)*COS(phi)*COS(phi)*COS(phi) - 2.D0*COS(phi)*SIN(phi)*SIN(phi)*COS(phi) + SIN(phi)*SIN(phi)*SIN(phi)*SIN(phi) ) * (1.d0/4.d0)
phi_pro(l) = 1.D0/(4.D0*G_inver)

ENDIF
!===============================================
IF(method == 'adv' .and. pro == "young" ) THEN
E_inver = S(1,1) * ( COS(phi)*COS(phi)*COS(phi)*COS(phi) ) +&
S(1,2) *2.d0*( SIN(phi)*COS(phi)*SIN(phi)*COS(phi) ) +&
S(2,2) * ( SIN(phi)*SIN(phi)*SIN(phi)*SIN(phi) ) +&
S(3,3) * ( SIN(phi)*COS(phi)*SIN(phi)*COS(phi) ) +&
S(1,3) *2.d0*( COS(phi)*SIN(phi)*SIN(phi)*SIN(phi) ) +&
S(2,3) *2.d0*( SIN(phi)*COS(phi)*COS(phi)*COS(phi) )
phi_pro(l) = 1.D0 / E_inver

endif
IF(method == 'adv' .and. pro == "poi" ) THEN
E_inver = S(1,1) * ( COS(phi)*COS(phi)*COS(phi)*COS(phi) ) +&
S(1,2) *2.d0*( SIN(phi)*COS(phi)*SIN(phi)*COS(phi) ) +&
S(2,2) * ( SIN(phi)*SIN(phi)*SIN(phi)*SIN(phi) ) +&
S(3,3) * ( SIN(phi)*COS(phi)*SIN(phi)*COS(phi) ) +&
S(1,3) *2.d0*( COS(phi)*SIN(phi)*SIN(phi)*SIN(phi) ) +&
S(2,3) *2.d0*( SIN(phi)*COS(phi)*COS(phi)*COS(phi) )

poi_inver = S(1,1) * ( SIN(phi)*SIN(phi)*COS(phi)*COS(phi) ) +&
S(1,2) * ( SIN(phi)*SIN(phi)*SIN(phi)*SIN(phi) + COS(phi)*COS(phi)*COS(phi)*COS(phi) )+&
S(2,2) * ( SIN(phi)*SIN(phi)*COS(phi)*COS(phi) ) +&
S(1,3) * ( SIN(phi)*SIN(phi)*COS(phi)*SIN(phi) - SIN(phi)*COS(phi)*COS(phi)*COS(phi) )+&
S(2,3) * ( COS(phi)*COS(phi)*COS(phi)*SIN(phi) - SIN(phi)*COS(phi)*SIN(phi)*SIN(phi) )+&
S(3,3) * ( SIN(phi)*COS(phi)*COS(phi)*SIN(phi) * -1.D0 )
phi_pro(l) = -(poi_inver / E_inver)
!WRITE(*,*) phi*(180D0/3.1415),phi_pro(l) ,l
IF (l.EQ.0) THEN
Max_pro=phi_pro(l); Min_pro=phi_pro(l);
ELSE
IF (phi_pro(l).GE.Max_pro) THEN
Max_pro=phi_pro(l)
!WRITE(*,*) phi*(180D0/3.1415),Max_pro
END IF
IF (phi_pro(l).LE.Min_pro) THEN
Min_pro=phi_pro(l)
END IF
END IF
ENDIF
!===============================================

END SUBROUTINE
58 changes: 48 additions & 10 deletions soc/Eatools_2Danalyz.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,29 +4,33 @@
! `
!```````````````````````````````````````````````````````````````````````````````````````````
! SUBROUTINE: fOR 2D MATERIAL , CALCULATE Youngs Modulus, Shear Modulus AND Poissons Ratio
SUBROUTINE analiz_2D_sys()
SUBROUTINE analiz_2D_sys(method)
implicit none

DOUBLE PRECISION, PARAMETER :: pi=3.141592653589793238462D0
DOUBLE PRECISION :: phi=0.0D0,&
vv11=0.d0,&
vv22=0d0,&
vv33=0.0d0,&
NPratio_max=0D0,&
NPratio_min=0.0D0,&
NPratio_max=0D0,Max_pro=0D0,&
NPratio_min=0.0D0,Min_pro=0.0D0,&
Pratio_max=0d0,&
Pratio_max_phi=0d0,&
Pratio_min_phi=0d0,&
Pratio_min=1d0,&
MaxPratio,MinPratio,&
Maximum,Minimum,MaxShear,MinShear,&
Shear_max_phi

DOUBLE PRECISION, DIMENSION(6000) :: phi_young,phi_poisson=0.d0, poisson2dmax, poisson2dminn, poisson2dminp,phii,phi_shear,&
shear2dmax, shear2dmin
DOUBLE PRECISION, DIMENSION(3) :: vec=0d0
DOUBLE PRECISION, DIMENSION(3,3) :: c
INTEGER :: Nmesh_phi,j, Nmesh_phiF ,num,i
CHARACTER(len=5) :: pro ! 1 = o 2 = r 3 = q
ChARACTER(LEN=3) :: adv,method
DOUBLE PRECISION :: val_pro, sai_G, r_G, o_G, G0, G_inver, E_inver, E
DOUBLE PRECISION, DIMENSION(201) :: phi_pro,pro_max_phi

DOUBLE PRECISION, DIMENSION(6000) :: phi_young,phi_poisson=0.d0, poisson2dmax, poisson2dminn, poisson2dminp,phii,phi_shear,&
shear2dmax, shear2dmin
DOUBLE PRECISION, DIMENSION(3) :: vec=0d0
DOUBLE PRECISION, DIMENSION(3,3) :: c
INTEGER :: Nmesh_phi,j, Nmesh_phiF ,num,i
!========================================================

Nmesh_phi = 200 ! mesh
Expand All @@ -37,26 +41,60 @@ SUBROUTINE analiz_2D_sys()
OPEN(61,FILE="young_2d_sys.dat")
OPEN(62,FILE="poisson_2d_sys.dat")
OPEN(63,FILE="shear_2d_sys.dat")
!method = "adv"
!!pro = "young"
DO j=0, Nmesh_phi
phi = DBLE(j)/DBLE(Nmesh_phi)*2D0*PI
vec(1) = SIN(phi)
vec(2) = COS(phi)
vv11 = SIN(phi)**4.0d0
vv22 = COS(phi)**4.0d0
vv33 =(COS(phi)**2.0d0)*(SIN(phi)**2.0d0)
IF(method=="adv") THEN

phi_pro=0.0
Max_pro = 0D0
Min_pro = 3.5D0
pro = "poi"
call adv_2D(phi,phi_pro,j,pro,method,Max_pro,Min_pro)
phi_poisson=phi_pro(j)
poisson2dmax(j) = Max_pro
IF (Min_pro.GE.0D0) poisson2dminp(j) = Min_pro
IF (Min_pro.LE.0D0) poisson2dminn(j) = Max_pro
WRITE(62,"(F8.4,3F20.16)")phi*(180d0/PI), poisson2dmax(j) ,poisson2dminp(j), poisson2dminn(j)

pro = "young"
call adv_2D(phi,phi_pro,j,pro,method,Max_pro,Min_pro)
WRITE(61,"(F8.4,2F21.16)") phi*(180D0/PI), phi_pro(j)
phi_young(j)=phi_pro(j)



phi_pro=0.0
pro = "shear"
call adv_2D(phi,phi_pro,j,pro,method,Max_pro,Min_pro)
WRITE(63,"(F8.4,2F21.16)") phi*(180D0/PI), phi_pro(j)
shear2dmax(j) =phi_pro(j)

ELSE

CALL yound_2D(vv11,vv22,vv33,phi,phi_young,j )
WRITE(61,"(F8.4,2F21.16)") phi*(180D0/PI), phi_young(j)
!
NPratio_max = 0D0
NPratio_min = 3.5D0
CALL poisson_2D(vv11,vv22,vv33,phi,phi_poisson,NPratio_max,NPratio_min,j)
CALL poisson_2D(vv11,vv22,vv33,phi,phi_poisson,NPratio_max,NPratio_min,j)
poisson2dmax(j) = NPratio_max
!WRITE(*,*) phi*(180D0/3.1415),poisson2dmax(j)
IF (NPratio_min.GE.0D0) poisson2dminp(j) = NPratio_min
IF (NPratio_min.LE.0D0) poisson2dminn(j) = NPratio_min
WRITE(62,"(F8.4,3F20.16)")phi*(180d0/PI), poisson2dmax(j) ,poisson2dminp(j), poisson2dminn(j)
!
CALL shear_2D(vv11,vv22,vv33,phi,phi_shear,MaxShear,j)
shear2dmax(j) = MaxShear
WRITE(63,"(F8.4,2F20.14)") phi*(180d0/PI), shear2dmax(j)

ENDIF
END DO

CLOSE(61)
Expand Down
2 changes: 1 addition & 1 deletion soc/Eatools_2Dpoisson.f90
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
! Please report bugs or suggestions to: [email protected] `
! `
!```````````````````````````````````````````````````````````````````````````````````````````
! SUBROUTINE: fOR 3D MATERIAL , CALCULATED poiison's retio.
! SUBROUTINE: fOR 2D MATERIAL , CALCULATED poiison's retio.
SUBROUTINE poisson_2D(vv11,vv22,vv33,phi,phi_poisson,MaxPratio,MinPratio,l)
implicit none
DOUBLE PRECISION :: vv11,vv22,vv33,Y1,Y2,A,B,T,Y3,MaxPratio,MinPratio,phi,Pe,E
Expand Down
2 changes: 1 addition & 1 deletion soc/Eatools_2Dshear.f90
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ SUBROUTINE shear_2D(vv11,vv22,vv33,phi,phi_shear,MaxShear ,l)
READ(51,*) (S(i,j),j=1,n)
ENDDO
close(51)
She= (S(1,1)+S(2,2)-S(1,2))*vv33+(1.d0/4.d0)*S(3,3)*(vv11+vv22-2.d0*vv33)
She= (S(1,1)+S(2,2)-2.d0*S(1,2))*vv33+(1.d0/4.d0)*S(3,3)*(vv11+vv22-2.d0*vv33)
phi_shear(l) =1D0/((4D0*She)) ! method_ 2 by Sij (Recommend)
!write(*,*)phi_shear(l)
MaxShear=phi_shear(l)
Expand Down
8 changes: 5 additions & 3 deletions soc/Eatools_2Dyoung.f90
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,12 @@
!```````````````````````````````````````````````````````````````````````````````````````````
! SUBROUTINE: fOR 2D MATERIAL , CALCULATED young's modulus.

SUBROUTINE yound_2D(vv11,vv22,vv33,phi,phi_young,l )!
SUBROUTINE yound_2D(vv11,vv22,vv33,phi,phi_young,l)!
implicit none
DOUBLE PRECISION :: vv11,vv22,vv33,Y1,Y2,A,B,T,phi,E,Pe

DOUBLE PRECISION :: vv11,vv22,vv33,Y1,Y2,A,B,T,phi,E,Pe
DOUBLE PRECISION, DIMENSION(201) :: phi_young,phi_young_test
DOUBLE PRECISION, DIMENSION(3,3):: C,S
DOUBLE PRECISION, DIMENSION(3,3) :: C,S
Integer::n,i,j,l
n=3
OPEN(58,FILE="Cij-2D.dat",STATUS='OLD',ACTION='READ')
Expand All @@ -32,4 +33,5 @@ SUBROUTINE yound_2D(vv11,vv22,vv33,phi,phi_young,l )!
!Pe=vv33*(S(1,1)+S(2,2)-S(3,3))+S(1,2)*(vv11+vv22)
!phi_young_test(l)=-(Pe/E)
!write(*,*)phi_young_test(l)

end SUBROUTINE
12 changes: 6 additions & 6 deletions soc/Eatools_2dcal.f90
Original file line number Diff line number Diff line change
Expand Up @@ -3,19 +3,19 @@
! Please report bugs or suggestions to: [email protected] `
! `
!```````````````````````````````````````````````````````````````````````````````````````````
! SUBROUTINE: fOR 2D MATERIAL , CALCULATE vectors and (theta, pihi) in the (001) plane
! SUBROUTINE: fOR 2D MATERIAL , CALCULATE vectors and (theta, pih) in the (001) plane

SUBROUTINE twoD_calc(vv11,vv12,vv13,vv22,vv23,vv33,mmx,kky,llz,smkl,i,phi,theta,vec)
IMPLICIT NONE
DOUBLE PRECISION :: smkl,smkl2,&
twoDTheta=0D0,&
DOUBLE PRECISION :: smkl,smkl2,&
twoDTheta=0D0,&
mmx, &
kky, &
llz, &
vv11,&
vv11,&
vv12,&
vv13,&
vv22,&
vv22,&
vv23,&
vv33,theta,phi
DOUBLE PRECISION, DIMENSION(3) :: vec
Expand Down Expand Up @@ -52,7 +52,7 @@ SUBROUTINE twoD_calc(vv11,vv12,vv13,vv22,vv23,vv33,mmx,kky,llz,smkl,i,phi,theta,
ENDIF
vv11 = vec(1)*vec(1) ; vv12 = vec(1)*vec(2)
vv13 = vec(1)*vec(3) ; vv22 = vec(2)*vec(2)
vv23 = vec(2)*vec(3) ; vv33 = vec(3)*vec(3)
vv23 = vec(2)*vec(3) ; vv33 = vec(3)*vec(3)
!write(*,*)vv11,vv13,vv23,vv12,vv22,vv33

END SUBROUTINE
Expand Down
4 changes: 2 additions & 2 deletions soc/Eatools_db.f90
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ Subroutine databank(id,yesno)
integer::i,j,stat
!read(*,*)id
call system("clear")
open (12,file='/home/shahram/Desktop/Cubelast/code/programMY/AAEP/soc/eatools_v1.6.2/db/All_2ID_cop.csv')
open (12,file='/home/shahram/Desktop/Cubelast/code/programMY/AAEP/soc/eatools_v1.6.4/db/All_2ID_cop.csv')
do i=1,13122
read(12,* )id2(i)
if (id2(i)==id )then
Expand All @@ -21,7 +21,7 @@ Subroutine databank(id,yesno)
close (12)

i=0
open (11,file='/home/shahram/Desktop/Cubelast/code/programMY/AAEP/soc/eatools_v1.6.2/db/Cijs.binery')
open (11,file='/home/shahram/Desktop/Cubelast/code/programMY/AAEP/soc/eatools_v1.6.4/db/Cijs.binery')
do i=1,2043900
read(11,'(Z16)',IOSTAT=stat )c1(i) ,c2(i),c3(i),c4(i),c5(i),c6(i)
! write(14,'(B64)')c1(j) ,c2(j),c3(j),c4(j),c5(j),c6(j)
Expand Down
Loading

0 comments on commit e6842c6

Please sign in to comment.