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

Last change on this file since 3118 was 3092, checked in by jbclement, 14 months ago

Marc PCM:

  • Correction of a bug in "writediagfi.F": the case of using the 1D model with parallelization was not anticipated so that the "diagfi.nc" file was filled with NaNf?;
  • Addition of the file "start1D.txt" as an example in the directory deftank/;
  • Some "cosmetic" modifications in "improvedclouds_mod.F", "write_output_mod.F90" and "testphys1d.F90".

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