A Modular Arbitrary-Order Ocean-Atmosphere Model -- Stochastic implementation
Data Types | Functions/Subroutines | Variables
tensor Module Reference

Tensor utility module. More...

Data Types

type  coolist
 Coordinate list. Type used to represent the sparse tensor. More...
 
type  coolist4
 4d coordinate list. Type used to represent the rank-4 sparse tensor. More...
 
type  coolist_elem
 Coordinate list element type. Elementary elements of the sparse tensors. More...
 
type  coolist_elem4
 4d coordinate list element type. Elementary elements of the 4d sparse tensors. More...
 

Functions/Subroutines

subroutine, public copy_coo (src, dst)
 Routine to copy a coolist. More...
 
subroutine, public mat_to_coo (src, dst)
 Routine to convert a matrix to a tensor. More...
 
subroutine, public sparse_mul3 (coolist_ijk, arr_j, arr_k, res)
 Sparse multiplication of a tensor with two vectors: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \,b_k\). More...
 
subroutine, public jsparse_mul (coolist_ijk, arr_j, jcoo_ij)
 Sparse multiplication of two tensors to determine the Jacobian:

\[J_{i,j} = {\displaystyle \sum_{k=0}^{ndim}} \left( \mathcal{T}_{i,j,k} + \mathcal{T}_{i,k,j} \right) \, a_k.\]

It's implemented slightly differently: for every \(\mathcal{T}_{i,j,k}\), we add to \(J_{i,j}\) as follows:

\[J_{i,j} = J_{i,j} + \mathcal{T}_{i,j,k} \, a_k \\ J_{i,k} = J_{i,k} + \mathcal{T}_{i,j,k} \, a_j\]

This version return a coolist (sparse tensor). More...

 
subroutine, public jsparse_mul_mat (coolist_ijk, arr_j, jcoo_ij)
 Sparse multiplication of two tensors to determine the Jacobian:

\[J_{i,j} = {\displaystyle \sum_{k=0}^{ndim}} \left( \mathcal{T}_{i,j,k} + \mathcal{T}_{i,k,j} \right) \, a_k.\]

It's implemented slightly differently: for every \(\mathcal{T}_{i,j,k}\), we add to \(J_{i,j}\) as follows:

\[J_{i,j} = J_{i,j} + \mathcal{T}_{i,j,k} \, a_k \\ J_{i,k} = J_{i,k} + \mathcal{T}_{i,j,k} \, a_j\]

