Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_covern.F90
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !SFX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITESURF_COVER_n (HSELECT, U, 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 : SURF_ATM_t
38 !
39 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
40 !
41 USE MODE_WRITE_SURF_COV, ONLY : WRITE_SURF_COV
42 !
43 USE MODI_WRITE_SURF
44 USE MODI_WRITE_LCOVER
45 !
46 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
47 USE PARKIND1  ,ONLY : JPRB
48 !
49 IMPLICIT NONE
50 !
51 !*       0.1   Declarations of arguments
52 !              -------------------------
53 !
54  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
55 !
56 TYPE(SURF_ATM_t), INTENT(INOUT) :: U
57 !
58  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
59 !
60 !*       0.2   Declarations of local variables
61 !              -------------------------------
62 !
63 INTEGER :: IRESP          ! IRESP  : return-code if a problem appears
64  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
65  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
66 REAL(KIND=JPRB) :: ZHOOK_HANDLE
67 !
68 !-------------------------------------------------------------------------------
69 !
70 !*       1.     Cover classes :
71 !               -------------
72 !
73 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',0,ZHOOK_HANDLE)
74 !
75 YCOMMENT = '(-)'
76  CALL WRITE_SURF(HSELECT, &
77                  HPROGRAM,'FRAC_SEA   ',U%XSEA,   IRESP,HCOMMENT=YCOMMENT)
78  CALL WRITE_SURF(HSELECT, &
79                  HPROGRAM,'FRAC_NATURE',U%XNATURE,IRESP,HCOMMENT=YCOMMENT)
80  CALL WRITE_SURF(HSELECT, &
81                  HPROGRAM,'FRAC_WATER ',U%XWATER, IRESP,HCOMMENT=YCOMMENT)
82  CALL WRITE_SURF(HSELECT, &
83                  HPROGRAM,'FRAC_TOWN  ',U%XTOWN,  IRESP,HCOMMENT=YCOMMENT)
84 !
85 CALL WRITE_LCOVER(HSELECT,HPROGRAM,U%LCOVER)
86 !
87 YCOMMENT='COVER FIELDS'
88  CALL WRITE_SURF_COV(HSELECT,  &
89                      HPROGRAM,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP,HCOMMENT=YCOMMENT)
90 !
91 !-------------------------------------------------------------------------------
92 !
93 !*       2.     Orography :
94 !               ---------
95 !
96 YRECFM='ZS'
97 YCOMMENT='X_Y_ZS (M)'
98  CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,U%XZS(:),IRESP,HCOMMENT=YCOMMENT)
99 !
100 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',1,ZHOOK_HANDLE)
101 !
102 !-------------------------------------------------------------------------------
103 !
104 END SUBROUTINE WRITESURF_COVER_n