SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/coupling_surf

Go to the documentation of this file.
00001 !######
00002 SUBROUTINE COUPLING_SURF_TRIP_n (HPROGRAM,KI,KSW,ORESTART,KYEAR,KMONTH,KTRIP, &
00003                                    PTIME,PDURATION,PZENITH,PSW_BANDS,PEMIS,     &
00004                                    PTSRAD,PDIR_ALB,PSCA_ALB                     )  
00005 !###################################################################
00006 !
00007 !!****  *COUPLING_SURF_TRIP_n*  
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!   
00012 !!    Driver for the coupling between SURFEX and TRIP
00013 !!      
00014 !!    REFERENCE
00015 !!    ---------
00016 !!      
00017 !!    AUTHOR
00018 !!    ------
00019 !!      B. Decharme     
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!      Original    01/02/05 
00024 !!      Modif.      28/05/08 
00025 !-------------------------------------------------------------------------------
00026 !
00027 !*       0.     DECLARATIONS
00028 !               ------------
00029 !
00030 USE MODD_TRIP_GRID_n, ONLY : GMASK
00031 USE MODE_COUPLING_VAR_SFX_TRIP
00032 !
00033 USE MODI_GET_LUOUT
00034 USE MODI_GET_CONF_ISBA_n
00035 USE MODI_GET_CONF_TRIP_n
00036 !
00037 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00038 USE PARKIND1  ,ONLY : JPRB
00039 !
00040 USE MODI_TRIP_INTERFACE
00041 USE MODI_UPDATE_ESM_SURF_ATM_n
00042 !
00043 USE MODI_ABOR1_SFX
00044 USE MODI_GET_TRIP_SIZE_n
00045 IMPLICIT NONE
00046 !
00047 !*      0.1    declarations of arguments
00048 !
00049  CHARACTER(LEN=6), INTENT(IN)         :: HPROGRAM ! program calling surf. schemes
00050 INTEGER,          INTENT(IN)         :: KI       ! Surfex grid dimension
00051 INTEGER,          INTENT(IN)         :: KSW      ! Number of spectral bands
00052 !
00053 LOGICAL, INTENT(IN)                  :: ORESTART ! write restart file
00054 !
00055 INTEGER, INTENT(IN)                  :: KYEAR    ! current year (UTC)
00056 INTEGER, INTENT(IN)                  :: KMONTH   ! current month (UTC)
00057 INTEGER, INTENT(INOUT)               :: KTRIP    ! number of Trip timestep counter
00058 !
00059 REAL,    INTENT(IN)                  :: PTIME    ! current time since start of the run (s)
00060 REAL,    INTENT(IN)                  :: PDURATION! duration of run                     (s)
00061 !
00062 REAL,             DIMENSION(KI),  INTENT(IN)  :: PZENITH   ! solar zenithal angle
00063 REAL,             DIMENSION(KSW), INTENT(IN)  :: PSW_BANDS ! middle wavelength of each band
00064 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each band
00065 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each band
00066 REAL,             DIMENSION(KI),  INTENT(OUT) :: PEMIS     ! emissivity
00067 REAL,             DIMENSION(KI),  INTENT(OUT) :: PTSRAD    ! radiative temperature
00068 !
00069 !*      0.2    declarations of local variables
00070 !
00071 LOGICAL :: LTRIP
00072 LOGICAL :: LFLOOD
00073 !
00074 REAL    :: ZTSTEP_COUPLING
00075 !
00076 INTEGER :: ILON  !TRIP lon dimension
00077 INTEGER :: ILAT  !TRIP lat dimension
00078 INTEGER :: INI   !TRIP total dimension
00079 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00080 INTEGER :: ILUOUT
00081 !
00082 !-------------------------------------------------------------------------------
00083 !-------------------------------------------------------------------------------
00084 !
00085 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N',0,ZHOOK_HANDLE)
00086  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00087 !
00088 ! * 1. Get ISBA and TRIP  configuration
00089 !      
00090  CALL GET_CONF_ISBA_n(LTRIP,LFLOOD)
00091 !
00092 IF (.NOT.LTRIP .AND. LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N',1,ZHOOK_HANDLE)
00093 IF (.NOT.LTRIP) RETURN
00094 !
00095  CALL GET_CONF_TRIP_n(PTSTEP_COUPLING=ZTSTEP_COUPLING)
00096 !
00097 !-------------------------------------------------------------------------------
00098 !-------------------------------------------------------------------------------
00099 !
00100 IF(LTRIP.AND.MOD(PTIME,ZTSTEP_COUPLING) == 0)THEN
00101 !
00102 !-------------------------------------------------------------------------------
00103 !-------------------------------------------------------------------------------
00104 !
00105   KTRIP = KTRIP + 1
00106 !
00107   CALL GET_TRIP_SIZE_n(ILON,ILAT)
00108 !
00109   INI = ILON*ILAT
00110 !
00111   CALL COUPLING_SURF_TRIP_DIM(ILON,ILAT)
00112 !
00113 !-------------------------------------------------------------------------------
00114 !
00115 ! * 2. Put TRIP variables into SURFEX if flooding scheme
00116 !
00117   IF(LFLOOD) CALL COUPLING_SURF_TRIP_FLOOD(INI)
00118 !
00119 !-------------------------------------------------------------------------------
00120 !-------------------------------------------------------------------------------
00121 !
00122 ENDIF
00123 !
00124 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N',1,ZHOOK_HANDLE)
00125 !
00126 !-------------------------------------------------------------------------------
00127 CONTAINS
00128 !
00129 SUBROUTINE COUPLING_SURF_TRIP_DIM(KLON,KLAT)
00130 !
00131 INTEGER, INTENT(IN) :: KLON
00132 INTEGER, INTENT(IN) :: KLAT
00133 !
00134 ! 2D LAT/LON Dimension
00135 !
00136 REAL, DIMENSION(KLON,KLAT)    :: Z2D_DRAIN       ! Drainage for TRIP (kg/m2)      
00137 REAL, DIMENSION(KLON,KLAT)    :: Z2D_RUNOFF      ! Runoff for TRIP (kg/m2)   
00138 REAL, DIMENSION(KLON,KLAT)    :: Z2D_SRC_FLOOD   ! Flood source budget for TRIP (kg/m2)
00139 !
00140 ! 1D TRIP Dimension
00141 !
00142 REAL, DIMENSION(KLON*KLAT)    :: ZTRIP_DRAIN     ! Cumulative drainage for TRIP (kg)
00143 REAL, DIMENSION(KLON*KLAT)    :: ZTRIP_RUNOFF    ! Cumulative Runoff for TRIP (kg)
00144 REAL, DIMENSION(KLON*KLAT)    :: ZTRIP_SRC_FLOOD ! Cumulative flood budget for TRIP (kg)
00145 !
00146 ! 1D SFX Dimension
00147 !
00148 REAL, DIMENSION(KI)    :: ZSFX_DRAIN     ! Cumulative drainage from ISBA (kg)
00149 REAL, DIMENSION(KI)    :: ZSFX_RUNOFF    ! Cumulative Runoff from ISBA (kg)
00150 REAL, DIMENSION(KI)    :: ZSFX_SRC_FLOOD ! Cumulative flood budget from ISBA (kg)
00151 !
00152 INTEGER :: I,J,ICOUNT
00153 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00154 !
00155 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N:COUPLING_SURF_TRIP_DIM',0,ZHOOK_HANDLE)
00156 !
00157 !-------------------------------------------------------------------------------  
00158 !
00159 ! * 1. Initialyse local variables
00160 !
00161 ! 2D LAT/LON Dimension
00162 !
00163 Z2D_DRAIN    (:,:) = 0.0
00164 Z2D_RUNOFF   (:,:) = 0.0
00165 Z2D_SRC_FLOOD(:,:) = 0.0
00166 !
00167 ! 1D TRIP Dimension
00168 ! 
00169 ZTRIP_DRAIN    (:) = 0.0
00170 ZTRIP_RUNOFF   (:) = 0.0
00171 ZTRIP_SRC_FLOOD(:) = 0.0
00172 ! 
00173 ZSFX_DRAIN    (:) = 0.0
00174 ZSFX_RUNOFF   (:) = 0.0
00175 ZSFX_SRC_FLOOD(:) = 0.0
00176 !
00177 !-------------------------------------------------------------------------------
00178 !
00179 ! * 2. Get SURFEX variables for TRIP in kg
00180 !
00181  CALL GET_COUPLING_VAR_SFX_n(LFLOOD,ZSFX_DRAIN(:),ZSFX_RUNOFF(:),ZSFX_SRC_FLOOD(:))
00182 !
00183 !-------------------------------------------------------------------------------
00184 !
00185 ! * 3. Interpolation from SFX grid to TRIP grid (kg)
00186 !
00187 IF(KI==INI)THEN
00188   ZTRIP_RUNOFF   (:)=ZSFX_RUNOFF   (:)
00189   ZTRIP_DRAIN    (:)=ZSFX_DRAIN    (:)
00190   IF(LFLOOD)THEN
00191     ZTRIP_SRC_FLOOD(:)=ZSFX_SRC_FLOOD(:)   
00192   ENDIF
00193 ELSE
00194   CALL ABOR1_SFX('COUPLING_SURF_TRIPN: TRIP and SFX are not on the same grid')
00195 ENDIF
00196 !
00197 ! 2d lat/lon TRIP grid array
00198 !
00199 ICOUNT=0
00200 DO J=1,KLAT
00201   DO I=1,KLON
00202     ICOUNT=ICOUNT+1
00203       IF(.NOT.GMASK(I,J))CYCLE
00204       Z2D_RUNOFF   (I,J)= ZTRIP_RUNOFF   (ICOUNT)
00205       Z2D_DRAIN    (I,J)= ZTRIP_DRAIN    (ICOUNT)
00206    ENDDO
00207 ENDDO
00208 !
00209 IF(LFLOOD)THEN
00210   ICOUNT=0
00211   DO J=1,KLAT
00212     DO I=1,KLON
00213       ICOUNT=ICOUNT+1
00214       IF(.NOT.GMASK(I,J))CYCLE
00215       Z2D_SRC_FLOOD(I,J)= ZTRIP_SRC_FLOOD(ICOUNT)
00216     ENDDO
00217   ENDDO
00218 ENDIF
00219 !
00220 ! Mass conservation
00221 !
00222 !
00223 !-------------------------------------------------------------------------------
00224 !
00225 ! * 5. Call Trip coupling
00226 !
00227  CALL TRIP_INTERFACE(ILUOUT,ILON,ILAT,ORESTART,KYEAR,KMONTH,KTRIP,PDURATION,&
00228                       Z2D_RUNOFF(:,:),Z2D_DRAIN(:,:),Z2D_SRC_FLOOD(:,:)      )
00229 !
00230 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N:COUPLING_SURF_TRIP_DIM',1,ZHOOK_HANDLE)
00231 !
00232 END SUBROUTINE COUPLING_SURF_TRIP_DIM
00233 !
00234 !
00235 SUBROUTINE COUPLING_SURF_TRIP_FLOOD(KNI)
00236 !
00237 INTEGER, INTENT(IN) :: KNI
00238 !
00239 REAL, DIMENSION(KNI) :: ZTRIP_FFLOOD       ! Flooded fraction from TRIP (-)
00240 REAL, DIMENSION(KNI) :: ZTRIP_PIFLOOD     ! Flood potential infiltration from TRIP (kg)
00241 !
00242 REAL, DIMENSION(KI)    :: ZSFX_FFLOOD    ! Flooded fraction for ISBA (-)
00243 REAL, DIMENSION(KI)    :: ZSFX_PIFLOOD   ! Flood potential infiltration for ISBA (kg)
00244 !    
00245 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00246 !
00247 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N:COUPLING_SURF_TRIP_FLOOD',0,ZHOOK_HANDLE)
00248 !
00249 ZTRIP_PIFLOOD      (:) = 0.0
00250 ZTRIP_FFLOOD       (:) = 0.0
00251 !
00252 ZSFX_FFLOOD   (:) = 0.0
00253 ZSFX_PIFLOOD  (:) = 0.0
00254 !   
00255 !   TRIP dimension INI in kg
00256  CALL GET_COUPLING_VAR_TRIP_n(ZTRIP_FFLOOD(:),ZTRIP_PIFLOOD(:))
00257 !
00258 !   Interpolation from TRIP grid to SFX grid in kg
00259 IF(KI==KNI)THEN
00260   ZSFX_FFLOOD (:) = ZTRIP_FFLOOD (:)
00261   ZSFX_PIFLOOD(:) = ZTRIP_PIFLOOD(:)
00262 ELSE
00263   CALL ABOR1_SFX('COUPLING_SURF_TRIPN: TRIP and SFX are not on the same grid')
00264 ENDIF
00265 !
00266 !   Mass conservation
00267 !   
00268 !
00269 !   Put into SFX
00270 !
00271 WHERE(ZSFX_FFLOOD (:)<0.01)
00272   ZSFX_FFLOOD (:)=0.0
00273   ZSFX_PIFLOOD(:)=0.0
00274 ENDWHERE
00275 !
00276  CALL PUT_COUPLING_VAR_SFX_n(ZSFX_FFLOOD,ZSFX_PIFLOOD)
00277 !
00278 !-------------------------------------------------------------------------------
00279 !
00280 ! * 8. Update radiative properties with flooding
00281 !
00282  CALL UPDATE_ESM_SURF_ATM_n(HPROGRAM, KI, KSW, PZENITH, PSW_BANDS,   &
00283                            PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS        )
00284 !
00285 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_TRIP_N:COUPLING_SURF_TRIP_FLOOD',1,ZHOOK_HANDLE)
00286 !
00287 END SUBROUTINE COUPLING_SURF_TRIP_FLOOD
00288 !
00289 !-------------------------------------------------------------------------------
00290 END SUBROUTINE COUPLING_SURF_TRIP_n