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_tensor (src, dst)
 Routine to copy a rank-3 tensor. More...
 
subroutine, public add_to_tensor (src, dst)
 Routine to add a rank-3 tensor to another one. 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 mat_to_coo (src, dst)
 Routine to convert a matrix to a rank-3 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_tensor (t)
 Routine to print a rank 3 tensor coolist. More...
 
subroutine, public print_tensor4 (t)
 Routine to print a rank-4 tensor coolist. More...
 
subroutine, public sparse_mul3 (coolist_ijk, arr_j, arr_k, res)
 Sparse multiplication of a rank-3 tensor coolist with two vectors: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \,b_k\). 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 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_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 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 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_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 144 of file tensor.f90.

144  INTEGER, INTENT(IN) :: i
145  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
146  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
147  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
148  INTEGER :: j,k,r,n,nsrc,allocstat
149 
150  nsrc=0
151  DO j=1,ndim
152  DO k=1,ndim
153  IF (abs(src(j,k))>real_eps) nsrc=nsrc+1
154  END DO
155  END DO
156 
157  IF (dst(i)%nelems==0) THEN
158  IF (ALLOCATED(dst(i)%elems)) THEN
159  DEALLOCATE(dst(i)%elems, stat=allocstat)
160  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
161  ENDIF
162  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
163  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
164  n=0
165  ELSE
166  n=dst(i)%nelems
167  ALLOCATE(celems(n), stat=allocstat)
168  DO j=1,n
169  celems(j)%j=dst(i)%elems(j)%j
170  celems(j)%k=dst(i)%elems(j)%k
171  celems(j)%v=dst(i)%elems(j)%v
172  ENDDO
173  DEALLOCATE(dst(i)%elems, stat=allocstat)
174  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
175  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
176  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
177  DO j=1,n
178  dst(i)%elems(j)%j=celems(j)%j
179  dst(i)%elems(j)%k=celems(j)%k
180  dst(i)%elems(j)%v=celems(j)%v
181  ENDDO
182  DEALLOCATE(celems, stat=allocstat)
183  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
184  ENDIF
185  r=0
186  DO j=1,ndim
187  DO k=1,ndim
188  IF (abs(src(j,k))>real_eps) THEN
189  r=r+1
190  dst(i)%elems(n+r)%j=j
191  dst(i)%elems(n+r)%k=k
192  dst(i)%elems(n+r)%v=src(j,k)
193  ENDIF
194  ENDDO
195  END DO
196  dst(i)%nelems=nsrc+n
197 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 206 of file tensor.f90.

206  INTEGER, INTENT(IN) :: i,j
207  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
208  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
209  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
210  INTEGER :: k,l,r,n,nsrc,allocstat
211 
212  nsrc=0
213  DO k=1,ndim
214  DO l=1,ndim
215  IF (abs(src(k,l))>real_eps) nsrc=nsrc+1
216  END DO
217  END DO
218 
219  IF (dst(i)%nelems==0) THEN
220  IF (ALLOCATED(dst(i)%elems)) THEN
221  DEALLOCATE(dst(i)%elems, stat=allocstat)
222  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
223  ENDIF
224  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
225  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
226  n=0
227  ELSE
228  n=dst(i)%nelems
229  ALLOCATE(celems(n), stat=allocstat)
230  DO k=1,n
231  celems(k)%j=dst(i)%elems(k)%j
232  celems(k)%k=dst(i)%elems(k)%k
233  celems(k)%l=dst(i)%elems(k)%l
234  celems(k)%v=dst(i)%elems(k)%v
235  ENDDO
236  DEALLOCATE(dst(i)%elems, stat=allocstat)
237  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
238  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
239  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
240  DO k=1,n
241  dst(i)%elems(k)%j=celems(k)%j
242  dst(i)%elems(k)%k=celems(k)%k
243  dst(i)%elems(k)%l=celems(k)%l
244  dst(i)%elems(k)%v=celems(k)%v
245  ENDDO
246  DEALLOCATE(celems, stat=allocstat)
247  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
248  ENDIF
249  r=0
250  DO k=1,ndim
251  DO l=1,ndim
252  IF (abs(src(k,l))>real_eps) THEN
253  r=r+1
254  dst(i)%elems(n+r)%j=j
255  dst(i)%elems(n+r)%k=k
256  dst(i)%elems(n+r)%l=l
257  dst(i)%elems(n+r)%v=src(k,l)
258  ENDIF
259  ENDDO
260  END DO
261  dst(i)%nelems=nsrc+n
262 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 92 of file tensor.f90.

