--- trunk/libf/dyn3d/exner_hyb.f90 2008/02/27 13:16:39 3 +++ trunk/libf/dyn3d/exner_hyb.f90 2008/04/18 14:45:53 10 @@ -8,30 +8,30 @@ ! From dyn3d/exner_hyb.F, v 1.1.1.1 2004/05/19 12:53:07 - ! Auteurs : P. Le Van, F. Hourdin. + ! Authors : P. Le Van, F. Hourdin ! Calcule la fonction d'Exner : ! pk = Cp * p ** kappa - ! aux milieux des couches. - ! Pk(l) est calculé aux milieux des couches "l", entre les pressions - ! "p(l)" et "p(l+1)", définies aux interfaces des "llm" couches. + ! aux milieux des "llm" couches. + ! "Pk(l)" est calculé au milieu de la couche "l", entre les pressions + ! "p(l)" et "p(l+1)", définies aux interfaces des couches. ! Au sommet de l'atmosphère : ! p(llm+1) = 0. - ! et ps et pks sont la pression et la fonction d'Exner au sol. + ! "ps" et "pks" sont la pression et la fonction d'Exner au sol. ! À partir des relations : ! -------- z - !(1) p*dz(pk) = kappa *pk*dz(p) + !(1) p*dz(pk) = kappa * pk * dz(p) - !(2) pk(l) = alpha(l)+ beta(l)*pk(l-1) + !(2) pk(l) = alpha(l)+ beta(l) * pk(l-1) - ! (voir note de F. Hourdin), on determine successivement, du haut + ! (voir note de F. Hourdin), on détermine successivement, du haut ! vers le bas des couches, les coefficients : ! alpha(llm), beta(llm)..., alpha(l), beta(l)..., alpha(2), beta(2) - ! puis "pk(ij, 1)". - ! Ensuite, on calcule, du bas vers le haut des couches, "pk(ij, l)" + ! puis "pk(:, 1)". + ! Ensuite, on calcule, du bas vers le haut des couches, "pk(:, l)" ! donné par la relation (2), pour l = 2 à l = llm. use dimens_m, only: iim, jjm, llm @@ -49,52 +49,44 @@ ! Variables locales real alpha((iim + 1) * (jjm + 1), llm), beta((iim + 1) * (jjm + 1), llm) - INTEGER l, ij - REAL unpl2k, dellta + INTEGER l + REAL unpl2k, dellta((iim + 1) * (jjm + 1)) REAL ppn(iim), pps(iim) - REAL xpn, xps - REAL SSUM !------------------------------------- - pks(:) = cpp * (ps(:) / preff)**kappa - ppn(:) = aire_2d(:iim, 1) * pks(:iim) - pps(:) = aire_2d(:iim, jjm + 1) & + pks = cpp * (ps / preff)**kappa + ppn = aire_2d(:iim, 1) * pks(:iim) + pps = aire_2d(:iim, jjm + 1) & * pks(1 + (iim + 1) * jjm: iim + (iim + 1) * jjm) - xpn = SSUM(iim, ppn, 1) /apoln - xps = SSUM(iim, pps, 1) /apols - pks(:iim + 1) = xpn - pks(1+(iim + 1) * jjm:) = xps + pks(:iim + 1) = SUM(ppn) /apoln + pks(1+(iim + 1) * jjm:) = SUM(pps) /apols unpl2k = 1. + 2 * kappa - ! Calcul des coeff. alpha et beta pour la couche l = llm + ! Calcul des coefficients alpha et beta pour la couche l = llm : alpha(:, llm) = 0. - beta (:, llm) = 1./ unpl2k + beta(:, llm) = 1./ unpl2k - ! Calcul des coeff. alpha et beta pour l = llm-1 à l = 2 - DO l = llm -1 , 2 , -1 - DO ij = 1, (iim + 1) * (jjm + 1) - dellta = p(ij, l)* unpl2k + p(ij, l+1)* ( beta(ij, l+1)-unpl2k ) - alpha(ij, l) = - p(ij, l+1) / dellta * alpha(ij, l+1) - beta (ij, l) = p(ij, l ) / dellta - ENDDO + ! Calcul des coefficients alpha et beta pour l = llm-1 à l = 2 : + DO l = llm - 1, 2, -1 + dellta = p(:, l) * unpl2k + p(:, l+1) * (beta(:, l+1) - unpl2k) + alpha(:, l) = - p(:, l+1) / dellta * alpha(:, l+1) + beta(:, l) = p(:, l) / dellta ENDDO ! Calcul de pk pour la couche 1, près du sol : - pk(:, 1) = (p(:, 1) * pks(:) - 0.5 * alpha(:, 2) * p(:, 2)) & + pk(:, 1) = (p(:, 1) * pks - 0.5 * alpha(:, 2) * p(:, 2)) & / (p(:, 1) * (1. + kappa) + 0.5 * (beta(:, 2) - unpl2k) * p(:, 2)) - ! Calcul de pk(ij, l) , pour l = 2 à l = llm + ! Calcul de pk(:, l) pour l = 2 à l = llm : DO l = 2, llm - DO ij = 1, (iim + 1) * (jjm + 1) - pk(ij, l) = alpha(ij, l) + beta(ij, l) * pk(ij, l-1) - ENDDO + pk(:, l) = alpha(:, l) + beta(:, l) * pk(:, l-1) ENDDO if (present(pkf)) then - pkf(:, :) = pk(:, :) + pkf = pk CALL filtreg(pkf, jjm + 1, llm, 2, 1, .TRUE., 1) end if