source: LMDZ6/trunk/libf/dyn3dmem/massdair_loc.f90 @ 5248

Last change on this file since 5248 was 5246, checked in by abarral, 21 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • 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
File size: 3.2 KB
Line 
1SUBROUTINE massdair_loc( p, masse )
2  USE parallel_lmdz
3  !
4  ! *********************************************************************
5  !   ....  Calcule la masse d'air  dans chaque maille   ....
6  ! *********************************************************************
7  !
8  !    Auteurs : P. Le Van , Fr. Hourdin  .
9  !   ..........
10  !
11  !  ..    p                      est  un argum. d'entree pour le s-pg ...
12  !  ..  masse                    est un  argum.de sortie pour le s-pg ...
13  !
14  !  ....  p est defini aux interfaces des llm couches   .....
15  !
16  IMPLICIT NONE
17  !
18  include "dimensions.h"
19  include "paramet.h"
20  include "comgeom.h"
21  !
22  !  .....   arguments  ....
23  !
24  REAL :: p(ijb_u:ije_u,llmp1), masse(ijb_u:ije_u,llm)
25
26  !   ....  Variables locales  .....
27
28  INTEGER :: l,ij
29  INTEGER :: ijb,ije
30  REAL :: massemoyn, massemoys
31
32  REAL :: SSUM
33  EXTERNAL SSUM
34  !
35  !
36  !   Methode pour calculer massebx et masseby .
37  !   ----------------------------------------
38  !
39  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
40  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
41  !   alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
42  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
43  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
44  !
45  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
46  !
47  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
48  !
49  !
50  !
51  !   alpha4 .         . alpha1    . alpha4
52  !    (i,j)             (i,j)       (i+1,j)
53  !
54  !         P .        U .          . P
55  !       (i,j)       (i,j)         (i+1,j)
56  !
57  !   alpha3 .         . alpha2    .alpha3
58  !    (i,j)              (i,j)     (i+1,j)
59  !
60  !         V .        Z .          . V
61  !       (i,j)
62  !
63  !   alpha4 .         . alpha1    .alpha4
64  !   (i,j+1)            (i,j+1)   (i+1,j+1)
65  !
66  !         P .        U .          . P
67  !      (i,j+1)                    (i+1,j+1)
68  !
69  !
70  !
71  !                   On  a :
72  !
73  !    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
74  !               masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
75  ! localise  au point  ... U (i,j) ...
76  !
77  !    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
78  !               masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
79  ! localise  au point  ... V (i,j) ...
80  !
81  !
82  !=======================================================================
83
84
85
86
87  ijb=ij_begin-iip1
88  ije=ij_end+2*iip1
89
90  if (pole_nord) ijb=ij_begin
91  if (pole_sud)  ije=ij_end
92
93!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
94  DO    l = 1 , llm
95  !
96    DO    ij     = ijb, ije
97     masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
98    ENDDO
99  !
100    DO   ij = ijb, ije,iip1
101     masse(ij+ iim,l) = masse(ij,l)
102    ENDDO
103  !
104  !   DO    ij     = 1,  iim
105  !    masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )
106  !    masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm)
107  !   ENDDO
108  !    massemoyn         = SSUM(iim,masse(   1   ,l),1)/ apoln
109  !    massemoys         = SSUM(iim,masse(ip1jm+1,l),1)/ apols
110  !   DO    ij     = 1, iip1
111  !    masse(   ij   ,l )    = massemoyn
112  !    masse(ij+ip1jm,l )    = massemoys
113  !   ENDDO
114
115  END DO
116!$OMP END DO NOWAIT
117  !
118  RETURN
119END SUBROUTINE massdair_loc
Note: See TracBrowser for help on using the repository browser.