libsim  Versione7.2.3
grid_dim_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"
19 
23 MODULE grid_dim_class
27 USE err_handling
28 IMPLICIT NONE
29 
33 TYPE grid_dim
34  INTEGER :: nx
35  INTEGER :: ny
36  DOUBLE PRECISION,POINTER :: lat(:,:)
37  DOUBLE PRECISION,POINTER :: lon(:,:)
38 END TYPE grid_dim
39 
40 INTERFACE delete
41  MODULE PROCEDURE grid_dim_delete
42 END INTERFACE
43 
44 INTERFACE copy
45  MODULE PROCEDURE grid_dim_copy
46 END INTERFACE
47 
48 INTERFACE alloc
49  MODULE PROCEDURE grid_dim_alloc
50 END INTERFACE
51 
52 INTERFACE dealloc
53  MODULE PROCEDURE grid_dim_dealloc
54 END INTERFACE
55 
56 INTERFACE OPERATOR (==)
57  MODULE PROCEDURE grid_dim_eq
58 END INTERFACE
59 
60 INTERFACE write_unit
61  MODULE PROCEDURE grid_dim_write_unit
62 END INTERFACE
63 
64 INTERFACE read_unit
65  MODULE PROCEDURE grid_dim_read_unit
66 END INTERFACE
67 
68 INTERFACE display
69  MODULE PROCEDURE grid_dim_display
70 END INTERFACE
71 
72 PRIVATE grid_dim_delete, grid_dim_copy, grid_dim_alloc, grid_dim_dealloc, &
73  grid_dim_eq, grid_dim_read_unit, grid_dim_write_unit, grid_dim_display
74 
75 CONTAINS
76 
77 FUNCTION grid_dim_new(nx, ny) RESULT(this)
78 INTEGER, INTENT(in), OPTIONAL :: nx, ny
79 
80 TYPE(grid_dim) :: this
81 
82 this%nx = optio_l(nx)
83 this%ny = optio_l(ny)
84 NULLIFY(this%lat, this%lon)
85 
86 END FUNCTION grid_dim_new
87 
88 
89 SUBROUTINE grid_dim_delete(this)
90 TYPE(grid_dim), INTENT(inout) :: this
91 
92 CALL dealloc(this)
93 this%nx = imiss
94 this%ny = imiss
95 
96 END SUBROUTINE grid_dim_delete
97 
98 
99 SUBROUTINE grid_dim_alloc(this)
100 TYPE(grid_dim),INTENT(inout) :: this
101 
102 IF (ASSOCIATED(this%lon) .AND. ASSOCIATED(this%lat)) THEN
103  IF (SIZE(this%lon, 1) == this%nx .AND. SIZE(this%lon, 2) == this%ny .AND. &
104  SIZE(this%lat, 1) == this%nx .AND. SIZE(this%lat, 2) == this%ny) RETURN
105 ENDIF
106 CALL dealloc(this)
107 IF (c_e(this%nx) .AND. c_e(this%ny)) THEN
108  ALLOCATE(this%lon(this%nx, this%ny), this%lat(this%nx, this%ny))
109 ENDIF
110 
111 END SUBROUTINE grid_dim_alloc
112 
113 
114 SUBROUTINE grid_dim_dealloc(this)
115 TYPE(grid_dim),INTENT(inout) :: this
116 
117 IF (ASSOCIATED(this%lon)) DEALLOCATE(this%lon)
118 IF (ASSOCIATED(this%lat)) DEALLOCATE(this%lat)
119 
120 END SUBROUTINE grid_dim_dealloc
121 
122 
123 SUBROUTINE grid_dim_copy(this, that)
124 TYPE(grid_dim),INTENT(in) :: this
125 TYPE(grid_dim),INTENT(out) :: that
126 
127 that = grid_dim_new(this%nx, this%ny)
128 
129 IF (ASSOCIATED(this%lon) .AND. ASSOCIATED(this%lat))THEN
130  CALL alloc(that)
131 
132 #ifdef DEBUG
133  IF (SIZE(this%lon,1) /= this%nx .OR. SIZE(this%lon,2) /= this%ny) THEN
134  CALL raise_error('grid_dim_copy, dimensioni non valide: '// &
135  trim(to_char(SIZE(this%lon,1)))//' '//trim(to_char(this%nx))// &
136  trim(to_char(SIZE(this%lon,2)))//' '//trim(to_char(this%ny)))
137  ENDIF
138  IF (SIZE(this%lat,1) /= this%nx .OR. SIZE(this%lat,2) /= this%ny) THEN
139  CALL raise_error('grid_dim_copy, dimensioni non valide: '// &
140  trim(to_char(SIZE(this%lat,1)))//' '//trim(to_char(this%nx))// &
141  trim(to_char(SIZE(this%lat,2)))//' '//trim(to_char(this%ny)))
142  ENDIF
143 #endif
144 
145  that%lon(:,:) = this%lon(:,:)
146  that%lat(:,:) = this%lat(:,:)
147 ENDIF
148 
149 END SUBROUTINE grid_dim_copy
150 
151 
152 ELEMENTAL FUNCTION grid_dim_eq(this, that) RESULT(res)
153 TYPE(grid_dim),INTENT(IN) :: this, that
154 LOGICAL :: res
155 
156 res = this%nx == that%nx .and. &
157  this%ny == that%ny
158 
159 END FUNCTION grid_dim_eq
160 
161 
166 SUBROUTINE grid_dim_read_unit(this, unit)
167 TYPE(grid_dim),INTENT(out) :: this
168 INTEGER, INTENT(in) :: unit
169 
170 CHARACTER(len=40) :: form
171 LOGICAL :: is_all
172 
173 INQUIRE(unit, form=form)
174 IF (form == 'FORMATTED') THEN
175  READ(unit,*)this%nx,this%ny
176  READ(unit,*)is_all
177  IF (is_all) THEN
178  CALL alloc(this)
179  READ(unit,*)this%lon,this%lat
180  ELSE
181  READ(unit,*)
182  ENDIF
183 ELSE
184  READ(unit)this%nx,this%ny
185  READ(unit)is_all
186  IF (is_all) THEN
187  CALL alloc(this)
188  READ(unit)this%lon,this%lat
189  ELSE
190  READ(unit)
191  ENDIF
192 ENDIF
193 
194 END SUBROUTINE grid_dim_read_unit
195 
196 
201 SUBROUTINE grid_dim_write_unit(this, unit)
202 TYPE(grid_dim),INTENT(in) :: this
203 INTEGER, INTENT(in) :: unit
204 
205 CHARACTER(len=40) :: form
206 LOGICAL :: is_all
207 
208 INQUIRE(unit, form=form)
209 IF (form == 'FORMATTED') THEN
210  WRITE(unit,*)this%nx,this%ny
211  is_all = (ASSOCIATED(this%lon) .AND. ASSOCIATED(this%lat))
212  WRITE(unit,*)is_all
213  IF (is_all) THEN
214  WRITE(unit,*)this%lon,this%lat
215  ELSE
216  WRITE(unit,*)
217  ENDIF
218 ELSE
219  WRITE(unit)this%nx,this%ny
220  is_all = (ASSOCIATED(this%lon) .AND. ASSOCIATED(this%lat))
221  WRITE(unit)is_all
222  IF (is_all) THEN
223  WRITE(unit)this%lon,this%lat
224  ELSE
225  WRITE(unit)
226  ENDIF
227 ENDIF
228 
229 END SUBROUTINE grid_dim_write_unit
230 
233 SUBROUTINE grid_dim_display(this)
234 TYPE(grid_dim),INTENT(in) :: this
236 print*,'Number of points along x direction',this%nx
237 print*,'Number of points along y direction',this%ny
238 
239 END SUBROUTINE grid_dim_display
240 
241 END MODULE grid_dim_class
Function to check whether a value is missing or not.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Set of functions that return a CHARACTER representation of the input variable.
Gestione degli errori.
Definitions of constants and functions for working with missing values.
Module for defining the extension and coordinates of a rectangular georeferenced grid.
Utilities for CHARACTER variables.
Derived type describing the extension of a grid and the geographical coordinates of each point...

Generated with Doxygen.