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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 64 - (hide annotations)
Wed Aug 29 14:47:17 2012 UTC (11 years, 9 months ago) by guez
Original Path: trunk/libf/dyn3d/Dissipation/dissip.f90
File size: 2671 byte(s) 
Removed variable lstardis in module comdissnew and procedures gradiv
and nxgrarot. lstardir had to be true. gradiv and nxgrarot were called
if lstardis was false. Removed argument iter of procedure
filtreg. iter had to be 1. gradiv and nxgrarot called filtreg with
iter == 2.

Moved procedure flxsetup into module yoecumf. Module yoecumf is only
used in program units of directory Conflx, moved it there.
1 guez 47 module dissip_m
2 guez 3
3 guez 47 IMPLICIT NONE
4 guez 3
5 guez 47 contains
6 guez 3
7 guez 47 SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
8 guez 3
9 guez 47 ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05
10     ! Author: P. Le Van
11 guez 56 ! Objet : calcul de la dissipation horizontale
12     ! Avec opĂ©rateurs star : gradiv2, divgrad2, nxgraro2
13 guez 3
14 guez 55 USE dimens_m, ONLY: iim, jjm, llm
15 guez 64 USE comdissnew, ONLY: nitergdiv, nitergrot, niterh
16 guez 55 USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
17 guez 54 use gradiv2_m, only: gradiv2
18 guez 56 use nr_util, only: assert
19 guez 3
20 guez 55 REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
21     REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
22 guez 56 REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
23     REAL, INTENT(IN):: p(:, :, :) ! (iim + 1, jjm + 1, llm + 1)
24 guez 55 REAL, intent(out):: dv(:, :, :) ! (iim + 1, jjm, llm)
25     REAL, intent(out):: du(:, :, :) ! (iim + 1, jjm + 1, llm)
26     REAL, intent(out):: dh(:, :, :) ! (iim + 1, jjm + 1, llm)
27 guez 3
28 guez 47 ! Local:
29 guez 55 REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)
30     REAL grx(iim + 1, jjm + 1, llm), gry(iim + 1, jjm, llm)
31 guez 56 REAL tedt(llm)
32     REAL deltapres(iim + 1, jjm + 1, llm)
33 guez 55 INTEGER l
34 guez 3
35 guez 47 !-----------------------------------------------------------------------
36 guez 3
37 guez 56 call assert((/size(vcov, 1), size(ucov, 1), size(teta, 1), size(p, 1), &
38     size(dv, 1), size(du, 1), size(dh, 1)/) == iim + 1, "dissip iim")
39     call assert((/size(vcov, 2), size(ucov, 2) - 1, size(teta, 2) - 1, &
40     size(p, 2) - 1, size(dv, 2), size(du, 2) - 1, size(dh, 2) - 1/) &
41     == jjm, "dissip jjm")
42     call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(p, 3) - 1, &
43     size(dv, 3), size(du, 3), size(dh, 3)/) == llm, "dissip llm")
44 guez 3
45 guez 56 du(:, 1, :) = 0.
46     du(:, jjm + 1, :) = 0.
47 guez 3
48 guez 47 ! Calcul de la partie grad (div) :
49 guez 3
50 guez 64 CALL gradiv2(ucov, vcov, nitergdiv, gdx, gdy, cdivu)
51 guez 56 tedt = tetaudiv * dtdiss
52 guez 55 forall (l = 1: llm)
53 guez 56 du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)
54     dv(:, :, l) = - tedt(l) * gdy(:, :, l)
55 guez 55 END forall
56 guez 3
57 guez 56 ! Calcul de la partie n X grad (rot) :
58 guez 3
59 guez 64 CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry, crot)
60 guez 56 tedt = tetaurot * dtdiss
61 guez 55 forall (l = 1: llm)
62 guez 56 du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * grx(:, 2: jjm, l)
63     dv(:, :, l) = dv(:, :, l) - tedt(l) * gry(:, :, l)
64 guez 55 END forall
65 guez 3
66 guez 47 ! calcul de la partie div (grad) :
67 guez 3
68 guez 64 forall (l = 1: llm) &
69     deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1))
70     CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
71 guez 56 forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)
72 guez 47
73     END SUBROUTINE dissip
74    
75     end module dissip_m
  ViewVC Help
Powered by ViewVC 1.1.21