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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 279 - (show annotations)
Fri Jul 20 14:30:23 2018 UTC (5 years, 10 months ago) by guez
File size: 2686 byte(s) 
fqcalving was saved in physiq and had intent inout in pbl_surface. So
we could set fqcalving to 0 only once per run. The point is fqcalving
must be defined everywhere for the computation of the average over all
surfaces, even values that get multiplied by pctsrf = 0. I find it
clearer to set fqcalving to 0 at every call of pbl_surface. This is
more expensive but allows to give intent out to fqcalving in
pbl_surface and remove the save attribute in physiq.

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