[320] | 1 | C |
---|
| 2 | C $Header$ |
---|
| 3 | C |
---|
[2] | 4 | MODULE startvar |
---|
| 5 | ! |
---|
| 6 | ! |
---|
| 7 | ! There are three ways to access data from the database of atmospheric data which |
---|
| 8 | ! can be used to initialize the model. This depends on the type of field which needs |
---|
| 9 | ! to be extracted. In any case the call should come after a restget and should be of the type : |
---|
| 10 | ! CALL startget(...) |
---|
| 11 | ! |
---|
| 12 | ! We will details the possible arguments to startget here : |
---|
| 13 | ! |
---|
| 14 | ! - A 2D variable on the dynamical grid : |
---|
[320] | 15 | ! CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar ) |
---|
[2] | 16 | ! |
---|
| 17 | ! - A 1D variable on the physical grid : |
---|
[320] | 18 | ! CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar ) |
---|
[2] | 19 | ! |
---|
| 20 | ! |
---|
| 21 | ! - A 3D variable on the dynamical grid : |
---|
[320] | 22 | ! CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar ) |
---|
[2] | 23 | ! |
---|
| 24 | ! |
---|
| 25 | ! There is special constraint on the atmospheric data base except that the |
---|
| 26 | ! the data needs to be in netCDF and the variables should have the the following |
---|
| 27 | ! names in the file : |
---|
| 28 | ! |
---|
| 29 | ! 'RELIEF' : High resolution orography |
---|
| 30 | ! 'ST' : Surface temperature |
---|
| 31 | ! 'CDSW' : Soil moisture |
---|
| 32 | ! 'Z' : Surface geopotential |
---|
| 33 | ! 'SP' : Surface pressure |
---|
| 34 | ! 'U' : East ward wind |
---|
| 35 | ! 'V' : Northward wind |
---|
| 36 | ! 'TEMP' : Temperature |
---|
| 37 | ! 'R' : Relative humidity |
---|
| 38 | ! |
---|
| 39 | USE ioipsl |
---|
| 40 | ! |
---|
| 41 | ! |
---|
| 42 | IMPLICIT NONE |
---|
| 43 | ! |
---|
| 44 | ! |
---|
| 45 | PRIVATE |
---|
| 46 | PUBLIC startget |
---|
| 47 | ! |
---|
| 48 | ! |
---|
| 49 | INTERFACE startget |
---|
| 50 | MODULE PROCEDURE startget_phys2d, startget_phys1d, startget_dyn |
---|
| 51 | END INTERFACE |
---|
| 52 | ! |
---|
| 53 | INTEGER, SAVE :: fid_phys, fid_dyn |
---|
| 54 | INTEGER, SAVE :: iml_phys, iml_rel, iml_dyn |
---|
| 55 | INTEGER, SAVE :: jml_phys, jml_rel, jml_dyn |
---|
| 56 | INTEGER, SAVE :: llm_dyn, ttm_dyn |
---|
| 57 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lon_phys, lon_rug, |
---|
| 58 | . lon_alb, lon_rel, lon_dyn |
---|
| 59 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lat_phys, lat_rug, |
---|
| 60 | . lat_alb, lat_rel, lat_dyn |
---|
[320] | 61 | REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: levdyn_ini |
---|
[2] | 62 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: relief, zstd, zsig, |
---|
| 63 | . zgam, zthe, zpic, zval |
---|
| 64 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: rugo, masque, phis |
---|
| 65 | ! |
---|
| 66 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: tsol, qsol, psol_dyn |
---|
| 67 | REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: var_ana3d |
---|
| 68 | ! |
---|
| 69 | CONTAINS |
---|
| 70 | ! |
---|
| 71 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 72 | ! |
---|
| 73 | SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in, |
---|
[370] | 74 | . champ, val_exp, jml2, lon_in2, lat_in2 , interbar, masque_lu ) |
---|
[2] | 75 | ! |
---|
| 76 | ! There is a big mess with the size in logitude, should it be iml or iml+1. |
---|
| 77 | ! I have chosen to use the iml+1 as an argument to this routine and we declare |
---|
| 78 | ! internaly smaler fields when needed. This needs to be cleared once and for all in LMDZ. |
---|
| 79 | ! A convention is required. |
---|
| 80 | ! |
---|
| 81 | ! |
---|
| 82 | CHARACTER*(*), INTENT(in) :: varname |
---|
[320] | 83 | INTEGER, INTENT(in) :: iml, jml ,jml2 |
---|
[2] | 84 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 85 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
[2] | 86 | REAL, INTENT(inout) :: champ(iml,jml) |
---|
| 87 | REAL, INTENT(in) :: val_exp |
---|
[370] | 88 | REAL, INTENT(in), optional :: masque_lu(iml,jml) |
---|
[320] | 89 | LOGICAL interbar |
---|
[2] | 90 | ! |
---|
| 91 | ! This routine only works if the variable does not exist or is constant |
---|
| 92 | ! |
---|
| 93 | IF ( MINVAL(champ(:,:)).EQ.MAXVAL(champ(:,:)) .AND. |
---|
| 94 | .MINVAL(champ(:,:)).EQ.val_exp ) THEN |
---|
| 95 | ! |
---|
| 96 | SELECTCASE(varname) |
---|
| 97 | ! |
---|
| 98 | CASE ('relief') |
---|
| 99 | ! |
---|
| 100 | ! If we do not have the orography we need to get it |
---|
| 101 | ! |
---|
| 102 | IF ( .NOT.ALLOCATED(relief)) THEN |
---|
| 103 | ! |
---|
[370] | 104 | if (present(masque_lu)) then |
---|
[320] | 105 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
[370] | 106 | . jml2,lon_in2,lat_in2, interbar, masque_lu ) |
---|
| 107 | else |
---|
| 108 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 109 | . jml2,lon_in2,lat_in2, interbar) |
---|
| 110 | endif |
---|
[2] | 111 | ! |
---|
| 112 | ENDIF |
---|
| 113 | ! |
---|
| 114 | IF (SIZE(relief) .NE. SIZE(champ)) THEN |
---|
| 115 | ! |
---|
| 116 | WRITE(*,*) 'STARTVAR module has been', |
---|
| 117 | .' initialized to the wrong size' |
---|
| 118 | STOP |
---|
| 119 | ! |
---|
| 120 | ENDIF |
---|
| 121 | ! |
---|
| 122 | champ(:,:) = relief(:,:) |
---|
| 123 | ! |
---|
| 124 | CASE ('rugosite') |
---|
| 125 | ! |
---|
| 126 | ! If we do not have the orography we need to get it |
---|
| 127 | ! |
---|
| 128 | IF ( .NOT.ALLOCATED(rugo)) THEN |
---|
| 129 | ! |
---|
[320] | 130 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 131 | . jml2,lon_in2,lat_in2 , interbar ) |
---|
[2] | 132 | ! |
---|
| 133 | ENDIF |
---|
| 134 | ! |
---|
| 135 | IF (SIZE(rugo) .NE. SIZE(champ)) THEN |
---|
| 136 | ! |
---|
| 137 | WRITE(*,*) |
---|
| 138 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 139 | STOP |
---|
| 140 | ! |
---|
| 141 | ENDIF |
---|
| 142 | ! |
---|
| 143 | champ(:,:) = rugo(:,:) |
---|
| 144 | ! |
---|
| 145 | CASE ('masque') |
---|
| 146 | ! |
---|
| 147 | ! If we do not have the orography we need to get it |
---|
| 148 | ! |
---|
| 149 | IF ( .NOT.ALLOCATED(masque)) THEN |
---|
| 150 | ! |
---|
[320] | 151 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 152 | . jml2,lon_in2,lat_in2 , interbar ) |
---|
[2] | 153 | ! |
---|
| 154 | ENDIF |
---|
| 155 | ! |
---|
| 156 | IF (SIZE(masque) .NE. SIZE(champ)) THEN |
---|
| 157 | ! |
---|
| 158 | WRITE(*,*) |
---|
| 159 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 160 | STOP |
---|
| 161 | ! |
---|
| 162 | ENDIF |
---|
| 163 | ! |
---|
| 164 | champ(:,:) = masque(:,:) |
---|
| 165 | ! |
---|
| 166 | CASE ('surfgeo') |
---|
| 167 | ! |
---|
| 168 | ! If we do not have the orography we need to get it |
---|
| 169 | ! |
---|
| 170 | IF ( .NOT.ALLOCATED(phis)) THEN |
---|
| 171 | ! |
---|
[320] | 172 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 173 | . jml2,lon_in2, lat_in2 , interbar ) |
---|
[2] | 174 | ! |
---|
| 175 | ENDIF |
---|
| 176 | ! |
---|
| 177 | IF (SIZE(phis) .NE. SIZE(champ)) THEN |
---|
| 178 | ! |
---|
| 179 | WRITE(*,*) |
---|
| 180 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 181 | STOP |
---|
| 182 | ! |
---|
| 183 | ENDIF |
---|
| 184 | ! |
---|
| 185 | champ(:,:) = phis(:,:) |
---|
| 186 | ! |
---|
| 187 | CASE ('psol') |
---|
| 188 | ! |
---|
| 189 | ! If we do not have the orography we need to get it |
---|
| 190 | ! |
---|
| 191 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
| 192 | ! |
---|
[320] | 193 | CALL start_init_dyn( iml, jml, lon_in, lat_in, |
---|
| 194 | . jml2,lon_in2, lat_in2 , interbar ) |
---|
[2] | 195 | ! |
---|
| 196 | ENDIF |
---|
| 197 | ! |
---|
| 198 | IF (SIZE(psol_dyn) .NE. SIZE(champ)) THEN |
---|
| 199 | ! |
---|
| 200 | WRITE(*,*) |
---|
| 201 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 202 | STOP |
---|
| 203 | ! |
---|
| 204 | ENDIF |
---|
| 205 | ! |
---|
| 206 | champ(:,:) = psol_dyn(:,:) |
---|
| 207 | ! |
---|
| 208 | CASE DEFAULT |
---|
| 209 | ! |
---|
| 210 | WRITE(*,*) 'startget_phys2d' |
---|
| 211 | WRITE(*,*) 'No rule is present to extract variable', |
---|
| 212 | . varname(:LEN_TRIM(varname)),' from any data set' |
---|
| 213 | STOP |
---|
| 214 | ! |
---|
| 215 | END SELECT |
---|
| 216 | ! |
---|
| 217 | ELSE |
---|
| 218 | ! |
---|
| 219 | ! There are a few fields we might need if we need to interpolate 3D filed. Thus if they come through here we |
---|
| 220 | ! will catch them |
---|
| 221 | ! |
---|
| 222 | SELECTCASE(varname) |
---|
| 223 | ! |
---|
| 224 | CASE ('surfgeo') |
---|
| 225 | ! |
---|
| 226 | IF ( .NOT.ALLOCATED(phis)) THEN |
---|
| 227 | ALLOCATE(phis(iml,jml)) |
---|
| 228 | ENDIF |
---|
| 229 | ! |
---|
| 230 | IF (SIZE(phis) .NE. SIZE(champ)) THEN |
---|
| 231 | ! |
---|
| 232 | WRITE(*,*) |
---|
| 233 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 234 | STOP |
---|
| 235 | ! |
---|
| 236 | ENDIF |
---|
| 237 | ! |
---|
| 238 | phis(:,:) = champ(:,:) |
---|
| 239 | ! |
---|
| 240 | END SELECT |
---|
| 241 | ! |
---|
| 242 | ENDIF |
---|
| 243 | ! |
---|
| 244 | END SUBROUTINE startget_phys2d |
---|
| 245 | ! |
---|
| 246 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 247 | ! |
---|
[320] | 248 | SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 , |
---|
[370] | 249 | , lat_in2 , interbar, masque_lu ) |
---|
[2] | 250 | ! |
---|
[320] | 251 | INTEGER, INTENT(in) :: iml, jml, jml2 |
---|
[2] | 252 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 253 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
[370] | 254 | REAL, intent(in), optional :: masque_lu(iml,jml) |
---|
[320] | 255 | LOGICAL interbar |
---|
[2] | 256 | ! |
---|
| 257 | ! LOCAL |
---|
| 258 | ! |
---|
[320] | 259 | LOGICAL interbar2 |
---|
| 260 | REAL :: lev(1), date, dt,chmin,chmax |
---|
[2] | 261 | INTEGER :: itau(1), fid |
---|
| 262 | INTEGER :: llm_tmp, ttm_tmp |
---|
| 263 | INTEGER :: i, j |
---|
| 264 | INTEGER :: iret |
---|
[320] | 265 | CHARACTER*25 title |
---|
[2] | 266 | REAL, ALLOCATABLE :: relief_hi(:,:) |
---|
| 267 | REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) |
---|
[320] | 268 | REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) |
---|
[2] | 269 | REAL, ALLOCATABLE :: tmp_var(:,:) |
---|
| 270 | INTEGER, ALLOCATABLE :: tmp_int(:,:) |
---|
| 271 | ! |
---|
| 272 | CHARACTER*120 :: orogfname |
---|
| 273 | LOGICAL :: check=.TRUE. |
---|
| 274 | ! |
---|
| 275 | ! |
---|
| 276 | orogfname = 'Relief.nc' |
---|
| 277 | ! |
---|
| 278 | IF ( check ) WRITE(*,*) 'Reading the high resolution orography' |
---|
| 279 | ! |
---|
| 280 | CALL flininfo(orogfname,iml_rel, jml_rel, llm_tmp, ttm_tmp, fid) |
---|
| 281 | ! |
---|
| 282 | ALLOCATE (lat_rel(iml_rel,jml_rel), stat=iret) |
---|
| 283 | ALLOCATE (lon_rel(iml_rel,jml_rel), stat=iret) |
---|
| 284 | ALLOCATE (relief_hi(iml_rel,jml_rel), stat=iret) |
---|
| 285 | ! |
---|
| 286 | CALL flinopen(orogfname, .FALSE., iml_rel, jml_rel, |
---|
| 287 | .llm_tmp, lon_rel, lat_rel, lev, ttm_tmp, |
---|
| 288 | . itau, date, dt, fid) |
---|
| 289 | ! |
---|
| 290 | CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp, |
---|
| 291 | . ttm_tmp, 1, 1, relief_hi) |
---|
| 292 | ! |
---|
| 293 | CALL flinclo(fid) |
---|
| 294 | ! |
---|
| 295 | ! In case we have a file which is in degrees we do the transformation |
---|
| 296 | ! |
---|
| 297 | ALLOCATE(lon_rad(iml_rel)) |
---|
[320] | 298 | ALLOCATE(lon_ini(iml_rel)) |
---|
| 299 | |
---|
[2] | 300 | IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 301 | lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 302 | ELSE |
---|
[320] | 303 | lon_ini(:) = lon_rel(:,1) |
---|
[2] | 304 | ENDIF |
---|
[320] | 305 | |
---|
[2] | 306 | ALLOCATE(lat_rad(jml_rel)) |
---|
[320] | 307 | ALLOCATE(lat_ini(jml_rel)) |
---|
| 308 | |
---|
[2] | 309 | IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 310 | lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 311 | ELSE |
---|
[320] | 312 | lat_ini(:) = lat_rel(1,:) |
---|
[2] | 313 | ENDIF |
---|
| 314 | ! |
---|
| 315 | ! |
---|
[320] | 316 | |
---|
| 317 | title='RELIEF' |
---|
| 318 | |
---|
| 319 | interbar2 = .FALSE. |
---|
| 320 | CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini, |
---|
| 321 | . lon_rad, lat_rad, relief_hi , interbar2 ) |
---|
| 322 | |
---|
[2] | 323 | IF ( check ) WRITE(*,*) 'Computes all the parameters needed', |
---|
| 324 | .' for the gravity wave drag code' |
---|
| 325 | ! |
---|
| 326 | ! Allocate the data we need to put in the interpolated fields |
---|
| 327 | ! |
---|
| 328 | ! RELIEF: orographie moyenne |
---|
| 329 | ALLOCATE(relief(iml,jml)) |
---|
| 330 | ! zphi : orographie moyenne |
---|
| 331 | ALLOCATE(phis(iml,jml)) |
---|
| 332 | ! zstd: deviation standard de l'orographie sous-maille |
---|
| 333 | ALLOCATE(zstd(iml,jml)) |
---|
| 334 | ! zsig: pente de l'orographie sous-maille |
---|
| 335 | ALLOCATE(zsig(iml,jml)) |
---|
| 336 | ! zgam: anisotropy de l'orographie sous maille |
---|
| 337 | ALLOCATE(zgam(iml,jml)) |
---|
| 338 | ! zthe: orientation de l'axe oriente dans la direction |
---|
| 339 | ! de plus grande pente de l'orographie sous maille |
---|
| 340 | ALLOCATE(zthe(iml,jml)) |
---|
| 341 | ! zpic: hauteur pics de la SSO |
---|
| 342 | ALLOCATE(zpic(iml,jml)) |
---|
| 343 | ! zval: hauteur vallees de la SSO |
---|
| 344 | ALLOCATE(zval(iml,jml)) |
---|
| 345 | ! masque : Masque terre ocean |
---|
| 346 | ALLOCATE(tmp_int(iml,jml)) |
---|
| 347 | ALLOCATE(masque(iml,jml)) |
---|
[370] | 348 | |
---|
| 349 | masque = -99999. |
---|
| 350 | if (present(masque_lu)) then |
---|
| 351 | masque = masque_lu |
---|
| 352 | endif |
---|
[2] | 353 | ! |
---|
| 354 | CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, |
---|
[320] | 355 | . iml-1, jml, lon_in, lat_in, |
---|
[355] | 356 | . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque) |
---|
[24] | 357 | phis = phis * 9.81 |
---|
[2] | 358 | ! |
---|
[355] | 359 | ! masque(:,:) = FLOAT(tmp_int(:,:)) |
---|
[2] | 360 | ! |
---|
| 361 | ! Compute surface roughness |
---|
| 362 | ! |
---|
| 363 | IF ( check ) WRITE(*,*) |
---|
| 364 | .'Compute surface roughness induced by the orography' |
---|
| 365 | ! |
---|
| 366 | ALLOCATE(rugo(iml,jml)) |
---|
| 367 | ALLOCATE(tmp_var(iml-1,jml)) |
---|
| 368 | ! |
---|
| 369 | CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, |
---|
| 370 | . iml-1, jml, lon_in, lat_in, tmp_var) |
---|
| 371 | ! |
---|
| 372 | DO j = 1, jml |
---|
| 373 | DO i = 1, iml-1 |
---|
| 374 | rugo(i,j) = tmp_var(i,j) |
---|
| 375 | ENDDO |
---|
| 376 | rugo(iml,j) = tmp_var(1,j) |
---|
| 377 | ENDDO |
---|
[320] | 378 | c |
---|
| 379 | cc *** rugo n'est pas utilise pour l'instant ****** |
---|
[2] | 380 | ! |
---|
| 381 | ! Build land-sea mask |
---|
| 382 | ! |
---|
| 383 | ! |
---|
| 384 | RETURN |
---|
| 385 | ! |
---|
| 386 | END SUBROUTINE start_init_orog |
---|
| 387 | ! |
---|
| 388 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 389 | ! |
---|
| 390 | SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, |
---|
[320] | 391 | .lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar) |
---|
[2] | 392 | ! |
---|
| 393 | CHARACTER*(*), INTENT(in) :: varname |
---|
[320] | 394 | INTEGER, INTENT(in) :: iml, jml, nbindex, jml2 |
---|
[2] | 395 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 396 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
[2] | 397 | REAL, INTENT(inout) :: champ(nbindex) |
---|
| 398 | REAL, INTENT(in) :: val_exp |
---|
[320] | 399 | LOGICAL interbar |
---|
[2] | 400 | ! |
---|
| 401 | ! |
---|
| 402 | ! This routine only works if the variable does not exist or is constant |
---|
| 403 | ! |
---|
| 404 | IF ( MINVAL(champ(:)).EQ.MAXVAL(champ(:)) .AND. |
---|
| 405 | .MINVAL(champ(:)).EQ.val_exp ) THEN |
---|
| 406 | SELECTCASE(varname) |
---|
| 407 | CASE ('tsol') |
---|
| 408 | IF ( .NOT.ALLOCATED(tsol)) THEN |
---|
[320] | 409 | CALL start_init_phys( iml, jml, lon_in, lat_in, |
---|
| 410 | . jml2, lon_in2, lat_in2, interbar ) |
---|
[2] | 411 | ENDIF |
---|
| 412 | IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 413 | WRITE(*,*) |
---|
| 414 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 415 | STOP |
---|
| 416 | ENDIF |
---|
| 417 | CALL gr_dyn_fi(1, iml, jml, nbindex, tsol, champ) |
---|
| 418 | CASE ('qsol') |
---|
| 419 | IF ( .NOT.ALLOCATED(qsol)) THEN |
---|
[320] | 420 | CALL start_init_phys( iml, jml, lon_in, lat_in, |
---|
| 421 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 422 | ENDIF |
---|
| 423 | IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 424 | WRITE(*,*) |
---|
| 425 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 426 | STOP |
---|
| 427 | ENDIF |
---|
| 428 | CALL gr_dyn_fi(1, iml, jml, nbindex, qsol, champ) |
---|
| 429 | CASE ('psol') |
---|
| 430 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 431 | CALL start_init_dyn( iml, jml, lon_in, lat_in, |
---|
| 432 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 433 | ENDIF |
---|
| 434 | IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN |
---|
| 435 | WRITE(*,*) |
---|
| 436 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 437 | STOP |
---|
| 438 | ENDIF |
---|
| 439 | CALL gr_dyn_fi(1, iml, jml, nbindex, psol_dyn, champ) |
---|
| 440 | CASE ('zmea') |
---|
| 441 | IF ( .NOT.ALLOCATED(relief)) THEN |
---|
[320] | 442 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 443 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 444 | ENDIF |
---|
| 445 | IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 446 | WRITE(*,*) |
---|
| 447 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 448 | STOP |
---|
| 449 | ENDIF |
---|
| 450 | CALL gr_dyn_fi(1, iml, jml, nbindex, relief, champ) |
---|
| 451 | CASE ('zstd') |
---|
| 452 | IF ( .NOT.ALLOCATED(zstd)) THEN |
---|
[320] | 453 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 454 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 455 | ENDIF |
---|
| 456 | IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 457 | WRITE(*,*) |
---|
| 458 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 459 | STOP |
---|
| 460 | ENDIF |
---|
| 461 | CALL gr_dyn_fi(1, iml, jml, nbindex,zstd, champ) |
---|
| 462 | CASE ('zsig') |
---|
| 463 | IF ( .NOT.ALLOCATED(zsig)) THEN |
---|
[320] | 464 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 465 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 466 | ENDIF |
---|
| 467 | IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 468 | WRITE(*,*) |
---|
| 469 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 470 | STOP |
---|
| 471 | ENDIF |
---|
| 472 | CALL gr_dyn_fi(1, iml, jml, nbindex,zsig, champ) |
---|
| 473 | CASE ('zgam') |
---|
| 474 | IF ( .NOT.ALLOCATED(zgam)) THEN |
---|
[320] | 475 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 476 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 477 | ENDIF |
---|
| 478 | IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 479 | WRITE(*,*) |
---|
| 480 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 481 | STOP |
---|
| 482 | ENDIF |
---|
| 483 | CALL gr_dyn_fi(1, iml, jml, nbindex,zgam, champ) |
---|
| 484 | CASE ('zthe') |
---|
| 485 | IF ( .NOT.ALLOCATED(zthe)) THEN |
---|
[320] | 486 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 487 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 488 | ENDIF |
---|
| 489 | IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 490 | WRITE(*,*) |
---|
| 491 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 492 | STOP |
---|
| 493 | ENDIF |
---|
| 494 | CALL gr_dyn_fi(1, iml, jml, nbindex,zthe, champ) |
---|
| 495 | CASE ('zpic') |
---|
| 496 | IF ( .NOT.ALLOCATED(zpic)) THEN |
---|
[320] | 497 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 498 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 499 | ENDIF |
---|
| 500 | IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 501 | WRITE(*,*) |
---|
| 502 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 503 | STOP |
---|
| 504 | ENDIF |
---|
| 505 | CALL gr_dyn_fi(1, iml, jml, nbindex,zpic, champ) |
---|
| 506 | CASE ('zval') |
---|
| 507 | IF ( .NOT.ALLOCATED(zval)) THEN |
---|
[320] | 508 | CALL start_init_orog( iml, jml, lon_in, lat_in, |
---|
| 509 | . jml2, lon_in2,lat_in2 , interbar ) |
---|
[2] | 510 | ENDIF |
---|
| 511 | IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN |
---|
| 512 | WRITE(*,*) |
---|
| 513 | . 'STARTVAR module has been initialized to the wrong size' |
---|
| 514 | STOP |
---|
| 515 | ENDIF |
---|
| 516 | CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ) |
---|
[320] | 517 | CASE ('rads') |
---|
[2] | 518 | champ(:) = 0.0 |
---|
| 519 | CASE ('snow') |
---|
| 520 | champ(:) = 0.0 |
---|
| 521 | CASE ('deltat') |
---|
| 522 | champ(:) = 0.0 |
---|
| 523 | CASE ('rugmer') |
---|
| 524 | champ(:) = 0.001 |
---|
| 525 | CASE ('agsno') |
---|
| 526 | champ(:) = 50.0 |
---|
| 527 | CASE DEFAULT |
---|
| 528 | WRITE(*,*) 'startget_phys1d' |
---|
| 529 | WRITE(*,*) 'No rule is present to extract variable ', |
---|
| 530 | . varname(:LEN_TRIM(varname)),' from any data set' |
---|
| 531 | STOP |
---|
| 532 | END SELECT |
---|
| 533 | ELSE |
---|
| 534 | ! |
---|
| 535 | ! If we see tsol we catch it as we may need it for a 3D interpolation |
---|
| 536 | ! |
---|
| 537 | SELECTCASE(varname) |
---|
| 538 | CASE ('tsol') |
---|
| 539 | IF ( .NOT.ALLOCATED(tsol)) THEN |
---|
| 540 | ALLOCATE(tsol(SIZE(lon_in),SIZE(lat_in) )) |
---|
| 541 | ENDIF |
---|
| 542 | CALL gr_fi_dyn(1, iml, jml, nbindex, champ, tsol) |
---|
| 543 | END SELECT |
---|
| 544 | ENDIF |
---|
| 545 | END SUBROUTINE startget_phys1d |
---|
| 546 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 547 | ! |
---|
[320] | 548 | SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2, |
---|
| 549 | . lon_in2, lat_in2 , interbar ) |
---|
[2] | 550 | ! |
---|
[320] | 551 | INTEGER, INTENT(in) :: iml, jml ,jml2 |
---|
[2] | 552 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 553 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
| 554 | LOGICAL interbar |
---|
[2] | 555 | ! |
---|
| 556 | ! LOCAL |
---|
| 557 | ! |
---|
| 558 | REAL :: lev(1), date, dt |
---|
| 559 | INTEGER :: itau(1) |
---|
| 560 | INTEGER :: llm_tmp, ttm_tmp |
---|
| 561 | INTEGER :: i, j |
---|
| 562 | ! |
---|
[320] | 563 | CHARACTER*25 title |
---|
[2] | 564 | CHARACTER*120 :: physfname |
---|
| 565 | LOGICAL :: check=.TRUE. |
---|
| 566 | ! |
---|
| 567 | REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) |
---|
[320] | 568 | REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) |
---|
[2] | 569 | REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:) |
---|
| 570 | ! |
---|
| 571 | physfname = 'ECPHY.nc' |
---|
| 572 | ! |
---|
| 573 | IF ( check ) WRITE(*,*) 'Opening the surface analysis' |
---|
| 574 | ! |
---|
| 575 | CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, |
---|
| 576 | . ttm_tmp, fid_phys) |
---|
| 577 | ! |
---|
| 578 | ! |
---|
| 579 | ALLOCATE (lat_phys(iml_phys,jml_phys)) |
---|
| 580 | ALLOCATE (lon_phys(iml_phys,jml_phys)) |
---|
| 581 | ! |
---|
| 582 | CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, |
---|
| 583 | . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp, |
---|
| 584 | . itau, date, dt, fid_phys) |
---|
| 585 | ! |
---|
| 586 | ! Allocate the space we will need to get the data out of this file |
---|
| 587 | ! |
---|
| 588 | ALLOCATE(var_ana(iml_phys, jml_phys)) |
---|
| 589 | ! |
---|
| 590 | ! In case we have a file which is in degrees we do the transformation |
---|
| 591 | ! |
---|
| 592 | ALLOCATE(lon_rad(iml_phys)) |
---|
[320] | 593 | ALLOCATE(lon_ini(iml_phys)) |
---|
| 594 | |
---|
[2] | 595 | IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 596 | lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 597 | ELSE |
---|
[320] | 598 | lon_ini(:) = lon_phys(:,1) |
---|
[2] | 599 | ENDIF |
---|
[320] | 600 | |
---|
[2] | 601 | ALLOCATE(lat_rad(jml_phys)) |
---|
[320] | 602 | ALLOCATE(lat_ini(jml_phys)) |
---|
| 603 | |
---|
[2] | 604 | IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 605 | lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 606 | ELSE |
---|
[320] | 607 | lat_ini(:) = lat_phys(1,:) |
---|
[2] | 608 | ENDIF |
---|
[320] | 609 | |
---|
| 610 | |
---|
[2] | 611 | ! |
---|
| 612 | ! We get the two standard varibales |
---|
| 613 | ! Surface temperature |
---|
| 614 | ! |
---|
| 615 | ALLOCATE(tsol(iml,jml)) |
---|
| 616 | ALLOCATE(tmp_var(iml-1,jml)) |
---|
| 617 | ! |
---|
| 618 | ! |
---|
[320] | 619 | |
---|
[2] | 620 | CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, |
---|
| 621 | .llm_tmp, ttm_tmp, 1, 1, var_ana) |
---|
[320] | 622 | |
---|
| 623 | title='ST' |
---|
| 624 | CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, |
---|
| 625 | . lon_rad, lat_rad, var_ana , interbar ) |
---|
| 626 | |
---|
| 627 | IF ( interbar ) THEN |
---|
| 628 | WRITE(6,*) '-------------------------------------------------', |
---|
| 629 | ,'--------------' |
---|
| 630 | WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', |
---|
| 631 | , ' pour ST $$$ ' |
---|
| 632 | WRITE(6,*) '-------------------------------------------------', |
---|
| 633 | ,'--------------' |
---|
| 634 | CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad , |
---|
| 635 | , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var ) |
---|
| 636 | ELSE |
---|
| 637 | CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, |
---|
| 638 | . var_ana, iml-1, jml, lon_in, lat_in, tmp_var ) |
---|
| 639 | ENDIF |
---|
| 640 | |
---|
[2] | 641 | CALL gr_int_dyn(tmp_var, tsol, iml-1, jml) |
---|
| 642 | ! |
---|
| 643 | ! Soil moisture |
---|
| 644 | ! |
---|
| 645 | ALLOCATE(qsol(iml,jml)) |
---|
| 646 | CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, |
---|
| 647 | . llm_tmp, ttm_tmp, 1, 1, var_ana) |
---|
[320] | 648 | |
---|
| 649 | title='CDSW' |
---|
| 650 | CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, |
---|
| 651 | . lon_rad, lat_rad, var_ana, interbar ) |
---|
| 652 | |
---|
| 653 | IF ( interbar ) THEN |
---|
| 654 | WRITE(6,*) '-------------------------------------------------', |
---|
| 655 | ,'--------------' |
---|
| 656 | WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', |
---|
| 657 | , ' pour CDSW $$$ ' |
---|
| 658 | WRITE(6,*) '-------------------------------------------------', |
---|
| 659 | ,'--------------' |
---|
| 660 | CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad , |
---|
| 661 | , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var ) |
---|
| 662 | ELSE |
---|
| 663 | CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, |
---|
| 664 | . var_ana, iml-1, jml, lon_in, lat_in, tmp_var ) |
---|
| 665 | ENDIF |
---|
| 666 | c |
---|
| 667 | CALL gr_int_dyn(tmp_var, qsol, iml-1, jml) |
---|
[2] | 668 | ! |
---|
[320] | 669 | CALL flinclo(fid_phys) |
---|
[2] | 670 | ! |
---|
| 671 | END SUBROUTINE start_init_phys |
---|
| 672 | ! |
---|
| 673 | ! |
---|
| 674 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 675 | ! |
---|
| 676 | ! |
---|
| 677 | SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in, |
---|
[320] | 678 | . lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 , |
---|
| 679 | , interbar ) |
---|
[2] | 680 | ! |
---|
| 681 | ! ARGUMENTS |
---|
| 682 | ! |
---|
| 683 | CHARACTER*(*), INTENT(in) :: varname |
---|
[320] | 684 | INTEGER, INTENT(in) :: iml, jml, lml, jml2 |
---|
[2] | 685 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 686 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
[2] | 687 | REAL, INTENT(in) :: pls(iml, jml, lml) |
---|
| 688 | REAL, INTENT(in) :: workvar(iml, jml, lml) |
---|
| 689 | REAL, INTENT(inout) :: champ(iml, jml, lml) |
---|
| 690 | REAL, INTENT(in) :: val_exp |
---|
[320] | 691 | LOGICAL interbar |
---|
[2] | 692 | ! |
---|
| 693 | ! LOCAL |
---|
| 694 | ! |
---|
| 695 | INTEGER :: il, ij, ii |
---|
| 696 | REAL :: xppn, xpps |
---|
| 697 | ! |
---|
| 698 | #include "dimensions.h" |
---|
| 699 | #include "paramet.h" |
---|
| 700 | #include "comgeom2.h" |
---|
| 701 | #include "comconst.h" |
---|
| 702 | ! |
---|
| 703 | ! This routine only works if the variable does not exist or is constant |
---|
| 704 | ! |
---|
| 705 | IF ( MINVAL(champ(:,:,:)).EQ.MAXVAL(champ(:,:,:)) .AND. |
---|
| 706 | . MINVAL(champ(:,:,:)).EQ.val_exp ) THEN |
---|
| 707 | ! |
---|
| 708 | SELECTCASE(varname) |
---|
| 709 | CASE ('u') |
---|
| 710 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 711 | CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , |
---|
| 712 | . lon_in2,lat_in2 , interbar ) |
---|
[2] | 713 | ENDIF |
---|
| 714 | CALL start_inter_3d('U', iml, jml, lml, lon_in, |
---|
[320] | 715 | . lat_in, jml2, lon_in2, lat_in2, pls, champ,interbar ) |
---|
[2] | 716 | DO il=1,lml |
---|
| 717 | DO ij=1,jml |
---|
| 718 | DO ii=1,iml-1 |
---|
| 719 | champ(ii,ij,il) = champ(ii,ij,il) * cu(ii,ij) |
---|
| 720 | ENDDO |
---|
| 721 | champ(iml,ij, il) = champ(1,ij, il) |
---|
| 722 | ENDDO |
---|
| 723 | ENDDO |
---|
| 724 | CASE ('v') |
---|
| 725 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 726 | CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2, |
---|
| 727 | . lon_in2, lat_in2 , interbar ) |
---|
[2] | 728 | ENDIF |
---|
[320] | 729 | CALL start_inter_3d('V', iml, jml, lml, lon_in, |
---|
| 730 | . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) |
---|
[2] | 731 | DO il=1,lml |
---|
| 732 | DO ij=1,jml |
---|
| 733 | DO ii=1,iml-1 |
---|
| 734 | champ(ii,ij,il) = champ(ii,ij,il) * cv(ii,ij) |
---|
| 735 | ENDDO |
---|
| 736 | champ(iml,ij, il) = champ(1,ij, il) |
---|
| 737 | ENDDO |
---|
| 738 | ENDDO |
---|
| 739 | CASE ('t') |
---|
| 740 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 741 | CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , |
---|
| 742 | . lon_in2, lat_in2 ,interbar ) |
---|
[2] | 743 | ENDIF |
---|
| 744 | CALL start_inter_3d('TEMP', iml, jml, lml, lon_in, |
---|
[320] | 745 | . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) |
---|
[2] | 746 | |
---|
| 747 | CASE ('tpot') |
---|
| 748 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 749 | CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 , |
---|
| 750 | . lon_in2, lat_in2 , interbar ) |
---|
[2] | 751 | ENDIF |
---|
| 752 | CALL start_inter_3d('TEMP', iml, jml, lml, lon_in, |
---|
[320] | 753 | . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) |
---|
[2] | 754 | IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) |
---|
| 755 | . THEN |
---|
| 756 | DO il=1,lml |
---|
| 757 | DO ij=1,jml |
---|
| 758 | DO ii=1,iml-1 |
---|
| 759 | champ(ii,ij,il) = champ(ii,ij,il) * cpp |
---|
| 760 | . / workvar(ii,ij,il) |
---|
| 761 | ENDDO |
---|
| 762 | champ(iml,ij,il) = champ(1,ij,il) |
---|
| 763 | ENDDO |
---|
| 764 | ENDDO |
---|
| 765 | DO il=1,lml |
---|
| 766 | xppn = SUM(aire(:,1)*champ(:,1,il))/apoln |
---|
[19] | 767 | xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols |
---|
[2] | 768 | champ(:,1,il) = xppn |
---|
| 769 | champ(:,jml,il) = xpps |
---|
| 770 | ENDDO |
---|
| 771 | ELSE |
---|
| 772 | WRITE(*,*)'Could not compute potential temperature as the' |
---|
| 773 | WRITE(*,*)'Exner function is missing or constant.' |
---|
| 774 | STOP |
---|
| 775 | ENDIF |
---|
| 776 | CASE ('q') |
---|
| 777 | IF ( .NOT.ALLOCATED(psol_dyn)) THEN |
---|
[320] | 778 | CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , |
---|
| 779 | . lon_in2, lat_in2 , interbar ) |
---|
[2] | 780 | ENDIF |
---|
| 781 | CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in, |
---|
[320] | 782 | . jml2, lon_in2, lat_in2, pls, champ, interbar ) |
---|
[2] | 783 | IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) |
---|
| 784 | . THEN |
---|
| 785 | DO il=1,lml |
---|
| 786 | DO ij=1,jml |
---|
| 787 | DO ii=1,iml-1 |
---|
| 788 | champ(ii,ij,il) = 0.01 * champ(ii,ij,il) * |
---|
| 789 | . workvar(ii,ij,il) |
---|
| 790 | ENDDO |
---|
| 791 | champ(iml,ij,il) = champ(1,ij,il) |
---|
| 792 | ENDDO |
---|
| 793 | ENDDO |
---|
| 794 | WHERE ( champ .LT. 0.) champ = 1.0E-10 |
---|
| 795 | DO il=1,lml |
---|
| 796 | xppn = SUM(aire(:,1)*champ(:,1,il))/apoln |
---|
[19] | 797 | xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols |
---|
[2] | 798 | champ(:,1,il) = xppn |
---|
| 799 | champ(:,jml,il) = xpps |
---|
| 800 | ENDDO |
---|
| 801 | ELSE |
---|
| 802 | WRITE(*,*)'Could not compute specific humidity as the' |
---|
| 803 | WRITE(*,*)'saturated humidity is missing or constant.' |
---|
| 804 | STOP |
---|
| 805 | ENDIF |
---|
| 806 | CASE DEFAULT |
---|
| 807 | WRITE(*,*) 'startget_dyn' |
---|
| 808 | WRITE(*,*) 'No rule is present to extract variable ', |
---|
| 809 | . varname(:LEN_TRIM(varname)),' from any data set' |
---|
| 810 | STOP |
---|
| 811 | END SELECT |
---|
| 812 | ENDIF |
---|
| 813 | END SUBROUTINE startget_dyn |
---|
| 814 | ! |
---|
| 815 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 816 | ! |
---|
[320] | 817 | SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 , |
---|
| 818 | , lat_in2 , interbar ) |
---|
[2] | 819 | ! |
---|
[320] | 820 | INTEGER, INTENT(in) :: iml, jml, jml2 |
---|
[2] | 821 | REAL, INTENT(in) :: lon_in(iml), lat_in(jml) |
---|
[320] | 822 | REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) |
---|
| 823 | LOGICAL interbar |
---|
[2] | 824 | ! |
---|
| 825 | ! LOCAL |
---|
| 826 | ! |
---|
| 827 | REAL :: lev(1), date, dt |
---|
| 828 | INTEGER :: itau(1) |
---|
| 829 | INTEGER :: i, j |
---|
| 830 | integer :: iret |
---|
| 831 | ! |
---|
| 832 | CHARACTER*120 :: physfname |
---|
| 833 | LOGICAL :: check=.TRUE. |
---|
| 834 | ! |
---|
| 835 | REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) |
---|
[320] | 836 | REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) |
---|
[2] | 837 | REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:) |
---|
| 838 | REAL, ALLOCATABLE :: xppn(:), xpps(:) |
---|
| 839 | LOGICAL :: allo |
---|
| 840 | ! |
---|
| 841 | ! |
---|
| 842 | #include "dimensions.h" |
---|
| 843 | #include "paramet.h" |
---|
| 844 | #include "comgeom2.h" |
---|
[320] | 845 | |
---|
| 846 | CHARACTER*25 title |
---|
| 847 | |
---|
[2] | 848 | ! |
---|
| 849 | physfname = 'ECDYN.nc' |
---|
| 850 | ! |
---|
| 851 | IF ( check ) WRITE(*,*) 'Opening the surface analysis' |
---|
| 852 | ! |
---|
| 853 | CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, |
---|
| 854 | . ttm_dyn, fid_dyn) |
---|
| 855 | IF ( check ) WRITE(*,*) 'Values read: ', iml_dyn, jml_dyn, |
---|
| 856 | . llm_dyn, ttm_dyn |
---|
| 857 | ! |
---|
| 858 | ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret) |
---|
| 859 | ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret) |
---|
[320] | 860 | ALLOCATE (levdyn_ini(llm_dyn), stat=iret) |
---|
[2] | 861 | ! |
---|
| 862 | CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn, |
---|
[320] | 863 | . lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, |
---|
[2] | 864 | . itau, date, dt, fid_dyn) |
---|
| 865 | ! |
---|
| 866 | |
---|
| 867 | allo = allocated (var_ana) |
---|
| 868 | if (allo) then |
---|
| 869 | DEALLOCATE(var_ana, stat=iret) |
---|
| 870 | endif |
---|
| 871 | ALLOCATE(var_ana(iml_dyn, jml_dyn), stat=iret) |
---|
| 872 | |
---|
| 873 | allo = allocated (lon_rad) |
---|
| 874 | if (allo) then |
---|
| 875 | DEALLOCATE(lon_rad, stat=iret) |
---|
| 876 | endif |
---|
[320] | 877 | |
---|
| 878 | ALLOCATE(lon_rad(iml_dyn), stat=iret) |
---|
| 879 | ALLOCATE(lon_ini(iml_dyn)) |
---|
[2] | 880 | |
---|
| 881 | IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 882 | lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 883 | ELSE |
---|
[320] | 884 | lon_ini(:) = lon_dyn(:,1) |
---|
[2] | 885 | ENDIF |
---|
[320] | 886 | |
---|
[2] | 887 | ALLOCATE(lat_rad(jml_dyn)) |
---|
[320] | 888 | ALLOCATE(lat_ini(jml_dyn)) |
---|
| 889 | |
---|
[2] | 890 | IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 891 | lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 892 | ELSE |
---|
[320] | 893 | lat_ini(:) = lat_dyn(1,:) |
---|
[2] | 894 | ENDIF |
---|
| 895 | ! |
---|
[320] | 896 | |
---|
| 897 | |
---|
[2] | 898 | ALLOCATE(z(iml, jml)) |
---|
| 899 | ALLOCATE(tmp_var(iml-1,jml)) |
---|
| 900 | ! |
---|
| 901 | CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, |
---|
| 902 | . 1, 1, var_ana) |
---|
[320] | 903 | c |
---|
| 904 | title='Z' |
---|
| 905 | CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini, |
---|
| 906 | . lon_rad, lat_rad, var_ana, interbar ) |
---|
| 907 | c |
---|
| 908 | IF ( interbar ) THEN |
---|
| 909 | WRITE(6,*) '-------------------------------------------------', |
---|
| 910 | ,'--------------' |
---|
| 911 | WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', |
---|
| 912 | , ' pour Z $$$ ' |
---|
| 913 | WRITE(6,*) '-------------------------------------------------', |
---|
| 914 | ,'--------------' |
---|
| 915 | CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad , |
---|
| 916 | , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) |
---|
| 917 | ELSE |
---|
| 918 | CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, |
---|
[2] | 919 | . iml-1, jml, lon_in, lat_in, tmp_var) |
---|
[320] | 920 | ENDIF |
---|
| 921 | |
---|
[2] | 922 | CALL gr_int_dyn(tmp_var, z, iml-1, jml) |
---|
| 923 | ! |
---|
| 924 | ALLOCATE(psol_dyn(iml, jml)) |
---|
| 925 | ! |
---|
| 926 | CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, |
---|
| 927 | . 1, 1, var_ana) |
---|
[320] | 928 | |
---|
| 929 | title='SP' |
---|
| 930 | CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini, |
---|
| 931 | . lon_rad, lat_rad, var_ana, interbar ) |
---|
| 932 | |
---|
| 933 | IF ( interbar ) THEN |
---|
| 934 | WRITE(6,*) '-------------------------------------------------', |
---|
| 935 | ,'--------------' |
---|
| 936 | WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', |
---|
| 937 | , ' pour SP $$$ ' |
---|
| 938 | WRITE(6,*) '-------------------------------------------------', |
---|
| 939 | ,'--------------' |
---|
| 940 | CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad , |
---|
| 941 | , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) |
---|
| 942 | ELSE |
---|
| 943 | CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, |
---|
| 944 | . iml-1, jml, lon_in, lat_in, tmp_var ) |
---|
| 945 | ENDIF |
---|
| 946 | |
---|
[2] | 947 | CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml) |
---|
| 948 | ! |
---|
| 949 | IF ( .NOT.ALLOCATED(tsol)) THEN |
---|
| 950 | ! These variables may have been allocated by the need to |
---|
| 951 | ! create a start field for them or by the varibale |
---|
| 952 | ! coming out of the restart file. In case we dor have it we will initialize it. |
---|
| 953 | ! |
---|
[320] | 954 | CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2, |
---|
| 955 | . lat_in2 , interbar ) |
---|
[2] | 956 | ELSE |
---|
| 957 | IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN |
---|
| 958 | WRITE(*,*) 'start_init_dyn :' |
---|
| 959 | WRITE(*,*) 'The temperature field we have does not ', |
---|
| 960 | . 'have the right size' |
---|
| 961 | STOP |
---|
| 962 | ENDIF |
---|
| 963 | ENDIF |
---|
| 964 | IF ( .NOT.ALLOCATED(phis)) THEN |
---|
| 965 | ! |
---|
| 966 | ! These variables may have been allocated by the need to create a start field for them or by the varibale |
---|
| 967 | ! coming out of the restart file. In case we dor have it we will initialize it. |
---|
| 968 | ! |
---|
[320] | 969 | CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 , |
---|
| 970 | . lat_in2 , interbar ) |
---|
[2] | 971 | ! |
---|
| 972 | ELSE |
---|
| 973 | ! |
---|
| 974 | IF (SIZE(phis) .NE. SIZE(psol_dyn)) THEN |
---|
| 975 | ! |
---|
| 976 | WRITE(*,*) 'start_init_dyn :' |
---|
| 977 | WRITE(*,*) 'The orography field we have does not ', |
---|
| 978 | . ' have the right size' |
---|
| 979 | STOP |
---|
| 980 | ENDIF |
---|
| 981 | ! |
---|
| 982 | ENDIF |
---|
| 983 | ! |
---|
| 984 | ! PSOL is computed in Pascals |
---|
| 985 | ! |
---|
| 986 | ! |
---|
| 987 | DO j = 1, jml |
---|
| 988 | DO i = 1, iml-1 |
---|
| 989 | psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j)) |
---|
| 990 | . /287.0/tsol(i,j)) |
---|
| 991 | ENDDO |
---|
| 992 | psol_dyn(iml,j) = psol_dyn(1,j) |
---|
| 993 | ENDDO |
---|
| 994 | ! |
---|
| 995 | ! |
---|
| 996 | ALLOCATE(xppn(iml-1)) |
---|
| 997 | ALLOCATE(xpps(iml-1)) |
---|
| 998 | ! |
---|
| 999 | DO i = 1, iml-1 |
---|
| 1000 | xppn(i) = aire( i,1) * psol_dyn( i,1) |
---|
| 1001 | xpps(i) = aire( i,jml) * psol_dyn( i,jml) |
---|
| 1002 | ENDDO |
---|
| 1003 | ! |
---|
| 1004 | DO i = 1, iml |
---|
| 1005 | psol_dyn(i,1 ) = SUM(xppn)/apoln |
---|
| 1006 | psol_dyn(i,jml) = SUM(xpps)/apols |
---|
| 1007 | ENDDO |
---|
| 1008 | ! |
---|
| 1009 | RETURN |
---|
| 1010 | ! |
---|
| 1011 | END SUBROUTINE start_init_dyn |
---|
| 1012 | ! |
---|
| 1013 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 1014 | ! |
---|
| 1015 | SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in, |
---|
[320] | 1016 | . lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar ) |
---|
[2] | 1017 | ! |
---|
| 1018 | ! This subroutine gets a variables from a 3D file and does the interpolations needed |
---|
| 1019 | ! |
---|
| 1020 | ! |
---|
| 1021 | ! ARGUMENTS |
---|
| 1022 | ! |
---|
| 1023 | CHARACTER*(*) :: varname |
---|
[320] | 1024 | INTEGER :: iml, jml, lml, jml2 |
---|
[2] | 1025 | REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml) |
---|
[320] | 1026 | REAL :: lon_in2(iml) , lat_in2(jml2) |
---|
[2] | 1027 | REAL :: var3d(iml, jml, lml) |
---|
[320] | 1028 | LOGICAL interbar |
---|
| 1029 | real chmin,chmax |
---|
[2] | 1030 | ! |
---|
| 1031 | ! LOCAL |
---|
| 1032 | ! |
---|
[320] | 1033 | CHARACTER*25 title |
---|
| 1034 | INTEGER :: ii, ij, il, jsort,i,j,l |
---|
[2] | 1035 | REAL :: bx, by |
---|
| 1036 | REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) |
---|
[320] | 1037 | REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:) |
---|
[2] | 1038 | REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:) |
---|
| 1039 | REAL, ALLOCATABLE :: ax(:), ay(:), yder(:) |
---|
[320] | 1040 | REAL, ALLOCATABLE :: varrr(:,:,:) |
---|
[2] | 1041 | INTEGER, ALLOCATABLE :: lind(:) |
---|
| 1042 | ! |
---|
| 1043 | LOGICAL :: check = .TRUE. |
---|
| 1044 | ! |
---|
| 1045 | IF ( .NOT. ALLOCATED(var_ana3d)) THEN |
---|
| 1046 | ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn)) |
---|
| 1047 | ENDIF |
---|
[320] | 1048 | ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn)) |
---|
[2] | 1049 | ! |
---|
| 1050 | ! |
---|
| 1051 | IF ( check) WRITE(*,*) 'Going into flinget to extract the 3D ', |
---|
| 1052 | . ' field.', fid_dyn |
---|
| 1053 | IF ( check) WRITE(*,*) fid_dyn, varname, iml_dyn, jml_dyn, |
---|
| 1054 | . llm_dyn,ttm_dyn |
---|
| 1055 | ! |
---|
| 1056 | CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, |
---|
| 1057 | . ttm_dyn, 1, 1, var_ana3d) |
---|
| 1058 | ! |
---|
| 1059 | IF ( check) WRITE(*,*) 'Allocating space for the interpolation', |
---|
| 1060 | . iml, jml, llm_dyn |
---|
| 1061 | ! |
---|
| 1062 | ALLOCATE(lon_rad(iml_dyn)) |
---|
[320] | 1063 | ALLOCATE(lon_ini(iml_dyn)) |
---|
| 1064 | |
---|
[2] | 1065 | IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 1066 | lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 1067 | ELSE |
---|
[320] | 1068 | lon_ini(:) = lon_dyn(:,1) |
---|
[2] | 1069 | ENDIF |
---|
[320] | 1070 | |
---|
[2] | 1071 | ALLOCATE(lat_rad(jml_dyn)) |
---|
[320] | 1072 | ALLOCATE(lat_ini(jml_dyn)) |
---|
| 1073 | |
---|
| 1074 | ALLOCATE(lev_dyn(llm_dyn)) |
---|
| 1075 | |
---|
[2] | 1076 | IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN |
---|
[320] | 1077 | lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 |
---|
[2] | 1078 | ELSE |
---|
[320] | 1079 | lat_ini(:) = lat_dyn(1,:) |
---|
[2] | 1080 | ENDIF |
---|
| 1081 | ! |
---|
[320] | 1082 | |
---|
| 1083 | CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini, |
---|
| 1084 | . lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d , |
---|
| 1085 | , interbar ) |
---|
| 1086 | |
---|
[2] | 1087 | ALLOCATE(var_tmp2d(iml-1, jml)) |
---|
| 1088 | ALLOCATE(var_tmp3d(iml, jml, llm_dyn)) |
---|
| 1089 | ALLOCATE(ax(llm_dyn)) |
---|
| 1090 | ALLOCATE(ay(llm_dyn)) |
---|
| 1091 | ALLOCATE(yder(llm_dyn)) |
---|
| 1092 | ALLOCATE(lind(llm_dyn)) |
---|
| 1093 | ! |
---|
[320] | 1094 | |
---|
[2] | 1095 | DO il=1,llm_dyn |
---|
| 1096 | ! |
---|
[320] | 1097 | IF( interbar ) THEN |
---|
| 1098 | IF( il.EQ.1 ) THEN |
---|
| 1099 | WRITE(6,*) '-------------------------------------------------', |
---|
| 1100 | ,'--------------' |
---|
| 1101 | WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', |
---|
| 1102 | , ' pour ', varname |
---|
| 1103 | WRITE(6,*) '-------------------------------------------------', |
---|
| 1104 | ,'--------------' |
---|
| 1105 | ENDIF |
---|
| 1106 | CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad, |
---|
| 1107 | , var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d ) |
---|
| 1108 | ELSE |
---|
| 1109 | CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, |
---|
| 1110 | . var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d ) |
---|
| 1111 | ENDIF |
---|
[2] | 1112 | ! |
---|
| 1113 | CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml) |
---|
| 1114 | ! |
---|
| 1115 | ENDDO |
---|
| 1116 | ! |
---|
| 1117 | DO il=1,llm_dyn |
---|
| 1118 | lind(il) = llm_dyn-il+1 |
---|
| 1119 | ENDDO |
---|
| 1120 | ! |
---|
[320] | 1121 | c |
---|
| 1122 | c ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere |
---|
| 1123 | c vers le sol ... |
---|
| 1124 | c |
---|
[2] | 1125 | DO ij=1,jml |
---|
| 1126 | DO ii=1,iml-1 |
---|
| 1127 | ! |
---|
[320] | 1128 | ax(:) = lev_dyn(lind(:)) |
---|
[2] | 1129 | ay(:) = var_tmp3d(ii, ij, lind(:)) |
---|
| 1130 | ! |
---|
[320] | 1131 | |
---|
[2] | 1132 | CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder) |
---|
| 1133 | ! |
---|
| 1134 | DO il=1,lml |
---|
| 1135 | bx = pls_in(ii, ij, il) |
---|
| 1136 | CALL SPLINT(ax, ay, yder, llm_dyn, bx, by) |
---|
| 1137 | var3d(ii, ij, il) = by |
---|
| 1138 | ENDDO |
---|
| 1139 | ! |
---|
| 1140 | ENDDO |
---|
| 1141 | var3d(iml, ij, :) = var3d(1, ij, :) |
---|
| 1142 | ENDDO |
---|
| 1143 | |
---|
[320] | 1144 | do il=1,lml |
---|
| 1145 | call minmax(iml*jml,var3d(1,1,il),chmin,chmax) |
---|
| 1146 | SELECTCASE(varname) |
---|
| 1147 | CASE('U') |
---|
| 1148 | WRITE(*,*) ' U min max l ',il,chmin,chmax |
---|
| 1149 | CASE('V') |
---|
| 1150 | WRITE(*,*) ' V min max l ',il,chmin,chmax |
---|
| 1151 | CASE('TEMP') |
---|
| 1152 | WRITE(*,*) ' TEMP min max l ',il,chmin,chmax |
---|
| 1153 | CASE('R') |
---|
| 1154 | WRITE(*,*) ' R min max l ',il,chmin,chmax |
---|
| 1155 | END SELECT |
---|
| 1156 | enddo |
---|
| 1157 | |
---|
[2] | 1158 | DEALLOCATE(lon_rad) |
---|
| 1159 | DEALLOCATE(lat_rad) |
---|
| 1160 | DEALLOCATE(var_tmp2d) |
---|
| 1161 | DEALLOCATE(var_tmp3d) |
---|
| 1162 | DEALLOCATE(ax) |
---|
| 1163 | DEALLOCATE(ay) |
---|
| 1164 | DEALLOCATE(yder) |
---|
| 1165 | DEALLOCATE(lind) |
---|
| 1166 | |
---|
| 1167 | ! |
---|
| 1168 | RETURN |
---|
| 1169 | ! |
---|
| 1170 | END SUBROUTINE start_inter_3d |
---|
| 1171 | ! |
---|
| 1172 | END MODULE startvar |
---|