trunk/dyn3d/nxgrad_gam.f90


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

SUBROUTINE nxgrad_gam(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 dimensions
  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))*cvscuvgam(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))*cuscvugam(ij)
    END DO
    DO ij = 1, iip1
      x(ij, l) = 0.
      x(ij+ip1jm, l) = 0.
    END DO

  END DO
  RETURN
END SUBROUTINE nxgrad_gam
1	guez	81
2			! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/nxgrad_gam.F,v 1.1.1.1 2004/05/19
3			! 12:53:06 lmdzadmin Exp $
4
5			SUBROUTINE nxgrad_gam(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	guez	265	USE dimensions
16	guez	81	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			DO l = 1, klevel
25
26			DO ij = 2, ip1jm
27			y(ij, l) = (rot(ij,l)-rot(ij-1,l))*cvscuvgam(ij)
28			END DO
29
30			! ..... correction pour y ( 1,j,l ) ......
31
32			! .... y(1,j,l)= y(iip1,j,l) ....
33			! DIR$ IVDEP
34			DO ij = 1, ip1jm, iip1
35			y(ij, l) = y(ij+iim, l)
36			END DO
37
38			DO ij = iip2, ip1jm
39			x(ij, l) = (rot(ij,l)-rot(ij-iip1,l))*cuscvugam(ij)
40			END DO
41			DO ij = 1, iip1
42			x(ij, l) = 0.
43			x(ij+ip1jm, l) = 0.
44			END DO
45
46			END DO
47			RETURN
48			END SUBROUTINE nxgrad_gam