source: trunk/LMDZ.MARS/libf/phymars/write_output_mod.F90 @ 3055

Last change on this file since 3055 was 3055, checked in by emillour, 13 months ago

Mars PCM:
Add extra tests for XIOS output: only combine and send fields to XIOS if the
user requests them in one of the output files.
EM
File size: 8.4 KB
Line 
1MODULE write_output_mod
2    IMPLICIT NONE
3PRIVATE
4   
5    INTERFACE write_output
6      MODULE PROCEDURE write_output_d0,write_output_d1,write_output_d2, &
7                       write_output_i0,write_output_i1,write_output_i2, &
8                       write_output_l0,write_output_l1,write_output_l2
9
10    END INTERFACE write_output
11
12    PUBLIC write_output
13   
14CONTAINS
15
16  SUBROUTINE write_output_d0(field_name,title,units,field)
17  ! For a surface field
18#ifdef CPP_XIOS
19  use xios_output_mod, only: xios_is_active_field
20  use xios_output_mod, only: send_xios_field
21#endif
22  IMPLICIT NONE
23  include "dimensions.h"
24  INTEGER ngrid
25  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
26  CHARACTER(LEN=*),INTENT(IN)    :: field_name
27  CHARACTER(LEN=*),INTENT(IN)    :: title
28  CHARACTER(LEN=*),INTENT(IN)    :: units
29  REAL,INTENT(IN)                :: field
30 
31  call writediagfi(ngrid,field_name,title,units,0,field)
32#ifdef CPP_XIOS
33  if (xios_is_active_field(field_name)) then
34    ! only send the field to xios if the user asked for it
35    call send_xios_field(field_name,field)
36  endif
37#endif
38 
39  END SUBROUTINE write_output_d0
40
41  SUBROUTINE write_output_d1(field_name,title,units,field)
42  ! For a surface field
43#ifdef CPP_XIOS
44  use xios_output_mod, only: xios_is_active_field
45  use xios_output_mod, only: send_xios_field
46#endif
47  IMPLICIT NONE
48  include "dimensions.h"
49  INTEGER ngrid
50  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
51  CHARACTER(LEN=*),INTENT(IN)    :: field_name
52  CHARACTER(LEN=*),INTENT(IN)    :: title
53  CHARACTER(LEN=*),INTENT(IN)    :: units
54  REAL,INTENT(IN)                :: field(:)
55 
56  call writediagfi(ngrid,field_name,title,units,2,field)
57#ifdef CPP_XIOS
58  if (xios_is_active_field(field_name)) then
59    ! only send the field to xios if the user asked for it
60    call send_xios_field(field_name,field)
61  endif
62#endif
63 
64  END SUBROUTINE write_output_d1
65
66  SUBROUTINE write_output_d2(field_name,title,units,field)
67  ! For a "3D" horizontal-vertical field
68#ifdef CPP_XIOS
69  use xios_output_mod, only: xios_is_active_field
70  use xios_output_mod, only: send_xios_field
71#endif
72  use comsoil_h, only: nsoilmx
73  use writediagsoil_mod, only: writediagsoil
74  IMPLICIT NONE
75  include "dimensions.h"
76  INTEGER ngrid
77  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
78  CHARACTER(LEN=*),INTENT(IN)    :: field_name
79  CHARACTER(LEN=*),INTENT(IN)    :: title
80  CHARACTER(LEN=*),INTENT(IN)    :: units
81  REAL,INTENT(IN)                :: field(:,:)
82
83  if(size(field(:,:),2).eq.nsoilmx) then
84    call writediagsoil(ngrid,field_name,title,units,3,field)
85  else
86    call writediagfi(ngrid,field_name,title,units,3,field(:,:))
87  endif
88#ifdef CPP_XIOS
89  if (xios_is_active_field(field_name)) then
90    ! only send the field to xios if the user asked for it
91    call send_xios_field(field_name,field)
92  endif
93#endif
94 
95  END SUBROUTINE write_output_d2
96
97  SUBROUTINE write_output_i0(field_name,title,units,field)
98  ! For a surface field
99#ifdef CPP_XIOS
100  use xios_output_mod, only: xios_is_active_field
101  use xios_output_mod, only: send_xios_field
102#endif
103  IMPLICIT NONE
104  include "dimensions.h"
105  INTEGER ngrid
106  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
107  CHARACTER(LEN=*),INTENT(IN)    :: field_name
108  CHARACTER(LEN=*),INTENT(IN)    :: title
109  CHARACTER(LEN=*),INTENT(IN)    :: units
110  INTEGER,INTENT(IN)             :: field
111 
112  call writediagfi(ngrid,field_name,title,units,0,real(field))
113#ifdef CPP_XIOS
114  if (xios_is_active_field(field_name)) then
115    ! only send the field to xios if the user asked for it
116    call send_xios_field(field_name,real(field))
117  endif
118#endif
119 
120  END SUBROUTINE write_output_i0
121
122  SUBROUTINE write_output_i1(field_name,title,units,field)
123  ! For a surface field
124#ifdef CPP_XIOS
125  use xios_output_mod, only: xios_is_active_field
126  use xios_output_mod, only: send_xios_field
127#endif
128  IMPLICIT NONE
129  include "dimensions.h"
130  INTEGER ngrid
131  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
132  CHARACTER(LEN=*),INTENT(IN)    :: field_name
133  CHARACTER(LEN=*),INTENT(IN)    :: title
134  CHARACTER(LEN=*),INTENT(IN)    :: units
135  INTEGER,INTENT(IN)             :: field(:)
136 
137  call writediagfi(ngrid,field_name,title,units,2,real(field))
138#ifdef CPP_XIOS
139  if (xios_is_active_field(field_name)) then
140    ! only send the field to xios if the user asked for it
141    call send_xios_field(field_name,real(field))
142  endif
143#endif
144 
145  END SUBROUTINE write_output_i1
146
147  SUBROUTINE write_output_i2(field_name,title,units,field)
148  ! For a "3D" horizontal-vertical field
149#ifdef CPP_XIOS
150  use xios_output_mod, only: xios_is_active_field
151  use xios_output_mod, only: send_xios_field
152#endif
153  use comsoil_h, only: nsoilmx
154  use writediagsoil_mod, only: writediagsoil
155  IMPLICIT NONE
156  include "dimensions.h"
157  INTEGER ngrid
158  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
159  CHARACTER(LEN=*),INTENT(IN)    :: field_name
160  CHARACTER(LEN=*),INTENT(IN)    :: title
161  CHARACTER(LEN=*),INTENT(IN)    :: units
162  INTEGER,INTENT(IN)             :: field(:,:)
163
164  if(size(field(:,:),2).eq.nsoilmx) then
165    call writediagsoil(ngrid,field_name,title,units,3,real(field))
166  else
167    call writediagfi(ngrid,field_name,title,units,3,real(field(:,:)))
168  endif
169#ifdef CPP_XIOS
170  if (xios_is_active_field(field_name)) then
171    ! only send the field to xios if the user asked for it
172    call send_xios_field(field_name,real(field))
173  endif
174#endif
175 
176  END SUBROUTINE write_output_i2
177
178  SUBROUTINE write_output_l0(field_name,title,units,field)
179  ! For a surface field
180#ifdef CPP_XIOS
181  use xios_output_mod, only: xios_is_active_field
182  use xios_output_mod, only: send_xios_field
183#endif
184  IMPLICIT NONE
185  include "dimensions.h"
186  INTEGER ngrid
187  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
188  CHARACTER(LEN=*),INTENT(IN)    :: field_name
189  CHARACTER(LEN=*),INTENT(IN)    :: title
190  CHARACTER(LEN=*),INTENT(IN)    :: units
191  LOGICAL,INTENT(IN)             :: field
192! Local argument used to convert logical to real
193  REAL                           :: field_real
194
195  field_real=0
196  if(field) field_real=1
197 
198  call writediagfi(ngrid,field_name,title,units,0,field_real)
199#ifdef CPP_XIOS
200  if (xios_is_active_field(field_name)) then
201    ! only send the field to xios if the user asked for it
202    call send_xios_field(field_name,field_real)
203  endif
204#endif
205 
206  END SUBROUTINE write_output_l0
207
208  SUBROUTINE write_output_l1(field_name,title,units,field)
209  ! For a surface field
210#ifdef CPP_XIOS
211  use xios_output_mod, only: xios_is_active_field
212  use xios_output_mod, only: send_xios_field
213#endif
214  IMPLICIT NONE
215  include "dimensions.h"
216  INTEGER ngrid
217  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
218  CHARACTER(LEN=*),INTENT(IN)    :: field_name
219  CHARACTER(LEN=*),INTENT(IN)    :: title
220  CHARACTER(LEN=*),INTENT(IN)    :: units
221  LOGICAL,INTENT(IN)             :: field(:)
222! Local argument used to convert logical to real
223  REAL                           :: field_real(ngrid)
224  INTEGER                        :: i
225
226  field_real(:)=0.
227  DO i=1,ngrid
228    if(field(i)) field_real(i)=1.
229  ENDDO
230 
231  call writediagfi(ngrid,field_name,title,units,2,field_real(:))
232#ifdef CPP_XIOS
233  if (xios_is_active_field(field_name)) then
234    ! only send the field to xios if the user asked for it
235    call send_xios_field(field_name,field_real)
236  endif
237#endif
238 
239  END SUBROUTINE write_output_l1
240
241  SUBROUTINE write_output_l2(field_name,title,units,field)
242  ! For a "3D" horizontal-vertical field
243#ifdef CPP_XIOS
244  use xios_output_mod, only: xios_is_active_field
245  use xios_output_mod, only: send_xios_field
246#endif
247  use comsoil_h, only: nsoilmx
248  use writediagsoil_mod, only: writediagsoil
249  IMPLICIT NONE
250  include "dimensions.h"
251  INTEGER ngrid
252  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
253  CHARACTER(LEN=*),INTENT(IN)    :: field_name
254  CHARACTER(LEN=*),INTENT(IN)    :: title
255  CHARACTER(LEN=*),INTENT(IN)    :: units
256  LOGICAL,INTENT(IN)             :: field(:,:)
257! Local argument used to convert logical to real
258  REAL,allocatable               :: field_real(:,:)
259  INTEGER                        :: i,j
260
261  allocate(field_real(size(field,1),size(field,2)))
262
263  field_real(:,:)=0.
264  DO i=1,size(field,1)
265    DO j=1,size(field,2)
266      if(field(i,j)) field_real(i,j)=1.
267    ENDDO
268  ENDDO
269
270  if(size(field(:,:),2).eq.nsoilmx) then
271    call writediagsoil(ngrid,field_name,title,units,3,field_real)
272  else
273    call writediagfi(ngrid,field_name,title,units,3,field_real(:,:))
274  endif
275
276#ifdef CPP_XIOS
277  if (xios_is_active_field(field_name)) then
278    ! only send the field to xios if the user asked for it
279    call send_xios_field(field_name,field_real)
280  endif
281#endif
282 
283  deallocate(field_real)
284
285  END SUBROUTINE write_output_l2
286
287END MODULE write_output_mod
Note: See TracBrowser for help on using the repository browser.