[1987] | 1 | ! $Id: caldyn.F90 5113 2024-07-24 11:17:08Z abarral $ |
---|
[5099] | 2 | |
---|
[5103] | 3 | SUBROUTINE caldyn & |
---|
| 4 | (itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, & |
---|
| 5 | phi, conser, du, dv, dteta, dp, w, pbaru, pbarv, time) |
---|
[524] | 6 | |
---|
[5103] | 7 | USE comvert_mod, ONLY: ap, bp |
---|
[524] | 8 | |
---|
[5103] | 9 | IMPLICIT NONE |
---|
[5099] | 10 | |
---|
[5103] | 11 | !======================================================================= |
---|
[5099] | 12 | |
---|
[5103] | 13 | ! Auteur : P. Le Van |
---|
[5099] | 14 | |
---|
[5103] | 15 | ! Objet: |
---|
| 16 | ! ------ |
---|
[5099] | 17 | |
---|
[5103] | 18 | ! Calcul des tendances dynamiques. |
---|
[524] | 19 | |
---|
[5103] | 20 | ! Modif 04/93 F.Forget |
---|
| 21 | !======================================================================= |
---|
[524] | 22 | |
---|
[5103] | 23 | !----------------------------------------------------------------------- |
---|
| 24 | ! 0. Declarations: |
---|
| 25 | ! ---------------- |
---|
[524] | 26 | |
---|
[5103] | 27 | include "dimensions.h" |
---|
| 28 | include "paramet.h" |
---|
| 29 | include "comgeom.h" |
---|
[524] | 30 | |
---|
[5103] | 31 | ! Arguments: |
---|
| 32 | ! ---------- |
---|
[524] | 33 | |
---|
[5103] | 34 | LOGICAL, INTENT(IN) :: conser ! triggers printing some diagnostics |
---|
| 35 | INTEGER, INTENT(IN) :: itau ! time step index |
---|
| 36 | REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind |
---|
| 37 | REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind |
---|
| 38 | REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature |
---|
| 39 | REAL, INTENT(IN) :: ps(ip1jmp1) ! surface pressure |
---|
| 40 | REAL, INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface |
---|
| 41 | REAL, INTENT(IN) :: pk(ip1jmp1, llm) ! Exner at mid-layer |
---|
| 42 | REAL, INTENT(IN) :: pkf(ip1jmp1, llm) ! filtered Exner |
---|
| 43 | REAL, INTENT(IN) :: phi(ip1jmp1, llm) ! geopotential |
---|
| 44 | REAL, INTENT(OUT) :: masse(ip1jmp1, llm) ! air mass |
---|
| 45 | REAL, INTENT(OUT) :: dv(ip1jm, llm) ! tendency on vcov |
---|
| 46 | REAL, INTENT(OUT) :: du(ip1jmp1, llm) ! tendency on ucov |
---|
| 47 | REAL, INTENT(OUT) :: dteta(ip1jmp1, llm) ! tenddency on teta |
---|
| 48 | REAL, INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps |
---|
| 49 | REAL, INTENT(OUT) :: w(ip1jmp1, llm) ! vertical velocity |
---|
| 50 | REAL, INTENT(OUT) :: pbaru(ip1jmp1, llm) ! mass flux in the zonal direction |
---|
| 51 | REAL, INTENT(OUT) :: pbarv(ip1jm, llm) ! mass flux in the meridional direction |
---|
| 52 | REAL, INTENT(IN) :: time ! current time |
---|
[1987] | 53 | |
---|
[5103] | 54 | ! Local: |
---|
| 55 | ! ------ |
---|
[524] | 56 | |
---|
[5103] | 57 | REAL :: vcont(ip1jm, llm), ucont(ip1jmp1, llm) |
---|
| 58 | REAL :: ang(ip1jmp1, llm), p(ip1jmp1, llmp1) |
---|
| 59 | REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm) |
---|
| 60 | REAL :: vorpot(ip1jm, llm) |
---|
| 61 | REAL :: ecin(ip1jmp1, llm), convm(ip1jmp1, llm) |
---|
| 62 | REAL :: bern(ip1jmp1, llm) |
---|
| 63 | REAL :: massebxy(ip1jm, llm) |
---|
[524] | 64 | |
---|
[5103] | 65 | INTEGER :: ij, l |
---|
[524] | 66 | |
---|
[5103] | 67 | !----------------------------------------------------------------------- |
---|
| 68 | ! Compute dynamical tendencies: |
---|
| 69 | !-------------------------------- |
---|
[524] | 70 | |
---|
[5113] | 71 | ! compute contravariant winds ucont() and vcont |
---|
[5103] | 72 | CALL covcont (llm, ucov, vcov, ucont, vcont) |
---|
[5113] | 73 | ! compute pressure p() |
---|
[5103] | 74 | CALL pression (ip1jmp1, ap, bp, ps, p) |
---|
[5113] | 75 | ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?) |
---|
[5103] | 76 | CALL psextbar (ps, psexbarxy) |
---|
[5113] | 77 | ! compute mass in each atmospheric mesh: masse() |
---|
[5103] | 78 | CALL massdair (p, masse) |
---|
[5113] | 79 | ! compute X and Y-averages of mass, massebx() and masseby() |
---|
[5103] | 80 | CALL massbar (masse, massebx, masseby) |
---|
[5113] | 81 | ! compute XY-average of mass, massebxy() |
---|
[5103] | 82 | CALL massbarxy(masse, massebxy) |
---|
[5113] | 83 | ! compute mass fluxes pbaru() and pbarv() |
---|
[5103] | 84 | CALL flumass (massebx, masseby, vcont, ucont, pbaru, pbarv) |
---|
[5113] | 85 | ! compute dteta() , horizontal converging flux of theta |
---|
[5103] | 86 | CALL dteta1 (teta, pbaru, pbarv, dteta) |
---|
[5113] | 87 | ! compute convm(), horizontal converging flux of mass |
---|
[5103] | 88 | CALL convmas (pbaru, pbarv, convm) |
---|
[524] | 89 | |
---|
[5113] | 90 | ! compute pressure variation due to mass convergence |
---|
[5103] | 91 | DO ij = 1, ip1jmp1 |
---|
| 92 | dp(ij) = convm(ij, 1) / airesurg(ij) |
---|
| 93 | ENDDO |
---|
[524] | 94 | |
---|
[5113] | 95 | ! compute vertical velocity w() |
---|
[5103] | 96 | CALL vitvert (convm, w) |
---|
[5113] | 97 | ! compute potential vorticity vorpot() |
---|
[5103] | 98 | CALL tourpot (vcov, ucov, massebxy, vorpot) |
---|
[5113] | 99 | ! compute rotation induced du() and dv() |
---|
[5103] | 100 | CALL dudv1 (vorpot, pbaru, pbarv, du, dv) |
---|
[5113] | 101 | ! compute kinetic energy ecin() |
---|
[5103] | 102 | CALL enercin (vcov, ucov, vcont, ucont, ecin) |
---|
[5113] | 103 | ! compute Bernouilli function bern() |
---|
[5103] | 104 | CALL bernoui (ip1jmp1, llm, phi, ecin, bern) |
---|
[5113] | 105 | ! compute and add du() and dv() contributions from Bernouilli and pressure |
---|
[5103] | 106 | CALL dudv2 (teta, pkf, bern, du, dv) |
---|
[524] | 107 | |
---|
[5103] | 108 | DO l = 1, llm |
---|
| 109 | DO ij = 1, ip1jmp1 |
---|
| 110 | ang(ij, l) = ucov(ij, l) + constang(ij) |
---|
| 111 | ENDDO |
---|
| 112 | ENDDO |
---|
[524] | 113 | |
---|
[5113] | 114 | ! compute vertical advection contributions to du(), dv() and dteta() |
---|
[5103] | 115 | CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta) |
---|
[524] | 116 | |
---|
[5103] | 117 | ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi |
---|
| 118 | ! probablement. Observe sur le code compile avec pgf90 3.0-1 |
---|
[524] | 119 | |
---|
[5103] | 120 | DO l = 1, llm |
---|
| 121 | DO ij = 1, ip1jm, iip1 |
---|
| 122 | IF(dv(ij, l)/=dv(ij + iim, l)) THEN |
---|
| 123 | ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', |
---|
| 124 | ! , ' dans caldyn' |
---|
| 125 | ! PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l) |
---|
| 126 | dv(ij + iim, l) = dv(ij, l) |
---|
| 127 | ENDIF |
---|
| 128 | ENDDO |
---|
| 129 | ENDDO |
---|
[524] | 130 | |
---|
[5103] | 131 | !----------------------------------------------------------------------- |
---|
| 132 | ! Output some control variables: |
---|
| 133 | !--------------------------------- |
---|
[1987] | 134 | |
---|
[5103] | 135 | IF(conser) THEN |
---|
| 136 | CALL sortvarc & |
---|
| 137 | (itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, time, vcov) |
---|
| 138 | ENDIF |
---|
[524] | 139 | |
---|
[5103] | 140 | END SUBROUTINE caldyn |
---|