Changeset 177


Ignore:
Timestamp:
Mar 9, 2001, 4:36:10 PM (24 years ago)
Author:
lmdzadmin
Message:

Lots of stuff, plus particulierement:

  • appel a ORCHIDEE en etat de marche (pb de grille subsiste)
  • modifs de Pascale sur soil dans le cas ou ok_veget=false -
Location:
LMDZ.3.3/branches/rel-LF
Files:
26 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/bibio/initdynav.F

    r79 r177  
    33
    44       USE IOIPSL
     5       USE histcom
    56
    67      implicit none

  • LMDZ.3.3/branches/rel-LF/libf/bibio/initfluxsto.F

    r54 r177  
    44
    55       USE IOIPSL
     6       USE histcom
    67
    78      implicit none

  • LMDZ.3.3/branches/rel-LF/libf/bibio/inithist.F

    r79 r177  
    33
    44       USE IOIPSL
     5       USE histcom
    56
    67      implicit none

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/calfis.F

    r79 r177  
    128128      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqmx)
    129129      REAL zdpsrf(ngridmx)
     130      REAL zcufi(ngridmx),zcvfi(ngridmx)
    130131c
    131132      REAL zsin(iim),zcos(iim),z1(iim)
    … …  
    177178         latfi(1)=rlatu(1)
    178179         lonfi(1)=0.
     180         zcufi(1) = cu(1,1)
     181         zcvfi(1) = cv(1,1)
    179182         DO j=2,jjm
    180183            DO i=1,iim
    181184               latfi((j-2)*iim+1+i)= rlatu(j)
    182185               lonfi((j-2)*iim+1+i)= rlonv(i)
     186               zcufi((j-2)*iim+1+i) = cu(i,j)
     187               zcvfi((j-2)*iim+1+i) = cv(i,j)
    183188            ENDDO
    184189         ENDDO
    185190         latfi(ngridmx)= rlatu(jjp1)
    186191         lonfi(ngridmx)= 0.
     192         zcufi(ngridmx) = cu(1,jjp1)
     193         zcvfi(ngridmx) = cv(1,jjm)
    187194         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
    188195          PRINT*,'WARNING!!! vitesse verticale nulle dans la physique'
    … …  
    430437     ,             presnivs,clesphy0,  zufi, zvfi,ztfi, zqfi, 
    431438ccc     ,             pcvgu, pcvgv, pcvgt, pcvgq,
    432      ,             pvervel,
     439     ,             pvervel, zcufi, zcvfi,
    433440C - sorties
    434441     s             zdufi, zdvfi, zdtfi, zdqfi,zdpsrf              )

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_limit.F

    r173 r177  
    101101      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
    102102      REAL :: flic_tmp(iip1, jjp1)
    103       REAL :: champint(iim, jjp1)
    104103c Diverses variables locales
    105104      REAL time
    … …  
    153152      zmasq(:) = 0.
    154153      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
    155       WHERE (zmasq(1 : klon) .LE. EPSFRA)
     154      WHERE (zmasq(1 : klon) .LT. EPSFRA)
    156155          zmasq(1 : klon) = 0.
     156      END WHERE
     157      WHERE (1 - zmasq(1 : klon) .LT. EPSFRA)
     158          zmasq(1 : klon) = 1.
    157159      END WHERE
    158160!      WRITE(*,*)zmasq
    … …  
    169171          END DO
    170172      ENDIF
    171       DO i = 1, iim
     173c$$$      DO i = 1, iim
     174c$$$      DO j = 1, jjp1
     175c$$$         mask(i,j) = masque(i,j)
     176c$$$      ENDDO
     177c$$$      ENDDO
     178c$$$      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
     179      phy_nat0(1:klon) = zmasq(1:klon)
     180      mask = 0.
    172181      DO j = 1, jjp1
    173          mask(i,j) = masque(i,j)
    174       ENDDO
    175       ENDDO
    176       CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
     182        DO i = 1, iim
     183          IF ( masque(i,j) .GE. EPSFRA) mask (i,j) = 1
     184        END DO
     185      END DO 
    177186C
    178187C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
    … …  
    275284     $    pctsrf(1:klon, is_lic))
    276285C adequation avec le maque terre/mer
    277       WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA )
     286      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA )
    278287          pctsrf(1 : klon, is_lic) = 0.
    279288      END WHERE
    280       WHERE (zmasq( 1 : klon) .LE. EPSFRA)
     289      WHERE (zmasq( 1 : klon) .LT. EPSFRA)
    281290          pctsrf(1 : klon, is_lic) = 0.
    282291      END WHERE
    … …  
    289298            ELSE
    290299                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
     300                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
     301                    pctsrf(ji,is_ter) = 0.
     302                    pctsrf(ji, is_lic) = zmasq(ji)
     303                ENDIF
    291304            ENDIF
    292305        ENDIF
    … …  
    557570CPB  en attendant de mettre fraction de terre
    558571c
    559           WHERE(phy_ice(1:klon) .GT. 1.) phy_ice(1 : klon) = 1.
     572          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
    560573          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
    561574c
    … …  
    564577            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
    565578            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
     579            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon)
     580     $            - pctsrf_t(1:klon,is_lic,k)
     581c§§ Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
     582            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
     583                pctsrf_t(1:klon,is_sic,k) = 0.
     584            END WHERE
     585            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
     586                pctsrf_t(1:klon,is_sic,k) = 0.
     587                pctsrf_t(1:klon,is_oce,k) = 0.
     588            END WHERE
    566589            DO i = 1, klon
    567               pctsrf_t(i,is_sic,k) = (1. - pctsrf_t(i,is_lic,k) -
    568      .                               pctsrf_t(i,is_ter,k)) * phy_ice(i)
    569               pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_lic,k) -
    570      .                      pctsrf_t(i,is_ter,k) - pctsrf_t(i,is_sic,k) 
     590c$$              pctsrf_t(i,is_sic,k) = (1. - pctsrf_t(i,is_lic,k) -
     591c$$     .                               pctsrf_t(i,is_ter,k)) * phy_ice(i)
     592c$$              pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_lic,k) -
     593c$$     .                      pctsrf_t(i,is_ter,k) - pctsrf_t(i,is_sic,k)
     594              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
     595                  IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
     596                      pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
     597                      pctsrf_t(i,is_oce,k) = 0.
     598                  ELSE
     599                      pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
     600     $                    - pctsrf_t(i,is_sic,k)
     601                      IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
     602                          pctsrf_t(i,is_oce,k) = 0.
     603                          pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
     604                      ENDIF
     605                  ENDIF
     606              ENDIF 
    571607              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
    572                       WRITE(*,*) 'pb sous maille au point : i,k '
    573      $                    , i,k,pctsrf_t(:,is_oce,k)
     608                  WRITE(*,*) 'pb sous maille au point : i,k '
     609     $                , i,k,pctsrf_t(:,is_oce,k)
     610              ENDIF
     611              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
     612     $            pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.)
     613     $            .GT. EPSFRA) THEN
     614                  WRITE(*,*) 'physiq : pb sous surface au point ', i,
     615     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
    574616              ENDIF
    575617            END DO
    576           ELSE
     618        ELSE
    577619            DO i = 1, klon
    578620              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
    … …  
    750792      ENDDO
    751793c
     794      WHERE(phy_sst .LT. 271.35) phy_sst = 271.35
    752795      ierr = NF_CLOSE(ncid)
    753796c

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/defrun_new.F

    r2 r177  
    7575c-----------------------------------------------------------------------
    7676
    77       OPEN( tapedef,file ='run.def',status='old',form='formatted')
     77      OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
    7878
    7979

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r174 r177  
    186186      zmasq(:) = 0.
    187187      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
    188       WHERE (zmasq(1 : klon) .LE. EPSFRA)
     188      WHERE (zmasq(1 : klon) .LT. EPSFRA)
    189189          zmasq(1 : klon) = 0.
     190      END WHERE
     191      WHERE (1. - zmasq(1 : klon) .LT. EPSFRA)
     192          zmasq(1 : klon) = 1.
    190193      END WHERE
    191194      WRITE(*,*)zmasq
    … …  
    434437     $    pctsrf(1:klon, is_lic))
    435438C adequation avec le maque terre/mer
    436       WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA )
     439c      zmasq(157) = 0.
     440      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA )
    437441          pctsrf(1 : klon, is_lic) = 0.
    438442      END WHERE
    439       WHERE (zmasq( 1 : klon) .LE. EPSFRA)
     443      WHERE (zmasq( 1 : klon) .LT. EPSFRA)
    440444          pctsrf(1 : klon, is_lic) = 0.
    441445      END WHERE
    … …  
    448452            ELSE
    449453                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
     454                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
     455                    pctsrf(ji,is_ter) = 0.
     456                    pctsrf(ji, is_lic) = zmasq(ji)
     457                ENDIF
    450458            ENDIF
    451459        ENDIF
    … …  
    558566      albe(:,is_sic) = 0.6
    559567      evap(:,:) = 0.
    560       qsolsrf(:,is_ter) = qsol
    561       qsolsrf(:,is_lic) = qsol
     568      qsolsrf(:,is_ter) = 150
     569      qsolsrf(:,is_lic) = 150
    562570      qsolsrf(:,is_oce) = 150.
    563571      qsolsrf(:,is_sic) = 150.
    … …  
    577585      frugs(:,is_ter) = rugmer
    578586      frugs(:,is_lic) = rugmer
    579       frugs(:,is_sic) = rugmer
     587      frugs(:,is_sic) = 0.001
    580588
    581589      call physdem("startphy.nc",phystep,radpas, co2_ppm, solaire,

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/gcm.F

    r113 r177  
    358358     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    359359     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
     360      write(47,*)'dp apres caldyn'
     361      write(47,*)dp
    360362
    361363c-----------------------------------------------------------------------

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/grid_noro.F

    r99 r177  
    332332c angle theta:
    333333           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
    334 c$$$           zphi(ii,jj)=zmea(ii,jj)
     334           zphi(ii,jj)=zmea(ii,jj)
    335335c$$$           zmea(ii,jj)=zmea(ii,jj)
    336336c$$$           zpic(ii,jj)=zpic(ii,jj)

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/startvar.F

    r99 r177  
     1! $Header$
    12      MODULE startvar
    23    !
    … …  
    319320     $    phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
    320321      phis = phis * 9.81
     322!      write(*,*)'phis sortie grid_noro'
     323!      write(*,*)phis
    321324    !
    322325    !PB supression ligne suivant pour masque avec % terre

  • LMDZ.3.3/branches/rel-LF/libf/filtrez/parafilt.h

    r2 r177  
    44c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
    55c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
    6          PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
     6c        PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
    77c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
    88cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
    … …  
    1717c
    1818c 96 72 19 non-zoom:
    19 ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
     19      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
    2020c
    2121c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )

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

    r171 r177  
    33     .                  jour, rmu0,
    44     .                  ok_veget, ocean, npas, nexca, ts,
    5      .                  paprs,pplay,radsol,snow,qsol,evap,albe,
    6      .                  rain_f, snow_f, solsw, sollw, fder,
     5     .                  soil_model,ftsoil,
     6     .                  paprs,pplay,radsol,snow,qsol,evap,albe,fluxlat,
     7     .                  rain_f, snow_f, solsw, sollw, sollwdown, fder,
    78     .                  rlon, rlat, cufi, cvfi, rugos,
    89     .                  debut, lafin, agesno,rugoro,
    … …  
    4546c rlat-----input-R- latitude en degree
    4647c rugos----input-R- longeur de rugosite (en m)
     48c cufi-----input-R- resolution des mailles en x (m)
     49c cvfi-----input-R- resolution des mailles en y (m)
    4750c
    4851c d_t------output-R- le changement pour "t"
    … …  
    5659c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
    5760c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
    58 c rugmer---output-R- longeur de rugosite sur mer (m)
    5961c dflux_t derive du flux sensible
    6062c dflux_q derive du flux latent
    … …  
    7072#include "dimphy.h"
    7173#include "indicesol.h"
    72 c
     74c$$$ PB ajout pour soil
     75#include "dimsoil.h"
    7376c
    7477      REAL dtime
    … …  
    102105      REAL evap(klon,nbsrf)
    103106      REAL albe(klon,nbsrf)
     107c$$$ PB
     108      REAL fluxlat(klon,nbsrf)
     109C
    104110      real rain_f(klon), snow_f(klon)
    105111      REAL fder(klon)
    106       REAL sollw(klon), solsw(klon)
     112      REAL sollw(klon), solsw(klon), sollwdown(klon)
    107113      REAL rugos(klon,nbsrf)
    108114C la nouvelle repartition des surfaces sortie de l'interface
    … …  
    113119      REAL zv1(klon)
    114120cAA
     121c$$$ PB ajout pour soil
     122      LOGICAL soil_model
     123      REAL ftsoil(klon,nsoilmx,nbsrf)
     124      REAL ytsoil(klon,nsoilmx)
    115125c======================================================================
    116126      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac
    … …  
    121131      real ysnow(klon), yqsol(klon)
    122132      real yrain_f(klon), ysnow_f(klon)
    123       real ysollw(klon), ysolsw(klon)
     133      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
    124134      real yfder(klon), ytaux(klon), ytauy(klon)
    125135      REAL yrugm(klon), yrads(klon),yrugoro(klon)
     136c$$$ PB
     137      REAL yfluxlat(klon)
     138C
    126139      REAL y_d_ts(klon)
    127140      REAL y_d_t(klon, klev), y_d_q(klon, klev)
    … …  
    197210      ysolsw = 0.0
    198211      ysollw = 0.0
     212      ysollwdown = 0.0
    199213      yrugos = 0.0
    200214      yu1 = 0.0
    … …  
    212226      y_flux_u = 0.0
    213227      y_flux_v = 0.0
     228      ytsoil = 0.0
    214229
    215230      DO nsrf = 1, nbsrf
    … …  
    219234      END DO
    220235C§§§ PB
     236      yfluxlat=0.
    221237      flux_t = 0.
    222238      flux_q = 0.
    … …  
    254270
    255271      pctsrf_pot = pctsrf
    256       pctsrf_pot(:,is_sic) = pctsrf(:,is_oce)
     272      pctsrf_pot(:,is_oce) = 1. - zmasq(:)
     273      pctsrf_pot(:,is_sic) = 1. - zmasq(:)
    257274
    258275      DO 99999 nsrf = 1, nbsrf
    259       totalflu = radsol
     276c$$$   PB   totalflu = radsol
    260277
    261278c chercher les indices:
    … …  
    274291      ENDDO
    275292c
     293      write(*,*)'CLMAIN, nsrf, knon =',nsrf, knon
    276294      IF (knon.EQ.0) GOTO 99999
    277295      DO j = 1, knon
    … …  
    290308        ysolsw(j) = solsw(i)
    291309        ysollw(j) = sollw(i)
     310        ysollwdown(j) = sollwdown(i)
    292311        yrugos(j) = rugos(i,nsrf)
    293312        yrugoro(j) = rugoro(i)
    294313        yu1(j) = u1lay(i)
    295314        yv1(j) = v1lay(i)
    296         yrads(j) = totalflu(i)
     315c$$$    PB    yrads(j) = totalflu(i)
     316        yrads(j) = (1 - albe(i,nsrf))
     317     $      /(1 - pctsrf(i,is_ter) * albe(i,is_ter)
     318     $      - pctsrf(i, is_lic) *albe(i,is_lic)
     319     $      - pctsrf(i, is_oce) *albe(i,is_oce)
     320     $      - pctsrf(i, is_sic) *albe(i,is_sic)
     321     $      ) * solsw(i) + sollw(i)
    297322        ypaprs(j,klev+1) = paprs(i,klev+1)
    298       ENDDO
     323      END DO
     324c$$$ PB ajour pour soil
     325      DO k = 1, nsoilmx
     326        DO j = 1, knon
     327          i = ni(j)
     328          ytsoil(j,k) = ftsoil(i,k,nsrf)
     329        END DO 
     330      END DO
    299331      DO k = 1, klev
    300332      DO j = 1, knon
    … …  
    339371     e          rlon, rlat, cufi, cvfi,
    340372     e          knon, nsrf, ni, pctsrf,
     373     e          soil_model, ytsoil,
    341374     e          ok_veget, ocean, npas, nexca,
    342375     e          rmu0, yrugos, yrugoro,
    … …  
    345378     e          ydelp,yrads, yevap,yalb, ysnow, yqsol,
    346379     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
    347      e          ysollw, ysolsw,
     380c$$$     e          ysollw, ysolsw,
     381     e          ysollw, ysollwdown, ysolsw,yfluxlat,
    348382     s          pctsrf_new, agesno,
    349383     s          y_d_t, y_d_q, y_d_ts, yz0_new,
    … …  
    384418        ENDDO
    385419      ENDDO
     420     
    386421
    387422      evap(:,nsrf) = - flux_q(:,1,nsrf)
    … …  
    394429         qsol(i,nsrf) = yqsol(j)
    395430         rugos(i,nsrf) = yz0_new(j)
    396          rugmer(i) = yrugm(j)
     431         fluxlat(i,nsrf) = yfluxlat(j)
     432c$$$ pb         rugmer(i) = yrugm(j)
     433         IF (nsrf .EQ. is_oce) rugmer(i) = yrugm(j)
    397434         cdragh(i) = cdragh(i) + ycoefh(j,1)
    398435         cdragm(i) = cdragm(i) + ycoefm(j,1)
    … …  
    401438         zu1(i) = zu1(i) + yu1(j)
    402439         zv1(i) = zv1(i) + yv1(j)
    403       ENDDO
     440      END DO
     441c$$$ PB ajout pour soil
     442      DO k = 1, nsoilmx
     443        DO j = 1, knon
     444          i = ni(j)
     445          ftsoil(i, k, nsrf) = ytsoil(j,k)
     446        END DO
     447      END DO
    404448c
    405449#ifdef CRAY
    … …  
    438482     e                rlon, rlat, cufi, cvfi,
    439483     e                knon, nisurf, knindex, pctsrf,
     484     $                soil_model,tsoil,
    440485     e                ok_veget, ocean, npas, nexca,
    441486     e                rmu0, rugos, rugoro,
    … …  
    444489     e                delp,radsol,evap,albedo,snow,qsol,
    445490     e                precip_rain, precip_snow, fder, taux, tauy,
    446      e                lwdown, swdown,
     491c$$$     e                lwdown, swdown,
     492     $                sollw, sollwdown, swdown,fluxlat,
    447493     s                pctsrf_new, agesno,
    448494     s                d_t, d_q, d_ts, z0_new,
    … …  
    462508#include "FCTTRE.h"
    463509#include "indicesol.h"
     510#include "dimsoil.h"
    464511c Arguments:
    465512      INTEGER knon
    … …  
    542589      real fder(klon), taux(klon), tauy(klon)
    543590      real temp_air(klon), spechum(klon)
    544       real hum_air(klon), ccanopy(klon)
     591      real epot_air(klon), ccanopy(klon)
    545592      real tq_cdrag(klon), petAcoef(klon), peqAcoef(klon)
    546593      real petBcoef(klon), peqBcoef(klon)
    547       real lwdown(klon), swnet(klon), swdown(klon)
     594      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
    548595      real p1lay(klon)
     596c$$$C PB ajout pour soil
     597      LOGICAL soil_model
     598      REAL tsoil(klon, nsoilmx)
    549599
    550600! Parametres de sortie
    … …  
    553603      real emis_new(klon), z0_new(klon)
    554604      real pctsrf_new(klon,nbsrf)
     605     
    555606c
    556607
    … …  
    669720        tq_cdrag=coef(:,1)
    670721        temp_air=t(:,1)
     722        epot_air=local_h(:,1)
    671723        spechum=q(:,1)
    672724        p1lay = pplay(:,1)
    … …  
    675727c      enddo
    676728c En attendant mieux
    677       hum_air = 0.
    678       ccanopy = 0.
     729      ccanopy = 365.
    679730
    680731      CALL interfsurf(itime, dtime, jour, rmu0,
    681      e klon, iim, jjm, nisurf, knon, knindex, pctsrf, rlon, rlat,
    682      e debut, lafin, ok_veget,
    683      e zlev1,  u1lay, v1lay, temp_air, spechum, hum_air, ccanopy,
     732     e klon, iim, jjm, nisurf, knon, knindex, pctsrf,
     733     e rlon, rlat, cufi, cvfi,
     734     e debut, lafin, ok_veget, soil_model, nsoilmx,tsoil,
     735     e zlev1,  u1lay, v1lay, temp_air, spechum, epot_air, ccanopy,
    684736     e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
    685      e precip_rain, precip_snow, lwdown, swnet, swdown,
     737     e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown,
    686738     e fder, taux, tauy, rugos, rugoro,
    687739     e albedo, snow, qsol,
    … …  
    691743     s tsol_rad, tsurf_new, alb_new, emis_new, z0_new,
    692744     s pctsrf_new, agesno)
     745
    693746
    694747      do i = 1, knon
    … …  
    10441097         ENDIF
    10451098      ENDDO
     1099
    10461100c
    10471101c Calculer les coefficients turbulents dans l'atmosphere

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

    r2 r177  
    5151         jbad = 0
    5252         DO i = 1, klon
    53          IF (zt(i).LT.100.0) THEN
     53!         IF (zt(i).LT.100.0) THEN
     54         IF (zt(i).LT.50.0) THEN
    5455            jbad = jbad + 1
    5556            jadrs(jbad) = i
    … …  
    9192         jbad = 0
    9293         DO i = 1, klon
    93          IF (zt(i).LT.100.0) THEN
     94!         IF (zt(i).LT.100.0) THEN
     95         IF (zt(i).LT.50.0) THEN
    9496            jbad = jbad + 1
    9597            jadrs(jbad) = i

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

    r171 r177  
    4141! run_off      ruissellement total
    4242  real, allocatable, dimension(:),save    :: run_off
    43 
     43  real, allocatable, dimension(:),save    :: coastalflow, riverflow
    4444
    4545
    … …  
    4949!
    5050  SUBROUTINE interfsurf_hq(itime, dtime, jour, rmu0, &
    51       & klon, iim, jjm, nisurf, knon, knindex, pctsrf, rlon, rlat, &
    52       & debut, lafin, ok_veget, &
    53       & zlev,  u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
     51      & klon, iim, jjm, nisurf, knon, knindex, pctsrf, &
     52      & rlon, rlat, cufi, cvfi,&
     53      & debut, lafin, ok_veget, soil_model, nsoilmx, tsoil,&
     54      & zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
    5455      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    55       & precip_rain, precip_snow, lwdown, swnet, swdown, &
     56      & precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, &
    5657      & fder, taux, tauy, rugos, rugoro, &
    5758      & albedo, snow, qsol, &
    … …  
    8485!   rlon         longitudes
    8586!   rlat         latitudes
     87!   cufi,cvfi    resolution des mailles en x et y (m)
    8688!   debut        logical: 1er appel a la physique
    8789!   lafin        logical: dernier appel a la physique
    … …  
    9395!   temp_air     temperature de l'air 1ere couche
    9496!   spechum      humidite specifique 1ere couche
    95 !   hum_air      humidite de l'air
     97!   epot_air     temp potentielle de l'air
    9698!   ccanopy      concentration CO2 canopee
    9799!   tq_cdrag     cdrag
    … …  
    102104!   precip_rain  precipitation liquide
    103105!   precip_snow  precipitation solide
    104 !   lwdown       flux IR entrant a la surface
     106!   sollw        flux IR net a la surface
     107!   sollwdown    flux IR descendant a la surface
    105108!   swnet        flux solaire net
    106109!   swdown       flux solaire entrant a la surface
    … …  
    142145  logical, intent(IN) :: debut, lafin, ok_veget
    143146  real, dimension(klon), intent(IN) :: rlon, rlat
     147  real, dimension(klon), intent(IN) :: cufi, cvfi
     148  real, dimension(klon), intent(INOUT) :: tq_cdrag
    144149  real, dimension(klon), intent(IN) :: zlev
    145150  real, dimension(klon), intent(IN) :: u1_lay, v1_lay
    146151  real, dimension(klon), intent(IN) :: temp_air, spechum
    147   real, dimension(klon), intent(IN) :: hum_air, ccanopy
    148   real, dimension(klon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
     152  real, dimension(klon), intent(IN) :: epot_air, ccanopy
     153  real, dimension(klon), intent(IN) :: petAcoef, peqAcoef
    149154  real, dimension(klon), intent(IN) :: petBcoef, peqBcoef
    150155  real, dimension(klon), intent(IN) :: precip_rain, precip_snow
    151   real, dimension(klon), intent(IN) :: lwdown, swnet, swdown, ps, albedo
     156  real, dimension(klon), intent(IN) :: sollw, sollwdown, swnet, swdown
     157  real, dimension(klon), intent(IN) :: ps, albedo
    152158  real, dimension(klon), intent(IN) :: tsurf, p1lay
    153   real, dimension(klon), intent(IN) :: radsol
     159  real, dimension(klon), intent(INOUT) :: radsol
    154160  real, dimension(klon), intent(IN) :: zmasq
    155161  real, dimension(klon), intent(IN) :: fder, taux, tauy, rugos, rugoro
    … …  
    157163  integer              :: npas, nexca ! nombre et pas de temps couplage
    158164  real, dimension(klon), intent(INOUT) :: evap, snow, qsol
    159 
     165!! PB ajout pour soil
     166  logical          :: soil_model
     167  integer          :: nsoilmx
     168  REAL, DIMENSION(klon, nsoilmx) :: tsoil
     169  REAL, dimension(klon)          :: soilcap
     170  REAL, dimension(klon)          :: soilflux
    160171! Parametres de sortie
    161172  real, dimension(klon), intent(OUT):: fluxsens, fluxlat
    … …  
    173184  logical              :: check = .true.
    174185  real, dimension(klon):: cal, beta, dif_grnd, capsol
    175   real, parameter      :: calice=1.0/(5.1444e+06*0.15), tau_gl=1./86400.*5.
     186!!$PB  real, parameter      :: calice=1.0/(5.1444e+06*0.15), tau_gl=86400.*5.
     187  real, parameter      :: calice=1.0/(5.1444e+06*0.15), tau_gl=86400.*5.
    176188  real, parameter      :: calsno=1./(2.3867e+06*.15)
    177189  real, dimension(klon):: alb_ice
    … …  
    180192  real, dimension(klon):: alb_neig, alb_eau
    181193  real, DIMENSION(klon):: zfra
     194  logical              :: cumul = .false.
    182195
    183196  if (check) write(*,*) 'Entree ', modname
    … …  
    228241!
    229242! allocation du run-off
    230     if (.not. allocated(run_off)) then
     243    if (.not. allocated(coastalflow)) then
     244      allocate(coastalflow(knon), stat = error)
     245      if (error /= 0) then
     246        abort_message='Pb allocation coastalflow'
     247        call abort_gcm(modname,abort_message,1)
     248      endif
     249      allocate(riverflow(knon), stat = error)
     250      if (error /= 0) then
     251        abort_message='Pb allocation riverflow'
     252        call abort_gcm(modname,abort_message,1)
     253      endif
    231254      allocate(run_off(knon), stat = error)
    232255      if (error /= 0) then
    233         abort_message='Pb allocation run_off'
    234         call abort_gcm(modname,abort_message,1)
    235       endif
    236     else if (size(run_off) /= knon) then
     256        abort_message='Pb allocation runoff'
     257        call abort_gcm(modname,abort_message,1)
     258      endif
     259    else if (size(coastalflow) /= knon) then
    237260      write(*,*)'Bizarre, le nombre de points continentaux'
    238       write(*,*)'a change entre deux appels. Je continue ...'
     261      write(*,*)'a change entre deux appels. J''arrete ...'
     262      abort_message='voir ci-dessus'
     263      call abort_gcm(modname,abort_message,1)
     264      deallocate(coastalflow, stat = error)
     265      allocate(coastalflow(knon), stat = error)
     266      if (error /= 0) then
     267        abort_message='Pb allocation coastalflow'
     268        call abort_gcm(modname,abort_message,1)
     269      endif
     270      deallocate(riverflow, stat = error)
     271      allocate(riverflow(knon), stat = error)
     272      if (error /= 0) then
     273        abort_message='Pb allocation riverflow'
     274        call abort_gcm(modname,abort_message,1)
     275      endif
    239276      deallocate(run_off, stat = error)
    240277      allocate(run_off(knon), stat = error)
    … …  
    248285! Calcul age de la neige
    249286!
    250 
    251   CALL albsno(klon,agesno,alb_neig_grid) 
    252  
    253  
     287!!$ PB ATTENTION changement ordre des appels
     288!!$   CALL albsno(klon,agesno,alb_neig_grid) 
     289 
    254290 
    255291    if (.not. ok_veget) then
    256 !
    257 ! calcul snow et qsol, hydrol adapté
    258 !
    259       call calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
    260 !      if (check) write(*,*)'Sortie calbeta'
    261 !      if (check) write(*,*)'RCPD = ',RCPD,' capsol = '
    262 !      if (check) write(*,*)capsol
    263       cal = RCPD * capsol
    264       call calcul_fluxs( klon, knon, nisurf, dtime, &
    265      &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
    266      &   precip_rain, precip_snow, snow, qsol,  &
    267      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    268      &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    269      &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    270 
    271292!
    272293! calcul albedo: lecture albedo fichier CL puis ajout albedo neige
    … …  
    283304       alb_new = alb_neig*zfra + alb_new*(1.0-zfra)
    284305       z0_new = SQRT(z0_new**2+rugoro**2)
     306!
     307       CALL albsno(klon,agesno,alb_neig_grid) 
     308 
     309! calcul snow et qsol, hydrol adapté
     310!
     311       IF (soil_model) THEN
     312           CALL soil(dtime, nisurf, snow, tsurf, tsoil,soilcap, soilflux)
     313           cal = RCPD / soilcap
     314           radsol = radsol + soilflux
     315       ELSE
     316           CALL calbeta(dtime, nisurf, knon, snow, qsol, beta, capsol, dif_grnd)
     317!      if (check) write(*,*)'Sortie calbeta'
     318!      if (check) write(*,*)'RCPD = ',RCPD,' capsol = '
     319!      if (check) write(*,*)capsol
     320           cal = RCPD * capsol
     321!!$      cal = capsol
     322       ENDIF
     323       CALL calcul_fluxs( klon, knon, nisurf, dtime, &
     324     &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
     325     &   precip_rain, precip_snow, snow, qsol,  &
     326     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
     327     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
     328     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     329
    285330    else
     331        CALL albsno(klon,agesno,alb_neig_grid) 
    286332!
    287333!  appel a sechiba
    288334!
    289335      call interfsol(itime, klon, dtime, nisurf, knon, &
    290      &  knindex, rlon, rlat, &
     336     &  knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
    291337     &  debut, lafin, ok_veget, &
    292      &  zlev,  u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
     338     &  zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
    293339     &  tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    294      &  precip_rain, precip_snow, lwdown, swnet, swdown, &
    295      &  tsurf, p1lay, ps, radsol, &
     340     &  precip_rain, precip_snow, sollwdown, swnet, swdown, &
     341     &  tsurf, p1lay/100., ps, radsol, &
    296342     &  evap, fluxsens, fluxlat, &             
    297343     &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
    … …  
    317363      endif
    318364
    319       call interfoce(itime, dtime, &
     365      cumul = .false.
     366
     367      call interfoce(itime, dtime, cumul, &
    320368      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    321369      & ocean, npas, nexca, debut, lafin, &
    322       & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    323       & fder, albedo, taux, tauy, zmasq, &
     370      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
     371      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    324372      & tsurf_new, alb_new, alb_ice, pctsrf_new)
    325373
    … …  
    345393     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    346394     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     395
     396!
     397! 2eme appel a interfoce pour le cumul des champs (en particulier
     398! fluxsens et fluxlat calcules dans calcul_fluxs)
     399!
     400    if (ocean == 'couple') then
     401
     402      cumul = .true.
     403
     404      call interfoce(itime, dtime, cumul, &
     405      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
     406      & ocean, npas, nexca, debut, lafin, &
     407      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
     408      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
     409      & tsurf_new, alb_new, alb_ice, pctsrf_new)
     410
     411!    else if (ocean == 'slab  ') then
     412!      call interfoce(nisurf)
     413
     414    endif
     415
    347416!
    348417! calcul albedo
    … …  
    370439    if (ocean == 'couple') then
    371440
    372       call interfoce(itime, dtime, &
     441      cumul =.false.
     442
     443      call interfoce(itime, dtime, cumul, &
    373444      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    374445      & ocean, npas, nexca, debut, lafin, &
    375       & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    376       & fder, albedo, taux, tauy, zmasq, &
     446      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
     447      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    377448      & tsurf_new, alb_new, alb_ice, pctsrf_new)
    378449
    379450      tsurf_temp = tsurf_new
     451      cal = 0.
    380452      dif_grnd = 0.
    381453      beta = 1.0
    … …  
    390462
    391463      tsurf_temp = tsurf
    392       dif_grnd = 1.0 / tau_gl
    393       beta = 1.0
    394     endif
    395 
    396     cal = calice
    397     where (snow > 0.0) cal = calsno
     464           dif_grnd = 1.0 / tau_gl
     465           beta = 1.0
     466           cal = RCPD * calice
     467           WHERE (snow > 0.0) cal = RCPD * calsno
     468    endif
    398469
    399470    call calcul_fluxs( klon, knon, nisurf, dtime, &
    … …  
    405476
    406477!
     478! 2eme appel a interfoce pour le cumul et le passage des flux a l'ocean
     479!
     480    if (ocean == 'couple') then
     481
     482      cumul =.true.
     483
     484      call interfoce(itime, dtime, cumul, &
     485      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
     486      & ocean, npas, nexca, debut, lafin, &
     487      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
     488      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
     489      & tsurf_new, alb_new, alb_ice, pctsrf_new)
     490
     491!    else if (ocean == 'slab  ') then
     492!      call interfoce(nisurf)
     493
     494    endif
     495
     496!
    407497! calcul albedo
    408498!
    … …  
    413503    alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    414504
    415     z0_new = rugos
     505    z0_new = 0.001
    416506
    417507  else if (nisurf == is_lic) then
    … …  
    423513!
    424514!    call interfsol(nisurf)
    425 
    426     cal = calice
    427     where (snow > 0.0) cal = calsno
     515    IF (soil_model) THEN
     516        CALL soil(dtime, nisurf, snow, tsurf, tsoil,soilcap, soilflux)
     517        cal = RCPD / soilcap
     518        radsol = radsol + soilflux
     519    ELSE
     520        cal = RCPD * calice
     521        WHERE (snow > 0.0) cal = RCPD * calsno
     522    ENDIF
    428523    beta = 1.0
    429524    dif_grnd = 0.0
    … …  
    490585!
    491586  SUBROUTINE interfsol(itime, klon, dtime, nisurf, knon, &
    492      & knindex, rlon, rlat, &
     587     & knindex, rlon, rlat, cufi, cvfi, iim, jjm, pctsrf, &
    493588     & debut, lafin, ok_veget, &
    494      & zlev,  u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
     589     & zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
    495590     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    496591     & precip_rain, precip_snow, lwdown, swnet, swdown, &
    … …  
    498593     & evap, fluxsens, fluxlat, &             
    499594     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
     595
     596  USE intersurf
    500597
    501598! Cette routine sert d'interface entre le modele atmospherique et le
    … …  
    513610!   rlon         longitudes de la grille entiere
    514611!   rlat         latitudes de la grille entiere
     612!   pctsrf       tableau des fractions de surface de chaque maille
    515613!   debut        logical: 1er appel a la physique (lire les restart)
    516614!   lafin        logical: dernier appel a la physique (ecrire les restart)
    … …  
    522620!   temp_air     temperature de l'air 1ere couche
    523621!   spechum      humidite specifique 1ere couche
    524 !   hum_air      humidite de l'air
     622!   epot_air     temp pot de l'air
    525623!   ccanopy      concentration CO2 canopee
    526624!   tq_cdrag     cdrag
    … …  
    531629!   precip_rain  precipitation liquide
    532630!   precip_snow  precipitation solide
    533 !   lwdown       flux IR entrant a la surface
     631!   lwdown       flux IR descendant a la surface
    534632!   swnet        flux solaire net
    535633!   swdown       flux solaire entrant a la surface
    … …  
    560658  integer, intent(IN) :: nisurf
    561659  integer, intent(IN) :: knon
     660  integer, intent(IN) :: iim, jjm
    562661  integer, dimension(klon), intent(IN) :: knindex
    563662  logical, intent(IN) :: debut, lafin, ok_veget
     663  real, dimension(klon,nbsrf), intent(IN) :: pctsrf
    564664  real, dimension(klon), intent(IN) :: rlon, rlat
     665  real, dimension(klon), intent(IN) :: cufi, cvfi
    565666  real, dimension(klon), intent(IN) :: zlev
    566667  real, dimension(klon), intent(IN) :: u1_lay, v1_lay
    567668  real, dimension(klon), intent(IN) :: temp_air, spechum
    568   real, dimension(klon), intent(IN) :: hum_air, ccanopy
    569   real, dimension(klon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
     669  real, dimension(klon), intent(IN) :: epot_air, ccanopy
     670  real, dimension(klon), intent(INOUT) :: tq_cdrag
     671  real, dimension(klon), intent(IN) :: petAcoef, peqAcoef
    570672  real, dimension(klon), intent(IN) :: petBcoef, peqBcoef
    571673  real, dimension(klon), intent(IN) :: precip_rain, precip_snow
    … …  
    581683! Local
    582684!
    583   integer              :: ii
     685  integer              :: ii, ij, jj, igrid, ireal, i, index
    584686  integer              :: error
    585687  character (len = 20) :: modname = 'interfsol'
    … …  
    595697! pts voisins
    596698  integer,allocatable, dimension(:,:), save :: neighbours
     699! fractions continents
     700  real,allocatable, dimension(:), save :: contfrac
    597701! resolution de la grille
    598702  real, allocatable, dimension (:,:), save :: resolution
     703! correspondance point n -> indices (i,j)
     704  integer, allocatable, dimension(:,:), save :: correspond
     705! offset pour calculer les point voisins
     706  integer, dimension(8,3), save :: off_ini
     707  integer, dimension(8), save :: offset
    599708! Identifieurs des fichiers restart et histoire
    600709  integer, save          :: rest_id, hist_id
    601710  integer, save          :: rest_id_stom, hist_id_stom
    602 
     711!
     712  real, allocatable, dimension (:,:), save :: lon_scat, lat_scat 
     713
     714  logical                :: lrestart_read = .true. , lrestart_write = .true.
     715
     716  real, dimension(klon):: qsurf
    603717  real, dimension(klon):: snow, qsol
     718  real                 :: date0 = 0.
     719  real, dimension(knon,2) :: albedo_out
     720! Pb de nomenclature
     721  real, dimension(klon) :: petA_orc, peqA_orc
     722  real, dimension(klon) :: petB_orc, peqB_orc
    604723
    605724  if (check) write(*,*)'Entree ', modname
    … …  
    607726
    608727! initialisation
    609 !    if (debut) then
    610 !      !
    611 !      ! Configuration de parametres specifiques a la SSL
    612 !      !
    613 !      call intsurf_config(control_in)
    614 !      !
    615 !      ! Allouer et initialiser le tableau de coordonnees du sol
    616 !      !
    617 !      if (( .not. allocated(lalo))) then
    618 !        allocate(lalo(knon,2), stat = error)
    619 !        if (error /= 0) then
    620 !          abort_message='Pb allocation lalo'
    621 !          call abort_gcm(modname,abort_message,1)
    622 !        endif     
    623 !      endif
    624 !      do ii = 1, knon
    625 !        lalo(ii,1) = rlat(knindex(ii))
    626 !        lalo(ii,2) = rlon(knindex(ii))
    627 !      enddo
    628       !-
    629       !- Compute variable to help describe the grid
    630       !- once the points are gathered.
    631       !-
    632 !      IF ( (.NOT.ALLOCATED(neighbours))) THEN
    633 !        ALLOCATE(neighbours(knon,4), stat = error)
    634 !        if (error /= 0) then
    635 !          abort_message='Pb allocation neighbours'
    636 !          call abort_gcm(modname,abort_message,1)
    637 !        endif
    638 !      ENDIF
    639 !      IF ( (.NOT.ALLOCATED(resolution))) THEN
    640 !        ALLOCATE(resolution(knon,2), stat = error)
    641 !        if (error /= 0) then
    642 !          abort_message='Pb allocation resolution'
    643 !          call abort_gcm(modname,abort_message,1)
    644 !        endif
    645 !      ENDIF
    646 
    647 ! call grid_stuff
    648 ! call sechiba_restart_init
    649 ! call sechiba_history_init
    650 
    651 !    endif                          ! (fin debut)
     728  if (debut) then
     729
     730!
     731!  Initialisation des offset   
     732!
     733! offset bord ouest
     734   off_ini(1,1) = - iim  ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
     735   off_ini(4,1) = iim + 1; off_ini(5,1) = iim      ; off_ini(6,1) = 2 * iim - 1
     736   off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
     737! offset point normal
     738   off_ini(1,2) = - iim  ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
     739   off_ini(4,2) = iim + 1; off_ini(5,2) = iim      ; off_ini(6,2) = iim - 1
     740   off_ini(7,2) = -1     ; off_ini(8,2) = - iim - 1
     741! offset bord   est
     742   off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
     743   off_ini(4,3) =  1   ; off_ini(5,3) = iim          ; off_ini(6,3) = iim - 1
     744   off_ini(7,3) = -1   ; off_ini(8,3) = - iim - 1
     745!
     746! Initialisation des correspondances point -> indices i,j
     747!
     748    if (( .not. allocated(correspond))) then
     749      allocate(correspond(iim,jjm+1), stat = error)
     750      if (error /= 0) then
     751        abort_message='Pb allocation correspond'
     752        call abort_gcm(modname,abort_message,1)
     753      endif     
     754    endif
     755!
     756! Attention aux poles
     757!
     758    do igrid = 1, knon
     759      index = knindex(igrid)
     760      ij = index - int((index-1)/iim)*iim - 1
     761      jj = 2 + int((index-1)/iim)
     762      if (mod(index,iim) == 1 ) then
     763        jj = 1 + int((index-1)/iim)
     764        ij = iim
     765      endif
     766      correspond(ij,jj) = igrid
     767    enddo
     768!
     769! Allouer et initialiser le tableau de coordonnees du sol
     770!
     771    if ((.not. allocated(lalo))) then
     772      allocate(lalo(knon,2), stat = error)
     773      if (error /= 0) then
     774        abort_message='Pb allocation lalo'
     775        call abort_gcm(modname,abort_message,1)
     776      endif     
     777    endif
     778    if ((.not. allocated(lon_scat))) then
     779      allocate(lon_scat(iim,jjm), stat = error)
     780      if (error /= 0) then
     781        abort_message='Pb allocation lon_scat'
     782        call abort_gcm(modname,abort_message,1)
     783      endif     
     784    endif
     785    if ((.not. allocated(lat_scat))) then
     786      allocate(lat_scat(iim,jjm), stat = error)
     787      if (error /= 0) then
     788        abort_message='Pb allocation lat_scat'
     789        call abort_gcm(modname,abort_message,1)
     790      endif     
     791    endif
     792    lon_scat = 0.
     793    lat_scat = 0.
     794    do igrid = 1, knon
     795      index = knindex(igrid)
     796      lalo(igrid,2) = rlon(index)
     797      lalo(igrid,1) = rlat(index)
     798      ij = index - int((index-1)/iim)*iim - 1
     799      jj = 2 + int((index-1)/iim)
     800      if (mod(index,iim) == 1 ) then
     801        jj = 1 + int((index-1)/iim)
     802        ij = iim
     803      endif
     804      lon_scat(ij,jj) = rlon(index)
     805      lat_scat(ij,jj) = rlat(index)
     806    enddo
     807    index = 1
     808    do jj = 2, jjm
     809      do ij = 1, iim
     810        index = index + 1
     811        lon_scat(ij,jj) = rlon(index)
     812        lat_scat(ij,jj) = rlat(index)
     813      enddo
     814    enddo
     815    lon_scat(:,1) = lon_scat(:,2)
     816    lat_scat(:,1) = rlat(1)
     817
     818!
     819! Allouer et initialiser le tableau des voisins et des fraction de continents
     820!
     821    if ( (.not.allocated(neighbours))) THEN
     822      allocate(neighbours(knon,8), stat = error)
     823      if (error /= 0) then
     824        abort_message='Pb allocation neighbours'
     825        call abort_gcm(modname,abort_message,1)
     826      endif
     827    endif
     828    neighbours = 0.
     829    if (( .not. allocated(contfrac))) then
     830      allocate(contfrac(knon), stat = error)
     831      if (error /= 0) then
     832        abort_message='Pb allocation contfrac'
     833        call abort_gcm(modname,abort_message,1)
     834      endif     
     835    endif
     836
     837    do igrid = 1, knon
     838      ireal = knindex(igrid)
     839      contfrac(igrid) = pctsrf(ireal,is_ter)
     840      if (mod(ireal - 2, iim) == 0) then
     841        offset = off_ini(:,1)
     842      else if(mod(ireal - 1, iim) == 0) then
     843        offset = off_ini(:,3)
     844      else
     845        offset = off_ini(:,2)
     846      endif
     847      if (ireal == 98) write (*,*) offset
     848      do i = 1, 8
     849        index = ireal + offset(i)
     850        if (index <= 1) index = 1
     851        if (index >= klon) index = klon
     852        if (pctsrf(index, is_ter) > EPSFRA) then
     853          ij = index - int((index-1)/iim)*iim - 1
     854          jj = 2 + int((index-1)/iim)
     855          if (mod(index,iim) == 1 ) then
     856            jj = 1 + int((index-1)/iim)
     857            ij = iim
     858          endif
     859!          write(*,*)'correspond',igrid, ireal,index,ij,jj
     860          if ( ij >= 1 .and. ij <= iim .and. jj >= 1 .and. jj <= jjm) then
     861!          write(*,*)'correspond',igrid, ireal,index,ij,jj
     862            neighbours(igrid, i) = correspond(ij, jj)
     863          endif
     864        endif
     865      enddo
     866    enddo
     867
     868!
     869!  Allocation et calcul resolutions
     870    IF ( (.NOT.ALLOCATED(resolution))) THEN
     871      ALLOCATE(resolution(knon,2), stat = error)
     872      if (error /= 0) then
     873        abort_message='Pb allocation resolution'
     874        call abort_gcm(modname,abort_message,1)
     875      endif
     876    ENDIF
     877    do igrid = 1, knon
     878      ij = knindex(igrid)
     879      resolution(igrid,1) = cufi(ij)
     880      resolution(igrid,2) = cvfi(ij)
     881    enddo 
     882
     883  endif                          ! (fin debut)
    652884
    653885!
    … …  
    655887!
    656888
    657 !    call sechiba_main(itime, klon, knon, knindex, dtime, &
    658 !     & debut, lafin, coupling, control_in, &
    659 !     & lalo, neighbours, resolution,&
    660 !     & zlev,  u1_lay, v1_lay, spechum, temp_air,hum_air , ccanopy, &
    661 !     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    662 !     & precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
    663 !     & evap, fluxsens, fluxlat, &
    664 !     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, &
    665 !     & rest_id, hist_id, rest_id_stom, hist_id_stom)
    666 
    667 !
    668 ! Sauvegarde dans fichiers histoire
    669 !
     889  petA_orc = petBcoef * dtime
     890  petB_orc = petAcoef
     891  peqA_orc = peqBcoef * dtime
     892  peqB_orc = peqAcoef
     893
     894  call intersurf_main (itime, iim, jjm, knon, knindex, dtime, &
     895     & lrestart_read, lrestart_write, lalo, &
     896     & contfrac, neighbours, resolution, date0, &
     897     & zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
     898     & tq_cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
     899     & precip_rain, precip_snow, lwdown, swnet, swdown, p1lay, &
     900     & evap, fluxsens, fluxlat, coastalflow, riverflow, &
     901     & tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
     902     & lon_scat, lat_scat)
     903
     904  alb_new(:) = albedo_out(:,1)
    670905
    671906  END SUBROUTINE interfsol
    … …  
    673908!#########################################################################
    674909!
    675   SUBROUTINE interfoce_cpl(itime, dtime, &
     910  SUBROUTINE interfoce_cpl(itime, dtime, cumul, &
    676911      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    677912      & ocean, npas, nexca, debut, lafin, &
    678913      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    679       & fder, albsol, taux, tauy, zmasq, &
     914      & fluxlat, fluxsens, fder, albsol, taux, tauy, zmasq, &
    680915      & tsurf_new, alb_new, alb_ice, pctsrf_new)
    681916
    … …  
    712947!   nexca        frequence de couplage
    713948!   swdown       flux solaire entrant a la surface
    714 !   lwdown       flux IR entrant a la surface
     949!   lwdown       flux IR net a la surface
    715950!   precip_rain  precipitation liquide
    716951!   precip_snow  precipitation solide
    … …  
    750985  INTEGER              :: nexca, npas, kstep
    751986  real, dimension(klon), intent(IN) :: zmasq
    752 
     987  real, dimension(klon), intent(IN) :: fluxlat, fluxsens
     988  logical, intent(IN)               :: cumul
    753989  real, dimension(klon), intent(INOUT) :: evap
    754990
    … …  
    7751011  real, dimension(iim, jjm+1) :: wri_sol_ice, wri_sol_sea, wri_nsol_ice
    7761012  real, dimension(iim, jjm+1) :: wri_nsol_sea, wri_fder_ice, wri_evap_ice
    777   real, dimension(iim, jjm+1) :: wri_evap_sea
    778   real, dimension(iim, jjm+1) :: wri_rain, wri_snow, wri_taux
    779   real, dimension(iim, jjm+1) :: wri_tauy, wri_rriv, wri_rcoa
     1013  REAL, DIMENSION(iim, jjm+1) :: wri_evap_sea, wri_rcoa, wri_rriv
     1014  REAL, DIMENSION(iim, jjm+1) :: wri_rain, wri_snow, wri_taux, wri_tauy
     1015  REAL, DIMENSION(iim, jjm+1) :: wri_tauxx, wri_tauyy, wri_tauzz
     1016  REAL, DIMENSION(iim, jjm+1) :: tmp_lon, tmp_lat
    7801017! variables relues par le coupleur
    7811018! read_sic = fraction de glace
    … …  
    8711108  cpl_index = 1
    8721109  if (nisurf == is_sic) cpl_index = 2
    873   do ig = 1, knon
    874     cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) &
    875      &                               + swdown(ig)      / FLOAT(nexca)
    876     cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) &
    877      &                               + lwdown(ig)      / FLOAT(nexca)
    878     cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) &
    879      &                               + precip_rain(ig) / FLOAT(nexca)
    880     cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) &
    881      &                               + precip_snow(ig) / FLOAT(nexca)
    882     cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) &
    883      &                               + evap(ig)        / FLOAT(nexca)
    884     cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) &
    885      &                               + tsurf(ig)       / FLOAT(nexca)
    886     cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) &
    887      &                               + fder(ig)        / FLOAT(nexca)
    888     cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) &
    889      &                               + albsol(ig)      / FLOAT(nexca)
    890     cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) &
    891      &                               + taux(ig)        / FLOAT(nexca)
    892     cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
    893      &                               + tauy(ig)        / FLOAT(nexca)
    894     cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
    895      &                               + 0.     / FLOAT(nexca)/dtime
    896     cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
    897      &                               + 0.     / FLOAT(nexca)/dtime
    898   enddo
     1110  if (cumul) then
     1111    do ig = 1, knon
     1112      if (check) write(*,*) modname, 'cumul des champs'
     1113      cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) &
     1114       &                          + swdown(ig)      / FLOAT(nexca)
     1115      cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) &
     1116       &                          + (lwdown(ig) + fluxlat(ig) +fluxsens(ig))&
     1117       &                                / FLOAT(nexca)
     1118      cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) &
     1119       &                          + precip_rain(ig) / FLOAT(nexca)
     1120      cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) &
     1121       &                          + precip_snow(ig) / FLOAT(nexca)
     1122      cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) &
     1123       &                          + evap(ig)        / FLOAT(nexca)
     1124      cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) &
     1125       &                          + tsurf(ig)       / FLOAT(nexca)
     1126      cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) &
     1127       &                          + fder(ig)        / FLOAT(nexca)
     1128      cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) &
     1129       &                          + albsol(ig)      / FLOAT(nexca)
     1130      cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) &
     1131       &                          + taux(ig)        / FLOAT(nexca)
     1132      cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
     1133       &                          + tauy(ig)        / FLOAT(nexca)
     1134      cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
     1135       &                          + 0.     / FLOAT(nexca)/dtime
     1136      cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
     1137       &                          + 0.     / FLOAT(nexca)/dtime
     1138    enddo
     1139  endif
    8991140
    9001141  if (mod(itime, nexca) == 1) then
    … …  
    9041145! Si le domaine considere est l'ocean, on lit les champs venant du coupleur
    9051146!
    906     if (nisurf == is_oce) then
     1147    if (nisurf == is_oce .and. .not. cumul) then
    9071148      if (check) write(*,*)'rentree fromcpl, itime-1 = ',itime-1
    9081149      call fromcpl(itime-1,(jjm+1)*iim,                                  &
    … …  
    10101251! Si le domaine considere est la banquise, on envoie les champs au coupleur
    10111252!
    1012     if (nisurf == is_sic) then
     1253    if (nisurf == is_sic .and. cumul) then
    10131254      wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0.
    10141255      wri_taux = 0.; wri_tauy = 0.
    … …  
    10381279      &            tmp_tauy(:,:,2) * tamp_srf(:,:,2) / deno
    10391280      endwhere
     1281!
     1282! on passe les coordonnées de la grille
     1283!
     1284      CALL gath2cpl(rlon(1), tmp_lon(1,1), klon, knon,iim,jjm, knindex)
     1285      CALL gath2cpl(rlat(1), tmp_lat(1,1), klon, knon,iim,jjm, knindex)
     1286      DO i = 1, iim
     1287        tmp_lon(i,1) = rlon(i+1)
     1288        tmp_lon(i,jjm + 1) = rlon(i+1)
     1289      ENDDO
     1290!
     1291! calcul 3 coordonnées du vent
     1292!
     1293      CALL atm2geo (iim , jjm + 1, wri_taux, wri_tauy, tmp_lon, tmp_lat, &
     1294         & wri_tauxx, wri_tauyy, wri_tauzz )
    10401295
    10411296      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
    10421297      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
    1043       & wri_snow, wri_rcoa, wri_rriv, wri_taux, wri_tauy, wri_taux, wri_tauy, &
    1044       & lafin )
     1298      & wri_snow, wri_rcoa, wri_rriv, wri_tauxx, wri_tauyy, wri_tauzz, &
     1299      & wri_tauxx, wri_tauyy, wri_tauzz,lafin )
    10451300      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
    10461301      cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
    … …  
    15721827  real                  :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
    15731828  real                  :: bilan_f, fq_fonte
     1829  REAL                  :: subli, fsno
    15741830  real, parameter :: t_grnd = 271.35, t_coup = 273.15
     1831!! PB temporaire en attendant mieux pour le modele de neige
     1832  REAL, parameter :: chasno = 3.334E+05/(2.3867E+06*0.15)
     1833!
    15751834  logical         :: check = .true.
    15761835  character (len = 20)  :: modname = 'calcul_fluxs'
    … …  
    15781837  real            :: max_eau_sol = 150.0
    15791838  character (len = 80) :: abort_message
     1839  logical,save         :: first = .t.,second=.f.
    15801840
    15811841  if (check) write(*,*)'Entree ', modname,' surface = ',nisurf
    … …  
    15901850! Traitement neige et humidite du sol
    15911851!
     1852!    if (first .and. nisurf == is_ter) then
     1853!      do i = 1, knon
     1854!        write(67,*)i, snow(i), precip_snow(i), evap(i)
     1855!      enddo
     1856!    endif
     1857!    if (second .and. nisurf == is_ter) then
     1858!      do i = 1, knon
     1859!        write(77,*)i, snow(i), precip_snow(i), evap(i)
     1860!      enddo
     1861!    endif
    15921862    if (nisurf == is_oce) then
    15931863      snow = 0.
    … …  
    15991869      qsol = qsol + (precip_rain - evap) * dtime
    16001870    endif
     1871    IF (nisurf /= is_ter) qsol = max_eau_sol
    16011872
    16021873
    … …  
    16351906     & * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
    16361907     & * p1lay(i)/(RD*t1lay(i))
     1908
     1909!    if (first .and. nisurf == is_ter) then
     1910!      write(43,*) &
     1911!     &i,zx_coef(i),coef1lay(i),u1lay(i),v1lay(i),p1lay(i),t1lay(i)
     1912!    endif
     1913!    if (second .and. nisurf == is_ter) then
     1914!      write(53,*) &
     1915!     &i,zx_coef(i),coef1lay(i),u1lay(i),v1lay(i),p1lay(i),t1lay(i)
     1916!    endif
    16371917   
    16381918  ENDDO
    … …  
    16641944    zx_mh(i) = zx_k1(i) * petAcoef(i) / zx_oh(i)
    16651945    zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i))/ zx_oh(i)
     1946
     1947!    if (first .and. nisurf == is_ter) then
     1948!      write(41,*) &
     1949!     &            i,zx_k1(i),petAcoef(i),petBcoef(i),&
     1950!     & zx_oh(i),zx_mh(i),zx_nh(i)
     1951!    endif
     1952
     1953!    if (second .and. nisurf == is_ter) then
     1954!      write(51,*) &
     1955!     &            i,zx_k1(i),petAcoef(i),petBcoef(i),&
     1956!     & zx_oh(i),zx_mh(i),zx_nh(i)
     1957!    endif
    16661958
    16671959! Tsurface
    … …  
    16911983    dflux_s(i) = zx_nh(i)
    16921984    dflux_l(i) = (zx_sl(i) * zx_nq(i))
     1985
     1986!    if (first .and. nisurf == is_ter) then
     1987!      write(42,*) &
     1988!     &            i,tsurf_new(i),d_ts(i),zx_h_ts(i),zx_q_0(i),&
     1989!     & evap(i),fluxsens(i)
     1990!    endif
     1991
     1992!    if (second .and. nisurf == is_ter) then
     1993!      write(52,*) &
     1994!     &            i,tsurf_new(i),d_ts(i),zx_h_ts(i),zx_q_0(i),&           
     1995!     & evap(i),fluxsens(i)
     1996!    endif
    16931997!
    16941998! en cas de fonte de neige
    … …  
    17072011    qsol(i) = min(qsol(i), max_eau_sol)
    17082012  ENDDO
     2013
     2014!  if (nisurf == is_oce .and. second) then
     2015!    second =.f.
     2016!  endif
     2017
     2018!  if (nisurf == is_oce .and. first) then
     2019!    first = .f.
     2020!    second = .t.
     2021!  endif
    17092022
    17102023  END SUBROUTINE calcul_fluxs

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

    r153 r177  
    8080      cl_writ(10)='CORUNCOA'
    8181      cl_writ(11)='CORIVFLU'
    82       cl_writ(12)='COZOTAUX'
    83       cl_writ(13)='COZOTAUV'
    84       cl_writ(14)='COMETAUY'
    85       cl_writ(15)='COMETAUU'
     82c$$$      cl_writ(12)='COZOTAUX'
     83c$$$      cl_writ(13)='COZOTAUV'
     84c$$$      cl_writ(14)='COMETAUY'
     85c$$$      cl_writ(15)='COMETAUU'
     86      cl_writ(12)='COTAUXXU'
     87      cl_writ(13)='COTAUYYU'
     88      cl_writ(14)='COTAUZZU'
     89      cl_writ(15)='COTAUXXV'
     90      cl_writ(16)='COTAUYYV'
     91      cl_writ(17)='COTAUZZV'
    8692c
    8793c     Define files name for fields exchanged from atmos to coupler,
    … …  
    103109      cl_f_writ(14)='flxatmos'
    104110      cl_f_writ(15)='flxatmos'
    105 c      cl_f_writ(16)='flxatmos'
     111      cl_f_writ(16)='flxatmos'
     112      cl_f_writ(17)='flxatmos'
     113
    106114c
    107115c
    … …  
    294302      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
    295303     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
    296      $    tauxu, tauxv, tauyv, tauyu, last)
     304     $    tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,last)
    297305c ======================================================================
    298306c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
    … …  
    306314      REAL fsolice(imjm)
    307315      REAL fsolwat(imjm)
    308       REAL fnsolice(imjm)
    309316      REAL fnsolwat(imjm)
    310       REAL fnsicedt(imjm)
    311       REAL ictemp(imjm)
     317      REAL fnsolice(imjm)
     318      REAL fnsicedt(imjm)
    312319      REAL evice(imjm)
    313320      REAL evwat(imjm)
    … …  
    316323      REAL dirunoff(imjm)
    317324      REAL rivrunoff(imjm)
    318       REAL tauxu(imjm)
    319       REAL tauxv(imjm)
    320       REAL tauyu(imjm)
    321       REAL tauyv(imjm)
     325c$$$      REAL tauxu(imjm)
     326c$$$      REAL tauxv(imjm)
     327c$$$      REAL tauyu(imjm)
     328c$$$      REAL tauyv(imjm)
     329      REAL tauxx_u(imjm)
     330      REAL tauxx_v(imjm)
     331      REAL tauyy_u(imjm)
     332      REAL tauyy_v(imjm)
     333      REAL tauzz_u(imjm)
     334      REAL tauzz_v(imjm)
    322335      LOGICAL last
    323336c
    … …  
    431444     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
    432445     $          file_unit_field(jf), ierror, nuout)
     446c$$$            IF (jf.eq.12)
     447c$$$     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
     448c$$$     $          file_unit_field(jf),ierror, nuout)
     449c$$$            IF (jf.eq.13)
     450c$$$     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
     451c$$$     $          file_unit_field(jf),ierror, nuout)
     452c$$$            IF (jf.eq.14)
     453c$$$     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
     454c$$$     $          file_unit_field(jf),ierror, nuout)
     455c$$$            IF (jf.eq.15)
     456c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
     457c$$$     $          file_unit_field(jf), ierror, nuout)
    433458            IF (jf.eq.12)
    434      $          CALL locwrite(cl_writ(jf),tauxu, imjm,
    435      $          file_unit_field(jf),ierror, nuout)
     459     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
     460     $          file_unit_field(jf),ierror)
    436461            IF (jf.eq.13)
    437      $          CALL locwrite(cl_writ(jf),tauxv, imjm,
    438      $          file_unit_field(jf),ierror, nuout)
     462     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
     463     $          file_unit_field(jf),ierror)
    439464            IF (jf.eq.14)
    440      $          CALL locwrite(cl_writ(jf),tauyv, imjm,
    441      $          file_unit_field(jf),ierror, nuout)
     465     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
     466     $          file_unit_field(jf),ierror)
    442467            IF (jf.eq.15)
    443      $          CALL locwrite(cl_writ(jf),tauyu, imjm,
    444      $          file_unit_field(jf), ierror, nuout)
     468     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
     469     $          file_unit_field(jf),ierror)
     470            IF (jf.eq.16)
     471     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
     472     $          file_unit_field(jf),ierror)
     473            IF (jf.eq.17)
     474     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
     475     $          file_unit_field(jf),ierror)
    445476          END DO
    446477C
    … …  
    484515          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
    485516          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
    486           IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
    487           IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
    488           IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
    489           IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
     517c$$$          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
     518c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
     519c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
     520c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
     521          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
     522          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
     523          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
     524          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
     525          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
     526          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
    490527         
    491528            IF (info .NE. CLIM_Ok) THEN

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.true

    r153 r177  
    8080      cl_writ(10)='CORUNCOA'
    8181      cl_writ(11)='CORIVFLU'
    82       cl_writ(12)='COZOTAUX'
    83       cl_writ(13)='COZOTAUV'
    84       cl_writ(14)='COMETAUY'
    85       cl_writ(15)='COMETAUU'
     82c$$$      cl_writ(12)='COZOTAUX'
     83c$$$      cl_writ(13)='COZOTAUV'
     84c$$$      cl_writ(14)='COMETAUY'
     85c$$$      cl_writ(15)='COMETAUU'
     86      cl_writ(12)='COTAUXXU'
     87      cl_writ(13)='COTAUYYU'
     88      cl_writ(14)='COTAUZZU'
     89      cl_writ(15)='COTAUXXV'
     90      cl_writ(16)='COTAUYYV'
     91      cl_writ(17)='COTAUZZV'
    8692c
    8793c     Define files name for fields exchanged from atmos to coupler,
    … …  
    103109      cl_f_writ(14)='flxatmos'
    104110      cl_f_writ(15)='flxatmos'
    105 c      cl_f_writ(16)='flxatmos'
     111      cl_f_writ(16)='flxatmos'
     112      cl_f_writ(17)='flxatmos'
     113
    106114c
    107115c
    … …  
    294302      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
    295303     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
    296      $    tauxu, tauxv, tauyv, tauyu, last)
     304     $    tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,last)
    297305c ======================================================================
    298306c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
    … …  
    306314      REAL fsolice(imjm)
    307315      REAL fsolwat(imjm)
    308       REAL fnsolice(imjm)
    309316      REAL fnsolwat(imjm)
    310       REAL fnsicedt(imjm)
    311       REAL ictemp(imjm)
     317      REAL fnsolice(imjm)
     318      REAL fnsicedt(imjm)
    312319      REAL evice(imjm)
    313320      REAL evwat(imjm)
    … …  
    316323      REAL dirunoff(imjm)
    317324      REAL rivrunoff(imjm)
    318       REAL tauxu(imjm)
    319       REAL tauxv(imjm)
    320       REAL tauyu(imjm)
    321       REAL tauyv(imjm)
     325c$$$      REAL tauxu(imjm)
     326c$$$      REAL tauxv(imjm)
     327c$$$      REAL tauyu(imjm)
     328c$$$      REAL tauyv(imjm)
     329      REAL tauxx_u(imjm)
     330      REAL tauxx_v(imjm)
     331      REAL tauyy_u(imjm)
     332      REAL tauyy_v(imjm)
     333      REAL tauzz_u(imjm)
     334      REAL tauzz_v(imjm)
    322335      LOGICAL last
    323336c
    … …  
    431444     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
    432445     $          file_unit_field(jf), ierror, nuout)
     446c$$$            IF (jf.eq.12)
     447c$$$     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
     448c$$$     $          file_unit_field(jf),ierror, nuout)
     449c$$$            IF (jf.eq.13)
     450c$$$     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
     451c$$$     $          file_unit_field(jf),ierror, nuout)
     452c$$$            IF (jf.eq.14)
     453c$$$     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
     454c$$$     $          file_unit_field(jf),ierror, nuout)
     455c$$$            IF (jf.eq.15)
     456c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
     457c$$$     $          file_unit_field(jf), ierror, nuout)
    433458            IF (jf.eq.12)
    434      $          CALL locwrite(cl_writ(jf),tauxu, imjm,
    435      $          file_unit_field(jf),ierror, nuout)
     459     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
     460     $          file_unit_field(jf),ierror)
    436461            IF (jf.eq.13)
    437      $          CALL locwrite(cl_writ(jf),tauxv, imjm,
    438      $          file_unit_field(jf),ierror, nuout)
     462     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
     463     $          file_unit_field(jf),ierror)
    439464            IF (jf.eq.14)
    440      $          CALL locwrite(cl_writ(jf),tauyv, imjm,
    441      $          file_unit_field(jf),ierror, nuout)
     465     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
     466     $          file_unit_field(jf),ierror)
    442467            IF (jf.eq.15)
    443      $          CALL locwrite(cl_writ(jf),tauyu, imjm,
    444      $          file_unit_field(jf), ierror, nuout)
     468     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
     469     $          file_unit_field(jf),ierror)
     470            IF (jf.eq.16)
     471     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
     472     $          file_unit_field(jf),ierror)
     473            IF (jf.eq.17)
     474     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
     475     $          file_unit_field(jf),ierror)
    445476          END DO
    446477C
    … …  
    484515          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
    485516          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
    486           IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
    487           IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
    488           IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
    489           IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
     517c$$$          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
     518c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
     519c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
     520c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
     521          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
     522          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
     523          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
     524          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
     525          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
     526          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
    490527         
    491528            IF (info .NE. CLIM_Ok) THEN

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

    r160 r177  
    220220c
    221221      real   ztau(klon,klev+1),
     222     $       ztauf(klon,klev+1),
    222223     *       zstab(klon,klev+1),
    223224     *       zvph(klon,klev+1),

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

    r151 r177  
    648648#endif
    649649c
     650      ierr = NF_REDEF (nid)
     651#ifdef NC_DOUBLE
     652      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
     653#else
     654      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
     655#endif
     656      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
     657     .                        "Longueur de rugosite sur mer")
     658      ierr = NF_ENDDEF(nid)
     659#ifdef NC_DOUBLE
     660      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,is_oce))
     661#else
     662      ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,is_oce))
     663#endif
     664c
     665c
    650666      ierr = NF_CLOSE(nid)
    651667c

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

    r171 r177  
    33     .            paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
    44     .            u,v,t,qx,
    5      .            omega,
     5     .            omega, cufi, cvfi,
    66     .            d_u, d_v, d_t, d_qx, d_ps)
    77      USE ioipsl
     8      USE histcom
     9
    810      IMPLICIT none
    911c======================================================================
    … …  
    8991ccc      PARAMETER (soil_model=.FALSE.)
    9092      logical ok_veget
    91       parameter (ok_veget = .false.)
     93      parameter (ok_veget = .true.)
    9294c======================================================================
    9395c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
    … …  
    217219      REAL fevap(klon,nbsrf)
    218220      SAVE fevap                 ! evaporation
     221      REAL fluxlat(klon,nbsrf)
     222      SAVE fluxlat
    219223c
    220224      REAL deltat(klon)
    … …  
    339343cAA
    340344      EXTERNAL hgardfou  ! verifier les temperatures
    341       EXTERNAL hydrol    ! hydrologie du sol
    342345      EXTERNAL nuage     ! calculer les proprietes radiatives
    343346      EXTERNAL o3cm      ! initialiser l'ozone
    … …  
    379382      REAL cool0(klon,klev)   ! refroidissement infrarouge ciel clair
    380383      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
     384      real sollwdown(klon)    ! downward LW flux at surface
    381385      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
    382386      REAL albpla(klon)
    383387c Le rayonnement n'est pas calcule tous les pas, il faut donc
    384388c                      sauvegarder les sorties du rayonnement
    385       SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw
     389      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
    386390      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
    387391      INTEGER itaprad
    … …  
    492496      logical ok_sync
    493497
     498
    494499c
    495500c Declaration des constantes et des fonctions thermodynamiques
    … …  
    538543         CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
    539544     .       rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow,
    540      .       falbe, fevap, rain_fall,snow_fall,solsw, sollw,
     545     .       falbe, fevap, rain_fall,snow_fall,solsw, sollwdown,
    541546     .       fder,radsol,frugs,agesno,clesphy0,
    542547     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
    … …  
    718723     .                "ave(X)", zsto,zout)
    719724c
     725         CALL histdef(nid_day, "solldown", "Down. IR rad. at surface",
     726     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
     727     .                "ave(X)", zsto,zout)
     728c
    720729         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
    721730     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    … …  
    746755     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
    747756     $         "ave(X)", zsto,zout)
    748 
     757C
     758           call histdef(nid_day, "tsol_"//clnsurf(nsrf),
     759     $         "Fraction"//clnsurf(nsrf), "W/m2", 
     760     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     761     $         "ave(X)", zsto,zout)
     762C
    749763           call histdef(nid_day, "sens_"//clnsurf(nsrf),
    750764     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
    … …  
    766780     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
    767781     $         "ave(X)", zsto,zout)
     782C
     783           call histdef(nid_day, "albe_"//clnsurf(nsrf),
     784     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
     785     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     786     $         "ave(X)", zsto,zout)
     787C
     788           call histdef(nid_day, "rugs_"//clnsurf(nsrf),
     789     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
     790     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     791     $         "ave(X)", zsto,zout)
     792
    768793C§§§
    769794         END DO
    … …  
    921946     .                "ave(X)", zsto,zout)
    922947c
     948         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
     949     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
     950     .                "ave(X)", zsto,zout)
     951c
    923952         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
    924953     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    … …  
    964993     $         "ave(X)", zsto,zout)
    965994C
     995           call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
     996     $         "Fraction "//clnsurf(nsrf), "W/m2", 
     997     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     998     $         "ave(X)", zsto,zout)
     999C
    9661000           call histdef(nid_mth, "sens_"//clnsurf(nsrf),
    9671001     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
    … …  
    9811015           call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
    9821016     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
     1017     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     1018     $         "ave(X)", zsto,zout)
     1019c
     1020           call histdef(nid_mth, "albe_"//clnsurf(nsrf),
     1021     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
     1022     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
     1023     $         "ave(X)", zsto,zout)
     1024c
     1025           call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
     1026     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
    9831027     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
    9841028     $         "ave(X)", zsto,zout)
    … …  
    12581302     .                "inst(X)", zsto,zout)
    12591303c
     1304         CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
     1305     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
     1306     .                "ave(X)", zsto,zout)
     1307c
    12601308         CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
    12611309     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    … …  
    15261574      DO nsrf = 1, nbsrf
    15271575      DO i = 1, klon
    1528          zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
     1576            zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
    15291577      ENDDO
    15301578      ENDDO
    … …  
    15461594     e            julien, rmu0,
    15471595     e            ok_veget, ocean, npas, nexca, ftsol,
    1548      e            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,
    1549      e            rain_fall, snow_fall, solsw, sollw, fder,
     1596     $            soil_model,ftsoil,
     1597     $            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,fluxlat,
     1598     e            rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
    15501599     e            rlon, rlat, cufi, cvfi, frugs,
    15511600     e            debut, lafin, agesno,rugoro ,
    … …  
    16051654      DO nsrf = 1, nbsrf
    16061655      DO i = 1, klon
    1607          ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
    1608          zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
     1656c$$$        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
     1657            ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
     1658            zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
     1659c$$$        ENDIF
    16091660      ENDDO
    16101661      ENDDO
    … …  
    16681719     s            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    16691720     s            kcbot, kctop, kdtop, pmflxr, pmflxs)
     1721      WHERE (rain_con < 0.) rain_con = 0.
     1722      WHERE (snow_con < 0.) snow_con = 0.
    16701723      DO i = 1, klon
    16711724         ibas_con(i) = klev+1 - kcbot(i)
    … …  
    17581811     .           frac_impa, frac_nucl,
    17591812     .           prfl, psfl)
     1813      WHERE (rain_lsc < 0) rain_lsc = 0.
     1814      WHERE (snow_lsc < 0) snow_lsc = 0.
    17601815      DO k = 1, klev
    17611816      DO i = 1, klon
    … …  
    18611916     s             heat,heat0,cool,cool0,radsol,albpla,
    18621917     s             topsw,toplw,solsw,sollw,
     1918     s             sollwdown,
    18631919     s             topsw0,toplw0,solsw0,sollw0)
    18641920      itaprad = 0
    … …  
    18931949c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
    18941950c
    1895       DO nsrf = 1, nbsrf
    1896       DO i = 1, klon
    1897          IF (pctsrf(i,nsrf).LT.epsfra) THEN
    1898             fqsol(i,nsrf) = zxqsol(i)
    1899             fsnow(i,nsrf) = zxsnow(i)
    1900          ENDIF
    1901       ENDDO
    1902       ENDDO
     1951c$$$      DO nsrf = 1, nbsrf
     1952c$$$      DO i = 1, klon
     1953c$$$         IF (pctsrf(i,nsrf).LT.epsfra) THEN
     1954c$$$            fqsol(i,nsrf) = zxqsol(i)
     1955c$$$            fsnow(i,nsrf) = zxsnow(i)
     1956c$$$         ENDIF
     1957c$$$      ENDDO
     1958c$$$      ENDDO
    19031959c
    19041960c Calculer le bilan du sol et la derive de temperature (couplage)
    … …  
    20922148      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    20932149c
     2150      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
     2151      CALL histwrite(nid_day,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2152c
    20942153      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
    20952154      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    … …  
    21082167        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
    21092168     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2169C
     2170        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
     2171        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2172        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itap,
     2173     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    21102174C
    2111         zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
     2175        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
    21122176        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    21132177        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
    21142178     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    21152179C
    2116         zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
     2180        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
    21172181        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    21182182        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
    21192183     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    21202184C
    2121         zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
     2185        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
    21222186        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    21232187        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
    21242188     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    21252189C     
    2126         zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
     2190        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
    21272191        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    21282192        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
    21292193     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2194C
     2195        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
     2196        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2197        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itap,
     2198     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2199C
     2200        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
     2201        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2202        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itap,
     2203     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    21302204C
    21312205      END DO 
    … …  
    22582332      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
    22592333      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2334c
     2335      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
     2336      CALL histwrite(nid_mth,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    22602337c
    22612338      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
    … …  
    23002377     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    23012378C
    2302         zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
     2379        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
     2380        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2381        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itap,
     2382     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2383C
     2384        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
    23032385        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    23042386        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
    2305      $      zx_tmp_2d,iim*jjmp1,ndex2d) 
    2306 C
    2307         zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
     2387     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2388C
     2389        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
    23082390        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    23092391        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
    23102392     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    23112393C
    2312         zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
     2394        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
    23132395        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    23142396        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
    23152397     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    23162398C     
    2317         zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
     2399        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
    23182400        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    23192401        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
    23202402     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    23212403C
     2404        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
     2405        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2406        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itap,
     2407     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2408C
     2409        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
     2410        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     2411        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itap,
     2412     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     2413
    23222414      END DO 
    23232415c$$$      DO i = 1, klon
    … …  
    25592651      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
    25602652      CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
     2653c
     2654      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
     2655      CALL histwrite(nid_ins,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
    25612656c
    25622657      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
    … …  
    25882683     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    25892684C
    2590         zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
     2685        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
    25912686        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    25922687        CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
    25932688     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    25942689C
    2595         zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
     2690        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
    25962691        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    25972692        CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
    … …  
    26032698     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    26042699C
    2605         zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
     2700        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
    26062701        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    26072702        CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
    26082703     $      zx_tmp_2d,iim*jjmp1,ndex2d)
    26092704C     
    2610         zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
     2705        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
    26112706        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
    26122707        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
    … …  
    27522847     .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
    27532848     .      falbe, fevap, rain_fall, snow_fall,
    2754      .      solsw, sollw,fder,
     2849     .      solsw, sollwdown,fder,
    27552850     .      radsol,frugs,agesno,
    27562851     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,

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

    r79 r177  
    77     O                   physid)
    88      USE ioipsl
     9      USE histcom
    910
    1011      IMPLICIT none

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

    r79 r177  
    1010     O                   tr_seri)
    1111      USE ioipsl
     12      USE histcom
     13
    1214      IMPLICIT none
    1315c======================================================================

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

    r2 r177  
    44     .                  heat,heat0,cool,cool0,radsol,albpla,
    55     .                  topsw,toplw,solsw,sollw,
     6     .                  sollwdown,
    67     .                  topsw0,toplw0,solsw0,sollw0)
    78      IMPLICIT none
    … …  
    5253      real solsw(klon), sollw(klon), albpla(klon)
    5354      real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
     55      real sollwdown(klon)
    5456c
    5557      REAL*8 zx_alpha1, zx_alpha2
    … …  
    8385      REAL*8 ztopsw(kdlon), ztoplw(kdlon)
    8486      REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
     87      REAL*8 zsollwdown(kdlon)
    8588      REAL*8 ztopsw0(kdlon), ztoplw0(kdlon)
    8689      REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
    … …  
    186189     .        PVIEW,
    187190     .        zcool, zcool0,
    188      .        ztoplw,zsollw,ztoplw0,zsollw0)
     191     .        ztoplw,zsollw,ztoplw0,zsollw0,
     192     .        zsollwdown)
    189193      CALL SW(PSCT, RCO2, zrmu0, zfract,
    190194     S        PPMB, PDP,
    … …  
    201205         solsw(iof+i) = zsolsw(i)
    202206         sollw(iof+i) = zsollw(i)
     207         sollwdown(iof+i) = zsollwdown(i)
    203208         topsw0(iof+i) = ztopsw0(i)
    204209         toplw0(iof+i) = ztoplw0(i)
    … …  
    24542459     .              PVIEW,
    24552460     .              PCOLR, PCOLR0,
    2456      .              PTOPLW,PSOLLW,PTOPLW0,PSOLLW0)
     2461     .              PTOPLW,PSOLLW,PTOPLW0,PSOLLW0,
     2462     .              psollwdown)
    24572463      IMPLICIT none
    24582464#include "dimensions.h"
    … …  
    25162522      REAL*8 PTOPLW0(KDLON)       ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
    25172523      REAL*8 PSOLLW0(KDLON)       ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
     2524c Rajout LF
     2525      real*8 psollwdown(kdlon)    ! LONGWAVE downwards flux at surface
    25182526C
    25192527C-------------------------------------------------------------------------
    … …  
    25882596         PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1)
    25892597         PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1)
     2598         psollwdown(i) = -ZFLUX(i,2,1)
    25902599      ENDDO
    25912600C     ------------------------------------------------------------------

  • LMDZ.3.3/branches/rel-LF/liste_des_sources_f90

    r112 r177  
    1111      USE IOIPSL
    1212libf/dyn3d/abort_gcm.F
     13      USE ioipsl
     14libf/dyn3d/create_limit.F
    1315      USE IOIPSL
    1416libf/dyn3d/dynredem.F

  • LMDZ.3.3/branches/rel-LF/makegcm

    r166 r177  
    168168else if $SUN then
    169169   set optim=" -fast "
     170#   set optim=" -g "
    170171   set optimbis=" "
    171172   set optim90=" -fast -fixed "
    172    set optimtru90=" -fast -free"
    173    set opt_link="-lf77compat -L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
     173   set optimtru90=" -fast -free "
     174   set opt_link="-lf77compat -L$modipsl/lib -lsechiba -lparameters -lstomate -L$IOIPSLDIR -lioipsl -L$NCDFLIB -lnetcdf "
    174175   set mod_loc_dir=$localdir
    175176   set mod_suffix=mod
    … …  
    199200else if $LINUX then
    200201   set optim="-fast "
    201    set optim90=" -fast -module $libo"
    202    set optimtru90=" -fast -c -Mfree -module /d3/fairhead/sechiba/ioipsl"
    203    set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -L$IOIPSLDIR -lioipsl -Wl,-Bstatic "
     202   set optim90=" -fast "
     203   set optimtru90=" -fast -c -Mfree -module $IOIPSLDIR "
     204   set opt_link=" -Mfree -L /usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$modipsl/lib -lsechiba -lparameters -lstomate -L$NCDFLIB -lnetcdf -L$IOIPSLDIR -lioipsl -Wl,-Bstatic -L/usr/lib/gcc-lib/i386-linux/2.95.2/"
    204205   set mod_loc_dir=$IOIPSLDIR
    205206   set mod_suffix=mod
    … …  
    390391           setenv PARALLEL 2
    391392           set optim=" -g -C "
    392            set optim90=" -fixed -g "
    393            set optimtru90=" -free -g "
     393           set optim90=" -fixed -g -C "
     394           set optimtru90=" -free -g -C "
     395#           set optim=" -g "
     396#           set optim90=" -fixed -g "
     397#           set optimtru90=" -free -g "
    394398        else if $CRAY then
    395399           set optim="$optim"" -g "
    396400           set optim90="$optim90"" -G1 "
    397401        else if $LINUX then
    398            set optim="$optim"" -g -Mbounds "
    399            set optim90="$optim90"" -g -Mbounds "
     402           set optim="$optim"" -g -Mbounds -C "
     403           set optim90="$optim90"" -g -Mbounds -C "
    400404        else
    401405           echo pas d option debug predefinie pour cette machine
    … …  
    715719 \cp $IOIPSLDIR/*.mod $libo
    716720else if $SUN then
    717  set optim90=" $optim90 -M$libo "
    718  set optimtru90=" $optimtru90 -M$libo "
     721 set optim90=" $optim90 -M$libo -M$modipsl/lib "
     722 set optimtru90=" $optimtru90 -M$libo -M$modipsl/lib "
    719723 set optim="$optim90"
    720  \cp /d3/fairhead/sechiba_sun/parameters/*.mod $libo
    721  \cp /d3/fairhead/sechiba_sun/sechiba/*.mod $libo
    722  \cp /d3/fairhead/sechiba_sun/stomate/*.mod $libo
    723724 \cp $IOIPSLDIR/*.mod $libo
    724725else if $NEC then
    … …  
    728729 set optimtru90=" $optimtru90 -I$libo "
    729730else if $LINUX then
    730  set optim90=" -fast -module $libo "
     731 set optim90=" $optim90 -module $libo "
    731732 set optim="$optim90"
    732733 set mod_loc_dir=$libo

  • LMDZ.3.3/branches/rel-LF/tmp

    r112 r177  
    1 g
    2 C
     1fast

  • LMDZ.3.3/branches/rel-LF/tmp90

    r112 r177  
    1111      USE IOIPSL
    1212libf/dyn3d/abort_gcm.F
     13      USE ioipsl
     14libf/dyn3d/create_limit.F
    1315      USE IOIPSL
    1416libf/dyn3d/dynredem.F
Note: See TracChangeset for help on using the changeset viewer.