/[lmdze]/trunk/dyn3d/grad.f
ViewVC logotype

Diff of /trunk/dyn3d/grad.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/grad.f revision 55 by guez, Mon Dec 12 13:25:01 2011 UTC trunk/dyn3d/grad.f revision 103 by guez, Fri Aug 29 13:00:05 2014 UTC
# Line 1  Line 1 
1  !  module grad_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/grad.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
3  !    IMPLICIT NONE
4        SUBROUTINE  grad(klevel, pg,pgx,pgy )  
5  c  contains
6  c      P. Le Van  
7  c    SUBROUTINE grad(klevel, g, gx, gy)
8  c    ******************************************************************  
9  c     .. calcul des composantes covariantes en x et y du gradient de g      ! From LMDZ4/libf/dyn3d/grad.F, version 1.1.1.1 2004/05/19 12:53:05
10  c      ! P. Le Van
11  c    ******************************************************************  
12  c             pg        est un   argument  d'entree pour le s-prog      ! Calcul des composantes covariantes en x et y du gradient de g.
13  c       pgx  et  pgy    sont des arguments de sortie pour le s-prog  
14  c      USE dimens_m, ONLY: iim, jjm
15        use dimens_m  
16        use paramet_m      INTEGER, intent(in):: klevel
17        IMPLICIT NONE      REAL, intent(in):: g(iim + 1, jjm + 1, klevel)
18  c      REAL, intent(out):: gx(iim + 1, jjm + 1, klevel) , gy(iim + 1, jjm, klevel)
19        INTEGER, intent(in):: klevel  
20        REAL  pg( ip1jmp1,klevel )      ! Local:
21        REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )      INTEGER i, j
22        INTEGER  l,ij  
23  c      !----------------------------------------------------------------
24  c  
25        DO 6 l = 1,klevel      forall (i = 1:iim) gx(i, :, :) = g(i + 1, :, :) - g(i, :, :)
26  c      gx(iim + 1, :, :)= gx(1, :, :)
27        DO 2  ij = 1, ip1jmp1 - 1  
28        pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )      forall (j = 1:jjm) gy(:, j, :) = g(:, j, :) - g(:, j + 1, :)
29     2  CONTINUE  
30  c    END SUBROUTINE grad
31  c    .... correction pour  pgx(ip1,j,l)  ....  
32  c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....  end module grad_m
 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  
Legend:
Removed from v.55  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.21