Changeset 157

Timestamp:

Nov 10, 2000, 11:49:09 AM (24 years ago)

Author:

lmdzadmin

Message:

Passage de rugos pour l'affectation de z0_new pour l'ocean et la glace
Initialisations de variables locales
correction d'un bug sur alb_neig
correction d'un bug sur le test a la negativite des pourcentages de surfaces
ocean lues (pctsrf_sav) et rajout d'un test pour rattraper des erreurs d'arrondis
LF

File:

• LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90 (modified) (14 diffs)

LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

@@ -54 +54 @@
       & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
       & precip_rain, precip_snow, lwdown, swnet, swdown, &
-      & fder, taux, tauy, &
+      & fder, taux, tauy, rugos, &
       & albedo, snow, qsol, &
       & tsurf, p1lay, ps, radsol, &
@@ -113 +113 @@
 !   fder         derivee des flux (pour le couplage)
 !   taux, tauy   tension de vents
+!   rugos        rugosite
 !   zmasq        masque terre/ocean
 !
@@ -151 +152 @@
   real, dimension(klon), intent(IN) :: radsol
   real, dimension(klon), intent(IN) :: zmasq
-  real, dimension(klon), intent(IN) :: fder, taux, tauy
+  real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos
   character (len = 6)  :: ocean
   integer              :: npas, nexca ! nombre et pas de temps couplage
@@ -175 +176 @@
   real, dimension(klon):: alb_ice
   real, dimension(klon):: tsurf_temp
-  real, dimension(klon):: alb_neig_grid, alb_eau
-  real, dimension(klon):: alb_neig
+  real, allocatable, dimension(:), save :: alb_neig_grid
+  real, dimension(klon):: alb_neig, alb_eau
   real, DIMENSION(klon):: zfra
 
@@ -206 +207 @@
       call abort_gcm(modname,abort_message,1)
     endif
+    allocate(alb_neig_grid(klon), stat = error)
+    if (error /= 0) then
+      abort_message='Pb allocation alb_neig_grid'
+      call abort_gcm(modname,abort_message,1)
+    endif
   endif
   first_call = .false.
   
+! Initialisations diverses
+!
+  cal=0.; beta=1.; dif_grnd=0.; capsol=0.
+  alb_new = 0.; z0_new = 0.; alb_neig = 0.0
+
 ! Aiguillage vers les differents schemas de surface
 
@@ -232 +243 @@
       endif
     endif
+    run_off = 0.
 !
 ! Calcul age de la neige
@@ -245 +257 @@
 !
       call calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
+!      if (check) write(*,*)'Sortie calbeta'
+!      if (check) write(*,*)'RCPD = ',RCPD,' capsol = '
+!      if (check) write(*,*)capsol
       cal = RCPD * capsol
       call calcul_fluxs( klon, knon, nisurf, dtime, &
@@ -340 +355 @@
       alb_new(ii) = alb_eau(knindex(ii))
     enddo
+
+    z0_new = rugos
 !
   else if (nisurf == is_sic) then
@@ -388 +405 @@
 ! calcul albedo
 !
-       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
-       DO ii = 1, knon
-         alb_neig = alb_neig_grid(knindex(ii))
-       enddo
-       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
+    zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
+    DO ii = 1, knon
+      alb_neig(ii) = alb_neig_grid(knindex(ii))
+    enddo
+    alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
+
+    z0_new = rugos
 
   else if (nisurf == is_lic) then
@@ -418 +437 @@
 ! calcul albedo
 !
-       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
-       DO ii =1, knon
-         alb_neig = alb_neig_grid(knindex(ii))
-       enddo
-       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
+    zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
+    DO ii = 1, knon
+      alb_neig(ii) = alb_neig_grid(knindex(ii))
+    enddo
+    alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
+!
+! Rugosite
+!
+    z0_new = rugos
 !
 ! Remplissage des pourcentages de surface
@@ -839 +862 @@
   endif ! fin if (first_appel)
 
-! fichier restart et fichiers histoires
+! Initialisations
+  alb_ice= 0.0
 
 ! calcul des fluxs a passer
@@ -902 +926 @@
 ! transformer read_sic en pctsrf_sav
 !
-    call cpl2gath(read_sic, tamp_sic , klon, klon,iim,jjm, unity)
-    do ig = 1, klon
-      IF (pctsrf(ig,is_oce) > epsfra .OR.            &
+      call cpl2gath(read_sic, tamp_sic , klon, klon,iim,jjm, unity)
+      do ig = 1, klon
+        IF (pctsrf(ig,is_oce) > epsfra .OR.            &
      &             pctsrf(ig,is_sic) > epsfra) THEN
           pctsrf_sav(ig,is_sic) = (pctsrf(ig,is_oce) + pctsrf(ig,is_sic)) &
@@ -912 +936 @@
         endif
       enddo
+!
+! Pour rattraper des erreurs d'arrondis
+!
+      where (abs(pctsrf_sav(:,is_sic)) .le. epsilon(pctsrf_sav(1,is_sic)))
+        pctsrf_sav(:,is_sic) = 0.
+        pctsrf_sav(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
+      endwhere
+      where (abs(pctsrf_sav(:,is_oce)) .le. epsilon(pctsrf_sav(1,is_sic)))
+        pctsrf_sav(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
+        pctsrf_sav(:,is_oce) = 0.
+      endwhere
       if (check) then
         write(46,*)'pct_srf_sav_ice = '
         write(46,'(72f8.3)')pctsrf_sav(:,is_sic)
       endif
-      if (minval(pctsrf_new(:,is_oce)) < 0.) then
+      if (minval(pctsrf_sav(:,is_oce)) < 0.) then
         write(*,*)'Pb fraction ocean inferieure a 0'
-        write(*,*)'au point ',minloc(pctsrf_new(:,is_oce))
-        write(*,*)'valeur = ',minval(pctsrf_new(:,is_oce)) 
+        write(*,*)'au point ',minloc(pctsrf_sav(:,is_oce))
+        write(*,*)'valeur = ',minval(pctsrf_sav(:,is_oce)) 
         abort_message = 'voir ci-dessus'
         call abort_gcm(modname,abort_message,1)
       endif
-      if (minval(pctsrf_new(:,is_sic)) < 0.) then
+      if (minval(pctsrf_sav(:,is_sic)) < 0.) then
         write(*,*)'Pb fraction glace inferieure a 0'
-        write(*,*)'au point ',minloc(pctsrf_new(:,is_sic))
-        write(*,*)'valeur = ',minval(pctsrf_new(:,is_sic)) 
+        write(*,*)'au point ',minloc(pctsrf_sav(:,is_sic))
+        write(*,*)'valeur = ',minval(pctsrf_sav(:,is_sic)) 
         abort_message = 'voir ci-dessus'
         call abort_gcm(modname,abort_message,1)
@@ -1535 +1570 @@
   real, dimension(klon) :: zx_mq, zx_nq, zx_oq
   real, dimension(klon) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
-  real, dimension(klon) :: zx_sl, zx_k1,  zx_dq,  zx_cq,  zx_dh, zx_ch
+  real, dimension(klon) :: zx_sl, zx_k1
   real, dimension(klon) :: zx_h_ts, zx_q_0 , d_ts
   real                  :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
   real                  :: bilan_f, fq_fonte
   real, parameter :: t_grnd = 271.35, t_coup = 273.15
-  logical         :: check = .false.
+  logical         :: check = .true.
   character (len = 20)  :: modname = 'calcul_fluxs'
   logical         :: fonte_neige = .false.