*=*=*=*= integrd.html =*=*=*=*
SUBROUTINE integrd $ ( nq,vcovm1,ucovm1,hm1,pextm1, $ dv,du,dh,dq,dp,vcov,ucov,h,q,pext,phis,finvpold,unsfpnew ) IMPLICIT NONE c .......... Version du 29/04/97 .............. c .. modification de l'integration de q . 26/04/94 .. c .... Si shema Van-leer pour advection de q , on n'integre pas q c car q a ete deja integre dans vlsplt appele par vanleer ... c======================================================================= c cccccccccccccccccccccccccccccccccccccccccccc c c VERSION MARTIENNE de integrd.F c c sans traceurs! c cccccccccccccccccccccccccccccccccccccccccccc 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 iadv(nqmx), 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 test sur la positivite des pressions pour detecter c les instabilites DO ij =1,ip1jmp1 IF(.NOT.pext(ij).GT.0.) THEN PRINT*,'pression extensive neg. au point ij=',ij PRINT*, pext(ij) STOP'dans integrd' ENDIF ENDDO 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 ......... 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