SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/writesurf_sso

Go to the documentation of this file.
00001 !     ####################################
00002       SUBROUTINE WRITESURF_SSO_CANOPY_n(HPROGRAM,HWRITE,OWRITE)
00003 !     ####################################
00004 !
00005 !!****  *WRITE_SSO_n* - writes SSO 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 !!      E. Martin   01/2012 avoid write of XUNDEF fields
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 !
00038 !
00039 USE MODD_SSO_CANOPY_n,   ONLY : NLVL, XZ, XU, XTKE
00040 !
00041 USE MODI_WRITE_SURF
00042 !
00043 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00044 USE PARKIND1  ,ONLY : JPRB
00045 !
00046 IMPLICIT NONE
00047 !
00048 !*       0.1   Declarations of arguments
00049 !              -------------------------
00050 !
00051  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00052  CHARACTER(LEN=3),  INTENT(IN)  :: HWRITE   ! 'PREP' : does not write SBL XUNDEF fields
00053 !                                          ! 'ALL' : all fields are written
00054 LOGICAL,           INTENT(IN)  :: OWRITE   ! flag to write canopy terms
00055 !
00056 !*       0.2   Declarations of local variables
00057 !              -------------------------------
00058 !
00059 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00060  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00061  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00062 !
00063 INTEGER :: JLAYER  ! loop counter on layers
00064 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00065 !-------------------------------------------------------------------------------
00066 !
00067 !*       1.     Prognostic fields:
00068 !               -----------------
00069 !
00070 !
00071 !* flag to define if canopy is computed
00072 !
00073 IF (LHOOK) CALL DR_HOOK('WRITESURF_SSO_CANOPY_N',0,ZHOOK_HANDLE)
00074 YRECFM='SSO_CANOPY'
00075 YCOMMENT='flag to use canopy levels'
00076  CALL WRITE_SURF(HPROGRAM,YRECFM,OWRITE,IRESP,HCOMMENT=YCOMMENT)
00077 !
00078 IF (.NOT. OWRITE .AND. LHOOK) CALL DR_HOOK('WRITESURF_SSO_CANOPY_N',1,ZHOOK_HANDLE)
00079 IF (.NOT. OWRITE) RETURN
00080 !
00081 !* number of levels
00082 !
00083 YRECFM='SSO_CAN_LVL'
00084 YCOMMENT='number of canopy levels'
00085  CALL WRITE_SURF(HPROGRAM,YRECFM,NLVL,IRESP,HCOMMENT=YCOMMENT)
00086 !
00087 !* altitudes
00088 !
00089 DO JLAYER=1,NLVL
00090   WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_Z',JLAYER,' '
00091   YCOMMENT='altitudes of canopy levels (m)'
00092   CALL WRITE_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00093 END DO
00094 !
00095 IF (HWRITE/='PRE') THEN
00096   !
00097   !* wind in canopy
00098   !
00099   DO JLAYER=1,NLVL
00100     WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_U',JLAYER,' '
00101     YCOMMENT='wind at canopy levels (m/s)'
00102     CALL WRITE_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00103   END DO
00104   !
00105   !* Tke in canopy
00106   !
00107   DO JLAYER=1,NLVL
00108     WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_E',JLAYER,' '
00109     YCOMMENT='Tke at canopy levels (m2/s2)'
00110     CALL WRITE_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00111   END DO
00112   !
00113 ENDIF
00114 !
00115 IF (LHOOK) CALL DR_HOOK('WRITESURF_SSO_CANOPY_N',1,ZHOOK_HANDLE)
00116 !
00117 !-------------------------------------------------------------------------------
00118 !
00119 END SUBROUTINE WRITESURF_SSO_CANOPY_n