76a652a815741b43b4c8928435d49244d9a7e289
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_covern.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_COVER_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITESURF_COVER_n* - writes cover fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!       
14 !!
15 !!
16 !!**  METHOD
17 !!    ------
18 !!      
19 !!
20 !!    REFERENCE
21 !!    ---------
22 !!
23 !!
24 !!    AUTHOR
25 !!    ------
26 !!      V. Masson   *Meteo France*      
27 !!
28 !!    MODIFICATIONS
29 !!    -------------
30 !!      Original    01/2003
31 !!      M. Moge     02/2015 parallelization using WRITE_LCOVER
32 !-------------------------------------------------------------------------------
33 !
34 !*       0.    DECLARATIONS
35 !              ------------
36 !
37 USE MODD_SURF_ATM_n,     ONLY : XSEA, XWATER, XNATURE, XTOWN, XCOVER, LCOVER, &
38                                 XZS, LECOCLIMAP
39 !
40 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
41 !
42 USE MODI_WRITE_SURF
43 USE MODI_WRITE_LCOVER
44 !
45 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
46 USE PARKIND1  ,ONLY : JPRB
47 !
48 IMPLICIT NONE
49 !
50 !*       0.1   Declarations of arguments
51 !              -------------------------
52 !
53  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
54 !
55 !*       0.2   Declarations of local variables
56 !              -------------------------------
57 !
58 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
59  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
60  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
61 REAL(KIND=JPRB) :: ZHOOK_HANDLE
62 INTEGER :: IINFO
63 LOGICAL, DIMENSION(JPCOVER)    :: OCOVER   ! tmp list of covers
64 !
65 !-------------------------------------------------------------------------------
66 !
67 !*       1.     Cover classes :
68 !               -------------
69 !
70 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',0,ZHOOK_HANDLE)
71 !
72 YCOMMENT = '(-)'
73  CALL WRITE_SURF(HPROGRAM,'FRAC_SEA   ',XSEA,   IRESP,HCOMMENT=YCOMMENT)
74  CALL WRITE_SURF(HPROGRAM,'FRAC_NATURE',XNATURE,IRESP,HCOMMENT=YCOMMENT)
75  CALL WRITE_SURF(HPROGRAM,'FRAC_WATER ',XWATER, IRESP,HCOMMENT=YCOMMENT)
76  CALL WRITE_SURF(HPROGRAM,'FRAC_TOWN  ',XTOWN,  IRESP,HCOMMENT=YCOMMENT)
77 !
78 CALL WRITE_LCOVER(HPROGRAM,LCOVER)
79 !
80 YCOMMENT='COVER FIELDS'
81  CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT,HDIR='H')
82 !
83 !-------------------------------------------------------------------------------
84 !
85 !*       2.     Orography :
86 !               ---------
87 !
88 YRECFM='ZS'
89 YCOMMENT='X_Y_ZS (M)'
90  CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
91 !
92 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',1,ZHOOK_HANDLE)
93 !
94 !-------------------------------------------------------------------------------
95 !
96 END SUBROUTINE WRITESURF_COVER_n