source: TOOLS/MOZAIC/src/MOZAIC/declare.f90 @ 3326

! -*- Mode: f90 -*-
MODULE declare
   !> All data types used in MOZAIC
   USE defprec
   USE data_types
   USE poly_types
   IMPLICIT NONE
   !
   SAVE
   !
   ! Useful variables for initialisation
   REAL (kind=rl) :: zero=0.0e0_rl !< Use this to initialize data
   REAL (kind=rl) :: zun=1.0e0_rl !< Use this to initialize data
   !
   REAL (kind=rl), PARAMETER, PUBLIC :: zeps   =EPSILON (1.0_rl) !< Default epsilon
   REAL (kind=rl), PARAMETER, PUBLIC :: zeps_r4=EPSILON (1.0_r_4) !< Simple precision epsilon
   ! 
   REAL (kind=rl), PARAMETER, PUBLIC :: rpi = 3.1415926536_rl     !< You should recognize this one ...
   REAL (kind=rl), PARAMETER, PUBLIC :: rad = 0.0174532925_rl     !< Conversion factor for degrees to radian
   REAL (kind=rl), PARAMETER, PUBLIC :: dar = 57.2957795130823_rl !< Conversion factor for radian to degrees
   !   REAL (kind=rl) :: dar = 180.0_rl / rpi
   REAL (kind=rl), PARAMETER, PUBLIC :: r_earth = 6371229.0_rl !< Earth radius
   !
   INTEGER (kind=il), PUBLIC :: nout = 6 !< File number for messages
   LOGICAL, PUBLIC :: l_d_alloc !< If TRUE, print message about array allocation
   !
   PUBLIC chk_allo
   !
CONTAINS
   SUBROUTINE chk_allo (kerr, cname, lreset, crout)
      !> Diagonose return code from allocate
      INTEGER (kind=il), INTENT (in) :: kerr !< Error code from ALLOCATE
      CHARACTER (len=*), INTENT (in) :: cname !< Brief description of the allocation
      LOGICAL, INTENT (in), OPTIONAL :: lreset !< If true, reset error counter
      CHARACTER (len=*), INTENT (in), OPTIONAL :: crout !< Calling routine name
      INTEGER, SAVE :: icount !< Error counter
      CHARACTER (len = 20), SAVE :: lcrout = 'unknown'
      !
      IF (PRESENT (lreset)) THEN
         icount = 0
      END IF
      !
      IF (PRESENT (crout)) THEN
         lcrout = TRIM (crout)
      ENDIF
      !
      icount = icount + 1
      !
      IF (kerr /= 0_il) THEN 
         WRITE (UNIT=nout, FMT=*) 'Erreur allocation memoire '
         WRITE (UNIT=nout, FMT=*) 'Numero d''erreur : ', kerr
         WRITE (UNIT=nout, FMT=*) 'Message : ', cname
         WRITE (UNIT=nout, FMT=*) 'Allocation number : ', icount
         WRITE (UNIT=nout, FMT=*) 'Routine : ', TRIM (lcrout)
         STOP
      ELSE
         IF (l_d_alloc) THEN 
            WRITE (UNIT=nout, FMT='("Memory Allocation ", 1I3, ", variable : ", A, ", in routine : ", A)') &
               & , icount, cname, TRIM (lcrout)
         END IF
      END IF
      !
   END SUBROUTINE chk_allo
END MODULE declare