4 |
|
|
5 |
contains |
contains |
6 |
|
|
7 |
SUBROUTINE addfi(nq, pdt, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, pdhfi,& |
SUBROUTINE addfi(nq, pdt, pucov, pvcov, teta, pq, pps, pdufi, pdvfi, 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 |
18 |
! pdt time step of integration |
! pdt time step of integration |
19 |
! pucov(ip1jmp1,llm) first component of the covariant velocity |
! pucov(ip1jmp1,llm) first component of the covariant velocity |
20 |
! pvcov(ip1ip1jm,llm) second component of the covariant velocity |
! pvcov(ip1ip1jm,llm) second component of the covariant velocity |
21 |
! pteta(ip1jmp1,llm) potential temperature |
! teta(ip1jmp1,llm) potential temperature |
22 |
! pts(ip1jmp1,llm) surface temperature |
! pts(ip1jmp1,llm) surface temperature |
23 |
! pdufi(ip1jmp1,llm) | |
! pdufi(ip1jmp1,llm) | |
24 |
! pdvfi(ip1jm,llm) | respective |
! pdvfi(ip1jm,llm) | respective |
45 |
REAL pdt |
REAL pdt |
46 |
|
|
47 |
REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm) |
REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm) |
48 |
REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1) |
REAL, intent(inout):: teta(ip1jmp1,llm) |
49 |
|
real pq(ip1jmp1,llm,nq),pps(ip1jmp1) |
50 |
|
|
51 |
REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm) |
REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm) |
52 |
REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1) |
REAL pdqfi(ip1jmp1,llm,nq), pdpfi(ip1jmp1) |
53 |
|
real, intent(in):: pdhfi(ip1jmp1,llm) |
54 |
|
|
55 |
! Local variables : |
! Local variables : |
56 |
|
|
66 |
|
|
67 |
DO k = 1,llm |
DO k = 1,llm |
68 |
DO j = 1,ip1jmp1 |
DO j = 1,ip1jmp1 |
69 |
pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt |
teta(j,k)= teta(j,k) + pdhfi(j,k) * pdt |
70 |
ENDDO |
ENDDO |
71 |
ENDDO |
ENDDO |
72 |
|
|
73 |
DO k = 1, llm |
DO k = 1, llm |
74 |
DO ij = 1, iim |
DO ij = 1, iim |
75 |
xpn(ij) = aire( ij ) * pteta( ij ,k) |
xpn(ij) = aire( ij ) * teta( ij ,k) |
76 |
xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k) |
xps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,k) |
77 |
ENDDO |
ENDDO |
78 |
tpn = SSUM(iim,xpn,1)/ apoln |
tpn = SSUM(iim,xpn,1)/ apoln |
79 |
tps = SSUM(iim,xps,1)/ apols |
tps = SSUM(iim,xps,1)/ apols |
80 |
|
|
81 |
DO ij = 1, iip1 |
DO ij = 1, iip1 |
82 |
pteta( ij ,k) = tpn |
teta( ij ,k) = tpn |
83 |
pteta(ij+ip1jm,k) = tps |
teta(ij+ip1jm,k) = tps |
84 |
ENDDO |
ENDDO |
85 |
ENDDO |
ENDDO |
86 |
|
|