Newer
Older
WAUTELET Philippe
committed
!MNH_LIC Copyright 2000-2021 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
!-----------------------------------------------------------------
! #################
MODULE MODI_SPEC_VER_INT
! #################
!
INTERFACE
!
SUBROUTINE SPEC_VER_INT(KMI,PA_MNH, PA_SPEC)
INTEGER, INTENT(IN) :: KMI
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA_MNH
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PA_SPEC
!
END SUBROUTINE SPEC_VER_INT
!
END INTERFACE
!
END MODULE MODI_SPEC_VER_INT
!
! ######################################
SUBROUTINE SPEC_VER_INT(KMI, PA_MNH, PA_SPEC)
! ######################################
!
!
!!**** *SPEC_VER_INT* interpolates a MESONH field
!! on the LES output levels
!!
!! PURPOSE
!! -------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! V. Masson
!!
!! MODIFICATIONS
!! -------------
!! Original 07/02/00
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
WAUTELET Philippe
committed
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 05/01/2021: bugfix: CSPECTRA_LEVEL_TYPE='Z' computation was wrong
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_LES
USE MODD_PARAMETERS
!
USE MODE_ll
USE MODE_GATHER_ll
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
USE MODI_VER_INTERP_LIN
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KMI
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA_MNH
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PA_SPEC
!
!
! 0.2 declaration of local variables
!
INTEGER :: IRESP
INTEGER :: JK ! vertical loop counter
!
REAL, DIMENSION(SIZE(PA_MNH,1),SIZE(PA_MNH,2),SIZE(PA_SPEC,3)) :: ZA
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZA_ll
!
INTEGER :: IIMAX_ll ! total physical domain size (x)
INTEGER :: IJMAX_ll ! total physical domain size (y)
!
REAL, DIMENSION(SIZE(PA_SPEC,3)) :: ZA_MEAN
INTEGER :: JI, JJ ! loop counter
!-------------------------------------------------------------------------------
!
IF (CSPECTRA_LEVEL_TYPE=='N') THEN
PA_SPEC(:,:,:) = XUNDEF
RETURN
ELSE IF (CSPECTRA_LEVEL_TYPE=='K') THEN
DO JK = 1, NSPECTRA_K
ZA(:,:,JK) = PA_MNH(:,:,NSPECTRA_LEVELS(JK))
END DO
ELSE IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
WAUTELET Philippe
committed
ZA(:,:,:) = VER_INTERP_LIN(PA_MNH,NKLIN_CURRENT_SPEC,XCOEFLIN_CURRENT_SPEC)
WAUTELET Philippe
committed
ZA(:,:,:) = XUNDEF
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
END WHERE
ELSE
PRINT*, '-------> STOP in SPEC_VER_INT <----------'
!callabortstop
CALL ABORT
STOP
END IF
!
!-------------------------------------------------------------------------------
!
! ONE PROCESSOR ONLY
! ------------------
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
ALLOCATE(ZA_ll(IIMAX_ll+2*JPHEXT,IJMAX_ll+2*JPHEXT,NSPECTRA_K))
!
!ZA_ll(:,:,:) = ZA(:,:,:)
CALL GATHERALL_FIELD_ll('XY',ZA,ZA_ll,IRESP)
!
!-------------------------------------------------------------------------------
!
PA_SPEC(:,:,:) = ZA_ll(NLESn_IINF(KMI):NLESn_ISUP(KMI),NLESn_JINF(KMI):NLESn_JSUP(KMI),:)
!
DO JK=1,SIZE(PA_SPEC,3)
ZA_MEAN(JK) = SUM(PA_SPEC(:,:,JK)) / SIZE(PA_SPEC(:,:,JK))
END DO
DO JK=1,SIZE(PA_SPEC,3)
DO JJ=1,SIZE(PA_SPEC,2)
DO JI=1,SIZE(PA_SPEC,1)
PA_SPEC(JI,JJ,JK) = PA_SPEC(JI,JJ,JK) - ZA_MEAN(JK)
END DO
END DO
END DO
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE SPEC_VER_INT