2dcf2084f5d363adfd5b09f3d5dbaba098ae849d
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_pgd_teb_vegn.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_TEB_VEG_n(HPROGRAM)
7 !     ###############################################
8 !
9 !!****  *WRITE_PGD_TEB_VEG_n* - writes ISBA fields describing urban gardens
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 !!      A. Lemonsu & C. de Munck   *Meteo France*       
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    06/2011 
35 !!
36 !-------------------------------------------------------------------------------
37 !
38 !*       0.    DECLARATIONS
39 !              ------------
40 !
41 USE MODD_SURF_PAR,          ONLY : XUNDEF, NUNDEF
42 USE MODD_TEB_n,             ONLY : LECOCLIMAP, XGARDEN
43 USE MODD_TEB_VEG_n,         ONLY : CISBA
44 USE MODD_TEB_GARDEN_n,      ONLY : NGROUND_LAYER, XSOILGRID,         &
45                                    XCLAY, XSAND, XRUNOFFB, XWDRAIN,  &
46                                    XDG, NWG_LAYER
47 USE MODD_DATA_TEB_GARDEN_n, ONLY : NTIME
48 !
49 USE MODI_WRITE_SURF
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=12) :: YRECFM         ! Name of the article to be read
67  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
68 !
69 INTEGER :: JL ! loop counter
70
71 REAL(KIND=JPRB) :: ZHOOK_HANDLE
72 REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
73 !
74 !-------------------------------------------------------------------------------
75 !
76 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_TEB_VEG_N',0,ZHOOK_HANDLE)
77 !
78 !* soil scheme option
79 !
80 YRECFM='GD_ISBA'
81 YCOMMENT=YRECFM
82  CALL WRITE_SURF(HPROGRAM,YRECFM,CISBA,IRESP,HCOMMENT=YCOMMENT)
83 !
84 !* Reference grid for DIF
85 !
86 IF(CISBA=='DIF') THEN
87   YRECFM='GD_SOILGRID'
88   YCOMMENT=YRECFM
89   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILGRID,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
90 ENDIF
91 !
92 !* number of soil layers
93 !
94 YRECFM='GD_LAYER'
95 YCOMMENT=YRECFM
96  CALL WRITE_SURF(HPROGRAM,YRECFM,NGROUND_LAYER,IRESP,HCOMMENT=YCOMMENT)
97 !
98 !* number of time data for vegetation characteristics (VEG, LAI, EMIS, Z0) 
99 !
100 YRECFM='GD_NTIME'
101 YCOMMENT=YRECFM
102  CALL WRITE_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
103 !
104 ! * clay fraction
105 !
106 YRECFM='GD_CLAY'
107 YCOMMENT='X_Y_GD_CLAY'
108  CALL WRITE_SURF(HPROGRAM,YRECFM,XCLAY(:,1),IRESP,HCOMMENT=YCOMMENT)
109 !        
110 ! * sand fraction
111 !
112 YRECFM='GD_SAND'
113 YCOMMENT='X_Y_GD_SAND'
114  CALL WRITE_SURF(HPROGRAM,YRECFM,XSAND(:,1),IRESP,HCOMMENT=YCOMMENT)
115 !        
116 ! * orographic runoff coefficient
117 !
118 YRECFM='GD_RUNOFFB'
119 YCOMMENT='X_Y_GD_RUNOFFB'
120  CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFB,IRESP,HCOMMENT=YCOMMENT)
121 !        
122 ! * subgrid drainage coefficient
123 !
124 YRECFM='GD_WDRAIN'
125 YCOMMENT='X_Y_GD_WDRAIN'
126  CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
127 !
128 !-------------------------------------------------------------------------------
129 !
130 !*    3.      ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
131 !             ----------------------------------------------------------------------------------
132 !
133 IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
134   ALLOCATE(ZWORK(SIZE(XDG,1)))
135 !
136 !* Soil depth for each patch
137 !
138   DO JL=1,SIZE(XDG,2)
139     IF (JL<10) THEN
140       WRITE(YRECFM,FMT='(A9,I1)') 'GD_ECO_DG',JL
141     ELSE
142       WRITE(YRECFM,FMT='(A9,I2)') 'GD_ECO_DG',JL          
143     ENDIF
144     YCOMMENT='soil depth from ecoclimap'//' (M)'
145     ZWORK(:) = XDG(:,JL)
146     IF (ASSOCIATED(XGARDEN)) THEN  ! in PGD step, XGARDEN is not associated. In other steps, it is.
147       WHERE (XGARDEN==0.) ZWORK=XUNDEF
148     END IF
149     CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
150   END DO
151 !* Number of soil layers for moisture
152 !
153   IF (CISBA=='DIF') THEN
154     YRECFM='GD_ECO_WG_L'
155     YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
156     ZWORK=FLOAT(NWG_LAYER(:))
157     IF (ASSOCIATED(XGARDEN)) THEN
158       WHERE (XGARDEN==0.) ZWORK=FLOAT(NUNDEF)
159     END IF
160     CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
161   END IF
162
163   DEALLOCATE(ZWORK)
164 END IF
165
166 !
167 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_TEB_VEG_N',1,ZHOOK_HANDLE)
168 !-------------------------------------------------------------------------------
169 !
170 END SUBROUTINE WRITESURF_PGD_TEB_VEG_n