SURFEX v8.1
General documentation of Surfex
write_surf.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 !##################
6 MODULE modi_write_surf
7 !##################
8 !
9 !----------------------------------------------------
10 !! MODIFICATIONS
11 !! -------------
12 !! Original
13 !! J.Escobar 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
14 !----------------------------------------------------
15 !
16  INTERFACE write_surf
17 !
18  SUBROUTINE write_surfx0 (HSELECT, HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT)
19 !
20 !
21  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
22 !
23  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
24  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
25 REAL, INTENT(IN) :: PFIELD ! real scalar to be written
26 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
27  CHARACTER(LEN=100),INTENT(IN) :: HCOMMENT ! Comment string
28 !
29 END SUBROUTINE write_surfx0
30 !
31  SUBROUTINE write_surfx1 (HSELECT, HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
32 !
33  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
34 !
35  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
36  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
37 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field
38 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
39  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
40  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
41 ! ! 'H' : field with
42 ! ! horizontal spatial dim.
43 ! ! '-' : no horizontal dim.
44  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
45 END SUBROUTINE write_surfx1
46 !
47  SUBROUTINE write_surfx2 ( HSELECT,HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
48 !
49 !
50  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
51 !
52  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
53  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
54 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
55 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
56  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
57  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
58 ! ! 'H' : field with
59 ! ! horizontal spatial dim.
60 ! ! '-' : no horizontal dim.
61  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
62 END SUBROUTINE write_surfx2
63 !
64  SUBROUTINE write_surfx3 ( HSELECT,HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
65 !
66 !
67  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
68 !
69  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
70  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
71 REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
72 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
73  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
74  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
75 ! ! 'H' : field with
76 ! ! horizontal spatial dim.
77 ! ! '-' : no horizontal dim.
78  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
79 END SUBROUTINE write_surfx3
80 !
81 !RJ: interface to WRITE_SURFX2COV moved out
82 !
83  SUBROUTINE write_surfn0 ( HSELECT, HPROGRAM,HREC,KFIELD,KRESP,HCOMMENT)
84 !
85 !
86  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
87 !
88  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
89  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
90 INTEGER, INTENT(IN) :: KFIELD ! integer to be written
91 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
92  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
93 !
94 END SUBROUTINE write_surfn0
95 !
96  SUBROUTINE write_surfn1 ( HSELECT, HPROGRAM,HREC,KFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
97 !
98  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
99 !
100  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
101  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
102 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD ! integer to be written
103 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
104  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
105  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
106 ! ! 'H' : field with
107 ! ! horizontal spatial dim.
108 ! ! '-' : no horizontal dim.
109  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
110 END SUBROUTINE write_surfn1
111 !
112  SUBROUTINE write_surfc0 ( HSELECT, HPROGRAM,HREC,HFIELD,KRESP,HCOMMENT)
113 !
114  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
115 !
116  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
117  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
118  CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! caracter to be written
119 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
120  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
121 !
122 END SUBROUTINE write_surfc0
123 !
124  SUBROUTINE write_surfl0 ( HSELECT, HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT)
125 !
126  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
127 !
128  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
129  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
130 LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
131 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
132  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
133 !
134 END SUBROUTINE write_surfl0
135 !
136  SUBROUTINE write_surfl1 ( HSELECT, HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT,HDIR)
137 !
138  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
139 !
140  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
141  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
142 LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field
143 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
144  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
145  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
146 ! ! 'H' : field with
147 ! ! horizontal spatial dim.
148 ! ! '-' : no horizontal dim.
149 END SUBROUTINE write_surfl1
150 !
151  SUBROUTINE write_surft0 ( HSELECT, HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
152 !
153 USE modd_type_date_surf
154 !
155 !
156  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
157 !
158  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
159  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
160 type(date_time), INTENT(IN) :: tfield ! array containing the data field
161 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
162  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
163 !
164 END SUBROUTINE write_surft0
165 !
166  SUBROUTINE write_surft1 ( HSELECT, HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
167 !
168 USE modd_type_date_surf
169 !
170  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
171 !
172  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
173  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
174 type(date_time), DIMENSION(:), INTENT(IN) :: tfield ! array containing the data field
175 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
176  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
177 !
178 END SUBROUTINE write_surft1
179 !
180  SUBROUTINE write_surft2 ( HSELECT, HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
181 !
182 USE modd_type_date_surf
183 !
184 !
185  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
186 !
187  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
188  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
189 type(date_time), DIMENSION(:,:), INTENT(IN) :: tfield ! array containing the data field
190 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
191  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
192 !
193 END SUBROUTINE write_surft2
194 !
195 END INTERFACE
196 !
197 END MODULE modi_write_surf
198 !
199 ! #############################################################
200  SUBROUTINE write_surfx0 ( HSELECT, &
201  HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT)
202 ! #############################################################
203 !
204 !!**** *WRITEX0* - routine to write a real scalar
205 !
206 !
207 USE yomhook ,ONLY : lhook, dr_hook
208 USE parkind1 ,ONLY : jprb
209 !
210 USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
211 !
212 #ifdef SFX_OL
213 USE mode_write_surf_ol, ONLY: write_surf0_ol, write_surf0_time_ol
214 #endif
215 #ifdef SFX_LFI
216 USE mode_write_surf_lfi, ONLY: write_surf0_lfi
217 #endif
218 #ifdef SFX_NC
219 USE mode_write_surf_nc, ONLY: write_surf0_nc
220 #endif
221 #ifdef SFX_TXT
222 USE mode_write_surf_txt, ONLY: write_surf0_txt
223 #endif
224 #ifdef SFX_BIN
225 USE mode_write_surf_bin, ONLY: write_surf0_bin
226 #endif
227 #ifdef SFX_ASC
228 USE mode_write_surf_asc, ONLY: write_surf0_asc
229 #endif
230 #ifdef SFX_FA
231 USE mode_write_surf_fa, ONLY: write_surf0_fa
232 #endif
233 #ifdef SFX_MNH
234 USE modi_write_surfx0_mnh
235 #endif
236 #ifdef WXIOS
237 USE modi_write_surf_xios
238 #endif
239 #ifdef SFX_ARO
240 USE modi_write_surfx0_aro
241 #endif
242 !
243 USE modi_test_record_len
244 !
245 IMPLICIT NONE
246 !
247 #ifdef SFX_MPI
248 include "mpif.h"
249 #endif
250 !
251 !
252  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
253 !
254 !
255 !* 0.1 Declarations of arguments
256 !
257  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
258  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
259 REAL, INTENT(IN) :: PFIELD ! real scalar to be written
260 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
261  CHARACTER(LEN=100),INTENT(IN) :: HCOMMENT ! Comment string
262 !
263 !* 0.2 Declarations of local variables
264 !
265  CHARACTER(LEN=16) :: YREC2
266  CHARACTER(LEN=12) :: YREC
267 LOGICAL :: GNOWRITE
268 REAL :: XTIME0
269 REAL(KIND=JPRB) :: ZHOOK_HANDLE
270 !
271 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',0,zhook_handle)
272 !
273 yrec = hrec
274 !
275  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
276 !
277 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',1,zhook_handle)
278 IF(gnowrite)RETURN
279 !
280 IF (hprogram=='MESONH') THEN
281 #ifdef SFX_MNH
282  yrec2 = yrec
283  CALL write_surfx0_mnh(yrec2,pfield,kresp,hcomment)
284 #endif
285 ENDIF
286 !
287 IF (hprogram=='AROME ') THEN
288 #ifdef SFX_ARO
289  CALL write_surfx0_aro(yrec,pfield,kresp,hcomment)
290 #endif
291 ENDIF
292 !
293 IF (nrank==npio) THEN
294  !
295 #ifdef SFX_MPI
296  xtime0 = mpi_wtime()
297 #endif
298  !
299  IF (hprogram=='ASCII ') THEN
300 #ifdef SFX_ASC
301  CALL write_surf0_asc(yrec,pfield,kresp,hcomment)
302 #endif
303  ENDIF
304  !
305  IF (hprogram=='FA ') THEN
306 #ifdef SFX_FA
307  CALL write_surf0_fa(yrec,pfield,kresp,hcomment)
308 #endif
309  ENDIF
310  !
311  IF (hprogram=='OFFLIN') THEN
312 #ifdef SFX_OL
313  IF (yrec=='time') THEN
314  CALL write_surf0_time_ol(pfield,kresp,hcomment)
315  ELSE
316  CALL write_surf0_ol(hselect,yrec,pfield,kresp,hcomment)
317  ENDIF
318 #endif
319  ENDIF
320  !
321  IF (hprogram=='TEXTE ') THEN
322 #ifdef SFX_TXT
323  CALL write_surf0_txt(yrec,pfield,kresp,hcomment)
324 #endif
325  ENDIF
326  !
327  IF (hprogram=='BINARY') THEN
328 #ifdef SFX_BIN
329  CALL write_surf0_bin(yrec,pfield,kresp,hcomment)
330 #endif
331  ENDIF
332  !
333  IF (hprogram=='LFI ') THEN
334 #ifdef SFX_LFI
335  CALL write_surf0_lfi(yrec,pfield,kresp,hcomment)
336 #endif
337  ENDIF
338  !
339  IF (hprogram=='NC ') THEN
340 #ifdef SFX_NC
341  CALL write_surf0_nc(hselect,yrec,pfield,kresp,hcomment)
342 #endif
343  ENDIF
344  !
345 #ifdef SFX_MPI
346  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
347 #endif
348  !
349 ENDIF
350 !
351 IF (trim(hprogram)=='XIOS') THEN
352 #ifdef WXIOS
353  CALL write_surf_xios(yrec, hcomment, pfield=pfield)
354 #endif
355 ENDIF
356 !
357 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',1,zhook_handle)
358 !
359 END SUBROUTINE write_surfx0
360 !
361 ! #############################################################
362  SUBROUTINE write_surfx1 ( HSELECT,HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
363 ! #############################################################
364 !
365 !!**** *WRITEX1* - routine to fill a real 1D array for the externalised surface
366 !
367 USE modd_surfex_mpi, ONLY : wlog_mpi, nrank
368 USE yomhook ,ONLY : lhook, dr_hook
369 USE parkind1 ,ONLY : jprb
370 !
371 #ifdef SFX_OL
372 USE mode_write_surf_ol, ONLY: write_surfx1n1_ol
373 #endif
374 #ifdef SFX_ASC
375 USE mode_write_surf_asc, ONLY: write_surfn_asc
376 #endif
377 #ifdef SFX_TXT
378 USE mode_write_surf_txt, ONLY: write_surfx_txt
379 #endif
380 #ifdef SFX_BIN
381 USE mode_write_surf_bin, ONLY: write_surfx_bin
382 #endif
383 #ifdef SFX_FA
384 USE mode_write_surf_fa, ONLY: write_surfn_fa
385 #endif
386 #ifdef SFX_LFI
387 USE mode_write_surf_lfi, ONLY: write_surfn_lfi
388 #endif
389 #ifdef SFX_NC
390 USE mode_write_surf_nc, ONLY: write_surfn_nc
391 #endif
392 #ifdef SFX_MNH
393 USE modi_write_surfx1_mnh
394 #endif
395 #ifdef WXIOS
396 USE modi_write_surf_xios
397 #endif
398 #ifdef SFX_ARO
399 USE modi_write_surfx1_aro
400 #endif
401 !
402 USE modi_test_record_len
403 !
404 IMPLICIT NONE
405 !
406 !
407 !* 0.1 Declarations of arguments
408 !
409  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
410 !
411  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
412 !
413  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
414 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field
415 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
416  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
417  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
418 ! ! 'H' : field with
419 ! ! horizontal spatial dim.
420 ! ! '-' : no horizontal dim.
421  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
422 !* 0.2 Declarations of local variables
423 !
424  CHARACTER(LEN=16) :: YREC2
425  CHARACTER(LEN=12) :: YREC
426 INTEGER :: IL
427  CHARACTER(LEN=1) :: YDIR
428 LOGICAL :: GNOWRITE
429 REAL(KIND=JPRB) :: ZHOOK_HANDLE
430 !
431 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',0,zhook_handle)
432 !
433 yrec = hrec
434 !
435  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
436 !
437 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',1,zhook_handle)
438 IF(gnowrite)RETURN
439 !
440 IF (trim(hprogram)=='XIOS') THEN
441 #ifdef WXIOS
442  CALL write_surf_xios(yrec, hcomment, pfield1=pfield)
443 #endif
444 ELSE
445 
446  ydir = 'H'
447  IF (PRESENT(hdir)) ydir = hdir
448  il = SIZE(pfield)
449 
450  IF (hprogram=='MESONH') THEN
451 #ifdef SFX_MNH
452  yrec2 = yrec
453  CALL write_surfx1_mnh(yrec2,il,pfield,kresp,hcomment,ydir)
454 #endif
455  ENDIF
456  !
457  IF (hprogram=='AROME ') THEN
458 #ifdef SFX_ARO
459  CALL write_surfx1_aro(yrec,il,pfield,kresp,hcomment,ydir)
460 #endif
461  ENDIF
462  !
463  IF (hprogram=='OFFLIN') THEN
464 #ifdef SFX_OL
465  CALL write_surfx1n1_ol(hselect,yrec,pfield,kresp,hcomment,ydir)
466 #endif
467  ENDIF
468  !
469  IF (hprogram=='TEXTE ') THEN
470 #ifdef SFX_TXT
471  CALL write_surfx_txt(hselect,yrec,pfield,kresp,hcomment,ydir)
472 #endif
473  ENDIF
474  !
475  IF (hprogram=='BINARY') THEN
476 #ifdef SFX_BIN
477  CALL write_surfx_bin(hselect,yrec,pfield,kresp,hcomment,ydir)
478 #endif
479  ENDIF
480  !
481  IF (hprogram=='LFI ') THEN
482 #ifdef SFX_LFI
483  CALL write_surfn_lfi(yrec,pfield,kresp,hcomment,ydir)
484 #endif
485  ENDIF
486  !
487  IF (hprogram=='NC ') THEN
488 #ifdef SFX_NC
489  IF (PRESENT(hnam_dim)) THEN
490  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir,hnam_dim)
491  ELSE
492  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir)
493  ENDIF
494 #endif
495  ENDIF
496  !
497  IF (hprogram=='ASCII ') THEN
498 #ifdef SFX_ASC
499  CALL write_surfn_asc(yrec,pfield,kresp,hcomment,ydir)
500 #endif
501  ENDIF
502  !
503  IF (hprogram=='FA ') THEN
504 #ifdef SFX_FA
505  CALL write_surfn_fa(yrec,il,pfield,kresp,hcomment,ydir)
506 #endif
507  ENDIF
508  !
509 ENDIF
510 !
511 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',1,zhook_handle)
512 !
513 END SUBROUTINE write_surfx1
514 !
515 ! #############################################################
516  SUBROUTINE write_surfx2 ( HSELECT, HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
517 ! #############################################################
518 !
519 !!**** *WRITEX2* - routine to fill a real 2D array for the externalised surface
520 !
521 USE modd_surfex_mpi, ONLY : wlog_mpi
522 USE yomhook ,ONLY : lhook, dr_hook
523 USE parkind1 ,ONLY : jprb
524 !
525 #ifdef SFX_OL
526 USE mode_write_surf_ol, ONLY: write_surfl1x2_ol
527 #endif
528 #ifdef SFX_TXT
529 USE mode_write_surf_txt, ONLY: write_surfx_txt
530 #endif
531 #ifdef SFX_BIN
532 USE mode_write_surf_bin, ONLY: write_surfx_bin
533 #endif
534 #ifdef SFX_LFI
535 USE mode_write_surf_lfi, ONLY: write_surfn_lfi
536 #endif
537 #ifdef SFX_NC
538 USE mode_write_surf_nc, ONLY: write_surfn_nc
539 #endif
540 #ifdef SFX_ASC
541 USE mode_write_surf_asc, ONLY: write_surfn_asc
542 #endif
543 #ifdef SFX_FA
544 USE mode_write_surf_fa, ONLY: write_surfn_fa
545 #endif
546 #ifdef SFX_MNH
547 USE modi_write_surfx2_mnh
548 #endif
549 #ifdef WXIOS
550 USE modi_write_surf_xios
551 #endif
552 !
553 USE modi_test_record_len
554 !
555 #ifdef SFX_ARO
556 USE modi_write_surfx2_aro
557 #endif
558 !
559 IMPLICIT NONE
560 !
561 !* 0.1 Declarations of arguments
562 !
563  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
564 !
565  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
566 !
567  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
568 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
569 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
570  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
571  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
572 ! ! 'H' : field with
573 ! ! horizontal spatial dim.
574 ! ! '-' : no horizontal dim.
575  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
576 !* 0.2 Declarations of local variables
577 !
578  CHARACTER(LEN=16) :: YREC2
579  CHARACTER(LEN=12) :: YREC
580 INTEGER :: IL1
581 INTEGER :: IL2
582  CHARACTER(LEN=1) :: YDIR
583 LOGICAL :: GNOWRITE
584 REAL(KIND=JPRB) :: ZHOOK_HANDLE
585 !
586 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',0,zhook_handle)
587 !
588 yrec = hrec
589 !
590  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
591 !
592 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',1,zhook_handle)
593 IF(gnowrite)RETURN
594 !
595 IF (trim(hprogram)=='XIOS') THEN
596 #ifdef WXIOS
597  CALL write_surf_xios(trim(yrec), hcomment, pfield2=pfield, haxis=hnam_dim)
598 #endif
599 ELSE
600  !
601  ydir = 'H'
602  IF (PRESENT(hdir)) ydir = hdir
603  il1 = SIZE(pfield,1)
604  il2 = SIZE(pfield,2)
605  !
606  IF (hprogram=='MESONH') THEN
607 #ifdef SFX_MNH
608  yrec2 = yrec
609  CALL write_surfx2_mnh(yrec2,il1,il2,pfield,kresp,hcomment,ydir)
610 #endif
611  ENDIF
612  !
613  IF (hprogram=='AROME ') THEN
614 #ifdef SFX_ARO
615  CALL write_surfx2_aro(yrec,il1,il2,pfield,kresp,hcomment,ydir)
616 #endif
617  ENDIF
618  !
619  IF (hprogram=='OFFLIN') THEN
620 #ifdef SFX_OL
621  IF (PRESENT(hnam_dim)) THEN
622  CALL write_surfl1x2_ol(hselect,yrec,pfield,kresp,hcomment,ydir,hnam_dim=hnam_dim)
623  ELSE
624  CALL write_surfl1x2_ol(hselect,yrec,pfield,kresp,hcomment,ydir)
625  ENDIF
626 #endif
627  ENDIF
628  !
629  IF (hprogram=='TEXTE ') THEN
630 #ifdef SFX_TXT
631  CALL write_surfx_txt(hselect, yrec,pfield,kresp,hcomment,ydir)
632 #endif
633  ENDIF
634  !
635  IF (hprogram=='BINARY') THEN
636 #ifdef SFX_BIN
637  CALL write_surfx_bin(hselect, yrec,pfield,kresp,hcomment,ydir)
638 #endif
639  ENDIF
640  !
641  IF (hprogram=='LFI ') THEN
642 #ifdef SFX_LFI
643  CALL write_surfn_lfi(yrec,pfield,kresp,hcomment,ydir)
644 #endif
645  ENDIF
646  !
647  IF (hprogram=='NC ') THEN
648 #ifdef SFX_NC
649  IF (PRESENT(hnam_dim)) THEN
650  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir,hnam_dim)
651  ELSE
652  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir)
653  ENDIF
654 #endif
655  ENDIF
656  !
657  IF (hprogram=='ASCII ') THEN
658 #ifdef SFX_ASC
659  CALL write_surfn_asc(yrec,pfield,kresp,hcomment,ydir)
660 #endif
661  ENDIF
662  !
663  IF (hprogram=='FA ') THEN
664 #ifdef SFX_FA
665  CALL write_surfn_fa(yrec,il1,il2,pfield,kresp,hcomment,ydir)
666 #endif
667  ENDIF
668  !
669 ENDIF
670 !
671 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',1,zhook_handle)
672 !
673 END SUBROUTINE write_surfx2
674 !
675 ! #############################################################
676  SUBROUTINE write_surfx3 ( HSELECT, HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
677 ! #############################################################
678 !
679 !!**** *WRITEX2* - routine to fill a real 2D array for the externalised surface
680 !
681 !
682 !
683 !
684 !
685 !
686 USE modd_surfex_mpi, ONLY : wlog_mpi
687 USE yomhook ,ONLY : lhook, dr_hook
688 USE parkind1 ,ONLY : jprb
689 !
690 #ifdef SFX_OL
691 USE mode_write_surf_ol, ONLY: write_surfl1x2_ol
692 #endif
693 #ifdef SFX_TXT
694 USE mode_write_surf_txt, ONLY: write_surfx_txt
695 #endif
696 #ifdef SFX_BIN
697 USE mode_write_surf_bin, ONLY: write_surfx_bin
698 #endif
699 #ifdef SFX_LFI
700 USE mode_write_surf_lfi, ONLY: write_surfn_lfi
701 #endif
702 #ifdef SFX_NC
703 USE mode_write_surf_nc, ONLY: write_surfn_nc
704 #endif
705 #ifdef SFX_ASC
706 USE mode_write_surf_asc, ONLY: write_surfn_asc
707 #endif
708 #ifdef SFX_FA
709 USE mode_write_surf_fa, ONLY: write_surfn_fa
710 #endif
711 #ifdef SFX_MNH
712 !USE MODI_WRITE_SURFX3_MNH
713 #endif
714 #ifdef WXIOS
715 USE modi_write_surf_xios
716 #endif
717 #ifdef SFX_ARO
718 USE modi_write_surfx2_aro
719 #endif
720 
721 !
722 USE modi_test_record_len
723 !
724 IMPLICIT NONE
725 !
726 !
727 !* 0.1 Declarations of arguments
728 !
729  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
730 !
731  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
732 !
733  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
734 REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
735 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
736  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
737  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
738 ! ! 'H' : field with
739 ! ! horizontal spatial dim.
740 ! ! '-' : no horizontal dim.
741  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
742 !* 0.2 Declarations of local variables
743 !
744  CHARACTER(LEN=12) :: YREC
745 INTEGER :: IL1
746 INTEGER :: IL2, IL3
747  CHARACTER(LEN=1) :: YDIR
748 LOGICAL :: GNOWRITE
749 REAL(KIND=JPRB) :: ZHOOK_HANDLE
750 !
751 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX3',0,zhook_handle)
752 !
753 yrec = hrec
754 !
755  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
756 !
757 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX3',1,zhook_handle)
758 IF(gnowrite)RETURN
759 !
760 IF (trim(hprogram)=='XIOS') THEN
761 #ifdef WXIOS
762  CALL write_surf_xios(trim(yrec), hcomment, pfield3=pfield, haxis=hnam_dim)
763 #endif
764 ELSE
765  !
766  ydir = 'H'
767  IF (PRESENT(hdir)) ydir = hdir
768  il1 = SIZE(pfield,1)
769  il2 = SIZE(pfield,2)
770  il3 = SIZE(pfield,3)
771  !
772  IF (hprogram=='MESONH') THEN
773 #ifdef SFX_MNH
774  !CALL WRITE_SURFX3_MNH(YREC,IL1,IL2,PFIELD,KRESP,HCOMMENT,YDIR)
775 #endif
776  ENDIF
777  !
778  IF (hprogram=='AROME ') THEN
779 #ifdef SFX_ARO
780  !CALL WRITE_SURFX3_ARO(YREC,IL1,IL2,PFIELD,KRESP,HCOMMENT,YDIR)
781 #endif
782  ENDIF
783  !
784  IF (hprogram=='OFFLIN') THEN
785 #ifdef SFX_OL
786  IF (PRESENT(hnam_dim)) THEN
787  CALL write_surfl1x2_ol(hselect,yrec,pfield,kresp,hcomment,ydir,hnam_dim=hnam_dim)
788  ELSE
789  CALL write_surfl1x2_ol(hselect,yrec,pfield,kresp,hcomment,ydir)
790  ENDIF
791 #endif
792  ENDIF
793  !
794  IF (hprogram=='TEXTE ') THEN
795 #ifdef SFX_TXT
796  !CALL WRITE_SURFX_TXT(HSELECT, YREC,PFIELD,KRESP,HCOMMENT,YDIR)
797 #endif
798  ENDIF
799  !
800  IF (hprogram=='BINARY') THEN
801 #ifdef SFX_BIN
802  !CALL WRITE_SURFX_BIN(HSELECT, YREC,PFIELD,KRESP,HCOMMENT,YDIR)
803 #endif
804  ENDIF
805  !
806  IF (hprogram=='LFI ') THEN
807 #ifdef SFX_LFI
808  CALL write_surfn_lfi(yrec,pfield,kresp,hcomment,ydir)
809 #endif
810  ENDIF
811  !
812  IF (hprogram=='NC ') THEN
813 #ifdef SFX_NC
814  IF (PRESENT(hnam_dim)) THEN
815  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir,hnam_dim)
816  ELSE
817  CALL write_surfn_nc( hselect, yrec,pfield,kresp,hcomment,ydir)
818  ENDIF
819 #endif
820  ENDIF
821  !
822  IF (hprogram=='ASCII ') THEN
823 #ifdef SFX_ASC
824  CALL write_surfn_asc(yrec,pfield,kresp,hcomment,ydir)
825 #endif
826  ENDIF
827  !
828  IF (hprogram=='FA ') THEN
829 #ifdef SFX_FA
830  CALL write_surfn_fa(yrec,il1,il2,il3,pfield,kresp,hcomment,ydir)
831 #endif
832  ENDIF
833  !
834 ENDIF
835 !
836 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX3',1,zhook_handle)
837 !
838 END SUBROUTINE write_surfx3
839 !
840 ! #############################################################
841  SUBROUTINE write_surfn0 ( HSELECT, HPROGRAM,HREC,KFIELD,KRESP,HCOMMENT)
842 ! #############################################################
843 !
844 !!**** *WRITEN0* - routine to write an integer
845 !
846 !
847 !
848 !
849 !
850 !
851 USE yomhook ,ONLY : lhook, dr_hook
852 USE parkind1 ,ONLY : jprb
853 !
854 USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
855 !
856 #ifdef SFX_OL
857 USE mode_write_surf_ol, ONLY: write_surf0_ol
858 #endif
859 #ifdef SFX_ASC
860 USE mode_write_surf_asc, ONLY: write_surf0_asc
861 #endif
862 #ifdef SFX_TXT
863 USE mode_write_surf_txt, ONLY: write_surf0_txt
864 #endif
865 #ifdef SFX_BIN
866 USE mode_write_surf_bin, ONLY: write_surf0_bin
867 #endif
868 #ifdef SFX_FA
869 USE mode_write_surf_fa, ONLY: write_surf0_fa
870 #endif
871 #ifdef SFX_LFI
872 USE mode_write_surf_lfi, ONLY: write_surf0_lfi
873 #endif
874 #ifdef SFX_NC
875 USE mode_write_surf_nc, ONLY: write_surf0_nc
876 #endif
877 #ifdef SFX_MNH
878 USE modi_write_surfn0_mnh
879 #endif
880 #ifdef WXIOS
881 USE modi_write_surf_xios
882 #endif
883 #ifdef SFX_ARO
884 USE modi_write_surfn0_aro
885 #endif
886 
887 !
888 USE modi_test_record_len
889 !
890 IMPLICIT NONE
891 !
892 #ifdef SFX_MPI
893 include "mpif.h"
894 #endif
895 !
896 !
897  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
898 !
899 !
900 !* 0.1 Declarations of arguments
901 !
902  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
903  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
904 INTEGER, INTENT(IN) :: KFIELD ! integer to be written
905 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
906  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
907 !
908 !* 0.2 Declarations of local variables
909 !
910  CHARACTER(LEN=16) :: YREC2
911  CHARACTER(LEN=12) :: YREC
912 LOGICAL :: GNOWRITE
913 REAL :: XTIME0
914 REAL(KIND=JPRB) :: ZHOOK_HANDLE
915 !
916 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',0,zhook_handle)
917 !
918 yrec = hrec
919 !
920  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
921 !
922 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',1,zhook_handle)
923 IF(gnowrite)RETURN
924 
925 !
926 IF (hprogram=='MESONH') THEN
927 #ifdef SFX_MNH
928  yrec2 = yrec
929  CALL write_surfn0_mnh(yrec2,kfield,kresp,hcomment)
930 #endif
931 ENDIF
932 !
933 IF (hprogram=='AROME ') THEN
934 #ifdef SFX_ARO
935  CALL write_surfn0_aro(yrec,kfield,kresp,hcomment)
936 #endif
937 ENDIF
938 !
939 IF (nrank==npio) THEN
940  !
941 #ifdef SFX_MPI
942  xtime0 = mpi_wtime()
943 #endif
944  !
945  IF (hprogram=='ASCII ') THEN
946 #ifdef SFX_ASC
947  CALL write_surf0_asc(yrec,kfield,kresp,hcomment)
948 #endif
949  ENDIF
950  !
951  IF (hprogram=='FA ') THEN
952 #ifdef SFX_FA
953  CALL write_surf0_fa(yrec,kfield,kresp,hcomment)
954 #endif
955  ENDIF
956  !
957  IF (hprogram=='OFFLIN') THEN
958 #ifdef SFX_OL
959  CALL write_surf0_ol(hselect,yrec,kfield,kresp,hcomment)
960 #endif
961  ENDIF
962  !
963  IF (hprogram=='TEXTE ') THEN
964 #ifdef SFX_TXT
965  CALL write_surf0_txt(yrec,kfield,kresp,hcomment)
966 #endif
967  ENDIF
968  !
969  IF (hprogram=='BINARY') THEN
970 #ifdef SFX_BIN
971  CALL write_surf0_bin(yrec,kfield,kresp,hcomment)
972 #endif
973  ENDIF
974  !
975  IF (hprogram=='LFI ') THEN
976 #ifdef SFX_LFI
977  CALL write_surf0_lfi(yrec,kfield,kresp,hcomment)
978 #endif
979  ENDIF
980  !
981  IF (hprogram=='NC ') THEN
982 #ifdef SFX_NC
983  CALL write_surf0_nc( hselect, yrec,kfield,kresp,hcomment)
984 #endif
985  ENDIF
986  !
987 #ifdef SFX_MPI
988  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
989 #endif
990  !
991 ENDIF
992 !
993 IF (trim(hprogram)=='XIOS') THEN
994 #ifdef WXIOS
995  CALL write_surf_xios(yrec, hcomment, kfield=kfield)
996 #endif
997 ENDIF
998 !
999 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',1,zhook_handle)
1000 !
1001 END SUBROUTINE write_surfn0
1002 
1003 ! #############################################################
1004  SUBROUTINE write_surfn1 ( HSELECT, HPROGRAM,HREC,KFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
1005 ! #############################################################
1006 !
1007 !!**** *WRITEN0* - routine to write an integer
1008 !
1009 USE modd_surfex_mpi, ONLY : wlog_mpi
1010 USE yomhook ,ONLY : lhook, dr_hook
1011 USE parkind1 ,ONLY : jprb
1012 !
1013 #ifdef SFX_OL
1014 USE mode_write_surf_ol, ONLY: write_surfx1n1_ol
1015 #endif
1016 #ifdef SFX_ASC
1017 USE mode_write_surf_asc, ONLY: write_surfn_asc
1018 #endif
1019 #ifdef SFX_TXT
1020 USE mode_write_surf_txt, ONLY: write_surfn_txt
1021 #endif
1022 #ifdef SFX_BIN
1023 USE mode_write_surf_bin, ONLY: write_surfn_bin
1024 #endif
1025 #ifdef SFX_FA
1026 USE mode_write_surf_fa, ONLY: write_surfn_fa
1027 #endif
1028 #ifdef SFX_LFI
1029 USE mode_write_surf_lfi, ONLY: write_surfn_lfi
1030 #endif
1031 #ifdef SFX_NC
1032 USE mode_write_surf_nc, ONLY: write_surfn_nc
1033 #endif
1034 #ifdef SFX_MNH
1035 USE modi_write_surfn1_mnh
1036 #endif
1037 #ifdef WXIOS
1038 USE modi_write_surf_xios
1039 #endif
1040 #ifdef SFX_ARO
1041 USE modi_write_surfn1_aro
1042 #endif
1043 !
1044 USE modi_test_record_len
1045 !
1046 IMPLICIT NONE
1047 !
1048 !
1049 !* 0.1 Declarations of arguments
1050 !
1051  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1052 !
1053  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1054 !
1055  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1056 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD ! integer to be written
1057 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1058  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1059  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
1060 ! ! 'H' : field with
1061 ! ! horizontal spatial dim.
1062 ! ! '-' : no horizontal dim.
1063  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM_DIM
1064 !* 0.2 Declarations of local variables
1065 !
1066  CHARACTER(LEN=16) :: YREC2
1067  CHARACTER(LEN=12) :: YREC
1068 INTEGER :: IL
1069  CHARACTER(LEN=1) :: YDIR
1070 LOGICAL :: GNOWRITE
1071 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1072 !
1073 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',0,zhook_handle)
1074 !
1075 yrec = hrec
1076 ydir = 'H'
1077 IF (PRESENT(hdir)) ydir = hdir
1078 il = SIZE(kfield)
1079 !
1080  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1081 !
1082 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',1,zhook_handle)
1083 IF(gnowrite)RETURN
1084 !
1085 IF (hprogram=='MESONH') THEN
1086 #ifdef SFX_MNH
1087  yrec2 = yrec
1088  CALL write_surfn1_mnh(yrec2,il,kfield,kresp,hcomment,ydir)
1089 #endif
1090 ENDIF
1091 !
1092 IF (hprogram=='AROME ') THEN
1093 #ifdef SFX_ARO
1094  CALL write_surfn1_aro(yrec,il,kfield,kresp,hcomment,ydir)
1095 #endif
1096 ENDIF
1097 !
1098 IF (hprogram=='OFFLIN') THEN
1099 #ifdef SFX_OL
1100  CALL write_surfx1n1_ol(hselect,yrec,kfield,kresp,hcomment,ydir)
1101 #endif
1102 ENDIF
1103 !
1104 IF (hprogram=='TEXTE ') THEN
1105 #ifdef SFX_TXT
1106  CALL write_surfn_txt(yrec,kfield,kresp,hcomment,ydir)
1107 #endif
1108 ENDIF
1109 !
1110 IF (hprogram=='BINARY') THEN
1111 #ifdef SFX_BIN
1112  CALL write_surfn_bin(yrec,kfield,kresp,hcomment,ydir)
1113 #endif
1114 ENDIF
1115 !
1116 IF (hprogram=='LFI ') THEN
1117 #ifdef SFX_LFI
1118  CALL write_surfn_lfi(yrec,kfield,kresp,hcomment,ydir)
1119 #endif
1120 ENDIF
1121 !
1122 IF (hprogram=='NC ') THEN
1123 #ifdef SFX_NC
1124  IF (PRESENT(hnam_dim)) THEN
1125  CALL write_surfn_nc( hselect, yrec,kfield,kresp,hcomment,ydir,hnam_dim)
1126  ELSE
1127  CALL write_surfn_nc( hselect, yrec,kfield,kresp,hcomment,ydir)
1128  ENDIF
1129 #endif
1130 ENDIF
1131 !
1132 IF (hprogram=='ASCII ') THEN
1133 #ifdef SFX_ASC
1134  CALL write_surfn_asc(yrec,kfield,kresp,hcomment,ydir)
1135 #endif
1136 ENDIF
1137 !
1138 IF (hprogram=='FA ') THEN
1139 #ifdef SFX_FA
1140  CALL write_surfn_fa(&
1141  yrec,il,kfield,kresp,hcomment,ydir)
1142 #endif
1143 ENDIF
1144 !
1145 IF (trim(hprogram)=='XIOS') THEN
1146 #ifdef WXIOS
1147  CALL write_surf_xios(yrec, hcomment, pfield1=REAL(kfield))
1148 #endif
1149 ENDIF
1150 !
1151 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',1,zhook_handle)
1152 !
1153 END SUBROUTINE write_surfn1
1154 !
1155 ! #############################################################
1156  SUBROUTINE write_surfc0 ( HSELECT, HPROGRAM,HREC,HFIELD,KRESP,HCOMMENT)
1157 ! #############################################################
1158 !
1159 !!**** *WRITEC0* - routine to write an integer
1160 !
1161 USE yomhook ,ONLY : lhook, dr_hook
1162 USE parkind1 ,ONLY : jprb
1163 !
1164 USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
1165 !
1166 #ifdef SFX_OL
1167 USE mode_write_surf_ol, ONLY: write_surf0_ol
1168 #endif
1169 #ifdef SFX_ASC
1170 USE mode_write_surf_asc, ONLY: write_surf0_asc
1171 #endif
1172 #ifdef SFX_TXT
1173 USE mode_write_surf_txt, ONLY: write_surf0_txt
1174 #endif
1175 #ifdef SFX_BIN
1176 USE mode_write_surf_bin, ONLY: write_surf0_bin
1177 #endif
1178 #ifdef SFX_FA
1179 USE mode_write_surf_fa, ONLY: write_surf0_fa
1180 #endif
1181 #ifdef SFX_LFI
1182 USE mode_write_surf_lfi, ONLY: write_surf0_lfi
1183 #endif
1184 #ifdef SFX_NC
1185 USE mode_write_surf_nc, ONLY: write_surf0_nc
1186 #endif
1187 #ifdef SFX_MNH
1188 USE modi_write_surfc0_mnh
1189 #endif
1190 #ifdef WXIOS
1191 USE modi_write_surf_xios
1192 #endif
1193 #ifdef SFX_ARO
1194 USE modi_write_surfc0_aro
1195 #endif
1196 
1197 !
1198 USE modi_test_record_len
1199 !
1200 IMPLICIT NONE
1201 !
1202 #ifdef SFX_MPI
1203 include "mpif.h"
1204 #endif
1205 !
1206 !
1207  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1208 !
1209 !
1210 !* 0.1 Declarations of arguments
1211 !
1212  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1213  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1214  CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! caracter to be written
1215 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1216  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1217 !
1218 !* 0.2 Declarations of local variables
1219 !
1220  CHARACTER(LEN=12) :: YREC
1221  CHARACTER(LEN=16) :: YREC2
1222  CHARACTER(LEN=40) :: YFIELD
1223 LOGICAL :: GNOWRITE
1224 REAL :: XTIME0
1225 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1226 !
1227 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',0,zhook_handle)
1228 !
1229 yrec = hrec
1230 yfield = " "
1231 yfield(1:len(hfield)) = hfield
1232 !
1233  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1234 !
1235 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',1,zhook_handle)
1236 IF(gnowrite)RETURN
1237 !
1238 IF (hprogram=='MESONH') THEN
1239 #ifdef SFX_MNH
1240  yrec2 = yrec
1241  CALL write_surfc0_mnh(yrec2,yfield,kresp,hcomment)
1242 #endif
1243 ENDIF
1244 !
1245 IF (hprogram=='AROME ') THEN
1246 #ifdef SFX_ARO
1247  CALL write_surfc0_aro(yrec,yfield,kresp,hcomment)
1248 #endif
1249 ENDIF
1250 !
1251 IF (nrank==npio) THEN
1252  !
1253 #ifdef SFX_MPI
1254  xtime0 = mpi_wtime()
1255 #endif
1256  !
1257  IF (hprogram=='ASCII ') THEN
1258 #ifdef SFX_ASC
1259  CALL write_surf0_asc(yrec,yfield,kresp,hcomment)
1260 #endif
1261  ENDIF
1262  !
1263  IF (hprogram=='FA ') THEN
1264 #ifdef SFX_FA
1265  CALL write_surf0_fa(yrec,yfield,kresp,hcomment)
1266 #endif
1267  ENDIF
1268  !
1269  IF (hprogram=='OFFLIN') THEN
1270 #ifdef SFX_OL
1271  CALL write_surf0_ol(hselect,yrec,yfield,kresp,hcomment)
1272 #endif
1273  ENDIF
1274  !
1275  IF (hprogram=='TEXTE ') THEN
1276 #ifdef SFX_TXT
1277  CALL write_surf0_txt(yrec,yfield,kresp,hcomment)
1278 #endif
1279  ENDIF
1280  !
1281  IF (hprogram=='BINARY') THEN
1282 #ifdef SFX_BIN
1283  CALL write_surf0_bin(yrec,yfield,kresp,hcomment)
1284 #endif
1285  ENDIF
1286  !
1287  IF (hprogram=='LFI ') THEN
1288 #ifdef SFX_LFI
1289  CALL write_surf0_lfi(yrec,yfield,kresp,hcomment)
1290 #endif
1291  ENDIF
1292  !
1293  IF (hprogram=='NC ') THEN
1294 #ifdef SFX_NC
1295  CALL write_surf0_nc( hselect, yrec,yfield,kresp,hcomment)
1296 #endif
1297  ENDIF
1298  !
1299 #ifdef SFX_MPI
1300  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
1301 #endif
1302  !
1303 ENDIF
1304 !
1305 IF (trim(hprogram)=='XIOS') THEN
1306 #ifdef WXIOS
1307  CALL write_surf_xios(yrec, hcomment, hfield=yfield)
1308 #endif
1309 ENDIF
1310 !
1311 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',1,zhook_handle)
1312 !
1313 END SUBROUTINE write_surfc0
1314 !
1315 ! #############################################################
1316  SUBROUTINE write_surfl0 ( HSELECT, HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT)
1317 ! #############################################################
1318 !
1319 !!**** *WRITEL0* - routine to write a logical
1320 !
1321 USE yomhook ,ONLY : lhook, dr_hook
1322 USE parkind1 ,ONLY : jprb
1323 !
1324 USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
1325 !
1326 #ifdef SFX_OL
1327 USE mode_write_surf_ol, ONLY: write_surf0_ol
1328 #endif
1329 #ifdef SFX_ASC
1330 USE mode_write_surf_asc, ONLY: write_surf0_asc
1331 #endif
1332 #ifdef SFX_TXT
1333 USE mode_write_surf_txt, ONLY: write_surf0_txt
1334 #endif
1335 #ifdef SFX_BIN
1336 USE mode_write_surf_bin, ONLY: write_surf0_bin
1337 #endif
1338 #ifdef SFX_FA
1339 USE mode_write_surf_fa, ONLY: write_surf0_fa
1340 #endif
1341 #ifdef SFX_LFI
1342 USE mode_write_surf_lfi, ONLY: write_surf0_lfi
1343 #endif
1344 #ifdef SFX_NC
1345 USE mode_write_surf_nc, ONLY: write_surf0_nc
1346 #endif
1347 #ifdef SFX_MNH
1348 USE modi_write_surfl0_mnh
1349 #endif
1350 #ifdef WXIOS
1351 USE modi_write_surf_xios
1352 #endif
1353 #ifdef SFX_ARO
1354 USE modi_write_surfl0_aro
1355 #endif
1356 
1357 !
1358 USE modi_test_record_len
1359 !
1360 IMPLICIT NONE
1361 !
1362 #ifdef SFX_MPI
1363 include "mpif.h"
1364 #endif
1365 !
1366 !
1367  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1368 !
1369 !
1370 !* 0.1 Declarations of arguments
1371 !
1372  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1373  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1374 LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
1375 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1376  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1377 !
1378 !* 0.2 Declarations of local variables
1379 !
1380  CHARACTER(LEN=12) :: YREC
1381  CHARACTER(LEN=16) :: YREC2
1382 LOGICAL :: GNOWRITE
1383 REAL :: XTIME0
1384 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1385 !
1386 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',0,zhook_handle)
1387 !
1388 yrec = hrec
1389 !
1390  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1391 !
1392 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',1,zhook_handle)
1393 IF(gnowrite)RETURN
1394 !
1395 IF (hprogram=='MESONH') THEN
1396 #ifdef SFX_MNH
1397  yrec2 = yrec
1398  CALL write_surfl0_mnh(yrec2,ofield,kresp,hcomment)
1399 #endif
1400 ENDIF
1401 !²
1402 IF (hprogram=='AROME ') THEN
1403 #ifdef SFX_ARO
1404  CALL write_surfl0_aro(yrec,ofield,kresp,hcomment)
1405 #endif
1406 ENDIF
1407 !
1408 IF (nrank==npio) THEN
1409  !
1410 #ifdef SFX_MPI
1411  xtime0 = mpi_wtime()
1412 #endif
1413  !
1414  IF (hprogram=='ASCII ') THEN
1415 #ifdef SFX_ASC
1416  CALL write_surf0_asc(yrec,ofield,kresp,hcomment)
1417 #endif
1418  ENDIF
1419  !
1420  IF (hprogram=='FA ') THEN
1421 #ifdef SFX_FA
1422  CALL write_surf0_fa(yrec,ofield,kresp,hcomment)
1423 #endif
1424  ENDIF
1425  !
1426  IF (hprogram=='OFFLIN') THEN
1427 #ifdef SFX_OL
1428  CALL write_surf0_ol(hselect,yrec,ofield,kresp,hcomment)
1429 #endif
1430  ENDIF
1431  !
1432  IF (hprogram=='TEXTE ') THEN
1433 #ifdef SFX_TXT
1434  CALL write_surf0_txt(yrec,ofield,kresp,hcomment)
1435 #endif
1436  ENDIF
1437  !
1438  IF (hprogram=='BINARY') THEN
1439 #ifdef SFX_BIN
1440  CALL write_surf0_bin(yrec,ofield,kresp,hcomment)
1441 #endif
1442  ENDIF
1443  !
1444  IF (hprogram=='LFI ') THEN
1445 #ifdef SFX_LFI
1446  CALL write_surf0_lfi(yrec,ofield,kresp,hcomment)
1447 #endif
1448  ENDIF
1449  !
1450  IF (hprogram=='NC ') THEN
1451 #ifdef SFX_NC
1452  CALL write_surf0_nc( hselect, yrec,ofield,kresp,hcomment)
1453 #endif
1454  ENDIF
1455  !
1456 #ifdef SFX_MPI
1457  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
1458 #endif
1459  !
1460 ENDIF
1461 !
1462 IF (trim(hprogram)=='XIOS') THEN
1463 #ifdef WXIOS
1464  !CALL WRITE_SURF_XIOS(YREC, HCOMMENT, OFIELD=OFIELD)
1465 #endif
1466 ENDIF
1467 !
1468 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',1,zhook_handle)
1469 !
1470 END SUBROUTINE write_surfl0
1471 
1472 ! #############################################################
1473  SUBROUTINE write_surfl1 ( HSELECT, HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT,HDIR)
1474 ! #############################################################
1475 !
1476 !!**** *WRITEL1* - routine to write a logical array
1477 !
1478 !
1479 !
1480 !
1481 !
1482 !
1483 USE modd_surfex_mpi, ONLY : wlog_mpi
1484 USE yomhook ,ONLY : lhook, dr_hook
1485 USE parkind1 ,ONLY : jprb
1486 !
1487 #ifdef SFX_OL
1488 USE mode_write_surf_ol, ONLY: write_surfl1x2_ol
1489 #endif
1490 #ifdef SFX_ASC
1491 USE mode_write_surf_asc, ONLY: write_surfn_asc
1492 #endif
1493 #ifdef SFX_TXT
1494 USE mode_write_surf_txt, ONLY: write_surfn_txt
1495 #endif
1496 #ifdef SFX_BIN
1497 USE mode_write_surf_bin, ONLY: write_surfn_bin
1498 #endif
1499 #ifdef SFX_FA
1500 USE mode_write_surf_fa, ONLY: write_surfn_fa
1501 #endif
1502 #ifdef SFX_LFI
1503 USE mode_write_surf_lfi, ONLY: write_surfn_lfi
1504 #endif
1505 #ifdef SFX_NC
1506 USE mode_write_surf_nc, ONLY: write_surfn_nc
1507 #endif
1508 #ifdef SFX_MNH
1509 USE modi_write_surfl1_mnh
1510 #endif
1511 #ifdef SFX_ARO
1512 USE modi_write_surfl1_aro
1513 #endif
1514 
1515 !
1516 USE modi_test_record_len
1517 !
1518 IMPLICIT NONE
1519 !
1520 !&
1521 !* 0.1 Declarations of arguments
1522 !
1523  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1524 !
1525  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1526 !
1527  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1528 LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field
1529 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1530  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1531  CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
1532 ! ! 'H' : field with
1533 ! ! horizontal spatial dim.
1534 ! ! '-' : no horizontal dim.
1535 !* 0.2 Declarations of local variables
1536 !
1537  CHARACTER(LEN=16) :: YREC2
1538  CHARACTER(LEN=12) :: YREC
1539 INTEGER :: IL
1540  CHARACTER(LEN=1) :: YDIR
1541 LOGICAL :: GNOWRITE
1542 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1543 !
1544 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',0,zhook_handle)
1545 !
1546 yrec = hrec
1547 ydir = 'H'
1548 IF (PRESENT(hdir)) ydir = hdir
1549 il = SIZE(ofield)
1550 !
1551  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1552 !
1553 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',1,zhook_handle)
1554 IF(gnowrite)RETURN
1555 !
1556 IF (hprogram=='MESONH') THEN
1557 #ifdef SFX_MNH
1558  yrec2 = yrec
1559  CALL write_surfl1_mnh(yrec2,il,ofield,kresp,hcomment,ydir)
1560 #endif
1561 ENDIF
1562 !
1563 IF (hprogram=='AROME ') THEN
1564 #ifdef SFX_ARO
1565  CALL write_surfl1_aro(yrec,il,ofield,kresp,hcomment,ydir)
1566 #endif
1567 ENDIF
1568 !
1569 IF (hprogram=='OFFLIN') THEN
1570 #ifdef SFX_OL
1571  CALL write_surfl1x2_ol(hselect,yrec,ofield,kresp,hcomment,ydir)
1572 #endif
1573 ENDIF
1574 !
1575 IF (hprogram=='TEXTE ') THEN
1576 #ifdef SFX_TXT
1577  CALL write_surfn_txt(yrec,ofield,kresp,hcomment,ydir)
1578 #endif
1579 ENDIF
1580 !
1581 IF (hprogram=='BINARY') THEN
1582 #ifdef SFX_BIN
1583  CALL write_surfn_bin(yrec,ofield,kresp,hcomment,ydir)
1584 #endif
1585 ENDIF
1586 !
1587 IF (hprogram=='LFI ') THEN
1588 #ifdef SFX_LFI
1589  CALL write_surfn_lfi(yrec,ofield,kresp,hcomment,ydir)
1590 #endif
1591 ENDIF
1592 !
1593 IF (hprogram=='NC ') THEN
1594 #ifdef SFX_NC
1595  CALL write_surfn_nc( hselect, yrec,ofield,kresp,hcomment,ydir)
1596 #endif
1597 ENDIF
1598 !
1599 IF (hprogram=='ASCII ') THEN
1600 #ifdef SFX_ASC
1601  CALL write_surfn_asc(yrec,ofield,kresp,hcomment,ydir)
1602 #endif
1603 ENDIF
1604 !
1605 IF (hprogram=='FA ') THEN
1606 #ifdef SFX_FA
1607  CALL write_surfn_fa(yrec,il,ofield,kresp,hcomment,ydir)
1608 #endif
1609 ENDIF
1610 !
1611 IF (trim(hprogram)=='XIOS') THEN
1612  !CALL ABOR1_SFX('WRITE_SURFL1 : cannot handle XIOS case')
1613 ENDIF
1614 !
1615 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',1,zhook_handle)
1616 !
1617 END SUBROUTINE write_surfl1
1618 !
1619 ! #############################################################
1620  SUBROUTINE write_surft0 ( HSELECT,HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
1621 ! #############################################################
1622 !
1623 !!**** *WRITET0* - routine to write a MESO-NH date_time scalar
1624 !
1625 USE modd_type_date_surf
1626 !
1627 USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
1628 !
1629 USE yomhook ,ONLY : lhook, dr_hook
1630 USE parkind1 ,ONLY : jprb
1631 !
1632 #ifdef SFX_OL
1633 USE mode_write_surf_ol, ONLY: write_surft_ol
1634 #endif
1635 #ifdef SFX_ASC
1636 USE mode_write_surf_asc, ONLY: write_surft_asc
1637 #endif
1638 #ifdef SFX_TXT
1639 USE mode_write_surf_txt, ONLY: write_surft_txt
1640 #endif
1641 #ifdef SFX_BIN
1642 USE mode_write_surf_bin, ONLY: write_surft_bin
1643 #endif
1644 #ifdef SFX_FA
1645 USE mode_write_surf_fa, ONLY: write_surft_fa
1646 #endif
1647 #ifdef SFX_LFI
1648 USE mode_write_surf_lfi, ONLY: write_surft_lfi
1649 #endif
1650 #ifdef SFX_NC
1651 USE mode_write_surf_nc, ONLY: write_surft_nc
1652 #endif
1653 #ifdef SFX_MNH
1654 USE modi_write_surft0_mnh
1655 #endif
1656 #ifdef SFX_ARO
1657 USE modi_write_surft0_aro
1658 #endif
1659 
1660 !
1661 USE modi_test_record_len
1662 !
1663 IMPLICIT NONE
1664 !
1665 #ifdef SFX_MPI
1666 include "mpif.h"
1667 #endif
1668 !
1669 !
1670  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1671 !
1672 !
1673 !* 0.1 Declarations of arguments
1674 !
1675  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1676  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1677 type(date_time), INTENT(IN) :: tfield ! array containing the data field
1678 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1679  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1680 !
1681 !* 0.2 Declarations of local variables
1682 !
1683  CHARACTER(LEN=16) :: YREC2
1684  CHARACTER(LEN=12) :: YREC
1685 REAL :: ZTIME
1686 REAL :: XTIME0
1687 INTEGER :: IDAY
1688 INTEGER :: IMONTH
1689 INTEGER :: IYEAR
1690 LOGICAL :: GNOWRITE
1691 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1692 !
1693 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',0,zhook_handle)
1694 !
1695 yrec = hrec
1696 !
1697 iyear = tfield%TDATE%YEAR
1698 imonth = tfield%TDATE%MONTH
1699 iday = tfield%TDATE%DAY
1700 ztime = tfield%TIME
1701 !
1702  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1703 !
1704 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',1,zhook_handle)
1705 IF(gnowrite)RETURN
1706 !
1707 IF (hprogram=='MESONH') THEN
1708 #ifdef SFX_MNH
1709  yrec2 = yrec
1710  CALL write_surft0_mnh(yrec2,iyear,imonth,iday,ztime,kresp,hcomment)
1711 #endif
1712 ENDIF
1713 !
1714 IF (hprogram=='AROME ') THEN
1715 #ifdef SFX_ARO
1716  CALL write_surft0_aro(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1717 #endif
1718 ENDIF
1719 !
1720 IF (nrank==npio) THEN
1721  !
1722 #ifdef SFX_MPI
1723  xtime0 = mpi_wtime()
1724 #endif
1725  !
1726  IF (hprogram=='ASCII ') THEN
1727 #ifdef SFX_ASC
1728  CALL write_surft_asc(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1729 #endif
1730  ENDIF
1731  !
1732  IF (hprogram=='FA ') THEN
1733 #ifdef SFX_FA
1734  CALL write_surft_fa(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1735 #endif
1736  ENDIF
1737  !
1738  IF (hprogram=='OFFLIN') THEN
1739 #ifdef SFX_OL
1740  CALL write_surft_ol(hselect,yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1741 #endif
1742  ENDIF
1743  !
1744  IF (hprogram=='TEXTE ') THEN
1745 #ifdef SFX_TXT
1746  CALL write_surft_txt(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1747 #endif
1748  ENDIF
1749  !
1750  IF (hprogram=='BINARY') THEN
1751 #ifdef SFX_BIN
1752  CALL write_surft_bin(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1753 #endif
1754  ENDIF
1755  !
1756  IF (hprogram=='LFI ') THEN
1757 #ifdef SFX_LFI
1758  CALL write_surft_lfi(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1759 #endif
1760  ENDIF
1761  !
1762  IF (hprogram=='NC ') THEN
1763 #ifdef SFX_NC
1764  CALL write_surft_nc( hselect, yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1765 #endif
1766  ENDIF
1767  !
1768 #ifdef SFX_MPI
1769  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
1770 #endif
1771  !
1772 ENDIF
1773 !
1774 IF (trim(hprogram)=='XIOS') THEN
1775  !CALL ABOR1_SFX('WRITE_SURFT0 : cannot handle XIOS case')
1776 ENDIF
1777 !
1778 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',1,zhook_handle)
1779 !
1780 END SUBROUTINE write_surft0
1781 !
1782 ! #############################################################
1783  SUBROUTINE write_surft1 ( HSELECT, HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
1784 ! #############################################################
1785 !
1786 !!**** *READT2* - routine to read a MESO-NH date_time array
1787 !
1788 USE modd_surfex_mpi, ONLY : wlog_mpi
1789 USE modd_type_date_surf
1790 !
1791 USE yomhook ,ONLY : lhook, dr_hook
1792 USE parkind1 ,ONLY : jprb
1793 !
1794 #ifdef SFX_ASC
1795 USE mode_write_surf_asc, ONLY: write_surft_asc
1796 #endif
1797 #ifdef SFX_LFI
1798 USE mode_write_surf_lfi, ONLY: write_surft_lfi
1799 #endif
1800 #ifdef SFX_NC
1801 USE mode_write_surf_nc, ONLY: write_surft_nc
1802 #endif
1803 #ifdef SFX_MNH
1804 USE modi_write_surft1_mnh
1805 #endif
1806 #ifdef SFX_ARO
1807 USE modi_write_surft1_aro
1808 #endif
1809 
1810 !
1811 USE modi_abor1_sfx
1812 !
1813 USE modi_test_record_len
1814 !
1815 IMPLICIT NONE
1816 !
1817 !
1818 !* 0.1 Declarations of arguments
1819 !
1820  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1821 !
1822  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1823 !
1824  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1825 type(date_time), DIMENSION(:), INTENT(IN) :: tfield ! array containing the data field
1826 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1827  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1828 !
1829 !* 0.2 Declarations of local variables
1830 !
1831  CHARACTER(LEN=16) :: YREC2
1832  CHARACTER(LEN=12) :: YREC
1833 INTEGER :: IL1
1834 REAL , DIMENSION(SIZE(TFIELD,1)) :: ZTIME
1835 INTEGER, DIMENSION(SIZE(TFIELD,1)) :: IDAY
1836 INTEGER, DIMENSION(SIZE(TFIELD,1)) :: IMONTH
1837 INTEGER, DIMENSION(SIZE(TFIELD,1)) :: IYEAR
1838 LOGICAL :: GNOWRITE
1839 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1840 !
1841 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',0,zhook_handle)
1842 !
1843 yrec = hrec
1844 il1 = SIZE(tfield,1)
1845 !
1846 iyear(:) = tfield(:)%TDATE%YEAR
1847 imonth(:) = tfield(:)%TDATE%MONTH
1848 iday(:) = tfield(:)%TDATE%DAY
1849 ztime(:) = tfield(:)%TIME
1850 !
1851  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1852 !
1853 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',1,zhook_handle)
1854 IF(gnowrite)RETURN
1855 !
1856 IF (hprogram=='MESONH') THEN
1857  !G .TANGUY 03/2009
1858  !CALL ABOR1_SFX('WRITE_SURFT1: NOT AVAILABLE FOR MESONH')
1859 #ifdef SFX_MNH
1860  yrec2 = yrec
1861  CALL write_surft1_mnh(yrec2,il1,iyear,imonth,iday,ztime,kresp,hcomment)
1862 #endif
1863 ENDIF
1864 !
1865 IF (hprogram=='AROME ') THEN
1866 #ifdef SFX_ARO
1867  CALL write_surft1_aro(yrec,il1,iyear,imonth,iday,ztime,kresp,hcomment)
1868 #endif
1869 ENDIF
1870 !
1871 !IF (HPROGRAM=='OFFLIN') THEN
1872 ! CALL ABOR1_SFX('WRITE_SURFT1: NOT AVAILABLE FOR OFFLIN')
1873 !ENDIF
1874 !
1875 !plm IF (HPROGRAM=='TEXTE ') THEN
1876 !plm CALL WRITE_SURFT1_TXT(YREC,IL1,IYEAR,IMONTH,IDAY,ZTIME,KRESP,HCOMMENT)
1877 !plm ENDIF
1878 !
1879 IF (hprogram=='LFI ') THEN
1880 #ifdef SFX_LFI
1881  CALL write_surft_lfi(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1882 #endif
1883 ENDIF
1884 !
1885 IF (hprogram=='NC ') THEN
1886 #ifdef SFX_NC
1887  CALL write_surft_nc( hselect, yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1888 #endif
1889 ENDIF
1890 !
1891 IF (hprogram=='ASCII ') THEN
1892 #ifdef SFX_ASC
1893  CALL write_surft_asc(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
1894 #endif
1895 ENDIF
1896 !
1897 IF (hprogram=='FA ') THEN
1898  CALL abor1_sfx('WRITE_SURFT1: NOT AVAILABLE FOR FA')
1899 ENDIF
1900 !
1901 IF (trim(hprogram)=='XIOS') THEN
1902  !CALL ABOR1_SFX('WRITE_SURFT1 : cannot handle XIOS case')
1903 ENDIF
1904 !
1905 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',1,zhook_handle)
1906 !
1907 END SUBROUTINE write_surft1
1908 !
1909 ! #############################################################
1910  SUBROUTINE write_surft2 ( HSELECT, HPROGRAM,HREC,TFIELD,KRESP,HCOMMENT)
1911 ! #############################################################
1912 !
1913 !!**** *WRITET2* - routine to write a MESO-NH date_time array
1914 !
1915 !
1916 !
1917 !
1918 !
1919 !
1920 USE modd_surfex_mpi, ONLY : wlog_mpi
1921 USE modd_type_date_surf
1922 !
1923 USE yomhook ,ONLY : lhook, dr_hook
1924 USE parkind1 ,ONLY : jprb
1925 !
1926 #ifdef SFX_ASC
1927 USE mode_write_surf_asc, ONLY: write_surft_asc
1928 #endif
1929 #ifdef SFX_TXT
1930 USE mode_write_surf_txt, ONLY: write_surft_txt
1931 #endif
1932 #ifdef SFX_BIN
1933 USE mode_write_surf_bin, ONLY: write_surft_bin
1934 #endif
1935 #ifdef SFX_FA
1936 USE mode_write_surf_fa, ONLY: write_surft_fa
1937 #endif
1938 #ifdef SFX_NC
1939 USE mode_write_surf_nc, ONLY: write_surft_nc
1940 #endif
1941 #ifdef SFX_LFI
1942 USE mode_write_surf_lfi, ONLY: write_surft_lfi
1943 #endif
1944 !
1945 USE modi_abor1_sfx
1946 !
1947 USE modi_test_record_len
1948 !
1949 IMPLICIT NONE
1950 !
1951 !* 0.1 Declarations of arguments
1952 !
1953  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
1954 !
1955  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
1956 !
1957  CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be written
1958 type(date_time), DIMENSION(:,:), INTENT(IN) :: tfield ! array containing the data field
1959 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
1960  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
1961 !
1962 !* 0.2 Declarations of local variables
1963 !
1964  CHARACTER(LEN=12) :: YREC
1965 INTEGER :: IL1, IL2
1966 REAL , DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: ZTIME
1967 INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: IDAY
1968 INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: IMONTH
1969 INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: IYEAR
1970 LOGICAL :: GNOWRITE
1971 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1972 !
1973 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',0,zhook_handle)
1974 !
1975 yrec = hrec
1976 il1 = SIZE(tfield,1)
1977 il2 = SIZE(tfield,2)
1978 !
1979 iyear(:,:) = tfield(:,:)%TDATE%YEAR
1980 imonth(:,:) = tfield(:,:)%TDATE%MONTH
1981 iday(:,:) = tfield(:,:)%TDATE%DAY
1982 ztime(:,:) = tfield(:,:)%TIME
1983 !
1984  CALL test_record_len(hprogram,yrec,hselect,gnowrite)
1985 !
1986 IF(gnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',1,zhook_handle)
1987 IF(gnowrite)RETURN
1988 !
1989 IF (hprogram=='MESONH') THEN
1990  CALL abor1_sfx('WRITE_SURFT2: NOT AVAILABLE FOR MESONH')
1991 ENDIF
1992 !
1993 IF (hprogram=='AROME ') THEN
1994  CALL abor1_sfx('WRITE_SURFT2: NOT AVAILABLE FOR AROME')
1995 ENDIF
1996 !
1997 !IF (HPROGRAM=='OFFLIN') THEN
1998 ! CALL ABOR1_SFX('WRITE_SURFT2: NOT AVAILABLE FOR OFFLIN')
1999 !ENDIF
2000 !
2001 IF (hprogram=='LFI ') THEN
2002 #ifdef SFX_LFI
2003  CALL write_surft_lfi(&
2004  yrec,iyear,imonth,iday,ztime,kresp,hcomment)
2005 #endif
2006 ENDIF
2007 !
2008 IF (hprogram=='TEXTE ') THEN
2009 #ifdef SFX_TXT
2010  CALL write_surft_txt(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
2011 #endif
2012 ENDIF
2013 !
2014 IF (hprogram=='BINARY') THEN
2015 #ifdef SFX_BIN
2016  CALL write_surft_bin(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
2017 #endif
2018 ENDIF
2019 !
2020 IF (hprogram=='ASCII ') THEN
2021 #ifdef SFX_ASC
2022  CALL write_surft_asc(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
2023 #endif
2024 ENDIF
2025 !
2026 IF (hprogram=='FA ') THEN
2027 #ifdef SFX_FA
2028  CALL write_surft_fa(yrec,il1,il2,iyear,imonth,iday,ztime,kresp,hcomment)
2029 #endif
2030 ENDIF
2031 !
2032 IF (hprogram=='NC ') THEN
2033 #ifdef SFX_NC
2034  CALL write_surft_nc( hselect, yrec,iyear,imonth,iday,ztime,kresp,hcomment)
2035 #endif
2036 ENDIF
2037 !
2038 IF (trim(hprogram)=='XIOS') THEN
2039  !CALL ABOR1_SFX('WRITE_SURFT2 : cannot handle XIOS case')
2040 ENDIF
2041 !
2042 IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',1,zhook_handle)
2043 !
2044 END SUBROUTINE write_surft2
mode_write_surf_asc::write_surft_asc
Definition: mode_write_surf_asc.F90:20
write_surfl0
subroutine write_surfl0(HSELECT, HPROGRAM, HREC, OFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:1317
trim
static const char * trim(const char *name, int *n)
Definition: drhook.c:2383
mode_write_surf_nc::write_surft_nc
Definition: mode_write_surf_nc.F90:21
mode_write_surf_bin
Definition: mode_write_surf_bin.F90:6
modd_surfex_mpi::npio
integer npio
Definition: modd_surfex_mpi.F90:60
write_surfx0
subroutine write_surfx0(HSELECT, HPROGRAM, HREC, PFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:202
modd_surfex_mpi::nrank
integer nrank
Definition: modd_surfex_mpi.F90:58
mode_write_surf_txt::write_surfn_txt
Definition: mode_write_surf_txt.F90:19
mode_write_surf_nc::write_surfn_nc
Definition: mode_write_surf_nc.F90:13
mode_write_surf_lfi::write_surf0_lfi
Definition: mode_write_surf_lfi.F90:11
mode_write_surf_lfi
Definition: mode_write_surf_lfi.F90:6
yomhook::dr_hook
Definition: yomhook.F90:20
write_surft0
subroutine write_surft0(HSELECT, HPROGRAM, HREC, TFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:1621
mode_write_surf_asc
Definition: mode_write_surf_asc.F90:5
mode_write_surf_bin::write_surfx_bin
Definition: mode_write_surf_bin.F90:14
mode_write_surf_txt::write_surft_txt
Definition: mode_write_surf_txt.F90:23
modd_surfex_mpi::xtime_npio_write
real xtime_npio_write
Definition: modd_surfex_mpi.F90:72
write_surf_xios
subroutine write_surf_xios(HREC, HCOMMENT, KFIELD, PFIELD, OFIELD, HFIELD, PFIELD1, PFIELD2, PFIELD3, HAXIS, HAXIS2)
Definition: write_surf_xios.F90:6
write_surfx3
subroutine write_surfx3(HSELECT, HPROGRAM, HREC, PFIELD, KRESP, HCOMMENT, HDIR, HNAM_DIM)
Definition: write_surf.F90:677
mode_write_surf_ol::write_surfx1n1_ol
Definition: mode_write_surf_ol.F90:19
mode_write_surf_asc::write_surf0_asc
Definition: mode_write_surf_asc.F90:7
mode_write_surf_ol::write_surf0_ol
Definition: mode_write_surf_ol.F90:10
mode_write_surf_ol::write_surfl1x2_ol
Definition: mode_write_surf_ol.F90:23
write_surft1
subroutine write_surft1(HSELECT, HPROGRAM, HREC, TFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:1784
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:7
mode_write_surf_nc
Definition: mode_write_surf_nc.F90:5
mode_write_surf_bin::write_surft_bin
Definition: mode_write_surf_bin.F90:22
mode_write_surf_ol
Definition: mode_write_surf_ol.F90:5
mode_write_surf_txt::write_surfx_txt
Definition: mode_write_surf_txt.F90:15
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
write_surfn0
subroutine write_surfn0(HSELECT, HPROGRAM, HREC, KFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:842
mode_write_surf_asc::write_surfn_asc
Definition: mode_write_surf_asc.F90:13
mode_write_surf_bin::write_surfn_bin
Definition: mode_write_surf_bin.F90:18
mode_write_surf_ol::write_surft_ol
Definition: mode_write_surf_ol.F90:28
test_record_len
subroutine test_record_len(HPROGRAM, HREC, HSELECT, ONOWRITE)
Definition: test_record_len.F90:7
write_surfn1
subroutine write_surfn1(HSELECT, HPROGRAM, HREC, KFIELD, KRESP, HCOMMENT, HDIR, HNAM_DIM)
Definition: write_surf.F90:1005
write_surft2
subroutine write_surft2(HSELECT, HPROGRAM, HREC, TFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:1911
mode_write_surf_ol::write_surf0_time_ol
Definition: mode_write_surf_ol.F90:16
mode_write_surf_txt
Definition: mode_write_surf_txt.F90:6
modd_type_date_surf::date_time
Definition: modd_type_date_surf.F90:46
mode_write_surf_fa::write_surf0_fa
Definition: mode_write_surf_fa.F90:7
modd_surfex_mpi
Definition: modd_surfex_mpi.F90:6
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
write_surfx1
subroutine write_surfx1(HSELECT, HPROGRAM, HREC, PFIELD, KRESP, HCOMMENT, HDIR, HNAM_DIM)
Definition: write_surf.F90:363
write_surfc0
subroutine write_surfc0(HSELECT, HPROGRAM, HREC, HFIELD, KRESP, HCOMMENT)
Definition: write_surf.F90:1157
mode_write_surf_bin::write_surf0_bin
Definition: mode_write_surf_bin.F90:8
modi_write_surf::write_surf
Definition: write_surf.F90:16
modi_write_surf
Definition: write_surf.F90:6
mode_write_surf_fa
Definition: mode_write_surf_fa.F90:5
mode_write_surf_lfi::write_surfn_lfi
Definition: mode_write_surf_lfi.F90:17
write_surfx2
subroutine write_surfx2(HSELECT, HPROGRAM, HREC, PFIELD, KRESP, HCOMMENT, HDIR, HNAM_DIM)
Definition: write_surf.F90:517
mode_write_surf_fa::write_surft_fa
Definition: mode_write_surf_fa.F90:20
mode_write_surf_lfi::write_surft_lfi
Definition: mode_write_surf_lfi.F90:24
mode_write_surf_nc::write_surf0_nc
Definition: mode_write_surf_nc.F90:7
modd_type_date_surf
Definition: modd_type_date_surf.F90:6
mode_write_surf_fa::write_surfn_fa
Definition: mode_write_surf_fa.F90:13
modd_surfex_mpi::wlog_mpi
subroutine wlog_mpi(HLOG, PLOG, KLOG, KLOG2, OLOG)
Definition: modd_surfex_mpi.F90:91
mode_write_surf_txt::write_surf0_txt
Definition: mode_write_surf_txt.F90:9
write_surfl1
subroutine write_surfl1(HSELECT, HPROGRAM, HREC, OFIELD, KRESP, HCOMMENT, HDIR)
Definition: write_surf.F90:1474
Generated on Tue Jan 16 2018 16:23:31 for SURFEX v8.1 by   doxygen 1.8.13