/[lmdze]/trunk/dyn3d/addfi.f90
ViewVC logotype

Diff of /trunk/dyn3d/addfi.f90

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

revision 44 by guez, Wed Apr 13 12:29:18 2011 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 4  module addfi_m Line 4  module addfi_m
4    
5  contains  contains
6    
7    SUBROUTINE addfi(nq, pdt, pucov, pvcov, teta, pq, pps, pdufi, pdvfi, pdhfi,&    SUBROUTINE addfi(nq, ucov, vcov, teta, pq, pps, dufi, dvfi, pdhfi, &
8         pdqfi, pdpfi)         pdqfi, pdpfi)
9    
10      ! From dyn3d/addfi.F,v 1.1.1.1 2004/05/19 12:53:06      ! From dyn3d/addfi.F, v 1.1.1.1 2004/05/19 12:53:06
11    
12      !    Addition of the physical tendencies      ! Addition of the physical tendencies
13    
14      !    Interface :      USE comconst, ONLY: dtphys
15        USE comgeom, ONLY: aire, apoln, apols
16      !      Input :      USE dimens_m, ONLY: iim, llm
17        USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
18      !      pdt                    time step of integration  
19      !      pucov(ip1jmp1,llm)     first component of the covariant velocity      INTEGER, intent(in):: nq
20      !      pvcov(ip1ip1jm,llm)    second component of the covariant velocity  
21      !      teta(ip1jmp1,llm)     potential temperature      REAL, intent(inout):: ucov(ip1jmp1, llm), vcov(ip1jm, llm)
22      !      pts(ip1jmp1,llm)       surface temperature      ! first and second components of the covariant velocity
23      !      pdufi(ip1jmp1,llm)     |  
24      !      pdvfi(ip1jm,llm)       |   respective      REAL, intent(inout):: teta(ip1jmp1, llm) ! potential temperature
25      !      pdhfi(ip1jmp1)         |      tendencies      real, intent(inout):: pq(ip1jmp1, llm, nq), pps(ip1jmp1)
26      !      pdtsfi(ip1jmp1)        |      REAL, intent(in):: dufi(ip1jmp1, llm), dvfi(ip1jm, llm) ! tendencies
27        real, intent(in):: pdhfi(ip1jmp1, llm) ! tendency
28      !      Output :      REAL, intent(in):: pdqfi(ip1jmp1, llm, nq), pdpfi(ip1jmp1)
29    
30      !      pucov      ! Local variables :
31      !      pvcov      REAL xpn(iim), xps(iim), tpn, tps
32      !      ph      INTEGER j, k, iq, ij
33      !      pts      REAL, PARAMETER:: qtestw = 1e-15, qtestt = 1e-40
   
     use dimens_m  
     use paramet_m  
     use comconst  
     use comgeom  
     use serre  
   
     !    Arguments :  
   
     INTEGER nq  
   
     REAL pdt  
   
     REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)  
     REAL, intent(inout):: teta(ip1jmp1,llm)  
     real pq(ip1jmp1,llm,nq),pps(ip1jmp1)  
   
     REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)  
     REAL pdqfi(ip1jmp1,llm,nq), pdpfi(ip1jmp1)  
     real, intent(in):: pdhfi(ip1jmp1,llm)  
   
     !    Local variables :  
   
     REAL xpn(iim),xps(iim),tpn,tps  
     INTEGER j,k,iq,ij  
     REAL qtestw, qtestt  
     PARAMETER ( qtestw = 1.0e-15 )  
     PARAMETER ( qtestt = 1.0e-40 )  
   
     REAL SSUM  
