source: LMDZ6/trunk/libf/dyn3d_common/psextbar.f90 @ 5271

Last change on this file since 5271 was 5271, checked in by abarral, 24 hours ago

Move dimensions.h into a module
Nb: doesn't compile yet

  • 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 
1!
2! $Header$
3!
4SUBROUTINE psextbar ( ps, psexbarxy )
5  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
6IMPLICIT NONE
7
8  !=======================================================================
9  !
10  !   Auteur:  P. Le Van
11  !   -------
12  !
13  !   Objet:
14  !   ------
15  !
16  ! **********************************************************************
17  ! calcul des moyennes en x et en y de (pression au sol*aire variable) ..
18  ! **********************************************************************
19  !
20  !     ps          est un  argum. d'entree  pour le s-pg ..
21  !     psexbarxy   est un  argum. de sortie pour le s-pg ..
22  !
23  !   Methode:
24  !   --------
25  !
26  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
27  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
28  !   alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
29  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
30  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
31  !
32  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
33  !
34  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
35  !
36  !
37  !
38  !   alpha4 .         . alpha1    . alpha4
39  !    (i,j)             (i,j)       (i+1,j)
40  !
41  !         P .        U .          . P
42  !       (i,j)       (i,j)         (i+1,j)
43  !
44  !   alpha3 .         . alpha2    .alpha3
45  !    (i,j)              (i,j)     (i+1,j)
46  !
47  !         V .        Z .          . V
48  !       (i,j)
49  !
50  !   alpha4 .         . alpha1    .alpha4
51  !   (i,j+1)            (i,j+1)   (i+1,j+1)
52  !
53  !         P .        U .          . P
54  !      (i,j+1)                    (i+1,j+1)
55  !
56  !
57  !
58  !
59  !                   On  a :
60  !
61  !    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
62  !             Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
63  ! localise  au point  ... U (i,j) ...
64  !
65  !    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
66  !             Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
67  ! localise  au point  ... V (i,j) ...
68  !
69  !  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
70  !           Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
71  ! localise  au point  ... Z (i,j) ...
72  !
73  !
74  !
75  !=======================================================================
76
77
78
79  INCLUDE "paramet.h"
80  INCLUDE "comgeom.h"
81
82  REAL :: ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
83
84  INTEGER :: l, ij
85  !
86
87  DO ij = 1, ip1jmp1
88   pext(ij) = ps(ij) * aire(ij)
89  ENDDO
90
91
92  DO     ij = 1, ip1jm - 1
93  psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) + &
94        pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
95  END DO
96
97
98  !    ....  correction pour     psexbarxy( iip1,j )  ........
99
100  !DIR$ IVDEP
101
102  DO ij = iip1, ip1jm, iip1
103  psexbarxy( ij ) = psexbarxy( ij - iim )
104  END DO
105
106
107  RETURN
108END SUBROUTINE psextbar
Note: See TracBrowser for help on using the repository browser.