mode_trip_init.F90

Go to the documentation of this file.

!###################
MODULE mode_trip_init
!###################
!
!!****  *MODE_TRIP_INIT*
!!
!!    PURPOSE
!!    -------
!    
!      The purpose of this routine is to store here all routines 
!      used by INIT_TRIP.
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!       NONE          
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    15/04/08
!--------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_trip_function
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!-------------------------------------------------------------------------------
!
 CONTAINS
!-------------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE setnext(KLON,KLAT,KGRCN,KNEXTX,KNEXTY,GMLON,GMLAT)
!     #############################################################
!
!!    PURPOSE
!!    -------
!    
!     set the destination grid point
!
!     (i, j) ===>  (inextx(i,j), inexty(i,j))
!     at river mouth : pointing itself
!     at sea         : 0
!
IMPLICIT NONE
!
!*      declarations of arguments
!
INTEGER, INTENT(IN)                    :: KLON, KLAT
!
INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KGRCN
!
INTEGER, DIMENSION(:,:), INTENT(OUT)   :: KNEXTX, KNEXTY
!
LOGICAL, INTENT(IN), OPTIONAL          :: GMLON,GMLAT
!
!*      declarations of local variables
!
INTEGER :: JLON, JLAT, IDIR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETNEXT',0,zhook_handle)
!
IF(PRESENT(gmlon))THEN
  IF(gmlon)THEN
    DO jlat=1,klat
       IF(kgrcn(klon,jlat)==2..OR.kgrcn(klon,jlat)==3.OR.kgrcn(klon,jlat)==4.)kgrcn(klon,jlat)=15
       IF(kgrcn(   1,jlat)==6..OR.kgrcn(   1,jlat)==7.OR.kgrcn(   1,jlat)==8.)kgrcn(   1,jlat)=15
    ENDDO
  ENDIF
ENDIF
!
IF(PRESENT(gmlat))THEN
  IF(gmlat)THEN
    DO jlon=1,klon
       IF(kgrcn(jlon,   1)==4..OR.kgrcn(jlon,   1)==5.OR.kgrcn(jlon,   1)==6.)kgrcn(jlon,   1)=15
       IF(kgrcn(jlon,klat)==1..OR.kgrcn(jlon,klat)==2.OR.kgrcn(jlon,klat)==8.)kgrcn(jlon,klat)=15
    ENDDO
  ENDIF
ENDIF
!
DO jlat=1,klat
   DO jlon=1,klon
!
      idir=kgrcn(jlon,jlat)
!
      IF((idir>=1).AND.(idir<=8))THEN              
        knextx(jlon,jlat)=irnxtx(jlon,klon,idir)
        knexty(jlon,jlat)=irnxty(jlat,klat,idir)        
      ELSEIF(idir>=9)THEN     
        knextx(jlon,jlat)=jlon
        knexty(jlon,jlat)=jlat     
      ELSE             
        knextx(jlon,jlat)=0
        knexty(jlon,jlat)=0  
      ENDIF
!
      IF(idir>0)THEN
        IF (kgrcn(knextx(jlon,jlat),knexty(jlon,jlat))==0) kgrcn(jlon,jlat)=9
      ENDIF
!
   ENDDO
ENDDO
!
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETNEXT',1,zhook_handle)
!
END SUBROUTINE setnext
!
!-------------------------------------------------------------------------------
!
!     #################################################
      SUBROUTINE setarea(KLAT,PLATMIN,PRES,PAREA)
!     #################################################
!
!!    PURPOSE
!!    -------
!    
!     set area [m²] of each grid box
!
USE modd_trip_par, ONLY : xpi, xrad
!
IMPLICIT NONE
!
!*      declarations of arguments
!
INTEGER, INTENT(IN)                :: KLAT
REAL, INTENT(IN)                   :: PRES
REAL, INTENT(IN)                   :: PLATMIN
!
REAL, DIMENSION(:,:), INTENT(OUT)  :: PAREA
!
!*      declarations of local variables
!
REAL    :: ZDLAT, ZDLON, ZLAT
!
INTEGER :: JI, JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETAREA',0,zhook_handle)
zdlon=pres
zdlat=pres
!
zlat=platmin-(pres/2.)
!
DO ji=1,klat
   zlat=zlat+pres
   DO jj=1,SIZE(parea,1)
      parea(jj,ji) = xrad * xrad * xpi/180.*(zdlon)              &
          * (sin((zlat+zdlat/2.)*xpi/180.)-sin((zlat-zdlat/2.)*xpi/180.))  
   ENDDO
ENDDO
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETAREA',1,zhook_handle)
!
END SUBROUTINE setarea
!
!-------------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE setlen(KLON,KLAT,KGRCN,KNEXTX,KNEXTY,PRATMED,PLEN)
!     #############################################################
!
!!    PURPOSE
!!    -------
!    
!     length from (i, j) to the destination in [m]
!     river mouth : distance to 1 grid north
!     sea         : 0.0
!
IMPLICIT NONE
!
!*      declarations of arguments
!
INTEGER, INTENT(IN)                 :: KLON, KLAT
REAL, INTENT(IN)                    :: PRATMED
!
INTEGER, DIMENSION(:,:), INTENT(IN) :: KGRCN
!
INTEGER, DIMENSION(:,:), INTENT(IN) :: KNEXTX, KNEXTY
!
REAL, DIMENSION(:,:), INTENT(OUT)   :: PLEN
!
!*      declarations of local variables
!
REAL    :: ZLON, ZLAT, ZLON_N, ZLAT_N
!
INTEGER :: JLON, JLAT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETLEN',0,zhook_handle)
!
zlon=0.0
zlat=0.0
!
DO jlat=1,klat
!
   zlat=getlat(klat-jlat+1,klat)
!
   DO jlon=1,klon
!
      zlon=getlon(jlon,klon)
!
      IF(kgrcn(jlon,jlat)>=1.AND.kgrcn(jlon,jlat)<=8)THEN
        zlon_n = getlon(knextx(jlon,jlat),klon)
        zlat_n = getlat(klat-knexty(jlon,jlat)+1,klat)
        plen(jlon,jlat) = givelen(zlon,zlat,zlon_n,zlat_n) * 1000.0
      ELSEIF(kgrcn(jlon,jlat)>=9)THEN
        zlat_n = getlat(klat-(jlat-1)+1,klat)
        plen(jlon,jlat) = givelen(zlon,zlat,zlon,zlat_n) * 1000.0
      ELSE
        plen(jlon,jlat) = 0.0
      ENDIF
!
   ENDDO
!   
ENDDO
!
plen=plen*pratmed
!
IF (lhook) CALL dr_hook('MODE_TRIP_INIT:SETLEN',1,zhook_handle)
!
END SUBROUTINE setlen
!
!-------------------------------------------------------------------------------
!
END MODULE mode_trip_init