V3FIT
siesta_context.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 siesta_context
12  USE stel_kinds
13  USE profiler
14 
15  IMPLICIT NONE
16 
17 ! FIXME: This is a hack remove everything between these FIXME statements once
18 ! siesta is fully coupled
19  LOGICAL :: lasym = .true.
20  LOGICAL :: lrecon = .true.
21  LOGICAL :: lcolscale = .true.
22  LOGICAL :: ladd_pert = .true.
23  LOGICAL :: lresistive = .true.
24  LOGICAL :: lrestart = .false.
25  INTEGER :: niter = 100
26  INTEGER :: nsin = 50
27  INTEGER :: mpolin = 12
28  INTEGER :: ntorin = 2
29  REAL (rprec) :: ftol = 1.0e-20
30  REAL (rprec) :: levmarq_param = 3.0e-2
31  REAL (rprec) :: mupar = 1.0e-3
32  CHARACTER (len=100) :: &
33  & wout_file = 'wout_154921.02530.asym.ntor1.nc'
34  CHARACTER (len=100) :: restart_ext = 'restart_cth_'
35  INTEGER, DIMENSION(10) :: mres
36  REAL (rprec), DIMENSION(10) :: helpert
37 
38  NAMELIST/siesta_info/ &
39  & lasym, lrecon, lcolscale, ladd_pert, lresistive, lrestart, &
40  & niter, nsin, mpolin, ntorin, ftol, levmarq_param, mupar, &
41  & wout_file, restart_ext, mres, helpert
42 ! FIXME: This is a hack remove everything between these FIXME statements once
43 ! siesta is fully coupled
44 
45 !*******************************************************************************
46 ! DERIVED-TYPE DECLARATIONS
47 ! 1) siesta_context_class class
48 !
49 !*******************************************************************************
50 !-------------------------------------------------------------------------------
53 !-------------------------------------------------------------------------------
54  TYPE siesta_context_class
56  LOGICAL :: l_asym
57 
59  INTEGER :: ns
61  INTEGER :: mpol
63  INTEGER :: ntor
64 
66  REAL (rprec) :: p_factor
67 
69  REAL (rprec) :: p_min
71  REAL (rprec) :: p_max
73  REAL (rprec), DIMENSION(:,:,:), POINTER :: pmnch => null()
75  REAL (rprec), DIMENSION(:,:,:), POINTER :: pmnsh => null()
76 
78  REAL (rprec) :: b_factor
79 
81  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupsmnch => null()
83  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupsmnsh => null()
85  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupumnch => null()
87  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupumnsh => null()
89  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupvmnch => null()
91  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsupvmnsh => null()
92 
94  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubsmnch => null()
96  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubsmnsh => null()
98  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubumnch => null()
100  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubumnsh => null()
102  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubvmnch => null()
104  REAL (rprec), DIMENSION(:,:,:), POINTER :: bsubvmnsh => null()
105 
107  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupsmncf => null()
109  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupsmnsf => null()
111  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupumncf => null()
113  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupumnsf => null()
115  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupvmncf => null()
117  REAL (rprec), DIMENSION(:,:,:), POINTER :: jksupvmnsf => null()
118  END TYPE
119 
120  CONTAINS
121 !*******************************************************************************
122 ! CONSTRUCTION SUBROUTINES
123 !*******************************************************************************
124 !-------------------------------------------------------------------------------
131 !-------------------------------------------------------------------------------
132  FUNCTION siesta_context_construct(restart_file_name)
133  USE ezcdf
134  USE file_opts, only: path_length
135 
136  IMPLICIT NONE
137 
138 ! Declare Arguments
139  TYPE (siesta_context_class), POINTER :: siesta_context_construct
140  CHARACTER (len=*), INTENT(in) :: restart_file_name
141 
142 ! local variables
143  INTEGER :: ncid
144  INTEGER :: ns
145  INTEGER :: mpol
146  INTEGER :: ntor
147  INTEGER :: status
148  INTEGER :: i
149  INTEGER :: flags
150  REAL (rprec) :: start_time
151 
152 ! local parameters
153  INTEGER, PARAMETER :: l_asym_flag = 31
154 
155 ! Start of executable code
156  start_time = profiler_get_start_time()
157 
158  ALLOCATE(siesta_context_construct)
159 
160  CALL cdf_open(ncid, trim(restart_file_name), 'r', status)
161 
162  CALL cdf_read(ncid, 'nrad', ns)
163  CALL cdf_read(ncid, 'mpol', mpol)
164  CALL cdf_read(ncid, 'ntor', ntor)
165 
166  siesta_context_construct%ns = ns
167  siesta_context_construct%mpol = mpol
168  siesta_context_construct%ntor = ntor
169 
170  CALL cdf_read(ncid, 'state_flags', flags)
171  siesta_context_construct%l_asym = btest(flags, l_asym_flag)
172 
173 ! Pressure
174  CALL cdf_read(ncid, 'p_factor', siesta_context_construct%p_factor)
175 
176  CALL cdf_read(ncid, 'p_min', siesta_context_construct%p_min)
177  CALL cdf_read(ncid, 'p_max', siesta_context_construct%p_max)
178 
179  ALLOCATE(siesta_context_construct%pmnch(0:mpol,-ntor:ntor,ns))
180  CALL cdf_read(ncid, 'pmnch(m,n,r)', &
181  & siesta_context_construct%pmnch)
182 
183 ! Magnetic field
184  CALL cdf_read(ncid, 'b_factor', siesta_context_construct%b_factor)
185 
186 ! Bsup*
187  ALLOCATE(siesta_context_construct%bsupsmnsh(0:mpol,-ntor:ntor,ns))
188  CALL cdf_read(ncid, 'bsupsmnsh(m,n,r)', &
189  & siesta_context_construct%bsupsmnsh)
190  ALLOCATE(siesta_context_construct%bsupumnch(0:mpol,-ntor:ntor,ns))
191  CALL cdf_read(ncid, 'bsupumnch(m,n,r)', &
192  & siesta_context_construct%bsupumnch)
193  ALLOCATE(siesta_context_construct%bsupvmnch(0:mpol,-ntor:ntor,ns))
194  CALL cdf_read(ncid, 'bsupvmnch(m,n,r)', &
195  & siesta_context_construct%bsupvmnch)
196 
197 ! Bsub*
198  ALLOCATE(siesta_context_construct%bsubsmnsh(0:mpol,-ntor:ntor,ns))
199  CALL cdf_read(ncid, 'bsubsmnsh(m,n,r)', &
200  & siesta_context_construct%bsubsmnsh)
201  ALLOCATE(siesta_context_construct%bsubumnch(0:mpol,-ntor:ntor,ns))
202  CALL cdf_read(ncid, 'bsubumnch(m,n,r)', &
203  & siesta_context_construct%bsubumnch)
204  ALLOCATE(siesta_context_construct%bsubvmnch(0:mpol,-ntor:ntor,ns))
205  CALL cdf_read(ncid, 'bsubvmnch(m,n,r)', &
206  & siesta_context_construct%bsubvmnch)
207 
208 ! JKsup*
209  ALLOCATE(siesta_context_construct%jksupsmnsf(0:mpol,-ntor:ntor, &
210  & ns))
211  CALL cdf_read(ncid, 'jksupsmnsf(m,n,r)', &
212  & siesta_context_construct%jksupsmnsf)
213  ALLOCATE(siesta_context_construct%jksupumncf(0:mpol,-ntor:ntor, &
214  & ns))
215  CALL cdf_read(ncid, 'jksupumncf(m,n,r)', &
216  & siesta_context_construct%jksupumncf)
217  ALLOCATE(siesta_context_construct%jksupvmncf(0:mpol,-ntor:ntor, &
218  & ns))
219  CALL cdf_read(ncid, 'jksupvmncf(m,n,r)', &
220  & siesta_context_construct%jksupvmncf)
221 
222  IF (siesta_context_construct%l_asym) THEN
223 ! Pressure
224  ALLOCATE(siesta_context_construct%pmnsh(0:mpol,-ntor:ntor,ns))
225  CALL cdf_read(ncid, 'pmnsh(m,n,r)', &
226  & siesta_context_construct%pmnsh)
227 
228 ! Bsup*
229  ALLOCATE(siesta_context_construct%bsupsmnch(0:mpol,-ntor:ntor, &
230  & ns))
231  CALL cdf_read(ncid, 'bsupsmnch(m,n,r)', &
232  & siesta_context_construct%bsupsmnch)
233  ALLOCATE(siesta_context_construct%bsupumnsh(0:mpol,-ntor:ntor, &
234  & ns))
235  CALL cdf_read(ncid, 'bsupumnsh(m,n,r)', &
236  & siesta_context_construct%bsupumnsh)
237  ALLOCATE(siesta_context_construct%bsupvmnsh(0:mpol,-ntor:ntor, &
238  & ns))
239  CALL cdf_read(ncid, 'bsupvmnsh(m,n,r)', &
240  & siesta_context_construct%bsupvmnsh)
241 
242 ! Bsub*
243  ALLOCATE(siesta_context_construct%bsubsmnch(0:mpol,-ntor:ntor, &
244  & ns))
245  CALL cdf_read(ncid, 'bsubsmnch(m,n,r)', &
246  & siesta_context_construct%bsubsmnch)
247  ALLOCATE(siesta_context_construct%bsubumnsh(0:mpol,-ntor:ntor, &
248  & ns))
249  CALL cdf_read(ncid, 'bsubumnsh(m,n,r)', &
250  & siesta_context_construct%bsubumnsh)
251  ALLOCATE(siesta_context_construct%bsubvmnsh(0:mpol,-ntor:ntor, &
252  & ns))
253  CALL cdf_read(ncid, 'bsubvmnsh(m,n,r)', &
254  & siesta_context_construct%bsubvmnsh)
255 
256 ! JKsup*
257  ALLOCATE(siesta_context_construct%jksupsmncf(0:mpol,-ntor:ntor, &
258  & ns))
259  CALL cdf_read(ncid, 'jksupsmncf(m,n,r)', &
260  & siesta_context_construct%jksupsmncf)
261  ALLOCATE(siesta_context_construct%jksupumnsf(0:mpol,-ntor:ntor, &
262  & ns))
263  CALL cdf_read(ncid, 'jksupumnsf(m,n,r)', &
264  & siesta_context_construct%jksupumnsf)
265  ALLOCATE(siesta_context_construct%jksupvmnsf(0:mpol,-ntor:ntor, &
266  & ns))
267  CALL cdf_read(ncid, 'jksupvmnsf(m,n,r)', &
268  & siesta_context_construct%jksupvmnsf)
269  END IF
270 
271  CALL cdf_close(ncid)
272 
273  CALL profiler_set_stop_time('siesta_context_construct', &
274  & start_time)
275 
276  END FUNCTION
277 
278 !*******************************************************************************
279 ! DESTRUCTION SUBROUTINES
280 !*******************************************************************************
281 !-------------------------------------------------------------------------------
287 !-------------------------------------------------------------------------------
288  SUBROUTINE siesta_context_destruct(this)
289 
290  IMPLICIT NONE
291 
292 ! Declare Arguments
293  TYPE (siesta_context_class), POINTER :: this
294 
295 ! Start of executable code
296  IF (ASSOCIATED(this%pmnch)) THEN
297  DEALLOCATE(this%pmnch)
298  this%pmnch => null()
299  END IF
300 
301  IF (ASSOCIATED(this%pmnsh)) THEN
302  DEALLOCATE(this%pmnsh)
303  this%pmnsh => null()
304  END IF
305 
306  IF (ASSOCIATED(this%bsupsmnsh)) THEN
307  DEALLOCATE(this%bsupsmnsh)
308  this%bsupsmnsh => null()
309  END IF
310 
311  IF (ASSOCIATED(this%bsupsmnch)) THEN
312  DEALLOCATE(this%bsupsmnch)
313  this%bsupsmnch => null()
314  END IF
315 
316  IF (ASSOCIATED(this%bsupumnsh)) THEN
317  DEALLOCATE(this%bsupumnsh)
318  this%bsupumnsh => null()
319  END IF
320 
321  IF (ASSOCIATED(this%bsupumnch)) THEN
322  DEALLOCATE(this%bsupumnch)
323  this%bsupumnch => null()
324  END IF
325 
326  IF (ASSOCIATED(this%bsupvmnsh)) THEN
327  DEALLOCATE(this%bsupvmnsh)
328  this%bsupvmnsh => null()
329  END IF
330 
331  IF (ASSOCIATED(this%bsupvmnch)) THEN
332  DEALLOCATE(this%bsupvmnch)
333  this%bsupvmnch => null()
334  END IF
335 
336  IF (ASSOCIATED(this%bsubsmnsh)) THEN
337  DEALLOCATE(this%bsubsmnsh)
338  this%bsubsmnsh => null()
339  END IF
340 
341  IF (ASSOCIATED(this%bsubsmnch)) THEN
342  DEALLOCATE(this%bsubsmnch)
343  this%bsubsmnch => null()
344  END IF
345 
346  IF (ASSOCIATED(this%bsubumnsh)) THEN
347  DEALLOCATE(this%bsubumnsh)
348  this%bsubumnsh => null()
349  END IF
350 
351  IF (ASSOCIATED(this%bsubumnch)) THEN
352  DEALLOCATE(this%bsubumnch)
353  this%bsubumnch => null()
354  END IF
355 
356  IF (ASSOCIATED(this%bsubvmnsh)) THEN
357  DEALLOCATE(this%bsubvmnsh)
358  this%bsubvmnsh => null()
359  END IF
360 
361  IF (ASSOCIATED(this%bsubvmnch)) THEN
362  DEALLOCATE(this%bsubvmnch)
363  this%bsubvmnch => null()
364  END IF
365 
366  IF (ASSOCIATED(this%jksupsmnsf)) THEN
367  DEALLOCATE(this%jksupsmnsf)
368  this%jksupsmnsf => null()
369  END IF
370 
371  IF (ASSOCIATED(this%jksupsmncf)) THEN
372  DEALLOCATE(this%jksupsmncf)
373  this%jksupsmncf => null()
374  END IF
375 
376  IF (ASSOCIATED(this%jksupumnsf)) THEN
377  DEALLOCATE(this%jksupumnsf)
378  this%jksupumnsf => null()
379  END IF
380 
381  IF (ASSOCIATED(this%jksupumncf)) THEN
382  DEALLOCATE(this%jksupumncf)
383  this%jksupumncf => null()
384  END IF
385 
386  IF (ASSOCIATED(this%jksupvmnsf)) THEN
387  DEALLOCATE(this%jksupvmnsf)
388  this%jksupvmnsf => null()
389  END IF
390 
391  IF (ASSOCIATED(this%jksupvmncf)) THEN
392  DEALLOCATE(this%jksupvmncf)
393  this%jksupvmncf => null()
394  END IF
395 
396  DEALLOCATE(this)
397 
398  END SUBROUTINE
399 
400 !*******************************************************************************
401 ! UTILITY SUBROUTINES
402 !*******************************************************************************
403 !-------------------------------------------------------------------------------
410 !-------------------------------------------------------------------------------
411  SUBROUTINE siesta_context_read(this, restart_file_name)
412  USE ezcdf
413  USE file_opts, only: path_length
414 
415  IMPLICIT NONE
416 
417 ! Declare Arguments
418  TYPE (siesta_context_class), POINTER :: this
419  CHARACTER (len=*), INTENT(in) :: restart_file_name
420 
421 ! local variables
422  INTEGER :: ncid
423  INTEGER :: status
424  INTEGER :: i
425  INTEGER :: flags
426  CHARACTER (len=path_length) :: wout_file_name
427  REAL (rprec) :: start_time
428 
429 ! local parameters
430  INTEGER, PARAMETER :: l_asym_flag = 31
431 
432 ! Start of executable code
433  start_time = profiler_get_start_time()
434 
435  CALL cdf_open(ncid, trim(restart_file_name), 'r', status)
436  IF (status .ne. 0) stop 'Failed'
437 
438  CALL cdf_read(ncid, 'nrad', this%ns)
439  CALL cdf_read(ncid, 'mpol', this%mpol)
440  CALL cdf_read(ncid, 'ntor', this%ntor)
441 
442  CALL cdf_read(ncid, 'state_flags', flags)
443  IF (this%l_asym .neqv. btest(flags, l_asym_flag)) THEN
444  stop 'Restart file changed parity.'
445  END IF
446 
447 ! Pressure
448  CALL cdf_read(ncid, 'p_factor', this%p_factor)
449 
450  CALL cdf_read(ncid, 'p_min', this%p_min)
451  CALL cdf_read(ncid, 'p_max', this%p_max)
452 
453  CALL cdf_read(ncid, 'pmnch(m,n,r)', this%pmnch)
454 
455 ! Magnetic field
456  CALL cdf_read(ncid, 'b_factor', this%b_factor)
457 
458 ! Bsup*
459  CALL cdf_read(ncid, 'bsupsmnsh(m,n,r)', this%bsupsmnsh)
460  CALL cdf_read(ncid, 'bsupumnch(m,n,r)', this%bsupumnch)
461  CALL cdf_read(ncid, 'bsupvmnch(m,n,r)', this%bsupvmnch)
462 
463 ! Bsub*
464  CALL cdf_read(ncid, 'bsubsmnsh(m,n,r)', this%bsubsmnsh)
465  CALL cdf_read(ncid, 'bsubumnch(m,n,r)', this%bsubumnch)
466  CALL cdf_read(ncid, 'bsubvmnch(m,n,r)', this%bsubvmnch)
467 
468 ! JKsup*
469  CALL cdf_read(ncid, 'jksupsmnsf(m,n,r)', this%jksupsmnsf)
470  CALL cdf_read(ncid, 'jksupumncf(m,n,r)', this%jksupumncf)
471  CALL cdf_read(ncid, 'jksupvmncf(m,n,r)', this%jksupvmncf)
472 
473  IF (this%l_asym) THEN
474 ! Pressure
475  CALL cdf_read(ncid, 'pmnsh(m,n,r)', this%pmnsh)
476 
477 ! Bsup*
478  CALL cdf_read(ncid, 'bsupsmnch(m,n,r)', this%bsupsmnch)
479  CALL cdf_read(ncid, 'bsupumnsh(m,n,r)', this%bsupumnsh)
480  CALL cdf_read(ncid, 'bsupvmnsh(m,n,r)', this%bsupvmnsh)
481 
482 ! Bsub*
483  CALL cdf_read(ncid, 'bsubsmnch(m,n,r)', this%bsubsmnch)
484  CALL cdf_read(ncid, 'bsubumnsh(m,n,r)', this%bsubumnsh)
485  CALL cdf_read(ncid, 'bsubvmnsh(m,n,r)', this%bsubvmnsh)
486 
487 ! JKsup*
488  CALL cdf_read(ncid, 'jksupsmncf(m,n,r)', this%jksupsmncf)
489  CALL cdf_read(ncid, 'jksupumnsf(m,n,r)', this%jksupumnsf)
490  CALL cdf_read(ncid, 'jksupvmnsf(m,n,r)', this%jksupvmnsf)
491  END IF
492 
493  CALL cdf_close(ncid)
494 
495  CALL profiler_set_stop_time('siesta_context_read', start_time)
496 
497  END SUBROUTINE
498 
499  END MODULE
profiler
Defines functions for measuring an tabulating performance of function and subroutine calls....
Definition: profiler.f:13
siesta_context::siesta_context_destruct
subroutine siesta_context_destruct(this)
Deconstruct a siesta_context_class object.
Definition: siesta_context.f:289
profiler::profiler_get_start_time
real(rprec) function profiler_get_start_time()
Gets the start time of profiled function.
Definition: profiler.f:194
siesta_context::siesta_context_construct
type(siesta_context_class) function, pointer siesta_context_construct(restart_file_name)
Construct a siesta_context_class object.
Definition: siesta_context.f:133
file_opts
Contains cross platform routines for manipulating files on the file system. Defines a functions to mo...
Definition: file_opts.f:13
siesta_context
Defines the base class of the type siesta_context_class. This contains the state variables needed by ...
Definition: siesta_context.f:11
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
siesta_context::siesta_context_class
Base class representing a siesta_context. This contains a copy of every variable that is needed to de...
Definition: siesta_context.f:54
file_opts::path_length
integer, parameter path_length
Length of file paths.
Definition: file_opts.f:22
siesta_context::siesta_context_read
subroutine siesta_context_read(this, restart_file_name)
Read a restart file.
Definition: siesta_context.f:412
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17