Changeset 833 for trunk/LMDZ.MARS/libf
- Timestamp:
- Nov 8, 2012, 7:03:03 PM (12 years ago)
- Location:
- trunk/LMDZ.MARS/libf/phymars
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/phymars/callkeys.h
r705 r833 12 12 & ,callg2d,linear,rayleigh,tracer,active,doubleq,submicron & 13 13 & ,lifting,callddevil,scavenging,sedimentation,activice,water & 14 & , microphys,caps,photochem,calltherm,outptherm,callrichsl&15 & ,call slope,tituscap14 & ,tifeedback,microphys,caps,photochem,calltherm,outptherm & 15 & ,callrichsl,callslope,tituscap 16 16 17 17 COMMON/callkeys_i/iradia,iaervar,iddist,ilwd,ilwb,ilwn,ncouche & … … 54 54 integer dustbin 55 55 logical active,doubleq,submicron,lifting,callddevil,scavenging 56 logical sedimentation,activice,water,microphys,caps 56 logical sedimentation 57 logical water,activice,tifeedback,microphys,caps 57 58 logical photochem 58 59 integer nltemodel -
trunk/LMDZ.MARS/libf/phymars/inifis.F
r740 r833 429 429 write(*,*) " water = ",water 430 430 431 ! thermal inertia feedback 432 write(*,*) "Activate the thermal inertia feedback ?" 433 tifeedback=.false. ! default value 434 call getin("tifeedback",tifeedback) 435 write(*,*) " tifeedback = ",tifeedback 436 431 437 ! Test of incompatibility: 438 439 if (tifeedback.and..not.water) then 440 print*,'if tifeedback is used,' 441 print*,'water should be used too' 442 stop 443 endif 444 445 if (tifeedback.and..not.callsoil) then 446 print*,'if tifeedback is used,' 447 print*,'callsoil should be used too' 448 stop 449 endif 432 450 433 451 if (activice.and..not.water) then -
trunk/LMDZ.MARS/libf/phymars/physiq.F
r790 r833 202 202 REAL surfdust(ngridmx,nlayermx) ! dust surface area (m2/m3, if photochemistry) 203 203 REAL surfice(ngridmx,nlayermx) ! ice surface area (m2/m3, if photochemistry) 204 REAL inertiesoil(ngridmx,nsoilmx)! Time varying subsurface 205 ! thermal inertia (J.s-1/2.m-2.K-1) 206 ! (used only when tifeedback=.true.) 204 207 205 208 c Variables used by the slope model … … 422 425 c ~~~~~~~~~~~~~~~ 423 426 IF (callsoil) THEN 424 CALL soil(ngrid,nsoilmx,firstcall,inertiedat, 425 s ptimestep,tsurf,tsoil,capcal,fluxgrd) 427 c Thermal inertia feedback: 428 IF (tifeedback) THEN 429 CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil) 430 CALL soil(ngrid,nsoilmx,firstcall,inertiesoil, 431 s ptimestep,tsurf,tsoil,capcal,fluxgrd) 432 ELSE 433 CALL soil(ngrid,nsoilmx,firstcall,inertiedat, 434 s ptimestep,tsurf,tsoil,capcal,fluxgrd) 435 ENDIF ! of IF (tifeedback) 426 436 ELSE 427 437 PRINT*, … … 610 620 c Radiative transfer 611 621 c ------------------ 622 623 c------------------------------------------- 624 c MODIF_JBM made on 12W29D5,05:29:23 PM 625 c------------------------------------------- 626 c WRITE(*,*) "MODIF_JBM DEBUGGING 12W29D5,05:29:23 PM" 627 c WRITE(*,*) "BEFORE CALLRADITE" 628 c WRITE(*,*) ">>> rice = ",rice(11,1) 629 c------------------------------------------- 630 612 631 CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo, 613 632 $ emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout, … … 615 634 $ tauref,tau,aerosol,tauscaling,taucloudtes,rdust,rice, 616 635 $ nuice,co2ice) 636 637 c------------------------------------------- 638 c MODIF_JBM made on 12W29D5,05:29:23 PM 639 c------------------------------------------- 640 c WRITE(*,*) "MODIF_JBM DEBUGGING 12W29D5,05:29:23 PM" 641 c WRITE(*,*) "AFTER CALLRADITE" 642 c WRITE(*,*) ">>> rice = ",rice(11,1) 643 c------------------------------------------- 644 617 645 618 646 c Outputs for basic check (middle of domain) … … 1009 1037 & nq,tau,tauscaling,rdust,rice,nuice, 1010 1038 & rsedcloud,rhocloud) 1039 1040 c------------------------------------------- 1041 c MODIF_JBM made on 12W29D5,05:29:23 PM 1042 c------------------------------------------- 1043 c WRITE(*,*) "MODIF_JBM DEBUGGING 12W29D5,05:29:23 PM" 1044 c WRITE(*,*) "AFTER WATERCLOUD" 1045 c WRITE(*,*) ">>> rice = ",rice(11,1) 1046 c------------------------------------------- 1011 1047 1012 1048 c Temperature variation due to latent heat release … … 1120 1156 & pq, pdq, zdqsed, zdqssed,nq, 1121 1157 & tau,tauscaling) 1122 1158 1159 c------------------------------------------- 1160 c MODIF_JBM made on 12W29D5,05:29:23 PM 1161 c------------------------------------------- 1162 c WRITE(*,*) "MODIF_JBM DEBUGGING 12W29D5,05:29:23 PM" 1163 c WRITE(*,*) "AFTER CALLSEDIM" 1164 c WRITE(*,*) ">>> rice = ",rice(11,1) 1165 c------------------------------------------- 1123 1166 1124 1167 DO iq=1, nq … … 1292 1335 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1293 1336 IF (callsoil) THEN 1337 c Thermal inertia feedback 1338 IF (tifeedback) THEN 1339 CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil) 1340 CALL soil(ngrid,nsoilmx,.false.,inertiesoil, 1341 s ptimestep,tsurf,tsoil,capcal,fluxgrd) 1342 ELSE 1294 1343 CALL soil(ngrid,nsoilmx,.false.,inertiedat, 1295 & ptimestep,tsurf,tsoil,capcal,fluxgrd) 1344 s ptimestep,tsurf,tsoil,capcal,fluxgrd) 1345 ENDIF 1296 1346 ENDIF 1297 1347 … … 1369 1419 ENDDO 1370 1420 c ******* TEST ****************************************************** 1371 ztim1 = 999 1372 DO l=1,nlayer 1373 DO ig=1,ngrid 1374 if (pt(ig,l).lt.ztim1) then 1375 ztim1 = pt(ig,l) 1376 igmin = ig 1377 lmin = l 1378 end if 1379 ENDDO 1380 ENDDO 1381 if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then 1382 write(*,*) 'PHYSIQ: stability WARNING :' 1383 write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin), 1384 & 'ig l =', igmin, lmin 1385 end if 1421 c MODIF_JBM COMMENTED 1422 c ztim1 = 999 1423 c DO l=1,nlayer 1424 c DO ig=1,ngrid 1425 c if (pt(ig,l).lt.ztim1) then 1426 c ztim1 = pt(ig,l) 1427 c igmin = ig 1428 c lmin = l 1429 c end if 1430 c ENDDO 1431 c ENDDO 1432 c if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then 1433 c write(*,*) 'PHYSIQ: stability WARNING :' 1434 c write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin), 1435 c & 'ig l =', igmin, lmin 1436 c end if 1386 1437 c ******************************************************************* 1387 1438 … … 1532 1583 & zq(ig,l,igcm_h2o_ice) * 1533 1584 & (pplev(ig,l) - pplev(ig,l+1)) / g 1534 cccc Column integrated effective ice radius1535 cccc is weighted by total ice mass (LESS GOOD than total ice surface area)1536 c rave(ig) = rave(ig) +1537 c & zq(ig,l,igcm_h2o_ice) *1538 c & (pplev(ig,l) - pplev(ig,l+1)) / g *1539 c & rice(ig,l) * (1.+nuice_ref)1540 1585 c Computing abs optical depth at 825 cm-1 in each 1541 1586 c layer to simulate NEW TES retrieval … … 1578 1623 & /max(pi*rave(ig),1.e-30) ! surface weight 1579 1624 if (icetot(ig)*1e3.lt.0.01) rave(ig)=0. 1625 enddo 1626 else ! of if (scavenging) 1627 rave(:)=0 1628 do ig=1,ngrid 1629 do l=1,nlayermx 1630 rave(ig) = rave(ig) + 1631 & zq(ig,l,igcm_h2o_ice) * 1632 & (pplev(ig,l) - pplev(ig,l+1)) / g * 1633 & rice(ig,l) * (1.+nuice_ref) 1634 enddo 1635 rave(ig) = max(rave(ig) / 1636 & max(icetot(ig),1.e-30),1.e-30) ! mass weight 1580 1637 enddo 1581 1638 endif ! of if (scavenging) … … 1844 1901 c WRITEDIAGFI can ALSO be called from any other subroutines 1845 1902 c for any variables !! 1846 ccall WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,1847 c& emis)1848 ccall WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)1849 ccall WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev)1903 call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2, 1904 & emis) 1905 call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay) 1906 call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev) 1850 1907 call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2, 1851 1908 & tsurf) … … 1874 1931 c call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2, 1875 1932 c & zstress) 1876 ccall WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',1877 c& 'w.m-2',3,zdtsw)1878 ccall WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',1879 c& 'w.m-2',3,zdtlw)1933 call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate', 1934 & 'w.m-2',3,zdtsw) 1935 call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate', 1936 & 'w.m-2',3,zdtlw) 1880 1937 if (.not.activice) then 1881 1938 CALL WRITEDIAGFI(ngridmx,'tauTESap', … … 1978 2035 & 'surface h2o_ice', 1979 2036 & 'kg.m-2',2,qsurf(1,igcm_h2o_ice)) 1980 c CALL WRITEDIAGFI(ngridmx,'albedo', 1981 c & 'albedo', 1982 c & '',2,albedo(1:ngridmx,1)) 2037 CALL WRITEDIAGFI(ngridmx,'albedo', 2038 & 'albedo', 2039 & '',2,albedo(1:ngridmx,1)) 2040 if (tifeedback) then 2041 call WRITEDIAGSOIL(ngridmx,"soiltemp", 2042 & "Soil temperature","K", 2043 & 3,tsoil) 2044 call WRITEDIAGSOIL(ngridmx,'soilti', 2045 & 'Soil Thermal Inertia', 2046 & 'J.s-1/2.m-2.K-1',3,inertiesoil) 2047 endif 1983 2048 endif !(water) 1984 2049 … … 2231 2296 & 'm',1,rdust) 2232 2297 endif 2298 if (water.AND.tifeedback) then 2299 call WRITEDIAGFI(ngridmx,"soiltemp", 2300 & "Soil temperature","K", 2301 & 1,tsoil) 2302 call WRITEDIAGFI(ngridmx,'soilti', 2303 & 'Soil Thermal Inertia', 2304 & 'J.s-1/2.m-2.K-1',1,inertiesoil) 2305 endif 2233 2306 end if 2234 2307 -
trunk/LMDZ.MARS/libf/phymars/soil.F
r285 r833 51 51 52 52 ! 0. Initialisations and preprocessing step 53 if (firstcall ) then53 if (firstcall.or.tifeedback) then 54 54 ! note: firstcall is set to .true. or .false. by the caller 55 55 ! and not changed by soil.F … … 127 127 enddo ! of do ig=1,ngrid 128 128 129 e lse ! of if (firstcall)129 endif ! of if (firstcall.or.tifeedback) 130 130 131 131 ! 1. Compute soil temperatures 132 IF (.not.firstcall) THEN 132 133 ! First layer: 133 134 do ig=1,ngrid … … 144 145 enddo 145 146 146 endif! of if (firstcall)147 ENDIF! of if (.not.firstcall) 147 148 148 149 ! 2. Compute beta coefficients (preprocessing for next time step)
Note: See TracChangeset
for help on using the changeset viewer.
