source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/screenc.F90 @ 3485

Last change on this file since 3485 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 3.9 KB
RevLine 
[3331]1!
2! $Header$
3!
4      SUBROUTINE screenc(klon, knon, nsrf, zxli, &
5                         speed, temp, q_zref, zref, &
6                         ts, qsurf, z0m, z0h, psol, &
7                         ustar, testar, qstar, okri, ri1, &
8                         pref, delu, delte, delq)
9      IMPLICIT NONE
10!-----------------------------------------------------------------------
11!
12! Objet : calcul "correcteur" des anomalies du vent, de la temperature
13!         potentielle et de l'humidite relative au niveau de reference zref et
14!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
15!         a partir des equations de Louis.
16!
17! Reference : Hess, Colman et McAvaney (1995)
18!
19! I. Musat, 01.07.2002
20!-----------------------------------------------------------------------
21!
22! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
23! knon----input-I- nombre de points pour un type de surface
24! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
25! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
26! speed---input-R- module du vent au 1er niveau du modele
27! temp----input-R- temperature de l'air au 1er niveau du modele
28! q_zref--input-R- humidite relative au 1er niveau du modele
29! zref----input-R- altitude de reference
30! ts------input-R- temperature de l'air a la surface
31! qsurf---input-R- humidite relative a la surface
32! z0m, z0h---input-R- rugosite
33! psol----input-R- pression au sol
34! ustar---input-R- facteur d'echelle pour le vent
35! testar--input-R- facteur d'echelle pour la temperature potentielle
36! qstar---input-R- facteur d'echelle pour l'humidite relative
37! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce
38!                  et zref par rapport au Ri entre la sfce et la 1ere couche
39! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche
40!
41! pref----input-R- pression au niveau de reference
42! delu----input-R- anomalie du vent par rapport au 1er niveau
43! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
44! delq----input-R- anomalie de l'humidite relative par rapport a la surface
45!
46      INTEGER, intent(in) :: klon, knon, nsrf
47      LOGICAL, intent(in) :: zxli, okri
48      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
49      REAL, intent(in) :: zref
50      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
51      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
52!
53      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq
54!-----------------------------------------------------------------------
55      include "YOMCST.h"
56      include "flux_arp.h"
57!
58! Variables locales 
59      INTEGER :: i
60      REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm
61!
62!-------------------------------------------------------------------------
63      DO i=1, knon
64        gref(i) = zref*RG
65      ENDDO
66!
67! Richardson at reference level
68!
69!      CALL coefcdrag (klon, knon, nsrf, zxli, &
70!                    speed, temp, q_zref, gref, &
71!                    psol, ts, qsurf, rugos, &
72!                    okri, ri1, &
73!                    cdram, cdrah, cdran, zri1, &
74!                    pref)
75! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
76      CALL cdrag (knon, nsrf, &
77                    speed, temp, q_zref, gref, &
78                    psol, ts, qsurf, z0m, z0h, &
79                    cdram, cdrah, zri1, pref)
80      DO i = 1, knon
81        IF(ok_prescr_ust) THEN
82! La aussi il faut forcer avec ust (FC + MPL 20160210)
83        ycdragm(i) = ust*ust/(1.+speed(i))/speed(i)
84        cdram=ycdragm
85        delu(i) = ust/sqrt(cdram(i))
86        ELSE
87        delu(i) = ustar(i)/sqrt(cdram(i))
88        ENDIF
89        delte(i)= (testar(i)* sqrt(cdram(i)))/ &
90                   cdrah(i)
91        delq(i)= (qstar(i)* sqrt(cdram(i)))/ &
92                  cdrah(i)
93      ENDDO
94!
95      RETURN
96      END SUBROUTINE screenc
Note: See TracBrowser for help on using the repository browser.