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_context.f90 in branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO – NEMO

source: branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90 @ 4660

Last change on this file since 4660 was 4660, checked in by timgraham, 10 years ago

Fixes described in ticket #1302 to XMLIO
Added in an error message in subroutine mod_context.f90
Changed mod_error_msg.f90 so that it prints "Error" instead of "Warning" before stopping.

  • Property svn:keywords set to Id
File size: 8.6 KB
Line 
1MODULE mod_context
2  USE mod_xmlio_parameters
3  USE mod_sorted_list
4  USE mod_field
5  USE mod_field_group
6  USE mod_field_definition
7  USE mod_file
8  USE mod_file_group
9  USE mod_file_definition
10  USE mod_grid
11  USE mod_zoom
12  USE mod_grid_group
13  USE mod_grid_definition
14  USE mod_axis
15  USE mod_axis_group
16  USE mod_axis_definition
17  USE mod_dependency
18  USE mod_time_parameters
19  USE error_msg
20
21
22  INTERFACE context__swap
23    MODULE PROCEDURE context__swap_id,context__swap_pt
24  END INTERFACE 
25 
26  TYPE, PUBLIC :: context
27    CHARACTER(len=str_len)         :: id
28    INTEGER                        :: number
29 
30    TYPE(vector_field),POINTER        :: field__field_Ids
31    TYPE(sorted_list),POINTER         :: field__Ids
32    TYPE(vector_field_group),POINTER  :: field_group__field_group_ids
33    TYPE(sorted_list),POINTER         :: field_group__Ids
34    TYPE(field_group),POINTER         :: field_definition__field_def
35    TYPE(vector_file),POINTER         :: file__file_Ids
36    TYPE(sorted_list),POINTER         :: file__Ids
37    TYPE(vector_file_group),POINTER   :: file_group__file_group_Ids
38    TYPE(sorted_list),POINTER         :: file_group__Ids 
39    TYPE(file_group),POINTER          :: file_definition__file_def 
40    TYPE(vector_grid),POINTER         :: grid__grid_Ids
41    TYPE(sorted_list),POINTER         :: grid__Ids 
42    TYPE(vector_zoom),POINTER         :: zoom__zoom_Ids
43    TYPE(sorted_list),POINTER         :: zoom__Ids 
44    TYPE(vector_grid_group),POINTER   :: grid_group__grid_group_Ids
45    TYPE(sorted_list),POINTER         :: grid_group__Ids 
46    TYPE(grid_group),POINTER          :: grid_definition__grid_def
47    TYPE(vector_axis),POINTER         :: axis__axis_Ids
48    TYPE(sorted_list),POINTER         :: axis__Ids 
49    TYPE(vector_axis_group),POINTER   :: axis_group__axis_group_Ids
50    TYPE(sorted_list),POINTER         :: axis_group__Ids 
51    TYPE(axis_group),POINTER          :: axis_definition__axis_def
52    TYPE(vector_file_dep),POINTER     :: dependency__file_enabled
53    TYPE(vector_field_out),POINTER    :: dependency__field_enabled 
54    TYPE(vector_field_dep),POINTER    :: dependency__field_id
55    TYPE(sorted_list),POINTER         :: dependency__sorted_id 
56    INTEGER,POINTER                   :: time_param__initial_timestep
57    REAL,POINTER                      :: time_param__initial_date
58    REAL,POINTER                      :: time_param__timestep_value 
59    INTEGER,POINTER                   :: time_param__timestep_number
60
61  END TYPE context
62 
63  INCLUDE 'vector_context_def.inc'
64  TYPE(vector_context),SAVE,POINTER  :: context_ids
65  TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
66
67 
68  CONTAINS
69    INCLUDE 'vector_context_contains.inc'
70   
71    SUBROUTINE context__init
72    IMPLICIT NONE
73
74      ALLOCATE(context_Ids)
75      ALLOCATE(Ids)
76
77      CALL vector_context__new(context_Ids)
78      CALL sorted_list__new(ids)
79
80    END SUBROUTINE context__init
81
82    SUBROUTINE context__get(Id,Pt_context)
83      USE string_function
84      IMPLICIT NONE
85      CHARACTER(LEN=*),INTENT(IN)     :: Id
86      TYPE(context),POINTER              :: Pt_context
87
88      INTEGER                         :: Pos
89      LOGICAL                         :: success
90   
91      CALL sorted_list__find(Ids,hash(Id),Pos,success)
92      IF (success) THEN
93        Pt_context=>context_ids%at(Pos)%Pt
94      ELSE
95        Pt_context=>NULL()
96      ENDIF
97   
98    END SUBROUTINE context__get
99
100    SUBROUTINE context__get_new(Id,pt_context)
101    USE string_function
102    IMPLICIT NONE
103      CHARACTER(LEN=*),INTENT(IN)     :: Id
104      TYPE(context),POINTER              :: Pt_context
105
106      INTEGER                         :: Pos
107      LOGICAL                         :: success
108     
109      CALL sorted_list__find(Ids,hash(Id),Pos,success)
110      IF (success) THEN
111        Pt_context=>context_ids%at(Pos)%Pt
112      ELSE
113        CALL vector_context__get_new(context_ids,pt_context,Pos)
114        pt_context%number=Pos
115        Pt_context%id=Id
116        CALL sorted_list__Add(Ids,hash(Id),Pos)
117       
118        ALLOCATE(pt_context%field__field_Ids )
119        ALLOCATE(pt_context%field__Ids )
120        ALLOCATE(pt_context%field_group__field_group_ids )
121        ALLOCATE(pt_context%field_group__field_group_ids )
122        ALLOCATE(pt_context%field_group__Ids )
123        ALLOCATE(pt_context%field_definition__field_def )
124        ALLOCATE(pt_context%file__file_Ids)
125        ALLOCATE(pt_context%file__Ids)
126        ALLOCATE(pt_context%file_group__file_group_Ids)
127        ALLOCATE(pt_context%file_group__Ids) 
128        ALLOCATE(pt_context%file_definition__file_def) 
129        ALLOCATE(pt_context%grid__grid_Ids)
130        ALLOCATE(pt_context%grid__Ids) 
131        ALLOCATE(pt_context%zoom__zoom_Ids)
132        ALLOCATE(pt_context%zoom__Ids) 
133        ALLOCATE(pt_context%grid_group__grid_group_Ids)
134        ALLOCATE(pt_context%grid_group__Ids) 
135        ALLOCATE(pt_context%grid_definition__grid_def)
136        ALLOCATE(pt_context%axis__axis_Ids)
137        ALLOCATE(pt_context%axis__Ids) 
138        ALLOCATE(pt_context%axis_group__axis_group_Ids)
139        ALLOCATE(pt_context%axis_group__Ids) 
140        ALLOCATE(pt_context%axis_definition__axis_def)
141        ALLOCATE(pt_context%dependency__file_enabled)
142        ALLOCATE(pt_context%dependency__field_enabled) 
143        ALLOCATE(pt_context%dependency__field_id)
144        ALLOCATE(pt_context%dependency__sorted_id) 
145        ALLOCATE(pt_context%time_param__initial_timestep)
146        ALLOCATE(pt_context%time_param__initial_date)
147        ALLOCATE(pt_context%time_param__timestep_value) 
148        ALLOCATE(pt_context%time_param__timestep_number)
149
150        CALL context__swap(pt_context)
151       
152        CALL field__init
153        CALL field_group__Init
154        CALL field_definition__Init
155
156        CALL axis__init
157        CALL axis_group__Init
158        CALL axis_definition__Init
159
160        CALL grid__init
161        CALL grid_group__Init
162        CALL grid_definition__Init
163
164        CALL zoom__init
165
166        CALL file__init
167        CALL file_group__Init
168        CALL file_definition__Init
169
170      ENDIF
171
172    END SUBROUTINE context__get_new
173
174
175    SUBROUTINE context__create(Id)
176    IMPLICIT NONE
177      CHARACTER(LEN=*),INTENT(IN)     :: Id
178     
179      TYPE(context),POINTER              :: Pt_context
180
181      CALL context__get(Id,Pt_context)
182      IF (.NOT. ASSOCIATED(Pt_context)) CALL context__get_new(Id,Pt_context)
183     
184!      CALL field__init
185!      CALL field_group__init
186!      CALL field_definition__init
187     
188     END SUBROUTINE context__create
189
190     
191    SUBROUTINE context__swap_id(Id)
192    USE mod_field
193      IMPLICIT NONE
194      CHARACTER(LEN=*),INTENT(IN)     :: Id
195      TYPE(context),POINTER       :: Pt_context
196
197      INTEGER :: number
198     
199      CALL context__get(Id,Pt_context)
200      IF (.NOT. ASSOCIATED(Pt_context)) THEN
201          WRITE (message,*) "Error: Unable to get context for Id '<Id>'"
202          CALL error('context__swap_id')
203      ENDIF
204     
205      CALL context__swap(pt_context) 
206
207    END SUBROUTINE context__swap_id
208
209    SUBROUTINE context__swap_pt(Pt_context)
210    USE mod_field
211      IMPLICIT NONE
212      TYPE(context),POINTER       :: Pt_context
213
214      CALL field__swap_context(Pt_context%field__field_Ids ,Pt_context%field__Ids)
215      CALL field_group__swap_context(Pt_context%field_group__field_group_ids ,Pt_context%field_group__Ids)
216      CALL field_definition__swap_context(Pt_context%field_definition__field_def)
217      CALL file__swap_context(Pt_context%file__file_Ids,Pt_context%file__Ids)
218      CALL file_group__swap_context(Pt_context%file_group__file_group_Ids,Pt_context%file_group__Ids)
219      CALL file_definition__swap_context(Pt_context%file_definition__file_def) 
220      CALL grid__swap_context(pt_context%grid__grid_Ids,pt_context%grid__Ids) 
221      CALL zoom__swap_context(pt_context%zoom__zoom_Ids,pt_context%zoom__Ids) 
222      CALL grid_group__swap_context(pt_context%grid_group__grid_group_Ids,pt_context%grid_group__Ids) 
223      CALL grid_definition__swap_context(pt_context%grid_definition__grid_def)
224      CALL axis__swap_context(pt_context%axis__axis_Ids,pt_context%axis__Ids) 
225      CALL axis_group__swap_context(pt_context%axis_group__axis_group_Ids,pt_context%axis_group__Ids) 
226      CALL axis_definition__swap_context(pt_context%axis_definition__axis_def)
227      CALL dependency__swap_context(pt_context%dependency__file_enabled,pt_context%dependency__field_enabled,  &
228                                    pt_context%dependency__field_id,pt_context%dependency__sorted_id)
229      CALL time_parameters__swap_context(pt_context%time_param__initial_timestep,pt_context%time_param__initial_date,  &
230                                         pt_context%time_param__timestep_value,pt_context%time_param__timestep_number)
231                                   
232    END SUBROUTINE context__swap_pt
233
234
235END MODULE mod_context
Note: See TracBrowser for help on using the repository browser.