Changeset 112 for LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F
- Timestamp:
- Jul 28, 2000, 2:38:04 PM (24 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F
r99 r112 10 10 ! 11 11 ! 12 INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2,13 .KLON=KFDIA-KIDIA+1,KLEV=llm12 c INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2, 13 c .KLON=KFDIA-KIDIA+1,KLEV=llm 14 14 ! 15 15 #include "comgeom2.h" 16 16 #include "comvert.h" 17 17 #include "comconst.h" 18 #include "indicesol.h" 19 #include "dimphy.h" 20 #include "dimsoil.h" 18 21 ! 19 22 REAL :: latfi(klon), lonfi(klon) … … 25 28 REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm) 26 29 REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm) 27 REAL :: tsol(klon), qsol(klon), sn(klon), radsol(klon) 28 REAL :: deltat(klon), rugmer(klon), agesno(klon) 30 REAL :: tsol(klon), qsol(klon), sn(klon) 31 REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf) 32 REAL :: albe(klon,nbsrf), evap(klon,nbsrf) 33 REAL :: tsoil(klon,nsoilmx,nbsrf) 34 REAL :: radsol(klon),rain_fall(klon), snow_fall(klon) 35 REAL :: solsw(klon), sollw(klon) 36 REAL :: deltat(klon), frugs(klon,nbsrf), agesno(klon),rugmer(klon) 29 37 REAL :: zmea(iip1*jjp1), zstd(iip1*jjp1) 30 38 REAL :: zsig(iip1*jjp1), zgam(iip1*jjp1), zthe(iip1*jjp1) 31 39 REAL :: zpic(iip1*jjp1), zval(iip1*jjp1), rugsrel(iip1*jjp1) 32 40 REAL :: qd(iip1, jjp1, llm) 33 ! 41 REAL :: pctsrf(klon, nbsrf) 42 REAL :: t_ancien(klon,klev), q_ancien(klon,klev) ! 43 ! declarations pour lecture glace de mer 44 INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret 45 INTEGER :: itaul(1), fid 46 REAL :: lev(1), date, dt 47 REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic 48 REAL, ALLOCATABLE, DIMENSION(:) :: dlon_lic, dlat_lic 49 REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic 50 REAL :: flic_tmp(iip1, jjp1) 51 REAL :: champint(iim, jjp1) 52 ! 53 34 54 CHARACTER*80 :: varname 35 55 ! 36 INTEGER :: i,j, ig, l 56 INTEGER :: i,j, ig, l, ji 37 57 REAL :: xpi 38 58 ! … … 144 164 ! 145 165 ! 166 167 168 C 169 C on initialise les sous surfaces 170 C 171 pctsrf=0. 172 !cree le masque a partir du fichier relief 173 varname = 'zmasq' 174 zmasq(:) = 0. 175 CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0) 176 WHERE (zmasq(1 : klon) .LE. EPSFRA) 177 zmasq(1 : klon) = 0. 178 END WHERE 179 WRITE(*,*)zmasq 180 181 182 183 146 184 varname = 'psol' 147 185 psol(:,:) = 0.0 … … 227 265 ! This line needs to be replaced by a call to restget to get the values in the restart file 228 266 tsol(:) = 0.0 229 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 267 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol,0.0) 230 268 ! 231 269 WRITE(*,*) 'TSOL construit :' … … 234 272 varname = 'qsol' 235 273 qsol(:) = 0.0 236 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 274 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol,0.0) 237 275 ! 238 276 varname = 'snow' 239 277 sn(:) = 0.0 240 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 278 CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn,0.0) 241 279 ! 242 280 varname = 'rads' … … 278 316 CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0) 279 317 rugsrel(:) = 0.0 318 319 320 C 321 C lecture du fichier glace de terre pour fixer la fraction de terre 322 C et de glace de terre 323 C 324 CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp 325 $ , fid) 326 ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret) 327 ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret) 328 ALLOCATE(dlon_lic(iml_lic), stat=iret) 329 ALLOCATE(dlat_lic(jml_lic), stat=iret) 330 ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret) 331 CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp 332 $ , lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid) 333 CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp 334 $ , 1, 1, fraclic) 335 CALL flinclo(fid) 336 C 337 C interpolation sur la grille T du modele 338 C 339 WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ', 340 $ iml_lic, jml_lic 341 c 342 C sil les coordonnees sont en degres, on les transforme 343 C 344 IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) ) THEN 345 lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180. 346 ENDIF 347 IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN 348 lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180. 349 ENDIF 350 351 dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1) 352 dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic) 353 C 354 CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic 355 $ ,iim, jjp1, 356 $ rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1)) 357 c$$$ flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1) 358 flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1) 359 C 360 C passage sur la grille physique 361 C 362 CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, 363 $ pctsrf(1:klon, is_lic)) 364 C adequation avec le maque terre/mer 365 WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA ) 366 pctsrf(1 : klon, is_lic) = 0. 367 END WHERE 368 WHERE (zmasq( 1 : klon) .LE. EPSFRA) 369 pctsrf(1 : klon, is_lic) = 0. 370 END WHERE 371 pctsrf(1 : klon, is_ter) = zmasq(1 : klon) 372 DO ji = 1, klon 373 IF (zmasq(ji) .GT. EPSFRA) THEN 374 IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN 375 pctsrf(ji, is_lic) = zmasq(ji) 376 pctsrf(ji, is_ter) = 0. 377 ELSE 378 pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic) 379 ENDIF 380 ENDIF 381 END DO 382 C 383 C sous surface ocean et glace de mer (pour demarrer on met glace de mer a 0) 384 C 385 pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon)) 386 WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA) 387 pctsrf(1 : klon, is_oce) = 0. 388 END WHERE 389 C 390 C verif que somme des sous surface = 1 391 C 392 ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 ) 393 $ .GT. EPSFRA) 394 IF (ji .NE. 0) THEN 395 WRITE(*,*) 'pb repartition sous maille pour ',ji,' points' 396 ENDIF 397 398 399 400 401 280 402 C Calcul intermediaire 281 403 c … … 333 455 solaire = 1370.0 334 456 335 call physdem(lonfi, latfi, phystep,radpas,co2_ppm, 336 . solaire,tsol, qsol, 337 . sn, radsol, deltat, rugmer, 338 . agesno, zmea, zstd, zsig, 339 . zgam, zthe, zpic, zval, 340 . rugsrel) 457 c call physdem(lonfi, latfi, phystep,radpas,co2_ppm, 458 c . solaire,tsol, qsol, 459 c . sn, radsol, deltat, rugmer, 460 c . agesno, zmea, zstd, zsig, 461 c . zgam, zthe, zpic, zval, 462 c . rugsrel) 463 464 c 465 c Initialisation 466 c tsol, qsol, sn,albe, evap,tsoil,rain_fall, snow_fall,solsw, sollw,frugs 467 c 468 tsolsrf(:,is_ter) = tsol 469 tsolsrf(:,is_lic) = tsol 470 tsolsrf(:,is_oce) = tsol 471 tsolsrf(:,is_sic) = tsol 472 snsrf(:,is_ter) = sn 473 snsrf(:,is_lic) = sn 474 snsrf(:,is_oce) = sn 475 snsrf(:,is_sic) = sn 476 albe(:,is_ter) = 0.08 477 albe(:,is_lic) = 0.6 478 albe(:,is_oce) = 0.5 479 albe(:,is_sic) = 0.6 480 evap(:,:) = 0. 481 qsolsrf(:,is_ter) = qsol 482 qsolsrf(:,is_lic) = qsol 483 qsolsrf(:,is_oce) = 150. 484 qsolsrf(:,is_sic) = 150. 485 do i = 1, nbsrf 486 do j = 1, nsoilmx 487 tsoil(:,j,i) = tsol 488 enddo 489 enddo 490 rain_fall = 0.; snow_fall = 0. 491 solsw = 165. 492 sollw = -53. 493 t_ancien = 273.15 494 q_ancien = 0. 495 agesno = 0. 496 deltat = 0. 497 frugs(:,is_oce) = rugmer 498 frugs(:,is_ter) = rugmer 499 frugs(:,is_lic) = rugmer 500 frugs(:,is_sic) = rugmer 501 502 call phyredem("startphy.nc",phystep,radpas, co2_ppm, solaire, 503 $ latfi, lonfi, pctsrf, tsolsrf, tsoil, deltat, qsolsrf, snsrf, 504 $ albe, evap, rain_fall, snow_fall, solsw, sollw, 505 $ radsol, frugs, agesno, 506 $ zmea, zstd, zsig, zgam, zthe, zpic, zval, rugsrel, 507 $ t_ancien, q_ancien) 341 508 342 509 C Sortie Visu pour les champs dynamiques
Note: See TracChangeset
for help on using the changeset viewer.
