|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !################### 00002 MODULE MODE_COUPLING_VAR_SFX_TRIP 00003 !################### 00004 ! 00005 !!**** *MODE_COUPLING_VAR_SFX_TRIP* 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 ! The purpose of this routine is to store here all routines 00011 ! used to get or to put each variable used in the coupling of SFX - TRIP. 00012 ! 00013 !! 00014 !!** IMPLICIT ARGUMENTS 00015 !! ------------------ 00016 !! NONE 00017 !! 00018 !! REFERENCE 00019 !! --------- 00020 !! 00021 !! 00022 !! AUTHOR 00023 !! ------ 00024 !! B. Decharme * Meteo France * 00025 !! 00026 !! MODIFICATIONS 00027 !! ------------- 00028 !! Original 15/05/08 00029 !-------------------------------------------------------------------------------- 00030 ! 00031 !* 0. DECLARATIONS 00032 ! ------------ 00033 ! 00034 INTERFACE GET_COUPLING_VAR_TRIP_n 00035 MODULE PROCEDURE GET_COUPLING_VAR_TRIP_n 00036 END INTERFACE 00037 00038 INTERFACE GET_COUPLING_VAR_SFX_n 00039 MODULE PROCEDURE GET_COUPLING_VAR_SFX_n 00040 END INTERFACE 00041 00042 INTERFACE PUT_COUPLING_VAR_SFX_n 00043 MODULE PROCEDURE PUT_COUPLING_VAR_SFX_n 00044 END INTERFACE 00045 ! 00046 !------------------------------------------------------------------------------- 00047 ! 00048 CONTAINS 00049 ! 00050 !------------------------------------------------------------------------------- 00051 ! 00052 ! #################################################### 00053 SUBROUTINE GET_COUPLING_VAR_TRIP_n(PFFLOOD,PPIFLOOD) 00054 ! #################################################### 00055 ! 00056 !! PURPOSE 00057 !! ------- 00058 ! 00059 ! Get TRIP - ISBA coupling variables 00060 ! 00061 USE MODD_TRIP_GRID_n, ONLY : GMASK 00062 USE MODD_TRIP_n, ONLY : XFFLOOD,XPIFLOOD 00063 ! 00064 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00065 USE PARKIND1 ,ONLY : JPRB 00066 ! 00067 IMPLICIT NONE 00068 ! 00069 !* declarations of arguments 00070 ! 00071 REAL, DIMENSION(:), INTENT(OUT) :: PFFLOOD 00072 REAL, DIMENSION(:), INTENT(OUT) :: PPIFLOOD 00073 ! 00074 !* declarations of local variables 00075 ! 00076 INTEGER I,J,ICOUNT 00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00078 ! 00079 !* procedure 00080 ! 00081 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:GET_COUPLING_VAR_TRIP_n',0,ZHOOK_HANDLE) 00082 ICOUNT=0 00083 ! 00084 DO J=1,SIZE(GMASK,2) 00085 DO I=1,SIZE(GMASK,1) 00086 ICOUNT=ICOUNT+1 00087 IF(.NOT.GMASK(I,J))CYCLE 00088 PFFLOOD (ICOUNT)=XFFLOOD (I,J) 00089 PPIFLOOD(ICOUNT)=XPIFLOOD(I,J) 00090 ENDDO 00091 ENDDO 00092 ! 00093 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:GET_COUPLING_VAR_TRIP_n',1,ZHOOK_HANDLE) 00094 END SUBROUTINE GET_COUPLING_VAR_TRIP_n 00095 ! 00096 !------------------------------------------------------------------------------- 00097 ! 00098 ! ################################################################### 00099 SUBROUTINE GET_COUPLING_VAR_SFX_n(OFLOOD,PDRAIN,PRUNOFF,PSRC_FLOOD) 00100 ! ################################################################### 00101 ! 00102 !! PURPOSE 00103 !! ------- 00104 ! 00105 ! Get TRIP - ISBA coupling variables 00106 ! Put ISBA variables in TRIP dimension (kg/m² --> kg) 00107 ! 00108 USE MODD_SURF_PAR, ONLY : XUNDEF 00109 ! 00110 USE MODD_ISBA_n, ONLY : XCPL_DRAIN,XCPL_RUNOFF,XCPL_EFLOOD, & 00111 XCPL_PFLOOD,XCPL_IFLOOD,XCPL_ICEFLUX,& 00112 LGLACIER, TSNOW 00113 ! 00114 USE MODD_SURF_ATM_n, ONLY : NR_NATURE, XNATURE 00115 USE MODD_SURF_ATM_GRID_n, ONLY : XMESH_SIZE 00116 ! 00117 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00118 USE PARKIND1 ,ONLY : JPRB 00119 ! 00120 IMPLICIT NONE 00121 ! 00122 !* declarations of arguments 00123 ! 00124 LOGICAL, INTENT(IN ) :: OFLOOD 00125 ! 00126 REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN 00127 REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF 00128 REAL, DIMENSION(:), INTENT(OUT) :: PSRC_FLOOD 00129 ! 00130 !* declarations of local variables 00131 ! 00132 INTEGER :: II, JI, INATURE 00133 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00134 ! 00135 !------------------------------------------------------------------------------- 00136 ! 00137 ! Initialize 00138 ! 00139 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:GET_COUPLING_VAR_SFX_n',0,ZHOOK_HANDLE) 00140 INATURE=SIZE(XCPL_DRAIN) 00141 ! 00142 PDRAIN (:) = 0.0 00143 PRUNOFF (:) = 0.0 00144 PSRC_FLOOD(:) = 0.0 00145 ! 00146 ! Some calculation 00147 ! 00148 IF(LGLACIER.AND.TSNOW%SCHEME=='D95')THEN 00149 XCPL_RUNOFF(:) = XCPL_RUNOFF(:) + XCPL_ICEFLUX(:) 00150 ENDIF 00151 ! 00152 ! Get variable over nature tile to global field 00153 ! 00154 DO JI=1,INATURE 00155 II = NR_NATURE(JI) 00156 PDRAIN (II) = XCPL_DRAIN (JI) 00157 PRUNOFF (II) = XCPL_RUNOFF(JI) 00158 ENDDO 00159 ! 00160 ! kg/m2 -> kg 00161 ! 00162 PDRAIN (:) = PDRAIN (:) * XMESH_SIZE(:) * XNATURE(:) 00163 PRUNOFF (:) = PRUNOFF (:) * XMESH_SIZE(:) * XNATURE(:) 00164 ! 00165 ! re-initialize cumulative field 00166 ! 00167 XCPL_DRAIN (:) = 0.0 00168 XCPL_RUNOFF (:) = 0.0 00169 XCPL_ICEFLUX(:) = 0.0 00170 ! 00171 ! Floodplains 00172 ! 00173 IF(OFLOOD)THEN 00174 ! 00175 DO JI=1,INATURE 00176 II = NR_NATURE(JI) 00177 PSRC_FLOOD(II) = XCPL_PFLOOD(JI)-XCPL_IFLOOD(JI)-XCPL_EFLOOD(JI) 00178 ENDDO 00179 ! 00180 PSRC_FLOOD (:) = PSRC_FLOOD(:) * XMESH_SIZE(:) * XNATURE(:) 00181 ! 00182 XCPL_PFLOOD(:) = 0.0 00183 XCPL_IFLOOD(:) = 0.0 00184 XCPL_EFLOOD(:) = 0.0 00185 ! 00186 ENDIF 00187 ! 00188 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:GET_COUPLING_VAR_SFX_n',1,ZHOOK_HANDLE) 00189 END SUBROUTINE GET_COUPLING_VAR_SFX_n 00190 ! 00191 !------------------------------------------------------------------------------- 00192 ! 00193 ! ########################################################## 00194 SUBROUTINE PUT_COUPLING_VAR_SFX_n(PFFLOOD,PPIFLOOD,PTSTEP) 00195 ! ########################################################## 00196 ! 00197 !! PURPOSE 00198 !! ------- 00199 ! 00200 ! Get TRIP - ISBA coupling variables 00201 ! 00202 USE MODD_SURF_ATM_GRID_n, ONLY : XMESH_SIZE 00203 ! 00204 USE MODD_SURF_ATM_n, ONLY : NR_NATURE, XNATURE 00205 ! 00206 USE MODD_ISBA_n, ONLY : XFFLOOD,XPIFLOOD,XTSTEP_COUPLING 00207 ! 00208 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00209 USE PARKIND1 ,ONLY : JPRB 00210 ! 00211 IMPLICIT NONE 00212 ! 00213 !* declarations of arguments 00214 ! 00215 REAL, DIMENSION(:), INTENT(IN) :: PFFLOOD 00216 REAL, DIMENSION(:), INTENT(IN) :: PPIFLOOD 00217 ! 00218 REAL, INTENT(IN), OPTIONAL :: PTSTEP 00219 ! 00220 INTEGER :: II, JI, INATURE 00221 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00222 ! 00223 !* declarations of local variables 00224 ! 00225 !* procedure 00226 ! 00227 ! Initialize 00228 ! 00229 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:PUT_COUPLING_VAR_SFX_n',0,ZHOOK_HANDLE) 00230 IF(PRESENT(PTSTEP)) XTSTEP_COUPLING = PTSTEP 00231 ! 00232 INATURE=SIZE(XFFLOOD) 00233 ! 00234 ! Get variable over global field to nature tile kg -> kg/m²/s 00235 ! 00236 DO JI=1,INATURE 00237 II = NR_NATURE(JI) 00238 XFFLOOD (JI) = PFFLOOD (II) * XNATURE(II) 00239 XPIFLOOD(JI) = PPIFLOOD(II) /(XTSTEP_COUPLING*XMESH_SIZE(II)*XNATURE(II)) 00240 ENDDO 00241 ! 00242 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_VAR_SFX_TRIP:PUT_COUPLING_VAR_SFX_n',1,ZHOOK_HANDLE) 00243 END SUBROUTINE PUT_COUPLING_VAR_SFX_n 00244 ! 00245 !------------------------------------------------------------------------------- 00246 ! 00247 END MODULE MODE_COUPLING_VAR_SFX_TRIP
1.8.0
