Sources/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	guez	78	SUBROUTINE massbar( masse, massebx, masseby )
2	guez	3
3	guez	78	! From LMDZ4/libf/dyn3d/massbar.F,v 1.1.1.1 2004/05/19 12:53:05
4	guez	3
5	guez	78	!
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	guez	79	REAL, intent(in):: masse( ip1jmp1,llm )
25			real massebx( ip1jmp1,llm ) , masseby( ip1jm,llm )
26	guez	78	!
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	guez	3
31	guez	78	! 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	guez	3
36	guez	78	! Avec alpha1(i, j) = aire(i + 1/4, j - 1/4)/ aire(i, j)
37	guez	3
38	guez	78	! 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