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