92  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
93  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
94  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
95  INTEGER :: i,j,n,allocstat
96 
97  DO i=1,ndim
98  IF (src(i)%nelems/=0) THEN
99  IF (dst(i)%nelems==0) THEN
100  IF (ALLOCATED(dst(i)%elems)) THEN
101  DEALLOCATE(dst(i)%elems, stat=allocstat)
102  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
103  ENDIF
104  ALLOCATE(dst(i)%elems(src(i)%nelems), stat=allocstat)
105  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
106  n=0
107  ELSE
108  n=dst(i)%nelems
109  ALLOCATE(celems(n), stat=allocstat)
110  DO j=1,n
111  celems(j)%j=dst(i)%elems(j)%j
112  celems(j)%k=dst(i)%elems(j)%k
113  celems(j)%v=dst(i)%elems(j)%v
114  ENDDO
115  DEALLOCATE(dst(i)%elems, stat=allocstat)
116  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
117  ALLOCATE(dst(i)%elems(src(i)%nelems+n), stat=allocstat)
118  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
119  DO j=1,n
120  dst(i)%elems(j)%j=celems(j)%j
121  dst(i)%elems(j)%k=celems(j)%k
122  dst(i)%elems(j)%v=celems(j)%v
123  ENDDO
124  DEALLOCATE(celems, stat=allocstat)
125  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
126  ENDIF
127  DO j=1,src(i)%nelems
128  dst(i)%elems(n+j)%j=src(i)%elems(j)%j
129  dst(i)%elems(n+j)%k=src(i)%elems(j)%k
130  dst(i)%elems(n+j)%v=src(i)%elems(j)%v
131  ENDDO
132  dst(i)%nelems=src(i)%nelems+n
133  ENDIF
134  ENDDO
135 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 454 of file tensor.f90.

454  INTEGER, INTENT(IN) :: i,j,k
455  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
456  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
457  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
458  INTEGER :: l,ne,r,n,nsrc,allocstat
459 
460  nsrc=0
461  DO l=1,ndim
462  IF (abs(src(l))>real_eps) nsrc=nsrc+1
463  ENDDO
464 
465  IF (dst(i)%nelems==0) THEN
466  IF (ALLOCATED(dst(i)%elems)) THEN
467  DEALLOCATE(dst(i)%elems, stat=allocstat)
468  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
469  ENDIF
470  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
471  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
472  n=0
473  ELSE
474  n=dst(i)%nelems
475  ALLOCATE(celems(n), stat=allocstat)
476  DO ne=1,n
477  celems(ne)%j=dst(i)%elems(ne)%j
478  celems(ne)%k=dst(i)%elems(ne)%k
479  celems(ne)%l=dst(i)%elems(ne)%l
480  celems(ne)%v=dst(i)%elems(ne)%v
481  ENDDO
482  DEALLOCATE(dst(i)%elems, stat=allocstat)
483  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
484  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
485  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
486  DO ne=1,n
487  dst(i)%elems(ne)%j=celems(ne)%j
488  dst(i)%elems(ne)%k=celems(ne)%k
489  dst(i)%elems(ne)%l=celems(ne)%l
490  dst(i)%elems(ne)%v=celems(ne)%v
491  ENDDO
492  DEALLOCATE(celems, stat=allocstat)
493  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
494  ENDIF
495  r=0
496  DO l=1,ndim
497  IF (abs(src(l))>real_eps) THEN
498  r=r+1
499  dst(i)%elems(n+r)%j=j
500  dst(i)%elems(n+r)%k=k
501  dst(i)%elems(n+r)%l=l
502  dst(i)%elems(n+r)%v=src(l)
503  ENDIF
504  ENDDO
505  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 395 of file tensor.f90.

