source: XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.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: 5.3 KB
Line 
1MODULE mod_file_group
2  USE mod_file
3  USE mod_xmlio_parameters
4
5  IMPLICIT NONE
6
7  TYPE file_group
8    CHARACTER(LEN=str_len)                    :: id
9    LOGICAL                                   :: has_id
10    TYPE(vector_file_group), POINTER          :: groups
11    TYPE(vector_file),POINTER                 :: files     
12    TYPE(file), POINTER                       :: default_attribut
13  END TYPE file_group
14
15  INCLUDE "vector_file_group_def.inc" 
16
17  TYPE(vector_file_group),POINTER,SAVE       :: file_group_Ids
18  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids 
19
20CONTAINS
21
22  INCLUDE "vector_file_group_contains.inc"
23
24  SUBROUTINE file_group__swap_context(saved_file_group_ids,saved_ids)
25  IMPLICIT NONE
26    TYPE(vector_file_group),POINTER      :: saved_file_group_Ids
27    TYPE(sorted_list),POINTER            :: saved_Ids
28   
29    file_group_ids=>saved_file_group_ids
30    ids=>saved_ids 
31 
32  END SUBROUTINE file_group__swap_context
33
34  SUBROUTINE file_group__init
35  IMPLICIT NONE
36   
37    CALL vector_file_group__new(file_group_Ids)
38    CALL sorted_list__new(Ids)
39   
40  END SUBROUTINE file_group__init
41
42  SUBROUTINE file_group__get(Id,Pt_fg)
43  USE string_function
44  IMPLICIT NONE
45    CHARACTER(LEN=*),INTENT(IN)     :: Id
46    TYPE(file_group),POINTER        :: Pt_fg
47
48    INTEGER                         :: Pos
49    LOGICAL                         :: success
50   
51    CALL sorted_list__find(Ids,hash(Id),Pos,success)
52    IF (success) THEN
53      Pt_fg=>file_group_ids%at(Pos)%Pt
54    ELSE
55      Pt_fg=>NULL()
56    ENDIF
57   
58  END SUBROUTINE file_group__get
59   
60  RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id)
61  USE string_function
62  IMPLICIT NONE
63    TYPE(file_group),POINTER                :: Pt_fg
64    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
65   
66    INTEGER :: Pos
67   
68    ALLOCATE(Pt_fg%groups)
69    ALLOCATE(Pt_fg%files)
70    ALLOCATE(Pt_fg%default_attribut)
71   
72    CALL vector_file_group__new(Pt_fg%groups)
73    CALL vector_file__new(Pt_fg%files)
74    CALL file__new(Pt_fg%default_attribut)
75    Pt_fg%has_id=.FALSE.
76     
77    IF (PRESENT(Id)) THEN
78      Pt_fg%id=TRIM(Id)
79      Pt_fg%has_id=.TRUE.
80      CALL vector_file_group__set_new(file_group_Ids,Pt_fg,Pos)
81      CALL sorted_list__Add(Ids,hash(id),Pos)
82    ENDIF
83
84  END SUBROUTINE file_group__new
85
86     
87  SUBROUTINE file_group__get_new_group(Pt_fg,Pt_fg_out,Id)
88  IMPLICIT NONE
89    TYPE(file_group),POINTER             :: Pt_fg
90    TYPE(file_group),POINTER             :: Pt_fg_out
91    CHARACTER(LEN=str_len),OPTIONAL      :: Id
92   
93    CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out)
94    CALL file_group__new(Pt_fg_out)
95
96    IF (PRESENT(id)) THEN
97      CALL file_group__new(Pt_fg_out,Id)
98    ELSE
99      CALL file_group__new(Pt_fg_out)
100    ENDIF
101   
102  END SUBROUTINE file_group__get_new_group
103
104 
105  SUBROUTINE file_group__get_new_file(Pt_fg,Pt_f_out,Id)
106  IMPLICIT NONE
107    TYPE(file_group),POINTER            :: Pt_fg
108    TYPE(file),POINTER                  :: Pt_f_out
109    CHARACTER(LEN=*),OPTIONAL      :: Id
110   
111    CALL vector_file__get_new(Pt_fg%files,Pt_f_out)
112   
113    IF (PRESENT(id)) THEN
114      CALL file__new(Pt_f_out,Id)
115    ELSE
116      CALL file__new(Pt_f_out)
117    ENDIF
118   
119  END SUBROUTINE file_group__get_new_file
120 
121 
122  SUBROUTINE file_group__get_default_attrib(Pt_fg,Pt_f)
123  IMPLICIT NONE
124    TYPE(file_group),POINTER  :: Pt_fg
125    TYPE(file),POINTER        :: Pt_f
126   
127    Pt_f=>Pt_fg%default_attribut
128  END SUBROUTINE file_group__get_default_attrib
129 
130  RECURSIVE SUBROUTINE file_group__apply_default(Pt_fg,default)
131  IMPLICIT NONE
132    TYPE(file_group),POINTER  :: Pt_fg
133    TYPE(file),POINTER,OPTIONAL        :: default
134   
135    INTEGER :: i
136   
137    IF (PRESENT(default)) THEN
138      CALL file__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
139    ENDIF
140     
141    DO i=1,Pt_fg%groups%size
142      CALL file_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
143    ENDDO
144   
145    DO i=1,Pt_fg%files%size
146      CALL file__apply_default(Pt_fg%default_attribut,Pt_fg%files%at(i)%pt,Pt_fg%files%at(i)%pt)
147    ENDDO
148 
149  END SUBROUTINE file_group__apply_default
150
151  SUBROUTINE file_group__solve_field_ref(pt_fg)
152  IMPLICIT NONE
153    TYPE(file_group),POINTER  :: Pt_fg
154
155    INTEGER :: i
156   
157    DO i=1,Pt_fg%files%size
158      CALL file__solve_field_ref(Pt_fg%files%at(i)%pt)
159    ENDDO
160 
161  END SUBROUTINE file_group__solve_field_ref
162 
163 
164  RECURSIVE SUBROUTINE file_group__print(Pt_fg)
165  IMPLICIT NONE
166    TYPE(file_group),POINTER  :: Pt_fg
167   
168    INTEGER :: i
169   
170    PRINT *,"--- FILE GROUP ---"
171    IF (Pt_fg%has_id) THEN
172      PRINT *,"id :",TRIM(Pt_fg%id)
173    ELSE
174      PRINT *,"id undefined"
175    ENDIF
176   
177    PRINT *,"file default attribut :"
178    CALL file__print(Pt_fg%default_attribut)   
179
180    PRINT *,"owned file groups :"     
181    DO i=1,Pt_fg%groups%size
182      CALL file_group__print(Pt_fg%groups%at(i)%pt)
183    ENDDO
184
185    PRINT *,"owned file :"     
186    DO i=1,Pt_fg%files%size
187      CALL file__print(Pt_fg%files%at(i)%pt)
188    ENDDO
189 
190  END SUBROUTINE file_group__print     
191
192  RECURSIVE SUBROUTINE file_group__Check(Pt_fg)
193  IMPLICIT NONE
194 
195    TYPE(file_group),POINTER  :: Pt_fg
196    INTEGER :: i
197   
198    DO i=1,Pt_fg%groups%size
199      CALL file_group__check(pt_fg%groups%at(i)%pt)
200    ENDDO
201
202    DO i=1,Pt_fg%files%size
203      CALL file__check(pt_fg%files%at(i)%pt)
204    ENDDO
205 
206  END SUBROUTINE file_group__check     
207         
208END MODULE mod_file_group
209
Note: See TracBrowser for help on using the repository browser.