| 1 | ! |
|---|
| 2 | MODULE screenc_mod |
|---|
| 3 | ! |
|---|
| 4 | ! This module contains some procedures for calculation of the correction |
|---|
| 5 | ! of temperature, specific humidity and wind at a reference level |
|---|
| 6 | ! |
|---|
| 7 | USE cdrag_mod |
|---|
| 8 | IMPLICIT NONE |
|---|
| 9 | |
|---|
| 10 | CONTAINS |
|---|
| 11 | ! |
|---|
| 12 | !**************************************************************************************** |
|---|
| 13 | ! |
|---|
| 14 | !r original routine svn3623 |
|---|
| 15 | ! |
|---|
| 16 | SUBROUTINE screenc(klon, knon, nsrf, zxli, & |
|---|
| 17 | speed, temp, q_zref, zref, & |
|---|
| 18 | ts, qsurf, z0m, z0h, psol, & |
|---|
| 19 | ustar, testar, qstar, okri, ri1, & |
|---|
| 20 | pref, delu, delte, delq) |
|---|
| 21 | IMPLICIT NONE |
|---|
| 22 | !----------------------------------------------------------------------- |
|---|
| 23 | ! |
|---|
| 24 | ! Objet : calcul "correcteur" des anomalies du vent, de la temperature |
|---|
| 25 | ! potentielle et de l'humidite relative au niveau de reference zref et |
|---|
| 26 | ! par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) |
|---|
| 27 | ! a partir des equations de Louis. |
|---|
| 28 | ! |
|---|
| 29 | ! Reference : Hess, Colman et McAvaney (1995) |
|---|
| 30 | ! |
|---|
| 31 | ! I. Musat, 01.07.2002 |
|---|
| 32 | !----------------------------------------------------------------------- |
|---|
| 33 | ! |
|---|
| 34 | ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude) |
|---|
| 35 | ! knon----input-I- nombre de points pour un type de surface |
|---|
| 36 | ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90 |
|---|
| 37 | ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li |
|---|
| 38 | ! speed---input-R- module du vent au 1er niveau du modele |
|---|
| 39 | ! temp----input-R- temperature de l'air au 1er niveau du modele |
|---|
| 40 | ! q_zref--input-R- humidite relative au 1er niveau du modele |
|---|
| 41 | ! zref----input-R- altitude de reference |
|---|
| 42 | ! ts------input-R- temperature de l'air a la surface |
|---|
| 43 | ! qsurf---input-R- humidite relative a la surface |
|---|
| 44 | ! z0m, z0h---input-R- rugosite |
|---|
| 45 | ! psol----input-R- pression au sol |
|---|
| 46 | ! ustar---input-R- facteur d'echelle pour le vent |
|---|
| 47 | ! testar--input-R- facteur d'echelle pour la temperature potentielle |
|---|
| 48 | ! qstar---input-R- facteur d'echelle pour l'humidite relative |
|---|
| 49 | ! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce |
|---|
| 50 | ! et zref par rapport au Ri entre la sfce et la 1ere couche |
|---|
| 51 | ! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche |
|---|
| 52 | ! |
|---|
| 53 | ! pref----input-R- pression au niveau de reference |
|---|
| 54 | ! delu----input-R- anomalie du vent par rapport au 1er niveau |
|---|
| 55 | ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface |
|---|
| 56 | ! delq----input-R- anomalie de l'humidite relative par rapport a la surface |
|---|
| 57 | ! |
|---|
| 58 | INTEGER, intent(in) :: klon, knon, nsrf |
|---|
| 59 | LOGICAL, intent(in) :: zxli, okri |
|---|
| 60 | REAL, dimension(klon), intent(in) :: speed, temp, q_zref |
|---|
| 61 | REAL, intent(in) :: zref |
|---|
| 62 | REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol |
|---|
| 63 | REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1 |
|---|
| 64 | ! |
|---|
| 65 | REAL, dimension(klon), intent(out) :: pref, delu, delte, delq |
|---|
| 66 | !----------------------------------------------------------------------- |
|---|
| 67 | include "YOMCST.h" |
|---|
| 68 | include "flux_arp.h" |
|---|
| 69 | ! |
|---|
| 70 | ! Variables locales |
|---|
| 71 | INTEGER :: i |
|---|
| 72 | REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm |
|---|
| 73 | ! |
|---|
| 74 | !------------------------------------------------------------------------- |
|---|
| 75 | DO i=1, knon |
|---|
| 76 | gref(i) = zref*RG |
|---|
| 77 | ENDDO |
|---|
| 78 | ! |
|---|
| 79 | ! Richardson at reference level |
|---|
| 80 | ! |
|---|
| 81 | ! CALL coefcdrag (klon, knon, nsrf, zxli, & |
|---|
| 82 | ! speed, temp, q_zref, gref, & |
|---|
| 83 | ! psol, ts, qsurf, rugos, & |
|---|
| 84 | ! okri, ri1, & |
|---|
| 85 | ! cdram, cdrah, cdran, zri1, & |
|---|
| 86 | ! pref) |
|---|
| 87 | ! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag |
|---|
| 88 | CALL cdrag (knon, nsrf, & |
|---|
| 89 | speed, temp, q_zref, gref, & |
|---|
| 90 | psol, ts, qsurf, z0m, z0h, & |
|---|
| 91 | cdram, cdrah, zri1, pref) |
|---|
| 92 | DO i = 1, knon |
|---|
| 93 | IF(ok_prescr_ust) THEN |
|---|
| 94 | ! La aussi il faut forcer avec ust (FC + MPL 20160210) |
|---|
| 95 | ycdragm(i) = ust*ust/(1.+speed(i))/speed(i) |
|---|
| 96 | cdram=ycdragm |
|---|
| 97 | delu(i) = ust/sqrt(cdram(i)) |
|---|
| 98 | ELSE |
|---|
| 99 | delu(i) = ustar(i)/sqrt(cdram(i)) |
|---|
| 100 | ENDIF |
|---|
| 101 | delte(i)= (testar(i)* sqrt(cdram(i)))/ & |
|---|
| 102 | cdrah(i) |
|---|
| 103 | delq(i)= (qstar(i)* sqrt(cdram(i)))/ & |
|---|
| 104 | cdrah(i) |
|---|
| 105 | ENDDO |
|---|
| 106 | ! |
|---|
| 107 | RETURN |
|---|
| 108 | END SUBROUTINE screenc |
|---|
| 109 | ! |
|---|
| 110 | SUBROUTINE screencn(klon, knon, nsrf, zxli, & |
|---|
| 111 | speed, temp, q_zref, zref, & |
|---|
| 112 | ts, qsurf, z0m, z0h, psol, & |
|---|
| 113 | cdrm, cdrh, okri, & |
|---|
| 114 | ri1, iri1, & |
|---|
| 115 | pref, delm, delh, zri1) |
|---|
| 116 | IMPLICIT NONE |
|---|
| 117 | !----------------------------------------------------------------------- |
|---|
| 118 | ! |
|---|
| 119 | ! Objet : calcul "correcteur" des anomalies du vent, de la temperature |
|---|
| 120 | ! potentielle et de l'humidite relative au niveau de reference zref et |
|---|
| 121 | ! par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) |
|---|
| 122 | ! a partir des equations de Louis. |
|---|
| 123 | ! |
|---|
| 124 | ! Reference : Hess, Colman et McAvaney (1995) |
|---|
| 125 | ! |
|---|
| 126 | ! I. Musat, 01.07.2002 |
|---|
| 127 | !----------------------------------------------------------------------- |
|---|
| 128 | ! |
|---|
| 129 | ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude) |
|---|
| 130 | ! knon----input-I- nombre de points pour un type de surface |
|---|
| 131 | ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90 |
|---|
| 132 | ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li |
|---|
| 133 | ! speed---input-R- module du vent au 1er niveau du modele |
|---|
| 134 | ! temp----input-R- temperature de l'air au 1er niveau du modele |
|---|
| 135 | ! q_zref--input-R- humidite relative au 1er niveau du modele |
|---|
| 136 | ! zref----input-R- altitude de reference |
|---|
| 137 | ! ts------input-R- temperature de l'air a la surface |
|---|
| 138 | ! qsurf---input-R- humidite relative a la surface |
|---|
| 139 | ! z0m, z0h---input-R- rugosite |
|---|
| 140 | ! psol----input-R- pression au sol |
|---|
| 141 | ! ustar---input-R- facteur d'echelle pour le vent |
|---|
| 142 | ! testar--input-R- facteur d'echelle pour la temperature potentielle |
|---|
| 143 | ! qstar---input-R- facteur d'echelle pour l'humidite relative |
|---|
| 144 | ! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce |
|---|
| 145 | ! et zref par rapport au Ri entre la sfce et la 1ere couche |
|---|
| 146 | ! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche |
|---|
| 147 | ! |
|---|
| 148 | ! pref----input-R- pression au niveau de reference |
|---|
| 149 | ! delu----input-R- anomalie du vent par rapport au 1er niveau |
|---|
| 150 | ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface |
|---|
| 151 | ! delq----input-R- anomalie de l'humidite relative par rapport a la surface |
|---|
| 152 | ! |
|---|
| 153 | INTEGER, intent(in) :: klon, knon, nsrf |
|---|
| 154 | LOGICAL, intent(in) :: zxli, okri |
|---|
| 155 | REAL, dimension(klon), intent(in) :: speed, temp, q_zref |
|---|
| 156 | REAL, intent(in) :: zref |
|---|
| 157 | REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol |
|---|
| 158 | REAL, dimension(klon), intent(in) :: cdrm, cdrh, ri1 |
|---|
| 159 | INTEGER, INTENT(IN) :: iri1 ! Richardson de la 1ere couche |
|---|
| 160 | ! |
|---|
| 161 | REAL, dimension(klon), intent(out) :: pref, delm, delh, zri1 |
|---|
| 162 | !171220 REAL, dimension(klon) :: cdram, cdrah, zri1 |
|---|
| 163 | REAL, dimension(klon) :: cdram, cdrah |
|---|
| 164 | !----------------------------------------------------------------------- |
|---|
| 165 | include "YOMCST.h" |
|---|
| 166 | include "flux_arp.h" |
|---|
| 167 | ! |
|---|
| 168 | ! Variables locales |
|---|
| 169 | INTEGER :: i |
|---|
| 170 | REAL, dimension(klon) :: cdran, gref,ycdragm |
|---|
| 171 | ! |
|---|
| 172 | !------------------------------------------------------------------------- |
|---|
| 173 | DO i=1, knon |
|---|
| 174 | gref(i) = zref*RG |
|---|
| 175 | ENDDO |
|---|
| 176 | ! |
|---|
| 177 | ! Richardson at reference level |
|---|
| 178 | ! |
|---|
| 179 | CALL cdragn_ri1 (knon, nsrf, & |
|---|
| 180 | speed, temp, q_zref, gref, & |
|---|
| 181 | psol, ts, qsurf, z0m, z0h, & |
|---|
| 182 | ri1, iri1, & |
|---|
| 183 | cdram, cdrah, zri1, pref) |
|---|
| 184 | DO i = 1, knon |
|---|
| 185 | ! IF(ok_prescr_ust) THEN |
|---|
| 186 | ! La aussi il faut forcer avec ust (FC + MPL 20160210) |
|---|
| 187 | ! ycdragm(i) = ust*ust/(1.+speed(i))/speed(i) |
|---|
| 188 | ! cdram=ycdragm |
|---|
| 189 | ! delu(i) = ust/sqrt(cdram(i)) |
|---|
| 190 | ! ELSE |
|---|
| 191 | ! delu(i) = ustar(i)/sqrt(cdram(i)) |
|---|
| 192 | ! ENDIF |
|---|
| 193 | IF(ok_prescr_ust) THEN |
|---|
| 194 | print*,'chgmnt calculs à 2m; remplacer par ??? si 1D' |
|---|
| 195 | STOP |
|---|
| 196 | ENDIF |
|---|
| 197 | delm(i) = sqrt(cdrm(i))/sqrt(cdram(i)) |
|---|
| 198 | !verifier que temp est un temperat potentielle. |
|---|
| 199 | delh(i)= (cdrh(i)* sqrt(cdram(i)))/ & |
|---|
| 200 | (cdrah(i)*sqrt(cdrm(i))) |
|---|
| 201 | ENDDO |
|---|
| 202 | ! |
|---|
| 203 | RETURN |
|---|
| 204 | END SUBROUTINE screencn |
|---|
| 205 | END MODULE screenc_mod |
|---|
