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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 56 - (show annotations)
Tue Jan 10 19:02:02 2012 UTC (12 years, 5 months ago) by guez
Original Path: trunk/libf/dyn3d/Dissipation/dissip.f90
File size: 3013 byte(s) 
Imported "writehist.f" from LMDZ.

Moved module variable "histaveid" from "com_io_dyn" to "initdynav_m".

In "inithist", access directly module variables from "com_io_dyn"
instead of going through the arguments. Copying from LMDZ, write "u"
and scalar variables to separate files. Create a new variable for the
new file in "com_io_dyn". Copying from LMDZ, change the vertical axes
of the three files.

Removed some useless initializations in "dissip".

In "bilan_dyn", removed useless variable "time". Avoiding the
approximate test on "dt_cum" being a multiple of "dt_app", just
compute "ncum" from known usage of "bilan_dyn" and compute "dt_cum"
from "ncum". Change "periodav" from real to integer in
"conf_gcm_m". Since "day_step" is required to be a multiple of
"iperiod", so is "ncum".
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 ! Objet : calcul de la dissipation horizontale
12 ! Avec opérateurs star : gradiv2, divgrad2, nxgraro2
13
14 USE dimens_m, ONLY: iim, jjm, llm
15 USE comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh
16 USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
17 use gradiv2_m, only: gradiv2
18 use nr_util, only: assert
19
20 REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
21 REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
22 REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
23 REAL, INTENT(IN):: p(:, :, :) ! (iim + 1, jjm + 1, llm + 1)
24 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
28 ! Local:
29 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 REAL tedt(llm)
32 REAL deltapres(iim + 1, jjm + 1, llm)
33 INTEGER l
34
35 !-----------------------------------------------------------------------
36
37 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
45 du(:, 1, :) = 0.
46 du(:, jjm + 1, :) = 0.
47
48 ! Calcul de la partie grad (div) :
49
50 IF (lstardis) THEN
51 CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)
52 ELSE
53 CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)
54 END IF
55
56 tedt = tetaudiv * dtdiss
57 forall (l = 1: llm)
58 du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)
59 dv(:, :, l) = - tedt(l) * gdy(:, :, l)
60 END forall
61
62 ! Calcul de la partie n X grad (rot) :
63
64 IF (lstardis) THEN
65 CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry, crot)
66 ELSE
67 CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry, crot)
68 END IF
69
70 tedt = tetaurot * dtdiss
71 forall (l = 1: llm)
72 du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * grx(:, 2: jjm, l)
73 dv(:, :, l) = dv(:, :, l) - tedt(l) * gry(:, :, l)
74 END forall
75
76 ! calcul de la partie div (grad) :
77
78 IF (lstardis) THEN
79 forall (l = 1: llm) &
80 deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1))
81 CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
82 ELSE
83 CALL divgrad(llm, teta, niterh, gdx, cdivh)
84 END IF
85
86 forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)
87
88 END SUBROUTINE dissip
89
90 end module dissip_m
  ViewVC Help
Powered by ViewVC 1.1.21