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
35 MODULE PROCEDURE grid_rect_delete
39 MODULE PROCEDURE grid_rect_get_val
43 MODULE PROCEDURE grid_rect_set_val
47 MODULE PROCEDURE grid_rect_copy
51 MODULE PROCEDURE grid_rect_eq
55 MODULE PROCEDURE grid_rect_write_unit
59 MODULE PROCEDURE grid_rect_read_unit
63 MODULE PROCEDURE grid_rect_display
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
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
80TYPE(grid_rect) :: this
82this%xmin = optio_d(xmin)
83this%ymin = optio_d(ymin)
84this%xmax = optio_d(xmax)
85this%ymax = optio_d(ymax)
88this%component_flag = optio_l(component_flag)
90END FUNCTION grid_rect_new
93SUBROUTINE grid_rect_delete(this)
94TYPE(grid_rect),
INTENT(inout) :: this
102this%component_flag = imiss
104END SUBROUTINE grid_rect_delete
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
115IF (
PRESENT(xmin))
THEN
118IF (
PRESENT(ymin))
THEN
121IF (
PRESENT(xmax))
THEN
124IF (
PRESENT(ymax))
THEN
133IF (
PRESENT(component_flag))
THEN
134 component_flag = this%component_flag
137END SUBROUTINE grid_rect_get_val
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
150IF (
PRESENT(xmin))
THEN
153IF (
PRESENT(ymin))
THEN
156IF (
PRESENT(xmax))
THEN
159IF (
PRESENT(ymax))
THEN
168IF (
PRESENT(component_flag))
THEN
169 this%component_flag = component_flag
172END SUBROUTINE grid_rect_set_val
175SUBROUTINE grid_rect_copy(this, that)
176TYPE(grid_rect),
INTENT(in) :: this
177TYPE(grid_rect),
INTENT(out) :: that
181END SUBROUTINE grid_rect_copy
184ELEMENTAL FUNCTION grid_rect_eq(this, that)
RESULT(res)
185TYPE(grid_rect),
INTENT(in) :: this
186TYPE(grid_rect),
INTENT(in) :: that
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)
196END FUNCTION grid_rect_eq
203SUBROUTINE grid_rect_read_unit(this, unit)
204TYPE(grid_rect),
INTENT(out) :: this
205INTEGER,
INTENT(in) :: unit
207CHARACTER(len=40) :: form
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
213 READ(unit)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
216END SUBROUTINE grid_rect_read_unit
223SUBROUTINE grid_rect_write_unit(this, unit)
224TYPE(grid_rect),
INTENT(in) :: this
225INTEGER,
INTENT(in) :: unit
227CHARACTER(len=40) :: form
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
233 WRITE(unit)this%xmin,this%ymin,this%xmax,this%ymax,this%dx,this%dy,this%component_flag
236END SUBROUTINE grid_rect_write_unit
240SUBROUTINE grid_rect_display(this)
241TYPE(grid_rect),
INTENT(in) :: this
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
250END SUBROUTINE grid_rect_display
256SUBROUTINE grid_rect_coordinates(this, x, y)
257TYPE(grid_rect),
INTENT(in) :: this
258DOUBLE PRECISION,
INTENT(out) :: x(:,:)
259DOUBLE PRECISION,
INTENT(out) :: y(:,:)
261DOUBLE PRECISION :: dx, dy
262INTEGER :: nx, ny, i, j
268IF (
SIZE(y,1) /= nx .OR.
SIZE(y,2) /= ny)
THEN
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) /),&
279 y(:,:) = reshape((/ ((this%ymin+(dy*dble(j)), i=0,nx-1), j=0,ny-1) /),&
286END SUBROUTINE grid_rect_coordinates
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
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)
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)
310END SUBROUTINE grid_rect_steps
314SUBROUTINE grid_rect_setsteps(this, nx, ny)
315TYPE(grid_rect),
INTENT(inout) :: this
316INTEGER,
INTENT(in) :: nx
317INTEGER,
INTENT(in) :: ny
319CALL grid_rect_steps(this, nx, ny, this%dx, this%dy)
321END SUBROUTINE grid_rect_setsteps
323END MODULE grid_rect_class
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.