[1765] | 1 | MODULE geop_m |
---|
| 2 | |
---|
| 3 | IMPLICIT NONE |
---|
| 4 | |
---|
| 5 | INTERFACE geop |
---|
| 6 | MODULE PROCEDURE geop_r, geop_d, geop_i, geop_c, geop_dv |
---|
| 7 | END INTERFACE |
---|
| 8 | |
---|
| 9 | INTEGER, PARAMETER, private :: NPAR_GEOP=4, NPAR2_GEOP=2 |
---|
| 10 | private geop_r, geop_d, geop_i, geop_c, geop_dv |
---|
| 11 | |
---|
| 12 | CONTAINS |
---|
| 13 | |
---|
| 14 | FUNCTION geop_r(first,factor,n) |
---|
| 15 | REAL, INTENT(IN) :: first,factor |
---|
| 16 | INTEGER, INTENT(IN) :: n |
---|
| 17 | REAL, DIMENSION(n) :: geop_r |
---|
| 18 | INTEGER :: k,k2 |
---|
| 19 | REAL :: temp |
---|
| 20 | if (n > 0) geop_r(1)=first |
---|
| 21 | if (n <= NPAR_GEOP) then |
---|
| 22 | do k=2,n |
---|
| 23 | geop_r(k)=geop_r(k-1)*factor |
---|
| 24 | end do |
---|
| 25 | else |
---|
| 26 | do k=2,NPAR2_GEOP |
---|
| 27 | geop_r(k)=geop_r(k-1)*factor |
---|
| 28 | end do |
---|
| 29 | temp=factor**NPAR2_GEOP |
---|
| 30 | k=NPAR2_GEOP |
---|
| 31 | do |
---|
| 32 | if (k >= n) exit |
---|
| 33 | k2=k+k |
---|
| 34 | geop_r(k+1:min(k2,n))=temp*geop_r(1:min(k,n-k)) |
---|
| 35 | temp=temp*temp |
---|
| 36 | k=k2 |
---|
| 37 | end do |
---|
| 38 | end if |
---|
| 39 | END FUNCTION geop_r |
---|
| 40 | !BL |
---|
| 41 | FUNCTION geop_d(first,factor,n) |
---|
| 42 | DOUBLE PRECISION, INTENT(IN) :: first,factor |
---|
| 43 | INTEGER, INTENT(IN) :: n |
---|
| 44 | DOUBLE PRECISION, DIMENSION(n) :: geop_d |
---|
| 45 | INTEGER :: k,k2 |
---|
| 46 | DOUBLE PRECISION :: temp |
---|
| 47 | if (n > 0) geop_d(1)=first |
---|
| 48 | if (n <= NPAR_GEOP) then |
---|
| 49 | do k=2,n |
---|
| 50 | geop_d(k)=geop_d(k-1)*factor |
---|
| 51 | end do |
---|
| 52 | else |
---|
| 53 | do k=2,NPAR2_GEOP |
---|
| 54 | geop_d(k)=geop_d(k-1)*factor |
---|
| 55 | end do |
---|
| 56 | temp=factor**NPAR2_GEOP |
---|
| 57 | k=NPAR2_GEOP |
---|
| 58 | do |
---|
| 59 | if (k >= n) exit |
---|
| 60 | k2=k+k |
---|
| 61 | geop_d(k+1:min(k2,n))=temp*geop_d(1:min(k,n-k)) |
---|
| 62 | temp=temp*temp |
---|
| 63 | k=k2 |
---|
| 64 | end do |
---|
| 65 | end if |
---|
| 66 | END FUNCTION geop_d |
---|
| 67 | !BL |
---|
| 68 | FUNCTION geop_i(first,factor,n) |
---|
| 69 | INTEGER, INTENT(IN) :: first,factor,n |
---|
| 70 | INTEGER, DIMENSION(n) :: geop_i |
---|
| 71 | INTEGER :: k,k2,temp |
---|
| 72 | if (n > 0) geop_i(1)=first |
---|
| 73 | if (n <= NPAR_GEOP) then |
---|
| 74 | do k=2,n |
---|
| 75 | geop_i(k)=geop_i(k-1)*factor |
---|
| 76 | end do |
---|
| 77 | else |
---|
| 78 | do k=2,NPAR2_GEOP |
---|
| 79 | geop_i(k)=geop_i(k-1)*factor |
---|
| 80 | end do |
---|
| 81 | temp=factor**NPAR2_GEOP |
---|
| 82 | k=NPAR2_GEOP |
---|
| 83 | do |
---|
| 84 | if (k >= n) exit |
---|
| 85 | k2=k+k |
---|
| 86 | geop_i(k+1:min(k2,n))=temp*geop_i(1:min(k,n-k)) |
---|
| 87 | temp=temp*temp |
---|
| 88 | k=k2 |
---|
| 89 | end do |
---|
| 90 | end if |
---|
| 91 | END FUNCTION geop_i |
---|
| 92 | !BL |
---|
| 93 | FUNCTION geop_c(first,factor,n) |
---|
| 94 | COMPLEX, INTENT(IN) :: first,factor |
---|
| 95 | INTEGER, INTENT(IN) :: n |
---|
| 96 | COMPLEX, DIMENSION(n) :: geop_c |
---|
| 97 | INTEGER :: k,k2 |
---|
| 98 | COMPLEX :: temp |
---|
| 99 | if (n > 0) geop_c(1)=first |
---|
| 100 | if (n <= NPAR_GEOP) then |
---|
| 101 | do k=2,n |
---|
| 102 | geop_c(k)=geop_c(k-1)*factor |
---|
| 103 | end do |
---|
| 104 | else |
---|
| 105 | do k=2,NPAR2_GEOP |
---|
| 106 | geop_c(k)=geop_c(k-1)*factor |
---|
| 107 | end do |
---|
| 108 | temp=factor**NPAR2_GEOP |
---|
| 109 | k=NPAR2_GEOP |
---|
| 110 | do |
---|
| 111 | if (k >= n) exit |
---|
| 112 | k2=k+k |
---|
| 113 | geop_c(k+1:min(k2,n))=temp*geop_c(1:min(k,n-k)) |
---|
| 114 | temp=temp*temp |
---|
| 115 | k=k2 |
---|
| 116 | end do |
---|
| 117 | end if |
---|
| 118 | END FUNCTION geop_c |
---|
| 119 | !BL |
---|
| 120 | FUNCTION geop_dv(first,factor,n) |
---|
| 121 | DOUBLE PRECISION, DIMENSION(:), INTENT(IN) :: first,factor |
---|
| 122 | INTEGER, INTENT(IN) :: n |
---|
| 123 | DOUBLE PRECISION, DIMENSION(size(first),n) :: geop_dv |
---|
| 124 | INTEGER :: k,k2 |
---|
| 125 | DOUBLE PRECISION, DIMENSION(size(first)) :: temp |
---|
| 126 | if (n > 0) geop_dv(:,1)=first(:) |
---|
| 127 | if (n <= NPAR_GEOP) then |
---|
| 128 | do k=2,n |
---|
| 129 | geop_dv(:,k)=geop_dv(:,k-1)*factor(:) |
---|
| 130 | end do |
---|
| 131 | else |
---|
| 132 | do k=2,NPAR2_GEOP |
---|
| 133 | geop_dv(:,k)=geop_dv(:,k-1)*factor(:) |
---|
| 134 | end do |
---|
| 135 | temp=factor**NPAR2_GEOP |
---|
| 136 | k=NPAR2_GEOP |
---|
| 137 | do |
---|
| 138 | if (k >= n) exit |
---|
| 139 | k2=k+k |
---|
| 140 | geop_dv(:,k+1:min(k2,n))=geop_dv(:,1:min(k,n-k))*& |
---|
| 141 | spread(temp,2,size(geop_dv(:,1:min(k,n-k)),2)) |
---|
| 142 | temp=temp*temp |
---|
| 143 | k=k2 |
---|
| 144 | end do |
---|
| 145 | end if |
---|
| 146 | END FUNCTION geop_dv |
---|
| 147 | |
---|
| 148 | END MODULE geop_m |
---|