source: XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90 @ 29

Last change on this file since 29 was 29, checked in by ymipsl, 15 years ago

New Features :

  • Les zoom sont maintenant utilisables.
  • Lorsqu'un serveur ne sort pas de données dans un fichier, le fichier n'est pas crée.
  • Lorsqu'un serveur est le seul a sortir un fichier, l'indexation par numero de process est supprimé.
  • Les axes verticaux ont maintenant un attribut << positive [TRUE/FALSE]>>
File size: 7.1 KB
Line 
1MODULE mod_axis
2
3  USE mod_xmlio_parameters
4  USE mod_sorted_list
5
6 
7  IMPLICIT NONE
8
9  TYPE, PUBLIC :: axis
10    CHARACTER(len=str_len)      :: id
11    LOGICAL                     :: has_id
12    CHARACTER(len=str_len)      :: name
13    LOGICAL                     :: has_name
14    INTEGER                     :: size
15    LOGICAL                     :: has_size
16    CHARACTER(len=str_len)      :: description
17    LOGICAL                     :: has_description
18    CHARACTER(len=str_len)      :: unit
19    LOGICAL                     :: has_unit
20    LOGICAL                     :: positive
21    LOGICAL                     :: has_positive
22    REAL, DIMENSION(:), POINTER :: values
23    LOGICAL                     :: has_values
24
25  END TYPE axis
26
27  INCLUDE 'vector_axis_def.inc'
28 
29  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids
30  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
31
32CONTAINS
33  INCLUDE 'vector_axis_contains.inc'
34
35  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids)
36  IMPLICIT NONE
37    TYPE(vector_axis),POINTER          :: saved_axis_Ids
38    TYPE(sorted_list),POINTER          :: saved_Ids 
39   
40    axis_ids=>saved_axis_ids
41    ids=>saved_ids
42   
43  END SUBROUTINE axis__swap_context
44
45  SUBROUTINE axis__init
46  IMPLICIT NONE
47   
48    CALL vector_axis__new(axis_Ids)
49    CALL sorted_list__new(Ids)
50   
51  END SUBROUTINE axis__init
52 
53  SUBROUTINE axis__get(Id,Pt_axis)
54  USE string_function
55  IMPLICIT NONE
56    CHARACTER(LEN=*),INTENT(IN)     :: Id
57    TYPE(axis),POINTER              :: Pt_axis
58
59    INTEGER                         :: Pos
60    LOGICAL                         :: success
61   
62    CALL sorted_list__find(Ids,hash(Id),Pos,success)
63    IF (success) THEN
64      Pt_axis=>axis_ids%at(Pos)%Pt
65    ELSE
66      Pt_axis=>NULL()
67    ENDIF
68   
69  END SUBROUTINE axis__get
70 
71  SUBROUTINE axis__new(pt_axis,Id)
72  USE string_function
73  IMPLICIT NONE
74   TYPE(axis), POINTER           :: pt_axis
75   CHARACTER(LEN=*),OPTIONAL     :: Id
76   INTEGER                       :: Pos
77   
78   pt_axis%has_id          = .FALSE.
79   pt_axis%has_name        = .FALSE.
80   pt_axis%has_size        = .FALSE.
81   pt_axis%has_description = .FALSE.
82   pt_axis%has_unit        = .FALSE.
83   pt_axis%has_values      = .FALSE.
84   pt_axis%has_positive    = .FALSE. 
85     
86   IF (PRESENT(Id)) THEN
87     Pt_axis%id=TRIM(ADJUSTL(Id))
88     Pt_axis%has_id=.TRUE.
89     CALL vector_axis__set_new(axis_Ids,Pt_axis,Pos)
90     CALL sorted_list__Add(Ids,hash(id),Pos)
91   ENDIF
92
93 END SUBROUTINE axis__new
94
95  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values, positive)
96  IMPLICIT NONE
97    TYPE(axis), POINTER         :: pt_axis
98    CHARACTER(len=*)  ,OPTIONAL :: name
99    CHARACTER(len=*)  ,OPTIONAL :: description
100    CHARACTER(len=*)  ,OPTIONAL :: unit
101    INTEGER           ,OPTIONAL :: a_size
102    REAL, DIMENSION(:),OPTIONAL :: values
103    LOGICAL           ,OPTIONAL :: positive
104
105    IF (PRESENT(name)) THEN
106        pt_axis%name=TRIM(ADJUSTL(name))
107        pt_axis%has_name = .TRUE.
108    ENDIF
109
110    IF (PRESENT(description)) THEN
111        pt_axis%description=TRIM(ADJUSTL(description))
112        pt_axis%has_description = .TRUE.
113    ENDIF
114 
115    IF (PRESENT(unit)) then
116        pt_axis%unit=TRIM(ADJUSTL(unit))
117        pt_axis%has_unit = .TRUE.
118    ENDIF
119
120    IF (PRESENT(a_size)) then
121        pt_axis%size=a_size
122        pt_axis%has_size = .TRUE.
123    ENDIF
124   
125    IF (PRESENT(values)) then
126        IF (pt_axis%has_values) DEALLOCATE(pt_axis%values) 
127        ALLOCATE(pt_axis%values(size(values)))
128        pt_axis%values(:)=values(:)
129        pt_axis%has_values = .TRUE.
130    ENDIF
131
132    IF (PRESENT(positive)) then
133        pt_axis%positive=positive
134        pt_axis%has_positive = .TRUE.
135    ENDIF
136
137  END SUBROUTINE axis__set
138
139  SUBROUTINE axis__print(pt_axis)
140  IMPLICIT NONE
141    TYPE(axis), POINTER         :: pt_axis
142
143    PRINT *,"---- AXIS ----"
144    IF (pt_axis%has_id) THEN
145      PRINT *,"id = ",TRIM(pt_axis%id)
146    ELSE
147      PRINT *,"id undefined"
148    ENDIF
149   
150    IF (pt_axis%has_name) THEN
151      PRINT *,"name = ",TRIM(pt_axis%name)
152    ELSE
153      PRINT *,"name undefined"
154    ENDIF
155   
156    IF (pt_axis%has_description) THEN
157      PRINT *,"description = ",TRIM(pt_axis%description)
158    ELSE
159      PRINT *,"description undefined"
160    ENDIF
161 
162    IF (pt_axis%has_unit) THEN
163      PRINT *,"unit = ",TRIM(pt_axis%unit)
164    ELSE
165      PRINT *,"unit undefined"
166    ENDIF
167
168    IF (pt_axis%has_size) THEN
169      PRINT *,"size = ",pt_axis%size
170    ELSE
171      PRINT *,"size undefined"
172    ENDIF
173
174    IF (pt_axis%has_values) THEN
175      PRINT *,"values = ",pt_axis%values
176    ELSE
177      PRINT *,"values undefined"
178    ENDIF
179
180    IF (pt_axis%has_positive) THEN
181      PRINT *,"positive = ",pt_axis%positive
182    ELSE
183      PRINT *,"positive undefined"
184    ENDIF
185
186  END SUBROUTINE axis__print
187
188
189  SUBROUTINE axis__apply_default(pt_axis_default, pt_axis_in, pt_axis_out)
190
191    TYPE(axis), POINTER :: pt_axis_default, pt_axis_in, pt_axis_out
192
193    IF (pt_axis_in%has_name) THEN
194        pt_axis_out%name=pt_axis_in%name
195        pt_axis_out%has_name=.TRUE.
196    ELSE IF ( pt_axis_default%has_name) THEN
197        pt_axis_out%name=pt_axis_default%name
198        pt_axis_out%has_name=.TRUE.
199    ELSE
200        pt_axis_out%has_name=.FALSE.
201    ENDIF
202       
203    IF (pt_axis_in%has_description) THEN
204        pt_axis_out%description=pt_axis_in%description
205        pt_axis_out%has_description=.TRUE.
206    ELSE IF ( pt_axis_default%has_description ) THEN
207        pt_axis_out%description=pt_axis_default%description
208        pt_axis_out%has_description=.TRUE.
209    ELSE
210        pt_axis_out%has_description=.FALSE.
211    ENDIF
212
213    IF (pt_axis_in%has_unit) THEN
214        pt_axis_out%unit=pt_axis_in%unit
215        pt_axis_out%has_unit=.TRUE.
216    ELSE IF ( pt_axis_default%has_unit ) THEN
217        pt_axis_out%unit=pt_axis_default%unit
218        pt_axis_out%has_unit=.TRUE.
219    ELSE
220        pt_axis_out%has_unit=.FALSE.
221    ENDIF
222
223    IF (pt_axis_in%has_size) THEN
224        pt_axis_out%size=pt_axis_in%size
225        pt_axis_out%has_size=.TRUE.
226    ELSE IF ( pt_axis_default%has_size ) THEN
227        pt_axis_out%size=pt_axis_default%size
228        pt_axis_out%has_size=.TRUE.
229    ELSE
230        pt_axis_out%has_size=.FALSE.
231    ENDIF
232
233    IF (pt_axis_in%has_values) THEN
234        pt_axis_out%values(:)=pt_axis_in%values(:)
235        pt_axis_out%has_values=.TRUE.
236    ELSE IF ( pt_axis_default%has_values ) THEN
237        pt_axis_out%values(:)=pt_axis_default%values(:)
238        pt_axis_out%has_values=.TRUE.
239    ELSE
240        pt_axis_out%has_values=.FALSE.
241    ENDIF
242
243    IF (pt_axis_in%has_positive) THEN
244        pt_axis_out%positive=pt_axis_in%positive
245        pt_axis_out%has_positive=.TRUE.
246    ELSE IF ( pt_axis_default%has_positive ) THEN
247        pt_axis_out%positive=pt_axis_default%positive
248        pt_axis_out%has_positive=.TRUE.
249    ELSE
250        pt_axis_out%has_positive=.FALSE.
251    ENDIF
252   
253  END SUBROUTINE axis__apply_default
254
255  SUBROUTINE axis__check(pt_axis)
256  USE error_msg
257  IMPLICIT NONE
258    TYPE(axis), POINTER :: pt_axis
259     
260    IF (.NOT. pt_axis%has_name) THEN
261      IF (pt_axis%has_id) THEN
262        pt_axis%name=TRIM(pt_axis%id)
263      ELSE
264        WRITE(message,*) "Axis has no name and no id" 
265        CALL error("mod_axis::axis__check")
266      ENDIF
267    ENDIF
268 
269 END SUBROUTINE axis__Check
270
271END MODULE mod_axis
Note: See TracBrowser for help on using the repository browser.