Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / mode_write_surf_asc.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 MODULE MODE_WRITE_SURF_ASC
6 !
7 INTERFACE WRITE_SURF0_ASC
8         MODULE PROCEDURE WRITE_SURFX0_ASC
9         MODULE PROCEDURE WRITE_SURFN0_ASC
10         MODULE PROCEDURE WRITE_SURFL0_ASC
11         MODULE PROCEDURE WRITE_SURFC0_ASC
12 END INTERFACE
13 INTERFACE WRITE_SURFN_ASC
14         MODULE PROCEDURE WRITE_SURFX1_ASC
15         MODULE PROCEDURE WRITE_SURFN1_ASC
16         MODULE PROCEDURE WRITE_SURFL1_ASC
17         MODULE PROCEDURE WRITE_SURFX2_ASC
18 END INTERFACE
19 INTERFACE WRITE_SURFT_ASC
20         MODULE PROCEDURE WRITE_SURFT0_ASC
21         MODULE PROCEDURE WRITE_SURFT1_ASC
22         MODULE PROCEDURE WRITE_SURFT2_ASC
23 END INTERFACE
24 !
25 CONTAINS
26 !
27 !     #############################################################
28       SUBROUTINE WRITE_SURFX0_ASC(HREC,PFIELD,KRESP,HCOMMENT)
29 !     #############################################################
30 !
31 !!****  * - routine to write a real scalar
32 !
33 USE MODD_SURFEX_OMP, ONLY : LWORK0
34 !
35 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
36 !
37 USE MODI_IO_BUFF_n
38 USE MODI_ERROR_WRITE_SURF_ASC
39 !
40 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
41 USE PARKIND1  ,ONLY : JPRB
42 !
43 IMPLICIT NONE
44 !
45 !*      0.1   Declarations of arguments
46 !
47  CHARACTER(LEN=LEN_HREC),  INTENT(IN) :: HREC     ! name of the article to be read
48 REAL,               INTENT(IN) :: PFIELD   ! the real scalar to be read
49 INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
50  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
51 !
52 !*      0.2   Declarations of local variables
53 !
54 REAL(KIND=JPRB) :: ZHOOK_HANDLE
55 !
56 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',0,ZHOOK_HANDLE)
57 !
58 KRESP=0
59 !
60  CALL IO_BUFF_n(HREC,'W',LWORK0)
61 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
62 IF (LWORK0) RETURN
63 !
64 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
65 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
66 WRITE(NUNIT,FMT=*,ERR=100) PFIELD
67 !
68 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
69 RETURN
70 !
71 100 CONTINUE
72  CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
73 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
74 !
75 END SUBROUTINE WRITE_SURFX0_ASC
76 !
77 !     #############################################################
78       SUBROUTINE WRITE_SURFN0_ASC(HREC,KFIELD,KRESP,HCOMMENT)
79 !     #############################################################
80 !
81 !!****  * - routine to write an integer
82 !
83 USE MODD_SURFEX_OMP, ONLY : LWORK0
84 !
85 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, NMASK, CMASK
86 !
87 USE MODI_IO_BUFF_n
88 USE MODI_ERROR_WRITE_SURF_ASC
89 !
90 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
91 USE PARKIND1  ,ONLY : JPRB
92 !
93 IMPLICIT NONE
94 !
95 !*      0.1   Declarations of arguments
96 !
97  CHARACTER(LEN=LEN_HREC),  INTENT(IN) :: HREC     ! name of the article to be read
98 INTEGER,            INTENT(IN) :: KFIELD   ! the integer to be read
99 INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
100  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
101 !
102 !*      0.2   Declarations of local variables
103 !
104 REAL(KIND=JPRB) :: ZHOOK_HANDLE
105 !
106 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',0,ZHOOK_HANDLE)
107 !
108 KRESP=0
109 !
110  CALL IO_BUFF_n(HREC,'W',LWORK0)
111 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE)
112 IF (LWORK0) RETURN
113 !
114 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
115 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
116 WRITE(NUNIT,FMT=*,ERR=100) KFIELD
117 !
118 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE)
119 RETURN
120 !
121 100 CONTINUE
122  CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
123 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE)
124 !
125 END SUBROUTINE WRITE_SURFN0_ASC
126 !
127 !     #############################################################
128       SUBROUTINE WRITE_SURFL0_ASC(HREC,OFIELD,KRESP,HCOMMENT)
129 !     #############################################################
130 !
131 !!****  * - routine to write a logical
132 !
133 USE MODD_SURFEX_OMP, ONLY : LWORK0
134 !
135 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
136 !
137 USE MODI_IO_BUFF_n
138 USE MODI_ERROR_WRITE_SURF_ASC
139 !
140 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
141 USE PARKIND1  ,ONLY : JPRB
142 !
143 IMPLICIT NONE
144 !
145 !*      0.1   Declarations of arguments
146 !
147  CHARACTER(LEN=LEN_HREC),  INTENT(IN) :: HREC     ! name of the article to be read
148 LOGICAL,            INTENT(IN) :: OFIELD   ! array containing the data field
149 INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
150  CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
151 !
152 !*      0.2   Declarations of local variables
153 !
154 REAL(KIND=JPRB) :: ZHOOK_HANDLE
155 !
156 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',0,ZHOOK_HANDLE)
157 !
158 KRESP=0
159 !
160  CALL IO_BUFF_n(HREC,'W',LWORK0)
161 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE)
162 IF (LWORK0) RETURN
163 !
164 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
165 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
166 WRITE(NUNIT,FMT=*,ERR=100) OFIELD
167 !
168 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE)
169 RETURN
170 !
171 100 CONTINUE
172  CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
173 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE)
174 !
175 END SUBROUTINE WRITE_SURFL0_ASC
176 !
177 !     #############################################################
178       SUBROUTINE WRITE_SURFC0_ASC(HREC,HFIELD,KRESP,HCOMMENT)
179 !     #############################################################
180 !
181 !!****  * - routine to write a character
182 !
183 USE MODD_SURFEX_OMP, ONLY : LWORK0
184 !
185 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
186 !
187 USE MODI_IO_BUFF_n
188 USE MODI_ERROR_WRITE_SURF_ASC
189 !
190 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
191 USE PARKIND1  ,ONLY : JPRB
192 !
193 IMPLICIT NONE
194 !
195 !*      0.1   Declarations of arguments
196 !
197  CHARACTER(LEN=LEN_HREC),  INTENT(IN)  :: HREC      ! name of the article to be read
198  CHARACTER(LEN=40),  INTENT(IN)  :: HFIELD    ! the integer to be read
199 INTEGER,            INTENT(OUT) :: KRESP     ! KRESP  : return-code if a problem appears
200  CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT  ! comment string
201 !
202 !*      0.2   Declarations of local variables
203 !
204 REAL(KIND=JPRB) :: ZHOOK_HANDLE
205 !
206 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',0,ZHOOK_HANDLE)
207 !
208 KRESP=0
209 !
210  CALL IO_BUFF_n(HREC,'W',LWORK0)
211 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE)
212 IF (LWORK0) RETURN
213 !
214 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
215 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
216 WRITE(NUNIT,FMT='(A40)',ERR=100) HFIELD
217 !
218 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE)
219 RETURN
220 !
221 100 CONTINUE
222  CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
223 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE)
224 !
225 END SUBROUTINE WRITE_SURFC0_ASC
226 !
227 !     #############################################################
228       SUBROUTINE WRITE_SURFX1_ASC(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
229 !     #############################################################
230 !
231 !!****  * - routine to fill a write 1D array for the externalised surface 
232 !
233 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
234 !
235 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB, NBLOCK
236 !
237 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, NMASK, NFULL, CMASK
238 !
239 USE MODI_IO_BUFF_n
240 USE MODI_ERROR_WRITE_SURF_ASC
241 USE MODI_GATHER_AND_WRITE_MPI
242 !
243 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
244 USE PARKIND1  ,ONLY : JPRB
245 !
246 IMPLICIT NONE
247 !
248 #ifndef NOMPI
249 INCLUDE "mpif.h"
250 #endif
251 !
252 !*      0.1   Declarations of arguments
253 !
254  CHARACTER(LEN=LEN_HREC),   INTENT(IN) :: HREC     ! name of the article to be read
255 REAL, DIMENSION(:),  INTENT(IN) :: PFIELD   ! array containing the data field
256 INTEGER,             INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
257  CHARACTER(LEN=100),  INTENT(IN) :: HCOMMENT ! comment string
258  CHARACTER(LEN=1),    INTENT(IN) :: HDIR     ! type of field :
259                                             ! 'H' : field with
260                                             !       horizontal spatial dim.
261                                             ! '-' : no horizontal dim.
262 !*      0.2   Declarations of local variables
263 !
264 INTEGER :: ISIZE, J
265 REAL   :: XTIME0
266 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK   ! work array read in the file
267 REAL(KIND=JPRB) :: ZHOOK_HANDLE
268 !
269 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',0,ZHOOK_HANDLE)
270 !
271 !$OMP SINGLE
272 !
273 NWORKB=0
274
275  CALL IO_BUFF_n(HREC,'W',LWORK0)
276 !
277 !$OMP END SINGLE
278 !
279 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE)
280 IF (LWORK0) RETURN
281 !
282 IF (HDIR=='-') THEN
283   ISIZE = SIZE(PFIELD)
284   ZWORK(1:ISIZE) = PFIELD
285 ELSE
286   ISIZE = SIZE(ZWORK)
287   CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
288 ENDIF
289 !
290 IF (NRANK==NPIO) THEN
291   !
292 #ifndef NOMPI  
293   XTIME0 = MPI_WTIME()
294 #endif  
295   !
296 !$OMP SINGLE
297   !
298   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
299   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
300   WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=NWORKB) ZWORK(1:ISIZE)
301   !
302 !$OMP END SINGLE
303   !  
304   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
305   !
306 #ifndef NOMPI
307   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
308 #endif
309   !
310 ENDIF
311 !
312 KRESP = NWORKB
313 !
314 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE)
315 !
316 END SUBROUTINE WRITE_SURFX1_ASC
317 !
318 !     #############################################################
319       SUBROUTINE WRITE_SURFX2_ASC(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
320 !     #############################################################
321 !
322 !!****  * - routine to fill a write 2D array for the externalised surface 
323 !
324 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
325 !
326 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
327 !
328 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, NMASK, NFULL, CMASK
329 !
330 USE MODI_IO_BUFF_n
331 USE MODI_ERROR_WRITE_SURF_ASC
332 USE MODI_GATHER_AND_WRITE_MPI
333 !
334 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
335 USE PARKIND1  ,ONLY : JPRB
336 !
337 IMPLICIT NONE
338 !
339 #ifndef NOMPI
340 INCLUDE "mpif.h"
341 #endif
342 !
343 !*      0.1   Declarations of arguments
344 !
345  CHARACTER(LEN=LEN_HREC),        INTENT(IN) :: HREC     ! name of the article to be read
346 REAL, DIMENSION(:,:),     INTENT(IN) :: PFIELD   ! array containing the data field
347 INTEGER,                  INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
348  CHARACTER(LEN=100),       INTENT(IN) :: HCOMMENT ! comment string
349  CHARACTER(LEN=1),         INTENT(IN) :: HDIR     ! type of field :
350                                                  ! 'H' : field with
351                                                  !       horizontal spatial dim.
352                                                  ! '-' : no horizontal dim.
353 !*      0.2   Declarations of local variables
354
355 INTEGER :: ISIZE
356 REAL   :: XTIME0
357 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK   ! work array read in the file
358 REAL(KIND=JPRB) :: ZHOOK_HANDLE
359 !
360 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',0,ZHOOK_HANDLE)
361 !
362 !$OMP SINGLE
363 !
364 NWORKB=0
365 !
366  CALL IO_BUFF_n(HREC,'W',LWORK0)
367 !
368 !$OMP END SINGLE
369 !
370 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE)
371 IF (LWORK0) RETURN
372 !
373 IF (HDIR=='-') THEN
374   ISIZE = SIZE(PFIELD,1)
375   ZWORK(1:ISIZE,:) = PFIELD(:,:)
376 ELSE
377   ISIZE = SIZE(ZWORK,1)
378   CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
379 ENDIF
380 !
381 IF (NRANK==NPIO) THEN
382   !
383 #ifndef NOMPI  
384   XTIME0 = MPI_WTIME()
385 #endif  
386   !
387 !$OMP SINGLE
388   !    
389   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
390   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
391   WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=NWORKB) ZWORK(1:ISIZE,:)
392   !
393 !$OMP END SINGLE
394   !  
395   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
396   !
397 #ifndef NOMPI
398   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
399 #endif  
400   !  
401 ENDIF
402 !
403 KRESP = NWORKB
404 !
405 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE)
406 !
407 END SUBROUTINE WRITE_SURFX2_ASC
408 !
409 !     #############################################################
410       SUBROUTINE WRITE_SURFN1_ASC(HREC,KFIELD,KRESP,HCOMMENT,HDIR)
411 !     #############################################################
412 !
413 !!****  * - routine to write an integer array
414 !
415 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
416 !
417 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
418 !
419 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, NMASK, NFULL, CMASK
420 !
421 USE MODI_IO_BUFF_n
422 USE MODI_ERROR_WRITE_SURF_ASC
423 USE MODI_GATHER_AND_WRITE_MPI
424 !
425 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
426 USE PARKIND1  ,ONLY : JPRB
427 !
428 IMPLICIT NONE
429 !
430 #ifndef NOMPI
431 INCLUDE "mpif.h"
432 #endif
433 !
434 !*      0.1   Declarations of arguments
435 !
436  CHARACTER(LEN=LEN_HREC),      INTENT(IN) :: HREC     ! name of the article to be read
437 INTEGER, DIMENSION(:),  INTENT(IN) :: KFIELD   ! the integer to be read
438 INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
439  CHARACTER(LEN=100),     INTENT(IN) :: HCOMMENT ! comment string
440  CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
441                                                ! 'H' : field with
442                                                !       horizontal spatial dim.
443                                                ! '-' : no horizontal dim.
444 !*      0.2   Declarations of local variables
445 !
446 INTEGER :: ISIZE
447 INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK  ! work array read in the file
448 REAL   :: XTIME0
449 REAL(KIND=JPRB) :: ZHOOK_HANDLE
450 !
451 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',0,ZHOOK_HANDLE)
452 !
453 !$OMP SINGLE
454 !
455 NWORKB = 0
456 !
457  CALL IO_BUFF_n(HREC,'W',LWORK0)
458 !
459 !$OMP END SINGLE
460 !
461 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE)
462 IF (LWORK0) RETURN
463 !
464 IF (HDIR=='-' .OR. HREC=='-') THEN
465   ISIZE = SIZE(KFIELD)
466   IWORK(1:ISIZE) = KFIELD
467 ELSE
468   ISIZE = SIZE(IWORK)
469   CALL GATHER_AND_WRITE_MPI(KFIELD,IWORK,NMASK)
470 ENDIF
471 !
472 IF (NRANK==NPIO) THEN
473   !
474 #ifndef NOMPI  
475   XTIME0 = MPI_WTIME()
476 #endif
477   !  
478 !$OMP SINGLE
479   !   
480   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
481   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
482   WRITE(NUNIT,FMT='(100I8)',IOSTAT=NWORKB) IWORK(1:ISIZE)
483   !
484 !$OMP END SINGLE
485   !  
486   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
487   !
488 #ifndef NOMPI  
489   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
490 #endif
491   !  
492 ENDIF
493 !
494 KRESP = NWORKB
495 !
496 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE)
497 !
498 END SUBROUTINE WRITE_SURFN1_ASC
499 !
500 !     #############################################################
501       SUBROUTINE WRITE_SURFL1_ASC(HREC,OFIELD,KRESP,HCOMMENT,HDIR)
502 !     #############################################################
503 !
504 !!****  * - routine to write a logical array
505 !
506 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
507 !
508 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
509 !
510 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
511 !
512 USE MODI_IO_BUFF_n
513 USE MODI_ERROR_WRITE_SURF_ASC
514 !
515 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
516 USE PARKIND1  ,ONLY : JPRB
517 !
518 IMPLICIT NONE
519 !
520 #ifndef NOMPI
521 INCLUDE "mpif.h"
522 #endif
523 !
524 !*      0.1   Declarations of arguments
525 !
526  CHARACTER(LEN=LEN_HREC),      INTENT(IN) :: HREC     ! name of the article to be read
527 LOGICAL, DIMENSION(:),  INTENT(IN) :: OFIELD   ! array containing the data field
528 INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
529  CHARACTER(LEN=100),     INTENT(IN) :: HCOMMENT ! comment string
530  CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
531                                                ! 'H' : field with
532                                                !       horizontal spatial dim.
533                                                ! '-' : no horizontal dim.
534 !*      0.2   Declarations of local variables
535 !
536 REAL   :: XTIME0
537 REAL(KIND=JPRB) :: ZHOOK_HANDLE
538 !
539 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',0,ZHOOK_HANDLE)
540 !
541 !$OMP SINGLE
542 !
543 NWORKB = 0
544 !
545  CALL IO_BUFF_n(HREC,'W',LWORK0)
546 !
547 !$OMP END SINGLE
548 !
549 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE)
550 IF (LWORK0) RETURN
551 !
552 IF (NRANK==NPIO) THEN
553   !
554 #ifndef NOMPI  
555   XTIME0 = MPI_WTIME()
556 #endif  
557   !
558 !$OMP SINGLE
559   !  
560   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
561   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
562   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) OFIELD
563   !
564 !$OMP END SINGLE
565   !
566   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
567   !  
568 #ifndef NOMPI  
569   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
570 #endif  
571   !
572 ENDIF
573 !
574 KRESP = NWORKB
575 !
576 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE)
577 !
578 END SUBROUTINE WRITE_SURFL1_ASC
579 !
580 !     #############################################################
581       SUBROUTINE WRITE_SURFT0_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
582 !     #############################################################
583 !
584 !!****  * - routine to write a date
585 !
586 USE MODD_SURFEX_OMP, ONLY : LWORK0
587 !
588 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
589 !
590 USE MODI_IO_BUFF_n
591 USE MODI_ERROR_WRITE_SURF_ASC
592 !
593 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
594 USE PARKIND1  ,ONLY : JPRB
595 !
596 IMPLICIT NONE
597 !
598 !*      0.1   Declarations of arguments
599 !
600  CHARACTER(LEN=LEN_HREC),  INTENT(IN)  :: HREC     ! name of the article to be read
601 INTEGER,            INTENT(IN)  :: KYEAR    ! year
602 INTEGER,            INTENT(IN)  :: KMONTH   ! month
603 INTEGER,            INTENT(IN)  :: KDAY     ! day
604 REAL,               INTENT(IN)  :: PTIME    ! time
605 INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
606  CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT ! comment string
607
608 !*      0.2   Declarations of local variables
609 !
610 INTEGER, DIMENSION(3) :: ITDATE
611 REAL(KIND=JPRB)       :: ZHOOK_HANDLE
612 !
613 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',0,ZHOOK_HANDLE)
614 !
615 KRESP=0
616 !
617  CALL IO_BUFF_n(HREC,'W',LWORK0)
618 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE)
619 IF (LWORK0) RETURN
620 !
621 ITDATE(1) = KYEAR
622 ITDATE(2) = KMONTH
623 ITDATE(3) = KDAY
624 !
625 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
626 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
627 WRITE(NUNIT,FMT=*,ERR=100) ITDATE(:)
628 !
629 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
630 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
631 WRITE(NUNIT,FMT=*,ERR=100) PTIME
632 !
633 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE)
634 RETURN
635 !
636 100 CONTINUE
637  CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
638 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE)
639 !
640 END SUBROUTINE WRITE_SURFT0_ASC
641 !
642 !     #############################################################
643       SUBROUTINE WRITE_SURFT1_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
644 !     #############################################################
645 !
646 !!****  * - routine to write a date
647 !
648 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
649 !
650 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
651 !
652 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
653 !
654 USE MODI_IO_BUFF_n
655 USE MODI_ERROR_WRITE_SURF_ASC
656 !
657 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
658 USE PARKIND1  ,ONLY : JPRB
659 !
660 IMPLICIT NONE
661 !
662 #ifndef NOMPI
663 INCLUDE "mpif.h"
664 #endif
665 !
666 !*      0.1   Declarations of arguments
667 !
668  CHARACTER(LEN=LEN_HREC),     INTENT(IN) :: HREC     ! name of the article to be read
669 INTEGER, DIMENSION(:), INTENT(IN) :: KYEAR    ! year
670 INTEGER, DIMENSION(:), INTENT(IN) :: KMONTH   ! month
671 INTEGER, DIMENSION(:), INTENT(IN) :: KDAY     ! day
672 REAL,    DIMENSION(:), INTENT(IN) :: PTIME    ! time
673 INTEGER,               INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
674  CHARACTER(LEN=100),    INTENT(IN) :: HCOMMENT ! comment string
675
676 !*      0.2   Declarations of local variables
677 !
678 INTEGER, DIMENSION(3,SIZE(KYEAR)) :: ITDATE
679 REAL   :: XTIME0
680 REAL(KIND=JPRB) :: ZHOOK_HANDLE
681 !
682 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',0,ZHOOK_HANDLE)
683 !
684 !$OMP SINGLE
685 !
686 NWORKB = 0
687 !
688  CALL IO_BUFF_n(HREC,'W',LWORK0)
689 !
690 !$OMP END SINGLE
691 !
692 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE)
693 IF (LWORK0) RETURN
694 !
695 IF (NRANK==NPIO) THEN
696   !
697 #ifndef NOMPI  
698   XTIME0 = MPI_WTIME()
699 #endif  
700   !
701 !$OMP SINGLE
702   !
703   ITDATE(1,:) = KYEAR  (:)
704   ITDATE(2,:) = KMONTH (:)
705   ITDATE(3,:) = KDAY   (:)
706   !
707   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
708   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
709   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) ITDATE(:,:)
710   !
711   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
712   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
713   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) PTIME
714   !
715 !$OMP END SINGLE
716   !   
717   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
718   !
719 #ifndef NOMPI  
720   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
721 #endif  
722   !
723 ENDIF
724 !
725 KRESP = NWORKB
726 !
727 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE)
728 !
729 END SUBROUTINE WRITE_SURFT1_ASC
730 !
731 !     #############################################################
732       SUBROUTINE WRITE_SURFT2_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
733 !     #############################################################
734 !
735 !!****  * - routine to write a date
736 !
737 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
738 !
739 USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
740 !
741 USE MODD_IO_SURF_ASC,        ONLY : NUNIT, CMASK
742 !
743 USE MODI_IO_BUFF_n
744 USE MODI_ERROR_WRITE_SURF_ASC
745 !
746 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
747 USE PARKIND1  ,ONLY : JPRB
748 !
749 IMPLICIT NONE
750 !
751 #ifndef NOMPI
752 INCLUDE "mpif.h"
753 #endif
754 !
755 !*      0.1   Declarations of arguments
756 !
757  CHARACTER(LEN=LEN_HREC),       INTENT(IN)  :: HREC     ! name of the article to be read
758 INTEGER, DIMENSION(:,:), INTENT(IN)  :: KYEAR    ! year
759 INTEGER, DIMENSION(:,:), INTENT(IN)  :: KMONTH   ! month
760 INTEGER, DIMENSION(:,:), INTENT(IN)  :: KDAY     ! day
761 REAL,    DIMENSION(:,:), INTENT(IN)  :: PTIME    ! time
762 INTEGER,                 INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
763  CHARACTER(LEN=100),      INTENT(IN)  :: HCOMMENT ! comment string
764
765 !*      0.2   Declarations of local variables
766 !
767 INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
768 REAL   :: XTIME0
769 REAL(KIND=JPRB) :: ZHOOK_HANDLE
770 !
771 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',0,ZHOOK_HANDLE)
772 !
773 !$OMP SINGLE
774 NWORKB = 0
775 !
776 CALL IO_BUFF_n(HREC,'W',LWORK0) 
777 !$OMP END SINGLE
778 !
779 IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE)
780 IF (LWORK0) RETURN
781 !
782 IF (NRANK==NPIO) THEN
783   !
784 #ifndef NOMPI  
785   XTIME0 = MPI_WTIME()
786 #endif  
787   !
788 !$OMP SINGLE
789   !    
790   ITDATE(1,:,:) = KYEAR  (:,:)
791   ITDATE(2,:,:) = KMONTH (:,:)
792   ITDATE(3,:,:) = KDAY   (:,:)
793   !
794   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
795   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
796   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) ITDATE(:,:,:)
797   !
798   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
799   WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
800   WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) PTIME
801   !
802 !$OMP END SINGLE  
803   !
804   IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
805   !
806 #ifndef NOMPI  
807   XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
808 #endif  
809   !
810 ENDIF
811 !
812 KRESP = NWORKB
813 !
814 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE)
815 !
816 END SUBROUTINE WRITE_SURFT2_ASC
817 !
818 END MODULE MODE_WRITE_SURF_ASC