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