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