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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 6 months ago) by guez
Original Path: trunk/dyn3d/Dissipation/nxgraro2.f90
File size: 1669 byte(s)
Moved everything out of libf.
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     USE filtreg_m, ONLY: filtreg
16     use nr_util, only: assert, assert_eq
17    
18     ! Composantes covariantes de v :
19     REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, :)
20     REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, :)
21    
22     integer, intent(in):: lr
23     REAL, intent(out):: grx(:, :, :) ! (iim + 1, jjm + 1, :)
24     REAL, intent(out):: gry(:, :, :) ! (iim + 1, jjm, :)
25     real, intent(in):: crot
26    
27     ! Variables locales
28    
29     INTEGER klevel, iter
30     REAL rot(iim + 1, jjm, size(xcov, 3)) , nugradrs
31    
32     !----------------------------------------------------------
33    
34     call assert((/size(xcov, 1), size(ycov, 1), size(grx, 1), size(gry, 1)/) &
35     == iim + 1, "nxgraro2 iim")
36     call assert((/size(xcov, 2) - 1, size(ycov, 2), size(grx, 2) - 1, &
37     size(gry, 2)/) == jjm, "nxgraro2 jjm")
38     klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(grx, 3), &
39     size(gry, 3), "nxgraro2 klevel")
40    
41     grx = xcov
42     gry = ycov
43    
44     CALL rotatf(klevel, grx, gry, rot)
45     CALL laplacien_rot(klevel, rot, rot, grx, gry)
46    
47     ! ItĂ©ration de l'opĂ©rateur laplacien_rotgam
48     DO iter = 1, lr - 2
49     CALL laplacien_rotgam(klevel, rot, rot)
50     ENDDO
51    
52     CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE.)
53     CALL nxgrad(klevel, rot, grx, gry)
54    
55     nugradrs = (-1.)**lr * crot
56     grx = grx * nugradrs
57     gry = gry * nugradrs
58    
59     END SUBROUTINE nxgraro2
60    
61     end module nxgraro2_m

  ViewVC Help
Powered by ViewVC 1.1.21