SUBROUTINE dteta1_loc( teta, pbaru, pbarv, dteta) USE parallel_lmdz USE write_field_p USE lmdz_filtreg_p IMPLICIT NONE !======================================================================= ! ! Auteur: P. Le Van ! ------- ! Modif F.Forget 03/94 (on retire q et dq pour construire dteta1) ! ! ******************************************************************** ! ... calcul du terme de convergence horizontale du flux d'enthalpie ! potentielle ...... ! ******************************************************************** ! .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg .... ! dteta sont des arguments de sortie pour le s-pg .... ! !======================================================================= include "dimensions.h" include "paramet.h" REAL :: teta( ijb_u:ije_u,llm ) REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm) REAL :: dteta( ijb_u:ije_u,llm ) INTEGER :: l,ij REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm ) ! INTEGER :: ijb,ije,jjb,jje jjb=jj_begin jje=jj_end !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1,llm ijb=ij_begin ije=ij_end IF (pole_nord) ijb=ij_begin+iip1 IF (pole_sud) ije=ij_end-iip1 DO ij = ijb, ije - 1 hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) ) END DO ! .... correction pour hbxu(iip1,j,l) ..... ! .... hbxu(iip1,j,l)= hbxu(1,j,l) .... !DIR$ IVDEP DO ij = ijb+iip1-1, ije, iip1 hbxu( ij, l ) = hbxu( ij - iim, l ) END DO ijb=ij_begin-iip1 IF (pole_nord) ijb=ij_begin DO ij = ijb,ije hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) ) END DO IF (.NOT. pole_sud) THEN hbxu(ije+1:ije+iip1,l) = 0 hbyv(ije+1:ije+iip1,l) = 0 endif END DO !$OMP END DO NOWAIT CALL convflu_loc ( hbxu, hbyv, llm, dteta ) ! stockage dans dh de la convergence horizont. filtree' du flux ! .... ........... ! d'enthalpie potentielle . CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, & 2, 2, .TRUE., 1) END SUBROUTINE dteta1_loc