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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE ZOOM_PGD_COVER(HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP)
00003 !     ###########################################################
00004 
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !!   This program prepares the physiographic data fields.
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!
00027 !!    V. Masson                   Meteo-France
00028 !!
00029 !!    MODIFICATION
00030 !!    ------------
00031 !!
00032 !!    Original     13/10/03
00033 !     Modification 17/04/12 M.Tomasini All COVER physiographic fields are now 
00034 !!                                     interpolated for spawning => 
00035 !!                                     ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
00036 !----------------------------------------------------------------------------
00037 !
00038 !*    0.     DECLARATION
00039 !            -----------
00040 !
00041 USE MODD_DATA_COVER_PAR,   ONLY : JPCOVER
00042 USE MODD_SURF_ATM_GRID_n,  ONLY : XLAT, XLON, CGRID, XGRID_PAR
00043 USE MODD_SURF_ATM_n,       ONLY : XCOVER, LCOVER, XSEA, XWATER, XNATURE, XTOWN, &
00044                                     NSIZE_NATURE, NSIZE_SEA, NR_NATURE, NR_SEA, &
00045                                     NSIZE_TOWN, NSIZE_WATER,NR_TOWN,NR_WATER,NSIZE_FULL,&
00046                                     NDIM_NATURE, NDIM_SEA,                  &
00047                                     NDIM_TOWN,NDIM_WATER,NDIM_FULL  
00048 USE MODD_PREP,             ONLY : CINGRID_TYPE, CINTERP_TYPE
00049 !
00050 USE MODI_CONVERT_COVER_FRAC
00051 USE MODI_OPEN_AUX_IO_SURF
00052 USE MODI_READ_SURF
00053 USE MODI_CLOSE_AUX_IO_SURF
00054 USE MODI_PREP_GRID_EXTERN
00055 USE MODI_HOR_INTERPOL
00056 USE MODI_PREP_OUTPUT_GRID
00057 USE MODI_OLD_NAME
00058 USE MODI_SUM_ON_ALL_PROCS
00059 USE MODI_GET_LUOUT
00060 USE MODI_CLEAN_PREP_OUTPUT_GRID
00061 USE MODI_GET_1D_MASK
00062 !
00063 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00064 USE PARKIND1  ,ONLY : JPRB
00065 !
00066 IMPLICIT NONE
00067 !
00068 !*    0.1    Declaration of dummy arguments
00069 !            ------------------------------
00070 !
00071  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
00072  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
00073  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
00074 LOGICAL,              INTENT(OUT) :: OECOCLIMAP  ! flag to use ecoclimap
00075 !
00076 !
00077 !*    0.2    Declaration of local variables
00078 !            ------------------------------
00079 !
00080 INTEGER :: IRESP
00081 INTEGER :: ILUOUT
00082 INTEGER :: INI     ! total 1D dimension (input grid)
00083 INTEGER :: IL      ! total 1D dimension (output grid)
00084 INTEGER :: JCOVER  ! loop counter
00085 INTEGER :: IVERSION       ! surface version
00086 REAL, DIMENSION(:,:), POINTER     :: ZCOVER
00087 REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
00088 REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
00089 REAL, DIMENSION(:),   ALLOCATABLE :: ZSUM
00090  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00091 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00092 !------------------------------------------------------------------------------
00093 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
00094  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00095 !
00096 !*      1.     Preparation of IO for reading in the file
00097 !              -----------------------------------------
00098 !
00099 !* Note that all points are read, even those without physical meaning.
00100 !  These points will not be used during the horizontal interpolation step.
00101 !  Their value must be defined as XUNDEF.
00102 !
00103  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
00104 !
00105  CALL READ_SURF(HPROGRAM,'ECOCLIMAP',OECOCLIMAP,IRESP)
00106 !
00107 !------------------------------------------------------------------------------
00108 !
00109 !*      2.     Reading of grid
00110 !              ---------------
00111 !
00112  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
00113 !
00114  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
00115 !
00116 !------------------------------------------------------------------------------
00117 !
00118 !*      3.     Reading of cover
00119 !              ----------------
00120 !
00121 YRECFM='VERSION'
00122  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00123 !
00124 ALLOCATE(LCOVER(JPCOVER))
00125  CALL OLD_NAME(HPROGRAM,'COVER_LIST      ',YRECFM)
00126  CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
00127 !
00128 ALLOCATE(ZCOVER(INI,JPCOVER))
00129  CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),LCOVER,IRESP,HDIR='A')
00130 !
00131 ALLOCATE(ZSEA1   (INI,1))
00132 ALLOCATE(ZNATURE1(INI,1))
00133 ALLOCATE(ZWATER1 (INI,1))
00134 ALLOCATE(ZTOWN1  (INI,1))
00135 !
00136 IF (IVERSION>=7) THEN
00137   CALL READ_SURF(HPROGRAM,'FRAC_SEA   ',ZSEA1(:,1),   IRESP,HDIR='A')
00138   CALL READ_SURF(HPROGRAM,'FRAC_NATURE',ZNATURE1(:,1),IRESP,HDIR='A')
00139   CALL READ_SURF(HPROGRAM,'FRAC_WATER ',ZWATER1(:,1), IRESP,HDIR='A')
00140   CALL READ_SURF(HPROGRAM,'FRAC_TOWN  ',ZTOWN1(:,1),  IRESP,HDIR='A')
00141   !
00142 ELSE
00143   CALL CONVERT_COVER_FRAC(ZCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
00144 ENDIF
00145 !
00146  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
00147 !------------------------------------------------------------------------------
00148 !
00149 !*      4.     Interpolations
00150 !              --------------
00151 !
00152 IL = SIZE(XLAT)
00153 ALLOCATE(XCOVER(IL,JPCOVER))
00154 !
00155  CALL HOR_INTERPOL(ILUOUT,ZCOVER,XCOVER)
00156 !
00157 DEALLOCATE(ZCOVER)
00158 !
00159 ALLOCATE(ZSEA2  (IL,1))
00160 ALLOCATE(ZNATURE2(IL,1))
00161 ALLOCATE(ZWATER2 (IL,1))
00162 ALLOCATE(ZTOWN2  (IL,1))
00163 !
00164  CALL HOR_INTERPOL(ILUOUT,ZSEA1,ZSEA2)
00165  CALL HOR_INTERPOL(ILUOUT,ZNATURE1,ZNATURE2)
00166  CALL HOR_INTERPOL(ILUOUT,ZWATER1,ZWATER2)
00167  CALL HOR_INTERPOL(ILUOUT,ZTOWN1,ZTOWN2)
00168 !
00169 DEALLOCATE(ZSEA1)
00170 DEALLOCATE(ZNATURE1)
00171 DEALLOCATE(ZWATER1)
00172 DEALLOCATE(ZTOWN1)
00173 !
00174 ALLOCATE(XSEA   (IL))
00175 ALLOCATE(XNATURE(IL))
00176 ALLOCATE(XWATER (IL))
00177 ALLOCATE(XTOWN  (IL))
00178 !
00179 XSEA(:)   = ZSEA2   (:,1)
00180 XNATURE(:)= ZNATURE2(:,1)
00181 XWATER(:) = ZWATER2 (:,1)
00182 XTOWN(:)  = ZTOWN2  (:,1)
00183 !
00184 DEALLOCATE(ZSEA2)
00185 DEALLOCATE(ZNATURE2)
00186 DEALLOCATE(ZWATER2)
00187 DEALLOCATE(ZTOWN2)
00188 !
00189  CALL CLEAN_PREP_OUTPUT_GRID
00190 !------------------------------------------------------------------------------
00191 !
00192 !*      5.     Coherence check
00193 !              ---------------
00194 ! 
00195 ALLOCATE(ZSUM(IL))
00196 ZSUM = 0.
00197 DO JCOVER=1,JPCOVER
00198   ZSUM(:) = ZSUM(:) + XCOVER(:,JCOVER)
00199 END DO
00200 !
00201 DO JCOVER=1,JPCOVER
00202   XCOVER(:,JCOVER) = XCOVER(:,JCOVER)/ZSUM(:)
00203 END DO
00204 !
00205 DO JCOVER=1,JPCOVER
00206   IF (ALL(XCOVER(:,JCOVER)==0.)) LCOVER(JCOVER) = .FALSE.
00207 END DO
00208 !------------------------------------------------------------------------------
00209 !
00210 !*      6.     Fractions
00211 !              ---------
00212 !
00213 ! When the model runs in multiproc, NSIZE* represents the number of points
00214 ! on a proc, and NDIM* the total number of points on all procs.
00215 ! The following definition of NDIM* won't be correct any more when the PGD
00216 ! runs in multiproc.
00217 !
00218 NSIZE_NATURE    = COUNT(XNATURE(:) > 0.0)
00219 NSIZE_WATER     = COUNT(XWATER (:) > 0.0)
00220 NSIZE_SEA       = COUNT(XSEA   (:) > 0.0)
00221 NSIZE_TOWN      = COUNT(XTOWN  (:) > 0.0)
00222 NSIZE_FULL      = IL
00223 !
00224 NDIM_NATURE    = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XNATURE(:) > 0., 'DIM')
00225 NDIM_WATER     = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XWATER (:) > 0., 'DIM')
00226 NDIM_SEA       = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XSEA   (:) > 0., 'DIM')
00227 NDIM_TOWN      = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XTOWN  (:) > 0., 'DIM')
00228 ZSUM=1.
00229 NDIM_FULL      = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,ZSUM   (:) ==1., 'DIM')
00230 DEALLOCATE(ZSUM)
00231 !
00232 ALLOCATE(NR_NATURE (NSIZE_NATURE))
00233 ALLOCATE(NR_TOWN   (NSIZE_TOWN  ))
00234 ALLOCATE(NR_WATER  (NSIZE_WATER ))
00235 ALLOCATE(NR_SEA    (NSIZE_SEA   ))
00236 !
00237 IF (NSIZE_SEA   >0)CALL GET_1D_MASK( NSIZE_SEA,    NSIZE_FULL, XSEA   , NR_SEA   )
00238 IF (NSIZE_WATER >0)CALL GET_1D_MASK( NSIZE_WATER,  NSIZE_FULL, XWATER , NR_WATER )
00239 IF (NSIZE_TOWN  >0)CALL GET_1D_MASK( NSIZE_TOWN,   NSIZE_FULL, XTOWN  , NR_TOWN  )
00240 IF (NSIZE_NATURE>0)CALL GET_1D_MASK( NSIZE_NATURE, NSIZE_FULL, XNATURE, NR_NATURE)
00241 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',1,ZHOOK_HANDLE)
00242 
00243 !_______________________________________________________________________________
00244 !
00245 END SUBROUTINE ZOOM_PGD_COVER