/[lmdze]/trunk/dyn3d/Dissipation/divgrad2.f
ViewVC logotype

Diff of /trunk/dyn3d/Dissipation/divgrad2.f

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

trunk/libf/dyn3d/Dissipation/divgrad2.f revision 55 by guez, Mon Dec 12 13:25:01 2011 UTC trunk/dyn3d/Dissipation/divgrad2.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 1  Line 1 
1  !  module divgrad2_m
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/divgrad2.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $  
 !  
       SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra, cdivh )  
 c  
 c     P. Le Van  
 c  
 c   ***************************************************************  
 c  
 c     .....   calcul de  (div( grad ))   de (  pext * h ) .....  
 c   ****************************************************************  
 c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg  
 c         divgra     est  un argument  de sortie pour le s-prg  
 c  
       use dimens_m  
       use paramet_m  
       use comgeom  
       IMPLICIT NONE  
 c  
   
 c    .......    variables en arguments   .......  
 c  
       INTEGER klevel  
       REAL, intent(in):: h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel)  
       REAL divgra( ip1jmp1,klevel)  
       real, intent(in):: cdivh  
 c  
 c    .......    variables  locales    ..........  
 c  
       REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )  
       INTEGER  l,ij,iter  
       integer, intent(in):: lh  
 c    ...................................................................  
   
 c  
       signe    = (-1.)**lh  
       nudivgrs = signe * cdivh  
       divgra = h  
   
 c  
       CALL laplacien( klevel, divgra, divgra )  
       
       DO l = 1, klevel  
        DO ij = 1, ip1jmp1  
         sqrtps( ij,l ) = SQRT( deltapres(ij,l) )  
        ENDDO  
       ENDDO  
 c  
       DO l = 1, klevel  
         DO ij = 1, ip1jmp1  
          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)  
         ENDDO  
       ENDDO  
     
 c    ........    Iteration de l'operateur  laplacien_gam    ........  
 c  
       DO  iter = 1, lh - 2  
        CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,  
      *                     unsapolnga2, unsapolsga2,  divgra, divgra )  
       ENDDO  
 c  
 c    ...............................................................  
   
       DO l = 1, klevel  
         DO ij = 1, ip1jmp1  
           divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)  
         ENDDO  
       ENDDO  
 c  
       CALL laplacien ( klevel, divgra, divgra )  
 c  
       DO l  = 1,klevel  
       DO ij = 1,ip1jmp1  
       divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)  
       ENDDO  
       ENDDO  
2    
3        RETURN    IMPLICIT NONE
4        END  
5    contains
6    
7      SUBROUTINE divgrad2(klevel, h, deltapres, lh, divgra, cdivh)
8    
9        ! From LMDZ4/libf/dyn3d/divgrad2.F, version 1.1.1.1 2004/05/19 12:53:06
10        ! P. Le Van
11    
12        ! Calcul de div(grad) de (pext * h)
13    
14        USE comgeom, ONLY: cuvscvgam2, cvuscugam2, unsair_gam2, unsapolnga2, &
15             unsapolsga2
16        use laplacien_gam_m, only: laplacien_gam
17        USE laplacien_m, ONLY: laplacien
18        USE paramet_m, ONLY: ip1jmp1
19    
20        INTEGER, intent(in):: klevel
21        REAL, intent(in):: h(ip1jmp1, klevel), deltapres(ip1jmp1, klevel)
22        integer, intent(in):: lh
23        REAL, intent(out):: divgra(ip1jmp1, klevel)
24        real, intent(in):: cdivh
25    
26        ! Variables locales
27        REAL sqrtps(ip1jmp1, klevel)
28        INTEGER iter
29    
30        !-----------------------------------------------------------------
31    
32        divgra = h
33        CALL laplacien(klevel, divgra)
34        sqrtps = SQRT(deltapres)
35        divgra = divgra * sqrtps
36    
37        ! ItĂ©ration de l'opĂ©rateur laplacien_gam
38        DO iter = 1, lh - 2
39           CALL laplacien_gam(klevel, cuvscvgam2, cvuscugam2, unsair_gam2, &
40                unsapolnga2, unsapolsga2, divgra, divgra)
41        ENDDO
42    
43        divgra = divgra * sqrtps
44        CALL laplacien(klevel, divgra)
45        divgra = (-1.)**lh * cdivh * divgra / deltapres
46    
47      END SUBROUTINE divgrad2
48    
49    end module divgrad2_m

Legend:
Removed from v.55  
changed lines
  Added in v.254

  ViewVC Help
Powered by ViewVC 1.1.21