source: XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.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: 10.3 KB
Line 
1MODULE iomanager
2  INTEGER,PRIVATE,SAVE :: nb_client
3  INTEGER,PRIVATE,SAVE :: nb_server
4  INTEGER,PRIVATE,SAVE :: server_rank
5  INTEGER,PRIVATE,SAVE :: current_rank
6 
7CONTAINS
8
9  SUBROUTINE iom__init(nb_client_,nb_server_,server_rank_)
10  IMPLICIT NONE
11   INTEGER,INTENT(IN) :: nb_client_
12   INTEGER,INTENT(IN) :: nb_server_
13   INTEGER,INTENT(IN) :: server_rank_
14   
15     nb_client=nb_client_ 
16     nb_server=nb_server_
17     server_rank=server_rank_
18     
19  END SUBROUTINE iom__init
20 
21  SUBROUTINE iom__parse_xml_file(filename)
22  USE xmlio
23  IMPLICIT NONE
24    CHARACTER(LEN=*) :: filename
25   
26    IF (current_rank==nb_client) CALL xmlio__init(filename)
27     
28  END SUBROUTINE iom__parse_xml_file
29   
30  SUBROUTINE iom__set_current_rank(rank)
31  IMPLICIT NONE
32    INTEGER,INTENT(IN) :: rank
33   
34    current_rank=rank
35 
36  END SUBROUTINE iom__set_current_rank
37 
38  SUBROUTINE iom__set_vert_axis(name,vert_value)
39  USE xmlio
40  IMPLICIT NONE
41    CHARACTER(LEN=*),INTENT(IN) :: name
42    REAL,INTENT(IN)             :: vert_value(:)
43    TYPE(axis), POINTER :: pt_axis
44   
45    IF (current_rank==nb_client) THEN
46      CALL axis__get(name, pt_axis)
47      CALL axis__set(pt_axis, a_size=size(vert_value), values=vert_value)
48    ENDIF
49 
50  END SUBROUTINE iom__set_vert_axis
51
52 
53  SUBROUTINE iom__set_grid_dimension(name,ni_glo,nj_glo)
54  USE xmlio
55  IMPLICIT NONE
56    CHARACTER(LEN=*),INTENT(IN) :: name
57    INTEGER,INTENT(IN) :: ni_glo
58    INTEGER,INTENT(IN) :: nj_glo
59    TYPE(grid), POINTER :: pt_grid
60 
61    IF (current_rank==nb_client) THEN
62      CALL grid__get(name,pt_grid)
63      CALL grid__set_dimension(pt_grid,ni_glo,nj_glo)
64    ENDIF
65
66  END SUBROUTINE iom__set_grid_dimension
67 
68  SUBROUTINE iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
69  USE xmlio
70  IMPLICIT NONE
71    CHARACTER(LEN=*),INTENT(IN) :: name
72    INTEGER,INTENT(IN) :: ni
73    INTEGER,INTENT(IN) :: nj
74    INTEGER,INTENT(IN) :: ibegin
75    INTEGER,INTENT(IN) :: jbegin
76    REAL,INTENT(IN)    :: lon(ni,nj)
77    REAL,INTENT(IN)    :: lat(ni,nj)
78
79    TYPE(grid),   POINTER :: pt_grid
80    TYPE(domain), POINTER :: pt_domain
81
82      CALL grid__get(name,pt_grid)
83      CALL grid__get_new_subdomain(pt_grid,current_rank,pt_domain)
84      CALL domain__set(pt_domain,current_rank,ni,nj,ibegin,jbegin,lon,lat)
85
86  END SUBROUTINE iom__set_grid_domain
87
88  SUBROUTINE iom__set_grid_type_nemo(name)
89  USE xmlio
90  IMPLICIT NONE
91    CHARACTER(LEN=*),INTENT(IN) :: name
92
93    TYPE(grid),   POINTER :: pt_grid
94    TYPE(domain), POINTER :: pt_domain
95     
96      CALL grid__get(name,pt_grid)
97      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
98      CALL domain__set_type_box(pt_domain)
99
100  END SUBROUTINE iom__set_grid_type_nemo
101     
102  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt)
103  USE mod_interface_ioipsl
104  IMPLICIT NONE
105    INTEGER, INTENT(IN) :: itau0
106    REAL,INTENT(IN)     :: zjulian
107    REAL,INTENT(IN)     :: zdt
108     
109    IF (current_rank==nb_client) THEN
110      CALL set_time_parameters(itau0, zjulian, zdt)
111    ENDIF
112  END SUBROUTINE iom__set_time_parameters
113 
114  SUBROUTINE iom__close_io_definition
115  USE mod_interface_ioipsl
116  IMPLICIT NONE
117 
118    IF (current_rank==nb_client) CALL Create_file_definition(nb_server,server_rank)
119 
120  END SUBROUTINE iom__close_io_definition
121     
122
123  SUBROUTINE iom__set_timestep(timestep)
124  USE mod_interface_ioipsl
125  IMPLICIT NONE
126    INTEGER, INTENT(IN) :: timestep
127   
128    IF (current_rank==nb_client) CALL set_timestep(timestep)
129   
130  END SUBROUTINE iom__set_timestep
131
132  SUBROUTINE iom__enable_field(varname)
133  USE xmlio
134  IMPLICIT NONE
135    CHARACTER(LEN=*) :: varname
136    TYPE(field),POINTER :: pt_field
137   
138    CALL field__get(TRIM(varname), pt_field)
139    CALL field__set(pt_field,enabled=.TRUE.)
140   
141  END SUBROUTINE iom__enable_field
142 
143  SUBROUTINE iom__disable_field(varname)
144  USE xmlio
145  IMPLICIT NONE
146    CHARACTER(LEN=*) :: varname
147    TYPE(field),POINTER :: pt_field
148   
149    CALL field__get(TRIM(varname), pt_field)
150    CALL field__set(pt_field,enabled=.FALSE.)
151   
152  END SUBROUTINE iom__disable_field
153   
154
155  SUBROUTINE iom__write_field1d(varname,var)
156  USE xmlio
157  USE field_bufferize
158  USE mod_interface_ioipsl
159  IMPLICIT NONE
160    CHARACTER(LEN=*) :: varname
161    REAL             :: var(:)
162
163    TYPE(field),POINTER  :: pt_field
164    TYPE(domain),POINTER :: subdomain
165    TYPE(domain),POINTER :: local_domain
166    INTEGER :: ni,nj,ibegin,jbegin
167    INTEGER :: id_rank
168   
169    CALL field__get(varname,pt_field)
170    id_rank=pt_field%grid%ranks(current_rank)
171    local_domain=>pt_field%grid%domain
172   
173    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
174    ni=subdomain%ni
175    nj=subdomain%nj
176    ibegin=subdomain%ibegin-local_domain%ibegin+1
177    jbegin=subdomain%jbegin-local_domain%jbegin+1 
178
179    IF (subdomain%type==box) THEN
180
181      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
182      CALL error("iom__write_field2d")
183
184    ELSE IF (subdomain%type==orange) THEN
185      IF (size(var,1)/=subdomain%nbp) THEN
186         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
187                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
188         CALL error("iom__write_field2d")
189      ENDIF
190      IF (pt_field%axis%name /= 'none') THEN
191        WRITE(message,*) "Missing axis dimension for this field"
192        CALL error("iom__write_field2d")
193      ENDIF
194    ENDIF
195   
196   
197    IF (current_rank==1) THEN
198      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
199    ENDIF
200   
201    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
202                         subdomain%i_index,subdomain%j_index,subdomain%mask)
203   
204    IF (current_rank==nb_client) THEN
205      ni=local_domain%ni
206      nj=local_domain%nj
207      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
208    ENDIF
209   
210  END SUBROUTINE iom__write_field1d
211
212   
213  SUBROUTINE iom__write_field2d(varname,var)
214  USE xmlio
215  USE field_bufferize
216  USE mod_interface_ioipsl
217  IMPLICIT NONE
218    CHARACTER(LEN=*) :: varname
219    REAL             :: var(:,:)
220
221    TYPE(field),POINTER  :: pt_field
222    TYPE(domain),POINTER :: subdomain
223    TYPE(domain),POINTER :: local_domain
224    INTEGER :: ni,nj,nk,ibegin,jbegin
225    INTEGER :: id_rank
226   
227    CALL field__get(varname,pt_field)
228    id_rank=pt_field%grid%ranks(current_rank)
229    local_domain=>pt_field%grid%domain
230   
231    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
232    ni=subdomain%ni
233    nj=subdomain%nj
234    ibegin=subdomain%ibegin-local_domain%ibegin+1
235    jbegin=subdomain%jbegin-local_domain%jbegin+1 
236    nk=pt_field%axis%size
237
238    IF (subdomain%type==box) THEN
239      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
240        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
241                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
242        CALL error("iom__write_field2d")
243      ENDIF
244     
245      IF (pt_field%axis%name/="none") THEN
246        WRITE(message,*) "Missing axis dimension for this field"
247        CALL error("iom__write_field2d")
248      ENDIF
249   
250    ELSE IF (subdomain%type==orange) THEN
251      IF (size(var,1)/=subdomain%nbp) THEN
252         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
253                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
254         CALL error("iom__write_field2d")
255      ENDIF
256      IF (nk /= size(var,2)) THEN
257         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
258                          'field dim :',size(var,2),'   axis dim :', nk
259         CALL error("iom__write_field2d")
260      ENDIF
261    ENDIF
262   
263   
264    IF (current_rank==1) THEN
265      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
266    ENDIF
267   
268    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
269                         subdomain%i_index,subdomain%j_index,subdomain%mask)
270   
271    IF (current_rank==nb_client) THEN
272      ni=local_domain%ni
273      nj=local_domain%nj
274     
275      IF (pt_field%axis%name/="none") THEN
276        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
277      ELSE
278        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
279      ENDIF
280   
281    ENDIF
282   
283  END SUBROUTINE iom__write_field2d
284
285  SUBROUTINE iom__write_field3d(varname,var)
286  USE xmlio
287  USE field_bufferize
288  USE mod_interface_ioipsl
289  IMPLICIT NONE
290    CHARACTER(LEN=*) :: varname
291    REAL             :: var(:,:,:)
292
293    TYPE(field),POINTER  :: pt_field
294    TYPE(domain),POINTER :: subdomain
295    TYPE(domain),POINTER :: local_domain
296    INTEGER :: ni,nj,nk,ibegin,jbegin
297    INTEGER :: id_rank
298   
299    CALL field__get(varname,pt_field)
300    id_rank=pt_field%grid%ranks(current_rank)
301    local_domain=>pt_field%grid%domain
302   
303    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
304    ni=subdomain%ni
305    nj=subdomain%nj
306    ibegin=subdomain%ibegin-local_domain%ibegin+1
307    jbegin=subdomain%jbegin-local_domain%jbegin+1 
308    nk=pt_field%axis%size
309
310    IF (subdomain%type==box) THEN
311      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
312        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
313                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
314        CALL error("iom__write_field3d")
315      ENDIF
316     
317      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
318        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
319                         'field dim : ',size(var,3),'  axis dim : ',nk
320        CALL error("iom__write_field3d")
321      ENDIF
322
323    ELSE IF (subdomain%type==orange) THEN
324
325      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
326      CALL error("iom__write_field3d")
327     
328    ENDIF
329   
330   
331    IF (current_rank==1) THEN
332      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
333    ENDIF
334   
335    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
336                         subdomain%i_index,subdomain%j_index,subdomain%mask)
337   
338    IF (current_rank==nb_client) THEN
339      ni=local_domain%ni
340      nj=local_domain%nj
341     
342      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
343   
344    ENDIF
345   
346  END SUBROUTINE iom__write_field3d
347 
348  SUBROUTINE iom__Finalize
349  USE mod_interface_ioipsl
350  IMPLICIT NONE
351 
352    IF (current_rank==nb_client) CALL ioipsl_finalize
353   
354  END SUBROUTINE iom__Finalize
355 
356END MODULE iomanager 
357 
Note: See TracBrowser for help on using the repository browser.