SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_PRECIP_n(HPROGRAM,HINIT) 00003 ! ######################################## 00004 ! 00005 !!**** *READ_PRECIP_n* - routine to read the restart file for 00006 !! precip field 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! The purpose of this routine is to initialise the 00011 !! precip field. Indeed, when ARPEGE/ALADIN is used, 00012 !! the precip field is not initialize at the begin of 00013 !! a run. 00014 !! 00015 !! 00016 !!** METHOD 00017 !! ------ 00018 !! The data are read in the initial surface file : 00019 !! - 2D data fields 00020 !! 00021 !! It does not read the grid definition. This should have been 00022 !! read already. 00023 !! 00024 !! EXTERNAL 00025 !! -------- 00026 !! 00027 !! 00028 !! 00029 !! IMPLICIT ARGUMENTS 00030 !! ------------------ 00031 !! 00032 !! REFERENCE 00033 !! --------- 00034 !! 00035 !! 00036 !! AUTHOR 00037 !! ------ 00038 !! B. Decharme *Meteo France* 00039 !! 00040 !! MODIFICATIONS 00041 !! ------------- 00042 !! Original 04/2009 00043 !------------------------------------------------------------------------------- 00044 ! 00045 !* 0. DECLARATIONS 00046 ! ------------ 00047 ! 00048 USE MODD_SURF_ATM_n , ONLY : NSIZE_FULL,LINIT_PRECIP 00049 ! 00050 USE MODD_SURF_ATM, ONLY : LRW_PRECIP,LSAVE_PRECIP 00051 USE MODD_DIAG_SURF_ATM_n, ONLY : XRW_RAIN, XRW_SNOW 00052 ! 00053 USE MODI_READ_SURF 00054 ! 00055 ! 00056 ! 00057 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00058 USE PARKIND1 ,ONLY : JPRB 00059 ! 00060 IMPLICIT NONE 00061 ! 00062 !* 0.1 Declarations of arguments 00063 ! ------------------------- 00064 ! 00065 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program 00066 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00067 ! 00068 !* 0.2 Declarations of local variables 00069 ! ------------------------------- 00070 ! 00071 00072 ! 00073 INTEGER :: IRESP ! Error code after redding 00074 ! 00075 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00076 ! 00077 INTEGER :: IVERSION ! surface version 00078 INTEGER :: IBUGFIX ! surface bugfix 00079 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00080 ! 00081 !------------------------------------------------------------------------------- 00082 ! 00083 IF (LHOOK) CALL DR_HOOK('READ_PRECIP_N',0,ZHOOK_HANDLE) 00084 SELECT CASE (HINIT) 00085 ! 00086 CASE ('PGD') 00087 ! 00088 ALLOCATE(XRW_RAIN(0)) 00089 ALLOCATE(XRW_SNOW(0)) 00090 LRW_PRECIP =.FALSE. 00091 LINIT_PRECIP =.FALSE. 00092 LSAVE_PRECIP =.FALSE. 00093 ! 00094 CASE ('PRE') 00095 ! 00096 IF(LRW_PRECIP)THEN 00097 LINIT_PRECIP =.TRUE. 00098 LSAVE_PRECIP =.TRUE. 00099 ALLOCATE(XRW_RAIN(NSIZE_FULL)) 00100 ALLOCATE(XRW_SNOW(NSIZE_FULL)) 00101 XRW_RAIN(:)=0.0 00102 XRW_SNOW(:)=0.0 00103 ELSE 00104 LINIT_PRECIP =.FALSE. 00105 LSAVE_PRECIP =.FALSE. 00106 ALLOCATE(XRW_RAIN(0)) 00107 ALLOCATE(XRW_SNOW(0)) 00108 ENDIF 00109 ! 00110 CASE DEFAULT 00111 ! 00112 YRECFM='VERSION' 00113 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP) 00114 IF (IVERSION<6) THEN 00115 LRW_PRECIP =.FALSE. 00116 ELSE 00117 YRECFM='RW_PRECIP' 00118 CALL READ_SURF(HPROGRAM,YRECFM,LRW_PRECIP,IRESP) 00119 ENDIF 00120 ! 00121 IF(LRW_PRECIP)THEN 00122 LINIT_PRECIP =.TRUE. 00123 LSAVE_PRECIP =.TRUE. 00124 ALLOCATE(XRW_RAIN(NSIZE_FULL)) 00125 ALLOCATE(XRW_SNOW(NSIZE_FULL)) 00126 YRECFM='RW_RAIN' 00127 CALL READ_SURF(HPROGRAM,YRECFM,XRW_RAIN(:),IRESP) 00128 YRECFM='RW_SNOW' 00129 CALL READ_SURF(HPROGRAM,YRECFM,XRW_SNOW(:),IRESP) 00130 ELSE 00131 LINIT_PRECIP =.FALSE. 00132 LSAVE_PRECIP =.FALSE. 00133 ALLOCATE(XRW_RAIN(0)) 00134 ALLOCATE(XRW_SNOW(0)) 00135 ENDIF 00136 ! 00137 END SELECT 00138 IF (LHOOK) CALL DR_HOOK('READ_PRECIP_N',1,ZHOOK_HANDLE) 00139 ! 00140 !------------------------------------------------------------------------------- 00141 ! 00142 END SUBROUTINE READ_PRECIP_n