V3FIT
read_response.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
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(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 
162  USE mpi_params
163  USE mpi_inc
164  IMPLICIT NONE
165 
166 !-----------------------------------------------
167 ! D u m m y A r g u m e n t s
168 !-----------------------------------------------
169  CHARACTER (LEN=*), INTENT(in) :: cdffil
170  TYPE(clresfun), INTENT(out) :: crf
171  INTEGER, INTENT(out) :: istat
172  CHARACTER(LEN=1), OPTIONAL, INTENT(in) :: mmode
173 ! cdffil name of the netcdf file that contains the coil response function
174 ! crf Derived Type clresfun variable - contains the coil response function
175 ! istat status variable
176 ! mmode variable to specify mode for "Scaled' or "Raw"
177 ! in "S" mode, B-fields are "unit" current responses, so EXTCUR
178 ! has units of A. The responses are obtained from SUM(inductance * EXTCUR)
179 ! in "R" mode, B-fields are the true fields corresponding to
180 ! the currents in the coils-dot file, so EXTCUR ~ unity dimensionless
181 ! multiplier. Thus, the responses are SUM(rdiag_coil * EXTCUR)
182 
183 !-----------------------------------------------
184 ! L o c a l V a r i a b l e s
185 !-----------------------------------------------
186  CHARACTER(LEN=1) :: mode = 'N'
187  INTEGER :: ncrfun, nwprocs
188  LOGICAL :: bReadIO
189 !-----------------------------------------------
190 ! Start of Executable Code
191 !-----------------------------------------------
192  IF (PRESENT(mmode)) mode = mmode
193  nwprocs = 0
194  istat = 0
195 
196 #if defined(MPI_OPT)
197  CALL mpi_comm_rank(mpi_comm_workers_ok, worker_id_ok, ierr_mpi)
198  CALL mpi_comm_size(mpi_comm_workers_ok, nwprocs, ierr_mpi)
199  IF (ierr_mpi .ne. 0) stop 'IERR_MPI != IN CDF_CRFUN_READ'
200  breadio = (worker_id_ok .eq. master)
201 #else
202  breadio = .true.
203 #endif
204 
205  IF (breadio) THEN
206  CALL cdf_open(ncrfun, cdffil, 'r', istat)
207  IF (istat .ne. 0) stop 'ERROR OPENING CDFFIL!'
208 
209  CALL cdf_read(ncrfun, vn_n_field_cg, crf%n_field_cg)
210  CALL cdf_read(ncrfun, vn_n_diagn_c, crf%n_diagn_c)
211  END IF
212 
213 #if defined(MPI_OPT)
214  IF (nwprocs .gt. 1) THEN
215  CALL mpi_bcast(crf%n_field_cg,1,
216  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
217  CALL mpi_bcast(crf%n_diagn_c,1,
218  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
219  END IF
220 #endif
221  IF (ASSOCIATED(crf%rdiag_coilg)) DEALLOCATE(crf%rdiag_coilg)
222  ALLOCATE(crf%rdiag_coilg(crf%n_diagn_c,crf%n_field_cg), &
223  & stat = istat)
224  IF (istat .ne. 0) THEN
225  WRITE(6,*) 'In cdf_crfun_read, istat = ', istat
226  RETURN
227  END IF
228 
229  IF (breadio) THEN
230  IF (mode .eq. 'R' .or. mode .eq. 'N') THEN
231  CALL cdf_read(ncrfun, vn_rdiag_coilg, crf%rdiag_coilg)
232  ELSE
233  CALL cdf_read(ncrfun, vn_inductance_coilg, crf%rdiag_coilg)
234  END IF
235  CALL cdf_close(ncrfun, istat)
236  END IF
237 
238 #if defined(MPI_OPT)
239  IF (nwprocs .gt. 1) THEN
240  CALL mpi_bcast(crf%rdiag_coilg,SIZE(crf%rdiag_coilg),
241  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
242  END IF
243 #endif
244 
245  END SUBROUTINE cdf_crfun_read
246 
247 !*******************************************************************************
248 ! SECTION IV. PLASMA RESPONSE FUNCTION READ
249 !*******************************************************************************
250 !-------------------------------------------------------------------------------
251 !
252 !-------------------------------------------------------------------------------
253 
254  SUBROUTINE cdf_prfun_read(cdffil, pl_str, istat, ldim_only)
255 
256 ! Subroutine cdf_pr_fun reads a NETCDF file, and puts all the plasma
257 ! response function information into the defined type plrfun.
258 
259 ! cdf_prfun_read reads NETCDF file of vector potential for single sensor
260 ! (nprfun, cdffil, idc, pl_str) unit#, filename, sensor#, structure for
261 ! returning data. Called by get_response.
262 ! SPH added istat error handler, in case file can not be opened
263 ! SPH (05/12/05) added MPI_ logic
264  USE mpi_params
265  USE mpi_inc
266  IMPLICIT NONE
267 ! USE bsc
268 
269 !-----------------------------------------------
270 ! D u m m y A r g u m e n t s
271 !-----------------------------------------------
272 
273  CHARACTER (LEN=*), INTENT(in) :: cdffil
274  TYPE (prfun), INTENT(inout) :: pl_str
275  INTEGER, INTENT(out) :: istat
276  LOGICAL, INTENT(in), OPTIONAL :: ldim_only
277 
278 ! cdffil name of the plasma response netcdf file
279 ! pl_str type prfun variable where the plasma response is stored
280 ! istat integer status variable
281 ! ldim_only logical, true if only need to read the dimension information.
282 !-----------------------------------------------
283 ! L o c a l V a r i a b l e s
284 !-----------------------------------------------
285 ! INTEGER :: dims(3)
286 ! CHARACTER(LEN=5) :: xtype
287  LOGICAL :: ldim_only_local, lfile
288  INTEGER :: nprfun, nwprocs
289  LOGICAL :: bReadIO
290 !-----------------------------------------------
291 ! Start of Executable Code
292 ! MPI Logic:
293 ! 1) If controllor processor, myid = master, gets here, let it read from the file
294 ! since it will be the ONLY processor to read (initial run through stellopt)
295 ! 2) If myid != master from the main (MPI_COMM_WORLD) group, then let ONLY the
296 ! worker_myid=0 from the MPI_COMM_WORKERS_OK group do the reading, and it should send
297 ! (bcast) the information to all other processors IN THAT WORKER group, only
298 !
299 !-----------------------------------------------
300 
301  ldim_only_local = .false.
302  IF (PRESENT(ldim_only)) ldim_only_local = ldim_only
303  nwprocs = 0
304  istat = 0
305 
306 #if defined(MPI_OPT)
307  CALL mpi_comm_rank(mpi_comm_workers_ok, worker_id_ok, ierr_mpi)
308  CALL mpi_comm_size(mpi_comm_workers_ok, nwprocs, ierr_mpi)
309  IF (ierr_mpi .ne. 0) stop 'IERR_MPI != IN CDF_PRFUN_READ'
310  breadio = (worker_id_ok .eq. master)
311 #else
312  breadio = .true.
313 #endif
314 
315  IF (breadio) THEN
316  INQUIRE(file=cdffil, exist=lfile)
317  IF (.not. lfile) THEN
318  print *,' cdf file: ', trim(cdffil),
319  1 ' not found in CDF_PRFUN_READ!'
320  stop
321  END IF
322 ! DO WHILE (istat .ne. 0)
323  CALL cdf_open(nprfun, cdffil, 'r', istat)
324 ! END DO
325 
326 ! Read the scalar (dim) information
327  CALL cdf_read(nprfun,vn_s_name,pl_str%s_name)
328  CALL cdf_read(nprfun,vn_kp,pl_str%kp)
329 
330  CALL cdf_read(nprfun,vn_kp_store,pl_str%kp_store,istat) ! note istat
331  CALL cdf_read(nprfun,vn_lstell_sym,pl_str%lstell_sym)
332 ! Coding to take care of files generated before the stellarator symmetry
333 ! was correctly implemented.
334  IF (istat .ne. 0) THEN
335  pl_str%kp_store = pl_str%kp
336  pl_str%lstell_sym = .false.
337  END IF
338 
339  CALL cdf_read(nprfun,vn_jz,pl_str%jz)
340  CALL cdf_read(nprfun,vn_ir,pl_str%ir)
341  CALL cdf_read(nprfun,vn_rmin,pl_str%rmin)
342  CALL cdf_read(nprfun,vn_rmax,pl_str%rmax)
343  CALL cdf_read(nprfun,vn_zmin,pl_str%zmin)
344  CALL cdf_read(nprfun,vn_zmax,pl_str%zmax)
345  CALL cdf_read(nprfun,vn_cdffil,pl_str%cdffil)
346  CALL cdf_read(nprfun,vn_idc,pl_str%idc)
347  CALL cdf_read(nprfun,vn_name_diagnostic_dot, &
348  & pl_str%name_diagnostic_dot)
349  CALL cdf_read(nprfun,vn_n_field_periods,pl_str%n_field_periods)
350  CALL cdf_read(nprfun,vn_idrfun,pl_str%idrfun)
351  END IF
352 
353 #if defined(MPI_OPT)
354  IF (nwprocs .gt. 1) THEN
355  CALL mpi_bcast(pl_str%s_name,len(pl_str%s_name),
356  1 mpi_character,master,mpi_comm_workers_ok,ierr_mpi)
357  CALL mpi_bcast(pl_str%kp,1,
358  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
359  CALL mpi_bcast(pl_str%kp_store,1,
360  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
361  CALL mpi_bcast(pl_str%lstell_sym,1,
362  1 mpi_logical,master,mpi_comm_workers_ok,ierr_mpi)
363  CALL mpi_bcast(pl_str%jz,1,
364  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
365  CALL mpi_bcast(pl_str%ir,1,
366  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
367  CALL mpi_bcast(pl_str%rmin,1,
368  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
369  CALL mpi_bcast(pl_str%rmax,1,
370  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
371  CALL mpi_bcast(pl_str%zmin,1,
372  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
373  CALL mpi_bcast(pl_str%zmax,1,
374  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
375  CALL mpi_bcast(pl_str%cdffil,len(pl_str%cdffil),
376  1 mpi_character,master,mpi_comm_workers_ok,ierr_mpi)
377  CALL mpi_bcast(pl_str%idc,1,
378  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
379  CALL mpi_bcast(pl_str%n_field_periods,1,
380  1 mpi_integer,master,mpi_comm_workers_ok,ierr_mpi)
381  CALL mpi_bcast(pl_str%name_diagnostic_dot,
382  1 len(pl_str%name_diagnostic_dot),
383  1 mpi_character,master,mpi_comm_workers_ok,ierr_mpi)
384  CALL mpi_bcast(pl_str%idrfun,len(pl_str%idrfun),
385  1 mpi_character,master,mpi_comm_workers_ok,ierr_mpi)
386  END IF
387 #endif
388 
389  IF (ldim_only_local) THEN
390  IF (breadio) CALL cdf_close(nprfun, istat)
391  RETURN
392  END IF
393 
394  IF (ASSOCIATED(pl_str%a_r)) DEALLOCATE(pl_str%a_r)
395  IF (ASSOCIATED(pl_str%a_f)) DEALLOCATE(pl_str%a_f)
396  IF (ASSOCIATED(pl_str%a_z)) DEALLOCATE(pl_str%a_z)
397  ALLOCATE(pl_str%a_r(pl_str%ir,pl_str%jz,pl_str%kp_store))
398  ALLOCATE(pl_str%a_f(pl_str%ir,pl_str%jz,pl_str%kp_store))
399  ALLOCATE(pl_str%a_z(pl_str%ir,pl_str%jz,pl_str%kp_store))
400 
401  IF (breadio) THEN
402  CALL cdf_read(nprfun,vn_a_r,pl_str%a_r)
403  CALL cdf_read(nprfun,vn_a_f,pl_str%a_f)
404  CALL cdf_read(nprfun,vn_a_z,pl_str%a_z)
405  CALL cdf_close(nprfun, istat)
406  END IF
407 
408 #if defined(MPI_OPT)
409  IF (nwprocs .gt. 1) THEN
410  CALL mpi_bcast(pl_str%a_r,SIZE(pl_str%a_r),
411  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
412  CALL mpi_bcast(pl_str%a_f,SIZE(pl_str%a_f),
413  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
414  CALL mpi_bcast(pl_str%a_z,SIZE(pl_str%a_z),
415  1 mpi_real8,master,mpi_comm_workers_ok,ierr_mpi)
416  END IF
417 #endif
418 
419  END SUBROUTINE cdf_prfun_read
420 #endif
421  END MODULE read_response
read_response::clresfun
Definition: read_response.f:73
read_response::prfun
Definition: read_response.f:82
mpi_inc
Umbrella module avoid multiple inlcudes of the mpif.h header.
Definition: mpi_inc.f:11