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

Last change on this file since 3026 was 2976, checked in by emillour, 19 months ago

Mars PCM:
Follow-up to r2970: output of integers/logicals also converted to reals with XIOS
Also updated "deftank/field_def_physics_mars.xml" to keep up with recently added
variables
EM
File size: 7.0 KB
RevLine 
[2932]1MODULE write_output_mod
2    IMPLICIT NONE
3PRIVATE
4   
5    INTERFACE write_output
[2970]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
[2932]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
[2934]18#ifdef CPP_XIOS
19  use xios_output_mod, only: send_xios_field
20#endif
[2932]21  IMPLICIT NONE
22  include "dimensions.h"
23  INTEGER ngrid
24  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
25  CHARACTER(LEN=*),INTENT(IN)    :: field_name
26  CHARACTER(LEN=*),INTENT(IN)    :: title
27  CHARACTER(LEN=*),INTENT(IN)    :: units
28  REAL,INTENT(IN)                :: field
29 
30  call writediagfi(ngrid,field_name,title,units,0,field)
31#ifdef CPP_XIOS
32  call send_xios_field(field_name,field)
33#endif
34 
35  END SUBROUTINE write_output_d0
36
37  SUBROUTINE write_output_d1(field_name,title,units,field)
38  ! For a surface field
[2934]39#ifdef CPP_XIOS
40  use xios_output_mod, only: send_xios_field
41#endif
[2932]42  IMPLICIT NONE
43  include "dimensions.h"
44  INTEGER ngrid
45  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
46  CHARACTER(LEN=*),INTENT(IN)    :: field_name
47  CHARACTER(LEN=*),INTENT(IN)    :: title
48  CHARACTER(LEN=*),INTENT(IN)    :: units
49  REAL,INTENT(IN)                :: field(:)
50 
[2933]51  call writediagfi(ngrid,field_name,title,units,2,field)
[2932]52#ifdef CPP_XIOS
53  call send_xios_field(field_name,field)
54#endif
55 
56  END SUBROUTINE write_output_d1
57
58  SUBROUTINE write_output_d2(field_name,title,units,field)
59  ! For a "3D" horizontal-vertical field
[2934]60#ifdef CPP_XIOS
61  use xios_output_mod, only: send_xios_field
62#endif
[2932]63  use comsoil_h, only: nsoilmx
64  use writediagsoil_mod, only: writediagsoil
65  IMPLICIT NONE
66  include "dimensions.h"
67  INTEGER ngrid
68  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
69  CHARACTER(LEN=*),INTENT(IN)    :: field_name
70  CHARACTER(LEN=*),INTENT(IN)    :: title
71  CHARACTER(LEN=*),INTENT(IN)    :: units
72  REAL,INTENT(IN)                :: field(:,:)
73
74  if(size(field(:,:),2).eq.nsoilmx) then
75    call writediagsoil(ngrid,field_name,title,units,3,field)
76  else
[2933]77    call writediagfi(ngrid,field_name,title,units,3,field(:,:))
[2932]78  endif
79#ifdef CPP_XIOS
80  call send_xios_field(field_name,field)
81#endif
82 
83  END SUBROUTINE write_output_d2
84
[2970]85  SUBROUTINE write_output_i0(field_name,title,units,field)
86  ! For a surface field
87#ifdef CPP_XIOS
88  use xios_output_mod, only: send_xios_field
89#endif
90  IMPLICIT NONE
91  include "dimensions.h"
92  INTEGER ngrid
93  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
94  CHARACTER(LEN=*),INTENT(IN)    :: field_name
95  CHARACTER(LEN=*),INTENT(IN)    :: title
96  CHARACTER(LEN=*),INTENT(IN)    :: units
97  INTEGER,INTENT(IN)             :: field
98 
99  call writediagfi(ngrid,field_name,title,units,0,real(field))
100#ifdef CPP_XIOS
[2976]101  call send_xios_field(field_name,real(field))
[2970]102#endif
103 
104  END SUBROUTINE write_output_i0
105
106  SUBROUTINE write_output_i1(field_name,title,units,field)
107  ! For a surface field
108#ifdef CPP_XIOS
109  use xios_output_mod, only: send_xios_field
110#endif
111  IMPLICIT NONE
112  include "dimensions.h"
113  INTEGER ngrid
114  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
115  CHARACTER(LEN=*),INTENT(IN)    :: field_name
116  CHARACTER(LEN=*),INTENT(IN)    :: title
117  CHARACTER(LEN=*),INTENT(IN)    :: units
118  INTEGER,INTENT(IN)             :: field(:)
119 
120  call writediagfi(ngrid,field_name,title,units,2,real(field))
121#ifdef CPP_XIOS
[2976]122  call send_xios_field(field_name,real(field))
[2970]123#endif
124 
125  END SUBROUTINE write_output_i1
126
127  SUBROUTINE write_output_i2(field_name,title,units,field)
128  ! For a "3D" horizontal-vertical field
129#ifdef CPP_XIOS
130  use xios_output_mod, only: send_xios_field
131#endif
132  use comsoil_h, only: nsoilmx
133  use writediagsoil_mod, only: writediagsoil
134  IMPLICIT NONE
135  include "dimensions.h"
136  INTEGER ngrid
137  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
138  CHARACTER(LEN=*),INTENT(IN)    :: field_name
139  CHARACTER(LEN=*),INTENT(IN)    :: title
140  CHARACTER(LEN=*),INTENT(IN)    :: units
141  INTEGER,INTENT(IN)             :: field(:,:)
142
143  if(size(field(:,:),2).eq.nsoilmx) then
144    call writediagsoil(ngrid,field_name,title,units,3,real(field))
145  else
146    call writediagfi(ngrid,field_name,title,units,3,real(field(:,:)))
147  endif
148#ifdef CPP_XIOS
[2976]149  call send_xios_field(field_name,real(field))
[2970]150#endif
151 
152  END SUBROUTINE write_output_i2
153
154  SUBROUTINE write_output_l0(field_name,title,units,field)
155  ! For a surface field
156#ifdef CPP_XIOS
157  use xios_output_mod, only: send_xios_field
158#endif
159  IMPLICIT NONE
160  include "dimensions.h"
161  INTEGER ngrid
162  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
163  CHARACTER(LEN=*),INTENT(IN)    :: field_name
164  CHARACTER(LEN=*),INTENT(IN)    :: title
165  CHARACTER(LEN=*),INTENT(IN)    :: units
166  LOGICAL,INTENT(IN)             :: field
167! Local argument used to convert logical to real
168  REAL                           :: field_real
169
170  field_real=0
171  if(field) field_real=1
172 
173  call writediagfi(ngrid,field_name,title,units,0,field_real)
174#ifdef CPP_XIOS
[2976]175  call send_xios_field(field_name,field_real)
[2970]176#endif
177 
178  END SUBROUTINE write_output_l0
179
180  SUBROUTINE write_output_l1(field_name,title,units,field)
181  ! For a surface field
182#ifdef CPP_XIOS
183  use xios_output_mod, only: send_xios_field
184#endif
185  IMPLICIT NONE
186  include "dimensions.h"
187  INTEGER ngrid
188  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
189  CHARACTER(LEN=*),INTENT(IN)    :: field_name
190  CHARACTER(LEN=*),INTENT(IN)    :: title
191  CHARACTER(LEN=*),INTENT(IN)    :: units
192  LOGICAL,INTENT(IN)             :: field(:)
193! Local argument used to convert logical to real
194  REAL                           :: field_real(ngrid)
195  INTEGER                        :: i
196
197  field_real(:)=0.
198  DO i=1,ngrid
199    if(field(i)) field_real(i)=1.
200  ENDDO
201 
202  call writediagfi(ngrid,field_name,title,units,2,field_real(:))
203#ifdef CPP_XIOS
[2976]204  call send_xios_field(field_name,field_real)
[2970]205#endif
206 
207  END SUBROUTINE write_output_l1
208
209  SUBROUTINE write_output_l2(field_name,title,units,field)
210  ! For a "3D" horizontal-vertical field
211#ifdef CPP_XIOS
212  use xios_output_mod, only: send_xios_field
213#endif
214  use comsoil_h, only: nsoilmx
215  use writediagsoil_mod, only: writediagsoil
216  IMPLICIT NONE
217  include "dimensions.h"
218  INTEGER ngrid
219  PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
220  CHARACTER(LEN=*),INTENT(IN)    :: field_name
221  CHARACTER(LEN=*),INTENT(IN)    :: title
222  CHARACTER(LEN=*),INTENT(IN)    :: units
223  LOGICAL,INTENT(IN)             :: field(:,:)
224! Local argument used to convert logical to real
225  REAL,allocatable               :: field_real(:,:)
226  INTEGER                        :: i,j
227
228  allocate(field_real(size(field,1),size(field,2)))
229
230  field_real(:,:)=0.
231  DO i=1,size(field,1)
232    DO j=1,size(field,2)
233      if(field(i,j)) field_real(i,j)=1.
234    ENDDO
235  ENDDO
236
237  if(size(field(:,:),2).eq.nsoilmx) then
238    call writediagsoil(ngrid,field_name,title,units,3,field_real)
239  else
240    call writediagfi(ngrid,field_name,title,units,3,field_real(:,:))
241  endif
242
243#ifdef CPP_XIOS
[2976]244  call send_xios_field(field_name,field_real)
[2970]245#endif
246 
[2976]247  deallocate(field_real)
248
[2970]249  END SUBROUTINE write_output_l2
250
[2932]251END MODULE write_output_mod
Note: See TracBrowser for help on using the repository browser.