source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90 @ 5119

Last change on this file since 5119 was 5117, checked in by abarral, 2 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • 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.5 KB
Line 
1SUBROUTINE nxgrad_gam_loc( klevel, rot, x, y )
2  !
3  !  P. Le Van
4  !
5  !   ********************************************************************
6  !  calcul du gradient tourne de pi/2 du rotationnel du vect.v
7  !   ********************************************************************
8  !   rot          est un argument  d'entree pour le s-prog
9  !   x  et y    sont des arguments de sortie pour le s-prog
10  !
11  USE parallel_lmdz
12
13  IMPLICIT NONE
14  !
15  INCLUDE "dimensions.h"
16  INCLUDE "paramet.h"
17  INCLUDE "comgeom.h"
18  INTEGER :: klevel
19  REAL :: rot( ijb_v:ije_v,klevel )
20  REAL :: x( ijb_u:ije_u,klevel ),y(ijb_v:ije_v,klevel )
21  INTEGER :: l,ij
22  INTEGER :: ismin,ismax
23  external ismin,ismax
24  INTEGER :: ijb,ije
25  !
26!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
27  DO l = 1,klevel
28  !
29  ijb=ij_begin
30  ije=ij_end
31  IF(pole_sud) ije=ij_end-iip1
32
33  DO ij = ijb+1, ije
34  y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
35  END DO
36  !
37  !    ..... correction pour  y ( 1,j,l )  ......
38  !
39  !    ....    y(1,j,l)= y(iip1,j,l) ....
40  !DIR$ IVDEP
41  DO ij = ijb, ije, iip1
42  y( ij,l ) = y( ij +iim,l )
43  END DO
44  !
45  ijb=ij_begin
46  ije=ij_end+iip1
47  IF(pole_nord) ijb=ij_begin+iip1
48  IF(pole_sud) ije=ij_end-iip1
49
50  DO ij = ijb,ije
51  x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
52  END DO
53
54  IF (pole_nord) THEN
55    DO  ij = 1,iip1
56     x(    ij    ,l ) = 0.
57    ENDDO
58  ENDIF
59
60  IF (pole_sud) THEN
61    DO  ij = 1,iip1
62     x( ij +ip1jm,l ) = 0.
63    ENDDO
64  ENDIF
65  !
66  END DO
67!$OMP END DO NOWAIT
68
69END SUBROUTINE nxgrad_gam_loc
Note: See TracBrowser for help on using the repository browser.