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 comgeom, ONLY: cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, &
         unsapolsga1
    USE dimens_m, ONLY: iim, jjm
    use divergf_m, only: divergf
    USE filtreg_scal_m, ONLY: filtreg_scal
    use grad_m, only: grad
    use laplacien_gam_m, only: laplacien_gam
    use laplacien_m, only: laplacien
    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, size(xcov, 3))
    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)

       ! 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_scal(div, direct = .true., intensive = .true.)
    CALL grad(klevel, div, gdx, gdy)
    nugrads = (-1.)**ld * cdivu

    gdx = gdx * nugrads
    gdy = gdy * nugrads

  END SUBROUTINE gradiv2

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