Changeset 157 for LMDZ.3.3/branches/rel-LF
- Timestamp:
- Nov 10, 2000, 11:49:09 AM (24 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
r147 r157 54 54 & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 55 55 & precip_rain, precip_snow, lwdown, swnet, swdown, & 56 & fder, taux, tauy, &56 & fder, taux, tauy, rugos, & 57 57 & albedo, snow, qsol, & 58 58 & tsurf, p1lay, ps, radsol, & … … 113 113 ! fder derivee des flux (pour le couplage) 114 114 ! taux, tauy tension de vents 115 ! rugos rugosite 115 116 ! zmasq masque terre/ocean 116 117 ! … … 151 152 real, dimension(klon), intent(IN) :: radsol 152 153 real, dimension(klon), intent(IN) :: zmasq 153 real, dimension(klon), intent(IN) :: fder, taux, tauy 154 real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos 154 155 character (len = 6) :: ocean 155 156 integer :: npas, nexca ! nombre et pas de temps couplage … … 175 176 real, dimension(klon):: alb_ice 176 177 real, dimension(klon):: tsurf_temp 177 real, dimension(klon):: alb_neig_grid, alb_eau178 real, dimension(klon):: alb_neig 178 real, allocatable, dimension(:), save :: alb_neig_grid 179 real, dimension(klon):: alb_neig, alb_eau 179 180 real, DIMENSION(klon):: zfra 180 181 … … 206 207 call abort_gcm(modname,abort_message,1) 207 208 endif 209 allocate(alb_neig_grid(klon), stat = error) 210 if (error /= 0) then 211 abort_message='Pb allocation alb_neig_grid' 212 call abort_gcm(modname,abort_message,1) 213 endif 208 214 endif 209 215 first_call = .false. 210 216 217 ! Initialisations diverses 218 ! 219 cal=0.; beta=1.; dif_grnd=0.; capsol=0. 220 alb_new = 0.; z0_new = 0.; alb_neig = 0.0 221 211 222 ! Aiguillage vers les differents schemas de surface 212 223 … … 232 243 endif 233 244 endif 245 run_off = 0. 234 246 ! 235 247 ! Calcul age de la neige … … 245 257 ! 246 258 call calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd) 259 ! if (check) write(*,*)'Sortie calbeta' 260 ! if (check) write(*,*)'RCPD = ',RCPD,' capsol = ' 261 ! if (check) write(*,*)capsol 247 262 cal = RCPD * capsol 248 263 call calcul_fluxs( klon, knon, nisurf, dtime, & … … 340 355 alb_new(ii) = alb_eau(knindex(ii)) 341 356 enddo 357 358 z0_new = rugos 342 359 ! 343 360 else if (nisurf == is_sic) then … … 388 405 ! calcul albedo 389 406 ! 390 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 391 DO ii = 1, knon 392 alb_neig = alb_neig_grid(knindex(ii)) 393 enddo 394 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 407 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 408 DO ii = 1, knon 409 alb_neig(ii) = alb_neig_grid(knindex(ii)) 410 enddo 411 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 412 413 z0_new = rugos 395 414 396 415 else if (nisurf == is_lic) then … … 418 437 ! calcul albedo 419 438 ! 420 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 421 DO ii =1, knon 422 alb_neig = alb_neig_grid(knindex(ii)) 423 enddo 424 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 439 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 440 DO ii = 1, knon 441 alb_neig(ii) = alb_neig_grid(knindex(ii)) 442 enddo 443 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 444 ! 445 ! Rugosite 446 ! 447 z0_new = rugos 425 448 ! 426 449 ! Remplissage des pourcentages de surface … … 839 862 endif ! fin if (first_appel) 840 863 841 ! fichier restart et fichiers histoires 864 ! Initialisations 865 alb_ice= 0.0 842 866 843 867 ! calcul des fluxs a passer … … 902 926 ! transformer read_sic en pctsrf_sav 903 927 ! 904 call cpl2gath(read_sic, tamp_sic , klon, klon,iim,jjm, unity)905 do ig = 1, klon906 IF (pctsrf(ig,is_oce) > epsfra .OR. &928 call cpl2gath(read_sic, tamp_sic , klon, klon,iim,jjm, unity) 929 do ig = 1, klon 930 IF (pctsrf(ig,is_oce) > epsfra .OR. & 907 931 & pctsrf(ig,is_sic) > epsfra) THEN 908 932 pctsrf_sav(ig,is_sic) = (pctsrf(ig,is_oce) + pctsrf(ig,is_sic)) & … … 912 936 endif 913 937 enddo 938 ! 939 ! Pour rattraper des erreurs d'arrondis 940 ! 941 where (abs(pctsrf_sav(:,is_sic)) .le. epsilon(pctsrf_sav(1,is_sic))) 942 pctsrf_sav(:,is_sic) = 0. 943 pctsrf_sav(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic) 944 endwhere 945 where (abs(pctsrf_sav(:,is_oce)) .le. epsilon(pctsrf_sav(1,is_sic))) 946 pctsrf_sav(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic) 947 pctsrf_sav(:,is_oce) = 0. 948 endwhere 914 949 if (check) then 915 950 write(46,*)'pct_srf_sav_ice = ' 916 951 write(46,'(72f8.3)')pctsrf_sav(:,is_sic) 917 952 endif 918 if (minval(pctsrf_ new(:,is_oce)) < 0.) then953 if (minval(pctsrf_sav(:,is_oce)) < 0.) then 919 954 write(*,*)'Pb fraction ocean inferieure a 0' 920 write(*,*)'au point ',minloc(pctsrf_ new(:,is_oce))921 write(*,*)'valeur = ',minval(pctsrf_ new(:,is_oce))955 write(*,*)'au point ',minloc(pctsrf_sav(:,is_oce)) 956 write(*,*)'valeur = ',minval(pctsrf_sav(:,is_oce)) 922 957 abort_message = 'voir ci-dessus' 923 958 call abort_gcm(modname,abort_message,1) 924 959 endif 925 if (minval(pctsrf_ new(:,is_sic)) < 0.) then960 if (minval(pctsrf_sav(:,is_sic)) < 0.) then 926 961 write(*,*)'Pb fraction glace inferieure a 0' 927 write(*,*)'au point ',minloc(pctsrf_ new(:,is_sic))928 write(*,*)'valeur = ',minval(pctsrf_ new(:,is_sic))962 write(*,*)'au point ',minloc(pctsrf_sav(:,is_sic)) 963 write(*,*)'valeur = ',minval(pctsrf_sav(:,is_sic)) 929 964 abort_message = 'voir ci-dessus' 930 965 call abort_gcm(modname,abort_message,1) … … 1535 1570 real, dimension(klon) :: zx_mq, zx_nq, zx_oq 1536 1571 real, dimension(klon) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef 1537 real, dimension(klon) :: zx_sl, zx_k1 , zx_dq, zx_cq, zx_dh, zx_ch1572 real, dimension(klon) :: zx_sl, zx_k1 1538 1573 real, dimension(klon) :: zx_h_ts, zx_q_0 , d_ts 1539 1574 real :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh 1540 1575 real :: bilan_f, fq_fonte 1541 1576 real, parameter :: t_grnd = 271.35, t_coup = 273.15 1542 logical :: check = . false.1577 logical :: check = .true. 1543 1578 character (len = 20) :: modname = 'calcul_fluxs' 1544 1579 logical :: fonte_neige = .false.
Note: See TracChangeset
for help on using the changeset viewer.