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/2011/dev_NEMO_MERGE_2011/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER – NEMO

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90 @ 3257

Last change on this file since 3257 was 3257, checked in by charris, 12 years ago

Corrected order of calls for 2d and 3d fields as discussed with Yann Meurdesoif (in practice this makes no difference with the standard use of the ioserver code).
  • 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_2d(varname,Field_buffer(1:ni,1:nj,1))
316      ELSE
317        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
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.