| 1 | SUBROUTINE heating(dist,rmu0,fract,sol_htg,swnet,icld) |
|---|
| 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 icld-----input-I- calcul avec nuages. |
|---|
| 19 | c p(klon,nl) pressure (level) |
|---|
| 20 | c |
|---|
| 21 | c Output: |
|---|
| 22 | c ------- |
|---|
| 23 | c sol_htg-----output-R- echauffement atmospherique (visible) (K/s) |
|---|
| 24 | c swnet-------output-R- flux solaire net (+ vers le bas) (W/m2) |
|---|
| 25 | c |
|---|
| 26 | c======================================================================= |
|---|
| 27 | c----------------------------------------------------------------------- |
|---|
| 28 | c Declarations: |
|---|
| 29 | c ------------- |
|---|
| 30 | |
|---|
| 31 | use dimphy |
|---|
| 32 | IMPLICIT NONE |
|---|
| 33 | #include "dimensions.h" |
|---|
| 34 | |
|---|
| 35 | INTEGER NLEVEL,NLAYER,NSPECV |
|---|
| 36 | PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1) |
|---|
| 37 | PARAMETER (NSPECV=24) |
|---|
| 38 | c |
|---|
| 39 | c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX |
|---|
| 40 | INTEGER ngrid |
|---|
| 41 | PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon |
|---|
| 42 | c |
|---|
| 43 | |
|---|
| 44 | c Arguments: |
|---|
| 45 | c ---------- |
|---|
| 46 | |
|---|
| 47 | |
|---|
| 48 | real dist, rmu0(klon), fract(klon) |
|---|
| 49 | integer icld |
|---|
| 50 | |
|---|
| 51 | real sol_htg(klon,klev) |
|---|
| 52 | real swnet(klon,klev+1) |
|---|
| 53 | |
|---|
| 54 | c Local: |
|---|
| 55 | c ------ |
|---|
| 56 | |
|---|
| 57 | INTEGER I,J,IG,K,IPRINT,ilat,nq |
|---|
| 58 | |
|---|
| 59 | c COMMONS for interface with local subroutines: |
|---|
| 60 | c --------------------------------------------- |
|---|
| 61 | |
|---|
| 62 | REAL UBARI,UBARV,UBAR0 |
|---|
| 63 | REAL CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL) |
|---|
| 64 | REAL XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER) |
|---|
| 65 | REAL FNETV(ngrid,NLEVEL),FUPV(ngrid,NLEVEL,NSPECV) |
|---|
| 66 | REAL FDV(ngrid,NLEVEL,NSPECV),FMNETV(ngrid,NLEVEL) |
|---|
| 67 | REAL CSUBP,RSFI,RSFV,F0PI |
|---|
| 68 | |
|---|
| 69 | COMMON /UBARED/ UBARI,UBARV,UBAR0 |
|---|
| 70 | |
|---|
| 71 | COMMON /GASS/ CH4,XN2 |
|---|
| 72 | & ,H2,AR |
|---|
| 73 | & ,XMU,GAS1 |
|---|
| 74 | & ,COLDEN |
|---|
| 75 | |
|---|
| 76 | COMMON /FLUXvV/ FNETV, |
|---|
| 77 | & FUPV, |
|---|
| 78 | & FDV, |
|---|
| 79 | & FMNETV |
|---|
| 80 | |
|---|
| 81 | COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI |
|---|
| 82 | |
|---|
| 83 | |
|---|
| 84 | c================================================================== |
|---|
| 85 | |
|---|
| 86 | fnetv = 0.0 |
|---|
| 87 | sol_htg= 0.0 |
|---|
| 88 | swnet = 0.0 |
|---|
| 89 | c pour sorties dans gfluxv... |
|---|
| 90 | iprint = 0 |
|---|
| 91 | |
|---|
| 92 | DO ig=1,klon |
|---|
| 93 | IF(fract(ig).LT.1.e-5) THEN |
|---|
| 94 | DO j=1,nlayer |
|---|
| 95 | sol_htg(ig,j)=0. |
|---|
| 96 | ENDDO |
|---|
| 97 | ELSE |
|---|
| 98 | ubar0=rmu0(ig) |
|---|
| 99 | |
|---|
| 100 | CALL sfluxv(iprint,ig,dist,icld) ! #3 |
|---|
| 101 | |
|---|
| 102 | fnetv(ig,:) = fnetv(ig,:) *fract(ig) ! >0 vers le haut |
|---|
| 103 | c >0 vers le bas + conversion en W/m2: |
|---|
| 104 | swnet(ig,:) = -1.e-3*fnetv(ig,:) |
|---|
| 105 | |
|---|
| 106 | DO j=1,nlayer |
|---|
| 107 | sol_htg(ig,j)= ! K/s |
|---|
| 108 | s (fnetv(ig,j+1)-fnetv(ig,j)) |
|---|
| 109 | s /(colden(j)*csubp) |
|---|
| 110 | ENDDO |
|---|
| 111 | ENDIF |
|---|
| 112 | ENDDO |
|---|
| 113 | |
|---|
| 114 | RETURN |
|---|
| 115 | 191 FORMAT(F8.2,1P10E10.2) |
|---|
| 116 | 192 FORMAT(a8,1P10E10.2) |
|---|
| 117 | END |
|---|
