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

Go to the documentation of this file.
00001 !     ################################################################
00002 SUBROUTINE GET_XYALL_IGN(PX,PY,PDX,PDY,PXALL,PYALL,KDIMX,KDIMY)
00003 !     ################################################################
00004 !
00005 !!****  *GET_XYALL_IGN* 
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      S. Faroux   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    07/2011 
00031 !-------------------------------------------------------------------------------
00032 !
00033 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00034 USE PARKIND1  ,ONLY : JPRB
00035 !
00036 IMPLICIT NONE
00037 !
00038 !*       0.1   Declarations of arguments
00039 !              -------------------------
00040 !
00041 REAL, DIMENSION(:), INTENT(IN) :: PX
00042 REAL, DIMENSION(:), INTENT(IN) :: PY
00043 REAL, DIMENSION(:), INTENT(IN) :: PDX
00044 REAL, DIMENSION(:), INTENT(IN) :: PDY
00045 REAL, DIMENSION(:), INTENT(OUT) :: PXALL
00046 REAL, DIMENSION(:), INTENT(OUT) :: PYALL
00047 INTEGER, INTENT(OUT) :: KDIMX
00048 INTEGER, INTENT(OUT) :: KDIMY
00049 !
00050 !*       0.2   Declarations of local variables
00051 !              -------------------------------
00052 !
00053 REAL, DIMENSION(MAX(SIZE(PXALL),SIZE(PYALL))*3) :: ZALL
00054 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00055 !
00056 !----------------------------------------------------------------------------
00057 !
00058 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN',0,ZHOOK_HANDLE)
00059 !
00060 KDIMX = 0
00061 KDIMY = 0
00062 !
00063  CALL GET_COORD(PX,PDX,ZALL,KDIMX)
00064 !sort values from lower to grower
00065  CALL SORT(KDIMX,ZALL,PXALL)
00066 !
00067  CALL GET_COORD(PY,PDY,ZALL,KDIMY)
00068 !sort values from lower to grower
00069  CALL SORT(KDIMY,ZALL,PYALL)
00070 !
00071 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN',1,ZHOOK_HANDLE)
00072 !-------------------------------------------------------------------------------
00073 CONTAINS
00074 !
00075 SUBROUTINE GET_COORD(PIN,PDIN,POUT,KSIZE)
00076 !
00077 IMPLICIT NONE
00078 !
00079 REAL, DIMENSION(:), INTENT(IN) :: PIN
00080 REAL, DIMENSION(:), INTENT(IN) :: PDIN
00081 REAL, DIMENSION(:), INTENT(OUT) :: POUT
00082 INTEGER, INTENT(INOUT) :: KSIZE
00083 REAL, DIMENSION(SIZE(POUT)) :: ZDOUT
00084 INTEGER :: I, J
00085 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00086 !
00087 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:GET_COORD',0,ZHOOK_HANDLE)
00088 !
00089 ZDOUT(:) = 0.
00090 POUT (:) = -9999.
00091 IF (SIZE(POUT)>0) THEN
00092   ZDOUT(1) = PDIN(1)/2.
00093   POUT (1) = PIN(1)
00094   IF (SIZE(POUT)>1) POUT (2) = PIN(1)-PDIN(1)
00095   IF (SIZE(POUT)>2) POUT (3) = PIN(1)+PDIN(1)
00096 ENDIF
00097 KSIZE = MIN(3,SIZE(PIN))
00098 !
00099 DO I=1,SIZE(PIN)
00100   !point
00101   DO J=1,KSIZE
00102     IF ( POUT(J) == PIN(I) ) EXIT
00103     IF ( J == KSIZE ) THEN
00104       KSIZE = KSIZE + 1
00105       POUT (KSIZE) = PIN (I)
00106       ZDOUT(KSIZE) = PDIN(I)/2.
00107     ENDIF
00108   ENDDO
00109   !limits of the mesh
00110    DO J=1,KSIZE
00111      IF ( POUT(J)<PIN(I) .AND. POUT(J)+ZDOUT(J)>=PIN(I)-PDIN(I) ) EXIT
00112      IF ( J == KSIZE ) THEN     
00113        KSIZE = KSIZE + 1
00114        POUT(KSIZE) = PIN(I)-PDIN(I)
00115      ENDIF
00116    ENDDO
00117    DO J=1,KSIZE
00118      IF ( POUT(J)>PIN(I) .AND. POUT(J)-ZDOUT(J)<=PIN(I)+PDIN(I) ) EXIT
00119      IF ( J == KSIZE ) THEN     
00120        KSIZE = KSIZE + 1
00121        POUT(KSIZE) = PIN(I)+PDIN(I)
00122      ENDIF
00123    ENDDO   
00124 ENDDO
00125 !
00126 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:GET_COORD',1,ZHOOK_HANDLE)
00127 !
00128 END SUBROUTINE GET_COORD
00129 !
00130 SUBROUTINE SORT(KSIZE,PIN,POUT)
00131 !
00132 IMPLICIT NONE
00133 !
00134 INTEGER, INTENT(INOUT) :: KSIZE
00135 REAL, DIMENSION(:), INTENT(INOUT) :: PIN
00136 REAL, DIMENSION(:), INTENT(OUT) :: POUT
00137 REAL, DIMENSION(SIZE(PIN)) :: ZOUT
00138 REAL :: ZMIN, ZMAX
00139 INTEGER,DIMENSION(1) :: IDMIN
00140 INTEGER :: J
00141 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00142 !
00143 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:SORT',0,ZHOOK_HANDLE)
00144 !
00145 ZMAX  = MAXVAL(PIN(1:KSIZE))
00146 DO J=1,KSIZE
00147   ZMIN  = MINVAL(PIN(1:KSIZE))
00148   ZOUT(J) = ZMIN
00149   IDMIN = MINLOC(PIN(1:KSIZE))
00150   PIN(IDMIN(1)) = ZMAX+1
00151 ENDDO
00152 !
00153 !to suppress fictive points at boundaries
00154 POUT(1:KSIZE-2) = ZOUT(2:KSIZE-1)
00155 KSIZE = MAX(0,KSIZE-2)
00156 !
00157 IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:SORT',1,ZHOOK_HANDLE)
00158 !
00159 END SUBROUTINE SORT
00160 !
00161 END SUBROUTINE GET_XYALL_IGN