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
MODULE MODE_EXTRAPOL
INTERFACE EXTRAPOL
MODULE PROCEDURE EXTRAPOL3D,EXTRAPOL3DN,EXTRAPOL2D,EXTRAPOL2DN
END INTERFACE
CONTAINS
SUBROUTINE EXTRAPOL3D(HBORD,PTAB)
USE MODD_LBC_n
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
CHARACTER :: HBORD
REAL, DIMENSION(:,:,:) :: PTAB
!
!* 0.2 Declarations of local variables
!
INTEGER :: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE,IKE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
!* 1. EXTRAPOLE LATERAL BOUNDARY CONDITIONS :
! ---------------------------------------
!
!RETURN
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
SELECT CASE (HBORD)
CASE ('W')
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
PTAB(IIB-1,:,:) = 2. * PTAB(IIB,:,:) - PTAB(IIB+1,:,:)
CASE ('E')
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
PTAB(IIE+1,:,:) = 2. * PTAB(IIE,:,:) - PTAB(IIE-1,:,:)
CASE ('S')
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
PTAB(:,IJB-1,:) = 2. * PTAB(:,IJB,:) - PTAB(:,IJB+1,:)
CASE ('N')
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
PTAB(:,IJE+1,:) = 2. * PTAB(:,IJE,:) - PTAB(:,IJE-1,:)
CASE DEFAULT
END SELECT
END SUBROUTINE EXTRAPOL3D
SUBROUTINE EXTRAPOL3DN(HBORD,P1,P2,P3,P4,P5,P6 )
IMPLICIT NONE
CHARACTER :: HBORD
REAL, DIMENSION(:,:,:) :: P1,P2
REAL, DIMENSION(:,:,:) , OPTIONAL :: P3,P4,P5,P6
CALL EXTRAPOL(HBORD,P1)
CALL EXTRAPOL(HBORD,P2)
IF (PRESENT(P3)) CALL EXTRAPOL(HBORD,P3)
IF (PRESENT(P4)) CALL EXTRAPOL(HBORD,P4)
IF (PRESENT(P5)) CALL EXTRAPOL(HBORD,P5)
IF (PRESENT(P6)) CALL EXTRAPOL(HBORD,P6)
END SUBROUTINE EXTRAPOL3DN
SUBROUTINE EXTRAPOL2D(HBORD,PTAB)
USE MODD_LBC_n
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
CHARACTER :: HBORD
REAL, DIMENSION(:,:) :: PTAB
!
!* 0.2 Declarations of local variables
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
!* 1. EXTRAPOLE LATERAL BOUNDARY CONDITIONS :
! ---------------------------------------
!
!RETURN
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
SELECT CASE (HBORD)
CASE ('W')
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
PTAB(IIB-1,:) = 2. * PTAB(IIB,:) - PTAB(IIB+1,:)
CASE ('E')
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
PTAB(IIE+1,:) = 2. * PTAB(IIE,:) - PTAB(IIE-1,:)
CASE ('S')
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
PTAB(:,IJB-1) = 2. * PTAB(:,IJB) - PTAB(:,IJB+1)
CASE ('N')
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
PTAB(:,IJE+1) = 2. * PTAB(:,IJE) - PTAB(:,IJE-1)
CASE DEFAULT
END SELECT
END SUBROUTINE EXTRAPOL2D
SUBROUTINE EXTRAPOL2DN(HBORD,P1,P2,P3,P4,P5,P6 )
IMPLICIT NONE
CHARACTER :: HBORD
REAL, DIMENSION(:,:) :: P1,P2
REAL, DIMENSION(:,:) , OPTIONAL :: P3,P4,P5,P6
CALL EXTRAPOL(HBORD,P1)
CALL EXTRAPOL(HBORD,P2)
IF (PRESENT(P3)) CALL EXTRAPOL(HBORD,P3)
IF (PRESENT(P4)) CALL EXTRAPOL(HBORD,P4)
IF (PRESENT(P5)) CALL EXTRAPOL(HBORD,P5)
IF (PRESENT(P6)) CALL EXTRAPOL(HBORD,P6)
END SUBROUTINE EXTRAPOL2DN
END MODULE MODE_EXTRAPOL