[1765] | 1 | module avg_mag_m |
---|
| 2 | |
---|
| 3 | ! The generic procedure computes the average magnitude, that is |
---|
| 4 | ! log10 of absolute value of an array. |
---|
| 5 | ! The difference between the specific procedures is the kind and |
---|
| 6 | ! rank of the array. |
---|
| 7 | ! We do not care here about precision so all specific procedures |
---|
| 8 | ! compute and return a default real kind value. |
---|
| 9 | |
---|
| 10 | implicit none |
---|
| 11 | |
---|
| 12 | interface avg_mag |
---|
| 13 | module procedure avg_mag1, avg_mag1_dble, avg_mag2, avg_mag2_dble, & |
---|
| 14 | avg_mag3, avg_mag3_dble, avg_mag4, avg_mag4_dble |
---|
| 15 | end interface |
---|
| 16 | |
---|
| 17 | private |
---|
| 18 | public avg_mag |
---|
| 19 | |
---|
| 20 | contains |
---|
| 21 | |
---|
| 22 | pure real function avg_mag1(a) |
---|
| 23 | |
---|
| 24 | real, intent(in):: a(:) |
---|
| 25 | |
---|
| 26 | ! Variables local to the procedure: |
---|
| 27 | logical not_zero(size(a)) ! not zero in "a" |
---|
| 28 | real magnit(size(a)) ! magnitudes of elements of "a" |
---|
| 29 | |
---|
| 30 | !------------------------------------- |
---|
| 31 | |
---|
| 32 | not_zero = a /= 0. |
---|
| 33 | |
---|
| 34 | if (any(not_zero)) then |
---|
| 35 | where (not_zero) magnit = log10(abs(a)) |
---|
| 36 | avg_mag1 = sum(magnit, mask=not_zero) / count(not_zero) |
---|
| 37 | else |
---|
| 38 | avg_mag1 = - huge(0.) ! minus infinity |
---|
| 39 | end if |
---|
| 40 | |
---|
| 41 | end function avg_mag1 |
---|
| 42 | |
---|
| 43 | !******************************************************************* |
---|
| 44 | |
---|
| 45 | pure real function avg_mag1_dble(a) |
---|
| 46 | |
---|
| 47 | double precision, intent(in):: a(:) |
---|
| 48 | |
---|
| 49 | !------------------------------------- |
---|
| 50 | |
---|
| 51 | avg_mag1_dble = avg_mag1(real(a)) |
---|
| 52 | |
---|
| 53 | end function avg_mag1_dble |
---|
| 54 | |
---|
| 55 | !******************************************************************* |
---|
| 56 | |
---|
| 57 | pure real function avg_mag2(a) |
---|
| 58 | |
---|
| 59 | real, intent(in):: a(:, :) |
---|
| 60 | |
---|
| 61 | !------------------------------------- |
---|
| 62 | |
---|
| 63 | avg_mag2 = avg_mag1(pack(a, .true.)) |
---|
| 64 | |
---|
| 65 | end function avg_mag2 |
---|
| 66 | |
---|
| 67 | !******************************************************************* |
---|
| 68 | |
---|
| 69 | pure real function avg_mag2_dble(a) |
---|
| 70 | |
---|
| 71 | double precision, intent(in):: a(:, :) |
---|
| 72 | |
---|
| 73 | !------------------------------------- |
---|
| 74 | |
---|
| 75 | avg_mag2_dble = avg_mag1(pack(real(a), .true.)) |
---|
| 76 | |
---|
| 77 | end function avg_mag2_dble |
---|
| 78 | |
---|
| 79 | !******************************************************************* |
---|
| 80 | |
---|
| 81 | pure real function avg_mag3(a) |
---|
| 82 | |
---|
| 83 | real, intent(in):: a(:, :, :) |
---|
| 84 | |
---|
| 85 | !------------------------------------- |
---|
| 86 | |
---|
| 87 | avg_mag3 = avg_mag1(pack(a, .true.)) |
---|
| 88 | |
---|
| 89 | end function avg_mag3 |
---|
| 90 | |
---|
| 91 | !******************************************************************* |
---|
| 92 | |
---|
| 93 | pure real function avg_mag3_dble(a) |
---|
| 94 | |
---|
| 95 | double precision, intent(in):: a(:, :, :) |
---|
| 96 | |
---|
| 97 | !------------------------------------- |
---|
| 98 | |
---|
| 99 | avg_mag3_dble = avg_mag1(pack(real(a), .true.)) |
---|
| 100 | |
---|
| 101 | end function avg_mag3_dble |
---|
| 102 | |
---|
| 103 | !******************************************************************* |
---|
| 104 | |
---|
| 105 | pure real function avg_mag4(a) |
---|
| 106 | |
---|
| 107 | real, intent(in):: a(:, :, :, :) |
---|
| 108 | |
---|
| 109 | !------------------------------------- |
---|
| 110 | |
---|
| 111 | avg_mag4 = avg_mag1(pack(a, .true.)) |
---|
| 112 | |
---|
| 113 | end function avg_mag4 |
---|
| 114 | |
---|
| 115 | !******************************************************************* |
---|
| 116 | |
---|
| 117 | pure real function avg_mag4_dble(a) |
---|
| 118 | |
---|
| 119 | double precision, intent(in):: a(:, :, :, :) |
---|
| 120 | |
---|
| 121 | !------------------------------------- |
---|
| 122 | |
---|
| 123 | avg_mag4_dble = avg_mag1(pack(real(a), .true.)) |
---|
| 124 | |
---|
| 125 | end function avg_mag4_dble |
---|
| 126 | |
---|
| 127 | end module avg_mag_m |
---|