V3FIT
allocate_boozer.f
1  SUBROUTINE allocate_boozer (iread)
2  USE booz_params
3  USE booz_persistent
4  IMPLICIT NONE
5 C-----------------------------------------------
6 C L o c a l V a r i a b l e s
7 C-----------------------------------------------
8  INTEGER :: i, jrad, istat1=0, istat2=0, istat3=0, iread, index
9  CHARACTER(LEN=1000) :: temp
10  CHARACTER(LEN=10) :: scanset='0123456789'
11 c-----------------------------------------------
12  IF (.not.ALLOCATED(jlist)) ALLOCATE (jlist(ns), lsurf_boz(ns),
13  1 stat=istat1)
14  IF (istat1 .ne. 0) stop 'Unable to allocate jlist/lsurf_boz'
15 
16 !
17 ! Read in (and parse) list of radial surfaces to compute
18 ! Surfaces SHOULD ALL be on a single line, but IFORT doesn't write it out that way
19 ! so the loop below will correctly read multiple lines from the in_booz file
20 !
21  jlist = 0
22  i = 1
23  READ (iread, '(a)', iostat=istat1) temp
24  IF (istat1 .eq. 0) THEN
25  DO WHILE (istat1 .eq. 0)
26  DO jrad = i, ns
27  index = scan(temp,scanset)
28  IF (index < 1) EXIT
29  temp = temp(index:)
30  READ(temp, *) jlist(jrad)
31  IF (jlist(jrad) < 10) THEN
32  temp = temp(3:)
33  ELSE IF (jlist(jrad) < 100) THEN
34  temp = temp(4:)
35  ELSE
36  temp = temp(5:)
37  END IF
38  END DO
39  READ (iread, '(a)', iostat=istat1) temp
40  i = jrad
41  END DO
42 
43  lsurf_boz = .false.
44  DO jrad = 1, ns
45  i = jlist(jrad)
46  IF (i.gt.1 .and. i.le.ns) lsurf_boz(i) = .true.
47  END DO
48 
49  ELSE IF (istat1 .ne. 0) THEN
50  WRITE(6, '(a,/,a,i4)')
51  1 ' No jlist data was found in Boozer input file.',
52  1 ' Will assume that all surfaces are needed.',
53  1 ' Iostat: ', istat1
54  lsurf_boz = .true.
55  lsurf_boz(1) = .false.
56 
57  END IF
58 
59  jsize = count(lsurf_boz(1:ns))
60 !
61 ! Recompute jlist, just in case user used unordered (or repeated) indices
62 !
63  DEALLOCATE (jlist)
64  ALLOCATE (jlist(jsize), stat=istat1)
65  IF (istat1 .ne. 0) stop 'Unable to allocate jlist'
66 
67  i = 1
68  DO jrad = 2, ns
69  IF (lsurf_boz(jrad)) THEN
70  jlist(i) = jrad
71  i = i+1
72  END IF
73  END DO
74 
75  IF (.not.ALLOCATED(bsubumnc)) ALLOCATE(
76  1 bsubumnc(mnmax_nyq,ns), bsubvmnc(mnmax_nyq,ns),
77  1 bmodmnc(mnmax_nyq,ns),
78  2 rmnc(mnmax,ns), zmns(mnmax,ns), lmns(mnmax,ns),
79  3 xm(mnmax), xn(mnmax),
80  3 xm_nyq(mnmax_nyq), xn_nyq(mnmax_nyq),
81  4 hiota(ns), phip(ns), gpsi(ns), ipsi(ns), pmns(mnmax_nyq),
82  5 beta_vol(ns), pres(ns), phi(ns), buco(ns), bvco(ns),
83  5 rmncb(mnboz,jsize), zmnsb(mnboz,jsize), pmnsb(mnboz,jsize),
84  6 gmncb(mnboz,jsize), bmncb(mnboz,jsize),
85  7 bmod_b(nv_boz,nu_boz), chip(ns), chi(ns), stat=istat1 )
86 ! CRCook allocated chi (poloidal flux)
87 
88  IF (.not.ALLOCATED(sfull)) ALLOCATE(
89  1 sfull(ns), scl(mnboz), xmb(mnboz), xnb(mnboz), stat=istat2)
90 
91  IF (.not.ALLOCATED(bsubumns)) ALLOCATE(
92 ! IF (lasym_b .AND. .not.ALLOCATED(bsubumns)) ALLOCATE(
93  1 bsubumns(mnmax_nyq,ns), bsubvmns(mnmax_nyq,ns),
94  1 bmodmns(mnmax_nyq,ns),
95  1 rmns(mnmax,ns), zmnc(mnmax,ns), lmnc(mnmax,ns),
96  4 pmnc(mnmax_nyq),
97  5 rmnsb(mnboz,jsize), zmncb(mnboz,jsize), pmncb(mnboz,jsize),
98  6 gmnsb(mnboz,jsize), bmnsb(mnboz,jsize),
99  1 stat=istat3)
100 
101  IF (istat1.ne.0 .or. istat2.ne.0 .or. istat3.ne.0) THEN
102  print *,' problem allocating boozer memory'
103  print *,' istat1 = ',istat1,' istat2 = ',istat2,
104  1 ' istat3 = ',istat3
105  stop
106  ENDIF
107 
108  END SUBROUTINE allocate_boozer