/[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 37 by guez, Tue Dec 21 15:45:48 2010 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, pdt, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, 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    
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    
26      !      pucov      ! Tendencies:
27      !      pvcov      REAL, intent(in):: dufi((iim + 1) * (jjm + 1), llm)
28      !      ph      REAL, intent(in):: dvfi((iim + 1) * jjm, llm)
29      !      pts      real, intent(in):: dtetafi((iim + 1) * (jjm + 1), llm)
30        REAL, intent(in):: dqfi((iim + 1) * (jjm + 1), llm, nqmx)
31    
32      use dimens_m      ! Local variables :
33      use paramet_m      REAL xpn(iim), xps(iim), tpn, tps
34      use comconst      INTEGER j, k, iq, ij
35      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  
36    
37      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
38    
39      DO k = 1,llm      teta = teta + dtetafi * dtphys
        DO j = 1,ip1jmp1  
           pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt  
        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   ) * pteta(  ij    ,k)            xpn(ij) = aire(ij) * teta(ij , k)
44            xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)            xps(ij) = aire(ij+(iim + 1) * jjm) * teta(ij+(iim + 1) * jjm, k)
        ENDDO  
        tpn      = SSUM(iim,xpn,1)/ apoln  
        tps      = SSUM(iim,xps,1)/ apols  
   
        DO ij   = 1, iip1  
           pteta(   ij   ,k)  = tpn  
           pteta(ij+ip1jm,k)  = tps  
45         ENDDO         ENDDO
46      ENDDO         tpn = SUM(xpn)/ apoln
47           tps = SUM(xps)/ apols
48    
49      DO k = 1,llm         DO ij = 1, iim + 1
50         DO j = iip2,ip1jm            teta(ij , k) = tpn
51            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt            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 = 1,ip1jm         DO j = iim + 2, (iim + 1) * jjm
57            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt            ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys
58         ENDDO         ENDDO
59      ENDDO      ENDDO
60    
61      DO j = 1,ip1jmp1      vcov = vcov + dvfi * dtphys
        pps(j) = pps(j) + pdpfi(j) * pdt  
     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) * pdt               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
67               pq(j,k,iq)= AMAX1( 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) * pdt               q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys
76               pq(j,k,iq)= AMAX1( 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
82         xpn(ij) = aire(   ij   ) * pps(  ij     )         DO k = 1, llm
83         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )            DO ij = 1, iim
84      ENDDO               xpn(ij) = aire(ij) * q(ij , k, iq)
85      tpn      = SSUM(iim,xpn,1)/apoln               xps(ij) = aire(ij+(iim + 1) * jjm) * q(ij+(iim + 1) * jjm, k, iq)
     tps      = SSUM(iim,xps,1)/apols  
   
     DO ij   = 1, iip1  
        pps (   ij     )  = tpn  
        pps ( ij+ip1jm )  = tps  
     ENDDO  
   
     DO iq = 1, nq  
        DO  k    = 1, llm  
           DO  ij   = 1, iim  
              xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)  
              xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)  
86            ENDDO            ENDDO
87            tpn      = SSUM(iim,xpn,1)/apoln            tpn = SUM(xpn)/apoln
88            tps      = SSUM(iim,xps,1)/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.37  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21