source: LMDZ6/trunk/libf/dyn3d_common/rotatf.f90 @ 5274

Last change on this file since 5274 was 5272, checked in by abarral, 8 days ago

Turn paramet.h into a module

  • 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: 1.5 KB
RevLine 
[524]1!
2! $Header$
3!
[5246]4SUBROUTINE rotatf (klevel, x, y, rot )
5  !
6  ! Auteur : P.Le Van
7  !**************************************************************
8  !.  calcule le rotationnel
9  ! a tous les niveaux d'1 vecteur de comp. x et y ..
10  !   x  et  y etant des composantes  covariantes  ...
11  ! Only difference with rotat: call to filtreg.
12  !********************************************************************
13  !   klevel, x  et y   sont des arguments d'entree pour le s-prog
14  !        rot          est  un argument  de sortie pour le s-prog
15  !
[5271]16  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5272]17USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
18          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
[5271]19IMPLICIT NONE
[5246]20  !
[5271]21
[5272]22
[5246]23  INCLUDE "comgeom.h"
24  !
25  !   .....  variables en arguments  ......
26  !
27  INTEGER :: klevel
28  REAL :: rot( ip1jm,klevel )
29  REAL :: x( ip1jmp1,klevel ), y( ip1jm,klevel )
30  !
31  !  ...   variables  locales  ...
32  !
33  INTEGER :: l, ij
34  !
35  !
36  DO l = 1,klevel
37  !
38    DO   ij = 1, ip1jm - 1
39     rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   + &
40           x(ij +iip1, l )  -  x( ij,l )
41    ENDDO
42  !
43  !    .... correction pour rot( iip1,j,l)  ....
44  !    ....   rot(iip1,j,l)= rot(1,j,l) ...
45  !DIR$ IVDEP
46    DO  ij = iip1, ip1jm, iip1
47     rot( ij,l ) = rot( ij -iim,l )
48    ENDDO
49  !
50  END DO
[524]51
[5246]52    CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
53
54    DO l = 1, klevel
55      DO ij = 1, ip1jm
56       rot(ij,l) = rot(ij,l) * unsairez(ij)
57      ENDDO
58    ENDDO
59  !
60  !
61  RETURN
62END SUBROUTINE rotatf
Note: See TracBrowser for help on using the repository browser.