subroutine physiq(ngrid,nlayer,nq, & nametrac, & firstcall,lastcall, & pday,ptime,ptimestep, & pplev,pplay,pphi, & pu,pv,pt,pq, & pw, & pdu,pdv,pdt,pdq,pdpsrf,tracerdyn) use radinc_h, only : L_NSPECTI,L_NSPECTV,naerkind use watercommon_h, only : RLVTT, Psat_water,epsi use gases_h, only: gnom, gfrac use radcommon_h, only: sigma, eclipse, glat, grav use radii_mod, only: h2o_reffrad, co2_reffrad, h2o_cloudrad use aerosol_mod, only: iaero_co2, iaero_h2o use surfdat_h, only: phisfi, albedodat, zmea, zstd, zsig, zgam, zthe, & dryness, watercaptag use comdiurn_h, only: coslat, sinlat, coslon, sinlon use comsaison_h, only: mu0, fract, dist_star, declin use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat USE comgeomfi_h, only: long, lati, area, totarea, totarea_planet USE tracer_h, only: noms, mmol, radius, rho_q, qext, & alpha_lift, alpha_devil, qextrhor, & igcm_h2o_ice, igcm_h2o_vap, igcm_dustbin, & igcm_co2_ice use control_mod, only: ecritphy, iphysiq, nday use phyredem, only: physdem0, physdem1 use slab_ice_h use ocean_slab_mod, only :ocean_slab_init, ocean_slab_ice, & ocean_slab_get_vars,ocean_slab_final use surf_heat_transp_mod,only :init_masquv use planetwide_mod, only: planetwide_minval,planetwide_maxval,planetwide_sumval use mod_phys_lmdz_para, only : is_master implicit none !================================================================== ! ! Purpose ! ------- ! Central subroutine for all the physics parameterisations in the ! universal model. Originally adapted from the Mars LMDZ model. ! ! The model can be run without or with tracer transport ! depending on the value of "tracer" in file "callphys.def". ! ! ! It includes: ! ! 1. Initialization: ! 1.1 Firstcall initializations ! 1.2 Initialization for every call to physiq ! 1.2.5 Compute mean mass and cp, R and thermal conduction coeff. ! 2. Compute radiative transfer tendencies ! (longwave and shortwave). ! 4. Vertical diffusion (turbulent mixing): ! 5. Convective adjustment ! 6. Condensation and sublimation of gases (currently just CO2). ! 7. TRACERS ! 7a. water and water ice ! 7c. other schemes for tracer transport (lifting, sedimentation) ! 7d. updates (pressure variations, surface budget) ! 9. Surface and sub-surface temperature calculations ! 10. Write outputs : ! - "startfi", "histfi" if it's time ! - Saving statistics if "callstats = .true." ! - Output any needed variables in "diagfi" ! 10. Diagnostics: mass conservation of tracers, radiative energy balance etc. ! ! arguments ! --------- ! ! input ! ----- ! ecri period (in dynamical timestep) to write output ! ngrid Size of the horizontal grid. ! All internal loops are performed on that grid. ! nlayer Number of vertical layers. ! nq Number of advected fields ! firstcall True at the first call ! lastcall True at the last call ! pday Number of days counted from the North. Spring ! equinoxe. ! ptime Universal time (0 PROBLEMS WITH ALLOCATED ARRAYS ! (temporary solution in callcorrk: do not deallocate if CLFvarying ...) clearsky=.true. call callcorrk(ngrid,nlayer,pq,nq,qsurf, & albedo,emis,mu0,pplev,pplay,pt, & tsurf,fract,dist_star,aerosol,muvar, & zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,fluxtop_lw1, & fluxabs_sw1,fluxtop_dn,OLR_nu1,OSR_nu1, & tau_col1,cloudfrac,totcloudfrac, & clearsky,firstcall,lastcall) clearsky = .false. ! just in case. ! Sum the fluxes and heating rates from cloudy/clear cases do ig=1,ngrid tf=totcloudfrac(ig) ntf=1.-tf fluxsurf_lw(ig) = ntf*fluxsurf_lw1(ig) + tf*fluxsurf_lw(ig) fluxsurf_sw(ig) = ntf*fluxsurf_sw1(ig) + tf*fluxsurf_sw(ig) fluxtop_lw(ig) = ntf*fluxtop_lw1(ig) + tf*fluxtop_lw(ig) fluxabs_sw(ig) = ntf*fluxabs_sw1(ig) + tf*fluxabs_sw(ig) tau_col(ig) = ntf*tau_col1(ig) + tf*tau_col(ig) zdtlw(ig,1:nlayermx) = ntf*zdtlw1(ig,1:nlayermx) + tf*zdtlw(ig,1:nlayermx) zdtsw(ig,1:nlayermx) = ntf*zdtsw1(ig,1:nlayermx) + tf*zdtsw(ig,1:nlayermx) OSR_nu(ig,1:L_NSPECTV) = ntf*OSR_nu1(ig,1:L_NSPECTV) + tf*OSR_nu(ig,1:L_NSPECTV) OLR_nu(ig,1:L_NSPECTI) = ntf*OLR_nu1(ig,1:L_NSPECTI) + tf*OLR_nu(ig,1:L_NSPECTI) enddo endif !CLFvarying if(ok_slab_ocean) then tsurf(:)=tsurf2(:) endif!(ok_slab_ocean) ! Radiative flux from the sky absorbed by the surface (W.m-2) GSR=0.0 fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid)+fluxsurf_sw(1:ngrid)*(1.-albedo(1:ngrid)) !if(noradsurf)then ! no lower surface; SW flux just disappears ! GSR = SUM(fluxsurf_sw(1:ngrid)*area(1:ngrid))/totarea ! fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid) ! print*,'SW lost in deep atmosphere = ',GSR,' W m^-2' !endif ! Net atmospheric radiative heating rate (K.s-1) dtrad(1:ngrid,1:nlayermx)=zdtsw(1:ngrid,1:nlayermx)+zdtlw(1:ngrid,1:nlayermx) elseif(newtonian)then ! b) Call Newtonian cooling scheme ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call newtrelax(ngrid,mu0,sinlat,zpopsk,pt,pplay,pplev,dtrad,firstcall) zdtsurf(1:ngrid) = +(pt(1:ngrid,1)-tsurf(1:ngrid))/ptimestep ! e.g. surface becomes proxy for 1st atmospheric layer ? else ! c) Atmosphere has no radiative effect ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ fluxtop_dn(1:ngrid) = fract(1:ngrid)*mu0(1:ngrid)*Fat1AU/dist_star**2 if(ngrid.eq.1)then ! / by 4 globally in 1D case... fluxtop_dn(1) = fract(1)*Fat1AU/dist_star**2/2.0 endif fluxsurf_sw(1:ngrid) = fluxtop_dn(1:ngrid) fluxrad_sky(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid)) fluxtop_lw(1:ngrid) = emis(1:ngrid)*sigma*tsurf(1:ngrid)**4 ! radiation skips the atmosphere entirely dtrad(1:ngrid,1:nlayermx)=0.0 ! hence no atmospheric radiative heating endif ! if corrk endif ! of if(mod(icount-1,iradia).eq.0) ! Transformation of the radiative tendencies ! ------------------------------------------ zplanck(1:ngrid)=tsurf(1:ngrid)*tsurf(1:ngrid) zplanck(1:ngrid)=emis(1:ngrid)*sigma*zplanck(1:ngrid)*zplanck(1:ngrid) fluxrad(1:ngrid)=fluxrad_sky(1:ngrid)-zplanck(1:ngrid) pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+dtrad(1:ngrid,1:nlayermx) !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(cpp*massarea(:,:)*zdtsw(:,:)/totarea_planet,dEtotSW) call planetwide_sumval(cpp*massarea(:,:)*zdtlw(:,:)/totarea_planet,dEtotLW) call planetwide_sumval(fluxsurf_sw(:)*(1.-albedo(:))*area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk call planetwide_sumval((fluxsurf_lw(:)*emis(:)-zplanck(:))*area(:)/totarea_planet,dEtotsLW) dEzRadsw(:,:)=cpp*mass(:,:)*zdtsw(:,:) dEzRadlw(:,:)=cpp*mass(:,:)*zdtlw(:,:) if (is_master) then print*,'---------------------------------------------------------------' print*,'In corrk SW atmospheric heating =',dEtotSW,' W m-2' print*,'In corrk LW atmospheric heating =',dEtotLW,' W m-2' print*,'atmospheric net rad heating (SW+LW) =',dEtotLW+dEtotSW,' W m-2' print*,'In corrk SW surface heating =',dEtotsSW,' W m-2' print*,'In corrk LW surface heating =',dEtotsLW,' W m-2' print*,'surface net rad heating (SW+LW) =',dEtotsLW+dEtotsSW,' W m-2' endif endif !------------------------- endif ! of if (callrad) !----------------------------------------------------------------------- ! 4. Vertical diffusion (turbulent mixing): ! ----------------------------------------- if (calldifv) then zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid) zdum1(1:ngrid,1:nlayermx)=0.0 zdum2(1:ngrid,1:nlayermx)=0.0 !JL12 the following if test is temporarily there to allow us to compare the old vdifc with turbdiff if (UseTurbDiff) then call turbdiff(ngrid,nlayer,nq,rnat, & ptimestep,capcal,lwrite, & pplay,pplev,zzlay,zzlev,z0, & pu,pv,pt,zpopsk,pq,tsurf,emis,qsurf, & zdum1,zdum2,pdt,pdq,zflubid, & zdudif,zdvdif,zdtdif,zdtsdif, & sensibFlux,q2,zdqdif,zdqevap,zdqsdif, & taux,tauy,lastcall) else zdh(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)/zpopsk(1:ngrid,1:nlayermx) call vdifc(ngrid,nlayer,nq,rnat,zpopsk, & ptimestep,capcal,lwrite, & pplay,pplev,zzlay,zzlev,z0, & pu,pv,zh,pq,tsurf,emis,qsurf, & zdum1,zdum2,zdh,pdq,zflubid, & zdudif,zdvdif,zdhdif,zdtsdif, & sensibFlux,q2,zdqdif,zdqsdif, & taux,tauy,lastcall) zdtdif(1:ngrid,1:nlayermx)=zdhdif(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx) ! for diagnostic only zdqevap(1:ngrid,1:nlayermx)=0. end if !turbdiff pdv(1:ngrid,1:nlayermx)=pdv(1:ngrid,1:nlayermx)+zdvdif(1:ngrid,1:nlayermx) pdu(1:ngrid,1:nlayermx)=pdu(1:ngrid,1:nlayermx)+zdudif(1:ngrid,1:nlayermx) pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+zdtdif(1:ngrid,1:nlayermx) zdtsurf(1:ngrid)=zdtsurf(1:ngrid)+zdtsdif(1:ngrid) if(ok_slab_ocean)then flux_sens_lat(1:ngrid)=(zdtsdif(1:ngrid)*capcal(1:ngrid)-fluxrad(1:ngrid)) endif if (tracer) then pdq(1:ngrid,1:nlayermx,1:nq)=pdq(1:ngrid,1:nlayermx,1:nq)+ zdqdif(1:ngrid,1:nlayermx,1:nq) dqsurf(1:ngrid,1:nq)=dqsurf(1:ngrid,1:nq) + zdqsdif(1:ngrid,1:nq) end if ! of if (tracer) !------------------------- ! test energy conservation if(enertest)then dEzdiff(:,:)=cpp*mass(:,:)*zdtdif(:,:) do ig = 1, ngrid dEdiff(ig)=SUM(dEzdiff (ig,:))+ sensibFlux(ig)! subtract flux to the ground dEzdiff(ig,1)= dEzdiff(ig,1)+ sensibFlux(ig)! subtract flux to the ground enddo call planetwide_sumval(dEdiff(:)*area(:)/totarea_planet,dEtot) dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:) call planetwide_sumval(dEdiffs(:)*area(:)/totarea_planet,dEtots) call planetwide_sumval(sensibFlux(:)*area(:)/totarea_planet,AtmToSurf_TurbFlux) if (is_master) then if (UseTurbDiff) then print*,'In TurbDiff sensible flux (atm=>surf) =',AtmToSurf_TurbFlux,' W m-2' print*,'In TurbDiff non-cons atm nrj change =',dEtot,' W m-2' print*,'In TurbDiff (correc rad+latent heat) surf nrj change =',dEtots,' W m-2' else print*,'In vdifc sensible flux (atm=>surf) =',AtmToSurf_TurbFlux,' W m-2' print*,'In vdifc non-cons atm nrj change =',dEtot,' W m-2' print*,'In vdifc (correc rad+latent heat) surf nrj change =',dEtots,' W m-2' end if endif ! of if (is_master) ! JL12 note that the black body radiative flux emitted by the surface has been updated by the implicit scheme ! but not given back elsewhere endif !------------------------- !------------------------- ! test water conservation if(watertest.and.water)then call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp) call planetwide_sumval(zdqsdif(:,igcm_h2o_vap)*area(:)*ptimestep/totarea_planet,dWtots_tmp) do ig = 1, ngrid vdifcncons(ig)=SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_vap)) Enddo call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) call planetwide_sumval(zdqsdif(:,igcm_h2o_ice)*area(:)*ptimestep/totarea_planet,dWtots) dWtot = dWtot + dWtot_tmp dWtots = dWtots + dWtots_tmp do ig = 1, ngrid vdifcncons(ig)=vdifcncons(ig) + SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_ice)) Enddo call planetwide_maxval(vdifcncons(:),nconsMAX) if (is_master) then print*,'---------------------------------------------------------------' print*,'In difv atmospheric water change =',dWtot,' kg m-2' print*,'In difv surface water change =',dWtots,' kg m-2' print*,'In difv non-cons factor =',dWtot+dWtots,' kg m-2' print*,'In difv MAX non-cons factor =',nconsMAX,' kg m-2 s-1' endif endif !------------------------- else if(.not.newtonian)then zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + (fluxrad(1:ngrid) + fluxgrd(1:ngrid))/capcal(1:ngrid) endif endif ! of if (calldifv) !----------------------------------------------------------------------- ! 5. Dry convective adjustment: ! ----------------------------- if(calladj) then zdh(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)/zpopsk(1:ngrid,1:nlayermx) zduadj(1:ngrid,1:nlayermx)=0.0 zdvadj(1:ngrid,1:nlayermx)=0.0 zdhadj(1:ngrid,1:nlayermx)=0.0 call convadj(ngrid,nlayer,nq,ptimestep, & pplay,pplev,zpopsk, & pu,pv,zh,pq, & pdu,pdv,zdh,pdq, & zduadj,zdvadj,zdhadj, & zdqadj) pdu(1:ngrid,1:nlayermx) = pdu(1:ngrid,1:nlayermx) + zduadj(1:ngrid,1:nlayermx) pdv(1:ngrid,1:nlayermx) = pdv(1:ngrid,1:nlayermx) + zdvadj(1:ngrid,1:nlayermx) pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx) + zdhadj(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx) zdtadj(1:ngrid,1:nlayermx) = zdhadj(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx) ! for diagnostic only if(tracer) then pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqadj(1:ngrid,1:nlayermx,1:nq) end if !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(cpp*massarea(:,:)*zdtadj(:,:)/totarea_planet,dEtot) if (is_master) print*,'In convadj atmospheric energy change =',dEtot,' W m-2' endif !------------------------- !------------------------- ! test water conservation if(watertest)then call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp) do ig = 1, ngrid cadjncons(ig)=SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_vap)) Enddo call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) dWtot = dWtot + dWtot_tmp do ig = 1, ngrid cadjncons(ig)=cadjncons(ig) + SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_ice)) Enddo call planetwide_maxval(cadjncons(:),nconsMAX) if (is_master) then print*,'In convadj atmospheric water change =',dWtot,' kg m-2' print*,'In convadj MAX non-cons factor =',nconsMAX,' kg m-2 s-1' endif endif !------------------------- endif ! of if(calladj) !----------------------------------------------------------------------- ! 6. Carbon dioxide condensation-sublimation: ! ------------------------------------------- if (co2cond) then if (.not.tracer) then print*,'We need a CO2 ice tracer to condense CO2' call abort endif call condense_cloud(ngrid,nlayer,nq,ptimestep, & capcal,pplay,pplev,tsurf,pt, & pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq, & qsurf(1,igcm_co2_ice),albedo,emis, & zdtc,zdtsurfc,pdpsrf,zduc,zdvc, & zdqc) pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+zdtc(1:ngrid,1:nlayermx) pdv(1:ngrid,1:nlayermx)=pdv(1:ngrid,1:nlayermx)+zdvc(1:ngrid,1:nlayermx) pdu(1:ngrid,1:nlayermx)=pdu(1:ngrid,1:nlayermx)+zduc(1:ngrid,1:nlayermx) zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurfc(1:ngrid) pdq(1:ngrid,1:nlayermx,1:nq)=pdq(1:ngrid,1:nlayermx,1:nq)+ zdqc(1:ngrid,1:nlayermx,1:nq) ! Note: we do not add surface co2ice tendency ! because qsurf(:,igcm_co2_ice) is updated in condens_co2cloud !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(cpp*massarea(:,:)*zdtc(:,:)/totarea_planet,dEtot) call planetwide_sumval(capcal(:)*zdtsurfc(:)*area(:)/totarea_planet,dEtots) if (is_master) then print*,'In co2cloud atmospheric energy change =',dEtot,' W m-2' print*,'In co2cloud surface energy change =',dEtots,' W m-2' endif endif !------------------------- endif ! of if (co2cond) !----------------------------------------------------------------------- ! 7. Specific parameterizations for tracers ! ----------------------------------------- if (tracer) then ! 7a. Water and ice ! --------------- if (water) then ! ---------------------------------------- ! Water ice condensation in the atmosphere ! ---------------------------------------- if(watercond.and.(RLVTT.gt.1.e-8))then ! ---------------- ! Moist convection ! ---------------- dqmoist(1:ngrid,1:nlayermx,1:nq)=0. dtmoist(1:ngrid,1:nlayermx)=0. call moistadj(ngrid,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man) pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) & +dqmoist(1:ngrid,1:nlayermx,igcm_h2o_vap) pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) =pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) & +dqmoist(1:ngrid,1:nlayermx,igcm_h2o_ice) pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+dtmoist(1:ngrid,1:nlayermx) !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(cpp*massarea(:,:)*dtmoist(:,:)/totarea_planet,dEtot) call planetwide_maxval(dtmoist(:,:),dtmoist_max) call planetwide_minval(dtmoist(:,:),dtmoist_min) madjdEz(:,:)=cpp*mass(:,:)*dtmoist(:,:) do ig=1,ngrid madjdE(ig) = cpp*SUM(mass(:,:)*dtmoist(:,:)) enddo if (is_master) then print*,'In moistadj atmospheric energy change =',dEtot,' W m-2' print*,'In moistadj MAX atmospheric energy change =',dtmoist_max*ptimestep,'K/step' print*,'In moistadj MIN atmospheric energy change =',dtmoist_min*ptimestep,'K/step' endif ! test energy conservation call planetwide_sumval(massarea(:,:)*dqmoist(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+ & massarea(:,:)*dqmoist(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) if (is_master) print*,'In moistadj atmospheric water change =',dWtot,' kg m-2' endif !------------------------- ! -------------------------------- ! Large scale condensation/evaporation ! -------------------------------- call largescale(ngrid,nq,ptimestep,pplev,pplay,pt,pq,pdt,pdq,dtlscale,dqvaplscale,dqcldlscale,rneb_lsc) pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+dtlscale(1:ngrid,1:nlayermx) pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap)+dqvaplscale(1:ngrid,1:nlayermx) pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) = pdq(1:ngrid,1:nlayermx,igcm_h2o_ice)+dqcldlscale(1:ngrid,1:nlayermx) !------------------------- ! test energy conservation if(enertest)then lscaledEz(:,:) = cpp*mass(:,:)*dtlscale(:,:) do ig=1,ngrid lscaledE(ig) = cpp*SUM(mass(:,:)*dtlscale(:,:)) enddo call planetwide_sumval(cpp*massarea(:,:)*dtlscale(:,:)/totarea_planet,dEtot) ! if(isnan(dEtot)) then ! NB: isnan() is not a standard function... ! print*,'Nan in largescale, abort' ! STOP ! endif if (is_master) print*,'In largescale atmospheric energy change =',dEtot,' W m-2' ! test water conservation call planetwide_sumval(massarea(:,:)*dqvaplscale(:,:)*ptimestep/totarea_planet+ & SUM(massarea(:,:)*dqcldlscale(:,:))*ptimestep/totarea_planet,dWtot) if (is_master) print*,'In largescale atmospheric water change =',dWtot,' kg m-2' endif !------------------------- ! compute cloud fraction do l = 1, nlayer do ig=1,ngrid cloudfrac(ig,l)=MAX(rneb_lsc(ig,l),rneb_man(ig,l)) enddo enddo endif ! of if (watercondense) ! -------------------------------- ! Water ice / liquid precipitation ! -------------------------------- if(waterrain)then zdqrain(1:ngrid,1:nlayermx,1:nq) = 0.0 zdqsrain(1:ngrid) = 0.0 zdqssnow(1:ngrid) = 0.0 call rain(ngrid,nq,ptimestep,pplev,pplay,pt,pdt,pq,pdq, & zdtrain,zdqrain,zdqsrain,zdqssnow,cloudfrac) pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) & +zdqrain(1:ngrid,1:nlayermx,igcm_h2o_vap) pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) = pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) & +zdqrain(1:ngrid,1:nlayermx,igcm_h2o_ice) pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+zdtrain(1:ngrid,1:nlayermx) dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid) ! a bug was here dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid) rainout(1:ngrid) = zdqsrain(1:ngrid)+zdqssnow(1:ngrid) ! diagnostic !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(cpp*massarea(:,:)*zdtrain(:,:)/totarea_planet,dEtot) if (is_master) print*,'In rain atmospheric T energy change =',dEtot,' W m-2' call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)/totarea_planet*RLVTT/cpp,dItot_tmp) call planetwide_sumval(area(:)*zdqssnow(:)/totarea_planet*RLVTT/cpp,dItot) dItot = dItot + dItot_tmp call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dVtot_tmp) call planetwide_sumval(area(:)*zdqsrain(:)/totarea_planet*RLVTT/cpp,dVtot) dVtot = dVtot + dVtot_tmp dEtot = dItot + dVtot if (is_master) then print*,'In rain dItot =',dItot,' W m-2' print*,'In rain dVtot =',dVtot,' W m-2' print*,'In rain atmospheric L energy change =',dEtot,' W m-2' endif ! test water conservation call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+ & massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) call planetwide_sumval((zdqsrain(:)+zdqssnow(:))*area(:)*ptimestep/totarea_planet,dWtots) if (is_master) then print*,'In rain atmospheric water change =',dWtot,' kg m-2' print*,'In rain surface water change =',dWtots,' kg m-2' print*,'In rain non-cons factor =',dWtot+dWtots,' kg m-2' endif endif !------------------------- end if ! of if (waterrain) end if ! of if (water) ! 7c. Aerosol particles ! ------------------- ! ------------- ! Sedimentation ! ------------- if (sedimentation) then zdqsed(1:ngrid,1:nlayermx,1:nq) = 0.0 zdqssed(1:ngrid,1:nq) = 0.0 !------------------------- ! find qtot if(watertest)then iq=igcm_h2o_ice call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot) call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots) if (is_master) then print*,'Before sedim pq =',dWtot,' kg m-2' print*,'Before sedim pdq =',dWtots,' kg m-2' endif endif !------------------------- call callsedim(ngrid,nlayer,ptimestep, & pplev,zzlev,pt,pdt,pq,pdq,zdqsed,zdqssed,nq) !------------------------- ! find qtot if(watertest)then iq=igcm_h2o_ice call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot) call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots) if (is_master) then print*,'After sedim pq =',dWtot,' kg m-2' print*,'After sedim pdq =',dWtots,' kg m-2' endif endif !------------------------- ! for now, we only allow H2O ice to sediment ! and as in rain.F90, whether it falls as rain or snow depends ! only on the surface temperature pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqsed(1:ngrid,1:nlayermx,1:nq) dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + zdqssed(1:ngrid,1:nq) !------------------------- ! test water conservation if(watertest)then call planetwide_sumval(massarea(:,:)*(zdqsed(:,:,igcm_h2o_vap)+zdqsed(:,:,igcm_h2o_ice))*ptimestep/totarea_planet,dWtot) call planetwide_sumval((zdqssed(:,igcm_h2o_vap)+zdqssed(:,igcm_h2o_ice))*area(:)*ptimestep/totarea_planet,dWtots) if (is_master) then print*,'In sedim atmospheric ice change =',dWtot,' kg m-2' print*,'In sedim surface ice change =',dWtots,' kg m-2' print*,'In sedim non-cons factor =',dWtot+dWtots,' kg m-2' endif endif !------------------------- end if ! of if (sedimentation) ! 7d. Updates ! --------- ! ----------------------------------- ! Updating atm mass and tracer budget ! ----------------------------------- if(mass_redistrib) then zdmassmr(1:ngrid,1:nlayermx) = mass(1:ngrid,1:nlayermx) * & ( zdqevap(1:ngrid,1:nlayermx) & + zdqrain(1:ngrid,1:nlayermx,igcm_h2o_vap) & + dqmoist(1:ngrid,1:nlayermx,igcm_h2o_vap) & + dqvaplscale(1:ngrid,1:nlayermx) ) do ig = 1, ngrid zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayermx)) enddo call writediagfi(ngrid,"mass_evap","mass gain"," ",3,zdmassmr) call writediagfi(ngrid,"mass_evap_col","mass gain col"," ",2,zdmassmr_col) call writediagfi(ngrid,"mass","mass"," ",3,mass) call mass_redistribution(ngrid,nlayer,nq,ptimestep, & rnat,capcal,pplay,pplev,pt,tsurf,pq,qsurf, & pu,pv,pdt,zdtsurf,pdq,pdu,pdv,zdmassmr, & zdtmr,zdtsurfmr,zdpsrfmr,zdumr,zdvmr,zdqmr,zdqsurfmr) pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqmr(1:ngrid,1:nlayermx,1:nq) dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq) pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx) + zdtmr(1:ngrid,1:nlayermx) pdu(1:ngrid,1:nlayermx) = pdu(1:ngrid,1:nlayermx) + zdumr(1:ngrid,1:nlayermx) pdv(1:ngrid,1:nlayermx) = pdv(1:ngrid,1:nlayermx) + zdvmr(1:ngrid,1:nlayermx) pdpsrf(1:ngrid) = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid) zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid) ! print*,'after mass redistrib, q=',pq(211,1:nlayermx,igcm_h2o_vap)+ptimestep*pdq(211,1:nlayermx,igcm_h2o_vap) endif ! 7e. Ocean ! --------- ! --------------------------------- ! Slab_ocean ! --------------------------------- if (ok_slab_ocean)then do ig=1,ngrid qsurfint(:,igcm_h2o_ice)=qsurf(:,igcm_h2o_ice) enddo call ocean_slab_ice(ptimestep, & ngrid, knindex, tsea_ice, fluxrad, & zdqssnow, qsurf(:,igcm_h2o_ice), & -zdqsdif(:,igcm_h2o_vap), & flux_sens_lat,tsea_ice, pctsrf_sic, & taux,tauy,icount) call ocean_slab_get_vars(ngrid,tslab, & sea_ice, flux_o, & flux_g, dt_hdiff, & dt_ekman) do ig=1,ngrid if (nint(rnat(ig)).eq.1)then tslab(ig,1) = 0. tslab(ig,2) = 0. tsea_ice(ig) = 0. sea_ice(ig) = 0. pctsrf_sic(ig) = 0. qsurf(ig,igcm_h2o_ice)=qsurfint(ig,igcm_h2o_ice) endif enddo endif! (ok_slab_ocean) ! --------------------------------- ! Updating tracer budget on surface ! --------------------------------- if(hydrology)then call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd, & capcal,albedo0,albedo,mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic, & sea_ice) ! note: for now, also changes albedo in the subroutine zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurf_hyd(1:ngrid) qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqs_hyd(1:ngrid,1:nq) ! when hydrology is used, other dqsurf tendencies are all added to dqs_hyd inside !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(area(:)*capcal(:)*zdtsurf_hyd(:)/totarea_planet,dEtots) if (is_master) print*,'In hydrol surface energy change =',dEtots,' W m-2' endif !------------------------- !------------------------- ! test water conservation if(watertest)then call planetwide_sumval(dqs_hyd(:,igcm_h2o_ice)*area(:)*ptimestep/totarea_planet,dWtots) if (is_master) print*,'In hydrol surface ice change =',dWtots,' kg m-2' call planetwide_sumval(dqs_hyd(:,igcm_h2o_vap)*area(:)*ptimestep/totarea_planet,dWtots) if (is_master) then print*,'In hydrol surface water change =',dWtots,' kg m-2' print*,'---------------------------------------------------------------' endif endif !------------------------- ELSE ! of if (hydrology) qsurf(1:ngrid,1:nq)=qsurf(1:ngrid,1:nq)+ptimestep*dqsurf(1:ngrid,1:nq) END IF ! of if (hydrology) ! Add qsurf to qsurf_hist, which is what we save in ! diagfi.nc etc. At the same time, we set the water ! content of ocean gridpoints back to zero, in order ! to avoid rounding errors in vdifc, rain qsurf_hist(:,:) = qsurf(:,:) if(ice_update)then ice_min(1:ngrid)=min(ice_min(1:ngrid),qsurf(1:ngrid,igcm_h2o_ice)) endif endif ! of if (tracer) !----------------------------------------------------------------------- ! 9. Surface and sub-surface soil temperature !----------------------------------------------------------------------- ! Increment surface temperature if(ok_slab_ocean)then do ig=1,ngrid if (nint(rnat(ig)).eq.0)then zdtsurf(ig)= (tslab(ig,1) & + pctsrf_sic(ig)*(tsea_ice(ig)-tslab(ig,1))-tsurf(ig))/ptimestep endif tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) enddo else tsurf(1:ngrid)=tsurf(1:ngrid)+ptimestep*zdtsurf(1:ngrid) endif!(ok_slab_ocean) ! Compute soil temperatures and subsurface heat flux if (callsoil) then call soil(ngrid,nsoilmx,.false.,lastcall,inertiedat, & ptimestep,tsurf,tsoil,capcal,fluxgrd) endif if (ok_slab_ocean) then do ig=1,ngrid fluxgrdocean(ig)=fluxgrd(ig) if (nint(rnat(ig)).eq.0) then capcal(ig)=capcalocean fluxgrd(ig)=0. fluxgrdocean(ig)=pctsrf_sic(ig)*flux_g(ig)+(1-pctsrf_sic(ig))*(dt_hdiff(ig,1)+dt_ekman(ig,1)) do iq=1,nsoilmx tsoil(ig,iq)=tsurf(ig) enddo if (pctsrf_sic(ig).gt.0.5) then capcal(ig)=capcalseaice if (qsurf(ig,igcm_h2o_ice).gt.0.) then capcal(ig)=capcalsno endif endif endif enddo endif !(ok_slab_ocean) !------------------------- ! test energy conservation if(enertest)then call planetwide_sumval(area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots) if (is_master) print*,'Surface energy change =',dEtots,' W m-2' endif !------------------------- !----------------------------------------------------------------------- ! 10. Perform diagnostics and write output files !----------------------------------------------------------------------- ! ------------------------------- ! Dynamical fields incrementation ! ------------------------------- ! For output only: the actual model integration is performed in the dynamics ! temperature, zonal and meridional wind zt(1:ngrid,1:nlayermx) = pt(1:ngrid,1:nlayermx) + pdt(1:ngrid,1:nlayermx)*ptimestep zu(1:ngrid,1:nlayermx) = pu(1:ngrid,1:nlayermx) + pdu(1:ngrid,1:nlayermx)*ptimestep zv(1:ngrid,1:nlayermx) = pv(1:ngrid,1:nlayermx) + pdv(1:ngrid,1:nlayermx)*ptimestep ! diagnostic zdtdyn(1:ngrid,1:nlayermx) = pt(1:ngrid,1:nlayermx)-ztprevious(1:ngrid,1:nlayermx) ztprevious(1:ngrid,1:nlayermx) = zt(1:ngrid,1:nlayermx) if(firstcall)then zdtdyn(1:ngrid,1:nlayermx)=0.0 endif ! dynamical heating diagnostic do ig=1,ngrid fluxdyn(ig)= SUM(zdtdyn(ig,:) *mass(ig,:))*cpp/ptimestep enddo ! tracers zq(1:ngrid,1:nlayermx,1:nq) = pq(1:ngrid,1:nlayermx,1:nq) + pdq(1:ngrid,1:nlayermx,1:nq)*ptimestep ! surface pressure ps(1:ngrid) = pplev(1:ngrid,1) + pdpsrf(1:ngrid)*ptimestep ! pressure do l=1,nlayer zplev(1:ngrid,l) = pplev(1:ngrid,l)/pplev(1:ngrid,1)*ps(:) zplay(1:ngrid,l) = pplay(1:ngrid,l)/pplev(1:ngrid,1)*ps(1:ngrid) enddo ! --------------------------------------------------------- ! Surface and soil temperature information ! --------------------------------------------------------- call planetwide_sumval(area(:)*tsurf(:)/totarea_planet,Ts1) call planetwide_minval(tsurf(:),Ts2) call planetwide_maxval(tsurf(:),Ts3) if(callsoil)then TsS = SUM(area(:)*tsoil(:,nsoilmx))/totarea ! mean temperature at bottom soil layer print*,' ave[Tsurf] min[Tsurf] max[Tsurf] ave[Tdeep]' print*,Ts1,Ts2,Ts3,TsS else if (is_master) then print*,' ave[Tsurf] min[Tsurf] max[Tsurf]' print*,Ts1,Ts2,Ts3 endif end if ! --------------------------------------------------------- ! Check the energy balance of the simulation during the run ! --------------------------------------------------------- if(corrk)then call planetwide_sumval(area(:)*fluxtop_dn(:)/totarea_planet,ISR) call planetwide_sumval(area(:)*fluxabs_sw(:)/totarea_planet,ASR) call planetwide_sumval(area(:)*fluxtop_lw(:)/totarea_planet,OLR) call planetwide_sumval(area(:)*fluxgrd(:)/totarea_planet,GND) call planetwide_sumval(area(:)*fluxdyn(:)/totarea_planet,DYN) do ig=1,ngrid if(fluxtop_dn(ig).lt.0.0)then print*,'fluxtop_dn has gone crazy' print*,'fluxtop_dn=',fluxtop_dn(ig) print*,'tau_col=',tau_col(ig) print*,'aerosol=',aerosol(ig,:,:) print*,'temp= ',pt(ig,:) print*,'pplay= ',pplay(ig,:) call abort endif end do if(ngrid.eq.1)then DYN=0.0 endif if (is_master) then print*,' ISR ASR OLR GND DYN [W m^-2]' print*, ISR,ASR,OLR,GND,DYN endif if(enertest .and. is_master)then print*,'SW flux/heating difference SW++ - ASR = ',dEtotSW+dEtotsSW-ASR,' W m-2' print*,'LW flux/heating difference LW++ - OLR = ',dEtotLW+dEtotsLW+OLR,' W m-2' print*,'LW energy balance LW++ + ASR = ',dEtotLW+dEtotsLW+ASR,' W m-2' endif if(meanOLR .and. is_master)then if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then ! to record global radiative balance open(92,file="rad_bal.out",form='formatted',position='append') write(92,*) zday,ISR,ASR,OLR close(92) open(93,file="tem_bal.out",form='formatted',position='append') if(callsoil)then write(93,*) zday,Ts1,Ts2,Ts3,TsS else write(93,*) zday,Ts1,Ts2,Ts3 endif close(93) endif endif endif ! ------------------------------------------------------------------ ! Diagnostic to test radiative-convective timescales in code ! ------------------------------------------------------------------ if(testradtimes)then open(38,file="tau_phys.out",form='formatted',position='append') ig=1 do l=1,nlayer write(38,*) -1./pdt(ig,l),pt(ig,l),pplay(ig,l) enddo close(38) print*,'As testradtimes enabled,' print*,'exiting physics on first call' call abort endif ! --------------------------------------------------------- ! Compute column amounts (kg m-2) if tracers are enabled ! --------------------------------------------------------- if(tracer)then qcol(1:ngrid,1:nq)=0.0 do iq=1,nq do ig=1,ngrid qcol(ig,iq) = SUM( zq(ig,1:nlayermx,iq) * mass(ig,1:nlayermx)) enddo enddo ! Generalised for arbitrary aerosols now. (LK) reffcol(1:ngrid,1:naerkind)=0.0 if(co2cond.and.(iaero_co2.ne.0))then call co2_reffrad(ngrid,nq,zq,reffrad(1,1,iaero_co2)) do ig=1,ngrid reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayermx,igcm_co2_ice)*reffrad(ig,1:nlayermx,iaero_co2)*mass(ig,1:nlayermx)) enddo endif if(water.and.(iaero_h2o.ne.0))then call h2o_reffrad(ngrid,zq(1,1,igcm_h2o_ice),zt, & reffrad(1,1,iaero_h2o),nueffrad(1,1,iaero_h2o)) do ig=1,ngrid reffcol(ig,iaero_h2o) = SUM(zq(ig,1:nlayermx,igcm_h2o_ice)*reffrad(ig,1:nlayermx,iaero_h2o)*mass(ig,1:nlayermx)) enddo endif endif ! --------------------------------------------------------- ! Test for water conservation if water is enabled ! --------------------------------------------------------- if(water)then call planetwide_sumval(area(:)*qsurf_hist(:,igcm_h2o_ice)/totarea_planet,icesrf) call planetwide_sumval(area(:)*qsurf_hist(:,igcm_h2o_vap)/totarea_planet,liqsrf) call planetwide_sumval(area(:)*qcol(:,igcm_h2o_ice)/totarea_planet,icecol) call planetwide_sumval(area(:)*qcol(:,igcm_h2o_vap)/totarea_planet,vapcol) h2otot = icesrf + liqsrf + icecol + vapcol if (is_master) then print*,' Total water amount [kg m^-2]: ',h2otot print*,' Surface ice Surface liq. Atmos. con. Atmos. vap. [kg m^-2] ' print*, icesrf,liqsrf,icecol,vapcol endif if(meanOLR .and. is_master)then if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then ! to record global water balance open(98,file="h2o_bal.out",form='formatted',position='append') write(98,*) zday,icesrf,liqsrf,icecol,vapcol close(98) endif endif endif ! --------------------------------------------------------- ! Calculate RH for diagnostic if water is enabled ! --------------------------------------------------------- if(water)then do l = 1, nlayer do ig=1,ngrid call Psat_water(zt(ig,l),pplay(ig,l),psat_tmp,qsat(ig,l)) RH(ig,l) = zq(ig,l,igcm_h2o_vap) / qsat(ig,l) enddo enddo ! compute maximum possible H2O column amount (100% saturation) do ig=1,ngrid H2Omaxcol(ig) = SUM( qsat(ig,:) * mass(ig,:)) enddo endif print*,'--> Ls =',zls*180./pi ! ------------------------------------------------------------------- ! Writing NetCDF file "RESTARTFI" at the end of the run ! ------------------------------------------------------------------- ! Note: 'restartfi' is stored just before dynamics are stored ! in 'restart'. Between now and the writting of 'restart', ! there will have been the itau=itau+1 instruction and ! a reset of 'time' (lastacll = .true. when itau+1= itaufin) ! thus we store for time=time+dtvr if(lastcall) then ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) ! Update surface ice distribution to iterate to steady state if requested if(ice_update)then do ig=1,ngrid delta_ice = (qsurf(ig,igcm_h2o_ice)-ice_initial(ig)) ! add multiple years of evolution qsurf_hist(ig,igcm_h2o_ice) = qsurf_hist(ig,igcm_h2o_ice) + delta_ice*icetstep ! if ice has gone -ve, set to zero if(qsurf_hist(ig,igcm_h2o_ice).lt.0.0)then qsurf_hist(ig,igcm_h2o_ice) = 0.0 endif ! if ice is seasonal, set to zero (NEW) if(ice_min(ig).lt.0.01)then qsurf_hist(ig,igcm_h2o_ice) = 0.0 endif enddo ! enforce ice conservation ice_tot= SUM(qsurf_hist(:,igcm_h2o_ice)*area(:) ) qsurf_hist(:,igcm_h2o_ice) = qsurf_hist(:,igcm_h2o_ice)*(icesrf/ice_tot) endif if (ngrid.ne.1) then write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin !#ifdef CPP_PARA !! for now in parallel we use a different routine to write restartfi.nc ! call phyredem(ngrid,"restartfi.nc", & ! ptimestep,pday,ztime_fin,tsurf,tsoil,emis,q2,qsurf_hist, & ! cloudfrac,totcloudfrac,hice) !#else ! call physdem1(ngrid,"restartfi.nc",long,lati,nsoilmx,nq, & ! ptimestep,pday,ztime_fin,tsurf,tsoil,emis,q2,qsurf_hist, & ! area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe, & ! cloudfrac,totcloudfrac,hice,noms) !#endif call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, & ptimestep,ztime_fin, & tsurf,tsoil,emis,q2,qsurf_hist, & cloudfrac,totcloudfrac,hice, & rnat,pctsrf_sic,tslab,tsea_ice,sea_ice) endif if(ok_slab_ocean) then call ocean_slab_final!(tslab, seaice) end if endif ! of if (lastcall) ! ----------------------------------------------------------------- ! Saving statistics : ! ----------------------------------------------------------------- ! ("stats" stores and accumulates 8 key variables in file "stats.nc" ! which can later be used to make the statistic files of the run: ! "stats") only possible in 3D runs ! if (callstats) then call wstats(ngrid,"ps","Surface pressure","Pa",2,ps) call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf) call wstats(ngrid,"fluxsurf_lw", & "Thermal IR radiative flux to surface","W.m-2",2, & fluxsurf_lw) ! call wstats(ngrid,"fluxsurf_sw", & ! "Solar radiative flux to surface","W.m-2",2, & ! fluxsurf_sw_tot) call wstats(ngrid,"fluxtop_lw", & "Thermal IR radiative flux to space","W.m-2",2, & fluxtop_lw) ! call wstats(ngrid,"fluxtop_sw", & ! "Solar radiative flux to space","W.m-2",2, & ! fluxtop_sw_tot) call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn) call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw) call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) call wstats(ngrid,"ALB","Surface albedo"," ",2,albedo) call wstats(ngrid,"p","Pressure","Pa",3,pplay) call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt) call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu) call wstats(ngrid,"v","Meridional (North-South) wind","m.s-1",3,zv) call wstats(ngrid,"w","Vertical (down-up) wind","m.s-1",3,pw) call wstats(ngrid,"q2","Boundary layer eddy kinetic energy","m2.s-2",3,q2) if (tracer) then do iq=1,nq call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 'kg m^-2',2,qsurf(1,iq) ) call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 'kg m^-2',2,qcol(1,iq) ) ! call wstats(ngrid,trim(noms(iq))//'_reff', & ! trim(noms(iq))//'_reff', & ! 'm',3,reffrad(1,1,iq)) end do if (water) then vmr=zq(1:ngrid,1:nlayermx,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap) call wstats(ngrid,"vmr_h2ovapor", & "H2O vapour volume mixing ratio","mol/mol", & 3,vmr) endif ! of if (water) endif !tracer if(watercond.and.CLFvarying)then call wstats(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man) call wstats(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc) call wstats(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac) call wstats(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac) call wstats(ngrid,"RH","relative humidity"," ",3,RH) endif if (ok_slab_ocean) then call wstats(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1)) call wstats(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2)) call wstats(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1)) call wstats(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2)) call wstats(ngrid,"tslab1","tslab1","K",2,tslab(:,1)) call wstats(ngrid,"tslab2","tslab2","K",2,tslab(:,2)) call wstats(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic) call wstats(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice) call wstats(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice) call wstats(ngrid,"rnat","nature of the surface","",2,rnat) endif! (ok_slab_ocean) if(lastcall) then write (*,*) "Writing stats..." call mkstats(ierr) endif endif !if callstats ! ---------------------------------------------------------------------- ! output in netcdf file "DIAGFI", containing any variable for diagnostic ! (output with period "ecritphy", set in "run.def") ! ---------------------------------------------------------------------- ! writediagfi can also be called from any other subroutine for any variable. ! but its preferable to keep all the calls in one place... call writediagfi(ngrid,"Ls","solar longitude","deg",0,zls*180./pi) call writediagfi(ngrid,"tsurf","Surface temperature","K",2,tsurf) call writediagfi(ngrid,"ps","Surface pressure","Pa",2,ps) call writediagfi(ngrid,"temp","temperature","K",3,zt) call writediagfi(ngrid,"teta","potential temperature","K",3,zh) call writediagfi(ngrid,"u","Zonal wind","m.s-1",3,zu) call writediagfi(ngrid,"v","Meridional wind","m.s-1",3,zv) call writediagfi(ngrid,"w","Vertical wind","m.s-1",3,pw) call writediagfi(ngrid,"p","Pressure","Pa",3,pplay) ! Subsurface temperatures ! call writediagsoil(ngrid,"tsurf","Surface temperature","K",2,tsurf) ! call writediagsoil(ngrid,"temp","temperature","K",3,tsoil) ! Oceanic layers if(ok_slab_ocean) then call writediagfi(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic) call writediagfi(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice) call writediagfi(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice) call writediagfi(ngrid,"tslab1","tslab1","K",2,tslab(:,1)) call writediagfi(ngrid,"tslab2","tslab2","K",2,tslab(:,2)) call writediagfi(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1)) call writediagfi(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2)) call writediagfi(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1)) call writediagfi(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2)) call writediagfi(ngrid,"rnat","nature of the surface","",2,rnat) call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux) call writediagfi(ngrid,"latentFlux","latent heat flux","w.m^-2",2,zdqsdif(:,igcm_h2o_vap)*RLVTT) endif! (ok_slab_ocean) ! Total energy balance diagnostics if(callrad.and.(.not.newtonian))then call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo) call writediagfi(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn) call writediagfi(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw) call writediagfi(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) call writediagfi(ngrid,"shad","rings"," ", 2, fract) ! call writediagfi(ngrid,"ASRcs","absorbed stellar rad (cs).","W m-2",2,fluxabs_sw1) ! call writediagfi(ngrid,"OLRcs","outgoing longwave rad (cs).","W m-2",2,fluxtop_lw1) ! call writediagfi(ngrid,"fluxsurfsw","sw surface flux.","W m-2",2,fluxsurf_sw) ! call writediagfi(ngrid,"fluxsurflw","lw back radiation.","W m-2",2,fluxsurf_lw) ! call writediagfi(ngrid,"fluxsurfswcs","sw surface flux (cs).","W m-2",2,fluxsurf_sw1) ! call writediagfi(ngrid,"fluxsurflwcs","lw back radiation (cs).","W m-2",2,fluxsurf_lw1) if(ok_slab_ocean) then call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrdocean) else call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrd) endif!(ok_slab_ocean) call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn) endif if(enertest) then if (calldifv) then call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2) ! call writediagfi(ngrid,"dEzdiff","turbulent diffusion heating (-sensible flux)","w.m^-2",3,dEzdiff) ! call writediagfi(ngrid,"dEdiff","integrated turbulent diffusion heating (-sensible flux)","w.m^-2",2,dEdiff) ! call writediagfi(ngrid,"dEdiffs","In TurbDiff (correc rad+latent heat) surf nrj change","w.m^-2",2,dEdiffs) call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux) endif if (corrk) then call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw) call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw) endif if(watercond) then ! call writediagfi(ngrid,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) ! call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz) call writediagfi(ngrid,"lscaledE","heat from largescale","W m-2",2,lscaledE) call writediagfi(ngrid,"madjdE","heat from moistadj","W m-2",2,madjdE) call writediagfi(ngrid,"qsatatm","atm qsat"," ",3,qsat) ! call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol) endif endif ! Temporary inclusions for heating diagnostics ! call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn) call writediagfi(ngrid,"zdtsw","SW heating","T s-1",3,zdtsw) call writediagfi(ngrid,"zdtlw","LW heating","T s-1",3,zdtlw) call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad) ! debugging !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat)) !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi) ! Output aerosols if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) & call writediagfi(ngrid,'CO2ice_reff','CO2ice_reff','m',3,reffrad(1,1,iaero_co2)) if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) & call writediagfi(ngrid,'H2Oice_reff','H2Oice_reff','m',3,reffrad(:,:,iaero_h2o)) if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) & call writediagfi(ngrid,'CO2ice_reffcol','CO2ice_reffcol','um kg m^-2',2,reffcol(1,iaero_co2)) if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) & call writediagfi(ngrid,'H2Oice_reffcol','H2Oice_reffcol','um kg m^-2',2,reffcol(1,iaero_h2o)) ! Output tracers if (tracer) then do iq=1,nq call writediagfi(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) ! call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & ! 'kg m^-2',2,qsurf(1,iq) ) call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 'kg m^-2',2,qsurf_hist(1,iq) ) call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 'kg m^-2',2,qcol(1,iq) ) if(watercond.or.CLFvarying)then call writediagfi(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man) call writediagfi(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc) call writediagfi(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac) call writediagfi(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac) call writediagfi(ngrid,"RH","relative humidity"," ",3,RH) endif if(waterrain)then call writediagfi(ngrid,"rain","rainfall","kg m-2 s-1",2,zdqsrain) call writediagfi(ngrid,"snow","snowfall","kg m-2 s-1",2,zdqssnow) endif if((hydrology).and.(.not.ok_slab_ocean))then call writediagfi(ngrid,"hice","oceanic ice height","m",2,hice) endif if(ice_update)then call writediagfi(ngrid,"ice_min","min annual ice","m",2,ice_min) call writediagfi(ngrid,"ice_ini","initial annual ice","m",2,ice_initial) endif do ig=1,ngrid if(tau_col(ig).gt.1.e3)then ! print*,'WARNING: tau_col=',tau_col(ig) ! print*,'at ig=',ig,'in PHYSIQ' endif end do call writediagfi(ngrid,"tau_col","Total aerosol optical depth","[]",2,tau_col) enddo endif ! output spectrum if(specOLR.and.corrk)then call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W/m^2/cm^-1",3,OLR_nu) call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W/m^2/cm^-1",3,OSR_nu) endif icount=icount+1 if (lastcall) then ! deallocate gas variables IF ( ALLOCATED( gnom ) ) DEALLOCATE( gnom ) IF ( ALLOCATED( gfrac ) ) DEALLOCATE( gfrac ) ! both allocated in su_gases.F90 ! deallocate saved arrays ! this is probably not that necessary ! ... but probably a good idea to clean the place before we leave IF ( ALLOCATED(tsurf)) DEALLOCATE(tsurf) IF ( ALLOCATED(tsoil)) DEALLOCATE(tsoil) IF ( ALLOCATED(albedo)) DEALLOCATE(albedo) IF ( ALLOCATED(albedo0)) DEALLOCATE(albedo0) IF ( ALLOCATED(rnat)) DEALLOCATE(rnat) IF ( ALLOCATED(emis)) DEALLOCATE(emis) IF ( ALLOCATED(dtrad)) DEALLOCATE(dtrad) IF ( ALLOCATED(fluxrad_sky)) DEALLOCATE(fluxrad_sky) IF ( ALLOCATED(fluxrad)) DEALLOCATE(fluxrad) IF ( ALLOCATED(capcal)) DEALLOCATE(capcal) IF ( ALLOCATED(fluxgrd)) DEALLOCATE(fluxgrd) IF ( ALLOCATED(qsurf)) DEALLOCATE(qsurf) IF ( ALLOCATED(q2)) DEALLOCATE(q2) IF ( ALLOCATED(ztprevious)) DEALLOCATE(ztprevious) IF ( ALLOCATED(cloudfrac)) DEALLOCATE(cloudfrac) IF ( ALLOCATED(totcloudfrac)) DEALLOCATE(totcloudfrac) IF ( ALLOCATED(qsurf_hist)) DEALLOCATE(qsurf_hist) IF ( ALLOCATED(reffrad)) DEALLOCATE(reffrad) IF ( ALLOCATED(nueffrad)) DEALLOCATE(nueffrad) IF ( ALLOCATED(ice_initial)) DEALLOCATE(ice_initial) IF ( ALLOCATED(ice_min)) DEALLOCATE(ice_min) IF ( ALLOCATED(fluxsurf_lw)) DEALLOCATE(fluxsurf_lw) IF ( ALLOCATED(fluxsurf_sw)) DEALLOCATE(fluxsurf_sw) IF ( ALLOCATED(fluxtop_lw)) DEALLOCATE(fluxtop_lw) IF ( ALLOCATED(fluxabs_sw)) DEALLOCATE(fluxabs_sw) IF ( ALLOCATED(fluxtop_dn)) DEALLOCATE(fluxtop_dn) IF ( ALLOCATED(fluxdyn)) DEALLOCATE(fluxdyn) IF ( ALLOCATED(OLR_nu)) DEALLOCATE(OLR_nu) IF ( ALLOCATED(OSR_nu)) DEALLOCATE(OSR_nu) IF ( ALLOCATED(sensibFlux)) DEALLOCATE(sensibFlux) IF ( ALLOCATED(zdtlw)) DEALLOCATE(zdtlw) IF ( ALLOCATED(zdtsw)) DEALLOCATE(zdtsw) IF ( ALLOCATED(tau_col)) DEALLOCATE(tau_col) !! this is defined in comsaison_h IF ( ALLOCATED(mu0)) DEALLOCATE(mu0) IF ( ALLOCATED(fract)) DEALLOCATE(fract) !! this is defined in radcommon_h IF ( ALLOCATED(eclipse)) DEALLOCATE(eclipse) !! this is defined in comsoil_h IF ( ALLOCATED(layer)) DEALLOCATE(layer) IF ( ALLOCATED(mlayer)) DEALLOCATE(mlayer) IF ( ALLOCATED(inertiedat)) DEALLOCATE(inertiedat) !! this is defined in surfdat_h IF ( ALLOCATED(albedodat)) DEALLOCATE(albedodat) IF ( ALLOCATED(phisfi)) DEALLOCATE(phisfi) IF ( ALLOCATED(zmea)) DEALLOCATE(zmea) IF ( ALLOCATED(zstd)) DEALLOCATE(zstd) IF ( ALLOCATED(zsig)) DEALLOCATE(zsig) IF ( ALLOCATED(zgam)) DEALLOCATE(zgam) IF ( ALLOCATED(zthe)) DEALLOCATE(zthe) IF ( ALLOCATED(dryness)) DEALLOCATE(dryness) IF ( ALLOCATED(watercaptag)) DEALLOCATE(watercaptag) !! this is defined in tracer_h IF ( ALLOCATED(noms)) DEALLOCATE(noms) IF ( ALLOCATED(mmol)) DEALLOCATE(mmol) IF ( ALLOCATED(radius)) DEALLOCATE(radius) IF ( ALLOCATED(rho_q)) DEALLOCATE(rho_q) IF ( ALLOCATED(qext)) DEALLOCATE(qext) IF ( ALLOCATED(alpha_lift)) DEALLOCATE(alpha_lift) IF ( ALLOCATED(alpha_devil)) DEALLOCATE(alpha_devil) IF ( ALLOCATED(qextrhor)) DEALLOCATE(qextrhor) IF ( ALLOCATED(igcm_dustbin)) DEALLOCATE(igcm_dustbin) !! this is defined in comgeomfi_h IF ( ALLOCATED(lati)) DEALLOCATE(lati) IF ( ALLOCATED(long)) DEALLOCATE(long) IF ( ALLOCATED(area)) DEALLOCATE(area) IF ( ALLOCATED(sinlat)) DEALLOCATE(sinlat) IF ( ALLOCATED(coslat)) DEALLOCATE(coslat) IF ( ALLOCATED(sinlon)) DEALLOCATE(sinlon) IF ( ALLOCATED(coslon)) DEALLOCATE(coslon) endif return end subroutine physiq