source: XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90 @ 8

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

Importation des sources du serveur XMLIO

File size: 6.3 KB
Line 
1MODULE mod_dependency
2USE mod_field
3USE mod_file
4USE mod_grid
5USE mod_axis
6USE mod_sorted_list
7
8TYPE file_dep
9  TYPE(file),POINTER           :: file
10  INTEGER                      :: hash
11  TYPE(vector_field),POINTER   :: fields
12  TYPE(vector_grid),POINTER    :: grids
13  TYPE(vector_axis),POINTER    :: axis
14END TYPE file_dep
15
16TYPE field_dep
17  TYPE(field),POINTER :: field
18  INTEGER             :: hash
19 
20  TYPE(vector_field_out),POINTER   :: field_out
21END TYPE field_dep
22
23TYPE field_out
24  TYPE(Field), POINTER  :: field
25  TYPE(file),  POINTER  :: file
26  TYPE(axis),  POINTER  :: axis
27  TYPE(grid),  POINTER  :: grid
28END TYPE field_out
29
30INCLUDE 'vector_field_dep_def.inc'
31INCLUDE 'vector_file_dep_def.inc'
32INCLUDE 'vector_field_out_def.inc'
33
34TYPE(vector_file_dep),POINTER      :: file_enabled
35TYPE(vector_field_out),POINTER     :: field_enabled 
36TYPE(vector_field_dep),POINTER     :: field_id
37
38 
39TYPE(sorted_list),POINTER :: sorted_id
40
41CONTAINS
42
43INCLUDE 'vector_field_dep_contains.inc'
44INCLUDE 'vector_file_dep_contains.inc'
45INCLUDE 'vector_field_out_contains.inc'
46
47  SUBROUTINE set_dependency
48  IMPLICIT NONE
49 
50   CALL set_file_dependency
51   CALL set_field_enabled
52   CALL set_field_dependency
53
54  END SUBROUTINE set_dependency
55 
56 
57  RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group)
58  USE mod_file_definition
59  USE mod_file_group
60  USE string_function
61  USE mod_sorted_list
62  IMPLICIT NONE
63    TYPE (file_group),POINTER,OPTIONAL :: pt_file_group 
64    TYPE (file_group),POINTER          :: Pt_fg
65    TYPE (file)     ,POINTER           :: Pt_file
66    TYPE (file_dep),POINTER            :: Pt_file_dep
67    TYPE (sorted_list),POINTER         :: sorted_axis
68    TYPE (sorted_list),POINTER         :: sorted_grid
69    INTEGER                            :: i
70    INTEGER                            :: j
71   
72    ALLOCATE(sorted_axis)
73    ALLOCATE(sorted_grid)
74   
75    IF (PRESENT(Pt_file_group)) THEN
76      Pt_fg=>Pt_file_group
77    ELSE
78      ALLOCATE(file_enabled)
79      CALL vector_file_dep__new(file_enabled)
80      Pt_fg=>file_definition
81    ENDIF
82   
83    DO i=1,Pt_fg%groups%size
84      CALL set_file_dependency(Pt_fg%groups%at(i)%pt)
85    ENDDO
86   
87    DO i=1,Pt_fg%files%size
88      Pt_file=>pt_fg%files%at(i)%pt
89      IF (Pt_file%enabled) THEN
90        CALL vector_file_dep__get_new(file_enabled,Pt_file_dep)
91       
92        ALLOCATE(Pt_file_dep%fields)
93        ALLOCATE(Pt_file_dep%grids)
94        ALLOCATE(Pt_file_dep%axis)
95        pt_file_dep%file=>pt_file
96        pt_file_dep%hash=hash(pt_file%id)
97        CALL vector_field__new(Pt_file_dep%fields)
98        CALL vector_grid__new(Pt_file_dep%grids)
99        CALL vector_axis__new(Pt_file_dep%axis)
100        CALL sorted_list__new(sorted_axis)
101        CALL sorted_list__new(sorted_grid)
102       
103        CALL Treat_field_group(pt_file%field_list)
104       
105        CALL sorted_list__delete(sorted_axis)
106        CALL sorted_list__delete(sorted_grid)
107      ENDIF
108    ENDDO
109   
110    CONTAINS
111      RECURSIVE SUBROUTINE treat_field_group(pt_fg)
112      IMPLICIT NONE 
113        TYPE(field_group),POINTER :: Pt_fg
114        INTEGER                   :: i
115       
116        DO i=1,Pt_fg%groups%size
117          CALL treat_field_group(Pt_fg%groups%at(i)%pt)
118        ENDDO
119       
120        DO i=1,Pt_fg%fields%size
121          CALL treat_field(Pt_fg%fields%at(i)%pt)
122        ENDDO
123      END SUBROUTINE treat_field_group
124     
125     
126      SUBROUTINE treat_field(pt_field)
127      IMPLICIT NONE 
128        TYPE(field),POINTER :: Pt_field
129        LOGICAL             :: found
130        INTEGER             :: Pos
131
132        IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN
133          CALL vector_field__set_new(Pt_file_dep%fields,Pt_field)
134 
135          IF (Pt_field%has_grid) THEN
136            CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found)
137            IF (.NOT. found) THEN
138              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos)
139              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos)
140            ENDIF
141          ENDIF
142 
143          IF (Pt_field%has_axis) THEN
144            CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found)
145            IF (.NOT. found) THEN
146              CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos)
147              CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos)
148            ENDIF
149          ENDIF
150        ENDIF
151     
152      END SUBROUTINE treat_field
153     
154  END SUBROUTINE set_file_dependency
155 
156  SUBROUTINE set_field_enabled
157  IMPLICIT NONE
158  TYPE(file_dep),POINTER   :: pt_file_dep
159  TYPE(field_out),POINTER  :: pt_field_out
160  INTEGER                  :: i
161  INTEGER                  :: j
162 
163    ALLOCATE(field_enabled)
164    CALL vector_field_out__new(field_enabled)
165   
166    DO i=1,file_enabled%size
167      pt_file_dep=>file_enabled%at(i)%pt
168      DO j=1,pt_file_dep%fields%size
169        CALL vector_field_out__get_new(field_enabled,pt_field_out)
170        pt_field_out%field=>pt_file_dep%fields%at(j)%pt
171        pt_field_out%file=>pt_file_dep%file
172        pt_field_out%axis=>pt_field_out%field%axis
173        pt_field_out%grid=>pt_field_out%field%grid
174      ENDDO
175    ENDDO
176   
177     
178  END SUBROUTINE set_field_enabled
179     
180  SUBROUTINE set_field_dependency
181  USE string_function
182  IMPLICIT NONE
183  TYPE(field_out),POINTER :: pt_field_out
184  TYPE(field_dep),POINTER :: pt_field_dep
185  TYPE(field),POINTER     :: pt_field
186  TYPE(field),POINTER     :: pt_field_base
187  INTEGER :: pos
188  LOGICAL :: found
189  INTEGER :: i
190 
191    ALLOCATE(field_id)
192    CALL vector_field_dep__new(field_id)
193
194    ALLOCATE(sorted_id)
195    CALL sorted_list__new(sorted_id)
196   
197    DO i=1,field_enabled%size
198      pt_field_out=>field_enabled%at(i)%pt
199      pt_field=>pt_field_out%field
200      pt_field_base=>pt_field%field_base
201     
202      CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found)
203      IF (.NOT. found) THEN
204        CALL vector_field_dep__get_new(field_id,pt_field_dep,pos)
205        ALLOCATE(pt_field_dep%field_out)
206        CALL vector_field_out__new(pt_field_dep%field_out)
207        pt_field_dep%field=>pt_field_base       
208        CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos)
209      ELSE
210        pt_field_dep=>field_id%at(pos)%pt
211      ENDIF
212     
213      CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) 
214    ENDDO 
215     
216  END SUBROUTINE set_field_dependency     
217     
218   
219   
220END MODULE mod_dependency
Note: See TracBrowser for help on using the repository browser.