|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_ISBA_CANOPY_n(HPROGRAM) 00003 ! ######################################### 00004 ! 00005 !!**** *READ_ISBA_CANOPY_n* - reads ISBA fields 00006 !! 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! REFERENCE 00022 !! --------- 00023 !! 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! V. Masson *Meteo France* 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! Original 01/2003 00032 !! E. Martin 01/2012 Add LSBL_COLD_START 00033 !------------------------------------------------------------------------------- 00034 ! 00035 !* 0. DECLARATIONS 00036 ! ------------ 00037 ! 00038 USE MODD_SURF_PAR, ONLY : XUNDEF 00039 ! 00040 USE MODD_ISBA_n, ONLY : LCANOPY 00041 USE MODD_ISBA_CANOPY_n, ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XDZ, XZF, XDZF, XP 00042 ! 00043 USE MODI_READ_SURF 00044 USE MODI_CANOPY_GRID 00045 USE MODI_GET_TYPE_DIM_n 00046 ! 00047 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00048 USE PARKIND1 ,ONLY : JPRB 00049 ! 00050 IMPLICIT NONE 00051 ! 00052 !* 0.1 Declarations of arguments 00053 ! ------------------------- 00054 ! 00055 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program 00056 ! 00057 ! 00058 !* 0.2 Declarations of local variables 00059 ! ------------------------------- 00060 ! 00061 ! 00062 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00063 CHARACTER(LEN=3) :: YREAD 00064 INTEGER :: JLAYER ! loop counter on layers 00065 INTEGER :: ILU ! 1D physical dimension 00066 INTEGER :: IRESP ! Error code after redding 00067 INTEGER :: IVERSION, IBUGFIX ! surface version 00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00069 !------------------------------------------------------------------------------- 00070 ! 00071 !* 1D physical dimension 00072 ! 00073 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',0,ZHOOK_HANDLE) 00074 YRECFM='SIZE_NATURE' 00075 CALL GET_TYPE_DIM_n('NATURE',ILU) 00076 ! 00077 ! 00078 !* flag to use or not canopy levels 00079 ! 00080 YRECFM='VERSION' 00081 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP) 00082 ! 00083 YRECFM='BUG' 00084 CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP) 00085 ! 00086 IF (IVERSION<3) THEN 00087 LCANOPY = .FALSE. 00088 ELSE 00089 YRECFM='ISBA_CANOPY' 00090 CALL READ_SURF(HPROGRAM,YRECFM,LCANOPY,IRESP) 00091 END IF 00092 ! 00093 IF (.NOT.LCANOPY) THEN 00094 ALLOCATE(XZ (0,0)) 00095 ALLOCATE(XU (0,0)) 00096 ALLOCATE(XT (0,0)) 00097 ALLOCATE(XQ (0,0)) 00098 ALLOCATE(XTKE(0,0)) 00099 ALLOCATE(XLMO(0) ) 00100 ALLOCATE(XP (0,0)) 00101 ALLOCATE(XDZ (0,0)) 00102 ALLOCATE(XZF (0,0)) 00103 ALLOCATE(XDZF(0,0)) 00104 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE) 00105 RETURN 00106 ENDIF 00107 ! 00108 !* number of vertical levels 00109 ! 00110 YRECFM='ISBA_CAN_LVL' 00111 CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP) 00112 ! 00113 !* 2. Prognostic fields: 00114 ! ----------------- 00115 ! 00116 !* altitudes 00117 ! 00118 ALLOCATE(XZ(ILU,NLVL)) 00119 ! 00120 DO JLAYER=1,NLVL 00121 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Z',JLAYER 00122 CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP) 00123 END DO 00124 ! 00125 ALLOCATE(XU (ILU,NLVL)) 00126 ALLOCATE(XT (ILU,NLVL)) 00127 ALLOCATE(XQ (ILU,NLVL)) 00128 ALLOCATE(XTKE(ILU,NLVL)) 00129 ALLOCATE(XLMO(ILU) ) 00130 ALLOCATE(XP (ILU,NLVL)) 00131 ! 00132 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN 00133 YRECFM='STORAGETYPE' 00134 CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP) 00135 ELSE 00136 YREAD = 'ALL' 00137 ENDIF 00138 ! 00139 IF(YREAD=='ALL') THEN 00140 ! 00141 !* wind in SBL 00142 DO JLAYER=1,NLVL 00143 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_U',JLAYER 00144 CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP) 00145 END DO 00146 ! 00147 !* theta in SBL 00148 DO JLAYER=1,NLVL 00149 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_T',JLAYER 00150 CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP) 00151 END DO 00152 ! 00153 !* humidity in SBL 00154 DO JLAYER=1,NLVL 00155 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Q',JLAYER 00156 CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP) 00157 END DO 00158 ! 00159 !* Tke in SBL 00160 DO JLAYER=1,NLVL 00161 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_E',JLAYER 00162 CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP) 00163 END DO 00164 ! 00165 !* Monin-Obhukov length 00166 YRECFM='ISBA_CAN_LMO ' 00167 CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP) 00168 ! 00169 !* Pressure 00170 DO JLAYER=1,NLVL 00171 WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_P',JLAYER 00172 CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP) 00173 END DO 00174 ! 00175 ELSE 00176 XU (:,:) = XUNDEF 00177 XT (:,:) = XUNDEF 00178 XQ (:,:) = XUNDEF 00179 XTKE(:,:) = XUNDEF 00180 XLMO(:) = XUNDEF 00181 XP (:,:) = XUNDEF 00182 ENDIF 00183 ! 00184 ! 00185 !* Grid characteristics 00186 ! 00187 ! 00188 ! --------------------------------- XZ(k+1) XDZ(k+1) 00189 ! ^ 00190 ! | 00191 ! | 00192 ! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1) 00193 ! ^ | 00194 ! | | 00195 ! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V 00196 ! | ^ 00197 ! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k) 00198 ! --------------------------------- XZ(k-1) XDZ(k-1) V 00199 ! - - - - - - - - - - - - - - - - - XZf(k-1) 00200 ! 00201 ALLOCATE(XDZ (ILU,NLVL)) 00202 ALLOCATE(XZF (ILU,NLVL)) 00203 ALLOCATE(XDZF(ILU,NLVL)) 00204 CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF) 00205 ! 00206 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE) 00207 ! 00208 !------------------------------------------------------------------------------- 00209 ! 00210 END SUBROUTINE READ_ISBA_CANOPY_n
1.8.0
