libf/phylmd/clcdrag.f90

SUBROUTINE clcdrag(klon, knon, nsrf, zxli, u, v, t, q, zgeop, ts, qsurf, &
     rugos, pcfm, pcfh)

  ! From LMDZ4/libf/phylmd/clcdrag.F90, version 1.1.1.1 2004/05/19 12:53:07

  use indicesol
  use SUPHEC_M
  use yoethf_m

  IMPLICIT NONE

  ! Objet : calcul des cdrags pour le moment (pcfm) et les flux de
  ! chaleur sensible et latente (pcfh).

  ! knon----input-I- nombre de points pour un type de surface
  ! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
  ! zxli----input-L- calcul des cdrags selon Laurent Li
  ! u-------input-R- vent zonal au 1er niveau du modele
  ! v-------input-R- vent meridien au 1er niveau du modele
  ! t-------input-R- temperature de l'air au 1er niveau du modele
  ! q-------input-R- humidite de l'air au 1er niveau du modele
  ! ts------input-R- temperature de l'air a la surface
  ! qsurf---input-R- humidite de l'air a la surface
  ! rugos---input-R- rugosite

  ! pcfm---output-R- cdrag pour le moment 
  ! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible

  INTEGER, intent(in) :: klon
  ! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)

  INTEGER, intent(in) :: knon, nsrf

  ! Fonctions thermodynamiques et fonctions d'instabilite
  LOGICAL, intent(in) :: zxli ! utiliser un jeu de fonctions simples

  REAL, intent(in), dimension(klon) :: u, v, t, q
  REAL, intent(in):: zgeop(klon) ! géopotentiel au 1er niveau du modèle
  REAL, intent(in), dimension(klon) :: ts, qsurf
  REAL, intent(in), dimension(klon) :: rugos
  REAL, intent(out), dimension(klon) :: pcfm, pcfh

  ! Quelques constantes et options:
  REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2

  ! Variables locales :
  INTEGER :: i
  REAL :: zdu2, ztsolv, ztvd, zscf
  REAL :: zucf, zcr
  REAL :: friv, frih
  REAL, dimension(klon) :: zcfm1, zcfm2
  REAL, dimension(klon) :: zcfh1, zcfh2
  REAL, dimension(klon) :: zcdn
  REAL, dimension(klon) :: zri

  !--------------------------------------------------------------------

  ! Calculer le frottement au sol (Cdrag)

  DO i = 1, knon
     zdu2 = max(cepdu2,u(i)**2+v(i)**2)
     ztsolv = ts(i) * (1.0+RETV*qsurf(i))
     ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
          *(1.+RETV*q(i))
     zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
     zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2

     IF (zri(i) .gt. 0.) THEN      
        ! situation stable
        zri(i) = min(20.,zri(i))
        IF (.NOT. zxli) THEN
           zscf = SQRT(1.+cd*ABS(zri(i)))
           FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
           zcfm1(i) = zcdn(i) * FRIV
           FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
           zcfh1(i) = 0.8 * zcdn(i) * FRIH
           pcfm(i) = zcfm1(i)
           pcfh(i) = zcfh1(i)
        ELSE
           pcfm(i) = zcdn(i)* fsta(zri(i))
           pcfh(i) = zcdn(i)* fsta(zri(i))
        ENDIF
     ELSE                          
        ! situation instable
        IF (.NOT. zxli) THEN
           zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
                *(1.0+zgeop(i)/(RG*rugos(i)))))
           zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
           zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
           pcfm(i) = zcfm2(i)
           pcfh(i) = zcfh2(i)
        ELSE
           pcfm(i) = zcdn(i)* fins(zri(i))
           pcfh(i) = zcdn(i)* fins(zri(i))
        ENDIF
        zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
        IF(nsrf == is_oce) pcfh(i) = 0.8 * zcdn(i) &
             * (1. + zcr**1.25)**(1. / 1.25)
     ENDIF
  END DO

  contains

    ! Fonctions thermodynamiques et fonctions d'instabilite

    function fsta(x)
      REAL fsta
      real, intent(in):: x
      fsta = 1.0 / (1.0+10.0*x*(1+8.0*x))
    end function fsta

    !*******************************************************

    function fins(x)
      REAL fins
      real, intent(in):: x
      fins = SQRT(1.0-18.0*x)
    end function fins

