6 |
|
|
7 |
SUBROUTINE divergf(klevel, x, y, div) |
SUBROUTINE divergf(klevel, x, y, div) |
8 |
|
|
9 |
! From libf/dyn3d/divergf.F, v 1.1.1.1 2004/05/19 12:53:05 |
! From libf/dyn3d/divergf.F, version 1.1.1.1 2004/05/19 12:53:05 |
10 |
|
|
11 |
! P. Le Van |
! P. Le Van |
12 |
|
|
13 |
! Calcule la divergence à tous les niveaux d'un vecteur de |
! Calcule la divergence à tous les niveaux d'un vecteur de |
14 |
! composantes x et y. x et y sont des composantes covariantes. |
! composantes x et y. x et y sont des composantes covariantes. |
15 |
|
|
16 |
USE dimens_m, ONLY: iim |
USE comgeom, ONLY: apoln, apols, cuvsurcv_2d, cvusurcu_2d, unsaire_2d |
17 |
USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmi1, ip1jmp1, jjp1 |
USE dimens_m, ONLY: iim, jjm |
18 |
USE comgeom, ONLY: apoln, apols, cuvsurcv, cvusurcu, unsaire |
USE filtreg_scal_m, ONLY: filtreg_scal |
|
USE filtreg_m, ONLY: filtreg |
|
|
|
|
|
! div est un argument de sortie pour le s-prog |
|
|
|
|
|
! variables en arguments |
|
19 |
|
|
20 |
INTEGER, intent(in):: klevel |
INTEGER, intent(in):: klevel |
21 |
REAL, intent(in):: x(ip1jmp1, klevel), y(ip1jm, klevel) |
REAL, intent(in):: x(iim + 1, jjm + 1, klevel), y(iim + 1, jjm, klevel) |
22 |
real div(ip1jmp1, klevel) |
real, intent(out):: div(iim + 1, jjm + 1, klevel) ! in (unit of x, y) m-2 |
23 |
|
|
24 |
! variables locales |
! Variables locales : |
25 |
|
|
26 |
INTEGER l, ij |
INTEGER l, i, j |
|
REAL aiy1(iip1) , aiy2(iip1) |
|
|
REAL sumypn, sumyps |
|
|
|
|
|
REAL SSUM |
|
27 |
|
|
28 |
!------------------------------------------------------------ |
!------------------------------------------------------------ |
29 |
|
|
30 |
DO l = 1, klevel |
DO l = 1, klevel |
31 |
DO ij = iip2, ip1jm - 1 |
forall (i = 2:iim + 1, j = 2:jjm) div(i, j, l) = cvusurcu_2d(i, j) & |
32 |
div(ij + 1, l) = cvusurcu(ij+1) * x(ij+1, l) & |
* x(i, j, l) - cvusurcu_2d(i - 1, j) * x(i - 1, j , l) & |
33 |
- cvusurcu(ij) * x(ij , l) + cuvsurcv(ij-iim) * y(ij-iim, l) & |
+ cuvsurcv_2d(i, j - 1) * y(i, j - 1, l) - cuvsurcv_2d(i, j) & |
34 |
- cuvsurcv(ij+1) * y(ij+1, l) |
* y(i, j, l) |
|
ENDDO |
|
|
|
|
|
DO ij = iip2, ip1jm, iip1 |
|
|
div(ij, l) = div(ij + iim, l) |
|
|
ENDDO |
|
35 |
|
|
36 |
! Calcul aux pôles |
div(1, 2:jjm, l) = div(iim + 1, 2:jjm, l) |
37 |
|
|
38 |
DO ij = 1, iim |
! Calcul aux pôles |
39 |
aiy1(ij) = cuvsurcv(ij) * y(ij , l) |
div(:, 1, l) = - SUM(cuvsurcv_2d(:iim, 1) * y(:iim, 1, l)) / apoln |
40 |
aiy2(ij) = cuvsurcv(ij+ ip1jmi1) * y(ij+ ip1jmi1, l) |
div(:, jjm + 1, l) = SUM(cuvsurcv_2d(:iim, jjm) * y(:iim, jjm, l)) & |
41 |
ENDDO |
/ apols |
|
sumypn = SSUM (iim, aiy1, 1) / apoln |
|
|
sumyps = SSUM (iim, aiy2, 1) / apols |
|
|
|
|
|
DO ij = 1, iip1 |
|
|
div(ij , l) = - sumypn |
|
|
div(ij + ip1jm, l) = sumyps |
|
|
ENDDO |
|
42 |
end DO |
end DO |
43 |
|
|
44 |
CALL filtreg(div, jjp1, klevel, 2, 2, .TRUE., 1) |
CALL filtreg_scal(div, direct = .true., intensive = .false.) |
45 |
|
|
46 |
DO l = 1, klevel |
DO l = 1, klevel |
47 |
DO ij = iip2, ip1jm |
div(:, 2:jjm, l) = div(:, 2:jjm, l) * unsaire_2d(:, 2:jjm) |
|
div(ij, l) = div(ij, l) * unsaire(ij) |
|
|
ENDDO |
|
48 |
ENDDO |
ENDDO |
49 |
|
|
50 |
END SUBROUTINE divergf |
END SUBROUTINE divergf |