Skip to content

Commit ed63269

Browse files
perazzperazz
committed
Move wrk/lwrk (real workspace) to fitpack_fitter base type
Rename wrk1/lwrk1 -> wrk/lwrk in surface, polar, sphere types (keeping wrk2/lwrk2 as type-specific), then migrate wrk(:) and lwrk to the abstract base. Updates destroy, comm_size/pack/expand for all 12 subtypes. All 51 tests pass.
1 parent 80ac6a4 commit ed63269

10 files changed

+75
-133
lines changed

‎src/fitpack_curves.f90‎

Lines changed: 4 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -47,8 +47,7 @@ module fitpack_curves
4747

4848
! Estimated and actual number of knots and their allocations
4949
integer(FP_SIZE) :: nest = 0
50-
integer(FP_SIZE) :: lwrk = 0
51-
real(FP_REAL), allocatable :: wrk(:),wrk_fou(:,:)
50+
real(FP_REAL), allocatable :: wrk_fou(:,:)
5251

5352
! Curve extrapolation behavior
5453
integer(FP_FLAG) :: bc = OUTSIDE_NEAREST_BND
@@ -156,15 +155,13 @@ elemental subroutine destroy(this)
156155
deallocate(this%y,stat=ierr)
157156
deallocate(this%w,stat=ierr)
158157
deallocate(this%sp,stat=ierr)
159-
deallocate(this% wrk,stat=ierr)
160158
deallocate(this%wrk_fou,stat=ierr)
161159
deallocate(this%t,stat=ierr)
162160
this%xleft = zero
163161
this%xright = zero
164162

165163
this%order = 3
166164
this%nest = 0
167-
this%lwrk = 0
168165
this%knots = 0
169166
this%bc = OUTSIDE_NEAREST_BND
170167

@@ -615,16 +612,15 @@ end function zeros
615612
elemental integer(FP_SIZE) function curve_comm_size(this)
616613
class(fitpack_curve), intent(in) :: this
617614

618-
! Base fields (iopt, smoothing, fp, c, iwrk)
619-
! Curve-specific scalars: m, order, knots, bc, nest, lwrk, xleft, xright (8 values)
615+
! Base fields (iopt, smoothing, fp, c, iwrk, wrk)
616+
! Curve-specific scalars: m, order, knots, bc, nest, xleft, xright (7 values)
620617
curve_comm_size = this%core_comm_size() &
621-
+ 8 &
618+
+ 7 &
622619
+ FP_COMM_SIZE(this%x) &
623620
+ FP_COMM_SIZE(this%y) &
624621
+ FP_COMM_SIZE(this%sp) &
625622
+ FP_COMM_SIZE(this%w) &
626623
+ FP_COMM_SIZE(this%t) &
627-
+ FP_COMM_SIZE(this%wrk) &
628624
+ FP_COMM_SIZE(this%wrk_fou)
629625

630626
end function curve_comm_size
@@ -646,7 +642,6 @@ pure subroutine curve_comm_pack(this, buffer)
646642
buffer(pos) = real(this%knots, FP_COMM); pos = pos + 1
647643
buffer(pos) = real(this%bc, FP_COMM); pos = pos + 1
648644
buffer(pos) = real(this%nest, FP_COMM); pos = pos + 1
649-
buffer(pos) = real(this%lwrk, FP_COMM); pos = pos + 1
650645
buffer(pos) = this%xleft; pos = pos + 1
651646
buffer(pos) = this%xright; pos = pos + 1
652647

