Changeset 883 for LMDZ4/trunk/libf
- Timestamp:
- Jan 31, 2008, 6:20:42 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf/phylmd
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phylmd/conf_phys.F90
r879 r883 6 6 7 7 subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, ok_hf, & 8 & s euil_inversion, &8 & solarlong0,qsol0,seuil_inversion, & 9 9 & fact_cldcon, facttemps,ok_newmicro,iflag_radia,& 10 10 & iflag_cldcon, & … … 26 26 include "compbl.h" 27 27 include "control.h" 28 include "comsoil.h" 28 29 ! 29 30 ! Configuration de la "physique" de LMDZ a l'aide de la fonction … … 93 94 INTEGER,SAVE :: iflag_pdf_omp 94 95 REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp 96 REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_ice_omp 97 REAL :: qsol0 98 REAL,SAVE :: qsol0_omp 99 REAL :: solarlong0 100 REAL,SAVE :: solarlong0_omp 95 101 INTEGER,SAVE :: top_height_omp,overlap_omp 96 102 REAL,SAVE :: cdmmax_omp,cdhmax_omp,ksta_omp,ksta_ter_omp … … 536 542 ratqshaut_omp = 0.3 537 543 call getin('ratqshaut',ratqshaut_omp) 544 545 ! 546 !----------------------------------------------------------------------- 547 ! Longitude solaire pour le calcul de l'ensoleillement en degre 548 ! si on veut imposer la saison. Sinon, solarlong0=-999.999 549 !Config Key = solarlong0 550 !Config Desc = 551 !Config Def = -999.999 552 !Config Help = 553 ! 554 solarlong0_omp = -999.999 555 call getin('solarlong0',solarlong0_omp) 556 ! 557 !----------------------------------------------------------------------- 558 ! Valeur imposee de l'humidite du sol pour le modele bucket. 559 !Config Key = qsol0 560 !Config Desc = 561 !Config Def = -1. 562 !Config Help = 563 ! 564 qsol0_omp = -1. 565 call getin('qsol0',qsol0_omp) 566 ! 567 !----------------------------------------------------------------------- 568 ! 569 !Config Key = inertie_ice 570 !Config Desc = 571 !Config Def = 2000. 572 !Config Help = 573 ! 574 inertie_ice_omp = 2000. 575 call getin('inertie_ice',inertie_ice_omp) 576 ! 577 !Config Key = inertie_sno 578 !Config Desc = 579 !Config Def = 2000. 580 !Config Help = 581 ! 582 inertie_sno_omp = 2000. 583 call getin('inertie_sno',inertie_sno_omp) 584 ! 585 !Config Key = inertie_sol 586 !Config Desc = 587 !Config Def = 2000. 588 !Config Help = 589 ! 590 inertie_sol_omp = 2000. 591 call getin('inertie_sol',inertie_sol_omp) 538 592 539 593 ! … … 872 926 reevap_ice = reevap_ice_omp 873 927 iflag_pdf = iflag_pdf_omp 928 solarlong0 = solarlong0_omp 929 qsol0 = qsol0_omp 930 inertie_sol = inertie_sol_omp 931 inertie_ice = inertie_ice_omp 932 inertie_sno = inertie_sno_omp 874 933 rad_froid = rad_froid_omp 875 934 rad_chau1 = rad_chau1_omp … … 996 1055 write(numout,*)' type_run = ',type_run 997 1056 write(numout,*)' ok_isccp = ',ok_isccp 1057 WRITE(numout,*)' solarlong0 = ', solarlong0 1058 write(numout,*)' qsol0 = ', qsol0 1059 write(numout,*)' inertie_sol = ', inertie_sol 1060 write(numout,*)' inertie_ice = ', inertie_ice 1061 write(numout,*)' inertie_sno = ', inertie_sno 1062 998 1063 write(numout,*)' lonmin lonmax latmin latmax bilKP_ins =',& 999 1064 & lonmin_ins, lonmax_ins, latmin_ins, latmax_ins -
LMDZ4/trunk/libf/phylmd/fisrtilp.F
r766 r883 63 63 64 64 INTEGER ninter ! sous-intervals pour la precipitation 65 INTEGER ncoreczq 65 66 PARAMETER (ninter=5) 66 67 LOGICAL evap_prec ! evaporation de la pluie … … 210 211 cAA---------------------------------------------------------- 211 212 c 213 ncoreczq=0 212 214 c Boucle verticale (du haut vers le bas) 213 215 c … … 342 344 do i=1,klon 343 345 if(zq(i).lt.1.e-15) then 344 print*,'ZQ(',i,',',k,')=',zq(i)346 ncoreczq=ncoreczq+1 345 347 zq(i)=1.e-15 346 348 endif … … 539 541 END DO 540 542 c 543 544 if (ncoreczq>0) then 545 print*,'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.' 546 endif 541 547 RETURN 542 548 END -
LMDZ4/trunk/libf/phylmd/physiq.F
r881 r883 687 687 c 688 688 REAL qsol(klon) 689 REAL,save :: qsol0 690 REAL,save :: solarlong0 689 691 c 690 692 REAL,allocatable,save :: falbe(:,:) … … 1478 1480 c====================================================================== 1479 1481 1480 if (klon.eq.1) then 1481 print*,'WARNING !!!! omega=0' 1482 omega=0. 1483 igout=1 1482 if (1.eq.1) then 1483 igout=klon/2 1484 1484 write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 1485 1485 write(lunout,*) … … 1738 1738 c 1739 1739 call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, 1740 . ok_instan, ok_hf, seuil_inversion, 1740 . ok_instan, ok_hf, 1741 . solarlong0,qsol0,seuil_inversion, 1741 1742 . fact_cldcon, facttemps,ok_newmicro,iflag_radia, 1742 1743 . iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut, … … 2256 2257 2257 2258 c 2258 C calculs necessaires au calcul de l'albedo dans l'interface 2259 c 2260 CALL orbite(FLOAT(julien),zlongi,dist) 2259 c========================================================================= 2260 ! Calculs de l'orbite. 2261 ! Necessaires pour le rayonnement et la surface (calcul de l'albedo). 2262 ! doit donc etre placé avant radlwsw et pbl_surface 2263 2264 ! choix entre calcul de la longitude solaire vraie ou valeur fixee a 2265 ! solarlong0 2266 2267 if (solarlong0<-999.) then 2268 CALL orbite(FLOAT(julien),zlongi,dist) 2269 else 2270 zlongi=solarlong0 ! longitude solaire vraie 2271 dist=1. ! distance au soleil / moyenne 2272 endif 2273 2274 print*,'Longitude solaire ',zlongi,solarlong0 2275 2276 ! Avec ou sans cycle diurne 2261 2277 IF (cycle_diurne) THEN 2262 2278 zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s) … … 2292 2308 c dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq 2293 2309 c 2310 2311 if (qsol0>0.) qsol(:)=qsol0 2312 2294 2313 CALL pbl_surface( 2295 2314 e dtime, date0, itap, julien, -
LMDZ4/trunk/libf/phylmd/soil.F
r776 r883 56 56 #include "dimsoil.h" 57 57 #include "indicesol.h" 58 #include "comsoil.h" 58 59 59 60 c----------------------------------------------------------------------- … … 91 92 SAVE firstcall, firstsurf 92 93 c$OMP THREADPRIVATE(firstcall, firstsurf) 93 REAL isol,isno,iice94 SAVE isol,isno,iice95 c$OMP THREADPRIVATE(isol,isno,iice)96 94 DATA firstcall/.true./ 97 95 DATA firstsurf/.TRUE.,.TRUE.,.TRUE.,.TRUE./ 98 96 99 DATA isol,isno,iice/2000.,2000.,2000./100 97 LOGICAL,SAVE :: First=.true. 101 98 c$OMP THREADPRIVATE(First) … … 108 105 pfluxgrd(:) = 0. 109 106 c calcul de l'inertie thermique a partir de la variable rnat. 110 c on initialise a i ice meme au-dessus d'un point de mer au cas107 c on initialise a inertie_ice meme au-dessus d'un point de mer au cas 111 108 c ou le point de mer devienne point de glace au pas suivant 112 109 c on corrige si on a un point de terre avec ou sans glace … … 119 116 IF (indice.EQ.is_sic) THEN 120 117 DO ig = 1, knon 121 ztherm_i(ig) = i ice122 IF (snow(ig).GT.0.0) ztherm_i(ig) = i sno118 ztherm_i(ig) = inertie_ice 119 IF (snow(ig).GT.0.0) ztherm_i(ig) = inertie_sno 123 120 ENDDO 124 121 ELSE IF (indice.EQ.is_lic) THEN 125 122 DO ig = 1, knon 126 ztherm_i(ig) = i ice127 IF (snow(ig).GT.0.0) ztherm_i(ig) = i sno123 ztherm_i(ig) = inertie_ice 124 IF (snow(ig).GT.0.0) ztherm_i(ig) = inertie_sno 128 125 ENDDO 129 126 ELSE IF (indice.EQ.is_ter) THEN 130 127 DO ig = 1, knon 131 ztherm_i(ig) = i sol132 IF (snow(ig).GT.0.0) ztherm_i(ig) = i sno128 ztherm_i(ig) = inertie_sol 129 IF (snow(ig).GT.0.0) ztherm_i(ig) = inertie_sno 133 130 ENDDO 134 131 ELSE IF (indice.EQ.is_oce) THEN 135 132 DO ig = 1, knon 136 ztherm_i(ig) = i ice133 ztherm_i(ig) = inertie_ice 137 134 ENDDO 138 135 ELSE -
LMDZ4/trunk/libf/phylmd/thermcell_flux.F90
r878 r883 206 206 207 207 208 if (1.eq. 0) then208 if (1.eq.1) then 209 209 ! do l=1,klev 210 210 do ig=1,ngrid -
LMDZ4/trunk/libf/phylmd/thermcell_main.F90
r879 r883 59 59 ! ------ 60 60 61 integer,save :: igout=1 52161 integer,save :: igout=1 62 62 integer,save :: lunout=6 63 integer,save :: lev_out=1 63 integer,save :: lev_out=10 64 64 65 65 INTEGER ig,k,l,ll … … 429 429 & po,pdoadj,zoa,lev_out) 430 430 431 if (1.eq.0) then 432 433 ! Calcul du transport de V tenant compte d'echange par gradient 434 ! de pression horizontal avec l'environnement 435 436 call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & 437 & ,fraca,zmax & 438 & ,zu,zv,pduadj,pdvadj,zua,zva,lev_out) 439 else 440 441 ! calcul purement conservatif pour le transport de V 442 call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse & 443 & ,zu,pduadj,zua,lev_out) 444 call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse & 445 & ,zv,pdvadj,zva,lev_out) 446 endif 447 448 ! print*,'13 OK convect8' 449 do l=1,nlay 450 do ig=1,ngrid 451 pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) 452 enddo 453 enddo 454 455 print*,'14 OK convect8' 456 !------------------------------------------------------------------ 457 ! Calculs de diagnostiques pour les sorties 458 !------------------------------------------------------------------ 459 !calcul de fraca pour les sorties 460 461 if (sorties) then 431 !------------------------------------------------------------------ 432 ! Calcul de la fraction de l'ascendance 433 !------------------------------------------------------------------ 462 434 do ig=1,klon 463 435 fraca(ig,1)=0. 436 fraca(ig,nlay+1)=0. 464 437 enddo 465 438 do l=2,nlay … … 473 446 enddo 474 447 448 !------------------------------------------------------------------ 449 ! calcul du transport vertical du moment horizontal 450 !------------------------------------------------------------------ 451 452 if (1.eq.1) then 453 454 455 ! Calcul du transport de V tenant compte d'echange par gradient 456 ! de pression horizontal avec l'environnement 457 458 call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & 459 & ,fraca,zmax & 460 & ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out) 461 else 462 463 ! calcul purement conservatif pour le transport de V 464 call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse & 465 & ,zu,pduadj,zua,lev_out) 466 call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse & 467 & ,zv,pdvadj,zva,lev_out) 468 endif 469 470 ! print*,'13 OK convect8' 471 do l=1,nlay 472 do ig=1,ngrid 473 pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) 474 enddo 475 enddo 476 477 print*,'14 OK convect8' 478 !------------------------------------------------------------------ 479 ! Calculs de diagnostiques pour les sorties 480 !------------------------------------------------------------------ 481 !calcul de fraca pour les sorties 482 483 if (sorties) then 475 484 print*,'14a OK convect8' 476 485 ! calcul du niveau de condensation
Note: See TracChangeset
for help on using the changeset viewer.