V3FIT
m_grid.f
Go to the documentation of this file.
1 !*******************************************************************************
4 !
5 ! Note separating the Doxygen comment block here so detailed decription is
6 ! found in the Module not the file.
7 !
10 !*******************************************************************************
11  MODULE m_grid
12  USE stel_kinds, ONLY: rprec
13  USE profiler
14 
15  IMPLICIT NONE
16 
17 !*******************************************************************************
18 ! DERIVED-TYPE DECLARATIONS
19 ! 1) m grid base class
20 !
21 !*******************************************************************************
22 !-------------------------------------------------------------------------------
25 !-------------------------------------------------------------------------------
26  TYPE m_grid_class
28  REAL (rprec) :: rmin
30  REAL (rprec) :: rmax
32  REAL (rprec) :: zmin
34  REAL (rprec) :: zmax
35 
37  REAL (rprec) :: dr
39  REAL (rprec) :: dz
40 
42  INTEGER :: nfp
43 
45  REAL (rprec), DIMENSION(:,:,:), POINTER :: a_r => null()
47  REAL (rprec), DIMENSION(:,:,:), POINTER :: a_p => null()
49  REAL (rprec), DIMENSION(:,:,:), POINTER :: a_z => null()
50  END TYPE
51 
52  CONTAINS
53 !*******************************************************************************
54 ! CONSTRUCTION SUBROUTINES
55 !*******************************************************************************
56 !-------------------------------------------------------------------------------
66 !-------------------------------------------------------------------------------
67  FUNCTION m_grid_construct(mgrid_file_name, parallel, io_unit)
68  USE ezcdf
69  USE read_wout_mod, Only: extcur
70  USE bmw_parallel_context
71 
72  IMPLICIT NONE
73 
74 ! Declare Arguments
75  TYPE (m_grid_class), POINTER :: m_grid_construct
76  CHARACTER (len=*), INTENT(in) :: mgrid_file_name
77  TYPE (bmw_parallel_context_class), INTENT(in) :: parallel
78  INTEGER, INTENT(in) :: io_unit
79 
80 ! local variables
81  REAL (rprec) :: start_time
82  INTEGER :: mgrid_ncid
83  INTEGER :: i
84  INTEGER :: status
85  INTEGER :: varid
86  INTEGER :: num_r
87  INTEGER :: num_p
88  INTEGER :: num_z
89  REAL (rprec), DIMENSION(:,:,:), ALLOCATABLE :: temp_buffer
90  CHARACTER (len=6) :: temp_string
91  INTEGER, DIMENSION(3) :: temp_dims
92 
93 ! Start of executable code
94  start_time = profiler_get_start_time()
95 
96  ALLOCATE(m_grid_construct)
97 
98  CALL cdf_open(mgrid_ncid, trim(mgrid_file_name), 'r', status)
99 
100  CALL cdf_inquire(mgrid_ncid, 'ar_001', temp_dims, ier=status)
101  IF (status .ne. 0) THEN
102  IF (parallel%offset .eq. 0) THEN
103  WRITE (io_unit,3000) trim(mgrid_file_name)
104  END IF
105  CALL bmw_parallel_context_abort(status)
106  END IF
107 
108  CALL cdf_read(mgrid_ncid, 'ir', num_r)
109  CALL cdf_read(mgrid_ncid, 'kp', num_p)
110  CALL cdf_read(mgrid_ncid, 'jz', num_z)
111 
112  CALL cdf_read(mgrid_ncid, 'nfp', m_grid_construct%nfp)
113 
114  CALL cdf_read(mgrid_ncid, 'rmax', m_grid_construct%rmax)
115  CALL cdf_read(mgrid_ncid, 'zmax', m_grid_construct%zmax)
116  CALL cdf_read(mgrid_ncid, 'rmin', m_grid_construct%rmin)
117  CALL cdf_read(mgrid_ncid, 'zmin', m_grid_construct%zmin)
118 
119  m_grid_construct%dr = (m_grid_construct%rmax - &
120  & m_grid_construct%rmin)/(num_r - 1.0)
121  m_grid_construct%dz = (m_grid_construct%zmax - &
122  & m_grid_construct%zmin)/(num_z - 1.0)
123 
124  ALLOCATE(m_grid_construct%a_r(num_r, num_z, num_p))
125  ALLOCATE(m_grid_construct%a_p(num_r, num_z, num_p))
126  ALLOCATE(m_grid_construct%a_z(num_r, num_z, num_p))
127 
128 !$OMP PARALLEL
129 !$OMP WORKSHARE
130  m_grid_construct%a_r = 0.0
131  m_grid_construct%a_p = 0.0
132  m_grid_construct%a_z = 0.0
133 !$OMP END WORKSHARE
134 !$OMP END PARALLEL
135 
136  ALLOCATE(temp_buffer(num_r, num_z, num_p))
137 
138  DO i = 1 + parallel%offset, SIZE(extcur), parallel%stride
139  WRITE (temp_string, 1000) i
140  CALL cdf_read(mgrid_ncid, temp_string, temp_buffer)
141  m_grid_construct%a_r = m_grid_construct%a_r &
142  & + temp_buffer*extcur(i)
143 
144  WRITE (temp_string, 1001) i
145  CALL cdf_read(mgrid_ncid, temp_string, temp_buffer)
146  m_grid_construct%a_p = m_grid_construct%a_p &
147  & + temp_buffer*extcur(i)
148 
149  WRITE (temp_string, 1002) i
150  CALL cdf_read(mgrid_ncid, temp_string, temp_buffer)
151  m_grid_construct%a_z = m_grid_construct%a_z &
152  & + temp_buffer*extcur(i)
153  END DO
154 
155  IF (parallel%stride .gt. 1) THEN
156  CALL bmw_parallel_context_reduce(parallel, &
157  & m_grid_construct%a_r)
158  CALL bmw_parallel_context_reduce(parallel, &
159  & m_grid_construct%a_p)
160  CALL bmw_parallel_context_reduce(parallel, &
161  & m_grid_construct%a_z)
162  END IF
163 
164  DEALLOCATE(temp_buffer)
165 
166  CALL cdf_close(mgrid_ncid)
167 
168  IF (parallel%offset .eq. 0) THEN
169  WRITE (io_unit,2000)
170  END IF
171 
172  CALL profiler_set_stop_time('m_grid_construct', start_time)
173 
174 1000 FORMAT('ar_',i3.3)
175 1001 FORMAT('ap_',i3.3)
176 1002 FORMAT('az_',i3.3)
177 
178 2000 FORMAT('M Grid Ready')
179 
180 3000 FORMAT(a,' does not contain the vacuum vector potential.')
181 
182  END FUNCTION
183 
184 !*******************************************************************************
185 ! DESTRUCTION SUBROUTINES
186 !*******************************************************************************
187 !-------------------------------------------------------------------------------
193 !-------------------------------------------------------------------------------
194  SUBROUTINE m_grid_destruct(this)
195 
196  IMPLICIT NONE
197 
198 ! Declare Arguments
199  TYPE (m_grid_class), POINTER :: this
200 
201 ! Start of executable code
202  IF (ASSOCIATED(this%a_r)) THEN
203  DEALLOCATE(this%a_r)
204  this%a_r => null()
205  END IF
206 
207  IF (ASSOCIATED(this%a_p)) THEN
208  DEALLOCATE(this%a_p)
209  this%a_p => null()
210  END IF
211 
212  IF (ASSOCIATED(this%a_z)) THEN
213  DEALLOCATE(this%a_z)
214  this%a_z => null()
215  END IF
216 
217  DEALLOCATE(this)
218 
219  END SUBROUTINE
220 
221 !*******************************************************************************
222 ! UTILITY SUBROUTINES
223 !*******************************************************************************
224 !-------------------------------------------------------------------------------
237 !-------------------------------------------------------------------------------
238  PURE SUBROUTINE m_grid_interpolate(this, r, phi, z, ar, ap, az)
239  USE stel_constants, ONLY: twopi
240 
241  IMPLICIT NONE
242 
243 ! Declare Arguments
244  TYPE (m_grid_class), INTENT(in) :: this
245  REAL (rprec), INTENT(in) :: r
246  REAL (rprec), INTENT(in) :: phi
247  REAL (rprec), INTENT(in) :: z
248  REAL (rprec), INTENT(out) :: ar
249  REAL (rprec), INTENT(out) :: ap
250  REAL (rprec), INTENT(out) :: az
251 
252 ! local variables
253  REAL (rprec) :: norm_phi
254  REAL (rprec) :: dphi
255  REAL (rprec) :: i
256  REAL (rprec) :: j
257  REAL (rprec) :: k
258  INTEGER :: ilow
259  INTEGER :: ihigh
260  INTEGER :: jlow
261  INTEGER :: jhigh
262  INTEGER :: klow
263  INTEGER :: khigh
264 
265 ! Start of executable code
266  dphi = twopi/(this%nfp*SIZE(this%a_r, 3))
267 
268  norm_phi = phi
269  DO WHILE (norm_phi > twopi/this%nfp)
270  norm_phi = norm_phi - twopi/this%nfp
271  END DO
272 
273 ! Find the nearest index positions.
274  i = (r - this%rmin)/this%dr + 1.0
275  j = (z - this%zmin)/this%dz + 1.0
276  k = norm_phi/dphi + 1.0
277 
278  ilow = floor(i)
279  ihigh = ceiling(i)
280  jlow = floor(j)
281  jhigh = ceiling(j)
282  klow = floor(k)
283  IF (k .gt. SIZE(this%a_r, 3)) THEN
284  khigh = 1
285  ELSE
286  khigh = ceiling(k)
287  END IF
288 
289 ! Scale index from 0 - 1.
290  i = i - ilow
291  j = j - jlow
292  k = k - klow
293 
294  ar = m_grid_intf( &
295  & m_grid_intf( &
296  & m_grid_intf( &
297  & this%a_r(ilow,jlow,klow), &
298  & this%a_r(ihigh,jlow,klow), &
299  & i), &
300  & m_grid_intf( &
301  & this%a_r(ilow,jhigh,klow), &
302  & this%a_r(ihigh,jhigh,klow), &
303  & i), &
304  & j), &
305  & m_grid_intf( &
306  & m_grid_intf( &
307  & this%a_r(ilow,jlow,khigh), &
308  & this%a_r(ihigh,jlow,khigh), &
309  & i), &
310  & m_grid_intf( &
311  & this%a_r(ilow,jhigh,khigh), &
312  & this%a_r(ihigh,jhigh,khigh), &
313  & i), &
314  & j), &
315  & k)
316 
317  ap = m_grid_intf( &
318  & m_grid_intf( &
319  & m_grid_intf( &
320  & this%a_p(ilow,jlow,klow), &
321  & this%a_p(ihigh,jlow,klow), &
322  & i), &
323  & m_grid_intf( &
324  & this%a_p(ilow,jhigh,klow), &
325  & this%a_p(ihigh,jhigh,klow), &
326  & i), &
327  & j), &
328  & m_grid_intf( &
329  & m_grid_intf( &
330  & this%a_p(ilow,jlow,khigh), &
331  & this%a_p(ihigh,jlow,khigh), &
332  & i), &
333  & m_grid_intf( &
334  & this%a_p(ilow,jhigh,khigh), &
335  & this%a_p(ihigh,jhigh,khigh), &
336  & i), &
337  & j), &
338  & k)
339 
340  az = m_grid_intf( &
341  & m_grid_intf( &
342  & m_grid_intf( &
343  & this%a_z(ilow,jlow,klow), &
344  & this%a_z(ihigh,jlow,klow), &
345  & i), &
346  & m_grid_intf( &
347  & this%a_z(ilow,jhigh,klow), &
348  & this%a_z(ihigh,jhigh,klow), &
349  & i), &
350  & j), &
351  & m_grid_intf( &
352  & m_grid_intf( &
353  & this%a_z(ilow,jlow,khigh), &
354  & this%a_z(ihigh,jlow,khigh), &
355  & i), &
356  & m_grid_intf( &
357  & this%a_z(ilow,jhigh,khigh), &
358  & this%a_z(ihigh,jhigh,khigh), &
359  & i), &
360  & j), &
361  & k)
362 
363  END SUBROUTINE
364 
365 !*******************************************************************************
366 ! UTILITY SUBROUTINES
367 !*******************************************************************************
368  PURE FUNCTION m_grid_intf(w1, w2, x)
369 
370  IMPLICIT NONE
371 
372 ! Declare Arguments
373  REAL (rprec) :: m_grid_intf
374  REAL (rprec), INTENT(in) :: w1
375  REAL (rprec), INTENT(in) :: w2
376  REAL (rprec), INTENT(in) :: x
377 
378 ! Start of executable code
379  m_grid_intf = w1*(1.0 - x) + w2*x
380 
381  END FUNCTION
382 
383  END MODULE
profiler
Defines functions for measuring an tabulating performance of function and subroutine calls....
Definition: profiler.f:13
m_grid::m_grid_interpolate
pure subroutine m_grid_interpolate(this, r, phi, z, ar, ap, az)
Interpolate the vector potential at a point.
Definition: m_grid.f:239
m_grid
Defines the base class of the type m_grid_class. This contains the state variables to define the vacu...
Definition: m_grid.f:11
m_grid::m_grid_construct
type(m_grid_class) function, pointer m_grid_construct(mgrid_file_name, parallel, io_unit)
Construct a m_grid_class object.
Definition: m_grid.f:68
bmw_parallel_context
Defines the base class of the type bmw_parallel_context_class. This contains the state variables need...
Definition: bmw_parallel_context.f:11
profiler::profiler_get_start_time
real(rprec) function profiler_get_start_time()
Gets the start time of profiled function.
Definition: profiler.f:194
bmw_parallel_context::bmw_parallel_context_abort
subroutine bmw_parallel_context_abort(status)
Abort the entire program.
Definition: bmw_parallel_context.f:177
m_grid::m_grid_destruct
subroutine m_grid_destruct(this)
Deconstruct a m_grid_class object.
Definition: m_grid.f:195
bmw_parallel_context::bmw_parallel_context_reduce
Interface for the buffer reduction.
Definition: bmw_parallel_context.f:49
m_grid::m_grid_class
Base class representing a m grid. This is grid contains information about the vacuum fields.
Definition: m_grid.f:26
profiler::profiler_set_stop_time
subroutine profiler_set_stop_time(symbol_name, start_time)
Gets the end time of profiled function.
Definition: profiler.f:121
bmw_parallel_context::bmw_parallel_context_class
Base class representing a bmw parallel context. This contains all memory needed parameters needed to ...
Definition: bmw_parallel_context.f:26
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17