! ! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $ ! c c SUBROUTINE fluxstokenc_p(pbaru,pbarv , * masse, teta, phi) USE parallel_lmdz USE control_mod, ONLY : iapp_tracvl,planet_type,iphysiq USE caladvtrac_mod USE mod_hallo USE bands USE times USE Vampir USE write_field_loc c IMPLICIT NONE c c Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron c c======================================================================= c c Shema de Van Leer c c======================================================================= include "dimensions.h" include "paramet.h" include "tracstoke.h" c Arguments: c ---------- REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm) REAL :: masse(ijb_u:ije_u,llm) REAL :: teta( ijb_u:ije_u,llm) REAL :: phi(ijb_u:ije_u,llm) INTEGER,SAVE :: pasflx=0 !$OMP THREADPRIVATE(pasflx) INTEGER :: ijb,ije,ijbu,ijbv,ijeu,ijev,j INTEGER :: ij,l TYPE(Request),SAVE :: Request_vanleer !$OMP THREADPRIVATE(Request_vanleer) !write(*,*) 'caladvtrac 58: entree' ijbu=ij_begin ijeu=ij_end ijbv=ij_begin-iip1 ijev=ij_end if (pole_nord) ijbv=ij_begin if (pole_sud) ijev=ij_end-iip1 IF(pasflx.EQ.0) THEN c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm tetac(ijbu:ijeu,l)=0. phic(ijbu:ijeu,l)=0. pbarucc(ijbu:ijeu,l)=0. pbarvcc(ijbv:ijev,l)=0. ENDDO c$OMP END DO NOWAIT ENDIF c accumulation des flux de masse horizontaux c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm DO ij = ijbu,ijeu pbarucc(ij,l) = pbarucc(ij,l) + pbaru(ij,l) tetac(ij,l) = tetac(ij,l) + teta(ij,l) phic(ij,l) = phic(ij,l) + phi(ij,l) ENDDO DO ij = ijbv,ijev pbarvcc(ij,l) = pbarvcc(ij,l) + pbarv(ij,l) ENDDO ENDDO c$OMP END DO NOWAIT c selection de la masse instantannee des mailles avant le transport. IF(pasflx.EQ.0) THEN ijb=ij_begin ije=ij_end c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm massec(ijb:ije,l)=masse(ijb:ije,l) ENDDO c$OMP END DO NOWAIT ENDIF pasflx = pasflx+1 c Test pour savoir si on advecte a ce pas de temps IF ( pasflx.EQ.(iphysiq*istphy) ) THEN !write(*,*) 'caladvtrac 133' c$OMP MASTER call suspend_timer(timer_caldyn) c$OMP END MASTER ijb=ij_begin ije=ij_end c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm pbarucc(ijb:ije,l) = pbarucc(ijb:ije,l)/REAL(iphysiq*istphy) tetac(ijb:ije,l) = tetac(ijb:ije,l)/REAL(iphysiq*istphy) phic(ijb:ije,l) = phic(ijb:ije,l)/REAL(iphysiq*istphy) ENDDO c$OMP ENDDO NOWAIT if (pole_sud) ije=ij_end-iip1 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm pbarvcc(ijb:ije,l) = pbarvcc(ijb:ije,l)/REAL(iphysiq*istphy) ENDDO c$OMP ENDDO NOWAIT c$OMP BARRIER call Register_Hallo_u(pbarucc,llm,1,1,1,1,Request_vanleer) call Register_Hallo_v(pbarvcc,llm,1,1,1,1,Request_vanleer) call SendRequest(Request_vanleer) c$OMP BARRIER call WaitRequest(Request_vanleer) c$OMP BARRIER cc .. Modif P.Le Van ( 20/12/97 ) .... cc c traitement des flux de masse avant advection. c 1. calcul de w c 2. groupement des mailles pres du pole. CALL groupe_loc( massec, pbarucc,pbarvcc, pbarugg,pbarvgg,wgg ) ijb=ij_begin ije=ij_end c$OMP BARRIER CALL WriteField_u('pbarug',pbarugg) CALL WriteField_v('pbarvg',pbarvgg) CALL WriteField_u('wg',wgg) CALL WriteField_u('tetag',tetac) CALL WriteField_u('phig',phic) CALL WriteField_u('masseg',massec) c$OMP MASTER call Set_Distrib(distrib_caldyn) call VTe(VThallo) call resume_timer(timer_caldyn) c$OMP END MASTER c$OMP BARRIER pasflx=0 ENDIF ! if iadvtr.EQ.iapp_tracvl END