source: dynamico_lmdz/simple_physics/phyparam/physics/radiative_sw.F90 @ 4217

Last change on this file since 4217 was 4210, checked in by dubos, 6 years ago

simple_physics : cleanup PRINTs
File size: 7.3 KB
Line 
1MODULE radiative_sw
2
3#include "use_logging.h"
4
5  IMPLICIT NONE
6  SAVE
7 
8  PRIVATE
9
10  PUBLIC :: sw
11
12CONTAINS
13 
14  PURE SUBROUTINE monGATHER(n,a,b,index)     
15    INTEGER, INTENT(IN) ::  n,index(n)
16    REAL, INTENT(IN) :: b(n)
17    REAL, INTENT(OUT) :: a(n)
18    INTEGER :: i
19
20    DO i=1,n
21       a(i)=b(index(i))
22    END DO
23  END SUBROUTINE monGATHER
24
25  PURE subroutine monscatter(n,a,index,b)
26    INTEGER, INTENT(IN) :: n,index(n)
27    REAL, INTENT(IN) :: b(n)
28    REAL, INTENT(OUT) :: a(n)
29    INTEGER :: i
30    DO i=1,n
31       a(index(i))=b(i)
32    END DO
33  end subroutine monscatter
34 
35  SUBROUTINE sw(ngrid,nlayer,ldiurn, &
36       coefvis,albedo, &
37       plevel,ps_rad,pmu,pfract,psolarf0, &
38       fsrfvis,dtsw, &
39       lwrite)
40    USE phys_const, ONLY : cpp, g
41    !=======================================================================
42    !
43    !   Rayonnement solaire en atmosphere non diffusante avec un
44    !   coefficient d'absoprption gris.
45    !
46    !=======================================================================
47    !
48    !   declarations:
49    !   -------------
50    !
51    !
52    !   arguments:
53    !   ----------
54    !
55    INTEGER ngrid,nlayer
56    REAL albedo(ngrid),coefvis
57    REAL pmu(ngrid),pfract(ngrid)
58    REAL plevel(ngrid,nlayer+1),ps_rad
59    REAL psolarf0
60    REAL fsrfvis(ngrid),dtsw(ngrid,nlayer)
61    LOGICAL lwrite,ldiurn
62    !
63    !   variables locales:
64    !   ------------------
65    !
66   
67    REAL zalb(ngrid),zmu(ngrid),zfract(ngrid)
68    REAL zplev(ngrid,nlayer+1)
69    REAL zflux(ngrid),zdtsw(ngrid,nlayer)
70   
71    INTEGER ig,l,nlevel,index(ngrid),ncount,igout
72    REAL ztrdir(ngrid,nlayer+1),ztrref(ngrid,nlayer+1)
73    REAL zfsrfref(ngrid)
74    REAL z1(ngrid)
75    REAL zu(ngrid,nlayer+1)
76    REAL tau0
77   
78    !-----------------------------------------------------------------------
79    !   1. initialisations:
80    !   -------------------
81   
82   
83    nlevel=nlayer+1
84   
85    !-----------------------------------------------------------------------
86    !   Definitions des tableaux locaux pour les points ensoleilles:
87    !   ------------------------------------------------------------
88   
89    IF (ldiurn) THEN
90       ncount=0
91       DO ig=1,ngrid
92          index(ig)=0
93       ENDDO
94       DO ig=1,ngrid
95          IF(pfract(ig).GT.1.e-6) THEN
96             ncount=ncount+1
97             index(ncount)=ig
98          ENDIF
99       ENDDO
100       CALL monGATHER(ncount,zfract,pfract,index)
101       CALL monGATHER(ncount,zmu,pmu,index)
102       CALL monGATHER(ncount,zalb,albedo,index)
103       DO l=1,nlevel
104          CALL monGATHER(ncount,zplev(1,l),plevel(1,l),index)
105       ENDDO
106    ELSE
107       ncount=ngrid
108       zfract(:)=pfract(:)
109       zmu(:)=pmu(:)
110       zalb(:)=albedo(:)
111       zplev(:,:)=plevel(:,:)
112    ENDIF
113   
114    !-----------------------------------------------------------------------
115    !   calcul des profondeurs optiques integres depuis p=0:
116    !   ----------------------------------------------------
117   
118    tau0=-.5*log(coefvis)
119   
120    ! calcul de la partie homogene de l'opacite
121    tau0=tau0/ps_rad
122    DO l=1,nlayer+1
123       DO ig=1,ncount
124          zu(ig,l)=tau0*zplev(ig,l)
125       ENDDO
126    ENDDO
127   
128    !-----------------------------------------------------------------------
129    !   2. calcul de la transmission depuis le sommet de l'atmosphere:
130    !   -----------------------------------------------------------
131   
132    DO l=1,nlevel
133       DO ig=1,ncount
134          ztrdir(ig,l)=exp(-zu(ig,l)/zmu(ig))
135       ENDDO
136    ENDDO
137   
138    IF (lwrite) THEN
139       igout=ncount/2+1
140       WRITELOG(*,*)
141       WRITELOG(*,*) 'Diagnostique des transmission dans le spectre solaire'
142       WRITELOG(*,*) 'zfract, zmu, zalb'
143       WRITELOG(*,*) zfract(igout), zmu(igout), zalb(igout)
144       WRITELOG(*,*) 'Pression, quantite d abs, transmission'
145       DO l=1,nlayer+1
146          WRITELOG(*,*) zplev(igout,l),zu(igout,l),ztrdir(igout,l)
147       ENDDO
148    ENDIF
149   
150    !-----------------------------------------------------------------------
151    !   3. taux de chauffage, ray. solaire direct:
152    !   ------------------------------------------
153   
154    DO l=1,nlayer
155       DO ig=1,ncount
156          zdtsw(ig,l)=g*psolarf0*zfract(ig)*zmu(ig)*      &
157               (ztrdir(ig,l+1)-ztrdir(ig,l))/    &
158               (cpp*(zplev(ig,l)-zplev(ig,l+1)))
159       ENDDO
160    ENDDO
161    IF (lwrite) THEN
162       WRITELOG(*,*)
163       WRITELOG(*,*) 'Diagnostique des taux de chauffage solaires:'
164       WRITELOG(*,*) ' 1 taux de chauffage lie au ray. solaire  direct'
165       DO l=1,nlayer
166          WRITELOG(*,*) zdtsw(igout,l)
167       ENDDO
168    ENDIF
169   
170   
171    !-----------------------------------------------------------------------
172    !   4. calcul du flux solaire arrivant sur le sol:
173    !   ----------------------------------------------
174   
175    DO ig=1,ncount
176       z1(ig)=zfract(ig)*zmu(ig)*psolarf0*ztrdir(ig,1)
177       zflux(ig)=(1.-zalb(ig))*z1(ig)
178       zfsrfref(ig)=    zalb(ig)*z1(ig)
179    ENDDO
180    IF (lwrite) THEN
181       WRITELOG(*,*)
182       WRITELOG(*,*) 'Diagnostique des taux de chauffage solaires:'
183       WRITELOG(*,*) ' 2 flux solaire net incident sur le sol'
184       WRITELOG(*,*) zflux(igout)
185    ENDIF
186   
187   
188    !-----------------------------------------------------------------------
189    !   5.calcul des traansmissions depuis le sol, cas diffus:
190    !   ------------------------------------------------------
191   
192    DO l=1,nlevel
193       DO ig=1,ncount
194          ztrref(ig,l)=exp(-(zu(ig,1)-zu(ig,l))*1.66)
195       ENDDO
196    ENDDO
197   
198    IF (lwrite) THEN
199       WRITELOG(*,*)
200       WRITELOG(*,*) 'Diagnostique des taux de chauffage solaires'
201       WRITELOG(*,*) ' 3 transmission avec les sol'
202       WRITELOG(*,*) 'niveau     transmission'
203       DO l=1,nlevel
204          WRITELOG(*,*) l,ztrref(igout,l)
205       ENDDO
206    ENDIF
207   
208    !-----------------------------------------------------------------------
209    !   6.ajout a l'echauffement de la contribution du ray. sol. reflechit:
210    !   -------------------------------------------------------------------
211   
212    DO l=1,nlayer
213       DO ig=1,ncount
214          zdtsw(ig,l)=zdtsw(ig,l)+ &
215               g*zfsrfref(ig)*(ztrref(ig,l+1)-ztrref(ig,l))/ &
216               (cpp*(zplev(ig,l+1)-zplev(ig,l)))
217       ENDDO
218    ENDDO
219   
220    !-----------------------------------------------------------------------
221    !   10. sorites eventuelles:
222    !   ------------------------
223   
224    IF (lwrite) THEN
225       WRITELOG(*,*)
226       WRITELOG(*,*) 'Diagnostique des taux de chauffage solaires:'
227       WRITELOG(*,*) ' 3 taux de chauffage total'
228       DO l=1,nlayer
229          WRITELOG(*,*) zdtsw(igout,l)
230       ENDDO
231    ENDIF
232   
233    IF (ldiurn) THEN
234       fsrfvis(:)=0.
235       CALL monscatter(ncount,fsrfvis,index,zflux)
236       dtsw(:,:)=0.
237       DO l=1,nlayer
238          CALL monscatter(ncount,dtsw(1,l),index,zdtsw(1,l))
239       ENDDO
240    ELSE
241       WRITELOG(*,*) 'NOT DIURNE'
242       fsrfvis(:)=zflux(:)
243       dtsw(:,:)=zdtsw(:,:)
244    ENDIF
245    !        call dump2d(iim,jjm-1,zflux(2),'ZFLUX      ')
246    !        call dump2d(iim,jjm-1,fsrfvis(2),'FSRVIS     ')
247    !        call dump2d(iim,jjm-1,ztrdir(2,1),'ztrdir     ')
248    !        call dump2d(iim,jjm-1,pmu(2),'pmu        ')
249    !        call dump2d(iim,jjm-1,pfract(2),'pfract     ')
250    !        call dump2d(iim,jjm-1,albedo(2),'albedo     ')
251    !        call dump2d(iim,jjm-1,ztrdir(2,1),'ztrdir     ')
252    LOG_INFO('rad_sw')
253   
254  END SUBROUTINE sw
255 
256END MODULE radiative_sw
257
Note: See TracBrowser for help on using the repository browser.