@@ -656,7 +651,6 @@ pure subroutine curve_comm_pack(this, buffer)
656651
call FP_COMM_PACK(this%sp, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%sp)
657652
call FP_COMM_PACK(this%w, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%w)
658653
call FP_COMM_PACK(this%t, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%t)
659-
call FP_COMM_PACK(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
660654
call FP_COMM_PACK(this%wrk_fou, buffer(pos:))
661655

662656
end subroutine curve_comm_pack
@@ -678,7 +672,6 @@ pure subroutine curve_comm_expand(this, buffer)
678672
this%knots = nint(buffer(pos), FP_SIZE); pos = pos + 1
679673
this%bc = nint(buffer(pos), FP_FLAG); pos = pos + 1
680674
this%nest = nint(buffer(pos), FP_SIZE); pos = pos + 1
681-
this%lwrk = nint(buffer(pos), FP_SIZE); pos = pos + 1
682675
this%xleft = buffer(pos); pos = pos + 1
683676
this%xright = buffer(pos); pos = pos + 1
684677

@@ -688,7 +681,6 @@ pure subroutine curve_comm_expand(this, buffer)
688681
call FP_COMM_EXPAND(this%sp, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%sp)
689682
call FP_COMM_EXPAND(this%w, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%w)
690683
call FP_COMM_EXPAND(this%t, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%t)
691-
call FP_COMM_EXPAND(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
692684
call FP_COMM_EXPAND(this%wrk_fou, buffer(pos:))
693685

694686
end subroutine curve_comm_expand

‎src/fitpack_fitters.f90‎

Lines changed: 17 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,10 @@ module fitpack_fitters
4040
!> B-spline coefficients
4141
real(FP_REAL), allocatable :: c(:)
4242

43+
!> Real workspace and its size
44+
integer(FP_SIZE) :: lwrk = 0
45+
real(FP_REAL), allocatable :: wrk(:)
46+
4347
!> Integer workspace and its size
4448
integer(FP_SIZE) :: liwrk = 0
4549
integer(FP_SIZE), allocatable :: iwrk(:)
@@ -90,10 +94,11 @@ elemental real(FP_REAL) function fitter_mse(this)
9094
end function fitter_mse
9195

9296
!> Number of FP_COMM slots needed for base fields:
93-
!> iopt (1) + smoothing (1) + fp (1) + liwrk (1) + c(:) + iwrk(:)
97+
!> iopt (1) + smoothing (1) + fp (1) + lwrk (1) + liwrk (1) + c(:) + wrk(:) + iwrk(:)
9498
elemental integer(FP_SIZE) function fitter_core_comm_size(this)
9599
class(fitpack_fitter), intent(in) :: this
96-
fitter_core_comm_size = 4 + FP_COMM_SIZE(this%c) + FP_COMM_SIZE(this%iwrk)
100+
fitter_core_comm_size = 5 + FP_COMM_SIZE(this%c) + FP_COMM_SIZE(this%wrk) &
101+
+ FP_COMM_SIZE(this%iwrk)
97102
end function fitter_core_comm_size
98103

99104
!> Pack base fields into communication buffer
@@ -106,9 +111,11 @@ pure subroutine fitter_core_comm_pack(this, buffer)
106111
buffer(1) = real(this%iopt, FP_COMM)
107112
buffer(2) = this%smoothing
108113
buffer(3) = this%fp
109-
buffer(4) = real(this%liwrk, FP_COMM)
110-
pos = 5
114+
buffer(4) = real(this%lwrk, FP_COMM)
115+
buffer(5) = real(this%liwrk, FP_COMM)
116+
pos = 6
111117
call FP_COMM_PACK(this%c, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%c)
118+
call FP_COMM_PACK(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
112119
call FP_COMM_PACK(this%iwrk, buffer(pos:))
113120

114121
end subroutine fitter_core_comm_pack
@@ -123,9 +130,11 @@ pure subroutine fitter_core_comm_expand(this, buffer)
123130
this%iopt = nint(buffer(1), FP_FLAG)
124131
this%smoothing = buffer(2)
125132
this%fp = buffer(3)
126-
this%liwrk = nint(buffer(4), FP_SIZE)
127-
pos = 5
133+
this%lwrk = nint(buffer(4), FP_SIZE)
134+
this%liwrk = nint(buffer(5), FP_SIZE)
135+
pos = 6
128136
call FP_COMM_EXPAND(this%c, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%c)
137+
call FP_COMM_EXPAND(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
129138
call FP_COMM_EXPAND(this%iwrk, buffer(pos:))
130139

131140
end subroutine fitter_core_comm_expand
@@ -137,8 +146,10 @@ elemental subroutine fitter_destroy_base(this)
137146
this%iopt = IOPT_NEW_SMOOTHING
138147
this%smoothing = 1000.0_FP_REAL
139148
this%fp = zero
149+
this%lwrk = 0
140150
this%liwrk = 0
141151
deallocate(this%c, stat=ierr)
152+
deallocate(this%wrk, stat=ierr)
142153
deallocate(this%iwrk, stat=ierr)
143154
end subroutine fitter_destroy_base
144155

‎src/fitpack_grid_surfaces.f90‎

Lines changed: 6 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,7 @@ module fitpack_grid_surfaces
4646
! Estimated and actual number of knots and their allocations
4747
integer(FP_SIZE) :: nest(2) = 0
4848
integer(FP_SIZE) :: nmax = 0
49-
integer(FP_SIZE) :: lwrk = 0
50-
real(FP_REAL), allocatable :: wrk(:)
49+
! (lwrk/wrk inherited from fitpack_fitter)
5150

5251
! Knots
5352
integer(FP_SIZE) :: knots(2) = 0
@@ -168,15 +167,13 @@ elemental subroutine surf_destroy(this)
168167
deallocate(this%x,stat=ierr)
169168
deallocate(this%y,stat=ierr)
170169
deallocate(this%z,stat=ierr)
171-
deallocate(this%wrk,stat=ierr)
172170
deallocate(this%t,stat=ierr)
173171
this%left = zero
174172
this%right = zero
175173

176174
this%order = 3
177175
this%nest = 0
178176
this%nmax = 0
179-
this%lwrk = 0
180177
this%knots = 0
181178

182179
end subroutine surf_destroy
@@ -455,14 +452,13 @@ end function gridded_derivatives_one
455452
elemental integer(FP_SIZE) function gridsurf_comm_size(this)
456453
class(fitpack_grid_surface), intent(in) :: this
457454
! Base fields + grid-surface-specific scalars:
458-
! order(2), left(2), right(2), nest(2), nmax, lwrk, knots(2) = 12
455+
! order(2), left(2), right(2), nest(2), nmax, knots(2) = 11
459456
gridsurf_comm_size = this%core_comm_size() &
460-
+ 12 &
457+
+ 11 &
461458
+ FP_COMM_SIZE(this%x) &
462459
+ FP_COMM_SIZE(this%y) &
463460
+ FP_COMM_SIZE(this%z) &
464-
+ FP_COMM_SIZE(this%t) &
465-
+ FP_COMM_SIZE(this%wrk)
461+
+ FP_COMM_SIZE(this%t)
466462
end function gridsurf_comm_size
467463

468464
pure subroutine gridsurf_comm_pack(this, buffer)
@@ -482,15 +478,13 @@ pure subroutine gridsurf_comm_pack(this, buffer)
482478
buffer(pos) = real(this%nest(1), FP_COMM); pos = pos + 1
483479
buffer(pos) = real(this%nest(2), FP_COMM); pos = pos + 1
484480
buffer(pos) = real(this%nmax, FP_COMM); pos = pos + 1
485-
buffer(pos) = real(this%lwrk, FP_COMM); pos = pos + 1
486481
buffer(pos) = real(this%knots(1), FP_COMM); pos = pos + 1
487482
buffer(pos) = real(this%knots(2), FP_COMM); pos = pos + 1
488483

489484
call FP_COMM_PACK(this%x, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%x)
490485
call FP_COMM_PACK(this%y, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%y)
491486
call FP_COMM_PACK(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
492-
call FP_COMM_PACK(this%t, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%t)
493-
call FP_COMM_PACK(this%wrk, buffer(pos:))
487+
call FP_COMM_PACK(this%t, buffer(pos:))
494488
end subroutine gridsurf_comm_pack
495489

496490
pure subroutine gridsurf_comm_expand(this, buffer)
@@ -510,15 +504,13 @@ pure subroutine gridsurf_comm_expand(this, buffer)
510504
this%nest(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
511505
this%nest(2) = nint(buffer(pos), FP_SIZE); pos = pos + 1
512506
this%nmax = nint(buffer(pos), FP_SIZE); pos = pos + 1
513-
this%lwrk = nint(buffer(pos), FP_SIZE); pos = pos + 1
514507
this%knots(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
515508
this%knots(2) = nint(buffer(pos), FP_SIZE); pos = pos + 1
516509

517510
call FP_COMM_EXPAND(this%x, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%x)
518511
call FP_COMM_EXPAND(this%y, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%y)
519512
call FP_COMM_EXPAND(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
520-
call FP_COMM_EXPAND(this%t, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%t)
521-
call FP_COMM_EXPAND(this%wrk, buffer(pos:))
513+
call FP_COMM_EXPAND(this%t, buffer(pos:))
522514
end subroutine gridsurf_comm_expand
523515

524516
end module fitpack_grid_surfaces

‎src/fitpack_gridded_polar.f90‎

Lines changed: 4 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,7 @@ module fitpack_gridded_polar
5555
! Estimated and actual number of knots and their allocations
5656
integer :: nest(2) = 0
5757
integer :: nmax = 0
58-
integer :: lwrk = 0
59-
real(FP_REAL), allocatable :: wrk (:)
58+
! (lwrk/wrk inherited from fitpack_fitter)
6059

6160
! Knots
6261
integer :: knots(2) = 0
@@ -185,14 +184,12 @@ elemental subroutine surf_destroy(this)
185184
deallocate(this%u,stat=ierr)
186185
deallocate(this%v,stat=ierr)
187186
deallocate(this%z,stat=ierr)
188-
deallocate(this%wrk,stat=ierr)
189187
deallocate(this%t,stat=ierr)
190188

191189
this%bc_boundary = OUTSIDE_EXTRAPOLATE
192190
this%bc_continuity_origin = 1
193191
this%nest = 0
194192
this%nmax = 0
195-
this%lwrk = 0
196193
this%knots = 0
197194

198195
end subroutine surf_destroy
@@ -384,14 +381,13 @@ end subroutine gridded_to_disk
384381
elemental integer(FP_SIZE) function gridpolar_comm_size(this)
385382
class(fitpack_grid_polar), intent(in) :: this
386383
! Base fields + grid-polar-specific scalars:
387-
! r, z0, z0_present, z0_exact, z0_zero_gradient, nest(2), nmax, lwrk,
388-
! bc_continuity_origin, bc_boundary, knots(2) = 13
384+
! r, z0, z0_present, z0_exact, z0_zero_gradient, nest(2), nmax,
385+
! bc_continuity_origin, bc_boundary, knots(2) = 12
389386
gridpolar_comm_size = this%core_comm_size() &
390-
+ 13 &
387+
+ 12 &
391388
+ FP_COMM_SIZE(this%u) &
392389
+ FP_COMM_SIZE(this%v) &
393390
+ FP_COMM_SIZE(this%z) &
394-
+ FP_COMM_SIZE(this%wrk) &
395391
+ FP_COMM_SIZE(this%t)
396392
end function gridpolar_comm_size
397393

@@ -411,7 +407,6 @@ pure subroutine gridpolar_comm_pack(this, buffer)
411407
buffer(pos) = real(this%nest(1), FP_COMM); pos = pos + 1
412408
buffer(pos) = real(this%nest(2), FP_COMM); pos = pos + 1
413409
buffer(pos) = real(this%nmax, FP_COMM); pos = pos + 1
414-
buffer(pos) = real(this%lwrk, FP_COMM); pos = pos + 1
415410
buffer(pos) = real(this%bc_continuity_origin, FP_COMM); pos = pos + 1
416411
buffer(pos) = real(this%bc_boundary, FP_COMM); pos = pos + 1
417412
buffer(pos) = real(this%knots(1), FP_COMM); pos = pos + 1
@@ -420,7 +415,6 @@ pure subroutine gridpolar_comm_pack(this, buffer)
420415
call FP_COMM_PACK(this%u, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%u)
421416
call FP_COMM_PACK(this%v, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%v)
422417
call FP_COMM_PACK(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
423-
call FP_COMM_PACK(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
424418
call FP_COMM_PACK(this%t, buffer(pos:))
425419
end subroutine gridpolar_comm_pack
426420

@@ -440,7 +434,6 @@ pure subroutine gridpolar_comm_expand(this, buffer)
440434
this%nest(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
441435
this%nest(2) = nint(buffer(pos), FP_SIZE); pos = pos + 1
442436
this%nmax = nint(buffer(pos), FP_SIZE); pos = pos + 1
443-
this%lwrk = nint(buffer(pos), FP_SIZE); pos = pos + 1
444437
this%bc_continuity_origin = nint(buffer(pos), FP_SIZE); pos = pos + 1
445438
this%bc_boundary = nint(buffer(pos), FP_SIZE); pos = pos + 1
446439
this%knots(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
@@ -449,7 +442,6 @@ pure subroutine gridpolar_comm_expand(this, buffer)
449442
call FP_COMM_EXPAND(this%u, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%u)
450443
call FP_COMM_EXPAND(this%v, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%v)
451444
call FP_COMM_EXPAND(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
452-
call FP_COMM_EXPAND(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
453445
call FP_COMM_EXPAND(this%t, buffer(pos:))
454446
end subroutine gridpolar_comm_expand
455447

‎src/fitpack_gridded_sphere.f90‎

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -49,8 +49,7 @@ module fitpack_gridded_sphere
4949
! Estimated and actual number of knots and their allocations
5050
integer :: nest(2) = 0
5151
integer :: nmax = 0
52-
integer :: lwrk = 0
53-
real(FP_REAL), allocatable :: wrk (:)
52+
! (lwrk/wrk inherited from fitpack_fitter)
5453

5554
! Knots
5655
integer :: knots(2) = 0
@@ -180,12 +179,10 @@ elemental subroutine spgrid_destroy(this)
180179
deallocate(this%u,stat=ierr)
181180
deallocate(this%v,stat=ierr)
182181
deallocate(this%z,stat=ierr)
183-
deallocate(this%wrk,stat=ierr)
184182
deallocate(this%t,stat=ierr)
185183

186184
this%nest = 0
187185
this%nmax = 0
188-
this%lwrk = 0
189186
this%knots = 0
190187

191188
end subroutine spgrid_destroy
@@ -393,13 +390,12 @@ elemental integer(FP_SIZE) function gridsphere_comm_size(this)
393390
class(fitpack_grid_sphere), intent(in) :: this
394391
! Base fields + grid-sphere-specific scalars:
395392
! pole_z0(2), pole_present(2), pole_exct(2), pole_continuity(2), pole_zero_grad(2),
396-
! nest(2), nmax, lwrk, knots(2) = 16
393+
! nest(2), nmax, knots(2) = 15
397394
gridsphere_comm_size = this%core_comm_size() &
398-
+ 16 &
395+
+ 15 &
399396
+ FP_COMM_SIZE(this%u) &
400397
+ FP_COMM_SIZE(this%v) &
401398
+ FP_COMM_SIZE(this%z) &
402-
+ FP_COMM_SIZE(this%wrk) &
403399
+ FP_COMM_SIZE(this%t)
404400
end function gridsphere_comm_size
405401

@@ -424,14 +420,12 @@ pure subroutine gridsphere_comm_pack(this, buffer)
424420
buffer(pos) = real(this%nest(1), FP_COMM); pos = pos + 1
425421
buffer(pos) = real(this%nest(2), FP_COMM); pos = pos + 1
426422
buffer(pos) = real(this%nmax, FP_COMM); pos = pos + 1
427-
buffer(pos) = real(this%lwrk, FP_COMM); pos = pos + 1
428423
buffer(pos) = real(this%knots(1), FP_COMM); pos = pos + 1
429424
buffer(pos) = real(this%knots(2), FP_COMM); pos = pos + 1
430425

431426
call FP_COMM_PACK(this%u, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%u)
432427
call FP_COMM_PACK(this%v, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%v)
433428
call FP_COMM_PACK(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
434-
call FP_COMM_PACK(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
435429
call FP_COMM_PACK(this%t, buffer(pos:))
436430
end subroutine gridsphere_comm_pack
437431

@@ -456,14 +450,12 @@ pure subroutine gridsphere_comm_expand(this, buffer)
456450
this%nest(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
457451
this%nest(2) = nint(buffer(pos), FP_SIZE); pos = pos + 1
458452
this%nmax = nint(buffer(pos), FP_SIZE); pos = pos + 1
459-
this%lwrk = nint(buffer(pos), FP_SIZE); pos = pos + 1
460453
this%knots(1) = nint(buffer(pos), FP_SIZE); pos = pos + 1
461454
this%knots(2) = nint(buffer(pos), FP_SIZE); pos = pos + 1
462455

463456
call FP_COMM_EXPAND(this%u, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%u)
464457
call FP_COMM_EXPAND(this%v, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%v)
465458
call FP_COMM_EXPAND(this%z, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%z)
466-
call FP_COMM_EXPAND(this%wrk, buffer(pos:)); pos = pos + FP_COMM_SIZE(this%wrk)
467459
call FP_COMM_EXPAND(this%t, buffer(pos:))
468460
end subroutine gridsphere_comm_expand
469461

0 commit comments

Comments
 (0)