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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX,     &
00003                               KLU,KPATCH,TPSNOW,HDIR)  
00004 !     ##########################################################
00005 !
00006 !!****  *READ_GR_SNOW* - routine to read snow surface fields
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !       Initialize snow surface fields.
00011 !
00012 !!**  METHOD
00013 !!    ------
00014 !!    
00015 !!    
00016 !!
00017 !!    EXTERNAL
00018 !!    --------
00019 !!      
00020 !!       
00021 !!    IMPLICIT ARGUMENTS
00022 !!    ------------------ 
00023 !!
00024 !!    REFERENCE
00025 !!    ---------
00026 !!      
00027 !!      
00028 !!
00029 !!    AUTHOR
00030 !!    ------
00031 !!      V. Masson       * Meteo France *
00032 !!
00033 !!    MODIFICATIONS
00034 !!    -------------
00035 !!      Original       20/01/99
00036 !       F.solmon       06/00 adaptation for patch
00037 !       V.Masson       01/03 new version of ISBA
00038 !       B. Decharme    2008  If no WSNOW, WSNOW = XUNDEF
00039 !-----------------------------------------------------------------------------
00040 !
00041 !*       0.    DECLARATIONS
00042 !
00043 USE MODD_TYPE_SNOW
00044 !
00045 USE MODI_READ_SURF
00046 !
00047 USE MODI_ALLOCATE_GR_SNOW
00048 !
00049 USE MODD_SURF_PAR, ONLY : XUNDEF
00050 USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
00051 !
00052 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00053 USE PARKIND1  ,ONLY : JPRB
00054 !
00055 IMPLICIT NONE
00056 !
00057 !*       0.1   declarations of arguments
00058 !
00059  CHARACTER(LEN=6),   INTENT(IN)           :: HPROGRAM  ! calling program
00060  CHARACTER (LEN=*),  INTENT(IN)           :: HSURFTYPE ! generic name used for
00061                                                       ! snow characteristics
00062                                                       ! storage in file
00063  CHARACTER (LEN=3),  INTENT(IN)           :: HPREFIX   ! generic name for patch
00064 !                                                     ! identification                      
00065 INTEGER,            INTENT(IN)           :: KLU       ! horizontal size of snow var.
00066 INTEGER,            INTENT(IN)           :: KPATCH    ! number of tiles
00067 TYPE(SURF_SNOW)                          :: TPSNOW    ! snow characteristics
00068  CHARACTER (LEN=1),  INTENT(IN), OPTIONAL :: HDIR      ! type of reading
00069 !                                                     ! HDIR = 'A' : entire field on All processors
00070 !                                                     ! HDIR = 'H' : distribution on each processor
00071 !
00072 !*       0.2   declarations of local variables
00073 !
00074 INTEGER             :: IRESP               ! Error code after redding
00075  CHARACTER(LEN=12)   :: YRECFM              ! Name of the article to be read
00076  CHARACTER(LEN=16)   :: YRECFM2 
00077 !
00078  CHARACTER (LEN=100) :: YFMT                ! format for writing
00079 INTEGER             :: ISURFTYPE_LEN       ! 
00080 LOGICAL             :: GSNOW               ! snow written in the file
00081 INTEGER             :: JLAYER              ! loop counter
00082 REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK ! 2D array to write data in file
00083  CHARACTER(LEN=1)    :: YDIR                ! type of reading
00084  CHARACTER(LEN=4)    :: YNLAYER     !Format depending on the number of layers
00085 INTEGER             :: IVERSION, IBUGFIX
00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00087 !-------------------------------------------------------------------------------
00088 !
00089 IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)
00090 YDIR = 'H'
00091 IF (PRESENT(HDIR)) YDIR = HDIR
00092 !
00093 !-------------------------------------------------------------------------------
00094  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
00095  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
00096 !-------------------------------------------------------------------------------
00097 !
00098 !*       1.    Type of snow scheme
00099 !              -------------------
00100 !
00101 ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
00102 IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
00103   WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A5)'
00104   WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
00105 ELSE
00106   IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00107     WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A5)'
00108     WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
00109   ELSE
00110     WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A4)'
00111     WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
00112     YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
00113   ENDIF
00114 END IF
00115 !
00116  CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
00117 !
00118 !*       2.    Snow levels
00119 !              -----------
00120 !
00121 !
00122 IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
00123   WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A6)'
00124   WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
00125 ELSE
00126   WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A2)'
00127   WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
00128   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
00129 END IF
00130 !
00131  CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
00132 !
00133 !*       2.    Presence of snow fields in the file
00134 !              -----------------------------------
00135 !
00136 IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN
00137   WRITE(YFMT,'(A5,I1,A1)')     '(A3,A',ISURFTYPE_LEN,')'
00138   WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
00139   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)
00140   CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)
00141 ELSE
00142   IF (TPSNOW%NLAYER==0) THEN
00143     GSNOW = .FALSE.
00144     IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='EBA') TPSNOW%NLAYER=1
00145     IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO'                          ) TPSNOW%NLAYER=3
00146   ELSE
00147     GSNOW = .TRUE.
00148   END IF
00149 END IF
00150 !
00151 !-------------------------------------------------------------------------------
00152 !
00153 !*       3.    Allocations
00154 !              -----------
00155 !
00156  CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
00157 !
00158 IF (.NOT. GSNOW) THEN
00159   IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
00160   RETURN
00161 END IF
00162 !-------------------------------------------------------------------------------
00163 !
00164 !*       4.    Additional key
00165 !              ---------------
00166 !
00167 IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
00168 !
00169 !-------------------------------------------------------------------------------
00170 !
00171 !*       5.    Snow reservoir
00172 !              --------------
00173 !
00174 ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))
00175 !
00176 DO JLAYER = 1,TPSNOW%NLAYER
00177 !
00178   YNLAYER='I1.1'
00179   IF (JLAYER>9) YNLAYER='I2.2'
00180 !   
00181   IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
00182      .OR. TPSNOW%SCHEME=='CRO') THEN  
00183 !
00184     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00185       WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'            
00186       WRITE(YRECFM,YFMT) 'WSNOW_',HSURFTYPE,JLAYER
00187     ELSE
00188       WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00189       WRITE(YRECFM,YFMT) 'WSN_',HSURFTYPE,JLAYER
00190       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00191     ENDIF
00192     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00193     TPSNOW%WSNOW(:,JLAYER,:)=ZWORK
00194   END IF
00195 !
00196 !*       6.    Snow density
00197 !              ------------
00198 !
00199   IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
00200      .OR. TPSNOW%SCHEME=='CRO') THEN  
00201     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00202       WRITE(YFMT,'(A5,I1,A6)')     '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'            
00203       WRITE(YRECFM,YFMT) 'RSNOW_',HSURFTYPE,JLAYER
00204     ELSE
00205       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00206       WRITE(YRECFM,YFMT) 'RSN_',HSURFTYPE,JLAYER
00207       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00208     ENDIF    
00209     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00210     TPSNOW%RHO(:,JLAYER,:)=ZWORK
00211     WHERE(TPSNOW%WSNOW(:,JLAYER,:)==0.0)TPSNOW%RHO(:,JLAYER,:)=XUNDEF
00212   END IF
00213 !
00214 !*       7.    Snow temperature
00215 !              ----------------
00216 !
00217   IF (TPSNOW%SCHEME=='1-L') THEN
00218     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00219       WRITE(YFMT,'(A5,I1,A6)')     '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'      
00220       WRITE(YRECFM,YFMT) 'TSNOW_',HSURFTYPE,JLAYER
00221     ELSE
00222       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00223       WRITE(YRECFM,YFMT) 'TSN_',HSURFTYPE,JLAYER
00224       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00225     ENDIF      
00226     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00227     TPSNOW%T(:,JLAYER,:)=ZWORK
00228     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
00229   END IF
00230 !
00231 !*       8.    Heat content
00232 !              ------------
00233 !
00234   IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
00235     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00236       WRITE(YFMT,'(A5,I1,A6)')     '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'      
00237       WRITE(YRECFM,YFMT) 'HSNOW_',HSURFTYPE,JLAYER
00238     ELSE
00239       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00240       WRITE(YRECFM,YFMT) 'HSN_',HSURFTYPE,JLAYER
00241       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00242     ENDIF       
00243     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00244     TPSNOW%HEAT(:,JLAYER,:)=ZWORK
00245     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
00246   END IF
00247 !
00248 !*       9.    Snow Gran1
00249 !              ------------
00250 !
00251   IF (TPSNOW%SCHEME=='CRO') THEN
00252     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00253       WRITE(YFMT,'(A5,I1,A6)')     '(A7,A',ISURFTYPE_LEN,','//YNLAYER//')'      
00254       WRITE(YRECFM,YFMT) 'SGRAN1_',HSURFTYPE,JLAYER
00255     ELSE
00256       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00257       WRITE(YRECFM,YFMT) 'SG1_',HSURFTYPE,JLAYER
00258       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00259     ENDIF      
00260     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00261     TPSNOW%GRAN1(:,JLAYER,:)=ZWORK
00262     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
00263   END IF
00264 !
00265 !*       10.    Snow Gran2
00266 !              ------------
00267 !
00268   IF (TPSNOW%SCHEME=='CRO') THEN
00269     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00270       WRITE(YFMT,'(A5,I1,A6)')     '(A7,A',ISURFTYPE_LEN,','//YNLAYER//')'       
00271       WRITE(YRECFM,YFMT) 'SGRAN2_',HSURFTYPE,JLAYER
00272     ELSE
00273       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00274       WRITE(YRECFM,YFMT) 'SG2_',HSURFTYPE,JLAYER
00275       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00276     ENDIF     
00277     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00278     TPSNOW%GRAN2(:,JLAYER,:)=ZWORK
00279     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
00280   END IF
00281 !
00282 !*       11.    Historical parameter
00283 !              -------------------
00284 !
00285   IF (TPSNOW%SCHEME=='CRO') THEN
00286     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00287       WRITE(YFMT,'(A5,I1,A6)')     '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
00288       WRITE(YRECFM,YFMT) 'SHIST_',HSURFTYPE,JLAYER
00289     ELSE
00290       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00291       WRITE(YRECFM,YFMT) 'SHI_',HSURFTYPE,JLAYER
00292       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00293     ENDIF    
00294     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00295     TPSNOW%HIST(:,JLAYER,:)=ZWORK
00296     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
00297   END IF
00298 !
00299 !*       12.    Age parameter
00300 !              -------------------
00301 !
00302   IF (TPSNOW%SCHEME=='CRO') THEN
00303     IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00304       WRITE(YFMT,'(A5,I1,A6)')     '(A5,A',ISURFTYPE_LEN,','//YNLAYER//')'
00305       WRITE(YRECFM,YFMT) 'SAGE_',HSURFTYPE,JLAYER
00306     ELSE
00307       WRITE(YFMT,'(A5,I1,A6)')     '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
00308       WRITE(YRECFM,YFMT) 'SAG_',HSURFTYPE,JLAYER
00309       YRECFM=ADJUSTL(HPREFIX//YRECFM)
00310     ENDIF     
00311     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
00312     TPSNOW%AGE(:,JLAYER,:)=ZWORK
00313     WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
00314   END IF
00315 !-------------------------------------------------------------------------------
00316 !
00317 END DO
00318 !
00319 DEALLOCATE(ZWORK)
00320 !-------------------------------------------------------------------------------
00321 !
00322 !*       13.    Albedo
00323 !              ------
00324 !
00325 IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
00326     .OR. TPSNOW%SCHEME=='CRO') THEN  
00327   IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00328     WRITE(YFMT,'(A5,I1,A1)')     '(A6,A',ISURFTYPE_LEN,')'
00329     WRITE(YRECFM,YFMT) 'ASNOW_',HSURFTYPE
00330   ELSE
00331     WRITE(YFMT,'(A5,I1,A1)')     '(A4,A',ISURFTYPE_LEN,')'
00332     WRITE(YRECFM,YFMT) 'ASN_',HSURFTYPE
00333     YRECFM=ADJUSTL(HPREFIX//YRECFM)
00334   ENDIF  
00335   CALL READ_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,:),IRESP,HDIR=YDIR)
00336   WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
00337 END IF
00338 IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
00339 !
00340 !-------------------------------------------------------------------------------
00341 !
00342 END SUBROUTINE READ_GR_SNOW