source: trunk/libf/phytitan/mucorr.F @ 124

      SUBROUTINE mucorr(npts,lon_sun, plat, pmu, pfract)
      IMPLICIT NONE

c=======================================================================
c
c   Calcul of equivalent solar angle and and fraction of day whithout 
c   diurnal cycle.
c
c   parmeters :
c   -----------
c
c      Input :
c      -------
c         npts             number of points
c         lon_sun          solar longitude (radians!!)
c         plat(npts)       latitude (en degres)
c
c      Output :
c      --------
c         pmu(npts)          equivalent cosinus of the solar angle
c         pfract(npts)       fractionnal day
c
c=======================================================================

c-----------------------------------------------------------------------
c
c    0. Declarations :
c    -----------------

#include "YOMCST.h"
#include "comorbit.h"

c     Arguments :
c     -----------
      INTEGER npts
      REAL plat(npts),pmu(npts), pfract(npts)
      REAL lon_sun
c
c     Local variables :
c     -----------------
      INTEGER j
      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
      REAL ap,a,t,b,tp
      real pdeclin,incl

c-----------------------------------------------------------------------

c verifs
c     print*,"LATITUDES=",plat(1),plat(npts/2),plat(npts)
c     print*,"zls=",lon_sun*180/RPI

      incl=obliquit * RPI / 180.                ! obliquite en radian
      pdeclin = ASIN (SIN(lon_sun)*SIN(incl) ) ! declin en radian
c     print*,'npts,pdeclin',npts,pdeclin*180./RPI
      z = pdeclin
      cz = cos (z)
      sz = sin (z)
c      print*,'cz,sz',cz,sz

      DO 20 j = 1, npts

         phi = plat(j)*RPI/180.  ! latitude en radian
         cphi = cos(phi)
         if (cphi.le.1.e-9) cphi=1.e-9
         sphi = sin(phi)
         tphi = sphi / cphi
         b = cphi * cz
         t = -tphi * sz / cz
         a = 1.0 - t*t
         ap = a

         IF(t.eq.0.) then
            t=0.5*RPI
         ELSE
            IF (a.lt.0.) a = 0.
            t = sqrt(a) / t
            IF (t.lt.0.) then
               tp = -atan (-t) + RPI
            ELSE
               tp = atan(t)
            ENDIF
            t = tp
         ENDIF
   
         pmu(j) = (sphi*sz*t) / RPI + b*sin(t)/RPI
         pfract(j) = t / RPI
         IF (ap .lt.0.) then
            pmu(j) = sphi * sz
            pfract(j) = 1.0
         ENDIF

         IF (pmu(j).le.0.0) pmu(j) = 0.0
         pmu(j) = pmu(j) / pfract(j)
         IF (pmu(j).eq.0.) pfract(j) = 0.

   20 CONTINUE
c        call dump2d(48,31,pfract(2),'FRACT      ')
c        call dump2d(48,31,pmu(2),'MU0        ')
c        stop
                                  
c-----------------------------------------------------------------------
c   correction de rotondite:
c   ------------------------

c        print*,'dans mucorr avant correction rotondite'
c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
c        print*,'pfract(1)=',pfract(1),' pfract(npts/2)=',pfract(npts/2)
         
      DO 30 j=1,npts
c !!!!!!
         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
30    CONTINUE

c        print*,'dans mucorr apres correction rotondite'
c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
         
c     print*,"pmu=",pmu(1),pmu(npts/2),pmu(npts)
c     print*,"pfract=",pfract(1),pfract(npts/2),pfract(npts)
      RETURN
      END