source: XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.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: 6.7 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,SAVE      :: file_enabled
35TYPE(vector_field_out),POINTER,SAVE     :: field_enabled 
36TYPE(vector_field_dep),POINTER,SAVE     :: field_id
37
38 
39TYPE(sorted_list),POINTER,SAVE :: 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 
48  SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id) 
49  IMPLICIT NONE
50    TYPE(vector_file_dep),POINTER      :: saved_file_enabled
51    TYPE(vector_field_out),POINTER     :: saved_field_enabled 
52    TYPE(vector_field_dep),POINTER     :: save_field_id
53    TYPE(sorted_list),POINTER          :: saved_sorted_id 
54   
55    file_enabled=>saved_file_enabled   
56    field_enabled=>saved_field_enabled
57    field_id=>save_field_id
58    sorted_id=>saved_sorted_id
59     
60  END SUBROUTINE dependency__swap_context
61 
62  SUBROUTINE set_dependency
63  IMPLICIT NONE
64 
65   CALL set_file_dependency
66   CALL set_field_enabled
67   CALL set_field_dependency
68
69  END SUBROUTINE set_dependency
70 
71 
72  RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group)
73  USE mod_file_definition
74  USE mod_file_group
75  USE string_function
76  USE mod_sorted_list
77  IMPLICIT NONE
78    TYPE (file_group),POINTER,OPTIONAL :: pt_file_group 
79    TYPE (file_group),POINTER          :: Pt_fg
80    TYPE (file)     ,POINTER           :: Pt_file
81    TYPE (file_dep),POINTER            :: Pt_file_dep
82    TYPE (sorted_list),POINTER         :: sorted_axis
83    TYPE (sorted_list),POINTER         :: sorted_grid
84    INTEGER                            :: i
85    INTEGER                            :: j
86   
87    ALLOCATE(sorted_axis)
88    ALLOCATE(sorted_grid)
89   
90    IF (PRESENT(Pt_file_group)) THEN
91      Pt_fg=>Pt_file_group
92    ELSE
93      CALL vector_file_dep__new(file_enabled)
94      Pt_fg=>file_definition
95    ENDIF
96   
97    DO i=1,Pt_fg%groups%size
98      CALL set_file_dependency(Pt_fg%groups%at(i)%pt)
99    ENDDO
100   
101    DO i=1,Pt_fg%files%size
102      Pt_file=>pt_fg%files%at(i)%pt
103      IF (Pt_file%enabled) THEN
104        CALL vector_file_dep__get_new(file_enabled,Pt_file_dep)
105       
106        ALLOCATE(Pt_file_dep%fields)
107        ALLOCATE(Pt_file_dep%grids)
108        ALLOCATE(Pt_file_dep%axis)
109        pt_file_dep%file=>pt_file
110        pt_file_dep%hash=hash(pt_file%id)
111        CALL vector_field__new(Pt_file_dep%fields)
112        CALL vector_grid__new(Pt_file_dep%grids)
113        CALL vector_axis__new(Pt_file_dep%axis)
114        CALL sorted_list__new(sorted_axis)
115        CALL sorted_list__new(sorted_grid)
116       
117        CALL Treat_field_group(pt_file%field_list)
118       
119        CALL sorted_list__delete(sorted_axis)
120        CALL sorted_list__delete(sorted_grid)
121      ENDIF
122    ENDDO
123   
124    CONTAINS
125      RECURSIVE SUBROUTINE treat_field_group(pt_fg)
126      IMPLICIT NONE 
127        TYPE(field_group),POINTER :: Pt_fg
128        INTEGER                   :: i
129       
130        DO i=1,Pt_fg%groups%size
131          CALL treat_field_group(Pt_fg%groups%at(i)%pt)
132        ENDDO
133       
134        DO i=1,Pt_fg%fields%size
135          CALL treat_field(Pt_fg%fields%at(i)%pt)
136        ENDDO
137      END SUBROUTINE treat_field_group
138     
139     
140      SUBROUTINE treat_field(pt_field)
141      IMPLICIT NONE 
142        TYPE(field),POINTER :: Pt_field
143        LOGICAL             :: found
144        INTEGER             :: Pos
145
146        IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN
147          CALL vector_field__set_new(Pt_file_dep%fields,Pt_field)
148 
149          IF (Pt_field%has_grid) THEN
150            CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found)
151            IF (.NOT. found) THEN
152              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos)
153              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos)
154            ENDIF
155          ENDIF
156 
157          IF (Pt_field%has_axis) THEN
158            CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found)
159            IF (.NOT. found) THEN
160              CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos)
161              CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos)
162            ENDIF
163          ENDIF
164        ENDIF
165     
166      END SUBROUTINE treat_field
167     
168  END SUBROUTINE set_file_dependency
169 
170  SUBROUTINE set_field_enabled
171  IMPLICIT NONE
172  TYPE(file_dep),POINTER   :: pt_file_dep
173  TYPE(field_out),POINTER  :: pt_field_out
174  INTEGER                  :: i
175  INTEGER                  :: j
176 
177    CALL vector_field_out__new(field_enabled)
178   
179    DO i=1,file_enabled%size
180      pt_file_dep=>file_enabled%at(i)%pt
181      DO j=1,pt_file_dep%fields%size
182        CALL vector_field_out__get_new(field_enabled,pt_field_out)
183        pt_field_out%field=>pt_file_dep%fields%at(j)%pt
184        pt_field_out%file=>pt_file_dep%file
185        pt_field_out%axis=>pt_field_out%field%axis
186        pt_field_out%grid=>pt_field_out%field%grid
187      ENDDO
188    ENDDO
189   
190     
191  END SUBROUTINE set_field_enabled
192     
193  SUBROUTINE set_field_dependency
194  USE string_function
195  IMPLICIT NONE
196  TYPE(field_out),POINTER :: pt_field_out
197  TYPE(field_dep),POINTER :: pt_field_dep
198  TYPE(field),POINTER     :: pt_field
199  TYPE(field),POINTER     :: pt_field_base
200  INTEGER :: pos
201  LOGICAL :: found
202  INTEGER :: i
203 
204    CALL vector_field_dep__new(field_id)
205    CALL sorted_list__new(sorted_id)
206   
207    DO i=1,field_enabled%size
208      pt_field_out=>field_enabled%at(i)%pt
209      pt_field=>pt_field_out%field
210      pt_field_base=>pt_field%field_base
211      CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found)
212      IF (.NOT. found) THEN
213        CALL vector_field_dep__get_new(field_id,pt_field_dep,pos)
214        ALLOCATE(pt_field_dep%field_out)
215        CALL vector_field_out__new(pt_field_dep%field_out)
216        pt_field_dep%field=>pt_field_base       
217        CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos)
218      ELSE
219        pt_field_dep=>field_id%at(pos)%pt
220      ENDIF
221     
222      CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) 
223    ENDDO 
224     
225  END SUBROUTINE set_field_dependency     
226     
227   
228   
229END MODULE mod_dependency
Note: See TracBrowser for help on using the repository browser.