Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_misc_flaken.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 !     #########
6       SUBROUTINE WRITE_DIAG_MISC_FLAKE_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_MISC_FLAKE* - writes the FLAKE diagnostic fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    REFERENCE
19 !!    ---------
20 !!
21 !!
22 !!    AUTHOR
23 !!    ------
24 !!      P. Le Moigne   *Meteo France*   
25 !!
26 !!    MODIFICATIONS
27 !!    -------------
28 !!      Original    10/2004
29 !-------------------------------------------------------------------------------
30 !
31 !*       0.    DECLARATIONS
32 !              ------------
33 USE MODI_INIT_IO_SURF_n
34 USE MODI_WRITE_SURF
35 USE MODI_END_IO_SURF_n
36 !USE MODD_FLAKE_n
37 USE MODD_DIAG_MISC_FLAKE_n,ONLY : LWATER_PROFILE, XZW_PROFILE, XTW_PROFILE
38 !
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 !
48  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
49 !
50 !*       0.2   Declarations of local variables
51 !              -------------------------------
52 !
53 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
54  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
55  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
56 INTEGER           :: IZ
57 REAL(KIND=JPRB) :: ZHOOK_HANDLE
58 !
59 !-------------------------------------------------------------------------------
60 !
61 !         Initialisation for IO
62 !
63 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',0,ZHOOK_HANDLE)
64  CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE   ','WRITE')
65 !
66 !-------------------------------------------------------------------------------
67 !
68 IF (LWATER_PROFILE) THEN
69 !
70 !*       Miscellaneous fields :
71 !        ----------------------
72 DO IZ=1,SIZE(XZW_PROFILE)
73    WRITE(YRECFM,'(F5.1)') XZW_PROFILE(IZ)
74    YRECFM='TW_'//TRIM(ADJUSTL(YRECFM))
75    YCOMMENT='X_Y_'//YRECFM//' (K)'
76 !
77    CALL WRITE_SURF(HPROGRAM,YRECFM,XTW_PROFILE(IZ,:),IRESP,HCOMMENT=YCOMMENT)
78 END DO
79 !
80 !
81 END IF
82 !
83 !-------------------------------------------------------------------------------
84 !
85 !         End of IO
86 !
87  CALL END_IO_SURF_n(HPROGRAM)
88 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',1,ZHOOK_HANDLE)
89 !
90 END SUBROUTINE WRITE_DIAG_MISC_FLAKE_n