|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_SURF_ATM_DATE(HPROGRAM,HINIT,KLUOUT, & 00003 HATMFILE,HATMFILETYPE, & 00004 KYEAR,KMONTH,KDAY,PTIME,TPTIME ) 00005 ! ####################################################### 00006 ! 00007 !!**** *READ_SURF_ATM_DATE* - routine to initialise the date TPTIME 00008 !! 00009 !! PURPOSE 00010 !! ------- 00011 !! 00012 !!** METHOD 00013 !! ------ 00014 !! 00015 !! EXTERNAL 00016 !! -------- 00017 !! 00018 !! 00019 !! IMPLICIT ARGUMENTS 00020 !! ------------------ 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! 00026 !! AUTHOR 00027 !! ------ 00028 !! S.Malardel *Meteo France* 00029 !! 00030 !! MODIFICATIONS 00031 !! ------------- 00032 !! Original 01/2004 00033 !! P. Le Moigne 10/2005, Phasage Arome 00034 !------------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATIONS 00037 ! ------------ 00038 ! 00039 USE MODD_TYPE_DATE_SURF 00040 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00041 ! 00042 USE MODI_READ_PRE_SURFA_DAT_CONF 00043 USE MODI_READ_PREP_SURF_ATM_CONF 00044 USE MODI_READ_PREP_FILE_DATE 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 USE MODI_ABOR1_SFX 00050 ! 00051 IMPLICIT NONE 00052 ! 00053 !* 0.1 Declarations of arguments 00054 ! ------------------------- 00055 ! 00056 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA 00057 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! fields to initialize 'ALL', 'PRE', 'PGD' 00058 TYPE (DATE_TIME), INTENT(OUT) :: TPTIME ! time and date 00059 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00060 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name 00061 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type 00062 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00063 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00064 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00065 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00066 ! 00067 ! 00068 !* 0.2 Declarations of local variables 00069 ! ------------------------------- 00070 ! 00071 CHARACTER(LEN=28) :: YFILE ! file name 00072 CHARACTER(LEN=6) :: YFILETYPE ! file type 00073 CHARACTER(LEN=28) :: YFILEPGD ! file name 00074 CHARACTER(LEN=6) :: YFILEPGDTYPE ! file type 00075 CHARACTER(LEN=28) :: YFILEPGDIN ! file name 00076 CHARACTER(LEN=6) :: YFILEPGDINTYPE ! file type 00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00078 ! 00079 !------------------------------------------------------------------------------- 00080 ! 00081 IF (LHOOK) CALL DR_HOOK('READ_SURF_ATM_DATE',0,ZHOOK_HANDLE) 00082 YFILE = ' ' 00083 YFILETYPE = ' ' 00084 ! 00085 YFILEPGDIN = ' ' 00086 YFILEPGDINTYPE = ' ' 00087 ! 00088 !------------------------------------------------------------------------------- 00089 ! 00090 !* look for a date in the namelist NAM_SURF_ATM 00091 !---------------------------------------------- 00092 ! 00093 CALL READ_PRE_SURFA_DAT_CONF(HPROGRAM,KLUOUT,TPTIME) 00094 ! 00095 !* If no date in the namelist, look for a file 00096 ! --------------- 00097 ! 00098 IF (TPTIME%TDATE%YEAR==NUNDEF.OR.TPTIME%TDATE%MONTH==NUNDEF & 00099 .OR.TPTIME%TDATE%DAY==NUNDEF.OR.TPTIME%TIME==XUNDEF) THEN 00100 ! 00101 CALL READ_PREP_SURF_ATM_CONF(HPROGRAM,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,& 00102 HATMFILE,HATMFILETYPE,YFILEPGDIN,YFILEPGDINTYPE,KLUOUT) 00103 ! 00104 IF (LEN_TRIM(YFILETYPE)/=0) & 00105 CALL READ_PREP_FILE_DATE(HPROGRAM,YFILE,YFILETYPE,TPTIME,KLUOUT) 00106 END IF 00107 ! 00108 !* If no file and no date in the namelist, test if atmospheric date 00109 !------------------------------------------------------------------ 00110 ! 00111 IF (LEN_TRIM(YFILE)==0 .AND. (TPTIME%TDATE%YEAR==XUNDEF.OR.TPTIME%TDATE%MONTH==XUNDEF & 00112 .OR.TPTIME%TDATE%DAY==XUNDEF.OR.TPTIME%TIME==XUNDEF)) THEN 00113 ! 00114 IF (KYEAR /= NUNDEF .AND. KMONTH /= NUNDEF .AND. KDAY /= NUNDEF .AND. PTIME /= XUNDEF) THEN 00115 TPTIME%TDATE%YEAR = KYEAR 00116 TPTIME%TDATE%MONTH= KMONTH 00117 TPTIME%TDATE%DAY = KDAY 00118 TPTIME%TIME = PTIME 00119 ELSE 00120 ! 00121 !* If no file, no date in the namelist and no atmospheric date : stop 00122 !----------------------------------------------------------------------- 00123 ! 00124 CALL ABOR1_SFX('READ_SURF_ATM_DATE: DATE NOT SET') 00125 END IF 00126 END IF 00127 ! 00128 !* Test of date coherence? 00129 !------------------------ 00130 ! 00131 IF (KYEAR /= NUNDEF .AND. KMONTH /= NUNDEF .AND. KDAY /= NUNDEF .AND. PTIME /= XUNDEF) THEN 00132 IF (KYEAR /= TPTIME%TDATE%YEAR .OR. KMONTH /= TPTIME%TDATE%MONTH & 00133 .OR. KDAY /= TPTIME%TDATE%DAY .AND. PTIME /= TPTIME%TIME) THEN 00134 WRITE(UNIT=KLUOUT, FMT=*) 'WARNING in READ_SURF_ATM_DATE' 00135 WRITE(UNIT=KLUOUT, FMT=*) 'ATMOSPHERIC AND SURFACE DATES ARE NOT THE SAME' 00136 00137 WRITE(UNIT=KLUOUT, FMT=*)'ATMOSPHERIC DATE:' 00138 WRITE(UNIT=KLUOUT, FMT='(" YEAR=",I4)') KYEAR 00139 WRITE(UNIT=KLUOUT, FMT='(" MONTH=",I4)') KMONTH 00140 WRITE(UNIT=KLUOUT, FMT='(" DAY=",I4)') KDAY 00141 WRITE(UNIT=KLUOUT, FMT='(" TIME=",E13.6)') PTIME 00142 WRITE(UNIT=KLUOUT, FMT=*)'SURFACE DATE:' 00143 WRITE(UNIT=KLUOUT, FMT='(" YEAR=",I4)') TPTIME%TDATE%YEAR 00144 WRITE(UNIT=KLUOUT, FMT='(" MONTH=",I4)') TPTIME%TDATE%MONTH 00145 WRITE(UNIT=KLUOUT, FMT='(" DAY=",I4)') TPTIME%TDATE%DAY 00146 WRITE(UNIT=KLUOUT, FMT='(" TIME=",E13.6)') TPTIME%TIME 00147 ELSE 00148 WRITE(UNIT=KLUOUT, FMT=*)'SAME ATMOSPHERIC AND SURFACE DATES' 00149 WRITE(UNIT=KLUOUT, FMT=*)'DATE in READ_SURF_ATM_DATE:' 00150 WRITE(UNIT=KLUOUT, FMT='(" YEAR=",I4," MONTH=",I4," DAY=",I4)') & 00151 KYEAR,KMONTH,KDAY 00152 WRITE(UNIT=KLUOUT, FMT='(" TIME=",E13.6)') PTIME 00153 ENDIF 00154 ENDIF 00155 IF (LHOOK) CALL DR_HOOK('READ_SURF_ATM_DATE',1,ZHOOK_HANDLE) 00156 !------------------------------------------------------------------------------ 00157 ! 00158 END SUBROUTINE READ_SURF_ATM_DATE
1.8.0
