SURFEX v7.3
General documentation of Surfex
|
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