34    
35      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
36    
37      DO k = 1,llm      DO k = 1, llm
38         DO j = 1,ip1jmp1         DO j = 1, ip1jmp1
39            teta(j,k)= teta(j,k) + pdhfi(j,k) * pdt            teta(j, k)= teta(j, k) + pdhfi(j, k) * dtphys
40         ENDDO         ENDDO
41      ENDDO      ENDDO
42    
43      DO  k    = 1, llm      DO k = 1, llm
44         DO  ij   = 1, iim         DO ij = 1, iim
45            xpn(ij) = aire(   ij   ) * teta(  ij    ,k)            xpn(ij) = aire(ij) * teta(ij , k)
46            xps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,k)            xps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm, k)
47         ENDDO         ENDDO
48         tpn      = SSUM(iim,xpn,1)/ apoln         tpn = SUM(xpn)/ apoln
49         tps      = SSUM(iim,xps,1)/ apols         tps = SUM(xps)/ apols
50    
51         DO ij   = 1, iip1         DO ij = 1, iip1
52            teta(   ij   ,k)  = tpn            teta(ij , k) = tpn
53            teta(ij+ip1jm,k)  = tps            teta(ij+ip1jm, k) = tps
54         ENDDO         ENDDO
55      ENDDO      ENDDO
56    
57      DO k = 1,llm      DO k = 1, llm
58         DO j = iip2,ip1jm         DO j = iip2, ip1jm
59            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys
60         ENDDO         ENDDO
61      ENDDO      ENDDO
62    
63      DO k = 1,llm      DO k = 1, llm
64         DO j = 1,ip1jm         DO j = 1, ip1jm
65            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt            vcov(j, k)= vcov(j, k) + dvfi(j, k) * dtphys
66         ENDDO         ENDDO
67      ENDDO      ENDDO
68    
69      DO j = 1,ip1jmp1      DO j = 1, ip1jmp1
70         pps(j) = pps(j) + pdpfi(j) * pdt         pps(j) = pps(j) + pdpfi(j) * dtphys
71      ENDDO      ENDDO
72    
73      DO iq = 1, 2      DO iq = 1, 2
74         DO k = 1,llm         DO k = 1, llm
75            DO j = 1,ip1jmp1            DO j = 1, ip1jmp1
76               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt               pq(j, k, iq)= pq(j, k, iq) + pdqfi(j, k, iq) * dtphys
77               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )               pq(j, k, iq)= MAX(pq(j, k, iq), qtestw)
78            ENDDO            ENDDO
79         ENDDO         ENDDO
80      ENDDO      ENDDO
81    
82      DO iq = 3, nq      DO iq = 3, nq
83         DO k = 1,llm         DO k = 1, llm
84            DO j = 1,ip1jmp1            DO j = 1, ip1jmp1
85               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt               pq(j, k, iq)= pq(j, k, iq) + pdqfi(j, k, iq) * dtphys
86               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )               pq(j, k, iq)= MAX(pq(j, k, iq), qtestt)
87            ENDDO            ENDDO
88         ENDDO         ENDDO
89      ENDDO      ENDDO
90    
91      DO  ij   = 1, iim      DO ij = 1, iim
92         xpn(ij) = aire(   ij   ) * pps(  ij     )         xpn(ij) = aire(ij) * pps(ij)
93         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm)
94      ENDDO      ENDDO
95      tpn      = SSUM(iim,xpn,1)/apoln      tpn = SUM(xpn)/apoln
96      tps      = SSUM(iim,xps,1)/apols      tps = SUM(xps)/apols
97    
98      DO ij   = 1, iip1      DO ij = 1, iip1
99         pps (   ij     )  = tpn         pps (ij) = tpn
100         pps ( ij+ip1jm )  = tps         pps (ij+ip1jm) = tps
101      ENDDO      ENDDO
102    
103      DO iq = 1, nq      DO iq = 1, nq
104         DO  k    = 1, llm         DO k = 1, llm
105            DO  ij   = 1, iim            DO ij = 1, iim
106               xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)               xpn(ij) = aire(ij) * pq(ij , k, iq)
107               xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)               xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm, k, iq)
108            ENDDO            ENDDO
109            tpn      = SSUM(iim,xpn,1)/apoln            tpn = SUM(xpn)/apoln
110            tps      = SSUM(iim,xps,1)/apols            tps = SUM(xps)/apols
111    
112            DO ij   = 1, iip1            DO ij = 1, iip1
113               pq (   ij   ,k,iq)  = tpn               pq (ij , k, iq) = tpn
114               pq (ij+ip1jm,k,iq)  = tps               pq (ij+ip1jm, k, iq) = tps
115            ENDDO            ENDDO
116         ENDDO         ENDDO
117      ENDDO      ENDDO
Legend:
Removed from v.44  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21