SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/OFFLIN/oi_hor_extrapol_surf.F90
Go to the documentation of this file.
00001 
00002 !     ###################################################################
00003       SUBROUTINE OI_HOR_EXTRAPOL_SURF(NDIM,PLAT_IN,PLON_IN,PFIELD_IN, &
00004                                          PLAT,PLON,PFIELD,OINTERP,PZS)  
00005 !     ###################################################################
00006 !
00007 !!**** *OI_HOR_EXTRAPOL_SURF* extrapolate a surface field
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!
00013 !!    METHOD
00014 !!    ------
00015 !!
00016 !!    For each point to interpolate, the nearest valid point value is set.
00017 !!
00018 !!    EXTERNAL
00019 !!    --------
00020 !!
00021 !!    IMPLICIT ARGUMENTS
00022 !!    ------------------
00023 !!
00024 !!    REFERENCE
00025 !!    ---------
00026 !!
00027 !!    AUTHOR
00028 !!    ------
00029 !!
00030 !!    V. Masson          Meteo-France
00031 !!
00032 !!    MODIFICATION
00033 !!    ------------
00034 !!
00035 !!    Original     01/12/98
00036 !!   V. Masson     01/2004 extrapolation in latitude and longitude
00037 !!   J.-F. Mahfouf 03/2010 adaptation for OI soil analysis 
00038 !----------------------------------------------------------------------------
00039 !
00040 !*    0.     DECLARATION
00041 !            -----------
00042 !
00043 USE MODD_SURF_PAR,   ONLY : XUNDEF
00044 USE MODD_CSTS,       ONLY : XPI
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 IMPLICIT NONE
00050 !
00051 !*    0.1    Declaration of arguments
00052 !            ------------------------
00053 !
00054 INTEGER,               INTENT(IN)     :: NDIM  ! dimension of arrays
00055 REAL,   DIMENSION(NDIM),  INTENT(IN)     :: PLAT_IN  ! input lat. of each grid mesh.
00056 REAL,   DIMENSION(NDIM),  INTENT(IN)     :: PLON_IN  ! input lon. of each grid mesh.
00057 REAL,   DIMENSION(NDIM),  INTENT(IN)     :: PFIELD_IN! input field on grid mesh
00058 REAL,   DIMENSION(NDIM),  INTENT(IN)     :: PLAT     ! latitude of each grid mesh.
00059 REAL,   DIMENSION(NDIM),  INTENT(IN)     :: PLON     ! longitude of each grid mesh.
00060 REAL,   DIMENSION(NDIM),  INTENT(INOUT)  :: PFIELD   ! field on grid mesh
00061 LOGICAL,DIMENSION(NDIM),  INTENT(IN)     :: OINTERP  ! .true. where physical value is needed
00062 REAL,   DIMENSION(NDIM), OPTIONAL, INTENT(IN) :: PZS      ! surface height
00063 !
00064 !*    0.2    Declaration of local variables
00065 !            ------------------------------
00066 !
00067 REAL     :: ZLAT    ! latitude of point to define
00068 REAL     :: ZLON    ! longitude of point to define
00069 REAL     :: ZDIST   ! current distance to valid point (in lat/lon grid)
00070 REAL     :: ZFIELD  ! current found field value
00071 REAL     :: ZNDIST  ! smallest distance to valid point
00072 REAL     :: ZCOSLA  ! cosine of latitude
00073 REAL     :: ZZS_OUT ! altitude of nearest grid point
00074 !
00075 INTEGER  :: JI    ! loop index on points
00076 INTEGER  :: JISC  ! loop index on valid points
00077 !
00078 REAL     :: ZLONSC, ZDLAT, ZDLON, ZCONV, ZR_EARTH
00079 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00080 !
00081 ! Earth radius
00082 !
00083 IF (LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',0,ZHOOK_HANDLE)
00084 ZR_EARTH = 6371598.0 
00085 !
00086 ! Angle conversion factor
00087 !  
00088 ZCONV = XPI/180.0
00089 !-------------------------------------------------------------------------------
00090 !
00091 !*    3.     No data point
00092 !            -------------
00093 !
00094 IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
00095 IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0) RETURN
00096 !
00097 !-------------------------------------------------------------------------------
00098 !
00099 !*      4.   Loop on points to define
00100 !            ------------------------
00101 !
00102 !
00103 DO JI=1,NDIM
00104   IF (PFIELD(JI)/=XUNDEF) CYCLE
00105   IF (.NOT. OINTERP(JI))  CYCLE
00106 !
00107 !*      4.1  initialisation
00108 !            --------------
00109 !
00110   ZNDIST=1.E20
00111   ZLAT=PLAT(JI)
00112   ZLON=PLON(JI)
00113   ZFIELD=PFIELD(JI)
00114   ZCOSLA=COS(ZLAT*ZCONV)
00115   IF (PRESENT(PZS)) ZZS_OUT=PZS(JI) 
00116 !
00117 !*      4.2  extrapolation with nearest valid point
00118 !            --------------------------------------
00119 !
00120   DO JISC=1,NDIM
00121     IF (PFIELD_IN(JISC)/=XUNDEF) THEN
00122       ZLONSC = PLON_IN(JISC)
00123       IF (ZLONSC-ZLON> 180.) ZLONSC = ZLONSC - 360.0
00124       IF (ZLONSC-ZLON<-180.) ZLONSC = ZLONSC + 360.0
00125       ZDLAT = (PLAT_IN(JISC)-ZLAT)*ZCONV
00126       ZDLON = (ZLONSC-ZLON)*ZCONV
00127       ZDIST = ZDLAT*ZDLAT + ZDLON*ZDLON*ZCOSLA*ZCOSLA
00128       IF (ZDIST<=ZNDIST) THEN
00129         ZFIELD=PFIELD_IN(JISC)
00130         IF (PRESENT(PZS)) ZZS_OUT=PZS(JISC)        
00131         ZNDIST=ZDIST
00132       END IF
00133     END IF
00134   END DO
00135   IF (PRESENT(PZS)) THEN
00136     PFIELD(JI) = ZFIELD + (ZZS_OUT - PZS(JI))*0.0065
00137   ELSE
00138     PFIELD(JI) = ZFIELD    
00139   ENDIF  
00140 
00141 
00142 END DO
00143 IF (LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
00144 !
00145 !-------------------------------------------------------------------------------
00146 !
00147 END SUBROUTINE OI_HOR_EXTRAPOL_SURF