395  INTEGER, INTENT(IN) :: i,k,l
396  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
397  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
398  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
399  INTEGER :: j,ne,r,n,nsrc,allocstat
400 
401  nsrc=0
402  DO j=1,ndim
403  IF (abs(src(j))>real_eps) nsrc=nsrc+1
404  ENDDO
405 
406  IF (dst(i)%nelems==0) THEN
407  IF (ALLOCATED(dst(i)%elems)) THEN
408  DEALLOCATE(dst(i)%elems, stat=allocstat)
409  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
410  ENDIF
411  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
412  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
413  n=0
414  ELSE
415  n=dst(i)%nelems
416  ALLOCATE(celems(n), stat=allocstat)
417  DO ne=1,n
418  celems(ne)%j=dst(i)%elems(ne)%j
419  celems(ne)%k=dst(i)%elems(ne)%k
420  celems(ne)%l=dst(i)%elems(ne)%l
421  celems(ne)%v=dst(i)%elems(ne)%v
422  ENDDO
423  DEALLOCATE(dst(i)%elems, stat=allocstat)
424  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
425  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
426  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
427  DO ne=1,n
428  dst(i)%elems(ne)%j=celems(ne)%j
429  dst(i)%elems(ne)%k=celems(ne)%k
430  dst(i)%elems(ne)%l=celems(ne)%l
431  dst(i)%elems(ne)%v=celems(ne)%v
432  ENDDO
433  DEALLOCATE(celems, stat=allocstat)
434  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
435  ENDIF
436  r=0
437  DO j=1,ndim
438  IF (abs(src(j))>real_eps) THEN
439  r=r+1
440  dst(i)%elems(n+r)%j=j
441  dst(i)%elems(n+r)%k=k
442  dst(i)%elems(n+r)%l=l
443  dst(i)%elems(n+r)%v=src(j)
444  ENDIF
445  ENDDO
446  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 326 of file tensor.f90.

326  INTEGER, INTENT(IN) :: i,k,l
327  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
328  TYPE(coolist4), DIMENSION(ndim), INTENT(INOUT) :: dst
329  TYPE(coolist_elem4), DIMENSION(:), ALLOCATABLE :: celems
330  INTEGER :: j,ne,r,n,nsrc,allocstat
331 
332  nsrc=0
333  DO j=1,ndim
334  IF (abs(src(j))>real_eps) nsrc=nsrc+1
335  ENDDO
336  nsrc=nsrc*3
337  IF (dst(i)%nelems==0) THEN
338  IF (ALLOCATED(dst(i)%elems)) THEN
339  DEALLOCATE(dst(i)%elems, stat=allocstat)
340  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
341  ENDIF
342  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
343  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
344  n=0
345  ELSE
346  n=dst(i)%nelems
347  ALLOCATE(celems(n), stat=allocstat)
348  DO ne=1,n
349  celems(ne)%j=dst(i)%elems(ne)%j
350  celems(ne)%k=dst(i)%elems(ne)%k
351  celems(ne)%l=dst(i)%elems(ne)%l
352  celems(ne)%v=dst(i)%elems(ne)%v
353  ENDDO
354  DEALLOCATE(dst(i)%elems, stat=allocstat)
355  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
356  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
357  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
358  DO ne=1,n
359  dst(i)%elems(ne)%j=celems(ne)%j
360  dst(i)%elems(ne)%k=celems(ne)%k
361  dst(i)%elems(ne)%l=celems(ne)%l
362  dst(i)%elems(ne)%v=celems(ne)%v
363  ENDDO
364  DEALLOCATE(celems, stat=allocstat)
365  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
366  ENDIF
367  r=0
368  DO j=1,ndim
369  IF (abs(src(j))>real_eps) THEN
370  r=r+1
371  dst(i)%elems(n+r)%j=j
372  dst(i)%elems(n+r)%k=k
373  dst(i)%elems(n+r)%l=l
374  dst(i)%elems(n+r)%v=src(j)
375  r=r+1
376  dst(i)%elems(n+r)%j=k
377  dst(i)%elems(n+r)%k=l
378  dst(i)%elems(n+r)%l=j
379  dst(i)%elems(n+r)%v=src(j)
380  r=r+1
381  dst(i)%elems(n+r)%j=l
382  dst(i)%elems(n+r)%k=j
383  dst(i)%elems(n+r)%l=k
384  dst(i)%elems(n+r)%v=src(j)
385  ENDIF
386  ENDDO
387  dst(i)%nelems=nsrc+n
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 271 of file tensor.f90.

