c0eeb805e485089318f472010f24e599f1ae1fc2
[MNH-git_open_source-lfs.git] / src / SURFEX / read_covers_and_av_pgd_on_layers.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 READ_COVERS_AND_AV_PGD_1D_ON_LAYERS(HFILEPGDTYPE,HRECFM,KLU,KDATA_LAYER,PFIELD2D,PDATA,HSFTYPE,HATYPE,PDZ,KDECADE)
7 !     ################################################################
8 !!
9 !!    PURPOSE
10 !!    -------
11 !!
12 !!    METHOD
13 !!    ------
14 !!
15 !!    EXTERNAL
16 !!    --------
17 !!
18 !!    IMPLICIT ARGUMENTS
19 !!    ------------------
20 !!
21 !!    REFERENCE
22 !!    ---------
23 !!
24 !!    AUTHOR
25 !!    ------
26 !!
27 !!    M.Moge        CNRS - LA
28 !!     inspired from AV_PGD_1D
29 !!
30 !!    MODIFICATION
31 !!    ------------
32 !
33 !
34 !!    Original    06/05/2015
35 !!
36 !----------------------------------------------------------------------------
37 !
38 !*    0.     DECLARATION
39 !            -----------
40 !
41 USE MODD_SURF_PAR,       ONLY : XUNDEF
42 USE MODD_DATA_COVER,     ONLY : XDATA_BLD_HEIGHT 
43 USE MODD_DATA_COVER_n,   ONLY : XDATA_NATURE, XDATA_TOWN, XDATA_BLD, XDATA_GARDEN, &
44                                 XDATA_SEA, XDATA_WATER, XDATA_VEGTYPE
45 USE MODD_DATA_COVER_PAR, ONLY : NVT_TREE, NVT_CONI, NVT_EVER, XCDREF, JPCOVER
46 !
47 !
48 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
49 USE PARKIND1  ,ONLY : JPRB
50 !
51 USE MODI_ABOR1_SFX
52 !
53 USE MODI_READ_SURF
54 #ifdef MNH
55 USE MODI_READ_SURFX2COV_1COV_MNH
56 #endif
57 !
58 IMPLICIT NONE
59 !
60 !*    0.1    Declaration of arguments
61 !            ------------------------
62 !
63 CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
64 CHARACTER(LEN=12),   INTENT(IN) :: HRECFM         ! Name of the article to be read
65 INTEGER,   INTENT(IN) :: KLU                      ! number of points
66 INTEGER,   INTENT(IN)  :: KDATA_LAYER  ! number of layers
67 REAL, DIMENSION(KLU,KDATA_LAYER),     INTENT(OUT) :: PFIELD2D  ! secondary field to construct
68 REAL, DIMENSION(JPCOVER,KDATA_LAYER),     INTENT(IN)  :: PDATA   ! secondary field value for each class
69 CHARACTER(LEN=3),       INTENT(IN)  :: HSFTYPE ! Type of surface where the field is defined
70 CHARACTER(LEN=3),       INTENT(IN)  :: HATYPE  ! Type of averaging
71 REAL, DIMENSION(KLU),     INTENT(IN), OPTIONAL :: PDZ    ! first model half level
72 INTEGER,                INTENT(IN), OPTIONAL :: KDECADE ! current month
73 !
74 !*    0.2    Declaration of local variables
75 !            ------------------------------
76 !
77 !
78 INTEGER :: ICOVER  ! number of cover classes
79 INTEGER :: JCOVER  ! loop on cover classes
80 INTEGER :: JLAYER  ! loop on layers
81 !
82 REAL, DIMENSION(KLU) :: ZWORK, ZDZ
83 REAL                            :: ZWEIGHT
84 REAL, DIMENSION(KLU) :: ZCOVER_WEIGHT
85 REAL                            :: ZDATA_COVER
86 REAL, DIMENSION(KLU) :: ZSUM_COVER_WEIGHT
87 REAL, DIMENSION(KLU) :: ZWEIGHT_MAX
88 REAL(KIND=JPRB) :: ZHOOK_HANDLE
89 LOGICAL, DIMENSION(JPCOVER)          :: GCOVER ! flag to read the covers
90 REAL,    DIMENSION(KLU)          :: ZCOVER ! cover fractions
91 CHARACTER(LEN=100) :: YCOMMENT
92 INTEGER           :: IRESP          ! reading return code
93 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
94 !-------------------------------------------------------------------------------
95 !
96 IF (LHOOK) CALL DR_HOOK('READ_COVERS_AND_AV_PGD_1D_ON_LAYERS',0,ZHOOK_HANDLE)
97 !
98 !*    0.3 Initializations
99 !
100 IF (PRESENT(PDZ)) THEN
101   ZDZ(:)=PDZ(:)
102 ELSE
103   ZDZ(:)=XCDREF
104 END IF
105 !
106 PFIELD2D(:,:)=XUNDEF
107 !
108 !
109 !* depths are deduced from the cover types
110 !* reading of the cover to obtain the thickness of layers
111 CALL READ_SURF(HFILEPGDTYPE,HRECFM,GCOVER(:),IRESP,HDIR='-')
112 YRECFM='COVER'
113 #ifdef MNH
114 !
115 ! Loop on layers
116 DO JLAYER=1,KDATA_LAYER
117   ZWORK(:)=0.
118   ZWEIGHT_MAX(:)=0.
119   ZSUM_COVER_WEIGHT(:)=0.
120   ! loop on covers
121   DO JCOVER=1,JPCOVER
122     !
123     !*    1. depths are deduced from the cover types
124     !        reading of the cover to obtain the thickness of layers
125     !
126     IF ( GCOVER( JCOVER ) ) THEN
127       CALL READ_SURFX2COV_1COV_MNH(YRECFM,KLU,JCOVER,ZCOVER(:),IRESP,YCOMMENT,'A')
128     ELSE
129       ZCOVER(:) = 0.
130     ENDIF
131     !
132     !*    2. averaging
133     !
134     ! 2.1. Selection of the weighting function
135     SELECT CASE (HSFTYPE)
136       CASE('ALL')
137         ZWEIGHT=1.
138       CASE('NAT')
139         ZWEIGHT=XDATA_NATURE(JCOVER)
140       CASE('GRD')
141         ZWEIGHT=XDATA_TOWN (JCOVER) * XDATA_GARDEN(JCOVER)
142       CASE('TWN')
143         ZWEIGHT=XDATA_TOWN  (JCOVER)
144       CASE('WAT')
145         ZWEIGHT=XDATA_WATER (JCOVER)
146       CASE('SEA')
147         ZWEIGHT=XDATA_SEA   (JCOVER)
148       CASE('BLD')
149         ZWEIGHT=XDATA_TOWN  (JCOVER) *        XDATA_BLD(JCOVER)
150       CASE('BLV')  !* building Volume
151         ZWEIGHT=XDATA_TOWN  (JCOVER) *        XDATA_BLD(JCOVER) * XDATA_BLD_HEIGHT(JCOVER)
152       CASE('STR')
153         ZWEIGHT=XDATA_TOWN  (JCOVER) * ( 1. - XDATA_BLD(JCOVER) )
154       CASE('TRE')
155         ZWEIGHT=XDATA_NATURE(JCOVER) * (  XDATA_VEGTYPE(JCOVER,NVT_TREE) &
156                 + XDATA_VEGTYPE(JCOVER,NVT_EVER) + XDATA_VEGTYPE(JCOVER,NVT_CONI) )  
157       CASE('GRT')
158         ZWEIGHT=XDATA_TOWN(JCOVER) * XDATA_GARDEN(JCOVER) * (  XDATA_VEGTYPE(JCOVER,NVT_TREE) &
159                 + XDATA_VEGTYPE(JCOVER,NVT_EVER) + XDATA_VEGTYPE(JCOVER,NVT_CONI) )  
160       CASE DEFAULT
161         CALL ABOR1_SFX('AV_PGD_1D: WEIGHTING FUNCTION NOT ALLOWED '//HSFTYPE)
162       END SELECT
163     ! 2.2. Averaging
164     ZCOVER_WEIGHT(:) = ZCOVER(:) * ZWEIGHT
165     ZSUM_COVER_WEIGHT(:) = ZSUM_COVER_WEIGHT(:) + ZCOVER_WEIGHT(:)
166     ZDATA_COVER = PDATA(JCOVER,JLAYER)
167     SELECT CASE (HATYPE)
168     CASE ('ARI')
169       ZWORK(:) = ZWORK(:) + ZDATA_COVER * ZCOVER_WEIGHT(:) 
170     CASE('INV' )
171       ZWORK (:)= ZWORK(:) + 1./ZDATA_COVER * ZCOVER_WEIGHT(:)
172     CASE('CDN')
173       ZWORK (:)= ZWORK(:) + 1./(LOG(ZDZ(:)/ZDATA_COVER))**2 * ZCOVER_WEIGHT(:)
174     CASE('MAJ' )
175       WHERE(ZCOVER_WEIGHT(:)>ZWEIGHT_MAX(:))
176         ZWEIGHT_MAX(:) = ZCOVER_WEIGHT(:)
177         ZWORK      (:) = ZDATA_COVER
178       END WHERE
179     CASE DEFAULT
180       CALL ABOR1_SFX('AV_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED : "'//HATYPE//'"')
181     END SELECT
182   ! 
183   END DO ! DO JCOVER=1,JPCOVER
184   !     
185   ! 2.3. End of Averaging
186   SELECT CASE (HATYPE)
187   CASE ('ARI')
188     WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
189       PFIELD2D(:,JLAYER) = ZWORK(:) / ZSUM_COVER_WEIGHT(:)
190     END WHERE
191   CASE('INV' )
192     WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
193       PFIELD2D(:,JLAYER) = ZSUM_COVER_WEIGHT(:) / ZWORK(:)
194     END WHERE
195   CASE('CDN')
196     WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
197       PFIELD2D(:,JLAYER) = ZDZ(:) * EXP( - SQRT(ZSUM_COVER_WEIGHT(:)/ZWORK(:)) )
198     END WHERE
199   CASE('MAJ' )
200     WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
201       PFIELD2D(:,JLAYER) = ZWORK(:)
202     END WHERE
203   CASE DEFAULT
204     CALL ABOR1_SFX('AV_PGD_1D: (2) AVERAGING TYPE NOT ALLOWED')
205   END SELECT
206 !
207 END DO !DO JLAYER=1,KDATA_LAYER
208 #endif
209 !
210 IF (LHOOK) CALL DR_HOOK('READ_COVERS_AND_AV_PGD_1D_ON_LAYERS',1,ZHOOK_HANDLE)
211 !-------------------------------------------------------------------------------
212 END SUBROUTINE READ_COVERS_AND_AV_PGD_1D_ON_LAYERS