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	guez	266	module nxgrad_m
2	guez	81
3	guez	266	IMPLICIT NONE
4	guez	81
5	guez	266	contains
6	guez	81
7	guez	266	SUBROUTINE nxgrad(klevel, rot, x, y)
8	guez	81
9	guez	266	! From LMDZ4/libf/dyn3d/nxgrad.F, version 1.1.1.1, 2004/05/19 12:53:05
10			! P. Le Van
11	guez	81
12	guez	266	! calcul du gradient tourne de pi/2 du rotationnel du vect.v
13	guez	81
14	guez	266	! rot est un argument d'entree pour le s-prog
15			! x et y sont des arguments de sortie pour le s-prog
16	guez	81
17	guez	266	USE dimensions
18			USE paramet_m
19			USE comgeom
20	guez	81
21	guez	266	INTEGER, INTENT (IN) :: klevel
22			REAL rot(ip1jm, klevel), x(ip1jmp1, klevel), y(ip1jm, klevel)
23			INTEGER l, ij
24	guez	81
25	guez	266	!---------------------------------------------------------------------
26	guez	81
27	guez	266	DO l = 1, klevel
28	guez	81
29	guez	266	DO ij = 2, ip1jm
30			y(ij, l) = (rot(ij, l)-rot(ij-1, l))*cvsurcuv(ij)
31			END DO
32	guez	81
33	guez	266	! 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	guez	81	END DO
50	guez	266	RETURN
51			END SUBROUTINE nxgrad
52	guez	81
53	guez	266	end module nxgrad_m