3ee00d70c6d85995097e81661c635025547235a1
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_teb_greenroof_extern.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 PREP_TEB_GREENROOF_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
7 !     #################################################################################
8 !
9 !!****  *PREP_TEB_GREENROOF_EXTERN* - initializes ISBA fields from operational GRIB
10 !!
11 !!    PURPOSE
12 !!    -------
13 !
14 !!**  METHOD
15 !!    ------
16 !!    Based on "prep_teb_garden_extern"
17 !!
18 !!    REFERENCE
19 !!    ---------
20 !!      
21 !!
22 !!    AUTHOR
23 !!    ------
24 !!    A. Lemonsu & C. de Munck 
25 !!
26 !!    MODIFICATIONS
27 !!    -------------
28 !!      Original    07/2011
29 !!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
30 !!------------------------------------------------------------------
31 !
32
33 !
34 USE MODE_READ_EXTERN
35 !
36 USE MODD_TYPE_DATE_SURF
37 !
38 USE MODI_PREP_GRID_EXTERN
39 USE MODI_READ_SURF
40 USE MODI_INTERP_GRID
41 USE MODI_OPEN_AUX_IO_SURF
42 USE MODI_CLOSE_AUX_IO_SURF
43 USE MODI_READ_TEB_PATCH
44 USE MODI_GET_CURRENT_TEB_PATCH
45 USE MODI_TOWN_PRESENCE
46 !
47 USE MODD_PREP,               ONLY : CINGRID_TYPE, CINTERP_TYPE
48 USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF
49 USE MODD_DATA_COVER_PAR,     ONLY : NVEGTYPE
50 USE MODD_SURF_PAR,           ONLY : XUNDEF
51 !
52 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
53 USE PARKIND1  ,ONLY : JPRB
54 !
55 USE MODI_PUT_ON_ALL_VEGTYPES
56 !
57 USE MODI_READ_SURF_FIELD2D
58 !
59 IMPLICIT NONE
60 !
61 !*      0.1    declarations of arguments
62 !
63  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
64  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
65  CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
66  CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
67  CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
68  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
69 INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
70 REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)
71 !
72 !*      0.2    declarations of local variables
73 !
74  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
75 INTEGER           :: IRESP          ! reading return code
76 INTEGER           :: INI            ! total 1D dimension
77 INTEGER           :: IPATCH         ! number of patch
78 !
79 REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches
80 REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch
81 REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil
82 REAL, DIMENSION(:,:), POINTER       :: ZD1            ! depth of field in the soil, one patch
83 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT           !
84 LOGICAL                             :: GTEB           ! flag if TEB fields are present
85 INTEGER                             :: JPATCH         ! loop counter for patch
86  CHARACTER(LEN=12)                   :: YSURF          ! type of field
87 INTEGER                             :: ITEB_PATCH     ! number of TEB patches in file
88 INTEGER                             :: ICURRENT_PATCH ! current TEB patch to be initialized
89 INTEGER                             :: IVERSION       ! SURFEX version
90 INTEGER                             :: IBUGFIX        ! SURFEX bug version
91 LOGICAL                             :: GOLD_NAME      ! old name flag for temperatures
92  CHARACTER(LEN=3)                    :: YPATCH         ! indentificator for TEB patch
93  CHARACTER(LEN=4)                    :: YPATCH2   ! number of the patch
94 LOGICAL                             :: GGREENROOF     ! T if gardens are present in the file
95 !
96 REAL(KIND=JPRB) :: ZHOOK_HANDLE
97 !
98 !------------------------------------------------------------------------------
99 !
100 !*      1.     Preparation of IO for reading in the file
101 !              -----------------------------------------
102 !
103 !* Note that all points are read, even those without physical meaning.
104 !  These points will not be used during the horizontal interpolation step.
105 !  Their value must be defined as XUNDEF.
106 !
107 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',0,ZHOOK_HANDLE)
108  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN  ')
109 !
110 !* reading of version of the file being read
111  CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
112  CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
113 GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
114 !
115 !------------------------------------------------------------------------------
116 !
117 !*      2.     Reading of grid
118 !              ---------------
119 !
120  CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
121 !
122 !* reads if TEB fields exist in the input file
123  CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
124 !
125 IF (GTEB) THEN
126   CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
127   CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
128   YPATCH='   '
129   IF (ITEB_PATCH>1) THEN
130     WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
131   END IF
132 END IF
133 !
134 ! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES
135 !---------------------------------------------------------------------------------------
136 !
137 !*      3.     Transformation into physical quantity to be interpolated
138 !              --------------------------------------------------------
139 !
140 SELECT CASE(HSURF)
141 !
142 !*     3.      Orography
143 !              ---------
144 !
145   CASE('ZS     ')
146     ALLOCATE(PFIELD(INI,1,1))
147     YRECFM='ZS'
148     CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
149     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
150 !
151 !--------------------------------------------------------------------------
152 !
153 !
154 !*      3.1    Profile of temperature, water or ice in the soil
155 !
156   CASE('TG    ','WG    ','WGI   ')
157 !* choice if one reads garden fields (if present) or ISBA fields
158      GGREENROOF = .FALSE.
159      IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
160      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
161      IF (GGREENROOF) THEN
162         YSURF = 'GR_'//HSURF(1:3)  
163         YSURF=YPATCH//YSURF      
164      ELSE
165        YSURF = HSURF
166      END IF
167      YSURF=ADJUSTL(YSURF)
168 !* reading of the profile and its depth definition
169      CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
170         HSURF,YSURF,ZFIELD,ZD)
171
172      ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
173      ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
174      ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
175      ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
176 !
177      DO JPATCH=1,SIZE(ZFIELD,3)
178         ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
179         ZD1(:,:)=ZD(:,:,JPATCH)
180         CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
181         PFIELD(:,:,JPATCH)=ZOUT(:,:)
182      END DO
183 !
184      DEALLOCATE(ZFIELD)
185      DEALLOCATE(ZOUT)
186      DEALLOCATE(ZFIELD1)
187      DEALLOCATE(ZD)
188 !
189 !--------------------------------------------------------------------------
190 !
191 !*      3.4    Water content intercepted on leaves, LAI
192 !
193   CASE('WR     ')
194      ALLOCATE(PFIELD(INI,1,NVEGTYPE))
195      !* choice if one reads garden fields (if present) or ISBA fields
196      GGREENROOF = .FALSE.
197      IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
198      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
199      IF (GGREENROOF) THEN
200        IPATCH = 1             
201        YRECFM = 'GD_WR'
202        YRECFM=YPATCH//YRECFM
203        CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')
204      ELSE
205        YRECFM = 'PATCH_NUMBER'
206        CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
207        CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
208        CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
209        CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
210        YRECFM = 'WR'
211      END IF
212      YRECFM=ADJUSTL(YRECFM)
213      ALLOCATE(ZFIELD(INI,1,IPATCH))
214      CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
215      CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
216      CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
217      DEALLOCATE(ZFIELD)
218 !
219   CASE('LAI    ')
220      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
221      ALLOCATE(PFIELD(INI,1,NVEGTYPE))
222      PFIELD(:,:,:) = XUNDEF
223 !
224 END SELECT
225 !
226 !
227 !---------------------------------------------------------------------------
228 !
229 !*      6.     End of IO
230 !              ---------
231 !
232 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',1,ZHOOK_HANDLE)
233 !
234 !---------------------------------------------------------------------------
235 !---------------------------------------------------------------------------
236 END SUBROUTINE PREP_TEB_GREENROOF_EXTERN