This version return a matrix. More...

 
subroutine, public sparse_mul2 (coolist_ij, arr_j, res)
 Sparse multiplication of a 2d sparse tensor with a vector: \({\displaystyle \sum_{j=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \). More...
 
subroutine, public simplify (tensor)
 Routine to simplify a coolist (sparse tensor). For each index \(i\), it upper triangularize the matrix

\[\mathcal{T}_{i,j,k} \qquad 0 \leq j,k \leq ndim.\]

. More...

 
subroutine, public add_elem (t, i, j, k, v)
 Subroutine to add element to a coolist. More...
 
subroutine, public add_check (t, i, j, k, v, dst)
 Subroutine to add element to a coolist and check for overflow. Once the t buffer tensor is full, add it to the destination buffer. More...
 
subroutine, public add_to_tensor (src, dst)
 Routine to add a rank-3 tensor to another one. More...
 
subroutine, public print_tensor (t, s)
 Routine to print a rank 3 tensor coolist. More...
 
subroutine, public write_tensor_to_file (s, t)
 Load a rank-4 tensor coolist from a file definition. More...
 
subroutine, public load_tensor_from_file (s, t)
 Load a rank-4 tensor coolist from a file definition. More...
 
subroutine, public add_matc_to_tensor (i, src, dst)
 Routine to add a matrix to a rank-3 tensor. More...
 
subroutine, public add_matc_to_tensor4 (i, j, src, dst)
 Routine to add a matrix to a rank-4 tensor. More...
 
subroutine, public add_vec_jk_to_tensor (j, k, src, dst)
 Routine to add a vector to a rank-3 tensor. More...
 
subroutine, public add_vec_ikl_to_tensor4_perm (i, k, l, src, dst)
 Routine to add a vector to a rank-4 tensor plus permutation. More...
 
subroutine, public add_vec_ikl_to_tensor4 (i, k, l, src, dst)
 Routine to add a vector to a rank-4 tensor. More...
 
subroutine, public add_vec_ijk_to_tensor4 (i, j, k, src, dst)
 Routine to add a vector to a rank-4 tensor. More...
 
subroutine, public tensor_to_coo (src, dst)
 Routine to convert a rank-3 tensor from matrix to coolist representation. More...
 
subroutine, public tensor4_to_coo4 (src, dst)
 Routine to convert a rank-4 tensor from matrix to coolist representation. More...
 
subroutine, public print_tensor4 (t)
 Routine to print a rank-4 tensor coolist. More...
 
subroutine, public sparse_mul3_mat (coolist_ijk, arr_k, res)
 Sparse multiplication of a rank-3 tensor coolist with a vector: \({\displaystyle \sum_{k=0}^{ndim}} \mathcal{T}_{i,j,k} \, b_k\). Its output is a matrix. More...
 
subroutine, public sparse_mul4 (coolist_ijkl, arr_j, arr_k, arr_l, res)
 Sparse multiplication of a rank-4 tensor coolist with three vectors: \({\displaystyle \sum_{j,k,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, a_j \,b_k \, c_l \). More...
 
subroutine, public sparse_mul4_mat (coolist_ijkl, arr_k, arr_l, res)
 Sparse multiplication of a tensor with two vectors: \({\displaystyle \sum_{k,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \,b_k \, c_l \). More...
 
subroutine, public sparse_mul2_j (coolist_ijk, arr_j, res)
 Sparse multiplication of a 3d sparse tensor with a vectors: \({\displaystyle \sum_{j=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \). More...
 
subroutine, public sparse_mul2_k (coolist_ijk, arr_k, res)
 Sparse multiplication of a rank-3 sparse tensor coolist with a vector: \({\displaystyle \sum_{k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_k \). More...
 
subroutine, public coo_to_mat_ik (src, dst)
 Routine to convert a rank-3 tensor coolist component into a matrix with i and k indices. More...
 
subroutine, public coo_to_mat_ij (src, dst)
 Routine to convert a rank-3 tensor coolist component into a matrix with i and j indices. More...
 
subroutine, public coo_to_mat_i (i, src, dst)
 Routine to convert a rank-3 tensor coolist component into a matrix. More...
 
subroutine, public coo_to_vec_jk (j, k, src, dst)
 Routine to convert a rank-3 tensor coolist component into a vector. More...
 
subroutine, public coo_to_mat_j (j, src, dst)
 Routine to convert a rank-3 tensor coolist component into a matrix. More...
 
subroutine, public sparse_mul4_with_mat_jl (coolist_ijkl, mat_jl, res)
 Sparse multiplication of a rank-4 tensor coolist with a matrix : \({\displaystyle \sum_{j,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, m_{j,l} \). More...
 
subroutine, public sparse_mul4_with_mat_kl (coolist_ijkl, mat_kl, res)
 Sparse multiplication of a rank-4 tensor coolist with a matrix : \({\displaystyle \sum_{j,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, m_{k,l} \). More...
 
subroutine, public sparse_mul3_with_mat (coolist_ijk, mat_jk, res)
 Sparse multiplication of a rank-3 tensor coolist with a matrix: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, m_{j,k}\). More...
 
subroutine, public matc_to_coo (src, dst)
 Routine to convert a matrix to a rank-3 tensor. More...
 
subroutine, public scal_mul_coo (s, t)
 Routine to multiply a rank-3 tensor by a scalar. More...
 
logical function, public tensor_empty (t)
 Test if a rank-3 tensor coolist is empty. More...
 
logical function, public tensor4_empty (t)
 Test if a rank-4 tensor coolist is empty. More...
 
subroutine, public load_tensor4_from_file (s, t)
 Load a rank-4 tensor coolist from a file definition. More...
 
subroutine, public write_tensor4_to_file (s, t)
 Load a rank-4 tensor coolist from a file definition. More...
 

Variables

real(kind=8), parameter real_eps = 2.2204460492503131e-16
 Parameter to test the equality with zero. More...
 

Detailed Description

Tensor utility module.

Remarks
coolist is a type and also means "coordinate list"

Function/Subroutine Documentation

subroutine, public tensor::add_check ( type(coolist), dimension(ndim), intent(inout)  t,
integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k,
real(kind=8), intent(in)  v,
type(coolist), dimension(ndim), intent(inout)  dst 
)

Subroutine to add element to a coolist and check for overflow. Once the t buffer tensor is full, add it to the destination buffer.

Parameters
ttemporary buffer tensor for the destination tensor
itensor \(i\) index
jtensor \(j\) index
ktensor \(k\) index
vvalue to add
dstdestination tensor

Definition at line 332 of file tensor.f90.

332  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: t
333  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
334  INTEGER, INTENT(IN) :: i,j,k
335  REAL(KIND=8), INTENT(IN) :: v
336  INTEGER :: n
337  CALL add_elem(t,i,j,k,v)
338  IF (t(i)%nelems==size(t(i)%elems)) THEN
339  CALL add_to_tensor(t,dst)
340  DO n=1,ndim
341  t(n)%nelems=0
342  ENDDO
343  ENDIF
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public add_to_tensor(src, dst)
Routine to add a rank-3 tensor to another one.
Definition: tensor.f90:350
subroutine, public tensor::add_elem ( type(coolist), dimension(ndim), intent(inout)  t,
integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k,
real(kind=8), intent(in)  v 
)

Subroutine to add element to a coolist.

Parameters
tdestination tensor
itensor \(i\) index
jtensor \(j\) index
ktensor \(k\) index
vvalue to add

Definition at line 310 of file tensor.f90.

310  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: t
311  INTEGER, INTENT(IN) :: i,j,k
312  REAL(KIND=8), INTENT(IN) :: v
313  INTEGER :: n
314  IF (abs(v) .ge. real_eps) THEN
315  n=(t(i)%nelems)+1
316  t(i)%elems(n)%j=j
317  t(i)%elems(n)%k=k
318  t(i)%elems(n)%v=v
319  t(i)%nelems=n
320  END IF
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::add_matc_to_tensor ( integer, intent(in)  i,
real(kind=8), dimension(ndim,ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(inout)  dst 
)

Routine to add a matrix to a rank-3 tensor.

Parameters
iAdd to tensor component i
srcMatrix to add
dstDestination tensor

Definition at line 474 of file tensor.f90.

474  INTEGER, INTENT(IN) :: i
475  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
476  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
477  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
478  INTEGER :: j,k,r,n,nsrc,allocstat
479 
480  nsrc=0
481  DO j=1,ndim
482  DO k=1,ndim
483  IF (abs(src(j,k))>real_eps) nsrc=nsrc+1
484  END DO
485  END DO
486 
487  IF (dst(i)%nelems==0) THEN
488  IF (ALLOCATED(dst(i)%elems)) THEN
489  DEALLOCATE(dst(i)%elems, stat=allocstat)
490  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
491  ENDIF
492  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
493  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
494  n=0
495  ELSE
496  n=dst(i)%nelems
497  ALLOCATE(celems(n), stat=allocstat)
498  DO j=1,n
499  celems(j)%j=dst(i)%elems(j)%j
500  celems(j)%k=dst(i)%elems(j)%k
501  celems(j)%v=dst(i)%elems(j)%v
502  ENDDO
503  DEALLOCATE(dst(i)%elems, stat=allocstat)
504  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
505  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
506  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
507  DO j=1,n
508  dst(i)%elems(j)%j=celems(j)%j
509  dst(i)%elems(j)%k=celems(j)%k
510  dst(i)%elems(j)%v=celems(j)%v
511  ENDDO
512  DEALLOCATE(celems, stat=allocstat)
513  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
514  ENDIF
515  r=0
516  DO j=1,ndim
517  DO k=1,ndim
518  IF (abs(src(j,k))>real_eps) THEN
519  r=r+1
520  dst(i)%elems(n+r)%j=j
521  dst(i)%elems(n+r)%k=k
522  dst(i)%elems(n+r)%v=src(j,k)
523  ENDIF
524  ENDDO
525  END DO
526  dst(i)%nelems=nsrc+n
527 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
Coordinate list element type. Elementary elements of the sparse tensors.
Definition: tensor.f90:25
subroutine, public tensor::add_matc_to_tensor4 ( integer, intent(in)  i,
integer, intent(in)  j,
real(kind=8), dimension(ndim,ndim), intent(in)  src,
type(coolist4), dimension(ndim), intent(inout)  dst 
)

Routine to add a matrix to a rank-4 tensor.

Parameters
iAdd to tensor component i,j
jAdd to tensor component i,j
srcMatrix to add
dstDestination tensor

Definition at line 537 of file tensor.f90.

537  INTEGER, INTENT(IN) :: i,j
538  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
539  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
540  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
541  INTEGER :: k,l,r,n,nsrc,allocstat
542 
543  nsrc=0
544  DO k=1,ndim
545  DO l=1,ndim
546  IF (abs(src(k,l))>real_eps) nsrc=nsrc+1
547  END DO
548  END DO
549 
550  IF (dst(i)%nelems==0) THEN
551  IF (ALLOCATED(dst(i)%elems)) THEN
552  DEALLOCATE(dst(i)%elems, stat=allocstat)
553  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
554  ENDIF
555  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
556  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
557  n=0
558  ELSE
559  n=dst(i)%nelems
560  ALLOCATE(celems(n), stat=allocstat)
561  DO k=1,n
562  celems(k)%j=dst(i)%elems(k)%j
563  celems(k)%k=dst(i)%elems(k)%k
564  celems(k)%l=dst(i)%elems(k)%l
565  celems(k)%v=dst(i)%elems(k)%v
566  ENDDO
567  DEALLOCATE(dst(i)%elems, stat=allocstat)
568  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
569  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
570  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
571  DO k=1,n
572  dst(i)%elems(k)%j=celems(k)%j
573  dst(i)%elems(k)%k=celems(k)%k
574  dst(i)%elems(k)%l=celems(k)%l
575  dst(i)%elems(k)%v=celems(k)%v
576  ENDDO
577  DEALLOCATE(celems, stat=allocstat)
578  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
579  ENDIF
580  r=0
581  DO k=1,ndim
582  DO l=1,ndim
583  IF (abs(src(k,l))>real_eps) THEN
584  r=r+1
585  dst(i)%elems(n+r)%j=j
586  dst(i)%elems(n+r)%k=k
587  dst(i)%elems(n+r)%l=l
588  dst(i)%elems(n+r)%v=src(k,l)
589  ENDIF
590  ENDDO
591  END DO
592  dst(i)%nelems=nsrc+n
593 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
4d coordinate list element type. Elementary elements of the 4d sparse tensors.
Definition: tensor.f90:32
subroutine, public tensor::add_to_tensor ( type(coolist), dimension(ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(inout)  dst 
)

Routine to add a rank-3 tensor to another one.

Parameters
srcTensor to add
dstDestination tensor

Definition at line 350 of file tensor.f90.

350  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
351  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
352  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
353  INTEGER :: i,j,n,allocstat
354 
355  DO i=1,ndim
356  IF (src(i)%nelems/=0) THEN
357  IF (dst(i)%nelems==0) THEN
358  IF (ALLOCATED(dst(i)%elems)) THEN
359  DEALLOCATE(dst(i)%elems, stat=allocstat)
360  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
361  ENDIF
362  ALLOCATE(dst(i)%elems(src(i)%nelems), stat=allocstat)
363  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
364  n=0
365  ELSE
366  n=dst(i)%nelems
367  ALLOCATE(celems(n), stat=allocstat)
368  DO j=1,n
369  celems(j)%j=dst(i)%elems(j)%j
370  celems(j)%k=dst(i)%elems(j)%k
371  celems(j)%v=dst(i)%elems(j)%v
372  ENDDO
373  DEALLOCATE(dst(i)%elems, stat=allocstat)
374  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
375  ALLOCATE(dst(i)%elems(src(i)%nelems+n), stat=allocstat)
376  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
377  DO j=1,n
378  dst(i)%elems(j)%j=celems(j)%j
379  dst(i)%elems(j)%k=celems(j)%k
380  dst(i)%elems(j)%v=celems(j)%v
381  ENDDO
382  DEALLOCATE(celems, stat=allocstat)
383  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
384  ENDIF
385  DO j=1,src(i)%nelems
386  dst(i)%elems(n+j)%j=src(i)%elems(j)%j
387  dst(i)%elems(n+j)%k=src(i)%elems(j)%k
388  dst(i)%elems(n+j)%v=src(i)%elems(j)%v
389  ENDDO
390  dst(i)%nelems=src(i)%nelems+n
391  ENDIF
392  ENDDO
393 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
Coordinate list element type. Elementary elements of the sparse tensors.
Definition: tensor.f90:25
subroutine, public tensor::add_vec_ijk_to_tensor4 ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  k,
real(kind=8), dimension(ndim), intent(in)  src,
type(coolist4), dimension(ndim), intent(inout)  dst 
)

Routine to add a vector to a rank-4 tensor.

Parameters
i,j,kAdd to tensor component i,j and k
srcVector to add
dstDestination tensor

Definition at line 785 of file tensor.f90.

785  INTEGER, INTENT(IN) :: i,j,k
786  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
787  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
788  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
789  INTEGER :: l,ne,r,n,nsrc,allocstat
790 
791  nsrc=0
792  DO l=1,ndim
793  IF (abs(src(l))>real_eps) nsrc=nsrc+1
794  ENDDO
795 
796  IF (dst(i)%nelems==0) THEN
797  IF (ALLOCATED(dst(i)%elems)) THEN
798  DEALLOCATE(dst(i)%elems, stat=allocstat)
799  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
800  ENDIF
801  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
802  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
803  n=0
804  ELSE
805  n=dst(i)%nelems
806  ALLOCATE(celems(n), stat=allocstat)
807  DO ne=1,n
808  celems(ne)%j=dst(i)%elems(ne)%j
809  celems(ne)%k=dst(i)%elems(ne)%k
810  celems(ne)%l=dst(i)%elems(ne)%l
811  celems(ne)%v=dst(i)%elems(ne)%v
812  ENDDO
813  DEALLOCATE(dst(i)%elems, stat=allocstat)
814  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
815  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
816  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
817  DO ne=1,n
818  dst(i)%elems(ne)%j=celems(ne)%j
819  dst(i)%elems(ne)%k=celems(ne)%k
820  dst(i)%elems(ne)%l=celems(ne)%l
821  dst(i)%elems(ne)%v=celems(ne)%v
822  ENDDO
823  DEALLOCATE(celems, stat=allocstat)
824  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
825  ENDIF
826  r=0
827  DO l=1,ndim
828  IF (abs(src(l))>real_eps) THEN
829  r=r+1
830  dst(i)%elems(n+r)%j=j
831  dst(i)%elems(n+r)%k=k
832  dst(i)%elems(n+r)%l=l
833  dst(i)%elems(n+r)%v=src(l)
834  ENDIF
835  ENDDO
836  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
4d coordinate list element type. Elementary elements of the 4d sparse tensors.
Definition: tensor.f90:32
subroutine, public tensor::add_vec_ikl_to_tensor4 ( integer, intent(in)  i,
integer, intent(in)  k,
integer, intent(in)  l,
real(kind=8), dimension(ndim), intent(in)  src,
type(coolist4), dimension(ndim), intent(inout)  dst 
)

Routine to add a vector to a rank-4 tensor.

Parameters
i,k,lAdd to tensor component i,k and l
srcVector to add
dstDestination tensor

Definition at line 726 of file tensor.f90.

726  INTEGER, INTENT(IN) :: i,k,l
727  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
728  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
729  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
730  INTEGER :: j,ne,r,n,nsrc,allocstat
731 
732  nsrc=0
733  DO j=1,ndim
734  IF (abs(src(j))>real_eps) nsrc=nsrc+1
735  ENDDO
736 
737  IF (dst(i)%nelems==0) THEN
738  IF (ALLOCATED(dst(i)%elems)) THEN
739  DEALLOCATE(dst(i)%elems, stat=allocstat)
740  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
741  ENDIF
742  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
743  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
744  n=0
745  ELSE
746  n=dst(i)%nelems
747  ALLOCATE(celems(n), stat=allocstat)
748  DO ne=1,n
749  celems(ne)%j=dst(i)%elems(ne)%j
750  celems(ne)%k=dst(i)%elems(ne)%k
751  celems(ne)%l=dst(i)%elems(ne)%l
752  celems(ne)%v=dst(i)%elems(ne)%v
753  ENDDO
754  DEALLOCATE(dst(i)%elems, stat=allocstat)
755  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
756  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
757  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
758  DO ne=1,n
759  dst(i)%elems(ne)%j=celems(ne)%j
760  dst(i)%elems(ne)%k=celems(ne)%k
761  dst(i)%elems(ne)%l=celems(ne)%l
762  dst(i)%elems(ne)%v=celems(ne)%v
763  ENDDO
764  DEALLOCATE(celems, stat=allocstat)
765  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
766  ENDIF
767  r=0
768  DO j=1,ndim
769  IF (abs(src(j))>real_eps) THEN
770  r=r+1
771  dst(i)%elems(n+r)%j=j
772  dst(i)%elems(n+r)%k=k
773  dst(i)%elems(n+r)%l=l
774  dst(i)%elems(n+r)%v=src(j)
775  ENDIF
776  ENDDO
777  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
4d coordinate list element type. Elementary elements of the 4d sparse tensors.
Definition: tensor.f90:32
subroutine, public tensor::add_vec_ikl_to_tensor4_perm ( integer, intent(in)  i,
integer, intent(in)  k,
integer, intent(in)  l,
real(kind=8), dimension(ndim), intent(in)  src,
type(coolist4), dimension(ndim), intent(inout)  dst 
)

Routine to add a vector to a rank-4 tensor plus permutation.

Parameters
i,k,lAdd to tensor component i,k and l
srcVector to add
dstDestination tensor

Definition at line 657 of file tensor.f90.

657  INTEGER, INTENT(IN) :: i,k,l
658  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
659  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
660  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
661  INTEGER :: j,ne,r,n,nsrc,allocstat
662 
663  nsrc=0
664  DO j=1,ndim
665  IF (abs(src(j))>real_eps) nsrc=nsrc+1
666  ENDDO
667  nsrc=nsrc*3
668  IF (dst(i)%nelems==0) THEN
669  IF (ALLOCATED(dst(i)%elems)) THEN
670  DEALLOCATE(dst(i)%elems, stat=allocstat)
671  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
672  ENDIF
673  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
674  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
675  n=0
676  ELSE
677  n=dst(i)%nelems
678  ALLOCATE(celems(n), stat=allocstat)
679  DO ne=1,n
680  celems(ne)%j=dst(i)%elems(ne)%j
681  celems(ne)%k=dst(i)%elems(ne)%k
682  celems(ne)%l=dst(i)%elems(ne)%l
683  celems(ne)%v=dst(i)%elems(ne)%v
684  ENDDO
685  DEALLOCATE(dst(i)%elems, stat=allocstat)
686  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
687  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
688  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
689  DO ne=1,n
690  dst(i)%elems(ne)%j=celems(ne)%j
691  dst(i)%elems(ne)%k=celems(ne)%k
692  dst(i)%elems(ne)%l=celems(ne)%l
693  dst(i)%elems(ne)%v=celems(ne)%v
694  ENDDO
695  DEALLOCATE(celems, stat=allocstat)
696  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
697  ENDIF
698  r=0
699  DO j=1,ndim
700  IF (abs(src(j))>real_eps) THEN
701  r=r+1
702  dst(i)%elems(n+r)%j=j
703  dst(i)%elems(n+r)%k=k
704  dst(i)%elems(n+r)%l=l
705  dst(i)%elems(n+r)%v=src(j)
706  r=r+1
707  dst(i)%elems(n+r)%j=k
708  dst(i)%elems(n+r)%k=l
709  dst(i)%elems(n+r)%l=j
710  dst(i)%elems(n+r)%v=src(j)
711  r=r+1
712  dst(i)%elems(n+r)%j=l
713  dst(i)%elems(n+r)%k=j
714  dst(i)%elems(n+r)%l=k
715  dst(i)%elems(n+r)%v=src(j)
716  ENDIF
717  ENDDO
718  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
4d coordinate list element type. Elementary elements of the 4d sparse tensors.
Definition: tensor.f90:32
subroutine, public tensor::add_vec_jk_to_tensor ( integer, intent(in)  j,
integer, intent(in)  k,
real(kind=8), dimension(ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(inout)  dst 
)

Routine to add a vector to a rank-3 tensor.

Parameters
j,kAdd to tensor component j and k
srcVector to add
dstDestination tensor

Definition at line 602 of file tensor.f90.

602  INTEGER, INTENT(IN) :: j,k
603  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
604  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
605  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
606  INTEGER :: i,l,r,n,nsrc,allocstat
607 
608  DO i=1,ndim
609  nsrc=0
610  IF (abs(src(i))>real_eps) nsrc=1
611  IF (dst(i)%nelems==0) THEN
612  IF (ALLOCATED(dst(i)%elems)) THEN
613  DEALLOCATE(dst(i)%elems, stat=allocstat)
614  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
615  ENDIF
616  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
617  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
618  n=0
619  ELSE
620  n=dst(i)%nelems
621  ALLOCATE(celems(n), stat=allocstat)
622  DO l=1,n
623  celems(l)%j=dst(i)%elems(l)%j
624  celems(l)%k=dst(i)%elems(l)%k
625  celems(l)%v=dst(i)%elems(l)%v
626  ENDDO
627  DEALLOCATE(dst(i)%elems, stat=allocstat)
628  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
629  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
630  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
631  DO l=1,n
632  dst(i)%elems(l)%j=celems(l)%j
633  dst(i)%elems(l)%k=celems(l)%k
634  dst(i)%elems(l)%v=celems(l)%v
635  ENDDO
636  DEALLOCATE(celems, stat=allocstat)
637  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
638  ENDIF
639  r=0
640  IF (abs(src(i))>real_eps) THEN
641  r=r+1
642  dst(i)%elems(n+r)%j=j
643  dst(i)%elems(n+r)%k=k
644  dst(i)%elems(n+r)%v=src(i)
645  ENDIF
646  dst(i)%nelems=nsrc+n
647  END DO
648 
649 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
Coordinate list element type. Elementary elements of the sparse tensors.
Definition: tensor.f90:25
subroutine, public tensor::coo_to_mat_i ( integer, intent(in)  i,
type(coolist), dimension(ndim), intent(in)  src,
real(kind=8), dimension(ndim,ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor coolist component into a matrix.

Parameters
iComponent to convert
srcSource tensor
dstDestination matrix

Definition at line 1112 of file tensor.f90.

1112  INTEGER, INTENT(IN) :: i
1113  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1114  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
1115  INTEGER :: n
1116 
1117  dst=0.d0
1118  DO n=1,src(i)%nelems
1119  dst(src(i)%elems(n)%j,src(i)%elems(n)%k)=src(i)%elems(n)%v
1120  ENDDO
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::coo_to_mat_ij ( type(coolist), dimension(ndim), intent(in)  src,
real(kind=8), dimension(ndim,ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor coolist component into a matrix with i and j indices.

Parameters
srcSource tensor
dstDestination matrix

Definition at line 1079 of file tensor.f90.

1079  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1080  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
1081  INTEGER :: i,n
1082 
1083  dst=0.d0
1084  DO i=1,ndim
1085  DO n=1,src(i)%nelems
1086  dst(i,src(i)%elems(n)%j)=src(i)%elems(n)%v
1087  ENDDO
1088  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::coo_to_mat_ik ( type(coolist), dimension(ndim), intent(in)  src,
real(kind=8), dimension(ndim,ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor coolist component into a matrix with i and k indices.

Parameters
srcSource tensor
dstDestination matrix

Definition at line 1063 of file tensor.f90.

1063  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1064  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
1065  INTEGER :: i,n
1066 
1067  dst=0.d0
1068  DO i=1,ndim
1069  DO n=1,src(i)%nelems
1070  dst(i,src(i)%elems(n)%k)=src(i)%elems(n)%v
1071  ENDDO
1072  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::coo_to_mat_j ( integer, intent(in)  j,
type(coolist), dimension(ndim), intent(in)  src,
real(kind=8), dimension(ndim,ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor coolist component into a matrix.

Parameters
jComponent to convert
srcSource tensor
dstDestination matrix

Definition at line 1148 of file tensor.f90.

1148  INTEGER, INTENT(IN) :: j
1149  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1150  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
1151  INTEGER :: i,n
1152 
1153  dst=0.d0
1154  DO i=1,ndim
1155  DO n=1,src(i)%nelems
1156  IF (src(i)%elems(n)%j==j) dst(i,src(i)%elems(n)%k)=src(i)%elems(n)%v
1157  ENDDO
1158  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::coo_to_vec_jk ( integer, intent(in)  j,
integer, intent(in)  k,
type(coolist), dimension(ndim), intent(in)  src,
real(kind=8), dimension(ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor coolist component into a vector.

Parameters
jComponent j,k to convert
kComponent j,k to convert
srcSource tensor
dstDestination vector

Definition at line 1129 of file tensor.f90.

1129  INTEGER, INTENT(IN) :: j,k
1130  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1131  REAL(KIND=8), DIMENSION(ndim), INTENT(OUT) :: dst
1132  INTEGER :: i,n
1133 
1134  dst=0.d0
1135  DO i=1,ndim
1136  DO n=1,src(i)%nelems
1137  IF ((src(i)%elems(n)%j==j).and.(src(i)%elems(n)%k==k)) dst(i)=src(i)%elems(n)%v
1138  END DO
1139  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::copy_coo ( type(coolist), dimension(ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(out)  dst 
)

Routine to copy a coolist.

Parameters
srcSource coolist
dstDestination coolist
Remarks
The destination tensor have to be an empty tensor, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 72 of file tensor.f90.

72  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
73  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
74  INTEGER :: i,j,allocstat
75 
76  DO i=1,ndim
77  IF (dst(i)%nelems/=0) stop "*** copy_coo : Destination coolist not empty ! ***"
78  ALLOCATE(dst(i)%elems(src(i)%nelems), stat=allocstat)
79  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
80  DO j=1,src(i)%nelems
81  dst(i)%elems(j)%j=src(i)%elems(j)%j
82  dst(i)%elems(j)%k=src(i)%elems(j)%k
83  dst(i)%elems(j)%v=src(i)%elems(j)%v
84  ENDDO
85  dst(i)%nelems=src(i)%nelems
86  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::jsparse_mul ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
type(coolist), dimension(ndim), intent(out)  jcoo_ij 
)

Sparse multiplication of two tensors to determine the Jacobian:

\[J_{i,j} = {\displaystyle \sum_{k=0}^{ndim}} \left( \mathcal{T}_{i,j,k} + \mathcal{T}_{i,k,j} \right) \, a_k.\]

It's implemented slightly differently: for every \(\mathcal{T}_{i,j,k}\), we add to \(J_{i,j}\) as follows:

\[J_{i,j} = J_{i,j} + \mathcal{T}_{i,j,k} \, a_k \\ J_{i,k} = J_{i,k} + \mathcal{T}_{i,j,k} \, a_j\]

This version return a coolist (sparse tensor).

Parameters
coolist_ijka coordinate list (sparse tensor) of which index 2 or 3 will be contracted.
arr_jthe vector to be contracted with index 2 and then index 3 of ffi_coo_ijk
jcoo_ija coolist (sparse tensor) to store the result of the contraction

Definition at line 153 of file tensor.f90.

153  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
154  TYPE(coolist), DIMENSION(ndim), INTENT(OUT):: jcoo_ij
155  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
156  REAL(KIND=8) :: v
157  INTEGER :: i,j,k,n,nj,allocstat
158  DO i=1,ndim
159  IF (jcoo_ij(i)%nelems/=0) stop "*** jsparse_mul : Destination coolist not empty ! ***"
160  nj=2*coolist_ijk(i)%nelems
161  ALLOCATE(jcoo_ij(i)%elems(nj), stat=allocstat)
162  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
163  nj=0
164  DO n=1,coolist_ijk(i)%nelems
165  j=coolist_ijk(i)%elems(n)%j
166  k=coolist_ijk(i)%elems(n)%k
167  v=coolist_ijk(i)%elems(n)%v
168  IF (j /=0) THEN
169  nj=nj+1
170  jcoo_ij(i)%elems(nj)%j=j
171  jcoo_ij(i)%elems(nj)%k=0
172  jcoo_ij(i)%elems(nj)%v=v*arr_j(k)
173  END IF
174 
175  IF (k /=0) THEN
176  nj=nj+1
177  jcoo_ij(i)%elems(nj)%j=k
178  jcoo_ij(i)%elems(nj)%k=0
179  jcoo_ij(i)%elems(nj)%v=v*arr_j(j)
180  END IF
181  END DO
182  jcoo_ij(i)%nelems=nj
183  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::jsparse_mul_mat ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
real(kind=8), dimension(ndim,ndim), intent(out)  jcoo_ij 
)

Sparse multiplication of two tensors to determine the Jacobian:

\[J_{i,j} = {\displaystyle \sum_{k=0}^{ndim}} \left( \mathcal{T}_{i,j,k} + \mathcal{T}_{i,k,j} \right) \, a_k.\]

It's implemented slightly differently: for every \(\mathcal{T}_{i,j,k}\), we add to \(J_{i,j}\) as follows:

\[J_{i,j} = J_{i,j} + \mathcal{T}_{i,j,k} \, a_k \\ J_{i,k} = J_{i,k} + \mathcal{T}_{i,j,k} \, a_j\]

This version return a matrix.

Parameters
coolist_ijka coordinate list (sparse tensor) of which index 2 or 3 will be contracted.
arr_jthe vector to be contracted with index 2 and then index 3 of ffi_coo_ijk
jcoo_ija matrix to store the result of the contraction

Definition at line 196 of file tensor.f90.

196  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
197  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT):: jcoo_ij
198  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
199  REAL(KIND=8) :: v
200  INTEGER :: i,j,k,n
201  jcoo_ij=0.d0
202  DO i=1,ndim
203  DO n=1,coolist_ijk(i)%nelems
204  j=coolist_ijk(i)%elems(n)%j
205  k=coolist_ijk(i)%elems(n)%k
206  v=coolist_ijk(i)%elems(n)%v
207  IF (j /=0) jcoo_ij(i,j)=jcoo_ij(i,j)+v*arr_j(k)
208  IF (k /=0) jcoo_ij(i,k)=jcoo_ij(i,k)+v*arr_j(j)
209  END DO
210  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::load_tensor4_from_file ( character (len=*), intent(in)  s,
type(coolist4), dimension(ndim), intent(out)  t 
)

Load a rank-4 tensor coolist from a file definition.

Parameters
sFilename of the tensor definition file
tThe loaded coolist
Remarks
The destination tensor have to be an empty tensor, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 1322 of file tensor.f90.

1322  CHARACTER (LEN=*), INTENT(IN) :: s
1323  TYPE(coolist4), DIMENSION(ndim), INTENT(OUT) :: t
1324  INTEGER :: i,ir,j,k,l,n,allocstat
1325  REAL(KIND=8) :: v
1326  OPEN(30,file=s,status='old')
1327  DO i=1,ndim
1328  READ(30,*) ir,n
1329  IF (n /= 0) THEN
1330  ALLOCATE(t(i)%elems(n), stat=allocstat)
1331  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
1332  t(i)%nelems=n
1333  ENDIF
1334  DO n=1,t(i)%nelems
1335  READ(30,*) ir,j,k,l,v
1336  t(i)%elems(n)%j=j
1337  t(i)%elems(n)%k=k
1338  t(i)%elems(n)%l=l
1339  t(i)%elems(n)%v=v
1340  ENDDO
1341  END DO
1342  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::load_tensor_from_file ( character (len=*), intent(in)  s,
type(coolist), dimension(ndim), intent(out)  t 
)

Load a rank-4 tensor coolist from a file definition.

Parameters
sFilename of the tensor definition file
tThe loaded coolist
Remarks
The destination tensor have to be an empty tensor, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 445 of file tensor.f90.

445  CHARACTER (LEN=*), INTENT(IN) :: s
446  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: t
447  INTEGER :: i,ir,j,k,n,allocstat
448  REAL(KIND=8) :: v
449  OPEN(30,file=s,status='old')
450  DO i=1,ndim
451  READ(30,*) ir,n
452  IF (n /= 0) THEN
453  ALLOCATE(t(i)%elems(n), stat=allocstat)
454  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
455  t(i)%nelems=n
456  ENDIF
457  DO n=1,t(i)%nelems
458  READ(30,*) ir,j,k,v
459  t(i)%elems(n)%j=j
460  t(i)%elems(n)%k=k
461  t(i)%elems(n)%v=v
462  ENDDO
463  END DO
464  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::mat_to_coo ( real(kind=8), dimension(0:ndim,0:ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(out)  dst 
)

Routine to convert a matrix to a tensor.

Parameters
srcSource matrix
dstDestination tensor
Remarks
The destination tensor have to be an empty tensor, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 94 of file tensor.f90.

94  REAL(KIND=8), DIMENSION(0:ndim,0:ndim), INTENT(IN) :: src
95  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
96  INTEGER :: i,j,n,allocstat
97  DO i=1,ndim
98  n=0
99  DO j=1,ndim
100  IF (abs(src(i,j))>real_eps) n=n+1
101  ENDDO
102  IF (n/=0) THEN
103  IF (dst(i)%nelems/=0) stop "*** mat_to_coo : Destination coolist not empty ! ***"
104  ALLOCATE(dst(i)%elems(n), stat=allocstat)
105  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
106  n=0
107  DO j=1,ndim
108  IF (abs(src(i,j))>real_eps) THEN
109  n=n+1
110  dst(i)%elems(n)%j=j
111  dst(i)%elems(n)%k=0
112  dst(i)%elems(n)%v=src(i,j)
113  ENDIF
114  ENDDO
115  ENDIF
116  dst(i)%nelems=n
117  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::matc_to_coo ( real(kind=8), dimension(ndim,ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(out)  dst 
)

Routine to convert a matrix to a rank-3 tensor.

Parameters
srcSource matrix
dstDestination tensor
Remarks
The destination tensor have to be an empty tensor, i.e. with unallocated list of elements and nelems set to 0.
The j component will be set to 0.

Definition at line 1244 of file tensor.f90.

1244  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
1245  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
1246  INTEGER :: i,j,n,allocstat
1247  DO i=1,ndim
1248  n=0
1249  DO j=1,ndim
1250  IF (abs(src(i,j))>real_eps) n=n+1
1251  ENDDO
1252  IF (n/=0) THEN
1253  IF (dst(i)%nelems/=0) stop "*** mat_to_coo : Destination coolist not empty ! ***"
1254  ALLOCATE(dst(i)%elems(n), stat=allocstat)
1255  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
1256  n=0
1257  DO j=1,ndim
1258  IF (abs(src(i,j))>real_eps) THEN
1259  n=n+1
1260  dst(i)%elems(n)%j=0
1261  dst(i)%elems(n)%k=j
1262  dst(i)%elems(n)%v=src(i,j)
1263  ENDIF
1264  ENDDO
1265  ENDIF
1266  dst(i)%nelems=n
1267  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::print_tensor ( type(coolist), dimension(ndim), intent(in)  t,
character, intent(in), optional  s 
)

Routine to print a rank 3 tensor coolist.

Parameters
tcoolist to print

Definition at line 399 of file tensor.f90.

399  USE util, only: str
400  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: t
401  CHARACTER, INTENT(IN), OPTIONAL :: s
402  CHARACTER :: r
403  INTEGER :: i,n,j,k
404  IF (PRESENT(s)) THEN
405  r=s
406  ELSE
407  r="t"
408  END IF
409  DO i=1,ndim
410  DO n=1,t(i)%nelems
411  j=t(i)%elems(n)%j
412  k=t(i)%elems(n)%k
413  IF( abs(t(i)%elems(n)%v) .GE. real_eps) THEN
414  write(*,"(A,ES12.5)") r//"["//trim(str(i))//"]["//trim(str(j)) &
415  &//"]["//trim(str(k))//"] = ",t(i)%elems(n)%v
416  END IF
417  END DO
418  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Utility module.
Definition: util.f90:12
character(len=20) function, public str(k)
Convert an integer to string.
Definition: util.f90:31
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::print_tensor4 ( type(coolist4), dimension(ndim), intent(in)  t)

Routine to print a rank-4 tensor coolist.

Parameters
tcoolist to print

Definition at line 922 of file tensor.f90.

922  USE util, only: str
923  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
924  INTEGER :: i,n,j,k,l
925  DO i=1,ndim
926  DO n=1,t(i)%nelems
927  j=t(i)%elems(n)%j
928  k=t(i)%elems(n)%k
929  l=t(i)%elems(n)%l
930  IF( abs(t(i)%elems(n)%v) .GE. real_eps) THEN
931  write(*,"(A,ES12.5)") "tensor["//trim(str(i))//"]["//trim(str(j)) &
932  &//"]["//trim(str(k))//"]["//trim(str(l))//"] = ",t(i)%elems(n)%v
933  END IF
934  END DO
935  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Utility module.
Definition: util.f90:12
character(len=20) function, public str(k)
Convert an integer to string.
Definition: util.f90:31
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::scal_mul_coo ( real(kind=8), intent(in)  s,
type(coolist), dimension(ndim), intent(inout)  t 
)

Routine to multiply a rank-3 tensor by a scalar.

Parameters
sThe scalar
tThe tensor

Definition at line 1274 of file tensor.f90.

1274  REAL(KIND=8), INTENT(IN) :: s
1275  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: t
1276  INTEGER :: i,li,n
1277  DO i=1,ndim
1278  n=t(i)%nelems
1279  DO li=1,n
1280  t(i)%elems(li)%v=s*t(i)%elems(li)%v
1281  ENDDO
1282  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::simplify ( type(coolist), dimension(ndim), intent(inout)  tensor)

Routine to simplify a coolist (sparse tensor). For each index \(i\), it upper triangularize the matrix

\[\mathcal{T}_{i,j,k} \qquad 0 \leq j,k \leq ndim.\]

.

Parameters
tensora coordinate list (sparse tensor) which will be simplified.

Definition at line 238 of file tensor.f90.

238  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT):: tensor
239  INTEGER :: i,j,k
240  INTEGER :: li,lii,liii,n
241  DO i= 1,ndim
242  n=tensor(i)%nelems
243  DO li=n,2,-1
244  j=tensor(i)%elems(li)%j
245  k=tensor(i)%elems(li)%k
246  DO lii=li-1,1,-1
247  IF (((j==tensor(i)%elems(lii)%j).AND.(k==tensor(i)&
248  &%elems(lii)%k)).OR.((j==tensor(i)%elems(lii)%k).AND.(k==tensor(i)%elems(lii)%j))) THEN
249  ! Found another entry with the same i,j,k: merge both into
250  ! the one listed first (of those two).
251  tensor(i)%elems(lii)%v=tensor(i)%elems(lii)%v+tensor(i)%elems(li)%v
252  IF (j>k) THEN
253  tensor(i)%elems(lii)%j=tensor(i)%elems(li)%k
254  tensor(i)%elems(lii)%k=tensor(i)%elems(li)%j
255  ENDIF
256 
257  ! Shift the rest of the items one place down.
258  DO liii=li+1,n
259  tensor(i)%elems(liii-1)%j=tensor(i)%elems(liii)%j
260  tensor(i)%elems(liii-1)%k=tensor(i)%elems(liii)%k
261  tensor(i)%elems(liii-1)%v=tensor(i)%elems(liii)%v
262  END DO
263  tensor(i)%nelems=tensor(i)%nelems-1
264  ! Here we should stop because the li no longer points to the
265  ! original i,j,k element
266  EXIT
267  ENDIF
268  ENDDO
269  ENDDO
270  n=tensor(i)%nelems
271  DO li=1,n
272  ! Clear new "almost" zero entries and shift rest of the items one place down.
273  ! Make sure not to skip any entries while shifting!
274  DO WHILE (abs(tensor(i)%elems(li)%v) < real_eps)
275  DO liii=li+1,n
276  tensor(i)%elems(liii-1)%j=tensor(i)%elems(liii)%j
277  tensor(i)%elems(liii-1)%k=tensor(i)%elems(liii)%k
278  tensor(i)%elems(liii-1)%v=tensor(i)%elems(liii)%v
279  ENDDO
280  tensor(i)%nelems=tensor(i)%nelems-1
281  if (li > tensor(i)%nelems) THEN
282  EXIT
283  ENDIF
284  ENDDO
285  ENDDO
286 
287  n=tensor(i)%nelems
288  DO li=1,n
289  ! Upper triangularize
290  j=tensor(i)%elems(li)%j
291  k=tensor(i)%elems(li)%k
292  IF (j>k) THEN
293  tensor(i)%elems(li)%j=k
294  tensor(i)%elems(li)%k=j
295  ENDIF
296  ENDDO
297 
298 
299  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Tensor utility module.
Definition: tensor.f90:18
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul2 ( type(coolist), dimension(ndim), intent(in)  coolist_ij,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a 2d sparse tensor with a vector: \({\displaystyle \sum_{j=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \).

Parameters
coolist_ija coordinate list (sparse tensor) of which index 2 will be contracted.
arr_jthe vector to be contracted with index 2 of coolist_ijk
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_j as a result buffer, as this operation does multiple passes.

Definition at line 221 of file tensor.f90.

221  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ij
222  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
223  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
224  INTEGER :: i,j,n
225  res=0.d0
226  DO i=1,ndim
227  DO n=1,coolist_ij(i)%nelems
228  j=coolist_ij(i)%elems(n)%j
229  res(i) = res(i) + coolist_ij(i)%elems(n)%v * arr_j(j)
230  END DO
231  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul2_j ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a 3d sparse tensor with a vectors: \({\displaystyle \sum_{j=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \).

Parameters
coolist_ijka coordinate list (sparse tensor) of which index 2 will be contracted.
arr_jthe vector to be contracted with index 2 of coolist_ijk
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_j as a result buffer, as this operation does multiple passes.

Definition at line 1024 of file tensor.f90.

1024  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
1025  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
1026  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
1027  INTEGER :: i,j,n
1028  res=0.d0
1029  DO i=1,ndim
1030  DO n=1,coolist_ijk(i)%nelems
1031  j=coolist_ijk(i)%elems(n)%j
1032  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_j(j)
1033  END DO
1034  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul2_k ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_k,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a rank-3 sparse tensor coolist with a vector: \({\displaystyle \sum_{k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_k \).

Parameters
coolist_ijka coordinate list (sparse tensor) of which index k will be contracted.
arr_kthe vector to be contracted with index k of coolist_ijk
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_k as a result buffer, as this operation does multiple passes.

Definition at line 1045 of file tensor.f90.

1045  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
1046  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k
1047  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
1048  INTEGER :: i,k,n
1049  res=0.d0
1050  DO i=1,ndim
1051  DO n=1,coolist_ijk(i)%nelems
1052  k=coolist_ijk(i)%elems(n)%k
1053  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_k(k)
1054  END DO
1055  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul3 ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
real(kind=8), dimension(0:ndim), intent(in)  arr_k,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a tensor with two vectors: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \,b_k\).

Parameters
coolist_ijka coordinate list (sparse tensor) of which index 2 and 3 will be contracted.
arr_jthe vector to be contracted with index 2 of coolist_ijk
arr_kthe vector to be contracted with index 3 of coolist_ijk
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_j/arr_k as a result buffer, as this operation does multiple passes.

Definition at line 129 of file tensor.f90.

129  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
130  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j, arr_k
131  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
132  INTEGER :: i,j,k,n
133  res=0.d0
134  DO i=1,ndim
135  DO n=1,coolist_ijk(i)%nelems
136  j=coolist_ijk(i)%elems(n)%j
137  k=coolist_ijk(i)%elems(n)%k
138  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_j(j)*arr_k(k)
139  END DO
140  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul3_mat ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(0:ndim), intent(in)  arr_k,
real(kind=8), dimension(ndim,ndim), intent(out)  res 
)

Sparse multiplication of a rank-3 tensor coolist with a vector: \({\displaystyle \sum_{k=0}^{ndim}} \mathcal{T}_{i,j,k} \, b_k\). Its output is a matrix.

Parameters
coolist_ijka coolist (sparse tensor) of which index k will be contracted.
arr_kthe vector to be contracted with index k of coolist_ijk
resmatrix (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_k as a result buffer, as this operation does multiple passes.

Definition at line 948 of file tensor.f90.

948  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
949  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k
950  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
951  INTEGER :: i,j,k,n
952  res=0.d0
953  DO i=1,ndim
954  DO n=1,coolist_ijk(i)%nelems
955  j=coolist_ijk(i)%elems(n)%j
956  IF (j /= 0) THEN
957  k=coolist_ijk(i)%elems(n)%k
958  res(i,j) = res(i,j) + coolist_ijk(i)%elems(n)%v * arr_k(k)
959  ENDIF
960  END DO
961  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul3_with_mat ( type(coolist), dimension(ndim), intent(in)  coolist_ijk,
real(kind=8), dimension(ndim,ndim), intent(in)  mat_jk,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a rank-3 tensor coolist with a matrix: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, m_{j,k}\).

Parameters
coolist_ijka coolist (sparse tensor) of which index j and k will be contracted.
mat_jkthe matrix to be contracted with index j and k of coolist_ijk
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass mat_jk as a result buffer, as this operation does multiple passes.

Definition at line 1220 of file tensor.f90.

1220  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
1221  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_jk
1222  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
1223  INTEGER i,j,k,n
1224 
1225  res=0.d0
1226  DO i=1,ndim
1227  DO n=1,coolist_ijk(i)%nelems
1228  j=coolist_ijk(i)%elems(n)%j
1229  k=coolist_ijk(i)%elems(n)%k
1230 
1231  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * mat_jk(j,k)
1232  ENDDO
1233  END DO
1234 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::sparse_mul4 ( type(coolist4), dimension(ndim), intent(in)  coolist_ijkl,
real(kind=8), dimension(0:ndim), intent(in)  arr_j,
real(kind=8), dimension(0:ndim), intent(in)  arr_k,
real(kind=8), dimension(0:ndim), intent(in)  arr_l,
real(kind=8), dimension(0:ndim), intent(out)  res 
)

Sparse multiplication of a rank-4 tensor coolist with three vectors: \({\displaystyle \sum_{j,k,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, a_j \,b_k \, c_l \).

Parameters
coolist_ijkla coolist (sparse tensor) of which index j, k and l will be contracted.
arr_jthe vector to be contracted with index j of coolist_ijkl
arr_kthe vector to be contracted with index k of coolist_ijkl
arr_lthe vector to be contracted with index l of coolist_ijkl
resvector (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_j/arr_k/arr_l as a result buffer, as this operation does multiple passes.

Definition at line 974 of file tensor.f90.

974  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
975  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j, arr_k, arr_l
976  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
977  INTEGER :: i,j,k,n,l
978  res=0.d0
979  DO i=1,ndim
980  DO n=1,coolist_ijkl(i)%nelems
981  j=coolist_ijkl(i)%elems(n)%j
982  k=coolist_ijkl(i)%elems(n)%k
983  l=coolist_ijkl(i)%elems(n)%l
984  res(i) = res(i) + coolist_ijkl(i)%elems(n)%v * arr_j(j)*arr_k(k)*arr_l(l)
985  END DO
986  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::sparse_mul4_mat ( type(coolist4), dimension(ndim), intent(in)  coolist_ijkl,
real(kind=8), dimension(0:ndim), intent(in)  arr_k,
real(kind=8), dimension(0:ndim), intent(in)  arr_l,
real(kind=8), dimension(ndim,ndim), intent(out)  res 
)

Sparse multiplication of a tensor with two vectors: \({\displaystyle \sum_{k,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \,b_k \, c_l \).

Parameters
coolist_ijkla coordinate list (sparse tensor) of which index 3 and 4 will be contracted.
arr_kthe vector to be contracted with index 3 of coolist_ijkl
arr_lthe vector to be contracted with index 4 of coolist_ijkl
resmatrix (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass arr_k/arr_l as a result buffer, as this operation does multiple passes.

Definition at line 998 of file tensor.f90.

998  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
999  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k, arr_l
1000  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
1001  INTEGER :: i,j,k,n,l
1002  res=0.d0
1003  DO i=1,ndim
1004  DO n=1,coolist_ijkl(i)%nelems
1005  j=coolist_ijkl(i)%elems(n)%j
1006  IF (j /= 0) THEN
1007  k=coolist_ijkl(i)%elems(n)%k
1008  l=coolist_ijkl(i)%elems(n)%l
1009  res(i,j) = res(i,j) + coolist_ijkl(i)%elems(n)%v * arr_k(k) * arr_l(l)
1010  ENDIF
1011  END DO
1012  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::sparse_mul4_with_mat_jl ( type(coolist4), dimension(ndim), intent(in)  coolist_ijkl,
real(kind=8), dimension(ndim,ndim), intent(in)  mat_jl,
real(kind=8), dimension(ndim,ndim), intent(out)  res 
)

Sparse multiplication of a rank-4 tensor coolist with a matrix : \({\displaystyle \sum_{j,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, m_{j,l} \).

Parameters
coolist_ijkla coolist (sparse tensor) of which index j and l will be contracted.
mat_jlthe matrix to be contracted with indices j and l of coolist_ijkl
resmatrix (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass mat_jl as a result buffer, as this operation does multiple passes.

Definition at line 1169 of file tensor.f90.

1169  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
1170  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_jl
1171  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
1172  INTEGER i,j,k,l,n
1173 
1174  res=0.d0
1175  DO i=1,ndim
1176  DO n=1,coolist_ijkl(i)%nelems
1177  j=coolist_ijkl(i)%elems(n)%j
1178  k=coolist_ijkl(i)%elems(n)%k
1179  l=coolist_ijkl(i)%elems(n)%l
1180 
1181  res(i,k) = res(i,k) + coolist_ijkl(i)%elems(n)%v * mat_jl(j,l)
1182  ENDDO
1183  END DO
1184 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::sparse_mul4_with_mat_kl ( type(coolist4), dimension(ndim), intent(in)  coolist_ijkl,
real(kind=8), dimension(ndim,ndim), intent(in)  mat_kl,
real(kind=8), dimension(ndim,ndim), intent(out)  res 
)

Sparse multiplication of a rank-4 tensor coolist with a matrix : \({\displaystyle \sum_{j,l=0}^{ndim}} \mathcal{T}_{i,j,k,l} \, m_{k,l} \).

Parameters
coolist_ijkla coolist (sparse tensor) of which index k and l will be contracted.
mat_klthe matrix to be contracted with indices k and l of coolist_ijkl
resmatrix (buffer) to store the result of the contraction
Remarks
Note that it is NOT safe to pass mat_kl as a result buffer, as this operation does multiple passes.

Definition at line 1194 of file tensor.f90.

1194  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
1195  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_kl
1196  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
1197  INTEGER i,j,k,l,n
1198 
1199  res=0.d0
1200  DO i=1,ndim
1201  DO n=1,coolist_ijkl(i)%nelems
1202  j=coolist_ijkl(i)%elems(n)%j
1203  k=coolist_ijkl(i)%elems(n)%k
1204  l=coolist_ijkl(i)%elems(n)%l
1205 
1206  res(i,j) = res(i,j) + coolist_ijkl(i)%elems(n)%v * mat_kl(k,l)
1207  ENDDO
1208  END DO
1209 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
logical function, public tensor::tensor4_empty ( type(coolist4), dimension(ndim), intent(in)  t)

Test if a rank-4 tensor coolist is empty.

Parameters
trank-4 tensor coolist to be tested

Definition at line 1304 of file tensor.f90.

1304  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
1305  LOGICAL :: tensor4_empty
1306  INTEGER :: i
1307  tensor4_empty=.true.
1308  DO i=1,ndim
1309  IF (t(i)%nelems /= 0) THEN
1310  tensor4_empty=.false.
1311  RETURN
1312  ENDIF
1313  END DO
1314  RETURN
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::tensor4_to_coo4 ( real(kind=8), dimension(ndim,0:ndim,0:ndim,0:ndim), intent(in)  src,
type(coolist4), dimension(ndim), intent(out)  dst 
)

Routine to convert a rank-4 tensor from matrix to coolist representation.

Parameters
srcSource matrix
dstDestination coolist
Remarks
The destination coolist have to be an empty one, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 883 of file tensor.f90.

883  REAL(KIND=8), DIMENSION(ndim,0:ndim,0:ndim,0:ndim), INTENT(IN) :: src
884  TYPE(coolist4), DIMENSION(ndim), INTENT(OUT) :: dst
885  INTEGER :: i,j,k,l,n,allocstat
886 
887  DO i=1,ndim
888  n=0
889  DO j=0,ndim
890  DO k=0,ndim
891  DO l=0,ndim
892  IF (abs(src(i,j,k,l))>real_eps) n=n+1
893  ENDDO
894  ENDDO
895  ENDDO
896  IF (n/=0) THEN
897  IF (dst(i)%nelems/=0) stop "*** tensor_to_coo : Destination coolist not empty ! ***"
898  ALLOCATE(dst(i)%elems(n), stat=allocstat)
899  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
900  n=0
901  DO j=0,ndim
902  DO k=0,ndim
903  DO l=0,ndim
904  IF (abs(src(i,j,k,l))>real_eps) THEN
905  n=n+1
906  dst(i)%elems(n)%j=j
907  dst(i)%elems(n)%k=k
908  dst(i)%elems(n)%l=l
909  dst(i)%elems(n)%v=src(i,j,k,l)
910  ENDIF
911  ENDDO
912  ENDDO
913  ENDDO
914  ENDIF
915  dst(i)%nelems=n
916  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
logical function, public tensor::tensor_empty ( type(coolist), dimension(ndim), intent(in)  t)

Test if a rank-3 tensor coolist is empty.

Parameters
trank-3 tensor coolist to be tested

Definition at line 1288 of file tensor.f90.

1288  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: t
1289  LOGICAL :: tensor_empty
1290  INTEGER :: i
1291  tensor_empty=.true.
1292  DO i=1,ndim
1293  IF (t(i)%nelems /= 0) THEN
1294  tensor_empty=.false.
1295  RETURN
1296  ENDIF
1297  END DO
1298  RETURN
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::tensor_to_coo ( real(kind=8), dimension(ndim,0:ndim,0:ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(out)  dst 
)

Routine to convert a rank-3 tensor from matrix to coolist representation.

Parameters
srcSource matrix
dstDestination coolist
Remarks
The destination coolist have to be an empty one, i.e. with unallocated list of elements and nelems set to 0.

Definition at line 847 of file tensor.f90.

847  REAL(KIND=8), DIMENSION(ndim,0:ndim,0:ndim), INTENT(IN) :: src
848  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
849  INTEGER :: i,j,k,n,allocstat
850 
851  DO i=1,ndim
852  n=0
853  DO j=0,ndim
854  DO k=0,ndim
855  IF (abs(src(i,j,k))>real_eps) n=n+1
856  ENDDO
857  ENDDO
858  IF (n/=0) THEN
859  IF (dst(i)%nelems/=0) stop "*** tensor_to_coo : Destination coolist not empty ! ***"
860  ALLOCATE(dst(i)%elems(n), stat=allocstat)
861  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
862  n=0
863  DO j=0,ndim
864  DO k=0,ndim
865  IF (abs(src(i,j,k))>real_eps) THEN
866  n=n+1
867  dst(i)%elems(n)%j=j
868  dst(i)%elems(n)%k=k
869  dst(i)%elems(n)%v=src(i,j,k)
870  ENDIF
871  ENDDO
872  ENDDO
873  ENDIF
874  dst(i)%nelems=n
875  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Statistics accumulators.
Definition: stat.f90:14
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::write_tensor4_to_file ( character (len=*), intent(in)  s,
type(coolist4), dimension(ndim), intent(in)  t 
)

Load a rank-4 tensor coolist from a file definition.

Parameters
sDestination filename
tThe coolist to write

Definition at line 1349 of file tensor.f90.

1349  CHARACTER (LEN=*), INTENT(IN) :: s
1350  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
1351  INTEGER :: i,j,k,l,n
1352  OPEN(30,file=s)
1353  DO i=1,ndim
1354  WRITE(30,*) i,t(i)%nelems
1355  DO n=1,t(i)%nelems
1356  j=t(i)%elems(n)%j
1357  k=t(i)%elems(n)%k
1358  l=t(i)%elems(n)%l
1359  WRITE(30,*) i,j,k,l,t(i)%elems(n)%v
1360  END DO
1361  END DO
1362  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44
subroutine, public tensor::write_tensor_to_file ( character (len=*), intent(in)  s,
type(coolist), dimension(ndim), intent(in)  t 
)

Load a rank-4 tensor coolist from a file definition.

Parameters
sDestination filename
tThe coolist to write

Definition at line 425 of file tensor.f90.

425  CHARACTER (LEN=*), INTENT(IN) :: s
426  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: t
427  INTEGER :: i,j,k,n
428  OPEN(30,file=s)
429  DO i=1,ndim
430  WRITE(30,*) i,t(i)%nelems
431  DO n=1,t(i)%nelems
432  j=t(i)%elems(n)%j
433  k=t(i)%elems(n)%k
434  WRITE(30,*) i,j,k,t(i)%elems(n)%v
435  END DO
436  END DO
437  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38

Variable Documentation

real(kind=8), parameter tensor::real_eps = 2.2204460492503131e-16

Parameter to test the equality with zero.

Definition at line 50 of file tensor.f90.

50  REAL(KIND=8), PARAMETER :: real_eps = 2.2204460492503131e-16