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

Diff of /trunk/dyn3d/addfi.f

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

trunk/libf/dyn3d/addfi.f90 revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC trunk/dyn3d/addfi.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 4  module addfi_m Line 4  module addfi_m
4    
5  contains  contains
6    
7    SUBROUTINE addfi(nq, pdt, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, 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    
11      !    Addition of the physical tendencies      ! Addition of the physical tendencies
12    
13      !    Interface :      USE comconst, ONLY: dtphys
14        USE comgeom, ONLY: aire, apoln, apols
15        USE dimens_m, ONLY: iim, jjm, llm, nqmx
16    
17      !      Input :      ! First and second components of the covariant velocity:
18        REAL, intent(inout):: ucov((iim + 1) * (jjm + 1), llm)
19        REAL, intent(inout):: vcov((iim + 1) * jjm, llm)
20    
21      !      pdt                    time step of integration      REAL, intent(inout):: teta((iim + 1) * (jjm + 1), llm)
22      !      pucov(ip1jmp1,llm)     first component of the covariant velocity      ! potential temperature
     !      pvcov(ip1ip1jm,llm)    second component of the covariant velocity  
     !      pteta(ip1jmp1,llm)     potential temperature  
     !      pts(ip1jmp1,llm)       surface temperature  
     !      pdufi(ip1jmp1,llm)     |  
     !      pdvfi(ip1jm,llm)       |   respective  
     !      pdhfi(ip1jmp1)         |      tendencies  
     !      pdtsfi(ip1jmp1)        |  
23    
24      !      Output :      real, intent(inout):: q((iim + 1) * (jjm + 1), llm, nqmx)
25        real, intent(inout):: ps((iim + 1) * (jjm + 1))
26    
27      !      pucov      ! Tendencies:
28      !      pvcov      REAL, intent(in):: dufi((iim + 1) * (jjm + 1), llm)
29      !      ph      REAL, intent(in):: dvfi((iim + 1) * jjm, llm)
30      !      pts      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      use dimens_m      ! Local variables :
35      use paramet_m      REAL xpn(iim), xps(iim), tpn, tps
36      use comconst      INTEGER j, k, iq, ij
37      use comgeom      REAL, PARAMETER:: qtestw = 1e-15, qtestt = 1e-40
     use serre  
   
     !    Arguments :  
   
     INTEGER nq  
   
     REAL pdt  
   
     REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)  
     REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)  
   
     REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)  
     REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)  
   
     !    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  
38    
39      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
40    
41      DO k = 1,llm      teta = teta + dtetafi * dtphys
        DO j = 1,ip1jmp1  
           pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt  
        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   ) * pteta(  ij    ,k)            xpn(ij) = aire(ij) * teta(ij , k)
46            xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)            xps(ij) = aire(ij+(iim + 1) * jjm) * teta(ij+(iim + 1) * jjm, 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, iim + 1
52            pteta(   ij   ,k)  = tpn            teta(ij , k) = tpn
53            pteta(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            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      vcov = vcov + dvfi * dtphys
64         DO j = 1,ip1jm      ps = ps + dpfi * dtphys
           pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt  
        ENDDO  
     ENDDO  
   
     DO j = 1,ip1jmp1  
        pps(j) = pps(j) + pdpfi(j) * pdt  
     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) * pdt               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
70               pq(j,k,iq)= AMAX1( 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) * pdt               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
79               pq(j,k,iq)= AMAX1( 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      = SSUM(iim,xpn,1)/apoln      tpn = SUM(xpn)/apoln
89      tps      = SSUM(iim,xps,1)/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      = SSUM(iim,xpn,1)/apoln            tpn = SUM(xpn)/apoln
103            tps      = SSUM(iim,xps,1)/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.37  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21