trunk/dyn3d/grad.f

!
! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/grad.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
!
      SUBROUTINE  grad(klevel, pg,pgx,pgy )
c
c      P. Le Van
c
c    ******************************************************************
c     .. calcul des composantes covariantes en x et y du gradient de g
c
c    ******************************************************************
c             pg        est un   argument  d'entree pour le s-prog
c       pgx  et  pgy    sont des arguments de sortie pour le s-prog
c
      use dimens_m
      use paramet_m
      IMPLICIT NONE
c
      INTEGER klevel
      REAL  pg( ip1jmp1,klevel )
      REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )
      INTEGER  l,ij
c
c
      DO 6 l = 1,klevel
c
      DO 2  ij = 1, ip1jmp1 - 1
      pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
   2  CONTINUE
c
c    .... correction pour  pgx(ip1,j,l)  ....
c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
CDIR$ IVDEP
      DO 3  ij = iip1, ip1jmp1, iip1
      pgx( ij,l ) = pgx( ij -iim,l )
   3  CONTINUE
c
      DO 4 ij = 1,ip1jm
      pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
   4  CONTINUE
c
   6  CONTINUE
      RETURN
      END
1	guez	3	!
2			! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/grad.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3			!
4			SUBROUTINE grad(klevel, pg,pgx,pgy )
5			c
6			c P. Le Van
7			c
8			c ******************************************************************
9			c .. calcul des composantes covariantes en x et y du gradient de g
10			c
11			c ******************************************************************
12			c pg est un argument d'entree pour le s-prog
13			c pgx et pgy sont des arguments de sortie pour le s-prog
14			c
15			use dimens_m
16			use paramet_m
17			IMPLICIT NONE
18			c
19			INTEGER klevel
20			REAL pg( ip1jmp1,klevel )
21			REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )
22			INTEGER l,ij
23			c
24			c
25			DO 6 l = 1,klevel
26			c
27			DO 2 ij = 1, ip1jmp1 - 1
28			pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
29			2 CONTINUE
30			c
31			c .... correction pour pgx(ip1,j,l) ....
32			c ... pgx(iip1,j,l)= pgx(1,j,l) ....
33			CDIR$ IVDEP
34			DO 3 ij = iip1, ip1jmp1, iip1
35			pgx( ij,l ) = pgx( ij -iim,l )
36			3 CONTINUE
37			c
38			DO 4 ij = 1,ip1jm
39			pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
40			4 CONTINUE
41			c
42			6 CONTINUE
43			RETURN
44			END