! ! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $ ! ! ! SUBROUTINE caladvtrac_loc(q,pbaru,pbarv , & p ,masse, dq , teta, & flxw, pk, iapptrac) USE parallel_lmdz USE infotrac, ONLY : nqtot USE control_mod, ONLY : iapp_tracvl,planet_type USE caladvtrac_mod USE mod_hallo USE bands USE times USE Vampir USE write_field_loc USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE ! ! Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron ! ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur !======================================================================= ! ! Shema de Van Leer ! !======================================================================= ! Arguments: ! ---------- REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm) REAL :: masse(ijb_u:ije_u,llm) REAL :: p( ijb_u:ije_u,llmp1) REAL :: q( ijb_u:ije_u,llm,nqtot),dq( ijb_u:ije_u,llm, nqtot ) REAL :: teta( ijb_u:ije_u,llm),pk( ijb_u:ije_u,llm) REAL :: flxw(ijb_u:ije_u,llm) INTEGER :: iapptrac ! Local: ! ------ ! REAL :: pbarug(ijb_u:ije_u,llm) ! REAL :: pbarvg(ijb_v:ije_v,llm) ! REAL :: wg(ijb_u:ije_u,llm) REAL :: flxw_adv(distrib_vanleer%ijb_u:distrib_vanleer%ije_u,llm) INTEGER,SAVE :: iadvtr=0 !$OMP THREADPRIVATE(iadvtr) 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(iadvtr.EQ.0) THEN !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm pbaruc(ijbu:ijeu,l)=0. pbarvc(ijbv:ijev,l)=0. ENDDO !$OMP END DO NOWAIT ENDIF ! accumulation des flux de masse horizontaux !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm DO ij = ijbu,ijeu pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l) ENDDO DO ij = ijbv,ijev pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l) ENDDO ENDDO !$OMP END DO NOWAIT ! selection de la masse instantannee des mailles avant le transport. IF(iadvtr.EQ.0) THEN ijb=ij_begin ije=ij_end !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm massem(ijb:ije,l)=masse(ijb:ije,l) ENDDO !$OMP END DO NOWAIT ENDIF iadvtr = iadvtr+1 !$OMP MASTER iapptrac = iadvtr !$OMP END MASTER ! Test pour savoir si on advecte a ce pas de temps IF ( iadvtr.EQ.iapp_tracvl ) THEN ! !write(*,*) 'caladvtrac 133' !$OMP MASTER call suspend_timer(timer_caldyn) !$OMP END MASTER ijb=ij_begin ije=ij_end !c .. Modif P.Le Van ( 20/12/97 ) .... !c ! traitement des flux de masse avant advection. ! 1. calcul de w ! 2. groupement des mailles pres du pole. CALL groupe_loc( massem, pbaruc,pbarvc, pbarug,pbarvg,wg ) !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm flxw(ijb:ije,l)=wg(ijb:ije,l)/REAL(iapp_tracvl) ENDDO !$OMP ENDDO NOWAIT IF (CPPKEY_DEBUGIO) THEN CALL WriteField_u('pbarug1',pbarug) CALL WriteField_v('pbarvg1',pbarvg) CALL WriteField_u('wg1',wg) END IF !$OMP BARRIER !$OMP MASTER call VTb(VTHallo) !$OMP END MASTER call Register_SwapField_u(pbarug,pbarug_adv, distrib_vanleer, & Request_vanleer) call Register_SwapField_v(pbarvg,pbarvg_adv, distrib_vanleer, & Request_vanleer,up=1) call Register_SwapField_u(massem,massem_adv, distrib_vanleer, & Request_vanleer) call Register_SwapField_u(wg,wg_adv,distrib_vanleer, & Request_vanleer) call Register_SwapField_u(teta,teta_adv, distrib_vanleer, & Request_vanleer,up=1,down=1) call Register_SwapField_u(p,p_adv, distrib_vanleer, & Request_vanleer,up=1,down=1) call Register_SwapField_u(pk,pk_adv, distrib_vanleer, & Request_vanleer,up=1,down=1) call Register_SwapField_u(q,q_adv, distrib_vanleer, & Request_vanleer) call SendRequest(Request_vanleer) !$OMP BARRIER call WaitRequest(Request_vanleer) !$OMP BARRIER !$OMP MASTER call Set_Distrib(distrib_vanleer) call VTe(VTHallo) call VTb(VTadvection) call start_timer(timer_vanleer) !$OMP END MASTER !$OMP BARRIER ! CALL WriteField_u('pbarug_adv',pbarug_adv) ! CALL WriteField_u('',) IF (CPPKEY_DEBUGIO) THEN CALL WriteField_u('pbarug1',pbarug_adv) CALL WriteField_v('pbarvg1',pbarvg_adv) CALL WriteField_u('wg1',wg_adv) END IF ! !write(*,*) 'caladvtrac 185' CALL advtrac_loc( pbarug_adv,pbarvg_adv,wg_adv, & p_adv, massem_adv,q_adv, teta_adv, & pk_adv) ! !write(*,*) 'caladvtrac 189' !$OMP MASTER call VTe(VTadvection) call stop_timer(timer_vanleer) call VTb(VThallo) !$OMP END MASTER call Register_SwapField_u(q_adv,q,distrib_caldyn, & Request_vanleer) call SendRequest(Request_vanleer) !$OMP BARRIER call WaitRequest(Request_vanleer) !$OMP BARRIER !$OMP MASTER call Set_Distrib(distrib_caldyn) call VTe(VThallo) call resume_timer(timer_caldyn) !$OMP END MASTER !$OMP BARRIER iadvtr=0 ENDIF ! if iadvtr.EQ.iapp_tracvl END SUBROUTINE caladvtrac_loc