source: LMDZ4/branches/LMDZ4_AR5/libf/dyn3d/divgrad2.F @ 5394

Last change on this file since 5394 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.0 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
5c
6c     P. Le Van
7c
8c   ***************************************************************
9c
10c     .....   calcul de  (div( grad ))   de (  pext * h ) .....
11c   ****************************************************************
12c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
13c         divgra     est  un argument  de sortie pour le s-prg
14c
15      IMPLICIT NONE
16c
17#include "dimensions.h"
18#include "paramet.h"
19#include "comgeom2.h"
20#include "comdissipn.h"
21
22c    .......    variables en arguments   .......
23c
24      INTEGER klevel
25      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
26      REAL divgra( ip1jmp1,klevel)
27c
28c    .......    variables  locales    ..........
29c
30      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
31      INTEGER  l,ij,iter,lh
32c    ...................................................................
33
34c
35      signe    = (-1.)**lh
36      nudivgrs = signe * cdivh
37
38      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
39
40c
41      CALL laplacien( klevel, divgra, divgra )
42     
43      DO l = 1, klevel
44       DO ij = 1, ip1jmp1
45        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
46       ENDDO
47      ENDDO
48c
49      DO l = 1, klevel
50        DO ij = 1, ip1jmp1
51         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
52        ENDDO
53      ENDDO
54   
55c    ........    Iteration de l'operateur  laplacien_gam    ........
56c
57      DO  iter = 1, lh - 2
58       CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
59     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
60      ENDDO
61c
62c    ...............................................................
63 
64      DO l = 1, klevel
65        DO ij = 1, ip1jmp1
66          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
67        ENDDO
68      ENDDO
69c
70      CALL laplacien ( klevel, divgra, divgra )
71c
72      DO l  = 1,klevel
73      DO ij = 1,ip1jmp1
74      divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
75      ENDDO
76      ENDDO
77
78      RETURN
79      END
Note: See TracBrowser for help on using the repository browser.