| 1 | SUBROUTINE caldyn0(itau, ucov, vcov, teta, ps, masse, pk, phis, phi, w, pbaru, pbarv, time) |
|---|
| 2 | |
|---|
| 3 | !------------------------------------------------------------------------------- |
|---|
| 4 | ! Author: P. Le Van ; modif. 04/93: F.Forget. |
|---|
| 5 | !------------------------------------------------------------------------------- |
|---|
| 6 | ! Purpose: Compute dynamic tendencies. |
|---|
| 7 | !------------------------------------------------------------------------------- |
|---|
| 8 | USE control_mod, ONLY: resetvarc |
|---|
| 9 | USE comvert_mod, ONLY: ap, bp |
|---|
| 10 | USE lmdz_comgeom |
|---|
| 11 | |
|---|
| 12 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
|---|
| 13 | USE lmdz_paramet |
|---|
| 14 | IMPLICIT NONE |
|---|
| 15 | |
|---|
| 16 | |
|---|
| 17 | !=============================================================================== |
|---|
| 18 | ! Arguments: |
|---|
| 19 | INTEGER, INTENT(IN) :: itau !--- TIME STEP INDEX |
|---|
| 20 | REAL, INTENT(IN) :: vcov (ip1jm, llm) !--- V COVARIANT WIND |
|---|
| 21 | REAL, INTENT(IN) :: ucov (ip1jmp1, llm) !--- U COVARIANT WIND |
|---|
| 22 | REAL, INTENT(IN) :: teta (ip1jmp1, llm) !--- POTENTIAL TEMPERATURE |
|---|
| 23 | REAL, INTENT(IN) :: ps (ip1jmp1) !--- GROUND PRESSURE |
|---|
| 24 | REAL, INTENT(OUT) :: masse(ip1jmp1, llm) !--- MASS IN EACH CELL |
|---|
| 25 | REAL, INTENT(IN) :: pk (iip1, jjp1, llm) !--- PRESSURE |
|---|
| 26 | REAL, INTENT(IN) :: phis (ip1jmp1) !--- GROUND GEOPOTENTIAL |
|---|
| 27 | REAL, INTENT(IN) :: phi (ip1jmp1, llm) !--- 3D GEOPOTENTIAL |
|---|
| 28 | REAL, INTENT(OUT) :: w (ip1jmp1, llm) !--- VERTICAL WIND |
|---|
| 29 | REAL, INTENT(OUT) :: pbaru(ip1jmp1, llm) !--- U MASS FLUX |
|---|
| 30 | REAL, INTENT(OUT) :: pbarv(ip1jm, llm) !--- V MASS FLUX |
|---|
| 31 | REAL, INTENT(IN) :: time !--- TIME |
|---|
| 32 | !=============================================================================== |
|---|
| 33 | ! Local variables: |
|---|
| 34 | REAL, DIMENSION(ip1jmp1, llmp1) :: p |
|---|
| 35 | REAL, DIMENSION(ip1jmp1, llm) :: ucont, massebx, ang, ecin, convm, bern |
|---|
| 36 | REAL, DIMENSION(ip1jmp1) :: dp |
|---|
| 37 | REAL, DIMENSION(ip1jm, llm) :: vcont, masseby, massebxy, vorpot |
|---|
| 38 | REAL, DIMENSION(ip1jm) :: psexbarxy |
|---|
| 39 | INTEGER :: ij, l |
|---|
| 40 | !=============================================================================== |
|---|
| 41 | CALL covcont (llm, ucov, vcov, ucont, vcont) |
|---|
| 42 | CALL pression (ip1jmp1, ap, bp, ps, p) |
|---|
| 43 | CALL psextbar (ps, psexbarxy) |
|---|
| 44 | CALL massdair (p, masse) |
|---|
| 45 | CALL massbar (masse, massebx, masseby) |
|---|
| 46 | CALL massbarxy(masse, massebxy) |
|---|
| 47 | CALL flumass (massebx, masseby, vcont, ucont, pbaru, pbarv) |
|---|
| 48 | CALL convmas (pbaru, pbarv, convm) |
|---|
| 49 | CALL vitvert (convm, w) |
|---|
| 50 | CALL tourpot (vcov, ucov, massebxy, vorpot) |
|---|
| 51 | CALL enercin (vcov, ucov, vcont, ucont, ecin) |
|---|
| 52 | CALL bernoui (ip1jmp1, llm, phi, ecin, bern) |
|---|
| 53 | DO l = 1, llm; ang(:, l) = ucov(:, l) + constang(:); |
|---|
| 54 | END DO |
|---|
| 55 | resetvarc = .TRUE. ! force a recomputation of initial values in sortvarc |
|---|
| 56 | dp(:) = convm(:, 1) / airesurg(:) |
|---|
| 57 | CALL sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, time, vcov) |
|---|
| 58 | |
|---|
| 59 | END SUBROUTINE caldyn0 |
|---|