ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
source_dummy.f90
Go to the documentation of this file.
1 !-------------------------------------------------------!
7 !-------------------------------------------------------!
8 MODULE source_dummy
9 
10 CONTAINS
11 
12 
13 
14 
15 !-------------------------------------------------------!
16 !-------------------------------------------------------!
17 
18  SUBROUTINE g_source (EQUILIBRIUM, COREPROF, CORESOURCE)
19 
20 !-------------------------------------------------------!
21 ! This routine provides dummy source for the !
22 ! ETS workflow. !
23 !-------------------------------------------------------!
24 ! Source: --- !
25 ! Developers: D.Kalupin !
26 ! Kontacts: Denis.Kalupin@efda.org !
27 ! !
28 ! Comments: input parameter list is specified !
29 ! in "source_dummy.xml" file. !
30 ! !
31 ! output CORESOURCE CPO is !
32 ! allocated inside the module !
33 ! !
34 !-------------------------------------------------------!
35 
36 
37  USE euitm_schemas
38  USE euitm_routines
39  USE allocate_deallocate
40  USE itm_types
41 
42 
43  IMPLICIT NONE
44 
45 
46  INTEGER :: ifail
47 
48 
49 ! +++ CPO derived types:
50  TYPE (type_equilibrium), POINTER :: equilibrium(:) !input CPO with geometry quantities from previous time
51  TYPE (type_coreprof), POINTER :: coreprof(:) !input CPO with internal ETS parameters profiles from previous time
52  TYPE (type_coresource), POINTER :: coresource(:) !output CPO with sources
53 
54 
55 ! +++ Local variables:
56  REAL(R8) :: time
57  REAL(R8), ALLOCATABLE :: amn(:)
58  REAL(R8), ALLOCATABLE :: rho(:)
59  REAL(R8), ALLOCATABLE :: vprime(:)
60  REAL(R8), ALLOCATABLE :: vprime_eq(:)
61  REAL(R8), ALLOCATABLE :: req(:)
62  REAL(R8), ALLOCATABLE :: jni(:)
63  REAL(R8), ALLOCATABLE :: qel(:)
64  REAL(R8), ALLOCATABLE :: qion(:,:)
65  REAL(R8), ALLOCATABLE :: sion(:,:)
66  REAL(R8), ALLOCATABLE :: uion(:,:)
67  REAL (R8) :: r0
68 
69 
70 ! +++ Dimensions:
71  INTEGER, PARAMETER :: nocur = 1 !number of CPO ocurancies in the work flow
72  INTEGER :: nrho !number of radial points (input, determined from COREPROF CPO)
73  INTEGER :: neq !number of radial points (input, determined from EQUILIBRIUM CPO)
74  INTEGER :: nnucl !number of nuclei species
75  INTEGER :: nion !number of ion species
76  INTEGER :: nimp, iimp !number of impurity species
77  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
78  INTEGER :: nneut, ineut !number of neutrals species
79  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
80  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
81 
82 
83 
84 
85 ! +++ Set dimensions:
86  nrho = SIZE (coreprof(1)%rho_tor, dim=1)
87  CALL get_comp_dimensions(coreprof(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
88 
89 
90 ! +++ Allocate output CPO:
91  CALL allocate_coresource_cpo(nocur, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource)
92 
93 
94 ! +++ Allocate local variables:
95  ALLOCATE ( amn(nion) )
96  ALLOCATE ( rho(nrho) )
97  ALLOCATE ( vprime(nrho) )
98  ALLOCATE ( vprime_eq(neq) )
99  ALLOCATE ( req(neq) )
100  ALLOCATE ( jni(nrho) )
101  ALLOCATE ( qel(nrho) )
102  ALLOCATE ( qion(nrho,nion) )
103  ALLOCATE ( sion(nrho,nion) )
104  ALLOCATE ( uion(nrho,nion) )
105 
106 
107 
108 ! +++ Save output in CPO:
109  time = coreprof(1)%time !time [s]
110 
111  amn = coreprof(1)%composition%amn
112 
113  rho = coreprof(1)%rho_tor !rho [m]
114 
115  req = equilibrium(1)%profiles_1d%rho_tor
116 
117  CALL l3deriv(equilibrium(1)%profiles_1d%volume, req, neq, &
118  vprime_eq, req, neq)
119 
120  r0 = equilibrium(1)%global_param%toroid_field%r0
121 
122  CALL interpolate(neq, req, vprime_eq, nrho, rho, vprime)
123 
124 
125 ! +++ Calculate sources:
126 ! << input >> << output >>
127  CALL additional_source(amn, nrho, rho, r0, vprime, nion, qel, qion, sion, uion, jni)
128 
129 
130 
131 ! +++ Save output in CPO:
132  coresource(1)%time = time !time [s]
133 
134  coresource(1)%VALUES(1)%rho_tor = rho !rho [m]
135 
136  coresource(1)%VALUES(1)%j = jni !j_ni [A/m^2]
137 
138  coresource(1)%VALUES(1)%qe%exp = qel !Qe_exp [W/m^3]
139  coresource(1)%VALUES(1)%qe%imp = 0.0e0_r8 !Qe_imp [1/m^3/s]
140 
141  coresource(1)%VALUES(1)%si%exp = sion !Si_exp [1/m^3/s]
142  coresource(1)%VALUES(1)%si%imp = 0.0e0_r8 !Si_imp [1/s]
143 
144  coresource(1)%VALUES(1)%qi%exp = qion !Qi_exp [W/m^3]
145  coresource(1)%VALUES(1)%qi%imp = 0.0e0_r8 !Qi_imp [1/m^3/s]
146 
147  coresource(1)%VALUES(1)%ui%exp = uion !Ui_exp [kg/m/s^2]
148  coresource(1)%VALUES(1)%ui%imp = 0.0e0_r8 !Ui_imp [kg/m^2/s]
149 
150 
151 ! +++ Deallocate local variables:
152  DEALLOCATE (amn)
153  DEALLOCATE (rho)
154  DEALLOCATE (vprime)
155  DEALLOCATE (vprime_eq)
156  DEALLOCATE (req)
157  DEALLOCATE (jni)
158  DEALLOCATE (qel)
159  DEALLOCATE (qion)
160  DEALLOCATE (sion)
161  DEALLOCATE (uion)
162  ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
163  ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
164 
165 
166 
167  RETURN
168 
169 
170  END SUBROUTINE g_source
171 
172 !-------------------------------------------------------!
173 !-------------------------------------------------------!
174 
175 
176 
177 
178 
179 
180 !-------------------------------------------------------!
181 !-------------------------------------------------------!
182 
183  SUBROUTINE additional_source (AMN, NRHO, RHO, R0, VPRIME, NION, QEL, QION, SION, UION, JNI)
184 
185  USE itm_constants
186  USE itm_types
187 
188  USE euitm_routines
189  USE euitm_schemas
190  USE euitm_xml_parser
191  USE xml_file_reader
192 
193  IMPLICIT NONE
194 
195 
196 ! +++ Dimensions:
197  INTEGER :: i
198  INTEGER :: nrho, irho
199  INTEGER :: nion
200 
201 
202 ! +++ Local variables:
203  REAL(R8) :: rho(nrho)
204  REAL(R8) :: vprime(nrho)
205 
206  REAL(R8) :: amn(nion)
207 
208  REAL(R8) :: jni(nrho)
209  REAL(R8) :: qel(nrho)
210  REAL(R8) :: qion(nrho,nion)
211  REAL(R8) :: sion(nrho,nion)
212  REAL(R8) :: uion(nrho,nion)
213  REAL(R8) :: r0
214 
215  REAL(R8) :: gfun(nrho)
216  REAL(R8) :: a, c, w, intfun
217  REAL(R8) :: ftot
218 
219 
220 ! +++ Parameters from XML:
221 
222 ! HEATING:
223  REAL(R8) :: wtot !total energy input [W]
224  REAL(R8) :: rheat !rho position of heating profile maximum [m]
225  REAL(R8) :: fwheat(1:nion+1) !A full width at half maximum of the heating profiles [m]
226  REAL(R8) :: fract(1:nion+1) !fractions of energy going in different components, summ should not exceed 1.0 [-]
227  REAL(R8) :: pheat(nrho) !Heating power [W/m^3]
228 
229 ! PARTICLES:
230  REAL(R8) :: ami !Atomic mass number of injected particles [-]
231  REAL(R8) :: stot !total particle input [s^-1]
232  REAL(R8) :: rpart !rho position of particle source profile maximum [m]
233  REAL(R8) :: fwpart !A full width at half maximum of the particle source profiles [m]
234  REAL(R8) :: si(nrho) !particle source density [s^-1*m^-3]
235 
236 ! MOMENTUM:
237  REAL(R8) :: amm !Atomic mass number of particles receiving momentum input[-]
238  REAL(R8) :: utot !Total momentum [kg*m^2*s^-1]
239  REAL(R8) :: rmom !rho position of momentum source profile maximum [m]
240  REAL(R8) :: fwmom !A full width at half maximum of the momentum source profiles [m]
241  REAL(R8) :: ui(nrho) !momentum source density [kg*m^-1*s^-1]
242 
243 ! CURRENT:
244  REAL(R8) :: jnitot !total noninductive current [A]
245  REAL(R8) :: rcurr !rho position of current profile maximum [m]
246  REAL(R8) :: fwcurr !A full width at half maximum of the current profiles [m]
247 
248 
249 ! +++ Other
250  LOGICAL, SAVE :: first = .true.
251  INTEGER :: return_status
252  TYPE (type_param) :: code_parameters
253 
254 
255  CALL fill_param(code_parameters, 'XML/source_dummy.xml', '', 'XML/source_dummy.xsd')
256 
257 
258  CALL assign_dummy_sources(code_parameters, return_status)
259 
260  IF (return_status /= 0) THEN
261  WRITE(*,*) 'ERROR: Could not assign source multipliers.'
262  END IF
263 
264 
265 
266 !-------------------------------------------------------!
267 ! +++ Individual heating sources:
268 
269 ! Check that summ of fractions is 1.0
270  ftot = 0.0
271  DO i = 1,nion+1
272  ftot = ftot + fract(i)
273  END DO
274 
275 
276  IF (ftot.NE.1.0_r8) THEN
277  WRITE (6,*) 'Total contribution for the dummy source is not 1.0'
278  WRITE (6,*) 'Fractions will be renormalised'
279  fract = fract / ftot
280  END IF
281 
282 
283 
284  DO i = 1,nion+1
285 
286  a = rheat
287  c = fwheat(i)/2.35482_r8
288  w = wtot * fract(i)
289 
290  gfun = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
291  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
292  * vprime
293 
294  CALL integ(nrho, rho, gfun, intfun)
295 
296  pheat = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
297  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
298  * w / intfun
299 
300  IF (i.LE.nion) THEN
301  DO irho = 1, nrho
302  qion(irho,i) = pheat(irho)
303  END DO
304  ELSE IF (i.EQ.nion+1) THEN
305  DO irho = 1, nrho
306  qel(irho) = pheat(irho)
307  END DO
308 
309  END IF
310 
311  END DO
312 
313 
314 
315 !-------------------------------------------------------!
316 ! +++ Individual particle sources:
317  DO i = 1,nion
318 
319  IF (ami.EQ.amn(i)) THEN
320 
321  a = rpart
322  c = fwpart/2.35482_r8
323  w = stot
324 
325  gfun = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
326  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
327  * vprime
328 
329  CALL integ(nrho, rho, gfun, intfun)
330 
331  si = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
332  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
333  * w / intfun
334 
335  DO irho = 1, nrho
336  sion(irho,i) = si(irho)
337  END DO
338 
339  END IF
340 
341  END DO
342 
343 
344 
345 !-------------------------------------------------------!
346 ! +++ Individual momentum sources:
347  DO i = 1,nion
348 
349  IF (amm.EQ.amn(i)) THEN
350 
351  a = rmom
352  c = fwmom/2.35482_r8
353  w = utot
354 
355  gfun = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
356  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
357  * vprime
358 
359  CALL integ(nrho, rho, gfun, intfun)
360 
361  ui = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
362  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
363  * w / intfun
364 
365  DO irho = 1, nrho
366  uion(irho,i) = ui(irho)
367  END DO
368 
369  END IF
370 
371  END DO
372 
373 
374 
375 !-------------------------------------------------------!
376 ! +++ Current sources:
377  a = rcurr
378  c = fwcurr/2.35482_r8
379  w = jnitot
380 
381  gfun(2:) = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
382  * exp(-(rho(2:)-a)**2 / 2.0_r8 / c**2) &
383  * vprime(2:) / 2.0_r8 / itm_pi / rho(2:)
384 
385  IF (rho(1).EQ.0.0_r8) &
386  gfun(1) = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
387  * exp(-a**2 / 2.0_r8 / c**2) &
388  * 2.0_r8 * itm_pi * r0
389 
390  CALL integ(nrho, rho, gfun, intfun)
391 
392  jni = 1.0_r8 / (2.0_r8*itm_pi)**0.5/ c &
393  * exp(-(rho-a)**2 / 2.0_r8 / c**2) &
394  * w / intfun
395 
396 
397  RETURN
398 
399 
400 !-------------------------------------------------------!
401 !-------------------------------------------------------!
402 
403 
404 
405  CONTAINS
406 !-------------------------------------------------------!
407 !-------------------------------------------------------!
408  SUBROUTINE assign_dummy_sources(codeparameters, return_status)
409 
410 !-------------------------------------------------------!
411 ! This subroutine calls the XML parser for !
412 ! the dummy sources and assign the !
413 ! resulting values to the corresponding variables !
414 !-------------------------------------------------------!
415 ! Source: --- !
416 ! Developers: D.Kalupin !
417 ! Kontacts: Denis.Kalupin@efda.org !
418 ! !
419 ! Comments: --- !
420 ! !
421 !-------------------------------------------------------!
422 
423  USE itm_types
424  USE euitm_schemas
425  USE euitm_xml_parser
426 
427  IMPLICIT NONE
428 
429 
430  TYPE(type_param) :: codeparameters
431  INTEGER(ITM_I4) :: return_status
432 
433  TYPE(tree) :: parameter_list
434  TYPE(element), POINTER :: temp_pointer
435  INTEGER(ITM_I4) :: i, nparm, n_values
436  CHARACTER(len = 132) :: cname
437 
438  INTEGER :: n_data
439 
440  return_status = 0 ! no error
441 
442 !-- parse xml-string codeparameters%parameters
443 
444  WRITE(6,*) 'Calling euitm_xml_parse'
445  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
446  WRITE(6,*) 'Called euitm_xml_parse'
447 
448 !-- assign variables
449 
450  temp_pointer => parameter_list%first
451 
452  outer: DO
453  cname = char2str(temp_pointer%cname) ! necessary for AIX
454  SELECT CASE (cname)
455 
456 
457 !-- parameters overall
458  CASE ("parameters")
459  temp_pointer => temp_pointer%child
460  cycle
461 
462 !-- Parameters for heating source
463  CASE ("heating")
464  temp_pointer => temp_pointer%child
465  cycle
466 
467  CASE ("WTOT")
468  IF (ALLOCATED(temp_pointer%cvalue)) &
469  CALL char2num(temp_pointer%cvalue, wtot)
470 
471  CASE ("RHEAT")
472  IF (ALLOCATED(temp_pointer%cvalue)) &
473  CALL char2num(temp_pointer%cvalue, rheat)
474 
475  CASE ("FRACT")
476  IF (ALLOCATED(temp_pointer%cvalue)) &
477  CALL scan_str2real(char2str(temp_pointer%cvalue), fract, n_data)
478 
479  CASE ("FWHEAT")
480  IF (ALLOCATED(temp_pointer%cvalue)) &
481  CALL scan_str2real(char2str(temp_pointer%cvalue), fwheat, n_data)
482 
483 
484 !-- Parameters for particle source
485  CASE ("particles")
486  temp_pointer => temp_pointer%child
487  cycle
488 
489  CASE ("AMI")
490  IF (ALLOCATED(temp_pointer%cvalue)) &
491  CALL char2num(temp_pointer%cvalue, ami)
492 
493  CASE ("STOT")
494  IF (ALLOCATED(temp_pointer%cvalue)) &
495  CALL char2num(temp_pointer%cvalue, stot)
496 
497  CASE ("RPART")
498  IF (ALLOCATED(temp_pointer%cvalue)) &
499  CALL char2num(temp_pointer%cvalue, rpart)
500 
501  CASE ("FWPART")
502  IF (ALLOCATED(temp_pointer%cvalue)) &
503  CALL char2num(temp_pointer%cvalue, fwpart)
504 
505 
506 !-- Parameters for momentum source
507  CASE ("momentum")
508  temp_pointer => temp_pointer%child
509  cycle
510 
511  CASE ("AMM")
512  IF (ALLOCATED(temp_pointer%cvalue)) &
513  CALL char2num(temp_pointer%cvalue, amm)
514 
515  CASE ("UTOT")
516  IF (ALLOCATED(temp_pointer%cvalue)) &
517  CALL char2num(temp_pointer%cvalue, utot)
518 
519  CASE ("RMOM")
520  IF (ALLOCATED(temp_pointer%cvalue)) &
521  CALL char2num(temp_pointer%cvalue, rmom)
522 
523  CASE ("FWMOM")
524  IF (ALLOCATED(temp_pointer%cvalue)) &
525  CALL char2num(temp_pointer%cvalue, fwmom)
526 
527 
528 !-- Parameters for particle source
529  CASE ("currents")
530  temp_pointer => temp_pointer%child
531  cycle
532 
533  CASE ("JNITOT")
534  IF (ALLOCATED(temp_pointer%cvalue)) &
535  CALL char2num(temp_pointer%cvalue, jnitot)
536 
537  CASE ("RCURR")
538  IF (ALLOCATED(temp_pointer%cvalue)) &
539  CALL char2num(temp_pointer%cvalue, rcurr)
540 
541  CASE ("FWCURR")
542  IF (ALLOCATED(temp_pointer%cvalue)) &
543  CALL char2num(temp_pointer%cvalue, fwcurr)
544 
545 
546 
547  CASE default
548  WRITE(*, *) 'ERROR: invalid parameter', cname
549  return_status = 1
550  EXIT
551  END SELECT
552 
553 
554  DO
555  IF (ASSOCIATED(temp_pointer%sibling)) THEN
556  temp_pointer => temp_pointer%sibling
557  EXIT
558  END IF
559  IF (ASSOCIATED(temp_pointer%parent, parameter_list%first )) &
560  EXIT outer
561  IF (ASSOCIATED(temp_pointer%parent)) THEN
562  temp_pointer => temp_pointer%parent
563  ELSE
564  WRITE(*, *) 'ERROR: broken list.'
565  RETURN
566  END IF
567  END DO
568  END DO outer
569 
570 
571 ! -- destroy tree
572  CALL destroy_xml_tree(parameter_list)
573 
574 
575  RETURN
576 
577 
578  END SUBROUTINE assign_dummy_sources
579 !-------------------------------------------------------!
580 !-------------------------------------------------------!
581 
582 
583  END SUBROUTINE additional_source
584 !-------------------------------------------------------!
585 !-------------------------------------------------------!
586 
587 
588 
589 
590 
591 
592 !-------------------------------------------------------!
593 !-------------------------------------------------------!
594 ! This subroutine calculates integral of a function y(x)
595 ! from X=0
596  SUBROUTINE integ(N,X,Y,INTY)
597 
598 
599  USE itm_types
600 
601 
602  IMPLICIT NONE
603 
604  INTEGER :: n ! number of radial points (input)
605  INTEGER :: i
606 
607  REAL (R8) :: x(n), & ! argument array (input)
608  y(n), & ! function array (input)
609  inty ! integral value (output)
610 
611  inty = 0.0_r8
612  DO i=2,n
613  inty = inty + (y(i)+y(i-1))*(x(i)-x(i-1))/2.e0_r8
614  END DO
615 
616  RETURN
617 
618  END SUBROUTINE integ
619 !-------------------------------------------------------!
620 !-------------------------------------------------------!
621 
622 
623 
624 
625 !-------------------------------------------------------!
626 !-------------------------------------------------------!
627  SUBROUTINE interpolate(ninput,rinput,finput,nout,rout,fout)
628 
629  ! +++ this subroutine interpolates profile Finput(rinput) to the new greed Fout(rout)
630 
631  USE itm_types
632 
633  IMPLICIT NONE
634 
635  INTEGER :: i,ii,jj, ninput,nout
636  ! Input: radii, function
637  REAL (R8) :: rinput(ninput),finput(ninput)
638  ! Output: radii, function
639  REAL (R8) :: rout(nout),fout(nout)
640  REAL (R8) :: f(2),r,h1,h2,y1,y2,y3,a,b,c,z
641 
642 
643  DO i=1,nout
644  r=rout(i)
645  IF(r.LE.rinput(2)) THEN
646  h1=rinput(2)-rinput(1)
647  h2=rinput(3)-rinput(2)
648  y1=finput(1)
649  y2=finput(2)
650  y3=finput(3)
651  a=((y1-y2)*h2+(y3-y2)*h1)/h1/h2/(h1+h2)
652  b=((y3-y2)*h1*h1-(y1-y2)*h2*h2)/h1/h2/(h1+h2)
653  c=y2
654  z=a*(r-rinput(2))**2+b*(r-rinput(2))+c
655  goto 100
656  ENDIF
657  IF(r.GT.rinput(2).AND.r.LE.rinput(ninput-1)) THEN
658  DO ii=3,ninput-1
659  IF(r.GT.rinput(ii-1).AND.r.LE.rinput(ii)) THEN
660  DO jj=1,2
661  h1=rinput(ii-2+jj)-rinput(ii-3+jj)
662  h2=rinput(ii-1+jj)-rinput(ii-2+jj)
663  y1=finput(ii-3+jj)
664  y2=finput(ii-2+jj)
665  y3=finput(ii-1+jj)
666  a=((y1-y2)*h2+(y3-y2)*h1)/h1/h2/(h1+h2)
667  b=((y3-y2)*h1*h1-(y1-y2)*h2*h2)/h1/h2/(h1+h2)
668  c=y2
669  f(jj)=a*(r-rinput(ii-2+jj))**2+b*(r-rinput(ii-2+jj))+c
670  ENDDO
671  z=(f(1)*(rinput(ii)-r)+f(2)*(r-rinput(ii-1)))/ &
672  (rinput(ii)-rinput(ii-1))
673  ENDIF
674  ENDDO
675  goto 100
676  ENDIF
677  IF(r.GE.rinput(ninput-1)) THEN
678  h1=rinput(ninput-1)-rinput(ninput-2)
679  h2=rinput(ninput)-rinput(ninput-1)
680  y1=finput(ninput-2)
681  y2=finput(ninput-1)
682  y3=finput(ninput)
683  a=((y1-y2)*h2+(y3-y2)*h1)/h1/h2/(h1+h2)
684  b=((y3-y2)*h1*h1-(y1-y2)*h2*h2)/h1/h2/(h1+h2)
685  c=y2
686  z=a*(r-rinput(ninput-1))**2+b*(r-rinput(ninput-1))+c
687  goto 100
688  ENDIF
689 100 fout(i)=z
690  ENDDO
691 
692 !DPC
693  IF(rinput(1).EQ.rout(1)) THEN
694  IF(finput(1).NE.fout(1)) THEN
695  WRITE(*,*) 'INTERPOLATION corrected for ',rinput(1),finput(1),fout(1)
696  fout(1)=finput(1)
697  ENDIF
698  ENDIF
699  RETURN
700 
701  END SUBROUTINE interpolate
702 !-------------------------------------------------------!
703 !-------------------------------------------------------!
704 
705 
706 
707 END MODULE source_dummy
708 
709 
710 
711 
712 
713 
714 
715 
716 
l3deriv
subroutine l3deriv(y_in, x_in, nr_in, dydx_out, x_out, nr_out)
Definition: l3interp.f90:59
gausian_src::additional_source
subroutine additional_source(AMN, ZN, ZION, NRHO, RHO, R0, VPRIME, NION, QEL, QION, SEL, SION, UION, JNI, code_parameters)
Definition: gausian_src.f90:221
source_dummy::g_source
subroutine g_source(EQUILIBRIUM, COREPROF, CORESOURCE)
Definition: source_dummy.f90:18
allocate_deallocate::get_comp_dimensions
subroutine get_comp_dimensions(COMPOSITIONS, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP)
Definition: allocate_deallocate.f90:1845
gausian_src::integ
subroutine integ(N, X, Y, INTY)
Definition: gausian_src.f90:749
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
source_dummy
Module provides the dummy source to the ETS.
Definition: source_dummy.f90:8
allocate_deallocate::allocate_coresource_cpo
subroutine allocate_coresource_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORESOURCE)
This routine allocates CORESOURCE CPO.
Definition: allocate_deallocate.f90:460
itm_toolbox::interpolate
real(r8) function, dimension(size(x_out)) interpolate(x_in, y_in, x_out)
&quot;generic&quot; interpolation routine (only calls l3interp at the moment)
Definition: itm_toolbox.F90:29
assign_dummy_sources
subroutine assign_dummy_sources(codeparameters, return_status)
Definition: gausian_src.f90:503