271  INTEGER, INTENT(IN) :: j,k
272  REAL(KIND=8), DIMENSION(ndim), INTENT(IN) :: src
273  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: dst
274  TYPE(coolist_elem), DIMENSION(:), ALLOCATABLE :: celems
275  INTEGER :: i,l,r,n,nsrc,allocstat
276 
277  DO i=1,ndim
278  nsrc=0
279  IF (abs(src(i))>real_eps) nsrc=1
280  IF (dst(i)%nelems==0) THEN
281  IF (ALLOCATED(dst(i)%elems)) THEN
282  DEALLOCATE(dst(i)%elems, stat=allocstat)
283  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
284  ENDIF
285  ALLOCATE(dst(i)%elems(nsrc), stat=allocstat)
286  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
287  n=0
288  ELSE
289  n=dst(i)%nelems
290  ALLOCATE(celems(n), stat=allocstat)
291  DO l=1,n
292  celems(l)%j=dst(i)%elems(l)%j
293  celems(l)%k=dst(i)%elems(l)%k
294  celems(l)%v=dst(i)%elems(l)%v
295  ENDDO
296  DEALLOCATE(dst(i)%elems, stat=allocstat)
297  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
298  ALLOCATE(dst(i)%elems(nsrc+n), stat=allocstat)
299  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
300  DO l=1,n
301  dst(i)%elems(l)%j=celems(l)%j
302  dst(i)%elems(l)%k=celems(l)%k
303  dst(i)%elems(l)%v=celems(l)%v
304  ENDDO
305  DEALLOCATE(celems, stat=allocstat)
306  IF (allocstat /= 0) stop "*** Deallocation problem ! ***"
307  ENDIF
308  r=0
309  IF (abs(src(i))>real_eps) THEN
310  r=r+1
311  dst(i)%elems(n+r)%j=j
312  dst(i)%elems(n+r)%k=k
313  dst(i)%elems(n+r)%v=src(i)
314  ENDIF
315  dst(i)%nelems=nsrc+n
316  END DO
317 
318 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 971 of file tensor.f90.

971  INTEGER, INTENT(IN) :: i
972  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
973  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
974  INTEGER :: n
975 
976  dst=0.d0
977  DO n=1,src(i)%nelems
978  dst(src(i)%elems(n)%j,src(i)%elems(n)%k)=src(i)%elems(n)%v
979  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 938 of file tensor.f90.

938  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
939  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
940  INTEGER :: i,n
941 
942  dst=0.d0
943  DO i=1,ndim
944  DO n=1,src(i)%nelems
945  dst(i,src(i)%elems(n)%j)=src(i)%elems(n)%v
946  ENDDO
947  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 922 of file tensor.f90.

922  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
923  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
924  INTEGER :: i,n
925 
926  dst=0.d0
927  DO i=1,ndim
928  DO n=1,src(i)%nelems
929  dst(i,src(i)%elems(n)%k)=src(i)%elems(n)%v
930  ENDDO
931  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1007 of file tensor.f90.

1007  INTEGER, INTENT(IN) :: j
1008  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
1009  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: dst
1010  INTEGER :: i,n
1011 
1012  dst=0.d0
1013  DO i=1,ndim
1014  DO n=1,src(i)%nelems
1015  IF (src(i)%elems(n)%j==j) dst(i,src(i)%elems(n)%k)=src(i)%elems(n)%v
1016  ENDDO
1017  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 988 of file tensor.f90.

988  INTEGER, INTENT(IN) :: j,k
989  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
990  REAL(KIND=8), DIMENSION(ndim), INTENT(OUT) :: dst
991  INTEGER :: i,n
992 
993  dst=0.d0
994  DO i=1,ndim
995  DO n=1,src(i)%nelems
996  IF ((src(i)%elems(n)%j==j).and.(src(i)%elems(n)%k==k)) dst(i)=src(i)%elems(n)%v
997  END DO
998  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
Coordinate list. Type used to represent the sparse tensor.
Definition: tensor.f90:38
subroutine, public tensor::copy_tensor ( type(coolist), dimension(ndim), intent(in)  src,
type(coolist), dimension(ndim), intent(out)  dst 
)

Routine to copy a rank-3 tensor.

Parameters
srcSource tensor
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 71 of file tensor.f90.

71  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: src
72  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
73  INTEGER :: i,j,allocstat
74 
75  DO i=1,ndim
76  IF (dst(i)%nelems/=0) stop "*** copy_tensor : Destination coolist not empty ! ***"
77  ALLOCATE(dst(i)%elems(src(i)%nelems), stat=allocstat)
78  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
79  DO j=1,src(i)%nelems
80  dst(i)%elems(j)%j=src(i)%elems(j)%j
81  dst(i)%elems(j)%k=src(i)%elems(j)%k
82  dst(i)%elems(j)%v=src(i)%elems(j)%v
83  ENDDO
84  dst(i)%nelems=src(i)%nelems
85  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 767 of file tensor.f90.

