Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_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 WRITESURF_FLAKE_n(HPROGRAM)
7 !     ########################################
8 !
9 !!****  *WRITESURF_FLAKE_n* - writes FLAKE fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    01/2003 
35 !-------------------------------------------------------------------------------
36 !
37 !*       0.    DECLARATIONS
38 !              ------------
39 !
40 USE MODD_FLAKE_n,  ONLY : XTS, TTIME    , &
41                             XT_SNOW       , &
42                             XT_ICE        , &
43                             XT_MNW        , &
44                             XT_WML        , &
45                             XT_BOT        , &
46                             XT_B1         , &
47                             XCT           , &
48                             XH_SNOW       , &
49                             XH_ICE        , &
50                             XH_ML         , &
51                             XH_B1         , &
52                             XZ0           , &
53                             XUSTAR  
54 !
55 USE MODI_WRITE_SURF
56 !
57 !
58 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
59 USE PARKIND1  ,ONLY : JPRB
60 !
61 IMPLICIT NONE
62 !
63 !*       0.1   Declarations of arguments
64 !              -------------------------
65 !
66  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
67
68 !
69 !*       0.2   Declarations of local variables
70 !              -------------------------------
71 !
72 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
73  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
74  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
75 REAL(KIND=JPRB) :: ZHOOK_HANDLE
76 !
77 !-------------------------------------------------------------------------------
78 !
79 !
80 !*       3.     Prognostic fields:
81 !               -----------------
82 !
83 !* water temperature
84 !
85 IF (LHOOK) CALL DR_HOOK('WRITESURF_FLAKE_N',0,ZHOOK_HANDLE)
86 YRECFM='TS_WATER'
87 YCOMMENT='TS_WATER (K)'
88  CALL WRITE_SURF(HPROGRAM,YRECFM,XTS(:),IRESP,HCOMMENT=YCOMMENT)
89
90
91 YRECFM='T_SNOW'
92 YCOMMENT='T_SNOW (K)'
93  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_SNOW(:),IRESP,HCOMMENT=YCOMMENT)
94 YRECFM='T_ICE'
95 YCOMMENT='T_ICE (K)'
96  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_ICE(:),IRESP,HCOMMENT=YCOMMENT)
97 YRECFM='T_MNW'
98 YCOMMENT='T_WATER_MEAN (K)'
99  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_MNW(:),IRESP,HCOMMENT=YCOMMENT)
100 YRECFM='T_WML'
101 YCOMMENT='T_WATER_ML (K)'
102  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WML(:),IRESP,HCOMMENT=YCOMMENT)
103 YRECFM='T_BOT'
104 YCOMMENT='T_WATER_BOT (K)'
105  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_BOT(:),IRESP,HCOMMENT=YCOMMENT)
106 YRECFM='T_B1'
107 YCOMMENT='T_B1 (K)'
108  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_B1(:),IRESP,HCOMMENT=YCOMMENT)
109 YRECFM='CT'
110 YCOMMENT='C_SHAPE_FACTOR ()'
111  CALL WRITE_SURF(HPROGRAM,YRECFM,XCT(:),IRESP,HCOMMENT=YCOMMENT)
112 YRECFM='H_SNOW'
113 YCOMMENT='H_SNOW (m)'
114  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_SNOW(:),IRESP,HCOMMENT=YCOMMENT)
115 YRECFM='H_ICE'
116 YCOMMENT='H_ICE (m)'
117  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_ICE(:),IRESP,HCOMMENT=YCOMMENT)
118 YRECFM='H_ML'
119 YCOMMENT='H_ML (m)'
120  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_ML(:),IRESP,HCOMMENT=YCOMMENT)
121 YRECFM='H_B1'
122 YCOMMENT='H_B1 (m)'
123  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_B1(:),IRESP,HCOMMENT=YCOMMENT)
124
125 !
126 !-------------------------------------------------------------------------------
127 !
128 !*       4.     Semi-prognostic fields:
129 !               ----------------------
130 !
131 !* roughness length
132 !
133 YRECFM='Z0WATER'
134 YCOMMENT='Z0WATER (m)'
135  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
136 !
137 !* friction velocity
138 !
139 YRECFM='USTAR_WATER'
140 YCOMMENT='USTAR_WATER (m/s)'
141  CALL WRITE_SURF(HPROGRAM,YRECFM,XUSTAR(:),IRESP,HCOMMENT=YCOMMENT)
142 !
143 !
144 !-------------------------------------------------------------------------------
145 !
146 !*       5.  Time
147 !            ----
148 !
149 YRECFM='DTCUR'
150 YCOMMENT='s'
151  CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
152 IF (LHOOK) CALL DR_HOOK('WRITESURF_FLAKE_N',1,ZHOOK_HANDLE)
153 !
154
155 !-------------------------------------------------------------------------------
156 !
157 END SUBROUTINE WRITESURF_FLAKE_n