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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PGD_FLAKE(HPROGRAM)
00003 !     ##############################################################
00004 !
00005 !!**** *PGD_FLAKE* monitor for averaging and interpolations of FLAKE 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    03/2004
00032 !!
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 USE MODD_DATA_LAKE,      ONLY : CLAKELDB, CSTATUSLDB
00039 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
00040 USE MODD_SURF_PAR,       ONLY : XUNDEF
00041 USE MODD_FLAKE_n,        ONLY : XCOVER, LCOVER, XZS, &
00042                                   XWATER_DEPTH  , &
00043                                   XWATER_FETCH  , &
00044                                   XT_BS         , &
00045                                   XDEPTH_BS     , &
00046                                   XEXTCOEF_WATER    
00047  
00048 USE MODD_FLAKE_GRID_n,  ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE, NDIM
00049 !
00050 USE MODI_ABOR1_SFX
00051 USE MODI_GET_LUOUT
00052 USE MODI_PGD_FIELD
00053 
00054 USE MODI_GET_SURF_SIZE_n
00055 USE MODI_PACK_PGD
00056 !
00057 USE MODI_OPEN_NAMELIST
00058 USE MODI_CLOSE_NAMELIST
00059 !
00060 USE MODI_TREAT_GLOBAL_LAKE_DEPTH
00061 !
00062 USE MODE_POS_SURF
00063 !
00064 !
00065 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00066 USE PARKIND1  ,ONLY : JPRB
00067 !
00068 USE MODI_WRITE_COVER_TEX_WATER
00069 !
00070 IMPLICIT NONE
00071 !
00072 !*    0.1    Declaration of arguments
00073 !            ------------------------
00074 !
00075  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00076 
00077 !
00078 !
00079 !*    0.2    Declaration of local variables
00080 !            ------------------------------
00081 !
00082 INTEGER                           :: ILUOUT    ! output listing logical unit
00083 INTEGER                           :: ILUNAM    ! namelist file logical unit
00084 LOGICAL                           :: GFOUND    ! flag when namelist is present
00085 INTEGER,DIMENSION(:),ALLOCATABLE  :: IWATER_STATUS
00086 !
00087 !*    0.3    Declaration of namelists
00088 !            ------------------------
00089 !
00090  CHARACTER(LEN=28)        :: YWATER_DEPTH  ! file name for water depth
00091  CHARACTER(LEN=28)        :: YWATER_DEPTH_STATUS  ! file name for water depth status
00092  CHARACTER(LEN=28)        :: YWATER_FETCH
00093  CHARACTER(LEN=28)        :: YT_BS
00094  CHARACTER(LEN=28)        :: YDEPTH_BS
00095  CHARACTER(LEN=28)        :: YEXTCOEF_WATER
00096 
00097  CHARACTER(LEN=6)         :: YWATER_DEPTHFILETYPE ! water depth file type
00098  CHARACTER(LEN=6)         :: YWATER_FETCHFILETYPE
00099  CHARACTER(LEN=6)         :: YT_BSFILETYPE
00100  CHARACTER(LEN=6)         :: YDEPTH_BSFILETYPE
00101  CHARACTER(LEN=6)         :: YEXTCOEF_WATERFILETYPE
00102 
00103 REAL                     :: XUNIF_WATER_DEPTH   ! uniform value of water depth
00104 REAL                     :: XUNIF_WATER_FETCH
00105 REAL                     :: XUNIF_T_BS
00106 REAL                     :: XUNIF_DEPTH_BS
00107 REAL                     :: XUNIF_EXTCOEF_WATER
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 !
00110 NAMELIST/NAM_DATA_FLAKE/ YWATER_DEPTH, YWATER_DEPTH_STATUS, YWATER_DEPTHFILETYPE,     &
00111                          XUNIF_WATER_DEPTH, YWATER_FETCH, YWATER_FETCHFILETYPE,       &
00112                          XUNIF_WATER_FETCH, YT_BS, YT_BSFILETYPE, XUNIF_T_BS,         &
00113                          YDEPTH_BS, YDEPTH_BSFILETYPE, XUNIF_DEPTH_BS,                &
00114                          YEXTCOEF_WATER, YEXTCOEF_WATERFILETYPE, XUNIF_EXTCOEF_WATER  
00115 !-------------------------------------------------------------------------------
00116 !
00117 IF (LHOOK) CALL DR_HOOK('PGD_FLAKE',0,ZHOOK_HANDLE)
00118  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00119 !
00120 !-------------------------------------------------------------------------------
00121 !
00122 !*    1.      Initializations of defaults
00123 !             ---------------------------
00124 !
00125 XUNIF_WATER_DEPTH  = 20.
00126 XUNIF_WATER_FETCH  = 1000.
00127 XUNIF_T_BS         = 286.
00128 XUNIF_DEPTH_BS     = 1.
00129 XUNIF_EXTCOEF_WATER= 3.
00130 !
00131 YWATER_DEPTH        = '                          '
00132 YWATER_DEPTH_STATUS = '                          '
00133 YWATER_FETCH        = '                          '
00134 YT_BS               = '                          '
00135 YDEPTH_BS           = '                          '
00136 YEXTCOEF_WATER      = '                          '
00137 !
00138 YWATER_DEPTHFILETYPE   = '      '
00139 YWATER_FETCHFILETYPE   = '      '
00140 YT_BSFILETYPE          = '      '
00141 YDEPTH_BSFILETYPE      = '      '
00142 YEXTCOEF_WATERFILETYPE = '      '
00143 
00144 !
00145 !-------------------------------------------------------------------------------
00146 !
00147 !*    2.      Reading of namelist
00148 !             -------------------
00149 !
00150  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00151 !
00152  CALL POSNAM(ILUNAM,'NAM_DATA_FLAKE',GFOUND,ILUOUT)
00153 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_FLAKE)
00154 !
00155  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00156 !
00157 !-------------------------------------------------------------------------------
00158 !
00159 !*    3.      Coherence of options
00160 !             --------------------
00161 !
00162 !-------------------------------------------------------------------------------
00163 !
00164 !*    4.      Number of points and packing
00165 !             ----------------------------
00166 !
00167  CALL GET_SURF_SIZE_n('WATER ',NDIM)
00168 !
00169 ALLOCATE(LCOVER     (JPCOVER))
00170 ALLOCATE(XCOVER     (NDIM,JPCOVER))
00171 ALLOCATE(XZS        (NDIM))
00172 ALLOCATE(XLAT       (NDIM))
00173 ALLOCATE(XLON       (NDIM))
00174 ALLOCATE(XMESH_SIZE (NDIM))
00175 !
00176  CALL PACK_PGD(HPROGRAM, 'WATER ',                    &
00177                 CGRID,  XGRID_PAR,                     &
00178                 LCOVER, XCOVER, XZS,                   &
00179                 XLAT, XLON, XMESH_SIZE                 )  
00180 !
00181 !-------------------------------------------------------------------------------
00182 !
00183 !*    5.      Water depth
00184 !             -----------
00185 !
00186 ALLOCATE(XWATER_DEPTH  (NDIM)) 
00187 !
00188 IF (TRIM(YWATER_DEPTH)==TRIM(CLAKELDB) .AND. TRIM(YWATER_DEPTHFILETYPE)=='DIRECT') THEN
00189   !      
00190   IF (TRIM(YWATER_DEPTH_STATUS)=='') THEN
00191      WRITE(ILUOUT,*)'Depth Status file name not initialized'
00192      WRITE(ILUOUT,*)'add YWATER_DEPTH_STATUS="GlobalLakeStatus" in NAM_DATA_FLAKE'
00193      CALL ABOR1_SFX('PGD_FLAKE: STATUS INPUT FILE NAME NOT SET')
00194   ELSEIF (TRIM(YWATER_DEPTH_STATUS)==TRIM(CSTATUSLDB)) THEN
00195      ALLOCATE(IWATER_STATUS  (NDIM))       
00196      CALL TREAT_GLOBAL_LAKE_DEPTH(HPROGRAM,XWATER_DEPTH(:),IWATER_STATUS(:))
00197   ELSE
00198      WRITE(ILUOUT,*)'Wrong name for Depth Status file :',' expected: ',TRIM(CSTATUSLDB),' input: ',TRIM(YWATER_DEPTH_STATUS)
00199      CALL ABOR1_SFX('PGD_FLAKE: WRONG STATUS INPUT FILE NAME')
00200   ENDIF
00201   !
00202 ELSE
00203   !
00204   CALL PGD_FIELD(HPROGRAM,'water depth','WAT',YWATER_DEPTH,YWATER_DEPTHFILETYPE,XUNIF_WATER_DEPTH,XWATER_DEPTH(:))
00205   !
00206 ENDIF
00207 !
00208 !-------------------------------------------------------------------------------
00209 !
00210 !*    6.      Wind fetch
00211 !             ----------
00212 !
00213 ALLOCATE(XWATER_FETCH  (NDIM)) 
00214 !
00215  CALL PGD_FIELD(HPROGRAM,'wind fetch','WAT',YWATER_FETCH,YWATER_FETCHFILETYPE,XUNIF_WATER_FETCH,XWATER_FETCH(:))
00216 !
00217 !-------------------------------------------------------------------------------
00218 !
00219 !*    7.      Sediments bottom temperature
00220 !             ----------------------------
00221 !
00222 ALLOCATE(XT_BS         (NDIM)) 
00223 !
00224  CALL PGD_FIELD(HPROGRAM,'sediments bottom temperature ','WAT',YT_BS,YT_BSFILETYPE,XUNIF_T_BS,XT_BS(:))
00225 !
00226 !-------------------------------------------------------------------------------
00227 !
00228 !*    8.      Depth of sediments layer
00229 !             ------------------------
00230 !
00231 ALLOCATE(XDEPTH_BS     (NDIM)) 
00232 !
00233  CALL PGD_FIELD(HPROGRAM,'depth of sediments layer','WAT',YDEPTH_BS,YDEPTH_BSFILETYPE,XUNIF_DEPTH_BS,XDEPTH_BS(:))
00234 !
00235 !-------------------------------------------------------------------------------
00236 !
00237 !*    9.      Water extinction coefficient
00238 !             ----------------------------
00239 
00240 ALLOCATE(XEXTCOEF_WATER(NDIM)) 
00241 !
00242  CALL PGD_FIELD(HPROGRAM,'water extinction coefficient','WAT', &
00243                  YEXTCOEF_WATER,YEXTCOEF_WATERFILETYPE,XUNIF_EXTCOEF_WATER, &
00244                  XEXTCOEF_WATER(:))  
00245 !
00246 !-------------------------------------------------------------------------------
00247 !
00248 !*   10.     Prints of flake parameters in a tex file
00249 !            ----------------------------------------
00250 !
00251  CALL WRITE_COVER_TEX_WATER
00252 IF (LHOOK) CALL DR_HOOK('PGD_FLAKE',1,ZHOOK_HANDLE)
00253 !-------------------------------------------------------------------------------
00254 !
00255 END SUBROUTINE PGD_FLAKE