SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_PGD_FLAKE_n(HPROGRAM) 00003 ! ################################################### 00004 ! 00005 !!**** *WRITESURF_PGD_FLAKE_n* - writes FLAKE fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! V. Masson *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 01/2003 00031 !! B. Decharme 07/2011 : delete argument HWRITE 00032 !------------------------------------------------------------------------------- 00033 ! 00034 !* 0. DECLARATIONS 00035 ! ------------ 00036 ! 00037 USE MODD_FLAKE_n, ONLY : XZS,XCOVER,LCOVER, & 00038 XWATER_DEPTH,XWATER_FETCH,XT_BS,XDEPTH_BS,XEXTCOEF_WATER 00039 USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR 00040 ! 00041 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER 00042 ! 00043 USE MODI_WRITE_SURF 00044 USE MODI_WRITE_GRID 00045 ! 00046 ! 00047 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00048 USE PARKIND1 ,ONLY : JPRB 00049 ! 00050 IMPLICIT NONE 00051 ! 00052 !* 0.1 Declarations of arguments 00053 ! ------------------------- 00054 ! 00055 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling 00056 00057 ! 00058 !* 0.2 Declarations of local variables 00059 ! ------------------------------- 00060 ! 00061 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00062 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00063 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00064 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00065 ! 00066 !------------------------------------------------------------------------------- 00067 ! 00068 ! 00069 !* 2. Physiographic data fields: 00070 ! ------------------------- 00071 ! 00072 !* cover classes 00073 ! 00074 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_FLAKE_N',0,ZHOOK_HANDLE) 00075 YRECFM='COVER_LIST' 00076 YCOMMENT='(LOGICAL LIST)' 00077 CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-') 00078 ! 00079 YCOMMENT='COVER FIELDS' 00080 CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT) 00081 ! 00082 !* orography 00083 ! 00084 YRECFM='ZS' 00085 YCOMMENT='ZS' 00086 CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT) 00087 ! 00088 !* latitude, longitude 00089 ! 00090 CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP) 00091 ! 00092 !* FLake parameters 00093 ! 00094 YRECFM='WATER_DEPTH' 00095 YCOMMENT='X_Y_'//YRECFM//' (m)' 00096 CALL WRITE_SURF(HPROGRAM,YRECFM,XWATER_DEPTH(:),IRESP,HCOMMENT=YCOMMENT) 00097 ! 00098 YRECFM='WATER_FETCH' 00099 YCOMMENT='X_Y_'//YRECFM//' (m)' 00100 CALL WRITE_SURF(HPROGRAM,YRECFM,XWATER_FETCH(:),IRESP,HCOMMENT=YCOMMENT) 00101 ! 00102 YRECFM='T_BS' 00103 YCOMMENT='X_Y_'//YRECFM//' (K)' 00104 CALL WRITE_SURF(HPROGRAM,YRECFM,XT_BS(:),IRESP,HCOMMENT=YCOMMENT) 00105 ! 00106 YRECFM='DEPTH_BS' 00107 YCOMMENT='X_Y_'//YRECFM//' (m)' 00108 CALL WRITE_SURF(HPROGRAM,YRECFM,XDEPTH_BS(:),IRESP,HCOMMENT=YCOMMENT) 00109 ! 00110 YRECFM='EXTCOEF_WAT' 00111 YCOMMENT='X_Y_'//YRECFM//' ' 00112 CALL WRITE_SURF(HPROGRAM,YRECFM,XEXTCOEF_WATER(:),IRESP,HCOMMENT=YCOMMENT) 00113 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_FLAKE_N',1,ZHOOK_HANDLE) 00114 ! 00115 !------------------------------------------------------------------------------- 00116 ! 00117 END SUBROUTINE WRITESURF_PGD_FLAKE_n