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

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