trunk/dyn3d/nxgrad.f

module nxgrad_m

  IMPLICIT NONE

contains

  SUBROUTINE nxgrad(klevel, rot, x, y)

    ! From LMDZ4/libf/dyn3d/nxgrad.F, version 1.1.1.1, 2004/05/19 12:53:05
    ! P. Le Van

    ! calcul du gradient tourne de pi/2 du rotationnel du vect.v

    ! rot est un argument d'entree pour le s-prog
    ! x et y sont des arguments de sortie pour le s-prog

    USE dimensions
    USE paramet_m
    USE comgeom

    INTEGER, INTENT (IN) :: klevel
    REAL rot(ip1jm, klevel), x(ip1jmp1, klevel), y(ip1jm, klevel)
    INTEGER l, ij

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

    DO l = 1, klevel

       DO ij = 2, ip1jm
          y(ij, l) = (rot(ij, l)-rot(ij-1, l))*cvsurcuv(ij)
       END DO

       ! correction pour y (1, j, l)

       ! y(1, j, l)= y(iip1, j, l)
       ! DIR$ IVDEP
       DO ij = 1, ip1jm, iip1
          y(ij, l) = y(ij+iim, l)
       END DO

       DO ij = iip2, ip1jm
          x(ij, l) = (rot(ij, l)-rot(ij-iip1, l))*cusurcvu(ij)
       END DO
       DO ij = 1, iip1
          x(ij, l) = 0.
          x(ij+ip1jm, l) = 0.
       END DO

    END DO
    RETURN
  END SUBROUTINE nxgrad

end module nxgrad_m
1	module nxgrad_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE nxgrad(klevel, rot, x, y)
8
9	! From LMDZ4/libf/dyn3d/nxgrad.F, version 1.1.1.1, 2004/05/19 12:53:05
10	! P. Le Van
11
12	! calcul du gradient tourne de pi/2 du rotationnel du vect.v
13
14	! rot est un argument d'entree pour le s-prog
15	! x et y sont des arguments de sortie pour le s-prog
16
17	USE dimensions
18	USE paramet_m
19	USE comgeom
20
21	INTEGER, INTENT (IN) :: klevel
22	REAL rot(ip1jm, klevel), x(ip1jmp1, klevel), y(ip1jm, klevel)
23	INTEGER l, ij
24
25	!---------------------------------------------------------------------
26
27	DO l = 1, klevel
28
29	DO ij = 2, ip1jm
30	y(ij, l) = (rot(ij, l)-rot(ij-1, l))*cvsurcuv(ij)
31	END DO
32
33	! correction pour y (1, j, l)
34
35	! y(1, j, l)= y(iip1, j, l)
36	! DIR$ IVDEP
37	DO ij = 1, ip1jm, iip1
38	y(ij, l) = y(ij+iim, l)
39	END DO
40
41	DO ij = iip2, ip1jm
42	x(ij, l) = (rot(ij, l)-rot(ij-iip1, l))*cusurcvu(ij)
43	END DO
44	DO ij = 1, iip1
45	x(ij, l) = 0.
46	x(ij+ip1jm, l) = 0.
47	END DO
48
49	END DO
50	RETURN
51	END SUBROUTINE nxgrad
52
53	end module nxgrad_m