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

Last change on this file since 4208 was 4205, checked in by dubos, 6 years ago

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