← Back to branch summary

~nickpapior/siesta/trunk-buds-format0.92

« back to all changes in this revision

Viewing changes to Src/buds/src/TransferD_Copy3D.inc

  • Committer: Nick Papior
  • Date: 2017-04-07 12:42:28 UTC
  • Revision ID: nickpapior@gmail.com-20170407124228-u5t08yr2p4fhzfeo
Initial commit of buds merged into siesta

Currently I have only enabled buds compilation.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/buds/src/TransferD_Copy3D.inc
 
1
!> @param[in] o1 first dimension of output array
 
2
!! @param[in] o2 second dimension of output array
 
3
!! @param[in] o3 third dimension of output array
 
4
!! @param[out] out the resulting array
 
5
!! @param[in] i1 first dimension of in array
 
6
!! @param[in] in array to be copied
 
7
subroutine BUD_TRANSFER_FUNC(copy,1Dto3D)(o1,o2,o3,out,i1,in)
 
8
  integer(ii_), intent(in) :: o1, o2, o3, i1
 
9
#ifdef BUD_TYPE_VAR_PREC
 
10
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(out) :: out(o1,o2,o3)
 
11
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(in) :: in(i1)
 
12
#else
 
13
  BUD_TYPE_VAR, intent(out) :: out(o1,o2,o3)
 
14
  BUD_TYPE_VAR, intent(in) :: in(i1)
 
15
#endif
 
16
  call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,o1,i1/(o2*o3),in(1))
 
17
end subroutine
 
18
 
 
19
!> @param[in] o1 first dimension of output array
 
20
!! @param[in] o2 second dimension of output array
 
21
!! @param[in] o3 third dimension of output array
 
22
!! @param[out] out the resulting array
 
23
!! @param[in] i1 first dimension of in array
 
24
!! @param[in] i2 second dimension of in array
 
25
!! @param[in] in array to be copied
 
26
recursive subroutine BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,i1,i2,in)
 
27
  integer(ii_), intent(in) :: o1, o2, o3, i1, i2
 
28
#ifdef BUD_TYPE_VAR_PREC
 
29
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(out) :: out(o1,o2,o3)
 
30
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(in) :: in(i1,i2)
 
31
#else
 
32
  BUD_TYPE_VAR, intent(out) :: out(o1,o2,o3)
 
33
  BUD_TYPE_VAR, intent(in) :: in(i1,i2)
 
34
#endif
 
35
  if ( o1 == i1 ) then
 
36
    ! Cycle call to assert correct memory alignment
 
37
    call BUD_TRANSFER_FUNC(copy,3Dto3D)(o1,o2,o3,out,i1,o2,i2/o2,in(1,1))
 
38
  else
 
39
    call BUD_TRANSFER_FUNC(copy,3Dto3D)(o1,o2,o3,out,o1,o2,(i1*i2)/(o1*o2),in(1,1))
 
40
  end if
 
41
end subroutine
 
42
 
 
43
!> @param[in] o1 first dimension of output array
 
44
!! @param[in] o2 second dimension of output array
 
45
!! @param[in] o3 third dimension of output array
 
46
!! @param[out] out the resulting array
 
47
!! @param[in] i1 first dimension of in array
 
48
!! @param[in] i2 second dimension of in array
 
49
!! @param[in] i3 third dimension of in array
 
50
!! @param[in] in array to be copied
 
51
recursive subroutine BUD_TRANSFER_FUNC(copy,3Dto3D)(o1,o2,o3,out,i1,i2,i3,in)
 
52
  integer(ii_), intent(in) :: o1, o2, o3, i1, i2, i3
 
53
#ifdef BUD_TYPE_VAR_PREC
 
54
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(out) :: out(o1,o2,o3)
 
55
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(in) :: in(i1,i2,i3)
 
56
#else
 
57
  BUD_TYPE_VAR, intent(out) :: out(o1,o2,o3)
 
58
  BUD_TYPE_VAR, intent(in) :: in(i1,i2,i3)
 
59
#endif
 
60
  integer(ii_) :: j1, j2, j3
 
61
  if ( o1 == i1 .and. o2 == i2 ) then
 
62
    do j3 = 1 , min(o3,i3)
 
63
      do j2 = 1 , o2
 
64
        do j1 = 1 , o1
 
65
          out(j1,j2,j3) = in(j1,j2,j3)
 
66
        end do
 
67
      end do
 
68
    end do
 
69
    return
 
70
  end if
 
71
  ! Cycle down in dimension to retrive a correct dimension
 
72
  call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,o1,(i1*i2*i3)/o1,in(1,1,1))
 
