SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_geo

Go to the documentation of this file.
00001 MODULE MODE_GEO_GAUSS
00002   !!
00003   !!     AUTHOR
00004   !!     ------
00005   !!      J-D Gril
00006   !!
00007   !!     MODIFICATION
00008   !!     ------------
00009   !!       Original  10/2005
00010   !!
00011   !--------------------------------------------------------------------------- 
00012   USE EGGANGLES, ONLY : LOLA
00013   !
00014 !
00015   USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00016   USE PARKIND1  ,ONLY : JPRB
00017 !
00018   IMPLICIT NONE
00019   !
00020   INTERFACE GAUSS_TR
00021      MODULE PROCEDURE GAUSS_TR_V, GAUSS_TR_S
00022   END INTERFACE
00023   !
00024   INTERFACE GAUSS_RT
00025      MODULE PROCEDURE GAUSS_RT_V, GAUSS_RT_S
00026   END INTERFACE
00027   !
00028   INTERFACE ETIR
00029      MODULE PROCEDURE ETIR_V, ETIR_S
00030   END INTERFACE
00031   !
00032   INTERFACE RETRE
00033      MODULE PROCEDURE RETRE_V, RETRE_S
00034   END INTERFACE
00035   !
00036   INTERFACE ROTATE_G
00037      MODULE PROCEDURE ROTATE_G_V, ROTATE_G_S
00038   END INTERFACE
00039   !
00040   INTERFACE ANTI_ROTATE_G
00041      MODULE PROCEDURE ANTI_ROTATE_G_V, ANTI_ROTATE_G_S
00042   END INTERFACE
00043   ! 
00044   INTERFACE MAP_FAC
00045      MODULE PROCEDURE MAP_FAC_V, MAP_FAC_S
00046   END INTERFACE
00047   !
00048 CONTAINS
00049   !==========================GAUSS_TR=========================================
00050   TYPE(LOLA) FUNCTION GAUSS_TR_S (PT_REEL,PT_POLE,PCODIL) RESULT (PT_G)
00051     TYPE (LOLA), INTENT(IN)          :: PT_REEL
00052     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00053     REAL, INTENT(IN)                 :: PCODIL
00054     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00055 
00056     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_TR_S',0,ZHOOK_HANDLE)
00057     PT_G=ETIR(ANTI_ROTATE_G(PT_REEL,PT_POLE),PCODIL)
00058   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_TR_S',1,ZHOOK_HANDLE)
00059 
00060   END FUNCTION GAUSS_TR_S
00061 
00062   FUNCTION GAUSS_TR_V (PT_REEL,PT_POLE,PCODIL) RESULT (PT_G)
00063     TYPE (LOLA), DIMENSION(:), INTENT(IN)          :: PT_REEL
00064     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00065     REAL, INTENT(IN)                 :: PCODIL
00066     TYPE (LOLA), DIMENSION(SIZE(PT_REEL))       :: PT_G
00067     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00068 
00069     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_TR_V',0,ZHOOK_HANDLE)
00070     PT_G=ETIR(ANTI_ROTATE_G(PT_REEL,PT_POLE),PCODIL)
00071   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_TR_V',1,ZHOOK_HANDLE)
00072 
00073   END FUNCTION GAUSS_TR_V
00074   !==========================GAUSS_RT=========================================
00075   TYPE(LOLA) FUNCTION GAUSS_RT_S (PT_G,PT_POLE,PCODIL) RESULT (PT_REEL)
00076     TYPE (LOLA), INTENT(IN)          :: PT_G
00077     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00078     REAL, INTENT(IN)                 :: PCODIL
00079     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00080 
00081     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_RT_S',0,ZHOOK_HANDLE)
00082     PT_REEL=ROTATE_G(RETRE(PT_G,PCODIL),PT_POLE)
00083   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_RT_S',1,ZHOOK_HANDLE)
00084 
00085   END FUNCTION GAUSS_RT_S
00086 
00087   FUNCTION GAUSS_RT_V (PT_G,PT_POLE,PCODIL) RESULT (PT_REEL)
00088     TYPE (LOLA), DIMENSION(:), INTENT(IN)          :: PT_G
00089     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00090     REAL, INTENT(IN)                 :: PCODIL
00091     TYPE (LOLA), DIMENSION(SIZE(PT_G))     :: PT_REEL
00092     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00093 
00094     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_RT_V',0,ZHOOK_HANDLE)
00095     PT_REEL=ROTATE_G(RETRE(PT_G,PCODIL),PT_POLE)
00096   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:GAUSS_RT_V',1,ZHOOK_HANDLE)
00097 
00098   END FUNCTION GAUSS_RT_V
00099   !==========================ROTATE_G=========================================
00100   TYPE(LOLA) FUNCTION ROTATE_G_S (PT_TR,PT_POLE) RESULT (PT_REEL)
00101     USE EGGANGLES, ONLY : COSIN_TO_ANGLE, P_ASIN
00102     TYPE (LOLA), INTENT(IN)          :: PT_TR
00103     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00104 
00105     REAL(KIND=JPRB)    :: ZSIN, ZCOS
00106     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00107 
00108     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_S',0,ZHOOK_HANDLE)
00109     PT_REEL%LAT = P_ASIN(SIN(PT_POLE%LAT)*SIN(PT_TR%LAT)+COS(PT_POLE%LAT)*COS(PT_TR%LAT)*COS(PT_TR%LON)) 
00110     
00111     IF (COS(PT_REEL%LAT) /= 0.0) THEN     
00112       ZSIN = -1.0*COS(PT_TR%LAT)*SIN(PT_TR%LON)/COS(PT_REEL%LAT)
00113       ZCOS = (COS(PT_POLE%LAT)*SIN(PT_TR%LAT)-SIN(PT_POLE%LAT)*COS(PT_TR%LAT)*COS(PT_TR%LON))/COS(PT_REEL%LAT)
00114       PT_REEL%LON = COSIN_TO_ANGLE(ZCOS,ZSIN) + PT_POLE%LON
00115     ELSE
00116       PT_REEL%LON = 0.0
00117     ENDIF
00118   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_S',1,ZHOOK_HANDLE)
00119 
00120   END FUNCTION ROTATE_G_S
00121 
00122   FUNCTION ROTATE_G_V (PT_TR,PT_POLE) RESULT (PT_REEL)
00123     USE EGGANGLES, ONLY : COSIN_TO_ANGLE, P_ASIN
00124     TYPE (LOLA), DIMENSION(:), INTENT(IN)          :: PT_TR
00125     TYPE (LOLA), INTENT(IN)                        :: PT_POLE
00126     TYPE (LOLA), DIMENSION(SIZE(PT_TR))            :: PT_REEL
00127 
00128     REAL(KIND=JPRB), DIMENSION(SIZE(PT_TR))                   :: ZSIN, ZCOS
00129     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00130 
00131     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_V',0,ZHOOK_HANDLE)
00132     PT_REEL%LAT = P_ASIN(SIN(PT_POLE%LAT)*SIN(PT_TR%LAT)+COS(PT_POLE%LAT)*COS(PT_TR%LAT)*COS(PT_TR%LON)) 
00133     
00134     PT_REEL%LON = 0.0
00135     WHERE (COS(PT_REEL%LAT) /= 0.0)
00136       ZSIN = -1.0*COS(PT_TR%LAT)*SIN(PT_TR%LON)/COS(PT_REEL%LAT)
00137       ZCOS = (COS(PT_POLE%LAT)*SIN(PT_TR%LAT)-SIN(PT_POLE%LAT)*COS(PT_TR%LAT)*COS(PT_TR%LON))/COS(PT_REEL%LAT)
00138       PT_REEL%LON = COSIN_TO_ANGLE(ZCOS,ZSIN) + PT_POLE%LON
00139     ENDWHERE
00140   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_V',1,ZHOOK_HANDLE)
00141 
00142 
00143 !    DO I=1,SIZE(PT_TR)
00144 !      PT_REEL(I) = ROTATE_G(PT_TR(I),PT_POLE)
00145 !    END DO
00146 
00147   END FUNCTION ROTATE_G_V
00148   !==========================ANTI_ROTATE_G====================================
00149   TYPE(LOLA) FUNCTION ANTI_ROTATE_G_S (PT_REEL,PT_POLE) RESULT (PT_TR)
00150     USE EGGANGLES, ONLY : COSIN_TO_ANGLE, P_ASIN
00151     TYPE (LOLA), INTENT(IN)          :: PT_REEL
00152     TYPE (LOLA), INTENT(IN)          :: PT_POLE
00153 
00154     REAL(KIND=JPRB) :: ZSIN, ZCOS
00155     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00156    
00157     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_S',0,ZHOOK_HANDLE)
00158     PT_TR%LAT = P_ASIN(SIN(PT_POLE%LAT)*SIN(PT_REEL%LAT)+COS(PT_POLE%LAT)*COS(PT_REEL%LAT)*COS(PT_REEL%LON-PT_POLE%LON))
00159  
00160    IF (COS(PT_TR%LAT) /= 0.0) THEN     
00161       ZSIN = -1.0*COS(PT_REEL%LAT)*SIN(PT_REEL%LON-PT_POLE%LON)/COS(PT_TR%LAT)
00162       ZCOS = (COS(PT_POLE%LAT)*SIN(PT_REEL%LAT)-SIN(PT_POLE%LAT)*COS(PT_REEL%LAT)*COS(PT_REEL%LON-PT_POLE%LON))/COS(PT_TR%LAT)
00163       PT_TR%LON = COSIN_TO_ANGLE(ZCOS,ZSIN)
00164     ELSE
00165       PT_TR%LON = 0.0
00166     ENDIF
00167   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_S',1,ZHOOK_HANDLE)
00168   END FUNCTION ANTI_ROTATE_G_S
00169 
00170   FUNCTION ANTI_ROTATE_G_V (PT_REEL,PT_POLE) RESULT (PT_TR)
00171     USE EGGANGLES, ONLY : COSIN_TO_ANGLE, P_ASIN
00172     TYPE (LOLA), DIMENSION(:), INTENT(IN)          :: PT_REEL
00173     TYPE (LOLA), INTENT(IN)                        :: PT_POLE
00174     TYPE (LOLA), DIMENSION(SIZE(PT_REEL))          :: PT_TR  
00175 
00176     REAL(KIND=JPRB), DIMENSION(SIZE(PT_REEL)) :: ZSIN, ZCOS
00177     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00178 
00179    IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_V',0,ZHOOK_HANDLE)
00180    PT_TR%LAT = P_ASIN(SIN(PT_POLE%LAT)*SIN(PT_REEL%LAT)+COS(PT_POLE%LAT)*COS(PT_REEL%LAT)*COS(PT_REEL%LON-PT_POLE%LON))
00181  
00182     PT_TR%LON = 0.0
00183     WHERE (COS(PT_TR%LAT) /= 0.0)
00184       ZSIN = -1.0*COS(PT_REEL%LAT)*SIN(PT_REEL%LON-PT_POLE%LON)/COS(PT_TR%LAT)
00185       ZCOS = (COS(PT_POLE%LAT)*SIN(PT_REEL%LAT)-SIN(PT_POLE%LAT)*COS(PT_REEL%LAT)*COS(PT_REEL%LON-PT_POLE%LON))/COS(PT_TR%LAT)
00186       PT_TR%LON = COSIN_TO_ANGLE(ZCOS,ZSIN)
00187     ENDWHERE
00188   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_V',1,ZHOOK_HANDLE)
00189 
00190 !    DO I=1,SIZE(PT_REEL)
00191 !      PT_TR(I) = ANTI_ROTATE_G(PT_REEL(I),PT_POLE)
00192 !    END DO
00193 
00194   END FUNCTION ANTI_ROTATE_G_V
00195   !==========================ETIR=============================================
00196   TYPE(LOLA) FUNCTION ETIR_S (PT_COORD,PCODIL) RESULT (PT_ET)
00197     USE EGGANGLES, ONLY : COSIN_TO_ANGLE
00198     TYPE (LOLA), INTENT(IN)          :: PT_COORD
00199     REAL, INTENT(IN)                 :: PCODIL
00200 
00201     REAL(KIND=JPRB) :: ZPC2, ZSIN, ZCOS
00202     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00203 
00204     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_S',0,ZHOOK_HANDLE)
00205     PT_ET%LON = PT_COORD%LON
00206     ZPC2  = PCODIL*PCODIL
00207     ZSIN = ((1.0-ZPC2)+(1.0+ZPC2)*SIN(PT_COORD%LAT))/((1.0+ZPC2)+(1.0-ZPC2)*SIN(PT_COORD%LAT))
00208     ZCOS = 2.0*PCODIL*COS(PT_COORD%LAT)/((1.0+ZPC2)+(1.0-ZPC2)*SIN(PT_COORD%LAT))
00209 
00210     PT_ET%LAT = COSIN_TO_ANGLE(ZCOS,ZSIN)
00211   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_S',1,ZHOOK_HANDLE)
00212 
00213   END FUNCTION ETIR_S
00214 
00215   FUNCTION ETIR_V (PT_COORD,PCODIL) RESULT (PT_ET)
00216     USE EGGANGLES, ONLY : COSIN_TO_ANGLE
00217     TYPE (LOLA), DIMENSION(:), INTENT(IN)   :: PT_COORD
00218     REAL, INTENT(IN)                        :: PCODIL
00219     TYPE (LOLA), DIMENSION(SIZE(PT_COORD))  :: PT_ET
00220 
00221     REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD))         :: ZPC2, ZSIN, ZCOS
00222     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00223 
00224     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_V',0,ZHOOK_HANDLE)
00225     PT_ET%LON = PT_COORD%LON
00226     ZPC2  = PCODIL*PCODIL
00227     ZSIN = ((1.0-ZPC2)+(1.0+ZPC2)*SIN(PT_COORD%LAT))/((1.0+ZPC2)+(1.0-ZPC2)*SIN(PT_COORD%LAT))
00228     ZCOS = 2.0*PCODIL*COS(PT_COORD%LAT)/((1.0+ZPC2)+(1.0-ZPC2)*SIN(PT_COORD%LAT))
00229 
00230     PT_ET%LAT = COSIN_TO_ANGLE(ZCOS,ZSIN)
00231   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_V',1,ZHOOK_HANDLE)
00232 
00233   END FUNCTION ETIR_V
00234   !==========================RETRE============================================
00235   TYPE(LOLA) FUNCTION RETRE_S (PT_COORD,PCODIL) RESULT (PT_RE)
00236     USE EGGANGLES, ONLY : COSIN_TO_ANGLE
00237     TYPE (LOLA), INTENT(IN)          :: PT_COORD
00238     REAL, INTENT(IN)                 :: PCODIL
00239 
00240     REAL(KIND=JPRB)     :: ZPC2, ZSIN, ZCOS
00241     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00242 
00243     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_S',0,ZHOOK_HANDLE)
00244     PT_RE%LON = PT_COORD%LON
00245     ZPC2  = PCODIL*PCODIL
00246     ZSIN = (-1.0*(1.0-ZPC2)+(1.0+ZPC2)*SIN(PT_COORD%LAT))/((1.0+ZPC2)-(1.0-ZPC2)*SIN(PT_COORD%LAT))
00247     ZCOS = 2.0*PCODIL*COS(PT_COORD%LAT)/((1.0+ZPC2)-(1.0-ZPC2)*SIN(PT_COORD%LAT))
00248 
00249     PT_RE%LAT = COSIN_TO_ANGLE(ZCOS,ZSIN)
00250   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_S',1,ZHOOK_HANDLE)
00251 
00252   END FUNCTION RETRE_S
00253 
00254   FUNCTION RETRE_V (PT_COORD,PCODIL) RESULT (PT_RE)
00255     USE EGGANGLES, ONLY : COSIN_TO_ANGLE
00256     TYPE (LOLA), DIMENSION(:), INTENT(IN)   :: PT_COORD
00257     REAL, INTENT(IN)                        :: PCODIL
00258     TYPE (LOLA), DIMENSION(SIZE(PT_COORD))  :: PT_RE
00259 
00260     REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD))         :: ZPC2, ZSIN, ZCOS
00261     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00262 
00263     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_V',0,ZHOOK_HANDLE)
00264     PT_RE%LON = PT_COORD%LON
00265     ZPC2  = PCODIL*PCODIL
00266     ZSIN = (-1.0*(1.0-ZPC2)+(1.0+ZPC2)*SIN(PT_COORD%LAT))/((1.0+ZPC2)-(1.0-ZPC2)*SIN(PT_COORD%LAT))
00267     ZCOS = 2.0*PCODIL*COS(PT_COORD%LAT)/((1.0+ZPC2)-(1.0-ZPC2)*SIN(PT_COORD%LAT))
00268 
00269     PT_RE%LAT = COSIN_TO_ANGLE(ZCOS,ZSIN)
00270   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_V',1,ZHOOK_HANDLE)
00271 
00272 !    DO I=1,SIZE(PT_COORD)
00273 !       PT_RE(I) = RETRE(PT_COORD(I),PCODIL)
00274 !    END DO
00275 
00276   END FUNCTION RETRE_V
00277   !==========================MAP FACTOR=======================================
00278   REAL FUNCTION MAP_FAC_S (POLE,PCODIL,PT_COORD) RESULT (PMF)
00279     TYPE (LOLA), INTENT(IN)          :: POLE, PT_COORD
00280     REAL, INTENT(IN)                 :: PCODIL
00281     
00282     REAL(KIND=JPRB) :: ZPC2
00283     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00284     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_S',0,ZHOOK_HANDLE)
00285     ZPC2  = PCODIL*PCODIL
00286     PMF = (2.0*PCODIL)/((1+ZPC2)+(1-ZPC2)* &
00287             (SIN(PT_COORD%LAT)*SIN(POLE%LAT)+COS(PT_COORD%LAT)*COS(POLE%LAT)*COS(PT_COORD%LON-POLE%LON)))      
00288   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_S',1,ZHOOK_HANDLE)
00289    
00290   END FUNCTION MAP_FAC_S
00291 
00292   FUNCTION MAP_FAC_V (POLE,PCODIL,PT_COORD) RESULT (PMF)
00293     TYPE (LOLA), INTENT(IN)                 :: POLE
00294     TYPE (LOLA), DIMENSION(:), INTENT(IN)   :: PT_COORD
00295     REAL, INTENT(IN)                        :: PCODIL
00296     REAL, DIMENSION(SIZE(PT_COORD))         :: PMF
00297 
00298     REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD))         :: ZPC2
00299     REAL(KIND=JPRB) :: ZHOOK_HANDLE
00300 
00301     IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_V',0,ZHOOK_HANDLE)
00302     ZPC2  = PCODIL*PCODIL
00303     PMF = (2.0*PCODIL)/((1+ZPC2)+(1-ZPC2)* &
00304             (SIN(PT_COORD%LAT)*SIN(POLE%LAT)+COS(PT_COORD%LAT)*COS(POLE%LAT)*COS(PT_COORD%LON-POLE%LON)))      
00305   IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_V',1,ZHOOK_HANDLE)
00306 
00307 !    DO I=1,SIZE(PT_COORD)
00308 !      PMF(I) = MAP_FAC(POLE,PCODIL,PT_COORD(I))
00309 !    END DO    
00310     
00311   END FUNCTION MAP_FAC_V
00312 END MODULE MODE_GEO_GAUSS