29 USE stel_kinds,
only : rprec, cprec
30 USE stel_constants,
only : pi, twopi, one, zero
50 PRIVATE rprec, cprec, pi, twopi, one, zero
55 INTEGER,
PARAMETER,
PRIVATE :: type_len=10
56 INTEGER,
PARAMETER,
PRIVATE :: sn_len=30
57 INTEGER,
PARAMETER,
PRIVATE :: ln_len=80
58 INTEGER,
PARAMETER,
PRIVATE :: units_len=30
86 CHARACTER (len=type_len) :: d_type
87 CHARACTER (len=sn_len) :: s_name
88 CHARACTER (len=ln_len) :: l_name
89 CHARACTER (len=units_len) :: units
90 REAL(rprec) :: sigma_default
91 TYPE (mddc_desc) :: mddc
92 TYPE (sxrch_desc) :: sxrch
93 TYPE (ipch_desc) :: ipch
94 TYPE (thscte_desc) :: thscte
95 TYPE (extcurz_desc) :: extcurz
104 INTERFACE ASSIGNMENT (=)
105 MODULE PROCEDURE diagnostic_desc_assign
112 MODULE PROCEDURE diagnostic_desc_construct_mddc,
113 & diagnostic_desc_construct_sxrch,
114 & diagnostic_desc_construct_ipch,
115 & diagnostic_desc_cnstrct_thscte,
116 & diagnostic_desc_construct_extcurz
123 MODULE PROCEDURE diagnostic_desc_destroy
130 MODULE PROCEDURE diagnostic_desc_write
146 SUBROUTINE diagnostic_desc_construct_mddc(this,d_type,s_name, &
147 & l_name, units,sigma_default,mddc)
156 TYPE (diagnostic_desc),
INTENT(inout) :: this
157 CHARACTER (len=*),
INTENT(in) :: d_type
158 CHARACTER (len=*),
INTENT(in) :: s_name
159 CHARACTER (len=*),
INTENT(in) :: l_name
160 CHARACTER (len=*),
INTENT(in) :: units
161 REAL(rprec),
INTENT(in) :: sigma_default
162 TYPE (mddc_desc),
INTENT(in) :: mddc
165 CHARACTER(len=*),
PARAMETER :: sub_name = &
166 &
'diagnostic_desc_construct_mddc: '
174 this % s_name = trim(adjustl(s_name))
175 this % l_name = trim(adjustl(l_name))
176 this % units = trim(adjustl(units))
177 this % sigma_default = sigma_default
180 SELECT CASE (trim(adjustl(d_type)))
182 this % d_type =
'mddc'
186 CALL err_fatal(sub_name //
'unrecognized d_type: ',
191 END SUBROUTINE diagnostic_desc_construct_mddc
194 SUBROUTINE diagnostic_desc_construct_sxrch(this,d_type,s_name, &
195 & l_name, units,sigma_default,sxrch)
209 TYPE (diagnostic_desc),
INTENT(inout) :: this
210 CHARACTER (len=*),
INTENT(in) :: d_type
211 CHARACTER (len=*),
INTENT(in) :: s_name
212 CHARACTER (len=*),
INTENT(in) :: l_name
213 CHARACTER (len=*),
INTENT(in) :: units
214 REAL(rprec),
INTENT(in) :: sigma_default
215 TYPE (sxrch_desc),
INTENT(in) :: sxrch
218 CHARACTER(len=*),
PARAMETER :: sub_name = &
219 &
'diagnostic_desc_construct_sxrch: '
224 CALL sxrch_desc_destroy(this % sxrch)
227 this % s_name = trim(adjustl(s_name))
228 this % l_name = trim(adjustl(l_name))
229 this % units = trim(adjustl(units))
230 this % sigma_default = sigma_default
233 SELECT CASE (trim(adjustl(d_type)))
235 this % d_type =
'sxrch'
239 CALL err_fatal(sub_name //
'unrecognized d_type: ',
244 END SUBROUTINE diagnostic_desc_construct_sxrch
248 SUBROUTINE diagnostic_desc_construct_extcurz(this,d_type, &
249 & s_name,l_name,units,sigma_default,extcurz,s0,u0)
254 TYPE (diagnostic_desc),
INTENT(inout) :: this
255 CHARACTER (len=*),
INTENT(in) :: d_type
256 CHARACTER (len=*),
INTENT(in) :: s_name
257 CHARACTER (len=*),
INTENT(in) :: l_name
258 CHARACTER (len=*),
INTENT(in) :: units
259 REAL(rprec),
INTENT(in) :: sigma_default
260 TYPE (extcurz_desc),
INTENT(in) :: extcurz
261 REAL(rprec),
INTENT(in) :: s0, u0
264 CHARACTER(len=*),
PARAMETER :: sub_name = &
265 &
'diagnostic_desc_construct_extcurz: '
268 CALL extcurz_desc_destroy(this % extcurz)
271 this % s_name = trim(adjustl(s_name))
272 this % l_name = trim(adjustl(l_name))
273 this % units = trim(adjustl(units))
274 this % sigma_default = sigma_default
277 SELECT CASE (trim(adjustl(d_type)))
279 this % d_type =
'extcurz'
281 this % extcurz % s0 = s0
282 this % extcurz % u0 = u0
284 CALL err_fatal(sub_name //
'unrecognized d_type: ',
288 END SUBROUTINE diagnostic_desc_construct_extcurz
291 SUBROUTINE diagnostic_desc_construct_ipch(this,d_type,s_name, &
292 & l_name, units,sigma_default,ipch)
306 TYPE (diagnostic_desc),
INTENT(inout) :: this
307 CHARACTER (len=*),
INTENT(in) :: d_type
308 CHARACTER (len=*),
INTENT(in) :: s_name
309 CHARACTER (len=*),
INTENT(in) :: l_name
310 CHARACTER (len=*),
INTENT(in) :: units
311 REAL(rprec),
INTENT(in) :: sigma_default
312 TYPE (ipch_desc),
INTENT(in) :: ipch
315 CHARACTER(len=*),
PARAMETER :: sub_name = &
316 &
'diagnostic_desc_construct_ipch: '
321 CALL ipch_desc_destroy(this % ipch)
324 this % s_name = trim(adjustl(s_name))
325 this % l_name = trim(adjustl(l_name))
326 this % units = trim(adjustl(units))
327 this % sigma_default = sigma_default
330 SELECT CASE (trim(adjustl(d_type)))
332 this % d_type =
'ipch'
336 CALL err_fatal(sub_name //
'unrecognized d_type: ',
341 END SUBROUTINE diagnostic_desc_construct_ipch
344 SUBROUTINE diagnostic_desc_cnstrct_thscte(this,d_type,s_name, &
345 & l_name, units,sigma_default,thscte)
359 TYPE (diagnostic_desc),
INTENT(inout) :: this
360 CHARACTER (len=*),
INTENT(in) :: d_type
361 CHARACTER (len=*),
INTENT(in) :: s_name
362 CHARACTER (len=*),
INTENT(in) :: l_name
363 CHARACTER (len=*),
INTENT(in) :: units
364 REAL(rprec),
INTENT(in) :: sigma_default
365 TYPE (thscte_desc),
INTENT(in) :: thscte
368 CHARACTER(len=*),
PARAMETER :: sub_name = &
369 &
'diagnostic_desc_cnstrct_thscte: '
374 CALL thscte_desc_destroy(this % thscte)
377 this % s_name = trim(adjustl(s_name))
378 this % l_name = trim(adjustl(l_name))
379 this % units = trim(adjustl(units))
380 this % sigma_default = sigma_default
383 SELECT CASE (trim(adjustl(d_type)))
385 this % d_type =
'thscte'
386 this % thscte = thscte
389 CALL err_fatal(sub_name //
'unrecognized d_type: ',
394 END SUBROUTINE diagnostic_desc_cnstrct_thscte
402 SUBROUTINE diagnostic_desc_destroy(this)
406 TYPE (diagnostic_desc),
INTENT(inout) :: this
409 CHARACTER(len=*),
PARAMETER :: sub_name = &
410 &
'diagnostic_desc_destroy: '
420 SELECT CASE (trim(adjustl(this % d_type)))
427 CALL sxrch_desc_destroy(this % sxrch)
431 CALL ipch_desc_destroy(this % ipch)
435 CALL thscte_desc_destroy(this % thscte)
439 CALL extcurz_desc_destroy(this % extcurz)
442 CALL err_fatal(sub_name //
'unrecognized d_type: ',
443 & char=this % d_type)
446 END SUBROUTINE diagnostic_desc_destroy
454 SUBROUTINE diagnostic_desc_assign(left,right)
462 TYPE (diagnostic_desc),
INTENT (inout) :: left
463 TYPE (diagnostic_desc),
INTENT (in) :: right
466 CHARACTER(len=*),
PARAMETER :: sub_name = &
467 &
'diagnostic_desc_assign: '
470 left % d_type = right % d_type
471 left % s_name = right % s_name
472 left % l_name = right % l_name
473 left % units = right % units
474 left % sigma_default = right % sigma_default
475 left % mddc = right % mddc
476 left % sxrch = right % sxrch
477 left % ipch = right % ipch
478 left % thscte = right % thscte
479 left % extcurz = right % extcurz
481 END SUBROUTINE diagnostic_desc_assign
490 SUBROUTINE diagnostic_desc_write(this,identifier,unit,verbose)
494 TYPE (diagnostic_desc),
INTENT (in) :: this
495 CHARACTER (len=*),
INTENT(in),
OPTIONAL :: identifier
496 INTEGER,
INTENT(in),
OPTIONAL :: unit
497 INTEGER,
INTENT(in),
OPTIONAL :: verbose
503 INTEGER :: iv_default = 1
505 INTEGER :: iou_default = 6
507 CHARACTER (len=60) :: id
510 CHARACTER(len=*),
PARAMETER,
DIMENSION(10) :: fmt1 = (/
511 '(" start diagnostic_desc write, called with id = ",a)',
512 &
'(" d_type = ",a) ',
513 &
'(" s_name = ",a) ',
514 &
'(" l_name = ",a) ',
515 &
'(" units = ",a) ',
516 &
'(" mddc s_name = ",a) ',
517 &
'(" sxrch s_name = ",a) ',
518 &
'(" ipch s_name = ",a) ',
519 &
'(" thscte s_name = ",a) ',
520 &
'(" end diagnostic_desc write, called with id = ",a) '
525 IF (
PRESENT(identifier))
THEN
531 IF (
PRESENT(unit))
THEN
537 IF (
PRESENT(verbose))
THEN
546 WRITE(iou,*) this % d_type
547 WRITE(iou,*) this % s_name
548 WRITE(iou,*) this % l_name
549 WRITE(iou,*) this % units
550 WRITE(iou,*) this % mddc % s_name
551 WRITE(iou,*) this % sxrch % chord_name
552 WRITE(iou,*) this % ipch % chord_name
553 WRITE(iou,*) this % thscte % chord_name
556 WRITE(iou,fmt1(1)) id
557 WRITE(iou,fmt1(2)) this % d_type
558 WRITE(iou,fmt1(3)) this % s_name
559 WRITE(iou,fmt1(4)) this % l_name
560 WRITE(iou,fmt1(5)) this % units
561 WRITE(iou,fmt1(6)) this % mddc % s_name
562 WRITE(iou,fmt1(7)) this % sxrch % chord_name
563 WRITE(iou,fmt1(8)) this % ipch % chord_name
564 WRITE(iou,fmt1(9)) this % thscte % chord_name
565 WRITE(iou,fmt1(10)) id
569 END SUBROUTINE diagnostic_desc_write
621 END MODULE diagnostic_t