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
61
62
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
234
235
236
237
238
239
240
! ######spl
MODULE MODI_COMPUTE_FRAC_ICE
! ############################
!
INTERFACE COMPUTE_FRAC_ICE
!
SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
!
END SUBROUTINE COMPUTE_FRAC_ICE3D
!
SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:,:), INTENT(IN) :: PT
REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
!
END SUBROUTINE COMPUTE_FRAC_ICE2D
SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:), INTENT(IN) :: PT
REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
END SUBROUTINE COMPUTE_FRAC_ICE1D
END INTERFACE
!
END MODULE MODI_COMPUTE_FRAC_ICE
!
! ##############################
MODULE MODI_COMPUTE_FRAC_ICE3D
! ##############################
INTERFACE
!
SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
!
END SUBROUTINE COMPUTE_FRAC_ICE3D
END INTERFACE
END MODULE MODI_COMPUTE_FRAC_ICE3D
!
! ##############################
MODULE MODI_COMPUTE_FRAC_ICE1D
! ##############################
INTERFACE
!
SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:), INTENT(IN) :: PT
REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
!
END SUBROUTINE COMPUTE_FRAC_ICE1D
END INTERFACE
END MODULE MODI_COMPUTE_FRAC_ICE1D
! ##########################################################
SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
! #################################################################
!
!
!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
!!
!! PURPOSE
!! -------
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! Julien PERGAUD * Meteo-France *
!!
!! MODIFICATIONS
!! -------------
!! Original 13/03/06
!! S. Riette April 2011 optimisation
!!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODI_COMPUTE_FRAC_ICE1D
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
!-------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: JJ, JK
!-------------------------------------------------------------------------
!
! 0.3 Initialisation
!
!
!----------------------------------------------------------------------------
!
! 1 Compute FRAC_ICE
! ----------------
!
DO JK=1, SIZE(PT,3)
DO JJ=1, SIZE(PT,2)
CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JJ,JK),PT(:,JJ,JK))
ENDDO
ENDDO
END SUBROUTINE COMPUTE_FRAC_ICE3D
! ##########################################################
SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
! ##########################################################
!
!
!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
!!
!! PURPOSE
!! -------
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! Julien PERGAUD * Meteo-France *
!!
!! MODIFICATIONS
!! -------------
!! Original 13/03/06
!! S. Riette April 2011 optimisation
!!
!! --------------------------------------------------------------------------
! 0. DECLARATIONS
! ------------
!
USE MODI_COMPUTE_FRAC_ICE1D
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
!-------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: JK
!-------------------------------------------------------------------------
!
! 0.3 Initialisation
!
!
!----------------------------------------------------------------------------
!
! 1 Compute FRAC_ICE
! ----------------
!
DO JK=1, SIZE(PT,2)
CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JK),PT(:,JK))
ENDDO
END SUBROUTINE COMPUTE_FRAC_ICE2D
! ##########################################################
SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
! ##########################################################
!
!
!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
!!
!! PURPOSE
!! -------
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! Julien PERGAUD * Meteo-France *
!!
!! MODIFICATIONS
!! -------------
!! Original 13/03/06
!! S. Riette April 2011 optimisation
!! S. Riette 08/2016 add option O
!!
!! --------------------------------------------------------------------------
! 0. DECLARATIONS
! ------------
!
USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
USE MODD_CST, ONLY : XTT
USE MODE_MSG
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
REAL, DIMENSION(:), INTENT(IN) :: PT ! temperature
REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
!
! 0.2 declaration of local variables
!
!
! 0.2 initialisation
!
!
!------------------------------------------------------------------------
! 1. Compute FRAC_ICE
!
IF (HFRAC_ICE=='T') THEN !using Temperature
PFRAC_ICE(:) = ( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX ) ! freezing interval
ELSEIF (HFRAC_ICE=='O') THEN !using Temperature with old formulae
PFRAC_ICE(:) = ( XTT - PT(:) ) / 40. ! freezing interval
ELSEIF (HFRAC_ICE=='N') THEN !No ice
PFRAC_ICE(:) = 0.
ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
!nothing to do
ELSE
WRITE(*,*) ' STOP'
WRITE(*,*) ' INVALID OPTION IN COMPUTE_FRAC_ICE, HFRAC_ICE=',HFRAC_ICE
CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','')
PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
END SUBROUTINE COMPUTE_FRAC_ICE1D