/[lmdze]/trunk/Sources/dyn3d/addfi.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/addfi.f

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

trunk/libf/dyn3d/addfi.f90 revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC trunk/Sources/dyn3d/addfi.f revision 134 by guez, Wed Apr 29 15:47:56 2015 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, dufi, dvfi, dtetafi, dqfi)
        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  
26      REAL, intent(in):: pdqfi(ip1jmp1, llm, nq), pdpfi(ip1jmp1)      ! Tendencies:
27        REAL, intent(in):: dufi((iim + 1) * (jjm + 1), llm)
28        REAL, intent(in):: dvfi((iim + 1) * jjm, llm)
29        real, intent(in):: dtetafi((iim + 1) * (jjm + 1), llm)
30        REAL, intent(in):: dqfi((iim + 1) * (jjm + 1), llm, nqmx)
31    
32      ! Local variables :      ! Local variables :
33      REAL xpn(iim), xps(iim), tpn, tps      REAL xpn(iim), xps(iim), tpn, tps
# Line 34  contains Line 36  contains
36    
37      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
38    
39      DO k = 1, llm      teta = teta + dtetafi * dtphys
        DO j = 1, ip1jmp1  
           teta(j, k)= teta(j, k) + pdhfi(j, k) * dtphys  
        ENDDO  
     ENDDO  
40    
41      DO k = 1, llm      DO k = 1, llm
42         DO ij = 1, iim         DO ij = 1, iim
43            xpn(ij) = aire(ij) * teta(ij , k)            xpn(ij) = aire(ij) * teta(ij , k)
44            xps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm, k)            xps(ij) = aire(ij+(iim + 1) * jjm) * teta(ij+(iim + 1) * jjm, k)
45         ENDDO         ENDDO
46         tpn = SUM(xpn)/ apoln         tpn = SUM(xpn)/ apoln
47         tps = SUM(xps)/ apols         tps = SUM(xps)/ apols
48    
49         DO ij = 1, iip1         DO ij = 1, iim + 1
50            teta(ij , k) = tpn            teta(ij , k) = tpn
51            teta(ij+ip1jm, k) = tps            teta(ij+(iim + 1) * jjm, k) = tps
52         ENDDO         ENDDO
53      ENDDO      ENDDO
54    
55      DO k = 1, llm      DO k = 1, llm
56         DO j = iip2, ip1jm         DO j = iim + 2, (iim + 1) * jjm
57            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys
58         ENDDO         ENDDO
59      ENDDO      ENDDO
60    
61      DO k = 1, llm      vcov = vcov + dvfi * dtphys
        DO j = 1, ip1jm  
           vcov(j, k)= vcov(j, k) + dvfi(j, k) * dtphys  
        ENDDO  
     ENDDO  
   
     DO j = 1, ip1jmp1  
        pps(j) = pps(j) + pdpfi(j) * dtphys  
     ENDDO  
62    
63      DO iq = 1, 2      DO iq = 1, 2
64         DO k = 1, llm         DO k = 1, llm
65            DO j = 1, ip1jmp1            DO j = 1, (iim + 1) * (jjm + 1)
66               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
67               pq(j, k, iq)= MAX(pq(j, k, iq), qtestw)               q(j, k, iq)= MAX(q(j, k, iq), qtestw)
68            ENDDO            ENDDO
69         ENDDO         ENDDO
70      ENDDO      ENDDO
71    
72      DO iq = 3, nq      DO iq = 3, nqmx
73         DO k = 1, llm         DO k = 1, llm
74            DO j = 1, ip1jmp1            DO j = 1, (iim + 1) * (jjm + 1)
75               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
76               pq(j, k, iq)= MAX(pq(j, k, iq), qtestt)               q(j, k, iq)= MAX(q(j, k, iq), qtestt)
77            ENDDO            ENDDO
78         ENDDO         ENDDO
79      ENDDO      ENDDO
80    
81      DO ij = 1, iim      DO iq = 1, nqmx
        xpn(ij) = aire(ij) * pps(ij)  
        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm)  
     ENDDO  
     tpn = SUM(xpn)/apoln  
     tps = SUM(xps)/apols  
   
     DO ij = 1, iip1  
        pps (ij) = tpn  
        pps (ij+ip1jm) = tps  
     ENDDO  
   
     DO iq = 1, nq  
82         DO k = 1, llm         DO k = 1, llm
83            DO ij = 1, iim            DO ij = 1, iim
84               xpn(ij) = aire(ij) * pq(ij , k, iq)               xpn(ij) = aire(ij) * q(ij , k, iq)
85               xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm, k, iq)               xps(ij) = aire(ij+(iim + 1) * jjm) * q(ij+(iim + 1) * jjm, k, iq)
86            ENDDO            ENDDO
87            tpn = SUM(xpn)/apoln            tpn = SUM(xpn)/apoln
88            tps = SUM(xps)/apols            tps = SUM(xps)/apols
89    
90            DO ij = 1, iip1            DO ij = 1, iim + 1
91               pq (ij , k, iq) = tpn               q(ij , k, iq) = tpn
92               pq (ij+ip1jm, k, iq) = tps               q(ij+(iim + 1) * jjm, k, iq) = tps
93            ENDDO            ENDDO
94         ENDDO         ENDDO
95      ENDDO      ENDDO
Legend:
Removed from v.70  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21