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

Diff of /trunk/libf/dyn3d/addfi.f90

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

revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC
# Line 4  module addfi_m Line 4  module addfi_m
4    
5  contains  contains
6    
7    SUBROUTINE addfi(nq, ucov, vcov, teta, pq, pps, dufi, dvfi, pdhfi, &    SUBROUTINE addfi(ucov, vcov, teta, q, ps, dufi, dvfi, dtetafi, dqfi, dpfi)
        pdqfi, pdpfi)  
8    
9      ! 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
10    
# Line 13  contains Line 12  contains
12    
13      USE comconst, ONLY: dtphys      USE comconst, ONLY: dtphys
14      USE comgeom, ONLY: aire, apoln, apols      USE comgeom, ONLY: aire, apoln, apols
15      USE dimens_m, ONLY: iim, llm      USE dimens_m, ONLY: iim, jjm, llm, nqmx
     USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1  
16    
17      INTEGER, intent(in):: nq      ! First and second components of the covariant velocity:
18        REAL, intent(inout):: ucov((iim + 1) * (jjm + 1), llm)
19      REAL, intent(inout):: ucov(ip1jmp1, llm), vcov(ip1jm, llm)      REAL, intent(inout):: vcov((iim + 1) * jjm, llm)
20      ! first and second components of the covariant velocity  
21        REAL, intent(inout):: teta((iim + 1) * (jjm + 1), llm)
22      REAL, intent(inout):: teta(ip1jmp1, llm) ! potential temperature      ! potential temperature
23      real, intent(inout):: pq(ip1jmp1, llm, nq), pps(ip1jmp1)  
24      REAL, intent(in):: dufi(ip1jmp1, llm), dvfi(ip1jm, llm) ! tendencies      real, intent(inout):: q((iim + 1) * (jjm + 1), llm, nqmx)
25      real, intent(in):: pdhfi(ip1jmp1, llm) ! tendency      real, intent(inout):: ps((iim + 1) * (jjm + 1))
26      REAL, intent(in):: pdqfi(ip1jmp1, llm, nq), pdpfi(ip1jmp1)  
27        ! Tendencies:
28        REAL, intent(in):: dufi((iim + 1) * (jjm + 1), llm)
29        REAL, intent(in):: dvfi((iim + 1) * jjm, llm)
30        real, intent(in):: dtetafi((iim + 1) * (jjm + 1), llm)
31        REAL, intent(in):: dqfi((iim + 1) * (jjm + 1), llm, nqmx)
32        REAL, intent(in):: dpfi((iim + 1) * (jjm + 1))
33    
34      ! Local variables :      ! Local variables :
35      REAL xpn(iim), xps(iim), tpn, tps      REAL xpn(iim), xps(iim), tpn, tps
# Line 34  contains Line 38  contains
38    
39      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
40    
41      DO k = 1, llm      teta = teta + dtetafi * dtphys
        DO j = 1, ip1jmp1  
           teta(j, k)= teta(j, k) + pdhfi(j, k) * dtphys  
        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+(iim + 1) * jjm) * teta(ij+(iim + 1) * jjm, k)
47         ENDDO         ENDDO
48         tpn = SUM(xpn)/ apoln         tpn = SUM(xpn)/ apoln
49         tps = SUM(xps)/ apols         tps = SUM(xps)/ apols
50    
51         DO ij = 1, iip1         DO ij = 1, iim + 1
52            teta(ij , k) = tpn            teta(ij , k) = tpn
53            teta(ij+ip1jm, k) = tps            teta(ij+(iim + 1) * jjm, 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 = iim + 2, (iim + 1) * jjm
59            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys
60         ENDDO         ENDDO
61      ENDDO      ENDDO
62    
63      DO k = 1, llm      vcov = vcov + dvfi * dtphys
64         DO j = 1, ip1jm      ps = ps + dpfi * dtphys
           vcov(j, k)= vcov(j, k) + dvfi(j, k) * dtphys  
        ENDDO  
     ENDDO  
   
     DO j = 1, ip1jmp1  
        pps(j) = pps(j) + pdpfi(j) * dtphys  
     ENDDO  
65    
66      DO iq = 1, 2      DO iq = 1, 2
67         DO k = 1, llm         DO k = 1, llm
68            DO j = 1, ip1jmp1            DO j = 1, (iim + 1) * (jjm + 1)
69               pq(j, k, iq)= pq(j, k, iq) + pdqfi(j, k, iq) * dtphys               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
70               pq(j, k, iq)= MAX(pq(j, k, iq), qtestw)               q(j, k, iq)= MAX(q(j, k, iq), qtestw)
71            ENDDO            ENDDO
72         ENDDO         ENDDO
73      ENDDO      ENDDO
74    
75      DO iq = 3, nq      DO iq = 3, nqmx
76         DO k = 1, llm         DO k = 1, llm
77            DO j = 1, ip1jmp1            DO j = 1, (iim + 1) * (jjm + 1)
78               pq(j, k, iq)= pq(j, k, iq) + pdqfi(j, k, iq) * dtphys               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
79               pq(j, k, iq)= MAX(pq(j, k, iq), qtestt)               q(j, k, iq)= MAX(q(j, k, iq), qtestt)
80            ENDDO            ENDDO
81         ENDDO         ENDDO
82      ENDDO      ENDDO
83    
84      DO ij = 1, iim      DO ij = 1, iim
85         xpn(ij) = aire(ij) * pps(ij)         xpn(ij) = aire(ij) * ps(ij)
86         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm)         xps(ij) = aire(ij+(iim + 1) * jjm) * ps(ij+(iim + 1) * jjm)
87      ENDDO      ENDDO
88      tpn = SUM(xpn)/apoln      tpn = SUM(xpn)/apoln
89      tps = SUM(xps)/apols      tps = SUM(xps)/apols
90    
91      DO ij = 1, iip1      DO ij = 1, iim + 1
92         pps (ij) = tpn         ps(ij) = tpn
93         pps (ij+ip1jm) = tps         ps(ij+(iim + 1) * jjm) = tps
94      ENDDO      ENDDO
95    
96      DO iq = 1, nq      DO iq = 1, nqmx
97         DO k = 1, llm         DO k = 1, llm
98            DO ij = 1, iim            DO ij = 1, iim
99               xpn(ij) = aire(ij) * pq(ij , k, iq)               xpn(ij) = aire(ij) * q(ij , k, iq)
100               xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm, k, iq)               xps(ij) = aire(ij+(iim + 1) * jjm) * q(ij+(iim + 1) * jjm, k, iq)
101            ENDDO            ENDDO
102            tpn = SUM(xpn)/apoln            tpn = SUM(xpn)/apoln
103            tps = SUM(xps)/apols            tps = SUM(xps)/apols
104    
105            DO ij = 1, iip1            DO ij = 1, iim + 1
106               pq (ij , k, iq) = tpn               q(ij , k, iq) = tpn
107               pq (ij+ip1jm, k, iq) = tps               q(ij+(iim + 1) * jjm, k, iq) = tps
108            ENDDO            ENDDO
109         ENDDO         ENDDO
110      ENDDO      ENDDO
Legend:
Removed from v.70  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21