[175] | 1 | SUBROUTINE heating(dist,rmu0,fract,sol_htg,swnet,icld) |
---|
[3] | 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 |
---|
[175] | 18 | c icld-----input-I- calcul avec nuages. |
---|
[3] | 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 | |
---|
[102] | 31 | use dimphy |
---|
| 32 | IMPLICIT NONE |
---|
[3] | 33 | #include "dimensions.h" |
---|
| 34 | |
---|
| 35 | INTEGER NLEVEL,NLAYER,NSPECV |
---|
| 36 | PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1) |
---|
| 37 | PARAMETER (NSPECV=24) |
---|
| 38 | c |
---|
[104] | 39 | c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX |
---|
| 40 | INTEGER ngrid |
---|
| 41 | PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon |
---|
| 42 | c |
---|
[3] | 43 | |
---|
| 44 | c Arguments: |
---|
| 45 | c ---------- |
---|
| 46 | |
---|
| 47 | |
---|
| 48 | real dist, rmu0(klon), fract(klon) |
---|
[175] | 49 | integer icld |
---|
[3] | 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) |
---|
[104] | 65 | REAL FNETV(ngrid,NLEVEL),FUPV(ngrid,NLEVEL,NSPECV) |
---|
| 66 | REAL FDV(ngrid,NLEVEL,NSPECV),FMNETV(ngrid,NLEVEL) |
---|
[3] | 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 | |
---|
[175] | 100 | CALL sfluxv(iprint,ig,dist,icld) ! #3 |
---|
[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 |
---|