Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / read_sso_canopyn.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_SSO_CANOPY_n(HPROGRAM,HINIT)
7 !     #########################################
8 !
9 !!****  *READ_SSO_CANOPY_n* - reads SSO fields
10 !!                        
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!      V. Masson   *Meteo France*      
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    05/2010 
36 !!      B. Decharme 07/2011  initialize sso_canopy in prep
37 !!      E. Martin   01/2012  Avoid writing of XUNDEF canopy fields
38 !-------------------------------------------------------------------------------
39 !
40 !*       0.    DECLARATIONS
41 !              ------------
42 !
43 USE MODD_SURF_PAR,        ONLY : XUNDEF
44 USE MODD_SSO_CANOPY_n,   ONLY : NLVL, XZ, XU, XTKE, XDZ, XZF, XDZF
45 !
46 USE MODI_READ_SURF
47 USE MODI_PREP_SSO_CANOPY
48 USE MODI_CANOPY_GRID
49 USE MODI_GET_TYPE_DIM_n
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 ! calling program
60  CHARACTER(LEN=3),  INTENT(IN)  :: HINIT    ! choice of fields to initialize
61 !
62 !*       0.2   Declarations of local variables
63 !              -------------------------------
64 !
65  CHARACTER(LEN=LEN_HREC) :: YRECFM       ! Name of the article to be read
66  CHARACTER(LEN=3)  :: YREAD
67 INTEGER :: ILU     ! 1D physical dimension
68 INTEGER :: IRESP   ! Error code after redding
69 INTEGER :: JLAYER  ! loop counter on layers
70 INTEGER :: IVERSION, IBUGFIX   ! surface version
71 LOGICAL :: GCANOPY    ! flag to test if SSO canopy fields are in the file
72 REAL(KIND=JPRB) :: ZHOOK_HANDLE
73 !-------------------------------------------------------------------------------
74 !
75 !* 1D physical dimension
76 !
77 IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',0,ZHOOK_HANDLE)
78  CALL GET_TYPE_DIM_n('FULL  ',ILU)
79 !
80 !* flag to use or not canopy levels
81 !
82 YRECFM='VERSION'
83  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
84 !
85 YRECFM='BUG'
86  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
87 !
88 IF (IVERSION<6.OR.HINIT=='PGD'.OR. HINIT=='PRE') THEN
89   GCANOPY = .FALSE.
90 ELSE
91   YRECFM='SSO_CANOPY'
92   CALL READ_SURF(HPROGRAM,YRECFM,GCANOPY,IRESP)
93 END IF
94 !
95 !*       2.     Allocation of Prognostic fields:
96 !               --------------------------------
97 !
98 !* number of vertical levels
99 !
100 IF (.NOT. GCANOPY) THEN
101   CALL PREP_SSO_CANOPY(ILU)
102 ELSE
103   !
104   YRECFM='SSO_CAN_LVL'
105   CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
106   !
107   ALLOCATE(XZ(ILU,NLVL))
108   !
109   !*       3.     Reading of Prognostic fields:
110   !               -----------------------------
111   !
112   !* altitudes
113   !
114   DO JLAYER=1,NLVL
115     WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_Z',JLAYER,' '
116     CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
117   END DO
118   !
119   ALLOCATE(XU(ILU,NLVL))
120   ALLOCATE(XTKE(ILU,NLVL))
121   !
122   IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
123     YRECFM='STORAGETYPE'
124     CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
125   ELSE
126     YREAD = 'ALL'
127   ENDIF
128   !
129   IF(YREAD=='ALL') THEN
130     !
131     !* wind in canopy
132     DO JLAYER=1,NLVL
133       WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_U',JLAYER,' '
134       CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
135     END DO
136     !
137     !* Tke in canopy
138     DO JLAYER=1,NLVL
139       WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_E',JLAYER,' '
140       CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
141     END DO
142     !
143   ELSE
144     XU(:,:)=XUNDEF
145     XTKE(:,:)=XUNDEF
146   ENDIF
147   !
148 ENDIF
149 !
150 !
151 !* Grid characteristics
152 !
153 !
154 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
155 !                                                                           ^
156 !                                                                           |
157 !                                                                           |
158 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
159 !                                                              ^            |
160 !                                                              |            |
161 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
162 !                                                              |            ^
163 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
164 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
165 !  - - - - - - - - - - - - - - - - - XZf(k-1)
166 !
167 ALLOCATE(XDZ (ILU,NLVL))
168 ALLOCATE(XZF (ILU,NLVL))
169 ALLOCATE(XDZF(ILU,NLVL))
170  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
171 IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',1,ZHOOK_HANDLE)
172 !
173 !-------------------------------------------------------------------------------
174 !
175 END SUBROUTINE READ_SSO_CANOPY_n