END SUBROUTINE clcdrag
1	SUBROUTINE clcdrag(klon, knon, nsrf, zxli, u, v, t, q, zgeop, ts, qsurf, &
2	rugos, pcfm, pcfh)
3
4	! From LMDZ4/libf/phylmd/clcdrag.F90, version 1.1.1.1 2004/05/19 12:53:07
5
6	use indicesol
7	use SUPHEC_M
8	use yoethf_m
9
10	IMPLICIT NONE
11
12	! Objet : calcul des cdrags pour le moment (pcfm) et les flux de
13	! chaleur sensible et latente (pcfh).
14
15	! knon----input-I- nombre de points pour un type de surface
16	! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
17	! zxli----input-L- calcul des cdrags selon Laurent Li
18	! u-------input-R- vent zonal au 1er niveau du modele
19	! v-------input-R- vent meridien au 1er niveau du modele
20	! t-------input-R- temperature de l'air au 1er niveau du modele
21	! q-------input-R- humidite de l'air au 1er niveau du modele
22	! ts------input-R- temperature de l'air a la surface
23	! qsurf---input-R- humidite de l'air a la surface
24	! rugos---input-R- rugosite
25
26	! pcfm---output-R- cdrag pour le moment
27	! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
28
29	INTEGER, intent(in) :: klon
30	! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
31
32	INTEGER, intent(in) :: knon, nsrf
33
34	! Fonctions thermodynamiques et fonctions d'instabilite
35	LOGICAL, intent(in) :: zxli ! utiliser un jeu de fonctions simples
36
37	REAL, intent(in), dimension(klon) :: u, v, t, q
38	REAL, intent(in):: zgeop(klon) ! géopotentiel au 1er niveau du modèle
39	REAL, intent(in), dimension(klon) :: ts, qsurf
40	REAL, intent(in), dimension(klon) :: rugos
41	REAL, intent(out), dimension(klon) :: pcfm, pcfh
42
43	! Quelques constantes et options:
44	REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
45
46	! Variables locales :
47	INTEGER :: i
48	REAL :: zdu2, ztsolv, ztvd, zscf
49	REAL :: zucf, zcr
50	REAL :: friv, frih
51	REAL, dimension(klon) :: zcfm1, zcfm2
52	REAL, dimension(klon) :: zcfh1, zcfh2
53	REAL, dimension(klon) :: zcdn
54	REAL, dimension(klon) :: zri
55
56	!--------------------------------------------------------------------
57
58	! Calculer le frottement au sol (Cdrag)
59
60	DO i = 1, knon
61	zdu2 = max(cepdu2,u(i)2+v(i)2)
62	ztsolv = ts(i) * (1.0+RETV*qsurf(i))
63	ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
64	(1.+RETVq(i))
65	zri(i) = zgeop(i)(ztvd-ztsolv)/(zdu2ztvd)
66	zcdn(i) = (ckap/log(1.+zgeop(i)/(RGrugos(i))))*2
67
68	IF (zri(i) .gt. 0.) THEN
69	! situation stable
70	zri(i) = min(20.,zri(i))
71	IF (.NOT. zxli) THEN
72	zscf = SQRT(1.+cd*ABS(zri(i)))
73	FRIV = AMAX1(1. / (1.+2.CBzri(i)/ZSCF), 0.1)
74	zcfm1(i) = zcdn(i) * FRIV
75	FRIH = AMAX1(1./ (1.+3.CBzri(i)*ZSCF), 0.1 )
76	zcfh1(i) = 0.8 * zcdn(i) * FRIH
77	pcfm(i) = zcfm1(i)
78	pcfh(i) = zcfh1(i)
79	ELSE
80	pcfm(i) = zcdn(i)* fsta(zri(i))
81	pcfh(i) = zcdn(i)* fsta(zri(i))
82	ENDIF
83	ELSE
84	! situation instable
85	IF (.NOT. zxli) THEN
86	zucf = 1./(1.+3.0cbcczcdn(i)SQRT(ABS(zri(i)) &
87	(1.0+zgeop(i)/(RGrugos(i)))))
88	zcfm2(i) = zcdn(i)amax1((1.-2.0cbzri(i)zucf),0.1)
89	zcfh2(i) = 0.8 * zcdn(i)amax1((1.-3.0cbzri(i)zucf),0.1)
90	pcfm(i) = zcfm2(i)
91	pcfh(i) = zcfh2(i)
92	ELSE
93	pcfm(i) = zcdn(i)* fins(zri(i))
94	pcfh(i) = zcdn(i)* fins(zri(i))
95	ENDIF
96	zcr = (0.0016/(zcdn(i)SQRT(zdu2)))ABS(ztvd-ztsolv)**(1./3.)
97	IF(nsrf == is_oce) pcfh(i) = 0.8 * zcdn(i) &
98	* (1. + zcr1.25)(1. / 1.25)
99	ENDIF
100	END DO
101
102	contains
103
104	! Fonctions thermodynamiques et fonctions d'instabilite
105
106	function fsta(x)
107	REAL fsta
108	real, intent(in):: x
109	fsta = 1.0 / (1.0+10.0x(1+8.0*x))
110	end function fsta
111
112	!*******************************************************
113
114	function fins(x)
115	REAL fins
116	real, intent(in):: x
117	fins = SQRT(1.0-18.0*x)
118	end function fins
119
120	END SUBROUTINE clcdrag