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_iomanager.f90 in branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

set proper svn properties to all files...
  • Property svn:keywords set to Id
File size: 12.6 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__set_calendar(str_calendar)
163  USE mod_interface_ioipsl
164  IMPLICIT NONE
165    CHARACTER(LEN=*) :: str_calendar
166   
167    IF (current_rank==nb_client) CALL set_calendar(str_calendar)
168   
169  END SUBROUTINE iom__set_calendar
170
171  SUBROUTINE iom__enable_field(varname)
172  USE xmlio
173  IMPLICIT NONE
174    CHARACTER(LEN=*) :: varname
175    TYPE(field),POINTER :: pt_field
176   
177    CALL field__get(TRIM(varname), pt_field)
178    CALL field__set(pt_field,enabled=.TRUE.)
179   
180  END SUBROUTINE iom__enable_field
181 
182  SUBROUTINE iom__disable_field(varname)
183  USE xmlio
184  IMPLICIT NONE
185    CHARACTER(LEN=*) :: varname
186    TYPE(field),POINTER :: pt_field
187   
188    CALL field__get(TRIM(varname), pt_field)
189    CALL field__set(pt_field,enabled=.FALSE.)
190   
191  END SUBROUTINE iom__disable_field
192   
193
194  SUBROUTINE iom__write_field1d(varname,var)
195  USE xmlio
196  USE field_bufferize
197  USE mod_interface_ioipsl
198  IMPLICIT NONE
199    CHARACTER(LEN=*) :: varname
200    REAL             :: var(:)
201
202    TYPE(field),POINTER  :: pt_field
203    TYPE(domain),POINTER :: subdomain
204    TYPE(domain),POINTER :: local_domain
205    INTEGER :: ni,nj,ibegin,jbegin
206    INTEGER :: id_rank
207   
208    CALL field__get(varname,pt_field)
209    id_rank=pt_field%grid%ranks(current_rank)
210    local_domain=>pt_field%grid%domain
211   
212    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
213    ni=subdomain%ni
214    nj=subdomain%nj
215    ibegin=subdomain%ibegin-local_domain%ibegin+1
216    jbegin=subdomain%jbegin-local_domain%jbegin+1 
217
218    IF (subdomain%type==box) THEN
219
220      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
221      CALL error("iom__write_field2d")
222
223    ELSE IF (subdomain%type==orange) THEN
224      IF (size(var,1)/=subdomain%nbp) THEN
225         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
226                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
227         CALL error("iom__write_field2d")
228      ENDIF
229      IF (pt_field%axis%name /= 'none') THEN
230        WRITE(message,*) "Missing axis dimension for this field"
231        CALL error("iom__write_field2d")
232      ENDIF
233    ENDIF
234   
235   
236    IF (current_rank==1) THEN
237      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
238    ENDIF
239   
240    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
241                         subdomain%i_index,subdomain%j_index,subdomain%mask)
242   
243    IF (current_rank==nb_client) THEN
244      ni=local_domain%ni
245      nj=local_domain%nj
246      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
247    ENDIF
248   
249  END SUBROUTINE iom__write_field1d
250
251   
252  SUBROUTINE iom__write_field2d(varname,var)
253  USE xmlio
254  USE field_bufferize
255  USE mod_interface_ioipsl
256  IMPLICIT NONE
257    CHARACTER(LEN=*) :: varname
258    REAL             :: var(:,:)
259
260    TYPE(field),POINTER  :: pt_field
261    TYPE(domain),POINTER :: subdomain
262    TYPE(domain),POINTER :: local_domain
263    INTEGER :: ni,nj,nk,ibegin,jbegin
264    INTEGER :: id_rank
265   
266    CALL field__get(varname,pt_field)
267    id_rank=pt_field%grid%ranks(current_rank)
268    local_domain=>pt_field%grid%domain
269   
270    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
271    ni=subdomain%ni
272    nj=subdomain%nj
273    ibegin=subdomain%ibegin-local_domain%ibegin+1
274    jbegin=subdomain%jbegin-local_domain%jbegin+1 
275    nk=pt_field%axis%size
276
277    IF (subdomain%type==box) THEN
278      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
279        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
280                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
281        CALL error("iom__write_field2d")
282      ENDIF
283     
284      IF (pt_field%axis%name/="none") THEN
285        WRITE(message,*) "Missing axis dimension for this field"
286        CALL error("iom__write_field2d")
287      ENDIF
288   
289    ELSE IF (subdomain%type==orange) THEN
290      IF (size(var,1)/=subdomain%nbp) THEN
291         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
292                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
293         CALL error("iom__write_field2d")
294      ENDIF
295      IF (nk /= size(var,2)) THEN
296         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
297                          'field dim :',size(var,2),'   axis dim :', nk
298         CALL error("iom__write_field2d")
299      ENDIF
300    ENDIF
301   
302   
303    IF (current_rank==1) THEN
304      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
305    ENDIF
306   
307    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
308                         subdomain%i_index,subdomain%j_index,subdomain%mask)
309   
310    IF (current_rank==nb_client) THEN
311      ni=local_domain%ni
312      nj=local_domain%nj
313     
314      IF (pt_field%axis%name=="none") THEN
315        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
316      ELSE
317        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
318      ENDIF
319   
320    ENDIF
321   
322  END SUBROUTINE iom__write_field2d
323
324  SUBROUTINE iom__write_field3d(varname,var)
325  USE xmlio
326  USE field_bufferize
327  USE mod_interface_ioipsl
328  IMPLICIT NONE
329    CHARACTER(LEN=*) :: varname
330    REAL             :: var(:,:,:)
331
332    TYPE(field),POINTER  :: pt_field
333    TYPE(domain),POINTER :: subdomain
334    TYPE(domain),POINTER :: local_domain
335    INTEGER :: ni,nj,nk,ibegin,jbegin
336    INTEGER :: id_rank
337
338    CALL field__get(varname,pt_field)
339    id_rank=pt_field%grid%ranks(current_rank)
340    local_domain=>pt_field%grid%domain
341   
342    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
343    ni=subdomain%ni
344    nj=subdomain%nj
345    ibegin=subdomain%ibegin-local_domain%ibegin+1
346    jbegin=subdomain%jbegin-local_domain%jbegin+1 
347    nk=pt_field%axis%size
348
349    IF (subdomain%type==box) THEN
350      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
351        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
352                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
353        CALL error("iom__write_field3d")
354      ENDIF
355     
356      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
357        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
358                         'field dim : ',size(var,3),'  axis dim : ',nk
359        CALL error("iom__write_field3d")
360      ENDIF
361
362    ELSE IF (subdomain%type==orange) THEN
363
364      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
365      CALL error("iom__write_field3d")
366     
367    ENDIF
368   
369   
370    IF (current_rank==1) THEN
371      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
372    ENDIF
373   
374    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
375                         subdomain%i_index,subdomain%j_index,subdomain%mask)
376   
377    IF (current_rank==nb_client) THEN
378      ni=local_domain%ni
379      nj=local_domain%nj
380     
381      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
382   
383    ENDIF
384   
385  END SUBROUTINE iom__write_field3d
386 
387  SUBROUTINE iom__Finalize
388  USE mod_interface_ioipsl
389  IMPLICIT NONE
390 
391    IF (current_rank==nb_client) CALL ioipsl_finalize
392   
393  END SUBROUTINE iom__Finalize
394
395
396  SUBROUTINE iom__set_attribut(id,attrib)
397  USE mod_attribut
398  USE mod_object
399  USE mod_field
400  USE mod_field_group
401  USE mod_file
402  USE mod_file_group
403  USE mod_axis
404  USE mod_axis_group
405  USE mod_grid
406  USE mod_grid_group
407  USE mod_zoom
408  IMPLICIT NONE
409    CHARACTER(LEN=*) :: id
410    TYPE(attribut)   :: attrib 
411    LOGICAL          :: success
412    IF (current_rank==nb_client) THEN
413   
414      SELECT CASE(attrib%object)
415        CASE(field_object)
416          CALL field_group__set_attribut(id,attrib,success)
417          IF (.NOT. success) CALL field__set_attribut(id,attrib,success)         
418        CASE(file_object)
419          CALL file_group__set_attribut(id,attrib,success)
420          IF (.NOT. success) CALL file__set_attribut(id,attrib,success)         
421        CASE(axis_object)
422          CALL axis_group__set_attribut(id,attrib,success)
423          IF (.NOT. success) CALL axis__set_attribut(id,attrib,success)         
424        CASE(grid_object)
425          CALL grid_group__set_attribut(id,attrib,success)
426          IF (.NOT. success) CALL grid__set_attribut(id,attrib,success)         
427        CASE(zoom_object)
428          CALL zoom__set_attribut(id,attrib,success)
429      END SELECT
430    ENDIF
431   
432  END SUBROUTINE iom__set_attribut
433   
434END MODULE iomanager 
435 
Note: See TracBrowser for help on using the repository browser.