dyn3d/Dissipation/gradiv2.f

module gradiv2_m

  IMPLICIT NONE

contains

  SUBROUTINE gradiv2(xcov, ycov, ld, gdx, gdy, cdivu)

    ! From LMDZ4/libf/dyn3d/gradiv2.F, version 1.1.1.1 2004/05/19 12:53:07
    ! P. Le Van
    ! Calcul du gradient de la divergence du vecteur v.

    USE dimens_m, ONLY : iim, jjm, llm
    use divergf_m, only: divergf
    USE comgeom, ONLY : cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, &
         unsapolsga1
    USE filtreg_m, ONLY : filtreg
    use grad_m, only: grad
    use nr_util, only: assert_eq, assert

    ! Composantes covariantes de v :
    REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, klevel)
    REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, klevel)

    integer, intent(in):: ld
    REAL, intent(out):: gdx(:, :, :) ! (iim + 1, jjm + 1, klevel)
    REAL, intent(out):: gdy(:, :, :) ! (iim + 1, jjm, klevel)
    real, intent(in):: cdivu

    ! Variables locales :
    REAL nugrads, div(iim + 1, jjm + 1, llm)
    INTEGER iter, klevel

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

    call assert((/size(xcov, 1), size(ycov, 1), size(gdx, 1), size(gdy, 1)/) &
         == iim + 1, "gradiv2 iim")
    call assert((/size(xcov, 2) - 1, size(ycov, 2), size(gdx, 2) - 1, &
         size(gdy, 2)/) == jjm, "gradiv2 iim")
    klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(gdx, 3), &
         size(gdy, 3), "gradiv2 klevel")

    CALL divergf(klevel, xcov, ycov, div)

    IF (ld > 1) THEN
       CALL laplacien(klevel, div, div)

       ! Itération de l'opérateur laplacien_gam
       DO iter = 1, ld -2
          CALL laplacien_gam(klevel, cuvscvgam1, cvuscugam1, unsair_gam1, &
               unsapolnga1, unsapolsga1, div, div)
       END DO
    ENDIF

    CALL filtreg(div, jjm + 1, klevel, 2, 1, .TRUE., 1)
    CALL grad(klevel, div, gdx, gdy)
    nugrads = (-1.)**ld * cdivu

    gdx = gdx * nugrads
    gdy = gdy * nugrads

  END SUBROUTINE gradiv2

end module gradiv2_m
1	module gradiv2_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE gradiv2(xcov, ycov, ld, gdx, gdy, cdivu)
8
9	! From LMDZ4/libf/dyn3d/gradiv2.F, version 1.1.1.1 2004/05/19 12:53:07
10	! P. Le Van
11	! Calcul du gradient de la divergence du vecteur v.
12
13	USE dimens_m, ONLY : iim, jjm, llm
14	use divergf_m, only: divergf
15	USE comgeom, ONLY : cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, &
16	unsapolsga1
17	USE filtreg_m, ONLY : filtreg
18	use grad_m, only: grad
19	use nr_util, only: assert_eq, assert
20
21	! Composantes covariantes de v :
22	REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, klevel)
23	REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, klevel)
24
25	integer, intent(in):: ld
26	REAL, intent(out):: gdx(:, :, :) ! (iim + 1, jjm + 1, klevel)
27	REAL, intent(out):: gdy(:, :, :) ! (iim + 1, jjm, klevel)
28	real, intent(in):: cdivu
29
30	! Variables locales :
31	REAL nugrads, div(iim + 1, jjm + 1, llm)
32	INTEGER iter, klevel
33
34	!--------------------------------------------------------------
35
36	call assert((/size(xcov, 1), size(ycov, 1), size(gdx, 1), size(gdy, 1)/) &
37	== iim + 1, "gradiv2 iim")
38	call assert((/size(xcov, 2) - 1, size(ycov, 2), size(gdx, 2) - 1, &
39	size(gdy, 2)/) == jjm, "gradiv2 iim")
40	klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(gdx, 3), &
41	size(gdy, 3), "gradiv2 klevel")
42
43	CALL divergf(klevel, xcov, ycov, div)
44
45	IF (ld > 1) THEN
46	CALL laplacien(klevel, div, div)
47
48	! Itération de l'opérateur laplacien_gam
49	DO iter = 1, ld -2
50	CALL laplacien_gam(klevel, cuvscvgam1, cvuscugam1, unsair_gam1, &
51	unsapolnga1, unsapolsga1, div, div)
52	END DO
53	ENDIF
54
55	CALL filtreg(div, jjm + 1, klevel, 2, 1, .TRUE., 1)
56	CALL grad(klevel, div, gdx, gdy)
57	nugrads = (-1.)*ld cdivu
58
59	gdx = gdx * nugrads
60	gdy = gdy * nugrads
61
62	END SUBROUTINE gradiv2
63
64	end module gradiv2_m