Updated to the current version of MKL.
[ptslat.git] / str_slat.f90
blob17b55aa161848c85883412749b895f4c5e06135d
1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 ! This subroutine calculates the strain distribution !
3 ! inside and around the quantum dot !
4 ! !
5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7 SUBROUTINE STRAIN0(EXX,EYY,EZZ,EXY,EXZ,EYZ)
9 Use Input_Data
10 Use Dot_Geometry
11 Use Auxiliar_Procedures, ONLY : AISO
12 Use STRAIN_CALC
14 IMPLICIT NONE
16 !!!!! 'dummy' and local variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
18 REAL ZM,THETA,CTHETA,STHETA,CHI, &
19 EESUM,EEDIF,EERR,EE00,EEZZ,E2ZZ,EERZ,&
20 EEXX,EEYY,EEXY,EEXZ,EEYZ,X,Y,Z,ZMAUX
21 REAL,DIMENSION(:,:,:) :: EXX,EYY,EZZ,EXY,EXZ,EYZ
22 INTEGER I_X,I_Y,I_Z,I_N1,I_N2,I_N3
24 REAL, DIMENSION(3) :: R_SL,X_VEC,XI_VEC
26 !!! COMMON
27 REAL :: RHO,ZETA,ETA
28 COMMON /QAGON/RHO,ZETA,ETA
30 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32 EXX=0.E0;EYY=0.E0;EZZ=0.E0;EXY=0.E0;EXZ=0.E0;EYZ=0.E0
34 ZD: DO I_Z=1,ZDim
35 WRITE(16,'(A,I3,A,I3)')"I_Z ",I_Z," of ",ZDIM
36 Z=Z_Min+REAL(I_Z-1)*Z_Inc
37 YD: DO I_Y=1,YDim
38 Y=Y_Min+REAL(I_Y-1)*Y_Inc
39 XD: DO I_X=1,XDim
40 X=X_Min+REAL(I_X-1)*X_Inc
42 X_VEC=(/X,Y,Z/)
44 EEXX=0.E0;EEYY=0.E0;EEXY=0.E0;EEXZ=0.E0;EEYZ=0.E0;EEZZ=0.E0
46 N3: DO I_N3=NMin_Z,NMax_Z
47 N2: DO I_N2=NMin_Y,NMax_Y
48 N1: DO I_N1=NMin_X,NMax_X
50 R_SL=REAL(I_N1)*A1_S+REAL(I_N2)*A2_S+REAL(I_N3)*A3_S
52 XI_VEC=X_VEC-R_SL
54 RHO=SQRT(XI_VEC(1)**2+XI_VEC(2)**2)/RC
55 IF(XI_VEC(1).EQ.0.E0.AND.XI_VEC(2).EQ.0.E0) THEN
56 CTHETA=1.E0/SQRT(2.E0); STHETA=1.E0/SQRT(2.E0) ! It is not the Mathematical limit
57 ELSE
58 THETA=ATAN(XI_VEC(2)/XI_VEC(1))
59 CTHETA=Cos(THETA); STHETA=Sin(THETA)
60 END IF
61 ZETA=XI_VEC(3)/ZC
63 IF (RHO.LE.RD) THEN
64 CALL SHAPERTOZ(MIN(RHO*RC,Rqd_Base),ZMAUX)
65 ZM=ZMAUX/ZC
66 ELSE
67 ZM = 0.E0
68 END IF
71 IF (abs(zeta) .EQ. 0.E0 .OR. ZETA .EQ. ZM) THEN
72 ZETA=ZETA-1.E-5
73 END IF
75 CHI = 0.
76 IF (RHO.LE.RD.AND.ZETA.GE.0.E0.AND.ZETA.LE.ZM) THEN
77 CHI = 1.
78 if(I_N1.NE.0.OR.I_N2.NE.0.OR.I_N3.NE.0) THEN
79 WRITE(16,*)I_N1,I_N2,I_N3
80 WRITE(16,*)X_VEC(3),ZETA*ZC,ZM*ZC
81 END IF
82 END IF
84 IF (AISO.EQ.1) THEN
85 CALL STRISO(EESUM,EEDIF,E2ZZ,EERZ,CHI)
86 ELSE
87 CALL STRANISO(EESUM,EEDIF,E2ZZ,EERZ,CHI)
88 END IF
90 IF (RHO .EQ. 0.E0) EEDIF = 0.E0
92 EERR = (EESUM+EEDIF)/2.
93 EE00 = (EESUM-EEDIF)/2.
96 !!!!!!!!!!!!!!!!!! Wetting Layer !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
98 IF(I_N1.EQ.0.AND.I_N2.EQ.0.AND.I_N3.EQ.0) THEN
99 IF (ZETA.LT.0.E0 .AND. ZETA.GE.-D) THEN
101 EESUM = EESUM + BISUM
102 EERR = EERR + BISUM/2.E0
103 EE00 = EE00 + BISUM/2.E0
104 IF (AISO.EQ.1) THEN
105 E2ZZ = E2ZZ + BIZZ
106 ELSE
107 E2ZZ = E2ZZ + (-2.E0*C13/C33*EPSA) !BIZZ
108 END IF
110 END IF
111 END IF
113 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
115 EEXX = EEXX + (CTHETA**2*EERR + STHETA**2*EE00)
116 EEYY = EEYY + (STHETA**2*EERR + CTHETA**2*EE00)
117 EEZZ = EEZZ + E2ZZ
118 EEXY = EEXY + (CTHETA*STHETA*(EERR-EE00))
119 EEXZ = EEXZ + (CTHETA*EERZ)
120 EEYZ = EEYZ + (STHETA*EERZ)
122 END DO N1
123 END DO N2
124 END DO N3
126 EXX(I_X,I_Y,I_Z)= EEXX
127 EYY(I_X,I_Y,I_Z)= EEYY
128 EZZ(I_X,I_Y,I_Z)= EEZZ
129 EXY(I_X,I_Y,I_Z)= EEXY
130 EXZ(I_X,I_Y,I_Z)= EEXZ
131 EYZ(I_X,I_Y,I_Z)= EEYZ
133 ! WRITE(26,'(10(E15.8,1X))')Z,EEXX,EEYY,EEZZ,EEXY,EEXZ,EEYZ
135 END DO XD
136 END DO YD
137 END DO ZD
139 ! STOP
141 RETURN
142 END SUBROUTINE STRAIN0
144 DOUBLE PRECISION FUNCTION I_FA00(X)
145 Use STRAIN_CALC
146 Use Dot_Geometry
147 Use Input_Data, ONLY: RC,ZC
148 IMPLICIT NONE
150 DOUBLE PRECISION :: X
151 !!! COMMON
152 REAL :: RHO,ZETA,ETA,ZM
153 COMMON /QAGON/RHO,ZETA,ETA
155 CALL SHAPERTOZ(MIN(SNGL(X)*RC,Rqd_Base),ZM)
156 I_FA00=X*FA00(DBLE(RHO),DBLE(ZETA),X,DBLE(ZM/ZC),DBLE(ETA))
158 RETURN
160 END FUNCTION I_FA00
162 DOUBLE PRECISION FUNCTION I_FA10(X)
163 Use STRAIN_CALC
164 Use Dot_Geometry
165 Use Input_Data, ONLY: RC,ZC
166 IMPLICIT NONE
168 DOUBLE PRECISION :: X
169 !!! COMMON
170 REAL :: RHO,ZETA,ETA,ZM
171 COMMON /QAGON/RHO,ZETA,ETA
173 CALL SHAPERTOZ(MIN(SNGL(X)*RC,Rqd_Base),ZM)
174 I_FA10=X*FA10(DBLE(RHO),DBLE(ZETA),X,DBLE(ZM/ZC),DBLE(ETA))
176 RETURN
178 END FUNCTION I_FA10
180 DOUBLE PRECISION FUNCTION I_FA20(X)
181 Use STRAIN_CALC
182 Use Dot_Geometry
183 Use Input_Data, ONLY: RC,ZC
184 IMPLICIT NONE
186 DOUBLE PRECISION :: X
187 !!! COMMON
188 REAL :: RHO,ZETA,ETA,ZM
189 COMMON /QAGON/RHO,ZETA,ETA
191 CALL SHAPERTOZ(MIN(SNGL(X)*RC,Rqd_Base),ZM)
192 I_FA20=X*FA20(DBLE(RHO),DBLE(ZETA),X,DBLE(ZM/ZC),DBLE(ETA))
194 RETURN
196 END FUNCTION I_FA20