Newer
Older
1
2
3
4
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
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/metrics.f90,v $ $Revision: 1.1.8.1.2.1 $ $Date: 2009/04/21 07:42:51 $
!-----------------------------------------------------------------
!-----------------------------------------------------------------
!-----------------------------------------------------------------
! ###################
MODULE MODI_METRICS
! ###################
INTERFACE
!
SUBROUTINE METRICS(PMAP,PDXHAT,PDYHAT,PZZ, &
PDXX,PDYY,PDZX,PDZY,PDZZ)
REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! Map factor
REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height in z direction
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZX ! metric coefficient dzx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZY ! metric coefficient dzy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZZ ! metric coefficient dzz
!
END SUBROUTINE METRICS
!
END INTERFACE
!
END MODULE MODI_METRICS
!
!
!
! #################################################################
SUBROUTINE METRICS(PMAP,PDXHAT,PDYHAT,PZZ, &
PDXX,PDYY,PDZX,PDZY,PDZZ)
! #################################################################
!
!!**** *METRICS* - routine to compute metric coefficients
!!
!! PURPOSE
!! -------
! The purpose of this routine is to compute the metric coefficients
! dxx,dyy,dzz,dzx,dzy
!
!!** METHOD
!! ------
!! The horizontal coefficients dxx and dyy (PDXX and PDYY arrays)
!! are computed according to the thinshell or no thinshell approximation
!! and to the cartesian or spherical geometry.
!!
!! EXTERNAL
!! --------
!! MXM,MYM,MZM : Shuman functions (mean operators)
!! DXM,DYM,DZM : Shuman functions (finite differences operators)
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
!! XRADIUS : earth radius
!!
!! Module MODD_CONF : contains configuration variables
!!
!! LTHINSHELL : Logical for thinshell approximation
!! .TRUE. = Thinshell approximation done
!! LCARTESIAN : Logical for cartesian geometry
!! .TRUE. = Cartesian geometry used
!!
!! REFERENCE
!! ---------
!! Book2 of documentation (routine METRICS)
!!
!! AUTHOR
!! ------
!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 12/07/94
!! 14/02/01 (V. Masson and J. Stein) PDZZ initialized below the surface
!! (influences the 3D turbulence of W) and PDXX,PDYY,PDZZ at the top
!! 19/03/2008 (J.Escobar) remove spread !!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_CONF
USE MODD_CST
!
USE MODI_SHUMAN
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! Map factor
REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZX ! metric coefficient dzx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZY ! metric coefficient dzy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZZ ! metric coefficient dzz
!
!* 0.2 declarations of local variables
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
INTEGER :: IKU ! Upper dimension in z direction
REAL :: ZD1 ! DELTA1 (switch 0/1) for thinshell
! approximation
INTEGER :: JI,JJ,JK
REAL, DIMENSION(SIZE(PDXHAT),SIZE(PDYHAT),SIZE(PZZ,3)) :: ZDZZ
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS :
! ----------------------------
IIU = SIZE(PDXHAT)
IJU = SIZE(PDYHAT)
IKU = SIZE(PZZ,3)
!
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE PDXX and PDYY :
! --------------------
!
IF (LTHINSHELL) THEN
ZD1=0.
ELSE
ZD1=1.
END IF
IF (.NOT.LCARTESIAN) THEN
ZDZZ(:,:,:) = MZF( 1.+ ZD1*PZZ(:,:,:)/XRADIUS)
DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PDXX(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDXHAT(JI) /PMAP(JI,JJ)
PDYY(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDYHAT(JJ) /PMAP(JI,JJ)
ENDDO ; ENDDO ; ENDDO
PDXX(:,:,:)=MXM(PDXX(:,:,:))
PDXX(:,:,IKU)=PDXX(:,:,IKU-1)
PDYY(:,:,:)=MYM(PDYY(:,:,:))
PDYY(:,:,IKU)=PDYY(:,:,IKU-1)
ELSE
DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PDXX(JI,JJ,JK) = PDXHAT(JI)
PDYY(JI,JJ,JK) = PDYHAT(JJ)
ENDDO ; ENDDO ; ENDDO
PDXX(:,:,:)=MXM(PDXX(:,:,:))
PDYY(:,:,:)=MYM(PDYY(:,:,:))
END IF
!
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE PDZX AND PDZY :
! ----------------------
!
PDZX(:,:,:) = DXM(PZZ(:,:,:))
!
PDZY(:,:,:) = DYM(PZZ(:,:,:))
!
!-------------------------------------------------------------------------------
!
!* 4. COMPUTE PDZZ :
! -------------
!
PDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
PDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1) ! same delta z in IKU and IKU -1
PDZZ(:,:,1) = PDZZ(:,:,2) ! same delta z in 1 and 2
!-----------------------------------------------------------------------------
!
END SUBROUTINE METRICS