module_machine.F
References to this file elsewhere.
1 !WRF:DRIVER_LAYER:DECOMPOSITION
2 !
3
4 MODULE module_machine
5
6 USE module_driver_constants
7
8 ! Machine characteristics and utilities here.
9
10 ! Tile strategy defined constants
11 INTEGER, PARAMETER :: TILE_X = 1, TILE_Y = 2, TILE_XY = 3
12
13 TYPE machine_type
14 INTEGER :: tile_strategy
15 END TYPE machine_type
16
17 TYPE (machine_type) machine_info
18
19 CONTAINS
20
21 RECURSIVE SUBROUTINE rlocproc(p,maxi,nproc,ml,mr,ret)
22 IMPLICIT NONE
23 INTEGER, INTENT(IN) :: p, maxi, nproc, ml, mr
24 INTEGER, INTENT(OUT) :: ret
25 INTEGER :: width, rem, ret2, bl, br, mid, adjust, &
26 p_r, maxi_r, nproc_r, zero
27 adjust = 0
28 rem = mod( maxi, nproc )
29 width = maxi / nproc
30 mid = maxi / 2
31 IF ( rem>0 .AND. (((mod(rem,2).EQ.0).OR.(rem.GT.2)).OR.(p.LE.mid))) THEN
32 width = width + 1
33 END IF
34 IF ( p.LE.mid .AND. mod(rem,2).NE.0 ) THEN
35 adjust = adjust + 1
36 END IF
37 bl = max(width,ml) ;
38 br = max(width,mr) ;
39 IF (p<bl) THEN
40 ret = 0
41 ELSE IF (p>maxi-br-1) THEN
42 ret = nproc-1
43 ELSE
44 p_r = p - bl
45 maxi_r = maxi-bl-br+adjust
46 nproc_r = max(nproc-2,1)
47 zero = 0
48 CALL rlocproc( p_r, maxi_r, nproc_r, zero, zero, ret2 ) ! Recursive
49 ret = ret2 + 1
50 END IF
51 RETURN
52 END SUBROUTINE rlocproc
53
54 INTEGER FUNCTION locproc( i, m, numpart )
55 implicit none
56 integer, intent(in) :: i, m, numpart
57 integer :: retval, ii, im, inumpart, zero
58 ii = i
59 im = m
60 inumpart = numpart
61 zero = 0
62 CALL rlocproc( ii, im, inumpart, zero, zero, retval )
63 locproc = retval
64 RETURN
65 END FUNCTION locproc
66
67 SUBROUTINE patchmap( res, y, x, py, px )
68 implicit none
69 INTEGER, INTENT(IN) :: y, x, py, px
70 INTEGER, DIMENSION(x,y), INTENT(OUT) :: res
71 INTEGER :: i, j, p_min, p_maj
72 DO j = 0,y-1
73 p_maj = locproc( j, y, py )
74 DO i = 0,x-1
75 p_min = locproc( i, x, px )
76 res(i+1,j+1) = p_min + px*p_maj
77 END DO
78 END DO
79 RETURN
80 END SUBROUTINE patchmap
81
82 SUBROUTINE region_bounds( region_start, region_end, &
83 num_p, p, &
84 patch_start, patch_end )
85 ! 1-D decomposition routine: Given starting and ending indices of a
86 ! vector, the number of patches dividing the vector, and the number of
87 ! the patch, give the start and ending indices of the patch within the
88 ! vector. This will work with tiles too. Implementation note. This is
89 ! implemented somewhat inefficiently, now, with a loop, so we can use the
90 ! locproc function above, which returns processor number for a given
91 ! index, whereas what we want is index for a given processor number.
92 ! With a little thought and a lot of debugging, we can come up with a
93 ! direct expression for what we want. For time being, we loop...
94 ! Remember that processor numbering starts with zero.
95
96 IMPLICIT NONE
97 INTEGER, INTENT(IN) :: region_start, region_end, num_p, p
98 INTEGER, INTENT(OUT) :: patch_start, patch_end
99 INTEGER :: offset, i
100 patch_end = -999999999
101 patch_start = 999999999
102 offset = region_start
103 do i = 0, region_end - offset
104 if ( locproc( i, region_end-region_start+1, num_p ) == p ) then
105 patch_end = max(patch_end,i)
106 patch_start = min(patch_start,i)
107 endif
108 enddo
109 patch_start = patch_start + offset
110 patch_end = patch_end + offset
111 RETURN
112 END SUBROUTINE region_bounds
113
114 SUBROUTINE least_aspect( nparts, minparts_y, minparts_x, nparts_y, nparts_x )
115 IMPLICIT NONE
116 ! Input data.
117 INTEGER, INTENT(IN) :: nparts, &
118 minparts_y, minparts_x
119 ! Output data.
120 INTEGER, INTENT(OUT) :: nparts_y, nparts_x
121 ! Local data.
122 INTEGER :: x, y, mini
123 mini = 2*nparts
124 nparts_y = 1
125 nparts_x = nparts
126 DO y = 1, nparts
127 IF ( mod( nparts, y ) .eq. 0 ) THEN
128 x = nparts / y
129 IF ( abs( y-x ) .LT. mini &
130 .AND. y .GE. minparts_y &
131 .AND. x .GE. minparts_x ) THEN
132 mini = abs( y-x )
133 nparts_y = y
134 nparts_x = x
135 END IF
136 END IF
137 END DO
138 END SUBROUTINE least_aspect
139
140 SUBROUTINE init_module_machine
141 machine_info%tile_strategy = TILE_Y
142 END SUBROUTINE init_module_machine
143
144 END MODULE module_machine
145
146 SUBROUTINE wrf_sizeof_integer( retval )
147 IMPLICIT NONE
148 INTEGER retval
149 ! IWORDSIZE is defined by CPP
150 retval = IWORDSIZE
151 RETURN
152 END SUBROUTINE wrf_sizeof_integer
153
154 SUBROUTINE wrf_sizeof_real( retval )
155 IMPLICIT NONE
156 INTEGER retval
157 ! RWORDSIZE is defined by CPP
158 retval = RWORDSIZE
159 RETURN
160 END SUBROUTINE wrf_sizeof_real
161
162 SUBROUTINE wrf_sizeof_doubleprecision( retval )
163 IMPLICIT NONE
164 INTEGER retval
165 ! DWORDSIZE is defined by CPP
166 retval = DWORDSIZE
167 RETURN
168 END SUBROUTINE wrf_sizeof_doubleprecision
169
170 SUBROUTINE wrf_sizeof_logical( retval )
171 IMPLICIT NONE
172 INTEGER retval
173 ! LWORDSIZE is defined by CPP
174 retval = LWORDSIZE
175 RETURN
176 END SUBROUTINE wrf_sizeof_logical
177