SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh ) USE parallel IMPLICIT NONE c #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comvert.h" #include "comgeom2.h" c .. DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO, C F. LOTT DEC. 2006 c ( 10/12/06 ) c======================================================================= c c Auteur: F. LOTT c ------- c c Objet: c ------ c c Dissipation linéaire (ex top_bound de la physique) c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- #include "comdissipn.h" c Arguments: c ---------- REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm) REAL masse(iip1,jjp1,llm) REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm) c Local: c ------ REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm) INTEGER NDAMP PARAMETER (NDAMP=4) integer i REAL,SAVE :: rdamp(llm) ! & (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/) LOGICAL,SAVE :: first=.true. INTEGER j,l,jjb,jje if (iflag_top_bound == 0) return if (first) then c$OMP BARRIER c$OMP MASTER if (iflag_top_bound == 1) then ! couche eponge dans les 4 dernieres couches du modele rdamp(:)=0. rdamp(llm)=tau_top_bound rdamp(llm-1)=tau_top_bound/2. rdamp(llm-2)=tau_top_bound/4. rdamp(llm-3)=tau_top_bound/8. else if (iflag_top_bound == 2) then ! couce eponge dans toutes les couches de pression plus faible que ! 100 fois la pression de la derniere couche rdamp(:)=tau_top_bound s *max(presnivs(llm)/presnivs(:)-0.01,0.) endif first=.false. print*,'TOP_BOUND rdamp=',rdamp c$OMP END MASTER c$OMP BARRIER endif CALL massbar_p(masse,massebx,masseby) C CALCUL DES CHAMPS EN MOYENNE ZONALE: jjb=jj_begin jje=jj_end IF (pole_sud) jje=jj_end-1 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje zm=0. vzon(j,l)=0 do i=1,iim ! Rm: on peut travailler directement avec la moyenne zonale de vcov ! plutot qu'avec celle de v car le coefficient cv qui relie les deux ! ne varie qu'en latitude vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l) zm=zm+masseby(i,j,l) enddo vzon(j,l)=vzon(j,l)/zm enddo enddo c$OMP END DO NOWAIT c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje do i=1,iip1 dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l)) enddo enddo enddo c$OMP END DO NOWAIT jjb=jj_begin jje=jj_end IF (pole_nord) jjb=jj_begin+1 IF (pole_sud) jje=jj_end-1 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje uzon(j,l)=0. zm=0. do i=1,iim uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j) zm=zm+massebx(i,j,l) enddo uzon(j,l)=uzon(j,l)/zm enddo enddo c$OMP END DO NOWAIT c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje zm=0. tzon(j,l)=0. do i=1,iim tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l) zm=zm+masse(i,j,l) enddo tzon(j,l)=tzon(j,l)/zm enddo enddo c$OMP END DO NOWAIT C AMORTISSEMENTS LINEAIRES: c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje do i=1,iip1 du(i,j,l)=du(i,j,l) s -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l)) dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l)) enddo enddo enddo c$OMP END DO NOWAIT RETURN END