930dc17f85d53b5710fa4fdd46601c5eca283232
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_isba.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 ZOOM_PGD_ISBA(HPROGRAM,HINIFILE,HINIFILETYPE,HFILE,HFILETYPE,OECOCLIMAP)
7 !     ###########################################################
8
9 !!
10 !!    PURPOSE
11 !!    -------
12 !!   This program prepares the physiographic data fields.
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!
31 !!    V. Masson                   Meteo-France
32 !!
33 !!    MODIFICATION
34 !!    ------------
35 !!
36 !!    Original     13/10/03
37 !!    B. Decharme      2008  XWDRAIN
38 !!    M.Tomasini    17/04/12  Add interpolation for ISBA variables (MODD_DATA_ISBA_n)
39 !----------------------------------------------------------------------------
40 !
41 !*    0.     DECLARATION
42 !            -----------
43 !
44 USE MODD_SURF_PAR, ONLY : XUNDEF
45 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
46 USE MODD_ISBA_n,         ONLY : NPATCH, NGROUND_LAYER, CISBA,            &
47                                   CPEDOTF, XCOVER, LCOVER, XZS,          &
48                                   XZ0EFFJPDIR, CPHOTO, NNBIOMASS,        &
49                                   XSAND, XCLAY, XRUNOFFB, XWDRAIN,       &
50                                   LECOCLIMAP, LTR_ML, XSOILGRID
51 USE MODD_ISBA_GRID_n,    ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE
52 USE MODD_ISBA_PAR,    ONLY : XOPTIMGRID
53 USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE
54 !
55 USE MODI_GET_LUOUT
56 USE MODI_OPEN_AUX_IO_SURF
57 USE MODI_READ_SURF
58 USE MODI_CLOSE_AUX_IO_SURF
59 USE MODI_GET_SURF_SIZE_n
60 USE MODI_PACK_PGD
61 USE MODI_ZOOM_PGD_ISBA_FULL
62 USE MODI_GET_AOS_n
63 USE MODI_GET_SSO_n
64 USE MODI_PACK_PGD_ISBA
65 !
66 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
67 USE PARKIND1  ,ONLY : JPRB
68 !
69 IMPLICIT NONE
70 !
71 !*    0.1    Declaration of dummy arguments
72 !            ------------------------------
73 !
74  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
75  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
76  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
77  CHARACTER(LEN=28),    INTENT(IN)  :: HFILE       ! output file name
78  CHARACTER(LEN=6),     INTENT(IN)  :: HFILETYPE   ! output file type
79 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
80 !
81 !
82 !*    0.2    Declaration of local variables
83 !            ------------------------------
84 !
85 INTEGER :: IVERSION, IBUGFIX
86 INTEGER :: IRESP
87 INTEGER :: ILUOUT
88 INTEGER :: IL      ! total 1D dimension (output grid, total surface)
89 INTEGER :: ILU     ! total 1D dimension (output grid, ISBA points only)
90 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIP    ! A/S i+ on all surface points
91 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIM    ! A/S i- on all surface points
92 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJP    ! A/S j+ on all surface points
93 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJM    ! A/S j- on all surface points
94 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IP    ! h/2 i+ on all surface points
95 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IM    ! h/2 i- on all surface points
96 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JP    ! h/2 j+ on all surface points
97 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JM    ! h/2 j- on all surface points
98 REAL, DIMENSION(:), ALLOCATABLE   :: ZSSO_SLOPE! subgrid slope on all surface points
99 REAL(KIND=JPRB) :: ZHOOK_HANDLE
100 !------------------------------------------------------------------------------
101 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',0,ZHOOK_HANDLE)
102  CALL GET_LUOUT(HPROGRAM,ILUOUT)
103 !
104 !*      1.     Preparation of IO for reading in the file
105 !              -----------------------------------------
106 !
107 !* Note that all points are read, even those without physical meaning.
108 !  These points will not be used during the horizontal interpolation step.
109 !  Their value must be defined as XUNDEF.
110 !
111  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
112 !
113  CALL READ_SURF(HINIFILETYPE,'VERSION',IVERSION,IRESP)
114  CALL READ_SURF(HINIFILETYPE,'BUG',IBUGFIX,IRESP) 
115  CALL READ_SURF(HINIFILETYPE,'PATCH_NUMBER',NPATCH,IRESP)
116  CALL READ_SURF(HINIFILETYPE,'GROUND_LAYER',NGROUND_LAYER,IRESP)
117  CALL READ_SURF(HINIFILETYPE,'ISBA',CISBA,IRESP)
118 IF (IVERSION >= 7) THEN
119   CALL READ_SURF(HINIFILETYPE,'PEDOTF',CPEDOTF,IRESP)
120 ELSE
121   CPEDOTF = 'CH78'
122 ENDIF
123  CALL READ_SURF(HINIFILETYPE,'PHOTO',CPHOTO,IRESP)
124 !
125 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
126   !
127   CALL READ_SURF(HINIFILETYPE,'TR_ML',LTR_ML,IRESP)
128   !
129 ELSE 
130   LTR_ML = .FALSE.
131 ENDIF
132 !
133 IF(CISBA=='DIF') THEN
134   ALLOCATE(XSOILGRID(NGROUND_LAYER))
135   XSOILGRID=XUNDEF
136   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
137     CALL READ_SURF(HINIFILETYPE,'SOILGRID',XSOILGRID,IRESP,HDIR='-')
138   ELSE
139     XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER)
140   ENDIF
141 ELSE
142   ALLOCATE(XSOILGRID(0))
143 ENDIF
144 !
145 !* number of biomass pools
146 !
147 IF (IVERSION>=6) THEN
148   CALL READ_SURF(HPROGRAM,'NBIOMASS',NNBIOMASS,IRESP)
149 ELSE
150   SELECT CASE (CPHOTO)
151     CASE ('AGS','LAI','AST','LST')
152       NNBIOMASS = 1
153     CASE ('NIT')
154       NNBIOMASS = 3
155     CASE ('NCB')
156       NNBIOMASS = 6
157   END SELECT
158 ENDIF
159 !
160  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
161 !
162 !------------------------------------------------------------------------------
163 LECOCLIMAP = OECOCLIMAP
164 !
165 !-------------------------------------------------------------------------------
166 !
167 !*    7.      Number of points and packing of general fields
168 !             ----------------------------------------------
169 !
170 !
171  CALL GET_SURF_SIZE_n('NATURE',ILU)
172 !
173 ALLOCATE(LCOVER     (JPCOVER))
174 ALLOCATE(XCOVER     (ILU,JPCOVER))
175 ALLOCATE(XZS        (ILU))
176 ALLOCATE(XLAT       (ILU))
177 ALLOCATE(XLON       (ILU))
178 ALLOCATE(XMESH_SIZE (ILU))
179 ALLOCATE(XZ0EFFJPDIR(ILU))
180 !
181  CALL PACK_PGD(HPROGRAM, 'NATURE',                    &
182                 CGRID,  XGRID_PAR,                     &
183                 LCOVER, XCOVER, XZS,                   &
184                 XLAT, XLON, XMESH_SIZE, XZ0EFFJPDIR    )  
185 !
186 !------------------------------------------------------------------------------
187 !
188 !*      3.     Reading of sand, clay, runoffb, wdrain and interpolations
189 !              --------------------------------------------------
190 !
191 ALLOCATE(XSAND(ILU,NGROUND_LAYER))
192 ALLOCATE(XCLAY(ILU,NGROUND_LAYER))
193 ALLOCATE(XRUNOFFB(ILU))
194 ALLOCATE(XWDRAIN (ILU))
195  CALL ZOOM_PGD_ISBA_FULL(HPROGRAM,HINIFILE,HINIFILETYPE)
196 !
197 !-------------------------------------------------------------------------------
198 !
199 !*    8.      Packing of ISBA specific fields
200 !             -------------------------------
201 !
202  CALL GET_SURF_SIZE_n('FULL  ',IL)
203 !
204 ALLOCATE(ZAOSIP(IL))
205 ALLOCATE(ZAOSIM(IL))
206 ALLOCATE(ZAOSJP(IL))
207 ALLOCATE(ZAOSJM(IL))
208 ALLOCATE(ZHO2IP(IL))
209 ALLOCATE(ZHO2IM(IL))
210 ALLOCATE(ZHO2JP(IL))
211 ALLOCATE(ZHO2JM(IL))
212 ALLOCATE(ZSSO_SLOPE(IL))
213
214  CALL GET_AOS_n(HPROGRAM,IL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM)
215  CALL GET_SSO_n(HPROGRAM,IL,ZSSO_SLOPE)
216
217  CALL PACK_PGD_ISBA(HPROGRAM,                                    &
218                      ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM,              &
219                      ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM,              &
220                      ZSSO_SLOPE                                   )  
221 !
222 DEALLOCATE(ZAOSIP)
223 DEALLOCATE(ZAOSIM)
224 DEALLOCATE(ZAOSJP)
225 DEALLOCATE(ZAOSJM)
226 DEALLOCATE(ZHO2IP)
227 DEALLOCATE(ZHO2IM)
228 DEALLOCATE(ZHO2JP)
229 DEALLOCATE(ZHO2JM)
230 DEALLOCATE(ZSSO_SLOPE)
231 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',1,ZHOOK_HANDLE)
232 !-------------------------------------------------------------------------------
233 !
234 END SUBROUTINE ZOOM_PGD_ISBA