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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PGD_GAUSS_INDEX(HPROGRAM,OZS)
00003 !     #########################################
00004 !!
00005 !!    PURPOSE
00006 !!    -------
00007 !!     
00008 !!    Initialize the gaussien grid mesh index where point (lat,lon) at heigh resolution is located
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 !!    B. Decharme                   Meteo-France
00028 !!
00029 !!    MODIFICATION
00030 !!    ------------
00031 !!
00032 !!    Original     02/2010
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 USE MODI_GET_LUOUT
00039 USE MODI_READ_NAM_PGD_GAUSS_INDEX
00040 !
00041 USE MODI_GAUSS_INDEX
00042 !
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 USE MODI_ABOR1_SFX
00048 !
00049 IMPLICIT NONE
00050 !
00051 !*    0.1    Declaration of dummy arguments
00052 !            ------------------------------
00053 !
00054  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM
00055 LOGICAL,           INTENT(IN)  :: OZS      ! .true. if orography is imposed by atm. model
00056 !
00057 !
00058 !*    0.2    Declaration of local variables
00059 !            ------------------------------
00060 !
00061  CHARACTER(LEN=5)            :: YRES_COMP    ! Resolution in file 
00062  CHARACTER(LEN=6)            :: YFLAG
00063 INTEGER                     :: ILUOUT       ! output listing logical unit
00064 LOGICAL                     :: LNOPERFORM
00065 !
00066 !*    0.3    Declaration of namelist
00067 !            -----------------------
00068 !
00069 LOGICAL                  :: LINDEX_STORE      ! Store index in a binary file
00070  CHARACTER(LEN=28)        :: YINDEX_1KM        ! file name for gauss index at 1km
00071  CHARACTER(LEN=28)        :: YINDEX_10KM       ! file name for gauss index at 10km
00072  CHARACTER(LEN=28)        :: YINDEX_100KM      ! file name for gauss index at 100km
00073  CHARACTER(LEN=28)        :: YCOVER            ! file name for cover types
00074  CHARACTER(LEN=28)        :: YZS               ! file name for orography
00075  CHARACTER(LEN=28)        :: YSAND             ! file name for sand fraction
00076  CHARACTER(LEN=28)        :: YCLAY             ! file name for clay fraction
00077  CHARACTER(LEN=28)        :: YCTI              ! file name for topographic index
00078  CHARACTER(LEN=28)        :: YPERM             ! file name for permafrost map
00079  CHARACTER(LEN=28)        :: YSOC_TOP          ! file name for organic carbon
00080  CHARACTER(LEN=28)        :: YSOC_SUB          ! file name for organic carbon
00081 !
00082 LOGICAL                  :: LIMP_COVER        ! Imposed values for Cover from another PGD file
00083 LOGICAL                  :: LIMP_ZS           ! Imposed orography from another PGD file
00084 LOGICAL                  :: LIMP_SAND         ! Imposed maps of Sand from another PGD file
00085 LOGICAL                  :: LIMP_CLAY         ! Imposed maps of Clay from another PGD file
00086 LOGICAL                  :: LIMP_CTI          ! Imposed values for topographic index statistics from another PGD file
00087 LOGICAL                  :: LIMP_PERM         ! Imposed values for topographic index statistics from another PGD file
00088 LOGICAL                  :: LIMP_SOC          ! Imposed maps of organic carbon
00089 !
00090 LOGICAL                  :: LUNIF_COVER
00091 LOGICAL                  :: LUNIF_ZS
00092 LOGICAL                  :: LUNIF_SAND
00093 LOGICAL                  :: LUNIF_CLAY
00094 LOGICAL                  :: LUNIF_CTI
00095 LOGICAL                  :: LUNIF_PERM
00096 LOGICAL                  :: LUNIF_SOC
00097 LOGICAL                  :: LSTOP_PGD
00098 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00099 !
00100 !---------------------------------------------------------------
00101 !*    1.      Initializations
00102 !-------------------------------------------------------------------------------
00103 !
00104 IF (LHOOK) CALL DR_HOOK('PGD_GAUSS_INDEX',0,ZHOOK_HANDLE)
00105 YRES_COMP='     '
00106 !
00107  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00108 !
00109 !-------------------------------------------------------------------------------
00110 !*    2.      Read all namelists
00111 !-------------------------------------------------------------------------------
00112 !
00113  CALL READ_NAM_PGD_GAUSS_INDEX(HPROGRAM,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,  &
00114                               YINDEX_100KM,YCOVER,YZS,YCLAY,YSAND,YCTI,      &
00115                               YPERM,YSOC_TOP,YSOC_SUB,                       &
00116                               LIMP_COVER,LIMP_ZS,LIMP_CLAY,LIMP_SAND,        &
00117                               LIMP_CTI,LIMP_PERM,LIMP_SOC,                   &
00118                               LUNIF_COVER,LUNIF_ZS,LUNIF_SAND,LUNIF_CLAY,    &
00119                               LUNIF_CTI,LUNIF_PERM,LUNIF_SOC,                &
00120                               LSTOP_PGD                                      )  
00121 !
00122 !-------------------------------------------------------------------------------
00123 !*    3.      Check consitensy
00124 !-------------------------------------------------------------------------------
00125 !
00126 IF(LIMP_COVER.AND.LIMP_ZS.AND.LIMP_CLAY.AND.LIMP_SAND.AND.LIMP_CTI.AND.LIMP_PERM.AND.LIMP_SOC)THEN
00127   WRITE(ILUOUT,*) '*****************************************************'
00128   WRITE(ILUOUT,*)'All pgd fields are imposed from another PGD file      '
00129   WRITE(ILUOUT,*)'Consequently, Gauss indexes are not calculated or read'
00130   WRITE(ILUOUT,*) '*****************************************************'
00131   IF (LHOOK) CALL DR_HOOK('PGD_GAUSS_INDEX',1,ZHOOK_HANDLE)
00132   RETURN
00133 ENDIF
00134 !
00135 IF(LUNIF_COVER.AND.LUNIF_ZS.AND.LUNIF_CLAY.AND.LUNIF_SAND.AND.LUNIF_CTI.AND.LUNIF_PERM.AND.LUNIF_SOC)THEN
00136   WRITE(ILUOUT,*) '*****************************************************'
00137   WRITE(ILUOUT,*)'All pgd fields are prescribed                         '
00138   WRITE(ILUOUT,*)'Consequently, Gauss indexes are not calculated or read'
00139   WRITE(ILUOUT,*) '*****************************************************'
00140   IF (LHOOK) CALL DR_HOOK('PGD_GAUSS_INDEX',1,ZHOOK_HANDLE)
00141   RETURN
00142 ENDIF
00143 !
00144 IF (LEN_TRIM(YCOVER)==0.AND..NOT.LUNIF_COVER) THEN
00145   WRITE(ILUOUT,*) ' '
00146   WRITE(ILUOUT,*) '***********************************************************'
00147   WRITE(ILUOUT,*) '* Error in COVER fractions preparation                    *'
00148   WRITE(ILUOUT,*) '* There is no prescribed cover fraction and no input file *'
00149   WRITE(ILUOUT,*) '***********************************************************'
00150   WRITE(ILUOUT,*) ' '
00151   CALL ABOR1_SFX('GAUSS_INDEX: NO PRESCRIBED COVER NOR INPUT FILE')
00152 ELSEIF (LEN_TRIM(YZS)==0.AND..NOT.LUNIF_ZS.AND..NOT.OZS) THEN
00153   WRITE(ILUOUT,*) ' '
00154   WRITE(ILUOUT,*) '***********************************************************'
00155   WRITE(ILUOUT,*) '* Error in orography preparation                          *'
00156   WRITE(ILUOUT,*) '* There is no prescribed orography and no input file      *'
00157   WRITE(ILUOUT,*) '***********************************************************'
00158   WRITE(ILUOUT,*) ' '
00159   CALL ABOR1_SFX('GAUSS_INDEX: NO PRESCRIBED OROGRAPHY NOR INPUT FILE')
00160 ENDIF
00161 !
00162 !-------------------------------------------------------------------------------
00163 !*    4.      Calculate gauss indexes
00164 !-------------------------------------------------------------------------------
00165 !
00166 !* 4.1 Orography treatment
00167 !  -----------------------
00168 !
00169 LNOPERFORM=(OZS.OR.LUNIF_ZS.OR.LIMP_ZS)
00170 !
00171 IF(LEN_TRIM(YZS)/=0.AND..NOT.LNOPERFORM)THEN
00172 !
00173   YFLAG='A_OROG'
00174   CALL GAUSS_INDEX(HPROGRAM,YZS,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00175 !  
00176 ENDIF
00177 !
00178 YFLAG='NONE'
00179 !
00180 !* 4.2 Cover treatment
00181 !  -------------------
00182 !
00183 LNOPERFORM=(LUNIF_COVER.OR.LIMP_COVER)
00184 !
00185 IF(LEN_TRIM(YCOVER)/=0.AND..NOT.LNOPERFORM)THEN
00186 !
00187   CALL GAUSS_INDEX(HPROGRAM,YCOVER,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00188 !  
00189 ENDIF
00190 !
00191 !* 4.3 Nature treatment
00192 !  --------------------
00193 !
00194 LNOPERFORM=(LUNIF_CLAY.OR.LIMP_CLAY)
00195 !
00196 IF(LEN_TRIM(YCLAY)/=0.AND..NOT.LNOPERFORM)THEN
00197 !
00198   CALL GAUSS_INDEX(HPROGRAM,YCLAY,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00199 !  
00200 ENDIF
00201 !
00202 LNOPERFORM=(LUNIF_SAND.OR.LIMP_SAND)
00203 !
00204 IF(LEN_TRIM(YSAND)/=0.AND..NOT.LNOPERFORM)THEN
00205 !
00206   CALL GAUSS_INDEX(HPROGRAM,YSAND,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00207 !  
00208 ENDIF
00209 !
00210 LNOPERFORM=(LUNIF_CTI.OR.LIMP_CTI)
00211 !
00212 IF(LEN_TRIM(YCTI)/=0.AND..NOT.LNOPERFORM)THEN
00213 !
00214   CALL GAUSS_INDEX(HPROGRAM,YCTI,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00215 !  
00216 ENDIF
00217 !
00218 LNOPERFORM=(LUNIF_PERM.OR.LIMP_PERM)
00219 !
00220 IF(LEN_TRIM(YPERM)/=0.AND..NOT.LNOPERFORM)THEN
00221 !
00222   CALL GAUSS_INDEX(HPROGRAM,YPERM,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00223 !  
00224 ENDIF
00225 !
00226 LNOPERFORM=(LUNIF_SOC.OR.LIMP_SOC)
00227 !
00228 IF((LEN_TRIM(YSOC_TOP)==0.AND.LEN_TRIM(YSOC_SUB)/=0).OR.(LEN_TRIM(YSOC_TOP)/=0.AND.LEN_TRIM(YSOC_SUB)==0))THEN
00229   WRITE(ILUOUT,*) ' '
00230   WRITE(ILUOUT,*) '***********************************************************'
00231   WRITE(ILUOUT,*) '* Error in soil organic carbon preparation                *'
00232   WRITE(ILUOUT,*) '* If used, sub and top soil input file must be given      *'
00233   WRITE(ILUOUT,*) '***********************************************************'
00234   WRITE(ILUOUT,*) ' '
00235   CALL ABOR1_SFX('GAUSS_INDEX: TOP AND SUB SOC INPUT FILE REQUIRED')        
00236 ENDIF
00237 !
00238 IF(LEN_TRIM(YSOC_TOP)/=0.AND.LEN_TRIM(YSOC_SUB)/=0.AND..NOT.LNOPERFORM)THEN
00239 !
00240   CALL GAUSS_INDEX(HPROGRAM,YSOC_TOP,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00241   CALL GAUSS_INDEX(HPROGRAM,YSOC_SUB,YFLAG,LINDEX_STORE,YINDEX_1KM,YINDEX_10KM,YINDEX_100KM,YRES_COMP)
00242 !  
00243 ENDIF
00244 !
00245 !-------------------------------------------------------------------------------
00246 !*    4.      Stop PGD after storage of gauss index if required
00247 !-------------------------------------------------------------------------------
00248 !
00249 IF(LSTOP_PGD)THEN
00250   WRITE(ILUOUT,*) '**************************************************************'
00251   WRITE(ILUOUT,*) 'GAUSS_INDEX: Stop PGD after storage of gauss index as required'
00252   WRITE(ILUOUT,*) '**************************************************************'
00253   STOP 'GAUSS_INDEX: Stop PGD after storage of gauss index as required'
00254 ENDIF
00255 IF (LHOOK) CALL DR_HOOK('PGD_GAUSS_INDEX',1,ZHOOK_HANDLE)
00256 !
00257 !-------------------------------------------------------------------------------
00258 !
00259 END SUBROUTINE PGD_GAUSS_INDEX