SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TRIP/mode_trip

Go to the documentation of this file.
00001 !###################
00002 MODULE MODE_TRIP_INIT
00003 !###################
00004 !
00005 !!****  *MODE_TRIP_INIT*
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !    
00010 !      The purpose of this routine is to store here all routines 
00011 !      used by INIT_TRIP.
00012 !
00013 !!
00014 !!**  IMPLICIT ARGUMENTS
00015 !!    ------------------
00016 !!       NONE          
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!      B. Decharme       * Meteo France *
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    15/04/08
00029 !--------------------------------------------------------------------------------
00030 !
00031 !*       0.    DECLARATIONS
00032 !              ------------
00033 !
00034 !
00035 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00036 USE PARKIND1  ,ONLY : JPRB
00037 !
00038   INTERFACE SETNEXT
00039       MODULE PROCEDURE SETNEXT
00040   END INTERFACE
00041 !
00042   INTERFACE SETAREA
00043       MODULE PROCEDURE SETAREA
00044   END INTERFACE
00045 !  
00046   INTERFACE SETLEN
00047       MODULE PROCEDURE SETLEN
00048   END INTERFACE
00049 !  
00050   INTERFACE SET_SUBGRID_FLOOD
00051       MODULE PROCEDURE SET_SUBGRID_FLOOD
00052   END INTERFACE
00053 !
00054 !-------------------------------------------------------------------------------
00055 !
00056 CONTAINS
00057 !-------------------------------------------------------------------------------
00058 !
00059 !     #############################################################
00060       SUBROUTINE SETNEXT(KLON,KLAT,KGRCN,KNEXTX,KNEXTY,GMLON,GMLAT)
00061 !     #############################################################
00062 !
00063 !!    PURPOSE
00064 !!    -------
00065 !    
00066 !     set the destination grid point
00067 !
00068 !     (i, j) ===>  (inextx(i,j), inexty(i,j))
00069 !     at river mouth : pointing itself
00070 !     at sea         : 0
00071 !
00072 USE MODE_TRIP_FUNCTION
00073 !
00074 IMPLICIT NONE
00075 !
00076 !*      declarations of arguments
00077 !
00078 INTEGER, INTENT(IN)                    :: KLON, KLAT
00079 !
00080 INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KGRCN
00081 !
00082 INTEGER, DIMENSION(:,:), INTENT(OUT)   :: KNEXTX, KNEXTY
00083 !
00084 LOGICAL, INTENT(IN), OPTIONAL          :: GMLON,GMLAT
00085 !
00086 !*      declarations of local variables
00087 !
00088 INTEGER :: I, J, K
00089 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00090 !
00091 !*      procedure
00092 !
00093 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETNEXT',0,ZHOOK_HANDLE)
00094 IF(PRESENT(GMLON))THEN
00095 IF(GMLON)THEN
00096   DO J=1,KLAT
00097      IF(KGRCN(KLON,J)==2..OR.KGRCN(KLON,J)==3.OR.KGRCN(KLON,J)==4.)KGRCN(KLON,J)=9
00098      IF(KGRCN(   1,J)==6..OR.KGRCN(   1,J)==7.OR.KGRCN(   1,J)==8.)KGRCN(   1,J)=9     
00099   ENDDO
00100 ENDIF
00101 ENDIF
00102 !
00103 IF(PRESENT(GMLAT))THEN
00104 IF(GMLAT)THEN
00105   DO I=1,KLON
00106      IF(KGRCN(I,   1)==4..OR.KGRCN(I,   1)==5.OR.KGRCN(I,   1)==6.)KGRCN(I,   1)=9
00107      IF(KGRCN(I,KLAT)==1..OR.KGRCN(I,KLAT)==2.OR.KGRCN(I,KLAT)==8.)KGRCN(I,KLAT)=9     
00108   ENDDO
00109 ENDIF
00110 ENDIF
00111 !
00112 DO I=1,KLON
00113    DO J=1,KLAT
00114 !
00115       K=KGRCN(I,J)
00116 !
00117       IF((K>=1).AND.(K<=8))THEN              
00118         KNEXTX(I,J)=IRNXTX(I,KLON,K)
00119         KNEXTY(I,J)=IRNXTY(J,KLAT,K)        
00120       ELSEIF(K==9.OR.K==12)THEN     
00121         KNEXTX(I,J)=I
00122         KNEXTY(I,J)=J       
00123       ELSE             
00124         KNEXTX(I,J)=0
00125         KNEXTY(I,J)=0       
00126       ENDIF
00127 !
00128    ENDDO
00129 ENDDO
00130 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETNEXT',1,ZHOOK_HANDLE)
00131 !
00132 END SUBROUTINE SETNEXT
00133 !
00134 !-------------------------------------------------------------------------------
00135 !
00136 !     #################################################
00137       SUBROUTINE SETAREA(KLAT,PLATMIN,PRES,PAREA)
00138 !     #################################################
00139 !
00140 !!    PURPOSE
00141 !!    -------
00142 !    
00143 !     set area [m�] of each grid box
00144 !
00145 USE MODD_TRIP_PAR, ONLY : XPI_T, XRAD_T
00146 !
00147 IMPLICIT NONE
00148 !
00149 !*      declarations of arguments
00150 !
00151 INTEGER, INTENT(IN)                :: KLAT
00152 REAL, INTENT(IN)                   :: PRES
00153 REAL, INTENT(IN)                   :: PLATMIN
00154 !
00155 REAL, DIMENSION(:,:), INTENT(OUT)  :: PAREA
00156 !
00157 !*      declarations of local variables
00158 !
00159 REAL    :: ZDLAT, ZDLON, ZLAT
00160 !
00161 INTEGER :: I, J, K
00162 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00163 !
00164 !*      procedure
00165 !
00166 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETAREA',0,ZHOOK_HANDLE)
00167 ZDLON=PRES
00168 ZDLAT=PRES
00169 !
00170 ZLAT=PLATMIN-(PRES/2.)
00171 !
00172 DO J=1,KLAT
00173 !
00174    ZLAT=ZLAT+PRES
00175 !
00176    PAREA(:,J) = XRAD_T**2 * XPI_T/180.*(ZDLON)              &
00177        * (SIN((ZLAT+ZDLAT/2.)*XPI_T/180.)-SIN((ZLAT-ZDLAT/2.)*XPI_T/180.))  
00178 !
00179 ENDDO
00180 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETAREA',1,ZHOOK_HANDLE)
00181 !
00182 END SUBROUTINE SETAREA
00183 !
00184 !-------------------------------------------------------------------------------
00185 !
00186 !     #############################################################
00187       SUBROUTINE SETLEN(KLON,KLAT,KGRCN,KNEXTX,KNEXTY,PRATMED,PLEN)
00188 !     #############################################################
00189 !
00190 !!    PURPOSE
00191 !!    -------
00192 !    
00193 !     length from (i, j) to the destination in [m]
00194 !     river mouth : distance to 1 grid north
00195 !     sea         : 0.0
00196 !
00197 !
00198 USE MODE_TRIP_FUNCTION
00199 !
00200 IMPLICIT NONE
00201 !
00202 !*      declarations of arguments
00203 !
00204 INTEGER, INTENT(IN)                 :: KLON, KLAT
00205 REAL, INTENT(IN)                    :: PRATMED
00206 !
00207 INTEGER, DIMENSION(:,:), INTENT(IN) :: KGRCN
00208 !
00209 INTEGER, DIMENSION(:,:), INTENT(IN) :: KNEXTX, KNEXTY
00210 !
00211 REAL, DIMENSION(:,:), INTENT(OUT)   :: PLEN
00212 !
00213 !*      declarations of local variables
00214 !
00215 REAL    :: ZLON, ZLAT, ZLON_N, ZLAT_N
00216 !
00217 INTEGER :: I, J, K
00218 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00219 !
00220 !*      procedure
00221 !
00222 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETLEN',0,ZHOOK_HANDLE)
00223 ZLON=0.0
00224 ZLAT=0.0
00225 !
00226 DO J=1,KLAT
00227 !
00228    ZLAT=GETLAT(KLAT-J+1,KLAT)
00229 !
00230    DO I=1,KLON
00231 !
00232       ZLON=GETLON(I,KLON)
00233 !
00234       IF(KGRCN(I,J)>=1.AND.KGRCN(I,J)<=8)THEN
00235         ZLON_N = GETLON(KNEXTX(I,J),KLON)
00236         ZLAT_N = GETLAT(KLAT-KNEXTY(I,J)+1,KLAT)
00237         PLEN(I,J) = GIVELEN(ZLON,ZLAT,ZLON_N,ZLAT_N) * 1000.0
00238       ELSEIF(KGRCN(I,J)==9.OR.KGRCN(I,J)==12)THEN
00239         ZLAT_N = GETLAT(KLAT-(J-1)+1,KLAT)
00240         PLEN(I,J) = GIVELEN(ZLON,ZLAT,ZLON,ZLAT_N) * 1000.0
00241       ELSE
00242         PLEN(I,J) = 0.0
00243       ENDIF
00244 !
00245    ENDDO
00246 !   
00247 ENDDO
00248 !
00249 PLEN=PLEN*PRATMED
00250 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SETLEN',1,ZHOOK_HANDLE)
00251 !
00252 END SUBROUTINE SETLEN
00253 !
00254 !-------------------------------------------------------------------------------
00255 !
00256 !     ###################################################################
00257       SUBROUTINE SET_SUBGRID_FLOOD(KLON,KLAT,PAREA,PTAB_H,PTAB_F,PTAB_VF)
00258 !     ###################################################################
00259 !
00260 !!    PURPOSE
00261 !!    -------
00262 !    
00263 !     set area [m�] of each grid box
00264 !
00265 USE MODD_TRIP_PAR, ONLY : XTRIP_UNDEF, XRHOLW_T
00266 !
00267 IMPLICIT NONE
00268 !
00269 !*      declarations of arguments
00270 !
00271 INTEGER,                INTENT(IN)   :: KLON, KLAT
00272 REAL, DIMENSION(:,:  ), INTENT(IN)   :: PAREA
00273 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PTAB_H
00274 !
00275 REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTAB_F
00276 REAL, DIMENSION(:,:,:), INTENT(  OUT):: PTAB_VF
00277 !
00278 !*      declarations of local variables
00279 !
00280 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZF,ZV
00281 !
00282 INTEGER :: I, J, K, IZDIM
00283 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00284 !
00285 !*      procedure
00286 !
00287 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SET_SUBGRID_FLOOD',0,ZHOOK_HANDLE)
00288 IZDIM=SIZE(PTAB_H,3)
00289 !
00290 ALLOCATE(ZF(KLON,KLAT,IZDIM))
00291 ALLOCATE(ZV(KLON,KLAT,IZDIM))
00292 ZF = 0.0
00293 ZV = 0.0
00294 !
00295 DO J=1,KLAT
00296    DO I=1,KLON
00297 !   
00298       IF(ALL(PTAB_H(I,J,:)>XTRIP_UNDEF-10.0))THEN
00299          ZV(I,J,:)=XTRIP_UNDEF
00300          ZF(I,J,:)=XTRIP_UNDEF
00301          CYCLE
00302       ENDIF
00303 !      
00304       DO K=2,IZDIM
00305          IF(PTAB_H(I,J,K)<XTRIP_UNDEF-1.0)THEN
00306             ZV(I,J,K)=ZV(I,J,K-1)+0.5*PTAB_H(I,J,K)*PTAB_F(I,J,K)*PAREA(I,J)*XRHOLW_T
00307             ZF(I,J,K)=ZF(I,J,K-1)+PTAB_F(I,J,K)
00308          ELSE
00309             ZV(I,J,K:IZDIM)=XTRIP_UNDEF
00310             ZF(I,J,K:IZDIM)=XTRIP_UNDEF
00311             EXIT
00312          ENDIF
00313       ENDDO
00314 !
00315    ENDDO
00316 ENDDO
00317 !
00318 WHERE(PTAB_H(:,:,:)<XTRIP_UNDEF-1.0)
00319       PTAB_F (:,:,:)=ZF(:,:,:)
00320       PTAB_VF(:,:,:)=ZV(:,:,:)
00321 ENDWHERE
00322 !
00323 DEALLOCATE(ZF)
00324 DEALLOCATE(ZV)
00325 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_INIT:SET_SUBGRID_FLOOD',1,ZHOOK_HANDLE)
00326 !
00327 END SUBROUTINE SET_SUBGRID_FLOOD
00328 !
00329 !-------------------------------------------------------------------------------
00330 !
00331 END MODULE MODE_TRIP_INIT