6df004cc4889114125948e5471fa65409c35abec
[MNH-git_open_source-lfs.git] / src / SURFEX / pgd_flake.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 PGD_FLAKE(HPROGRAM)
7 !     ##############################################################
8 !
9 !!**** *PGD_FLAKE* monitor for averaging and interpolations of FLAKE physiographic fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!    AUTHOR
28 !!    ------
29 !!
30 !!    V. Masson        Meteo-France
31 !!
32 !!    MODIFICATION
33 !!    ------------
34 !!
35 !!    Original    03/2004
36 !!
37 !----------------------------------------------------------------------------
38 !
39 !*    0.     DECLARATION
40 !            -----------
41 !
42 USE MODD_DATA_LAKE,      ONLY : CLAKELDB, CSTATUSLDB
43 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
44 USE MODD_SURF_PAR,       ONLY : XUNDEF
45 USE MODD_FLAKE_n,        ONLY : XCOVER, LCOVER, XZS, &
46                                   XWATER_DEPTH  , &
47                                   XWATER_FETCH  , &
48                                   XT_BS         , &
49                                   XDEPTH_BS     , &
50                                   XEXTCOEF_WATER    
51  
52 USE MODD_FLAKE_GRID_n,  ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE, NDIM
53 !
54 USE MODI_ABOR1_SFX
55 USE MODI_GET_LUOUT
56 USE MODI_PGD_FIELD
57
58 USE MODI_GET_SURF_SIZE_n
59 USE MODI_PACK_PGD
60 !
61 USE MODI_OPEN_NAMELIST
62 USE MODI_CLOSE_NAMELIST
63 !
64 USE MODI_TREAT_GLOBAL_LAKE_DEPTH
65 !
66 USE MODE_POS_SURF
67 !
68 !
69 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
70 USE PARKIND1  ,ONLY : JPRB
71 !
72 USE MODI_WRITE_COVER_TEX_WATER
73 !
74 IMPLICIT NONE
75 !
76 !*    0.1    Declaration of arguments
77 !            ------------------------
78 !
79  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
80
81 !
82 !
83 !*    0.2    Declaration of local variables
84 !            ------------------------------
85 !
86 INTEGER                           :: ILUOUT    ! output listing logical unit
87 INTEGER                           :: ILUNAM    ! namelist file logical unit
88 LOGICAL                           :: GFOUND    ! flag when namelist is present
89 INTEGER,DIMENSION(:),ALLOCATABLE  :: IWATER_STATUS
90 !
91 !*    0.3    Declaration of namelists
92 !            ------------------------
93 !
94  CHARACTER(LEN=28)        :: YWATER_DEPTH  ! file name for water depth
95  CHARACTER(LEN=28)        :: YWATER_DEPTH_STATUS  ! file name for water depth status
96  CHARACTER(LEN=28)        :: YWATER_FETCH
97  CHARACTER(LEN=28)        :: YT_BS
98  CHARACTER(LEN=28)        :: YDEPTH_BS
99  CHARACTER(LEN=28)        :: YEXTCOEF_WATER
100
101  CHARACTER(LEN=6)         :: YWATER_DEPTHFILETYPE ! water depth file type
102  CHARACTER(LEN=6)         :: YWATER_FETCHFILETYPE
103  CHARACTER(LEN=6)         :: YT_BSFILETYPE
104  CHARACTER(LEN=6)         :: YDEPTH_BSFILETYPE
105  CHARACTER(LEN=6)         :: YEXTCOEF_WATERFILETYPE
106
107 REAL                     :: XUNIF_WATER_DEPTH   ! uniform value of water depth
108 REAL                     :: XUNIF_WATER_FETCH
109 REAL                     :: XUNIF_T_BS
110 REAL                     :: XUNIF_DEPTH_BS
111 REAL                     :: XUNIF_EXTCOEF_WATER
112 REAL(KIND=JPRB) :: ZHOOK_HANDLE
113 !
114 NAMELIST/NAM_DATA_FLAKE/ YWATER_DEPTH, YWATER_DEPTH_STATUS, YWATER_DEPTHFILETYPE,     &
115                          XUNIF_WATER_DEPTH, YWATER_FETCH, YWATER_FETCHFILETYPE,       &
116                          XUNIF_WATER_FETCH, YT_BS, YT_BSFILETYPE, XUNIF_T_BS,         &
117                          YDEPTH_BS, YDEPTH_BSFILETYPE, XUNIF_DEPTH_BS,                &
118                          YEXTCOEF_WATER, YEXTCOEF_WATERFILETYPE, XUNIF_EXTCOEF_WATER  
119 !-------------------------------------------------------------------------------
120 !
121 IF (LHOOK) CALL DR_HOOK('PGD_FLAKE',0,ZHOOK_HANDLE)
122  CALL GET_LUOUT(HPROGRAM,ILUOUT)
123 !
124 !-------------------------------------------------------------------------------
125 !
126 !*    1.      Initializations of defaults
127 !             ---------------------------
128 !
129 XUNIF_WATER_DEPTH  = 20.
130 XUNIF_WATER_FETCH  = 1000.
131 XUNIF_T_BS         = 286.
132 XUNIF_DEPTH_BS     = 1.
133 XUNIF_EXTCOEF_WATER= 3.
134 !
135 YWATER_DEPTH        = '                          '
136 YWATER_DEPTH_STATUS = '                          '
137 YWATER_FETCH        = '                          '
138 YT_BS               = '                          '
139 YDEPTH_BS           = '                          '
140 YEXTCOEF_WATER      = '                          '
141 !
142 YWATER_DEPTHFILETYPE   = '      '
143 YWATER_FETCHFILETYPE   = '      '
144 YT_BSFILETYPE          = '      '
145 YDEPTH_BSFILETYPE      = '      '
146 YEXTCOEF_WATERFILETYPE = '      '
147
148 !
149 !-------------------------------------------------------------------------------
150 !
151 !*    2.      Reading of namelist
152 !             -------------------
153 !
154  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
155 !
156  CALL POSNAM(ILUNAM,'NAM_DATA_FLAKE',GFOUND,ILUOUT)
157 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_FLAKE)
158 !
159  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
160 !
161 !-------------------------------------------------------------------------------
162 !
163 !*    3.      Coherence of options
164 !             --------------------
165 !
166 !-------------------------------------------------------------------------------
167 !
168 !*    4.      Number of points and packing
169 !             ----------------------------
170 !
171  CALL GET_SURF_SIZE_n('WATER ',NDIM)
172 !
173 ALLOCATE(LCOVER     (JPCOVER))
174 ALLOCATE(XCOVER     (NDIM,JPCOVER))
175 ALLOCATE(XZS        (NDIM))
176 ALLOCATE(XLAT       (NDIM))
177 ALLOCATE(XLON       (NDIM))
178 ALLOCATE(XMESH_SIZE (NDIM))
179 !
180  CALL PACK_PGD(HPROGRAM, 'WATER ',                    &
181                 CGRID,  XGRID_PAR,                     &
182                 LCOVER, XCOVER, XZS,                   &
183                 XLAT, XLON, XMESH_SIZE                 )  
184 !
185 !-------------------------------------------------------------------------------
186 !
187 !*    5.      Water depth
188 !             -----------
189 !
190 ALLOCATE(XWATER_DEPTH  (NDIM)) 
191 !
192 IF (TRIM(YWATER_DEPTH)==TRIM(CLAKELDB) .AND. TRIM(YWATER_DEPTHFILETYPE)=='DIRECT') THEN
193   !      
194   IF (TRIM(YWATER_DEPTH_STATUS)=='') THEN
195      WRITE(ILUOUT,*)'Depth Status file name not initialized'
196      WRITE(ILUOUT,*)'add YWATER_DEPTH_STATUS="GlobalLakeStatus" in NAM_DATA_FLAKE'
197      CALL ABOR1_SFX('PGD_FLAKE: STATUS INPUT FILE NAME NOT SET')
198   ELSEIF (TRIM(YWATER_DEPTH_STATUS)==TRIM(CSTATUSLDB)) THEN
199      ALLOCATE(IWATER_STATUS  (NDIM))       
200      CALL TREAT_GLOBAL_LAKE_DEPTH(HPROGRAM,XWATER_DEPTH(:),IWATER_STATUS(:))
201   ELSE
202      WRITE(ILUOUT,*)'Wrong name for Depth Status file :',' expected: ',TRIM(CSTATUSLDB),' input: ',TRIM(YWATER_DEPTH_STATUS)
203      CALL ABOR1_SFX('PGD_FLAKE: WRONG STATUS INPUT FILE NAME')
204   ENDIF
205   !
206 ELSE
207   !
208   CALL PGD_FIELD(HPROGRAM,'water depth','WAT',YWATER_DEPTH,YWATER_DEPTHFILETYPE,XUNIF_WATER_DEPTH,XWATER_DEPTH(:))
209   !
210 ENDIF
211 !
212 !-------------------------------------------------------------------------------
213 !
214 !*    6.      Wind fetch
215 !             ----------
216 !
217 ALLOCATE(XWATER_FETCH  (NDIM)) 
218 !
219  CALL PGD_FIELD(HPROGRAM,'wind fetch','WAT',YWATER_FETCH,YWATER_FETCHFILETYPE,XUNIF_WATER_FETCH,XWATER_FETCH(:))
220 !
221 !-------------------------------------------------------------------------------
222 !
223 !*    7.      Sediments bottom temperature
224 !             ----------------------------
225 !
226 ALLOCATE(XT_BS         (NDIM)) 
227 !
228  CALL PGD_FIELD(HPROGRAM,'sediments bottom temperature ','WAT',YT_BS,YT_BSFILETYPE,XUNIF_T_BS,XT_BS(:))
229 !
230 !-------------------------------------------------------------------------------
231 !
232 !*    8.      Depth of sediments layer
233 !             ------------------------
234 !
235 ALLOCATE(XDEPTH_BS     (NDIM)) 
236 !
237  CALL PGD_FIELD(HPROGRAM,'depth of sediments layer','WAT',YDEPTH_BS,YDEPTH_BSFILETYPE,XUNIF_DEPTH_BS,XDEPTH_BS(:))
238 !
239 !-------------------------------------------------------------------------------
240 !
241 !*    9.      Water extinction coefficient
242 !             ----------------------------
243
244 ALLOCATE(XEXTCOEF_WATER(NDIM)) 
245 !
246  CALL PGD_FIELD(HPROGRAM,'water extinction coefficient','WAT', &
247                  YEXTCOEF_WATER,YEXTCOEF_WATERFILETYPE,XUNIF_EXTCOEF_WATER, &
248                  XEXTCOEF_WATER(:))  
249 !
250 !-------------------------------------------------------------------------------
251 !
252 !*   10.     Prints of flake parameters in a tex file
253 !            ----------------------------------------
254 !
255  CALL WRITE_COVER_TEX_WATER
256 IF (LHOOK) CALL DR_HOOK('PGD_FLAKE',1,ZHOOK_HANDLE)
257 !-------------------------------------------------------------------------------
258 !
259 END SUBROUTINE PGD_FLAKE