source: trunk/LMDZ.GENERIC/libf/phystd/mucorr.F @ 1243

Last change on this file since 1243 was 1174, checked in by sglmd, 11 years ago

Calculation of the insolation for a flattened planet. New keyword flatten =(a-b)/a (default value =0.).

File size: 2.8 KB
RevLine 
[1174]1      SUBROUTINE mucorr(npts,pdeclin, plat, pmu,pfract,phaut,prad,pflat)
[135]2      IMPLICIT NONE
3
4c=======================================================================
5c
6c   Calcul of equivalent solar angle and and fraction of day whithout
7c   diurnal cycle.
8c
9c   parmeters :
10c   -----------
11c
12c      Input :
13c      -------
14c         npts             number of points
15c         pdeclin          solar declinaison
16c         plat(npts)        latitude
17c         phaut            hauteur typique de l'atmosphere
18c         prad             rayon planetaire
19c
20c      Output :
21c      --------
22c         pmu(npts)          equivalent cosinus of the solar angle
23c         pfract(npts)       fractionnal day
24c
25c=======================================================================
26
27c-----------------------------------------------------------------------
28c
29c    0. Declarations :
30c    -----------------
31
32c     Arguments :
33c     -----------
34      INTEGER npts
35      REAL plat(npts),pmu(npts), pfract(npts)
[1174]36      REAL phaut,prad,pdeclin, pflat
[135]37c
38c     Local variables :
39c     -----------------
40      INTEGER j
41      REAL pi
42      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
[1174]43      REAL ap,a,t,b, tp, rap
[135]44      REAL alph
45
46c-----------------------------------------------------------------------
47
[1174]48c----- SG: geometry adapted to a flattened planet (Feb2014)
49
[135]50      pi = 4. * atan(1.0)
51      z = pdeclin
52      cz = cos (z)
53      sz = sin (z)
[1174]54      rap = 1./((1.-pflat)**2)
[135]55
56      DO 20 j = 1, npts
57
58         phi = plat(j)
59         cphi = cos(phi)
60         if (cphi.le.1.e-9) cphi=1.e-9
61         sphi = sin(phi)
62         tphi = sphi / cphi
63         b = cphi * cz
[1174]64         t = -rap*tphi * sz / cz
[135]65         a = 1.0 - t*t
66         ap = a
67   
68         IF(t.eq.0.) then
69            tp=0.5*pi
70         ELSE
71            IF (a.lt.0.) a = 0.
72            t = sqrt(a) / t
73            IF (t.lt.0.) then
74               tp = -atan (-t) + pi
75            ELSE
76               tp = atan(t)
77            ENDIF
78         ENDIF
79         t = tp
80   
[1174]81         pmu(j) = (sphi*sz*t*rap) / pi + b*sin(t)/pi
[135]82         pfract(j) = t / pi
83         IF (ap .lt.0.) then
[1174]84            pmu(j) = sphi * sz*rap
[135]85            pfract(j) = 1.0
86         ENDIF
87         IF (pmu(j).le.0.0) pmu(j) = 0.0
88         pmu(j) = pmu(j) / pfract(j)
89         IF (pmu(j).eq.0.) pfract(j) = 0.
90
[1174]91         pmu(j)=pmu(j)/SQRT(cphi**2 + (rap**2) * (sphi**2))
92
[135]93   20 CONTINUE
94
95c-----------------------------------------------------------------------
96c   correction de rotondite:
97c   ------------------------
98
[1152]99      ! condition added to avoid errors when rad is not set (e.g. 1D runs)
100      IF (prad.ne.0) THEN
101 
[135]102      alph=phaut/prad
103      DO 30 j=1,npts
104c !!!!!!
[1152]105 !!!!!!! AS: how generic is this???
[135]106         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
107c    $          (sqrt(alph*alph*pmu(j)*pmu(j)+2.*alph+1.)-alph*pmu(j))
10830    CONTINUE
109
[1152]110      ENDIF
111
[135]112      RETURN
113      END
Note: See TracBrowser for help on using the repository browser.