Changeset 3395 for LMDZ6/trunk
- Timestamp:
- Sep 25, 2018, 5:22:13 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/surf_ocean_mod.F90
r3389 r3395 7 7 8 8 CONTAINS 9 !10 !******************************************************************************11 !9 ! 10 !****************************************************************************** 11 ! 12 12 SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, & 13 13 windsp, rmu0, fder, tsurf_in, & … … 22 22 flux_u1, flux_v1) 23 23 24 use albedo, only: alboc, alboc_cd25 USE dimphy, ONLY: klon, zmasq26 USE surface_data, ONLY : type_ocean27 USE ocean_forced_mod, ONLY : ocean_forced_noice28 USE ocean_slab_mod, ONLY : ocean_slab_noice29 USE ocean_cpl_mod, ONLY : ocean_cpl_noice30 USE indice_sol_mod, ONLY : nbsrf, is_oce31 USE limit_read_mod32 !33 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,34 ! slab or couple). The calculations of albedo and rugosity for the ocean surface are35 ! done in here because they are identical for the different modes of ocean.24 use albedo, only: alboc, alboc_cd 25 USE dimphy, ONLY: klon, zmasq 26 USE surface_data, ONLY : type_ocean 27 USE ocean_forced_mod, ONLY : ocean_forced_noice 28 USE ocean_slab_mod, ONLY : ocean_slab_noice 29 USE ocean_cpl_mod, ONLY : ocean_cpl_noice 30 USE indice_sol_mod, ONLY : nbsrf, is_oce 31 USE limit_read_mod 32 ! 33 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, 34 ! slab or couple). The calculations of albedo and rugosity for the ocean surface are 35 ! done in here because they are identical for the different modes of ocean. 36 36 37 37 … … 41 41 ! for cycle_diurne and for iflag_z0_oce==-1 (prescribed z0) 42 42 43 ! Input variables44 !******************************************************************************43 ! Input variables 44 !****************************************************************************** 45 45 INTEGER, INTENT(IN) :: itime, jour, knon 46 46 INTEGER, DIMENSION(klon), INTENT(IN) :: knindex … … 66 66 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf 67 67 68 ! In/Output variables69 !******************************************************************************68 ! In/Output variables 69 !****************************************************************************** 70 70 REAL, DIMENSION(klon), INTENT(INOUT) :: snow 71 71 REAL, DIMENSION(klon), INTENT(INOUT) :: qsurf … … 73 73 REAL, DIMENSION(klon), INTENT(inOUT):: z0h 74 74 75 ! Output variables76 !******************************************************************************75 ! Output variables 76 !****************************************************************************** 77 77 REAL, DIMENSION(klon), INTENT(OUT) :: z0m 78 !albedo SB >>>79 ! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval80 ! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval78 !albedo SB >>> 79 ! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval 80 ! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval 81 81 REAL, DIMENSION(6), INTENT(IN) :: SFRWL 82 82 REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new 83 !albedo SB <<<83 !albedo SB <<< 84 84 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 85 85 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new … … 88 88 REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1 89 89 90 ! Local variables91 !******************************************************************************90 ! Local variables 91 !****************************************************************************** 92 92 INTEGER :: i, k 93 93 REAL :: tmp … … 98 98 CHARACTER(len=20),PARAMETER :: modname="surf_ocean" 99 99 100 ! End definition101 !******************************************************************************102 103 104 !******************************************************************************105 ! Calculate total net radiance at surface106 !107 !******************************************************************************100 ! End definition 101 !****************************************************************************** 102 103 104 !****************************************************************************** 105 ! Calculate total net radiance at surface 106 ! 107 !****************************************************************************** 108 108 radsol(1:klon) = 0.0 ! initialisation a priori inutile 109 109 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 110 110 111 !******************************************************************************112 ! Cdragq computed from cdrag113 ! The difference comes only from a factor (f_z0qh_oce) on z0, so that114 ! it can be computed inside surf_ocean115 ! More complicated appraches may require the propagation through116 ! pbl_surface of an independant cdragq variable.117 !******************************************************************************111 !****************************************************************************** 112 ! Cdragq computed from cdrag 113 ! The difference comes only from a factor (f_z0qh_oce) on z0, so that 114 ! it can be computed inside surf_ocean 115 ! More complicated appraches may require the propagation through 116 ! pbl_surface of an independant cdragq variable. 117 !****************************************************************************** 118 118 119 119 IF ( f_z0qh_oce .ne. 1.) THEN 120 ! Si on suit les formulations par exemple de Tessel, on121 ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55120 ! Si on suit les formulations par exemple de Tessel, on 121 ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55 122 122 cdragq(1:knon)=cdragh(1:knon)* & 123 log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))123 log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon))) 124 124 ELSE 125 125 cdragq(1:knon)=cdragh(1:knon) … … 127 127 128 128 129 !******************************************************************************130 ! Switch according to type of ocean (couple, slab or forced)131 !******************************************************************************129 !****************************************************************************** 130 ! Switch according to type of ocean (couple, slab or forced) 131 !****************************************************************************** 132 132 SELECT CASE(type_ocean) 133 133 CASE('couple') … … 154 154 qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 155 155 tsurf_new, dflux_s, dflux_l, lmt_bils) 156 156 157 157 CASE('force') 158 158 CALL ocean_forced_noice( & … … 168 168 END SELECT 169 169 170 !******************************************************************************171 ! fcodron: compute lmt_bils forced case (same as wfbils_oce / 1.-contfracatm)172 !******************************************************************************170 !****************************************************************************** 171 ! fcodron: compute lmt_bils forced case (same as wfbils_oce / 1.-contfracatm) 172 !****************************************************************************** 173 173 IF (type_ocean.NE.'slab') THEN 174 175 176 177 *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))178 174 lmt_bils(1:klon)=0. 175 DO i=1,knon 176 lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) & 177 *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i))) 178 END DO 179 179 END IF 180 180 181 !****************************************************************************** 182 ! Calculate ocean surface albedo 183 !****************************************************************************** 184 !albedo SB >>> 185 IF (iflag_albedo==0) THEN 186 !--old parametrizations of ocean surface albedo 187 ! 188 IF (iflag_cycle_diurne.GE.1) THEN 189 ! 190 CALL alboc_cd(rmu0,alb_eau) 191 ! 192 !--ad-hoc correction for model radiative balance tuning 193 !--now outside alboc_cd routine 194 alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic 195 alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0) 196 ! 181 !****************************************************************************** 182 ! Calculate ocean surface albedo 183 !****************************************************************************** 184 !albedo SB >>> 185 IF (iflag_albedo==0) THEN 186 !--old parametrizations of ocean surface albedo 187 ! 188 IF (iflag_cycle_diurne.GE.1) THEN 189 ! 190 CALL alboc_cd(rmu0,alb_eau) 191 ! 192 !--ad-hoc correction for model radiative balance tuning 193 !--now outside alboc_cd routine 194 alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic 195 alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0) 196 ! 197 ELSE 198 ! 199 CALL alboc(REAL(jour),rlat,alb_eau) 200 !--ad-hoc correction for model radiative balance tuning 201 !--now outside alboc routine 202 alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic 203 alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60) 204 ! 205 ENDIF 206 ! 207 DO i =1, knon 208 DO k=1,nsw 209 alb_dir_new(i,k) = alb_eau(knindex(i)) 210 ENDDO 211 ENDDO 212 !IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions 213 !albedo for diffuse radiation is taken the same as for direct radiation 214 alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:) 215 !IM 09122015 end 216 ! 217 ELSE IF (iflag_albedo==1) THEN 218 !--new parametrization of ocean surface albedo by Sunghye Baek 219 !--albedo for direct and diffuse radiation are different 220 ! 221 CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new) 222 ! 223 !--ad-hoc correction for model radiative balance tuning 224 alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic 225 alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic 226 alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0) 227 alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0) 228 ! 229 ELSE IF (iflag_albedo==2) THEN 230 ! F. Codron albedo read from limit.nc 231 CALL limit_read_rug_alb(itime, dtime, jour,& 232 knon, knindex, z0_lim, alb_eau) 233 DO i =1, knon 234 DO k=1,nsw 235 alb_dir_new(i,k) = alb_eau(i) 236 ENDDO 237 ENDDO 238 alb_dif_new=alb_dir_new 239 ENDIF 240 !albedo SB <<< 241 242 !****************************************************************************** 243 ! Calculate the rugosity 244 !****************************************************************************** 245 IF (iflag_z0_oce==0) THEN 246 DO i = 1, knon 247 tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2) 248 z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG & 249 + 0.11*14e-6 / SQRT(cdragm(i) * tmp) 250 z0m(i) = MAX(1.5e-05,z0m(i)) 251 ENDDO 252 z0h(1:knon)=z0m(1:knon) ! En attendant mieux 253 254 ELSE IF (iflag_z0_oce==1) THEN 255 DO i = 1, knon 256 tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2) 257 z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG & 258 + 0.11*14e-6 / SQRT(cdragm(i) * tmp) 259 z0m(i) = MAX(1.5e-05,z0m(i)) 260 z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp) 261 ENDDO 262 ELSE IF (iflag_z0_oce==-1) THEN 263 DO i = 1, knon 264 z0m(i) = z0min 265 z0h(i) = z0min 266 ENDDO 197 267 ELSE 198 ! 199 CALL alboc(REAL(jour),rlat,alb_eau) 200 !--ad-hoc correction for model radiative balance tuning 201 !--now outside alboc routine 202 alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic 203 alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60) 204 ! 268 CALL abort_physic(modname,'version non prevue',1) 205 269 ENDIF 206 ! 207 DO i =1, knon 208 DO k=1,nsw 209 alb_dir_new(i,k) = alb_eau(knindex(i)) 210 ENDDO 211 ENDDO 212 !IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions 213 !albedo for diffuse radiation is taken the same as for direct radiation 214 alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:) 215 !IM 09122015 end 216 ! 217 ELSE IF (iflag_albedo==1) THEN 218 !--new parametrization of ocean surface albedo by Sunghye Baek 219 !--albedo for direct and diffuse radiation are different 220 ! 221 CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new) 222 ! 223 !--ad-hoc correction for model radiative balance tuning 224 alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic 225 alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic 226 alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0) 227 alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0) 228 ! 229 ! F. Codron albedo read from limit.nc 230 ELSE IF (iflag_albedo==2) THEN 231 CALL limit_read_rug_alb(itime, dtime, jour,& 232 knon, knindex, z0_lim, alb_eau) 233 DO i =1, knon 234 DO k=1,nsw 235 alb_dir_new(i,k) = alb_eau(i) 236 ENDDO 237 ENDDO 238 alb_dif_new=alb_dir_new 239 ENDIF 240 !albedo SB <<< 241 242 !****************************************************************************** 243 ! Calculate the rugosity 244 !****************************************************************************** 245 IF (iflag_z0_oce==0) THEN 246 DO i = 1, knon 247 tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2) 248 z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG & 249 + 0.11*14e-6 / SQRT(cdragm(i) * tmp) 250 z0m(i) = MAX(1.5e-05,z0m(i)) 251 ENDDO 252 z0h(1:knon)=z0m(1:knon) ! En attendant mieux 253 254 ELSE IF (iflag_z0_oce==1) THEN 255 DO i = 1, knon 256 tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2) 257 z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG & 258 + 0.11*14e-6 / SQRT(cdragm(i) * tmp) 259 z0m(i) = MAX(1.5e-05,z0m(i)) 260 z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp) 261 ENDDO 262 ELSE IF (iflag_z0_oce==-1) THEN 263 DO i = 1, knon 264 z0m(i) = z0min 265 z0h(i) = z0min 266 ENDDO 267 ELSE 268 CALL abort_physic(modname,'version non prevue',1) 269 ENDIF 270 ! 271 !****************************************************************************** 270 ! 271 !****************************************************************************** 272 272 END SUBROUTINE surf_ocean 273 !******************************************************************************274 !273 !****************************************************************************** 274 ! 275 275 END MODULE surf_ocean_mod
Note: See TracChangeset
for help on using the changeset viewer.