73
end subroutine
 
74
 
 
75
!> @param[in] o1 first dimension of output array
 
76
!! @param[in] o2 second dimension of output array
 
77
!! @param[in] o3 third dimension of output array
 
78
!! @param[out] out the resulting array
 
79
!! @param[in] i1 first dimension of in array
 
80
!! @param[in] i2 second dimension of in array
 
81
!! @param[in] i3 third dimension of in array
 
82
!! @param[in] i4 fourth dimension of in array
 
83
!! @param[in] in array to be copied
 
84
subroutine BUD_TRANSFER_FUNC(copy,4Dto3D)(o1,o2,o3,out,i1,i2,i3,i4,in)
 
85
  integer(ii_), intent(in) :: o1, o2, o3, i1, i2, i3, i4
 
86
#ifdef BUD_TYPE_VAR_PREC
 
87
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(out) :: out(o1,o2,o3)
 
88
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(in) :: in(i1,i2,i3,i4)
 
89
#else
 
90
  BUD_TYPE_VAR, intent(out) :: out(o1,o2,o3)
 
91
  BUD_TYPE_VAR, intent(in) :: in(i1,i2,i3,i4)
 
92
#endif
 
93
  if ( o1 == i1 .and. o2 == i2 ) then
 
94
    call BUD_TRANSFER_FUNC(copy,3Dto3D)(o1,o2,o3,out,i1,i2,i3*i4,in(1,1,1,1))
 
95
  else if ( o1 == i1 ) then
 
96
    call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,i1,i2*i3*i4,in(1,1,1,1))
 
97
  else
 
98
    call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,o1,(i1*i2*i3*i4)/o1,in(1,1,1,1))
 
99
  end if
 
100
end subroutine
 
101
 
 
102
!> @param[in] o1 first dimension of output array
 
103
!! @param[in] o2 second dimension of output array
 
104
!! @param[in] o3 third dimension of output array
 
105
!! @param[out] out the resulting array
 
106
!! @param[in] i1 first dimension of in array
 
107
!! @param[in] i2 second dimension of in array
 
108
!! @param[in] i3 third dimension of in array
 
109
!! @param[in] i4 fourth dimension of in array
 
110
!! @param[in] i5 fifth dimension of in array
 
111
!! @param[in] in array to be copied
 
112
subroutine BUD_TRANSFER_FUNC(copy,5Dto3D)(o1,o2,o3,out,i1,i2,i3,i4,i5,in)
 
113
  integer(ii_), intent(in) :: o1, o2, o3, i1, i2, i3, i4, i5
 
114
#ifdef BUD_TYPE_VAR_PREC
 
115
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(out) :: out(o1,o2,o3)
 
116
  BUD_TYPE_VAR(BUD_TYPE_VAR_PREC), intent(in) :: in(i1,i2,i3,i4,i5)
 
117
#else
 
118
  BUD_TYPE_VAR, intent(out) :: out(o1,o2,o3)
 
119
  BUD_TYPE_VAR, intent(in) :: in(i1,i2,i3,i4,i5)
 
120
#endif
 
121
  if ( o1 == i1 .and. o2 == i2 ) then
 
122
    call BUD_TRANSFER_FUNC(copy,3Dto3D)(o1,o2,o3,out,i1,i2,i3*i4*i5,in(1,1,1,1,1))
 
123
  else if ( o1 == i1 ) then
 
124
    call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,i1,i2*i3*i4*i5,in(1,1,1,1,1))
 
125
  else
 
126
    call BUD_TRANSFER_FUNC(copy,2Dto3D)(o1,o2,o3,out,o1,(i1*i2*i3*i4*i5)/o1,in(1,1,1,1,1))
 
127
  end if
 
128
end subroutine
 
129
 
 
130
#undef BUD_TYPE_VAR
 
131
#undef BUD_TYPE_VAR_PREC
 
132
#undef BUD_TYPE_VAR_P
 
133
 
 
134
 
 
135
! project-buds -- local file settings
 
136
!     Anything below this line may be overwritten by scripts
 
137
!     Below are non-editable settings
 
138
 
 
139
! Local Variables:
 
140
!  mode: f90
 
141
!  f90-if-indent: 2
 
142
!  f90-type-indent: 2
 
143
!  f90-associate-indent: 2
 
144
!  f90-continuation-indent: 2
 
145
!  f90-structure-indent: 2
 
146
!  f90-critical-indent: 2
 
147
!  f90-program-indent: 2
 
148
!  f90-do-indent: 2
 
149
! End:
 
150