source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pbar.f90 @ 5186

Last change on this file since 5186 was 5159, checked in by abarral, 7 weeks 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: 3.1 KB
RevLine 
[5099]1
[524]2! $Header$
[5099]3
[5106]4SUBROUTINE pbar( pext, pbarx, pbary, pbarxy )
[5136]5  USE lmdz_comgeom
6
[5159]7  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
8  USE lmdz_paramet
[5105]9  IMPLICIT NONE
[524]10
[5105]11  !=======================================================================
[5159]12
[5105]13  !   Auteur:  P. Le Van
14  !   -------
[5159]15
[5105]16  !   Objet:
17  !   ------
[5159]18
[5105]19  ! **********************************************************************
20  ! calcul des moyennes en x et en y de (pression au sol*aire variable) ..
21  ! *********************************************************************
[5159]22
[5105]23  !      pext               est  un argum. d'entree  pour le s-pg ..
24  ! pbarx,pbary et pbarxy  sont des argum. de sortie pour le s-pg ..
[5159]25
[5105]26  !   Methode:
27  !   --------
[5159]28
[5105]29  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
30  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
31  !   alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
32  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
33  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
[5159]34
[5105]35  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
[5159]36
[5105]37  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
[5159]38
39
40
[5105]41  !   alpha4 .         . alpha1    . alpha4
42  !    (i,j)             (i,j)       (i+1,j)
[5159]43
[5105]44  !         P .        U .          . P
45  !       (i,j)       (i,j)         (i+1,j)
[5159]46
[5105]47  !   alpha3 .         . alpha2    .alpha3
48  !    (i,j)              (i,j)     (i+1,j)
[5159]49
[5105]50  !         V .        Z .          . V
51  !       (i,j)
[5159]52
[5105]53  !   alpha4 .         . alpha1    .alpha4
54  !   (i,j+1)            (i,j+1)   (i+1,j+1)
[5159]55
[5105]56  !         P .        U .          . P
57  !      (i,j+1)                    (i+1,j+1)
[5159]58
59
60
61
[5105]62  !                   On  a :
[5159]63
[5105]64  !    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
65  !             Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
66  ! localise  au point  ... U (i,j) ...
[5159]67
[5105]68  !    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
69  !             Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
70  ! localise  au point  ... V (i,j) ...
[5159]71
[5105]72  !  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
73  !           Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
74  ! localise  au point  ... Z (i,j) ...
[5159]75
76
77
[5105]78  !=======================================================================
[524]79
80
81
[5159]82
83
[5105]84  REAL :: pext( ip1jmp1 ),  pbarx ( ip1jmp1 )
85  REAL :: pbary(  ip1jm  ),  pbarxy(  ip1jm  )
[524]86
[5105]87  INTEGER :: ij
[524]88
89
90
[5105]91  DO ij = 1, ip1jmp1 - 1
92  pbarx( ij ) = pext(ij) * alpha1p2(ij) + pext(ij+1)*alpha3p4(ij+1)
93  END DO
[524]94
[5105]95  !    .... correction pour pbarx( iip1,j) .....
[524]96
[5105]97  !    ...    pbarx(iip1,j)= pbarx(1,j) ...
98  !DIR$ IVDEP
99  DO ij = iip1, ip1jmp1, iip1
100  pbarx( ij ) = pbarx( ij - iim )
101  END DO
[524]102
103
[5105]104  DO ij = 1,ip1jm
105  pbary( ij ) = pext(   ij  )   * alpha2p3(   ij   )     + &
106        pext( ij+iip1 ) * alpha1p4( ij+iip1 )
107  END DO
[524]108
109
[5105]110  DO ij = 1, ip1jm - 1
111  pbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) + &
112        pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
113  END DO
[524]114
115
[5105]116  !    ....  correction pour     pbarxy( iip1,j )  ........
[524]117
[5105]118  !DIR$ IVDEP
[524]119
[5105]120  DO ij = iip1, ip1jm, iip1
121  pbarxy( ij ) = pbarxy( ij - iim )
122  END DO
[524]123
124
[5105]125  RETURN
126END SUBROUTINE pbar
Note: See TracBrowser for help on using the repository browser.