Changeset 201


Ignore:
Timestamp:
Apr 6, 2001, 10:28:03 AM (23 years ago)
Author:
lmdzadmin
Message:

Rajout de l'appel 2D scattered a ORCHIDEE (marche bien mieux)
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r182 r201  
    195195  real, DIMENSION(klon):: zfra
    196196  logical              :: cumul = .false.
     197  logical              :: scatter = .false.
    197198
    198199  if (check) write(*,*) 'Entree ', modname
    … …  
    342343!  appel a sechiba
    343344!
    344       call interfsol(itime, klon, dtime, nisurf, knon, &
     345      scatter= .true.
     346      if (.not. scatter) then
     347        call interfsol(itime, klon, dtime, nisurf, knon, &
    345348     &  knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
    346349     &  debut, lafin, ok_veget, &
    … …  
    351354     &  evap, fluxsens, fluxlat, &             
    352355     &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     356      else
     357        call interfsol_scat(itime, klon, dtime, nisurf, knon, &
     358     &  knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
     359     &  debut, lafin, ok_veget, &
     360     &  zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
     361     &  tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
     362     &  precip_rain, precip_snow, sollwdown, swnet, swdown, &
     363     &  tsurf, p1lay/100., ps, radsol, &
     364     &  evap, fluxsens, fluxlat, &             
     365     &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     366      endif
    353367    endif   
    354368!
    … …  
    801815    endif
    802816    if ((.not. allocated(lon_scat))) then
    803       allocate(lon_scat(iim,jjm), stat = error)
     817      allocate(lon_scat(iim,jjm+1), stat = error)
    804818      if (error /= 0) then
    805819        abort_message='Pb allocation lon_scat'
    … …  
    808822    endif
    809823    if ((.not. allocated(lat_scat))) then
    810       allocate(lat_scat(iim,jjm), stat = error)
     824      allocate(lat_scat(iim,jjm+1), stat = error)
    811825      if (error /= 0) then
    812826        abort_message='Pb allocation lat_scat'
    … …  
    839853    lon_scat(:,1) = lon_scat(:,2)
    840854    lat_scat(:,1) = rlat(1)
     855    lon_scat(:,jjm+1) = lon_scat(:,2)
     856    lat_scat(:,jjm+1) = rlat(klon)
    841857
    842858!
    … …  
    916932  peqB_orc = peqAcoef
    917933
    918   call intersurf_main (itime, iim, jjm, knon, knindex, dtime, &
     934!
     935! Init Orchidee
     936!
     937  if (debut) then
     938    call intersurf_main (itime-1, iim, jjm+1, knon, knindex, dtime, &
    919939     & lrestart_read, lrestart_write, lalo, &
    920940     & contfrac, neighbours, resolution, date0, &
    … …  
    925945     & tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
    926946     & lon_scat, lat_scat)
     947  endif
     948
     949  call intersurf_main (itime, iim, jjm+1, knon, knindex, dtime, &
     950     & lrestart_read, lrestart_write, lalo, &
     951     & contfrac, neighbours, resolution, date0, &
     952     & zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
     953     & tq_cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
     954     & precip_rain, precip_snow, lwdown, swnet, swdown, p1lay, &
     955     & evap, fluxsens, fluxlat, coastalflow, riverflow, &
     956     & tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
     957     & lon_scat, lat_scat)
    927958
    928959  alb_new(:) = albedo_out(:,1)
    929960
    930961  END SUBROUTINE interfsol
     962!
     963!#########################################################################
     964!
     965  SUBROUTINE interfsol_scat(itime, klon, dtime, nisurf, knon, &
     966     & knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
     967     & debut, lafin, ok_veget, &
     968     & zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
     969     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
     970     & precip_rain, precip_snow, lwdown, swnet, swdown, &
     971     & tsurf, p1lay, ps, radsol, &
     972     & evap, fluxsens, fluxlat, &             
     973     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     974
     975  USE intersurf
     976
     977! Cette routine sert d'interface entre le modele atmospherique et le
     978! modele de sol continental. Appel a sechiba
     979!
     980! L. Fairhead 02/2000
     981!
     982! input:
     983!   itime        numero du pas de temps
     984!   klon         nombre total de points de grille
     985!   dtime        pas de temps de la physique (en s)
     986!   nisurf       index de la surface a traiter (1 = sol continental)
     987!   knon         nombre de points de la surface a traiter
     988!   knindex      index des points de la surface a traiter
     989!   rlon         longitudes de la grille entiere
     990!   rlat         latitudes de la grille entiere
     991!   pctsrf       tableau des fractions de surface de chaque maille
     992!   debut        logical: 1er appel a la physique (lire les restart)
     993!   lafin        logical: dernier appel a la physique (ecrire les restart)
     994!   ok_veget     logical: appel ou non au schema de surface continental
     995!                     (si false calcul simplifie des fluxs sur les continents)
     996!   zlev         hauteur de la premiere couche       
     997!   u1_lay       vitesse u 1ere couche
     998!   v1_lay       vitesse v 1ere couche
     999!   temp_air     temperature de l'air 1ere couche
     1000!   spechum      humidite specifique 1ere couche
     1001!   epot_air     temp pot de l'air
     1002!   ccanopy      concentration CO2 canopee
     1003!   tq_cdrag     cdrag
     1004!   petAcoef     coeff. A de la resolution de la CL pour t
     1005!   peqAcoef     coeff. A de la resolution de la CL pour q
     1006!   petBcoef     coeff. B de la resolution de la CL pour t
     1007!   peqBcoef     coeff. B de la resolution de la CL pour q
     1008!   precip_rain  precipitation liquide
     1009!   precip_snow  precipitation solide
     1010!   lwdown       flux IR descendant a la surface
     1011!   swnet        flux solaire net
     1012!   swdown       flux solaire entrant a la surface
     1013!   tsurf        temperature de surface
     1014!   p1lay        pression 1er niveau (milieu de couche)
     1015!   ps           pression au sol
     1016!   radsol       rayonnement net aus sol (LW + SW)
     1017!   
     1018!
     1019! input/output
     1020!   run_off      ruissellement total
     1021!
     1022! output:
     1023!   evap         evaporation totale
     1024!   fluxsens     flux de chaleur sensible
     1025!   fluxlat      flux de chaleur latente
     1026!   tsol_rad     
     1027!   tsurf_new    temperature au sol
     1028!   alb_new      albedo
     1029!   emis_new     emissivite
     1030!   z0_new       surface roughness
     1031
     1032
     1033! Parametres d'entree
     1034  integer, intent(IN) :: itime
     1035  integer, intent(IN) :: klon
     1036  real, intent(IN)    :: dtime
     1037  integer, intent(IN) :: nisurf
     1038  integer, intent(IN) :: knon
     1039  integer, intent(IN) :: iim, jjm
     1040  integer, dimension(klon), intent(IN) :: knindex
     1041  logical, intent(IN) :: debut, lafin, ok_veget
     1042  real, dimension(klon,nbsrf), intent(IN) :: pctsrf
     1043  real, dimension(klon), intent(IN) :: rlon, rlat
     1044  real, dimension(klon), intent(IN) :: cufi, cvfi
     1045  real, dimension(klon), intent(IN) :: zlev
     1046  real, dimension(klon), intent(IN) :: u1_lay, v1_lay
     1047  real, dimension(klon), intent(IN) :: temp_air, spechum
     1048  real, dimension(klon), intent(IN) :: epot_air, ccanopy
     1049  real, dimension(klon), intent(INOUT) :: tq_cdrag
     1050  real, dimension(klon), intent(IN) :: petAcoef, peqAcoef
     1051  real, dimension(klon), intent(IN) :: petBcoef, peqBcoef
     1052  real, dimension(klon), intent(IN) :: precip_rain, precip_snow
     1053  real, dimension(klon), intent(IN) :: lwdown, swnet, swdown, ps
     1054  real, dimension(klon), intent(IN) :: tsurf, p1lay
     1055  real, dimension(klon), intent(IN) :: radsol
     1056! Parametres de sortie
     1057  real, dimension(klon), intent(OUT):: evap, fluxsens, fluxlat
     1058  real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
     1059  real, dimension(klon), intent(OUT):: emis_new, z0_new
     1060  real, dimension(klon), intent(OUT):: dflux_s, dflux_l
     1061
     1062! Local
     1063!
     1064  integer              :: ii, ij, jj, igrid, ireal, i, index
     1065  integer              :: error
     1066  character (len = 20) :: modname = 'interfsol_scat'
     1067  character (len = 80) :: abort_message
     1068  logical,save              :: check = .TRUE.
     1069  real, dimension(klon) :: cal, beta, dif_grnd, capsol
     1070! type de couplage dans sechiba
     1071!  character (len=10)   :: coupling = 'implicit'
     1072! drapeaux controlant les appels dans SECHIBA
     1073!  type(control_type), save   :: control_in
     1074! coordonnees geographiques
     1075  real, allocatable, dimension(:,:), save :: lalo
     1076! pts voisins
     1077  integer,allocatable, dimension(:,:), save :: neighbours
     1078! fractions continents
     1079  real,allocatable, dimension(:), save :: contfrac
     1080! resolution de la grille
     1081  real, allocatable, dimension (:,:), save :: resolution
     1082! correspondance point n -> indices (i,j)
     1083  integer, allocatable, dimension(:,:), save :: correspond
     1084! offset pour calculer les point voisins
     1085  integer, dimension(8,3), save :: off_ini
     1086  integer, dimension(8), save :: offset
     1087! Identifieurs des fichiers restart et histoire
     1088  integer, save          :: rest_id, hist_id
     1089  integer, save          :: rest_id_stom, hist_id_stom
     1090!
     1091  real, allocatable, dimension (:,:), save :: lon_scat, lat_scat 
     1092
     1093  logical, save           :: lrestart_read = .true. , lrestart_write = .false.
     1094
     1095  real, dimension(klon):: qsurf
     1096  real, dimension(klon):: snow, qsol
     1097  real, save                 :: date0 = 0.
     1098  real, dimension(knon,2) :: albedo_out
     1099! Pb de nomenclature
     1100  real, dimension(klon)      :: petA_orc, petB_orc, peqA_orc, peqB_orc
     1101! champs a passer a ORCHIDEE
     1102  real, dimension(:,:), allocatable, save :: lon_sc, lat_sc, contfrac_sc
     1103  real, dimension(iim,jjm+1) :: zlev_sc
     1104  real, dimension(iim,jjm+1) :: u1_lay_sc, v1_lay_sc, spechum_sc, temp_air_sc
     1105  real, dimension(iim,jjm+1) :: epot_air_sc, ccanopy_sc, tq_cdrag_sc
     1106  real, dimension(iim,jjm+1) :: petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc
     1107  real, dimension(iim,jjm+1) :: precip_rain_sc, precip_snow_sc, lwdown_sc
     1108  real, dimension(iim,jjm+1) :: swnet_sc, swdown_sc, p1lay_sc, evap_sc
     1109  real, dimension(iim,jjm+1) :: fluxsens_sc, fluxlat_sc, coastalflow_sc
     1110  real, dimension(iim,jjm+1) :: riverflow_sc, tsol_rad_sc, tsurf_new_sc
     1111  real, dimension(iim,jjm+1) :: qsurf_sc, emis_new_sc, z0_new_sc
     1112  real, dimension(iim,jjm+1,2) :: albedo_out_sc
     1113
     1114  if (check) write(*,*)'Entree ', modname
     1115  if (check) write(*,*)'ok_veget = ',ok_veget
     1116
     1117! initialisation
     1118  if (debut) then
     1119    if ((.not. allocated(lon_sc))) then
     1120      allocate(lon_sc(iim,jjm+1), stat = error)
     1121      if (error /= 0) then
     1122        abort_message='Pb allocation lon_sc'
     1123        call abort_gcm(modname,abort_message,1)
     1124      endif     
     1125    endif
     1126    if ((.not. allocated(lat_sc))) then
     1127      allocate(lat_sc(iim,jjm+1), stat = error)
     1128      if (error /= 0) then
     1129        abort_message='Pb allocation lat_sc'
     1130        call abort_gcm(modname,abort_message,1)
     1131      endif     
     1132    endif
     1133    index = 1
     1134    do jj = 2, jjm
     1135      do ij = 1, iim
     1136        index = index + 1
     1137        lon_sc(ij,jj) = rlon(index)
     1138        lat_sc(ij,jj) = rlat(index)
     1139      enddo
     1140    enddo
     1141    lon_sc(:,1) = lon_sc(:,2)
     1142    lat_sc(:,1) = rlat(1)
     1143    lon_sc(:,jjm+1) = lon_sc(:,jjm)
     1144    lat_sc(:,jjm+1) = rlat(klon)
     1145    if (( .not. allocated(contfrac_sc))) then
     1146      allocate(contfrac_sc(iim, jjm+1), stat = error)
     1147      if (error /= 0) then
     1148        abort_message='Pb allocation contfrac'
     1149        call abort_gcm(modname,abort_message,1)
     1150      endif     
     1151    endif
     1152    contfrac_sc = 0.
     1153    call gath2cpl(pctsrf(:,is_ter), contfrac_sc, klon, knon,iim,jjm, knindex)
     1154  endif                          ! (fin debut)
     1155
     1156!
     1157! Appel a la routine sols continentaux
     1158!
     1159! petit pb de nomenclature
     1160!
     1161  if (lafin) lrestart_write = .true.
     1162  if (check) write(*,*)'lafin ',lafin,lrestart_write
     1163
     1164  petA_orc = petBcoef * dtime
     1165  petB_orc = petAcoef
     1166  peqA_orc = peqBcoef * dtime
     1167  peqB_orc = peqAcoef
     1168
     1169!
     1170! Passage sur la grille 2D avant envoi a ORCHIDEE
     1171!
     1172  call gath2cpl(zlev, zlev_sc, klon, knon,iim,jjm, knindex)
     1173  call gath2cpl(u1_lay, u1_lay_sc, klon, knon,iim,jjm, knindex)
     1174  call gath2cpl(v1_lay, v1_lay_sc, klon, knon,iim,jjm, knindex)
     1175  call gath2cpl(spechum, spechum_sc, klon, knon,iim,jjm, knindex)
     1176  call gath2cpl(temp_air, temp_air_sc, klon, knon,iim,jjm, knindex)
     1177  call gath2cpl(epot_air, epot_air_sc, klon, knon,iim,jjm, knindex)
     1178  call gath2cpl(ccanopy, ccanopy_sc, klon, knon,iim,jjm, knindex)
     1179  call gath2cpl(tq_cdrag, tq_cdrag_sc, klon, knon,iim,jjm, knindex)
     1180  call gath2cpl(petA_orc, petA_or_sc, klon, knon,iim,jjm, knindex)
     1181  call gath2cpl(peqA_orc, peqA_or_sc, klon, knon,iim,jjm, knindex)
     1182  call gath2cpl(petB_orc, petB_or_sc, klon, knon,iim,jjm, knindex)
     1183  call gath2cpl(peqB_orc, peqB_or_sc, klon, knon,iim,jjm, knindex)
     1184  call gath2cpl(precip_rain, precip_rain_sc, klon, knon,iim,jjm, knindex)
     1185  call gath2cpl(precip_snow, precip_snow_sc, klon, knon,iim,jjm, knindex)
     1186  call gath2cpl(lwdown, lwdown_sc, klon, knon,iim,jjm, knindex)
     1187  call gath2cpl(swnet, swnet_sc, klon, knon,iim,jjm, knindex)
     1188  call gath2cpl(swdown, swdown_sc, klon, knon,iim,jjm, knindex)
     1189  call gath2cpl(p1lay, p1lay_sc, klon, knon,iim,jjm, knindex)
     1190!
     1191! Init Orchidee
     1192!
     1193  if (debut) then
     1194    call intersurf_main (itime-1, iim, jjm+1 , knon, knindex, dtime, &
     1195     & lrestart_read, lrestart_write, lon_sc, lat_sc, &
     1196     & contfrac_sc, date0, zlev_sc,  u1_lay_sc, v1_lay_sc, &
     1197     & spechum_sc, temp_air_sc, epot_air_sc, ccanopy_sc, &
     1198     & tq_cdrag_sc, petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc, &
     1199     & precip_rain_sc, precip_snow_sc, lwdown_sc, swnet_sc, &
     1200     & swdown_sc, p1lay_sc, &
     1201     & evap_sc, fluxsens_sc, fluxlat_sc, &
     1202     & coastalflow_sc, riverflow_sc, tsol_rad_sc, tsurf_new_sc, &
     1203     & qsurf_sc, albedo_out_sc, emis_new_sc, z0_new_sc)
     1204  endif
     1205
     1206  call intersurf_main (itime, iim, jjm+1 , knon, knindex, dtime, &
     1207     & lrestart_read, lrestart_write, lon_sc, lat_sc, &
     1208     & contfrac_sc, date0, zlev_sc,  u1_lay_sc, v1_lay_sc, &
     1209     & spechum_sc, temp_air_sc, epot_air_sc, ccanopy_sc, &
     1210     & tq_cdrag_sc, petA_or_sc, peqA_or_sc, petB_or_sc, peqB_or_sc, &
     1211     & precip_rain_sc, precip_snow_sc, lwdown_sc, swnet_sc, &
     1212     & swdown_sc, p1lay_sc, &
     1213     & evap_sc, fluxsens_sc, fluxlat_sc, &
     1214     & coastalflow_sc, riverflow_sc, tsol_rad_sc, tsurf_new_sc, &
     1215     & qsurf_sc, albedo_out_sc, emis_new_sc, z0_new_sc)
     1216!
     1217! sorties mises sur la grille physique
     1218!
     1219
     1220  call cpl2gath(evap_sc, evap, klon, knon,iim,jjm, knindex)
     1221  call cpl2gath(fluxsens_sc, fluxsens, klon, knon,iim,jjm, knindex)
     1222  call cpl2gath(fluxlat_sc, fluxlat, klon, knon,iim,jjm, knindex)
     1223  call cpl2gath(coastalflow_sc, coastalflow, klon, knon,iim,jjm, knindex)
     1224  call cpl2gath(riverflow_sc, riverflow, klon, knon,iim,jjm, knindex)
     1225  call cpl2gath(tsol_rad_sc, tsol_rad, klon, knon,iim,jjm, knindex)
     1226  call cpl2gath(tsurf_new_sc, tsurf_new, klon, knon,iim,jjm, knindex)
     1227  call cpl2gath(qsurf_sc, qsurf, klon, knon,iim,jjm, knindex)
     1228  call cpl2gath(albedo_out_sc(:,:,1), alb_new, klon, knon,iim,jjm, knindex)
     1229  call cpl2gath(emis_new_sc, emis_new, klon, knon,iim,jjm, knindex)
     1230  call cpl2gath(z0_new_sc, z0_new, klon, knon,iim,jjm, knindex)
     1231
     1232! LF essai sensible
     1233  fluxsens = -1. * fluxsens
     1234  fluxlat = -1. * fluxlat
     1235
     1236  if (debut) lrestart_read = .false.
     1237
     1238  END SUBROUTINE interfsol_scat
    9311239!
    9321240!#########################################################################
Note: See TracChangeset for help on using the changeset viewer.