SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/assim_surf

Go to the documentation of this file.
00001 !     #################################################################################
00002 SUBROUTINE ASSIM_SURF_ATM_n(HPROGRAM,KI,                                                &
00003                             PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW,             &
00004                             PCLOUDS,   PLSM,        PEVAPTR,   PEVAP,                   &
00005                             PSWEC,     PTSC,                                            &
00006                             PTS,       PT2M,        PHU2M,     PSWE,                    &
00007                             HTEST )
00008 !     #################################################################################
00009 !
00010 !
00011 !!****  *ASSIM_SURF_ATM_n * - Driver to call the schemes for the 
00012 !!       four surface types (SEA, WATER, NATURE, TOWN)
00013 !!
00014 !!    PURPOSE
00015 !!    -------
00016 !!
00017 !!**  METHOD
00018 !!    ------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!      
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!     T. Aspelien 
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    04/2012
00031 !!-------------------------------------------------------------
00032 !
00033 USE MODD_SURF_CONF,      ONLY : CPROGNAME
00034 USE MODD_SURF_ATM_n,     ONLY : NDIM_FULL,                             &
00035                                 NSIZE_SEA, NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, &
00036                                 NR_SEA,    NR_WATER,    NR_TOWN,    NR_NATURE
00037 !
00038 USE MODD_ASSIM,          ONLY : LREAD_SST_FROM_FILE
00039 !
00040 USE YOMHOOK,             ONLY : LHOOK,   DR_HOOK
00041 USE PARKIND1,            ONLY : JPRB
00042 !
00043 USE MODI_ABOR1_SFX
00044 USE MODI_ASSIM_READ_SST_FROM_FILE
00045 USE MODI_ASSIM_SEA_n
00046 USE MODI_ASSIM_INLAND_WATER_n
00047 USE MODI_ASSIM_NATURE_n
00048 USE MODI_ASSIM_TOWN_n
00049 !
00050 IMPLICIT NONE
00051 !
00052 !*      0.1    declarations of arguments
00053 !
00054  CHARACTER(LEN=6),    INTENT(IN) :: HPROGRAM     ! program calling surf. schemes
00055 INTEGER,             INTENT(IN) :: KI
00056 REAL, DIMENSION(KI), INTENT(IN) :: PCON_RAIN
00057 REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_RAIN
00058 REAL, DIMENSION(KI), INTENT(IN) :: PCON_SNOW
00059 REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_SNOW
00060 REAL, DIMENSION(KI), INTENT(IN) :: PCLOUDS
00061 REAL, DIMENSION(KI), INTENT(IN) :: PLSM
00062 REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
00063 REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
00064 REAL, DIMENSION(KI), INTENT(IN) :: PSWEC
00065 REAL, DIMENSION(KI), INTENT(IN) :: PTSC
00066 REAL, DIMENSION(KI), INTENT(INOUT) :: PTS
00067 REAL, DIMENSION(KI), INTENT(IN) :: PT2M
00068 REAL, DIMENSION(KI), INTENT(IN) :: PHU2M
00069 REAL, DIMENSION(KI), INTENT(IN) :: PSWE
00070  CHARACTER(LEN=2),   INTENT(IN)  :: HTEST        ! must be equal to 'OK'
00071 
00072 !
00073 !*      0.2    declarations of local variables
00074 !
00075 INTEGER                              :: JTILE                        ! loop on type of surface
00076 LOGICAL                              :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
00077 REAL(KIND=JPRB)                      :: ZHOOK_HANDLE
00078 
00079 !
00080 !-------------------------------------------------------------------------------------
00081 IF (LHOOK) CALL DR_HOOK('ASSIM_SURF_ATM_N',0,ZHOOK_HANDLE)
00082 CPROGNAME=HPROGRAM
00083 !
00084 IF (HTEST/='OK') THEN
00085   CALL ABOR1_SFX('ASSIM_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
00086 END IF
00087 !
00088 !
00089 !-------------------------------------------------------------------------------------
00090 ! Preliminaries: Tile related operations
00091 !-------------------------------------------------------------------------------------
00092 
00093 ! FLAGS for the various surfaces:
00094 !
00095 GSEA      = NSIZE_SEA    >0
00096 GWATER    = NSIZE_WATER  >0
00097 GTOWN     = NSIZE_TOWN   >0
00098 GNATURE   = NSIZE_NATURE >0
00099 !
00100 ! Tile counter:
00101 !
00102 JTILE     = 0 
00103 !
00104 !
00105 !--------------------------------------------------------------------------------------
00106 ! Call interfaces for sea, water, nature and town here...
00107 !--------------------------------------------------------------------------------------
00108 !
00109 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00110 ! SEA Tile calculations:
00111 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00112 !
00113 JTILE = JTILE + 1
00114 !
00115 IF(GSEA)THEN
00116 !
00117   IF ( LREAD_SST_FROM_FILE ) CALL ASSIM_READ_SST_FROM_FILE(HPROGRAM,NDIM_FULL,PTS,PLSM,HTEST)
00118   CALL ASSIM_TREAT_SURF(JTILE,NSIZE_SEA,NR_SEA)
00119 !
00120 ENDIF
00121 !
00122 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00123 ! INLAND WATER Tile calculations:
00124 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00125 !
00126 JTILE = JTILE + 1
00127 !
00128 IF(GWATER)THEN
00129 !
00130   CALL ASSIM_TREAT_SURF(JTILE,NSIZE_WATER,NR_WATER)
00131 !
00132 ENDIF 
00133 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00134 ! NATURAL SURFACE Tile calculations:
00135 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00136 !
00137 JTILE = JTILE + 1
00138 !
00139 IF(GNATURE)THEN
00140 !
00141   CALL ASSIM_TREAT_SURF(JTILE,NSIZE_NATURE,NR_NATURE)
00142 !
00143 ENDIF 
00144 !
00145 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00146 ! URBAN Tile calculations:
00147 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
00148 !
00149 JTILE = JTILE + 1
00150 !
00151 IF(GTOWN)THEN
00152 !
00153   CALL ASSIM_TREAT_SURF(JTILE,NSIZE_TOWN,NR_TOWN)
00154 !
00155 ENDIF
00156 
00157 IF (LHOOK) CALL DR_HOOK('ASSIM_SURF_ATM_N',1,ZHOOK_HANDLE)
00158 !
00159 !=======================================================================================
00160 CONTAINS
00161 !=======================================================================================
00162 SUBROUTINE ASSIM_TREAT_SURF(KTILE,KSIZE,KMASK)
00163 !
00164 IMPLICIT NONE
00165 !
00166 INTEGER, INTENT(IN)                   :: KTILE
00167 INTEGER, INTENT(IN)                   :: KSIZE
00168 INTEGER, INTENT(IN), DIMENSION(KSIZE) :: KMASK
00169 INTEGER                               :: JJ,JI
00170 REAL,DIMENSION(KSIZE)                 :: ZP_PCON_RAIN
00171 REAL,DIMENSION(KSIZE)                 :: ZP_PSTRAT_RAIN
00172 REAL,DIMENSION(KSIZE)                 :: ZP_PCON_SNOW
00173 REAL,DIMENSION(KSIZE)                 :: ZP_PSTRAT_SNOW
00174 REAL,DIMENSION(KSIZE)                 :: ZP_PCLOUDS
00175 REAL,DIMENSION(KSIZE)                 :: ZP_PLSM
00176 REAL,DIMENSION(KSIZE)                 :: ZP_PEVAPTR
00177 REAL,DIMENSION(KSIZE)                 :: ZP_PEVAP
00178 REAL,DIMENSION(KSIZE)                 :: ZP_PSWEC
00179 REAL,DIMENSION(KSIZE)                 :: ZP_PTSC
00180 REAL,DIMENSION(KSIZE)                 :: ZP_PTS
00181 REAL,DIMENSION(KSIZE)                 :: ZP_PT2M
00182 REAL,DIMENSION(KSIZE)                 :: ZP_PHU2M
00183 REAL,DIMENSION(KSIZE)                 :: ZP_PSWE
00184 
00185 DO JJ=1,KSIZE
00186   JI=KMASK(JJ)
00187   ZP_PCON_RAIN(JJ)   = PCON_RAIN(JI)
00188   ZP_PSTRAT_RAIN(JJ) = PSTRAT_RAIN(JI)
00189   ZP_PCON_SNOW(JJ)   = PCON_SNOW(JI)
00190   ZP_PSTRAT_SNOW(JJ) = PSTRAT_SNOW(JI)
00191   ZP_PCLOUDS(JJ)     = PCLOUDS(JI)
00192   ZP_PLSM(JJ)        = PLSM(JI)
00193   ZP_PEVAPTR(JJ)     = PEVAPTR(JI)
00194   ZP_PEVAP(JJ)       = PEVAP(JI)
00195   ZP_PSWEC(JJ)       = PSWEC(JI)
00196   ZP_PTSC(JJ)        = PTSC(JI)
00197   ZP_PTS(JJ)         = PTS(JI) 
00198   ZP_PT2M(JJ)        = PT2M(JI)
00199   ZP_PHU2M(JJ)       = PHU2M(JI)
00200   ZP_PSWE(JJ)        = PSWE(JI)
00201 ENDDO
00202 
00203 IF (KTILE==1) THEN
00204  
00205   WRITE(*,*) '*********************************************'
00206   WRITE(*,*) '*      ASSIMILATIONS FOR SEA POINTS         *'
00207   WRITE(*,*) '*********************************************'
00208  
00209   CALL ASSIM_SEA_n(HPROGRAM,KSIZE,ZP_PTS,ZP_PLSM,HTEST)
00210 
00211 ELSEIF (KTILE==2) THEN
00212   
00213   WRITE(*,*) '*********************************************'  
00214   WRITE(*,*) '*      ASSIMILATIONS FOR WATER POINTS       *'
00215   WRITE(*,*) '*********************************************'
00216   CALL ASSIM_INLAND_WATER_n(HPROGRAM,KSIZE,ZP_PTS,ZP_PLSM,HTEST)
00217 
00218 ELSEIF (KTILE==3) THEN
00219   
00220   WRITE(*,*) '*********************************************'  
00221   WRITE(*,*) '*      ASSIMILATIONS FOR NATURE POINTS      *'
00222   WRITE(*,*) '*********************************************'
00223   CALL ASSIM_NATURE_n(HPROGRAM,KSIZE,                                             &
00224                       ZP_PCON_RAIN, ZP_PSTRAT_RAIN, ZP_PCON_SNOW, ZP_PSTRAT_SNOW, &
00225                       ZP_PCLOUDS,   ZP_PLSM,        ZP_PEVAPTR,   ZP_PEVAP,       & 
00226                       ZP_PSWEC,     ZP_PTSC,                                      &
00227                       ZP_PTS,       ZP_PT2M,        ZP_PHU2M,     ZP_PSWE,        & 
00228                       HTEST )
00229   
00230 ELSEIF (KTILE==4) THEN
00231   
00232   WRITE(*,*) '*********************************************'  
00233   WRITE(*,*) '*      ASSIMILATIONS FOR URBAN POINTS       *'
00234   WRITE(*,*) '*********************************************'
00235   CALL ASSIM_TOWN_n(HPROGRAM,KSIZE,ZP_PT2M,HTEST)
00236   
00237 ENDIF
00238 
00239 END SUBROUTINE ASSIM_TREAT_SURF
00240 !=======================================================================================
00241 END SUBROUTINE ASSIM_SURF_ATM_n
00242 !=======================================================================================
00243