trunk/dyn3d/divergf.f

module divergf_m

  IMPLICIT NONE

contains

  SUBROUTINE divergf(klevel, x, y, div)

    ! From libf/dyn3d/divergf.F, v 1.1.1.1 2004/05/19 12:53:05

    ! P. Le Van
    ! Calcule la divergence à tous les niveaux d'un vecteur de
    ! composantes x et y. x et y sont des composantes covariantes.

    USE dimens_m, ONLY: iim
    USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmi1, ip1jmp1, jjp1
    USE comgeom, ONLY: apoln, apols, cuvsurcv, cvusurcu, unsaire
    USE filtreg_m, ONLY: filtreg

    ! div est un argument de sortie pour le s-prog

    ! variables en arguments 

    INTEGER, intent(in):: klevel
    REAL, intent(in):: x(ip1jmp1, klevel), y(ip1jm, klevel)
    real div(ip1jmp1, klevel)

    ! variables locales 

    INTEGER l, ij
    REAL aiy1(iip1) , aiy2(iip1)
    REAL sumypn, sumyps

    REAL SSUM

    !------------------------------------------------------------

    DO l = 1, klevel
       DO ij = iip2, ip1jm - 1
          div(ij + 1, l) = cvusurcu(ij+1) * x(ij+1, l) &
               - cvusurcu(ij) * x(ij , l) + cuvsurcv(ij-iim) * y(ij-iim, l) &
               - cuvsurcv(ij+1) * y(ij+1, l) 
       ENDDO

       DO ij = iip2, ip1jm, iip1
          div(ij, l) = div(ij + iim, l)
       ENDDO

       ! Calcul aux pôles 

       DO ij = 1, iim
          aiy1(ij) = cuvsurcv(ij) * y(ij , l)
          aiy2(ij) = cuvsurcv(ij+ ip1jmi1) * y(ij+ ip1jmi1, l)
       ENDDO
       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
    end DO

    CALL filtreg(div, jjp1, klevel, 2, 2, .TRUE., 1)

    DO l = 1, klevel
       DO ij = iip2, ip1jm
          div(ij, l) = div(ij, l) * unsaire(ij) 
       ENDDO
    ENDDO

  END SUBROUTINE divergf

end module divergf_m
1	module divergf_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE divergf(klevel, x, y, div)
8
9	! From libf/dyn3d/divergf.F, v 1.1.1.1 2004/05/19 12:53:05
10
11	! P. Le Van
12	! Calcule la divergence à tous les niveaux d'un vecteur de
13	! composantes x et y. x et y sont des composantes covariantes.
14
15	USE dimens_m, ONLY: iim
16	USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmi1, ip1jmp1, jjp1
17	USE comgeom, ONLY: apoln, apols, cuvsurcv, cvusurcu, unsaire
18	USE filtreg_m, ONLY: filtreg
19
20	! div est un argument de sortie pour le s-prog
21
22	! variables en arguments
23
24	INTEGER, intent(in):: klevel
25	REAL, intent(in):: x(ip1jmp1, klevel), y(ip1jm, klevel)
26	real div(ip1jmp1, klevel)
27
28	! variables locales
29
30	INTEGER l, ij
31	REAL aiy1(iip1) , aiy2(iip1)
32	REAL sumypn, sumyps
33
34	REAL SSUM
35
36	!------------------------------------------------------------
37
38	DO l = 1, klevel
39	DO ij = iip2, ip1jm - 1
40	div(ij + 1, l) = cvusurcu(ij+1) * x(ij+1, l) &
41	- cvusurcu(ij) * x(ij , l) + cuvsurcv(ij-iim) * y(ij-iim, l) &
42	- cuvsurcv(ij+1) * y(ij+1, l)
43	ENDDO
44
45	DO ij = iip2, ip1jm, iip1
46	div(ij, l) = div(ij + iim, l)
47	ENDDO
48
49	! Calcul aux pôles
50
51	DO ij = 1, iim
52	aiy1(ij) = cuvsurcv(ij) * y(ij , l)
53	aiy2(ij) = cuvsurcv(ij+ ip1jmi1) * y(ij+ ip1jmi1, l)
54	ENDDO
55	sumypn = SSUM (iim, aiy1, 1) / apoln
56	sumyps = SSUM (iim, aiy2, 1) / apols
57
58	DO ij = 1, iip1
59	div(ij , l) = - sumypn
60	div(ij + ip1jm, l) = sumyps
61	ENDDO
62	end DO
63
64	CALL filtreg(div, jjp1, klevel, 2, 2, .TRUE., 1)
65
66	DO l = 1, klevel
67	DO ij = iip2, ip1jm
68	div(ij, l) = div(ij, l) * unsaire(ij)
69	ENDDO
70	ENDDO
71
72	END SUBROUTINE divergf
73
74	end module divergf_m