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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PGD_CHEMISTRY(HPROGRAM,OCH_EMIS)
00003 !     ##############################################################
00004 !
00005 !!**** *PGD_CHEMISTRY* monitor for averaging and interpolations of physiographic fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!
00026 !!    V. Masson        Meteo-France
00027 !!
00028 !!    MODIFICATION
00029 !!    ------------
00030 !!
00031 !!    Original    10/12/97
00032 !!
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 USE MODD_PGD_GRID,           ONLY : NL
00039 USE MODD_PGDWORK,            ONLY : CATYPE
00040 USE MODD_SURF_PAR,           ONLY : XUNDEF
00041 USE MODD_CH_EMIS_FIELD_n,    ONLY : JPEMISMAX, NEMIS_NBR, CEMIS_AREA, CEMIS_NAME, &
00042                                      CEMIS_COMMENT, NEMIS_TIME, XEMIS_FIELDS  
00043 USE MODD_SURF_ATM_n
00044 !
00045 USE MODI_GET_LUOUT
00046 USE MODI_PGD_FIELD
00047 USE MODI_OPEN_NAMELIST
00048 USE MODI_CLOSE_NAMELIST
00049 USE MODI_GET_SURF_SIZE_n
00050 USE MODI_UNPACK_SAME_RANK
00051 !
00052 USE MODE_POS_SURF
00053 !
00054 !
00055 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00056 USE PARKIND1  ,ONLY : JPRB
00057 !
00058 USE MODI_ABOR1_SFX
00059 !
00060 USE MODI_GET_SURF_MASK_n
00061 !
00062 IMPLICIT NONE
00063 !
00064 !*    0.1    Declaration of arguments
00065 !            ------------------------
00066 !
00067  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00068 LOGICAL,             INTENT(OUT)   :: OCH_EMIS     ! emission flag
00069 !
00070 !
00071 !*    0.2    Declaration of local variables
00072 !            ------------------------------
00073 !
00074 INTEGER                           :: ILUOUT    ! output listing logical unit
00075 INTEGER                           :: ILUNAM    ! namelist file logical unit
00076 LOGICAL                           :: GFOUND    ! flag when namelist is present
00077 INTEGER                           :: JNBR      ! loop counter on dummy fields
00078 INTEGER                           :: ILU, IL_SEA, IL_LAND, IL
00079 !
00080 !*    0.3    Declaration of namelists
00081 !            ------------------------
00082 !
00083 INTEGER                                :: NEMIS_PGD_NBR
00084  CHARACTER(LEN=40), DIMENSION(JPEMISMAX):: CEMIS_PGD_NAME
00085  CHARACTER(LEN=40), DIMENSION(JPEMISMAX):: CEMIS_PGD_COMMENT
00086 INTEGER,           DIMENSION(JPEMISMAX):: NEMIS_PGD_TIME
00087  CHARACTER(LEN=3),  DIMENSION(JPEMISMAX):: CEMIS_PGD_AREA
00088  CHARACTER(LEN=3),  DIMENSION(JPEMISMAX):: CEMIS_PGD_ATYPE
00089  CHARACTER(LEN=28), DIMENSION(JPEMISMAX):: CEMIS_PGD_FILE
00090  CHARACTER(LEN=6),  DIMENSION(JPEMISMAX):: CEMIS_PGD_FILETYPE
00091  CHARACTER(LEN=6)                       :: YMASK
00092 REAL, DIMENSION(:), ALLOCATABLE :: ZEMIS_FIELD, ZEMIS_FIELDS
00093 INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK
00094 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00095 
00096 !
00097 NAMELIST/NAM_CH_EMIS_PGD/ NEMIS_PGD_NBR,CEMIS_PGD_NAME,NEMIS_PGD_TIME,&
00098        CEMIS_PGD_COMMENT,CEMIS_PGD_AREA,CEMIS_PGD_ATYPE,CEMIS_PGD_FILE,&
00099        CEMIS_PGD_FILETYPE  
00100 !-------------------------------------------------------------------------------
00101 !
00102 !*    1.      Initializations of defaults
00103 !             ---------------------------
00104 !
00105 !
00106 IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY',0,ZHOOK_HANDLE)
00107 NEMIS_PGD_NBR = 0  
00108 CEMIS_PGD_NAME(:)    = '                           '
00109 NEMIS_PGD_TIME(:)    = 0
00110 CEMIS_PGD_COMMENT(:) = ''
00111 CEMIS_PGD_AREA(:)    = 'ALL'
00112 CEMIS_PGD_FILETYPE(:)= 'DIRECT'
00113 CEMIS_PGD_FILE(:)    = '                           '
00114 CEMIS_PGD_ATYPE(:)   = 'ARI'
00115 !
00116  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00117 !
00118 !-------------------------------------------------------------------------------
00119 !
00120 !*    2.      Reading of namelist
00121 !             -------------------
00122 !
00123 !
00124  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00125 !
00126  CALL POSNAM(ILUNAM,'NAM_CH_EMIS_PGD',GFOUND,ILUOUT)
00127 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMIS_PGD)
00128 !
00129  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00130 !
00131 !-------------------------------------------------------------------------------
00132 !
00133 !*    3.      Allocation
00134 !             ----------
00135 !
00136 NEMIS_NBR = NEMIS_PGD_NBR
00137 !
00138  CALL GET_SURF_SIZE_n('LAND', IL_LAND)
00139  CALL GET_SURF_SIZE_n('SEA   ',IL_SEA)
00140 !
00141 !
00142 ALLOCATE(ZEMIS_FIELDS (NL))
00143 !
00144 ALLOCATE(XEMIS_FIELDS (NL,NEMIS_NBR))
00145 ALLOCATE(CEMIS_AREA   (NEMIS_NBR))
00146 ALLOCATE(CEMIS_COMMENT(NEMIS_NBR))
00147 ALLOCATE(CEMIS_NAME   (NEMIS_NBR))
00148 ALLOCATE(NEMIS_TIME   (NEMIS_NBR))
00149 !
00150 CEMIS_AREA   (:) = CEMIS_PGD_AREA   (1:NEMIS_NBR)
00151 CEMIS_NAME   (:) = CEMIS_PGD_NAME   (1:NEMIS_NBR)
00152 NEMIS_TIME   (:) = NEMIS_PGD_TIME   (1:NEMIS_NBR)
00153 CEMIS_COMMENT(:) = CEMIS_PGD_COMMENT(1:NEMIS_NBR)
00154 !
00155 !
00156 !-------------------------------------------------------------------------------
00157 OCH_EMIS = NEMIS_NBR > 0
00158 !-------------------------------------------------------------------------------
00159 !
00160 !*    4.      Computations
00161 !             ------------
00162 !
00163 DO JNBR=1,NEMIS_NBR
00164   CATYPE = CEMIS_PGD_ATYPE(JNBR)
00165   SELECT CASE (CEMIS_AREA(JNBR))
00166     CASE ('LAN')
00167       IL = IL_LAND
00168       YMASK='LAND  '
00169     CASE ('SEA')
00170       IL = IL_SEA
00171       YMASK='SEA   '
00172     CASE ('ALL')
00173       IL = NL
00174       YMASK='FULL  '
00175     CASE DEFAULT
00176       CALL ABOR1_SFX('PGD_CHEMISTRY (1): EMISSION AREA NOT SUPPORTED')
00177   END SELECT
00178   ALLOCATE(ZEMIS_FIELD (IL))
00179   ALLOCATE(IMASK(IL))
00180   !*    4.1     Computes the field on the surface points where it is defined
00181   CALL PGD_FIELD(HPROGRAM,CEMIS_NAME(JNBR),CEMIS_AREA(JNBR),CEMIS_PGD_FILE(JNBR), &
00182                    CEMIS_PGD_FILETYPE(JNBR),XUNDEF,ZEMIS_FIELD(:)             )  
00183   CATYPE = 'ARI'
00184   
00185 !*    4.2     Expends field on all surface points
00186   ILU=0
00187   CALL GET_SURF_MASK_n(YMASK,IL,IMASK,ILU,ILUOUT)
00188   CALL UNPACK_SAME_RANK(IMASK,ZEMIS_FIELD(:),ZEMIS_FIELDS(:))
00189   DEALLOCATE(ZEMIS_FIELD)
00190   DEALLOCATE(IMASK)
00191 
00192   
00193 !*    4.3      Weights field on all surface points 
00194 !              (zero weight where field is not defined)
00195   SELECT CASE (CEMIS_AREA(JNBR))
00196     CASE ('LAN')
00197       XEMIS_FIELDS(:,JNBR) = (XNATURE(:)+XTOWN(:))*ZEMIS_FIELDS(:) 
00198     CASE ('SEA')
00199       XEMIS_FIELDS(:,JNBR) = XSEA*ZEMIS_FIELDS(:)
00200     CASE ('ALL')
00201       XEMIS_FIELDS(:,JNBR) = ZEMIS_FIELDS(:)
00202     CASE DEFAULT
00203       CALL ABOR1_SFX('PGD_CHEMISTRY (2): EMISSION AREA NOT SUPPORTED')
00204   END SELECT
00205 END DO
00206 DEALLOCATE(ZEMIS_FIELDS)
00207 IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY',1,ZHOOK_HANDLE)
00208 !
00209 !-------------------------------------------------------------------------------
00210 !
00211 !*    5.      Expends 
00212 !             ------------
00213 !
00214 
00215 !-------------------------------------------------------------------------------
00216 !
00217 END SUBROUTINE PGD_CHEMISTRY