106 integer ,
dimension(:),
allocatable :: dof2todof
168 call clear( y%clToDof2)
186 integer ,
intent(in) :: k
188 integer :: cl, ii, jj, ll, wdt, cpt, nn
189 integer,
dimension(:),
allocatable :: nnz, row, row2
192 &
'feSpacexk_mod : create k =', int(k,1)
194 if (k<1)
call quit( &
195 &
"feSpacexk_mod: feSpacexk_create:& 196 & wrong argument 'k'" )
198 &
"feSpacexk_mod: feSpacexk_create:& 199 & fe space 'X_h' not valid" )
204 y%nbDof2 = x_h%nbDof * k
207 call allocmem( y%dof2ToDof, y%nbDof2)
209 y%dof2ToDof(ii) = (ii-1)/k + 1
214 call allocmem( nnz, y%X_h%clToDof%nl )
215 do cl=1, x_h%clToDof%nl
217 jj = x_h%clToDof%row(cl)
218 ll = x_h%clToDof%row(cl+1)
223 y%clToDof2 =
graph(nnz,
size(nnz,1), y%nbDof2)
228 wdt = x_h%clToDof%width
231 do cl=1, x_h%clToDof%nl
233 call getrow(ll, row, wdt, x_h%clToDof, cl)
243 call setrow(y%clToDof2, row2(1:nn), nn, cl)
248 &
'feSpacexk_mod : feSpacexk_create:& 249 & assembling not valid' )
261 if(.NOT.
valid(y%X_h) )
return 262 if(
valid(y%clToDof2) < 0 )
return 263 if(.NOT.
allocated(y%dof2ToDof) )
return 266 b = b .AND. ( y%k >0 )
267 b = b .AND. ( (y%k * y%X_h%nbDof ) == y%nbdof2 )
268 b = b .AND. (
size( y%dof2ToDof, 1) == y%nbDof2 )
282 real(RP),
dimension(:),
allocatable :: u_h
284 procedure(r3tor) :: u_1, u_2
285 procedure(r3tor) ,
optional :: u_3
288 integer :: i, dim, jj, ll
289 real(RP),
dimension(:),
allocatable :: u_ih
292 &
"feSpacexk_mod : interp_vetc_func" 295 &
"feSpacexk_mod: feSpacexk_interp_vect_func:& 296 & fespacsexk 'Y' not valid" )
300 if (y%k /= dim)
call quit(&
301 &
"feSpacexk_mod: feSpacexk_interp_vect_func:& 302 & fespacsexk exponent 'Y%k' incorrect" )
303 if ( dim==1 )
call quit(&
304 &
"feSpacexk_mod: feSpacexk_interp_vect_func:& 305 & dim 1 case, use feSpace_mod::interp_scal_func" )
306 if ( (dim==3).AND.(.NOT.
present(u_3)) )
call quit(&
307 &
"feSpacexk_mod: feSpacexk_interp_vect_func:& 308 & argument 'u3' missing" )
316 ll = (jj-1) * y%k + i
324 ll = (jj-1) * y%k + i
333 ll = (jj-1) * y%k + i
344 write(*,*)
"feSpacexk_mod : print" 345 write(*,*)
" Number of DOF =", y%nbDof2
346 write(*,*)
" Exponent =", y%k
347 write(*,*)
" Valid =",
valid(y)
375 real(RP),
dimension(:),
allocatable :: u_c
376 real(RP),
dimension(:),
intent(in) :: u
378 integer ,
intent(in) :: c
383 &
"feSpacexk_mod : extract_component" 386 &
"feSpacexk_mod: extract_component:& 387 & fespacsexk 'Y' not valid" )
389 if ( (c <1) .OR. (c> y%k) )
call quit(&
390 &
"feSpacexk_mod: extract_component:& 391 & component 'c' incorrect" )
393 if (
size(u,1) /= y%nbDof2 )
call quit(&
394 &
"feSpacexk_mod: extract_component:& 395 & wrong size for the finite element function 'u'" )
430 function l2_dist_2(uh, Y, qdm, u_1, u_2, u_3)
result(dist)
432 real(RP),
dimension(:),
intent(in) :: uh
435 procedure(r3tor) :: u_1, u_2
436 procedure(r3tor) ,
optional :: u_3
438 real(RP),
dimension(:),
allocatable :: uh_i
442 &
"feSpacexk_mod: L2_dist_2:& 443 & fespacsexk 'Y' not valid" )
445 &
"feSpacexk_mod: L2_dist_2:& 446 & quadMesh 'qdm' not valid" )
447 if(.NOT.
associated( qdm%mesh, y%X_h%mesh))
call quit( &
448 &
"feSpacexk_mod: L2_dist_2:& 449 & 'Y' and 'qdmh' associated to different meshes" )
450 if (
size(uh,1) /= y%nbDof2)
call quit( &
451 &
"feSpacexk_mod: L2_dist_2:& 452 & wrong size for the finite element function 'uh'")
453 if ( y%k==1 )
call quit(&
454 &
"feSpacexk_mod: L2_dist_2:& 455 & dim 1 case, use integral::L2_dist" )
456 if ( y%k>3 )
call quit(&
457 &
"feSpacexk_mod: L2_dist_2: dim > 3 " )
458 if (( y%k==3 ) .AND. (.NOT.
present(u_3)))
call quit(&
459 &
"feSpacexk_mod: L2_dist_2:& 460 & argument 'u_3' not provided " )
463 &
'feSpacexk_mod : L2_dist_2' 467 itg =
l2_dist(u_1, uh_i, y%X_h, qdm)
472 itg =
l2_dist(u_2, uh_i, y%X_h, qdm)
478 itg =
l2_dist(u_3, uh_i, y%X_h, qdm)
513 & grad_u2, grad_u3)
result(dist)
515 real(RP),
dimension(:),
intent(in) :: uh
518 procedure(r3tor3) :: grad_u1, grad_u2
519 procedure(r3tor3) ,
optional :: grad_u3
521 real(RP),
dimension(:),
allocatable :: uh_i
525 &
"feSpacexk_mod: L2_dist_grad_2:& 526 & fespacsexk 'Y' not valid" )
528 &
"feSpacexk_mod: L2_dist_grad_2:& 529 & quadMesh 'qdm' not valid" )
530 if(.NOT.
associated( qdm%mesh, y%X_h%mesh))
call quit( &
531 &
"feSpacexk_mod: L2_dist_grad_2:& 532 & 'Y' and 'qdmh' associated to different meshes" )
533 if (
size(uh,1) /= y%nbDof2)
call quit( &
534 &
"feSpacexk_mod: L2_dist_grad_2:& 535 & wrong size for the finite element function 'uh'")
536 if ( y%k==1 )
call quit(&
537 &
"feSpacexk_mod: L2_dist_grad_2:& 538 & dim 1 case, use integral::L2_dist_grad" )
539 if ( y%k>3 )
call quit(&
540 &
"feSpacexk_mod: L2_dist_grad_2: dim > 3 " )
541 if (( y%k==3 ) .AND. (.NOT.
present(grad_u3)))
call quit(&
542 &
"feSpacexk_mod: L2_dist_grad_2:& 543 & argument 'grad_u3' not provided " )
546 &
'feSpacexk_mod : L2_dist_grad_2'
subroutine fespacexk_interp_vect_func(u_h, Y, u_1, u_2, u_3)
Interpolate a function u : R^3 –> R^d given by its components u_1, u_2 and u_3 on Y = [X_h]^d...
DEFINITION OF ABSTRACT_INTERFACES FOR THE LIBRARY CHORAL
DERIVED TYPE graph: sparse matrices of boolean in CSR format
deallocate memory for real(RP) arrays
print a short description
The type feSpacexk defines for a finite element space.
DERIVED TYPE feSpacexk: define for a finite element space.
subroutine fespacexk_print(Y)
Print a short description.
REAL NUMBERS PRECISION IN CHORAL: selects simple/double/quad
DERIVED TYPE quadMesh: integration methods on meshes
subroutine, public extract_component(u_c, u, Y, c)
Extract the component of a finite element function .
DERIVED TYPE feSpace: finite element spaces
type(fespacexk) function fespacexk_create(X_h, k)
Constructor for the type feSpacexk
logical function fespacexk_valid(Y)
Check if the structure content is correct.
real(rp) function l2_dist_2(uh, Y, qdm, u_1, u_2, u_3)
Returns .
allocate memory for real(RP) arrays
Derived type feSpace: finite element space on a mesh.
COMPUTATION OF INTEGRALS using a quadrature methods on a mesh.
integer choral_verb
Verbosity level.
subroutine fespacexk_clear(Y)
Destructor for feSpacexk type.
subroutine, public interp_scal_func(uh, u, X_h)
Interpolation of a scalar function to a scalar finite element function.
real(rp) function l2_dist_grad_2(uh, Y, qdm, grad_u1, grad_u2, grad_u3)
Returns .
DEFINITION OF GLOBAL VARIABLES FOR THE LIBRARY CHORAL
The type quadMesh defines integration methods on meshes.
The type graph stores sparse matrices of boolean in CSR format.