trunk/dyn3d/massbar.f

SUBROUTINE massbar(  masse, massebx, masseby )

  ! From LMDZ4/libf/dyn3d/massbar.F,v 1.1.1.1 2004/05/19 12:53:05

  !
  ! **********************************************************************
  !
  !  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
  ! **********************************************************************
  !    Auteurs : P. Le Van , Fr. Hourdin  .
  !   ..........
  !
  !  ..  masse                 est  un argum. d'entree  pour le s-pg ...
  !  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
  !     
  !
  !     IMPLICIT NONE
  !
  use dimens_m
  use paramet_m
  use comconst
  use comgeom
  !
  REAL, intent(in):: masse( ip1jmp1,llm )
  real massebx( ip1jmp1,llm )  , masseby(   ip1jm,llm )
  !
  !
  ! Méthode pour calculer massebx et masseby. A chaque point scalaire
  ! P(i, j) sont affectés quatre coefficients d'aire.

  ! alpha1(i, j) calculé au point (i + 1/4, j - 1/4)
  ! alpha2(i, j) calculé au point (i + 1/4, j + 1/4)
  ! alpha3(i, j) calculé au point (i - 1/4, j + 1/4)
  ! alpha4(i, j) calculé au point (i - 1/4, j - 1/4)

  ! Avec alpha1(i, j) = aire(i + 1/4, j - 1/4)/ aire(i, j) 

  ! Pour plus de détails, voir sous-programme "iniconst" et
  ! "massbar.txt".


  DO       l = 1 , llm
     !
     DO  ij = 1, ip1jmp1 - 1
        massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +  &
             masse(ij+1, l) * alpha3p4(ij+1 )
     ENDDO

     !    .... correction pour massebx( iip1,j) .....
     !    ...    massebx(iip1,j)= massebx(1,j) ...
     !
     !DIR$ IVDEP
     DO  ij = iip1, ip1jmp1, iip1
        massebx( ij,l ) = massebx( ij - iim,l )
     ENDDO


     DO  ij = 1,ip1jm
        masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  + &
             masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
     ENDDO

  end DO

END SUBROUTINE massbar
1	SUBROUTINE massbar( masse, massebx, masseby )
2
3	! From LMDZ4/libf/dyn3d/massbar.F,v 1.1.1.1 2004/05/19 12:53:05
4
5	!
6	! **********************************************************************
7	!
8	! Calcule les moyennes en x et y de la masse d'air dans chaque maille.
9	! **********************************************************************
10	! Auteurs : P. Le Van , Fr. Hourdin .
11	! ..........
12	!
13	! .. masse est un argum. d'entree pour le s-pg ...
14	! .. massebx,masseby sont des argum. de sortie pour le s-pg ...
15	!
16	!
17	! IMPLICIT NONE
18	!
19	use dimens_m
20	use paramet_m
21	use comconst
22	use comgeom
23	!
24	REAL, intent(in):: masse( ip1jmp1,llm )
25	real massebx( ip1jmp1,llm ) , masseby( ip1jm,llm )
26	!
27	!
28	! Méthode pour calculer massebx et masseby. A chaque point scalaire
29	! P(i, j) sont affectés quatre coefficients d'aire.
30
31	! alpha1(i, j) calculé au point (i + 1/4, j - 1/4)
32	! alpha2(i, j) calculé au point (i + 1/4, j + 1/4)
33	! alpha3(i, j) calculé au point (i - 1/4, j + 1/4)
34	! alpha4(i, j) calculé au point (i - 1/4, j - 1/4)
35
36	! Avec alpha1(i, j) = aire(i + 1/4, j - 1/4)/ aire(i, j)
37
38	! Pour plus de détails, voir sous-programme "iniconst" et
39	! "massbar.txt".
40
41
42	DO l = 1 , llm
43	!
44	DO ij = 1, ip1jmp1 - 1
45	massebx(ij,l) = masse( ij, l) * alpha1p2( ij ) + &
46	masse(ij+1, l) * alpha3p4(ij+1 )
47	ENDDO
48
49	! .... correction pour massebx( iip1,j) .....
50	! ... massebx(iip1,j)= massebx(1,j) ...
51	!
52	!DIR$ IVDEP
53	DO ij = iip1, ip1jmp1, iip1
54	massebx( ij,l ) = massebx( ij - iim,l )
55	ENDDO
56
57
58	DO ij = 1,ip1jm
59	masseby( ij,l ) = masse( ij , l ) * alpha2p3( ij ) + &
60	masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
61	ENDDO
62
63	end DO
64
65	END SUBROUTINE massbar