Changeset 281


Ignore:
Timestamp:
Oct 19, 2001, 12:31:04 PM (23 years ago)
Author:
lmdzadmin
Message:

Passage des deux albedos de surface (vis et nir)
Modif dans interfsol sur les indicages des variables passees a ORCHIDEE pour
ne plus avoir de decalage dans les sorties ORCHIDEE
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r277 r281  
    6060      & ocean, npas, nexca, zmasq, &
    6161      & evap, fluxsens, fluxlat, dflux_l, dflux_s, &             
    62       & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, agesno)
     62      & tsol_rad, tsurf_new, alb_new, alblw, emis_new, &
     63      & z0_new, pctsrf_new, agesno)
    6364
    6465
    … …  
    174175  real, dimension(klon), intent(OUT):: fluxsens, fluxlat
    175176  real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
     177  real, dimension(klon), intent(OUT):: alblw
    176178  real, dimension(klon), intent(OUT):: emis_new, z0_new
    177179  real, dimension(klon), intent(OUT):: dflux_l, dflux_s
    … …  
    242244  alb_new = 999999. ; z0_new = 999999. ; alb_neig = 999999.
    243245  tsurf_new = 999999.
     246  alblw = 999999.
    244247! Aiguillage vers les differents schemas de surface
    245248
    … …  
    316319     call albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
    317320     where (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
    318      zfra = max(0.0,min(1.0,snow/(snow+10.0)))
    319      alb_new(1 : knon)  = alb_neig(1 : knon) *zfra + alb_new(1 : knon)*(1.0-zfra)
     321     zfra(1:knon) = max(0.0,min(1.0,snow/(snow+10.0)))
     322     alb_new(1 : knon)  = alb_neig(1 : knon) *zfra(1:knon) + &
     323    &                     alb_new(1 : knon)*(1.0-zfra(1:knon))
    320324     z0_new = sqrt(z0_new**2+rugoro**2)
     325     alblw(1 : knon) = alb_new(1 : knon)
    321326
    322327    else
    … …  
    333338     &  tsurf, p1lay/100., ps, radsol, &
    334339     &  evap, fluxsens, fluxlat, &             
    335      &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     340     &  tsol_rad, tsurf_new, alb_new, alblw, &
     341     &  emis_new, z0_new, dflux_l, dflux_s)
    336342
    337343! 
    … …  
    429435
    430436    z0_new = sqrt(rugos**2 + rugoro**2)
     437    alblw(1:knon) = alb_new(1:knon)
     438
    431439!
    432440  else if (nisurf == is_sic) then
    … …  
    498506      CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
    499507      WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
    500       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    501       alb_new(1 : knon) = alb_neig(1 : knon) *zfra + 0.6 * (1.0-zfra)
     508      zfra(1:knon) = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     509      alb_new(1 : knon) = alb_neig(1 : knon) *zfra(1:knon) + &
     510     &                    0.6 * (1.0-zfra(1:knon))
    502511!!      alb_new(1 : knon) = 0.6
    503512    ENDIF
    … …  
    525534
    526535     
    527      z0_new = 0.001
    528      z0_new = SQRT(z0_new**2+rugoro**2)
     536    z0_new = 0.001
     537    z0_new = SQRT(z0_new**2+rugoro**2)
     538    alblw(1:knon) = alb_new(1:knon)
    529539
    530540  else if (nisurf == is_lic) then
    … …  
    566576     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
    567577     WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
    568      zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    569      alb_new(1 : knon)  = alb_neig(1 : knon)*zfra + 0.6 * (1.0-zfra)
     578     zfra(1:knon) = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     579     alb_new(1 : knon)  = alb_neig(1 : knon)*zfra(1:knon) + &
     580    &                     0.6 * (1.0-zfra(1:knon))
    570581!!     alb_new(1 : knon)  = 0.6
    571582!
    … …  
    578589    pctsrf_new(:,nisurf) = pctsrf(:,nisurf)
    579590
     591    alblw(1:knon) = alb_new(1:knon)
    580592  else
    581593    write(*,*)'Index surface = ',nisurf
    … …  
    622634     & tsurf, p1lay, ps, radsol, &
    623635     & evap, fluxsens, fluxlat, &             
    624      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     636     & tsol_rad, tsurf_new, alb_new, alblw, &
     637     & emis_new, z0_new, dflux_l, dflux_s)
    625638
    626639  USE intersurf
    … …  
    708721! Parametres de sortie
    709722  real, dimension(klon), intent(OUT):: evap, fluxsens, fluxlat
    710   real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
     723  real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new, alblw
    711724  real, dimension(klon), intent(OUT):: emis_new, z0_new
    712725  real, dimension(klon), intent(OUT):: dflux_s, dflux_l
    … …  
    714727! Local
    715728!
    716   integer              :: ii, ij, jj, igrid, ireal, i, index
     729  integer              :: ii, ij, jj, igrid, ireal, i, index, iglob
    717730  integer              :: error
    718731  character (len = 20) :: modname = 'interfsol'
    … …  
    751764  real, dimension(klon) :: petA_orc, peqA_orc
    752765  real, dimension(klon) :: petB_orc, peqB_orc
     766! Pb de correspondances de grilles
     767  integer, dimension(:), save, allocatable :: ig, jg
     768  integer :: indi, indj
     769  integer, dimension(klon) :: ktindex
     770! Essai cdrag
     771  real, dimension(klon) :: cdrag
    753772
    754773  if (check) write(*,*)'Entree ', modname
    755774  if (check) write(*,*)'ok_veget = ',ok_veget
    756775
     776  ktindex(:) = knindex(:) + iim - 1
     777
    757778! initialisation
    758779  if (debut) then
    759780
     781! Pb de correspondances de grilles
     782   allocate(ig(klon))
     783   allocate(jg(klon))
     784   ig(1) = 1
     785   jg(1) = 1
     786   indi = 0
     787   indj = 2
     788   do igrid = 2, klon - 1
     789     indi = indi + 1
     790     if ( indi > iim) then
     791       indi = 1
     792       indj = indj + 1
     793     endif
     794     ig(igrid) = indi
     795     jg(igrid) = indj
     796   enddo
     797   ig(klon) = 1
     798   jg(klon) = jjm + 1
    760799!
    761800!  Initialisation des offset   
    … …  
    786825! Attention aux poles
    787826!
     827!!$    do igrid = 1, knon
     828!!$      index = ktindex(igrid)
     829!!$      ij = index - int((index-1)/iim)*iim - 1
     830!!$      jj = 2 + int((index-1)/iim)
     831!!$      if (mod(index,iim) == 1 ) then
     832!!$        jj = 1 + int((index-1)/iim)
     833!!$        ij = iim
     834!!$      endif
     835!!$      correspond(ij,jj) = igrid
     836!!$      write(50,*)'igrid, i, j =',igrid,ij,jj
     837!!$    enddo
     838! Pb de correspondances de grilles!
     839!!$    do igrid = 1, knon
     840!!$      index = ktindex(igrid)
     841!!$      ij = ig(index)
     842!!$      jj = jg(index)
     843!!$      correspond(ij,jj) = igrid
     844!!$      write(51,*)'igrid, i, j =',igrid,ij,jj
     845!!$    enddo
    788846    do igrid = 1, knon
    789       index = knindex(igrid)
    790       ij = index - int((index-1)/iim)*iim - 1
    791       jj = 2 + int((index-1)/iim)
    792       if (mod(index,iim) == 1 ) then
    793         jj = 1 + int((index-1)/iim)
    794         ij = iim
    795       endif
     847      index = ktindex(igrid)
     848          jj = int((index - 1)/iim) + 1
     849          ij = index - (jj - 1) * iim
    796850      correspond(ij,jj) = igrid
    797851    enddo
    798 !
     852
     853!!$    index = 0
     854!!$    do jj = 1, jjm+1
     855!!$      do ij = 1, iim
     856!!$        index = index + 1
     857!!$        correspond(ij,jj) = index
     858!!$      enddo
     859!!$    enddo
     860
    799861! Allouer et initialiser le tableau de coordonnees du sol
    800862!
    … …  
    832894        ij = iim
    833895      endif
    834       lon_scat(ij,jj) = rlon(index)
    835       lat_scat(ij,jj) = rlat(index)
     896!      lon_scat(ij,jj) = rlon(index)
     897!      lat_scat(ij,jj) = rlat(index)
    836898    enddo
    837899    index = 1
    … …  
    847909    lon_scat(:,jjm+1) = lon_scat(:,2)
    848910    lat_scat(:,jjm+1) = rlat(klon)
     911! Pb de correspondances de grilles!
     912!    do igrid = 1, knon
     913!      index = ktindex(igrid)
     914!      ij = ig(index)
     915!      jj = jg(index)
     916!      lon_scat(ij,jj) = rlon(index)
     917!      lat_scat(ij,jj) = rlat(index)
     918!    enddo
    849919
    850920!
    … …  
    870940      ireal = knindex(igrid)
    871941      contfrac(igrid) = pctsrf(ireal,is_ter)
    872       if (mod(ireal - 2, iim) == 0) then
     942    enddo
     943
     944    do igrid = 1, knon
     945      iglob = ktindex(igrid)
     946      if (mod(iglob, iim) == 1) then
    873947        offset = off_ini(:,1)
    874       else if(mod(ireal - 1, iim) == 0) then
     948      else if(mod(iglob, iim) == 0) then
    875949        offset = off_ini(:,3)
    876950      else
    877951        offset = off_ini(:,2)
    878952      endif
    879       if (ireal == 98) write (*,*) offset
    880953      do i = 1, 8
    881         index = ireal + offset(i)
    882         if (index <= 1) index = 1
    883         if (index >= klon) index = klon
    884         if (pctsrf(index, is_ter) > EPSFRA) then
    885           ij = index - int((index-1)/iim)*iim - 1
    886           jj = 2 + int((index-1)/iim)
    887           if (mod(index,iim) == 1 ) then
    888             jj = 1 + int((index-1)/iim)
    889             ij = iim
    890           endif
    891 !          write(*,*)'correspond',igrid, ireal,index,ij,jj
    892           if ( ij >= 1 .and. ij <= iim .and. jj >= 1 .and. jj <= jjm) then
     954        index = iglob + offset(i)
     955        ireal = (min(max(1, index - iim + 1), klon))
     956!        if (index <= 1) index = 1
     957!        if (index >= klon) index = klon
     958        if (pctsrf(ireal, is_ter) > EPSFRA) then
     959          jj = int((index - 1)/iim) + 1
     960          ij = index - (jj - 1) * iim
     961!!$          ij = index - int((index-1)/iim)*iim - 1
     962!!$          jj = 2 + int((index-1)/iim)
     963!!$          if (mod(index,iim) == 1 ) then
     964!!$            jj = 1 + int((index-1)/iim)
     965!!$            ij = iim
     966!!$          endif
     967!!$! Pb de correspondances de grilles!
     968!!$      ij = ig(index)
     969!!$      jj = jg(index)
     970!!$!          write(*,*)'correspond',igrid, ireal,index,ij,jj
     971!          if ( ij >= 1 .and. ij <= iim .and. jj >= 1 .and. jj <= jjm) then
    893972!          write(*,*)'correspond',igrid, ireal,index,ij,jj
    894973            neighbours(igrid, i) = correspond(ij, jj)
    895           endif
     974!          endif
    896975        endif
    897976      enddo
    898977    enddo
     978
     979    write(*,*)'Neighbours = '
     980
     981    write(*,*)neighbours(1,8), neighbours(1,1),neighbours(1,2)
     982    write(*,*)neighbours(1,7), ktindex(1), neighbours(1,3)
     983    write(*,*)neighbours(1,6), neighbours(1,5),neighbours(1,4)
     984
     985    write(*,*)neighbours(250,8), neighbours(250,1),neighbours(250,2)
     986    write(*,*)neighbours(250,7), ktindex(250), neighbours(250,3)
     987    write(*,*)neighbours(250,6), neighbours(250,5),neighbours(250,4)
     988
     989 OPEN (unit=12, file="neighbours.9671")
     990  DO i=1,knon
     991     WRITE(12,*) '-----------------------------'
     992     WRITE(12,'(I7,f8.5,   "    ",3I6)') knon, contfrac(i), &
     993          & neighbours(i,8), neighbours(i,1), neighbours(i,2)
     994     WRITE(12,'(f10.5,"         ",3I6)') lalo(i,2), neighbours(i,7), &
     995          & ktindex(i), neighbours(i,3)
     996     WRITE(12,'(f10.5,"         ",3I6)') lalo(i,1), neighbours(i,6), &
     997          & neighbours(i,5), neighbours(i,3)
     998  ENDDO
     999  CLOSE(12)
     1000
    8991001
    9001002!
    … …  
    9261028  peqB_orc = peqAcoef
    9271029
     1030  cdrag = 0.
     1031  cdrag(1:knon) = tq_cdrag(1:knon)
     1032
     1033!  where(cdrag > 0.01)
     1034!    cdrag = 0.01
     1035!  endwhere
     1036!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
     1037
    9281038!
    9291039! Init Orchidee
    9301040!
    9311041  if (debut) then
    932     call intersurf_main (itime-1, iim, jjm+1, knon, knindex, dtime, &
     1042    call intersurf_main (itime-1, iim, jjm+1, knon, ktindex, dtime, &
    9331043     & lrestart_read, lrestart_write, lalo, &
    9341044     & contfrac, neighbours, resolution, date0, &
    9351045     & zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
    936      & tq_cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
     1046     & cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
    9371047     & precip_rain, precip_snow, lwdown, swnet, swdown, p1lay, &
    9381048     & evap, fluxsens, fluxlat, coastalflow, riverflow, &
    … …  
    9411051  endif
    9421052
    943   call intersurf_main (itime, iim, jjm+1, knon, knindex, dtime, &
     1053  call intersurf_main (itime, iim, jjm+1, knon, ktindex, dtime, &
    9441054     & lrestart_read, lrestart_write, lalo, &
    9451055     & contfrac, neighbours, resolution, date0, &
    9461056     & zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
    947      & tq_cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
     1057     & cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
    9481058     & precip_rain, precip_snow, lwdown, swnet, swdown, p1lay, &
    9491059     & evap, fluxsens, fluxlat, coastalflow, riverflow, &
    … …  
    9511061     & lon_scat, lat_scat)
    9521062
    953   alb_new(:) = albedo_out(:,1)
     1063!  alb_new(:) = (albedo_out(:,1) + albedo_out(:,2)) / 2.
     1064  alb_new(1:knon) = albedo_out(1:knon,1)
     1065  alblw(1:knon) = albedo_out(1:knon,2)
    9541066
    9551067! Convention orchidee: positif vers le haut
    9561068  fluxsens = -1. * fluxsens
    9571069  fluxlat  = -1. * fluxlat
    958   evap     = -1. * evap
     1070!  evap     = -1. * evap
    9591071
    9601072  if (debut) lrestart_read = .false.
Note: See TracChangeset for help on using the changeset viewer.