/[lmdze]/trunk/dyn3d/Dissipation/nxgraro2.f
ViewVC logotype

Annotation of /trunk/dyn3d/Dissipation/nxgraro2.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 254 - (hide annotations)
Mon Feb 5 10:39:38 2018 UTC (6 years, 3 months ago) by guez
File size: 1698 byte(s)
Move Sources/* to root directory.
1 guez 65 module nxgraro2_m
2 guez 3
3 guez 65 IMPLICIT NONE
4    
5     contains
6    
7     SUBROUTINE nxgraro2(xcov, ycov, lr, grx, gry, crot)
8    
9     ! From LMDZ4/libf/dyn3d/nxgraro2.F, version 1.1.1.1 2004/05/19 12:53:06
10    
11     ! P. Le Van
12     ! Calcul de nxgrad(rot) du vecteur v
13    
14     USE dimens_m, ONLY: iim, jjm
15 guez 137 USE filtreg_v_m, ONLY: filtreg_v
16 guez 65 use nr_util, only: assert, assert_eq
17 guez 107 use rotatf_m, only: rotatf
18 guez 65
19     ! Composantes covariantes de v :
20     REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, :)
21     REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, :)
22    
23     integer, intent(in):: lr
24     REAL, intent(out):: grx(:, :, :) ! (iim + 1, jjm + 1, :)
25     REAL, intent(out):: gry(:, :, :) ! (iim + 1, jjm, :)
26     real, intent(in):: crot
27    
28     ! Variables locales
29    
30     INTEGER klevel, iter
31     REAL rot(iim + 1, jjm, size(xcov, 3)) , nugradrs
32    
33     !----------------------------------------------------------
34    
35     call assert((/size(xcov, 1), size(ycov, 1), size(grx, 1), size(gry, 1)/) &
36     == iim + 1, "nxgraro2 iim")
37     call assert((/size(xcov, 2) - 1, size(ycov, 2), size(grx, 2) - 1, &
38     size(gry, 2)/) == jjm, "nxgraro2 jjm")
39     klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(grx, 3), &
40     size(gry, 3), "nxgraro2 klevel")
41    
42     grx = xcov
43     gry = ycov
44    
45     CALL rotatf(klevel, grx, gry, rot)
46     CALL laplacien_rot(klevel, rot, rot, grx, gry)
47    
48     ! ItĂ©ration de l'opĂ©rateur laplacien_rotgam
49     DO iter = 1, lr - 2
50     CALL laplacien_rotgam(klevel, rot, rot)
51     ENDDO
52    
53 guez 137 CALL filtreg_v(rot, intensive = .true.)
54 guez 65 CALL nxgrad(klevel, rot, grx, gry)
55    
56     nugradrs = (-1.)**lr * crot
57     grx = grx * nugradrs
58     gry = gry * nugradrs
59    
60     END SUBROUTINE nxgraro2
61    
62     end module nxgraro2_m

  ViewVC Help
Powered by ViewVC 1.1.21