| 1 | ! $Id: integrd.F90 5159 2024-08-02 19:58:25Z dcugnet $ |
|---|
| 2 | |
|---|
| 3 | SUBROUTINE integrd & |
|---|
| 4 | (nq, vcovm1, ucovm1, tetam1, psm1, massem1, & |
|---|
| 5 | dv, du, dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis & !,finvmaold |
|---|
| 6 | ) |
|---|
| 7 | |
|---|
| 8 | USE control_mod, ONLY: planet_type |
|---|
| 9 | USE comconst_mod, ONLY: pi |
|---|
| 10 | USE logic_mod, ONLY: leapf |
|---|
| 11 | USE comvert_mod, ONLY: ap, bp |
|---|
| 12 | USE temps_mod, ONLY: dt |
|---|
| 13 | USE lmdz_iniprint, ONLY: lunout, prt_level |
|---|
| 14 | USE lmdz_ssum_scopy, ONLY: scopy, ssum |
|---|
| 15 | USE lmdz_comgeom |
|---|
| 16 | |
|---|
| 17 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
|---|
| 18 | USE lmdz_paramet |
|---|
| 19 | IMPLICIT NONE |
|---|
| 20 | |
|---|
| 21 | |
|---|
| 22 | !======================================================================= |
|---|
| 23 | |
|---|
| 24 | ! Auteur: P. Le Van |
|---|
| 25 | ! ------- |
|---|
| 26 | |
|---|
| 27 | ! objet: |
|---|
| 28 | ! ------ |
|---|
| 29 | |
|---|
| 30 | ! Incrementation des tendances dynamiques |
|---|
| 31 | |
|---|
| 32 | !======================================================================= |
|---|
| 33 | !----------------------------------------------------------------------- |
|---|
| 34 | ! Declarations: |
|---|
| 35 | ! ------------- |
|---|
| 36 | |
|---|
| 37 | |
|---|
| 38 | |
|---|
| 39 | |
|---|
| 40 | ! Arguments: |
|---|
| 41 | ! ---------- |
|---|
| 42 | |
|---|
| 43 | INTEGER, INTENT(IN) :: nq ! number of tracers to handle in this routine |
|---|
| 44 | REAL, INTENT(INOUT) :: vcov(ip1jm, llm) ! covariant meridional wind |
|---|
| 45 | REAL, INTENT(INOUT) :: ucov(ip1jmp1, llm) ! covariant zonal wind |
|---|
| 46 | REAL, INTENT(INOUT) :: teta(ip1jmp1, llm) ! potential temperature |
|---|
| 47 | REAL, INTENT(INOUT) :: q(ip1jmp1, llm, nq) ! advected tracers |
|---|
| 48 | REAL, INTENT(INOUT) :: ps(ip1jmp1) ! surface pressure |
|---|
| 49 | REAL, INTENT(INOUT) :: masse(ip1jmp1, llm) ! atmospheric mass |
|---|
| 50 | REAL, INTENT(IN) :: phis(ip1jmp1) ! ground geopotential !!! unused |
|---|
| 51 | ! values at previous time step |
|---|
| 52 | REAL, INTENT(INOUT) :: vcovm1(ip1jm, llm) |
|---|
| 53 | REAL, INTENT(INOUT) :: ucovm1(ip1jmp1, llm) |
|---|
| 54 | REAL, INTENT(INOUT) :: tetam1(ip1jmp1, llm) |
|---|
| 55 | REAL, INTENT(INOUT) :: psm1(ip1jmp1) |
|---|
| 56 | REAL, INTENT(INOUT) :: massem1(ip1jmp1, llm) |
|---|
| 57 | ! the tendencies to add |
|---|
| 58 | REAL, INTENT(IN) :: dv(ip1jm, llm) |
|---|
| 59 | REAL, INTENT(IN) :: du(ip1jmp1, llm) |
|---|
| 60 | REAL, INTENT(IN) :: dteta(ip1jmp1, llm) |
|---|
| 61 | REAL, INTENT(IN) :: dp(ip1jmp1) |
|---|
| 62 | REAL, INTENT(IN) :: dq(ip1jmp1, llm, nq) !!! unused |
|---|
| 63 | ! REAL,INTENT(OUT) :: finvmaold(ip1jmp1,llm) !!! unused |
|---|
| 64 | |
|---|
| 65 | ! Local: |
|---|
| 66 | ! ------ |
|---|
| 67 | |
|---|
| 68 | REAL :: vscr(ip1jm), uscr(ip1jmp1), hscr(ip1jmp1), pscr(ip1jmp1) |
|---|
| 69 | REAL :: massescr(ip1jmp1, llm) |
|---|
| 70 | ! REAL finvmasse(ip1jmp1,llm) |
|---|
| 71 | REAL :: p(ip1jmp1, llmp1) |
|---|
| 72 | REAL :: tpn, tps, tppn(iim), tpps(iim) |
|---|
| 73 | REAL :: qpn, qps, qppn(iim), qpps(iim) |
|---|
| 74 | REAL :: deltap(ip1jmp1, llm) |
|---|
| 75 | |
|---|
| 76 | INTEGER :: l, ij, iq, i, j |
|---|
| 77 | |
|---|
| 78 | !----------------------------------------------------------------------- |
|---|
| 79 | |
|---|
| 80 | DO l = 1, llm |
|---|
| 81 | DO ij = 1, iip1 |
|---|
| 82 | ucov(ij, l) = 0. |
|---|
| 83 | ucov(ij + ip1jm, l) = 0. |
|---|
| 84 | uscr(ij) = 0. |
|---|
| 85 | uscr(ij + ip1jm) = 0. |
|---|
| 86 | ENDDO |
|---|
| 87 | ENDDO |
|---|
| 88 | |
|---|
| 89 | |
|---|
| 90 | ! ............ integration de ps .............. |
|---|
| 91 | |
|---|
| 92 | CALL SCOPY(ip1jmp1 * llm, masse, 1, massescr, 1) |
|---|
| 93 | |
|---|
| 94 | DO ij = 1, ip1jmp1 |
|---|
| 95 | pscr (ij) = ps(ij) |
|---|
| 96 | ps (ij) = psm1(ij) + dt * dp(ij) |
|---|
| 97 | ENDDO |
|---|
| 98 | |
|---|
| 99 | DO ij = 1, ip1jmp1 |
|---|
| 100 | IF(ps(ij)<0.) THEN |
|---|
| 101 | WRITE(lunout, *) "integrd: negative surface pressure ", ps(ij) |
|---|
| 102 | WRITE(lunout, *) " at node ij =", ij |
|---|
| 103 | ! since ij=j+(i-1)*jjp1 , we have |
|---|
| 104 | j = modulo(ij, jjp1) |
|---|
| 105 | i = 1 + (ij - j) / jjp1 |
|---|
| 106 | WRITE(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", & |
|---|
| 107 | " lat = ", rlatu(j) * 180. / pi, " deg" |
|---|
| 108 | CALL abort_gcm("integrd", "", 1) |
|---|
| 109 | ENDIF |
|---|
| 110 | ENDDO |
|---|
| 111 | |
|---|
| 112 | DO ij = 1, iim |
|---|
| 113 | tppn(ij) = aire(ij) * ps(ij) |
|---|
| 114 | tpps(ij) = aire(ij + ip1jm) * ps(ij + ip1jm) |
|---|
| 115 | ENDDO |
|---|
| 116 | tpn = SSUM(iim, tppn, 1) / apoln |
|---|
| 117 | tps = SSUM(iim, tpps, 1) / apols |
|---|
| 118 | DO ij = 1, iip1 |
|---|
| 119 | ps(ij) = tpn |
|---|
| 120 | ps(ij + ip1jm) = tps |
|---|
| 121 | ENDDO |
|---|
| 122 | |
|---|
| 123 | ! ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ... |
|---|
| 124 | |
|---|
| 125 | CALL pression (ip1jmp1, ap, bp, ps, p) |
|---|
| 126 | CALL massdair (p, masse) |
|---|
| 127 | |
|---|
| 128 | ! Ehouarn : we don't use/need finvmaold and finvmasse, |
|---|
| 129 | ! so might as well not compute them |
|---|
| 130 | ! CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 ) |
|---|
| 131 | ! CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1 ) |
|---|
| 132 | ! |
|---|
| 133 | |
|---|
| 134 | ! ............ integration de ucov, vcov, h .............. |
|---|
| 135 | |
|---|
| 136 | DO l = 1, llm |
|---|
| 137 | |
|---|
| 138 | DO ij = iip2, ip1jm |
|---|
| 139 | uscr(ij) = ucov(ij, l) |
|---|
| 140 | ucov(ij, l) = ucovm1(ij, l) + dt * du(ij, l) |
|---|
| 141 | ENDDO |
|---|
| 142 | |
|---|
| 143 | DO ij = 1, ip1jm |
|---|
| 144 | vscr(ij) = vcov(ij, l) |
|---|
| 145 | vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l) |
|---|
| 146 | ENDDO |
|---|
| 147 | |
|---|
| 148 | DO ij = 1, ip1jmp1 |
|---|
| 149 | hscr(ij) = teta(ij, l) |
|---|
| 150 | teta (ij, l) = tetam1(ij, l) * massem1(ij, l) / masse(ij, l) & |
|---|
| 151 | + dt * dteta(ij, l) / masse(ij, l) |
|---|
| 152 | ENDDO |
|---|
| 153 | |
|---|
| 154 | ! .... Calcul de la valeur moyenne, unique aux poles pour teta ...... |
|---|
| 155 | |
|---|
| 156 | |
|---|
| 157 | DO ij = 1, iim |
|---|
| 158 | tppn(ij) = aire(ij) * teta(ij, l) |
|---|
| 159 | tpps(ij) = aire(ij + ip1jm) * teta(ij + ip1jm, l) |
|---|
| 160 | ENDDO |
|---|
| 161 | tpn = SSUM(iim, tppn, 1) / apoln |
|---|
| 162 | tps = SSUM(iim, tpps, 1) / apols |
|---|
| 163 | |
|---|
| 164 | DO ij = 1, iip1 |
|---|
| 165 | teta(ij, l) = tpn |
|---|
| 166 | teta(ij + ip1jm, l) = tps |
|---|
| 167 | ENDDO |
|---|
| 168 | ! |
|---|
| 169 | |
|---|
| 170 | IF(leapf) THEN |
|---|
| 171 | CALL SCOPY (ip1jmp1, uscr(1), 1, ucovm1(1, l), 1) |
|---|
| 172 | CALL SCOPY (ip1jm, vscr(1), 1, vcovm1(1, l), 1) |
|---|
| 173 | CALL SCOPY (ip1jmp1, hscr(1), 1, tetam1(1, l), 1) |
|---|
| 174 | END IF |
|---|
| 175 | |
|---|
| 176 | ENDDO ! of DO l = 1,llm |
|---|
| 177 | |
|---|
| 178 | |
|---|
| 179 | |
|---|
| 180 | ! ....... integration de q ...... |
|---|
| 181 | |
|---|
| 182 | !$$$ IF( iadv(1).NE.3.AND.iadv(2).NE.3 ) THEN |
|---|
| 183 | !$$$c |
|---|
| 184 | !$$$ IF( forward .OR. leapf ) THEN |
|---|
| 185 | !$$$ DO iq = 1,2 |
|---|
| 186 | !$$$ DO l = 1,llm |
|---|
| 187 | !$$$ DO ij = 1,ip1jmp1 |
|---|
| 188 | !$$$ q(ij,l,iq) = ( q(ij,l,iq)*finvmaold(ij,l) + dtvr *dq(ij,l,iq) )/ |
|---|
| 189 | !$$$ $ finvmasse(ij,l) |
|---|
| 190 | !$$$ ENDDO |
|---|
| 191 | !$$$ ENDDO |
|---|
| 192 | !$$$ ENDDO |
|---|
| 193 | !$$$ ELSE |
|---|
| 194 | !$$$ DO iq = 1,2 |
|---|
| 195 | !$$$ DO l = 1,llm |
|---|
| 196 | !$$$ DO ij = 1,ip1jmp1 |
|---|
| 197 | !$$$ q( ij,l,iq ) = q( ij,l,iq ) * finvmaold(ij,l) / finvmasse(ij,l) |
|---|
| 198 | !$$$ ENDDO |
|---|
| 199 | !$$$ ENDDO |
|---|
| 200 | !$$$ ENDDO |
|---|
| 201 | !$$$ |
|---|
| 202 | !$$$ END IF |
|---|
| 203 | !$$$c |
|---|
| 204 | !$$$ ENDIF |
|---|
| 205 | |
|---|
| 206 | IF (planet_type=="earth") THEN |
|---|
| 207 | ! Earth-specific treatment of first 2 tracers (water) |
|---|
| 208 | DO l = 1, llm |
|---|
| 209 | DO ij = 1, ip1jmp1 |
|---|
| 210 | deltap(ij, l) = p(ij, l) - p(ij, l + 1) |
|---|
| 211 | ENDDO |
|---|
| 212 | ENDDO |
|---|
| 213 | |
|---|
| 214 | CALL qminimum(q, nq, deltap) |
|---|
| 215 | |
|---|
| 216 | |
|---|
| 217 | ! ..... Calcul de la valeur moyenne, unique aux poles pour q ..... |
|---|
| 218 | ! |
|---|
| 219 | |
|---|
| 220 | DO iq = 1, nq |
|---|
| 221 | DO l = 1, llm |
|---|
| 222 | |
|---|
| 223 | DO ij = 1, iim |
|---|
| 224 | qppn(ij) = aire(ij) * q(ij, l, iq) |
|---|
| 225 | qpps(ij) = aire(ij + ip1jm) * q(ij + ip1jm, l, iq) |
|---|
| 226 | ENDDO |
|---|
| 227 | qpn = SSUM(iim, qppn, 1) / apoln |
|---|
| 228 | qps = SSUM(iim, qpps, 1) / apols |
|---|
| 229 | |
|---|
| 230 | DO ij = 1, iip1 |
|---|
| 231 | q(ij, l, iq) = qpn |
|---|
| 232 | q(ij + ip1jm, l, iq) = qps |
|---|
| 233 | ENDDO |
|---|
| 234 | |
|---|
| 235 | ENDDO |
|---|
| 236 | ENDDO |
|---|
| 237 | |
|---|
| 238 | ! Ehouarn: forget about finvmaold |
|---|
| 239 | ! CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 ) |
|---|
| 240 | |
|---|
| 241 | ENDIF ! of if (planet_type.EQ."earth") |
|---|
| 242 | |
|---|
| 243 | |
|---|
| 244 | ! ..... FIN de l'integration de q ....... |
|---|
| 245 | |
|---|
| 246 | ! ................................................................. |
|---|
| 247 | |
|---|
| 248 | IF(leapf) THEN |
|---|
| 249 | CALL SCOPY (ip1jmp1, pscr, 1, psm1, 1) |
|---|
| 250 | CALL SCOPY (ip1jmp1 * llm, massescr, 1, massem1, 1) |
|---|
| 251 | END IF |
|---|
| 252 | |
|---|
| 253 | END SUBROUTINE integrd |
|---|
