V3FIT
read_response_nompi.f
1 !*******************************************************************************
2 ! File read_response.f
3 ! Module for use in program v3post
4 ! Encapsulates the reading of the netCDF files
5 ! for the coil responses and the plasma responses.
6 ! Response data is generated n code v3rfun.
7 ! This module is a companion to module write_response
8 ! NB. Geometric data in the cdf files IS NOT read back, only response data is read.
9 !-------------------------------------------------------------------------------
10 ! DEPENDENCIES
11 !-------------------------------------------------------------------------------
12 !
13 ! This module uses the following modules:
14 ! stel_kinds
15 ! stel_constants
16 ! bsc_cdf
17 ! response_arrays ! No Longer JDH 6.28.03
18 ! ezcdf
19 ! bsc
20 !
21 !-------------------------------------------------------------------------------
22 ! CHANGE HISTORY
23 !-------------------------------------------------------------------------------
24 !
25 ! Initial Coding - Ed Lazarus 12.12.2002
26 ! 01.11.2003 SPH - added istat error handler, in case file can not be opened
27 ! 04.11.2003 SPH - added mmode arg to check "Raw" or "Scaled" mode used for extcur array
28 ! 06.27.2003 JDH - Add kp_store to TYPE prfun. Add lots of comments and white space
29 ! 06.28.2003 JDH - Eliminated get_response. Only used once, changed call in v3post.f
30 ! 06.29.2003 JDH - Eliminated cdf_vctpot_read. In cdf_prfun_read, the vector potential
31 ! arrays a_r, a_f, a_z that are pointer components of the derived structure prfun,
32 ! now have space allocated within cdf_prfun_read.
33 ! 07.08.2003 SPH - Added logical flag ldim_only to cdf_prfun_read so only dimensions are read
34 ! in, NOT a-pointer components (needed for initializations).
35 ! 08.15.2003 JDH - Revised logic in cdf_prfun_read so that dimensional information
36 ! (including s_name) would ALWAYS be read in. Other small changes.
37 !-------------------------------------------------------------------------------
38 ! USAGE
39 !-------------------------------------------------------------------------------
40 !
41 !-------------------------------------------------------------------------------
42 ! COMMENTS
43 !-------------------------------------------------------------------------------
44 !
45 !
46 !*******************************************************************************
47 ! MODULE read_response
48 !
49 ! SECTION I. VARIABLE DECLARATIONS
50 ! SECTION II. INTERFACE BLOCKS
51 ! SECTION III. COIL RESPONSE FUNCTION READ
52 ! SECTION IV. PLASMA RESPONSE FUNCTION READ
53 !*******************************************************************************
54 
55 !*******************************************************************************
56 ! SECTION I. VARIABLE DECLARATIONS
57 !*******************************************************************************
58 
59  MODULE read_response_nompi
60 
61 ! work_arrays avoids premature size definition of arrays
62  USE stel_kinds
63  USE stel_constants
64 #if defined(NETCDF)
65  USE bsc_cdf, ONLY: vn_c_type, vn_s_name, vn_l_name,
66  1 vn_current, vn_raux, vn_xnod, vn_ehnod, vn_rcirc,
67  1 vn_xcent, vn_enhat
68 ! USE response_arrays
69  USE ezcdf
70 #endif
71 
72 ! Define derived type clresfun - coil response function
73  TYPE clresfun
74  INTEGER(iprec) :: n_field_cg
75  INTEGER(iprec) :: n_diagn_c
76  REAL(rprec), DIMENSION(:,:), POINTER :: rdiag_coilg => null()
77  END TYPE clresfun
78 
79 ! Define derived type prfun
80 ! Contains vector potential data for a single magnetic diagnostic
81 ! TYPE prfun is 247+8*size(a) bytes (+ size of kp_store, JDH)
82  TYPE prfun
83  CHARACTER (len=63) :: cdffil
84  CHARACTER (len=120) :: name_diagnostic_dot
85  CHARACTER (len=30) :: idrfun
86  INTEGER(iprec) :: idc
87  INTEGER(iprec) :: ir
88  INTEGER(iprec) :: jz
89  INTEGER(iprec) :: kp
90  INTEGER(iprec) :: kp_store
91  INTEGER(iprec) :: n_field_periods
92  REAL(rprec) :: rmin
93  REAL(rprec) :: rmax
94  REAL(rprec) :: zmin
95  REAL(rprec) :: zmax
96  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_r => null()
97  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_f => null()
98  REAL(rprec), DIMENSION(:,:,:), POINTER :: a_z => null()
99  CHARACTER (len=30) :: s_name
100  CHARACTER (len=8) :: c_type
101  LOGICAL :: lstell_sym
102  END TYPE prfun
103 
104 ! vn_ are the variable names loaded into NETCDF
105  CHARACTER (LEN=*), PARAMETER ::
106  & vn_rdiag_coilg = 'rdiag_coilg', &
107  & vn_n_field_cg = 'n_field_cg', &
108  & vn_n_diagn_c = 'n_diagn_c', &
109  & vn_inductance_coilg ='external_inductance'
110  CHARACTER (LEN=*), PARAMETER :: &
111  & vn_idrfun = 'idrfun', &
112  & vn_name_diagnostic_dot = 'name_diagnostic_dot', &
113  & vn_lstell_sym = 'lstell_sym', &
114  & vn_ir = 'ir', &
115  & vn_jz = 'jz', &
116  & vn_kp = 'kp', &
117  & vn_kp_store = 'kp_store', &
118  & vn_idc = 'idc', &
119  & vn_cdffil = 'cdffil', &
120  & vn_a_r = 'a_r', &
121  & vn_a_f = 'a_f', &
122  & vn_a_z = 'a_z', &
123  & vn_plasma_response = 'plasma_response', &
124  & vn_n_field_periods = 'n_field_periods', &
125  & vn_rmin = 'rmin', &
126  & vn_rmax = 'rmax', &
127  & vn_zmin = 'zmin', &
128  & vn_zmax = 'zmax'
129 
130 
131 ! Other variables
132 ! INTEGER :: nprfun = 0
133 
134 #if defined(NETCDF)
135 !*******************************************************************************
136 ! SECTION II. INTERFACE BLOCKS
137 !*******************************************************************************
138 !-------------------------------------------------------------------------------
139 !
140 !-------------------------------------------------------------------------------
141 
142  CONTAINS
143 
144 !*******************************************************************************
145 ! SECTION III. COIL RESPONSE FUNCTION READ
146 !*******************************************************************************
147 !-------------------------------------------------------------------------------
148 !
149 !-------------------------------------------------------------------------------
150  SUBROUTINE cdf_crfun_read_nompi(cdffil, crf, istat, mmode)
151 
152 ! cdf_crfun_read reads back the (sensor,coil) vector potential table
153 ! (ncrfun, cdffil) are unit number and file name. Called by get_response.
154 ! 01.11.2003 SPH
155 ! added istat error handler, in case file can not be opened
156 ! 04.11.2003 SPH
157 ! added mmode arg to check "Raw" or "Scaled" mode used for extcur array
158 ! ASSUMES that V3POST output for vn_rdiag_coilg is in "Raw" mode
159 ! JDH 06.28.2003. Added coil response function argument (derived type)
160 ! SPH 05.12.2005 Added MPI enabling code
161 ! this version for xv3post => NO MPI! EAL
162  IMPLICIT NONE
163 
164 !-----------------------------------------------
165 ! D u m m y A r g u m e n t s
166 !-----------------------------------------------
167  CHARACTER (LEN=*), INTENT(in) :: cdffil
168  TYPE(clresfun), INTENT(out) :: crf
169  INTEGER, INTENT(out) :: istat
170  CHARACTER(LEN=1), OPTIONAL, INTENT(in) :: mmode
171 ! cdffil name of the netcdf file that contains the coil response function
172 ! crf Derived Type clresfun variable - contains the coil response function
173 ! istat status variable
174 ! mmode variable to specify mode for "Scaled' or "Raw"
175 ! in "S" mode, B-fields are "unit" current responses, so EXTCUR
176 ! has units of A. The responses are obtained from SUM(inductance * EXTCUR)
177 ! in "R" mode, B-fields are the true fields corresponding to
178 ! the currents in the coils-dot file, so EXTCUR ~ unity dimensionless
179 ! multiplier. Thus, the responses are SUM(rdiag_coil * EXTCUR)
180 
181 !-----------------------------------------------
182 ! L o c a l V a r i a b l e s
183 !-----------------------------------------------
184  CHARACTER(LEN=1) :: mode = 'N'
185  INTEGER :: ncrfun, nwprocs
186  LOGICAL :: bReadIO
187 !-----------------------------------------------
188 ! Start of Executable Code
189 !-----------------------------------------------
190  IF (PRESENT(mmode)) mode = mmode
191  nwprocs = 0
192  istat = 0
193 
194  breadio = .true.
195 
196  IF (breadio) THEN
197  CALL cdf_open(ncrfun, cdffil, 'r', istat)
198  IF (istat .ne. 0) stop 'ERROR OPENING CDFFIL!'
199  CALL cdf_read(ncrfun, vn_n_field_cg, crf%n_field_cg)
200  CALL cdf_read(ncrfun, vn_n_diagn_c, crf%n_diagn_c)
201  END IF
202 
203  IF (ASSOCIATED(crf%rdiag_coilg)) DEALLOCATE(crf%rdiag_coilg)
204  ALLOCATE(crf%rdiag_coilg(crf%n_diagn_c,crf%n_field_cg), &
205  & stat = istat)
206  IF (istat .ne. 0) THEN
207  WRITE(6,*) 'In cdf_crfun_read, istat = ', istat
208  RETURN
209  END IF
210 
211  IF (breadio) THEN
212  IF (mode .eq. 'R' .or. mode .eq. 'N') THEN
213  CALL cdf_read(ncrfun, vn_rdiag_coilg, crf%rdiag_coilg)
214  ELSE
215  CALL cdf_read(ncrfun, vn_inductance_coilg, crf%rdiag_coilg)
216  END IF
217  CALL cdf_close(ncrfun, istat)
218  END IF
219 
220 
221  END SUBROUTINE cdf_crfun_read_nompi
222 
223 !*******************************************************************************
224 ! SECTION IV. PLASMA RESPONSE FUNCTION READ
225 !*******************************************************************************
226 !-------------------------------------------------------------------------------
227 !
228 !-------------------------------------------------------------------------------
229 
230  SUBROUTINE cdf_prfun_read_nompi(cdffil, pl_str, istat, ldim_only)
231 
232 ! Subroutine cdf_pr_fun reads a NETCDF file, and puts all the plasma
233 ! response function information into the defined type plrfun.
234 
235 ! cdf_prfun_read reads NETCDF file of vector potential for single sensor
236 ! (nprfun, cdffil, idc, pl_str) unit#, filename, sensor#, structure for
237 ! returning data. Called by get_response.
238 ! SPH added istat error handler, in case file can not be opened
239 ! SPH (05/12/05) added MPI_ logic
240  IMPLICIT NONE
241 ! USE bsc
242 
243 !-----------------------------------------------
244 ! D u m m y A r g u m e n t s
245 !-----------------------------------------------
246 
247  CHARACTER (LEN=*), INTENT(in) :: cdffil
248  TYPE (prfun), INTENT(inout) :: pl_str
249  INTEGER, INTENT(out) :: istat
250  LOGICAL, INTENT(in), OPTIONAL :: ldim_only
251 
252 ! cdffil name of the plasma response netcdf file
253 ! pl_str type prfun variable where the plasma response is stored
254 ! istat integer status variable
255 ! ldim_only logical, true if only need to read the dimension information.
256 !-----------------------------------------------
257 ! L o c a l V a r i a b l e s
258 !-----------------------------------------------
259 ! INTEGER :: dims(3)
260 ! CHARACTER(LEN=5) :: xtype
261  LOGICAL :: ldim_only_local, lfile
262  INTEGER :: nprfun, nwprocs
263  LOGICAL :: bReadIO
264 !-----------------------------------------------
265 ! Start of Executable Code
266 !-----------------------------------------------
267 
268  ldim_only_local = .false.
269  IF (PRESENT(ldim_only)) ldim_only_local = ldim_only
270  nwprocs = 0
271  istat = 0
272 
273  breadio = .true.
274 
275  IF (breadio) THEN
276  INQUIRE(file=cdffil, exist=lfile)
277  IF (.not. lfile) print*,"file=",cdffil
278  IF (.not. lfile) stop 'cdf file not found in CDF_PRFUN_READ!'
279 ! DO WHILE (istat .ne. 0)
280  CALL cdf_open(nprfun, cdffil, 'r', istat)
281 ! END DO
282 
283 ! Read the scalar (dim) information
284  CALL cdf_read(nprfun,vn_s_name,pl_str%s_name)
285  CALL cdf_read(nprfun,vn_kp,pl_str%kp)
286 
287  CALL cdf_read(nprfun,vn_kp_store,pl_str%kp_store,istat) ! note istat
288  CALL cdf_read(nprfun,vn_lstell_sym,pl_str%lstell_sym)
289 ! Coding to take care of files generated before the stellarator symmetry
290 ! was correctly implemented.
291  IF (istat .ne. 0) THEN
292  pl_str%kp_store = pl_str%kp
293  pl_str%lstell_sym = .false.
294  END IF
295 
296  CALL cdf_read(nprfun,vn_jz,pl_str%jz)
297  CALL cdf_read(nprfun,vn_ir,pl_str%ir)
298  CALL cdf_read(nprfun,vn_rmin,pl_str%rmin)
299  CALL cdf_read(nprfun,vn_rmax,pl_str%rmax)
300  CALL cdf_read(nprfun,vn_zmin,pl_str%zmin)
301  CALL cdf_read(nprfun,vn_zmax,pl_str%zmax)
302  CALL cdf_read(nprfun,vn_cdffil,pl_str%cdffil)
303  CALL cdf_read(nprfun,vn_idc,pl_str%idc)
304  CALL cdf_read(nprfun,vn_name_diagnostic_dot, &
305  & pl_str%name_diagnostic_dot)
306  CALL cdf_read(nprfun,vn_n_field_periods,pl_str%n_field_periods)
307  CALL cdf_read(nprfun,vn_idrfun,pl_str%idrfun)
308  END IF
309 
310 
311  IF (ldim_only_local) THEN
312  IF (breadio) CALL cdf_close(nprfun, istat)
313  RETURN
314  END IF
315 
316  IF (ASSOCIATED(pl_str%a_r)) DEALLOCATE(pl_str%a_r)
317  IF (ASSOCIATED(pl_str%a_f)) DEALLOCATE(pl_str%a_f)
318  IF (ASSOCIATED(pl_str%a_z)) DEALLOCATE(pl_str%a_z)
319  ALLOCATE(pl_str%a_r(pl_str%ir,pl_str%jz,pl_str%kp_store))
320  ALLOCATE(pl_str%a_f(pl_str%ir,pl_str%jz,pl_str%kp_store))
321  ALLOCATE(pl_str%a_z(pl_str%ir,pl_str%jz,pl_str%kp_store))
322 
323  IF (breadio) THEN
324  CALL cdf_read(nprfun,vn_a_r,pl_str%a_r)
325  CALL cdf_read(nprfun,vn_a_f,pl_str%a_f)
326  CALL cdf_read(nprfun,vn_a_z,pl_str%a_z)
327  CALL cdf_close(nprfun, istat)
328  END IF
329 
330 
331  END SUBROUTINE cdf_prfun_read_nompi
332 #endif
333  END MODULE read_response_nompi
read_response_nompi::clresfun
Definition: read_response_nompi.f:73
read_response_nompi::prfun
Definition: read_response_nompi.f:82