source: trunk/LMDZ.TITAN.old/libf/phytitan/heating.F @ 3094

Last change on this file since 3094 was 1461, checked in by emillour, 10 years ago

Titan GCM:
Turned the common block "tgmdat.F" into a module "tgmdat_mod.F90".
This fixes issues in "debug" mode with common variables which seemed to not be correctly shared between routines.
EM

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