source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/flumass.F90 @ 5195

Last change on this file since 5195 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.8 KB
Line 
1SUBROUTINE flumass(massebx,masseby, vcont, ucont, pbaru, pbarv )
2
3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , Fr. Hourdin.
5!-------------------------------------------------------------------------------
6! Purpose: Compute mass flux at s levels.
7  USE lmdz_comgeom
8
9USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
10  USE lmdz_paramet
11  IMPLICIT NONE
12
13
14!===============================================================================
15! Arguments:
16  REAL, INTENT(IN)  :: massebx(ip1jmp1,llm)
17  REAL, INTENT(IN)  :: masseby(ip1jm  ,llm)
18  REAL, INTENT(IN)  :: vcont  (ip1jm  ,llm)
19  REAL, INTENT(IN)  :: ucont  (ip1jmp1,llm)
20  REAL, INTENT(OUT) :: pbaru  (ip1jmp1,llm)
21  REAL, INTENT(OUT) :: pbarv  (ip1jm  ,llm)
22!===============================================================================
23! Method used:   A 2 equations system is solved.
24!   * 1st one describes divergence computation at pole point nr. i (i=1 to im):
25!     (0.5*(pbaru(i)-pbaru(i-1))-pbarv(i))/aire(i) = - SUM(pbarv(n))/aire pole
26!   * 2nd one specifies that mean mass flux at pole is equal to 0:
27!     SUM(pbaru(n)*local_area(n))=0
28! This way, we determine additive constant common to pbary elements representing
29!   pbaru(0,j,l) in divergence computation equation for point i=1. (i=1 to im)
30!===============================================================================
31! Local variables:
32  REAL    :: sairen, saireun, ctn, ctn0, apbarun(iip1)
33  REAL    :: saires, saireus, cts, cts0, apbarus(iip1)
34  INTEGER :: l, i
35!===============================================================================
36  DO l=1,llm
37    pbaru(iip2:ip1jm,l)=massebx(iip2:ip1jm,l)*ucont(iip2:ip1jm,l)
38    pbarv(   1:ip1jm,l)=masseby(   1:ip1jm,l)*vcont(   1:ip1jm,l)
39  END DO
40
41  !--- NORTH POLE
42  sairen =SUM(aire (1:iim))
43  saireun=SUM(aireu(1:iim))
44  DO l = 1,llm
45    ctn=SUM(pbarv(1:iim,l))/sairen
46    pbaru(1,l)= pbarv(1,l)-ctn*aire(1)
47    DO i=2,iim
48      pbaru(i,l)=pbaru(i-1,l)+pbarv(i,l)-ctn*aire(i)
49    END DO
50    DO i=1,iim
51      apbarun(i)=aireu(i)*pbaru(i,l)
52    END DO
53    ctn0 = -SUM(apbarun(1:iim))/saireun
54    DO i = 1,iim
55      pbaru(i,l)=2.*(pbaru(i,l)+ctn0)
56    END DO
57    pbaru(iip1,l)=pbaru(1,l)
58  END DO
59
60  !--- SOUTH POLE
61  saires =SUM(aire (ip1jm+1:ip1jmp1-1))
62  saireus=SUM(aireu(ip1jm+1:ip1jmp1-1))
63  DO l = 1,llm
64    cts=SUM(pbarv(ip1jmi1+1:ip1jm-1,l))/saires
65    pbaru(1+ip1jm,l)=-pbarv(1+ip1jmi1,l)+cts*aire(1+ip1jm)
66    DO i=2,iim
67      pbaru(i+ip1jm,l)=pbaru(i-1+ip1jm,l)-pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm)
68    END DO
69    DO i=1,iim
70      apbarus(i)=aireu(i+ip1jm)*pbaru(i+ip1jm,l)
71    END DO
72    cts0 = -SUM(apbarus(1:iim))/saireus
73    DO i = 1,iim
74      pbaru(i+ip1jm,l)=2.*(pbaru(i+ip1jm,l)+cts0)
75    END DO
76    pbaru(ip1jmp1,l)=pbaru(1+ip1jm,l)
77  END DO
78
79END SUBROUTINE flumass
Note: See TracBrowser for help on using the repository browser.