source: XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90 @ 47

Last change on this file since 47 was 47, checked in by ymipsl, 15 years ago

rustine pour S. masson => file id ne s'arrete pas pour iomanager::set_attribut

YM
File size: 12.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__swap_context(id)
31  USE xmlio
32  IMPLICIT NONE
33    CHARACTER(LEN=*) :: id
34   
35    IF (current_rank==nb_client) CALL context__swap(id)
36     
37  END SUBROUTINE iom__swap_context
38
39  SUBROUTINE iom__set_current_rank(rank)
40  IMPLICIT NONE
41    INTEGER,INTENT(IN) :: rank
42   
43    current_rank=rank
44 
45  END SUBROUTINE iom__set_current_rank
46 
47  SUBROUTINE iom__set_vert_axis(name,vert_value)
48  USE xmlio
49  IMPLICIT NONE
50    CHARACTER(LEN=*),INTENT(IN) :: name
51    REAL,INTENT(IN)             :: vert_value(:)
52    TYPE(axis), POINTER :: pt_axis
53   
54    IF (current_rank==nb_client) THEN
55      CALL axis__get(name, pt_axis)
56      CALL axis__set(pt_axis, a_size=size(vert_value), values=vert_value)
57    ENDIF
58 
59  END SUBROUTINE iom__set_vert_axis
60
61 
62  SUBROUTINE iom__set_grid_dimension(name,ni_glo,nj_glo)
63  USE xmlio
64  IMPLICIT NONE
65    CHARACTER(LEN=*),INTENT(IN) :: name
66    INTEGER,INTENT(IN) :: ni_glo
67    INTEGER,INTENT(IN) :: nj_glo
68    TYPE(grid), POINTER :: pt_grid
69 
70    IF (current_rank==nb_client) THEN
71      CALL grid__get(name,pt_grid)
72      CALL grid__set_dimension(pt_grid,ni_glo,nj_glo)
73    ENDIF
74
75  END SUBROUTINE iom__set_grid_dimension
76 
77  SUBROUTINE iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
78  USE xmlio
79  IMPLICIT NONE
80    CHARACTER(LEN=*),INTENT(IN) :: name
81    INTEGER,INTENT(IN) :: ni
82    INTEGER,INTENT(IN) :: nj
83    INTEGER,INTENT(IN) :: ibegin
84    INTEGER,INTENT(IN) :: jbegin
85    REAL,INTENT(IN)    :: lon(ni,nj)
86    REAL,INTENT(IN)    :: lat(ni,nj)
87
88    TYPE(grid),   POINTER :: pt_grid
89    TYPE(domain), POINTER :: pt_domain
90
91      CALL grid__get(name,pt_grid)
92      CALL grid__get_new_subdomain(pt_grid,current_rank,pt_domain)
93      CALL domain__set(pt_domain,current_rank,ni,nj,ibegin,jbegin,lon,lat)
94
95  END SUBROUTINE iom__set_grid_domain
96
97  SUBROUTINE iom__set_grid_type_nemo(name)
98  USE xmlio
99  IMPLICIT NONE
100    CHARACTER(LEN=*),INTENT(IN) :: name
101
102    TYPE(grid),   POINTER :: pt_grid
103    TYPE(domain), POINTER :: pt_domain
104     
105      CALL grid__get(name,pt_grid)
106      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
107      CALL domain__set_type_box(pt_domain)
108
109  END SUBROUTINE iom__set_grid_type_nemo
110
111  SUBROUTINE iom__set_grid_type_lmdz(name,nbp,offset)
112  USE xmlio
113  IMPLICIT NONE
114    CHARACTER(LEN=*),INTENT(IN) :: name
115    INTEGER,INTENT(IN)          :: nbp
116    INTEGER,INTENT(IN)          :: offset
117
118    TYPE(grid),   POINTER :: pt_grid
119    TYPE(domain), POINTER :: pt_domain
120    LOGICAL,ALLOCATABLE   :: mask(:,:)
121     
122      CALL grid__get(name,pt_grid)
123      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
124      ALLOCATE(mask(pt_domain%ni,pt_domain%nj))
125      mask(:,:)=.TRUE.
126      mask(1:offset,1)=.FALSE.
127      mask(MOD(offset+nbp-1,pt_domain%ni)+2:pt_domain%ni,pt_domain%nj)=.FALSE.
128      CALL domain__set_type_box(pt_domain,mask)
129
130  END SUBROUTINE iom__set_grid_type_lmdz
131     
132  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt)
133  USE mod_interface_ioipsl
134  IMPLICIT NONE
135    INTEGER, INTENT(IN) :: itau0
136    REAL,INTENT(IN)     :: zjulian
137    REAL,INTENT(IN)     :: zdt
138     
139    IF (current_rank==nb_client) THEN
140      CALL set_time_parameters(itau0, zjulian, zdt)
141    ENDIF
142  END SUBROUTINE iom__set_time_parameters
143 
144  SUBROUTINE iom__close_io_definition
145  USE mod_interface_ioipsl
146  IMPLICIT NONE
147 
148    IF (current_rank==nb_client) CALL Create_file_definition(nb_server,server_rank)
149 
150  END SUBROUTINE iom__close_io_definition
151     
152
153  SUBROUTINE iom__set_timestep(timestep)
154  USE mod_interface_ioipsl
155  IMPLICIT NONE
156    INTEGER, INTENT(IN) :: timestep
157   
158    IF (current_rank==nb_client) CALL set_timestep(timestep)
159   
160  END SUBROUTINE iom__set_timestep
161
162  SUBROUTINE iom__enable_field(varname)
163  USE xmlio
164  IMPLICIT NONE
165    CHARACTER(LEN=*) :: varname
166    TYPE(field),POINTER :: pt_field
167   
168    CALL field__get(TRIM(varname), pt_field)
169    CALL field__set(pt_field,enabled=.TRUE.)
170   
171  END SUBROUTINE iom__enable_field
172 
173  SUBROUTINE iom__disable_field(varname)
174  USE xmlio
175  IMPLICIT NONE
176    CHARACTER(LEN=*) :: varname
177    TYPE(field),POINTER :: pt_field
178   
179    CALL field__get(TRIM(varname), pt_field)
180    CALL field__set(pt_field,enabled=.FALSE.)
181   
182  END SUBROUTINE iom__disable_field
183   
184
185  SUBROUTINE iom__write_field1d(varname,var)
186  USE xmlio
187  USE field_bufferize
188  USE mod_interface_ioipsl
189  IMPLICIT NONE
190    CHARACTER(LEN=*) :: varname
191    REAL             :: var(:)
192
193    TYPE(field),POINTER  :: pt_field
194    TYPE(domain),POINTER :: subdomain
195    TYPE(domain),POINTER :: local_domain
196    INTEGER :: ni,nj,ibegin,jbegin
197    INTEGER :: id_rank
198   
199    CALL field__get(varname,pt_field)
200    id_rank=pt_field%grid%ranks(current_rank)
201    local_domain=>pt_field%grid%domain
202   
203    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
204    ni=subdomain%ni
205    nj=subdomain%nj
206    ibegin=subdomain%ibegin-local_domain%ibegin+1
207    jbegin=subdomain%jbegin-local_domain%jbegin+1 
208
209    IF (subdomain%type==box) THEN
210
211      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
212      CALL error("iom__write_field2d")
213
214    ELSE IF (subdomain%type==orange) THEN
215      IF (size(var,1)/=subdomain%nbp) THEN
216         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
217                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
218         CALL error("iom__write_field2d")
219      ENDIF
220      IF (pt_field%axis%name /= 'none') THEN
221        WRITE(message,*) "Missing axis dimension for this field"
222        CALL error("iom__write_field2d")
223      ENDIF
224    ENDIF
225   
226   
227    IF (current_rank==1) THEN
228      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
229    ENDIF
230   
231    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
232                         subdomain%i_index,subdomain%j_index,subdomain%mask)
233   
234    IF (current_rank==nb_client) THEN
235      ni=local_domain%ni
236      nj=local_domain%nj
237      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
238    ENDIF
239   
240  END SUBROUTINE iom__write_field1d
241
242   
243  SUBROUTINE iom__write_field2d(varname,var)
244  USE xmlio
245  USE field_bufferize
246  USE mod_interface_ioipsl
247  IMPLICIT NONE
248    CHARACTER(LEN=*) :: varname
249    REAL             :: var(:,:)
250
251    TYPE(field),POINTER  :: pt_field
252    TYPE(domain),POINTER :: subdomain
253    TYPE(domain),POINTER :: local_domain
254    INTEGER :: ni,nj,nk,ibegin,jbegin
255    INTEGER :: id_rank
256   
257    CALL field__get(varname,pt_field)
258    id_rank=pt_field%grid%ranks(current_rank)
259    local_domain=>pt_field%grid%domain
260   
261    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
262    ni=subdomain%ni
263    nj=subdomain%nj
264    ibegin=subdomain%ibegin-local_domain%ibegin+1
265    jbegin=subdomain%jbegin-local_domain%jbegin+1 
266    nk=pt_field%axis%size
267
268    IF (subdomain%type==box) THEN
269      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
270        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
271                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
272        CALL error("iom__write_field2d")
273      ENDIF
274     
275      IF (pt_field%axis%name/="none") THEN
276        WRITE(message,*) "Missing axis dimension for this field"
277        CALL error("iom__write_field2d")
278      ENDIF
279   
280    ELSE IF (subdomain%type==orange) THEN
281      IF (size(var,1)/=subdomain%nbp) THEN
282         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
283                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
284         CALL error("iom__write_field2d")
285      ENDIF
286      IF (nk /= size(var,2)) THEN
287         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
288                          'field dim :',size(var,2),'   axis dim :', nk
289         CALL error("iom__write_field2d")
290      ENDIF
291    ENDIF
292   
293   
294    IF (current_rank==1) THEN
295      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
296    ENDIF
297   
298    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
299                         subdomain%i_index,subdomain%j_index,subdomain%mask)
300   
301    IF (current_rank==nb_client) THEN
302      ni=local_domain%ni
303      nj=local_domain%nj
304     
305      IF (pt_field%axis%name=="none") THEN
306        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
307      ELSE
308        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
309      ENDIF
310   
311    ENDIF
312   
313  END SUBROUTINE iom__write_field2d
314
315  SUBROUTINE iom__write_field3d(varname,var)
316  USE xmlio
317  USE field_bufferize
318  USE mod_interface_ioipsl
319  IMPLICIT NONE
320    CHARACTER(LEN=*) :: varname
321    REAL             :: var(:,:,:)
322
323    TYPE(field),POINTER  :: pt_field
324    TYPE(domain),POINTER :: subdomain
325    TYPE(domain),POINTER :: local_domain
326    INTEGER :: ni,nj,nk,ibegin,jbegin
327    INTEGER :: id_rank
328
329    CALL field__get(varname,pt_field)
330    id_rank=pt_field%grid%ranks(current_rank)
331    local_domain=>pt_field%grid%domain
332   
333    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
334    ni=subdomain%ni
335    nj=subdomain%nj
336    ibegin=subdomain%ibegin-local_domain%ibegin+1
337    jbegin=subdomain%jbegin-local_domain%jbegin+1 
338    nk=pt_field%axis%size
339
340    IF (subdomain%type==box) THEN
341      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
342        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
343                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
344        CALL error("iom__write_field3d")
345      ENDIF
346     
347      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
348        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
349                         'field dim : ',size(var,3),'  axis dim : ',nk
350        CALL error("iom__write_field3d")
351      ENDIF
352
353    ELSE IF (subdomain%type==orange) THEN
354
355      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
356      CALL error("iom__write_field3d")
357     
358    ENDIF
359   
360   
361    IF (current_rank==1) THEN
362      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
363    ENDIF
364   
365    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
366                         subdomain%i_index,subdomain%j_index,subdomain%mask)
367   
368    IF (current_rank==nb_client) THEN
369      ni=local_domain%ni
370      nj=local_domain%nj
371     
372      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
373   
374    ENDIF
375   
376  END SUBROUTINE iom__write_field3d
377 
378  SUBROUTINE iom__Finalize
379  USE mod_interface_ioipsl
380  IMPLICIT NONE
381 
382    IF (current_rank==nb_client) CALL ioipsl_finalize
383   
384  END SUBROUTINE iom__Finalize
385
386
387  SUBROUTINE iom__set_attribut(id,attrib)
388  USE mod_attribut
389  USE mod_object
390  USE mod_field
391  USE mod_field_group
392  USE mod_file
393  USE mod_file_group
394  USE mod_axis
395  USE mod_axis_group
396  USE mod_grid
397  USE mod_grid_group
398  USE mod_zoom
399  IMPLICIT NONE
400    CHARACTER(LEN=*) :: id
401    TYPE(attribut)   :: attrib 
402    LOGICAL          :: success
403    IF (current_rank==nb_client) THEN
404   
405      SELECT CASE(attrib%object)
406        CASE(field_object)
407          CALL field_group__set_attribut(id,attrib,success)
408          IF (.NOT. success) CALL field__set_attribut(id,attrib)         
409        CASE(file_object)
410          CALL file_group__set_attribut(id,attrib,success)
411          IF (.NOT. success) CALL file__set_attribut(id,attrib,success)         
412        CASE(axis_object)
413          CALL axis_group__set_attribut(id,attrib,success)
414          IF (.NOT. success) CALL axis__set_attribut(id,attrib)         
415        CASE(grid_object)
416          CALL grid_group__set_attribut(id,attrib,success)
417          IF (.NOT. success) CALL grid__set_attribut(id,attrib)         
418        CASE(zoom_object)
419          CALL zoom__set_attribut(id,attrib)
420      END SELECT
421    ENDIF
422   
423  END SUBROUTINE iom__set_attribut
424   
425END MODULE iomanager 
426 
Note: See TracBrowser for help on using the repository browser.