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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE SOILTEMP_ARP_PAR(HPROGRAM,OTEMP_ARP,KTEMPLAYER_ARP)
00003 !     ##############################################################
00004 !
00005 !!**** *SOILTEMP_ARP_PAR* Impose special pseudo depth for "force-restore"
00006 !!                        multilayer deep temperature
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!    METHOD
00012 !!    ------
00013 !!   
00014 !
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!
00027 !!    B. Decharme        Meteo-France
00028 !!
00029 !!    MODIFICATION
00030 !!    ------------
00031 !!
00032 !!    Original    03/2009
00033 !!
00034 !!
00035 !----------------------------------------------------------------------------
00036 !
00037 !*    0.     DECLARATION
00038 !            -----------
00039 !
00040 USE MODD_SURF_PAR, ONLY : XUNDEF
00041 USE MODD_READ_NAMELIST, ONLY : LNAM_READ
00042 !
00043 USE MODD_ISBA_n,   ONLY : CISBA, XSODELX
00044 !
00045 USE MODN_SOILTEMP_ARP
00046 !
00047 USE MODI_GET_LUOUT
00048 USE MODI_OPEN_NAMELIST
00049 USE MODI_CLOSE_NAMELIST
00050 !
00051 USE MODE_POS_SURF
00052 !
00053 !
00054 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00055 USE PARKIND1  ,ONLY : JPRB
00056 !
00057 USE MODI_ABOR1_SFX
00058 !
00059 IMPLICIT NONE
00060 !
00061 !*    0.1    Declaration of arguments
00062 !            ------------------------
00063 !
00064  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00065 LOGICAL,             INTENT(OUT)   :: OTEMP_ARP
00066 INTEGER,             INTENT(OUT)   :: KTEMPLAYER_ARP
00067 !
00068 !*    0.2    Declaration of local variables
00069 !            ------------------------------
00070 !
00071 INTEGER               :: ILUOUT    ! output listing logical unit
00072 INTEGER               :: ILUNAM    ! namelist file  logical unit
00073 LOGICAL               :: GFOUND    ! true if namelist is found
00074 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00075 !
00076 !*    0.3    Declaration of namelists
00077 !            ------------------------
00078 !
00079 !
00080 !-------------------------------------------------------------------------------
00081 !
00082 !*    1.      Initializations
00083 !             ---------------
00084 !
00085 
00086 IF (LHOOK) CALL DR_HOOK('SOILTEMP_ARP_PAR',0,ZHOOK_HANDLE)
00087 !
00088  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00089 !
00090 IF (LNAM_READ) THEN
00091 
00092  SODELX(:)      = XUNDEF
00093  LTEMP_ARP      = .FALSE.
00094  NTEMPLAYER_ARP = 4
00095  !
00096  !-------------------------------------------------------------------------------
00097  !
00098  !*    2.      Input value for SODELX variable
00099  !             -------------------------------
00100  !
00101  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00102  !
00103  CALL POSNAM(ILUNAM,'NAM_SOILTEMP_ARP',GFOUND,ILUOUT)
00104  IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SOILTEMP_ARP)
00105  !
00106  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00107 !
00108 ENDIF
00109 !
00110 !-------------------------------------------------------------------------------
00111 !
00112 !*    3.      Consistency
00113 !             -----------
00114 !
00115 IF(LTEMP_ARP.AND.CISBA=='DIF')THEN
00116    LTEMP_ARP=.FALSE.
00117    WRITE(ILUOUT,*)'LTEMP_ARP put at False because you use the ISBA-DF scheme'
00118 ENDIF
00119 !
00120 IF(LTEMP_ARP)THEN
00121   IF(NTEMPLAYER_ARP>NMAX_LAYER)THEN     
00122     WRITE(ILUOUT,*)'NTEMPLAYER_ARP is too big (>10), NTEMPLAYER_ARP= ',NTEMPLAYER_ARP
00123     CALL ABOR1_SFX('NTEMPLAYER_ARP is too big (>10)')
00124   ELSEIF(NTEMPLAYER_ARP<4)THEN
00125     WRITE(ILUOUT,*)'NTEMPLAYER_ARP must be at least equal to 4, NTEMPLAYER_ARP= ',NTEMPLAYER_ARP
00126     CALL ABOR1_SFX('NTEMPLAYER_ARP must be at least equal to 4')
00127   ENDIF
00128   IF(COUNT(SODELX(1:NTEMPLAYER_ARP)/=XUNDEF)>0.AND. &
00129        COUNT(SODELX(1:NTEMPLAYER_ARP)/=XUNDEF)/=NTEMPLAYER_ARP)THEN  
00130     WRITE(ILUOUT,*)'Number of SODELX imposed values =',COUNT(SODELX(1:NTEMPLAYER_ARP)/=XUNDEF),&
00131                      ' /= NTEMPLAYER_ARP= ',NTEMPLAYER_ARP  
00132     CALL ABOR1_SFX('SODELX imposed values /= NTEMPLAYER_ARP')
00133   ENDIF          
00134 ENDIF
00135 !
00136 !-------------------------------------------------------------------------------
00137 !
00138 !*    4.      Initialization
00139 !             -------------------------------
00140 !
00141 IF(LTEMP_ARP)THEN
00142 !
00143   ALLOCATE(XSODELX(NTEMPLAYER_ARP))
00144 !
00145   IF(ALL(SODELX(:)==XUNDEF))THEN
00146 !          
00147     XSODELX(1)=0.5
00148     XSODELX(2)=1.5
00149     XSODELX(3)=4.5
00150     XSODELX(4)=13.5
00151     WRITE(ILUOUT,*)'SODELX default values : ',XSODELX(:)
00152 !    
00153   ELSE
00154 !          
00155     XSODELX(:)=SODELX(1:NTEMPLAYER_ARP)
00156     WRITE(ILUOUT,*)'SODELX imposed to : ',XSODELX(:)
00157 !    
00158   ENDIF
00159 !
00160 ELSE
00161 !
00162   ALLOCATE(XSODELX(0))
00163 !
00164 ENDIF
00165 !
00166 OTEMP_ARP     =LTEMP_ARP
00167 KTEMPLAYER_ARP=NTEMPLAYER_ARP
00168 IF (LHOOK) CALL DR_HOOK('SOILTEMP_ARP_PAR',1,ZHOOK_HANDLE)
00169 !
00170 !-------------------------------------------------------------------------------
00171 !
00172 END SUBROUTINE SOILTEMP_ARP_PAR