SUBROUTINE heating(dist,rmu0,fract,falbe,sol_htg,swnet,icld) c======================================================================= c c Object: Computation of the solar heating rate c SOL_HTG(klon,klev) c c Arguments: c ---------- c c Input: c ------ c c dist-----input-R- distance astronomique terre-soleil c rmu0-----input-R- cosinus de l'angle zenithal c fract----input-R- duree d'ensoleillement normalisee c falbe----input-R- surface albedo c icld-----input-I- calcul avec nuages. c p(klon,nl) pressure (level) c c Output: c ------- c sol_htg-----output-R- echauffement atmospherique (visible) (K/s) c swnet-------output-R- flux solaire net (+ vers le bas) (W/m2) c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- use dimphy IMPLICIT NONE #include "dimensions.h" INTEGER NLEVEL,NLAYER,NSPECV PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1) PARAMETER (NSPECV=24) c c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX INTEGER ngrid PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon c c Arguments: c ---------- real dist, rmu0(klon), fract(klon), falbe(klon) integer icld real sol_htg(klon,klev) real swnet(klon,klev+1) c Local: c ------ INTEGER I,J,IG,K,IPRINT,ilat,nq c COMMONS for interface with local subroutines: c --------------------------------------------- REAL UBARI,UBARV,UBAR0 REAL CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL) REAL XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER) REAL FNETV(ngrid,NLEVEL),FUPV(ngrid,NLEVEL,NSPECV) REAL FDV(ngrid,NLEVEL,NSPECV),FMNETV(ngrid,NLEVEL) REAL CSUBP,F0PI COMMON /UBARED/ UBARI,UBARV,UBAR0 COMMON /GASS/ CH4,XN2 & ,H2,AR & ,XMU,GAS1 & ,COLDEN COMMON /FLUXvV/ FNETV, & FUPV, & FDV, & FMNETV COMMON /PLANT/ CSUBP,F0PI c================================================================== fnetv = 0.0 sol_htg= 0.0 swnet = 0.0 c pour sorties dans gfluxv... iprint = 0 DO ig=1,klon IF(fract(ig).LT.1.e-5) THEN DO j=1,nlayer sol_htg(ig,j)=0. ENDDO ELSE ubar0=rmu0(ig) CALL sfluxv(iprint,ig,dist,falbe,icld) ! #3 fnetv(ig,:) = fnetv(ig,:) *fract(ig) ! >0 vers le haut c >0 vers le bas + conversion en W/m2: swnet(ig,:) = -1.e-3*fnetv(ig,:) DO j=1,nlayer sol_htg(ig,j)= ! K/s s (fnetv(ig,j+1)-fnetv(ig,j)) s /(colden(j)*csubp) ENDDO ENDIF ENDDO RETURN 191 FORMAT(F8.2,1P10E10.2) 192 FORMAT(a8,1P10E10.2) END