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

Go to the documentation of this file.
00001 !##################
00002 MODULE MODD_TRIP_GRID_n
00003 !##################
00004 !
00005 !!****  *MODD_TRIP_GRID_n - declaration of grid for TRIP scheme
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!
00011 !!**  IMPLICIT ARGUMENTS
00012 !!    ------------------
00013 !!      None 
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      B. Decharme   *Meteo France*
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original       05/2008
00025 !
00026 !*       0.   DECLARATIONS
00027 !             ------------
00028 !
00029 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00030 USE PARKIND1  ,ONLY : JPRB
00031 !
00032 IMPLICIT NONE
00033 !
00034 TYPE TRIP_GRID_t
00035 !-------------------------------------------------------------------------------
00036 !
00037 ! Grid definition
00038 !
00039   REAL, POINTER,  DIMENSION(:)      :: XGRID_TRIP ! lits of parameters used to define the grid
00040 !
00041 !-------------------------------------------------------------------------------
00042 !
00043   REAL, POINTER, DIMENSION(:,:)    :: XAREA       ! 2d grid area [m*m]
00044 !
00045 !
00046   LOGICAL, POINTER, DIMENSION(:,:) :: GMASK       !Logical Mask for TRIP grid
00047 !
00048 !-------------------------------------------------------------------------------
00049 !
00050 END TYPE TRIP_GRID_t
00051 !
00052 TYPE(TRIP_GRID_t), ALLOCATABLE, TARGET, SAVE :: TRIP_GRID_MODEL(:)
00053 !
00054 REAL, POINTER,    DIMENSION(:)   :: XGRID_TRIP=>NULL()
00055 !$OMP THREADPRIVATE(XGRID_TRIP)
00056 REAL, POINTER,    DIMENSION(:,:) :: XAREA=>NULL()
00057 !$OMP THREADPRIVATE(XAREA)
00058 LOGICAL, POINTER, DIMENSION(:,:) :: GMASK=>NULL() 
00059 !$OMP THREADPRIVATE(GMASK)
00060 !
00061 CONTAINS
00062 
00063 SUBROUTINE TRIP_GRID_GOTO_MODEL(KFROM, KTO, LKFROM)
00064 LOGICAL, INTENT(IN) :: LKFROM
00065 INTEGER, INTENT(IN) :: KFROM, KTO
00066 !
00067 ! Save current state for allocated arrays
00068 IF (LKFROM) THEN
00069 TRIP_GRID_MODEL(KFROM)%XGRID_TRIP=>XGRID_TRIP
00070 TRIP_GRID_MODEL(KFROM)%XAREA=>XAREA
00071 TRIP_GRID_MODEL(KFROM)%GMASK=>GMASK
00072 ENDIF
00073 !
00074 ! Current model is set to model KTO
00075 XGRID_TRIP=>TRIP_GRID_MODEL(KTO)%XGRID_TRIP
00076 XAREA=>TRIP_GRID_MODEL(KTO)%XAREA
00077 GMASK=>TRIP_GRID_MODEL(KTO)%GMASK
00078 !
00079 END SUBROUTINE TRIP_GRID_GOTO_MODEL
00080 
00081 SUBROUTINE TRIP_GRID_ALLOC(KMODEL)
00082 INTEGER, INTENT(IN) :: KMODEL
00083 INTEGER :: J
00084 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00085 IF (LHOOK) CALL DR_HOOK("MODD_TRIP_GRID_N:TRIP_GRID_ALLOC",0,ZHOOK_HANDLE)
00086 ALLOCATE(TRIP_GRID_MODEL(KMODEL))
00087 DO J=1,KMODEL
00088   NULLIFY(TRIP_GRID_MODEL(J)%XGRID_TRIP)
00089   NULLIFY(TRIP_GRID_MODEL(J)%XAREA)
00090   NULLIFY(TRIP_GRID_MODEL(J)%GMASK)
00091 ENDDO
00092 IF (LHOOK) CALL DR_HOOK("MODD_TRIP_GRID_N:TRIP_GRID_ALLOC",1,ZHOOK_HANDLE)
00093 END SUBROUTINE TRIP_GRID_ALLOC
00094 
00095 SUBROUTINE TRIP_GRID_DEALLO
00096 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00097 IF (LHOOK) CALL DR_HOOK("MODD_TRIP_GRID_N:TRIP_GRID_DEALLO",0,ZHOOK_HANDLE)
00098 IF (ALLOCATED(TRIP_GRID_MODEL)) DEALLOCATE(TRIP_GRID_MODEL)
00099 IF (LHOOK) CALL DR_HOOK("MODD_TRIP_GRID_N:TRIP_GRID_DEALLO",1,ZHOOK_HANDLE)
00100 END SUBROUTINE TRIP_GRID_DEALLO
00101 
00102 END MODULE MODD_TRIP_GRID_n