Ignore:
Timestamp:
Oct 16, 2000, 5:18:52 PM (24 years ago)
Author:
lmdzadmin
Message:

Version debugge coupleur
LF

File:
1 edited

Legend:

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

    r139 r140  
    364364
    365365      tsurf_temp = tsurf_new
    366       cal = 0.
    367366      dif_grnd = 0.
    368       beta = 1.
     367      beta = 1.0
    369368
    370369!    else if (ocean == 'slab  ') then
     
    376375     &  tsurf_new, pctsrf_new)
    377376
    378       cal = calice
    379       where (snow > 0.0) cal = calsno
     377      tsurf_temp = tsurf
     378      dif_grnd = 1.0 / tau_gl
    380379      beta = 1.0
    381       dif_grnd = 1.0 / tau_gl
    382       tsurf_temp = tsurf
    383     endif
     380    endif
     381
     382    cal = calice
     383    where (snow > 0.0) cal = calsno
    384384
    385385    call calcul_fluxs( knon, nisurf, dtime, &
     
    437437    abort_message = 'Index surface non valable'
    438438    call abort_gcm(modname,abort_message,1)
    439   endif
    440 
    441   if (check) then
    442     write(*,*)'In ',modname
    443     do ii = 1, nbsrf
    444       write(*,*) 'surface, pctsrf_new',ii,pctsrf_new(:,ii)
    445     enddo
    446439  endif
    447440
     
    735728  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
    736729  real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy
    737   INTEGER              :: nexca, npas
     730  INTEGER              :: nexca, npas, kstep
    738731  real, dimension(klon), intent(IN) :: zmasq
    739732
     
    745738
    746739! Variables locales
    747   integer                    :: j, error, sum_error, ig
     740  integer                    :: j, error, sum_error, ig, cpl_index,i
    748741  character (len = 20) :: modname = 'interfoce_cpl'
    749742  character (len = 80) :: abort_message
     
    772765! variable tampon
    773766  real, dimension(klon)       :: tamp
    774   real, dimension(knon)       :: tamp_sic
     767  real, dimension(klon)       :: tamp_sic
     768! sauvegarde des fractions de surface d'un pas de temps a l'autre apres
     769! l'avoir lu
     770  real, allocatable,dimension(:,:),save :: pctsrf_sav
    775771  real, dimension(iim, jjm+1, 2) :: tamp_srf
    776772  integer, allocatable, dimension(:), save :: tamp_ind
     
    778774  real, dimension(iim, jjm+1) :: deno
    779775  integer                     :: idtime
     776  integer, allocatable, dimension(:,:) :: isst
     777  integer, allocatable,save,dimension(:) :: unity
    780778!
    781779  logical, save    :: first_appel = .true.
     780  logical          :: print
    782781
    783782!
     
    787786 
    788787  if (first_appel) then
     788    error = 0
     789    allocate(unity(klon), stat = error)
     790    if ( error  /=0) then
     791      abort_message='Pb allocation variable unity'
     792      call abort_gcm(modname,abort_message,1)
     793    endif
     794    allocate(pctsrf_sav(klon,2), stat = error)
     795    if ( error  /=0) then
     796      abort_message='Pb allocation variable pctsrf_sav'
     797      call abort_gcm(modname,abort_message,1)
     798    endif
     799
     800    do ig = 1, klon
     801      unity(ig) = ig
     802    enddo
    789803    sum_error = 0
    790804    allocate(cpl_sols(knon,2), stat = error); sum_error = sum_error + error
     
    825839    idtime = int(dtime)
    826840    call inicma(npas , nexca, idtime,(jjm+1)*iim)
    827 !
    828 ! 1ere lecture champs ocean
    829 !
    830 !    if (nisurf == is_oce) then
    831 !      call fromcpl(itime - 1,(jjm+1)*iim,                                  &
    832 !     &        read_sst, read_sic, read_sit, read_alb_sic)
    833 !
    834 ! je voulais utiliser des where mais ca ne voulait pas compiler dans un
    835 ! if construct sur sun
    836 !
    837 !      do j = 1, jjm + 1
    838 !        do ig = 1, iim
    839 !          if (abs(1. - read_sic(ig,j)) < 0.00001) then
    840 !            read_sst(ig,j) = RTT - 1.8
    841 !            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
    842 !            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
    843 !          else if (abs(read_sic(ig,j)) < 0.00001) then
    844 !            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
    845 !            read_sit(ig,j) = read_sst(ig,j)
    846 !            read_alb_sic(ig,j) =  0.6
    847 !          else
    848 !            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
    849 !            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
    850 !            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
    851 !          endif
    852 !        enddo
    853 !      enddo
    854 !    endif
    855841
    856842    first_appel = .false.
     
    861847! calcul des fluxs a passer
    862848
    863   cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown      / FLOAT(nexca)
    864   cpl_nsol(:,nisurf) = cpl_nsol(:,nisurf) + lwdown      / FLOAT(nexca)
    865   cpl_rain(:,nisurf) = cpl_rain(:,nisurf) + precip_rain / FLOAT(nexca)
    866   cpl_snow(:,nisurf) = cpl_snow(:,nisurf) + precip_snow / FLOAT(nexca)
    867   cpl_evap(:,nisurf) = cpl_evap(:,nisurf) + evap        / FLOAT(nexca)
    868   cpl_tsol(:,nisurf) = cpl_tsol(:,nisurf) + tsurf       / FLOAT(nexca)
    869   cpl_fder(:,nisurf) = cpl_fder(:,nisurf) + fder        / FLOAT(nexca)
    870   cpl_albe(:,nisurf) = cpl_albe(:,nisurf) + albsol      / FLOAT(nexca)
    871   cpl_taux(:,nisurf) = cpl_taux(:,nisurf) + taux        / FLOAT(nexca)
    872   cpl_tauy(:,nisurf) = cpl_tauy(:,nisurf) + tauy        / FLOAT(nexca)
    873   cpl_rriv(:,nisurf) = cpl_rriv(:,nisurf) + run_off     / FLOAT(nexca)/dtime
    874   cpl_rcoa(:,nisurf) = cpl_rcoa(:,nisurf) + run_off     / FLOAT(nexca)/dtime
     849  cpl_index = 1
     850  if (nisurf == is_sic) cpl_index = 2
     851  do ig = 1, knon
     852    cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) &
     853     &                               + swdown(ig)      / FLOAT(nexca)
     854    cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) &
     855     &                               + lwdown(ig)      / FLOAT(nexca)
     856    cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) &
     857     &                               + precip_rain(ig) / FLOAT(nexca)
     858    cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) &
     859     &                               + precip_snow(ig) / FLOAT(nexca)
     860    cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) &
     861     &                               + evap(ig)        / FLOAT(nexca)
     862    cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) &
     863     &                               + tsurf(ig)       / FLOAT(nexca)
     864    cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) &
     865     &                               + fder(ig)        / FLOAT(nexca)
     866    cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) &
     867     &                               + albsol(ig)      / FLOAT(nexca)
     868    cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) &
     869     &                               + taux(ig)        / FLOAT(nexca)
     870    cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
     871     &                               + tauy(ig)        / FLOAT(nexca)
     872    cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
     873     &                               + 0.     / FLOAT(nexca)/dtime
     874    cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
     875     &                               + 0.     / FLOAT(nexca)/dtime
     876  enddo
    875877
    876878  if (mod(itime, nexca) == 1) then
     
    900902        enddo
    901903      enddo
     904!
     905! transformer read_sic en pctsrf_sav
     906!
     907    call cpl2gath(read_sic, tamp_sic , klon, klon,iim,jjm, unity)
     908    do ig = 1, klon
     909      IF (pctsrf(ig,is_oce) > epsfra .OR.            &
     910     &             pctsrf(ig,is_sic) > epsfra) THEN
     911            pctsrf_sav(ig,is_sic) = tamp_sic(ig) * pctsrf(ig,is_sic)
     912            pctsrf_sav(ig,is_oce) = pctsrf(ig,is_oce)    &
     913     &                        - (pctsrf_sav(ig,is_sic)-pctsrf(ig,is_sic))
     914      endif
     915    enddo
     916    if (minval(pctsrf_new(:,is_oce)) < 0.) then
     917      write(*,*)'Pb fraction ocean inferieure a 0'
     918      write(*,*)'au point ',minloc(pctsrf_new(:,is_oce))
     919      write(*,*)'valeur = ',minval(pctsrf_new(:,is_oce))
     920      abort_message = 'voir ci-dessus'
     921      call abort_gcm(modname,abort_message,1)
     922    endif
     923    if (minval(pctsrf_new(:,is_sic)) < 0.) then
     924      write(*,*)'Pb fraction glace inferieure a 0'
     925      write(*,*)'au point ',minloc(pctsrf_new(:,is_sic))
     926      write(*,*)'valeur = ',minval(pctsrf_new(:,is_sic))
     927      abort_message = 'voir ci-dessus'
     928      call abort_gcm(modname,abort_message,1)
     929    endif
     930       if (check) then
     931         write(47,*)'Sortie fromcpl apres bidouille'
     932         write(47,*)' read_sst = '
     933         write(47,'(72f8.3)')read_sst
     934         call flush(47)
     935!        allocate(isst(iim, jjm+1), stat = error)
     936!        isst = 0
     937!        where (read_sst >0.) isst = 1
     938!        write(46,'(72i1)')isst
     939       endif
    902940    endif
    903941  endif                         ! fin mod(itime, nexca) == 1
     
    10081046  if (nisurf == is_oce) then
    10091047    call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex)
    1010     call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex)
    1011 !
    1012 ! transformer tamp_sic en pctsrf_new
    1013 !
    1014     do ig = 1, klon
    1015       IF (pctsrf(ig,is_oce) > epsfra .OR.            &
    1016      &             pctsrf(ig,is_sic) > epsfra) THEN
    1017             pctsrf_new(ig,is_oce) = pctsrf(ig,is_oce)    &
    1018      &                        - (tamp_sic(ig)-pctsrf(ig,is_sic))
    1019             pctsrf_new(ig,is_sic) = tamp_sic(ig)
    1020       endif
    1021     enddo
    1022     if (check) write(*,*)'In ',modname
    1023     if (check) write(*,*)' surface, pctsrf_new',is_oce,pctsrf_new(:,is_oce)
    1024     if (check) write(*,*)' surface, pctsrf_new',is_sic,pctsrf_new(:,is_sic)
    10251048  else if (nisurf == is_sic) then
    1026       call cpl2gath(read_sit, tsurf_new, klon, knon,iim,jjm, knindex)
    1027       call cpl2gath(read_alb_sic, alb_new, klon, knon,iim,jjm, knindex)
     1049    call cpl2gath(read_sit, tsurf_new, klon, knon,iim,jjm, knindex)
     1050    call cpl2gath(read_alb_sic, alb_new, klon, knon,iim,jjm, knindex)
    10281051  endif
     1052  pctsrf_new(:,nisurf) = pctsrf_sav(:,nisurf)
    10291053 
    10301054!  if (lafin) call quitcpl
     
    11321156 
    11331157  if (check) write(*,*)modname,' :: jour_lu, deja_lu', jour_lu, deja_lu
     1158  if (check) write(*,*)modname,' :: itime, lmt_pas ', itime, lmt_pas,dtime
    11341159
    11351160! Tester d'abord si c'est le moment de lire le fichier
     
    13391364! Variables locales
    13401365  integer     :: ii
    1341   integer    :: lmt_pas     ! frequence de lecture des conditions limites
     1366  integer,save :: lmt_pas     ! frequence de lecture des conditions limites
    13421367                             ! (en pas de physique)
    13431368  logical,save :: deja_lu_sur! pour indiquer que le jour a lire a deja
     
    13721397 
    13731398  if (check) write(*,*)modname,':: jour_lu_sur, deja_lu_sur', jour_lu_sur, deja_lu_sur
     1399  if (check) write(*,*)modname,':: itime, lmt_pas', itime, lmt_pas
     1400  call flush(6)
    13741401
    13751402! Tester d'abord si c'est le moment de lire le fichier
     
    15171544  real                  :: bilan_f, fq_fonte
    15181545  real, parameter :: t_grnd = 271.35, t_coup = 273.15
    1519   logical         :: check = .true.
     1546  logical         :: check = .false.
    15201547  character (len = 20)  :: modname = 'calcul_fluxs'
    15211548  logical         :: fonte_neige = .false.
     
    15231550  character (len = 80) :: abort_message
    15241551
    1525   if (check) write(*,*)'Entree ', modname
     1552  if (check) write(*,*)'Entree ', modname,' surface = ',nisurf
    15261553
    15271554  if (size(run_off) /= knon .AND. nisurf == is_ter) then
     
    16851712    tamp(ig) = champ_in(i)
    16861713  enddo   
    1687   champ_out(:,1) = tamp(1)
     1714  ig = 1
     1715  champ_out(:,1) = tamp(ig)
    16881716  do j = 2, jjm
    16891717    do i = 1, iim
    1690       champ_out(i,j) = tamp((j-2)*jjm + i + 1)
     1718      ig = ig + 1
     1719      champ_out(i,j) = tamp(ig)
    16911720    enddo
    16921721  enddo
    1693   champ_out(:,jjm+1) = tamp(klon)
     1722  ig = ig + 1
     1723  champ_out(:,jjm+1) = tamp(ig)
    16941724
    16951725  END SUBROUTINE gath2cpl
     
    17221752  integer                   :: i, ig, j
    17231753  real, dimension(klon)     :: tamp
    1724 
    1725   tamp(1) = champ_in(1,1)
     1754  logical                   :: check = .false.
     1755
     1756  ig = 1
     1757  tamp(ig) = champ_in(1,1)
    17261758  do j = 2, jjm
    17271759    do i = 1, iim
    1728       tamp((j-2)*jjm + i + 1) = champ_in(i,j)
     1760      ig = ig + 1
     1761      tamp(ig) = champ_in(i,j)
    17291762    enddo
    17301763  enddo
    1731   tamp(klon) = champ_in(1,jjm+1)
     1764  ig = ig + 1
     1765  tamp(ig) = champ_in(1,jjm+1)
    17321766
    17331767  do i = 1, knon
Note: See TracChangeset for help on using the changeset viewer.