[13926] | 1 | |
---|
| 2 | ! |
---|
| 3 | ! This program may be freely redistributed under the |
---|
| 4 | ! condition that the copyright notices (including this |
---|
| 5 | ! entire header) are not removed, and no compensation |
---|
| 6 | ! is received through use of the software. Private, |
---|
| 7 | ! research, and institutional use is free. You may |
---|
| 8 | ! distribute modified versions of this code UNDER THE |
---|
| 9 | ! CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE |
---|
| 10 | ! TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE |
---|
| 11 | ! ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE |
---|
| 12 | ! MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR |
---|
| 13 | ! NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution |
---|
| 14 | ! of this code as part of a commercial system is |
---|
| 15 | ! permissible ONLY BY DIRECT ARRANGEMENT WITH THE |
---|
| 16 | ! AUTHOR. (If you are not directly supplying this |
---|
| 17 | ! code to a customer, and you are instead telling them |
---|
| 18 | ! how they can obtain it for free, then you are not |
---|
| 19 | ! required to make any arrangement with me.) |
---|
| 20 | ! |
---|
| 21 | ! Disclaimer: Neither I nor: Columbia University, the |
---|
| 22 | ! National Aeronautics and Space Administration, nor |
---|
| 23 | ! the Massachusetts Institute of Technology warrant |
---|
| 24 | ! or certify this code in any way whatsoever. This |
---|
| 25 | ! code is provided "as-is" to be used at your own risk. |
---|
| 26 | ! |
---|
| 27 | ! |
---|
| 28 | |
---|
| 29 | ! |
---|
| 30 | ! UTIL1D.f90: util. func. for 1-dim. grid manipulation. |
---|
| 31 | ! |
---|
| 32 | ! Darren Engwirda |
---|
| 33 | ! 31-Mar-2019 |
---|
| 34 | ! de2363 [at] columbia [dot] edu |
---|
| 35 | ! |
---|
| 36 | ! |
---|
| 37 | |
---|
| 38 | subroutine linspace(xxll,xxuu,npos,xpos) |
---|
| 39 | |
---|
| 40 | ! |
---|
| 41 | ! XXLL lower-bound grid position. |
---|
| 42 | ! NNEW upper-bound grid position. |
---|
| 43 | ! NPOS no. edges in the grid. |
---|
| 44 | ! XPOS array of grid edges. XPOS has length NPOS . |
---|
| 45 | ! |
---|
| 46 | |
---|
| 47 | implicit none |
---|
| 48 | |
---|
| 49 | real*8 , intent(in) :: xxll,xxuu |
---|
| 50 | integer, intent(in) :: npos |
---|
| 51 | real*8 , intent(out) :: xpos(:) |
---|
| 52 | |
---|
| 53 | integer :: ipos |
---|
| 54 | real*8 :: xdel |
---|
| 55 | |
---|
| 56 | xpos( 1) = xxll |
---|
| 57 | xpos(npos) = xxuu |
---|
| 58 | |
---|
| 59 | xdel = (xxuu-xxll) / (npos - 1) |
---|
| 60 | |
---|
| 61 | do ipos = +2, npos-1 |
---|
| 62 | |
---|
| 63 | xpos(ipos) = (ipos-1) * xdel |
---|
| 64 | |
---|
| 65 | end do |
---|
| 66 | |
---|
| 67 | return |
---|
| 68 | |
---|
| 69 | end subroutine |
---|
| 70 | |
---|
| 71 | subroutine rndspace(xxll,xxuu,npos,xpos, & |
---|
| 72 | & frac) |
---|
| 73 | |
---|
| 74 | ! |
---|
| 75 | ! XXLL lower-bound grid position. |
---|
| 76 | ! NNEW upper-bound grid position. |
---|
| 77 | ! NPOS no. edges in the grid. |
---|
| 78 | ! XPOS array of grid edges. XPOS has length NPOS . |
---|
| 79 | ! FRAC fractional perturbation of cell, OPTIONAL . |
---|
| 80 | ! |
---|
| 81 | |
---|
| 82 | implicit none |
---|
| 83 | |
---|
| 84 | real*8 , intent(in) :: xxll,xxuu |
---|
| 85 | integer, intent(in) :: npos |
---|
| 86 | real*8 , intent(out) :: xpos(:) |
---|
| 87 | real*8 , intent(in), optional :: frac |
---|
| 88 | |
---|
| 89 | integer :: ipos |
---|
| 90 | real*8 :: xdel,rand,move |
---|
| 91 | |
---|
| 92 | if (present(frac)) then |
---|
| 93 | move = +frac |
---|
| 94 | else |
---|
| 95 | move = 0.33d0 |
---|
| 96 | end if |
---|
| 97 | |
---|
| 98 | xpos( 1) = xxll |
---|
| 99 | xpos(npos) = xxuu |
---|
| 100 | |
---|
| 101 | xdel = (xxuu-xxll) / (npos - 1) |
---|
| 102 | |
---|
| 103 | do ipos = +2, npos-1 |
---|
| 104 | |
---|
| 105 | xpos(ipos) = (ipos-1) * xdel |
---|
| 106 | |
---|
| 107 | end do |
---|
| 108 | |
---|
| 109 | do ipos = +2, npos-1 |
---|
| 110 | |
---|
| 111 | call random_number (rand) |
---|
| 112 | |
---|
| 113 | rand = 2.d0 * (rand-.5d0) |
---|
| 114 | |
---|
| 115 | move = rand * move |
---|
| 116 | |
---|
| 117 | xpos(ipos) = & |
---|
| 118 | & xpos(ipos) + move * xdel |
---|
| 119 | |
---|
| 120 | end do |
---|
| 121 | |
---|
| 122 | return |
---|
| 123 | |
---|
| 124 | end subroutine |
---|
| 125 | |
---|
| 126 | |
---|
| 127 | |
---|