source: LMDZ5/trunk/libf/dyn3dmem/divgrad2.F @ 1632

Last change on this file since 1632 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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.