SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/pgd_tsz0

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PGD_TSZ0_PAR(HPROGRAM)
00003 !     ##############################################################
00004 !
00005 !!**** *PGD_TSZ0_PAR* monitor for averaging and interpolations of sst
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!
00026 !!    P. Le Moigne        Meteo-France
00027 !!
00028 !!    MODIFICATION
00029 !!    ------------
00030 !!
00031 !!    Original    09/2007
00032 !!
00033 !!
00034 !----------------------------------------------------------------------------
00035 !
00036 !*    0.     DECLARATION
00037 !            -----------
00038 !
00039 USE MODD_DATA_TSZ0_n, ONLY : XDATA_DTS, XDATA_DHUGRD
00040 !
00041 USE MODI_GET_LUOUT
00042 USE MODI_OPEN_NAMELIST
00043 USE MODI_CLOSE_NAMELIST
00044 !
00045 USE MODE_POS_SURF
00046 !
00047 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00048 USE PARKIND1  ,ONLY : JPRB
00049 !
00050 USE MODI_ABOR1_SFX
00051 !
00052 IMPLICIT NONE
00053 !
00054 !*    0.1    Declaration of arguments
00055 !            ------------------------
00056 !
00057  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00058 !
00059 !
00060 !*    0.2    Declaration of local variables
00061 !            ------------------------------
00062 !
00063 INTEGER               :: ILUOUT    ! output listing logical unit
00064 INTEGER               :: ILUNAM    ! namelist file  logical unit
00065 LOGICAL               :: GFOUND    ! true if namelist is found
00066 !
00067 INTEGER               :: JTIME     ! loop counter on time
00068 !
00069 !*    0.3    Declaration of namelists
00070 !            ------------------------
00071 !
00072 INTEGER            :: NTIME
00073 INTEGER, PARAMETER :: NTIME_MAX    = 25
00074 !
00075 REAL, DIMENSION(NTIME_MAX)     :: XUNIF_DTS
00076 REAL, DIMENSION(NTIME_MAX)     :: XUNIF_DHUGRD
00077  CHARACTER(LEN=28), DIMENSION(NTIME_MAX)  :: CFNAM_DTS
00078  CHARACTER(LEN=28), DIMENSION(NTIME_MAX)  :: CFNAM_DHUGRD
00079  CHARACTER(LEN=6), DIMENSION(NTIME_MAX)   :: CFTYP_DTS
00080  CHARACTER(LEN=6), DIMENSION(NTIME_MAX)   :: CFTYP_DHUGRD
00081 !
00082 ! name of files containing data
00083 !
00084 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00085 !
00086 NAMELIST/NAM_DATA_TSZ0/NTIME, XUNIF_DTS, XUNIF_DHUGRD  
00087 !-------------------------------------------------------------------------------
00088 !
00089 !*    1.      Initializations
00090 !             ---------------
00091 !
00092 IF (LHOOK) CALL DR_HOOK('PGD_TSZ0_PAR',0,ZHOOK_HANDLE)
00093 NTIME             = 25
00094 XUNIF_DTS (:)     = -0.250
00095 XUNIF_DHUGRD(:)   = 0.0
00096 CFNAM_DTS   (:) = '                            '
00097 CFNAM_DHUGRD(:) = '                            '
00098 CFTYP_DTS   (:) = '      '
00099 CFTYP_DHUGRD(:) = '      '
00100 !
00101 !-------------------------------------------------------------------------------
00102 !
00103 !*    2.      Input file for cover types
00104 !             --------------------------
00105 !
00106  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00107  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00108 !
00109  CALL POSNAM(ILUNAM,'NAM_DATA_TSZ0',GFOUND,ILUOUT)
00110 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_TSZ0)
00111 !
00112  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00113 !
00114 IF (NTIME > NTIME_MAX) THEN
00115    WRITE(ILUOUT,*)'NTIME SHOULD NOT EXCEED',NTIME_MAX
00116    CALL ABOR1_SFX('PGD_TSZ0_PAR: NTIME TOO BIG')
00117 ELSEIF (NTIME.NE.1 .AND. NTIME.NE.25) THEN
00118   CALL ABOR1_SFX('PGD_TSZ0_PAR: NTIME MUST BE 1 OR 25')
00119 ENDIF
00120 !
00121 ALLOCATE(XDATA_DTS    (NTIME))
00122 ALLOCATE(XDATA_DHUGRD (NTIME))
00123 !
00124 !-------------------------------------------------------------------------------
00125 !
00126 !*    3.      Uniform fields are prescribed
00127 !             -----------------------------
00128 !
00129 IF (NTIME==25) THEN
00130   DO JTIME=1,NTIME
00131     XDATA_DTS   (JTIME) = XUNIF_DTS   (JTIME)
00132     XDATA_DHUGRD(JTIME) = XUNIF_DHUGRD(JTIME)
00133   END DO
00134 ELSEIF (NTIME==1) THEN
00135   XDATA_DTS   (:) = XUNIF_DTS   (1)
00136   XDATA_DHUGRD(:) = XUNIF_DHUGRD(1)
00137 ENDIF
00138 IF (LHOOK) CALL DR_HOOK('PGD_TSZ0_PAR',1,ZHOOK_HANDLE)
00139 !
00140 !-------------------------------------------------------------------------------
00141 !
00142 END SUBROUTINE PGD_TSZ0_PAR