source: PSPA/madxPSPA/src/madx_ptc_intstate.f90 @ 486

Last change on this file since 486 was 430, checked in by touze, 11 years ago

import madx-5.01.00
File size: 9.3 KB
Line 
1module madx_ptc_intstate_module
2  use madx_keywords
3  implicit none
4  save
5
6  !============================================================================================
7  !  PUBLIC INTERFACE
8
9  public                            :: getintstate
10  public                            :: setintstate
11  public                            :: initintstate
12  public                            :: getmaxaccel
13  public                            :: getdebug
14  public                            :: getenforce6D
15  public                            :: setenforce6D
16  public                            :: ptc_setdebuglevel
17  public                            :: ptc_setaccel_method
18  public                            :: ptc_setexactmis
19  public                            :: ptc_setradiation
20  public                            :: ptc_settotalpath
21  public                            :: ptc_settime
22  public                            :: ptc_setnocavity
23  public                            :: ptc_setfringe
24  public                            :: printintstate
25
26
27
28  private
29  !============================================================================================
30  !  PRIVATE
31  !    data structures
32
33  logical(lp),            public   :: maxaccel  ! switch saying to make the reference particle to fly always on the crest
34  logical(lp),            public   :: enforce6D = .false. ! normally 6D is reduced to 4D if no cavities are present
35  ! this switch prevents it. It is needed to calcualte  fg R56 in a chicane
36  type (internal_state),  private  :: intstate = default0
37  integer,                private  :: debug = 1    ! defines debug level
38
39  !    routines
40
41  !--none--!
42
43  !============================================================================================
44
45contains
46
47  logical(lp) function getmaxaccel()
48    implicit none
49    getmaxaccel = maxaccel
50    return
51  end function getmaxaccel
52  !____________________________________________________________________________________________
53
54  type (internal_state) function getintstate()
55    implicit none
56    !returns the internal state
57    getintstate = intstate
58    return
59  end function getintstate
60  !____________________________________________________________________________________________
61
62  subroutine setintstate(state)
63    implicit none
64    type (internal_state)  :: state
65    !sets the internal state
66    !if (getdebug() > 1)
67    intstate = state
68    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
69  end subroutine setintstate
70
71  !____________________________________________________________________________________________
72
73  integer function getdebug()
74    implicit none
75    getdebug = debug
76  end function getdebug
77  !____________________________________________________________________________________________
78
79  subroutine initintstate(intst)
80    implicit none
81    type (internal_state) :: intst
82
83    !if (getdebug() > 1)
84    print *, "Initializing internal state"
85
86    intstate = intst - nocavity0
87    call update_states
88
89    if ( associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
90  end subroutine initintstate
91  !____________________________________________________________________________________________
92
93  subroutine ptc_resetinternalstate
94    implicit none
95
96    if (getdebug() > 1) then
97        print *, "Setting internal state to DEFAULT0"
98    end if
99
100    intstate = default0
101    default = intstate
102    call update_states
103
104    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
105
106  end subroutine ptc_resetinternalstate
107  !____________________________________________________________________________________________
108
109
110  subroutine ptc_setdebuglevel(level)
111    implicit none
112    integer     :: level
113
114    if (level > 0) then
115        print *, "Setting debug level to", level
116    end if
117    debug = level
118
119  end subroutine ptc_setdebuglevel
120  !____________________________________________________________________________________________
121
122  subroutine setenforce6D(flag)
123    implicit none
124    integer     :: flag
125    if (flag == 0) then
126       if (getdebug() > 1) then
127           print *, "Switching off ENFORCE6D"
128       end if
129       enforce6D = .false.
130    else
131       if (getdebug() > 1) then
132           print *, "Setting ENFORCE6D"
133       end if
134       enforce6D = .true.
135    endif
136
137  end subroutine setenforce6D
138  !____________________________________________________________________________________________
139
140  logical(lp) function getenforce6D()
141    implicit none
142
143    getenforce6D = enforce6D
144    print *, getenforce6D
145
146  end function getenforce6D
147
148  !____________________________________________________________________________________________
149
150  subroutine ptc_setaccel_method(flag)
151    implicit none
152    integer     :: flag
153
154    if (flag == 1) then
155       if (getdebug() > 1) then
156           print *, "Setting MAX ACCEL"
157       end if
158       maxaccel = .true.
159    endif
160
161  end subroutine ptc_setaccel_method
162  !____________________________________________________________________________________________
163
164
165   subroutine ptc_setexactmis(flag)
166    implicit none
167    integer    :: flag
168    !    print *, "Setting the flag"
169    !    print *, "And the flag is", flag
170    if (flag == 1) then
171       if (getdebug() > 1) then
172           print *, "Switching ON exact missaligment"
173       end if
174       always_exactmis=.true.
175     !  intstate = intstate + EXACTMIS0
176    else
177       if (getdebug() > 1) then
178           print *, "Switching OFF exact missaligment"
179       end if
180     !  intstate = intstate - EXACTMIS0
181       always_exactmis=.false.
182    endif
183    default = intstate
184    call update_states
185    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
186  end subroutine ptc_setexactmis
187  !____________________________________________________________________________________________
188
189  subroutine ptc_setradiation(flag)
190    implicit none
191    integer    :: flag
192
193
194    if (flag == 1) then
195       if (getdebug() > 1) then
196           print *, "Switching ON radiation"
197       end if
198       intstate = intstate + radiation0
199    else
200       if (getdebug() > 1) then
201           print *, "Switching OFF radiation"
202       end if
203       intstate = intstate - radiation0
204    endif
205    default = intstate
206    call update_states
207    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
208  end subroutine ptc_setradiation
209  !____________________________________________________________________________________________
210
211  subroutine ptc_setfringe(flag)
212    implicit none
213    integer    :: flag
214
215    if (flag == 1) then
216       if (getdebug() > 1) then
217           print *, "Switching ON fringe"
218       end if
219       intstate = intstate + fringe0
220    else
221       if (getdebug() > 1) then
222           print *, "Switching OFF fringe"
223       end if
224       intstate = intstate - fringe0
225    endif
226
227    default = intstate
228    call update_states
229    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
230  end subroutine ptc_setfringe
231  !____________________________________________________________________________________________
232
233  subroutine ptc_settotalpath(flag)
234    implicit none
235    integer    :: flag
236
237    if (flag == 1) then
238       if (getdebug() > 1) then
239           print *, "Switching ON totalpath (and switching OFF delta and only_4d)"
240       end if
241       intstate = intstate - delta0 - only_4d0 + totalpath0
242    else
243       if (getdebug() > 1) then
244           print *, "Switching OFF totalpath"
245       end if
246       intstate = intstate - totalpath0
247    endif
248
249    default = intstate
250    call update_states
251    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
252
253  end subroutine ptc_settotalpath
254  !____________________________________________________________________________________________
255
256
257  subroutine ptc_settime(flag)
258    implicit none
259    integer    :: flag
260
261    !    print *, "Setting the flag"
262    !    print *, "And the flag is", flag
263
264    if (flag == 1) then
265       if (getdebug() > 1) then
266           print *, "Switching ON time"
267       end if
268       intstate = intstate + time0
269    else
270       if (getdebug() > 1) then
271           print *, "Switching OFF time"
272       end if
273       intstate = intstate - time0
274    endif
275
276    default = intstate
277    call update_states
278    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
279
280  end subroutine ptc_settime
281
282  !____________________________________________________________________________________________
283
284  subroutine ptc_setnocavity(flag)
285    implicit none
286    integer    :: flag
287
288    if (flag == 1) then
289       if (getdebug() > 1) then
290           print *, "Switching ON nocavity"
291       end if
292       intstate = intstate + nocavity0
293    else
294       if (getdebug() > 1) then
295           print *, "Switching OFF nocavity and (also) delta and only_4d"
296       end if
297       intstate = intstate  - delta0 - only_4d0 - nocavity0
298    endif
299
300    default = intstate
301    call update_states
302    if (associated(c_%no) .and. getdebug() > 1) call print(intstate,6)
303  end subroutine ptc_setnocavity
304
305
306  !____________________________________________________________________________________________
307
308  subroutine printintstate(n)
309    implicit none
310    integer               :: n
311    if (associated(c_%no) ) then
312      call print(intstate,n)
313    else
314      write(n,*) 'printintstate: Can not print, PTC is not initialized yet'
315    endif
316  end subroutine printintstate
317  !____________________________________________________________________________________________
318
319end module madx_ptc_intstate_module
Note: See TracBrowser for help on using the repository browser.