Ignore:
Timestamp:
Jun 20, 2001, 6:10:52 PM (23 years ago)
Author:
lmdzadmin
Message:

Integration des modifs pour fder de Pasb
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r230 r235  
    282282      y_flux_u = 0.0
    283283      y_flux_v = 0.0
    284       ytsoil = 0.0
     284      ytsoil = 999999.
    285285
    286286      DO nsrf = 1, nbsrf
    … …  
    330330
    331331      DO 99999 nsrf = 1, nbsrf
    332 c$$$   PB   totalflu = radsol
     332       totalflu = radsol
    333333
    334334c chercher les indices:
    … …  
    384384        yu1(j) = u1lay(i)
    385385        yv1(j) = v1lay(i)
    386 c$$$    PB    yrads(j) = totalflu(i)
     386c$$$        yrads(j) = totalflu(i)
    387387        yrads(j) = (1 - albe(i,nsrf))
    388388     $      /(1 - pctsrf(i,is_ter) * albe(i,is_ter)
    … …  
    493493      evap(:,nsrf) = - flux_q(:,1,nsrf)
    494494c
     495      albe(:, nsrf) = 0.
     496      snow(:, nsrf) = 0.
     497      qsol(:, nsrf) = 0.
     498      rugos(:, nsrf) = 0.
     499      fluxlat(:,nsrf) = 0.
    495500      DO j = 1, knon
    496501         i = ni(j)
    … …  
    502507         fluxlat(i,nsrf) = yfluxlat(j)
    503508c$$$ pb         rugmer(i) = yrugm(j)
    504          IF (nsrf .EQ. is_oce) rugmer(i) = yrugm(j)
     509         IF (nsrf .EQ. is_oce) then
     510               rugmer(i) = yrugm(j)
     511               rugos(i,nsrf) = yrugm(i)
     512          endif
    505513         cdragh(i) = cdragh(i) + ycoefh(j,1)
    506514         cdragm(i) = cdragm(i) + ycoefm(j,1)
    … …  
    511519      END DO
    512520c$$$ PB ajout pour soil
     521      ftsoil(:,:,nsrf) = 0.
    513522      DO k = 1, nsoilmx
    514523        DO j = 1, knon

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/conf_phys.F90

    r223 r235  
    33!
    44
    5 !module conf_phys
    6 !
    7 !  use IOIPSL
    8 !  implicit none
    9 !
    10 !  public conf_phys
    11 !
    12 !contains
     5  subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan)
    136
    14   subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan)
     7   use IOIPSL
     8   implicit none
    159
    1610!
    … …  
    2115!
    2216
    23   use IOIPSL     
    24   implicit none
    2517!
    2618! ocean:      type d'ocean (force, slab, couple)
    … …  
    10496  end subroutine conf_phys
    10597
    106 !end module conf_phys

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

    r233 r235  
    159159  real, dimension(klon), intent(IN) :: ps, albedo
    160160  real, dimension(klon), intent(IN) :: tsurf, p1lay
    161   real, dimension(klon), intent(INOUT) :: radsol
     161  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol,fder
    162162  real, dimension(klon), intent(IN) :: zmasq
    163   real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos, rugoro
     163  real, dimension(klon), intent(IN) :: taux, tauy, rugos, rugoro
    164164  character (len = 6)  :: ocean
    165165  integer              :: npas, nexca ! nombre et pas de temps couplage
    … …  
    196196  real, DIMENSION(klon):: zfra
    197197  logical              :: cumul = .false.
    198   logical,save         :: scatter = .false.
    199198
    200199  if (check) write(*,*) 'Entree ', modname
    … …  
    235234! Initialisations diverses
    236235!
    237   cal=0.; beta=1.; dif_grnd=0.; capsol=0.
    238   alb_new = 0.; z0_new = 0.; alb_neig = 0.0
    239 
     236!!$  cal=0.; beta=1.; dif_grnd=0.; capsol=0.
     237!!$  alb_new = 0.; z0_new = 0.; alb_neig = 0.0
     238!!$! PB
     239!!$  tsurf_new = 0.
     240
     241  cal = 999999. ; beta = 999999. ; dif_grnd = 999999. ; capsol = 999999.
     242  alb_new = 999999. ; z0_new = 999999. ; alb_neig = 999999.
     243  tsurf_new = 999999.
    240244! Aiguillage vers les differents schemas de surface
    241245
    … …  
    290294!
    291295!!$ PB ATTENTION changement ordre des appels
    292 !!$   CALL albsno(klon,agesno,alb_neig_grid) 
    293  
    294  
     296    CALL albsno(klon,agesno,alb_neig_grid) 
     297
    295298    if (.not. ok_veget) then
    296299!
    … …  
    410413     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    411414     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     415   
     416    fder = fder + dflux_s + dflux_l
    412417
    413418!
    … …  
    472477!    else if (ocean == 'slab  ') then
    473478!      call interfoce(nisurf)
    474     else                              ! lecture conditions limites
    475       call interfoce(itime, dtime, jour, &
    476      &  klon, nisurf, knon, knindex, &
    477      &  debut, &
    478      &  tsurf_new, pctsrf_new)
    479 
    480       tsurf_temp = tsurf
    481            dif_grnd = 1.0 / tau_gl
    482            beta = 1.0
    483            cal = RCPD * calice
    484            WHERE (snow > 0.0) cal = RCPD * calsno
    485     endif
    486 
    487     call calcul_fluxs( klon, knon, nisurf, dtime, &
    488      &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
    489      &   precip_rain, precip_snow, snow, qsol,  &
    490      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    491      &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    492      &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    493 
    494     if (ocean /= 'couple') then
    495       call fonte_neige( klon, knon, nisurf, dtime, &
    496      &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
    497      &   precip_rain, precip_snow, snow, qsol,  &
    498      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    499      &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    500      &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    501     endif
     479      ELSE
     480!                              ! lecture conditions limites
     481          CALL interfoce(itime, dtime, jour, &
     482             &  klon, nisurf, knon, knindex, &
     483             &  debut, &
     484             &  tsurf_new, pctsrf_new)
     485
     486          CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
     487     
     488          IF (soil_model) THEN
     489              CALL soil(dtime, nisurf, knon,snow, tsurf, tsoil,soilcap, soilflux)
     490              cal(1:knon) = RCPD / soilcap(1:knon)
     491              radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
     492              dif_grnd = 0.
     493!!$           WRITE(*,*) 'radsol'
     494!!$           WRITE(*,*) radsol(1 : knon)
     495!!$           WRITE(*,*) 'soilflux'
     496!!$           WRITE(*,*) soilflux(1 : knon)
     497          ELSE
     498!      if (check) write(*,*)'Sortie calbeta'
     499!      if (check) write(*,*)'RCPD = ',RCPD,' capsol = '
     500!      if (check) write(*,*)capsol
     501              dif_grnd = 1.0 / tau_gl
     502              cal = RCPD * calice
     503              WHERE (snow > 0.0) cal = RCPD * calsno
     504          ENDIF
     505          tsurf_temp = tsurf
     506          beta = 1.0
     507      ENDIF
     508
     509      CALL calcul_fluxs( klon, knon, nisurf, dtime, &
     510         &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
     511         &   precip_rain, precip_snow, snow, qsol,  &
     512         &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
     513         &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
     514         &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     515
     516      IF (ocean /= 'couple') THEN
     517          CALL fonte_neige( klon, knon, nisurf, dtime, &
     518             &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
     519             &   precip_rain, precip_snow, snow, qsol,  &
     520             &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
     521             &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
     522             &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     523      ENDIF
    502524!
    503525! 2eme appel a interfoce pour le cumul et le passage des flux a l'ocean
    … …  
    539561!    call interfsol(nisurf)
    540562    IF (soil_model) THEN
    541         CALL soil(dtime, nisurf, snow, tsurf, tsoil,soilcap, soilflux)
    542         cal = RCPD / soilcap
    543         radsol = radsol + soilflux
     563        CALL soil(dtime, nisurf, knon, snow, tsurf, tsoil,soilcap, soilflux)
     564        cal(1:knon) = RCPD / soilcap(1:knon)
     565        radsol(1:knon)  = radsol(1:knon) + soilflux(1:knon)
     566!!$           WRITE(*,*) 'radsol'
     567!!$           WRITE(*,'(16f17.4)') radsol(1 : knon)
     568!!$           WRITE(*,*) 'soilflux'
     569!!$           WRITE(*,'(16f17.4)')soilflux(1:knon)
    544570    ELSE
    545571        cal = RCPD * calice
    … …  
    962988
    963989  END SUBROUTINE interfsol
    964 !
    965 !#########################################################################
    966 !
    967   SUBROUTINE interfsol_scat(itime, klon, dtime, date0, nisurf, knon, &
    968      & knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
    969      & debut, lafin, ok_veget, &
    970      & zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
    971      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    972      & precip_rain, precip_snow, lwdown, swnet, swdown, &
    973      & tsurf, p1lay, ps, radsol, &
    974      & evap, fluxsens, fluxlat, &             
    975      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
    976 
    977   USE intersurf
    978 
    979 ! Cette routine sert d'interface entre le modele atmospherique et le
    980 ! modele de sol continental. Appel a sechiba
    981 !
    982 ! L. Fairhead 02/2000
    983 !
    984 ! input:
    985 !   itime        numero du pas de temps
    986 !   klon         nombre total de points de grille
    987 !   dtime        pas de temps de la physique (en s)
    988 !   nisurf       index de la surface a traiter (1 = sol continental)
    989 !   knon         nombre de points de la surface a traiter
    990 !   knindex      index des points de la surface a traiter
    991 !   rlon         longitudes de la grille entiere
    992 !   rlat         latitudes de la grille entiere
    993 !   pctsrf       tableau des fractions de surface de chaque maille
    994 !   debut        logical: 1er appel a la physique (lire les restart)
    995 !   lafin        logical: dernier appel a la physique (ecrire les restart)
    996 !   ok_veget     logical: appel ou non au schema de surface continental
    997 !                     (si false calcul simplifie des fluxs sur les continents)
    998 !   zlev         hauteur de la premiere couche       
    999 !   u1_lay       vitesse u 1ere couche
    1000 !   v1_lay       vitesse v 1ere couche
    1001 !   temp_air     temperature de l'air 1ere couche
    1002 !   spechum      humidite specifique 1ere couche
    1003 !   epot_air     temp pot de l'air
    1004 !   ccanopy      concentration CO2 canopee
    1005 !   tq_cdrag     cdrag
    1006 !   petAcoef     coeff. A de la resolution de la CL pour t
    1007 !   peqAcoef     coeff. A de la resolution de la CL pour q
    1008 !   petBcoef     coeff. B de la resolution de la CL pour t
    1009 !   peqBcoef     coeff. B de la resolution de la CL pour q
    1010 !   precip_rain  precipitation liquide
    1011 !   precip_snow  precipitation solide
    1012 !   lwdown       flux IR descendant a la surface
    1013 !   swnet        flux solaire net
    1014 !   swdown       flux solaire entrant a la surface
    1015 !   tsurf        temperature de surface
    1016 !   p1lay        pression 1er niveau (milieu de couche)
    1017 !   ps           pression au sol
    1018 !   radsol       rayonnement net aus sol (LW + SW)
    1019 !   
    1020 !
    1021 ! input/output
    1022 !   run_off      ruissellement total
    1023 !
    1024 ! output:
    1025 !   evap         evaporation totale
    1026 !   fluxsens     flux de chaleur sensible
    1027 !   fluxlat      flux de chaleur latente
    1028 !   tsol_rad     
    1029 !   tsurf_new    temperature au sol
    1030 !   alb_new      albedo
    1031 !   emis_new     emissivite
    1032 !   z0_new       surface roughness
    1033 
    1034 
    1035 ! Parametres d'entree
    1036   integer, intent(IN) :: itime
    1037   integer, intent(IN) :: klon
    1038   real, intent(IN)    :: dtime
    1039   real, intent(IN)    :: date0
    1040   integer, intent(IN) :: nisurf
    1041   integer, intent(IN) :: knon
    1042   integer, intent(IN) :: iim, jjm
    1043   integer, dimension(klon), intent(IN) :: knindex
    1044   logical, intent(IN) :: debut, lafin, ok_veget
    1045   real, dimension(klon,nbsrf), intent(IN) :: pctsrf
    1046   real, dimension(klon), intent(IN) :: rlon, rlat
    1047   real, dimension(klon), intent(IN) :: cufi, cvfi
    1048   real, dimension(klon), intent(IN) :: zlev
    1049   real, dimension(klon), intent(IN) :: u1_lay, v1_lay
    1050   real, dimension(klon), intent(IN) :: temp_air, spechum
    1051   real, dimension(klon), intent(IN) :: epot_air, ccanopy
    1052   real, dimension(klon), intent(INOUT) :: tq_cdrag
    1053   real, dimension(klon), intent(IN) :: petAcoef, peqAcoef
    1054   real, dimension(klon), intent(IN) :: petBcoef, peqBcoef
    1055   real, dimension(klon), intent(IN) :: precip_rain, precip_snow
    1056   real, dimension(klon), intent(IN) :: lwdown, swnet, swdown, ps
    1057   real, dimension(klon), intent(IN) :: tsurf, p1lay
    1058   real, dimension(klon), intent(IN) :: radsol
    1059 ! Parametres de sortie
    1060   real, dimension(klon), intent(OUT):: evap, fluxsens, fluxlat
    1061   real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
    1062   real, dimension(klon), intent(OUT):: emis_new, z0_new
    1063   real, dimension(klon), intent(OUT):: dflux_s, dflux_l
    1064 
    1065 ! Local
    1066 !
    1067   integer              :: ii, ij, jj, igrid, ireal, i, index
    1068   integer              :: error
    1069   character (len = 20) :: modname = 'interfsol_scat'
    1070   character (len = 80) :: abort_message
    1071   logical,save              :: check = .TRUE.
    1072   real, dimension(klon) :: cal, beta, dif_grnd, capsol
    1073 ! type de couplage dans sechiba
    1074 !  character (len=10)   :: coupling = 'implicit'
    1075 ! drapeaux controlant les appels dans SECHIBA
    1076 !  type(control_type), save   :: control_in
    1077 ! coordonnees geographiques
    1078   real, allocatable, dimension(:,:), save :: lalo
    1079 ! pts voisins
    1080   integer,allocatable, dimension(:,:), save :: neighbours
    1081 ! fractions continents
    1082   real,allocatable, dimension(:), save :: contfrac
    1083 ! resolution de la grille
    1084   real, allocatable, dimension (:,:), save :: resolution
    1085 ! correspondance point n -> indices (i,j)
    1086   integer, allocatable, dimension(:,:), save :: correspond
    1087 ! offset pour calculer les point voisins
    1088   integer, dimension(8,3), save :: off_ini
    1089   integer, dimension(8), save :: offset
    1090 ! Identifieurs des fichiers restart et histoire
    1091   integer, save          :: rest_id, hist_id
    1092   integer, save          :: rest_id_stom, hist_id_stom
    1093 !
    1094   real, allocatable, dimension (:,:), save :: lon_scat, lat_scat 
    1095 
    1096   logical, save           :: lrestart_read = .true. , lrestart_write = .false.
    1097 
    1098   real, dimension(klon):: qsurf
    1099   real, dimension(klon):: snow, qsol
    1100   real, dimension(knon,2) :: albedo_out
    1101 ! Pb de nomenclature
    1102   real, dimension(klon)      :: petA_orc, petB_orc, peqA_orc, peqB_orc
    1103 ! champs a passer a ORCHIDEE
    1104   real, dimension(:,:), allocatable, save :: lon_sc, lat_sc, contfrac_sc
    1105   real, dimension(iim,jjm+1) :: zlev_sc
    1106   real, dimension(iim,jjm+1) :: u1_lay_sc, v1_lay_sc, spechum_sc, temp_air_sc
    1107   real, dimension(iim,jjm+1) :: epot_air_sc, ccanopy_sc, tq_cdrag_sc
    1108   real, dimension(iim,jjm+1) :: petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc
    1109   real, dimension(iim,jjm+1) :: precip_rain_sc, precip_snow_sc, lwdown_sc
    1110   real, dimension(iim,jjm+1) :: swnet_sc, swdown_sc, p1lay_sc, evap_sc
    1111   real, dimension(iim,jjm+1) :: fluxsens_sc, fluxlat_sc, coastalflow_sc
    1112   real, dimension(iim,jjm+1) :: riverflow_sc, tsol_rad_sc, tsurf_new_sc
    1113   real, dimension(iim,jjm+1) :: qsurf_sc, emis_new_sc, z0_new_sc
    1114   real, dimension(iim,jjm+1,2) :: albedo_out_sc
    1115 
    1116   if (check) write(*,*)'Entree ', modname
    1117   if (check) write(*,*)'ok_veget = ',ok_veget
    1118 
    1119 ! initialisation
    1120   if (debut) then
    1121     if ((.not. allocated(lon_sc))) then
    1122       allocate(lon_sc(iim,jjm+1), stat = error)
    1123       if (error /= 0) then
    1124         abort_message='Pb allocation lon_sc'
    1125         call abort_gcm(modname,abort_message,1)
    1126       endif     
    1127     endif
    1128     if ((.not. allocated(lat_sc))) then
    1129       allocate(lat_sc(iim,jjm+1), stat = error)
    1130       if (error /= 0) then
    1131         abort_message='Pb allocation lat_sc'
    1132         call abort_gcm(modname,abort_message,1)
    1133       endif     
    1134     endif
    1135     index = 1
    1136     do jj = 2, jjm
    1137       do ij = 1, iim
    1138         index = index + 1
    1139         lon_sc(ij,jj) = rlon(index)
    1140         lat_sc(ij,jj) = rlat(index)
    1141       enddo
    1142     enddo
    1143     lon_sc(:,1) = lon_sc(:,2)
    1144     lat_sc(:,1) = rlat(1)
    1145     lon_sc(:,jjm+1) = lon_sc(:,jjm)
    1146     lat_sc(:,jjm+1) = rlat(klon)
    1147     if (( .not. allocated(contfrac_sc))) then
    1148       allocate(contfrac_sc(iim, jjm+1), stat = error)
    1149       if (error /= 0) then
    1150         abort_message='Pb allocation contfrac'
    1151         call abort_gcm(modname,abort_message,1)
    1152       endif     
    1153     endif
    1154     contfrac_sc = 0.
    1155     call gath2cpl(pctsrf(:,is_ter), contfrac_sc, klon, knon,iim,jjm, knindex)
    1156   endif                          ! (fin debut)
    1157 
    1158 !
    1159 ! Appel a la routine sols continentaux
    1160 !
    1161 ! petit pb de nomenclature
    1162 !
    1163   if (lafin) lrestart_write = .true.
    1164   if (check) write(*,*)'lafin ',lafin,lrestart_write
    1165 
    1166   petA_orc = petBcoef * dtime
    1167   petB_orc = petAcoef
    1168   peqA_orc = peqBcoef * dtime
    1169   peqB_orc = peqAcoef
    1170 
    1171 !
    1172 ! Passage sur la grille 2D avant envoi a ORCHIDEE
    1173 !
    1174   call gath2cpl(zlev, zlev_sc, klon, knon,iim,jjm, knindex)
    1175   call gath2cpl(u1_lay, u1_lay_sc, klon, knon,iim,jjm, knindex)
    1176   call gath2cpl(v1_lay, v1_lay_sc, klon, knon,iim,jjm, knindex)
    1177   call gath2cpl(spechum, spechum_sc, klon, knon,iim,jjm, knindex)
    1178   call gath2cpl(temp_air, temp_air_sc, klon, knon,iim,jjm, knindex)
    1179   call gath2cpl(epot_air, epot_air_sc, klon, knon,iim,jjm, knindex)
    1180   call gath2cpl(ccanopy, ccanopy_sc, klon, knon,iim,jjm, knindex)
    1181   call gath2cpl(tq_cdrag, tq_cdrag_sc, klon, knon,iim,jjm, knindex)
    1182   call gath2cpl(petA_orc, petA_or_sc, klon, knon,iim,jjm, knindex)
    1183   call gath2cpl(peqA_orc, peqA_or_sc, klon, knon,iim,jjm, knindex)
    1184   call gath2cpl(petB_orc, petB_or_sc, klon, knon,iim,jjm, knindex)
    1185   call gath2cpl(peqB_orc, peqB_or_sc, klon, knon,iim,jjm, knindex)
    1186   call gath2cpl(precip_rain, precip_rain_sc, klon, knon,iim,jjm, knindex)
    1187   call gath2cpl(precip_snow, precip_snow_sc, klon, knon,iim,jjm, knindex)
    1188   call gath2cpl(lwdown, lwdown_sc, klon, knon,iim,jjm, knindex)
    1189   call gath2cpl(swnet, swnet_sc, klon, knon,iim,jjm, knindex)
    1190   call gath2cpl(swdown, swdown_sc, klon, knon,iim,jjm, knindex)
    1191   call gath2cpl(p1lay, p1lay_sc, klon, knon,iim,jjm, knindex)
    1192 !
    1193 ! Init Orchidee
    1194 !
    1195   if (debut) then
    1196     if (check) write(*,*) 'debut orchidee itime - 1', itime-1,date0
    1197     call intersurf_main (itime-1, iim, jjm+1 , knon, knindex, dtime, &
    1198      & lrestart_read, lrestart_write, lon_sc, lat_sc, &
    1199      & contfrac_sc, date0, zlev_sc,  u1_lay_sc, v1_lay_sc, &
    1200      & spechum_sc, temp_air_sc, epot_air_sc, ccanopy_sc, &
    1201      & tq_cdrag_sc, petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc, &
    1202      & precip_rain_sc, precip_snow_sc, lwdown_sc, swnet_sc, &
    1203      & swdown_sc, p1lay_sc, &
    1204      & evap_sc, fluxsens_sc, fluxlat_sc, &
    1205      & coastalflow_sc, riverflow_sc, tsol_rad_sc, tsurf_new_sc, &
    1206      & qsurf_sc, albedo_out_sc, emis_new_sc, z0_new_sc)
    1207   endif
    1208 
    1209   call intersurf_main (itime, iim, jjm+1 , knon, knindex, dtime, &
    1210      & lrestart_read, lrestart_write, lon_sc, lat_sc, &
    1211      & contfrac_sc, date0, zlev_sc,  u1_lay_sc, v1_lay_sc, &
    1212      & spechum_sc, temp_air_sc, epot_air_sc, ccanopy_sc, &
    1213      & tq_cdrag_sc, petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc, &
    1214      & precip_rain_sc, precip_snow_sc, lwdown_sc, swnet_sc, &
    1215      & swdown_sc, p1lay_sc, &
    1216      & evap_sc, fluxsens_sc, fluxlat_sc, &
    1217      & coastalflow_sc, riverflow_sc, tsol_rad_sc, tsurf_new_sc, &
    1218      & qsurf_sc, albedo_out_sc, emis_new_sc, z0_new_sc)
    1219 !
    1220 ! sorties mises sur la grille physique
    1221 !
    1222 
    1223   call cpl2gath(evap_sc, evap, klon, knon,iim,jjm, knindex)
    1224   call cpl2gath(fluxsens_sc, fluxsens, klon, knon,iim,jjm, knindex)
    1225   call cpl2gath(fluxlat_sc, fluxlat, klon, knon,iim,jjm, knindex)
    1226   call cpl2gath(coastalflow_sc, coastalflow, klon, knon,iim,jjm, knindex)
    1227   call cpl2gath(riverflow_sc, riverflow, klon, knon,iim,jjm, knindex)
    1228   call cpl2gath(tsol_rad_sc, tsol_rad, klon, knon,iim,jjm, knindex)
    1229   call cpl2gath(tsurf_new_sc, tsurf_new, klon, knon,iim,jjm, knindex)
    1230   call cpl2gath(qsurf_sc, qsurf, klon, knon,iim,jjm, knindex)
    1231   call cpl2gath(albedo_out_sc(:,:,1), alb_new, klon, knon,iim,jjm, knindex)
    1232   call cpl2gath(emis_new_sc, emis_new, klon, knon,iim,jjm, knindex)
    1233   call cpl2gath(z0_new_sc, z0_new, klon, knon,iim,jjm, knindex)
    1234 
    1235 ! LF essai sensible
    1236   fluxsens = -1. * fluxsens
    1237   fluxlat = -1. * fluxlat
    1238 
    1239   if (debut) lrestart_read = .false.
    1240 
    1241   END SUBROUTINE interfsol_scat
    1242990!
    1243991!#########################################################################
    … …  
    20211769! Recopie des variables dans les champs de sortie
    20221770!
     1771  lmt_sst = 999999999.
    20231772  do ii = 1, knon
    20241773    lmt_sst(ii) = sst_lu(knindex(ii))
    … …  
    21761925! Recopie des variables dans les champs de sortie
    21771926!
    2178   lmt_alb(:) = 0.0
    2179   lmt_rug(:) = 0.0
     1927!!$  lmt_alb(:) = 0.0
     1928!!$  lmt_rug(:) = 0.0
     1929  lmt_alb(:) = 999999.
     1930  lmt_rug(:) = 999999.
    21801931  DO ii = 1, knon
    21811932    lmt_alb(ii) = alb_lu(knindex(ii))

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r230 r235  
    447447c
    448448      CHARACTER*2 str2
     449      CHARACTER*2 iqn
    449450c
    450451      REAL qcheck
    … …  
    549550c
    550551      REAL tr_seri(klon,klev,nbtr)
     552      REAL d_tr(klon,klev,nbtr)
    551553
    552554      REAL zx_rh(klon,klev)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F

    r230 r235  
    242242            zx_lon(i,jjm+1) = xlon(i+1)
    243243         ENDDO
    244          DO ll=1,klev
    245             znivsig(ll)=float(ll)
    246          ENDDO
     244c         DO ll=1,klev
     245c            znivsig(ll)=float(ll)
     246c         ENDDO
    247247         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlat,zx_lat)
    248248         CALL histbeg("histrac", iim,zx_lon, jjm+1,zx_lat,

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.h

    r230 r235  
    11      INTEGER kdlon, kflev
    2 c
    3 ccc      PARAMETER (kdlon=klon,kflev=klev)
    4 c
    5 c resolution 72 45:
    6       PARAMETER (kdlon=317,kflev=klev)
    7 c resolution 64 32:
    8 ccc      PARAMETER (kdlon=331,kflev=klev)
    9 c resolution 96 49:
    10 ccc      PARAMETER (kdlon=461,kflev=klev)
    11 c resolution 144 73:
    12 ccc      PARAMETER (kdlon=610,kflev=klev)
    13 c resolution 96 72:
    14 c      PARAMETER (kdlon=487,kflev=klev)
    15 c resolution 128 64:
    16 ccc       PARAMETER (kdlon=4033,kflev=klev)
     2      PARAMETER (kdlon=klon,kflev=klev)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/soil.F

    r2 r235  
    1       SUBROUTINE soil(ptimestep, indice, snow, ptsrf, ptsoil,
     1      SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, ptsoil,
    22     s          pcapcal, pfluxgrd)
    33      IMPLICIT NONE
    … …  
    4747
    4848#include "dimensions.h"
     49#include "YOMCST.h"
    4950#include "dimphy.h"
    5051#include "dimsoil.h"
    … …  
    5657
    5758      REAL ptimestep
    58       INTEGER indice
     59      INTEGER indice, knon
    5960      REAL ptsrf(klon),ptsoil(klon,nsoilmx),snow(klon)
    6061      REAL pcapcal(klon),pfluxgrd(klon)
    … …  
    6566
    6667      INTEGER ig,jk
    67       REAL zdz2(nsoilmx),z1(klon)
     68c$$$      REAL zdz2(nsoilmx),z1(klon)
     69      REAL zdz2(nsoilmx),z1(klon,nbsrf)
    6870      REAL min_period,dalph_soil
    6971      REAL ztherm_i(klon)
    … …  
    7274c   ----------------------
    7375      REAL dz1(nsoilmx),dz2(nsoilmx)
    74       REAL zc(klon,nsoilmx),zd(klon,nsoilmx)
     76c$$$          REAL zc(klon,nsoilmx),zd(klon,nsoilmx)
     77      REAL zc(klon,nsoilmx,nbsrf),zd(klon,nsoilmx,nbsrf)
    7578      REAL lambda
    7679      SAVE dz1,dz2,zc,zd,lambda
    77       LOGICAL firstcall
    78       SAVE firstcall
     80      LOGICAL firstcall, firstsurf(nbsrf)
     81      SAVE firstcall, firstsurf
    7982      REAL isol,isno,iice
    8083      SAVE isol,isno,iice
    8184
    8285      DATA firstcall/.true./
     86      DATA firstsurf/.TRUE.,.TRUE.,.TRUE.,.TRUE./
    8387
    8488      DATA isol,isno,iice/2000.,2000.,2000./
    … …  
    9094      REAL fz,rk,fz1,rk1,rk2
    9195      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
    92 
     96      pfluxgrd(:) = 0.
    9397c   calcul de l'inertie thermique a partir de la variable rnat.
    9498c   on initialise a iice meme au-dessus d'un point de mer au cas
    … …  
    97101c
    98102      IF (indice.EQ.is_sic) THEN
    99          DO ig = 1, klon
     103         DO ig = 1, knon
    100104            ztherm_i(ig)   = iice
    101105            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
    102106         ENDDO
    103107      ELSE IF (indice.EQ.is_lic) THEN
    104          DO ig = 1, klon
     108         DO ig = 1, knon
    105109            ztherm_i(ig)   = iice
    106110            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
    107111         ENDDO
    108112      ELSE IF (indice.EQ.is_ter) THEN
    109          DO ig = 1, klon
     113         DO ig = 1, knon
    110114            ztherm_i(ig)   = isol
    111115            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
    112116         ENDDO
    113117      ELSE IF (indice.EQ.is_oce) THEN
    114          DO ig = 1, klon
     118         DO ig = 1, knon
    115119            ztherm_i(ig)   = iice
    116120         ENDDO
    … …  
    121125
    122126
    123       IF (firstcall) THEN
     127c$$$      IF (firstcall) THEN
     128      IF (firstsurf(indice)) THEN
    124129
    125130c-----------------------------------------------------------------------
    … …  
    162167     .               fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
    163168         ENDDO
    164 
    165          firstcall =.false.
     169C PB
     170         firstsurf(indice) = .FALSE.
     171c$$$         firstcall =.false.
    166172
    167173c   Initialisations:
    … …  
    175181
    176182c    surface temperature
    177          DO ig=1,klon
    178             ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
    179      s      (lambda*(1.-zd(ig,1))+1.)
     183         DO ig=1,knon
     184            ptsoil(ig,1)=(lambda*zc(ig,1,indice)+ptsrf(ig))/
     185     s      (lambda*(1.-zd(ig,1,indice))+1.)
    180186         ENDDO
    181187
    182188c   other temperatures
    183189         DO jk=1,nsoilmx-1
    184             DO ig=1,klon
    185                ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
     190            DO ig=1,knon
     191               ptsoil(ig,jk+1)=zc(ig,jk,indice)+zd(ig,jk,indice)
     192     $            *ptsoil(ig,jk)
    186193            ENDDO
    187194         ENDDO
    … …  
    192199c   ---------------------------------------------------------------
    193200
     201c$$$  PB ajout pour cas glace de mer
     202      IF (indice .EQ. is_sic) THEN
     203          DO ig = 1 , knon
     204            ptsoil(ig,nsoilmx) = RTT - 1.8
     205          END DO
     206      ENDIF
     207
    194208      DO jk=1,nsoilmx
    195209         zdz2(jk)=dz2(jk)/ptimestep
    196210      ENDDO
    197211
    198       DO ig=1,klon
    199          z1(ig)=zdz2(nsoilmx)+dz1(nsoilmx-1)
    200          zc(ig,nsoilmx-1)=zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig)
    201          zd(ig,nsoilmx-1)=dz1(nsoilmx-1)/z1(ig)
     212      DO ig=1,knon
     213         z1(ig,indice)=zdz2(nsoilmx)+dz1(nsoilmx-1)
     214         zc(ig,nsoilmx-1,indice)=
     215     $       zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig,indice)
     216         zd(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1(ig,indice)
    202217      ENDDO
    203218
    204219      DO jk=nsoilmx-1,2,-1
    205          DO ig=1,klon
    206             z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
    207             zc(ig,jk-1)=
    208      s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
    209             zd(ig,jk-1)=dz1(jk-1)*z1(ig)
     220         DO ig=1,knon
     221            z1(ig,indice)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)
     222     $         *(1.-zd(ig,jk,indice)))
     223            zc(ig,jk-1,indice)=
     224     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk,indice))
     225     $          *z1(ig,indice)
     226            zd(ig,jk-1,indice)=dz1(jk-1)*z1(ig,indice)
    210227         ENDDO
    211228      ENDDO
    … …  
    216233c   ---------------------------------
    217234
    218       DO ig=1,klon
     235      DO ig=1,knon
    219236         pfluxgrd(ig)=ztherm_i(ig)*dz1(1)*
    220      s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
     237     s   (zc(ig,1,indice)+(zd(ig,1,indice)-1.)*ptsoil(ig,1))
    221238         pcapcal(ig)=ztherm_i(ig)*
    222      s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
    223          z1(ig)=lambda*(1.-zd(ig,1))+1.
    224          pcapcal(ig)=pcapcal(ig)/z1(ig)
    225          pfluxgrd(ig)=pfluxgrd(ig)
    226      s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
     239     s   (dz2(1)+ptimestep*(1.-zd(ig,1,indice))*dz1(1))
     240         z1(ig,indice)=lambda*(1.-zd(ig,1,indice))+1.
     241         pcapcal(ig)=pcapcal(ig)/z1(ig,indice)
     242         pfluxgrd(ig) = pfluxgrd(ig)
     243     s   + pcapcal(ig) * (ptsoil(ig,1) * z1(ig,indice)
     244     $       - lambda * zc(ig,1,indice)
     245     $       - ptsrf(ig))
    227246     s   /ptimestep
    228247      ENDDO
Note: See TracChangeset for help on using the changeset viewer.