New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
mod_dependency.f90 in vendors/XMLIO_SERVER/current/src/XMLIO – NEMO

source: vendors/XMLIO_SERVER/current/src/XMLIO/mod_dependency.f90 @ 1897

Last change on this file since 1897 was 1897, checked in by flavoni, 14 years ago

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