source: PSPA/madxPSPA/libs/ptc/src/Sf_def_all_kinds.f90 @ 430

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

import madx-5.01.00
File size: 16.5 KB
Line 
1!The Polymorphic Tracking Code
2!Copyright (C) Etienne Forest and CERN
3
4module S_def_all_kinds
5  use S_status
6  implicit none
7  public
8  private XMIDR,GMIDR,ALLOC_FIBRE
9  include "a_def_worm.inc"
10  !  include "a_def_all_kind.inc"
11  !  include "a_def_sagan.inc"
12  !  include "a_def_user1.inc"
13  !!  include "a_def_arbitrary.inc"
14  !  include "a_def_user2.inc"
15  !  include "a_def_element_fibre_layout.inc"
16  private ALLOC_midr,KILL_midr
17
18
19  INTERFACE XMID
20     MODULE PROCEDURE XMIDR
21  END  INTERFACE
22
23  INTERFACE GMID
24     MODULE PROCEDURE GMIDR
25  END  INTERFACE
26
27  INTERFACE ALLOC
28     MODULE PROCEDURE ALLOC_midr
29     MODULE PROCEDURE ALLOC_FIBRE
30  END  INTERFACE
31
32  INTERFACE KILL
33     MODULE PROCEDURE KILL_midr
34  END  INTERFACE
35
36
37contains
38
39  !  RECURSIVE
40  SUBROUTINE GET_LENGTH(R,L)
41    IMPLICIT NONE
42    TYPE(LAYOUT),target, INTENT(IN) :: R
43    REAL(DP), INTENT(OUT) :: L
44    TYPE(FIBRE), POINTER:: P
45
46    INTEGER I
47    P=>R%START
48    L=0.0_dp
49    DO I=1,R%N
50       IF(P%MAG%KIND/=KIND23) THEN
51          L=L+P%MAG%P%LD
52          !       ELSE
53          !          CALL GET_LENGTH(P%MAG%G23,LG)
54          !          L=L+LG
55       ENDIF
56       P=>P%NEXT
57    ENDDO
58  END SUBROUTINE GET_LENGTH
59
60  SUBROUTINE XFRAME(E_IN,ENT,A,I)
61    IMPLICIT NONE
62    TYPE(INNER_FRAME), INTENT(INOUT):: E_IN
63    REAL(DP),optional, INTENT(IN):: ENT(3,3),A(3)
64    INTEGER, INTENT(IN):: i
65    INTEGER J,K
66
67    IF(I<=SIZE(E_IN%ORIGIN,2)) THEN
68       DO J=1,3
69          ! write(6,*) i,SIZE(E_IN%ORIGIN,1),SIZE(E_IN%ORIGIN,2)
70          ! write(6,*) LBOUND(E_IN%ORIGIN,DIM=1),uBOUND(E_IN%ORIGIN,DIM=1),LBOUND(E_IN%ORIGIN,DIM=2),uBOUND(E_IN%ORIGIN,DIM=2)
71          if(PRESENT(A)) E_IN%ORIGIN(J,I)=A(J)
72          DO K=1,3
73             if(PRESENT(ENT)) E_IN%FRAME(J,K,I)=ENT(J,K)
74          ENDDO
75       ENDDO
76    ELSE
77       WRITE(6,*) I
78    ENDIF
79  END SUBROUTINE XFRAME
80
81
82  SUBROUTINE G_FRAME(E_IN,ENT,A,I)
83    IMPLICIT NONE
84    TYPE(INNER_FRAME), INTENT(IN):: E_IN
85    REAL(DP), INTENT(INOUT):: ENT(3,3),A(3)
86    INTEGER, INTENT(IN):: i
87    INTEGER J,K
88
89    IF(I<=SIZE(E_IN%ORIGIN,2)) THEN
90       DO J=1,3
91          A(J)=E_IN%ORIGIN(J,I)
92          DO K=1,3
93             ENT(J,K)=E_IN%FRAME(J,K,I)
94          ENDDO
95       ENDDO
96    ELSE
97       WRITE(6,*) "ERROR IN GFRAME "
98       WRITE(6,*) I,SIZE(E_IN%ORIGIN,2)
99       STOP 345
100    ENDIF
101  END SUBROUTINE G_FRAME
102
103  SUBROUTINE XMIDR(X_IN,X,I)
104    IMPLICIT NONE
105    TYPE(worm), INTENT(INOUT):: X_IN
106    REAL(DP), INTENT(IN) :: X(6)
107    INTEGER, INTENT(IN):: i
108    INTEGER J
109
110    X_IN%nst=i
111    IF(I<=SIZE(X_IN%RAY,2)) THEN
112       DO J=1,6
113          X_IN%RAY(J,I)=X(J)
114       ENDDO
115    ELSE
116       WRITE(6,*) I
117       STOP 8
118    ENDIF
119  END SUBROUTINE XMIDR
120
121
122
123  SUBROUTINE gMIDR(X_IN,X,I)
124    IMPLICIT NONE
125    TYPE(worm), INTENT(IN):: X_IN
126    REAL(DP), INTENT(INOUT) :: X(6)
127    INTEGER, INTENT(IN):: i
128    INTEGER J
129
130    IF(I<=SIZE(X_IN%RAY,2)) THEN
131       DO J=1,6
132          X(J)=  X_IN%RAY(J,I)
133       ENDDO
134    ELSE
135       WRITE(6,*) I
136       STOP 10
137    ENDIF
138  END SUBROUTINE gMIDR
139
140
141
142  SUBROUTINE ALLOC_midr(X_IN,R)
143    IMPLICIT NONE
144    TYPE(worm), INTENT(INOUT):: X_IN
145    TYPE(LAYOUT), INTENT(IN):: R
146    INTEGER I
147    TYPE(FIBRE), POINTER:: P
148
149    P=>R%START
150    allocate(x_in%nst)
151    X_IN%NST=3
152    DO I=1,R%N
153       X_IN%nst= MAX(P%MAG%p%NST,X_IN%NST)
154       P=>P%NEXT
155    ENDDO
156
157    allocate(x_in%RAY(6,-6:X_IN%nst+6))
158    allocate(x_in%E)
159    allocate(x_in%E%L(-1:X_IN%nst))
160    allocate(x_in%POS(4))
161
162    allocate(x_in%E%FRAME(3,3,-7:X_IN%nst+6))
163    allocate(x_in%E%ORIGIN(3,-7:X_IN%nst+6))
164    ALLOCATE(x_in%E%DO_SURVEY)
165    x_in%E%DO_SURVEY=.TRUE.
166    x_in%nst=0
167    x_in%POS=0
168    x_in%RAY=0.0_dp
169    x_in%E%L=0.0_dp
170    x_in%E%FRAME=0.0_dp
171    x_in%E%ORIGIN=0.0_dp
172    x_in%e%nst=>x_in%nst
173
174  END SUBROUTINE ALLOC_midr
175
176  SUBROUTINE ALLOC_FIBRE(X_IN,P)
177    IMPLICIT NONE
178    TYPE(worm), INTENT(INOUT):: X_IN
179    TYPE(FIBRE),TARGET, INTENT(INOUT):: P
180
181    allocate(x_in%nst)
182    X_IN%NST=3
183    X_IN%nst= MAX(P%MAG%p%NST,X_IN%NST)
184
185
186    allocate(x_in%RAY(6,-6:X_IN%nst+6))
187    allocate(x_in%E)
188    allocate(x_in%E%L(-1:X_IN%nst))
189    allocate(x_in%POS(4))
190
191    allocate(x_in%E%FRAME(3,3,-7:X_IN%nst+6))
192    allocate(x_in%E%ORIGIN(3,-7:X_IN%nst+6))
193    ALLOCATE(x_in%E%DO_SURVEY)
194    x_in%E%DO_SURVEY=.TRUE.
195    x_in%nst=0
196    x_in%POS=0
197    x_in%RAY=0.0_dp
198    x_in%E%L=0.0_dp
199    x_in%E%FRAME=0.0_dp
200    x_in%E%ORIGIN=0.0_dp
201    x_in%e%nst=>x_in%nst
202
203  END SUBROUTINE ALLOC_FIBRE
204
205  SUBROUTINE KILL_midr(X_IN)
206    IMPLICIT NONE
207    TYPE(worm), INTENT(INOUT):: X_IN
208
209    DEallocate(x_in%nst)
210
211    DEallocate(x_in%RAY)
212    DEallocate(x_in%POS)
213
214    DEallocate(x_in%E%FRAME)
215    DEallocate(x_in%E%ORIGIN)
216    DEallocate(x_in%E%L)
217    DEallocate(x_in%E%DO_SURVEY)
218    DEallocate(x_in%E)
219
220  END SUBROUTINE KILL_midr
221
222
223  SUBROUTINE SURVEY_CHART(C,P,DIR,MAGNETFRAME,E_IN)
224    !changed
225    ! SURVEYS A SINGLE ELEMENT FILLS IN CHART AND MAGNET_CHART; LOCATES ORIGIN AT THE ENTRANCE OR EXIT
226    IMPLICIT NONE
227    TYPE(CHART), TARGET ,OPTIONAL, INTENT(INOUT):: C
228    TYPE(MAGNET_CHART), TARGET,INTENT(INOUT) :: P
229    TYPE (CHART), POINTER :: CL
230    TYPE(MAGNET_FRAME), TARGET, OPTIONAL :: MAGNETFRAME
231    TYPE(INNER_FRAME), OPTIONAL :: E_IN
232    INTEGER, INTENT(IN) ::DIR
233    TYPE(MAGNET_FRAME), POINTER :: F
234    REAL(DP) ENT(3,3),EXI(3,3),HA,D(3),BASIS(3,3),OMEGA(3),A(3),N(3)
235    INTEGER I,J
236    CALL ALLOC(F)
237
238
239    CL=> C  ! CHART OF ELEMENT 1
240
241    HA=DIR*P%LD*P%B0/2.0_dp
242    D=0.0_dp
243    D(3)=DIR*P%LC/2.0_dp
244    IF(ASSOCIATED(CL%F)) THEN     !!!! DOING SURVEY
245       IF(DIR==1) THEN
246          A=0.0_dp;A(3)=P%TILTD  ;
247          CALL GEO_ROT(CL%F%ENT,ENT      ,A  ,CL%F%ENT)
248          IF(PRESENT(E_IN) ) THEN
249
250             CALL XFRAME(E_IN,ENT,CL%F%A,-2)
251             !          WRITE(6,*) "E_IN%NST ",E_IN%NST
252             !          WRITE(6,*) ENT
253             !          WRITE(6,*) E_IN%FRAME(:,:,-2)
254
255             !         PAUSE 123
256          ENDIF
257          A=0.0_dp;A(2)=HA ;
258          CALL GEO_ROT(ENT     ,CL%F%MID ,A     ,ENT)
259          CALL GEO_ROT(CL%F%MID,EXI     , A     ,CL%F%MID)
260
261          IF(PRESENT(E_IN) ) CALL XFRAME(E_IN,ENT=EXI,I=E_IN%nst-4)
262          A=0.0_dp;A(3)=-P%TILTD  ;
263          CALL GEO_ROT(EXI     ,CL%F%EXI ,A,EXI)
264
265          CL%F%O=CL%F%A
266          CALL GEO_TRA(CL%F%O,CL%F%MID,D,1)
267          CL%F%B=CL%F%O
268          CALL GEO_TRA(CL%F%B,CL%F%MID,D,1)
269
270          IF(PRESENT(E_IN) ) CALL XFRAME(E_IN,A=CL%F%B,I=E_IN%nst-4)
271
272       ELSE
273          A=0.0_dp;A(3)=P%TILTD  ;
274          CALL GEO_ROT(CL%F%EXI,EXI      ,A  ,CL%F%EXI)
275          IF(PRESENT(E_IN) ) CALL XFRAME(E_IN,EXI,CL%F%B,-2)
276          A=0.0_dp;A(2)=HA ;
277          CALL GEO_ROT(EXI     ,CL%F%MID ,A     ,EXI)
278          CALL GEO_ROT(CL%F%MID,ENT     , A     ,CL%F%MID)
279
280          IF(PRESENT(E_IN) ) CALL XFRAME(E_IN,ENT=ENT,I=E_IN%nst-4)
281          A=0.0_dp;A(3)=-P%TILTD  ;
282          CALL GEO_ROT(ENT     ,CL%F%ENT ,A ,ENT)
283
284          CL%F%O=CL%F%B
285          CALL GEO_TRA(CL%F%O,CL%F%MID,D,1)
286          CL%F%A=CL%F%O
287          CALL GEO_TRA(CL%F%A,CL%F%MID,D,1)
288
289          IF(PRESENT(E_IN) ) CALL XFRAME(E_IN,A=CL%F%A,I=E_IN%nst-4)
290
291
292
293       ENDIF
294
295       !  CAN BE THE SAME FOR DIR =1 OR DIR= -1
296       F=CL%F
297
298       F%ENT=ENT
299       F%EXI=EXI
300       BASIS=F%ENT
301       OMEGA=F%A
302       IF(PRESENT(MAGNETFRAME) )THEN
303          MAGNETFRAME=F
304       ENDIF
305
306       !          DO I=1,3
307       !          A=ZERO
308       !          A(I)=C%ANG_IN(I)
309
310       A=C%ANG_IN
311       call ROTATE_FRAME(f,OMEGA,a,1,BASIS)
312
313       !       D=F%A-OMEGA
314       !       CALL GEO_ROT(F%ENT,D,A,1,BASIS)
315       !       F%A=OMEGA+D
316
317       !       D=F%O-OMEGA
318       !       CALL GEO_ROT(F%MID,D,A,1,BASIS)
319       !       F%O=OMEGA+D
320
321       !       D=F%B-OMEGA
322       !       CALL GEO_ROT(F%EXI,D,A,1,BASIS)
323       !       F%B=OMEGA+D
324
325       BASIS=F%ENT
326
327       !          ENDDO
328
329       CALL GEO_TRA(F%A,BASIS,C%D_IN,1)
330       CALL GEO_TRA(F%B,BASIS,C%D_IN,1)
331       CALL GEO_TRA(F%O,BASIS,C%D_IN,1)
332
333       IF(PRESENT(E_IN) ) THEN
334          IF(DIR==1) THEN
335             CALL XFRAME(E_IN,F%ENT,F%A,-1)
336             CALL XFRAME(E_IN,F%EXI,F%B,E_IN%nst-5)
337          ELSE
338             CALL XFRAME(E_IN,F%EXI,F%B,-1)
339             CALL XFRAME(E_IN,F%ENT,F%A,E_IN%nst-5)
340          ENDIF
341
342          call SURVEY_inner_mag(E_IN)
343       ENDIF
344
345
346       ! CHECKING HERE THE CONSISTANCY
347       ENT=F%EXI
348       BASIS=F%EXI
349       A=C%ANG_OUT
350       OMEGA=F%B
351       D=F%B-OMEGA   ! D=0 OF COURSE
352       CALL GEO_ROT(ENT,D,A,1,BASIS)
353       OMEGA=OMEGA+D
354
355       CALL GEO_TRA(OMEGA,ENT,C%D_OUT,1)
356       ENT=ENT-EXI
357       OMEGA=OMEGA-CL%F%B
358       N=0.0_dp
359       DO I=1,3
360          N(2)=ABS(OMEGA(I))+N(2)
361          DO J=1,3
362             N(1)=ABS(ENT(I,J))+N(1)
363          ENDDO
364       ENDDO
365
366       !       IF(N(2)<EPS_FITTED) N(2)=N(2)/( ABS(CL%F%B(1))+ABS(CL%F%B(2))+ABS(CL%F%B(3)) )
367
368       IF(N(1)>EPS_FITTED.OR.N(2)>EPS_FITTED) THEN
369          WRITE(6,*) "INCONSISTANCY IN SURVEY_CHART "
370          WRITE(6,*) N(1),N(2)
371       ENDIF
372       !
373
374
375       IF(ASSOCIATED(P%F)) THEN
376          P%F=F
377       ENDIF
378
379
380
381    ENDIF  !!!! DOING SURVEY
382
383
384    CALL KILL(F)
385    IF(ASSOCIATED(F)) deallocate(f)
386
387  END SUBROUTINE SURVEY_CHART
388
389  SUBROUTINE SURVEY_INNER_MAG(e_in) !  Tracks the chart through a magnet
390    IMPLICIT NONE
391    TYPE(INNER_FRAME), INTENT(INOUT):: e_in
392    REAL(DP) ENT(3,3),A(3),MID(3,3),O(3),D(3)
393    LOGICAL(LP) DONE
394    INTEGER NST,I,start
395    REAL(DP) LH,HA,ANG(3),ANGH,RHO
396    TYPE(MAGNET_CHART), POINTER :: P
397
398    NST=E_IN%NST-6
399    DONE=.FALSE.
400    start=nst*(1-(1+E_IN%F%dir)/2)
401
402
403    P=>E_IN%F%MAG%P
404    !E_IN%L
405
406    IF(E_IN%DO_SURVEY) THEN   !  DOING THE SURVEY
407
408       !     CALL GFRAME(E_IN,ENT,A,-1)
409       IF(ASSOCIATED(E_IN%F%CHART)) THEN
410          IF(ASSOCIATED(E_IN%F%CHART%F)) THEN
411             MID=E_IN%F%CHART%F%MID
412             O=E_IN%F%CHART%F%O
413             DONE=.TRUE.
414          ENDIF
415       ENDIF
416
417       IF(ASSOCIATED(E_IN%F%MAG%P%F)) THEN
418          MID= P%F%MID
419          O  = P%F%O
420          DONE=.TRUE.
421       ENDIF
422
423       IF(.NOT.DONE) THEN
424          WRITE(6,*) "ERROR IN SURVEY_INNER_MAG, NO FRAME WHATSOEVER "
425          STOP 330
426       ENDIF
427
428       SELECT CASE(E_IN%F%MAG%KIND)
429
430          !       CASE(KIND0)
431          !          CALL XFRAME(E_IN,MID,O,0)
432          !          E_IN%L(0)=zero +E_IN%L(-1)
433          !          IF(NST/=0) THEN
434          !             WRITE(6,*) "ERROR IN SURVEY_INNER_MAG at kind23"
435          !             STOP 330
436          !          ENDIF
437
438          !       CASE(kind23)                 ! kind 23 layout
439          !          call  GET_LENGTH(E_IN%F%mag%g23,Lh)
440          !
441          !          E_IN%L(start)=start*lh/nst  +E_IN%L(-1)
442          !
443          !          if(E_IN%F%dir==1) then
444          !             CALL XFRAME(E_IN,P%F%ent,P%F%a,start)
445          !          else
446          !             CALL XFRAME(E_IN,P%F%exi,P%F%b,start)
447          !          endif
448          !
449          !          start=start+E_IN%F%dir
450          !
451          !          E_IN%L(start)=start*lh/nst  +E_IN%L(-1)
452          !
453          !          if(E_IN%F%dir==1) then
454          !             CALL XFRAME(E_IN,P%F%exi,P%F%b,start)
455          !          else
456          !             CALL XFRAME(E_IN,P%F%ent,P%F%a,start)
457          !          endif
458
459          !          IF(NST/=1) THEN
460          !             WRITE(6,*) "ERROR IN SURVEY_INNER_MAG "
461          !             STOP 331
462          !          ENDIF
463       CASE(KIND0,KIND1,KIND3:KIND5,KIND8:KIND9,KIND11:KIND15,KIND17:KIND22,kindwiggler)
464          LH=P%LC/2.0_dp
465          A=O
466          D=0.0_dp;D(3)=-LH
467          CALL GEO_TRA(A,MID,D,1)
468          CALL XFRAME(E_IN,MID,A,start)
469
470          HA=P%LC/NST
471          E_IN%L(start)=start*P%LD/nst  +E_IN%L(-1)
472          D=0.0_dp;D(3)=HA
473          DO I=1,NST
474             start=start+E_IN%F%dir
475             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
476             CALL GEO_TRA(A,MID,D,1)
477             CALL XFRAME(E_IN,MID,A,start)
478          ENDDO
479       CASE(KIND2,KIND6:KIND7,KIND10,KINDPA)
480          IF(P%B0==0.0_dp) THEN
481             LH=P%LC/2.0_dp
482             A=O
483             D=0.0_dp;D(3)=-LH
484             CALL GEO_TRA(A,MID,D,1)
485             CALL XFRAME(E_IN,MID,A,start)
486             HA=P%LC/NST
487             D=0.0_dp;D(3)=HA
488             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
489             DO I=1,NST
490                start=start+E_IN%F%dir
491                E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
492                CALL GEO_TRA(A,MID,D,1)
493                CALL XFRAME(E_IN,MID,A,start)
494             ENDDO
495          ELSE
496             RHO=1.0_dp/P%B0
497             ANG=0.0_dp; D=0.0_dp;
498             LH=P%LC/2.0_dp
499             A=O
500             D(3)=-LH
501             ANGH=P%LD*P%B0/2.0_dp
502             ANG(2)=-ANGH
503             CALL GEO_TRA(A,MID,D,1)
504             O=A
505             CALL GEO_ROT(MID,ENT      ,ANG  ,MID)
506             CALL XFRAME(E_IN,ENT,A,start)
507             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
508
509             ANG(2)=2.0_dp*ANGH/NST
510             DO I=1,NST
511                start=start+E_IN%F%dir
512                E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
513                HA=ANGH-I*ANG(2)
514                CALL GEO_ROT(ENT,ENT      ,ANG  ,MID)
515                D=0.0_dp
516                D(1)=RHO*(COS(ha)-COS(ANGH))
517                D(3)=P%LC/2.0_dp-sin(ha)*rho
518                A=O
519                CALL GEO_TRA(A,MID,D,1)
520                CALL XFRAME(E_IN,ENT,A,start)
521             ENDDO
522
523          ENDIF
524
525       CASE(KIND16)
526          ANGH=P%LD*P%B0/2.0_dp
527          LH=P%LC/2.0_dp
528          A=O
529          D=0.0_dp;D(3)=-LH
530          CALL GEO_TRA(A,MID,D,1)
531          ANG=0.0_dp;ANG(2)=-(ANGH-P%EDGE(1))
532          CALL GEO_ROT(MID,MID      ,ANG  ,MID)
533
534          CALL XFRAME(E_IN,MID,A,start)
535          HA=E_IN%F%MAG%L/NST
536          E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
537          D=0.0_dp;D(3)=HA
538          DO I=1,NST
539             start=start+E_IN%F%dir
540             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
541             CALL GEO_TRA(A,MID,D,1)
542             CALL XFRAME(E_IN,MID,A,start)
543          ENDDO
544
545
546       CASE DEFAULT
547
548
549
550          Write(6,*)"KIND = ",  E_IN%F%MAG%KIND," NOT SUPPORTED IN SURVEY_INNER_MAG "
551          STOP 778
552
553       END  SELECT
554
555
556
557    ELSE    ! NOT  DOING THE SURVEY
558
559
560
561
562       SELECT CASE(E_IN%F%MAG%KIND)
563
564          !       CASE(KIND0)
565          !          E_IN%L(0)=zero +E_IN%L(-1)
566          !          IF(NST/=0) THEN
567          !             WRITE(6,*) "ERROR IN SURVEY_INNER_MAG "
568          !             STOP 330
569          !          ENDIF
570       CASE(KIND0,KIND1,KIND3:KIND5,KIND8:KIND9,KIND11:KIND15,KIND17:KIND22,kindwiggler)
571          E_IN%L(start)=start*P%LD/nst  +E_IN%L(-1)
572          DO I=1,NST
573             start=start+E_IN%F%dir
574             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
575          ENDDO
576       CASE(KIND2,KIND6:KIND7,KIND10,KINDPA)
577          IF(P%B0==0.0_dp) THEN
578             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
579             DO I=1,NST
580                start=start+E_IN%F%dir
581                E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
582             ENDDO
583          ELSE
584             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
585
586             DO I=1,NST
587                start=start+E_IN%F%dir
588                E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
589             ENDDO
590
591          ENDIF
592
593       CASE(KIND16)
594          E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
595          DO I=1,NST
596             start=start+E_IN%F%dir
597             E_IN%L(start)=start*P%LD/nst    +E_IN%L(-1)
598          ENDDO
599
600          !       CASE(kind23)                 ! kind 23 layout
601          !          call  GET_LENGTH(E_IN%F%mag%g23,Lh)
602          !
603          !          E_IN%L(start)=start*lh/nst  +E_IN%L(-1)
604          !
605          !
606          !          start=start+E_IN%F%dir
607          !
608          !          E_IN%L(start)=start*lh/nst  +E_IN%L(-1)
609
610          !          IF(NST/=1) THEN
611          !             WRITE(6,*) "ERROR IN SURVEY_INNER_MAG "
612          !             STOP 331
613          !          ENDIF
614          !
615       CASE DEFAULT
616
617
618
619          Write(6,*)"KIND = ",  E_IN%F%MAG%KIND," NOT SUPPORTED IN SURVEY_INNER_MAG "
620          STOP 778
621
622       END  SELECT
623
624
625    ENDIF
626
627
628
629    E_IN%L(-1)=E_IN%L(-1)+P%Ld
630
631
632
633
634  end SUBROUTINE SURVEY_INNER_MAG
635
636
637end module S_def_all_kinds
Note: See TracBrowser for help on using the repository browser.