source: LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_dissip.f90 @ 5220

Last change on this file since 5220 was 5186, checked in by abarral, 13 days ago

Encapsulate files in modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.7 KB
RevLine 
[5186]1MODULE lmdz_dissip
2  IMPLICIT NONE; PRIVATE
3  PUBLIC dissip
[5099]4
[5186]5CONTAINS
[524]6
[5186]7  SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
8    USE comconst_mod, ONLY: dtdiss
9    USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
10    USE lmdz_comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
11            tetagrot, tetatemp, coefdis, vert_prof_dissip
12    USE lmdz_comgeom
[524]13
[5186]14    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
15    USE lmdz_paramet
16    IMPLICIT NONE
[524]17
18
[5186]19    ! ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
20    ! (  10/01/98  )
[5159]21
[5186]22    !=======================================================================
[5159]23
[5186]24    !   Auteur:  P. Le Van
25    !   -------
[5159]26
[5186]27    !   Objet:
28    !   ------
[5159]29
[5186]30    !   Dissipation horizontale
[524]31
[5186]32    !=======================================================================
33    !-----------------------------------------------------------------------
34    !   Declarations:
35    !   -------------
[524]36
[5159]37
38
[524]39
[5186]40    !   Arguments:
41    !   ----------
[524]42
[5186]43    REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
44    REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
45    REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
46    REAL, INTENT(IN) :: p(ip1jmp1, llmp1) ! pressure
47    ! tendencies (.../s) on covariant winds and potential temperature
48    REAL, INTENT(OUT) :: dv(ip1jm, llm)
49    REAL, INTENT(OUT) :: du(ip1jmp1, llm)
50    REAL, INTENT(OUT) :: dh(ip1jmp1, llm)
[524]51
[5186]52    !   Local:
53    !   ------
[524]54
[5186]55    REAL :: gdx(ip1jmp1, llm), gdy(ip1jm, llm)
56    REAL :: grx(ip1jmp1, llm), gry(ip1jm, llm)
57    REAL :: te1dt(llm), te2dt(llm), te3dt(llm)
58    REAL :: deltapres(ip1jmp1, llm)
[524]59
[5186]60    INTEGER :: l, ij
[524]61
[5186]62    !-----------------------------------------------------------------------
63    !   initialisations:
64    !   ----------------
[524]65
[5186]66    DO l = 1, llm
67      te1dt(l) = tetaudiv(l) * dtdiss
68      te2dt(l) = tetaurot(l) * dtdiss
69      te3dt(l) = tetah(l) * dtdiss
70    ENDDO
71    du = 0.
72    dv = 0.
73    dh = 0.
[524]74
[5186]75    !-----------------------------------------------------------------------
76    !   Calcul de la dissipation:
77    !   -------------------------
[524]78
[5186]79    !   Calcul de la partie   grad  ( div ) :
80    !   -------------------------------------
[524]81
[5186]82    IF(lstardis) THEN
83      CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy)
84    ELSE
85      CALL gradiv (llm, ucov, vcov, nitergdiv, gdx, gdy)
86    ENDIF
[524]87
[5186]88    DO l = 1, llm
[524]89
[5186]90      DO ij = 1, iip1
91        gdx(ij, l) = 0.
92        gdx(ij + ip1jm, l) = 0.
93      ENDDO
94
95      DO ij = iip2, ip1jm
96        du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
97      ENDDO
98      DO ij = 1, ip1jm
99        dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
100      ENDDO
101
[5103]102    ENDDO
[524]103
[5186]104    !   calcul de la partie   n X grad ( rot ):
105    !   ---------------------------------------
[524]106
[5186]107    IF(lstardis) THEN
108      CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry)
109    ELSE
110      CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry)
111    ENDIF
[524]112
[5186]113    DO l = 1, llm
114      DO ij = 1, iip1
115        grx(ij, l) = 0.
116      ENDDO
[524]117
[5186]118      DO ij = iip2, ip1jm
119        du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
120      ENDDO
121      DO ij = 1, ip1jm
122        dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
123      ENDDO
[5103]124    ENDDO
[524]125
[5186]126    !   calcul de la partie   div ( grad ):
127    !   -----------------------------------
[524]128
[5186]129    IF(lstardis) THEN
[524]130
[5186]131      DO l = 1, llm
132        DO ij = 1, ip1jmp1
133          deltapres(ij, l) = AMAX1(0., p(ij, l) - p(ij, l + 1))
134        ENDDO
135      ENDDO
[524]136
[5186]137      CALL divgrad2(llm, teta, deltapres, niterh, gdx)
138    ELSE
139      CALL divgrad (llm, teta, niterh, gdx)
140    ENDIF
141
[5103]142    DO l = 1, llm
143      DO ij = 1, ip1jmp1
[5186]144        dh(ij, l) = dh(ij, l) - te3dt(l) * gdx(ij, l)
[5103]145      ENDDO
146    ENDDO
[524]147
[5186]148  END SUBROUTINE dissip
[524]149
150
[5186]151END MODULE lmdz_dissip
Note: See TracBrowser for help on using the repository browser.