Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_pgd_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_PGD_FLAKE_n(HPROGRAM)
7 !     ###################################################
8 !
9 !!****  *WRITESURF_PGD_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 !!      B. Decharme 07/2011 : delete argument HWRITE
36 !!      M. Moge     02/2015 parallelization using MPI_ALLREDUCE
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 USE MODD_FLAKE_n,      ONLY : XZS,XCOVER,LCOVER, &
43       XWATER_DEPTH,XWATER_FETCH,XT_BS,XDEPTH_BS,XEXTCOEF_WATER  
44 USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
45 !
46 USE MODI_WRITE_SURF
47 USE MODI_WRITE_GRID
48 !
49 USE MODI_WRITE_LCOVER
50 !
51 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
52 USE PARKIND1  ,ONLY : JPRB
53 !
54 IMPLICIT NONE
55 !
56 !*       0.1   Declarations of arguments
57 !              -------------------------
58 !
59  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
60
61 !
62 !*       0.2   Declarations of local variables
63 !              -------------------------------
64 !
65 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
66  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
67  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
68 REAL(KIND=JPRB) :: ZHOOK_HANDLE
69 !
70 !-------------------------------------------------------------------------------
71 !
72 !
73 !*       2.     Physiographic data fields:
74 !               -------------------------
75 !
76 !* cover classes
77 !
78 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_FLAKE_N',0,ZHOOK_HANDLE)
79 !
80 CALL WRITE_LCOVER(HPROGRAM,LCOVER)
81 !
82 YCOMMENT='COVER FIELDS'
83  CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
84 !
85 !* orography
86 !
87 YRECFM='ZS'
88 YCOMMENT='ZS'
89  CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
90 !
91 !* latitude, longitude
92 !
93  CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP)
94 !
95 !* FLake parameters
96 !
97 YRECFM='WATER_DEPTH'
98 YCOMMENT='X_Y_'//YRECFM//' (m)'
99  CALL WRITE_SURF(HPROGRAM,YRECFM,XWATER_DEPTH(:),IRESP,HCOMMENT=YCOMMENT)
100 !
101 YRECFM='WATER_FETCH'
102 YCOMMENT='X_Y_'//YRECFM//' (m)'
103  CALL WRITE_SURF(HPROGRAM,YRECFM,XWATER_FETCH(:),IRESP,HCOMMENT=YCOMMENT)
104 !
105 YRECFM='T_BS'
106 YCOMMENT='X_Y_'//YRECFM//' (K)'
107  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_BS(:),IRESP,HCOMMENT=YCOMMENT)
108 !
109 YRECFM='DEPTH_BS'
110 YCOMMENT='X_Y_'//YRECFM//' (m)'
111  CALL WRITE_SURF(HPROGRAM,YRECFM,XDEPTH_BS(:),IRESP,HCOMMENT=YCOMMENT)
112 !
113 YRECFM='EXTCOEF_WAT'
114 YCOMMENT='X_Y_'//YRECFM//'    '
115  CALL WRITE_SURF(HPROGRAM,YRECFM,XEXTCOEF_WATER(:),IRESP,HCOMMENT=YCOMMENT)
116 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_FLAKE_N',1,ZHOOK_HANDLE)
117 !
118 !-------------------------------------------------------------------------------
119 !
120 END SUBROUTINE WRITESURF_PGD_FLAKE_n