Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
! ################
PROGRAM PREP_PGD
! ################
!!
!! PURPOSE
!! -------
!! This program prepares the physiographic data fields.
!!
!! METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!!
!! F. Mereyde Meteo-France
!!
!! MODIFICATION
!! ------------
!!
!! Original 21/07/95
!! Modification 26/07/95 Treatment of orography and subgrid-scale
!! orography roughness length (V. Masson)
!! Modification 22/05/96 Variable CSTORAGE_TYPE (V. Masson)
!! Modification 25/05/96 Modification of splines, correction on z0rel
!! and set limits for some surface varaibles
!! Modification 12/06/96 Treatment of a rare case for ZPGDZ0EFF (Masson)
!! Modification 22/11/96 removes the filtering. It will have to be
!! performed in ADVANCED_PREP_PGD (Masson)
!! Modification 15/03/99 **** MAJOR MODIFICATION **** (Masson)
!! PGD fields are now defined from the cover
!! type fractions in the grid meshes
!! User can still include its own data, and
!! even additional (dummy) fields
!! Modificatio 06/00 patch approach, for vegetation related variable (Solmon/Masson)
! averaging is performed on subclass(=patch) of nature
!! 08/03/01 add chemical emission treatment (D.Gazen)
!! Modification 15/10/01 allow namelists in different orders (I.Mallet)
!!
!! ################################
!! MODIFICATION 13/10/03 EXTERNALIZED VERSION (V. Masson)
!! ################################
!! J.Escobar 4/04/2008 Improve checking --> add STATUS=OLD in open_ll(PRE_PGD1.nam,...
!!
!! Modification 30/03/2012 Add NAM_NCOUT for netcdf output (S.Bielli)
!! S.Bielli 23/04/2014 supress writing of LAt and LON in NETCDF case
!! S.Bielli 20/11/2014 add writing of LAt and LON in NETCDF case
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
USE MODD_CONF, ONLY : CPROGRAM, NMASDEV, NBUGFIX, CBIBUSER, &
L1D, L2D, LPACK , LCARTESIAN
USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
USE MODD_LUNIT, ONLY : CLUOUT0, COUTFMFILE
USE MODD_PARAMETERS, ONLY : XUNDEF
USE MODD_IO_ll, ONLY : GSMONOPROC
USE MODD_IO_SURF_MNH, ONLY : NHALO
!
USE MODE_POS
USE MODE_FMWRIT
USE MODE_IO_ll
USE MODE_MODELN_HANDLER
!
USE MODI_ZSMT_PGD
!
!JUAN
USE MODN_CONFZ
!JUAN
!
USE MODI_ALLOC_SURFEX
USE MODI_READ_ALL_NAMELISTS
USE MODI_GOTO_SURFEX
USE MODI_VERSION
USE MODI_PGD_GRID_SURF_ATM
USE MODI_SPLIT_GRID
USE MODI_PGD_SURF_ATM
USE MODI_WRITE_PGD_SURF_ATM_N
USE MODI_DEALLOC_SURFEX
!
#ifdef MNH_NCWRIT
USE MODD_SURF_ATM_GRID_n, ONLY : XLON, XLAT
USE MODN_NCOUT
USE MODE_UTIL
USE MODE_FMREAD
#endif
!
IMPLICIT NONE
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
INTEGER :: IRESP ! return code for I/O
INTEGER :: ILUOUT0
INTEGER :: ILUNAM
INTEGER :: IINFO_LL
INTEGER :: ININAR
LOGICAL :: GFOUND
CHARACTER(LEN=28) :: YDAD =' ' ! name of dad of input FM file
CHARACTER(LEN=28) :: CPGDFILE ='PGDFILE' ! name of the output file
INTEGER :: NZSFILTER=1 ! number of iteration for filter for fine orography
INTEGER :: NSLEVE =12 ! number of iteration for filter for smooth orography
REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
#ifdef MNH_NCWRIT
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! work array for lat and lon reshape
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LAT ! work array for lat and lon reshape
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LON ! work array for lat and lon reshape
REAL, DIMENSION(:,:),ALLOCATABLE :: ZZS ! work array for lat and lon reshape
CHARACTER(LEN=16) :: YRECFM ! name of record
INTEGER :: IGRID ! grid location
INTEGER :: ILENCH ! length of comment string
CHARACTER(LEN=100):: YCOMMENT ! comment string
#endif
!
NAMELIST/NAM_PGDFILE/CPGDFILE, NHALO
NAMELIST/NAM_ZSFILTER/NZSFILTER
NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
!------------------------------------------------------------------------------
!
!
CPROGRAM='PGD '
!
!
!* 1. Set default names and parallelized I/O
! --------------------------------------
!
CALL INITIO_ll()
!
NHALO=15
!
CLUOUT0='OUTPUT_LISTING0' ! Name of the output-listing.
!
CALL OPEN_ll(UNIT=ILUOUT0,FILE=CLUOUT0,IOSTAT=IRESP, &
FORM='FORMATTED',ACTION='WRITE',MODE=GLOBAL)
!
!JUAN
CALL OPEN_ll(UNIT=ILUNAM,FILE='PRE_PGD1.nam',IOSTAT=IRESP, &
FORM='FORMATTED',ACTION='READ',STATUS='OLD',MODE=GLOBAL)
IF (IRESP.NE.0 ) THEN
PRINT "('PREP_PGD :: IRESP=',I6,' --> file PRE_PGD1.nam not found ')", IRESP
!callabortstop
CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
CALL ABORT
STOP
ENDIF
!JUAN
CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
CALL POSNAM(ILUNAM,'NAM_ZSFILTER',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_ZSFILTER)
CALL POSNAM(ILUNAM,'NAM_SLEVE',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SLEVE)
!JUANZ
CALL POSNAM(ILUNAM,'NAM_CONFZ',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFZ)
!JUANZ
!SB
#ifdef MNH_NCWRIT
CALL POSNAM(ILUNAM,'NAM_NCOUT',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_NCOUT)
#endif
!
CALL CLOSE_ll('PRE_PGD1.nam')
!
!
CALL ALLOC_SURFEX(1)
CALL READ_ALL_NAMELISTS('MESONH','PRE',.FALSE.)
!
CALL GOTO_MODEL(1)
CALL GOTO_SURFEX(1,.TRUE.)
!
CALL VERSION
CSTORAGE_TYPE = 'PG'
!
CALL INI_CST
!
!
!* 2. Preparation of surface physiographic fields
! -------------------------------------------
!
!* Initializes the grid
! --------------------
!
CALL PGD_GRID_SURF_ATM('MESONH',' ',' ',.FALSE.)
!
CALL SPLIT_GRID('MESONH')
!
!
!* Initializes all physiographic fields
! ------------------------------------
!
CALL PGD_SURF_ATM('MESONH',' ',' ',.FALSE.)
!
!
!* 3. Writes the physiographic fields
! -------------------------------
!
COUTFMFILE = CPGDFILE
CALL FMOPEN_ll(COUTFMFILE,'WRITE',CLUOUT0,1,1,5,ININAR,IRESP)
!
CALL FMWRIT(COUTFMFILE,'MASDEV ',CLUOUT0,'--',NMASDEV,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'BUGFIX ',CLUOUT0,'--',NBUGFIX,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'BIBUSER ',CLUOUT0,'--',CBIBUSER,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'PROGRAM ',CLUOUT0,'--',CPROGRAM,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'STORAGE_TYPE',CLUOUT0,'--',CSTORAGE_TYPE,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'MY_NAME ',CLUOUT0,'--',COUTFMFILE,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'DAD_NAME ',CLUOUT0,'--',YDAD,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'SURF ',CLUOUT0,'--','EXTE',0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'L1D ',CLUOUT0,'--',L1D,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'L2D ',CLUOUT0,'--',L2D,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'PACK ',CLUOUT0,'--',LPACK,0,1,' ',IRESP)
!
#ifdef MNH_NCWRIT
NC_WRITE = LNETCDF
CALL WRITE_PGD_SURF_ATM_n('MESONH')
IF (LNETCDF.AND..NOT.LCARTESIAN) THEN
LLFIFM = .FALSE.
!!!! WRITE LAT and LON
CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
ALLOCATE(ZWORK(NIMAX+NHALO*2,NJMAX+NHALO*2))
ALLOCATE(ZWORK_LAT(NIMAX+2,NJMAX+2))
ALLOCATE(ZWORK_LON(NIMAX+2,NJMAX+2))
ZWORK=RESHAPE(XLAT, (/ (NIMAX+NHALO*2),(NJMAX+NHALO*2) /) )
ZWORK_LAT=ZWORK(NHALO:(NIMAX+NHALO+1),NHALO:(NJMAX+NHALO+1))
CALL FMWRIT(COUTFMFILE,'LAT',CLUOUT0,'XY',ZWORK_LAT,1,21,'X_Y_latitude (degree)',IRESP)
ZWORK=RESHAPE(XLON, (/ NIMAX+NHALO*2,NJMAX+NHALO*2 /) )
ZWORK_LON=ZWORK(NHALO:(NIMAX+NHALO+1),NHALO:(NJMAX+NHALO+1))
CALL FMWRIT(COUTFMFILE,'LON',CLUOUT0,'XY',ZWORK_LON,1,22,'X_Y_longitude (degree)',IRESP)
DEALLOCATE(ZWORK)
LLFIFM = .TRUE.
END IF
!* 4. Computes and writes smooth orography for SLEVE coordinate
! ---------------------------------------------------------
CALL ZSMT_PGD(COUTFMFILE,NZSFILTER,NSLEVE,XSMOOTH_ZS)
IF ( LNETCDF ) THEN
DEF_NC=.FALSE.
CALL WRITE_PGD_SURF_ATM_n('MESONH')
IF (LNETCDF.AND..NOT.LCARTESIAN) THEN
LLFIFM = .FALSE.
!!!! WRITE LAT and LON
CALL FMWRIT(COUTFMFILE,'LAT',CLUOUT0,'XY',ZWORK_LAT,1,21,'X_Y_latitude (degree)',IRESP)
CALL FMWRIT(COUTFMFILE,'LON',CLUOUT0,'XY',ZWORK_LON,1,22,'X_Y_longitude (degree)',IRESP)
END IF
ALLOCATE(ZZS(NIMAX+2,NJMAX+2))
!!!! writes smooth orography for SLEVE coordinate in netcdf
YRECFM = 'ZS '
CALL FMREAD(COUTFMFILE,YRECFM,CLUOUT0,'XY',ZZS,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMWRIT(COUTFMFILE,'ZS',CLUOUT0,'XY',ZZS,IGRID,ILENCH,YCOMMENT,IRESP)
YRECFM = 'ZSMT '
CALL FMREAD(COUTFMFILE,YRECFM,CLUOUT0,'XY',ZZS,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMWRIT(COUTFMFILE,'ZSMT',CLUOUT0,'XY',ZZS,IGRID,ILENCH,YCOMMENT,IRESP)
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
DEF_NC=.TRUE.
NC_WRITE = .FALSE.
END IF
#else
CALL WRITE_PGD_SURF_ATM_n('MESONH')
!* 4. Computes and writes smooth orography for SLEVE coordinate
! ---------------------------------------------------------
CALL ZSMT_PGD(COUTFMFILE,NZSFILTER,NSLEVE,XSMOOTH_ZS)
#endif
!
!
WRITE(ILUOUT0,*)
WRITE(ILUOUT0,*) '***************************'
WRITE(ILUOUT0,*) '* PREP_PGD ends correctly *'
WRITE(ILUOUT0,*) '***************************'
!
!* 6. Close parallelized I/O
! ----------------------
!
CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
CALL FMCLOS_ll(COUTFMFILE,'KEEP',CLUOUT0,IRESP)
!
CALL END_PARA_ll(IINFO_ll)
!
CALL DEALLOC_SURFEX
!
!-------------------------------------------------------------------------------
!
END PROGRAM PREP_PGD