function3d.f90 8.15 KB
Newer Older
Marco Govoni's avatar
Marco Govoni committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
!
! Copyright (C) 2015-2017 M. Govoni 
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
! This file is part of WEST.
!
! Contributors to this file: 
! Marco Govoni
!
! -------------------------------------------------------------------
MODULE function3d 
 ! -----------------------------------------------------------------
 !
 IMPLICIT NONE
 !
Marco Govoni's avatar
Marco Govoni committed
19
20
21
22
23
24
25
26
 INTERFACE write_function3d
    MODULE PROCEDURE write_function3d_real !, write_function3d_complex
 END INTERFACE  
 !
 INTERFACE read_function3d
    MODULE PROCEDURE read_function3d_real !, read_function3d_complex
 END INTERFACE  
 !
Marco Govoni's avatar
Marco Govoni committed
27
28
29
 CONTAINS
 ! 
 !-----------------------------------------------------------------
Marco Govoni's avatar
Marco Govoni committed
30
   SUBROUTINE write_function3d_real ( fname, f_r, dfft )
Marco Govoni's avatar
Marco Govoni committed
31
32
   ! -----------------------------------------------------------------
   !
33
34
35
36
37
38
   USE kinds,                       ONLY : DP
   USE cell_base,                   ONLY : celldm, at
   USE control_flags,               ONLY : gamma_only
   USE mp_bands,                    ONLY : me_bgrp
   USE scatter_mod,                 ONLY : gather_grid
   USE fft_types,                   ONLY : fft_type_descriptor
Marco Govoni's avatar
Marco Govoni committed
39
40
41
42
43
44
45
   USE forpy_mod,  ONLY: call_py, call_py_noret, import_py, module_py
   USE forpy_mod,  ONLY: tuple, tuple_create 
   USE forpy_mod,  ONLY: dict, dict_create 
   USE forpy_mod,  ONLY: list, list_create 
   USE forpy_mod,  ONLY: object, cast
   USE forpy_mod,  ONLY: exception_matches, KeyError, err_clear, err_print 
   USE conversions, ONLY : ltoa, itoa, dtoa
Marco Govoni's avatar
Marco Govoni committed
46
47
48
49
50
51
52
   USE base64_module
   !
   IMPLICIT NONE
   !
   ! I/O 
   !
   CHARACTER(LEN=*),INTENT(IN) :: fname
Marco Govoni's avatar
Marco Govoni committed
53
54
   TYPE(fft_type_descriptor), INTENT(IN) :: dfft
   REAL(DP),INTENT(IN) :: f_r(dfft%nnr)
Marco Govoni's avatar
Marco Govoni committed
55
56
57
58
   ! 
   ! Workspace
   !
   CHARACTER(LEN=:),ALLOCATABLE :: charbase64
Marco Govoni's avatar
Marco Govoni committed
59
60
61
62
63
64
65
66
   REAL(DP),ALLOCATABLE :: f_r_gathered(:), f_r_gathered_nopadded(:)
   INTEGER :: ndim, nbytes, nlen
   TYPE(tuple) :: args
   TYPE(dict) :: kwargs
   TYPE(module_py) :: pymod
   TYPE(object) :: return_obj
   INTEGER :: return_int
   INTEGER :: IERR
Marco Govoni's avatar
Marco Govoni committed
67
   !
Marco Govoni's avatar
Marco Govoni committed
68
   ! Gather the function 
Marco Govoni's avatar
Marco Govoni committed
69
   !
Marco Govoni's avatar
Marco Govoni committed
70
71
   ALLOCATE(f_r_gathered(dfft%nr1x*dfft%nr2x*dfft%nr3x)); f_r_gathered = 0._DP
   CALL gather_grid(dfft,f_r,f_r_gathered)
Marco Govoni's avatar
Marco Govoni committed
72
   !
Han Yang's avatar
Han Yang committed
73
   IF( me_bgrp == 0 ) THEN
