/[lmdze]/trunk/libf/dyn3d/Dissipation/dissip.f90
ViewVC logotype

Annotation of /trunk/libf/dyn3d/Dissipation/dissip.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 65 - (hide annotations)
Thu Sep 20 09:57:03 2012 UTC (11 years, 8 months ago) by guez
File size: 2670 byte(s) 
Removed unused procedure "divgrad".

In procedure "dissip", save memory by using intermediary arrays "gdx"
and "gdy" several times instead of additional array "grx" and "gry".

In procedure "inidissip", write "dtdiss * teta*" instead of "teta*".

In "comvert", change name of s_sampling from "LMD5" to "tropo" and
from "strato2" to "strato".
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 65 USE comdissnew, ONLY: nitergdiv, nitergrot, niterh
15 guez 55 USE dimens_m, ONLY: iim, jjm, llm
16 guez 65 use divgrad2_m, only: divgrad2
17     use gradiv2_m, only: gradiv2
18 guez 55 USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
19 guez 56 use nr_util, only: assert
20 guez 65 use nxgraro2_m, only: nxgraro2
21 guez 3
22 guez 55 REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
23     REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
24 guez 56 REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
25     REAL, INTENT(IN):: p(:, :, :) ! (iim + 1, jjm + 1, llm + 1)
26 guez 55 REAL, intent(out):: dv(:, :, :) ! (iim + 1, jjm, llm)
27     REAL, intent(out):: du(:, :, :) ! (iim + 1, jjm + 1, llm)
28     REAL, intent(out):: dh(:, :, :) ! (iim + 1, jjm + 1, llm)
29 guez 3
30 guez 47 ! Local:
31 guez 55 REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)
32 guez 56 REAL tedt(llm)
33     REAL deltapres(iim + 1, jjm + 1, llm)
34 guez 55 INTEGER l
35 guez 3
36 guez 47 !-----------------------------------------------------------------------
37 guez 3
38 guez 56 call assert((/size(vcov, 1), size(ucov, 1), size(teta, 1), size(p, 1), &
39     size(dv, 1), size(du, 1), size(dh, 1)/) == iim + 1, "dissip iim")
40     call assert((/size(vcov, 2), size(ucov, 2) - 1, size(teta, 2) - 1, &
41     size(p, 2) - 1, size(dv, 2), size(du, 2) - 1, size(dh, 2) - 1/) &
42     == jjm, "dissip jjm")
43     call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(p, 3) - 1, &
44     size(dv, 3), size(du, 3), size(dh, 3)/) == llm, "dissip llm")
45 guez 3
46 guez 56 du(:, 1, :) = 0.
47     du(:, jjm + 1, :) = 0.
48 guez 3
49 guez 65 ! Calcul de la partie grad(div) :
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 65 ! Calcul de la partie n X grad(rot) :
58     CALL nxgraro2(ucov, vcov, nitergrot, gdx, gdy, crot)
59 guez 56 tedt = tetaurot * dtdiss
60 guez 55 forall (l = 1: llm)
61 guez 65 du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * gdx(:, 2: jjm, l)
62     dv(:, :, l) = dv(:, :, l) - tedt(l) * gdy(:, :, l)
63 guez 55 END forall
64 guez 3
65 guez 65 ! calcul de la partie div(grad) :
66 guez 64 forall (l = 1: llm) &
67     deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1))
68     CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
69 guez 56 forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)
70 guez 47
71     END SUBROUTINE dissip
72    
73     end module dissip_m
  ViewVC Help
Powered by ViewVC 1.1.21