|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 SUBROUTINE ASSIM_ISBA_UPDATE_SNOW(YPROGRAM, KI, PSWE, PSWE_ORIG, LINITSNOW, LINC, HTEST ) 00002 00003 ! ------------------------------------------------------------------------------------------ 00004 ! ***************************************************************************************** 00005 ! 00006 ! Routine to update snow field for ISBA 00007 ! 00008 ! 00009 ! ****************************************************************************************** 00010 ! ------------------------------------------------------------------------------------------ 00011 #ifdef LFI 00012 USE MODD_IO_SURF_LFI, ONLY : CFILEIN_LFI,CFILEOUT_LFI 00013 #endif 00014 USE MODN_IO_OFFLINE, ONLY : CPREPFILE 00015 USE YOMHOOK, ONLY : LHOOK,DR_HOOK 00016 USE PARKIND1, ONLY : JPRB 00017 USE MODD_CSTS, ONLY : XTT 00018 USE MODD_SURF_PAR, ONLY : XUNDEF 00019 USE MODD_SNOW_PAR, ONLY : XANSMIN, XANSMAX, XRHOSMIN, XRHOSMAX 00020 ! 00021 USE MODI_ABOR1_SFX 00022 USE MODI_INIT_IO_SURF_n 00023 USE MODI_READ_SURF 00024 USE MODI_END_IO_SURF_n 00025 USE MODI_IO_BUFF_CLEAN_n 00026 USE MODI_FLAG_UPDATE 00027 USE MODI_WRITE_SURF 00028 00029 ! 00030 IMPLICIT NONE 00031 ! 00032 CHARACTER(LEN=6), INTENT(IN) :: YPROGRAM ! program calling surf. schemes 00033 INTEGER, INTENT(IN) :: KI 00034 REAL, DIMENSION(KI), INTENT(IN) :: PSWE 00035 REAL, DIMENSION(KI), INTENT(INOUT) :: PSWE_ORIG 00036 LOGICAL, INTENT(IN) :: LINITSNOW 00037 LOGICAL, INTENT(IN) :: LINC 00038 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00039 ! 00040 ! Declarations of local variables 00041 ! 00042 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00043 CHARACTER(LEN=10) :: YVAR ! Name of the prognostic variable (in LFI file) 00044 CHARACTER(LEN=100) :: YPREFIX ! Prefix of the prognostic variable (in LFI file) 00045 INTEGER :: IRESP 00046 INTEGER :: IVERSION, IBUGFIX 00047 REAL, DIMENSION(KI) :: ZSWE ! Snow before update 00048 REAL, DIMENSION(KI) :: ZSWEINC 00049 REAL, DIMENSION(KI) :: PTS 00050 ! Addtional snow fields with D95 snow scheme 00051 REAL, DIMENSION(KI) :: ZSNR ! Snow density 00052 REAL, DIMENSION(KI) :: ZSNA ! Snow albedo 00053 ! 00054 ! 00055 ! ---------------------------------------------------------------------------------- 00056 ! 00057 IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_UPDATE_SNOW',0,ZHOOK_HANDLE) 00058 00059 IF (HTEST/='OK') THEN 00060 CALL ABOR1_SFX('ASSIM_ISBA_n: FATAL ERROR DURING ARGUMENT TRANSFER') 00061 END IF 00062 00063 ! If we only do second step, we must set working SWE as input SWE 00064 ZSWE=PSWE 00065 00066 IF ( LINITSNOW ) THEN 00067 ! read initial snow before update 00068 #ifdef LFI 00069 CFILEIN_LFI = CPREPFILE ! input PREP file (surface fields) 00070 #endif 00071 print*,CFILEIN_LFI 00072 CALL INIT_IO_SURF_n(YPROGRAM,'NATURE','SURF ','READ ') 00073 CALL READ_SURF(YPROGRAM,'VERSION',IVERSION,IRESP) 00074 CALL READ_SURF(YPROGRAM,'BUG',IBUGFIX,IRESP) 00075 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN 00076 CALL READ_SURF(YPROGRAM,'WSNOW_VEG1',ZSWE, IRESP) 00077 ELSE 00078 CALL READ_SURF(YPROGRAM,'WSN_VEG1',ZSWE, IRESP) 00079 ENDIF 00080 CALL READ_SURF(YPROGRAM,'TG1', PTS, IRESP) 00081 CALL END_IO_SURF_n(YPROGRAM) 00082 CALL IO_BUFF_CLEAN_n 00083 00084 ! Set snow=0 where 1. guess = 0 and Ts>0, to avoid that the snow analysis introduce snow where it is no snow. 00085 WHERE ( PSWE(:)/=XUNDEF .AND. PSWE(:)<1.0E-10 .AND. PTS(:)>XTT ) 00086 ZSWE(:) = 0.0 00087 END WHERE 00088 00089 ZSWE=PSWE 00090 ! Set snow=0 where 1. guess = 0 and Ts>0, to avoid that the snow analysis introduce snow where it is no snow. 00091 WHERE ( PSWE(:)/=XUNDEF .AND. PSWE(:)<1.0E-10 .AND. PTS(:)>XTT ) 00092 ZSWE(:) = 0.0 00093 END WHERE 00094 ENDIF 00095 00096 ! Update snow 00097 IF ( LINC ) THEN 00098 00099 ! Calculate increments 00100 ZSWEINC(:) = ZSWE(:) - PSWE_ORIG(:) 00101 WRITE(*,'(" SURFRESERV.NEIGE - min, mean, max: ",3E13.4)') MINVAL(ZSWE),MAXVAL(ZSWE),SUM(ZSWE)/KI 00102 WRITE(*,*) 'Mean SN increments over NATURE ',SUM(ZSWEINC)/KI 00103 00104 ! read additional snow fields 00105 #ifdef LFI 00106 CFILEIN_LFI = CPREPFILE ! input PREP file (surface fields) 00107 #endif 00108 print*,CFILEIN_LFI 00109 CALL INIT_IO_SURF_n(YPROGRAM,'NATURE','SURF ','READ ') 00110 CALL READ_SURF(YPROGRAM,'VERSION',IVERSION,IRESP) 00111 CALL READ_SURF(YPROGRAM,'BUG',IBUGFIX,IRESP) 00112 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN 00113 CALL READ_SURF(YPROGRAM,'RSNOW_VEG1',ZSNR, IRESP) 00114 CALL READ_SURF(YPROGRAM,'ASNOW_VEG',ZSNA, IRESP) 00115 ELSE 00116 CALL READ_SURF(YPROGRAM,'RSN_VEG1',ZSNR, IRESP) 00117 CALL READ_SURF(YPROGRAM,'ASN_VEG',ZSNA, IRESP) 00118 ENDIF 00119 CALL END_IO_SURF_n(YPROGRAM) 00120 CALL IO_BUFF_CLEAN_n 00121 00122 ! Snow albedo and density are given initial values in points 00123 ! which get initial snow in the snow analysis 00124 WHERE ( PSWE_ORIG(:) < 1.0E-10 .AND. ZSWE(:)>= 1.0E-10 ) 00125 ZSNA(:) = 0.5 * ( XANSMIN + XANSMAX ) 00126 ZSNR(:) = 0.5 * ( XRHOSMIN + XRHOSMAX ) 00127 END WHERE 00128 00129 ENDIF 00130 00131 ! Write updated snow 00132 ! 00133 #ifdef LFI 00134 CFILEOUT_LFI=CPREPFILE 00135 #endif 00136 CALL FLAG_UPDATE(.FALSE.,.TRUE.,.FALSE.,.FALSE.) 00137 CALL INIT_IO_SURF_n(YPROGRAM,'NATURE','SURF ','WRITE') 00138 00139 YVAR='WSN_VEG1' 00140 YPREFIX='X_Y_WSN_VEG1 (kg/m2)' 00141 CALL WRITE_SURF(YPROGRAM,YVAR,ZSWE,IRESP,HCOMMENT=YPREFIX) 00142 00143 IF ( LINC ) THEN 00144 YVAR='RSN_VEG1' 00145 YPREFIX='X_Y_RSNOW_VEG1 (kg/m3) ' 00146 CALL WRITE_SURF(YPROGRAM,YVAR,ZSNR,IRESP,HCOMMENT=YPREFIX) 00147 YVAR='ASN_VEG' 00148 YPREFIX='X_Y_ASNOW_VEG1 (%) ' 00149 CALL WRITE_SURF(YPROGRAM,YVAR,ZSNA,IRESP,HCOMMENT=YPREFIX) 00150 ENDIF 00151 CALL END_IO_SURF_n(YPROGRAM) 00152 CALL IO_BUFF_CLEAN_n 00153 00154 ! 00155 ! ------------------------------------------------------------------------------------- 00156 IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_UPDATE_SNOW',1,ZHOOK_HANDLE) 00157 END SUBROUTINE ASSIM_ISBA_UPDATE_SNOW
1.8.0
