source: trunk/fsource/pydiffax.for @ 2190

Last change on this file since 2190 was 2190, checked in by vondreele, 6 years ago

fix g77/gfortran problem with DIFFaX by putting use of GET_G into OPTIMZ instead of calling it from pydiffax.for
thus new binwin2.7 & bunwin64-2.7 libraries are deposited
GSASIIphsGUI still rund original DIFFaX for selected area simulations - still testing pydiffax

File size: 6.9 KB
Line 
1      SUBROUTINE PYGETSADP(CNTRLS,NSADP,SADP,HKLIM,INCR)
2       
3Cf2py intent(in) CNTRLS
4Cf2py intent(in) NSADP
5Cf2py intent(in/out) SADP
6Cf2py depend(NSADP) SADP
7Cf2py intent(out) HKLIM
8Cf2py intent(out) INCR
9   
10      INCLUDE 'DIFFaXsubs/DIFFaX.par'
11      INCLUDE 'DIFFaXsubs/DIFFaX.inc'
12
13      INTEGER*4 CNTRLS(7),NSADP,GET_SYM,i_plane,hk_lim,i,j,k
14      INTEGER*4 HKLIM
15      REAL*8 SADP(NSADP),AGLQ16,l_upper,INCR
16      LOGICAL ok
17       
18      EXTERNAL AGLQ16,GET_SYM                 
19                   
20      i_plane = CNTRLS(2)
21      l_upper = CNTRLS(3)
22C      print *,n_actual,(l_n_atoms(i),i=1,n_actual)
23C      do j=1,n_actual
24C        do i=1,l_n_atoms(j)
25C          print *,a_name(i,j),(a_pos(k,i,j),k=1,3)
26C        end do
27C      end do
28C      print *, recrsv,inf_thick,xplcit,rndm,l_cnt,has_l_mirror
29C      do i=1,n_layers
30C      print *,' layer',i
31C         do j=1,n_layers
32C            print *,'layer',j,l_alpha(i,j),(l_r(k,i,j),k=1,3)
33C         end do
34C      end do
35      ok = .TRUE.
36       
37C      print *,cell_a,cell_b,cell_c,cell_gamma,pnt_grp,SymGrpNo
38c      DoSymDump = .TRUE.
39      CALL SPHCST()
40      CALL DETUN()
41      CALL OPTIMZ('GSAS-II',ok)
42C      print *,lambda,max_angle,h_bnd,k_bnd,l_bnd,no_trials,
43C     1  rad_type,X_RAY,n_atoms
44C      print *,(l_g(j),j=1,n_layers)
45C      do j=1,n_layers
46C        print *,(hx_ky(i,j),i=1,l_n_atoms(j))
47C        print *,(mat(i,j),i=1,n_layers)
48C        print *,(mat1(i,j),i=1,n_layers)
49C        print *,(l_phi(i,j),i=1,n_layers)
50C      end do
51      CALL GETSAD(AGLQ16,i_plane,l_upper,hk_lim,'GSAS-II',ok)
52      HKLIM = hk_lim+1
53      INCR = dble(SADSIZE/2)/l_upper
54      if (i_plane.eq.1) then
55        INCR = INCR*sqrt(a0/c0)
56      else if (i_plane.eq.2) then
57        INCR = INCR*sqrt(b0/c0)
58      else if (i_plane.eq.3) then
59        INCR = INCR*sqrt((a0+b0+d0)/c0)
60      else if (i_plane.eq.4) then
61        INCR = INCR*sqrt((a0+b0-d0)/c0)
62      end if
63      do I=1,NSADP
64        SADP(i) = spec(i)
65      end do
66      RETURN
67      END
68
69      SUBROUTINE PYLOADSCF(NATP,ATYPES,SFDAT)
70       
71Cf2py intent(in) NATP
72Cf2py intent(in) ATYPES
73Cf2py intent(in) SFDAT
74cf2py depend(NATP) ATYPES,SFDAT
75           
76      INCLUDE 'DIFFaXsubs/DIFFaX.par'
77      INCLUDE 'DIFFaXsubs/DIFFaX.inc'
78               
79      INTEGER*4 NATP,I,J
80      CHARACTER*4 ATYPES(NATP)
81      REAL*4  SFDAT(9,NATP)
82               
83C fill common x-ray scattering factors
84      DO J=1,NATP
85        WRITE(atom_l(J),'(A4)') ATYPES(J)
86        DO I=1,9
87          x_sf(I,J) = SFDAT(I,J)
88        END DO
89C        print *,ATYPES(J),(x_sf(I,J),I=1,9)
90      END DO
91      intp_F = .TRUE.
92      n_atoms = NATP
93      RETURN
94      END
95       
96      SUBROUTINE PYGETCLAY(CNTRLS,LAUESYM,WDTH,NST,STSEQ)
97       
98Cf2py intent(in) CNTRLS
99Cf2py intent(in) LAUESYM
100Cf2py intent(in) WDTH
101Cf2py intent(in) NST
102Cf2py intent(in) STSEQ
103cf2py depend(NST) STSEQ
104     
105      INCLUDE 'DIFFaXsubs/DIFFaX.par'
106      INCLUDE 'DIFFaXsubs/DIFFaX.inc'
107
108      CHARACTER*12 LAUESYM
109      INTEGER*4 CNTRLS(7),NST,STSEQ(NST),I
110      REAL*8 WDTH(2)                 
111      LOGICAL*4 ok,GETLAY
112      EXTERNAL GETLAY
113                                     
114      PI = FOUR * atan(ONE)
115      PI2 = TWO * PI
116      DEG2RAD = PI / ONE_EIGHTY
117      RAD2DEG = ONE_EIGHTY / PI
118      rad_type = X_RAY
119      lambda = 0.1
120      trim_origin = .TRUE.
121      blurring = NONE
122      loglin = 1
123      tolerance = 0.01
124      finite_width = .TRUE.
125      Wa = WDTH(1)*10000.
126      Wb = WDTH(2)*10000.
127      IF (Wa.GE.10000.) finite_width = .FALSE.
128      WRITE(pnt_grp,'(A12)') LAUESYM
129      SymGrpNo = CNTRLS(1)
130      check_sym = .TRUE.
131C CNTRLS = [laueId,planeId,lmax,mult,StkType,StkParm,ranSeed]
132      bitdepth = 16
133      ok = .TRUE.
134      scaleint = FLOAT(CNTRLS(4))
135C fill in stacking seq stuff                 
136      IF (CNTRLS(5).NE.0) THEN
137        xplcit = .TRUE.
138        recrsv = .FALSE.
139        IF (CNTRLS(6).EQ.1) THEN
140            rndm = .TRUE.
141        ELSE
142            rndm = .FALSE.
143            l_cnt = NST
144            DO I=1,NST
145              l_seq(I) = STSEQ(I)
146            END DO       
147        END IF   
148      ELSE
149        recrsv = .TRUE.
150        xplcit = .FALSE.
151        IF (CNTRLS(6).NE.0) THEN
152            l_cnt = CNTRLS(7)
153            inf_thick = .FALSE.
154        ELSE
155            inf_thick = .TRUE.
156        END IF
157      END IF
158      IF (rndm) ok = GETLAY()
159      RETURN
160      END
161           
162      SUBROUTINE PYCELLAYER(CELL,NATM,ATMTP,ATMXOU,NU,LSYM,NL,LNUM)
163                   
164Cf2py intent(in) CELL
165Cf2py intent(in) NATM
166Cf2py intent(in) ATMTP
167Cf2py intent(in) ATMXOU
168cf2py depend(NATM) ATMTP,ATMXOU
169Cf2py intent(in) NU
170Cf2py intent(in) LSYM
171Cf2py depend(NU) LSYM
172Cf2py intent(in) NL
173Cf2py intent(in) LNUM
174Cf2py depend(NL) LNUM
175                       
176      INCLUDE 'DIFFaXsubs/DIFFaX.par'
177      INCLUDE 'DIFFaXsubs/DIFFaX.inc'
178
179      INTEGER*4 NATM,NL,LNUM(NL),NU,LSYM(NU)
180      CHARACTER*4 ATMTP(NATM)
181      REAL*8  CELL(4),ATMXOU(8,NATM)
182      INTEGER*4 I,J,K,IL,IA
183
184C fill Common - cell stuff & finish symmetry stuff
185      cell_a = CELL(1)
186      cell_b = CELL(2)
187      cell_c = CELL(3)
188      cell_gamma = CELL(4)*DEG2RAD
189C fill common layer stuff - atoms & symm
190C      print *,NL,LNUM,NU,LSYM
191      DO I=1,NATM
192        IL = NINT(ATMXOU(1,I))
193        IA = NINT(ATMXOU(2,I))       
194        a_type(IA,IL) = NINT(ATMXOU(3,I))
195C        print *,ATMTP(I),IL,IA,a_type(IA,IL),(ATMXOU(j,I),j=4,6)
196        a_number(IA,IL) = IA
197        WRITE(a_name(IA,IL),'(A4)') ATMTP(I)
198        DO K=1,3
199            a_pos(K,IA,IL) = ATMXOU(K+3,I)
200        END DO
201        high_atom(IL) = max(high_atom(IL),a_pos(3,IA,IL))
202        low_atom(IL) = min(low_atom(IL),a_pos(3,IA,IL))
203        IF (LSYM(IL).EQ.CENTRO) THEN
204            high_atom(IL) = MAX(high_atom(IL),-a_pos(3,IA,IL))
205            low_atom(IL) = MIN(low_atom(IL),-a_pos(3,IA,IL))
206        END IF
207        a_occup(IA,IL) = ATMXOU(7,I)
208        a_B(IA,IL) = ATMXOU(8,I)
209        l_n_atoms(IL) = IA
210        l_symmetry(IL) = LSYM(IL)
211      END DO
212C      print *,IL,high_atom(IL),low_atom(IL)
213      n_actual = IL
214      n_layers = NL
215      DO I=1,NL
216        l_actual(I) = LNUM(I)
217        DO J=1,NL
218            Bs_zero(J,I) = .TRUE.
219        END DO
220      END DO
221      all_Bs_zero = .TRUE.
222      RETURN
223      END
224
225      SUBROUTINE PYGETTRANS(NL,TRP,TRX)
226     
227Cf2py intent(in) NL
228Cf2py intent(in) TRP
229Cf2py intent(in) TRX
230Cf2py depend(NL) TRP,TRX
231     
232     
233      INCLUDE 'DIFFaXsubs/DIFFaX.par'
234      INCLUDE 'DIFFaXsubs/DIFFaX.inc'
235       
236      INTEGER*4 I,J,K
237      INTEGER*4 NL
238      REAL*4  TRP(NL,NL),TRX(NL,NL,3)
239                               
240C fill common transitions stuff
241      DO J=1,NL
242        DO I=1,NL
243          l_alpha(J,I) = TRP(I,J)
244          DO K=1,3
245            l_r(K,J,I) = TRX(I,J,K)
246          END DO
247        END DO
248      END DO
249      RETURN
250      END
251       
252           
Note: See TracBrowser for help on using the repository browser.