V3FIT
mddc_cdf.f
1 ! SPH010908 REPLACE INTEGER(iprec) with INTEGER
2 !*******************************************************************************
3 ! File mddc_cdf.f
4 ! Contains the module mddc_cdf
5 ! Module for defining variables and writing netCDF files, and reading
6 ! netCDF files with the derived types mddc_desc and mddc_mrf
7 ! (from the mddc_T module).
8 !
9 ! Information about the EZcdf module is at:
10 ! http://w3.pppl.gov/NTCC/EZcdf/
11 !
12 !-------------------------------------------------------------------------------
13 ! DEPENDENCIES
14 !-------------------------------------------------------------------------------
15 !
16 ! This module uses the following modules:
17 ! stel_kinds
18 ! stel_constants
19 ! mddc_T
20 ! bsc
21 ! bsc_cdf
22 ! ezcdf
23 ! v3_utilities
24 !
25 !-------------------------------------------------------------------------------
26 ! CHANGE HISTORY
27 !-------------------------------------------------------------------------------
28 !
29 ! See Section X at the end of the module.
30 !
31 !-------------------------------------------------------------------------------
32 ! USAGE
33 !-------------------------------------------------------------------------------
34 !-------------------------------------------------------------------------------
35 ! COMMENTS
36 !
37 ! 1) All cdf_define calls must be completed before the first cdf_write call.
38 !-------------------------------------------------------------------------------
39 !
40 !*******************************************************************************
41 
42 !*******************************************************************************
43 ! MODULE mddc_cdf
44 !
45 ! SECTION I. VARIABLE DECLARATIONS
46 ! SECTION II. INTERFACE BLOCKS
47 ! SECTION III. DEFINE SUBROUTINES
48 ! SECTION IV. WRITE SUBROUTINES
49 ! SECTION V. READ SUBROUTINES
50 ! SECTION VI. AUXILIARY FUNCTIONS AND SUBROUTINES
51 
52 ! SECTION X. COMMENTS FOR DIFFERENT REVISIONS
53 !*******************************************************************************
54 
55  MODULE mddc_cdf
56 
57 !*******************************************************************************
58 ! SECTION I. VARIABLE DECLARATIONS
59 !*******************************************************************************
60 
61 !-------------------------------------------------------------------------------
62 ! Type declarations - lengths of reals, integers, and complexes.
63 ! Frequently used mathematical constants, lots of extra precision.
64 !-------------------------------------------------------------------------------
65  USE stel_kinds, only : rprec, iprec, cprec
66  USE stel_constants, only : pi, twopi, one, zero
67 
68 !-------------------------------------------------------------------------------
69 ! Modules to USE
70 !-------------------------------------------------------------------------------
71 
72  USE bsc_t
73  USE bsc_cdf, only : bsc_cdf_define_coil, bsc_cdf_write_coil,
74  & bsc_cdf_read_coil
75  USE mddc_t
76  USE ezcdf
77  USE v3_utilities
78 
79 !-------------------------------------------------------------------------------
80 ! Implicit None comes after USE statements, before other declarations
81 !-------------------------------------------------------------------------------
82  IMPLICIT NONE
83 
84 !-------------------------------------------------------------------------------
85 ! Make type declarations and constants Private, so there are no conflicts.
86 !-------------------------------------------------------------------------------
87  PRIVATE rprec, iprec, cprec, pi, twopi, one, zero
88 
89 !-------------------------------------------------------------------------------
90 ! Variable Names for netCDF. Make them Private.
91 !-------------------------------------------------------------------------------
92 
93  CHARACTER (LEN=*), PRIVATE, PARAMETER :: &
94  & vn_s_name = 'mddc_desc_s_name', &
95  & vn_l_name = 'mddc_desc_l_name', &
96  & vn_units = 'mddc_desc_units', &
97  & vn_sigma_default = 'mddc_desc_sigma_default', &
98  & vn_l_mdcoil_def = 'mddc_desc_l_mdcoil_def', &
99  & vn_mddc_type = 'mddc_desc_mddc_type', &
100  & vn_flux_factor = 'mddc_desc_flux_factor'
101 
102  CHARACTER (LEN=64), PRIVATE :: &
103  & vn_s_name_use, &
104  & vn_l_name_use, &
105  & vn_units_use, &
106  & vn_sigma_default_use, &
107  & vn_l_mdcoil_def_use, &
108  & vn_mddc_type_use, &
109  & vn_flux_factor_use
110 
111  CHARACTER (LEN=*), PRIVATE, PARAMETER :: &
112  & vn_desc_s_name = 'mddc_data_desc_s_name'
113 
114  CHARACTER (LEN=64), PRIVATE :: &
115  & vn_desc_s_name_use
116 
117  CHARACTER (LEN=*), PRIVATE, PARAMETER :: &
118  & vn_code_name = 'mddc_mrf_code_name', &
119  & vn_code_version = 'mddc_mrf_code_version', &
120  & vn_date_run = 'mddc_mrf_date_run', &
121  & vn_field_coils_id = 'mddc_mrf_field_coils_id', &
122  & vn_n_field_cg = 'mddc_mrf_n_field_cg', &
123  & vn_rdiag_coilg_1 = 'mddc_mrf_rdiag_coilg_1', &
124  & vn_extcur_mg = 'mddc_mrf_extcur_mg', &
125  & vn_ir = 'mddc_mrf_ir', &
126  & vn_jz = 'mddc_mrf_jz', &
127  & vn_kp = 'mddc_mrf_kp', &
128  & vn_kp_store = 'mddc_mrf_kp_store', &
129  & vn_rmin = 'mddc_mrf_rmin', &
130  & vn_rmax = 'mddc_mrf_rmax', &
131  & vn_zmin = 'mddc_mrf_zmin', &
132  & vn_zmax = 'mddc_mrf_zmax', &
133  & vn_n_field_periods = 'mddc_mrf_n_field_periods', &
134  & vn_lstell_sym = 'mddc_mrf_lstell_sym', &
135  & vn_a_r = 'mddc_mrf_a_r', &
136  & vn_a_f = 'mddc_mrf_a_f', &
137  & vn_a_z = 'mddc_mrf_a_z', &
138  & vn_use_con_shell = 'mddc_mrf_use_con_shell', &
139  & vn_a_s_r = 'mddc_mrf_a_s_r', &
140  & vn_a_s_f = 'mddc_mrf_a_s_f', &
141  & vn_a_s_z = 'mddc_mrf_a_s_z', &
142  & vn_kp_shell = 'mddc_mrf_kp_shell', &
143  & vn_kp_shell_store = 'mddc_mrf_kp_shell_store'
144 
145  CHARACTER (LEN=64), PRIVATE :: &
146  & vn_code_name_use, &
147  & vn_code_version_use, &
148  & vn_date_run_use, &
149  & vn_field_coils_id_use, &
150  & vn_n_field_cg_use, &
151  & vn_rdiag_coilg_1_use, &
152  & vn_extcur_mg_use, &
153  & vn_ir_use, &
154  & vn_jz_use, &
155  & vn_kp_use, &
156  & vn_kp_store_use, &
157  & vn_rmin_use, &
158  & vn_rmax_use, &
159  & vn_zmin_use, &
160  & vn_zmax_use, &
161  & vn_n_field_periods_use, &
162  & vn_lstell_sym_use, &
163  & vn_a_r_use, &
164  & vn_a_f_use, &
165  & vn_a_z_use, &
166  & vn_use_con_shell_use, &
167  & vn_a_s_r_use, &
168  & vn_a_s_f_use, &
169  & vn_a_S_z_use, &
170  & vn_kp_shell_use, &
171  & vn_kp_shell_store_use
172 
173 !-------------------------------------------------------------------------------
174 ! Lengths of Character Variables
175 !-------------------------------------------------------------------------------
176  INTEGER, PARAMETER, PRIVATE :: type_len=10
177  INTEGER, PARAMETER, PRIVATE :: sn_len=30
178  INTEGER, PARAMETER, PRIVATE :: ln_len=80
179  INTEGER, PARAMETER, PRIVATE :: units_len=30
180 
181 !*******************************************************************************
182 ! SECTION II. INTERFACE BLOCKS
183 !*******************************************************************************
184 !-------------------------------------------------------------------------------
185 !
186 !-------------------------------------------------------------------------------
187 
188 !-------------------------------------------------------------------------------
189 ! Generic Define
190 !-------------------------------------------------------------------------------
191  INTERFACE mddc_cdf_define
192  MODULE PROCEDURE mddc_cdf_define_desc, &
193  & mddc_cdf_define_mrf
194  END INTERFACE
195 
196 !-------------------------------------------------------------------------------
197 ! Generic Write
198 !-------------------------------------------------------------------------------
199  INTERFACE mddc_cdf_write
200  MODULE PROCEDURE mddc_cdf_write_desc, &
201  & mddc_cdf_write_mrf
202  END INTERFACE
203 
204 !-------------------------------------------------------------------------------
205 ! Generic Read
206 !-------------------------------------------------------------------------------
207  INTERFACE mddc_cdf_read
208  MODULE PROCEDURE mddc_cdf_read_desc, &
209  & mddc_cdf_read_mrf
210  END INTERFACE
211 !-------------------------------------------------------------------------------
212 
213  CONTAINS
214 !*******************************************************************************
215 ! SECTION III. DEFINE SUBROUTINES
216 !*******************************************************************************
217 !-------------------------------------------------------------------------------
218 !
219 !-------------------------------------------------------------------------------
220  SUBROUTINE mddc_cdf_define_desc(this,iou,prefix)
221 ! Subroutine to do the appropriate netCDF definition calls for a mddc_desc
222 !
223 !-----------------------------------------------
224 ! D u m m y A r g u m e n t s
225 !-----------------------------------------------
226  TYPE (mddc_desc), INTENT (in) :: this
227  INTEGER, INTENT(in) :: iou
228  CHARACTER (len=*), INTENT(in), OPTIONAL :: prefix
229 
230 ! this mddc_desc - this is what gets defined and written.
231 ! iou i/o unit number of the netCDF file.
232 ! prefix character - prefixed to variable names, so that netCDF
233 ! doesn't have problems with repeated, identical names
234 !-----------------------------------------------
235 ! L o c a l V a r i a b l e s
236 !-----------------------------------------------
237  CHARACTER(len=*), PARAMETER :: sub_name = &
238  & 'mddc_cdf_define_desc: '
239  CHARACTER(len=32) :: prefix_use
240 
241 !-----------------------------------------------
242 ! Start of Executable Code
243 !-----------------------------------------------
244 
245 ! Define the prefix to actually use
246  IF (PRESENT(prefix)) THEN
247  prefix_use = trim(adjustl(prefix))
248  ELSE
249  prefix_use = ' '
250  ENDIF
251 
252 ! Define all vn_--_use variable names
253  CALL mddc_cdf_defvn_desc(prefix_use)
254 
255 ! Scalar Components
256  CALL cdf_define(iou, trim(vn_s_name_use), this % s_name)
257  CALL cdf_define(iou, trim(vn_l_name_use), this % l_name)
258  CALL cdf_define(iou, trim(vn_units_use), this % units)
259  CALL cdf_define(iou, trim(vn_sigma_default_use), &
260  & this % sigma_default)
261  CALL cdf_define(iou, trim(vn_l_mdcoil_def_use), &
262  & this % l_mdcoil_def)
263  CALL cdf_define(iou, trim(vn_mddc_type_use), &
264  & this % mddc_type)
265  CALL cdf_define(iou, trim(vn_flux_factor_use), &
266  & this % flux_factor)
267 
268 ! bsc_coil and mrf
269  IF (this % l_mdcoil_def) THEN
270  CALL bsc_cdf_define_coil(this % mdcoil,iou,prefix)
271  END IF
272 
273  CALL mddc_cdf_define(this % mrf,iou,prefix)
274 
275  RETURN
276 
277  END SUBROUTINE mddc_cdf_define_desc
278 !-------------------------------------------------------------------------------
279 !
280 !-------------------------------------------------------------------------------
281  SUBROUTINE mddc_cdf_define_mrf(this,iou,prefix)
282 ! Subroutine to do the appropriate netCDF definition calls for a mddc_mrf
283 
284 !-----------------------------------------------
285 ! D u m m y A r g u m e n t s
286 !-----------------------------------------------
287  TYPE (mddc_mrf), INTENT (in) :: this
288  INTEGER, INTENT(in) :: iou
289  CHARACTER (len=*), INTENT(in), OPTIONAL :: prefix
290 
291 ! this mddc_mrf - this is what gets defined and written.
292 ! iou i/o unit number of the netCDF file.
293 ! prefix character - prefixed to variable names, so that netCDF
294 ! doesn't have problems with repeated, identical names
295 !-----------------------------------------------
296 ! L o c a l V a r i a b l e s
297 !-----------------------------------------------
298  CHARACTER(len=*), PARAMETER :: sub_name = &
299  & 'mddc_cdf_define_mrf: '
300  CHARACTER(len=32) :: prefix_use
301 
302 !-----------------------------------------------
303 ! Start of Executable Code
304 !-----------------------------------------------
305 
306 ! Define the prefix to actually use
307  IF (PRESENT(prefix)) THEN
308  prefix_use = trim(adjustl(prefix))
309  ELSE
310  prefix_use = ' '
311  ENDIF
312 
313 ! Define all vn_--_use variable names
314  CALL mddc_cdf_defvn_mrf(prefix_use)
315 
316 ! Define Components
317  CALL cdf_define(iou, trim(vn_code_name_use), this % code_name)
318  CALL cdf_define(iou, trim(vn_code_version_use), &
319  & this % code_version)
320  CALL cdf_define(iou, trim(vn_date_run_use), this % date_run)
321  CALL cdf_define(iou, trim(vn_field_coils_id_use), &
322  & this % field_coils_id)
323  CALL cdf_define(iou, trim(vn_n_field_cg_use), &
324  & this % n_field_cg)
325  CALL cdf_define(iou, trim(vn_rdiag_coilg_1_use), &
326  & this % rdiag_coilg_1)
327  CALL cdf_define(iou, trim(vn_extcur_mg_use), this % extcur_mg)
328  CALL cdf_define(iou, trim(vn_ir_use), this % ir)
329  CALL cdf_define(iou, trim(vn_jz_use), this % jz)
330  CALL cdf_define(iou, trim(vn_kp_use), this % kp)
331  CALL cdf_define(iou, trim(vn_kp_store_use), this % kp_store)
332  CALL cdf_define(iou, trim(vn_rmin_use), this % rmin)
333  CALL cdf_define(iou, trim(vn_rmax_use), this % rmax)
334  CALL cdf_define(iou, trim(vn_zmin_use), this % zmin)
335  CALL cdf_define(iou, trim(vn_zmax_use), this % zmax)
336  CALL cdf_define(iou, trim(vn_n_field_periods_use), &
337  & this % n_field_periods)
338  CALL cdf_define(iou, trim(vn_lstell_sym_use), &
339  & this % lstell_sym)
340  CALL cdf_define(iou, trim(vn_a_r_use), this % a_r)
341  CALL cdf_define(iou, trim(vn_a_f_use), this % a_f)
342  CALL cdf_define(iou, trim(vn_a_z_use), this % a_z)
343 
344  CALL cdf_define(iou, trim(vn_use_con_shell_use), &
345  & this%use_con_shell)
346  IF (this%use_con_shell) THEN
347  CALL cdf_define(iou, trim(vn_kp_shell_use), this % kp_shell)
348  CALL cdf_define(iou, trim(vn_a_s_r_use), this % a_s_r)
349  CALL cdf_define(iou, trim(vn_a_s_f_use), this % a_s_f)
350  CALL cdf_define(iou, trim(vn_a_s_z_use), this % a_s_z)
351  END IF
352 
353  RETURN
354 
355  END SUBROUTINE mddc_cdf_define_mrf
356 
357 !*******************************************************************************
358 ! SECTION III. WRITE SUBROUTINES
359 !*******************************************************************************
360 !-------------------------------------------------------------------------------
361 !
362 !-------------------------------------------------------------------------------
363  SUBROUTINE mddc_cdf_write_desc(this,iou,prefix)
364 ! Subroutine to do the appropriate netCDF write calls for a mddc_desc
365 !
366 !-----------------------------------------------
367 ! D u m m y A r g u m e n t s
368 !-----------------------------------------------
369  TYPE (mddc_desc), INTENT (in) :: this
370  INTEGER, INTENT (in) :: iou
371  CHARACTER (len=*), INTENT (in), OPTIONAL :: prefix
372 
373 ! this mddc_desc - this is what gets written.
374 ! iou i/o unit number of the netCDF file.
375 ! prefix character - prefixed to variable names, so that netCDF
376 ! doesn't have problems with repeated, identical names
377 !-----------------------------------------------
378 ! L o c a l V a r i a b l e s
379 !-----------------------------------------------
380  CHARACTER(len=*), PARAMETER :: sub_name = &
381  & 'mddc_cdf_write_desc: '
382  CHARACTER(len=32) :: prefix_use
383 
384 !-----------------------------------------------
385 ! Start of Executable Code
386 !-----------------------------------------------
387 ! Define the prefix to actually use
388  IF (PRESENT(prefix)) THEN
389  prefix_use = trim(adjustl(prefix))
390  ELSE
391  prefix_use = ' '
392  ENDIF
393 
394 ! Define all vn_--_use variable names
395  CALL mddc_cdf_defvn_desc(prefix_use)
396 
397 ! Scalar Components
398  CALL cdf_write(iou, trim(vn_s_name_use), this % s_name)
399  CALL cdf_write(iou, trim(vn_l_name_use), this % l_name)
400  CALL cdf_write(iou, trim(vn_units_use), this % units)
401  CALL cdf_write(iou, trim(vn_sigma_default_use), &
402  & this % sigma_default)
403  CALL cdf_write(iou, trim(vn_l_mdcoil_def_use), &
404  & this % l_mdcoil_def)
405  CALL cdf_write(iou, trim(vn_mddc_type_use), &
406  & this % mddc_type)
407  CALL cdf_write(iou, trim(vn_flux_factor_use), &
408  & this % flux_factor)
409 
410 ! bsc_coil and mrf
411  IF (this % l_mdcoil_def) THEN
412  CALL bsc_cdf_write_coil(this % mdcoil,iou,prefix)
413  END IF
414 
415  CALL mddc_cdf_write(this % mrf,iou,prefix)
416 
417  RETURN
418 
419  END SUBROUTINE mddc_cdf_write_desc
420 !-------------------------------------------------------------------------------
421 !
422 !-------------------------------------------------------------------------------
423  SUBROUTINE mddc_cdf_write_mrf(this,iou,prefix)
424 ! Subroutine to do the appropriate netCDF write calls for a mddc_mrf
425 
426 !-----------------------------------------------
427 ! D u m m y A r g u m e n t s
428 !-----------------------------------------------
429  TYPE (mddc_mrf), INTENT (in) :: this
430  INTEGER, INTENT(in) :: iou
431  CHARACTER (len=*), INTENT(in), OPTIONAL :: prefix
432 
433 ! this mddc_mrf - this is what gets defined and written.
434 ! iou i/o unit number of the netCDF file.
435 ! prefix character - prefixed to variable names, so that netCDF
436 ! doesn't have problems with repeated, identical names
437 !-----------------------------------------------
438 ! L o c a l V a r i a b l e s
439 !-----------------------------------------------
440  CHARACTER(len=*), PARAMETER :: sub_name = &
441  & 'mddc_cdf_write_mrf: '
442  CHARACTER(len=32) :: prefix_use
443 
444 !-----------------------------------------------
445 ! Start of Executable Code
446 !-----------------------------------------------
447 
448 ! Define the prefix to actually use
449  IF (PRESENT(prefix)) THEN
450  prefix_use = trim(adjustl(prefix))
451  ELSE
452  prefix_use = ' '
453  ENDIF
454 
455 ! Define all vn_--_use variable names
456  CALL mddc_cdf_defvn_mrf(prefix_use)
457 
458 ! Write Components
459  CALL cdf_write(iou, trim(vn_code_name_use), this % code_name)
460  CALL cdf_write(iou, trim(vn_code_version_use), &
461  & this % code_version)
462  CALL cdf_write(iou, trim(vn_date_run_use), this % date_run)
463  CALL cdf_write(iou, trim(vn_field_coils_id_use), &
464  & this % field_coils_id)
465  CALL cdf_write(iou, trim(vn_n_field_cg_use), &
466  & this % n_field_cg)
467  CALL cdf_write(iou, trim(vn_rdiag_coilg_1_use), &
468  & this % rdiag_coilg_1)
469  CALL cdf_write(iou, trim(vn_extcur_mg_use), this % extcur_mg)
470  CALL cdf_write(iou, trim(vn_ir_use), this % ir)
471  CALL cdf_write(iou, trim(vn_jz_use), this % jz)
472  CALL cdf_write(iou, trim(vn_kp_use), this % kp)
473  CALL cdf_write(iou, trim(vn_kp_store_use), this % kp_store)
474  CALL cdf_write(iou, trim(vn_rmin_use), this % rmin)
475  CALL cdf_write(iou, trim(vn_rmax_use), this % rmax)
476  CALL cdf_write(iou, trim(vn_zmin_use), this % zmin)
477  CALL cdf_write(iou, trim(vn_zmax_use), this % zmax)
478  CALL cdf_write(iou, trim(vn_n_field_periods_use), &
479  & this % n_field_periods)
480  CALL cdf_write(iou, trim(vn_lstell_sym_use), &
481  & this % lstell_sym)
482  CALL cdf_write(iou, trim(vn_a_r_use), this % a_r)
483  CALL cdf_write(iou, trim(vn_a_f_use), this % a_f)
484  CALL cdf_write(iou, trim(vn_a_z_use), this % a_z)
485 
486  CALL cdf_write(iou, trim(vn_use_con_shell_use), &
487  & this%use_con_shell)
488  IF (this%use_con_shell) THEN
489  CALL cdf_write(iou, trim(vn_kp_shell_use), this % kp_shell)
490  CALL cdf_write(iou, trim(vn_kp_shell_store_use), &
491  & this % kp_shell_store)
492 
493  CALL cdf_write(iou, trim(vn_a_s_r_use), this % a_s_r)
494  CALL cdf_write(iou, trim(vn_a_s_f_use), this % a_s_f)
495  CALL cdf_write(iou, trim(vn_a_s_z_use), this % a_s_z)
496  END IF
497 
498  RETURN
499 
500  END SUBROUTINE mddc_cdf_write_mrf
501 
502 !*******************************************************************************
503 ! SECTION IV. READ SUBROUTINES
504 !*******************************************************************************
505 !-------------------------------------------------------------------------------
506 !
507 !-------------------------------------------------------------------------------
508  SUBROUTINE mddc_cdf_read_desc(this,iou,prefix)
509 ! Subroutine to do the appropriate netCDF read calls for a mddc_desc
510 !
511 !-----------------------------------------------
512 ! D u m m y A r g u m e n t s
513 !-----------------------------------------------
514  TYPE (mddc_desc), INTENT (inout) :: this
515  INTEGER, INTENT (in) :: iou
516  CHARACTER (len=*), INTENT (in), OPTIONAL :: prefix
517 
518 ! this mddc_desc - this is what gets defined and written.
519 ! iou i/o unit number of the netCDF file.
520 ! prefix character - prefixed to variable names, so that netCDF
521 ! doesn't have problems with repeated, identical names
522 !-----------------------------------------------
523 ! L o c a l V a r i a b l e s
524 !-----------------------------------------------
525  CHARACTER(len=*), PARAMETER :: sub_name = &
526  & 'mddc_cdf_read_desc: '
527  CHARACTER(len=32) :: prefix_use
528  INTEGER, DIMENSION(3) :: dimlens
529 
530  CHARACTER (len=sn_len) :: s_name
531  CHARACTER (len=ln_len) :: l_name
532  CHARACTER (len=units_len) :: units
533  CHARACTER (len=30) :: mddc_type
534  LOGICAL :: l_mdcoil_def
535  REAL(rprec) :: sigma_default
536  REAL(rprec) :: flux_factor
537  TYPE (bsc_coil) :: mdcoil
538  TYPE (mddc_mrf) :: mrf
539 
540 !-----------------------------------------------
541 ! Start of Executable Code
542 !-----------------------------------------------
543 
544 ! Define the prefix to actually use
545  IF (PRESENT(prefix)) THEN
546  prefix_use = trim(adjustl(prefix))
547  ELSE
548  prefix_use = ' '
549  ENDIF
550 
551 ! Define all vn_--_use variable names
552  CALL mddc_cdf_defvn_desc(prefix_use)
553 
554 ! Read Scalar pieces
555 ! Note: Read in to variables local to this subroutine.
556  CALL cdf_read(iou, trim(vn_s_name_use), s_name)
557  CALL cdf_read(iou, trim(vn_l_name_use), l_name)
558  CALL cdf_read(iou, trim(vn_units_use), units)
559 
560  CALL cdf_read(iou, trim(vn_sigma_default_use), sigma_default)
561  CALL cdf_read(iou, trim(vn_l_mdcoil_def_use),l_mdcoil_def)
562  CALL cdf_read(iou, trim(vn_mddc_type_use),mddc_type)
563  CALL cdf_read(iou, trim(vn_flux_factor_use),flux_factor)
564 
565 ! Read Derived Types
566  IF (l_mdcoil_def) THEN
567  CALL bsc_cdf_read_coil(mdcoil,iou,prefix)
568  ENDIF
569 
570  CALL mddc_cdf_read(mrf,iou,prefix)
571 
572 
573 ! Create the mddc_desc, this
574  CALL mddc_desc_construct(this,s_name,l_name,units, &
575  & sigma_default,mddc_type,mdcoil,mrf,flux_factor)
576 
577 ! Destroy the local bsc_coil mdcoil, and mrf to avoid memory leakage
578  CALL bsc_destroy(mdcoil)
579  CALL mddc_destroy(mrf)
580 
581  RETURN
582 
583  END SUBROUTINE mddc_cdf_read_desc
584 !-------------------------------------------------------------------------------
585 !
586 !-------------------------------------------------------------------------------
587  SUBROUTINE mddc_cdf_read_mrf(this,iou,prefix)
588 ! Subroutine to do the appropriate netCDF read calls for a mddc_mrf
589 !
590 !-----------------------------------------------
591 ! D u m m y A r g u m e n t s
592 !-----------------------------------------------
593  TYPE (mddc_mrf), INTENT (inout) :: this
594  INTEGER, INTENT (in) :: iou
595  CHARACTER (len=*), INTENT (in), OPTIONAL :: prefix
596 
597 ! this mddc_mrf - this is what gets defined and written.
598 ! iou i/o unit number of the netCDF file.
599 ! prefix character - prefixed to variable names, so that netCDF
600 ! doesn't have problems with repeated, identical names
601 !-----------------------------------------------
602 ! L o c a l V a r i a b l e s
603 !-----------------------------------------------
604  CHARACTER(len=32) :: prefix_use
605  INTEGER, DIMENSION(3) :: dimlens
606  INTEGER, DIMENSION(2) :: dimlens2
607 
608  CHARACTER(len=80) :: code_name
609  CHARACTER(len=80) :: code_version
610  CHARACTER(len=80) :: date_run
611  CHARACTER(len=80) :: field_coils_id
612  INTEGER :: n_field_cg
613  REAL(rprec), DIMENSION(:), ALLOCATABLE :: rdiag_coilg_1
614  REAL(rprec), DIMENSION(:), ALLOCATABLE :: extcur_mg
615  INTEGER :: ir
616  INTEGER :: jz
617  INTEGER :: kp
618  INTEGER :: kp_store
619  REAL(rprec) :: rmin
620  REAL(rprec) :: rmax
621  REAL(rprec) :: zmin
622  REAL(rprec) :: zmax
623  INTEGER :: n_field_periods
624  LOGICAL :: lstell_sym
625  REAL(rprec), DIMENSION(:,:,:), ALLOCATABLE :: a_r
626  REAL(rprec), DIMENSION(:,:,:), ALLOCATABLE :: a_f
627  REAL(rprec), DIMENSION(:,:,:), ALLOCATABLE :: a_z
628 
629  LOGICAL :: use_con_shell
630  REAL(rprec), DIMENSION(:,:), ALLOCATABLE :: a_s_r
631  REAL(rprec), DIMENSION(:,:), ALLOCATABLE :: a_s_f
632  REAL(rprec), DIMENSION(:,:), ALLOCATABLE :: a_s_z
633  INTEGER :: kp_shell
634  INTEGER :: kp_shell_store
635 
636 ! Declare local variables
637  INTEGER :: ir1, ir2, ir3, if1, if2, if3, iz1, &
638  & iz2, iz3
639  INTEGER :: ier1, ier2, ier3
640  INTEGER :: n_field_cg_decl
641 
642  CHARACTER(len=*), PARAMETER :: sub_name = &
643  & 'mddc_cdf_read_data: '
644 
645 !-----------------------------------------------
646 ! Start of Executable Code
647 !-----------------------------------------------
648 
649 ! Define the prefix to actually use
650  IF (PRESENT(prefix)) THEN
651  prefix_use = trim(adjustl(prefix))
652  ELSE
653  prefix_use = ' '
654  ENDIF
655 
656 ! Define all vn_--_use variable names
657  CALL mddc_cdf_defvn_mrf(prefix_use)
658 
659 ! Read Components
660 ! Note: Read in to variables local to this subroutine.
661 ! Arrays require inquiry regarding size, and allocation before actual reading.
662 
663  CALL cdf_read(iou, trim(vn_code_name_use), code_name)
664  CALL cdf_read(iou, trim(vn_code_version_use),code_version)
665  CALL cdf_read(iou, trim(vn_date_run_use), date_run)
666  CALL cdf_read(iou, trim(vn_field_coils_id_use),field_coils_id)
667  CALL cdf_read(iou, trim(vn_n_field_cg_use),n_field_cg)
668 
669  CALL cdf_inquire(iou, trim(vn_rdiag_coilg_1_use),dimlens)
670  n_field_cg_decl = dimlens(1)
671  CALL assert_eq(0,dimlens(2),dimlens(3), &
672  & sub_name // 'Unexpected rdiag_coilg_1 dimensions')
673  CALL assert_eq(n_field_cg,n_field_cg_decl, &
674  & sub_name // 'Disagreement rdiag_coilg_1 dimensions')
675  ALLOCATE(rdiag_coilg_1(n_field_cg),stat=ier1)
676  CALL assert_eq(0,ier1,sub_name // 'alloc rdiag_coilg_1')
677  CALL cdf_read(iou, trim(vn_rdiag_coilg_1_use), rdiag_coilg_1)
678 
679  CALL cdf_inquire(iou, trim(vn_extcur_mg_use),dimlens)
680  n_field_cg_decl = dimlens(1)
681  CALL assert_eq(0,dimlens(2),dimlens(3), &
682  & sub_name // 'Unexpected extcur_mg dimensions')
683  CALL assert_eq(n_field_cg,n_field_cg_decl, &
684  & sub_name // 'Disagreement extcur_mg dimensions')
685  ALLOCATE(extcur_mg(n_field_cg),stat=ier1)
686  CALL assert_eq(0,ier1,sub_name // 'alloc extcur_mg')
687  CALL cdf_read(iou, trim(vn_extcur_mg_use), extcur_mg)
688 
689  CALL cdf_read(iou, trim(vn_ir_use), ir)
690  CALL cdf_read(iou, trim(vn_jz_use), jz)
691  CALL cdf_read(iou, trim(vn_kp_use), kp)
692  CALL cdf_read(iou, trim(vn_kp_store_use), kp_store)
693  CALL cdf_read(iou, trim(vn_rmin_use), rmin)
694  CALL cdf_read(iou, trim(vn_rmax_use), rmax)
695  CALL cdf_read(iou, trim(vn_zmin_use), zmin)
696  CALL cdf_read(iou, trim(vn_zmax_use), zmax)
697  CALL cdf_read(iou, trim(vn_n_field_periods_use), n_field_periods)
698  CALL cdf_read(iou, trim(vn_lstell_sym_use), lstell_sym)
699 
700  CALL cdf_inquire(iou, trim(vn_a_r_use),dimlens)
701  ir1 = dimlens(1)
702  ir2 = dimlens(2)
703  ir3 = dimlens(3)
704  CALL assert_eq(ir,ir1, &
705  & sub_name // 'Disagreement ir a_r dimensions')
706  CALL assert_eq(jz,ir2, &
707  & sub_name // 'Disagreement jz a_r dimensions')
708  CALL assert_eq(kp_store,ir3, &
709  & sub_name // 'Disagreement kp_store a_r dimensions')
710  ALLOCATE(a_r(ir1,ir2,ir3),stat=ier1)
711  CALL assert_eq(0,ier1,sub_name // 'alloc a_r')
712  CALL cdf_read(iou, trim(vn_a_r_use), a_r)
713 
714  CALL cdf_inquire(iou, trim(vn_a_f_use),dimlens)
715  if1 = dimlens(1)
716  if2 = dimlens(2)
717  if3 = dimlens(3)
718  CALL assert_eq(ir,if1, &
719  & sub_name // 'Disagreement ir a_f dimensions')
720  CALL assert_eq(jz,if2, &
721  & sub_name // 'Disagreement jz a_f dimensions')
722  CALL assert_eq(kp_store,if3, &
723  & sub_name // 'Disagreement kp_store a_f dimensions')
724  ALLOCATE(a_f(if1,if2,if3),stat=ier1)
725  CALL assert_eq(0,ier1,sub_name // 'alloc a_f')
726  CALL cdf_read(iou, trim(vn_a_f_use), a_f)
727 
728  CALL cdf_inquire(iou, trim(vn_a_z_use),dimlens)
729  iz1 = dimlens(1)
730  iz2 = dimlens(2)
731  iz3 = dimlens(3)
732  CALL assert_eq(ir,iz1, &
733  & sub_name // 'Disagreement ir a_z dimensions')
734  CALL assert_eq(jz,iz2, &
735  & sub_name // 'Disagreement jz a_z dimensions')
736  CALL assert_eq(kp_store,iz3, &
737  & sub_name // 'Disagreement kp_store a_z dimensions')
738  ALLOCATE(a_z(iz1,iz2,iz3),stat=ier1)
739  CALL assert_eq(0,ier1,sub_name // 'alloc a_z')
740  CALL cdf_read(iou, trim(vn_a_z_use), a_z)
741 
742 ! Read
743  SELECT CASE (code_version)
744 
745  CASE ('MRC 2014-09-28')
746  CALL cdf_read(iou, trim(vn_use_con_shell_use), &
747  & use_con_shell)
748 
749  IF (use_con_shell) THEN
750  CALL cdf_read(iou, trim(vn_kp_shell_use), kp_shell)
751 
752  CALL cdf_inquire(iou, trim(vn_a_r_use), dimlens2)
753  ir1 = dimlens2(1)
754  ir2 = dimlens2(2)
755  ALLOCATE(a_s_r(ir1,ir2))
756  CALL cdf_read(iou, trim(vn_a_s_r_use), a_s_r)
757 
758  CALL cdf_inquire(iou, trim(vn_a_f_use), dimlens2)
759  if1 = dimlens2(1)
760  if2 = dimlens2(2)
761  ALLOCATE(a_s_r(if1,if2))
762  CALL cdf_read(iou, trim(vn_a_s_f_use), a_s_f)
763 
764  CALL cdf_inquire(iou, trim(vn_a_z_use), dimlens2)
765  iz1 = dimlens2(1)
766  iz2 = dimlens2(2)
767  ALLOCATE(a_s_r(iz1,iz2))
768  CALL cdf_read(iou, trim(vn_a_s_z_use), a_s_z)
769  END IF
770 
771  CASE DEFAULT
772  use_con_shell = .false.
773 
774  END SELECT
775 
776 ! Create the mddc_mrf, this
777  CALL mddc_mrf_construct(this,code_name,code_version, &
778  & date_run,field_coils_id,rdiag_coilg_1,extcur_mg,kp, &
779  & rmin,rmax,zmin,zmax,n_field_periods,lstell_sym,a_r,a_f,a_z, &
780  & use_con_shell, a_s_r, a_s_f, a_s_z, kp_shell)
781 
782 ! Deallocate the local pointers
783  DEALLOCATE(rdiag_coilg_1,extcur_mg,stat=ier1)
784  CALL assert_eq(0,ier1,sub_name // 'dealloc 1')
785  DEALLOCATE(a_r,a_f,a_z,stat=ier1)
786  CALL assert_eq(0,ier1,sub_name // 'dealloc 2')
787 
788  IF (ALLOCATED(a_s_r)) DEALLOCATE(a_s_r)
789  IF (ALLOCATED(a_s_f)) DEALLOCATE(a_s_f)
790  IF (ALLOCATED(a_s_z)) DEALLOCATE(a_s_z)
791 
792  RETURN
793 
794  END SUBROUTINE mddc_cdf_read_mrf
795 
796 !*******************************************************************************
797 ! SECTION IV. AUXILIARY FUNCTIONS AND SUBROUTINES
798 !*******************************************************************************
799 !-------------------------------------------------------------------------------
800 !
801 !-------------------------------------------------------------------------------
802  SUBROUTINE mddc_cdf_defvn_desc(prefix_use)
803 ! Subroutine to do define the character variable names for a mddc_desc,
804 ! using the prefix. All the vn_ variables are module variables, and so do not
805 ! need to be declared here
806 
807 !-----------------------------------------------
808 ! D u m m y A r g u m e n t s
809 !-----------------------------------------------
810  CHARACTER (len=*), INTENT (in) :: prefix_use
811 
812 ! prefix_use character - prefixed to variable names, so that netCDF
813 ! doesn't have problems with repeated, identical names
814 
815 !-----------------------------------------------
816 ! L o c a l V a r i a b l e s
817 !-----------------------------------------------
818  CHARACTER(len=*), PARAMETER :: sub_name = &
819  & 'mddc_cdf_defvn_desc: '
820 
821 !-----------------------------------------------
822 ! Start of Executable Code
823 !-----------------------------------------------
824 
825 ! Define all variable names
826  vn_s_name_use = mddc_cdf_mknam(prefix_use,vn_s_name)
827  vn_l_name_use = mddc_cdf_mknam(prefix_use,vn_l_name)
828  vn_units_use = mddc_cdf_mknam(prefix_use,vn_units)
829  vn_sigma_default_use = mddc_cdf_mknam(prefix_use, &
830  & vn_sigma_default)
831  vn_l_mdcoil_def_use = mddc_cdf_mknam(prefix_use, &
832  & vn_l_mdcoil_def)
833  vn_mddc_type_use = mddc_cdf_mknam(prefix_use, &
834  & vn_mddc_type)
835  vn_flux_factor_use = mddc_cdf_mknam(prefix_use, &
836  & vn_flux_factor)
837 
838  RETURN
839 
840  END SUBROUTINE mddc_cdf_defvn_desc
841 !-------------------------------------------------------------------------------
842 !
843 !-------------------------------------------------------------------------------
844  SUBROUTINE mddc_cdf_defvn_mrf(prefix_use)
845 ! Subroutine to do define the character variable names for a mddc_mrf,
846 ! using the prefix. All the vn_ variables are module variables, and so do not
847 ! need to be declared here
848 
849 !-----------------------------------------------
850 ! D u m m y A r g u m e n t s
851 !-----------------------------------------------
852  CHARACTER (len=*), INTENT (in) :: prefix_use
853 
854 ! prefix_use character - prefixed to variable names, so that netCDF
855 ! doesn't have problems with repeated, identical names
856 
857 !-----------------------------------------------
858 ! L o c a l V a r i a b l e s
859 !-----------------------------------------------
860  CHARACTER(len=*), PARAMETER :: sub_name = &
861  & 'mddc_cdf_defvn_mrf: '
862 
863 !-----------------------------------------------
864 ! Start of Executable Code
865 !-----------------------------------------------
866 
867 ! Define all variable names
868  vn_code_name_use = mddc_cdf_mknam(prefix_use,vn_code_name)
869  vn_code_version_use = mddc_cdf_mknam(prefix_use, &
870  & vn_code_version)
871  vn_date_run_use = mddc_cdf_mknam(prefix_use,vn_date_run)
872  vn_field_coils_id_use = mddc_cdf_mknam(prefix_use, &
873  & vn_field_coils_id)
874  vn_n_field_cg_use = mddc_cdf_mknam(prefix_use, &
875  & vn_n_field_cg)
876  vn_rdiag_coilg_1_use = mddc_cdf_mknam(prefix_use, &
877  & vn_rdiag_coilg_1)
878  vn_extcur_mg_use = mddc_cdf_mknam(prefix_use,vn_extcur_mg)
879  vn_ir_use = mddc_cdf_mknam(prefix_use,vn_ir)
880  vn_jz_use = mddc_cdf_mknam(prefix_use,vn_jz)
881  vn_kp_use = mddc_cdf_mknam(prefix_use,vn_kp)
882  vn_kp_store_use = mddc_cdf_mknam(prefix_use,vn_kp_store)
883  vn_rmin_use = mddc_cdf_mknam(prefix_use,vn_rmin)
884  vn_rmax_use = mddc_cdf_mknam(prefix_use,vn_rmax)
885  vn_zmin_use = mddc_cdf_mknam(prefix_use,vn_zmin)
886  vn_zmax_use = mddc_cdf_mknam(prefix_use,vn_zmax)
887  vn_n_field_periods_use = mddc_cdf_mknam(prefix_use, &
888  & vn_n_field_periods)
889  vn_lstell_sym_use = mddc_cdf_mknam(prefix_use,vn_lstell_sym)
890  vn_a_r_use = mddc_cdf_mknam(prefix_use,vn_a_r)
891  vn_a_f_use = mddc_cdf_mknam(prefix_use,vn_a_f)
892  vn_a_z_use = mddc_cdf_mknam(prefix_use,vn_a_z)
893  vn_use_con_shell_use = mddc_cdf_mknam(prefix_use,vn_use_con_shell)
894  vn_a_s_r_use = mddc_cdf_mknam(prefix_use,vn_a_s_r)
895  vn_a_s_f_use = mddc_cdf_mknam(prefix_use,vn_a_s_f)
896  vn_a_s_z_use = mddc_cdf_mknam(prefix_use,vn_a_s_z)
897  vn_kp_shell_use = mddc_cdf_mknam(prefix_use,vn_kp_shell)
898  vn_kp_shell_store_use = mddc_cdf_mknam(prefix_use, &
899  & vn_kp_shell_store)
900 
901  RETURN
902 
903  END SUBROUTINE mddc_cdf_defvn_mrf
904 !-------------------------------------------------------------------------------
905 !
906 !-------------------------------------------------------------------------------
907  FUNCTION mddc_cdf_mknam(c1,c2)
908 ! A simple function to help in the generation of names
909 
910 !-----------------------------------------------
911 ! F u n c t i o n N a m e
912 !-----------------------------------------------
913  CHARACTER(LEN=64) mddc_cdf_mknam
914 
915 !-----------------------------------------------
916 ! D u m m y A r g u m e n t s
917 !-----------------------------------------------
918  CHARACTER(LEN=*), INTENT (in) :: c1,c2
919 
920 !-----------------------------------------------
921 ! Start of Executable Code
922 !-----------------------------------------------
923  IF (len_trim(c1) .eq. 0) THEN
924  mddc_cdf_mknam = trim(c2)
925  ELSE
926  mddc_cdf_mknam = adjustl(trim(c1) // '_' // trim(c2))
927  ENDIF
928 
929  RETURN
930 
931  END FUNCTION mddc_cdf_mknam
932 
933 !-----------------------------------------------
934 !-----------------------------------------------
935 !*******************************************************************************
936 ! SECTION X. COMMENTS FOR DIFFERENT REVISIONS
937 !*******************************************************************************
938 !
939 ! JDH 2007-06-11. First version of mddc_cdf.
940 ! Based on diagnostic_cdf
941 !
942 ! JDH 2008-01-19 - Added => null() to pointer declarations
943 !
944 !------------------ (Below comments for diagnostic_cdf) ------------------------
945 ! 09-02-2004 JDH - Initial Coding, based on bsc_cdf
946 !
947 ! JDH 12-11-2004
948 ! Modified _desc subroutines, to correspond with changes in diagnostic_T.
949 !
950 ! JDH 07-01-2005
951 ! Added bsc_destroy of local bsc_coil mdcoil in subroutine
952 ! diagnostic_cdf_read_desc, to avoid memory leaks.
953 !
954 ! JDH 2009-06-15
955 ! Eliminated mddc_data derived type - not needed.
956 
957 
958  END MODULE mddc_cdf
mddc_cdf::mddc_cdf_write
Definition: mddc_cdf.f:199
bsc_t::bsc_destroy
Definition: bsc_T.f:189
v3_utilities::assert_eq
Definition: v3_utilities.f:62
mddc_cdf::mddc_cdf_read
Definition: mddc_cdf.f:207
mddc_t::mddc_destroy
Definition: mddc_T.f:198
mddc_cdf::mddc_cdf_define
Definition: mddc_cdf.f:191
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17