767  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
768  TYPE(coolist), DIMENSION(ndim), INTENT(OUT):: jcoo_ij
769  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
770  REAL(KIND=8) :: v
771  INTEGER :: i,j,k,n,nj,allocstat
772  DO i=1,ndim
773  IF (jcoo_ij(i)%nelems/=0) stop "*** jsparse_mul : Destination coolist not empty ! ***"
774  nj=2*coolist_ijk(i)%nelems
775  ALLOCATE(jcoo_ij(i)%elems(nj), stat=allocstat)
776  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
777  nj=0
778  DO n=1,coolist_ijk(i)%nelems
779  j=coolist_ijk(i)%elems(n)%j
780  k=coolist_ijk(i)%elems(n)%k
781  v=coolist_ijk(i)%elems(n)%v
782  IF (j /=0) THEN
783  nj=nj+1
784  jcoo_ij(i)%elems(nj)%j=j
785  jcoo_ij(i)%elems(nj)%k=0
786  jcoo_ij(i)%elems(nj)%v=v*arr_j(k)
787  END IF
788 
789  IF (k /=0) THEN
790  nj=nj+1
791  jcoo_ij(i)%elems(nj)%j=k
792  jcoo_ij(i)%elems(nj)%k=0
793  jcoo_ij(i)%elems(nj)%v=v*arr_j(j)
794  END IF
795  END DO
796  jcoo_ij(i)%nelems=nj
797  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 810 of file tensor.f90.

810  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
811  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT):: jcoo_ij
812  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
813  REAL(KIND=8) :: v
814  INTEGER :: i,j,k,n
815  jcoo_ij=0.d0
816  DO i=1,ndim
817  DO n=1,coolist_ijk(i)%nelems
818  j=coolist_ijk(i)%elems(n)%j
819  k=coolist_ijk(i)%elems(n)%k
820  v=coolist_ijk(i)%elems(n)%v
821  IF (j /=0) jcoo_ij(i,j)=jcoo_ij(i,j)+v*arr_j(k)
822  IF (k /=0) jcoo_ij(i,k)=jcoo_ij(i,k)+v*arr_j(j)
823  END DO
824  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1181 of file tensor.f90.

1181  CHARACTER (LEN=*), INTENT(IN) :: s
1182  TYPE(coolist4), DIMENSION(ndim), INTENT(OUT) :: t
1183  INTEGER :: i,ir,j,k,l,n,allocstat
1184  REAL(KIND=8) :: v
1185  OPEN(30,file=s,status='old')
1186  DO i=1,ndim
1187  READ(30,*) ir,n
1188  IF (n /= 0) THEN
1189  ALLOCATE(t(i)%elems(n), stat=allocstat)
1190  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
1191  t(i)%nelems=n
1192  ENDIF
1193  DO n=1,t(i)%nelems
1194  READ(30,*) ir,j,k,l,v
1195  t(i)%elems(n)%j=j
1196  t(i)%elems(n)%k=k
1197  t(i)%elems(n)%l=l
1198  t(i)%elems(n)%v=v
1199  ENDDO
1200  END DO
1201  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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::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 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 k component will be set to 0.

Definition at line 515 of file tensor.f90.

515  REAL(KIND=8), DIMENSION(0:ndim,0:ndim), INTENT(IN) :: src
516  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
517  INTEGER :: i,j,n,allocstat
518  DO i=1,ndim
519  n=0
520  DO j=1,ndim
521  IF (abs(src(i,j))>real_eps) n=n+1
522  ENDDO
523  IF (n/=0) THEN
524  IF (dst(i)%nelems/=0) stop "*** mat_to_coo : Destination coolist not empty ! ***"
525  ALLOCATE(dst(i)%elems(n), stat=allocstat)
526  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
527  n=0
528  DO j=1,ndim
529  IF (abs(src(i,j))>real_eps) THEN
530  n=n+1
531  dst(i)%elems(n)%j=j
532  dst(i)%elems(n)%k=0
533  dst(i)%elems(n)%v=src(i,j)
534  ENDIF
535  ENDDO
536  ENDIF
537  dst(i)%nelems=n
538  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1103 of file tensor.f90.

1103  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: src
1104  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
1105  INTEGER :: i,j,n,allocstat
1106  DO i=1,ndim
1107  n=0
1108  DO j=1,ndim
1109  IF (abs(src(i,j))>real_eps) n=n+1
1110  ENDDO
1111  IF (n/=0) THEN
1112  IF (dst(i)%nelems/=0) stop "*** mat_to_coo : Destination coolist not empty ! ***"
1113  ALLOCATE(dst(i)%elems(n), stat=allocstat)
1114  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
1115  n=0
1116  DO j=1,ndim
1117  IF (abs(src(i,j))>real_eps) THEN
1118  n=n+1
1119  dst(i)%elems(n)%j=0
1120  dst(i)%elems(n)%k=j
1121  dst(i)%elems(n)%v=src(i,j)
1122  ENDIF
1123  ENDDO
1124  ENDIF
1125  dst(i)%nelems=n
1126  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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)

