SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/write_ecoclimap2_data.F90
Go to the documentation of this file.
00001 !     #######################
00002       SUBROUTINE WRITE_ECOCLIMAP2_DATA(HPROGRAM)
00003 !     #######################
00004 !
00005 USE MODI_WRITE_SURF
00006 !
00007 USE MODD_DATA_COVER,     ONLY : TDATA_SEED, TDATA_REAP, XDATA_WATSUP, XDATA_IRRIG,&
00008                                   LDATA_IRRIG, XDATA_VEGTYPE, LCLIM_LAI  
00009 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVT_IRR
00010 !
00011 !
00012 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00013 USE PARKIND1  ,ONLY : JPRB
00014 !
00015 IMPLICIT NONE
00016 !
00017 !* dummy arguments
00018 !  ---------------
00019 !
00020  CHARACTER(LEN=6),     INTENT(IN)    :: HPROGRAM  ! program calling surf. schemes
00021 !
00022 !
00023 !* local variables
00024 !  ---------------
00025 !
00026  CHARACTER(LEN=12) :: YRECFM     ! Name of the article to be read
00027  CHARACTER(LEN=100):: YCOMMENT   ! Comment
00028 INTEGER           :: IRESP      ! reading return code
00029 !
00030 INTEGER           :: IVERSION   ! surface version
00031 INTEGER           :: IBUGFIX    ! surface bugfix
00032 !
00033 INTEGER           :: JCOVER     ! loop counter
00034 !
00035 REAL, DIMENSION(6) :: ZWORK
00036 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00037 !------------------------------------------------------------------------------
00038 !
00039 IF (LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',0,ZHOOK_HANDLE)
00040 YRECFM='DATA_IRRIG'
00041 YCOMMENT='FLAG TO READ USER IRRIGATION DATA FOR ECOCLIMAP2'
00042  CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,YCOMMENT)
00043 !
00044 YRECFM='LCLIM_LAI'
00045 YCOMMENT='FLAG TO USE CLIMATOLOGICAL LAI'
00046  CALL WRITE_SURF(HPROGRAM,YRECFM,LCLIM_LAI,IRESP,YCOMMENT)
00047 !
00048 IF (.NOT. LDATA_IRRIG .AND. LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',1,ZHOOK_HANDLE)
00049 IF (.NOT. LDATA_IRRIG) RETURN
00050 !
00051 DO JCOVER=1,JPCOVER
00052   IF (XDATA_VEGTYPE(JCOVER,NVT_IRR)==0.) CYCLE
00053   WRITE(YRECFM,FMT='(A6,I3.3)') 'IRRIG_',JCOVER
00054   WRITE(YCOMMENT,FMT='(A47,I3.3)') &
00055     'SEED MONTH&DAY, REAP MONTH&DAY, WATSUP, IRRIG  ',JCOVER  
00056   ZWORK(1) = TDATA_SEED  (JCOVER,NVT_IRR)%TDATE%MONTH
00057   ZWORK(2) = TDATA_SEED  (JCOVER,NVT_IRR)%TDATE%DAY
00058   ZWORK(3) = TDATA_REAP  (JCOVER,NVT_IRR)%TDATE%MONTH
00059   ZWORK(4) = TDATA_REAP  (JCOVER,NVT_IRR)%TDATE%DAY
00060   ZWORK(5) = XDATA_WATSUP(JCOVER,NVT_IRR)
00061   ZWORK(6) = XDATA_IRRIG (JCOVER,NVT_IRR)
00062   CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,YCOMMENT,HDIR='-')
00063 END DO
00064 IF (LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',1,ZHOOK_HANDLE)
00065 !
00066 !------------------------------------------------------------------------------
00067 !
00068 END SUBROUTINE WRITE_ECOCLIMAP2_DATA