libsim Versione 7.2.4
grid_rect_class.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18#include "config.h"
19MODULE grid_rect_class
22IMPLICIT NONE
23
24TYPE grid_rect
25 DOUBLE PRECISION :: xmin
26 DOUBLE PRECISION :: xmax
27 DOUBLE PRECISION :: ymin
28 DOUBLE PRECISION :: ymax
29 DOUBLE PRECISION :: dx
30 DOUBLE PRECISION :: dy
31 INTEGER :: component_flag
32END TYPE grid_rect
33
34INTERFACE delete
35 MODULE PROCEDURE grid_rect_delete
36END INTERFACE
37
38INTERFACE get_val
39 MODULE PROCEDURE grid_rect_get_val
40END INTERFACE
41
42INTERFACE set_val
43 MODULE PROCEDURE grid_rect_set_val
44END INTERFACE
45
46INTERFACE copy
47 MODULE PROCEDURE grid_rect_copy
48END INTERFACE
49
50INTERFACE OPERATOR(==)
51 MODULE PROCEDURE grid_rect_eq
52END INTERFACE
53
54INTERFACE write_unit
55 MODULE PROCEDURE grid_rect_write_unit
56END INTERFACE
57
58INTERFACE read_unit
59 MODULE PROCEDURE grid_rect_read_unit
60END INTERFACE
61
62INTERFACE display
63 MODULE PROCEDURE grid_rect_display
64END INTERFACE
65
66
67PRIVATE grid_rect_delete, grid_rect_get_val, &
68 grid_rect_set_val, grid_rect_copy, grid_rect_eq, &
69 grid_rect_read_unit, grid_rect_write_unit, grid_rect_display
70
71CONTAINS
72
73FUNCTION grid_rect_new(xmin, xmax, ymin, ymax, dx, dy, component_flag) RESULT(this)
74DOUBLE PRECISION,INTENT(in),OPTIONAL :: xmin, xmax, ymin, ymax
75DOUBLE PRECISION,INTENT(in),OPTIONAL :: dx, dy
78INTEGER,INTENT(in),OPTIONAL :: component_flag
79
80TYPE(grid_rect) :: this
81
82this%xmin = optio_d(xmin)
83this%ymin = optio_d(ymin)
84this%xmax = optio_d(xmax)
85this%ymax = optio_d(ymax)
86this%dx = optio_d(dx)
87this%dy = optio_d(dy)
88this%component_flag = optio_l(component_flag)
89
90END FUNCTION grid_rect_new
91
92
93SUBROUTINE grid_rect_delete(this)
94TYPE(grid_rect),INTENT(inout) :: this
95
96this%xmin = dmiss
97this%ymin = dmiss
98this%xmax = dmiss
99this%ymax = dmiss
100this%dx = dmiss
101this%dy = dmiss
102this%component_flag = imiss
103
104END SUBROUTINE grid_rect_delete
105
106
107SUBROUTINE grid_rect_get_val(this, xmin, xmax, ymin, ymax, dx, dy, component_flag)
108TYPE(grid_rect), INTENT(in) :: this
109DOUBLE PRECISION,INTENT(out),OPTIONAL :: xmin, xmax, ymin, ymax
110DOUBLE PRECISION,INTENT(out),OPTIONAL :: dx, dy
113INTEGER,INTENT(out),OPTIONAL :: component_flag
114
115IF (PRESENT(xmin)) THEN
116 xmin = this%xmin
117ENDIF
118IF (PRESENT(ymin)) THEN
119 ymin = this%ymin
120ENDIF
121IF (PRESENT(xmax)) THEN
122 xmax = this%xmax
123ENDIF
124IF (PRESENT(ymax)) THEN
125 ymax = this%ymax
126ENDIF
127IF (PRESENT(dx)) THEN
128 dx = this%dx
129ENDIF
130IF (PRESENT(dy)) THEN
131 dy = this%dy
132ENDIF
133IF (PRESENT(component_flag)) THEN
134 component_flag = this%component_flag
135ENDIF
136
137END SUBROUTINE grid_rect_get_val
138
139
140SUBROUTINE grid_rect_set_val(this, xmin, xmax, ymin, ymax, &
141 dx, dy, component_flag)
142TYPE(grid_rect), INTENT(inout) :: this
143DOUBLE PRECISION,INTENT(in),OPTIONAL :: xmin, xmax, ymin, ymax
144DOUBLE PRECISION,INTENT(in),OPTIONAL :: dx, dy
147INTEGER,INTENT(in),OPTIONAL :: component_flag
148
149
150IF (PRESENT(xmin)) THEN
151 this%xmin = xmin
152ENDIF
153IF (PRESENT(ymin)) THEN
154 this%ymin = ymin
155ENDIF
156IF (PRESENT(xmax)) THEN
157 this%xmax = xmax
158ENDIF
159IF (PRESENT(ymax)) THEN
160 this%ymax = ymax
161ENDIF
162IF (PRESENT(dx)) THEN
163 this%dx = dx
164ENDIF
165IF (PRESENT(dy)) THEN
166 this%dy = dy
167ENDIF
168IF (PRESENT(component_flag)) THEN
169 this%component_flag = component_flag
170ENDIF
171
172END SUBROUTINE grid_rect_set_val
173
174
175SUBROUTINE grid_rect_copy(this, that)
176TYPE(grid_rect), INTENT(in) :: this
177TYPE(grid_rect), INTENT(out) :: that
178
179that = this
180
181END SUBROUTINE grid_rect_copy
182
183
184ELEMENTAL FUNCTION grid_rect_eq(this, that) RESULT(res)
185TYPE(grid_rect), INTENT(in) :: this
186TYPE(grid_rect), INTENT(in) :: that
187
188LOGICAL :: res
189
190
191res = (this%xmin == that%xmin .AND. this%xmax == that%xmax .AND. &
192 this%ymin == that%ymin .AND. this%ymax == that%ymax .AND. &
193 this%dx == that%dx .AND. this%dy == that%dy .AND. &
194 this%component_flag == that%component_flag)
195
196END FUNCTION grid_rect_eq
197
198
203SUBROUTINE grid_rect_read_unit(this, unit)
204TYPE(grid_rect),INTENT(out) :: this
205INTEGER, INTENT(in) :: unit
206
207CHARACTER(len=40) :: form
208
209INQUIRE(unit, form=form)
210IF (form == 'FORMATTED') THEN
211 READ(unit,*)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
212ELSE
213 READ(unit)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
214ENDIF
215
216END SUBROUTINE grid_rect_read_unit
217
218
223SUBROUTINE grid_rect_write_unit(this, unit)
224TYPE(grid_rect),INTENT(in) :: this
225INTEGER, INTENT(in) :: unit
226
227CHARACTER(len=40) :: form
228
229INQUIRE(unit, form=form)
230IF (form == 'FORMATTED') THEN
231 WRITE(unit,*)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
232ELSE
233 WRITE(unit)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
234ENDIF
235
236END SUBROUTINE grid_rect_write_unit
237
238
240SUBROUTINE grid_rect_display(this)
241TYPE(grid_rect),INTENT(in) :: this
242
243print*,"xFirst",this%xmin
244print*,"xLast ",this%xmax
245print*,"yFirst",this%ymin
246print*,"yLast ",this%ymax
247print*,"dx, dy",this%dx,this%dy
248print*,"componentFlag",this%component_flag
249
250END SUBROUTINE grid_rect_display
251
252
256SUBROUTINE grid_rect_coordinates(this, x, y)
257TYPE(grid_rect),INTENT(in) :: this
258DOUBLE PRECISION,INTENT(out) :: x(:,:)
259DOUBLE PRECISION,INTENT(out) :: y(:,:)
260
261DOUBLE PRECISION :: dx, dy
262INTEGER :: nx, ny, i, j
263
264nx = SIZE(x,1)
265ny = SIZE(x,2)
266
267#ifdef DEBUG
268IF (SIZE(y,1) /= nx .OR. SIZE(y,2) /= ny) THEN
269 x(:,:) = dmiss
270 y(:,:) = dmiss
271 RETURN
272ENDIF
273#endif
274
275CALL grid_rect_steps(this, nx, ny, dx, dy)
276IF (c_e(dx) .AND. c_e(dy)) THEN
277 x(:,:) = reshape((/ ((this%xmin+(dx*dble(i)), i=0,nx-1), j=0,ny-1) /),&
278 (/nx,ny/))
279 y(:,:) = reshape((/ ((this%ymin+(dy*dble(j)), i=0,nx-1), j=0,ny-1) /),&
280 (/nx,ny/))
281ELSE
282 x(:,:) = dmiss
283 y(:,:) = dmiss
284ENDIF
285
286END SUBROUTINE grid_rect_coordinates
287
288
290SUBROUTINE grid_rect_steps(this, nx, ny, dx, dy)
291TYPE(grid_rect), INTENT(in) :: this
292INTEGER,INTENT(in) :: nx
293INTEGER,INTENT(in) :: ny
294DOUBLE PRECISION,INTENT(out) :: dx
295DOUBLE PRECISION,INTENT(out) :: dy
296
297IF (c_e(nx) .AND. c_e(this%xmax) .AND. c_e(this%xmin) .AND. &
298 c_e(nx) .AND. nx > 1) THEN
299 dx = (this%xmax - this%xmin)/dble(nx - 1)
300ELSE
301 dx = dmiss
302ENDIF
303IF (c_e(ny) .AND. c_e(this%ymax) .AND. c_e(this%ymin) .AND. &
304 c_e(ny) .AND. ny > 1) THEN
305 dy = (this%ymax - this%ymin)/dble(ny - 1)
306ELSE
307 dy = dmiss
308ENDIF
309
310END SUBROUTINE grid_rect_steps
311
312
314SUBROUTINE grid_rect_setsteps(this, nx, ny)
315TYPE(grid_rect), INTENT(inout) :: this
316INTEGER,INTENT(in) :: nx
317INTEGER,INTENT(in) :: ny
318
319CALL grid_rect_steps(this, nx, ny, this%dx, this%dy)
320
321END SUBROUTINE grid_rect_setsteps
322
323END MODULE grid_rect_class
324
Function to check whether a value is missing or not.
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.

Generated with Doxygen.