GRIDMAN
grid managment library
carre.f
Go to the documentation of this file.
1 C> @file formats/carre.f
2 C> Reading the 2D magnetic field aligned grid in CARRE (SONNET) format
3 C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de
4 
5 ! Copyright (c) 2017 Forschungszentrum Juelich GmbH
6 ! Vladislav Kotov
7 !
8 ! This file is part of GRIDMAN.
9 !
10 ! GRIDMAN is free software: you can redistribute it and/or modify
11 ! it under the terms of the GNU General Public License as published by
12 ! the Free Software Foundation, either version 3 of the License, or
13 ! (at your option) any later version.
14 !
15 ! GRIDMAN is distributed in the hope that it will be useful,
16 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ! GNU General Public License for more details.
19 !
20 ! You should have received a copy of the GNU General Public License
21 ! along with GRIDMAN. If not, see <http://www.gnu.org/licenses/>.
22 
23 C*********************************************************************************
24 C> Read B2 (CARRE, SONNET) grid from fort.30, return separate arrays
25 C>
26 C> FORT.30 contains B2 grid in the format understood by EIRENE.
27 C> The file is generated by B2.
28 C>
38 C> To convert the grid into GRIDMAN_GRID object
39 C> NXCUT, NYCUT, NXISO, NYISO, as well as BR, BZ broduced by
40 C> GRIDMAN_CARRE_READ30 has to be sent to GRIDMAN_CARRE2GRID_FORT30
41 C>
42 C> WARNING: arrays NNCUT, NXCUT, NYCUT, NNISO, NXISO, NYISO, BR, BZ, BC, PIT
43 C> must NOT be allocated - they are allocated inside the subroutine.
44 C> Arrays which already exist will be re-allocated.
45 C>
46 C> GRIDMAN_CARRE_READ30_ARRAY and GRIDMAN_CARRE_READ30_GRID
47 C> are combined in the interface GRIDMAN_CARRE_READ30
48 C
49 C*********************************************************************************
50  SUBROUTINE gridman_carre_read30_array(FNAME,STITLE,NX,NY,
51  s nncut,nxcut,nycut,
52  s nniso,nxiso,nyiso,
53  s br,bz,ierr)
54  USE gridman,ONLY:gridman_dp,gridman_sp,
55  u gridman_dbg,gridman_unit
56  IMPLICIT NONE
57  INTRINSIC len_trim
58 C> String containing the name of input file
59  CHARACTER(*),INTENT(IN) :: FNAME
60 C> String containing the file title
61  CHARACTER(*),INTENT(OUT) :: STITLE
62 C> Number of poloidal (X) cells
63  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NX
64 C> Number of radial (Y) cells
65  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NY
66 C> Number of cuts
67  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NNCUT
68 C> Number of isolated surfaces
69  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NNISO
70 C> Poloidal (X) indices of the cuts, NXCUT(2,NNCUT)
71  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NXCUT(:,:)
72 C> Radial (Y) indices of the cuts, NYCUT(2,NNCUT)
73  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NYCUT(:,:)
74 C> Poloidal (X) indices of isolated surfaces, NXISO(2,NNISO)
75  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NXISO(:,:)
76 C> Radial (Y) indices of isolated surfaces, NYISO(2,NNISO)
77  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NYISO(:,:)
78 C> Main radius (R) coordinates of the cell nodes, BR(NX,NY,4)
79  REAL(GRIDMAN_DP),ALLOCATABLE :: BR(:,:,:)
80 C> Vertical (Z) coordinates of the cell nodes, BZ(NX,NY,4)
81  REAL(GRIDMAN_DP),ALLOCATABLE :: BZ(:,:,:)
82 C> Error code
83  INTEGER,INTENT(OUT) :: IERR
84 
85  CHARACTER(256) :: STR
86  INTEGER(GRIDMAN_SP) :: IX,IY,I
87  INTEGER :: IO,IS,SL
88 
89  IF(gridman_dbg)
90  w WRITE(gridman_unit,*) "Starting GRIDMAN_CARRE_READ30_ARRAY"
91 
92  ierr=0
93  CALL nullify
94 
95  sl=len_trim(fname)
96  IF(sl.GT.0) THEN
97  OPEN (unit=30,status='OLD',access='SEQUENTIAL',
98  o form='FORMATTED',file=fname,iostat=io)
99  IF(io.NE.0) THEN
100  ierr=300
101  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
102  o "can not open ",fname(1:sl)
103  CALL nullify
104  RETURN
105  END IF
106  ELSE
107  OPEN (unit=30,status='OLD',access='SEQUENTIAL',
108  o form='FORMATTED',file='fort.30',iostat=io)
109  IF(io.NE.0) THEN
110  ierr=300
111  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
112  o "can not open fort.30"
113  CALL nullify
114  RETURN
115  END IF
116  END IF
117 
118  READ(30,'(A)',iostat=io) stitle ! READING TITLE
119  IF(io.NE.0) GOTO 200
120  10 READ(30,'(A)',iostat=io) str !SKIP SPACES
121  IF(io.NE.0) GOTO 200
122  IF(len_trim(str).LT.1) GOTO 10
123  READ(str,*,iostat=io) nx,ny,nncut !READING DIMENSIONS
124  IF(io.NE.0) GOTO 200
125  IF(nncut.GT.0) THEN !READING COORDINATES OF CUTS
126  IF(ALLOCATED(nxcut)) DEALLOCATE(nxcut)
127  IF(ALLOCATED(nycut)) DEALLOCATE(nycut)
128  ALLOCATE(nxcut(2,nncut),nycut(2,nncut),stat=is)
129  IF(is.NE.0) THEN
130  ierr=200
131  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
132  w "can not perform allocation"
133  CLOSE(30)
134  CALL nullify
135  RETURN
136  END IF
137  READ(30,*,iostat=io) (nxcut(1,i),nxcut(2,i),
138  r nycut(1,i),nycut(2,i),i=1,nncut)
139  IF(io.NE.0) GOTO 200
140  ELSE
141  READ(30,*,iostat=io) !SKIP LINE
142  IF(ALLOCATED(nxcut)) DEALLOCATE(nxcut)
143  IF(ALLOCATED(nycut)) DEALLOCATE(nycut)
144  ALLOCATE(nxcut(1,1),nycut(1,1),stat=is) !ALLOCATE DUMMY
145  IF(is.NE.0) THEN
146  ierr=200
147  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
148  w "can not perform allocation"
149  CLOSE(30)
150  CALL nullify
151  RETURN
152  END IF
153  END IF !IF(NNCUT.GT.0) THEN
154 
155  IF(nncut.GT.2) THEN !READING COORDINATES OF ISOLATED CELLS
156  READ(30,*,iostat=io) nniso
157  IF(io.NE.0) GOTO 200
158  IF(nniso.GT.0) THEN
159  IF(ALLOCATED(nxiso)) DEALLOCATE(nxiso)
160  IF(ALLOCATED(nyiso)) DEALLOCATE(nyiso)
161  ALLOCATE(nxiso(2,nniso),nyiso(2,nniso),stat=is)
162  IF(is.NE.0) THEN
163  ierr=200
164  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
165  w "can not perform allocation"
166  CLOSE(30)
167  CALL nullify
168  RETURN
169  END IF
170  READ(30,*,iostat=io) (nxiso(1,i),nxiso(2,i),
171  r nyiso(1,i),nyiso(2,i),i=1,nniso)
172  IF(io.NE.0) GOTO 200
173  ELSE
174  READ(30,*,iostat=io) !SKIP LINE
175  END IF !IF(NNISO.GT.0)
176  END IF
177 
178  IF(.NOT.ALLOCATED(nxiso) ) THEN !ALLOCATE DUMMY
179  ALLOCATE(nxiso(1,1),nyiso(1,1),stat=is) !ALLOCATE DUMMY
180  IF(is.NE.0) THEN
181  ierr=200
182  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
183  w "can not perform allocation"
184  CLOSE(30)
185  CALL nullify
186  RETURN
187  END IF
188  END IF
189 
190  READ(30,*,iostat=io) !EMPTY LINE
191  IF(io.NE.0) GOTO 200
192 
193  IF(nx.GT.0.AND.ny.GT.0) THEN
194 C READING COORDINATES
195  IF(ALLOCATED(br)) DEALLOCATE(br)
196  IF(ALLOCATED(bz)) DEALLOCATE(bz)
197  ALLOCATE(br(nx,ny,4),bz(nx,ny,4),stat=is)
198  IF(is.NE.0) THEN
199  ierr=200
200  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
201  w "can not perform allocation"
202  CLOSE(30)
203  CALL nullify
204  RETURN
205  END IF
206  DO ix=1,nx
207  DO iy=1,ny
208 cc READ(30,'(4e15.7)',IOSTAT=IO,ERR=200,END=200) (BR(IX,IY,I),I=1,4)
209  READ(30,*,iostat=io,err=200,end=200) (br(ix,iy,i),i=1,4)
210  IF(io.NE.0) GOTO 200
211 cc READ(30,'(4e15.7)',IOSTAT=IO,ERR=200,END=200) (BZ(IX,IY,I),I=1,4)
212  READ(30,*,iostat=io,err=200,end=200) (bz(ix,iy,i),i=1,4)
213  IF(io.NE.0) GOTO 200
214  END DO
215  END DO
216  ELSE
217  ierr=400
218  WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READ30_ARRAY: ",
219  w "incorrect dimensions, NX, NY ", ny,ny
220  WRITE(gridman_unit,*) " Reading of BR and BZ is skipped"
221  CLOSE(30)
222  CALL nullify
223  RETURN
224  END IF !IF(NX.GT.0.AND.NY.GT.0)
225 
226  CLOSE(30)
227 
228 C ARRAYS ARE NOT LEFT UNALLOCATED IN ORDER NOT TO
229 C CONFUSE COMPILER IN THE SUBSEQUENT CALL OFF GRIDMAN_CARRE2GRID
230  IF(.NOT.ALLOCATED(nxcut)) ALLOCATE(nxcut(1,1))
231  IF(.NOT.ALLOCATED(nycut)) ALLOCATE(nycut(1,1))
232  IF(.NOT.ALLOCATED(nxiso)) ALLOCATE(nxiso(1,1))
233  IF(.NOT.ALLOCATED(nyiso)) ALLOCATE(nyiso(1,1))
234 
235  IF(gridman_dbg)
236  w WRITE(gridman_unit,*) "GRIDMAN_CARRE_READ30_ARRAY finished"
237 
238  RETURN
239 
240  200 CLOSE(30)
241  ierr=300 !ERROR WHEN READING FORT.30
242  WRITE(gridman_unit,*)
243  w "ERROR in GRIDMAN_CARRE_READ30_ARRAY: can not read fort.30"
244  CALL nullify
245  RETURN
246 
247  CONTAINS
248 C
249  SUBROUTINE nullify
250  nx=0
251  ny=0
252  nncut=0
253  nniso=0
254  END SUBROUTINE nullify
255 
256  END SUBROUTINE gridman_carre_read30_array
257 
258 C*********************************************************************************
259 C> Read carre grid in SONNET format, return separate arrays
260 C*********************************************************************************
261 C>
271 C> To convert the grid into GRIDMAN_GRID object
272 C> NXCUT, NYCUT, NXISO, NYISO, as well as BR, BZ broduced by
273 C> GRIDMAN_CARRE_READSONNET has to be sent to GRIDMAN_CARRE2GRID
274 C>
275 C> GRIDMAN_CARRE_READSONNET_ARRAY and GRIDMAN_CARRE_READSONNET_GRID
276 C> are combined in the interface GRIDMAN_CARRE_READSONNET
277 C
278  SUBROUTINE gridman_carre_readsonnet_array(FNAME,NX,NY,
279  s nncut,nxcut,nycut,
280  s nniso,nxiso,nyiso,
281  s rbt,br,bz,pit,bc,ierr)
282  USE gridman,ONLY:gridman_dp,gridman_sp,
283  u gridman_dbg,gridman_unit
284  IMPLICIT NONE
285  INTRINSIC trim,index
286 C> String containing the name of input file
287  CHARACTER(*),INTENT(IN) :: FNAME
288 C> Number of poloidal (X) cells
289  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NX
290 C> Number of poloidal (Y) cells
291  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NY
292 C> Number of cuts
293  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NNCUT
294 C> Number of isolated surfaces
295  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NNISO
296 C> Poloidal (X) indices of cuts, NXCUT(NNCUT)
297  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NXCUT(:)
298 C> Radial (Y) indices of cuts, NXCUT(NNCUT)
299  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NYCUT(:)
300 C> Poloidal (X) indices of isolated surfaces, NXISO(NNISO)
301  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NXISO(:)
302 C> Radial (Y) indices of isolated surfaces, NYISO(NNISO)
303  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NYISO(:)
304 C> R*Btor (Major radius x Toroidal field strength)
305  REAL(GRIDMAN_DP) :: RBT
306 C> Main radius (R) coordinates of the cell nodes, BR(0:NX+1,0:NY+1,4)
307  REAL(GRIDMAN_DP),ALLOCATABLE :: BR(:,:,:)
308 C> Vertical (Z) coordinates of the cell nodes, BZ(0:NX+1,0:NY+1,4)
309  REAL(GRIDMAN_DP),ALLOCATABLE :: BZ(:,:,:)
310 C> Coordinates of cells centers, BC(0:NX+1,0:NY+1,2)
311 C>
312 C> BC(:,:,1) is R coordinate, BC(:,:,2) is Z coordinate,
313  REAL(GRIDMAN_DP),ALLOCATABLE :: BC(:,:,:)
314 C> Pitch - ration of poloidal and total field strength, PIT(0:NX+1,0:NY+1)
315 C>
316 C> Pitch is defined at the position of cell center BC
317  REAL(GRIDMAN_DP),ALLOCATABLE :: PIT(:,:)
318 C> Error code
319  INTEGER,INTENT(OUT) :: IERR
320 
321  INTEGER,PARAMETER :: LS=1024
322  CHARACTER(LEN=LS) :: STR
323  INTEGER :: I,I1,I2,I3,ST,IO,IS
324  INTEGER(GRIDMAN_SP) :: IX,IY,N,M
325  REAL(GRIDMAN_DP) :: RR(4),ZZ(4),PITT,BCX,BCY
326  LOGICAL :: LNOPITCH
327 
328  IF(gridman_dbg)
329  w WRITE(gridman_unit,*) "Starting GRIDMAN_CARRE_READSONNET_ARRAY"
330 
331  ierr=0
332  nx=0
333  ny=0
334  nncut=0
335  nniso=0
336 
337  OPEN (unit=30,status='OLD',access='SEQUENTIAL',
338  o form='FORMATTED',file=fname,iostat=io)
339  IF(io.NE.0) THEN
340  ierr=300
341  WRITE(gridman_unit,*)
342  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
343  o "can not open ",trim(fname)
344  RETURN
345  END IF
346 
347 C READING THE HEADER
348  IF(gridman_dbg)
349  w WRITE(gridman_unit,*)
350  w "GRIDMAN_CARRE_READSONNET_ARRAY reading header"
351  100 READ(30,'(A)',iostat=io) str
352  IF(io.NE.0) GOTO 1000
353  i=carre_substring(str,'R*Btor')
354  IF(i.GT.0) THEN
355  READ(str(i+1:ls),*) rbt
356  GOTO 100
357  END IF
358  i=carre_substring(str,'nx')
359  i1=index(str,'nxcut')
360  i2=index(str,'nxiso')
361  IF(i.GT.0.AND.i1.EQ.0.AND.i2.EQ.0) THEN
362  READ(str(i+1:ls),*) nx
363  GOTO 100
364  END IF
365  i=carre_substring(str,'ny')
366  i1=index(str,'nycut')
367  i2=index(str,'nyiso')
368  IF(i.GT.0.AND.i1.EQ.0.AND.i2.EQ.0) THEN
369  READ(str(i+1:ls),*) ny
370  GOTO 100
371  END IF
372  i=carre_substring(str,'ncut')
373  IF(i.GT.0) THEN
374  READ(str(i+1:ls),*) nncut
375  IF(ALLOCATED(nxcut)) DEALLOCATE(nxcut)
376  IF(ALLOCATED(nycut)) DEALLOCATE(nycut)
377  ALLOCATE(nxcut(nncut),nycut(nncut),stat=is)
378  IF(is.NE.0) THEN
379  ierr=200
380  WRITE(gridman_unit,*)
381  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
382  w "can not allocate NXCUT, NYCUT"
383  GOTO 1010
384  END IF
385  GOTO 100
386  END IF
387  i=carre_substring(str,'niso')
388  IF(i.GT.0) THEN
389  READ(str(i+1:ls),*) nniso
390  IF(ALLOCATED(nxiso)) DEALLOCATE(nxiso)
391  IF(ALLOCATED(nyiso)) DEALLOCATE(nyiso)
392  ALLOCATE(nxiso(nniso),nyiso(nniso),stat=is)
393  IF(is.NE.0) THEN
394  ierr=200
395  WRITE(gridman_unit,*)
396  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
397  w "can not allocate NXCUT, NYCUT"
398  GOTO 1010
399  END IF
400  GOTO 100
401  END IF
402  i=carre_substring(str,'nxcut')
403  IF(i.GT.0) THEN
404  IF(ALLOCATED(nxcut)) THEN
405  READ(str(i+1:ls),*) nxcut
406  ELSE
407  ierr=-300
408  WRITE(gridman_unit,*)
409  w "WARNING from GRIDMAN_CARRE_READSONNET_ARRAY: ",
410  w "keyword nxcut present but array NXCUT is not allocated"
411  END IF
412  GOTO 100
413  END IF
414  i=carre_substring(str,'nycut')
415  IF(i.GT.0) THEN
416  IF(ALLOCATED(nycut)) THEN
417  READ(str(i+1:ls),*) nycut
418  ELSE
419  ierr=-300
420  WRITE(gridman_unit,*)
421  w "WARNING from GRIDMAN_CARRE_READSONNET_ARRAY: ",
422  w "keyword 'nxcut' present but array NYCUT is not allocated"
423  END IF
424  GOTO 100
425  END IF
426  i=carre_substring(str,'nxiso')
427  IF(i.GT.0) THEN
428  IF(ALLOCATED(nxiso)) THEN
429  READ(str(i+1:ls),*) nxiso
430  ELSE
431  ierr=-300
432  WRITE(gridman_unit,*)
433  w "WARNING from GRIDMAN_CARRE_READSONNET_ARRAY: ",
434  w "keyword 'nxiso' present but array NXISO is not allocated"
435  END IF
436  GOTO 100
437  END IF
438  i=carre_substring(str,'nyiso')
439  IF(i.GT.0) THEN
440  IF(ALLOCATED(nyiso)) THEN
441  READ(str(i+1:ls),*) nyiso
442  ELSE
443  ierr=-300
444  WRITE(gridman_unit,*)
445  w "WARNING from GRIDMAN_CARRE_READSONNET_ARRAY: ",
446  w "keyword 'nyiso' present but array NYISO is not allocated"
447  END IF
448  GOTO 100
449  END IF
450  IF(index(str,'===').GT.0) GOTO 200 !THE HEADER IS FINISHED
451  GOTO 100
452  200 CONTINUE
453 
454 C ALLOCATE MAIN ARRAYS
455  IF(nx.GT.0.AND.ny.GT.0) THEN
456  IF(ALLOCATED(br)) DEALLOCATE(br)
457  IF(ALLOCATED(bz)) DEALLOCATE(bz)
458  IF(ALLOCATED(bc)) DEALLOCATE(bc)
459  IF(ALLOCATED(pit)) DEALLOCATE(pit)
460  ALLOCATE(br(0:nx+1,0:ny+1,4),bz(0:nx+1,0:ny+1,4),
461  a pit(0:nx+1,0:ny+1),bc(0:nx+1,0:ny+1,2),stat=st)
462  IF(st.NE.0) THEN
463  ierr=200
464  WRITE(gridman_unit,*)
465  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
466  w "can not allocate BR, BZ, PIT, BC "
467  WRITE(gridman_unit,*) " NX, NY ",nx,ny
468  GOTO 1010
469  END IF
470  ELSE
471  ierr=300
472  WRITE(gridman_unit,*)
473  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
474  w "wrong dimensions, NX, NY ",nx,ny
475  GOTO 1010
476  END IF
477 
478  IF(gridman_dbg) THEN
479  WRITE(gridman_unit,*) "GRIDMAN_CARRE_READSONNET_ARRAY"
480  WRITE(gridman_unit,*) " RBT ",rbt
481  WRITE(gridman_unit,*) " NX, NY ",nx,ny
482  WRITE(gridman_unit,*) " NCUT, NISO ",nncut,nniso
483  IF(nncut.GT.0) THEN
484  WRITE(gridman_unit,*) " NXCUT ",nxcut
485  WRITE(gridman_unit,*) " NYCUT ",nycut
486  END IF
487  IF(nniso.GT.0) THEN
488  WRITE(gridman_unit,*) " NXCUT ",nxiso
489  WRITE(gridman_unit,*) " NYCUT ",nyiso
490  END IF
491  END IF
492 
493  IF(gridman_dbg) WRITE(gridman_unit,*)
494  w "GRIDMAN_CARRE_READSONNET_ARRAY reading the grid"
495 
496 C READING THE GRID
497  lnopitch=.false.
498  n=0
499  300 READ (30,'(A)',iostat=io,end=400) str
500  IF(io.NE.0) GOTO 1000
501  i=index(str,'Element')
502  IF(i.LT.1) i=index(str,'ELEMENT')
503  IF(i.GT.0) THEN
504  CALL find_numbers(str,1,i1,i2,i3)
505  IF(i1.EQ.0) GOTO 1010
506  READ(str(i1+1:i2-1),*,iostat=io) ix
507  IF(io.NE.0) GOTO 1000
508  READ(str(i2+1:i3-1),*,iostat=io) iy
509  IF(io.NE.0) GOTO 1000
510  i=i3+1
511  CALL find_numbers(str,i,i1,i2,i3)
512  IF(i1.EQ.0) GOTO 1010
513  READ(str(i1+1:i2-1),*,iostat=io) rr(3)
514  IF(io.NE.0) GOTO 1000
515  READ(str(i2+1:i3-1),*,iostat=io) zz(3)
516  IF(io.NE.0) GOTO 1000
517  i=i3+1
518  CALL find_numbers(str,i,i1,i2,i3)
519  IF(i1.EQ.0) GOTO 1010
520  READ(str(i1+1:i2-1),*,iostat=io) rr(2)
521  IF(io.NE.0) GOTO 1000
522  READ(str(i2+1:i3-1),*,iostat=io) zz(2)
523  IF(io.NE.0) GOTO 1000
524  READ (30,'(A)',iostat=io) str
525  IF(io.NE.0) GOTO 1000
526  i1=index(str,'=')
527  i2=index(str,'(')
528  IF(i1.GT.0.AND.i2.GT.i1) THEN
529  READ(str(i1+1:i2-1),*,iostat=io) pitt
530  IF(io.NE.0) GOTO 1000
531  i=i2+1
532  CALL find_numbers(str,i,i1,i2,i3)
533  IF(i1.EQ.0) GOTO 1010
534  READ(str(i1+1:i2-1),*,iostat=io) bcx
535  IF(io.NE.0) GOTO 1000
536  READ(str(i2+1:i3-1),*,iostat=io) bcy
537  IF(io.NE.0) GOTO 1000
538  ELSE
539  pitt=1.0
540  lnopitch=.true.
541  END IF
542  READ (30,'(A)',iostat=io) str
543  IF(io.NE.0) GOTO 1000
544  CALL find_numbers(str,1,i1,i2,i3)
545  IF(i1.EQ.0) GOTO 1010
546  READ(str(i1+1:i2-1),*,iostat=io) rr(4)
547  IF(io.NE.0) GOTO 1000
548  READ(str(i2+1:i3-1),*,iostat=io) zz(4)
549  IF(io.NE.0) GOTO 1000
550  i=i3+1
551  CALL find_numbers(str,i,i1,i2,i3)
552  IF(i1.EQ.0) GOTO 1010
553  READ(str(i1+1:i2-1),*,iostat=io) rr(1)
554  IF(io.NE.0) GOTO 1000
555  READ(str(i2+1:i3-1),*,iostat=io) zz(1)
556  IF(io.NE.0) GOTO 1000
557  IF(ix.GT.-1.AND.ix.LT.nx+2.AND.
558  f iy.GT.-1.AND.iy.LT.ny+2) THEN
559  br(ix,iy,:)=rr
560  bz(ix,iy,:)=zz
561  pit(ix,iy)= pitt
562  bc(ix,iy,1)=bcx
563  bc(ix,iy,2)=bcy
564  ELSE
565  ierr=300
566  WRITE(gridman_unit,*)
567  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
568  w "wrong index, IX, IY, NX, NY ",ix,iy,nx,ny
569  GOTO 1010
570  END IF
571  n=n+1
572  END IF
573  GOTO 300
574  400 CONTINUE
575  CLOSE(30)
576 
577 C CHECKS
578  IF(lnopitch) THEN
579  ierr=-300
580  WRITE(gridman_unit,*)
581  w "WARNING from GRIDMAN_CARRE_READSONNET_ARRAY: ",
582  w "could not read fild ratio, set to 1 "
583  RETURN
584  END IF
585  m=(nx+2)*(ny+2)
586  IF(n.NE.m) THEN
587  ierr=-300
588  WRITE(gridman_unit,*)
589  w "WARNUNG from GRIDMAN_CARRE_READSONNET_ARRAY: ",
590  w "mismatch between expected and actual number of elements"
591  WRITE(gridman_unit,*) "Expected number of elements: ",m
592  WRITE(gridman_unit,*) "Number of elements read: ",n
593  RETURN
594  END IF
595 
596 C ARRAYS ARE NOT LEFT UNALLOCATED IN ORDER NOT TO
597 C CONFUSE COMPILER IN THE SUBSEQUENT CALL OFF GRIDMAN_CARRE2GRID
598  IF(.NOT.ALLOCATED(nxcut)) ALLOCATE(nxcut(1))
599  IF(.NOT.ALLOCATED(nycut)) ALLOCATE(nycut(1))
600  IF(.NOT.ALLOCATED(nxiso)) ALLOCATE(nxiso(1))
601  IF(.NOT.ALLOCATED(nyiso)) ALLOCATE(nyiso(1))
602 
603  IF(gridman_dbg)
604  w WRITE(gridman_unit,*) "GRIDMAN_CARRE_READSONNET_ARRAY finished"
605 
606  RETURN
607 
608  1000 WRITE(gridman_unit,*) "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: "
609  ierr=300
610  1010 WRITE(gridman_unit,*) "Can not read ",fname(1:len_trim(fname))
611  WRITE(gridman_unit,*) " Last line ",trim(str)
612  CLOSE(30)
613  IF(ALLOCATED(nxcut)) DEALLOCATE(nxcut,stat=st)
614  IF(ALLOCATED(nycut)) DEALLOCATE(nycut,stat=st)
615  IF(ALLOCATED(nxiso)) DEALLOCATE(nxiso,stat=st)
616  IF(ALLOCATED(nyiso)) DEALLOCATE(nyiso,stat=st)
617  IF(ALLOCATED(br)) DEALLOCATE(br,stat=st)
618  IF(ALLOCATED(bz)) DEALLOCATE(bz,stat=st)
619  IF(ALLOCATED(pit)) DEALLOCATE(pit,stat=st)
620  nx=0
621  ny=0
622  nncut=0
623  nniso=0
624  RETURN
625 
626  CONTAINS
627 
628 C
629  FUNCTION carre_substring(STR,STR1)
630  INTEGER :: CARRE_SUBSTRING,I2,I
631  CHARACTER(*) :: STR,STR1
632  i=index(str,str1)
633  IF(i.GT.0) THEN
634  i2=index(str,'=')
635  IF(i2.EQ.0) i2=i+len_trim(str1)
636  ELSE
637  i2=0
638  END IF
639  carre_substring=i2
640  END FUNCTION carre_substring
641 
642 C
643  SUBROUTINE find_numbers(STR,I,I1,I2,I3)
644  CHARACTER(*) :: STR
645  INTEGER :: I,I1,I2,I3,L
646  INTRINSIC len_trim
647 
648  l=len_trim(str)
649  i1=index(str(i:l),'(')
650  i2=index(str(i:l),',')
651  i3=index(str(i:l),')')
652  IF(i1.EQ.1.OR.i2.EQ.0.OR.i3.EQ.0.OR.
653  f i2.LT.i1.OR.i3.LT.i2) THEN
654  WRITE(gridman_unit,*)
655  w "ERROR in GRIDMAN_CARRE_READSONNET_ARRAY: ",
656  w "cannot read notation"
657  WRITE(gridman_unit,*) "STR=",trim(str)
658  i1=0
659  END IF
660  i1=i1+i-1
661  i2=i2+i-1
662  i3=i3+i-1
663  END SUBROUTINE find_numbers
664 
665  END SUBROUTINE gridman_carre_readsonnet_array
gridman::gridman_dp
integer, parameter, public gridman_dp
Kind parameter for real numbers.
Definition: gridman.f:93
gridman_carre_read30_array
subroutine gridman_carre_read30_array(FNAME, STITLE, NX, NY, NNCUT, NXCUT, NYCUT, NNISO, NXISO, NYISO, BR, BZ, IERR)
Read B2 (CARRE, SONNET) grid from fort.30, return separate arrays.
Definition: carre.f:54
gridman_carre_readsonnet_array
subroutine gridman_carre_readsonnet_array(FNAME, NX, NY, NNCUT, NXCUT, NYCUT, NNISO, NXISO, NYISO, RBT, BR, BZ, PIT, BC, IERR)
Read carre grid in SONNET format, return separate arrays.
Definition: carre.f:282
gridman
Definition of data types, global constants and variables.
Definition: gridman.f:83
gridman::gridman_sp
integer, parameter, public gridman_sp
Kind parameter for integer numbers.
Definition: gridman.f:95
Generated on Thu Oct 5 2017 09:49:56 for GRIDMAN by   doxygen 1.8.9.1