source: LMDZ6/trunk/libf/dyn3d_common/divgrad2.F @ 4684

Last change on this file since 4684 was 4593, checked in by yann meurdesoif, 18 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • 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.