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 v

    USE dimens_m, ONLY: iim, jjm
    USE filtreg_m, ONLY: filtreg
    use nr_util, only: assert, assert_eq
    use rotatf_m, only: rotatf

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

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

    ! Variables locales

    INTEGER klevel, iter
    REAL rot(iim + 1, jjm, size(xcov, 3)) , nugradrs

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

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