source: LMDZ6/trunk/libf/dyn3dmem/dudv2_loc.f90 @ 5420

Last change on this file since 5420 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h 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.9 KB
RevLine 
[5246]1SUBROUTINE dudv2_loc ( teta, pkf, bern, du, dv  )
2  USE parallel_lmdz
[5271]3  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]4  USE paramet_mod_h
[5271]5IMPLICIT NONE
[5246]6  !
7  !=======================================================================
8  !
9  !   Auteur:  P. Le Van
10  !   -------
11  !
12  !   Objet:
13  !   ------
14  !
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  ..
20  !
21  !
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  ....
24  !
25  !=======================================================================
26  !
27  REAL :: teta( ijb_u:ije_u,llm ),pkf( ijb_u:ije_u,llm )
28  REAL :: bern( ijb_u:ije_u,llm )
29  REAL :: du( ijb_u:ije_u,llm ),  dv( ijb_v:ije_v,llm )
30  INTEGER :: l,ij,ijb,ije
31  !
32  !
33!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
34  DO l = 1,llm
35  !
36  ijb=ij_begin
37  ije=ij_end
38  if (pole_nord) ijb=ijb+iip1
39  if (pole_sud)  ije=ije-iip1
[1632]40
[5246]41  DO  ij  = ijb, ije - 1
42   du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * &
43         ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
44  END DO
45  !
46  !
47  !    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
48  !    ...          du(iip1,j,l) = du(1,j,l)                 ...
49  !
50  !DIR$ IVDEP
51  DO ij = ijb+iip1-1, ije, iip1
52  du( ij,l ) = du( ij - iim,l )
53  END DO
54  !
55  !
56  if (pole_nord) ijb=ijb-iip1
[1632]57
[5246]58  DO ij  = ijb,ije
59  dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * &
60        ( pkf(ij+iip1,l) - pkf(  ij,l  ) ) &
61        +   bern( ij+iip1,l ) - bern( ij  ,l )
62  END DO
63  !
64  END DO
65!$OMP END DO NOWAIT
66  !
67  RETURN
68END SUBROUTINE dudv2_loc
Note: See TracBrowser for help on using the repository browser.