SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TRIP/mode

Go to the documentation of this file.
00001 !
00002 MODULE MODE_CONVERT
00003    !     MODE_CONVERT
00004    !     CONVERT_1D    = Convert 1D to 2D array            (ISBA -> TRIP)
00005    !     CONVERT_2D    = Convert 2D to 3D array            (ISBA -> TRIP)
00006    !     UN_CONVERT_1D = Convert 2D to 1D                  (TRIP -> ISBA)
00007    !     UN_CONVERT_2D = Convert 3D to 2D array            (TRIP -> ISBA)
00008 !
00009 !
00010 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00011 USE PARKIND1  ,ONLY : JPRB
00012 !
00013   INTERFACE CONVERT
00014       MODULE PROCEDURE CONVERT_1D
00015       MODULE PROCEDURE CONVERT_2D
00016   END INTERFACE
00017 
00018   INTERFACE UN_CONVERT
00019       MODULE PROCEDURE UN_CONVERT_1D
00020       MODULE PROCEDURE UN_CONVERT_2D
00021   END INTERFACE 
00022 !
00023 CONTAINS
00024 !
00025 !  ##########################################################
00026    SUBROUTINE CONVERT_1D(P1D,GMASK,P2D)
00027    !-------------------------------------------------------------------------------
00028    !
00029    IMPLICIT NONE
00030    !
00031    REAL,    DIMENSION(:),         INTENT(IN)     :: P1D    ! Input 1D array without patch
00032    LOGICAL, DIMENSION(:,:),       INTENT(IN)     :: GMASK  ! Mask used to pack
00033    REAL,    DIMENSION(:,:),       INTENT(OUT)    :: P2D    ! Output 2D array
00034    !
00035    INTEGER ILON,ILAT,I,J,ICOUNT
00036    REAL(KIND=JPRB) :: ZHOOK_HANDLE
00037    !--------------------------------------------------------------------------------
00038    !
00039    ! initialize
00040    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:CONVERT_1D',0,ZHOOK_HANDLE)
00041    ILON =SIZE(GMASK,1)
00042    ILAT =SIZE(GMASK,2)
00043    !
00044    P2D(:,:)=0.0
00045    ICOUNT=0
00046    !
00047    DO J=1,ILAT
00048       DO I=1,ILON
00049          IF(GMASK(I,J))THEN
00050            ICOUNT=ICOUNT+1
00051            P2D(I,J)= P1D(ICOUNT)
00052          ELSE
00053            P2D(I,J)= 0.0
00054          ENDIF
00055       ENDDO
00056    ENDDO
00057    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:CONVERT_1D',1,ZHOOK_HANDLE)
00058    !
00059    END SUBROUTINE CONVERT_1D
00060 !  
00061    SUBROUTINE CONVERT_2D(P2D,GMASK,P3D)
00062    !-------------------------------------------------------------------------------
00063    !
00064    IMPLICIT NONE
00065    !
00066    REAL,    DIMENSION(:,:),       INTENT(IN)     :: P2D    ! Input 2D array without patch
00067    LOGICAL, DIMENSION(:,:),       INTENT(IN)     :: GMASK  ! Mask used to pack
00068    REAL,    DIMENSION(:,:,:),     INTENT(OUT)    :: P3D    ! Output 3D array
00069    !
00070    INTEGER ILON,ILAT,I,J,ICOUNT
00071    REAL(KIND=JPRB) :: ZHOOK_HANDLE
00072    !--------------------------------------------------------------------------------
00073    !
00074    ! initialize
00075    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:CONVERT_2D',0,ZHOOK_HANDLE)
00076    ILON =SIZE(GMASK,1)
00077    ILAT =SIZE(GMASK,2)
00078    !
00079    P3D(:,:,:)=0.0
00080    ICOUNT=0
00081    !
00082    DO J=1,ILAT
00083       DO I=1,ILON
00084          IF(GMASK(I,J))THEN
00085            ICOUNT=ICOUNT+1
00086            P3D(I,J,:)= P2D(ICOUNT,:)
00087          ELSE
00088            P3D(I,J,:)= 0.0
00089          ENDIF
00090       ENDDO
00091    ENDDO
00092    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:CONVERT_2D',1,ZHOOK_HANDLE)
00093    !
00094    END SUBROUTINE CONVERT_2D
00095 !
00096    SUBROUTINE UN_CONVERT_1D(P2D,GMASK,P1D)
00097    !-----------------------------------------------------------------------------
00098    !
00099    IMPLICIT NONE
00100    !
00101    REAL,    DIMENSION(:,:),       INTENT(IN)     :: P2D   ! Input 2D array
00102    LOGICAL, DIMENSION(:,:),       INTENT(IN)     :: GMASK ! Mask used to pack
00103    REAL,    DIMENSION(:),         INTENT(OUT)    :: P1D   ! Output 1D array
00104    !
00105    INTEGER ILON,ILAT,I,J,ICOUNT
00106    REAL(KIND=JPRB) :: ZHOOK_HANDLE
00107    !------------------------------------------------------------------------------
00108    !
00109    ! initialize
00110    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:UN_CONVERT_1D',0,ZHOOK_HANDLE)
00111    ILON =SIZE(P2D,1)
00112    ILAT =SIZE(P2D,2)
00113    P1D(:)=0.0
00114    ICOUNT=0
00115    !
00116    DO J=1,ILAT
00117       DO I=1,ILON
00118          IF(GMASK(I,J))THEN
00119            ICOUNT=ICOUNT+1
00120            P1D(ICOUNT)=P2D(I,J)
00121          ENDIF
00122       ENDDO
00123    ENDDO
00124    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:UN_CONVERT_1D',1,ZHOOK_HANDLE)
00125    !
00126    END SUBROUTINE UN_CONVERT_1D
00127 !   
00128    SUBROUTINE UN_CONVERT_2D(P3D,GMASK,P2D)
00129    !-----------------------------------------------------------------------------
00130    !
00131    IMPLICIT NONE
00132    !
00133    REAL,    DIMENSION(:,:,:),     INTENT(IN)   :: P3D   ! Input 2D array
00134    LOGICAL, DIMENSION(:,:),       INTENT(IN)   :: GMASK ! Mask used to pack
00135    REAL,    DIMENSION(:,:),       INTENT(OUT)  :: P2D   ! Output 1D array
00136    !
00137    INTEGER ILON,ILAT,I,J,ICOUNT
00138    REAL(KIND=JPRB) :: ZHOOK_HANDLE
00139    !------------------------------------------------------------------------------
00140    !
00141    ! initialize
00142    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:UN_CONVERT_2D',0,ZHOOK_HANDLE)
00143    ILON =SIZE(P3D,1)
00144    ILAT =SIZE(P3D,2)
00145    P2D(:,:)=0.0
00146    ICOUNT=0
00147    !
00148    DO J=1,ILAT
00149       DO I=1,ILON
00150          IF(GMASK(I,J))THEN
00151            ICOUNT=ICOUNT+1
00152            P2D(ICOUNT,:)=P3D(I,J,:)
00153          ENDIF
00154       ENDDO
00155    ENDDO
00156    IF (LHOOK) CALL DR_HOOK('MODE_CONVERT:UN_CONVERT_2D',1,ZHOOK_HANDLE)
00157    !
00158    END SUBROUTINE UN_CONVERT_2D
00159 !   
00160 !---------------
00161 END MODULE MODE_CONVERT