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.
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ini_posprofilern.f90,v $ $Revision: 1.2.2.2.2.2.2.2.2.1.2.3 $
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
! masdev4_7 BUG1 2007/06/28 11:28:12
!-----------------------------------------------------------------
! #########################
MODULE MODI_INI_POSPROFILER_n
! #########################
!
INTERFACE
!
SUBROUTINE INI_POSPROFILER_n(HLUOUT, &
PTSTEP, TPDTSEG, PSEGLEN, &
KRR, KSV, OUSETKE, &
PLATOR, PLONOR )
!
USE MODD_TYPE_DATE
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output listing
REAL, INTENT(IN) :: PTSTEP ! time step
TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE INI_POSPROFILER_n
!
END INTERFACE
!
END MODULE MODI_INI_POSPROFILER_n
!
! ###############################################################
SUBROUTINE INI_POSPROFILER_n(HLUOUT, &
PTSTEP, TPDTSEG, PSEGLEN, &
KRR, KSV, OUSETKE, &
PLATOR, PLONOR )
! ###############################################################
!
!
!!**** *INI_POSPROFILER_n* -
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! Valery Masson * Meteo-France *
!!
!! MODIFICATIONS
!! -------------
!! P. Tulet 15/01/2002
!! C.Lac 10/2016 Add visibility diagnostic
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
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_PARAMETERS
USE MODD_TYPE_PROFILER
USE MODD_TYPE_DATE
USE MODD_PROFILER_n
USE MODD_GRID_n
USE MODD_DYN_n
USE MODD_CONF
USE MODD_GRID
USE MODD_RADIATIONS_n, ONLY: NAER
!
USE MODE_ll
USE MODE_IO_ll
USE MODE_GRIDPROJ
!
USE MODI_INI_PROFILER_N
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output listing
REAL, INTENT(IN) :: PTSTEP ! time step
TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: ISTORE ! number of storage instants
INTEGER :: ILUOUT ! logical unit
INTEGER :: IRESP ! return code
INTEGER :: IKU !
!
!----------------------------------------------------------------------------
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!----------------------------------------------------------------------------
!
!* 1. Default values
! --------------
IKU = SIZE(XZZ,3) ! nombre de niveaux verticaux
!
CALL DEFAULT_PROFILER_n(TPROFILER)
!
!
!* 3. Stations initialization
! -----------------------
!
CALL INI_PROFILER_n
LPROFILER = (NUMBPROFILER>0)
!
!----------------------------------------------------------------------------
!
!* 4. Allocations of storage arrays
! -----------------------------
!
IF(NUMBPROFILER>0) THEN
CALL ALLOCATE_PROFILER_n(TPROFILER)
CALL INI_INTERP_PROFILER_n(TPROFILER)
END IF
!----------------------------------------------------------------------------
!
CONTAINS
!
!----------------------------------------------------------------------------
SUBROUTINE DEFAULT_PROFILER_n(TPROFILER)
!
TYPE(PROFILER), INTENT(INOUT) :: TPROFILER
!
NUMBPROFILER = 0
TPROFILER%T_CUR = XUNDEF
TPROFILER%N_CUR = 0
TPROFILER%STEP = XTSTEP
!
END SUBROUTINE DEFAULT_PROFILER_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE ALLOCATE_PROFILER_n(TPROFILER)
!
TYPE(PROFILER), INTENT(INOUT) :: TPROFILER
!
ISTORE = INT ( (PSEGLEN-XTSTEP) / TPROFILER%STEP ) + 1
!
ALLOCATE(TPROFILER%TIME (ISTORE))
ALLOCATE(TPROFILER%ERROR (NUMBPROFILER))
ALLOCATE(TPROFILER%X (NUMBPROFILER))
ALLOCATE(TPROFILER%Y (NUMBPROFILER))
ALLOCATE(TPROFILER%ZON (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%MER (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%FF (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%DD (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%W (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%P (ISTORE,IKU,NUMBPROFILER))

Gaelle Tanguy
committed
ALLOCATE(TPROFILER%ZZ (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%TH (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%THV (ISTORE,IKU,NUMBPROFILER))

Gaelle Tanguy
committed
ALLOCATE(TPROFILER%RHOD (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISI (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISIKUN(ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%RARE (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%R (ISTORE,IKU,NUMBPROFILER,KRR))
ALLOCATE(TPROFILER%SV (ISTORE,IKU,NUMBPROFILER,KSV))
ALLOCATE(TPROFILER%AER (ISTORE,IKU,NUMBPROFILER,NAER))
IF (OUSETKE) THEN
ALLOCATE(TPROFILER%TKE (ISTORE,IKU,NUMBPROFILER))
ELSE
ALLOCATE(TPROFILER%TKE (0,IKU,0))
END IF
ALLOCATE(TPROFILER%DATIME(16,ISTORE))
ALLOCATE(TPROFILER%T2M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%Q2M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%HU2M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%ZON10M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%MER10M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%RN (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%H (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%LE (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%LEI (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%GFLUX (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%LW (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%SW (ISTORE,NUMBPROFILER))

Gaelle Tanguy
committed
ALLOCATE(TPROFILER%IWV (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%ZTD (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%ZWD (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%ZHD (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%TKE_DISS(ISTORE,IKU,NUMBPROFILER))
!
!
TPROFILER%ERROR= .FALSE.
TPROFILER%TIME = XUNDEF
TPROFILER%ZON = XUNDEF
TPROFILER%MER = XUNDEF
TPROFILER%FF = XUNDEF
TPROFILER%DD = XUNDEF
TPROFILER%W = XUNDEF
TPROFILER%P = XUNDEF

Gaelle Tanguy
committed
TPROFILER%ZZ = XUNDEF
TPROFILER%TH = XUNDEF
TPROFILER%THV = XUNDEF

Gaelle Tanguy
committed
TPROFILER%RHOD = XUNDEF
TPROFILER%VISI = XUNDEF
TPROFILER%VISIKUN = XUNDEF

Gaelle Tanguy
committed
TPROFILER%IWV = XUNDEF
TPROFILER%ZTD = XUNDEF
TPROFILER%ZWD = XUNDEF
TPROFILER%ZHD = XUNDEF
TPROFILER%R = XUNDEF
TPROFILER%SV = XUNDEF
TPROFILER%AER = XUNDEF
TPROFILER%TKE = XUNDEF
TPROFILER%T2M = XUNDEF
TPROFILER%Q2M = XUNDEF
TPROFILER%HU2M = XUNDEF
TPROFILER%ZON10M = XUNDEF
TPROFILER%MER10M = XUNDEF
TPROFILER%RN = XUNDEF
TPROFILER%H = XUNDEF
TPROFILER%LE = XUNDEF
TPROFILER%GFLUX = XUNDEF
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
TPROFILER%LW = XUNDEF
TPROFILER%SW = XUNDEF
TPROFILER%TKE_DISS = XUNDEF
!
END SUBROUTINE ALLOCATE_PROFILER_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE INI_INTERP_PROFILER_n(TPROFILER)
!
TYPE(PROFILER), INTENT(INOUT) :: TPROFILER
INTEGER :: III
INTEGER :: IIU, IJU
!
DO III=1,NUMBPROFILER
CALL GET_DIM_EXT_ll ('B',IIU,IJU)
CALL SM_XYHAT(PLATOR,PLONOR, &
TPROFILER%LAT(III), TPROFILER%LON(III), &
TPROFILER%X(III), TPROFILER%Y(III) )
ENDDO
!
IF ( ANY(TPROFILER%LAT(:)==XUNDEF) .OR. ANY(TPROFILER%LON(:)==XUNDEF) ) THEN
WRITE(ILUOUT,*) 'Error in station position '
WRITE(ILUOUT,*) 'either LATitude or LONgitude segment'
WRITE(ILUOUT,*) 'definiton is not complete.'
!callabortstop
CALL CLOSE_ll(HLUOUT,IOSTAT=IRESP)
CALL ABORT
STOP
END IF
!
TPROFILER%STEP = MAX ( PTSTEP, TPROFILER%STEP )
!
!
END SUBROUTINE INI_INTERP_PROFILER_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!
END SUBROUTINE INI_POSPROFILER_n