source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90 @ 5172

Last change on this file since 5172 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
File size: 1.8 KB
RevLine 
[5106]1SUBROUTINE dudv2_loc( teta, pkf, bern, du, dv  )
[5105]2  USE parallel_lmdz
[5159]3  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
4  USE lmdz_paramet
[5105]5  IMPLICIT NONE
[5159]6
[5105]7  !=======================================================================
[5159]8
[5105]9  !   Auteur:  P. Le Van
10  !   -------
[5159]11
[5105]12  !   Objet:
13  !   ------
[5159]14
[5105]15  !   *****************************************************************
16  !   ..... calcul du terme de pression (gradient de p/densite )   et
17  !      du terme de ( -gradient de la fonction de Bernouilli ) ...
18  !   *****************************************************************
19  !      Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
[5159]20
21
[5105]22  !    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
23  !    du et dv          sont des arguments de sortie pour le s-pg  ....
[5159]24
[5105]25  !=======================================================================
26  !
[1632]27
[5159]28
29
[5105]30  REAL :: teta( ijb_u:ije_u,llm ),pkf( ijb_u:ije_u,llm )
31  REAL :: bern( ijb_u:ije_u,llm )
32  REAL :: du( ijb_u:ije_u,llm ),  dv( ijb_v:ije_v,llm )
33  INTEGER :: l,ij,ijb,ije
[5159]34
35
[5105]36!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
37  DO l = 1,llm
[5159]38
[5105]39  ijb=ij_begin
40  ije=ij_end
[5117]41  IF (pole_nord) ijb=ijb+iip1
42  IF (pole_sud)  ije=ije-iip1
[1632]43
[5105]44  DO ij  = ijb, ije - 1
45   du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * &
46         ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
47  END DO
[5159]48
49
[5105]50  !    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
51  !    ...          du(iip1,j,l) = du(1,j,l)                 ...
[5159]52
[5105]53  !DIR$ IVDEP
54  DO ij = ijb+iip1-1, ije, iip1
55  du( ij,l ) = du( ij - iim,l )
56  END DO
[5159]57
58
[5117]59  IF (pole_nord) ijb=ijb-iip1
[1632]60
[5105]61  DO ij  = ijb,ije
62  dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * &
63        ( pkf(ij+iip1,l) - pkf(  ij,l  ) ) &
64        +   bern( ij+iip1,l ) - bern( ij  ,l )
65  END DO
[5159]66
[5105]67  END DO
68!$OMP END DO NOWAIT
69  !
70
71END SUBROUTINE dudv2_loc
Note: See TracBrowser for help on using the repository browser.