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

Go to the documentation of this file.
00001 !     ####################
00002       MODULE MODD_DUMMY_SURF_FIELDS_n
00003 !     ####################
00004 !
00005 !!****  *MODD_DUMMY_SURF_FIELDS* - declaration of dummy physiographic data arrays
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !       The purpose of this declarative module is to specify  the 
00010 !     dummy physiographic data arrays.
00011 !
00012 !!
00013 !!    AUTHOR
00014 !!    ------
00015 !!      V. Masson   *Meteo France*
00016 !!
00017 !!    MODIFICATIONS
00018 !!    -------------
00019 !!      Original    03/2004                      
00020 !-------------------------------------------------------------------------------
00021 !
00022 !*       0.   DECLARATIONS
00023 !             ------------
00024 !
00025 !
00026 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00027 USE PARKIND1  ,ONLY : JPRB
00028 !
00029 IMPLICIT NONE
00030 
00031 TYPE DUMMY_SURF_FIELDS_t
00032 !
00033   INTEGER                                          :: NDUMMY_NBR
00034 !                          ! number of dummy pgd fields chosen by user
00035   CHARACTER(LEN=3) , DIMENSION(:), POINTER         :: CDUMMY_AREA =>  NULL()
00036 !                          ! areas where dummy pgd fields are defined
00037 !                          ! 'ALL' : everywhere
00038 !                          ! 'SEA' : where sea exists
00039 !                          ! 'LAN' : where land exists
00040 !                          ! 'WAT' : where inland water exists
00041 !                          ! 'NAT' : where natural or agricultural areas exist
00042 !                          ! 'TWN' : where town areas exist
00043 !                          ! 'STR' : where streets are present
00044 !                          ! 'BLD' : where buildings are present
00045 !                          !
00046   CHARACTER(LEN=20), DIMENSION(:), POINTER         :: CDUMMY_NAME =>  NULL()
00047 !                          ! name of the dummy pgd fields (for information)
00048   REAL,              DIMENSION(:,:), POINTER       :: XDUMMY_FIELDS =>  NULL()
00049 !                          ! dummy pgd fields themselves
00050 !
00051 !-------------------------------------------------------------------------------
00052 !
00053 END TYPE DUMMY_SURF_FIELDS_t
00054 
00055 TYPE(DUMMY_SURF_FIELDS_t), ALLOCATABLE, TARGET, SAVE :: DUMMY_SURF_FIELDS_MODEL(:)
00056 LOGICAL, ALLOCATABLE, SAVE :: DUMMY_SURF_FIELDS_FIRST_CALL(:)
00057 
00058 INTEGER, POINTER :: NDUMMY_NBR=>NULL()
00059 !$OMP THREADPRIVATE(NDUMMY_NBR)
00060  CHARACTER(LEN=3) , DIMENSION(:), POINTER :: CDUMMY_AREA=>NULL()
00061 !$OMP THREADPRIVATE(CDUMMY_AREA)
00062  CHARACTER(LEN=20), DIMENSION(:), POINTER :: CDUMMY_NAME=>NULL()
00063 !$OMP THREADPRIVATE(CDUMMY_NAME)
00064 REAL,              DIMENSION(:,:), POINTER   :: XDUMMY_FIELDS=>NULL()
00065 !$OMP THREADPRIVATE(XDUMMY_FIELDS)
00066 
00067 CONTAINS
00068 
00069 SUBROUTINE DUMMY_SURF_FIELDS_GOTO_MODEL(KFROM, KTO, LKFROM)
00070 LOGICAL, INTENT(IN) :: LKFROM
00071 INTEGER, INTENT(IN) :: KFROM, KTO
00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00073 !
00074 ! Save current state for allocated arrays
00075 IF (LKFROM) THEN
00076 DUMMY_SURF_FIELDS_MODEL(KFROM)%XDUMMY_FIELDS=>XDUMMY_FIELDS
00077 ENDIF
00078 !
00079 IF (LHOOK) CALL DR_HOOK('MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_GOTO_MODEL',0,ZHOOK_HANDLE)
00080 IF (DUMMY_SURF_FIELDS_FIRST_CALL(KTO)) THEN
00081 ALLOCATE (DUMMY_SURF_FIELDS_MODEL(KTO)%CDUMMY_AREA(1000))
00082 ALLOCATE (DUMMY_SURF_FIELDS_MODEL(KTO)%CDUMMY_NAME(1000))
00083 DUMMY_SURF_FIELDS_FIRST_CALL(KTO) = .FALSE.
00084 ENDIF
00085 ! Current model is set to model KTO
00086 NDUMMY_NBR=>DUMMY_SURF_FIELDS_MODEL(KTO)%NDUMMY_NBR
00087 CDUMMY_AREA=>DUMMY_SURF_FIELDS_MODEL(KTO)%CDUMMY_AREA
00088 CDUMMY_NAME=>DUMMY_SURF_FIELDS_MODEL(KTO)%CDUMMY_NAME
00089 XDUMMY_FIELDS=>DUMMY_SURF_FIELDS_MODEL(KTO)%XDUMMY_FIELDS
00090 IF (LHOOK) CALL DR_HOOK('MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_GOTO_MODEL',1,ZHOOK_HANDLE)
00091 
00092 END SUBROUTINE DUMMY_SURF_FIELDS_GOTO_MODEL
00093 
00094 SUBROUTINE DUMMY_SURF_FIELDS_ALLOC(KMODEL)
00095 INTEGER, INTENT(IN) :: KMODEL
00096 INTEGER :: J
00097 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00098 IF (LHOOK) CALL DR_HOOK("MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_ALLOC",0,ZHOOK_HANDLE)
00099 ALLOCATE(DUMMY_SURF_FIELDS_MODEL(KMODEL))
00100 ALLOCATE(DUMMY_SURF_FIELDS_FIRST_CALL(KMODEL))
00101 DO J=1,KMODEL
00102   NULLIFY(DUMMY_SURF_FIELDS_MODEL(J)%CDUMMY_NAME)
00103   NULLIFY(DUMMY_SURF_FIELDS_MODEL(J)%CDUMMY_AREA)
00104 ENDDO
00105 DUMMY_SURF_FIELDS_MODEL(:)%NDUMMY_NBR=0
00106 DUMMY_SURF_FIELDS_FIRST_CALL(:)=.TRUE.
00107 IF (LHOOK) CALL DR_HOOK("MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_ALLOC",1,ZHOOK_HANDLE)
00108 END SUBROUTINE DUMMY_SURF_FIELDS_ALLOC
00109 
00110 SUBROUTINE DUMMY_SURF_FIELDS_DEALLO
00111 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00112 IF (LHOOK) CALL DR_HOOK("MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_DEALLO",0,ZHOOK_HANDLE)
00113 IF (ALLOCATED(DUMMY_SURF_FIELDS_MODEL)) DEALLOCATE(DUMMY_SURF_FIELDS_MODEL)
00114 IF (ALLOCATED(DUMMY_SURF_FIELDS_FIRST_CALL)) DEALLOCATE(DUMMY_SURF_FIELDS_FIRST_CALL)
00115 IF (LHOOK) CALL DR_HOOK("MODD_DUMMY_SURF_FIELDS_N:DUMMY_SURF_FIELDS_DEALLO",1,ZHOOK_HANDLE)
00116 END SUBROUTINE DUMMY_SURF_FIELDS_DEALLO
00117 
00118 END MODULE MODD_DUMMY_SURF_FIELDS_n