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 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))*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
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	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	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