|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_COVER_n(HPROGRAM) 00003 ! ################################# 00004 ! 00005 !!**** *WRITESURF_COVER_n* - writes cover fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! 00011 !! 00012 !!** METHOD 00013 !! ------ 00014 !! 00015 !! 00016 !! REFERENCE 00017 !! --------- 00018 !! 00019 !! 00020 !! AUTHOR 00021 !! ------ 00022 !! V. Masson *Meteo France* 00023 !! 00024 !! MODIFICATIONS 00025 !! ------------- 00026 !! Original 01/2003 00027 !------------------------------------------------------------------------------- 00028 ! 00029 !* 0. DECLARATIONS 00030 ! ------------ 00031 ! 00032 USE MODD_SURF_ATM_n, ONLY : XSEA, XWATER, XNATURE, XTOWN, XCOVER, LCOVER, & 00033 XZS, LECOCLIMAP 00034 ! 00035 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER 00036 ! 00037 USE MODI_WRITE_SURF 00038 ! 00039 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00040 USE PARKIND1 ,ONLY : JPRB 00041 ! 00042 IMPLICIT NONE 00043 ! 00044 !* 0.1 Declarations of arguments 00045 ! ------------------------- 00046 ! 00047 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling 00048 ! 00049 !* 0.2 Declarations of local variables 00050 ! ------------------------------- 00051 ! 00052 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00053 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00054 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00055 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00056 ! 00057 !------------------------------------------------------------------------------- 00058 ! 00059 !* 1. Cover classes : 00060 ! ------------- 00061 ! 00062 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',0,ZHOOK_HANDLE) 00063 ! 00064 YCOMMENT = '(-)' 00065 CALL WRITE_SURF(HPROGRAM,'FRAC_SEA ',XSEA, IRESP,HCOMMENT=YCOMMENT) 00066 CALL WRITE_SURF(HPROGRAM,'FRAC_NATURE',XNATURE,IRESP,HCOMMENT=YCOMMENT) 00067 CALL WRITE_SURF(HPROGRAM,'FRAC_WATER ',XWATER, IRESP,HCOMMENT=YCOMMENT) 00068 CALL WRITE_SURF(HPROGRAM,'FRAC_TOWN ',XTOWN, IRESP,HCOMMENT=YCOMMENT) 00069 ! 00070 YRECFM='COVER_LIST' 00071 YCOMMENT='(LOGICAL LIST)' 00072 CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-') 00073 ! 00074 YCOMMENT='COVER FIELDS' 00075 CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT) 00076 ! 00077 !------------------------------------------------------------------------------- 00078 ! 00079 !* 2. Orography : 00080 ! --------- 00081 ! 00082 YRECFM='ZS' 00083 YCOMMENT='X_Y_ZS (M)' 00084 CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT) 00085 ! 00086 IF (LHOOK) CALL DR_HOOK('WRITESURF_COVER_N',1,ZHOOK_HANDLE) 00087 ! 00088 !------------------------------------------------------------------------------- 00089 ! 00090 END SUBROUTINE WRITESURF_COVER_n
1.8.0