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

Diff of /trunk/dyn3d/dteta1.f

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

trunk/libf/dyn3d/dteta1.f revision 43 by guez, Fri Apr 8 12:43:31 2011 UTC trunk/libf/dyn3d/dteta1.f90 revision 44 by guez, Wed Apr 13 12:29:18 2011 UTC
# Line 1  Line 1 
1  !  SUBROUTINE dteta1(teta, pbaru, pbarv, dteta)
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dteta1.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $  
 !  
       SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)  
       use dimens_m  
       use paramet_m  
       use logic  
       use filtreg_m, only: filtreg  
2    
3        IMPLICIT NONE    ! From LMDZ4/libf/dyn3d/dteta1.F, version 1.1.1.1 2004/05/19 12:53:06
4      ! Auteurs : P. Le Van, F. Forget
5    
6  c=======================================================================    ! Calcul du terme de convergence horizontale du flux d'enthalpie
7  c    ! potentielle.
 c   Auteur:  P. Le Van  
 c   -------  
 c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)  
 c  
 c   ********************************************************************  
 c   ... calcul du terme de convergence horizontale du flux d'enthalpie  
 c        potentielle   ......  
 c   ********************************************************************  
 c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....  
 c     dteta               sont des arguments de sortie pour le s-pg ....  
 c  
 c=======================================================================  
8    
9      ! dteta est un argument de sortie pour le s-pg
10    
11      use dimens_m
12      use paramet_m
13      use logic
14      use filtreg_m, only: filtreg
15    
16        REAL, intent(in):: teta( ip1jmp1,llm )    IMPLICIT NONE
       real pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)  
       REAL dteta( ip1jmp1,llm )  
       INTEGER   l,ij  
17    
18        REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )    REAL, intent(in):: teta(ip1jmp1, llm), pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
19      REAL dteta(ip1jmp1, llm)
20      INTEGER l, ij
21    
22  c    REAL hbyv(ip1jm, llm), hbxu(ip1jmp1, llm)
23    
24        DO 5 l = 1,llm    !----------------------------------------------------------------
25    
26        DO 1  ij = iip2, ip1jm - 1    DO l = 1, llm
27        hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )       DO ij = iip2, ip1jm - 1
28     1  CONTINUE          hbxu(ij, l) = pbaru(ij, l) * 0.5 * (teta(ij, l) + teta(ij + 1, l))
29         end DO
30    
31  c    .... correction pour  hbxu(iip1,j,l)  .....       DO ij = iip1+ iip1, ip1jm, iip1
32  c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....          hbxu(ij, l) = hbxu(ij - iim, l)
33         end DO
34    
35  CDIR$ IVDEP       DO ij = 1, ip1jm
36        DO 2 ij = iip1+ iip1, ip1jm, iip1          hbyv(ij, l)= pbarv(ij, l) * 0.5 * (teta(ij, l) + teta(ij + iip1, l))
37        hbxu( ij, l ) = hbxu( ij - iim, l )       end DO
38     2  CONTINUE    end DO
39    
40      CALL convflu(hbxu, hbyv, llm, dteta)
41    
42        DO 3 ij = 1,ip1jm    ! stockage dans dh de la convergence horizont. filtree' du flux
43        hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )    ! d'enthalpie potentielle
44     3  CONTINUE    CALL filtreg(dteta, jjp1, llm, 2, 2, .true., 1)
45    
46     5  CONTINUE  END SUBROUTINE dteta1
   
   
         CALL  convflu ( hbxu, hbyv, llm, dteta )  
   
   
 c    stockage dans  dh de la convergence horizont. filtree' du  flux  
 c                  ....                           ...........  
 c           d'enthalpie potentielle .  
   
       CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)  
   
 c  
       RETURN  
       END  
Legend:
Removed from v.43  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.21