ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
plasma_composition.f90
Go to the documentation of this file.
1 MODULE plasma_composition
2 
3 CONTAINS
4 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
5 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
6  SUBROUTINE set_plasma_composition (COREPROF_OUT, &
7  nion, nimp, nneut, &
8  amn_ion, zn_ion, z_ion, &
9  amn_imp, zn_imp, maxz_imp, &
10  ncomp_in, ntype_in, &
11  ncold, nthermal, nfast, nnbi)
12 
13 
14 ! +++ Declaration of variables:
15  use itm_types
16  USE euitm_schemas
17  USE allocate_deallocate
18  USE copy_structures
19  USE deallocate_structures
20 
21 
22 
23  IMPLICIT NONE
24 
25 ! +++ CPO derived types:
26  TYPE (type_coreprof), POINTER :: coreprof_out(:) !output CPO slice
27  TYPE (type_compositionc), POINTER :: compositionc(:)
28 
29 ! +++ Input:
30  INTEGER, PARAMETER :: nocur = 1 !number of CPO ocurancies in the work flow
31  INTEGER :: nnucl, inucl !number of nuclei species
32  INTEGER :: nion, iion !number of ion species
33  INTEGER :: nimp, iimp !number of impurity species
34  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
35  INTEGER :: izimp
36  INTEGER :: nneut, ineut !number of neutrals species
37  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
38  INTEGER :: icomp
39  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
40  INTEGER :: itype
41 
42  INTEGER :: ncold, nthermal, nfast, nnbi
43 
44  REAL (R8), ALLOCATABLE :: amn_ion(:), zn_ion(:), z_ion(:)
45  REAL (R8), ALLOCATABLE :: amn_imp(:), zn_imp(:), maxz_imp(:)
46 
47  INTEGER :: ncomp_in(:)
48  INTEGER :: ntype_in(:)
49 
50  INTEGER, ALLOCATABLE :: nucindex_ion(:)
51  INTEGER, ALLOCATABLE :: nucindex_imp(:)
52  INTEGER, ALLOCATABLE :: nucindex_neut(:)
53  INTEGER :: neut_flag(4)
54  CHARACTER :: neut_id(4)
55  CHARACTER :: neut_desc(4)
56 
57  CHARACTER :: neutrals(4)
58  DATA neutrals /'cold','thermal','fast','NBI'/
59  INTEGER :: intype(4), i, i_ion
60 
61 ! +++ Local:
62  REAL (R8), ALLOCATABLE :: amn(:), zn(:)
63 
64 
65 
66 
67 ! +++ Check consistency:
68  IF(min(SIZE(amn_ion), SIZE(zn_ion),SIZE(z_ion)).LT.nion) THEN
69  WRITE (*,*) 'COMPOSITION INFORMATION IS NOT COMPETE FOR {1:NION}'
70  stop
71  END IF
72  IF(min(SIZE(amn_imp), SIZE(zn_imp),SIZE(maxz_imp)).LT.nimp) THEN
73  WRITE (*,*) 'COMPOSITION INFORMATION IS NOT COMPETE FOR {1:NIMP}'
74  stop
75  END IF
76 
77 
78 
79 ! +++ Define nuclei:
80  ALLOCATE (amn(nion+nimp))
81  ALLOCATE (zn(nion+nimp))
82  ALLOCATE (nucindex_ion(nion))
83  ALLOCATE (nucindex_imp(nimp))
84  ALLOCATE (nucindex_neut(nion+nimp))
85 
86 
87  nnucl = 0
88  DO iion = 1,nion
89  IF (amn_ion(iion).GT.0._r8.AND.zn_ion(iion).GT.0._r8) THEN
90  IF (nnucl.GE.1) THEN
91  DO inucl = 1, nnucl
92  IF (abs(amn(inucl)-amn_ion(iion)) .LE. 0.25 .AND. &
93  abs(zn(inucl)-zn_ion(iion)) .LE. 0.25) THEN !Nuclei already exist
94  nucindex_ion(iion) = inucl
95  nucindex_neut(iion) = inucl
96  goto 10
97  END IF
98  ENDDO
99  ENDIF
100  nnucl = nnucl + 1 !Add one more nuclei
101  amn(nnucl) = amn_ion(iion)
102  zn(nnucl) = zn_ion(iion)
103  nucindex_ion(iion) = nnucl
104  nucindex_neut(iion) = nnucl
105  10 CONTINUE
106  END IF
107  END DO
108  DO iimp = 1,nimp
109  IF (amn_imp(iimp).GT.0._r8.AND.zn_imp(iimp).GT.0._r8) THEN
110  IF (nnucl.GE.1) THEN
111  DO inucl = 1, nnucl
112  IF (abs(amn(inucl)-amn_imp(iimp)) .LE. 0.25 .AND. &
113  abs(zn(inucl)-zn_imp(iimp)) .LE. 0.25) THEN !Nuclei already exist
114  nucindex_imp(iimp) = inucl
115  nucindex_neut(nion+iimp) = inucl
116  goto 12
117  END IF
118  ENDDO
119  ENDIF
120  nnucl = nnucl + 1 !Add one more nuclei
121  amn(nnucl) = amn_imp(iimp)
122  zn(nnucl) = zn_imp(iimp)
123  nucindex_imp(iimp) = nnucl
124  nucindex_neut(nion+iimp) = nnucl
125  12 CONTINUE
126  END IF
127  END DO
128 
129 
130 
131 ! +++ Define impurity:
132  ALLOCATE (nzimp(nimp))
133 
134 
135  DO iimp = 1,nimp
136  nzimp(iimp) = int(maxz_imp(iimp))
137  END DO
138 
139 
140 
141 ! +++ Define neutrals:
142  if(nneut.gt.0) then
143  ALLOCATE (ncomp(nneut))
144  ALLOCATE (ntype(nneut))
145  ncomp(1:nneut) = ncomp_in(1:nneut)
146  ntype(1:nneut) = ntype_in(1:nneut)
147  intype(1) = ncold
148  intype(2) = nthermal
149  intype(3) = nfast
150  intype(4) = nnbi
151 
152  itype =0
153  DO i = 1, 4
154  IF (intype(i).EQ.1) THEN
155  itype = itype +1
156  neut_id(itype) = neutrals(i)
157  neut_flag(itype) = i-1
158  neut_desc(itype) = neutrals(i)
159  END IF
160  END DO
161  end if
162 
163 
164 
165 ! +++ Allocate output CPO and internal derived types:
166  CALL allocate_compositionc_cpo(nocur, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, compositionc)
167 
168 
169 
170 ! +++ Fill oou new allocated CPO:
171 ! +++ Nuclei:
172  DO inucl = 1, nnucl
173  compositionc(1)%compositions%NUCLEI(inucl)%zn = zn(inucl)
174  compositionc(1)%compositions%NUCLEI(inucl)%amn = amn(inucl)
175  compositionc(1)%compositions%NUCLEI(inucl)%label = " "
176  END DO
177 
178 
179 
180 ! +++ Ions:
181  DO iion = 1, nion
182  compositionc(1)%compositions%IONS(iion)%nucindex = nucindex_ion(iion)
183  compositionc(1)%compositions%IONS(iion)%zion = z_ion(iion)
184  compositionc(1)%compositions%IONS(iion)%imp_flag = 0
185  compositionc(1)%compositions%IONS(iion)%label = " "
186  END DO
187 
188 
189 
190 ! +++ Impurities:
191  DO iimp = 1, nimp
192  compositionc(1)%compositions%IMPURITIES(iimp)%nucindex = nucindex_imp(iimp)
193  i_ion = 0
194  DO iion = 1, nion
195  IF (nucindex_imp(iimp).EQ.nucindex_ion(iion)) i_ion = iion
196  END DO
197  compositionc(1)%compositions%IMPURITIES(iimp)%i_ion = i_ion
198  compositionc(1)%compositions%IMPURITIES(iimp)%nzimp = nzimp(iimp)
199  DO izimp = 1, nzimp(iimp)
200  compositionc(1)%compositions%IMPURITIES(iimp)%zmin(izimp) = izimp
201  compositionc(1)%compositions%IMPURITIES(iimp)%zmax(izimp) = izimp
202  compositionc(1)%compositions%IMPURITIES(iimp)%label(izimp) = " "
203  END DO
204  END DO
205 
206 
207 
208 ! +++ Neutrals:
209  DO ineut = 1, nneut
210  DO icomp = 1, ncomp(ineut)
211  compositionc(1)%compositions%NEUTRALSCOMP(ineut)%NEUTCOMP(icomp)%nucindex = nucindex_neut(ineut)
212  compositionc(1)%compositions%NEUTRALSCOMP(ineut)%NEUTCOMP(icomp)%multiplicity = 1
213  END DO
214  DO itype = 1, ntype(ineut)
215  compositionc(1)%compositions%NEUTRALSCOMP(ineut)%TYPE(itype)%id = neut_id(itype)
216  compositionc(1)%compositions%NEUTRALSCOMP(ineut)%TYPE(itype)%flag = neut_flag(itype)
217  compositionc(1)%compositions%NEUTRALSCOMP(ineut)%TYPE(itype)%description = neut_desc(itype)
218  END DO
219  END DO
220 
221 
222 
223 ! +++ Copy composition to COREPROF
224  ALLOCATE (coreprof_out(1))
225  CALL copy_cpo(compositionc(1)%compositions, coreprof_out(1)%compositions)
226 
227 
228 
229 ! +++ Deallocation
230  CALL deallocate_cpo(compositionc)
231 
232  DEALLOCATE (amn)
233  DEALLOCATE (zn)
234  DEALLOCATE (nzimp)
235  if(nneut.gt.0) then
236  DEALLOCATE (ncomp)
237  DEALLOCATE (ntype)
238  endif
239  DEALLOCATE (nucindex_ion)
240  DEALLOCATE (nucindex_imp)
241  DEALLOCATE (nucindex_neut)
242 
243 
244  RETURN
245 
246 
247  END SUBROUTINE set_plasma_composition
248 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
249 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
250 
251 
252 END MODULE plasma_composition
plasma_composition
Definition: plasma_composition.f90:1
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
plasma_composition::set_plasma_composition
subroutine set_plasma_composition(COREPROF_OUT, NION, NIMP, NNEUT, AMN_ION, ZN_ION, Z_ION, AMN_IMP, ZN_IMP, MAXZ_IMP, NCOMP_IN, NTYPE_IN, NCOLD, NTHERMAL, NFAST, NNBI)
Definition: plasma_composition.f90:6
allocate_deallocate::allocate_compositionc_cpo
subroutine allocate_compositionc_cpo(NSLICE, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, COMPOSITIONC)
Definition: allocate_deallocate.f90:1663