Routine to print a rank 3 tensor coolist.

Parameters
tcoolist to print

Definition at line 622 of file tensor.f90.

622  USE util, only: str
623  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: t
624  INTEGER :: i,n,j,k
625  DO i=1,ndim
626  DO n=1,t(i)%nelems
627  j=t(i)%elems(n)%j
628  k=t(i)%elems(n)%k
629  IF( abs(t(i)%elems(n)%v) .GE. real_eps) THEN
630  write(*,"(A,ES12.5)") "tensor["//trim(str(i))//"]["//trim(str(j)) &
631  &//"]["//trim(str(k))//"] = ",t(i)%elems(n)%v
632  END IF
633  END DO
634  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
Utility module.
Definition: util.f90:12
character(len=20) function, public str(k)
Convert an integer to string.
Definition: util.f90:30
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 640 of file tensor.f90.

640  USE util, only: str
641  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
642  INTEGER :: i,n,j,k,l
643  DO i=1,ndim
644  DO n=1,t(i)%nelems
645  j=t(i)%elems(n)%j
646  k=t(i)%elems(n)%k
647  l=t(i)%elems(n)%l
648  IF( abs(t(i)%elems(n)%v) .GE. real_eps) THEN
649  write(*,"(A,ES12.5)") "tensor["//trim(str(i))//"]["//trim(str(j)) &
650  &//"]["//trim(str(k))//"]["//trim(str(l))//"] = ",t(i)%elems(n)%v
651  END IF
652  END DO
653  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
Utility module.
Definition: util.f90:12
character(len=20) function, public str(k)
Convert an integer to string.
Definition: util.f90:30
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 1133 of file tensor.f90.

1133  REAL(KIND=8), INTENT(IN) :: s
1134  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT) :: t
1135  INTEGER :: i,li,n
1136  DO i=1,ndim
1137  n=t(i)%nelems
1138  DO li=1,n
1139  t(i)%elems(li)%v=s*t(i)%elems(li)%v
1140  ENDDO
1141  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 874 of file tensor.f90.

874  TYPE(coolist), DIMENSION(ndim), INTENT(INOUT):: tensor
875  INTEGER :: i,j,k
876  INTEGER :: li,lii,liii,n
877  DO i= 1,ndim
878  n=tensor(i)%nelems
879  DO li=n,2,-1
880  j=tensor(i)%elems(li)%j
881  k=tensor(i)%elems(li)%k
882  DO lii=li-1,1,-1
883  IF ((j==tensor(i)%elems(lii)%j).AND.(k==tensor(i)%elems(lii)%k)) THEN
884  ! Found another entry with the same i,j,k: merge both into
885  ! the one listed first (of those two).
886  tensor(i)%elems(lii)%v=tensor(i)%elems(lii)%v+tensor(i)%elems(li)%v
887  ! Shift the rest of the items one place down.
888  DO liii=li+1,n
889  tensor(i)%elems(liii-1)%j=tensor(i)%elems(liii)%j
890  tensor(i)%elems(liii-1)%k=tensor(i)%elems(liii)%k
891  tensor(i)%elems(liii-1)%v=tensor(i)%elems(liii)%v
892  END DO
893  tensor(i)%nelems=tensor(i)%nelems-1
894  ! Here we should stop because the li no longer points to the
895  ! original i,j,k element
896  EXIT
897  ENDIF
898  ENDDO
899  ENDDO
900  n=tensor(i)%nelems
901  DO li=1,n
902  ! Clear new "almost" zero entries and shift rest of the items one place down.
903  ! Make sure not to skip any entries while shifting!
904  DO WHILE (abs(tensor(i)%elems(li)%v) < real_eps)
905  DO liii=li+1,n
906  tensor(i)%elems(liii-1)%j=tensor(i)%elems(liii)%j
907  tensor(i)%elems(liii-1)%k=tensor(i)%elems(liii)%k
908  tensor(i)%elems(liii-1)%v=tensor(i)%elems(liii)%v
909  ENDDO
910  tensor(i)%nelems=tensor(i)%nelems-1
911  ENDDO
912  ENDDO
913 
914  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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_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 835 of file tensor.f90.

835  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
836  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j
837  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
838  INTEGER :: i,j,n
839  res=0.d0
840  DO i=1,ndim
841  DO n=1,coolist_ijk(i)%nelems
842  j=coolist_ijk(i)%elems(n)%j
843  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_j(j)
844  END DO
845  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 856 of file tensor.f90.

