source: LMDZ5/branches/AI-cosp/libf/dyn3d_common/flumass.F90 @ 5371

Last change on this file since 5371 was 2336, checked in by dcugnet, 9 years ago
  • Add parallel capability for ce0l.
  • Small bug in grid_noro fixed (smoothed topography was used instead of unsmoothed one for geopotential computation at north pole).
  • Removed average of mass at poles in etat0dyn_netcdf after start_init_dyn => different results in the zoomed grid case.
  • ok_etat0=n and ok_limit=y combination now works fine (if no initial state is needed, but only limit.nc file). This required:
    • to move grid_noro0 and start_init_noro0 subroutines from etat0dyn_netcdf.F90 to limit_netcdf.F90
    • to create init_ssrf_m.F90 file, so that sub-surfaces can be initialized from limit_netcdf.F90 without any etat0*_netcdf routines call).
  • Simplified somehow the corresponding code, in particular: 1) removed obsolete flags "oldice". 2) removed flag "ibar": barycentric interpolation is used everywhere (except in start_init_subsurf, still calling grille_m - to be changed soon). 3) removed useless CPP_PHY precompilation directives, considering the possibility to run ce0l without physics is useless (ce0l is dedicated to Earth physics).
  • 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.7 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  IMPLICIT NONE
8  include "dimensions.h"
9  include "paramet.h"
10  include "comgeom.h"
11!===============================================================================
12! Arguments:
13  REAL, INTENT(IN)  :: massebx(ip1jmp1,llm)
14  REAL, INTENT(IN)  :: masseby(ip1jm  ,llm)
15  REAL, INTENT(IN)  :: vcont  (ip1jm  ,llm)
16  REAL, INTENT(IN)  :: ucont  (ip1jmp1,llm)
17  REAL, INTENT(OUT) :: pbaru  (ip1jmp1,llm)
18  REAL, INTENT(OUT) :: pbarv  (ip1jm  ,llm)
19!===============================================================================
20! Method used:   A 2 equations system is solved.
21!   * 1st one describes divergence computation at pole point nr. i (i=1 to im):
22!     (0.5*(pbaru(i)-pbaru(i-1))-pbarv(i))/aire(i) = - SUM(pbarv(n))/aire pole
23!   * 2nd one specifies that mean mass flux at pole is equal to 0:
24!     SUM(pbaru(n)*local_area(n))=0
25! This way, we determine additive constant common to pbary elements representing
26!   pbaru(0,j,l) in divergence computation equation for point i=1. (i=1 to im)
27!===============================================================================
28! Local variables:
29  REAL    :: sairen, saireun, ctn, ctn0, apbarun(iip1)
30  REAL    :: saires, saireus, cts, cts0, apbarus(iip1)
31  INTEGER :: l, i
32!===============================================================================
33  DO l=1,llm
34    pbaru(iip2:ip1jm,l)=massebx(iip2:ip1jm,l)*ucont(iip2:ip1jm,l)
35    pbarv(   1:ip1jm,l)=masseby(   1:ip1jm,l)*vcont(   1:ip1jm,l)
36  END DO
37
38  !--- NORTH POLE
39  sairen =SUM(aire (1:iim))
40  saireun=SUM(aireu(1:iim))
41  DO l = 1,llm
42    ctn=SUM(pbarv(1:iim,l))/sairen
43    pbaru(1,l)= pbarv(1,l)-ctn*aire(1)
44    DO i=2,iim
45      pbaru(i,l)=pbaru(i-1,l)+pbarv(i,l)-ctn*aire(i)
46    END DO
47    DO i=1,iim
48      apbarun(i)=aireu(i)*pbaru(i,l)
49    END DO
50    ctn0 = -SUM(apbarun(1:iim))/saireun
51    DO i = 1,iim
52      pbaru(i,l)=2.*(pbaru(i,l)+ctn0)
53    END DO
54    pbaru(iip1,l)=pbaru(1,l)
55  END DO
56
57  !--- SOUTH POLE
58  saires =SUM(aire (ip1jm+1:ip1jmp1-1))
59  saireus=SUM(aireu(ip1jm+1:ip1jmp1-1))
60  DO l = 1,llm
61    cts=SUM(pbarv(ip1jmi1+1:ip1jm-1,l))/saires
62    pbaru(1+ip1jm,l)=-pbarv(1+ip1jmi1,l)+cts*aire(1+ip1jm)
63    DO i=2,iim
64      pbaru(i+ip1jm,l)=pbaru(i-1+ip1jm,l)-pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm)
65    END DO
66    DO i=1,iim
67      apbarus(i)=aireu(i+ip1jm)*pbaru(i+ip1jm,l)
68    END DO
69    cts0 = -SUM(apbarus(1:iim))/saireus
70    DO i = 1,iim
71      pbaru(i+ip1jm,l)=2.*(pbaru(i+ip1jm,l)+cts0)
72    END DO
73    pbaru(ip1jmp1,l)=pbaru(1+ip1jm,l)
74  END DO
75
76END SUBROUTINE flumass
Note: See TracBrowser for help on using the repository browser.