| 1 | SUBROUTINE heating(dist,rmu0,fract,sol_htg,swnet) |
|---|
| 2 | |
|---|
| 3 | |
|---|
| 4 | c======================================================================= |
|---|
| 5 | c |
|---|
| 6 | c Object: Computation of the solar heating rate |
|---|
| 7 | c SOL_HTG(klon,klev) |
|---|
| 8 | c |
|---|
| 9 | c Arguments: |
|---|
| 10 | c ---------- |
|---|
| 11 | c |
|---|
| 12 | c Input: |
|---|
| 13 | c ------ |
|---|
| 14 | c |
|---|
| 15 | c dist-----input-R- distance astronomique terre-soleil |
|---|
| 16 | c rmu0-----input-R- cosinus de l'angle zenithal |
|---|
| 17 | c fract----input-R- duree d'ensoleillement normalisee |
|---|
| 18 | c p(klon,nl) pressure (level) |
|---|
| 19 | c |
|---|
| 20 | c Output: |
|---|
| 21 | c ------- |
|---|
| 22 | c sol_htg-----output-R- echauffement atmospherique (visible) (K/s) |
|---|
| 23 | c swnet-------output-R- flux solaire net (+ vers le bas) (W/m2) |
|---|
| 24 | c |
|---|
| 25 | c======================================================================= |
|---|
| 26 | c----------------------------------------------------------------------- |
|---|
| 27 | c Declarations: |
|---|
| 28 | c ------------- |
|---|
| 29 | |
|---|
| 30 | use dimphy |
|---|
| 31 | IMPLICIT NONE |
|---|
| 32 | #include "dimensions.h" |
|---|
| 33 | |
|---|
| 34 | INTEGER NLEVEL,NLAYER,NSPECV |
|---|
| 35 | PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1) |
|---|
| 36 | PARAMETER (NSPECV=24) |
|---|
| 37 | c |
|---|
| 38 | |
|---|
| 39 | c Arguments: |
|---|
| 40 | c ---------- |
|---|
| 41 | |
|---|
| 42 | |
|---|
| 43 | real dist, rmu0(klon), fract(klon) |
|---|
| 44 | |
|---|
| 45 | real sol_htg(klon,klev) |
|---|
| 46 | real swnet(klon,klev+1) |
|---|
| 47 | |
|---|
| 48 | c Local: |
|---|
| 49 | c ------ |
|---|
| 50 | |
|---|
| 51 | INTEGER I,J,IG,K,IPRINT,ilat,nq |
|---|
| 52 | |
|---|
| 53 | c COMMONS for interface with local subroutines: |
|---|
| 54 | c --------------------------------------------- |
|---|
| 55 | |
|---|
| 56 | REAL UBARI,UBARV,UBAR0 |
|---|
| 57 | REAL CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL) |
|---|
| 58 | REAL XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER) |
|---|
| 59 | REAL FNETV(klon,NLEVEL),FUPV(klon,NLEVEL,NSPECV) |
|---|
| 60 | REAL FDV(klon,NLEVEL,NSPECV),FMNETV(klon,NLEVEL) |
|---|
| 61 | REAL CSUBP,RSFI,RSFV,F0PI |
|---|
| 62 | |
|---|
| 63 | COMMON /UBARED/ UBARI,UBARV,UBAR0 |
|---|
| 64 | |
|---|
| 65 | COMMON /GASS/ CH4,XN2 |
|---|
| 66 | & ,H2,AR |
|---|
| 67 | & ,XMU,GAS1 |
|---|
| 68 | & ,COLDEN |
|---|
| 69 | |
|---|
| 70 | COMMON /FLUXvV/ FNETV, |
|---|
| 71 | & FUPV, |
|---|
| 72 | & FDV, |
|---|
| 73 | & FMNETV |
|---|
| 74 | |
|---|
| 75 | COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI |
|---|
| 76 | |
|---|
| 77 | |
|---|
| 78 | c================================================================== |
|---|
| 79 | |
|---|
| 80 | fnetv = 0.0 |
|---|
| 81 | sol_htg= 0.0 |
|---|
| 82 | swnet = 0.0 |
|---|
| 83 | c pour sorties dans gfluxv... |
|---|
| 84 | iprint = 0 |
|---|
| 85 | |
|---|
| 86 | DO ig=1,klon |
|---|
| 87 | IF(fract(ig).LT.1.e-5) THEN |
|---|
| 88 | DO j=1,nlayer |
|---|
| 89 | sol_htg(ig,j)=0. |
|---|
| 90 | ENDDO |
|---|
| 91 | ELSE |
|---|
| 92 | ubar0=rmu0(ig) |
|---|
| 93 | |
|---|
| 94 | CALL sfluxv(iprint,ig,dist) ! #3 |
|---|
| 95 | |
|---|
| 96 | fnetv(ig,:) = fnetv(ig,:) *fract(ig) ! >0 vers le haut |
|---|
| 97 | c >0 vers le bas + conversion en W/m2: |
|---|
| 98 | swnet(ig,:) = -1.e-3*fnetv(ig,:) |
|---|
| 99 | |
|---|
| 100 | DO j=1,nlayer |
|---|
| 101 | sol_htg(ig,j)= ! K/s |
|---|
| 102 | s (fnetv(ig,j+1)-fnetv(ig,j)) |
|---|
| 103 | s /(colden(j)*csubp) |
|---|
| 104 | ENDDO |
|---|
| 105 | ENDIF |
|---|
| 106 | ENDDO |
|---|
| 107 | |
|---|
| 108 | RETURN |
|---|
| 109 | 191 FORMAT(F8.2,1P10E10.2) |
|---|
| 110 | 192 FORMAT(a8,1P10E10.2) |
|---|
| 111 | END |
|---|