Marco Govoni's avatar
Marco Govoni committed
74
      !
Marco Govoni's avatar
Marco Govoni committed
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
      ALLOCATE(f_r_gathered_nopadded(dfft%nr1*dfft%nr2*dfft%nr3)); f_r_gathered_nopadded = 0._DP
      CALL remove_padding_real(dfft,f_r_gathered,f_r_gathered_nopadded)
      !
      ! Encode
      !
      ndim = dfft%nr1*dfft%nr2*dfft%nr3
      nbytes = SIZEOF(f_r_gathered_nopadded(1)) * ndim
      nlen = lenbase64(nbytes)
      ALLOCATE(CHARACTER(LEN=nlen) :: charbase64)
      IF (.NOT. islittleendian()) CALL base64_byteswap_double(nbytes,f_r_gathered_nopadded(1:ndim))
      CALL base64_encode_double(f_r_gathered_nopadded(1:ndim), ndim, charbase64)
      DEALLOCATE(f_r_gathered_nopadded)
      !
      IERR = import_py(pymod, "function3d")
      !  
      IERR = tuple_create(args, 1)
      IERR = args%setitem(0, TRIM(ADJUSTL(fname)) )
      IERR = dict_create(kwargs)
      IERR = kwargs%setitem("name","delta_v")
      IERR = kwargs%setitem("domain",'{'// &
      & '"a":['//dtoa(celldm(1)*at(1,1))//","//dtoa(celldm(1)*at(2,1))//","//dtoa(celldm(1)*at(3,1))//'],'// &
      & '"b":['//dtoa(celldm(1)*at(1,2))//","//dtoa(celldm(1)*at(2,2))//","//dtoa(celldm(1)*at(3,2))//'],'// &
      & '"c":['//dtoa(celldm(1)*at(1,3))//","//dtoa(celldm(1)*at(2,3))//","//dtoa(celldm(1)*at(3,3))//'] }')
      IERR = kwargs%setitem("grid","["//itoa(dfft%nr1)//","//itoa(dfft%nr2)//","//itoa(dfft%nr3)//"]" )
      IERR = kwargs%setitem("grid_function",charbase64)
      IERR = kwargs%setitem("dtype","double")
      !
      IERR = call_py_noret(pymod, "base64_to_function3d", args, kwargs)
      !
      CALL kwargs%destroy
      CALL args%destroy
      CALL pymod%destroy
Marco Govoni's avatar
Marco Govoni committed
107
      !
Marco Govoni's avatar
Marco Govoni committed
108
109
110
   ENDIF
   ! 
   DEALLOCATE(f_r_gathered)
Marco Govoni's avatar
Marco Govoni committed
111
   !
Marco Govoni's avatar
Marco Govoni committed
112
113
 END SUBROUTINE 
 !
Marco Govoni's avatar
Marco Govoni committed
114
 !-----------------------------------------------------------------
Marco Govoni's avatar
Marco Govoni committed
115
   SUBROUTINE read_function3d_real ( fname, f_r, dfft )
Marco Govoni's avatar
Marco Govoni committed
116
117
   ! -----------------------------------------------------------------
   !
118
   USE kinds,                       ONLY : DP
Marco Govoni's avatar
Marco Govoni committed
119
   USE cell_base,                   ONLY : celldm, at
120
   USE control_flags,               ONLY : gamma_only
Marco Govoni's avatar
Marco Govoni committed
121
122
   USE mp_bands,                    ONLY : me_bgrp
   USE scatter_mod,                 ONLY : gather_grid
123
   USE fft_types,                   ONLY : fft_type_descriptor
Marco Govoni's avatar
Marco Govoni committed
124
125
126
127
128
129
   USE forpy_mod,  ONLY: call_py, call_py_noret, import_py, module_py
   USE forpy_mod,  ONLY: tuple, tuple_create 
   USE forpy_mod,  ONLY: dict, dict_create 
   USE forpy_mod,  ONLY: list, list_create 
   USE forpy_mod,  ONLY: object, cast
   USE forpy_mod,  ONLY: exception_matches, KeyError, err_clear, err_print 
Marco Govoni's avatar
Marco Govoni committed
130
131
132
133
134
135
136
   USE base64_module
   !
   IMPLICIT NONE
   !
   ! I/O 
   !
   CHARACTER(LEN=*),INTENT(IN) :: fname
Marco Govoni's avatar
Marco Govoni committed
137
138
   TYPE(fft_type_descriptor), INTENT(IN) :: dfft
   REAL(DP),INTENT(OUT) :: f_r(dfft%nnr)
Marco Govoni's avatar
Marco Govoni committed
139
140
141
142
   ! 
   ! Workspace
   !
   CHARACTER(LEN=:),ALLOCATABLE :: charbase64
Marco Govoni's avatar
Marco Govoni committed
143
144
145
146
147
148
149
150
151
152
   REAL(DP),ALLOCATABLE :: f_r_gathered(:), f_r_gathered_nopadded(:)
   INTEGER :: ndim, nbytes, nlen
   TYPE(tuple) :: args
   TYPE(dict) :: kwargs, return_dict
   TYPE(module_py) :: pymod
   TYPE(object) :: return_obj
   INTEGER :: return_int
   INTEGER :: IERR
   !
   ALLOCATE(f_r_gathered(dfft%nr1x*dfft%nr2x*dfft%nr3x)); f_r_gathered = 0._DP
Marco Govoni's avatar
Marco Govoni committed
153
   !
Han Yang's avatar
Han Yang committed
154
   IF( me_bgrp == 0 ) THEN
Marco Govoni's avatar
Marco Govoni committed
155
      !
Marco Govoni's avatar
Marco Govoni committed
156
      ! Decode
Marco Govoni's avatar
Marco Govoni committed
157
158
      !
      !
Marco Govoni's avatar
Marco Govoni committed
159
160
161
162
163
      IERR = import_py(pymod, "function3d")
      !  
      IERR = tuple_create(args, 1)
      IERR = args%setitem(0, TRIM(ADJUSTL(fname)) )
      IERR = dict_create(kwargs)
Marco Govoni's avatar
Marco Govoni committed
164
      !
Marco Govoni's avatar
Marco Govoni committed
165
      IERR = call_py(return_obj,pymod, "function3d_to_base64", args, kwargs)
Marco Govoni's avatar
Marco Govoni committed
166
      !
Marco Govoni's avatar
Marco Govoni committed
167
      IERR = cast(return_dict, return_obj)
Marco Govoni's avatar
Marco Govoni committed
168
      !
Marco Govoni's avatar
Marco Govoni committed
169
170
171
172
173
174
175
176
      ndim = dfft%nr1*dfft%nr2*dfft%nr3
      nbytes = SIZEOF(f_r_gathered_nopadded(1)) * ndim
      nlen = lenbase64(nbytes)
      ALLOCATE(CHARACTER(LEN=nlen) :: charbase64)
      IERR = return_dict%getitem(charbase64, "grid_function")
      ALLOCATE(f_r_gathered_nopadded(dfft%nr1*dfft%nr2*dfft%nr3)); f_r_gathered_nopadded = 0._DP
      CALL base64_decode_double(charbase64(1:nlen), ndim, f_r_gathered_nopadded(1:ndim))
      IF (.NOT. islittleendian()) CALL base64_byteswap_double(nbytes,f_r_gathered_nopadded(1:ndim))
Marco Govoni's avatar
Marco Govoni committed
177
      !
Marco Govoni's avatar
Marco Govoni committed
178
179
180
181
182
183
184
185
      CALL kwargs%destroy
      CALL args%destroy
      CALL return_obj%destroy
      CALL return_dict%destroy
      CALL pymod%destroy
      !
      CALL add_padding_real(dfft,f_r_gathered_nopadded,f_r_gathered)
      DEALLOCATE(f_r_gathered_nopadded) 
Marco Govoni's avatar
Marco Govoni committed
186
      !
187
188
   ENDIF
   !
Marco Govoni's avatar
Marco Govoni committed
189
190
191
   CALL scatter_grid(dfft,f_r_gathered,f_r)
   ! 
   DEALLOCATE(f_r_gathered)
Marco Govoni's avatar
Marco Govoni committed
192
193
194
   !
 END SUBROUTINE
 !
Marco Govoni's avatar
Marco Govoni committed
195
196
197
 SUBROUTINE add_padding_real(dfft,f_r_gathered_nopadded,f_r_gathered) 
   USE kinds, ONLY :DP
   USE fft_types,                   ONLY : fft_type_descriptor
Marco Govoni's avatar
Marco Govoni committed
198
   IMPLICIT NONE
Marco Govoni's avatar
Marco Govoni committed
199
200
201
202
203
204
205
206
207
208
209
210
211
   TYPE(fft_type_descriptor), INTENT(IN) :: dfft
   REAL(DP),INTENT(IN) :: f_r_gathered_nopadded(dfft%nr1*dfft%nr2*dfft%nr3)
   REAL(DP),INTENT(OUT) :: f_r_gathered(dfft%nr1x*dfft%nr2x*dfft%nr3x)
   INTEGER :: i,j,k,ir_notpadded,ir_padded
   f_r_gathered = 0._DP
   DO k = 1, dfft%nr3
      DO j = 1, dfft%nr2
         DO i = 1, dfft%nr1
            ir_notpadded = (i-1)*dfft%nr1 *dfft%nr2  + (j-1)*dfft%nr2  + k
            ir_padded    = (i-1)*dfft%nr1x*dfft%nr2x + (j-1)*dfft%nr2x + k
            f_r_gathered(ir_padded) = f_r_gathered_nopadded(ir_notpadded)
         ENDDO
      ENDDO
Marco Govoni's avatar
Marco Govoni committed
212
213
214
   ENDDO
 END SUBROUTINE
 !
Marco Govoni's avatar
Marco Govoni committed
215
216
217
 SUBROUTINE remove_padding_real(dfft,f_r_gathered,f_r_gathered_nopadded) 
   USE kinds, ONLY :DP
   USE fft_types,                   ONLY : fft_type_descriptor
Marco Govoni's avatar
Marco Govoni committed
218
   IMPLICIT NONE
Marco Govoni's avatar
Marco Govoni committed
219
220
221
222
223
224
225
226
227
228
229
230
231
   TYPE(fft_type_descriptor), INTENT(IN) :: dfft
   REAL(DP),INTENT(IN) :: f_r_gathered(dfft%nr1x*dfft%nr2x*dfft%nr3x)
   REAL(DP),INTENT(OUT) :: f_r_gathered_nopadded(dfft%nr1*dfft%nr2*dfft%nr3)
   INTEGER :: i,j,k,ir_notpadded,ir_padded
   f_r_gathered_nopadded = 0._DP
   DO k = 1, dfft%nr3
      DO j = 1, dfft%nr2
         DO i = 1, dfft%nr1
            ir_notpadded = (i-1)*dfft%nr1 *dfft%nr2  + (j-1)*dfft%nr2  + k
            ir_padded    = (i-1)*dfft%nr1x*dfft%nr2x + (j-1)*dfft%nr2x + k
            f_r_gathered_nopadded(ir_notpadded) = f_r_gathered(ir_padded)
         ENDDO
      ENDDO
Marco Govoni's avatar
Marco Govoni committed
232
233
234
   ENDDO
 END SUBROUTINE
 !
Marco Govoni's avatar
Marco Govoni committed
235
END MODULE