*=*=*=*= grn.html =*=*=*=*
subroutine grn(pext,ucov,vcov,h) implicit none c sous-programme servant a fitlrer les champs de flux de masse aux c poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur c et a mesure qu'on se rapproche du pole. c c en entree: pext, pbaru et pbarv c c en sortie: pextm, t wm. c c remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc c pas besoin de w en entree. #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comgeom2.h" #include "comvert.h" integer ngroup parameter (ngroup=3) real pext(iip1,jjp1),h(iip1,jjp1,llm) real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm) real vnat(iip1,jjm,llm) real ucont(iip1,jjp1,llm),vcont(iip1,jjm,llm) real pbarx(iip1,jjp1),pbary(iip1,jjm),pbarxy(iip1,jjm) real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm) real zconvm(iip1,jjp1,llm) real uu integer i,j,l logical firstcall,lfiltreg save firstcall,lfiltreg data firstcall/.true./ lfiltreg=.true. c if (firstcall) then c if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point' c firstcall=.false. print*,'Utilisation de filtreg ? (T) ou groupeun (F)' c read (*,*) lfiltreg c endif if(lfiltreg) then CALL filtreg( pext, jjp1, 1, 2,2, .true., 1) CALL filtreg( h, jjp1, llm, 2,1, .true., 1) else call groupeun(jjp1,1,pext,.false.) call groupeun(jjp1,llm,h,.true.) endif do l=1,llm do j=1,jjm do i=1,iip1 vnat(i,j,l)=vcov(i,j,l)/cv(i,j) enddo enddo enddo call groupeun(jjm,llm,vnat,.true.) do l=1,llm do j=1,jjm do i=1,iip1 vcov(i,j,l)=vnat(i,j,l)*cv(i,j) enddo enddo enddo CALL covcont ( llm, ucov, vcov, ucont, vcont ) CALL pbar ( pext ,pbarx , pbary, pbarxy ) CALL flumass ( pbarx, pbary, vcont, ucont ,pbaru, pbarv ) call convflu(pbaru,pbarv,llm,zconvm) if(lfiltreg) then CALL filtreg( zconvm, jjp1, llm, 2,2, .true., 1) else call groupeun(jjp1,llm,zconvm,.false.) endif c Champs 3D do l=1,llm do j=2,jjm uu=pbaru(iim,j,l) do i=1,iim uu=uu+pbarv(i,j,l)-pbarv(i,j-1,l)-zconvm(i,j,l) c pbaru(i,j,l)=uu c zconvm(i,j,l ) = xflu(i-1,j,l)-xflu(i,j,l)+ c * yflu(i,j,l)-yflu(i,j-1,l) c ucov=ucont*cu*cu=cu*cu*pbaru/pbarx ucov(i,j,l)=uu/(pbarx(i,j)*unscu2(i,j)) enddo ucov(iip1,j,l)=ucov(1,j,l) enddo do j=1,jjm do i=1,iim vcov(i,j,l)=pbarv(i,j,l)/(pbary(i,j)*unscv2(i,j)) enddo enddo enddo return end