source: XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90 @ 17

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

Importation des sources du serveur XMLIO
File size: 7.2 KB
Line 
1MODULE mod_file
2
3  USE mod_xmlio_parameters
4  USE mod_field_group
5  USE mod_sorted_list
6
7  TYPE, PUBLIC :: file
8    CHARACTER(len=str_len)           :: id
9    LOGICAL                          :: has_id
10    CHARACTER(len=str_len)           :: name
11    LOGICAL                          :: has_name
12    CHARACTER(len=str_len)           :: description
13    LOGICAL                          :: has_description
14    INTEGER                          :: output_freq
15    LOGICAL                          :: has_output_freq
16    INTEGER                          :: output_level
17    LOGICAL                          :: has_output_level
18    LOGICAL                          :: enabled
19    LOGICAL                          :: has_enabled
20    INTEGER                          :: internal(internal_file)
21    TYPE(field_group),POINTER        :: field_list 
22  END TYPE file
23
24  INCLUDE 'vector_file_def.inc'
25 
26  TYPE(vector_file),POINTER,SAVE             :: file_Ids
27  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
28
29CONTAINS
30  INCLUDE 'vector_file_contains.inc'
31
32  SUBROUTINE file__init
33  IMPLICIT NONE
34   
35    ALLOCATE(file_Ids)
36    ALLOCATE(Ids)
37   
38    CALL vector_file__new(file_Ids)
39    CALL sorted_list__new(Ids)
40   
41  END SUBROUTINE file__init
42 
43  SUBROUTINE file__get(Id,Pt_file)
44  USE string_function
45  IMPLICIT NONE
46    CHARACTER(LEN=*),INTENT(IN)     :: Id
47    TYPE(file),POINTER              :: Pt_file
48
49    INTEGER                         :: Pos
50    LOGICAL                         :: success
51   
52    CALL sorted_list__find(Ids,hash(Id),Pos,success)
53    IF (success) THEN
54      Pt_file=>file_ids%at(Pos)%Pt
55    ELSE
56      Pt_file=>NULL()
57    ENDIF
58   
59  END SUBROUTINE file__get
60 
61  SUBROUTINE file__new(pt_file,Id)
62  USE string_function
63  IMPLICIT NONE
64   TYPE(file), POINTER           :: pt_file
65   CHARACTER(LEN=*),OPTIONAL     :: Id
66   INTEGER                       :: Pos
67
68   ALLOCATE(pt_file%field_list)
69   CALL field_group__new(pt_file%field_list)
70     
71   pt_file%has_id           = .FALSE.
72   pt_file%has_name         = .FALSE.
73   pt_file%has_description  = .FALSE.
74   pt_file%has_output_freq  = .FALSE.
75   pt_file%has_output_level = .FALSE.
76   pt_file%has_output_level = .FALSE.
77   
78   IF (PRESENT(Id)) THEN
79     Pt_file%id=TRIM(ADJUSTL(Id))
80     Pt_file%has_id=.TRUE.
81     CALL vector_file__set_new(file_Ids,Pt_file,Pos)
82     CALL sorted_list__Add(Ids,hash(id),Pos)
83   ENDIF
84
85  END SUBROUTINE file__new
86
87  SUBROUTINE file__set(pt_file, name, description, output_freq, output_level,enabled)
88  IMPLICIT NONE
89    TYPE(file), POINTER         :: pt_file
90    CHARACTER(len=*)  ,OPTIONAL :: name
91    CHARACTER(len=*)  ,OPTIONAL :: description
92    INTEGER           ,OPTIONAL :: output_freq
93    INTEGER           ,OPTIONAL :: output_level
94    LOGICAL           ,OPTIONAL :: enabled
95
96    IF (PRESENT(name)) THEN
97        pt_file%name=TRIM(ADJUSTL(name))
98        pt_file%has_name = .TRUE.
99    ENDIF
100
101    IF (PRESENT(description)) THEN
102        pt_file%description=TRIM(ADJUSTL(description))
103        pt_file%has_description = .TRUE.
104    ENDIF
105 
106    IF (PRESENT(output_freq)) then
107        pt_file%output_freq=output_freq
108        pt_file%has_output_freq = .TRUE.
109    ENDIF
110
111    IF (PRESENT(output_level)) then
112        pt_file%output_level = output_level
113        pt_file%has_output_level = .TRUE.
114    ENDIF
115
116    IF (PRESENT(enabled)) then
117        pt_file%enabled = enabled
118        pt_file%has_enabled = .TRUE.
119    ENDIF
120   
121  END SUBROUTINE file__set
122
123  SUBROUTINE file__get_field_list(pt_file,pt_field_list)
124  IMPLICIT NONE
125    TYPE(file),POINTER         :: pt_file
126    TYPE(field_group),POINTER  :: pt_field_list
127   
128      pt_field_list=>pt_file%field_list
129 
130  END SUBROUTINE file__get_field_list
131   
132  SUBROUTINE file__print(pt_file)
133  IMPLICIT NONE
134    TYPE(file), POINTER         :: pt_file
135
136    PRINT *,"---- FILE ----"
137    IF (pt_file%has_id) THEN
138      PRINT *,"id = ",TRIM(pt_file%id)
139    ELSE
140      PRINT *,"id undefined"
141    ENDIF
142   
143    IF (pt_file%has_name) THEN
144      PRINT *,"name = ",TRIM(pt_file%name)
145    ELSE
146      PRINT *,"name undefined"
147    ENDIF
148   
149    IF (pt_file%has_description) THEN
150      PRINT *,"description = ",TRIM(pt_file%description)
151    ELSE
152      PRINT *,"description undefined"
153    ENDIF
154 
155    IF (pt_file%has_output_freq) THEN
156      PRINT *,"output_freq = ",pt_file%output_freq
157    ELSE
158      PRINT *,"output_freq undefined"
159    ENDIF
160
161    IF (pt_file%has_output_level) THEN
162      PRINT *,"output_level = ",pt_file%output_level
163    ELSE
164      PRINT *,"output_level undefined"
165    ENDIF
166
167    IF (pt_file%has_enabled) THEN
168      PRINT *,"enabled = ",pt_file%enabled
169    ELSE
170      PRINT *,"enabled undefined"
171    ENDIF
172
173    PRINT *,"field_list :"
174    CALL field_group__print(pt_file%field_list)
175
176    PRINT *,"--------------"
177
178  END SUBROUTINE file__print
179
180
181  SUBROUTINE file__apply_default(pt_file_default, pt_file_in, pt_file_out)
182
183    TYPE(file), POINTER :: pt_file_default, pt_file_in, pt_file_out
184
185    IF (pt_file_in%has_name) THEN
186        pt_file_out%name=pt_file_in%name
187        pt_file_out%has_name=.TRUE.
188    ELSE IF ( pt_file_default%has_name) THEN
189        pt_file_out%name=pt_file_default%name
190        pt_file_out%has_name=.TRUE.
191    ELSE
192        pt_file_out%has_name=.FALSE.
193    ENDIF
194       
195    IF (pt_file_in%has_description) THEN
196        pt_file_out%description=pt_file_in%description
197        pt_file_out%has_description=.TRUE.
198    ELSE IF ( pt_file_default%has_description ) THEN
199        pt_file_out%description=pt_file_default%description
200        pt_file_out%has_description=.TRUE.
201    ELSE
202        pt_file_out%has_description=.FALSE.
203    ENDIF
204
205    IF (pt_file_in%has_output_freq) THEN
206        pt_file_out%output_freq=pt_file_in%output_freq
207        pt_file_out%has_output_freq=.TRUE.
208    ELSE IF ( pt_file_default%has_output_freq ) THEN
209        pt_file_out%output_freq=pt_file_default%output_freq
210        pt_file_out%has_output_freq=.TRUE.
211    ELSE
212        pt_file_out%has_output_freq=.FALSE.
213    ENDIF
214
215    IF (pt_file_in%has_output_level) THEN
216        pt_file_out%output_level=pt_file_in%output_level
217        pt_file_out%has_output_level=.TRUE.
218    ELSE IF ( pt_file_default%has_output_level ) THEN
219        pt_file_out%output_level=pt_file_default%output_level
220        pt_file_out%has_output_level=.TRUE.
221    ELSE
222        pt_file_out%has_output_level=.FALSE.
223    ENDIF
224
225    IF (pt_file_in%has_enabled) THEN
226        pt_file_out%enabled=pt_file_in%enabled
227        pt_file_out%has_enabled=.TRUE.
228    ELSE IF ( pt_file_default%has_enabled ) THEN
229        pt_file_out%enabled=pt_file_default%enabled
230        pt_file_out%has_enabled=.TRUE.
231    ELSE
232        pt_file_out%has_enabled=.FALSE.
233    ENDIF
234   
235    CALL field_group__apply_default(pt_file_out%field_list)
236
237
238  END SUBROUTINE file__apply_default
239
240   
241  SUBROUTINE file__solve_field_ref(pt_file)
242  IMPLICIT NONE
243    TYPE(file), POINTER :: pt_file
244   
245    CALL field_group__solve_ref(pt_file%field_list)
246 
247  END SUBROUTINE file__solve_field_ref
248 
249 
250  SUBROUTINE file__Check(pt_file)
251  USE error_msg
252  IMPLICIT NONE
253    TYPE(file), POINTER :: pt_file
254     
255    IF (.NOT. pt_file%has_name) THEN
256      IF (pt_file%has_id) THEN
257        pt_file%name=TRIM(pt_file%id)
258      ELSE
259        WRITE(message,*) "File has no name and no id" 
260        CALL error("mod_file::file__check")
261      ENDIF
262    ENDIF
263 
264 END SUBROUTINE file__Check
265   
266END MODULE mod_file
Note: See TracBrowser for help on using the repository browser.