SUBROUTINE drag_noro (klon,klev,dtime,pplay,pplev, e pvar, psig, pgam, pthe, e kgwd,kgwdim,kdx,ktest, e t, u, v, s pulow, pvlow, pustr, pvstr, s d_t, d_u, d_v) C**** *DRAG_NORO* INTERFACE FOR SUB-GRID SCALE OROGRAPHIC SCHEME C C PURPOSE. C -------- C ZEROS TENDENCIES, COMPUTES GEOPOTENTIAL HEIGHT AND UPDATES THE C TENDENCIES AFTER THE SCHEME HAS BEEN CALLED. C C EXPLICIT ARGUMENTS : C -------------------- C C INPUT : C C NLON : NUMBER OF HORIZONTAL GRID POINTS C NLEV : NUMBER OF LEVELS C DTIME : LENGTH OF TIME STEP C PPLAY(NLON,NLEV+1) : PRESSURE AT MIDDLE LEVELS C PPLEV(NLON,NLEV) : PRESSURE ON MODEL LEVELS C PVAR(NLON) : SUB-GRID SCALE STANDARD DEVIATION C PSIG(NLON) : SUB-GRID SCALE SLOPE C PGAM(NLON) : SUB-GRID SCALE ANISOTROPY C PTHE(NLON) : SUB-GRID SCALE PRINCIPAL AXES ANGLE C KGWD : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED C KGWDIM : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED C KDX(NLON) : POINTS AT WHICH TO CALL THE SCHEME C KTEST(NLON) : MAP OF CALLING POINTS C T(NLON,NLEV) : TEMPERATURE C U(NLON,NLEV) : ZONAL WIND C V(NLON,NLEV) : MERIDIONAL WIND C C OUTPUT : C C PULOW(NLON) : LOW LEVEL ZONAL WIND C PVLOW(NLON) : LOW LEVEL MERIDIONAL WIND C PUSTR(NLON) : LOW LEVEL ZONAL STRESS C PVSTR(NLON) : LOW LEVEL MERIDIONAL STRESS C D_T(NLON,NLEV) : TEMPERATURE TENDENCY C D_U(NLON,NLEV) : ZONAL WIND TENDENCY C D_V(NLON,NLEV) : MERIDIONAL WIND TENDENCY C C IMPLICIT ARGUMENTS : C -------------------- C C comcstfi.h C dimphys.h C c use dimradmars_mod, only: ndlo2 USE comcstfi_h IMPLICIT none c====================================================================== c Auteur(s): Z.X. Li F.Lott (LMD/CNRS) date: 19950201 c Objet: Frottement de la montagne Interface c====================================================================== c Arguments: c dtime---input-R- pas d'integration (s) c s-------input-R-la valeur "s" pour chaque couche c pplay--input-R- pression au milieu des couches en Pa c pplev--input-R-pression au bords des couches en Pa c t-------input-R-temperature (K) c u-------input-R-vitesse horizontale (m/s) c v-------input-R-vitesse horizontale (m/s) c c d_t-----output-R-increment de la temperature t c d_u-----output-R-increment de la vitesse u c d_v-----output-R-increment de la vitesse v c====================================================================== !#include "dimensions.h" !#include "dimphys.h" !#include "dimradmars.h" c c ARGUMENTS c REAL dtime INTEGER klon,klev real pplay(NDLO2,klev),pplev(NDLO2,klev+1) REAL pvar(NDLO2),psig(NDLO2),pgam(NDLO2),pthe(NDLO2) REAL pulow(NDLO2),pvlow(NDLO2),pustr(NDLO2),pvstr(NDLO2) REAL u(NDLO2,klev), v(NDLO2,klev),t(NDLO2,klev) REAL d_t(NDLO2,klev), d_u(NDLO2,klev), d_v(NDLO2,klev) c INTEGER i, k, kgwd, kgwdim, kdx(NDLO2), ktest(NDLO2) c c Variables locales: c REAL paprs(NDLO2,klev+1) REAL paprsf(NDLO2,klev) REAL zgeom(NDLO2,klev) REAL pdtdt(NDLO2,klev) REAL pdudt(NDLO2,klev), pdvdt(NDLO2,klev) REAL pt(NDLO2,klev), pu(NDLO2,klev) REAL pv(NDLO2,klev) c c initialiser les variables de sortie (pour securite) c DO i = 1,klon pulow(i) = 0.0 pvlow(i) = 0.0 pustr(i) = 0.0 pvstr(i) = 0.0 ENDDO DO k = 1, klev DO i = 1, klon d_t(i,k) = 0.0 d_u(i,k) = 0.0 d_v(i,k) = 0.0 pdudt(i,k)=0.0 pdvdt(i,k)=0.0 pdtdt(i,k)=0.0 ENDDO ENDDO c c preparer les variables d'entree (attention: l'ordre des niveaux c verticaux augmente du haut vers le bas) c DO k = 1, klev DO i = 1, klon pt(i,k) = t(i,klev-k+1) pu(i,k) = u(i,klev-k+1) pv(i,k) = v(i,klev-k+1) paprsf(i,k) = pplay(i,klev-k+1) paprs(i,k) = pplev(i,klev+1-k+1) ENDDO ENDDO DO i = 1, klon paprs(i,klev+1) = pplev(i,1) ENDDO DO i = 1, klon zgeom(i,klev) = r * pt(i,klev) . * LOG(paprs(i,klev+1)/paprsf(i,klev)) ENDDO DO k = klev-1, 1, -1 DO i = 1, klon zgeom(i,k) = zgeom(i,k+1) + r * (pt(i,k)+pt(i,k+1))/2.0 . * LOG(paprsf(i,k+1)/paprsf(i,k)) ENDDO ENDDO c c appeler la routine principale c CALL ORODRAG(klon,klev,kgwd,kgwdim,kdx,ktest, . dtime, . paprs, paprsf, zgeom, . pt, pu, pv, pvar, psig, pgam, pthe, . pulow,pvlow, . pdudt,pdvdt,pdtdt) C DO k = 1, klev DO i = 1, klon d_u(i,klev+1-k) = dtime*pdudt(i,k) d_v(i,klev+1-k) = dtime*pdvdt(i,k) d_t(i,klev+1-k) = dtime*pdtdt(i,k) pustr(i) = pustr(i) . +g*pdudt(i,k)*(paprs(i,k+1)-paprs(i,k)) pvstr(i) = pvstr(i) . +g*pdvdt(i,k)*(paprs(i,k+1)-paprs(i,k)) ENDDO ENDDO c RETURN END