source: XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90 @ 29

Last change on this file since 29 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: 5.1 KB
Line 
1MODULE mod_grid_group
2  USE mod_grid
3  USE mod_xmlio_parameters
4
5  IMPLICIT NONE
6
7  TYPE grid_group
8    CHARACTER(LEN=str_len)                    :: id
9    LOGICAL                                   :: has_id
10    TYPE(vector_grid_group), POINTER          :: groups
11    TYPE(vector_grid),POINTER                 :: grids     
12    TYPE(grid), POINTER                       :: default_attribut
13  END TYPE grid_group
14
15  INCLUDE "vector_grid_group_def.inc" 
16
17  TYPE(vector_grid_group),POINTER,SAVE       :: grid_group_Ids
18  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
19
20CONTAINS
21
22  INCLUDE "vector_grid_group_contains.inc"
23
24  SUBROUTINE grid_group__swap_context(saved_grid_group_Ids,saved_ids)
25  IMPLICIT NONE
26  TYPE(vector_grid_group),POINTER       :: saved_grid_group_Ids
27  TYPE(sorted_list),POINTER             :: saved_Ids 
28   
29   grid_group_ids=>saved_grid_group_ids
30   ids=>saved_ids
31   
32  END SUBROUTINE grid_group__swap_context
33   
34  SUBROUTINE grid_group__init
35  IMPLICIT NONE
36   
37    CALL vector_grid_group__new(grid_group_Ids)
38    CALL sorted_list__new(Ids)
39   
40  END SUBROUTINE grid_group__init
41
42  SUBROUTINE grid_group__get(Id,Pt_gg)
43  USE string_function
44  IMPLICIT NONE
45    CHARACTER(LEN=*),INTENT(IN)     :: Id
46    TYPE(grid_group),POINTER        :: Pt_gg
47
48    INTEGER                         :: Pos
49    LOGICAL                         :: success
50   
51    CALL sorted_list__find(Ids,hash(Id),Pos,success)
52    IF (success) THEN
53      Pt_gg=>grid_group_ids%at(Pos)%Pt
54    ELSE
55      Pt_gg=>NULL()
56    ENDIF
57   
58  END SUBROUTINE grid_group__get
59   
60  RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id)
61  USE string_function
62  IMPLICIT NONE
63    TYPE(grid_group),POINTER                :: Pt_gg
64    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
65   
66    INTEGER :: Pos
67   
68    ALLOCATE(Pt_gg%groups)
69    ALLOCATE(Pt_gg%grids)
70    ALLOCATE(Pt_gg%default_attribut)
71   
72    CALL vector_grid_group__new(Pt_gg%groups)
73    CALL vector_grid__new(Pt_gg%grids)
74    CALL grid__new(Pt_gg%default_attribut)
75    Pt_gg%has_id=.FALSE.
76     
77    IF (PRESENT(Id)) THEN
78      Pt_gg%id=TRIM(Id)
79      Pt_gg%has_id=.TRUE.
80      CALL vector_grid_group__set_new(grid_group_Ids,Pt_gg,Pos)
81      CALL sorted_list__Add(Ids,hash(id),Pos)
82    ENDIF
83
84  END SUBROUTINE grid_group__new
85
86     
87  SUBROUTINE grid_group__get_new_group(Pt_gg,Pt_gg_out,Id)
88  IMPLICIT NONE
89    TYPE(grid_group),POINTER             :: Pt_gg
90    TYPE(grid_group),POINTER             :: Pt_gg_out
91    CHARACTER(LEN=*),OPTIONAL            :: Id
92   
93    CALL vector_grid_group__get_new(Pt_gg%groups,Pt_gg_out)
94    CALL grid_group__new(Pt_gg_out)
95
96    IF (PRESENT(id)) THEN
97      CALL grid_group__new(Pt_gg_out,Id)
98    ELSE
99      CALL grid_group__new(Pt_gg_out)
100    ENDIF
101   
102  END SUBROUTINE grid_group__get_new_group
103
104 
105  SUBROUTINE grid_group__get_new_grid(Pt_gg,Pt_g_out,Id)
106  IMPLICIT NONE
107    TYPE(grid_group),POINTER            :: Pt_gg
108    TYPE(grid),POINTER                  :: Pt_g_out
109    CHARACTER(LEN=*),OPTIONAL      :: Id
110   
111    CALL vector_grid__get_new(Pt_gg%grids,Pt_g_out)
112   
113    IF (PRESENT(id)) THEN
114      CALL grid__new(Pt_g_out,Id)
115    ELSE
116      CALL grid__new(Pt_g_out)
117    ENDIF
118   
119  END SUBROUTINE grid_group__get_new_grid
120 
121 
122  SUBROUTINE grid_group__get_default_attrib(Pt_gg,Pt_g)
123  IMPLICIT NONE
124    TYPE(grid_group),POINTER  :: Pt_gg
125    TYPE(grid),POINTER        :: Pt_g
126   
127    Pt_g=>Pt_gg%default_attribut
128  END SUBROUTINE grid_group__get_default_attrib
129 
130  RECURSIVE SUBROUTINE grid_group__apply_default(Pt_gg,default)
131  IMPLICIT NONE
132    TYPE(grid_group),POINTER      :: Pt_gg
133    TYPE(grid),POINTER,OPTIONAL   :: default
134   
135    INTEGER :: i
136   
137    IF (PRESENT(default)) THEN
138      CALL grid__apply_default(default,Pt_gg%default_attribut,Pt_gg%default_attribut)
139    ENDIF
140     
141    DO i=1,Pt_gg%groups%size
142      CALL grid_group__apply_default(Pt_gg%groups%at(i)%pt,Pt_gg%default_attribut)
143    ENDDO
144   
145    DO i=1,Pt_gg%grids%size
146      CALL grid__apply_default(Pt_gg%default_attribut,Pt_gg%grids%at(i)%pt,Pt_gg%grids%at(i)%pt)
147    ENDDO
148 
149  END SUBROUTINE grid_group__apply_default
150
151  RECURSIVE SUBROUTINE grid_group__Process_domain(Pt_gg)
152  IMPLICIT NONE
153  TYPE(grid_group),POINTER  :: Pt_gg
154    INTEGER :: i
155   
156    DO i=1,pt_gg%groups%size
157      CALL grid_group__process_domain(pt_gg%groups%at(i)%pt)
158    ENDDO
159   
160    DO i=1,pt_gg%grids%size
161      CALL grid__process_domain(pt_gg%grids%at(i)%pt)
162    ENDDO
163   
164  END SUBROUTINE grid_group__Process_domain
165     
166
167  RECURSIVE SUBROUTINE grid_group__print(Pt_gg)
168  IMPLICIT NONE
169    TYPE(grid_group),POINTER  :: Pt_gg
170   
171    INTEGER :: i
172   
173    PRINT *,"--- GRID GROUP ---"
174    IF (pt_gg%has_id) THEN
175      PRINT *,"id  ",TRIM(pt_gg%id)
176    ELSE
177      PRINT *,"id undefined"
178    ENDIF
179   
180    PRINT *,"grid default attribut :"
181    CALL grid__print(Pt_gg%default_attribut)   
182
183    PRINT *,"owned grid groups : ",Pt_gg%groups%size     
184    DO i=1,Pt_gg%groups%size
185      CALL grid_group__print(Pt_gg%groups%at(i)%pt)
186    ENDDO
187
188    PRINT *,"owned grid : ",Pt_gg%grids%size     
189    DO i=1,Pt_gg%grids%size
190      CALL grid__print(Pt_gg%grids%at(i)%pt)
191    ENDDO
192    PRINT *,"------------"
193 
194  END SUBROUTINE grid_group__print
195     
196END MODULE mod_grid_group
Note: See TracBrowser for help on using the repository browser.