--- trunk/libf/dyn3d/addfi.f90 2010/12/21 15:45:48 37 +++ trunk/libf/dyn3d/addfi.f90 2013/07/08 18:12:18 71 @@ -4,142 +4,107 @@ contains - SUBROUTINE addfi(nq, pdt, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, pdhfi,& - pdqfi, pdpfi) + SUBROUTINE addfi(ucov, vcov, teta, q, ps, dufi, dvfi, dtetafi, dqfi, dpfi) - ! 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 - ! Addition of the physical tendencies + ! Addition of the physical tendencies - ! Interface : + USE comconst, ONLY: dtphys + USE comgeom, ONLY: aire, apoln, apols + USE dimens_m, ONLY: iim, jjm, llm, nqmx - ! Input : + ! First and second components of the covariant velocity: + REAL, intent(inout):: ucov((iim + 1) * (jjm + 1), llm) + REAL, intent(inout):: vcov((iim + 1) * jjm, llm) - ! pdt time step of integration - ! pucov(ip1jmp1,llm) first component of the covariant velocity - ! 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) | + REAL, intent(inout):: teta((iim + 1) * (jjm + 1), llm) + ! potential temperature - ! Output : + real, intent(inout):: q((iim + 1) * (jjm + 1), llm, nqmx) + real, intent(inout):: ps((iim + 1) * (jjm + 1)) - ! pucov - ! pvcov - ! ph - ! pts + ! Tendencies: + REAL, intent(in):: dufi((iim + 1) * (jjm + 1), llm) + REAL, intent(in):: dvfi((iim + 1) * jjm, llm) + real, intent(in):: dtetafi((iim + 1) * (jjm + 1), llm) + REAL, intent(in):: dqfi((iim + 1) * (jjm + 1), llm, nqmx) + REAL, intent(in):: dpfi((iim + 1) * (jjm + 1)) - use dimens_m - use paramet_m - use comconst - use comgeom - 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 + ! Local variables : + REAL xpn(iim), xps(iim), tpn, tps + INTEGER j, k, iq, ij + REAL, PARAMETER:: qtestw = 1e-15, qtestt = 1e-40 !----------------------------------------------------------------------- - DO k = 1,llm - DO j = 1,ip1jmp1 - pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt - ENDDO - ENDDO + teta = teta + dtetafi * dtphys - DO k = 1, llm - DO ij = 1, iim - xpn(ij) = aire( ij ) * pteta( ij ,k) - xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k) + DO k = 1, llm + DO ij = 1, iim + xpn(ij) = aire(ij) * teta(ij , 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 + tpn = SUM(xpn)/ apoln + tps = SUM(xps)/ apols - DO ij = 1, iip1 - pteta( ij ,k) = tpn - pteta(ij+ip1jm,k) = tps + DO ij = 1, iim + 1 + teta(ij , k) = tpn + teta(ij+(iim + 1) * jjm, k) = tps ENDDO ENDDO - DO k = 1,llm - DO j = iip2,ip1jm - pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt + DO k = 1, llm + DO j = iim + 2, (iim + 1) * jjm + ucov(j, k)= ucov(j, k) + dufi(j, k) * dtphys ENDDO ENDDO - DO k = 1,llm - DO j = 1,ip1jm - pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt - ENDDO - ENDDO - - DO j = 1,ip1jmp1 - pps(j) = pps(j) + pdpfi(j) * pdt - ENDDO + vcov = vcov + dvfi * dtphys + ps = ps + dpfi * dtphys DO iq = 1, 2 - DO k = 1,llm - DO j = 1,ip1jmp1 - pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt - pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw ) + DO k = 1, llm + DO j = 1, (iim + 1) * (jjm + 1) + q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys + q(j, k, iq)= MAX(q(j, k, iq), qtestw) ENDDO ENDDO ENDDO - DO iq = 3, nq - DO k = 1,llm - DO j = 1,ip1jmp1 - pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt - pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt ) + DO iq = 3, nqmx + DO k = 1, llm + DO j = 1, (iim + 1) * (jjm + 1) + q(j, k, iq)= q(j, k, iq) + dqfi(j, k, iq) * dtphys + q(j, k, iq)= MAX(q(j, k, iq), qtestt) ENDDO ENDDO ENDDO - DO ij = 1, iim - xpn(ij) = aire( ij ) * pps( ij ) - xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm ) - ENDDO - tpn = SSUM(iim,xpn,1)/apoln - 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) + DO ij = 1, iim + xpn(ij) = aire(ij) * ps(ij) + xps(ij) = aire(ij+(iim + 1) * jjm) * ps(ij+(iim + 1) * jjm) + ENDDO + tpn = SUM(xpn)/apoln + tps = SUM(xps)/apols + + DO ij = 1, iim + 1 + ps(ij) = tpn + ps(ij+(iim + 1) * jjm) = tps + ENDDO + + DO iq = 1, nqmx + DO k = 1, llm + DO ij = 1, iim + xpn(ij) = aire(ij) * q(ij , k, iq) + xps(ij) = aire(ij+(iim + 1) * jjm) * q(ij+(iim + 1) * jjm, k, iq) ENDDO - tpn = SSUM(iim,xpn,1)/apoln - tps = SSUM(iim,xps,1)/apols + tpn = SUM(xpn)/apoln + tps = SUM(xps)/apols - DO ij = 1, iip1 - pq ( ij ,k,iq) = tpn - pq (ij+ip1jm,k,iq) = tps + DO ij = 1, iim + 1 + q(ij , k, iq) = tpn + q(ij+(iim + 1) * jjm, k, iq) = tps ENDDO ENDDO ENDDO