dyn3d/Dissipation/nxgraro2.f

module nxgraro2_m

  IMPLICIT NONE

contains

  SUBROUTINE nxgraro2(xcov, ycov, lr, grx, gry, crot)

    ! From LMDZ4/libf/dyn3d/nxgraro2.F, version 1.1.1.1, 2004/05/19 12:53:06

    ! P. Le Van
    ! Calcul de nxgrad(rot) du vecteur (xcov, ycov).

    USE filtreg_v_m, ONLY: filtreg_v
    use nr_util, only: assert, assert_eq
    use nxgrad_m, only: nxgrad
    use rotatf_m, only: rotatf

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

    integer, intent(in):: lr
    REAL, intent(out):: grx(:, :, :) ! (iim + 1, jjm + 1, klevel)
    REAL, intent(out):: gry(:, :, :) ! (iim + 1, jjm, klevel)
    real, intent(in):: crot

    ! Local:
    INTEGER klevel, iter
    REAL rot(size(ycov, 1), size(ycov, 2), size(ycov, 3)) , nugradrs

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

    call assert(size(xcov, 1) == [size(ycov, 1), size(grx, 1), size(gry, 1)], &
         "nxgraro2 iim")
    call assert(size(xcov, 2) - 1 == [size(ycov, 2), size(grx, 2) - 1, &
         size(gry, 2)], "nxgraro2 jjm")
    klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(grx, 3), &
         size(gry, 3), "nxgraro2 klevel")

    grx = xcov
    gry = ycov

    CALL rotatf(klevel, grx, gry, rot)
    CALL laplacien_rot(klevel, rot, rot, grx, gry)

    ! Itération de l'opérateur laplacien_rotgam
    DO iter = 1, lr - 2
       CALL laplacien_rotgam(klevel, rot, rot)
    ENDDO

    CALL filtreg_v(rot, intensive = .true.)
    CALL nxgrad(klevel, rot, grx, gry)

    nugradrs = (-1.)**lr * crot
    grx = grx * nugradrs
    gry = gry * nugradrs

  END SUBROUTINE nxgraro2

end module nxgraro2_m
1	guez	65	module nxgraro2_m
2	guez	3
3	guez	65	IMPLICIT NONE
4
5			contains
6
7			SUBROUTINE nxgraro2(xcov, ycov, lr, grx, gry, crot)
8
9	guez	266	! From LMDZ4/libf/dyn3d/nxgraro2.F, version 1.1.1.1, 2004/05/19 12:53:06
10	guez	65
11			! P. Le Van
12	guez	266	! Calcul de nxgrad(rot) du vecteur (xcov, ycov).
13	guez	65
14	guez	137	USE filtreg_v_m, ONLY: filtreg_v
15	guez	65	use nr_util, only: assert, assert_eq
16	guez	266	use nxgrad_m, only: nxgrad
17	guez	107	use rotatf_m, only: rotatf
18	guez	65
19	guez	266	! Composantes covariantes :
20			REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, klevel)
21			REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, klevel)
22	guez	65
23			integer, intent(in):: lr
24	guez	266	REAL, intent(out):: grx(:, :, :) ! (iim + 1, jjm + 1, klevel)
25			REAL, intent(out):: gry(:, :, :) ! (iim + 1, jjm, klevel)
26	guez	65	real, intent(in):: crot
27
28	guez	266	! Local:
29	guez	65	INTEGER klevel, iter
30	guez	266	REAL rot(size(ycov, 1), size(ycov, 2), size(ycov, 3)) , nugradrs
31	guez	65
32			!----------------------------------------------------------
33
34	guez	266	call assert(size(xcov, 1) == [size(ycov, 1), size(grx, 1), size(gry, 1)], &
35			"nxgraro2 iim")
36			call assert(size(xcov, 2) - 1 == [size(ycov, 2), size(grx, 2) - 1, &
37			size(gry, 2)], "nxgraro2 jjm")
38	guez	65	klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(grx, 3), &
39			size(gry, 3), "nxgraro2 klevel")
40
41			grx = xcov
42			gry = ycov
43
44			CALL rotatf(klevel, grx, gry, rot)
45			CALL laplacien_rot(klevel, rot, rot, grx, gry)
46
47			! Itération de l'opérateur laplacien_rotgam
48			DO iter = 1, lr - 2
49			CALL laplacien_rotgam(klevel, rot, rot)
50			ENDDO
51
52	guez	137	CALL filtreg_v(rot, intensive = .true.)
53	guez	65	CALL nxgrad(klevel, rot, grx, gry)
54
55			nugradrs = (-1.)*lr crot
56			grx = grx * nugradrs
57			gry = gry * nugradrs
58
59			END SUBROUTINE nxgraro2
60
61			end module nxgraro2_m