! ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $ ! SUBROUTINE radlwsw(dist, rmu0, fract, . paprs, pplay,tsol, t, . heat,cool,radsol, . topsw,toplw,solsw,sollw, . sollwdown, . lwnet, swnet) c c====================================================================== c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 c Objet: interface entre le modele et les rayonnements c Arguments: 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 solaire--input-R- constante solaire (W/m**2) (dans clesphys.h) c paprs----input-R- pression a inter-couche (Pa) c pplay----input-R- pression au milieu de couche (Pa) c tsol-----input-R- temperature du sol (en K) c t--------input-R- temperature (K) c heat-----output-R- echauffement atmospherique (visible) (K/jour) c cool-----output-R- refroidissement dans l'IR (K/jour) c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas) c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas) c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut) c solsw----output-R- flux solaire net a la surface (+ vers le bas) c sollw----output-R- ray. IR net a la surface (+ vers le bas) c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas) c lwnet____output-R- flux IR net (+ vers le haut) c swnet____output-R- flux solaire net (+ vers le bas) c c====================================================================== use dimphy IMPLICIT none #include "dimensions.h" c real rmu0(klon), fract(klon), dist #include "clesphys.h" c real paprs(klon,klev+1), pplay(klon,klev) real tsol(klon) real t(klon,klev) real heat(klon,klev), cool(klon,klev) real radsol(klon), topsw(klon), toplw(klon) real solsw(klon), sollw(klon) real sollwdown(klon) REAL swnet(klon,kflev+1),lwnet(klon,kflev+1) c #include "YOMCST.h" c INTEGER k, kk, i, j, nb_gr c REAL PSCT c REAL PDT0 REAL PPSOL REAL PTL(kflev+1), PPB(kflev+1) REAL PTAVE(kflev) c REAL zfract, zrmu0, zdist c REAL zheat(kflev), zcool(kflev) REAL ZFSNET(KFLEV+1),ZFLNET(KFLEV+1) REAL ztopsw, ztoplw REAL zsolsw, zsollw cIM BEG REAL zsollwdown cIM END REAL zznormcp c REAL zx_alpha1, zx_alpha2 c c------------------------------------------- nb_gr = klon c------------------------------------------- c Initialisations c----------------- DO k = 1, klev DO i = 1, klon heat(i,k)=0. cool(i,k)=0. ENDDO ENDDO c zdist = dist c c PRINT*,'IMradlwsw : solaire= ', solaire c PSCT = solaire/zdist/zdist c c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++ DO 99999 j = 1, nb_gr DO k = 1, klev zheat(k) = 0.0 zcool(k) = 0.0 ENDDO DO k = 1, klev+1 ZFLNET(k) = 0.0 ZFSNET(k) = 0.0 ENDDO ztopsw = 0.0 ztoplw = 0.0 zsolsw = 0.0 zsollw = 0.0 zsollwdown = 0.0 zfract = fract(j) zrmu0 = rmu0(j) PPSOL = paprs(j,1) zx_alpha1 = (paprs(j,1)-pplay(j,2)) . / (pplay(j,1)-pplay(j,2)) zx_alpha2 = 1.0 - zx_alpha1 PTL(1) = t(j,1) * zx_alpha1 + t(j,2) * zx_alpha2 PTL(klev+1) = t(j,klev) PDT0 = tsol(j) - PTL(1) DO k = 2, kflev PTL(k) = (t(j,k)+t(j,k-1))*0.5 ENDDO DO k = 1, kflev PTAVE(k) = t(j,k) ENDDO c DO k = 1, kflev PPB(k) = paprs(j,k)/1.e5 ENDDO c PPB(kflev+1) = pplay(j,kflev)/2.e5 ! pour eviter le 0. (=paprs(j,kflev+1)) PPB(kflev+1) = paprs(j,kflev)/1.e9 ! pour eviter le 0. (=paprs(j,kflev+1)) c c====================================================================== c LW call c--------- CALL LW_venus_ve( . PPB, PTAVE, tsol(j), . zcool, . ztoplw,zsollw, . zsollwdown,ZFLNET) c--------- c SW call c--------- CALL SW_venus_dc(zrmu0, zfract, S PPB, S zheat, S ztopsw,zsolsw,ZFSNET) c====================================================================== radsol(j) = zsolsw - zsollw ! + vers bas topsw(j) = ztopsw ! + vers bas toplw(j) = ztoplw ! + vers haut solsw(j) = zsolsw ! + vers bas sollw(j) = -zsollw ! + vers bas sollwdown(j) = zsollwdown ! + vers bas DO k = 1, kflev+1 lwnet (j,k) = ZFLNET(k) swnet (j,k) = ZFSNET(k) ENDDO DO k = 1, kflev C scale factor to take into account the difference between C dry air and watter vapour scpecific heat capacity zznormcp=1.0 heat (j,k) = zheat(k)/zznormcp cool (j,k) = zcool(k)/zznormcp ENDDO c 99999 CONTINUE c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++ c tests c j = klon/2 c j = 1 c print*,'mu0=',rmu0(j) c print*,' net flux vis HEAT(K/day)' c do k=1,kflev c print*,k,ZFSNET(k),heat(j,k)*8.56548e-3 c enddo c print*,' net flux IR COOL(K/day)' c do k=1,kflev c print*,k,ZFLNET(k),cool(j,k)*8.56548e-3 c enddo RETURN END