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

Last change on this file since 26 was 26, checked in by ymipsl, 13 years ago

Mise à jour importante :

  • ajout de la grille type LMDZ
  • ajout des context
  • ajout de namelist pour parametrer l'utilisation du server : avec/sans MPI, en utlisant ou pas OASIS
File size: 6.4 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    REAL, DIMENSION(:), POINTER :: values
21    LOGICAL                     :: has_values
22
23  END TYPE axis
24
25  INCLUDE 'vector_axis_def.inc'
26 
27  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids
28  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
29
30CONTAINS
31  INCLUDE 'vector_axis_contains.inc'
32
33  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids)
34  IMPLICIT NONE
35    TYPE(vector_axis),POINTER          :: saved_axis_Ids
36    TYPE(sorted_list),POINTER          :: saved_Ids 
37   
38    axis_ids=>saved_axis_ids
39    ids=>saved_ids
40   
41  END SUBROUTINE axis__swap_context
42
43  SUBROUTINE axis__init
44  IMPLICIT NONE
45   
46    CALL vector_axis__new(axis_Ids)
47    CALL sorted_list__new(Ids)
48   
49  END SUBROUTINE axis__init
50 
51  SUBROUTINE axis__get(Id,Pt_axis)
52  USE string_function
53  IMPLICIT NONE
54    CHARACTER(LEN=*),INTENT(IN)     :: Id
55    TYPE(axis),POINTER              :: Pt_axis
56
57    INTEGER                         :: Pos
58    LOGICAL                         :: success
59   
60    CALL sorted_list__find(Ids,hash(Id),Pos,success)
61    IF (success) THEN
62      Pt_axis=>axis_ids%at(Pos)%Pt
63    ELSE
64      Pt_axis=>NULL()
65    ENDIF
66   
67  END SUBROUTINE axis__get
68 
69  SUBROUTINE axis__new(pt_axis,Id)
70  USE string_function
71  IMPLICIT NONE
72   TYPE(axis), POINTER           :: pt_axis
73   CHARACTER(LEN=*),OPTIONAL     :: Id
74   INTEGER                       :: Pos
75   
76   pt_axis%has_id         = .FALSE.
77   pt_axis%has_name        = .FALSE.
78   pt_axis%has_size        = .FALSE.
79   pt_axis%has_description = .FALSE.
80   pt_axis%has_unit        = .FALSE.
81   pt_axis%has_values      = .FALSE.
82   
83   IF (PRESENT(Id)) THEN
84     Pt_axis%id=TRIM(ADJUSTL(Id))
85     Pt_axis%has_id=.TRUE.
86     CALL vector_axis__set_new(axis_Ids,Pt_axis,Pos)
87     CALL sorted_list__Add(Ids,hash(id),Pos)
88   ENDIF
89
90 END SUBROUTINE axis__new
91
92  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values)
93  IMPLICIT NONE
94    TYPE(axis), POINTER         :: pt_axis
95    CHARACTER(len=*)  ,OPTIONAL :: name
96    CHARACTER(len=*)  ,OPTIONAL :: description
97    CHARACTER(len=*)  ,OPTIONAL :: unit
98    INTEGER           ,OPTIONAL :: a_size
99    REAL, DIMENSION(:),OPTIONAL :: values
100
101    IF (PRESENT(name)) THEN
102        pt_axis%name=TRIM(ADJUSTL(name))
103        pt_axis%has_name = .TRUE.
104    ENDIF
105
106    IF (PRESENT(description)) THEN
107        pt_axis%description=TRIM(ADJUSTL(description))
108        pt_axis%has_description = .TRUE.
109    ENDIF
110 
111    IF (PRESENT(unit)) then
112        pt_axis%unit=TRIM(ADJUSTL(unit))
113        pt_axis%has_unit = .TRUE.
114    ENDIF
115
116    IF (PRESENT(a_size)) then
117        pt_axis%size=a_size
118        pt_axis%has_size = .TRUE.
119    ENDIF
120   
121    IF (PRESENT(values)) then
122        IF (pt_axis%has_values) DEALLOCATE(pt_axis%values) 
123        ALLOCATE(pt_axis%values(size(values)))
124        pt_axis%values(:)=values(:)
125        pt_axis%has_values = .TRUE.
126    ENDIF
127
128  END SUBROUTINE axis__set
129
130  SUBROUTINE axis__print(pt_axis)
131  IMPLICIT NONE
132    TYPE(axis), POINTER         :: pt_axis
133
134    PRINT *,"---- AXIS ----"
135    IF (pt_axis%has_id) THEN
136      PRINT *,"id = ",TRIM(pt_axis%id)
137    ELSE
138      PRINT *,"id undefined"
139    ENDIF
140   
141    IF (pt_axis%has_name) THEN
142      PRINT *,"name = ",TRIM(pt_axis%name)
143    ELSE
144      PRINT *,"name undefined"
145    ENDIF
146   
147    IF (pt_axis%has_description) THEN
148      PRINT *,"description = ",TRIM(pt_axis%description)
149    ELSE
150      PRINT *,"description undefined"
151    ENDIF
152 
153    IF (pt_axis%has_unit) THEN
154      PRINT *,"unit = ",TRIM(pt_axis%unit)
155    ELSE
156      PRINT *,"unit undefined"
157    ENDIF
158
159    IF (pt_axis%has_size) THEN
160      PRINT *,"size = ",pt_axis%size
161    ELSE
162      PRINT *,"size undefined"
163    ENDIF
164
165    IF (pt_axis%has_values) THEN
166      PRINT *,"values = ",pt_axis%values
167    ELSE
168      PRINT *,"values undefined"
169    ENDIF
170
171  END SUBROUTINE axis__print
172
173
174  SUBROUTINE axis__apply_default(pt_axis_default, pt_axis_in, pt_axis_out)
175
176    TYPE(axis), POINTER :: pt_axis_default, pt_axis_in, pt_axis_out
177
178    IF (pt_axis_in%has_name) THEN
179        pt_axis_out%name=pt_axis_in%name
180        pt_axis_out%has_name=.TRUE.
181    ELSE IF ( pt_axis_default%has_name) THEN
182        pt_axis_out%name=pt_axis_default%name
183        pt_axis_out%has_name=.TRUE.
184    ELSE
185        pt_axis_out%has_name=.FALSE.
186    ENDIF
187       
188    IF (pt_axis_in%has_description) THEN
189        pt_axis_out%description=pt_axis_in%description
190        pt_axis_out%has_description=.TRUE.
191    ELSE IF ( pt_axis_default%has_description ) THEN
192        pt_axis_out%description=pt_axis_default%description
193        pt_axis_out%has_description=.TRUE.
194    ELSE
195        pt_axis_out%has_description=.FALSE.
196    ENDIF
197
198    IF (pt_axis_in%has_unit) THEN
199        pt_axis_out%unit=pt_axis_in%unit
200        pt_axis_out%has_unit=.TRUE.
201    ELSE IF ( pt_axis_default%has_unit ) THEN
202        pt_axis_out%unit=pt_axis_default%unit
203        pt_axis_out%has_unit=.TRUE.
204    ELSE
205        pt_axis_out%has_unit=.FALSE.
206    ENDIF
207
208    IF (pt_axis_in%has_size) THEN
209        pt_axis_out%size=pt_axis_in%size
210        pt_axis_out%has_size=.TRUE.
211    ELSE IF ( pt_axis_default%has_size ) THEN
212        pt_axis_out%size=pt_axis_default%size
213        pt_axis_out%has_size=.TRUE.
214    ELSE
215        pt_axis_out%has_size=.FALSE.
216    ENDIF
217
218    IF (pt_axis_in%has_values) THEN
219        pt_axis_out%values(:)=pt_axis_in%values(:)
220        pt_axis_out%has_values=.TRUE.
221    ELSE IF ( pt_axis_default%has_values ) THEN
222        pt_axis_out%values(:)=pt_axis_default%values(:)
223        pt_axis_out%has_values=.TRUE.
224    ELSE
225        pt_axis_out%has_values=.FALSE.
226    ENDIF
227   
228  END SUBROUTINE axis__apply_default
229
230  SUBROUTINE axis__check(pt_axis)
231  USE error_msg
232  IMPLICIT NONE
233    TYPE(axis), POINTER :: pt_axis
234     
235    IF (.NOT. pt_axis%has_name) THEN
236      IF (pt_axis%has_id) THEN
237        pt_axis%name=TRIM(pt_axis%id)
238      ELSE
239        WRITE(message,*) "Axis has no name and no id" 
240        CALL error("mod_axis::axis__check")
241      ENDIF
242    ENDIF
243 
244 END SUBROUTINE axis__Check
245
246END MODULE mod_axis
Note: See TracBrowser for help on using the repository browser.