SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/restart_coupl

Go to the documentation of this file.
00001 !######
00002 SUBROUTINE RESTART_COUPL_TOPD(HPROGRAM,KI)
00003 !###################################################################
00004 !
00005 !!****  *RESTART_COUPL_TOPDn*  
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!  Read all files needed in case of restart 
00010 !!      
00011 !!    REFERENCE
00012 !!    ---------
00013 !!      
00014 !!    AUTHOR
00015 !!    ------
00016 !!      B. Vincendon    
00017 !!
00018 !!    MODIFICATIONS
00019 !!    -------------
00020 !!      Original    07/06/11 
00021 !-------------------------------------------------------------------------------
00022 !
00023 !*       0.     DECLARATIONS
00024 !               ------------
00025 !
00026 USE MODD_SURF_PAR,        ONLY : XUNDEF,NUNDEF
00027 USE MODD_SURF_ATM_n,      ONLY:  NR_NATURE
00028 USE MODD_ISBA_PAR,        ONLY : XWGMIN
00029 !
00030 USE MODD_TOPODYN,       ONLY : NNCAT, CCAT, NNPT, NLINE, NNMC, NPMAX,&
00031                                NNB_TOPD_STEP
00032 
00033 USE MODD_COUPLING_TOPD, ONLY : XAS_NATURE, &
00034                                  NNB_STP_STOCK,NNB_STP_RESTART,XWTOPT,&
00035                                  XRUN_TOROUT,XDR_TOROUT
00036 !
00037 USE MODI_READ_TOPD_FILE
00038 USE MODI_READ_FILE_ISBAMAP
00039 !
00040 USE MODI_GET_LUOUT
00041 USE MODI_ABOR1_SFX
00042 USE MODI_UNPACK_SAME_RANK
00043 USE MODI_PACK_SAME_RANK
00044 !
00045 USE MODI_OPEN_FILE
00046 USE MODI_CLOSE_FILE
00047 !
00048 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00049 USE PARKIND1  ,ONLY : JPRB
00050 !
00051 IMPLICIT NONE
00052 !
00053 !*      0.1    declarations of arguments
00054 !
00055  CHARACTER(LEN=6), INTENT(IN)         :: HPROGRAM ! program calling surf. schemes
00056 INTEGER,          INTENT(IN)         :: KI       ! Surfex grid dimension
00057 !
00058 !
00059 !*      0.2    declarations of local variables
00060 !
00061 INTEGER                                     :: ILUOUT   ! unit of output listing file
00062 INTEGER                                     :: IUNIT    ! unit of restart files
00063 INTEGER                                     :: JSTP,JCAT,JPIX! loop control indexes
00064 REAL, DIMENSION(:),ALLOCATABLE              :: ZAS      ! Saturated area fraction for each Isba meshes
00065 REAL, DIMENSION(:),ALLOCATABLE              :: ZWTOPT   ! Initial water content in case of restart
00066  CHARACTER(LEN=50), DIMENSION(:),ALLOCATABLE :: YFILETOP ! File names
00067 LOGICAL                                     :: LSTOCK, LWG, LASAT
00068 REAL                                        :: ZCORR_STOCK ! used to avoid to lose stock
00069 REAL                                        :: ZCNT_UNDEF,ZSUM1,ZSUM2 ! used to correct budget
00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00071 !-------------------------------------------------------------------------------
00072 IF (LHOOK) CALL DR_HOOK('RESTART_COUPL_TOPD',0,ZHOOK_HANDLE)
00073 !
00074  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00075 !
00076 ! * 1. Read stock files
00077 !          
00078 WRITE(*,*) 'Read STOCK file ',NNB_STP_STOCK
00079 NNB_STP_STOCK = MIN(NNB_STP_STOCK, NNB_TOPD_STEP + NNB_STP_RESTART)
00080 !
00081 INQUIRE(FILE='stocks_init.txt', EXIST=LSTOCK)
00082 INQUIRE(FILE='surfcont_init.map', EXIST=LASAT)
00083 !
00084 IF (.NOT.LSTOCK) THEN
00085   WRITE(ILUOUT,*) 'You asked to run in restart mode but stock file is missing'
00086   CALL ABOR1_SFX("RESTART_COUPL_TOPD_n: stock file is missing")
00087 ELSEIF (.NOT.LASAT) THEN
00088   WRITE(ILUOUT,*) 'You asked to run in restart mode but contributive area file is missing'
00089   CALL ABOR1_SFX("RESTART_COUPL_TOPD_n: contributive area file is missing")
00090 ELSE
00091   !
00092   CALL OPEN_FILE('ASCII ',IUNIT,'stocks_init.txt','FORMATTED',HACTION='READ ')
00093   DO JSTP=1,NNB_STP_STOCK
00094     READ(IUNIT,*)  XRUN_TOROUT(1:NNCAT,JSTP),XDR_TOROUT(1:NNCAT,JSTP)
00095   ENDDO
00096   CALL CLOSE_FILE('ASCII ',IUNIT)
00097   !  
00098   ! * 2. Read pixels water content
00099   !
00100   DO JCAT=1,NNCAT
00101     !
00102     IF (XRUN_TOROUT(JCAT,NNB_STP_STOCK)/=0.) THEN
00103       !
00104       ZCORR_STOCK = XRUN_TOROUT(JCAT,NNB_STP_STOCK) - XRUN_TOROUT(JCAT,NNB_STP_STOCK-1)
00105       DO JSTP = NNB_STP_STOCK+1,NNB_TOPD_STEP
00106         XRUN_TOROUT(JCAT,JSTP) = MAX(0.,XRUN_TOROUT(JCAT,JSTP-1)+ZCORR_STOCK)
00107       ENDDO
00108       !
00109     ENDIF
00110     !
00111     IF (XDR_TOROUT(JCAT,NNB_STP_STOCK)/=0.) THEN
00112       !
00113       ZCORR_STOCK = XDR_TOROUT(JCAT,NNB_STP_STOCK) - XDR_TOROUT(JCAT,NNB_STP_STOCK-1)
00114       DO JSTP = NNB_STP_STOCK+1,NNB_TOPD_STEP
00115         XDR_TOROUT(JCAT,JSTP) = MAX(0.,XDR_TOROUT(JCAT,JSTP-1)+ZCORR_STOCK)
00116       ENDDO
00117       !
00118     ENDIF
00119     !
00120   ENDDO
00121   !
00122   WRITE(*,*) 'Write pixels water content files'
00123   !
00124   ALLOCATE(ZWTOPT(NPMAX))
00125   ALLOCATE(YFILETOP(NNCAT))
00126   !
00127   DO JCAT=1,NNCAT
00128     !
00129     YFILETOP(JCAT)=TRIM(CCAT(JCAT))//'_xwtop_init.map'
00130     INQUIRE(FILE=YFILETOP(JCAT), EXIST=LWG)
00131     IF (.NOT.LWG) THEN
00132       !
00133       WRITE(ILUOUT,*) 'You asked to run in restart mode but pixels water content file is missing'
00134       WRITE(ILUOUT,*) 'for catchment : ',CCAT(JCAT)
00135       CALL ABOR1_SFX("RESTART_COUPL_TOPD_n: pixels water content file is missing")
00136       !
00137     ELSE
00138       !
00139       ZSUM1=SUM(XWTOPT(JCAT,:),MASK=XWTOPT(JCAT,:)/=XUNDEF)
00140       !
00141       CALL READ_TOPD_FILE('ASCII ',YFILETOP(JCAT),'FORMATTED',NNPT(JCAT),ZWTOPT)
00142       !
00143       DO JPIX=1,SIZE(NLINE(JCAT,:))
00144         IF ( NLINE(JCAT,JPIX)/=0 .AND. NLINE(JCAT,JPIX)/=XUNDEF ) THEN
00145           IF (ZWTOPT(JPIX) /= XUNDEF) XWTOPT(JCAT,NLINE(JCAT,JPIX)) = ZWTOPT(JPIX)
00146         ENDIF
00147       ENDDO
00148       !
00149       ZSUM2=SUM(XWTOPT(JCAT,:),MASK=XWTOPT(JCAT,:)<XUNDEF)
00150       !
00151       IF ( ABS(ZSUM2-ZSUM1)>100. ) THEN
00152         !
00153         ZCNT_UNDEF = COUNT(XWTOPT(JCAT,NLINE(JCAT,:))/=XUNDEF.AND. NLINE(JCAT,:)/=0)
00154         IF (ZCNT_UNDEF/=0.) THEN
00155           WHERE ( XWTOPT(JCAT,NLINE(JCAT,:))/=XUNDEF .AND. NLINE(JCAT,:)/=0 )
00156             XWTOPT(JCAT,NLINE(JCAT,:)) = XWTOPT(JCAT,NLINE(JCAT,:)) - ((ZSUM2-ZSUM1)/ZCNT_UNDEF)
00157           ENDWHERE
00158         ENDIF
00159         ZSUM2=SUM(XWTOPT(JCAT,:),MASK=XWTOPT(JCAT,:)<XUNDEF)
00160         !
00161       ENDIF
00162       !
00163     ENDIF
00164     !
00165   ENDDO
00166   ! 
00167   ! * 3. Read Asat files
00168   ! 
00169   WRITE(*,*) 'Write Asat files'
00170   ALLOCATE(ZAS(KI))
00171   CALL OPEN_FILE('ASCII ',IUNIT,'surfcont_init.map','FORMATTED',HACTION='READ ')
00172   CALL READ_FILE_ISBAMAP(IUNIT,ZAS,KI)
00173   CALL CLOSE_FILE('ASCII ',IUNIT)
00174   CALL PACK_SAME_RANK(NR_NATURE,ZAS,XAS_NATURE)
00175   !
00176 ENDIF
00177 !
00178 IF (LHOOK) CALL DR_HOOK('RESTART_COUPL_TOPD',1,ZHOOK_HANDLE)
00179 !-------------------------------------------------------------------------------
00180 END SUBROUTINE RESTART_COUPL_TOPD