Changeset 526 for trunk/LMDZ.GENERIC/libf
- Timestamp:
- Feb 13, 2012, 6:30:26 PM (13 years ago)
- Location:
- trunk/LMDZ.GENERIC/libf/phystd
- Files:
-
- 17 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/libf/phystd/aeropacity.F90
r486 r526 235 235 ( 0.75 * QREFvis3d(ig,l,iaer) / & 236 236 ( rho_ice * reffrad(ig,l,iaer) ) ) * & 237 ( pq(ig,l,i_h2oice) + 1.E-9 ) * &238 ( pplev(ig,l) - pplev(ig,l+1) ) / g / & 239 CLF1 237 pq(ig,l,i_h2oice) * & !JL I dropped the +1e-9 here to have the same 238 ( pplev(ig,l) - pplev(ig,l+1) ) / g / & ! opacity in the clearsky=true and the 239 CLF1 ! clear=false/pq=0 case 240 240 241 241 aerosol(ig,l,iaer) = -log(1 - CLF2 + CLF2*exp(-aerosol0)) -
trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90
r486 r526 1 subroutine callcorrk(ngrid,nlayer,pq,nq,qsurf, &1 subroutine callcorrk(ngrid,nlayer,pq,nq,qsurf, & 2 2 albedo,emis,mu0,pplev,pplay,pt, & 3 3 tsurf,fract,dist_star,aerosol,cpp3D,muvar, & 4 4 dtlw,dtsw,fluxsurf_lw, & 5 5 fluxsurf_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn, & 6 reffrad,tau_col,cloudfrac,totcloudfrac, & 6 OLR_nu,OSR_nu, & 7 reffrad,tau_col,cloudfrac,totcloudfrac, & 7 8 clearsky,firstcall,lastcall) 8 9 … … 83 84 REAL fluxabs_sw(ngridmx) ! SW flux absorbed by planet (W/m2) 84 85 REAL fluxtop_dn(ngridmx) ! incident top of atmosphere SW flux (W/m2) 85 86 REAL OLR_nu(ngrid,L_NSPECTI)! Outgoing LW radition in each band (Normalized to the band width (W/m2/cm-1) 87 REAL OSR_nu(ngrid,L_NSPECTV)! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1) 86 88 !----------------------------------------------------------------------- 87 89 ! Declaration of the variables required by correlated-k subroutines … … 154 156 ! real(KIND=r8) :: pq_temp(nlayer) ! better F90 way.. DOESNT PORT TO F77!!! 155 157 156 ! for OLR spec157 integer OLRcount158 save OLRcount159 integer OLRcount2160 save OLRcount2161 character(len=2) :: tempOLR162 character(len=30) :: filenomOLR163 158 !real ptime, pday 164 159 logical OLRz 165 real OLR_nu(ngrid,L_NSPECTI)166 !real GSR_nu(ngrid,L_NSPECTV)167 real OSR_nu(ngrid,L_NSPECTV)168 160 real*8 NFLUXGNDV_nu(L_NSPECTV) 169 161 … … 272 264 stop 273 265 endif 266 267 OLR_nu=0. 268 OSR_nu=0. 274 269 275 270 firstcall=.false. … … 331 326 332 327 do ig=1,ngrid 333 if(tracer )then328 if(tracer.and.igcm_co2_ice.gt.0)then 334 329 reffrad(ig,l,1) = CBRT( 3*pq(ig,l,igcm_co2_ice)/ & 335 330 (4*Nmix_co2*pi*rho_co2) ) … … 561 556 end do 562 557 qvar(1)=qvar(2) 563 qvar(2*nlayermx+1)=qsurf(ig,i_var) 558 ! qvar(2*nlayermx+1)=qsurf(ig,i_var) !JL12 not very good to compare kg/kg and kg/m2??? 564 559 565 560 elseif(varfixed)then … … 590 585 Ttemp = tsurf(ig) 591 586 call watersat(Ttemp,ptemp,qsat) 587 592 588 593 589 !qvar(2*nlayermx+1)=qsat ! fully saturated everywhere 594 590 qvar(2*nlayermx+1)= RH * qsat ! ~realistic profile (e.g. 80% saturation at ground) 591 592 593 !!!!!!!!!!!!!!!!!!!!!!!! JL: for completely constant water profile uncoment the following line 594 ! qvar=0.005 595 595 596 596 else … … 766 766 qxiaer,qsiaer,giaer,cosbi,wbari,tauaero,tmid,pmid, & 767 767 taugsurfi,qvar,muvarrad) 768 768 769 769 call sfluxi(plevrad,tlevrad,dtaui,taucumi,ubari,albi, & 770 770 wnoi,dwni,cosbi,wbari,gweight,nfluxtopi,nfluxtopi_nu, & … … 797 797 if(specOLR)then 798 798 do nw=1,L_NSPECTI 799 OLR_nu(ig,nw)=nfluxtopi_nu(nw) 799 OLR_nu(ig,nw)=nfluxtopi_nu(nw)/DWNI(nw) !JL Normalize to the bandwidth 800 800 end do 801 801 do nw=1,L_NSPECTV 802 802 !GSR_nu(ig,nw)=nfluxgndv_nu(nw) 803 OSR_nu(ig,nw)=nfluxoutv_nu(nw) 803 OSR_nu(ig,nw)=nfluxoutv_nu(nw)/DWNV(nw) !JL Normalize to the bandwidth 804 804 end do 805 805 endif … … 848 848 849 849 ! IR spectral output, for exoplanet observational comparison 850 if(specOLR)then 851 if(ngrid.ne.1)then 852 call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W m^-2",3,OLR_nu) 853 call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W m^-2",3,OSR_nu) 854 endif 855 endif 856 857 if(lastcall.and.(ngrid.eq.1))then 850 851 852 if(lastcall.and.(ngrid.eq.1))then ! could disable the 1D output, they are in the diagfi and diagspec... JL12 858 853 859 854 print*,'Saving scalar quantities in surf_vals.out...' … … 864 859 close(116) 865 860 866 if(specOLR)then867 open(117,file='OLRnu.out')868 do nw=1,L_NSPECTI869 write(117,*) OLR_nu(1,nw)870 enddo871 close(117)872 873 open(127,file='OSRnu.out')874 do nw=1,L_NSPECTV875 write(127,*) OSR_nu(1,nw)876 enddo877 close(127)878 endif861 ! if(specOLR)then 862 ! open(117,file='OLRnu.out') 863 ! do nw=1,L_NSPECTI 864 ! write(117,*) OLR_nu(1,nw) 865 ! enddo 866 ! close(117) 867 ! 868 ! open(127,file='OSRnu.out') 869 ! do nw=1,L_NSPECTV 870 ! write(127,*) OSR_nu(1,nw) 871 ! enddo 872 ! close(127) 873 ! endif 879 874 880 875 ! OLR vs altitude: do it as a .txt file -
trunk/LMDZ.GENERIC/libf/phystd/callkeys.h
r486 r526 9 9 & , enertest & 10 10 & , callgasvis & 11 & , Continuum & 11 12 & , Nmix_co2, Nmix_h2o & 12 13 & , dusttau & … … 52 53 & , season,diurnal,tlocked,lwrite & 53 54 & , callstats,calleofdump & 54 & , callgasvis 55 & , callgasvis,Continuum 55 56 56 57 logical enertest -
trunk/LMDZ.GENERIC/libf/phystd/condense_cloud.F90
r486 r526 46 46 ! Francois Forget (1996) 47 47 ! Converted to Fortran 90 and slightly modified by R. Wordsworth (2009) 48 ! Includes simplifed nucleation by J. Leconte (2011) 48 49 ! 49 50 !================================================================== … … 96 97 REAL zcpi 97 98 REAL ztcond (ngridmx,nlayermx) 99 REAL ztnuc (ngridmx,nlayermx) 98 100 REAL ztcondsol(ngridmx) 99 101 REAL zdiceco2(ngridmx) … … 271 273 ! end if 272 274 273 ! Forecast the atmospheric frost temperature 'ztcond' 275 ! Forecast the atmospheric frost temperature 'ztcond' and nucleation temperature 'ztnuc' 274 276 DO l=1,nlayer 275 277 DO ig=1,ngrid 276 278 ppco2=gfrac(igasco2)*pplay(ig,l) 277 279 call get_tcond_co2(ppco2,ztcond(ig,l)) 280 call get_tnuc_co2(ppco2,ztnuc(ig,l)) 278 281 ENDDO 279 282 ENDDO … … 379 382 380 383 381 IF ((zt(ig,l).LT.ztcond(ig,l)).or.(zq(ig,l,i_co2ice).gt.0)) THEN 384 ! ztcond-> ztnuc in test beneath to nucleate only when super saturation occurs(JL 2011) 385 IF ((zt(ig,l).LT.ztnuc(ig,l)).or.(zq(ig,l,i_co2ice).gt.1.E-10)) THEN 382 386 condsub(ig)=.true. 383 387 pdtc(ig,l) = (ztcond(ig,l) - zt(ig,l))/subptimestep … … 524 528 real, parameter :: ptriple=518000.0 525 529 526 peff=p !/co2supsat530 peff=p 527 531 528 532 if(peff.lt.ptriple)then … … 535 539 536 540 end subroutine get_tcond_co2 541 542 543 544 545 !------------------------------------------------------------------------- 546 subroutine get_tnuc_co2(p,tnuc) 547 ! Calculates the nucleation temperature for CO2, based on a simple super saturation criterion 548 ! (JL 2011) 549 550 implicit none 551 552 #include "callkeys.h" 553 554 real p, peff, tnuc 555 real, parameter :: ptriple=518000.0 556 557 peff=p/co2supsat 558 559 if(peff.lt.ptriple)then 560 tnuc = (-3167.8)/(log(.01*peff)-23.23) ! Fanale's formula 561 else 562 tnuc = 684.2-92.3*log(peff)+4.32*log(peff)**2 563 ! liquid-vapour transition (based on CRC handbook 2003 data) 564 endif 565 return 566 567 end subroutine get_tnuc_co2 -
trunk/LMDZ.GENERIC/libf/phystd/inifis.F
r486 r526 192 192 call getin("callgasvis",callgasvis) 193 193 write(*,*) " callgasvis = ",callgasvis 194 195 write(*,*) "call continuum opacities in radiative transfer ?", 196 & "(matters only if callrad=T)" 197 Continuum=.false. ! default value 198 call getin("Continuum",Continuum) 199 write(*,*) " Continuum = ",Continuum 194 200 195 201 write(*,*) "call turbulent vertical diffusion ?" -
trunk/LMDZ.GENERIC/libf/phystd/iniwrite_specIR.F
r305 r526 2 2 3 3 use radinc_h, only: L_NSPECTI 4 use radcommon_h, only: W AVEI4 use radcommon_h, only: WNOI 5 5 6 6 implicit none … … 54 54 integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm 55 55 ! integer :: idim_nsoilmx ! "subsurface_layers" dimension ID # 56 integer :: idim_bandsIR ! " bandsIR" dimension ID #56 integer :: idim_bandsIR ! "IR Wavenumber" dimension ID # 57 57 integer, dimension(2) :: id 58 58 … … 114 114 ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm) 115 115 ! ierr = NF_DEF_DIM (nid, "subsurface_layers",nsoilmx,idim_nsoilmx) 116 ierr = NF_DEF_DIM (nid, " bandsIR",L_NSPECTI,idim_bandsIR)116 ierr = NF_DEF_DIM (nid, "IR Wavenumber",L_NSPECTI,idim_bandsIR) 117 117 118 118 ierr = NF_ENDDEF(nid) … … 290 290 ! define variable 291 291 #ifdef NC_DOUBLE 292 ierr=NF_DEF_VAR(nid,"bandsIR",NF_DOUBLE,1,idim_bandsIR,nvarid) 293 #else 294 ierr=NF_DEF_VAR(nid,"bandsIR",NF_FLOAT,1,idim_bandsIR,nvarid) 295 #endif 296 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 27, 297 . "Band limits in the infrared") 298 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"cm^-1") 292 ierr=NF_DEF_VAR(nid,"IR Wavenumber",NF_DOUBLE,1, 293 . idim_bandsIR,nvarid) 294 #else 295 ierr=NF_DEF_VAR(nid,"IR Wavenumber",NF_FLOAT,1, 296 . idim_bandsIR,nvarid) 297 #endif 298 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 34, 299 . "Band mid frequency in the infrared") 300 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1") 299 301 ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode 300 302 ! write variable 301 303 #ifdef NC_DOUBLE 302 ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(W AVEI))303 #else 304 ierr=NF_PUT_VAR_REAL (nid,nvarid,real(W AVEI))304 ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(WNOI)) 305 #else 306 ierr=NF_PUT_VAR_REAL (nid,nvarid,real(WNOI)) 305 307 #endif 306 308 -
trunk/LMDZ.GENERIC/libf/phystd/iniwrite_specVI.F
r305 r526 2 2 3 3 use radinc_h, only: L_NSPECTV 4 use radcommon_h, only: W AVEV4 use radcommon_h, only: WNOV 5 5 6 6 implicit none … … 54 54 integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm 55 55 ! integer :: idim_nsoilmx ! "subsurface_layers" dimension ID # 56 integer :: idim_bandsVI ! " bandsIR" dimension ID #56 integer :: idim_bandsVI ! "VI Wavenumber" dimension ID # 57 57 integer, dimension(2) :: id 58 58 … … 114 114 ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm) 115 115 ! ierr = NF_DEF_DIM (nid, "subsurface_layers",nsoilmx,idim_nsoilmx) 116 ierr = NF_DEF_DIM (nid, " bandsVI",L_NSPECTV,idim_bandsVI)116 ierr = NF_DEF_DIM (nid, "VI Wavenumber",L_NSPECTV,idim_bandsVI) 117 117 118 118 ierr = NF_ENDDEF(nid) … … 290 290 ! define variable 291 291 #ifdef NC_DOUBLE 292 ierr=NF_DEF_VAR(nid,"bandsVI",NF_DOUBLE,1,idim_bandsVI,nvarid) 293 #else 294 ierr=NF_DEF_VAR(nid,"bandsVI",NF_FLOAT,1,idim_bandsVI,nvarid) 295 #endif 296 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 27, 297 . "Band limits in the visible") 298 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"cm^-1") 292 ierr=NF_DEF_VAR(nid,"VI Wavenumber",NF_DOUBLE,1, 293 . idim_bandsVI,nvarid) 294 #else 295 ierr=NF_DEF_VAR(nid,"VI Wavenumber",NF_FLOAT,1, 296 . idim_bandsVI,nvarid) 297 #endif 298 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 33, 299 . "Band mid frequency in the visible") 300 ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1") 299 301 ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode 300 302 ! write variable 301 303 #ifdef NC_DOUBLE 302 ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(W AVEV))303 #else 304 ierr=NF_PUT_VAR_REAL (nid,nvarid,real(W AVEV))304 ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(WNOV)) 305 #else 306 ierr=NF_PUT_VAR_REAL (nid,nvarid,real(WNOV)) 305 307 #endif 306 308 -
trunk/LMDZ.GENERIC/libf/phystd/interpolateH2Ocont.F90
r374 r526 150 150 151 151 else 152 152 153 153 call bilinearH2Ocont(wn_arr,temp_arr,abs_arrS,wn,temp,abcoefS) 154 154 call bilinearH2Ocont(wn_arr,temp_arr,abs_arrF,wn,temp,abcoefF) … … 162 162 abcoef = abcoef*Nmolec/(100.0**2) ! convert to m^-1 163 163 abcoef = abcoef*(presS/(presF+presS)) ! take H2O mixing ratio into account 164 164 165 165 166 ! unlike for Rayleigh scattering, we do not currently weight by the BB function -
trunk/LMDZ.GENERIC/libf/phystd/optci.F90
r471 r526 163 163 164 164 DCONT = DCONT*dz(k) 165 166 if(.not.Continuum)then 167 DCONT=0.0 168 endif 165 169 166 170 !--- Kasting's CIA ---------------------------------------- … … 217 221 TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT 218 222 !TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS 219 220 223 DTAUKI(K,nw,ng) = TAUGAS + DCONT ! For parameterized continuum absorption 221 224 -
trunk/LMDZ.GENERIC/libf/phystd/optcv.F90
r471 r526 157 157 DCONT = DCONT*dz(k) 158 158 159 if( (.not.callgasvis))then159 if(.not.(callgasvis.and.Continuum))then 160 160 DCONT=0.0 161 161 endif 162 163 162 164 163 do NG=1,L_NGAUSS-1 -
trunk/LMDZ.GENERIC/libf/phystd/physiq.F90
r486 r526 7 7 pdu,pdv,pdt,pdq,pdpsrf,tracerdyn) 8 8 9 use radinc_h, only : naerkind 9 use radinc_h, only : naerkind,L_NSPECTI,L_NSPECTV 10 10 use watercommon_h, only : mx_eau_sol, To, RLVTT, mH2O 11 11 use gases_h … … 116 116 #include "comsaison.h" 117 117 #include "control.h" 118 #include "comg1d.h"119 118 #include "tracer.h" 120 119 #include "watercap.h" … … 190 189 191 190 character*80 fichier 192 integer l,ig,ierr,iq,i, tapphys 191 integer l,ig,ierr,iq,i, tapphys,nw 193 192 194 193 real fluxsurf_lw(ngridmx) ! incident LW (IR) surface flux (W.m-2) … … 199 198 real fluxtop_dn(ngridmx) 200 199 real fluxdyn(ngridmx) ! horizontal heat transport by dynamics 201 save fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn 200 real OLR_nu(ngridmx,L_NSPECTI)! Outgoing LW radition in each band (Normalized to the band width (W/m2/cm-1) 201 real OSR_nu(ngridmx,L_NSPECTV)! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1) 202 save fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu 202 203 203 204 … … 326 327 real zpopskNI(ngridmx,nlayermx) 327 328 328 ! included by RW to make 1D saves not every timestep329 integer countG1D330 save countG1D331 329 332 330 ! included by BC for evaporation … … 357 355 ! included by BC for double radiative transfer call 358 356 logical clearsky 359 360 real zdtsw1(ngridmx,nlayermx),zdtsw2(ngridmx,nlayermx) 361 real zdtlw1(ngridmx,nlayermx),zdtlw2(ngridmx,nlayermx) 362 real fluxsurf_lw1(ngridmx), fluxsurf_lw2(ngridmx) 363 real fluxsurf_sw1(ngridmx), fluxsurf_sw2(ngridmx) 364 real fluxtop_lw1(ngridmx), fluxtop_lw2(ngridmx) 365 real fluxabs_sw1(ngridmx), fluxabs_sw2(ngridmx) 366 real tau_col1(ngrid), tau_col2(ngrid) 357 real zdtsw1(ngridmx,nlayermx) 358 real zdtlw1(ngridmx,nlayermx) 359 real fluxsurf_lw1(ngridmx) 360 real fluxsurf_sw1(ngridmx) 361 real fluxtop_lw1(ngridmx) 362 real fluxabs_sw1(ngridmx) 363 real tau_col1(ngrid) 364 real OLR_nu1(ngrid,L_NSPECTI) 365 real OSR_nu1(ngrid,L_NSPECTV) 367 366 real tf, ntf 368 367 … … 423 422 if (firstcall) then 424 423 425 if(ngrid.eq.1)then426 saveG1D=day_step*10427 !saveG1D=1428 !saveG1D=-1 ! to never save429 countG1D=1430 endif431 424 432 425 ! variables set to 0 … … 447 440 ! read startfi (initial parameters) 448 441 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 449 442 print*,'in physiqu i am in phyetat0' 450 443 call phyetat0("startfi.nc",0,0,nsoilmx,nq, & 451 444 day_ini,time_phys,tsurf,tsoil,emis,q2,qsurf, & … … 681 674 682 675 if (callrad) then 683 if( mod(icount-1,iradia).eq.0 ) then676 if( mod(icount-1,iradia).eq.0.or.lastcall) then 684 677 685 678 ! Compute local stellar zenith angles … … 720 713 endif 721 714 muvar(:,:)=0.0 ! only used for climate evolution for now 722 723 ! Option to call scheme once for clear regions, once for cloudy regions (BC) 715 716 717 ! standard callcorrk 718 clearsky=.false. 719 call callcorrk(ngrid,nlayer,pq,nq,qsurf, & 720 albedo,emis,mu0,pplev,pplay,pt, & 721 tsurf,fract,dist_star,aerosol,cpp3D,muvar, & 722 zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw, & 723 fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu, & 724 reffrad,tau_col,cloudfrac,totcloudfrac, & 725 clearsky,firstcall,lastcall) 726 727 728 ! Option to call scheme once more for clear regions 724 729 if(CLFvarying)then 725 730 726 !!! THIS IS NOT A VERY GOOD STRATEGY HERE (everything should be in callcorrk) 727 !!! ---> PROBLEMS WITH ALLOCATED ARRAYS 728 !!! (temporary solution in callcorrk: do not deallocate if CLFvarying ...) 729 731 !!! ---> PROBLEMS WITH ALLOCATED ARRAYS 732 !!! (temporary solution in callcorrk: do not deallocate if CLFvarying ...) 730 733 clearsky=.true. 731 734 call callcorrk(ngrid,nlayer,pq,nq,qsurf, & … … 733 736 tsurf,fract,dist_star,aerosol,cpp3D,muvar, & 734 737 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,fluxtop_lw1, & 735 fluxabs_sw1,fluxtop_dn,reffrad,tau_col1, & 736 cloudfrac,totcloudfrac,clearsky,firstcall,lastcall) 737 738 clearsky=.false. 739 call callcorrk(ngrid,nlayer,pq,nq,qsurf, & 740 albedo,emis,mu0,pplev,pplay,pt, & 741 tsurf,fract,dist_star,aerosol,cpp3D,muvar, & 742 zdtlw2,zdtsw2,fluxsurf_lw2,fluxsurf_sw2,fluxtop_lw2, & 743 fluxabs_sw2,fluxtop_dn,reffrad,tau_col2, & 744 cloudfrac,totcloudfrac,clearsky,firstcall,lastcall) 738 fluxabs_sw1,fluxtop_dn,OLR_nu1,OSR_nu1, & 739 reffrad,tau_col1,cloudfrac,totcloudfrac, & 740 clearsky,firstcall,lastcall) 741 clearsky = .false. !! just in case. 745 742 746 743 ! Sum the fluxes and heating rates from cloudy/clear cases … … 749 746 ntf=1.-tf 750 747 751 fluxsurf_lw(ig) = ntf*fluxsurf_lw1(ig) + tf*fluxsurf_lw 2(ig)752 fluxsurf_sw(ig) = ntf*fluxsurf_sw1(ig) + tf*fluxsurf_sw 2(ig)753 fluxtop_lw(ig) = ntf*fluxtop_lw1(ig) + tf*fluxtop_lw 2(ig)754 fluxabs_sw(ig) = ntf*fluxabs_sw1(ig) + tf*fluxabs_sw 2(ig)755 tau_col(ig) = ntf*tau_col1(ig) + tf*tau_col 2(ig)748 fluxsurf_lw(ig) = ntf*fluxsurf_lw1(ig) + tf*fluxsurf_lw(ig) 749 fluxsurf_sw(ig) = ntf*fluxsurf_sw1(ig) + tf*fluxsurf_sw(ig) 750 fluxtop_lw(ig) = ntf*fluxtop_lw1(ig) + tf*fluxtop_lw(ig) 751 fluxabs_sw(ig) = ntf*fluxabs_sw1(ig) + tf*fluxabs_sw(ig) 752 tau_col(ig) = ntf*tau_col1(ig) + tf*tau_col(ig) 756 753 757 754 do l=1,nlayer 758 zdtlw(ig,l) = ntf*zdtlw1(ig,l) + tf*zdtlw 2(ig,l)759 zdtsw(ig,l) = ntf*zdtsw1(ig,l) + tf*zdtsw 2(ig,l)755 zdtlw(ig,l) = ntf*zdtlw1(ig,l) + tf*zdtlw(ig,l) 756 zdtsw(ig,l) = ntf*zdtsw1(ig,l) + tf*zdtsw(ig,l) 760 757 enddo 758 759 do nw=1,L_NSPECTV 760 OSR_nu(ig,nw) = ntf*OSR_nu1(ig,nw) + tf*OSR_nu(ig,nw) 761 enddo 762 do nw=1,L_NSPECTI 763 OLR_nu(ig,nw) = ntf*OLR_nu1(ig,nw) + tf*OLR_nu(ig,nw) 764 enddo 765 761 766 enddo 762 767 763 ! Otherwise standard callcorrk 764 else 765 766 clearsky=.false. 767 call callcorrk(ngrid,nlayer,pq,nq,qsurf, & 768 albedo,emis,mu0,pplev,pplay,pt, & 769 tsurf,fract,dist_star,aerosol,cpp3D,muvar, & 770 zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw, & 771 fluxabs_sw,fluxtop_dn,reffrad,tau_col, & 772 cloudfrac,totcloudfrac,clearsky,firstcall,lastcall) 773 774 endif 768 endif !CLFvarying 775 769 776 770 ! Radiative flux from the sky absorbed by the surface (W.m-2) … … 872 866 print*,'In corrk SW atmospheric energy change =',dEtotSW,' W m-2' 873 867 print*,'In corrk LW atmospheric energy change =',dEtotLW,' W m-2' 868 print*,'atmospheric energy change (SW+LW) =',dEtotLW+dEtotSW,' W m-2' 874 869 print*,'In corrk SW surface energy change =',dEtotsSW,' W m-2' 875 870 print*,'In corrk LW surface energy change =',dEtotsLW,' W m-2' 871 print*,'surface energy change (SW+LW) =',dEtotsLW+dEtotsSW,' W m-2' 876 872 endif 877 873 !------------------------- … … 884 880 885 881 if (calldifv) then 886 882 887 883 do ig=1,ngrid 888 884 zflubid(ig)=fluxrad(ig)+fluxgrd(ig) … … 1743 1739 OLR = OLR + area(ig)*fluxtop_lw(ig) 1744 1740 GND = GND + area(ig)*fluxgrd(ig) 1741 if(.not.callsoil) GND=GND+ area(ig)*fluxrad(ig) 1745 1742 DYN = DYN + area(ig)*fluxdyn(ig) 1746 1743 … … 1765 1762 if(enertest)then 1766 1763 print*,'SW energy balance SW++ - ASR = ',dEtotSW+dEtotsSW-ASR/totarea,' W m-2' 1764 print*,'LW energy balance LW++ + ***ASR*** = ',dEtotLW+dEtotsLW+ASR/totarea,' W m-2' 1767 1765 endif 1768 1766 1769 1767 if(meanOLR)then 1770 if((ngridmx.gt.1) .or. ( countG1D.eq.saveG1D))then1768 if((ngridmx.gt.1) .or. (mod(icount-1,nint(ecritphy)).eq.0))then 1771 1769 ! to record global radiative balance 1772 1770 open(92,file="rad_bal.out",form='formatted',access='append') … … 1857 1855 1858 1856 if(meanOLR)then 1859 if((ngridmx.gt.1) .or. ( countG1D.eq.saveG1D))then1857 if((ngridmx.gt.1) .or. (mod(icount-1,nint(ecritphy)).eq.0))then 1860 1858 ! to record global water balance 1861 1859 open(98,file="h2o_bal.out",form='formatted',access='append') … … 1891 1889 1892 1890 1893 if (ngrid.ne.1) then1894 1891 print*,'' 1895 1892 print*,'--> Ls =',zls*180./pi … … 1977 1974 ! "Solar radiative flux to space","W.m-2",2, & 1978 1975 ! fluxtop_sw_tot) 1976 1977 call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn) 1978 call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw) 1979 call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) 1980 1979 1981 call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt) 1980 1982 call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu) … … 1984 1986 1985 1987 if (tracer) then 1988 do iq=1,nq 1989 call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) 1990 call wstats(ngridmx,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 1991 'kg m^-2',2,qsurf(1,iq) ) 1992 1993 call wstats(ngridmx,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 1994 'kg m^-2',2,qcol(1,iq) ) 1995 call wstats(ngridmx,trim(noms(iq))//'_reff', & 1996 trim(noms(iq))//'_reff', & 1997 'm',3,reffrad(1,1,iq)) 1998 end do 1986 1999 if (water) then 1987 2000 vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap) … … 2041 2054 2042 2055 ! Output aerosols 2043 call writediagfi(ngridmx,'CO2ice_reff','CO2ice_reff','m',3,reffrad(1,1,1))2044 call writediagfi(ngridmx,'H2Oice_reff','H2Oice_reff','m',3,reffrad(1,1,2))2045 call writediagfi(ngridmx,'CO2ice_reffcol','CO2ice_reffcol','um kg m^-2',2,reffcol(1,1))2046 call writediagfi(ngridmx,'H2Oice_reffcol','H2Oice_reffcol','um kg m^-2',2,reffcol(1,2))2056 if (igcm_co2_ice.ne.0) call writediagfi(ngridmx,'CO2ice_reff','CO2ice_reff','m',3,reffrad(1,1,1)) 2057 if (igcm_h2o_ice.ne.0) call writediagfi(ngridmx,'H2Oice_reff','H2Oice_reff','m',3,reffrad(1,1,2)) 2058 if (igcm_co2_ice.ne.0) call writediagfi(ngridmx,'CO2ice_reffcol','CO2ice_reffcol','um kg m^-2',2,reffcol(1,1)) 2059 if (igcm_h2o_ice.ne.0) call writediagfi(ngridmx,'H2Oice_reffcol','H2Oice_reffcol','um kg m^-2',2,reffcol(1,2)) 2047 2060 2048 2061 ! Output tracers … … 2093 2106 endif 2094 2107 2095 ! ---------------------------------------------------------- 2096 ! Output in netcdf file "diagsoil.nc" for subterranean 2097 ! variables (output every "ecritphy", as for writediagfi) 2098 ! ---------------------------------------------------------- 2099 2100 ! Write soil temperature 2101 !call writediagsoil(ngrid,"soiltemp","Soil temperature","K",3,tsoil) 2102 2103 else ! if(ngrid.eq.1) 2104 2105 ! ---------------------------------------------------------------------- 2106 ! Output in grads file "g1d" (ONLY when using testphys1d) 2107 ! ---------------------------------------------------------------------- 2108 2109 if(countG1D.eq.saveG1D)then 2110 2111 call writeg1d(ngrid,1,tsurf,'tsurf','K') 2112 call writeg1d(ngrid,1,ps,'ps','Pa') 2113 call writeg1d(ngrid,nlayer,zt,'T','K') 2114 call writeg1d(ngrid,nlayer,pq(1,1,1),'q','kg/kg') 2115 call writeg1d(ngrid,nlayer,aerosol,'aerosol','SI') 2116 call writeg1d(ngrid,nlayer,reffrad,'reffrad','SI') 2117 call writeg1d(ngrid,nlayer,zdtlw,'dtlw','SI') 2118 call writeg1d(ngrid,nlayer,zdtsw,'dtsw','SI') 2119 call writeg1d(ngrid,nlayer,zdtdyn,'dtdyn','SI') 2120 2121 ! radiation balance 2122 call writeg1d(ngrid,1,ISR/totarea,'ISR','W m-2') 2123 call writeg1d(ngrid,1,ASR/totarea,'ASR','W m-2') 2124 call writeg1d(ngrid,1,OLR/totarea,'OLR','W m-2') 2125 2126 if(tracer) then 2127 do iq=1,nq 2128 call writeg1d(ngrid,1,qsurf(1,iq),trim(noms(iq))//'_s','kg m^-2') 2129 call writeg1d(ngrid,1,qcol(1,iq),trim(noms(iq))//'_c','kg m^-2') 2130 call writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 2131 end do 2132 2133 if(waterrain)then 2134 CALL writeg1d(ngrid,1,zdqsrain,'rainfall','kg m-2 s-1') 2135 CALL writeg1d(ngrid,1,zdqssnow,'snowfall','kg m-2 s-1') 2136 endif 2137 2138 end if 2139 2140 countG1D=1 2141 else 2142 countG1D=countG1D+1 2143 endif ! if time to save 2144 2145 endif ! if(ngrid.ne.1) 2108 ! output spectrum 2109 if(specOLR.and.corrk)then 2110 call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W/m^2/cm^-1",3,OLR_nu) 2111 call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W/m^2/cm^-1",3,OSR_nu) 2112 endif 2113 2146 2114 2147 2115 icount=icount+1 -
trunk/LMDZ.GENERIC/libf/phystd/rain.F90
r253 r526 62 62 63 63 logical simple ! Use very simple Emanuel scheme? 64 parameter(simple=. true.)64 parameter(simple=.false.) 65 65 66 66 logical evap_prec ! Does the rain evaporate? -
trunk/LMDZ.GENERIC/libf/phystd/rcm1d.F
r486 r526 41 41 #include "comvert.h" 42 42 #include "netcdf.inc" 43 #include "comg1d.h"44 43 #include "watercap.h" 45 44 #include "fisice.h" … … 117 116 c======================================================================= 118 117 119 saveprofile=. true.118 saveprofile=.false. 120 119 121 120 c ------------------------------------------------------ … … 274 273 write(*,*)" time = ",time 275 274 time=time/24.E+0 ! convert time (hours) to fraction of sol 275 276 ecritphy=day_step ! default value for ecritphy 277 PRINT *,'Nunber of steps between writediagfi ?' 278 call getin("ecritphy",ecritphy) 279 write(*,*) " ecritphy = ",ecritphy 280 276 281 277 282 c Discretisation (Definition de la grille et des pas de temps) … … 294 299 ndt=ndt*day_step 295 300 dtphys=daysec/day_step 301 302 303 c output spectrum? 304 write(*,*)"Output spectral OLR?" 305 specOLR=.false. 306 call getin("specOLR",specOLR) 307 write(*,*)" specOLR = ",specOLR 296 308 297 309 … … 304 316 write(*,*) " psurf = ",psurf 305 317 c Pression de reference 306 pa= 20.307 preff= 610. ! these values are not needed in 1D318 pa=psurf/30. 319 preff=psurf ! these values are not needed in 1D (are you sure JL12) 308 320 309 321 c Gravity of planet … … 577 589 enddo 578 590 579 c Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"580 c ----------------------------------------------------------------581 c (effectuee avec "writeg1d" a partir de "physiq.F"582 c ou tout autre subroutine physique, y compris celle ci).583 584 g1d_nlayer=nlayer585 g1d_nomfich='g1d.dat'586 g1d_unitfich=40587 g1d_nomctl='g1d.ctl'588 g1d_unitctl=41589 g1d_premier=.true.590 g2d_premier=.true.591 591 592 592 c Ecriture de "startfi" … … 613 613 lastcall=.true. 614 614 call stellarlong(day*1.0,zls) 615 write(103,*) 'Ls=',zls*180./pi616 write(103,*) 'Lat=', lati(1)*180./pi617 write(103,*) 'Tau=', tauvis/700*psurf618 write(103,*) 'RunEnd - Atmos. Temp. File'619 write(103,*) 'RunEnd - Atmos. Temp. File'620 write(104,*) 'Ls=',zls*180./pi621 write(104,*) 'Lat=', lati(1)622 write(104,*) 'Tau=', tauvis/700*psurf623 write(104,*) 'RunEnd - Atmos. Temp. File'615 ! write(103,*) 'Ls=',zls*180./pi 616 ! write(103,*) 'Lat=', lati(1)*180./pi 617 ! write(103,*) 'Tau=', tauvis/700*psurf 618 ! write(103,*) 'RunEnd - Atmos. Temp. File' 619 ! write(103,*) 'RunEnd - Atmos. Temp. File' 620 ! write(104,*) 'Ls=',zls*180./pi 621 ! write(104,*) 'Lat=', lati(1) 622 ! write(104,*) 'Tau=', tauvis/700*psurf 623 ! write(104,*) 'RunEnd - Atmos. Temp. File' 624 624 ENDIF 625 625 … … 748 748 c ======================================================== 749 749 750 c fermeture pour conclure les sorties format grads dans "g1d.dat"751 c et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"752 c ou tout autre subroutine physique, y compris celle ci).753 754 750 ! save temperature profile 755 751 if(saveprofile)then … … 761 757 endif 762 758 763 logplevs(1)=log(plev(1)/100000.0)764 do ilayer=2,nlayer765 logplevs(ilayer)=log(play(ilayer)/100000.0)766 enddo767 CALL endg1d(1,nlayer,logplevs,ndt) ! now simply log(p) with p in bars768 759 769 760 c ======================================================== -
trunk/LMDZ.GENERIC/libf/phystd/sfluxi.F
r486 r526 64 64 C TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL 65 65 66 TTOP = TLEV(2) 66 TTOP = TLEV(2) ! JL12 why not (1) ??? 67 67 TSURF = TLEV(L_LEVELS) 68 68 -
trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F
r323 r526 196 196 ! are undefined; so set them to 1 197 197 iphysiq=1 198 irythme=1198 !JL11 irythme=1 199 199 ! NB: 200 200 endif -
trunk/LMDZ.GENERIC/libf/phystd/writediagspecIR.F
r305 r526 112 112 ! The following test is here to enforce that writediagfi is not used with the 113 113 ! 1D version of the GCM 114 if (ngrid.eq.1) return 114 !not anymore (JL12) 115 if (ngrid.eq.-1) return 115 116 116 117 c nom=trim((nom)) … … 238 239 ierr= NF_INQ_DIMID(nid,"longitude",id(1)) 239 240 ierr= NF_INQ_DIMID(nid,"latitude",id(2)) 240 ierr= NF_INQ_DIMID(nid," bandsIR",id(3))241 ierr= NF_INQ_DIMID(nid,"IR Wavenumber",id(3)) 241 242 ierr= NF_INQ_DIMID(nid,"Time",id(4)) 242 243 -
trunk/LMDZ.GENERIC/libf/phystd/writediagspecVI.F
r305 r526 112 112 ! The following test is here to enforce that writediagfi is not used with the 113 113 ! 1D version of the GCM 114 if (ngrid.eq.1) return 114 !not anymore (JL12) 115 if (ngrid.eq.-1) return 115 116 116 117 c nom=trim((nom)) … … 238 239 ierr= NF_INQ_DIMID(nid,"longitude",id(1)) 239 240 ierr= NF_INQ_DIMID(nid,"latitude",id(2)) 240 ierr= NF_INQ_DIMID(nid," bandsVI",id(3))241 ierr= NF_INQ_DIMID(nid,"VI Wavenumber",id(3)) 241 242 ierr= NF_INQ_DIMID(nid,"Time",id(4)) 242 243
Note: See TracChangeset
for help on using the changeset viewer.