856  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
857  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k
858  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
859  INTEGER :: i,k,n
860  res=0.d0
861  DO i=1,ndim
862  DO n=1,coolist_ijk(i)%nelems
863  k=coolist_ijk(i)%elems(n)%k
864  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_k(k)
865  END DO
866  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 rank-3 tensor coolist with two vectors: \({\displaystyle \sum_{j,k=0}^{ndim}} \mathcal{T}_{i,j,k} \, a_j \,b_k\).

Parameters
coolist_ijka coolist (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 666 of file tensor.f90.

666  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
667  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j, arr_k
668  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
669  INTEGER :: i,j,k,n
670  res=0.d0
671  DO i=1,ndim
672  DO n=1,coolist_ijk(i)%nelems
673  j=coolist_ijk(i)%elems(n)%j
674  k=coolist_ijk(i)%elems(n)%k
675  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * arr_j(j)*arr_k(k)
676  END DO
677  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 689 of file tensor.f90.

689  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
690  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k
691  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
692  INTEGER :: i,j,k,n
693  res=0.d0
694  DO i=1,ndim
695  DO n=1,coolist_ijk(i)%nelems
696  j=coolist_ijk(i)%elems(n)%j
697  IF (j /= 0) THEN
698  k=coolist_ijk(i)%elems(n)%k
699  res(i,j) = res(i,j) + coolist_ijk(i)%elems(n)%v * arr_k(k)
700  ENDIF
701  END DO
702  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1079 of file tensor.f90.

1079  TYPE(coolist), DIMENSION(ndim), INTENT(IN):: coolist_ijk
1080  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_jk
1081  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
1082  INTEGER i,j,k,n
1083 
1084  res=0.d0
1085  DO i=1,ndim
1086  DO n=1,coolist_ijk(i)%nelems
1087  j=coolist_ijk(i)%elems(n)%j
1088  k=coolist_ijk(i)%elems(n)%k
1089 
1090  res(i) = res(i) + coolist_ijk(i)%elems(n)%v * mat_jk(j,k)
1091  ENDDO
1092  END DO
1093 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 715 of file tensor.f90.

715  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
716  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_j, arr_k, arr_l
717  REAL(KIND=8), DIMENSION(0:ndim), INTENT(OUT) :: res
718  INTEGER :: i,j,k,n,l
719  res=0.d0
720  DO i=1,ndim
721  DO n=1,coolist_ijkl(i)%nelems
722  j=coolist_ijkl(i)%elems(n)%j
723  k=coolist_ijkl(i)%elems(n)%k
724  l=coolist_ijkl(i)%elems(n)%l
725  res(i) = res(i) + coolist_ijkl(i)%elems(n)%v * arr_j(j)*arr_k(k)*arr_l(l)
726  END DO
727  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 739 of file tensor.f90.

739  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
740  REAL(KIND=8), DIMENSION(0:ndim), INTENT(IN) :: arr_k, arr_l
741  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
742  INTEGER :: i,j,k,n,l
743  res=0.d0
744  DO i=1,ndim
745  DO n=1,coolist_ijkl(i)%nelems
746  j=coolist_ijkl(i)%elems(n)%j
747  IF (j /= 0) THEN
748  k=coolist_ijkl(i)%elems(n)%k
749  l=coolist_ijkl(i)%elems(n)%l
750  res(i,j) = res(i,j) + coolist_ijkl(i)%elems(n)%v * arr_k(k) * arr_l(l)
751  ENDIF
752  END DO
753  END DO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1028 of file tensor.f90.

1028  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
1029  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_jl
1030  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
1031  INTEGER i,j,k,l,n
1032 
1033  res=0.d0
1034  DO i=1,ndim
1035  DO n=1,coolist_ijkl(i)%nelems
1036  j=coolist_ijkl(i)%elems(n)%j
1037  k=coolist_ijkl(i)%elems(n)%k
1038  l=coolist_ijkl(i)%elems(n)%l
1039 
1040  res(i,k) = res(i,k) + coolist_ijkl(i)%elems(n)%v * mat_jl(j,l)
1041  ENDDO
1042  END DO
1043 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1053 of file tensor.f90.

1053  TYPE(coolist4), DIMENSION(ndim), INTENT(IN):: coolist_ijkl
1054  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(IN) :: mat_kl
1055  REAL(KIND=8), DIMENSION(ndim,ndim), INTENT(OUT) :: res
1056  INTEGER i,j,k,l,n
1057 
1058  res=0.d0
1059  DO i=1,ndim
1060  DO n=1,coolist_ijkl(i)%nelems
1061  j=coolist_ijkl(i)%elems(n)%j
1062  k=coolist_ijkl(i)%elems(n)%k
1063  l=coolist_ijkl(i)%elems(n)%l
1064 
1065  res(i,j) = res(i,j) + coolist_ijkl(i)%elems(n)%v * mat_kl(k,l)
1066  ENDDO
1067  END DO
1068 
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1163 of file tensor.f90.

1163  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
1164  LOGICAL :: tensor4_empty
1165  INTEGER :: i
1166  tensor4_empty=.true.
1167  DO i=1,ndim
1168  IF (t(i)%nelems /= 0) THEN
1169  tensor4_empty=.false.
1170  RETURN
1171  ENDIF
1172  END DO
1173  RETURN
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 583 of file tensor.f90.

583  REAL(KIND=8), DIMENSION(ndim,0:ndim,0:ndim,0:ndim), INTENT(IN) :: src
584  TYPE(coolist4), DIMENSION(ndim), INTENT(OUT) :: dst
585  INTEGER :: i,j,k,l,n,allocstat
586 
587  DO i=1,ndim
588  n=0
589  DO j=0,ndim
590  DO k=0,ndim
591  DO l=0,ndim
592  IF (abs(src(i,j,k,l))>real_eps) n=n+1
593  ENDDO
594  ENDDO
595  ENDDO
596  IF (n/=0) THEN
597  IF (dst(i)%nelems/=0) stop "*** tensor_to_coo : Destination coolist not empty ! ***"
598  ALLOCATE(dst(i)%elems(n), stat=allocstat)
599  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
600  n=0
601  DO j=0,ndim
602  DO k=0,ndim
603  DO l=0,ndim
604  IF (abs(src(i,j,k,l))>real_eps) THEN
605  n=n+1
606  dst(i)%elems(n)%j=j
607  dst(i)%elems(n)%k=k
608  dst(i)%elems(n)%l=l
609  dst(i)%elems(n)%v=src(i,j,k,l)
610  ENDIF
611  ENDDO
612  ENDDO
613  ENDDO
614  ENDIF
615  dst(i)%nelems=n
616  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1147 of file tensor.f90.

1147  TYPE(coolist), DIMENSION(ndim), INTENT(IN) :: t
1148  LOGICAL :: tensor_empty
1149  INTEGER :: i
1150  tensor_empty=.true.
1151  DO i=1,ndim
1152  IF (t(i)%nelems /= 0) THEN
1153  tensor_empty=.false.
1154  RETURN
1155  ENDIF
1156  END DO
1157  RETURN
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 547 of file tensor.f90.

547  REAL(KIND=8), DIMENSION(ndim,0:ndim,0:ndim), INTENT(IN) :: src
548  TYPE(coolist), DIMENSION(ndim), INTENT(OUT) :: dst
549  INTEGER :: i,j,k,n,allocstat
550 
551  DO i=1,ndim
552  n=0
553  DO j=0,ndim
554  DO k=0,ndim
555  IF (abs(src(i,j,k))>real_eps) n=n+1
556  ENDDO
557  ENDDO
558  IF (n/=0) THEN
559  IF (dst(i)%nelems/=0) stop "*** tensor_to_coo : Destination coolist not empty ! ***"
560  ALLOCATE(dst(i)%elems(n), stat=allocstat)
561  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
562  n=0
563  DO j=0,ndim
564  DO k=0,ndim
565  IF (abs(src(i,j,k))>real_eps) THEN
566  n=n+1
567  dst(i)%elems(n)%j=j
568  dst(i)%elems(n)%k=k
569  dst(i)%elems(n)%v=src(i,j,k)
570  ENDIF
571  ENDDO
572  ENDDO
573  ENDIF
574  dst(i)%nelems=n
575  ENDDO
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
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 1208 of file tensor.f90.

1208  CHARACTER (LEN=*), INTENT(IN) :: s
1209  TYPE(coolist4), DIMENSION(ndim), INTENT(IN) :: t
1210  INTEGER :: i,j,k,l,n
1211  OPEN(30,file=s)
1212  DO i=1,ndim
1213  WRITE(30,*) i,t(i)%nelems
1214  DO n=1,t(i)%nelems
1215  j=t(i)%elems(n)%j
1216  k=t(i)%elems(n)%k
1217  l=t(i)%elems(n)%l
1218  WRITE(30,*) i,j,k,l,t(i)%elems(n)%v
1219  END DO
1220  END DO
1221  CLOSE(30)
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:79
4d coordinate list. Type used to represent the rank-4 sparse tensor.
Definition: tensor.f90:44

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