*=*=*=*= integvanl.html =*=*=*=*
SUBROUTINE integvanl $ ( nq,vcovm1,ucovm1,hm1,pextm1, $ dv,du,dh,dq,dp,vcov,ucov,h,q,pext,phis,finvpold,unsfpnew ) IMPLICIT NONE c .. modification de l'integration de q . 26/04/94 .. c======================================================================= c c Auteur: P. Le Van c ------- c c objet: c ------ c c Incrementation des tendances dynamiques c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comgeom.h" #include "comvert.h" #include "logic.h" #include "temps.h" #include "serre.h" c Arguments: c ---------- INTEGER nq REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm) REAL q(ip1jmp1,llm,nq) REAL pext(ip1jmp1),phis(ip1jmp1) REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm) REAL hm1(ip1jmp1,llm),pextm1(ip1jmp1) REAL dv(ip1jm,llm),du(ip1jmp1,llm) REAL dh(ip1jmp1,llm),dp(ip1jmp1) REAL dq(ip1jmp1,llm,nq), finvpold(ip1jmp1), unsfpnew(ip1jmp1) c Local: c ------ REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ) REAL pscr( ip1jmp1 ) REAL unspext( ip1jmp1 ) REAL finvpext(ip1jmp1) REAL hppn(iim),hpps(iim),qppn(iim),qpps(iim),hpn,hps,qpn,qps INTEGER l,ij,iq REAL SSUM EXTERNAL filtreg EXTERNAL SCOPY REAL CVMGT c----------------------------------------------------------------------- DO 1 l = 1,llm DO 1 ij = 1,iip1 ucov( ij , l) = 0. ucov( ij +ip1jm, l) = 0. uscr( ij ) = 0. uscr( ij +ip1jm ) = 0. 1 CONTINUE c ............ integration de pext .............. DO 2 ij = 1,ip1jmp1 pscr(ij) = pext(ij) pext(ij) = pextm1(ij) + dt * dp(ij) 2 CONTINUE c ####### P.Le Van ( Modif le 26/04/94) ########## CALL SCOPY( ip1jmp1,pext,1,finvpext,1 ) CALL filtreg( finvpext,jjp1,1,-2,2,.TRUE.,1 ) DO 3 ij = 1,ip1jmp1 unspext ( ij ) = 1./ pext ( ij ) unsfpnew( ij ) = 1./finvpext( ij ) 3 CONTINUE c ............ integration de ucov, vcov, h .............. DO 10 l = 1,llm DO 4 ij = iip2,ip1jm uscr( ij ) = ucov( ij,l ) ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l ) 4 CONTINUE DO 5 ij = 1,ip1jm vscr( ij ) = vcov( ij,l ) vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l ) 5 CONTINUE DO 6 ij = 1,ip1jmp1 hscr( ij ) = h(ij,l) h ( ij,l ) = hm1(ij,l) * pextm1(ij) * unspext(ij) $ + dt * dh(ij,l) * unspext(ij) 6 CONTINUE c .... Calcul de la valeur moyenne, unique aux poles pour h ...... c ......... P. Le Van ( ajout le 17/04/96 ) ......... c c IF( alphax.NE.0. ) THEN DO ij = 1, iim hppn(ij) = aire( ij ) * h( ij ,l) hpps(ij) = aire(ij+ip1jm) * h(ij+ip1jm,l) ENDDO hpn = SSUM(iim,hppn,1)/apoln hps = SSUM(iim,hpps,1)/apols DO ij = 1, iip1 h( ij ,l) = hpn h(ij+ip1jm,l) = hps ENDDO ENDIF c c ......................................................................... IF(leapf) THEN CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 ) CALL SCOPY ( ip1jm, vscr(1), 1, vcovm1(1, l), 1 ) CALL SCOPY ( ip1jmp1, hscr(1), 1, hm1(1, l), 1 ) END IF 10 CONTINUE c c ............. integration de q ........................ c c ###### P.Le Van ( Modif le 26/04/94 ) ######## c ancienne formul. Z.X.Li c q(ij,l,iq)=( qm1(ij,l,iq)*pscr(ij) +dtvr*dq(ij,l,iq) )* unspext(ij) c ou .... q(ij,l,iq) = qm1(ij,l,iq) * pscr(ij)* unspext(ij) c c c ..... P.Le Van ( ajout le 17/04/96 ) ........ c ..... Calcul de la valeur moyenne, unique aux poles pour q ..... c IF( alphax.NE.0. ) THEN DO iq = 1, nq DO l = 1, llm DO ij = 1, iim qppn(ij) = aire( ij ) * q( ij ,l,iq) qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq) ENDDO qpn = SSUM(iim,qppn,1)/apoln qps = SSUM(iim,qpps,1)/apols DO ij = 1, iip1 q( ij ,l,iq) = qpn q(ij+ip1jm,l,iq) = qps ENDDO ENDDO ENDDO ENDIF c c ......... FIN de l'integration de q ................. c c CALL SCOPY( ip1jmp1,finvpext,1,finvpold,1 ) c c ................................................................. IF( leapf ) THEN CALL SCOPY ( ip1jmp1, pscr, 1, pextm1, 1 ) END IF RETURN END