← Back to branch summary

~siesta-maint/siesta/rel-4.1

« back to all changes in this revision

Viewing changes to Src/fdict/src/variable_pp.F90

  • Committer: Nick Papior
  • Date: 2018-12-06 14:20:30 UTC
  • Revision ID: nickpapior@gmail.com-20181206142030-m12ony85o87264aw
Updated fdict and ncdf to latest released versions

Now retrieving dcmplx also works as expected!

Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/fdict/src/variable_pp.F90
41
41
  ! To create a constant transfer data-type of the 
42
42
  ! pointer methods
43
43
  character(len=1) :: local_enc_type(1)
44
 
  
 
44
 
 
45
  ! Internal variable to hold the size of the "type" switch
 
46
  !> Maximum character length of the type specifier in the variable, no
 
47
  !! unique identifier may be longer than this.
 
48
  integer, parameter, public :: VAR_TYPE_LENGTH = 4
 
49
 
45
50
  type :: var
46
51
     !! Container for _any_ fortran data-type, intrinsically handles all
47
52
     !! from fortran and any external type may be added via external routines.
51
56
     !! This enables one to retrieve the pointer position later and thus enables
52
57
     !! pointer assignments and easy copying of data.
53
58
     
54
 
     character(len=4) :: t = '    '
 
59
     character(len=VAR_TYPE_LENGTH) :: t = '    '
55
60
     ! The encoding placement of all data
56
61
     character(len=1), dimension(:), allocatable :: enc
57
62
  end type var
58
63
  public :: var
59
64
 
60
65
  interface which
61
 
     !! Type of content stored in the variable (`character(len=4)`)
 
66
     !! Type of content stored in the variable (`character(len=VAR_TYPE_LENGTH)`)
62
67
     module procedure which_
63
68
  end interface
64
69
  public :: which
158
163
 
159
164
  elemental function which_(this) result(t)
160
165
    type(var), intent(in) :: this
161
 
    character(len=4) :: t
 
166
    character(len=VAR_TYPE_LENGTH) :: t
162
167
    t = this%t
163
168
  end function which_
164
169
    
258
263
    end if
259
264
    this%t = 'USER'
260
265
    allocate(this%enc(size(enc)))
261
 
    this%enc = enc
 
266
    this%enc(:) = enc
262
267
 
263
268
  end subroutine associate_type_
264
269
 
312
317
          pa__1%p(i)%p = pa__2%p(i)%p
313
318
       end do
314
319
       allocate(this%enc(size(transfer(pa__1, local_enc_type))))
315
 
       this%enc = transfer(pa__1, local_enc_type)
 
320
       this%enc(:) = transfer(pa__1, local_enc_type)
316
321
    end if
317
322
 
318
323
    ! copy over RHS and Save encoding
341
346
    ! Association is done by copying the encoding
342
347
    this%t = rhs%t
343
348
    allocate(this%enc(size(rhs%enc)))
344
 
    this%enc = rhs%enc
 
349
    this%enc(:) = rhs%enc
345
350
 
346
351
  end subroutine associate_var
347
352
 
429
434
       p%p(i)%p => rhs(i:i)
430
435
    end do
431
436
    allocate(this%enc(size(transfer(p, local_enc_type)))) ! allocate encoding
432
 
    this%enc = transfer(p, local_enc_type) ! transfer pointer type to the encoding
 
437
    this%enc(:) = transfer(p, local_enc_type) ! transfer pointer type to the encoding
433
438
    nullify(p%p)
434
439
  end subroutine associate_set_a0_0
435
440