SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/oi

Go to the documentation of this file.
00001 SUBROUTINE OI_TSL(IDAT,NSSSSS,PLAT,PLON,PMU0,PMU0M,IH)
00002 !-----------------------------------------------------------------------
00003 !
00004 !     Computation of solar zenith angle 
00005 !     ---------------------------------
00006 !
00007 !     INPUT PARAMETERS :
00008 !
00009 !     IDAT    : DATE in the following form => YYYYMMDD
00010 !     NSSSSS  : TIME of the day in seconds
00011 !     PLAT    : LATITUDE  in Degrees
00012 !     PLON    : LONGITUDE in Degrees
00013 !
00014 !     OUTPUT PARAMETERS :
00015 !
00016 !     PMU0    : Cosine of solar zenith angle
00017 !     PMU0M   : Cosine of solar zenith angle (mean value)
00018 !     IH      : local time (hour)
00019 !
00020 !
00021 !     J.F. Mahfouf (4/12/97) from IFS/ARPEGE routines
00022 !                 
00023 !
00024 !     23/05/2009 : Fortran 90 recoding (IMPLICIT NONE + FUNCTIONS)
00025 !
00026 !-----------------------------------------------------------------------
00027 !
00028 ! - Astronomical functions
00029 !   you will find the description in the annex 1 of the documentation
00030 !   RRS is the distance Sun-Earth
00031 !   RDS is the declination of the Earth
00032 !   RET is the equation of time
00033 ! 
00034  USE MODD_CSTS,       ONLY : XDAY, XPI
00035  USE MODD_ASSIM,      ONLY : REPSM, RCDTR, ITRAD
00036 !
00037 !
00038  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00039  USE PARKIND1  ,ONLY : JPRB
00040 !
00041  IMPLICIT NONE
00042 !
00043  INTEGER, INTENT(IN)  :: IDAT
00044  INTEGER, INTENT(IN)  :: NSSSSS 
00045  REAL, INTENT(IN)     :: PLAT, PLON
00046  REAL, INTENT(OUT)    :: PMU0, PMU0M
00047  INTEGER, INTENT(OUT) :: IH
00048 !
00049  REAL :: PGEMU,   PGELAM,  RTIMTR,  ZTETA,   RDECLI,  REQTIM, RHGMT,    RSOVR,   RWSOVR, 
00050           RCODEC,  RSIDEC,  RCOVSR,  RSIVSR,  RTIMTRM, ZTETAM,  RDECLIM, REQTIMM, RHGMTM, 
00051           RSOVRM,  RWSOVRM, RCODECM, RSIDECM, RCOVSRM, RSIVSRM, ZT  
00052  INTEGER :: ID, IM, IA, INSSSSS
00053  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00054 !
00055 !  Angle conversions 
00056 !      
00057  IF (LHOOK) CALL DR_HOOK('OI_TSL',0,ZHOOK_HANDLE)
00058  PGEMU=SIN(PLAT*XPI/180.)      ! sinus of latitude
00059  PGELAM=PLON*XPI/180.          ! longitude
00060 !      
00061  ID=NDD(IDAT)
00062  IM=NMM(IDAT)
00063  IA=NCCAA(IDAT)
00064  RTIMTR=RTIME(IA,IM,ID,NSSSSS)
00065  ZTETA=RTETA(RTIMTR)
00066  RDECLI=RDS(ZTETA)             ! declinaison
00067  REQTIM=RET(ZTETA)
00068  RHGMT=REAL(MOD(NSSSSS,NINT(XDAY)))
00069  RSOVR =REQTIM+RHGMT    
00070  RWSOVR=RSOVR*2.*XPI/XDAY      ! hour angle
00071 !      
00072  RCODEC=COS(RDECLI)
00073  RSIDEC=SIN(RDECLI)
00074 !
00075  RCOVSR=COS(RWSOVR)
00076  RSIVSR=SIN(RWSOVR)
00077 !      
00078  PMU0=MAX( RSIDEC*PGEMU  &
00079            -RCODEC*RCOVSR*SQRT(1.-PGEMU**2)*COS(PGELAM) &
00080            +RCODEC*RSIVSR*SQRT(1.-PGEMU**2)*SIN(PGELAM) , 0.)  
00081  IF (PMU0.GT.0.) THEN
00082    PMU0=SQRT(1224.*PMU0*PMU0 +1.)/35. ! Magnification factor
00083  ENDIF  
00084 !
00085 !     Mean angle over the previous 6 hours
00086 !     ------------------------------------
00087 !  
00088  RTIMTRM=RTIME(IA,IM,ID,NSSSSS-ITRAD)
00089  ZTETAM=RTETA(RTIMTRM)
00090  RDECLIM=RDS(ZTETAM)             ! declinaison
00091  REQTIMM=RET(ZTETAM)
00092  IF ((NSSSSS-ITRAD).LT.0) THEN
00093    INSSSSS=NSSSSS+86400
00094  ELSE
00095    INSSSSS=NSSSSS
00096  ENDIF  
00097  RHGMTM=REAL(MOD(INSSSSS-ITRAD,NINT(XDAY)))
00098  RSOVRM =REQTIMM+RHGMTM    
00099  RWSOVRM=RSOVRM*2.*XPI/XDAY      ! hour angle
00100 !      
00101  RCODECM=COS(RDECLIM)
00102  RSIDECM=SIN(RDECLIM)
00103 !
00104  RCOVSRM=COS(RWSOVRM)
00105  RSIVSRM=SIN(RWSOVRM)
00106 !     
00107  PMU0M=MAX( RSIDECM*PGEMU &
00108             -RCODECM*RCOVSRM*SQRT(1.-PGEMU**2)*COS(PGELAM) &
00109             +RCODECM*RSIVSRM*SQRT(1.-PGEMU**2)*SIN(PGELAM) , 0.)  
00110  IF (PMU0M.GT.0.) THEN
00111    PMU0M=SQRT(1224.*PMU0M*PMU0M +1.)/35. ! Magnification factor
00112  ENDIF  
00113 ! 
00114 !  Local time in hours
00115 !  Should be inside [1,24]
00116 !
00117  ZT = (NSSSSS + PLON*RCDTR*3600.)/3600.
00118  IF (ZT < 0.0)  ZT = ZT + 24.
00119  IF (ZT > 24.0) ZT = ZT - 24.
00120  IH = INT(ZT)
00121  IF ( IH == 0 ) IH=24 
00122 !
00123 IF (LHOOK) CALL DR_HOOK('OI_TSL',1,ZHOOK_HANDLE)
00124 CONTAINS
00125 !
00126 FUNCTION RTETA(PTIME)
00127  USE MODD_CSTS, ONLY : XDAY
00128  IMPLICIT NONE
00129  REAL, INTENT(IN) :: PTIME
00130  REAL             :: RTETA
00131  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00132  IF (LHOOK) CALL DR_HOOK('RTETA',0,ZHOOK_HANDLE)
00133  RTETA = PTIME/(XDAY*365.25)
00134 IF (LHOOK) CALL DR_HOOK('RTETA',1,ZHOOK_HANDLE)
00135 END FUNCTION RTETA
00136 !
00137 FUNCTION REL(PTETA)
00138  IMPLICIT NONE
00139  REAL, INTENT(IN) :: PTETA
00140  REAL             :: REL
00141  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00142  IF (LHOOK) CALL DR_HOOK('REL',0,ZHOOK_HANDLE)
00143  REL = 1.7535+6.283076*PTETA
00144 IF (LHOOK) CALL DR_HOOK('REL',1,ZHOOK_HANDLE)
00145 END FUNCTION REL
00146 !
00147 FUNCTION REM(PTETA)
00148  IMPLICIT NONE
00149  REAL, INTENT(IN) :: PTETA
00150  REAL             :: REM
00151  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00152  IF (LHOOK) CALL DR_HOOK('REM',0,ZHOOK_HANDLE)
00153  REM = 6.240075+6.283020*PTETA
00154 IF (LHOOK) CALL DR_HOOK('REM',1,ZHOOK_HANDLE)
00155 END FUNCTION REM
00156 !
00157 FUNCTION RLLS(PTETA)
00158  IMPLICIT NONE
00159  REAL, INTENT(IN) :: PTETA
00160  REAL             :: RLLS
00161  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00162  IF (LHOOK) CALL DR_HOOK('RLLS',0,ZHOOK_HANDLE)
00163  RLLS = 4.8951+6.283076*PTETA
00164 IF (LHOOK) CALL DR_HOOK('RLLS',1,ZHOOK_HANDLE)
00165 END FUNCTION RLLS
00166 !
00167 FUNCTION RLLLS(PTETA)
00168  IMPLICIT NONE
00169  REAL, INTENT(IN) :: PTETA
00170  REAL             :: RLLLS, REL
00171  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00172  IF (LHOOK) CALL DR_HOOK('RLLLS',0,ZHOOK_HANDLE)
00173  REL   = 1.7535+6.283076*PTETA
00174  RLLLS = 4.8952+6.283320*PTETA-0.0075*SIN(REL)  &
00175        -0.0326*COS(REL)-0.0003*SIN(2.*REL)+0.0002*COS(2.*REL)  
00176 IF (LHOOK) CALL DR_HOOK('RLLLS',1,ZHOOK_HANDLE)
00177 END FUNCTION RLLLS
00178 !
00179 FUNCTION RDS(PTETA)
00180  USE MODD_ASSIM, ONLY : REPSM
00181  IMPLICIT NONE
00182  REAL, INTENT(IN) :: PTETA
00183  REAL             :: RDS, RLLLS
00184  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00185  IF (LHOOK) CALL DR_HOOK('RDS',0,ZHOOK_HANDLE)
00186  RLLLS = 4.8952+6.283320*PTETA-0.0075*SIN(REL(PTETA))  &
00187          -0.0326*COS(REL(PTETA))-0.0003*SIN(2.*REL(PTETA)) &
00188          +0.0002*COS(2.*REL(PTETA))  
00189  RDS   = ASIN(SIN(REPSM)*SIN(RLLLS))
00190 IF (LHOOK) CALL DR_HOOK('RDS',1,ZHOOK_HANDLE)
00191 END FUNCTION RDS
00192 ! 
00193 FUNCTION RET(PTETA)
00194  IMPLICIT NONE
00195  REAL, INTENT(IN) :: PTETA
00196  REAL             :: RET, REM, RLLS
00197  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00198  IF (LHOOK) CALL DR_HOOK('RET',0,ZHOOK_HANDLE)
00199  REM  = 6.240075+6.283020*PTETA
00200  RLLS = 4.8951+6.283076*PTETA
00201  RET  = 591.8*SIN(2.*RLLS)-459.4*SIN(REM) &
00202         +39.5*SIN(REM)*COS(2.*RLLS) &
00203         -12.7*SIN(4.*RLLS)-4.8*SIN(2.*REM)  
00204 IF (LHOOK) CALL DR_HOOK('RET',1,ZHOOK_HANDLE)
00205 END FUNCTION RET
00206 !
00207 FUNCTION NDD(KGRDAT)
00208  IMPLICIT NONE
00209  INTEGER, INTENT(IN) :: KGRDAT
00210  INTEGER             :: NDD
00211  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00212  IF (LHOOK) CALL DR_HOOK('NDD',0,ZHOOK_HANDLE)
00213  NDD = MOD(KGRDAT,100)
00214 IF (LHOOK) CALL DR_HOOK('NDD',1,ZHOOK_HANDLE)
00215 END FUNCTION NDD
00216 !
00217 FUNCTION NMM(KGRDAT)
00218  IMPLICIT NONE
00219  INTEGER, INTENT(IN) :: KGRDAT
00220  INTEGER             :: NMM, NDD
00221  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00222  IF (LHOOK) CALL DR_HOOK('NMM',0,ZHOOK_HANDLE)
00223  NDD = MOD(KGRDAT,100)
00224  NMM = MOD((KGRDAT-NDD)/100,100)
00225 IF (LHOOK) CALL DR_HOOK('NMM',1,ZHOOK_HANDLE)
00226 END FUNCTION NMM
00227 ! 
00228 FUNCTION NCCAA(KGRDAT)
00229  IMPLICIT NONE
00230  INTEGER, INTENT(IN) :: KGRDAT
00231  INTEGER             :: NCCAA
00232  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00233  IF (LHOOK) CALL DR_HOOK('NCCAA',0,ZHOOK_HANDLE)
00234  NCCAA = KGRDAT/10000
00235 IF (LHOOK) CALL DR_HOOK('NCCAA',1,ZHOOK_HANDLE)
00236 END FUNCTION NCCAA
00237 ! 
00238 FUNCTION NZZAA(KAAAA,KMM)
00239  IMPLICIT NONE
00240  INTEGER, INTENT(IN) :: KAAAA,KMM
00241  INTEGER             :: NZZAA
00242  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00243  IF (LHOOK) CALL DR_HOOK('NZZAA',0,ZHOOK_HANDLE)
00244  NZZAA = KAAAA-( (1-ISIGN(1,KMM-3))/2 )
00245 IF (LHOOK) CALL DR_HOOK('NZZAA',1,ZHOOK_HANDLE)
00246 END FUNCTION NZZAA
00247 !
00248 FUNCTION NZZMM(KMM)
00249  IMPLICIT NONE
00250  INTEGER, INTENT(IN) :: KMM
00251  INTEGER             :: NZZMM
00252  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00253  IF (LHOOK) CALL DR_HOOK('NZZMM',0,ZHOOK_HANDLE)
00254  NZZMM = KMM+6*(1-ISIGN(1,KMM-3))
00255 IF (LHOOK) CALL DR_HOOK('NZZMM',1,ZHOOK_HANDLE)
00256 END FUNCTION NZZMM
00257 !
00258 FUNCTION RJUDAT(KAAAA,KMM,KDD)
00259  IMPLICIT NONE
00260  INTEGER, INTENT(IN) :: KAAAA,KMM,KDD
00261  REAL                :: RJUDAT
00262  INTEGER             :: NZZAA, NZZMM
00263  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00264  IF (LHOOK) CALL DR_HOOK('RJUDAT',0,ZHOOK_HANDLE)
00265  NZZMM  = KMM+6*(1-ISIGN(1,KMM-3))
00266  NZZAA  = KAAAA-( (1-ISIGN(1,KMM-3))/2 )
00267  RJUDAT = 1720994.5 + FLOAT(2-NZZAA/100 + (NZZAA/100)/4 &
00268    + INT(365.25*FLOAT(NZZAA)) + INT(30.601*FLOAT(NZZMM+1)) + KDD)  
00269 IF (LHOOK) CALL DR_HOOK('RJUDAT',1,ZHOOK_HANDLE)
00270 END FUNCTION RJUDAT
00271 !
00272 FUNCTION RTIME(KAAAA,KMM,KDD,KSS)
00273  USE MODD_CSTS, ONLY : XDAY
00274  IMPLICIT NONE 
00275  INTEGER, INTENT(IN) :: KAAAA,KMM,KDD,KSS
00276  REAL                :: RTIME, RJUDAT
00277  INTEGER             :: NZZAA, NZZMM
00278  REAL(KIND=JPRB) :: ZHOOK_HANDLE
00279  IF (LHOOK) CALL DR_HOOK('RTIME',0,ZHOOK_HANDLE)
00280  NZZMM  = KMM+6*(1-ISIGN(1,KMM-3))
00281  NZZAA  = KAAAA-( (1-ISIGN(1,KMM-3))/2 )
00282  RJUDAT = 1720994.5 + FLOAT(2-NZZAA/100 + (NZZAA/100)/4 &
00283    + INT(365.25*FLOAT(NZZAA)) + INT(30.601*FLOAT(NZZMM+1)) + KDD)  
00284  RTIME  = (RJUDAT-2451545.)*XDAY+FLOAT(KSS)
00285 IF (LHOOK) CALL DR_HOOK('RTIME',1,ZHOOK_HANDLE)
00286 END FUNCTION RTIME
00287 
00288 END SUBROUTINE OI_TSL
00289 
00290 
00291 
00292