sucape.F90

Go to the documentation of this file.

SUBROUTINE sucape(KULOUT)

!**** *SUCAPE  * - ROUTINE TO INITIALIZE THE VARIABLES FOR CAPE 
!                  AND CIN COMPUTATION

!     PURPOSE.
!     --------
!        SET DEFAULT VALUES, THEN READS NAMELIST NAMCAPE

!**   INTERFACE.
!     ----------
!        *CALL* *SUCAPE(KULOUT)*

!         EXPLICIT ARGUMENTS :  KULOUT
!         --------------------

!         IMPLICIT ARGUMENTS :
!         --------------------
!            COMMON  YOMCAPE
!            COMMON  YOMPHY
!            COMMON  YOMLUN

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!     AUTHOR.
!     -------
!        N.Pristov 03/2001

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 03/2001
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE yomcape  , ONLY :  ncapeiter   ,netapes  ,gcaperet   ,gcapepsd
USE yomphy   , ONLY :  nbiter 
! Ce qui concerne NULNAM commente par MPL le 15.04.09
!USE YOMLUN   , ONLY :  NULNAM

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "posnam.intfb.h"

#include "namcape.h"

!      ----------------------------------------------------------------
!*       1.    SET DEFAULT VALUES.
!              -------------------
IF (lhook) CALL dr_hook('SUCAPE',0,zhook_handle)
ncapeiter=nbiter
netapes=2
gcaperet=0._jprb
gcapepsd=30000._jprb

!      ----------------------------------------------------------------
!*       2.    MODIFIES DEFAULT VALUES. READ NAMELIST.
!              ------------------------

! Ce qui concerne NAMCAPE commente par MPL le 15.04.09
!CALL POSNAM(NULNAM,'NAMCAPE')
!READ(NULNAM,NAMCAPE)

IF (ncapeiter <= 0 ) CALL abor1('SUCAPE:  INVALID VALUE FOR NCAPEITER')
IF (netapes <= 0 ) CALL abor1('SUCAPE:  INVALID VALUE FOR NETAPES')
IF ((gcaperet < 0.0_jprb ) .OR. (gcaperet > 1.0_jprb ))  &
 & CALL abor1('SUCAPE:  INVALID VALUE FOR GCAPERET')  
IF (gcapepsd <= 0.0_jprb ) CALL abor1('SUCAPE:  INVALID VALUE FOR GCAPEPSD')

!      -----------------------------------------------------------
!*       3.    PRINT FINAL VALUES.
!              -------------------

WRITE(kulout,'('' NCAPEITER = '',I2,'' NETAPES = '',I2,'' GCAPERET = '',&
 & E13.6,'' GCAPEPSD = '',E13.6)') ncapeiter, netapes, gcaperet, gcapepsd  
 
IF (lhook) CALL dr_hook('SUCAPE',1,zhook_handle)
END SUBROUTINE sucape