trunk/dyn3d/massbarxy.f

module massbarxy_m

  IMPLICIT NONE

contains

  SUBROUTINE massbarxy(masse, massebxy)

    ! From LMDZ4/libf/dyn3d/massbarxy.F, version 1.1.1.1 2004/05/19 12:53:07

    ! Calcule les moyennes en x et y de la masse d'air dans chaque maille.
    ! Authors: P. Le Van, F. Hourdin.

    USE dimens_m, ONLY: iim, llm
    USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
    USE comgeom, ONLY: alpha1, alpha2, alpha3, alpha4

    REAL, intent(in):: masse(ip1jmp1, llm)
    real, intent(out):: massebxy(ip1jm, llm)

    ! Local:
    integer l, ij

    !-------------------------------------------------------------------

    DO l = 1, llm
       DO ij = 1, ip1jm - 1
          massebxy(ij, l) = masse(ij, l) * alpha2(ij) &
               + masse(ij + 1, l) * alpha3(ij + 1) &
               + masse(ij + iip1, l) * alpha1(ij + iip1) &
               + masse(ij + iip2, l) * alpha4(ij + iip2)
       end DO

       !  correction pour massebxy(iip1, j) 
       DO ij = iip1, ip1jm, iip1
          massebxy(ij, l) = massebxy(ij - iim, l)
       end DO
    end DO

  END SUBROUTINE massbarxy

end module massbarxy_m
1	guez	78	module massbarxy_m
2	guez	3
3	guez	78	IMPLICIT NONE
4	guez	3
5	guez	78	contains
6	guez	3
7	guez	78	SUBROUTINE massbarxy(masse, massebxy)
8	guez	3
9	guez	78	! From LMDZ4/libf/dyn3d/massbarxy.F, version 1.1.1.1 2004/05/19 12:53:07
10	guez	3
11	guez	78	! Calcule les moyennes en x et y de la masse d'air dans chaque maille.
12	guez	79	! Authors: P. Le Van, F. Hourdin.
13	guez	78
14			USE dimens_m, ONLY: iim, llm
15			USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
16			USE comgeom, ONLY: alpha1, alpha2, alpha3, alpha4
17
18			REAL, intent(in):: masse(ip1jmp1, llm)
19			real, intent(out):: massebxy(ip1jm, llm)
20
21			! Local:
22			integer l, ij
23
24			!-------------------------------------------------------------------
25
26			DO l = 1, llm
27			DO ij = 1, ip1jm - 1
28			massebxy(ij, l) = masse(ij, l) * alpha2(ij) &
29			+ masse(ij + 1, l) * alpha3(ij + 1) &
30			+ masse(ij + iip1, l) * alpha1(ij + iip1) &
31			+ masse(ij + iip2, l) * alpha4(ij + iip2)
32			end DO
33
34			! correction pour massebxy(iip1, j)
35			DO ij = iip1, ip1jm, iip1
36			massebxy(ij, l) = massebxy(ij - iim, l)
37			end DO
38			end DO
39
40			END SUBROUTINE massbarxy
41
42			end module massbarxy_m