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

Go to the documentation of this file.
00001 !     ##################
00002       MODULE MODD_AGRI_n
00003 !     ##################
00004 !
00005 !!****  *MODD_AGRI_n - declaration of SEEDING date for summer crops 
00006 !!      
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!
00011 !!**  IMPLICIT ARGUMENTS
00012 !!    ------------------
00013 !!      None 
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      P. LE MOIGNE   *Meteo France*
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original       06/2006
00025 !
00026 !*       0.   DECLARATIONS
00027 !             ------------
00028 !
00029 !
00030 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00031 USE PARKIND1  ,ONLY : JPRB
00032 !
00033 IMPLICIT NONE
00034 !
00035 !-------------------------------------------------------------------------------
00036 TYPE AGRI_t
00037 !                                          
00038 INTEGER, POINTER, DIMENSION (:,:)   :: NIRRINUM       
00039                                         ! Stage for Irrigation (4 stages)
00040 !
00041 LOGICAL, POINTER,DIMENSION(:,:)     :: LIRRIGATE 
00042                                         ! True if irrigation performed
00043 !
00044 LOGICAL, POINTER,DIMENSION(:,:)     :: LIRRIDAY 
00045                                         ! True if irrigation occurs during present day
00046 !                                          
00047 REAL, POINTER, DIMENSION(:,:)       :: XTHRESHOLDSPT 
00048                                         ! Spatialized threshold
00049 
00050 END TYPE AGRI_t
00051 !-------------------------------------------------------------------------------
00052 
00053 TYPE(AGRI_t), ALLOCATABLE, TARGET, SAVE :: AGRI_MODEL(:)
00054 
00055 INTEGER, POINTER, DIMENSION (:,:)   :: NIRRINUM=>NULL()
00056 !$OMP THREADPRIVATE(NIRRINUM)
00057 LOGICAL, POINTER, DIMENSION (:,:)   :: LIRRIGATE=>NULL()
00058 !$OMP THREADPRIVATE(LIRRIGATE)
00059 LOGICAL, POINTER, DIMENSION (:,:)   :: LIRRIDAY=>NULL()
00060 !$OMP THREADPRIVATE(LIRRIDAY)
00061 REAL, POINTER, DIMENSION (:,:)   :: XTHRESHOLDSPT=>NULL()
00062 !$OMP THREADPRIVATE(XTHRESHOLDSPT)
00063 
00064 CONTAINS
00065 
00066 SUBROUTINE AGRI_GOTO_MODEL(KFROM,KTO, LKFROM)                                        
00067 LOGICAL, INTENT(IN) :: LKFROM
00068 !
00069 INTEGER, INTENT(IN) :: KFROM, KTO
00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00071 !
00072 ! Save current state for allocated arrays
00073 IF (LKFROM) THEN
00074 AGRI_MODEL(KFROM)%NIRRINUM=>NIRRINUM
00075 AGRI_MODEL(KFROM)%LIRRIGATE=>LIRRIGATE
00076 AGRI_MODEL(KFROM)%LIRRIDAY=>LIRRIDAY
00077 AGRI_MODEL(KFROM)%XTHRESHOLDSPT=>XTHRESHOLDSPT
00078 ENDIF
00079 !
00080 ! Current model is set to model KTO
00081 IF (LHOOK) CALL DR_HOOK('MODD_AGRI_N:AGRI_GOTO_MODEL',0,ZHOOK_HANDLE)
00082 NIRRINUM=>AGRI_MODEL(KTO)%NIRRINUM          
00083 LIRRIGATE=>AGRI_MODEL(KTO)%LIRRIGATE          
00084 LIRRIDAY=>AGRI_MODEL(KTO)%LIRRIDAY          
00085 XTHRESHOLDSPT=>AGRI_MODEL(KTO)%XTHRESHOLDSPT          
00086 IF (LHOOK) CALL DR_HOOK('MODD_AGRI_N:AGRI_GOTO_MODEL',1,ZHOOK_HANDLE)
00087                                         
00088 END SUBROUTINE AGRI_GOTO_MODEL
00089 
00090 SUBROUTINE AGRI_ALLOC(KMODEL)
00091 INTEGER, INTENT(IN) :: KMODEL
00092 INTEGER :: J
00093 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00094 IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_ALLOC",0,ZHOOK_HANDLE)
00095 ALLOCATE(AGRI_MODEL(KMODEL))
00096 DO J=1,KMODEL
00097   NULLIFY(AGRI_MODEL(J)%NIRRINUM)
00098   NULLIFY(AGRI_MODEL(J)%LIRRIGATE)
00099   NULLIFY(AGRI_MODEL(J)%LIRRIDAY)
00100   NULLIFY(AGRI_MODEL(J)%XTHRESHOLDSPT)
00101 ENDDO
00102 IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_ALLOC",1,ZHOOK_HANDLE)
00103 END SUBROUTINE AGRI_ALLOC
00104 
00105 SUBROUTINE AGRI_DEALLO
00106 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00107 IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_DEALLO",0,ZHOOK_HANDLE)
00108 IF (ALLOCATED(AGRI_MODEL)) DEALLOCATE(AGRI_MODEL)
00109 IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_DEALLO",1,ZHOOK_HANDLE)
00110 END SUBROUTINE AGRI_DEALLO
00111 !-------------------------------------------------------------------------------
00112 !
00113 END MODULE MODD_AGRI_n