V3FIT
interp.f
1  SUBROUTINE interp_par(xnew, xold, scalxc, nsnew, nsold)
2  USE vmec_main, ONLY: dp, rprec, mnsize
3  USE vmec_params, ONLY: ntmax
4  USE vmec_persistent, ONLY: ixm
5  USE parallel_include_module
6 
7  IMPLICIT NONE
8 C-----------------------------------------------
9 C D u m m y A r g u m e n t s
10 C-----------------------------------------------
11  INTEGER nsnew, nsold
12  REAL(rprec), DIMENSION(mnsize,nsnew,3*ntmax), INTENT(out) :: xnew
13  REAL(rprec), DIMENSION(mnsize,nsnew,3*ntmax), INTENT(in) ::
14  & scalxc
15  REAL(rprec), DIMENSION(mnsize,nsold,3*ntmax) :: xold
16 C-----------------------------------------------
17 C L o c a l P a r a m e t e r s
18 C-----------------------------------------------
19  REAL(rprec), PARAMETER :: zero=0, one=1
20 C-----------------------------------------------
21 C L o c a l V a r i a b l e s
22 C-----------------------------------------------
23  INTEGER :: ntype, js, js1, js2, neqs2_old
24  REAL(rprec) :: hsold, sj, s1, xint
25 C-----------------------------------------------
26  IF (nsold .le. 0) RETURN
27  hsold = one/(nsold - 1)
28 
29 ! INTERPOLATE R,Z AND LAMBDA ON FULL GRID
30 ! (EXTRAPOLATE M=1 MODES,OVER SQRT(S), TO ORIGIN)
31 ! ON ENTRY, XOLD = X(COARSE MESH) * SCALXC(COARSE MESH)
32 ! ON EXIT, XNEW = X(NEW MESH) [ NOT SCALED BY 1/SQRTS ]
33 
34  DO ntype = 1, 3*ntmax
35 
36  WHERE (mod(ixm(:mnsize),2) .eq. 1)
37  xold(:,1,ntype) = 2*xold(:,2,ntype) - xold(:,3,ntype)
38  END WHERE
39 
40  DO js = 1, nsnew
41  sj = real(js - 1,rprec)/(nsnew - 1)
42  js1 = 1 + ((js - 1)*(nsold - 1))/(nsnew - 1)
43  js2 = min(js1 + 1,nsold)
44  s1 = (js1 - 1)*hsold
45  xint = (sj - s1)/hsold
46  xint = min(one,xint)
47  xint = max(zero,xint)
48  xnew(:,js,ntype) = ((one - xint)*xold(:,js1,ntype) +
49  & xint*xold(:,js2,ntype))/scalxc(:,js,1)
50  END DO
51 
52 ! Zero M=1 modes at origin
53  WHERE (mod(ixm(:mnsize),2) .eq. 1)
54  xnew(:,1,ntype) = 0
55  END WHERE
56 
57  END DO
58 
59  END SUBROUTINE interp_par
60 
61  SUBROUTINE interp(xnew, xold, scalxc, nsnew, nsold)
62  USE vmec_main, ONLY: dp, rprec, mnsize
63  USE vmec_params, ONLY: ntmax
64  USE vmec_persistent, ONLY: ixm
65  USE parallel_include_module
66  IMPLICIT NONE
67 C-----------------------------------------------
68 C D u m m y A r g u m e n t s
69 C-----------------------------------------------
70  INTEGER nsnew, nsold
71  REAL(rprec), DIMENSION(nsnew,mnsize,3*ntmax), INTENT(out) :: xnew
72  REAL(rprec), DIMENSION(nsnew,mnsize,3*ntmax), INTENT(in) ::
73  & scalxc
74  REAL(rprec), DIMENSION(nsold,mnsize,3*ntmax) :: xold
75 C-----------------------------------------------
76 C L o c a l P a r a m e t e r s
77 C-----------------------------------------------
78  REAL(rprec), PARAMETER :: zero=0, one=1
79 C-----------------------------------------------
80 C L o c a l V a r i a b l e s
81 C-----------------------------------------------
82  INTEGER :: ntype, js, js1, js2, neqs2_old
83  REAL(rprec) :: hsold, sj, s1, xint
84 C-----------------------------------------------
85 
86  IF (nsold .le. 0) RETURN
87  hsold = one/(nsold - 1)
88 !
89 ! INTERPOLATE R,Z AND LAMBDA ON FULL GRID
90 ! (EXTRAPOLATE M=1 MODES,OVER SQRT(S), TO ORIGIN)
91 ! ON ENTRY, XOLD = X(COARSE MESH) * SCALXC(COARSE MESH)
92 ! ON EXIT, XNEW = X(NEW MESH) [ NOT SCALED BY 1/SQRTS ]
93 !
94 
95  DO ntype = 1, 3*ntmax
96 
97  WHERE (mod(ixm(:mnsize),2) .eq. 1)
98  xold(1,:,ntype) = 2*xold(2,:,ntype) - xold(3,:,ntype)
99  END WHERE
100 
101  DO js = 1, nsnew
102  sj = real(js - 1,rprec)/(nsnew - 1)
103  js1 = 1 + ((js - 1)*(nsold - 1))/(nsnew - 1)
104  js2 = min(js1 + 1,nsold)
105  s1 = (js1 - 1)*hsold
106  xint = (sj - s1)/hsold
107  xint = min(one,xint)
108  xint = max(zero,xint)
109  xnew(js,:,ntype) = ((one - xint)*xold(js1,:,ntype) +
110  & xint*xold(js2,:,ntype))/scalxc(js,:,1)
111  END DO
112 
113 ! Zero M=1 modes at origin
114  WHERE (mod(ixm(:mnsize),2) .eq. 1)
115  xnew(1,:,ntype) = 0
116  END WHERE
117 
118  END DO
119 
120  END SUBROUTINE interp