trunk/dyn3d/nxgrad.f90


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/nxgrad.F,v 1.1.1.1 2004/05/19
! 12:53:05 lmdzadmin Exp $

SUBROUTINE nxgrad(klevel, rot, x, y)

  ! 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 dimens_m
  USE paramet_m
  USE comgeom
  IMPLICIT NONE

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